mime-edit.el

   1 ;;; mime-edit.el --- Simple MIME Composer for GNU Emacs
   2
   3 ;; Copyright (C) 1993,94,95,96,97,98,99,2000,01,02,03
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Author: UMEDA Masanobu <umerin@mse.kyutech.ac.jp>
   7 ;;      MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
   8 ;;      Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
   9 ;; Created: 1994/08/21 renamed from mime.el
  10 ;;      Renamed: 1997/2/21 from tm-edit.el
  11 ;; Keywords: MIME, multimedia, multilingual, mail, news
  12
  13 ;; This file is part of SEMI (Sophisticated 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., 51 Franklin Street, Fifth Floor,
  28 ;; Boston, MA 02110-1301, 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 (multilingual feature of Emacs 20 and multilingual extension
  40 ;; for XEmacs 20) has a capability of handling multilingual text in
  41 ;; limited ISO-2022 manner that is based on early experiences in
  42 ;; Japanese Internet community and resulted in RFC 1468 (ISO-2022-JP
  43 ;; charset for MIME).  In order to enable multilingual capability in
  44 ;; single text message in MIME, charset of multilingual text written
  45 ;; in Mule is declared as either `ISO-2022-JP-2' [RFC 1554].  Mule is
  46 ;; required for reading the such messages.
  47
  48 ;; This MIME composer can work with Mail mode, mh-e letter Mode, and
  49 ;; News mode.  First of all, you need the following autoload
  50 ;; definition to load mime-edit-mode automatically:
  51 ;;
  52 ;; (autoload 'turn-on-mime-edit "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 'turn-on-mime-edit)
  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 ;;              (turn-on-mime-edit)
  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 'turn-on-mime-edit)
  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 'signature)
 116 (require 'alist)
 117 (require 'invisible)
 118 (require 'pgg-def)
 119 (require 'pgg-parse)
 120
 121 (autoload 'pgg-encrypt-region "pgg"
 122   "PGP encryption of current region." t)
 123 (autoload 'pgg-sign-region "pgg"
 124   "PGP signature of current region." t)
 125 (autoload 'pgg-insert-key "pgg"
 126   "Insert PGP public key at point." t)
 127 (autoload 'smime-encrypt-region "smime"
 128   "S/MIME encryption of current region.")
 129 (autoload 'smime-sign-region "smime"
 130   "S/MIME signature of current region.")
 131 (defvar smime-output-buffer)
 132 (defvar smime-errors-buffer)
 133
 134
 135 ;;; @ version
 136 ;;;
 137
 138 (eval-and-compile
 139   (defconst mime-edit-version
 140     (concat
 141      (mime-product-name mime-user-interface-product) " "
 142      (mapconcat #'number-to-string
 143                 (mime-product-version mime-user-interface-product) ".")
 144      " - \"" (mime-product-code-name mime-user-interface-product) "\"")))
 145
 146
 147 ;;; @ variables
 148 ;;;
 149
 150 (defgroup mime-edit nil
 151   "MIME edit mode"
 152   :group 'mime)
 153
 154 (defcustom mime-ignore-preceding-spaces nil
 155   "*Ignore preceding white spaces if non-nil."
 156   :group 'mime-edit
 157   :type 'boolean)
 158
 159 (defcustom mime-ignore-trailing-spaces nil
 160   "*Ignore trailing white spaces if non-nil."
 161   :group 'mime-edit
 162   :type 'boolean)
 163
 164 (defcustom mime-ignore-same-text-tag t
 165   "*Ignore preceding text content-type tag that is same with new one.
 166 If non-nil, the text tag is not inserted unless something different."
 167   :group 'mime-edit
 168   :type 'boolean)
 169
 170 (defcustom mime-auto-hide-body t
 171   "*Hide non-textual body encoded in base64 after insertion if non-nil."
 172   :group 'mime-edit
 173   :type 'boolean)
 174
 175 (defcustom mime-edit-voice-recorder
 176   (function mime-edit-voice-recorder-for-sun)
 177   "*Function to record a voice message and encode it."
 178   :group 'mime-edit
 179   :type 'function)
 180
 181 (defcustom mime-edit-mode-hook nil
 182   "*Hook called when enter MIME mode."
 183   :group 'mime-edit
 184   :type 'hook)
 185
 186 (defcustom mime-edit-translate-hook nil
 187   "*Hook called before translating into a MIME compliant message.
 188 To insert a signature file automatically, call the function
 189 `mime-edit-insert-signature' from this hook."
 190   :group 'mime-edit
 191   :type 'hook)
 192
 193 (defcustom mime-edit-exit-hook nil
 194   "*Hook called when exit MIME mode."
 195   :group 'mime-edit
 196   :type 'hook)
 197
 198 (defvar mime-content-types
 199   '(("text"
 200      ;; Charset parameter need not to be specified, since it is
 201      ;; defined automatically while translation.
 202      ("plain"
 203       ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8")
 204       )
 205      ("enriched")
 206      ("html")
 207      ("css") ; rfc2318
 208      ("csv") ; rfc4180
 209      ("xml") ; rfc2376
 210      ("x-latex")
 211      ;; ("x-rot13-47-48")
 212      )
 213     ("message"
 214      ("external-body"
 215       ("access-type"
 216        ("anon-ftp"
 217         ("site" "ftp.jaist.ac.jp" "wnoc-fuk.wide.ad.jp" "nic.karrn.ad.jp")
 218         ("directory" "/pub/GNU/elisp/mime")
 219         ("name")
 220         ("mode" "image" "ascii" "local8"))
 221        ("ftp"
 222         ("site")
 223         ("directory")
 224         ("name")
 225         ("mode" "image" "ascii" "local8"))
 226        ("tftp"        ("site") ("name"))
 227        ("afs"         ("site") ("name"))
 228        ("local-file"  ("site") ("name"))
 229        ("mail-server"
 230         ("server" "ftpmail@nic.karrn.ad.jp")
 231         ("subject"))
 232        ("url"         ("url"))
 233        ))
 234      ("rfc822")
 235      ("news")
 236      )
 237     ("application"
 238      ("javascript")
 239      ("msword")
 240      ("octet-stream" ("type" "" "tar" "shar"))
 241      ("postscript")
 242      ("pdf")
 243      ("rtf")
 244      ("zip")
 245      ("x-shockwave-flash")
 246      ("x-7z-compressed")
 247
 248                                         ; OpenOffice
 249      ("vnd.oasis.opendocument.text")
 250      ("vnd.oasis.opendocument.spreadsheet")
 251      ("vnd.oasis.opendocument.graphics")
 252      ("vnd.oasis.opendocument.chart")
 253      ("vnd.oasis.opendocument.formula")
 254      ("vnd.oasis.opendocument.text-master")
 255      ("vnd.oasis.opendocument.presentation")
 256      ("vnd.oasis.opendocument.text-template")
 257      ("vnd.oasis.opendocument.spreadsheet-template")
 258      ("vnd.oasis.opendocument.presentation-template")
 259      ("vnd.oasis.opendocument.graphics-template")
 260
 261      ("msword")
 262      ("vnd.ms-excel")
 263      ("vnd.ms-powerpoint")
 264                                         ; Microsoft Office (OpenXML)
 265      ("vnd.ms-excel.addin.macroEnabled.12")
 266      ("vnd.ms-excel.sheet.binary.macroEnabled.12")
 267      ("vnd.ms-excel.sheet.macroEnabled.12")
 268      ("vnd.ms-excel.template.macroEnabled.12")
 269      ("vnd.ms-powerpoint.addin.macroEnabled.12")
 270      ("vnd.ms-powerpoint.presentation.macroEnabled.12")
 271      ("vnd.ms-powerpoint.slideshow.macroEnabled.12")
 272      ("vnd.ms-powerpoint.template.macroEnabled.12")
 273      ("vnd.ms-word.document.macroEnabled.12")
 274      ("vnd.ms-word.template.macroEnabled.12")
 275      ("vnd.openxmlformats-officedocument.presentationml.presentation")
 276      ("vnd.openxmlformats-officedocument.presentationml.slideshow")
 277      ("vnd.openxmlformats-officedocument.presentationml.template")
 278      ("vnd.openxmlformats-officedocument.spreadsheetml.sheet")
 279      ("vnd.openxmlformats-officedocument.spreadsheetml.template")
 280      ("vnd.openxmlformats-officedocument.wordprocessingml.document")
 281      ("vnd.openxmlformats-officedocument.wordprocessingml.template")
 282      ("vnd.ms-xpsdocument")
 283                                         ; Microsoft Project
 284      ("vnd.ms-project")
 285      ("x-kiss" ("x-cnf")))
 286     ("image"
 287      ("bmp")
 288      ("gif")
 289      ("jpeg")
 290      ("png")
 291      ("svg+xml")
 292      ("tiff")
 293      ("x-pic")
 294      ("x-mag")
 295      ("x-xwd")
 296      ("x-xbm"))
 297     ("audio"
 298      ("basic")
 299      ("mpeg")
 300      ("ogg")
 301      ("vorbis"))
 302     ("video"
 303      ("mpeg")
 304      ("ogg")
 305      ("mp4")
 306      ("quicktime")
 307      ("x-flv")))
 308   "*Alist of content-type, subtype, parameters and its values.")
 309
 310 (defcustom mime-file-types
 311   '(
 312
 313     ;; Programming languages
 314
 315     ("\\.cc$"
 316      "application" "octet-stream" (("type" . "C++"))
 317      "7bit"
 318      "attachment"       (("filename" . file))
 319      )
 320
 321     ("\\.el$"
 322      "application" "octet-stream" (("type" . "emacs-lisp"))
 323      "7bit"
 324      "attachment"       (("filename" . file))
 325      )
 326
 327     ("\\.lsp$"
 328      "application" "octet-stream" (("type" . "common-lisp"))
 329      "7bit"
 330      "attachment"       (("filename" . file))
 331      )
 332
 333     ("\\.pl$"
 334      "application" "octet-stream" (("type" . "perl"))
 335      "7bit"
 336      "attachment"       (("filename" . file))
 337      )
 338
 339     ;; Text or translated text
 340
 341     ("\\.txt$\\|\\.pln$"
 342      "text"     "plain"         nil
 343      nil
 344      "inline"           (("filename" . file))
 345      )
 346
 347     ("\\.css$"
 348      "text"     "css"           nil
 349      nil
 350      "inline"           (("filename" . file))
 351      )
 352
 353     ("\\.csv$"
 354      "text"     "csv"           nil
 355      nil
 356      "inline"           (("filename" . file))
 357      )
 358
 359     ("\\.tex$\\|\\.latex$"
 360      "text"     "x-latex"       nil
 361      nil
 362      "inline"           (("filename" . file))
 363      )
 364
 365      ;; .rc : procmail modules pm-xxxx.rc
 366      ;; *rc : other resource files
 367
 368     ("\\.\\(rc\\|lst\\|log\\|sql\\|mak\\)$\\|\\..*rc$"
 369      "text"     "plain"         nil
 370      nil
 371      "attachment"       (("filename" . file))
 372      )
 373
 374     ("\\.html$"
 375      "text"     "html"          nil
 376      nil
 377      nil                nil)
 378
 379     ("\\.diff$\\|\\.patch$"
 380      "application" "octet-stream" (("type" . "patch"))
 381      nil
 382      "attachment"       (("filename" . file))
 383      )
 384
 385     ("\\.signature"
 386      "text"     "plain"         nil     nil     nil     nil)
 387
 388
 389     ("\\.js$"
 390      "application"      "javascript" nil
 391      nil
 392      "inline"   (("filename" . file))
 393      )
 394
 395
 396     ;; Microsoft Project
 397     ("\\.mpp$"
 398      "application" "vnd.ms-project" nil
 399      "base64"
 400      "attachment" (("filename" . file))
 401      )
 402
 403
 404     ;; Microsoft Office (none-OpenXML)
 405
 406     ("\\.rtf$"                          ; Rich text format
 407      "application" "rtf" nil
 408      "base64"
 409      "attachment" (("filename" . file))
 410      )
 411     ("\\.doc$"                          ;MS Word
 412      "application" "msword" nil
 413      "base64"
 414      "attachment" (("filename" . file))
 415      )
 416     ("\\.xls$"                          ; MS Excel
 417      "application" "vnd.ms-excel" nil
 418      "base64"
 419      "attachment" (("filename" . file))
 420      )
 421     ("\\.ppt$"                          ; MS Power Point
 422      "application" "vnd.ms-powerpoint" nil
 423      "base64"
 424      "attachment" (("filename" . file))
 425      )
 426
 427
 428     ;; Microsoft Office (OpenXML)
 429
 430                                         ; MS Word
 431     ("\\.docm$"
 432      "application" "vnd.ms-word.document.macroEnabled.12" nil
 433      "base64"
 434      "attachment" (("filename" . file))
 435      )
 436     ("\\.docx$"
 437      "application" "vnd.openxmlformats-officedocument.wordprocessingml.document" nil
 438      "base64"
 439      "attachment" (("filename" . file))
 440      )
 441     ("\\.dotm$"
 442      "application" "vnd.ms-word.template.macroEnabled.12" nil
 443      "base64"
 444      "attachment" (("filename" . file))
 445      )
 446     ("\\.dotx$"
 447      "application" "vnd.openxmlformats-officedocument.wordprocessingml.template" nil
 448      "base64"
 449      "attachment" (("filename" . file))
 450      )
 451
 452                                         ; MS Power Point
 453     ("\\.potm$"
 454      "application" "vnd.ms-powerpoint.template.macroEnabled.12" nil
 455      "base64"
 456      "attachment" (("filename" . file))
 457      )
 458     ("\\.potx$"
 459      "application" "vnd.openxmlformats-officedocument.presentationml.template" nil
 460      "base64"
 461      "attachment" (("filename" . file))
 462      )
 463     ("\\.ppam$"
 464      "application" "vnd.ms-powerpoint.addin.macroEnabled.12" nil
 465      "base64"
 466      "attachment" (("filename" . file))
 467      )
 468     ("\\.ppsm$"
 469      "application" "vnd.ms-powerpoint.slideshow.macroEnabled.12" nil
 470      "base64"
 471      "attachment" (("filename" . file))
 472      )
 473     ("\\.ppsx$"
 474      "application" "vnd.openxmlformats-officedocument.presentationml.slideshow" nil
 475      "base64"
 476      "attachment" (("filename" . file))
 477      )
 478     ("\\.pptm$"
 479      "application" "vnd.ms-powerpoint.presentation.macroEnabled.12" nil
 480      "base64"
 481      "attachment" (("filename" . file))
 482      )
 483     ("\\.pptx$"
 484      "application" "vnd.openxmlformats-officedocument.presentationml.presentation" nil
 485      "base64"
 486      "attachment" (("filename" . file))
 487      )
 488
 489                                         ; MS Excel
 490     ("\\.xlam$"
 491      "application" "vnd.ms-excel.addin.macroEnabled.12" nil
 492      "base64"
 493      "attachment" (("filename" . file))
 494      )
 495     ("\\.xlsb$"
 496      "application" "vnd.ms-excel.sheet.binary.macroEnabled.12" nil
 497      "base64"
 498      "attachment" (("filename" . file))
 499      )
 500     ("\\.xlsm$"
 501      "application" "vnd.ms-excel.sheet.macroEnabled.12" nil
 502      "base64"
 503      "attachment" (("filename" . file))
 504      )
 505     ("\\.xlsx$"
 506      "application" "vnd.openxmlformats-officedocument.spreadsheetml.sheet" nil
 507      "base64"
 508      "attachment" (("filename" . file))
 509      )
 510     ("\\.xltm$"
 511      "application" "vnd.ms-excel.template.macroEnabled.12" nil
 512      "base64"
 513      "attachment" (("filename" . file))
 514      )
 515     ("\\.xltx$"
 516      "application" "vnd.openxmlformats-officedocument.spreadsheetml.template" nil
 517      "base64"
 518      "attachment" (("filename" . file))
 519      )
 520
 521
 522     ;; Open Office
 523     ("\\.odt$"
 524      "application" "vnd.oasis.opendocument.text" nil
 525      "base64"
 526      "attachment" (("filename" . file))
 527      )
 528     ("\\.ods$"
 529      "application" "vnd.oasis.opendocument.spreadsheet" nil
 530      "base64"
 531      "attachment" (("filename" . file))
 532      )
 533     ("\\.odg$"
 534      "application" "vnd.oasis.opendocument.graphics" nil
 535      "base64"
 536      "attachment" (("filename" . file))
 537      )
 538     ("\\.odf$"
 539      "application" "vnd.oasis.opendocument.formula" nil
 540      "base64"
 541      "attachment" (("filename" . file))
 542      )
 543     ("\\.odm$"
 544      "application" "vnd.oasis.opendocument.text-master" nil
 545      "base64"
 546      "attachment" (("filename" . file))
 547      )
 548     ("\\.odp$"
 549      "application" "vnd.oasis.opendocument.presentation" nil
 550      "base64"
 551      "attachment" (("filename" . file))
 552      )
 553     ("\\.ott$"
 554      "application" "vnd.oasis.opendocument.text-template" nil
 555      "base64"
 556      "attachment" (("filename" . file))
 557      )
 558     ("\\.ots$"
 559      "application" "vnd.oasis.opendocument.spreadsheet-template" nil
 560      "base64"
 561      "attachment" (("filename" . file))
 562      )
 563     ("\\.otp$"
 564      "application" "vnd.oasis.opendocument.presentation-template" nil
 565      "base64"
 566      "attachment" (("filename" . file))
 567      )
 568     ("\\.otg$"
 569      "application" "vnd.oasis.opendocument.graphics-template" nil
 570      "base64"
 571      "attachment" (("filename" . file))
 572      )
 573
 574         ;; Postscript and PDF
 575     ("\\.ps$"
 576      "application" "postscript" nil
 577      "base64"
 578      "attachment"       (("filename" . file))
 579      )
 580     ("\\.pdf$"
 581      "application" "pdf"        nil
 582      "base64"
 583      "attachment"       (("filename" . file))
 584      )
 585
 586     ;;  Pure binary
 587
 588     ("\\.jpg$\\|\\.jpeg$"
 589      "image"    "jpeg"          nil
 590      "base64"
 591      "inline"           (("filename" . file))
 592      )
 593     ("\\.gif$"
 594      "image"    "gif"           nil
 595      "base64"
 596      "inline"           (("filename" . file))
 597      )
 598     ("\\.png$"
 599      "image"    "png"           nil
 600      "base64"
 601      "inline"           (("filename" . file))
 602      )
 603     ("\\.bmp$"
 604      "image"    "bmp"           nil
 605      "base64"
 606      "inline"           (("filename" . file))
 607      )
 608     ("\\.svg$"
 609      "image"    "svg+xml"   nil
 610      "base64"
 611      "inline"           (("filename" . file))
 612      )
 613     ("\\.tiff$"
 614      "image"    "tiff"          nil
 615      "base64"
 616      "inline"           (("filename" . file))
 617      )
 618     ("\\.pic$"
 619      "image"    "x-pic"         nil
 620      "base64"
 621      "inline"           (("filename" . file))
 622      )
 623     ("\\.mag$"
 624      "image"    "x-mag"         nil
 625      "base64"
 626      "inline"           (("filename" . file))
 627      )
 628     ("\\.xbm$"
 629      "image"    "x-xbm"         nil
 630      "base64"
 631      "inline"           (("filename" . file))
 632      )
 633     ("\\.xwd$"
 634      "image"    "x-xwd"         nil
 635      "base64"
 636      "inline"           (("filename" . file))
 637      )
 638
 639         ;; Audio and video
 640
 641     ("\\.au$\\|\\.snd$"
 642      "audio"    "basic"         nil
 643      "base64"
 644      "attachment"               (("filename" . file))
 645      )
 646     ("\\.mp[234]\\|\\.m4[abp]$"
 647      "audio"    "mpeg"          nil
 648      "base64"
 649      "attachment"               (("filename" . file))
 650      )
 651     ("\\.ogg$"
 652      "audio"    "ogg"           nil
 653      "base64"
 654      "attachment"               (("filename" . file))
 655      )
 656     ("\\.ogg$"
 657      "audio"    "vorbis"                nil
 658      "base64"
 659      "attachment"               (("filename" . file))
 660      )
 661     ("\\.mpg\\|\\.mpeg$"
 662      "video"    "mpeg"          nil
 663      "base64"
 664      "attachment"       (("filename" . file))
 665      )
 666     ("\\.mp4\\|\\.m4v$"
 667      "video"    "mp4"           nil
 668      "base64"
 669      "attachment"       (("filename" . file))
 670      )
 671     ("\\.qt$\\|\\.mov$"
 672      "video"    "quicktime"             nil
 673      "base64"
 674      "attachment"       (("filename" . file))
 675      )
 676     ("\\.flv$"
 677      "video"    "x-flv"         nil
 678      "base64"
 679      "attachment"       (("filename" . file))
 680      )
 681     ("\\.swf$"
 682      "application"      "x-shockwave-flash"             nil
 683      "base64"
 684      "attachment"       (("filename" . file))
 685      )
 686
 687
 688         ;; Compressed files
 689
 690     ("\\.tar\\.gz$"
 691      "application" "octet-stream" (("type" . "tar+gzip"))
 692      "base64"
 693      "attachment"       (("filename" . file))
 694      )
 695     ("\\.tgz$"
 696      "application" "octet-stream" (("type" . "tar+gzip"))
 697      "base64"
 698      "attachment"       (("filename" . file))
 699      )
 700     ("\\.tar\\.Z$"
 701      "application" "octet-stream" (("type" . "tar+compress"))
 702      "base64"
 703      "attachment"       (("filename" . file))
 704      )
 705     ("\\.taz$"
 706      "application" "octet-stream" (("type" . "tar+compress"))
 707      "base64"
 708      "attachment"       (("filename" . file))
 709      )
 710     ("\\.gz$"
 711      "application" "octet-stream" (("type" . "gzip"))
 712      "base64"
 713      "attachment"       (("filename" . file))
 714      )
 715     ("\\.Z$"
 716      "application" "octet-stream" (("type" . "compress"))
 717      "base64"
 718      "attachment"       (("filename" . file))
 719      )
 720     ("\\.lzh$"
 721      "application" "octet-stream" (("type" . "lha"))
 722      "base64"
 723      "attachment"       (("filename" . file))
 724      )
 725     ("\\.zip$"
 726      "application" "zip" nil
 727      "base64"
 728      "attachment"       (("filename" . file))
 729      )
 730     ("\\.7z$"
 731      "application" "x-7z-compressed" nil
 732      "base64"
 733      "attachment"       (("filename" . file))
 734      )
 735
 736     ;; Rest
 737
 738     (".*"
 739      "application" "octet-stream" nil
 740      nil
 741      "attachment"       (("filename" . file)))
 742     )
 743   "*Alist of file name, types, parameters, and default encoding.
 744 If encoding is nil, it is determined from its contents."
 745   :type `(repeat
 746           (list regexp
 747                 ;; primary-type
 748                 (choice :tag "Primary-Type"
 749                         ,@(nconc (mapcar (lambda (cell)
 750                                            (list 'item (car cell))
 751                                            )
 752                                          mime-content-types)
 753                                  '(string)))
 754                 ;; subtype
 755                 (choice :tag "Sub-Type"
 756                         ,@(nconc
 757                            (apply #'nconc
 758                                   (mapcar (lambda (cell)
 759                                             (mapcar (lambda (cell)
 760                                                       (list 'item (car cell))
 761                                                       )
 762                                                     (cdr cell)))
 763                                           mime-content-types))
 764                            '(string)))
 765                 ;; parameters
 766                 (repeat :tag "Parameters of Content-Type field"
 767                         (cons string (choice string symbol)))
 768                 ;; content-transfer-encoding
 769                 (choice :tag "Encoding"
 770                         ,@(cons
 771                            '(const nil)
 772                            (mapcar (lambda (cell)
 773                                      (list 'item cell)
 774                                      )
 775                                    (mime-encoding-list))))
 776                 ;; disposition-type
 777                 (choice :tag "Disposition-Type"
 778                         (item nil)
 779                         (item "inline")
 780                         (item "attachment")
 781                         string)
 782                 ;; parameters
 783                 (repeat :tag "Parameters of Content-Disposition field"
 784                         (cons string (choice string symbol)))
 785                 ))
 786   :group 'mime-edit)
 787
 788
 789 ;;; @@ about charset, encoding and transfer-level
 790 ;;;
 791
 792 (defvar mime-charset-type-list
 793   '((us-ascii           7 nil)
 794     (iso-8859-1         8 "quoted-printable")
 795     (iso-8859-2         8 "quoted-printable")
 796     (iso-8859-3         8 "quoted-printable")
 797     (iso-8859-4         8 "quoted-printable")
 798     (iso-8859-5         8 "quoted-printable")
 799     (koi8-r             8 "quoted-printable")
 800     (iso-8859-7         8 "quoted-printable")
 801     (iso-8859-8         8 "quoted-printable")
 802     (iso-8859-9         8 "quoted-printable")
 803     (iso-8859-14        8 "quoted-printable")
 804     (iso-8859-15        8 "quoted-printable")
 805     (iso-2022-jp        7 "base64")
 806     (iso-2022-jp-3      7 "base64")
 807     (iso-2022-kr        7 "base64")
 808     (euc-kr             8 "base64")
 809     (cn-gb              8 "base64")
 810     (gb2312             8 "base64")
 811     (cn-big5            8 "base64")
 812     (big5               8 "base64")
 813     (shift_jis          8 "base64")
 814     (tis-620            8 "base64")
 815     (iso-2022-jp-2      7 "base64")
 816     (iso-2022-int-1     7 "base64")
 817     ))
 818
 819 (defvar mime-transfer-level 7
 820   "*A number of network transfer level.  It should be bigger than 7.")
 821 (make-variable-buffer-local 'mime-transfer-level)
 822
 823 (defsubst mime-encoding-name (transfer-level &optional not-omit)
 824   (cond ((> transfer-level 8) "binary")
 825         ((= transfer-level 8) "8bit")
 826         (not-omit "7bit")
 827         ))
 828
 829 (defvar mime-transfer-level-string
 830   (mime-encoding-name mime-transfer-level 'not-omit)
 831   "A string formatted version of mime-transfer-level")
 832 (make-variable-buffer-local 'mime-transfer-level-string)
 833
 834 ;;; @@ about content transfer encoding
 835
 836 (defvar mime-content-transfer-encoding-priority-list
 837   '(nil "8bit" "binary"))
 838
 839 ;;; @@ about message inserting
 840 ;;;
 841
 842 (defvar mime-edit-yank-ignored-field-list
 843   '("Received" "Approved" "Path" "Replied" "Status"
 844     "Xref" "X-UIDL" "X-Filter" "X-Gnus-.*" "X-VM-.*")
 845   "Delete these fields from original message when it is inserted
 846 as message/rfc822 part.
 847 Each elements are regexp of field-name.")
 848
 849 (defvar mime-edit-yank-ignored-field-regexp
 850   (concat "^"
 851           (apply (function regexp-or) mime-edit-yank-ignored-field-list)
 852           ":"))
 853
 854 (defvar mime-edit-message-inserter-alist nil)
 855 (defvar mime-edit-mail-inserter-alist nil)
 856
 857
 858 ;;; @@ about message splitting
 859 ;;;
 860
 861 (defcustom mime-edit-split-message t
 862   "*Split large message if it is non-nil."
 863   :group 'mime-edit
 864   :type 'boolean)
 865
 866 (defcustom mime-edit-message-default-max-lines 1000
 867   "*Default maximum lines of a message."
 868   :group 'mime-edit
 869   :type 'integer)
 870
 871 (defcustom mime-edit-message-max-lines-alist
 872   '((news-reply-mode . 500))
 873   "Alist of major-mode vs maximum lines of a message.
 874 If it is not specified for a major-mode,
 875 `mime-edit-message-default-max-lines' is used."
 876   :group 'mime-edit
 877   :type 'list)
 878
 879 (defconst mime-edit-split-ignored-field-regexp
 880   "\\(^Content-\\|^Subject:\\|^Mime-Version:\\|^Message-Id:\\)")
 881
 882 (defcustom mime-edit-split-blind-field-regexp
 883   "\\(^[BDFbdf]cc:\\|^cc:[ \t]*$\\)"
 884   "*Regular expression to match field-name to be ignored when split sending."
 885   :group 'mime-edit
 886   :type 'regexp)
 887
 888 (defvar mime-edit-split-message-sender-alist nil)
 889
 890 (defvar mime-edit-news-reply-mode-server-running nil)
 891
 892
 893 ;;; @@ about tag
 894 ;;;
 895
 896 (defconst mime-edit-single-part-tag-regexp
 897   "--[[][[]\\([^]]*\\)]\\([[]\\([^]]*\\)]\\|\\)]"
 898   "*Regexp of MIME tag in the form of [[CONTENT-TYPE][ENCODING]].")
 899
 900 (defconst mime-edit-quoted-single-part-tag-regexp
 901   (concat "- " (substring mime-edit-single-part-tag-regexp 1)))
 902
 903 (defconst mime-edit-multipart-beginning-regexp "--<<\\([^<>]+\\)>>-{\n")
 904
 905 (defconst mime-edit-multipart-end-regexp "--}-<<\\([^<>]+\\)>>\n")
 906
 907 (defconst mime-edit-beginning-tag-regexp
 908   (regexp-or mime-edit-single-part-tag-regexp
 909              mime-edit-multipart-beginning-regexp))
 910
 911 (defconst mime-edit-end-tag-regexp
 912   (regexp-or mime-edit-single-part-tag-regexp
 913              mime-edit-multipart-end-regexp))
 914
 915 (defconst mime-edit-tag-regexp
 916   (regexp-or mime-edit-single-part-tag-regexp
 917              mime-edit-multipart-beginning-regexp
 918              mime-edit-multipart-end-regexp))
 919
 920 (defvar mime-tag-format "--[[%s]]"
 921   "*Control-string making a MIME tag.")
 922
 923 (defvar mime-tag-format-with-encoding "--[[%s][%s]]"
 924   "*Control-string making a MIME tag with encoding.")
 925
 926
 927 ;;; @@ multipart boundary
 928 ;;;
 929
 930 (defvar mime-multipart-boundary "Multipart"
 931   "*Boundary of a multipart message.")
 932
 933
 934 ;;; @@ optional header fields
 935 ;;;
 936
 937 (defvar mime-edit-insert-user-agent-field t
 938   "*If non-nil, insert User-Agent header field.")
 939
 940 (defvar mime-edit-user-agent-value
 941   (concat (mime-product-name mime-user-interface-product)
 942           "/"
 943           (mapconcat #'number-to-string
 944                      (mime-product-version mime-user-interface-product) ".")
 945           " ("
 946           (mime-product-code-name mime-user-interface-product)
 947           ") "
 948           (mime-product-name mime-library-product)
 949           "/"
 950           (mapconcat #'number-to-string
 951                      (mime-product-version mime-library-product) ".")
 952           " ("
 953           (mime-product-code-name mime-library-product)
 954           ") "
 955           (if (fboundp 'apel-version)
 956               (concat (apel-version) " "))
 957           (if (featurep 'xemacs)
 958               (concat (cond ((and (featurep 'chise)
 959                                   (boundp 'xemacs-chise-version))
 960                              (concat "CHISE-MULE/" xemacs-chise-version))
 961                             ((featurep 'utf-2000)
 962                              (concat "UTF-2000-MULE/" utf-2000-version))
 963                             ((featurep 'mule) "MULE"))
 964                       " XEmacs"
 965                       (if (string-match "^[0-9]+\\(\\.[0-9]+\\)" emacs-version)
 966                           (concat
 967                            "/"
 968                            (substring emacs-version 0 (match-end 0))
 969                            (cond ((and (boundp 'xemacs-betaname)
 970                                        xemacs-betaname)
 971                                   ;; It does not exist in XEmacs
 972                                   ;; versions prior to 20.3.
 973                                   (concat " " xemacs-betaname))
 974                                  ((and (boundp 'emacs-patch-level)
 975                                        emacs-patch-level)
 976                                   ;; It does not exist in FSF Emacs or in
 977                                   ;; XEmacs versions earlier than 21.1.1.
 978                                   (format " (patch %d)" emacs-patch-level))
 979                                  (t ""))
 980                            " (" xemacs-codename ")"
 981                            ;; `xemacs-extra-name' has appeared in the
 982                            ;; development version of XEmacs 21.5-b8.
 983                            (if (and (boundp 'xemacs-extra-name)
 984                                     (symbol-value 'xemacs-extra-name))
 985                                (concat " " (symbol-value 'xemacs-extra-name))
 986                              "")
 987                            " ("
 988                            system-configuration ")")
 989                         " (" emacs-version ")"))
 990             (let ((ver (if (string-match "\\.[0-9]+$" emacs-version)
 991                            (substring emacs-version 0 (match-beginning 0))
 992                          emacs-version)))
 993               (if (featurep 'mule)
 994                   (if (boundp 'enable-multibyte-characters)
 995                       (concat "Emacs/" ver
 996                               " (" system-configuration ")"
 997                               (if enable-multibyte-characters
 998                                   (concat " MULE/" mule-version)
 999                                 " (with unibyte mode)")
1000                               (if (featurep 'meadow)
1001                                   (let ((mver (Meadow-version)))
1002                                     (if (string-match "^Meadow-" mver)
1003                                         (concat " Meadow/"
1004                                                 (substring mver
1005                                                            (match-end 0)))
1006                                       ))))
1007                     (concat "MULE/" mule-version
1008                             " (based on Emacs " ver ")"))
1009                 (concat "Emacs/" ver " (" system-configuration ")")))))
1010   "Body of User-Agent field.
1011 If variable `mime-edit-insert-user-agent-field' is not nil, it is
1012 inserted into message header.")
1013
1014 \f
1015 ;;; @ constants
1016 ;;;
1017
1018 (defconst mime-tspecials-regexp "[][()<>@,;:\\\"/?.= \t]"
1019   "*Specify MIME tspecials.
1020 Tspecials means any character that matches with it in header must be quoted.")
1021
1022 (defconst mime-edit-mime-version-value
1023   (concat "1.0 (generated by " mime-edit-version ")")
1024   "MIME version number.")
1025
1026 (defconst mime-edit-mime-version-field-for-message/partial
1027   (concat "MIME-Version:"
1028           (mime-encode-field-body
1029            (concat " 1.0 (split by " mime-edit-version ")\n")
1030            "MIME-Version"))
1031   "MIME version field for message/partial.")
1032
1033
1034 ;;; @ keymap and menu
1035 ;;;
1036
1037 (defvar mime-edit-mode-flag nil)
1038 (make-variable-buffer-local 'mime-edit-mode-flag)
1039
1040 (defvar mime-edit-mode-entity-prefix "\C-c\C-x"
1041   "Keymap prefix for MIME-Edit mode commands to insert entity or set status.")
1042 (defvar mime-edit-mode-entity-map (make-sparse-keymap)
1043   "Keymap for MIME-Edit mode commands to insert entity or set status.")
1044
1045 (define-key mime-edit-mode-entity-map "\C-t" 'mime-edit-insert-text)
1046 (define-key mime-edit-mode-entity-map "\C-i" 'mime-edit-insert-file)
1047 (define-key mime-edit-mode-entity-map "\C-e" 'mime-edit-insert-external)
1048 (define-key mime-edit-mode-entity-map "\C-v" 'mime-edit-insert-voice)
1049 (define-key mime-edit-mode-entity-map "\C-y" 'mime-edit-insert-message)
1050 (define-key mime-edit-mode-entity-map "\C-m" 'mime-edit-insert-mail)
1051 (define-key mime-edit-mode-entity-map "\C-w" 'mime-edit-insert-signature)
1052 (define-key mime-edit-mode-entity-map "\C-s" 'mime-edit-insert-signature)
1053 (define-key mime-edit-mode-entity-map "\C-k" 'mime-edit-insert-key)
1054 (define-key mime-edit-mode-entity-map "t"    'mime-edit-insert-tag)
1055
1056 (define-key mime-edit-mode-entity-map "7" 'mime-edit-set-transfer-level-7bit)
1057 (define-key mime-edit-mode-entity-map "8" 'mime-edit-set-transfer-level-8bit)
1058 (define-key mime-edit-mode-entity-map "/" 'mime-edit-set-split)
1059 (define-key mime-edit-mode-entity-map "s" 'mime-edit-set-sign)
1060 (define-key mime-edit-mode-entity-map "v" 'mime-edit-set-sign)
1061 (define-key mime-edit-mode-entity-map "e" 'mime-edit-set-encrypt)
1062 (define-key mime-edit-mode-entity-map "h" 'mime-edit-set-encrypt)
1063 (define-key mime-edit-mode-entity-map "p" 'mime-edit-preview-message)
1064 (define-key mime-edit-mode-entity-map "\C-z" 'mime-edit-exit)
1065 (define-key mime-edit-mode-entity-map "?" 'mime-edit-help)
1066
1067 (defvar mime-edit-mode-enclosure-prefix "\C-c\C-m"
1068   "Keymap prefix for MIME-Edit mode commands about enclosure.")
1069 (defvar mime-edit-mode-enclosure-map (make-sparse-keymap)
1070   "Keymap for MIME-Edit mode commands about enclosure.")
1071
1072 (define-key mime-edit-mode-enclosure-map
1073   "\C-a" 'mime-edit-enclose-alternative-region)
1074 (define-key mime-edit-mode-enclosure-map
1075   "\C-p" 'mime-edit-enclose-parallel-region)
1076 (define-key mime-edit-mode-enclosure-map
1077   "\C-m" 'mime-edit-enclose-mixed-region)
1078 (define-key mime-edit-mode-enclosure-map
1079   "\C-d" 'mime-edit-enclose-digest-region)
1080 (define-key mime-edit-mode-enclosure-map
1081   "\C-s" 'mime-edit-enclose-pgp-signed-region)
1082 (define-key mime-edit-mode-enclosure-map
1083   "\C-e" 'mime-edit-enclose-pgp-encrypted-region)
1084 (define-key mime-edit-mode-enclosure-map
1085   "\C-q" 'mime-edit-enclose-quote-region)
1086
1087 (defvar mime-edit-mode-map (make-sparse-keymap)
1088   "Keymap for MIME-Edit mode commands.")
1089 (define-key mime-edit-mode-map
1090   mime-edit-mode-entity-prefix mime-edit-mode-entity-map)
1091 (define-key mime-edit-mode-map
1092   mime-edit-mode-enclosure-prefix mime-edit-mode-enclosure-map)
1093
1094 (defconst mime-edit-menu-title "MIME-Edit")
1095
1096 (defconst mime-edit-menu-list
1097   '((mime-help  "Describe MIME editor mode" mime-edit-help)
1098     (file       "Insert File"           mime-edit-insert-file)
1099     (external   "Insert External"       mime-edit-insert-external)
1100     (voice      "Insert Voice"          mime-edit-insert-voice)
1101     (message    "Insert Message"        mime-edit-insert-message)
1102     (mail       "Insert Mail"           mime-edit-insert-mail)
1103     (signature  "Insert Signature"      mime-edit-insert-signature)
1104     (text       "Insert Text"           mime-edit-insert-text)
1105     (tag        "Insert Tag"            mime-edit-insert-tag)
1106     (alternative "Enclose as alternative"
1107                  mime-edit-enclose-alternative-region)
1108     (parallel   "Enclose as parallel"   mime-edit-enclose-parallel-region)
1109     (mixed      "Enclose as serial"     mime-edit-enclose-mixed-region)
1110     (digest     "Enclose as digest"     mime-edit-enclose-digest-region)
1111     (signed     "Enclose as signed"     mime-edit-enclose-pgp-signed-region)
1112     (encrypted  "Enclose as encrypted"  mime-edit-enclose-pgp-encrypted-region)
1113     (quote      "Verbatim region"       mime-edit-enclose-quote-region)
1114     (key        "Insert Public Key"     mime-edit-insert-key)
1115     (split      "Set splitting"         mime-edit-set-split)
1116     (sign       "PGP sign"              mime-edit-set-sign)
1117     (encrypt    "PGP encrypt"           mime-edit-set-encrypt)
1118     (preview    "Preview Message"       mime-edit-preview-message)
1119     (level      "Toggle transfer-level" mime-edit-toggle-transfer-level)
1120     )
1121   "MIME-edit menubar entry.")
1122
1123 (cond ((featurep 'xemacs)
1124        ;; modified by Pekka Marjola <pema@iki.fi>
1125        ;;       1995/9/5 (c.f. [tm-en:69])
1126        (defun mime-edit-define-menu-for-xemacs ()
1127          "Define menu for XEmacs."
1128          (cond ((featurep 'menubar)
1129                 (make-local-variable 'current-menubar)
1130                 (set-buffer-menubar current-menubar)
1131                 (add-submenu
1132                  nil
1133                  (cons mime-edit-menu-title
1134                        (mapcar (function
1135                                 (lambda (item)
1136                                   (vector (nth 1 item)(nth 2 item)
1137                                           mime-edit-mode-flag)
1138                                   ))
1139                                mime-edit-menu-list)))
1140                 )))
1141
1142        ;; modified by Steven L. Baur <steve@miranova.com>
1143        ;;       1995/12/6 (c.f. [tm-en:209])
1144        (or (boundp 'mime-edit-popup-menu-for-xemacs)
1145            (setq mime-edit-popup-menu-for-xemacs
1146                  (append '("MIME Commands" "---")
1147                          (mapcar (function (lambda (item)
1148                                              (vector (nth 1 item)
1149                                                      (nth 2 item)
1150                                                      t)))
1151                                  mime-edit-menu-list)))
1152            )
1153        )
1154       ((>= emacs-major-version 19)
1155        (define-key mime-edit-mode-map [menu-bar mime-edit]
1156          (cons mime-edit-menu-title
1157                (make-sparse-keymap mime-edit-menu-title)))
1158        (mapcar (function
1159                 (lambda (item)
1160                   (define-key mime-edit-mode-map
1161                     (vector 'menu-bar 'mime-edit (car item))
1162                     (cons (nth 1 item)(nth 2 item))
1163                     )
1164                   ))
1165                (reverse mime-edit-menu-list)
1166                )
1167        ))
1168
1169
1170 ;;; @ functions
1171 ;;;
1172
1173 (defvar mime-edit-touched-flag nil)
1174
1175 ;;;###autoload
1176 (defun mime-edit-mode ()
1177   "MIME minor mode for editing the tagged MIME message.
1178
1179 In this mode, basically, the message is composed in the tagged MIME
1180 format. The message tag looks like:
1181
1182         --[[text/plain; charset=ISO-2022-JP][7bit]]
1183
1184 The tag specifies the MIME content type, subtype, optional parameters
1185 and transfer encoding of the message following the tag.  Messages
1186 without any tag are treated as `text/plain' by default.  Charset and
1187 transfer encoding are automatically defined unless explicitly
1188 specified.  Binary messages such as audio and image are usually
1189 hidden.  The messages in the tagged MIME format are automatically
1190 translated into a MIME compliant message when exiting this mode.
1191
1192 Available charsets depend on Emacs version being used.  The following
1193 lists the available charsets of each emacs.
1194
1195 Without mule:   US-ASCII and ISO-8859-1 (or other charset) are available.
1196 With mule:      US-ASCII, ISO-8859-* (except for ISO-8859-5), KOI8-R,
1197                 ISO-2022-JP, ISO-2022-JP-2, EUC-KR, CN-GB-2312,
1198                 CN-BIG5 and ISO-2022-INT-1 are available.
1199
1200 ISO-2022-JP-2 and ISO-2022-INT-1 charsets used in mule is expected to
1201 be used to represent multilingual text in intermixed manner.  Any
1202 languages that has no registered charset are represented as either
1203 ISO-2022-JP-2 or ISO-2022-INT-1 in mule.
1204
1205 If you want to use non-ISO-8859-1 charset in Emacs 19 or XEmacs
1206 without mule, please set variable `default-mime-charset'.  This
1207 variable must be symbol of which name is a MIME charset.
1208
1209 If you want to add more charsets in mule, please set variable
1210 `charsets-mime-charset-alist'.  This variable must be alist of which
1211 key is list of charset and value is symbol of MIME charset.  If name
1212 of coding-system is different as MIME charset, please set variable
1213 `mime-charset-coding-system-alist'.  This variable must be alist of
1214 which key is MIME charset and value is coding-system.
1215
1216 Following commands are available in addition to major mode commands:
1217
1218 \[make single part\]
1219 \\[mime-edit-insert-text]       insert a text message.
1220 \\[mime-edit-insert-file]       insert a (binary) file.
1221 \\[mime-edit-insert-external]   insert a reference to external body.
1222 \\[mime-edit-insert-voice]      insert a voice message.
1223 \\[mime-edit-insert-message]    insert a mail or news message.
1224 \\[mime-edit-insert-mail]       insert a mail message.
1225 \\[mime-edit-insert-signature]  insert a signature file at end.
1226 \\[mime-edit-insert-key]        insert PGP public key.
1227 \\[mime-edit-insert-tag]        insert a new MIME tag.
1228
1229 \[make enclosure (maybe multipart)\]
1230 \\[mime-edit-enclose-alternative-region]   enclose as multipart/alternative.
1231 \\[mime-edit-enclose-parallel-region]      enclose as multipart/parallel.
1232 \\[mime-edit-enclose-mixed-region]         enclose as multipart/mixed.
1233 \\[mime-edit-enclose-digest-region]        enclose as multipart/digest.
1234 \\[mime-edit-enclose-pgp-signed-region]    enclose as PGP signed.
1235 \\[mime-edit-enclose-pgp-encrypted-region] enclose as PGP encrypted.
1236 \\[mime-edit-enclose-quote-region]         enclose as verbose mode
1237                                            (to avoid to expand tags)
1238
1239 \[other commands\]
1240 \\[mime-edit-set-transfer-level-7bit]   set transfer-level as 7.
1241 \\[mime-edit-set-transfer-level-8bit]   set transfer-level as 8.
1242 \\[mime-edit-set-split]                 set message splitting mode.
1243 \\[mime-edit-set-sign]                  set PGP-sign mode.
1244 \\[mime-edit-set-encrypt]               set PGP-encryption mode.
1245 \\[mime-edit-preview-message]           preview editing MIME message.
1246 \\[mime-edit-exit]                      exit and translate into a MIME
1247                                         compliant message.
1248 \\[mime-edit-help]                      show this help.
1249 \\[mime-edit-maybe-translate]           exit and translate if in MIME mode,
1250                                         then split.
1251
1252 Additional commands are available in some major modes:
1253 C-c C-c         exit, translate and run the original command.
1254 C-c C-s         exit, translate and run the original command.
1255
1256 The following is a message example written in the tagged MIME format.
1257 TABs at the beginning of the line are not a part of the message:
1258
1259         This is a conventional plain text.  It should be translated
1260         into text/plain.
1261         --[[text/plain]]
1262         This is also a plain text.  But, it is explicitly specified as
1263         is.
1264         --[[text/plain; charset=ISO-8859-1]]
1265         This is also a plain text.  But charset is specified as
1266         iso-8859-1.
1267
1268         ¡Hola!  Buenos días.  ¿Cómo está usted?
1269         --[[text/enriched]]
1270         This is a <bold>enriched text</bold>.
1271         --[[image/gif][base64]]...image encoded in base64 here...
1272         --[[audio/basic][base64]]...audio encoded in base64 here...
1273
1274 User customizable variables (not documented all of them):
1275  mime-edit-prefix
1276     Specifies a key prefix for MIME minor mode commands.
1277
1278  mime-ignore-preceding-spaces
1279     Preceding white spaces in a message body are ignored if non-nil.
1280
1281  mime-ignore-trailing-spaces
1282     Trailing white spaces in a message body are ignored if non-nil.
1283
1284  mime-auto-hide-body
1285     Hide a non-textual body message encoded in base64 after insertion
1286     if non-nil.
1287
1288  mime-transfer-level
1289     A number of network transfer level.  It should be bigger than 7.
1290     If you are in 8bit-through environment, please set 8.
1291
1292  mime-edit-voice-recorder
1293     Specifies a function to record a voice message and encode it.
1294     The function `mime-edit-voice-recorder-for-sun' is for Sun
1295     SparcStations.
1296
1297  mime-edit-mode-hook
1298     Turning on MIME mode calls the value of mime-edit-mode-hook, if
1299     it is non-nil.
1300
1301  mime-edit-translate-hook
1302     The value of mime-edit-translate-hook is called just before translating
1303     the tagged MIME format into a MIME compliant message if it is
1304     non-nil.  If the hook call the function mime-edit-insert-signature,
1305     the signature file will be inserted automatically.
1306
1307  mime-edit-exit-hook
1308     Turning off MIME mode calls the value of mime-edit-exit-hook, if it is
1309     non-nil."
1310   (interactive)
1311   (if mime-edit-mode-flag
1312       (mime-edit-exit)
1313     (if mime-edit-touched-flag
1314         (mime-edit-again)
1315       (make-local-variable 'mime-edit-touched-flag)
1316       (setq mime-edit-touched-flag t)
1317       (turn-on-mime-edit)
1318       )))
1319
1320
1321 (cond ((featurep 'xemacs)
1322        (add-minor-mode 'mime-edit-mode-flag
1323                        '((" MIME-Edit "  mime-transfer-level-string))
1324                        mime-edit-mode-map
1325                        nil
1326                        'mime-edit-mode)
1327        )
1328       (t
1329        (set-alist 'minor-mode-alist
1330                   'mime-edit-mode-flag
1331                   '((" MIME-Edit "  mime-transfer-level-string)))
1332        (set-alist 'minor-mode-map-alist
1333                   'mime-edit-mode-flag
1334                   mime-edit-mode-map)
1335        ))
1336
1337
1338 ;;;###autoload
1339 (defun turn-on-mime-edit ()
1340   "Unconditionally turn on MIME-Edit mode."
1341   (interactive)
1342   (if mime-edit-mode-flag
1343       (error "You are already editing a MIME message.")
1344     (setq mime-edit-mode-flag t)
1345
1346     ;; Set transfer level into mode line
1347     ;;
1348     (setq mime-transfer-level-string
1349           (mime-encoding-name mime-transfer-level 'not-omit))
1350     (force-mode-line-update)
1351
1352     ;; Define menu for XEmacs.
1353     (if (featurep 'xemacs)
1354         (mime-edit-define-menu-for-xemacs)
1355       )
1356
1357     (enable-invisible)
1358
1359     (make-local-variable 'paragraph-start)
1360     (setq paragraph-start
1361           (regexp-or mime-edit-single-part-tag-regexp
1362                      paragraph-start))
1363     (make-local-variable 'paragraph-separate)
1364     (setq paragraph-separate
1365           (regexp-or mime-edit-single-part-tag-regexp
1366                      paragraph-separate))
1367     (run-hooks 'mime-edit-mode-hook)
1368     (message
1369      "%s"
1370      (substitute-command-keys
1371       "Type \\[mime-edit-exit] to exit MIME mode, and type \\[mime-edit-help] to get help."))
1372     ))
1373
1374 ;;;###autoload
1375 (defalias 'edit-mime 'turn-on-mime-edit) ; for convenience
1376
1377
1378 (defun mime-edit-exit (&optional nomime no-error)
1379   "Translate the tagged MIME message into a MIME compliant message.
1380 With no argument encode a message in the buffer into MIME, otherwise
1381 just return to previous mode."
1382   (interactive "P")
1383   (if (not mime-edit-mode-flag)
1384       (if (null no-error)
1385           (error "You aren't editing a MIME message.")
1386         )
1387     (if (not nomime)
1388         (progn
1389           (run-hooks 'mime-edit-translate-hook)
1390           (mime-edit-translate-buffer)))
1391     ;; Restore previous state.
1392     (setq mime-edit-mode-flag nil)
1393     (if (and (featurep 'xemacs)
1394              (featurep 'menubar))
1395         (delete-menu-item (list mime-edit-menu-title))
1396       )
1397     (end-of-invisible)
1398     (set-buffer-modified-p (buffer-modified-p))
1399     (run-hooks 'mime-edit-exit-hook)
1400     (message "Exit MIME editor mode.")
1401     ))
1402
1403 (defun mime-edit-maybe-translate ()
1404   (interactive)
1405   (mime-edit-exit nil t)
1406   (call-interactively 'mime-edit-maybe-split-and-send)
1407   )
1408
1409 (defun mime-edit-help ()
1410   "Show help message about MIME mode."
1411   (interactive)
1412   (with-output-to-temp-buffer "*Help*"
1413     (princ "MIME editor mode:\n")
1414     (princ (documentation 'mime-edit-mode))
1415     (print-help-return-message)))
1416
1417 (defun mime-edit-insert-text (&optional subtype)
1418   "Insert a text message.
1419 Charset is automatically obtained from the `charsets-mime-charset-alist'.
1420 If optional argument SUBTYPE is not nil, text/SUBTYPE tag is inserted."
1421   (interactive)
1422   (let ((ret (mime-edit-insert-tag "text" subtype nil)))
1423     (when ret
1424       (if (looking-at mime-edit-single-part-tag-regexp)
1425           (progn
1426             ;; Make a space between the following message.
1427             (insert "\n")
1428             (forward-char -1)
1429             ))
1430       (if (and (member (cadr ret) '("enriched"))
1431                (fboundp 'enriched-mode))
1432           (enriched-mode t)
1433         (if (boundp 'enriched-mode)
1434             (enriched-mode -1)
1435           ))
1436       )))
1437
1438 (defun mime-edit-insert-file (file &optional verbose)
1439   "Insert a message from a file."
1440   (interactive "fInsert file as MIME message: \nP")
1441   (let*  ((guess (mime-find-file-type file))
1442           (type (nth 0 guess))
1443           (subtype (nth 1 guess))
1444           (parameters (nth 2 guess))
1445           (encoding (nth 3 guess))
1446           (disposition-type (nth 4 guess))
1447           (disposition-params (nth 5 guess))
1448           )
1449     (if (or (interactive-p) verbose)
1450         (setq type (mime-prompt-for-type type)
1451               subtype (mime-prompt-for-subtype type subtype)
1452               encoding (mime-prompt-for-encoding encoding)))
1453     (if (or (consp parameters) (stringp disposition-type))
1454         (let ((rest parameters) cell attribute value)
1455           (setq parameters "")
1456           (while rest
1457             (setq cell (car rest))
1458             (setq attribute (car cell))
1459             (setq value (cdr cell))
1460             (if (eq value 'file)
1461                 (setq value (std11-wrap-as-quoted-string
1462                              (file-name-nondirectory file)))
1463               )
1464             (setq parameters (concat parameters "; " attribute "=" value))
1465             (setq rest (cdr rest))
1466             )
1467           (if disposition-type
1468               (progn
1469                 (setq parameters
1470                       (concat parameters "\n"
1471                               "Content-Disposition: " disposition-type))
1472                 (setq rest disposition-params)
1473                 (while rest
1474                   (setq cell (car rest))
1475                   (setq attribute (car cell))
1476                   (setq value (cdr cell))
1477                   (if (eq value 'file)
1478                       (setq value (std11-wrap-as-quoted-string
1479                                    (file-name-nondirectory file)))
1480                     )
1481                   (setq parameters
1482                         (concat parameters "; " attribute "=" value))
1483                   (setq rest (cdr rest))
1484                   )
1485                 ))
1486           ))
1487     (mime-edit-insert-tag type subtype parameters)
1488     (mime-edit-insert-binary-file file encoding)
1489     ))
1490
1491 (defun mime-edit-insert-external ()
1492   "Insert a reference to external body."
1493   (interactive)
1494   (mime-edit-insert-tag "message" "external-body" nil ";\n\t")
1495   ;;(forward-char -1)
1496   ;;(insert "Content-Description: " (read-string "Content-Description: ") "\n")
1497   ;;(forward-line 1)
1498   (let* ((pritype (mime-prompt-for-type))
1499          (subtype (mime-prompt-for-subtype pritype))
1500          (parameters (mime-prompt-for-parameters pritype subtype ";\n\t")))
1501     (and pritype
1502          subtype
1503          (insert "Content-Type: "
1504                  pritype "/" subtype (or parameters "") "\n")))
1505   (if (and (not (eobp))
1506            (not (looking-at mime-edit-single-part-tag-regexp)))
1507       (insert (mime-make-text-tag) "\n")))
1508
1509 (defun mime-edit-insert-voice ()
1510   "Insert a voice message."
1511   (interactive)
1512   (let ((encoding
1513          (completing-read
1514           "What transfer encoding: "
1515           (mime-encoding-alist) nil t nil)))
1516     (mime-edit-insert-tag "audio" "basic" nil)
1517     (mime-edit-define-encoding encoding)
1518     (save-restriction
1519       (narrow-to-region (1- (point))(point))
1520       (unwind-protect
1521           (funcall mime-edit-voice-recorder encoding)
1522         (progn
1523           (insert "\n")
1524           (invisible-region (point-min)(point-max))
1525           (goto-char (point-max))
1526           )))))
1527
1528 (defun mime-edit-insert-signature (&optional arg)
1529   "Insert a signature file."
1530   (interactive "P")
1531   (let ((signature-insert-hook
1532          (function
1533           (lambda ()
1534             (let ((items (mime-find-file-type signature-file-name)))
1535               (apply (function mime-edit-insert-tag)
1536                      (car items) (cadr items) (list (caddr items))))
1537             )))
1538         )
1539     (insert-signature arg)
1540     ))
1541
1542 \f
1543 ;; Insert a new tag around a point.
1544
1545 (defun mime-edit-insert-tag (&optional pritype subtype parameters delimiter)
1546   "Insert new MIME tag and return a list of PRITYPE, SUBTYPE, and PARAMETERS.
1547 If nothing is inserted, return nil."
1548   (interactive)
1549   (let ((p (point)))
1550     (mime-edit-goto-tag)
1551     (if (and (re-search-forward mime-edit-tag-regexp nil t)
1552              (< (match-beginning 0) p)
1553              (< p (match-end 0))
1554              )
1555         (goto-char (match-beginning 0))
1556       (goto-char p)
1557       ))
1558   (let ((oldtag nil)
1559         (newtag nil)
1560         (current (point))
1561         )
1562     (setq pritype
1563           (or pritype
1564               (mime-prompt-for-type)))
1565     (setq subtype
1566           (or subtype
1567               (mime-prompt-for-subtype pritype)))
1568     (setq parameters
1569           (or parameters
1570               (mime-prompt-for-parameters pritype subtype delimiter)))
1571     ;; Make a new MIME tag.
1572     (setq newtag (mime-make-tag pritype subtype parameters))
1573     ;; Find an current MIME tag.
1574     (setq oldtag
1575           (save-excursion
1576             (if (mime-edit-goto-tag)
1577                 (buffer-substring (match-beginning 0) (match-end 0))
1578               ;; Assume content type is 'text/plan'.
1579               (mime-make-tag "text" "plain")
1580               )))
1581     ;; We are only interested in TEXT.
1582     (if (and oldtag
1583              (not (mime-test-content-type
1584                    (mime-edit-get-contype oldtag) "text")))
1585         (setq oldtag nil))
1586     ;; Make a new tag.
1587     (if (or (not oldtag)                ;Not text
1588             (or mime-ignore-same-text-tag
1589                 (not (string-equal oldtag newtag))))
1590         (progn
1591           ;; Mark the beginning of the tag for convenience.
1592           (push-mark (point) 'nomsg)
1593           (insert newtag "\n")
1594           (list pritype subtype parameters) ;New tag is created.
1595           )
1596       ;; Restore previous point.
1597       (goto-char current)
1598       nil                               ;Nothing is created.
1599       )
1600     ))
1601
1602 (defun mime-edit-insert-binary-file (file &optional encoding)
1603   "Insert binary FILE at point.
1604 Optional argument ENCODING specifies an encoding method such as base64."
1605   (let* ((tagend (1- (point)))          ;End of the tag
1606          (hide-p (and mime-auto-hide-body
1607                       (stringp encoding)
1608                       (not
1609                        (let ((en (downcase encoding)))
1610                          (or (string-equal en "7bit")
1611                              (string-equal en "8bit")
1612                              (string-equal en "binary")
1613                              )))))
1614          )
1615     (save-restriction
1616       (narrow-to-region tagend (point))
1617       (mime-insert-encoded-file file encoding)
1618       (if hide-p
1619           (progn
1620             (invisible-region (point-min) (point-max))
1621             (goto-char (point-max))
1622             )
1623         (goto-char (point-max))
1624         ))
1625     (or hide-p
1626         (looking-at mime-edit-tag-regexp)
1627         (= (point)(point-max))
1628         (mime-edit-insert-tag "text" "plain")
1629         )
1630     ;; Define encoding even if it is 7bit.
1631     (if (stringp encoding)
1632         (save-excursion
1633           (goto-char tagend) ; Make sure which line the tag is on.
1634           (mime-edit-define-encoding encoding)
1635           ))
1636     ))
1637
1638 \f
1639 ;; Commands work on a current message flagment.
1640
1641 (defun mime-edit-goto-tag ()
1642   "Search for the beginning of the tagged MIME message."
1643   (let ((current (point)))
1644     (if (looking-at mime-edit-tag-regexp)
1645         t
1646       ;; At first, go to the end.
1647       (cond ((re-search-forward mime-edit-beginning-tag-regexp nil t)
1648              (goto-char (1- (match-beginning 0))) ;For multiline tag
1649              )
1650             (t
1651              (goto-char (point-max))
1652              ))
1653       ;; Then search for the beginning.
1654       (re-search-backward mime-edit-end-tag-regexp nil t)
1655       (or (looking-at mime-edit-beginning-tag-regexp)
1656           ;; Restore previous point.
1657           (progn
1658             (goto-char current)
1659             nil
1660             ))
1661       )))
1662
1663 (defun mime-edit-content-beginning ()
1664   "Return the point of the beginning of content."
1665   (save-excursion
1666     (let ((beg (save-excursion
1667                  (beginning-of-line) (point))))
1668       (if (mime-edit-goto-tag)
1669           (let ((top (point)))
1670             (goto-char (match-end 0))
1671             (if (and (= beg top)
1672                      (= (following-char) ?\^M))
1673                 (point)
1674               (forward-line 1)
1675               (point)))
1676         ;; Default text/plain tag.
1677         (goto-char (point-min))
1678         (re-search-forward
1679          (concat "\n" (regexp-quote mail-header-separator)
1680                  (if mime-ignore-preceding-spaces
1681                      "[ \t\n]*\n" "\n")) nil 'move)
1682         (point))
1683       )))
1684
1685 (defun mime-edit-content-end ()
1686   "Return the point of the end of content."
1687   (save-excursion
1688     (if (mime-edit-goto-tag)
1689         (progn
1690           (goto-char (match-end 0))
1691           (if (invisible-p (point))
1692               (next-visible-point (point))
1693             ;; Move to the end of this text.
1694             (if (re-search-forward mime-edit-tag-regexp nil 'move)
1695                 ;; Don't forget a multiline tag.
1696                 (goto-char (match-beginning 0))
1697               )
1698             (point)
1699             ))
1700       ;; Assume the message begins with text/plain.
1701       (goto-char (mime-edit-content-beginning))
1702       (if (re-search-forward mime-edit-tag-regexp nil 'move)
1703           ;; Don't forget a multiline tag.
1704           (goto-char (match-beginning 0)))
1705       (point))
1706     ))
1707
1708 (defun mime-edit-define-charset (charset)
1709   "Set charset of current tag to CHARSET."
1710   (save-excursion
1711     (if (mime-edit-goto-tag)
1712         (let ((tag (buffer-substring (match-beginning 0) (match-end 0))))
1713           (delete-region (match-beginning 0) (match-end 0))
1714           (insert
1715            (mime-create-tag
1716             (mime-edit-set-parameter
1717              (mime-edit-get-contype tag)
1718              "charset"
1719              (let ((comment (get charset 'mime-charset-comment)))
1720                (if comment
1721                    (concat (upcase (symbol-name charset)) " (" comment ")")
1722                  (upcase (symbol-name charset)))))
1723             (mime-edit-get-encoding tag)))
1724           ))))
1725
1726 (defun mime-edit-define-encoding (encoding)
1727   "Set encoding of current tag to ENCODING."
1728   (save-excursion
1729     (if (mime-edit-goto-tag)
1730         (let ((tag (buffer-substring (match-beginning 0) (match-end 0))))
1731           (delete-region (match-beginning 0) (match-end 0))
1732           (insert (mime-create-tag (mime-edit-get-contype tag) encoding)))
1733       )))
1734
1735 (defun mime-edit-choose-charset ()
1736   "Choose charset of a text following current point."
1737   (detect-mime-charset-region (point) (mime-edit-content-end))
1738   )
1739
1740 (defun mime-make-text-tag (&optional subtype)
1741   "Make a tag for a text after current point.
1742 Subtype of text type can be specified by an optional argument SUBTYPE.
1743 Otherwise, it is obtained from mime-content-types."
1744   (let* ((pritype "text")
1745          (subtype (or subtype
1746                       (car (car (cdr (assoc pritype mime-content-types)))))))
1747     ;; Charset should be defined later.
1748     (mime-make-tag pritype subtype)))
1749
1750 \f
1751 ;; Tag handling functions
1752
1753 (defun mime-make-tag (pritype subtype &optional parameters encoding)
1754   "Make a tag of MIME message of PRITYPE, SUBTYPE and optional PARAMETERS."
1755   (mime-create-tag (concat (or pritype "") "/" (or subtype "")
1756                            (or parameters ""))
1757                    encoding))
1758
1759 (defun mime-create-tag (contype &optional encoding)
1760   "Make a tag with CONTENT-TYPE and optional ENCODING."
1761   (format (if encoding mime-tag-format-with-encoding mime-tag-format)
1762           contype encoding))
1763
1764 (defun mime-edit-get-contype (tag)
1765   "Return Content-Type (including parameters) of TAG."
1766   (and (stringp tag)
1767        (or (string-match mime-edit-single-part-tag-regexp tag)
1768            (string-match mime-edit-multipart-beginning-regexp tag)
1769            (string-match mime-edit-multipart-end-regexp tag)
1770            )
1771        (substring tag (match-beginning 1) (match-end 1))
1772        ))
1773
1774 (defun mime-edit-get-encoding (tag)
1775   "Return encoding of TAG."
1776   (and (stringp tag)
1777        (string-match mime-edit-single-part-tag-regexp tag)
1778        (match-beginning 3)
1779        (not (= (match-beginning 3) (match-end 3)))
1780        (substring tag (match-beginning 3) (match-end 3))))
1781
1782 (defun mime-get-parameter (contype parameter)
1783   "For given CONTYPE return value for PARAMETER.
1784 Nil if no such parameter."
1785   (if (string-match
1786        (concat
1787         ";[ \t\n]*"
1788         (regexp-quote parameter)
1789         "[ \t\n]*=[ \t\n]*\\([^\" \t\n;]*\\|\"[^\"]*\"\\)\\([ \t\n]*;\\|$\\)")
1790        contype)
1791       (substring contype (match-beginning 1) (match-end 1))
1792     nil                                 ;No such parameter
1793     ))
1794
1795 (defun mime-edit-set-parameter (contype parameter value)
1796   "For given CONTYPE set PARAMETER to VALUE."
1797   (let (ctype opt-fields)
1798     (if (string-match "\n[^ \t\n\r]+:" contype)
1799         (setq ctype (substring contype 0 (match-beginning 0))
1800               opt-fields (substring contype (match-beginning 0)))
1801       (setq ctype contype)
1802       )
1803     (if (string-match
1804          (concat
1805           ";[ \t\n]*\\("
1806           (regexp-quote parameter)
1807           "[ \t\n]*=[ \t\n]*\\([^\" \t\n;]*\\|\"[^\"]*\"\\)\\)[ \t\n]*\\(;\\|$\\)")
1808          ctype)
1809         ;; Change value
1810         (concat (substring ctype 0 (match-beginning 1))
1811                 parameter "=" value
1812                 (substring ctype (match-end 1))
1813                 opt-fields)
1814       (concat ctype "; " parameter "=" value opt-fields)
1815       )))
1816
1817 (defun mime-strip-parameters (contype)
1818   "Return primary content-type and subtype without parameters for CONTYPE."
1819   (if (string-match "^[ \t]*\\([^; \t\n]*\\)" contype)
1820       (substring contype (match-beginning 1) (match-end 1)) nil))
1821
1822 (defun mime-test-content-type (contype type &optional subtype)
1823   "Test if CONTYPE is a TYPE and an optional SUBTYPE."
1824   (and (stringp contype)
1825        (stringp type)
1826        (string-match
1827         (concat "^[ \t]*" (downcase type) "/" (downcase (or subtype "")))
1828         (downcase contype))))
1829
1830 \f
1831 ;; Basic functions
1832
1833 (defun mime-find-file-type (file)
1834   "Guess Content-Type, subtype, and parameters from FILE."
1835   (let ((guess nil)
1836         (guesses mime-file-types))
1837     (while (and (not guess) guesses)
1838       (if (string-match (car (car guesses)) file)
1839           (setq guess (cdr (car guesses))))
1840       (setq guesses (cdr guesses)))
1841     guess
1842     ))
1843
1844 (defun mime-prompt-for-type (&optional default)
1845   "Ask for Content-type."
1846   (let ((type ""))
1847     ;; Repeat until primary content type is specified.
1848     (while (string-equal type "")
1849       (setq type
1850             (completing-read "What content type: "
1851                              mime-content-types
1852                              nil
1853                              'require-match ;Type must be specified.
1854                              default
1855                              ))
1856       (if (string-equal type "")
1857           (progn
1858             (message "Content type is required.")
1859             (beep)
1860             (sit-for 1)
1861             ))
1862       )
1863     type))
1864
1865 (defun mime-prompt-for-subtype (type &optional default)
1866   "Ask for subtype of media-type TYPE."
1867   (let ((subtypes (cdr (assoc type mime-content-types))))
1868     (or (and default
1869              (assoc default subtypes))
1870         (setq default (car (car subtypes)))
1871         ))
1872   (let* ((answer
1873           (completing-read
1874            (if default
1875                (concat
1876                 "What content subtype: (default " default ") ")
1877              "What content subtype: ")
1878            (cdr (assoc type mime-content-types))
1879            nil
1880            'require-match               ;Subtype must be specified.
1881            nil
1882            )))
1883     (if (string-equal answer "") default answer)))
1884
1885 (defun mime-prompt-for-parameters (pritype subtype &optional delimiter)
1886   "Ask for Content-type parameters of Content-Type PRITYPE and SUBTYPE.
1887 Optional DELIMITER specifies parameter delimiter (';' by default)."
1888   (let* ((delimiter (or delimiter "; "))
1889          (parameters
1890           (mapconcat
1891            (function identity)
1892            (delq nil
1893                  (mime-prompt-for-parameters-1
1894                   (cdr (assoc subtype
1895                               (cdr (assoc pritype mime-content-types))))))
1896            delimiter
1897            )))
1898     (if (and (stringp parameters)
1899              (not (string-equal parameters "")))
1900         (concat delimiter parameters)
1901       ""                                ;"" if no parameters
1902       )))
1903
1904 (defun mime-prompt-for-parameters-1 (optlist)
1905   (apply (function append)
1906          (mapcar (function mime-prompt-for-parameter) optlist)))
1907
1908 (defun mime-prompt-for-parameter (parameter)
1909   "Ask for PARAMETER.
1910 Parameter must be '(PROMPT CHOICE1 (CHOICE2...))."
1911   (let* ((prompt (car parameter))
1912          (choices (mapcar (function
1913                            (lambda (e)
1914                              (if (consp e) e (list e))))
1915                           (cdr parameter)))
1916          (default (car (car choices)))
1917          (answer nil))
1918     (if choices
1919         (progn
1920           (setq answer
1921                 (completing-read
1922                  (concat "What " prompt
1923                          ": (default "
1924                          (if (string-equal default "") "\"\"" default)
1925                          ") ")
1926                  choices nil nil ""))
1927           ;; If nothing is selected, use default.
1928           (if (string-equal answer "")
1929               (setq answer default)))
1930       (setq answer
1931             (read-string (concat "What " prompt ": "))))
1932     (cons (if (and answer
1933                    (not (string-equal answer "")))
1934               (concat prompt "="
1935                       ;; Note: control characters ignored!
1936                       (if (string-match mime-tspecials-regexp answer)
1937                           (concat "\"" answer "\"") answer)))
1938           (mime-prompt-for-parameters-1 (cdr (assoc answer (cdr parameter)))))
1939     ))
1940
1941 (defun mime-prompt-for-encoding (default)
1942   "Ask for Content-Transfer-Encoding."
1943   (let (encoding)
1944     (while (string=
1945             (setq encoding
1946                   (completing-read
1947                    "What transfer encoding: "
1948                    (mime-encoding-alist) nil t default)
1949                   )
1950             ""))
1951     encoding))
1952
1953 \f
1954 ;;; @ Translate the tagged MIME messages into a MIME compliant message.
1955 ;;;
1956
1957 (defvar mime-edit-translate-buffer-hook
1958   '(mime-edit-pgp-enclose-buffer
1959     mime-edit-translate-body
1960     mime-edit-translate-header))
1961
1962 (defun mime-edit-translate-header ()
1963   "Encode the message header into network representation."
1964   (mime-encode-header-in-buffer 'code-conversion)
1965   (run-hooks 'mime-edit-translate-header-hook))
1966
1967 (defun mime-edit-translate-buffer ()
1968   "Encode the tagged MIME message in current buffer in MIME compliant message."
1969   (interactive)
1970   (undo-boundary)
1971   (if (catch 'mime-edit-error
1972         (save-excursion
1973           (run-hooks 'mime-edit-translate-buffer-hook)
1974           ))
1975       (progn
1976         (undo)
1977         (error "Translation error!")
1978         )))
1979
1980 (defun mime-edit-find-inmost ()
1981   (goto-char (point-min))
1982   (if (re-search-forward mime-edit-multipart-beginning-regexp nil t)
1983       (let ((bb (match-beginning 0))
1984             (be (match-end 0))
1985             (type (buffer-substring (match-beginning 1)(match-end 1)))
1986             end-exp eb)
1987         (setq end-exp (format "--}-<<%s>>\n" type))
1988         (widen)
1989         (if (re-search-forward end-exp nil t)
1990             (setq eb (match-beginning 0))
1991           (setq eb (point-max))
1992           )
1993         (narrow-to-region be eb)
1994         (goto-char be)
1995         (if (re-search-forward mime-edit-multipart-beginning-regexp nil t)
1996             (progn
1997               (narrow-to-region (match-beginning 0)(point-max))
1998               (mime-edit-find-inmost)
1999               )
2000           (widen)
2001           (list type bb be eb)
2002           ))))
2003
2004 (defun mime-edit-process-multipart-1 (boundary)
2005   (let ((ret (mime-edit-find-inmost)))
2006     (if ret
2007         (let ((type (car ret))
2008               (bb (nth 1 ret))(be (nth 2 ret))
2009               (eb (nth 3 ret))
2010               )
2011           (narrow-to-region bb eb)
2012           (delete-region bb be)
2013           (setq bb (point-min))
2014           (setq eb (point-max))
2015           (widen)
2016           (goto-char eb)
2017           (if (looking-at mime-edit-multipart-end-regexp)
2018               (let ((beg (match-beginning 0))
2019                     (end (match-end 0))
2020                     )
2021                 (delete-region beg end)
2022                 (or (looking-at mime-edit-beginning-tag-regexp)
2023                     (looking-at mime-edit-multipart-end-regexp)
2024                     (eobp)
2025                     (insert (concat (mime-make-text-tag) "\n"))
2026                     )))
2027           (cond ((string-equal type "quote")
2028                  (mime-edit-enquote-region bb eb)
2029                  )
2030                 ((string-equal type "pgp-signed")
2031                  (mime-edit-sign-pgp-mime bb eb boundary)
2032                  )
2033                 ((string-equal type "pgp-encrypted")
2034                  (mime-edit-encrypt-pgp-mime bb eb boundary)
2035                  )
2036                 ((string-equal type "kazu-signed")
2037                  (mime-edit-sign-pgp-kazu bb eb boundary)
2038                  )
2039                 ((string-equal type "kazu-encrypted")
2040                  (mime-edit-encrypt-pgp-kazu bb eb boundary)
2041                  )
2042                 ((string-equal type "smime-signed")
2043                  (mime-edit-sign-smime bb eb boundary)
2044                  )
2045                 ((string-equal type "smime-encrypted")
2046                  (mime-edit-encrypt-smime bb eb boundary)
2047                  )
2048                 (t
2049                  (setq boundary
2050                        (nth 2 (mime-edit-translate-region bb eb
2051                                                             boundary t)))
2052                  (goto-char bb)
2053                  (insert
2054                   (format "--[[multipart/%s;
2055  boundary=\"%s\"][7bit]]\n"
2056                           type boundary))
2057                  ))
2058           boundary))))
2059
2060 (defun mime-edit-enquote-region (beg end)
2061   (save-excursion
2062     (save-restriction
2063       (narrow-to-region beg end)
2064       (goto-char beg)
2065       (while (re-search-forward mime-edit-single-part-tag-regexp nil t)
2066         (let ((tag (buffer-substring (match-beginning 0)(match-end 0))))
2067           (replace-match (concat "- " (substring tag 1)))
2068           )))))
2069
2070 (defun mime-edit-dequote-region (beg end)
2071   (save-excursion
2072     (save-restriction
2073       (narrow-to-region beg end)
2074       (goto-char beg)
2075       (while (re-search-forward
2076               mime-edit-quoted-single-part-tag-regexp nil t)
2077         (let ((tag (buffer-substring (match-beginning 0)(match-end 0))))
2078           (replace-match (concat "-" (substring tag 2)))
2079           )))))
2080
2081 (defvar mime-edit-pgp-user-id nil)
2082
2083 (defun mime-edit-delete-trailing-whitespace ()
2084   (save-match-data
2085     (save-excursion
2086       (goto-char (point-min))
2087       (while (re-search-forward "[ \t]+$" nil t)
2088         (delete-region (match-beginning 0) (match-end 0))))))
2089
2090 (defun mime-edit-sign-pgp-mime (beg end boundary)
2091   (save-excursion
2092     (save-restriction
2093       (let* ((from (std11-field-body "From" mail-header-separator))
2094              (ret (progn
2095                     (narrow-to-region beg end)
2096                     (mime-edit-translate-region beg end boundary)))
2097              (ctype    (car ret))
2098              (encoding (nth 1 ret))
2099              (pgp-boundary (concat "pgp-sign-" boundary))
2100              micalg)
2101         (mime-edit-delete-trailing-whitespace) ; RFC3156
2102         (goto-char beg)
2103         (insert (format "Content-Type: %s\n" ctype))
2104         (if encoding
2105             (insert (format "Content-Transfer-Encoding: %s\n" encoding))
2106           )
2107         (insert "\n")
2108         (or (let ((pgg-default-user-id
2109                    (or mime-edit-pgp-user-id
2110                        (if from
2111                            (nth 1 (std11-extract-address-components from))
2112                          pgg-default-user-id)))
2113                   (pgg-text-mode t))
2114               (pgg-sign-region (point-min)(point-max)))
2115             (throw 'mime-edit-error 'pgp-error)
2116             )
2117         (setq micalg
2118               (cdr (assq 'hash-algorithm
2119                          (cdar (with-current-buffer pgg-output-buffer
2120                                  (pgg-parse-armor-region
2121                                   (point-min)(point-max))))))
2122               micalg
2123               (if micalg
2124                   (concat "; micalg=pgp-" (downcase (symbol-name micalg)))
2125                 ""))
2126         (goto-char beg)
2127         (insert (format "--[[multipart/signed;
2128  boundary=\"%s\"%s;
2129  protocol=\"application/pgp-signature\"][7bit]]
2130 --%s
2131 " pgp-boundary micalg pgp-boundary))
2132         (goto-char (point-max))
2133         (insert (format "\n--%s
2134 Content-Type: application/pgp-signature
2135 Content-Transfer-Encoding: 7bit
2136
2137 " pgp-boundary))
2138         (insert-buffer-substring pgg-output-buffer)
2139         (goto-char (point-max))
2140         (insert (format "\n--%s--\n" pgp-boundary))
2141         ))))
2142
2143 (defvar mime-edit-encrypt-recipient-fields-list '("To" "cc"))
2144
2145 (defun mime-edit-make-encrypt-recipient-header ()
2146   (let* ((names mime-edit-encrypt-recipient-fields-list)
2147          (values
2148           (std11-field-bodies (cons "From" names)
2149                               nil mail-header-separator))
2150          (from (prog1
2151                    (car values)
2152                  (setq values (cdr values))))
2153          (header (and (stringp from)
2154                       (if (string-equal from "")
2155                           ""
2156                         (format "From: %s\n" from)
2157                         )))
2158          recipients)
2159     (while (and names values)
2160       (let ((name (car names))
2161             (value (car values))
2162             )
2163         (and (stringp value)
2164              (or (string-equal value "")
2165                  (progn
2166                    (setq header (concat header name ": " value "\n")
2167                          recipients (if recipients
2168                                         (concat recipients " ," value)
2169                                       value))
2170                    ))))
2171       (setq names (cdr names)
2172             values (cdr values))
2173       )
2174     (vector from recipients header)
2175     ))
2176
2177 (defun mime-edit-encrypt-pgp-mime (beg end boundary)
2178   (save-excursion
2179     (save-restriction
2180       (let (from recipients header)
2181         (let ((ret (mime-edit-make-encrypt-recipient-header)))
2182           (setq from (aref ret 0)
2183                 recipients (aref ret 1)
2184                 header (aref ret 2))
2185           )
2186         (narrow-to-region beg end)
2187         (let* ((ret
2188                 (mime-edit-translate-region beg end boundary))
2189                (ctype    (car ret))
2190                (encoding (nth 1 ret))
2191                (pgp-boundary (concat "pgp-" boundary)))
2192           (goto-char beg)
2193           (insert header)
2194           (insert (format "Content-Type: %s\n" ctype))
2195           (if encoding
2196               (insert (format "Content-Transfer-Encoding: %s\n" encoding))
2197             )
2198           (insert "\n")
2199           (mime-encode-header-in-buffer)
2200           (or (let ((pgg-default-user-id
2201                      (or mime-edit-pgp-user-id
2202                          (if from
2203                              (nth 1 (std11-extract-address-components from))
2204                            pgg-default-user-id)))
2205                     (pgg-text-mode t))
2206                 (pgg-encrypt-region
2207                  (point-min) (point-max)
2208                  (mapcar (lambda (recipient)
2209                            (nth 1 (std11-extract-address-components
2210                                    recipient)))
2211                          (split-string recipients
2212                                        "\\([ \t\n]*,[ \t\n]*\\)+")))
2213                 )
2214               (throw 'mime-edit-error 'pgp-error)
2215               )
2216           (delete-region (point-min)(point-max))
2217           (goto-char beg)
2218           (insert (format "--[[multipart/encrypted;
2219  boundary=\"%s\";
2220  protocol=\"application/pgp-encrypted\"][7bit]]
2221 --%s
2222 Content-Type: application/pgp-encrypted
2223
2224 Version: 1
2225 --%s
2226 Content-Type: application/octet-stream
2227 Content-Transfer-Encoding: 7bit
2228
2229 " pgp-boundary pgp-boundary pgp-boundary))
2230           (insert-buffer-substring pgg-output-buffer)
2231           (goto-char (point-max))
2232           (insert (format "\n--%s--\n" pgp-boundary))
2233           )))))
2234
2235 (defun mime-edit-sign-pgp-kazu (beg end boundary)
2236   (save-excursion
2237     (save-restriction
2238       (narrow-to-region beg end)
2239       (let* ((ret
2240               (mime-edit-translate-region beg end boundary))
2241              (ctype    (car ret))
2242              (encoding (nth 1 ret)))
2243         (goto-char beg)
2244         (insert (format "Content-Type: %s\n" ctype))
2245         (if encoding
2246             (insert (format "Content-Transfer-Encoding: %s\n" encoding))
2247           )
2248         (insert "\n")
2249         (or (pgg-sign-region beg (point-max) 'clearsign)
2250             (throw 'mime-edit-error 'pgp-error)
2251             )
2252         (goto-char beg)
2253         (insert
2254          "--[[application/pgp; format=mime][7bit]]\n")
2255         ))
2256     ))
2257
2258 (defun mime-edit-encrypt-pgp-kazu (beg end boundary)
2259   (save-excursion
2260     (let (recipients header)
2261       (let ((ret (mime-edit-make-encrypt-recipient-header)))
2262         (setq recipients (aref ret 1)
2263               header (aref ret 2))
2264         )
2265       (save-restriction
2266         (narrow-to-region beg end)
2267         (let* ((ret
2268                 (mime-edit-translate-region beg end boundary))
2269                (ctype    (car ret))
2270                (encoding (nth 1 ret)))
2271           (goto-char beg)
2272           (insert header)
2273           (insert (format "Content-Type: %s\n" ctype))
2274           (if encoding
2275               (insert (format "Content-Transfer-Encoding: %s\n" encoding))
2276             )
2277           (insert "\n")
2278           (or (pgg-encrypt-region beg (point-max) recipients)
2279               (throw 'mime-edit-error 'pgp-error)
2280               )
2281           (goto-char beg)
2282           (insert
2283            "--[[application/pgp; format=mime][7bit]]\n")
2284           ))
2285       )))
2286
2287 (defun mime-edit-sign-smime (beg end boundary)
2288   (save-excursion
2289     (save-restriction
2290       (let* ((ret (progn
2291                     (narrow-to-region beg end)
2292                     (mime-edit-translate-region beg end boundary)))
2293              (ctype    (car ret))
2294              (encoding (nth 1 ret))
2295              (smime-boundary (concat "smime-sign-" boundary)))
2296         (goto-char beg)
2297         (insert (format "Content-Type: %s\n" ctype))
2298         (if encoding
2299             (insert (format "Content-Transfer-Encoding: %s\n" encoding))
2300           )
2301         (insert "\n")
2302         (let (buffer-undo-list)
2303           (goto-char (point-min))
2304           (while (progn (end-of-line) (not (eobp)))
2305             (insert "\r")
2306             (forward-line 1))
2307           (or (prog1 (smime-sign-region (point-min)(point-max))
2308                 (push nil buffer-undo-list)
2309                 (ignore-errors (undo)))
2310               (throw 'mime-edit-error 'pgp-error)
2311               ))
2312         (goto-char beg)
2313         (insert (format "--[[multipart/signed;
2314  boundary=\"%s\"; micalg=sha1;
2315  protocol=\"application/pkcs7-signature\"][7bit]]
2316 --%s
2317 " smime-boundary smime-boundary))
2318         (goto-char (point-max))
2319         (insert (format "\n--%s
2320 Content-Type: application/pkcs7-signature; name=\"smime.p7s\"
2321 Content-Transfer-Encoding: base64
2322 Content-Disposition: attachment; filename=\"smime.p7s\"
2323 Content-Description: S/MIME Cryptographic Signature
2324
2325 "  smime-boundary))
2326         (insert-buffer-substring smime-output-buffer)
2327         (goto-char (point-max))
2328         (insert (format "\n--%s--\n" smime-boundary))
2329         ))))
2330
2331 (defun mime-edit-encrypt-smime (beg end boundary)
2332   (save-excursion
2333     (save-restriction
2334       (let* ((ret (progn
2335                     (narrow-to-region beg end)
2336                     (mime-edit-translate-region beg end boundary)))
2337              (ctype    (car ret))
2338              (encoding (nth 1 ret)))
2339         (goto-char beg)
2340         (insert (format "Content-Type: %s\n" ctype))
2341         (if encoding
2342             (insert (format "Content-Transfer-Encoding: %s\n" encoding))
2343           )
2344         (insert "\n")
2345         (goto-char (point-min))
2346         (while (progn (end-of-line) (not (eobp)))
2347           (insert "\r")
2348           (forward-line 1))
2349         (or (smime-encrypt-region (point-min)(point-max))
2350             (throw 'mime-edit-error 'pgp-error)
2351             )
2352         (delete-region (point-min)(point-max))
2353         (insert "--[[application/pkcs7-mime; name=\"smime.p7m\"
2354 Content-Disposition: attachment; filename=\"smime.p7m\"
2355 Content-Description: S/MIME Encrypted Message][base64]]\n")
2356         (insert-buffer-substring smime-output-buffer)
2357         ))))
2358
2359 (defsubst replace-space-with-underline (str)
2360   (mapconcat (function
2361               (lambda (arg)
2362                 (char-to-string
2363                  (if (eq arg ?\ )
2364                      ?_
2365                    arg)))) str "")
2366   )
2367
2368 (defun mime-edit-make-boundary ()
2369   (concat mime-multipart-boundary "_"
2370           (replace-space-with-underline (current-time-string))
2371           ))
2372
2373 (defun mime-edit-translate-body ()
2374   "Encode the tagged MIME body in current buffer in MIME compliant message."
2375   (interactive)
2376   (save-excursion
2377     (let ((boundary (mime-edit-make-boundary))
2378           (i 1)
2379           ret)
2380       (while (mime-edit-process-multipart-1
2381               (format "%s-%d" boundary i))
2382         (setq i (1+ i))
2383         )
2384       (save-restriction
2385         ;; We are interested in message body.
2386         (let* ((beg
2387                 (progn
2388                   (goto-char (point-min))
2389                   (re-search-forward
2390                    (concat "\n" (regexp-quote mail-header-separator)
2391                            (if mime-ignore-preceding-spaces
2392                                "[ \t\n]*\n" "\n")) nil 'move)
2393                   (point)))
2394                (end
2395                 (progn
2396                   (goto-char (point-max))
2397                   (and mime-ignore-trailing-spaces
2398                        (re-search-backward "[^ \t\n]\n" beg t)
2399                        (forward-char 1))
2400                   (point))))
2401           (setq ret (mime-edit-translate-region
2402                      beg end
2403                      (format "%s-%d" boundary i)))
2404           ))
2405       (mime-edit-dequote-region (point-min)(point-max))
2406       (let ((contype (car ret))         ;Content-Type
2407             (encoding (nth 1 ret))      ;Content-Transfer-Encoding
2408             )
2409         ;; Insert User-Agent field
2410         (and mime-edit-insert-user-agent-field
2411              (or (mail-position-on-field "User-Agent")
2412                  (insert mime-edit-user-agent-value)
2413                  ))
2414         ;; Make primary MIME headers.
2415         (or (mail-position-on-field "MIME-Version")
2416             (insert mime-edit-mime-version-value))
2417         ;; Remove old Content-Type and other fields.
2418         (save-restriction
2419           (goto-char (point-min))
2420           (search-forward (concat "\n" mail-header-separator "\n") nil t)
2421           (narrow-to-region (point-min) (point))
2422           (goto-char (point-min))
2423           (mime-delete-field "Content-Type")
2424           (mime-delete-field "Content-Transfer-Encoding"))
2425         ;; Then, insert Content-Type and Content-Transfer-Encoding fields.
2426         (mail-position-on-field "Content-Type")
2427         (insert contype)
2428         (if encoding
2429             (progn
2430               (mail-position-on-field "Content-Transfer-Encoding")
2431               (insert encoding)))
2432         ))))
2433
2434 (defun mime-edit-translate-single-part-tag (boundary &optional prefix)
2435   "Translate single-part-tag to MIME header."
2436   (if (re-search-forward mime-edit-single-part-tag-regexp nil t)
2437       (let* ((beg (match-beginning 0))
2438              (end (match-end 0))
2439              (tag (buffer-substring beg end)))
2440         (delete-region beg end)
2441         (let ((contype (mime-edit-get-contype tag))
2442               (encoding (mime-edit-get-encoding tag)))
2443           (insert (concat prefix "--" boundary "\n"))
2444           (save-restriction
2445             (narrow-to-region (point)(point))
2446             (insert "Content-Type: " contype "\n")
2447             (if encoding
2448                 (insert "Content-Transfer-Encoding: " encoding "\n"))
2449             (mime-encode-header-in-buffer))
2450           (cons (and contype
2451                      (downcase contype))
2452                 (and encoding
2453                      (downcase encoding))))
2454         )))
2455
2456 (defun mime-edit-translate-region (beg end &optional boundary multipart)
2457   (or boundary
2458       (setq boundary (mime-edit-make-boundary))
2459       )
2460   (save-excursion
2461     (save-restriction
2462       (narrow-to-region beg end)
2463       (let ((tag nil)                   ;MIME tag
2464             (contype nil)               ;Content-Type
2465             (encoding nil)              ;Content-Transfer-Encoding
2466             (nparts 0))                 ;Number of body parts
2467         ;; Normalize the body part by inserting appropriate message
2468         ;; tags for every message contents.
2469         (mime-edit-normalize-body)
2470         ;; Counting the number of Content-Type.
2471         (goto-char (point-min))
2472         (while (re-search-forward mime-edit-single-part-tag-regexp nil t)
2473           (setq nparts (1+ nparts)))
2474         ;; Begin translation.
2475         (cond
2476          ((and (<= nparts 1)(not multipart))
2477           ;; It's a singular message.
2478           (goto-char (point-min))
2479           (while (re-search-forward
2480                   mime-edit-single-part-tag-regexp nil t)
2481             (setq tag
2482                   (buffer-substring (match-beginning 0) (match-end 0)))
2483             (delete-region (match-beginning 0) (1+ (match-end 0)))
2484             (setq contype (mime-edit-get-contype tag))
2485             (setq encoding (mime-edit-get-encoding tag))
2486             ))
2487          (t
2488           ;; It's a multipart message.
2489           (goto-char (point-min))
2490           (let ((prio mime-content-transfer-encoding-priority-list)
2491                 part-info nprio)
2492             (when (setq part-info
2493                         (mime-edit-translate-single-part-tag boundary))
2494               (and (setq nprio (member (cdr part-info) prio))
2495                    (setq prio nprio))
2496               (while (setq part-info
2497                            (mime-edit-translate-single-part-tag boundary "\n"))
2498                 (and (setq nprio (member (cdr part-info) prio))
2499                      (setq prio nprio))))
2500             ;; Define Content-Type as "multipart/mixed".
2501             (setq contype
2502                   (concat "multipart/mixed;\n boundary=\"" boundary "\""))
2503             (setq encoding (car prio))
2504             ;; Insert the trailer.
2505             (goto-char (point-max))
2506             (insert "\n--" boundary "--\n")
2507             )))
2508          (list contype encoding boundary nparts)
2509          ))))
2510
2511 (defun mime-edit-normalize-body ()
2512   "Normalize the body part by inserting appropriate message tags."
2513   ;; Insert the first MIME tags if necessary.
2514   (goto-char (point-min))
2515   (if (not (looking-at mime-edit-single-part-tag-regexp))
2516       (insert (mime-make-text-tag) "\n"))
2517   ;; Check each tag, and add new tag or correct it if necessary.
2518   (goto-char (point-min))
2519   (while (re-search-forward mime-edit-single-part-tag-regexp nil t)
2520     (let* ((tag (buffer-substring (match-beginning 0) (match-end 0)))
2521            (contype (mime-edit-get-contype tag))
2522            (charset (mime-get-parameter contype "charset"))
2523            (encoding (mime-edit-get-encoding tag)))
2524       ;; Remove extra whitespaces after the tag.
2525       (if (looking-at "[ \t]+$")
2526           (delete-region (match-beginning 0) (match-end 0)))
2527       (let ((beg (point))
2528             (end (mime-edit-content-end))
2529             )
2530         (if (= end (point-max))
2531             nil
2532           (goto-char end)
2533           (or (looking-at mime-edit-beginning-tag-regexp)
2534               (eobp)
2535               (insert (mime-make-text-tag) "\n")
2536               ))
2537         (visible-region beg end)
2538         (goto-char beg)
2539         )
2540       (cond
2541        ((mime-test-content-type contype "message")
2542         ;; Content-type "message" should be sent as is.
2543         (forward-line 1)
2544         )
2545        ((mime-test-content-type contype "text")
2546         ;; Define charset for text if necessary.
2547         (setq charset (if charset
2548                           (intern (downcase charset))
2549                         (mime-edit-choose-charset)))
2550         (mime-edit-define-charset charset)
2551         (cond ((string-equal contype "text/x-rot13-47-48")
2552                (save-excursion
2553                  (forward-line)
2554                  (mule-caesar-region (point) (mime-edit-content-end))
2555                  ))
2556               ((string-equal contype "text/enriched")
2557                (save-excursion
2558                  (let ((beg (progn
2559                               (forward-line)
2560                               (point)))
2561                        (end (mime-edit-content-end))
2562                        )
2563                    ;; Patch for hard newlines
2564                    ;; (save-excursion
2565                    ;;   (goto-char beg)
2566                    ;;   (while (search-forward "\n" end t)
2567                    ;;     (put-text-property (match-beginning 0)
2568                    ;;                        (point)
2569                    ;;                        'hard t)))
2570                    ;; End patch for hard newlines
2571                    (enriched-encode beg end nil)
2572                    (goto-char beg)
2573                    (if (search-forward "\n\n")
2574                        (delete-region beg (match-end 0))
2575                      )
2576                    ))))
2577         ;; Point is now on current tag.
2578         ;; Define encoding and encode text if necessary.
2579         (or encoding    ;Encoding is not specified.
2580             (let* ((encoding
2581                     (let (bits conv)
2582                       (let ((ret (cdr (assq charset mime-charset-type-list))))
2583                         (if ret
2584                             (setq bits (car ret)
2585                                   conv (nth 1 ret))
2586                           (setq bits 8
2587                                 conv "quoted-printable")))
2588                       (if (<= bits mime-transfer-level)
2589                           (mime-encoding-name bits)
2590                         conv)))
2591                    (beg (mime-edit-content-beginning)))
2592               (encode-mime-charset-region beg (mime-edit-content-end)
2593                                           charset)
2594               ;; Protect "From " in beginning of line
2595               (save-restriction
2596                 (narrow-to-region beg (mime-edit-content-end))
2597                 (goto-char beg)
2598                 (let (case-fold-search)
2599                   (if (re-search-forward "^From " nil t)
2600                       (unless encoding
2601                         (if (memq charset '(iso-2022-jp
2602                                             iso-2022-jp-2
2603                                             iso-2022-int-1
2604                                             x-ctext))
2605                             (while (progn
2606                                      (replace-match "\e(BFrom ")
2607                                      (re-search-forward "^From " nil t)
2608                                      ))
2609                           (setq encoding "quoted-printable")
2610                           )))))
2611               ;; canonicalize line break code
2612               (or (member encoding '(nil "7bit" "8bit" "quoted-printable"))
2613                   (save-restriction
2614                     (narrow-to-region beg (mime-edit-content-end))
2615                     (goto-char beg)
2616                     (while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t)
2617                       ;; In a certain period, `replace-match' with "\\N"
2618                       ;; converted 8-bit characters into multibyte string,
2619                       ;; but it has been fixed at 2004-01-15.
2620                       ;;(replace-match "\\1\r\n"))))
2621                       (backward-char 1)
2622                       (insert "\r")
2623                       (forward-char 1))))
2624               (goto-char beg)
2625               (mime-encode-region beg (mime-edit-content-end)
2626                                   (or encoding "7bit"))
2627               (mime-edit-define-encoding encoding)
2628               ))
2629         (goto-char (mime-edit-content-end))
2630         )
2631        ((null encoding)         ;Encoding is not specified.
2632         ;; Application, image, audio, video, and any other
2633         ;; unknown content-type without encoding should be
2634         ;; encoded.
2635         (let* ((encoding "base64")      ;Encode in BASE64 by default.
2636                (beg (mime-edit-content-beginning))
2637                (end (mime-edit-content-end)))
2638           (mime-encode-region beg end encoding)
2639           (mime-edit-define-encoding encoding))
2640         (forward-line 1)
2641         ))
2642       )))
2643
2644 (defun mime-delete-field (field)
2645   "Delete header FIELD."
2646   (let ((regexp (format "^%s:[ \t]*" field)))
2647     (goto-char (point-min))
2648     (while (re-search-forward regexp nil t)
2649       (delete-region (match-beginning 0)
2650                      (1+ (std11-field-end))))))
2651
2652 \f
2653 ;;;
2654 ;;; Platform dependent functions
2655 ;;;
2656
2657 ;; Sun implementations
2658
2659 (defun mime-edit-voice-recorder-for-sun (encoding)
2660   "Record voice in a buffer using Sun audio device,
2661 and insert data encoded as ENCODING."
2662   (message "Start the recording on %s.  Type C-g to finish the recording..."
2663            (system-name))
2664   (mime-insert-encoded-file "/dev/audio" encoding)
2665   )
2666
2667 \f
2668 ;;; @ Other useful commands.
2669 ;;;
2670
2671 ;; Message forwarding commands as content-type "message/rfc822".
2672
2673 (defun mime-edit-insert-message (&optional message)
2674   (interactive)
2675   (let ((inserter (cdr (assq major-mode mime-edit-message-inserter-alist))))
2676     (if (and inserter (fboundp inserter))
2677         (progn
2678           (mime-edit-insert-tag "message" "rfc822")
2679           (funcall inserter message)
2680           )
2681       (message "Sorry, I don't have message inserter for your MUA.")
2682       )))
2683
2684 (defun mime-edit-insert-mail (&optional message)
2685   (interactive)
2686   (let ((inserter (cdr (assq major-mode mime-edit-mail-inserter-alist))))
2687     (if (and inserter (fboundp inserter))
2688         (progn
2689           (mime-edit-insert-tag "message" "rfc822")
2690           (funcall inserter message)
2691           )
2692       (message "Sorry, I don't have mail inserter for your MUA.")
2693       )))
2694
2695 (defun mime-edit-inserted-message-filter ()
2696   (save-excursion
2697     (save-restriction
2698       (let ((header-start (point))
2699             (case-fold-search t)
2700             beg end)
2701         ;; for Emacs 18
2702         ;; (if (re-search-forward "^$" (marker-position (mark-marker)))
2703         (if (re-search-forward "^$" (mark t))
2704             (narrow-to-region header-start (match-beginning 0))
2705           )
2706         (goto-char header-start)
2707         (while (and (re-search-forward
2708                      mime-edit-yank-ignored-field-regexp nil t)
2709                     (setq beg (match-beginning 0))
2710                     (setq end (1+ (std11-field-end)))
2711                     )
2712           (delete-region beg end)
2713           )
2714         ))))
2715
2716
2717 ;;; @ multipart enclosure
2718 ;;;
2719
2720 (defun mime-edit-enclose-region-internal (type beg end)
2721   (save-excursion
2722     (goto-char beg)
2723     (save-restriction
2724       (narrow-to-region beg end)
2725       (insert (format "--<<%s>>-{\n" type))
2726       (goto-char (point-max))
2727       (insert (format "--}-<<%s>>\n" type))
2728       (goto-char (point-max))
2729       )
2730     (or (looking-at mime-edit-beginning-tag-regexp)
2731         (eobp)
2732         (insert (mime-make-text-tag) "\n")
2733         )
2734     ))
2735
2736 (defun mime-edit-enclose-quote-region (beg end)
2737   (interactive "*r")
2738   (mime-edit-enclose-region-internal 'quote beg end)
2739   )
2740
2741 (defun mime-edit-enclose-mixed-region (beg end)
2742   (interactive "*r")
2743   (mime-edit-enclose-region-internal 'mixed beg end)
2744   )
2745
2746 (defun mime-edit-enclose-parallel-region (beg end)
2747   (interactive "*r")
2748   (mime-edit-enclose-region-internal 'parallel beg end)
2749   )
2750
2751 (defun mime-edit-enclose-digest-region (beg end)
2752   (interactive "*r")
2753   (mime-edit-enclose-region-internal 'digest beg end)
2754   )
2755
2756 (defun mime-edit-enclose-alternative-region (beg end)
2757   (interactive "*r")
2758   (mime-edit-enclose-region-internal 'alternative beg end)
2759   )
2760
2761 (defun mime-edit-enclose-pgp-signed-region (beg end)
2762   (interactive "*r")
2763   (mime-edit-enclose-region-internal 'pgp-signed beg end)
2764   )
2765
2766 (defun mime-edit-enclose-pgp-encrypted-region (beg end)
2767   (interactive "*r")
2768   (mime-edit-enclose-region-internal 'pgp-encrypted beg end)
2769   )
2770
2771 (defun mime-edit-enclose-kazu-signed-region (beg end)
2772   (interactive "*r")
2773   (mime-edit-enclose-region-internal 'kazu-signed beg end)
2774   )
2775
2776 (defun mime-edit-enclose-kazu-encrypted-region (beg end)
2777   (interactive "*r")
2778   (mime-edit-enclose-region-internal 'kazu-encrypted beg end)
2779   )
2780
2781 (defun mime-edit-enclose-smime-signed-region (beg end)
2782   (interactive "*r")
2783   (mime-edit-enclose-region-internal 'smime-signed beg end)
2784   )
2785
2786 (defun mime-edit-enclose-smime-encrypted-region (beg end)
2787   (interactive "*r")
2788   (mime-edit-enclose-region-internal 'smime-encrypted beg end)
2789   )
2790
2791 (defun mime-edit-insert-key (&optional arg)
2792   "Insert a pgp public key."
2793   (interactive "P")
2794   (mime-edit-insert-tag "application" "pgp-keys")
2795   (mime-edit-define-encoding "7bit")
2796   (pgg-insert-key)
2797   (if (and (not (eobp))
2798            (not (looking-at mime-edit-single-part-tag-regexp)))
2799       (insert (mime-make-text-tag) "\n")))
2800
2801
2802 ;;; @ flag setting
2803 ;;;
2804
2805 (defun mime-edit-set-split (arg)
2806   (interactive
2807    (list
2808     (y-or-n-p "Do you want to enable split? ")
2809     ))
2810   (setq mime-edit-split-message arg)
2811   (if arg
2812       (message "This message is enabled to split.")
2813     (message "This message is not enabled to split.")
2814     ))
2815
2816 (defun mime-edit-toggle-transfer-level (&optional transfer-level)
2817   "Toggle transfer-level is 7bit or 8bit through.
2818
2819 Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8."
2820   (interactive)
2821   (if (numberp transfer-level)
2822       (setq mime-transfer-level transfer-level)
2823     (if (< mime-transfer-level 8)
2824         (setq mime-transfer-level 8)
2825       (setq mime-transfer-level 7)
2826       ))
2827   (message (format "Current transfer-level is %d bit"
2828                    mime-transfer-level))
2829   (setq mime-transfer-level-string
2830         (mime-encoding-name mime-transfer-level 'not-omit))
2831   (force-mode-line-update)
2832   )
2833
2834 (defun mime-edit-set-transfer-level-7bit ()
2835   (interactive)
2836   (mime-edit-toggle-transfer-level 7)
2837   )
2838
2839 (defun mime-edit-set-transfer-level-8bit ()
2840   (interactive)
2841   (mime-edit-toggle-transfer-level 8)
2842   )
2843
2844
2845 ;;; @ pgp
2846 ;;;
2847
2848 (defvar mime-edit-pgp-processing nil)
2849 (make-variable-buffer-local 'mime-edit-pgp-processing)
2850
2851 (defun mime-edit-set-sign (arg)
2852   (interactive
2853    (list
2854     (y-or-n-p "Do you want to sign? ")
2855     ))
2856   (if arg
2857       (progn
2858         (or (memq 'sign mime-edit-pgp-processing)
2859             (setq mime-edit-pgp-processing
2860                   (nconc mime-edit-pgp-processing
2861                          (copy-sequence '(sign)))))
2862         (message "This message will be signed.")
2863         )
2864     (setq mime-edit-pgp-processing
2865           (delq 'sign mime-edit-pgp-processing))
2866     (message "This message will not be signed.")
2867     ))
2868
2869 (defun mime-edit-set-encrypt (arg)
2870   (interactive
2871    (list
2872     (y-or-n-p "Do you want to encrypt? ")
2873     ))
2874   (if arg
2875       (progn
2876         (or (memq 'encrypt mime-edit-pgp-processing)
2877             (setq mime-edit-pgp-processing
2878                   (nconc mime-edit-pgp-processing
2879                          (copy-sequence '(encrypt)))))
2880         (message "This message will be encrypted.")
2881         )
2882     (setq mime-edit-pgp-processing
2883           (delq 'encrypt mime-edit-pgp-processing))
2884     (message "This message will not be encrypted.")
2885     ))
2886
2887 (defun mime-edit-pgp-enclose-buffer ()
2888   (let ((beg (save-excursion
2889                (goto-char (point-min))
2890                (if (search-forward (concat "\n" mail-header-separator "\n"))
2891                    (match-end 0)
2892                  )))
2893         )
2894     (when beg
2895       (if (memq 'sign mime-edit-pgp-processing)
2896           (mime-edit-enclose-pgp-signed-region beg (point-max)))
2897       (if (memq 'encrypt mime-edit-pgp-processing)
2898           (mime-edit-enclose-pgp-encrypted-region beg (point-max)))
2899       )))
2900
2901 ;;; @ split
2902 ;;;
2903
2904 (defun mime-edit-insert-partial-header (fields subject
2905                                                id number total separator)
2906   (insert fields)
2907   (insert (format "Subject: %s (%d/%d)\n" subject number total))
2908   (insert mime-edit-mime-version-field-for-message/partial)
2909   (insert (format "\
2910 Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n"
2911                   id number total separator))
2912   )
2913
2914 (defun mime-edit-split-and-send
2915   (&optional cmd lines mime-edit-message-max-length)
2916   (interactive)
2917   (or lines
2918       (setq lines
2919             (count-lines (point-min) (point-max)))
2920       )
2921   (or mime-edit-message-max-length
2922       (setq mime-edit-message-max-length
2923             (or (cdr (assq major-mode mime-edit-message-max-lines-alist))
2924                 mime-edit-message-default-max-lines))
2925       )
2926   (let ((separator mail-header-separator)
2927         (id (concat "\""
2928                     (replace-space-with-underline (current-time-string))
2929                     "@" (system-name) "\"")))
2930     (run-hooks 'mime-edit-before-split-hook)
2931     (let ((the-buf (current-buffer))
2932           (copy-buf (get-buffer-create " *Original Message*"))
2933           (header (std11-header-string-except
2934                    mime-edit-split-ignored-field-regexp separator))
2935           (subject (mail-fetch-field "subject"))
2936           (total (+ (/ lines mime-edit-message-max-length)
2937                     (if (> (mod lines mime-edit-message-max-length) 0)
2938                         1)))
2939           (command
2940            (or cmd
2941                (cdr
2942                 (assq major-mode
2943                       mime-edit-split-message-sender-alist))
2944                (function
2945                 (lambda ()
2946                   (interactive)
2947                   (error "Split sender is not specified for `%s'." major-mode)
2948                   ))
2949                ))
2950           (mime-edit-partial-number 1)
2951           data)
2952       (save-excursion
2953         (set-buffer copy-buf)
2954         (erase-buffer)
2955         (insert-buffer the-buf)
2956         (save-restriction
2957           (if (re-search-forward
2958                (concat "^" (regexp-quote separator) "$") nil t)
2959               (let ((he (match-beginning 0)))
2960                 (replace-match "")
2961                 (narrow-to-region (point-min) he)
2962                 ))
2963           (goto-char (point-min))
2964           (while (re-search-forward mime-edit-split-blind-field-regexp nil t)
2965             (delete-region (match-beginning 0)
2966                            (1+ (std11-field-end)))
2967             )))
2968       (while (< mime-edit-partial-number total)
2969         (erase-buffer)
2970         (save-excursion
2971           (set-buffer copy-buf)
2972           (setq data (buffer-substring
2973                       (point-min)
2974                       (progn
2975                         (goto-line mime-edit-message-max-length)
2976                         (point))
2977                       ))
2978           (delete-region (point-min)(point))
2979           )
2980         (mime-edit-insert-partial-header
2981          header subject id mime-edit-partial-number total separator)
2982         (insert data)
2983         (save-excursion
2984           (message (format "Sending %d/%d..."
2985                            mime-edit-partial-number total))
2986           (call-interactively command)
2987           (message (format "Sending %d/%d...done"
2988                            mime-edit-partial-number total))
2989           )
2990         (setq mime-edit-partial-number
2991               (1+ mime-edit-partial-number))
2992         )
2993       (erase-buffer)
2994       (save-excursion
2995         (set-buffer copy-buf)
2996         (setq data (buffer-string))
2997         (erase-buffer)
2998         )
2999       (mime-edit-insert-partial-header
3000        header subject id mime-edit-partial-number total separator)
3001       (insert data)
3002       (save-excursion
3003         (message (format "Sending %d/%d..."
3004                          mime-edit-partial-number total))
3005         (message (format "Sending %d/%d...done"
3006                          mime-edit-partial-number total))
3007         )
3008       )))
3009
3010 (defun mime-edit-maybe-split-and-send (&optional cmd)
3011   (interactive)
3012   (run-hooks 'mime-edit-before-send-hook)
3013   (let ((mime-edit-message-max-length
3014          (or (cdr (assq major-mode mime-edit-message-max-lines-alist))
3015              mime-edit-message-default-max-lines))
3016         (lines (count-lines (point-min) (point-max)))
3017         )
3018     (if (and (> lines mime-edit-message-max-length)
3019              mime-edit-split-message)
3020         (mime-edit-split-and-send cmd lines mime-edit-message-max-length)
3021       )))
3022
3023
3024 ;;; @ preview message
3025 ;;;
3026
3027 (defvar mime-edit-buffer nil) ; buffer local variable
3028 (defvar mime-edit-temp-message-buffer nil) ; buffer local variable
3029
3030 (defun mime-edit-preview-message ()
3031   "preview editing MIME message."
3032   (interactive)
3033   (let* ((str (buffer-string))
3034          (separator mail-header-separator)
3035          (the-buf (current-buffer))
3036          (buf-name (buffer-name))
3037          (temp-buf-name (concat "*temp-article:" buf-name "*"))
3038          (buf (get-buffer temp-buf-name))
3039          (pgp-processing mime-edit-pgp-processing)
3040          )
3041     (if buf
3042         (progn
3043           (switch-to-buffer buf)
3044           (erase-buffer)
3045           )
3046       (setq buf (get-buffer-create temp-buf-name))
3047       (switch-to-buffer buf)
3048       )
3049     (insert str)
3050     (setq major-mode 'mime-temp-message-mode)
3051     (make-local-variable 'mail-header-separator)
3052     (setq mail-header-separator separator)
3053     (make-local-variable 'mime-edit-buffer)
3054     (setq mime-edit-buffer the-buf)
3055     (setq mime-edit-pgp-processing pgp-processing)
3056
3057     (run-hooks 'mime-edit-translate-hook)
3058     (mime-edit-translate-buffer)
3059     (goto-char (point-min))
3060     (if (re-search-forward
3061          (concat "^" (regexp-quote separator) "$"))
3062         (replace-match "")
3063       )
3064     (mime-view-buffer)
3065     (make-local-variable 'mime-edit-temp-message-buffer)
3066     (setq mime-edit-temp-message-buffer buf)))
3067
3068 (defun mime-edit-quitting-method ()
3069   "Quitting method for mime-view."
3070   (let* ((temp mime-edit-temp-message-buffer)
3071          buf)
3072     (mime-preview-kill-buffer)
3073     (set-buffer temp)
3074     (setq buf mime-edit-buffer)
3075     (kill-buffer temp)
3076     (switch-to-buffer buf)))
3077
3078 (set-alist 'mime-preview-quitting-method-alist
3079            'mime-temp-message-mode
3080            #'mime-edit-quitting-method)
3081
3082
3083 ;;; @ edit again
3084 ;;;
3085
3086 (defvar mime-edit-again-ignored-field-regexp
3087   (concat "^\\(" "Content-.*\\|Mime-Version"
3088           (if mime-edit-insert-user-agent-field "\\|User-Agent")
3089           "\\):")
3090   "Regexp for deleted header fields when `mime-edit-again' is called.")
3091
3092 (defsubst eliminate-top-spaces (string)
3093   "Eliminate top sequence of space or tab in STRING."
3094   (if (string-match "^[ \t]+" string)
3095       (substring string (match-end 0))
3096     string))
3097
3098 (defun mime-edit-decode-multipart-in-buffer (content-type not-decode-text)
3099   (let* ((subtype
3100           (or
3101            (cdr (assoc (mime-content-type-parameter content-type "protocol")
3102                        '(("application/pgp-encrypted" . pgp-encrypted)
3103                          ("application/pgp-signature" . pgp-signed))))
3104            (mime-content-type-subtype content-type)))
3105          (boundary (mime-content-type-parameter content-type "boundary"))
3106          (boundary-pat (concat "\n--" (regexp-quote boundary) "[ \t]*\n")))
3107     (re-search-forward boundary-pat nil t)
3108     (let ((bb (match-beginning 0)) eb tag)
3109       (setq tag (format "\n--<<%s>>-{\n" subtype))
3110       (goto-char bb)
3111       (insert tag)
3112       (setq bb (+ bb (length tag)))
3113       (re-search-forward
3114        (concat "\n--" (regexp-quote boundary) "--[ \t]*\n")
3115        nil t)
3116       (setq eb (match-beginning 0))
3117       (replace-match (format "--}-<<%s>>\n" subtype))
3118       (save-restriction
3119         (narrow-to-region bb eb)
3120         (goto-char (point-min))
3121         (while (re-search-forward boundary-pat nil t)
3122           (let ((beg (match-beginning 0))
3123                 end)
3124             (delete-region beg (match-end 0))
3125             (save-excursion
3126               (if (re-search-forward boundary-pat nil t)
3127                   (setq end (match-beginning 0))
3128                 (setq end (point-max))
3129                 )
3130               (save-restriction
3131                 (narrow-to-region beg end)
3132                 (cond
3133                  ((eq subtype 'pgp-encrypted)
3134                   (when (and
3135                          (progn
3136                            (goto-char (point-min))
3137                            (re-search-forward "^-+BEGIN PGP MESSAGE-+$"
3138                                               nil t))
3139                          (prog1
3140                              (save-window-excursion
3141                                (pgg-decrypt-region (match-beginning 0)
3142                                                    (point-max)))
3143                            (delete-region (point-min)(point-max))))
3144                     (insert-buffer-substring pgg-output-buffer)
3145                     (mime-edit-decode-message-in-buffer
3146                      nil not-decode-text)
3147                     (delete-region (goto-char (point-min))
3148                                    (if (search-forward "\n\n" nil t)
3149                                        (match-end 0)
3150                                      (point-min)))
3151                     (goto-char (point-max))
3152                     ))
3153                  (t
3154                   (mime-edit-decode-message-in-buffer
3155                    (if (eq subtype 'digest)
3156                        (eval-when-compile
3157                          (make-mime-content-type 'message 'rfc822))
3158                      )
3159                    not-decode-text)
3160                   (goto-char (point-max))
3161                   ))
3162                 ))))
3163         ))
3164     (goto-char (point-min))
3165     (or (= (point-min) 1)
3166         (delete-region (point-min)
3167                        (if (search-forward "\n\n" nil t)
3168                            (match-end 0)
3169                          (point-min)
3170                          )))
3171     ))
3172
3173 (defun mime-edit-decode-single-part-in-buffer
3174   (content-type not-decode-text &optional content-disposition)
3175   (let* ((type (mime-content-type-primary-type content-type))
3176          (subtype (mime-content-type-subtype content-type))
3177          (ctype (format "%s/%s" type subtype))
3178          charset
3179          (pstr (let ((bytes (+ 14 (length ctype))))
3180                  (mapconcat (function
3181                              (lambda (attr)
3182                                (if (string= (car attr) "charset")
3183                                    (progn
3184                                      (setq charset (cdr attr))
3185                                      "")
3186                                  (let* ((str (concat (car attr)
3187                                                      "=" (cdr attr)))
3188                                         (bs (length str)))
3189                                    (setq bytes (+ bytes bs 2))
3190                                    (if (< bytes 76)
3191                                        (concat "; " str)
3192                                      (setq bytes (+ bs 1))
3193                                      (concat ";\n " str)
3194                                      )
3195                                    ))))
3196                             (mime-content-type-parameters content-type) "")))
3197          encoding
3198          encoded
3199          (limit (save-excursion
3200                   (if (search-forward "\n\n" nil t)
3201                       (1- (point)))))
3202          (disposition-type
3203           (mime-content-disposition-type content-disposition))
3204          (disposition-str
3205           (if disposition-type
3206               (let ((bytes (+ 21 (length (format "%s" disposition-type)))))
3207                 (mapconcat (function
3208                             (lambda (attr)
3209                               (let* ((str (concat
3210                                            (car attr)
3211                                            "="
3212                                            (if (string-equal "filename"
3213                                                              (car attr))
3214                                                (std11-wrap-as-quoted-string
3215                                                 (cdr attr))
3216                                              (cdr attr))))
3217                                      (bs (length str)))
3218                                 (setq bytes (+ bytes bs 2))
3219                                 (if (< bytes 76)
3220                                     (concat "; " str)
3221                                   (setq bytes (+ bs 1))
3222                                   (concat ";\n " str)
3223                                   )
3224                                 )))
3225                            (mime-content-disposition-parameters
3226                             content-disposition)
3227                            ""))))
3228          )
3229     (if disposition-type
3230         (setq pstr (format "%s\nContent-Disposition: %s%s"
3231                            pstr disposition-type disposition-str))
3232       )
3233     (save-excursion
3234       (if (re-search-forward
3235            "^Content-Transfer-Encoding:" limit t)
3236           (let ((beg (match-beginning 0))
3237                 (hbeg (match-end 0))
3238                 (end (std11-field-end limit)))
3239             (setq encoding
3240                   (downcase
3241                    (eliminate-top-spaces
3242                     (std11-unfold-string
3243                      (buffer-substring hbeg end)))))
3244             (if (or charset (eq type 'text))
3245                 (progn
3246                   (delete-region beg (1+ end))
3247                   (goto-char (point-min))
3248                   (if (search-forward "\n\n" nil t)
3249                       (progn
3250                         (mime-decode-region
3251                          (match-end 0)(point-max) encoding)
3252                         (setq encoded t
3253                               encoding nil)
3254                         )))))))
3255     (if (and (eq type 'text)
3256              (or encoded (not not-decode-text)))
3257         (progn
3258           (save-excursion
3259             (goto-char (point-min))
3260             (while (re-search-forward "\r\n" nil t)
3261               (replace-match "\n")
3262               ))
3263           (decode-mime-charset-region (point-min)(point-max)
3264                                       (or charset default-mime-charset))
3265           ))
3266     (let ((he (if (re-search-forward "^$" nil t)
3267                   (match-end 0)
3268                 (point-min)
3269                 )))
3270       (if (and (eq type 'text)
3271                (eq subtype 'x-rot13-47-48))
3272           (mule-caesar-region he (point-max))
3273         )
3274       (if (= (point-min) 1)
3275           (progn
3276             (goto-char he)
3277             (insert
3278              (concat "\n"
3279                      (mime-create-tag
3280                       (format "%s/%s%s" type subtype pstr)
3281                       encoding)))
3282             )
3283         (delete-region (point-min) he)
3284         (insert
3285          (mime-create-tag (format "%s/%s%s" type subtype pstr)
3286                           encoding))
3287         ))
3288     ))
3289
3290 ;;;###autoload
3291 (defun mime-edit-decode-message-in-buffer (&optional default-content-type
3292                                                      not-decode-text)
3293   (save-excursion
3294     (goto-char (point-min))
3295     (let ((ctl (or (mime-read-Content-Type)
3296                    default-content-type)))
3297       (if ctl
3298           (let ((type (mime-content-type-primary-type ctl)))
3299             (cond
3300              ((and (eq type 'application)
3301                    (eq (mime-content-type-subtype ctl) 'pgp-signature))
3302               (delete-region (point-min)(point-max))
3303               )
3304              ((eq type 'multipart)
3305               (mime-edit-decode-multipart-in-buffer ctl not-decode-text)
3306               )
3307              (t
3308               (mime-edit-decode-single-part-in-buffer
3309                ctl not-decode-text (mime-read-Content-Disposition))
3310               )))
3311         (or not-decode-text
3312             (decode-mime-charset-region (point-min) (point-max)
3313                                         default-mime-charset))
3314         )
3315       (if (= (point-min) 1)
3316           (progn
3317             (save-restriction
3318               (std11-narrow-to-header)
3319               (goto-char (point-min))
3320               (while (re-search-forward
3321                       mime-edit-again-ignored-field-regexp nil t)
3322                 (delete-region (match-beginning 0) (1+ (std11-field-end)))
3323                 ))
3324             (mime-decode-header-in-buffer (not not-decode-text))
3325             ))
3326       )))
3327
3328 ;;;###autoload
3329 (defun mime-edit-again (&optional not-decode-text no-separator not-turn-on)
3330   "Convert current buffer to MIME-Edit buffer and turn on MIME-Edit mode.
3331 Content-Type and Content-Transfer-Encoding header fields will be
3332 converted to MIME-Edit tags."
3333   (interactive)
3334   (goto-char (point-min))
3335   (if (search-forward
3336        (concat "\n" (regexp-quote mail-header-separator) "\n")
3337        nil t)
3338       (replace-match "\n\n")
3339     )
3340   (mime-edit-decode-message-in-buffer nil not-decode-text)
3341   (goto-char (point-min))
3342   (or no-separator
3343       (and (re-search-forward "^$")
3344            (replace-match mail-header-separator)
3345            ))
3346   (or not-turn-on
3347       (turn-on-mime-edit)
3348       ))
3349
3350
3351 ;;; @ end
3352 ;;;
3353
3354 (provide 'mime-edit)
3355
3356 (run-hooks 'mime-edit-load-hook)
3357
3358 ;;; mime-edit.el ends here