X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=dev%2Fgraphviz%2Fgraphviz-support.lisp;h=1ea586a6f170b13fe09249605a91adeb232395af;hb=7090c13854c379b6eb139bea25d873fe2a5eb668;hp=aec3b994ab5297c1d27fc97637c3e29a0be80cda;hpb=967f37e2d82bf3bcf47a644686eed00e293b50aa;p=cl-graph.git diff --git a/dev/graphviz/graphviz-support.lisp b/dev/graphviz/graphviz-support.lisp index aec3b99..1ea586a 100644 --- a/dev/graphviz/graphviz-support.lisp +++ b/dev/graphviz/graphviz-support.lisp @@ -341,24 +341,26 @@ B--D [] (:export-p t)) -(defmethod (setf dot-attribute-value) :before (value (attr symbol) (thing dot-attributes-mixin)) +(defmethod (setf dot-attribute-value) + :before (value (attr symbol) (thing dot-attributes-mixin)) (declare (ignore value)) (ensure-valid-dot-attribute attr thing)) -(defmethod (setf dot-attribute-value) (value (attr symbol) (thing dot-attributes-mixin)) +(defmethod (setf dot-attribute-value) + (value (attr symbol) (thing dot-attributes-mixin)) (setf (getf (dot-attributes thing) attr) value)) (defmethod dot-attribute-value ((attr symbol) (thing dot-attributes-mixin)) (getf (dot-attributes thing) attr)) (defmacro defpixel-inch-accessors (name attr type) - (bind ((actual-name (form-symbol name "-IN-PIXELS"))) + (let ((actual-name (form-symbol name (symbol-name '-in-pixels)))) `(progn - (export ',actual-name) + (eval-always (export ',actual-name)) (defmethod ,actual-name ((thing ,type)) "Return the attribute in pixels assuming 72 dpi" - (awhen (dot-attribute-value ,attr thing) - (* 72 it))) + (when (dot-attribute-value ,attr thing) + (* 72 (dot-attribute-value ,attr thing)))) (defmethod (setf ,actual-name) (value (thing ,type)) "Set the attribute in pixels assuming 72 dpi" (setf (dot-attribute-value ,attr thing) @@ -497,9 +499,10 @@ B--D [] (defmethod graph->dot-external ((g basic-graph) file-name &key (type :ps)) "Generate an external represenation of a graph to a file, by running the program in *dot-path*." + (declare (ignorable file-name)) (let ((dot-string (graph->dot g nil)) (dot-type (concatenate 'string "-T" (string-downcase (symbol-name type))))) - (declare (ignorable dot-string dot-type file-name)) + (declare (ignorable dot-string dot-type)) #+lispworks (with-open-stream (s (sys:open-pipe (concatenate 'string *dot-path* " -Tpng -o" file-name) :direction :input)) @@ -514,10 +517,10 @@ the program in *dot-path*." #-(or sbcl lispworks) (error "Don't know how to execute a program on this platform"))) -;;; --------------------------------------------------------------------------- -; +;;; ; Test dot external -; + +#+test (defun test-dot-external () (let* ((g (make-graph 'dot-graph)) (v1 (add-vertex g 'a :dot-attributes '(:shape :box