mcclim-cvs

mcclim-cvs@common-lisp.net

1697 discussions

[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

[mcclim-cvs] CVS mcclim
by afuchs 30 Mar '06

30 Mar '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv22364 Modified Files: decls.lisp Log Message: Fix invoke-with-new-output-record and invoke-with-output-to-output-record's arg lists to conform to the Franz User Guide, as noted in recording.lisp. --- /project/mcclim/cvsroot/mcclim/decls.lisp 2006/03/15 15:38:39 1.37 +++ /project/mcclim/cvsroot/mcclim/decls.lisp 2006/03/30 20:31:06 1.38 @@ -321,9 +321,9 @@ ;; with-output-recording-options (stream &key record draw) &body body [Macro] (defgeneric invoke-with-output-recording-options (stream continuation record draw)) ;; with-new-output-record (stream &optional record-type record &rest initargs) &body body [MAcro] -(defgeneric invoke-with-new-output-record (stream continuation record-type &rest initargs &key parent)) +(defgeneric invoke-with-new-output-record (stream continuation record-type constructor &key &allow-other-keys)) ;; with-output-to-output-record (stream &optional record-type record &rest initargs)) &body body [Macro] -(defgeneric invoke-with-output-to-output-record (stream continuation record-type &rest initargs &key)) +(defgeneric invoke-with-output-to-output-record (stream continuation record-type constructor &rest initargs &key &allow-other-keys)) (defgeneric make-design-from-output-record (record)) ;;;; 21.2

1 0

[mcclim-cvs] CVS mcclim/Backends/beagle/native-panes
by tmoore 30 Mar '06

30 Mar '06

Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes In directory clnet:/tmp/cvs-serv25437/Backends/beagle/native-panes Modified Files: beagle-scroll-bar-pane.lisp Log Message: Fix up scroll bars in Beagle. Use the high level gadget events to signal scroll bar changes to the application. Document the unintuitive scroll-bar-thumb-size slot in the scroll-bar gadget. --- /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp 2006/02/22 10:55:41 1.7 +++ /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp 2006/03/30 12:07:59 1.8 @@ -4,13 +4,7 @@ ;;; Limitations: ;;; ;;; - ignores different NSControl sizes -;;; - inherits from the 'standard' scroll-bar-pane, rather than from the abstract -;;; scroll bar -;;; Inheriting from 'scroll-bar' will probably work if we use the :default-initargs -;;; hackery out of gadgets.lisp (but shouldn't these be part of the abstract type?) - -;;;(defclass beagle-scroll-bar-pane (scroll-bar) (defclass beagle-scroll-bar-pane (scroll-bar) ((tk-obj :initform (%null-ptr) :accessor toolkit-object))) @@ -83,6 +77,54 @@ :min-height width :height width)))) +;;; Change the value of the scroll bar in the application process i.e., +;;; consistently with respect to events that have been received. + +(defmethod drag-callback :before + ((gadget beagle-scroll-bar-pane) client gadget-id value) + (declare (ignore client gadget-id)) + (setf (slot-value gadget 'climi::value) value)) + +(defun update-cocoa-scroll-bar (scroll-bar) + (let* ((range (- (gadget-max-value scroll-bar) + (gadget-min-value scroll-bar))) + (value (if (zerop range) + 0.0 + (/ (- (gadget-value scroll-bar) + (gadget-min-value scroll-bar)) + range))) + (ts (climi::scroll-bar-thumb-size scroll-bar)) + (loz-size (if (<= range 0) + 1.0 + (/ ts (+ range ts))))) + (send (toolkit-object scroll-bar) + :set-float-value (coerce (clamp value 0.0 1.0) 'short-float) + :knob-proportion (coerce (clamp loz-size 0.0 1.0) 'short-float)))) + +(defmethod (setf gadget-min-value) :after + (new-value (pane beagle-scroll-bar-pane)) + (declare (ignore new-value)) + (update-cocoa-scroll-bar pane)) + +(defmethod (setf gadget-max-value) :after (new-value (pane beagle-scroll-bar-pane)) + (declare (ignore new-value)) + (update-cocoa-scroll-bar pane)) + +(defmethod (setf climi::scroll-bar-thumb-size) :after (new-value (pane beagle-scroll-bar-pane)) + (declare (ignore new-value)) + (update-cocoa-scroll-bar pane)) + +(defmethod (setf gadget-value) :after (new-value (pane beagle-scroll-bar-pane) &key invoke-callback) + (declare (ignore new-value invoke-callback)) + (update-cocoa-scroll-bar pane)) + +(climi::defmethod* (setf climi::scroll-bar-values) + (min-value max-value thumb-size value (scroll-bar beagle-scroll-bar-pane)) + (setf (slot-value scroll-bar 'climi::min-value) min-value + (slot-value scroll-bar 'climi::max-value) max-value + (slot-value scroll-bar 'climi::thumb-size) thumb-size + (slot-value scroll-bar 'climi::value) value) + (update-cocoa-scroll-bar scroll-bar)) ;;; No need to update the scrollbar (most of the time) since Cocoa will move ;;; the 'thumb' appropriately. Stick some debug in to see when it's invoked. @@ -91,6 +133,7 @@ ;;; I believe it's safe to leave this alone though since the sb will only be ;;; redrawn once through the event loop it shouldn't be too inefficient to ;;; be changing its value regularly. +#-(and) (defmethod (setf gadget-value) :before (value (gadget beagle-scroll-bar-pane) &key invoke-callback) (declare (ignore invoke-callback)) @@ -101,12 +144,10 @@ (let* ((range (- (gadget-max-value gadget) (gadget-min-value gadget))) - (size (if (eq (gadget-orientation gadget) :vertical) - (bounding-rectangle-height gadget) - (bounding-rectangle-width gadget))) + (size (climi::scroll-bar-thumb-size gadget)) (position (if (<= range 0) 0.0 - (/ value range))) + (/ (- value (gadget-min-value gadget) range))) (loz-size (if (<= range 0) 1.0 (/ size range)))) @@ -115,6 +156,7 @@ :knob-proportion (coerce loz-size 'short-float)))) +;;; Called in the Cocoa App thread. (defun scroll-bar-action-handler (pane sender) ;; Now we need to decide exactly what we do with these events... not sure @@ -132,28 +174,33 @@ (let ((hit-part (send sender 'hit-part))) (cond ((or (eq hit-part #$NSScrollerKnob) ; drag knob (eq hit-part #$NSScrollerKnobSlot)) ; click on knob (or alt-click on slot) - (let ((value (* (send sender 'float-value) ; 0.0 - 1.0 + (let ((value (+ (* (send sender 'float-value) ; 0.0 - 1.0 (- (gadget-max-value pane) ; range; 0.0 -> max extent ... - (gadget-min-value pane))))) ; ... (probably) - (clim:drag-callback pane - (gadget-client pane) - (gadget-id pane) - value))) + (gadget-min-value pane))) + (gadget-min-value pane)))) ; ... (probably) + (queue-callback #'clim:drag-callback + pane + (gadget-client pane) + (gadget-id pane) + value))) ((eq hit-part #$NSScrollerDecrementLine) - (clim:scroll-up-line-callback pane - (gadget-client pane) - (gadget-id pane))) + (queue-callback #'clim:scroll-up-line-callback + pane + (gadget-client pane) + (gadget-id pane))) ((eq hit-part #$NSScrollerDecrementPage) - (clim:scroll-up-page-callback pane - (gadget-client pane) - (gadget-id pane))) + (queue-callback #'clim:scroll-up-page-callback + pane + (gadget-client pane) + (gadget-id pane))) ((eq hit-part #$NSScrollerIncrementLine) - (clim:scroll-down-line-callback pane - (gadget-client pane) - (gadget-id pane))) + (queue-callback #'clim:scroll-down-line-callback + pane + (gadget-client pane) + (gadget-id pane))) ((eq hit-part #$NSScrollerIncrementPage) - (clim:scroll-down-page-callback pane - (gadget-client pane) - (gadget-id pane)))))) - + (queue-callback #'clim:scroll-down-page-callback + pane + (gadget-client pane) + (gadget-id pane))))))

1 0

[mcclim-cvs] CVS mcclim/Backends/beagle
by tmoore 30 Mar '06

30 Mar '06

Update of /project/mcclim/cvsroot/mcclim/Backends/beagle In directory clnet:/tmp/cvs-serv25437/Backends/beagle Modified Files: package.lisp Log Message: Fix up scroll bars in Beagle. Use the high level gadget events to signal scroll bar changes to the application. Document the unintuitive scroll-bar-thumb-size slot in the scroll-bar gadget. --- /project/mcclim/cvsroot/mcclim/Backends/beagle/package.lisp 2005/05/17 20:26:37 1.4 +++ /project/mcclim/cvsroot/mcclim/Backends/beagle/package.lisp 2006/03/30 12:07:59 1.5 @@ -18,27 +18,15 @@ (:import-from :climi #:+alt-key+ ;; - #:mirror-transformation - #:port-set-sheet-region - #:port-set-sheet-transformation #:port-text-style-mappings #:port-lookup-mirror #:port-register-mirror - #:port-allocate-pixmap - #:port-deallocate-pixmap - #:port-mirror-width - #:port-mirror-height + #:port-event-process #:port-grafts - #:port-enable-sheet - #:port-disable-sheet - #:port-motion-hints - #:port-force-output #:%set-port-keyboard-focus #:set-sheet-pointer-cursor ;; - #:port-set-mirror-region - #:port-set-mirror-transformation #:update-mirror-geometry #:%sheet-mirror-region #:%sheet-mirror-transformation @@ -69,7 +57,6 @@ ;; #:space-requirement ;used as slot, very bogus ;; fbound #:medium-device-region - #:medium-draw-circle* #:draw-image #:text-style-character-width #:height ;this seems bogus @@ -81,9 +68,7 @@ #:port-ungrab-pointer ;; #:invoke-with-special-choices - #:medium-draw-glyph #:medium-miter-limit - #:make-graft ;; classes: #:mirrored-pixmap #:window-destroy-event

1 0

[mcclim-cvs] CVS mcclim
by tmoore 30 Mar '06

30 Mar '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv25437 Modified Files: gadgets.lisp package.lisp Log Message: Fix up scroll bars in Beagle. Use the high level gadget events to signal scroll bar changes to the application. Document the unintuitive scroll-bar-thumb-size slot in the scroll-bar gadget. --- /project/mcclim/cvsroot/mcclim/gadgets.lisp 2006/03/29 10:43:37 1.98 +++ /project/mcclim/cvsroot/mcclim/gadgets.lisp 2006/03/30 12:07:59 1.99 @@ -460,8 +460,11 @@ :initform nil :reader scroll-bar-scroll-up-page-callback) (thumb-size :initarg :thumb-size :initform 1/4 - :accessor scroll-bar-thumb-size) - ) + :accessor scroll-bar-thumb-size + :documentation "The size of the scroll bar thumb (slug) in the + units of the gadget value. When the scroll bar is drawn the empty region of + the scroll bar and the thumb are drawn in proportion to the values of the + gadget range and thumb size.")) (:default-initargs :value 0 :min-value 0 :max-value 1 @@ -2853,6 +2856,7 @@ (defmethod handle-event ((gadget basic-gadget) (event callback-event)) (apply (callback-function event) + (event-gadget event) (event-client event) (event-client-id event) (event-other-args event))) --- /project/mcclim/cvsroot/mcclim/package.lisp 2006/03/15 22:56:54 1.53 +++ /project/mcclim/cvsroot/mcclim/package.lisp 2006/03/30 12:07:59 1.54 @@ -1947,6 +1947,7 @@ #:port-set-sheet-region #:port-set-sheet-transformation #:port-ungrab-pointer + #:queue-callback #:%set-port-keyboard-focus #:set-sheet-pointer-cursor #:synthesize-pointer-motion-event

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

mcclim-cvs