Search and highlight symbol at point.

* doc/emacs/display.texi (Highlight Interactively): Add global keybindings
with the key prefix `M-s h'.  Document old command `highlight-phrase'.
Document new command `highlight-symbol-at-point'.

* lisp/bindings.el (search-map): Bind `highlight-symbol-at-point' to
`M-s h .'. 

* lisp/hi-lock.el (highlight-symbol-at-point): New alias for the new
command `hi-lock-face-symbol-at-point'.
(hi-lock-face-symbol-at-point): New command.
(hi-lock-map): Bind `highlight-symbol-at-point' to `C-x w .'.
(hi-lock-menu): Add `highlight-symbol-at-point'.
(hi-lock-mode): Doc fix.

* lisp/isearch.el (isearch-forward-symbol-at-point): New command.
(search-map): Bind `isearch-forward-symbol-at-point' to `M-s .'.
(isearch-highlight-regexp): Add a regexp which matches
words/symbols for word/symbol mode.

* lisp/subr.el (find-tag-default-bounds): New function with the body
mostly moved from `find-tag-default'.
(find-tag-default): Move most code to `find-tag-default-bounds',
call it and apply `buffer-substring-no-properties' afterwards.

Fixes: debbugs:14427

8 files changed, 153 insertions, 17 deletions

diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog
index b1f9fb2a40d..f0b89a15fcc 100644
--- a/doc/emacs/ChangeLog
+++ b/doc/emacs/ChangeLog
@@ -1,3 +1,9 @@
+2013-06-03  Juri Linkov  <juri@jurta.org>
+
+	* display.texi (Highlight Interactively): Add global keybindings
+	with the key prefix `M-s h'.  Document old command `highlight-phrase'.
+	Document new command `highlight-symbol-at-point'.
+
 2013-06-01  Glenn Morris  <rgm@gnu.org>
 
 	* programs.texi (Semantic): Fix typo.
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index f5ec8946e1b..482d7e7741a 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -903,14 +903,16 @@ that you specify explicitly the regular expressions to highlight.  You
 control them with these commands:
 
 @table @kbd
-@item C-x w h @var{regexp} @key{RET} @var{face} @key{RET}
+@item M-s h r @var{regexp} @key{RET} @var{face} @key{RET}
+@itemx C-x w h @var{regexp} @key{RET} @var{face} @key{RET}
+@kindex M-s h r
 @kindex C-x w h
 @findex highlight-regexp
 Highlight text that matches @var{regexp} using face @var{face}
 (@code{highlight-regexp}).  The highlighting will remain as long as
 the buffer is loaded.  For example, to highlight all occurrences of
 the word ``whim'' using the default face (a yellow background)
-@kbd{C-x w h whim @key{RET} @key{RET}}.  Any face can be used for
+@kbd{M-s h r whim @key{RET} @key{RET}}.  Any face can be used for
 highlighting, Hi Lock provides several of its own and these are
 pre-loaded into a list of default values.  While being prompted
 for a face use @kbd{M-n} and @kbd{M-p} to cycle through them.
@@ -918,7 +920,9 @@ for a face use @kbd{M-n} and @kbd{M-p} to cycle through them.
 You can use this command multiple times, specifying various regular
 expressions to highlight in different ways.
 
-@item C-x w r @var{regexp} @key{RET}
+@item M-s h u @var{regexp} @key{RET}
+@itemx C-x w r @var{regexp} @key{RET}
+@kindex M-s h u
 @kindex C-x w r
 @findex unhighlight-regexp
 Unhighlight @var{regexp} (@code{unhighlight-regexp}).
@@ -926,13 +930,15 @@ Unhighlight @var{regexp} (@code{unhighlight-regexp}).
 If you invoke this from the menu, you select the expression to
 unhighlight from a list.  If you invoke this from the keyboard, you
 use the minibuffer.  It will show the most recently added regular
-expression; use @kbd{M-p} to show the next older expression and
-@kbd{M-n} to select the next newer expression.  (You can also type the
+expression; use @kbd{M-n} to show the next older expression and
+@kbd{M-p} to select the next newer expression.  (You can also type the
 expression by hand, with completion.)  When the expression you want to
 unhighlight appears in the minibuffer, press @kbd{@key{RET}} to exit
 the minibuffer and unhighlight it.
 
-@item C-x w l @var{regexp} @key{RET} @var{face} @key{RET}
+@item M-s h l @var{regexp} @key{RET} @var{face} @key{RET}
+@itemx C-x w l @var{regexp} @key{RET} @var{face} @key{RET}
+@kindex M-s h l
 @kindex C-x w l
 @findex highlight-lines-matching-regexp
 @cindex lines, highlighting
@@ -940,7 +946,31 @@ the minibuffer and unhighlight it.
 Highlight entire lines containing a match for @var{regexp}, using face
 @var{face} (@code{highlight-lines-matching-regexp}).
 
-@item C-x w b
+@item M-s h p @var{phrase} @key{RET} @var{face} @key{RET}
+@itemx C-x w p @var{phrase} @key{RET} @var{face} @key{RET}
+@kindex M-s h p
+@kindex C-x w p
+@findex highlight-phrase
+@cindex phrase, highlighting
+@cindex highlighting phrase
+Highlight matches of @var{phrase}, using face @var{face}
+(@code{highlight-phrase}).  @var{phrase} can be any regexp,
+but spaces will be replaced by matches to whitespace and
+initial lower-case letters will become case insensitive.
+
+@item M-s h .
+@itemx C-x w .
+@kindex M-s h .
+@kindex C-x w .
+@findex highlight-symbol-at-point
+@cindex symbol, highlighting
+@cindex highlighting symbol at point
+Highlight the symbol found near point without prompting, using the next
+available face automatically (@code{highlight-symbol-at-point}).
+
+@item M-s h w
+@itemx C-x w b
+@kindex M-s h w
 @kindex C-x w b
 @findex hi-lock-write-interactive-patterns
 Insert all the current highlighting regexp/face pairs into the buffer
@@ -952,7 +982,9 @@ These patterns are extracted from the comments, if appropriate, if you
 invoke @kbd{M-x hi-lock-find-patterns}, or if you visit the file while
 Hi Lock mode is enabled (since that runs @code{hi-lock-find-patterns}).
 
-@item C-x w i
+@item M-s h f
+@itemx C-x w i
+@kindex M-s h f
 @kindex C-x w i
 @findex hi-lock-find-patterns
 Extract regexp/face pairs from comments in the current buffer
diff --git a/etc/NEWS b/etc/NEWS
index b2ecba79684..bb66faa183c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -260,8 +260,22 @@ callers to fit the image to a frame other than the selected frame.
 entries displayed by `Info-index-next', `Info-virtual-index' and
 `info-apropos'.
 
+** Hi-Lock
+
+*** New option `hi-lock-auto-select-face'.  When non-nil, hi-lock commands
+will cycle through faces in `hi-lock-face-defaults' without prompting.
+
++++
+*** New global command `M-s h .' (`highlight-symbol-at-point')
+highlights the symbol found near point without prompting,
+using the next face automatically.
+
 ** Search and Replace
 
+*** New global command `M-s .' (`isearch-forward-symbol-at-point')
+starts a symbol (identifier) incremental search forward with the
+symbol found near point added to the search string initially.
+
 *** `C-x 8 RET' in Isearch mode reads a character by its Unicode name
 and adds it to the search string.
 
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7ee43e602f9..35ea3231c93 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,25 @@
+2013-06-03  Juri Linkov  <juri@jurta.org>
+
+	* bindings.el (search-map): Bind `highlight-symbol-at-point' to
+	`M-s h .'.  (Bug#14427)
+
+	* hi-lock.el (highlight-symbol-at-point): New alias for the new
+	command `hi-lock-face-symbol-at-point'.
+	(hi-lock-face-symbol-at-point): New command.
+	(hi-lock-map): Bind `highlight-symbol-at-point' to `C-x w .'.
+	(hi-lock-menu): Add `highlight-symbol-at-point'.
+	(hi-lock-mode): Doc fix.
+
+	* isearch.el (isearch-forward-symbol-at-point): New command.
+	(search-map): Bind `isearch-forward-symbol-at-point' to `M-s .'.
+	(isearch-highlight-regexp): Add a regexp which matches
+	words/symbols for word/symbol mode.
+
+	* subr.el (find-tag-default-bounds): New function with the body
+	mostly moved from `find-tag-default'.
+	(find-tag-default): Move most code to `find-tag-default-bounds',
+	call it and apply `buffer-substring-no-properties' afterwards.
+
 2013-06-03  Tassilo Horn  <tsdh@gnu.org>
 
 	* eshell/em-term.el (eshell-term-initialize): Use
diff --git a/lisp/bindings.el b/lisp/bindings.el
index fe0eabb77af..2013c079820 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -894,6 +894,7 @@ if `inhibit-field-text-motion' is non-nil."
 (define-key search-map "hr" 'highlight-regexp)
 (define-key search-map "hp" 'highlight-phrase)
 (define-key search-map "hl" 'highlight-lines-matching-regexp)
+(define-key search-map "h." 'highlight-symbol-at-point)
 (define-key search-map "hu" 'unhighlight-regexp)
 (define-key search-map "hf" 'hi-lock-find-patterns)
 (define-key search-map "hw" 'hi-lock-write-interactive-patterns)
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index e2dc4eac67b..d0a82cd97b0 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -37,18 +37,18 @@
 ;;
 ;;    In program source code highlight a variable to quickly see all
 ;;    places it is modified or referenced:
-;;    M-x highlight-regexp ground_contact_switches_closed RET RET
+;;    M-x highlight-regexp RET ground_contact_switches_closed RET RET
 ;;
 ;;    In a shell or other buffer that is showing lots of program
 ;;    output, highlight the parts of the output you're interested in:
-;;    M-x highlight-regexp Total execution time [0-9]+ RET hi-blue-b RET
+;;    M-x highlight-regexp RET Total execution time [0-9]+ RET hi-blue-b RET
 ;;
 ;;    In buffers displaying tables, highlight the lines you're interested in:
-;;    M-x highlight-lines-matching-regexp January 2000 RET hi-black-b RET
+;;    M-x highlight-lines-matching-regexp RET January 2000 RET hi-black-b RET
 ;;
 ;;    When writing text, highlight personal cliches.  This can be
 ;;    amusing.
-;;    M-x highlight-phrase as can be seen RET RET
+;;    M-x highlight-phrase RET as can be seen RET RET
 ;;
 ;;  Setup:
 ;;
@@ -252,6 +252,10 @@ a library is being loaded.")
       '(menu-item "Highlight Lines..." highlight-lines-matching-regexp
         :help "Highlight lines containing match of PATTERN (a regexp)."))
 
+    (define-key-after map [highlight-symbol-at-point]
+      '(menu-item "Highlight Symbol at Point" highlight-symbol-at-point
+        :help "Highlight symbol found near point without prompting."))
+
     (define-key-after map [unhighlight-regexp]
       '(menu-item "Remove Highlighting..." unhighlight-regexp
         :help "Remove previously entered highlighting pattern."
@@ -274,6 +278,7 @@ a library is being loaded.")
     (define-key map "\C-xwl" 'highlight-lines-matching-regexp)
     (define-key map "\C-xwp" 'highlight-phrase)
     (define-key map "\C-xwh" 'highlight-regexp)
+    (define-key map "\C-xw." 'highlight-symbol-at-point)
     (define-key map "\C-xwr" 'unhighlight-regexp)
     (define-key map "\C-xwb" 'hi-lock-write-interactive-patterns)
     map)
@@ -333,6 +338,10 @@ which can be called interactively, are:
 \\[highlight-lines-matching-regexp] REGEXP FACE
   Highlight lines containing matches of REGEXP in current buffer with FACE.
 
+\\[highlight-symbol-at-point]
+  Highlight the symbol found near point without prompting, using the next
+  available face automatically.
+
 \\[unhighlight-regexp] REGEXP
   Remove highlighting on matches of REGEXP in current buffer.
 
@@ -490,6 +499,27 @@ highlighting will not update as you type."
   (unless hi-lock-mode (hi-lock-mode 1))
   (hi-lock-set-pattern regexp face))
 
+;;;###autoload
+(defalias 'highlight-symbol-at-point 'hi-lock-face-symbol-at-point)
+;;;###autoload
+(defun hi-lock-face-symbol-at-point ()
+  "Set face of each match of the symbol at point.
+Use `find-tag-default-as-regexp' to retrieve the symbol at point.
+Use non-nil `hi-lock-auto-select-face' to retrieve the next face
+from `hi-lock-face-defaults' automatically.
+
+Use Font lock mode, if enabled, to highlight symbol at point.
+Otherwise, use overlays for highlighting.  If overlays are used,
+the highlighting will not update as you type."
+  (interactive)
+  (let* ((regexp (hi-lock-regexp-okay
+		  (find-tag-default-as-regexp)))
+	 (hi-lock-auto-select-face t)
+	 (face (hi-lock-read-face-name)))
+    (or (facep face) (setq face 'hi-yellow))
+    (unless hi-lock-mode (hi-lock-mode 1))
+    (hi-lock-set-pattern regexp face)))
+
 (defun hi-lock-keyword->face (keyword)
   (cadr (cadr (cadr keyword))))    ; Keyword looks like (REGEXP (0 'FACE) ...).
 
diff --git a/lisp/isearch.el b/lisp/isearch.el
index acecc74d1be..c49b0d7fc59 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -667,6 +667,7 @@ Each set is a vector of the form:
 (define-key esc-map "\C-r" 'isearch-backward-regexp)
 (define-key search-map "w" 'isearch-forward-word)
 (define-key search-map "_" 'isearch-forward-symbol)
+(define-key search-map "." 'isearch-forward-symbol-at-point)
 
 ;; Entry points to isearch-mode.
 
@@ -806,6 +807,25 @@ as a regexp.  See the command `isearch-forward' for more information."
   (interactive "P\np")
   (isearch-mode nil (null not-regexp) nil (not no-recursive-edit)))
 
+(defun isearch-forward-symbol-at-point ()
+  "Do incremental search forward for a symbol found near point.
+Like ordinary incremental search except that the symbol found at point
+is added to the search string initially as a regexp surrounded
+by symbol boundary constructs \\_< and \\_>.
+See the command `isearch-forward-symbol' for more information."
+  (interactive)
+  (isearch-forward-symbol nil 1)
+  (let ((bounds (find-tag-default-bounds)))
+    (cond
+     (bounds
+      (when (< (car bounds) (point))
+	(goto-char (car bounds)))
+      (isearch-yank-string
+       (buffer-substring-no-properties (car bounds) (cdr bounds))))
+     (t
+      (setq isearch-error "No symbol at point")
+      (isearch-update)))))
+
 
 ;; isearch-mode only sets up incremental search for the minor mode.
 ;; All the work is done by the isearch-mode commands.
@@ -1752,7 +1772,10 @@ and reads its face argument using `hi-lock-read-face-name'."
     (isearch-done nil t)
     (isearch-clean-overlays))
   (require 'hi-lock nil t)
-  (let ((string (cond (isearch-regexp isearch-string)
+  (let ((regexp (cond ((functionp isearch-word)
+		       (funcall isearch-word isearch-string))
+		      (isearch-word (word-search-regexp isearch-string))
+		      (isearch-regexp isearch-string)
 		      ((if (and (eq isearch-case-fold-search t)
 				search-upper-case)
 			   (isearch-no-upper-case-p
@@ -1768,7 +1791,7 @@ and reads its face argument using `hi-lock-read-face-name'."
 			      (regexp-quote s))))
 			isearch-string ""))
 		      (t (regexp-quote isearch-string)))))
-    (hi-lock-face-buffer string (hi-lock-read-face-name)))
+    (hi-lock-face-buffer regexp (hi-lock-read-face-name)))
   (and isearch-recursive-edit (exit-recursive-edit)))
 
 
diff --git a/lisp/subr.el b/lisp/subr.el
index 23684f02b87..6b1dd48258e 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2717,8 +2717,9 @@ customize the variable `user-emacs-directory-warning'."
   "Return non-nil if the current buffer is narrowed."
   (/= (- (point-max) (point-min)) (buffer-size)))
 
-(defun find-tag-default ()
-  "Determine default tag to search for, based on text at point.
+(defun find-tag-default-bounds ()
+  "Determine the boundaries of the default tag, based on text at point.
+Return a cons cell with the beginning and end of the found tag.
 If there is no plausible default, return nil."
   (let (from to bound)
     (when (or (progn
@@ -2742,7 +2743,14 @@ If there is no plausible default, return nil."
 		     (< (setq from (point)) bound)
 		     (skip-syntax-forward "w_")
 		     (setq to (point)))))
-      (buffer-substring-no-properties from to))))
+      (cons from to))))
+
+(defun find-tag-default ()
+  "Determine default tag to search for, based on text at point.
+If there is no plausible default, return nil."
+  (let ((bounds (find-tag-default-bounds)))
+    (when bounds
+      (buffer-substring-no-properties (car bounds) (cdr bounds)))))
 
 (defun find-tag-default-as-regexp ()
   "Return regexp that matches the default tag at point.