with-format supersedes implicty
Created by: reiniervandijk
Example of dangerous implicit coding: with-format defines inside macro body:
(open ,stream-or-file :if-does-not-exist :create
:if-exists :supersede :direction :output )
This is dangerous, because your deviating from the default (and therefore expected) common-lisp behavior without any notification or control to the user. By default in common-lisp, recreating already existing files would lead to an error. However, you have already decided to :supersede existing files, with the risk that someone unnecessarily loses data. I would strongly suggest to either document these premises or to allow the user control over this process.
Imported comments:
By genworks on 2015-01-29 23:58:49 UTC
Open for submissions: $100
This would have to be controlled with a global parameter to allow legacy behavior to continue.
By reiniervandijk on 2015-01-30 13:25:53 UTC
Fix with global parameter. I leave it up to you to move parameter to different package. For examples, check the docstrings:
(in-package :geom-base)
(defparameter *with-format-if-exists* :supersede
"keyword. For use in combination with with-format macro. In case data is written to a file,
the default behavior is to supersede any existing file. If you want to change this default
behavior, override this parameter. For an overview of all valid keywords check with-open-file
documentation in hyperspecs. Default: :supersede.
:example
<pre>
(let ((geom-base::*with-format-if-exists* :error))
(gdl::with-format (pdf \"/tmp/box.pdf\" :view-transform (getf *standard-views* :trimetric))
(write-the-object (make-instance 'box :length 100 :width 100 :height 100) cad-output)))
</pre>
")
(defmacro with-format ((format stream-or-file &rest args) &body body)
"Void [Macro]. Used to establish an output format and a stream to which data is to be sent. This
supports a full range of output options such as page dimensions, view transforms, view scales, etc.
:example
<pre>
(gdl::with-format (pdf \"/tmp/box.pdf\" :view-transform (getf *standard-views* :trimetric))
(write-the-object (make-instance 'box :length 100 :width 100 :height 100) cad-output))
</pre>
In case data is written to a file, the default behavior is to :supersede any existing file. If you
want to change this default behavior, override the *with-format-if-exists* parameter.
:example
<pre>
(let ((geom-base::*with-format-if-exists* :error))
(gdl::with-format (pdf \"/tmp/box.pdf\" :view-transform (getf *standard-views* :trimetric))
(write-the-object (make-instance 'box :length 100 :width 100 :height 100) cad-output)))
</pre>
"
(let ((flag (gensym))
(if-exists *with-format-if-exists*))
(let (;;(external-format (getf args :external-format))
;;(element-type (getf args :element-type))
(args (remove-plist-keys args (list :external-format))))
`(let ((*%format%* (make-instance ',format ,@args))
(file? (or (stringp ,stream-or-file) (pathnamep ,stream-or-file))))
(let ((*stream* (if file?
(open ,stream-or-file
:if-does-not-exist :create
;; fixes #131
:if-exists ,if-exists
:direction :output
;; FLAG -- below element-type seems necessary for generate-sample-drawing
;; from an aserve thread on CCL (at least). Make this as a passable
;; arg for with-format png and other known binary types.
;;:element-type '(unsigned-byte 8)
;;:external-format ,(or external-format :default)
)
,stream-or-file))
(,flag t))
(unwind-protect
(progn (multiple-value-prog1
,(case format
(pdf `(let ((path (glisp:temporary-file)))
(pdf:with-document()
(pdf:with-page (:bounds (make-array 4 :initial-contents
(list 0 0 (format-slot page-width)
(format-slot page-length))))
(with-format-slots (page-width page-length background-color)
(setq background-color (coerce (lookup-color background-color
:ground :background) 'list))
(pdf:with-saved-state
(apply #'pdf:set-rgb-stroke (coerce background-color 'list))
(apply #'pdf:set-rgb-fill (coerce background-color 'list))
(pdf:move-to 0 0)
(pdf:line-to page-width 0)
(pdf:line-to page-width page-length) (pdf:line-to 0 page-length)
(pdf:line-to 0 0) (pdf:fill-and-stroke)))
(with-format-slots (page-width page-length)
(pdf:translate (half page-width) (half page-length)))
,@body)
(pdf:write-document (if file? ,stream-or-file path)))
(when (and *stream* (not file?))
(with-open-file (in path
:element-type '(unsigned-byte 8))
(do ((val (read-byte in nil nil) (read-byte in nil nil)))
((null val))
(write-byte val *stream*))))
(when (probe-file path) (delete-file path))))
;;
;; FLAG -- update multipage to match pdf case behavior
;;
(pdf-multipage `(let ((path (glisp:temporary-file)))
(pdf:with-document() ,@body
(pdf:write-document (if file? ,stream-or-file path)))
(when (and *stream* (not file?))
(with-open-file (in path :element-type '(unsigned-byte 8))
(do ((val (read-byte in nil nil) (read-byte in nil nil)))
((null val))
(write-byte val *stream*))))
(when (probe-file path) (delete-file path))))
#+nil
(pdf-multipage `(pdf:with-document() ,@body
(when *stream* (pdf:write-document *stream*))))
;;
;; FLAG -- consider having default
;; initialize-output and finalize-output
;; methods instead of these special
;; cases. Special case is only really
;; needed when we need to wrap things like
;; in PDF.
;;
(dxf `(progn (write-string *dxf-header* *stream*)
,@body
(write-string *dxf-footer* *stream*)))
(otherwise `(progn (write-env (initialize-output) )
,@body
(write-env (finalize-output)))))
(setq ,flag nil)))
(when (and (or (stringp ,stream-or-file) (pathnamep ,stream-or-file)) (streamp *stream*))
(close *stream* :abort ,flag))) nil)))))
By genworks on 2015-03-18 17:16:27 UTC
Added format-slots for controlling this (and other args to cl:open), which get their defaults from globals -- rather than having to control directly with a global parameter. Also applied to original definition of with-format in case :geom-base system component is not loaded. Fix is merged into devo branch.