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

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

New tool: window-parking-cm

File size: 14.0 KB
Line 
1;;;-*- Mode: Lisp; Package: WINDOW-PARKING -*-
2
3;;; ----------------------------------------------------------------------------
4;;;
5;;;      window-parking-dialogs.lisp
6;;;
7;;;      copyright (c) 2009 Glen Foy
8;;;      (Permission is granted to Clozure Associates to distribute this file.)
9;;;
10;;;      Dialogs for defining and deleting parking spots.
11;;;
12;;;      This software is offered "as is", without warranty of any kind.
13;;;
14;;;      Mod History (most recent edit first)
15;;;      9/14/9  version 0.1b1
16;;;              first cut
17;;;
18;;; ----------------------------------------------------------------------------
19
20(in-package "WINDOW-PARKING")
21
22(defparameter *dps-dialog* nil "The define-parking-spot-dialog instance.")
23(defparameter *del-dialog* nil "The delete-parking-spot-dialog instance.")
24
25
26;;; ----------------------------------------------------------------------------
27;;;
28(defclass DEFINE-PARKING-SPOT-DIALOG (ns:ns-window)
29  ((path :initform nil :accessor psd-path)
30   (okay-button :initform nil :accessor psd-okay-button)
31   (function-key-buttons :initform nil :accessor psd-function-key-buttons)
32   (function-key-matrix :initform nil :accessor psd-function-key-matrix))
33  (:documentation "A dialog for associating a window size and position with a function key.")
34  (:metaclass ns:+ns-object))
35
36(defmethod selected-function-key ((d define-parking-spot-dialog))
37  (read-from-string (ccl::lisp-string-from-nsstring 
38                     (#/title (#/selectedCell (psd-function-key-matrix d))))))
39
40(objc:defmethod (#/okayAction: :void) ((d define-parking-spot-dialog) (sender :id))
41  (declare (ignore sender))
42  (#/stopModalWithCode: ccl::*nsapp* 0))
43
44(objc:defmethod (#/cancelAction: :void) ((d define-parking-spot-dialog) (sender :id))
45  (declare (ignore sender))
46  (#/stopModalWithCode: ccl::*nsapp* 1))
47
48(defun open-define-parking-spot-dialog (path &optional (function-key 1))
49  "Open the define-parking-spot-dialog for PATH."
50  (let* ((path-string (#/initWithString:attributes: (#/alloc ns:ns-attributed-string) 
51                                                    (ccl::%make-nsstring 
52                                                     (format nil "~A" path))
53                                                    cmenu::*tool-key-dictionary*)))
54    (flet ((selectFunctionKey (num)
55             (dolist (button (psd-function-key-buttons *dps-dialog*))
56               (let ((key (read-from-string (ccl::lisp-string-from-nsstring (#/title button)))))
57                 (when (= num key)
58                   (#/selectCell: (psd-function-key-matrix *dps-dialog*) button)
59                   (return))))))
60      (cond (*dps-dialog*
61             (#/setStringValue: (psd-path *dps-dialog*) path-string)
62             (selectFunctionKey function-key)
63             (#/makeKeyAndOrderFront: *dps-dialog* nil)
64             (let ((ret (#/runModalForWindow: ccl::*nsapp* *dps-dialog*)))
65               (#/close *dps-dialog*)
66               (when (zerop ret) (selected-function-key *dps-dialog*))))
67            (t
68             (let ((dialog (#/alloc define-parking-spot-dialog)))
69               (setq *dps-dialog* dialog)
70               (ns:with-ns-rect (r 10 300 600 140)
71                 (#/initWithContentRect:styleMask:backing:defer: 
72                  dialog
73                  r
74                  (logior  #$NSTitledWindowMask 
75                           #$NSClosableWindowMask 
76                           #$NSMiniaturizableWindowMask)
77                  #$NSBackingStoreBuffered
78                  #$NO))
79               (dolist (item (get-items dialog))
80                 (#/addSubview: (#/contentView dialog) item))
81               (#/setTitle: dialog #@"Define Parking Spot")
82               (#/setReleasedWhenClosed: dialog nil)
83               (#/setDefaultButtonCell: dialog (psd-okay-button dialog))
84               (#/center dialog)
85               (#/setStringValue: (psd-path dialog) path-string)
86               (selectFunctionKey function-key)
87               (#/makeKeyAndOrderFront: dialog nil)
88               (let ((ret (#/runModalForWindow: ccl::*nsapp* dialog)))
89                 (#/close dialog)
90                 (when (zerop ret) (selected-function-key dialog)))))))))
91
92(defmethod get-items ((d define-parking-spot-dialog))
93  (append
94   (make-prompt-field)
95   (make-path-field d)
96   (make-function-key-items d)
97   (make-buttons d)))
98
99(defun make-prompt-field ()
100  "Create the prompt text-field."
101  (list
102   (let* ((string (#/initWithString:attributes: 
103                   (#/alloc ns:ns-attributed-string) 
104                   #@"Save the front window size, position and function key:"
105                   cmenu::*tool-label-dictionary*))
106          (title (#/alloc ns:ns-text-field)))
107     (ns:with-ns-rect (frame 15 90 410 32)
108       (#/initWithFrame: title frame))
109     (#/setEditable: title nil)
110     (#/setDrawsBackground: title nil)
111     (#/setBordered: title nil)
112     (#/setStringValue: title string)
113     title)))
114
115(defun make-path-field (dialog)
116  "Create the path text-field."
117  (list
118   (setf (psd-path dialog)
119         (let* ((string (#/initWithString:attributes: 
120                         (#/alloc ns:ns-attributed-string) 
121                         #@""
122                         cmenu::*tool-doc-dictionary*))
123                (title (#/alloc ns:ns-text-field)))
124           (ns:with-ns-rect (frame 15 72 580 22)
125             (#/initWithFrame: title frame))
126           (#/setEditable: title nil)
127           (#/setDrawsBackground: title nil)
128           (#/setBordered: title nil)
129           (#/setStringValue: title string)
130           title))))
131
132(defun make-function-key-items (dialog)
133  (list
134   (let* ((string (#/initWithString:attributes: 
135                   (#/alloc ns:ns-attributed-string) 
136                   #@"Associated Function Key:"
137                   cmenu::*tool-label-dictionary*))
138          (title (#/alloc ns:ns-text-field)))
139     (ns:with-ns-rect (frame 15 40 200 32)
140       (#/initWithFrame: title frame))
141     (#/setEditable: title nil)
142     (#/setDrawsBackground: title nil)
143     (#/setBordered: title nil)
144     (#/setStringValue: title string)
145     title)
146   (setf (psd-function-key-matrix dialog)
147         (ns:with-ns-rect (frame 190 40 350 32)
148           (let* ((matrix (#/alloc ns:ns-matrix))
149                  (prototype (#/init (#/alloc ns:ns-button-cell)))
150                  buttons cell-array)
151             (#/setTitle: prototype #@"7     ")
152             (#/setButtonType: prototype #$NSRadioButton)
153             (#/initWithFrame:mode:prototype:numberOfRows:numberOfColumns: 
154              matrix frame #$NSRadioModeMatrix prototype 1 7)
155             (setq cell-array (#/cells matrix))
156             (#/setTitle: (#/objectAtIndex: cell-array 0) #@"1")
157             (push (#/objectAtIndex: cell-array 0) buttons)
158             (#/setTitle: (#/objectAtIndex: cell-array 1) #@"2")
159             (push (#/objectAtIndex: cell-array 1) buttons)
160             (#/setTitle: (#/objectAtIndex: cell-array 2) #@"3")
161             (push (#/objectAtIndex: cell-array 2) buttons)
162             (#/setTitle: (#/objectAtIndex: cell-array 3) #@"4")
163             (push (#/objectAtIndex: cell-array 3) buttons)
164             (#/setTitle: (#/objectAtIndex: cell-array 4) #@"5")
165             (push (#/objectAtIndex: cell-array 4) buttons)
166             (#/setTitle: (#/objectAtIndex: cell-array 5) #@"6")
167             (push (#/objectAtIndex: cell-array 5) buttons)
168             (#/setTitle: (#/objectAtIndex: cell-array 6) #@"7")
169             (push (#/objectAtIndex: cell-array 6) buttons)
170             (setf (psd-function-key-buttons dialog) buttons)
171             matrix)))))
172
173(defun make-buttons (dialog)
174  "Construct the buttons."
175  (flet ((make-button (title x-coord y-coord x-dim y-dim action)
176           (let ((button (#/alloc ns:ns-button)))
177             (ns:with-ns-rect (frame x-coord y-coord x-dim y-dim)
178               (#/initWithFrame: button frame))
179             (#/setButtonType: button #$NSMomentaryPushInButton)
180             (#/setBezelStyle: button #$NSRoundedBezelStyle)
181             (#/setTitle: button title)
182             (#/setTarget: button dialog)
183             (#/setAction: button action)
184             button)))
185    (list
186     (setf (psd-okay-button dialog)
187           (make-button #@"Okay" 500 10 80 32
188                        (ccl::@selector "okayAction:")))
189     (make-button #@"Cancel" 400 10 90 32
190                  (ccl::@selector "cancelAction:")))))
191
192
193;;; ----------------------------------------------------------------------------
194;;;
195(defclass DELETE-PARKING-SPOT-DIALOG (ns:ns-window)
196  ((path :initform nil :accessor psd-path)
197   (okay-button :initform nil :accessor psd-okay-button)
198   (function-key-buttons :initform nil :accessor psd-function-key-buttons)
199   (function-key-matrix :initform nil :accessor psd-function-key-matrix))
200  (:documentation "A dialog for deleting parking spots.")
201  (:metaclass ns:+ns-object))
202
203(defmethod selected-function-key ((d delete-parking-spot-dialog))
204  (read-from-string (ccl::lisp-string-from-nsstring 
205                     (#/title (#/selectedCell (psd-function-key-matrix d))))))
206
207(objc:defmethod (#/deleteAction: :void) ((d delete-parking-spot-dialog) (sender :id))
208  (declare (ignore sender))
209  (#/stopModalWithCode: ccl::*nsapp* 0))
210
211(objc:defmethod (#/cancelAction: :void) ((d delete-parking-spot-dialog) (sender :id))
212  (declare (ignore sender))
213  (#/stopModalWithCode: ccl::*nsapp* 1))
214
215(defun open-delete-parking-spot-dialog ()
216  "Open the delete-parking-spot-dialog for PATH."
217  (cond (*del-dialog*
218         (#/makeKeyAndOrderFront: *del-dialog* nil)
219         (let ((ret (#/runModalForWindow: ccl::*nsapp* *del-dialog*)))
220           (#/close *del-dialog*)
221           (when (zerop ret) (selected-function-key *del-dialog*))))
222        (t
223         (let ((dialog (#/alloc delete-parking-spot-dialog)))
224           (setq *del-dialog* dialog)
225           (ns:with-ns-rect (r 10 300 600 140)
226             (#/initWithContentRect:styleMask:backing:defer: 
227              dialog
228              r
229              (logior  #$NSTitledWindowMask 
230                       #$NSClosableWindowMask 
231                       #$NSMiniaturizableWindowMask)
232              #$NSBackingStoreBuffered
233              #$NO))
234           (dolist (item (get-delete-items dialog))
235             (#/addSubview: (#/contentView dialog) item))
236           (#/setTitle: dialog #@"Delete Parking Spot")
237           (#/setReleasedWhenClosed: dialog nil)
238           (#/setDefaultButtonCell: dialog (psd-okay-button dialog))
239           (#/center dialog)
240           (#/makeKeyAndOrderFront: dialog nil)
241           (let ((ret (#/runModalForWindow: ccl::*nsapp* dialog)))
242             (#/close dialog)
243             (when (zerop ret) (selected-function-key dialog)))))))
244
245(defmethod get-delete-items ((d delete-parking-spot-dialog))
246  (append
247   (make-delete-prompt-field)
248   (make-delete-function-key-items d)
249   (make-delete-buttons d)))
250
251(defun make-delete-prompt-field ()
252  "Create the prompt text-field."
253  (list
254   (let* ((string (#/initWithString:attributes: 
255                   (#/alloc ns:ns-attributed-string) 
256                   #@"Click the number of the parking spot you want to delete:"
257                   cmenu::*tool-label-dictionary*))
258          (title (#/alloc ns:ns-text-field)))
259     (ns:with-ns-rect (frame 15 90 410 32)
260       (#/initWithFrame: title frame))
261     (#/setEditable: title nil)
262     (#/setDrawsBackground: title nil)
263     (#/setBordered: title nil)
264     (#/setStringValue: title string)
265     title)))
266
267(defun make-delete-function-key-items (dialog)
268  (list
269   (let* ((string (#/initWithString:attributes: 
270                   (#/alloc ns:ns-attributed-string) 
271                   #@"Associated Function Key:"
272                   cmenu::*tool-label-dictionary*))
273          (title (#/alloc ns:ns-text-field)))
274     (ns:with-ns-rect (frame 15 40 200 32)
275       (#/initWithFrame: title frame))
276     (#/setEditable: title nil)
277     (#/setDrawsBackground: title nil)
278     (#/setBordered: title nil)
279     (#/setStringValue: title string)
280     title)
281   (setf (psd-function-key-matrix dialog)
282         (ns:with-ns-rect (frame 190 40 350 32)
283           (let* ((matrix (#/alloc ns:ns-matrix))
284                  (prototype (#/init (#/alloc ns:ns-button-cell)))
285                  buttons cell-array)
286             (#/setTitle: prototype #@"7     ")
287             (#/setButtonType: prototype #$NSRadioButton)
288             (#/initWithFrame:mode:prototype:numberOfRows:numberOfColumns: 
289              matrix frame #$NSRadioModeMatrix prototype 1 7)
290             (setq cell-array (#/cells matrix))
291             (#/setTitle: (#/objectAtIndex: cell-array 0) #@"1")
292             (push (#/objectAtIndex: cell-array 0) buttons)
293             (#/setTitle: (#/objectAtIndex: cell-array 1) #@"2")
294             (push (#/objectAtIndex: cell-array 1) buttons)
295             (#/setTitle: (#/objectAtIndex: cell-array 2) #@"3")
296             (push (#/objectAtIndex: cell-array 2) buttons)
297             (#/setTitle: (#/objectAtIndex: cell-array 3) #@"4")
298             (push (#/objectAtIndex: cell-array 3) buttons)
299             (#/setTitle: (#/objectAtIndex: cell-array 4) #@"5")
300             (push (#/objectAtIndex: cell-array 4) buttons)
301             (#/setTitle: (#/objectAtIndex: cell-array 5) #@"6")
302             (push (#/objectAtIndex: cell-array 5) buttons)
303             (#/setTitle: (#/objectAtIndex: cell-array 6) #@"7")
304             (push (#/objectAtIndex: cell-array 6) buttons)
305             (setf (psd-function-key-buttons dialog) buttons)
306             matrix)))))
307
308(defun make-delete-buttons (dialog)
309  "Construct the buttons."
310  (flet ((make-button (title x-coord y-coord x-dim y-dim action)
311           (let ((button (#/alloc ns:ns-button)))
312             (ns:with-ns-rect (frame x-coord y-coord x-dim y-dim)
313               (#/initWithFrame: button frame))
314             (#/setButtonType: button #$NSMomentaryPushInButton)
315             (#/setBezelStyle: button #$NSRoundedBezelStyle)
316             (#/setTitle: button title)
317             (#/setTarget: button dialog)
318             (#/setAction: button action)
319             button)))
320    (list
321     (setf (psd-okay-button dialog)
322           (make-button #@"Delete" 500 10 80 32
323                        (ccl::@selector "deleteAction:")))
324     (make-button #@"Cancel" 400 10 90 32
325                  (ccl::@selector "cancelAction:")))))
326
Note: See TracBrowser for help on using the repository browser.