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.37 $
  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/19 17:47:16 $|$Revision: 7.37 $|~/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.37 1995/12/19 17:47:16 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           (regexp-or mime-editor/single-part-tag-regexp
 748                      paragraph-start))
 749     (setq paragraph-separate
 750           (regexp-or mime-editor/single-part-tag-regexp
 751                      paragraph-separate))
 752     (run-hooks 'mime/editor-mode-hook)
 753     (message
 754      (substitute-command-keys
 755       "Type \\[mime-editor/exit] to exit MIME mode, and type \\[mime-editor/help] to get help."))
 756     ))
 757
 758 ;;;###autoload
 759 (defalias 'edit-mime 'mime/editor-mode)         ; for convenience
 760 (defalias 'mime-mode 'mime/editor-mode)         ; for convenience
 761
 762 (defun mime-editor/exit (&optional nomime no-error)
 763   "Translate the tagged MIME message into a MIME compliant message.
 764 With no argument encode a message in the buffer into MIME, otherwise
 765 just return to previous mode."
 766   (interactive "P")
 767   (if (not mime/editor-mode-flag)
 768       (if (null no-error)
 769           (error "You aren't editing a MIME message.")
 770         )
 771     (if (not nomime)
 772         (progn
 773           (run-hooks 'mime-editor/translate-hook)
 774           (mime-editor/translate-buffer)))
 775     ;; Restore previous state.
 776     (setq mime/editor-mode-flag nil)
 777     (use-local-map mime/editor-mode-old-local-map)
 778
 779     ;; modified by Pekka Marjola <pema@niksula.hut.fi>
 780     ;;  1995/9/5 (c.f. [tm-eng:69])
 781     (if (string-match "XEmacs\\|Lucid" emacs-version)
 782         (progn
 783           (delete-menu-item (list mime-editor/menu-title))
 784                                         ; should rather be const
 785           ;; (while mime-editor/xemacs-old-bindings
 786           ;;   (eval (pop mime-editor/xemacs-old-bindings)))
 787           (local-unset-key mime-prefix)))
 788     ;; end
 789
 790     (setq selective-display mime/editor-mode-old-selective-display)
 791     (set-buffer-modified-p (buffer-modified-p))
 792     (run-hooks 'mime-editor/exit-hook)
 793     (message "Exit MIME editor mode.")
 794     ))
 795
 796 (defun mime-editor/maybe-translate ()
 797   (interactive)
 798   (mime-editor/exit nil t)
 799   (call-interactively 'mime-editor/maybe-split-and-send)
 800   )
 801
 802 (defun mime-editor/help ()
 803   "Show help message about MIME mode."
 804   (interactive)
 805   (with-output-to-temp-buffer "*Help*"
 806     (princ "MIME editor mode:\n")
 807     (princ (documentation 'mime/editor-mode))
 808     (print-help-return-message)))
 809
 810 (defun mime-editor/insert-text ()
 811   "Insert a text message.
 812 Charset is automatically obtained from the mime-body-charset-chooser."
 813   (interactive)
 814   (if (and (mime-editor/insert-tag "text" nil nil)
 815            (looking-at mime-editor/single-part-tag-regexp))
 816       (progn
 817         ;; Make a space between the following message.
 818         (insert "\n")
 819         (forward-char -1)
 820         )))
 821
 822 (defun mime-editor/insert-file (file)
 823   "Insert a message from a file."
 824   (interactive "fInsert file as MIME message: ")
 825   (let*  ((guess (mime-find-file-type file))
 826           (pritype (nth 0 guess))
 827           (subtype (nth 1 guess))
 828           (parameters (nth 2 guess))
 829           (default (nth 3 guess))       ;Guess encoding from its file name.
 830           (fields (nth 4 guess))
 831           (encoding
 832            (if (not (interactive-p))
 833                default
 834              (completing-read
 835               (concat "What transfer encoding"
 836                       (if default
 837                           (concat " (default "
 838                                   (if (string-equal default "")
 839                                       "\"\""
 840                                     default)
 841                                   ")"
 842                                   ))
 843                       ": ")
 844               mime-encoding-method-alist nil t nil))))
 845     (if (string-equal encoding "")
 846         (setq encoding default))
 847     (if (or (consp parameters) (consp fields))
 848         (let ((rest parameters) cell attribute value)
 849           (setq parameters "")
 850           (while rest
 851             (setq cell (car rest))
 852             (setq attribute (car cell))
 853             (setq value (cdr cell))
 854             (if (eq value 'file)
 855                 (setq value (file-name-nondirectory file))
 856               )
 857             (setq parameters (concat parameters "; " attribute "=" value))
 858             (setq rest (cdr rest))
 859             )
 860           (setq rest fields)
 861           (while rest
 862             (setq cell (car rest))
 863             (setq attribute (car cell))
 864             (setq value (cdr cell))
 865             (if (eq value 'file)
 866                 (setq value (file-name-nondirectory file))
 867               )
 868             (setq parameters (concat parameters "\n" attribute ": " value))
 869             (setq rest (cdr rest))
 870             )
 871           ))
 872     (mime-editor/insert-tag pritype subtype parameters)
 873     (mime-editor/insert-binary-file file encoding)
 874     ))
 875
 876 (defun mime-editor/insert-external ()
 877   "Insert a reference to external body."
 878   (interactive)
 879   (mime-editor/insert-tag "message" "external-body" nil ";\n\t")
 880   ;;(forward-char -1)
 881   ;;(insert "Content-Description: " (read-string "Content-Description: ") "\n")
 882   ;;(forward-line 1)
 883   (let* ((pritype (mime-prompt-for-type))
 884          (subtype (mime-prompt-for-subtype pritype))
 885          (parameters (mime-prompt-for-parameters pritype subtype ";\n\t")))
 886     (and pritype
 887          subtype
 888          (insert "Content-Type: "
 889                  pritype "/" subtype (or parameters "") "\n")))
 890   (if (and (not (eobp))
 891            (not (looking-at mime-editor/single-part-tag-regexp)))
 892       (insert (mime-make-text-tag) "\n")))
 893
 894 (defun mime-editor/insert-voice ()
 895   "Insert a voice message."
 896   (interactive)
 897   (mime-editor/insert-tag "audio" "basic" nil)
 898   (let ((buffer (funcall mime-voice-recorder)))
 899     (unwind-protect
 900         (mime-editor/insert-binary-buffer buffer "base64")
 901       (kill-buffer buffer)
 902       )))
 903
 904 (defun mime-editor/insert-signature (&optional arg)
 905   "Insert a signature file specified by mime-signature-file."
 906   (interactive "P")
 907   (let ((signature
 908          (expand-file-name
 909           (if arg
 910               (read-file-name "Insert your signature: "
 911                               (concat signature-file-name "-")
 912                               signature-file-name
 913                               nil)
 914             (signature/get-signature-file-name))))
 915         )
 916     (if signature-insert-at-eof
 917         (goto-char (point-max))
 918       )
 919     (apply (function mime-editor/insert-tag)
 920            (mime-find-file-type signature))
 921     (if (file-readable-p signature)
 922         (progn
 923           (goto-char (point-max))
 924           (if (not (bolp))
 925               (insert "\n"))
 926           (delete-blank-lines)
 927           (insert-file-contents signature)
 928           (set-buffer-modified-p (buffer-modified-p))
 929                                         ; force mode line update
 930           ))))
 931
 932 \f
 933 ;; Insert a new tag around a point.
 934
 935 (defun mime-editor/insert-tag (&optional pritype subtype parameters delimiter)
 936   "Insert new MIME tag and return a list of PRITYPE, SUBTYPE, and PARAMETERS.
 937 If nothing is inserted, return nil."
 938   (interactive)
 939   (let ((oldtag nil)
 940         (newtag nil)
 941         (current (point))
 942         exist-prev-tag exist-next-tag)
 943     (setq pritype
 944           (or pritype
 945               (mime-prompt-for-type)))
 946     (setq subtype
 947           (or subtype
 948               (mime-prompt-for-subtype pritype)))
 949     (setq parameters
 950           (or parameters
 951               (mime-prompt-for-parameters pritype subtype delimiter)))
 952     ;; Make a new MIME tag.
 953     (setq newtag (mime-make-tag pritype subtype parameters))
 954     ;; Find an current MIME tag.
 955     (setq oldtag
 956           (save-excursion
 957             (if (mime-editor/goto-tag)
 958                 (progn
 959                   (if (eq current (match-beginning 0))
 960                       (setq exist-next-tag t)
 961                     (setq exist-prev-tag t)
 962                     )
 963                   (buffer-substring (match-beginning 0) (match-end 0))
 964                   )
 965               ;; Assume content type is 'text/plan'.
 966               (mime-make-tag "text" "plain")
 967               )))
 968     ;; We are only interested in TEXT.
 969     (if (and oldtag
 970              (not (mime-test-content-type
 971                    (mime-editor/get-contype oldtag) "text")))
 972         (setq oldtag nil))
 973     (cond (exist-prev-tag (insert "\n"))
 974           (exist-next-tag (save-excursion
 975                             (insert "\n")
 976                             )))
 977     ;; (beginning-of-line)
 978     ;; (cond ((and oldtag                  ;Text
 979     ;;             (not (eobp))
 980     ;;             (save-excursion
 981     ;;               (forward-line -1)
 982     ;;               (looking-at mime-editor/beginning-tag-regexp)
 983     ;;               )
 984     ;;             (or mime-ignore-same-text-tag
 985     ;;                 (not (string-equal oldtag newtag))))
 986     ;;        ;; If point is at the next of current tag, move to the
 987     ;;        ;; beginning of the tag to disable insertion of extra tag.
 988     ;;        (forward-line -1))
 989     ;;       ((and oldtag                  ;Text
 990     ;;             (not (eobp))
 991     ;;             (not (looking-at mime-editor/tag-regexp))
 992     ;;             (or mime-ignore-same-text-tag
 993     ;;                 (not (string-equal oldtag newtag))))
 994     ;;        ;; Copy current tag to break a text into two.
 995     ;;        (save-excursion
 996     ;;          (insert oldtag "\n")))
 997     ;;       ((and (null oldtag)           ;Not text
 998     ;;             (not (looking-at mime-editor/tag-regexp)))
 999     ;;        ;; Adjust insertion point.  In the middle of text, it is
1000     ;;        ;; okay to break the text into two.  However, it should not
1001     ;;        ;; be broken into two, if otherwise.
1002     ;;        (goto-char (mime-editor/content-end))
1003     ;;        (if (eolp)
1004     ;;            (forward-line 1))
1005     ;;        (if (not (bolp))
1006     ;;            (insert "\n"))
1007     ;;        ))
1008     (if (not (bolp))
1009         (if exist-prev-tag
1010             (forward-line 1)
1011           (insert "\n")
1012           ))
1013     ;; Make a new tag.
1014     (if (or (not oldtag)                ;Not text
1015             (or mime-ignore-same-text-tag
1016                 (not (string-equal oldtag newtag))))
1017         (progn
1018           ;; Mark the beginning of the tag for convenience.
1019           (push-mark (point) 'nomsg)
1020           (insert newtag "\n")
1021           (list pritype subtype parameters) ;New tag is created.
1022           )
1023       ;; Restore previous point.
1024       (goto-char current)
1025       nil                               ;Nothing is created.
1026       )
1027     ))
1028
1029 ;; Insert the binary content after MIME tag.
1030 ;;      modified by MORITA Masahiro <hiro@isl.ntt.JP>
1031 ;;      for x-uue
1032 (defun mime-editor/insert-binary-file (file &optional encoding)
1033   "Insert binary FILE at point.
1034 Optional argument ENCODING specifies an encoding method such as base64."
1035   (let ((tmpbuf (get-buffer-create " *MIME insert*")))
1036     (save-excursion
1037       (set-buffer tmpbuf)
1038       (erase-buffer)
1039       (let ((mc-flag nil)               ;Mule
1040             (file-coding-system-for-read
1041              (if (featurep 'mule) *noconv*))
1042             (kanji-flag nil)            ;NEmacs
1043             (emx-binary-mode t)         ;Stop CRLF to LF conversion in OS/2
1044             )
1045         (let (jka-compr-compression-info-list
1046               jam-zcat-filename-list)
1047           (insert-file-contents file))))
1048     (prog1
1049         (if (and (stringp encoding)
1050                  (string-equal (downcase encoding) "x-uue"))
1051             (progn
1052               (require 'mel-u)
1053               (let ((uuencode-external-encoder
1054                      (cons (car uuencode-external-encoder)
1055                            (list (file-name-nondirectory file))
1056                            )))
1057                 (mime-editor/insert-binary-buffer tmpbuf encoding)
1058                 ))
1059           (mime-editor/insert-binary-buffer tmpbuf encoding))
1060       (kill-buffer tmpbuf))))
1061
1062 ;; Insert the binary content after MIME tag.
1063 ;;      modified by MORITA Masahiro <hiro@isl.ntt.JP>
1064 ;;      for x-uue
1065 (defun mime-editor/insert-binary-buffer (buffer &optional encoding)
1066   "Insert binary BUFFER at point.
1067 Optional argument ENCODING specifies an encoding method such as base64."
1068   (let* ((tagend (1- (point)))          ;End of the tag
1069          (hide-p (and mime-auto-hide-body
1070                       (stringp encoding)
1071                       (let ((en (downcase encoding)))
1072                         (or (string-equal en "base64")
1073                             (string-equal en "x-uue")
1074                             ))))
1075          )
1076     (save-restriction
1077       (narrow-to-region (1- (point)) (point))
1078       (let ((start (point))
1079             (emx-binary-mode t))        ;Stop LF to CRLF conversion in OS/2
1080         (insert-buffer-substring buffer)
1081         ;; Encode binary message if necessary.
1082         (if encoding
1083             (mime-encode-region encoding start (point-max))))
1084       (if hide-p
1085           (progn
1086             (mime-flag-region (point-min) (1- (point-max)) ?\^M)
1087             (goto-char (point-max)))
1088         ))
1089     ;; Define encoding even if it is 7bit.
1090     (if (stringp encoding)
1091         (save-excursion
1092           (goto-char tagend)            ;Make sure which line the tag is on.
1093           (mime-editor/define-encoding encoding)))
1094     ))
1095
1096 \f
1097 ;; Commands work on a current message flagment.
1098
1099 (defun mime-editor/goto-tag ()
1100   "Search for the beginning of the tagged MIME message."
1101   (let ((current (point)) multipart)
1102     (if (looking-at mime-editor/tag-regexp)
1103         t
1104       ;; At first, go to the end.
1105       (cond ((re-search-forward mime-editor/beginning-tag-regexp nil t)
1106              (goto-char (match-beginning 0)) ;For multiline tag
1107              (forward-line -1)
1108              (end-of-line)
1109              )
1110             (t
1111              (goto-char (point-max))
1112              ))
1113       ;; Then search for the beginning.
1114       (re-search-backward mime-editor/end-tag-regexp nil t)
1115       (beginning-of-line)
1116       (or (looking-at mime-editor/beginning-tag-regexp)
1117           ;; Restore previous point.
1118           (progn
1119             (goto-char current)
1120             nil
1121             ))
1122       )))
1123
1124 (defun mime-editor/content-beginning ()
1125   "Return the point of the beginning of content."
1126   (save-excursion
1127     (let ((beg (save-excursion
1128                  (beginning-of-line) (point))))
1129       (if (mime-editor/goto-tag)
1130           (let ((top (point)))
1131             (goto-char (match-end 0))
1132             (if (and (= beg top)
1133                      (= (following-char) ?\^M))
1134                 (point)
1135               (forward-line 1)
1136               (point)))
1137         ;; Default text/plain tag.
1138         (goto-char (point-min))
1139         (re-search-forward
1140          (concat "\n" (regexp-quote mail-header-separator)
1141                  (if mime-ignore-preceding-spaces
1142                      "[ \t\n]*\n" "\n")) nil 'move)
1143         (point))
1144       )))
1145
1146 (defun mime-editor/content-end ()
1147   "Return the point of the end of content."
1148   (save-excursion
1149     (let ((beg (save-excursion
1150                  (beginning-of-line) (point))))
1151       (if (mime-editor/goto-tag)
1152           (let ((top (point)))
1153             (goto-char (match-end 0))
1154             (if (and (= beg top)        ;Must be on the same line.
1155                      (= (following-char) ?\^M))
1156                 (progn
1157                   (end-of-line)
1158                   (point))
1159               ;; Move to the end of this text.
1160               (if (re-search-forward mime-editor/tag-regexp nil 'move)
1161                   ;; Don't forget a multiline tag.
1162                   (goto-char (match-beginning 0)))
1163               (point)
1164               ))
1165         ;; Assume the message begins with text/plain.
1166         (goto-char (mime-editor/content-beginning))
1167         (if (re-search-forward mime-editor/tag-regexp nil 'move)
1168             ;; Don't forget a multiline tag.
1169             (goto-char (match-beginning 0)))
1170         (point))
1171       )))
1172
1173 (defun mime-editor/define-charset (charset)
1174   "Set charset of current tag to CHARSET."
1175   (save-excursion
1176     (if (mime-editor/goto-tag)
1177         (let ((tag (buffer-substring (match-beginning 0) (match-end 0))))
1178           (delete-region (match-beginning 0) (match-end 0))
1179           (insert
1180            (mime-create-tag (mime-set-parameter
1181                              (mime-editor/get-contype tag) "charset" charset)
1182                             (mime-editor/get-encoding tag))))
1183       )))
1184
1185 (defun mime-editor/define-encoding (encoding)
1186   "Set encoding of current tag to ENCODING."
1187   (save-excursion
1188     (if (mime-editor/goto-tag)
1189         (let ((tag (buffer-substring (match-beginning 0) (match-end 0))))
1190           (delete-region (match-beginning 0) (match-end 0))
1191           (insert (mime-create-tag (mime-editor/get-contype tag) encoding)))
1192       )))
1193
1194 (defun mime-editor/choose-charset ()
1195   "Choose charset of a text following current point."
1196   (save-excursion
1197     (let* ((beg (point))
1198            (end (mime-editor/content-end)))
1199       (car (funcall mime-body-charset-chooser beg end)))))
1200
1201 (defun mime-editor/choose-encoding ()
1202   "Choose encoding of a text following current point."
1203   (save-excursion
1204     (let* ((beg (point))
1205            (end (mime-editor/content-end)))
1206       (cdr (funcall mime-body-charset-chooser beg end)))))
1207
1208 (defun mime-make-text-tag (&optional subtype)
1209   "Make a tag for a text after current point.
1210 Subtype of text type can be specified by an optional argument SUBTYPE.
1211 Otherwise, it is obtained from mime-content-types."
1212   (let* ((pritype "text")
1213          (subtype (or subtype
1214                       (car (car (cdr (assoc pritype mime-content-types)))))))
1215     ;; Charset should be defined later.
1216     (mime-make-tag pritype subtype)))
1217
1218 \f
1219 ;; Tag handling functions
1220
1221 (defun mime-make-tag (pritype subtype &optional parameters encoding)
1222   "Make a tag of MIME message of PRITYPE, SUBTYPE and optional PARAMETERS."
1223   (mime-create-tag (concat (or pritype "") "/" (or subtype "")
1224                            (or parameters ""))
1225                    encoding))
1226
1227 (defun mime-create-tag (contype &optional encoding)
1228   "Make a tag with CONTENT-TYPE and optional ENCODING."
1229   (format (if encoding mime-tag-format-with-encoding mime-tag-format)
1230           contype encoding))
1231
1232 (defun mime-editor/get-contype (tag)
1233   "Return Content-Type (including parameters) of TAG."
1234   (and (stringp tag)
1235        (or (string-match mime-editor/single-part-tag-regexp tag)
1236            (string-match mime-editor/multipart-beginning-regexp tag)
1237            (string-match mime-editor/multipart-end-regexp tag)
1238            )
1239        (substring tag (match-beginning 1) (match-end 1))
1240        ))
1241
1242 (defun mime-editor/get-encoding (tag)
1243   "Return encoding of TAG."
1244   (and (stringp tag)
1245        (string-match mime-editor/single-part-tag-regexp tag)
1246        (match-beginning 3)
1247        (not (= (match-beginning 3) (match-end 3)))
1248        (substring tag (match-beginning 3) (match-end 3))))
1249
1250 (defun mime-get-parameter (contype parameter)
1251   "For given CONTYPE return value for PARAMETER.
1252 Nil if no such parameter."
1253   (if (string-match
1254        (concat
1255         ";[ \t\n]*"
1256         (regexp-quote parameter)
1257         "[ \t\n]*=[ \t\n]*\\([^\" \t\n;]*\\|\"[^\"]*\"\\)\\([ \t\n]*;\\|$\\)")
1258        contype)
1259       (substring contype (match-beginning 1) (match-end 1))
1260     nil                                 ;No such parameter
1261     ))
1262
1263 (defun mime-set-parameter (contype parameter value)
1264   "For given CONTYPE set PARAMETER to VALUE."
1265   (if (string-match
1266        (concat
1267         ";[ \t\n]*\\("
1268         (regexp-quote parameter)
1269         "[ \t\n]*=[ \t\n]*\\([^\" \t\n;]*\\|\"[^\"]*\"\\)\\)[ \t\n]*\\(;\\|$\\)")
1270        contype)
1271       ;; Change value
1272       (concat (substring contype 0 (match-beginning 1))
1273               parameter "=" value
1274               (substring contype (match-end 1)))
1275     (concat contype "; " parameter "=" value)))
1276
1277 (defun mime-strip-parameters (contype)
1278   "Return primary content-type and subtype without parameters for CONTYPE."
1279   (if (string-match "^[ \t]*\\([^; \t\n]*\\)" contype)
1280       (substring contype (match-beginning 1) (match-end 1)) nil))
1281
1282 (defun mime-test-content-type (contype type &optional subtype)
1283   "Test if CONTYPE is a TYPE and an optional SUBTYPE."
1284   (and (stringp contype)
1285        (stringp type)
1286        (string-match
1287         (concat "^[ \t]*" (downcase type) "/" (downcase (or subtype "")))
1288         (downcase contype))))
1289
1290 \f
1291 ;; Basic functions
1292
1293 (defun mime-find-file-type (file)
1294   "Guess Content-Type, subtype, and parameters from FILE."
1295   (let ((guess nil)
1296         (guesses mime-file-types))
1297     (while (and (not guess) guesses)
1298       (if (string-match (car (car guesses)) file)
1299           (setq guess (cdr (car guesses))))
1300       (setq guesses (cdr guesses)))
1301     guess
1302     ))
1303
1304 (defun mime-prompt-for-type ()
1305   "Ask for Content-type."
1306   (let ((type ""))
1307     ;; Repeat until primary content type is specified.
1308     (while (string-equal type "")
1309       (setq type
1310             (completing-read "What content type: "
1311                              mime-content-types
1312                              nil
1313                              'require-match ;Type must be specified.
1314                              nil
1315                              ))
1316       (if (string-equal type "")
1317           (progn
1318             (message "Content type is required.")
1319             (beep)
1320             (sit-for 1)
1321             ))
1322       )
1323     type
1324     ))
1325
1326 (defun mime-prompt-for-subtype (pritype)
1327   "Ask for Content-type subtype of Content-Type PRITYPE."
1328   (let* ((default (car (car (cdr (assoc pritype mime-content-types)))))
1329          (answer
1330           (completing-read
1331            (if default
1332                (concat
1333                 "What content subtype: (default " default ") ")
1334              "What content subtype: ")
1335            (cdr (assoc pritype mime-content-types))
1336            nil
1337            'require-match               ;Subtype must be specified.
1338            nil
1339            )))
1340     (if (string-equal answer "") default answer)))
1341
1342 (defun mime-prompt-for-parameters (pritype subtype &optional delimiter)
1343   "Ask for Content-type parameters of Content-Type PRITYPE and SUBTYPE.
1344 Optional DELIMITER specifies parameter delimiter (';' by default)."
1345   (let* ((delimiter (or delimiter "; "))
1346          (parameters
1347           (mapconcat
1348            (function identity)
1349            (delq nil
1350                  (mime-prompt-for-parameters-1
1351                   (cdr (assoc subtype
1352                               (cdr (assoc pritype mime-content-types))))))
1353            delimiter
1354            )))
1355     (if (and (stringp parameters)
1356              (not (string-equal parameters "")))
1357         (concat delimiter parameters)
1358       ""                                ;"" if no parameters
1359       )))
1360
1361 (defun mime-prompt-for-parameters-1 (optlist)
1362   (apply (function append)
1363          (mapcar (function mime-prompt-for-parameter) optlist)))
1364
1365 (defun mime-prompt-for-parameter (parameter)
1366   "Ask for PARAMETER.
1367 Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))."
1368   (let* ((prompt (car parameter))
1369          (choices (mapcar (function
1370                            (lambda (e)
1371                              (if (consp e) e (list e))))
1372                           (cdr parameter)))
1373          (default (car (car choices)))
1374          (answer nil))
1375     (if choices
1376         (progn
1377           (setq answer
1378                 (completing-read
1379                  (concat "What " prompt
1380                          ": (default "
1381                          (if (string-equal default "") "\"\"" default)
1382                          ") ")
1383                  choices nil nil ""))
1384           ;; If nothing is selected, use default.
1385           (if (string-equal answer "")
1386               (setq answer default)))
1387       (setq answer
1388             (read-string (concat "What " prompt ": "))))
1389     (cons (if (and answer
1390                    (not (string-equal answer "")))
1391               (concat prompt "="
1392                       ;; Note: control characters ignored!
1393                       (if (string-match mime-tspecials-regexp answer)
1394                           (concat "\"" answer "\"") answer)))
1395           (mime-prompt-for-parameters-1 (cdr (assoc answer (cdr parameter)))))
1396     ))
1397
1398 (defun mime-encode-string (encoding string)
1399   "Using ENCODING encode a STRING.
1400 If the STRING is too long, the encoded string may be broken into
1401 several lines."
1402   (save-excursion
1403     (set-buffer (get-buffer-create " *MIME encoding*"))
1404     (erase-buffer)
1405     (insert string)
1406     (mime-encode-region encoding (point-min) (point-max))
1407     (prog1
1408         (buffer-substring (point-min) (point-max))
1409       (kill-buffer (current-buffer)))))
1410
1411 (defun mime-decode-string (encoding string)
1412   "Using ENCODING decode a STRING."
1413   (save-excursion
1414     (set-buffer (get-buffer-create " *MIME decoding*"))
1415     (erase-buffer)
1416     (insert string)
1417     (mime-decode-region encoding (point-min) (point-max))
1418     (prog1
1419         (buffer-substring (point-min) (point-max))
1420       (kill-buffer (current-buffer)))))
1421
1422 (defun mime-flag-region (from to flag)
1423   "Hides or shows lines from FROM to TO, according to FLAG.
1424 If FLAG is `\\n' (newline character) then text is shown,
1425 while if FLAG is `\\^M' (control-M) the text is hidden."
1426   (let ((buffer-read-only nil)          ;Okay even if write protected.
1427         (modp (buffer-modified-p)))
1428     (unwind-protect
1429         (subst-char-in-region from to
1430                               (if (= flag ?\n) ?\^M ?\n)
1431                               flag t)
1432       (set-buffer-modified-p modp))))
1433
1434 \f
1435 ;;; @ Translate the tagged MIME messages into a MIME compliant message.
1436 ;;;
1437
1438 (defun mime-editor/translate-buffer ()
1439   "Encode the tagged MIME message in current buffer in MIME compliant message."
1440   (interactive)
1441   (if (catch 'mime-editor/error
1442         (save-excursion
1443           (mime/encode-message-header)
1444           (mime-editor/translate-body)
1445           (mime-editor/pgp-processing)
1446           ))
1447       (progn
1448         (undo)
1449         (error "Translation error!")
1450         )))
1451
1452 (defun mime-editor/find-inmost ()
1453   (goto-char (point-min))
1454   (if (re-search-forward mime-editor/multipart-beginning-regexp nil t)
1455       (let ((bb (match-beginning 0))
1456             (be (match-end 0))
1457             (type (buffer-substring (match-beginning 1)(match-end 1)))
1458             end-exp eb ee)
1459         (setq end-exp (format "^--}-<<%s>>\n" type))
1460         (widen)
1461         (if (re-search-forward end-exp nil t)
1462             (progn
1463               (setq eb (match-beginning 0))
1464               (setq ee (match-end 0))
1465               )
1466           (setq eb (point-max))
1467           (setq ee (point-max))
1468           )
1469         (narrow-to-region be eb)
1470         (goto-char be)
1471         (if (re-search-forward mime-editor/multipart-beginning-regexp nil t)
1472             (let (ret)
1473               (narrow-to-region (match-beginning 0)(point-max))
1474               (mime-editor/find-inmost)
1475               )
1476           (widen)
1477           ;;(delete-region eb ee)
1478           (list type bb be eb)
1479           ))))
1480
1481 (defun mime-editor/process-multipart-1 (boundary)
1482   (let ((ret (mime-editor/find-inmost)))
1483     (if ret
1484         (let ((type (car ret))
1485               (bb (nth 1 ret))(be (nth 2 ret))
1486               (eb (nth 3 ret))
1487               )
1488           (narrow-to-region bb eb)
1489           (delete-region bb be)
1490           (setq bb (point-min))
1491           (setq eb (point-max))
1492           (widen)
1493           (goto-char eb)
1494           (if (looking-at mime-editor/multipart-end-regexp)
1495               (let ((beg (match-beginning 0))
1496                     (end (match-end 0))
1497                     )
1498                 (delete-region beg end)
1499                 (if (and (not (looking-at mime-editor/single-part-tag-regexp))
1500                          (not (eobp)))
1501                     (insert (concat (mime-make-text-tag) "\n"))
1502                   )))
1503           (cond ((string= type "signed")
1504                  (cond ((eq mime-editor/signing-type 'pgp-elkins)
1505                         (mime-editor/sign-pgp-elkins bb eb boundary)
1506                         )
1507                        ((eq mime-editor/signing-type 'pgp-kazu)
1508                         (mime-editor/process-pgp-kazu 'mc-sign
1509                                                       bb eb boundary)
1510                         )
1511                        ))
1512                 ((string= type "encrypted")
1513                  (cond ((eq mime-editor/signing-type 'pgp-elkins)
1514                         (mime-editor/encrypt-pgp-elkins bb eb boundary)
1515                         )
1516                        ((eq mime-editor/signing-type 'pgp-kazu)
1517                         (mime-editor/process-pgp-kazu 'mc-encrypt
1518                                                       bb eb boundary)
1519                         )))
1520                 (t
1521                  (setq boundary
1522                        (nth 2 (mime-editor/translate-region bb eb
1523                                                             boundary t)))
1524                  (goto-char bb)
1525                  (insert
1526                   (format "--[[multipart/%s;
1527  boundary=\"%s\"][7bit]]\n"
1528                           type boundary))
1529                  ))
1530           boundary))))
1531
1532 (defun tm:mc-pgp-generic-parser (result)
1533   (let ((ret (mc-pgp-generic-parser result)))
1534     (if (consp ret)
1535         (vector (car ret)(cdr ret))
1536       )))
1537
1538 (autoload 'mc-pgp-lookup-key "mc-pgp")
1539
1540 (defun tm:mc-process-region
1541   (beg end passwd program args parser &optional buffer boundary)
1542   (let ((obuf (current-buffer))
1543         (process-connection-type nil)
1544         mybuf result rgn proc)
1545     (unwind-protect
1546         (progn
1547           (setq mybuf (or buffer (generate-new-buffer " *mailcrypt temp")))
1548           (set-buffer mybuf)
1549           (erase-buffer)
1550           (set-buffer obuf)
1551           (buffer-disable-undo mybuf)
1552           (setq proc
1553                 (apply 'start-process "*PGP*" mybuf program args))
1554           (if passwd
1555               (progn
1556                 (process-send-string proc (concat passwd "\n"))
1557                 (or mc-passwd-timeout (mc-deactivate-passwd t))))
1558           (process-send-region proc beg end)
1559           (process-send-eof proc)
1560           (while (eq 'run (process-status proc))
1561             (accept-process-output proc 5))
1562           (setq result (process-exit-status proc))
1563           ;; Hack to force a status_notify() in Emacs 19.29
1564           (delete-process proc)
1565           (set-buffer mybuf)
1566           (goto-char (point-max))
1567           (if (re-search-backward "\nProcess \\*PGP.*\n\\'" nil t)
1568               (delete-region (match-beginning 0) (match-end 0)))
1569           (goto-char (point-min))
1570           ;; CRNL -> NL
1571           (while (search-forward "\r\n" nil t)
1572             (replace-match "\n"))
1573           ;; Hurm.  FIXME; must get better result codes.
1574           (if (stringp result)
1575               (error "%s exited abnormally: '%s'" program result)
1576             (setq rgn (funcall parser result))
1577             ;; If the parser found something, migrate it
1578             (if (consp rgn)
1579                 (progn
1580                   (set-buffer obuf)
1581                   (if boundary
1582                       (save-restriction
1583                         (narrow-to-region beg end)
1584                         (goto-char beg)
1585                         (insert (format "--%s\n" boundary))
1586                         (goto-char (point-max))
1587                         (insert (format "\n--%s
1588 Content-Type: application/pgp-signature
1589 Content-Transfer-Encoding: 7bit
1590
1591 " boundary))
1592                         (insert-buffer-substring mybuf (car rgn) (cdr rgn))
1593                         (goto-char (point-max))
1594                         (insert (format "\n--%s--\n" boundary))
1595                         )
1596                     (delete-region beg end)
1597                     (goto-char beg)
1598                     (insert-buffer-substring mybuf (car rgn) (cdr rgn))
1599                     )
1600                   (set-buffer mybuf)
1601                   (delete-region (car rgn) (cdr rgn)))))
1602           ;; Return nil on failure and exit code on success
1603           (if rgn result))
1604       ;; Cleanup even on nonlocal exit
1605       (if (and proc (eq 'run (process-status proc)))
1606           (interrupt-process proc))
1607       (set-buffer obuf)
1608       (or buffer (null mybuf) (kill-buffer mybuf)))))
1609
1610 (defun tm:mc-pgp-sign-region (start end &optional id unclear boundary)
1611   (if (not (boundp 'mc-pgp-user-id))
1612       (load "mc-pgp")
1613     )
1614   (let ((process-environment process-environment)
1615         (buffer (get-buffer-create mc-buffer-name))
1616         passwd args key
1617         (parser (function mc-pgp-generic-parser))
1618         (pgp-path mc-pgp-path)
1619         )
1620     (setq key (mc-pgp-lookup-key (or id mc-pgp-user-id)))
1621     (setq passwd
1622           (mc-activate-passwd
1623            (cdr key)
1624            (format "PGP passphrase for %s (%s): " (car key) (cdr key))))
1625     (setenv "PGPPASSFD" "0")
1626     (setq args
1627           (cons
1628            (if boundary
1629                "-fbast"
1630              "-fast")
1631            (list "+verbose=1" "+language=en"
1632                  (format "+clearsig=%s" (if unclear "off" "on"))
1633                  "+batchmode" "-u" (cdr key))))
1634     (if mc-pgp-comment
1635         (setq args (cons (format "+comment=%s" mc-pgp-comment) args))
1636       )
1637     (message "Signing as %s ..." (car key))
1638     (if (tm:mc-process-region
1639          start end passwd pgp-path args parser buffer boundary)
1640         (progn
1641           (if boundary
1642               (progn
1643                 (goto-char (point-min))
1644                 (insert
1645                  (format "\
1646 --[[multipart/signed; protocol=\"application/pgp-signature\";
1647  boundary=\"%s\"; micalg=pgp-md5][7bit]]\n" boundary))
1648                 ))
1649           (message "Signing as %s ... Done." (car key))
1650           t)
1651       nil)))
1652
1653 (defun mime-editor/sign-pgp-elkins (beg end boundary)
1654   (save-excursion
1655     (save-restriction
1656       (narrow-to-region beg end)
1657       (let* ((ret
1658               (mime-editor/translate-region beg end boundary))
1659              (ctype    (car ret))
1660              (encoding (nth 1 ret))
1661              (parts    (nth 3 ret))
1662              (pgp-boundary (concat "pgp-sign-" boundary))
1663              )
1664         (goto-char beg)
1665         (insert (format "Content-Type: %s\n" ctype))
1666         (if encoding
1667             (insert (format "Content-Transfer-Encoding: %s\n" encoding))
1668           )
1669         (insert "\n")
1670         (or (tm:mc-pgp-sign-region (point-min)(point-max)
1671                                    nil nil pgp-boundary)
1672             (throw 'mime-editor/error 'pgp-error)
1673             )
1674         ))))
1675
1676 (defun mime-editor/encrypt-pgp-elkins (beg end boundary)
1677   (save-excursion
1678     (save-restriction
1679       (narrow-to-region beg end)
1680       (let* ((ret
1681               (mime-editor/translate-region beg end boundary))
1682              (ctype    (car ret))
1683              (encoding (nth 1 ret))
1684              (parts    (nth 3 ret))
1685              (pgp-boundary (concat "pgp-" boundary))
1686              )
1687         (goto-char beg)
1688         (insert (format "Content-Type: %s\n" ctype))
1689         (if encoding
1690             (insert (format "Content-Transfer-Encoding: %s\n" encoding))
1691           )
1692         (insert "\n")
1693         (if (null
1694              (progn
1695                (goto-char beg)
1696                (insert "=\n")
1697                (prog1
1698                    (let ((mail-header-separator "="))
1699                      (call-interactively 'mc-encrypt)
1700                      )
1701                  (goto-char beg)
1702                  (and (search-forward "=\n")
1703                       (replace-match ""))
1704                  )))
1705             (throw 'mime-editor/error 'pgp-error)
1706           )
1707         (goto-char beg)
1708         (insert (format "--[[multipart/encrypted;
1709  boundary=\"%s\"; protocol=\"application/pgp-encrypted\"][7bit]]
1710 --%s
1711 Content-Type: application/pgp-encrypted
1712
1713 --%s
1714 Content-Type: application/octet-stream
1715 Content-Transfer-Encoding: 7bit
1716
1717 " pgp-boundary pgp-boundary pgp-boundary))
1718         (goto-char (point-max))
1719         (insert (format "\n--%s--\n" pgp-boundary))
1720         ))
1721     ))
1722
1723 (defun mime-editor/process-pgp-kazu (type beg end boundary)
1724   (save-excursion
1725     (save-restriction
1726       (narrow-to-region beg end)
1727       (let* ((ret
1728               (mime-editor/translate-region beg end boundary))
1729              (ctype    (car ret))
1730              (encoding (nth 1 ret))
1731              (parts    (nth 3 ret))
1732              )
1733         (goto-char beg)
1734         (insert (format "Content-Type: %s\n" ctype))
1735         (if encoding
1736             (insert (format "Content-Transfer-Encoding: %s\n" encoding))
1737           )
1738         (insert "\n")
1739         (if (null
1740              (progn
1741                (goto-char beg)
1742                (insert "=\n")
1743                (prog1
1744                    (let ((mail-header-separator "="))
1745                      (call-interactively type)
1746                      )
1747                  (goto-char beg)
1748                  (and (search-forward "=\n")
1749                       (replace-match ""))
1750                  )))
1751             (throw 'mime-editor/error 'pgp-error)
1752           )
1753         (goto-char beg)
1754         (insert
1755          "--[[application/pgp; format=mime][7bit]]\n")
1756         ))
1757     ))
1758
1759 (defun mime-editor/translate-body ()
1760   "Encode the tagged MIME body in current buffer in MIME compliant message."
1761   (interactive)
1762   (save-excursion
1763     (let ((boundary
1764            (concat mime-multipart-boundary " " (current-time-string)))
1765           (i 1)
1766           (time (current-time-string))
1767           ret)
1768       (while (mime-editor/process-multipart-1
1769               (format "%s %s-%d" mime-multipart-boundary time i))
1770         (setq i (1+ i))
1771         )
1772       (save-restriction
1773         ;; We are interested in message body.
1774         (let* ((beg
1775                 (progn
1776                   (goto-char (point-min))
1777                   (re-search-forward
1778                    (concat "\n" (regexp-quote mail-header-separator)
1779                            (if mime-ignore-preceding-spaces
1780                                "[ \t\n]*\n" "\n")) nil 'move)
1781                   (point)))
1782                (end
1783                 (progn
1784                   (goto-char (point-max))
1785                   (and mime-ignore-trailing-spaces
1786                        (re-search-backward "[^ \t\n]\n" beg t)
1787                        (forward-char 1))
1788                   (point))))
1789           (setq ret (mime-editor/translate-region
1790                      beg end
1791                      (format "%s %s-%d" mime-multipart-boundary time i)))
1792           ))
1793       (let ((contype (car ret))         ;Content-Type
1794             (encoding (nth 1 ret))      ;Content-Transfer-Encoding
1795             )
1796         ;; Make primary MIME headers.
1797         (or (mail-position-on-field "Mime-Version")
1798             (insert mime-editor/mime-version-value))
1799         ;; Remove old Content-Type and other fields.
1800         (save-restriction
1801           (goto-char (point-min))
1802           (search-forward (concat "\n" mail-header-separator "\n") nil t)
1803           (narrow-to-region (point-min) (point))
1804           (goto-char (point-min))
1805           (mime-delete-field "Content-Type")
1806           (mime-delete-field "Content-Transfer-Encoding"))
1807         ;; Then, insert Content-Type and Content-Transfer-Encoding fields.
1808         (mail-position-on-field "Content-Type")
1809         (insert contype)
1810         (if encoding
1811             (progn
1812               (mail-position-on-field "Content-Transfer-Encoding")
1813               (insert encoding)))
1814         ))))
1815
1816 (defun mime-editor/translate-region (beg end &optional boundary multipart)
1817   (if (null boundary)
1818       (setq boundary
1819             (concat mime-multipart-boundary " " (current-time-string)))
1820     )
1821   (save-excursion
1822     (save-restriction
1823       (narrow-to-region beg end)
1824       (let ((tag nil)                   ;MIME tag
1825             (contype nil)               ;Content-Type
1826             (encoding nil)              ;Content-Transfer-Encoding
1827             (nparts 0))                 ;Number of body parts
1828         ;; Normalize the body part by inserting appropriate message
1829         ;; tags for every message contents.
1830         (mime-editor/normalize-body)
1831         ;; Counting the number of Content-Type.
1832         (goto-char (point-min))
1833         (while (re-search-forward mime-editor/single-part-tag-regexp nil t)
1834           (setq nparts (1+ nparts)))
1835         ;; Begin translation.
1836         (cond ((and (<= nparts 1)(not multipart))
1837                ;; It's a singular message.
1838                (goto-char (point-min))
1839                (while (re-search-forward
1840                        mime-editor/single-part-tag-regexp nil t)
1841                  (setq tag
1842                        (buffer-substring (match-beginning 0) (match-end 0)))
1843                  (delete-region (match-beginning 0) (1+ (match-end 0)))
1844                  (setq contype (mime-editor/get-contype tag))
1845                  (setq encoding (mime-editor/get-encoding tag))
1846                  ))
1847               (t
1848                ;; It's a multipart message.
1849                (goto-char (point-min))
1850                (while (re-search-forward
1851                        mime-editor/single-part-tag-regexp nil t)
1852                  (setq tag
1853                        (buffer-substring (match-beginning 0) (match-end 0)))
1854                  (delete-region (match-beginning 0) (match-end 0))
1855                  (setq contype (mime-editor/get-contype tag))
1856                  (setq encoding (mime-editor/get-encoding tag))
1857                  (insert "--" boundary "\n")
1858                  (insert "Content-Type: " contype "\n")
1859                  (if encoding
1860                      (insert "Content-Transfer-Encoding: " encoding "\n"))
1861                  )
1862                ;; Define Content-Type as "multipart/mixed".
1863                (setq contype
1864                      (concat "multipart/mixed;\n boundary=\"" boundary "\""))
1865                ;; Content-Transfer-Encoding must be "7bit".
1866                ;; The following encoding can be `nil', but is
1867                ;; specified as is since there is no way that a user
1868                ;; specifies it.
1869                (setq encoding "7bit")
1870                ;; Insert the trailer.
1871                (goto-char (point-max))
1872                (if multipart
1873                    (insert "--" boundary "--\n")
1874                  (insert "\n--" boundary "--\n")
1875                  )))
1876         (list contype encoding boundary nparts)
1877         ))))
1878
1879 (defun mime-editor/normalize-body ()
1880   "Normalize the body part by inserting appropriate message tags."
1881   ;; Insert the first MIME tags if necessary.
1882   (goto-char (point-min))
1883   (if (not (looking-at mime-editor/single-part-tag-regexp))
1884       (insert (mime-make-text-tag) "\n"))
1885   ;; Check each tag, and add new tag or correct it if necessary.
1886   (goto-char (point-min))
1887   (while (re-search-forward mime-editor/single-part-tag-regexp nil t)
1888     (let* ((tag (buffer-substring (match-beginning 0) (match-end 0)))
1889            (contype (mime-editor/get-contype tag))
1890            (charset (mime-get-parameter contype "charset"))
1891            (encoding (mime-editor/get-encoding tag)))
1892       ;; Remove extra whitespaces after the tag.
1893       (if (looking-at "[ \t]+$")
1894           (delete-region (match-beginning 0) (match-end 0)))
1895       (cond ((= (following-char) ?\^M)
1896              ;; It must be image, audio or video.
1897              (let ((beg (point))
1898                    (end (mime-editor/content-end)))
1899                ;; Insert explicit MIME tags after hidden messages.
1900                (forward-line 1)
1901                (if (and (not (eobp))
1902                         (not (looking-at mime-editor/single-part-tag-regexp)))
1903                    (progn
1904                      (insert (mime-make-text-tag) "\n")
1905                      (forward-line -1)  ;Process it again as text.
1906                      ))
1907                ;; Show a hidden message.  The point is not altered
1908                ;; after the conversion.
1909                (mime-flag-region beg end ?\n)))
1910             ((mime-test-content-type contype "message")
1911              ;; Content-type "message" should be sent as is.
1912              (forward-line 1))
1913             ((mime-test-content-type contype "text")
1914              ;; Define charset for text if necessary.
1915              (setq charset (or charset (mime-editor/choose-charset)))
1916              (mime-editor/define-charset charset)
1917              (if (string-equal contype "text/x-rot13-47")
1918                  (save-excursion
1919                    (forward-line)
1920                    (set-mark (point))
1921                    (goto-char (mime-editor/content-end))
1922                    (tm:caesar-region)
1923                    ))
1924              ;; Point is now on current tag.
1925              ;; Define encoding and encode text if necessary.
1926              (if (null encoding)        ;Encoding is not specified.
1927                  (let* ((encoding (mime-editor/choose-encoding))
1928                         (beg (mime-editor/content-beginning))
1929                         (end (mime-editor/content-end))
1930                         (body (buffer-substring beg end))
1931                         (encoded (funcall mime-string-encoder
1932                                           (cons charset encoding) body)))
1933                    (if (not (string-equal body encoded))
1934                        (progn
1935                          (goto-char beg)
1936                          (delete-region beg end)
1937                          (insert encoded)
1938                          (goto-char beg)))
1939                    (mime-editor/define-encoding encoding)))
1940              (forward-line 1))
1941             ((null encoding)            ;Encoding is not specified.
1942              ;; Application, image, audio, video, and any other
1943              ;; unknown content-type without encoding should be
1944              ;; encoded.
1945              (let* ((encoding "base64") ;Encode in BASE64 by default.
1946                     (beg (mime-editor/content-beginning))
1947                     (end (mime-editor/content-end))
1948                     (body (buffer-substring beg end))
1949                     (encoded (funcall mime-string-encoder
1950                                       (cons nil encoding) body)))
1951                (if (not (string-equal body encoded))
1952                    (progn
1953                      (goto-char beg)
1954                      (delete-region beg end)
1955                      (insert encoded)
1956                      (goto-char beg)))
1957                (mime-editor/define-encoding encoding))
1958              (forward-line 1))
1959             )
1960       )))
1961
1962 (defun mime-delete-field (field)
1963   "Delete header FIELD."
1964   (let ((regexp (format "^%s:[ \t]*" field)))
1965     (goto-char (point-min))
1966     (while (re-search-forward regexp nil t)
1967       (delete-region (match-beginning 0)
1968                      (progn (forward-line 1) (point)))
1969       )))
1970
1971 \f
1972 ;;;
1973 ;;; Platform dependent functions
1974 ;;;
1975
1976 ;; Emacs 18 implementations
1977
1978 (defun mime-body-charset-chooser-for-emacs18 (begin end)
1979   "Return a cons of charset and encoding of a message in a given region.
1980 Encoding name must be a canonical name, such as `base64'."
1981   '("US-ASCII" . nil)                   ;Default charset of MIME.
1982   )
1983
1984 (defun mime-string-encoder-for-emacs18 (method string)
1985   "For given METHOD that is a cons of charset and encoding, encode a STRING."
1986   (let ((charset (car method))
1987         (encoding (cdr method)))
1988     (cond ((stringp encoding)
1989            (mime-encode-string encoding string))
1990           ;; Return string without any encoding.
1991           (t string)
1992           )))
1993
1994 \f
1995 ;; Emacs 19 implementations
1996
1997 (defun mime-body-charset-chooser-for-emacs19 (begin end)
1998   "Return a cons of charset and encoding of a message in a given region.
1999 Encoding name must be a canonical name, such as `base64'.
2000 US-ASCII and ISO-8859-1 are supported on Emacs 19."
2001   (cond ((save-excursion
2002            (goto-char begin)
2003            (re-search-forward "[\200-\377]" end t))
2004          '("ISO-8859-1" . "quoted-printable"))
2005         (t
2006          '("US-ASCII" . nil))           ;Default charset of MIME.
2007         ))
2008
2009 (defun mime-string-encoder-for-emacs19 (method string)
2010   "For given METHOD that is a cons of charset and encoding, encode a STRING."
2011   (let ((charset (car method))
2012         (encoding (cdr method)))
2013     (cond ((stringp encoding)
2014            (mime-encode-string encoding string))
2015           ;; Return string without any encoding.
2016           (t string)
2017           )))
2018
2019 \f
2020 ;; NEmacs implementations
2021
2022 (defun mime-body-charset-chooser-for-nemacs (begin end)
2023   "Return a cons of charset and encoding of a message in a given region.
2024 Encoding name must be a canonical name, such as `base64'.
2025 US-ASCII and ISO-2022-JP are supported on NEmacs."
2026   (cond ((check-region-kanji-code begin end)
2027          ;; The following are safe encoding methods for use in
2028          ;; USENET News systems that strip off all ESCs.
2029          ;; '("ISO-2022-JP" . "quoted-printable")
2030          ;; '("ISO-2022-JP" . "base64")
2031          ;; The following expects transport systems are all MIME
2032          ;; compliants.  For instance, ESCs are never stripped off.
2033          '("ISO-2022-JP" . nil))
2034         (t
2035          '("US-ASCII" . nil))           ;Default charset of MIME.
2036         ))
2037
2038 (defun mime-string-encoder-for-nemacs (method string)
2039   "For given METHOD that is a cons of charset and encoding, encode a STRING.
2040 US-ASCII and ISO-2022-JP are supported on NEmacs."
2041   (let ((charset (car method))
2042         (encoding (cdr method)))
2043     (cond ((stringp encoding)
2044            (mime-encode-string encoding
2045                                ;; Convert internal (EUC) to JIS code.
2046                                (convert-string-kanji-code string 3 2)
2047                                ))
2048           ;; NEmacs can convert into ISO-2022-JP automatically,
2049           ;; but can do it myself as follows:
2050           ;;(t (convert-string-kanji-code string 3 2))
2051
2052           ;; Return string without any encoding.
2053           (t string)
2054           )))
2055
2056 \f
2057 ;; Mule implementations
2058 ;; Thanks to contributions by wkenji@flab.fujitsu.co.jp (Kenji
2059 ;; WAKAMIYA) and handa@etl.go.jp (Kenichi Handa).
2060
2061 (defun mime-body-charset-chooser-for-mule (begin end)
2062   "Return a cons of charset and encoding of a message in a given
2063 region.  Encoding name must be a canonical name, such as `base64'.
2064 US-ASCII, ISO-8859-* (except for ISO-8859-6), ISO-2022-JP,
2065 ISO-2022-JP-2 and ISO-2022-INT-1 are supported on Mule.  Either of
2066 charset ISO-2022-JP-2 or ISO-2022-INT-1 is used for multilingual text
2067 in Mule."
2068   (let ((lclist (find-charset-region begin end)))
2069     (cond ((null lclist)
2070            '("US-ASCII" . nil))         ;Default charset of MIME.
2071           ;; Multilingual capability requred.
2072           ((and (> (length lclist) 1)
2073                 (boundp '*iso-2022-int-1*))
2074            '("ISO-2022-INT-1" . nil))
2075           ((> (length lclist) 1)
2076            '("ISO-2022-JP-2" . nil))
2077           ;; Simple charset.
2078           ((memq lc-ltn1 lclist)
2079            '("ISO-8859-1" . "quoted-printable"))
2080           ((memq lc-ltn2 lclist)
2081            '("ISO-8859-2" . "quoted-printable"))
2082           ((memq lc-ltn3 lclist)
2083            '("ISO-8859-3" . "quoted-printable"))
2084           ((memq lc-ltn4 lclist)
2085            '("ISO-8859-4" . "quoted-printable"))
2086           ((memq lc-crl lclist)
2087            '("ISO-8859-5" . "quoted-printable"))
2088           ;;((memq lc-arb lclist)
2089           ;; '("ISO-8859-6" . "quoted-printable"))
2090           ((memq lc-grk lclist)
2091            '("ISO-8859-7" . "quoted-printable"))
2092           ((memq lc-hbw lclist)
2093            '("ISO-8859-8" . "quoted-printable"))
2094           ((memq lc-ltn5 lclist)
2095            '("ISO-8859-9" . "quoted-printable"))
2096           ((memq lc-jp lclist)
2097            '("ISO-2022-JP" . nil))
2098           ((memq lc-kr lclist)
2099            '("ISO-2022-KR" . nil))
2100           ;; Unknown charset.
2101           ((boundp '*iso-2022-int-1*)
2102            '("ISO-2022-INT-1" . nil))
2103           (t
2104            '("ISO-2022-JP-2" . nil))
2105           )))
2106
2107 (defun mime-string-encoder-for-mule (method string)
2108   "For given METHOD that is a cons of charset and encoding, encode a
2109 STRING.  US-ASCII, ISO-8859-* (except for ISO-8859-6), ISO-2022-JP,
2110 ISO-2022-JP-2 and ISO-2022-INT-1 are supported on Mule.  Either of
2111 charset ISO-2022-JP-2 or ISO-2022-INT-1 is used for multilingual
2112 text."
2113   (let* ((charset (car method))
2114          (encoding (cdr method))
2115          (coding-system
2116           (cdr (assoc (and (stringp charset) (upcase charset))
2117                       '(("ISO-8859-1" . *ctext*)
2118                         ("ISO-8859-2" . *iso-8859-2*)
2119                         ("ISO-8859-3" . *iso-8859-3*)
2120                         ("ISO-8859-4" . *iso-8859-4*)
2121                         ("ISO-8859-5" . *iso-8859-5*)
2122                         ;;("ISO-8859-6" . *iso-8859-6*)
2123                         ("ISO-8859-7" . *iso-8859-7*)
2124                         ("ISO-8859-8" . *iso-8859-8*)
2125                         ("ISO-8859-9" . *iso-8859-9*)
2126                         ("ISO-2022-JP" . *junet*)
2127                         ("ISO-2022-JP-2" . *iso-2022-ss2-7*)
2128                         ("ISO-2022-KR" . *korean-mail*)
2129                         ("ISO-2022-INT-1" . *iso-2022-int-1*)
2130                         )))))
2131     ;; In bilingual environment it may be unnecessary to convert the
2132     ;; coding system of the string unless transfer encoding is
2133     ;; required since such conversion may be performed by mule
2134     ;; automatically.
2135     (if (not (null coding-system))
2136         (setq string (code-convert-string string *internal* coding-system)))
2137     (if (stringp encoding)
2138         (setq string (mime-encode-string encoding string)))
2139     string
2140     ))
2141
2142 \f
2143 ;; Sun implementations
2144
2145 (defun mime-voice-recorder-for-sun ()
2146   "Record voice in a buffer using Sun audio device, and return the buffer.
2147 If the environment variable AUDIOHOST is defined, its value is used as
2148 a recording host instead of local host."
2149   (let ((buffer (get-buffer-create " *MIME audio*"))
2150         (host (getenv "AUDIOHOST")))
2151     (message "Start the recording on %s.  Type C-g to finish the recording..."
2152              (or host (system-name)))
2153     (save-excursion
2154       (set-buffer buffer)
2155       (erase-buffer)
2156       (condition-case errorcode
2157           (let ((selective-display nil) ;Disable ^M to nl translation.
2158                 (mc-flag nil)           ;Mule
2159                 (kanji-flag nil))       ;NEmacs
2160             ;; If AUDIOHOST is defined, use the value as recording host.
2161             (cond ((not (null host))
2162                    ;; Disable automatic conversion of coding system if Mule.
2163                    (if (featurep 'mule)
2164                        (define-program-coding-system nil "rsh" *noconv*))
2165                    (call-process "rsh"
2166                                  nil
2167                                  buffer
2168                                  nil
2169                                  host
2170                                  "cat"
2171                                  "/dev/audio"
2172                                  ))
2173                   (t
2174                    ;; Disable automatic conversion of coding system if Mule.
2175                    (if (featurep 'mule)
2176                        (define-program-coding-system nil "cat" *noconv*))
2177                    (call-process "cat"
2178                                  "/dev/audio"
2179                                  buffer
2180                                  nil
2181                                  ))))
2182         (quit (message "Type C-g to finish recording... done.")
2183               buffer                    ;Return the buffer
2184               )))))
2185
2186 \f
2187 ;;; @ Other useful commands.
2188 ;;;
2189
2190 ;; Message forwarding commands as content-type "message/rfc822".
2191
2192 (defun mime-editor/insert-message (&optional message)
2193   (interactive)
2194   (let ((inserter (assoc-value major-mode mime-editor/message-inserter-alist)))
2195     (if (and inserter (fboundp inserter))
2196         (progn
2197           (mime-editor/insert-tag "message" "rfc822")
2198           (funcall inserter message)
2199           )
2200       (message "Sorry, I don't have message inserter for your MUA.")
2201       )))
2202
2203 (defun mime-editor/insert-mail (&optional message)
2204   (interactive)
2205   (let ((inserter (assoc-value major-mode mime-editor/mail-inserter-alist)))
2206     (if (and inserter (fboundp inserter))
2207         (progn
2208           (mime-editor/insert-tag "message" "rfc822")
2209           (funcall inserter message)
2210           )
2211       (message "Sorry, I don't have mail inserter for your MUA.")
2212       )))
2213
2214 (defun mime-editor/inserted-message-filter ()
2215   (save-excursion
2216     (save-restriction
2217       (let ((header-start (point))
2218             (case-fold-search t)
2219             beg end)
2220         ;; for Emacs 18
2221         ;; (if (re-search-forward "^$" (marker-position (mark-marker)))
2222         (if (re-search-forward "^$" (mark t))
2223             (narrow-to-region header-start (match-beginning 0))
2224           )
2225         (goto-char header-start)
2226         (while (and (re-search-forward
2227                      mime-editor/yank-ignored-field-regexp nil t)
2228                     (setq beg (match-beginning 0))
2229                     (setq end (1+ (rfc822/field-end)))
2230                     )
2231           (delete-region beg end)
2232           )
2233         ))))
2234
2235
2236 ;;; @ multipart enclosure
2237 ;;;
2238
2239 (defun mime-editor/enclose-region (type beg end)
2240   (save-excursion
2241     (goto-char beg)
2242     (let ((current (point))
2243           exist-prev-tag)
2244       (save-excursion
2245         (if (mime-editor/goto-tag)
2246             (or (eq current (match-beginning 0))
2247                 (setq exist-prev-tag t)
2248                 )))
2249       (save-restriction
2250         (narrow-to-region beg end)
2251         (goto-char beg)
2252         (if exist-prev-tag
2253             (insert "\n")
2254           )
2255         (insert (format "--<<%s>>-{\n" type))
2256         (goto-char (point-max))
2257         (insert (format "\n--}-<<%s>>\n" type))
2258         (goto-char (point-max))
2259         )
2260       (if (and (not (looking-at mime-editor/single-part-tag-regexp))
2261                (not (eobp)))
2262           (insert (mime-make-text-tag) "\n")
2263         )
2264       )))
2265
2266 (defun mime-editor/enclose-mixed-region (beg end)
2267   (interactive "*r")
2268   (mime-editor/enclose-region "mixed" beg end)
2269   )
2270
2271 (defun mime-editor/enclose-parallel-region (beg end)
2272   (interactive "*r")
2273   (mime-editor/enclose-region "parallel" beg end)
2274   )
2275
2276 (defun mime-editor/enclose-digest-region (beg end)
2277   (interactive "*r")
2278   (mime-editor/enclose-region "digest" beg end)
2279   )
2280
2281 (defun mime-editor/enclose-alternative-region (beg end)
2282   (interactive "*r")
2283   (mime-editor/enclose-region "alternative" beg end)
2284   )
2285
2286 (defun mime-editor/enclose-signed-region (beg end)
2287   (interactive "*r")
2288   (if mime-editor/signing-type
2289       (mime-editor/enclose-region "signed" beg end)
2290     (message "Please specify signing type.")
2291     ))
2292
2293 (defun mime-editor/enclose-encrypted-region (beg end)
2294   (interactive "*r")
2295   (if mime-editor/signing-type
2296       (mime-editor/enclose-region "encrypted" beg end)
2297     (message "Please specify encrypting type.")
2298     ))
2299
2300 (defun mime-editor/insert-key (&optional arg)
2301   "Insert a pgp public key."
2302   (interactive "P")
2303   (mime-editor/insert-tag "application" "pgp-keys")
2304   (mime-editor/define-encoding "7bit")
2305   (mc-insert-public-key)
2306   )
2307
2308
2309 ;;; @ flag setting
2310 ;;;
2311
2312 (defun mime-editor/set-split (arg)
2313   (interactive
2314    (list
2315     (y-or-n-p "Do you want to enable split?")
2316     ))
2317   (setq mime-editor/split-message arg)
2318   (if arg
2319       (message "This message is enabled to split.")
2320     (message "This message is not enabled to split.")
2321     ))
2322
2323
2324 ;;; @ pgp
2325 ;;;
2326
2327 (defun mime-editor/set-sign (arg)
2328   (interactive
2329    (list
2330     (y-or-n-p "Do you want to sign?")
2331     ))
2332   (if arg
2333       (progn
2334         (setq mime-editor/pgp-processing 'sign)
2335         (message "This message will be signed.")
2336         )
2337     (if (eq mime-editor/pgp-processing 'sign)
2338         (setq mime-editor/pgp-processing nil)
2339       )
2340     (message "This message will not be signed.")
2341     ))
2342
2343 (defun mime-editor/set-encrypt (arg)
2344   (interactive
2345    (list
2346     (y-or-n-p "Do you want to encrypt?")
2347     ))
2348   (if arg
2349       (progn
2350         (setq mime-editor/pgp-processing 'encrypt)
2351         (message "This message will be encrypt.")
2352         )
2353     (if (eq mime-editor/pgp-processing 'encrypt)
2354         (setq mime-editor/pgp-processing nil)
2355       )
2356     (message "This message will not be encrypt.")
2357     ))
2358
2359 (defvar mime-editor/pgp-processing nil)
2360 (make-variable-buffer-local 'mime-editor/pgp-processing)
2361
2362 (defun mime-editor/call-mc (command)
2363   (let* ((header (rfc822/get-header-string-except
2364                   "^Content-Type:" mail-header-separator)))
2365     (goto-char (point-min))
2366     (if (search-forward mail-header-separator)
2367         (replace-match "")
2368       )
2369     (goto-char (point-min))
2370     (insert header)
2371     (insert "Content-Type: application/pgp; format=mime\n")
2372     (insert mail-header-separator)
2373     (insert "\n")
2374     (if (null (call-interactively command))
2375         (throw 'mime-editor/error 'pgp-error)
2376       )
2377     ))
2378
2379 (defun mime-editor/pgp-processing ()
2380   (let ((command
2381          (cdr (assq mime-editor/pgp-processing
2382                     '((sign    . mc-sign)
2383                       (encrypt . mc-encrypt)
2384                       )))))
2385     (and command
2386          (mime-editor/call-mc command)
2387          )))
2388
2389
2390 ;;; @ split
2391 ;;;
2392
2393 (defun mime-editor/insert-partial-header
2394   (fields subject id number total separator)
2395   (insert fields)
2396   (insert (format "Subject: %s (%d/%d)\n" subject number total))
2397   (insert (format "Mime-Version: 1.0 (split by tm-edit %s)\n"
2398                   mime-editor/version))
2399   (insert (format "\
2400 Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n"
2401                   id number total separator))
2402   )
2403
2404 (defun mime-editor/split-and-send
2405   (&optional cmd lines mime-editor/message-max-length)
2406   (interactive)
2407   (or lines
2408       (setq lines
2409             (count-lines (point-min) (point-max)))
2410       )
2411   (or mime-editor/message-max-length
2412       (setq mime-editor/message-max-length
2413             (or (cdr (assq major-mode mime-editor/message-max-length-alist))
2414                 mime-editor/message-default-max-length))
2415       )
2416   (let* ((mime-editor/draft-file-name
2417           (or (buffer-file-name)
2418               (make-temp-name
2419                (expand-file-name "tm-draft" mime/tmp-dir))))
2420          (separator mail-header-separator)
2421          (config
2422           (eval (cdr (assq major-mode mime-editor/window-config-alist))))
2423          (id (concat "\""
2424                      (replace-space-with-underline (current-time-string))
2425                      "@" (system-name) "\"")))
2426     (run-hooks 'mime-editor/before-split-hook)
2427     (let* ((header (rfc822/get-header-string-except
2428                     mime-editor/split-ignored-field-regexp separator))
2429            (subject (mail-fetch-field "subject"))
2430            (total (+ (/ lines mime-editor/message-max-length)
2431                      (if (> (mod lines mime-editor/message-max-length) 0)
2432                          1)))
2433            (the-buf (current-buffer))
2434            (buf (get-buffer "*tmp-send*"))
2435            (command
2436             (or cmd
2437                 (cdr
2438                  (assq major-mode
2439                        mime-editor/split-message-sender-alist))
2440                 (cdr
2441                  (assq major-mode
2442                        mime-editor/message-default-sender-alist))
2443                 ))
2444            data)
2445       (goto-char (point-min))
2446       (if (re-search-forward (concat "^" (regexp-quote separator) "$")
2447                              nil t)
2448           (replace-match "")
2449         )
2450       (if buf
2451           (progn
2452             (switch-to-buffer buf)
2453             (erase-buffer)
2454             (switch-to-buffer the-buf)
2455             )
2456         (setq buf (get-buffer-create "*tmp-send*"))
2457         )
2458       (switch-to-buffer buf)
2459       (make-local-variable 'mail-header-separator)
2460       (setq mail-header-separator separator)
2461       (switch-to-buffer the-buf)
2462       (goto-char (point-min))
2463       (re-search-forward "^$" nil t)
2464       (let ((mime-editor/partial-number 1))
2465         (setq data (buffer-substring
2466                     (point-min)
2467                     (progn
2468                       (goto-line mime-editor/message-max-length)
2469                       (point))
2470                     ))
2471         (delete-region (point-min)(point))
2472         (switch-to-buffer buf)
2473         (mime-editor/insert-partial-header
2474          header subject id mime-editor/partial-number total separator)
2475         (insert data)
2476         (save-excursion
2477           (save-restriction
2478             (goto-char (point-min))
2479             (search-forward (concat "\n" mail-header-separator "\n"))
2480             (narrow-to-region
2481              (match-end 0)
2482              (if (re-search-forward "^$" nil t)
2483                  (match-beginning 0)
2484                (point-max)
2485                ))
2486             (goto-char (point-min))
2487             (while (re-search-forward
2488                     mime-editor/split-blind-field-regexp nil t)
2489               (delete-region (match-beginning 0)
2490                              (let ((e (rfc822/field-end)))
2491                                (if (< e (point-max))
2492                                    (1+ e)
2493                                  e)))
2494               )
2495             ))
2496         (save-excursion
2497           (message (format "Sending %d/%d..."
2498                            mime-editor/partial-number total))
2499           (call-interactively command)
2500           (message (format "Sending %d/%d... done"
2501                            mime-editor/partial-number total))
2502           )
2503         (erase-buffer)
2504         (switch-to-buffer the-buf)
2505         (setq mime-editor/partial-number 2)
2506         (while (< mime-editor/partial-number total)
2507           (setq data (buffer-substring
2508                       (point-min)
2509                       (progn
2510                         (goto-line mime-editor/message-max-length)
2511                         (point))
2512                       ))
2513           (delete-region (point-min)(point))
2514           (switch-to-buffer buf)
2515           (mime-editor/insert-partial-header
2516            header subject id mime-editor/partial-number total separator)
2517           (insert data)
2518           (save-excursion
2519             (message (format "Sending %d/%d..."
2520                              mime-editor/partial-number total))
2521             (call-interactively command)
2522             (message (format "Sending %d/%d... done"
2523                              mime-editor/partial-number total))
2524             )
2525           (erase-buffer)
2526           (switch-to-buffer the-buf)
2527           (setq mime-editor/partial-number
2528                 (1+ mime-editor/partial-number))
2529           )
2530         (goto-char (point-min))
2531         (mime-editor/insert-partial-header
2532          header subject id mime-editor/partial-number total separator)
2533         (message (format "Sending %d/%d..."
2534                          mime-editor/partial-number total))
2535         ))))
2536
2537 (defun mime-editor/maybe-split-and-send (&optional cmd)
2538   (interactive)
2539   (run-hooks 'mime-editor/before-send-hook)
2540   (let ((mime-editor/message-max-length
2541          (or (cdr (assq major-mode mime-editor/message-max-length-alist))
2542              mime-editor/message-default-max-length))
2543         (lines (count-lines (point-min) (point-max)))
2544         )
2545     (if (and (> lines mime-editor/message-max-length)
2546              mime-editor/split-message)
2547         (mime-editor/split-and-send cmd lines mime-editor/message-max-length)
2548       )))
2549
2550
2551 ;;; @ preview message
2552 ;;;
2553
2554 (defun mime-editor/preview-message ()
2555   "preview editing MIME message. [tm-edit.el]"
2556   (interactive)
2557   (let* ((str (buffer-string))
2558          (separator mail-header-separator)
2559          (the-buf (current-buffer))
2560          (buf-name (buffer-name))
2561          (temp-buf-name (concat "*temp-article:" buf-name "*"))
2562          (buf (get-buffer temp-buf-name))
2563          )
2564     (if buf
2565         (progn
2566           (switch-to-buffer buf)
2567           (erase-buffer)
2568           )
2569       (setq buf (get-buffer-create temp-buf-name))
2570       (switch-to-buffer buf)
2571       )
2572     (insert str)
2573     (setq major-mode 'mime/temporary-message-mode)
2574     (make-local-variable 'mail-header-separator)
2575     (setq mail-header-separator separator)
2576     (make-local-variable 'mime/editing-buffer)
2577     (setq mime/editing-buffer the-buf)
2578
2579     (run-hooks 'mime-editor/translate-hook)
2580     (mime-editor/translate-buffer)
2581     (goto-char (point-min))
2582     (if (re-search-forward
2583          (concat "^" (regexp-quote separator) "$"))
2584         (replace-match "")
2585       )
2586     (mime/viewer-mode)
2587     ))
2588
2589 (defun mime-editor/quitting-method ()
2590   (let ((temp mime::preview/article-buffer)
2591         buf)
2592     (mime-viewer/kill-buffer)
2593     (set-buffer temp)
2594     (setq buf mime/editing-buffer)
2595     (kill-buffer temp)
2596     (switch-to-buffer buf)
2597     ))
2598
2599 (set-alist 'mime-viewer/quitting-method-alist
2600            'mime/temporary-message-mode
2601            (function mime-editor/quitting-method)
2602            )
2603
2604
2605 ;;; @ draft preview
2606 ;;;
2607 ;; by "OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
2608 ;;       Mon, 10 Apr 1995 20:03:07 +0900
2609
2610 (defvar mime-editor/draft-header-separator-alist
2611   '((news-reply-mode . mail-header-separator)
2612     (mh-letter-mode . mail-header-separator)
2613     ))
2614
2615 (defvar mime::article/draft-header-separator nil)
2616
2617 (defun mime-editor/draft-preview ()
2618   (interactive)
2619   (let ((sep (cdr (assq major-mode mime-editor/draft-header-separator-alist))))
2620     (or (stringp sep) (setq sep (eval sep)))
2621     (make-variable-buffer-local 'mime::article/draft-header-separator)
2622     (goto-char (point-min))
2623     (re-search-forward
2624      (concat "^\\(" (regexp-quote sep) "\\)?$"))
2625     (setq mime::article/draft-header-separator
2626           (buffer-substring (match-beginning 0) (match-end 0)))
2627     (replace-match "")
2628     (mime/viewer-mode (current-buffer))
2629     (pop-to-buffer (current-buffer))
2630     ))
2631
2632 (defun mime-viewer::quitting-method/draft-preview ()
2633   (let ((mother mime::preview/mother-buffer))
2634     (save-excursion
2635       (switch-to-buffer mother)
2636       (goto-char (point-min))
2637       (if (and
2638            (re-search-forward
2639             (concat "^\\("
2640                     (regexp-quote mime::article/draft-header-separator)
2641                     "\\)?$") nil t)
2642            (bolp))
2643           (progn
2644             (insert mime::article/draft-header-separator)
2645             (set-buffer-modified-p (buffer-modified-p))
2646             )))
2647     (mime-viewer/kill-buffer)
2648     (pop-to-buffer mother)
2649     ))
2650
2651 (set-alist 'mime-viewer/quitting-method-alist
2652            'mh-letter-mode
2653            (function mime-viewer::quitting-method/draft-preview)
2654            )
2655
2656 (set-alist 'mime-viewer/quitting-method-alist
2657            'news-reply-mode
2658            (function mime-viewer::quitting-method/draft-preview)
2659            )
2660
2661
2662 ;;; @ etc
2663 ;;;
2664
2665 (defun replace-space-with-underline (str)
2666   (mapconcat (function
2667               (lambda (arg)
2668                 (char-to-string
2669                  (if (= arg 32)
2670                      ?_
2671                    arg)))) str "")
2672   )
2673
2674
2675 ;;; @ end
2676 ;;;
2677
2678 (provide 'tm-edit)
2679
2680 (run-hooks 'tm-edit-load-hook)
2681
2682 ;;; tm-edit.el ends here