X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=strings.lisp;h=4ef18f0134e586755ab1cb9177e82ff53ca11b10;hp=179bdb3ccea252a7c415f58259aea1fe0bb44734;hb=8513c6f273613b0ceb2b48c07da6a0b1803c32a5;hpb=c09e2c2ead02aef697a02fb894bea2642c4c0d55 diff --git a/strings.lisp b/strings.lisp index 179bdb3..4ef18f0 100644 --- a/strings.lisp +++ b/strings.lisp @@ -427,7 +427,7 @@ for characters in a string" (+ 10 (- code +char-code-upper-a+)) (- code +char-code-0+)))) -(defun uriencode-string (query) +(defun encode-uri-string (query) "Escape non-alphanumeric characters for URI fields" (declare (simple-string query) (optimize (speed 3) (safety 0) (space 0))) @@ -450,7 +450,7 @@ for characters in a string" (setf (schar str dpos) (hexchar (logand c 15)))) (setf (schar str dpos) ch))))) -(defun uridecode-string (query) +(defun decode-uri-string (query) "Unescape non-alphanumeric characters for URI fields" (declare (simple-string query) (optimize (speed 3) (safety 0) (space 0))) @@ -476,9 +476,9 @@ for characters in a string" (eval-when (:compile-toplevel :load-toplevel :execute) - (defvar +unambigous-charset+ + (defvar +unambiguous-charset+ "abcdefghjkmnpqrstuvwxyz123456789ABCDEFGHJKLMNPQSRTUVWXYZ") - (defconstant +unambigous-length+ (length +unambigous-charset+))) + (defconstant +unambiguous-length+ (length +unambiguous-charset+))) (defun random-char (&optional (set :lower-alpha)) (ecase set @@ -491,8 +491,8 @@ for characters in a string" (code-char (+ +char-code-lower-a+ n))))) (:upper-alpha (code-char (+ +char-code-upper-a+ (random 26)))) - (:unambigous - (schar +unambigous-charset+ (random +unambigous-length+))) + (:unambiguous + (schar +unambiguous-charset+ (random +unambiguous-length+))) (:upper-lower-alpha (let ((n (random 52))) (if (>= n 26) @@ -552,11 +552,24 @@ for characters in a string" (defun string-maybe-shorten (str maxlen) - (let ((len (length str))) - (if (<= len maxlen) - str - (concatenate 'string (subseq str 0 (- maxlen 3)) "...")))) + (string-elide str maxlen :end)) +(defun string-elide (str maxlen position) + (declare (fixnum maxlen)) + (let ((len (length str))) + (declare (fixnum len)) + (cond + ((<= len maxlen) + str) + ((<= maxlen 3) + "...") + ((eq position :middle) + (multiple-value-bind (mid remain) (truncate maxlen 2) + (let ((end1 (- mid 1)) + (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)) "..."))))) (defun shrink-vector (str size) #+allegro @@ -627,3 +640,10 @@ for characters in a string" (t (setq in-white nil) (write-char c stream))))))) + +(defun string->list (string) + (let ((eof (list nil))) + (with-input-from-string (stream string) + (do ((x (read stream nil eof) (read stream nil eof)) + (l nil (cons x l))) + ((eq x eof) (nreverse l))))))