conditions.lisp - clic - Clic is an command line interactive client for gopher … | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
conditions.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 … | |
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 &bo… | |
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 execu… | |
75 (:abort (format t \"This is only evaluated if PROTECTED-FORM abort… | |
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 ,gfla… | |
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 |