[Emacs-diffs] /srv/bzr/emacs/trunk r111971: Provide for customizing default regexp in hi-lock commands (Bug#13892).

[Jambunathan K]

------------------------------------------------------------
revno: 111971
committer: Jambunathan K <address@hidden>
branch nick: trunk
timestamp: Fri 2013-03-08 09:48:16 +0530
message:
  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.
modified:
  lisp/ChangeLog
  lisp/hi-lock.el
  lisp/replace.el
  lisp/subr.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-03-08 02:11:25 +0000
+++ b/lisp/ChangeLog    2013-03-08 04:18:16 +0000
@@ -1,3 +1,14 @@
+2013-03-08  Jambunathan K  <address@hidden>
+
+       * 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  <address@hidden>
 
        * calc/calc-units.el (calc-convert-units): Fix the way that default

=== modified file 'lisp/hi-lock.el'
--- a/lisp/hi-lock.el   2013-01-28 20:00:35 +0000
+++ b/lisp/hi-lock.el   2013-03-08 04:18:16 +0000
@@ -279,6 +279,26 @@
     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 @@
 ;;;###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 @@
 ;;;###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 @@
 ;;;###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.
+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'.
 
-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
      (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 @@
       (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.

=== modified file 'lisp/replace.el'
--- a/lisp/replace.el   2013-02-25 20:57:44 +0000
+++ b/lisp/replace.el   2013-03-08 04:18:16 +0000
@@ -603,15 +603,7 @@
          (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)))))

=== modified file 'lisp/subr.el'
--- a/lisp/subr.el      2013-02-09 16:20:29 +0000
+++ b/lisp/subr.el      2013-03-08 04:18:16 +0000
@@ -2697,6 +2697,22 @@
                     (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: