>From 1b949087ade4884d85de2cb489f854a0666f1d2a Mon Sep 17 00:00:00 2001
From: Chris Kelly <address@hidden>
Date: Tue, 8 Mar 2011 21:53:58 +0000
Subject: [PATCH] updated menu so that it highlights search matches which can be jumped to with tab

---
 menu.lisp |   79 ++++++++++++++++++++++++++++++++++++++++++++++++++++++-------
 1 files changed, 70 insertions(+), 9 deletions(-)

diff --git a/menu.lisp b/menu.lisp
index 649e085..e142cc2 100644
--- a/menu.lisp
+++ b/menu.lisp
@@ -37,26 +37,40 @@
         (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 "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 "C-n") 'menu-down)
           (define-key m (kbd "Down") '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 "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
   table prompt selected view-start view-end current-input)
 
+(defun highlight-substring (str chars)
+  "Function to highlight selected characters using bright colors
+Limitation: this function only searches the first part
+TODO: union-mode: logical and terms separated by spaces together"
+  (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))))
+
+          (concatenate 'string 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."
@@ -86,6 +100,51 @@ on current view and new selection."
                      (values (menu-state-view-start menu)
                              (menu-state-view-end menu)))))))))
 
+(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))
@@ -203,17 +262,19 @@ See *menu-map* for menu bindings."
                                        (menu-state-view-start menu)
                                        (menu-state-view-end menu)))
                       (highlight (- (menu-state-selected menu)
-                                    (menu-state-view-start menu))))
+                                    (menu-state-view-start menu)))
+                      (input (menu-state-current-input menu)))
+                  (loop for c on strings
+                     when (search input (car c) :test #'char-equal)
+                     do (setf (car c) (highlight-substring (car c) input)))
                   (unless (= 0 (menu-state-view-start menu))
                     (setf strings (cons "..." strings))
                     (incf highlight))
                   (unless (= (length menu-options) (menu-state-view-end menu))
                     (setf strings (nconc strings '("..."))))
-                  (unless (string= (menu-state-current-input menu) "")
+                  (unless (string= input "")
                     (setf strings
-                          (cons (format nil "Search: ~a"
-                                        (menu-state-current-input menu))
-                                strings))
+                          (cons (format nil "Search: ~a" input) strings))
                     (incf highlight))
                   (when prompt
                     (setf strings (cons prompt strings))
-- 
1.7.2.3