(nnshimbun-header-xref): Removed.
authortsuchiya <tsuchiya>
Wed, 30 May 2001 15:55:52 +0000 (15:55 +0000)
committertsuchiya <tsuchiya>
Wed, 30 May 2001 15:55:52 +0000 (15:55 +0000)
(nnshimbun-check-header): Removed.
(nnshimbun-make-shimbun-header): Don't call
`nnshimbun-header-xref'.
(nnshimbun-request-group): Simplified.
(nnshimbun-request-article-1): Call `nnshimbun-replace-nov-entry'
instead of `nnshimbun-check-header'.
(nnshimbun-insert-nov): New function.
(nnshimbun-generate-nov-database): Call `nnshimbun-insert-nov'
instead of `nnheader-insert-nov'.
(nnshimbun-replace-nov-entry): New function.

ChangeLog
lisp/nnshimbun.el

index 774ff3d..ca05aa6 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2001-05-31  TSUCHIYA Masatoshi  <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+
+       * lisp/nnshimbun.el (nnshimbun-header-xref): Removed.
+       (nnshimbun-check-header): Removed.
+       (nnshimbun-make-shimbun-header): Don't call
+       `nnshimbun-header-xref'.
+       (nnshimbun-request-group): Simplified.
+       (nnshimbun-request-article-1): Call `nnshimbun-replace-nov-entry'
+       instead of `nnshimbun-check-header'.
+       (nnshimbun-insert-nov): New function.
+       (nnshimbun-generate-nov-database): Call `nnshimbun-insert-nov'
+       instead of `nnheader-insert-nov'.
+       (nnshimbun-replace-nov-entry): New function.
+
 2001-05-29  Katsumi Yamaoka <yamaoka@jpl.org>
 
        * lisp/gnus-clfns.el (find-cl-run-time-functions): Add a parser for
index 1102691..3c48b1a 100644 (file)
   (nnoo-close-server 'nnshimbun server)
   t)
 
-(defsubst nnshimbun-header-xref (x)
-  (if (and (setq x (mail-header-xref x))
-          (string-match "^Xref: " x))
-      (substring x 6)
-    x))
-
 (eval-and-compile
   (let ((Gnus-p
         (eval-when-compile
    (mail-header-references header)
    (mail-header-chars header)
    (mail-header-lines header)
-   (nnshimbun-header-xref header)))
-
-(defsubst nnshimbun-check-header (group header)
-  (let (flag)
-    ;; Check message-id.
-    (let ((id (std11-field-body "message-id")))
-      (when (and id (not (string= id (mail-header-id header))))
-       (let ((extra (mail-header-extra header)))
-         (unless (assq 'X-Nnshimbun-Id extra)
-           (push (cons 'X-Nnshimbun-Id (mail-header-id header)) extra)
-           (mail-header-set-extra header extra)))
-       (mail-header-set-id header id)
-       (setq flag t)))
-    ;; Check references.
-    (when (string= "" (mail-header-references header))
-      (let ((refs (std11-field-body "references")))
-       (when refs
-         (mail-header-set-references header (std11-unfold-string refs))))
-      (setq flag t))
-    (when flag
-      ;; Replace header.
-      (with-current-buffer (nnshimbun-open-nov group)
-       (when (nnheader-find-nov-line (mail-header-number header))
-         (mail-header-set-xref header (nnshimbun-header-xref header))
-         (delete-region (point) (progn (forward-line 1) (point)))
-         (nnheader-insert-nov header))))))
+   (let ((xref (mail-header-xref header)))
+     (if (and xref (string-match "^Xref: " xref))
+        (substring xref 6)
+       xref))))
 
 (defun nnshimbun-request-article-1 (article &optional group server to-buffer)
   (if (nnshimbun-backlog
        (gnus-backlog-request-article
         group article (or to-buffer nntp-server-buffer)))
       (cons group article)
-    (let ((header (with-current-buffer (nnshimbun-open-nov group)
-                   (and (nnheader-find-nov-line article)
-                        (nnheader-parse-nov)))))
+    (let* ((header (with-current-buffer (nnshimbun-open-nov group)
+                    (and (nnheader-find-nov-line article)
+                         (nnshimbun-make-shimbun-header
+                          (nnheader-parse-nov)))))
+          (original-id (shimbun-header-id header)))
       (when header
        (with-current-buffer (or to-buffer nntp-server-buffer)
          (delete-region (point-min) (point-max))
-         (shimbun-article nnshimbun-shimbun
-                          (nnshimbun-make-shimbun-header header))
+         (shimbun-article nnshimbun-shimbun header)
          (when (> (buffer-size) 0)
-           (nnshimbun-check-header group header)
+           (nnshimbun-replace-nov-entry group article header original-id)
            (nnshimbun-backlog
              (gnus-backlog-enter-article group article (current-buffer)))
            (nnheader-report 'nnshimbun "Article %s retrieved"
-                            (mail-header-id header))
-           (cons group (mail-header-number header))))))))
+                            (shimbun-header-id header))
+           (cons group article)))))))
 
 (deffoo nnshimbun-request-article (article &optional group server to-buffer)
   (when (nnshimbun-possibly-change-group group server)
       t)
      (t
       (let (beg end lines)
-       (save-excursion
-         (set-buffer (nnshimbun-open-nov group))
+       (with-current-buffer (nnshimbun-open-nov group)
          (goto-char (point-min))
          (setq beg (ignore-errors (read (current-buffer))))
          (goto-char (point-max))
 
 ;;; Nov Database Operations
 
+(defsubst nnshimbun-insert-nov (number header &optional id)
+  (unless (and (stringp id)
+              (not (string= id (shimbun-header-id header))))
+    (setq id nil))
+  (princ number (current-buffer))
+  (let ((p (point)))
+    (insert
+     "\t"
+     (or (shimbun-header-subject header) "(none)") "\t"
+     (or (shimbun-header-from header) "(nobody)") "\t"
+     (or (shimbun-header-date header) "") "\t"
+     (or (shimbun-header-id header) (nnmail-message-id)) "\t"
+     (or (shimbun-header-references header) "") "\t")
+    (princ (or (shimbun-header-chars header) 0) (current-buffer))
+    (insert "\t")
+    (princ (or (shimbun-header-lines header) 0) (current-buffer))
+    (insert "\t")
+    (when (shimbun-header-xref header)
+      (insert "Xref: " (shimbun-header-xref header)))
+    (when (or (shimbun-header-xref header) id)
+      (insert "\t"))
+    (when id
+      (insert "X-Nnshimbun-Id: " id "\t"))
+    (insert "\n")
+    (backward-char 1)
+    (while (search-backward "\n" p t)
+      (delete-char 1))
+    (forward-line 1)))
+
 (defun nnshimbun-generate-nov-database (group)
   (nnshimbun-possibly-change-group group)
-  (let (i)
   (with-current-buffer (nnshimbun-open-nov group)
     (goto-char (point-max))
     (forward-line -1)
-    (setq i (or (ignore-errors (read (current-buffer))) 0))
-    (dolist (header (shimbun-headers nnshimbun-shimbun))
-      (unless (nnshimbun-search-id group (shimbun-header-id header))
-       (goto-char (point-max))
-       (nnheader-insert-nov
-        (make-full-mail-header (setq i (1+ i))
-                               (shimbun-header-subject header)
-                               (shimbun-header-from header)
-                               (shimbun-header-date header)
-                               (shimbun-header-id header)
-                               (shimbun-header-references header)
-                               (shimbun-header-chars header)
-                               (shimbun-header-lines header)
-                               (shimbun-header-xref header)))
-       (if nnshimbun-pre-fetch-article
+    (let ((i (or (ignore-errors (read (current-buffer))) 0)))
+      (dolist (header (shimbun-headers nnshimbun-shimbun))
+       (unless (nnshimbun-search-id group (shimbun-header-id header))
+         (goto-char (point-max))
+         (nnshimbun-insert-nov (setq i (1+ i)) header)
+         (when nnshimbun-pre-fetch-article
            (nnshimbun-request-article-1 i group nil nnshimbun-buffer)))))
   (nnshimbun-write-nov group)))
 
+(defun nnshimbun-replace-nov-entry (group article header &optional id)
+  (with-current-buffer (nnshimbun-open-nov group)
+    (when (nnheader-find-nov-line article)
+      (delete-region (point) (progn (forward-line 1) (point)))
+      (nnshimbun-insert-nov article header id))))
+
 (defun nnshimbun-search-id (group id &optional nov)
   (with-current-buffer (nnshimbun-open-nov group)
     (goto-char (point-min))