;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(require 'sendmail)
(require 'mail-utils)
(require 'mel)
-(require 'eword-encode) ; eword-encode-field-body
(require 'mime-view)
(require 'signature)
(require 'alist)
-(require 'invisible)
-(require 'pgg-def)
-(require 'pgg-parse)
-
-(autoload 'pgg-encrypt-region "pgg"
- "PGP encryption of current region." t)
-(autoload 'pgg-sign-region "pgg"
- "PGP signature of current region." t)
-(autoload 'pgg-insert-key "pgg"
- "Insert PGP public key at point." t)
-(autoload 'smime-encrypt-region "smime"
- "S/MIME encryption of current region.")
-(autoload 'smime-sign-region "smime"
- "S/MIME signature of current region.")
-(defvar smime-output-buffer)
-(defvar smime-errors-buffer)
+(require 'epa)
+
+(autoload 'smime-encrypt-buffer "smime"
+ "S/MIME encryption of current buffer.")
+(autoload 'smime-sign-buffer "smime"
+ "S/MIME signature of current buffer.")
;;; @ version
("application"
("octet-stream" ("type" "" "tar" "shar"))
("postscript")
+ ("pdf")
+ ("msword")
+ ("vnd.ms-excel")
("vnd.ms-powerpoint")
("x-kiss" ("x-cnf")))
("image"
;; Octect binary text
("\\.doc$" ;MS Word
- "application" "winword" nil
+ "application" "msword" nil
+ "base64"
+ "attachment" (("filename" . file)))
+ ("\\.xls$" ; MS Excel
+ "application" "vnd.ms-excel" nil
"base64"
"attachment" (("filename" . file)))
("\\.ppt$" ; MS Power Point
"inline" (("filename" . file)))
("\\.ps$"
"application" "postscript" nil
- "quoted-printable"
+ "base64"
+ "attachment" (("filename" . file)))
+ ("\\.pdf$"
+ "application" "pdf" nil
+ "base64"
"attachment" (("filename" . file)))
;; Pure binary
- ("\\.jpg$"
+ ("\\.jpg$\\|\\.jpeg$"
"image" "jpeg" nil
"base64"
"inline" (("filename" . file)))
(iso-8859-7 8 "quoted-printable")
(iso-8859-8 8 "quoted-printable")
(iso-8859-9 8 "quoted-printable")
+ (iso-8859-14 8 "quoted-printable")
+ (iso-8859-15 8 "quoted-printable")
(iso-2022-jp 7 "base64")
(iso-2022-jp-3 7 "base64")
(iso-2022-kr 7 "base64")
") "
(if (fboundp 'apel-version)
(concat (apel-version) " "))
+ "EasyPG/ " epg-version-number " "
(if (featurep 'xemacs)
- (concat (cond ((featurep 'utf-2000)
+ (concat (cond ((and (featurep 'chise)
+ (boundp 'xemacs-chise-version))
+ (concat "CHISE-MULE/" xemacs-chise-version))
+ ((featurep 'utf-2000)
(concat "UTF-2000-MULE/" utf-2000-version))
((featurep 'mule) "MULE"))
" XEmacs"
;; XEmacs versions earlier than 21.1.1.
(format " (patch %d)" emacs-patch-level))
(t ""))
- " (" xemacs-codename ") ("
+ " (" xemacs-codename ")"
+ ;; `xemacs-extra-name' has appeared in the
+ ;; development version of XEmacs 21.5-b8.
+ (if (and (boundp 'xemacs-extra-name)
+ (symbol-value 'xemacs-extra-name))
+ (concat " " (symbol-value 'xemacs-extra-name))
+ "")
+ " ("
system-configuration ")")
" (" emacs-version ")"))
(let ((ver (if (string-match "\\.[0-9]+$" emacs-version)
(defconst mime-edit-mime-version-field-for-message/partial
(concat "MIME-Version:"
- (eword-encode-field-body
+ (mime-encode-field-body
(concat " 1.0 (split by " mime-edit-version ")\n")
- "MIME-Version:"))
+ "MIME-Version"))
"MIME version field for message/partial.")
(encrypted "Enclose as encrypted" mime-edit-enclose-pgp-encrypted-region)
(quote "Verbatim region" mime-edit-enclose-quote-region)
(key "Insert Public Key" mime-edit-insert-key)
- (split "About split" mime-edit-set-split)
- (sign "About sign" mime-edit-set-sign)
- (encrypt "About encryption" mime-edit-set-encrypt)
+ (split "Set splitting" mime-edit-set-split)
+ (sign "PGP sign" mime-edit-set-sign)
+ (encrypt "PGP encrypt" mime-edit-set-encrypt)
(preview "Preview Message" mime-edit-preview-message)
(level "Toggle transfer-level" mime-edit-toggle-transfer-level))
"MIME-edit menubar entry.")
(if (featurep 'xemacs)
(mime-edit-define-menu-for-xemacs))
- (enable-invisible)
-
;; I don't care about saving these.
(setq paragraph-start
(regexp-or mime-edit-single-part-tag-regexp
paragraph-separate))
(run-hooks 'mime-edit-mode-hook)
(message
+ "%s"
(substitute-command-keys
"Type \\[mime-edit-exit] to exit MIME mode, and type \\[mime-edit-help] to get help."))))
(if (and (featurep 'xemacs)
(featurep 'menubar))
(delete-menu-item (list mime-edit-menu-title)))
- (disable-invisible)
(set-buffer-modified-p (buffer-modified-p))
(run-hooks 'mime-edit-exit-hook)
(message "Exit MIME editor mode.")))
(mime-edit-insert-tag "audio" "basic" nil)
(mime-edit-define-encoding encoding)
(save-restriction
- (narrow-to-region (1- (point))(point))
+ (narrow-to-region (point)(point))
(unwind-protect
(funcall mime-edit-voice-recorder encoding)
(progn
(insert "\n")
- (mime-edit-invisible-region (point-min)(point-max))
+ (add-text-properties
+ (point-min)(point-max) '(invisible t mime-edit-invisible t))
(goto-char (point-max)))))))
(defun mime-edit-insert-signature (&optional arg)
nil ;Nothing is created.
)))
-(defun mime-edit-invisible-region (start end)
- (invisible-region start end) ;`invisible-region' might be overridden
- (static-if (featurep 'xemacs)
- (if (save-excursion
- (goto-char start)
- (eq (following-char) ?\n))
- (setq start (1+ start)))
- (if (save-excursion
- (goto-char (1- end))
- (eq (following-char) ?\n))
- (setq end (1- end))))
- (put-text-property start end 'mime-edit-invisible t))
-
-(defun mime-edit-invisible-p (pos)
- (static-when (featurep 'xemacs)
- (if (save-excursion
- (goto-char pos)
- (eq (following-char) ?\n))
- (setq pos (1+ pos))))
- (get-text-property pos 'mime-edit-invisible))
-
-(defun mime-edit-next-visible-point (pos)
- (static-if (featurep 'xemacs)
- (save-excursion
- (if (save-excursion
- (goto-char pos)
- (eq (following-char) ?\n))
- (setq pos (1+ pos)))
- (or (next-single-property-change pos 'mime-edit-invisible)
- (point-max)))
- (save-excursion
- (goto-char (next-single-property-change pos 'mime-edit-invisible))
- (if (eq (following-char) ?\n)
- (forward-char))
- (point))))
-
(defun mime-edit-insert-binary-file (file &optional encoding)
"Insert binary FILE at point.
Optional argument ENCODING specifies an encoding method such as base64."
(string-equal en "8bit")
(string-equal en "binary")))))))
(save-restriction
- (narrow-to-region tagend (point))
+ (narrow-to-region (point)(point))
(mime-insert-encoded-file file encoding)
(if hide-p
- (progn
- (mime-edit-invisible-region (point-min) (point-max))
- (goto-char (point-max)))
- (goto-char (point-max))))
+ (add-text-properties
+ (point-min)(point-max) '(invisible t mime-edit-invisible t)))
+ (goto-char (point-max)))
(or hide-p
(looking-at mime-edit-tag-regexp)
(= (point)(point-max))
(save-excursion
(if (mime-edit-goto-tag)
(progn
- (goto-char (match-end 0))
- (if (mime-edit-invisible-p (point))
- (mime-edit-next-visible-point (point))
+ (goto-char (1+ (match-end 0)))
+ (if (get-text-property (point) 'mime-edit-invisible)
+ (or (next-single-property-change (point) 'mime-edit-invisible)
+ (point-max))
;; Move to the end of this text.
(if (re-search-forward mime-edit-tag-regexp nil 'move)
;; Don't forget a multiline tag.
;; Change value
(concat (substring ctype 0 (match-beginning 1))
parameter "=" value
- (substring contype (match-end 1))
+ (substring ctype (match-end 1))
opt-fields)
(concat ctype "; " parameter "=" value opt-fields)
)))
(defun mime-prompt-for-parameter (parameter)
"Ask for PARAMETER.
-Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))."
+Parameter must be '(PROMPT CHOICE1 (CHOICE2...))."
(let* ((prompt (car parameter))
(choices (mapcar (function
(lambda (e)
(defun mime-edit-translate-header ()
"Encode the message header into network representation."
- (eword-encode-header 'code-conversion)
+ (mime-encode-header-in-buffer 'code-conversion)
(run-hooks 'mime-edit-translate-header-hook))
(defun mime-edit-translate-buffer ()
(defvar mime-edit-pgp-user-id nil)
+(defun mime-edit-delete-trailing-whitespace ()
+ (save-match-data
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "[ \t]+$" nil t)
+ (delete-region (match-beginning 0) (match-end 0))))))
+
(defun mime-edit-sign-pgp-mime (beg end boundary)
(save-excursion
(save-restriction
(ctype (car ret))
(encoding (nth 1 ret))
(pgp-boundary (concat "pgp-sign-" boundary))
+ (context (epg-make-context))
+ signature
micalg)
+ (mime-edit-delete-trailing-whitespace) ; RFC3156
(goto-char beg)
(insert (format "Content-Type: %s\n" ctype))
(if encoding
(insert (format "Content-Transfer-Encoding: %s\n" encoding)))
(insert "\n")
- (or (let ((pgg-default-user-id
- (or mime-edit-pgp-user-id
- (if from
- (nth 1 (std11-extract-address-components from))
- pgg-default-user-id))))
- (pgg-sign-region (point-min)(point-max)))
- (throw 'mime-edit-error 'pgp-error))
- (setq micalg
- (cdr (assq 'hash-algorithm
- (cdar (with-current-buffer pgg-output-buffer
- (pgg-parse-armor-region
- (point-min)(point-max))))))
- micalg
- (if micalg
- (concat "; micalg=pgp-" (downcase (symbol-name micalg)))
- ""))
+ (epg-context-set-armor context t)
+ (epg-context-set-textmode context t)
+ (epg-context-set-signers
+ context
+ (epa-select-keys
+ "\
+Select keys for signing.
+If no one is selected, default secret key is used. "
+ (if from
+ (list (nth 1 (std11-extract-address-components from))))
+ t))
+ (condition-case error
+ (setq signature
+ (epg-sign-string context
+ (buffer-substring (point-min) (point-max))
+ 'detached))
+ (error (signal 'mime-edit-error (cdr error))))
+ (setq micalg (cdr (assq 'digest-algorithm
+ (car (epg-context-result-for context 'sign)))))
(goto-char beg)
(insert (format "--[[multipart/signed;
boundary=\"%s\"%s;
protocol=\"application/pgp-signature\"][7bit]]
--%s
-" pgp-boundary micalg pgp-boundary))
+"
+ pgp-boundary
+ (if micalg
+ (concat "; micalg=pgp-"
+ (downcase
+ (cdr (assq micalg
+ epg-digest-algorithm-alist))))
+ "")
+ pgp-boundary))
(goto-char (point-max))
(insert (format "\n--%s
Content-Type: application/pgp-signature
Content-Transfer-Encoding: 7bit
" pgp-boundary))
- (insert-buffer-substring pgg-output-buffer)
+ (insert signature)
(goto-char (point-max))
(insert (format "\n--%s--\n" pgp-boundary))))))
(defun mime-edit-encrypt-pgp-mime (beg end boundary)
(save-excursion
(save-restriction
- (let (from recipients header)
+ (let (recipients header)
(let ((ret (mime-edit-make-encrypt-recipient-header)))
- (setq from (aref ret 0)
- recipients (aref ret 1)
+ (setq recipients (aref ret 1)
header (aref ret 2)))
(narrow-to-region beg end)
(let* ((ret
(mime-edit-translate-region beg end boundary))
(ctype (car ret))
(encoding (nth 1 ret))
- (pgp-boundary (concat "pgp-" boundary)))
+ (pgp-boundary (concat "pgp-" boundary))
+ (context (epg-make-context))
+ cipher)
(goto-char beg)
(insert header)
(insert (format "Content-Type: %s\n" ctype))
(if encoding
(insert (format "Content-Transfer-Encoding: %s\n" encoding)))
(insert "\n")
- (eword-encode-header)
- (or (let ((pgg-default-user-id
- (or mime-edit-pgp-user-id
- (if from
- (nth 1 (std11-extract-address-components from))
- pgg-default-user-id))))
- (pgg-encrypt-region
- (point-min) (point-max)
- (mapcar (lambda (recipient)
- (nth 1 (std11-extract-address-components
- recipient)))
- (split-string recipients
- "\\([ \t\n]*,[ \t\n]*\\)+"))))
- (throw 'mime-edit-error 'pgp-error))
+ (mime-encode-header-in-buffer)
+ (epg-context-set-armor context t)
+ (condition-case error
+ (setq cipher
+ (epg-encrypt-string
+ context
+ (buffer-substring (point-min) (point-max))
+ (epa-select-keys
+ "\
+Select recipents for encryption.
+If no one is selected, symmetric encryption will be performed. "
+ (mapcar (lambda (recipient)
+ (nth 1 (std11-extract-address-components
+ recipient)))
+ (split-string recipients
+ "\\([ \t\n]*,[ \t\n]*\\)+")))))
+ (error (signal 'mime-edit-error (cdr error))))
(delete-region (point-min)(point-max))
(goto-char beg)
(insert (format "--[[multipart/encrypted;
Content-Transfer-Encoding: 7bit
" pgp-boundary pgp-boundary pgp-boundary))
- (insert-buffer-substring pgg-output-buffer)
+ (insert cipher)
(goto-char (point-max))
(insert (format "\n--%s--\n" pgp-boundary)))))))
(let* ((ret
(mime-edit-translate-region beg end boundary))
(ctype (car ret))
- (encoding (nth 1 ret)))
+ (encoding (nth 1 ret))
+ (context (epg-make-context))
+ signature)
(goto-char beg)
(insert (format "Content-Type: %s\n" ctype))
(if encoding
(insert (format "Content-Transfer-Encoding: %s\n" encoding)))
(insert "\n")
- (or (pgg-sign-region beg (point-max) 'clearsign)
- (throw 'mime-edit-error 'pgp-error))
+ (condition-case error
+ (setq signature
+ (epg-sign-string context
+ (buffer-substring beg (point-max))
+ 'clearsign))
+ (error (signal 'mime-edit-error (cdr error))))
(goto-char beg)
(insert
"--[[application/pgp; format=mime][7bit]]\n")
(let* ((ret
(mime-edit-translate-region beg end boundary))
(ctype (car ret))
- (encoding (nth 1 ret)))
+ (encoding (nth 1 ret))
+ (context (epg-make-context))
+ cipher)
(goto-char beg)
(insert header)
(insert (format "Content-Type: %s\n" ctype))
(if encoding
(insert (format "Content-Transfer-Encoding: %s\n" encoding)))
(insert "\n")
- (or (pgg-encrypt-region beg (point-max) recipients)
- (throw 'mime-edit-error 'pgp-error))
+ (epg-context-set-armor context t)
+ (condition-case error
+ (setq cipher
+ (epg-encrypt-string
+ context
+ (buffer-substring beg (point-max))
+ (epa-select-keys
+ "\
+Select recipents for encryption.
+If no one is selected, symmetric encryption will be performed. "
+ (mapcar (lambda (recipient)
+ (nth 1 (std11-extract-address-components
+ recipient)))
+ (split-string recipients
+ "\\([ \t\n]*,[ \t\n]*\\)+")))))
+ (error (signal 'mime-edit-error (cdr error))))
(goto-char beg)
(insert
- "--[[application/pgp; format=mime][7bit]]\n")
+ "--[[application/pgp; format=mime][7bit]]\n" cipher)
)))))
(defun mime-edit-sign-smime (beg end boundary)
(while (progn (end-of-line) (not (eobp)))
(insert "\r")
(forward-line 1))
- (or (prog1 (smime-sign-region (point-min)(point-max))
- (push nil buffer-undo-list)
- (ignore-errors (undo)))
+ (or (smime-sign-buffer)
(throw 'mime-edit-error 'pgp-error)))
(goto-char beg)
- (insert (format "--[[multipart/signed;
- boundary=\"%s\"; micalg=sha1;
- protocol=\"application/pkcs7-signature\"][7bit]]
---%s
-" smime-boundary smime-boundary))
- (goto-char (point-max))
- (insert (format "\n--%s
-Content-Type: application/pkcs7-signature; name=\"smime.p7s\"
-Content-Transfer-Encoding: base64
-Content-Disposition: attachment; filename=\"smime.p7s\"
-Content-Description: S/MIME Cryptographic Signature
-
-" smime-boundary))
- (insert-buffer-substring smime-output-buffer)
- (goto-char (point-max))
- (insert (format "\n--%s--\n" smime-boundary))))))
+ (if (re-search-forward "^Content-Type:\\s-*" nil t)
+ (let* ((start (match-beginning 0))
+ (body (buffer-substring (match-end 0) (std11-field-end))))
+ (delete-region start (line-beginning-position 2))
+ (goto-char beg)
+ (insert "--[[" body "][7bit]]\n")))))))
(defun mime-edit-encrypt-smime (beg end boundary)
(save-excursion
(while (progn (end-of-line) (not (eobp)))
(insert "\r")
(forward-line 1))
- (or (smime-encrypt-region (point-min)(point-max))
+ (or (smime-encrypt-buffer)
(throw 'mime-edit-error 'pgp-error))
- (delete-region (point-min)(point-max))
- (insert "--[[application/pkcs7-mime; name=\"smime.p7m\"
-Content-Disposition: attachment; filename=\"smime.p7m\"
-Content-Description: S/MIME Encrypted Message][base64]]\n")
- (insert-buffer-substring smime-output-buffer)))))
+ (goto-char beg)
+ (if (re-search-forward "^Content-Type:\\s-*" nil t)
+ (let* ((start (match-beginning 0))
+ (body (buffer-substring (match-end 0) (std11-field-end))))
+ (delete-region start (line-beginning-position 2))
+ (goto-char beg)
+ (insert "--[[" body "]]\n")))))))
(defsubst replace-space-with-underline (str)
(mapconcat (function
(insert "Content-Type: " contype "\n")
(if encoding
(insert "Content-Transfer-Encoding: " encoding "\n"))
- (eword-encode-header))
+ (mime-encode-header-in-buffer))
(cons (and contype
(downcase contype))
(and encoding
(or (looking-at mime-edit-beginning-tag-regexp)
(eobp)
(insert (mime-make-text-tag) "\n")))
- (visible-region beg end)
+ (remove-text-properties beg end '(invisible mime-edit-invisible))
(goto-char beg))
(cond
((mime-test-content-type contype "message")
(narrow-to-region beg (mime-edit-content-end))
(goto-char beg)
(while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t)
- (replace-match "\\1\r\n"))))
+ ;; In a certain period, `replace-match' with "\\N"
+ ;; converted 8-bit characters into multibyte string,
+ ;; but it has been fixed at 2004-01-15.
+ ;;(replace-match "\\1\r\n"))))
+ (backward-char 1)
+ (insert "\r")
+ (forward-char 1))))
(goto-char beg)
(mime-encode-region beg (mime-edit-content-end)
(or encoding "7bit"))
(interactive "P")
(mime-edit-insert-tag "application" "pgp-keys")
(mime-edit-define-encoding "7bit")
- (pgg-insert-key)
+ (let ((context (epg-make-context)))
+ (epg-context-set-armor t)
+ (epg-export-keys-to-string context
+ (epa-select-keys "Select keys for export. ")))
(if (and (not (eobp))
(not (looking-at mime-edit-single-part-tag-regexp)))
(insert (mime-make-text-tag) "\n")))
(setq mime-edit-message-max-length
(or (cdr (assq major-mode mime-edit-message-max-lines-alist))
mime-edit-message-default-max-lines)))
- (let* ((mime-edit-draft-file-name
- (or (buffer-file-name)
- (make-temp-name
- (expand-file-name "mime-draft" temporary-file-directory))))
- (separator mail-header-separator)
- (id (concat "\""
- (replace-space-with-underline (current-time-string))
- "@" (system-name) "\"")))
+ (let ((separator mail-header-separator)
+ (id (concat "\""
+ (replace-space-with-underline (current-time-string))
+ "@" (system-name) "\"")))
(run-hooks 'mime-edit-before-split-hook)
(let ((the-buf (current-buffer))
(copy-buf (get-buffer-create " *Original Message*"))
(message (format "Sending %d/%d..."
mime-edit-partial-number total))
(call-interactively command)
- (message (format "Sending %d/%d... done"
+ (message (format "Sending %d/%d...done"
mime-edit-partial-number total)))
(setq mime-edit-partial-number
(1+ mime-edit-partial-number)))
(save-excursion
(message (format "Sending %d/%d..."
mime-edit-partial-number total))
- (message (format "Sending %d/%d... done"
+ (message (format "Sending %d/%d...done"
mime-edit-partial-number total))))))
(defun mime-edit-maybe-split-and-send (&optional cmd)
;;;
(defvar mime-edit-buffer nil) ; buffer local variable
+(defvar mime-edit-temp-message-buffer nil) ; buffer local variable
(defun mime-edit-preview-message ()
"preview editing MIME message."
nil t))
(prog1
(save-window-excursion
- (pgg-decrypt-region (match-beginning 0)
- (point-max)))
+ (epg-decrypt-string
+ (epg-make-context)
+ (buffer-substring
+ (match-beginning 0)
+ (point-max))))
(delete-region (point-min)(point-max))))
(insert-buffer-substring pgg-output-buffer)
(mime-edit-decode-message-in-buffer
(match-end 0)(point-max) encoding)
(setq encoded t
encoding nil))))))))
- (if (or encoded (not not-decode-text))
- (progn
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "\r\n" nil t)
- (replace-match "\n")))
- (decode-mime-charset-region (point-min)(point-max)
- (or charset default-mime-charset))))
+ (if (and (eq type 'text)
+ (or encoded (not not-decode-text)))
+ (progn
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "\r\n" nil t)
+ (replace-match "\n")))
+ (decode-mime-charset-region (point-min)(point-max)
+ (or charset default-mime-charset))))
(let ((he (if (re-search-forward "^$" nil t)
(match-end 0)
(point-min))))
projects / elisp / semi.git / blobdiff