Changeset 8207


Ignore:
Timestamp:
Jan 17, 2008, 9:49:54 PM (12 years ago)
Author:
gz
Message:

Make sure all the symbols in the editor documentation in the wiki are exported
from the hemlock-interface package, and vice versa. Get rid of a bunch of stuff
we no longer support, add a few things that got lost (move-to-column, update-
modeline-fields).

Make a subtype of buffer, echo-buffer, for buffers used as echo area backing.
Add public fn all-buffers which only returns the non-echo-area ones.

Get rid of the assorted "Page" commands -- since Cocoa doesn't display L's,
there is no point encouraging people to use them.

Now that I actually understand mode variables, don't use them for query/replace
and i-search state, use buffer variables.

Add hemlock-ext:raise-buffer-view, use it in "Jump to Saved Position"

make delete-buffer error if buffer-document is non-nil (used to do something
like that before).

Location:
branches/event-ide/ccl/cocoa-ide
Files:
22 edited

Legend:

Unmodified
Added
Removed
  • branches/event-ide/ccl/cocoa-ide/cocoa-editor.lisp

    r7995 r8207  
    17321732  (declare (ignore change)))
    17331733
    1734 (defloadvar *hemlock-frame-count* 0)
    1735 
    17361734(defun make-echo-area (the-hemlock-frame x y width height main-buffer color)
    17371735  (let* ((box (make-instance 'ns:ns-view :with-frame (ns:make-ns-rect x y width height))))
     
    17471745      (#/setAutoresizesSubviews: box t)
    17481746      (#/release clipview)
    1749       (let* ((buffer (hi:make-buffer (format nil "Echo Area ~d"
    1750                                              (prog1
    1751                                                  *hemlock-frame-count*
    1752                                                (incf *hemlock-frame-count*)))
    1753                                      :modes '("Echo Area")))
     1747      (let* ((buffer (hi::make-echo-buffer))
    17541748             (textstorage
    17551749              (progn
     
    18521846     t)))
    18531847
    1854 (defmethod hemlock-ext:report-hemlock-error ((view hi:hemlock-view) condition)
    1855   (maybe-log-callback-error condition)
     1848(defmethod hemlock-ext:report-hemlock-error ((view hi:hemlock-view) condition debug-p)
     1849  (when debug-p (maybe-log-callback-error condition))
    18561850  (let ((pane (hi::hemlock-view-pane view)))
    18571851    (when (and pane (not (%null-ptr-p pane)))
     
    29542948   t))
    29552949
     2950(defun hemlock-ext:raise-buffer-view (buffer &optional action)
     2951  "Bring a window containing buffer to front and then execute action in
     2952   the window.  Returns before operation completes."
     2953  ;; Queue for after this event, so don't screw up current context.
     2954  (queue-for-gui #'(lambda ()
     2955                     (let ((doc (hi::buffer-document buffer)))
     2956                       (unless (and doc (not (%null-ptr-p doc)))
     2957                         (hi:editor-error "Deleted buffer: ~s" buffer))
     2958                       (#/showWindows doc)
     2959                       (when action
     2960                         (hi::handle-hemlock-event (front-view-for-buffer buffer) action))))))
     2961
    29562962;;; Enable CL:ED
    29572963(defun cocoa-edit (&optional arg)
     
    29622968        ((ccl::valid-function-name-p arg)
    29632969         (hemlock::edit-definition arg)
    2964          arg)
     2970         nil)
    29652971        (t (report-bad-arg arg '(or null string pathname (satisfies ccl::valid-function-name-p))))))
    29662972
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/bindings.lisp

    r8055 r8207  
    362362
    363363
    364 ;;;; Typescript.
    365 #+typescript
    366 (progn
    367 (bind-key "Confirm Typescript Input" #k"return" :mode "Typescript")
    368 (bind-key "Interactive Beginning of Line" #k"control-a" :mode "Typescript")
    369 (bind-key "Kill Interactive Input" #k"meta-i" :mode "Typescript")
    370 (bind-key "Previous Interactive Input" #k"meta-p" :mode "Typescript")
    371 (bind-key "Search Previous Interactive Input" #k"meta-P" :mode "Typescript")
    372 (bind-key "Next Interactive Input" #k"meta-n" :mode "Typescript")
    373 (bind-key "Reenter Interactive Input" #k"control-return" :mode "Typescript")
    374 (bind-key "Typescript Slave Break" #k"hyper-b" :mode "Typescript")
    375 (bind-key "Typescript Slave to Top Level" #k"hyper-g" :mode "Typescript")
    376 (bind-key "Typescript Slave Status" #k"hyper-s" :mode "Typescript")
    377 (bind-key "Select Slave" #k"control-meta-\c")
    378 (bind-key "Select Background" #k"control-meta-C")
    379 
    380 (bind-key "Abort Operations" #k"hyper-a")
    381 (bind-key "List Operations" #k"hyper-l")
    382 
    383 (bind-key "Next Compiler Error" #k"hyper-n")
    384 (bind-key "Previous Compiler Error" #k"hyper-p")
    385 )
    386 
    387 
    388364;;;; Lisp (some).
    389365
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/buffer.lisp

    r8062 r8207  
    397397  "Internal variable which might contain the current buffer." )
    398398
     399(defun all-buffers ()
     400  "List of all buffers"
     401  (remove-if #'echo-buffer-p *buffer-list*))
     402
     403(ccl:defloadvar *echo-area-counter* 0)
     404
     405(defun make-echo-buffer ()
     406  (let* ((name (loop as name = (format nil "Echo Area ~d" (incf *echo-area-counter*))
     407                  until (null (getstring name *buffer-names*))
     408                  finally (return name)))
     409         (buffer (internal-make-echo-buffer
     410                  :%name name
     411                  :major-mode-object (getstring "Echo Area" *mode-names*))))
     412    (initialize-buffer buffer)))
     413
    399414(defun make-buffer (name &key (modes (value hemlock::default-modes))
    400                               (modeline-fields
    401                                (value hemlock::default-modeline-fields))
    402                               delete-hook)
     415                              (modeline-fields (value hemlock::default-modeline-fields))
     416                              delete-hook)
    403417  "Creates and returns a buffer with the given Name if a buffer with Name does
    404418   not already exist, otherwise returns nil.  Modes is a list of mode names,
    405419   and Modeline-fields is a list of modeline field objects.  Delete-hook is a
    406420   list of functions that take a buffer as the argument."
    407   #+GZ
    408421  (when (getstring name *buffer-names*)
    409422    (cerror "Try to delete" "~s already exists" name)
     
    415428         (unless (listp delete-hook)
    416429           (error ":delete-hook is a list of functions -- ~S." delete-hook))
    417          (let* ((region (make-empty-region))
    418                 (object (getstring "Fundamental" *mode-names*))
    419                 (buffer (internal-make-buffer
    420                          :%name name
    421                          :%region region
    422                          :major-mode-object object
    423                          :bindings (make-hash-table)
    424                          :point (copy-mark (region-end region))
    425                          :delete-hook delete-hook
    426                          :variables (make-string-table))))
    427            (set-buffer-modeline-fields buffer modeline-fields)
    428            (setf (line-%buffer (mark-line (region-start region))) buffer)
    429            (push buffer *buffer-list*)
    430            (setf (getstring name *buffer-names*) buffer)
    431            (unless (equalp modes '("Fundamental"))
    432              (setf (buffer-major-mode buffer) (car modes))
    433              (dolist (m (cdr modes))
    434                (setf (buffer-minor-mode buffer m) t)))
    435            (invoke-hook hemlock::make-buffer-hook buffer)
    436            buffer))))
     430         (let* ((buffer (internal-make-buffer
     431                         :%name name
     432                         :major-mode-object (getstring "Fundamental" *mode-names*)
     433                         :delete-hook delete-hook)))
     434           (initialize-buffer buffer :modeline-fields modeline-fields :modes modes)))))
     435
     436(defun initialize-buffer (buffer &key modeline-fields modes)
     437  (setf (buffer-bindings buffer) (make-hash-table))
     438  (setf (buffer-variables buffer) (make-string-table))
     439  (let ((region (make-empty-region)))
     440    (setf (line-%buffer (mark-line (region-start region))) buffer)
     441    (setf (buffer-%region buffer) region)
     442    (setf (buffer-point buffer) (copy-mark (region-end region))))
     443  (setf (getstring (buffer-%name buffer) *buffer-names*) buffer)
     444  (push buffer *buffer-list*)
     445  (set-buffer-modeline-fields buffer modeline-fields)
     446  (when modes
     447    (unless (equalp modes '("Fundamental"))
     448      (setf (buffer-major-mode buffer) (car modes))
     449      (dolist (m (cdr modes))
     450        (setf (buffer-minor-mode buffer m) t))))
     451  (invoke-hook hemlock::make-buffer-hook buffer)
     452  buffer)
    437453
    438454(defun delete-buffer (buffer)
     
    440456  (when (eq buffer *current-buffer*)
    441457    (error "Cannot delete current buffer ~S." buffer))
     458  (when (buffer-document buffer)
     459    (error "Cannot delete displayed buffer ~S." buffer))
    442460  (invoke-hook (buffer-delete-hook buffer) buffer)
    443461  (invoke-hook hemlock::delete-buffer-hook buffer)
     
    470488;;; "make-buffer" wants fundamental to be defined when it is called, and we
    471489;;; can't make the real fundamental mode until there is a current buffer
    472 ;;; because "defmode" wants to invoke it's mode definition hook.  Also,
     490;;; because "defmode" wants to invoke its mode definition hook.  Also,
    473491;;; when creating the "Main" buffer, "Default Modeline Fields" is not yet
    474492;;; defined, so we supply this argument to MAKE-BUFFER as nil.  This is
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/decls.lisp

    r7844 r8207  
    5555             ,name)))
    5656
    57 (declfun change-to-buffer (buffer))     ;filecoms.lisp
    58 
    59 (declfun hemlock::to-line-comment (mark start)) ;defined in comments.lisp used in lispbuf.lisp
    60 
    6157;;; Some special variables are forward-referenced, and we don't even
    6258;;; need to invent a new language to advise the compiler of that ...
     
    6460                  *the-sentinel*
    6561                  *in-the-editor* *buffer-list* *things-to-do-once*
    66                   *gc-notify-before* *gc-notify-after*))
     62                  *gc-notify-before* *gc-notify-after*
     63                  *key-event-history*))
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/echo.lisp

    r8062 r8207  
    271271        (let ((merge
    272272               (cond ((not (eps-parse-default eps)) nil)
    273                      ((directoryp pn)
     273                     ((ccl:directory-pathname-p pn)
    274274                      (merge-pathnames pn (eps-parse-default eps)))
    275275                     (t
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/echocoms.lisp

    r7993 r8207  
    221221                  (string/= string (ring-ref *echo-area-history* 0)))
    222222          (ring-push string *echo-area-history*)))
    223     (multiple-value-bind (res flag)
     223    (multiple-value-bind (vals flag)
    224224                         (funcall (eps-parse-verification-function eps) eps string)
    225       (unless (or res flag) (editor-error))
    226       (exit-echo-parse eps res))))
     225      ;; flag is to distinguish vals=() to return 0 values vs vals=nil because invalid.
     226      (unless (or vals flag) (editor-error))
     227      (exit-echo-parse eps vals))))
    227228
    228229(defcommand "Previous Parse" (p)
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/edit-defs.lisp

    r7993 r8207  
    121121                      (concatenate 'simple-string name "-COMMAND"))))
    122122
     123;;; FUN-DEFINED-FROM-PATHNAME takes a symbol or function object.  It
     124;;; returns a pathname for the file the function was defined in.  If it was
     125;;; not defined in some file, then nil is returned.
     126;;;
     127(defun fun-defined-from-pathname (function)
     128  "Takes a symbol or function and returns the pathname for the file the
     129   function was defined in.  If it was not defined in some file, nil is
     130   returned."
     131  (flet ((true-namestring (path) (namestring (truename path))))
     132    (typecase function
     133      (function (fun-defined-from-pathname (ccl:function-name function)))
     134      (symbol (let* ((info (ccl::%source-files function)))
     135                (if (atom info)
     136                  (true-namestring info)
     137                  (let* ((finfo (assq 'function info)))
     138                    (when finfo
     139                      (true-namestring
     140                       (if (atom finfo)
     141                         finfo
     142                         (car finfo)))))))))))
     143
    123144;;; GO-TO-DEFINITION tries to find name in file with a search pattern based
    124145;;; on type (defun or defmacro).  File may be translated to another source
     
    131152     (file
    132153      (setf file (go-to-definition-file file))
    133       (let* ((buffer (find-file-command nil file))
     154      (let* ((buffer (old-find-file-command nil file))
    134155             (point (buffer-point buffer))
    135156             (name-len (length name)))
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/filecoms.lisp

    r7993 r8207  
    355355  (clear-echo-area))
    356356
    357 ;;; REVERT-PATHNAME -- Internal
    358 ;;;
    359 ;;; If in Save Mode, return either the checkpoint pathname or the buffer
    360 ;;; pathname whichever is more recent. Otherwise return the buffer-pathname
    361 ;;; if it exists. If neither file exists, return NIL.
    362 ;;;
    363 (defun revert-pathname (buffer)
    364   (let* ((buffer-pn (buffer-pathname buffer))
    365          (buffer-pn-date (file-write-date buffer-pn))
    366          (checkpoint-pn (get-checkpoint-pathname buffer))
    367          (checkpoint-pn-date (and checkpoint-pn
    368                                   (file-write-date checkpoint-pn))))
    369     (cond (checkpoint-pn-date
    370            (if (> checkpoint-pn-date (or buffer-pn-date 0))
    371                (values checkpoint-pn t)
    372                (values buffer-pn nil)))
    373           (buffer-pn-date (values buffer-pn nil))
    374           (t (values nil nil)))))
    375 
    376 
    377 
    378357
    379358;;;; Find file.
    380359
    381360
    382 (defcommand "Find File" (p &optional pathname)
     361(defcommand "Find File" (p)
    383362  "Visit a file in its own buffer.
    384363   If the file is already in some buffer, select that buffer,
    385364   otherwise make a new buffer with the same name as the file and
    386365   read the file into it."
    387   "Make a buffer containing the file Pathname current, creating a buffer
    388    if necessary.  The buffer is returned."
    389   (if pathname
    390     (old-find-file-command p pathname)
    391     (hi::open-document)))
     366  (hi::open-document))
    392367 
    393368
    394 
     369#|
    395370(defun find-file-buffer (pathname)
    396   "Return a buffer assoicated with the file Pathname, reading the file into a
     371  "Return a buffer associated with the file Pathname, reading the file into a
    397372   new buffer if necessary.  The second value is T if we created a buffer, NIL
    398373   otherwise.  If the file has already been read, we check to see if the file
     
    433408           (read-buffer-file pathname found)
    434409           (values found nil)))))
    435 
     410|#
    436411
    437412;;; Check-Disk-Version-Consistent  --  Internal
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/htext1.lisp

    r7993 r8207  
    478478      column)))
    479479
     480(defun move-to-column (mark column &optional (line (mark-line mark)))
     481  (let ((tab-spaces (value hemlock::spaces-per-tab)))
     482    (multiple-value-bind (chars gap-start gap-end end-pos)
     483                         (if (current-open-line-p line)
     484                           (values (current-open-chars)
     485                                   (current-left-open-pos)
     486                                   (current-right-open-pos)
     487                                   (current-line-cache-length))
     488                           (values (line-%chars line)
     489                                   0
     490                                   0
     491                                   (length (line-%chars line))))
     492      (loop with col = 0 with pos = 0
     493        do (when (eql pos gap-start) (setq pos gap-end))
     494        while (and (< pos end-pos) (< col column))
     495        do (incf col (if (eql (schar chars pos) #\tab)
     496                           (- tab-spaces (mod col tab-spaces))
     497                           1))
     498        do (incf pos)
     499        finally (return (unless (< col column)
     500                          (move-to-position mark pos line)))))))
     501
    480502
    481503
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/interp.lisp

    r8062 r8207  
    381381    result))
    382382
     383(defvar *key-event-history* (make-ring 60))
    383384
    384385;;; LAST-COMMAND-TYPE  --  Public
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/isearchcoms.lisp

    r7913 r8207  
    1515  :value "I-Search Self Insert"
    1616  :mode "I-Search")
    17 
    18 (defhvar "I-Search State"
    19   "Internal variable containing current state of I-Search"
    20   :mode "I-Search")
    21 
    22 (defun current-isearch-state ()
    23   (or (value i-search-state)
    24       (error "I-Search command invoked outside I-Search")))
    2517
    2618(defcommand "Incremental Search" (p)
     
    129121;;
    130122
     123(defun current-isearch-state ()
     124  (or (value i-search-state)
     125      (error "I-Search command invoked outside I-Search")))
     126
    131127(defun start-isearch-mode (direction)
    132   (setf (buffer-minor-mode (current-buffer) "I-Search") t)
    133   (let* ((iss (make-isearch-state :direction direction
     128  (let* ((buffer (current-buffer))
     129         (iss (make-isearch-state :direction direction
    134130                                  :start-region (current-region-info))))
     131    (setf (buffer-minor-mode buffer "I-Search") t)
     132    (unless (hemlock-bound-p 'i-search-state :buffer buffer)
     133      (defhvar "I-Search State"
     134        "Internal variable containing current state of I-Search"
     135        :buffer buffer))
    135136    (push-new-buffer-mark (current-point))
    136137    (setf (value i-search-state) iss)
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/key-event.lisp

    r7993 r8207  
    463463(defvar *key-events*)
    464464
    465 ;;; GET-KEY-EVENT -- Internal.
     465;;; GET-KEY-EVENT* -- Internal.
    466466;;;
    467467;;; This finds the key-event specified by keysym and bits.  If the key-event
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/macros.lisp

    r8062 r8207  
    557557(declaim (special *random-typeout-ml-fields* *buffer-names*))
    558558
    559 (defvar *random-typeout-buffers* () "A list of random-typeout buffers.")
    560 
    561 
    562559
    563560
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/main.lisp

    r8055 r8207  
    8282;;;; DEFINE-SOME-VARIABLES.
    8383
    84 ;;; This is necessary to define "Default Status Line Fields" which belongs
    85 ;;; beside the other modeline variables.  This DEFVAR would live in
    86 ;;; Morecoms.Lisp, but it is compiled and loaded after this file.
    87 ;;;
    88 (declaim (special hemlock::*recursive-edit-count*))
    89 ;;;
    90 (make-modeline-field
    91  :name :edit-level :width 15
    92  :function #'(lambda (buffer)
    93                (declare (ignore buffer))
    94                (if (zerop hemlock::*recursive-edit-count*)
    95                    ""
    96                    (format nil "Edit Level: ~2,'0D "
    97                            hemlock::*recursive-edit-count*))))
    98 
    99 ;;; This is necessary to define "Default Status Line Fields" which belongs
    100 ;;; beside the other modeline variables.  This DEFVAR would live in
    101 ;;; Completion.Lisp, but it is compiled and loaded after this file.
    102 ;;;
    103 (make-modeline-field
    104  :name :completion :width 40
    105  :function #'(lambda (buffer)
    106                (declare (special hemlock::*completion-mode-possibility*))
    107                (declare (ignore buffer))
    108                hemlock::*completion-mode-possibility*))
    109 
    110 
    11184(defun define-some-variables ()
    11285  (defhvar "Default Modes"
    11386    "This variable contains the default list of modes for new buffers."
    11487    :value '("Fundamental"))
    115   (defhvar "Echo Area Height"
    116     "Number of lines in the echo area window."
    117     :value 3)
    11888  (defhvar "Make Buffer Hook"
    11989    "This hook is called with the new buffer whenever a buffer is created.")
     
    142112  (defhvar "Buffer Package Hook"
    143113      "This hook is called with the new package name whenever a (Lisp) buffer's package changes")
    144   (defhvar "Set Window Hook"
    145     "This hook is called with the new window when the current window
    146      is set.")
    147   (defhvar "Make Window Hook"
    148     "This hook is called with a new window when one is created.")
    149   (defhvar "Delete Window Hook"
    150     "This hook is called with a window before it is deleted.")
    151   (defhvar "Window Buffer Hook"
    152     "This hook is invoked with the window and new buffer when a window's
    153      buffer is changed.")
    154114  (defhvar "Delete Variable Hook"
    155115    "This hook is called when a variable is deleted with the args to
    156116     delete-variable.")
    157   (defhvar "Entry Hook"
    158     "this hook is called when the editor is entered.")
    159   (defhvar "Exit Hook"
    160     "This hook is called when the editor is exited.")
    161   (defhvar "Redisplay Hook"
    162     "This is called on the current window from REDISPLAY after checking the
    163      window display start, window image, and recentering.  After calling the
    164      functions in this hook, we do the above stuff and call the smart
    165      redisplay method for the device."
    166     :value nil)
    167117  (defhvar "Key Echo Delay"
    168118    "Wait this many seconds before echoing keys in the command loop.  This
     
    188138    "This hook is called when a mode character attribute is deleted.")
    189139  (defhvar "Default Modeline Fields"
    190     "The default list of modeline-fields for MAKE-WINDOW."
     140    "The default list of modeline-fields for MAKE-BUFFER."
    191141    :value *default-modeline-fields*)
    192   (defhvar "Default Status Line Fields"
    193     "This is the default list of modeline-fields for the echo area window's
    194      modeline which is used for general information."
    195     :value (list (make-modeline-field
    196                   :name :hemlock-banner :width 27
    197                   :function #'(lambda (buffer)
    198                                 (declare (ignore buffer))
    199                                 (format nil "Hemlock ~A  "
    200                                         *hemlock-version*)))
    201                  (modeline-field :edit-level)
    202                  (modeline-field :completion)))
    203142  (defhvar "Maximum Modeline Pathname Length"
    204143    "When set, this variable is the maximum length of the display of a pathname
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/modeline.lisp

    r8062 r8207  
    140140                        (format nil "~A: " name))
    141141                       (t "")))))
     142
     143(make-modeline-field
     144 :name :completion :width 40
     145 :function #'(lambda (buffer)
     146               (declare (special hemlock::*completion-mode-possibility*))
     147               (declare (ignore buffer))
     148               hemlock::*completion-mode-possibility*))
     149
     150
    142151
    143152
     
    216225
    217226(defun note-modeline-change (buffer &rest more)
    218   (declare (ignore more))
     227  (declare (ignore more)) ;; used as hooks some of which pass more info
    219228  (hemlock-ext:invalidate-modeline buffer))
     229
     230;; Public version
     231(defun update-modeline-fields (buffer)
     232  (note-modeline-change buffer))
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/morecoms.lisp

    r7993 r8207  
    376376             char abspos size (round (/ (* 100 abspos) size)) line-number charpos)))
    377377
    378 ;;;; Page commands & stuff.
    379 
    380 (defvar *goto-page-last-num* 0)
    381 (defvar *goto-page-last-string* "")
    382 
    383 (defcommand "Goto Page" (p)
    384   "Go to an absolute page number (argument).  If no argument, then go to
    385   next page.  A negative argument moves back that many pages if possible.
    386   If argument is zero, prompt for string and goto page with substring
    387   in title."
    388   "Go to an absolute page number (argument).  If no argument, then go to
    389   next page.  A negative argument moves back that many pages if possible.
    390   If argument is zero, prompt for string and goto page with substring
    391   in title."
    392   (let ((point (current-point)))
    393     (cond ((not p)
    394            (page-offset point 1))
    395           ((zerop p)
    396            (let* ((againp (eq (last-command-type) :goto-page-zero))
    397                   (name (prompt-for-string :prompt "Substring of page title: "
    398                                            :default (if againp
    399                                                         *goto-page-last-string*)))
    400                   (dir (page-directory (current-buffer)))
    401                   (i 1))
    402              (declare (simple-string name))
    403              (cond ((not againp)
    404                     (push-new-buffer-mark point))
    405                    ((string-equal name *goto-page-last-string*)
    406                     (setf dir (nthcdr *goto-page-last-num* dir))
    407                     (setf i (1+ *goto-page-last-num*))))
    408              (loop
    409                (when (null dir)
    410                  (editor-error "No page title contains ~S." name))
    411                (when (search name (the simple-string (car dir))
    412                              :test #'char-equal)
    413                  (goto-page point i)
    414                  (setf (last-command-type) :goto-page-zero)
    415                  (setf *goto-page-last-num* i)
    416                  (setf *goto-page-last-string* name)
    417                  (return t))
    418                (incf i)
    419                (setf dir (cdr dir)))))
    420             ((minusp p)
    421              (page-offset point p))
    422             (t (goto-page point p)))
    423     (set-scroll-position :line point)))
    424 
    425 (defun goto-page (mark i)
    426   (with-mark ((m mark))
    427     (buffer-start m)
    428     (unless (page-offset m (1- i))
    429       (editor-error "No page numbered ~D." i))
    430     (move-mark mark m)))
    431 
    432                            
    433 
    434 
    435378(defcommand "Count Lines" (p)
    436379  "Display number of lines in the region."
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/package.lisp

    r7993 r8207  
    44  (:use)
    55  (:export
    6    ;; Functions from the CIM:
     6   ;; Symbols from the CIM, by chapter:
     7
     8   ;; Representation of Text
    79   #:linep
    810   #:line-string
     
    2527   #:copy-mark
    2628   #:delete-mark
     29   #:with-mark
    2730   #:move-to-position
    2831   #:move-to-absolute-position
     
    4952   #:count-lines
    5053   #:count-characters
     54
     55   ;; Buffers
    5156   #:current-buffer
    5257   #:current-point-for-insertion
     
    6065   #:push-buffer-mark
    6166   #:push-new-buffer-mark
    62    #:change-to-buffer
     67   #:all-buffers
    6368   #:make-buffer
    6469   #:bufferp
     
    7984   #:buffer-package
    8085   #:delete-buffer
     86   #:with-writable-buffer
    8187   #:make-modeline-field
    8288   #:modeline-field-p
     
    8793   #:buffer-modeline-fields
    8894   #:buffer-modeline-field-p
    89    #:update-modeline-field
     95   #:update-modeline-fields
     96
     97   ;; Altering and Searching Text
    9098   #:insert-character
    9199   #:insert-string
     
    118126   #:kill-region
    119127   #:kill-characters
     128   #:*ephemerally-active-command-types*
    120129   #:activate-region
    121130   #:deactivate-region
     
    128137   #:find-pattern
    129138   #:replace-pattern
     139   #:*last-search-string*
     140
     141   ;; Hemlock Variables
     142   #:*global-variable-names*
    130143   #:current-variable-tables
    131144   #:defhvar
     
    135148   #:variable-name
    136149   #:string-to-variable
     150   #:value
     151   #:setv
     152   #:hlet
    137153   #:hemlock-bound-p
    138154   #:delete-variable
     155   #:add-hook
     156   #:remove-hook
     157   #:invoke-hook
     158
     159   ;; Commands
     160   #:*command-names*
     161   #:defcommand
    139162   #:make-command
    140163   #:commandp
     
    148171   #:map-bindings
    149172   #:key-translation
    150    #:interactive
    151173   #:last-command-type
    152174   #:prefix-argument
    153    #:recursive-edit
    154    #:in-recursive-edit
    155    #:exit-recursive-edit
    156    #:abort-recursive-edit
     175
     176   ;; Modes
     177   #:*mode-names*
    157178   #:defmode
    158179   #:mode-documentation
     
    161182   #:mode-variables
    162183   #:mode-major-p
     184
     185   ;; Character attributes
     186   #:*character-attribute-names*
    163187   #:defattribute
    164188   #:character-attribute-name
     
    173197   #:reverse-find-not-attribute
    174198   #:character-attribute-hooks
    175    #:make-window
    176    #:delete-window
    177    #:next-window
    178    #:previous-window
    179    #:show-mark
    180    #:redisplay
    181    #:redisplay-all
    182    #:editor-finish-output
     199
     200   ;; Controlling the Display
     201   #:current-view
     202   #:hemlock-view-p
     203   #:hemlock-view-buffer
     204   #:mark-column
     205   #:move-to-column
     206   #:set-scroll-position
     207
     208   ;; Logical Key Events
     209   #:*logical-key-event-names*
    183210   #:define-logical-key-event
    184211   #:logical-key-event-key-events
     
    186213   #:logical-key-event-documentation
    187214   #:logical-key-event-p
     215
     216   ;; The Echo Area
    188217   #:clear-echo-area
    189218   #:message
    190219   #:loud-message
     220   #:beep
     221   #:command-case
    191222   #:prompt-for-buffer
    192223   #:prompt-for-key-event
     
    200231   #:prompt-for-y-or-n
    201232   #:prompt-for-yes-or-no
     233   #:parse-for-something
     234
     235   ;; Files
     236   #:define-file-option
     237   #:define-file-type-hook
    202238   #:process-file-options
    203239   #:pathname-to-buffer-name
     
    207243   #:write-buffer-file
    208244   #:read-buffer-file
    209    #:find-file-buffer
     245  ;; #:find-file-buffer
     246
     247   ;;# Hemlock's Lisp Environment
    210248   ;;   #:ed
    211    #:pause-hemlock
    212    #:clear-editor-input
     249   #:*key-event-history*
     250   #:last-key-event-typed
     251   #:last-char-typed
    213252   #:make-hemlock-output-stream
    214253   #:hemlock-output-stream-p
    215254   #:make-hemlock-region-stream
    216255   #:hemlock-region-stream-p
    217    #:editor-error-format-string
    218    #:editor-error-format-arguments
     256   #:with-input-from-region
     257   #:with-output-to-mark
     258   #:with-pop-up-display
    219259   #:editor-error
    220    #:add-definition-dir-translation
    221    #:delete-definition-dir-translation
    222    #:schedule-event
    223    #:remove-scheduled-event
     260   #:handle-lisp-errors
    224261   #:in-lisp
     262   #:do-alpha-chars
     263
     264   ;; Higher-Level Text Primitives
    225265   #:indent-region
    226266   #:indent-region-for-commands
     
    241281   #:paragraph-offset
    242282   #:mark-paragraph
    243    #:goto-page
    244    #:page-offset
    245    #:page-directory
    246    #:display-page-directory
    247283   #:fill-region
    248284   #:fill-region-by-paragraphs
     285
     286   ;; Utilities
    249287   #:make-string-table
    250288   #:string-table-p
     
    256294   #:find-ambiguous
    257295   #:find-containing
     296   #:do-strings
    258297   #:make-ring
    259298   #:ringp
     
    265304   #:save-for-undo
    266305   #:make-region-undo
    267    #:supply-generic-pointer-up-function
    268 
    269    ;; Macros from the CIM:
    270    #:with-writable-buffer
    271    #:value
    272    #:setv
    273    #:add-hook
    274    #:remove-hook
    275    #:invoke-hook
    276    #:defcommand
    277    #:use-buffer
    278    #:command-case
    279    #:define-file-option
    280    #:define-file-type-hook
    281    #:do-active-group
    282    #:with-input-from-region
    283    #:with-output-to-mark
    284    #:with-pop-up-display
    285    #:handle-lisp-errors
    286    #:do-alpha-chars
    287    #:do-strings
    288    
     306
     307   ;; Miscellaneous
     308
     309   #:define-keysym
     310   #:define-keysym-code
     311   #:define-mouse-keysym
     312   #:name-keysym
     313   #:keysym-names
     314   #:keysym-preferred-name
     315   #:define-key-event-modifier
     316   #:*all-modifier-names*
     317   #:make-key-event-bits
     318   #:key-event-modifier-mask
     319   #:key-event-bits-modifiers
     320   #:make-key-event
     321   #:key-event-p
     322   #:key-event-bits
     323   #:key-event-keysym
     324   #:char-key-event
     325   #:key-event-char
     326   #:key-event-bit-p
     327   #:do-alpha-key-events
     328   #:pretty-key-string
    289329   ))
    290330
     
    312352   #:send-string-to-listener
    313353   #:buffer-process-description
     354   #:raise-buffer-view
    314355   ))
    315356
     
    365406
    366407   ;; rompsite.lisp
    367    #:show-mark #:fun-defined-from-pathname
    368    #:editor-describe-function #:pause-hemlock #:store-cut-string
    369    #:fetch-cut-string #:schedule-event #:remove-scheduled-event
    370    #:enter-window-autoraise #:directoryp #:merge-relative-pathnames
     408   #:editor-describe-function
     409   #:merge-relative-pathnames
    371410   ;;
    372411   ;; Export default-font to prevent a name conflict that occurs due to
     
    377416
    378417   ;;
    379    #:mark #:mark-line #:mark-charpos #:mark-column #:markp #:region #:region-start #:region-end
     418   #:mark #:mark-line #:mark-charpos #:mark-column #:move-to-column
     419   #:markp #:region #:region-start #:region-end
    380420   #:regionp #:buffer #:bufferp #:buffer-modes #:buffer-point #:buffer-writable
    381421   #:buffer-delete-hook #:buffer-variables #:buffer-write-date
     
    384424   #:command-documentation #:modeline-field #:modeline-field-p
    385425
    386    ;; from input.lisp
    387    #:clear-editor-input
    388    #:*key-event-history* #:input-waiting
    389 
    390426   ;; from macros.lisp
    391427   #:invoke-hook #:value #:setv #:hlet #:string-to-variable #:add-hook #:remove-hook
     
    393429   #:editor-error-format-string #:editor-error-format-arguments #:do-strings
    394430   #:command-case #:reprompt #:with-output-to-mark #:with-input-from-region
    395    #:handle-lisp-errors #:with-pop-up-display #:*random-typeout-buffers*
     431   #:handle-lisp-errors #:with-pop-up-display
    396432
    397433   ;; from views.lisp
     
    415451   #:delete-string #:clrstring #:do-strings
    416452
    417    ;; bit-display.lisp
    418    #:redisplay #:redisplay-all
    419 
    420    ;; bit-screen.lisp
    421    #:make-xwindow-like-hwindow #:*create-window-hook* #:*delete-window-hook*
    422    #:*random-typeout-hook* #:*create-initial-windows-hook*
    423 
    424453   ;; buffer.lisp
    425454   #:buffer-modified #:buffer-region #:buffer-name #:buffer-pathname
    426455   #:buffer-major-mode #:buffer-minor-mode #:buffer-modeline-fields
    427456   #:buffer-modeline-field-p #:current-buffer #:current-point
    428    #:in-recursive-edit #:exit-recursive-edit #:abort-recursive-edit
    429    #:recursive-edit #:defmode #:mode-major-p #:mode-variables #:mode-documentation
     457   #:defmode #:mode-major-p #:mode-variables #:mode-documentation
    430458   #:make-buffer #:delete-buffer #:with-writable-buffer #:buffer-start-mark
    431459   #:buffer-end-mark #:*buffer-list*
     
    440468   #:key-event-modifier-mask #:key-event-char #:key-event-bit-p
    441469   #:pretty-key-string
    442 
    443    ;; display.lisp
    444    #:redisplay #:redisplay-all
    445470
    446471   ;; echo.lisp
     
    512537   #:after-editor-initializations
    513538
    514    ;; screen.lisp
    515    #:make-window #:delete-window #:next-window #:previous-window
    516 
    517 
    518539   ;; search1.lisp
    519540   #:search-pattern #:search-pattern-p #:find-pattern #:replace-pattern
    520541   #:new-search-pattern
    521542
     543   ;; modeline.lisp
     544   #:modeline-field-width
     545   #:modeline-field-function #:make-modeline-field
     546   #:update-modeline-field #:modeline-field-name #:modeline-field
    522547
    523548   ;; streams.lisp
     
    538563   #:hemlock-bound-p #:defhvar #:delete-variable
    539564
    540    ;; window.lisp
    541    #:modeline-field-width
    542    #:modeline-field-function #:make-modeline-field
    543    #:update-modeline-field #:modeline-field-name #:modeline-field
    544    #:editor-finish-output
    545 
    546565   ))
    547566
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/register.lisp

    r7993 r8207  
    107107(defcommand "Save Position" (p)
    108108  "Saves the current location in a register.  Prompts for register name."
    109   "Saves the current location in a register.  Prompts for register name."
    110109  (declare (ignore p))
    111110  (let ((reg-name (prompt-for-register)))
     
    115114(defcommand "Jump to Saved Position" (p)
    116115  "Moves the point to a location previously saved in a register."
    117   "Moves the point to a location previously saved in a register."
    118116  (declare (ignore p))
    119117  (let* ((reg-name (prompt-for-register "Jump to Register: " t))
     
    121119    (unless (markp val)
    122120      (editor-error "Register ~A does not hold a location." reg-name))
    123     (change-to-buffer (mark-buffer val))
    124     (move-mark (current-point) val)))
     121    (unless (eq (mark-buffer val) (current-buffer))
     122      (hemlock-ext:raise-buffer-view (mark-buffer val)
     123                                     #'(lambda ()
     124                                         (move-mark (current-point) val))))))
    125125
    126126(defcommand "Kill Register" (p)
    127   "Kill a regist er.  Prompts for the name."
    128127  "Kill a register.  Prompts for the name."
    129128  (declare (ignore p))
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/rompsite.lisp

    r8029 r8207  
    1515
    1616(in-package :hi)
    17 
    18 ;;;; SITE-INIT.
    19 
    20 ;;; *key-event-history* is defined in input.lisp, but it needs to be set in
    21 ;;; SITE-INIT, since MAKE-RING doesn't exist at load time for this file.
    22 ;;;
    23 (declaim (special *key-event-history*))
    2417
    2518;;; SITE-INIT  --  Internal
     
    6356    "Paints white on black in window bodies, black on white in modelines."
    6457    :value nil)
    65   (defhvar "Enter Window Hook"
    66     "When the mouse enters an editor window, this hook is invoked.  These
    67      functions take the Hemlock Window as an argument."
    68     :value nil)
    69   (defhvar "Exit Window Hook"
    70     "When the mouse exits an editor window, this hook is invoked.  These
    71      functions take the Hemlock Window as an argument."
    72     :value nil)
    73   (defhvar "Set Window Autoraise"
    74     "When non-nil, setting the current window will automatically raise that
    75      window via a function on \"Set Window Hook\".  If the value is :echo-only
    76      (the default), then only the echo area window will be raised
    77      automatically upon becoming current."
    78     :value :echo-only)
    7958  (defhvar "Default Font"
    8059    "The string name of the font to be used for Hemlock -- buffer text,
     
    9473     a ruler in the bottom border of the window."
    9574    :value t)
    96 
    97   (setf *key-event-history* (make-ring 60))
    9875  nil)
    9976
     
    11592   directory."
    11693  (let ((pathname (merge-pathnames pathname default-directory)))
    117     (if (directoryp pathname)
     94    (if (ccl:directory-pathname-p pathname)
    11895        pathname
    11996        (pathname (concatenate 'simple-string
    12097                               (namestring pathname)
    12198                               "/")))))
    122 
    123 (defun directoryp (pathname)
    124   "Returns whether pathname names a directory, that is whether it has no
    125    name and no type components."
    126   (not (or (pathname-name pathname) (pathname-type pathname))))
    127 
    128 
    12999
    130100
     
    161131
    162132
    163 
    164 ;;;; Event scheduling.
    165 
    166 ;;; The time queue provides a ROUGH mechanism for scheduling events to
    167 ;;; occur after a given amount of time has passed, optionally repeating
    168 ;;; using the given time as an interval for rescheduling.  When the input
    169 ;;; loop goes around, it will check the current time and process all events
    170 ;;; that should have happened before or at this time.  The function gets
    171 ;;; called on the number of seconds that have elapsed since it was last
    172 ;;; called.
    173 ;;;
    174 ;;; NEXT-SCHEDULED-EVENT-WAIT and INVOKE-SCHEDULED-EVENTS are used in the
    175 ;;; editor stream in methods.
    176 ;;;
    177 ;;; SCHEDULE-EVENT and REMOVE-SCHEDULED-EVENT are exported interfaces.
    178 
    179 (defstruct (tq-event (:print-function print-tq-event)
    180                      (:constructor make-tq-event
    181                                    (time last-time interval function)))
    182   time          ; When the event should happen.
    183   last-time     ; When the event was scheduled.
    184   interval      ; When non-nil, how often the event should happen.
    185   function)     ; What to do.
    186 
    187 (defun print-tq-event (obj stream n)
    188   (declare (ignore n))
    189   (format stream "#<Tq-Event ~S>" (tq-event-function obj)))
    190 
    191 (defvar *time-queue* nil
    192   "This is the time priority queue used in Hemlock input streams for event
    193    scheduling.")
    194 
    195 ;;; QUEUE-TIME-EVENT inserts event into the time priority queue *time-queue*.
    196 ;;; Event is inserted before the first element that it is less than (which
    197 ;;; means that it gets inserted after elements that are the same).
    198 ;;; *time-queue* is returned.
    199 ;;;
    200 (defun queue-time-event (event)
    201   (let ((time (tq-event-time event)))
    202     (if *time-queue*
    203         (if (< time (tq-event-time (car *time-queue*)))
    204             (push event *time-queue*)
    205             (do ((prev *time-queue* rest)
    206                  (rest (cdr *time-queue*) (cdr rest)))
    207                 ((or (null rest)
    208                      (< time (tq-event-time (car rest))))
    209                  (push event (cdr prev))
    210                  *time-queue*)))
    211         (push event *time-queue*))))
    212 
    213 ;;; NEXT-SCHEDULED-EVENT-WAIT returns nil or the number of seconds to wait for
    214 ;;; the next event to happen.
    215 ;;;
    216 (defun next-scheduled-event-wait ()
    217   (if *time-queue*
    218       (let ((wait (round (- (tq-event-time (car *time-queue*))
    219                             (get-internal-real-time))
    220                          internal-time-units-per-second)))
    221         (if (plusp wait) wait 0))))
    222 
    223 ;;; INVOKE-SCHEDULED-EVENTS invokes all the functions in *time-queue* whose
    224 ;;; time has come.  If we run out of events, or there are none, then we get
    225 ;;; out.  If we popped an event whose time hasn't come, we push it back on the
    226 ;;; queue.  Each function is called on how many seconds, roughly, went by since
    227 ;;; the last time it was called (or scheduled).  If it has an interval, we
    228 ;;; re-queue it.  While invoking the function, bind *time-queue* to nothing in
    229 ;;; case the event function tries to read off *editor-input*.
    230 ;;;
    231 (defun invoke-scheduled-events ()
    232   (let ((time (get-internal-real-time)))
    233     (loop
    234       (unless *time-queue* (return))
    235       (let* ((event (car *time-queue*))
    236              (event-time (tq-event-time event)))
    237         (cond ((>= time event-time)
    238                (let ((*time-queue* nil))
    239                  (funcall (tq-event-function event)
    240                           (round (- time (tq-event-last-time event))
    241                                  internal-time-units-per-second)))
    242                (without-interrupts
    243                 (let ((interval (tq-event-interval event)))
    244                   (when interval
    245                     (setf (tq-event-time event) (+ time interval))
    246                     (setf (tq-event-last-time event) time)
    247                     (pop *time-queue*)
    248                     (queue-time-event event)))))
    249               (t (return)))))))
    250 
    251 (defun schedule-event (time function &optional (repeat t))
    252   "This causes function to be called after time seconds have passed,
    253    optionally repeating every time seconds.  This is a rough mechanism
    254    since commands can take an arbitrary amount of time to run; the function
    255    will be called at the first possible moment after time has elapsed.
    256    Function takes the time that has elapsed since the last time it was
    257    called (or since it was scheduled for the first invocation)."
    258   (let ((now (get-internal-real-time))
    259         (itime (* internal-time-units-per-second time)))
    260     (queue-time-event (make-tq-event (+ itime now) now (if repeat itime)
    261                                      function))))
    262 
    263 (defun remove-scheduled-event (function)
    264   "Removes function queued with SCHEDULE-EVENT."
    265   (setf *time-queue* (delete function *time-queue* :key #'tq-event-function)))
    266 
    267 
    268 ;;;; Function description and defined-from.
    269 
    270 ;;; FUN-DEFINED-FROM-PATHNAME takes a symbol or function object.  It
    271 ;;; returns a pathname for the file the function was defined in.  If it was
    272 ;;; not defined in some file, then nil is returned.
    273 ;;;
    274 (defun fun-defined-from-pathname (function)
    275   "Takes a symbol or function and returns the pathname for the file the
    276    function was defined in.  If it was not defined in some file, nil is
    277    returned."
    278   (flet ((true-namestring (path) (namestring (truename path))))
    279     (typecase function
    280       (function (fun-defined-from-pathname (ccl:function-name function)))
    281       (symbol (let* ((info (ccl::%source-files function)))
    282                 (if (atom info)
    283                   (true-namestring info)
    284                   (let* ((finfo (assq 'function info)))
    285                     (when finfo
    286                       (true-namestring
    287                        (if (atom finfo)
    288                          finfo
    289                          (car finfo)))))))))))
    290 
    291 
    292133(defvar *editor-describe-stream*
    293134  #+CMU (system:make-indenting-stream *standard-output*)
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/searchcoms.lisp

    r7922 r8207  
    102102(add-hook abort-hook 'abort-query/replace-mode)
    103103
    104 (defhvar "Query/Replace State"
    105   "Internal variable containing current state of Query/Replace"
    106   :mode "Query/Replace")
    107 
    108 (defun current-query-replace-state ()
    109   (or (value query/replace-state)
    110       (error "Query/Replace command invoked outside Query Replace")))
    111 
    112104(defhvar "Case Replace"
    113105  "If this is true then \"Query Replace\" will try to preserve case when
     
    131123    (query/replace-finish qrs)))
    132124
     125(defun current-query-replace-state ()
     126  (or (value query/replace-state)
     127      (error "Query/Replace command invoked outside Query Replace")))
     128
    133129(defcommand "Query Replace" (p &optional
    134130                               (target (prompt-for-string
     
    142138   from the keyboard is given.  If the region is active, limit queries to
    143139   occurrences that occur within it, otherwise use point to end of buffer."
    144   (let ((qrs (query/replace-init :count p :target target :replacement replacement
    145                                  :undo-name "Query Replace")))
     140  (let* ((buffer (current-buffer))
     141         (qrs (query/replace-init :count p :target target :replacement replacement
     142                                  :undo-name "Query Replace")))
    146143    (setf (buffer-minor-mode (current-buffer) "Query/Replace") t)
     144    (unless (hemlock-bound-p 'query/replace-state :buffer buffer)
     145      (defhvar "Query/Replace State"
     146        "Internal variable containing current state of Query/Replace"
     147        :buffer buffer))
    147148    (setf (value query/replace-state) qrs)
    148149    (query/replace-find-next qrs)))
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/struct.lisp

    r8062 r8207  
    120120  )
    121121
     122(defstruct (echo-buffer (:include buffer)
     123                        (:constructor internal-make-echo-buffer))
     124  )
    122125
    123126(defstruct (font-region-node (:include ccl::dll-node)
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/views.lisp

    r8062 r8207  
    5555   ))
    5656
     57(defun hemlock-view-p (object)
     58  (typep object 'hemlock-view))
     59
    5760(defmethod initialize-instance ((view hemlock-view) &key)
    5861  (call-next-method)
     
    7982;; This handles errors in event handling.  It assumes it's called in a normal
    8083;; event handling context for some view.
    81 (defun lisp-error-error-handler (condition)
     84(defun lisp-error-error-handler (condition &key debug-p)
    8285  (with-standard-standard-output
    8386    (handler-case
    8487        (progn
    85           (hemlock-ext:report-hemlock-error (current-view) condition)
     88          (hemlock-ext:report-hemlock-error (current-view) condition debug-p)
    8689          (let ((emsg (ignore-errors (princ-to-string condition))))
    8790            (abort-to-toplevel (or emsg "Error"))))
     
    186189                          (get-command-binding-for-key view key)
    187190       #+gz (log-debug "~&  binding ~s ~s" main-binding transparent-bindings)
     191       (ring-push key *key-event-history*)
    188192       (when main-binding
    189193         (let* ((*last-last-command-type* (shiftf (hemlock-last-command-type view) nil))
     
    222226  "Set the desired scroll position of the current view"
    223227  (when (markp where)
     228    (unless (eq (mark-buffer where)
     229                (hemlock-view-buffer (current-view)))
     230      (error "~s is not a mark in the current view." where))
    224231    (setq where (mark-absolute-position where)))
    225232  (setf *next-view-start* (cons how where)))
     
    248255        (modifying-buffer-storage (*current-buffer*)
    249256          (restart-case
    250               (handler-bind ((error #'lisp-error-error-handler))
     257              (handler-bind ((error #'(lambda (c)
     258                                        (lisp-error-error-handler c :debug-p t))))
    251259                (execute-hemlock-key view key))
    252260            (exit-event-handler () :report "Exit from hemlock event handler")))
Note: See TracChangeset for help on using the changeset viewer.