From a71194988cc4ff9249a0e8eb22f9e4663009c9e6 Mon Sep 17 00:00:00 2001
From: Chris Kelly <address@hidden>
Date: Mon, 7 Mar 2011 23:27:16 +0100
Subject: [PATCH] updated menu so that it highlights search matches which can be jumped to with tab

---
 menu.lisp |  111 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++---
 1 files changed, 105 insertions(+), 6 deletions(-)

diff --git a/menu.lisp b/menu.lisp
index 1567714..17e763e 100644
--- a/menu.lisp
+++ b/menu.lisp
@@ -26,7 +26,6 @@
 ;;; interactive menu
 
 (in-package #:stumpwm)
-
 (export '())
 
 (defvar *menu-map* nil
@@ -37,21 +36,25 @@
         (let ((m (make-sparse-keymap)))
           (define-key m (kbd "C-p") 'menu-up)
           (define-key m (kbd "Up") 'menu-up)
-          (define-key m (kbd "k") 'menu-up)
+          ;(define-key m (kbd "k") 'menu-up)
           (define-key m (kbd "S-Up") 'menu-scroll-up)
           (define-key m (kbd "SunPageUp") 'menu-page-up)
-          (define-key m (kbd "K") 'menu-page-up)
+          ;(define-key m (kbd "K") 'menu-page-up)
 
           (define-key m (kbd "C-n") 'menu-down)
           (define-key m (kbd "Down") 'menu-down)
-          (define-key m (kbd "j") 'menu-down)
+          ;(define-key m (kbd "j") 'menu-down)
           (define-key m (kbd "S-Down") 'menu-scroll-down)
           (define-key m (kbd "SunPageDown") 'menu-page-down)
-          (define-key m (kbd "J") 'menu-page-down)
+          ;(define-key m (kbd "J") 'menu-page-down)
 
           (define-key m (kbd "C-g") 'menu-abort)
           (define-key m (kbd "ESC") 'menu-abort)
           (define-key m (kbd "RET") 'menu-finish)
+
+          (define-key m (kbd "DEL") 'menu-back)
+	  (define-key m (kbd "TAB") 'menu-cycle-match)
+
           m)))
 
 (defstruct menu-state
@@ -62,6 +65,29 @@
        (> (length (menu-state-table menu))
           *menu-maximum-height*)))
 
+
+(defun highlight-substring (str chars)
+  "Funciton to highlight selected characters using bright colors
+Limitaiton: this function only searches the first part
+
+TODO: union-mode: logical and terms separated by spaces together
+"
+
+  (format t "num chars is ~A~%" (length chars))
+  (if (> (length chars) 0)
+      (let ((firstloc 
+	 (search chars str :test #'char-equal))
+	(len (length chars)))
+    
+    (let ((firstpart (subseq str 0 firstloc))
+	  (lastpart (subseq str (+ firstloc len))))
+      
+      (cat firstpart "^R^B" chars "^b^r" lastpart)  
+      )
+    )
+      str)
+  )
+
 (defun bound-check-menu (menu)
   "Adjust the menu view and selected item based
 on current view and new selection."
@@ -103,12 +129,67 @@ on current view and new selection."
                                (+ (menu-state-selected menu)
                                   *menu-scrolling-step*))))))))
 
+
+(defun menu-cycle-match (menu) 
+  "Jump ahead to the next matched result."
+
+  ;; make a list of 'matched' elements by index
+  ;; find current index
+  ;; go to next one on the list
+  (let ((matchlist (mapcar 
+		    (lambda (x) 
+		      (if (search (menu-state-current-input menu) (car x) 
+				  :test #'char-equal)
+			  t
+			  nil
+			  )) 
+		    (menu-state-table menu)
+		    ))
+	(cur (menu-state-selected menu))
+	(first-i -1)
+	(x -1)
+	(mlist (list))
+	)
+  
+    ;; get the indexes of the matches
+    (loop for i in matchlist do 
+	 (incf x)
+	 (if i
+	     (progn
+	       (if (= first-i -1) (setf first-i x))
+	       (if (> x cur) (setq mlist (append 
+					  mlist
+					  (list x)))))))
+    
+    (if mlist
+	(if (< cur first-i)
+	    (setf (menu-state-selected menu) first-i)
+	    (setf (menu-state-selected menu) (car mlist))
+	    )
+	(setf (menu-state-selected menu) first-i)
+	)
+    )
+  )
+(defun menu-back (menu)
+  "Delete previously typed characters, thus, widen search."
+
+  ;; delete one char from the en
+  (if (> (length (menu-state-current-input menu)) 0)
+      (setf (menu-state-current-input menu) (subseq (menu-state-current-input menu) 0 (- (length (menu-state-current-input menu)) 1)))
+      )
+
+  ;; don't change selected unless necessary
+  ;;(decf (menu-state-selected menu))
+  (bound-check-menu menu))
+
 (defun menu-up (menu)
   (setf (menu-state-current-input menu) "")
   (decf (menu-state-selected menu))
   (bound-check-menu menu))
 
 (defun menu-down (menu)
+  (print "hum ---------------------------------------------------------------------------")
+
   (setf (menu-state-current-input menu) "")
   (incf (menu-state-selected menu))
   (bound-check-menu menu))
@@ -248,7 +329,25 @@ See *menu-map* for menu bindings."
                                       (if (string= (menu-state-current-input menu) "")
                                           0 1)
                                       (if (= 0 (menu-state-view-start menu)) 0 1))))
-              (echo-string-list screen menu-text menu-highlight))
+
+		  (echo-string-list screen 
+				(mapcar 
+				 #'(lambda (x) 
+				     (if 
+				      (search (menu-state-current-input menu) x 
+					      :test #'char-equal)
+				      
+				      (highlight-substring x
+							   (menu-state-current-input menu)
+							   )
+				      
+				      x 
+				      ) 
+				     ) 
+				 menu-text
+				 )
+				
+				menu-highlight))
                 (multiple-value-bind (action key-seq) (read-from-keymap (list *menu-map*))
 		  (if action
 		      (funcall action menu)
-- 
1.6.3.3