unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* [PATCH] Conkeror like hints for incremental search
@ 2012-01-23 17:52 Gideon Stupp
  2012-01-24  7:55 ` Tassilo Horn
                   ` (2 more replies)
  0 siblings, 3 replies; 12+ messages in thread
From: Gideon Stupp @ 2012-01-23 17:52 UTC (permalink / raw)
  To: emacs-devel

[-- Attachment #1: Type: text/plain, Size: 550 bytes --]

This patch adds Conkeror like hints to incremental-search's currently
matched strings.
This way it is possible to choose one of the highlighted possibilities
without completing the search string (useful when using incremental
search for navigation).
The hints can be toggled on or off at any point during the search with
isearch-toggle-hints (which is mapped to C-f by default). Note that to
save keystrokes characters are used as hints instead of just numbers.

Anyway, please review it and if there is any interest in it merge it.

Thanks, Gideon.

[-- Attachment #2: 0001-Conkeror-like-hints-for-isearch-highlight.patch --]
[-- Type: text/x-patch, Size: 12504 bytes --]

From aa12a3d6ac7e2dae9e3f25336c4f01a3507913b4 Mon Sep 17 00:00:00 2001
From: gstupp <gstupp@debian.(none)>
Date: Sun, 22 Jan 2012 17:22:40 +0200
Subject: [PATCH] Conkeror like hints for incremental search

This patch adds Conkeror like hints to incremental-search's currently matched strings.
This way it is possible to choose one of the highlighted possibilities
without completing the search string (useful when using incremental search for navigation).
The hints can be toggled on or off at any point during the search with isearch-toggle-hints (which is mapped to C-f by default).
To save keystrokes characters are used as hints instead of just numbers.

---
 lisp/isearch.el          |  138 ++++++++++++++++++++++++++++++++++++++-------
 lisp/replace.el          |    3 +-
 lisp/textmodes/ispell.el |    3 +-
 3 files changed, 120 insertions(+), 24 deletions(-)

diff --git a/lisp/isearch.el b/lisp/isearch.el
index ce75911..ffbf6de 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -315,6 +315,11 @@ A value of nil means highlight all matches."
 		 (integer :tag "Some"))
   :group 'lazy-highlight)
 
+(defcustom lazy-highlight-hint-chars (purecopy "abcdefghijklmnopqrstuvwxyz1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+  "Set of characters to use for hints."
+  :type 'string
+  :group 'lazy-highlight)
+
 (defface lazy-highlight
   '((((class color) (min-colors 88) (background light))
      (:background "paleturquoise"))
@@ -333,6 +338,22 @@ A value of nil means highlight all matches."
                                 'lazy-highlight-face
                                 "22.1")
 (defvar lazy-highlight-face 'lazy-highlight)
+
+(defface lazy-highlight-hint
+  '((((class color) (min-colors 88) (background light))
+     (:background "paleturquoise" :bold t))
+    (((class color) (min-colors 88) (background dark))
+     (:background "paleturquoise4" :bold t))
+    (((class color) (min-colors 16))
+     (:background "turquoise3" :bold t))
+    (((class color) (min-colors 8))
+     (:background "turquoise3" :bold t))
+    (t (:underline t)))
+  "Face for lazy highlighting hints."
+  :group 'lazy-highlight
+  :group 'basic-faces)
+
+(defvar hint-map (make-hash-table :test 'equal))
 \f
 ;; Define isearch help map.
 
@@ -499,6 +520,7 @@ This is like `describe-bindings', but displays only Isearch keys."
     ;; Suggest some alternates...
     (define-key map "\M-c" 'isearch-toggle-case-fold)
     (define-key map "\M-r" 'isearch-toggle-regexp)
+    (define-key map "\C-f" 'isearch-toggle-hints)
     (define-key map "\M-e" 'isearch-edit-string)
 
     (define-key map "\M-sr" 'isearch-toggle-regexp)
@@ -553,7 +575,7 @@ Each set is a vector of the form:
   "Recorded minimum/maximal point for the current search.")
 (defvar isearch-just-started nil)
 (defvar isearch-start-hscroll 0)	; hscroll when starting the search.
-
+(defvar isearch-hints nil)
 ;; case-fold-search while searching.
 ;;   either nil, t, or 'yes.  'yes means the same as t except that mixed
 ;;   case in the search string is ignored.
@@ -653,6 +675,7 @@ If you try to exit with the search string still empty, it invokes
 Type \\[isearch-toggle-case-fold] to toggle search case-sensitivity.
 Type \\[isearch-toggle-regexp] to toggle regular-expression mode.
 Type \\[isearch-toggle-word] to toggle word mode.
+Type \\[isearch-toggle-hints] to toggle hints on/off.
 Type \\[isearch-edit-string] to edit the search string in the minibuffer.
 
 Also supported is a search ring of the previous 16 search strings.
@@ -767,6 +790,7 @@ It is called by the function `isearch-forward' and other related functions."
 	isearch-adjusted nil
 	isearch-yank-flag nil
 	isearch-error nil
+	isearch-hints nil
 	isearch-slow-terminal-mode (and (<= baud-rate search-slow-speed)
 					(> (window-height)
 					   (* 4
@@ -927,7 +951,6 @@ NOPUSH is t and EDIT is t."
     (kill-local-variable 'input-method-function))
 
   (force-mode-line-update)
-
   ;; If we ended in the middle of some intangible text,
   ;; move to the further end of that intangible text.
   (let ((after (if (eobp) nil
@@ -1380,6 +1403,13 @@ Use `isearch-exit' to quit without signaling."
   (sit-for 1)
   (isearch-update))
 
+(defun isearch-toggle-hints ()
+  "Toggle hints on or off."
+  (interactive)
+  (setq isearch-hints (not isearch-hints))
+  (setq isearch-error nil)
+  (isearch-update))
+
 (defun isearch-query-replace (&optional delimited regexp-flag)
   "Start `query-replace' with string to replace from last search string.
 The arg DELIMITED (prefix arg if interactive), if non-nil, means replace
@@ -2078,9 +2108,24 @@ Isearch mode."
      (isearch-text-char-description char))))
 
 (defun isearch-process-search-string (string message)
-  (setq isearch-string (concat isearch-string string)
-	isearch-message (concat isearch-message message))
-  (isearch-search-and-update))
+  (let* ((hint-position (gethash string hint-map)))
+    (if hint-position
+	(progn
+	  (setq isearch-success t
+		isearch-error nil)
+	  (if isearch-forward
+	      (progn
+		(setq isearch-other-end (car hint-position))
+		(goto-char (cadr hint-position)))
+	    (progn
+	      (setq isearch-other-end (cadr hint-position))
+		(goto-char (car hint-position))))
+	  (isearch-done)
+	  (isearch-clean-overlays))
+      (progn
+	(setq isearch-string (concat isearch-string string)
+	    isearch-message (concat isearch-message message))
+	(isearch-search-and-update)))))
 
 \f
 ;; Search Ring
@@ -2623,6 +2668,7 @@ since they have special meaning in a regexp."
 (defvar isearch-lazy-highlight-window-end nil)
 (defvar isearch-lazy-highlight-case-fold-search nil)
 (defvar isearch-lazy-highlight-regexp nil)
+(defvar isearch-lazy-highlight-hints nil)
 (defvar isearch-lazy-highlight-space-regexp nil)
 (defvar isearch-lazy-highlight-word nil)
 (defvar isearch-lazy-highlight-forward nil)
@@ -2639,6 +2685,7 @@ is nil.  This function is called when exiting an incremental search if
         (delete-overlay (car isearch-lazy-highlight-overlays))
         (setq isearch-lazy-highlight-overlays
               (cdr isearch-lazy-highlight-overlays))))
+  (clrhash hint-map)
   (when isearch-lazy-highlight-timer
     (cancel-timer isearch-lazy-highlight-timer)
     (setq isearch-lazy-highlight-timer nil)))
@@ -2665,6 +2712,8 @@ by other Emacs features."
 			  isearch-regexp))
 		 (not (eq isearch-lazy-highlight-word
 			  isearch-word))
+		 (not (eq isearch-lazy-highlight-hints
+			  isearch-hints))
                  (not (= (window-start)
                          isearch-lazy-highlight-window-start))
                  (not (= (window-end)   ; Window may have been split/joined.
@@ -2691,6 +2740,7 @@ by other Emacs features."
 	  isearch-lazy-highlight-last-string  isearch-string
 	  isearch-lazy-highlight-case-fold-search isearch-case-fold-search
 	  isearch-lazy-highlight-regexp       isearch-regexp
+	  isearch-lazy-highlight-hints         isearch-hints
 	  isearch-lazy-highlight-space-regexp search-whitespace-regexp
 	  isearch-lazy-highlight-word         isearch-word
 	  isearch-lazy-highlight-forward      isearch-forward)
@@ -2735,10 +2785,65 @@ Attempt to do the search exactly the way the pending Isearch would."
 	success)
     (error nil)))
 
+(defvar isearch-lazy-highlight-deferred-overlays "Overlay definitions cached until presented")
+
+(defun isearch-lazy-highlight-overlay-throttled-setup ()
+"Setup the overlays and register hint action"
+(let ((max lazy-highlight-max-at-a-time)
+      (looping t))
+  (while (and looping isearch-lazy-highlight-deferred-overlays)
+    (let* ((m (pop isearch-lazy-highlight-deferred-overlays))
+	   (mb (nth 0 m))
+	   (me (nth 1 m))
+	   (hint (nth 2 m))
+	   (ov (make-overlay mb me)))
+      (if hint
+	  (progn (set-text-properties 0 1 '(face lazy-highlight-hint) hint)
+		 (overlay-put ov 'before-string hint)
+		 (puthash hint (list mb me) hint-map)
+		 ))
+      (push ov isearch-lazy-highlight-overlays)
+      ;; 1000 is higher than ediff's 100+,
+      ;; but lower than isearch main overlay's 1001
+      (overlay-put ov 'priority 1000)
+      (overlay-put ov 'face lazy-highlight-face)
+      (overlay-put ov 'window (selected-window))
+
+      (when max
+	(setq max (1- max))
+	(if (<= max 0)
+	    (setq looping nil)))))
+
+  ;; Still more work to do
+  (if isearch-lazy-highlight-deferred-overlays
+      (setq isearch-lazy-highlight-timer
+	    (run-at-time lazy-highlight-interval nil
+			 'isearch-lazy-highlight-overlay-throttled-setup)))))
+
+(defun isearch-lazy-highlight-add-hints (inlist)
+  (let ((hint-chars (mapcar 'string (append lazy-highlight-hint-chars nil)))
+	(get-following-chars-func (function (lambda (arg) (buffer-substring-no-properties (nth 1 arg) (1+ (nth 1 arg))))))
+	out mb me s tmp next-hint)
+    (if  isearch-lazy-highlight-hints
+	(progn
+	  ;; Gather all the chars immediately after our overlays and avoid using them
+	  (setq tmp (delete-dups (mapcar get-following-chars-func inlist)))
+	  ;; Filter out the chars we found from hint-chars
+	  (setq hint-chars (delq nil (mapcar '(lambda (c) (if (not (member c tmp)) c)) hint-chars)))
+	  (dolist (m inlist nil)
+	    (setq mb (car m))
+	    (setq me (cadr m))
+	    (setq s nil)
+	    (setq next-hint (buffer-substring-no-properties me (1+ me)))
+	    (setq s (pop hint-chars))
+	    (push (list mb me s) out)))
+      (setq out inlist))
+    out))
+
 (defun isearch-lazy-highlight-update ()
   "Update highlighting of other matches for current search."
-  (let ((max lazy-highlight-max-at-a-time)
-        (looping t)
+  (let ((looping t)
+	(deferred-overlays nil)
         nomore)
     (with-local-quit
       (save-selected-window
@@ -2752,10 +2857,6 @@ Attempt to do the search exactly the way the pending Isearch would."
 			 isearch-lazy-highlight-start))
 	    (while looping
 	      (let ((found (isearch-lazy-highlight-search)))
-		(when max
-		  (setq max (1- max))
-		  (if (<= max 0)
-		      (setq looping nil)))
 		(if found
 		    (let ((mb (match-beginning 0))
 			  (me (match-end 0)))
@@ -2773,13 +2874,7 @@ Attempt to do the search exactly the way the pending Isearch would."
 			      (forward-char -1)))
 
 			;; non-zero-length match
-			(let ((ov (make-overlay mb me)))
-			  (push ov isearch-lazy-highlight-overlays)
-			  ;; 1000 is higher than ediff's 100+,
-			  ;; but lower than isearch main overlay's 1001
-			  (overlay-put ov 'priority 1000)
-			  (overlay-put ov 'face lazy-highlight-face)
-			  (overlay-put ov 'window (selected-window))))
+			(push (list mb me) deferred-overlays))
 		      (if isearch-lazy-highlight-forward
 			  (setq isearch-lazy-highlight-end (point))
 			(setq isearch-lazy-highlight-start (point)))))
@@ -2798,10 +2893,9 @@ Attempt to do the search exactly the way the pending Isearch would."
 			(setq isearch-lazy-highlight-start (window-end))
 			(goto-char (min (or isearch-lazy-highlight-end-limit (point-max))
 					(window-end))))))))
-	    (unless nomore
-	      (setq isearch-lazy-highlight-timer
-		    (run-at-time lazy-highlight-interval nil
-				 'isearch-lazy-highlight-update)))))))))
+	    (setq isearch-lazy-highlight-deferred-overlays
+		      (isearch-lazy-highlight-add-hints (reverse deferred-overlays)))
+	    (isearch-lazy-highlight-overlay-throttled-setup)))))))
 
 (defun isearch-resume (string regexp word forward message case-fold)
   "Resume an incremental search.
diff --git a/lisp/replace.el b/lisp/replace.el
index cb6d7d2..610c984 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -2116,7 +2116,8 @@ make, or the user didn't cancel the call."
 	    (search-whitespace-regexp nil)
 	    (isearch-case-fold-search case-fold)
 	    (isearch-forward t)
-	    (isearch-error nil))
+	    (isearch-error nil)
+	    (isearch-hints nil))
 	;; Set isearch-word to nil because word-replace is regexp-based,
 	;; so `isearch-search-fun' should not use `word-search-forward'.
 	(if (and isearch-word isearch-regexp) (setq isearch-word nil))
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index c1fcb60..e82adfd 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -2455,7 +2455,8 @@ The variable `ispell-highlight-face' selects the face to use for highlighting."
 		  (regexp-quote (buffer-substring-no-properties start end))
 		  "\\b"))
 		(isearch-regexp t)
-		(isearch-case-fold-search nil))
+		(isearch-case-fold-search nil)
+		(isearch-hints nil))
 	    (isearch-lazy-highlight-new-loop
 	     (if (boundp 'reg-start) reg-start)
 	     (if (boundp 'reg-end)   reg-end)))
-- 
1.7.2.5


^ permalink raw reply related	[flat|nested] 12+ messages in thread

end of thread, other threads:[~2012-01-25 14:00 UTC | newest]

Thread overview: 12+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2012-01-23 17:52 [PATCH] Conkeror like hints for incremental search Gideon Stupp
2012-01-24  7:55 ` Tassilo Horn
2012-01-24 10:09   ` gideon.stupp
2012-01-24 17:39     ` Stefan Monnier
2012-01-24 18:47       ` Gideon Stupp
2012-01-24 19:12         ` Stefan Monnier
2012-01-24 11:44 ` Juanma Barranquero
2012-01-24 22:55 ` Juri Linkov
2012-01-25 11:03   ` gideon.stupp
2012-01-25 11:29     ` Juri Linkov
2012-01-25 11:59       ` gideon.stupp
2012-01-25 14:00         ` Stephen J. Turnbull

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).