[STUMP] [PATCH] Fixed problem with completion of `where-is' command, now it also recognises not existent commands giving a proper message

[W Dan Meyer]

Hi!

I came across a small bug when using `where-is' command. If the command
doesn't exist then Stump gives a wrong message (saying that the command
is not bound to a key), also the completion hasn't been working. Since
similar functionality is in the `colon' command, I have lifted the
common functionality into the macro, `with-command-completion', and used
that in `where-is' _and_ in the `colon' command.

Patch attached.

Cheers;
        Wojciech Dan

>From d2f31cfe936e86488554eae0f50f68ef011f849d Mon Sep 17 00:00:00 2001
From: Wojciech Daniel Meyer <address@hidden>
Date: Wed, 8 Jul 2009 00:42:54 +0100
Subject: [PATCH] fixed problem with where-is command. now recognizes not 
existent commands giving proper message. introduced macro and refactored one 
defun.

---
 command.lisp |   18 +++++++++++++-----
 help.lisp    |   20 +++++++++++---------
 2 files changed, 24 insertions(+), 14 deletions(-)

diff --git a/command.lisp b/command.lisp
index 1200c7c..bf12b0c 100644
--- a/command.lisp
+++ b/command.lisp
@@ -543,11 +543,19 @@ know lisp very well. One might put the following in one's 
rc file:
   (loop for i in commands do
         (eval-command i)))
 
+(defmacro with-command-completion (prompt initial-input cmd &body body)
+  "Prompt user with @var{prompt}, bind the command name into @{cmd}
+check for errors, commands existence then evaluate @{body}."
+  `(let ((,cmd (completing-read (current-screen) ,prompt (all-commands) (or 
,initial-input ""))))
+     (unless ,cmd
+       (throw 'error :abort))
+     (when (and (plusp (length ,cmd))
+       (if (not (get-command-structure cmd))
+           (throw 'error (format nil "Command '~a' not found." cmd))
+         ,@body)))))
+
 (defcommand colon (&optional initial-input) (:rest)
   "Read a command from the user. @var{initial-text} is optional. When
 supplied, the text will appear in the prompt."
-  (let ((cmd (completing-read (current-screen) ": " (all-commands) (or 
initial-input ""))))
-    (unless cmd
-      (throw 'error :abort))
-    (when (plusp (length cmd))
-      (eval-command cmd t))))
+  (with-command-completion ": " initial-input cmd
+                          (eval-command cmd t)))
diff --git a/help.lisp b/help.lisp
index cb07492..54d4380 100644
--- a/help.lisp
+++ b/help.lisp
@@ -107,15 +107,6 @@ command prints the command bound to the specified key 
sequence."
            (message-no-timeout "\"~a\" is an alias for the command 
\"~a\":~%~a" (command-alias-from deref) (command-name struct)
                                (documentation (command-name struct) 
'function))))))
 
-(defcommand where-is (cmd) ((:rest "Where is command: "))
-"Print the key sequences bound to the specified command."
-(let ((bindings (loop for map in (top-maps) append (search-kmap cmd map))))
-  (if bindings
-      (message-no-timeout "\"~a\" is on ~{~a~^, ~}"
-                      cmd
-                      (mapcar 'print-key-seq bindings))
-      (message-no-timeout "Command \"~a\" is not currently bound"
-                      cmd))))
 
 (defcommand modifiers () ()
   "List the modifiers stumpwm recognizes and what MOD-X it thinks they're on."
@@ -125,3 +116,14 @@ command prints the command bound to the specified key 
sequence."
            "Super" (modifiers-super *modifiers*)
            "Hyper" (modifiers-hyper *modifiers*)
            "AltGr" (modifiers-altgr *modifiers*)))
+
+(defcommand where-is (&optional initial-input) (:rest)
+  "Print the key sequences bound to the specified command."
+  (with-command-completion "Where is command: " initial-input cmd
+    (let ((bindings (loop for map in (top-maps) append (search-kmap cmd map))))
+      (if bindings
+         (message-no-timeout "\"~a\" is on ~{~a~^, ~}"
+                             cmd
+                             (mapcar 'print-key-seq bindings))
+       (message-no-timeout "Command \"~a\" is not currently bound"
+                           cmd)))))
\ No newline at end of file
-- 
1.5.6.3