Mercurial > emacs

changeset 67112:146389d32df6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
* hi-lock.el (hi-lock-buffer-mode): Renamed from `hi-lock-mode'. Use define-minor-mode, and make it a local mode. (hi-lock-mode): New global minor mode. (turn-on-hi-lock-if-enabled): New function. (hi-lock-line-face-buffer, hi-lock-face-buffer) (hi-lock-set-pattern): Changed arguments to regexp and face instead of a font-lock pattern. Directly set face property, instead of refontifying. (hi-lock-font-lock-hook): Check if font-lock is being turned on. (hi-lock-find-patterns): Use line-number-at-pos. (hi-lock-face-phrase-buffer): Call hi-lock-buffer-mode. Use new arguments for hi-lock-set-pattern. (hi-lock-find-file-hook, hi-lock-current-line) (hi-lock-set-patterns): Deleted unused functions. * progmodes/compile.el (compilation-setup): Don't fiddle with font-lock-defaults.
author Chong Yidong <cyd@stupidchicken.com>
date Thu, 24 Nov 2005 20:52:16 +0000
parents e8d805eb4ade
children e5cb150b288f
files lisp/ChangeLog lisp/hi-lock.el lisp/progmodes/compile.el
diffstat 3 files changed, 78 insertions(+), 91 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Thu Nov 24 20:45:50 2005 +0000
+++ b/lisp/ChangeLog	Thu Nov 24 20:52:16 2005 +0000
@@ -1,3 +1,24 @@
+2005-11-24  Chong Yidong  <cyd@stupidchicken.com>
+
+	* hi-lock.el (hi-lock-buffer-mode): Renamed from `hi-lock-mode'.
+	Use define-minor-mode, and make it a local mode.
+	(hi-lock-mode): New global minor mode.
+	(turn-on-hi-lock-if-enabled): New function.
+	(hi-lock-line-face-buffer, hi-lock-face-buffer)
+	(hi-lock-set-pattern): Changed arguments to regexp and face
+	instead of a font-lock pattern.  Directly set face property,
+	instead of refontifying.
+	(hi-lock-font-lock-hook): Check if font-lock is being turned on.
+	(hi-lock-find-patterns): Use line-number-at-pos.
+
+	(hi-lock-face-phrase-buffer): Call hi-lock-buffer-mode.  Use new
+	arguments for hi-lock-set-pattern.
+	(hi-lock-find-file-hook, hi-lock-current-line)
+	(hi-lock-set-patterns): Deleted unused functions.
+
+	* progmodes/compile.el (compilation-setup): Don't fiddle with
+	font-lock-defaults.
+
 2005-11-25  Nick Roberts  <nickrob@snap.net.nz>
 
 	* progmodes/gdb-ui.el (gdb-var-create-handler)
--- a/lisp/hi-lock.el	Thu Nov 24 20:45:50 2005 +0000
+++ b/lisp/hi-lock.el	Thu Nov 24 20:52:16 2005 +0000
@@ -89,16 +89,6 @@
   :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
@@ -244,19 +234,11 @@
 (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)
+(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,43 +279,36 @@
 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))))
+  :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 (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)))))
+    (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)))
 
-      (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
+(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,12 +327,12 @@
                            (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))
+  (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.
-   (list (concat "^.*\\(?:" regexp "\\).*$") (list 0 (list 'quote face) t))))
+   (concat "^.*\\(?:" regexp "\\).*$") face))
 
 
 ;;;###autoload
@@ -378,8 +353,8 @@
                            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))))
+  (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,8 +373,8 @@
                             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))))
+  (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,29 +488,22 @@
                        (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)
+(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))
-      (add-to-list 'hi-lock-interactive-patterns pattern)))
-  (hi-lock-refontify))
+      (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,14 +537,14 @@
             (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))
+                              (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 hi-lock-mode
+  (when font-lock-mode
     (font-lock-add-keywords nil hi-lock-file-patterns)
     (font-lock-add-keywords nil hi-lock-interactive-patterns)))
 
--- a/lisp/progmodes/compile.el	Thu Nov 24 20:45:50 2005 +0000
+++ b/lisp/progmodes/compile.el	Thu Nov 24 20:52:16 2005 +0000
@@ -1335,19 +1335,17 @@
   ;; jit-lock might fontify some things too late.
   (set (make-local-variable 'font-lock-support-mode) nil)
   (set (make-local-variable 'font-lock-maximum-size) nil)
-  (let ((fld font-lock-defaults))
-    (if (and minor fld)
+  (if minor
+      (let ((fld font-lock-defaults))
 	(font-lock-add-keywords nil (compilation-mode-font-lock-keywords))
-      (setq font-lock-defaults '(compilation-mode-font-lock-keywords t)))
-    (if minor
 	(if font-lock-mode
 	    (if fld
 		(font-lock-fontify-buffer)
 	      (font-lock-change-mode)
 	      (turn-on-font-lock))
-	  (turn-on-font-lock))
-      ;; maybe defer font-lock till after derived mode is set up
-      (run-mode-hooks 'compilation-turn-on-font-lock))))
+	  (turn-on-font-lock)))
+    ;; maybe defer font-lock till after derived mode is set up
+    (run-mode-hooks 'compilation-turn-on-font-lock)))
 
 ;;;###autoload
 (define-minor-mode compilation-shell-minor-mode