[STUMP] [PATCH] Enhancements to the interactive module loading.

[David Vazquez]

The `load-module' command fails in sbcl when it is invoked
interactively. I fixed this.

I also remove the tailing space which is introduced by `read-one-line'
in order to load-module found it. Indeed, I add a new argument
REQUIRE-MATCH to `completing-read' to make sure that the input module
exists.

I do not know Feel free to deny or change this patch. 

Greetings.
David


---
 input.lisp  |   24 +++++++++++++++++++-----
 module.lisp |   18 ++++++++++++------
 screen.lisp |    3 ++-
 3 files changed, 33 insertions(+), 12 deletions(-)

diff --git a/input.lisp b/input.lisp
index 932e990..888acc6 100644
--- a/input.lisp
+++ b/input.lisp
@@ -121,7 +121,7 @@
     ;; Draw the prompt
     (draw-input-bucket screen prompt input)
     ;; Ready to recieve input
-    
+
 ))
 
 (defun shutdown-input-window (screen)
@@ -180,7 +180,9 @@
   (make-array (length initial-input) :element-type 'character 
:initial-contents initial-input
               :adjustable t :fill-pointer t))
 
-(defun completing-read (screen prompt completions &optional (initial-input ""))
+
+
+(defun completing-read (screen prompt completions &optional (initial-input "") 
require-match)
   "Read a line of input through stumpwm and return it with TAB
 completion. completions can be a list, an fbound symbol, or a
 function. if its an fbound symbol or a function then that
@@ -189,8 +191,19 @@ to return a list of matches."
   (check-type completions (or list function symbol))
   (let ((*input-completions* completions)
         (*input-current-completions* nil)
-        (*input-current-completions-idx* nil))
-    (read-one-line screen prompt initial-input)))
+        (*input-current-completions-idx* nil)
+        (old-input initial-input))
+    (loop
+     (let* ((input (read-one-line screen prompt old-input))
+            (compl (input-find-completions input completions)))
+       (when (or (not require-match)
+                 (null input)
+                 (member input compl :test #'string=))
+         (return input))
+       (setf old-input input)
+       (message "No match")
+       (sleep 0.5)))))
+
 
 (defun read-one-line (screen prompt &optional (initial-input ""))
   "Read a line of input through stumpwm and return it. returns nil if the user 
aborted."
@@ -396,7 +409,8 @@ functions are passed this structure as their first 
argument."
                 (setf *input-current-completions-idx* (1- (length 
*input-current-completions*))))))
         (let ((elt (nth *input-current-completions-idx* 
*input-current-completions*)))
           (input-insert-string input (if (listp elt) (first elt) elt))
-          (input-insert-char input #\Space)))
+;;        (input-insert-char input #\Space)
+          ))
       :error))
 
 (defun input-complete-forward (input key)
diff --git a/module.lisp b/module.lisp
index 91b358e..c5caf4b 100644
--- a/module.lisp
+++ b/module.lisp
@@ -72,17 +72,20 @@
 
 (define-stumpwm-type :module (input prompt)
   (or (argument-pop-rest input)
-      (completing-read (current-screen) prompt (list-modules))))
+      (completing-read (current-screen) prompt (list-modules) "" t)))
 
 (defun list-modules ()
   "Return a list of the available modules."
   (mapcar 'pathname-name
-          (directory (make-pathname :directory *contrib-dir*
+          (directory (make-pathname :directory
+                                    #+sbcl (namestring *contrib-dir*)
+                                    #-sbcl *contrib-dir*
                                    :name :wild
                                    :type "lisp"))))
 
 (defun find-module (name)
-  (make-pathname :defaults *contrib-dir*
+  (make-pathname :defaults
+                 *contrib-dir*
                 :name name
                 :type "lisp"))
 
@@ -91,8 +94,11 @@
   ;; FIXME: This should use ASDF in the future. And maybe there should
   ;; be an extra stumpwm-contrib repository.
   (let ((module (find-module name)))
-    (if module
-        (load module)
-        (error "No such module: ~a" name))))
+    (cond
+      (module
+       (load module)
+       (message "Module ~a loaded" name))
+      (t
+       (error "No such module: ~a" name)))))
 
 ;; End of file
diff --git a/screen.lisp b/screen.lisp
index 19eebdb..b3aa9d4 100644
--- a/screen.lisp
+++ b/screen.lisp
@@ -25,7 +25,8 @@
 
 (in-package #:stumpwm)
 
-(export '(current-screen
+(export '(current-head
+          current-screen
           current-window
           screen-current-window
           set-fg-color
-- 
1.5.6.5