home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / source / oodleutl.cpt / oodles-of-utils / NotInROM / +TextEdit.lisp < prev    next >
Encoding:
Text File  |  1992-02-13  |  1.6 KB  |  40 lines
  1. ;; -*- package: NotInROM -*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;; +TextEdit.Lisp
  4. ;;
  5. ;; Copyright ⌐ 1991 Northwestern University Institute for the Learning Sciences
  6. ;; All Rights Reserved
  7. ;;
  8. ;; author: Michael S. Engber
  9. ;;
  10. ;; Provides missing TextEdit Routines
  11. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  12.  
  13. (eval-when (:compile-toplevel :load-toplevel :execute)
  14.   (require    :NotInROM-u)
  15.   (in-package :NotInROM))
  16.  
  17. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  18.  
  19. (deftrap-NotInROM _TEFromScrap :OSErr ()
  20.   (block exit
  21.     (rlet ((scrap-offset_p :long))
  22.       (let ((scrap-size (#_GetScrap (%null-ptr) "TEXT" scrap-offset_p)))
  23.         (when (minusp scrap-size)  (return-from exit scrap-size))
  24.         (when (> scrap-size 32000) (return-from exit #$teScrapSizeErr))
  25.         (with-macptrs ((TEScrap_h (%get-ptr (%int-to-ptr #$TEScrpHandle))))
  26.           (let ((ecode (#_GetScrap TEScrap_h "TEXT" scrap-offset_p)))
  27.             (when (minusp ecode)  (return-from exit ecode))
  28.             (%put-word (%int-to-ptr #$TEScrpLength) scrap-size)
  29.             #$noErr))))))
  30.  
  31. (deftrap-NotInROM _TEToScrap :OSErr ()
  32.   (with-macptrs ((TEScrap_h (%get-ptr (%int-to-ptr #$TEScrpHandle))))
  33.     (with-dereferenced-handles ((TEScrap_p TEScrap_h))
  34.       (#_PutScrap (%get-unsigned-word (%int-to-ptr #$TEScrpLength)) "TEXT" TEScrap_p))))
  35.  
  36. (deftrap-NotInROM _SetWordBreak :none ((wBrkProc :ProcPtr) (hTE :TEHandle))
  37.   (setf (href hTE :TERec.wordBreak) wBrkProc))
  38.  
  39. (deftrap-NotInROM _SetClikLoop :none ((clikProc :ProcPtr) (hTE :TEHandle))
  40.   (setf (href hTE :TERec.clikLoop) clikProc))