mcclim-cvs

mcclim-cvs@common-lisp.net

1697 discussions

[mcclim-cvs] CVS update: mcclim/Apps/Inspector/inspector.lisp
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-serv30166 Modified Files: inspector.lisp Log Message: Better layout for standard-object Date: Sat Jan 29 06:58:30 2005 Author: rstrandh Index: mcclim/Apps/Inspector/inspector.lisp diff -u mcclim/Apps/Inspector/inspector.lisp:1.2 mcclim/Apps/Inspector/inspector.lisp:1.3 --- mcclim/Apps/Inspector/inspector.lisp:1.2 Sat Jan 29 06:48:38 2005 +++ mcclim/Apps/Inspector/inspector.lisp Sat Jan 29 06:58:29 2005 @@ -119,13 +119,16 @@ (formatting-cell (pane) (surrounding-output-with-border (pane) (print (class-name class) pane)))) - (loop for slot in (reverse (class-slots class)) - do (let ((slot-name (slot-definition-name slot))) - (formatting-row (pane) - (formatting-cell (pane :align-x :right) - (format pane "~a:" slot-name)) - (formatting-cell (pane) - (inspect-object (slot-value object slot-name) pane))))))))) + (formatting-row (pane) + (formatting-cell (pane) + (formatting-table (pane) + (loop for slot in (reverse (class-slots class)) + do (let ((slot-name (slot-definition-name slot))) + (formatting-row (pane) + (formatting-cell (pane :align-x :right) + (format pane "~a:" slot-name)) + (formatting-cell (pane) + (inspect-object (slot-value object slot-name) pane)))))))))))) (defmethod inspect-object ((object cons) pane) (if (null (cdr object))

1 0

[mcclim-cvs] CVS update: mcclim/Apps/Inspector/inspector.lisp
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-serv30104 Modified Files: inspector.lisp Log Message: Better layout for generic functions. Date: Sat Jan 29 06:48:38 2005 Author: rstrandh Index: mcclim/Apps/Inspector/inspector.lisp diff -u mcclim/Apps/Inspector/inspector.lisp:1.1 mcclim/Apps/Inspector/inspector.lisp:1.2 --- mcclim/Apps/Inspector/inspector.lisp:1.1 Sat Jan 29 04:10:54 2005 +++ mcclim/Apps/Inspector/inspector.lisp Sat Jan 29 06:48:38 2005 @@ -182,16 +182,19 @@ (formatting-row (pane) (formatting-cell (pane) (surrounding-output-with-border (pane) - (print (generic-function-name object) pane)))) - (loop for method in (generic-function-methods object) - do (with-output-as-presentation - (pane method (presentation-type-of method)) - (formatting-row (pane) - (formatting-cell (pane) - (print (method-qualifiers method))) - (loop for specializer in (method-specializers method) - do (formatting-cell (pane) - (format pane "~s " (class-name specializer)))))))))) + (format pane "Generic Function: ~s" (generic-function-name object))))) + (formatting-row (pane) + (formatting-cell (pane) + (formatting-table (pane) + (loop for method in (generic-function-methods object) + do (with-output-as-presentation + (pane method (presentation-type-of method)) + (formatting-row (pane) + (formatting-cell (pane) + (print (method-qualifiers method))) + (loop for specializer in (method-specializers method) + do (formatting-cell (pane) + (format pane "~s " (class-name specializer))))))))))))) (defun display-app (frame pane) (inspect-object (obj frame) pane))

1 0

[mcclim-cvs] CVS update: mcclim/Apps/Inspector/INSTALL mcclim/Apps/Inspector/inspector.asd mcclim/Apps/Inspector/inspector.lisp
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-serv21831 Added Files: INSTALL inspector.asd inspector.lisp Log Message: Embryonic inspector application. Date: Sat Jan 29 04:10:54 2005 Author: rstrandh

1 0

[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

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