Re: Modal dialogs like the Finder

[bill (Bill St. Clair)]

> Date: Fri, 18 Oct 91 12:57:18 -0400
> To: info-mcl@cambridge.apple.com (Macintosh Common Lisp)
> From: cartier@math.uqam.ca (Guillaume Cartier)
> Subject: Modal dialogs like the Finder
> 
> I need to do some computations while reporting the progress
> to the user (this is a fairly common task!).
> 
> I would like the report window to be modal like the Finder's but
> calling "modal-dialog" does'nt return immediatly so I am stuck.
> 
> Is there a way to get the behaviour I want?
> Thanks.

Well, here's a start.  This doesn't handle clicking in the close box correctly.
You need to set up a catch for the tag CCL::%MODAL-DIALOG to do that.
It also completely disables the menus.  Doing this correctly modulo the
system 7 user interface guidelines is tricky.

Enjoy!

(defmacro with-modal-report-dialog (dialog &body body)
  (let ((thunk (gensym)))
    `(let ((,thunk #'(lambda () ,@body)))
       (declare (dynamic-extent ,thunk))
       (call-with-modal-report-dialog ,dialog ,thunk))))

(defun call-with-modal-report-dialog (dialog thunk &optional close-on-exit)
  (unwind-protect
    (let ((*eventhook* 
           #'(lambda (&aux (event *current-event*)
                           (what (rref event eventRecord.what)))
               (unless (eq (window-layer dialog) 0)
                 (set-window-layer dialog 0))
               (block eventhook
                 (case what
                  (#.#$MouseDown
                   (%stack-block ((wp 4))
                     (let* ((code (#_FindWindow (rref event eventRecord.where) 
                                                wp)))
                       (cond
                        ((eq code #$inMenubar))
                        ((%ptr-eql (wptr dialog) (%get-ptr wp))
                         (return-from eventhook nil))))))
                  ((#.#$KeyDown #.#$AutoKey))
                  (t (return-from eventhook nil)))
                 (ed-beep)
                 t)))
          (*modal-dialog-on-top* dialog))
      (set-window-layer dialog 0)
      (window-select dialog)
      (funcall thunk))
    (if close-on-exit
      (window-close dialog)
      (window-hide dialog))))