X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=strings.lisp;h=3390581840e0d9aafa67b80068ebf05499f93d5d;hb=5c5adb1297021e440fa4943ef996c59ed9681178;hp=1178b5d5426e24c727f804de200625d6d3e4ed02;hpb=03712fbb06acbb103602bae10f41aeae7fa05127;p=kmrcl.git

diff --git a/strings.lisp b/strings.lisp
index 1178b5d..3390581 100644
--- a/strings.lisp
+++ b/strings.lisp
@@ -7,8 +7,6 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id$
-;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002-2006 by Kevin M. Rosenberg
 ;;;;
 ;;;; KMRCL users are granted the rights to distribute and use this software
@@ -44,7 +42,6 @@
             (setq in-word t))
         (setq in-word nil)))))
 
-;; From Larry Hunter with modifications
 (defun position-char (char string start max)
   (declare (optimize (speed 3) (safety 0) (space 0))
            (fixnum start max) (simple-string string))
@@ -567,6 +564,23 @@ for characters in a string"
       str)))
 
 
+(defun remove-char-string (char str)
+  (declare (character char)
+           (string str))
+  (do* ((len (length str))
+        (out (make-string len))
+        (pos 0 (1+ pos))
+        (opos 0))
+       ((= pos len) (subseq out 0 opos))
+    (declare (fixnum pos opos len)
+             (simple-string out))
+    (let ((c (char str pos)))
+      (declare (character c))
+      (when (char/= c char)
+        (setf (schar out opos) c)
+        (incf opos)))))
+
+
 (defun string-strip-ending (str endings)
   (if (stringp endings)
       (setq endings (list endings)))
@@ -704,3 +718,14 @@ for characters in a string"
       (do ((x (read stream nil eof) (read stream nil eof))
            (l nil (cons x l)))
           ((eq x eof) (nreverse l))))))
+
+(defun safely-read-from-string (str &rest read-from-string-args)
+  "Read an expression from the string STR, with *READ-EVAL* set
+to NIL. Any unsafe expressions will be replaced by NIL in the
+resulting S-Expression."
+  (let ((*read-eval* nil))
+    (ignore-errors (apply 'read-from-string str read-from-string-args))))
+
+(defun parse-float (f)
+  (let ((*read-default-float-format* 'double-float))
+    (coerce (safely-read-from-string f) 'double-float)))