[mcclim-cvs] CVS mcclim

thenriksen thenriksen at common-lisp.net
Tue May 29 12:34:21 UTC 2007


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"




More information about the Mcclim-cvs mailing list