source: trunk/cocoa-ide-contrib/foy/list-definitions/history-lists.lisp @ 14985

Last change on this file since 14985 was 14985, checked in by gfoy, 9 years ago

Updates for ccl 1.7

File size: 25.7 KB
Line 
1;;;-*- Mode: Lisp; Package: LIST-DEFINITIONS -*-
2
3;;; ----------------------------------------------------------------------------
4;;;
5;;;      history-lists.lisp
6;;;
7;;;      copyright (c) 2009 Glen Foy
8;;;      (Permission is granted to Clozure Associates to distribute this file.)
9;;;
10;;;      This code supports file and position history lists.
11;;;
12;;;      Alt-Right-Click produces a most-recently-visited list of definition
13;;;      positions.  Alt-Command-Right-Click produces a most-recently-visited
14;;;      list of files.  Both lists are persistent and are stored here:
15;;;
16;;;      ~/Library/Preferences/org.clairvaux/list-definitions/file-history
17;;;      ~/Library/Preferences/org.clairvaux/list-definitions/position-history
18;;;
19;;;      This software is offered "as is", without warranty of any kind.
20;;;
21;;;      Mod History, most recent first:
22;;;      9/9/11  update for ccl 1.7
23;;;      8/17/9  version 0.2b1
24;;;              This file added.
25;;;
26;;; ----------------------------------------------------------------------------
27
28(in-package "LIST-DEFINITIONS")
29
30(defParameter *position-history-list-length* 25)
31(defParameter *file-history-list-length* 25)
32
33;;; This includes a work-around for what appears to be a bug in the hemlock-frame
34;;; #/close method.  After a #/close, the window remains on the (#/orderedWindows *NSApp*)
35;;; list, but (hi::buffer-document buffer) in NIL.  Therefore the extra tests:
36(defun window-with-path (path)
37  "If a window with PATH is open, return it."
38  (gui::first-window-satisfying-predicate 
39   #'(lambda (w)
40       (when (and (typep w 'gui::hemlock-frame)
41                  (not (typep w 'gui::hemlock-listener-frame)))
42         (let* ((pane (slot-value w 'gui::pane))
43                (text-view (gui::text-pane-text-view pane))
44                (buffer (gui::hemlock-buffer text-view))
45                (document (when buffer (hi::buffer-document buffer)))
46                (p (hi::buffer-pathname buffer)))
47           (when (and document p) (string-equal path p)))))))
48
49(defun maybe-open-file (path)
50  "If a window with PATH is open, return it.  Otherwise open a new window."
51  (let ((w (window-with-path path)))
52    (if w 
53      w
54      (let ((hemlock-view (gui::cocoa-edit path)))
55        (when hemlock-view (#/window (hi::hemlock-view-pane hemlock-view)))))))
56
57(defun construct-history-path (filename)
58  "Construct the path to the history file."
59    (merge-pathnames (concatenate 'string 
60                                  ";Library;Preferences;org.clairvaux;list-definitions;" 
61                                  filename)
62                     (hemlock::user-homedir-pathname)))
63
64(defun notify (message)
65  "FYI"
66  (gui::alert-window :title "Notification" :message message))
67
68;;; ----------------------------------------------------------------------------
69;;;
70(defClass HISTORY-LIST-ENTRY ()
71  ((name :initarg :name :reader hle-name)
72   (path :initarg :path :reader hle-path))
73  (:documentation "Support for the history lists.")) 
74
75;;; ----------------------------------------------------------------------------
76;;;
77(defClass POSITION-LIST-ENTRY (history-list-entry) 
78  ((info :initarg :info :reader hle-info))
79  (:documentation "Support for the position history list."))
80
81(defMethod show-entry ((entry position-list-entry))
82  "Display the file and scroll to position."
83  (let* ((name (hle-name entry))
84         (path (hle-path entry))
85         (window (window-with-path path))
86         mark def-list text-view hemlock-view)
87    (unless (probe-file path)
88      (notify (format nil "~a does not exist.  It will be deleted from the history lists."
89                      path))
90      (purge-file-references *position-history-list* path)
91      (remove-path *file-history-list* path)
92      (return-from show-entry nil))
93    (cond (window 
94           (setq hemlock-view (gui::hemlock-view window))
95           (setq text-view (gui::text-pane-text-view (hi::hemlock-view-pane hemlock-view))))
96          (t
97           (setq hemlock-view (gui::cocoa-edit path))
98           (when hemlock-view
99             (setq window (#/window (hi::hemlock-view-pane hemlock-view)))
100             (setq text-view (gui::text-pane-text-view (hi::hemlock-view-pane hemlock-view))))))
101    (when window
102      (#/makeKeyAndOrderFront: window nil)
103      (setq def-list (list-definitions window))
104      (setq mark (cdr (assoc name def-list 
105                             :test #'string-equal
106                             :key #'(lambda (def-info)
107                                      (let ((def-type (first def-info)))
108                                        (if (or (eq def-type :defmethod)
109                                                (eq def-type :objc))
110                                          (third def-info)
111                                          (second def-info)))))))
112      (cond (mark
113             (display-position text-view mark)
114             (move-entry-to-front *file-history-list* path) t)
115            (t 
116             (notify (format nil "Cannot find ~S.  It will be deleted from the position history list." 
117                             name))
118             (remove-entry *position-history-list* name) nil)))))
119
120;;; ----------------------------------------------------------------------------
121;;;
122(defClass FILE-LIST-ENTRY (history-list-entry) 
123  ((short-path :initarg :short-path :accessor hle-short-path))
124  (:documentation "Support for the file history list."))
125
126(defMethod show-entry ((entry file-list-entry))
127  (let ((path (hle-path entry)))
128    (unless (probe-file path)
129      (notify (format nil "~S does not exist.  It will be deleted from the history lists." path))
130      (purge-file-references *position-history-list* path)
131      (remove-path *file-history-list* path)
132      (return-from show-entry nil))
133    (let ((window (window-with-path path))) 
134      (unless window 
135        (let ((hemlock-view (gui::cocoa-edit path)))
136          (when hemlock-view 
137            (setq window (#/window (hi::hemlock-view-pane hemlock-view))))))
138      (when window
139        (#/makeKeyAndOrderFront: window nil) t))))
140
141;;; ----------------------------------------------------------------------------
142;;;
143(defClass HISTORY-LIST ()
144  ((capacity :initarg :capacity :reader hl-capacity)
145   (path :initarg :path :reader hl-path)
146   (list :initform nil :accessor hl-list))
147  (:documentation "Super class of position-history-list and file-history-list."))
148
149;;; ----------------------------------------------------------------------------
150;;;
151(defClass POSITION-HISTORY-LIST (history-list) 
152  ()
153  (:documentation "A persistent history list of most-recently-visited definition positions."))
154
155(setq *position-history-list* (make-instance 'position-history-list 
156                                :path (construct-history-path "position-history")
157                                :capacity *position-history-list-length*))
158
159(defMethod find-entry ((hl position-history-list) name)
160  (find-if  #'(lambda (entry) (string-equal name (hle-name entry)))
161            (hl-list hl)))
162
163(defMethod move-entry-to-front ((hl position-history-list) name)
164  (let ((entry (find-entry hl name)))
165    (when entry
166      (setf (hl-list hl) 
167            (cons entry (delete name (hl-list hl) :test #'string-equal :key #'hle-name)))
168      entry)))
169
170(defMethod purge-file-references ((hl position-history-list) path)
171  (setf (hl-list hl) (delete-if #'(lambda (entry)
172                                    (equal (hle-path entry) path))
173                                (hl-list hl))))
174
175(defMethod remove-entry ((hl position-history-list) name)
176  (setf (hl-list hl) (delete name (hl-list hl) :test #'string-equal :key #'hle-name)))
177
178(defMethod add-history-entry ((hl position-history-list) def-info path)
179  (let* ((def-type (first def-info))
180         (name (second def-info))
181         (signature (third def-info))
182         (entry (make-instance 'position-list-entry 
183                  :name (if (or (eq def-type :defmethod)
184                                (eq def-type :objc))
185                          signature
186                          name)
187                  :info def-info :path path)))
188    (setf (hl-list hl) (cons entry (hl-list hl)))
189    entry))
190
191(defMethod maybe-add-history-entry ((hl position-history-list) def-info path)
192  (let* ((def-type (first def-info))
193         (name (if (or (eq def-type :defmethod)
194                       (eq def-type :objc))
195                 (third def-info)
196                 (second def-info))))
197    (cond ((member name (hl-list hl) :test #'string-equal :key #'hle-name)
198           ;; it's there; move it to the front:
199           (move-entry-to-front hl name))
200          (t
201           (when (>= (length (hl-list hl)) (hl-capacity hl))
202             ;; bump the last entry, then add:
203             (setf (hl-list hl) (butlast (hl-list hl))))
204           (add-history-entry hl def-info path)))))
205
206(defun clear-position-history-list()
207  "Remove all the entries from the position history list."
208  (setf (hl-list *position-history-list*) nil))
209
210;;; ----------------------------------------------------------------------------
211;;;
212(defClass FILE-HISTORY-LIST (history-list) 
213  ()
214  (:documentation "A persistent history list of most-recently-visited files."))
215
216(setf *file-history-list* (make-instance 'file-history-list
217                            :path (construct-history-path "file-history")
218                            :capacity *file-history-list-length*))
219
220(defMethod find-entry ((hl file-history-list) path)
221  (find-if  #'(lambda (entry) (string-equal path (hle-path entry)))
222            (hl-list hl)))
223
224(defMethod move-entry-to-front ((hl file-history-list) path)
225  (let ((entry (find-entry hl path))) 
226    (when entry
227      (setf (hl-list hl) 
228            (cons entry (delete path (hl-list hl) :test #'string-equal :key #'hle-path)))
229      entry)))
230
231(defMethod remove-path ((hl file-history-list) path)
232  (setf (hl-list hl) (delete path (hl-list hl) 
233                             :test #'string-equal :key #'hle-path)))
234
235(defMethod add-history-entry ((hl file-history-list) name path)
236  (let* ((name-position (position #\/ path :test #'char= :from-end t))
237         (short-path (when name-position (subseq path 0 (incf name-position))))
238         (entry (when short-path (make-instance 'file-list-entry :name name 
239                                   :short-path short-path :path path))))
240    (when entry
241      (setf (hl-list hl) (cons entry (hl-list hl)))
242      entry)))
243
244(defMethod maybe-add-history-entry ((hl file-history-list) name path)
245  (cond ((member path (hl-list hl) :test #'string-equal :key #'hle-path)
246         (move-entry-to-front hl path))
247        (t 
248         (cond ((< (length (hl-list hl)) (hl-capacity hl))
249                (add-history-entry hl name path))
250               (t 
251                (setf (hl-list hl) (butlast (hl-list hl)))
252                (add-history-entry hl name path))))))
253
254(defun clear-file-history-list ()
255  "Remove all the entries from the file history list."
256  (setf (hl-list *file-history-list*) nil))
257
258;;; ----------------------------------------------------------------------------
259;;;
260(defClass POSITION-MENU-ITEM (ns:ns-menu-item)
261   ((path :accessor position-path)
262    (name :accessor position-name))
263  (:documentation "Support for the positions popup menu.")
264  (:metaclass ns:+ns-object))
265
266;;; ----------------------------------------------------------------------------
267;;;
268(defClass POSITIONS-MENU (ns:ns-menu)
269  ()
270  (:documentation "A popup menu of most-recently-visited definition positions.")
271  (:metaclass ns:+ns-object))
272
273;;; Pressing the shift key when selecting an entry will delete the entry:
274(objc:defmethod (#/positionHistoryAction: :void) ((m positions-menu) (sender :id))
275  (let ((entry (find-entry *position-history-list* (position-name sender))))
276    (when entry
277      (cond ((gui::current-event-modifier-p #$NSShiftKeyMask)
278             (remove-entry *position-history-list* (position-name sender)))
279            (t
280             (show-entry entry)
281             (move-entry-to-front *position-history-list* (position-name sender)))))))
282
283(objc:defmethod (#/clearPositionHistoryAction: :void) ((m positions-menu) (sender :id))
284  (declare (ignore sender))
285  (clear-position-history-list))
286
287(defun positions-context-menu ()
288  "Create the positions context menu."
289  (let* ((menu (make-instance 'positions-menu))
290         (class-icon (#/iconForFileType: (#/sharedWorkspace ns:ns-workspace) (ccl::%make-nsstring "lisp")))
291          menu-item)
292    (ns:with-ns-size (icon-size 16 16)
293      (#/setSize: class-icon icon-size))
294    (dolist (entry (hl-list *position-history-list*))
295      (let* ((def-info (hle-info entry))
296             (def-type (first def-info))
297             (name (second def-info))
298             (signature (third def-info))
299             (dictionary (case def-type
300                           (:defclass *defclass-dictionary*)
301                           (:defstruct *defstruct-dictionary*)
302                           (:defmethod *defmethod-dictionary*)
303                           (:defun *defun-dictionary*)
304                           (:defmacro *defmacro-dictionary*)
305                           (:objc *objc-dictionary*)
306                           (t *generic-dictionary*)))
307             (attributed-string (#/initWithString:attributes:
308                                 (#/alloc ns:ns-attributed-string) 
309                                 (if (or (eq def-type :defmethod)
310                                         (eq def-type :objc))
311                                   (ccl::%make-nsstring signature)
312                                   (ccl::%make-nsstring name))
313                                 dictionary)))
314        (setq menu-item (make-instance 'position-menu-item))
315        (setf (position-path menu-item) (hle-path entry))
316        (if (or (eq def-type :defmethod) (eq def-type :objc))
317          (setf (position-name menu-item) signature)
318          (setf (position-name menu-item) name))
319        (#/setAttributedTitle: menu-item attributed-string)
320        ;; Classes have a prepended CCL icon:
321        (when (eq def-type :defclass) (#/setImage: menu-item class-icon))
322        (#/setAction: menu-item (ccl::@selector "positionHistoryAction:"))
323        (#/setTarget: menu-item  menu)
324        (#/addItem: menu menu-item)))
325    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
326    (let ((attributed-string (#/initWithString:attributes:
327                              (#/alloc ns:ns-attributed-string)
328                              (ccl::%make-nsstring "Clear List")
329                              *generic-dictionary*)))
330      (setq menu-item (make-instance 'ns:ns-menu-item))
331      (#/setAttributedTitle: menu-item attributed-string)
332      (#/setTarget: menu-item menu)
333      (#/setAction: menu-item (ccl::@selector "clearPositionHistoryAction:"))
334      (#/addItem: menu menu-item))
335    menu))
336
337;;; ----------------------------------------------------------------------------
338;;;
339(defClass FILE-MENU-ITEM (ns:ns-menu-item)
340   ((path :accessor file-path)
341    (name :accessor file-name))
342  (:documentation "Support for the files popup menu.")
343  (:metaclass ns:+ns-object))
344
345;;; ----------------------------------------------------------------------------
346;;;
347(defClass FILE-MENU (ns:ns-menu)
348  ()
349  (:documentation "A popup menu of most-recently-visited files.")
350  (:metaclass ns:+ns-object))
351
352;;; Pressing the shift key when selecting an entry will delete the entry:
353(objc:defmethod (#/fileHistoryAction: :void) ((m file-menu) (sender :id))
354  (let ((entry (find-entry *file-history-list* (file-path sender))))
355    (when entry
356      (cond ((gui::current-event-modifier-p #$NSShiftKeyMask)
357             (remove-path *file-history-list* (file-path sender)))
358            (t
359             (show-entry entry)
360             (move-entry-to-front *file-history-list* (file-path sender)))))))
361
362(objc:defmethod (#/clearFileHistoryAction: :void) ((m file-menu) (sender :id))
363  (declare (ignore sender))
364  (clear-file-history-list))
365
366(defun files-context-menu ()
367  "Create the files context menu."
368  (let* ((menu (make-instance 'file-menu))
369          menu-item)
370    (dolist (entry (hl-list *file-history-list*))
371      (let ((attributed-string (#/initWithString:attributes:
372                                (#/alloc ns:ns-attributed-string) 
373                                (ccl::%make-nsstring 
374                                 (format nil "~A  ~A" 
375                                         (hle-name entry)
376                                         (hle-short-path entry)))
377                                *file-history-dictionary*)))
378        (setq menu-item (make-instance 'file-menu-item))
379        (setf (file-name menu-item) (hle-name entry))
380        (setf (file-path menu-item) (hle-path entry))
381        (#/setAttributedTitle: menu-item attributed-string)
382        (#/setAction: menu-item (ccl::@selector "fileHistoryAction:"))
383        (#/setTarget: menu-item  menu)
384        (#/addItem: menu menu-item)))
385    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
386    (let ((attributed-string (#/initWithString:attributes:
387                              (#/alloc ns:ns-attributed-string)
388                              (ccl::%make-nsstring "Clear List")
389                              *generic-dictionary*)))
390      (setq menu-item (make-instance 'ns:ns-menu-item))
391      (#/setAttributedTitle: menu-item attributed-string)
392      (#/setTarget: menu-item menu)
393      (#/setAction: menu-item (ccl::@selector "clearFileHistoryAction:"))
394      (#/addItem: menu menu-item))
395    menu))
396
397;;; ----------------------------------------------------------------------------
398;;; File I/O
399;;;
400(defun read-history-files ()
401  "Read the position and file history lists."
402  (let ((path (hl-path *file-history-list*)))
403    (when (probe-file path)
404      (with-open-file (stream path :direction :input)
405        (read-history-list *file-history-list* stream))))
406  (let ((path (hl-path *position-history-list*)))
407    (when (probe-file path)
408      (with-open-file (stream path :direction :input)
409        (read-history-list *position-history-list* stream t)))))
410
411(defMethod read-history-list ((hl history-list) stream &optional position-p)
412  (flet ((oops ()
413           (notify (format nil "There is a problem with ~S. Setting the history to NIL." (hl-path hl)))
414           (setf (hl-list hl) nil)
415           ;;; delete the file?
416           (return-from read-history-list)))
417    (setf (hl-list hl) nil)
418    ;; For the position-history-list, ufo is the def-info list.
419    ;; For the file-history-list, ufo is the filename string.
420    (let (length ufo path input)
421      (setf input (read stream nil :eof))
422      (unless (numberp input) (oops))
423      (setf length input)
424      (dotimes (count length t)
425        (setf input (read stream nil :eof))
426        (when (or (eql input :eof)
427                  (if position-p
428                    (not (listp input))
429                    (not (stringp input))))
430          (oops))
431        (setf ufo input)
432        (setf input (read stream nil :eof))
433        (when (or (eql input :eof)
434                  (not (stringp input)))
435          (oops))
436        (setf path input)
437        (when (null (add-history-entry hl ufo path))
438          (oops))))))
439
440(defMethod write-history-list ((hl position-history-list) stream)
441  (format stream "~s~%" (length (hl-list hl)))
442  (dolist (entry (reverse (hl-list hl)))
443    (format stream "~s~%" (hle-info entry))
444    (format stream "~s~%" (hle-path entry))))
445
446(defMethod write-history-list ((hl file-history-list) stream)
447  (format stream "~s~%" (length (hl-list hl)))
448  (dolist (entry (reverse (hl-list hl)))
449    (format stream "~s~%" (hle-name entry))
450    (format stream "~s~%" (hle-path entry))))
451
452(defun write-history-files ()
453  "Write the history list entries to the path."
454  (let ((path (hl-path *position-history-list*)))
455    (with-open-file (stream path :direction :output :if-exists :supersede)
456      (write-history-list *position-history-list* stream)))
457  (let ((path (hl-path *file-history-list*)))
458    (with-open-file (stream path :direction :output :if-exists :supersede)
459      (write-history-list *file-history-list* stream))))
460
461(defun write-history-files-on-shutdown (&rest args)
462  "Writing function pushed into *lisp-cleanup-functions*."
463  (declare (ignore args))
464  (write-history-files))
465
466(defun read-history-files-on-startup (&rest args)
467  "Reading function (eventually) pushed into *lisp-startup-functions*."
468  (declare (ignore args))
469  (read-history-files))
470
471(pushnew 'write-history-files-on-shutdown ccl::*lisp-cleanup-functions*)
472
473;;; To Do:
474;;; Heap issues involved in saving an image with the utility loaded.
475;;; (pushnew 'read-history-files-on-startup ccl::*lisp-startup-functions*)
476
477;;; ----------------------------------------------------------------------------
478;;; File History Interface:
479;;;
480#-syntax-styling 
481(objc:defmethod (#/becomeKeyWindow :void) ((w gui::hemlock-frame))
482  (let* ((path (window-path w))
483         (name (when (and path (or (string-equal (pathname-type path) "lisp")
484                                   (string-equal (pathname-type path) "scm")
485                                   (string-equal (pathname-type path) "clj")))
486                 (concatenate 'string (pathname-name path) "." (pathname-type path)))))
487    (when (and name path)
488      (maybe-add-history-entry *file-history-list* name path)))
489  (let ((become-key-function (find-symbol "BECOME-KEY-WINDOW" (find-package :sax))))
490    (when become-key-function (funcall become-key-function w)))
491  (call-next-method))
492
493#+syntax-styling
494(defMethod become-key-window ((w gui::hemlock-frame))
495  (let* ((path (window-path w))
496         (name (when (and path (or (string-equal (pathname-type path) "lisp")
497                                   (string-equal (pathname-type path) "scm")
498                                   (string-equal (pathname-type path) "clj")))
499                 (concatenate 'string (pathname-name path) "." (pathname-type path)))))
500    (when (and name path)
501      (maybe-add-history-entry *file-history-list* name path))))
502
503;;; ----------------------------------------------------------------------------
504;;; Position History Interface:
505;;;
506(hemlock::defcommand "Add Definition Position" (p)
507  "Add the position of the definition containing point to *position-history-list*."
508  (declare (ignore p))
509  (let* ((buffer (hemlock::current-buffer))
510         (mark (hi::copy-mark (hemlock::buffer-point buffer) :temporary))
511         (path (hi::buffer-pathname buffer))
512         (start-mark (hi::top-level-offset mark -1))
513         (def-info (when start-mark (definition-info start-mark))))
514    (when (and def-info path)
515      (maybe-add-history-entry *position-history-list* def-info path))))
516
517(hemlock::bind-key "Add Definition Position" #k"control-shift-space")
518
519(defun add-top-level-position (&optional buffer)
520  "Maybe add the top-level definition position to the position history list."
521  (let* ((buf (or buffer (hi::current-buffer)))
522         (mark (hi::copy-mark (hemlock::buffer-point buf) :temporary))
523         (path (hi::buffer-pathname buf))
524         start-mark def-info)
525    (if (and (= (hi::mark-charpos mark) 0)
526             (char= (hi::next-character mark) #\())
527      (setq start-mark mark)
528      (setq start-mark (hemlock::top-level-offset mark -1)))
529    (when start-mark
530      (let* ((line-end (hi::line-end (hi::copy-mark start-mark :temporary)))
531             (def-mark (hi::copy-mark start-mark :temporary))
532             (objc-mark (hi::copy-mark start-mark :temporary))
533             (def-p (hi::find-pattern def-mark *def-search-pattern* line-end))
534             (objc-p (hi::find-pattern objc-mark *objc-defmethod-search-pattern* line-end)))
535        (cond (def-p
536               (setq def-info (definition-info start-mark)))
537              (objc-p
538               (setq def-info (definition-info start-mark t)))))
539      (when (and def-info path)
540        (maybe-add-history-entry *position-history-list* def-info path)))))
541
542;;; *** redefinitions ***
543;;;
544(hemlock::defCommand "Editor Execute Defun" (p)
545  "Executes the current or next top-level form in the editor Lisp."
546  (declare (ignore p))
547  (if (hemlock::region-active-p)
548    (hemlock::eval-region (hemlock::current-region))
549    (hemlock::eval-region (hemlock::defun-region (hi::current-point))))
550  (add-top-level-position))
551
552(hemlock::defcommand "Editor Execute Expression" (p)
553  "Executes the current region in the editor Lisp. Ensures the result is visible."
554  (declare (ignore p))
555  (let* ((region (hi::copy-region (hemlock::current-form-region)))
556         (form (when hemlock::*echo-expression-to-listener* (hi::region-to-string region)))
557         (doc (gui::top-listener-document))
558         (buf (when doc (gui::hemlock-buffer doc))))
559    (when buf
560      (let ((hi::*current-buffer* buf))
561        (hi::move-mark (hi::current-point) (hi::region-end (hi::buffer-region buf)))))
562    (when form (format (HEMLOCK-EXT:TOP-LISTENER-OUTPUT-STREAM) "~A~&" form))
563    (hemlock::eval-region region))
564  (add-top-level-position))
565
566#|
567(hemlock::defcommand "Editor Evaluate Defun" (p)
568  "Evaluates the current or next top-level form in the editor Lisp.
569   If the current region is active, this evaluates the region."
570  "Evaluates the current or next top-level form in the editor Lisp."
571  (declare (ignore p))
572  (if (hemlock::region-active-p)
573    (hemlock::editor-evaluate-region-command nil)
574    (hemlock::eval-region (hemlock::defun-region (hi::current-point))))
575  (add-top-level-position))
576
577(hemlock::defcommand "Editor Compile Defun" (p)
578  "Compiles the current or next top-level form in the editor Lisp.
579   First the form is evaluated, then the result of this evaluation
580   is passed to compile.  If the current region is active, this
581   compiles the region."
582  "Evaluates the current or next top-level form in the editor Lisp."
583  (declare (ignore p))
584  (if (hemlock::region-active-p)
585      (hemlock::editor-compile-region (hemlock::current-region))
586      (hemlock::editor-compile-region (hemlock::defun-region (hi::current-point)) t))
587  (add-top-level-position))
588|#
589
590;;; gui::cocoa-edit-single-definition didn't last long.
591;;; This one's days are numbered:
592(defun hemlock::move-point-leaving-mark (target)
593  (let ((point (hi::current-point-collapsing-selection)))
594    (hemlock::push-new-buffer-mark point)
595    (hi::move-mark point target)
596    (add-top-level-position (hi::current-buffer))
597    point))
598
599
600(read-history-files)
Note: See TracBrowser for help on using the repository browser.