[Emacs-diffs] Changes to emacs/lisp/hi-lock.el

[Chong Yidong]

Index: emacs/lisp/hi-lock.el
diff -c emacs/lisp/hi-lock.el:1.29 emacs/lisp/hi-lock.el:1.30
*** emacs/lisp/hi-lock.el:1.29  Thu Nov 17 07:21:54 2005
--- emacs/lisp/hi-lock.el       Thu Nov 24 20:52:16 2005
***************
*** 89,104 ****
    :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
-   :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
--- 89,94 ----
***************
*** 244,262 ****
  (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
! (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
--- 234,244 ----
  (define-key hi-lock-map "\C-xwr" 'unhighlight-regexp)
  (define-key hi-lock-map "\C-xwb" 'hi-lock-write-interactive-patterns)
  
  ;; Visible Functions
  
  
  ;;;###autoload
! (define-minor-mode hi-lock-buffer-mode
    "Toggle minor mode for interactively adding font-lock highlighting patterns.
  
  If ARG positive turn hi-lock on.  Issuing a hi-lock command will also
***************
*** 297,339 ****
  will be read until
   Hi-lock: end
  is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'."
!   (interactive)
!   (let ((hi-lock-mode-prev hi-lock-mode))
!     (setq hi-lock-mode
!           (if (null arg) (not hi-lock-mode)
!             (> (prefix-numeric-value arg) 0)))
!     ;; Turned on.
!     (when (and (not hi-lock-mode-prev) hi-lock-mode)
!       (add-hook 'find-file-hook 'hi-lock-find-file-hook)
!       (add-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook)
!       (if (null (default-value 'font-lock-defaults))
!         (setq-default font-lock-defaults '(nil)))
!       (if (null font-lock-defaults)
!         (setq font-lock-defaults '(nil)))
!       (unless font-lock-mode
!       (font-lock-mode 1))
!       (define-key-after menu-bar-edit-menu [hi-lock]
!         (cons "Regexp Highlighting" hi-lock-menu))
!       (dolist (buffer (buffer-list))
!         (with-current-buffer buffer (hi-lock-find-patterns))))
      ;; Turned off.
!     (when (and hi-lock-mode-prev (not hi-lock-mode))
!       (dolist (buffer (buffer-list))
!         (with-current-buffer buffer
!           (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-file-patterns)
!             (setq hi-lock-interactive-patterns nil
!                   hi-lock-file-patterns nil)
!             (when font-lock-mode (hi-lock-refontify)))))
! 
!       (let ((fld (default-value 'font-lock-defaults)))
!       (if (and fld (listp fld) (null (car fld)))
!           (setq-default font-lock-defaults (cdr fld))))
!       (define-key-after menu-bar-edit-menu [hi-lock] nil)
!       (remove-hook 'find-file-hook 'hi-lock-find-file-hook)
!       (remove-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook))))
! 
  
  ;;;###autoload
  (defalias 'highlight-lines-matching-regexp 'hi-lock-line-face-buffer)
--- 279,314 ----
  will be read until
   Hi-lock: end
  is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'."
!   :group 'hi-lock
!   :lighter " H"
!   :global nil
!   :keymap hi-lock-map
!   (if hi-lock-buffer-mode
!       ;; Turned on.
!       (progn
!       (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 t))
      ;; Turned off.
!     (when hi-lock-interactive-patterns 
!       (font-lock-remove-keywords nil hi-lock-interactive-patterns)
!       (setq hi-lock-interactive-patterns nil))
!     (when hi-lock-file-patterns
!       (font-lock-remove-keywords nil hi-lock-file-patterns)
!       (setq hi-lock-file-patterns nil))
!     (if font-lock-mode (hi-lock-refontify))
!     (define-key-after menu-bar-edit-menu [hi-lock] nil)
!     (remove-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook t)))
! 
! ;;;###autoload
! (define-global-minor-mode hi-lock-mode
!   hi-lock-buffer-mode turn-on-hi-lock-if-enabled
!   :group 'hi-lock-interactive-text-highlighting)
!   
! (defun turn-on-hi-lock-if-enabled ()
!   (unless (memq major-mode hi-lock-exclude-modes)
!     (hi-lock-buffer-mode 1)))
  
  ;;;###autoload
  (defalias 'highlight-lines-matching-regexp 'hi-lock-line-face-buffer)
***************
*** 352,363 ****
                             (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 'rwl-yellow))
    (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))))
  
  
  ;;;###autoload
--- 327,338 ----
                             (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))
+   (unless hi-lock-buffer-mode (hi-lock-buffer-mode 1))
    (hi-lock-set-pattern
     ;; The \\(?:...\\) grouping construct ensures that a leading ^, +, * or ?
     ;; or a trailing $ in REGEXP will be interpreted correctly.
!    (concat "^.*\\(?:" regexp "\\).*$") face))
  
  
  ;;;###autoload
***************
*** 378,385 ****
                             nil nil 'hi-lock-regexp-history))
      (hi-lock-read-face-name)))
    (or (facep face) (setq face 'rwl-yellow))
!   (unless hi-lock-mode (hi-lock-mode))
!   (hi-lock-set-pattern (list regexp (list 0 (list 'quote face) t))))
  
  ;;;###autoload
  (defalias 'highlight-phrase 'hi-lock-face-phrase-buffer)
--- 353,360 ----
                             nil nil 'hi-lock-regexp-history))
      (hi-lock-read-face-name)))
    (or (facep face) (setq face 'rwl-yellow))
!   (unless hi-lock-buffer-mode (hi-lock-buffer-mode 1))
!   (hi-lock-set-pattern regexp face))
  
  ;;;###autoload
  (defalias 'highlight-phrase 'hi-lock-face-phrase-buffer)
***************
*** 398,405 ****
                              nil nil 'hi-lock-regexp-history)))
      (hi-lock-read-face-name)))
    (or (facep face) (setq face 'rwl-yellow))
!   (unless hi-lock-mode (hi-lock-mode))
!   (hi-lock-set-pattern (list regexp (list 0 (list 'quote face) t))))
  
  ;;;###autoload
  (defalias 'unhighlight-regexp 'hi-lock-unface-buffer)
--- 373,380 ----
                              nil nil 'hi-lock-regexp-history)))
      (hi-lock-read-face-name)))
    (or (facep face) (setq face 'rwl-yellow))
!   (unless hi-lock-buffer-mode (hi-lock-buffer-mode 1))
!   (hi-lock-set-pattern regexp face))
  
  ;;;###autoload
  (defalias 'unhighlight-regexp 'hi-lock-unface-buffer)
***************
*** 513,541 ****
                         (length prefix) 0)))
             '(hi-lock-face-history . 0))))
  
! (defun hi-lock-find-file-hook ()
!   "Add hi-lock patterns, if present."
!   (hi-lock-find-patterns))
! 
! (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))
!       (add-to-list 'hi-lock-interactive-patterns pattern)))
!   (hi-lock-refontify))
  
  (defun hi-lock-set-file-patterns (patterns)
    "Replace file patterns list with PATTERNS and refontify."
--- 488,509 ----
                         (length prefix) 0)))
             '(hi-lock-face-history . 0))))
  
! (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))
!       (push pattern hi-lock-interactive-patterns)
!       (let ((buffer-undo-list t)
!           (inhibit-read-only t)
!           (mod (buffer-modified-p)))
!       (save-excursion
!         (goto-char (point-min))
!         (while (re-search-forward regexp (point-max) t)
!           (put-text-property
!            (match-beginning 0) (match-end 0) 'face face)
!           (goto-char (match-end 0))))
!       (set-buffer-modified-p mod)))))
  
  (defun hi-lock-set-file-patterns (patterns)
    "Replace file patterns list with PATTERNS and refontify."
***************
*** 569,582 ****
              (condition-case nil
                  (setq all-patterns (append (read (current-buffer)) 
all-patterns))
                (error (message "Invalid pattern list expression at %d"
!                               (hi-lock-current-line)))))))
!       (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
      (font-lock-add-keywords nil hi-lock-file-patterns)
      (font-lock-add-keywords nil hi-lock-interactive-patterns)))
  
--- 537,550 ----
              (condition-case nil
                  (setq all-patterns (append (read (current-buffer)) 
all-patterns))
                (error (message "Invalid pattern list expression at %d"
!                               (line-number-at-pos)))))))
!       (when hi-lock-buffer-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 font-lock-mode
      (font-lock-add-keywords nil hi-lock-file-patterns)
      (font-lock-add-keywords nil hi-lock-interactive-patterns)))