(FILECREATED "17-Jul-85 16:39:32" {ERIS}<TEDIT>TEDITFIND.;4 27021
changes to: (FNS TEDIT.SUBSTITUTE TEDIT.FIND)
previous date: "13-Jun-85 19:59:02" {ERIS}<TEDIT>TEDITFIND.;2)
(* Copyright (c) 1983, 1984, 1985 by John Sybalsky & Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TEDITFINDCOMS)
(RPAQQ TEDITFINDCOMS ([COMS (* Read-table Utilities)
(FNS \TEDIT.SEARCH.CODETABLE)
[DECLARE: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.SEARCH.CODETABLE (
\TEDIT.SEARCH.CODETABLE]
(GLOBALVARS TEDIT.SEARCH.CODETABLE)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS (\AlphaNumericFlag 256)
(\AlphaFlag 512)
(\OneCharPattern 1024)
(\AnyStringPattern 1025)
(\OneAlphaPattern 1026)
(\AnyAlphaPattern 1027)
(\OneNonAlphaPattern 1028)
(\AnyNonAlphaPattern 1029)
(\LeftBracketPattern 1030)
(\RightBracketPattern 1031)
(\SpecialPattern 1024]
(FNS \TEDIT.BASICFIND TEDIT.FIND TEDIT.NEW.FIND TEDIT.NEXT \TEDIT.FIND.WC
\TEDIT.FIND.WC1 \TEDIT.PACK.TARGETLIST \TEDIT.PARSE.SEARCHSTRING
\TEDIT.SUBST.FN1 \TEDIT.SUBST.FN2 TEDIT.SUBSTITUTE)))
(* Read-table Utilities)
(DEFINEQ
(\TEDIT.SEARCH.CODETABLE
[LAMBDA NIL (* jds "23-OCT-83 00:58")
(* Build the 16-bit-item "syntax class" table for
searching)
(PROG ((CODETBL (ARRAY 256 (QUOTE SMALLP)
0 0)))
(for I from 0 to 255 do (SETA CODETBL I I)) (* Default is that a char maps to itself, and is
punctuation.)
(for CH
in (CHARCODE (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k
l m n o p q r s t u v w x y z))
do (SETA CODETBL CH (IPLUS \AlphaNumericFlag \AlphaFlag CH)))
(for CH in (CHARCODE (0 1 2 3 4 5 6 7 8 9)) do (SETA CODETBL CH (IPLUS \AlphaNumericFlag CH)
))
(for CH in (CHARCODE (# * @ ! & ~ { })) as CODE
in (LIST \OneCharPattern \AnyStringPattern \OneAlphaPattern \OneNonAlphaPattern
\AnyAlphaPattern \AnyNonAlphaPattern \LeftBracketPattern \RightBracketPattern)
do (SETA CODETBL CH CODE))
(RETURN CODETBL])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(RPAQ TEDIT.SEARCH.CODETABLE (\TEDIT.SEARCH.CODETABLE))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TEDIT.SEARCH.CODETABLE)
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ \AlphaNumericFlag 256)
(RPAQQ \AlphaFlag 512)
(RPAQQ \OneCharPattern 1024)
(RPAQQ \AnyStringPattern 1025)
(RPAQQ \OneAlphaPattern 1026)
(RPAQQ \AnyAlphaPattern 1027)
(RPAQQ \OneNonAlphaPattern 1028)
(RPAQQ \AnyNonAlphaPattern 1029)
(RPAQQ \LeftBracketPattern 1030)
(RPAQQ \RightBracketPattern 1031)
(RPAQQ \SpecialPattern 1024)
(CONSTANTS (\AlphaNumericFlag 256)
(\AlphaFlag 512)
(\OneCharPattern 1024)
(\AnyStringPattern 1025)
(\OneAlphaPattern 1026)
(\AnyAlphaPattern 1027)
(\OneNonAlphaPattern 1028)
(\AnyNonAlphaPattern 1029)
(\LeftBracketPattern 1030)
(\RightBracketPattern 1031)
(\SpecialPattern 1024))
)
)
(DEFINEQ
(\TEDIT.BASICFIND
[LAMBDA (TEXTOBJ STRING CH# CHLIM) (* jds " 6-Mar-85 21:44")
(* Search thru TEXTOBJ, starting where the caret is, for the string STRING, exact match only for now.
(Optionally, start the search at character ch#.))
(PROG ((SEL (fetch SEL of TEXTOBJ))
(TEXTLEN (fetch TEXTLEN of TEXTOBJ))
[TEXTLIM (OR CHLIM (ADD1 (IDIFFERENCE (fetch TEXTLEN of TEXTOBJ)
(NCHARS STRING]
(TEXTSTREAM (fetch STREAMHINT of TEXTOBJ))
(FOUND NIL)
(CH#1 (NTHCHARCODE STRING 1))
CH1 ANCHOR PCH# OANCHOR CH)
(replace \INSERTPCVALID of TEXTOBJ with NIL) (* 2/12/85 JDS: I don't understand WHY this is here,
but I'll assume it's right for now.)
(* Prohibit future insertions in the current piece.)
(COND
((OR CH# (fetch SET of SEL)) (* There must be a well-defined starting point.)
(RETURN (PROG NIL
(SETQ CH1 (OR CH# (SELECTQ (fetch POINT of SEL)
(LEFT (fetch CH# of SEL))
(RIGHT (fetch CHLIM of SEL))
NIL)))
(* Find the starting point for the search)
(* DO THE SEARCH)
(COND
((IGREATERP CH1 TEXTLIM) (* Starting the search past the last possible starting
point. Just punt.)
(RETURN NIL)))
RETRY
(SETQ ANCHOR CH1)
(\SETUPGETCH CH1 TEXTOBJ)
[for old ANCHOR from CH1 to TEXTLEN
do (SETQ CH (\BIN TEXTSTREAM))
(COND
((EQ CH CH#1)
(RETURN]
(COND
((IGREATERP ANCHOR TEXTLIM)
(RETURN NIL))) (* No starting character found before end of string)
(SETQ OANCHOR ANCHOR)
(SETQ FOUND T)
[for old CH1 from (ADD1 ANCHOR) to TEXTLEN as PCH# from 2
to (NCHARS STRING)
do (SETQ CH (\BIN TEXTSTREAM))
(COND
((NEQ CH (NTHCHARCODE STRING PCH#))
(SETQ FOUND NIL)
(RETURN]
(COND
(FOUND (RETURN ANCHOR))
(T (GO RETRY])
(TEDIT.FIND
[LAMBDA (TEXTOBJ TARGETSTRING START# END# WILDCARDS?) (* jds "16-Jul-85 17:36")
(* If WILDCARDS? is NIL then TEDIT.FIND is the old TEDIT.FIND. Else, it returns a list of (SEL.START# SEL.END#)
which is the start and end char positions of the selection)
(PROG [(TEDIT.WILDCARD.CHARACTERS (QUOTE ("#" "*"]
(AND TARGETSTRING (NOT (STRINGP TARGETSTRING))
(SETQ TARGETSTRING (MKSTRING TARGETSTRING)))
(SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
(\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT
THACTION ←(QUOTE Find)
THAUXINFO ← TARGETSTRING))
(replace \INSERTPCVALID of TEXTOBJ with NIL) (* Any FIND invalidates the type-in cache.)
(RETURN (COND
[WILDCARDS? (* will return a list of start and end of selection or
nil if not found)
(PROG (TARGETLIST SEL RESULT RESULT1)
(RETURN (COND
([OR START#
(AND (fetch SET of (SETQ SEL (fetch SEL of TEXTOBJ)))
(LEQ (SETQ START#
(SELECTQ (fetch POINT of SEL)
(LEFT (fetch CH# of SEL))
(RIGHT (fetch CHLIM of SEL))
NIL))
(OR END# (SETQ END# (fetch TEXTLEN of TEXTOBJ]
(* START# better be >= to END#)
(COND
((AND (for X in [SETQ TARGETLIST
(\TEDIT.PARSE.SEARCHSTRING
(for X in (UNPACK (MKATOM TARGETSTRING))
collect (MKSTRING X]
collect X when (LITATOM X))
(SETQ RESULT1 (\TEDIT.SUBST.FN1 TEXTOBJ TARGETLIST
START# END#)))
(* If there are atoms, they are tedit wildcard chars)
(\TEDIT.FIND.WC TEXTOBJ TARGETLIST RESULT1 END#))
(T (* no wildcards but bounded search)
(COND
((SETQ RESULT (TEDIT.FIND TEXTOBJ (CAR TARGETLIST)
START# END# NIL))
(LIST RESULT (SUB1 (IPLUS RESULT
(NCHARS (CAR TARGETLIST]
(T (* will return just the number of the start char or nil
if not found)
(PROG (RESULT)
(SETQ RESULT (\TEDIT.BASICFIND TEXTOBJ TARGETSTRING START#))
(RETURN (COND
((NULL END#)
RESULT)
((OR (NULL RESULT)
(GREATERP (IPLUS RESULT (SUB1 (NCHARS TARGETSTRING)))
END#))
NIL)
(T RESULT])
(TEDIT.NEW.FIND
[LAMBDA (TEXTOBJ TARGETSTRING START# END# WILDCARDS?) (* jds "10-Jan-84 17:06")
(* If WILDCARDS? is NIL then TEDIT.NEW.FIND is the old TEDIT.FIND. Else, it returns a list of
(SEL.START# SEL.END#) which is the start and end char positions of the selection)
(PROG ((TEXTSTREAM (fetch STREAMHINT of TEXTOBJ))
PATTERN FIRSTPAT PATTERNSTACK POSNSTACK FIRSTCHAR1 FIRSTCHAR2 FIRSTPATNORMAL PATTERNLEN
FOUND PATTERNPOS TEXTPOS)
(AND TARGETSTRING (NOT (STRINGP TARGETSTRING))
(SETQ TARGETSTRING (MKSTRING TARGETSTRING)))
(SETQ PATTERN (\TEDIT.NEW.PARSE.SEARCHSTRING TARGETSTRING))
(OR PATTERN (RETURN))
(SETQ PATTERNLEN (FLENGTH PATTERN))
(\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT
THACTION ←(QUOTE Find)
THAUXINFO ← TARGETSTRING))
[COND
([ZEROP (LOGAND \SpecialPattern (SETQ FIRSTPAT (CAR PATTERN]
(* The pattern starts with an easy first character)
(SETQ FIRSTPATNORMAL T)
(SETQ FIRSTCHAR1 (LOGAND \CHARMASK FIRSTPAT))
(COND
((ZEROP (LOGAND \AlphaFlag FIRSTPAT)) (* Not alphabetic)
(SETQ FIRSTCHAR2 FIRSTCHAR1))
(T (* Is alphabetic)
(SETQ FIRSTCHAR2 (LOGAND FIRSTCHAR1 223]
(bind (CH# ← START#) while (ILEQ CH# END#) first (\SETUPGETCH START# TEXTOBJ)
do (COND
(FIRSTPATNORMAL (* The pattern starts with an easy first character)
(COND
((AND (NEQ (SETQ CH (\BIN TEXTSTREAM))
FIRSTCHAR1)
(NEW CH FIRSTCHAR2))
(GO $$ITERATE)))
(SETQ PATTERNPOS 1)
(SETQ CH (\BIN TEXTSTREAM)))
(T (SETQ PATTERNPOS 0)))
(SETQ TEXTPOS (\TEXTMARK TEXTOBJ))
(COND
((IGEQ PATTERNPOS PATTERNLEN)
(SETQ FOUND T)
(RETURN])
(TEDIT.NEXT
[LAMBDA (STREAM) (* jds " 6-Mar-85 22:24")
(PROG ((TEXTOBJ (TEXTOBJ STREAM))
TARGET SEL OPTION FIELDSEL)
(SETQ SEL (fetch SEL of TEXTOBJ))
(SETQ TARGET (TEDIT.FIND TEXTOBJ ">>*<<" NIL NIL T))
(* find the first >>delimited<< field)
(SETQ FIELDSEL (MBUTTON.FIND.NEXT.FIELD TEXTOBJ (fetch CH# of SEL)))
(* find the first menu-type insertion field, usually
delimited with {})
[SETQ OPTION (COND
[(AND TARGET FIELDSEL) (* take the first one)
(COND
((IGREATERP (CAR TARGET)
(fetch CH# of FIELDSEL)) (* use the {} selection)
(QUOTE FIELD))
(T (QUOTE TARGET]
(TARGET (QUOTE TARGET))
(FIELDSEL (QUOTE FIELD))
(T (QUOTE NEITHER]
(SELECTQ OPTION
(TARGET (* Found another fill-in)
(\SHOWSEL SEL NIL NIL)
(replace CH# of SEL with (CAR TARGET))
(* Set up SELECTION to be the found text)
(replace CHLIM of SEL with (ADD1 (CADR TARGET)))
(replace DCH of SEL with (IDIFFERENCE (ADD1 (CADR TARGET))
(CAR TARGET)))
(replace POINT of SEL with (QUOTE RIGHT))
(\TEDIT.SET.SEL.LOOKS SEL (QUOTE PENDINGDEL))
(* Always selected normally)
(replace BLUEPENDINGDELETE of TEXTOBJ with T)
(* And never pending a deletion.)
(\FIXSEL SEL TEXTOBJ)
(TEDIT.NORMALIZECARET TEXTOBJ)
(\SHOWSEL SEL NIL T) (* And get it into the window)
)
(FIELD (* Replace the selection for this textobj with the
scratch sel returned from MBUTTON.FIND.NEXT.FIELD)
(\SHOWSEL SEL NIL NIL)
(replace CH# of SEL with (fetch CH# of FIELDSEL))
(* Set up SELECTION to be the found text)
(replace CHLIM of SEL with (fetch CHLIM of FIELDSEL))
(replace DCH of SEL with (fetch DCH of FIELDSEL))
(replace POINT of SEL with (QUOTE LEFT))
(\TEDIT.SET.SEL.LOOKS SEL (QUOTE PENDINGDEL))
(replace BLUEPENDINGDELETE of TEXTOBJ with T)
(\FIXSEL SEL TEXTOBJ)
(TEDIT.NORMALIZECARET TEXTOBJ)
(\SHOWSEL SEL NIL T) (* And get it into the window)
)
(NEITHER (TEDIT.PROMPTPRINT TEXTOBJ "No more blanks to fill in." T)
(SETQ SEL NIL))
(SHOULDNT "No legal value found in selectq in TEDIT.NEXT"))
(COND
(SEL (* There really IS a selection made here, so set up the
charlooks for it properly.)
(replace CARETLOOKS of TEXTOBJ with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL])
(\TEDIT.FIND.WC
[LAMBDA (TEXTOBJ TARGETLIST START# END#) (* jds "28-SEP-83 18:18")
(* \TEDIT.FIND.WC returns the end char # of the
TARGETLIST which may contain wildcards)
(PROG (RESULT RESULT1)
(RETURN (COND
((SETQ RESULT (\TEDIT.FIND.WC1 TEXTOBJ TARGETLIST START# END#))
(* SUB1 because NEWFIND.WC2 takes that arg as the Lastchar of the selection so far and so will start on the next
char after this)
(* DONE!)
(LIST START# (IMAX START# RESULT)))
(T (AND (SETQ RESULT1 (\TEDIT.SUBST.FN1 TEXTOBJ TARGETLIST (ADD1 START#)
END#))
(\TEDIT.FIND.WC TEXTOBJ TARGETLIST RESULT1 END#])
(\TEDIT.FIND.WC1
[LAMBDA (TEXTOBJ TARGETLIST TRIALEND# END#) (* PeanLim "29-AUG-83 20:07")
(* TRIALEND# is where the next char string should go)
(* \TEDIT.FIND.WC1 should return the lastchar# of
selection)
(PROG (RESULT RESULT1)
(RETURN (COND
((NULL TARGETLIST) (* DONE!)
(SUB1 TRIALEND#))
[(STRINGP (CAR TARGETLIST))
(COND
((SETQ RESULT (TEDIT.FIND TEXTOBJ (CAR TARGETLIST)
TRIALEND# END# NIL))
(* NOT null)
(\TEDIT.FIND.WC1 TEXTOBJ (CDR TARGETLIST)
(IPLUS RESULT (NCHARS (CAR TARGETLIST)))
END#]
((LITATOM (CAR TARGETLIST))
(COND
[(MEMBER (CAR TARGETLIST)
(QUOTE (#))) (* fixed width wildcard)
(COND
((OR (NULL (CDR TARGETLIST))
(EQUAL (CAR (TEDIT.FIND TEXTOBJ (CONCATLIST (\TEDIT.PACK.TARGETLIST
(CDR TARGETLIST)))
(ADD1 TRIALEND#)
END# T))
(ADD1 TRIALEND#))) (* If the next start after a fixed char is the char
after it, OK. else return nil)
(\TEDIT.FIND.WC1 TEXTOBJ (CDR TARGETLIST)
(ADD1 TRIALEND#)
END#]
(T (* variable width wildcard)
(COND
((CDR TARGETLIST)
(SETQ RESULT1 (TEDIT.FIND TEXTOBJ (CONCATLIST (\TEDIT.PACK.TARGETLIST
(CDR TARGETLIST)))
TRIALEND# END# T))
(AND RESULT1 (CADR RESULT1)))
(T (* last element of search)
(SUB1 TRIALEND#])
(\TEDIT.PACK.TARGETLIST
[LAMBDA (TARGETLIST) (* PeanLim "29-AUG-83 20:02")
(COND
((NULL TARGETLIST)
NIL)
[(MEMBER (CAR TARGETLIST)
TEDIT.WILDCARD.CHARACTERS)
(CONS (CONCAT (CAR TARGETLIST)
(CAR TARGETLIST))
(\TEDIT.PACK.TARGETLIST (CDR TARGETLIST]
[(STRINGP (CAR TARGETLIST))
(CONS (CAR TARGETLIST)
(\TEDIT.PACK.TARGETLIST (CDR TARGETLIST]
(T (* wildcard)
(CONS (MKSTRING (CAR TARGETLIST))
(\TEDIT.PACK.TARGETLIST (CDR TARGETLIST])
(\TEDIT.PARSE.SEARCHSTRING
[LAMBDA (LST RESULT) (* jds "31-Jan-84 13:26")
(PROG [(TEDIT.WILDCARD.CHARACTERS (QUOTE ("#" "*"]
(RETURN (COND
[(NULL LST)
(COND
(RESULT (LIST RESULT]
[(MEMBER (CAR LST)
TEDIT.WILDCARD.CHARACTERS)
(COND
[(NULL RESULT)
(CONS (MKATOM (CAR LST))
(\TEDIT.PARSE.SEARCHSTRING (CDR LST]
(T (APPEND (LIST RESULT (MKATOM (CAR LST)))
(\TEDIT.PARSE.SEARCHSTRING (CDR LST]
[(AND (EQUAL (CAR LST)
"'")
(LISTP (CDR LST))
(MEMBER (CADR LST)
TEDIT.WILDCARD.CHARACTERS))
(* quoting something a wildcard char)
(\TEDIT.PARSE.SEARCHSTRING (CDDR LST)
(COND
((NULL RESULT)
(MKSTRING (CADR LST)))
(T (CONCAT RESULT (MKSTRING (CADR LST]
(T (\TEDIT.PARSE.SEARCHSTRING (CDR LST)
(COND
((NULL RESULT)
(CAR LST))
(T (CONCAT RESULT (CAR LST])
(\TEDIT.SUBST.FN1
[LAMBDA (TEXTOBJ TARGETLIST START# END#) (* PeanLim "26-AUG-83 12:36")
(* returns the char location that would match the
beginning element of a targetlist)
(PROG (RESULT)
(SETQ RESULT (\TEDIT.SUBST.FN2 TEXTOBJ TARGETLIST START# END#))
(RETURN (AND RESULT (GEQ RESULT START#)
RESULT])
(\TEDIT.SUBST.FN2
[LAMBDA (TEXTOBJ TARGETLIST TRIALSTART# END#) (* PeanLim "26-AUG-83 12:37")
(* will return the start char of a wildcarded selection.
returns NIL if selection is beyond bounds)
(COND
((NULL TARGETLIST)
TRIALSTART#)
[(LITATOM (CAR TARGETLIST))
(COND
((MEMBER (CAR TARGETLIST)
(QUOTE (#))) (* fixed width wildcard)
(SUB1 (\TEDIT.SUBST.FN1 TEXTOBJ (CDR TARGETLIST)
(ADD1 TRIALSTART#)
END#)))
(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.SUBSTITUTE
[LAMBDA (TEXTSTREAM PATTERN REPLACEMENT CONFIRM?) (* jds "17-Jul-85 11:41")
(* Replace all instances of PATTERN with REPLACEMENT.
If CONFIRM? is non-NIL, ask before each replacement.)
(PROG (SEARCHSTRING REPLACESTRING ABORTFLG OUTOFRANGEFLG (TEXTOBJ (TEXTOBJ TEXTSTREAM))
BEGINCHAR# ENDCHAR# STARTCHAR# RANGE (REPLACEDFLG 0)
(YESLIST (QUOTE ("Y" "y" "yes" "YES" "T" "Yes")))
CONFIRMFLG SEL PC# SELCH# SELCHLIM SELPOINT CRSEEN)
(COND
([NULL (SETQ SEARCHSTRING (OR PATTERN (TEDIT.GETINPUT TEXTOBJ "Search string:" NIL
(CHARCODE (EOL LF ESC]
(* If the search pattern is empty, bail out.)
(TEDIT.PROMPTPRINT TEXTOBJ "[Aborted]")
(RETURN)))
[SETQ REPLACESTRING (OR REPLACEMENT (TEDIT.GETINPUT TEXTOBJ "Replace string:")
""
(CHARCODE (EOL LF ESC]
(SETQ CRSEEN (STRPOS (CHARACTER (CHARCODE CR))
REPLACESTRING))
[COND
(PATTERN (* If a pattern is specd in the call, use the caller's
confirm flag.)
(SETQ CONFIRMFLG CONFIRM?))
(T (* Otherwise, ask for one.)
(SETQ CONFIRMFLG (MEMBER (TEDIT.GETINPUT TEXTOBJ "Ask before each replace?" "No"
(CHARCODE (EOL SPACE ESCAPE LF TAB)))
YESLIST]
(TEDIT.PROMPTPRINT TEXTOBJ "Substituting..." T)
(SETQ SEL (fetch SEL of TEXTOBJ)) (* STARTCHAR# and ENDCHAR# are the bound of the search)
(\SHOWSEL SEL NIL NIL)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL) (* Turn off any blue pending delete)
(SETQ BEGINCHAR# (SETQ STARTCHAR# (fetch CH# of SEL)))
[SETQ ENDCHAR# (IPLUS STARTCHAR# (SUB1 (fetch DCH of SEL]
(while (AND (SETQ RANGE (TEDIT.FIND TEXTOBJ SEARCHSTRING STARTCHAR# ENDCHAR# T))
(NOT ABORTFLG))
do [PROG (PENDING.SEL CHOICE)
(COND
[CONFIRMFLG (SETQ PENDING.SEL (TEDIT.SETSEL TEXTSTREAM (CAR RANGE)
(IDIFFERENCE (CADR RANGE)
(SUB1 (CAR RANGE)))
(QUOTE RIGHT)
T))
(\SHOWSEL PENDING.SEL NIL NIL)
(TEDIT.NORMALIZECARET TEXTOBJ PENDING.SEL)
(\SHOWSEL PENDING.SEL NIL T)
[SETQ CHOICE (TEDIT.GETINPUT TEXTOBJ "OK to replace? ['q' quits]"
"Yes"
(CHARCODE (EOL SPACE ESCAPE LF TAB]
(COND
((MEMBER CHOICE (QUOTE ("Q" "q")))
(SETQ ABORTFLG T)
(GO L1))
((NOT (MEMBER CHOICE YESLIST))
(* turn off selection)
(TEDIT.SHOWSEL TEXTSTREAM NIL PENDING.SEL)
(GO L1))
(T (* OK to replace)
(TEDIT.DELETE TEXTSTREAM PENDING.SEL)
(* make the replacement)
(COND
((NOT (EQUAL REPLACESTRING ""))
(* If the replacestring is nothing, why bother to add
nothing)
(TEDIT.INSERT TEXTSTREAM REPLACESTRING (CAR RANGE))
[SETQ ENDCHAR# (IPLUS ENDCHAR#
(IDIFFERENCE
(NCHARS REPLACESTRING)
(IDIFFERENCE
(CADR RANGE)
(SUB1 (CAR RANGE]
(add REPLACEDFLG 1]
(T (* No confirmation required.
Do the substitutions without showing intermediate work)
[replace CARETLOOKS of TEXTOBJ with (fetch PLOOKS
of (\CHTOPC (CAR RANGE)
(fetch PCTB
of TEXTOBJ]
(SETQ PC# (\DELETECH (CAR RANGE)
(ADD1 (CADR RANGE))
(ADD1 (IDIFFERENCE (CADR RANGE)
(CAR RANGE)))
TEXTOBJ))
(\FIXDLINES (fetch LINES of TEXTOBJ)
SEL
(CAR RANGE)
(ADD1 (CADR RANGE))
TEXTOBJ)
[COND
((NOT (EQUAL REPLACESTRING ""))
(* If the replacestring is nothing, why bother to add
nothing)
(\FIXILINES TEXTOBJ SEL (CAR RANGE)
(NCHARS REPLACESTRING)
(fetch TEXTLEN of TEXTOBJ))
(COND
[CRSEEN (for ACHAR instring REPLACESTRING as NCH#
from (CAR RANGE) by 1
do (SELCHARQ ACHAR
(CR (\INSERTCR ACHAR NCH# TEXTOBJ))
(\INSERTCH ACHAR NCH# TEXTOBJ]
(T (\INSERTCH REPLACESTRING (CAR RANGE)
TEXTOBJ PC#)))
(SETQ ENDCHAR# (IPLUS ENDCHAR# (IDIFFERENCE
(NCHARS REPLACESTRING)
(IDIFFERENCE (CADR RANGE)
(SUB1 (CAR RANGE]
(add REPLACEDFLG 1)))
L1 (SETQ STARTCHAR# (IPLUS (CAR RANGE)
(NCHARS REPLACESTRING]
(* start looking where you left off)
)
(COND
((ZEROP REPLACEDFLG)
(TEDIT.PROMPTPRINT TEXTOBJ "No replacements made." T))
((EQUAL REPLACEDFLG 1)
(TEDIT.PROMPTPRINT TEXTOBJ "1 Replacement made." T))
(T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (MKSTRING REPLACEDFLG)
" Replacements made.")
T)))
(COND
((AND (NOT CONFIRMFLG)
(NOT (ZEROP REPLACEDFLG))) (* There WERE replacements, and they were not
confirmed.)
(replace CHLIM of SEL with (ADD1 ENDCHAR#)) (* account for the changes in selection length due to
replacements)
(replace CH# of SEL with BEGINCHAR#) (* And remember where it started)
(replace DCH of SEL with (IDIFFERENCE (fetch CHLIM of SEL)
(fetch CH# of SEL)))
(\TEDIT.MARK.LINES.DIRTY TEXTOBJ (fetch CH# of SEL)
(fetch CHLIM of SEL))
(TEDIT.UPDATE.SCREEN TEXTOBJ)
(\FIXSEL SEL TEXTOBJ)
(\SHOWSEL SEL NIL T)))
(RETURN REPLACEDFLG])
)
(PUTPROPS TEDITFIND COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1276 2448 (\TEDIT.SEARCH.CODETABLE 1286 . 2446)) (3390 26915 (\TEDIT.BASICFIND 3400 .
5940) (TEDIT.FIND 5942 . 8795) (TEDIT.NEW.FIND 8797 . 10961) (TEDIT.NEXT 10963 . 14400) (
\TEDIT.FIND.WC 14402 . 15242) (\TEDIT.FIND.WC1 15244 . 17051) (\TEDIT.PACK.TARGETLIST 17053 . 17671) (
\TEDIT.PARSE.SEARCHSTRING 17673 . 18735) (\TEDIT.SUBST.FN1 18737 . 19185) (\TEDIT.SUBST.FN2 19187 .
20116) (TEDIT.SUBSTITUTE 20118 . 26913)))))
STOP