- mcclim-cvs@common-lisp.net - mailman3.common-lisp.net

[mcclim-cvs] CVS update: mcclim/presentation-defs.lisp
by tmoore＠common-lisp.net 19 Jan '05

19 Jan '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv20050 Modified Files: presentation-defs.lisp Log Message: For CLOS objects, make presentation-type-of return the name of the class if possible Date: Wed Jan 19 14:44:46 2005 Author: tmoore Index: mcclim/presentation-defs.lisp diff -u mcclim/presentation-defs.lisp:1.39 mcclim/presentation-defs.lisp:1.40 --- mcclim/presentation-defs.lisp:1.39 Tue Jan 11 05:02:19 2005 +++ mcclim/presentation-defs.lisp Wed Jan 19 14:44:46 2005 @@ -87,11 +87,15 @@ (defmethod presentation-type-of ((object standard-object)) (multiple-value-bind (name lambda-list) (get-ptype-from-class-of object) - (if (and name - (or (null lambda-list) - (member (first lambda-list) lambda-list-keywords))) - name - (call-next-method)))) + (cond ((and name + (or (null lambda-list) + (member (first lambda-list) lambda-list-keywords))) + name) + (name + 'standard-object) + (t (let* ((class (class-of object)) + (class-name (class-name class))) + (or class-name class)))))) (defmethod presentation-type-of ((object structure-object)) (multiple-value-bind (name lambda-list) @@ -100,7 +104,6 @@ (member lambda-list lambda-list-keywords)) name (call-next-method)))) - (define-presentation-generic-function %map-over-presentation-type-supertypes

1 0

[mcclim-cvs] CVS update: mcclim/Backends/CLX/medium.lisp
by tmoore＠common-lisp.net 18 Jan '05

18 Jan '05

Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory common-lisp.net:/tmp/cvs-serv15329/Backends/CLX Modified Files: medium.lisp Log Message: In method medium-gcontext ((medium clx-medium) (ink climi::transformed-design)), do return the gcontext as the value of the function. This was screwed up by me in the last commit to this file. Fixes the bug reported by Paolo Amoroso on Jan 17 2005: <integer> is not of type XLIB:GCONTEXT error when using pixmaps in Listener Date: Tue Jan 18 05:35:28 2005 Author: tmoore Index: mcclim/Backends/CLX/medium.lisp diff -u mcclim/Backends/CLX/medium.lisp:1.64 mcclim/Backends/CLX/medium.lisp:1.65 --- mcclim/Backends/CLX/medium.lisp:1.64 Tue Jan 11 05:35:33 2005 +++ mcclim/Backends/CLX/medium.lisp Tue Jan 18 05:35:26 2005 @@ -301,7 +301,8 @@ (setf (xlib:gcontext-ts-x gc) gc-x (xlib:gcontext-ts-y gc) gc-y (xlib:gcontext-clip-x gc) gc-x - (xlib:gcontext-clip-y gc) gc-y)))) + (xlib:gcontext-clip-y gc) gc-y) + gc))) (t (error "You lost, we not yet implemented transforming an ~S." (type-of ink)))))) @@ -514,8 +515,6 @@ (with-transformed-position (tr left top) (with-transformed-position (tr right bottom) (with-clx-graphics (medium) - #+nil (when (typep mirror 'xlib:pixmap) - (break)) (if (< right left) (rotatef left right)) (if (< bottom top) @@ -524,14 +523,14 @@ (top (round-coordinate top)) (right (round-coordinate right)) (bottom (round-coordinate bottom))) - ;; To clip rectangles, we just need to clamp the cooridnates + ;; To clip rectangles, we just need to clamp the + ;; coordinates (xlib:draw-rectangle mirror gc (max #x-8000 (min #x7FFF left)) (max #x-8000 (min #x7FFF top)) (max 0 (min #xFFFF (- right left))) (max 0 (min #xFFFF (- bottom top))) - filled) - )))))) + filled))))))) #+CLX-EXT-RENDER (defmethod medium-draw-rectangle-using-ink* ((medium clx-medium) (ink climi::uniform-compositum)

1 0

[mcclim-cvs] CVS update: mcclim/system.lisp
by rstrandh＠common-lisp.net 18 Jan '05

18 Jan '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv11515 Modified Files: system.lisp Log Message: Patch from Robert P. Goldman allowing the use of Allegro defsystem without a clash with mk:defsystem. Date: Tue Jan 18 04:20:16 2005 Author: rstrandh Index: mcclim/system.lisp diff -u mcclim/system.lisp:1.108 mcclim/system.lisp:1.109 --- mcclim/system.lisp:1.108 Tue Jan 18 02:58:08 2005 +++ mcclim/system.lisp Tue Jan 18 04:20:15 2005 @@ -43,12 +43,15 @@ (pushnew :clim *features*) (pushnew :mcclim *features*) -#+mk-defsystem (use-package "MK") ++;;; I really didn't have good luck with this on Allegro, because ++;;; Allegro's CL-USER package uses it's EXCL stuff, which has its own ++;;; DEFSYSTEM. [2004/12/21:rpg] ++;;;#+mk-defsystem (use-package "MK") (defmacro clim-defsystem ((module &key depends-on) &rest components) `(progn #+mk-defsystem - (defsystem ,module + (mk:defsystem ,module :source-pathname *clim-directory* :source-extension "lisp" ,@(and depends-on `(:depends-on ,depends-on))

1 0

[mcclim-cvs] CVS update: mcclim/Examples/accepting-values.lisp mcclim/Examples/dragndrop.lisp
by tmoore＠common-lisp.net 18 Jan '05

18 Jan '05

Update of /project/mcclim/cvsroot/mcclim/Examples In directory common-lisp.net:/tmp/cvs-serv6742/Examples Modified Files: accepting-values.lisp dragndrop.lisp Log Message: Implemented a pop-up-menu-view for displaying the completion presentation type in a dialog. Added some documentation for the internals of accepting-values. Date: Tue Jan 18 02:58:11 2005 Author: tmoore Index: mcclim/Examples/accepting-values.lisp diff -u mcclim/Examples/accepting-values.lisp:1.1 mcclim/Examples/accepting-values.lisp:1.2 --- mcclim/Examples/accepting-values.lisp:1.1 Fri Oct 15 06:05:36 2004 +++ mcclim/Examples/accepting-values.lisp Tue Jan 18 02:58:11 2005 @@ -44,3 +44,13 @@ (setq ymin-changed nil ymax-changed nil))))) (values xmin xmax ymin ymax)) + +;;; Test of McCLIM extension + +(defun accept-popup (seq &key (stream *query-io*)) + (let ((val (elt seq 0)) + (ptype `(completion ,seq))) + (accepting-values (stream) + (setq val (accept ptype :stream stream :view climi::+pop-up-menu-view+ + :prompt "Choose one:" :default val))) + val)) \ No newline at end of file Index: mcclim/Examples/dragndrop.lisp diff -u mcclim/Examples/dragndrop.lisp:1.1 mcclim/Examples/dragndrop.lisp:1.2 --- mcclim/Examples/dragndrop.lisp:1.1 Tue Jan 11 05:35:40 2005 +++ mcclim/Examples/dragndrop.lisp Tue Jan 18 02:58:11 2005 @@ -78,4 +78,7 @@ (define-presentation-to-command-translator translator-clone-circle (circle com-clone-circle dragndrop) (object x y) - `(,object ,x ,y)) \ No newline at end of file + `(,object ,x ,y)) + +(defun drag-circles () + (run-frame-top-level (make-application-frame 'dragndrop)))

1 0

[mcclim-cvs] CVS update: mcclim/dialog-views.lisp mcclim/dialog.lisp mcclim/system.lisp
by tmoore＠common-lisp.net 18 Jan '05

18 Jan '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv6742 Modified Files: dialog.lisp system.lisp Added Files: dialog-views.lisp Log Message: Implemented a pop-up-menu-view for displaying the completion presentation type in a dialog. Added some documentation for the internals of accepting-values. Date: Tue Jan 18 02:58:09 2005 Author: tmoore Index: mcclim/dialog.lisp diff -u mcclim/dialog.lisp:1.16 mcclim/dialog.lisp:1.17 --- mcclim/dialog.lisp:1.16 Tue Jan 11 05:02:19 2005 +++ mcclim/dialog.lisp Tue Jan 18 02:58:08 2005 @@ -23,16 +23,49 @@ produced by accept-present-default, as well as the current value of that query, arguments that were passed to accept, etc. are stored in a query object. The stream stores all the query objects for this -invocation of accepting-values. - -The query output records are presentations with command translators -defined that directly change their value (stored in the query object) -or select them for further user input, like the default text input. +invocation of accepting-values. The record created and returned by +accept-present-default must be a subclass of updating-output-record. After the initial output records are drawn, invoke-accepting-values -blocks accepting commands. When a query's value is changed, the body -of the call to accepting-values is run, with all the values returned -by calls to accept coming from the query objects. +blocks accepting commands. The state of the dialog state machine is changed +via these commands. The commands currently are: + +COM-SELECT-QUERY query-id -- calls the method select-query with the +corresponding query object and output record object. When select-query returns +the "next" field, if any, is selected so the user can move from field to field +easily. + +COM-CHANGE-QUERY query-id value -- This command is used to directly change the +value of a query field that does not need to be selected first for input. For +example, a user would click directly on a radio button without selecting the +gadget first. + +COM-DESELECT-QUERY -- deselects the currently selected query. + +COM-QUERY-EXIT -- Exits accepting-values + +COM-QUERY-ABORT -- Aborts accepting-values + +These commands are generated in two ways. For query fields that are entirely +based on CLIM drawing commands and presentations, these are emitted by +presentation translators. There is a presentation type selectable-query that +throws com-select-query for the :select gesture. Fields that are based on +gadgets have to throw presentations from their callbacks. This can be done +using the method on p. 305 of the Franz CLIM user guide, or by using the +McCLIM function throw-object-ptype. + +After a command is executed the body of accepting-values is rerun, calling +accept-present-default again to update the fields' graphic appearance. [This +may be calling these methods too often an may change in the future]. The +values returned by the user's calls to accept are come from the query objects. + + +If a query field is selectable than it should implement the method +select-query: + +SELECT-QUERY stream query record -- Make a query field active and do any +input. This should change the query object and setf (changedp query). This +method might be interrupted at any time if the user selects another field. |# @@ -292,7 +325,8 @@ (defgeneric select-query (stream query record) (:documentation "Does whatever is needed for input (e.g., calls accept) when -a query is selected for input." )) +a query is selected for input. It is responsible for updating the + query object when a new value is entered in the query field." )) (defgeneric deselect-query (stream query record) (:documentation "Deselect a query field: turn the cursor off, turn off Index: mcclim/system.lisp diff -u mcclim/system.lisp:1.107 mcclim/system.lisp:1.108 --- mcclim/system.lisp:1.107 Sat Jan 1 21:17:59 2005 +++ mcclim/system.lisp Tue Jan 18 02:58:08 2005 @@ -173,6 +173,7 @@ "table-formatting" "graph-formatting" "bordered-output" + "dialog-views" "dialog" ; depends on table formatting "builtin-commands" ; need dialog before commands are defined "describe" @@ -206,7 +207,8 @@ "Examples/stream-test" "Examples/presentation-test" #+clx "Examples/gadget-test" - "Goatee/goatee-test") + "Goatee/goatee-test" + "Examples/accepting-values") (clim-defsystem (:scigraph :depends-on (:clim #+clx :clim-looks))

1 0

[mcclim-cvs] CVS update: mcclim/incremental-redisplay.lisp
by tmoore＠common-lisp.net 18 Jan '05

18 Jan '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv1478 Modified Files: incremental-redisplay.lisp Log Message: Add explicit calls to FINISH-OUTPUT in COMPUTE-NEW-OUTPUT-RECORDS and INVOKE-UPDATING-OUTPUT. The current text record was being put in different subtrees when a new updating output record was created and when an existing one was found and reused. Date: Tue Jan 18 01:16:32 2005 Author: tmoore Index: mcclim/incremental-redisplay.lisp diff -u mcclim/incremental-redisplay.lisp:1.41 mcclim/incremental-redisplay.lisp:1.42 --- mcclim/incremental-redisplay.lisp:1.41 Tue Jan 11 05:35:18 2005 +++ mcclim/incremental-redisplay.lisp Tue Jan 18 01:16:30 2005 @@ -353,9 +353,6 @@ (fixed-position :reader output-record-fixed-position :initarg :fixed-position :initform nil) (displayer :reader output-record-displayer :initarg :displayer) - (sub-record :accessor sub-record - :documentation "The actual contents of this record. All output -record operations are forwarded to this record.") ;; Start and end cursor (start-graphics-state :accessor start-graphics-state :initarg :start-graphics-state @@ -511,12 +508,18 @@ (setf (output-record-dirty r) :updating)) record nil) + (finish-output stream) + ;; Why is this binding here? We need the "environment" in this call that + ;; computes the new records of an outer updating output record to resemble + ;; that when a record's contents are computed in invoke-updating-output. (letf (((stream-current-output-record stream) (output-record-parent record))) (compute-new-output-records-1 record stream (output-record-displayer record))))) +;;; Create the sub-record that holds the new contents of the updating output +;;; record. (defun %invoke-updating (record stream displayer) (letf (((stream-current-output-record stream) record)) (with-new-output-record (stream) @@ -838,6 +841,7 @@ (parent-cache nil)) (unless *enable-updating-output* (return-from invoke-updating-output (funcall continuation stream))) + (finish-output stream) (let ((parent-cache (or parent-cache *current-updating-output* stream))) (when (eq unique-id *no-unique-id*) (setq unique-id (incf (id-counter parent-cache))))

1 0

[mcclim-cvs] CVS update: mcclim/Backends/CLX/port.lisp
by tmoore＠common-lisp.net 14 Jan '05

14 Jan '05

Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory common-lisp.net:/tmp/cvs-serv8647 Modified Files: port.lisp Log Message: Fix comment; it's confusing enough without the wrong comment! Date: Fri Jan 14 13:47:47 2005 Author: tmoore Index: mcclim/Backends/CLX/port.lisp diff -u mcclim/Backends/CLX/port.lisp:1.104 mcclim/Backends/CLX/port.lisp:1.105 --- mcclim/Backends/CLX/port.lisp:1.104 Fri Jan 14 13:43:25 2005 +++ mcclim/Backends/CLX/port.lisp Fri Jan 14 13:47:47 2005 @@ -36,7 +36,7 @@ ;; ;; Note that CLIM defines pixel coordinates to be at the corners, ;; while in X11 they are at the centers. We don't do much about the - ;; discrepancy, but rounding down at half pixel boundaries seems to + ;; discrepancy, but rounding up at half pixel boundaries seems to ;; work well. (floor (+ x .5)))

1 0

[mcclim-cvs] CVS update: mcclim/Backends/CLX/port.lisp
by tmoore＠common-lisp.net 14 Jan '05

14 Jan '05

Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory common-lisp.net:/tmp/cvs-serv7897/Backends/CLX Modified Files: port.lisp Log Message: Change ROUND-COORDINATES back to the definition that rounds up at half pixel boundaries. When I made the previous change I didn't realize that X coordinates are at pixel centers. Date: Fri Jan 14 13:43:25 2005 Author: tmoore Index: mcclim/Backends/CLX/port.lisp diff -u mcclim/Backends/CLX/port.lisp:1.103 mcclim/Backends/CLX/port.lisp:1.104 --- mcclim/Backends/CLX/port.lisp:1.103 Tue Jan 11 14:35:33 2005 +++ mcclim/Backends/CLX/port.lisp Fri Jan 14 13:43:25 2005 @@ -34,9 +34,11 @@ ;; Using CL:ROUND gives you "random" results. Using "mercantile ;; rounding" gives you consistent results. ;; - ;; For values at .5 we round down in order to be consistant with - ;; the CLIM and CLX definitions for pixel coverage of shapes. - (ceiling (- x .5))) + ;; Note that CLIM defines pixel coordinates to be at the corners, + ;; while in X11 they are at the centers. We don't do much about the + ;; discrepancy, but rounding down at half pixel boundaries seems to + ;; work well. + (floor (+ x .5))) ;;; CLX-PORT class

1 0

[mcclim-cvs] CVS update: mcclim/presentations.lisp
by tmoore＠common-lisp.net 14 Jan '05

14 Jan '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv7897 Modified Files: presentations.lisp Log Message: Change ROUND-COORDINATES back to the definition that rounds up at half pixel boundaries. When I made the previous change I didn't realize that X coordinates are at pixel centers. Date: Fri Jan 14 13:43:23 2005 Author: tmoore Index: mcclim/presentations.lisp diff -u mcclim/presentations.lisp:1.69 mcclim/presentations.lisp:1.70 --- mcclim/presentations.lisp:1.69 Tue Jan 11 14:02:19 2005 +++ mcclim/presentations.lisp Fri Jan 14 13:43:23 2005 @@ -45,6 +45,16 @@ (presentation-mixin standard-sequence-output-record) ()) +(defvar *print-presentation-verbose* nil) + +(defmethod print-object ((self standard-presentation) stream) + (print-unreadable-object (self stream :type t :identity t) + (with-bounding-rectangle* (x1 y1 x2 y2) + self + (format stream "~D:~D,~D:~D ~S" x1 x2 y1 y2 (presentation-type self)) + (when *print-presentation-verbose* + (format stream " ~S" (presentation-object self)))))) + (defgeneric ptype-specializer (type) (:documentation "The specializer to use for this type in a presentation method lambda list")) @@ -1757,7 +1767,7 @@ (frame *application-frame*) event modifier-state button) (find-innermost-presentation-match input-context - (stream-output-history window) + top-record frame window x y @@ -1789,6 +1799,8 @@ x y) (when ptype (funcall (cdr context) object ptype event options))))))) + +(defvar *input-context*) (defun throw-object-ptype (object type &key (input-context *input-context*) sheet)

1 0

[mcclim-cvs] CVS update: mcclim/stream-input.lisp
by tmoore＠common-lisp.net 11 Jan '05

11 Jan '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv23180 Modified Files: stream-input.lisp Log Message: Save the last character returned by stream-read-gesture for unreading Date: Tue Jan 11 16:33:32 2005 Author: tmoore Index: mcclim/stream-input.lisp diff -u mcclim/stream-input.lisp:1.40 mcclim/stream-input.lisp:1.41 --- mcclim/stream-input.lisp:1.40 Thu Oct 14 08:30:11 2004 +++ mcclim/stream-input.lisp Tue Jan 11 16:33:32 2005 @@ -123,7 +123,11 @@ (defclass standard-extended-input-stream (extended-input-stream) ((pointer) - (cursor :initarg :text-cursor))) + (cursor :initarg :text-cursor) + (last-gesture :accessor last-gesture :initform nil + :documentation "Holds the last gesture returned by + stream-read-gesture (not peek-p), untransformed, so it can easily be + unread."))) (defvar *input-wait-test* nil) (defvar *input-wait-handler* nil) @@ -254,7 +258,8 @@ ;; An event should be in the stream buffer now. (when (handle-non-stream-event buffer) (go wait-for-char)) - (let ((gesture (convert-to-gesture (pop-gesture buffer peek-p)))) + (let* ((raw-gesture (pop-gesture buffer peek-p)) + (gesture (convert-to-gesture raw-gesture))) ;; Sometimes key press events get generated with a key code for ;; which there is no keysym. This seems to happen on my machine ;; when keys are hit rapidly in succession. I'm not sure if this is @@ -274,7 +279,8 @@ thereis (event-matches-gesture-name-p gesture gesture-name)) (signal 'accelerator-gesture :event gesture)) - (t (return-from stream-read-gesture gesture)))) + (t (setf (last-gesture stream) raw-gesture) + (return-from stream-read-gesture gesture)))) (go wait-for-char))))) @@ -315,8 +321,12 @@ (defmethod stream-unread-gesture ((stream standard-extended-input-stream) gesture) + (declare (ignore gesture)) (with-encapsulating-stream (estream stream) - (repush-gesture gesture (stream-input-buffer estream)))) + (let ((gesture (last-gesture stream))) + (when gesture + (setf (last-gesture stream) nil) + (repush-gesture gesture (stream-input-buffer estream)))))) ;;; Standard stream methods on standard-extended-input-stream. Ignore any ;;; pointer gestures in the input buffer.

1 0