[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
"with-handlers" code (may be helpful).
- To: firstname.lastname@example.org
- Subject: "with-handlers" code (may be helpful).
- From: nakamura@SOE.Berkeley.Edu (Mark Nakamura)
- Date: Wed, 26 Sep 90 14:09:23 PDT
Here is some code that I just hacked up. If you're doing large amounts
of event-driven window interactions, then this might be of some use to
you. Comments and questions please. I _hope_ that the comments are
;; The with-handlers macro is designed to be used to temporarily modify the
;; event-handling behavior of a window, by setting up an extent (not a scope!)
;; during which some subset of the window's event handlers are redefined. This
;; should only be called under an ASK of a window.
;; The call
;; (ask window
;; (with-handlers ((handler-1-name new-def-1)
;; (handler-2-name new-def-2)
;; makes window FHAVE the handler-i-name's with definitions new-def-i, eval's
;; BODY as an implicit progn, rebinds the handler-i-name's to their initial
;; bindings or makes them funbound if they had no "window-local" definitions,
;; and returns what the last form of BODY returns.
(eval-when (compile eval load)
(defmacro with-handlers (temp-fbindings &body body)
;; temp-fbindings is a list of pairs (function-name temp-binding). For
;; each of the pairs, function-name's current function is saved (as the
;; function binding of OLD-function-name) and function-name is temporarily
;; given temp-fbinding as its function binding. The forms in body are
;; eval'ed as in a progn, and the value(s) of the last form is/are returned
;; after the function-names have had their initial function bindings
;; restored. The temporary functions may call the initial functions by
;; name, e.g. OLD-foo.
`(let ((wir ccl:*warn-if-redefine-kernel*)
,@(mapcar '(lambda (x) (name-had (car x))) temp-fbindings))
; make possible kernel-fn redefinitions silent
(setq ccl:*warn-if-redefine-kernel* nil)
; save current fn-bindings
,@(mapcar #'(lambda (fpair) (save-old (car fpair)))
; set up new function bindings
,@(mapcar #'(lambda (x) `(fhave ',(car x)
,(or (cadr x)
,@(mapcan #'(lambda (fpair) (restore-old (car fpair)))
(setq ccl:*warn-if-redefine-kernel* wir)))))
(defun save-old (fn)
;; Return a form that creates a new function named OLD-fn, and gives it the
;; current function binding of fn. Also, if fn is bound in the current
;; object, set variable HAD-fn to t.
`(if (fboundp ',fn)
(fhave ',(name-old fn)
(when (fownp ',fn) (setq ,(name-had fn) t)))
(fmakunbound ',(name-old fn))))
(defun restore-old (fn)
;; Return a form to restore the function binding of fn: if variable HAD-fn
;; is t, restore the binding from OLD-fn, otherwise make the current object
;; have fn unbound as a function.
`((if ,(name-had fn)
(fhave ',fn (symbol-function ',(name-old fn)))
(fmakunbound ',(name-old fn))))
(defun name-old (fn)
;; Create and return a (possibly new) symbol OLD-fn.
(intern (concatenate 'string "OLD-" (string fn))))
(defun name-had (fn)
;; Create and return a (possibly new) symbol HAD-fn.
(intern (concatenate 'string "HAD-" (string fn))))
;; Test code.
;; Define a new class of windows.
(defobject *new-window* *window*)
;; Create one of those windows.
(defvar *my-window* (oneof *new-window*))
(defobfun (window-click-event-handler *my-window*) (where)
;; Shadow the original click handler.
;; Beep then call the usual handler.
(defobfun (loop-click-event-handler *my-window*) (where)
;; Click handler that is used in do-with-new-click-handler.
;; Print where we are in the window.
(print (point-string where))
;; Do the old handler, which includes the usual handler.
;; Call the OLD-window-click-event-handler whose binding has been saved.
(defobfun (do-with-new-click-handler *my-window*) ()
;; Loop within with-handler which temporarily assigns *new-window*
;; with a new click handler.
;; Loop until command-key down.
;; Try clicking within loop to test loop-click-event-handler.
;; Exit do when by pressing command-key.
;; Allow for other things to happen.
;; Call this to test. Command-key to exit.
;; (ask *my-window* (do-with-new-click-handler))