;;; Code:
+(eval-when-compile (require 'static))
+
(require 'sendmail)
(require 'mail-utils)
(require 'mel)
nil
"attachment" (("filename" . file)))
- ("\\.html$"
+ ("\\.html?$"
"text" "html" nil
nil
nil nil)
(iso-2022-jp-2 7 "base64")
(iso-2022-int-1 7 "base64")))
-(defvar mime-transfer-level 7
- "*A number of network transfer level. It should be bigger than 7.")
+(defcustom mime-transfer-level 7
+ "*A number of network transfer level. It should be bigger than 7.
+Currently it has no effect except mode-line display."
+ :group 'mime-edit
+ :type '(choice (const 7)
+ (const 8)
+ (const :tag "Binary" 9)))
(make-variable-buffer-local 'mime-transfer-level)
(defsubst mime-encoding-name (transfer-level &optional not-omit)
;;; @@ about message inserting
;;;
-(defvar mime-edit-yank-ignored-field-list
+(defcustom mime-edit-yank-ignored-field-list
'("Received" "Approved" "Path" "Replied" "Status"
"Xref" "X-UIDL" "X-Filter" "X-Gnus-.*" "X-VM-.*")
"List of ignored header fields when inserting message/rfc822.
-Each elements are regexp of field-name.")
-
-(defvar mime-edit-yank-ignored-field-regexp
- (concat "^"
- (apply (function regexp-or) mime-edit-yank-ignored-field-list)
- ":"))
+Each elements are regexp of field-name."
+ :group 'mime-edit
+ :type '(repeat regexp))
(defvar mime-edit-message-inserter-alist nil)
(defvar mime-edit-mail-inserter-alist nil)
:group 'mime-edit
:type 'boolean)
-(defcustom mime-edit-message-default-max-lines 1000
+(defcustom mime-edit-message-default-max-lines 5000
"*Default maximum lines of a message."
:group 'mime-edit
:type 'integer)
mime-edit-multipart-beginning-regexp
mime-edit-multipart-end-regexp))
-(defvar mime-tag-format "--[[%s]]"
- "*Control-string making a MIME tag.")
+(defconst mime-tag-format "--[[%s]]"
+ "Control-string making a MIME tag.")
-(defvar mime-tag-format-with-encoding "--[[%s][%s]]"
- "*Control-string making a MIME tag with encoding.")
+(defconst mime-tag-format-with-encoding "--[[%s][%s]]"
+ "Control-string making a MIME tag with encoding.")
;;; @@ multipart boundary
;;; @@ optional header fields
;;;
-(defvar mime-edit-insert-user-agent-field t
- "*If non-nil, insert User-Agent header field.")
+(defcustom mime-edit-insert-user-agent-field t
+ "*If non-nil, insert User-Agent header field."
+ :group 'mime-edit
+ :type 'boolean)
(defvar mime-edit-user-agent-value
(concat (mime-product-name mime-user-interface-product)
;;;
(defconst mime-tspecials-regexp "[][()<>@,;:\\\"/?.= \t]"
- "*Specify MIME tspecials.
+ "Specify MIME tspecials.
Tspecials means any character that matches with it in header must be quoted.")
(defconst mime-edit-mime-version-value
"1.0"
"MIME version number.")
-(defconst mime-edit-mime-version-field-for-message/partial
- (concat "MIME-Version:"
- (eword-encode-field-body
- (concat " 1.0 (split by " mime-edit-version ")\n")
- "MIME-Version:"))
- "MIME version field for message/partial.")
-
-
;;; @ keymap and menu
;;;
(define-key mime-edit-mode-entity-map "\C-t" 'mime-edit-insert-text)
(define-key mime-edit-mode-entity-map "\C-i" 'mime-edit-insert-file)
+(define-key mime-edit-mode-entity-map "i" 'mime-edit-insert-text-file)
(define-key mime-edit-mode-entity-map "\C-e" 'mime-edit-insert-external)
(define-key mime-edit-mode-entity-map "\C-v" 'mime-edit-insert-voice)
(define-key mime-edit-mode-entity-map "\C-y" 'mime-edit-insert-message)
(level "Toggle transfer-level" mime-edit-toggle-transfer-level))
"MIME-edit menubar entry.")
-(cond ((featurep 'xemacs)
+(static-if (featurep 'xemacs)
;; modified by Pekka Marjola <pema@iki.fi>
;; 1995/9/5 (c.f. [tm-en:69])
- (defun mime-edit-define-menu-for-xemacs ()
- "Define menu for XEmacs."
- (cond ((featurep 'menubar)
- (make-local-variable 'current-menubar)
- (set-buffer-menubar current-menubar)
- (add-submenu
- nil
- (cons mime-edit-menu-title
- (mapcar (function
- (lambda (item)
- (vector (nth 1 item)(nth 2 item)
- mime-edit-mode-flag)))
- mime-edit-menu-list))))))
-
- ;; modified by Steven L. Baur <steve@miranova.com>
- ;; 1995/12/6 (c.f. [tm-en:209])
- (or (boundp 'mime-edit-popup-menu-for-xemacs)
- (setq mime-edit-popup-menu-for-xemacs
- (append '("MIME Commands" "---")
- (mapcar (function (lambda (item)
- (vector (nth 1 item)
- (nth 2 item)
- t)))
- mime-edit-menu-list)))))
- ((>= emacs-major-version 19)
- (define-key mime-edit-mode-map [menu-bar mime-edit]
- (cons mime-edit-menu-title
- (make-sparse-keymap mime-edit-menu-title)))
- (mapcar (function
- (lambda (item)
- (define-key mime-edit-mode-map
- (vector 'menu-bar 'mime-edit (car item))
- (cons (nth 1 item)(nth 2 item)))))
- (reverse mime-edit-menu-list))))
+ (progn
+ (defun mime-edit-define-menu-for-xemacs ()
+ "Define menu for XEmacs."
+ (cond ((featurep 'menubar)
+ (make-local-variable 'current-menubar)
+ (set-buffer-menubar current-menubar)
+ (add-submenu
+ nil
+ (cons mime-edit-menu-title
+ (mapcar (function
+ (lambda (item)
+ (vector (nth 1 item)(nth 2 item)
+ mime-edit-mode-flag)))
+ mime-edit-menu-list))))))
+ ;; modified by Steven L. Baur <steve@miranova.com>
+ ;; 1995/12/6 (c.f. [tm-en:209])
+ (or (boundp 'mime-edit-popup-menu-for-xemacs)
+ (setq mime-edit-popup-menu-for-xemacs
+ (append '("MIME Commands" "---")
+ (mapcar (function (lambda (item)
+ (vector (nth 1 item)
+ (nth 2 item)
+ t)))
+ mime-edit-menu-list)))))
+ ;; Bogus check. Nemacs is not supported.
+ ;;(>= emacs-major-version 19)
+ (define-key mime-edit-mode-map [menu-bar mime-edit]
+ (cons mime-edit-menu-title
+ (make-sparse-keymap mime-edit-menu-title)))
+ (mapcar (function
+ (lambda (item)
+ (define-key mime-edit-mode-map
+ (vector 'menu-bar 'mime-edit (car item))
+ (cons (nth 1 item)(nth 2 item)))))
+ (reverse mime-edit-menu-list)))
;;; @ macros
;;;
mime-transfer-level
A number of network transfer level. It should be bigger than 7.
- If you are in 8bit-through environment, please set 8.
+ If you are in 8bit-through environment, please set to 8.
mime-edit-voice-recorder
Specifies a function to record a voice message and encode it.
(turn-on-mime-edit))))
-(cond ((featurep 'xemacs)
- (add-minor-mode 'mime-edit-mode-flag
- '((" MIME-Edit " mime-transfer-level-string))
- mime-edit-mode-map
- nil
- 'mime-edit-mode))
- (t
- (set-alist 'minor-mode-alist
- 'mime-edit-mode-flag
- '((" MIME-Edit " mime-transfer-level-string)))
- (set-alist 'minor-mode-map-alist
- 'mime-edit-mode-flag
- mime-edit-mode-map)))
+(static-if (featurep 'xemacs)
+ (add-minor-mode 'mime-edit-mode-flag
+ '((" MIME-Edit " mime-transfer-level-string))
+ mime-edit-mode-map
+ nil
+ 'mime-edit-mode)
+ (set-alist 'minor-mode-alist
+ 'mime-edit-mode-flag
+ '((" MIME-Edit " mime-transfer-level-string)))
+ (set-alist 'minor-mode-map-alist
+ 'mime-edit-mode-flag
+ mime-edit-mode-map))
;;;###autoload
(if (and (featurep 'xemacs)
(featurep 'menubar))
(delete-menu-item (list mime-edit-menu-title)))
- (end-of-invisible)
+ (disable-invisible)
(set-buffer-modified-p (buffer-modified-p))
(run-hooks 'mime-edit-exit-hook)
(message "Exit MIME editor mode.")))
(if (boundp 'enriched-mode)
(enriched-mode -1))))))
+(defun mime-edit-insert-text-file (file &optional verbose)
+ "Insert a text message from a FILE.
+Charset is automatically obtained from the `charsets-mime-charset-alist'.
+If optional argument SUBTYPE is not nil, text/SUBTYPE tag is inserted."
+ (interactive "fInsert file as a MIME text: \nP")
+ (let* ((guess (mime-find-file-type file))
+ (type "text")
+ (subtype nil)
+ (parameters (nth 2 guess))
+;; (encoding (nth 3 guess))
+ (disposition-type (nth 4 guess))
+ (disposition-params (nth 5 guess))
+ string)
+ (setq subtype (mime-prompt-for-subtype type subtype))
+;; (if (or (interactive-p) verbose)
+;; (setq encoding (mime-prompt-for-encoding encoding)))
+ (if verbose
+ (setq disposition-type (mime-prompt-for-disposition disposition-type)))
+ (if (or (consp parameters) (stringp disposition-type))
+ (let ((rest parameters) cell attribute value)
+ (setq parameters "")
+ (while rest
+ (setq cell (car rest))
+ (setq attribute (car cell))
+ (setq value (cdr cell))
+ (if (eq value 'file)
+ (setq value (std11-wrap-as-quoted-string
+ (file-name-nondirectory file))))
+ (setq parameters (concat parameters "; " attribute "=" value))
+ (setq rest (cdr rest)))
+ (if disposition-type
+ (progn
+ (setq parameters
+ (concat parameters "\n"
+ "Content-Disposition: " disposition-type))
+ (setq rest disposition-params)
+ (while rest
+ (setq cell (car rest))
+ (setq attribute (car cell))
+ (setq value (cdr cell))
+ (if (eq value 'file)
+ (setq value (std11-wrap-as-quoted-string
+ (file-name-nondirectory file))))
+ (setq parameters
+ (concat parameters "; " attribute "=" value))
+ (setq rest (cdr rest)))))))
+ (mime-edit-insert-place
+ (list type subtype)
+ (mime-edit-insert-tag type subtype parameters)
+;; (if (stringp encoding)
+;; (mime-edit-define-encoding encoding))
+ (save-excursion
+ (let ((ret (insert-file-contents file)))
+ (forward-char (cadr ret))
+ (if (and (not (eobp))
+ (not (looking-at mime-edit-single-part-tag-regexp)))
+ (insert (mime-make-text-tag) "\n")))))))
+
(defun mime-edit-insert-file (file &optional verbose)
"Insert a message from a FILE.
If VERBOSE is non-nil, it will prompt for Content-Type,
(parameters (nth 2 guess))
(encoding (nth 3 guess))
(disposition-type (nth 4 guess))
- (disposition-params (nth 5 guess)))
+ (disposition-params (nth 5 guess))
+ string)
(if verbose
(setq type (mime-prompt-for-type type)
subtype (mime-prompt-for-subtype type subtype)))
(if (or (consp parameters) (stringp disposition-type))
(let ((rest parameters) cell attribute value)
(setq parameters "")
+ (when (string= type "text")
+ (with-temp-buffer
+ (let (candidates candidate eol eol-string)
+ (set-buffer-multibyte nil)
+ (insert-file-contents-as-binary file)
+ (setq candidates (detect-coding-region (point-min) (point-max)))
+ (setq candidate (if (listp candidates)
+ (car candidates)
+ candidates))
+ (setq eol (coding-system-eol-type candidate))
+ (cond ((eq eol
+ (static-if (featurep 'xemacs)
+ 'lf
+ 0))
+ (setq eol-string "\n"))
+ ((eq eol
+ (static-if (featurep 'xemacs)
+ 'cr
+ 2))
+ (setq eol-string "\r")))
+ (goto-char (point-min))
+ (when eol-string
+ (while (search-forward eol-string nil t)
+ (replace-match "\r\n")))
+ (setq string (buffer-string))
+ (setq parameters
+ (concat parameters "; charset="
+ (symbol-name
+ (coding-system-to-mime-charset
+ candidate)))))))
(while rest
(setq cell (car rest))
(setq attribute (car cell))
(mime-edit-insert-place
(list type subtype)
(mime-edit-insert-tag type subtype parameters)
- (mime-edit-insert-binary-file file encoding))))
+ (if string
+ (mime-edit-insert-binary-string string encoding)
+ (mime-edit-insert-binary-file file encoding)))))
(defun mime-edit-insert-external ()
"Insert a reference to external body."
nil ;Nothing is created.
)))
+;; #### This should be merged into the function below but for now,
+;; don't change APIs.
+(defun mime-edit-insert-binary-string (string &optional encoding)
+ "Insert binary STRING at point.
+Optional argument ENCODING specifies an encoding method such as base64."
+ (let* ((tagend (1- (point))) ;End of the tag
+ (hide-p (and mime-auto-hide-body
+ (stringp encoding)
+ (not
+ (let ((en (downcase encoding)))
+ (or (string-equal en "7bit")
+ (string-equal en "8bit")
+ (string-equal en "binary")))))))
+ (save-restriction
+ (narrow-to-region tagend (point))
+ (insert
+ (with-temp-buffer
+ ;; #### @!#$%@!${$@}
+ (set-buffer-multibyte nil)
+ (insert string)
+ ;; #### Why mime-encode-string doesn't exist?
+ (mime-encode-region (point-min) (point-max)
+ (or encoding "7bit"))
+ (buffer-string)))
+ (if hide-p
+ (progn
+ (invisible-region (point-min) (point-max))
+ (goto-char (point-max)))
+ (goto-char (point-max))))
+ (unless (or (looking-at mime-edit-tag-regexp)
+ (= (point)(point-max)))
+ (insert "\n")
+ (mime-edit-insert-tag "text" "plain"))
+ ;; Define encoding even if it is 7bit.
+ (if (stringp encoding)
+ (save-excursion
+ (goto-char tagend) ; Make sure which line the tag is on.
+ (mime-edit-define-encoding encoding)))))
+
(defun mime-edit-insert-binary-file (file &optional encoding)
"Insert binary FILE at point.
Optional argument ENCODING specifies an encoding method such as base64."
(invisible-region (point-min) (point-max))
(goto-char (point-max)))
(goto-char (point-max))))
- (or hide-p
- (looking-at mime-edit-tag-regexp)
- (= (point)(point-max))
- (mime-edit-insert-tag "text" "plain"))
+ (unless (or (looking-at mime-edit-tag-regexp)
+ (= (point)(point-max)))
+ (insert "\n")
+ (mime-edit-insert-tag "text" "plain"))
;; Define encoding even if it is 7bit.
(if (stringp encoding)
(save-excursion
;; Change value
(concat (substring ctype 0 (match-beginning 1))
parameter "=" value
- (substring contype (match-end 1))
- opt-fields)
- (concat ctype "; " parameter "=" value opt-fields)
- )))
+ (substring contype (match-end 1)))
+ ;; This field makes two CDP header when charset parameter is present.
+;; opt-fields)
+ (concat ctype "; " parameter "=" value opt-fields))))
(defun mime-strip-parameters (contype)
"Return primary content-type and subtype without parameters for CONTYPE."
;; (point)
;; 'hard t)))
;; End patch for hard newlines
- (enriched-encode beg end)
+ (enriched-encode beg end nil)
(goto-char beg)
(if (search-forward "\n\n")
(delete-region beg (match-end 0)))))))
(narrow-to-region header-start (match-beginning 0)))
(goto-char header-start)
(while (and (re-search-forward
- mime-edit-yank-ignored-field-regexp nil t)
+ (concat "^"
+ (apply (function regexp-or)
+ mime-edit-yank-ignored-field-list)
+ ":") nil t)
(setq beg (match-beginning 0))
(setq end (1+ (std11-field-end))))
(delete-region beg end))))))
(interactive "P")
(mime-edit-insert-tag "application" "pgp-keys")
(mime-edit-define-encoding "7bit")
- (pgg-insert-key))
+ (pgg-insert-key)
+ (if (and (not (eobp))
+ (not (looking-at mime-edit-single-part-tag-regexp)))
+ (insert (mime-make-text-tag) "\n")))
;;; @ flag setting
id number total separator)
(insert fields)
(insert (format "Subject: %s (%d/%d)\n" subject number total))
- (insert mime-edit-mime-version-field-for-message/partial)
+ (insert (format "Mime-Version: %s\n" mime-edit-mime-version-value))
(insert (format "\
Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n"
id number total separator)))
(setq mime-edit-message-max-length
(or (cdr (assq major-mode mime-edit-message-max-lines-alist))
mime-edit-message-default-max-lines)))
- (let* ((mime-edit-draft-file-name
- (or (buffer-file-name)
- (make-temp-name
- (expand-file-name "mime-draft" temporary-file-directory))))
+ (let* (
+;; (mime-edit-draft-file-name
+;; (or (buffer-file-name)
+;; (make-temp-name
+;; (expand-file-name "mime-draft" temporary-file-directory))))
(separator mail-header-separator)
(id (concat "\""
(replace-space-with-underline (current-time-string))
projects / elisp / semi.git / blobdiff