emacs: lisp/hi-lock.el comparison

comparison lisp/hi-lock.el @ 90261:7beb78bc1f8e

Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-97 Merge from emacs--cvs-trunk--0 Patches applied: * emacs--cvs-trunk--0 (patch 616-696) - Add lisp/mh-e/.arch-inventory - Update from CVS - Merge from gnus--rel--5.10 - Update from CVS: lisp/smerge-mode.el: Add 'tools' to file keywords. - lisp/gnus/ChangeLog: Remove duplicate entry * gnus--rel--5.10 (patch 147-181) - Update from CVS - Merge from emacs--cvs-trunk--0 - Update from CVS: lisp/mml.el (mml-preview): Doc fix. - Update from CVS: texi/message.texi: Fix default values. - Update from CVS: texi/gnus.texi (RSS): Addition.

author	Miles Bader <miles@gnu.org>
date	Mon, 16 Jan 2006 08:37:27 +0000
parents	fa0da9b57058 edd5b99fd103
children	d6f8fe3307c8

comparison

equal deleted inserted replaced

-:0ca0d9181b5e
+:7beb78bc1f8e
 ;;
 ;;    Put the following code in your .emacs file.  This turns on
 ;;    hi-lock mode and adds a "Regexp Highlighting" entry
 ;;    to the edit menu.
 ;;
-;;    (hi-lock-mode 1)
+;;    (global-hi-lock-mode 1)
 ;;
 ;;    You might also want to bind the hi-lock commands to more
 ;;    finger-friendly sequences:
 ;;    (define-key hi-lock-map "\C-z\C-h" 'highlight-lines-matching-regexp)
 ;;; Code:
 (eval-and-compile
 (require 'font-lock))
-(defgroup hi-lock-interactive-text-highlighting nil
+(defgroup hi-lock nil
 "Interactively add and remove font-lock patterns for highlighting text."
-:group 'faces)
+:link '(custom-manual "(emacs)Highlight Interactively")
+:group 'font-lock)
-;;;###autoload
-(defcustom hi-lock-mode nil
-"Toggle hi-lock, for interactively adding font-lock text-highlighting patterns."
-:set (lambda (symbol value)
-(hi-lock-mode (or value 0)))
-:initialize 'custom-initialize-default
-:type 'boolean
-:group 'hi-lock-interactive-text-highlighting
-:require 'hi-lock)
 (defcustom hi-lock-file-patterns-range 10000
 "Limit of search in a buffer for hi-lock patterns.
 When a file is visited and hi-lock mode is on patterns starting
 up to this limit are added to font-lock's patterns.  See documentation
 of functions `hi-lock-mode' and `hi-lock-find-patterns'."
 :type 'integer
-:group 'hi-lock-interactive-text-highlighting)
+:group 'hi-lock)
+(defcustom hi-lock-highlight-range 200000
+"Size of area highlighted by hi-lock when font-lock not active.
+Font-lock is not active in buffers that do their own highlighting,
+such as the buffer created by `list-colors-display'.  In those buffers
+hi-lock patterns will only be applied over a range of
+`hi-lock-highlight-range' characters.  If font-lock is active then
+highlighting will be applied throughout the buffer."
+:type 'integer
+:group 'hi-lock)
 (defcustom hi-lock-exclude-modes
 '(rmail-mode mime/viewer-mode gnus-article-mode)
 "List of major modes in which hi-lock will not run.
 For security reasons since font lock patterns can specify function
 calls."
 :type '(repeat symbol)
-:group 'hi-lock-interactive-text-highlighting)
+:group 'hi-lock)
 (defgroup hi-lock-faces nil
 "Faces for hi-lock."
-:group 'hi-lock-interactive-text-highlighting)
+:group 'hi-lock
+:group 'faces)
 (defface hi-yellow
 '((((min-colors 88) (background dark))
 (:background "yellow1" :foreground "black"))
 (((background dark)) (:background "yellow" :foreground "black"))
 "History of regexps used for interactive fontification.")
 (defvar hi-lock-file-patterns-prefix "Hi-lock"
 "Regexp for finding hi-lock patterns at top of file.")
+(defvar hi-lock-archaic-interface-message-used nil
+"True if user alerted that `global-hi-lock-mode' is now the global switch.
+Earlier versions of hi-lock used `hi-lock-mode' as the global switch,
+the message is issued if it appears that `hi-lock-mode' is used assuming
+that older functionality.  This variable avoids multiple reminders.")
+(defvar hi-lock-archaic-interface-deduce nil
+"If non-nil, sometimes assume that `hi-lock-mode' means `global-hi-lock-mode'.
+Assumption is made if `hi-lock-mode' used in the *scratch* buffer while
+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)
 (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)
-(unless (assq 'hi-lock-mode minor-mode-map-alist)
-(setq minor-mode-map-alist (cons (cons 'hi-lock-mode hi-lock-map)
-minor-mode-map-alist)))
-(unless (assq 'hi-lock-mode minor-mode-alist)
-(setq minor-mode-alist (cons '(hi-lock-mode " H") minor-mode-alist)))
 ;; Visible Functions
+;;;###autoload
-;;;###autoload
+(define-minor-mode hi-lock-mode
-(defun hi-lock-mode (&optional arg)
 "Toggle minor mode for interactively adding font-lock highlighting patterns.
-If ARG positive turn hi-lock on.  Issuing a hi-lock command will also
+If ARG positive, turn hi-lock on.  Issuing a hi-lock command will also
-turn hi-lock on.  When hi-lock is turned on, a \"Regexp Highlighting\"
+turn hi-lock on.  To turn hi-lock on in all buffers use
-submenu is added to the \"Edit\" menu.  The commands in the submenu,
+`global-hi-lock-mode' or in your .emacs file (global-hi-lock-mode 1).
-which can be called interactively, are:
+When hi-lock is turned on, a \"Regexp Highlighting\" submenu is added
+to the \"Edit\" menu.  The commands in the submenu, which can be
+called interactively, are:
 \\[highlight-regexp] REGEXP FACE
 Highlight matches of pattern REGEXP in current buffer with FACE.
 \\[highlight-phrase] PHRASE FACE
 already present.  The patterns must start before position (number
 of characters into buffer) `hi-lock-file-patterns-range'.  Patterns
 will be read until
 Hi-lock: end
 is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'."
-(interactive)
+:group 'hi-lock
-(let ((hi-lock-mode-prev hi-lock-mode))
+:lighter (:eval (if (or hi-lock-interactive-patterns
-(setq hi-lock-mode
+			  hi-lock-file-patterns)
-(if (null arg) (not hi-lock-mode)
+		      " Hi" ""))
-(> (prefix-numeric-value arg) 0)))
+:global nil
-;; Turned on.
+:keymap hi-lock-map
-(when (and (not hi-lock-mode-prev) hi-lock-mode)
+(when (and (equal (buffer-name) "*scratch*")
-(add-hook 'find-file-hook 'hi-lock-find-file-hook)
+load-in-progress
-(add-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook)
+(not (interactive-p))
-(when (eq nil font-lock-defaults)
+(not hi-lock-archaic-interface-message-used))
-	(setq font-lock-defaults '(nil)))
+(setq hi-lock-archaic-interface-message-used t)
-(unless font-lock-mode
+(if hi-lock-archaic-interface-deduce
-	(font-lock-mode 1))
+(global-hi-lock-mode hi-lock-mode)
-(define-key-after menu-bar-edit-menu [hi-lock]
+(warn
-(cons "Regexp Highlighting" hi-lock-menu))
+"Possible archaic use of (hi-lock-mode).
-(dolist (buffer (buffer-list))
+Use (global-hi-lock-mode 1) in .emacs to enable hi-lock for all buffers,
-(with-current-buffer buffer (hi-lock-find-patterns))))
+use (hi-lock-mode 1) for individual buffers.  For compatibility with Emacs
+versions before 22 use the following in your .emacs file:
+(if (functionp 'global-hi-lock-mode)
+(global-hi-lock-mode 1)
+(hi-lock-mode 1))
+")))
+(if hi-lock-mode
+;; Turned on.
+(progn
+	(unless font-lock-mode (font-lock-mode 1))
+	(define-key-after menu-bar-edit-menu [hi-lock]
+	  (cons "Regexp Highlighting" hi-lock-menu))
+	(hi-lock-find-patterns)
+	(add-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook nil t))
 ;; Turned off.
-(when (and hi-lock-mode-prev (not hi-lock-mode))
+(when (or hi-lock-interactive-patterns
-(dolist (buffer (buffer-list))
+	      hi-lock-file-patterns)
-(with-current-buffer buffer
+(when hi-lock-interactive-patterns
-(when (or hi-lock-interactive-patterns hi-lock-file-patterns)
+	(font-lock-remove-keywords nil hi-lock-interactive-patterns)
-(font-lock-remove-keywords nil hi-lock-interactive-patterns)
+	(setq hi-lock-interactive-patterns nil))
-(font-lock-remove-keywords nil hi-lock-file-patterns)
+(when hi-lock-file-patterns
-(setq hi-lock-interactive-patterns nil
+	(font-lock-remove-keywords nil hi-lock-file-patterns)
-hi-lock-file-patterns nil)
+	(setq hi-lock-file-patterns nil))
-(when font-lock-mode (hi-lock-refontify)))))
+(remove-overlays nil nil 'hi-lock-overlay t)
-(define-key-after menu-bar-edit-menu [hi-lock] nil)
+(when font-lock-fontified (font-lock-fontify-buffer)))
-(remove-hook 'find-file-hook 'hi-lock-find-file-hook)
+(define-key-after menu-bar-edit-menu [hi-lock] nil)
-(remove-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook))))
+(remove-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook t)))
+;;;###autoload
+(define-global-minor-mode global-hi-lock-mode
+hi-lock-mode turn-on-hi-lock-if-enabled
+:group 'hi-lock)
+(defun turn-on-hi-lock-if-enabled ()
+(setq hi-lock-archaic-interface-message-used t)
+(unless (memq major-mode hi-lock-exclude-modes)
+(hi-lock-mode 1)))
 ;;;###autoload
 (defalias 'highlight-lines-matching-regexp 'hi-lock-line-face-buffer)
 ;;;###autoload
 (defun hi-lock-line-face-buffer (regexp &optional face)
 (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))
 (hi-lock-read-face-name)))
-(unless hi-lock-mode (hi-lock-mode))
+(or (facep face) (setq face 'hi-yellow))
-(or (facep face) (setq face 'rwl-yellow))
+(unless hi-lock-mode (hi-lock-mode 1))
 (hi-lock-set-pattern
 ;; The \\(?:...\\) grouping construct ensures that a leading ^, +, * or ?
 ;; or a trailing $ in REGEXP will be interpreted correctly.
-(list (concat "^.*\\(?:" regexp "\\).*$") (list 0 (list 'quote face) t))))
+(concat "^.*\\(?:" regexp "\\).*$") face))
 ;;;###autoload
 (defalias 'highlight-regexp 'hi-lock-face-buffer)
 ;;;###autoload
 (hi-lock-regexp-okay
 (read-from-minibuffer "Regexp to highlight: "
 (cons (or (car hi-lock-regexp-history) "") 1 )
 nil nil 'hi-lock-regexp-history))
 (hi-lock-read-face-name)))
-(or (facep face) (setq face 'rwl-yellow))
+(or (facep face) (setq face 'hi-yellow))
-(unless hi-lock-mode (hi-lock-mode))
+(unless hi-lock-mode (hi-lock-mode 1))
-(hi-lock-set-pattern (list regexp (list 0 (list 'quote face) t))))
+(hi-lock-set-pattern regexp face))
 ;;;###autoload
 (defalias 'highlight-phrase 'hi-lock-face-phrase-buffer)
 ;;;###autoload
 (defun hi-lock-face-phrase-buffer (regexp &optional face)
 (hi-lock-process-phrase
 (read-from-minibuffer "Phrase to highlight: "
 (cons (or (car hi-lock-regexp-history) "") 1 )
 nil nil 'hi-lock-regexp-history)))
 (hi-lock-read-face-name)))
-(or (facep face) (setq face 'rwl-yellow))
+(or (facep face) (setq face 'hi-yellow))
-(unless hi-lock-mode (hi-lock-mode))
+(unless hi-lock-mode (hi-lock-mode 1))
-(hi-lock-set-pattern (list regexp (list 0 (list 'quote face) t))))
+(hi-lock-set-pattern regexp face))
 ;;;###autoload
 (defalias 'unhighlight-regexp 'hi-lock-unface-buffer)
 ;;;###autoload
 (defun hi-lock-unface-buffer (regexp)
 (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))
-(hi-lock-refontify))))
+(remove-overlays
+nil nil 'hi-lock-overlay-regexp (hi-lock-string-serialize regexp))
+(when font-lock-fontified (font-lock-fontify-buffer)))))
 ;;;###autoload
 (defun hi-lock-write-interactive-patterns ()
 "Write interactively added patterns, if any, into buffer at point.
 Interactively added patterns are those normally specified using
 `highlight-regexp' and `highlight-lines-matching-regexp'; they can
 be found in variable `hi-lock-interactive-patterns'."
 (interactive)
-(let ((prefix (format "%s %s:" (or comment-start "") "Hi-lock")))
+(if (null hi-lock-interactive-patterns)
-(when (> (+ (point) (length prefix)) hi-lock-file-patterns-range)
+(error "There are no interactive patterns"))
-(beep)
+(let ((beg (point)))
-(message
-"Warning, inserted keywords not close enough to top of file."))
 (mapcar
 (lambda (pattern)
-(insert (format "%s (%s) %s\n"
+(insert (format "%s: (%s)\n"
-prefix (prin1-to-string pattern) (or comment-end ""))))
+		       hi-lock-file-patterns-prefix
-hi-lock-interactive-patterns)))
+		       (prin1-to-string pattern))))
+hi-lock-interactive-patterns)
+(comment-region beg (point)))
+(when (> (point) hi-lock-file-patterns-range)
+(warn "Inserted keywords not close enough to top of file")))
 ;; Implementation Functions
 (defun hi-lock-process-phrase (phrase)
 "Convert regexp PHRASE to a regexp that matches phrases.
 (if (and (stringp prefix)
 (not (equal prefix (car hi-lock-face-history))))
 (length prefix) 0)))
 '(hi-lock-face-history . 0))))
-(defun hi-lock-find-file-hook ()
+(defun hi-lock-set-pattern (regexp face)
-"Add hi-lock patterns, if present."
+"Highlight REGEXP with face FACE."
-(hi-lock-find-patterns))
+(let ((pattern (list regexp (list 0 (list 'quote face) t))))
-(defun hi-lock-current-line (&optional end)
-"Return line number of line at point.
-Optional argument END is maximum excursion."
-(interactive)
-(save-excursion
-(beginning-of-line)
-(1+ (count-lines 1 (or end (point))))))
-(defun hi-lock-set-pattern (pattern)
-"Add PATTERN to list of interactively highlighted patterns and refontify."
-(hi-lock-set-patterns (list pattern)))
-(defun hi-lock-set-patterns (patterns)
-"Add PATTERNS to list of interactively highlighted patterns and refontify.."
-(dolist (pattern patterns)
 (unless (member pattern hi-lock-interactive-patterns)
-(font-lock-add-keywords nil (list pattern))
+(font-lock-add-keywords nil (list pattern) t)
-(add-to-list 'hi-lock-interactive-patterns pattern)))
+(push pattern hi-lock-interactive-patterns)
-(hi-lock-refontify))
+(if font-lock-fontified
+(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)))
+(search-start
+(max (point-min)
+(- range-min (max 0 (- range-max (point-max))))))
+(search-end
+(min (point-max)
+(+ range-max (max 0 (- (point-min) range-min))))))
+(save-excursion
+(goto-char search-start)
+(while (re-search-forward regexp search-end t)
+(let ((overlay (make-overlay (match-beginning 0) (match-end 0))))
+(overlay-put overlay 'hi-lock-overlay t)
+(overlay-put overlay 'hi-lock-overlay-regexp serial)
+(overlay-put overlay 'face face))
+(goto-char (match-end 0)))))))))
 (defun hi-lock-set-file-patterns (patterns)
 "Replace file patterns list with PATTERNS and refontify."
 (when (or hi-lock-file-patterns patterns)
 (font-lock-remove-keywords nil hi-lock-file-patterns)
 (setq hi-lock-file-patterns patterns)
-(font-lock-add-keywords nil hi-lock-file-patterns)
+(font-lock-add-keywords nil hi-lock-file-patterns t)
-(hi-lock-refontify)))
+(font-lock-fontify-buffer)))
-(defun hi-lock-refontify ()
-"Unfontify then refontify buffer.  Used when hi-lock patterns change."
-(interactive)
-(unless font-lock-mode (font-lock-mode 1))
-(font-lock-fontify-buffer))
 (defun hi-lock-find-patterns ()
 "Find patterns in current buffer for hi-lock."
 (interactive)
 (unless (memq major-mode hi-lock-exclude-modes)
 	  (while (and (re-search-forward target-regexp (+ (point) 100) t)
 		      (not (looking-at "\\s-*end")))
 (condition-case nil
 (setq all-patterns (append (read (current-buffer)) all-patterns))
 (error (message "Invalid pattern list expression at %d"
-(hi-lock-current-line)))))))
+(line-number-at-pos)))))))
 (when hi-lock-mode (hi-lock-set-file-patterns all-patterns))
 (if (interactive-p)
 (message "Hi-lock added %d patterns." (length all-patterns))))))
 (defun hi-lock-font-lock-hook ()
 "Add hi lock patterns to font-lock's."
-(when hi-lock-mode
+(if font-lock-mode
-(font-lock-add-keywords nil hi-lock-file-patterns)
+(progn
-(font-lock-add-keywords nil hi-lock-interactive-patterns)))
+	(font-lock-add-keywords nil hi-lock-file-patterns t)
+	(font-lock-add-keywords nil hi-lock-interactive-patterns t))
+(hi-lock-mode -1)))
+(defvar hi-lock-string-serialize-hash
+(make-hash-table :test 'equal)
+"Hash table used to assign unique numbers to strings.")
+(defvar hi-lock-string-serialize-serial 1
+"Number assigned to last new string in call to `hi-lock-string-serialize'.
+A string is considered new if it had not previously been used in a call to
+`hi-lock-string-serialize'.")
+(defun hi-lock-string-serialize (string)
+"Return unique serial number for STRING."
+(interactive)
+(let ((val (gethash string hi-lock-string-serialize-hash)))
+(if val val
+(puthash string
+(setq hi-lock-string-serialize-serial
+(1+ hi-lock-string-serialize-serial))
+hi-lock-string-serialize-hash)
+hi-lock-string-serialize-serial)))
 (provide 'hi-lock)
 ;; arch-tag: d2e8fd07-4cc9-4c6f-a200-1e729bc54066
 ;;; hi-lock.el ends here

Mercurial > emacs

comparison lisp/hi-lock.el @ 90261:7beb78bc1f8e