/[cmucl]/src/code/string.lisp
ViewVC logotype

Diff of /src/code/string.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.21 by rtoy, Sun Oct 18 14:21:24 2009 UTC revision 1.22 by rtoy, Fri Mar 19 15:18:59 2010 UTC
# Line 16  Line 16 
16  ;;; ****************************************************************  ;;; ****************************************************************
17  ;;;  ;;;
18  (in-package "LISP")  (in-package "LISP")
19    (intl:textdomain "cmucl")
20    
21  (export '(char schar glyph sglyph string  (export '(char schar glyph sglyph string
22            string= string-equal string< string> string<= string>= string/=            string= string-equal string< string> string<= string>= string/=
23            string-lessp string-greaterp string-not-lessp string-not-greaterp            string-lessp string-greaterp string-not-lessp string-not-greaterp
# Line 33  Line 35 
35  (declaim (inline surrogatep surrogates-to-codepoint codepoint surrogates))  (declaim (inline surrogatep surrogates-to-codepoint codepoint surrogates))
36    
37  (defun surrogatep (char-or-code &optional surrogate-type)  (defun surrogatep (char-or-code &optional surrogate-type)
38    "Test if C is a surrogate.  C may be either an integer or a    _N"Test if C is a surrogate.  C may be either an integer or a
39    character. Surrogate-type indicates what kind of surrogate to test    character. Surrogate-type indicates what kind of surrogate to test
40    for.  :High means to test for the high (leading) surrogate; :Low    for.  :High means to test for the high (leading) surrogate; :Low
41    tests for the low (trailing surrogate).  A value of :Any or Nil    tests for the low (trailing surrogate).  A value of :Any or Nil
# Line 54  Line 56 
56         (= #b11011 (ash code -11))))))         (= #b11011 (ash code -11))))))
57    
58  (defun surrogates-to-codepoint (hi-surrogate-char lo-surrogate-char)  (defun surrogates-to-codepoint (hi-surrogate-char lo-surrogate-char)
59    "Convert the given Hi and Lo surrogate characters to the    _N"Convert the given Hi and Lo surrogate characters to the
60    corresponding codepoint value"    corresponding codepoint value"
61    (declare (type character hi-surrogate-char lo-surrogate-char))    (declare (type character hi-surrogate-char lo-surrogate-char))
62    (+ (ash (- (the (integer #xD800 #xDBFF) (char-code hi-surrogate-char)) #xD800) 10)    (+ (ash (- (the (integer #xD800 #xDBFF) (char-code hi-surrogate-char)) #xD800) 10)
63       (the (integer #xDC00 #xDFFF) (char-code lo-surrogate-char)) #x2400))       (the (integer #xDC00 #xDFFF) (char-code lo-surrogate-char)) #x2400))
64    
65  (defun codepoint (string i &optional (end (length string)))  (defun codepoint (string i &optional (end (length string)))
66    "Return the codepoint value from String at position I.  If that    _N"Return the codepoint value from String at position I.  If that
67    position is a surrogate, it is combined with either the previous or    position is a surrogate, it is combined with either the previous or
68    following character (when possible) to compute the codepoint.  The    following character (when possible) to compute the codepoint.  The
69    second return value is NIL if the position is not a surrogate pair.    second return value is NIL if the position is not a surrogate pair.
# Line 82  Line 84 
84            (t (values code nil)))))            (t (values code nil)))))
85    
86  (defun surrogates (codepoint)  (defun surrogates (codepoint)
87    "Return the high and low surrogate characters for Codepoint.  If    _N"Return the high and low surrogate characters for Codepoint.  If
88    Codepoint is in the BMP, the first return value is the corresponding    Codepoint is in the BMP, the first return value is the corresponding
89    character and the second is NIL."    character and the second is NIL."
90    (declare (type codepoint codepoint))    (declare (type codepoint codepoint))
# Line 94  Line 96 
96          (values (code-char hi) (code-char lo)))))          (values (code-char hi) (code-char lo)))))
97    
98  (defun (setf codepoint) (codepoint string i)  (defun (setf codepoint) (codepoint string i)
99    "Set the codepoint at string position I to the Codepoint.  If the    _N"Set the codepoint at string position I to the Codepoint.  If the
100    codepoint requires a surrogate pair, the high (leading surrogate) is    codepoint requires a surrogate pair, the high (leading surrogate) is
101    stored at position I and the low (trailing) surrogate is stored at    stored at position I and the low (trailing) surrogate is stored at
102    I+1"    I+1"
# Line 111  Line 113 
113    
114  #+unicode  #+unicode
115  (defun utf16-string-p (string)  (defun utf16-string-p (string)
116    "Check if String is a valid UTF-16 string.  If the string is valid,    _N"Check if String is a valid UTF-16 string.  If the string is valid,
117    T is returned.  If the string is not valid, NIL is returned, and the    T is returned.  If the string is not valid, NIL is returned, and the
118    second value is the index into the string of the invalid character.    second value is the index into the string of the invalid character.
119    A string is also invalid if it contains any unassigned codepoints."    A string is also invalid if it contains any unassigned codepoints."
# Line 134  Line 136 
136        (when wide (incf index)))))        (when wide (incf index)))))
137    
138  (defun string (X)  (defun string (X)
139    "Coerces X into a string.  If X is a string, X is returned.  If X is a    _N"Coerces X into a string.  If X is a string, X is returned.  If X is a
140    symbol, X's pname is returned.  If X is a character then a one element    symbol, X's pname is returned.  If X is a character then a one element
141    string containing that character is returned.  If X cannot be coerced    string containing that character is returned.  If X cannot be coerced
142    into a string, an error occurs."    into a string, an error occurs."
# Line 147  Line 149 
149           (error 'simple-type-error           (error 'simple-type-error
150                  :datum x                  :datum x
151                  :expected-type '(or string symbol character)                  :expected-type '(or string symbol character)
152                  :format-control "~S cannot be coerced to a string."                  :format-control _"~S cannot be coerced to a string."
153                  :format-arguments (list x)))))                  :format-arguments (list x)))))
154    
155  ;;; With-One-String is used to set up some string hacking things.  The keywords  ;;; With-One-String is used to set up some string hacking things.  The keywords
# Line 200  Line 202 
202    
203    
204  (defun char (string index)  (defun char (string index)
205    "Given a string and a non-negative integer index less than the length of    _N"Given a string and a non-negative integer index less than the length of
206    the string, returns the character object representing the character at    the string, returns the character object representing the character at
207    that position in the string."    that position in the string."
208    (declare (optimize (safety 1)))    (declare (optimize (safety 1)))
# Line 211  Line 213 
213    (setf (char string index) new-el))    (setf (char string index) new-el))
214    
215  (defun schar (string index)  (defun schar (string index)
216    "SCHAR returns the character object at an indexed position in a string    _N"SCHAR returns the character object at an indexed position in a string
217    just as CHAR does, except the string must be a simple-string."    just as CHAR does, except the string must be a simple-string."
218    (declare (optimize (safety 1)))    (declare (optimize (safety 1)))
219    (schar string index))    (schar string index))
# Line 303  Line 305 
305    
306    
307  (defun string< (string1 string2 &key (start1 0) end1 (start2 0) end2)  (defun string< (string1 string2 &key (start1 0) end1 (start2 0) end2)
308    "Given two strings, if the first string is lexicographically less than    _N"Given two strings, if the first string is lexicographically less than
309    the second string, returns the longest common prefix (using char=)    the second string, returns the longest common prefix (using char=)
310    of the two strings. Otherwise, returns ()."    of the two strings. Otherwise, returns ()."
311    (string<* string1 string2 start1 end1 start2 end2))    (string<* string1 string2 start1 end1 start2 end2))
312    
313  (defun string> (string1 string2 &key (start1 0) end1 (start2 0) end2)  (defun string> (string1 string2 &key (start1 0) end1 (start2 0) end2)
314    "Given two strings, if the first string is lexicographically greater than    _N"Given two strings, if the first string is lexicographically greater than
315    the second string, returns the longest common prefix (using char=)    the second string, returns the longest common prefix (using char=)
316    of the two strings. Otherwise, returns ()."    of the two strings. Otherwise, returns ()."
317    (string>* string1 string2 start1 end1 start2 end2))    (string>* string1 string2 start1 end1 start2 end2))
318    
319    
320  (defun string<= (string1 string2 &key (start1 0) end1 (start2 0) end2)  (defun string<= (string1 string2 &key (start1 0) end1 (start2 0) end2)
321    "Given two strings, if the first string is lexicographically less than    _N"Given two strings, if the first string is lexicographically less than
322    or equal to the second string, returns the longest common prefix    or equal to the second string, returns the longest common prefix
323    (using char=) of the two strings. Otherwise, returns ()."    (using char=) of the two strings. Otherwise, returns ()."
324    (string<=* string1 string2 start1 end1 start2 end2))    (string<=* string1 string2 start1 end1 start2 end2))
325    
326  (defun string>= (string1 string2 &key (start1 0) end1 (start2 0) end2)  (defun string>= (string1 string2 &key (start1 0) end1 (start2 0) end2)
327    "Given two strings, if the first string is lexicographically greater    _N"Given two strings, if the first string is lexicographically greater
328    than or equal to the second string, returns the longest common prefix    than or equal to the second string, returns the longest common prefix
329    (using char=) of the two strings. Otherwise, returns ()."    (using char=) of the two strings. Otherwise, returns ()."
330    (string>=* string1 string2 start1 end1 start2 end2))    (string>=* string1 string2 start1 end1 start2 end2))
331    
332  (defun string= (string1 string2 &key (start1 0) end1 (start2 0) end2)  (defun string= (string1 string2 &key (start1 0) end1 (start2 0) end2)
333    "Given two strings (string1 and string2), and optional integers start1,    _N"Given two strings (string1 and string2), and optional integers start1,
334    start2, end1 and end2, compares characters in string1 to characters in    start2, end1 and end2, compares characters in string1 to characters in
335    string2 (using char=)."    string2 (using char=)."
336    (string=* string1 string2 start1 end1 start2 end2))    (string=* string1 string2 start1 end1 start2 end2))
337    
338  (defun string/= (string1 string2 &key (start1 0) end1 (start2 0) end2)  (defun string/= (string1 string2 &key (start1 0) end1 (start2 0) end2)
339    "Given two strings, if the first string is not lexicographically equal    _N"Given two strings, if the first string is not lexicographically equal
340    to the second string, returns the longest common prefix (using char=)    to the second string, returns the longest common prefix (using char=)
341    of the two strings. Otherwise, returns ()."    of the two strings. Otherwise, returns ()."
342    (string/=* string1 string2 start1 end1 start2 end2))    (string/=* string1 string2 start1 end1 start2 end2))
# Line 367  Line 369 
369    
370  #+unicode  #+unicode
371  (defun string-case-fold (string &key (start 0) end (casing :simple))  (defun string-case-fold (string &key (start 0) end (casing :simple))
372    "Return a new string with the case folded according to Casing as follows:    _N"Return a new string with the case folded according to Casing as follows:
373    
374    :SIMPLE  Unicode simple case folding (preserving length)    :SIMPLE  Unicode simple case folding (preserving length)
375    :FULL    Unicode full case folding (possibly changing length)    :FULL    Unicode full case folding (possibly changing length)
# Line 397  Line 399 
399               (write-string (unicode-case-fold-full code) s))))))))               (write-string (unicode-case-fold-full code) s))))))))
400    
401  (defun string-equal (string1 string2 &key (start1 0) end1 (start2 0) end2)  (defun string-equal (string1 string2 &key (start1 0) end1 (start2 0) end2)
402    "Given two strings (string1 and string2), and optional integers start1,    _N"Given two strings (string1 and string2), and optional integers start1,
403    start2, end1 and end2, compares characters in string1 to characters in    start2, end1 and end2, compares characters in string1 to characters in
404    string2 (using char-equal)."    string2 (using char-equal)."
405    (declare (fixnum start1 start2))    (declare (fixnum start1 start2))
# Line 407  Line 409 
409        (declare (fixnum slen1 slen2))        (declare (fixnum slen1 slen2))
410        (if (or (minusp slen1) (minusp slen2))        (if (or (minusp slen1) (minusp slen2))
411            ;;prevent endless looping later.            ;;prevent endless looping later.
412            (error "Improper bounds for string comparison."))            (error _"Improper bounds for string comparison."))
413        (if (= slen1 slen2)        (if (= slen1 slen2)
414            ;;return () immediately if lengths aren't equal.            ;;return () immediately if lengths aren't equal.
415            (string-not-equal-loop 1 t nil)))))            (string-not-equal-loop 1 t nil)))))
416    
417  (defun string-not-equal (string1 string2 &key (start1 0) end1 (start2 0) end2)  (defun string-not-equal (string1 string2 &key (start1 0) end1 (start2 0) end2)
418    "Given two strings, if the first string is not lexicographically equal    _N"Given two strings, if the first string is not lexicographically equal
419    to the second string, returns the longest common prefix (using char-equal)    to the second string, returns the longest common prefix (using char-equal)
420    of the two strings. Otherwise, returns ()."    of the two strings. Otherwise, returns ()."
421    (with-two-strings string1 string2 start1 end1 offset1 start2 end2    (with-two-strings string1 string2 start1 end1 offset1 start2 end2
# Line 422  Line 424 
424        (declare (fixnum slen1 slen2))        (declare (fixnum slen1 slen2))
425        (if (or (minusp slen1) (minusp slen2))        (if (or (minusp slen1) (minusp slen2))
426            ;;prevent endless looping later.            ;;prevent endless looping later.
427            (error "Improper bounds for string comparison."))            (error _"Improper bounds for string comparison."))
428        (cond ((or (minusp slen1) (or (minusp slen2)))        (cond ((or (minusp slen1) (or (minusp slen2)))
429               (error "Improper substring for comparison."))               (error _"Improper substring for comparison."))
430              ((= slen1 slen2)              ((= slen1 slen2)
431               (string-not-equal-loop 1 nil (- index1 offset1)))               (string-not-equal-loop 1 nil (- index1 offset1)))
432              ((< slen1 slen2)              ((< slen1 slen2)
# Line 470  Line 472 
472           (declare (fixnum slen1 slen2))           (declare (fixnum slen1 slen2))
473           (if (or (minusp slen1) (minusp slen2))           (if (or (minusp slen1) (minusp slen2))
474               ;;prevent endless looping later.               ;;prevent endless looping later.
475               (error "Improper bounds for string comparison."))               (error _"Improper bounds for string comparison."))
476           (do ((index1 start1 (1+ index1))           (do ((index1 start1 (1+ index1))
477                (index2 start2 (1+ index2))                (index2 start2 (1+ index2))
478                (char1)                (char1)
# Line 509  Line 511 
511           (declare (fixnum slen1 slen2))           (declare (fixnum slen1 slen2))
512           (if (or (minusp slen1) (minusp slen2))           (if (or (minusp slen1) (minusp slen2))
513               ;;prevent endless looping later.               ;;prevent endless looping later.
514               (error "Improper bounds for string comparison."))               (error _"Improper bounds for string comparison."))
515           (do ((index1 start1 (1+ index1))           (do ((index1 start1 (1+ index1))
516                (index2 start2 (1+ index2)))                (index2 start2 (1+ index2)))
517               ((or (= index1 (the fixnum end1)) (= index2 (the fixnum end2)))               ((or (= index1 (the fixnum end1)) (= index2 (the fixnum end2)))
# Line 550  Line 552 
552    (string-less-greater-equal t t))    (string-less-greater-equal t t))
553    
554  (defun string-lessp (string1 string2 &key (start1 0) end1 (start2 0) end2)  (defun string-lessp (string1 string2 &key (start1 0) end1 (start2 0) end2)
555    "Given two strings, if the first string is lexicographically less than    _N"Given two strings, if the first string is lexicographically less than
556    the second string, returns the longest common prefix (using char-equal)    the second string, returns the longest common prefix (using char-equal)
557    of the two strings. Otherwise, returns ()."    of the two strings. Otherwise, returns ()."
558    (string-lessp* string1 string2 start1 end1 start2 end2))    (string-lessp* string1 string2 start1 end1 start2 end2))
559    
560  (defun string-greaterp (string1 string2 &key (start1 0) end1 (start2 0) end2)  (defun string-greaterp (string1 string2 &key (start1 0) end1 (start2 0) end2)
561    "Given two strings, if the first string is lexicographically greater than    _N"Given two strings, if the first string is lexicographically greater than
562    the second string, returns the longest common prefix (using char-equal)    the second string, returns the longest common prefix (using char-equal)
563    of the two strings. Otherwise, returns ()."    of the two strings. Otherwise, returns ()."
564    (string-greaterp* string1 string2 start1 end1 start2 end2))    (string-greaterp* string1 string2 start1 end1 start2 end2))
565    
566  (defun string-not-lessp (string1 string2 &key (start1 0) end1 (start2 0) end2)  (defun string-not-lessp (string1 string2 &key (start1 0) end1 (start2 0) end2)
567    "Given two strings, if the first string is lexicographically greater    _N"Given two strings, if the first string is lexicographically greater
568    than or equal to the second string, returns the longest common prefix    than or equal to the second string, returns the longest common prefix
569    (using char-equal) of the two strings. Otherwise, returns ()."    (using char-equal) of the two strings. Otherwise, returns ()."
570    (string-not-lessp* string1 string2 start1 end1 start2 end2))    (string-not-lessp* string1 string2 start1 end1 start2 end2))
571    
572  (defun string-not-greaterp (string1 string2 &key (start1 0) end1 (start2 0)  (defun string-not-greaterp (string1 string2 &key (start1 0) end1 (start2 0)
573                                      end2)                                      end2)
574    "Given two strings, if the first string is lexicographically less than    _N"Given two strings, if the first string is lexicographically less than
575    or equal to the second string, returns the longest common prefix    or equal to the second string, returns the longest common prefix
576    (using char-equal) of the two strings. Otherwise, returns ()."    (using char-equal) of the two strings. Otherwise, returns ()."
577    (string-not-greaterp* string1 string2 start1 end1 start2 end2))    (string-not-greaterp* string1 string2 start1 end1 start2 end2))
578    
579    
580  (defun make-string (count &key element-type ((:initial-element fill-char)))  (defun make-string (count &key element-type ((:initial-element fill-char)))
581    "Given a character count and an optional fill character, makes and returns    _N"Given a character count and an optional fill character, makes and returns
582    a new string Count long filled with the fill character."    a new string Count long filled with the fill character."
583    (declare (type fixnum count))    (declare (type fixnum count))
584    (assert (subtypep element-type 'character))    (assert (subtypep element-type 'character))
# Line 661  Line 663 
663    
664  (defun string-upcase (string &key (start 0) end #+unicode (casing :simple))  (defun string-upcase (string &key (start 0) end #+unicode (casing :simple))
665    #-unicode    #-unicode
666    "Given a string, returns a new string that is a copy of it with all    _N"Given a string, returns a new string that is a copy of it with all
667    lower case alphabetic characters converted to uppercase."    lower case alphabetic characters converted to uppercase."
668    #+unicode    #+unicode
669    "Given a string, returns a new string that is a copy of it with all    _N"Given a string, returns a new string that is a copy of it with all
670    lower case alphabetic characters converted to uppercase.  Casing is    lower case alphabetic characters converted to uppercase.  Casing is
671    :simple or :full for simple or full case conversion, respectively."    :simple or :full for simple or full case conversion, respectively."
672    (declare (fixnum start))    (declare (fixnum start))
# Line 747  Line 749 
749    
750  (defun string-downcase (string &key (start 0) end #+unicode (casing :simple))  (defun string-downcase (string &key (start 0) end #+unicode (casing :simple))
751    #-unicode    #-unicode
752    "Given a string, returns a new string that is a copy of it with all    _N"Given a string, returns a new string that is a copy of it with all
753    upper case alphabetic characters converted to lowercase."    upper case alphabetic characters converted to lowercase."
754    #+unicode    #+unicode
755    "Given a string, returns a new string that is a copy of it with all    _N"Given a string, returns a new string that is a copy of it with all
756    upper case alphabetic characters converted to lowercase.  Casing is    upper case alphabetic characters converted to lowercase.  Casing is
757    :simple or :full for simple or full case conversion, respectively."    :simple or :full for simple or full case conversion, respectively."
758    (declare (fixnum start))    (declare (fixnum start))
# Line 841  Line 843 
843                                   #+unicode (casing :simple)                                   #+unicode (casing :simple)
844                                   #+unicode unicode-word-break)                                   #+unicode unicode-word-break)
845    #-unicode    #-unicode
846    "Given a string, returns a copy of the string with the first    _N"Given a string, returns a copy of the string with the first
847    character of each ``word'' converted to upper-case, and remaining    character of each ``word'' converted to upper-case, and remaining
848    chars in the word converted to lower case. A ``word'' is defined    chars in the word converted to lower case. A ``word'' is defined
849    to be a string of case-modifiable characters delimited by    to be a string of case-modifiable characters delimited by
850    non-case-modifiable chars."    non-case-modifiable chars."
851    #+unicode    #+unicode
852    "Given a string, returns a copy of the string with the first    _N"Given a string, returns a copy of the string with the first
853    character of each ``word'' converted to upper-case, and remaining    character of each ``word'' converted to upper-case, and remaining
854    chars in the word converted to lower case. A ``word'' is defined    chars in the word converted to lower case. A ``word'' is defined
855    to be a string of case-modifiable characters delimited by    to be a string of case-modifiable characters delimited by
# Line 865  Line 867 
867            (string-capitalize-full string :start start :end end))))            (string-capitalize-full string :start start :end end))))
868    
869  (defun nstring-upcase (string &key (start 0) end)  (defun nstring-upcase (string &key (start 0) end)
870    "Given a string, returns that string with all lower case alphabetic    _N"Given a string, returns that string with all lower case alphabetic
871    characters converted to uppercase."    characters converted to uppercase."
872    (declare (fixnum start))    (declare (fixnum start))
873    (let ((save-header string))    (let ((save-header string))
# Line 892  Line 894 
894      save-header))      save-header))
895    
896  (defun nstring-downcase (string &key (start 0) end)  (defun nstring-downcase (string &key (start 0) end)
897    "Given a string, returns that string with all upper case alphabetic    _N"Given a string, returns that string with all upper case alphabetic
898    characters converted to lowercase."    characters converted to lowercase."
899    (declare (fixnum start))    (declare (fixnum start))
900    (let ((save-header string))    (let ((save-header string))
# Line 917  Line 919 
919      save-header))      save-header))
920    
921  (defun nstring-capitalize (string &key (start 0) end)  (defun nstring-capitalize (string &key (start 0) end)
922    "Given a string, returns that string with the first    _N"Given a string, returns that string with the first
923    character of each ``word'' converted to upper-case, and remaining    character of each ``word'' converted to upper-case, and remaining
924    chars in the word converted to lower case. A ``word'' is defined    chars in the word converted to lower case. A ``word'' is defined
925    to be a string of case-modifiable characters delimited by    to be a string of case-modifiable characters delimited by
# Line 984  Line 986 
986              (when widep (incf index)))))))              (when widep (incf index)))))))
987    
988  (defun string-left-trim (char-bag string)  (defun string-left-trim (char-bag string)
989    "Given a set of characters (a list or string) and a string, returns    _N"Given a set of characters (a list or string) and a string, returns
990    a copy of the string with the characters in the set removed from the    a copy of the string with the characters in the set removed from the
991    left end.  If the set of characters is a string, surrogates will be    left end.  If the set of characters is a string, surrogates will be
992    properly handled."    properly handled."
# Line 1032  Line 1034 
1034              (when widep (decf index)))))))              (when widep (decf index)))))))
1035    
1036  (defun string-right-trim (char-bag string)  (defun string-right-trim (char-bag string)
1037    "Given a set of characters (a list or string) and a string, returns    _N"Given a set of characters (a list or string) and a string, returns
1038    a copy of the string with the characters in the set removed from the    a copy of the string with the characters in the set removed from the
1039    right end.  If the set of characters is a string, surrogates will be    right end.  If the set of characters is a string, surrogates will be
1040    properly handled."    properly handled."
# Line 1042  Line 1044 
1044        (subseq string start stop))))        (subseq string start stop))))
1045    
1046  (defun string-trim (char-bag string)  (defun string-trim (char-bag string)
1047    "Given a set of characters (a list or string) and a string, returns a    _N"Given a set of characters (a list or string) and a string, returns a
1048    copy of the string with the characters in the set removed from both    copy of the string with the characters in the set removed from both
1049    ends.  If the set of characters is a string, surrogates will be    ends.  If the set of characters is a string, surrogates will be
1050    properly handled."    properly handled."
# Line 1056  Line 1058 
1058  #-unicode  #-unicode
1059  (progn  (progn
1060  (defun string-left-trim (char-bag string)  (defun string-left-trim (char-bag string)
1061    "Given a set of characters (a list or string) and a string, returns    _N"Given a set of characters (a list or string) and a string, returns
1062    a copy of the string with the characters in the set removed from the    a copy of the string with the characters in the set removed from the
1063    left end."    left end."
1064    (with-string string    (with-string string
# Line 1067  Line 1069 
1069        (declare (fixnum index)))))        (declare (fixnum index)))))
1070    
1071  (defun string-right-trim (char-bag string)  (defun string-right-trim (char-bag string)
1072    "Given a set of characters (a list or string) and a string, returns    _N"Given a set of characters (a list or string) and a string, returns
1073    a copy of the string with the characters in the set removed from the    a copy of the string with the characters in the set removed from the
1074    right end."    right end."
1075    (with-string string    (with-string string
# Line 1077  Line 1079 
1079        (declare (fixnum index)))))        (declare (fixnum index)))))
1080    
1081  (defun string-trim (char-bag string)  (defun string-trim (char-bag string)
1082    "Given a set of characters (a list or string) and a string, returns a    _N"Given a set of characters (a list or string) and a string, returns a
1083    copy of the string with the characters in the set removed from both    copy of the string with the characters in the set removed from both
1084    ends."    ends."
1085    (with-string string    (with-string string
# Line 1131  Line 1133 
1133  ) ; unicode  ) ; unicode
1134    
1135  (defun glyph (string index &key (from-end nil))  (defun glyph (string index &key (from-end nil))
1136    "GLYPH returns the glyph at the indexed position in a string, and the    _N"GLYPH returns the glyph at the indexed position in a string, and the
1137    position of the next glyph (or NIL) as a second value.  A glyph is    position of the next glyph (or NIL) as a second value.  A glyph is
1138    a substring consisting of the character at INDEX followed by all    a substring consisting of the character at INDEX followed by all
1139    subsequent combining characters."    subsequent combining characters."
# Line 1147  Line 1149 
1149            (values (subseq string index n) (and (< n (length string)) n))))))            (values (subseq string index n) (and (< n (length string)) n))))))
1150    
1151  (defun sglyph (string index &key (from-end nil))  (defun sglyph (string index &key (from-end nil))
1152    "SGLYPH returns the glyph at the indexed position, the same as GLYPH,    _N"SGLYPH returns the glyph at the indexed position, the same as GLYPH,
1153    except that the string must be a simple-string"    except that the string must be a simple-string"
1154    (declare (type simple-string string) (type kernel:index index))    (declare (type simple-string string) (type kernel:index index))
1155    #-unicode    #-unicode
# Line 1336  Line 1338 
1338          (shrink-vector target comp-pos)))))          (shrink-vector target comp-pos)))))
1339    
1340  (defun string-to-nfd (string)  (defun string-to-nfd (string)
1341    "Convert String to Unicode Normalization Form D (NFD) using the    _N"Convert String to Unicode Normalization Form D (NFD) using the
1342    canonical decomposition.  The NFD string is returned"    canonical decomposition.  The NFD string is returned"
1343    (decompose string nil))    (decompose string nil))
1344    
1345  (defun string-to-nfkd (string)  (defun string-to-nfkd (string)
1346    "Convert String to Unicode Normalization Form KD (NFKD) uisng the    _N"Convert String to Unicode Normalization Form KD (NFKD) uisng the
1347    compatible decomposition form.  The NFKD string is returned."    compatible decomposition form.  The NFKD string is returned."
1348    (decompose string t))    (decompose string t))
1349    
1350  (defun string-to-nfc (string)  (defun string-to-nfc (string)
1351    "Convert String to Unicode Normalization Form C (NFC).  If the    _N"Convert String to Unicode Normalization Form C (NFC).  If the
1352    string a simple string and is already normalized, the original    string a simple string and is already normalized, the original
1353    string is returned."    string is returned."
1354    (if (normalized-form-p string :nfc)    (if (normalized-form-p string :nfc)
# Line 1357  Line 1359 
1359                'simple-string)))                'simple-string)))
1360    
1361  (defun string-to-nfkc (string)  (defun string-to-nfkc (string)
1362    "Convert String to Unicode Normalization Form KC (NFKC).  If the    _N"Convert String to Unicode Normalization Form KC (NFKC).  If the
1363    string is a simple string and is already normalized, the original    string is a simple string and is already normalized, the original
1364    string is returned."    string is returned."
1365    (if (normalized-form-p string :nfkc)    (if (normalized-form-p string :nfkc)

Legend:
Removed from v.1.21  
changed lines
  Added in v.1.22

  ViewVC Help
Powered by ViewVC 1.1.5