From c868b91923f344c5e0e3be990da49643068500c1 Mon Sep 17 00:00:00 2001 From: Jambunathan K Date: Mon, 10 Dec 2012 13:33:59 -0500 Subject: [PATCH] * 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 --- lisp/ChangeLog | 16 ++++++++++-- lisp/hi-lock.el | 81 ++++++++++++++++++++++++++++++++------------------------- 2 files changed, 60 insertions(+), 37 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f496863d76d..c75a6a9719f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2012-12-10 Jambunathan K + + * 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 * subr.el (w32notify-handle-event): New function. @@ -13,8 +26,7 @@ 2012-12-10 Eli Zaretskii - * textmodes/texinfo.el (texinfo-enable-quote-envs): Add - "smallexample". + * textmodes/texinfo.el (texinfo-enable-quote-envs): Add "smallexample". 2012-12-10 Le Wang diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index de875c72593..a6ad4dd26e0 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -462,6 +462,9 @@ updated as you type." (unless hi-lock-mode (hi-lock-mode 1)) (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)) (defun hi-lock--regexps-at-point () @@ -470,23 +473,25 @@ updated as you type." ;; choice of regexp. (let ((regexp (get-char-property (point) 'hi-lock-overlay-regexp))) (when regexp (push regexp regexps))) - ;; With font-locking on, check if the cursor is on an highlighted text. - ;; Checking for hi-lock face is a good heuristic. FIXME: use "hi-lock-". - (and (string-match "\\`hi-" (face-name (face-at-point))) - (let* ((hi-text - (buffer-substring-no-properties - (previous-single-property-change (point) 'face) - (next-single-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)))))) + ;; With font-locking on, check if the cursor is on a highlighted text. + (and (memq (face-at-point) + (mapcar #'hi-lock-keyword->face hi-lock-interactive-patterns)) + (let* ((hi-text + (buffer-substring-no-properties + (previous-single-property-change (point) 'face) + (next-single-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)))))) 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 (defalias 'unhighlight-regexp 'hi-lock-unface-buffer) @@ -514,7 +519,7 @@ then remove all hi-lock highlighting." (list (car pattern) (format "%s (%s)" (car pattern) - (cadr (cadr (cadr pattern)))) + (hi-lock-keyword->face pattern)) (cons nil nil) (car pattern))) hi-lock-interactive-patterns)))) @@ -541,16 +546,14 @@ 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 - (let ((face (cadr (cadr (cadr keyword))))) + (let ((face (hi-lock-keyword->face keyword))) ;; Make `face' the next one to use by default. - (setq hi-lock--last-face - (cadr (member (symbol-name face) - (reverse hi-lock-face-defaults))))) + (add-to-list 'hi-lock--unused-faces (face-name face))) (font-lock-remove-keywords nil (list keyword)) (setq hi-lock-interactive-patterns (delq keyword hi-lock-interactive-patterns)) (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))))) ;;;###autoload @@ -608,27 +611,35 @@ not suitable." "Return face 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." - (let ((default (or (cadr (member hi-lock--last-face hi-lock-face-defaults)) - (car hi-lock-face-defaults)))) - (setq hi-lock--last-face + (unless hi-lock-interactive-patterns + (setq hi-lock--unused-faces hi-lock-face-defaults)) + (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)) - default - (completing-read - (format "Highlight using face (default %s): " default) - obarray 'facep t nil 'face-name-history - (append (member default hi-lock-face-defaults) - hi-lock-face-defaults)))) - (unless (member hi-lock--last-face hi-lock-face-defaults) - (setq hi-lock-face-defaults - (append hi-lock-face-defaults (list hi-lock--last-face)))) - (intern hi-lock--last-face))) + (setq face (or (pop hi-lock--unused-faces) (car defaults))) + (setq face (completing-read + (format "Highlight using face (default %s): " + (car defaults)) + obarray 'facep t nil 'face-name-history defaults)) + ;; Update list of un-used faces. + (setq hi-lock--unused-faces (remove face hi-lock--unused-faces)) + ;; Grow the list of defaults. + (add-to-list 'hi-lock-face-defaults face t)) + (intern face))) (defun hi-lock-set-pattern (regexp face) "Highlight REGEXP with face FACE." ;; Hashcons the regexp, so it can be passed to remove-overlays later. (setq regexp (hi-lock--hashcons regexp)) (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) (if font-lock-mode (progn -- 2.11.4.GIT