From aa12a3d6ac7e2dae9e3f25336c4f01a3507913b4 Mon Sep 17 00:00:00 2001 From: gstupp 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)) ;; 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))))) ;; 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