Commit c2854726 authored by Dave Cooper's avatar Dave Cooper
Browse files

added file output controls for with-format

parent 4c0b8f40
......@@ -132,9 +132,12 @@ view transforms, view scales, etc.
(let ((flag (gensym)))
`(let ((*%format%* (make-instance ',format ,@args)))
(let ((*stream* (if (or (stringp ,stream-or-file) (pathnamep ,stream-or-file))
(open ,stream-or-file :if-does-not-exist :create
:if-exists :supersede :direction :output
:external-format glisp:*external-text-format*)
(open ,stream-or-file
:if-does-not-exist (or (format-slot if-does-not-exist) :create)
:if-exists (or (format-slot if-exists) :error)
:direction (or (format-slot direction) :output)
:external-format (format-slot external-format)
:element-type (format-slot element-type))
,stream-or-file))
(,flag t))
(unwind-protect
......
......@@ -288,3 +288,71 @@ set to nil to improve memory performance.")
(defparameter *onclick-function* nil)
(defparameter *with-format-if-exists* :supersede
"keyword symbol. Establishes the default for the :if-exists
format-slot of the base-format. If you want to change this default
behavior, you can override this parameter globally or bind it
dynamically. Alternatively you can specify a different value
for :if-exists in the call to with-format. Valid keywords are the
same as for Common Lisp open or with-open-file. Default
is :supersede.
:example
<pre>
(let ((*with-format-if-exists* :error))
(with-format (x3d \"/tmp/box.x3d\")
(write-the-object (make-instance 'box :length 100 :width 100 :height 100) cad-output)))
(with-format (x3d \"/tmp/box.x3d\" :if-exists :error)
(write-the-object (make-instance 'box :length 100 :width 100 :height 100) cad-output)
</pre>
"
)
(defparameter *with-format-if-does-not-exist* :create
"keyword symbol. Establishes the default for the :if-does-not-exist
format-slot of the base-format. If you want to change this default
behavior, you can override this parameter globally or bind it
dynamically. Alternatively you can specify a different value
for :if-does-not-exist in the call to with-format. Valid keywords are
the same as for Common Lisp open or with-open-file. Default
is :create.
:example
<pre>
(let ((*with-format-if-does-not-exist* :error))
(with-format (x3d \"/tmp/box.x3d\")
(write-the-object (make-instance 'box :length 100 :width 100 :height 100) cad-output)))
(with-format (x3d \"/tmp/box.x3d\" :if-does-not-exist :error)
(write-the-object (make-instance 'box :length 100 :width 100 :height 100) cad-output)
</pre>
"
)
(defparameter *with-format-direction :output
"keyword symbol. Establishes the default for the :direction
format-slot of the base-format. If you want to change this default
behavior, you can override this parameter globally or bind it
dynamically. Alternatively you can specify a different value
for :direction in the call to with-format. Valid keywords are the
same as for Common Lisp open or with-open-file. Default
is :output. Normally this should not be changed in user code.")
(defparameter *with-format-external-format* glisp:*external-text-format*
"External-format. The default for the :external-format format-slot
for the base format. Defaults to glisp:*external-text-format*.")
;;
;; FLAG -- determine what this should really be, i.e. establish a glisp:*element-type-default*
;;
(defparameter *with-format-element-type* nil
"Element-type. The default for the :element-type format-slot
for the base format. Defaults to nil. Needs a better default.")
......@@ -991,7 +991,12 @@ a separate object hierarchy." object self)))
(define-format base-format ()
:slots ((foreground-color nil) (background-color nil))
:slots ((foreground-color nil) (background-color nil)
(if-exists *with-format-if-exists*)
(if-does-not-exist *with-format-if-does-not-exist*)
(direction *with-format-direction)
(external-format *with-format-external-format*)
(element-type *with-format-element-type*))
:functions
((initialize-output ())
......
......@@ -106,8 +106,12 @@ supports a full range of output options such as page dimensions, view transforms
`(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
:if-exists :supersede :direction :output
(open ,stream-or-file
:if-does-not-exist (or (format-slot if-does-not-exist) :create)
:if-exists (or (format-slot if-exists) :error)
:direction (or (format-slot direction) :output)
:external-format (format-slot external-format)
:element-type (format-slot element-type)
;; 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.
......
......@@ -176,7 +176,10 @@ Default is the standard doctype for HTML5 and later."
Default nil."
use-jquery? nil :settable)
(use-raphael? nil)
(use-x3dom? nil)
("String. The title of the web page. Defaults to \"Genworks GDL -\"
.followed by the strings-for-display."
......@@ -212,9 +215,9 @@ interface. Defaults to nil."
:trickle-down-slots (respondent)
:computed-slots ((use-raphael? nil)
:computed-slots (
(use-x3dom? nil)
("String of HTML. Provides the developer control links for current sheet."
development-links
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment