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

try to make images work in yadd

parent 1754506e
......@@ -221,7 +221,7 @@ If you specify :part-symbol-supplied, do not specify :instance-supplied."))
(princ (the example-code) out))
(let (*redefinition-warnings*) (load (compile-file (the lisp-file))))) :uncached)
(image-file (merge-pathnames (funcall gdl::*make-temp-file-name-func*) #p"*.png"))
(image-file (glisp:temporary-file :extension "png"))
(image-url (format nil "/images/~a" (make-pathname :name (pathname-name (the image-file))
:type (pathname-type (the image-file)))))
......@@ -478,14 +478,7 @@ If you specify :part-symbol-supplied, do not specify :instance-supplied."))
pdf-file)))
(let ((return-value
(#+allegro
run-shell-command
#+lispworks system:call-system
#+cmu asdf:run-shell-command
command
#+allegro :show-window
#+allegro :hide)))
(glisp:run-shell-command command :show-window? nil)))
(with-http-response (req ent)
(setf (reply-header-slot-value req :cache-control) "no-cache")
(setf (reply-header-slot-value req :pragma) "no-cache")
......@@ -832,11 +825,9 @@ If you specify :part-symbol-supplied, do not specify :instance-supplied."))
(:body (the (write-back-link :display-string "<-Back"))
(:h2 (:center "Example in VRML format"))
(:p (let ((vrml-url (string-append "/vrml/"
(file-namestring
(make-pathname
:name
(pathname-name
(funcall gdl::*make-temp-file-name-func*)) :type "wrl")))))
(namestring
(glisp:temporary-file :extension "wrl")))))
(publish :path vrml-url
:content-type "x-world/x-vrml"
:function #'(lambda(req ent)
......
......@@ -54,9 +54,8 @@ The javascript loaded is jquery."
((:script :type "text/javascript"
:src "/static/3rdpty/jquery/js/jquery.quicksearch.js"))))
(footer (let* ((updater (make-object 'gwl::gdl-updater))
(version (the-object updater gdl-version))
(patch (the-object updater gdl-patchlevel)))
(footer (let* ((version "1581")
(patch 9))
(with-cl-who-string ()
((:p :class "copyrightFooter")
"Copyright © "
......@@ -86,9 +85,8 @@ The javascript loaded is jquery."
(write-footer
()
(let ((*stream* (or *html-stream* *stream*)))
(let* ((updater (make-object 'gwl::gdl-updater))
(version (the-object updater gdl-version))
(patch (the-object updater gdl-patchlevel)))
(let* ((version "1581")
(patch 9))
(with-cl-who()
((:p :class "copyrightFooter")
"Copyright © "
......
......@@ -5,12 +5,13 @@
(:use :common-lisp)
(:export #:get-pid
#:run-gs
#:run-shell-command
#:set-gs-path
)))
(defun featurep (x)
#+allegro (excl:featurep x)
#+lispworks (system:featurep x)
......@@ -20,6 +21,38 @@
(defun get-pid ()
#+allegro (excl.osi:getpid)
#+lispworks (multiple-value-bind (status pid)
(system:call-system-showing-output "echo $PPID"
:show-cmd nil :output-stream nil)
(declare (ignore status))
(read-from-string pid))
#-(or allegro lispworks)
(error "Need implementation for get-pid for currently running lisp~%"))
(defun run-gs (command)
"Shell out a ghostscript command and handle errors."
#-allegro (let ((result (asdf-utilities:run-shell-command command)))
(unless (zerop result) (error "Ghostscript threw error")))
#+allegro
(multiple-value-bind (output error return)
(excl.osi:command-output command)
(unless (zerop return) (error "Ghostscript command threw error. Result was:
output: ~a
error: ~a
return: ~a"
output error return))))
(defun run-shell-command (command &rest args)
;;
;; FLAG -- add specific keyword args e.g. for hide-window?
;;
(asdf-utilities:run-shell-command command))
(defun set-gs-path (&optional gs-path)
(if (featurep :mswindows)
(let (found-path)
......@@ -51,29 +84,4 @@
(when (and (stringp gdl:*gs-path*) (string-equal gdl:*gs-path* "gs")) (warn "Gnu Ghostscript (\"gs\") was not found
in either /usr/local/bin or /usr/bin -- we assume it is elsewhere in your execution path
so we are setting it simply to \"gs\". If Gnu Ghostscript is not installed on your Unix/Linux
system, please contact Genworks for assistance in installing it.")))))
(defun get-pid ()
#+allegro (excl.osi:getpid)
#+lispworks (multiple-value-bind (status pid)
(system:call-system-showing-output "echo $PPID"
:show-cmd nil :output-stream nil)
(declare (ignore status))
(read-from-string pid))
#-(or allegro lispworks)
(error "Need implementation for get-pid for currently running lisp~%"))
(defun run-gs (command)
"Shell out a ghostscript command and handle errors."
#-allegro (let ((result (asdf-utilities:run-shell-command command)))
(unless (zerop result) (error "Ghostscript threw error")))
#+allegro
(multiple-value-bind (output error return)
(excl.osi:command-output command)
(unless (zerop return) (error "Ghostscript command threw error. Result was:
output: ~a
error: ~a
return: ~a"
output error return))))
system, please contact Genworks for assistance in installing it.")))))
\ No newline at end of file
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