[climacs-cvs] CVS esa

crhodes crhodes at common-lisp.net
Wed May 24 08:38:37 UTC 2006


Update of /project/climacs/cvsroot/esa
In directory clnet:/tmp/cvs-serv21300

Modified Files:
	esa-command-parser.lisp 
Log Message:
Accept the status quo behaviour for esa-parse-one-arg, writing a comment 
explaining the issue.  Also use do* as I should have done in the first 
place.


--- /project/climacs/cvsroot/esa/esa-command-parser.lisp	2006/05/16 14:45:58	1.2
+++ /project/climacs/cvsroot/esa/esa-command-parser.lisp	2006/05/24 08:38:36	1.3
@@ -20,8 +20,13 @@
 
 (in-package :esa)
 
-(defun esa-parse-one-arg (stream name ptype accept-args 
-                          &optional (default *unsupplied-argument-marker*))
+;;; There is an ambiguity over what to do for parsing partial commands
+;;; with certain values filled in, as might occur for keyboard
+;;; shortcuts.  Either the supplied arguments should be treated as
+;;; gospel and not even mentioned to the user, as we do now; or they
+;;; should be treated as the default, but the user should be prompted
+;;; to confirm, as we used to do.
+(defun esa-parse-one-arg (stream name ptype accept-args)
   (declare (ignore name))
   ;; this conditional doesn't feel entirely happy.  The issue is that
   ;; we could be called either recursively from an outer call to
@@ -36,26 +41,22 @@
                     stream)))
     (apply #'accept (eval ptype)
            :stream stream
-           (append 
-            (unless (eq default *unsupplied-argument-marker*)
-              ;; adjust to taste.
-              `(:default ,default :insert-default nil :display-default t))
-            ;; This is fucking nuts.  FIXME: the clim spec says
-            ;; ":GESTURE is not evaluated at all".  Um, but how are
-            ;; you meant to tell if a keyword argument is :GESTURE,
-            ;; then?  The following does not actually allow variable
-            ;; keys: anyone who writes (DEFINE-COMMAND FOO ((BAR
-            ;; 'PATHNAME *RANDOM-ARG* ""))) and expects it to work
-            ;; deserves to lose.
-            ;;
-            ;; FIXME: this will do the wrong thing on malformed accept
-            ;; arguments, such improper lists or those with an odd
-            ;; number of keyword arguments.  I doubt that
-            ;; DEFINE-COMMAND is checking the syntax, so we probably
-            ;; should.
-            (loop for (key val) on accept-args by #'cddr
-                  unless (eq key :gesture)
-                  collect key and collect (eval val))))))
+           ;; This is fucking nuts.  FIXME: the clim spec says
+           ;; ":GESTURE is not evaluated at all".  Um, but how are you
+           ;; meant to tell if a keyword argument is :GESTURE, then?
+           ;; The following does not actually allow variable keys:
+           ;; anyone who writes (DEFINE-COMMAND FOO ((BAR 'PATHNAME
+           ;; *RANDOM-ARG* ""))) and expects it to work deserves to
+           ;; lose.
+           ;;
+           ;; FIXME: this will do the wrong thing on malformed accept
+           ;; arguments, such improper lists or those with an odd
+           ;; number of keyword arguments.  I doubt that
+           ;; DEFINE-COMMAND is checking the syntax, so we probably
+           ;; should.
+           (loop for (key val) on accept-args by #'cddr
+                 unless (eq key :gesture)
+                 collect key and collect (eval val)))))
 
 (defun esa-command-parser (command-table stream)
   (let ((command-name nil))
@@ -107,14 +108,14 @@
           (declare (ignore keyword-args))
           (let (result)
             ;; only required args for now.
-            (do ((required-args required-args (cdr required-args))
-                 (arg (car required-args) (cadr required-args))
-                 (command-args command-args (cdr command-args))
-                 (command-arg (car command-args) (cadr command-args)))
-                ((null required-args) (cons command-name (nreverse result)))
+            (do* ((required-args required-args (cdr required-args))
+                  (arg (car required-args) (car required-args))
+                  (command-args command-args (cdr command-args))
+                  (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)
+                          (esa-parse-one-arg stream name ptype args)
                           command-arg)
                       result)
                 (maybe-clear-input)))))))))




More information about the Climacs-cvs mailing list