(DEFINE-FILE-INFO PACKAGE "IL" READTABLE "INTERLISP" BASE 10)
(FILECREATED "14-Oct-88 18:05:48" {QV}<NOTECARDS>1.3MNEXT>MEDLEYTEDITPATCHES.;3 33608
changes to%: (FNS TEDIT.PROMPTPRINT)
(ADVICE (PROCESS.APPLY :IN \TEDIT.BUTTONEVENTFN))
previous date%: "10-Oct-88 16:38:09" {QV}<NOTECARDS>1.3MNEXT>MEDLEYTEDITPATCHES.;1)
(* "
Copyright (c) 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT MEDLEYTEDITPATCHESCOMS)
(RPAQQ MEDLEYTEDITPATCHESCOMS
(
(* ;; " Does WINDOWP check in both fns to avoid infamous %"DON'T%" case.")
(FNS TEDIT.GETINPUT TEDIT.PROMPTPRINT)
(* ;; "\TEDIT.COMMAND.LOOP now checks EDITFINISHEDFLG while waiting for TTY, so can't get hung forever, also checks TTY.PROCESSP before calling TEDIT.FLASHCARET, to eliminate spurious caret images hanging around.")
(* ;; "(DECLARE%%: DONTCOPY DONTEVAL@LOAD EVAL@COMPILE (FILES (FROM {ERIS}<TEDIT>) TEDITDECLS (FROM LISPUSERS) EXPORTS.ALL))")
(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)
(\SCRATCHLEN 10)))
(* ;; "\TEDIT.COMMAND.LOOP from TEDITCOMMAND, \TEDIT.WAITFORSYSBUFP is new")
(FNS \TEDIT.COMMAND.LOOP \TEDIT.WAITFORSYSBUFP)
(* ;; "First advice makes tedit menu run in a new process, second fixes promptwindow problem in TEDIT.GET (from TEDITFILE).")
(ADVISE (PROCESS.APPLY :IN \TEDIT.BUTTONEVENTFN))
(PROP (FILETYPE MAKEFILE-ENVIRONMENT)
MEDLEYTEDITPATCHES)))
(* ;; " Does WINDOWP check in both fns to avoid infamous %"DON'T%" case.")
(DEFINEQ
(TEDIT.GETINPUT
[LAMBDA (STREAM PROMPTSTRING DEFAULTSTRING DELIMITER.LIST) (* ; "Edited 13-Dec-87 23:27 by rht:")
(* Ask for input (file names, &c) for
TEdit, perhaps with a default.)
(* ;; "rg 12/3/87: fixed ambiguous record fetch of PROMPTWINDOW.")
(* ;; "rht 12/13/87: Now does WINDOWP check on TEXTOBJ's PROMPTWINDOW to avoid %"DON'T%" case.")
(PROG [(TEXTOBJ (TEXTOBJ STREAM))
(TPROMPT (OR (WINDOWP (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
'TTY
(OR DELIMITER.LIST (CHARCODE (EOL LF TAB ESCAPE)))
NIL) (* Get what the guy wants to tell us)
(WINDOWPROP (OR TPROMPT PROMPTWINDOW)
'PROCESS NIL) (* Now detach the prompt window from
its process, to avoid a circularity.)
)])
(TEDIT.PROMPTPRINT
[LAMBDA (TEXTSTREAM MSG CLEAR?) (* ; "Edited 14-Oct-88 18:01 by Gobbel")
(* ;; "Print a message in the editor's prompt window (if none, use the global promptwindow). Optionally clear the window first.")
(* ;; "rg 10/10/88: Added in rht's patch from Lyric - check for (WINDOWP WINDOW) before clearing or printing")
(PROG (WINDOW PWINDOW (TEXTOBJ (TEXTOBJ TEXTSTREAM))
MAINTEXTOBJ)
(COND
[(AND TEXTOBJ (fetch (TEXTOBJ MENUFLG) of TEXTOBJ))
(* ;
"There is a known textobj, and it's a menu. Go use the main editor's promptwindow.")
(SETQ MAINTEXTOBJ (WINDOWPROP (\TEDIT.MAINW TEXTOBJ)
'TEXTOBJ)) (* ;
"Find the TEXTOBJ for the main edit window, and use ITS prompting window.")
(SETQ WINDOW (AND MAINTEXTOBJ (fetch (TEXTOBJ PROMPTWINDOW) of MAINTEXTOBJ]
((AND TEXTOBJ (SETQ WINDOW (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ)))
(* ;
"There IS an editor window to get to; use its prompt window")
)
([SETQ WINDOW (CAR (NLSETQ (GETPROMPTWINDOW (\TEDIT.MAINW TEXTSTREAM)
NIL NIL T] (* ;
"Failing that, try any prompt window attached to the edit window.")
)) (* ;
"Try to find an editor's prompt window for our message")
(COND
((AND WINDOW (WINDOWP WINDOW)) (* ;
"We found a window to use. Print the message.")
(COND
(CLEAR? (CLEARW WINDOW)))
(PRIN1 MSG WINDOW))
(T (* ;
"Failing all else, use PROMPTWINDOW.")
(FRESHLINE PROMPTWINDOW)
(printout PROMPTWINDOW MSG])
)
(* ;;
"\TEDIT.COMMAND.LOOP now checks EDITFINISHEDFLG while waiting for TTY, so can't get hung forever, also checks TTY.PROCESSP before calling TEDIT.FLASHCARET, to eliminate spurious caret images hanging around."
)
(* ;;
"(DECLARE%%: DONTCOPY DONTEVAL@LOAD EVAL@COMPILE (FILES (FROM {ERIS}<TEDIT>) TEDITDECLS (FROM LISPUSERS) EXPORTS.ALL))"
)
(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)
(RPAQQ \SCRATCHLEN 10)
(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)
(\SCRATCHLEN 10))
)
)
(* ;; "\TEDIT.COMMAND.LOOP from TEDITCOMMAND, \TEDIT.WAITFORSYSBUFP is new")
(DEFINEQ
(\TEDIT.COMMAND.LOOP
[LAMBDA (STREAM RTBL) (* ; "Edited 10-Oct-88 16:20 by Gobbel")
(* ;; "Main command loop for the TEDIT editor. Includes keyboard polling and command dispatch")
(* ;; "rg 10/10/88: reinstated Lyric patch - calls \TEDIT.WAITFORSYSBUFP instead of \WAITFORSYSBUFP, so doesn't get hung in infinite wait, also calls TTY.PROCESSP before calling TEDIT.FLASHCARET to avoid spurious caret images. This fn from TEDITCOMMAND.")
(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 'PROCESS (THIS.PROCESS)))
(* ; "And the window to this process")
(while (NOT (TTY.PROCESSP)) do (* ;
"Wait until we really have the TTY before proceeding.")
(DISMISS 250))
(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 'LOOPFN))
(CHARFN (TEXTPROP TEXTOBJ 'CHARFN))
COMMANDFN)
(while (NOT (fetch EDITFINISHEDFLG of TEXTOBJ))
do
[ERSETQ
(while (NOT (fetch EDITFINISHEDFLG of TEXTOBJ))
do
(PROGN (\TEDIT.WAITFORSYSBUFP 25 TEXTOBJ)
(* ; "Await type-in or mouse action")
(while (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)))
(if (TTY.PROCESSP)
then (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 '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
)
'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.WAITFORSYSBUFP
[LAMBDA (N TEXTOBJ) (* ; "Edited 13-Jan-88 11:01 by Randy.Gobbel")
(* ;;; "If sysbufp, return T. Else, wait for tty up to n msecs. After awaking, if finished, return nil, else loop around")
(COND
[(FIXP N)
(GLOBALRESOURCE (\DISMISSTIMER)
(PROG ((NOW (\CLOCK0 \DISMISSTIMER)))
LP (* ; "")
(COND
((\SYSBUFP)
(RETURN T))
((NOT (TTY.PROCESSP))
(\WAIT.FOR.TTY N)
(if (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ)
then (RETURN)))
((\CLOCKGREATERP NOW N) (* ; "Time's up, return with no input")
(RETURN))
(T (BLOCK)))
(GO LP]
(T (until (\SYSBUFP) do (BLOCK)
(AWAIT.EVENT \TTY.PROCESS.EVENT])
)
(* ;;
"First advice makes tedit menu run in a new process, second fixes promptwindow problem in TEDIT.GET (from TEDITFILE)."
)
[XCL:REINSTALL-ADVICE '(PROCESS.APPLY :IN \TEDIT.BUTTONEVENTFN)
:AROUND
'((:LAST (ADD.PROCESS (LIST USERFN (KWOTE W]
(READVISE (PROCESS.APPLY :IN \TEDIT.BUTTONEVENTFN))
(PUTPROPS MEDLEYTEDITPATCHES FILETYPE :TCOMPL)
(PUTPROPS MEDLEYTEDITPATCHES MAKEFILE-ENVIRONMENT (:PACKAGE "IL" :READTABLE "INTERLISP" :BASE
10))
(PUTPROPS MEDLEYTEDITPATCHES COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2447 6564 (TEDIT.GETINPUT 2457 . 4266) (TEDIT.PROMPTPRINT 4268 . 6562)) (7772 32968 (
\TEDIT.COMMAND.LOOP 7782 . 31875) (\TEDIT.WAITFORSYSBUFP 31877 . 32966)))))
STOP