(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))
(setq contents (append (list (cons 'tag-location orig-point)) contents))
(cons (intern name) (nreverse contents))))
-(defun mml-buffer-substring-no-properties-except-hard-newlines (start end)
+(defun mml-buffer-substring-no-properties-except-some (start end)
(let ((str (buffer-substring-no-properties start end))
- (bufstart start) tmp)
- (while (setq tmp (text-property-any start end 'hard 't))
- (set-text-properties (- tmp bufstart) (- tmp bufstart -1)
- '(hard t) str)
+ (bufstart start)
+ tmp)
+ ;; Copy over all hard newlines.
+ (while (setq tmp (text-property-any start end 'hard t))
+ (put-text-property (- tmp bufstart) (- tmp bufstart -1)
+ 'hard t str)
+ (setq start (1+ tmp)))
+ ;; Copy over all `display' properties (which are usually images).
+ (setq start bufstart)
+ (while (setq tmp (text-property-not-all start end 'display nil))
+ (put-text-property (- tmp bufstart) (- tmp bufstart -1)
+ 'display (get-text-property tmp 'display)
+ str)
(setq start (1+ tmp)))
str))
(if (re-search-forward "<#\\(/\\)?mml." nil t)
(setq count (+ count (if (match-beginning 1) -1 1)))
(goto-char (point-max))))
- (mml-buffer-substring-no-properties-except-hard-newlines
+ (mml-buffer-substring-no-properties-except-some
beg (if (> count 0)
(point)
(match-beginning 0))))
(if (re-search-forward
"<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
(prog1
- (mml-buffer-substring-no-properties-except-hard-newlines
+ (mml-buffer-substring-no-properties-except-some
beg (match-beginning 0))
(if (or (not (match-beginning 1))
(equal (match-string 2) "multipart"))
(goto-char (match-beginning 0))
(when (looking-at "[ \t]*\n")
(forward-line 1))))
- (mml-buffer-substring-no-properties-except-hard-newlines
+ (mml-buffer-substring-no-properties-except-some
beg (goto-char (point-max)))))))
(defvar mml-boundary nil)
(when (search-forward (url-filename parsed) end t)
(let ((cid (format "fsf.%d" cid)))
(replace-match (concat "cid:" cid) t t)
- (push (list cid (url-filename parsed)) new-parts))
+ (push (list cid (url-filename parsed)
+ (get-text-property start 'display))
+ new-parts))
(setq cid (1+ cid)))))))
;; We have local images that we want to include.
(if (not new-parts)
(setq cont
(nconc cont
(list `(part (type . "image/png")
- (filename . ,(nth 1 new-part))
+ ,@(mml--possibly-alter-image
+ (nth 1 new-part)
+ (nth 2 new-part))
(id . ,(concat "<" (nth 0 new-part)
">")))))))
cont))))
+(defun mml--possibly-alter-image (file-name image)
+ (if (or (null image)
+ (not (consp image))
+ (not (eq (car image) 'image))
+ (not (image-property image :rotation))
+ (not (executable-find "exiftool")))
+ `((filename . ,file-name))
+ `((filename . ,file-name)
+ (buffer
+ .
+ ,(with-current-buffer (mml-generate-new-buffer " *mml rotation*")
+ (set-buffer-multibyte nil)
+ (call-process "exiftool"
+ file-name
+ (list (current-buffer) nil)
+ nil
+ (format "-Orientation#=%d"
+ (cl-case (truncate
+ (image-property image :rotation))
+ (0 0)
+ (90 6)
+ (180 3)
+ (270 8)
+ (otherwise 0)))
+ "-o" "-"
+ "-")
+ (current-buffer))))))
+
(defun mml-generate-mime-1 (cont)
(let ((mm-use-ultra-safe-encoding
(or mm-use-ultra-safe-encoding (assq 'sign cont))))
(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)))
filename)))))
(t
(let ((contents (cdr (assq 'contents cont))))
- (if (if (featurep 'xemacs)
- (string-match "[^\000-\377]" contents)
- (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.
(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)