This commit was generated by cvs2svn to compensate for changes in r359,
[elisp/tm.git] / tm-edit.el
index 2a15e49..6bed766 100644 (file)
@@ -8,7 +8,7 @@
 ;;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;;; Created: 1994/08/21 renamed from mime.el
-;;; Version: $Revision: 7.43 $
+;;; Version: $Revision: 7.52 $
 ;;; Keywords: mail, news, MIME, multimedia, multilingual
 ;;;
 ;;; This file is part of tm (Tools for MIME).
 ;;;
 
 (defconst mime-editor/RCS-ID
-  "$Id: tm-edit.el,v 7.43 1996/02/09 06:57:20 morioka Exp $")
+  "$Id: tm-edit.el,v 7.52 1996/04/19 13:40:55 shuhei-k Exp $")
 
 (defconst mime-editor/version (get-version-string mime-editor/RCS-ID))
 
@@ -149,18 +149,6 @@ 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-string-encoder
-  (cond ((boundp 'NEMACS)
-        (function mime-string-encoder-for-nemacs))
-       ((featurep 'mule)
-        (function mime-string-encoder-for-mule))
-       ((string-match "^19\\." emacs-version)
-        (function mime-string-encoder-for-emacs19))
-       (t                              ;ASCII only emacs
-        (function mime-string-encoder-for-emacs18)))
-  "*Function to encode a string for given encoding method.
-The method is a form of (CHARSET . ENCODING).")
-
 (defvar mime-voice-recorder
   (function mime-voice-recorder-for-sun)
   "*Function to record a voice message and return a buffer that contains it.")
@@ -361,6 +349,22 @@ To insert a signature file specified by mime-signature-file
   "*Alist of file name, types, parameters, and default encoding.
 If encoding is nil, it is determined from its contents.")
 
+;;; @@ about charset, encoding and transfer-level
+;;;
+
+(defvar mime-editor/transfer-level 7
+  "*A number of network transfer level. It should be bigger than 7.")
+(make-variable-buffer-local 'mime-editor/transfer-level)
+
+(defvar mime-editor/transfer-level-string
+  (mime/encoding-name mime-editor/transfer-level 'not-omit)
+  "*A string formatted version of mime/defaul-transfer-level")
+(make-variable-buffer-local 'mime-editor/transfer-level-string)
+
+(defvar mime-editor/charset-default-encoding-alist
+  (mime/make-charset-default-encoding-alist mime-editor/transfer-level))
+(make-variable-buffer-local 'mime-editor/charset-default-encoding-alist)
+
 ;;; @@ about message inserting
 ;;;
 
@@ -520,6 +524,8 @@ Tspecials means any character that matches with it in header must be quoted.")
   (format "1.0 (generated by tm-edit %s)" mime-editor/version)
   "MIME version number.")
 
+(defconst mime-editor/mime-map (make-sparse-keymap)
+  "Keymap for MIME commands.")
 
 ;;; @ keymap and menu
 ;;;
@@ -527,7 +533,9 @@ Tspecials means any character that matches with it in header must be quoted.")
 (defvar mime/editor-mode-flag nil)
 (make-variable-buffer-local 'mime/editor-mode-flag)
 
-(set-alist 'minor-mode-alist 'mime/editor-mode-flag '(" MIME-Edit"))
+(set-alist 'minor-mode-alist
+          'mime/editor-mode-flag
+          '((" MIME-Edit "  mime-editor/transfer-level-string)))
 
 (defun mime-editor/define-keymap (keymap)
   "Add mime-editor commands to KEYMAP."
@@ -554,6 +562,8 @@ Tspecials means any character that matches with it in header must be quoted.")
     (define-key keymap "?"    'mime-editor/help)
     ))
 
+(mime-editor/define-keymap mime-editor/mime-map)
+
 (defconst mime-editor/menu-title "MIME-Edit")
 
 (defconst mime-editor/menu-list
@@ -578,6 +588,7 @@ Tspecials means any character that matches with it in header must be quoted.")
     (sign      "About sign"            mime-editor/set-sign)
     (encrypt   "About encryption"      mime-editor/set-encrypt)
     (preview   "Preview Message"       mime-editor/preview-message)
+    (level     "Toggle transfer-level" mime-editor/toggle-transfer-level)
     )
   "MIME-edit menubar entry.")
 
@@ -615,8 +626,7 @@ Tspecials means any character that matches with it in header must be quoted.")
 
 ;;; modified by Steven L. Baur <steve@miranova.com>
 ;;;    1995/12/6 (c.f. [tm-en:209])
-(if (and (string-match "XEmacs\\|Lucid" emacs-version)
-        (not (boundp 'mime-editor/popup-menu-for-xemacs)))
+(if (and running-xemacs (not (boundp 'mime-editor/popup-menu-for-xemacs)))
     (setq mime-editor/popup-menu-for-xemacs
          (append '("MIME Commands" "---")
                  (mapcar (function (lambda (item)
@@ -681,7 +691,7 @@ Following commands are available in addition to major mode commands:
 \\[mime-editor/insert-key]     insert PGP public key.
 \\[mime-editor/preview-message]        preview editing MIME message.
 \\[mime-editor/exit]   exit and translate into a MIME compliant message.
-\\[mime-editor/maybe-translate]        exit, translate and run the original command.
+\\[mime-editor/maybe-translate]        exit and translate if in MIME mode, then split.
 \\[mime-editor/help]   show this help.
 
 Additional commands are available in some major modes:
@@ -725,10 +735,6 @@ User customizable variables (not documented all of them):
     Hide a non-textual body message encoded in base64 after insertion
     if non-nil.
 
- mime-string-encoder
-    Specifies a function to encode a string for given encoding method.
-    The method is a form of (CHARSET . ENCODING).
-
  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
@@ -752,19 +758,27 @@ User customizable variables (not documented all of them):
       (error "You are already editing a MIME message.")
     (setq mime/editor-mode-flag t)
     ;; Remember old key bindings.
-    (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)))
+    (if running-xemacs
+       nil
+      (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)))
+      )
     (if (not (lookup-key (current-local-map) mime-prefix))
-       (define-key (current-local-map) mime-prefix (make-sparse-keymap)))
-    (mime-editor/define-keymap (lookup-key (current-local-map) mime-prefix))
+       (define-key (current-local-map) mime-prefix mime-editor/mime-map))
+
+    ;; Set transfer level into mode line
+    ;;
+    (setq mime-editor/transfer-level-string
+         (mime/encoding-name mime-editor/transfer-level 'not-omit))
+    (force-mode-line-update)
     
     ;; Define menu.  Menus for other emacs implementations are
     ;; welcome.
     ;; modified by Pekka Marjola <pema@niksula.hut.fi>
     ;;         1995/9/5 (c.f. [tm-eng:69])
-    (cond ((string-match "XEmacs\\|Lucid" emacs-version)
+    (cond (running-xemacs
           (mime-editor/define-menu-for-xemacs))
          ((string-match "^19\\." emacs-version)
           (mime-editor/define-menu-for-emacs19)
@@ -807,18 +821,14 @@ just return to previous mode."
          (mime-editor/translate-buffer)))
     ;; Restore previous state.
     (setq mime/editor-mode-flag nil)
-    (use-local-map mime/editor-mode-old-local-map)
-    
-    ;; modified by Pekka Marjola <pema@niksula.hut.fi>
-    ;; 1995/9/5 (c.f. [tm-eng:69])
-    (if (string-match "XEmacs\\|Lucid" emacs-version)
-       (progn
-         (delete-menu-item (list mime-editor/menu-title))
-                                       ; should rather be const
-          ;; (while mime-editor/xemacs-old-bindings
-          ;;   (eval (pop mime-editor/xemacs-old-bindings)))
-         (local-unset-key mime-prefix)))
-    ;; end
+    (cond (running-xemacs
+          ;; mime-prefix only defined if binding was nil
+          (if (eq (lookup-key (current-local-map) mime-prefix)
+                  mime-editor/mime-map)
+              (define-key (current-local-map) mime-prefix nil))
+          (delete-menu-item (list mime-editor/menu-title)))
+         (t
+          (use-local-map mime/editor-mode-old-local-map)))
     
     (setq selective-display mime/editor-mode-old-selective-display)
     (set-buffer-modified-p (buffer-modified-p))
@@ -947,30 +957,15 @@ Charset is automatically obtained from the `mime/lc-charset-alist'."
 (defun mime-editor/insert-signature (&optional arg)
   "Insert a signature file specified by mime-signature-file."
   (interactive "P")
-  (let ((signature
-        (expand-file-name
-         (if arg
-             (read-file-name "Insert your signature: "
-                             (concat signature-file-name "-")
-                             signature-file-name
-                             nil)
-           (signature/get-signature-file-name))))
-       )
-    (if signature-insert-at-eof
-       (goto-char (point-max))
-      )
-    (apply (function mime-editor/insert-tag)
-          (mime-find-file-type signature))
-    (if (file-readable-p signature)
-       (progn
-         (goto-char (point-max))
-         (if (not (bolp))
-             (insert "\n"))
-         (delete-blank-lines)
-         (insert-file-contents signature)
-         (set-buffer-modified-p (buffer-modified-p))
-                                       ; force mode line update
-         ))))
+  (let ((signature-insert-hook
+         (function
+          (lambda ()
+            (apply (function mime-editor/insert-tag)
+                   (mime-find-file-type signature))
+            )))
+        )
+    (insert-signature arg)
+    ))
 
 \f
 ;; Insert a new tag around a point.
@@ -1398,30 +1393,6 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))."
          (mime-prompt-for-parameters-1 (cdr (assoc answer (cdr parameter)))))
     ))
 
-(defun mime-encode-string (encoding string)
-  "Using ENCODING encode a STRING.
-If the STRING is too long, the encoded string may be broken into
-several lines."
-  (save-excursion
-    (set-buffer (get-buffer-create " *MIME encoding*"))
-    (erase-buffer)
-    (insert string)
-    (mime-encode-region encoding (point-min) (point-max))
-    (prog1
-       (buffer-substring (point-min) (point-max))
-      (kill-buffer (current-buffer)))))
-
-(defun mime-decode-string (encoding string)
-  "Using ENCODING decode a STRING."
-  (save-excursion
-    (set-buffer (get-buffer-create " *MIME decoding*"))
-    (erase-buffer)
-    (insert string)
-    (mime-decode-region encoding (point-min) (point-max))
-    (prog1
-       (buffer-substring (point-min) (point-max))
-      (kill-buffer (current-buffer)))))
-
 (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,
@@ -1438,14 +1409,17 @@ while if FLAG is `\\^M' (control-M) the text is hidden."
 ;;; @ Translate the tagged MIME messages into a MIME compliant message.
 ;;;
 
+(defvar mime-editor/translate-buffer-hook
+  '(mime-editor/pgp-enclose-buffer
+    mime/encode-message-header
+    mime-editor/translate-body))
+
 (defun mime-editor/translate-buffer ()
   "Encode the tagged MIME message in current buffer in MIME compliant message."
   (interactive)
   (if (catch 'mime-editor/error
        (save-excursion
-         (mime-editor/pgp-enclose-buffer)
-         (mime/encode-message-header)
-         (mime-editor/translate-body)
+         (run-hooks 'mime-editor/translate-buffer-hook)
          ))
       (progn
        (undo)
@@ -1949,20 +1923,16 @@ Content-Transfer-Encoding: 7bit
             (if (null encoding)        ;Encoding is not specified.
                 (let* ((encoding
                         (cdr
-                         (assoc charset mime/charset-default-encoding-alist)
+                         (assoc charset
+                                mime-editor/charset-default-encoding-alist)
                          ))
                        (beg (mime-editor/content-beginning))
-                       (end (mime-editor/content-end))
-                       (body (buffer-substring beg end))
-                       (encoded (funcall mime-string-encoder
-                                         (cons charset encoding) body)))
-                  (if (not (string-equal body encoded))
-                      (progn
-                        (goto-char beg)
-                        (delete-region beg end)
-                        (insert encoded)
-                        (goto-char beg)))
-                  (mime-editor/define-encoding encoding)))
+                       )
+                  (mime/code-convert-region-from-emacs
+                   beg (mime-editor/content-end) charset)
+                  (mime-encode-region encoding
+                                      beg (mime-editor/content-end))
+                   (mime-editor/define-encoding encoding)))
             (forward-line 1))
            ((null encoding)            ;Encoding is not specified.
             ;; Application, image, audio, video, and any other
@@ -1972,15 +1942,9 @@ Content-Transfer-Encoding: 7bit
                    (beg (mime-editor/content-beginning))
                    (end (mime-editor/content-end))
                    (body (buffer-substring beg end))
-                   (encoded (funcall mime-string-encoder
-                                     (cons nil encoding) body)))
-              (if (not (string-equal body encoded))
-                  (progn
-                    (goto-char beg)
-                    (delete-region beg end)
-                    (insert encoded)
-                    (goto-char beg)))
-              (mime-editor/define-encoding encoding))
+                    )
+              (mime-encode-region encoding beg end)
+               (mime-editor/define-encoding encoding))
             (forward-line 1))
            )
       )))
@@ -1999,93 +1963,6 @@ Content-Transfer-Encoding: 7bit
 ;;; Platform dependent functions
 ;;;
 
-;; Emacs 18 implementations
-
-(defun mime-string-encoder-for-emacs18 (method string)
-  "For given METHOD that is a cons of charset and encoding, encode a STRING."
-  (let ((charset (car method))
-       (encoding (cdr method)))
-    (cond ((stringp encoding)
-          (mime-encode-string encoding string))
-         ;; Return string without any encoding.
-         (t string)
-         )))
-
-\f
-;; Emacs 19 implementations
-
-(defun mime-string-encoder-for-emacs19 (method string)
-  "For given METHOD that is a cons of charset and encoding, encode a STRING."
-  (let ((charset (car method))
-       (encoding (cdr method)))
-    (cond ((stringp encoding)
-          (mime-encode-string encoding string))
-         ;; Return string without any encoding.
-         (t string)
-         )))
-
-\f
-;; NEmacs implementations
-
-(defun mime-string-encoder-for-nemacs (method string)
-  "For given METHOD that is a cons of charset and encoding, encode a STRING.
-US-ASCII and ISO-2022-JP are supported on NEmacs."
-  (let ((charset (car method))
-       (encoding (cdr method)))
-    (cond ((stringp encoding)
-          (mime-encode-string encoding
-                              ;; Convert internal (EUC) to JIS code.
-                              (convert-string-kanji-code string 3 2)
-                              ))
-         ;; NEmacs can convert into ISO-2022-JP automatically,
-         ;; but can do it myself as follows:
-         ;;(t (convert-string-kanji-code string 3 2))
-
-         ;; Return string without any encoding.
-         (t string)
-         )))
-
-\f
-;; Mule implementations
-;; Thanks to contributions by wkenji@flab.fujitsu.co.jp (Kenji
-;; WAKAMIYA) and handa@etl.go.jp (Kenichi Handa).
-
-(defun mime-string-encoder-for-mule (method string)
-  "For given METHOD that is a cons of charset and encoding, encode a
-STRING.  US-ASCII, ISO-8859-* (except for ISO-8859-6), ISO-2022-JP,
-ISO-2022-JP-2 and ISO-2022-INT-1 are supported on Mule.  Either of
-charset ISO-2022-JP-2 or ISO-2022-INT-1 is used for multilingual
-text."
-  (let* ((charset (car method))
-        (encoding (cdr method))
-        (coding-system
-         (cdr (assoc (and (stringp charset) (upcase charset))
-                     '(("ISO-8859-1" . *ctext*)
-                       ("ISO-8859-2" . *iso-8859-2*)
-                       ("ISO-8859-3" . *iso-8859-3*)
-                       ("ISO-8859-4" . *iso-8859-4*)
-                       ("ISO-8859-5" . *iso-8859-5*)
-                       ;;("ISO-8859-6" . *iso-8859-6*)
-                       ("ISO-8859-7" . *iso-8859-7*)
-                       ("ISO-8859-8" . *iso-8859-8*)
-                       ("ISO-8859-9" . *iso-8859-9*)
-                       ("ISO-2022-JP" . *junet*)
-                       ("ISO-2022-JP-2" . *iso-2022-ss2-7*)
-                       ("ISO-2022-KR" . *korean-mail*)
-                       ("ISO-2022-INT-1" . *iso-2022-int-1*)
-                       )))))
-    ;; In bilingual environment it may be unnecessary to convert the
-    ;; coding system of the string unless transfer encoding is
-    ;; required since such conversion may be performed by mule
-    ;; automatically.
-    (if (not (null coding-system))
-       (setq string (code-convert-string string *internal* coding-system)))
-    (if (stringp encoding)
-       (setq string (mime-encode-string encoding string)))
-    string
-    ))
-
-\f
 ;; Sun implementations
 
 (defun mime-voice-recorder-for-sun ()
@@ -2266,6 +2143,27 @@ a recording host instead of local host."
     (message "This message is not enabled to split.")
     ))
 
+(defun mime-editor/toggle-transfer-level (&optional transfer-level)
+  "Toggle transfer-level is 7bit or 8bit through.
+
+Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8."
+  (interactive)
+  (if (numberp transfer-level)
+      (setq mime-editor/transfer-level transfer-level)
+    (if (< mime-editor/transfer-level 8)
+       (setq mime-editor/transfer-level 8)
+      (setq mime-editor/transfer-level 7)
+      ))
+  (setq mime-editor/charset-default-encoding-alist
+       (mime/make-charset-default-encoding-alist
+        mime-editor/transfer-level))
+  (message (format "Current transfer-level is %d bit"
+                  mime-editor/transfer-level))
+  (setq mime-editor/transfer-level-string
+       (mime/encoding-name mime-editor/transfer-level 'not-omit))
+  (force-mode-line-update)
+  )
+
 
 ;;; @ pgp
 ;;;
@@ -2601,17 +2499,140 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n"
           )
 
 
-;;; @ etc
+;;; @ edit again
 ;;;
 
-(defun replace-space-with-underline (str)
-  (mapconcat (function
-             (lambda (arg)
-               (char-to-string
-                (if (= arg 32)
-                    ?_
-                  arg)))) str "")
-  )
+(defun mime-editor::edit-again (code-conversion)
+  (save-excursion
+    (goto-char (point-min))
+    (let ((ctl (mime/Content-Type)))
+      (if ctl
+         (let ((ctype (car ctl))
+               (params (cdr ctl))
+               type stype)
+           (if (string-match "/" ctype)
+               (progn
+                 (setq type (substring ctype 0 (match-beginning 0)))
+                 (setq stype (substring ctype (match-end 0)))
+                 )
+             (setq type ctype)
+             )
+           (cond ((string-equal type "multipart")
+                  (let ((boundary (assoc-value "boundary" params)))
+                    (re-search-forward (concat "\n--" boundary) nil t)
+                    (let ((bb (match-beginning 0)) eb tag)
+                      (setq tag (format "\n--<<%s>>-{" stype))
+                      (goto-char bb)
+                      (insert tag)
+                      (setq bb (+ bb (length tag)))
+                      (re-search-forward (concat "\n--" boundary "--") nil t)
+                      (setq eb (match-beginning 0))
+                      (replace-match (format "\n--}-<<%s>>" stype))
+                      (save-restriction
+                        (narrow-to-region bb eb)
+                        (goto-char (point-min))
+                        (while (re-search-forward
+                                (concat "\n--" boundary "\n") nil t)
+                          (let ((beg (match-beginning 0))
+                                end)
+                            (delete-region beg (match-end 0))
+                            (save-excursion
+                              (if (re-search-forward
+                                   (concat "\n--" boundary) nil t)
+                                  (setq end (match-beginning 0))
+                                (setq end (point-max))
+                                )
+                              (save-restriction
+                                (narrow-to-region beg end)
+                                (mime-editor::edit-again code-conversion)
+                                (goto-char (point-max))
+                                ))))
+                        ))
+                    (goto-char (point-min))
+                    (or (= (point-min) 1)
+                        (delete-region (point-min)
+                                       (if (re-search-forward "^$" nil t)
+                                           (match-end 0)
+                                         (point-min)
+                                         )))
+                    ))
+                 (t
+                  (let* ((str (rfc822/get-header-string-except
+                               "^Content-Type" ""))
+                         charset
+                         (pstr
+                          (mapconcat (function
+                                      (lambda (attr)
+                                        (if (string-equal (car attr)
+                                                          "charset")
+                                            (progn
+                                              (setq charset (cdr attr))
+                                              "")
+                                          (concat ";" (car attr)
+                                                  "=" (cdr attr))
+                                          )
+                                        ))
+                                     params ""))
+                         )
+                    (if code-conversion
+                        (if charset
+                            (mime/code-convert-region-to-emacs
+                             (point-min) (point-max) charset)
+                          (code-convert-region
+                           (point-min) (point-max)
+                           mime/default-coding-system *internal*)
+                          ))
+                    (and str
+                         (setq pstr (concat pstr "\n" str))
+                         )
+                    (let ((he
+                           (if (re-search-forward "^$" nil t)
+                               (match-end 0)
+                             (point-min)
+                             )))
+                      (if (= (point-min) 1)
+                          (progn
+                            (goto-char he)
+                            (insert
+                             (concat
+                              "\n"
+                              (mime-create-tag (concat type "/" stype))
+                              ))
+                            )
+                        (delete-region (point-min) he)
+                        (insert
+                         (concat "\n" (mime-create-tag
+                                       (concat type "/" stype pstr))))
+                        ))
+                    ))))
+       (if code-conversion
+           (code-convert-region (point-min) (point-max)
+                                mime/default-coding-system *internal*)
+         )
+       ))))
+
+(defun mime/edit-again (&optional code-conversion no-separator no-mode)
+  (interactive)
+  (mime-editor::edit-again code-conversion)
+  (goto-char (point-min))
+  (save-restriction
+    (narrow-to-region (point-min)
+                     (if (re-search-forward "^$" nil t)
+                         (match-end 0)
+                       (point-max)
+                       ))
+    (goto-char (point-min))
+    (while (re-search-forward
+           "^\\(Content-.*\\|Mime-Version\\):" nil t)
+      (delete-region (match-beginning 0) (1+ (rfc822/field-end)))
+      ))
+  (or no-separator
+      (and (re-search-forward "^$")
+          (replace-match mail-header-separator)
+          ))
+  (or no-mode
+      (mime/editor-mode)
+      ))
 
 
 ;;; @ end