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

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

Updates for ccl 1.7

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