source: trunk/cocoa-ide-contrib/foy/window-parking-cm/window-parking.lisp @ 15113

Last change on this file since 15113 was 15113, checked in by gfoy, 8 years ago

#/saveDocument revisited.

File size: 25.6 KB
Line 
1;;;-*- Mode: Lisp; Package: WINDOW-PARKING -*-
2
3;;; ----------------------------------------------------------------------------
4;;;
5;;;      window-parking.lisp
6;;;
7;;;      copyright (c) 2009 Glen Foy
8;;;      (Permission is granted to Clozure Associates to distribute this file.)
9;;;
10;;;      This code provides a Hemlock window manager and is part of the Context-Menu
11;;;      tool set.  See the ReadMe file for details.
12;;;
13;;;      This software is offered "as is", without warranty of any kind.
14;;;
15;;;      Mod History (most recent edit first)
16;;;      12/6/11  #/saveDocument revisited.
17;;;      9/17/9   Fix bogus move after #/saveDocument.
18;;;      9/16/9   Park new window.
19;;;      9/9/9    first cut
20;;;
21;;; ----------------------------------------------------------------------------
22
23
24(defPackage "WINDOW-PARKING" (:nicknames "WP") (:use :cl :ccl))
25(in-package "WINDOW-PARKING")
26
27(require :context-menu-cm)
28(require :list-definitions-cm)
29
30(defParameter *window-parker* nil "The window-parker instance.")
31(defParameter *window-parking-menu* nil "The window-parking-menu instance.")
32(defParameter *park-p* t "To park or not to park.")
33
34;;; ----------------------------------------------------------------------------
35;;;
36(defClass WINDOW-PARKING-MENU (ns:ns-menu) 
37  ((tool-menu :initform nil :accessor tool-menu)
38   (doc-path :initform (merge-pathnames ";ReadMe.rtf" cl-user::*window-parking-directory*) :reader doc-path))
39  (:documentation "A menu for adding and deleting parking spots.")
40  (:metaclass ns:+ns-object))
41
42;;; This can be called to add a new parking spot or adjust an existing spot.
43(objc:defmethod (#/defineAction: :void) ((m window-parking-menu) (sender :id))
44  (declare (ignore sender))
45  (let* ((window (cmenu:active-hemlock-window))
46         (path (when window (cmenu:window-path window)))
47         ;; Possibly a re-definition.
48         (current-function-key (get-function-key *window-parker* window))
49         (defined-function-key
50             (when path
51               (if current-function-key
52                 (open-define-parking-spot-dialog path current-function-key)
53                 (open-define-parking-spot-dialog path)))))
54    (unless window
55      (cmenu:notify (format nil "First open a window, adjusting its size and position.") ))
56    (when defined-function-key
57      (cond (current-function-key 
58             (cond ((= current-function-key defined-function-key)
59                    ;; Adjusting an existing spot.
60                    (let ((spot (parking-spot-with-function-key *window-parker* current-function-key)))
61                      (init-parking-spot-values spot window current-function-key))
62                    (cmenu:echo-msg "Parking spot ~S modified." current-function-key))
63                   (t
64                    (vacate-current-location *window-parker* window)
65                    (add-parking-spot *window-parker* window defined-function-key)
66                    (cmenu:echo-msg "Parking spot ~S defined." current-function-key))))
67            (t
68             (add-parking-spot *window-parker* window defined-function-key))
69            (cmenu:echo-msg "Parking spot ~S defined." defined-function-key)))))
70
71(objc:defmethod (#/deleteAction: :void) ((m window-parking-menu) (sender :id))
72  (declare (ignore sender))
73  (let ((function-key (open-delete-parking-spot-dialog)))
74    (when function-key
75      (delete-parking-spot *window-parker* function-key))))
76
77(objc:defmethod (#/update :void) ((m window-parking-menu))
78  (cmenu:update-tool-menu m (tool-menu m))
79  (call-next-method))
80
81(defMethod initialize-instance :after ((m window-parking-menu) &key)
82  (setf (tool-menu m) (cmenu:add-default-tool-menu m :doc-file (doc-path m)))
83  (flet ((create-menu-item (name action)
84           (let ((menu-item (make-instance 'ns:ns-menu-item))
85                 (attributed-string (#/initWithString:attributes:
86                                     (#/alloc ns:ns-attributed-string) 
87                                     (ccl::%make-nsstring name)
88                                     cmenu:*hemlock-menu-dictionary*)))
89             (#/setAttributedTitle: menu-item attributed-string)
90             (#/setAction: menu-item action)
91             (#/setTarget: menu-item  m)
92             (#/addItem: m menu-item))))
93    (create-menu-item "Define Parking Spot..." 
94                      (ccl::@selector "defineAction:"))
95    (create-menu-item "Delete Parking Spot..." 
96                      (ccl::@selector "deleteAction:"))))
97 
98(setq *window-parking-menu* (make-instance 'window-parking-menu))
99
100(defun get-window-parking-menu (view event) 
101  (declare (ignore view event))
102  *window-parking-menu*)
103
104(cmenu:register-tool "Window-Parking-CM" #'get-window-parking-menu)
105
106
107;;; ----------------------------------------------------------------------------
108;;;
109(defClass PARKABLE-HEMLOCK-FRAME (gui::hemlock-frame)
110  ((parked-p :initform nil :accessor parked-p)
111   (front-p :initform nil :accessor front-p)
112   (new-window-p :initform t :accessor new-window-p))
113  (:metaclass ns:+ns-object))
114
115(defMethod init-parking ((w parkable-hemlock-frame))
116  (setf (parked-p w) nil)
117  (setf (front-p w) nil))
118
119(defMethod h-position ((w parkable-hemlock-frame))
120  (let ((rect (#/frame w)))
121    (pref rect :<nsr>ect.origin.x)))
122
123(defMethod v-position ((w parkable-hemlock-frame))
124  (let ((rect (#/frame w)))
125    (pref rect :<nsr>ect.origin.y)))
126
127(defMethod h-dimension ((w parkable-hemlock-frame))
128  (let ((rect (#/frame w)))
129    (pref rect :<nsr>ect.size.width)))
130
131(defMethod v-dimension ((w parkable-hemlock-frame))
132  (let ((rect (#/frame w)))
133    (pref rect :<nsr>ect.size.height)))
134
135(objc:defmethod (#/close :void) ((w parkable-hemlock-frame))
136  (vacate-current-location *window-parker* w)
137  (call-next-method))
138
139(defMethod modified-p ((w parkable-hemlock-frame))
140  (when w
141    (let* ((pane (slot-value w 'gui::pane))
142           (hemlock-view (when pane (gui::text-pane-hemlock-view pane)))
143           (buffer (when hemlock-view (hi::hemlock-view-buffer hemlock-view))))
144      (when buffer
145        (hi::buffer-modified buffer)))))
146
147(defMethod print-object ((w parkable-hemlock-frame) stream)
148  (format stream "<parkable-hemlock-frame: ~S>" (namestring (cmenu:window-path w))))
149
150;;; This is a work-around for some odd #/saveDocument behavior:
151;;; Why is the frame being set on a save operation?
152(objc:defmethod (#/saveDocument: :void) ((self gui::hemlock-editor-document) (sender :id))
153  (let ((url (#/fileURL self)))
154    (cond ((ccl::%null-ptr-p url)
155           (call-next-method sender))
156          (t
157           (let* ((path (ccl::lisp-string-from-nsstring (#/path url)))
158                  (window (cmenu:window-with-path path)))
159             (when window (init-parking window))
160             (call-next-method sender)
161             (when window (setf (parked-p window) t)))))))
162
163;;; ----------------------------------------------------------------------------
164;;; *** redefinition ***
165;;; Need the equivalent of: (setf ccl::*default-editor-class* 'parkable-hemlock-frame)
166(defun gui::new-hemlock-document-window (class)
167  (let* ((w (gui::new-cocoa-window :class (if (or (eq class 'gui::hemlock-listener-frame)
168                                                  (eq class (find-class 'gui::hemlock-listener-frame)))
169                                            'gui::hemlock-listener-frame
170                                            'parkable-hemlock-frame)
171                                   :auto-display t
172                                   :activate nil))
173         (echo-area-height (+ 1 (gui::size-of-char-in-font gui::*editor-font*))))
174      (values w (gui::add-pane-to-window w :reserve-below echo-area-height))))
175
176(objc:defmethod (#/makeKeyAndOrderFront: :void) ((w parkable-hemlock-frame) (sender :id))
177  (setf (front-p w) t)
178  (call-next-method sender))
179
180(objc:defmethod (#/setFrame:display: :void) ((w parkable-hemlock-frame) (rect :<NSR>ect) (display-p :<BOOL>))
181 (cond ((and w (not (ccl::%null-ptr-p w)) (parked-p w))
182        (let ((spot (get-window-parking-spot *window-parker* w)))
183          ;; This is an ugly hack for saving a new window:
184          (cond ((and (new-window-p w) spot)
185                 (ns:with-ns-rect (r (ps-h-position spot) (ps-v-position spot)
186                                     (ps-h-dimension spot) (ps-v-dimension spot))
187                   (setf (new-window-p w) nil)
188                   (call-next-method r display-p)))
189                (t
190                 (call-next-method rect display-p)))))
191        (t
192         (when (front-p w) (setf (parked-p w) t))
193         (multiple-value-bind (h-position v-position h-dimension v-dimension)
194                              (park *window-parker* w)
195           (if (and h-position v-position h-dimension v-dimension)
196             (ns:with-ns-rect (r h-position v-position h-dimension v-dimension)
197               (call-next-method r display-p))
198             (call-next-method rect display-p))))))
199
200;;; ----------------------------------------------------------------------------
201;;;
202(defClass PARKING-SPOT ()
203  ((h-dimension :initform nil :initarg :h-dimension :accessor ps-h-dimension)
204   (v-dimension :initform nil :initarg :v-dimension :accessor ps-v-dimension)
205   (h-position :initform nil :initarg :h-position :accessor ps-h-position)
206   (v-position :initform nil :initarg :v-position :accessor ps-v-position)
207   (tenant :initform nil :initarg :tenant :accessor ps-tenant)
208   (function-key :initform nil :initarg :function-key :accessor ps-function-key))
209  (:documentation "Parking spot position, size, tenant and function key information."))
210
211(defMethod initialize-instance :after ((ps parking-spot) &key window 
212                                       function-key h-dimension v-dimension
213                                       h-position v-position)
214  (cond ((and h-dimension v-dimension h-position v-position function-key)
215         (setf (ps-tenant ps) window)
216         (setf (ps-h-dimension ps) h-dimension)
217         (setf (ps-v-dimension ps) v-dimension)
218         (setf (ps-h-position ps) h-position)
219         (setf (ps-v-position ps) v-position)
220         (setf (ps-function-key ps) function-key))
221        ((and window function-key)
222         (init-parking-spot-values ps window function-key))
223        (t
224         (error "Bogus condition in parking-spot i-i :after"))))
225
226(defMethod init-parking-spot-values ((ps parking-spot) window function-key)
227  (setf (ps-tenant ps) window)
228  (setf (ps-h-dimension ps) (h-dimension window))
229  (setf (ps-v-dimension ps) (v-dimension window))
230  (setf (ps-h-position ps) (h-position window))
231  (setf (ps-v-position ps) (v-position window))
232  (setf (ps-function-key ps) function-key))
233
234(defMethod parking-spot-on-screen-p ((ps parking-spot) &optional window)
235  (let* ((screen (if window 
236                   (#/screen window)
237                   (#/mainScreen ns:ns-screen)))
238         (screen-rect (if (%null-ptr-p screen)
239                        (#/visibleFrame (#/mainScreen ns:ns-screen))
240                        (#/visibleFrame screen)))
241         (screen-left (pref screen-rect :<nsr>ect.origin.x))
242         (screen-right (+ screen-left (pref screen-rect :<nsr>ect.size.width)))
243         (screen-bottom (pref screen-rect :<nsr>ect.origin.y))
244         (screen-top (+ screen-bottom (pref screen-rect :<nsr>ect.size.height))))
245    (and (>= (ps-h-position ps) screen-left)
246         (<= (+ (ps-h-position ps) (ps-h-dimension ps)) screen-right)
247         (>= (ps-v-position ps) screen-bottom)
248         (<= (+ (ps-v-position ps) (ps-v-dimension ps)) screen-top))))
249
250(defMethod print-object ((ps parking-spot) stream)
251  (format stream "<~a ~a ~a>" (type-of ps) (ps-function-key ps)
252          (if (ps-tenant ps) (ps-tenant ps) "empty")))
253
254(defMethod apply-parking-spot-values ((ps parking-spot) window)
255  (setf (ps-tenant ps) window)
256  (when (or (neq (ps-h-dimension ps) (h-dimension window))
257            (neq (ps-v-dimension ps) (v-dimension window))
258            (neq (ps-h-position ps) (h-position window))
259            (neq (ps-v-position ps) (v-position window)))
260    ;; park it
261    (init-parking window)
262    (ns:with-ns-rect (r (ps-h-position ps) (ps-v-position ps) (ps-h-dimension ps) (ps-v-dimension ps))
263      (#/setFrame:display: window r t))
264    (#/makeKeyAndOrderFront: window nil))
265  (let ((style-screen-function (find-symbol "STYLE-SCREEN" (find-package :sax))))
266    (when style-screen-function
267      (let* ((hemlock-view (gui::hemlock-view window))
268             (text-view (gui::text-pane-text-view (hi::hemlock-view-pane hemlock-view))))
269        (when text-view
270          (funcall style-screen-function text-view))))))
271
272;;; ----------------------------------------------------------------------------
273;;;
274(defClass WINDOW-PARKER ()
275  ((parking-spots :initform nil :accessor wp-parking-spots)
276   (parking-lot-path :initform (merge-pathnames ";Library;Preferences;org.clairvaux;window-parking;parking-lot" 
277                                                 (hemlock::user-homedir-pathname))
278                      :reader wp-parking-lot-path))
279  (:documentation "A window manager."))
280
281(setf *window-parker* (make-instance 'window-parker))
282
283(defMethod park ((wp window-parker) (window parkable-hemlock-frame))
284  (when (and (wp-parking-spots wp) *park-p*)
285    ;; Already parked?
286    (let* ((position (position window (wp-parking-spots wp) :key #'ps-tenant))
287           spot)
288      (when (null position)
289        (or (setf position (get-empty-position wp))
290            (setf position (bump-position wp (1- (length (wp-parking-spots wp)))))))
291      (when position
292        (setq spot (nth position (wp-parking-spots wp)))
293        (move-position-to-front wp position)
294        (setf (ps-tenant spot) window)
295        (values (ps-h-position spot) (ps-v-position spot)
296                (ps-h-dimension spot) (ps-v-dimension spot))))))
297
298;;; Test to make sure that POSITION is on screen.  If not, call recursively with
299;;; (1- position).  Return POSITION or NIL
300(defMethod bump-position ((wp window-parker) position)
301  ;; Has the recursive call run out of positions?
302  (when (< position 0)
303    (cmenu:notify "There are no on-screen parking spots with unmodified buffers.")
304    (return-from bump-position nil))
305  (let* ((bump-location (nth position (wp-parking-spots wp)))
306         (tenant (when bump-location (ps-tenant bump-location))))
307    (cond ((and bump-location 
308                (parking-spot-on-screen-p bump-location)
309                (not (modified-p tenant)))
310             (when tenant (#/close tenant))
311             position)
312          (t ; location is off-screen or not defined, recursive call
313           (bump-position wp (1- position))))))
314
315;;; Assumes that WINDOW's buffer is unmodified.
316(defMethod bump-location-and-set-location-values ((wp window-parker) location window)
317  (let ((tenant (ps-tenant location)))
318    (when tenant
319      (#/close tenant))
320    (apply-parking-spot-values location window)))
321
322(defMethod move-position-to-front ((wp window-parker) position)
323  (let ((current-location (nth position (wp-parking-spots wp))))
324    (setf (wp-parking-spots wp) 
325          (cons current-location (delete current-location (wp-parking-spots wp))))))
326
327(defMethod parking-spot-with-function-key ((wp window-parker) function-key)
328  (find  function-key (wp-parking-spots wp) :test #'= :key #'ps-function-key))
329
330(defMethod get-window-parking-spot ((wp window-parker) window)
331  (find-if #'(lambda (spot)
332               (equal (ps-tenant spot) window))
333           (wp-parking-spots wp)))
334
335;;; Find the lowest number parking-spot that has no tenant.
336(defMethod get-empty-position ((wp window-parker))
337  (let ((parking-spots (sort (copy-list (wp-parking-spots wp))
338                             #'(lambda (s1 s2)
339                                 (< (ps-function-key s1) (ps-function-key s2))))))
340    (dolist (spot parking-spots)
341      (when (and (null (ps-tenant spot))
342                 (parking-spot-on-screen-p spot))
343        ;; Return the position in the unsorted list.
344        (return (position spot (wp-parking-spots wp)))))))
345
346(defMethod add-parking-spot ((wp window-parker) window function-key)
347  (let ((new-parking-spot (make-instance 'parking-spot :window window :function-key function-key)))
348    (setf (wp-parking-spots wp) (cons new-parking-spot (wp-parking-spots wp)))
349    (cmenu:echo-msg "Parking Spot ~a defined." function-key)))
350
351(defMethod add-parking-spot-2 ((wp window-parker) function-key
352                               h-dimension v-dimension h-position v-position)
353  (cond ((and (wp-parking-spots wp)
354              (find-if #'(lambda (spot) (= function-key (ps-function-key spot)))
355                       (wp-parking-spots wp)))
356         (cmenu:notify "Duplicate parking-spot ignored."))
357        (t
358         (let ((new-parking-spot (make-instance 'parking-spot
359                                   :function-key function-key
360                                   :h-dimension h-dimension :v-dimension v-dimension
361                                   :h-position h-position :v-position v-position)))
362           (setf (wp-parking-spots wp) (cons new-parking-spot (wp-parking-spots wp)))))))
363
364(defMethod delete-parking-spot ((wp window-parker) function-key)
365  (let ((parking-spot (find function-key (wp-parking-spots wp) :key #'ps-function-key)))
366    (cond (parking-spot
367           (let ((tenant (ps-tenant parking-spot)))
368             (cond (tenant
369                    (cond ((modified-p tenant)
370                           (cmenu:notify (format nil "First save: ~S.  Then try again."
371                                                 (cmenu:window-path tenant))))
372                          (t
373                           (setf (wp-parking-spots wp) (delete parking-spot (wp-parking-spots wp))) 
374                           (#/close tenant)
375                           (cmenu:echo-msg "Parking Spot ~a deleted." function-key))))
376                   (t
377                    (setf (wp-parking-spots wp) (delete parking-spot (wp-parking-spots wp))) 
378                    (cmenu:echo-msg "Parking Spot ~a deleted." function-key)))))                   
379          (t 
380           (cmenu:notify (format nil "Parking Spot ~a is not currently defined." function-key))))))
381
382(defMethod get-function-key ((wp window-parker) window)
383  (dolist (spot (wp-parking-spots wp))
384    (when (eql window (ps-tenant spot)) (return (ps-function-key spot)))))
385
386(defMethod vacate-current-location ((wp window-parker) window)
387  (let ((location (find window (wp-parking-spots wp) :key #'ps-tenant)))
388    (when location 
389      (setf (ps-tenant location) nil)
390      t)))
391
392(defMethod clear-parking-lot ((wp window-parker))
393  (setf (wp-parking-spots wp) nil))
394
395;;; Move WINDOW to the parking-spot corresponding to the pressed function key,
396;;; unless the parking-spot is not on screen or the window is already in that location.
397(defMethod move-window-to-position ((wp window-parker) window function-key)
398  (when *park-p*
399    (let* ((parking-spot (find function-key (wp-parking-spots wp) :key #'ps-function-key))
400           (tenant (when parking-spot (ps-tenant parking-spot))))
401      (cond ((and parking-spot (parking-spot-on-screen-p parking-spot window))
402             (cond (tenant
403                    (cond ((eql window tenant)
404                           (cmenu:echo-msg "Already in parking-spot ~a." function-key))
405                          (t
406                           (cond ((modified-p tenant)
407                                  (cmenu:notify (format nil "First save: ~S. Then try again." 
408                                                        (cmenu:window-path tenant)))
409                                  (init-parking tenant))
410                                 (t
411                                  (vacate-current-location wp window)
412                                  (bump-location-and-set-location-values wp parking-spot window)
413                                  (#/makeKeyAndOrderFront: window nil)
414                                  (cmenu:echo-msg "Moved to parking-spot ~a." function-key))))))
415                   (t 
416                    (vacate-current-location wp window)
417                    (apply-parking-spot-values parking-spot window)
418                    (#/makeKeyAndOrderFront: window nil)
419                    (cmenu:echo-msg "Moved to parking-spot ~a." function-key))))
420            (t
421             (if (null parking-spot)
422               (cmenu:notify (format nil "Parking-spot ~a is not defined." function-key))
423               (cmenu:notify (format nil "Parking-spot ~a is off screen." function-key))))))))
424
425;;; ----------------------------------------------------------------------------
426;;; file I/O
427;;;
428(defMethod read-parking-spot-entries ((wp window-parker) stream)
429  (let (length h-dimension v-dimension h-position v-position function-key input)
430    (setf input (read stream nil :eof))
431    (when (not (numberp input))
432      (return-from read-parking-spot-entries))
433    (setf length input)
434    (dotimes (count length t)
435      (setf input (read stream nil :eof))
436      ;; *** null ?
437      (when (not (or (numberp input) (null input))) (return nil))
438      (setf function-key input)
439      (setf input (read stream nil :eof))
440      (when (not (or (numberp input) (null input))) (return nil))
441      (setf h-dimension input)
442      (setf input (read stream nil :eof))
443      (when (not (or (numberp input) (null input))) (return nil))
444      (setf v-dimension input)
445      (setf input (read stream nil :eof))
446      (when (not (or (numberp input) (null input))) (return nil))
447      (setf h-position input)
448      (setf input (read stream nil :eof))
449      (when (not (or (numberp input) (null input))) (return nil))
450      (setf v-position input)
451      (add-parking-spot-2 wp function-key h-dimension v-dimension
452                            h-position v-position))))
453
454(defMethod write-parking-spot-entries ((wp window-parker) stream)
455  (let (;; write the positions in reverse order based on their function key order
456        (sorted-parking-spots (sort (copy-list (wp-parking-spots wp)) #'> :key #'ps-function-key)))
457    (format stream "~s~%" (length sorted-parking-spots))
458    (dolist (entry sorted-parking-spots)
459      (format stream "~s~%" (ps-function-key entry))
460      (format stream "~s~%" (ps-h-dimension entry))
461      (format stream "~s~%" (ps-v-dimension entry))
462      (format stream "~s~%" (ps-h-position entry)) 
463      (format stream "~s~%" (ps-v-position entry)))))
464
465(defun read-parking-lot-file ()
466  "Read the parking-lot file."
467  (let ((path (wp-parking-lot-path *window-parker*)))
468    (when (probe-file path)
469      (with-open-file (stream path :direction :input)
470        (unless (read-parking-spot-entries *window-parker* stream)
471          (cmenu:notify "There is a problem with the parking-lot file.  You will have to redefine your parking spots.")
472          (clear-parking-lot *window-parker*))))))
473
474(defun write-parking-lot-file (&rest args)
475  "Writing function pushed into *lisp-cleanup-functions*."
476  (declare (ignore args))
477  (let ((path (wp-parking-lot-path *window-parker*)))
478    (with-open-file (stream path :direction :output :if-exists :supersede)
479      (write-parking-spot-entries *window-parker* stream))))
480
481(pushnew 'write-parking-lot-file ccl::*lisp-cleanup-functions*)
482
483;;; To Do:
484;;; Heap issues involved in saving an image with the utility loaded.
485;;; (pushnew 'read-parking-lot-file ccl::*lisp-startup-functions*)
486
487;;; ----------------------------------------------------------------------------
488;;; Commands and bindings:
489;;;
490(hemlock::defcommand "Move Window to Position 1" (p)
491  "Move the front Hemlock window to parking spot 1."
492  (declare (ignore p))
493  (let ((window (cmenu:active-hemlock-window)))
494    (cond (window
495           (move-window-to-position *window-parker* window 1))
496          (t
497           (hi::editor-error "There is no active Hemlock window to move.")))))
498
499(hi::bind-key "Move Window to Position 1" #k"F1")
500
501(hemlock::defcommand "Move Window to Position 2" (p)
502  "Move the front Hemlock window to parking spot 2."
503  (declare (ignore p))
504  (let ((window (cmenu:active-hemlock-window)))
505    (cond (window
506           (move-window-to-position *window-parker* window 2))
507          (t
508           (hi::editor-error "There is no active Hemlock window to move.")))))
509
510(hi::bind-key "Move Window to Position 2" #k"F2")
511
512(hemlock::defcommand "Move Window to Position 3" (p)
513  "Move the front Hemlock window to parking spot 3."
514  (declare (ignore p))
515  (let ((window (cmenu:active-hemlock-window)))
516    (cond (window
517           (move-window-to-position *window-parker* window 3))
518          (t
519           (hi::editor-error "There is no active Hemlock window to move.")))))
520
521(hi::bind-key "Move Window to Position 3" #k"F3")
522
523(hemlock::defcommand "Move Window to Position 4" (p)
524  "Move the front Hemlock window to parking spot 4."
525  (declare (ignore p))
526  (let ((window (cmenu:active-hemlock-window)))
527    (cond (window
528           (move-window-to-position *window-parker* window 4))
529          (t
530           (hi::editor-error "There is no active Hemlock window to move.")))))
531
532(hi::bind-key "Move Window to Position 4" #k"F4")
533
534(hemlock::defcommand "Move Window to Position 5" (p)
535  "Move the front Hemlock window to parking spot 5."
536  (declare (ignore p))
537  (let ((window (cmenu:active-hemlock-window)))
538    (cond (window
539           (move-window-to-position *window-parker* window 5))
540          (t
541           (hi::editor-error "There is no active Hemlock window to move.")))))
542
543(hi::bind-key "Move Window to Position 5" #k"F5")
544
545(hemlock::defcommand "Move Window to Position 6" (p)
546  "Move the front Hemlock window to parking spot 6."
547  (declare (ignore p))
548  (let ((window (cmenu:active-hemlock-window)))
549    (cond (window
550           (move-window-to-position *window-parker* window 6))
551          (t
552           (hi::editor-error "There is no active Hemlock window to move.")))))
553
554(hi::bind-key "Move Window to Position 6" #k"F6")
555
556(hemlock::defcommand "Move Window to Position 7" (p)
557  "Move the front Hemlock window to parking spot 7."
558  (declare (ignore p))
559  (let ((window (cmenu:active-hemlock-window)))
560    (cond (window
561           (move-window-to-position *window-parker* window 7))
562          (t
563           (hi::editor-error "There is no active Hemlock window to move.")))))
564
565(hi::bind-key "Move Window to Position 7" #k"F7")
566
567
568(read-parking-lot-file)
569
570
571
572
573
Note: See TracBrowser for help on using the repository browser.