=== modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-10-12 01:01:50 +0000 +++ lisp/ChangeLog 2012-10-12 19:15:47 +0000 @@ -1,3 +1,25 @@ +2012-10-12 Jambunathan K + + * replace.el (read-regexp): Tighten the regexp that matches tag. + When tag is retrieved with `find-tag-default', use regexp that + matches symbol at point. Also update docstring. + + * hi-lock.el (hi-yellow, hi-pink, hi-green, hi-blue, hi-black-b) + (hi-blue-b, hi-green-b, hi-red-b, hi-black-hb): Mark these faces + as obsolete. + (hi-lock-1, hi-lock-2, hi-lock-3, hi-lock-4, hi-lock-5, hi-lock-6) + (hi-lock-7, hi-lock-8, hi-lock-9): New faces. + (hi-lock-face-defaults): Use new faces. + (hi-lock-auto-select-face): New user variable. + (hi-lock-auto-select-face-defaults): New buffer local variable. + (hi-lock-read-face-name): Honor `hi-lock-auto-select-face'. + (hi-lock-line-face-buffer, hi-lock-face-buffer) + (hi-lock-face-phrase-buffer): Don't provide a default to + `read-regexp'. Effectively, the default regexp offered by + `read-regexp' matches tag at point. Use new faces. + (hi-lock-unface-buffer): Add support for unhighlighting (a) text + at point (b) all highlighted text in buffer. (Bug#11095) + 2012-10-12 Glenn Morris * mail/rmailsum.el (rmail-header-summary): === modified file 'lisp/hi-lock.el' --- lisp/hi-lock.el 2012-10-07 00:27:31 +0000 +++ lisp/hi-lock.el 2012-10-12 19:15:47 +0000 @@ -135,12 +135,20 @@ ;; It can have a function value. (put 'hi-lock-file-patterns-policy 'risky-local-variable t) +(defcustom hi-lock-auto-select-face nil + "Non-nil if highlighting commands should not prompt for face names. +When non-nil, each hi-lock command will cycle through faces in +`hi-lock-face-defaults'." + :type 'boolean + :group 'hi-lock + :version "24.3") + (defgroup hi-lock-faces nil "Faces for hi-lock." :group 'hi-lock :group 'faces) -(defface hi-yellow +(defface hi-lock-1 '((((min-colors 88) (background dark)) (:background "yellow1" :foreground "black")) (((background dark)) (:background "yellow" :foreground "black")) @@ -149,13 +157,13 @@ "Default face for hi-lock mode." :group 'hi-lock-faces) -(defface hi-pink +(defface hi-lock-2 '((((background dark)) (:background "pink" :foreground "black")) (t (:background "pink"))) "Face for hi-lock mode." :group 'hi-lock-faces) -(defface hi-green +(defface hi-lock-3 '((((min-colors 88) (background dark)) (:background "green1" :foreground "black")) (((background dark)) (:background "green" :foreground "black")) @@ -164,40 +172,50 @@ "Face for hi-lock mode." :group 'hi-lock-faces) -(defface hi-blue +(defface hi-lock-4 '((((background dark)) (:background "light blue" :foreground "black")) (t (:background "light blue"))) "Face for hi-lock mode." :group 'hi-lock-faces) -(defface hi-black-b +(defface hi-lock-5 '((t (:weight bold))) "Face for hi-lock mode." :group 'hi-lock-faces) -(defface hi-blue-b +(defface hi-lock-6 '((((min-colors 88)) (:weight bold :foreground "blue1")) (t (:weight bold :foreground "blue"))) "Face for hi-lock mode." :group 'hi-lock-faces) -(defface hi-green-b +(defface hi-lock-7 '((((min-colors 88)) (:weight bold :foreground "green1")) (t (:weight bold :foreground "green"))) "Face for hi-lock mode." :group 'hi-lock-faces) -(defface hi-red-b +(defface hi-lock-8 '((((min-colors 88)) (:weight bold :foreground "red1")) (t (:weight bold :foreground "red"))) "Face for hi-lock mode." :group 'hi-lock-faces) -(defface hi-black-hb +(defface hi-lock-9 '((t (:weight bold :height 1.67 :inherit variable-pitch))) "Face for hi-lock mode." :group 'hi-lock-faces) +(define-obsolete-face-alias 'hi-yellow 'hi-lock-1 "24.3") +(define-obsolete-face-alias 'hi-pink 'hi-lock-2 "24.3") +(define-obsolete-face-alias 'hi-green 'hi-lock-3 "24.3") +(define-obsolete-face-alias 'hi-blue 'hi-lock-4 "24.3") +(define-obsolete-face-alias 'hi-black-b 'hi-lock-5 "24.3") +(define-obsolete-face-alias 'hi-blue-b 'hi-lock-6 "24.3") +(define-obsolete-face-alias 'hi-green-b 'hi-lock-7 "24.3") +(define-obsolete-face-alias 'hi-red-b 'hi-lock-8 "24.3") +(define-obsolete-face-alias 'hi-black-hb 'hi-lock-9 "24.3") + (defvar hi-lock-file-patterns nil "Patterns found in file for hi-lock. Should not be changed.") @@ -207,12 +225,19 @@ (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") + '("hi-lock-1" "hi-lock-2" "hi-lock-3" "hi-lock-4" "hi-lock-5" + "hi-lock-6" "hi-lock-7" "hi-lock-8" "hi-lock-9") "Default faces for hi-lock interactive functions.") -;;(dolist (f hi-lock-face-defaults) -;; (unless (facep f) (error "%s not a face" f))) +(defvar hi-lock-auto-select-face-defaults + (let ((l (copy-sequence hi-lock-face-defaults))) + (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 +head of this list for next interactive highlighting. See also +`hi-lock-read-face-name'.") + +(make-variable-buffer-local 'hi-lock-auto-select-face-defaults) (define-obsolete-variable-alias 'hi-lock-regexp-history 'regexp-history @@ -408,9 +433,9 @@ (interactive (list (hi-lock-regexp-okay - (read-regexp "Regexp to highlight line" (car regexp-history))) + (read-regexp "Regexp to highlight line")) (hi-lock-read-face-name))) - (or (facep face) (setq face 'hi-yellow)) + (or (facep face) (setq face 'hi-lock-1)) (unless hi-lock-mode (hi-lock-mode 1)) (hi-lock-set-pattern ;; The \\(?:...\\) grouping construct ensures that a leading ^, +, * or ? @@ -433,9 +458,9 @@ (interactive (list (hi-lock-regexp-okay - (read-regexp "Regexp to highlight" (car regexp-history))) + (read-regexp "Regexp to highlight")) (hi-lock-read-face-name))) - (or (facep face) (setq face 'hi-yellow)) + (or (facep face) (setq face 'hi-lock-1)) (unless hi-lock-mode (hi-lock-mode 1)) (hi-lock-set-pattern regexp face)) @@ -455,9 +480,9 @@ (list (hi-lock-regexp-okay (hi-lock-process-phrase - (read-regexp "Phrase to highlight" (car regexp-history)))) + (read-regexp "Phrase to highlight"))) (hi-lock-read-face-name))) - (or (facep face) (setq face 'hi-yellow)) + (or (facep face) (setq face 'hi-lock-1)) (unless hi-lock-mode (hi-lock-mode 1)) (hi-lock-set-pattern regexp face)) @@ -466,10 +491,18 @@ ;;;###autoload (defalias 'unhighlight-regexp 'hi-lock-unface-buffer) ;;;###autoload -(defun hi-lock-unface-buffer (regexp) +(defun hi-lock-unface-buffer (regexp &optional prefix-arg) "Remove highlighting of each match to REGEXP set by hi-lock. -Interactively, prompt for REGEXP, accepting only regexps -previously inserted by hi-lock interactive functions." +Interactively, when PREFIX-ARG is non-nil, unhighlight all +highlighted text in current buffer. When PREFIX-ARG is nil, +prompt for REGEXP. If the cursor is on a previously highlighted +text and if the associated regexp can be inferred via simple +heuristics, offer that regexp as default. Otherwise, prompt for +REGEXP with completion and limit the choices to only those +regexps used previously with hi-lock commands. + +If this command is invoked via menu, pop-up a list of currently +highlighted patterns." (interactive (if (and (display-popup-menus-p) (listp last-nonmenu-event) @@ -497,23 +530,63 @@ ;; To prevent that, we return an empty string, which will ;; effectively disable the rest of the function. (throw 'snafu '("")))) - (let ((history-list (mapcar (lambda (p) (car p)) - hi-lock-interactive-patterns))) - (unless hi-lock-interactive-patterns - (error "No highlighting to remove")) + ;; Un-highlighting triggered via keyboard action. + (unless hi-lock-interactive-patterns + (error "No highlighting to remove")) + ;; Infer the regexp to un-highlight based on cursor position. + (let* (candidate-hi-lock-patterns + (default-regexp + (or + ;; When using overlays, there is no ambiguity on the best + ;; choice of regexp. + (let ((desired-serial (get-char-property + (point) 'hi-lock-overlay-regexp))) + (when desired-serial + (catch 'regexp + (maphash + (lambda (regexp serial) + (when (= serial desired-serial) + (throw 'regexp regexp))) + 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))) + (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. + (setq candidate-hi-lock-patterns + (delq nil + (mapcar + (lambda (hi-lock-pattern) + (let ((regexp (car hi-lock-pattern))) + (and (string-match regexp hi-text) + hi-lock-pattern))) + hi-lock-interactive-patterns))) + ;; Use regexp from the first matching pattern as + ;; a reasonable default. + (caar candidate-hi-lock-patterns)))))) (list - (completing-read "Regexp to unhighlight: " - hi-lock-interactive-patterns nil t - (car (car hi-lock-interactive-patterns)) - (cons 'history-list 1)))))) - (let ((keyword (assoc regexp hi-lock-interactive-patterns))) - (when keyword - (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-string-serialize regexp)) - (when font-lock-fontified (font-lock-fontify-buffer))))) + (and (not current-prefix-arg) + (completing-read "Regexp to unhighlight: " + (or candidate-hi-lock-patterns + hi-lock-interactive-patterns) + nil t default-regexp)) + current-prefix-arg)))) + (dolist (re (if (not prefix-arg) (list regexp) + (mapcar #'car hi-lock-interactive-patterns))) + (let ((keyword (assoc re hi-lock-interactive-patterns))) + (when keyword + (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-string-serialize re)) + (when font-lock-fontified (font-lock-fontify-buffer)))))) ;;;###autoload (defun hi-lock-write-interactive-patterns () @@ -567,20 +640,28 @@ regexp)) (defun hi-lock-read-face-name () - "Read face name from minibuffer with completion and history." - (intern (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))) - (if (and (stringp prefix) - (not (equal prefix (car hi-lock-face-defaults)))) - (length prefix) 0))) - 'face-name-history - (cdr hi-lock-face-defaults)))) + "Return face name for interactive highlighting. +When `hi-lock-auto-select-face' is non-nil, return head of +`hi-lock-auto-select-face-defaults'. Otherwise, read face name +from minibuffer with completion and history." + (if hi-lock-auto-select-face + ;; Return current head and rotate the face list. + (prog1 (intern (car hi-lock-auto-select-face-defaults)) + (setq hi-lock-auto-select-face-defaults + (cdr hi-lock-auto-select-face-defaults))) + (intern (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))) + (if (and (stringp prefix) + (not (equal prefix (car hi-lock-face-defaults)))) + (length prefix) 0))) + 'face-name-history + (cdr hi-lock-face-defaults))))) (defun hi-lock-set-pattern (regexp face) "Highlight REGEXP with face FACE." === modified file 'lisp/replace.el' --- lisp/replace.el 2012-10-04 19:28:11 +0000 +++ lisp/replace.el 2012-10-12 19:15:47 +0000 @@ -585,27 +585,32 @@ When PROMPT doesn't end with a colon and space, it adds a final \": \". If DEFAULTS is non-nil, it displays the first default in the prompt. -Non-nil optional arg DEFAULTS is a string or a list of strings that -are prepended to a list of standard default values, which include the -string at point, the last isearch regexp, the last isearch string, and -the last replacement regexp. +Optional arg DEFAULTS is a string or a list of strings that are +prepended to a list of standard default values, which include the +tag at point, the last isearch regexp, the last isearch string, +and the last replacement regexp. Non-nil HISTORY is a symbol to use for the history list. If HISTORY is nil, `regexp-history' is used." - (let* ((default (if (consp defaults) (car defaults) defaults)) - (defaults + (let* ((defaults (append (if (listp defaults) defaults (list defaults)) - (list (regexp-quote - (or (funcall (or find-tag-default-function - (get major-mode 'find-tag-default-function) - 'find-tag-default)) - "")) - (car regexp-search-ring) - (regexp-quote (or (car search-ring) "")) - (car (symbol-value - query-replace-from-history-variable))))) + (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)))) + (car regexp-search-ring) + (regexp-quote (or (car search-ring) "")) + (car (symbol-value + query-replace-from-history-variable))))) (defaults (delete-dups (delq nil (delete "" defaults)))) + (default (car defaults)) ;; Do not automatically add default to the history for empty input. (history-add-new-input nil) (input (read-from-minibuffer