(FILECREATED "29-Jul-86 01:54:16" {ERIS}<LISPCORE>LIBRARY>CMLSTRING.;14 36210
changes to: (VARS CMLSTRINGCOMS)
(FNS STRING)
previous date: "17-Jul-86 04:58:25" {ERIS}<LISPCORE>LIBRARY>CMLSTRING.;13)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT CMLSTRINGCOMS)
(RPAQQ CMLSTRINGCOMS
[(FUNCTIONS FOR-SUBSTRING \STRING WITH-ONE-STRING WITH-STRING WITH-TWO-STRINGS STRING<>=*-BODY
)
(FNS STRING STRING-EQUAL \SP-STRING-COMPARE STRING=* STRING/=* STRING<* STRING>* STRING<=*
STRING>=* STRING< STRING> STRING<= STRING>= STRING= STRING/= STRING-LESSP
STRING-GREATERP STRING-NOT-GREATERP STRING-NOT-LESSP STRING-NOT-EQUAL MAKE-STRING
STRING-UPCASE STRING-DOWNCASE STRING-CAPITALIZE NSTRING-UPCASE NSTRING-DOWNCASE
NSTRING-CAPITALIZE STRING-LEFT-TRIM STRING-RIGHT-TRIM STRING-TRIM)
(PROP FILETYPE CMLSTRING)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML)
(LAMA STRING-TRIM STRING-RIGHT-TRIM STRING-LEFT-TRIM NSTRING-CAPITALIZE
NSTRING-DOWNCASE NSTRING-UPCASE STRING-CAPITALIZE STRING-DOWNCASE
STRING-UPCASE MAKE-STRING STRING-NOT-EQUAL STRING-NOT-LESSP
STRING-NOT-GREATERP STRING-GREATERP STRING-LESSP STRING/= STRING=
STRING>= STRING<= STRING> STRING< STRING>=* STRING<=* STRING>* STRING<*
STRING/=* STRING=* STRING-EQUAL STRING])
(DEFMACRO FOR-SUBSTRING (STRING START END NEW INDEX &REST FORMS)
(* * Creates a new string to hold the old string and iterates the body over the
positions START to END with INDEX * *)
(BQUOTE (LET* ((SLEN (CL:LENGTH (\, STRING)))
((\, NEW)
(MAKE-STRING SLEN)))
(for INDEX from 0 to (1- (\, START)) do (SETF (CHAR (\, NEW)
INDEX)
(CHAR (\, STRING)
INDEX)))
(for (\, INDEX) from (\, START) to (1- (\, END)) do (\,@ FORMS))
(for INDEX from (\, END) to (1- SLEN) do (SETF (CHAR (\, NEW)
INDEX)
(CHAR (\, STRING)
INDEX)))
(\, NEW))))
(DEFMACRO \STRING (THING) (* \String returns its arg if it is a
string, otherwise calls String.
*) (BQUOTE (COND
((STRINGP (\, THING))
(\, THING))
(T (STRING (\, THING))))))
(DEFMACRO WITH-ONE-STRING (STRING START END &REST FORMS) (* WITH-ONE-STRING is used to set up
some string hacking things.
The keywords are parsed, and the
string is hacked into a simple-string.
*)
(BQUOTE (PROGN (COND
((SYMBOLP (\, STRING))
(SETQ (\, STRING)
(SYMBOL-NAME (\, STRING)))))
(COND
((NULL (\, END))
(SETQ (\, END)
(CL:LENGTH (\, STRING)))))
(\,@ FORMS))))
(DEFMACRO WITH-STRING (STRING &REST FORMS) (* WITH-STRING is like
WITH-ONE-STRING, but doesn't parse
keywords. *)
(BQUOTE (LET ((START 0)
END)
(COND
((SYMBOLP (\, STRING))
(SETQ (\, STRING)
(SYMBOL-NAME (\, STRING)))))
(SETQ END (CL:LENGTH (\, STRING)))
(\,@ FORMS))))
(DEFMACRO WITH-TWO-STRINGS (STRING1 STRING2 START1 END1 START2 END2 &REST FORMS)
(* WITH-TWO-STRINGS is used to set up
string comparison operations.
The keywords are parsed, and symbols
are hacked into strings *)
(BQUOTE (PROGN (COND
((SYMBOLP (\, STRING1))
(SETQ (\, STRING1)
(SYMBOL-NAME (\, STRING1)))))
(COND
((NULL (\, END1))
(SETQ (\, END1)
(CL:LENGTH (\, STRING1)))))
(COND
((SYMBOLP (\, STRING2))
(SETQ (\, STRING2)
(SYMBOL-NAME (\, STRING2)))))
(COND
((NULL (\, END2))
(SETQ (\, END2)
(CL:LENGTH (\, STRING2)))))
(\,@ FORMS))))
(DEFMACRO STRING<>=*-BODY (LESSP EQUALP)
(BQUOTE (WITH-TWO-STRINGS STRING1 STRING2 START1 END1 START2 END2
(LET ((INDEX (\SP-STRING-COMPARE STRING1 START1 END1 STRING2 START2 END2)))
(COND
(INDEX (COND
((= INDEX (\, (COND
(LESSP (QUOTE END1))
(T (QUOTE END2)))))
INDEX)
((= INDEX (\, (COND
(LESSP (QUOTE END2))
(T (QUOTE END1)))))
NIL)
(((\, (COND
(LESSP (QUOTE CHAR<))
(T (QUOTE CHAR>))))
(CHAR STRING1 INDEX)
(CHAR STRING2 (+ INDEX (- START2 START1))))
INDEX)
(T NIL)))
(T (\, (COND
(EQUALP (QUOTE (- END1 START1)))
(T (QUOTE NIL))))))))))
(DEFINEQ
(STRING
[CL:LAMBDA (X) (* lmm "29-Jul-86 01:03")
(* Coerces X into a string. If X is a string, X is returned.
If X is a symbol, X's pname is returned.
If X is a character then a one element string containing that character is
returned. If X cannot be coerced into a string, an error occurs.)
(ETYPECASE X (STRING X)
(SYMBOL (SYMBOL-NAME X))
(CHARACTER (LET ((RES (MAKE-STRING 1)))
(SETF (SCHAR RES 0)
X)
RES])
(STRING-EQUAL
[CL:LAMBDA (STRING1 STRING2 &KEY (START1 0)
END1
(START2 0)
END2) (* lmm "17-Jul-86 04:24")
(* Given two strings (string1 and string2)%, and optional integers start1,
start2, end1 and end2, compares characters in string1 to characters in string2
(using CHAR-EQUAL) . *)
(WITH-TWO-STRINGS STRING1 STRING2 START1 END1 START2 END2
(AND (= (- END2 START2)
(- END1 START1))
(NOT (for I1 from START1 to (1- END1) as I2 from START2
when [NOT (EQL (CHAR-UPCASE (CHAR STRING1 I1))
(CHAR-UPCASE (CHAR STRING2 I2] do (RETURN T])
(\SP-STRING-COMPARE
[LAMBDA (STRING1 START1 END1 STRING2 START2 END2) (* raf " 5-Dec-85 03:14")
(* First INDEX at which compared portions of STRING1
and STRING2 differ. *)
(for I1 from START1 to (1- (OR END1 (CL:LENGTH STRING1))) as I2 from START2
to (1- (OR END2 (CL:LENGTH STRING2))) as I from 0
when (NOT (EQ (CHAR STRING1 I1)
(CHAR STRING2 I2)))
do (RETURN I])
(STRING=*
[CL:LAMBDA (STRING1 STRING2 START1 END1 START2 END2) (* lmm "17-Jul-86 04:23")
(WITH-TWO-STRINGS STRING1 STRING2 START1 END1 START2 END2
(AND (= (- END2 START2)
(- END1 START1))
(NOT (\SP-STRING-COMPARE STRING1 START1 END1 STRING2 START2 END2])
(STRING/=*
(CL:LAMBDA (STRING1 STRING2 START1 END1 START2 END2)
(WITH-TWO-STRINGS STRING1 STRING2 START1 END1 START2 END2 (\SP-STRING-COMPARE STRING1 START1
END1 STRING2
START2 END2))))
(STRING<*
[CL:LAMBDA (STRING1 STRING2 START1 END1 START2 END2) (* raf " 4-Dec-85 23:19")
(WITH-TWO-STRINGS STRING1 STRING2 START1 END1 START2 END2
(LET ((INDEX (\SP-STRING-COMPARE STRING1 START1 END1 STRING2 START2 END2)))
(COND
(INDEX (COND
((= INDEX END1)
INDEX)
((= INDEX END2)
NIL)
([CHAR< (CHAR STRING1 INDEX)
(CHAR STRING2 (+ INDEX (- START2 START1]
INDEX)
(T NIL)))
(T NIL])
(STRING>*
[CL:LAMBDA (STRING1 STRING2 START1 END1 START2 END2) (* raf " 4-Dec-85 23:20")
(WITH-TWO-STRINGS STRING1 STRING2 START1 END1 START2 END2
(LET ((INDEX (\SP-STRING-COMPARE STRING1 START1 END1 STRING2 START2 END2)))
(COND
(INDEX (COND
((= INDEX END2)
INDEX)
((= INDEX END1)
NIL)
([CHAR> (CHAR STRING1 INDEX)
(CHAR STRING2 (+ INDEX (- START2 START1]
INDEX)
(T NIL)))
(T NIL])
(STRING<=*
[CL:LAMBDA (STRING1 STRING2 START1 END1 START2 END2) (* raf " 4-Dec-85 23:20")
(WITH-TWO-STRINGS STRING1 STRING2 START1 END1 START2 END2
(LET ((INDEX (\SP-STRING-COMPARE STRING1 START1 END1 STRING2 START2 END2)))
(COND
(INDEX (COND
((= INDEX END1)
INDEX)
((= INDEX END2)
NIL)
([CHAR< (CHAR STRING1 INDEX)
(CHAR STRING2 (+ INDEX (- START2 START1]
INDEX)
(T NIL)))
(T (- END1 START1])
(STRING>=*
[CL:LAMBDA (STRING1 STRING2 START1 END1 START2 END2) (* raf " 4-Dec-85 23:21")
(WITH-TWO-STRINGS STRING1 STRING2 START1 END1 START2 END2
(LET ((INDEX (\SP-STRING-COMPARE STRING1 START1 END1 STRING2 START2 END2)))
(COND
(INDEX (COND
((= INDEX END2)
INDEX)
((= INDEX END1)
NIL)
([CHAR> (CHAR STRING1 INDEX)
(CHAR STRING2 (+ INDEX (- START2 START1]
INDEX)
(T NIL)))
(T (- END1 START1])
(STRING<
[CL:LAMBDA (STRING1 STRING2 &KEY (START1 0)
END1
(START2 0)
END2) (* lmm "17-Jul-86 04:46")
"A string A is less than a string B if in the first position in which they differ the character of A is less than the corresponding character of B according to char< or if string A is a proper prefix of string B (of shorter length and matching in all the characters of A)."
(WITH-TWO-STRINGS STRING1 STRING2 START1 END1 START2 END2
(LET ((SLEN1 (- END1 START1))
(SLEN2 (- END2 START2)))
(COND
((OR (MINUSP SLEN1)
(MINUSP SLEN2))
(CL:ERROR "Improper bounds for string comparison."))
(T NIL))
(CL:DO ((INDEX1 START1 (1+ INDEX1))
(INDEX2 START2 (1+ INDEX2))
(CHAR1)
(CHAR2))
((OR (= INDEX1 END1)
(= INDEX2 END2)) (* return index if string1 shorter,
NIL if they're the same *)
(COND
((= INDEX1 END1)
INDEX1)
(T NIL)))
(SETQ CHAR1 (CHAR STRING1 INDEX1))
(SETQ CHAR2 (CHAR STRING2 INDEX2))
(COND
[(NOT (EQL CHAR1 CHAR2))
(COND
((CHAR< CHAR1 CHAR2)
(RETURN INDEX1))
(T (RETURN NIL]
(T NIL])
(STRING>
[CL:LAMBDA (STRING1 STRING2 &KEY (START1 0)
END1
(START2 0)
END2) (* lmm "17-Jul-86 04:35")
"A string A is less than a string B if in the first position in which they differ the character of A is less than the corresponding character of B according to char< or if string A is a proper prefix of string B (of shorter length and matching in all the characters of A)."
(WITH-TWO-STRINGS STRING1 STRING2 START1 END1 START2 END2
(LET ((SLEN1 (- END1 START1))
(SLEN2 (- END2 START2)))
(COND
((OR (MINUSP SLEN1)
(MINUSP SLEN2))
(CL:ERROR "Improper bounds for string comparison."))
(T NIL))
(CL:DO ((INDEX1 START1 (1+ INDEX1))
(INDEX2 START2 (1+ INDEX2))
(CHAR1)
(CHAR2))
((OR (= INDEX1 END1)
(= INDEX2 END2)) (* return index if string1 shorter,
NIL if they're the same *)
(COND
((NOT (= SLEN1 SLEN2))
INDEX1)
(T NIL)))
(SETQ CHAR1 (CHAR STRING1 INDEX1))
(SETQ CHAR2 (CHAR STRING2 INDEX2))
(COND
[(NOT (EQL CHAR1 CHAR2))
(COND
((CHAR> CHAR1 CHAR2)
(RETURN INDEX1))
(T (RETURN NIL]
(T NIL])
(STRING<=
[CL:LAMBDA (STRING1 STRING2 &KEY (START1 0)
END1
(START2 0)
END2) (* lmm "17-Jul-86 04:42")
(WITH-TWO-STRINGS STRING1 STRING2 START1 END1 START2 END2
(LET ((SLEN1 (- END1 START1))
(SLEN2 (- END2 START2)))
(COND
((OR (MINUSP SLEN1)
(MINUSP SLEN2))
(CL:ERROR "Improper bounds for string comparison."))
(T NIL))
(CL:DO ((INDEX1 START1 (1+ INDEX1))
(INDEX2 START2 (1+ INDEX2))
(CHAR1)
(CHAR2))
((OR (= INDEX1 END1)
(= INDEX2 END2))
(CL:IF (= INDEX1 END1)
INDEX1 NIL))
(SETQ CHAR1 (CHAR STRING1 INDEX1))
(SETQ CHAR2 (CHAR STRING2 INDEX2))
(COND
[(NOT (EQL CHAR1 CHAR2))
(COND
((CHAR<= CHAR1 CHAR2)
(RETURN INDEX1))
(T (RETURN NIL]
(T NIL])
(STRING>=
(CL:LAMBDA (STRING1 STRING2 &KEY (START1 0)
END1
(START2 0)
END2) (* kbr: " 4-Oct-85 11:31")
(* Given two strings, if the first string is lexicographically greater than or equal to the second string, returns
the longest common prefix (using char=) of the two strings. Otherwise, returns NIL . *)
(STRING>=* STRING1 STRING2 START1 END1 START2 END2)))
(STRING=
[CL:LAMBDA (STRING1 STRING2 &KEY (START1 0)
END1
(START2 0)
END2) (* lmm "17-Jul-86 04:57")
(WITH-TWO-STRINGS STRING1 STRING2 START1 END1 START2 END2
(AND (= (- END2 START2)
(- END1 START1))
(for I1 from START1 to (1- END1) as I2 from START2 to (1- END2)
when (NOT (EQL (CHAR STRING1 I1)
(CHAR STRING2 I2))) do (RETURN NIL) finally (RETURN I1])
(STRING/=
[CL:LAMBDA (STRING1 STRING2 &KEY (START1 0)
END1
(START2 0)
END2) (* lmm "17-Jul-86 04:53")
(WITH-TWO-STRINGS STRING1 STRING2 START1 END1 START2 END2
(for I1 from START1 to (1- END1) as I2 from START2 to (1- END2)
when (NOT (EQ (CHAR STRING1 I1)
(CHAR STRING2 I2))) do (RETURN I1)
finally (RETURN (CL:IF (= I1 END1)
(CL:IF (= I2 END2)
NIL I2)
I2])
(STRING-LESSP
[CL:LAMBDA (STRING1 STRING2 &KEY (START1 0)
END1
(START2 0)
END2) (* lmm "17-Jul-86 04:28")
(* Given two strings, if the first string is lexicographically less than the
second string, returns the longest common prefix
(using char-equal) of the two strings. Otherwise, returns NIL . *)
(WITH-TWO-STRINGS STRING1 STRING2 START1 END1 START2 END2
(LET ((SLEN1 (- END1 START1))
(SLEN2 (- END2 START2)))
(COND
((OR (MINUSP SLEN1)
(MINUSP SLEN2))
(CL:ERROR "Improper bounds for string comparison."))
(T NIL))
(CL:DO ((INDEX1 START1 (1+ INDEX1))
(INDEX2 START2 (1+ INDEX2))
(CHAR1)
(CHAR2))
((OR (= INDEX1 END1)
(= INDEX2 END2)) (* return index if string1 shorter,
NIL if they're the same *)
(COND
((NOT (= SLEN1 SLEN2))
INDEX1)
(T NIL)))
(SETQ CHAR1 (CHAR STRING1 INDEX1))
(SETQ CHAR2 (CHAR STRING2 INDEX2))
(COND
[(NOT (CHAR-EQUAL CHAR1 CHAR2))
(COND
((CHAR-LESSP CHAR1 CHAR2)
(RETURN INDEX1))
(T (RETURN NIL]
(T NIL])
(STRING-GREATERP
[CL:LAMBDA (STRING1 STRING2 &KEY (START1 0)
END1
(START2 0)
END2) (* raf " 5-Dec-85 04:11")
(* Given two strings, if the first string is lexicographically greater than the second string, returns the longest
common prefix (using char-equal) of the two strings. Otherwise, returns NIL . *)
(WITH-TWO-STRINGS STRING1 STRING2 START1 END1 START2 END2
(LET ((SLEN1 (- END1 START1))
(SLEN2 (- END2 START2)))
(DECLARE (TYPE FIXNUM SLEN1 SLEN2))
(* prevent endless looping later.
*)
(COND
((OR (MINUSP SLEN1)
(MINUSP SLEN2))
(CL:ERROR "Improper bounds for string comparison."))
(T NIL))
(CL:DO ((INDEX1 START1 (1+ INDEX1))
(INDEX2 START2 (1+ INDEX2))
(CHAR1)
(CHAR2))
((OR (= INDEX1 END1)
(= INDEX2 END2))
(* return index if string1 shorter, NIL if they're the
same *)
(COND
((NOT (= SLEN1 SLEN2))
INDEX1)
(T NIL)))
(DECLARE (TYPE FIXNUM INDEX1 INDEX2))
(SETQ CHAR1 (CHAR STRING1 INDEX1))
(SETQ CHAR2 (CHAR STRING2 INDEX2))
(COND
[(NOT (CHAR-EQUAL CHAR1 CHAR2))
(COND
((CHAR-GREATERP CHAR1 CHAR2)
(RETURN INDEX1))
(T (RETURN NIL]
(T NIL])
(STRING-NOT-GREATERP
[CL:LAMBDA (STRING1 STRING2 &KEY (START1 0)
END1
(START2 0)
END2) (* raf " 5-Dec-85 04:12")
(* Given two strings, if the first string is lexicographically less than or equal to the second string, returns the
longest common prefix (using char-equal) of the two strings. Otherwise, returns NIL . *)
(WITH-TWO-STRINGS STRING1 STRING2 START1 END1 START2 END2
(LET ((SLEN1 (- END1 START1))
(SLEN2 (- END2 START2)))
(DECLARE (TYPE FIXNUM SLEN1 SLEN2))
(* prevent endless looping later.
*)
(COND
((OR (MINUSP SLEN1)
(MINUSP SLEN2))
(CL:ERROR "Improper bounds for string comparison."))
(T NIL))
(CL:DO ((INDEX1 START1 (1+ INDEX1))
(INDEX2 START2 (1+ INDEX2))
(CHAR1)
(CHAR2))
((OR (= INDEX1 END1)
(= INDEX2 END2))
(* return index if string1 shorter, NIL if they're the
same *)
INDEX1)
(DECLARE (TYPE FIXNUM INDEX1 INDEX2))
(SETQ CHAR1 (CHAR STRING1 INDEX1))
(SETQ CHAR2 (CHAR STRING2 INDEX2))
(COND
[(NOT (CHAR-EQUAL CHAR1 CHAR2))
(COND
((NOT (CHAR-GREATERP CHAR1 CHAR2))
(RETURN INDEX1))
(T (RETURN NIL]
(T NIL])
(STRING-NOT-LESSP
[CL:LAMBDA (STRING1 STRING2 &KEY (START1 0)
END1
(START2 0)
END2) (* raf " 5-Dec-85 04:12")
(* Given two strings, if the first string is lexicographically greater than or equal to the second string, returns
the longest common prefix (using char-equal) of the two strings. Otherwise, returns NIL . *)
(WITH-TWO-STRINGS STRING1 STRING2 START1 END1 START2 END2
(LET ((SLEN1 (- END1 START1))
(SLEN2 (- END2 START2)))
(DECLARE (TYPE FIXNUM SLEN1 SLEN2))
(* prevent endless looping later.
*)
(COND
((OR (MINUSP SLEN1)
(MINUSP SLEN2))
(CL:ERROR "Improper bounds for string comparison."))
(T NIL))
(CL:DO ((INDEX1 START1 (1+ INDEX1))
(INDEX2 START2 (1+ INDEX2))
(CHAR1)
(CHAR2))
((OR (= INDEX1 END1)
(= INDEX2 END2))
(* return index if string1 shorter, NIL if they're the
same *)
INDEX1)
(DECLARE (TYPE FIXNUM INDEX1 INDEX2))
(SETQ CHAR1 (CHAR STRING1 INDEX1))
(SETQ CHAR2 (CHAR STRING2 INDEX2))
(COND
[(NOT (CHAR-EQUAL CHAR1 CHAR2))
(COND
((NOT (CHAR-LESSP CHAR1 CHAR2))
(RETURN INDEX1))
(T (RETURN NIL]
(T NIL])
(STRING-NOT-EQUAL
[CL:LAMBDA (STRING1 STRING2 &KEY (START1 0)
END1
(START2 0)
END2) (* raf " 5-Dec-85 04:13")
(* Given two strings, if the first string is not lexicographically equal to the second string, returns the longest
common prefix (using char-equal) of the two strings. Otherwise, returns NIL . *)
(WITH-TWO-STRINGS STRING1 STRING2 START1 END1 START2 END2
(LET ((SLEN1 (- END1 START1))
(SLEN2 (- END2 START2)))
(DECLARE (TYPE FIXNUM SLEN1 SLEN2))
(* prevent endless looping later.
*)
(COND
((OR (MINUSP SLEN1)
(MINUSP SLEN2))
(CL:ERROR "Improper bounds for string comparison."))
(T NIL))
(COND
((OR (MINUSP SLEN1)
(OR (MINUSP SLEN2)))
(CL:ERROR "Improper substring for comparison."))
[(= SLEN1 SLEN2)
(CL:DO ((INDEX1 START1 (1+ INDEX1))
(INDEX2 START2 (1+ INDEX2)))
((= INDEX1 END1)
NIL)
(DECLARE (TYPE FIXNUM INDEX1 INDEX2))
(COND
((NOT (CHAR-EQUAL (CHAR STRING1 INDEX1)
(CHAR STRING2 INDEX2)))
(RETURN INDEX1))
(T NIL]
[(< SLEN1 SLEN2)
(CL:DO ((INDEX1 START1 (1+ INDEX1))
(INDEX2 START2 (1+ INDEX2)))
([OR (= INDEX1 END1)
(NOT (CHAR-EQUAL (CHAR STRING1 INDEX1)
(CHAR STRING2 INDEX2]
INDEX1)
(DECLARE (TYPE FIXNUM INDEX1 INDEX2]
(T (CL:DO ((INDEX1 START1 (1+ INDEX1))
(INDEX2 START2 (1+ INDEX2)))
([OR (= INDEX2 END2)
(NOT (CHAR-EQUAL (CHAR STRING1 INDEX1)
(CHAR STRING2 INDEX2]
INDEX1)
(DECLARE (TYPE FIXNUM INDEX1 INDEX2])
(MAKE-STRING
[CL:LAMBDA (SIZE &KEY INITIAL-ELEMENT) (* lmm " 5-Sep-85 02:36")
(ALLOCSTRING SIZE (AND INITIAL-ELEMENT (CHAR-INT INITIAL-ELEMENT])
(STRING-UPCASE
[CL:LAMBDA (STRING &KEY (START 0)
END) (* raf " 4-Dec-85 23:59")
(* Given a string, returns a new string that is a copy
of it with all lower case alphabetic characters
converted to uppercase. *)
(WITH-ONE-STRING STRING START END (FOR-SUBSTRING STRING START END NEWSTRING INDEX
(SETF (CHAR NEWSTRING INDEX)
(CHAR-UPCASE (CHAR STRING INDEX])
(STRING-DOWNCASE
[CL:LAMBDA (STRING &KEY (START 0)
END) (* raf " 4-Dec-85 23:59")
(* Given a string, returns a new string that is a copy
of it with all upper case alphabetic characters
converted to lowercase. *)
(WITH-ONE-STRING STRING START END (FOR-SUBSTRING STRING START END NEWSTRING INDEX
(SETF (CHAR NEWSTRING INDEX)
(CHAR-DOWNCASE (CHAR STRING INDEX])
(STRING-CAPITALIZE
[CL:LAMBDA (STRING &KEY (START 0)
END) (* raf " 4-Dec-85 23:59")
(* Given a string, returns a copy of the string with the first character of each ``word'' converted to upper-case,
and remaining chars in the word converted to lower case. A ``word'' is defined to be a string of case-modifiable
characters delimited by non-case-modifiable chars. *)
(WITH-ONE-STRING STRING START END (LET ((NEWWORD T)
CHAR)
(FOR-SUBSTRING STRING START END NEWSTRING INDEX
(SETQ CHAR (CHAR STRING INDEX))
[COND
((NOT (ALPHANUMERICP CHAR))
(SETQ NEWWORD T))
(NEWWORD
(* char is first case-modifiable after
non-case-modifiable *)
(SETQ CHAR (CHAR-UPCASE
CHAR))
(SETQ NEWWORD NIL))
(T
(* char is case-modifiable, but not first *)
(SETQ CHAR (CHAR-DOWNCASE CHAR]
(SETF (CHAR NEWSTRING INDEX)
CHAR])
(NSTRING-UPCASE
(CL:LAMBDA (STRING &KEY (START 0)
END) (* raf " 5-Dec-85 03:21")
(* Given a string, returns that string with all lower
case alphabetic characters converted to uppercase.
*)
(WITH-ONE-STRING STRING START END [for INDEX from START to (1- END)
do (SETF (CHAR STRING INDEX)
(CHAR-UPCASE (CHAR STRING INDEX]
STRING)))
(NSTRING-DOWNCASE
(CL:LAMBDA (STRING &KEY (START 0)
END) (* raf " 5-Dec-85 03:21")
(* Given a string, returns that string with all upper
case alphabetic characters converted to lowercase.
*)
(WITH-ONE-STRING STRING START END [for INDEX from START to (1- END)
do (SETF (CHAR STRING INDEX)
(CHAR-DOWNCASE (CHAR STRING INDEX]
STRING)))
(NSTRING-CAPITALIZE
(CL:LAMBDA (STRING &KEY (START 0)
END) (* raf " 5-Dec-85 03:22")
(* Given a string, returns that string with the first character of each ``word'' converted to upper-case, and
remaining chars in the word converted to lower case. A ``word'' is defined to be a string of case-modifiable
characters delimited by non-case-modifiable chars. *)
(WITH-ONE-STRING STRING START END (LET (CHAR (NEWWORD T))
(for INDEX from START to (1- END)
do (SETQ CHAR (CHAR STRING INDEX))
[COND
((NOT (ALPHANUMERICP CHAR))
(SETQ NEWWORD T))
(NEWWORD
(* char is first case-modifiable after
non-case-modifiable *)
(SETQ CHAR (CHAR-UPCASE CHAR))
(SETQ NEWWORD NIL))
(T (* char is case-modifiable, but not first *)
(SETQ CHAR (CHAR-DOWNCASE CHAR]
(SETF (CHAR STRING INDEX)
CHAR))
STRING))))
(STRING-LEFT-TRIM
[CL:LAMBDA (CHAR-BAG STRING) (* raf " 5-Dec-85 04:13")
(* Given a set of characters (a list or string) and a string, returns a copy of the string with the characters in
the set removed from the left end. *)
(WITH-STRING STRING (CL:DO ((INDEX START (1+ INDEX)))
((OR (= INDEX END)
(NOT (CL:FIND (CHAR STRING INDEX)
CHAR-BAG)))
(SUBSEQ (THE STRING STRING)
INDEX END))
(DECLARE (TYPE FIXNUM INDEX])
(STRING-RIGHT-TRIM
[CL:LAMBDA (CHAR-BAG STRING) (* raf " 5-Dec-85 04:13")
(* Given a set of characters (a list or string) and a string, returns a copy of the string with the characters in
the set removed from the right end. *)
(WITH-STRING STRING (CL:DO ((INDEX (1- END)
(1- INDEX)))
((OR (< INDEX START)
(NOT (CL:FIND (CHAR STRING INDEX)
CHAR-BAG)))
(SUBSEQ (THE STRING STRING)
START
(1+ INDEX)))
(DECLARE (TYPE FIXNUM INDEX])
(STRING-TRIM
[CL:LAMBDA (CHAR-BAG STRING) (* lmm "17-Jul-86 02:29")
(* Given a set of characters (a list or string) and a string, returns a copy of
the string with the characters in the set removed from both ends.
*)
(WITH-STRING STRING (LET ((LEFT-END)
(RIGHT-END))
(CL:DO ((INDEX START (1+ INDEX)))
((OR (= INDEX END)
(NOT (CL:FIND (CHAR STRING INDEX)
CHAR-BAG)))
(SETQ LEFT-END INDEX))
(DECLARE (TYPE FIXNUM INDEX)))
(CL:DO ((INDEX (1- END)
(1- INDEX)))
((OR (< INDEX LEFT-END)
(NOT (CL:FIND (CHAR STRING INDEX)
CHAR-BAG)))
(SETQ RIGHT-END INDEX))
(DECLARE (TYPE FIXNUM INDEX)))
(SUBSEQ (THE STRING STRING)
LEFT-END
(1+ RIGHT-END])
)
(PUTPROPS CMLSTRING FILETYPE COMPILE-FILE)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA
STRING-TRIM STRING-RIGHT-TRIM STRING-LEFT-TRIM NSTRING-CAPITALIZE NSTRING-DOWNCASE
NSTRING-UPCASE STRING-CAPITALIZE STRING-DOWNCASE STRING-UPCASE MAKE-STRING
STRING-NOT-EQUAL STRING-NOT-LESSP STRING-NOT-GREATERP STRING-GREATERP STRING-LESSP
STRING/= STRING= STRING>= STRING<= STRING> STRING< STRING>=* STRING<=* STRING>*
STRING<* STRING/=* STRING=* STRING-EQUAL STRING)
)
(PUTPROPS CMLSTRING COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (7207 35498 (STRING 7217 . 7904) (STRING-EQUAL 7906 . 8772) (\SP-STRING-COMPARE 8774 .
9354) (STRING=* 9356 . 9704) (STRING/=* 9706 . 9935) (STRING<* 9937 . 10476) (STRING>* 10478 . 11017)
(STRING<=* 11019 . 11574) (STRING>=* 11576 . 12131) (STRING< 12133 . 14065) (STRING> 14067 . 16005) (
STRING<= 16007 . 17448) (STRING>= 17450 . 17909) (STRING= 17911 . 18542) (STRING/= 18544 . 19275) (
STRING-LESSP 19277 . 21197) (STRING-GREATERP 21199 . 22839) (STRING-NOT-GREATERP 22841 . 24423) (
STRING-NOT-LESSP 24425 . 26005) (STRING-NOT-EQUAL 26007 . 28049) (MAKE-STRING 28051 . 28241) (
STRING-UPCASE 28243 . 28788) (STRING-DOWNCASE 28790 . 29339) (STRING-CAPITALIZE 29341 . 30579) (
NSTRING-UPCASE 30581 . 31122) (NSTRING-DOWNCASE 31124 . 31669) (NSTRING-CAPITALIZE 31671 . 32852) (
STRING-LEFT-TRIM 32854 . 33416) (STRING-RIGHT-TRIM 33418 . 34020) (STRING-TRIM 34022 . 35496)))))
STOP