January 2006 - mcclim-cvs@common-lisp.net

[mcclim-cvs] CVS update: mcclim/input.lisp
by cfruhwirth＠common-lisp.net 16 Jan '06

16 Jan '06

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp:/tmp/cvs-serv25595 Modified Files: input.lisp Log Message: Remove superfluous closing-parenthesis. Date: Mon Jan 16 07:16:38 2006 Author: cfruhwirth Index: mcclim/input.lisp diff -u mcclim/input.lisp:1.34 mcclim/input.lisp:1.35 --- mcclim/input.lisp:1.34 Fri Jan 13 10:51:03 2006 +++ mcclim/input.lisp Mon Jan 16 07:16:38 2006 @@ -559,4 +559,4 @@ ((eq button +pointer-wheel-left+) (scroll-sheet sheet 0 -1)) ((eq button +pointer-wheel-right+) (scroll-sheet sheet 0 1)) (t (call-next-method)))) ; not a scroll wheel button - (call-next-method)))) ; no viewport + (call-next-method))) ; no viewport

1 0

[mcclim-cvs] CVS update: mcclim/input.lisp
by cfruhwirth＠common-lisp.net 13 Jan '06

13 Jan '06

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv7567 Modified Files: input.lisp Log Message: Rewrite dispatch-event for mouse-wheel-scroll-mixin to work with left and right scrolling wheel buttons. Date: Fri Jan 13 17:51:03 2006 Author: cfruhwirth Index: mcclim/input.lisp diff -u mcclim/input.lisp:1.33 mcclim/input.lisp:1.34 --- mcclim/input.lisp:1.33 Fri Jul 1 14:59:39 2005 +++ mcclim/input.lisp Fri Jan 13 17:51:03 2006 @@ -535,23 +535,28 @@ (defmethod scroll-quantum (pane) 10) +(defun scroll-sheet (sheet vertical horizontal) + (with-bounding-rectangle* (vx0 vy0 vx1 vy1) (pane-viewport-region sheet) + (with-bounding-rectangle* (sx0 sy0 sx1 sy1) (sheet-region sheet) + (let ((viewport-height (- vy1 vy0)) + (viewport-width (- vx1 vx0)) + (delta (* *mouse-scroll-distance* + (scroll-quantum sheet)))) + ;; The coordinates (x,y) of the new upper-left corner of the viewport + ;; must be "sx0 < x < sx1 - viewport-width" and + ;; "sy0 < y < sy1 - viewport-height" + (scroll-extent sheet + (max sx0 (min (- sx1 viewport-width) (+ vx0 (* delta horizontal)))) + (max sy0 (min (- sy1 viewport-height) (+ vy0 (* delta vertical))))))))) + (defmethod dispatch-event :around ((sheet mouse-wheel-scroll-mixin) (event pointer-button-press-event)) - (let ((viewport (pane-viewport sheet)) - (button (pointer-event-button event)) - (dy (* *mouse-scroll-distance* - (scroll-quantum sheet)))) - (if (and viewport - (or (eql button +pointer-wheel-up+) - (eql button +pointer-wheel-down+))) - (multiple-value-bind (x0 y0 x1 y1) - (bounding-rectangle* (pane-viewport-region sheet)) - (declare (ignore x1)) - (multiple-value-bind (sx0 sy0 sx1 sy1) - (bounding-rectangle* (sheet-region sheet)) - (declare (ignore sx0 sx1)) - (let ((height (- y1 y0))) - (scroll-extent sheet x0 (if (eql button +pointer-wheel-up+) - (max sy0 (- y0 dy)) - (- (min sy1 (+ y1 dy)) height)))))) - (call-next-method)))) \ No newline at end of file + (if (pane-viewport sheet) + (let ((button (pointer-event-button event))) + (cond + ((eq button +pointer-wheel-up+) (scroll-sheet sheet -1 0)) + ((eq button +pointer-wheel-down+) (scroll-sheet sheet 1 0)) + ((eq button +pointer-wheel-left+) (scroll-sheet sheet 0 -1)) + ((eq button +pointer-wheel-right+) (scroll-sheet sheet 0 1)) + (t (call-next-method)))) ; not a scroll wheel button + (call-next-method)))) ; no viewport

1 0

[mcclim-cvs] CVS update: mcclim/recording.lisp
by cfruhwirth＠common-lisp.net 13 Jan '06

13 Jan '06

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv18663 Modified Files: recording.lisp Log Message: %handle-repaint derives the bounding rectangle for region. There are two cases where region does not participate in the bounding rectangle protocol: +everywhere+ and +nowhere+, the only two regions in the unbound region class. For +everywhere+, fallback to the bounding rectangle of sheet. For +nowhere+, ignore repaint. Date: Fri Jan 13 13:18:11 2006 Author: cfruhwirth Index: mcclim/recording.lisp diff -u mcclim/recording.lisp:1.120 mcclim/recording.lisp:1.121 --- mcclim/recording.lisp:1.120 Thu Dec 1 12:10:55 2005 +++ mcclim/recording.lisp Fri Jan 13 13:17:55 2006 @@ -2237,11 +2237,14 @@ (defun %handle-repaint (stream region) (when (output-recording-stream-p stream) - (let ((region (bounding-rectangle region))) - (with-bounding-rectangle* (x1 y1 x2 y2) region - (with-output-recording-options (stream :record nil) - (draw-rectangle* stream x1 y1 x2 y2 :filled T :ink +background-ink+))) - (stream-replay stream region)))) + (unless (region-equal region +nowhere+) ; ignore repaint requests for +nowhere+ + (let ((region (if (region-equal region +everywhere+) + (sheet-region stream) ; fallback to the sheet's region for +everwhere+ + (bounding-rectangle region)))) + (with-bounding-rectangle* (x1 y1 x2 y2) region + (with-output-recording-options (stream :record nil) + (draw-rectangle* stream x1 y1 x2 y2 :filled T :ink +background-ink+))) + (stream-replay stream region))))) (defmethod handle-repaint ((stream output-recording-stream) region) (%handle-repaint stream region))

1 0

[mcclim-cvs] CVS update: mcclim/Backends/CLX/port.lisp
by cfruhwirth＠common-lisp.net 13 Jan '06

13 Jan '06

Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory common-lisp.net:/tmp/cvs-serv12046 Modified Files: port.lisp Log Message: Enable :pointer-motion in default event mask for realize-mirror-aux. This unbreaks tracking-pointer's pointer-motion for all regular sheets. Previously, it only worked for clim-stream-pane, because clim-stream-pane overrode the defaults. This will cause additional traffic between the X11 server and CLIM, however the CLIM spec does not provide a way to selectively enable or disable events (only total muting is possible). Therefore, we must shove all events to a sheet as we have no way to find out if an event is handled or not. Date: Fri Jan 13 12:05:06 2006 Author: cfruhwirth Index: mcclim/Backends/CLX/port.lisp diff -u mcclim/Backends/CLX/port.lisp:1.116 mcclim/Backends/CLX/port.lisp:1.117 --- mcclim/Backends/CLX/port.lisp:1.116 Thu Jan 12 22:08:06 2006 +++ mcclim/Backends/CLX/port.lisp Fri Jan 13 12:05:06 2006 @@ -345,8 +345,8 @@ :button-press :button-release :enter-window :leave-window :structure-notify - ;:pointer-motion - :button-motion))) + :pointer-motion + :button-motion))) (when (null (port-lookup-mirror port sheet)) (update-mirror-geometry sheet) (let* ((desired-color (typecase sheet

1 0

[mcclim-cvs] CVS update: mcclim/commands.lisp
by cfruhwirth＠common-lisp.net 13 Jan '06

13 Jan '06

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv4901 Modified Files: commands.lisp Log Message: According to the CLIM Spec, Chapter 26, accepting-values must be supplied with accept forms that either have unique query-identifiers or unique prompts (query-identifier is derived from prompt if query-id is missing). When the partial command parser is called for commands that have two arguments with the same type, two identical prompts are generated. That is not allowed. Fix by generating a unique query-identifier via gensym in accept-form-for-argument-partial. Date: Fri Jan 13 10:26:21 2006 Author: cfruhwirth Index: mcclim/commands.lisp diff -u mcclim/commands.lisp:1.56 mcclim/commands.lisp:1.57 --- mcclim/commands.lisp:1.56 Thu Dec 1 12:10:54 2005 +++ mcclim/commands.lisp Fri Jan 13 10:26:21 2006 @@ -639,6 +639,7 @@ ,command-arg)) else if (member key accept-keys :test #'eq) append `(,key ,val)))) + (setq args (append args `(:query-identifier ',(gensym "COMMAND-PROMPT-ID")))) (if (member :default args :test #'eq) `(accept ,ptype :stream ,stream ,@args) `(if (eq ,original-command-arg *unsupplied-argument-marker*)

1 0

[mcclim-cvs] CVS update: mcclim/Backends/CLX/port.lisp
by cfruhwirth＠common-lisp.net 12 Jan '06

12 Jan '06

Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory common-lisp.net:/tmp/cvs-serv12975 Modified Files: port.lisp Log Message: Add handler-case for destroy-port to handle stream-errors thrown by xlib:close-display. Required to destroy ports with a connection already closed/reseted by the X server (xkilled client or network drop outs) Date: Thu Jan 12 22:08:08 2006 Author: cfruhwirth Index: mcclim/Backends/CLX/port.lisp diff -u mcclim/Backends/CLX/port.lisp:1.115 mcclim/Backends/CLX/port.lisp:1.116 --- mcclim/Backends/CLX/port.lisp:1.115 Wed Jan 11 09:30:56 2006 +++ mcclim/Backends/CLX/port.lisp Thu Jan 12 22:08:06 2006 @@ -536,7 +536,10 @@ (xlib:unmap-window (sheet-direct-mirror mirror)) ) (defmethod destroy-port :before ((port clx-port)) - (xlib:close-display (clx-port-display port))) + (handler-case + (xlib:close-display (clx-port-display port)) + (stream-error () + (xlib:close-display (clx-port-display port) :abort t)))) (defmethod port-motion-hints ((port clx-port) (sheet mirrored-sheet-mixin)) (let ((event-mask (xlib:window-event-mask (sheet-direct-mirror sheet))))

1 0

[mcclim-cvs] CVS update: mcclim/Backends/CLX/port.lisp
by ahefner＠common-lisp.net 11 Jan '06

11 Jan '06

Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory common-lisp.net:/tmp/cvs-serv1768/Backends/CLX Modified Files: port.lisp Log Message: Add wheel left/right constants. TODO: Support left/right scrolling of panes (I don't have an appropriate input device to test this, so I leave it for someone else). Date: Wed Jan 11 09:30:57 2006 Author: ahefner Index: mcclim/Backends/CLX/port.lisp diff -u mcclim/Backends/CLX/port.lisp:1.114 mcclim/Backends/CLX/port.lisp:1.115 --- mcclim/Backends/CLX/port.lisp:1.114 Mon Nov 28 15:21:45 2005 +++ mcclim/Backends/CLX/port.lisp Wed Jan 11 09:30:56 2006 @@ -571,11 +571,12 @@ +pointer-middle-button+ +pointer-right-button+ +pointer-wheel-up+ - +pointer-wheel-down+))) - (if (and (> code 0) - (<= code (1+ (length button-mapping)))) - (aref button-mapping (1- code)) - nil))) + +pointer-wheel-down+ + +pointer-wheel-left+ + +pointer-wheel-right+))) + (and (> code 0) + (<= code (1+ (length button-mapping))) + (aref button-mapping (1- code))))) ;; From "Inter-Client Communication Conventions Manual", Version 2.0.xf86.1, ;; section 4.1.5:

1 0

[mcclim-cvs] CVS update: mcclim/events.lisp mcclim/package.lisp
by ahefner＠common-lisp.net 11 Jan '06

11 Jan '06

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv1768 Modified Files: events.lisp package.lisp Log Message: Add wheel left/right constants. TODO: Support left/right scrolling of panes (I don't have an appropriate input device to test this, so I leave it for someone else). Date: Wed Jan 11 09:30:56 2006 Author: ahefner Index: mcclim/events.lisp diff -u mcclim/events.lisp:1.26 mcclim/events.lisp:1.27 --- mcclim/events.lisp:1.26 Thu Oct 14 08:30:11 2004 +++ mcclim/events.lisp Wed Jan 11 09:30:55 2006 @@ -304,6 +304,8 @@ (defconstant +pointer-right-button+ #x04) (defconstant +pointer-wheel-up+ #x08) (defconstant +pointer-wheel-down+ #x10) +(defconstant +pointer-wheel-left+ #x20) +(defconstant +pointer-wheel-right+ #x40) (defconstant +shift-key+ #x0100) (defconstant +control-key+ #x0200) Index: mcclim/package.lisp diff -u mcclim/package.lisp:1.50 mcclim/package.lisp:1.51 --- mcclim/package.lisp:1.50 Fri Aug 12 04:26:00 2005 +++ mcclim/package.lisp Wed Jan 11 09:30:55 2006 @@ -1638,6 +1638,8 @@ (:export #:+pointer-wheel-up+ #:+pointer-wheel-down+ + #:+pointer-wheel-left+ + #:+pointer-wheel-right+ #:sheet-pointer-cursor) ;;; x11 color names - some are not in the spec - mikemac

1 0

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

04 Jan '06

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv32753 Modified Files: presentation-defs.lisp Log Message: fix behavior of :allow-sensitive-inferiors in with-output-as-presentation. It was disabling the current presentation as well as the inferiors. Date: Wed Jan 4 10:45:36 2006 Author: tmoore Index: mcclim/presentation-defs.lisp diff -u mcclim/presentation-defs.lisp:1.48 mcclim/presentation-defs.lisp:1.49 --- mcclim/presentation-defs.lisp:1.48 Fri Sep 2 13:36:48 2005 +++ mcclim/presentation-defs.lisp Wed Jan 4 10:45:35 2006 @@ -280,24 +280,23 @@ (with-gensyms (record-arg continuation) (with-keywords-removed (key-args (:record-type :allow-sensitive-inferiors)) - `(let ((*allow-sensitive-inferiors* - (if *allow-sensitive-inferiors* - ,allow-sensitive-inferiors - nil))) - (flet ((,continuation () - ,@decls - ,@with-body)) - (declare (dynamic-extent #'continuation)) - (if (and (output-recording-stream-p ,stream) - *allow-sensitive-inferiors*) - (with-new-output-record - (,stream ,record-type ,record-arg - :object ,object - :type (expand-presentation-type-abbreviation - ,type) - ,@key-args) - (,continuation)) - (,continuation)))))))) + `(flet ((,continuation () + ,@decls + ,@with-body)) + (declare (dynamic-extent #'continuation)) + (if (and (output-recording-stream-p ,stream) + *allow-sensitive-inferiors*) + (with-new-output-record + (,stream ,record-type ,record-arg + :object ,object + :type (expand-presentation-type-abbreviation + ,type) + ,@key-args) + (let ((*allow-sensitive-inferiors* + ,allow-sensitive-inferiors)) + (,continuation))) + (,continuation))))))) + (defun present (object &optional (type (presentation-type-of object)) &key @@ -337,9 +336,10 @@ (allow-sensitive-inferiors t) (sensitive t) (record-type 'standard-presentation)) - (let ((*allow-sensitive-inferiors* (if *allow-sensitive-inferiors* - sensitive - nil))) + ;; *allow-sensitive-inferiors* controls whether or not + ;; with-output-as-presentation will emit a presentation + (let ((*allow-sensitive-inferiors* (and *allow-sensitive-inferiors* + sensitive))) (with-output-as-presentation (stream object type :view view :modifier modifier

1 0

[mcclim-cvs] CVS update: mcclim/Apps/Listener/icons.lisp
by mretzlaff＠common-lisp.net 01 Jan '06

01 Jan '06

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory common-lisp.net:/tmp/cvs-serv22828 Modified Files: icons.lisp Log Message: The old version was probably not portable, it's now using the "portablized" version LIST-DIRECTORY that is defined in util.lisp. More important a wild pathname will be created first. (This actually has bitten me: I've created a core image that includes my File Selector that uses the functions of the Clim Listener to display directories. This image was going to be run on other computers that have no mcclim sources installed (not to speak about installed in equivalent directories). As PRECACHE-ICONS did not work and the icons for which there are no separate DEFICON constructs have not been cached, it tried to load the icon "up-folder.xpm" in COM-SHOW-DIRECTORY. . .) By the way, what do you think about getting rid of the pathname functions in util.lisp and depend on CL-FAD instead (the, so to speak, maintained version of Peter Seibel's :com.gigamonkeys.pathnames package)? Why shouldn't we use a nice library if it already exists? (In addition to this, the File Selector uses it as well -- particularly cl-fad:pathname-as-directory --, although it is not yet commited to the CVS.) Date: Sun Jan 1 11:14:55 2006 Author: mretzlaff Index: mcclim/Apps/Listener/icons.lisp diff -u mcclim/Apps/Listener/icons.lisp:1.3 mcclim/Apps/Listener/icons.lisp:1.4 --- mcclim/Apps/Listener/icons.lisp:1.3 Sun Jan 2 06:14:28 2005 +++ mcclim/Apps/Listener/icons.lisp Sun Jan 1 11:14:50 2006 @@ -64,7 +64,8 @@ (defun precache-icons () (let ((pathnames (remove-if #'directoryp - (directory (strip-filespec *icon-path*))))) + (list-directory (gen-wild-pathname + (strip-filespec *icon-path*)))))) (dolist (pn pathnames) (standard-icon (namestring (make-pathname :name (pathname-name pn) :type (pathname-type pn)))))))

1 0