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)))))))))