X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=strings.lisp;h=d5bfa07a4b7c35e2baa47d3f513666c8d8dfe492;hp=fbb130caad55b5d4442653f43d1d57290354bd4a;hb=b9b882d7884b08b878e59c7c2c20828d57b3ce55;hpb=90225d9ba12f7a9116bcc923afdaf6e76a8c6728

diff --git a/strings.lisp b/strings.lisp
index fbb130c..d5bfa07 100644
--- a/strings.lisp
+++ b/strings.lisp
@@ -9,7 +9,7 @@
 ;;;;
 ;;;; $Id$
 ;;;;
-;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; 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
 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
@@ -61,7 +61,7 @@
     (declare (fixnum i))
     (when (char/= char (schar string i)) (return i))))
 
-(defun delimited-string-to-list (string &optional (separator #\space) 
+(defun delimited-string-to-list (string &optional (separator #\space)
 						  skip-terminal)
   "split a string with delimiter"
   (declare (optimize (speed 3) (safety 0) (space 0) (compilation-speed 0))
@@ -106,7 +106,7 @@
 (defun escape-backslashes (s)
   (substitute-string-for-char s #\\ "\\\\"))
 
-(defun substitute-string-for-char (procstr match-char subst-str) 
+(defun substitute-string-for-char (procstr match-char subst-str)
   "Substitutes a string for a single matching character of a string"
   (substitute-chars-strings procstr (list (cons match-char subst-str))))
 
@@ -157,7 +157,7 @@
 			     #+allegro #\%space
 			     #+lispworks #\No-Break-Space))
 
-(defun is-char-whitespace (c) 
+(defun is-char-whitespace (c)
   (declare (character c) (optimize (speed 3) (safety 0)))
   (or (char= c #\Space) (char= c #\Tab) (char= c #\Return)
       (char= c #\Linefeed)
@@ -353,7 +353,7 @@ Leading zeros are present."
 	     (type (or fixnum null) end))
     (push (subseq str pos end) output)
     (setq pos (+ end substr-len))))
-  
+
 (defun string-to-list-skip-delimiter (str &optional (delim #\space))
   "Return a list of strings, delimited by spaces, skipping spaces."
   (declare (simple-string str)
@@ -425,11 +425,17 @@ for characters in a string"
 (defun charhex (ch)
   "convert hex character to decimal"
   (let ((code (char-code (char-upcase ch))))
-    (declare (fixnum ch)) 
+    (declare (fixnum ch))
     (if (>= code +char-code-upper-a+)
 	(+ 10 (- code +char-code-upper-a+))
 	(- code +char-code-0+))))
 
+(defun binary-sequence-to-hex-string (seq)
+  (let ((list (etypecase seq
+                (list seq)
+                (sequence (map 'list #'identity seq)))))
+    (string-downcase (format nil "~{~2,'0X~}" list))))
+
 (defun encode-uri-string (query)
   "Escape non-alphanumeric characters for URI fields"
   (declare (simple-string query)
@@ -501,7 +507,7 @@ for characters in a string"
        (if (>= n 26)
 	   (code-char (+ +char-code-upper-a+ (- n 26)))
 	 (code-char (+ +char-code-lower-a+ n)))))))
-     
+
 
 (defun random-string (&key (length 10) (set :lower-alpha))
   "Returns a random lower-case string."
@@ -552,7 +558,7 @@ for characters in a string"
 					      (length ending)))))
 	(return-from string-strip-ending
 	  (subseq str 0 (- len (length ending))))))))
-       
+
 
 (defun string-maybe-shorten (str maxlen)
   (string-elide str maxlen :end))
@@ -569,7 +575,7 @@ for characters in a string"
      ((eq position :middle)
       (multiple-value-bind (mid remain) (truncate maxlen 2)
 	(let ((end1 (- mid 1))
-	      (start2 (- len (- mid 2) remain))) 
+	      (start2 (- len (- mid 2) remain)))
 	  (concatenate 'string (subseq str 0 end1) "..." (subseq str start2)))))
      ((or (eq position :end) t)
       (concatenate 'string (subseq str 0 (- maxlen 3)) "...")))))
@@ -594,7 +600,7 @@ for characters in a string"
   (flet ((is-sep (char) (member char whitespace :test #'char=)))
     (let ((tokens nil))
       (do* ((token-start
-             (position-if-not #'is-sep string) 
+             (position-if-not #'is-sep string)
              (when token-end
                (position-if-not #'is-sep string :start (1+ token-end))))
             (token-end
@@ -609,13 +615,13 @@ for characters in a string"
   "Separates a string at any non-alphanumeric chararacter"
   (declare (simple-string string)
 	   (optimize (speed 3) (safety 0)))
-  (flet ((is-sep (char) 
+  (flet ((is-sep (char)
 	   (declare (character char))
 	   (and (non-alphanumericp char)
 		(not (char= #\_ char)))))
     (let ((tokens nil))
       (do* ((token-start
-             (position-if-not #'is-sep string) 
+             (position-if-not #'is-sep string)
              (when token-end
                (position-if-not #'is-sep string :start (1+ token-end))))
             (token-end
@@ -650,7 +656,7 @@ for characters in a string"
 	(subseq word start end)
       word)))
 
-	  
+
 (defun collapse-whitespace (s)
   "Convert multiple whitespace characters to a single space character."
   (declare (simple-string s)