=== 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 + + * 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 * 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