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