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

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

[Jambunathan K]

[-- Attachment #1: Type: text/plain, Size: 192 bytes --]


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.


[-- Attachment #2: hi-lock.el.diff --]
[-- Type: diff, Size: 5760 bytes --]

=== 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  <kjambunathan@gmail.com>
+
+	* 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  <acm@muc.de>
 
 	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.


[-- Attachment #3: Type: text/plain, Size: 611 bytes --]



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



[-- Attachment #4: subr.el.diff --]
[-- Type: diff, Size: 1131 bytes --]

=== 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...)'.

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

[Juri Linkov]

> +(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.

Requiring an additional argument `op' means that we wouldn't
be able to customize `hi-lock-read-regexp-defaults-function'
to just `find-tag-default' or `find-tag-default-as-regexp'.
I think there is no need to distinguish between different
hi-lock commands since one user would very likely prefer
the one way to get the default for all hi-lock commands,
so you could call `hi-lock-read-regexp-defaults-function'
without arguments.

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

[Jambunathan K]

Juri Linkov <juri@jurta.org> writes:

>> +(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.
>
> Requiring an additional argument `op' means that we wouldn't
> be able to customize `hi-lock-read-regexp-defaults-function'
> to just `find-tag-default' or `find-tag-default-as-regexp'.
> I think there is no need to distinguish between different
> hi-lock commands since one user would very likely prefer
> the one way to get the default for all hi-lock commands,
> so you could call `hi-lock-read-regexp-defaults-function'
> without arguments.

I had the same thought but ended up with having an OP.

If we want to remove OP but still want the ability to choose the regexp
based on the highlighting command, then may be `this-command' can take
the place of OP.

ps: Does EmacsLisp have notion of function pointers (as in C).  Here the
function pointer is not declared and the function pointer could well be
set in a .emacs file.  So there is no way the byte-compiler can complain
based on arity.  Does runtime check for arity? (I don't think so).  May
be (i.e., technically) it is OK to call a function that takes no
argument with a single argument?  I don't know.  Let's see what others
think.

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

[Jambunathan K]

Juri Linkov <juri@jurta.org> writes:

>> +(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.
>
> Requiring an additional argument `op' means that we wouldn't
> be able to customize `hi-lock-read-regexp-defaults-function'
> to just `find-tag-default' or `find-tag-default-as-regexp'.
> I think there is no need to distinguish between different
> hi-lock commands since one user would very likely prefer
> the one way to get the default for all hi-lock commands,
> so you could call `hi-lock-read-regexp-defaults-function'
> without arguments.

Committed as bzr revision 111971.

I have removed OP, updated the docstring.  I have also introduced
`find-tag-default-as-regexp' in subr.el.

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

[Juri Linkov]

> Provide for customizing default regexp in hi-lock commands

Actually it's possible do the same for hi-lock commands that read faces.

I mean moving the following part of `hi-lock-read-face-name':

   (defaults (append hi-lock--unused-faces
                     (cdr (member last-used-face hi-lock-face-defaults))
                     hi-lock-face-defaults))

to a new function with a name like `hi-lock-read-face-name-defaults'
where you could implement your wishes for hi-lock face auto-rotation
and auto-selection of the next default face value.  In a separate
function the users would be able to modify its default behavior easily.