/[linedit]/src/utility-macros.lisp
ViewVC logotype

Contents of /src/utility-macros.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (show annotations)
Mon Apr 12 12:38:41 2004 UTC (10 years ago) by nsiivola
Branch: MAIN
CVS Tags: HEAD
Changes since 1.6: +7 -6 lines
 * Make completion not stuble on logical pathnames.
 * Fix META-ESCAPE to deal with character literals. Not 100% sure this is the right fix, though, but seems to do the job.
1 ;; Copyright (c) 2003 Nikodemus Siivola
2 ;;
3 ;; Permission is hereby granted, free of charge, to any person obtaining
4 ;; a copy of this software and associated documentation files (the
5 ;; "Software"), to deal in the Software without restriction, including
6 ;; without limitation the rights to use, copy, modify, merge, publish,
7 ;; distribute, sublicense, and/or sell copies of the Software, and to
8 ;; permit persons to whom the Software is furnished to do so, subject to
9 ;; the following conditions:
10 ;;
11 ;; The above copyright notice and this permission notice shall be included
12 ;; in all copies or substantial portions of the Software.
13 ;;
14 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
15 ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
16 ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
17 ;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
18 ;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
19 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
20 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
21
22 (in-package :linedit)
23
24 (defmacro aif (condition consequent &optional alternative)
25 `(let ((it ,condition))
26 (if it
27 ,consequent
28 ,alternative)))
29
30 (defmacro acase (form &rest cases)
31 `(let ((it ,form))
32 (case it
33 ,@cases)))
34
35 (defmacro with-unique-names ((&rest bindings) &body body)
36 `(let ,(mapcar #'(lambda (binding)
37 (destructuring-bind (var prefix)
38 (if (consp binding) binding (list binding binding))
39 `(,var (gensym ,(string prefix)))))
40 bindings)
41 ,@body))
42
43 (defmacro awhen (condition &body body)
44 `(aif ,condition
45 (progn ,@body)))
46
47 (defmacro do-internal-symbols ((var package) &body forms)
48 (with-unique-names (state)
49 `(do-symbols (,var ,package)
50 (multiple-value-bind (,var ,state)
51 (find-symbol (symbol-name ,var) ,package)
52 (when (eq ,state :internal)
53 ,@forms)))))
54
55 (defmacro invariant (condition)
56 (with-unique-names (value)
57 `(let ((,value ,condition))
58 (unless ,value
59 (let ((*print-pretty* nil))
60 (error "BUG: You seem to have found a bug in Linedit. Please report~
61 this incident along with directions to reproduce and the ~
62 following message to linedit-devel@common-lisp.net:~
63 ~
64 `Invariant ~S violated.'"
65 ',condition))))))
66
67 (defmacro ensure (symbol expr)
68 `(or ,symbol (setf ,symbol ,expr)))
69
70 (defmacro dbg-values (&rest places)
71 `(when *debug*
72 (format *debug* ,(apply #'concatenate 'string
73 (mapcar (lambda (x)
74 (format nil "~A = ~~A, " x))
75 places))
76 ,@places)
77 (terpri *debug*)
78 (force-output *debug*)))
79
80

  ViewVC Help
Powered by ViewVC 1.1.5