[PATCH] Hide headers using narrowing

[Romain Francoise <romain@orebokech.com>]

[-- Attachment #1: Type: text/plain, Size: 1202 bytes --]

Hi,

This patch has been waiting for No Gnus for months: it makes Message use
narrowing to hide headers, by moving them to the very top of the message
buffer, and narrowing to the region underneath.  This approach will most
probably be less fragile than the current one which uses the `invisible'
text property.

To make raw messages look less funky, I've also made it sort the headers
before sending the message, maybe it's not 100% necessary, but it seemed
cleaner this way.  The proposed ChangeLog entry follows.  (And I do have
papers on file for Gnus.)

2004-01-11  Romain Francoise  <romain@orebokech.com>

	* message.el (message-header-format-alist): Add `From' in list
	so that it can be sorted.
	(message-hide-headers): Use narrowing to hide headers by moving
	them to the top of the buffer and narrowing to the region
	underneath.
	(message-fix-before-sending): Widen and sort headers before
	sending.
	(message-strip-forbidden-properties): Remove check for obsolete
	`message-hidden' text property, hidden headers are not
	accessible in the buffer anymore.

-- 
Romain Francoise <romain@orebokech.com> | Shine the headlight, straight
it's a miracle -- http://orebokech.com/ | into my eyes.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Hide headers using narrowing --]
[-- Type: text/x-patch, Size: 2815 bytes --]

Index: lisp/message.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/message.el,v
retrieving revision 7.3
diff -u -r7.3 message.el
--- lisp/message.el	7 Jan 2004 17:47:39 -0000	7.3
+++ lisp/message.el	11 Jan 2004 11:31:56 -0000
@@ -1490,7 +1490,8 @@
   "A regexp that matches the separator before the text of a failed message.")
 
 (defvar message-header-format-alist
-  `((Newsgroups)
+  `((From)
+    (Newsgroups)
     (To . message-fill-address)
     (Cc . message-fill-address)
     (Subject)
@@ -2108,7 +2109,8 @@
 	 10000))))
 
 (defun message-sort-headers ()
-  "Sort the headers of the current message according to `message-header-format-alist'."
+  "Sort the headers of the current message according to
+`message-header-format-alist'."
   (interactive)
   (save-excursion
     (save-restriction
@@ -2372,9 +2374,8 @@
   (when (and message-strip-special-text-properties
 	     (message-tamago-not-in-use-p begin))
     (while (not (= begin end))
-      (when (not (get-text-property begin 'message-hidden))
-	(remove-text-properties begin (1+ begin)
-				message-forbidden-properties))
+      (remove-text-properties begin (1+ begin)
+			       message-forbidden-properties)
       (incf begin))))
 
 ;;;###autoload
@@ -3470,12 +3471,9 @@
   (unless (bolp)
     (insert "\n"))
   ;; Make the hidden headers visible.
-  (let ((points (message-text-with-property 'message-hidden)))
-    (when points
-      (goto-char (car points))
-      (dolist (point points)
-	(add-text-properties point (1+ point)
-			     '(invisible nil intangible nil)))))
+  (widen)
+  ;; Sort headers before sending the message.
+  (message-sort-headers)
   ;; Make invisible text visible.
   ;; It doesn't seem as if this is useful, since the invisible property
   ;; is clobbered by an after-change hook anyhow.
@@ -6804,7 +6802,8 @@
 		     (list message-hidden-headers)
 		   message-hidden-headers))
 	(inhibit-point-motion-hooks t)
-	(after-change-functions nil))
+	(after-change-functions nil)
+	(end-of-headers 0))
     (when regexps
       (save-excursion
 	(save-restriction
@@ -6813,11 +6812,17 @@
 	  (while (not (eobp))
 	    (if (not (message-hide-header-p regexps))
 		(message-next-header)
-	      (let ((begin (point)))
+	      (let ((begin (point))
+		    header header-len)
 		(message-next-header)
-		(add-text-properties
-		 begin (point)
-		 '(invisible t message-hidden t))))))))))
+		(setq header (buffer-substring begin (point))
+		      header-len (- (point) begin))
+		(delete-region begin (point))
+		(goto-char (1+ end-of-headers))
+		(insert header)
+		(setq end-of-headers
+		      (+ end-of-headers header-len))))))))
+    (narrow-to-region (1+ end-of-headers) (point-max))))
 
 (defun message-hide-header-p (regexps)
   (let ((result nil)