Common subdirectories: cl-who-0.9.1-orig/doc and cl-who-0.9.1-new/doc diff -u cl-who-0.9.1-orig/packages.lisp cl-who-0.9.1-new/packages.lisp --- cl-who-0.9.1-orig/packages.lisp 2007-04-27 12:33:42.000000000 +0300 +++ cl-who-0.9.1-new/packages.lisp 2007-07-16 15:42:53.000000000 +0300 @@ -43,6 +43,11 @@ :convert-attributes :convert-tag-to-string-list :esc + :escape-char + :escape-char-all + :escape-char-iso-8859-1 + :escape-char-minimal + :escape-char-minimal-plus-quotes :escape-string :escape-string-all :escape-string-iso-8859 diff -u cl-who-0.9.1-orig/who.lisp cl-who-0.9.1-new/who.lisp --- cl-who-0.9.1-orig/who.lisp 2007-05-28 21:31:31.000000000 +0300 +++ cl-who-0.9.1-new/who.lisp 2007-07-16 15:40:50.000000000 +0300 @@ -54,6 +54,22 @@ *empty-tag-end* " />" *prologue* "")))) +(declaim (inline escape-char)) +(defun escape-char (char &key (test *escape-char-p*)) + (declare (optimize speed)) + "Escape supplied CHAR that suffices TEST predicate. \(Function will always +return a string.)" + (if (funcall test char) + (case char + (#\< "<") + (#\> ">") + (#\& "&") + (#\' "'") + (#\" """) + (t (format nil (if (eq *html-mode* :xml) "&#x~x;" "&#~d;") + (char-code char)))) + (make-string 1 :initial-element char))) + (defun escape-string (string &key (test *escape-char-p*)) (declare (optimize speed)) "Escape all characters in STRING which pass TEST. This function is @@ -91,32 +107,49 @@ finally (unless pos (write-sequence string s :start old-pos))))))) -(defun escape-string-minimal (string) - "Escape only #\<, #\>, and #\& in STRING." - (escape-string string :test #'(lambda (char) (find char "<>&")))) - -(defun escape-string-minimal-plus-quotes (string) - "Like ESCAPE-STRING-MINIMAL but also escapes quotes." - (escape-string string :test #'(lambda (char) (find char "<>&'\"")))) - -(defun escape-string-iso-8859-1 (string) - "Escapes all characters in STRING which aren't defined in -ISO-8859-1." - (escape-string string :test #'(lambda (char) - (or (find char "<>&'\"") - (> (char-code char) 255))))) +(let ((minimal-escape-char-p #'(lambda (char) (find char "<>&")))) + (defun escape-char-minimal (char) + "Escape only #\<, #\>, and #\& characters." + (escape-char char :test minimal-escape-char-p)) + (defun escape-string-minimal (string) + "Escape only #\<, #\>, and #\& in STRING." + (escape-string string :test minimal-escape-char-p))) + +(let ((minimal-plus-quotes-escape-char-p + #'(lambda (char) (find char "<>&'\"")))) + (defun escape-char-minimal-plus-quotes (char) + "Like ESCAPE-CHAR-MINIMAL but also escapes quotes." + (escape-char char :test minimal-plus-quotes-escape-char-p)) + (defun escape-string-minimal-plus-quotes (string) + "Like ESCAPE-STRING-MINIMAL but also escapes quotes." + (escape-string string :test minimal-plus-quotes-escape-char-p))) + +(let ((iso-8859-1-escape-char-p + #'(lambda (char) + (or (find char "<>&'\"") + (> (char-code char) 255))))) + (defun escape-char-iso-8859-1 (char) + "Escapes character that isn't defined in ISO-8859-9." + (escape-char char :test iso-8859-1-escape-char-p)) + (defun escape-string-iso-8859-1 (string) + "Escapes all characters in STRING which aren't defined in ISO-8859-1." + (escape-string string :test iso-8859-1-escape-char-p))) (defun escape-string-iso-8859 (string) - "Identical to ESCAPE-STRING-8859-1. Kept for backward -compatibility." + "Identical to ESCAPE-STRING-8859-1. Kept for backward compatibility." (escape-string-iso-8859-1 string)) -(defun escape-string-all (string) - "Escapes all characters in STRING which aren't in the 7-bit ASCII -character set." - (escape-string string :test #'(lambda (char) - (or (find char "<>&'\"") - (> (char-code char) 127))))) +(let ((non-7bit-ascii-escape-char-p + #'(lambda (char) + (or (find char "<>&'\"") + (> (char-code char) 127))))) + (defun escape-char-all (char) + "Escapes characters which aren't in the 7-bit ASCII character set." + (escape-char char :test non-7bit-ascii-escape-char-p)) + (defun escape-string-all (string) + "Escapes all characters in STRING which aren't in the 7-bit ASCII character +set." + (escape-string string :test non-7bit-ascii-escape-char-p))) (defun process-tag (sexp body-fn) (declare (optimize speed space))