tconditions.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
HTML git clone git://bitreich.org/clic/ git://hg6vgqziawt5s4dj.onion/clic/
DIR Log
DIR Files
DIR Refs
DIR Tags
DIR LICENSE
---
tconditions.lisp (3363B)
---
1 (in-package :alexandria)
2
3 (defun required-argument (&optional name)
4 "Signals an error for a missing argument of NAME. Intended for
5 use as an initialization form for structure and class-slots, and
6 a default value for required keyword arguments."
7 (error "Required argument ~@[~S ~]missing." name))
8
9 (define-condition simple-style-warning (simple-warning style-warning)
10 ())
11
12 (defun simple-style-warning (message &rest args)
13 (warn 'simple-style-warning :format-control message :format-arguments args))
14
15 ;; We don't specify a :report for simple-reader-error to let the
16 ;; underlying implementation report the line and column position for
17 ;; us. Unfortunately this way the message from simple-error is not
18 ;; displayed, unless there's special support for that in the
19 ;; implementation. But even then it's still inspectable from the
20 ;; debugger...
21 (define-condition simple-reader-error
22 #-sbcl(simple-error reader-error)
23 #+sbcl(sb-int:simple-reader-error)
24 ())
25
26 (defun simple-reader-error (stream message &rest args)
27 (error 'simple-reader-error
28 :stream stream
29 :format-control message
30 :format-arguments args))
31
32 (define-condition simple-parse-error (simple-error parse-error)
33 ())
34
35 (defun simple-parse-error (message &rest args)
36 (error 'simple-parse-error
37 :format-control message
38 :format-arguments args))
39
40 (define-condition simple-program-error (simple-error program-error)
41 ())
42
43 (defun simple-program-error (message &rest args)
44 (error 'simple-program-error
45 :format-control message
46 :format-arguments args))
47
48 (defmacro ignore-some-conditions ((&rest conditions) &body body)
49 "Similar to CL:IGNORE-ERRORS but the (unevaluated) CONDITIONS
50 list determines which specific conditions are to be ignored."
51 `(handler-case
52 (progn ,@body)
53 ,@(loop for condition in conditions collect
54 `(,condition (c) (values nil c)))))
55
56 (defmacro unwind-protect-case ((&optional abort-flag) protected-form &body clauses)
57 "Like CL:UNWIND-PROTECT, but you can specify the circumstances that
58 the cleanup CLAUSES are run.
59
60 clauses ::= (:NORMAL form*)* | (:ABORT form*)* | (:ALWAYS form*)*
61
62 Clauses can be given in any order, and more than one clause can be
63 given for each circumstance. The clauses whose denoted circumstance
64 occured, are executed in the order the clauses appear.
65
66 ABORT-FLAG is the name of a variable that will be bound to T in
67 CLAUSES if the PROTECTED-FORM aborted preemptively, and to NIL
68 otherwise.
69
70 Examples:
71
72 (unwind-protect-case ()
73 (protected-form)
74 (:normal (format t \"This is only evaluated if PROTECTED-FORM executed normally.~%\"))
75 (:abort (format t \"This is only evaluated if PROTECTED-FORM aborted preemptively.~%\"))
76 (:always (format t \"This is evaluated in either case.~%\")))
77
78 (unwind-protect-case (aborted-p)
79 (protected-form)
80 (:always (perform-cleanup-if aborted-p)))
81 "
82 (check-type abort-flag (or null symbol))
83 (let ((gflag (gensym "FLAG+")))
84 `(let ((,gflag t))
85 (unwind-protect (multiple-value-prog1 ,protected-form (setf ,gflag nil))
86 (let ,(and abort-flag `((,abort-flag ,gflag)))
87 ,@(loop for (cleanup-kind . forms) in clauses
88 collect (ecase cleanup-kind
89 (:normal `(when (not ,gflag) ,@forms))
90 (:abort `(when ,gflag ,@forms))
91