Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
(in-package :able)
(defmacro when-string (string &optional (other t) &body body)
"Evaluate body if string is valid (non-null and non-empty)."
`(when (and ,string (> (length ,string) 0) ,other)
,@body))
(defmacro when-let ((var form) &body body)
`(let ((,var ,form))
(when ,var
,@body)))
(defmacro equal-case (keyform &body clauses)
`(cond ,@(loop for clause in clauses collect
(destructuring-bind (test exec) clause
(if (or (eql test t) (eql test 'otherwise))
`(t ,exec)
`((equal ,keyform ,test) ,exec))))))
(defmacro with-status-msg (msg &rest body)
`(progn (info-message ,msg) ,@body (no-message)))
(defmacro with-able-streams (stream &body body)
"Bind all interesting streams to STREAM during BODY"
`(let* ((stream (make-instance ,stream))
(*standard-output* stream)
(*trace-output* stream)
;(*error-output* stream)
(*standard-input* stream)
(*terminal-io* stream)
(*debug-io* stream))
,@body
(flush stream)))
(defmacro with-temporary-value (place temporary &body body)
"A simple transactional re-binding of a variable which is unwound at the
end of the block. Note that the following semantics are in operation: an
error condition raised by code in the body will be caught, the original
value will be restored and the error condition wil be re-raised for the
calling code to handle. Not intended as a replacement for specials!"
`(let ((original ,place))
(setf ,place ,temporary)
(handler-case
(progn ,@body)
(error (ex)
(progn
(setf ,place original)
(error ex))))
(setf ,place original)))
(defmacro get-indent-level (token)
"Deduce how much to indent based on the token supplied. The user
can supply their own indentation rules in the configuration file."
`(cond
((equal (char ,token 0) +lparen+) 1)
((equal (length ,token) 1) 3)
,@(mapcar #'(lambda (rule)
`((equalp ,token ,(car rule)) ,(cdr rule)))
*indentation-rules*)
(t 2)))