From: morioka <morioka>
Date: Mon, 31 May 1999 10:51:51 +0000 (+0000)
Subject: Require `mmgnus'.
X-Git-Tag: last-sync-keiichi-chaos-1_13-~4
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=ccd572f5e3880aa2b0261c5732cabcb6e4252737;p=elisp%2Fgnus.git-

Require `mmgnus'.
(mail-header-subject): Now an alias for
`mime-gnus-entity-subject-internal'.
(mail-header-set-subject): Now an alias for
`mime-gnus-entity-set-subject-internal)'.
(mail-header-from): Now an alias for `mime-gnus-entity-from-internal'.
(mail-header-set-from): Now an alias for
`mime-gnus-entity-set-from-internal'.
(mail-header-date): Now an alias for `mime-gnus-entity-date-internal'.
(mail-header-set-date): Now an alias for
`mime-gnus-entity-set-date-internal'.
(mail-header-message-id): Now an alias for
`mime-gnus-entity-id-internal'.
(mail-header-id): Likewise.
(mail-header-set-message-id): Now an alias for
`mime-gnus-entity-set-id-internal'.
(mail-header-set-id): Likewise.
(mail-header-references): Now an alias for
`mime-gnus-entity-references-internal'.
(mail-header-set-references): Now an alias for
`mime-gnus-entity-set-references-internal'.
(mail-header-chars): Now an alias for
`mime-gnus-entity-chars-internal.
(mail-header-set-chars): Now an alias for
`mime-gnus-entity-set-chars-internal.
(mail-header-lines): Now an alias for
`mime-gnus-entity-lines-internal'.
(mail-header-set-lines): Now an alias for
`mime-gnus-entity-set-lines-internal'.
(mail-header-xref): Now an alias for `mime-gnus-entity-xref-internal'.
(mail-header-set-xref): Now an alias for
`mime-gnus-entity-set-xref-internal'.
(make-full-mail-header): New implementation [use `luna-make-entity'].
(make-full-mail-header-from-decoded-header): Likewise.
---

diff --git a/lisp/nnheader.el b/lisp/nnheader.el
index bc725b6..f0a86c2 100644
--- a/lisp/nnheader.el
+++ b/lisp/nnheader.el
@@ -1,9 +1,10 @@
-;;; nnheader.el --- header access macros for Gnus and its backends
-;; Copyright (C) 1987,88,89,90,93,94,95,96,97,98 Free Software Foundation, Inc.
+;;; nnheader.el --- header access macros for Chaos and its backends
+;; Copyright (C) 1987-1990,1993-1999 Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; 	Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news
+;;         Lars Magne Ingebrigtsen <larsi@gnus.org>
+;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: mail, news, MIME
 
 ;; This file is part of GNU Emacs.
 
@@ -40,6 +41,7 @@
 (eval-when-compile (require 'cl))
 
 (require 'mail-utils)
+(require 'mime)
 
 (defvar nnheader-max-head-length 4096
   "*Max length of the head of articles.")
@@ -49,7 +51,7 @@
 
 (defvar nnheader-file-name-translation-alist nil
   "*Alist that says how to translate characters in file names.
-For instance, if \":\" is illegal as a file character in file names
+For instance, if \":\" is invalid as a file character in file names
 on your system, you could say something like:
 
 \(setq nnheader-file-name-translation-alist '((?: . ?_)))")
@@ -66,88 +68,108 @@ on your system, you could say something like:
 
 ;;; Header access macros.
 
+(require 'mmgnus)
+
 (defmacro mail-header-number (header)
   "Return article number in HEADER."
-  `(aref ,header 0))
+  `(mime-entity-location-internal ,header))
 
 (defmacro mail-header-set-number (header number)
   "Set article number of HEADER to NUMBER."
-  `(aset ,header 0 ,number))
-
-(defmacro mail-header-subject (header)
-  "Return subject string in HEADER."
-  `(aref ,header 1))
-
-(defmacro mail-header-set-subject (header subject)
-  "Set article subject of HEADER to SUBJECT."
-  `(aset ,header 1 ,subject))
-
-(defmacro mail-header-from (header)
-  "Return author string in HEADER."
-  `(aref ,header 2))
-
-(defmacro mail-header-set-from (header from)
-  "Set article author of HEADER to FROM."
-  `(aset ,header 2 ,from))
-
-(defmacro mail-header-date (header)
-  "Return date in HEADER."
-  `(aref ,header 3))
-
-(defmacro mail-header-set-date (header date)
-  "Set article date of HEADER to DATE."
-  `(aset ,header 3 ,date))
+  `(mime-entity-set-location-internal ,header ,number))
 
-(defalias 'mail-header-message-id 'mail-header-id)
-(defmacro mail-header-id (header)
-  "Return Id in HEADER."
-  `(aref ,header 4))
+(defalias 'mail-header-subject 'mime-gnus-entity-subject-internal)
+(defalias 'mail-header-set-subject 'mime-gnus-entity-set-subject-internal)
 
-(defalias 'mail-header-set-message-id 'mail-header-set-id)
-(defmacro mail-header-set-id (header id)
-  "Set article Id of HEADER to ID."
-  `(aset ,header 4 ,id))
+(defalias 'mail-header-from 'mime-gnus-entity-from-internal)
+(defalias 'mail-header-set-from 'mime-gnus-entity-set-from-internal)
 
-(defmacro mail-header-references (header)
-  "Return references in HEADER."
-  `(aref ,header 5))
+(defalias 'mail-header-date 'mime-gnus-entity-date-internal)
+(defalias 'mail-header-set-date 'mime-gnus-entity-set-date-internal)
 
-(defmacro mail-header-set-references (header ref)
-  "Set article references of HEADER to REF."
-  `(aset ,header 5 ,ref))
+(defalias 'mail-header-message-id 'mime-gnus-entity-id-internal)
+(defalias 'mail-header-id 'mime-gnus-entity-id-internal)
+(defalias 'mail-header-set-message-id 'mime-gnus-entity-set-id-internal)
+(defalias 'mail-header-set-id 'mime-gnus-entity-set-id-internal)
 
-(defmacro mail-header-chars (header)
-  "Return number of chars of article in HEADER."
-  `(aref ,header 6))
+(defalias 'mail-header-references 'mime-gnus-entity-references-internal)
+(defalias 'mail-header-set-references
+  'mime-gnus-entity-set-references-internal)
 
-(defmacro mail-header-set-chars (header chars)
-  "Set number of chars in article of HEADER to CHARS."
-  `(aset ,header 6 ,chars))
+(defalias 'mail-header-chars 'mime-gnus-entity-chars-internal)
+(defalias 'mail-header-set-chars 'mime-gnus-entity-set-chars-internal)
 
-(defmacro mail-header-lines (header)
-  "Return lines in HEADER."
-  `(aref ,header 7))
+(defalias 'mail-header-lines 'mime-gnus-entity-lines-internal)
+(defalias 'mail-header-set-lines 'mime-gnus-entity-set-lines-internal)
 
-(defmacro mail-header-set-lines (header lines)
-  "Set article lines of HEADER to LINES."
-  `(aset ,header 7 ,lines))
+(defalias 'mail-header-xref 'mime-gnus-entity-xref-internal)
+(defalias 'mail-header-set-xref 'mime-gnus-entity-set-xref-internal)
 
-(defmacro mail-header-xref (header)
-  "Return xref string in HEADER."
-  `(aref ,header 8))
+(defalias 'nnheader-decode-subject
+  (mime-find-field-decoder 'Subject 'nov))
+(defalias 'nnheader-decode-from
+  (mime-find-field-decoder 'From 'nov))
 
-(defmacro mail-header-set-xref (header xref)
-  "Set article xref of HEADER to xref."
-  `(aset ,header 8 ,xref))
+(defsubst make-full-mail-header (&optional number subject from date id
+					   references chars lines xref)
+  "Create a new mail header structure initialized with the parameters given."
+  (luna-make-entity (mm-expand-class-name 'gnus)
+		    :location number
+		    :subject (if subject
+				 (nnheader-decode-subject subject))
+		    :from (if from
+			      (nnheader-decode-from from))
+		    :date date
+		    :id id
+		    :references references
+		    :chars chars
+		    :lines lines
+		    :xref xref
+		    :original-header (list (cons 'Subject subject)
+					   (cons 'From from)))
+  ;;(make-mime-entity-internal
+  ;; 'gnus number
+  ;; nil
+  ;; nil nil nil
+  ;;  (if subject
+  ;;      (nnheader-decode-subject subject)
+  ;;    )
+  ;;  (if from
+  ;;      (nnheader-decode-from from)
+  ;;    )
+  ;; date id references
+  ;; chars lines xref
+  ;;  (list (cons 'Subject subject)
+  ;;        (cons 'From from)))
+  )
+
+(defsubst make-full-mail-header-from-decoded-header
+  (&optional number subject from date id references chars lines xref)
+  "Create a new mail header structure initialized with the parameters given."
+  (luna-make-entity (mm-expand-class-name 'gnus)
+		    :location number
+		    :subject subject
+		    :from from
+		    :date date
+		    :id id
+		    :references references
+		    :chars chars
+		    :lines lines
+		    :xref xref)
+  ;;(make-mime-entity-internal
+  ;; 'gnus number
+  ;; nil
+  ;; nil nil nil
+  ;; subject
+  ;; from
+  ;; date id references
+  ;; chars lines xref)
+  )
 
 (defun make-mail-header (&optional init)
   "Create a new mail header structure initialized with INIT."
-  (make-vector 9 init))
-
-(defun make-full-mail-header (&optional number subject from date id
-					references chars lines xref)
-  "Create a new mail header structure initialized with the parameters given."
-  (vector number subject from date id references chars lines xref))
+  (make-full-mail-header init init init init init
+			 init init init init))
 
 ;; fake message-ids: generation and detection
 
@@ -183,7 +205,7 @@ on your system, you could say something like:
 	  ;; about twice as fast, even though it looks messier.	 You
 	  ;; can't have everything, I guess.  Speed and elegance
 	  ;; don't always go hand in hand.
-	  (vector
+	  (make-full-mail-header
 	   ;; Number.
 	   (if naked
 	       (progn
@@ -270,17 +292,18 @@ on your system, you could say something like:
 
 (defmacro nnheader-nov-read-integer ()
   '(prog1
-       (if (= (following-char) ?\t)
+       (if (eq (char-after) ?\t)
 	   0
 	 (let ((num (ignore-errors (read (current-buffer)))))
 	   (if (numberp num) num 0)))
-     (or (eobp) (forward-char 1))))
+     (unless (eobp)
+       (search-forward "\t" eol 'move))))
 
 ;; (defvar nnheader-none-counter 0)
 
 (defun nnheader-parse-nov ()
   (let ((eol (gnus-point-at-eol)))
-    (vector
+    (make-full-mail-header
      (nnheader-nov-read-integer)	; number
      (nnheader-nov-field)		; subject
      (nnheader-nov-field)		; from
@@ -290,7 +313,7 @@ on your system, you could say something like:
      (nnheader-nov-field)		; refs
      (nnheader-nov-read-integer)	; chars
      (nnheader-nov-read-integer)	; lines
-     (if (= (following-char) ?\n)
+     (if (eq (char-after) ?\n)
 	 nil
        (nnheader-nov-field))		; misc
      )))
@@ -299,8 +322,8 @@ on your system, you could say something like:
   (princ (mail-header-number header) (current-buffer))
   (insert
    "\t"
-   (or (mail-header-subject header) "(none)") "\t"
-   (or (mail-header-from header) "(nobody)") "\t"
+   (or (mime-fetch-field 'Subject header) "(none)") "\t"
+   (or (mime-fetch-field 'From header) "(nobody)") "\t"
    (or (mail-header-date header) "") "\t"
    (or (mail-header-id header)
        (nnmail-message-id))
@@ -382,6 +405,191 @@ the line could be found."
     (beginning-of-line)
     (eq num article)))
 
+(defun nnheader-retrieve-headers-from-directory* (articles
+						  directory dependencies
+						  &optional
+						  fetch-old force-new large
+						  backend)
+  (with-temp-buffer
+    (let* ((file nil)
+	   (number (length articles))
+	   (count 0)
+	   (pathname-coding-system 'binary)
+	   (case-fold-search t)
+	   (cur (current-buffer))
+	   article
+	   headers header id end ref in-reply-to lines chars ctype)
+      ;; We don't support fetching by Message-ID.
+      (if (stringp (car articles))
+	  'headers
+	(while articles
+	  (when (and (file-exists-p
+		      (setq file (expand-file-name
+				  (int-to-string
+				   (setq article (pop articles)))
+				  directory)))
+		     (not (file-directory-p file)))
+	    (erase-buffer)
+	    (nnheader-insert-head file)
+	    (save-restriction
+	      (std11-narrow-to-header)
+	      (setq
+	       header
+	       (make-full-mail-header
+		;; Number.
+		article
+		;; Subject.
+		(or (std11-fetch-field "Subject")
+		    "(none)")
+		;; From.
+		(or (std11-fetch-field "From")
+		    "(nobody)")
+		;; Date.
+		(or (std11-fetch-field "Date")
+		    "")
+		;; Message-ID.
+		(progn
+		  (goto-char (point-min))
+		  (setq id (if (re-search-forward
+				"^Message-ID: *\\(<[^\n\t> ]+>\\)" nil t)
+			       ;; We do it this way to make sure the Message-ID
+			       ;; is (somewhat) syntactically valid.
+			       (buffer-substring (match-beginning 1)
+						 (match-end 1))
+			     ;; If there was no message-id, we just fake one
+			     ;; to make subsequent routines simpler.
+			     (nnheader-generate-fake-message-id))))
+		;; References.
+		(progn
+		  (goto-char (point-min))
+		  (if (search-forward "\nReferences: " nil t)
+		      (progn
+			(setq end (point))
+			(prog1
+			    (buffer-substring (match-end 0) (std11-field-end))
+			  (setq ref
+				(buffer-substring
+				 (progn
+				   ;; (end-of-line)
+				   (search-backward ">" end t)
+				   (1+ (point)))
+				 (progn
+				   (search-backward "<" end t)
+				   (point))))))
+		    ;; Get the references from the in-reply-to header if there
+		    ;; were no references and the in-reply-to header looks
+		    ;; promising.
+		    (if (and (search-forward "\nIn-Reply-To: " nil t)
+			     (setq in-reply-to
+				   (buffer-substring (match-end 0)
+						     (std11-field-end)))
+			     (string-match "<[^>]+>" in-reply-to))
+			(let (ref2)
+			  (setq ref (substring in-reply-to (match-beginning 0)
+					       (match-end 0)))
+			  (while (string-match "<[^>]+>"
+					       in-reply-to (match-end 0))
+			    (setq ref2
+				  (substring in-reply-to (match-beginning 0)
+					     (match-end 0)))
+			    (when (> (length ref2) (length ref))
+			      (setq ref ref2)))
+			  ref)
+		      (setq ref nil))))
+		;; Chars.
+		(progn
+		  (goto-char (point-min))
+		  (if (search-forward "\nChars: " nil t)
+		      (if (numberp (setq chars (ignore-errors (read cur))))
+			  chars 0)
+		    0))
+		;; Lines.
+		(progn
+		  (goto-char (point-min))
+		  (if (search-forward "\nLines: " nil t)
+		      (if (numberp (setq lines (ignore-errors (read cur))))
+			  lines 0)
+		    0))
+		;; Xref.
+		(std11-fetch-field "Xref")
+		))
+	      (goto-char (point-min))
+	      (if (setq ctype (std11-fetch-field "Content-Type"))
+		  (mime-entity-set-content-type-internal
+		   header (mime-parse-Content-Type ctype)))
+	      )
+	    (when (setq header
+			(gnus-dependencies-add-header
+			 header dependencies force-new))
+	      (push header headers))
+	    )
+	  (setq count (1+ count))
+
+	  (and large
+	       (zerop (% count 20))
+	       (nnheader-message 5 "%s: Receiving headers... %d%%"
+				 backend
+				 (/ (* count 100) number))))
+
+	(when large
+	  (nnheader-message 5 "%s: Receiving headers...done" backend))
+
+	headers))))
+
+(defun nnheader-retrieve-headers-from-directory (articles
+						 directory dependencies
+						 &optional
+						 fetch-old force-new large
+						 backend)
+  (cons 'header
+	(nreverse (nnheader-retrieve-headers-from-directory*
+		   articles directory dependencies
+		   fetch-old force-new large backend))))
+
+(defun nnheader-get-newsgroup-headers-xover* (sequence
+					      &optional
+					      force-new dependencies
+					      group)
+  "Parse the news overview data in the server buffer, and return a
+list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
+  ;; Get the Xref when the users reads the articles since most/some
+  ;; NNTP servers do not include Xrefs when using XOVER.
+  ;; (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
+  (let ((cur nntp-server-buffer)
+	number headers header)
+    (save-excursion
+      (set-buffer nntp-server-buffer)
+      ;; Allow the user to mangle the headers before parsing them.
+      (gnus-run-hooks 'gnus-parse-headers-hook)
+      (goto-char (point-min))
+      (while (not (eobp))
+	(condition-case ()
+	    (while (and sequence (not (eobp)))
+	      (setq number (read cur))
+	      (while (and sequence
+			  (< (car sequence) number))
+		(setq sequence (cdr sequence)))
+	      (and sequence
+		   (eq number (car sequence))
+		   (progn
+		     (setq sequence (cdr sequence))
+		     (setq header (inline
+				    (gnus-nov-parse-line
+				     number dependencies force-new))))
+		   (push header headers))
+	      (forward-line 1))
+	  (error
+	   (gnus-error 4 "Strange nov line (%d)"
+		       (count-lines (point-min) (point)))))
+	(forward-line 1))
+      ;; A common bug in inn is that if you have posted an article and
+      ;; then retrieves the active file, it will answer correctly --
+      ;; the new article is included.  However, a NOV entry for the
+      ;; article may not have been generated yet, so this may fail.
+      ;; We work around this problem by retrieving the last few
+      ;; headers using HEAD.
+      headers)))
+
 ;; Various cruft the backends and Gnus need to communicate.
 
 (defvar nntp-server-buffer nil)
@@ -454,7 +662,8 @@ the line could be found."
 (defun nnheader-insert-references (references message-id)
   "Insert a References header based on REFERENCES and MESSAGE-ID."
   (if (and (not references) (not message-id))
-      ()				; This is illegal, but not all articles have Message-IDs.
+      ;; This is invalid, but not all articles have Message-IDs.
+      ()
     (mail-position-on-field "References")
     (let ((begin (save-excursion (beginning-of-line) (point)))
 	  (fill-column 78)