[Lisppaste-cvs] CVS update: lisppaste2/encode-for-pre.lisp

Brian Mastenbrook bmastenbrook at common-lisp.net
Sun Nov 30 22:16:47 UTC 2003


Update of /project/lisppaste/cvsroot/lisppaste2
In directory common-lisp.net:/tmp/cvs-serv13757

Modified Files:
	encode-for-pre.lisp 
Log Message:
Attempt to make this a little less slow

Date: Sun Nov 30 17:16:46 2003
Author: bmastenbrook

Index: lisppaste2/encode-for-pre.lisp
diff -u lisppaste2/encode-for-pre.lisp:1.4 lisppaste2/encode-for-pre.lisp:1.5
--- lisppaste2/encode-for-pre.lisp:1.4	Wed Nov 12 23:34:20 2003
+++ lisppaste2/encode-for-pre.lisp	Sun Nov 30 17:16:45 2003
@@ -1,32 +1,27 @@
-;;;; $Id: encode-for-pre.lisp,v 1.4 2003/11/13 04:34:20 bmastenbrook Exp $
+;;;; $Id: encode-for-pre.lisp,v 1.5 2003/11/30 22:16:45 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/encode-for-pre.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
 
 (in-package :lisppaste)
 
-(defun replace-in-string (str char repstr)
-  (declare (type string str repstr))
-  (let ((stri str)
-	(startpos 0))
-    (tagbody
-     start
-     (let ((pos (position char stri :test #'char= :start startpos)))
-       (when pos
-	 (setf stri (concatenate 'string (subseq stri 0 pos) repstr (subseq stri (1+ pos) (length stri))))
-	 (setf startpos (+ pos (length repstr)))
-	 (go start))))
-     stri))
+(defun replace-in-string (str chars repstrs)
+  (declare (type string str))
+  (let ((stri str))
+    (loop for char in chars for repstr in repstrs do
+	  (let ((startpos 0))
+	    (tagbody
+	     start
+	       (let ((pos (position char stri :test #'char= :start startpos)))
+		 (when pos
+		   (setf stri (concatenate 'string (subseq stri 0 pos) repstr (subseq stri (1+ pos) (length stri))))
+		   (setf startpos (+ pos (length repstr)))
+		   (go start))))
+	    stri))
+    stri))
 
 (defun encode-for-pre (str)
-  (replace-in-string
-   (replace-in-string
-    (replace-in-string str #\& "&") #\< "<") #\> ">"))
+  (replace-in-string str '(#\& #\< #\>) '("&" "<" ">")))
 
 (defun encode-for-tt (str)
-  (replace-in-string
-   (replace-in-string
-    (replace-in-string
-     (replace-in-string
-      (replace-in-string (encode-for-pre str) #\newline "") #\return "<br>") #\linefeed "")
-    #\space " ") #\tab "    "))
\ No newline at end of file
+  (replace-in-string str '(#\& #\< #\> #\newline #\return #\linefeed  #\space #\tab) '("&" "<" ">" "" "<br>" "" " " "    ")))
\ No newline at end of file





More information about the Lisppaste-cvs mailing list