Provide for customizing default regexp in hi-lock commands (Bug#13892).

* lisp/hi-lock.el (hi-lock-read-regexp-defaults-function): New var.
(hi-lock-read-regexp-defaults):	 New defun.
(hi-lock-line-face-buffer, hi-lock-face-buffer)
(hi-lock-face-phrase-buffer): Propagate above change.  Update
docstring.

* lisp/subr.el (find-tag-default-as-regexp): New defun.
* lisp/replace.el (read-regexp): Propagate above change.

4 files changed, 81 insertions, 31 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c8a4a06f28d..487d9e611d6 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,14 @@
+2013-03-08  Jambunathan K  <kjambunathan@gmail.com>
+
+	* hi-lock.el (hi-lock-read-regexp-defaults-function): New var.
+	(hi-lock-read-regexp-defaults):	 New defun.
+	(hi-lock-line-face-buffer, hi-lock-face-buffer)
+	(hi-lock-face-phrase-buffer): Propagate above change.  Update
+	docstring (bug#13892).
+
+	* subr.el (find-tag-default-as-regexp): New defun.
+	* replace.el (read-regexp): Propagate above change.
+
 2013-03-08  Jay Belanger  <jay.p.belanger@gmail.com>
 
 	* calc/calc-units.el (calc-convert-units): Fix the way that default
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index cbd8ac5ebad..38e5e8acb15 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -279,6 +279,26 @@ a library is being loaded.")
     map)
   "Key map for hi-lock.")
 
+(defvar hi-lock-read-regexp-defaults-function
+  'hi-lock-read-regexp-defaults
+  "Function that provides default regexp(s) for highlighting commands.
+This function should take no arguments and return one of nil, a
+regexp or a list of regexps for use with highlighting commands -
+`hi-lock-face-phrase-buffer', `hi-lock-line-face-buffer' and
+`hi-lock-face-buffer'.  The return value of this function is used
+as DEFAULTS param of `read-regexp' while executing the
+highlighting command.  This function is called only during
+interactive use.  
+
+For example, to highlight at symbol at point use
+
+    \(setq hi-lock-read-regexp-defaults-function 
+	  'find-tag-default-as-regexp\)
+
+If you need different defaults for different highlighting
+operations, use `this-command' to identify the command under
+execution.")
+
 ;; Visible Functions
 
 ;;;###autoload
@@ -399,17 +419,18 @@ versions before 22 use the following in your init file:
 ;;;###autoload
 (defun hi-lock-line-face-buffer (regexp &optional face)
   "Set face of all lines containing a match of REGEXP to FACE.
-Interactively, prompt for REGEXP then FACE, using a buffer-local
-history list for REGEXP and a global history list for FACE.
+Interactively, prompt for REGEXP then FACE.  Use
+`hi-lock-read-regexp-defaults-function' to retrieve default
+value(s) of REGEXP.  Use the global history list for FACE.
 
-If Font Lock mode is enabled in the buffer, it is used to
-highlight REGEXP.  If Font Lock mode is disabled, overlays are
-used for highlighting; in this case, the highlighting will not be
-updated as you type."
+Use Font lock mode, if enabled, to highlight REGEXP.  Otherwise,
+use overlays for highlighting.  If overlays are used, the
+highlighting will not update as you type."
   (interactive
    (list
     (hi-lock-regexp-okay
-     (read-regexp "Regexp to highlight line" (car regexp-history)))
+     (read-regexp "Regexp to highlight line"
+		  (funcall hi-lock-read-regexp-defaults-function)))
     (hi-lock-read-face-name)))
   (or (facep face) (setq face 'hi-yellow))
   (unless hi-lock-mode (hi-lock-mode 1))
@@ -424,17 +445,18 @@ updated as you type."
 ;;;###autoload
 (defun hi-lock-face-buffer (regexp &optional face)
   "Set face of each match of REGEXP to FACE.
-Interactively, prompt for REGEXP then FACE, using a buffer-local
-history list for REGEXP and a global history list for FACE.
+Interactively, prompt for REGEXP then FACE.  Use
+`hi-lock-read-regexp-defaults-function' to retrieve default
+value(s) REGEXP.  Use the global history list for FACE.
 
-If Font Lock mode is enabled in the buffer, it is used to
-highlight REGEXP.  If Font Lock mode is disabled, overlays are
-used for highlighting; in this case, the highlighting will not be
-updated as you type."
+Use Font lock mode, if enabled, to highlight REGEXP.  Otherwise,
+use overlays for highlighting.  If overlays are used, the
+highlighting will not update as you type."
   (interactive
    (list
     (hi-lock-regexp-okay
-     (read-regexp "Regexp to highlight" (car regexp-history)))
+     (read-regexp "Regexp to highlight"
+		  (funcall hi-lock-read-regexp-defaults-function)))
     (hi-lock-read-face-name)))
   (or (facep face) (setq face 'hi-yellow))
   (unless hi-lock-mode (hi-lock-mode 1))
@@ -445,18 +467,22 @@ updated as you type."
 ;;;###autoload
 (defun hi-lock-face-phrase-buffer (regexp &optional face)
   "Set face of each match of phrase REGEXP to FACE.
-If called interactively, replaces whitespace in REGEXP with
-arbitrary whitespace and makes initial lower-case letters case-insensitive.
-
-If Font Lock mode is enabled in the buffer, it is used to
-highlight REGEXP.  If Font Lock mode is disabled, overlays are
-used for highlighting; in this case, the highlighting will not be
-updated as you type."
+Interactively, prompt for REGEXP then FACE.  Use
+`hi-lock-read-regexp-defaults-function' to retrieve default
+value(s) of REGEXP.  Use the global history list for FACE.  When
+called interactively, replace whitespace in user provided regexp
+with arbitrary whitespace and make initial lower-case letters
+case-insensitive before highlighting with `hi-lock-set-pattern'.
+
+Use Font lock mode, if enabled, to highlight REGEXP.  Otherwise,
+use overlays for highlighting.  If overlays are used, the
+highlighting will not update as you type."
   (interactive
    (list
     (hi-lock-regexp-okay
      (hi-lock-process-phrase
-      (read-regexp "Phrase to highlight" (car regexp-history))))
+      (read-regexp "Phrase to highlight"
+		   (funcall hi-lock-read-regexp-defaults-function))))
     (hi-lock-read-face-name)))
   (or (facep face) (setq face 'hi-yellow))
   (unless hi-lock-mode (hi-lock-mode 1))
@@ -622,6 +648,11 @@ not suitable."
       (error "Regexp cannot match an empty string")
     regexp))
 
+(defun hi-lock-read-regexp-defaults ()
+  "Return the latest regexp from `regexp-history'.
+See `hi-lock-read-regexp-defaults-function' for details."
+  (car regexp-history))
+
 (defun hi-lock-read-face-name ()
   "Return face for interactive highlighting.
 When `hi-lock-auto-select-face' is non-nil, just return the next face.
diff --git a/lisp/replace.el b/lisp/replace.el
index 86b1aa27069..ceb0fe4a63e 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -603,15 +603,7 @@ If HISTORY is nil, `regexp-history' is used."
 	  (append
 	   suggestions
 	   (list
-	    ;; Regexp for tag at point.
-	    (let* ((tagf (or find-tag-default-function
-			     (get major-mode 'find-tag-default-function)
-			     'find-tag-default))
-		   (tag (funcall tagf)))
-	      (cond ((not tag) "")
-		    ((eq tagf 'find-tag-default)
-		     (format "\\_<%s\\_>" (regexp-quote tag)))
-		    (t (regexp-quote tag))))
+	    (find-tag-default-as-regexp)
 	    (car regexp-search-ring)
 	    (regexp-quote (or (car search-ring) ""))
 	    (car (symbol-value query-replace-from-history-variable)))))
diff --git a/lisp/subr.el b/lisp/subr.el
index db2b6a8eaad..6c7257ad987 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2697,6 +2697,22 @@ If there is no plausible default, return nil."
 		     (setq to (point)))))
       (buffer-substring-no-properties from to))))
 
+(defun find-tag-default-as-regexp ()
+  "Return regexp that matches the default tag at point.
+If there is no tag at point, return nil.
+
+When in a major mode that does not provide it's own
+`find-tag-default-function', return a regexp that matches the
+symbol at point exactly."
+  (let* ((tagf (or find-tag-default-function
+		   (get major-mode 'find-tag-default-function)
+		   'find-tag-default))
+	 (tag (funcall tagf)))
+    (cond ((not tag))
+	  ((eq tagf 'find-tag-default)
+	   (format "\\_<%s\\_>" (regexp-quote tag)))
+	  (t (regexp-quote tag)))))
+
 (defun play-sound (sound)
   "SOUND is a list of the form `(sound KEYWORD VALUE...)'.
 The following keywords are recognized: