From 6c832664a41082e36acc88f4750b1991e1ac7f48 Mon Sep 17 00:00:00 2001
From: Michael Raitza <spacefrogg-clfswm@meterriblecrew.net>
Date: Sat, 13 Oct 2012 14:24:50 +0200
Subject: [PATCH] Added query-mode-complete-suggest and helpers.

---
 src/clfswm-query.lisp | 39 +++++++++++++++++++++++++++++++++++++--
 1 file changed, 37 insertions(+), 2 deletions(-)

diff --git a/src/clfswm-query.lisp b/src/clfswm-query.lisp
index 8353677..a178b79 100644
--- a/src/clfswm-query.lisp
+++ b/src/clfswm-query.lisp
@@ -32,6 +32,7 @@
 
 (defparameter *query-history* (list ""))
 (defparameter *query-complet-list* nil)
+(defparameter *query-completion-state* nil)
 
 (defparameter *query-message* nil)
 (defparameter *query-string* nil)
@@ -108,7 +109,9 @@
 (defun query-print-string ()
   (let ((dec (min 0 (- (- (x-drawable-width *query-window*) 10)
 		       (+ 10 (* *query-pos* (xlib:max-char-width *query-font*))))))
-        (complet (query-find-complet-list)))
+        (complet (if *query-completion-state*
+                     (first *query-completion-state*)
+                     (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)
@@ -277,6 +280,37 @@
                                                 (subseq *query-string* *query-pos*))
                     *query-pos* (+ pos (length common)))))))))
 
+(defun query-mode-complete-suggest ()
+  (flet ((complete (completions completion-pos pos initial-pos)
+	   (when completions
+	     (let ((completion (if (equal completion-pos (list-length completions))
+				   (subseq *query-string* pos initial-pos)
+				   (nth completion-pos completions))))
+	       (setf *query-string* (concatenate 'string
+						 (subseq *query-string* 0 pos)
+						 completion
+						 (subseq *query-string* *query-pos*))
+		     *query-pos* (+ pos (length completion))))
+	     (setf *query-completion-state*
+		   (list completions completion-pos pos initial-pos)))))
+    (if *query-completion-state*
+	(complete (first *query-completion-state*)
+		  (mod (1+ (second *query-completion-state*))
+		       (1+ (list-length (first *query-completion-state*))))
+		  (third *query-completion-state*)
+		  (fourth *query-completion-state*))
+	(multiple-value-bind (comps pos) (query-find-complet-list)
+	  (complete comps 0 pos *query-pos*)))))
+
+(add-hook *query-key-press-hook* 'query-mode-complete-suggest-reset)
+
+(defun query-mode-complete-suggest-reset (code state)
+  "Reset the query-completion-state if another key was pressed than a key
+that calls query-mode-complete-suggest."
+  (unless (equal 'query-mode-complete-suggest
+		 (first (find-key-from-code *query-keys* code state)))
+    (setf *query-completion-state* nil)
+    (query-print-string)))
 
 (add-hook *binding-hook* 'set-default-query-keys)
 
@@ -336,7 +370,8 @@
   (setf *query-message* message
         *query-string* default
         *query-pos* (length default)
-        *query-complet-list* complet-list)
+        *query-complet-list* complet-list
+	*query-completion-state* nil)
   (with-grab-keyboard-and-pointer (92 93 66 67 t)
     (generic-mode 'query-mode 'exit-query-loop
 		  :enter-function #'query-enter-function
-- 
2.11.4.GIT