An infrequent error

[lynch@aristotle.ils.nwu.edu (Richard Lynch)]

;We are working on a very large project.
;I wrote a little code one day while my partner
;was catching up with his side of the project
;that would make little about screen (or two)
;and automatically install them in the apple-menu.

;Of course, we also display the window during start-up,
;and I put a timer in to make it go away after 5 seconds.
;(Or if there is a mouse-click or keyboard event, of course.)

;SOMETIMES when we start up with our main file
;(ie double-click on it in Finder), the following error comes up:
#|
> While executing: CCL::RECORD-SOURCE-FILE
> Error: Can't throw to tag CCL::%MODAL-DIALOG .
> While executing: WINDOW-EVENT
> Type Command-/ to continue, Command-. to abort.
|#
;I can only surmise that somehow the window gets built
;and has null-event-handler called on it BEFORE the
;modal-dialog tag exists, but that doesn't seem right...

;I haven't touched the mouse or keyboard in these instances.
;One possible solution I just thought of is to add a test for
*in-modal-dialog*,
;but I wonder if it will be set when the tag doesn't exist yet, and
;don't want to take the shotgun approach to debugging.

;SO, here is the code that does the about window, (which is actually
;pretty nice and an improved version of what I submitted a couple
;months ago...except that this timer seems to jump the gun
;sometimes to produce the error above.

;Unfortunately, when I tried it 10X with JUST this file, I can't get
;the bug to happen, and I'm NOT going to send y'all the tons
;of code you'd need to see the bug for sure.  Unless you actually
;want it.

;Any hints, suggestions, guesses, wild speculation,
;derogatory remarks welcome.

;Warning, the Net will almost-fer-sure munge the ellipsis character
;of which there are two or three below.

(require 'init)
(defobject *about* *dialog*)

(defmacro prep-next-about-window (next-about)
"Returns a back-quoted form which can be placed on the event
queue to be evaluated.  This form will call modal-dialog on
next-about if there is one."
 `(eval-enqueue
    `(if ,,next-about (modal-dialog ,,next-about nil))
) )

(defobfun (exist *about*) (init-list)
  (declare (object-variable next-about prev-about))
  ;give it a next and prev links
  (have 'next-about nil)
  (have 'prev-about nil)
  (have 'show-time (get-universal-time))
  ;search out the first and last about windows so far.
  (let* ((about-wins (windows *about* t t))
         (first-win (find-if #'(lambda (about-win) (null (ask about-win
prev-about)))
                             about-wins
         )          )
         (last-win (find-if #'(lambda (about-win) (null (ask about-win
next-about)))
                            about-wins
         )         )
        )
    (setq next-about nil)
    (setq prev-about last-win)
    ;build the window
    (usual-exist
      (init-list-default init-list
        :window-type :double-edge-box
        :window-show nil
    ) )
    ;add in the new window
    (when last-win
      (let ((new-win (self)))
        (ask last-win
          (set-window-size (add-points (window-size) #@(0 25)))
          (setq next-about new-win)
          (add-dialog-items
            (oneof *button-dialog-item*
              :dialog-item-nick-name 'cancel
              :dialog-item-text "Cancel"
              :dialog-item-position (subtract-points (window-size)
                                                     #@(70 20)
                                    )
              :default-button nil
              :dialog-item-action
              (nfunction dialog-item-action
                (lambda ()
                  (declare (object-variable my-dialog))
                  (usual-dialog-item-action)
                  (ask my-dialog
                    (return-from-modal-dialog nil)
              ) ) )
    ) ) ) ) )
    (when (null first-win)
      (let ((new-win (self))
            (window-title (window-title))
           )
        (ask *apple-menu*
          (remove-menu-items (find-menu-item "About MACLI"))
          (add-menu-items
            (oneof *menu-item*
              :menu-item-title (concatenate 'string "About " window-title
"I") ;Note the ellipsis character, not three periods
              :menu-item-action
              (nfunction menu-item-action
                (lambda ()
                  (modal-dialog new-win nil)
              ) )
    ) ) ) ) )
) )

(defobfun (window-click-event-handler *about*) (where)
  (declare (object-variable next-about))
  (if (let ((cancel-button (find-named-dialog-item 'cancel)))
        (and cancel-button (ask cancel-button (point-in-item-p where)))
      )
    (usual-window-click-event-handler where)
    (prep-next-about-window next-about)
  )
  (return-from-modal-dialog nil)
)

(defobfun (window-key-event-handler *about*) (char)
  (declare (object-variable next-about) (ignore char))
  (prep-next-about-window next-about)
  (return-from-modal-dialog nil)
)

(defobfun (window-select *about*) ()
  (declare (object-variable show-time))
  (setq show-time (get-universal-time))
  (usual-window-select)
)

(defobfun (window-show *about*) ()
  (declare (object-variable show-time))
  (setq show-time (get-universal-time))
  (usual-window-show)
)

(defobfun (window-null-event-handler *about*) ()
  (declare (object-variable show-time next-about))
  (when (> (- (get-universal-time) show-time) 5)
    (prep-next-about-window next-about)
    (return-from-modal-dialog nil)
) )

;Use this function while futzing with the about windows to clear out all of
the mess and
;start over.  Yes, I use this one a lot. :-)

(defun reset-abouts ()
"This function will remove all the 'About <blank>I's from
the Apple menu and close all children of *about*."
  (dolist (about-win (windows *about* t t))
    (ask about-win (window-close))
  )
  (ask *apple-menu*
    (apply #'remove-menu-items (menu-items))
) )

#|
;Sample.
;This sample assumes you are about to make an application.
;RTFM for details about *restore-lisp-functions* and why windows can't just
be pre-fab.

(defun about-screen-start-up ()
  (modal-dialog
    (oneof *about*
      :window-size #@(520 140)
      :window-title "About"
      :dialog-items
      (list
        (oneof *static-text-dialog-item*
          :dialog-item-text (format nil
                              ") MCMXCI Northwestern University, The
Institute For The Learning Sciences~%~
                               Author:  Richard Lynch~%~
                               ~%~
                               Please forward any suggestions, bugs, or
improvements to:~%~
                               lynch@ils.nwu.edu~%~
                               The Institute For The Learning Sciences~%~
                               1890 Maple~%~
                               Evanston, IL  60201-3142"
                            )
          :dialog-item-position #@(4 4)
    ) ) )
    nil ;DON'T close on return!  Need it later for About menu-item.
) )

(setq *restore-lisp-functions* (append *restore-lisp-functions*
#'about-screen-start-up))

(about-screen-start-up)

|#

"TANSTAAFL" Rich lynch@aristotle.ils.nwu.edu