X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tm-edit.el;h=70268a28b5c9dd4adc09ab0ebe868648822e9315;hb=e2aa14e5654094e9e8dc4434192bab7f8974e0f7;hp=278853d2081b1c02a5e8a4d49735d6210c732758;hpb=c4f426c5c7ef1a007023cb42e70440e2f94c10ab;p=elisp%2Ftm.git diff --git a/tm-edit.el b/tm-edit.el index 278853d..70268a2 100644 --- a/tm-edit.el +++ b/tm-edit.el @@ -1,48 +1,47 @@ -;;; ;;; tm-edit.el --- Simple MIME Composer for GNU Emacs -;;; -;;; Copyright (C) 1993 UMEDA Masanobu -;;; Copyright (C) 1994 .. 1996 MORIOKA Tomohiko -;;; -;;; Author: UMEDA Masanobu -;;; MORIOKA Tomohiko -;;; Maintainer: MORIOKA Tomohiko -;;; Created: 1994/08/21 renamed from mime.el -;;; Version: $Revision: 7.74 $ -;;; Keywords: mail, news, MIME, multimedia, multilingual -;;; -;;; This file is part of tm (Tools for MIME). -;;; -;;; This program 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. -;;; -;;; This program 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 This program. If not, write to the Free Software -;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;; Copyright (C) 1993 .. 1996 Free Software Foundation, Inc. + +;; Author: UMEDA Masanobu +;; MORIOKA Tomohiko +;; Maintainer: MORIOKA Tomohiko +;; Created: 1994/08/21 renamed from mime.el +;; Version: $Revision: 7.99 $ +;; Keywords: mail, news, MIME, multimedia, multilingual + +;; This file is part of tm (Tools for MIME). + +;; This program 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. + +;; This program 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: ;; This is an Emacs minor mode for editing Internet multimedia -;; messages formatted in MIME (RFC 1521 and RFC 1522). All messages in -;; this mode are composed in the tagged MIME format, that are -;; described in the following examples. The messages composed in the -;; tagged MIME format are automatically translated into a MIME -;; compliant message when exiting the mode. +;; messages formatted in MIME (RFC 2045, 2046, 2047, 2048 and 2049). +;; All messages in this mode are composed in the tagged MIME format, +;; that are described in the following examples. The messages +;; composed in the tagged MIME format are automatically translated +;; into a MIME compliant message when exiting the mode. ;; Mule (a multilingual extension to Emacs 18 and 19) has a capability ;; of handling multilingual text in limited ISO-2022 manner that is ;; based on early experiences in Japanese Internet community and -;; resulted in RFC 1468 (ISO-2022-JP charset for MIME). In order to +;; resulted in RFC 1468 (ISO-2022-JP charset for MIME). In order to ;; enable multilingual capability in single text message in MIME, ;; charset of multilingual text written in Mule is declared as either -;; `ISO-2022-JP-2' [RFC 1554] or `ISO-2022-INT-1'. Mule is required +;; `ISO-2022-JP-2' [RFC 1554] or `ISO-2022-INT-1'. Mule is required ;; for reading the such messages. ;; This MIME composer can work with Mail mode, mh-e letter Mode, and @@ -111,7 +110,6 @@ (require 'sendmail) (require 'mail-utils) (require 'mel) -(require 'tl-822) (require 'tl-list) (require 'tm-view) (require 'tm-ew-e) @@ -122,7 +120,7 @@ ;;; (defconst mime-editor/RCS-ID - "$Id: tm-edit.el,v 7.74 1996/07/24 10:27:07 morioka Exp $") + "$Id: tm-edit.el,v 7.99 1996/12/24 12:08:50 morioka Exp $") (defconst mime-editor/version (get-version-string mime-editor/RCS-ID)) @@ -149,9 +147,9 @@ If non-nil, the text tag is not inserted unless something different.") (defvar mime-auto-hide-body t "*Hide non-textual body encoded in base64 after insertion if non-nil.") -(defvar mime-voice-recorder - (function mime-voice-recorder-for-sun) - "*Function to record a voice message and return a buffer that contains it.") +(defvar mime-editor/voice-recorder + (function mime-editor/voice-recorder-for-sun) + "*Function to record a voice message and encode it. [tm-edit.el]") (defvar mime/editor-mode-hook nil "*Hook called when enter MIME mode.") @@ -294,42 +292,42 @@ To insert a signature file automatically, call the function ) ("\\.tar\\.gz$" "application" "octet-stream" (("type" . "tar+gzip")) - nil + "base64" "attachment" (("filename" . file)) ) ("\\.tgz$" "application" "octet-stream" (("type" . "tar+gzip")) - nil + "base64" "attachment" (("filename" . file)) ) ("\\.tar\\.Z$" "application" "octet-stream" (("type" . "tar+compress")) - nil + "base64" "attachment" (("filename" . file)) ) ("\\.taz$" "application" "octet-stream" (("type" . "tar+compress")) - nil + "base64" "attachment" (("filename" . file)) ) ("\\.gz$" "application" "octet-stream" (("type" . "gzip")) - nil + "base64" "attachment" (("filename" . file)) ) ("\\.Z$" "application" "octet-stream" (("type" . "compress")) - nil + "base64" "attachment" (("filename" . file)) ) ("\\.lzh$" "application" "octet-stream" (("type" . "lha")) - nil + "base64" "attachment" (("filename" . file)) ) ("\\.zip$" "application" "zip" nil - nil + "base64" "attachment" (("filename" . file)) ) ("\\.diff$" @@ -386,7 +384,8 @@ If encoding is nil, it is determined from its contents.") ;;; (defvar mime-editor/yank-ignored-field-list - '("Received" "Approved" "Path" "Replied" "Status" "X-VM-.*" "X-UIDL") + '("Received" "Approved" "Path" "Replied" "Status" + "Xref" "X-UIDL" "X-Filter" "X-Gnus-.*" "X-VM-.*") "Delete these fields from original message when it is inserted as message/rfc822 part. Each elements are regexp of field-name. [tm-edit.el]") @@ -405,11 +404,14 @@ Each elements are regexp of field-name. [tm-edit.el]") (defvar mime-editor/split-message t "*Split large message if it is non-nil. [tm-edit.el]") -(defvar mime-editor/message-default-max-length 1000 - "*Default maximum size of a message. [tm-edit.el]") +(defvar mime-editor/message-default-max-lines 1000 + "*Default maximum lines of a message. [tm-edit.el]") -(defvar mime-editor/message-max-length-alist - '((news-reply-mode . 500))) +(defvar mime-editor/message-max-lines-alist + '((news-reply-mode . 500)) + "Alist of major-mode vs maximum lines of a message. +If it is not specified for a major-mode, +`mime-editor/message-default-max-lines' is used. [tm-edit.el]") (defconst mime-editor/split-ignored-field-regexp "\\(^Content-\\|^Subject:\\|^Mime-Version:\\)") @@ -417,29 +419,7 @@ Each elements are regexp of field-name. [tm-edit.el]") (defvar mime-editor/split-blind-field-regexp "\\(^[BDFbdf]cc:\\|^cc:[ \t]*$\\)") -(defvar mime-editor/split-message-sender-alist - '((mh-letter-mode - . (lambda (&optional arg) - (interactive "P") - (write-region (point-min) (point-max) - mime-editor/draft-file-name nil 'no-message) - (cond (arg - (pop-to-buffer "MH mail delivery") - (erase-buffer) - (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush" - "-nodraftfolder" - mh-send-args mime-editor/draft-file-name) - (goto-char (point-max)) ; show the interesting part - (recenter -1) - (sit-for 1)) - (t - (apply 'mh-exec-cmd-quiet t mh-send-prog - (mh-list-to-string - (list "-nopush" "-nodraftfolder" - "-noverbose" "-nowatch" - mh-send-args mime-editor/draft-file-name))))) - )) - )) +(defvar mime-editor/split-message-sender-alist nil) (defvar mime-editor/news-reply-mode-server-running nil) @@ -447,15 +427,21 @@ Each elements are regexp of field-name. [tm-edit.el]") ;;; @@ about PGP ;;; -(defvar mime-editor/signing-type nil +(defvar mime-editor/signing-type 'pgp-elkins "*PGP signing type (pgp-elkins, pgp-kazu or nil). [tm-edit.el]") -(defvar mime-editor/encrypting-type nil +(defvar mime-editor/encrypting-type 'pgp-elkins "*PGP encrypting type (pgp-elkins, pgp-kazu or nil). [tm-edit.el]") -(if (or mime-editor/signing-type mime-editor/encrypting-type) - (require 'mailcrypt) - ) +(defvar mime-editor/pgp-sign-function 'tm:mc-pgp-sign-region) +(defvar mime-editor/pgp-encrypt-function 'tm:mc-pgp-encrypt-region) +(defvar mime-editor/traditional-pgp-sign-function 'mc-pgp-sign-region) +(defvar mime-editor/pgp-insert-public-key-function 'mc-insert-public-key) + +(autoload mime-editor/pgp-sign-function "tm-edit-mc") +(autoload mime-editor/pgp-encrypt-function "tm-edit-mc") +(autoload mime-editor/traditional-pgp-sign-function "mc-pgp") +(autoload mime-editor/pgp-insert-public-key-function "mc-toplev") ;;; @@ about tag @@ -546,6 +532,11 @@ Tspecials means any character that matches with it in header must be quoted.") (define-key keymap "s" 'mime-editor/enclose-signed-region) (define-key keymap "e" 'mime-editor/enclose-encrypted-region) (define-key keymap "q" 'mime-editor/enclose-quote-region) + (define-key keymap "7" 'mime-editor/set-transfer-level-7bit) + (define-key keymap "8" 'mime-editor/set-transfer-level-8bit) + (define-key keymap "/" 'mime-editor/set-split) + (define-key keymap "v" 'mime-editor/set-sign) + (define-key keymap "h" 'mime-editor/set-encrypt) (define-key keymap "\C-p" 'mime-editor/preview-message) (define-key keymap "\C-z" 'mime-editor/exit) (define-key keymap "?" 'mime-editor/help) @@ -763,10 +754,10 @@ User customizable variables (not documented all of them): Hide a non-textual body message encoded in base64 after insertion if non-nil. - mime-voice-recorder - Specifies a function to record a voice message and return a buffer - that contains it. The function mime-voice-recorder-for-sun is for - Sun SparcStations. + mime-editor/voice-recorder + Specifies a function to record a voice message and encode it. + The function `mime-editor/voice-recorder-for-sun' is for Sun + SparcStations. mime/editor-mode-hook Turning on MIME mode calls the value of mime/editor-mode-hook, if @@ -787,11 +778,12 @@ User customizable variables (not documented all of them): (setq mime/editor-mode-flag t) ;; Remember old key bindings. (if running-xemacs - nil + (use-local-map (or (current-local-map) (make-sparse-keymap))) (make-local-variable 'mime/editor-mode-old-local-map) (setq mime/editor-mode-old-local-map (current-local-map)) ;; Add MIME commands to current local map. - (use-local-map (copy-keymap (current-local-map))) + (use-local-map (copy-keymap (or (current-local-map) + (make-sparse-keymap)))) ) (if (not (lookup-key (current-local-map) mime-prefix)) (define-key (current-local-map) mime-prefix mime-editor/mime-map)) @@ -874,40 +866,41 @@ just return to previous mode." "Insert a text message. Charset is automatically obtained from the `mime/lc-charset-alist'." (interactive) - (if (and (mime-editor/insert-tag "text" nil nil) - (looking-at mime-editor/single-part-tag-regexp)) + (let ((ret (mime-editor/insert-tag "text" nil nil))) + (if ret (progn - ;; Make a space between the following message. - (insert "\n") - (forward-char -1) - ))) + (if (looking-at mime-editor/single-part-tag-regexp) + (progn + ;; Make a space between the following message. + (insert "\n") + (forward-char -1) + )) + (if (and (member (second ret) '("enriched" "richtext")) + (fboundp 'enriched-mode) + ) + (enriched-mode t) + (if (boundp 'enriched-mode) + (enriched-mode nil) + )))))) -(defun mime-editor/insert-file (file) +(defun mime-editor/insert-file (file &optional verbose) "Insert a message from a file." - (interactive "fInsert file as MIME message: ") + (interactive "fInsert file as MIME message: \nP") (let* ((guess (mime-find-file-type file)) - (pritype (nth 0 guess)) + (type (nth 0 guess)) (subtype (nth 1 guess)) (parameters (nth 2 guess)) - (default (nth 3 guess)) ;Guess encoding from its file name. + (encoding (nth 3 guess)) (disposition-type (nth 4 guess)) (disposition-params (nth 5 guess)) - (encoding - (if (not (interactive-p)) - default - (completing-read - (concat "What transfer encoding" - (if default - (concat " (default " - (if (string-equal default "") - "\"\"" - default) - ")" - )) - ": ") - mime-encoding-method-alist nil t nil)))) - (if (string-equal encoding "") - (setq encoding default)) + ) + (if verbose + (setq type (mime-prompt-for-type type) + subtype (mime-prompt-for-subtype type subtype) + )) + (if (or (interactive-p) verbose) + (setq encoding (mime-prompt-for-encoding encoding)) + ) (if (or (consp parameters) (stringp disposition-type)) (let ((rest parameters) cell attribute value) (setq parameters "") @@ -916,7 +909,7 @@ Charset is automatically obtained from the `mime/lc-charset-alist'." (setq attribute (car cell)) (setq value (cdr cell)) (if (eq value 'file) - (setq value (rfc822/wrap-as-quoted-string + (setq value (std11-wrap-as-quoted-string (file-name-nondirectory file))) ) (setq parameters (concat parameters "; " attribute "=" value)) @@ -933,7 +926,7 @@ Charset is automatically obtained from the `mime/lc-charset-alist'." (setq attribute (car cell)) (setq value (cdr cell)) (if (eq value 'file) - (setq value (rfc822/wrap-as-quoted-string + (setq value (std11-wrap-as-quoted-string (file-name-nondirectory file))) ) (setq parameters @@ -942,7 +935,7 @@ Charset is automatically obtained from the `mime/lc-charset-alist'." ) )) )) - (mime-editor/insert-tag pritype subtype parameters) + (mime-editor/insert-tag type subtype parameters) (mime-editor/insert-binary-file file encoding) )) @@ -967,12 +960,21 @@ Charset is automatically obtained from the `mime/lc-charset-alist'." (defun mime-editor/insert-voice () "Insert a voice message." (interactive) - (mime-editor/insert-tag "audio" "basic" nil) - (let ((buffer (funcall mime-voice-recorder))) - (unwind-protect - (mime-editor/insert-binary-buffer buffer "base64") - (kill-buffer buffer) - ))) + (let ((encoding + (completing-read + "What transfer encoding: " + mime-file-encoding-method-alist nil t nil))) + (mime-editor/insert-tag "audio" "basic" nil) + (mime-editor/define-encoding encoding) + (save-restriction + (narrow-to-region (1- (point))(point)) + (unwind-protect + (funcall mime-editor/voice-recorder encoding) + (progn + (insert "\n") + (invisible-region (point-min)(point-max)) + (goto-char (point-max)) + ))))) (defun mime-editor/insert-signature (&optional arg) "Insert a signature file." @@ -994,6 +996,15 @@ Charset is automatically obtained from the `mime/lc-charset-alist'." "Insert new MIME tag and return a list of PRITYPE, SUBTYPE, and PARAMETERS. If nothing is inserted, return nil." (interactive) + (let ((p (point))) + (mime-editor/goto-tag) + (if (and (re-search-forward mime-editor/tag-regexp nil t) + (< (match-beginning 0) p) + (< p (match-end 0)) + ) + (goto-char (match-beginning 0)) + (goto-char p) + )) (let ((oldtag nil) (newtag nil) (current (point)) @@ -1038,73 +1049,40 @@ If nothing is inserted, return nil." ) )) -;; Insert the binary content after MIME tag. -;; modified by MORITA Masahiro -;; for x-uue (defun mime-editor/insert-binary-file (file &optional encoding) "Insert binary FILE at point. Optional argument ENCODING specifies an encoding method such as base64." - (let ((tmpbuf (get-buffer-create " *MIME insert*"))) - (save-excursion - (set-buffer tmpbuf) - (erase-buffer) - (let ((mc-flag nil) ;Mule - (file-coding-system-for-read - (if (featurep 'mule) *noconv*)) - (kanji-flag nil) ;NEmacs - (emx-binary-mode t) ;Stop CRLF to LF conversion in OS/2 - ) - (let (jka-compr-compression-info-list - jam-zcat-filename-list) - (insert-file-contents file)))) - (prog1 - (if (and (stringp encoding) - (string-equal (downcase encoding) "x-uue")) - (progn - (require 'mel-u) - (let ((uuencode-external-encoder - (cons (car uuencode-external-encoder) - (list (file-name-nondirectory file)) - ))) - (mime-editor/insert-binary-buffer tmpbuf encoding) - )) - (mime-editor/insert-binary-buffer tmpbuf encoding)) - (kill-buffer tmpbuf)))) - -;; Insert the binary content after MIME tag. -;; modified by MORITA Masahiro -;; for x-uue -(defun mime-editor/insert-binary-buffer (buffer &optional encoding) - "Insert binary BUFFER at point. -Optional argument ENCODING specifies an encoding method such as base64." (let* ((tagend (1- (point))) ;End of the tag (hide-p (and mime-auto-hide-body (stringp encoding) - (let ((en (downcase encoding))) - (or (string-equal en "base64") - (string-equal en "x-uue") - )))) + (not + (let ((en (downcase encoding))) + (or (string-equal en "7bit") + (string-equal en "8bit") + (string-equal en "binary") + ))))) ) (save-restriction - (narrow-to-region (1- (point)) (point)) - (let ((start (point)) - (emx-binary-mode t)) ;Stop LF to CRLF conversion in OS/2 - (insert-buffer-substring buffer) - ;; Encode binary message if necessary. - (if encoding - (mime-encode-region start (point-max) encoding) - )) + (narrow-to-region tagend (point)) + (mime-insert-encoded-file file encoding) (if hide-p (progn (invisible-region (point-min) (point-max)) (goto-char (point-max)) ) + (goto-char (point-max)) )) + (or hide-p + (looking-at mime-editor/tag-regexp) + (= (point)(point-max)) + (mime-editor/insert-tag "text" "plain") + ) ;; Define encoding even if it is 7bit. (if (stringp encoding) (save-excursion - (goto-char tagend) ;Make sure which line the tag is on. - (mime-editor/define-encoding encoding))) + (goto-char tagend) ; Make sure which line the tag is on. + (mime-editor/define-encoding encoding) + )) )) @@ -1310,7 +1288,7 @@ Nil if no such parameter." guess )) -(defun mime-prompt-for-type () +(defun mime-prompt-for-type (&optional default) "Ask for Content-type." (let ((type "")) ;; Repeat until primary content type is specified. @@ -1320,7 +1298,7 @@ Nil if no such parameter." mime-content-types nil 'require-match ;Type must be specified. - nil + default )) (if (string-equal type "") (progn @@ -1329,19 +1307,22 @@ Nil if no such parameter." (sit-for 1) )) ) - type - )) - -(defun mime-prompt-for-subtype (pritype) - "Ask for Content-type subtype of Content-Type PRITYPE." - (let* ((default (car (car (cdr (assoc pritype mime-content-types))))) - (answer + type)) + +(defun mime-prompt-for-subtype (type &optional default) + "Ask for subtype of media-type TYPE." + (let ((subtypes (cdr (assoc type mime-content-types)))) + (or (and default + (assoc default subtypes)) + (setq default (car (car subtypes))) + )) + (let* ((answer (completing-read (if default (concat "What content subtype: (default " default ") ") "What content subtype: ") - (cdr (assoc pritype mime-content-types)) + (cdr (assoc type mime-content-types)) nil 'require-match ;Subtype must be specified. nil @@ -1404,17 +1385,17 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (mime-prompt-for-parameters-1 (cdr (assoc answer (cdr parameter))))) )) -(defun mime-flag-region (from to flag) - "Hides or shows lines from FROM to TO, according to FLAG. -If FLAG is `\\n' (newline character) then text is shown, -while if FLAG is `\\^M' (control-M) the text is hidden." - (let ((buffer-read-only nil) ;Okay even if write protected. - (modp (buffer-modified-p))) - (unwind-protect - (subst-char-in-region from to - (if (= flag ?\n) ?\^M ?\n) - flag t) - (set-buffer-modified-p modp)))) +(defun mime-prompt-for-encoding (default) + "Ask for Content-Transfer-Encoding. [tm-edit.el]" + (let (encoding) + (while (string= + (setq encoding + (completing-read + "What transfer encoding: " + mime-file-encoding-method-alist nil t default) + ) + "")) + encoding)) ;;; @ Translate the tagged MIME messages into a MIME compliant message. @@ -1422,9 +1403,15 @@ while if FLAG is `\\^M' (control-M) the text is hidden." (defvar mime-editor/translate-buffer-hook '(mime-editor/pgp-enclose-buffer - mime/encode-message-header + mime-editor/translate-header mime-editor/translate-body)) +(defun mime-editor/translate-header () + "Encode the message header into network representation." + (mime/encode-message-header 'code-conversion) + (run-hooks 'mime-editor/translate-header-hook) + ) + (defun mime-editor/translate-buffer () "Encode the tagged MIME message in current buffer in MIME compliant message." (interactive) @@ -1538,129 +1525,6 @@ while if FLAG is `\\^M' (control-M) the text is hidden." (replace-match (concat "-" (substring tag 2))) ))))) -(autoload 'mc-pgp-lookup-key "mc-pgp") -(autoload 'mc-pgp-sign-region "mc-pgp") -(autoload 'mc-pgp-encrypt-region "mc-pgp") - -(defun tm:mc-pgp-generic-parser (result) - (let ((ret (mc-pgp-generic-parser result))) - (if (consp ret) - (vector (car ret)(cdr ret)) - ))) - -(defun tm:mc-process-region - (beg end passwd program args parser &optional buffer boundary) - (let ((obuf (current-buffer)) - (process-connection-type nil) - mybuf result rgn proc) - (unwind-protect - (progn - (setq mybuf (or buffer (generate-new-buffer " *mailcrypt temp"))) - (set-buffer mybuf) - (erase-buffer) - (set-buffer obuf) - (buffer-disable-undo mybuf) - (setq proc - (apply 'start-process "*PGP*" mybuf program args)) - (if passwd - (progn - (process-send-string proc (concat passwd "\n")) - (or mc-passwd-timeout (mc-deactivate-passwd t)))) - (process-send-region proc beg end) - (process-send-eof proc) - (while (eq 'run (process-status proc)) - (accept-process-output proc 5)) - (setq result (process-exit-status proc)) - ;; Hack to force a status_notify() in Emacs 19.29 - (delete-process proc) - (set-buffer mybuf) - (goto-char (point-max)) - (if (re-search-backward "\nProcess \\*PGP.*\n\\'" nil t) - (delete-region (match-beginning 0) (match-end 0))) - (goto-char (point-min)) - ;; CRNL -> NL - (while (search-forward "\r\n" nil t) - (replace-match "\n")) - ;; Hurm. FIXME; must get better result codes. - (if (stringp result) - (error "%s exited abnormally: '%s'" program result) - (setq rgn (funcall parser result)) - ;; If the parser found something, migrate it - (if (consp rgn) - (progn - (set-buffer obuf) - (if boundary - (save-restriction - (narrow-to-region beg end) - (goto-char beg) - (insert (format "--%s\n" boundary)) - (goto-char (point-max)) - (insert (format "\n--%s -Content-Type: application/pgp-signature -Content-Transfer-Encoding: 7bit - -" boundary)) - (insert-buffer-substring mybuf (car rgn) (cdr rgn)) - (goto-char (point-max)) - (insert (format "\n--%s--\n" boundary)) - ) - (delete-region beg end) - (goto-char beg) - (insert-buffer-substring mybuf (car rgn) (cdr rgn)) - ) - (set-buffer mybuf) - (delete-region (car rgn) (cdr rgn))))) - ;; Return nil on failure and exit code on success - (if rgn result)) - ;; Cleanup even on nonlocal exit - (if (and proc (eq 'run (process-status proc))) - (interrupt-process proc)) - (set-buffer obuf) - (or buffer (null mybuf) (kill-buffer mybuf))))) - -(defun tm:mc-pgp-sign-region (start end &optional id unclear boundary) - (if (not (boundp 'mc-pgp-user-id)) - (load "mc-pgp") - ) - (let ((process-environment process-environment) - (buffer (get-buffer-create mc-buffer-name)) - passwd args key - (parser (function mc-pgp-generic-parser)) - (pgp-path mc-pgp-path) - ) - (setq key (mc-pgp-lookup-key (or id mc-pgp-user-id))) - (setq passwd - (mc-activate-passwd - (cdr key) - (format "PGP passphrase for %s (%s): " (car key) (cdr key)))) - (setenv "PGPPASSFD" "0") - (setq args - (cons - (if boundary - "-fbast" - "-fast") - (list "+verbose=1" "+language=en" - (format "+clearsig=%s" (if unclear "off" "on")) - "+batchmode" "-u" (cdr key)))) - (if mc-pgp-comment - (setq args (cons (format "+comment=%s" mc-pgp-comment) args)) - ) - (message "Signing as %s ..." (car key)) - (if (tm:mc-process-region - start end passwd pgp-path args parser buffer boundary) - (progn - (if boundary - (progn - (goto-char (point-min)) - (insert - (format "\ ---[[multipart/signed; protocol=\"application/pgp-signature\"; - boundary=\"%s\"; micalg=pgp-md5][7bit]]\n" boundary)) - )) - (message "Signing as %s ... Done." (car key)) - t) - nil))) - (defun mime-editor/sign-pgp-elkins (beg end boundary) (save-excursion (save-restriction @@ -1678,19 +1542,55 @@ Content-Transfer-Encoding: 7bit (insert (format "Content-Transfer-Encoding: %s\n" encoding)) ) (insert "\n") - (or (tm:mc-pgp-sign-region (point-min)(point-max) - nil nil pgp-boundary) + (or (funcall mime-editor/pgp-sign-function + (point-min)(point-max) nil nil pgp-boundary) (throw 'mime-editor/error 'pgp-error) ) )))) +(defvar mime-editor/encrypt-recipient-fields-list '("To" "cc")) + +(defun mime-editor/make-encrypt-recipient-header () + (let* ((names mime-editor/encrypt-recipient-fields-list) + (values + (std11-field-bodies (cons "From" names) + nil mail-header-separator)) + (from (prog1 + (car values) + (setq values (cdr values)))) + (header (and (stringp from) + (if (string-equal from "") + "" + (format "From: %s\n" from) + ))) + recipients) + (while (and names values) + (let ((name (car names)) + (value (car values)) + ) + (and (stringp value) + (or (string-equal value "") + (progn + (setq header (concat header name ": " value "\n") + recipients (if recipients + (concat recipients " ," value) + value)) + )))) + (setq names (cdr names) + values (cdr values)) + ) + (vector from recipients header) + )) + (defun mime-editor/encrypt-pgp-elkins (beg end boundary) (save-excursion (save-restriction - (let ((from (rfc822/get-field-body "From" mail-header-separator)) - (to (rfc822/get-field-body "To" mail-header-separator)) - (cc (rfc822/get-field-body "cc" mail-header-separator)) - recipients) + (let (from recipients header) + (let ((ret (mime-editor/make-encrypt-recipient-header))) + (setq from (aref ret 0) + recipients (aref ret 1) + header (aref ret 2)) + ) (narrow-to-region beg end) (let* ((ret (mime-editor/translate-region beg end boundary)) @@ -1700,37 +1600,16 @@ Content-Transfer-Encoding: 7bit (pgp-boundary (concat "pgp-" boundary)) ) (goto-char beg) - (if (and (stringp from) - (not (string-equal from ""))) - (insert (format "From: %s\n" from)) - ) - (if (and (stringp to) - (not (string-equal to ""))) - (progn - (insert (format "To: %s\n" to)) - (setq recipients to) - )) - (if (and (stringp cc) - (not (string-equal cc ""))) - (progn - (insert (format "cc: %s\n" cc)) - (if recipients - (setq recipients (concat recipients "," cc)) - (setq recipients cc) - ))) + (insert header) (insert (format "Content-Type: %s\n" ctype)) (if encoding (insert (format "Content-Transfer-Encoding: %s\n" encoding)) ) (insert "\n") - (if (null - (let ((mc-pgp-always-sign 'never)) - (mc-pgp-encrypt-region - (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" recipients) - (point-min) (point-max) from nil) - )) + (or (funcall mime-editor/pgp-encrypt-function + recipients (point-min) (point-max) from) (throw 'mime-editor/error 'pgp-error) - ) + ) (goto-char beg) (insert (format "--[[multipart/encrypted; boundary=\"%s\"; @@ -1763,7 +1642,9 @@ Content-Transfer-Encoding: 7bit (insert (format "Content-Transfer-Encoding: %s\n" encoding)) ) (insert "\n") - (or (as-binary-process (mc-pgp-sign-region beg (point-max))) + (or (as-binary-process + (funcall mime-editor/traditional-pgp-sign-function + beg (point-max))) (throw 'mime-editor/error 'pgp-error) ) (goto-char beg) @@ -1774,10 +1655,12 @@ Content-Transfer-Encoding: 7bit (defun mime-editor/encrypt-pgp-kazu (beg end boundary) (save-excursion - (let ((from (rfc822/get-field-body "From")) - (to (rfc822/get-field-body "To")) - (cc (rfc822/get-field-body "cc")) - recipients) + (let (from recipients header) + (let ((ret (mime-editor/make-encrypt-recipient-header))) + (setq from (aref ret 0) + recipients (aref ret 1) + header (aref ret 2)) + ) (save-restriction (narrow-to-region beg end) (let* ((ret @@ -1787,33 +1670,15 @@ Content-Transfer-Encoding: 7bit (parts (nth 3 ret)) ) (goto-char beg) - (if (and (stringp from) - (not (string-equal from ""))) - (insert (format "From: %s\n" from)) - ) - (if (and (stringp to) - (not (string-equal to ""))) - (progn - (insert (format "To: %s\n" to)) - (setq recipients to) - )) - (if (and (stringp cc) - (not (string-equal cc ""))) - (progn - (insert (format "cc: %s\n" cc)) - (if recipients - (setq recipients (concat recipients "," cc)) - (setq recipients cc) - ))) + (insert header) (insert (format "Content-Type: %s\n" ctype)) (if encoding (insert (format "Content-Transfer-Encoding: %s\n" encoding)) ) (insert "\n") (or (as-binary-process - (mc-pgp-encrypt-region - (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" recipients) - beg (point-max)) + (funcall mime-editor/pgp-encrypt-function + recipients beg (point-max) nil 'maybe) ) (throw 'mime-editor/error 'pgp-error) ) @@ -1974,11 +1839,13 @@ Content-Transfer-Encoding: 7bit (let ((beg (point)) (end (mime-editor/content-end)) ) - (goto-char end) - (or (looking-at mime-editor/beginning-tag-regexp) - (eobp) - (insert (mime-make-text-tag) "\n") - ) + (if (= end (point-max)) + nil + (goto-char end) + (or (looking-at mime-editor/beginning-tag-regexp) + (eobp) + (insert (mime-make-text-tag) "\n") + )) (visible-region beg end) (goto-char beg) ) @@ -2007,6 +1874,14 @@ Content-Transfer-Encoding: 7bit (point))) (end (mime-editor/content-end)) ) + ;; Patch for hard newlines + ;; (save-excursion + ;; (goto-char beg) + ;; (while (search-forward "\n" end t) + ;; (put-text-property (match-beginning 0) + ;; (point) + ;; 'hard t))) + ;; End patch for hard newlines (enriched-encode beg end) (goto-char beg) (if (search-forward "\n\n") @@ -2061,46 +1936,13 @@ Content-Transfer-Encoding: 7bit ;; Sun implementations -(defun mime-voice-recorder-for-sun () - "Record voice in a buffer using Sun audio device, and return the buffer. -If the environment variable AUDIOHOST is defined, its value is used as -a recording host instead of local host." - (let ((buffer (get-buffer-create " *MIME audio*")) - (host (getenv "AUDIOHOST"))) - (message "Start the recording on %s. Type C-g to finish the recording..." - (or host (system-name))) - (save-excursion - (set-buffer buffer) - (erase-buffer) - (condition-case errorcode - (let ((selective-display nil) ;Disable ^M to nl translation. - (mc-flag nil) ;Mule - (kanji-flag nil)) ;NEmacs - ;; If AUDIOHOST is defined, use the value as recording host. - (cond ((not (null host)) - ;; Disable automatic conversion of coding system if Mule. - (if (featurep 'mule) - (define-program-coding-system nil "rsh" *noconv*)) - (call-process "rsh" - nil - buffer - nil - host - "cat" - "/dev/audio" - )) - (t - ;; Disable automatic conversion of coding system if Mule. - (if (featurep 'mule) - (define-program-coding-system nil "cat" *noconv*)) - (call-process "cat" - "/dev/audio" - buffer - nil - )))) - (quit (message "Type C-g to finish recording... done.") - buffer ;Return the buffer - ))))) +(defun mime-editor/voice-recorder-for-sun (encoding) + "Record voice in a buffer using Sun audio device, +and insert data encoded as ENCODING. [tm-edit.el]" + (message "Start the recording on %s. Type C-g to finish the recording..." + (system-name)) + (mime-insert-encoded-file "/dev/audio" encoding) + ) ;;; @ Other useful commands. @@ -2145,7 +1987,7 @@ a recording host instead of local host." (while (and (re-search-forward mime-editor/yank-ignored-field-regexp nil t) (setq beg (match-beginning 0)) - (setq end (1+ (rfc822/field-end))) + (setq end (1+ (std11-field-end))) ) (delete-region beg end) ) @@ -2216,7 +2058,7 @@ a recording host instead of local host." (interactive "P") (mime-editor/insert-tag "application" "pgp-keys") (mime-editor/define-encoding "7bit") - (mc-insert-public-key) + (funcall mime-editor/pgp-insert-public-key-function) ) @@ -2255,6 +2097,16 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." (force-mode-line-update) ) +(defun mime-editor/set-transfer-level-7bit () + (interactive) + (mime-editor/toggle-transfer-level 7) + ) + +(defun mime-editor/set-transfer-level-8bit () + (interactive) + (mime-editor/toggle-transfer-level 8) + ) + ;;; @ pgp ;;; @@ -2341,8 +2193,8 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" ) (or mime-editor/message-max-length (setq mime-editor/message-max-length - (or (cdr (assq major-mode mime-editor/message-max-length-alist)) - mime-editor/message-default-max-length)) + (or (cdr (assq major-mode mime-editor/message-max-lines-alist)) + mime-editor/message-default-max-lines)) ) (let* ((mime-editor/draft-file-name (or (buffer-file-name) @@ -2355,7 +2207,7 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (run-hooks 'mime-editor/before-split-hook) (let ((the-buf (current-buffer)) (copy-buf (get-buffer-create " *Original Message*")) - (header (rfc822/get-header-string-except + (header (std11-header-string-except mime-editor/split-ignored-field-regexp separator)) (subject (mail-fetch-field "subject")) (total (+ (/ lines mime-editor/message-max-length) @@ -2366,6 +2218,11 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (cdr (assq major-mode mime-editor/split-message-sender-alist)) + (function + (lambda () + (interactive) + (error "Split sender is not specified for `%s'." major-mode) + )) )) (mime-editor/partial-number 1) data) @@ -2383,7 +2240,7 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (goto-char (point-min)) (while (re-search-forward mime-editor/split-blind-field-regexp nil t) (delete-region (match-beginning 0) - (1+ (rfc822/field-end))) + (1+ (std11-field-end))) ))) (while (< mime-editor/partial-number total) (erase-buffer) @@ -2431,8 +2288,8 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (interactive) (run-hooks 'mime-editor/before-send-hook) (let ((mime-editor/message-max-length - (or (cdr (assq major-mode mime-editor/message-max-length-alist)) - mime-editor/message-default-max-length)) + (or (cdr (assq major-mode mime-editor/message-max-lines-alist)) + mime-editor/message-default-max-lines)) (lines (count-lines (point-min) (point-max))) ) (if (and (> lines mime-editor/message-max-length) @@ -2616,18 +2473,27 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (t (let* (charset (pstr - (mapconcat (function - (lambda (attr) - (if (string-equal (car attr) - "charset") - (progn - (setq charset (cdr attr)) - "") - (concat ";" (car attr) - "=" (cdr attr)) - ) - )) - params "")) + (let ((bytes (+ 14 (length ctype)))) + (mapconcat (function + (lambda (attr) + (if (string-equal (car attr) "charset") + (progn + (setq charset (cdr attr)) + "") + (let* ((str + (concat (car attr) + "=" (cdr attr)) + ) + (bs (length str)) + ) + (setq bytes (+ bytes bs 2)) + (if (< bytes 76) + (concat "; " str) + (setq bytes (+ bs 1)) + (concat ";\n " str) + ) + )))) + params ""))) encoding encoded) (save-excursion @@ -2635,10 +2501,10 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" "Content-Transfer-Encoding:" nil t) (let ((beg (match-beginning 0)) (hbeg (match-end 0)) - (end (rfc822/field-end))) + (end (std11-field-end))) (setq encoding (eliminate-top-spaces - (rfc822/unfolding-string + (std11-unfold-string (buffer-substring hbeg end)))) (if (or charset (string-equal type "text")) (progn @@ -2697,7 +2563,7 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (goto-char (point-min)) (while (re-search-forward "^\\(Content-.*\\|Mime-Version\\):" nil t) - (delete-region (match-beginning 0) (1+ (rfc822/field-end))) + (delete-region (match-beginning 0) (1+ (std11-field-end))) )) (or no-separator (and (re-search-forward "^$")