stumpwm-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [STUMP] [PATCH] Fixed problem with completion of `where-is' command,


From: Wojciech Meyer
Subject: Re: [STUMP] [PATCH] Fixed problem with completion of `where-is' command, now it also recognises not existent commands giving a proper message
Date: Fri, 18 Mar 2011 01:49:49 +0000
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/24.0.50

Hi Stump Hackers,

Please see the new (It's been two years to look at it again! :)) patch,
for the command completion of `where-is' command. As mentioned I've
introduced a new macro `with-command-completion', but maybe eventually
we'd need a completely different approach and just extend `defcommand'
macro syntax. For now, however introducing the macro seems to be
a reasonable thing to do to avoid code duplication.

Thanks!!
Wojciech
>From 597353496474d171f92c716102501a892b8658af Mon Sep 17 00:00:00 2001
From: Wojciech Meyer <address@hidden>
Date: Fri, 18 Mar 2011 01:41:14 +0000
Subject: [PATCH] * command.lisp: Add macro `with-command-completion' for 
command completion. Adjust `colon' command to use it.
 * help.lisp: Use new `with-command-completion' for command completion with 
`where-is' command. Allow user to complete command `where-is'


Signed-off-by: Wojciech Meyer <address@hidden>
---
 command.lisp |   21 +++++++++++++++------
 help.lisp    |   19 ++++++++++---------
 2 files changed, 25 insertions(+), 15 deletions(-)

diff --git a/command.lisp b/command.lisp
index 5e43edc..cc2ed22 100644
--- a/command.lisp
+++ b/command.lisp
@@ -541,11 +541,20 @@ 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) :initial-input (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) 
:initial-input (or initial-input ""))))
-    (unless cmd
-      (throw 'error :abort))
-    (when (plusp (length cmd))
-      (eval-command cmd t))))
+ supplied, the text will appear in the prompt."
+  (with-command-completion ": " initial-input cmd
+                          (eval-command cmd t)))
diff --git a/help.lisp b/help.lisp
index ade6f00..0d8c96d 100644
--- a/help.lisp
+++ b/help.lisp
@@ -108,15 +108,16 @@ 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 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)))))
 
 (defcommand modifiers () ()
   "List the modifiers stumpwm recognizes and what MOD-X it thinks they're on."
-- 
1.7.1


reply via email to

[Prev in Thread] Current Thread [Next in Thread]