changeset 45444:84e0e49bfb75

(occur-engine): Increment globalcount all at once after searching a buffer. (occur-mode-map): Don't escape plain "o". (occur-mode-hook): New variable. (occur-fontify-region-function): Deleted. (occur-mode): Don't use it. Set up `font-lock-category-alist' instead. (occur-fontify-on-property): Deleted. (occur-engine): Use categories from `font-lock-category-alist'.

--- a/lisp/replace.el	Tue May 21 20:59:28 2002 +0000
+++ b/lisp/replace.el	Tue May 21 21:01:14 2002 +0000
@@ -440,7 +440,7 @@
     (define-key map [mouse-2] 'occur-mode-mouse-goto)
     (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence)
     (define-key map "\C-m" 'occur-mode-goto-occurrence)
-    (define-key map "\o" 'occur-mode-goto-occurrence-other-window)
+    (define-key map "o" 'occur-mode-goto-occurrence-other-window)
     (define-key map "\C-o" 'occur-mode-display-occurrence)
     (define-key map "\M-n" 'occur-next)
     (define-key map "\M-p" 'occur-prev)
@@ -453,6 +453,11 @@
   "Arguments to pass to `occur-1' to revert an Occur mode buffer.
 See `occur-revert-function'.")
 
+(defcustom occur-mode-hook '(turn-on-font-lock)
+  "Hooks run when `occur' is called."
+  :type 'hook
+  :group 'matching)
+
 (put 'occur-mode 'mode-class 'special)
 (defun occur-mode ()
   "Major mode for output from \\[occur].
@@ -466,10 +471,9 @@
   (setq major-mode 'occur-mode)
   (setq mode-name "Occur")
   (make-local-variable 'revert-buffer-function)
-  (set (make-local-variable 'font-lock-defaults)
-       '(nil t nil nil nil
-	     (font-lock-fontify-region-function . occur-fontify-region-function)))
-  (setq revert-buffer-function 'occur-revert-function)
+  (set (make-local-variable 'font-lock-category-alist)
+       `((,(make-symbol "occur-match") . bold)
+	 (,(make-symbol "occur-title") . underline)))
   (set (make-local-variable 'revert-buffer-function) 'occur-revert-function)
   (make-local-variable 'occur-revert-arguments)
   (run-hooks 'occur-mode-hook))
@@ -763,7 +767,6 @@
 		  (setq origpt (point))
 		  (when (setq endpt (re-search-forward regexp nil t))
 		    (setq matches (1+ matches)) ;; increment match count
-		    (setq globalcount (1+ globalcount))
 		    (setq matchbeg (match-beginning 0)
 			  matchend (match-end 0))
 		    (setq begpt (save-excursion
@@ -777,6 +780,8 @@
 		    ;; Depropertize the string, and maybe
 		    ;; highlight the matches
 		    (let ((len (length curstring))
+			  (match-category (with-current-buffer out-buf
+					    (car (nth 0 font-lock-category-alist))))
 			  (start 0))
 		      (unless keep-props
 			(set-text-properties 0 len nil curstring))
@@ -785,7 +790,7 @@
 			(add-text-properties (match-beginning 0)
 					     (match-end 0)
 					     (append
-					      '(occur-match t)
+					      `(occur-match t category ,match-category)
 					      (when match-face
 						`(face ,match-face)))
 					     curstring)
@@ -831,6 +836,7 @@
 			(forward-line 1))
 		    (goto-char (point-max))))))
 	    (when (not (zerop matches)) ;; is the count zero?
+	      (setq globalcount (+ globalcount matches))
 	      (with-current-buffer out-buf
 		(goto-char headerpt)
 		(let ((beg (point))
@@ -842,36 +848,13 @@
 				       (append
 					(when title-face
 					  `(face ,title-face))
-					`(occur-title ,buf))))
+					`(occur-title
+					  ,buf category
+					  ,(car (nth 1 font-lock-category-alist))))))
 		(goto-char (point-min)))))))
       ;; Return the number of matches
       globalcount)))
 
-(defun occur-fontify-on-property (prop face beg end)
-  (let ((prop-beg (or (and (get-text-property (point) prop) (point))
-		      (next-single-property-change (point) prop nil end))))
-    (when (and prop-beg (not (= prop-beg end)))
-      (let ((prop-end (next-single-property-change beg prop nil end)))
-	(when (and prop-end (not (= prop-end end)))
-	  (put-text-property prop-beg prop-end 'face face)
-	  prop-end)))))
-
-(defun occur-fontify-region-function (beg end &optional verbose)
-  (when verbose (message "Fontifying..."))
-  (let ((inhibit-read-only t))
-    (save-excursion
-      (dolist (e `((occur-title . ,list-matching-lines-buffer-name-face)
-		   (occur-match . ,list-matching-lines-face)))
-		   ; (occur-prefix . ,list-matching-lines-prefix-face)))
-	(goto-char beg)
-	(let ((change-end nil))
-	  (while (setq change-end (occur-fontify-on-property (car e)
-							     (cdr e)
-							     (point)
-							     end))
-	    (goto-char change-end))))))
-  (when verbose (message "Fontifying...done")))
-
 
 ;; It would be nice to use \\[...], but there is no reasonable way
 ;; to make that display both SPC and Y.