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