source: trunk/source/contrib/foy/window-parking-cm/window-parking.lisp @ 12849

Last change on this file since 12849 was 12849, checked in by gfoy, 10 years ago

Bogus move on #/saveDocument

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