1
0
mirror of synced 2026-01-16 00:34:03 +00:00

SKETCH: calls TEDIT.GET.CHARACTION, word-delete should now work

This commit is contained in:
rmkaplan 2025-11-12 23:16:30 -08:00
parent 20a018631d
commit 0bfc2958df
2 changed files with 192 additions and 254 deletions

View File

@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 5-Nov-2025 23:56:42" {WMEDLEY}<library>sketch>SKETCH-EDIT.;2 108507
(FILECREATED "12-Nov-2025 14:50:25" {WMEDLEY}<library>SKETCH>SKETCH-EDIT.;5 110185
:EDIT-BY rmk
:CHANGES-TO (FNS SKED.MOVE.SELECTION)
:CHANGES-TO (FNS \SKED.INSERT \SKED.INSERT.CHARS.TO.STR)
:PREVIOUS-DATE " 5-Dec-2023 00:12:04" {WMEDLEY}<library>sketch>SKETCH-EDIT.;1)
:PREVIOUS-DATE "10-Nov-2025 16:36:04" {WMEDLEY}<library>SKETCH>SKETCH-EDIT.;4)
(PRETTYCOMPRINT SKETCH-EDITCOMS)
@ -694,15 +694,16 @@
(GETSYNTAX CHCODE (GETREADTABLE])
(SK.GETSYNTAX
[LAMBDA (CHARCODE) (* rrb "11-Jul-86 17:18")
(* version of getsyntax that uses the TEDIT table if it is available, otherwise
 the terminal.)
[LAMBDA (CHARCODE) (* ; "Edited 10-Nov-2025 15:33 by rmk")
(* rrb "11-Jul-86 17:18")
(COND
((DEFINEDP (FUNCTION TEDIT.GETSYNTAX))
(TEDIT.GETSYNTAX CHARCODE TEDIT.READTABLE))
(T (GETSYNTAX CHARCODE (GETTERMTABLE])
(* ;; "Original code used TEDIT.GETSYNTAX if it was defined, otherwise called the system GETSYNTAX. That made SKETCH dependent on the system tags (CHARDELETE etc.). Bbut now we know that loading SKETCH insures that TEDIT is loaded, so Sketch is modified to use the Tedit action names")
(* (COND ((DEFINEDP (FUNCTION
 TEDIT.GETSYNTAX)) (TEDIT.GETSYNTAX
 CHARCODE TEDIT.READTABLE))
 (T (GETSYNTAX CHARCODE
 (GETTERMTABLE)))))
(TEDIT.GET.CHARACTION CHARCODE])
)
(DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE
@ -813,13 +814,14 @@
(\SKED.INSERT CHARCODES SKW ATSCALE])
(\SKED.INSERT
[LAMBDA (CHARCODES SKW ATSCALE) (* ; "Edited 20-Feb-87 17:28 by rrb")
[LAMBDA (CHARCODES SKW ATSCALE) (* ; "Edited 12-Nov-2025 14:49 by rmk")
(* ; "Edited 10-Nov-2025 15:32 by rmk")
(* ; "Edited 20-Feb-87 17:28 by rrb")
(COND
((GREATERP (LENGTH CHARCODES)
200)
(* the maximum string length limits the number of characters that can be
 inserted at once. This can happen from a shift select.)
(* ;; "the maximum string length limits the number of characters that can be inserted at once. This can happen from a shift select.")
(SKED.INSERT (FIRST.N.ELEMENTS CHARCODES 200)
SKW ATSCALE)
@ -831,16 +833,15 @@
NEWELT STRPIECE NEWLINE# NEWCHAR# SKCONTEXT PTRCHAR# CONTROLCHARTAIL)
(COND
((EQ (SK.GETSYNTAX (CAR CHARCODES))
'UNDO)
(* user typed an undo Avoid the overhead of inserting no characters and allow
 undo to be typed without a selection.)
:UNDO)
(* ;; "user typed an undo Avoid the overhead of inserting no characters and allow undo to be typed without a selection.")
(SETQ CONTROLCHARTAIL 'UNDO)
(GO UNDO)))
(COND
((NULL SELECTION) (* add a new text element with these
 characters.)
((NULL SELECTION) (* ;
 "add a new text element with these characters.")
(STATUSPRINT SKW "
" "Indicate the position the typing should go with the left button.")
(RETURN)))
@ -851,10 +852,8 @@
(CHARCODE EOL))
(EQ (CAR CHARCODES)
(CHARCODE LINEFEED)))
(KEYDOWNP 'CTRL))
(* user hit control CR. create a new text or textbox.)
(KEYDOWNP 'CTRL)) (* ;
 "user hit control CR. create a new text or textbox.")
(SKED.CREATE.NEW.TEXTBOX [COND
((NEW.TEXT.SELECTIONP SELECTION)
NIL)
@ -864,30 +863,26 @@
SKW
(CDR CHARCODES))
(RETURN))
[(NEW.TEXT.SELECTIONP SELECTION)
(* selection is in open space, create a new text element.)
(* merge the characters into strings
 of each line.)
[(NEW.TEXT.SELECTIONP SELECTION) (* ;
 "selection is in open space, create a new text element.")
(* ;
 "merge the characters into strings of each line.")
(SETQ ELTTYPE 'TEXT)
(SETQ CONTROLCHARTAIL (\SKED.INSERT.CHARS.TO.STR CHARCODES NIL SKW))
(COND
((OR NEWSTRS STRPIECE)
(* if there are any new characters, add a new text element.)
(* save the selection that marked the spot where the new text goes and add the
 text but not in a way that puts an event on the history list.
 this is done during clean up.)
((OR NEWSTRS STRPIECE) (* ;
 "if there are any new characters, add a new text element.")
(* ;; "save the selection that marked the spot where the new text goes and add the text but not in a way that puts an event on the history list. this is done during clean up.")
(WINDOWPROP SKW 'CHANGEDTEXTELT SELECTION)
(SETQ NEWELT (SK.ADD.ELEMENT (CREATE.TEXT.ELEMENT
(SETQ NEWSTRS (NCONC1 NEWSTRS STRPIECE))
(SK.MAP.INPUT.PT.TO.GLOBAL (create INPUTPT
INPUT.ONGRID?
INPUT.ONGRID?
_ NIL
INPUT.POSITION
INPUT.POSITION
_
(
 SELECTION.POSITION
@ -904,20 +899,15 @@
of (fetch (SKETCHCONTEXT SKETCHBRUSH)
of SKCONTEXT)))
SKW T)))
(CONTROLCHARTAIL
(* user typed control return to get textbox in the middle of no where.)
(CONTROLCHARTAIL (* ;
 "user typed control return to get textbox in the middle of no where.")
(SKED.CREATE.NEW.TEXTBOX NIL SKW (CDR CONTROLCHARTAIL)
ATSCALE)
(RETURN))
(T
(* user typed backspace, etc. when no text exists.
 Put caret back in same place.)
(T (* ;
 "user typed backspace, etc. when no text exists. Put caret back in same place.")
(SKED.SET.SELECTION SELECTION SKW)
(RETURN))) (* put selection marker at the end.)
(RETURN))) (* ; "put selection marker at the end.")
(SETQ NEWLINE# (LENGTH NEWSTRS))
(SETQ NEWCHAR# (NCHARS (CAR (LAST NEWSTRS]
(T [SETQ GTEXTELT (fetch (SCREENELT INDIVIDUALGLOBALPART)
@ -926,8 +916,8 @@
(SETQ ELTTYPE (fetch (INDIVIDUALGLOBALPART GTYPE) of GTEXTELT))
(SETQ STRLST (fetch (LOCALTEXT LOCALLISTOFCHARACTERS)
of (fetch (SCREENELT LOCALPART) of TEXTELT)))
(* set up points to beginning and end
 of selection.)
(* ;
 "set up points to beginning and end of selection.")
[COND
[(NULL EXTENSION)
(SETQ LASTCHAR# (SETQ FIRSTCHAR# (fetch (TEXTELTSELECTION SKCHAR#)
@ -939,9 +929,8 @@
(SETQ FIRSTCHAR# (fetch (TEXTELTSELECTION SKCHAR#) of SELECTION))
(SETQ LASTLINE# (fetch (TEXTELTSELECTION SKLINE#) of EXTENSION))
(SETQ LASTCHAR# (fetch (TEXTELTSELECTION SKCHAR#) of EXTENSION))
(* make SELECTION be the candidate for the selection after the deletion.)
(* ;
 "make SELECTION be the candidate for the selection after the deletion.")
(SETQ SELECTION EXTENSION))
(T (SETQ FIRSTLINE# (fetch (TEXTELTSELECTION SKLINE#) of EXTENSION))
(SETQ FIRSTCHAR# (fetch (TEXTELTSELECTION SKCHAR#) of EXTENSION))
@ -949,13 +938,14 @@
(SETQ LASTCHAR# (fetch (TEXTELTSELECTION SKCHAR#) of SELECTION]
[for STR in STRLST as LINE# from 1
do [COND
((ILESSP LINE# FIRSTLINE#) (* before the first, copy across)
((ILESSP LINE# FIRSTLINE#) (* ; "before the first, copy across")
(SETQ NEWSTRS (NCONC1 NEWSTRS STR)))
((IGREATERP LINE# LASTLINE#) (* After the last, copy across)
((IGREATERP LINE# LASTLINE#) (* ; "After the last, copy across")
(SETQ NEWSTRS (NCONC1 NEWSTRS STR)))
((EQ LINE# FIRSTLINE#) (* on the first, save the part before.)
((EQ LINE# FIRSTLINE#) (* ;
 "on the first, save the part before.")
(SETQ STRPIECE (SUBSTRING STR 1 FIRSTCHAR#))
(* insert new text.)
(* ; "insert new text.")
(COND
[CHARCODES (SETQ CONTROLCHARTAIL (\SKED.INSERT.CHARS.TO.STR
CHARCODES
@ -968,18 +958,15 @@
(T (SETQ NEWCHAR# FIRSTCHAR#)
(SETQ NEWLINE# FIRSTLINE#]
(COND
((EQ LINE# LASTLINE#)
(* on the last, copy the part before and the part after as one)
((EQ LINE# LASTLINE#) (* ;
 "on the last, copy the part before and the part after as one")
(SETQ NEWSTRS (COND
[STRPIECE (NCONC1
NEWSTRS
(COND
((EQ LASTCHAR# (NCHARS STR))
(* special check because SUBSTRING returns NIL rather than the empty string.)
(* ;
 "special check because SUBSTRING returns NIL rather than the empty string.")
STRPIECE)
(T (CONCAT STRPIECE
(SUBSTRING STR (ADD1
@ -988,15 +975,13 @@
[(NEQ LASTCHAR# (NCHARS STR))
(NCONC1 NEWSTRS (SUBSTRING STR (ADD1 LASTCHAR#]
(T NEWSTRS]
(* any other windows that had this selection have had it deleted already so
 this doesn't do anything for them.)
(* ;; "any other windows that had this selection have had it deleted already so this doesn't do anything for them.")
[COND
((IGREATERP NEWLINE# (LENGTH NEWSTRS))
(* this corresponds to deleting every thing in a line.
 Make sure that if it is the last line that the selection is reset)
(* ;; "this corresponds to deleting every thing in a line. Make sure that if it is the last line that the selection is reset")
(COND
((EQ (SETQ NEWLINE# (LENGTH NEWSTRS))
@ -1004,30 +989,23 @@
(SETQ NEWCHAR# 0)
(COND
((EQ ELTTYPE 'TEXT)
(* deleted everything in a text element, delete the text element and set the
 selection to new text cursor.)
(* ;; "deleted everything in a text element, delete the text element and set the selection to new text cursor.")
(COND
[(WINDOWPROP SKW 'CHANGEDTEXTELT)
(* make the history event for this edit so that it will restore the original
 text element)
(* ;
 "make the history event for this edit so that it will restore the original text element")
(PROG ((INITSELECTION (WINDOWPROP SKW 'CHANGEDTEXTELT NIL)))
(COND
((POSITIONP INITSELECTION)
(* this text element was typing that was never officially added, don't record
 the deletion either.)
(* ;
 "this text element was typing that was never officially added, don't record the deletion either.")
(SK.DELETE.ELEMENT (LIST TEXTELT)
SKW
'DON'T))
(T
(* selection was existing text, record this as a delete event.)
(T (* ;
 "selection was existing text, record this as a delete event.")
(SK.DELETE.ELEMENT
(LIST TEXTELT)
SKW
@ -1043,16 +1021,14 @@
(VIEWER.SCALE SKW))
SKW)
(RETURN NIL))
((EQ ELTTYPE 'TEXTBOX) (* deleted everything in a textbox)
((EQ ELTTYPE 'TEXTBOX) (* ; "deleted everything in a textbox")
NIL)))
(T (SETQ NEWCHAR# (NCHARS (CAR (LAST NEWSTRS]
(SETQ PTRCHAR# (SKED.CHARACTERPOSITION NEWSTRS NEWLINE# NEWCHAR#))
(COND
((WINDOWPROP SKW 'CHANGEDTEXTELT)
(* this is not the first change to the text element.
 Collect the changes so that only one element is put on the undo stack, not one
 for each character.)
(* ;; "this is not the first change to the text element. Collect the changes so that only one element is put on the undo stack, not one for each character.")
(SETQ NEWELT (SK.UPDATE.ELEMENT (fetch (SCREENELT GLOBALPART) of TEXTELT)
(SK.REPLACE.TEXT.IN.ELEMENT (fetch (SCREENELT
@ -1061,12 +1037,10 @@
NEWSTRS)
SKW T)))
((AND CONTROLCHARTAIL (NEQ CONTROLCHARTAIL 'UNDO))
(* user typed a character command to create a new text box.
 Create it and put the remaining characters in it and set the cursor there.)
(* this is done here so that no undo event is created for the textbox that the
 user was in when all they did was type a control-cr.)
(* ;; "user typed a character command to create a new text box. Create it and put the remaining characters in it and set the cursor there.")
(* ;; "this is done here so that no undo event is created for the textbox that the user was in when all they did was type a control-cr.")
(SKED.CREATE.NEW.TEXTBOX (fetch (SCREENELT INDIVIDUALGLOBALPART)
of NEWELT)
@ -1074,9 +1048,7 @@
(CDR CONTROLCHARTAIL))
(RETURN))
(T
(* this is the first edit change to a new element, call the PREEDITFN and save
 old text element so undo event can be constructed when the selection changes.)
(* ;; "this is the first edit change to a new element, call the PREEDITFN and save old text element so undo event can be constructed when the selection changes.")
(OR (SK.CHECK.PREEDITFN SKW (fetch (SCREENELT GLOBALPART) of TEXTELT))
(RETURN NIL))
@ -1087,9 +1059,8 @@
NEWSTRS)
SKW))
(WINDOWPROP SKW 'CHANGEDTEXTELT SELECTION)))
(* recalculate the line %# and char %# of the insertion point as the textboxes
 at least do justification.)
(* ;; "recalculate the line # and char # of the insertion point as the textboxes at least do justification.")
[SETQ NEWCHAR# (CDR (SETQ NEWLINE# (SKED.LINE.AND.CHAR#
(fetch (LOCALTEXTBOX LOCALLISTOFCHARACTERS)
@ -1099,36 +1070,28 @@
(SETQ NEWLINE# (CAR NEWLINE#]
UNDO
(COND
((NULL CONTROLCHARTAIL)
(* set the selection to where the characters were just inserted.)
((NULL CONTROLCHARTAIL) (* ;
 "set the selection to where the characters were just inserted.")
(SKED.SET.SELECTION (CREATE.TEXT.SELECTION NEWELT NEWLINE# NEWCHAR# NIL NIL
(WINDOWPROP SKW 'DSP))
SKW))
[(EQ CONTROLCHARTAIL 'UNDO)
(* user types in an undo after some characters or while selection was in the
 middle of text.)
[(EQ CONTROLCHARTAIL 'UNDO) (* ;
 "user types in an undo after some characters or while selection was in the middle of text.")
(PROG (INITSELECTION EDITEDELT)
(COND
((SETQ INITSELECTION (WINDOWPROP SKW 'CHANGEDTEXTELT NIL))
(* in the middle of editing, undo
 these edits.)
(* ;
 "in the middle of editing, undo these edits.")
[SETQ EDITEDELT (fetch (SCREENELT GLOBALPART)
of (OR NEWELT (fetch (TEXTELTSELECTION SKTEXTELT)
of (OR SELECTION (ERROR
"NO SELECTION WHEN THERE SHOULD BE"
]
(* add event to history list so the undo can be undone.)
(* ;
 "add event to history list so the undo can be undone.")
(COND
((POSITIONP INITSELECTION)
(* add an ADD event because previously there was nothing here.)
((POSITIONP INITSELECTION) (* ;
 "add an ADD event because previously there was nothing here.")
(SK.ADD.HISTEVENT 'ADD (LIST EDITEDELT)
SKW)
(SK.CHECK.END.INITIAL.EDIT SKW EDITEDELT))
@ -1139,20 +1102,13 @@
EDITEDELT)))
(SK.UNDO.LAST SKW)
(SKED.SET.SELECTION INITSELECTION SKW))
(T
(* haven't edited any characters in the current element, just undo the last
 thing.)
(T (* ;
 "haven't edited any characters in the current element, just undo the last thing.")
(SK.UNDO.LAST SKW]
(T
(* user typed a character command to create a new text box.
 Create it and put the remaining characters in it and set the cursor there.)
(* set the selection so that adding the new text box will create an undo event
 for the character change that took place in this text box before the control-cr
 was typed.)
(* ;; "user typed a character command to create a new text box. Create it and put the remaining characters in it and set the cursor there.")
(* ;; "set the selection so that adding the new text box will create an undo event for the character change that took place in this text box before the control-cr was typed.")
(SKED.SET.SELECTION (CREATE.TEXT.SELECTION NEWELT NEWLINE# NEWCHAR# NIL NIL
(WINDOWPROP SKW 'DSP))
@ -1351,136 +1307,118 @@
(T (RETURN (SUBSTRING STRING 1 END])
(\SKED.INSERT.CHARS.TO.STR
[LAMBDA (CHARCODES INCLUDECR SKW) (* rrb "11-Jul-86 17:18")
[LAMBDA (CHARCODES INCLUDECR SKW) (* ; "Edited 12-Nov-2025 14:50 by rmk")
(* ; "Edited 10-Nov-2025 16:35 by rmk")
(* rrb "11-Jul-86 17:18")
(DECLARE (SPECVARS NEWSTRS STRPIECE))
(* takes a list of characters and makes it into strings on the free variable
 NEWSTRS. The variable STRPIECE is set to the last line of characters.
 NEWSTRS is a list of the strings that precede this one which is used in the
 case of backspace onto the previous line.)
(* ;; "takes a list of characters and makes it into strings on the free variable NEWSTRS. The variable STRPIECE is set to the last line of characters. NEWSTRS is a list of the strings that precede this one which is used in the case of backspace onto the previous line.")
(PROG (LINELST THISLINE REMAININGCHARS CLASS)
[for CHAR in CHARCODES
do (SELECTQ (SK.GETSYNTAX CHAR)
(CHARDELETE (* delete the previous character.)
[COND
(THISLINE (* easy case of deleting type in.)
(SETQ THISLINE (CDR THISLINE)))
(LINELST (* deleting a typed in CR.)
(SETQ THISLINE (CAR LINELST))
(SETQ LINELST (CDR LINELST)))
[STRPIECE (* remove the previous character from
 the current string.)
(COND
((EQ (NCHARS STRPIECE)
1)
(SETQ STRPIECE NIL))
(T (SETQ STRPIECE (SUBSTRING STRPIECE 1 -2]
[NEWSTRS (SETQ STRPIECE (CAR (LAST NEWSTRS)))
(SETQ NEWSTRS (BUTLAST NEWSTRS))
(COND
((EQ (NTHCHARCODE STRPIECE -1)
(CHARCODE EOL))
(* remove previous eol)
(COND
((EQ (NCHARS STRPIECE)
1)
(SETQ STRPIECE NIL))
(T (SETQ STRPIECE (SUBSTRING STRPIECE 1 -2]
(T (* no characters to delete)
(FLASHW (TTYDISPLAYSTREAM])
(WORDDELETE (* delete the previous word)
(* use the TEdit word bounding readtable.
 Code are%: character = 21 -
 space = 22 -
 punctuation = 20)
(:CHARDELETE.BACKWARD (* ; "delete the previous character.")
[COND
(THISLINE (* ; "easy case of deleting type in.")
(SETQ THISLINE (CDR THISLINE)))
(LINELST (* ; "deleting a typed in CR.")
(SETQ THISLINE (CAR LINELST))
(SETQ LINELST (CDR LINELST)))
[STRPIECE (* ;
 "remove the previous character from the current string.")
(COND
((EQ (NCHARS STRPIECE)
1)
(SETQ STRPIECE NIL))
(T (SETQ STRPIECE (SUBSTRING STRPIECE 1 -2]
[NEWSTRS (SETQ STRPIECE (CAR (LAST NEWSTRS)))
(SETQ NEWSTRS (BUTLAST NEWSTRS))
(COND
((EQ (NTHCHARCODE STRPIECE -1)
(CHARCODE EOL)) (* ; "remove previous eol")
(COND
((EQ (NCHARS STRPIECE)
1)
(SETQ STRPIECE NIL))
(T (SETQ STRPIECE (SUBSTRING STRPIECE 1 -2]
(T (* ; "no characters to delete")
(FLASHW (TTYDISPLAYSTREAM])
((:CHARDELETE.FORWARD :WORDDELETE.BACKWARD)
(* ;
 "delete the previous word. Tedit binds DEL to CHARDELETE.FORWARD, sketch used to delete the word")
(* ;; "use the TEdit word bounding readtable. Code are: character = 21 --- space = 22 --- punctuation = 20")
[COND
[[OR THISLINE (PROG1 (SETQ THISLINE (CAR LINELST))
(SETQ LINELST (CDR LINELST]
(* easy case of deleting type in.)
(* if this line was empty, skip the cr that created it as part of the white
 space before the word.)
(* skip any whitespace)
(COND
([NULL (SETQ THISLINE (for TAIL on THISLINE
while (EQ (SK.WORD.BREAK.CLASS
(CAR TAIL))
22)
finally (RETURN TAIL]
(* the whitespace backed up to the beginning of a line.
 quit there.)
[COND
[[OR THISLINE (PROG1 (SETQ THISLINE (CAR LINELST))
(SETQ LINELST (CDR LINELST)))]
(* ; "easy case of deleting type in.")
(* ;
 "if this line was empty, skip the cr that created it as part of the white space before the word.")
(* ; "skip any whitespace")
(COND
([NULL (SETQ THISLINE (for TAIL on THISLINE
while (EQ (SK.WORD.BREAK.CLASS (CAR TAIL))
22) finally (RETURN TAIL]
(* ;
 "the whitespace backed up to the beginning of a line. quit there.")
NIL)
(T (SETQ CLASS (SK.WORD.BREAK.CLASS (CAR THISLINE)))
(* ;
 "skip all things of the same class as the first character before the whitespace")
(SETQ THISLINE (for TAIL on THISLINE
until (NEQ (SK.WORD.BREAK.CLASS (CAR TAIL))
CLASS) finally (RETURN TAIL]
(STRPIECE (* ;
 "remove the previous character from the current string.")
(SETQ STRPIECE (\SKED.DELETE.WORD.FROM.STRING STRPIECE)))
(NEWSTRS [SETQ STRPIECE (\SKED.DELETE.WORD.FROM.STRING
(CAR (LAST NEWSTRS]
(SETQ NEWSTRS (BUTLAST NEWSTRS)))
(T (* ; "no characters to delete")
(FLASHW (TTYDISPLAYSTREAM])
(:DELETE (* ;
 "delete selection. Here that means don't insert anything."))
(:UNDO
(* ;; "by side effect this flushes any characters typed after the undo but it's not clear where they should go anyway.")
NIL)
(T (SETQ CLASS (SK.WORD.BREAK.CLASS (CAR THISLINE)))
(* skip all things of the same class as the first character before the
 whitespace)
(SETQ THISLINE (for TAIL on THISLINE
until (NEQ (SK.WORD.BREAK.CLASS
(CAR TAIL))
CLASS)
finally (RETURN TAIL]
(STRPIECE (* remove the previous character from
 the current string.)
(SETQ STRPIECE (\SKED.DELETE.WORD.FROM.STRING STRPIECE)))
(NEWSTRS [SETQ STRPIECE (\SKED.DELETE.WORD.FROM.STRING
(CAR (LAST NEWSTRS]
(SETQ NEWSTRS (BUTLAST NEWSTRS)))
(T (* no characters to delete)
(FLASHW (TTYDISPLAYSTREAM])
(DELETE (* delete selection.
 Here that means don't insert anything.))
(UNDO
(* by side effect this flushes any characters typed after the undo but it's not
 clear where they should go anyway.)
(RETURN 'UNDO))
((REDO FN CMD)
(RETURN 'UNDO))
((:REDO :CMD) (* ; "There are many more Tedit actions that we don't deal with here, these were called out when Sketch was using \TEDIT.GETSYNTAX or GETSYNTAX. Not clear we need this message, just fall through and treat REDO/CMD like other actions, as ordinary characters")
(STATUSPRINT SKW "
" "Not implemented in this editor. Sorry."))
(COND
[(OR (EQ CHAR (CHARCODE EOL))
(EQ CHAR (CHARCODE LINEFEED))) (* eol)
(EQ CHAR (CHARCODE LINEFEED))) (* ; "eol")
(COND
((KEYDOWNP 'CTRL)
(* user entered control return, save remaining characters and return indicator)
((KEYDOWNP 'CTRL) (* ;
 "user entered control return, save remaining characters and return indicator")
(SETQ REMAININGCHARS (MEMB CHAR CHARCODES))
(RETURN))
(T (SETQ LINELST (CONS (COND
(INCLUDECR
(* text boxes need to have the CRs
 left in.)
(* ;
 "text boxes need to have the CRs left in.")
(CONS (CHARCODE EOL)
THISLINE))
(T THISLINE))
LINELST))
(SETQ THISLINE NIL]
(T
(* add this character onto the front of this line;
 reversal will happen before conversion to string and return.)
(* ;; "add this character onto the front of this line; reversal will happen before conversion to string and return.")
(SETQ THISLINE (CONS CHAR THISLINE]
(COND
[LINELST (* had a cr in the character set.)
[LINELST (* ; "had a cr in the character set.")
[SETQ NEWSTRS (NCONC NEWSTRS [CONS (JOINCHARS STRPIECE (REVERSE
(CAR (LAST LINELST]
(for CHLST in (REVERSE (BUTLAST LINELST))
collect (STRINGFROMCHARACTERS (REVERSE CHLST]
(SETQ STRPIECE (STRINGFROMCHARACTERS (REVERSE THISLINE]
[THISLINE (* no new lines, add these characters
 onto STRPIECE)
[THISLINE (* ;
 "no new lines, add these characters onto STRPIECE")
(SETQ STRPIECE (JOINCHARS STRPIECE (REVERSE THISLINE]
(T (* no new lines, or characters, leave
 STRPIECE alone.)
(T (* ;
 "no new lines, or characters, leave STRPIECE alone.")
NIL))
(RETURN REMAININGCHARS])
@ -1944,26 +1882,26 @@
YCOORD _ (LASTMOUSEY WIN])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2425 39442 (BUTLAST 2435 . 2783) (CHAR.BEGIN 2785 . 4710) (CLOSEST.CHAR 4712 . 8935) (
CLOSEST.LINE 8937 . 9499) (FLASHW 9501 . 9658) (HILITE.LINE 9660 . 10479) (HILITE.TEXT 10481 . 12129)
(IN.TEXT.EXTEND 12131 . 15404) (INIMAGEOBJ 15406 . 15911) (INTEXT 15913 . 16410) (NEW.TEXT.EXTEND
16412 . 18631) (NEW.TEXT.SELECTIONP 18633 . 18813) (NTHCHARWIDTH 18815 . 19072) (NTHLOCALREGION 19074
. 19312) (ONCHAR 19314 . 19709) (SHOW.EXTENDED.SELECTION.FEEDBACK 19711 . 20646) (SHOW.FEEDBACK 20648
. 21138) (SHOW.FEEDBACK.BOX 21140 . 22194) (SELECTION.POSITION 22196 . 22988) (SKED.CLEAR.SELECTION
22990 . 23513) (SKETCH.CLEANUP 23515 . 25429) (SK.ENTER.EDIT.CHANGE 25431 . 26976) (
SKED.REMOVE.OTHER.SELECTIONS 26978 . 27405) (SKED.EXTEND.SELECTION 27407 . 28872) (SKED.MOVE.SELECTION
28874 . 33944) (CREATE.TEXT.SELECTION 33946 . 34462) (SKED.SELECTION.FEEDBACK 34464 . 36120) (
SKED.SET.EXTENDSELECTION 36122 . 36439) (SKED.SET.SELECTION 36441 . 36841) (LINE.BEGIN 36843 . 37397)
(SELECTION.GREATERP 37399 . 38194) (SK.WORD.BREAK.CLASS 38196 . 39036) (SK.GETSYNTAX 39038 . 39440)) (
40284 86018 (WB.EDITOR 40294 . 41619) (SK.TTYENTRYFN 41621 . 41899) (SK.TTYEXITFN 41901 . 42170) (
SKED.INSERT 42172 . 42600) (\SKED.INSERT 42602 . 63724) (FIRST.N.ELEMENTS 63726 . 63993) (
SKED.CREATE.NEW.TEXTBOX 63995 . 70524) (SKED.CHARACTERPOSITION 70526 . 71313) (SKED.LINE.AND.CHAR#
71315 . 72946) (\SKED.DELETE.WORD.FROM.STRING 72948 . 73987) (\SKED.INSERT.CHARS.TO.STR 73989 . 82400)
(JOINCHARS 82402 . 82789) (STRINGFROMCHARACTERS 82791 . 83116) (GETALLCHARS 83118 . 83459) (
CLEANUP.EDIT 83461 . 83913) (SKED.NEW.TEXTELT 83915 . 86016)) (86053 107061 (
MAP.SCREEN.POSITION.ONTO.GRID 86063 . 87512) (NEAREST.ON.GRID 87514 . 88058) (SK.MIDDLE.TITLEFN 88060
. 90003) (WB.BUTTON.HANDLER 90005 . 97827) (WB.ADD.NEW.POINT 97829 . 101158) (WB.DRAWLINE 101160 .
105394) (WB.RUBBERBAND.POSITION 105396 . 106313) (SK.RUBBERBAND.FEEDBACKFN 106315 . 106819) (
RESET.LINE.BEING.INPUT 106821 . 107059)) (107243 108484 (NEAREST.EXISTING.POSITION 107253 . 107455) (
WB.NEARPT 107457 . 108342) (LASTMOUSEPOSITION 108344 . 108482)))))
(FILEMAP (NIL (2444 40071 (BUTLAST 2454 . 2802) (CHAR.BEGIN 2804 . 4729) (CLOSEST.CHAR 4731 . 8954) (
CLOSEST.LINE 8956 . 9518) (FLASHW 9520 . 9677) (HILITE.LINE 9679 . 10498) (HILITE.TEXT 10500 . 12148)
(IN.TEXT.EXTEND 12150 . 15423) (INIMAGEOBJ 15425 . 15930) (INTEXT 15932 . 16429) (NEW.TEXT.EXTEND
16431 . 18650) (NEW.TEXT.SELECTIONP 18652 . 18832) (NTHCHARWIDTH 18834 . 19091) (NTHLOCALREGION 19093
. 19331) (ONCHAR 19333 . 19728) (SHOW.EXTENDED.SELECTION.FEEDBACK 19730 . 20665) (SHOW.FEEDBACK 20667
. 21157) (SHOW.FEEDBACK.BOX 21159 . 22213) (SELECTION.POSITION 22215 . 23007) (SKED.CLEAR.SELECTION
23009 . 23532) (SKETCH.CLEANUP 23534 . 25448) (SK.ENTER.EDIT.CHANGE 25450 . 26995) (
SKED.REMOVE.OTHER.SELECTIONS 26997 . 27424) (SKED.EXTEND.SELECTION 27426 . 28891) (SKED.MOVE.SELECTION
28893 . 33963) (CREATE.TEXT.SELECTION 33965 . 34481) (SKED.SELECTION.FEEDBACK 34483 . 36139) (
SKED.SET.EXTENDSELECTION 36141 . 36458) (SKED.SET.SELECTION 36460 . 36860) (LINE.BEGIN 36862 . 37416)
(SELECTION.GREATERP 37418 . 38213) (SK.WORD.BREAK.CLASS 38215 . 39055) (SK.GETSYNTAX 39057 . 40069)) (
40913 87696 (WB.EDITOR 40923 . 42248) (SK.TTYENTRYFN 42250 . 42528) (SK.TTYEXITFN 42530 . 42799) (
SKED.INSERT 42801 . 43229) (\SKED.INSERT 43231 . 65221) (FIRST.N.ELEMENTS 65223 . 65490) (
SKED.CREATE.NEW.TEXTBOX 65492 . 72021) (SKED.CHARACTERPOSITION 72023 . 72810) (SKED.LINE.AND.CHAR#
72812 . 74443) (\SKED.DELETE.WORD.FROM.STRING 74445 . 75484) (\SKED.INSERT.CHARS.TO.STR 75486 . 84078)
(JOINCHARS 84080 . 84467) (STRINGFROMCHARACTERS 84469 . 84794) (GETALLCHARS 84796 . 85137) (
CLEANUP.EDIT 85139 . 85591) (SKED.NEW.TEXTELT 85593 . 87694)) (87731 108739 (
MAP.SCREEN.POSITION.ONTO.GRID 87741 . 89190) (NEAREST.ON.GRID 89192 . 89736) (SK.MIDDLE.TITLEFN 89738
. 91681) (WB.BUTTON.HANDLER 91683 . 99505) (WB.ADD.NEW.POINT 99507 . 102836) (WB.DRAWLINE 102838 .
107072) (WB.RUBBERBAND.POSITION 107074 . 107991) (SK.RUBBERBAND.FEEDBACKFN 107993 . 108497) (
RESET.LINE.BEING.INPUT 108499 . 108737)) (108921 110162 (NEAREST.EXISTING.POSITION 108931 . 109133) (
WB.NEARPT 109135 . 110020) (LASTMOUSEPOSITION 110022 . 110160)))))
STOP

Binary file not shown.