X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=strings.lisp;h=fbb130caad55b5d4442653f43d1d57290354bd4a;hp=732e8f075b9ac501e94443ae0b0324c778b23781;hb=12e4f3260043dbc89dc8efd78cb9f116e0173054;hpb=ab5f800e2939665c968b9e97519d99bddb39251d diff --git a/strings.lisp b/strings.lisp index 732e8f0..fbb130c 100644 --- a/strings.lisp +++ b/strings.lisp @@ -227,17 +227,20 @@ list of characters and replacement strings." (defun make-usb8-array (len) (make-array len :element-type '(unsigned-byte 8))) -(defun usb8-array-to-string (vec) - (declare (type (simple-array (unsigned-byte 8) (*)) vec)) - (let* ((len (length vec)) +(defun usb8-array-to-string (vec &key (start 0) end) + (declare (type (simple-array (unsigned-byte 8) (*)) vec) + (fixnum start)) + (unless end + (setq end (length vec))) + (let* ((len (- end start)) (str (make-string len))) (declare (fixnum len) (simple-string str) - (optimize (speed 3))) + (optimize (speed 3) (safety 0))) (do ((i 0 (1+ i))) ((= i len) str) (declare (fixnum i)) - (setf (schar str i) (code-char (aref vec i)))))) + (setf (schar str i) (code-char (aref vec (the fixnum (+ i start)))))))) (defun string-to-usb8-array (str) (declare (simple-string str)) @@ -413,9 +416,9 @@ for characters in a string" (declare (type (integer 0 15) n)) (schar +hex-chars+ n)) -(defconstant +char-code-lower-a+ (char-code #\a)) -(defconstant +char-code-upper-a+ (char-code #\A)) -(defconstant +char-code-0+ (char-code #\0)) +(defconstant* +char-code-lower-a+ (char-code #\a)) +(defconstant* +char-code-upper-a+ (char-code #\A)) +(defconstant* +char-code-0+ (char-code #\0)) (declaim (type fixnum +char-code-0+ +char-code-upper-a+ +char-code-0)) @@ -476,9 +479,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 +494,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) @@ -604,7 +607,12 @@ for characters in a string" (defun split-alphanumeric-string (string) "Separates a string at any non-alphanumeric chararacter" - (flet ((is-sep (char) (non-alphanumericp char))) + (declare (simple-string string) + (optimize (speed 3) (safety 0))) + (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) @@ -619,7 +627,30 @@ for characters in a string" (push (subseq string token-start token-end) tokens))))) - +(defun trim-non-alphanumeric (word) + "Strip non-alphanumeric characters from beginning and end of a word." + (declare (simple-string word) + (optimize (speed 3) (safety 0) (space 0))) + (let* ((start 0) + (len (length word)) + (end len)) + (declare (fixnum start end len)) + (do ((done nil)) + ((or done (= start end))) + (if (alphanumericp (schar word start)) + (setq done t) + (incf start))) + (when (> end start) + (do ((done nil)) + ((or done (= start end))) + (if (alphanumericp (schar word (1- end))) + (setq done t) + (decf end)))) + (if (or (plusp start) (/= len end)) + (subseq word start end) + word))) + + (defun collapse-whitespace (s) "Convert multiple whitespace characters to a single space character." (declare (simple-string s)