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

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

Updates for ccl 1.7

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