X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnndoc.el;h=764f085e6a7239fd76a05e2ec4480ab2ed1d6104;hb=e380078b088aae5d92e9279997009dd6396129b2;hp=cedeb230bb68fc50ea1dff5de42a6eac05ef5b29;hpb=5a62f756a9f1e8841d11eb55029fbcc3c373e4b5;p=gnus diff --git a/lisp/nndoc.el b/lisp/nndoc.el index cedeb230b..764f085e6 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -1,9 +1,10 @@ ;;; nndoc.el --- single file access for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 -;; Free Software Foundation, Inc. + +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA +;; Masanobu UMEDA ;; Keywords: news ;; This file is part of GNU Emacs. @@ -20,8 +21,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -58,9 +59,16 @@ from the document.") `((mmdf (article-begin . "^\^A\^A\^A\^A\n") (body-end . "^\^A\^A\^A\^A\n")) - (exim-bounce - (article-begin . "^------ This is a copy of the message, including all the headers. ------\n\n") - (body-end-function . nndoc-exim-bounce-body-end-function)) + (mime-digest + (article-begin . "") + (head-begin . "^ ?\n") + (head-end . "^ ?$") + (body-end . "") + (file-end . "") + (subtype digest guess)) + (mime-parts + (generate-head-function . nndoc-generate-mime-parts-head) + (article-transform-function . nndoc-transform-mime-parts)) (nsmail (article-begin . "^From - ")) (news @@ -76,6 +84,9 @@ from the document.") (body-end . "\^_") (body-begin-function . nndoc-babyl-body-begin) (head-begin-function . nndoc-babyl-head-begin)) + (exim-bounce + (article-begin . "^------ This is a copy of the message, including all the headers. ------\n\n") + (body-end-function . nndoc-exim-bounce-body-end-function)) (rfc934 (article-begin . "^--.*\n+") (body-end . "^--.*$") @@ -91,16 +102,7 @@ from the document.") (head-end . "^\t") (generate-head-function . nndoc-generate-clari-briefs-head) (article-transform-function . nndoc-transform-clari-briefs)) - (mime-digest - (article-begin . "") - (head-begin . "^ ?\n") - (head-end . "^ ?$") - (body-end . "") - (file-end . "") - (subtype digest guess)) - (mime-parts - (generate-head-function . nndoc-generate-mime-parts-head) - (article-transform-function . nndoc-transform-mime-parts)) + (standard-digest (first-article . ,(concat "^" (make-string 70 ?-) "\n *\n+")) (article-begin . ,(concat "^\n" (make-string 30 ?-) "\n *\n+")) @@ -123,14 +125,16 @@ from the document.") (head-begin . "^Paper.*:") (head-end . "\\(^\\\\\\\\.*\n\\|-----------------\\)") (body-begin . "") - (body-end . "-------------------------------------------------") - (file-end . "^Title: Recent Seminal") + (body-end . "\\(-------------------------------------------------\\|%-%-%-%-%-%-%-%-%-%-%-%-%-%-\\|%%--%%--%%--%%--%%--%%--%%--%%--\\|%%%---%%%---%%%---%%%---\\)") + (file-end . "\\(^Title: Recent Seminal\\|%%%---%%%---%%%---%%%---\\)") (generate-head-function . nndoc-generate-lanl-gov-head) (article-transform-function . nndoc-transform-lanl-gov-announce) (subtype preprints guess)) (rfc822-forward - (article-begin . "^\n") - (body-end-function . nndoc-rfc822-forward-body-end-function)) + (article-begin . "^\n+") + (body-end-function . nndoc-rfc822-forward-body-end-function) + (generate-head-function . nndoc-rfc822-forward-generate-head) + (generate-article-function . nndoc-rfc822-forward-generate-article)) (outlook (article-begin-function . nndoc-outlook-article-begin) (body-end . "\0")) @@ -234,7 +238,7 @@ from the document.") (set-buffer buffer) (erase-buffer) (when entry - (cond + (cond ((stringp article) nil) (nndoc-generate-article-function (funcall nndoc-generate-article-function article)) @@ -393,7 +397,7 @@ from the document.") (error "Document is not of any recognized type")) (if result (car entry) - (cadar (sort results 'car-less-than-car))))) + (cadar (last (sort results 'car-less-than-car)))))) ;;; ;;; Built-in type predicates and functions @@ -418,7 +422,7 @@ from the document.") (search-forward "\n\n" beg t) (re-search-backward "^Content-Length:[ \t]*\\([0-9]+\\) *$" end t) - (setq len (string-to-int (match-string 1))) + (setq len (string-to-number (match-string 1))) (search-forward "\n\n" beg t) (unless (= (setq len (+ (point) len)) (point-max)) (and (< len (point-max)) @@ -441,7 +445,7 @@ from the document.") (defun nndoc-rnews-body-end () (and (re-search-backward nndoc-article-begin nil t) (forward-line 1) - (goto-char (+ (point) (string-to-int (match-string 1)))))) + (goto-char (+ (point) (string-to-number (match-string 1)))))) (defun nndoc-babyl-type-p () (when (re-search-forward "\^_\^L *\n" nil t) @@ -468,7 +472,7 @@ from the document.") (defun nndoc-forward-type-p () (when (and (re-search-forward "^-+ \\(Start of \\)?forwarded message.*\n+" nil t) - (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:")) + (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:\\|^>?From ")) t)) (defun nndoc-rfc934-type-p () @@ -491,6 +495,29 @@ from the document.") (defun nndoc-rfc822-forward-body-end-function () (goto-char (point-max))) +(defun nndoc-rfc822-forward-generate-article (article &optional head) + (let ((entry (cdr (assq article nndoc-dissection-alist))) + (begin (point)) + encoding) + (with-current-buffer nndoc-current-buffer + (save-restriction + (message-narrow-to-head) + (setq encoding (message-fetch-field "content-transfer-encoding")))) + (insert-buffer-substring nndoc-current-buffer (car entry) (nth 3 entry)) + (when encoding + (save-restriction + (narrow-to-region begin (point-max)) + (mm-decode-content-transfer-encoding + (intern (downcase (mail-header-strip encoding)))))) + (when head + (goto-char begin) + (when (search-forward "\n\n" nil t) + (delete-region (1- (point)) (point-max))))) + t) + +(defun nndoc-rfc822-forward-generate-head (article) + (nndoc-rfc822-forward-generate-article article 'head)) + (defun nndoc-mime-parts-type-p () (let ((case-fold-search t) (limit (search-forward "\n\n" nil t))) @@ -579,7 +606,7 @@ from the document.") (cons 'body-begin "^ ?\n") (cons 'article-begin b-delimiter) (cons 'body-end-function 'nndoc-digest-body-end) - (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$")))) + (cons 'file-end (concat "^--" boundary-id "--[ \t]*$")))) t))) (defun nndoc-standard-digest-type-p () @@ -597,35 +624,54 @@ from the document.") (defun nndoc-lanl-gov-announce-type-p () (when (let ((case-fold-search nil)) - (re-search-forward "^\\\\\\\\\nPaper: [a-z-]+/[0-9]+" nil t)) + (re-search-forward "^\\\\\\\\\nPaper\\( (\\*cross-listing\\*)\\)?: [a-zA-Z-\\.]+/[0-9]+" nil t)) t)) (defun nndoc-transform-lanl-gov-announce (article) (goto-char (point-max)) - (when (re-search-backward "^\\\\\\\\ +(\\([^ ]*\\) , *\\([^ ]*\\))" nil t) - (replace-match "\n\nGet it at \\1 (\\2)" t nil))) + (when (re-search-backward "^\\\\\\\\ +( *\\([^ ]*\\) , *\\([^ ]*\\))" nil t) + (replace-match "\n\nGet it at \\1 (\\2)" t nil)) + (goto-char (point-min)) + (while (re-search-forward "^\\\\\\\\$" nil t) + (replace-match "" t nil)) + (goto-char (point-min)) + (when (re-search-forward "^replaced with revised version +\\(.*[^ ]\\) +" nil t) + (replace-match "Date: \\1 (revised) " t nil)) + (goto-char (point-min)) + (unless (re-search-forward "^From" nil t) + (goto-char (point-min)) + (when (re-search-forward "^Authors?: \\(.*\\)" nil t) + (goto-char (point-min)) + (insert "From: " (match-string 1) "\n")))) (defun nndoc-generate-lanl-gov-head (article) (let ((entry (cdr (assq article nndoc-dissection-alist))) - (e-mail "no address given") - subject from) + (from "") + subject date) (save-excursion (set-buffer nndoc-current-buffer) (save-restriction - (narrow-to-region (car entry) (nth 1 entry)) - (goto-char (point-min)) - (when (looking-at "^Paper.*: \\([a-z-]+/[0-9]+\\)") - (setq subject (concat " (" (match-string 1) ")")) - (when (re-search-forward "^From: \\([^ ]+\\)" nil t) - (setq e-mail (match-string 1))) - (when (re-search-forward "^Title: \\([^\f]*\\)\nAuthors?: \\(.*\\)" - nil t) - (setq subject (concat (match-string 1) subject)) - (setq from (concat (match-string 2) " <" e-mail ">")))))) + (narrow-to-region (car entry) (nth 1 entry)) + (goto-char (point-min)) + (when (looking-at "^Paper.*: \\([a-zA-Z-\\.]+/[0-9]+\\)") + (setq subject (concat " (" (match-string 1) ")")) + (when (re-search-forward "^From: \\(.*\\)" nil t) + (setq from (concat "<" + (cadr (funcall gnus-extract-address-components + (match-string 1))) ">"))) + (if (re-search-forward "^Date: +\\([^(]*\\)" nil t) + (setq date (match-string 1)) + (when (re-search-forward "^replaced with revised version +\\([^(]*\\)" nil t) + (setq date (match-string 1)))) + (when (re-search-forward "^Title: \\([^\f]*\\)\nAuthors?: \\(.*\\)" + nil t) + (setq subject (concat (match-string 1) subject)) + (setq from (concat (match-string 2) " " from)))))) (while (and from (string-match "(\[^)\]*)" from)) (setq from (replace-match "" t t from))) (insert "From: " (or from "unknown") - "\nSubject: " (or subject "(no subject)") "\n"))) + "\nSubject: " (or subject "(no subject)") "\n") + (if date (insert "Date: " date)))) (defun nndoc-nsmail-type-p () (when (looking-at "From - ") @@ -706,14 +752,35 @@ from the document.") (nndoc-oe-dbx-generate-article article 'head)) (defun nndoc-mail-in-mail-type-p () - (save-excursion - (and (search-forward "\n\n" nil t) - (re-search-forward "^[-A-Za-z0-9]+: .*\n\\([ \t]?.*\n\\)*\\(^[-A-Za-z0-9]+: .*\n\\([ \t]?.*\n\\)*\\)+\n" nil t) - t))) + (let (found) + (save-excursion + (catch 'done + (while (re-search-forward "\n\n[-A-Za-z0-9]+:" nil t) + (setq found 0) + (forward-line) + (while (looking-at "[ \t]\\|[-A-Za-z0-9]+:") + (if (looking-at "[-A-Za-z0-9]+:") + (setq found (1+ found))) + (forward-line)) + (if (and (> found 0) (looking-at "\n")) + (throw 'done 9999))) + nil)))) (defun nndoc-mail-in-mail-article-begin () - (when (re-search-forward "^[-A-Za-z0-9]+: .*\n\\([ \t]?.*\n\\)*\\(^[-A-Za-z0-9]+: .*\n\\([ \t]?.*\n\\)*\\)+\n" nil t) - (goto-char (match-beginning 0)))) + (let (point found) + (if (catch 'done + (while (re-search-forward "\n\n\\([-A-Za-z0-9]+:\\)" nil t) + (setq found 0) + (setq point (match-beginning 1)) + (forward-line) + (while (looking-at "[ \t]\\|[-A-Za-z0-9]+:") + (if (looking-at "[-A-Za-z0-9]+:") + (setq found (1+ found))) + (forward-line)) + (if (and (> found 0) (looking-at "\n")) + (throw 'done t))) + nil) + (goto-char point)))) (deffoo nndoc-request-accept-article (group &optional server last) nil) @@ -731,7 +798,7 @@ from the document.") "Go through the document and partition it into heads/bodies/articles." (let ((i 0) (first t) - head-begin head-end body-begin body-end) + art-begin head-begin head-end body-begin body-end) (setq nndoc-dissection-alist nil) (save-excursion (set-buffer nndoc-current-buffer) @@ -747,8 +814,11 @@ from the document.") ;; Go through the file. (while (if (and first nndoc-first-article) (nndoc-search nndoc-first-article) - (nndoc-article-begin)) - (setq first nil) + (if art-begin + (goto-char art-begin) + (nndoc-article-begin))) + (setq first nil + art-begin nil) (cond (nndoc-head-begin-function (funcall nndoc-head-begin-function)) (nndoc-head-begin @@ -768,7 +838,8 @@ from the document.") (funcall nndoc-body-end-function)) (and nndoc-body-end (nndoc-search nndoc-body-end)) - (nndoc-article-begin) + (and (nndoc-article-begin) + (setq art-begin (point))) (progn (goto-char (point-max)) (when nndoc-file-end @@ -850,8 +921,12 @@ PARENT is the message-ID of the parent summary line, or nil for none." subtype "plain")) ;; Prepare the article and summary inserts. (unless article-insert - (setq article-insert (buffer-substring (point-min) (point-max)) + (setq article-insert (buffer-string) head-end head-begin)) + ;; Fix MIME-Version + (unless (string-match "MIME-Version:" article-insert) + (setq article-insert + (concat article-insert "MIME-Version: 1.0\n"))) (setq summary-insert article-insert) ;; - summary Subject. (setq summary-insert @@ -949,4 +1024,5 @@ symbol in the alist." (provide 'nndoc) +;;; arch-tag: f5c2970e-0387-47ac-a0b3-6cc317dffabe ;;; nndoc.el ends here