Subject: bug#13892: 24.3.50; Provide for customizing default regexp in hi-lock commands

From: Jambunathan K <[email-masked]>
Date: Wed, 06 Mar 2013 23:26:09 +0530

Provide for customizing default regexp in hi-lock commands

See bug#13687 & Co. disussion surrounding this feature-let.  

Let me know if the patch is OK, so that I can install it in trunk.

=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog	2013-03-06 14:24:39 +0000
+++ lisp/ChangeLog	2013-03-06 17:37:52 +0000
@@ -1,3 +1,12 @@
+2013-03-06  Jambunathan K  <[email-masked]>
+
+	* hi-lock.el (hi-lock-read-regexp-defaults-function): New
+	variable.
+	(hi-lock-read-regexp-defaults): New defun.
+	(hi-lock-line-face-buffer, hi-lock-face-buffer)
+	(hi-lock-face-phrase-buffer): Use
+	`hi-lock-read-regexp-defaults-function'.  Update docstring.
+
 2013-03-06  Alan Mackenzie  <[email-masked]>
 
 	Correct the position of point in some line-up functions.

=== modified file 'lisp/hi-lock.el'
--- lisp/hi-lock.el	2013-01-28 20:00:35 +0000
+++ lisp/hi-lock.el	2013-03-06 17:25:29 +0000
@@ -279,6 +279,19 @@ 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 one argument OP and return one of nil,
+a regexp or a list of regexps for use with highlighting command
+OP.  OP, a symbol, can be one of `phrase', `line' or `nil'
+signifying commands `hi-lock-face-phrase-buffer',
+`hi-lock-line-face-buffer' and `hi-lock-face-buffer'
+respectively.
+
+The return value of this function is used as DEFAULTS param of
+`read-regexp' while executing command denoted by OP.")
+
 ;; Visible Functions
 
 ;;;###autoload
@@ -399,17 +412,18 @@ versions before 22 use the following in
 ;;;###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.
-
-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.
+
+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 'line)))
     (hi-lock-read-face-name)))
   (or (facep face) (setq face 'hi-yellow))
   (unless hi-lock-mode (hi-lock-mode 1))
@@ -424,17 +438,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.
-
-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) REGEXP.  Use the global history list for FACE.
+
+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 nil)))
     (hi-lock-read-face-name)))
   (or (facep face) (setq face 'hi-yellow))
   (unless hi-lock-mode (hi-lock-mode 1))
@@ -445,18 +460,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 'phrase))))
     (hi-lock-read-face-name)))
   (or (facep face) (setq face 'hi-yellow))
   (unless hi-lock-mode (hi-lock-mode 1))
@@ -622,6 +641,13 @@ not suitable."
       (error "Regexp cannot match an empty string")
     regexp))
 
+(defun hi-lock-read-regexp-defaults (op)
+  "Return the latest regexp from `regexp-history'.
+See `hi-lock-read-regexp-defaults-function' for details."
+  (case op				; Keep compiler happy.
+    ((phrase line nil)
+     (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.

I also need a ready-made function for retrieving the regexp for symbol
at point.

I can install this as a new defun in subr.el

    (defun find-tag-default-as-regexp ()
      (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)))))

or

Augment existing `find-tag-default' to take an optional argument like so

=== modified file 'lisp/subr.el'
--- lisp/subr.el	2013-02-09 16:20:29 +0000
+++ lisp/subr.el	2013-03-06 17:51:43 +0000
@@ -2670,9 +2670,12 @@ directory if it does not exist."
   "Return non-nil if the current buffer is narrowed."
   (/= (- (point-max) (point-min)) (buffer-size)))
 
-(defun find-tag-default ()
+(defun find-tag-default (&optional regexp-p)
   "Determine default tag to search for, based on text at point.
-If there is no plausible default, return nil."
+If there is no plausible default, return nil.
+
+When optional argument REGEXP-P is nil, return a regexp that
+matches tag as a symbol."
   (let (from to bound)
     (when (or (progn
 		;; Look at text around `point'.
@@ -2695,7 +2698,9 @@ If there is no plausible default, return
 		     (< (setq from (point)) bound)
 		     (skip-syntax-forward "w_")
 		     (setq to (point)))))
-      (buffer-substring-no-properties from to))))
+      (let ((tag (buffer-substring-no-properties from to)))
+	(if (not regexp-p) tag
+	  (format "\\_<%s\\_>" (regexp-quote tag)))))))
 
 (defun play-sound (sound)
   "SOUND is a list of the form `(sound KEYWORD VALUE...)'.