home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / source / oodleutl.cpt / oodles-of-utils / patches / call-with-focus-view-patch.lisp < prev    next >
Encoding:
Text File  |  1992-05-05  |  959 b   |  32 lines
  1. (in-package :ccl)
  2.  
  3. ;; focus-view-patch.lisp
  4. ;; call-with-focused-view becomes a generic function at
  5. ;; Mike Engber's suggestion.
  6.  
  7. (let ((*warn-if-redefine* nil)
  8.       (*warn-if-redefine-kernel* nil))
  9.  
  10. (without-interrupts
  11.  
  12. (unless (typep #'call-with-focused-view 'generic-function)
  13.   (fmakunbound 'call-with-focused-view))
  14.  
  15. (defmethod call-with-focused-view (view function &optional font-view)
  16.   (let* ((old-view *current-view*)
  17.          (old-font-view *current-font-view*)
  18.          wptr ff ms)
  19.     (if (and (eq view old-view) (eq font-view old-font-view))
  20.       (funcall function view)
  21.       (unwind-protect
  22.         (progn
  23.           (when (and view (null old-font-view) font-view (setq wptr (wptr view))
  24. )
  25.             (multiple-value-setq (ff ms) (wptr-font-codes wptr)))
  26.           (focus-view view font-view)
  27.           (funcall function view))
  28.         (when wptr
  29.           (set-wptr-font-codes wptr ff ms))
  30.         (focus-view old-view old-font-view)))))
  31. ))
  32.