initial checkin for library
This commit is contained in:
Larry Masinter
493
library/TEDITFIND
Normal file
493
library/TEDITFIND
Normal file
@@ -0,0 +1,493 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 6-May-2018 17:34:44"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITFIND.;2 40100
|
||||
|
||||
changes to%: (FNS TEDIT.FIND)
|
||||
|
||||
previous date%: "25-Aug-94 10:53:52"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITFIND.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 by Venue & Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT TEDITFINDCOMS)
|
||||
|
||||
(RPAQQ TEDITFINDCOMS
|
||||
((FILES TEDITDCL)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
|
||||
(FILES (LOADCOMP)
|
||||
TEDITDCL))
|
||||
[DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.SEARCH.CODETABLE (\TEDIT.SEARCH.CODETABLE]
|
||||
(COMS (* Read-table Utilities)
|
||||
(FNS \TEDIT.SEARCH.CODETABLE)
|
||||
(GLOBALVARS TEDIT.SEARCH.CODETABLE))
|
||||
(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)))
|
||||
|
||||
(FILESLOAD TEDITDCL)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \SCRATCHLEN 64)
|
||||
|
||||
|
||||
(CONSTANTS (\SCRATCHLEN 64))
|
||||
)
|
||||
|
||||
|
||||
(FILESLOAD (LOADCOMP)
|
||||
TEDITDCL)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(RPAQ TEDIT.SEARCH.CODETABLE (\TEDIT.SEARCH.CODETABLE))
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* 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 '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%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS TEDIT.SEARCH.CODETABLE)
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.BASICFIND
|
||||
[LAMBDA (TEXTOBJ STRING CH# CHLIM) (* ; "Edited 30-May-91 20:56 by jds")
|
||||
|
||||
(* ;; "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 (TEXTOBJ SEL) of TEXTOBJ))
|
||||
[TEXTLIM (OR CHLIM (ADD1 (IDIFFERENCE (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)
|
||||
(NCHARS STRING]
|
||||
(TEXTSTREAM (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ))
|
||||
(FOUND NIL)
|
||||
(CH#1 (NTHCHARCODE STRING 1))
|
||||
CH1 ANCHOR PCH# OANCHOR CH)
|
||||
(replace (TEXTOBJ \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 (SELECTION SET) of SEL))(* ;
|
||||
"There must be a well-defined starting point.")
|
||||
(RETURN (PROG NIL
|
||||
(SETQ CH1 (OR CH# (SELECTQ (fetch (SELECTION POINT) of SEL)
|
||||
(LEFT (fetch (SELECTION CH#) of SEL))
|
||||
(RIGHT (fetch (SELECTION 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)))
|
||||
(SETQ ANCHOR (SUB1 CH1))
|
||||
RETRY
|
||||
(\SETUPGETCH (ADD1 ANCHOR)
|
||||
TEXTOBJ)
|
||||
[for old ANCHOR from (ADD1 ANCHOR) to TEXTLIM
|
||||
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 TEXTLIM 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?) (* ; "Edited 6-May-2018 17:34 by rmk:")
|
||||
(* ; "Edited 30-May-91 20:56 by jds")
|
||||
|
||||
(* ;; "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")
|
||||
|
||||
(LET*
|
||||
[(TEXTOBJ (TEXTOBJ TEXTOBJ))
|
||||
(TEDIT.WILDCARD.CHARACTERS '("#" "*"))
|
||||
(REAL-END# (OR END# (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ]
|
||||
(AND TARGETSTRING (NOT (STRINGP TARGETSTRING))
|
||||
(SETQ TARGETSTRING (MKSTRING TARGETSTRING)))
|
||||
|
||||
(* ;; "RMK: FIND isn't undoable, FIND-AGAIN is armed on meta-g. No point in hiding a previous actual edit by adding the find event (given that the history is not a list, just a single event (TEDITHISTORY)")
|
||||
|
||||
(AND NIL (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT
|
||||
THACTION _ 'Find
|
||||
THAUXINFO _ TARGETSTRING)))
|
||||
(replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL)
|
||||
(* ;
|
||||
"Any FIND invalidates the type-in cache.")
|
||||
(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 (SELECTION SET) of (SETQ SEL
|
||||
(fetch (TEXTOBJ
|
||||
SEL)
|
||||
of TEXTOBJ)))
|
||||
(LEQ (SETQ START# (SELECTQ (fetch (SELECTION POINT)
|
||||
of SEL)
|
||||
(LEFT (fetch (SELECTION CH#)
|
||||
of SEL))
|
||||
(RIGHT (fetch (SELECTION CHLIM)
|
||||
of SEL))
|
||||
NIL))
|
||||
REAL-END#))) (* ; "START# better be >= to END#")
|
||||
(COND
|
||||
((AND (for X in [SETQ TARGETLIST
|
||||
(\TEDIT.PARSE.SEARCHSTRING
|
||||
(for X in (CHCON TARGETSTRING)
|
||||
collect (MKSTRING (CHARACTER X]
|
||||
collect X when (LITATOM X))
|
||||
(SETQ RESULT1 (\TEDIT.SUBST.FN1 TEXTOBJ TARGETLIST START#
|
||||
REAL-END#)))
|
||||
(* ;
|
||||
"If there are atoms, they are tedit wildcard chars")
|
||||
(\TEDIT.FIND.WC TEXTOBJ TARGETLIST RESULT1 REAL-END#))
|
||||
(T (* ; "no wildcards but bounded search")
|
||||
(COND
|
||||
((SETQ RESULT (TEDIT.FIND TEXTOBJ (CAR TARGETLIST)
|
||||
START# REAL-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")
|
||||
(LET ((RESULT (\TEDIT.BASICFIND TEXTOBJ TARGETSTRING START# REAL-END#)))
|
||||
(COND
|
||||
((NULL REAL-END#)
|
||||
RESULT)
|
||||
((OR (NULL RESULT)
|
||||
(GREATERP (IPLUS RESULT (SUB1 (NCHARS TARGETSTRING)))
|
||||
REAL-END#))
|
||||
NIL)
|
||||
(T RESULT])
|
||||
|
||||
(TEDIT.NEW.FIND
|
||||
[LAMBDA (TEXTOBJ TARGETSTRING START# END# WILDCARDS?) (* ; "Edited 23-Feb-88 11:13 by jds")
|
||||
|
||||
(* ;; "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)))))")
|
||||
|
||||
(HELP])
|
||||
|
||||
(TEDIT.NEXT
|
||||
[LAMBDA (STREAM) (* ; "Edited 30-May-91 20:57 by jds")
|
||||
(PROG ((TEXTOBJ (TEXTOBJ STREAM))
|
||||
TARGET SEL OPTION FIELDSEL)
|
||||
(SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
|
||||
(SETQ TARGET (TEDIT.FIND TEXTOBJ ">>*<<" NIL NIL T))
|
||||
(* find the first >>delimited<<
|
||||
field)
|
||||
(SETQ FIELDSEL (MBUTTON.FIND.NEXT.FIELD TEXTOBJ (fetch (SELECTION 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 (SELECTION CH#) of FIELDSEL))
|
||||
(* use the {} selection)
|
||||
'FIELD)
|
||||
(T 'TARGET]
|
||||
(TARGET 'TARGET)
|
||||
(FIELDSEL 'FIELD)
|
||||
(T 'NEITHER]
|
||||
(SELECTQ OPTION
|
||||
(TARGET (* Found another fill-in)
|
||||
(\SHOWSEL SEL NIL NIL)
|
||||
(replace (SELECTION CH#) of SEL with (CAR TARGET))
|
||||
(* Set up SELECTION to be the found
|
||||
text)
|
||||
(replace (SELECTION CHLIM) of SEL with (ADD1 (CADR TARGET)))
|
||||
(replace (SELECTION DCH) of SEL with (IDIFFERENCE
|
||||
(ADD1 (CADR TARGET))
|
||||
(CAR TARGET)))
|
||||
(replace (SELECTION POINT) of SEL with 'RIGHT)
|
||||
(\TEDIT.SET.SEL.LOOKS SEL 'PENDINGDEL) (* Always selected normally)
|
||||
(replace (TEXTOBJ 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 (SELECTION CH#) of SEL with (fetch (SELECTION CH#)
|
||||
of FIELDSEL))
|
||||
(* Set up SELECTION to be the found
|
||||
text)
|
||||
(replace (SELECTION CHLIM) of SEL with (fetch (SELECTION CHLIM)
|
||||
of FIELDSEL))
|
||||
(replace (SELECTION DCH) of SEL with (fetch (SELECTION DCH)
|
||||
of FIELDSEL))
|
||||
(replace (SELECTION POINT) of SEL with 'LEFT)
|
||||
(\TEDIT.SET.SEL.LOOKS SEL 'PENDINGDEL)
|
||||
(replace (TEXTOBJ 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 (TEXTOBJ CARETLOOKS) of TEXTOBJ with (
|
||||
\TEDIT.GET.INSERT.CHARLOOKS
|
||||
TEXTOBJ SEL])
|
||||
|
||||
(\TEDIT.FIND.WC
|
||||
[LAMBDA (TEXTOBJ TARGETLIST START# END#) (* ; "Edited 9-Dec-88 09:56 by jds")
|
||||
(* ;
|
||||
"\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#) (* ; "Edited 9-Dec-88 09:52 by jds")
|
||||
(* ;
|
||||
"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)
|
||||
'(%#)) (* ; "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) (* ; "Edited 24-Sep-87 09:54 by jds")
|
||||
|
||||
(COND
|
||||
((NULL TARGETLIST)
|
||||
NIL)
|
||||
[(MEMBER (CAR TARGETLIST)
|
||||
'("#" "*"))
|
||||
(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 '("#" "*")))
|
||||
(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#) (* ; "Edited 3-Sep-87 11:38 by jds")
|
||||
(* ;
|
||||
"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 (IGEQ RESULT START#)
|
||||
RESULT])
|
||||
|
||||
(\TEDIT.SUBST.FN2
|
||||
[LAMBDA (TEXTOBJ TARGETLIST TRIALSTART# END#) (* ; "Edited 9-Dec-88 09:54 by jds")
|
||||
|
||||
(* ;;
|
||||
"will return the start char of a wildcarded selection. returns NIL if selection is beyond bounds")
|
||||
|
||||
(* ;; "TARGETLIST is (what)?")
|
||||
|
||||
(LET (SUB-FIND-RESULT)
|
||||
(COND
|
||||
((NULL TARGETLIST)
|
||||
TRIALSTART#)
|
||||
((IGREATERP TRIALSTART# END#)
|
||||
NIL)
|
||||
[(LITATOM (CAR TARGETLIST))
|
||||
(COND
|
||||
((EQ (CAR TARGETLIST)
|
||||
'%#) (* ; "fixed width wildcard")
|
||||
(AND (SETQ SUB-FIND-RESULT (\TEDIT.SUBST.FN1 TEXTOBJ (CDR TARGETLIST)
|
||||
(ADD1 TRIALSTART#)
|
||||
END#))
|
||||
(SUB1 SUB-FIND-RESULT)))
|
||||
(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?) (* ; "Edited 30-Mar-94 16:04 by jds")
|
||||
|
||||
(* ;; "Replace all instances of PATTERN with REPLACEMENT. If CONFIRM? is non-NIL, ask before each replacement.")
|
||||
|
||||
(PROG ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
|
||||
(REPLACEDFLG 0)
|
||||
(YESLIST '("Y" "y" "yes" "YES" "T" "Yes"))
|
||||
SEARCHSTRING REPLACESTRING ABORTFLG OUTOFRANGEFLG BEGINCHAR# ENDCHAR# STARTCHAR# RANGE
|
||||
CONFIRMFLG SEL PC# SELCH# SELCHLIM SELPOINT CRSEEN REPLACE-LEN)
|
||||
(COND
|
||||
([NULL (SETQ SEARCHSTRING (OR PATTERN (TEDIT.GETINPUT TEXTOBJ "Search string:"
|
||||
(TEXTPROP TEXTOBJ
|
||||
'TEDIT.LAST.SUBSTITUTE.STRING)
|
||||
(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:"
|
||||
(TEXTPROP TEXTOBJ
|
||||
'TEDIT.LAST.REPLACEMENT.STRING)
|
||||
(CHARCODE (EOL LF ESC]
|
||||
[COND
|
||||
((STRINGP REPLACESTRING)
|
||||
(SETQ REPLACE-LEN (NCHARS REPLACESTRING)))
|
||||
((LISTP REPLACESTRING) (* ;
|
||||
"It's a list of pieces, meaning insert these pieces as the replacement.")
|
||||
(SETQ REPLACE-LEN (for PC in REPLACESTRING sum (fetch (PIECE PLEN)
|
||||
of PC]
|
||||
(SETQ CRSEEN (AND REPLACESTRING (STRINGP REPLACESTRING)
|
||||
(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 (TEXTOBJ 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 (SELECTION CH#) of SEL)))
|
||||
[SETQ ENDCHAR# (IPLUS STARTCHAR# (SUB1 (fetch (SELECTION 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)))
|
||||
Reference in New Issue
Block a user