Commit 9c5038f3 authored by Dave Cooper's avatar Dave Cooper

updated quicklisp

parent 7fc7e8d3
......@@ -172,6 +172,33 @@ the format object, optionally with arguments. Typically these functions will out
:arguments (function-calls \"(&rest). Functions on the named output-format to be called.\")
:example
<pre>
(with-format (base-format my-object) (write-env (:a \"Hello World, my object's length is: \")
(:a (the length))))
</pre>"
`(progn
,@(mapcar #'(lambda(method-call)
(typecase method-call
(string `(write-string ,method-call *stream*))
(otherwise (if (atom (first method-call))
`(,(glisp:intern (symbol-name (first method-call)) :gdl-format)
*%format%* ,@(rest method-call))
`(funcall (glisp:intern (symbol-name (apply (function ,(first (first method-call)))
',(rest (first method-call))))
:gdl-format)
*%format%* ,@(rest method-call))))))
method-calls)))
#+nil
(defmacro write-env (&rest method-calls)
"Void [Macro] (usually used just for outputting). Within the context of a <tt>with-format</tt>, calls functions of
the format object, optionally with arguments. Typically these functions will output data to the
<tt>stream</tt> established by the <tt>with-format</tt>.
:arguments (function-calls \"(&rest). Functions on the named output-format to be called.\")
:example
<pre>
(with-format (base-format my-object) (write-env (:a \"Hello World, my object's length is: \")
......
......@@ -92,7 +92,11 @@
(defun executable-homedir-pathname ()
#+allegro (translate-logical-pathname "sys:")
#+sbcl (make-pathname :name nil :type nil :defaults sb-ext:*core-pathname*)
#+(or lispworks ccl ecl clisp) (make-pathname :name nil :type nil :defaults (first (glisp:basic-command-line-arguments)))
#+(or lispworks ccl ecl clisp)
(let* ((exe (first (glisp:basic-command-line-arguments)))
(exe-dir (pathname-directory exe)))
(if (eql (first exe-dir) :relative) (uiop/os:getcwd)
(make-pathname :name nil :type nil :defaults exe)))
#+abcl
(warn "Don't know how to get executable-homedir-pathname on ~a! Please find out.~%"
(lisp-implementation-type)))
......
......@@ -80,9 +80,9 @@ supports a full range of output options such as page dimensions, view transforms
(dxf `(progn (write-string *dxf-header* *stream*)
,@body
(write-string *dxf-footer* *stream*)))
(otherwise `(progn (write-env (initialize-output) )
(otherwise `(progn (write-env (:initialize-output) )
,@body
(write-env (finalize-output)))))
(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)))))
......@@ -183,9 +183,9 @@ supports a full range of output options such as page dimensions, view transforms
(dxf `(progn (write-string *dxf-header* *stream*)
,@body
(write-string *dxf-footer* *stream*)))
(otherwise `(progn (write-env (initialize-output) )
(otherwise `(progn (write-env (:initialize-output) )
,@body
(write-env (finalize-output)))))
(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)))))
......@@ -36,7 +36,7 @@ output is coming later.")
(pdf:line-to 0 high-bar) (pdf:stroke)
(pdf:translate spacing 0) (pdf:move-to 0 0)
(dolist (digit digits)
(write-env (postnet-digit digit high-bar low-bar spacing)))
(write-env (:postnet-digit digit high-bar low-bar spacing)))
(pdf:line-to 0 high-bar) (pdf:stroke))))
......
......@@ -664,7 +664,11 @@ please find implementation for the currently running lisp.~%")
(cons (when options (format nil "-~{~a~}" options))
(append
(mapcar #'(lambda(option) (concatenate 'string "--" option)) long-form-options)
(list (expanded-pathname-string (namestring source)))
(progn
(gdl:print-variables source)
(gdl:print-variables (namestring source))
(gdl:print-variables (expanded-pathname-string (namestring source)))
(list (expanded-pathname-string (namestring source))))
(list (if (search ":" (namestring dest)) dest
(expanded-pathname-string (namestring dest))))))))))
(when (or print-command? dry-run?) (format t "~s~%" command-list))
......
......@@ -65,7 +65,7 @@
(base64-encode-safe (format nil "~s" yason-string))))
#+nil
(defun yasonify (value)
(cond ((or (null value) (eql value t) (numberp value) (stringp value)) value)
((vectorp value) (map 'vector #'yasonify value))
......@@ -77,7 +77,7 @@
finally (print-hash hash) (return hash)))
(t (mapcar #'yasonify value))))
#+nil
(defun yasonify (value)
(cond ((or (null value) (eql value t) (numberp value) (stringp value)) value)
((vectorp value) (map 'vector #'yasonify value))
......
......@@ -226,9 +226,9 @@
(if assembly?
(write-env (assembly-output))
(progn
(write-env (objects-output))
(write-env (:objects-output))
;;(write-env (a "%Finalized Output"))
(write-env (newline-out))))))))
(write-env (:newline-out))))))))
......@@ -238,9 +238,9 @@
:functions ((finalize-output
()
(write-env (objects-output))
(write-env (a "// Finalized Output"))
(write-env (newline-out)))
(write-env (:objects-output))
(write-env (:a "// Finalized Output"))
(write-env (:newline-out)))
(objects-output
()
......
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