[Openmcl-devel] y-or-n-dialog contribution

[Arthur W Cater]

Here's a y-or-n-dialog function using cocoa calls. Maybe there was something like it already but I failed to find it.
Suggested improvements most welcome: I am just learning ...

(in-package :easygui)

(defun y-or-n-dialog (message)
  (let* (dialog content
         (app (#/sharedApplication ns:ns-application))
         (yes (make-instance 'ns:ns-button))
         (no (make-instance 'ns:ns-button))
         (query (make-instance 'ns:ns-text-field)))
    (flet ((buttonize (button text x action)
             (dcc (#/setTitle: button text))
             (dcc (#/setBezelStyle: button #$NSRoundedBezelStyle))
             (dcc (#/sizeToFit button))
             (if (< x 0)
               (let ((left (- 0 x (ns:ns-rect-width (dcc (#/bounds button))))))
                 (dcc (#/setFrameOrigin: button (ns:make-ns-point left 9))))
               (dcc (#/setFrameOrigin: button (ns:make-ns-point x 9))))
             (dcc (#/addSubview: content button))
             (dcc (#/setTarget: button app))
             (dcc (#/setAction: button action))))
      (dcc (#/setStringValue: query message))
      (dcc (#/setFrameOrigin: query (ns:make-ns-point 9 48)))
      (dcc (#/sizeToFit query))
      (let* ((querybounds (dcc (#/bounds query)))
             (width (max 100.0 (+ 18.0 (ns:ns-rect-width querybounds))))
             (rect (ns:make-ns-rect
                    *window-position-default-x*
                    *window-position-default-y*
                    width
                    (max 90.0 (+ 57.0 (ns:ns-rect-height querybounds))))))
        (setf dialog (make-instance 'ns:ns-window
                       :with-content-rect rect
                       :style-mask (logior #$NSBorderlessWindowMask #$NSTexturedBackgroundWindowMask)
                       :backing #$NSBackingStoreBuffered ; TODO? Copied from ccl:examples/cocoa/easygui/views.lisp
                       :defer nil)
              content (#/contentView dialog))
        (buttonize yes "Yes" 9 (@selector #/stopModal))
        (buttonize no "No" (- 9 width) (@selector #/abortModal)))
      (dcc (#/addSubview: content query))
      (prog1
          (eq #$NSRunStoppedResponse (dcc (#/runModalForWindow: app dialog)))
          (#/close dialog)))))
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://lists.clozure.com/pipermail/openmcl-devel/attachments/20080905/802f366d/attachment.htm>