X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmml.el;h=603675b65ad37f0b0c319efa2183b190bc6d8c6e;hb=8047583c8c86a5c6a61bddc27b391042e39e1ce5;hp=a7ee8de9ec72840595f00ff4f7ba3524ba7e24b9;hpb=288df404798143bcebde31f44f2041f786424fa6;p=elisp%2Fgnus.git- diff --git a/lisp/mml.el b/lisp/mml.el index a7ee8de..603675b 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -1,5 +1,5 @@ ;;; mml.el --- A package for parsing and validating MML documents -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -36,13 +36,16 @@ (autoload 'gnus-setup-posting-charset "gnus-msg") (autoload 'gnus-make-local-hook "gnus-util") (autoload 'message-fetch-field "message") + (autoload 'message-mark-active-p "message") (autoload 'fill-flowed-encode "flow-fill") - (autoload 'message-posting-charset "message")) + (autoload 'message-posting-charset "message") + (autoload 'x-dnd-get-local-file-name "x-dnd")) (defcustom mml-content-type-parameters '(name access-type expiration size permission format) "*A list of acceptable parameters in MML tag. These parameters are generated in Content-Type header if exists." + :version "21.4" :type '(repeat (symbol :tag "Parameter")) :group 'message) @@ -50,12 +53,14 @@ These parameters are generated in Content-Type header if exists." '(filename creation-date modification-date read-date) "*A list of acceptable parameters in MML tag. These parameters are generated in Content-Disposition header if exists." + :version "21.4" :type '(repeat (symbol :tag "Parameter")) :group 'message) (defcustom mml-insert-mime-headers-always nil "If non-nil, always put Content-Type: text/plain at top of empty parts. It is necessary to work against a bug in certain clients." + :version "21.4" :type 'boolean :group 'message) @@ -130,19 +135,15 @@ one charsets.") (defun mml-destroy-buffers () (let (kill-buffer-hook) - (mapcar 'kill-buffer mml-buffer-list) + (mapc 'kill-buffer mml-buffer-list) (setq mml-buffer-list nil))) (defun mml-parse () "Parse the current buffer as an MML document." (save-excursion (goto-char (point-min)) - (let ((table (syntax-table))) - (unwind-protect - (progn - (set-syntax-table mml-syntax-table) - (mml-parse-1)) - (set-syntax-table table))))) + (with-syntax-table mml-syntax-table + (mml-parse-1)))) (defun mml-parse-1 () "Parse the current buffer as an MML document." @@ -164,9 +165,8 @@ one charsets.") (method (cdr (assq 'method taginfo))) tags) (save-excursion - (if - (re-search-forward - "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t) + (if (re-search-forward + "<#/?\\(multipart\\|part\\|external\\|mml\\)." nil t) (setq secure-mode "multipart") (setq secure-mode "part"))) (save-excursion @@ -446,6 +446,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." ;; actually are hard newlines in the text. (let (use-hard-newlines) (when (and (string= type "text/plain") + (not (string= (cdr (assq 'sign cont)) "pgp")) (or (null (assq 'format cont)) (string= (cdr (assq 'format cont)) "flowed")) @@ -553,7 +554,8 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (message-options-set 'message-sender sender)) (if (setq recipients (cdr (assq 'recipients cont))) (message-options-set 'message-recipients recipients)) - (let ((style (mml-signencrypt-style (first (or sign-item encrypt-item))))) + (let ((style (mml-signencrypt-style + (first (or sign-item encrypt-item))))) ;; check if: we're both signing & encrypting, both methods ;; are the same (why would they be different?!), and that ;; the signencrypt style allows for combined operation. @@ -587,7 +589,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (insert-buffer-substring (cdr (assq 'buffer cont)))) ((and (setq filename (cdr (assq 'filename cont))) (not (equal (cdr (assq 'nofile cont)) "yes"))) - (mm-insert-file-contents filename)) + (mm-insert-file-contents filename nil nil nil nil t)) (t (insert (cdr (assq 'contents cont))))) (goto-char (point-min)) @@ -597,7 +599,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (incf mml-multipart-number))) (throw 'not-unique nil)))) ((eq (car cont) 'multipart) - (mapcar 'mml-compute-boundary-1 (cddr cont)))) + (mapc 'mml-compute-boundary-1 (cddr cont)))) t)) (defun mml-make-boundary (number) @@ -804,7 +806,7 @@ If HANDLES is non-nil, use it instead reparsing the buffer." (insert " " param) (when (> (current-column) 71) (goto-char point) - (insert "\n ") + (insert "\n") (end-of-line))))) ;;; @@ -850,33 +852,36 @@ If HANDLES is non-nil, use it instead reparsing the buffer." main)) (easy-menu-define - mml-menu mml-mode-map "" - `("Attachments" - ["Attach File..." mml-attach-file - ,@(if (featurep 'xemacs) '(t) - '(:help "Attach a file at point"))] - ["Attach Buffer..." mml-attach-buffer t] - ["Attach External..." mml-attach-external t] - ["Insert Part..." mml-insert-part t] - ["Insert Multipart..." mml-insert-multipart t] - ["PGP/MIME Sign" mml-secure-message-sign-pgpmime t] - ["PGP/MIME Encrypt" mml-secure-message-encrypt-pgpmime t] - ["PGP Sign" mml-secure-message-sign-pgp t] - ["PGP Encrypt" mml-secure-message-encrypt-pgp t] - ["S/MIME Sign" mml-secure-message-sign-smime t] - ["S/MIME Encrypt" mml-secure-message-encrypt-smime t] - ("Secure MIME part" - ["PGP/MIME Sign Part" mml-secure-sign-pgpmime t] - ["PGP/MIME Encrypt Part" mml-secure-encrypt-pgpmime t] - ["PGP Sign Part" mml-secure-sign-pgp t] - ["PGP Encrypt Part" mml-secure-encrypt-pgp t] - ["S/MIME Sign Part" mml-secure-sign-smime t] - ["S/MIME Encrypt Part" mml-secure-encrypt-smime t]) - ["Encrypt/Sign off" mml-unsecure-message t] - ;;["Narrow" mml-narrow-to-part t] - ["Quote MML" mml-quote-region t] - ["Validate MML" mml-validate t] - ["Preview" mml-preview t])) + mml-menu mml-mode-map "" + `("Attachments" + ["Attach File..." mml-attach-file + ,@(if (featurep 'xemacs) '(t) + '(:help "Attach a file at point"))] + ["Attach Buffer..." mml-attach-buffer t] + ["Attach External..." mml-attach-external t] + ["Insert Part..." mml-insert-part t] + ["Insert Multipart..." mml-insert-multipart t] + ["PGP/MIME Sign" mml-secure-message-sign-pgpmime t] + ["PGP/MIME Encrypt" mml-secure-message-encrypt-pgpmime t] + ["PGP Sign" mml-secure-message-sign-pgp t] + ["PGP Encrypt" mml-secure-message-encrypt-pgp t] + ["S/MIME Sign" mml-secure-message-sign-smime t] + ["S/MIME Encrypt" mml-secure-message-encrypt-smime t] + ("Secure MIME part" + ["PGP/MIME Sign Part" mml-secure-sign-pgpmime t] + ["PGP/MIME Encrypt Part" mml-secure-encrypt-pgpmime t] + ["PGP Sign Part" mml-secure-sign-pgp t] + ["PGP Encrypt Part" mml-secure-encrypt-pgp t] + ["S/MIME Sign Part" mml-secure-sign-smime t] + ["S/MIME Encrypt Part" mml-secure-encrypt-smime t]) + ["Encrypt/Sign off" mml-unsecure-message t] + ;;["Narrow" mml-narrow-to-part t] + ["Quote MML" mml-quote-region + :active (message-mark-active-p) + ,@(if (featurep 'xemacs) nil + '(:help "Quote MML tags in region"))] + ["Validate MML" mml-validate t] + ["Preview" mml-preview t])) (defvar mml-mode nil "Minor mode for editing MML.") @@ -893,6 +898,11 @@ See Info node `(emacs-mime)Composing'. (> (prefix-numeric-value arg) 0))) (add-minor-mode 'mml-mode " MML" mml-mode-map) (easy-menu-add mml-menu mml-mode-map) + (when (boundp 'x-dnd-protocol-alist) + (set (make-local-variable 'x-dnd-protocol-alist) + '(("^file:///" . mml-x-dnd-attach-file) + ("^file://" . x-dnd-open-file) + ("^file:" . mml-x-dnd-attach-file)))) (run-hooks 'mml-mode-hook))) ;;; @@ -939,7 +949,7 @@ See Info node `(emacs-mime)Composing'. (if (string-match "^text/.*" type) "inline" "attachment"))) - (disposition (completing-read + (disposition (completing-read (format "Disposition: (default %s): " default) '(("attachment") ("inline") ("")) nil @@ -1010,6 +1020,15 @@ description of the attachment." 'disposition (or disposition "attachment") 'description description)) +(defun mml-x-dnd-attach-file (uri action) + "Attach a drag and drop file." + (let ((file (x-dnd-get-local-file-name uri t))) + (when (and file (file-regular-p file)) + (let* ((type (mml-minibuffer-read-type file)) + (description (mml-minibuffer-read-description)) + (disposition (mml-minibuffer-read-disposition type))) + (mml-attach-file file type description disposition))))) + (defun mml-attach-buffer (buffer &optional type description) "Attach a buffer to the outgoing MIME message. See `mml-attach-file' for details of operation." @@ -1059,10 +1078,15 @@ Should be adopted if code in `message-send-mail' is changed." (message-position-on-field "Mail-Followup-To" "X-Draft-From") (insert (message-make-mail-followup-to)))) +(defvar mml-preview-buffer nil) + (defun mml-preview (&optional raw) "Display current buffer with Gnus, in a new buffer. If RAW, don't highlight the article." (interactive "P") + (setq mml-preview-buffer (generate-new-buffer + (concat (if raw "*Raw MIME preview of " + "*MIME preview of ") (buffer-name)))) (save-excursion (let* ((buf (current-buffer)) (message-options message-options) @@ -1074,11 +1098,9 @@ If RAW, don't highlight the article." (message-fetch-field "Newsgroups"))) message-posting-charset))) (message-options-set-recipient) - (switch-to-buffer (generate-new-buffer - (concat (if raw "*Raw MIME preview of " - "*MIME preview of ") (buffer-name)))) (when (boundp 'gnus-buffers) - (push (current-buffer) gnus-buffers)) + (push mml-preview-buffer gnus-buffers)) + (set-buffer mml-preview-buffer) (erase-buffer) (insert-buffer-substring buf) (mml-preview-insert-mail-followup-to) @@ -1125,7 +1147,11 @@ If RAW, don't highlight the article." (lambda (event) (interactive "@e") (widget-button-press (widget-event-point event) event))) - (goto-char (point-min))))) + (goto-char (point-min)))) + (if (and (boundp 'gnus-buffer-configuration) + (assq 'mml-preview gnus-buffer-configuration)) + (gnus-configure-windows 'mml-preview) + (pop-to-buffer mml-preview-buffer))) (defun mml-validate () "Validate the current MML document."