Commit c868b919 authored by Jambunathan K's avatar Jambunathan K Committed by Stefan Monnier
Browse files

* lisp/hi-lock.el: Refine the choice of default face.

(hi-lock-keyword->face): New function.  Use it wherever we used
cadadadr instead.
(hi-lock--regexps-at-point): Ignore faces that can't come from hi-lock.
(hi-lock--last-face): Remove var.
(hi-lock--unused-faces): New var to replace it.
(hi-lock-read-face-name): Use/maintain it.
(hi-lock-unface-buffer): Maintain it.  Fix error for the C-u case.
(hi-lock-set-pattern): Ignore new rule if it has the same regexp even
if it has another face.

Fixes: debbugs:11095
parent 743fa5cb
2012-12-10 Jambunathan K <kjambunathan@gmail.com>
* hi-lock.el: Refine the choice of default face.
(hi-lock-keyword->face): New function. Use it wherever we used
cadadadr instead.
(hi-lock--regexps-at-point): Ignore faces that can't come from hi-lock.
(hi-lock--last-face): Remove var.
(hi-lock--unused-faces): New var to replace it.
(hi-lock-read-face-name): Use/maintain it.
(hi-lock-unface-buffer): Maintain it. Fix error for the C-u case.
(hi-lock-set-pattern): Ignore new rule if it has the same regexp even
if it has another face.
2012-12-10 Eli Zaretskii <eliz@gnu.org> 2012-12-10 Eli Zaretskii <eliz@gnu.org>
   
* subr.el (w32notify-handle-event): New function. * subr.el (w32notify-handle-event): New function.
...@@ -13,8 +26,7 @@ ...@@ -13,8 +26,7 @@
   
2012-12-10 Eli Zaretskii <eliz@gnu.org> 2012-12-10 Eli Zaretskii <eliz@gnu.org>
   
* textmodes/texinfo.el (texinfo-enable-quote-envs): Add * textmodes/texinfo.el (texinfo-enable-quote-envs): Add "smallexample".
"smallexample".
   
2012-12-10 Le Wang <l26wang@gmail.com> 2012-12-10 Le Wang <l26wang@gmail.com>
   
......
...@@ -462,6 +462,9 @@ updated as you type." ...@@ -462,6 +462,9 @@ updated as you type."
(unless hi-lock-mode (hi-lock-mode 1)) (unless hi-lock-mode (hi-lock-mode 1))
(hi-lock-set-pattern regexp face)) (hi-lock-set-pattern regexp face))
(defun hi-lock-keyword->face (keyword)
(cadr (cadr (cadr keyword)))) ; Keyword looks like (REGEXP (0 'FACE) ...).
(declare-function x-popup-menu "menu.c" (position menu)) (declare-function x-popup-menu "menu.c" (position menu))
(defun hi-lock--regexps-at-point () (defun hi-lock--regexps-at-point ()
...@@ -470,23 +473,25 @@ updated as you type." ...@@ -470,23 +473,25 @@ updated as you type."
;; choice of regexp. ;; choice of regexp.
(let ((regexp (get-char-property (point) 'hi-lock-overlay-regexp))) (let ((regexp (get-char-property (point) 'hi-lock-overlay-regexp)))
(when regexp (push regexp regexps))) (when regexp (push regexp regexps)))
;; With font-locking on, check if the cursor is on an highlighted text. ;; With font-locking on, check if the cursor is on a highlighted text.
;; Checking for hi-lock face is a good heuristic. FIXME: use "hi-lock-". (and (memq (face-at-point)
(and (string-match "\\`hi-" (face-name (face-at-point))) (mapcar #'hi-lock-keyword->face hi-lock-interactive-patterns))
(let* ((hi-text (let* ((hi-text
(buffer-substring-no-properties (buffer-substring-no-properties
(previous-single-property-change (point) 'face) (previous-single-property-change (point) 'face)
(next-single-property-change (point) 'face)))) (next-single-property-change (point) 'face))))
;; Compute hi-lock patterns that match the ;; Compute hi-lock patterns that match the
;; highlighted text at point. Use this later in ;; highlighted text at point. Use this later in
;; during completing-read. ;; during completing-read.
(dolist (hi-lock-pattern hi-lock-interactive-patterns) (dolist (hi-lock-pattern hi-lock-interactive-patterns)
(let ((regexp (car hi-lock-pattern))) (let ((regexp (car hi-lock-pattern)))
(if (string-match regexp hi-text) (if (string-match regexp hi-text)
(push regexp regexps)))))) (push regexp regexps))))))
regexps)) regexps))
(defvar-local hi-lock--last-face nil) (defvar-local hi-lock--unused-faces nil
"List of faces that is not used and is available for highlighting new text.
Face names from this list come from `hi-lock-face-defaults'.")
;;;###autoload ;;;###autoload
(defalias 'unhighlight-regexp 'hi-lock-unface-buffer) (defalias 'unhighlight-regexp 'hi-lock-unface-buffer)
...@@ -514,7 +519,7 @@ then remove all hi-lock highlighting." ...@@ -514,7 +519,7 @@ then remove all hi-lock highlighting."
(list (car pattern) (list (car pattern)
(format (format
"%s (%s)" (car pattern) "%s (%s)" (car pattern)
(cadr (cadr (cadr pattern)))) (hi-lock-keyword->face pattern))
(cons nil nil) (cons nil nil)
(car pattern))) (car pattern)))
hi-lock-interactive-patterns)))) hi-lock-interactive-patterns))))
...@@ -541,16 +546,14 @@ then remove all hi-lock highlighting." ...@@ -541,16 +546,14 @@ then remove all hi-lock highlighting."
(dolist (keyword (if (eq regexp t) hi-lock-interactive-patterns (dolist (keyword (if (eq regexp t) hi-lock-interactive-patterns
(list (assoc regexp hi-lock-interactive-patterns)))) (list (assoc regexp hi-lock-interactive-patterns))))
(when keyword (when keyword
(let ((face (cadr (cadr (cadr keyword))))) (let ((face (hi-lock-keyword->face keyword)))
;; Make `face' the next one to use by default. ;; Make `face' the next one to use by default.
(setq hi-lock--last-face (add-to-list 'hi-lock--unused-faces (face-name face)))
(cadr (member (symbol-name face)
(reverse hi-lock-face-defaults)))))
(font-lock-remove-keywords nil (list keyword)) (font-lock-remove-keywords nil (list keyword))
(setq hi-lock-interactive-patterns (setq hi-lock-interactive-patterns
(delq keyword hi-lock-interactive-patterns)) (delq keyword hi-lock-interactive-patterns))
(remove-overlays (remove-overlays
nil nil 'hi-lock-overlay-regexp (hi-lock--hashcons regexp)) nil nil 'hi-lock-overlay-regexp (hi-lock--hashcons (car keyword)))
(when font-lock-fontified (font-lock-fontify-buffer))))) (when font-lock-fontified (font-lock-fontify-buffer)))))
;;;###autoload ;;;###autoload
...@@ -608,27 +611,35 @@ not suitable." ...@@ -608,27 +611,35 @@ not suitable."
"Return face for interactive highlighting. "Return face for interactive highlighting.
When `hi-lock-auto-select-face' is non-nil, just return the next face. When `hi-lock-auto-select-face' is non-nil, just return the next face.
Otherwise, read face name from minibuffer with completion and history." Otherwise, read face name from minibuffer with completion and history."
(let ((default (or (cadr (member hi-lock--last-face hi-lock-face-defaults)) (unless hi-lock-interactive-patterns
(car hi-lock-face-defaults)))) (setq hi-lock--unused-faces hi-lock-face-defaults))
(setq hi-lock--last-face (let* ((last-used-face
(when hi-lock-interactive-patterns
(face-name (hi-lock-keyword->face
(car hi-lock-interactive-patterns)))))
(defaults (append hi-lock--unused-faces
(cdr (member last-used-face hi-lock-face-defaults))
hi-lock-face-defaults))
face)
(if (and hi-lock-auto-select-face (not current-prefix-arg)) (if (and hi-lock-auto-select-face (not current-prefix-arg))
default (setq face (or (pop hi-lock--unused-faces) (car defaults)))
(completing-read (setq face (completing-read
(format "Highlight using face (default %s): " default) (format "Highlight using face (default %s): "
obarray 'facep t nil 'face-name-history (car defaults))
(append (member default hi-lock-face-defaults) obarray 'facep t nil 'face-name-history defaults))
hi-lock-face-defaults)))) ;; Update list of un-used faces.
(unless (member hi-lock--last-face hi-lock-face-defaults) (setq hi-lock--unused-faces (remove face hi-lock--unused-faces))
(setq hi-lock-face-defaults ;; Grow the list of defaults.
(append hi-lock-face-defaults (list hi-lock--last-face)))) (add-to-list 'hi-lock-face-defaults face t))
(intern hi-lock--last-face))) (intern face)))
(defun hi-lock-set-pattern (regexp face) (defun hi-lock-set-pattern (regexp face)
"Highlight REGEXP with face FACE." "Highlight REGEXP with face FACE."
;; Hashcons the regexp, so it can be passed to remove-overlays later. ;; Hashcons the regexp, so it can be passed to remove-overlays later.
(setq regexp (hi-lock--hashcons regexp)) (setq regexp (hi-lock--hashcons regexp))
(let ((pattern (list regexp (list 0 (list 'quote face) t)))) (let ((pattern (list regexp (list 0 (list 'quote face) t))))
(unless (member pattern hi-lock-interactive-patterns) ;; Refuse to highlight a text that is already highlighted.
(unless (assoc regexp hi-lock-interactive-patterns)
(push pattern hi-lock-interactive-patterns) (push pattern hi-lock-interactive-patterns)
(if font-lock-mode (if font-lock-mode
(progn (progn
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment