source: trunk/j/src/org/armedbear/lisp/strings.lisp @ 11297

Last change on this file since 11297 was 11297, checked in by ehuelsmann, 13 years ago

Set Id keyword for expansion.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 6.1 KB
Line 
1;;; strings.lisp
2;;;
3;;; Copyright (C) 2003-2005 Peter Graves
4;;; $Id: strings.lisp 11297 2008-08-31 13:26:45Z ehuelsmann $
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))))
Note: See TracBrowser for help on using the repository browser.