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.69 $
  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.69 1996/06/27 14:22:59 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 (as-binary-process (mc-pgp-sign-region beg (point-max)))
1704             (throw 'mime-editor/error 'pgp-error)
1705             )
1706         (goto-char beg)
1707         (insert
1708          "--[[application/pgp; format=mime][7bit]]\n")
1709         ))
1710     ))
1711
1712 (defun mime-editor/encrypt-pgp-kazu (beg end boundary)
1713   (save-excursion
1714     (let ((from (rfc822/get-field-body "From"))
1715           (to (rfc822/get-field-body "To"))
1716           (cc (rfc822/get-field-body "cc"))
1717           recipients)
1718       (save-restriction
1719         (narrow-to-region beg end)
1720         (let* ((ret
1721                 (mime-editor/translate-region beg end boundary))
1722                (ctype    (car ret))
1723                (encoding (nth 1 ret))
1724                (parts    (nth 3 ret))
1725                )
1726           (goto-char beg)
1727           (if (and (stringp from)
1728                    (not (string-equal from "")))
1729               (insert (format "From: %s\n" from))
1730             )
1731           (if (and (stringp to)
1732                    (not (string-equal to "")))
1733               (progn
1734                 (insert (format "To: %s\n" to))
1735                 (setq recipients to)
1736                 ))
1737           (if (and (stringp cc)
1738                    (not (string-equal cc "")))
1739               (progn
1740                 (insert (format "cc: %s\n" cc))
1741                 (if recipients
1742                     (setq recipients (concat recipients "," cc))
1743                   (setq recipients cc)
1744                   )))
1745           (insert (format "Content-Type: %s\n" ctype))
1746           (if encoding
1747               (insert (format "Content-Transfer-Encoding: %s\n" encoding))
1748             )
1749           (insert "\n")
1750           (or (as-binary-process
1751                (mc-pgp-encrypt-region
1752                 (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" recipients)
1753                 beg (point-max))
1754                )
1755               (throw 'mime-editor/error 'pgp-error)
1756               )
1757           (goto-char beg)
1758           (insert
1759            "--[[application/pgp; format=mime][7bit]]\n")
1760           ))
1761       )))
1762
1763 (defun mime-editor/translate-body ()
1764   "Encode the tagged MIME body in current buffer in MIME compliant message."
1765   (interactive)
1766   (save-excursion
1767     (let ((boundary
1768            (concat mime-multipart-boundary "_"
1769                    (replace-space-with-underline (current-time-string))
1770                    ))
1771           (i 1)
1772           ret)
1773       (while (mime-editor/process-multipart-1
1774               (format "%s-%d" boundary i))
1775         (setq i (1+ i))
1776         )
1777       (save-restriction
1778         ;; We are interested in message body.
1779         (let* ((beg
1780                 (progn
1781                   (goto-char (point-min))
1782                   (re-search-forward
1783                    (concat "\n" (regexp-quote mail-header-separator)
1784                            (if mime-ignore-preceding-spaces
1785                                "[ \t\n]*\n" "\n")) nil 'move)
1786                   (point)))
1787                (end
1788                 (progn
1789                   (goto-char (point-max))
1790                   (and mime-ignore-trailing-spaces
1791                        (re-search-backward "[^ \t\n]\n" beg t)
1792                        (forward-char 1))
1793                   (point))))
1794           (setq ret (mime-editor/translate-region
1795                      beg end
1796                      (format "%s-%d" boundary i)))
1797           ))
1798       (let ((contype (car ret))         ;Content-Type
1799             (encoding (nth 1 ret))      ;Content-Transfer-Encoding
1800             )
1801         ;; Make primary MIME headers.
1802         (or (mail-position-on-field "Mime-Version")
1803             (insert mime-editor/mime-version-value))
1804         ;; Remove old Content-Type and other fields.
1805         (save-restriction
1806           (goto-char (point-min))
1807           (search-forward (concat "\n" mail-header-separator "\n") nil t)
1808           (narrow-to-region (point-min) (point))
1809           (goto-char (point-min))
1810           (mime-delete-field "Content-Type")
1811           (mime-delete-field "Content-Transfer-Encoding"))
1812         ;; Then, insert Content-Type and Content-Transfer-Encoding fields.
1813         (mail-position-on-field "Content-Type")
1814         (insert contype)
1815         (if encoding
1816             (progn
1817               (mail-position-on-field "Content-Transfer-Encoding")
1818               (insert encoding)))
1819         ))))
1820
1821 (defun mime-editor/translate-region (beg end &optional boundary multipart)
1822   (if (null boundary)
1823       (setq boundary
1824             (concat mime-multipart-boundary "_"
1825                     (replace-space-with-underline (current-time-string))))
1826     )
1827   (save-excursion
1828     (save-restriction
1829       (narrow-to-region beg end)
1830       (let ((tag nil)                   ;MIME tag
1831             (contype nil)               ;Content-Type
1832             (encoding nil)              ;Content-Transfer-Encoding
1833             (nparts 0))                 ;Number of body parts
1834         ;; Normalize the body part by inserting appropriate message
1835         ;; tags for every message contents.
1836         (mime-editor/normalize-body)
1837         ;; Counting the number of Content-Type.
1838         (goto-char (point-min))
1839         (while (re-search-forward mime-editor/single-part-tag-regexp nil t)
1840           (setq nparts (1+ nparts)))
1841         ;; Begin translation.
1842         (cond ((and (<= nparts 1)(not multipart))
1843                ;; It's a singular message.
1844                (goto-char (point-min))
1845                (while (re-search-forward
1846                        mime-editor/single-part-tag-regexp nil t)
1847                  (setq tag
1848                        (buffer-substring (match-beginning 0) (match-end 0)))
1849                  (delete-region (match-beginning 0) (1+ (match-end 0)))
1850                  (setq contype (mime-editor/get-contype tag))
1851                  (setq encoding (mime-editor/get-encoding tag))
1852                  ))
1853               (t
1854                ;; It's a multipart message.
1855                (goto-char (point-min))
1856                (while (re-search-forward
1857                        mime-editor/single-part-tag-regexp nil t)
1858                  (setq tag
1859                        (buffer-substring (match-beginning 0) (match-end 0)))
1860                  (delete-region (match-beginning 0) (match-end 0))
1861                  (setq contype (mime-editor/get-contype tag))
1862                  (setq encoding (mime-editor/get-encoding tag))
1863                  (insert "--" boundary "\n")
1864                  (insert "Content-Type: " contype "\n")
1865                  (if encoding
1866                      (insert "Content-Transfer-Encoding: " encoding "\n"))
1867                  )
1868                ;; Define Content-Type as "multipart/mixed".
1869                (setq contype
1870                      (concat "multipart/mixed;\n boundary=\"" boundary "\""))
1871                ;; Content-Transfer-Encoding must be "7bit".
1872                ;; The following encoding can be `nil', but is
1873                ;; specified as is since there is no way that a user
1874                ;; specifies it.
1875                (setq encoding "7bit")
1876                ;; Insert the trailer.
1877                (goto-char (point-max))
1878                (if multipart
1879                    (insert "--" boundary "--\n")
1880                  (insert "\n--" boundary "--\n")
1881                  )))
1882         (list contype encoding boundary nparts)
1883         ))))
1884
1885 (defun mime-editor/normalize-body ()
1886   "Normalize the body part by inserting appropriate message tags."
1887   ;; Insert the first MIME tags if necessary.
1888   (goto-char (point-min))
1889   (if (not (looking-at mime-editor/single-part-tag-regexp))
1890       (insert (mime-make-text-tag) "\n"))
1891   ;; Check each tag, and add new tag or correct it if necessary.
1892   (goto-char (point-min))
1893   (while (re-search-forward mime-editor/single-part-tag-regexp nil t)
1894     (let* ((tag (buffer-substring (match-beginning 0) (match-end 0)))
1895            (contype (mime-editor/get-contype tag))
1896            (charset (mime-get-parameter contype "charset"))
1897            (encoding (mime-editor/get-encoding tag)))
1898       ;; Remove extra whitespaces after the tag.
1899       (if (looking-at "[ \t]+$")
1900           (delete-region (match-beginning 0) (match-end 0)))
1901       (cond
1902        ((= (following-char) ?\^M)
1903         ;; It must be image, audio or video.
1904         (let ((beg (point))
1905               (end (mime-editor/content-end)))
1906           ;; Insert explicit MIME tags after hidden messages.
1907           (forward-line 1)
1908           (if (and (not (eobp))
1909                    (not (looking-at mime-editor/single-part-tag-regexp)))
1910               (progn
1911                 (insert (mime-make-text-tag) "\n")
1912                 (forward-line -1)       ;Process it again as text.
1913                 ))
1914           ;; Show a hidden message.  The point is not altered
1915           ;; after the conversion.
1916           (mime-flag-region beg end ?\n)
1917           ))
1918        ((mime-test-content-type contype "message")
1919         ;; Content-type "message" should be sent as is.
1920         (forward-line 1)
1921         )
1922        ((mime-test-content-type contype "text")
1923         ;; Define charset for text if necessary.
1924         (setq charset (or charset (mime-editor/choose-charset)))
1925         (mime-editor/define-charset charset)
1926         (cond ((string-equal contype "text/x-rot13-47")
1927                (save-excursion
1928                  (forward-line)
1929                  (set-mark (point))
1930                  (goto-char (mime-editor/content-end))
1931                  (tm:caesar-region)
1932                  ))
1933               ((string-equal contype "text/enriched")
1934                (save-excursion
1935                  (let ((beg (progn
1936                               (forward-line)
1937                               (point)))
1938                        (end (mime-editor/content-end))
1939                        )
1940                    (enriched-encode beg end)
1941                    (goto-char beg)
1942                    (if (search-forward "\n\n")
1943                        (delete-region beg (match-end 0))
1944                      )
1945                    ))))
1946         ;; Point is now on current tag.
1947         ;; Define encoding and encode text if necessary.
1948         (or encoding    ;Encoding is not specified.
1949             (let* ((encoding
1950                     (cdr
1951                      (assoc charset
1952                             mime-editor/charset-default-encoding-alist)
1953                      ))
1954                    (beg (mime-editor/content-beginning))
1955                    )
1956               (mime-charset-encode-region beg (mime-editor/content-end)
1957                                           charset)
1958               (mime-encode-region beg (mime-editor/content-end) encoding)
1959               (mime-editor/define-encoding encoding)
1960               ))
1961         (forward-line 1)
1962         )
1963        ((null encoding)         ;Encoding is not specified.
1964         ;; Application, image, audio, video, and any other
1965         ;; unknown content-type without encoding should be
1966         ;; encoded.
1967         (let* ((encoding "base64")      ;Encode in BASE64 by default.
1968                (beg (mime-editor/content-beginning))
1969                (end (mime-editor/content-end))
1970                (body (buffer-substring beg end))
1971                )
1972           (mime-encode-region beg end encoding)
1973           (mime-editor/define-encoding encoding))
1974         (forward-line 1)
1975         )
1976        )
1977       )))
1978
1979 (defun mime-delete-field (field)
1980   "Delete header FIELD."
1981   (let ((regexp (format "^%s:[ \t]*" field)))
1982     (goto-char (point-min))
1983     (while (re-search-forward regexp nil t)
1984       (delete-region (match-beginning 0)
1985                      (progn (forward-line 1) (point)))
1986       )))
1987
1988 \f
1989 ;;;
1990 ;;; Platform dependent functions
1991 ;;;
1992
1993 ;; Sun implementations
1994
1995 (defun mime-voice-recorder-for-sun ()
1996   "Record voice in a buffer using Sun audio device, and return the buffer.
1997 If the environment variable AUDIOHOST is defined, its value is used as
1998 a recording host instead of local host."
1999   (let ((buffer (get-buffer-create " *MIME audio*"))
2000         (host (getenv "AUDIOHOST")))
2001     (message "Start the recording on %s.  Type C-g to finish the recording..."
2002              (or host (system-name)))
2003     (save-excursion
2004       (set-buffer buffer)
2005       (erase-buffer)
2006       (condition-case errorcode
2007           (let ((selective-display nil) ;Disable ^M to nl translation.
2008                 (mc-flag nil)           ;Mule
2009                 (kanji-flag nil))       ;NEmacs
2010             ;; If AUDIOHOST is defined, use the value as recording host.
2011             (cond ((not (null host))
2012                    ;; Disable automatic conversion of coding system if Mule.
2013                    (if (featurep 'mule)
2014                        (define-program-coding-system nil "rsh" *noconv*))
2015                    (call-process "rsh"
2016                                  nil
2017                                  buffer
2018                                  nil
2019                                  host
2020                                  "cat"
2021                                  "/dev/audio"
2022                                  ))
2023                   (t
2024                    ;; Disable automatic conversion of coding system if Mule.
2025                    (if (featurep 'mule)
2026                        (define-program-coding-system nil "cat" *noconv*))
2027                    (call-process "cat"
2028                                  "/dev/audio"
2029                                  buffer
2030                                  nil
2031                                  ))))
2032         (quit (message "Type C-g to finish recording... done.")
2033               buffer                    ;Return the buffer
2034               )))))
2035
2036 \f
2037 ;;; @ Other useful commands.
2038 ;;;
2039
2040 ;; Message forwarding commands as content-type "message/rfc822".
2041
2042 (defun mime-editor/insert-message (&optional message)
2043   (interactive)
2044   (let ((inserter (assoc-value major-mode mime-editor/message-inserter-alist)))
2045     (if (and inserter (fboundp inserter))
2046         (progn
2047           (mime-editor/insert-tag "message" "rfc822")
2048           (funcall inserter message)
2049           )
2050       (message "Sorry, I don't have message inserter for your MUA.")
2051       )))
2052
2053 (defun mime-editor/insert-mail (&optional message)
2054   (interactive)
2055   (let ((inserter (assoc-value major-mode mime-editor/mail-inserter-alist)))
2056     (if (and inserter (fboundp inserter))
2057         (progn
2058           (mime-editor/insert-tag "message" "rfc822")
2059           (funcall inserter message)
2060           )
2061       (message "Sorry, I don't have mail inserter for your MUA.")
2062       )))
2063
2064 (defun mime-editor/inserted-message-filter ()
2065   (save-excursion
2066     (save-restriction
2067       (let ((header-start (point))
2068             (case-fold-search t)
2069             beg end)
2070         ;; for Emacs 18
2071         ;; (if (re-search-forward "^$" (marker-position (mark-marker)))
2072         (if (re-search-forward "^$" (mark t))
2073             (narrow-to-region header-start (match-beginning 0))
2074           )
2075         (goto-char header-start)
2076         (while (and (re-search-forward
2077                      mime-editor/yank-ignored-field-regexp nil t)
2078                     (setq beg (match-beginning 0))
2079                     (setq end (1+ (rfc822/field-end)))
2080                     )
2081           (delete-region beg end)
2082           )
2083         ))))
2084
2085
2086 ;;; @ multipart enclosure
2087 ;;;
2088
2089 (defun mime-editor/enclose-region (type beg end)
2090   (save-excursion
2091     (goto-char beg)
2092     (let ((current (point))
2093           exist-prev-tag)
2094       (save-excursion
2095         (if (mime-editor/goto-tag)
2096             (or (eq current (match-beginning 0))
2097                 (setq exist-prev-tag t)
2098                 )))
2099       (save-restriction
2100         (narrow-to-region beg end)
2101         (goto-char beg)
2102         (if exist-prev-tag
2103             (insert "\n")
2104           )
2105         (insert (format "--<<%s>>-{\n" type))
2106         (goto-char (point-max))
2107         (insert (format "\n--}-<<%s>>\n" type))
2108         (goto-char (point-max))
2109         )
2110       (if (and (not (looking-at mime-editor/single-part-tag-regexp))
2111                (not (eobp)))
2112           (insert (mime-make-text-tag) "\n")
2113         )
2114       )))
2115
2116 (defun mime-editor/enclose-mixed-region (beg end)
2117   (interactive "*r")
2118   (mime-editor/enclose-region "mixed" beg end)
2119   )
2120
2121 (defun mime-editor/enclose-parallel-region (beg end)
2122   (interactive "*r")
2123   (mime-editor/enclose-region "parallel" beg end)
2124   )
2125
2126 (defun mime-editor/enclose-digest-region (beg end)
2127   (interactive "*r")
2128   (mime-editor/enclose-region "digest" beg end)
2129   )
2130
2131 (defun mime-editor/enclose-alternative-region (beg end)
2132   (interactive "*r")
2133   (mime-editor/enclose-region "alternative" beg end)
2134   )
2135
2136 (defun mime-editor/enclose-signed-region (beg end)
2137   (interactive "*r")
2138   (if mime-editor/signing-type
2139       (mime-editor/enclose-region "signed" beg end)
2140     (message "Please specify signing type.")
2141     ))
2142
2143 (defun mime-editor/enclose-encrypted-region (beg end)
2144   (interactive "*r")
2145   (if mime-editor/signing-type
2146       (mime-editor/enclose-region "encrypted" beg end)
2147     (message "Please specify encrypting type.")
2148     ))
2149
2150 (defun mime-editor/insert-key (&optional arg)
2151   "Insert a pgp public key."
2152   (interactive "P")
2153   (mime-editor/insert-tag "application" "pgp-keys")
2154   (mime-editor/define-encoding "7bit")
2155   (mc-insert-public-key)
2156   )
2157
2158
2159 ;;; @ flag setting
2160 ;;;
2161
2162 (defun mime-editor/set-split (arg)
2163   (interactive
2164    (list
2165     (y-or-n-p "Do you want to enable split?")
2166     ))
2167   (setq mime-editor/split-message arg)
2168   (if arg
2169       (message "This message is enabled to split.")
2170     (message "This message is not enabled to split.")
2171     ))
2172
2173 (defun mime-editor/toggle-transfer-level (&optional transfer-level)
2174   "Toggle transfer-level is 7bit or 8bit through.
2175
2176 Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8."
2177   (interactive)
2178   (if (numberp transfer-level)
2179       (setq mime-editor/transfer-level transfer-level)
2180     (if (< mime-editor/transfer-level 8)
2181         (setq mime-editor/transfer-level 8)
2182       (setq mime-editor/transfer-level 7)
2183       ))
2184   (setq mime-editor/charset-default-encoding-alist
2185         (mime/make-charset-default-encoding-alist
2186          mime-editor/transfer-level))
2187   (message (format "Current transfer-level is %d bit"
2188                    mime-editor/transfer-level))
2189   (setq mime-editor/transfer-level-string
2190         (mime/encoding-name mime-editor/transfer-level 'not-omit))
2191   (force-mode-line-update)
2192   )
2193
2194
2195 ;;; @ pgp
2196 ;;;
2197
2198 (defun mime-editor/set-sign (arg)
2199   (interactive
2200    (list
2201     (y-or-n-p "Do you want to sign?")
2202     ))
2203   (if arg
2204       (if mime-editor/signing-type
2205           (progn
2206             (setq mime-editor/pgp-processing 'sign)
2207             (message "This message will be signed.")
2208             )
2209         (message "Please specify signing type.")
2210         )
2211     (if (eq mime-editor/pgp-processing 'sign)
2212         (setq mime-editor/pgp-processing nil)
2213       )
2214     (message "This message will not be signed.")
2215     ))
2216
2217 (defun mime-editor/set-encrypt (arg)
2218   (interactive
2219    (list
2220     (y-or-n-p "Do you want to encrypt?")
2221     ))
2222   (if arg
2223       (if mime-editor/encrypting-type
2224           (progn
2225             (setq mime-editor/pgp-processing 'encrypt)
2226             (message "This message will be encrypt.")
2227             )
2228         (message "Please specify encrypting type.")
2229         )
2230     (if (eq mime-editor/pgp-processing 'encrypt)
2231         (setq mime-editor/pgp-processing nil)
2232       )
2233     (message "This message will not be encrypt.")
2234     ))
2235
2236 (defvar mime-editor/pgp-processing nil)
2237 (make-variable-buffer-local 'mime-editor/pgp-processing)
2238
2239 (defun mime-editor/pgp-enclose-buffer ()
2240   (let ((beg (save-excursion
2241                (goto-char (point-min))
2242                (if (search-forward (concat "\n" mail-header-separator "\n"))
2243                    (match-end 0)
2244                  )))
2245         (end (point-max))
2246         )
2247     (if beg
2248         (cond ((eq mime-editor/pgp-processing 'sign)
2249                (mime-editor/enclose-signed-region beg end)
2250                )
2251               ((eq mime-editor/pgp-processing 'encrypt)
2252                (mime-editor/enclose-encrypted-region beg end)
2253                ))
2254       )))
2255
2256
2257 ;;; @ split
2258 ;;;
2259
2260 (defun mime-editor/insert-partial-header
2261   (fields subject id number total separator)
2262   (insert fields)
2263   (insert (format "Subject: %s (%d/%d)\n" subject number total))
2264   (insert (format "Mime-Version: 1.0 (split by tm-edit %s)\n"
2265                   mime-editor/version))
2266   (insert (format "\
2267 Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n"
2268                   id number total separator))
2269   )
2270
2271 (defun mime-editor/split-and-send
2272   (&optional cmd lines mime-editor/message-max-length)
2273   (interactive)
2274   (or lines
2275       (setq lines
2276             (count-lines (point-min) (point-max)))
2277       )
2278   (or mime-editor/message-max-length
2279       (setq mime-editor/message-max-length
2280             (or (cdr (assq major-mode mime-editor/message-max-length-alist))
2281                 mime-editor/message-default-max-length))
2282       )
2283   (let* ((mime-editor/draft-file-name
2284           (or (buffer-file-name)
2285               (make-temp-name
2286                (expand-file-name "tm-draft" mime/tmp-dir))))
2287          (separator mail-header-separator)
2288          (id (concat "\""
2289                      (replace-space-with-underline (current-time-string))
2290                      "@" (system-name) "\"")))
2291     (run-hooks 'mime-editor/before-split-hook)
2292     (let ((the-buf (current-buffer))
2293           (copy-buf (get-buffer-create " *Original Message*"))
2294           (header (rfc822/get-header-string-except
2295                    mime-editor/split-ignored-field-regexp separator))
2296           (subject (mail-fetch-field "subject"))
2297           (total (+ (/ lines mime-editor/message-max-length)
2298                     (if (> (mod lines mime-editor/message-max-length) 0)
2299                         1)))
2300           (command
2301            (or cmd
2302                (cdr
2303                 (assq major-mode
2304                       mime-editor/split-message-sender-alist))
2305                ))
2306           (mime-editor/partial-number 1)
2307           data)
2308       (save-excursion
2309         (set-buffer copy-buf)
2310         (erase-buffer)
2311         (insert-buffer the-buf)
2312         (save-restriction
2313           (if (re-search-forward
2314                (concat "^" (regexp-quote separator) "$") nil t)
2315               (let ((he (match-beginning 0)))
2316                 (replace-match "")
2317                 (narrow-to-region (point-min) he)
2318                 ))
2319           (goto-char (point-min))
2320           (while (re-search-forward mime-editor/split-blind-field-regexp nil t)
2321             (delete-region (match-beginning 0)
2322                            (1+ (rfc822/field-end)))
2323             )))
2324       (while (< mime-editor/partial-number total)
2325         (erase-buffer)
2326         (save-excursion
2327           (set-buffer copy-buf)
2328           (setq data (buffer-substring
2329                       (point-min)
2330                       (progn
2331                         (goto-line mime-editor/message-max-length)
2332                         (point))
2333                       ))
2334           (delete-region (point-min)(point))
2335           )
2336         (mime-editor/insert-partial-header
2337          header subject id mime-editor/partial-number total separator)
2338         (insert data)
2339         (save-excursion
2340           (message (format "Sending %d/%d..."
2341                            mime-editor/partial-number total))
2342           (call-interactively command)
2343           (message (format "Sending %d/%d... done"
2344                            mime-editor/partial-number total))
2345           )
2346         (setq mime-editor/partial-number
2347               (1+ mime-editor/partial-number))
2348         )
2349       (erase-buffer)
2350       (save-excursion
2351         (set-buffer copy-buf)
2352         (setq data (buffer-string))
2353         (erase-buffer)
2354         )
2355       (mime-editor/insert-partial-header
2356        header subject id mime-editor/partial-number total separator)
2357       (insert data)
2358       (save-excursion
2359         (message (format "Sending %d/%d..."
2360                          mime-editor/partial-number total))
2361         (message (format "Sending %d/%d... done"
2362                          mime-editor/partial-number total))
2363         )
2364       )))
2365
2366 (defun mime-editor/maybe-split-and-send (&optional cmd)
2367   (interactive)
2368   (run-hooks 'mime-editor/before-send-hook)
2369   (let ((mime-editor/message-max-length
2370          (or (cdr (assq major-mode mime-editor/message-max-length-alist))
2371              mime-editor/message-default-max-length))
2372         (lines (count-lines (point-min) (point-max)))
2373         )
2374     (if (and (> lines mime-editor/message-max-length)
2375              mime-editor/split-message)
2376         (mime-editor/split-and-send cmd lines mime-editor/message-max-length)
2377       )))
2378
2379
2380 ;;; @ preview message
2381 ;;;
2382
2383 (defun mime-editor/preview-message ()
2384   "preview editing MIME message. [tm-edit.el]"
2385   (interactive)
2386   (let* ((str (buffer-string))
2387          (separator mail-header-separator)
2388          (the-buf (current-buffer))
2389          (buf-name (buffer-name))
2390          (temp-buf-name (concat "*temp-article:" buf-name "*"))
2391          (buf (get-buffer temp-buf-name))
2392          )
2393     (if buf
2394         (progn
2395           (switch-to-buffer buf)
2396           (erase-buffer)
2397           )
2398       (setq buf (get-buffer-create temp-buf-name))
2399       (switch-to-buffer buf)
2400       )
2401     (insert str)
2402     (setq major-mode 'mime/temporary-message-mode)
2403     (make-local-variable 'mail-header-separator)
2404     (setq mail-header-separator separator)
2405     (make-local-variable 'mime/editing-buffer)
2406     (setq mime/editing-buffer the-buf)
2407
2408     (run-hooks 'mime-editor/translate-hook)
2409     (mime-editor/translate-buffer)
2410     (goto-char (point-min))
2411     (if (re-search-forward
2412          (concat "^" (regexp-quote separator) "$"))
2413         (replace-match "")
2414       )
2415     (mime/viewer-mode)
2416     ))
2417
2418 (defun mime-editor/quitting-method ()
2419   (let ((temp mime::preview/article-buffer)
2420         buf)
2421     (mime-viewer/kill-buffer)
2422     (set-buffer temp)
2423     (setq buf mime/editing-buffer)
2424     (kill-buffer temp)
2425     (switch-to-buffer buf)
2426     ))
2427
2428 (set-alist 'mime-viewer/quitting-method-alist
2429            'mime/temporary-message-mode
2430            (function mime-editor/quitting-method)
2431            )
2432
2433
2434 ;;; @ draft preview
2435 ;;;
2436 ;; by "OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
2437 ;;       Mon, 10 Apr 1995 20:03:07 +0900
2438
2439 (defvar mime-editor/draft-header-separator-alist
2440   '((news-reply-mode . mail-header-separator)
2441     (mh-letter-mode . mail-header-separator)
2442     ))
2443
2444 (defvar mime::article/draft-header-separator nil)
2445
2446 (defun mime-editor/draft-preview ()
2447   (interactive)
2448   (let ((sep (cdr (assq major-mode mime-editor/draft-header-separator-alist))))
2449     (or (stringp sep) (setq sep (eval sep)))
2450     (make-variable-buffer-local 'mime::article/draft-header-separator)
2451     (goto-char (point-min))
2452     (re-search-forward
2453      (concat "^\\(" (regexp-quote sep) "\\)?$"))
2454     (setq mime::article/draft-header-separator
2455           (buffer-substring (match-beginning 0) (match-end 0)))
2456     (replace-match "")
2457     (mime/viewer-mode (current-buffer))
2458     (pop-to-buffer (current-buffer))
2459     ))
2460
2461 (defun mime-viewer::quitting-method/draft-preview ()
2462   (let ((mother mime::preview/mother-buffer))
2463     (save-excursion
2464       (switch-to-buffer mother)
2465       (goto-char (point-min))
2466       (if (and
2467            (re-search-forward
2468             (concat "^\\("
2469                     (regexp-quote mime::article/draft-header-separator)
2470                     "\\)?$") nil t)
2471            (bolp))
2472           (progn
2473             (insert mime::article/draft-header-separator)
2474             (set-buffer-modified-p (buffer-modified-p))
2475             )))
2476     (mime-viewer/kill-buffer)
2477     (pop-to-buffer mother)
2478     ))
2479
2480 (set-alist 'mime-viewer/quitting-method-alist
2481            'mh-letter-mode
2482            (function mime-viewer::quitting-method/draft-preview)
2483            )
2484
2485 (set-alist 'mime-viewer/quitting-method-alist
2486            'news-reply-mode
2487            (function mime-viewer::quitting-method/draft-preview)
2488            )
2489
2490
2491 ;;; @ edit again
2492 ;;;
2493
2494 (defun mime-editor::edit-again (code-conversion)
2495   (save-excursion
2496     (goto-char (point-min))
2497     (let ((ctl (mime/Content-Type)))
2498       (if ctl
2499           (let ((ctype (car ctl))
2500                 (params (cdr ctl))
2501                 type stype)
2502             (if (string-match "/" ctype)
2503                 (progn
2504                   (setq type (substring ctype 0 (match-beginning 0)))
2505                   (setq stype (substring ctype (match-end 0)))
2506                   )
2507               (setq type ctype)
2508               )
2509             (cond
2510              ((string-equal type "multipart")
2511               (let ((boundary (assoc-value "boundary" params)))
2512                 (re-search-forward (concat "\n--" boundary) nil t)
2513                 (let ((bb (match-beginning 0)) eb tag)
2514                   (setq tag (format "\n--<<%s>>-{" stype))
2515                   (goto-char bb)
2516                   (insert tag)
2517                   (setq bb (+ bb (length tag)))
2518                   (re-search-forward (concat "\n--" boundary "--") nil t)
2519                   (setq eb (match-beginning 0))
2520                   (replace-match (format "\n--}-<<%s>>" stype))
2521                   (save-restriction
2522                     (narrow-to-region bb eb)
2523                     (goto-char (point-min))
2524                     (while (re-search-forward
2525                             (concat "\n--" boundary "\n") nil t)
2526                       (let ((beg (match-beginning 0))
2527                             end)
2528                         (delete-region beg (match-end 0))
2529                         (save-excursion
2530                           (if (re-search-forward
2531                                (concat "\n--" boundary) nil t)
2532                               (setq end (match-beginning 0))
2533                             (setq end (point-max))
2534                             )
2535                           (save-restriction
2536                             (narrow-to-region beg end)
2537                             (mime-editor::edit-again code-conversion)
2538                             (goto-char (point-max))
2539                             ))))
2540                     ))
2541                 (goto-char (point-min))
2542                 (or (= (point-min) 1)
2543                     (delete-region (point-min)
2544                                    (if (re-search-forward "^$" nil t)
2545                                        (match-end 0)
2546                                      (point-min)
2547                                      )))
2548                 ))
2549              (t
2550               (let* (charset
2551                      (pstr
2552                       (mapconcat (function
2553                                   (lambda (attr)
2554                                     (if (string-equal (car attr)
2555                                                       "charset")
2556                                         (progn
2557                                           (setq charset (cdr attr))
2558                                           "")
2559                                       (concat ";" (car attr)
2560                                               "=" (cdr attr))
2561                                       )
2562                                     ))
2563                                  params ""))
2564                      encoding
2565                      encoded)
2566                 (save-excursion
2567                   (if (re-search-forward
2568                        "Content-Transfer-Encoding:" nil t)
2569                       (let ((beg (match-beginning 0))
2570                             (hbeg (match-end 0))
2571                             (end (rfc822/field-end)))
2572                         (setq encoding
2573                               (eliminate-top-spaces
2574                                (rfc822/unfolding-string
2575                                 (buffer-substring hbeg end))))
2576                         (if (or charset (string-equal type "text"))
2577                             (progn
2578                               (delete-region beg (1+ end))
2579                               (goto-char (point-min))
2580                               (if (search-forward "\n\n" nil t)
2581                                   (progn
2582                                     (mime-decode-region
2583                                      (match-end 0)(point-max) encoding)
2584                                     (setq encoded t
2585                                           encoding nil)
2586                                     )))))))
2587                 (if (or code-conversion encoded)
2588                     (if charset
2589                         (mime-charset-decode-region (point-min)(point-max)
2590                                                     charset)
2591                       (character-decode-region (point-min)(point-max)
2592                                                mime/default-coding-system)
2593                       ))
2594                 (let ((he
2595                        (if (re-search-forward "^$" nil t)
2596                            (match-end 0)
2597                          (point-min)
2598                          )))
2599                   (if (= (point-min) 1)
2600                       (progn
2601                         (goto-char he)
2602                         (insert
2603                          (concat
2604                           "\n"
2605                           (mime-create-tag
2606                            (concat type "/" stype pstr) encoding)
2607                           ))
2608                         )
2609                     (delete-region (point-min) he)
2610                     (insert
2611                      (concat "\n"
2612                              (mime-create-tag
2613                               (concat type "/" stype pstr) encoding)
2614                              ))
2615                     ))
2616                 ))))
2617         (if code-conversion
2618             (character-decode-region (point-min) (point-max)
2619                                      mime/default-coding-system)
2620           )
2621         ))))
2622
2623 (defun mime/edit-again (&optional code-conversion no-separator no-mode)
2624   (interactive)
2625   (mime-editor::edit-again code-conversion)
2626   (goto-char (point-min))
2627   (save-restriction
2628     (narrow-to-region (point-min)
2629                       (if (re-search-forward "^$" nil t)
2630                           (match-end 0)
2631                         (point-max)
2632                         ))
2633     (goto-char (point-min))
2634     (while (re-search-forward
2635             "^\\(Content-.*\\|Mime-Version\\):" nil t)
2636       (delete-region (match-beginning 0) (1+ (rfc822/field-end)))
2637       ))
2638   (or no-separator
2639       (and (re-search-forward "^$")
2640            (replace-match mail-header-separator)
2641            ))
2642   (or no-mode
2643       (mime/editor-mode)
2644       ))
2645
2646
2647 ;;; @ end
2648 ;;;
2649
2650 (provide 'tm-edit)
2651
2652 (run-hooks 'tm-edit-load-hook)
2653
2654 ;;; tm-edit.el ends here