Gnus development mailing list
 help / color / mirror / Atom feed
* [PATCH] Hide headers using narrowing
@ 2004-01-11 12:45 Romain Francoise
  2004-11-22 20:50 ` Romain Francoise
  0 siblings, 1 reply; 20+ messages in thread
From: Romain Francoise @ 2004-01-11 12:45 UTC (permalink / raw)


[-- 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)

^ permalink raw reply	[flat|nested] 20+ messages in thread
end of thread, other threads:[~2006-04-15 12:34 UTC | newest]

Thread overview: 20+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2004-01-11 12:45 [PATCH] Hide headers using narrowing Romain Francoise
2004-11-22 20:50 ` Romain Francoise
2004-11-23  0:18   ` Katsumi Yamaoka
2004-11-23 11:21     ` Romain Francoise
2004-11-23 12:55       ` Katsumi Yamaoka
2004-11-23 13:39         ` Romain Francoise
2004-11-23 14:49           ` Reiner Steib
2004-11-23 15:41             ` Romain Francoise
2004-11-23 16:35               ` Reiner Steib
2004-11-25  0:39                 ` Katsumi Yamaoka
2004-11-25 12:46                   ` Katsumi Yamaoka
2004-11-25 13:18                     ` Ralf Angeli
2004-11-25 13:36                       ` Romain Francoise
2004-11-25 15:33                         ` Katsumi Yamaoka
2004-11-25 23:23                           ` Katsumi Yamaoka
2004-11-25 23:47                             ` Katsumi Yamaoka
2006-04-15 12:34                       ` Lars Magne Ingebrigtsen
2004-11-25 13:32                     ` Romain Francoise
2005-01-02 18:45                       ` Romain Francoise
2005-01-02 23:33                         ` Katsumi Yamaoka

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).