mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-29 19:48:19 +00:00
* lisp/hi-lock.el (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-unface-buffer): Prompt user with useful defaults. With prefix arg, unhighlight all hi-lock patterns in buffer. Fixes: debbugs:11095
This commit is contained in:
parent
47a6e6df2b
commit
b85aec936c
@ -1,3 +1,11 @@
|
|||||||
|
2012-12-04 Jambunathan K <kjambunathan@gmail.com>
|
||||||
|
|
||||||
|
* hi-lock.el (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-unface-buffer): Prompt user with useful defaults.
|
||||||
|
With prefix arg, unhighlight all hi-lock patterns in buffer.
|
||||||
|
|
||||||
2012-12-04 Stefan Monnier <monnier@iro.umontreal.ca>
|
2012-12-04 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||||
|
|
||||||
* obsolete/terminal.el, obsolete/longlines.el: Add obsolecence info.
|
* obsolete/terminal.el, obsolete/longlines.el: Add obsolecence info.
|
||||||
|
@ -135,6 +135,13 @@ patterns."
|
|||||||
;; It can have a function value.
|
;; It can have a function value.
|
||||||
(put 'hi-lock-file-patterns-policy 'risky-local-variable t)
|
(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
|
||||||
|
:version "24.4")
|
||||||
|
|
||||||
(defgroup hi-lock-faces nil
|
(defgroup hi-lock-faces nil
|
||||||
"Faces for hi-lock."
|
"Faces for hi-lock."
|
||||||
:group 'hi-lock
|
:group 'hi-lock
|
||||||
@ -211,8 +218,13 @@ patterns."
|
|||||||
"hi-blue-b" "hi-red-b" "hi-green-b" "hi-black-hb")
|
"hi-blue-b" "hi-red-b" "hi-green-b" "hi-black-hb")
|
||||||
"Default faces for hi-lock interactive functions.")
|
"Default faces for hi-lock interactive functions.")
|
||||||
|
|
||||||
;;(dolist (f hi-lock-face-defaults)
|
(defvar-local hi-lock--auto-select-face-defaults
|
||||||
;; (unless (facep f) (error "%s not a face" f)))
|
(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'.")
|
||||||
|
|
||||||
(define-obsolete-variable-alias 'hi-lock-regexp-history
|
(define-obsolete-variable-alias 'hi-lock-regexp-history
|
||||||
'regexp-history
|
'regexp-history
|
||||||
@ -463,15 +475,47 @@ updated as you type."
|
|||||||
|
|
||||||
(declare-function x-popup-menu "menu.c" (position menu))
|
(declare-function x-popup-menu "menu.c" (position menu))
|
||||||
|
|
||||||
|
(defun hi-lock--regexps-at-point ()
|
||||||
|
(let ((regexps '()))
|
||||||
|
;; 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)
|
||||||
|
(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)))
|
||||||
|
(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))))))))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defalias 'unhighlight-regexp 'hi-lock-unface-buffer)
|
(defalias 'unhighlight-regexp 'hi-lock-unface-buffer)
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun hi-lock-unface-buffer (regexp)
|
(defun hi-lock-unface-buffer (regexp)
|
||||||
"Remove highlighting of each match to REGEXP set by hi-lock.
|
"Remove highlighting of each match to REGEXP set by hi-lock.
|
||||||
Interactively, prompt for REGEXP, accepting only regexps
|
Interactively, prompt for REGEXP, accepting only regexps
|
||||||
previously inserted by hi-lock interactive functions."
|
previously inserted by hi-lock interactive functions.
|
||||||
|
If REGEXP is t (or if \\[universal-argument] was specified interactively),
|
||||||
|
then remove all hi-lock highlighting."
|
||||||
(interactive
|
(interactive
|
||||||
(if (and (display-popup-menus-p)
|
(cond
|
||||||
|
(current-prefix-arg (list t))
|
||||||
|
((and (display-popup-menus-p)
|
||||||
(listp last-nonmenu-event)
|
(listp last-nonmenu-event)
|
||||||
use-dialog-box)
|
use-dialog-box)
|
||||||
(catch 'snafu
|
(catch 'snafu
|
||||||
@ -496,17 +540,22 @@ previously inserted by hi-lock interactive functions."
|
|||||||
;; interactive signals a wrong number of arguments error.
|
;; interactive signals a wrong number of arguments error.
|
||||||
;; To prevent that, we return an empty string, which will
|
;; To prevent that, we return an empty string, which will
|
||||||
;; effectively disable the rest of the function.
|
;; effectively disable the rest of the function.
|
||||||
(throw 'snafu '(""))))
|
(throw 'snafu '("")))))
|
||||||
(let ((history-list (mapcar (lambda (p) (car p))
|
(t
|
||||||
hi-lock-interactive-patterns)))
|
;; Un-highlighting triggered via keyboard action.
|
||||||
(unless hi-lock-interactive-patterns
|
(unless hi-lock-interactive-patterns
|
||||||
(error "No highlighting to remove"))
|
(error "No highlighting to remove"))
|
||||||
|
;; Infer the regexp to un-highlight based on cursor position.
|
||||||
|
(let* ((defaults (hi-lock--regexps-at-point)))
|
||||||
(list
|
(list
|
||||||
(completing-read "Regexp to unhighlight: "
|
(completing-read (if (null defaults)
|
||||||
hi-lock-interactive-patterns nil t
|
"Regexp to unhighlight: "
|
||||||
(car (car hi-lock-interactive-patterns))
|
(format "Regexp to unhighlight (default %s): "
|
||||||
(cons 'history-list 1))))))
|
(car defaults)))
|
||||||
(let ((keyword (assoc regexp hi-lock-interactive-patterns)))
|
hi-lock-interactive-patterns
|
||||||
|
nil t nil nil defaults))))))
|
||||||
|
(dolist (keyword (if (eq regexp t) hi-lock-interactive-patterns
|
||||||
|
(list (assoc regexp hi-lock-interactive-patterns))))
|
||||||
(when keyword
|
(when keyword
|
||||||
(font-lock-remove-keywords nil (list keyword))
|
(font-lock-remove-keywords nil (list keyword))
|
||||||
(setq hi-lock-interactive-patterns
|
(setq hi-lock-interactive-patterns
|
||||||
@ -567,7 +616,12 @@ not suitable."
|
|||||||
regexp))
|
regexp))
|
||||||
|
|
||||||
(defun hi-lock-read-face-name ()
|
(defun hi-lock-read-face-name ()
|
||||||
"Read face name from minibuffer with completion and history."
|
"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
|
||||||
|
;; Return current head and rotate the face list.
|
||||||
|
(pop hi-lock--auto-select-face-defaults)
|
||||||
(intern (completing-read
|
(intern (completing-read
|
||||||
"Highlight using face: "
|
"Highlight using face: "
|
||||||
obarray 'facep t
|
obarray 'facep t
|
||||||
@ -580,7 +634,7 @@ not suitable."
|
|||||||
(not (equal prefix (car hi-lock-face-defaults))))
|
(not (equal prefix (car hi-lock-face-defaults))))
|
||||||
(length prefix) 0)))
|
(length prefix) 0)))
|
||||||
'face-name-history
|
'face-name-history
|
||||||
(cdr hi-lock-face-defaults))))
|
(cdr hi-lock-face-defaults)))))
|
||||||
|
|
||||||
(defun hi-lock-set-pattern (regexp face)
|
(defun hi-lock-set-pattern (regexp face)
|
||||||
"Highlight REGEXP with face FACE."
|
"Highlight REGEXP with face FACE."
|
||||||
@ -656,6 +710,8 @@ not suitable."
|
|||||||
(font-lock-add-keywords nil hi-lock-interactive-patterns t)))
|
(font-lock-add-keywords nil hi-lock-interactive-patterns t)))
|
||||||
|
|
||||||
(defvar hi-lock-string-serialize-hash
|
(defvar hi-lock-string-serialize-hash
|
||||||
|
;; FIXME: don't map strings to numbers but to unique strings via
|
||||||
|
;; hash-consing, with a weak hash-table.
|
||||||
(make-hash-table :test 'equal)
|
(make-hash-table :test 'equal)
|
||||||
"Hash table used to assign unique numbers to strings.")
|
"Hash table used to assign unique numbers to strings.")
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user