1 | ;;; strings.lisp |
---|
2 | ;;; |
---|
3 | ;;; Copyright (C) 2003-2004 Peter Graves |
---|
4 | ;;; $Id: strings.lisp,v 1.7 2004-08-15 11:25:36 piso Exp $ |
---|
5 | ;;; |
---|
6 | ;;; This program is free software; you can redistribute it and/or |
---|
7 | ;;; modify it under the terms of the GNU General Public License |
---|
8 | ;;; as published by the Free Software Foundation; either version 2 |
---|
9 | ;;; of the License, or (at your option) any later version. |
---|
10 | ;;; |
---|
11 | ;;; This program is distributed in the hope that it will be useful, |
---|
12 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
---|
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
---|
14 | ;;; GNU General Public License for more details. |
---|
15 | ;;; |
---|
16 | ;;; You should have received a copy of the GNU General Public License |
---|
17 | ;;; along with this program; if not, write to the Free Software |
---|
18 | ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
---|
19 | |
---|
20 | (in-package "SYSTEM") |
---|
21 | |
---|
22 | (defun string-upcase (string &key (start 0) end) |
---|
23 | (%string-upcase string start end)) |
---|
24 | |
---|
25 | (defun string-downcase (string &key (start 0) end) |
---|
26 | (%string-downcase string start end)) |
---|
27 | |
---|
28 | (defun string-capitalize (string &key (start 0) end) |
---|
29 | (%string-capitalize string start end)) |
---|
30 | |
---|
31 | (defun nstring-upcase (string &key (start 0) end) |
---|
32 | (%nstring-upcase string start end)) |
---|
33 | |
---|
34 | (defun nstring-downcase (string &key (start 0) end) |
---|
35 | (%nstring-downcase string start end)) |
---|
36 | |
---|
37 | (defun nstring-capitalize (string &key (start 0) end) |
---|
38 | (%nstring-capitalize string start end)) |
---|
39 | |
---|
40 | (defun string= (string1 string2 &key (start1 0) end1 (start2 0) end2) |
---|
41 | (%string= string1 string2 start1 end1 start2 end2)) |
---|
42 | |
---|
43 | (defun string/= (string1 string2 &key (start1 0) end1 (start2 0) end2) |
---|
44 | (let* ((string1 (string string1)) |
---|
45 | (string2 (string string2)) |
---|
46 | (end1 (or end1 (length string1))) |
---|
47 | (end2 (or end2 (length string2)))) |
---|
48 | (%string/= string1 string2 start1 end1 start2 end2))) |
---|
49 | |
---|
50 | (defun string-equal (string1 string2 &key (start1 0) end1 (start2 0) end2) |
---|
51 | (let* ((string1 (string string1)) |
---|
52 | (string2 (string string2)) |
---|
53 | (end1 (or end1 (length string1))) |
---|
54 | (end2 (or end2 (length string2)))) |
---|
55 | (%string-equal string1 string2 start1 end1 start2 end2))) |
---|
56 | |
---|
57 | (defun string-not-equal (string1 string2 &key (start1 0) end1 (start2 0) end2) |
---|
58 | (let* ((string1 (string string1)) |
---|
59 | (string2 (string string2)) |
---|
60 | (end1 (or end1 (length string1))) |
---|
61 | (end2 (or end2 (length string2)))) |
---|
62 | (%string-not-equal string1 string2 start1 end1 start2 end2))) |
---|
63 | |
---|
64 | (defun string< (string1 string2 &key (start1 0) end1 (start2 0) end2) |
---|
65 | (let* ((string1 (string string1)) |
---|
66 | (string2 (string string2)) |
---|
67 | (end1 (or end1 (length string1))) |
---|
68 | (end2 (or end2 (length string2)))) |
---|
69 | (%string< string1 string2 start1 end1 start2 end2))) |
---|
70 | |
---|
71 | (defun string> (string1 string2 &key (start1 0) end1 (start2 0) end2) |
---|
72 | (let* ((string1 (string string1)) |
---|
73 | (string2 (string string2)) |
---|
74 | (end1 (or end1 (length string1))) |
---|
75 | (end2 (or end2 (length string2)))) |
---|
76 | (%string> string1 string2 start1 end1 start2 end2))) |
---|
77 | |
---|
78 | (defun string<= (string1 string2 &key (start1 0) end1 (start2 0) end2) |
---|
79 | (let* ((string1 (string string1)) |
---|
80 | (string2 (string string2)) |
---|
81 | (end1 (or end1 (length string1))) |
---|
82 | (end2 (or end2 (length string2)))) |
---|
83 | (%string<= string1 string2 start1 end1 start2 end2))) |
---|
84 | |
---|
85 | (defun string>= (string1 string2 &key (start1 0) end1 (start2 0) end2) |
---|
86 | (let* ((string1 (string string1)) |
---|
87 | (string2 (string string2)) |
---|
88 | (end1 (or end1 (length string1))) |
---|
89 | (end2 (or end2 (length string2)))) |
---|
90 | (%string>= string1 string2 start1 end1 start2 end2))) |
---|
91 | |
---|
92 | (defun string-lessp (string1 string2 &key (start1 0) end1 (start2 0) end2) |
---|
93 | (let* ((string1 (string string1)) |
---|
94 | (string2 (string string2)) |
---|
95 | (end1 (or end1 (length string1))) |
---|
96 | (end2 (or end2 (length string2)))) |
---|
97 | (%string-lessp string1 string2 start1 end1 start2 end2))) |
---|
98 | |
---|
99 | (defun string-greaterp (string1 string2 &key (start1 0) end1 (start2 0) end2) |
---|
100 | (let* ((string1 (string string1)) |
---|
101 | (string2 (string string2)) |
---|
102 | (end1 (or end1 (length string1))) |
---|
103 | (end2 (or end2 (length string2)))) |
---|
104 | (%string-greaterp string1 string2 start1 end1 start2 end2))) |
---|
105 | |
---|
106 | (defun string-not-lessp (string1 string2 &key (start1 0) end1 (start2 0) end2) |
---|
107 | (let* ((string1 (string string1)) |
---|
108 | (string2 (string string2)) |
---|
109 | (end1 (or end1 (length string1))) |
---|
110 | (end2 (or end2 (length string2)))) |
---|
111 | (%string-not-lessp string1 string2 start1 end1 start2 end2))) |
---|
112 | |
---|
113 | (defun string-not-greaterp (string1 string2 &key (start1 0) end1 (start2 0) end2) |
---|
114 | (let* ((string1 (string string1)) |
---|
115 | (string2 (string string2)) |
---|
116 | (end1 (or end1 (length string1))) |
---|
117 | (end2 (or end2 (length string2)))) |
---|
118 | (%string-not-greaterp string1 string2 start1 end1 start2 end2))) |
---|
119 | |
---|
120 | |
---|
121 | ;;; STRING-LEFT-TRIM, STRING-RIGHT-TRIM, STRING-TRIM (from OpenMCL) |
---|
122 | |
---|
123 | (defun string-left-trim (char-bag string &aux end) |
---|
124 | "Given a set of characters (a list or string) and a string, returns |
---|
125 | a copy of the string with the characters in the set removed from the |
---|
126 | left end." |
---|
127 | (setq string (string string)) |
---|
128 | (setq end (length string)) |
---|
129 | (do ((index 0 (+ index 1))) |
---|
130 | ((or (= index end) (not (find (aref string index) char-bag))) |
---|
131 | (subseq string index end)))) |
---|
132 | |
---|
133 | (defun string-right-trim (char-bag string &aux end) |
---|
134 | "Given a set of characters (a list or string) and a string, returns |
---|
135 | a copy of the string with the characters in the set removed from the |
---|
136 | right end." |
---|
137 | (setq string (string string)) |
---|
138 | (setq end (length string)) |
---|
139 | (do ((index (- end 1) (- index 1))) |
---|
140 | ((or (< index 0) (not (find (aref string index) char-bag))) |
---|
141 | (subseq string 0 (+ index 1))))) |
---|
142 | |
---|
143 | (defun string-trim (char-bag string &aux end) |
---|
144 | "Given a set of characters (a list or string) and a string, returns a |
---|
145 | copy of the string with the characters in the set removed from both |
---|
146 | ends." |
---|
147 | (setq string (string string)) |
---|
148 | (setq end (length string)) |
---|
149 | (let ((left-end) (right-end)) |
---|
150 | (do ((index 0 (+ index 1))) |
---|
151 | ((or (= index end) (not (find (aref string index) char-bag))) |
---|
152 | (setq left-end index))) |
---|
153 | (do ((index (- end 1) (- index 1))) |
---|
154 | ((or (< index left-end) (not (find (aref string index) char-bag))) |
---|
155 | (setq right-end index))) |
---|
156 | (subseq string left-end (+ right-end 1)))) |
---|