conditions.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
 (HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
 (DIR) Log
 (DIR) Files
 (DIR) Refs
 (DIR) Tags
 (DIR) README
 (DIR) 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 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