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 #& "&amp;") #< "&lt;") #> "&gt;")) + (replace-in-string str '(#& #< #>) '("&amp;" "&lt;" "&gt;")))

(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 "&nbsp;") #\tab "&nbsp;&nbsp;&nbsp;&nbsp;")) \ No newline at end of file + (replace-in-string str '(#& #< #> #\newline #\return #\linefeed #\space #\tab) '("&amp;" "&lt;" "&gt;" "" "<br>" "" "&nbsp;" "&nbsp;&nbsp;&nbsp;&nbsp;"))) \ No newline at end of file