dev/macros.lisp

   1 (in-package #:trivial-shell)
   2
   3 ;; whatever...
   4 (defmacro with-gensyms (syms &body body)
   5   `(let ,(mapcar #'(lambda (s)
   6                      `(,s (gensym)))
   7                  syms)
   8      ,@body))
   9
  10 (defmacro with-stream-from-specifier ((stream stream-specifier direction
  11                                               &rest args)
  12                                       &body body)
  13   (with-gensyms (s close? result)
  14     `(let ((,close? t)
  15            ,s
  16            ,result)
  17       (unwind-protect
  18            (setf ,result
  19                  (multiple-value-list
  20                      (let (,stream)
  21                        (setf (values ,s ,close?)
  22                              (make-stream-from-specifier
  23                               ,stream-specifier ,direction ,@args))
  24                        (setf ,stream ,s)
  25                        ,@body)))
  26         (when (and ,close? ,s)
  27           (let ((it (close-stream-specifier ,s)))
  28             (when it
  29               (setf (first ,result) it)))))
  30        (values-list ,result))))
  31
  32 (defmacro with-input ((var source &rest args) &body body)
  33   "Create an input stream from source and bind it to var within the body of the with-input form. The stream will be closed if necessary on exit."
  34   `(with-stream-from-specifier (,var ,source :input ,@args)
  35      ,@body))
  36
  37 (defmacro with-output ((var destination &rest args) &body body)
  38   "Create an output stream from source and bind it to var within the body of the with-output form. The stream will be closed if necessary on exit."
  39   `(with-stream-from-specifier (,var ,destination :output ,@args)
  40      ,@body))
  41
  42 (defgeneric make-stream-from-specifier (specifier direction &rest args)
  43   (:documentation "Create and return a stream from specifier, direction and any other argsuments"))
  44
  45 (defgeneric close-stream-specifier (steam)
  46   (:documentation "Close a stream and handle other bookkeeping as appropriate."))
  47
  48 (defmethod make-stream-from-specifier ((stream-specifier stream)
  49                                        (direction symbol) &rest args)
  50   (declare (ignore args))
  51   (values stream-specifier nil))
  52
  53 (defmethod make-stream-from-specifier ((stream-specifier (eql t))
  54                                        (direction symbol) &rest args)
  55   (declare (ignore args))
  56   (values *standard-output* nil))
  57
  58 (defmethod make-stream-from-specifier ((stream-specifier (eql nil))
  59                                        (direction symbol) &rest args)
  60   (declare (ignore args))
  61   (values (make-string-output-stream) t))
  62
  63 (defmethod make-stream-from-specifier ((stream-specifier (eql :none))
  64                                        (direction symbol) &rest args)
  65   (declare (ignore args))
  66   (values nil nil))
  67
  68 (defmethod make-stream-from-specifier ((stream-specifier pathname)
  69                                        (direction symbol) &rest args)
  70   (values (apply #'open stream-specifier :direction direction args)
  71           t))
  72
  73 (defmethod make-stream-from-specifier ((stream-specifier string)
  74                                        (direction symbol) &rest args)
  75   (let ((start (getf args :start 0))
  76         (end (getf args :end)))
  77     (values (make-string-input-stream stream-specifier start end) nil)))
  78
  79 (defmethod make-stream-from-specifier ((stream-specifier string)
  80                                        (direction (eql :output)) &rest args)
  81   (let ((if-does-not-exist (getf args :if-does-not-exist :create)))
  82     (remf args :if-does-not-exist)
  83     (values (apply #'open stream-specifier
  84                    :direction direction :if-does-not-exist if-does-not-exist args)
  85             t)))
  86
  87 (defmethod close-stream-specifier (s)
  88   (close s)
  89   (values nil))
  90
  91 (defmethod close-stream-specifier ((s string-stream))
  92   (prog1
  93     (values (get-output-stream-string s))
  94     (close s)))