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