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

[mcclim-cvs] CVS update: Directory change: mcclim/Apps/Inspector
by rstrandh＠common-lisp.net 29 Jan '05

29 Jan '05

Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory common-lisp.net:/tmp/cvs-serv21792/Inspector Log Message: Directory /project/mcclim/cvsroot/mcclim/Apps/Inspector added to the repository Date: Sat Jan 29 04:09:27 2005 Author: rstrandh New directory mcclim/Apps/Inspector added

1 0

[mcclim-cvs] CVS update: mcclim/Experimental/menu-choose.lisp
by ahefner＠common-lisp.net 26 Jan '05

26 Jan '05

Update of /project/mcclim/cvsroot/mcclim/Experimental In directory common-lisp.net:/tmp/cvs-serv30589 Modified Files: menu-choose.lisp Log Message: Remove usage of exit-window variable, which was totally wrong and made it difficult to exit via clicking outside the menu. I don't think this breaks what Tim Moore was trying to accomplish, for which switching from :presentation-button-press to :presentation-button-release should be sufficient. Note that I still think this menu implementation should go away and be replaced with the one in McCLIM/menu.lisp, if possible. :) Date: Tue Jan 25 20:29:07 2005 Author: ahefner Index: mcclim/Experimental/menu-choose.lisp diff -u mcclim/Experimental/menu-choose.lisp:1.15 mcclim/Experimental/menu-choose.lisp:1.16 --- mcclim/Experimental/menu-choose.lisp:1.15 Tue Jan 11 06:39:02 2005 +++ mcclim/Experimental/menu-choose.lisp Tue Jan 25 20:29:06 2005 @@ -266,24 +266,16 @@ :width x2 :height y2 :resize-frame t))) - ;; Eat pointer release event so it isn't fed spuriously to another - ;; command entering its own tracking-pointer loop. - (let ((*pointer-documentation-output* pointer-documentation) - (exit-menu nil)) + (let ((*pointer-documentation-output* pointer-documentation)) (tracking-pointer (menu :context-type presentation-type :multiple-window t :highlight t) - (:presentation (&key presentation) - (setq exit-menu t)) - (:pointer-button-release (&key event x y) ; Pointer clicked outside menu? - ; Close the menu. - (when exit-menu - (unless (and (sheet-ancestor-p (event-sheet event) menu) - (region-contains-position-p (sheet-region menu) x y)) - (return-from menu-choose-from-drawer (values nil))))) + (:pointer-button-press (&key event x y) ; Close if pointer clicked outside menu. + (unless (and (sheet-ancestor-p (event-sheet event) menu) + (region-contains-position-p (sheet-region menu) x y)) + (return-from menu-choose-from-drawer (values nil)))) (:presentation-button-release (&key event presentation x y) (if (and (sheet-ancestor-p (event-sheet event) menu) (region-contains-position-p (sheet-region menu) x y)) (return-from menu-choose-from-drawer (values (presentation-object presentation) event)) (return-from menu-choose-from-drawer (values nil))))))) -

1 0

[mcclim-cvs] CVS update: mcclim/medium.lisp
by afuchs＠common-lisp.net 24 Jan '05

24 Jan '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv2822 Modified Files: medium.lisp Log Message: commit a patch by Eric Marsden for a typo (http://paste.lisp.org/display/5237) squere->square Date: Mon Jan 24 15:03:45 2005 Author: afuchs Index: mcclim/medium.lisp diff -u mcclim/medium.lisp:1.53 mcclim/medium.lisp:1.54 --- mcclim/medium.lisp:1.53 Sun Mar 28 07:16:55 2004 +++ mcclim/medium.lisp Mon Jan 24 15:03:41 2005 @@ -536,7 +536,7 @@ (cap-shape :initarg :line-cap-shape :initform :butt :reader line-style-cap-shape - :type (member :butt :squere :round :no-end-point)) + :type (member :butt :square :round :no-end-point)) (dashes :initarg :line-dashes :initform nil :reader line-style-dashes

1 0

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

24 Jan '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv25788 Modified Files: commands.lisp Log Message: Changes to MAKE-PARTIAL-PARSER-FUN and supporting functions. If a command argument is unspecified and there is no default specified for that argument, then don't pass any any :default argument to the corresponding call to ACCEPT. Also, don't modify the variables that hold the return values for the arguments unless the user actually changes the value; this preserves thhe unspecified argument marker. This fixes the bug show-cmd-table-arg. Date: Mon Jan 24 01:36:01 2005 Author: tmoore Index: mcclim/commands.lisp diff -u mcclim/commands.lisp:1.50 mcclim/commands.lisp:1.51 --- mcclim/commands.lisp:1.50 Mon Dec 13 04:18:05 2004 +++ mcclim/commands.lisp Mon Jan 24 01:36:00 2005 @@ -575,7 +575,7 @@ "Mapping from command names to argument parsing functions.") -(defvar *unsupplied-argument-marker* (cons nil nil)) +(defvar *unsupplied-argument-marker* (gensym "UNSUPPLIED-ARGUMENT-MARKER")) (defvar *command-name-delimiters* '(command-delimiter)) @@ -614,29 +614,40 @@ ,@args) args))))))) -;;;accept for the partial command reader. Can this be refactored to share code -;;;with accept-form-for-argument? -(defun accept-form-for-argument-partial (stream ptype-arg command-arg) +;;; In the partial command reader accepting-values dialog, default +;;; values come either from the input command arguments, if a value +;;; was supplied, or from the default option for the command argument. +;;; +;;; accept for the partial command reader. Can this be refactored to +;;; share code with accept-form-for-argument? Probably not. +;;; +;;; original-command-arg is value entered by the user, or +;;; *unsupplied-argument-marker*. command-arg is the current value for the +;;; argument, originally bound to original-command-arg and now possibly +;;; changed by the user. +(defun accept-form-for-argument-partial (stream ptype-arg command-arg + original-command-arg ) (let ((accept-keys '(:default :default-type :display-default :prompt :documentation))) - (destructuring-bind (name ptype &rest key-args - &key (mentioned-default nil mentioned-default-p) - &allow-other-keys) + (destructuring-bind (name ptype &rest key-args) ptype-arg (declare (ignore name)) - (let ((accept-args-var (gensym "ACCEPT-ARGS"))) - `(let ((,accept-args-var - (list ,@(loop for (key val) on key-args by #'cddr - when (member key accept-keys) - append `(,key ,val) into args - finally (return (if mentioned-default-p - `(:default ,mentioned-default - ,@args) - args)))))) - (apply #'accept ,ptype :stream ,stream - (if (eq ,command-arg *unsupplied-argument-marker*) - ,accept-args-var - (list* :default ,command-arg ,accept-args-var)))))))) + (let ((args (loop + for (key val) on key-args by #'cddr + if (eq key :default) + append `(:default (if (eq ,command-arg + *unsupplied-argument-marker*) + ,val + ,command-arg)) + else if (member key accept-keys :test #'eq) + append `(,key ,val)))) + (if (member :default args :test #'eq) + `(accept ,ptype :stream ,stream ,@args) + `(if (eq ,original-command-arg *unsupplied-argument-marker*) + (accept ,ptype :stream ,stream ,@args) + (accept ,ptype :stream ,stream :default ,command-arg + ,@args))))))) + (defun make-keyword (sym) (intern (symbol-name sym) :keyword)) @@ -730,26 +741,38 @@ (defun make-partial-parser-fun (name required-args) (with-gensyms (command-table stream partial-command command-name command-line-name) - (let ((required-arg-names (mapcar #'car required-args))) - `(defun ,name (,command-table ,stream ,partial-command) - (destructuring-bind (,command-name ,@required-arg-names) - ,partial-command - (let ((,command-line-name (command-line-name-for-command - ,command-name - ,command-table - :errorp nil))) - (accepting-values (,stream) - (format ,stream - "You are being prompted for arguments to ~S~%" - ,command-line-name) - ,@(loop for var in required-arg-names - for parameter in required-args - append `((setq ,var - ,(accept-form-for-argument-partial stream - parameter - var)) - (terpri ,stream))))) - (list ,command-name ,@required-arg-names)))))) + (let* ((required-arg-names (mapcar #'car required-args)) + (original-args (mapcar #'(lambda (arg) + (gensym (format nil "~A-ORIGINAL" + (symbol-name arg)))) + required-arg-names))) + ;; We don't need fresh gensyms of these variables for each accept form. + (with-gensyms (value ptype changedp) + `(defun ,name (,command-table ,stream ,partial-command) + (destructuring-bind (,command-name ,@original-args) + ,partial-command + (let ((,command-line-name (command-line-name-for-command + ,command-name + ,command-table + :errorp nil)) + ,@(mapcar #'list required-arg-names original-args)) + (accepting-values (,stream) + (format ,stream + "You are being prompted for arguments to ~S~%" + ,command-line-name) + ,@(loop + for var in required-arg-names + for original-var in original-args + for parameter in required-args + append `((multiple-value-bind (,value ,ptype ,changedp) + ,(accept-form-for-argument-partial + stream parameter var original-var) + (declare (ignore ,ptype)) + (terpri ,stream) + (when ,changedp + (setq ,var ,value)))))) + (list ,command-name ,@required-arg-names)))))))) + ;;; XXX What do to about :acceptably? Probably need to wait for Goatee "buffer ;;; streams" so we can insert an accept-result-extent in the buffer for

1 0

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

22 Jan '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv16684 Modified Files: presentation-defs.lisp Log Message: In presentation method (present t t t textual-view), do the right thing with the :acceptably keyword argument i.e., arrange for Common Lisp to throw an error for unreadable stuff. Date: Sat Jan 22 14:31:08 2005 Author: tmoore Index: mcclim/presentation-defs.lisp diff -u mcclim/presentation-defs.lisp:1.40 mcclim/presentation-defs.lisp:1.41 --- mcclim/presentation-defs.lisp:1.40 Wed Jan 19 14:44:46 2005 +++ mcclim/presentation-defs.lisp Sat Jan 22 14:31:08 2005 @@ -829,7 +829,7 @@ (with-input-position (stream) ; support for calls to replace-input (setf (values sensitizer-object sensitizer-type) (with-input-context (type) - (object object-type event options) + (object object-type event options) (with-activation-gestures ((if additional-activations-p additional-activation-gestures activation-gestures) @@ -996,8 +996,12 @@ (define-default-presentation-method present (object type stream (view textual-view) &key acceptably for-context-type) - (declare (ignore acceptably for-context-type)) - (princ object stream)) + (declare (ignore for-context-type type)) + (if acceptably + (let ((*print-readably* t)) + (prin1 object stream)) + (princ object stream))) + (defun accept-using-read (stream ptype &key ((:read-eval *read-eval*) nil)) (let* ((token (read-token stream)))

1 0

[mcclim-cvs] CVS update: mcclim/builtin-commands.lisp
by tmoore＠common-lisp.net 22 Jan '05

22 Jan '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv5050 Modified Files: builtin-commands.lisp Log Message: Remove Describe Presentation from the default right-click menu. This means that interfaces will look much quiter. Date: Sat Jan 22 00:42:40 2005 Author: tmoore Index: mcclim/builtin-commands.lisp diff -u mcclim/builtin-commands.lisp:1.17 mcclim/builtin-commands.lisp:1.18 --- mcclim/builtin-commands.lisp:1.17 Tue May 18 03:47:46 2004 +++ mcclim/builtin-commands.lisp Sat Jan 22 00:42:40 2005 @@ -63,11 +63,6 @@ (define-gesture-name :describe-presentation :pointer-button-press (:left :super)) -;;; This is defined as a command, not just as a translator to -;;; com-describe, so it can be disabled independently of -;;; com-describe. Also, it might do something different from -;;; com-describe someday. - ;;; The argument obj is not really the presentation object but the ;;; presentation itself as supplied by the translator. (define-command (com-describe-presentation :command-table global-command-table) @@ -80,7 +75,8 @@ :tester ((presentation) (not (eq presentation *null-presentation*))) :documentation "Describe Presentation" - :pointer-documentation "Describe Presentation") + :pointer-documentation "Describe Presentation" + :menu presentation-debugging) (presentation) (list presentation))

1 0

[mcclim-cvs] CVS update: mcclim/panes.lisp
by ahefner＠common-lisp.net 21 Jan '05

21 Jan '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv3255 Modified Files: panes.lisp Log Message: Implement label option to open-window-stream. Date: Fri Jan 21 03:01:44 2005 Author: ahefner Index: mcclim/panes.lisp diff -u mcclim/panes.lisp:1.147 mcclim/panes.lisp:1.148 --- mcclim/panes.lisp:1.147 Sat Jan 1 21:26:44 2005 +++ mcclim/panes.lisp Fri Jan 21 03:01:37 2005 @@ -27,7 +27,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. -;;; $Id: panes.lisp,v 1.147 2005/01/02 05:26:44 ahefner Exp $ +;;; $Id: panes.lisp,v 1.148 2005/01/21 11:01:37 ahefner Exp $ (in-package :clim-internals) @@ -2543,6 +2543,7 @@ (frame (make-application-frame 'a-window-stream :frame-event-queue input-buffer :frame-manager fm + :pretty-name (or label "") :left left :top top :right right @@ -2556,6 +2557,7 @@ (eq (frame-state frame) :shrunk)) (enable-frame frame)) ;; Start a new thread to run the event loop, if necessary. + #+CLIM-MP (unless input-buffer (clim-sys:make-process (lambda () (let ((*application-frame* frame)) (standalone-event-loop)))))

1 0

[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