(defun is-string-empty (str)
(zerop (length str)))
-(defvar *whitespace-chars* '(#\space #\tab #\return #\linefeed))
+(defvar *whitespace-chars* '(#\space #\tab #\return #\linefeed
+ #+allegro #\%space
+ #+lispworks #\No-Break-Space))
(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)))
+ (char= c #\Linefeed)
+ #+allegro (char= c #\%space)
+ #+lispworks (char= c #\No-Break-Space)))
(defun is-string-whitespace (str)
"Return t if string is all whitespace"
(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))
(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))
(+ 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)))
(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)))
(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
(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)
(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
(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)
(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)
(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))))))