mime-edit.el

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