1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: strings.lisp
6 ;;;; Purpose: Strings utility functions for KMRCL package
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Apr 2000
10 ;;;; $Id: strings.lisp,v 1.2 2002/11/04 18:02:13 kevin Exp $
12 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
14 ;;;; KMRCL users are granted the rights to distribute and use this software
15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
17 ;;;; *************************************************************************
21 (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3)))
25 (defmacro string-append (outputstr &rest args)
26 `(setq ,outputstr (concatenate 'string ,outputstr ,@args)))
28 (defmacro string-field-append (outputstr &rest args)
29 `(setq ,outputstr (concatenate 'string ,outputstr ,@args)))
31 (defun list-to-string (lst)
32 "Converts a list to a string, doesn't include any delimiters between elements"
33 (format nil "~{~A~}" lst))
35 (defun count-string-words (str)
36 (declare (simple-string str)
37 (optimize (speed 3) (safety 0)))
40 (declare (fixnum n-words))
41 (dotimes (i (length str))
42 (let ((ch (char str i)))
43 (declare (character ch))
44 (if (alphanumericp ch)
52 (defun delimited-string-to-list (string &optional (separator #\space))
53 (excl:delimited-string-to-list string separator))
56 (defun delimited-string-to-list (sequence &optional (separator #\space))
57 "Split a string by a delimitor"
60 for end = (position separator sequence :start start)
61 collect (subseq sequence start end)
64 (setf start (1+ end))))
67 (defun list-to-delimited-string (list &optional (separator #\space))
68 (excl:list-to-delimited-string list separator))
71 (defun list-to-delimited-string (list &optional (separator #\space))
72 (let ((output (when list (format nil "~A" (car list)))))
73 (dolist (obj (rest list))
74 (setq output (concatenate 'string output
75 (format nil "~A" separator)
76 (format nil "~A" obj))))
79 (defun string-invert (str)
80 "Invert case of a string"
81 (declare (optimize (speed 3) (compilation-speed 0) (debug 0) (safety 0))
83 (let ((up nil) (down nil))
85 (loop for char of-type character across str do
86 (cond ((upper-case-p char) (if down (return-from skip str) (setf up t)))
87 ((lower-case-p char) (if up (return-from skip str) (setf down t)))))
88 (if up (string-downcase str) (string-upcase str)))))
90 (defun add-sql-quotes (s)
91 (substitute-string-for-char s #\' "''"))
93 (defun escape-backslashes (s)
94 (substitute-string-for-char s #\\ "\\\\"))
96 (defun substitute-string-for-char (procstr match-char subst-str)
97 "Substitutes a string for a single matching character of a string"
98 (let ((pos (position match-char procstr)))
101 (subseq procstr 0 pos) subst-str
102 (substitute-string-for-char (subseq procstr (1+ pos)) match-char subst-str))
105 (defun string-substitute (string substring replacement-string)
106 "String substitute by Larry Hunter. Obtained from Google"
107 (let ((substring-length (length substring))
111 (search substring string)
112 (search substring string :start2 last-end)))
114 (concatenate 'string new-string (subseq string last-end)))
118 (subseq string last-end next-start)
120 (setq last-end (+ next-start substring-length)))))
123 (defun string-trim-last-character (s)
124 "Return the string less the last character"
125 (subseq s 0 (1- (length s))))
127 (defun string-hash (str &optional (bitmask 65535))
129 (declare (fixnum hash)
131 (dotimes (i (length str))
133 (setq hash (+ hash (char-code (char str i)))))
134 (logand hash bitmask)))
136 (defun string-not-null? (str)
137 (and str (not (zerop (length str)))))
139 (defun whitespace? (c)
140 (declare (character c))
141 (declare (optimize (speed 3) (safety 0)))
142 (or (char= c #\Space) (char= c #\Tab) (char= c #\Return) (char= c #\Linefeed)))
144 (defun not-whitespace? (c)
145 (not (whitespace? c)))
147 (defun string-ws? (str)
148 "Return t if string is all whitespace"
150 (null (find-if #'not-whitespace? str))))