X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnndoc.el;h=cca341875e0c4ec39b7e79cc0d7d746bf90b4993;hp=00d9f4d4dd03a45eea2105f5e083b734a315d99e;hb=829fe7e073a13eaf991e04e90b1e731b1ccce0c2;hpb=0a63db68d21591915aa899eabbadb2320edbdb65 diff --git a/lisp/nndoc.el b/lisp/nndoc.el index 00d9f4d4d..cca341875 100644 --- a/lisp/nndoc.el +++ b/lisp/nndoc.el @@ -1,6 +1,6 @@ ;;; nndoc.el --- single file access for Gnus -;; Copyright (C) 1995-2013 Free Software Foundation, Inc. +;; Copyright (C) 1995-2015 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA @@ -56,6 +56,10 @@ from the document.") `((mmdf (article-begin . "^\^A\^A\^A\^A\n") (body-end . "^\^A\^A\^A\^A\n")) + (debbugs-db + (file-begin . "^\005") + (article-begin . "^[\005\007]\n") + (body-end . "^\003")) (mime-digest (article-begin . "") (head-begin . "^ ?\n") @@ -195,7 +199,7 @@ from the document.") ;; lines in the body. For MIME dissections only, ARTICLE-INSERT [5] and ;; SUMMARY-INSERT [6] give headers to insert for full article or summary line ;; generation, respectively. Other headers usually follow directly from the -;; buffer. Value `nil' means no insert. +;; buffer. Value nil means no insert. (defvoo nndoc-dissection-alist nil) (defvoo nndoc-prepare-body-function nil) (defvoo nndoc-generate-head-function nil) @@ -460,6 +464,10 @@ from the document.") (when (looking-at "\^A\^A\^A\^A$") t)) +(defun nndoc-debbugs-db-type-p () + (when (looking-at "\006$") + t)) + (defun nndoc-news-type-p () (when (looking-at "^Path:.*\n") t)) @@ -734,7 +742,7 @@ from the document.") nil t) (setq subject (concat (match-string 1) subject)) (setq from (concat (match-string 2) " " from)))))) - (while (and from (string-match "(\[^)\]*)" 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") @@ -968,61 +976,15 @@ PARENT is the message-ID of the parent summary line, or nil for none." (goto-char head-begin) (setq content-type (message-fetch-field "Content-Type")) (when content-type - (with-temp-buffer - (insert content-type) - (goto-char (point-min)) - (when (re-search-forward ";[\t\n ]*name=\\([\"']\\|\\([^\t\n\r ]+\\)\\)" - nil t) - (setq subject (or (match-string 2) - (progn - (goto-char (match-beginning 1)) - (condition-case nil - (progn - (forward-sexp 1) - (buffer-substring - (1+ (match-beginning 1)) (1- (point)))) - (error nil))))))) - (when (or (string-match "^ *\\([^ \t\n/;]+\\)/\\([^ \t\n/;]+\\)" - content-type) - ;; Guess Content-Type from the file name extention. - ;; Some mailer sends a part without type like this: - ;; Content-Type: ; name="IMG_3156.JPG" - ;; Content-Disposition: attachment; filename="IMG_3156.JPG" - (let ((tem (message-fetch-field "Content-Disposition")) - (case-fold-search t) - len) - (when (and - (setq tem - (or (and tem - (mail-content-type-get - (mail-header-parse-content-disposition - tem) - 'filename)) - subject)) - (setq tem (file-name-extension tem)) - (require 'mailcap) - (setq content-type - (cdr (assoc (concat "." (downcase tem)) - mailcap-mime-extensions))) - (string-match "^ *\\([^ \t\n/;]+\\)/\\([^ \t\n/;]+\\)" - content-type)) - (save-match-data - (goto-char (point-min)) - (when (re-search-forward "^Content-Type:\\([^;]*\\);" - nil t) - (setq len (- (match-end 1) (match-beginning 1) - (length content-type)) - head-end (- head-end len) - body-begin (- body-begin len) - body-end (- body-end len)) - (replace-match (concat "Content-Type: " content-type - ";")))) - t))) + (when (string-match + "^ *\\([^ \t\n/;]+\\)/\\([^ \t\n/;]+\\)" content-type) (setq type (downcase (match-string 1 content-type)) subtype (downcase (match-string 2 content-type)) message-rfc822 (and (string= type "message") (string= subtype "rfc822")) multipart-any (string= type "multipart"))) + (when (string-match ";[ \t\n]*name=\\([^ \t\n;]+\\)" content-type) + (setq subject (match-string 1 content-type))) (when (string-match "boundary=\"?\\([^\"\n]*[^\" \t\n]\\)" content-type) (setq boundary-regexp (concat "^--" (regexp-quote