mcclim-cvs May 2007

mcclim-cvs@common-lisp.net

2 participants
5 discussions

[mcclim-cvs] CVS mcclim
by thenriksen 29 May '07

29 May '07

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv14661 Modified Files: dialog.lisp Log Message: Committed patch from Daniel Jensen changing name of ACCEPTING-VALUES command table to ACCEPT-VALUES. --- /project/mcclim/cvsroot/mcclim/dialog.lisp 2006/12/21 23:14:20 1.25 +++ /project/mcclim/cvsroot/mcclim/dialog.lisp 2007/05/29 12:34:20 1.26 @@ -117,7 +117,7 @@ ;;; The accepting-values state machine is controlled by commands. Each ;;; action (e.g., "select a text field") terminates -(define-command-table accepting-values) ; :inherit-from nil??? +(define-command-table accept-values) ; :inherit-from nil??? (defvar *default-command* '(accepting-values-default-command)) @@ -188,7 +188,7 @@ modify-initial-query resynchronize-every-pass resize-frame align-prompts label scroll-bars x-position y-position width height - (command-table 'accepting-values) + (command-table 'accept-values) (frame-class 'accept-values)) (declare (ignore own-window exit-boxes modify-initial-query resize-frame label scroll-bars x-position y-position @@ -226,7 +226,7 @@ (when resynchronize-every-pass (redisplay arecord stream))) (with-input-context - ('(command :command-table accepting-values)) + ('(command :command-table accept-values)) (object) (progn (apply (command-name current-command) @@ -298,7 +298,9 @@ :default default :default-supplied-p default-supplied-p :value default)) - (setf (queries stream) (nconc (queries stream) (list query)))) + (setf (queries stream) (nconc (queries stream) (list query))) + (when default + (setf (changedp query) t))) (setf (accept-arguments query) rest-args) ;; If the program changes the default, that becomes the value. (unless (equal default (default query)) @@ -338,20 +340,20 @@ (declare (ignore view)) (apply #'prompt-for-accept-1 stream type :display-default nil args)) -(define-command (com-query-exit :command-table accepting-values +(define-command (com-query-exit :command-table accept-values :name nil :provide-output-destination-keyword nil) () (signal 'av-exit)) -(define-command (com-query-abort :command-table accepting-values +(define-command (com-query-abort :command-table accept-values :name nil :provide-output-destination-keyword nil) () (and (find-restart 'abort) (invoke-restart 'abort))) -(define-command (com-change-query :command-table accepting-values +(define-command (com-change-query :command-table accept-values :name nil :provide-output-destination-keyword nil) ((query-identifier t) @@ -372,7 +374,7 @@ (:documentation "Deselect a query field: turn the cursor off, turn off highlighting, etc." )) -(define-command (com-select-query :command-table accepting-values +(define-command (com-select-query :command-table accept-values :name nil :provide-output-destination-keyword nil) ((query-identifier t)) @@ -391,14 +393,14 @@ (when query (setf selected-query query) (select-query *accepting-values-stream* query (record query)) - (let ((command-ptype '(command :command-table accepting-values))) + (let ((command-ptype '(command :command-table accept-values))) (if (cdr query-list) (throw-object-ptype `(com-select-query ,(query-identifier (cadr query-list))) command-ptype) (throw-object-ptype '(com-deselect-query) command-ptype)))))))) -(define-command (com-deselect-query :command-table accepting-values +(define-command (com-deselect-query :command-table accept-values :name nil :provide-output-destination-keyword nil) () @@ -587,7 +589,7 @@ (define-presentation-to-command-translator com-select-field - (selectable-query com-select-query accepting-values + (selectable-query com-select-query accept-values :gesture :select :documentation "Select field for input" :pointer-documentation "Select field for input" @@ -600,7 +602,7 @@ `(,object)) (define-presentation-to-command-translator com-exit-button - (exit-button com-query-exit accepting-values + (exit-button com-query-exit accept-values :gesture :select :documentation "Exit dialog" :pointer-documentation "Exit dialog" @@ -609,7 +611,7 @@ ()) (define-presentation-to-command-translator com-abort-button - (abort-button com-query-abort accepting-values + (abort-button com-query-abort accept-values :gesture :select :documentation "Abort dialog" :pointer-documentation "Abort dialog"

1 0

[mcclim-cvs] CVS mcclim/Apps/Scigraph/scigraph
by thenriksen 29 May '07

29 May '07

Update of /project/mcclim/cvsroot/mcclim/Apps/Scigraph/scigraph In directory clnet:/tmp/cvs-serv14661/Apps/Scigraph/scigraph Modified Files: popup-accept.lisp popup-accept-methods.lisp Log Message: Committed patch from Daniel Jensen changing name of ACCEPTING-VALUES command table to ACCEPT-VALUES. --- /project/mcclim/cvsroot/mcclim/Apps/Scigraph/scigraph/popup-accept.lisp 2004/08/06 13:19:40 1.5 +++ /project/mcclim/cvsroot/mcclim/Apps/Scigraph/scigraph/popup-accept.lisp 2007/05/29 12:34:20 1.6 @@ -158,8 +158,7 @@ (list object window presentation)) (install-command #+(or clim-0.9 (not clim)) :accept-values - #+(or clim-1.0 (and clim-2 (not mcclim))) 'clim::accept-values - #+mcclim 'climi::accepting-values ; who knows... --moore + #+(or clim-1.0 clim-2 mcclim) 'clim::accept-values 'com-pop-edit) --- /project/mcclim/cvsroot/mcclim/Apps/Scigraph/scigraph/popup-accept-methods.lisp 2003/11/04 14:52:18 1.2 +++ /project/mcclim/cvsroot/mcclim/Apps/Scigraph/scigraph/popup-accept-methods.lisp 2007/05/29 12:34:20 1.3 @@ -96,15 +96,13 @@ (list object window presentation)) (install-command #+(or clim-0.9 (not clim)) 'accept-values - #+(or clim-1.0 (and clim-2 (not mcclim))) 'clim::accept-values - #+mcclim 'climi::accepting-values + #+(or clim-1.0 clim-2 mcclim) 'clim::accept-values 'com-pop-edit-dataset) #+(or clim-1.0 clim-2) (define-presentation-to-command-translator com-pop-edit-dataset (graph-data :command-name com-pop-edit-dataset - :command-table #-mcclim clim::accept-values - #+mcclim climi::accepting-values + :command-table clim::accept-values :documentation "Change Data Symbols..." :menu t :gesture :select)

1 0

[mcclim-cvs] CVS mcclim/ESA
by crhodes 23 May '07

23 May '07

Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv6101 Modified Files: esa.lisp Log Message: Take input focus when reading gestures for help; This fixes the ESA help commands when a Drei gadget pane is being used. (It might be that accepting a gesture would be better, at which point the stream-accept method would kick in automatically). --- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/02/21 12:35:36 1.6 +++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/05/23 14:41:48 1.7 @@ -1040,14 +1040,14 @@ :width 400)) (defun read-gestures-for-help (command-table) - (loop for gestures = (list (esa-read-gesture)) - then (nconc gestures (list (esa-read-gesture))) - for item = (find-gestures-with-inheritance gestures command-table) - unless item - do (return (values nil gestures)) - when (eq (command-menu-item-type item) :command) - do (return (values (command-menu-item-value item) - gestures)))) + (with-input-focus (t) + (loop for gestures = (list (esa-read-gesture)) + then (nconc gestures (list (esa-read-gesture))) + for item = (find-gestures-with-inheritance gestures command-table) + unless item + do (return (values nil gestures)) + when (eq (command-menu-item-type item) :command) + do (return (values (command-menu-item-value item) gestures))))) (defun describe-key-briefly (pane) (let ((command-table (command-table pane)))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 06 May '07

06 May '07

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv19970 Modified Files: lr-syntax.lisp Log Message: Added parser hack to make it possible to extend incomplete-lexemes to the end of the buffer, instead of to their last lexeme. --- /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2007/04/27 21:37:14 1.1 +++ /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2007/05/06 13:54:11 1.2 @@ -160,14 +160,17 @@ until (typep child type) finally (return result)))) -(defmacro reduce-until-type (symbol type) +(defmacro reduce-until-type (symbol type &optional end-of-buffer) `(let ((result (make-instance ',symbol - :children (pop-until-type syntax ',type)))) - (when (null (children result)) - (with-slots (scan) syntax - (with-slots (start-mark size) result - (setf start-mark (clone-mark scan :right) - size 0)))) + :children (pop-until-type syntax ',type)))) + (with-slots (start-mark size) result + (when (null (children result)) + (with-slots (scan) syntax + (setf start-mark (clone-mark scan :right) + size 0))) + (when ,end-of-buffer + (setf size (- (size (buffer syntax)) + (start-offset result))))) result)) (defun pop-all (syntax)

1 0

[mcclim-cvs] CVS mcclim/Tests
by crhodes 04 May '07

04 May '07

Update of /project/mcclim/cvsroot/mcclim/Tests In directory clnet:/tmp/cvs-serv28269 Modified Files: commands.lisp input-editing.lisp postscript.lisp regions.lisp Added Files: run-tests.lisp Log Message: Improve test workflow a little bit: can now just load run-tests.lisp --- /project/mcclim/cvsroot/mcclim/Tests/commands.lisp 2006/04/21 12:03:23 1.4 +++ /project/mcclim/cvsroot/mcclim/Tests/commands.lisp 2007/05/04 11:24:07 1.5 @@ -1,6 +1,3 @@ -(defpackage :clim-tests - (:use :clim-lisp :clim)) - (in-package :clim-tests) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; --- /project/mcclim/cvsroot/mcclim/Tests/input-editing.lisp 2006/04/25 10:16:13 1.2 +++ /project/mcclim/cvsroot/mcclim/Tests/input-editing.lisp 2007/05/04 11:24:07 1.3 @@ -1,6 +1,3 @@ -(defpackage :clim-tests - (:use :clim-lisp :clim)) - (in-package :clim-tests) (assert (null *activation-gestures*)) --- /project/mcclim/cvsroot/mcclim/Tests/postscript.lisp 2006/03/07 14:59:29 1.2 +++ /project/mcclim/cvsroot/mcclim/Tests/postscript.lisp 2007/05/04 11:24:07 1.3 @@ -1,6 +1,4 @@ -(defpackage :clim-postscript-tests - (:use :clim :clim-lisp)) -(in-package :clim-postscript-tests) +(in-package :clim-tests) (let ((psfilename "/tmp/clim-postscript-test.ps") (epsfilename "/tmp/clim-postscript-test.eps")) --- /project/mcclim/cvsroot/mcclim/Tests/regions.lisp 2006/03/06 16:09:12 1.5 +++ /project/mcclim/cvsroot/mcclim/Tests/regions.lisp 2007/05/04 11:24:07 1.6 @@ -1,6 +1,3 @@ -(defpackage :clim-tests - (:use :clim-lisp :clim)) - (in-package :clim-tests) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; --- /project/mcclim/cvsroot/mcclim/Tests/run-tests.lisp 2007/05/04 11:24:08 NONE +++ /project/mcclim/cvsroot/mcclim/Tests/run-tests.lisp 2007/05/04 11:24:08 1.1 (defpackage :clim-tests (:use :clim-lisp :clim)) (let ((files (remove *load-pathname* (directory (merge-pathnames (make-pathname :name :wild) *load-pathname*)) :test #'equal))) (dolist (f files) (handler-case (load f) (error (c) (format *error-output* "~@<Error in file ~S:~2I~_~A~@:>" f c)))))

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

mcclim-cvs May 2007