tm-edit.el

   1 ;;;
   2 ;;; tm-edit.el --- Simple MIME Composer for GNU Emacs
   3 ;;;
   4 ;;; Copyright (C) 1993 UMEDA Masanobu
   5 ;;; Copyright (C) 1994 .. 1996 MORIOKA Tomohiko
   6 ;;;
   7 ;;; Author: UMEDA Masanobu <umerin@mse.kyutech.ac.jp>
   8 ;;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
   9 ;;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
  10 ;;; Created: 1994/08/21 renamed from mime.el
  11 ;;; Version: $Revision: 7.68 $
  12 ;;; Keywords: mail, news, MIME, multimedia, multilingual
  13 ;;;
  14 ;;; This file is part of tm (Tools for MIME).
  15 ;;;
  16 ;;; This program is free software; you can redistribute it and/or
  17 ;;; modify it under the terms of the GNU General Public License as
  18 ;;; published by the Free Software Foundation; either version 2, or
  19 ;;; (at your option) any later version.
  20 ;;;
  21 ;;; This program is distributed in the hope that it will be useful,
  22 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  24 ;;; General Public License for more details.
  25 ;;;
  26 ;;; You should have received a copy of the GNU General Public License
  27 ;;; along with This program.  If not, write to the Free Software
  28 ;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  29
  30 ;;; Commentary:
  31
  32 ;; This is an Emacs minor mode for editing Internet multimedia
  33 ;; messages formatted in MIME (RFC 1521 and RFC 1522). All messages in
  34 ;; this mode are composed in the tagged MIME format, that are
  35 ;; described in the following examples. The messages composed in the
  36 ;; tagged MIME format are automatically translated into a MIME
  37 ;; compliant message when exiting the mode.
  38
  39 ;; Mule (a multilingual extension to Emacs 18 and 19) has a capability
  40 ;; of handling multilingual text in limited ISO-2022 manner that is
  41 ;; based on early experiences in Japanese Internet community and
  42 ;; resulted in RFC 1468 (ISO-2022-JP charset for MIME). In order to
  43 ;; enable multilingual capability in single text message in MIME,
  44 ;; charset of multilingual text written in Mule is declared as either
  45 ;; `ISO-2022-JP-2' [RFC 1554] or `ISO-2022-INT-1'. Mule is required
  46 ;; for reading the such messages.
  47
  48 ;; This MIME composer can work with Mail mode, mh-e letter Mode, and
  49 ;; News mode.  First of all, you need the following autoload
  50 ;; definition to load mime/editor-mode automatically:
  51 ;;
  52 ;; (autoload 'mime/editor-mode "tm-edit"
  53 ;;           "Minor mode for editing MIME message." t)
  54 ;;
  55 ;; In case of Mail mode (includes VM mode), you need the following
  56 ;; hook definition:
  57 ;;
  58 ;; (add-hook 'mail-mode-hook 'mime/editor-mode)
  59 ;; (add-hook 'mail-send-hook 'mime-editor/maybe-translate)
  60 ;;
  61 ;; In case of MH-E, you need the following hook definition:
  62 ;;
  63 ;; (add-hook 'mh-letter-mode-hook
  64 ;;           (function
  65 ;;            (lambda ()
  66 ;;              (mime/editor-mode)
  67 ;;              (make-local-variable 'mail-header-separator)
  68 ;;              (setq mail-header-separator "--------")
  69 ;;              ))))
  70 ;; (add-hook 'mh-before-send-letter-hook 'mime-editor/maybe-translate)
  71 ;;
  72 ;; In case of News mode, you need the following hook definition:
  73 ;;
  74 ;; (add-hook 'news-reply-mode-hook 'mime/editor-mode)
  75 ;; (add-hook 'news-inews-hook 'mime-editor/maybe-translate)
  76 ;;
  77 ;; In case of Emacs 19, it is possible to emphasize the message tags
  78 ;; using font-lock mode as follows:
  79 ;;
  80 ;; (add-hook 'mime/editor-mode-hook
  81 ;;           (function
  82 ;;            (lambda ()
  83 ;;              (font-lock-mode 1)
  84 ;;              (setq font-lock-keywords (list mime-editor/tag-regexp))
  85 ;;              ))))
  86
  87 ;; The message tag looks like:
  88 ;;
  89 ;;      --[[TYPE/SUBTYPE;PARAMETERS][ENCODING]]
  90 ;;
  91 ;; The tagged MIME message examples:
  92 ;;
  93 ;; This is a conventional plain text.  It should be translated into
  94 ;; text/plain.
  95 ;;
  96 ;;--[[text/plain]]
  97 ;; This is also a plain text.  But, it is explicitly specified as is.
  98 ;;
  99 ;;--[[text/plain; charset=ISO-2022-JP]]
 100 ;; \e$B$3$l$O\e(B charset \e$B$r\e(B ISO-2022-JP \e$B$K;XDj$7$?F|K\8l$N\e(B plain \e$B%F%-%9%H$G$9\e(B.
 101 ;;
 102 ;;--[[text/richtext]]
 103 ;; <center>This is a richtext.</center>
 104 ;;
 105 ;;--[[image/gif][base64]]^M...image encoded in base64 comes here...
 106 ;;
 107 ;;--[[audio/basic][base64]]^M...audio encoded in base64 comes here...
 108
 109 ;;; Code:
 110
 111 (require 'sendmail)
 112 (require 'mail-utils)
 113 (require 'mel)
 114 (require 'tl-822)
 115 (require 'tl-list)
 116 (require 'tm-view)
 117 (require 'tm-ew-e)
 118 (require 'signature)
 119
 120
 121 ;;; @ version
 122 ;;;
 123
 124 (defconst mime-editor/RCS-ID
 125   "$Id: tm-edit.el,v 7.68 1996/06/12 05:53:26 morioka Exp $")
 126
 127 (defconst mime-editor/version (get-version-string mime-editor/RCS-ID))
 128
 129
 130 ;;; @ variables
 131 ;;;
 132
 133 (defvar mime-prefix "\C-c\C-x"
 134   "*Keymap prefix for MIME commands.")
 135
 136 (defvar mime-ignore-preceding-spaces nil
 137   "*Ignore preceding white spaces if non-nil.")
 138
 139 (defvar mime-ignore-trailing-spaces nil
 140   "*Ignore trailing white spaces if non-nil.")
 141
 142 (defvar mime-ignore-same-text-tag t
 143   "*Ignore preceding text content-type tag that is same with new one.
 144 If non-nil, the text tag is not inserted unless something different.")
 145
 146 (defvar mime-auto-hide-body t
 147   "*Hide non-textual body encoded in base64 after insertion if non-nil.")
 148
 149 (defvar mime-voice-recorder
 150   (function mime-voice-recorder-for-sun)
 151   "*Function to record a voice message and return a buffer that contains it.")
 152
 153 (defvar mime/editor-mode-hook nil
 154   "*Hook called when enter MIME mode.")
 155
 156 (defvar mime-editor/translate-hook nil
 157   "*Hook called before translating into a MIME compliant message.
 158 To insert a signature file automatically, call the function
 159 `mime-editor/insert-signature' from this hook.")
 160
 161 (defvar mime-editor/exit-hook nil
 162   "*Hook called when exit MIME mode.")
 163
 164 (defvar mime-content-types
 165   '(("text"
 166      ;; Charset parameter need not to be specified, since it is
 167      ;; defined automatically while translation.
 168      ("plain"
 169       ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8")
 170       )
 171      ("richtext"
 172       ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8")
 173       )
 174      ("enriched"
 175       ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8")
 176       )
 177      ("x-latex"
 178       ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8")
 179       )
 180      ("html"
 181       ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8")
 182       )
 183      ("x-rot13-47")
 184      )
 185     ("message"
 186      ("external-body"
 187       ("access-type"
 188        ("anon-ftp"
 189         ("site" "ftp.jaist.ac.jp" "wnoc-fuk.wide.ad.jp" "nic.karrn.ad.jp")
 190         ("directory" "/pub/GNU/elisp/mime")
 191         ("name")
 192         ("mode" "image" "ascii" "local8"))
 193        ("ftp"
 194         ("site")
 195         ("directory")
 196         ("name")
 197         ("mode" "image" "ascii" "local8"))
 198        ("tftp"        ("site") ("name"))
 199        ("afs"         ("site") ("name"))
 200        ("local-file"  ("site") ("name"))
 201        ("mail-server" ("server" "ftpmail@nic.karrn.ad.jp"))
 202        ))
 203      ("rfc822")
 204      )
 205     ("application"
 206      ("octet-stream" ("type" "" "tar" "shar"))
 207      ("postscript")
 208      ("x-kiss" ("x-cnf")))
 209     ("image"
 210      ("gif")
 211      ("jpeg")
 212      ("tiff")
 213      ("x-pic")
 214      ("x-mag")
 215      ("x-xwd")
 216      ("x-xbm")
 217      )
 218     ("audio" ("basic"))
 219     ("video" ("mpeg"))
 220     )
 221   "*Alist of content-type, subtype, parameters and its values.")
 222
 223 (defvar mime-file-types
 224   '(("\\.rtf$"
 225      "text"     "richtext"      nil
 226      nil
 227      nil                nil)
 228     ("\\.html$"
 229      "text"     "html"          nil
 230      nil
 231      nil                nil)
 232     ("\\.ps$"
 233      "application" "postscript" nil
 234      "quoted-printable"
 235      "attachment"       (("filename" . file))
 236      )
 237     ("\\.jpg$"
 238      "image"    "jpeg"          nil
 239      "base64"
 240      "inline"           (("filename" . file))
 241      )
 242     ("\\.gif$"
 243      "image"    "gif"           nil
 244      "base64"
 245      "inline"           (("filename" . file))
 246      )
 247     ("\\.tiff$"
 248      "image"    "tiff"          nil
 249      "base64"
 250      "inline"           (("filename" . file))
 251      )
 252     ("\\.pic$"
 253      "image"    "x-pic"         nil
 254      "base64"
 255      "inline"           (("filename" . file))
 256      )
 257     ("\\.mag$"
 258      "image"    "x-mag"         nil
 259      "base64"
 260      "inline"           (("filename" . file))
 261      )
 262     ("\\.xbm$"
 263      "image"    "x-xbm"         nil
 264      "base64"
 265      "inline"           (("filename" . file))
 266      )
 267     ("\\.xwd$"
 268      "image"    "x-xwd"         nil
 269      "base64"
 270      "inline"           (("filename" . file))
 271      )
 272     ("\\.au$"
 273      "audio"    "basic"         nil
 274      "base64"
 275      "attachment"               (("filename" . file))
 276      )
 277     ("\\.mpg$"
 278      "video"    "mpeg"          nil
 279      "base64"
 280      "attachment"       (("filename" . file))
 281      )
 282     ("\\.el$"
 283      "application" "octet-stream" (("type" . "emacs-lisp"))
 284      "7bit"
 285      "attachment"       (("filename" . file))
 286      )
 287     ("\\.lsp$"
 288      "application" "octet-stream" (("type" . "common-lisp"))
 289      "7bit"
 290      "attachment"       (("filename" . file))
 291      )
 292     ("\\.tar\\.gz$"
 293      "application" "octet-stream" (("type" . "tar+gzip"))
 294      nil
 295      "attachment"       (("filename" . file))
 296      )
 297     ("\\.tgz$"
 298      "application" "octet-stream" (("type" . "tar+gzip"))
 299      nil
 300      "attachment"       (("filename" . file))
 301      )
 302     ("\\.tar\\.Z$"
 303      "application" "octet-stream" (("type" . "tar+compress"))
 304      nil
 305      "attachment"       (("filename" . file))
 306      )
 307     ("\\.taz$"
 308      "application" "octet-stream" (("type" . "tar+compress"))
 309      nil
 310      "attachment"       (("filename" . file))
 311      )
 312     ("\\.gz$"
 313      "application" "octet-stream" (("type" . "gzip"))
 314      nil
 315      "attachment"       (("filename" . file))
 316      )
 317     ("\\.Z$"
 318      "application" "octet-stream" (("type" . "compress"))
 319      nil
 320      "attachment"       (("filename" . file))
 321      )
 322     ("\\.lzh$"
 323      "application" "octet-stream" (("type" . "lha"))
 324      nil
 325      "attachment"       (("filename" . file))
 326      )
 327     ("\\.zip$"
 328      "application" "zip" nil
 329      nil
 330      "attachment"       (("filename" . file))
 331      )
 332     ("\\.diff$"
 333      "application" "octet-stream" (("type" . "patch"))
 334      nil
 335      "attachment"       (("filename" . file))
 336      )
 337     ("\\.patch$"
 338      "application" "octet-stream" (("type" . "patch"))
 339      nil
 340      "attachment"       (("filename" . file))
 341      )
 342     ("\\.signature"
 343      "text"     "plain"         nil     nil)
 344     (".*"
 345      "application" "octet-stream" nil
 346      nil
 347      "attachment"       (("filename" . file))
 348      )
 349     )
 350   "*Alist of file name, types, parameters, and default encoding.
 351 If encoding is nil, it is determined from its contents.")
 352
 353 ;;; @@ about charset, encoding and transfer-level
 354 ;;;
 355
 356 (defvar mime-editor/transfer-level 7
 357   "*A number of network transfer level. It should be bigger than 7.")
 358 (make-variable-buffer-local 'mime-editor/transfer-level)
 359
 360 (defvar mime-editor/transfer-level-string
 361   (mime/encoding-name mime-editor/transfer-level 'not-omit)
 362   "*A string formatted version of mime/defaul-transfer-level")
 363 (make-variable-buffer-local 'mime-editor/transfer-level-string)
 364
 365 (defvar mime-editor/charset-default-encoding-alist
 366   (mime/make-charset-default-encoding-alist mime-editor/transfer-level))
 367 (make-variable-buffer-local 'mime-editor/charset-default-encoding-alist)
 368
 369 ;;; @@ about message inserting
 370 ;;;
 371
 372 (defvar mime-editor/yank-ignored-field-list
 373   '("Received" "Approved" "Path" "Replied" "Status" "X-VM-.*" "X-UIDL")
 374   "Delete these fields from original message when it is inserted
 375 as message/rfc822 part.
 376 Each elements are regexp of field-name. [tm-edit.el]")
 377
 378 (defvar mime-editor/yank-ignored-field-regexp
 379   (concat "^"
 380           (apply (function regexp-or) mime-editor/yank-ignored-field-list)
 381           ":"))
 382
 383 (defvar mime-editor/message-inserter-alist nil)
 384 (defvar mime-editor/mail-inserter-alist nil)
 385
 386 ;;; @@ about message splitting
 387 ;;;
 388
 389 (defvar mime-editor/split-message t
 390   "*Split large message if it is non-nil. [tm-edit.el]")
 391
 392 (defvar mime-editor/message-default-max-length 1000
 393   "*Default maximum size of a message. [tm-edit.el]")
 394
 395 (defvar mime-editor/message-max-length-alist
 396   '((news-reply-mode . 500)))
 397
 398 (defconst mime-editor/split-ignored-field-regexp
 399   "\\(^Content-\\|^Subject:\\|^Mime-Version:\\)")
 400
 401 (defvar mime-editor/split-blind-field-regexp
 402   "\\(^[BDFbdf]cc:\\|^cc:[ \t]*$\\)")
 403
 404 (defvar mime-editor/split-message-sender-alist
 405   '((mh-letter-mode
 406      . (lambda (&optional arg)
 407          (interactive "P")
 408          (write-region (point-min) (point-max)
 409                        mime-editor/draft-file-name nil 'no-message)
 410          (cond (arg
 411                 (pop-to-buffer "MH mail delivery")
 412                 (erase-buffer)
 413                 (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush"
 414                                     "-nodraftfolder"
 415                                     mh-send-args mime-editor/draft-file-name)
 416                 (goto-char (point-max)) ; show the interesting part
 417                 (recenter -1)
 418                 (sit-for 1))
 419                (t
 420                 (apply 'mh-exec-cmd-quiet t mh-send-prog
 421                        (mh-list-to-string
 422                         (list "-nopush" "-nodraftfolder"
 423                               "-noverbose" "-nowatch"
 424                               mh-send-args mime-editor/draft-file-name)))))
 425          ))
 426     ))
 427
 428 (defvar mime-editor/news-reply-mode-server-running nil)
 429
 430
 431 ;;; @@ about PGP
 432 ;;;
 433
 434 (defvar mime-editor/signing-type nil
 435   "*PGP signing type (pgp-elkins, pgp-kazu or nil). [tm-edit.el]")
 436
 437 (defvar mime-editor/encrypting-type nil
 438   "*PGP encrypting type (pgp-elkins, pgp-kazu or nil). [tm-edit.el]")
 439
 440 (if (or mime-editor/signing-type mime-editor/encrypting-type)
 441     (require 'mailcrypt)
 442   )
 443
 444
 445 ;;; @@ about tag
 446 ;;;
 447
 448 (defconst mime-editor/single-part-tag-regexp
 449   "^--[[][[]\\([^]]*\\)]\\([[]\\([^]]*\\)]\\|\\)]"
 450   "*Regexp of MIME tag in the form of [[CONTENT-TYPE][ENCODING]].")
 451
 452 (defconst mime-editor/multipart-beginning-regexp "^--<<\\([^<>]+\\)>>-{\n")
 453
 454 (defconst mime-editor/multipart-end-regexp "^--}-<<\\([^<>]+\\)>>\n")
 455
 456 (defconst mime-editor/beginning-tag-regexp
 457   (regexp-or mime-editor/single-part-tag-regexp
 458              mime-editor/multipart-beginning-regexp))
 459
 460 (defconst mime-editor/end-tag-regexp
 461   (regexp-or mime-editor/single-part-tag-regexp
 462              mime-editor/multipart-end-regexp))
 463
 464 (defconst mime-editor/tag-regexp
 465   (regexp-or mime-editor/single-part-tag-regexp
 466              mime-editor/multipart-beginning-regexp
 467              mime-editor/multipart-end-regexp))
 468
 469 (defvar mime-tag-format "--[[%s]]"
 470   "*Control-string making a MIME tag.")
 471
 472 (defvar mime-tag-format-with-encoding "--[[%s][%s]]"
 473   "*Control-string making a MIME tag with encoding.")
 474
 475 ;;; @@ multipart boundary
 476 ;;;
 477
 478 (defvar mime-multipart-boundary "Multipart"
 479   "*Boundary of a multipart message.")
 480
 481
 482 ;;; @@ buffer local variables
 483 ;;;
 484
 485 (defvar mime/editor-mode-old-local-map nil)
 486 (defvar mime/editor-mode-old-selective-display nil)
 487 (defvar mime/editing-buffer nil)
 488
 489 \f
 490 ;;; @ constants
 491 ;;;
 492
 493 (defconst mime-tspecials-regexp "[][()<>@,;:\\\"/?.= \t]"
 494   "*Specify MIME tspecials.
 495 Tspecials means any character that matches with it in header must be quoted.")
 496
 497 (defconst mime-editor/mime-version-value
 498   (format "1.0 (generated by tm-edit %s)" mime-editor/version)
 499   "MIME version number.")
 500
 501 (defconst mime-editor/mime-map (make-sparse-keymap)
 502   "Keymap for MIME commands.")
 503
 504
 505 ;;; @ keymap and menu
 506 ;;;
 507
 508 (defvar mime/editor-mode-flag nil)
 509 (make-variable-buffer-local 'mime/editor-mode-flag)
 510
 511 (set-alist 'minor-mode-alist
 512            'mime/editor-mode-flag
 513            '((" MIME-Edit "  mime-editor/transfer-level-string)))
 514
 515 (defun mime-editor/define-keymap (keymap)
 516   "Add mime-editor commands to KEYMAP."
 517   (if (not (keymapp keymap))
 518       nil
 519     (define-key keymap "\C-t" 'mime-editor/insert-text)
 520     (define-key keymap "\C-i" 'mime-editor/insert-file)
 521     (define-key keymap "\C-e" 'mime-editor/insert-external)
 522     (define-key keymap "\C-v" 'mime-editor/insert-voice)
 523     (define-key keymap "\C-y" 'mime-editor/insert-message)
 524     (define-key keymap "\C-m" 'mime-editor/insert-mail)
 525     (define-key keymap "\C-w" 'mime-editor/insert-signature)
 526     (define-key keymap "\C-s" 'mime-editor/insert-signature)
 527     (define-key keymap "\C-k" 'mime-editor/insert-key)
 528     (define-key keymap "t"    'mime-editor/insert-tag)
 529     (define-key keymap "a"    'mime-editor/enclose-alternative-region)
 530     (define-key keymap "p"    'mime-editor/enclose-parallel-region)
 531     (define-key keymap "m"    'mime-editor/enclose-mixed-region)
 532     (define-key keymap "d"    'mime-editor/enclose-digest-region)
 533     (define-key keymap "s"    'mime-editor/enclose-signed-region)
 534     (define-key keymap "e"    'mime-editor/enclose-encrypted-region)
 535     (define-key keymap "\C-p" 'mime-editor/preview-message)
 536     (define-key keymap "\C-z" 'mime-editor/exit)
 537     (define-key keymap "?"    'mime-editor/help)
 538     ))
 539
 540 (mime-editor/define-keymap mime-editor/mime-map)
 541
 542 (defconst mime-editor/menu-title "MIME-Edit")
 543
 544 (defconst mime-editor/menu-list
 545   '((mime-help  "Describe MIME editor mode" mime-editor/help)
 546     (file       "Insert File"           mime-editor/insert-file)
 547     (external   "Insert External"       mime-editor/insert-external)
 548     (voice      "Insert Voice"          mime-editor/insert-voice)
 549     (message    "Insert Message"        mime-editor/insert-message)
 550     (mail       "Insert Mail"           mime-editor/insert-mail)
 551     (signature  "Insert Signature"      mime-editor/insert-signature)
 552     (text       "Insert Text"           mime-editor/insert-text)
 553     (tag        "Insert Tag"            mime-editor/insert-tag)
 554     (alternative "Enclose as alternative"
 555                  mime-editor/enclose-alternative-region)
 556     (parallel   "Enclose as parallel"   mime-editor/enclose-parallel-region)
 557     (mixed      "Enclose as serial"     mime-editor/enclose-mixed-region)
 558     (digest     "Enclose as digest"     mime-editor/enclose-digest-region)
 559     (signed     "Enclose as signed"     mime-editor/enclose-signed-region)
 560     (encrypted  "Enclose as encrypted"  mime-editor/enclose-encrypted-region)
 561     (key        "Insert Public Key"     mime-editor/insert-key)
 562     (split      "About split"           mime-editor/set-split)
 563     (sign       "About sign"            mime-editor/set-sign)
 564     (encrypt    "About encryption"      mime-editor/set-encrypt)
 565     (preview    "Preview Message"       mime-editor/preview-message)
 566     (level      "Toggle transfer-level" mime-editor/toggle-transfer-level)
 567     )
 568   "MIME-edit menubar entry.")
 569
 570 (defun mime-editor/define-menu-for-emacs19 ()
 571   "Define menu for Emacs 19."
 572   (define-key (current-local-map) [menu-bar mime-edit]
 573     (cons mime-editor/menu-title
 574           (make-sparse-keymap mime-editor/menu-title)))
 575   (mapcar (function
 576            (lambda (item)
 577              (define-key (current-local-map)
 578                (vector 'menu-bar 'mime-edit (car item))
 579                (cons (nth 1 item)(nth 2 item))
 580                )
 581              ))
 582           (reverse mime-editor/menu-list)
 583           ))
 584
 585 ;;; modified by Pekka Marjola <pema@iki.fi>
 586 ;;;     1995/9/5 (c.f. [tm-en:69])
 587 (defun mime-editor/define-menu-for-xemacs ()
 588   "Define menu for Emacs 19."
 589   (cond ((featurep 'menubar)
 590          (make-local-variable 'current-menubar)
 591          (set-buffer-menubar current-menubar)
 592          (add-submenu nil
 593                       (cons mime-editor/menu-title
 594                             (mapcar (function
 595                                      (lambda (item)
 596                                        (vector (nth 1 item)(nth 2 item)
 597                                                mime/editor-mode-flag)
 598                                        ))
 599                                     mime-editor/menu-list)))
 600          )))
 601
 602 ;;; modified by Steven L. Baur <steve@miranova.com>
 603 ;;;     1995/12/6 (c.f. [tm-en:209])
 604 (if (and running-xemacs (not (boundp 'mime-editor/popup-menu-for-xemacs)))
 605     (setq mime-editor/popup-menu-for-xemacs
 606           (append '("MIME Commands" "---")
 607                   (mapcar (function (lambda (item)
 608                                       (vector (nth 1 item)
 609                                               (nth 2 item)
 610                                               t)))
 611                           mime-editor/menu-list)))
 612   )
 613 ;;; end
 614
 615
 616 ;;; @ functions
 617 ;;;
 618
 619 ;;;###autoload
 620 (defun mime/editor-mode ()
 621   "MIME minor mode for editing the tagged MIME message.
 622
 623 In this mode, basically, the message is composed in the tagged MIME
 624 format.  The message tag looks like:
 625
 626         `--[[text/plain; charset=ISO-2022-JP][7bit]]'.
 627
 628 The tag specifies the MIME content type, subtype, optional parameters
 629 and transfer encoding of the message following the tag.  Messages
 630 without any tag are treated as `text/plain' by default.  Charset and
 631 transfer encoding are automatically defined unless explicitly
 632 specified.  Binary messages such as audio and image are usually hidden
 633 using selective-display facility.  The messages in the tagged MIME
 634 format are automatically translated into a MIME compliant message when
 635 exiting this mode.
 636
 637 Available charsets depend on Emacs version being used.  The following
 638 lists the available charsets of each emacs.
 639
 640 Emacs18:        US-ASCII is only available.
 641 NEmacs:         US-ASCII and ISO-2022-JP are available.
 642 Emacs19:        US-ASCII and ISO-8859-1 are available.
 643 Mule:           US-ASCII, ISO-8859-* (except for ISO-8859-6),
 644                 ISO-2022-JP, ISO-2022-JP-2 and ISO-2022-INT-1 are available.
 645
 646 ISO-2022-JP-2 and ISO-2022-INT-1 charsets used in Mule is expected to
 647 be used to represent multilingual text in intermixed manner.  Any
 648 languages that has no registered charset are represented as either
 649 ISO-2022-JP-2 or ISO-2022-INT-1 in Mule.
 650
 651 Following commands are available in addition to major mode commands:
 652 \\[mime-editor/insert-text]     insert a text message.
 653 \\[mime-editor/insert-file]     insert a (binary) file.
 654 \\[mime-editor/insert-external] insert a reference to external body.
 655 \\[mime-editor/insert-voice]    insert a voice message.
 656 \\[mime-editor/insert-message]  insert a mail or news message.
 657 \\[mime-editor/insert-mail]     insert a mail message.
 658 \\[mime-editor/insert-signature]        insert a signature file at end.
 659 \\[mime-editor/insert-tag]      insert a new MIME tag.
 660 \\[mime-editor/enclose-alternative-region]      enclose as multipart/alternative.
 661 \\[mime-editor/enclose-parallel-region] enclose as multipart/parallel.
 662 \\[mime-editor/enclose-mixed-region]    enclose as multipart/mixed.
 663 \\[mime-editor/enclose-digest-region]   enclose as multipart/digest.
 664 \\[mime-editor/enclose-signed-region]   enclose as PGP signed.
 665 \\[mime-editor/enclose-encrypted-region]        enclose as PGP encrypted.
 666 \\[mime-editor/insert-key]      insert PGP public key.
 667 \\[mime-editor/preview-message] preview editing MIME message.
 668 \\[mime-editor/exit]    exit and translate into a MIME compliant message.
 669 \\[mime-editor/maybe-translate] exit and translate if in MIME mode, then split.
 670 \\[mime-editor/help]    show this help.
 671
 672 Additional commands are available in some major modes:
 673 C-c C-c         exit, translate and run the original command.
 674 C-c C-s         exit, translate and run the original command.
 675
 676 The following is a message example written in the tagged MIME format.
 677 TABs at the beginning of the line are not a part of the message:
 678
 679         This is a conventional plain text.  It should be translated
 680         into text/plain.
 681         --[[text/plain]]
 682         This is also a plain text.  But, it is explicitly specified as
 683         is.
 684         --[[text/plain; charset=ISO-2022-JP]]
 685         \e$B$3$l$O\e(B charset \e$B$r\e(B ISO-2022-JP \e$B$K;XDj$7$?F|K\8l$N\e(B plain \e$B%F%-%9\e(B
 686         \e$B%H$G$9\e(B.
 687         --[[text/richtext]]
 688         <center>This is a richtext.</center>
 689         --[[image/gif][base64]]^M...image encoded in base64 here...
 690         --[[audio/basic][base64]]^M...audio encoded in base64 here...
 691
 692 User customizable variables (not documented all of them):
 693  mime-prefix
 694     Specifies a key prefix for MIME minor mode commands.
 695
 696  mime-ignore-preceding-spaces
 697     Preceding white spaces in a message body are ignored if non-nil.
 698
 699  mime-ignore-trailing-spaces
 700     Trailing white spaces in a message body are ignored if non-nil.
 701
 702  mime-auto-fill-header
 703     Fill header fields that contain encoded-words if non-nil.
 704
 705  mime-auto-hide-body
 706     Hide a non-textual body message encoded in base64 after insertion
 707     if non-nil.
 708
 709  mime-voice-recorder
 710     Specifies a function to record a voice message and return a buffer
 711     that contains it.  The function mime-voice-recorder-for-sun is for
 712     Sun SparcStations.
 713
 714  mime/editor-mode-hook
 715     Turning on MIME mode calls the value of mime/editor-mode-hook, if
 716     it is non-nil.
 717
 718  mime-editor/translate-hook
 719     The value of mime-editor/translate-hook is called just before translating
 720     the tagged MIME format into a MIME compliant message if it is
 721     non-nil.  If the hook call the function mime-editor/insert-signature,
 722     the signature file will be inserted automatically.
 723
 724  mime-editor/exit-hook
 725     Turning off MIME mode calls the value of mime-editor/exit-hook, if it is
 726     non-nil."
 727   (interactive)
 728   (if mime/editor-mode-flag
 729       (error "You are already editing a MIME message.")
 730     (setq mime/editor-mode-flag t)
 731     ;; Remember old key bindings.
 732     (if running-xemacs
 733         nil
 734       (make-local-variable 'mime/editor-mode-old-local-map)
 735       (setq mime/editor-mode-old-local-map (current-local-map))
 736       ;; Add MIME commands to current local map.
 737       (use-local-map (copy-keymap (current-local-map)))
 738       )
 739     (if (not (lookup-key (current-local-map) mime-prefix))
 740         (define-key (current-local-map) mime-prefix mime-editor/mime-map))
 741
 742     ;; Set transfer level into mode line
 743     ;;
 744     (setq mime-editor/transfer-level-string
 745           (mime/encoding-name mime-editor/transfer-level 'not-omit))
 746     (force-mode-line-update)
 747
 748     ;; Define menu.  Menus for other emacs implementations are
 749     ;; welcome.
 750     (cond (running-xemacs
 751            (mime-editor/define-menu-for-xemacs))
 752           ((>= emacs-major-version 19)
 753            (mime-editor/define-menu-for-emacs19)
 754            ))
 755     ;; end
 756
 757     ;; Remember old selective-display.
 758     (make-local-variable 'mime/editor-mode-old-selective-display)
 759     (setq mime/editor-mode-old-selective-display selective-display)
 760     (setq selective-display t)
 761     ;; I don't care about saving these.
 762     (setq paragraph-start
 763           (regexp-or mime-editor/single-part-tag-regexp
 764                      paragraph-start))
 765     (setq paragraph-separate
 766           (regexp-or mime-editor/single-part-tag-regexp
 767                      paragraph-separate))
 768     (run-hooks 'mime/editor-mode-hook)
 769     (message
 770      (substitute-command-keys
 771       "Type \\[mime-editor/exit] to exit MIME mode, and type \\[mime-editor/help] to get help."))
 772     ))
 773
 774 ;;;###autoload
 775 (defalias 'edit-mime 'mime/editor-mode)         ; for convenience
 776 (defalias 'mime-mode 'mime/editor-mode)         ; for convenience
 777
 778 (defun mime-editor/exit (&optional nomime no-error)
 779   "Translate the tagged MIME message into a MIME compliant message.
 780 With no argument encode a message in the buffer into MIME, otherwise
 781 just return to previous mode."
 782   (interactive "P")
 783   (if (not mime/editor-mode-flag)
 784       (if (null no-error)
 785           (error "You aren't editing a MIME message.")
 786         )
 787     (if (not nomime)
 788         (progn
 789           (run-hooks 'mime-editor/translate-hook)
 790           (mime-editor/translate-buffer)))
 791     ;; Restore previous state.
 792     (setq mime/editor-mode-flag nil)
 793     (cond (running-xemacs
 794            ;; mime-prefix only defined if binding was nil
 795            (if (eq (lookup-key (current-local-map) mime-prefix)
 796                    mime-editor/mime-map)
 797                (define-key (current-local-map) mime-prefix nil))
 798            (delete-menu-item (list mime-editor/menu-title)))
 799           (t
 800            (use-local-map mime/editor-mode-old-local-map)))
 801
 802     (setq selective-display mime/editor-mode-old-selective-display)
 803     (set-buffer-modified-p (buffer-modified-p))
 804     (run-hooks 'mime-editor/exit-hook)
 805     (message "Exit MIME editor mode.")
 806     ))
 807
 808 (defun mime-editor/maybe-translate ()
 809   (interactive)
 810   (mime-editor/exit nil t)
 811   (call-interactively 'mime-editor/maybe-split-and-send)
 812   )
 813
 814 (defun mime-editor/help ()
 815   "Show help message about MIME mode."
 816   (interactive)
 817   (with-output-to-temp-buffer "*Help*"
 818     (princ "MIME editor mode:\n")
 819     (princ (documentation 'mime/editor-mode))
 820     (print-help-return-message)))
 821
 822 (defun mime-editor/insert-text ()
 823   "Insert a text message.
 824 Charset is automatically obtained from the `mime/lc-charset-alist'."
 825   (interactive)
 826   (if (and (mime-editor/insert-tag "text" nil nil)
 827            (looking-at mime-editor/single-part-tag-regexp))
 828       (progn
 829         ;; Make a space between the following message.
 830         (insert "\n")
 831         (forward-char -1)
 832         )))
 833
 834 (defun mime-editor/insert-file (file)
 835   "Insert a message from a file."
 836   (interactive "fInsert file as MIME message: ")
 837   (let*  ((guess (mime-find-file-type file))
 838           (pritype (nth 0 guess))
 839           (subtype (nth 1 guess))
 840           (parameters (nth 2 guess))
 841           (default (nth 3 guess))       ;Guess encoding from its file name.
 842           (disposition-type (nth 4 guess))
 843           (disposition-params (nth 5 guess))
 844           (encoding
 845            (if (not (interactive-p))
 846                default
 847              (completing-read
 848               (concat "What transfer encoding"
 849                       (if default
 850                           (concat " (default "
 851                                   (if (string-equal default "")
 852                                       "\"\""
 853                                     default)
 854                                   ")"
 855                                   ))
 856                       ": ")
 857               mime-encoding-method-alist nil t nil))))
 858     (if (string-equal encoding "")
 859         (setq encoding default))
 860     (if (or (consp parameters) (stringp disposition-type))
 861         (let ((rest parameters) cell attribute value)
 862           (setq parameters "")
 863           (while rest
 864             (setq cell (car rest))
 865             (setq attribute (car cell))
 866             (setq value (cdr cell))
 867             (if (eq value 'file)
 868                 (setq value (rfc822/wrap-as-quoted-string
 869                              (file-name-nondirectory file)))
 870               )
 871             (setq parameters (concat parameters "; " attribute "=" value))
 872             (setq rest (cdr rest))
 873             )
 874           (if disposition-type
 875               (progn
 876                 (setq parameters
 877                       (concat parameters "\n"
 878                               "Content-Disposition: " disposition-type))
 879                 (setq rest disposition-params)
 880                 (while rest
 881                   (setq cell (car rest))
 882                   (setq attribute (car cell))
 883                   (setq value (cdr cell))
 884                   (if (eq value 'file)
 885                       (setq value (rfc822/wrap-as-quoted-string
 886                                    (file-name-nondirectory file)))
 887                     )
 888                   (setq parameters
 889                         (concat parameters "; " attribute "=" value))
 890                   (setq rest (cdr rest))
 891                   )
 892                 ))
 893           ))
 894     (mime-editor/insert-tag pritype subtype parameters)
 895     (mime-editor/insert-binary-file file encoding)
 896     ))
 897
 898 (defun mime-editor/insert-external ()
 899   "Insert a reference to external body."
 900   (interactive)
 901   (mime-editor/insert-tag "message" "external-body" nil ";\n\t")
 902   ;;(forward-char -1)
 903   ;;(insert "Content-Description: " (read-string "Content-Description: ") "\n")
 904   ;;(forward-line 1)
 905   (let* ((pritype (mime-prompt-for-type))
 906          (subtype (mime-prompt-for-subtype pritype))
 907          (parameters (mime-prompt-for-parameters pritype subtype ";\n\t")))
 908     (and pritype
 909          subtype
 910          (insert "Content-Type: "
 911                  pritype "/" subtype (or parameters "") "\n")))
 912   (if (and (not (eobp))
 913            (not (looking-at mime-editor/single-part-tag-regexp)))
 914       (insert (mime-make-text-tag) "\n")))
 915
 916 (defun mime-editor/insert-voice ()
 917   "Insert a voice message."
 918   (interactive)
 919   (mime-editor/insert-tag "audio" "basic" nil)
 920   (let ((buffer (funcall mime-voice-recorder)))
 921     (unwind-protect
 922         (mime-editor/insert-binary-buffer buffer "base64")
 923       (kill-buffer buffer)
 924       )))
 925
 926 (defun mime-editor/insert-signature (&optional arg)
 927   "Insert a signature file."
 928   (interactive "P")
 929   (let ((signature-insert-hook
 930          (function
 931           (lambda ()
 932             (apply (function mime-editor/insert-tag)
 933                    (mime-find-file-type signature-file-name))
 934             )))
 935         )
 936     (insert-signature arg)
 937     ))
 938
 939 \f
 940 ;; Insert a new tag around a point.
 941
 942 (defun mime-editor/insert-tag (&optional pritype subtype parameters delimiter)
 943   "Insert new MIME tag and return a list of PRITYPE, SUBTYPE, and PARAMETERS.
 944 If nothing is inserted, return nil."
 945   (interactive)
 946   (let ((oldtag nil)
 947         (newtag nil)
 948         (current (point))
 949         exist-prev-tag exist-next-tag)
 950     (setq pritype
 951           (or pritype
 952               (mime-prompt-for-type)))
 953     (setq subtype
 954           (or subtype
 955               (mime-prompt-for-subtype pritype)))
 956     (setq parameters
 957           (or parameters
 958               (mime-prompt-for-parameters pritype subtype delimiter)))
 959     ;; Make a new MIME tag.
 960     (setq newtag (mime-make-tag pritype subtype parameters))
 961     ;; Find an current MIME tag.
 962     (setq oldtag
 963           (save-excursion
 964             (if (mime-editor/goto-tag)
 965                 (progn
 966                   (if (eq current (match-beginning 0))
 967                       (setq exist-next-tag t)
 968                     (setq exist-prev-tag t)
 969                     )
 970                   (buffer-substring (match-beginning 0) (match-end 0))
 971                   )
 972               ;; Assume content type is 'text/plan'.
 973               (mime-make-tag "text" "plain")
 974               )))
 975     ;; We are only interested in TEXT.
 976     (if (and oldtag
 977              (not (mime-test-content-type
 978                    (mime-editor/get-contype oldtag) "text")))
 979         (setq oldtag nil))
 980     (cond (exist-prev-tag (insert "\n"))
 981           (exist-next-tag (save-excursion
 982                             (insert "\n")
 983                             )))
 984     (if (not (bolp))
 985         (if exist-prev-tag
 986             (forward-line 1)
 987           (insert "\n")
 988           ))
 989     ;; Make a new tag.
 990     (if (or (not oldtag)                ;Not text
 991             (or mime-ignore-same-text-tag
 992                 (not (string-equal oldtag newtag))))
 993         (progn
 994           ;; Mark the beginning of the tag for convenience.
 995           (push-mark (point) 'nomsg)
 996           (insert newtag "\n")
 997           (list pritype subtype parameters) ;New tag is created.
 998           )
 999       ;; Restore previous point.
1000       (goto-char current)
1001       nil                               ;Nothing is created.
1002       )
1003     ))
1004
1005 ;; Insert the binary content after MIME tag.
1006 ;;      modified by MORITA Masahiro <hiro@isl.ntt.JP>
1007 ;;      for x-uue
1008 (defun mime-editor/insert-binary-file (file &optional encoding)
1009   "Insert binary FILE at point.
1010 Optional argument ENCODING specifies an encoding method such as base64."
1011   (let ((tmpbuf (get-buffer-create " *MIME insert*")))
1012     (save-excursion
1013       (set-buffer tmpbuf)
1014       (erase-buffer)
1015       (let ((mc-flag nil)               ;Mule
1016             (file-coding-system-for-read
1017              (if (featurep 'mule) *noconv*))
1018             (kanji-flag nil)            ;NEmacs
1019             (emx-binary-mode t)         ;Stop CRLF to LF conversion in OS/2
1020             )
1021         (let (jka-compr-compression-info-list
1022               jam-zcat-filename-list)
1023           (insert-file-contents file))))
1024     (prog1
1025         (if (and (stringp encoding)
1026                  (string-equal (downcase encoding) "x-uue"))
1027             (progn
1028               (require 'mel-u)
1029               (let ((uuencode-external-encoder
1030                      (cons (car uuencode-external-encoder)
1031                            (list (file-name-nondirectory file))
1032                            )))
1033                 (mime-editor/insert-binary-buffer tmpbuf encoding)
1034                 ))
1035           (mime-editor/insert-binary-buffer tmpbuf encoding))
1036       (kill-buffer tmpbuf))))
1037
1038 ;; Insert the binary content after MIME tag.
1039 ;;      modified by MORITA Masahiro <hiro@isl.ntt.JP>
1040 ;;      for x-uue
1041 (defun mime-editor/insert-binary-buffer (buffer &optional encoding)
1042   "Insert binary BUFFER at point.
1043 Optional argument ENCODING specifies an encoding method such as base64."
1044   (let* ((tagend (1- (point)))          ;End of the tag
1045          (hide-p (and mime-auto-hide-body
1046                       (stringp encoding)
1047                       (let ((en (downcase encoding)))
1048                         (or (string-equal en "base64")
1049                             (string-equal en "x-uue")
1050                             ))))
1051          )
1052     (save-restriction
1053       (narrow-to-region (1- (point)) (point))
1054       (let ((start (point))
1055             (emx-binary-mode t))        ;Stop LF to CRLF conversion in OS/2
1056         (insert-buffer-substring buffer)
1057         ;; Encode binary message if necessary.
1058         (if encoding
1059             (mime-encode-region start (point-max) encoding)
1060           ))
1061       (if hide-p
1062           (progn
1063             (mime-flag-region (point-min) (1- (point-max)) ?\^M)
1064             (goto-char (point-max)))
1065         ))
1066     ;; Define encoding even if it is 7bit.
1067     (if (stringp encoding)
1068         (save-excursion
1069           (goto-char tagend)            ;Make sure which line the tag is on.
1070           (mime-editor/define-encoding encoding)))
1071     ))
1072
1073 \f
1074 ;; Commands work on a current message flagment.
1075
1076 (defun mime-editor/goto-tag ()
1077   "Search for the beginning of the tagged MIME message."
1078   (let ((current (point)) multipart)
1079     (if (looking-at mime-editor/tag-regexp)
1080         t
1081       ;; At first, go to the end.
1082       (cond ((re-search-forward mime-editor/beginning-tag-regexp nil t)
1083              (goto-char (match-beginning 0)) ;For multiline tag
1084              (forward-line -1)
1085              (end-of-line)
1086              )
1087             (t
1088              (goto-char (point-max))
1089              ))
1090       ;; Then search for the beginning.
1091       (re-search-backward mime-editor/end-tag-regexp nil t)
1092       (beginning-of-line)
1093       (or (looking-at mime-editor/beginning-tag-regexp)
1094           ;; Restore previous point.
1095           (progn
1096             (goto-char current)
1097             nil
1098             ))
1099       )))
1100
1101 (defun mime-editor/content-beginning ()
1102   "Return the point of the beginning of content."
1103   (save-excursion
1104     (let ((beg (save-excursion
1105                  (beginning-of-line) (point))))
1106       (if (mime-editor/goto-tag)
1107           (let ((top (point)))
1108             (goto-char (match-end 0))
1109             (if (and (= beg top)
1110                      (= (following-char) ?\^M))
1111                 (point)
1112               (forward-line 1)
1113               (point)))
1114         ;; Default text/plain tag.
1115         (goto-char (point-min))
1116         (re-search-forward
1117          (concat "\n" (regexp-quote mail-header-separator)
1118                  (if mime-ignore-preceding-spaces
1119                      "[ \t\n]*\n" "\n")) nil 'move)
1120         (point))
1121       )))
1122
1123 (defun mime-editor/content-end ()
1124   "Return the point of the end of content."
1125   (save-excursion
1126     (let ((beg (save-excursion
1127                  (beginning-of-line) (point))))
1128       (if (mime-editor/goto-tag)
1129           (let ((top (point)))
1130             (goto-char (match-end 0))
1131             (if (and (= beg top)        ;Must be on the same line.
1132                      (= (following-char) ?\^M))
1133                 (progn
1134                   (end-of-line)
1135                   (point))
1136               ;; Move to the end of this text.
1137               (if (re-search-forward mime-editor/tag-regexp nil 'move)
1138                   ;; Don't forget a multiline tag.
1139                   (goto-char (match-beginning 0)))
1140               (point)
1141               ))
1142         ;; Assume the message begins with text/plain.
1143         (goto-char (mime-editor/content-beginning))
1144         (if (re-search-forward mime-editor/tag-regexp nil 'move)
1145             ;; Don't forget a multiline tag.
1146             (goto-char (match-beginning 0)))
1147         (point))
1148       )))
1149
1150 (defun mime-editor/define-charset (charset)
1151   "Set charset of current tag to CHARSET."
1152   (save-excursion
1153     (if (mime-editor/goto-tag)
1154         (let ((tag (buffer-substring (match-beginning 0) (match-end 0))))
1155           (delete-region (match-beginning 0) (match-end 0))
1156           (insert
1157            (mime-create-tag (mime-set-parameter
1158                              (mime-editor/get-contype tag) "charset" charset)
1159                             (mime-editor/get-encoding tag))))
1160       )))
1161
1162 (defun mime-editor/define-encoding (encoding)
1163   "Set encoding of current tag to ENCODING."
1164   (save-excursion
1165     (if (mime-editor/goto-tag)
1166         (let ((tag (buffer-substring (match-beginning 0) (match-end 0))))
1167           (delete-region (match-beginning 0) (match-end 0))
1168           (insert (mime-create-tag (mime-editor/get-contype tag) encoding)))
1169       )))
1170
1171 (defun mime-editor/choose-charset ()
1172   "Choose charset of a text following current point."
1173   (mime/find-charset-region (point) (mime-editor/content-end))
1174   )
1175
1176 (defun mime-make-text-tag (&optional subtype)
1177   "Make a tag for a text after current point.
1178 Subtype of text type can be specified by an optional argument SUBTYPE.
1179 Otherwise, it is obtained from mime-content-types."
1180   (let* ((pritype "text")
1181          (subtype (or subtype
1182                       (car (car (cdr (assoc pritype mime-content-types)))))))
1183     ;; Charset should be defined later.
1184     (mime-make-tag pritype subtype)))
1185
1186 \f
1187 ;; Tag handling functions
1188
1189 (defun mime-make-tag (pritype subtype &optional parameters encoding)
1190   "Make a tag of MIME message of PRITYPE, SUBTYPE and optional PARAMETERS."
1191   (mime-create-tag (concat (or pritype "") "/" (or subtype "")
1192                            (or parameters ""))
1193                    encoding))
1194
1195 (defun mime-create-tag (contype &optional encoding)
1196   "Make a tag with CONTENT-TYPE and optional ENCODING."
1197   (format (if encoding mime-tag-format-with-encoding mime-tag-format)
1198           contype encoding))
1199
1200 (defun mime-editor/get-contype (tag)
1201   "Return Content-Type (including parameters) of TAG."
1202   (and (stringp tag)
1203        (or (string-match mime-editor/single-part-tag-regexp tag)
1204            (string-match mime-editor/multipart-beginning-regexp tag)
1205            (string-match mime-editor/multipart-end-regexp tag)
1206            )
1207        (substring tag (match-beginning 1) (match-end 1))
1208        ))
1209
1210 (defun mime-editor/get-encoding (tag)
1211   "Return encoding of TAG."
1212   (and (stringp tag)
1213        (string-match mime-editor/single-part-tag-regexp tag)
1214        (match-beginning 3)
1215        (not (= (match-beginning 3) (match-end 3)))
1216        (substring tag (match-beginning 3) (match-end 3))))
1217
1218 (defun mime-get-parameter (contype parameter)
1219   "For given CONTYPE return value for PARAMETER.
1220 Nil if no such parameter."
1221   (if (string-match
1222        (concat
1223         ";[ \t\n]*"
1224         (regexp-quote parameter)
1225         "[ \t\n]*=[ \t\n]*\\([^\" \t\n;]*\\|\"[^\"]*\"\\)\\([ \t\n]*;\\|$\\)")
1226        contype)
1227       (substring contype (match-beginning 1) (match-end 1))
1228     nil                                 ;No such parameter
1229     ))
1230
1231 (defun mime-set-parameter (contype parameter value)
1232   "For given CONTYPE set PARAMETER to VALUE."
1233   (if (string-match
1234        (concat
1235         ";[ \t\n]*\\("
1236         (regexp-quote parameter)
1237         "[ \t\n]*=[ \t\n]*\\([^\" \t\n;]*\\|\"[^\"]*\"\\)\\)[ \t\n]*\\(;\\|$\\)")
1238        contype)
1239       ;; Change value
1240       (concat (substring contype 0 (match-beginning 1))
1241               parameter "=" value
1242               (substring contype (match-end 1)))
1243     (concat contype "; " parameter "=" value)))
1244
1245 (defun mime-strip-parameters (contype)
1246   "Return primary content-type and subtype without parameters for CONTYPE."
1247   (if (string-match "^[ \t]*\\([^; \t\n]*\\)" contype)
1248       (substring contype (match-beginning 1) (match-end 1)) nil))
1249
1250 (defun mime-test-content-type (contype type &optional subtype)
1251   "Test if CONTYPE is a TYPE and an optional SUBTYPE."
1252   (and (stringp contype)
1253        (stringp type)
1254        (string-match
1255         (concat "^[ \t]*" (downcase type) "/" (downcase (or subtype "")))
1256         (downcase contype))))
1257
1258 \f
1259 ;; Basic functions
1260
1261 (defun mime-find-file-type (file)
1262   "Guess Content-Type, subtype, and parameters from FILE."
1263   (let ((guess nil)
1264         (guesses mime-file-types))
1265     (while (and (not guess) guesses)
1266       (if (string-match (car (car guesses)) file)
1267           (setq guess (cdr (car guesses))))
1268       (setq guesses (cdr guesses)))
1269     guess
1270     ))
1271
1272 (defun mime-prompt-for-type ()
1273   "Ask for Content-type."
1274   (let ((type ""))
1275     ;; Repeat until primary content type is specified.
1276     (while (string-equal type "")
1277       (setq type
1278             (completing-read "What content type: "
1279                              mime-content-types
1280                              nil
1281                              'require-match ;Type must be specified.
1282                              nil
1283                              ))
1284       (if (string-equal type "")
1285           (progn
1286             (message "Content type is required.")
1287             (beep)
1288             (sit-for 1)
1289             ))
1290       )
1291     type
1292     ))
1293
1294 (defun mime-prompt-for-subtype (pritype)
1295   "Ask for Content-type subtype of Content-Type PRITYPE."
1296   (let* ((default (car (car (cdr (assoc pritype mime-content-types)))))
1297          (answer
1298           (completing-read
1299            (if default
1300                (concat
1301                 "What content subtype: (default " default ") ")
1302              "What content subtype: ")
1303            (cdr (assoc pritype mime-content-types))
1304            nil
1305            'require-match               ;Subtype must be specified.
1306            nil
1307            )))
1308     (if (string-equal answer "") default answer)))
1309
1310 (defun mime-prompt-for-parameters (pritype subtype &optional delimiter)
1311   "Ask for Content-type parameters of Content-Type PRITYPE and SUBTYPE.
1312 Optional DELIMITER specifies parameter delimiter (';' by default)."
1313   (let* ((delimiter (or delimiter "; "))
1314          (parameters
1315           (mapconcat
1316            (function identity)
1317            (delq nil
1318                  (mime-prompt-for-parameters-1
1319                   (cdr (assoc subtype
1320                               (cdr (assoc pritype mime-content-types))))))
1321            delimiter
1322            )))
1323     (if (and (stringp parameters)
1324              (not (string-equal parameters "")))
1325         (concat delimiter parameters)
1326       ""                                ;"" if no parameters
1327       )))
1328
1329 (defun mime-prompt-for-parameters-1 (optlist)
1330   (apply (function append)
1331          (mapcar (function mime-prompt-for-parameter) optlist)))
1332
1333 (defun mime-prompt-for-parameter (parameter)
1334   "Ask for PARAMETER.
1335 Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))."
1336   (let* ((prompt (car parameter))
1337          (choices (mapcar (function
1338                            (lambda (e)
1339                              (if (consp e) e (list e))))
1340                           (cdr parameter)))
1341          (default (car (car choices)))
1342          (answer nil))
1343     (if choices
1344         (progn
1345           (setq answer
1346                 (completing-read
1347                  (concat "What " prompt
1348                          ": (default "
1349                          (if (string-equal default "") "\"\"" default)
1350                          ") ")
1351                  choices nil nil ""))
1352           ;; If nothing is selected, use default.
1353           (if (string-equal answer "")
1354               (setq answer default)))
1355       (setq answer
1356             (read-string (concat "What " prompt ": "))))
1357     (cons (if (and answer
1358                    (not (string-equal answer "")))
1359               (concat prompt "="
1360                       ;; Note: control characters ignored!
1361                       (if (string-match mime-tspecials-regexp answer)
1362                           (concat "\"" answer "\"") answer)))
1363           (mime-prompt-for-parameters-1 (cdr (assoc answer (cdr parameter)))))
1364     ))
1365
1366 (defun mime-flag-region (from to flag)
1367   "Hides or shows lines from FROM to TO, according to FLAG.
1368 If FLAG is `\\n' (newline character) then text is shown,
1369 while if FLAG is `\\^M' (control-M) the text is hidden."
1370   (let ((buffer-read-only nil)          ;Okay even if write protected.
1371         (modp (buffer-modified-p)))
1372     (unwind-protect
1373         (subst-char-in-region from to
1374                               (if (= flag ?\n) ?\^M ?\n)
1375                               flag t)
1376       (set-buffer-modified-p modp))))
1377
1378 \f
1379 ;;; @ Translate the tagged MIME messages into a MIME compliant message.
1380 ;;;
1381
1382 (defvar mime-editor/translate-buffer-hook
1383   '(mime-editor/pgp-enclose-buffer
1384     mime/encode-message-header
1385     mime-editor/translate-body))
1386
1387 (defun mime-editor/translate-buffer ()
1388   "Encode the tagged MIME message in current buffer in MIME compliant message."
1389   (interactive)
1390   (if (catch 'mime-editor/error
1391         (save-excursion
1392           (run-hooks 'mime-editor/translate-buffer-hook)
1393           ))
1394       (progn
1395         (undo)
1396         (error "Translation error!")
1397         )))
1398
1399 (defun mime-editor/find-inmost ()
1400   (goto-char (point-min))
1401   (if (re-search-forward mime-editor/multipart-beginning-regexp nil t)
1402       (let ((bb (match-beginning 0))
1403             (be (match-end 0))
1404             (type (buffer-substring (match-beginning 1)(match-end 1)))
1405             end-exp eb ee)
1406         (setq end-exp (format "^--}-<<%s>>\n" type))
1407         (widen)
1408         (if (re-search-forward end-exp nil t)
1409             (progn
1410               (setq eb (match-beginning 0))
1411               (setq ee (match-end 0))
1412               )
1413           (setq eb (point-max))
1414           (setq ee (point-max))
1415           )
1416         (narrow-to-region be eb)
1417         (goto-char be)
1418         (if (re-search-forward mime-editor/multipart-beginning-regexp nil t)
1419             (let (ret)
1420               (narrow-to-region (match-beginning 0)(point-max))
1421               (mime-editor/find-inmost)
1422               )
1423           (widen)
1424           ;;(delete-region eb ee)
1425           (list type bb be eb)
1426           ))))
1427
1428 (defun mime-editor/process-multipart-1 (boundary)
1429   (let ((ret (mime-editor/find-inmost)))
1430     (if ret
1431         (let ((type (car ret))
1432               (bb (nth 1 ret))(be (nth 2 ret))
1433               (eb (nth 3 ret))
1434               )
1435           (narrow-to-region bb eb)
1436           (delete-region bb be)
1437           (setq bb (point-min))
1438           (setq eb (point-max))
1439           (widen)
1440           (goto-char eb)
1441           (if (looking-at mime-editor/multipart-end-regexp)
1442               (let ((beg (match-beginning 0))
1443                     (end (match-end 0))
1444                     )
1445                 (delete-region beg end)
1446                 (if (and (not (looking-at mime-editor/single-part-tag-regexp))
1447                          (not (eobp)))
1448                     (insert (concat (mime-make-text-tag) "\n"))
1449                   )))
1450           (cond ((string= type "signed")
1451                  (cond ((eq mime-editor/signing-type 'pgp-elkins)
1452                         (mime-editor/sign-pgp-elkins bb eb boundary)
1453                         )
1454                        ((eq mime-editor/signing-type 'pgp-kazu)
1455                         (mime-editor/sign-pgp-kazu bb eb boundary)
1456                         )
1457                        ))
1458                 ((string= type "encrypted")
1459                  (cond ((eq mime-editor/encrypting-type 'pgp-elkins)
1460                         (mime-editor/encrypt-pgp-elkins bb eb boundary)
1461                         )
1462                        ((eq mime-editor/encrypting-type 'pgp-kazu)
1463                         (mime-editor/encrypt-pgp-kazu bb eb boundary)
1464                         )))
1465                 (t
1466                  (setq boundary
1467                        (nth 2 (mime-editor/translate-region bb eb
1468                                                             boundary t)))
1469                  (goto-char bb)
1470                  (insert
1471                   (format "--[[multipart/%s;
1472  boundary=\"%s\"][7bit]]\n"
1473                           type boundary))
1474                  ))
1475           boundary))))
1476
1477
1478 (autoload 'mc-pgp-lookup-key "mc-pgp")
1479 (autoload 'mc-pgp-sign-region "mc-pgp")
1480 (autoload 'mc-pgp-encrypt-region "mc-pgp")
1481
1482 (defun tm:mc-pgp-generic-parser (result)
1483   (let ((ret (mc-pgp-generic-parser result)))
1484     (if (consp ret)
1485         (vector (car ret)(cdr ret))
1486       )))
1487
1488 (defun tm:mc-process-region
1489   (beg end passwd program args parser &optional buffer boundary)
1490   (let ((obuf (current-buffer))
1491         (process-connection-type nil)
1492         mybuf result rgn proc)
1493     (unwind-protect
1494         (progn
1495           (setq mybuf (or buffer (generate-new-buffer " *mailcrypt temp")))
1496           (set-buffer mybuf)
1497           (erase-buffer)
1498           (set-buffer obuf)
1499           (buffer-disable-undo mybuf)
1500           (setq proc
1501                 (apply 'start-process "*PGP*" mybuf program args))
1502           (if passwd
1503               (progn
1504                 (process-send-string proc (concat passwd "\n"))
1505                 (or mc-passwd-timeout (mc-deactivate-passwd t))))
1506           (process-send-region proc beg end)
1507           (process-send-eof proc)
1508           (while (eq 'run (process-status proc))
1509             (accept-process-output proc 5))
1510           (setq result (process-exit-status proc))
1511           ;; Hack to force a status_notify() in Emacs 19.29
1512           (delete-process proc)
1513           (set-buffer mybuf)
1514           (goto-char (point-max))
1515           (if (re-search-backward "\nProcess \\*PGP.*\n\\'" nil t)
1516               (delete-region (match-beginning 0) (match-end 0)))
1517           (goto-char (point-min))
1518           ;; CRNL -> NL
1519           (while (search-forward "\r\n" nil t)
1520             (replace-match "\n"))
1521           ;; Hurm.  FIXME; must get better result codes.
1522           (if (stringp result)
1523               (error "%s exited abnormally: '%s'" program result)
1524             (setq rgn (funcall parser result))
1525             ;; If the parser found something, migrate it
1526             (if (consp rgn)
1527                 (progn
1528                   (set-buffer obuf)
1529                   (if boundary
1530                       (save-restriction
1531                         (narrow-to-region beg end)
1532                         (goto-char beg)
1533                         (insert (format "--%s\n" boundary))
1534                         (goto-char (point-max))
1535                         (insert (format "\n--%s
1536 Content-Type: application/pgp-signature
1537 Content-Transfer-Encoding: 7bit
1538
1539 " boundary))
1540                         (insert-buffer-substring mybuf (car rgn) (cdr rgn))
1541                         (goto-char (point-max))
1542                         (insert (format "\n--%s--\n" boundary))
1543                         )
1544                     (delete-region beg end)
1545                     (goto-char beg)
1546                     (insert-buffer-substring mybuf (car rgn) (cdr rgn))
1547                     )
1548                   (set-buffer mybuf)
1549                   (delete-region (car rgn) (cdr rgn)))))
1550           ;; Return nil on failure and exit code on success
1551           (if rgn result))
1552       ;; Cleanup even on nonlocal exit
1553       (if (and proc (eq 'run (process-status proc)))
1554           (interrupt-process proc))
1555       (set-buffer obuf)
1556       (or buffer (null mybuf) (kill-buffer mybuf)))))
1557
1558 (defun tm:mc-pgp-sign-region (start end &optional id unclear boundary)
1559   (if (not (boundp 'mc-pgp-user-id))
1560       (load "mc-pgp")
1561     )
1562   (let ((process-environment process-environment)
1563         (buffer (get-buffer-create mc-buffer-name))
1564         passwd args key
1565         (parser (function mc-pgp-generic-parser))
1566         (pgp-path mc-pgp-path)
1567         )
1568     (setq key (mc-pgp-lookup-key (or id mc-pgp-user-id)))
1569     (setq passwd
1570           (mc-activate-passwd
1571            (cdr key)
1572            (format "PGP passphrase for %s (%s): " (car key) (cdr key))))
1573     (setenv "PGPPASSFD" "0")
1574     (setq args
1575           (cons
1576            (if boundary
1577                "-fbast"
1578              "-fast")
1579            (list "+verbose=1" "+language=en"
1580                  (format "+clearsig=%s" (if unclear "off" "on"))
1581                  "+batchmode" "-u" (cdr key))))
1582     (if mc-pgp-comment
1583         (setq args (cons (format "+comment=%s" mc-pgp-comment) args))
1584       )
1585     (message "Signing as %s ..." (car key))
1586     (if (tm:mc-process-region
1587          start end passwd pgp-path args parser buffer boundary)
1588         (progn
1589           (if boundary
1590               (progn
1591                 (goto-char (point-min))
1592                 (insert
1593                  (format "\
1594 --[[multipart/signed; protocol=\"application/pgp-signature\";
1595  boundary=\"%s\"; micalg=pgp-md5][7bit]]\n" boundary))
1596                 ))
1597           (message "Signing as %s ... Done." (car key))
1598           t)
1599       nil)))
1600
1601 (defun mime-editor/sign-pgp-elkins (beg end boundary)
1602   (save-excursion
1603     (save-restriction
1604       (narrow-to-region beg end)
1605       (let* ((ret
1606               (mime-editor/translate-region beg end boundary))
1607              (ctype    (car ret))
1608              (encoding (nth 1 ret))
1609              (parts    (nth 3 ret))
1610              (pgp-boundary (concat "pgp-sign-" boundary))
1611              )
1612         (goto-char beg)
1613         (insert (format "Content-Type: %s\n" ctype))
1614         (if encoding
1615             (insert (format "Content-Transfer-Encoding: %s\n" encoding))
1616           )
1617         (insert "\n")
1618         (or (tm:mc-pgp-sign-region (point-min)(point-max)
1619                                    nil nil pgp-boundary)
1620             (throw 'mime-editor/error 'pgp-error)
1621             )
1622         ))))
1623
1624 (defun mime-editor/encrypt-pgp-elkins (beg end boundary)
1625   (save-excursion
1626     (save-restriction
1627       (let ((from (rfc822/get-field-body "From"))
1628             (to (rfc822/get-field-body "To"))
1629             (cc (rfc822/get-field-body "cc"))
1630             recipients)
1631         (narrow-to-region beg end)
1632         (let* ((ret
1633                 (mime-editor/translate-region beg end boundary))
1634                (ctype    (car ret))
1635                (encoding (nth 1 ret))
1636                (parts    (nth 3 ret))
1637                (pgp-boundary (concat "pgp-" boundary))
1638                )
1639           (goto-char beg)
1640           (if (and (stringp from)
1641                    (not (string-equal from "")))
1642               (insert (format "From: %s\n" from))
1643             )
1644           (if (and (stringp to)
1645                    (not (string-equal to "")))
1646               (progn
1647                 (insert (format "To: %s\n" to))
1648                 (setq recipients to)
1649                 ))
1650           (if (and (stringp cc)
1651                    (not (string-equal cc "")))
1652               (progn
1653                 (insert (format "cc: %s\n" cc))
1654                 (if recipients
1655                     (setq recipients (concat recipients "," cc))
1656                   (setq recipients cc)
1657                   )))
1658           (insert (format "Content-Type: %s\n" ctype))
1659           (if encoding
1660               (insert (format "Content-Transfer-Encoding: %s\n" encoding))
1661             )
1662           (insert "\n")
1663           (if (null
1664                (let ((mc-pgp-always-sign 'never))
1665                  (mc-pgp-encrypt-region
1666                   (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" recipients)
1667                   (point-min) (point-max) from nil)
1668                  ))
1669               (throw 'mime-editor/error 'pgp-error)
1670             )
1671           (goto-char beg)
1672           (insert (format "--[[multipart/encrypted;
1673  boundary=\"%s\";
1674  protocol=\"application/pgp-encrypted\"][7bit]]
1675 --%s
1676 Content-Type: application/pgp-encrypted
1677
1678 --%s
1679 Content-Type: application/octet-stream
1680 Content-Transfer-Encoding: 7bit
1681
1682 " pgp-boundary pgp-boundary pgp-boundary))
1683           (goto-char (point-max))
1684           (insert (format "\n--%s--\n" pgp-boundary))
1685           )))))
1686
1687 (defun mime-editor/sign-pgp-kazu (beg end boundary)
1688   (save-excursion
1689     (save-restriction
1690       (narrow-to-region beg end)
1691       (let* ((ret
1692               (mime-editor/translate-region beg end boundary))
1693              (ctype    (car ret))
1694              (encoding (nth 1 ret))
1695              (parts    (nth 3 ret))
1696              )
1697         (goto-char beg)
1698         (insert (format "Content-Type: %s\n" ctype))
1699         (if encoding
1700             (insert (format "Content-Transfer-Encoding: %s\n" encoding))
1701           )
1702         (insert "\n")
1703         (or (let ((program-coding-system-alist
1704                    (cons (cons (cons nil ".*pgp.*")
1705                                (cons *noconv* *noconv*))
1706                          program-coding-system-alist))
1707                   )
1708               (mc-pgp-sign-region beg (point-max))
1709               )
1710             (throw 'mime-editor/error 'pgp-error)
1711             )
1712         (goto-char beg)
1713         (insert
1714          "--[[application/pgp; format=mime][7bit]]\n")
1715         ))
1716     ))
1717
1718 (defun mime-editor/encrypt-pgp-kazu (beg end boundary)
1719   (save-excursion
1720     (let ((from (rfc822/get-field-body "From"))
1721           (to (rfc822/get-field-body "To"))
1722           (cc (rfc822/get-field-body "cc"))
1723           recipients)
1724       (save-restriction
1725         (narrow-to-region beg end)
1726         (let* ((ret
1727                 (mime-editor/translate-region beg end boundary))
1728                (ctype    (car ret))
1729                (encoding (nth 1 ret))
1730                (parts    (nth 3 ret))
1731                )
1732           (goto-char beg)
1733           (if (and (stringp from)
1734                    (not (string-equal from "")))
1735               (insert (format "From: %s\n" from))
1736             )
1737           (if (and (stringp to)
1738                    (not (string-equal to "")))
1739               (progn
1740                 (insert (format "To: %s\n" to))
1741                 (setq recipients to)
1742                 ))
1743           (if (and (stringp cc)
1744                    (not (string-equal cc "")))
1745               (progn
1746                 (insert (format "cc: %s\n" cc))
1747                 (if recipients
1748                     (setq recipients (concat recipients "," cc))
1749                   (setq recipients cc)
1750                   )))
1751           (insert (format "Content-Type: %s\n" ctype))
1752           (if encoding
1753               (insert (format "Content-Transfer-Encoding: %s\n" encoding))
1754             )
1755           (insert "\n")
1756           (or (let ((program-coding-system-alist
1757                      (cons (cons (cons nil ".*pgp.*")
1758                                  (cons *noconv* *noconv*))
1759                            program-coding-system-alist))
1760                     )
1761                 (mc-pgp-encrypt-region
1762                  (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" recipients)
1763                  beg (point-max))
1764                 )
1765               (throw 'mime-editor/error 'pgp-error)
1766               )
1767           (goto-char beg)
1768           (insert
1769            "--[[application/pgp; format=mime][7bit]]\n")
1770           ))
1771       )))
1772
1773 (defun mime-editor/translate-body ()
1774   "Encode the tagged MIME body in current buffer in MIME compliant message."
1775   (interactive)
1776   (save-excursion
1777     (let ((boundary
1778            (concat mime-multipart-boundary "_"
1779                    (replace-space-with-underline (current-time-string))
1780                    ))
1781           (i 1)
1782           ret)
1783       (while (mime-editor/process-multipart-1
1784               (format "%s-%d" boundary i))
1785         (setq i (1+ i))
1786         )
1787       (save-restriction
1788         ;; We are interested in message body.
1789         (let* ((beg
1790                 (progn
1791                   (goto-char (point-min))
1792                   (re-search-forward
1793                    (concat "\n" (regexp-quote mail-header-separator)
1794                            (if mime-ignore-preceding-spaces
1795                                "[ \t\n]*\n" "\n")) nil 'move)
1796                   (point)))
1797                (end
1798                 (progn
1799                   (goto-char (point-max))
1800                   (and mime-ignore-trailing-spaces
1801                        (re-search-backward "[^ \t\n]\n" beg t)
1802                        (forward-char 1))
1803                   (point))))
1804           (setq ret (mime-editor/translate-region
1805                      beg end
1806                      (format "%s-%d" boundary i)))
1807           ))
1808       (let ((contype (car ret))         ;Content-Type
1809             (encoding (nth 1 ret))      ;Content-Transfer-Encoding
1810             )
1811         ;; Make primary MIME headers.
1812         (or (mail-position-on-field "Mime-Version")
1813             (insert mime-editor/mime-version-value))
1814         ;; Remove old Content-Type and other fields.
1815         (save-restriction
1816           (goto-char (point-min))
1817           (search-forward (concat "\n" mail-header-separator "\n") nil t)
1818           (narrow-to-region (point-min) (point))
1819           (goto-char (point-min))
1820           (mime-delete-field "Content-Type")
1821           (mime-delete-field "Content-Transfer-Encoding"))
1822         ;; Then, insert Content-Type and Content-Transfer-Encoding fields.
1823         (mail-position-on-field "Content-Type")
1824         (insert contype)
1825         (if encoding
1826             (progn
1827               (mail-position-on-field "Content-Transfer-Encoding")
1828               (insert encoding)))
1829         ))))
1830
1831 (defun mime-editor/translate-region (beg end &optional boundary multipart)
1832   (if (null boundary)
1833       (setq boundary
1834             (concat mime-multipart-boundary "_"
1835                     (replace-space-with-underline (current-time-string))))
1836     )
1837   (save-excursion
1838     (save-restriction
1839       (narrow-to-region beg end)
1840       (let ((tag nil)                   ;MIME tag
1841             (contype nil)               ;Content-Type
1842             (encoding nil)              ;Content-Transfer-Encoding
1843             (nparts 0))                 ;Number of body parts
1844         ;; Normalize the body part by inserting appropriate message
1845         ;; tags for every message contents.
1846         (mime-editor/normalize-body)
1847         ;; Counting the number of Content-Type.
1848         (goto-char (point-min))
1849         (while (re-search-forward mime-editor/single-part-tag-regexp nil t)
1850           (setq nparts (1+ nparts)))
1851         ;; Begin translation.
1852         (cond ((and (<= nparts 1)(not multipart))
1853                ;; It's a singular message.
1854                (goto-char (point-min))
1855                (while (re-search-forward
1856                        mime-editor/single-part-tag-regexp nil t)
1857                  (setq tag
1858                        (buffer-substring (match-beginning 0) (match-end 0)))
1859                  (delete-region (match-beginning 0) (1+ (match-end 0)))
1860                  (setq contype (mime-editor/get-contype tag))
1861                  (setq encoding (mime-editor/get-encoding tag))
1862                  ))
1863               (t
1864                ;; It's a multipart message.
1865                (goto-char (point-min))
1866                (while (re-search-forward
1867                        mime-editor/single-part-tag-regexp nil t)
1868                  (setq tag
1869                        (buffer-substring (match-beginning 0) (match-end 0)))
1870                  (delete-region (match-beginning 0) (match-end 0))
1871                  (setq contype (mime-editor/get-contype tag))
1872                  (setq encoding (mime-editor/get-encoding tag))
1873                  (insert "--" boundary "\n")
1874                  (insert "Content-Type: " contype "\n")
1875                  (if encoding
1876                      (insert "Content-Transfer-Encoding: " encoding "\n"))
1877                  )
1878                ;; Define Content-Type as "multipart/mixed".
1879                (setq contype
1880                      (concat "multipart/mixed;\n boundary=\"" boundary "\""))
1881                ;; Content-Transfer-Encoding must be "7bit".
1882                ;; The following encoding can be `nil', but is
1883                ;; specified as is since there is no way that a user
1884                ;; specifies it.
1885                (setq encoding "7bit")
1886                ;; Insert the trailer.
1887                (goto-char (point-max))
1888                (if multipart
1889                    (insert "--" boundary "--\n")
1890                  (insert "\n--" boundary "--\n")
1891                  )))
1892         (list contype encoding boundary nparts)
1893         ))))
1894
1895 (defun mime-editor/normalize-body ()
1896   "Normalize the body part by inserting appropriate message tags."
1897   ;; Insert the first MIME tags if necessary.
1898   (goto-char (point-min))
1899   (if (not (looking-at mime-editor/single-part-tag-regexp))
1900       (insert (mime-make-text-tag) "\n"))
1901   ;; Check each tag, and add new tag or correct it if necessary.
1902   (goto-char (point-min))
1903   (while (re-search-forward mime-editor/single-part-tag-regexp nil t)
1904     (let* ((tag (buffer-substring (match-beginning 0) (match-end 0)))
1905            (contype (mime-editor/get-contype tag))
1906            (charset (mime-get-parameter contype "charset"))
1907            (encoding (mime-editor/get-encoding tag)))
1908       ;; Remove extra whitespaces after the tag.
1909       (if (looking-at "[ \t]+$")
1910           (delete-region (match-beginning 0) (match-end 0)))
1911       (cond
1912        ((= (following-char) ?\^M)
1913         ;; It must be image, audio or video.
1914         (let ((beg (point))
1915               (end (mime-editor/content-end)))
1916           ;; Insert explicit MIME tags after hidden messages.
1917           (forward-line 1)
1918           (if (and (not (eobp))
1919                    (not (looking-at mime-editor/single-part-tag-regexp)))
1920               (progn
1921                 (insert (mime-make-text-tag) "\n")
1922                 (forward-line -1)       ;Process it again as text.
1923                 ))
1924           ;; Show a hidden message.  The point is not altered
1925           ;; after the conversion.
1926           (mime-flag-region beg end ?\n)
1927           ))
1928        ((mime-test-content-type contype "message")
1929         ;; Content-type "message" should be sent as is.
1930         (forward-line 1)
1931         )
1932        ((mime-test-content-type contype "text")
1933         ;; Define charset for text if necessary.
1934         (setq charset (or charset (mime-editor/choose-charset)))
1935         (mime-editor/define-charset charset)
1936         (cond ((string-equal contype "text/x-rot13-47")
1937                (save-excursion
1938                  (forward-line)
1939                  (set-mark (point))
1940                  (goto-char (mime-editor/content-end))
1941                  (tm:caesar-region)
1942                  ))
1943               ((string-equal contype "text/enriched")
1944                (save-excursion
1945                  (let ((beg (progn
1946                               (forward-line)
1947                               (point)))
1948                        (end (mime-editor/content-end))
1949                        )
1950                    (enriched-encode beg end)
1951                    (goto-char beg)
1952                    (if (search-forward "\n\n")
1953                        (delete-region beg (match-end 0))
1954                      )
1955                    ))))
1956         ;; Point is now on current tag.
1957         ;; Define encoding and encode text if necessary.
1958         (or encoding    ;Encoding is not specified.
1959             (let* ((encoding
1960                     (cdr
1961                      (assoc charset
1962                             mime-editor/charset-default-encoding-alist)
1963                      ))
1964                    (beg (mime-editor/content-beginning))
1965                    )
1966               (mime-charset-encode-region beg (mime-editor/content-end)
1967                                           charset)
1968               (mime-encode-region beg (mime-editor/content-end) encoding)
1969               (mime-editor/define-encoding encoding)
1970               ))
1971         (forward-line 1)
1972         )
1973        ((null encoding)         ;Encoding is not specified.
1974         ;; Application, image, audio, video, and any other
1975         ;; unknown content-type without encoding should be
1976         ;; encoded.
1977         (let* ((encoding "base64")      ;Encode in BASE64 by default.
1978                (beg (mime-editor/content-beginning))
1979                (end (mime-editor/content-end))
1980                (body (buffer-substring beg end))
1981                )
1982           (mime-encode-region beg end encoding)
1983           (mime-editor/define-encoding encoding))
1984         (forward-line 1)
1985         )
1986        )
1987       )))
1988
1989 (defun mime-delete-field (field)
1990   "Delete header FIELD."
1991   (let ((regexp (format "^%s:[ \t]*" field)))
1992     (goto-char (point-min))
1993     (while (re-search-forward regexp nil t)
1994       (delete-region (match-beginning 0)
1995                      (progn (forward-line 1) (point)))
1996       )))
1997
1998 \f
1999 ;;;
2000 ;;; Platform dependent functions
2001 ;;;
2002
2003 ;; Sun implementations
2004
2005 (defun mime-voice-recorder-for-sun ()
2006   "Record voice in a buffer using Sun audio device, and return the buffer.
2007 If the environment variable AUDIOHOST is defined, its value is used as
2008 a recording host instead of local host."
2009   (let ((buffer (get-buffer-create " *MIME audio*"))
2010         (host (getenv "AUDIOHOST")))
2011     (message "Start the recording on %s.  Type C-g to finish the recording..."
2012              (or host (system-name)))
2013     (save-excursion
2014       (set-buffer buffer)
2015       (erase-buffer)
2016       (condition-case errorcode
2017           (let ((selective-display nil) ;Disable ^M to nl translation.
2018                 (mc-flag nil)           ;Mule
2019                 (kanji-flag nil))       ;NEmacs
2020             ;; If AUDIOHOST is defined, use the value as recording host.
2021             (cond ((not (null host))
2022                    ;; Disable automatic conversion of coding system if Mule.
2023                    (if (featurep 'mule)
2024                        (define-program-coding-system nil "rsh" *noconv*))
2025                    (call-process "rsh"
2026                                  nil
2027                                  buffer
2028                                  nil
2029                                  host
2030                                  "cat"
2031                                  "/dev/audio"
2032                                  ))
2033                   (t
2034                    ;; Disable automatic conversion of coding system if Mule.
2035                    (if (featurep 'mule)
2036                        (define-program-coding-system nil "cat" *noconv*))
2037                    (call-process "cat"
2038                                  "/dev/audio"
2039                                  buffer
2040                                  nil
2041                                  ))))
2042         (quit (message "Type C-g to finish recording... done.")
2043               buffer                    ;Return the buffer
2044               )))))
2045
2046 \f
2047 ;;; @ Other useful commands.
2048 ;;;
2049
2050 ;; Message forwarding commands as content-type "message/rfc822".
2051
2052 (defun mime-editor/insert-message (&optional message)
2053   (interactive)
2054   (let ((inserter (assoc-value major-mode mime-editor/message-inserter-alist)))
2055     (if (and inserter (fboundp inserter))
2056         (progn
2057           (mime-editor/insert-tag "message" "rfc822")
2058           (funcall inserter message)
2059           )
2060       (message "Sorry, I don't have message inserter for your MUA.")
2061       )))
2062
2063 (defun mime-editor/insert-mail (&optional message)
2064   (interactive)
2065   (let ((inserter (assoc-value major-mode mime-editor/mail-inserter-alist)))
2066     (if (and inserter (fboundp inserter))
2067         (progn
2068           (mime-editor/insert-tag "message" "rfc822")
2069           (funcall inserter message)
2070           )
2071       (message "Sorry, I don't have mail inserter for your MUA.")
2072       )))
2073
2074 (defun mime-editor/inserted-message-filter ()
2075   (save-excursion
2076     (save-restriction
2077       (let ((header-start (point))
2078             (case-fold-search t)
2079             beg end)
2080         ;; for Emacs 18
2081         ;; (if (re-search-forward "^$" (marker-position (mark-marker)))
2082         (if (re-search-forward "^$" (mark t))
2083             (narrow-to-region header-start (match-beginning 0))
2084           )
2085         (goto-char header-start)
2086         (while (and (re-search-forward
2087                      mime-editor/yank-ignored-field-regexp nil t)
2088                     (setq beg (match-beginning 0))
2089                     (setq end (1+ (rfc822/field-end)))
2090                     )
2091           (delete-region beg end)
2092           )
2093         ))))
2094
2095
2096 ;;; @ multipart enclosure
2097 ;;;
2098
2099 (defun mime-editor/enclose-region (type beg end)
2100   (save-excursion
2101     (goto-char beg)
2102     (let ((current (point))
2103           exist-prev-tag)
2104       (save-excursion
2105         (if (mime-editor/goto-tag)
2106             (or (eq current (match-beginning 0))
2107                 (setq exist-prev-tag t)
2108                 )))
2109       (save-restriction
2110         (narrow-to-region beg end)
2111         (goto-char beg)
2112         (if exist-prev-tag
2113             (insert "\n")
2114           )
2115         (insert (format "--<<%s>>-{\n" type))
2116         (goto-char (point-max))
2117         (insert (format "\n--}-<<%s>>\n" type))
2118         (goto-char (point-max))
2119         )
2120       (if (and (not (looking-at mime-editor/single-part-tag-regexp))
2121                (not (eobp)))
2122           (insert (mime-make-text-tag) "\n")
2123         )
2124       )))
2125
2126 (defun mime-editor/enclose-mixed-region (beg end)
2127   (interactive "*r")
2128   (mime-editor/enclose-region "mixed" beg end)
2129   )
2130
2131 (defun mime-editor/enclose-parallel-region (beg end)
2132   (interactive "*r")
2133   (mime-editor/enclose-region "parallel" beg end)
2134   )
2135
2136 (defun mime-editor/enclose-digest-region (beg end)
2137   (interactive "*r")
2138   (mime-editor/enclose-region "digest" beg end)
2139   )
2140
2141 (defun mime-editor/enclose-alternative-region (beg end)
2142   (interactive "*r")
2143   (mime-editor/enclose-region "alternative" beg end)
2144   )
2145
2146 (defun mime-editor/enclose-signed-region (beg end)
2147   (interactive "*r")
2148   (if mime-editor/signing-type
2149       (mime-editor/enclose-region "signed" beg end)
2150     (message "Please specify signing type.")
2151     ))
2152
2153 (defun mime-editor/enclose-encrypted-region (beg end)
2154   (interactive "*r")
2155   (if mime-editor/signing-type
2156       (mime-editor/enclose-region "encrypted" beg end)
2157     (message "Please specify encrypting type.")
2158     ))
2159
2160 (defun mime-editor/insert-key (&optional arg)
2161   "Insert a pgp public key."
2162   (interactive "P")
2163   (mime-editor/insert-tag "application" "pgp-keys")
2164   (mime-editor/define-encoding "7bit")
2165   (mc-insert-public-key)
2166   )
2167
2168
2169 ;;; @ flag setting
2170 ;;;
2171
2172 (defun mime-editor/set-split (arg)
2173   (interactive
2174    (list
2175     (y-or-n-p "Do you want to enable split?")
2176     ))
2177   (setq mime-editor/split-message arg)
2178   (if arg
2179       (message "This message is enabled to split.")
2180     (message "This message is not enabled to split.")
2181     ))
2182
2183 (defun mime-editor/toggle-transfer-level (&optional transfer-level)
2184   "Toggle transfer-level is 7bit or 8bit through.
2185
2186 Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8."
2187   (interactive)
2188   (if (numberp transfer-level)
2189       (setq mime-editor/transfer-level transfer-level)
2190     (if (< mime-editor/transfer-level 8)
2191         (setq mime-editor/transfer-level 8)
2192       (setq mime-editor/transfer-level 7)
2193       ))
2194   (setq mime-editor/charset-default-encoding-alist
2195         (mime/make-charset-default-encoding-alist
2196          mime-editor/transfer-level))
2197   (message (format "Current transfer-level is %d bit"
2198                    mime-editor/transfer-level))
2199   (setq mime-editor/transfer-level-string
2200         (mime/encoding-name mime-editor/transfer-level 'not-omit))
2201   (force-mode-line-update)
2202   )
2203
2204
2205 ;;; @ pgp
2206 ;;;
2207
2208 (defun mime-editor/set-sign (arg)
2209   (interactive
2210    (list
2211     (y-or-n-p "Do you want to sign?")
2212     ))
2213   (if arg
2214       (if mime-editor/signing-type
2215           (progn
2216             (setq mime-editor/pgp-processing 'sign)
2217             (message "This message will be signed.")
2218             )
2219         (message "Please specify signing type.")
2220         )
2221     (if (eq mime-editor/pgp-processing 'sign)
2222         (setq mime-editor/pgp-processing nil)
2223       )
2224     (message "This message will not be signed.")
2225     ))
2226
2227 (defun mime-editor/set-encrypt (arg)
2228   (interactive
2229    (list
2230     (y-or-n-p "Do you want to encrypt?")
2231     ))
2232   (if arg
2233       (if mime-editor/encrypting-type
2234           (progn
2235             (setq mime-editor/pgp-processing 'encrypt)
2236             (message "This message will be encrypt.")
2237             )
2238         (message "Please specify encrypting type.")
2239         )
2240     (if (eq mime-editor/pgp-processing 'encrypt)
2241         (setq mime-editor/pgp-processing nil)
2242       )
2243     (message "This message will not be encrypt.")
2244     ))
2245
2246 (defvar mime-editor/pgp-processing nil)
2247 (make-variable-buffer-local 'mime-editor/pgp-processing)
2248
2249 (defun mime-editor/pgp-enclose-buffer ()
2250   (let ((beg (save-excursion
2251                (goto-char (point-min))
2252                (if (search-forward (concat "\n" mail-header-separator "\n"))
2253                    (match-end 0)
2254                  )))
2255         (end (point-max))
2256         )
2257     (if beg
2258         (cond ((eq mime-editor/pgp-processing 'sign)
2259                (mime-editor/enclose-signed-region beg end)
2260                )
2261               ((eq mime-editor/pgp-processing 'encrypt)
2262                (mime-editor/enclose-encrypted-region beg end)
2263                ))
2264       )))
2265
2266
2267 ;;; @ split
2268 ;;;
2269
2270 (defun mime-editor/insert-partial-header
2271   (fields subject id number total separator)
2272   (insert fields)
2273   (insert (format "Subject: %s (%d/%d)\n" subject number total))
2274   (insert (format "Mime-Version: 1.0 (split by tm-edit %s)\n"
2275                   mime-editor/version))
2276   (insert (format "\
2277 Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n"
2278                   id number total separator))
2279   )
2280
2281 (defun mime-editor/split-and-send
2282   (&optional cmd lines mime-editor/message-max-length)
2283   (interactive)
2284   (or lines
2285       (setq lines
2286             (count-lines (point-min) (point-max)))
2287       )
2288   (or mime-editor/message-max-length
2289       (setq mime-editor/message-max-length
2290             (or (cdr (assq major-mode mime-editor/message-max-length-alist))
2291                 mime-editor/message-default-max-length))
2292       )
2293   (let* ((mime-editor/draft-file-name
2294           (or (buffer-file-name)
2295               (make-temp-name
2296                (expand-file-name "tm-draft" mime/tmp-dir))))
2297          (separator mail-header-separator)
2298          (id (concat "\""
2299                      (replace-space-with-underline (current-time-string))
2300                      "@" (system-name) "\"")))
2301     (run-hooks 'mime-editor/before-split-hook)
2302     (let ((the-buf (current-buffer))
2303           (copy-buf (get-buffer-create " *Original Message*"))
2304           (header (rfc822/get-header-string-except
2305                    mime-editor/split-ignored-field-regexp separator))
2306           (subject (mail-fetch-field "subject"))
2307           (total (+ (/ lines mime-editor/message-max-length)
2308                     (if (> (mod lines mime-editor/message-max-length) 0)
2309                         1)))
2310           (command
2311            (or cmd
2312                (cdr
2313                 (assq major-mode
2314                       mime-editor/split-message-sender-alist))
2315                ))
2316           (mime-editor/partial-number 1)
2317           data)
2318       (save-excursion
2319         (set-buffer copy-buf)
2320         (erase-buffer)
2321         (insert-buffer the-buf)
2322         (save-restriction
2323           (if (re-search-forward
2324                (concat "^" (regexp-quote separator) "$") nil t)
2325               (let ((he (match-beginning 0)))
2326                 (replace-match "")
2327                 (narrow-to-region (point-min) he)
2328                 ))
2329           (goto-char (point-min))
2330           (while (re-search-forward mime-editor/split-blind-field-regexp nil t)
2331             (delete-region (match-beginning 0)
2332                            (1+ (rfc822/field-end)))
2333             )))
2334       (while (< mime-editor/partial-number total)
2335         (erase-buffer)
2336         (save-excursion
2337           (set-buffer copy-buf)
2338           (setq data (buffer-substring
2339                       (point-min)
2340                       (progn
2341                         (goto-line mime-editor/message-max-length)
2342                         (point))
2343                       ))
2344           (delete-region (point-min)(point))
2345           )
2346         (mime-editor/insert-partial-header
2347          header subject id mime-editor/partial-number total separator)
2348         (insert data)
2349         (save-excursion
2350           (message (format "Sending %d/%d..."
2351                            mime-editor/partial-number total))
2352           (call-interactively command)
2353           (message (format "Sending %d/%d... done"
2354                            mime-editor/partial-number total))
2355           )
2356         (setq mime-editor/partial-number
2357               (1+ mime-editor/partial-number))
2358         )
2359       (erase-buffer)
2360       (save-excursion
2361         (set-buffer copy-buf)
2362         (setq data (buffer-string))
2363         (erase-buffer)
2364         )
2365       (mime-editor/insert-partial-header
2366        header subject id mime-editor/partial-number total separator)
2367       (insert data)
2368       (save-excursion
2369         (message (format "Sending %d/%d..."
2370                          mime-editor/partial-number total))
2371         (message (format "Sending %d/%d... done"
2372                          mime-editor/partial-number total))
2373         )
2374       )))
2375
2376 (defun mime-editor/maybe-split-and-send (&optional cmd)
2377   (interactive)
2378   (run-hooks 'mime-editor/before-send-hook)
2379   (let ((mime-editor/message-max-length
2380          (or (cdr (assq major-mode mime-editor/message-max-length-alist))
2381              mime-editor/message-default-max-length))
2382         (lines (count-lines (point-min) (point-max)))
2383         )
2384     (if (and (> lines mime-editor/message-max-length)
2385              mime-editor/split-message)
2386         (mime-editor/split-and-send cmd lines mime-editor/message-max-length)
2387       )))
2388
2389
2390 ;;; @ preview message
2391 ;;;
2392
2393 (defun mime-editor/preview-message ()
2394   "preview editing MIME message. [tm-edit.el]"
2395   (interactive)
2396   (let* ((str (buffer-string))
2397          (separator mail-header-separator)
2398          (the-buf (current-buffer))
2399          (buf-name (buffer-name))
2400          (temp-buf-name (concat "*temp-article:" buf-name "*"))
2401          (buf (get-buffer temp-buf-name))
2402          )
2403     (if buf
2404         (progn
2405           (switch-to-buffer buf)
2406           (erase-buffer)
2407           )
2408       (setq buf (get-buffer-create temp-buf-name))
2409       (switch-to-buffer buf)
2410       )
2411     (insert str)
2412     (setq major-mode 'mime/temporary-message-mode)
2413     (make-local-variable 'mail-header-separator)
2414     (setq mail-header-separator separator)
2415     (make-local-variable 'mime/editing-buffer)
2416     (setq mime/editing-buffer the-buf)
2417
2418     (run-hooks 'mime-editor/translate-hook)
2419     (mime-editor/translate-buffer)
2420     (goto-char (point-min))
2421     (if (re-search-forward
2422          (concat "^" (regexp-quote separator) "$"))
2423         (replace-match "")
2424       )
2425     (mime/viewer-mode)
2426     ))
2427
2428 (defun mime-editor/quitting-method ()
2429   (let ((temp mime::preview/article-buffer)
2430         buf)
2431     (mime-viewer/kill-buffer)
2432     (set-buffer temp)
2433     (setq buf mime/editing-buffer)
2434     (kill-buffer temp)
2435     (switch-to-buffer buf)
2436     ))
2437
2438 (set-alist 'mime-viewer/quitting-method-alist
2439            'mime/temporary-message-mode
2440            (function mime-editor/quitting-method)
2441            )
2442
2443
2444 ;;; @ draft preview
2445 ;;;
2446 ;; by "OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
2447 ;;       Mon, 10 Apr 1995 20:03:07 +0900
2448
2449 (defvar mime-editor/draft-header-separator-alist
2450   '((news-reply-mode . mail-header-separator)
2451     (mh-letter-mode . mail-header-separator)
2452     ))
2453
2454 (defvar mime::article/draft-header-separator nil)
2455
2456 (defun mime-editor/draft-preview ()
2457   (interactive)
2458   (let ((sep (cdr (assq major-mode mime-editor/draft-header-separator-alist))))
2459     (or (stringp sep) (setq sep (eval sep)))
2460     (make-variable-buffer-local 'mime::article/draft-header-separator)
2461     (goto-char (point-min))
2462     (re-search-forward
2463      (concat "^\\(" (regexp-quote sep) "\\)?$"))
2464     (setq mime::article/draft-header-separator
2465           (buffer-substring (match-beginning 0) (match-end 0)))
2466     (replace-match "")
2467     (mime/viewer-mode (current-buffer))
2468     (pop-to-buffer (current-buffer))
2469     ))
2470
2471 (defun mime-viewer::quitting-method/draft-preview ()
2472   (let ((mother mime::preview/mother-buffer))
2473     (save-excursion
2474       (switch-to-buffer mother)
2475       (goto-char (point-min))
2476       (if (and
2477            (re-search-forward
2478             (concat "^\\("
2479                     (regexp-quote mime::article/draft-header-separator)
2480                     "\\)?$") nil t)
2481            (bolp))
2482           (progn
2483             (insert mime::article/draft-header-separator)
2484             (set-buffer-modified-p (buffer-modified-p))
2485             )))
2486     (mime-viewer/kill-buffer)
2487     (pop-to-buffer mother)
2488     ))
2489
2490 (set-alist 'mime-viewer/quitting-method-alist
2491            'mh-letter-mode
2492            (function mime-viewer::quitting-method/draft-preview)
2493            )
2494
2495 (set-alist 'mime-viewer/quitting-method-alist
2496            'news-reply-mode
2497            (function mime-viewer::quitting-method/draft-preview)
2498            )
2499
2500
2501 ;;; @ edit again
2502 ;;;
2503
2504 (defun mime-editor::edit-again (code-conversion)
2505   (save-excursion
2506     (goto-char (point-min))
2507     (let ((ctl (mime/Content-Type)))
2508       (if ctl
2509           (let ((ctype (car ctl))
2510                 (params (cdr ctl))
2511                 type stype)
2512             (if (string-match "/" ctype)
2513                 (progn
2514                   (setq type (substring ctype 0 (match-beginning 0)))
2515                   (setq stype (substring ctype (match-end 0)))
2516                   )
2517               (setq type ctype)
2518               )
2519             (cond
2520              ((string-equal type "multipart")
2521               (let ((boundary (assoc-value "boundary" params)))
2522                 (re-search-forward (concat "\n--" boundary) nil t)
2523                 (let ((bb (match-beginning 0)) eb tag)
2524                   (setq tag (format "\n--<<%s>>-{" stype))
2525                   (goto-char bb)
2526                   (insert tag)
2527                   (setq bb (+ bb (length tag)))
2528                   (re-search-forward (concat "\n--" boundary "--") nil t)
2529                   (setq eb (match-beginning 0))
2530                   (replace-match (format "\n--}-<<%s>>" stype))
2531                   (save-restriction
2532                     (narrow-to-region bb eb)
2533                     (goto-char (point-min))
2534                     (while (re-search-forward
2535                             (concat "\n--" boundary "\n") nil t)
2536                       (let ((beg (match-beginning 0))
2537                             end)
2538                         (delete-region beg (match-end 0))
2539                         (save-excursion
2540                           (if (re-search-forward
2541                                (concat "\n--" boundary) nil t)
2542                               (setq end (match-beginning 0))
2543                             (setq end (point-max))
2544                             )
2545                           (save-restriction
2546                             (narrow-to-region beg end)
2547                             (mime-editor::edit-again code-conversion)
2548                             (goto-char (point-max))
2549                             ))))
2550                     ))
2551                 (goto-char (point-min))
2552                 (or (= (point-min) 1)
2553                     (delete-region (point-min)
2554                                    (if (re-search-forward "^$" nil t)
2555                                        (match-end 0)
2556                                      (point-min)
2557                                      )))
2558                 ))
2559              (t
2560               (let* (charset
2561                      (pstr
2562                       (mapconcat (function
2563                                   (lambda (attr)
2564                                     (if (string-equal (car attr)
2565                                                       "charset")
2566                                         (progn
2567                                           (setq charset (cdr attr))
2568                                           "")
2569                                       (concat ";" (car attr)
2570                                               "=" (cdr attr))
2571                                       )
2572                                     ))
2573                                  params ""))
2574                      encoding
2575                      encoded)
2576                 (save-excursion
2577                   (if (re-search-forward
2578                        "Content-Transfer-Encoding:" nil t)
2579                       (let ((beg (match-beginning 0))
2580                             (hbeg (match-end 0))
2581                             (end (rfc822/field-end)))
2582                         (setq encoding
2583                               (eliminate-top-spaces
2584                                (rfc822/unfolding-string
2585                                 (buffer-substring hbeg end))))
2586                         (if (or charset (string-equal type "text"))
2587                             (progn
2588                               (delete-region beg (1+ end))
2589                               (goto-char (point-min))
2590                               (if (search-forward "\n\n" nil t)
2591                                   (progn
2592                                     (mime-decode-region
2593                                      (match-end 0)(point-max) encoding)
2594                                     (setq encoded t
2595                                           encoding nil)
2596                                     )))))))
2597                 (if (or code-conversion encoded)
2598                     (if charset
2599                         (mime-charset-decode-region (point-min)(point-max)
2600                                                     charset)
2601                       (character-decode-region (point-min)(point-max)
2602                                                mime/default-coding-system)
2603                       ))
2604                 (let ((he
2605                        (if (re-search-forward "^$" nil t)
2606                            (match-end 0)
2607                          (point-min)
2608                          )))
2609                   (if (= (point-min) 1)
2610                       (progn
2611                         (goto-char he)
2612                         (insert
2613                          (concat
2614                           "\n"
2615                           (mime-create-tag
2616                            (concat type "/" stype pstr) encoding)
2617                           ))
2618                         )
2619                     (delete-region (point-min) he)
2620                     (insert
2621                      (concat "\n"
2622                              (mime-create-tag
2623                               (concat type "/" stype pstr) encoding)
2624                              ))
2625                     ))
2626                 ))))
2627         (if code-conversion
2628             (character-decode-region (point-min) (point-max)
2629                                      mime/default-coding-system)
2630           )
2631         ))))
2632
2633 (defun mime/edit-again (&optional code-conversion no-separator no-mode)
2634   (interactive)
2635   (mime-editor::edit-again code-conversion)
2636   (goto-char (point-min))
2637   (save-restriction
2638     (narrow-to-region (point-min)
2639                       (if (re-search-forward "^$" nil t)
2640                           (match-end 0)
2641                         (point-max)
2642                         ))
2643     (goto-char (point-min))
2644     (while (re-search-forward
2645             "^\\(Content-.*\\|Mime-Version\\):" nil t)
2646       (delete-region (match-beginning 0) (1+ (rfc822/field-end)))
2647       ))
2648   (or no-separator
2649       (and (re-search-forward "^$")
2650            (replace-match mail-header-separator)
2651            ))
2652   (or no-mode
2653       (mime/editor-mode)
2654       ))
2655
2656
2657 ;;; @ end
2658 ;;;
2659
2660 (provide 'tm-edit)
2661
2662 (run-hooks 'tm-edit-load-hook)
2663
2664 ;;; tm-edit.el ends here