[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch test updated. R-1106-67-gd220157

Philippe Brochard pbrochard at common-lisp.net
Tue Jun 26 21:03:43 UTC 2012


This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager".

The branch, test has been updated
       via  d220157eba933213ce9f590858bad32599b30223 (commit)
      from  a236a208d7dc04c397e6165cc0fe734b66bd67d2 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit d220157eba933213ce9f590858bad32599b30223
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Tue Jun 26 23:03:33 2012 +0200

    src/clfswm-query.lisp: Support completion with chars other than spaces.

diff --git a/clfswm.asd b/clfswm.asd
index edeab21..ffcc6a2 100644
--- a/clfswm.asd
+++ b/clfswm.asd
@@ -64,7 +64,7 @@
 			 (:file "clfswm-util"
 				:depends-on ("clfswm" "keysyms" "clfswm-info" "clfswm-second-mode" "clfswm-query"
                                                       "clfswm-menu" "clfswm-autodoc" "clfswm-corner"
-                                                      "clfswm-placement"))
+                                                      "clfswm-placement" "tools"))
                          (:file "clfswm-configuration"
 				:depends-on ("package" "config" "clfswm-internal" "clfswm-util" "clfswm-query"
 						       "clfswm-menu"))
diff --git a/src/clfswm-query.lisp b/src/clfswm-query.lisp
index 357b1d6..87e1d2e 100644
--- a/src/clfswm-query.lisp
+++ b/src/clfswm-query.lisp
@@ -96,9 +96,12 @@
 
 
 (defun query-find-complet-list ()
-  (let* ((pos (or (position #\space *query-string* :end *query-pos* :from-end t) 0))
-         (str (string-trim " " (subseq *query-string* pos *query-pos*))))
-    (when (>= (length str) *query-min-complet-char*)
+  (let* ((pos (1+ (or (position-if-not #'extented-alphanumericp *query-string*
+                                       :end *query-pos* :from-end t)
+                      -1)))
+         (str (subseq *query-string* pos *query-pos*)))
+    (when (or (> (length str) (1- *query-min-complet-char*))
+              (< (length *query-complet-list*) *query-max-complet-length*))
       (values (string-match str *query-complet-list*) pos))))
 
 
@@ -256,22 +259,20 @@
 (defun query-mode-complet ()
   (multiple-value-bind (complet pos)
       (query-find-complet-list)
-    (if (= (length complet) 1)
-        (setf *query-string* (concatenate 'string
-                                          (subseq *query-string* 0 pos)
-                                          (if (plusp pos) " " "")
-                                          (first complet) " "
-                                          (subseq *query-string* *query-pos*))
-              *query-pos* (+ pos (length (first complet)) (if (plusp pos) 2 1)))
-        (let ((common (find-common-string (string-trim " " (subseq *query-string* pos *query-pos*))
-                                          complet)))
-          (when (and complet common)
-            (setf *query-string* (concatenate 'string
-                                              (subseq *query-string* 0 pos)
-                                              (if (plusp pos) " " "")
-                                              common
-                                              (subseq *query-string* *query-pos*))
-                  *query-pos* (+ pos (length common) (if (plusp pos) 1 0))))))))
+    (when complet
+      (if (= (length complet) 1)
+          (setf *query-string* (concatenate 'string
+                                            (subseq *query-string* 0 pos)
+                                            (first complet) " "
+                                            (subseq *query-string* *query-pos*))
+                *query-pos* (+ pos (length (first complet)) 1))
+          (let ((common (find-common-string (subseq *query-string* pos *query-pos*) complet)))
+            (when common
+              (setf *query-string* (concatenate 'string
+                                                (subseq *query-string* 0 pos)
+                                                common
+                                                (subseq *query-string* *query-pos*))
+                    *query-pos* (+ pos (length common)))))))))
 
 
 (add-hook *binding-hook* 'set-default-query-keys)
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index ca1a21b..0799231 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -563,11 +563,9 @@
 
 
 
-(let ((commands nil))
+(let ((commands (command-in-path)))
   (defun run-program-from-query-string ()
     "Run a program from the query input"
-    (unless commands
-      (setf commands (remove-duplicates (cmd-in-path) :test #'string-equal)))
     (multiple-value-bind (program return)
         (query-string "Run:" "" commands)
       (when (and (equal return :return) program (not (equal program "")))
diff --git a/src/config.lisp b/src/config.lisp
index 6769a8d..f031790 100644
--- a/src/config.lisp
+++ b/src/config.lisp
@@ -257,9 +257,9 @@ on the root window in the main mode with the mouse")
   'Query-string "Query string window border color")
 (defconfig *query-transparency* *default-transparency*
   'Query-string "Query string window background transparency")
-(defconfig *query-max-complet-length* 50
+(defconfig *query-max-complet-length* 100
   'Query-string "Query maximum length of completion list")
-(defconfig *query-min-complet-char* 2
+(defconfig *query-min-complet-char* 1
   'Query-string "Query minimum input length for completion")
 
 
diff --git a/src/menu-def.lisp b/src/menu-def.lisp
index 76bf799..e43da42 100644
--- a/src/menu-def.lisp
+++ b/src/menu-def.lisp
@@ -27,6 +27,9 @@
 
 (in-package :clfswm)
 
+(format t "Updating menus...")
+(force-output)
+
 (init-menu)
 
 ;;; Here is a small example of menu manipulation:
@@ -236,3 +239,5 @@
 (add-menu-key 'clfswm-menu "l" 'reload-clfswm)
 (add-menu-key 'clfswm-menu "x" 'exit-clfswm)
 
+(format t " Done.~%")
+(force-output)
diff --git a/src/tools.lisp b/src/tools.lisp
index 927c688..3759afd 100644
--- a/src/tools.lisp
+++ b/src/tools.lisp
@@ -62,7 +62,7 @@
 	   :ensure-function
 	   :empty-string-p
 	   :find-common-string
-           :cmd-in-path
+           :command-in-path
 	   :setf/=
 	   :number->char
            :number->string
@@ -71,6 +71,7 @@
 	   :nth-insert
 	   :split-string
            :string-match
+           :extented-alphanumericp
 	   :append-newline-space
 	   :expand-newline
 	   :ensure-list
@@ -442,19 +443,23 @@ Return the result of the last hook"
       string))
 
 
-(defun cmd-in-path (&optional (tmpfile "/tmp/clfswm-cmd.tmp"))
+(defun command-in-path (&optional (tmpfile "/tmp/clfswm-cmd.tmp"))
+  (format t "Updating command list...~%")
   (labels ((delete-tmp ()
              (when (probe-file tmpfile)
                (delete-file tmpfile))))
     (delete-tmp)
     (dolist (dir (split-string (getenv "PATH") #\:))
       (ushell (format nil "ls ~A/* >> ~A" dir tmpfile)))
-    (prog1
-        (with-open-file (stream tmpfile :direction :input)
-          (loop for line = (read-line stream nil nil)
-             while line
-             collect (subseq line (1+ (or (position #\/ line :from-end t) -1)))))
-      (delete-tmp))))
+    (let ((commands nil))
+      (with-open-file (stream tmpfile :direction :input)
+        (loop for line = (read-line stream nil nil)
+           while line
+           do (pushnew (subseq line (1+ (or (position #\/ line :from-end t) -1))) commands
+                       :test #'string=)))
+      (delete-tmp)
+      (format t "Done. Found ~A commands in shell PATH.~%" (length commands))
+      commands)))
 
 
 ;;; Tools
@@ -515,6 +520,14 @@ Return the result of the last hook"
                        :test #'string-equal)))
 
 
+(defun extented-alphanumericp (char)
+  (or (alphanumericp char)
+      (eq char #\-)
+      (eq char #\_)
+      (eq char #\.)
+      (eq char #\+)))
+
+
 (defun append-newline-space (string)
   "Append spaces before Newline on each line"
   (with-output-to-string (stream)

-----------------------------------------------------------------------

Summary of changes:
 clfswm.asd            |    2 +-
 src/clfswm-query.lisp |   39 ++++++++++++++++++++-------------------
 src/clfswm-util.lisp  |    4 +---
 src/config.lisp       |    4 ++--
 src/menu-def.lisp     |    5 +++++
 src/tools.lisp        |   29 +++++++++++++++++++++--------
 6 files changed, 50 insertions(+), 33 deletions(-)


hooks/post-receive
-- 
CLFSWM - A(nother) Common Lisp FullScreen Window Manager




More information about the clfswm-cvs mailing list