home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / source / oodleutl.cpt / oodles-of-utils / brutal-utils / traps-u.lisp < prev   
Encoding:
Text File  |  1992-02-05  |  3.3 KB  |  98 lines
  1. (in-package :oou)
  2. (oou-provide :Traps-u)
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;; traps-u.Lisp
  5. ;;
  6. ;; Copyright ⌐ 1992 Northwestern University Institute for the Learning Sciences
  7. ;; All Rights Reserved
  8. ;;
  9. ;; author: Michael S. Engber
  10. ;;
  11. ;; Utilities for working with trap calls 
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.  
  14. (oou-dependencies :+OSUtils
  15.                   )
  16.  
  17. (export '(on-trap-nz-error trap-nz-echeck with-patched-trap
  18.           ))
  19.  
  20. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21.  
  22. (eval-when (:compile-toplevel :load-toplevel :execute)
  23.   
  24.   (defmacro on-trap-nz-error (trap-form &rest body)
  25.     (let* ((result (gensym))
  26.            (trap-call (if (eq 'require-trap (first trap-form))
  27.                         (rest trap-form)
  28.                         trap-form))
  29.            (args (rest trap-call)))
  30.       `(let ((,result ,trap-call))
  31.          (declare (dynamic-extent ,result)
  32.                   (fixnum ,result))
  33.          (unless (zerop ,result)
  34.            ,@body
  35.            (error (MacOS-nz-error-string ',trap-form ',args ,result) ,@args))
  36.          0)))
  37.   
  38.   (defmacro trap-nz-echeck (trap-call)
  39.     `(on-trap-nz-error ,trap-call))
  40.   
  41.   (defmacro with-patched-trap ((trap-number new-trap-addr &optional (old-trap-addr (gensym))) &body body)
  42.     (let ((trap-type (if (plusp (logand #x0800)) #$ToolTrap #$OSTrap)))
  43.       `(with-macptrs ((,old-trap-addr (%int-to-ptr (#~NGetTrapAddress ,trap-number ,trap-type))))
  44.          (unwind-protect
  45.            (progn
  46.              (#~NSetTrapAddress (%ptr-to-int ,new-trap-addr) ,trap-number ,trap-type)
  47.              ,@body)
  48.            (#~NSetTrapAddress (%ptr-to-int ,old-trap-addr) ,trap-number ,trap-type)))))
  49.   
  50.   )
  51.  
  52. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  53.  
  54.  
  55. (defun MacOS-nz-error-string (trap-form args result)
  56.   (format nil
  57.           "mac error code = ~s~%> from trap call: ~s~%>  with arg vals: ~{~%>    ~s = ~~s~}"
  58.           result
  59.           trap-form
  60.           args))
  61.  
  62. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  63.  
  64. #|
  65.  
  66. ;;example of patching EraseRect to do nothing. Useful for keeping
  67. ;; TextEdit from doing an EraseRect before imaging the text.
  68.  
  69. (defpascal dummy-EraseRect (:ptr r :void) (declare (ignore r)))
  70.  
  71. (defparameter *test-w* (make-instance 'window :view-size #@(200 200) :view-font '("Chicago" 12)))
  72.  
  73. (with-focused-view *test-w*
  74.  
  75.     (let* ((topLeft #@(0 0))
  76.            (botRight (view-size *test-w*))
  77.            (mid (round (+ (point-v topLeft) (point-v botRight)) 2)))
  78.       (rlet ((r  :Rect :topLeft topLeft :botRight botRight)
  79.              (r1 :Rect :topLeft topLeft :bottom  mid :right (point-h botRight))
  80.              (r2 :Rect :top mid :left (point-h topLeft) :botRight botRight))
  81.  
  82.         (#_FillRect r *gray-pattern*)
  83.  
  84.         (#_InsetRect r1 15 15)
  85.         (#_InsetRect r2 15 15)
  86.         (#_FrameRect r1)
  87.         (#_FrameRect r2)
  88.         (let ((text1 "Here is normal text edit drawing via _TextBox. Note: it calls EraseRect 1st")
  89.               (text2 "Here the EraseRect trap has been patched to do nothing."))
  90.           (with-cstrs ((text1_p text1)
  91.                        (text2_p text2))
  92.         (#_TextBox text1_p (length text1) r1 #$teJustCenter)
  93.         (with-patched-trap (#_EraseRect dummy-EraseRect)
  94.           (#_TextBox text2_p (length text2) r2 #$teJustCenter)))))))
  95.  
  96.  
  97.  
  98. |#