mcclim-cvs April 2006

mcclim-cvs@common-lisp.net

5 participants
35 discussions

[mcclim-cvs] CVS mcclim/Backends/CLX
by dlichteblau 17 Apr '06

17 Apr '06

Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory clnet:/tmp/cvs-serv11135 Modified Files: medium.lisp Log Message: * Backends/CLX/medium.lisp (climi::text-bounding-rectangle*): Do not error out when the string contains newlines. [Whether the return values are right is a different matter...] --- /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp 2006/03/23 11:59:00 1.73 +++ /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp 2006/04/17 18:12:16 1.74 @@ -757,7 +757,7 @@ font-ascent font-descent direction first-not-done)) (multiple-value-bind (minx miny maxx maxy) - (text-bounding-rectangle* + (climi::text-bounding-rectangle* medium string :text-style text-style :start (1+ position-newline) :end end) (values (min minx left) (- ascent)

1 0

[mcclim-cvs] CVS mcclim/Examples
by dlichteblau 17 Apr '06

17 Apr '06

Update of /project/mcclim/cvsroot/mcclim/Examples In directory clnet:/tmp/cvs-serv8858/Examples Modified Files: demodemo.lisp Added Files: text-size-test.lisp Log Message: * Examples/text-size-test.lisp: New file. Visual test for the TEXT-SIZE function. * Examples/demodemo.lisp: Added a button for text-size-test. * mcclim.asd (clim-examples): Added text-size-test.lisp. --- /project/mcclim/cvsroot/mcclim/Examples/demodemo.lisp 2006/04/10 09:48:40 1.9 +++ /project/mcclim/cvsroot/mcclim/Examples/demodemo.lisp 2006/04/17 17:54:58 1.10 @@ -72,7 +72,8 @@ (make-demo-button "Table Test" 'table-test) (make-demo-button "Scroll Test" 'Scroll-test) (make-demo-button "List Test" 'list-test) - (make-demo-button "HBOX Test" 'hbox-test))))))))) + (make-demo-button "HBOX Test" 'hbox-test) + (make-demo-button "Text Size Test" 'text-size-test))))))))) (defun demodemo () #+nil --- /project/mcclim/cvsroot/mcclim/Examples/text-size-test.lisp 2006/04/17 17:54:59 NONE +++ /project/mcclim/cvsroot/mcclim/Examples/text-size-test.lisp 2006/04/17 17:54:59 1.1 ;;; -*- Mode: Lisp; -*- ;;; (c) 2006 David Lichteblau (david(a)lichteblau.com) ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public ;;; License as published by the Free Software Foundation; either ;;; version 2 of the License, or (at your option) any later version. ;;; ;;; This library is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; Library General Public License for more details. ;;; ;;; You should have received a copy of the GNU Library General Public ;;; License along with this library; if not, write to the ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. (in-package :clim-demo) (define-application-frame text-size-test () () (:panes (canvas :application :min-width 600 :display-time t :display-function 'display-canvas) (text (make-pane 'text-field :value "ytmM")) (family (with-radio-box () (make-pane 'toggle-button :label "Fixed" :id :fixed) (radio-box-current-selection (make-pane 'toggle-button :label "Serif" :id :serif)) (make-pane 'toggle-button :label "Sans Serif" :id :sans-serif))) (face (with-radio-box (:type :some-of) (make-pane 'toggle-button :label "Bold" :id :bold) (make-pane 'toggle-button :label "Italic" :id :italic))) (size (make-pane 'slider :orientation :horizontal :value 200 :min-value 1 :max-value 1000))) (:layouts (default (vertically () (labelling (:label "Text") text) (horizontally () (labelling (:label "Family") family) (labelling (:label "Face") face)) (labelling (:label "Size") size) canvas)))) (defmethod display-canvas (frame stream) (window-clear stream) (let* ((pane-width (rectangle-width (sheet-region stream))) (pane-height (rectangle-height (sheet-region stream))) (str (gadget-value (find-pane-named frame 'text))) (size (gadget-value (find-pane-named frame 'size))) (family (gadget-id (gadget-value (find-pane-named frame 'family)))) (faces (mapcar #'gadget-id (gadget-value (find-pane-named frame 'face)))) (face (if (cdr faces) '(:bold :italic) (car faces))) (style (make-text-style family face size))) (multiple-value-bind (width height final-x final-y baseline) (text-size stream str :text-style style) (let ((x1 (/ (- pane-width width) 2)) (y1 (/ (- pane-height height) 2))) (draw-line* stream 0 (+ y1 baseline) pane-width (+ y1 baseline) :ink +green+) (draw-text* stream str x1 (+ y1 baseline) :text-style style) ;; Here an attempt at testing text with newlines, results are garbage ;; even with CLIM-CLX: ;;; (setf (stream-cursor-position stream) (values x1 y1)) ;;; (with-text-style (stream style) ;;; (write-string str stream)) (draw-rectangle* stream x1 y1 (+ x1 width) (+ y1 height) :ink +red+ :filled nil) (draw-rectangle* stream x1 y1 (+ x1 final-x) (+ y1 final-y) :ink +blue+ :filled nil))))) (define-text-size-test-command (com-quit-text-size-test :menu "Quit") () (frame-exit *application-frame*)) (define-text-size-test-command (com-update :menu "Update") () (display-canvas *application-frame* (frame-standard-output *application-frame*)))

1 0

[mcclim-cvs] CVS mcclim
by dlichteblau 17 Apr '06

17 Apr '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv8858 Modified Files: mcclim.asd Log Message: * Examples/text-size-test.lisp: New file. Visual test for the TEXT-SIZE function. * Examples/demodemo.lisp: Added a button for text-size-test. * mcclim.asd (clim-examples): Added text-size-test.lisp. --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2006/04/10 09:48:40 1.17 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2006/04/17 17:54:58 1.18 @@ -316,7 +316,8 @@ (:file "accepting-values") (:file "method-browser") (:file "dragndrop-translator") - (:file "draggable-graph"))) + (:file "draggable-graph") + (:file "text-size-test"))) (:module "Goatee" :components ((:file "goatee-test")))))

1 0

[mcclim-cvs] CVS mcclim/Apps/Listener
by crhodes 10 Apr '06

10 Apr '06

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory clnet:/tmp/cvs-serv20022 Modified Files: dev-commands.lisp Log Message: Slightly better editability in the listener: now fboundp (setf foo) things stand a chance of having the Edit Definition command work. Printing methods with EQL specializers works better. --- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2006/03/29 10:43:37 1.34 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2006/04/10 21:24:53 1.35 @@ -37,10 +37,20 @@ ;;; Presentation types -(define-presentation-type class () :inherit-from 'expression) +(define-presentation-type specializer () :inherit-from 'expression) +(define-presentation-type class () :inherit-from 'specializer) +(define-presentation-type eql-specializer () :inherit-from 'specializer) (define-presentation-type class-name () :inherit-from 'symbol) (define-presentation-type slot-definition () :inherit-from 'expression) -(define-presentation-type function-name () :inherit-from 'symbol) + +(define-presentation-type-abbreviation function-name () + `(and expression (satisfies legal-and-fboundp))) + +(defun legal-and-fboundp (object) + (and #+sbcl (sb-int:valid-function-name-p object) + #-sbcl (typep object '(or symbol (cons (eql setf)))) + (fboundp object))) + (define-presentation-type process () :inherit-from 'expression) (define-presentation-type generic-function () :inherit-from 't) @@ -67,9 +77,7 @@ (define-presentation-type package-name () :inherit-from 'string) (define-presentation-method presentation-typep (object (type package-name)) - (find-package 'object)) - - + (find-package object)) ;;; Presentation methods @@ -98,8 +106,10 @@ (write-char #$ stream) (present arg 'symbol :stream stream) (write-char #\space stream) - (with-output-as-presentation (stream spec 'class) - (format stream "~S" (clim-mop:class-name spec))) + (with-output-as-presentation (stream spec 'specializer) + (if (typep spec 'class) + (format stream "~S" (clim-mop:class-name spec)) + (format stream "~S" `(eql ,(clim-mop:eql-specializer-object spec))))) (write-char #$ stream)))) (when optional (format stream " &optional ~{~A ~^ ~}" optional)) @@ -187,13 +197,31 @@ (object) (clim-mop:class-name object)) +(define-presentation-translator expression-to-function-name + (expression function-name lisp-dev-commands + :documentation ((object stream) (format stream "~A" object)) + :gesture t + :tester ((object) (legal-and-fboundp object)) + :tester-definitive t) + (object) + object) (define-presentation-translator symbol-to-function-name (symbol function-name lisp-dev-commands - :documentation ((object stream) (format stream "Function ~A" object)) + :documentation ((object stream) (format stream "~A" object)) :gesture t - :tester ((object) (fboundp object)) + :tester ((object) (legal-and-fboundp object)) :tester-definitive t) - (object) object) + (object) + object) +#+nil ; doesn't work for some reason +(define-presentation-translator sequence-to-function-name + ((sequence t) function-name lisp-dev-commands + :documentation ((object stream) (format stream "~A" object)) + :gesture t + :tester ((object) (legal-and-fboundp object)) + :tester-definitive t) + (object) + object) ;;; Application commands @@ -336,7 +364,7 @@ :command-table lisp-commands :menu t :provide-output-destination-keyword nil) - ((fsym 'function-name :prompt "function-name")) + ((fsym 'function-name :prompt "function name")) (if (fboundp fsym) (progn (eval `(trace ,fsym)) @@ -347,7 +375,7 @@ :command-table lisp-commands :menu t :provide-output-destination-keyword nil) - ((fsym 'symbol :prompt "function name")) + ((fsym 'function-name :prompt "function name")) (if (fboundp fsym) (progn (eval `(untrace ,fsym)) @@ -572,10 +600,16 @@ (note "No accessors") (progn (with-ink (readers) - (if readers (dolist (reader readers) (format t "~A~%" reader)) - (note "No readers~%"))) + (if readers + (dolist (reader readers) + (hackish-present reader) + (terpri)) + (note "No readers~%"))) (with-ink (writers) - (if writers (dolist (writer writers) (format t "~A~%" writer)) + (if writers + (dolist (writer writers) + (hackish-present writer) + (terpri)) (note "No writers")))))) (fcell (documentation :left) @@ -1379,19 +1413,14 @@ :command-table lisp-commands :menu t :provide-output-destination-keyword nil) - ((symbol 'symbol :prompt "function-name")) - (clim-sys:make-process (lambda () (ed symbol)))) - -(defun editable-definition-p (symbol) - (fboundp symbol)) + ((function-name 'function-name :prompt "function name")) + (clim-sys:make-process (lambda () (ed function-name)))) (define-presentation-to-command-translator edit-definition - (symbol com-edit-definition lisp-commands :gesture :select + (function-name com-edit-definition lisp-commands :gesture :select :pointer-documentation ((object stream) (format stream "Edit Definition of ~A" object)) - :documentation ((stream) (format stream "Edit Definition")) - :tester ((object) - (editable-definition-p object))) + :documentation ((stream) (format stream "Edit Definition"))) (object) (list object))

1 0

[mcclim-cvs] CVS mcclim
by rgoldman 10 Apr '06

10 Apr '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv22293 Modified Files: input-editing.lisp Log Message: Changed the way possibilities are presented when complete-from-generator is used in the command reader. Now the list of possibilities generated will be sorted alphabetically. This solution is possibly not ideal, but I thought any better solution would require more widespread changes. --- /project/mcclim/cvsroot/mcclim/input-editing.lisp 2006/03/10 21:58:13 1.49 +++ /project/mcclim/cvsroot/mcclim/input-editing.lisp 2006/04/10 13:58:10 1.50 @@ -767,7 +767,7 @@ ;;; The possibilities action is different enough that I don't want to add to ;;; the spaghetti above... -(defun complete-from-generator-possibilities +(defun complete-from-generator-possibilities (initial-string generator predicate) (let ((possibilities nil) (nmatches 0) @@ -783,12 +783,13 @@ (funcall generator initial-string #'suggester) (if (and (eql nmatches 1) (string-equal initial-string (caar possibilities))) + ;; return values are as from complete-from-generator, qv. (values (caar possibilities) t (cdar possibilities) nmatches possibilities) - (values initial-string nil nil nmatches possibilities))))) + (values initial-string nil nil nmatches (sort possibilities #'string-lessp :key #'car)))))) (defun complete-from-possibilities (initial-string completions delimiters &key (action :complete)

1 0

[mcclim-cvs] CVS mcclim/Examples
by crhodes 10 Apr '06

10 Apr '06

Update of /project/mcclim/cvsroot/mcclim/Examples In directory clnet:/tmp/cvs-serv20167/Examples Modified Files: demodemo.lisp Added Files: draggable-graph.lisp Log Message: Andy Hefner's code for keeping track of graph edges, and demo code for draggable graphs. I've been running with this for about a year now, and I'm bored of having to snip it out of diffs all the time. (Also add the drag-and-drop-translator demo to demodemo) --- /project/mcclim/cvsroot/mcclim/Examples/demodemo.lisp 2006/03/29 10:43:43 1.8 +++ /project/mcclim/cvsroot/mcclim/Examples/demodemo.lisp 2006/04/10 09:48:40 1.9 @@ -63,7 +63,9 @@ (make-demo-button "Gadget Test" 'gadget-test) (make-demo-button "Drag and Drop" 'dragndrop) (make-demo-button "Colorslider" 'colorslider) - (make-demo-button "Goatee Test" 'goatee::goatee-test))) + (make-demo-button "Goatee Test" 'goatee::goatee-test) + (make-demo-button "D&D Translator" 'drag-test) + (make-demo-button "Draggable Graph" 'draggable-graph-demo))) (labelling (:label "Tests") (vertically (:equalize-width t) (make-demo-button "Label Test" 'label-test) --- /project/mcclim/cvsroot/mcclim/Examples/draggable-graph.lisp 2006/04/10 09:48:41 NONE +++ /project/mcclim/cvsroot/mcclim/Examples/draggable-graph.lisp 2006/04/10 09:48:41 1.1 ;;; -*- Mode: Lisp; Package: CLIM-DEMO -*- ;;; (c) copyright 2005 by ;;; Andy Hefner (ahefner(a)gmail.com) ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public ;;; License as published by the Free Software Foundation; either ;;; version 2 of the License, or (at your option) any later version. ;;; ;;; This library is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; Library General Public License for more details. ;;; ;;; You should have received a copy of the GNU Library General Public ;;; License along with this library; if not, write to the ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. (in-package :clim-demo) ;;; Demo of draggable graph nodes (define-application-frame draggable-graph-demo () () (:pane (make-pane 'application-pane :width :compute :height :compute :display-function 'generate-graph :display-time t))) (defun generate-graph (frame pane) (format-graph-from-roots (list (find-class 'number)) (lambda (object stream) (present (clim-mop:class-name object) (presentation-type-of object) :stream stream)) #'clim-mop:class-direct-subclasses :stream pane)) (defun record-parent-chain (record) (and record (cons record (record-parent-chain (output-record-parent record))))) (defun find-graph-node (record) "Searches upward until a graph node parent of the supplied output record is found." (find-if #'graph-node-output-record-p (record-parent-chain record))) (defun node-edges (node) (let (edges) (maphash (lambda (child edge) (declare (ignore child)) (push edge edges)) (slot-value node 'climi::edges-from)) (maphash (lambda (parent edge) (declare (ignore parent)) (push edge edges)) (slot-value node 'climi::edges-to)) edges)) (defun redisplay-edges (graph edges) (dolist (edge edges) (with-slots (climi::from-node climi::to-node) edge (climi::layout-edge-1 graph climi::from-node climi::to-node)))) ;;; (AH) McCLIM bug of the day: ;;; ;;; (I haven't looked in detail at the spec or McCLIM to confirm my ;;; assumptions here, but as I understand things..) CLIM regions are ;;; immutable. Output records ARE mutable. A McCLIM output record can ;;; be used as a rectangular region corresponding to its bounding ;;; rectangle. But this bounding rectangle is not immutable! So, ;;; region operations such as region-union may build a rectangle-set ;;; capturing the mutable output-record object, violating the ;;; immutability of regions and causing widespread panic and ;;; confusion. (defun stupid-copy-rectangle (region) (with-bounding-rectangle* (x0 y0 x1 y1) region (make-rectangle* x0 y0 x1 y1))) (define-draggable-graph-demo-command (com-drag-node) ((record t) (x 'real) (y 'real)) (let* ((graph-node (find-graph-node record)) (edges (node-edges graph-node)) (erase-region (stupid-copy-rectangle (reduce (lambda (x &optional y) (if y (region-union x y) x)) edges)))) (multiple-value-bind (px py) (output-record-position graph-node) (let ((graph (output-record-parent graph-node)) (x-offset (- x px)) (y-offset (- y py))) (assert (typep graph 'graph-output-record)) (erase-output-record graph-node *standard-output*) (dolist (edge edges) (clear-output-record edge)) (when edges (repaint-sheet *standard-output* erase-region)) (multiple-value-bind (final-x final-y) (drag-output-record *standard-output* graph-node :erase-final t :finish-on-release t) (setf (output-record-position graph-node) (values (- final-x x-offset) (- final-y y-offset))) (add-output-record graph-node graph) (redisplay-edges graph edges) (repaint-sheet *standard-output* graph-node)))))) (define-presentation-to-command-translator record-dragging-translator (t com-drag-node draggable-graph-demo :tester ((presentation) (find-graph-node presentation))) (presentation x y) (list presentation x y)) ;;; (CSR) This demo code is quite cool; visually, it's a little ;;; disconcerting to have the edges disappear when dragging, but ;;; that's acceptable, though I think it might be possible to preserve ;;; them by having a feedback function for the call to ;;; DRAG-OUTPUT-RECORD.

1 0

[mcclim-cvs] CVS mcclim
by crhodes 10 Apr '06

10 Apr '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv20167 Modified Files: graph-formatting.lisp mcclim.asd Log Message: Andy Hefner's code for keeping track of graph edges, and demo code for draggable graphs. I've been running with this for about a year now, and I'm bored of having to snip it out of diffs all the time. (Also add the drag-and-drop-translator demo to demodemo) --- /project/mcclim/cvsroot/mcclim/graph-formatting.lisp 2006/03/10 21:58:13 1.17 +++ /project/mcclim/cvsroot/mcclim/graph-formatting.lisp 2006/04/10 09:48:40 1.18 @@ -3,7 +3,7 @@ ;;; Title: Graph Formatting ;;; Created: 2002-08-13 ;;; License: LGPL (See file COPYING for details). -;;; $Id: graph-formatting.lisp,v 1.17 2006/03/10 21:58:13 tmoore Exp $ +;;; $Id: graph-formatting.lisp,v 1.18 2006/04/10 09:48:40 crhodes Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 2002 by Gilbert Baumann @@ -240,6 +240,8 @@ :initarg :graph-children :initform nil :accessor graph-node-children) + (edges-from :initform (make-hash-table)) + (edges-to :initform (make-hash-table)) (object :initarg :object :reader graph-node-object) @@ -405,6 +407,15 @@ (incf v within-generation-separation))) (graph-root-nodes graph-output-record))))))))))) +;;;; Edges + +(defclass standard-edge-output-record (standard-sequence-output-record) + ((stream) + (arc-drawer) + (arc-drawing-options) + (from-node :initarg :from-node) + (to-node :initarg :to-node))) + (defmethod layout-graph-nodes ((graph-output-record dag-graph-output-record) stream arc-drawer arc-drawing-options) @@ -526,7 +537,7 @@ (with-slots (root-nodes orientation) graph-output-record (let ((hash (make-hash-table))) (labels ((walk (node) - (unless (gethash node hash) + (unless (gethash node hash) (setf (gethash node hash) t) (dolist (k (graph-node-children node)) (with-bounding-rectangle* (x1 y1 x2 y2) node @@ -551,6 +562,55 @@ (walk k))))) (map nil #'walk root-nodes))))) +(defun layout-edges (graph node stream arc-drawer arc-drawing-options) + (dolist (k (graph-node-children node)) + (layout-edge graph node k stream arc-drawer arc-drawing-options))) + +(defun ensure-edge-record (graph major-node minor-node) + (let ((edges-from (slot-value major-node 'edges-from)) + (edges-to (slot-value minor-node 'edges-to))) + (assert (eq (gethash minor-node edges-from) + (gethash major-node edges-to))) + (or (gethash minor-node edges-from) + (let ((record (make-instance 'standard-edge-output-record + :from-node major-node :to-node minor-node))) + (setf (gethash minor-node edges-from) record + (gethash major-node edges-to) record) + (add-output-record record graph) + record)))) + +(defun layout-edge-1 (graph major-node minor-node) + (let ((edge-record (ensure-edge-record graph major-node minor-node))) + (with-slots (stream arc-drawer arc-drawing-options) edge-record + (with-bounding-rectangle* (x1 y1 x2 y2) major-node + (with-bounding-rectangle* (u1 v1 u2 v2) minor-node + (clear-output-record edge-record) ;;; FIXME: repaint? + (letf (((stream-current-output-record stream) edge-record)) + (ecase (slot-value graph 'orientation) + ((:horizontal) + (multiple-value-bind (from to) (if (< x1 u1) + (values x2 u1) + (values x1 u2)) + (apply arc-drawer stream major-node minor-node + from (/ (+ y1 y2) 2) + to (/ (+ v1 v2) 2) + arc-drawing-options))) + ((:vertical) + (multiple-value-bind (from to) (if (< y1 v1) + (values y2 v1) + (values y1 v2)) + (apply arc-drawer stream major-node minor-node + (/ (+ x1 x2) 2) from + (/ (+ u1 u2) 2) to + arc-drawing-options)))))))))) + +(defun layout-edge (graph major-node minor-node stream arc-drawer arc-drawing-options) + (let ((edge-record (ensure-edge-record graph major-node minor-node))) + (setf (slot-value edge-record 'stream) stream + (slot-value edge-record 'arc-drawer) arc-drawer + (slot-value edge-record 'arc-drawing-options) arc-drawing-options) + (layout-edge-1 graph major-node minor-node))) + (defmethod layout-graph-edges ((graph standard-graph-output-record) stream arc-drawer arc-drawing-options) (with-slots (orientation) graph @@ -562,26 +622,7 @@ (traverse-graph-nodes graph (lambda (node children continuation) (unless (eq node graph) - (dolist (k children) - (with-bounding-rectangle* (x1 y1 x2 y2) node - (with-bounding-rectangle* (u1 v1 u2 v2) k - (ecase orientation - ((:horizontal) - (multiple-value-bind (from to) (if (< x1 u1) - (values x2 u1) - (values x1 u2)) - (apply arc-drawer stream node k - from (/ (+ y1 y2) 2) - to (/ (+ v1 v2) 2) - arc-drawing-options))) - ((:vertical) - (multiple-value-bind (from to) (if (< y1 v1) - (values y2 v1) - (values y1 v2)) - (apply arc-drawer stream node k - (/ (+ x1 x2) 2) from - (/ (+ u1 u2) 2) to - arc-drawing-options)))))))) + (layout-edges graph node stream arc-drawer arc-drawing-options)) (map nil continuation children)))))) (defmethod layout-graph-edges :around ((graph-output-record tree-graph-output-record) --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2006/03/29 10:43:37 1.16 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2006/04/10 09:48:40 1.17 @@ -315,7 +315,8 @@ #+clx (:file "gadget-test") (:file "accepting-values") (:file "method-browser") - (:file "dragndrop-translator"))) + (:file "dragndrop-translator") + (:file "draggable-graph"))) (:module "Goatee" :components ((:file "goatee-test")))))

1 0

[mcclim-cvs] CVS mcclim/Backends/PostScript
by crhodes 01 Apr '06

01 Apr '06

Update of /project/mcclim/cvsroot/mcclim/Backends/PostScript In directory clnet:/tmp/cvs-serv29250/Backends/PostScript Modified Files: sheet.lisp Log Message: Fix for EPS output from postscript backend. (From David Lewis) --- /project/mcclim/cvsroot/mcclim/Backends/PostScript/sheet.lisp 2006/03/29 10:43:38 1.14 +++ /project/mcclim/cvsroot/mcclim/Backends/PostScript/sheet.lisp 2006/04/01 21:07:04 1.15 @@ -74,11 +74,11 @@ ((:eps) (let ((record (stream-output-history stream))) (multiple-value-bind (lx ly ux uy) (bounding-rectangle* record) - (setf translate-x (- (ceiling lx)) + (setf translate-x (- (floor lx)) translate-y (ceiling uy)) (format file-stream "%%BoundingBox: ~A ~A ~A ~A~%" 0 0 - (+ translate-x (floor lx)) + (+ translate-x (ceiling ux)) (- translate-y (floor ly)))))) (t (multiple-value-bind (width height)

1 0

[mcclim-cvs] CVS mcclim/Goatee
by tmoore 01 Apr '06

01 Apr '06

Update of /project/mcclim/cvsroot/mcclim/Goatee In directory clnet:/tmp/cvs-serv26959/Goatee Modified Files: clim-area.lisp Log Message: Change the input editing text cursor from the disturbing outline to solid. Do something a bit more intelligent with presentation-type-of and structure objects. --- /project/mcclim/cvsroot/mcclim/Goatee/clim-area.lisp 2006/03/01 21:51:54 1.32 +++ /project/mcclim/cvsroot/mcclim/Goatee/clim-area.lisp 2006/04/01 07:58:37 1.33 @@ -26,7 +26,8 @@ ;;; cheat and use this McCLIM internal class :) (defclass screen-area-cursor (clim-internals::cursor-mixin cursor) - ((screen-line :accessor screen-line :initarg :screen-line))) + ((screen-line :accessor screen-line :initarg :screen-line)) + (:default-initargs :appearance :solid)) (defmethod* (setf cursor-position) (nx ny (cursor screen-area-cursor)) (declare (ignore nx ny))

1 0

[mcclim-cvs] CVS mcclim
by tmoore 01 Apr '06

01 Apr '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv26959 Modified Files: presentation-defs.lisp Log Message: Change the input editing text cursor from the disturbing outline to solid. Do something a bit more intelligent with presentation-type-of and structure objects. --- /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2006/03/20 08:15:26 1.54 +++ /project/mcclim/cvsroot/mcclim/presentation-defs.lisp 2006/04/01 07:58:36 1.55 @@ -100,8 +100,9 @@ (defmethod presentation-type-of ((object structure-object)) (multiple-value-bind (name lambda-list) (get-ptype-from-class-of object) - (if (or (null lambda-list) - (member lambda-list lambda-list-keywords)) + (if (and name + (or (null lambda-list) + (member lambda-list lambda-list-keywords))) name (call-next-method))))

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

mcclim-cvs April 2006