mime-edit.el

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