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