Re: Remove mouse-face in Occur buffers

[Juri Linkov]

>> Maybe, there should be a separate variable defining a list
>> of text properties to remove on copied text in the occur buffer.
>> Do you think it would be useful?
>
> Yes, that sounds like a good idea.
>
> The default value could be the same as the initial value of
> yank-excluded-properties (I haven't checked).

The default value of `yank-excluded-properties' also includes
`invisible' which will unhide copied invisible text in the Occur buffer.
This is better than displaying lines with hidden matches.  But maybe
occur should skip invisible text in the original buffer, and not to copy
lines where matches have invisible properties on them (i.e. like
isearch skips invisible text)?

Anyway, in the patch below the default value of `occur-excluded-properties'
is the same as of `yank-excluded-properties'.  And it also servers as
the default value of the `keep-props' argument (which before this patch
was unconditionally non-nil).

Index: lisp/replace.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/replace.el,v
retrieving revision 1.228
diff -c -r1.228 replace.el
*** lisp/replace.el     29 Oct 2005 19:49:20 -0000      1.228
--- lisp/replace.el     31 Oct 2005 07:43:23 -0000
***************
*** 878,883 ****
--- 878,893 ----
    :type 'face
    :group 'matching)
  
+ (defcustom occur-excluded-properties
+   '(read-only invisible intangible field mouse-face help-echo local-map keymap
+     yank-handler follow-link)
+   "*Text properties to discard when copying lines to the *Occur* buffer.
+ The value should be a list of text properties to discard or t,
+ which means to discard all text properties."
+   :type '(choice (const :tag "All" t) (repeat symbol))
+   :group 'matching
+   :version "22.1")
+ 
  (defun occur-accumulate-lines (count &optional keep-props)
    (save-excursion
      (let ((forwardp (> count 0))
***************
*** 894,903 ****
            (if (fboundp 'jit-lock-fontify-now)
                (jit-lock-fontify-now beg end)))
        (push
!        (funcall (if keep-props
!                     #'buffer-substring
!                   #'buffer-substring-no-properties)
!                 beg end)
         result)
        (forward-line (if forwardp 1 -1)))
        (nreverse result))))
--- 904,915 ----
            (if (fboundp 'jit-lock-fontify-now)
                (jit-lock-fontify-now beg end)))
        (push
!        (if (and keep-props (not (eq occur-excluded-properties t)))
!            (let ((str (buffer-substring beg end)))
!              (remove-list-of-text-properties
!               0 (length str) occur-excluded-properties str)
!              str)
!          (buffer-substring-no-properties beg end))
         result)
        (forward-line (if forwardp 1 -1)))
        (nreverse result))))
***************
*** 1033,1039 ****
                      (and case-fold-search
                           (isearch-no-upper-case-p regexp t))
                      list-matching-lines-buffer-name-face
!                     nil list-matching-lines-face t)))
          (let* ((bufcount (length active-bufs))
                 (diff (- (length bufs) bufcount)))
            (message "Searched %d buffer%s%s; %s match%s for `%s'"
--- 1045,1052 ----
                      (and case-fold-search
                           (isearch-no-upper-case-p regexp t))
                      list-matching-lines-buffer-name-face
!                     nil list-matching-lines-face
!                     (not (eq occur-excluded-properties t)))))
          (let* ((bufcount (length active-bufs))
                 (diff (- (length bufs) bufcount)))
            (message "Searched %d buffer%s%s; %s match%s for `%s'"
***************
*** 1102,1114 ****
                             (text-property-not-all begpt endpt 'fontified t))
                        (if (fboundp 'jit-lock-fontify-now)
                            (jit-lock-fontify-now begpt endpt)))
!                   (setq curstring (buffer-substring begpt endpt))
!                   ;; Depropertize the string, and maybe
!                   ;; highlight the matches
                    (let ((len (length curstring))
                          (start 0))
-                     (unless keep-props
-                       (set-text-properties 0 len nil curstring))
                      (while (and (< start len)
                                  (string-match regexp curstring start))
                        (add-text-properties
--- 1115,1129 ----
                             (text-property-not-all begpt endpt 'fontified t))
                        (if (fboundp 'jit-lock-fontify-now)
                            (jit-lock-fontify-now begpt endpt)))
!                   (if (and keep-props (not (eq occur-excluded-properties t)))
!                       (progn
!                         (setq curstring (buffer-substring begpt endpt))
!                         (remove-list-of-text-properties
!                          0 (length curstring) occur-excluded-properties 
curstring))
!                     (setq curstring (buffer-substring-no-properties begpt 
endpt)))
!                   ;; Highlight the matches
                    (let ((len (length curstring))
                          (start 0))
                      (while (and (< start len)
                                  (string-match regexp curstring start))
                        (add-text-properties

-- 
Juri Linkov
http://www.jurta.org/emacs/