collapse-string
A function to remove whitespace from a string, with the option of collapsing each "run" to a single character, while optionally ignoring whitespace on the left, right, or both ends of the string. This function always returns a fresh string, so it may be convenient to use in series with destructive functions like nstring-downcase. On the other hand, this function isn't very optimized.

(defun whitespace-char-p (char) (check-type char character) ;; Could include non-breaking space, maybe, since ;; we're already in semi-standard territory with ;; these character names. It's a tricky predicate. (case char ((#\Return #\Linefeed #\Page #\Space #\Tab #\VT) t))) (defun make-scratch (string to-type buffer-size) (let ((string-type (array-element-type string))) (make-array buffer-size :fill-pointer 0 ;; The new element-type must accommodate both existing characters ;; and the given substitution character (if any was specified). :element-type (cond ((subtypep to-type 'null) string-type) ((subtypep to-type string-type) string-type) ((subtypep string-type to-type) to-type) (t 'character))))) (defun collapse-string (string &key (start 0) end to (trim :both)) (check-type trim (member nil :left :right :both) "a trim option") (let ((buffer-size (- (or end (setq end (length string))) start))) (loop with buffer = (make-scratch string (type-of to) buffer-size) with state = :initial for i from start below end for char = (char string i) do (cond ((not (whitespace-char-p char)) (when (and to (eq state :whitespace)) (vector-push-extend to buffer)) (vector-push-extend char buffer) (setq state :non-whitespace-sequence)) ((not (and (zerop (fill-pointer buffer)) (case trim ((:left :both) t)))) ;; Not trimming on left. (setq state :whitespace))) ;; Deal with any trailing whitespace. finally (unless (case trim ((:right :both) t)) (when (and to (eq state :whitespace)) (vector-push-extend to buffer))) ;; Always a new string. (return (copy-seq buffer)))))

Quick examples

Call Output
(collapse-string "    Hello      World    ")
HelloWorld
(collapse-string "    Hello      World    " :start 10)
World
(collapse-string "    Hello      World    " :to #\-)
Hello-World
(collapse-string "    Hello      World    " :to #\_ :trim :right)
_Hello_World
(collapse-string "    Hello      World    " :to #\/ :trim nil)
/Hello/World/
(collapse-string "    " :to #\/ :trim nil)
/

See also


Apache 2