;;; mml.el --- A package for parsing and validating MML documents
-;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2016 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
(require 'mml-sec)
(eval-when-compile (require 'cl))
(eval-when-compile (require 'url))
-(eval-when-compile
- (when (featurep 'xemacs)
- (require 'easy-mmode))) ; for `define-minor-mode'
(autoload 'message-make-message-id "message")
(declare-function gnus-setup-posting-charset "gnus-msg" (group))
-(autoload 'gnus-make-local-hook "gnus-util")
(autoload 'gnus-completing-read "gnus-util")
(autoload 'message-fetch-field "message")
(autoload 'message-mark-active-p "message")
(autoload 'message-mail-p "message")
(defvar gnus-article-mime-handles)
-(defvar gnus-mouse-2)
(defvar gnus-newsrc-hashtb)
(defvar message-default-charset)
(defvar message-deletable-headers)
(defvar mml-inhibit-compute-boundary nil)
(declare-function libxml-parse-html-region "xml.c"
- (start end &optional base-url))
+ (start end &optional base-url discard-comments))
(defun mml-generate-mime (&optional multipart-type)
"Generate a MIME message based on the current MML document.
(let ((mm-coding-system-priorities
(cons 'utf-8 mm-coding-system-priorities)))
(setq charset (mm-encode-body))))
+ (mm-disable-multibyte)
(setq encoding (mm-body-encoding
charset (cdr (assq 'encoding cont))))))
(setq coded (buffer-string)))
(mm-with-unibyte-buffer
(cond
((cdr (assq 'buffer cont))
- (insert (mm-string-as-unibyte
+ (insert (string-as-unibyte
(with-current-buffer (cdr (assq 'buffer cont))
(buffer-string)))))
((and filename
filename)))))
(t
(let ((contents (cdr (assq 'contents cont))))
- (if (if (featurep 'xemacs)
- (string-match "[^\000-\377]" contents)
- (mm-multibyte-string-p contents))
+ (if (multibyte-string-p contents)
(progn
(mm-enable-multibyte)
(insert contents)
(if (setq encoding (cdr (assq 'encoding cont)))
(setq encoding (intern (downcase encoding))))
(setq encoding (mm-encode-buffer type encoding)
- coded (mm-string-as-multibyte (buffer-string))))
+ coded (string-as-multibyte (buffer-string))))
(mml-insert-mime-headers cont type charset encoding nil)
(insert "\n" coded))))
((eq (car cont) 'external)
(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 File..." mml-attach-file :help "Attach a file at point"]
["Attach Buffer..." mml-attach-buffer
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Attach a buffer to the outgoing message"))]
+ :help "Attach a buffer to the outgoing message"]
["Attach External..." mml-attach-external
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Attach reference to an external file"))]
+ :help "Attach reference to an external file"]
;; FIXME: Is it possible to do this without using
;; `gnus-gcc-externalize-attachments'?
["Externalize Attachments"
(lambda ()
(interactive)
- (if (not (and (boundp 'gnus-gcc-externalize-attachments)
- (memq gnus-gcc-externalize-attachments
- '(all t nil))))
- ;; Stupid workaround for XEmacs not honoring :visible.
- (message "Can't handle this value of `gnus-gcc-externalize-attachments'")
- (setq gnus-gcc-externalize-attachments
- (not gnus-gcc-externalize-attachments))
- (message "gnus-gcc-externalize-attachments is `%s'."
- gnus-gcc-externalize-attachments)))
- ;; XEmacs barfs on :visible.
- ,@(if (featurep 'xemacs) nil
- '(:visible (and (boundp 'gnus-gcc-externalize-attachments)
- (memq gnus-gcc-externalize-attachments
- '(all t nil)))))
+ (setq gnus-gcc-externalize-attachments
+ (not gnus-gcc-externalize-attachments))
+ (message "gnus-gcc-externalize-attachments is `%s'."
+ gnus-gcc-externalize-attachments))
+ :visible (and (boundp 'gnus-gcc-externalize-attachments)
+ (memq gnus-gcc-externalize-attachments
+ '(all t nil)))
:style toggle
:selected gnus-gcc-externalize-attachments
- ,@(if (featurep 'xemacs) nil
- '(:help "Save attachments as external parts in Gcc copies"))]
+ :help "Save attachments as external parts in Gcc copies"]
"----"
;;
("Change Security Method"
["PGP/MIME"
(lambda () (interactive) (setq mml-secure-method "pgpmime"))
- ,@(if (featurep 'xemacs) nil
- '(:help "Set Security Method to PGP/MIME"))
+ :help "Set Security Method to PGP/MIME"
:style radio
:selected (equal mml-secure-method "pgpmime") ]
["S/MIME"
(lambda () (interactive) (setq mml-secure-method "smime"))
- ,@(if (featurep 'xemacs) nil
- '(:help "Set Security Method to S/MIME"))
+ :help "Set Security Method to S/MIME"
:style radio
:selected (equal mml-secure-method "smime") ]
["Inline PGP"
(lambda () (interactive) (setq mml-secure-method "pgp"))
- ,@(if (featurep 'xemacs) nil
- '(:help "Set Security Method to inline PGP"))
+ :help "Set Security Method to inline PGP"
:style radio
:selected (equal mml-secure-method "pgp") ] )
;;
["Encrypt Message" mml-secure-message-encrypt t]
["Sign and Encrypt Message" mml-secure-message-sign-encrypt t]
["Encrypt/Sign off" mml-unsecure-message
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Don't Encrypt/Sign Message"))]
+ :help "Don't Encrypt/Sign Message"]
;; Do we have separate encrypt and encrypt/sign commands for parts?
["Sign Part" mml-secure-sign t]
["Encrypt Part" mml-secure-encrypt t]
;;["Narrow" mml-narrow-to-part t]
["Quote MML in region" mml-quote-region
:active (message-mark-active-p)
- ,@(if (featurep 'xemacs) nil
- '(:help "Quote MML tags in region"))]
+ :help "Quote MML tags in region"]
["Validate MML" mml-validate t]
["Preview" mml-preview t]
"----"
["Emacs MIME manual" (lambda () (interactive) (message-info 4))
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Display the Emacs MIME manual"))]
+ :help "Display the Emacs MIME manual"]
["PGG manual" (lambda () (interactive) (message-info mml2015-use))
- ;; XEmacs barfs on :visible.
- ,@(if (featurep 'xemacs) nil
- '(:visible (and (boundp 'mml2015-use) (equal mml2015-use 'pgg))))
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Display the PGG manual"))]
+ :visible (and (boundp 'mml2015-use) (equal mml2015-use 'pgg))
+ :help "Display the PGG manual"]
["EasyPG manual" (lambda () (interactive) (require 'mml2015) (message-info mml2015-use))
- ;; XEmacs barfs on :visible.
- ,@(if (featurep 'xemacs) nil
- '(:visible (and (boundp 'mml2015-use) (equal mml2015-use 'epg))))
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Display the EasyPG manual"))]))
+ :visible (and (boundp 'mml2015-use) (equal mml2015-use 'epg))
+ :help "Display the EasyPG manual"]))
(define-minor-mode mml-mode
"Minor mode for editing MML.
'type type
;; icicles redefines read-file-name and returns a
;; string w/ text properties :-/
- 'filename (mm-substring-no-properties file)
+ 'filename (substring-no-properties file)
'disposition (or disposition "attachment")
'description description)
;; When using Mail mode, make sure it does the mime encoding
(message-sort-headers)
(mml-to-mime))
(if raw
- (when (fboundp 'set-buffer-multibyte)
- (let ((s (buffer-string)))
- ;; Insert the content into unibyte buffer.
- (erase-buffer)
- (mm-disable-multibyte)
- (insert s)))
+ (let ((s (buffer-string)))
+ ;; Insert the content into unibyte buffer.
+ (erase-buffer)
+ (mm-disable-multibyte)
+ (insert s))
(let ((gnus-newsgroup-charset (car message-posting-charset))
gnus-article-prepare-hook gnus-original-article-buffer
gnus-displaying-mime)
(gnus-article-prepare-display))))
;; Disable article-mode-map.
(use-local-map nil)
- (gnus-make-local-hook 'kill-buffer-hook)
(add-hook 'kill-buffer-hook
(lambda ()
(mm-destroy-parts gnus-article-mime-handles)) nil t)
(lambda ()
(interactive)
(widget-button-press (point))))
- (local-set-key gnus-mouse-2
+ (local-set-key [mouse-2]
(lambda (event)
(interactive "@e")
(widget-button-press (widget-event-point event) event)))
;; FIXME: Buffer is in article mode, but most tool bar commands won't
;; work. Maybe only keep the following icons: search, print, quit
(goto-char (point-min))))
- (if (and (not (mm-special-display-p (buffer-name mml-preview-buffer)))
+ (if (and (not (special-display-p (buffer-name mml-preview-buffer)))
(boundp 'gnus-buffer-configuration)
(assq 'mml-preview gnus-buffer-configuration))
(let ((gnus-message-buffer (current-buffer)))