X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ecae6af979abcbb5b45c33ee05ceb297678ec9a0..7031be6d49cb78d4cc4a2604b899144824abfeca:/lisp/hi-lock.el?ds=sidebyside diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 7226433c80..a0b5844582 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -1,9 +1,8 @@ ;;; hi-lock.el --- minor mode for interactive automatic highlighting -;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 2000-2011 Free Software Foundation, Inc. -;; Author: David M. Koppelman, koppel@ece.lsu.edu +;; Author: David M. Koppelman ;; Keywords: faces, minor-mode, matching, display ;; This file is part of GNU Emacs. @@ -88,8 +87,7 @@ ;;; Code: -(eval-and-compile - (require 'font-lock)) +(require 'font-lock) (defgroup hi-lock nil "Interactively add and remove font-lock patterns for highlighting text." @@ -206,15 +204,20 @@ patterns." (defvar hi-lock-interactive-patterns nil "Patterns provided to hi-lock by user. Should not be changed.") -(defvar hi-lock-face-history - (list "hi-yellow" "hi-pink" "hi-green" "hi-blue" "hi-black-b" - "hi-blue-b" "hi-red-b" "hi-green-b" "hi-black-hb") - "History list of faces for hi-lock interactive functions.") +(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.") -;(dolist (f hi-lock-face-history) (unless (facep f) (error "%s not a face" f))) +;(dolist (f hi-lock-face-defaults) (unless (facep f) (error "%s not a face" f))) -(defvar hi-lock-regexp-history nil - "History of regexps used for interactive fontification.") +(define-obsolete-variable-alias 'hi-lock-face-history + 'hi-lock-face-defaults + "23.1") + +(define-obsolete-variable-alias 'hi-lock-regexp-history + 'regexp-history + "23.1") (defvar hi-lock-file-patterns-prefix "Hi-lock" "Search target for finding hi-lock patterns at top of file.") @@ -232,50 +235,50 @@ a library is being loaded.") (make-variable-buffer-local 'hi-lock-interactive-patterns) (put 'hi-lock-interactive-patterns 'permanent-local t) -(make-variable-buffer-local 'hi-lock-regexp-history) -(put 'hi-lock-regexp-history 'permanent-local t) (make-variable-buffer-local 'hi-lock-file-patterns) (put 'hi-lock-file-patterns 'permanent-local t) -(defvar hi-lock-menu (make-sparse-keymap "Hi Lock") +(defvar hi-lock-menu + (let ((map (make-sparse-keymap "Hi Lock"))) + (define-key-after map [highlight-regexp] + '(menu-item "Highlight Regexp..." highlight-regexp + :help "Highlight text matching PATTERN (a regexp).")) + + (define-key-after map [highlight-phrase] + '(menu-item "Highlight Phrase..." highlight-phrase + :help "Highlight text matching PATTERN (a regexp processed to match phrases).")) + + (define-key-after map [highlight-lines-matching-regexp] + '(menu-item "Highlight Lines..." highlight-lines-matching-regexp + :help "Highlight lines containing match of PATTERN (a regexp).")) + + (define-key-after map [unhighlight-regexp] + '(menu-item "Remove Highlighting..." unhighlight-regexp + :help "Remove previously entered highlighting pattern." + :enable hi-lock-interactive-patterns)) + + (define-key-after map [hi-lock-write-interactive-patterns] + '(menu-item "Patterns to Buffer" hi-lock-write-interactive-patterns + :help "Insert interactively added REGEXPs into buffer at point." + :enable hi-lock-interactive-patterns)) + + (define-key-after map [hi-lock-find-patterns] + '(menu-item "Patterns from Buffer" hi-lock-find-patterns + :help "Use patterns (if any) near top of buffer.")) + map) "Menu for hi-lock mode.") -(define-key-after hi-lock-menu [highlight-regexp] - '(menu-item "Highlight Regexp..." highlight-regexp - :help "Highlight text matching PATTERN (a regexp).")) - -(define-key-after hi-lock-menu [highlight-phrase] - '(menu-item "Highlight Phrase..." highlight-phrase - :help "Highlight text matching PATTERN (a regexp processed to match phrases).")) - -(define-key-after hi-lock-menu [highlight-lines-matching-regexp] - '(menu-item "Highlight Lines..." highlight-lines-matching-regexp - :help "Highlight lines containing match of PATTERN (a regexp)..")) - -(define-key-after hi-lock-menu [unhighlight-regexp] - '(menu-item "Remove Highlighting..." unhighlight-regexp - :help "Remove previously entered highlighting pattern." - :enable hi-lock-interactive-patterns)) - -(define-key-after hi-lock-menu [hi-lock-write-interactive-patterns] - '(menu-item "Patterns to Buffer" hi-lock-write-interactive-patterns - :help "Insert interactively added REGEXPs into buffer at point." - :enable hi-lock-interactive-patterns)) - -(define-key-after hi-lock-menu [hi-lock-find-patterns] - '(menu-item "Patterns from Buffer" hi-lock-find-patterns - :help "Use patterns (if any) near top of buffer.")) - -(defvar hi-lock-map (make-sparse-keymap "Hi Lock") +(defvar hi-lock-map + (let ((map (make-sparse-keymap "Hi Lock"))) + (define-key map "\C-xwi" 'hi-lock-find-patterns) + (define-key map "\C-xwl" 'highlight-lines-matching-regexp) + (define-key map "\C-xwp" 'highlight-phrase) + (define-key map "\C-xwh" 'highlight-regexp) + (define-key map "\C-xwr" 'unhighlight-regexp) + (define-key map "\C-xwb" 'hi-lock-write-interactive-patterns) + map) "Key map for hi-lock.") -(define-key hi-lock-map "\C-xwi" 'hi-lock-find-patterns) -(define-key hi-lock-map "\C-xwl" 'highlight-lines-matching-regexp) -(define-key hi-lock-map "\C-xwp" 'highlight-phrase) -(define-key hi-lock-map "\C-xwh" 'highlight-regexp) -(define-key hi-lock-map "\C-xwr" 'unhighlight-regexp) -(define-key hi-lock-map "\C-xwb" 'hi-lock-write-interactive-patterns) - ;; Visible Functions ;;;###autoload @@ -335,7 +338,7 @@ is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'." :keymap hi-lock-map (when (and (equal (buffer-name) "*scratch*") load-in-progress - (not (interactive-p)) + (not (called-interactively-p 'interactive)) (not hi-lock-archaic-interface-message-used)) (setq hi-lock-archaic-interface-message-used t) (if hi-lock-archaic-interface-deduce @@ -390,14 +393,13 @@ versions before 22 use the following in your .emacs file: Interactively, prompt for REGEXP then FACE. Buffer-local history list maintained for regexps, global history maintained for faces. -\\Use \\[next-history-element] and \\[previous-history-element] to retrieve next or previous history item. +\\Use \\[previous-history-element] to retrieve previous history items, +and \\[next-history-element] to retrieve default values. \(See info node `Minibuffer History'.)" (interactive (list (hi-lock-regexp-okay - (read-from-minibuffer "Regexp to highlight line: " - (cons (or (car hi-lock-regexp-history) "") 1 ) - nil nil 'hi-lock-regexp-history)) + (read-regexp "Regexp to highlight line" (car regexp-history))) (hi-lock-read-face-name))) (or (facep face) (setq face 'hi-yellow)) (unless hi-lock-mode (hi-lock-mode 1)) @@ -415,14 +417,13 @@ list maintained for regexps, global history maintained for faces. Interactively, prompt for REGEXP then FACE. Buffer-local history list maintained for regexps, global history maintained for faces. -\\Use \\[next-history-element] and \\[previous-history-element] to retrieve next or previous history item. +\\Use \\[previous-history-element] to retrieve previous history items, +and \\[next-history-element] to retrieve default values. \(See info node `Minibuffer History'.)" (interactive (list (hi-lock-regexp-okay - (read-from-minibuffer "Regexp to highlight: " - (cons (or (car hi-lock-regexp-history) "") 1 ) - nil nil 'hi-lock-regexp-history)) + (read-regexp "Regexp to highlight" (car regexp-history))) (hi-lock-read-face-name))) (or (facep face) (setq face 'hi-yellow)) (unless hi-lock-mode (hi-lock-mode 1)) @@ -440,14 +441,14 @@ lower-case letters made case insensitive." (list (hi-lock-regexp-okay (hi-lock-process-phrase - (read-from-minibuffer "Phrase to highlight: " - (cons (or (car hi-lock-regexp-history) "") 1 ) - nil nil 'hi-lock-regexp-history))) + (read-regexp "Phrase to highlight" (car regexp-history)))) (hi-lock-read-face-name))) (or (facep face) (setq face 'hi-yellow)) (unless hi-lock-mode (hi-lock-mode 1)) (hi-lock-set-pattern regexp face)) +(declare-function x-popup-menu "menu.c" (position menu)) + ;;;###autoload (defalias 'unhighlight-regexp 'hi-lock-unface-buffer) ;;;###autoload @@ -552,25 +553,26 @@ not suitable." (intern (completing-read "Highlight using face: " obarray 'facep t - (cons (car hi-lock-face-history) + (cons (car hi-lock-face-defaults) (let ((prefix (try-completion - (substring (car hi-lock-face-history) 0 1) - (mapcar (lambda (f) (cons f f)) - hi-lock-face-history)))) + (substring (car hi-lock-face-defaults) 0 1) + hi-lock-face-defaults))) (if (and (stringp prefix) - (not (equal prefix (car hi-lock-face-history)))) + (not (equal prefix (car hi-lock-face-defaults)))) (length prefix) 0))) - '(hi-lock-face-history . 0)))) + 'face-name-history + (cdr hi-lock-face-defaults)))) (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) - (font-lock-add-keywords nil (list pattern) t) (push pattern hi-lock-interactive-patterns) (if font-lock-fontified - (font-lock-fontify-buffer) + (progn + (font-lock-add-keywords nil (list pattern) t) + (font-lock-fontify-buffer)) (let* ((serial (hi-lock-string-serialize regexp)) (range-min (- (point) (/ hi-lock-highlight-range 2))) (range-max (+ (point) (/ hi-lock-highlight-range 2))) @@ -626,16 +628,14 @@ not suitable." (y-or-n-p "Add patterns from this buffer to hi-lock? ")) (t nil))) (hi-lock-set-file-patterns all-patterns) - (if (interactive-p) + (if (called-interactively-p 'interactive) (message "Hi-lock added %d patterns." (length all-patterns))))))) (defun hi-lock-font-lock-hook () "Add hi-lock patterns to font-lock's." - (if font-lock-mode - (progn - (font-lock-add-keywords nil hi-lock-file-patterns t) - (font-lock-add-keywords nil hi-lock-interactive-patterns t)) - (hi-lock-mode -1))) + (when font-lock-fontified + (font-lock-add-keywords nil hi-lock-file-patterns t) + (font-lock-add-keywords nil hi-lock-interactive-patterns t))) (defvar hi-lock-string-serialize-hash (make-hash-table :test 'equal) @@ -665,5 +665,4 @@ A string is considered new if it had not previously been used in a call to (provide 'hi-lock) -;; arch-tag: d2e8fd07-4cc9-4c6f-a200-1e729bc54066 ;;; hi-lock.el ends here