;;;;
;;;; $Id$
;;;;
-;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of KMRCL, is Copyright (c) 2002-2006 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
#:collapse-whitespace
#:string->list
#:trim-non-alphanumeric
-
+ #:binary-sequence-to-hex-string
+
;; io.lisp
#:indent-spaces
#:indent-html-spaces
#:zone
#:day-of-month
#:day-of-week
- #:+datetime-number-strings+
+ #:+datetime-number-strings+
#:utc-offset
#:copy-binary-stream
#:get-plist
#:flatten
#:unique-slot-values
-
+
;; seq.lisp
#:nsubseq
-
+
;; math.lisp
#:ensure-integer
#:histogram
#:ppmx
#:defconstant*
#:defvar-unbound
-
+
;; files.lisp
#:print-file-contents
#:read-stream-to-string
#:read-file-to-usb8-array
#:read-stream-to-strings
#:read-file-to-strings
-
+
;; strings.lisp
#:string-append
#:count-string-words
#:print-separated-strings
#:lex-string
#:split-alphanumeric-string
-
+
;; strmatch.lisp
#:score-multiword-match
#:multiword-match
-
+
;; symbols.lisp
#:ensure-keyword
#:ensure-keyword-upcase
#:show
#:show-variables
#:show-functions
-
+
;; From attrib-class.lisp
#:attributes-class
#:slot-attribute
#:generalized-equal
;; From buffered input
-
+
#:make-fields-buffer
#:read-buffered-fields
-
+
;; From datetime.lisp
#:pretty-date
#:date-string
#:print-seconds
#:posix-time-to-utime
#:utime-to-posix-time
-
+
;; From random.lisp
#:seed-random-generator
#:random-choice
-
+
;; From repl.lisp
#:make-repl
#:init/repl
-
+
;; From web-utils
#:*base-url*
#:base-url!
#:user-agent-ie-p
#:decode-uri-query-string
#:split-uri-query-string
-
+
;; From xml-utils
#:sgml-header-stream
#:xml-tag-contents
#:positions-xml-tag-contents
#:cdata-string
#:write-cdata
-
+
;; From console
#:*console-msgs*
#:cmsg
;; sockets.lisp
#:make-active-socket
#:close-active-socket
-
+
;; listener.lisp
#:init/listener
#:stop-all/listener
#:listener
-
+
;; fformat.lisp
#:fformat
;;;;
;;;; $Id$
;;;;
-;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of KMRCL, is Copyright (c) 2002-2006 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
(declare (fixnum i))
(when (char/= char (schar string i)) (return i))))
-(defun delimited-string-to-list (string &optional (separator #\space)
+(defun delimited-string-to-list (string &optional (separator #\space)
skip-terminal)
"split a string with delimiter"
(declare (optimize (speed 3) (safety 0) (space 0) (compilation-speed 0))
(defun escape-backslashes (s)
(substitute-string-for-char s #\\ "\\\\"))
-(defun substitute-string-for-char (procstr match-char subst-str)
+(defun substitute-string-for-char (procstr match-char subst-str)
"Substitutes a string for a single matching character of a string"
(substitute-chars-strings procstr (list (cons match-char subst-str))))
#+allegro #\%space
#+lispworks #\No-Break-Space))
-(defun is-char-whitespace (c)
+(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)
(type (or fixnum null) end))
(push (subseq str pos end) output)
(setq pos (+ end substr-len))))
-
+
(defun string-to-list-skip-delimiter (str &optional (delim #\space))
"Return a list of strings, delimited by spaces, skipping spaces."
(declare (simple-string str)
(defun charhex (ch)
"convert hex character to decimal"
(let ((code (char-code (char-upcase ch))))
- (declare (fixnum ch))
+ (declare (fixnum ch))
(if (>= code +char-code-upper-a+)
(+ 10 (- code +char-code-upper-a+))
(- code +char-code-0+))))
+(defun binary-sequence-to-hex-string (seq)
+ (let ((list (etypecase seq
+ (list seq)
+ (sequence (map 'list #'identity seq)))))
+ (string-downcase (format nil "~{~2,'0X~}" list))))
+
(defun encode-uri-string (query)
"Escape non-alphanumeric characters for URI fields"
(declare (simple-string query)
(if (>= n 26)
(code-char (+ +char-code-upper-a+ (- n 26)))
(code-char (+ +char-code-lower-a+ n)))))))
-
+
(defun random-string (&key (length 10) (set :lower-alpha))
"Returns a random lower-case string."
(length ending)))))
(return-from string-strip-ending
(subseq str 0 (- len (length ending))))))))
-
+
(defun string-maybe-shorten (str maxlen)
(string-elide str maxlen :end))
((eq position :middle)
(multiple-value-bind (mid remain) (truncate maxlen 2)
(let ((end1 (- mid 1))
- (start2 (- len (- mid 2) remain)))
+ (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)) "...")))))
(flet ((is-sep (char) (member char whitespace :test #'char=)))
(let ((tokens nil))
(do* ((token-start
- (position-if-not #'is-sep string)
+ (position-if-not #'is-sep string)
(when token-end
(position-if-not #'is-sep string :start (1+ token-end))))
(token-end
"Separates a string at any non-alphanumeric chararacter"
(declare (simple-string string)
(optimize (speed 3) (safety 0)))
- (flet ((is-sep (char)
+ (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)
+ (position-if-not #'is-sep string)
(when token-end
(position-if-not #'is-sep string :start (1+ token-end))))
(token-end
(subseq word start end)
word)))
-
+
(defun collapse-whitespace (s)
"Convert multiple whitespace characters to a single space character."
(declare (simple-string s)