Skip to content
Snippets Groups Projects
Commit 41a8881d authored by Duane Rettig's avatar Duane Rettig
Browse files

2009-05-04 Duane Rettig <duane@franz.com>

	* clim/graph-formatting.lisp: bug18430: Fix dynamic-extent warning
	* misc/compile-1.lisp: bug18430: Fix compiler-switch for 8.2
	* tk-silica/xm-gadgets.lisp: bug18430: Add ignore declaration
parent 8f0abe4d
No related branches found
No related tags found
No related merge requests found
......@@ -6,6 +6,12 @@ join from trunk_afuchs4 to trunk
2008-09-23 Andreas Fuchs <afuchs@franz.com>
*******************************************************************************
2009-05-04 Duane Rettig <duane@franz.com>
* clim/graph-formatting.lisp: bug18430: Fix dynamic-extent warning
* misc/compile-1.lisp: bug18430: Fix compiler-switch for 8.2
* tk-silica/xm-gadgets.lisp: bug18430: Add ignore declaration
2009-03-17 Andreas Fuchs <afuchs@franz.com>
* silica/medium.lisp: Define condition unsupported-ink: signaled when a medium
......
......@@ -177,34 +177,8 @@
(graph-node-children record) nil)
t))
;; For compatibility...
(defun format-graph-from-root (root-object object-printer inferior-producer
&rest keys
&key (stream *standard-output*)
(orientation ':horizontal) (center-nodes nil)
(cutoff-depth nil)
(merge-duplicates nil)
(graph-type (if merge-duplicates :digraph :tree))
(key #'identity) (test #'eql)
(arc-drawer #'draw-linear-arc)
(arc-drawing-options nil)
(generation-separation
*default-generation-separation*)
(within-generation-separation
*default-within-generation-separation*)
(maximize-generations #+allegro t #-allegro nil)
(store-objects t) (move-cursor t))
(declare (dynamic-extent keys object-printer inferior-producer)
(ignore stream orientation center-nodes cutoff-depth
arc-drawer arc-drawing-options graph-type move-cursor store-objects
generation-separation within-generation-separation maximize-generations))
(with-keywords-removed (keys keys '(:merge-duplicates :key :test))
(apply #'format-graph-from-roots
(list root-object) object-printer inferior-producer
(if merge-duplicates
(append `(:merge-duplicates ,merge-duplicates
:duplicate-key ,key :duplicate-test ,test) keys)
keys))))
;; [bug18430]: format-graph-from-root moved down to avoid dynamic-extent
;; warning without defun-proto form
(defun format-graph-from-roots (root-objects object-printer inferior-producer
&key (stream *standard-output*)
......@@ -290,6 +264,37 @@
(move-cursor-beyond-output-record stream graph-record))
graph-record)))
;; For compatibility...
(defun format-graph-from-root (root-object object-printer inferior-producer
&rest keys
&key (stream *standard-output*)
(orientation ':horizontal) (center-nodes nil)
(cutoff-depth nil)
(merge-duplicates nil)
(graph-type (if merge-duplicates :digraph :tree))
(key #'identity) (test #'eql)
(arc-drawer #'draw-linear-arc)
(arc-drawing-options nil)
(generation-separation
*default-generation-separation*)
(within-generation-separation
*default-within-generation-separation*)
(maximize-generations #+allegro t #-allegro nil)
(store-objects t) (move-cursor t))
(declare (dynamic-extent keys object-printer inferior-producer)
(ignore stream orientation center-nodes cutoff-depth
arc-drawer arc-drawing-options graph-type move-cursor store-objects
generation-separation within-generation-separation maximize-generations))
(with-keywords-removed (keys keys '(:merge-duplicates :key :test))
(apply #'format-graph-from-roots
(list root-object) object-printer inferior-producer
(if merge-duplicates
(append `(:merge-duplicates ,merge-duplicates
:duplicate-key ,key :duplicate-test ,test) keys)
keys))))
(defun draw-linear-arc (stream from-object to-object x1 y1 x2 y2 &rest drawing-options
&key path &allow-other-keys)
(declare (dynamic-extent drawing-options))
......
......@@ -39,6 +39,7 @@
(declare (ignore safety size speed))
(> debug 1))))
#-(version>= 8 2)
(setq comp:declared-fixnums-remain-fixnums-switch
(named-function |(> speed 2)|
(lambda (safety size speed debug)
......@@ -46,6 +47,15 @@
(> speed 2))))
;; [bug18430]:
#+(version>= 8 2)
(setq comp:declared-fixnums-remain-fixnums-switch
(named-function |(> speed 2)|
(lambda (safety size speed debug compilation-speed)
(declare (ignore safety size debug compilation-speed))
(> speed 2))))
;;;; Set up translations so we can find stuff.
;;;
(setf (logical-pathname-translations "clim2")
......
......@@ -1592,6 +1592,8 @@
:sub-menu-id sub-pdm
:parent pdm
initargs)))
;; [bug18430]
(declare (ignore button))
(setf pdm sub-pdm))))))
(defmethod (setf set-gadget-items) :after (items (gadget motif-option-pane))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment