Package: emacs;
Reported by: Jambunathan K <kjambunathan <at> gmail.com>
Date: Mon, 26 Mar 2012 07:19:02 UTC
Severity: minor
Tags: patch
Found in version 24.0.94
Done: Stefan Monnier <monnier <at> IRO.UMontreal.CA>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Jambunathan K <kjambunathan <at> gmail.com> To: Stefan Monnier <monnier <at> iro.umontreal.ca> Cc: 11095 <at> debbugs.gnu.org Subject: bug#11095: [PATCH] Re: bug#11095: 24.0.94; hi-lock-face-buffer/unhighlight-regexp': Augment? Date: Thu, 06 Dec 2012 20:20:16 +0530
[Message part 1 (text/plain, inline)]
Please review the attached patch. The patch exposes exposes a bug in defcustom and defvar-local which I will outline separately in a followup post (after another 2-3 hours). ps: I only wish you had tested unhighlighting part. It would have saved some re-working for me.
[bug11095.patch (text/x-diff, inline)]
=== modified file 'etc/NEWS'
--- etc/NEWS 2012-12-04 17:07:09 +0000
+++ etc/NEWS 2012-12-06 14:44:01 +0000
@@ -74,6 +74,15 @@ when its arg ADJACENT is non-nil (when c
it works like the utility `uniq'. Otherwise by default it deletes
duplicate lines everywhere in the region without regard to adjacency.
+** Various improvements to hi-lock.el
+*** New user variables `hi-lock-faces' and `hi-lock-auto-select-face'
+*** Highlighting commands (`hi-lock-face-buffer', `hi-lock-face-phrase-buffer'
+and `hi-lock-line-face-buffer') now take a prefix argument which
+temporarily inverts the meaning of `hi-lock-auto-select-face'.
+*** Unhighlighting command (`hi-lock-unface-buffer') now un-highlights text at
+point. When called interactively with C-u, removes all highlighting
+in current buffer.
+
** Tramp
+++
*** New connection method "adb", which allows to access Android
=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog 2012-12-06 09:15:27 +0000
+++ lisp/ChangeLog 2012-12-06 14:24:34 +0000
@@ -1,3 +1,18 @@
+2012-12-06 Jambunathan K <kjambunathan <at> gmail.com>
+
+ * hi-lock.el (hi-lock-faces): New user variable.
+ (hi-lock--auto-select-face-defaults): Use `hi-lock-faces'.
+ (hi-lock-read-face-name): New optional param `toggle-auto-select'.
+ (hi-lock-line-face-buffer, hi-lock-face-buffer)
+ (hi-lock-face-phrase-buffer): Allow prefix argument to temporarily
+ toggle the value of `hi-lock-auto-select-face'.
+ (hi-lock--regexps-at-point, hi-lock-unface-buffer): Fix earlier
+ commit.
+ (hi-lock-set-pattern): Refuse to highlight a regexp that is
+ already highlighted.
+
+ * faces.el (face-at-point): Fix bug (Bug#11095).
+
2012-12-06 Michael Albinus <michael.albinus <at> gmx.de>
* net/tramp.el (tramp-replace-environment-variables): Hide
=== modified file 'lisp/faces.el'
--- lisp/faces.el 2012-11-25 04:50:20 +0000
+++ lisp/faces.el 2012-12-05 19:35:05 +0000
@@ -1884,6 +1884,7 @@ Return nil if it has no specified face."
(get-char-property (point) 'face)
'default))
(face (cond ((symbolp faceprop) faceprop)
+ ((stringp faceprop) (intern-soft faceprop))
;; List of faces (don't treat an attribute spec).
;; Just use the first face.
((and (consp faceprop) (not (keywordp (car faceprop)))
=== modified file 'lisp/hi-lock.el'
--- lisp/hi-lock.el 2012-12-04 21:13:47 +0000
+++ lisp/hi-lock.el 2012-12-06 14:02:42 +0000
@@ -213,13 +213,27 @@ When non-nil, each hi-lock command will
(define-obsolete-variable-alias 'hi-lock-face-history
'hi-lock-face-defaults "23.1")
+
(defvar hi-lock-face-defaults
'("hi-yellow" "hi-pink" "hi-green" "hi-blue" "hi-black-b"
"hi-blue-b" "hi-red-b" "hi-green-b" "hi-black-hb")
"Default faces for hi-lock interactive functions.")
+(defcustom hi-lock-faces
+ (or
+ (when (boundp 'hi-lock-face-defaults)
+ (mapcar
+ (lambda (face-name) (intern-soft face-name))
+ hi-lock-face-defaults))
+ '(hi-yellow hi-pink hi-green hi-blue hi-black-b
+ hi-blue-b hi-red-b hi-green-b hi-black-hb))
+ "Default faces for hi-lock interactive functions."
+ :type '(repeat face)
+ :group 'hi-lock
+ :version "24.4")
+
(defvar-local hi-lock--auto-select-face-defaults
- (let ((l (copy-sequence hi-lock-face-defaults)))
+ (let ((l (copy-sequence hi-lock-faces)))
(setcdr (last l) l))
"Circular list of faces used for interactive highlighting.
When `hi-lock-auto-select-face' is non-nil, use the face at the
@@ -410,8 +424,12 @@ 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.
+Interactively, prompt for REGEXP, using a buffer-local history
+list for REGEXP . When `hi-lock-auto-select-face' is non-nil,
+prompt for FACE using a global history list. Otherwise, use the
+next of `hi-lock-faces'. When invoked with
+\\[universal-argument] prefix, invert the meaning of
+`hi-lock-auto-select-face'.
If Font Lock mode is enabled in the buffer, it is used to
highlight REGEXP. If Font Lock mode is disabled, overlays are
@@ -421,8 +439,9 @@ updated as you type."
(list
(hi-lock-regexp-okay
(read-regexp "Regexp to highlight line" (car regexp-history)))
- (hi-lock-read-face-name)))
- (or (facep face) (setq face 'hi-yellow))
+ (let ((toggle-auto-select current-prefix-arg))
+ (hi-lock-read-face-name toggle-auto-select))))
+ (unless (facep face) (setq face (hi-lock-read-face-name)))
(unless hi-lock-mode (hi-lock-mode 1))
(hi-lock-set-pattern
;; The \\(?:...\\) grouping construct ensures that a leading ^, +, * or ?
@@ -435,8 +454,12 @@ 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, using a buffer-local history
+list for REGEXP . When `hi-lock-auto-select-face' is non-nil,
+prompt for FACE using a global history list. Otherwise, use the
+next of `hi-lock-faces'. When invoked with
+\\[universal-argument] prefix, invert the meaning of
+`hi-lock-auto-select-face'.
If Font Lock mode is enabled in the buffer, it is used to
highlight REGEXP. If Font Lock mode is disabled, overlays are
@@ -446,8 +469,9 @@ updated as you type."
(list
(hi-lock-regexp-okay
(read-regexp "Regexp to highlight" (car regexp-history)))
- (hi-lock-read-face-name)))
- (or (facep face) (setq face 'hi-yellow))
+ (let ((toggle-auto-select current-prefix-arg))
+ (hi-lock-read-face-name toggle-auto-select))))
+ (unless (facep face) (setq face (hi-lock-read-face-name)))
(unless hi-lock-mode (hi-lock-mode 1))
(hi-lock-set-pattern regexp face))
@@ -457,7 +481,12 @@ updated as you type."
(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.
+arbitrary whitespace and makes initial lower-case letters
+case-insensitive. When `hi-lock-auto-select-face' is non-nil,
+prompt for FACE using a global history list. Otherwise, use the
+next of `hi-lock-faces'. When invoked with
+\\[universal-argument] prefix, invert the meaning of
+`hi-lock-auto-select-face'.
If Font Lock mode is enabled in the buffer, it is used to
highlight REGEXP. If Font Lock mode is disabled, overlays are
@@ -467,9 +496,10 @@ updated as you type."
(list
(hi-lock-regexp-okay
(hi-lock-process-phrase
- (read-regexp "Phrase to highlight" (car regexp-history))))
- (hi-lock-read-face-name)))
- (or (facep face) (setq face 'hi-yellow))
+ (read-regexp "Phrase to highlight" (car regexp-history))))))
+ (let ((toggle-auto-select current-prefix-arg))
+ (hi-lock-read-face-name toggle-auto-select))
+ (unless (facep face) (setq face (hi-lock-read-face-name)))
(unless hi-lock-mode (hi-lock-mode 1))
(hi-lock-set-pattern regexp face))
@@ -482,26 +512,29 @@ updated as you type."
(let ((desired-serial (get-char-property
(point) 'hi-lock-overlay-regexp)))
(when desired-serial
- (catch 'regexp
(maphash
(lambda (regexp serial)
(when (= serial desired-serial)
(push regexp regexps)))
- hi-lock-string-serialize-hash))))
- ;; With font-locking on, check if the cursor is on an highlighted text.
- ;; Checking for hi-lock face is a good heuristic.
- (and (string-match "\\`hi-lock-" (face-name (face-at-point)))
+ hi-lock-string-serialize-hash)))
+ ;; With font-locking on, check if cursor is on an highlighted
+ ;; text.
+ (when (member (list 'quote (face-at-point))
+ (mapcar (lambda (pattern)
+ (cadr (cadr pattern)))
+ hi-lock-interactive-patterns))
(let* ((hi-text
(buffer-substring-no-properties
- (previous-single-property-change (point) 'face)
- (next-single-property-change (point) 'face))))
+ (previous-single-char-property-change (point) 'face)
+ (next-single-char-property-change (point) 'face))))
;; Compute hi-lock patterns that match the
;; highlighted text at point. Use this later in
;; during completing-read.
(dolist (hi-lock-pattern hi-lock-interactive-patterns)
(let ((regexp (car hi-lock-pattern)))
- (if (string-match regexp hi-text)
- (push regexp regexps))))))))
+ (when (string-match regexp hi-text)
+ (push regexp regexps))))))
+ regexps))
;;;###autoload
(defalias 'unhighlight-regexp 'hi-lock-unface-buffer)
@@ -529,9 +562,7 @@ then remove all hi-lock highlighting."
(list (car pattern)
(format
"%s (%s)" (car pattern)
- (symbol-name
- (car
- (cdr (car (cdr (car (cdr pattern))))))))
+ (cadr (cadr (cadr pattern))))
(cons nil nil)
(car pattern)))
hi-lock-interactive-patterns))))
@@ -557,6 +588,7 @@ then remove all hi-lock highlighting."
(dolist (keyword (if (eq regexp t) hi-lock-interactive-patterns
(list (assoc regexp hi-lock-interactive-patterns))))
(when keyword
+ (setq regexp (car keyword))
(font-lock-remove-keywords nil (list keyword))
(setq hi-lock-interactive-patterns
(delq keyword hi-lock-interactive-patterns))
@@ -615,31 +647,36 @@ not suitable."
(error "Regexp cannot match an empty string")
regexp))
-(defun hi-lock-read-face-name ()
+(defun hi-lock-read-face-name (&optional toggle-auto-select)
"Return face name for interactive highlighting.
When `hi-lock-auto-select-face' is non-nil, just return the next face.
-Otherwise, read face name from minibuffer with completion and history."
- (if hi-lock-auto-select-face
+Otherwise, read face name from minibuffer with completion and history.
+
+When TOGGLE-AUTO-SELECT is non-nil, temporarily invert the value
+of `hi-lock-auto-select-face'."
+ (let ((auto-select
+ (if toggle-auto-select (not hi-lock-auto-select-face)
+ hi-lock-auto-select-face)))
+ (if auto-select
;; Return current head and rotate the face list.
(pop hi-lock--auto-select-face-defaults)
- (intern (completing-read
+ (intern
+ (let* ((face-names (mapcar #'face-name hi-lock-faces))
+ (prefix (try-completion "" face-names)))
+ (completing-read
"Highlight using face: "
obarray 'facep t
- (cons (car hi-lock-face-defaults)
- (let ((prefix
- (try-completion
- (substring (car hi-lock-face-defaults) 0 1)
- hi-lock-face-defaults)))
+ (cons (car face-names)
(if (and (stringp prefix)
- (not (equal prefix (car hi-lock-face-defaults))))
- (length prefix) 0)))
- 'face-name-history
- (cdr hi-lock-face-defaults)))))
+ (not (equal prefix (car face-names))))
+ (length prefix) 0))
+ 'face-name-history (cdr face-names)))))))
(defun hi-lock-set-pattern (regexp face)
"Highlight REGEXP with face FACE."
(let ((pattern (list regexp (list 0 (list 'quote face) t))))
- (unless (member pattern hi-lock-interactive-patterns)
+ ;; Check if REGEXP is already highlighted.
+ (unless (assoc regexp hi-lock-interactive-patterns)
(push pattern hi-lock-interactive-patterns)
(if font-lock-mode
(progn
[Message part 3 (text/plain, inline)]
> There are three issues that I see with your commmit:
>
> Issue-1: face-at-point broken?
> ===============================
>
> M-x toggle-debug-on-error RET
> M-x find-function RET face-at-point RET
> C-x w h
> C-x w r
>
> Debugger entered--Lisp error: (error "Not a face: nil")
> signal(error ("Not a face: nil"))
> error("Not a face: %s" nil)
> check-face(nil)
> face-name(nil)
> hi-lock--regexps-at-point()
> byte-code("\203\305C\207\306 \203. <\203.\n\203.\307\310\215\207 \204!\311\312!\210\313 \314\f\204-\315\2022\316\317\f@\" \320\305\320\211\f&)C\207" [current-prefix-arg last-nonmenu-event use-dialog-box hi-lock-interactive-patterns defaults t display-popup-menus-p snafu (byte-code "\301\302\303\304\305\306\"BB\"\206.\307\310\311\"\207" [hi-lock-interactive-patterns x-popup-menu t keymap "Select Pattern to Unhighlight" mapcar #[(pattern) "@\301\302@\303A <at> A@A@!#\304\211B@F\207" [pattern format "%s (%s)" symbol-name nil] 6] throw snafu ("")] 7) error "No highlighting to remove" hi-lock--regexps-at-point completing-read "Regexp to unhighlight: " format "Regexp to unhighlight (default %s): " nil] 8)
> call-interactively(unhighlight-regexp nil nil)
>
> The reason is faceprop happens to be a string
>
> (get-char-property (point) 'face)
> : "hi-yellow"
>
> Issue-2: Various issues with unhighlighting
> ============================================
>
> Once you fix Issue-1 you will run in to other issues with
> un-highlighting. Try highlighting and UN-highlighting in following 3
> ways
>
> 1. Buffer with font-lock-mode ON
> 2. Buffer with font-lock-mode OFF
> 3. Unhighlight from the menu
>
> Caveat: Extra testing needed if /type/ of face names are changed
> =================================================================
>
> hi-lock-face-defautls is currently a list of face names (stringp). If
> it is made a defcustom, it will be cast to a list of symbols (symbolp).
> In some places, face names are expected and in some other places face as
> a symbol is used. So you need to re-run the tests if move from
> string->symbols.
>
> Suggestion: In default faces, don't mix bold and foreground/background
> =======================================================================
>
> I am OK with defcustom of faces. Something like
>
> (defcustom hi-lock-face-defaults
> '(hi-yellow hi-pink hi-green hi-blue hi-black-b
> hi-blue-b hi-red-b hi-green-b hi-black-hb)
> "Default faces for hi-lock interactive functions."
> :type '(repeat face)
> :group 'hi-lock-faces)
>
> Bonus points if the default settings of the faces that go in there is
> revised as part of this bug. I want to highlight variables in a buffer.
> So consistent policy of highlighting - a changed background of normal
> face - will require no additional work.
>
> Here is how my own faces look like. Note that the first 4 come from
> "blue" space and the later 4 or so come from "pink" space, all chosen
> using agave.
>
> ps: I will let you install a change for the above issues.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.