Re: Replace selective-display in Gnus

[Stefan Monnier]

> Could someone propose a patch how to use invisible overlays here?  It
> should be compatible with Emacs 21 (and up) and XEmacs 21.4 (and up)
> if possible.

I thought I had a few years back, but Google can't find it, so maybe
I just dreamt it.  Here is the gnus-sum.el code I'm using nowadays.
IIRC it's not 100% correct (the behavior is not quite the same as the
current one).  This includes unrelated changes, and uses remove-overlays
which was new in Emacs-22.


        Stefan



Using submit branch file:///home/monnier/tmp/bzr/trunk/
=== modified file 'lisp/gnus/gnus-sum.el'
--- lisp/gnus/gnus-sum.el       2009-08-29 09:03:23 +0000
+++ lisp/gnus/gnus-sum.el       2009-08-29 14:14:56 +0000
@@ -3069,8 +3069,7 @@
   (setq buffer-read-only t             ;Disable modification
        show-trailing-whitespace nil)
   (setq truncate-lines t)
-  (setq selective-display t)
-  (setq selective-display-ellipses t)  ;Display `...'
+  (add-to-invisibility-spec '(gnus-sum . t))
   (gnus-summary-set-display-table)
   (gnus-set-default-directory)
   (make-local-variable 'gnus-summary-line-format)
@@ -3282,7 +3281,10 @@
   '(progn
      (gnus-summary-skip-intangible)
      (or (get-text-property (point) 'gnus-number)
-        (gnus-summary-last-subject))))
+        (gnus-summary-last-subject)
+         ;; FIXME: WTF?
+         ;; Triggered once from editing a text saved in the drafts folder.
+        (debug))))
 
 (defmacro gnus-summary-article-header (&optional number)
   "Return the header of article NUMBER."
@@ -4403,9 +4405,7 @@
 
 (defsubst gnus-remove-odd-characters (string)
   "Translate STRING into something that doesn't contain weird characters."
-  (mm-subst-char-in-string
-   ?\r ?\-
-   (mm-subst-char-in-string ?\n ?\- string t) t))
+  (replace-regexp-in-string "[\r\n]" "-" string))
 
 ;; This function has to be called with point after the article number
 ;; on the beginning of the line.
@@ -6101,8 +6101,7 @@
   "Look through all the headers and mark the Xrefs as read."
   (let ((virtual (gnus-virtual-group-p from-newsgroup))
        name info xref-hashtb idlist method nth4)
-    (save-excursion
-      (set-buffer gnus-group-buffer)
+    (with-current-buffer gnus-group-buffer
       (when (setq xref-hashtb
                  (gnus-create-xref-hashtb from-newsgroup headers unreads))
        (mapatoms
@@ -7530,6 +7529,8 @@
     (gnus-article-setup-buffer))
   (gnus-set-global-variables)
   (with-current-buffer gnus-article-buffer
+    ;; It seems I added this at some point, not sure why.  --Stef
+    ;; (let ((inhibit-read-only t)) (erase-buffer))
     (setq gnus-article-charset gnus-newsgroup-charset)
     (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets)
     (mm-enable-multibyte))
@@ -9184,6 +9185,9 @@
        (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
        (case-fold-search t))
     (dolist (header gnus-newsgroup-headers)
+      ;; FIXME: when called from gnus-summary-limit-include-thread via
+      ;; gnus-summary-limit-include-matching-articles, `regexp' is a decoded
+      ;; string whereas the header isn't decoded.
       (when (string-match regexp (funcall func header))
        (push (mail-header-number header) articles)))
     (nreverse articles)))
@@ -9845,7 +9849,7 @@
                              to-newsgroup
                              select-method))
 
-       ;;;!!!Why is this necessary?
+        ;;!!!Why is this necessary?
        (set-buffer gnus-summary-buffer)
 
        (gnus-summary-goto-subject article)
@@ -10009,6 +10013,8 @@
 (defun gnus-summary-expire-articles (&optional now)
   "Expire all articles that are marked as expirable in the current group."
   (interactive)
+  ;; (unless (gnus-check-server (gnus-find-method-for-group 
gnus-newsgroup-name))
+  ;;   (error "Couldn't open server"))
   (when (and (not gnus-group-is-exiting-without-update-p)
             (gnus-check-backend-function
              'request-expire-articles gnus-newsgroup-name))
@@ -10287,8 +10293,8 @@
        ;; Prettify the article buffer again.
        (unless no-highlight
          (with-current-buffer gnus-article-buffer
-           ;;;!!! Fix this -- article should be rehighlighted.
-           ;;;(gnus-run-hooks 'gnus-article-display-hook)
+           ;;!!! Fix this -- article should be rehighlighted.
+            ;;(gnus-run-hooks 'gnus-article-display-hook)
            (set-buffer gnus-original-article-buffer)
            (gnus-request-article
             (cdr gnus-article-current)
@@ -10450,8 +10456,8 @@
       (set var (cons article (symbol-value var)))
       (if (memq type '(processable cached replied forwarded recent saved))
          (gnus-summary-update-secondary-mark article)
-       ;;; !!! This is bogus.  We should find out what primary
-       ;;; !!! mark we want to set.
+       ;; !!! This is bogus.  We should find out what primary
+       ;; !!! mark we want to set.
        (gnus-summary-update-mark gnus-del-mark 'unread)))))
 
 (defun gnus-summary-mark-as-expirable (n)
@@ -11281,26 +11287,25 @@
 (defun gnus-summary-show-all-threads ()
   "Show all threads."
   (interactive)
-  (save-excursion
-    (let ((buffer-read-only nil))
-      (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
+  (remove-overlays (point-min) (point-max) 'invisible 'gnus-sum)
   (gnus-summary-position-point))
 
 (defun gnus-summary-show-thread ()
   "Show thread subtrees.
 Returns nil if no thread was there to be shown."
   (interactive)
-  (let ((buffer-read-only nil)
-       (orig (point))
+  (let* ((orig (point))
        (end (point-at-eol))
        ;; Leave point at bol
-       (beg (progn (beginning-of-line) (point))))
-    (prog1
-       ;; Any hidden lines here?
-       (search-forward "\r" end t)
-      (subst-char-in-region beg end ?\^M ?\n t)
+         (beg (progn (beginning-of-line) (if (bobp) (point) (1- (point)))))
+         (eoi (when (eq (get-char-property end 'invisible) 'gnus-sum)
+                (or (next-single-char-property-change end 'invisible)
+                    (point-max)))))
+    (when eoi
+      (remove-overlays beg eoi 'invisible 'gnus-sum)
       (goto-char orig)
-      (gnus-summary-position-point))))
+      (gnus-summary-position-point)
+      eoi)))
 
 (defun gnus-summary-maybe-hide-threads ()
   "If requested, hide the threads that should be hidden."
@@ -11349,22 +11354,26 @@
 will not be hidden.
 Returns nil if no threads were there to be hidden."
   (interactive)
-  (let ((buffer-read-only nil)
-       (start (point))
+  (let ((start (point))
+        (starteol (line-end-position))
        (article (gnus-summary-article-number)))
     (goto-char start)
     ;; Go forward until either the buffer ends or the subthread ends.
     (when (and (not (eobp))
               (or (zerop (gnus-summary-next-thread 1 t))
                   (goto-char (point-max))))
-      (prog1
          (if (and (> (point) start)
+               ;; FIXME: this should actually search for a non-invisible \n.
                   (search-backward "\n" start t))
              (progn
-               (subst-char-in-region start (point) ?\n ?\^M)
+            (when (> (point) starteol)
+              (remove-overlays starteol (point) 'invisible 'gnus-sum)
+              (let ((ol (make-overlay starteol (point) nil t nil)))
+                (overlay-put ol 'invisible 'gnus-sum)
+                (overlay-put ol 'evaporate t)))
                (gnus-summary-goto-subject article))
            (goto-char start)
-           nil)))))
+        nil))))
 
 (defun gnus-summary-go-to-next-thread (&optional previous)
   "Go to the same level (or less) next thread.
@@ -11854,8 +11863,12 @@
   (and (boundp group)
        (symbol-name group)
        (symbol-value group)
+       ;; It seems that we may get spurious old groups which do not
+       ;; correspond to any server any more and for which the returned method
+       ;; is invalid (like (nil "")) and causes an error in gnus-get-function.
+       (ignore-errors
        (gnus-get-function (gnus-find-method-for-group
-                          (symbol-name group)) 'request-accept-article t)))
+                             (symbol-name group)) 'request-accept-article t))))
 
 (defun gnus-read-move-group-name (prompt default articles prefix)
   "Read a group name."