[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch test updated. R-1106-66-ga236a20
Philippe Brochard
pbrochard at common-lisp.net
Mon Jun 25 22:20:39 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 a236a208d7dc04c397e6165cc0fe734b66bd67d2 (commit)
from 02e0f7b49c2d606348acb8008f47c59c87109048 (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 a236a208d7dc04c397e6165cc0fe734b66bd67d2
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Tue Jun 26 00:20:33 2012 +0200
src/clfswm-query.lisp: Add completion for shell commands.
diff --git a/ChangeLog b/ChangeLog
index c4231cd..c0af3cb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2012-06-26 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-query.lisp: Add completion for shell commands.
+
2012-06-18 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm-placement.lisp: Each child can have its own border
diff --git a/TODO b/TODO
index fc6a728..5bb16e4 100644
--- a/TODO
+++ b/TODO
@@ -16,7 +16,7 @@ FOR THE NEXT RELEASE
- Add a toolbar in contrib/
-- Add completion in query input.
+- Add completion in query input (done for shell command / TODO for lisp symbols).
- Add a tabbar layout : save some space on top/left... of the frame and display clickable
children name.
diff --git a/src/clfswm-query.lisp b/src/clfswm-query.lisp
index 9e72529..357b1d6 100644
--- a/src/clfswm-query.lisp
+++ b/src/clfswm-query.lisp
@@ -39,7 +39,6 @@
(defparameter *query-return* nil)
-
(defun query-show-paren (orig-string pos dec)
"Replace matching parentheses with brackets"
(let ((string (copy-seq orig-string)))
@@ -95,20 +94,24 @@
(add-hook *binding-hook* 'init-*query-keys*)
+
(defun query-find-complet-list ()
- (remove-if-not (lambda (x)
- (zerop (or (search *query-string* x :test #'string-equal) -1)))
- *query-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*)
+ (values (string-match str *query-complet-list*) pos))))
(defun query-print-string ()
(let ((dec (min 0 (- (- (x-drawable-width *query-window*) 10)
- (+ 10 (* *query-pos* (xlib:max-char-width *query-font*)))))))
+ (+ 10 (* *query-pos* (xlib:max-char-width *query-font*))))))
+ (complet (query-find-complet-list)))
(clear-pixmap-buffer *query-window* *query-gc*)
(setf (xlib:gcontext-foreground *query-gc*) (get-color *query-message-color*))
(xlib:draw-glyphs *pixmap-buffer* *query-gc* 5 (+ (xlib:max-char-ascent *query-font*) 5)
(format nil "~A ~{~A~^, ~}" *query-message*
- (query-find-complet-list)))
+ (if (< (length complet) *query-max-complet-length*)
+ complet nil)))
(when (< *query-pos* 0)
(setf *query-pos* 0))
(when (> *query-pos* (length *query-string*))
@@ -251,12 +254,24 @@
(defun query-mode-complet ()
- (setf *query-string* (find-common-string *query-string* (query-find-complet-list)))
- (let ((complet (query-find-complet-list)))
- (when (= (length complet) 1)
- (setf *query-string* (first complet))))
- (query-end))
-
+ (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))))))))
(add-hook *binding-hook* 'set-default-query-keys)
@@ -271,7 +286,9 @@
(define-query-key ("Delete") 'query-delete)
(define-query-key ("Delete" :control) 'query-delete-word)
(define-query-key ("Home") 'query-home)
+ (define-query-key ("a" :control) 'query-home)
(define-query-key ("End") 'query-end)
+ (define-query-key ("e" :control) 'query-end)
(define-query-key ("Left") 'query-left)
(define-query-key ("Left" :control) 'query-left-word)
(define-query-key ("Right") 'query-right)
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index d31aa88..ca1a21b 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -65,7 +65,7 @@
(defun query-yes-or-no (formatter &rest args)
- (let ((rep (query-string (apply #'format nil formatter args) "" '("yes" "no"))))
+ (let ((rep (query-string (apply #'format nil formatter args) "" '("Yes" "No"))))
(or (string= rep "")
(char= (char rep 0) #\y)
(char= (char rep 0) #\Y))))
@@ -562,15 +562,19 @@
-(defun run-program-from-query-string ()
- "Run a program from the query input"
- (multiple-value-bind (program return)
- (query-string "Run:")
- (when (and (equal return :return) program (not (equal program "")))
- (setf *second-mode-leave-function* (let ((cmd (concatenate 'string "cd $HOME && " program)))
- (lambda ()
- (do-shell cmd))))
- (leave-second-mode))))
+
+(let ((commands nil))
+ (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 "")))
+ (setf *second-mode-leave-function* (let ((cmd (concatenate 'string "cd $HOME && " program)))
+ (lambda ()
+ (do-shell cmd))))
+ (leave-second-mode)))))
diff --git a/src/config.lisp b/src/config.lisp
index f93c9e6..6769a8d 100644
--- a/src/config.lisp
+++ b/src/config.lisp
@@ -257,6 +257,10 @@ 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
+ 'Query-string "Query maximum length of completion list")
+(defconfig *query-min-complet-char* 2
+ 'Query-string "Query minimum input length for completion")
;;; CONFIG - Info mode
diff --git a/src/tools.lisp b/src/tools.lisp
index e958fb9..927c688 100644
--- a/src/tools.lisp
+++ b/src/tools.lisp
@@ -62,6 +62,7 @@
:ensure-function
:empty-string-p
:find-common-string
+ :cmd-in-path
:setf/=
:number->char
:number->string
@@ -69,6 +70,7 @@
:repeat-chars
:nth-insert
:split-string
+ :string-match
:append-newline-space
:expand-newline
:ensure-list
@@ -440,6 +442,20 @@ Return the result of the last hook"
string))
+(defun cmd-in-path (&optional (tmpfile "/tmp/clfswm-cmd.tmp"))
+ (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))))
+
;;; Tools
(defmacro setf/= (var val)
@@ -490,6 +506,14 @@ Return the result of the last hook"
unless (string= sub "") collect sub
while j))
+(defun string-match (match list)
+ "Return the string in list witch match the match string"
+ (let ((len (length match)))
+ (remove-duplicates (remove-if-not (lambda (x)
+ (string-equal match (subseq x 0 (min len (length x)))))
+ list)
+ :test #'string-equal)))
+
(defun append-newline-space (string)
"Append spaces before Newline on each line"
-----------------------------------------------------------------------
Summary of changes:
ChangeLog | 4 ++++
TODO | 2 +-
src/clfswm-query.lisp | 41 +++++++++++++++++++++++++++++------------
src/clfswm-util.lisp | 24 ++++++++++++++----------
src/config.lisp | 4 ++++
src/tools.lisp | 24 ++++++++++++++++++++++++
6 files changed, 76 insertions(+), 23 deletions(-)
hooks/post-receive
--
CLFSWM - A(nother) Common Lisp FullScreen Window Manager
More information about the clfswm-cvs
mailing list