Changeset 3330 for trunk/j/src/org/armedbear/lisp/strings.lisp

Timestamp:

08/11/03 16:31:37 (18 years ago)

Author:

piso

Message:

STRING-LEFT-TRIM, STRING-RIGHT-TRIM, STRING-TRIM

File:

• trunk/j/src/org/armedbear/lisp/strings.lisp (modified) (2 diffs)

trunk/j/src/org/armedbear/lisp/strings.lisp

@@ -2 +2 @@
 ;;;
 ;;; Copyright (C) 2003 Peter Graves
-;;; $Id: strings.lisp,v 1.5 2003-07-02 15:27:43 piso Exp $
+;;; $Id: strings.lisp,v 1.6 2003-08-11 16:31:37 piso Exp $
 ;;;
 ;;; This program is free software; you can redistribute it and/or
@@ -121 +121 @@
          (end2 (or end2 (length string2))))
     (%string-not-greaterp string1 string2 start1 end1 start2 end2)))
+
+
+;;; STRING-LEFT-TRIM, STRING-RIGHT-TRIM, STRING-TRIM (from OpenMCL)
+
+(defun string-left-trim (char-bag string &aux end)
+  "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."
+  (setq string (string string))
+  (setq end (length string))
+  (do ((index 0 (+ index 1)))
+      ((or (= index end) (not (find (aref string index) char-bag)))
+       (subseq string index end))))
+
+(defun string-right-trim (char-bag string &aux end)
+  "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."
+  (setq string (string string))
+  (setq end (length string))
+  (do ((index (- end 1) (- index 1)))
+      ((or (< index 0) (not (find (aref string index) char-bag)))
+       (subseq string 0 (+ index 1)))))
+
+(defun string-trim (char-bag string &aux end)
+  "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."
+  (setq string (string string))
+  (setq end (length string))
+  (let ((left-end) (right-end))
+    (do ((index 0 (+ index 1)))
+        ((or (= index end) (not (find (aref string index) char-bag)))
+         (setq left-end index)))
+    (do ((index (- end 1) (- index 1)))
+        ((or (< index left-end) (not (find (aref string index) char-bag)))
+         (setq right-end index)))
+    (subseq string left-end (+ right-end 1))))