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.2 2006-04-25 20:26:04 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
32 (in-package #:clg-utils)
34 (defun read-lines (&optional (stream *standard-input*))
35 "Read lines from STREAM until end of file."
37 as line = (read-line stream nil)
42 (if (and obj (atom obj)) (list obj) obj))
45 (and (symbolp obj) (not (member obj '(t nil)))))
47 (defun funcallable (object)
52 (defmacro return-if (form)
53 (let ((result (make-symbol "RESULT")))
54 `(let ((,result ,form))
58 (defmacro when-bind ((var expr) &body body)
63 (defun visible-char-p (char)
64 (and (graphic-char-p char) (char/= char #\space)))
66 (defun whitespace-p (char)
67 (not (visible-char-p char)))
69 (defun split-string-if (string predicate)
70 (declare (simple-string string))
71 (let ((pos (position-if predicate string :start 1)))
76 (split-string-if (subseq string pos) predicate)))))
78 (defun split-string (string &key (delimiter #'whitespace-p)
79 (start 0) (end (length string)))
80 (let* ((predicate (if (functionp delimiter)
83 (find char (mklist delimiter) :test #'char=))))
84 (from (position-if-not predicate string :start start)))
86 (let ((to (position-if predicate string :start from :end end)))
88 (subseq string from (or to end))
90 (split-string string :delimiter predicate :start to :end end)))))))
92 (defun concatenate-strings (strings &optional delimiter)
93 (if (not (rest strings))
98 (if delimiter (string delimiter) "")
99 (concatenate-strings (rest strings) delimiter))))
101 (defun string-prefix-p (prefix string)
103 (>= (length string) (length prefix))
104 (string= prefix string :end2 (length prefix))))
106 (defun get-all (plist property)
107 (multiple-value-bind (property value tail)
108 (get-properties plist (list property))
110 (cons value (get-all (cddr tail) property)))))
113 (defun delete-collect-if (predicate seq)
114 (let ((head (cons nil seq)))
119 when (funcall predicate (second tmp))
120 collect (let ((elm (second tmp)))
121 (setf (cdr tmp) (cddr tmp))