source: release/1.4/source/contrib/foy/window-parking-cm/window-parking.lisp @ 13073

Last change on this file since 13073 was 13073, checked in by rme, 10 years ago

Merge trunk changes r13036 through r13047

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