(FILECREATED " 5-Dec-85 04:17:27" {ERIS}<LISPCORE>LIBRARY>CMLSTRING.;11 27040
changes to: (FNS STRING-LESSP STRING-GREATERP STRING-NOT-GREATERP STRING-NOT-LESSP
STRING-NOT-EQUAL STRING-LEFT-TRIM STRING-RIGHT-TRIM STRING-TRIM
\SP-STRING-COMPARE NSTRING-UPCASE NSTRING-DOWNCASE NSTRING-CAPITALIZE STRING>
STRING<= STRING>= STRING/= STRING<* STRING>* STRING<=* STRING>=*
STRING-UPCASE STRING-DOWNCASE STRING-CAPITALIZE)
(MACROS FOR-SUBSTRING WITH-ONE-STRING WITH-STRING WITH-TWO-STRINGS STRING<>=*-BODY)
(VARS CMLKBRSTRINGCOMS)
previous date: " 5-Dec-85 00:35:05" {ERIS}<LISPCORE>LIBRARY>CMLSTRING.;7)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT CMLSTRINGCOMS)
(RPAQQ CMLSTRINGCOMS [(MACROS FOR-SUBSTRING \STRING WITH-ONE-STRING WITH-STRING WITH-TWO-STRINGS
STRING<>=*-BODY)
(FNS STRING \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)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML)
(LAMA 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<])
(DECLARE: EVAL@COMPILE
[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
[LAMBDA (X) (* kbr: " 4-Oct-85 11:14")
(* 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. *)
(COND
((STRINGP X)
X)
((SYMBOLP X)
(SYMBOL-NAME X))
((CHARACTERP X)
(ALLOCSTRING 1 (CHAR-INT X)))
(T (CL:ERROR "~S cannot be coerced to a string." X])
(\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)
(WITH-TWO-STRINGS STRING1 STRING2 START1 END1 START2 END2
(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) (* kbr: " 4-Oct-85 11:30")
(* Given two strings, if the first string is lexicographically less than 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) (* kbr: " 4-Oct-85 11:30")
(* Given two strings, if the first string is lexicographically greater than 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) (* kbr: " 4-Oct-85 11:31")
(* Given two strings, if the first string is lexicographically less 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) (* 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) (* kbr: " 4-Oct-85 10:54")
(* Given two strings (string1 and string2), and optional integers start1, start2, end1 and end2, compares
characters in string1 to characters in string2 (using char=) . *)
(STRING=* STRING1 STRING2 START1 END1 START2 END2)))
(STRING/=
(CL:LAMBDA (STRING1 STRING2 &KEY (START1 0)
END1
(START2 0)
END2) (* kbr: " 4-Oct-85 11:32")
(* Given two strings, if the first string is not lexicographically 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-LESSP
[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 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)))
(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-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) (* 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 both ends. *)
(WITH-STRING STRING (LET ((LEFT-END)
(RIGHT-END))
(DECLARE (TYPE FIXNUM 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])
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA 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<)
)
(PUTPROPS CMLSTRING COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4595 26557 (STRING 4605 . 5199) (\SP-STRING-COMPARE 5201 . 5781) (STRING=* 5783 . 5996)
(STRING/=* 5998 . 6227) (STRING<* 6229 . 6768) (STRING>* 6770 . 7309) (STRING<=* 7311 . 7866) (
STRING>=* 7868 . 8423) (STRING< 8425 . 8867) (STRING> 8869 . 9314) (STRING<= 9316 . 9771) (STRING>=
9773 . 10232) (STRING= 10234 . 10660) (STRING/= 10662 . 11109) (STRING-LESSP 11111 . 12742) (
STRING-GREATERP 12744 . 14384) (STRING-NOT-GREATERP 14386 . 15968) (STRING-NOT-LESSP 15970 . 17550) (
STRING-NOT-EQUAL 17552 . 19594) (MAKE-STRING 19596 . 19786) (STRING-UPCASE 19788 . 20333) (
STRING-DOWNCASE 20335 . 20884) (STRING-CAPITALIZE 20886 . 22124) (NSTRING-UPCASE 22126 . 22667) (
NSTRING-DOWNCASE 22669 . 23214) (NSTRING-CAPITALIZE 23216 . 24397) (STRING-LEFT-TRIM 24399 . 24961) (
STRING-RIGHT-TRIM 24963 . 25565) (STRING-TRIM 25567 . 26555)))))
STOP