Ignore:
Timestamp:
Feb 5, 2008, 11:01:48 PM (12 years ago)
Author:
gz
Message:

Merge of the 'event-ide' branch. Hemlock's thread model has been changed
so that Hemlock commands now run in the Cocoa event thread -- see the
Hemlock file view.lisp for an overview.

IDE compilation has also been reorganized. Hemlock is now more fully
integrated into the IDE and cannot be compiled separately, sorry.

The hemlock-ext package has been repurposed to contain all interfaces
to window-system specific functionality.

There are also many many assorted other changes, cleanups and fixes.

The Hemlock documentation (Hemlock Command Implementor's Manual) in
http://trac.clozure.com/openmcl/wiki now correctly reflects the
implementation, although it doesn't (yet) describe the integration
with Cocoa or the threading model.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/hemlock/src/cocoa-hemlock.lisp

    r7595 r8428  
    77(in-package :hemlock-internals)
    88
    9 (defstruct (frame-event-queue (:include ccl::locked-dll-header))
    10   (signal (ccl::make-semaphore))
    11   (quoted-insert nil))
    12 
    13 (defstruct (buffer-operation (:include ccl::dll-node))
    14   (thunk nil))
    15 
    16 (defstruct (event-queue-node (:include ccl::dll-node)
    17                              (:constructor make-event-queue-node (event)))
    18   event)
    19 
    20 (defun event-queue-insert (q node)
    21   (ccl::locked-dll-header-enqueue node q)
    22   (ccl::signal-semaphore (frame-event-queue-signal q)))
    23 
    24 (defun enqueue-key-event (q event)
    25   (event-queue-insert q (make-event-queue-node event)))
    26 
    27 (defun dequeue-key-event (q)
    28   (unless (listen-editor-input q)
    29     (let* ((document (buffer-document (current-buffer))))
    30       (when document
    31         (document-set-point-position document))))
    32   (ccl::wait-on-semaphore (frame-event-queue-signal q))
    33   (ccl::locked-dll-header-dequeue q))
    34 
    35 
    36 (defun unget-key-event (event q)
    37   (ccl::with-locked-dll-header (q)
    38     (ccl::insert-dll-node-after (make-event-queue-node  event) q))
    39   (ccl::signal-semaphore (frame-event-queue-signal q)))
    40 
    41 (defun timed-wait-for-key-event (q seconds)
    42   (let* ((signal (frame-event-queue-signal q)))
    43     (when (ccl:timed-wait-on-semaphore signal seconds)
    44       (ccl:signal-semaphore signal)
    45       t)))
    46 
    47 (defvar *command-key-event-buffer* nil)
    48 
    49  
    50 
    51 (defun buffer-windows (buffer)
    52   (let* ((doc (buffer-document buffer)))
    53     (when doc
    54       (document-panes doc))))
    55 
    56 (defvar *current-window* ())
    57 
    58 (defvar *window-list* ())
    59 (defun current-window ()
    60   "Return the current window.  The current window is specially treated by
    61   redisplay in several ways, the most important of which is that is does
    62   recentering, ensuring that the Buffer-Point of the current window's
    63   Window-Buffer is always displayed.  This may be set with Setf."
    64   *current-window*)
    65 
    66 (defun %set-current-window (new-window)
    67   #+not-yet
    68   (invoke-hook hemlock::set-window-hook new-window)
    69   (activate-hemlock-view new-window)
    70   (setq *current-window* new-window))
    71 
    72 ;;; This is a public variable.
    73 ;;;
    74 (defvar *last-key-event-typed* ()
    75   "This variable contains the last key-event typed by the user and read as
    76    input.")
    77 
    78 (defvar *input-transcript* ())
    79 
    80 (defparameter editor-abort-key-events (list #k"Control-g" #k"Control-G"))
    81 
    82 (defmacro abort-key-event-p (key-event)
    83   `(member (event-queue-node-event ,key-event) editor-abort-key-events))
    84 
    85 (defconstant +shift-event-mask+ (hemlock-ext::key-event-modifier-mask "Shift"))
    86    
    87 (defun get-key-event (q &optional ignore-pending-aborts)
    88   (do* ((e (dequeue-key-event q) (dequeue-key-event q)))
    89        ((typep e 'event-queue-node)
    90         (unless ignore-pending-aborts
    91           (when (abort-key-event-p e)
    92             (beep)
    93             (clear-echo-area)
    94             (throw 'editor-top-level-catcher nil)))
    95         (values (setq *last-key-event-typed* (event-queue-node-event e))
    96                 (prog1 (frame-event-queue-quoted-insert q)
    97                   (setf (frame-event-queue-quoted-insert q) nil))))
    98     (if (typep e 'buffer-operation)
    99       (catch 'command-loop-catcher
    100         (funcall (buffer-operation-thunk e))))))
    101 
    102 (defun recursive-get-key-event (q &optional ignore-pending-aborts)
    103   (let* ((buffer *command-key-event-buffer*)
    104          (doc (when buffer (buffer-document buffer))))
    105     (if (null doc)
    106       (get-key-event q ignore-pending-aborts)
    107       (unwind-protect
    108            (progn
    109              (document-end-editing doc)
    110              (get-key-event q ignore-pending-aborts))
    111         (document-begin-editing doc)))))
    112 
    113 
    114 (defun listen-editor-input (q)
    115   (ccl::with-locked-dll-header (q)
    116     (not (eq (ccl::dll-header-first q) q))))
    117 
    1189(defun add-buffer-font-region (buffer region)
    11910  (when (typep buffer 'buffer)
     
    12314      (setf (font-region-node region) node)
    12415      region)))
    125 
    126 (defun enable-self-insert (q)
    127   (setf (frame-event-queue-quoted-insert q) t))
    128 
    129 (defmethod disable-self-insert ((q frame-event-queue))
    130   (setf (frame-event-queue-quoted-insert q) nil))
    13116
    13217(defun remove-font-region (region)
     
    19075      (format t "~& style ~d ~d [~s]/ ~d [~s] ~a"
    19176              (font-mark-font start)
    192               (ccl::mark-absolute-position start)
     77              (mark-absolute-position start)
    19378              (mark-%kind start)
    194               (ccl::mark-absolute-position end)
     79              (mark-absolute-position end)
    19580              (mark-%kind end)
    19681              (eq r (buffer-active-font-region buffer))))))
     
    20085  (string-to-clipboard (region-to-string region)))
    20186
    202 ;;; Meta-.
    203 (defun hemlock::get-def-info-and-go-to-it (string package)
    204   (multiple-value-bind (fun-name error)
    205       (let* ((*package* package))
    206         (ignore-errors (values (read-from-string string))))
    207     (if error
    208       (editor-error)
    209       (hi::edit-definition fun-name))))
    210 
    211 ;;; Search highlighting
    212 (defun note-selection-set-by-search (&optional (buffer (current-buffer)))
    213   (let* ((doc (buffer-document buffer)))
    214     (when doc (hi::document-note-selection-set-by-search doc))))
Note: See TracChangeset for help on using the changeset viewer.