+2000-11-03 10:46:44 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-msg.el (gnus-msg-mail): Move it backwards.
+
+2000-11-03 Simon Josefsson <sj@extundo.com>
+
+ * rfc2231.el (rfc2231-parse-qp-string): New function.
+ (require): rfc2047.
+
+ * mail-parse.el (mail-header-parse-content-type):
+ (mail-header-parse-content-disposition): Support invalid QP
+ encoded strings, by using `rfc2231-parse-qp-string'.
+
+2000-11-03 08:58:08 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * rfc2231.el (rfc2231-parse-string): Decode when there is no number.
+ (rfc2231-decode-encoded-string): Typo "> X 1".
+ (rfc2231-encode-string): Insert the name of charset.
+ * mail-parse.el (mail-header-encode-parameter): Use RFC2231.
+
+2000-11-02 23:35:50 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mm-save-part): Return the filename.
+ * gnus-sum.el (gnus-summary-edit-article): Remove a hack.
+ * gnus-art.el (gnus-mime-save-part-and-strip): New function.
+ (gnus-mime-action-alist): Use it.
+ (gnus-mime-button-commands): USe it.
+ * mm-extern.el (mm-extern-local-file): Error when the file is gone.
+ (mm-inline-external-body): unwind-protect.
+
+2000-11-02 21:08:49 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-insert-mime-button): Show url.
+
+2000-11-02 19:51:19 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml.el (mml-generate-mime-1): Support external url.
+ * nnwarchive.el (nnwarchive-mail-archive-article): Use external url.
+
+2000-11-02 16:53:32 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-partial.el (mm-inline-partial): Buffer name with a leading space.
+ * mm-decode.el (mm-display-external): Ditto.
+ * mm-extern.el: New file.
+ * mm-decode.el (mm-inline-media-tests): Hook it up.
+ (mm-inlined-types): Inline message/external-body.
+
+2000-11-02 Simon Josefsson <sj@extundo.com>
+
+ * gnus-art.el (gnus-visible-headers): Add Mail-Followup-To.
+
+ * message.el (message-get-reply-headers): Better handling when
+ Mail-Followup-To is very large.
+
+2000-11-02 13:27:56 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-uu.el (gnus-uu-post-news): Comment out the redundancy.
+ * gnus-art.el (gnus-article-edit-done):
+ * gnus-sum.el (gnus-summary-edit-article-done): Move line
+ counting code here.
+ * gnus-msg.el (gnus-setup-message): Remove a hack.
+
+2000-11-02 09:33:01 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-newsgroup-variables): New variable.
+ (gnus-summary-mode): Make them local variables.
+ (gnus-set-global-variables): Globalize them.
+ (gnus-summary-exit): Kill them.
+
+2000-11-02 Hrvoje Niksic <hniksic@arsdigita.com>
+
+ * rfc2047.el (rfc2047-encoded-word-regexp): Allow empty encoded
+ word.
+
2000-11-01 10:07:13 ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus-art.el (gnus-mime-display-part): Add to signed or encrypted.
(condition-case nil
(progn (require 'w3-forms) nil)
(error '("nnweb.el" "nnlistserv.el" "nnultimate.el"
- "nnslashdot.el" "nnwarchive.el" "webmail.el")))
+ "nnslashdot.el" "nnwarchive.el" "webmail.el"
+ "nnwfm.el")))
(condition-case nil
(progn (require 'bbdb) nil)
(error '("gnus-bbdb.el")))
:group 'gnus-article-hiding)
(defcustom gnus-visible-headers
- "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|^X-Sent:"
+ "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Mail-Followup-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|^X-Sent:"
"*All headers that do not match this regexp will be hidden.
This variable can also be a list of regexp of headers to remain visible.
If this variable is non-nil, `gnus-ignored-headers' will be ignored."
(defcustom gnus-mime-action-alist
'(("save to file" . gnus-mime-save-part)
+ ("save and strip" . gnus-mime-save-part-and-strip)
("display as text" . gnus-mime-inline-part)
("view the part" . gnus-mime-view-part)
("pipe to command" . gnus-mime-pipe-part)
(gnus-mime-view-part "v" "View Interactively...")
(gnus-mime-view-part-as-type "t" "View As Type...")
(gnus-mime-save-part "o" "Save...")
+ (gnus-mime-save-part-and-strip "\C-o" "Save and Strip")
(gnus-mime-copy-part "c" "View As Text, In Other Buffer")
(gnus-mime-inline-part "i" "View As Text, In This Buffer")
(gnus-mime-internalize-part "E" "View Internally")
(gnus-mime-view-all-parts (cdr handles))
(mapcar 'mm-display-part handles)))))
+(defun gnus-mime-save-part-and-strip ()
+ "Save the MIME part under point then replace it with an external body."
+ (interactive)
+ (gnus-article-check-buffer)
+ (let* ((data (get-text-property (point) 'gnus-data))
+ (file (mm-save-part data))
+ param)
+ (when file
+ (with-current-buffer (mm-handle-buffer data)
+ (erase-buffer)
+ (insert "Content-Type: " (mm-handle-media-type data))
+ (mml-insert-parameter-string (cdr (mm-handle-type data))
+ '(charset))
+ (insert "\n")
+ (insert "Content-ID: " (message-make-message-id) "\n")
+ (insert "Content-Transfer-Encoding: binary\n")
+ (insert "\n"))
+ (setcdr data
+ (cdr (mm-make-handle nil
+ `("message/external-body"
+ (access-type . "LOCAL-FILE")
+ (name . ,file)))))
+ (set-buffer gnus-summary-buffer)
+ (gnus-article-edit-article
+ `(lambda ()
+ (erase-buffer)
+ (let ((mail-parse-charset (or gnus-article-charset
+ ',gnus-newsgroup-charset))
+ (mail-parse-ignored-charsets
+ (or gnus-article-ignored-charsets
+ ',gnus-newsgroup-ignored-charsets))
+ (mbl mml-buffer-list))
+ (insert-buffer gnus-original-article-buffer)
+ (save-restriction
+ (message-narrow-to-head)
+ (message-remove-header "Content-Type")
+ (message-remove-header "MIME-Version")
+ (message-remove-header "Content-Transfer-Encoding")
+ (mail-decode-encoded-word-region (point-min) (point-max))
+ (goto-char (point-max)))
+ (forward-char 1)
+ (delete-region (point) (point-max))
+ (setq mml-buffer-list nil)
+ (if (stringp (car gnus-article-mime-handles))
+ (mml-insert-mime gnus-article-mime-handles)
+ (mml-insert-mime gnus-article-mime-handles t))
+ (mm-destroy-parts gnus-article-mime-handles)
+ (setq gnus-article-mime-handles nil)
+ (make-local-hook 'kill-buffer-hook)
+ (let ((mbl1 mml-buffer-list))
+ (setq mml-buffer-list mbl)
+ (set (make-local-variable 'mml-buffer-list) mbl1))
+ (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
+ `(lambda (no-highlight)
+ (let ((mail-parse-charset (or gnus-article-charset
+ ',gnus-newsgroup-charset))
+ (message-options message-options)
+ (message-options-set-recipient)
+ (mail-parse-ignored-charsets
+ (or gnus-article-ignored-charsets
+ ',gnus-newsgroup-ignored-charsets)))
+ (mml-to-mime)
+ (mml-destroy-buffers)
+ (remove-hook 'kill-buffer-hook
+ 'mml-destroy-buffers t)
+ (kill-local-variable 'mml-buffer-list))
+ (gnus-summary-edit-article-done
+ ,(or (mail-header-references gnus-current-headers) "")
+ ,(gnus-group-read-only-p)
+ ,gnus-summary-buffer no-highlight))))))
+
(defun gnus-mime-save-part ()
"Save the MIME part under point."
(interactive)
'name)
(mail-content-type-get (mm-handle-disposition handle)
'filename)
+ (mail-content-type-get (mm-handle-type handle)
+ 'url)
""))
(gnus-tmp-type (mm-handle-media-type handle))
(gnus-tmp-description
(defun gnus-article-edit-done (&optional arg)
"Update the article edits and exit."
(interactive "P")
- (save-excursion
- (save-restriction
- (widen)
- (when (article-goto-body)
- (let ((lines (count-lines (point) (point-max)))
- (length (- (point-max) (point)))
- (case-fold-search t)
- (body (copy-marker (point))))
- (goto-char (point-min))
- (when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t)
- (delete-region (match-beginning 1) (match-end 1))
- (insert (number-to-string length)))
- (goto-char (point-min))
- (when (re-search-forward
- "^x-content-length:[ \t]\\([0-9]+\\)" body t)
- (delete-region (match-beginning 1) (match-end 1))
- (insert (number-to-string length)))
- (goto-char (point-min))
- (when (re-search-forward "^lines:[ \t]\\([0-9]+\\)" body t)
- (delete-region (match-beginning 1) (match-end 1))
- (insert (number-to-string lines)))))))
(let ((func gnus-article-edit-done-function)
(buf (current-buffer))
(start (window-start)))
;; "c" gnus-summary-send-draft
"r" gnus-summary-resend-message)
-;;;###autoload
-(defun gnus-msg-mail (&rest args)
- "Start editing a mail message to be sent.
-Like `message-mail', but with Gnus paraphernalia, particularly the
-the Gcc: header for archiving purposes."
- (interactive)
- (gnus-setup-message 'message
- (apply 'message-mail args)))
-
-;;;###autoload
-(define-mail-user-agent 'gnus-user-agent
- 'gnus-msg-mail 'message-send-and-exit
- 'message-kill-buffer 'message-send-hook)
-
;;; Internal functions.
(defvar gnus-article-reply nil)
(gnus-configure-windows ,config t)
(set-buffer-modified-p nil))))
+;;;###autoload
+(defun gnus-msg-mail (&rest args)
+ "Start editing a mail message to be sent.
+Like `message-mail', but with Gnus paraphernalia, particularly the
+the Gcc: header for archiving purposes."
+ (interactive)
+ (gnus-setup-message 'message
+ (apply 'message-mail args)))
+
+;;;###autoload
+(define-mail-user-agent 'gnus-user-agent
+ 'gnus-msg-mail 'message-send-and-exit
+ 'message-kill-buffer 'message-send-hook)
+
(defun gnus-setup-posting-charset (group)
(let ((alist gnus-group-posting-charset-alist)
(group (or group ""))
gnus-newsgroup-incorporated)
"Variables that are buffer-local to the summary buffers.")
+(defvar gnus-newsgroup-variables nil
+ "Variables that have separate values in the newsgroups.")
+
;; Byte-compiler warning.
(defvar gnus-article-mode-map)
(gnus-summary-make-menu-bar))
(kill-all-local-variables)
(gnus-summary-make-local-variables)
+ (let ((gnus-summary-local-variables gnus-newsgroup-variables))
+ (gnus-summary-make-local-variables))
(gnus-make-thread-indent-array)
(gnus-simplify-mode-line)
(setq major-mode 'gnus-summary-mode)
(gac gnus-article-current)
(reffed gnus-reffed-article-number)
(score-file gnus-current-score-file)
- (default-charset gnus-newsgroup-charset))
+ (default-charset gnus-newsgroup-charset)
+ vlist)
+ (let ((locals gnus-newsgroup-variables))
+ (while locals
+ (if (consp (car locals))
+ (push (eval (caar locals)) vlist)
+ (push (eval (car locals)) vlist))
+ (setq locals (cdr locals)))
+ (setq vlist (nreverse vlist)))
(save-excursion
(set-buffer gnus-group-buffer)
(setq gnus-newsgroup-name name
gnus-reffed-article-number reffed
gnus-current-score-file score-file
gnus-newsgroup-charset default-charset)
+ (let ((locals gnus-newsgroup-variables))
+ (while locals
+ (if (consp (car locals))
+ (set (caar locals) (pop vlist))
+ (set (car locals) (pop vlist)))
+ (setq locals (cdr locals))))
;; The article buffer also has local variables.
(when (gnus-buffer-live-p gnus-article-buffer)
(set-buffer gnus-article-buffer)
;; not garbage-collected, it seems. This would the lead to en
;; ever-growing Emacs.
(gnus-summary-clear-local-variables)
+ (let ((gnus-summary-local-variables gnus-newsgroup-variables))
+ (gnus-summary-clear-local-variables))
(when (get-buffer gnus-article-buffer)
(bury-buffer gnus-article-buffer))
;; We clear the global counterparts of the buffer-local
;; variables as well, just to be on the safe side.
(set-buffer gnus-group-buffer)
(gnus-summary-clear-local-variables)
+ (let ((gnus-summary-local-variables gnus-newsgroup-variables))
+ (gnus-summary-clear-local-variables))
;; Return to group mode buffer.
(when (eq mode 'gnus-summary-mode)
(gnus-kill-buffer buf)))
(gnus-deaden-summary)
(gnus-close-group group)
(gnus-summary-clear-local-variables)
+ (let ((gnus-summary-local-variables gnus-newsgroup-variables))
+ (gnus-summary-clear-local-variables))
(set-buffer gnus-group-buffer)
(gnus-summary-clear-local-variables)
+ (let ((gnus-summary-local-variables gnus-newsgroup-variables))
+ (gnus-summary-clear-local-variables))
(when (get-buffer gnus-summary-buffer)
(kill-buffer gnus-summary-buffer)))
(unless gnus-single-article-buffer
no-highlight)
"Make edits to the current article permanent."
(interactive)
+ (save-excursion
+ ;; The buffer restriction contains the entire article if it exists.
+ (when (article-goto-body)
+ (let ((lines (count-lines (point) (point-max)))
+ (length (- (point-max) (point)))
+ (case-fold-search t)
+ (body (copy-marker (point))))
+ (goto-char (point-min))
+ (when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t)
+ (delete-region (match-beginning 1) (match-end 1))
+ (insert (number-to-string length)))
+ (goto-char (point-min))
+ (when (re-search-forward
+ "^x-content-length:[ \t]\\([0-9]+\\)" body t)
+ (delete-region (match-beginning 1) (match-end 1))
+ (insert (number-to-string length)))
+ (goto-char (point-min))
+ (when (re-search-forward "^lines:[ \t]\\([0-9]+\\)" body t)
+ (delete-region (match-beginning 1) (match-end 1))
+ (insert (number-to-string lines))))))
;; Replace the article.
(let ((buf (current-buffer)))
(with-temp-buffer
(insert-buffer-substring buf)
+
(if (and (not read-only)
(not (gnus-request-replace-article
(cdr gnus-article-current) (car gnus-article-current)
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (current-local-map))
(use-local-map map))
- (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
+ ;;(local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
(local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews)
(local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews)
(local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article)
(require 'rfc2047)
(require 'rfc2045)
-(defalias 'mail-header-parse-content-type 'rfc2231-parse-string)
-(defalias 'mail-header-parse-content-disposition 'rfc2231-parse-string)
+(defalias 'mail-header-parse-content-type 'rfc2231-parse-qp-string)
+(defalias 'mail-header-parse-content-disposition 'rfc2231-parse-qp-string)
(defalias 'mail-content-type-get 'rfc2231-get-value)
-(defalias 'mail-header-encode-parameter 'rfc2045-encode-string)
+;(defalias 'mail-header-encode-parameter 'rfc2045-encode-string)
+(defalias 'mail-header-encode-parameter 'rfc2231-encode-string)
(defalias 'mail-header-remove-comments 'ietf-drums-remove-comments)
(defalias 'mail-header-remove-whitespace 'ietf-drums-remove-whitespace)
(let (ccalist)
(save-excursion
(message-set-work-buffer)
- (if (and mft
- message-use-followup-to
- (or (not (eq message-use-followup-to 'ask))
- (message-y-or-n-p
- (concat "Obey Mail-Followup-To: " mft "? ") t "\
-You should normally obey the Mail-Followup-To: header.
+ (if (and mft
+ message-use-followup-to
+ (or (not (eq message-use-followup-to 'ask))
+ (message-y-or-n-p
+ (concat "Obey Mail-Followup-To? ") t "\
+You should normally obey the Mail-Followup-To: header. In this
+article, it has the value of
- `Mail-Followup-To: " mft "'
-directs your response to " (if (string-match "," mft)
+" mft "
+
+which directs your response to " (if (string-match "," mft)
"the specified addresses"
"that address only") ".
(eval-when-compile (require 'cl))
(eval-and-compile
- (autoload 'mm-inline-partial "mm-partial"))
+ (autoload 'mm-inline-partial "mm-partial")
+ (autoload 'mm-inline-external-body "mm-extern"))
(defgroup mime-display ()
"Display of MIME in mail and news articles."
("message/delivery-status" mm-inline-text identity)
("message/rfc822" mm-inline-message identity)
("message/partial" mm-inline-partial identity)
+ ("message/external-body" mm-inline-external-body identity)
("text/.*" mm-inline-text identity)
("audio/wav" mm-inline-audio
(lambda (handle)
(defcustom mm-inlined-types
'("image/.*" "text/.*" "message/delivery-status" "message/rfc822"
- "message/partial" "application/emacs-lisp"
+ "message/partial" "message/external-body" "application/emacs-lisp"
"application/pgp-signature")
"List of media types that are to be displayed inline."
:type '(repeat string)
(let ((cur (current-buffer)))
(if (eq method 'mailcap-save-binary-file)
(progn
- (set-buffer (generate-new-buffer "*mm*"))
+ (set-buffer (generate-new-buffer " *mm*"))
(setq method nil))
(mm-insert-part handle)
(let ((win (get-buffer-window cur t)))
(when win
(select-window win)))
- (switch-to-buffer (generate-new-buffer "*mm*")))
+ (switch-to-buffer (generate-new-buffer " *mm*")))
(buffer-disable-undo)
(mm-set-buffer-file-coding-system mm-binary-coding-system)
(insert-buffer-substring cur)
(progn
(call-process shell-file-name nil
(setq buffer
- (generate-new-buffer "*mm*"))
+ (generate-new-buffer " *mm*"))
nil
shell-command-switch
(mm-mailcap-command
(unwind-protect
(start-process "*display*"
(setq buffer
- (generate-new-buffer "*mm*"))
+ (generate-new-buffer " *mm*"))
shell-file-name
shell-command-switch
(mm-mailcap-command
(push "<" out)
(push (mm-quote-arg file) out)))
(mapconcat 'identity (nreverse out) "")))
-
+
(defun mm-remove-parts (handles)
"Remove the displayed MIME parts represented by HANDLES."
(if (and (listp handles)
(or filename name "")
(or mm-default-directory default-directory))))
(setq mm-default-directory (file-name-directory file))
- (when (or (not (file-exists-p file))
- (yes-or-no-p (format "File %s already exists; overwrite? "
- file)))
- (mm-save-part-to-file handle file))))
+ (and (or (not (file-exists-p file))
+ (yes-or-no-p (format "File %s already exists; overwrite? "
+ file)))
+ (progn
+ (mm-save-part-to-file handle file)
+ file))))
(defun mm-save-part-to-file (handle file)
(mm-with-unibyte-buffer
--- /dev/null
+;;; mm-extern.el --- showing message/external-body
+;; Copyright (C) 2000 Free Software Foundation, Inc.
+
+;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
+;; Keywords: message external-body
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation; either version 2, or (at your
+;; option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; 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:
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+
+(require 'mm-util)
+(require 'mm-decode)
+
+(defvar mm-extern-function-alist
+ '((local-file . mm-extern-local-file)
+ (url . mm-extern-url)
+ (anon-ftp . mm-extern-anon-ftp)
+ (ftp . mm-extern-ftp)
+;;; (tftp . mm-extern-tftp)
+ (mail-server . mm-extern-mail-server)
+;;; (afs . mm-extern-afs))
+ ))
+
+(defvar mm-extern-anonymous "anonymous")
+
+(defun mm-extern-local-file (handle)
+ (erase-buffer)
+ (let ((name (cdr (assq 'name (cdr (mm-handle-type handle)))))
+ (coding-system-for-read mm-binary-coding-system))
+ (unless name
+ (error "The filename is not specified."))
+ (mm-disable-multibyte-mule4)
+ (if (file-exists-p name)
+ (mm-insert-file-contents name nil nil nil nil t)
+ (error "The file is gone."))))
+
+(defun mm-extern-url (handle)
+ (erase-buffer)
+ (require 'url)
+ (let ((url (cdr (assq 'url (cdr (mm-handle-type handle)))))
+ (name buffer-file-name)
+ (coding-system-for-read mm-binary-coding-system))
+ (unless url
+ (error "URL is not specified."))
+ (mm-with-unibyte-current-buffer-mule4
+ (url-insert-file-contents url))
+ (mm-disable-multibyte-mule4)
+ (setq buffer-file-name name)))
+
+(defun mm-extern-anon-ftp (handle)
+ (erase-buffer)
+ (let* ((params (cdr (mm-handle-type handle)))
+ (name (cdr (assq 'name params)))
+ (site (cdr (assq 'site params)))
+ (directory (cdr (assq 'directory params)))
+ (mode (cdr (assq 'mode params)))
+ (path (concat "/" (or mm-extern-anonymous
+ (read-string (format "ID for %s: " site)))
+ "@" site ":" directory "/" name))
+ (coding-system-for-read mm-binary-coding-system))
+ (unless name
+ (error "The filename is not specified."))
+ (mm-disable-multibyte-mule4)
+ (mm-insert-file-contents path nil nil nil nil t)))
+
+(defun mm-extern-ftp (handle)
+ (let (mm-extern-anonymous)
+ (mm-extern-anon-ftp handle)))
+
+(defun mm-extern-mail-server (handle)
+ (require 'message)
+ (let* ((params (cdr (mm-handle-type handle)))
+ (server (cdr (assq 'server params)))
+ (subject (or (cdr (assq 'subject params)) "none"))
+ (buf (current-buffer))
+ info)
+ (if (y-or-n-p (format "Send a request message to %s?" server))
+ (save-window-excursion
+ (message-mail server subject)
+ (message-goto-body)
+ (delete-region (point) (point-max))
+ (insert-buffer buf)
+ (message "Requesting external body...")
+ (message-send-and-exit)
+ (setq info "Request is sent.")
+ (message info))
+ (setq info "Request is not sent."))
+ (goto-char (point-min))
+ (insert "[" info "]\n\n")))
+
+;;;###autoload
+(defun mm-inline-external-body (handle &optional no-display)
+ "Show the external-body part of HANDLE.
+This function replaces the buffer of HANDLE with a buffer contains
+the entire message.
+If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing."
+ (let* ((access-type (cdr (assq 'access-type
+ (cdr (mm-handle-type handle)))))
+ (func (cdr (assq (intern (downcase access-type))
+ mm-extern-function-alist)))
+ gnus-displaying-mime buf
+ handles)
+ (unless (mm-handle-cache handle)
+ (unless func
+ (error (format "Access type (%s) is not supported." access-type)))
+ (with-temp-buffer
+ (mm-insert-part handle)
+ (goto-char (point-max))
+ (insert "\n\n")
+ (setq handles (mm-dissect-buffer t)))
+ (unless (bufferp (car handles))
+ (mm-destroy-parts handles)
+ (error "Multipart external body is not supported."))
+ (save-excursion ;; single part
+ (set-buffer (setq buf (mm-handle-buffer handles)))
+ (let (good)
+ (unwind-protect
+ (progn
+ (funcall func handle)
+ (setq good t))
+ (unless good
+ (mm-destroy-parts handles))))
+ (mm-handle-set-cache handle handles))
+ (push handles gnus-article-mime-handles))
+ (unless no-display
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (gnus-display-mime (mm-handle-cache handle))
+ (mm-handle-set-undisplayer
+ handle
+ `(lambda ()
+ (let (buffer-read-only)
+ (condition-case nil
+ ;; This is only valid on XEmacs.
+ (mapcar (lambda (prop)
+ (remove-specifier
+ (face-property 'default prop) (current-buffer)))
+ '(background background-pixmap foreground))
+ (error nil))
+ (delete-region ,(point-min-marker) ,(point-max-marker))))))))))
+
+;; mm-extern.el ends here
(list gnus-article-mime-handles))
phandles))
(save-excursion
- (set-buffer (generate-new-buffer "*mm*"))
+ (set-buffer (generate-new-buffer " *mm*"))
(while (setq phandle (pop phandles))
(setq nn (string-to-number
(cdr (assq 'number
(insert "Content-Type: message/external-body")
(let ((parameters (mml-parameter-string
cont '(expiration size permission)))
- (name (cdr (assq 'name cont))))
+ (name (cdr (assq 'name cont)))
+ (url (cdr (assq 'url cont))))
(when name
(setq name (mml-parse-file-name name))
(if (stringp name)
(if (member (nth 0 name) '("ftp@" "anonymous@"))
"anon-ftp"
"ftp")))))
+ (when url
+ (mml-insert-parameter
+ (mail-header-encode-parameter "url" url)
+ "access-type=url"))
(when parameters
(mml-insert-parameter-string
cont '(expiration size permission))))
(progn (forward-line) (point)))
;; I hate to download the url encode it, then immediately
;; decode it.
- ;; FixMe: Find a better solution to attach the URL.
- ;; Maybe do some hack in external part of mml-generate-mim-1.
- (insert "<#part>"
- "\n--\nExternal: \n"
- (format "<URL:http://www.mail-archive.com/%s/%s>"
+ (insert "<#external"
+ " type="
+ (or (and url
+ (string-match "\\.[^\\.]+$" url)
+ (mailcap-extension-to-mime
+ (match-string 0 url)))
+ "application/octet-stream")
+ (format " url=\"http://www.mail-archive.com/%s/%s\""
group url)
- "\n--\n"
- "<#/part>")
+ ">\n"
+ "<#/external>")
(setq mime t))
(t
(setq p (point))
;;;
(defvar rfc2047-encoded-word-regexp
- "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ +]+\\)\\?=")
+ "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ +]*\\)\\?=")
(defun rfc2047-decode-region (start end)
"Decode MIME-encoded words in region between START and END."
(eval-when-compile (require 'cl))
(require 'ietf-drums)
+(require 'rfc2047)
(defun rfc2231-get-value (ct attribute)
"Return the value of ATTRIBUTE from CT."
(cdr (assq attribute (cdr ct))))
+(defun rfc2231-parse-qp-string (string)
+ "Parse QP-encoded string using `rfc2231-parse-string'.
+N.B. This is in violation with RFC2047, but it seem to be in common use."
+ (rfc2231-parse-string (rfc2047-decode-string string)))
+
(defun rfc2231-parse-string (string)
"Parse STRING and return a list.
The list will be on the form
(when (eq c ?*)
(forward-char 1)
(setq c (char-after))
- (when (memq c ntoken)
+ (if (not (memq c ntoken))
+ (setq encoded t
+ number nil)
(setq number
(string-to-number
(buffer-substring
(string-to-number (buffer-substring (point) (+ (point) 2)) 16)
(delete-region (1- (point)) (+ (point) 2)))))
;; Encode using the charset, if any.
- (when (and (< (length elems) 1)
+ (when (and (> (length elems) 1)
(not (equal (intern (car elems)) 'us-ascii)))
(mm-decode-coding-region (point-min) (point-max)
(intern (car elems))))
(delete-char 1))
(forward-char 1)))
(goto-char (point-min))
- (insert (or charset "ascii") "''")
+ (insert (or (symbol-name charset) "ascii") "''")
(goto-char (point-min))
(if (not broken)
(insert param "*=")
projects / elisp / gnus.git- / commitdiff