[mcclim-cvs] CVS mcclim/ESA

thenriksen thenriksen at common-lisp.net
Wed Dec 19 11:02:01 UTC 2007


Update of /project/mcclim/cvsroot/mcclim/ESA
In directory clnet:/tmp/cvs-serv29422/ESA

Modified Files:
	esa.lisp esa-command-parser.lisp 
Log Message:
Use the default value of the parameter for parameters specified to use
the value of the numeric argument, when no numeric argument is
provided.

Changed Drei command definitions to handle this.


--- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp	2007/12/08 08:53:48	1.12
+++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp	2007/12/19 11:01:57	1.13
@@ -353,8 +353,6 @@
   "While a command is being run, this symbol will be dynamically
 bound to the current command processor.")
 
-(defvar *numeric-argument-p* (list nil))
-
 (defun find-gestures (gestures start-table)
   (loop with table = (find-command-table start-table)
 	for (gesture . rest) on gestures
@@ -623,9 +621,6 @@
 	  (t (values 1 nil (when first-gesture
                              (cons first-gesture gestures)))))))
 
-(defun substitute-numeric-argument-p (command numargp)
-  (substitute numargp *numeric-argument-p* command :test #'eq))
-
 (defgeneric process-gestures (command-processor)
   (:documentation "Process the gestures accumulated in
 `command-processor', returning T if there are no gestures
@@ -655,14 +650,14 @@
                       (*current-gesture* (first (last gestures))))
                   (unless (consp command)
                     (setf command (list command)))
-                  (setf command (substitute-numeric-argument-marker command prefix-arg))
-                  (setf command (substitute-numeric-argument-p command prefix-p))
-                  (unwind-protect (when (member *unsupplied-argument-marker* command :test #'eq)
-                                    (setq command
-                                          (funcall
-                                           *partial-command-parser*
-                                           (command-table command-processor)
-                                           *standard-input* command 0)))
+                  ;; Call `*partial-command-parser*' to handle numeric
+                  ;; argument.
+                  (unwind-protect (setq command
+                                        (funcall
+                                         *partial-command-parser*
+                                         (command-table command-processor)
+                                         *standard-input* command 0 (when prefix-p
+                                                                      prefix-arg)))
                     ;; If we are macrorecording, store whatever the user
                     ;; did to invoke this command.
                     (when (recordingp command-processor)
@@ -1316,8 +1311,7 @@
 	       (mapcar #'(lambda (arg)
                            (cond ((eq arg *unsupplied-argument-marker*)
                                   "unsupplied-argument")
-                                 ((or (eq arg *numeric-argument-marker*)
-                                      (eq arg *numeric-argument-p*))
+                                 ((eq arg *numeric-argument-marker*)
                                   "numeric-argument")
                                  (t arg))) command-args)))
       (terpri stream)
@@ -1402,7 +1396,7 @@
 			   #'sort-by-keystrokes
 			   #'sort-by-name))))
 
-(set-key `(com-describe-bindings ,*numeric-argument-p*) 'help-table '((#\h :control) (#\b)))
+(set-key `(com-describe-bindings ,*numeric-argument-marker*) 'help-table '((#\h :control) (#\b)))
 
 (define-command (com-describe-key :name t :command-table help-table)
     ()
--- /project/mcclim/cvsroot/mcclim/ESA/esa-command-parser.lisp	2006/11/08 01:10:16	1.1
+++ /project/mcclim/cvsroot/mcclim/ESA/esa-command-parser.lisp	2007/12/19 11:02:00	1.2
@@ -89,7 +89,8 @@
                 (push (esa-parse-one-arg stream name ptype args) result)
                 (maybe-clear-input)))))))))
 
-(defun esa-partial-command-parser (command-table stream command position)
+(defun esa-partial-command-parser (command-table stream command position
+                                   &optional numeric-argument)
   (declare (ignore command-table position))
   (let ((command-name (car command))
 	(command-args (cdr command)))
@@ -114,8 +115,10 @@
                   (command-arg (car command-args) (car command-args)))
                  ((null required-args) (cons command-name (nreverse result)))
               (destructuring-bind (name ptype &rest args) arg
-                (push (if (eq command-arg *unsupplied-argument-marker*)
-                          (esa-parse-one-arg stream name ptype args)
-                          command-arg)
+                (push (cond ((eq command-arg *unsupplied-argument-marker*)
+                             (esa-parse-one-arg stream name ptype args))
+                            ((eq command-arg *numeric-argument-marker*)
+                             (or numeric-argument (getf args :default)))
+                            (t command-arg))
                       result)
                 (maybe-clear-input)))))))))




More information about the Mcclim-cvs mailing list