arnesi

Manipulating strings 

(defvar +lower-case-ascii-alphabet+   "abcdefghijklmnopqrstuvwxyz")

(defvar +upper-case-ascii-alphabet+   "ABCDEFGHIJKLMNOPQRSTUVWXYZ")

(defvar +ascii-alphabet+              "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ")

(defvar +alphanumeric-ascii-alphabet+ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789")

(defvar +base64-alphabet+             "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")

(defun random-string (&optional (length 32) (alphabet +ascii-alphabet+))
  "Returns a random alphabetic string.
[...]
The returned string will contain LENGTH characters chosen from
the vector ALPHABET.
"
  (loop with id = (make-string length)
        with alphabet-length = (length alphabet)
        for i below length
        do (setf (cl:aref id i)
                 (cl:aref alphabet (random alphabet-length)))
        finally (return id)))

(defun strcat (&rest items)
  "Returns a fresh string consisting of ITEMS concat'd together."
  (strcat* items))

(defun strcat* (string-designators)
  "Concatenate all the strings in STRING-DESIGNATORS."
  (with-output-to-string (strcat)
    (dotree (s string-designators)
      (princ s strcat))))

(defun fold-strings (list)
  "Traverse list and cancatenates any sequential elements which
  are lists. removes any \"\" elements for LIST. returns a fresh[...]
  list."
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (let ((return-list '())
        (string-buffer (make-array 20 :element-type 'character :fill-pointer 0 :adjustable t)))
    (flet ((collect-string (string)
             (if (stringp (car return-list))
                 ;; collecting another string, just add it.
                 (loop
                    for char across string
                    do (vector-push-extend char (car return-list)))
                 ;; new string
                 (progn
                   (loop
                      initially (setf (fill-pointer string-buffer) 0)
                      for char across string
                      do (vector-push-extend char string-buffer))
                   (push string-buffer return-list))))
           (collect-object (object)
             (if (stringp (car return-list))
                 (setf (car return-list) (map-into (make-array (length string-buffer)
                                                               :element-type 'character)
                                                   #'identity
                                                   string-buffer)
                       return-list (cons object return-list))
                 (push object return-list))))
      (dolist (l list)
        (if (stringp l)
            (collect-string l)
            (collect-object l)))
      (nreverse return-list))))

(defun trim-string (string &optional (char '(#\Space #\Tab #\Newline #\Return #\Linefeed)))
  (let ((chars (ensure-list char)))
    (subseq string [...]
	    (loop for index upfrom 0 below (length string)
		  when (not (member (aref string index) chars)) 
		    do (return index)
		  ;; if we get here we're trimming the entire string
                  finally (return-from trim-string ""))
	    (loop for index downfrom (length string)
		  when (not (member (aref string (1- index)) chars))
		    do (return index)))))

(defvar ~%      (format nil "~%"))

(defvar ~T      (string #\Tab))

(defvar +CR-LF+ (make-array 2 :element-type 'character
					     :initial-contents (list (code-char #x0D) (code-char #x0A))))

(defun ~D (number &optional stream &key mincol pad-char)
  (format stream "~v,vD" mincol pad-char number))

(defun ~A (object &optional stream)
  (format stream "~A" object))

(defun ~S (object &optional stream)
  (format stream "~S" object))

(defun ~W (object &optional stream)
  (format stream "~W" object))