1 ;; Common Lisp bindings for GTK+ v2.x
2 ;; Copyright 1999-2005 Espen S. Johnsen <espen@users.sf.net>
4 ;; Permission is hereby granted, free of charge, to any person obtaining
5 ;; a copy of this software and associated documentation files (the
6 ;; "Software"), to deal in the Software without restriction, including
7 ;; without limitation the rights to use, copy, modify, merge, publish,
8 ;; distribute, sublicense, and/or sell copies of the Software, and to
9 ;; permit persons to whom the Software is furnished to do so, subject to
10 ;; the following conditions:
12 ;; The above copyright notice and this permission notice shall be
13 ;; included in all copies or substantial portions of the Software.
15 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
16 ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
17 ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
18 ;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
19 ;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
20 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
21 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
23 ;; $Id: utils.lisp,v 1.1 2006-03-29 09:51:55 espen Exp $
25 (defpackage #:clg-utils
27 (:export #:read-lines #:mklist #:namep #:funcallable #:return-if #:when-bind
28 #:visible-char-p #:whitespace-p #:split-string-if #:split-string
29 #:concatenate-strings #:string-prefix-p #:get-all))
31 (in-package #:clg-utils)
33 (defun read-lines (&optional (stream *standard-input*))
34 "Read lines from STREAM until end of file."
36 as line = (read-line stream nil)
41 (if (and obj (atom obj)) (list obj) obj))
44 (and (symbolp obj) (not (member obj '(t nil)))))
46 (defun funcallable (object)
51 (defmacro return-if (form)
52 (let ((result (make-symbol "RESULT")))
53 `(let ((,result ,form))
57 (defmacro when-bind ((var expr) &body body)
62 (defun visible-char-p (char)
63 (and (graphic-char-p char) (char/= char #\space)))
65 (defun whitespace-p (char)
66 (not (visible-char-p char)))
68 (defun split-string-if (string predicate)
69 (declare (simple-string string))
70 (let ((pos (position-if predicate string :start 1)))
75 (split-string-if (subseq string pos) predicate)))))
77 (defun split-string (string &optional (delimiter #'whitespace-p)
78 &key (start 0) (end (length string)))
79 (let* ((predicate (if (functionp delimiter)
82 (find char (mklist delimiter) :test #'char=))))
83 (from (position-if-not predicate string :start start)))
85 (let ((to (position-if predicate string :start from :end end)))
87 (subseq string from (or to end))
89 (split-string string predicate :start to :end end)))))))
91 (defun concatenate-strings (strings &optional delimiter)
92 (if (not (rest strings))
97 (if delimiter (string delimiter) "")
98 (concatenate-strings (rest strings) delimiter))))
100 (defun string-prefix-p (prefix string)
102 (>= (length string) (length prefix))
103 (string= prefix string :end2 (length prefix))))
105 (defun get-all (plist property)
106 (multiple-value-bind (property value tail)
107 (get-properties plist (list property))
109 (cons value (get-all (cddr tail) property)))))