From b9b882d7884b08b878e59c7c2c20828d57b3ce55 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Thu, 27 Jul 2006 17:04:19 +0000 Subject: [PATCH] r10990: 27 Jul 2006 Kevin Rosenberg * Version 1.88 * strings.lisp, package.lisp: Add binary-sequence-to-hex-string --- ChangeLog | 4 ++++ debian/changelog | 6 ++++++ package.lisp | 39 ++++++++++++++++++++------------------- strings.lisp | 32 +++++++++++++++++++------------- tests.lisp | 18 +++++++++++++++++- 5 files changed, 66 insertions(+), 33 deletions(-) diff --git a/ChangeLog b/ChangeLog index 81bee4f..b7d4445 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +27 Jul 2006 Kevin Rosenberg + * Version 1.88 + * strings.lisp, package.lisp: Add binary-sequence-to-hex-string + 26 Jul 2006 Kevin Rosenberg * Version 1.87 * proceeses.lisp, sockets.lisp: Apply patch from Travis Cross diff --git a/debian/changelog b/debian/changelog index 089893d..82db43f 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-kmrcl (1.88-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Thu, 27 Jul 2006 11:03:55 -0600 + cl-kmrcl (1.87-1) unstable; urgency=low * New upstream diff --git a/package.lisp b/package.lisp index 58c0172..f4d42ff 100644 --- a/package.lisp +++ b/package.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 @@ -73,7 +73,8 @@ #:collapse-whitespace #:string->list #:trim-non-alphanumeric - + #:binary-sequence-to-hex-string + ;; io.lisp #:indent-spaces #:indent-html-spaces @@ -107,7 +108,7 @@ #:zone #:day-of-month #:day-of-week - #:+datetime-number-strings+ + #:+datetime-number-strings+ #:utc-offset #:copy-binary-stream @@ -137,10 +138,10 @@ #:get-plist #:flatten #:unique-slot-values - + ;; seq.lisp #:nsubseq - + ;; math.lisp #:ensure-integer #:histogram @@ -173,7 +174,7 @@ #:ppmx #:defconstant* #:defvar-unbound - + ;; files.lisp #:print-file-contents #:read-stream-to-string @@ -181,7 +182,7 @@ #:read-file-to-usb8-array #:read-stream-to-strings #:read-file-to-strings - + ;; strings.lisp #:string-append #:count-string-words @@ -205,11 +206,11 @@ #:print-separated-strings #:lex-string #:split-alphanumeric-string - + ;; strmatch.lisp #:score-multiword-match #:multiword-match - + ;; symbols.lisp #:ensure-keyword #:ensure-keyword-upcase @@ -219,7 +220,7 @@ #:show #:show-variables #:show-functions - + ;; From attrib-class.lisp #:attributes-class #:slot-attribute @@ -228,10 +229,10 @@ #:generalized-equal ;; From buffered input - + #:make-fields-buffer #:read-buffered-fields - + ;; From datetime.lisp #:pretty-date #:date-string @@ -239,15 +240,15 @@ #:print-seconds #:posix-time-to-utime #:utime-to-posix-time - + ;; From random.lisp #:seed-random-generator #:random-choice - + ;; From repl.lisp #:make-repl #:init/repl - + ;; From web-utils #:*base-url* #:base-url! @@ -258,14 +259,14 @@ #:user-agent-ie-p #:decode-uri-query-string #:split-uri-query-string - + ;; From xml-utils #:sgml-header-stream #:xml-tag-contents #:positions-xml-tag-contents #:cdata-string #:write-cdata - + ;; From console #:*console-msgs* #:cmsg @@ -283,12 +284,12 @@ ;; sockets.lisp #:make-active-socket #:close-active-socket - + ;; listener.lisp #:init/listener #:stop-all/listener #:listener - + ;; fformat.lisp #:fformat 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) diff --git a/tests.lisp b/tests.lisp index e149575..d78aba3 100644 --- a/tests.lisp +++ b/tests.lisp @@ -9,7 +9,7 @@ ;;;; ;;;; $Id$ ;;;; -;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg +;;;; This file is Copyright (c) 2000-2006 by Kevin M. Rosenberg ;;;; ;;;; ************************************************************************* @@ -64,6 +64,22 @@ (deftest :sdstl.4 (string-delimited-string-to-list "ab|cd|ef" "ab") ("" "|cd|ef")) +(deftest :hexstr.1 (binary-sequence-to-hex-string ()) + "") + +(deftest :hexstr.2 (binary-sequence-to-hex-string #()) + "") + +(deftest :hexstr.3 (binary-sequence-to-hex-string #(165)) + "a5" +) + +(deftest :hexstr.4 (binary-sequence-to-hex-string (list 165)) + "a5") + +(deftest :hexstr.5 (binary-sequence-to-hex-string #(165 86)) + "a556") + (deftest :apsl.1 (append-sublists '((a b) (c d))) (a b c d)) (deftest :apsl.2 (append-sublists nil) nil) (deftest :apsl.3 (append-sublists '((a b))) (a b)) -- 2.34.1