From: morioka <morioka>
Date: Sat, 30 Jan 1999 04:48:11 +0000 (+0000)
Subject: (nnheader-retrieve-headers-from-directory): New function.
X-Git-Tag: chaos-1_12-199901301900~3
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=297bf9cc46f9d9bf0ad0770ef1d050f3d699f3cf;p=elisp%2Fgnus.git-

(nnheader-retrieve-headers-from-directory): New function.
---

diff --git a/lisp/nnheader.el b/lisp/nnheader.el
index 875da91..5d6c4cb 100644
--- a/lisp/nnheader.el
+++ b/lisp/nnheader.el
@@ -376,6 +376,139 @@ 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))
+
+        ;; (nnheader-fold-continuation-lines)
+	(cons 'header (nreverse headers))
+	))))
+
 ;; Various cruft the backends and Gnus need to communicate.
 
 (defvar nntp-server-buffer nil)