Re: An infrequenct error

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

I've been attempting to reproduce the error more often,
so I can find the bug and kill it.
I was successful in the former, and failed in the latter.
Here is code that will produce the following error:

#|
> Error: Can't throw to tag CCL::%MODAL-DIALOG .
> While executing: WINDOW-EVENT
> Type Command-/ to continue, Command-. to abort.
1 > 
|#

Hacker of the year award to anyone who can figure
out how to get the interrupt-event loop and
read-eval-print loop in sync enough to get the
dotimes at the bottom of this file to survive
all 100 iterations. :-)

(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
        ;You DON'T want to have window-show t.
        ;Otherwise it could be that the timer will elapse (say after a gc)
before
        ;the modal-dialog kicks in.  modal-dialog will show the window
anyway,
        ;and you NEVER want a non-modal *about* window.
        :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 (and (>= (- (get-universal-time) show-time) 0)
             (eq *in-modal-dialog* (self))            ;Make 100% sure (HA!)
that we can
        )                                             ;do the
return-from-modal-dialog.
                                                      ;NO!  This didn't
help!!!
    (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 ()
;  (gc)
  (modal-dialog
    (oneof *about*
      :window-size #@(520 140)
      :window-title "About"
;      :ignore (gc)
      :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)
;          :ignore (gc)
    ) ) )
    (gc) ;DON'T close on return!  Need it later for About menu-item.
         ;This (gc) used to be just nil, but (gc) returns nil, and this is
when
         ;it needs to happen to have the effect I want.  Note that
SOMETIMES
         ;this causes an error.  So far, within 4 iterations of the dotimes
below.
  )
;  (gc)
)

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

(dotimes (i 100)
  (print i)
  (about-screen-start-up)
)

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