source: release/1.2/source/examples/cocoa/easygui/dialogs.lisp @ 11798

Last change on this file since 11798 was 11798, checked in by cater, 10 years ago

Provide some dialogs

File size: 4.1 KB
Line 
1(in-package :easygui)
2
3;;; Contributed to Clozure CL by AWSC, Feb 2009.
4;;; Permission is granted to use, redistribute, and modify.
5;;;
6;;; Provides some generally useful dialogs:
7;;;    y-or-n-dialog
8;;;    choose-file-dialog     (original from Gary Byers)
9;;;    choose-new-file-dialog (adapted from that)
10;;;    user-pick-color        (TODO: improve)
11;;; To use them you will probably want to set *debug-cocoa-calls* to NIL.
12
13(defun y-or-n-dialog (message)
14  (let ((alert (make-instance 'ns:ns-alert)))
15    (#/setMessageText: alert message)
16    (#/addButtonWithTitle: alert "Yes")
17    (#/addButtonWithTitle: alert "No")
18    (eql (#/runModal alert) #$NSAlertFirstButtonReturn)))
19
20(defun choose-file-dialog (&key button-string)
21  (declare (ignorable button-string))
22  (gui::with-autorelease-pool 
23      (let* ((panel (dcc (#/autorelease (dcc (#/openPanel ns:ns-open-panel)))))) ; allocate an NSOpenPanel
24        (dcc (#/setAllowsMultipleSelection: panel nil)) ; return at most one filename
25        (when button-string (dcc (#/setPrompt: panel button-string)))
26        (when (eql #$NSOKButton
27                   (dcc (#/runModalForDirectory:file:types: panel
28                      +null-ptr+ ; default to last dir used
29                      +null-ptr+ ; no preselected file
30                      ;; If not NIL below then an ObjC array containing NSStrings could be used
31                      ;; to restrict the file types we're interested in
32                      #$NIL)))
33          ;; Because we told the panel to disallow multiple selection,
34          ;; there should be exactly one object in this array, an
35          ;; NSString describing the selected file.
36          (let* ((files (dcc (#/filenames panel))))
37            (if (eql 1 (dcc (#/count files)))
38              (gui::lisp-string-from-nsstring (dcc (#/objectAtIndex: files 0)))
39              (error "Don't know why we didn't get an NSArray containing exactly 1 file here.")))))))
40
41(defun choose-new-file-dialog (&key button-string)
42  (declare (ignorable button-string))
43  (gui::with-autorelease-pool 
44      (let* ((panel (dcc (#/autorelease (dcc (#/savePanel ns:ns-save-panel)))))) ; allocate an NSSavePanel
45        (when button-string (dcc (#/setPrompt: panel button-string)))
46        (when (eql #$NSOKButton
47                   (dcc (#/runModalForDirectory:file: panel
48                      +null-ptr+ ; default to last dir used
49                      +null-ptr+)))
50          ;; Because we told the panel to disallow multiple selection,
51          ;; there should be exactly one object in this array, an
52          ;; NSString describing the selected file.
53          (let* ((files (dcc (#/filenames panel))))
54            (if (eql 1 (dcc (#/count files)))
55              (gui::lisp-string-from-nsstring (dcc (#/objectAtIndex: files 0)))
56              (error "Don't know why we didn't get an NSArray containing exactly 1 file here.")))))))
57
58(objc:defmethod (#/NSWindowWillCloseNotification :void) ((self ns:ns-color-panel))
59  (dcc (#/stopModal (#/sharedApplication ns:ns-application))))
60 
61(defun user-pick-color (&key color (prompt "Pick a color") position)
62  "POSITION argument is provided only for Digitool MCL compatibility, it is ignored"
63  (declare (ignore position))
64  (gui::with-autorelease-pool 
65    (let* ((panel (dcc (#/sharedColorPanel ns:ns-color-panel)))) ; find or create the NSColorPanel
66      (dcc (#/setPickerMode: ns:ns-color-panel #$NSWheelModeColorPanel))
67      (dcc (#/setTitle: panel prompt))
68      (dcc (#/addObserver:selector:name:object:                 ; observe yourself close but
69       (dcc (#/defaultCenter ns:ns-notification-center))        ; sadly confound OK & CANCEL
70       panel
71       (objc:\@selector #/NSWindowWillCloseNotification)
72       "NSWindowWillCloseNotification"
73       panel))
74      (when color (dcc (#/setColor: panel color)))
75      (dcc (#/runModalForWindow: (#/sharedApplication ns:ns-application) panel))
76      (dcc (#/removeObserver:name:object:                       ; prevent pileup
77       (dcc (#/defaultCenter ns:ns-notification-center))
78       panel
79       "NSWindowWillCloseNotification"
80       panel))
81      (dcc (#/retain (dcc (#/color panel)))))))
Note: See TracBrowser for help on using the repository browser.