comparison lisp/gnus/nndoc.el @ 88155:d7ddb3e565de

sync with trunk

88154:8ce476d3ba36

;;; nndoc.el --- single file access for Gnus
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
;;        Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <[e-mail]>
;;	Masanobu UMEDA <[e-mail]>
;; Keywords: news

;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; 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.

;;; Commentary:

;; For Outlook mail boxes format, see http://mbx2mbox.sourceforge.net/

(defvar nndoc-type-alist
  `((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))
    (nsmail
     (article-begin .  "^From - "))
    (news
     (article-begin . "^Path:"))
    (rnews

    (babyl
     (article-begin . "\^_\^L *\n")
     (body-end . "\^_")
     (body-begin-function . nndoc-babyl-body-begin)
     (head-begin-function . nndoc-babyl-head-begin))
    (rfc934
     (article-begin . "^--.*\n+")
     (body-end . "^--.*$")
     (prepare-body-function . nndoc-unquote-dashes))
    (mailman

     (body-end . "^\t------*[ \t]^*\n^ \\*")
     (body-begin . "^\t")
     (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+"))
     (prepare-body-function . nndoc-unquote-dashes)
     (body-end-function . nndoc-digest-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))
    (outlook
     (article-begin-function . nndoc-outlook-article-begin)
     (body-end .  "\0"))
    (oe-dbx  ;; Outlook Express DBX format
     (dissection-function . nndoc-oe-dbx-dissection)

	  (setq result nil))))
    (unless (or result results)
      (error "Document is not of any recognized type"))
    (if result
	(car entry)
      (cadar (sort results 'car-less-than-car)))))

;;;
;;; Built-in type predicates and functions
;;;

		(concat "^" message-unix-mail-delimiter) nil t)
	       (setq end (point))
	       (search-forward "\n\n" beg t)
	       (re-search-backward
		"^Content-Length:[ \t]*\\([0-9]+\\) *$" end t)
	       (setq len (string-to-int (match-string 1)))
	       (search-forward "\n\n" beg t)
	       (unless (= (setq len (+ (point) len)) (point-max))
		 (and (< len (point-max))
		      (goto-char len)
		      (looking-at message-unix-mail-delimiter)))))

    t))

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

(defun nndoc-babyl-type-p ()
  (when (re-search-forward "\^_\^L *\n" nil t)
    t))

    t))

(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-]*:"))
    t))

(defun nndoc-rfc934-type-p ()
  (when (and (re-search-forward "^-+ Start of forwarded.*\n+" nil t)
	     (not (re-search-forward "^Subject:.*digest" nil t))

    (when (re-search-forward "^Content-Type: *message/rfc822" nil t)
      t)))

(defun nndoc-rfc822-forward-body-end-function ()
  (goto-char (point-max)))

(defun nndoc-mime-parts-type-p ()
  (let ((case-fold-search t)
	(limit (search-forward "\n\n" nil t)))
    (goto-char (point-min))

(defun nndoc-dissect-buffer ()
  "Go through the document and partition it into heads/bodies/articles."
  (let ((i 0)
	(first t)
	head-begin head-end body-begin body-end)
    (setq nndoc-dissection-alist nil)
    (save-excursion
      (set-buffer nndoc-current-buffer)
      (goto-char (point-min))
      ;; Remove blank lines.

	(when nndoc-file-begin
	  (nndoc-search nndoc-file-begin))
	;; Go through the file.
	(while (if (and first nndoc-first-article)
		   (nndoc-search nndoc-first-article)
		 (nndoc-article-begin))
	  (setq first nil)
	  (cond (nndoc-head-begin-function
		 (funcall nndoc-head-begin-function))
		(nndoc-head-begin
		 (nndoc-search nndoc-head-begin)))
	  (if (or (eobp)

	    (setq body-begin (point))
	    (or (and nndoc-body-end-function
		     (funcall nndoc-body-end-function))
		(and nndoc-body-end
		     (nndoc-search nndoc-body-end))
		(nndoc-article-begin)
		(progn
		  (goto-char (point-max))
		  (when nndoc-file-end
		    (and (re-search-backward nndoc-file-end nil t)
			 (beginning-of-line)))))

    (unless type
      (setq type "text"
	    subtype "plain"))
    ;; Prepare the article and summary inserts.
    (unless article-insert
      (setq article-insert (buffer-substring (point-min) (point-max))
	    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")))

	(error "No such position: %s" position))
      (setcdr list (cons definition (cdr list)))))))

(provide 'nndoc)

;;; nndoc.el ends here

88155:d7ddb3e565de

;;; nndoc.el --- single file access for Gnus

;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
;;   2004, 2005 Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <[e-mail]>
;;	Masanobu UMEDA <[e-mail]>
;; Keywords: news

;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; 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., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; For Outlook mail boxes format, see http://mbx2mbox.sourceforge.net/

(defvar nndoc-type-alist
  `((mmdf
     (article-begin .  "^\^A\^A\^A\^A\n")
     (body-end .  "^\^A\^A\^A\^A\n"))
    (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
     (article-begin . "^Path:"))
    (rnews

    (babyl
     (article-begin . "\^_\^L *\n")
     (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 . "^--.*$")
     (prepare-body-function . nndoc-unquote-dashes))
    (mailman

     (body-end . "^\t------*[ \t]^*\n^ \\*")
     (body-begin . "^\t")
     (head-end . "^\t")
     (generate-head-function . nndoc-generate-clari-briefs-head)
     (article-transform-function . nndoc-transform-clari-briefs))
    
    (standard-digest
     (first-article . ,(concat "^" (make-string 70 ?-) "\n *\n+"))
     (article-begin . ,(concat "^\n" (make-string 30 ?-) "\n *\n+"))
     (prepare-body-function . nndoc-unquote-dashes)
     (body-end-function . nndoc-digest-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)
     (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"))
    (oe-dbx  ;; Outlook Express DBX format
     (dissection-function . nndoc-oe-dbx-dissection)

	  (setq result nil))))
    (unless (or result results)
      (error "Document is not of any recognized type"))
    (if result
	(car entry)
      (cadar (last (sort results 'car-less-than-car))))))

;;;
;;; Built-in type predicates and functions
;;;

		(concat "^" message-unix-mail-delimiter) nil t)
	       (setq end (point))
	       (search-forward "\n\n" beg t)
	       (re-search-backward
		"^Content-Length:[ \t]*\\([0-9]+\\) *$" end t)
	       (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))
		      (goto-char len)
		      (looking-at message-unix-mail-delimiter)))))

    t))

(defun nndoc-rnews-body-end ()
  (and (re-search-backward nndoc-article-begin nil t)
       (forward-line 1)
       (goto-char (+ (point) (string-to-number (match-string 1))))))

(defun nndoc-babyl-type-p ()
  (when (re-search-forward "\^_\^L *\n" nil t)
    t))

    t))

(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-]*:\\|^>?From "))
    t))

(defun nndoc-rfc934-type-p ()
  (when (and (re-search-forward "^-+ Start of forwarded.*\n+" nil t)
	     (not (re-search-forward "^Subject:.*digest" nil t))

    (when (re-search-forward "^Content-Type: *message/rfc822" nil t)
      t)))

(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)))
    (goto-char (point-min))

(defun nndoc-dissect-buffer ()
  "Go through the document and partition it into heads/bodies/articles."
  (let ((i 0)
	(first t)
	art-begin head-begin head-end body-begin body-end)
    (setq nndoc-dissection-alist nil)
    (save-excursion
      (set-buffer nndoc-current-buffer)
      (goto-char (point-min))
      ;; Remove blank lines.

	(when nndoc-file-begin
	  (nndoc-search nndoc-file-begin))
	;; Go through the file.
	(while (if (and first nndoc-first-article)
		   (nndoc-search nndoc-first-article)
		 (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
		 (nndoc-search nndoc-head-begin)))
	  (if (or (eobp)

	    (setq body-begin (point))
	    (or (and nndoc-body-end-function
		     (funcall nndoc-body-end-function))
		(and nndoc-body-end
		     (nndoc-search nndoc-body-end))
		(and (nndoc-article-begin)
		     (setq art-begin (point)))
		(progn
		  (goto-char (point-max))
		  (when nndoc-file-end
		    (and (re-search-backward nndoc-file-end nil t)
			 (beginning-of-line)))))

    (unless type
      (setq type "text"
	    subtype "plain"))
    ;; Prepare the article and summary inserts.
    (unless article-insert
      (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")))

	(error "No such position: %s" position))
      (setcdr list (cons definition (cdr list)))))))

(provide 'nndoc)

;;; arch-tag: f5c2970e-0387-47ac-a0b3-6cc317dffabe
;;; nndoc.el ends here