(FILECREATED "31-Aug-87 15:39:25" {QV}<NOTECARDS>1.3KNEXT>KOTOTEDITPATCHES.;3 27898  

      changes to:  (VARS KOTOTEDITPATCHESCOMS)
		   (FNS \TEDIT.COMMAND.LOOP)

      previous date: "14-Jul-87 20:57:12" {QV}<NOTECARDS>1.3KNEXT>KOTOTEDITPATCHES.;2)


(* Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT KOTOTEDITPATCHESCOMS)

(RPAQQ KOTOTEDITPATCHESCOMS [(FNS \TEDIT.COMMAND.LOOP \TEDIT.FOREIGN.COPY? \TEDIT.SUBST.FN2 
				    TEDIT.GETINPUT BMOBJ.GETFN3 BMOBJ.DISPLAYFN BMOBJ.BUTTONEVENTINFN)
			       (DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS (NONE.TTC 0)
									  (CHARDELETE.TTC 1)
									  (WORDDELETE.TTC 2)
									  (DELETE.TTC 3)
									  (FUNCTIONCALL.TTC 4)
									  (REDO.TTC 5)
									  (UNDO.TTC 6)
									  (CMD.TTC 7)
									  (NEXT.TTC 8)
									  (EXPAND.TTC 9)
									  (PUNCT.TTC 20)
									  (TEXT.TTC 21)
									  (WHITESPACE.TTC 22)))
			       (DECLARE: DONTEVAL@LOAD (ADVISE (PROCESS.APPLY IN \TEDIT.BUTTONEVENTFN]
)
(DEFINEQ

(\TEDIT.COMMAND.LOOP
  [LAMBDA (STREAM RTBL)                                      (* Randy.Gobbel " 4-Aug-87 14:30")
                                                             (* ; 
							     
"Main command loop for the TEDIT editor.  Includes keyboard polling and command dispatch")
    (PROG ((TEXTOBJ (COND
			  ((type? STREAM STREAM)
			    (fetch (TEXTSTREAM TEXTOBJ) of STREAM))
			  (T STREAM)))
	     (ISCRSTRING (ALLOCSTRING \SCRATCHLEN " "))
	     SEL WINDOW LINES IPASSSTRING TTYWINDOW)
	    (SETQ SEL (fetch SEL of TEXTOBJ))
	    (SETQ WINDOW (fetch \WINDOW of TEXTOBJ))
	    (SETQ LINES (fetch LINES of TEXTOBJ))
	    (SETQ IPASSSTRING (SUBSTRING ISCRSTRING 1))
                                                             (* ; "Used inside \INSERT\TTY\BUFFER")
	    (SETQ RTBL (OR RTBL (fetch TXTRTBL of TEXTOBJ)
			       TEDIT.READTABLE))             (* ; "Used to derive command characters from type-in")
	    (for WW inside WINDOW do (WINDOWPROP WW (QUOTE PROCESS)
							 (THIS.PROCESS)))
                                                             (* ; "And the window to this process")
	    (until (OR (TTY.PROCESSP)
			   (fetch EDITFINISHEDFLG of TEXTOBJ))
	       do                                          (* ; 
							     "Wait until we really have the TTY before proceeding."
)
		    (DISMISS 100))
	    (RESETLST
	      (RESETSAVE (\TEDIT.COMMAND.RESET.SETUP (LIST TEXTOBJ WINDOW)
							 T))
	      (PROG (CH FN TCH (DIRTY NIL)
			  (BLANKSEEN NIL)
			  INSCH#
			  (CRSEEN NIL)
			  TLEN CHNO (READSA (fetch READSA of %#CURRENTRDTBL#))
			  (TERMSA (OR (fetch TXTTERMSA of TEXTOBJ)
					\PRIMTERMSA))
			  (TEDITSA (fetch READSA of RTBL))
			  (TEDITFNHASH (fetch READMACRODEFS of RTBL))
			  (LOOPFN (TEXTPROP TEXTOBJ (QUOTE LOOPFN)))
			  (CHARFN (TEXTPROP TEXTOBJ (QUOTE CHARFN)))
			  COMMANDFN)
		      (while (NOT (fetch EDITFINISHEDFLG of TEXTOBJ))
			 do
			  [ERSETQ
			    (while (NOT (fetch EDITFINISHEDFLG of TEXTOBJ))
			       do (PROGN
				      (\WAITFORSYSBUFP 25)
                                                             (* ; "Await type-in or mouse action")
				      (while (AND (NOT (fetch EDITFINISHEDFLG of TEXTOBJ))
						      (OR TEDIT.SELPENDING (fetch EDITOPACTIVE
										of TEXTOBJ)))
					 do                (* ; 
							     
"Don't do anything while he's selecting or one of the lock-out ops is active.")
					      [COND
						((EQ TEDIT.SELPENDING TEXTOBJ)
                                                             (* ; 
							     
"(OR (EQ TEDIT.SELPENDING TEXTOBJ) (fetch TCUP of (fetch CARET of TEXTOBJ)))")
                                                             (* ; 
							     
"If this TEdit is the one being selected in, or the caret is explicitly visible, flash it")
						  (TEDIT.FLASHCARET (fetch CARET of TEXTOBJ]
					      (BLOCK))
				      [COND
					((fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ))
					(T (COND
					     ((fetch TXTNEEDSUPDATE of TEXTOBJ)
                                                             (* ; 
							     
"We got here somehow with the window not in sync with the text.  Run an update.")
					       (\SHOWSEL SEL NIL NIL)
					       (TEDIT.UPDATE.SCREEN TEXTOBJ NIL T)
					       (\FIXSEL SEL TEXTOBJ)
					       (\SHOWSEL SEL NIL T)))
					   (TEDIT.FLASHCARET (fetch CARET of TEXTOBJ))
                                                             (* ; 
							     
"Flash the caret periodically (BUT not while we're here only to cleanup and quit.)")
					   (replace EDITOPACTIVE of TEXTOBJ with T)
                                                             (* ; 
							     
"Before starting to work, note that we're doing something.")
					   (AND LOOPFN (ERSETQ (APPLY* LOOPFN STREAM)))
                                                             (* ; 
							     
"If the guy wants control during the loop, give it to him.")
                                                             (* ; "Process any pending selections")
					   [COND
					     (TEDIT.COPY.PENDING 
                                                             (* ; "Have to copy the shifted SEL to caret.")
								 (SETQ TEDIT.COPY.PENDING NIL)
								 (\COPYSEL TEDIT.SHIFTEDSELECTION
									     (fetch SHIFTEDSEL
										of TEXTOBJ))
								 (ERSETQ (TEDIT.COPY
									     (fetch SHIFTEDSEL
										of TEXTOBJ)
									     (fetch SEL
										of TEXTOBJ)))
								 (replace SET of 
									   TEDIT.SHIFTEDSELECTION
								    with NIL)
								 (replace L1 of 
									   TEDIT.SHIFTEDSELECTION
								    with NIL)
								 (replace LN of 
									   TEDIT.SHIFTEDSELECTION
								    with NIL)
								 (\COPYSEL TEDIT.SHIFTEDSELECTION
									     (fetch SHIFTEDSEL
										of TEXTOBJ)))
					     (TEDIT.COPYLOOKS.PENDING
                                                             (* ; "Have to copy the shifted SEL to caret.")
					       (SETQ TEDIT.COPYLOOKS.PENDING NIL)
					       (\COPYSEL TEDIT.COPYLOOKSSELECTION
							   (fetch SHIFTEDSEL of TEXTOBJ))
					       [ERSETQ (COND
							   ((EQ (QUOTE PARA)
								  (fetch SELKIND
								     of (fetch SHIFTEDSEL
									     of TEXTOBJ)))
                                                             (* ; 
							     
"copy the paragraph looks, since the source selection type was paragraph")
							     (TEDIT.COPY.PARALOOKS TEXTOBJ
										     (fetch 
										       SHIFTEDSEL
											of TEXTOBJ)
										     (fetch SEL
											of TEXTOBJ))
							     )
							   (T 
                                                             (* ; "copy the character looks")
							      (TEDIT.COPY.LOOKS TEXTOBJ
										  (fetch SHIFTEDSEL
										     of TEXTOBJ)
										  (fetch SEL
										     of TEXTOBJ]
					       (\SHOWSEL (fetch SHIFTEDSEL of TEXTOBJ)
							   NIL NIL)
					       (replace SET of TEDIT.COPYLOOKSSELECTION
						  with NIL)
					       (replace L1 of TEDIT.COPYLOOKSSELECTION
						  with NIL)
					       (replace LN of TEDIT.COPYLOOKSSELECTION
						  with NIL)
					       (\COPYSEL TEDIT.COPYLOOKSSELECTION
							   (fetch SHIFTEDSEL of TEXTOBJ)))
					     (TEDIT.MOVE.PENDING 
                                                             (* ; "Have to move the ctrl-shift SEL to caret.")
								 (SETQ TEDIT.MOVE.PENDING NIL)
								 (\COPYSEL TEDIT.MOVESELECTION
									     (fetch MOVESEL
										of TEXTOBJ))
								 (TEDIT.DO.BLUEPENDINGDELETE SEL 
											  TEXTOBJ)
								 (ERSETQ (TEDIT.MOVE
									     (fetch MOVESEL
										of TEXTOBJ)
									     (fetch SEL
										of TEXTOBJ)))
								 (replace SET of 
									      TEDIT.MOVESELECTION
								    with NIL)
								 (replace L1 of 
									      TEDIT.MOVESELECTION
								    with NIL)
								 (replace LN of 
									      TEDIT.MOVESELECTION
								    with NIL)
								 (\COPYSEL TEDIT.MOVESELECTION
									     (fetch MOVESEL
										of TEXTOBJ)))
					     (TEDIT.DEL.PENDING
                                                             (* ; "Delete the current selection.")
					       (SETQ TEDIT.DEL.PENDING NIL)
                                                             (* ; "Above all, reset the demand flag first")
					       (ERSETQ (COND
							   ((fetch SET of TEDIT.DELETESELECTION)
                                                             (* ; 
							     
"Only try the deletion if he really set the selection.")
							     (\SHOWSEL (fetch DELETESEL
									    of TEXTOBJ)
									 NIL NIL)
                                                             (* ; "Turn off the selection highlights")
							     (\SHOWSEL (fetch SEL of TEXTOBJ)
									 NIL NIL)
							     (replace SET
								of (fetch DELETESEL of TEXTOBJ)
								with NIL)
							     (\COPYSEL TEDIT.DELETESELECTION
									 (fetch SEL of TEXTOBJ))
							     (\TEDIT.SET.SEL.LOOKS (fetch SEL
											of TEXTOBJ)
										     (QUOTE NORMAL))
                                                             (* ; "Grab the selection we're to use")
							     (\TEDIT.DELETE (fetch SEL
										 of TEXTOBJ)
									      (fetch \TEXTOBJ
										 of (fetch SEL
											 of TEXTOBJ)
										       )
									      NIL)
							     (replace L1 of TEDIT.DELETESELECTION
								with NIL)
							     (replace LN of TEDIT.DELETESELECTION
								with NIL]
					   (UNINTERRUPTABLY
                                               (replace (STRINGP OFFST) of ISCRSTRING
						  with 0)
					       (replace (STRINGP LENGTH) of ISCRSTRING
						  with \SCRATCHLEN))
					   (while (\SYSBUFP)
					      do           (* ; "Handle user type-in")
						   (SETQ CH (\GETKEY))
						   (COND
						     (CHARFN 
                                                             (* ; 
							     "Give the OEM user control for each character typed.")
							     (SETQ TCH (APPLY* CHARFN STREAM CH))
							     (OR (EQ TCH T)
								   (SETQ CH TCH))
                                                             (* ; 
							     
"And let him return one of NIL for 'ignore this char' , T for 'leave it be' or a new charcode.")
							     ))
						   (SELECTC (AND CH (\SYNCODE TEDITSA CH))
							      (CHARDELETE.TTC 
                                                             (* ; 
							     
"Backspace handler: Remove the character just before SEL:CH#.")
									      (\TEDIT.CHARDELETE
										TEXTOBJ ISCRSTRING 
										SEL)
									      (
								TEDIT.RESET.EXTEND.PENDING.DELETE
										SEL))
							      (WORDDELETE.TTC (\TEDIT.WORDDELETE
										TEXTOBJ)
									      (
								TEDIT.RESET.EXTEND.PENDING.DELETE
										SEL))
							      (DELETE.TTC 
                                                             (* ; "DEL Key handler: Delete the selected characters"
)
									  (\TEDIT.DELETE SEL 
											  TEXTOBJ)
									  (
								TEDIT.RESET.EXTEND.PENDING.DELETE
									    SEL))
							      (UNDO.TTC 
                                                             (* ; "He hit the CANCEL key, so go UNDO something")
									(TEDIT.UNDO TEXTOBJ)
									(
								TEDIT.RESET.EXTEND.PENDING.DELETE
									  SEL))
							      (REDO.TTC 
                                                             (* ; "He hit the REDO key, so go REDO something")
									(TEDIT.REDO TEXTOBJ)
									(
								TEDIT.RESET.EXTEND.PENDING.DELETE
									  SEL))
							      [FUNCTIONCALL.TTC
                                                             (* ; 
							     "This is a special character -- it calls a function")
								(COND
								  ((SETQ FN (GETHASH CH 
										      TEDITFNHASH))
                                                             (* ; "There IS a command function to be called.")
								    (APPLY* FN
									      (fetch STREAMHINT
										 of TEXTOBJ)
									      TEXTOBJ SEL)
                                                             (* ; "do it")
								    (\SHOWSEL SEL NIL NIL)
								    (
								TEDIT.RESET.EXTEND.PENDING.DELETE
								      SEL)
                                                             (* ; 
							     "After a user function, no more blue-pending-delete")
								    (\SHOWSEL SEL NIL T)
                                                             (* ; "And forget any pending deletion.")
								    ]
							      (NEXT.TTC 
                                                             (* ; 
							     
"Move to the next blank to fill in.  For now, blanks are delimited by >>...<<")
									(TEDIT.NEXT TEXTOBJ))
							      (EXPAND.TTC 
                                                             (* ; "EXPAND AN ABBREVIATION")
									  (\TEDIT.ABBREV.EXPAND
									    (fetch STREAMHINT
									       of TEXTOBJ)))
							      (SELECTC (AND TERMSA CH
										(fetch TERMCLASS
										   of (\SYNCODE
											  TERMSA CH)))
									 (CHARDELETE.TC 
                                                             (* ; 
							     
"Backspace handler: Remove the character just before SEL:CH#.")
											(
										\TEDIT.CHARDELETE
											  TEXTOBJ 
										       ISCRSTRING SEL)
											(
								TEDIT.RESET.EXTEND.PENDING.DELETE
											  SEL))
									 (WORDDELETE.TC 
                                                             (* ; "Back-WORD handler")
											(
										\TEDIT.WORDDELETE
											  TEXTOBJ)
											(
								TEDIT.RESET.EXTEND.PENDING.DELETE
											  SEL))
									 (LINEDELETE.TC 
                                                             (* ; "DEL Key handler: Delete the selected characters"
)
											(
										    \TEDIT.DELETE
											  SEL TEXTOBJ)
											(
								TEDIT.RESET.EXTEND.PENDING.DELETE
											  SEL))
									 (COND
									   (CH 
                                                             (* ; 
							     "Any other key was hit: Just insert the character.")
									       (
								       TEDIT.DO.BLUEPENDINGDELETE
										 SEL TEXTOBJ)
                                                             (* ; "Handle blue pending delete, if there is one.")
									       (TEDIT.\INSERT
										 CH SEL TEXTOBJ 
										 BLANKSEEN CRSEEN]
				      (replace EDITOPACTIVE of TEXTOBJ with NIL]
			  (replace EDITOPACTIVE of TEXTOBJ with NIL])

(\TEDIT.FOREIGN.COPY?
  (LAMBDA (SEL)                                              (* rht: "15-Dec-86 19:03")

          (* IF the current process's window isn't a TEdit window, do a "Copy" by BKSYSBUFing the selected text.
	  Then turn off all the various indicators.)



          (* * rht&rg 12/15/86: Now checks that SEL's CH# is reasonable before calling \SETUPGETCH.)


    (PROG (PROCW (SOURCE.TEXTOBJ (fetch \TEXTOBJ of SEL))
		   CH STREAM DEST.TEDIT? DEST.TEXTOBJ)
	    (SETQ DEST.TEDIT? (AND (SETQ PROCW (PROCESSPROP (TTY.PROCESS)
								    (QUOTE WINDOW)))
				       (SETQ DEST.TEXTOBJ (WINDOWPROP PROCW (QUOTE TEXTOBJ)))
				       (NOT (TEXTPROP DEST.TEXTOBJ (QUOTE COPYBYBKSYSBUF)))))

          (* Treat the destination specially if (1) the recipient process has a window, and (2) it's a TEdit window, and 
	  (3) the TEdit isn't declining special treatment by having COPYBYBKSYSBUF set in its props.)


	    (COND
	      ((OR (NOT DEST.TEDIT?)
		     (AND PROCW DEST.TEXTOBJ (NEQ SOURCE.TEXTOBJ DEST.TEXTOBJ)
			    (fetch EDITOPACTIVE of DEST.TEXTOBJ)))
                                                             (* OK -- receiver isn't TEdit.
							     Do it the hard way.)
		(if (LESSP (fetch CH# of SEL)
			       (fetch CHLIM of SEL))
		    then 

          (* * Only do this if mouse is not off the end of text.)


			   (\SETUPGETCH (fetch CH# of SEL)
					  SOURCE.TEXTOBJ)    (* Go to the first character to be copied)
			   (SETQ STREAM (fetch STREAMHINT of SOURCE.TEXTOBJ))
			   (for I from 1 to (fetch DCH of SEL)
			      do                           (* Run thru the selected text, copying only those 
							     items that really ARE characters--IMAGEOBJs don't get 
							     copied by this route.)
				   (COND
				     ((FIXP (SETQ CH (\BIN STREAM)))
				       (BKSYSBUF (CHARACTER CH)))
				     (T (COPYINSERT CH))))
			   (\SHOWSEL SEL NIL NIL)          (* Then reset the copy-pending flags.)
			   (SETQ TEDIT.COPY.PENDING NIL)))))))

(\TEDIT.SUBST.FN2
  [LAMBDA (TEXTOBJ TARGETLIST TRIALSTART# END#)            (* Randy.Gobbel "17-Jun-87 15:40")
                                                             (* will return the start char of a wildcarded 
							     selection. returns NIL if selection is beyond bounds)
    (LET (INDEX)
         (COND
	   ((NULL TARGETLIST)
	     TRIALSTART#)
	   [(LITATOM (CAR TARGETLIST))
	     (COND
	       ((MEMBER (CAR TARGETLIST)
			  (QUOTE (%#)))                    (* fixed width wildcard)
		 (SETQ INDEX (\TEDIT.SUBST.FN1 TEXTOBJ (CDR TARGETLIST)
						   (ADD1 TRIALSTART#)
						   END#))
		 (AND (NUMBERP INDEX)
			(SUB1 INDEX)))
	       (T                                            (* variable width wildcard, so forget them)
		  (\TEDIT.SUBST.FN2 TEXTOBJ (CDR TARGETLIST)
				      TRIALSTART# END#]
	   (T                                                (* it's a string)
	      (TEDIT.FIND TEXTOBJ (CAR TARGETLIST)
			    TRIALSTART# END# NIL])

(TEDIT.GETINPUT
  [LAMBDA (STREAM PROMPTSTRING DEFAULTSTRING DELIMITER.LIST)
                                                             (* Randy.Gobbel "22-Apr-87 15:22")
                                                             (* Ask for input (file names, &c) for TEdit, perhaps 
							     with a default.)

          (* * RG 4/22/87 fixed ambiguous PROMPTWINDOW record field reference)


    (PROG [(TEXTOBJ (TEXTOBJ STREAM))
	     (TPROMPT (OR (fetch (TEXTOBJ PROMPTWINDOW) of (TEXTOBJ STREAM))
			    (GETPROMPTWINDOW (\TEDIT.MAINW STREAM)
					       NIL NIL T]
	    (COND
	      (TPROMPT                                       (* If it's our own promptwindow, just clear it.)
		       (CLEARW TPROMPT))
	      (T                                             (* If it's the system's window, just move to a new 
							     line.)
		 (FRESHLINE PROMPTWINDOW)))
	    (RETURN (PROG1 (PROMPTFORWORD PROMPTSTRING DEFAULTSTRING NIL (OR TPROMPT 
										     PROMPTWINDOW)
						NIL
						(QUOTE TTY)
						(OR DELIMITER.LIST (CHARCODE (EOL LF TAB ESCAPE)))
						NIL)         (* Get what the guy wants to tell us)
			       (WINDOWPROP (OR TPROMPT PROMPTWINDOW)
					     (QUOTE PROCESS)
					     NIL)            (* Now detach the prompt window from its process, to 
							     avoid a circularity.)
			       ])

(BMOBJ.GETFN3
  [LAMBDA (STREAM)                                           (* rht: " 9-May-87 21:18")
                                                             (* ;;; 
							     
"reads a bitmap image object from a file.  This version stores the binary data rather than the character representation used by READBITMAP."
)
    (COND
      ((IEQP (\PEEKBIN STREAM)
	       (CHARCODE CR))                              (* ; 
							     
"This is an old-format sketch with bitmap included.  Skip the interfering CR.")
	(BIN STREAM)))
    (PROG [(SCALE (FPLUS (PLUS (LSH (BIN STREAM)
					    8)
				     (BIN STREAM))
			     (FQUOTIENT (PLUS (LSH (BIN STREAM)
							 8)
						  (BIN STREAM))
					  32768)))
	     (ROT (PLUS (LSH (BIN STREAM)
				   8)
			    (BIN STREAM]
	    (RETURN (BITMAPTEDITOBJ (\READBINARYBITMAP STREAM)
					SCALE ROT])

(BMOBJ.DISPLAYFN
  [LAMBDA (IMAGEOBJ IMAGE.STREAM)                            (* ; "Edited 17-Apr-87 15:02 by jds")
                                                             (* ; 
							     
"function which displays a scaled bitmap on only an interpress stream for now")
    (PROG ([FACTOR (fetch (BITMAPOBJ BMOBJSCALEFACTOR) of (IMAGEOBJPROP IMAGEOBJ
										(QUOTE OBJECTDATUM]
	     [BITMAP (fetch (BITMAPOBJ BITMAP) of (IMAGEOBJPROP IMAGEOBJ (QUOTE OBJECTDATUM]
	     (CACHE (IMAGEOBJPROP IMAGEOBJ (QUOTE CACHED.BITMAP)))
	     SHRUNK.BITMAP)                                  (* ; "(IMAGESTREAMTYPE IMAGE.STREAM)")
	    (SELECTQ (IMAGESTREAMTYPE IMAGE.STREAM)
		       (INTERPRESS                           (* ; 
							     
"Printing to an Interpress stream, so use the specialized method.")
				   (SHOWBITMAP.IP IMAGE.STREAM BITMAP NIL FACTOR 0))
		       (PROGN                              (* ; 
							     
"This is the default case, press display and everyone else prints the junky shrunk bitmap")
				(COND
				  ((NOT (SETQ SHRUNK.BITMAP CACHE))
				    [COND
				      [(LEQ FACTOR 1.0)    (* ; 
							     
"We're shrinking the bitmap.  Create a shrunk image for display")
					(SETQ SHRUNK.BITMAP (SHRINKBITMAP BITMAP
									      (FQUOTIENT 1.0 FACTOR)
									      (FQUOTIENT 1.0 FACTOR]
				      (T                     (* ; "We're expanding it.  Create a bigger one.")
					 (SETQ SHRUNK.BITMAP (EXPANDBITMAP BITMAP FACTOR FACTOR]
				    (IMAGEOBJPROP IMAGEOBJ (QUOTE CACHED.BITMAP)
						    SHRUNK.BITMAP)))
				(BITBLT SHRUNK.BITMAP NIL NIL IMAGE.STREAM (DSPXPOSITION NIL 
										     IMAGE.STREAM)
					  (DSPYPOSITION NIL IMAGE.STREAM)
					  (FIXR (FTIMES FACTOR (BITMAPWIDTH BITMAP)))
					  (FIXR (FTIMES FACTOR (BITMAPHEIGHT BITMAP])

(BMOBJ.BUTTONEVENTINFN
  [LAMBDA (IMAGEOBJ WINDOW SELECTION X Y SELWINDOW TEXTSTREAM BUTTON OPERATION)
                                                             (* Randy.Gobbel " 8-Jun-87 18:30")
                                                             (* ;;; 
							     
"the user has pressed a button inside the bitmap object IMAGEOBJ.  Bring up a menu of bitmap edit operations.")

          (* * rht&pmi 5/8/87: Removed TEdit dependent stuff used in the CHANGE.SCALE option; replaced with PROMPTFORWORD)


    (PROG* ((OBJ (IMAGEOBJPROP IMAGEOBJ (QUOTE OBJECTDATUM)))
	    (OLDSCALE (fetch (BITMAPOBJ BMOBJSCALEFACTOR) of OBJ))
	    NEW.BITMAP COMMAND.MENU COMMAND PREVIOUS.BITMAP NAME TEMP X Y PROMPT.WINDOW)
           (COND
	     ([OR (EQ BUTTON (QUOTE RIGHT))
		    (AND OPERATION (NEQ OPERATION (QUOTE NORMAL]
                                                             (* ; 
							     
" If he's extending a selection, or is selecting for move/copy/delete, DON'T bring up the bitmap editing menu!")
	       (RETURN)))
           (SETQ PREVIOUS.BITMAP (BITMAPCOPY (fetch (BITMAPOBJ BITMAP) of OBJ)))
           (SETQ NEW.BITMAP (SELECTQ [MENU (COND
						   ((type? MENU BITMAP.OBJ.MENU)
						     BITMAP.OBJ.MENU)
						   (T (SETQ BITMAP.OBJ.MENU (BMOBJ.CREATE.MENU]
					 (CHANGE.SCALE       (* ; "Change the scale on the bitmap.")
						       [CLEARW (SETQ PROMPT.WINDOW
								   (GETPROMPTWINDOW
								     (OR (WINDOWP WINDOW)
									   (WFROMDS WINDOW]
						       (replace (BITMAPOBJ BMOBJSCALEFACTOR)
							  of OBJ
							  with (OR (NUMBERP
									 (MKATOM (PROMPTFORWORD
										     
										"Scale Factor:  "
										     OLDSCALE NIL 
										    PROMPT.WINDOW)))
								       OLDSCALE))
                                                             (* ; 
							     
"Return the prevous bitmap, so we don't change the bits.")
						       PREVIOUS.BITMAP)
					 (HAND.EDIT (EDITBM PREVIOUS.BITMAP))
					 (TRIM (TRIM.BITMAP PREVIOUS.BITMAP))
					 (INVERT.HORIZONTALLY (INVERT.BITMAP.HORIZONTALLY 
										  PREVIOUS.BITMAP))
					 (INVERT.VERTICALLY (INVERT.BITMAP.VERTICALLY 
										  PREVIOUS.BITMAP))
					 (INVERT.DIAGONALLY (INVERT.BITMAP.DIAGONALLY 
										  PREVIOUS.BITMAP))
					 (ROTATE.BITMAP.LEFT (ROTATE.BITMAP.LEFT PREVIOUS.BITMAP))
					 (ROTATE.BITMAP.RIGHT (ROTATE.BITMAP.RIGHT 
										  PREVIOUS.BITMAP))
					 (SHIFT.LEFT (INTERACT&SHIFT.BITMAP.LEFT PREVIOUS.BITMAP))
					 (SHIFT.RIGHT (INTERACT&SHIFT.BITMAP.RIGHT PREVIOUS.BITMAP))
					 (SHIFT.DOWN (INTERACT&SHIFT.BITMAP.DOWN PREVIOUS.BITMAP))
					 (SHIFT.UP (INTERACT&SHIFT.BITMAP.UP PREVIOUS.BITMAP))
					 (INTERCHANGE.BLACK/WHITE (INVERT.BITMAP.B/W 
										  PREVIOUS.BITMAP))
					 (ADD.BORDER (INTERACT&ADD.BORDER.TO.BITMAP PREVIOUS.BITMAP)
						     )
					 (RETURN NIL)))
           (replace (BITMAPOBJ BITMAP) of OBJ with NEW.BITMAP)
           (IMAGEOBJPROP IMAGEOBJ (QUOTE CACHED.BITMAP)
			   NIL)                              (* ; 
							     
"And clear any cached shrunk bitmaps so the display looks reasonable.")
           (RETURN (QUOTE CHANGED])
)
(DECLARE: EVAL@COMPILE DONTCOPY 
(DECLARE: EVAL@COMPILE 

(RPAQQ NONE.TTC 0)

(RPAQQ CHARDELETE.TTC 1)

(RPAQQ WORDDELETE.TTC 2)

(RPAQQ DELETE.TTC 3)

(RPAQQ FUNCTIONCALL.TTC 4)

(RPAQQ REDO.TTC 5)

(RPAQQ UNDO.TTC 6)

(RPAQQ CMD.TTC 7)

(RPAQQ NEXT.TTC 8)

(RPAQQ EXPAND.TTC 9)

(RPAQQ PUNCT.TTC 20)

(RPAQQ TEXT.TTC 21)

(RPAQQ WHITESPACE.TTC 22)

(CONSTANTS (NONE.TTC 0)
	   (CHARDELETE.TTC 1)
	   (WORDDELETE.TTC 2)
	   (DELETE.TTC 3)
	   (FUNCTIONCALL.TTC 4)
	   (REDO.TTC 5)
	   (UNDO.TTC 6)
	   (CMD.TTC 7)
	   (NEXT.TTC 8)
	   (EXPAND.TTC 9)
	   (PUNCT.TTC 20)
	   (TEXT.TTC 21)
	   (WHITESPACE.TTC 22))
)
)
(DECLARE: DONTEVAL@LOAD 

(PUTPROPS PROCESS.APPLY-IN-\TEDIT.BUTTONEVENTFN READVICE [(\TEDIT.BUTTONEVENTFN . PROCESS.APPLY)
							    (AROUND NIL (ADD.PROCESS
								      (LIST USERFN (KWOTE W])
(READVISE PROCESS.APPLY-IN-\TEDIT.BUTTONEVENTFN)
)
(PUTPROPS KOTOTEDITPATCHES COPYRIGHT ("Xerox Corporation" 1985 1986 1987))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1024 26880 (\TEDIT.COMMAND.LOOP 1034 . 15752) (\TEDIT.FOREIGN.COPY? 15754 . 17997) (
\TEDIT.SUBST.FN2 17999 . 19070) (TEDIT.GETINPUT 19072 . 20530) (BMOBJ.GETFN3 20532 . 21500) (
BMOBJ.DISPLAYFN 21502 . 23478) (BMOBJ.BUTTONEVENTINFN 23480 . 26878)))))
STOP