tm-edit.el

   1 ;;;
   2 ;;; tm-edit.el --- Simple MIME Composer for GNU Emacs
   3 ;;;
   4
   5 ;; Copyright (C) 1993 UMEDA Masanobu
   6 ;; Copyright (C) 1994,1995 MORIOKA Tomohiko
   7
   8 ;; Author: UMEDA Masanobu <umerin@mse.kyutech.ac.jp>
   9 ;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
  10 ;; Keywords: mail, news, MIME, multimedia, multilingual
  11
  12 ;; This file is not part of GNU Emacs.
  13
  14 ;; GNU Emacs is free software; you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either version 2, or (at your option)
  17 ;; any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  26 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  27
  28 ;;; Commentary:
  29
  30 ;; This is an Emacs minor mode for editing Internet multimedia
  31 ;; messages formatted in MIME (RFC 1521 and RFC 1522). All messages in
  32 ;; this mode are composed in the tagged MIME format, that are
  33 ;; described in the following examples. The messages composed in the
  34 ;; tagged MIME format are automatically translated into a MIME
  35 ;; compliant message when exiting the mode.
  36
  37 ;; Mule (a multilingual extension to Emacs 18 and 19) has a capability
  38 ;; of handling multilingual text in limited ISO-2022 manner that is
  39 ;; based on early experiences in Japanese Internet community and
  40 ;; resulted in RFC 1468 (ISO-2022-JP charset for MIME). In order to
  41 ;; enable multilingual capability in single text message in MIME,
  42 ;; charset of multilingual text written in Mule is declared as either
  43 ;; `ISO-2022-JP-2' [RFC 1554] or `ISO-2022-INT-1'. Mule is required
  44 ;; 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/editor-mode automatically:
  49 ;;
  50 ;; (autoload 'mime/editor-mode "tm-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 'mime/editor-mode)
  57 ;; (add-hook 'mail-send-hook 'mime-editor/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 ;;              (mime/editor-mode)
  65 ;;              (make-local-variable 'mail-header-separator)
  66 ;;              (setq mail-header-separator "--------")
  67 ;;              ))))
  68 ;; (add-hook 'mh-before-send-letter-hook 'mime-editor/maybe-translate)
  69 ;;
  70 ;; In case of News mode, you need the following hook definition:
  71 ;;
  72 ;; (add-hook 'news-reply-mode-hook 'mime/editor-mode)
  73 ;; (add-hook 'news-inews-hook 'mime-editor/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/editor-mode-hook
  79 ;;           (function
  80 ;;            (lambda ()
  81 ;;              (font-lock-mode 1)
  82 ;;              (setq font-lock-keywords (list mime-editor/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 ;;
  97 ;;--[[text/plain; charset=ISO-2022-JP]]
  98 ;; \e$B$3$l$O\e(B charset \e$B$r\e(B ISO-2022-JP \e$B$K;XDj$7$?F|K\8l$N\e(B plain \e$B%F%-%9%H$G$9\e(B.
  99 ;;
 100 ;;--[[text/richtext]]
 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 ;; LCD Archive Entry:
 108 ;; mime|Masanobu UMEDA|umerin@mse.kyutech.ac.jp|
 109 ;; Simple MIME Composer|
 110 ;; $Date: 1995/11/11 12:48:30 $|$Revision: 7.23 $|~/misc/mime.el.Z|
 111
 112 ;;; Code:
 113
 114 (require 'sendmail)
 115 (require 'mail-utils)
 116 (require 'mel)
 117 (require 'tl-822)
 118 (require 'tl-list)
 119 (require 'tm-view)
 120 (require 'tm-ew-e)
 121 (require 'signature)
 122
 123
 124 ;;; @ version
 125 ;;;
 126
 127 (defconst mime-editor/RCS-ID
 128   "$Id: tm-edit.el,v 7.23 1995/11/11 12:48:30 morioka Exp $")
 129
 130 (defconst mime-editor/version (get-version-string mime-editor/RCS-ID))
 131
 132
 133 ;;; @ variables
 134 ;;;
 135
 136 (defvar mime-prefix "\C-c\C-x"
 137   "*Keymap prefix for MIME commands.")
 138
 139 (defvar mime-signature-file "~/.signature.rtf"
 140   "*Signature file to be included as a part of a multipart message.")
 141
 142 (defvar mime-ignore-preceding-spaces nil
 143   "*Ignore preceding white spaces if non-nil.")
 144
 145 (defvar mime-ignore-trailing-spaces nil
 146   "*Ignore trailing white spaces if non-nil.")
 147
 148 (defvar mime-ignore-same-text-tag t
 149   "*Ignore preceding text content-type tag that is same with new one.
 150 If non-nil, the text tag is not inserted unless something different.")
 151
 152 (defvar mime-auto-hide-body t
 153   "*Hide non-textual body encoded in base64 after insertion if non-nil.")
 154
 155 (defvar mime-body-charset-chooser
 156   (cond ((boundp 'NEMACS)
 157          (function mime-body-charset-chooser-for-nemacs))
 158         ((featurep 'mule)
 159          (function mime-body-charset-chooser-for-mule))
 160         ((string-match "^19\\." emacs-version)
 161          (function mime-body-charset-chooser-for-emacs19))
 162         (t                              ;ASCII only emacs
 163          (function mime-body-charset-chooser-for-emacs18)))
 164   "*Function to identify charset and encoding of a text in a given region.
 165 The value is a form of (CHARSET . ENCODING), where ENCODING must be a
 166 full name, such as base64.")
 167
 168 (defvar mime-string-encoder
 169   (cond ((boundp 'NEMACS)
 170          (function mime-string-encoder-for-nemacs))
 171         ((featurep 'mule)
 172          (function mime-string-encoder-for-mule))
 173         ((string-match "^19\\." emacs-version)
 174          (function mime-string-encoder-for-emacs19))
 175         (t                              ;ASCII only emacs
 176          (function mime-string-encoder-for-emacs18)))
 177   "*Function to encode a string for given encoding method.
 178 The method is a form of (CHARSET . ENCODING).")
 179
 180 (defvar mime-voice-recorder
 181   (function mime-voice-recorder-for-sun)
 182   "*Function to record a voice message and return a buffer that contains it.")
 183
 184 (defvar mime/editor-mode-hook nil
 185   "*Hook called when enter MIME mode.")
 186
 187 (defvar mime-editor/translate-hook nil
 188   "*Hook called before translating into a MIME compliant message.
 189 To insert a signature file specified by mime-signature-file
 190 (`.signature.rtf' by default) automatically, call the function
 191 `mime-editor/insert-signature' from this hook.")
 192
 193 (defvar mime-editor/exit-hook nil
 194   "*Hook called when exit MIME mode.")
 195
 196 (defvar mime-content-types
 197   '(("text"
 198      ;; Charset parameter need not to be specified, since it is
 199      ;; defined automatically while translation.
 200      ("plain"
 201       ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8")
 202       )
 203      ("richtext"
 204       ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8")
 205       )
 206      ("enriched"
 207       ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8")
 208       )
 209      ("x-latex"
 210       ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8")
 211       )
 212      ("html"
 213       ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8")
 214       )
 215      ("x-rot13-47")
 216      )
 217     ("message"
 218      ("external-body"
 219       ("access-type"
 220        ("anon-ftp"
 221         ("site" "ftp.jaist.ac.jp" "wnoc-fuk.wide.ad.jp" "nic.karrn.ad.jp")
 222         ("directory" "/pub/GNU/elisp/mime")
 223         ("name")
 224         ("mode" "binary" "ascii"))
 225        ("ftp" ("site") ("directory") ("name") ("mode" "binary" "ascii"))
 226        ("tftp"        ("site") ("name"))
 227        ("afs"         ("site") ("name"))
 228        ("local-file"  ("site") ("name"))
 229        ("mail-server" ("server" "ftpmail@nic.karrn.ad.jp"))
 230        ))
 231      ("rfc822")
 232      )
 233     ("application"
 234      ("octet-stream"
 235       ("name")
 236       ("type" "" "tar" "shar")
 237       ("conversions"))
 238      ("postscript")
 239      ("x-kiss" ("x-cnf")))
 240     ("image"
 241      ("gif")
 242      ("jpeg")
 243      ("tiff")
 244      ("x-pic")
 245      ("x-xwd")
 246      ("x-xbm")
 247      )
 248     ("audio" ("basic"))
 249     ("video" ("mpeg"))
 250     )
 251   "*Alist of content-type, subtype, parameters and its values.")
 252
 253 (defvar mime-file-types
 254   '(("\\.rtf$"
 255      "text"     "richtext"      nil     nil)
 256     ("\\.html$"
 257      "text"     "html"          nil     nil)
 258     ("\\.ps$"
 259      "application" "postscript" nil     "quoted-printable")
 260     ("\\.gif$"
 261      "image"    "gif"           nil     "base64"
 262      (("Content-Description" . file))
 263      )
 264     ("\\.jpg$"
 265      "image"    "jpeg"          nil     "base64")
 266     ("\\.xwd$"
 267      "image"    "x-xwd"         nil     "base64")
 268     ("\\.xbm$"
 269      "image"    "x-xbm"         nil     "base64")
 270     ("\\.pic$"
 271      "image"    "x-pic"         nil     "base64"
 272      (("Content-Description" . file))
 273      )
 274     ("\\.tiff$"
 275      "image"    "tiff"          nil     "base64")
 276     ("\\.au$"
 277      "audio"    "basic"         nil     "base64")
 278     ("\\.mpg$"
 279      "video"    "mpeg"          nil     "base64")
 280     ("\\.el$"
 281      "application" "octet-stream" (("name" . file)
 282                                    ("type" . "emacs-lisp")) "7bit")
 283     ("\\.lsp$"
 284      "application" "octet-stream" (("name" . file)
 285                                    ("type" . "common-lisp")) "7bit")
 286     ("\\.tar.gz$"
 287      "application" "octet-stream" (("name" . file)
 288                                    ("type" . "tar")
 289                                    ("conversions" . "gzip")) nil)
 290     ("\\.diff$"
 291      "application" "octet-stream" (("name" . file)
 292                                    ("type" . "patch")) nil)
 293     ("\\.signature"
 294      "text"     "plain"         nil     nil)
 295     (".*"       nil             nil     nil     nil)
 296     )
 297   "*Alist of file name, types, parameters, and default encoding.
 298 If encoding is nil, it is determined from its contents.")
 299
 300 ;;; @@ about message inserting
 301 ;;;
 302
 303 (defvar mime-editor/yank-ignored-fields-regexp
 304   "^\\(Received\\|X-UIDL\\|Sender\\|Approved\\|Path\\):")
 305
 306 (defvar mime-editor/message-inserter-alist nil)
 307 (defvar mime-editor/mail-inserter-alist nil)
 308
 309 ;;; @@ about message splitting
 310 ;;;
 311
 312 (defvar mime-editor/split-message t)
 313
 314 (defvar mime-editor/message-default-max-length 1000)
 315
 316 (defvar mime-editor/message-max-length-alist
 317   '((news-reply-mode . 500)))
 318
 319 (defconst mime-editor/split-ignored-fields-regexp
 320   "\\(^Content-\\|^Subject:\\|^Mime-Version:\\)")
 321
 322 (defvar mime-editor/split-blind-fields-regexp
 323   "\\(^[BDFbdf]cc:\\|^cc:[ \t]*$\\)")
 324
 325 (defvar mime-editor/message-default-sender-alist
 326   '((mail-mode . mail-send-and-exit)
 327     (mh-letter-mode . mh-send-letter)
 328     (news-reply-mode . gnus-inews-news)
 329     ))
 330
 331 (defvar mime-editor/split-message-sender-alist
 332   '((mail-mode
 333      . (lambda ()
 334          (interactive)
 335          (sendmail-send-it)
 336          ))
 337     (mh-letter-mode
 338      . (lambda (&optional arg)
 339          (interactive "P")
 340          (write-region (point-min) (point-max)
 341                        mime-editor/draft-file-name nil 'no-message)
 342          (cond (arg
 343                 (pop-to-buffer "MH mail delivery")
 344                 (erase-buffer)
 345                 (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush"
 346                                     "-nodraftfolder"
 347                                     mh-send-args mime-editor/draft-file-name)
 348                 (goto-char (point-max)) ; show the interesting part
 349                 (recenter -1)
 350                 (sit-for 1))
 351                (t
 352                 (apply 'mh-exec-cmd-quiet t mh-send-prog
 353                        (mh-list-to-string
 354                         (list "-nopush" "-nodraftfolder"
 355                               "-noverbose" "-nowatch"
 356                               mh-send-args mime-editor/draft-file-name)))))
 357          ))
 358     ))
 359
 360 (defvar mime-editor/window-config-alist
 361   '((mail-mode       . nil)
 362     (mh-letter-mode  . mh-previous-window-config)
 363     (news-reply-mode . (cond ((boundp 'gnus-winconf-post-news)
 364                               (prog1
 365                                   gnus-winconf-post-news
 366                                 (setq gnus-winconf-post-news nil)
 367                                 ))
 368                              ((boundp 'gnus-prev-winconf)
 369                               (prog1
 370                                   gnus-prev-winconf
 371                                 (setq gnus-prev-winconf nil)
 372                                 ))
 373                              ))
 374     ))
 375
 376 (defvar mime-editor/news-reply-mode-server-running nil)
 377
 378 ;;; @@ about tag
 379 ;;;
 380
 381 (defconst mime-editor/single-part-tag-regexp
 382   "^--[[][[]\\([^]]*\\)]\\([[]\\([^]]*\\)]\\|\\)]"
 383   "*Regexp of MIME tag in the form of [[CONTENT-TYPE][ENCODING]].")
 384
 385 (defconst mime-editor/multipart-beginning-regexp "^--<<\\([^<>]+\\)>>-{\n")
 386
 387 (defconst mime-editor/multipart-end-regexp "^--}-<<\\([^<>]+\\)>>\n")
 388
 389 (defconst mime-editor/beginning-tag-regexp
 390   (regexp-or mime-editor/single-part-tag-regexp
 391              mime-editor/multipart-beginning-regexp))
 392
 393 (defconst mime-editor/end-tag-regexp
 394   (regexp-or mime-editor/single-part-tag-regexp
 395              mime-editor/multipart-end-regexp))
 396
 397 (defconst mime-editor/tag-regexp
 398   (regexp-or mime-editor/single-part-tag-regexp
 399              mime-editor/multipart-beginning-regexp
 400              mime-editor/multipart-end-regexp))
 401
 402 (defvar mime-tag-format "--[[%s]]"
 403   "*Control-string making a MIME tag.")
 404
 405 (defvar mime-tag-format-with-encoding "--[[%s][%s]]"
 406   "*Control-string making a MIME tag with encoding.")
 407
 408 ;;; @@ multipart boundary
 409 ;;;
 410
 411 (defvar mime-multipart-boundary "Multipart"
 412   "*Boundary of a multipart message.")
 413
 414
 415 ;;; @@ buffer local variables
 416 ;;;
 417
 418 (defvar mime/editor-mode-old-local-map nil)
 419 (defvar mime/editor-mode-old-selective-display nil)
 420 (defvar mime/editing-buffer nil)
 421
 422 \f
 423 ;;; @ constants
 424 ;;;
 425
 426 (defconst mime-tspecials-regexp "[][()<>@,;:\\\"/?.= \t]"
 427   "*Specify MIME tspecials.
 428 Tspecials means any character that matches with it in header must be quoted.")
 429
 430 (defconst mime-editor/mime-version-value
 431   (format "1.0 (generated by tm-edit %s)" mime-editor/version)
 432   "MIME version number.")
 433
 434
 435 ;;; @ keymap and menu
 436 ;;;
 437
 438 (defvar mime/editor-mode-flag nil)
 439 (make-variable-buffer-local 'mime/editor-mode-flag)
 440
 441 (set-alist 'minor-mode-alist 'mime/editor-mode-flag '(" MIME-Edit"))
 442
 443 (defun mime-editor/define-keymap (keymap)
 444   "Add mime-editor commands to KEYMAP."
 445   (if (not (keymapp keymap))
 446       nil
 447     (define-key keymap "\C-t" 'mime-editor/insert-text)
 448     (define-key keymap "\C-i" 'mime-editor/insert-file)
 449     (define-key keymap "\C-e" 'mime-editor/insert-external)
 450     (define-key keymap "\C-v" 'mime-editor/insert-voice)
 451     (define-key keymap "\C-y" 'mime-editor/insert-message)
 452     (define-key keymap "\C-m" 'mime-editor/insert-mail)
 453     (define-key keymap "\C-w" 'mime-editor/insert-signature)
 454     (define-key keymap "\C-s" 'mime-editor/insert-signature)
 455     (define-key keymap "t"    'mime-editor/insert-tag)
 456     (define-key keymap "a"    'mime-editor/enclose-alternative-region)
 457     (define-key keymap "p"    'mime-editor/enclose-parallel-region)
 458     (define-key keymap "m"    'mime-editor/enclose-mixed-region)
 459     (define-key keymap "d"    'mime-editor/enclose-digest-region)
 460     (define-key keymap "\C-p" 'mime-editor/preview-message)
 461     (define-key keymap "\C-z" 'mime-editor/exit)
 462     (define-key keymap "?"    'mime-editor/help)
 463     ))
 464
 465 (defconst mime-editor/menu-title "MIME-Edit")
 466
 467 (defconst mime-editor/menu-list
 468   '((mime-help  "Describe MIME Mode"    mime-editor/help)
 469     (file       "Insert File"           mime-editor/insert-file)
 470     (external   "Insert External"       mime-editor/insert-external)
 471     (voice      "Insert Voice"          mime-editor/insert-voice)
 472     (message    "Insert Message"        mime-editor/insert-message)
 473     (mail       "Insert Mail"           mime-editor/insert-mail)
 474     (signature  "Insert Signature"      mime-editor/insert-signature)
 475     (text       "Insert Text"           mime-editor/insert-text)
 476     (tag        "Insert Tag"            mime-editor/insert-tag)
 477     (alternative "Enclose as alternative"
 478                  mime-editor/enclose-alternative-region)
 479     (parallel   "Enclose as parallel"   mime-editor/enclose-parallel-region)
 480     (mixed      "Enclose as serial"     mime-editor/enclose-mixed-region)
 481     (digest     "Enclose as digest"     mime-editor/enclose-digest-region)
 482     (preview    "Preview Message"       mime-editor/preview-message)
 483     )
 484   "MIME-edit menubar entry.")
 485
 486 (defun mime-editor/define-menu-for-emacs19 ()
 487   "Define menu for Emacs 19."
 488   (define-key (current-local-map) [menu-bar mime-edit]
 489     (cons mime-editor/menu-title
 490           (make-sparse-keymap mime-editor/menu-title)))
 491   (mapcar (function
 492            (lambda (item)
 493              (define-key (current-local-map)
 494                (vector 'menu-bar 'mime-edit (car item))
 495                (cons (nth 1 item)(nth 2 item))
 496                )
 497              ))
 498           (reverse mime-editor/menu-list)
 499           ))
 500
 501 ;;; modified by Pekka Marjola <pema@niksula.hut.fi>
 502 ;;;     1995/9/5 (c.f. [tm-eng:69])
 503 (defun mime-editor/define-menu-for-xemacs ()
 504   "Define menu for Emacs 19."
 505   (cond ((featurep 'menubar)
 506          (make-local-variable 'current-menubar)
 507          (set-buffer-menubar current-menubar)
 508          (add-submenu nil
 509                       (cons mime-editor/menu-title
 510                             (mapcar (function
 511                                      (lambda (item)
 512                                        (vector (nth 1 item)(nth 2 item)
 513                                                mime/editor-mode-flag)
 514                                        ))
 515                                     mime-editor/menu-list)))
 516          )))
 517 ;;; end
 518
 519
 520 ;;; @ functions
 521 ;;;
 522
 523 ;;;###autoload
 524 (defun mime/editor-mode ()
 525   "MIME minor mode for editing the tagged MIME message.
 526
 527 In this mode, basically, the message is composed in the tagged MIME
 528 format.  The message tag looks like:
 529
 530         `--[[text/plain; charset=ISO-2022-JP][7bit]]'.
 531
 532 The tag specifies the MIME content type, subtype, optional parameters
 533 and transfer encoding of the message following the tag.  Messages
 534 without any tag are treated as `text/plain' by default.  Charset and
 535 transfer encoding are automatically defined unless explicitly
 536 specified.  Binary messages such as audio and image are usually hidden
 537 using selective-display facility.  The messages in the tagged MIME
 538 format are automatically translated into a MIME compliant message when
 539 exiting this mode.
 540
 541 Available charsets depend on Emacs version being used.  The following
 542 lists the available charsets of each emacs.
 543
 544 Emacs18:        US-ASCII is only available.
 545 NEmacs:         US-ASCII and ISO-2022-JP are available.
 546 Emacs19:        US-ASCII and ISO-8859-1 are available.
 547 Mule:           US-ASCII, ISO-8859-* (except for ISO-8859-6),
 548                 ISO-2022-JP, ISO-2022-JP-2 and ISO-2022-INT-1 are available.
 549
 550 ISO-2022-JP-2 and ISO-2022-INT-1 charsets used in Mule is expected to
 551 be used to represent multilingual text in intermixed manner.  Any
 552 languages that has no registered charset are represented as either
 553 ISO-2022-JP-2 or ISO-2022-INT-1 in Mule.
 554
 555 Following commands are available in addition to major mode commands:
 556 \\[mime-editor/insert-text]     insert a text message.
 557 \\[mime-editor/insert-file]     insert a (binary) file.
 558 \\[mime-editor/insert-external] insert a reference to external body.
 559 \\[mime-editor/insert-voice]    insert a voice message.
 560 \\[mime-editor/insert-message]  insert a mail or news message.
 561 \\[mime-editor/insert-mail]     insert a mail message.
 562 \\[mime-editor/insert-signature]        insert a signature file at end.
 563 \\[mime-editor/insert-tag]      insert a new MIME tag.
 564 \\[mime-editor/enclose-alternative-region]      enclose as multipart/alternative.
 565 \\[mime-editor/enclose-parallel-region] enclose as multipart/parallel.
 566 \\[mime-editor/enclose-mixed-region]    enclose as multipart/mixed.
 567 \\[mime-editor/enclose-digest-region]   enclose as multipart/digest.
 568 \\[mime-editor/preview-message] preview editing MIME message.
 569 \\[mime-editor/exit]    exit and translate into a MIME compliant message.
 570 \\[mime-editor/maybe-translate] exit, translate and run the original command.
 571 \\[mime-editor/help]    show this help.
 572
 573 Additional commands are available in some major modes:
 574 C-c C-c         exit, translate and run the original command.
 575 C-c C-s         exit, translate and run the original command.
 576
 577 The following is a message example written in the tagged MIME format.
 578 TABs at the beginning of the line are not a part of the message:
 579
 580         This is a conventional plain text.  It should be translated
 581         into text/plain.
 582         --[[text/plain]]
 583         This is also a plain text.  But, it is explicitly specified as
 584         is.
 585         --[[text/plain; charset=ISO-2022-JP]]
 586         \e$B$3$l$O\e(B charset \e$B$r\e(B ISO-2022-JP \e$B$K;XDj$7$?F|K\8l$N\e(B plain \e$B%F%-%9\e(B
 587         \e$B%H$G$9\e(B.
 588         --[[text/richtext]]
 589         <center>This is a richtext.</center>
 590         --[[image/gif][base64]]^M...image encoded in base64 here...
 591         --[[audio/basic][base64]]^M...audio encoded in base64 here...
 592
 593 User customizable variables (not documented all of them):
 594  mime-prefix
 595     Specifies a key prefix for MIME minor mode commands.
 596
 597  mime-signature-file
 598     Specifies a signature file to be included as part of a multipart
 599     message.
 600
 601  mime-ignore-preceding-spaces
 602     Preceding white spaces in a message body are ignored if non-nil.
 603
 604  mime-ignore-trailing-spaces
 605     Trailing white spaces in a message body are ignored if non-nil.
 606
 607  mime-auto-fill-header
 608     Fill header fields that contain encoded-words if non-nil.
 609
 610  mime-auto-hide-body
 611     Hide a non-textual body message encoded in base64 after insertion
 612     if non-nil.
 613
 614  mime-body-charset-chooser
 615     Specifies a function to identify charset and encoding of a text in
 616     a given region.  The value is a form of (CHARSET . ENCODING),
 617     where ENCODING must be a full name, such as base64.
 618
 619  mime-string-encoder
 620     Specifies a function to encode a string for given encoding method.
 621     The method is a form of (CHARSET . ENCODING).
 622
 623  mime-voice-recorder
 624     Specifies a function to record a voice message and return a buffer
 625     that contains it.  The function mime-voice-recorder-for-sun is for
 626     Sun SparcStations.
 627
 628  mime/editor-mode-hook
 629     Turning on MIME mode calls the value of mime/editor-mode-hook, if
 630     it is non-nil.
 631
 632  mime-editor/translate-hook
 633     The value of mime-editor/translate-hook is called just before translating
 634     the tagged MIME format into a MIME compliant message if it is
 635     non-nil.  If the hook call the function mime-editor/insert-signature,
 636     the signature file will be inserted automatically.
 637
 638  mime-editor/exit-hook
 639     Turning off MIME mode calls the value of mime-editor/exit-hook, if it is
 640     non-nil."
 641   (interactive)
 642   (if mime/editor-mode-flag
 643       (error "You are already editing a MIME message.")
 644     (setq mime/editor-mode-flag t)
 645     ;; Remember old key bindings.
 646     (make-local-variable 'mime/editor-mode-old-local-map)
 647     (setq mime/editor-mode-old-local-map (current-local-map))
 648     ;; Add MIME commands to current local map.
 649     (use-local-map (copy-keymap (current-local-map)))
 650     (if (not (lookup-key (current-local-map) mime-prefix))
 651         (define-key (current-local-map) mime-prefix (make-sparse-keymap)))
 652     (mime-editor/define-keymap (lookup-key (current-local-map) mime-prefix))
 653
 654     ;; Define menu.  Menus for other emacs implementations are
 655     ;; welcome.
 656     ;;  modified by Pekka Marjola <pema@niksula.hut.fi>
 657     ;;          1995/9/5 (c.f. [tm-eng:69])
 658     (cond ((string-match "XEmacs\\|Lucid" emacs-version)
 659            (mime-editor/define-menu-for-xemacs))
 660           ((string-match "^19\\." emacs-version)
 661            (mime-editor/define-menu-for-emacs19)
 662            ))
 663     ;; end
 664
 665     ;; Remember old selective-display.
 666     (make-local-variable 'mime/editor-mode-old-selective-display)
 667     (setq mime/editor-mode-old-selective-display selective-display)
 668     (setq selective-display t)
 669     ;; I don't care about saving these.
 670     (setq paragraph-start
 671           (concat mime-editor/single-part-tag-regexp "\\|" paragraph-start))
 672     (setq paragraph-separate
 673           (concat mime-editor/single-part-tag-regexp "\\|" paragraph-separate))
 674     (run-hooks 'mime/editor-mode-hook)
 675     (message
 676      (substitute-command-keys
 677       "Type \\[mime-editor/exit] to exit MIME mode, and type \\[mime-editor/help] to get help."))
 678     ))
 679
 680 ;;;###autoload
 681 (defalias 'edit-mime 'mime/editor-mode)         ; for convenience
 682 (defalias 'mime-mode 'mime/editor-mode)         ; for convenience
 683
 684 (defun mime-editor/exit (&optional nomime no-error)
 685   "Translate the tagged MIME message into a MIME compliant message.
 686 With no argument encode a message in the buffer into MIME, otherwise
 687 just return to previous mode."
 688   (interactive "P")
 689   (if (not mime/editor-mode-flag)
 690       (if (null no-error)
 691           (error "You aren't editing a MIME message.")
 692         )
 693     (if (not nomime)
 694         (progn
 695           (run-hooks 'mime-editor/translate-hook)
 696           (mime-editor/translate-buffer)))
 697     ;; Restore previous state.
 698     (setq mime/editor-mode-flag nil)
 699     (use-local-map mime/editor-mode-old-local-map)
 700
 701     ;; modified by Pekka Marjola <pema@niksula.hut.fi>
 702     ;;  1995/9/5 (c.f. [tm-eng:69])
 703     (if (string-match "XEmacs\\|Lucid" emacs-version)
 704         (progn
 705           (delete-menu-item (list mime-editor/menu-title))
 706                                         ; should rather be const
 707           ;; (while mime-editor/xemacs-old-bindings
 708           ;;   (eval (pop mime-editor/xemacs-old-bindings)))
 709           (local-unset-key mime-prefix)))
 710     ;; end
 711
 712     (setq selective-display mime/editor-mode-old-selective-display)
 713     (set-buffer-modified-p (buffer-modified-p))
 714     (run-hooks 'mime-editor/exit-hook)
 715     (message "Exit MIME editor mode.")
 716     ))
 717
 718 (defun mime-editor/maybe-translate ()
 719   (interactive)
 720   (mime-editor/exit nil t)
 721   (call-interactively 'mime-editor/split-and-send)
 722   )
 723
 724 (defun mime-editor/help ()
 725   "Show help message about MIME mode."
 726   (interactive)
 727   (with-output-to-temp-buffer "*Help*"
 728     (princ "MIME editor mode:\n")
 729     (princ (documentation 'mime/editor-mode))
 730     (print-help-return-message)))
 731
 732 (defun mime-editor/insert-text ()
 733   "Insert a text message.
 734 Charset is automatically obtained from the mime-body-charset-chooser."
 735   (interactive)
 736   (if (and (mime-editor/insert-tag "text" nil nil)
 737            (looking-at mime-editor/single-part-tag-regexp))
 738       (progn
 739         ;; Make a space between the following message.
 740         (insert "\n")
 741         (forward-char -1)
 742         )))
 743
 744 (defun mime-editor/insert-file (file)
 745   "Insert a message from a file."
 746   (interactive "fInsert file as MIME message: ")
 747   (let*  ((guess (mime-find-file-type file))
 748           (pritype (nth 0 guess))
 749           (subtype (nth 1 guess))
 750           (parameters (nth 2 guess))
 751           (default (nth 3 guess))       ;Guess encoding from its file name.
 752           (fields (nth 4 guess))
 753           (encoding
 754            (if (not (interactive-p))
 755                default
 756              (completing-read
 757               (concat "What transfer encoding"
 758                       (if default
 759                           (concat " (default "
 760                                   (if (string-equal default "")
 761                                       "\"\""
 762                                     default)
 763                                   ")"
 764                                   ))
 765                       ": ")
 766               mime-encoding-method-alist nil t nil))))
 767     (if (string-equal encoding "")
 768         (setq encoding default))
 769     (if (or (consp parameters) (consp fields))
 770         (let ((rest parameters) cell attribute value)
 771           (setq parameters "")
 772           (while rest
 773             (setq cell (car rest))
 774             (setq attribute (car cell))
 775             (setq value (cdr cell))
 776             (if (eq value 'file)
 777                 (setq value (file-name-nondirectory file))
 778               )
 779             (setq parameters (concat parameters "; " attribute "=" value))
 780             (setq rest (cdr rest))
 781             )
 782           (setq rest fields)
 783           (while rest
 784             (setq cell (car rest))
 785             (setq attribute (car cell))
 786             (setq value (cdr cell))
 787             (if (eq value 'file)
 788                 (setq value (file-name-nondirectory file))
 789               )
 790             (setq parameters (concat parameters "\n" attribute ": " value))
 791             (setq rest (cdr rest))
 792             )
 793           ))
 794     (mime-editor/insert-tag pritype subtype parameters)
 795     (mime-editor/insert-binary-file file encoding)
 796     ))
 797
 798 (defun mime-editor/insert-external ()
 799   "Insert a reference to external body."
 800   (interactive)
 801   (mime-editor/insert-tag "message" "external-body" nil ";\n\t")
 802   ;;(forward-char -1)
 803   ;;(insert "Content-Description: " (read-string "Content-Description: ") "\n")
 804   ;;(forward-line 1)
 805   (let* ((pritype (mime-prompt-for-type))
 806          (subtype (mime-prompt-for-subtype pritype))
 807          (parameters (mime-prompt-for-parameters pritype subtype ";\n\t")))
 808     (and pritype
 809          subtype
 810          (insert "Content-Type: "
 811                  pritype "/" subtype (or parameters "") "\n")))
 812   (if (and (not (eobp))
 813            (not (looking-at mime-editor/single-part-tag-regexp)))
 814       (insert (mime-make-text-tag) "\n")))
 815
 816 (defun mime-editor/insert-voice ()
 817   "Insert a voice message."
 818   (interactive)
 819   (mime-editor/insert-tag "audio" "basic" nil)
 820   (let ((buffer (funcall mime-voice-recorder)))
 821     (unwind-protect
 822         (mime-editor/insert-binary-buffer buffer "base64")
 823       (kill-buffer buffer)
 824       )))
 825
 826 (defun mime-editor/insert-signature ()
 827   "Insert a signature file specified by mime-signature-file."
 828   (interactive)
 829   (save-restriction
 830     (apply (function mime-editor/insert-tag)
 831            (prog1
 832                (mime-find-file-type (insert-signature))
 833              (narrow-to-region (point-min)(point))
 834              ))
 835     ))
 836 \f
 837 ;; Insert a new tag around a point.
 838
 839 (defun mime-editor/insert-tag (&optional pritype subtype parameters delimiter)
 840   "Insert new MIME tag and return a list of PRITYPE, SUBTYPE, and PARAMETERS.
 841 If nothing is inserted, return nil."
 842   (interactive)
 843   (let ((oldtag nil)
 844         (newtag nil)
 845         (current (point)))
 846     (setq pritype
 847           (or pritype
 848               (mime-prompt-for-type)))
 849     (setq subtype
 850           (or subtype
 851               (mime-prompt-for-subtype pritype)))
 852     (setq parameters
 853           (or parameters
 854               (mime-prompt-for-parameters pritype subtype delimiter)))
 855     ;; Make a new MIME tag.
 856     (setq newtag (mime-make-tag pritype subtype parameters))
 857     ;; Find an current MIME tag.
 858     (setq oldtag
 859           (save-excursion
 860             (if (mime-editor/goto-tag)
 861                 (buffer-substring (match-beginning 0) (match-end 0))
 862               ;; Assume content type is 'text/plan'.
 863               (mime-make-tag "text" "plain")
 864               )))
 865     ;; We are only interested in TEXT.
 866     (if (and oldtag
 867              (not (mime-test-content-type
 868                    (mime-editor/get-contype oldtag) "text")))
 869         (setq oldtag nil))
 870     (beginning-of-line)
 871     (cond ((and oldtag                  ;Text
 872                 (not (eobp))
 873                 (save-excursion
 874                   (forward-line -1)
 875                   (looking-at mime-editor/beginning-tag-regexp)
 876                   )
 877                 (or mime-ignore-same-text-tag
 878                     (not (string-equal oldtag newtag))))
 879            ;; If point is at the next of current tag, move to the
 880            ;; beginning of the tag to disable insertion of extra tag.
 881            (forward-line -1))
 882           ((and oldtag                  ;Text
 883                 (not (eobp))
 884                 (not (looking-at mime-editor/tag-regexp))
 885                 (or mime-ignore-same-text-tag
 886                     (not (string-equal oldtag newtag))))
 887            ;; Copy current tag to break a text into two.
 888            (save-excursion
 889              (insert oldtag "\n")))
 890           ((and (null oldtag)           ;Not text
 891                 (not (looking-at mime-editor/tag-regexp)))
 892            ;; Adjust insertion point.  In the middle of text, it is
 893            ;; okay to break the text into two.  However, it should not
 894            ;; be broken into two, if otherwise.
 895            (goto-char (mime-editor/content-end))
 896            (if (eolp)
 897                (forward-line 1))
 898            (if (not (bolp))
 899                (insert "\n"))
 900            ))
 901     ;; Make a new tag.
 902     (if (or (not oldtag)                ;Not text
 903             (or mime-ignore-same-text-tag
 904                 (not (string-equal oldtag newtag))))
 905         (progn
 906           ;; Mark the beginning of the tag for convenience.
 907           (push-mark (point) 'nomsg)
 908           (insert newtag "\n")
 909           (list pritype subtype parameters) ;New tag is created.
 910           )
 911       ;; Restore previous point.
 912       (goto-char current)
 913       nil                               ;Nothing is created.
 914       )
 915     ))
 916
 917 ;; Insert the binary content after MIME tag.
 918 ;;      modified by MORITA Masahiro <hiro@isl.ntt.JP>
 919 ;;      for x-uue
 920 (defun mime-editor/insert-binary-file (file &optional encoding)
 921   "Insert binary FILE at point.
 922 Optional argument ENCODING specifies an encoding method such as base64."
 923   (let ((tmpbuf (get-buffer-create " *MIME insert*")))
 924     (save-excursion
 925       (set-buffer tmpbuf)
 926       (erase-buffer)
 927       (let ((mc-flag nil)               ;Mule
 928             (file-coding-system-for-read
 929              (if (featurep 'mule) *noconv*))
 930             (kanji-flag nil)            ;NEmacs
 931             (emx-binary-mode t)         ;Stop CRLF to LF conversion in OS/2
 932             )
 933         (let (jka-compr-compression-info-list
 934               jam-zcat-filename-list)
 935           (insert-file-contents file))))
 936     (prog1
 937         (if (and (stringp encoding)
 938                  (string-equal (downcase encoding) "x-uue"))
 939             (progn
 940               (require 'mel-u)
 941               (let ((uuencode-external-encoder
 942                      (cons (car uuencode-external-encoder)
 943                            (list (file-name-nondirectory file))
 944                            )))
 945                 (mime-editor/insert-binary-buffer tmpbuf encoding)
 946                 ))
 947           (mime-editor/insert-binary-buffer tmpbuf encoding))
 948       (kill-buffer tmpbuf))))
 949
 950 ;; Insert the binary content after MIME tag.
 951 ;;      modified by MORITA Masahiro <hiro@isl.ntt.JP>
 952 ;;      for x-uue
 953 (defun mime-editor/insert-binary-buffer (buffer &optional encoding)
 954   "Insert binary BUFFER at point.
 955 Optional argument ENCODING specifies an encoding method such as base64."
 956   (let* ((tagend (1- (point)))          ;End of the tag
 957          (hide-p (and mime-auto-hide-body
 958                       (stringp encoding)
 959                       (let ((en (downcase encoding)))
 960                         (or (string-equal en "base64")
 961                             (string-equal en "x-uue")
 962                             ))))
 963          )
 964     (save-restriction
 965       (narrow-to-region (1- (point)) (point))
 966       (let ((start (point))
 967             (emx-binary-mode t))        ;Stop LF to CRLF conversion in OS/2
 968         (insert-buffer-substring buffer)
 969         ;; Encode binary message if necessary.
 970         (if encoding
 971             (mime-encode-region encoding start (point-max))))
 972       (if hide-p
 973           (progn
 974             (mime-flag-region (point-min) (1- (point-max)) ?\^M)
 975             (goto-char (point-max)))
 976         ))
 977     ;; Define encoding even if it is 7bit.
 978     (if (stringp encoding)
 979         (save-excursion
 980           (goto-char tagend)            ;Make sure which line the tag is on.
 981           (mime-editor/define-encoding encoding)))
 982     ))
 983
 984 \f
 985 ;; Commands work on a current message flagment.
 986
 987 (defun mime-editor/goto-tag ()
 988   "Search for the beginning of the tagged MIME message."
 989   (let ((current (point)) multipart)
 990     (if (looking-at mime-editor/tag-regexp)
 991         t
 992       ;; At first, go to the end.
 993       (cond ((re-search-forward mime-editor/beginning-tag-regexp nil t)
 994              (goto-char (match-beginning 0)) ;For multiline tag
 995              (forward-line -1)
 996              (end-of-line)
 997              )
 998             (t
 999              (goto-char (point-max))
1000              ))
1001       ;; Then search for the beginning.
1002       (re-search-backward mime-editor/end-tag-regexp nil t)
1003       (beginning-of-line)
1004       (or (looking-at mime-editor/beginning-tag-regexp)
1005           ;; Restore previous point.
1006           (progn
1007             (goto-char current)
1008             nil
1009             ))
1010       )))
1011
1012 (defun mime-editor/content-beginning ()
1013   "Return the point of the beginning of content."
1014   (save-excursion
1015     (let ((beg (save-excursion
1016                  (beginning-of-line) (point))))
1017       (if (mime-editor/goto-tag)
1018           (let ((top (point)))
1019             (goto-char (match-end 0))
1020             (if (and (= beg top)
1021                      (= (following-char) ?\^M))
1022                 (point)
1023               (forward-line 1)
1024               (point)))
1025         ;; Default text/plain tag.
1026         (goto-char (point-min))
1027         (re-search-forward
1028          (concat "\n" (regexp-quote mail-header-separator)
1029                  (if mime-ignore-preceding-spaces
1030                      "[ \t\n]*\n" "\n")) nil 'move)
1031         (point))
1032       )))
1033
1034 (defun mime-editor/content-end ()
1035   "Return the point of the end of content."
1036   (save-excursion
1037     (let ((beg (save-excursion
1038                  (beginning-of-line) (point))))
1039       (if (mime-editor/goto-tag)
1040           (let ((top (point)))
1041             (goto-char (match-end 0))
1042             (if (and (= beg top)        ;Must be on the same line.
1043                      (= (following-char) ?\^M))
1044                 (progn
1045                   (end-of-line)
1046                   (point))
1047               ;; Move to the end of this text.
1048               (if (re-search-forward mime-editor/tag-regexp nil 'move)
1049                   ;; Don't forget a multiline tag.
1050                   (goto-char (match-beginning 0)))
1051               (point)
1052               ))
1053         ;; Assume the message begins with text/plain.
1054         (goto-char (mime-editor/content-beginning))
1055         (if (re-search-forward mime-editor/tag-regexp nil 'move)
1056             ;; Don't forget a multiline tag.
1057             (goto-char (match-beginning 0)))
1058         (point))
1059       )))
1060
1061 (defun mime-editor/define-charset (charset)
1062   "Set charset of current tag to CHARSET."
1063   (save-excursion
1064     (if (mime-editor/goto-tag)
1065         (let ((tag (buffer-substring (match-beginning 0) (match-end 0))))
1066           (delete-region (match-beginning 0) (match-end 0))
1067           (insert
1068            (mime-create-tag (mime-set-parameter
1069                              (mime-editor/get-contype tag) "charset" charset)
1070                             (mime-editor/get-encoding tag))))
1071       )))
1072
1073 (defun mime-editor/define-encoding (encoding)
1074   "Set encoding of current tag to ENCODING."
1075   (save-excursion
1076     (if (mime-editor/goto-tag)
1077         (let ((tag (buffer-substring (match-beginning 0) (match-end 0))))
1078           (delete-region (match-beginning 0) (match-end 0))
1079           (insert (mime-create-tag (mime-editor/get-contype tag) encoding)))
1080       )))
1081
1082 (defun mime-editor/choose-charset ()
1083   "Choose charset of a text following current point."
1084   (save-excursion
1085     (let* ((beg (point))
1086            (end (mime-editor/content-end)))
1087       (car (funcall mime-body-charset-chooser beg end)))))
1088
1089 (defun mime-editor/choose-encoding ()
1090   "Choose encoding of a text following current point."
1091   (save-excursion
1092     (let* ((beg (point))
1093            (end (mime-editor/content-end)))
1094       (cdr (funcall mime-body-charset-chooser beg end)))))
1095
1096 (defun mime-make-text-tag (&optional subtype)
1097   "Make a tag for a text after current point.
1098 Subtype of text type can be specified by an optional argument SUBTYPE.
1099 Otherwise, it is obtained from mime-content-types."
1100   (let* ((pritype "text")
1101          (subtype (or subtype
1102                       (car (car (cdr (assoc pritype mime-content-types)))))))
1103     ;; Charset should be defined later.
1104     (mime-make-tag pritype subtype)))
1105
1106 \f
1107 ;; Tag handling functions
1108
1109 (defun mime-make-tag (pritype subtype &optional parameters encoding)
1110   "Make a tag of MIME message of PRITYPE, SUBTYPE and optional PARAMETERS."
1111   (mime-create-tag (concat (or pritype "") "/" (or subtype "")
1112                            (or parameters ""))
1113                    encoding))
1114
1115 (defun mime-create-tag (contype &optional encoding)
1116   "Make a tag with CONTENT-TYPE and optional ENCODING."
1117   (format (if encoding mime-tag-format-with-encoding mime-tag-format)
1118           contype encoding))
1119
1120 (defun mime-editor/get-contype (tag)
1121   "Return Content-Type (including parameters) of TAG."
1122   (and (stringp tag)
1123        (or (string-match mime-editor/single-part-tag-regexp tag)
1124            (string-match mime-editor/multipart-beginning-regexp tag)
1125            (string-match mime-editor/multipart-end-regexp tag)
1126            )
1127        (substring tag (match-beginning 1) (match-end 1))
1128        ))
1129
1130 (defun mime-editor/get-encoding (tag)
1131   "Return encoding of TAG."
1132   (and (stringp tag)
1133        (string-match mime-editor/single-part-tag-regexp tag)
1134        (match-beginning 3)
1135        (not (= (match-beginning 3) (match-end 3)))
1136        (substring tag (match-beginning 3) (match-end 3))))
1137
1138 (defun mime-get-parameter (contype parameter)
1139   "For given CONTYPE return value for PARAMETER.
1140 Nil if no such parameter."
1141   (if (string-match
1142        (concat
1143         ";[ \t\n]*"
1144         (regexp-quote parameter)
1145         "[ \t\n]*=[ \t\n]*\\([^\" \t\n;]*\\|\"[^\"]*\"\\)\\([ \t\n]*;\\|$\\)")
1146        contype)
1147       (substring contype (match-beginning 1) (match-end 1))
1148     nil                                 ;No such parameter
1149     ))
1150
1151 (defun mime-set-parameter (contype parameter value)
1152   "For given CONTYPE set PARAMETER to VALUE."
1153   (if (string-match
1154        (concat
1155         ";[ \t\n]*\\("
1156         (regexp-quote parameter)
1157         "[ \t\n]*=[ \t\n]*\\([^\" \t\n;]*\\|\"[^\"]*\"\\)\\)[ \t\n]*\\(;\\|$\\)")
1158        contype)
1159       ;; Change value
1160       (concat (substring contype 0 (match-beginning 1))
1161               parameter "=" value
1162               (substring contype (match-end 1)))
1163     (concat contype "; " parameter "=" value)))
1164
1165 (defun mime-strip-parameters (contype)
1166   "Return primary content-type and subtype without parameters for CONTYPE."
1167   (if (string-match "^[ \t]*\\([^; \t\n]*\\)" contype)
1168       (substring contype (match-beginning 1) (match-end 1)) nil))
1169
1170 (defun mime-test-content-type (contype type &optional subtype)
1171   "Test if CONTYPE is a TYPE and an optional SUBTYPE."
1172   (and (stringp contype)
1173        (stringp type)
1174        (string-match
1175         (concat "^[ \t]*" (downcase type) "/" (downcase (or subtype "")))
1176         (downcase contype))))
1177
1178 \f
1179 ;; Basic functions
1180
1181 (defun mime-find-file-type (file)
1182   "Guess Content-Type, subtype, and parameters from FILE."
1183   (let ((guess nil)
1184         (guesses mime-file-types))
1185     (while (and (not guess) guesses)
1186       (if (string-match (car (car guesses)) file)
1187           (setq guess (cdr (car guesses))))
1188       (setq guesses (cdr guesses)))
1189     guess
1190     ))
1191
1192 (defun mime-prompt-for-type ()
1193   "Ask for Content-type."
1194   (let ((type ""))
1195     ;; Repeat until primary content type is specified.
1196     (while (string-equal type "")
1197       (setq type
1198             (completing-read "What content type: "
1199                              mime-content-types
1200                              nil
1201                              'require-match ;Type must be specified.
1202                              nil
1203                              ))
1204       (if (string-equal type "")
1205           (progn
1206             (message "Content type is required.")
1207             (beep)
1208             (sit-for 1)
1209             ))
1210       )
1211     type
1212     ))
1213
1214 (defun mime-prompt-for-subtype (pritype)
1215   "Ask for Content-type subtype of Content-Type PRITYPE."
1216   (let* ((default (car (car (cdr (assoc pritype mime-content-types)))))
1217          (answer
1218           (completing-read
1219            (if default
1220                (concat
1221                 "What content subtype: (default " default ") ")
1222              "What content subtype: ")
1223            (cdr (assoc pritype mime-content-types))
1224            nil
1225            'require-match               ;Subtype must be specified.
1226            nil
1227            )))
1228     (if (string-equal answer "") default answer)))
1229
1230 (defun mime-prompt-for-parameters (pritype subtype &optional delimiter)
1231   "Ask for Content-type parameters of Content-Type PRITYPE and SUBTYPE.
1232 Optional DELIMITER specifies parameter delimiter (';' by default)."
1233   (let* ((delimiter (or delimiter "; "))
1234          (parameters
1235           (mapconcat
1236            (function identity)
1237            (delq nil
1238                  (mime-prompt-for-parameters-1
1239                   (cdr (assoc subtype
1240                               (cdr (assoc pritype mime-content-types))))))
1241            delimiter
1242            )))
1243     (if (and (stringp parameters)
1244              (not (string-equal parameters "")))
1245         (concat delimiter parameters)
1246       ""                                ;"" if no parameters
1247       )))
1248
1249 (defun mime-prompt-for-parameters-1 (optlist)
1250   (apply (function append)
1251          (mapcar (function mime-prompt-for-parameter) optlist)))
1252
1253 (defun mime-prompt-for-parameter (parameter)
1254   "Ask for PARAMETER.
1255 Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))."
1256   (let* ((prompt (car parameter))
1257          (choices (mapcar (function
1258                            (lambda (e)
1259                              (if (consp e) e (list e))))
1260                           (cdr parameter)))
1261          (default (car (car choices)))
1262          (answer nil))
1263     (if choices
1264         (progn
1265           (setq answer
1266                 (completing-read
1267                  (concat "What " prompt
1268                          ": (default "
1269                          (if (string-equal default "") "\"\"" default)
1270                          ") ")
1271                  choices nil nil ""))
1272           ;; If nothing is selected, use default.
1273           (if (string-equal answer "")
1274               (setq answer default)))
1275       (setq answer
1276             (read-string (concat "What " prompt ": "))))
1277     (cons (if (and answer
1278                    (not (string-equal answer "")))
1279               (concat prompt "="
1280                       ;; Note: control characters ignored!
1281                       (if (string-match mime-tspecials-regexp answer)
1282                           (concat "\"" answer "\"") answer)))
1283           (mime-prompt-for-parameters-1 (cdr (assoc answer (cdr parameter)))))
1284     ))
1285
1286 (defun mime-encode-string (encoding string)
1287   "Using ENCODING encode a STRING.
1288 If the STRING is too long, the encoded string may be broken into
1289 several lines."
1290   (save-excursion
1291     (set-buffer (get-buffer-create " *MIME encoding*"))
1292     (erase-buffer)
1293     (insert string)
1294     (mime-encode-region encoding (point-min) (point-max))
1295     (prog1
1296         (buffer-substring (point-min) (point-max))
1297       (kill-buffer (current-buffer)))))
1298
1299 (defun mime-decode-string (encoding string)
1300   "Using ENCODING decode a STRING."
1301   (save-excursion
1302     (set-buffer (get-buffer-create " *MIME decoding*"))
1303     (erase-buffer)
1304     (insert string)
1305     (mime-decode-region encoding (point-min) (point-max))
1306     (prog1
1307         (buffer-substring (point-min) (point-max))
1308       (kill-buffer (current-buffer)))))
1309
1310 (defun mime-flag-region (from to flag)
1311   "Hides or shows lines from FROM to TO, according to FLAG.
1312 If FLAG is `\\n' (newline character) then text is shown,
1313 while if FLAG is `\\^M' (control-M) the text is hidden."
1314   (let ((buffer-read-only nil)          ;Okay even if write protected.
1315         (modp (buffer-modified-p)))
1316     (unwind-protect
1317         (subst-char-in-region from to
1318                               (if (= flag ?\n) ?\^M ?\n)
1319                               flag t)
1320       (set-buffer-modified-p modp))))
1321
1322 \f
1323 ;; Translate the tagged MIME messages into a MIME compliant message.
1324
1325 (defun mime-editor/translate-buffer ()
1326   "Encode the tagged MIME message in current buffer in MIME compliant message."
1327   (interactive)
1328   (mime/encode-message-header)
1329   (mime-editor/translate-body)
1330   )
1331
1332 (defun mime-editor/translate-body ()
1333   "Encode the tagged MIME body in current buffer in MIME compliant message."
1334   (interactive)
1335   (save-excursion
1336     (let ((boundary
1337            (concat mime-multipart-boundary " " (current-time-string)))
1338           (i 1)
1339           (time (current-time-string))
1340           ret)
1341       (while (mime-editor/process-multipart-1
1342               (format "%s %s-%d" mime-multipart-boundary time i))
1343         (setq i (1+ i))
1344         )
1345       (save-restriction
1346         ;; We are interested in message body.
1347         (let* ((beg
1348                 (progn
1349                   (goto-char (point-min))
1350                   (re-search-forward
1351                    (concat "\n" (regexp-quote mail-header-separator)
1352                            (if mime-ignore-preceding-spaces
1353                                "[ \t\n]*\n" "\n")) nil 'move)
1354                   (point)))
1355                (end
1356                 (progn
1357                   (goto-char (point-max))
1358                   (and mime-ignore-trailing-spaces
1359                        (re-search-backward "[^ \t\n]\n" beg t)
1360                        (forward-char 1))
1361                   (point))))
1362           (setq ret (mime-editor/translate-region
1363                      beg end
1364                      (format "%s %s-%d" mime-multipart-boundary time i)))
1365           ))
1366       (let ((contype (car ret))         ;Content-Type
1367             (encoding (nth 1 ret))      ;Content-Transfer-Encoding
1368             )
1369         ;; Make primary MIME headers.
1370         (or (mail-position-on-field "Mime-Version")
1371             (insert mime-editor/mime-version-value))
1372         ;; Remove old Content-Type and other fields.
1373         (save-restriction
1374           (goto-char (point-min))
1375           (search-forward (concat "\n" mail-header-separator "\n") nil t)
1376           (narrow-to-region (point-min) (point))
1377           (goto-char (point-min))
1378           (mime-delete-field "Content-Type")
1379           (mime-delete-field "Content-Transfer-Encoding"))
1380         ;; Then, insert Content-Type and Content-Transfer-Encoding fields.
1381         (mail-position-on-field "Content-Type")
1382         (insert contype)
1383         (if encoding
1384             (progn
1385               (mail-position-on-field "Content-Transfer-Encoding")
1386               (insert encoding)))
1387         ))))
1388
1389 (defun mime-editor/normalize-body ()
1390   "Normalize the body part by inserting appropriate message tags."
1391   ;; Insert the first MIME tags if necessary.
1392   (goto-char (point-min))
1393   (if (not (looking-at mime-editor/single-part-tag-regexp))
1394       (insert (mime-make-text-tag) "\n"))
1395   ;; Check each tag, and add new tag or correct it if necessary.
1396   (goto-char (point-min))
1397   (while (re-search-forward mime-editor/single-part-tag-regexp nil t)
1398     (let* ((tag (buffer-substring (match-beginning 0) (match-end 0)))
1399            (contype (mime-editor/get-contype tag))
1400            (charset (mime-get-parameter contype "charset"))
1401            (encoding (mime-editor/get-encoding tag)))
1402       ;; Remove extra whitespaces after the tag.
1403       (if (looking-at "[ \t]+$")
1404           (delete-region (match-beginning 0) (match-end 0)))
1405       (cond ((= (following-char) ?\^M)
1406              ;; It must be image, audio or video.
1407              (let ((beg (point))
1408                    (end (mime-editor/content-end)))
1409                ;; Insert explicit MIME tags after hidden messages.
1410                (forward-line 1)
1411                (if (and (not (eobp))
1412                         (not (looking-at mime-editor/single-part-tag-regexp)))
1413                    (progn
1414                      (insert (mime-make-text-tag) "\n")
1415                      (forward-line -1)  ;Process it again as text.
1416                      ))
1417                ;; Show a hidden message.  The point is not altered
1418                ;; after the conversion.
1419                (mime-flag-region beg end ?\n)))
1420             ((mime-test-content-type contype "message")
1421              ;; Content-type "message" should be sent as is.
1422              (forward-line 1))
1423             ((mime-test-content-type contype "text")
1424              ;; Define charset for text if necessary.
1425              (setq charset (or charset (mime-editor/choose-charset)))
1426              (mime-editor/define-charset charset)
1427              (if (string-equal contype "text/x-rot13-47")
1428                  (save-excursion
1429                    (forward-line)
1430                    (set-mark (point))
1431                    (goto-char (mime-editor/content-end))
1432                    (tm:caesar-region)
1433                    ))
1434              ;; Point is now on current tag.
1435              ;; Define encoding and encode text if necessary.
1436              (if (null encoding)        ;Encoding is not specified.
1437                  (let* ((encoding (mime-editor/choose-encoding))
1438                         (beg (mime-editor/content-beginning))
1439                         (end (mime-editor/content-end))
1440                         (body (buffer-substring beg end))
1441                         (encoded (funcall mime-string-encoder
1442                                           (cons charset encoding) body)))
1443                    (if (not (string-equal body encoded))
1444                        (progn
1445                          (goto-char beg)
1446                          (delete-region beg end)
1447                          (insert encoded)
1448                          (goto-char beg)))
1449                    (mime-editor/define-encoding encoding)))
1450              (forward-line 1))
1451             ((null encoding)            ;Encoding is not specified.
1452              ;; Application, image, audio, video, and any other
1453              ;; unknown content-type without encoding should be
1454              ;; encoded.
1455              (let* ((encoding "base64") ;Encode in BASE64 by default.
1456                     (beg (mime-editor/content-beginning))
1457                     (end (mime-editor/content-end))
1458                     (body (buffer-substring beg end))
1459                     (encoded (funcall mime-string-encoder
1460                                       (cons nil encoding) body)))
1461                (if (not (string-equal body encoded))
1462                    (progn
1463                      (goto-char beg)
1464                      (delete-region beg end)
1465                      (insert encoded)
1466                      (goto-char beg)))
1467                (mime-editor/define-encoding encoding))
1468              (forward-line 1))
1469             )
1470       )))
1471
1472 (defun mime-delete-field (field)
1473   "Delete header FIELD."
1474   (let ((regexp (format "^%s:[ \t]*" field)))
1475     (goto-char (point-min))
1476     (while (re-search-forward regexp nil t)
1477       (delete-region (match-beginning 0)
1478                      (progn (forward-line 1) (point)))
1479       )))
1480
1481 \f
1482 ;;;
1483 ;;; Platform dependent functions
1484 ;;;
1485
1486 ;; Emacs 18 implementations
1487
1488 (defun mime-body-charset-chooser-for-emacs18 (begin end)
1489   "Return a cons of charset and encoding of a message in a given region.
1490 Encoding name must be a canonical name, such as `base64'."
1491   '("US-ASCII" . nil)                   ;Default charset of MIME.
1492   )
1493
1494 (defun mime-string-encoder-for-emacs18 (method string)
1495   "For given METHOD that is a cons of charset and encoding, encode a STRING."
1496   (let ((charset (car method))
1497         (encoding (cdr method)))
1498     (cond ((stringp encoding)
1499            (mime-encode-string encoding string))
1500           ;; Return string without any encoding.
1501           (t string)
1502           )))
1503
1504 \f
1505 ;; Emacs 19 implementations
1506
1507 (defun mime-body-charset-chooser-for-emacs19 (begin end)
1508   "Return a cons of charset and encoding of a message in a given region.
1509 Encoding name must be a canonical name, such as `base64'.
1510 US-ASCII and ISO-8859-1 are supported on Emacs 19."
1511   (cond ((save-excursion
1512            (goto-char begin)
1513            (re-search-forward "[\200-\377]" end t))
1514          '("ISO-8859-1" . "quoted-printable"))
1515         (t
1516          '("US-ASCII" . nil))           ;Default charset of MIME.
1517         ))
1518
1519 (defun mime-string-encoder-for-emacs19 (method string)
1520   "For given METHOD that is a cons of charset and encoding, encode a STRING."
1521   (let ((charset (car method))
1522         (encoding (cdr method)))
1523     (cond ((stringp encoding)
1524            (mime-encode-string encoding string))
1525           ;; Return string without any encoding.
1526           (t string)
1527           )))
1528
1529 \f
1530 ;; NEmacs implementations
1531
1532 (defun mime-body-charset-chooser-for-nemacs (begin end)
1533   "Return a cons of charset and encoding of a message in a given region.
1534 Encoding name must be a canonical name, such as `base64'.
1535 US-ASCII and ISO-2022-JP are supported on NEmacs."
1536   (cond ((check-region-kanji-code begin end)
1537          ;; The following are safe encoding methods for use in
1538          ;; USENET News systems that strip off all ESCs.
1539          ;; '("ISO-2022-JP" . "quoted-printable")
1540          ;; '("ISO-2022-JP" . "base64")
1541          ;; The following expects transport systems are all MIME
1542          ;; compliants.  For instance, ESCs are never stripped off.
1543          '("ISO-2022-JP" . nil))
1544         (t
1545          '("US-ASCII" . nil))           ;Default charset of MIME.
1546         ))
1547
1548 (defun mime-string-encoder-for-nemacs (method string)
1549   "For given METHOD that is a cons of charset and encoding, encode a STRING.
1550 US-ASCII and ISO-2022-JP are supported on NEmacs."
1551   (let ((charset (car method))
1552         (encoding (cdr method)))
1553     (cond ((stringp encoding)
1554            (mime-encode-string encoding
1555                                ;; Convert internal (EUC) to JIS code.
1556                                (convert-string-kanji-code string 3 2)
1557                                ))
1558           ;; NEmacs can convert into ISO-2022-JP automatically,
1559           ;; but can do it myself as follows:
1560           ;;(t (convert-string-kanji-code string 3 2))
1561
1562           ;; Return string without any encoding.
1563           (t string)
1564           )))
1565
1566 \f
1567 ;; Mule implementations
1568 ;; Thanks to contributions by wkenji@flab.fujitsu.co.jp (Kenji
1569 ;; WAKAMIYA) and handa@etl.go.jp (Kenichi Handa).
1570
1571 (defun mime-body-charset-chooser-for-mule (begin end)
1572   "Return a cons of charset and encoding of a message in a given
1573 region.  Encoding name must be a canonical name, such as `base64'.
1574 US-ASCII, ISO-8859-* (except for ISO-8859-6), ISO-2022-JP,
1575 ISO-2022-JP-2 and ISO-2022-INT-1 are supported on Mule.  Either of
1576 charset ISO-2022-JP-2 or ISO-2022-INT-1 is used for multilingual text
1577 in Mule."
1578   (let ((lclist (find-charset-region begin end)))
1579     (cond ((null lclist)
1580            '("US-ASCII" . nil))         ;Default charset of MIME.
1581           ;; Multilingual capability requred.
1582           ((and (> (length lclist) 1)
1583                 (boundp '*iso-2022-int-1*))
1584            '("ISO-2022-INT-1" . nil))
1585           ((> (length lclist) 1)
1586            '("ISO-2022-JP-2" . nil))
1587           ;; Simple charset.
1588           ((memq lc-ltn1 lclist)
1589            '("ISO-8859-1" . "quoted-printable"))
1590           ((memq lc-ltn2 lclist)
1591            '("ISO-8859-2" . "quoted-printable"))
1592           ((memq lc-ltn3 lclist)
1593            '("ISO-8859-3" . "quoted-printable"))
1594           ((memq lc-ltn4 lclist)
1595            '("ISO-8859-4" . "quoted-printable"))
1596           ((memq lc-crl lclist)
1597            '("ISO-8859-5" . "quoted-printable"))
1598           ;;((memq lc-arb lclist)
1599           ;; '("ISO-8859-6" . "quoted-printable"))
1600           ((memq lc-grk lclist)
1601            '("ISO-8859-7" . "quoted-printable"))
1602           ((memq lc-hbw lclist)
1603            '("ISO-8859-8" . "quoted-printable"))
1604           ((memq lc-ltn5 lclist)
1605            '("ISO-8859-9" . "quoted-printable"))
1606           ((memq lc-jp lclist)
1607            '("ISO-2022-JP" . nil))
1608           ;; Unknown charset.
1609           ((boundp '*iso-2022-int-1*)
1610            '("ISO-2022-INT-1" . nil))
1611           (t
1612            '("ISO-2022-JP-2" . nil))
1613           )))
1614
1615 (defun mime-string-encoder-for-mule (method string)
1616   "For given METHOD that is a cons of charset and encoding, encode a
1617 STRING.  US-ASCII, ISO-8859-* (except for ISO-8859-6), ISO-2022-JP,
1618 ISO-2022-JP-2 and ISO-2022-INT-1 are supported on Mule.  Either of
1619 charset ISO-2022-JP-2 or ISO-2022-INT-1 is used for multilingual
1620 text."
1621   (let* ((charset (car method))
1622          (encoding (cdr method))
1623          (coding-system
1624           (cdr (assoc (and (stringp charset) (upcase charset))
1625                       '(("ISO-8859-1" . *ctext*)
1626                         ("ISO-8859-2" . *iso-8859-2*)
1627                         ("ISO-8859-3" . *iso-8859-3*)
1628                         ("ISO-8859-4" . *iso-8859-4*)
1629                         ("ISO-8859-5" . *iso-8859-5*)
1630                         ;;("ISO-8859-6" . *iso-8859-6*)
1631                         ("ISO-8859-7" . *iso-8859-7*)
1632                         ("ISO-8859-8" . *iso-8859-8*)
1633                         ("ISO-8859-9" . *iso-8859-9*)
1634                         ("ISO-2022-JP" . *junet*)
1635                         ("ISO-2022-JP-2" . *iso-2022-ss2-7*)
1636                         ("ISO-2022-INT-1" . *iso-2022-int-1*)
1637                         )))))
1638     ;; In bilingual environment it may be unnecessary to convert the
1639     ;; coding system of the string unless transfer encoding is
1640     ;; required since such conversion may be performed by mule
1641     ;; automatically.
1642     (if (not (null coding-system))
1643         (setq string (code-convert-string string *internal* coding-system)))
1644     (if (stringp encoding)
1645         (setq string (mime-encode-string encoding string)))
1646     string
1647     ))
1648
1649 \f
1650 ;; Sun implementations
1651
1652 (defun mime-voice-recorder-for-sun ()
1653   "Record voice in a buffer using Sun audio device, and return the buffer.
1654 If the environment variable AUDIOHOST is defined, its value is used as
1655 a recording host instead of local host."
1656   (let ((buffer (get-buffer-create " *MIME audio*"))
1657         (host (getenv "AUDIOHOST")))
1658     (message "Start the recording on %s.  Type C-g to finish the recording..."
1659              (or host (system-name)))
1660     (save-excursion
1661       (set-buffer buffer)
1662       (erase-buffer)
1663       (condition-case errorcode
1664           (let ((selective-display nil) ;Disable ^M to nl translation.
1665                 (mc-flag nil)           ;Mule
1666                 (kanji-flag nil))       ;NEmacs
1667             ;; If AUDIOHOST is defined, use the value as recording host.
1668             (cond ((not (null host))
1669                    ;; Disable automatic conversion of coding system if Mule.
1670                    (if (featurep 'mule)
1671                        (define-program-coding-system nil "rsh" *noconv*))
1672                    (call-process "rsh"
1673                                  nil
1674                                  buffer
1675                                  nil
1676                                  host
1677                                  "cat"
1678                                  "/dev/audio"
1679                                  ))
1680                   (t
1681                    ;; Disable automatic conversion of coding system if Mule.
1682                    (if (featurep 'mule)
1683                        (define-program-coding-system nil "cat" *noconv*))
1684                    (call-process "cat"
1685                                  "/dev/audio"
1686                                  buffer
1687                                  nil
1688                                  ))))
1689         (quit (message "Type C-g to finish recording... done.")
1690               buffer                    ;Return the buffer
1691               )))))
1692
1693 \f
1694 ;;; @ Other useful commands.
1695 ;;;
1696
1697 ;; Message forwarding commands as content-type "message/rfc822".
1698
1699 (defun mime-editor/insert-message (&optional message)
1700   (interactive)
1701   (let ((inserter (assoc-value major-mode mime-editor/message-inserter-alist)))
1702     (if (and inserter (fboundp inserter))
1703         (progn
1704           (mime-editor/insert-tag "message" "rfc822")
1705           (funcall inserter message)
1706           )
1707       (message "Sorry, I don't have message inserter for your MUA.")
1708       )))
1709
1710 (defun mime-editor/insert-mail (&optional message)
1711   (interactive)
1712   (let ((inserter (assoc-value major-mode mime-editor/mail-inserter-alist)))
1713     (if (and inserter (fboundp inserter))
1714         (progn
1715           (mime-editor/insert-tag "message" "rfc822")
1716           (funcall inserter message)
1717           )
1718       (message "Sorry, I don't have mail inserter for your MUA.")
1719       )))
1720
1721 (defun mime-editor/inserted-message-filter ()
1722   (save-excursion
1723     (save-restriction
1724       (let ((header-start (point))
1725             (case-fold-search t)
1726             beg end)
1727         (if (re-search-forward "^$" (mark t))
1728             (narrow-to-region header-start (match-beginning 0))
1729           )
1730         (goto-char header-start)
1731         (while (and (re-search-forward
1732                      mime-editor/yank-ignored-fields-regexp nil t)
1733                     (setq beg (match-beginning 0))
1734                     (setq end (1+ (rfc822/field-end)))
1735                     )
1736           (delete-region beg end)
1737           )
1738         ))))
1739
1740 ;;; mime.el ends here
1741
1742 (defun mime-editor/translate-region (beg end &optional boundary multipart)
1743   (if (null boundary)
1744       (setq boundary
1745             (concat mime-multipart-boundary " " (current-time-string)))
1746     )
1747   (save-excursion
1748     (save-restriction
1749       (narrow-to-region beg end)
1750       (let ((tag nil)                   ;MIME tag
1751             (contype nil)               ;Content-Type
1752             (encoding nil)              ;Content-Transfer-Encoding
1753             (nparts 0))                 ;Number of body parts
1754         ;; Normalize the body part by inserting appropriate message
1755         ;; tags for every message contents.
1756         (mime-editor/normalize-body)
1757         ;; Counting the number of Content-Type.
1758         (goto-char (point-min))
1759         (while (re-search-forward mime-editor/single-part-tag-regexp nil t)
1760           (setq nparts (1+ nparts)))
1761         ;; Begin translation.
1762         (cond ((and (<= nparts 1)(not multipart))
1763                ;; It's a singular message.
1764                (goto-char (point-min))
1765                (while (re-search-forward
1766                        mime-editor/single-part-tag-regexp nil t)
1767                  (setq tag
1768                        (buffer-substring (match-beginning 0) (match-end 0)))
1769                  (delete-region (match-beginning 0) (1+ (match-end 0)))
1770                  (setq contype (mime-editor/get-contype tag))
1771                  (setq encoding (mime-editor/get-encoding tag))
1772                  ))
1773               (t
1774                ;; It's a multipart message.
1775                (goto-char (point-min))
1776                (while (re-search-forward
1777                        mime-editor/single-part-tag-regexp nil t)
1778                  (setq tag
1779                        (buffer-substring (match-beginning 0) (match-end 0)))
1780                  (delete-region (match-beginning 0) (match-end 0))
1781                  (setq contype (mime-editor/get-contype tag))
1782                  (setq encoding (mime-editor/get-encoding tag))
1783                  (insert "--" boundary "\n")
1784                  (insert "Content-Type: " contype "\n")
1785                  (if encoding
1786                      (insert "Content-Transfer-Encoding: " encoding "\n"))
1787                  )
1788                ;; Define Content-Type as "multipart/mixed".
1789                (setq contype
1790                      (concat "multipart/mixed; boundary=\"" boundary "\""))
1791                ;; Content-Transfer-Encoding must be "7bit".
1792                ;; The following encoding can be `nil', but is
1793                ;; specified as is since there is no way that a user
1794                ;; specifies it.
1795                (setq encoding "7bit")
1796                ;; Insert the trailer.
1797                (goto-char (point-max))
1798                (if (not (= (preceding-char) ?\n))
1799                    ;; Boundary must start with a newline.
1800                    (insert "\n"))
1801                (insert "--" boundary "--\n")))
1802         (list contype encoding boundary nparts)
1803         ))))
1804
1805
1806 (defun mime-editor/find-inmost ()
1807   (goto-char (point-min))
1808   (if (re-search-forward mime-editor/multipart-beginning-regexp nil t)
1809       (let ((bb (match-beginning 0))
1810             (be (match-end 0))
1811             (type (buffer-substring (match-beginning 1)(match-end 1)))
1812             end-exp eb ee)
1813         (setq end-exp (format "^--}-<<%s>>\n" type))
1814         (widen)
1815         (if (re-search-forward end-exp nil t)
1816             (progn
1817               (setq eb (match-beginning 0))
1818               (setq ee (match-end 0))
1819               )
1820           (setq eb (point-max))
1821           (setq ee (point-max))
1822           )
1823         (narrow-to-region be eb)
1824         (goto-char be)
1825         (if (re-search-forward mime-editor/multipart-beginning-regexp nil t)
1826             (let (ret)
1827               (narrow-to-region (match-beginning 0)(point-max))
1828               (mime-editor/find-inmost)
1829               )
1830           (widen)
1831           ;;(delete-region eb ee)
1832           (list type bb be eb)
1833           ))))
1834
1835 (defun mime-editor/process-multipart-1 (boundary)
1836   (let ((ret (mime-editor/find-inmost)))
1837     (if ret
1838         (let ((type (car ret))
1839               (bb (nth 1 ret))(be (nth 2 ret))
1840               (eb (nth 3 ret))
1841               )
1842           (narrow-to-region bb eb)
1843           (delete-region bb be)
1844           (setq bb (point-min))
1845           (setq eb (point-max))
1846           (widen)
1847           (goto-char eb)
1848           (if (looking-at mime-editor/multipart-end-regexp)
1849               (let ((beg (match-beginning 0))
1850                     (end (match-end 0))
1851                     )
1852                 (delete-region beg end)
1853                 (if (and (not (looking-at mime-editor/single-part-tag-regexp))
1854                          (not (eobp)))
1855                     (insert (concat (mime-make-text-tag) "\n"))
1856                   )))
1857           (setq boundary
1858                 (nth 2 (mime-editor/translate-region bb eb
1859                                                      boundary t)))
1860           (goto-char bb)
1861           (insert
1862            (format "--[[multipart/%s; boundary=\"%s\"][7bit]]\n"
1863                    type boundary))
1864           boundary))))
1865
1866
1867 ;;; @ multipart enclosure
1868 ;;;
1869
1870 (defun mime-editor/enclose-region (type beg end)
1871   (save-excursion
1872     (goto-char beg)
1873     (let ((f (bolp)))
1874       (save-restriction
1875         (narrow-to-region beg end)
1876         (goto-char beg)
1877         (if (not f)
1878             (insert "\n")
1879           )
1880         (insert (format "--<<%s>>-{\n" type))
1881         (goto-char (point-max))
1882         (setq f (bolp))
1883         (if (not f)
1884             (insert (format "\n--}-<<%s>>" type))
1885           (insert (format "--}-<<%s>>\n" type))
1886           )
1887         (goto-char (point-max))
1888         )
1889       (if (not (eobp))
1890           (progn
1891             (if (not f)
1892                 (if (not (eolp))
1893                     (insert "\n")
1894                   (forward-char)
1895                   )
1896               )
1897             (if (not (looking-at mime-editor/single-part-tag-regexp))
1898                 (insert (mime-make-text-tag) "\n")
1899               )
1900             )
1901         (if (not f)
1902             (insert "\n")
1903           ))
1904       )))
1905
1906 (defun mime-editor/enclose-mixed-region (beg end)
1907   (interactive "*r")
1908   (mime-editor/enclose-region "mixed" beg end)
1909   )
1910
1911 (defun mime-editor/enclose-parallel-region (beg end)
1912   (interactive "*r")
1913   (mime-editor/enclose-region "parallel" beg end)
1914   )
1915
1916 (defun mime-editor/enclose-digest-region (beg end)
1917   (interactive "*r")
1918   (mime-editor/enclose-region "digest" beg end)
1919   )
1920
1921 (defun mime-editor/enclose-alternative-region (beg end)
1922   (interactive "*r")
1923   (mime-editor/enclose-region "alternative" beg end)
1924   )
1925
1926
1927 ;;; @ split
1928 ;;;
1929
1930 (defun mime-editor/insert-partial-header
1931   (fields subject id number total separator)
1932   (insert fields)
1933   (insert (format "Subject: %s (%d/%d)\n" subject number total))
1934   (insert (format "Mime-Version: 1.0 (split by tm-edit %s)\n"
1935                   mime-editor/version))
1936   (insert (format "\
1937 Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n"
1938                   id number total separator))
1939   )
1940
1941 (defun mime-editor/split-and-send (&optional cmd)
1942   (interactive)
1943   (let ((mime-editor/message-max-length
1944          (or (cdr (assq major-mode mime-editor/message-max-length-alist))
1945              mime-editor/message-default-max-length))
1946         (lines (count-lines (point-min) (point-max)))
1947         )
1948     (if (and (> lines mime-editor/message-max-length)
1949              mime-editor/split-message)
1950         (let* ((mime-editor/draft-file-name
1951                 (or (buffer-file-name)
1952                     (make-temp-name
1953                      (expand-file-name "tm-draft" mime/tmp-dir))))
1954                (separator mail-header-separator)
1955                (config
1956                 (eval (cdr (assq major-mode mime-editor/window-config-alist))))
1957                (id (concat "\""
1958                            (replace-space-with-underline (current-time-string))
1959                            "@" (system-name) "\"")))
1960           (run-hooks 'mime-editor/before-split-hook)
1961           (let* ((header (rfc822/get-header-string-except
1962                           mime-editor/split-ignored-fields-regexp separator))
1963                  (subject (mail-fetch-field "subject"))
1964                  (total (+ (/ lines mime-editor/message-max-length)
1965                            (if (> (mod lines mime-editor/message-max-length) 0)
1966                                1)))
1967                  (the-buf (current-buffer))
1968                  (buf (get-buffer "*tmp-send*"))
1969                  (command
1970                   (or cmd
1971                       (cdr
1972                        (assq major-mode
1973                              mime-editor/split-message-sender-alist))
1974                       (cdr
1975                        (assq major-mode
1976                              mime-editor/message-default-sender-alist))
1977                       ))
1978                  data)
1979             (goto-char (point-min))
1980             (if (re-search-forward (concat "^" (regexp-quote separator) "$")
1981                                    nil t)
1982                 (replace-match "")
1983               )
1984             (if buf
1985                 (progn
1986                   (switch-to-buffer buf)
1987                   (erase-buffer)
1988                   (switch-to-buffer the-buf)
1989                   )
1990               (setq buf (get-buffer-create "*tmp-send*"))
1991               )
1992             (switch-to-buffer buf)
1993             (make-variable-buffer-local 'mail-header-separator)
1994             (setq mail-header-separator separator)
1995             (switch-to-buffer the-buf)
1996             (goto-char (point-min))
1997             (re-search-forward "^$" nil t)
1998             (let ((mime-editor/partial-number 1))
1999               (setq data (buffer-substring
2000                           (point-min)
2001                           (progn
2002                             (goto-line mime-editor/message-max-length)
2003                             (point))
2004                           ))
2005               (delete-region (point-min)(point))
2006               (switch-to-buffer buf)
2007               (mime-editor/insert-partial-header
2008                header subject id mime-editor/partial-number total separator)
2009               (insert data)
2010               (save-excursion
2011                 (save-restriction
2012                   (goto-char (point-min))
2013                   (search-forward (concat "\n" mail-header-separator "\n"))
2014                   (narrow-to-region
2015                    (match-end 0)
2016                    (if (re-search-forward "^$" nil t)
2017                        (match-beginning 0)
2018                      (point-max)
2019                      ))
2020                   (goto-char (point-min))
2021                   (while (re-search-forward
2022                           mime-editor/split-blind-fields-regexp nil t)
2023                     (delete-region (match-beginning 0)
2024                                    (let ((e (rfc822/field-end)))
2025                                      (if (< e (point-max))
2026                                          (1+ e)
2027                                        e)))
2028                     )
2029                   ))
2030               (save-excursion
2031                 (message (format "Sending %d/%d..."
2032                                  mime-editor/partial-number total))
2033                 (call-interactively command)
2034                 (message (format "Sending %d/%d... done"
2035                                  mime-editor/partial-number total))
2036                 )
2037               (erase-buffer)
2038               (switch-to-buffer the-buf)
2039               (setq mime-editor/partial-number 2)
2040               (while (< mime-editor/partial-number total)
2041                 (setq data (buffer-substring
2042                             (point-min)
2043                             (progn
2044                               (goto-line mime-editor/message-max-length)
2045                               (point))
2046                             ))
2047                 (delete-region (point-min)(point))
2048                 (switch-to-buffer buf)
2049                 (mime-editor/insert-partial-header
2050                  header subject id mime-editor/partial-number total separator)
2051                 (insert data)
2052                 (save-excursion
2053                   (message (format "Sending %d/%d..."
2054                                    mime-editor/partial-number total))
2055                   (call-interactively command)
2056                   (message (format "Sending %d/%d... done"
2057                                    mime-editor/partial-number total))
2058                   )
2059                 (erase-buffer)
2060                 (switch-to-buffer the-buf)
2061                 (setq mime-editor/partial-number
2062                       (1+ mime-editor/partial-number))
2063                 )
2064               (goto-char (point-min))
2065               (mime-editor/insert-partial-header
2066                header subject id mime-editor/partial-number total separator)
2067               (message (format "Sending %d/%d..."
2068                                mime-editor/partial-number total))
2069               ))))))
2070
2071
2072 ;;; @ preview message
2073 ;;;
2074
2075 (defun mime-editor/preview-message ()
2076   "preview editing MIME message. [tm-edit.el]"
2077   (interactive)
2078   (let* ((str (buffer-string))
2079          (separator mail-header-separator)
2080          (the-buf (current-buffer))
2081          (buf-name (buffer-name))
2082          (temp-buf-name (concat "*temp-article:" buf-name "*"))
2083          (buf (get-buffer temp-buf-name))
2084          )
2085     (if buf
2086         (progn
2087           (switch-to-buffer buf)
2088           (erase-buffer)
2089           )
2090       (setq buf (get-buffer-create temp-buf-name))
2091       (switch-to-buffer buf)
2092       )
2093     (insert str)
2094     (setq major-mode 'mime/temporary-message-mode)
2095     (make-local-variable 'mail-header-separator)
2096     (setq mail-header-separator separator)
2097     (make-local-variable 'mime/editing-buffer)
2098     (setq mime/editing-buffer the-buf)
2099
2100     (run-hooks 'mime-editor/translate-hook)
2101     (mime-editor/translate-buffer)
2102     (goto-char (point-min))
2103     (if (re-search-forward
2104          (concat "^" (regexp-quote separator) "$"))
2105         (replace-match "")
2106       )
2107     (mime/viewer-mode)
2108     ))
2109
2110 (defun mime-editor/quitting-method ()
2111   (let ((temp mime::preview/article-buffer)
2112         buf)
2113     (mime-viewer/kill-buffer)
2114     (set-buffer temp)
2115     (setq buf mime/editing-buffer)
2116     (kill-buffer temp)
2117     (switch-to-buffer buf)
2118     ))
2119
2120 (set-alist 'mime-viewer/quitting-method-alist
2121            'mime/temporary-message-mode
2122            (function mime-editor/quitting-method)
2123            )
2124
2125
2126 ;;; @ draft preview
2127 ;;;
2128 ;; by "OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
2129 ;;       Mon, 10 Apr 1995 20:03:07 +0900
2130
2131 (defvar mime-editor/draft-header-separator-alist
2132   '((news-reply-mode . mail-header-separator)
2133     (mh-letter-mode . mail-header-separator)
2134     ))
2135
2136 (defvar mime::article/draft-header-separator nil)
2137
2138 (defun mime-editor/draft-preview ()
2139   (interactive)
2140   (let ((sep (assoc-value major-mode mime-editor/draft-header-separator-alist)))
2141     (or (stringp sep) (setq sep (eval sep)))
2142     (make-variable-buffer-local 'mime::article/draft-header-separator)
2143     (goto-char (point-min))
2144     (re-search-forward
2145      (concat "^\\(" (regexp-quote sep) "\\)?$"))
2146     (setq mime::article/draft-header-separator
2147           (buffer-substring (match-beginning 0) (match-end 0)))
2148     (replace-match "")
2149     (mime/viewer-mode (current-buffer))
2150     (pop-to-buffer (current-buffer))
2151     ))
2152
2153 (defun mime-viewer::quitting-method/draft-preview ()
2154   (let ((mother mime/mother-buffer))
2155     (save-excursion
2156       (switch-to-buffer mother)
2157       (goto-char (point-min))
2158       (if (and
2159            (re-search-forward
2160             (concat "^\\("
2161                     (regexp-quote mime::article/draft-header-separator)
2162                     "\\)?$") nil t)
2163            (bolp))
2164           (progn
2165             (insert mime::article/draft-header-separator)
2166             (set-buffer-modified-p (buffer-modified-p))
2167             )))
2168     (mime-viewer/kill-buffer)
2169     (pop-to-buffer mother)
2170     ))
2171
2172 (set-alist 'mime-viewer/quitting-method-alist
2173            'mh-letter-mode
2174            (function mime-viewer::quitting-method/draft-preview)
2175            )
2176
2177 (set-alist 'mime-viewer/quitting-method-alist
2178            'news-reply-mode
2179            (function mime-viewer::quitting-method/draft-preview)
2180            )
2181
2182
2183 ;;; @ etc
2184 ;;;
2185
2186 (defun replace-space-with-underline (str)
2187   (mapconcat (function
2188               (lambda (arg)
2189                 (char-to-string
2190                  (if (= arg 32)
2191                      ?_
2192                    arg)))) str "")
2193   )
2194
2195
2196 ;;; @ end
2197 ;;;
2198
2199 (provide 'tm-edit)
2200
2201 (run-hooks 'tm-edit-load-hook)