;;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
;;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;;; Created: 1994/08/21 renamed from mime.el
-;;; Version: $Revision: 7.69 $
+;;; Version: $Revision: 7.71 $
;;; Keywords: mail, news, MIME, multimedia, multilingual
;;;
;;; This file is part of tm (Tools for MIME).
;;;
(defconst mime-editor/RCS-ID
- "$Id: tm-edit.el,v 7.69 1996/06/27 14:22:59 morioka Exp $")
+ "$Id: tm-edit.el,v 7.71 1996/07/11 14:54:06 morioka Exp $")
(defconst mime-editor/version (get-version-string mime-editor/RCS-ID))
+(defconst mime-editor/version-name
+ (concat "tm-edit " mime-editor/version))
+
;;; @ variables
;;;
"*A string formatted version of mime/defaul-transfer-level")
(make-variable-buffer-local 'mime-editor/transfer-level-string)
+(defun mime-editor/make-charset-default-encoding-alist (transfer-level)
+ (mapcar (function
+ (lambda (charset-type)
+ (let ((charset (car charset-type))
+ (type (nth 1 charset-type))
+ (encoding (nth 2 charset-type))
+ )
+ (if (<= type transfer-level)
+ (cons charset (mime/encoding-name type))
+ (cons charset encoding)
+ ))))
+ mime-charset-type-list))
+
(defvar mime-editor/charset-default-encoding-alist
- (mime/make-charset-default-encoding-alist mime-editor/transfer-level))
+ (mime-editor/make-charset-default-encoding-alist mime-editor/transfer-level))
(make-variable-buffer-local 'mime-editor/charset-default-encoding-alist)
;;; @@ about message inserting
;;;
(defconst mime-editor/single-part-tag-regexp
- "^--[[][[]\\([^]]*\\)]\\([[]\\([^]]*\\)]\\|\\)]"
+ "--[[][[]\\([^]]*\\)]\\([[]\\([^]]*\\)]\\|\\)]"
"*Regexp of MIME tag in the form of [[CONTENT-TYPE][ENCODING]].")
-(defconst mime-editor/multipart-beginning-regexp "^--<<\\([^<>]+\\)>>-{\n")
+(defconst mime-editor/quoted-single-part-tag-regexp
+ (concat "- " (substring mime-editor/single-part-tag-regexp 1)))
+
+(defconst mime-editor/multipart-beginning-regexp "--<<\\([^<>]+\\)>>-{\n")
-(defconst mime-editor/multipart-end-regexp "^--}-<<\\([^<>]+\\)>>\n")
+(defconst mime-editor/multipart-end-regexp "--}-<<\\([^<>]+\\)>>\n")
(defconst mime-editor/beginning-tag-regexp
(regexp-or mime-editor/single-part-tag-regexp
Tspecials means any character that matches with it in header must be quoted.")
(defconst mime-editor/mime-version-value
- (format "1.0 (generated by tm-edit %s)" mime-editor/version)
+ (concat "1.0 (generated by " mime-editor/version-name ")")
"MIME version number.")
(defconst mime-editor/mime-map (make-sparse-keymap)
"Keymap for MIME commands.")
-
;;; @ keymap and menu
;;;
(defvar mime/editor-mode-flag nil)
(make-variable-buffer-local 'mime/editor-mode-flag)
-(set-alist 'minor-mode-alist
- 'mime/editor-mode-flag
- '((" MIME-Edit " mime-editor/transfer-level-string)))
-
(defun mime-editor/define-keymap (keymap)
"Add mime-editor commands to KEYMAP."
(if (not (keymapp keymap))
(define-key keymap "d" 'mime-editor/enclose-digest-region)
(define-key keymap "s" 'mime-editor/enclose-signed-region)
(define-key keymap "e" 'mime-editor/enclose-encrypted-region)
+ (define-key keymap "q" 'mime-editor/enclose-quote-region)
(define-key keymap "\C-p" 'mime-editor/preview-message)
(define-key keymap "\C-z" 'mime-editor/exit)
(define-key keymap "?" 'mime-editor/help)
(mime-editor/define-keymap mime-editor/mime-map)
+(defun mime-editor/toggle-mode ()
+ (interactive)
+ (if mime/editor-mode-flag
+ (mime-editor/exit 'nomime)
+ (mime/editor-mode)
+ ))
+
+(cond (running-xemacs
+ (defconst mime-editor/minor-mime-map nil "Keymap for MIME commands.")
+ (or mime-editor/minor-mime-map
+ (progn
+ (setq mime-editor/minor-mime-map
+ (make-sparse-keymap 'mime-editor/minor-mime-map))
+ (define-key
+ mime-editor/minor-mime-map mime-prefix mime-editor/mime-map)
+ ))
+ (add-minor-mode 'mime/editor-mode-flag
+ '((" MIME-Edit " mime-editor/transfer-level-string))
+ mime-editor/minor-mime-map
+ nil
+ 'mime-editor/toggle-mode)
+ )
+ (t
+ (set-alist 'minor-mode-alist
+ 'mime/editor-mode-flag
+ '((" MIME-Edit " mime-editor/transfer-level-string))))
+ )
+
(defconst mime-editor/menu-title "MIME-Edit")
(defconst mime-editor/menu-list
(digest "Enclose as digest" mime-editor/enclose-digest-region)
(signed "Enclose as signed" mime-editor/enclose-signed-region)
(encrypted "Enclose as encrypted" mime-editor/enclose-encrypted-region)
+ (quote "Verbatim region" mime-editor/enclose-quote-region)
(key "Insert Public Key" mime-editor/insert-key)
(split "About split" mime-editor/set-split)
(sign "About sign" mime-editor/set-sign)
;; Restore previous state.
(setq mime/editor-mode-flag nil)
(cond (running-xemacs
- ;; mime-prefix only defined if binding was nil
- (if (eq (lookup-key (current-local-map) mime-prefix)
- mime-editor/mime-map)
- (define-key (current-local-map) mime-prefix nil))
(delete-menu-item (list mime-editor/menu-title)))
(t
(use-local-map mime/editor-mode-old-local-map)))
(let ((oldtag nil)
(newtag nil)
(current (point))
- exist-prev-tag exist-next-tag)
+ )
(setq pritype
(or pritype
(mime-prompt-for-type)))
(setq oldtag
(save-excursion
(if (mime-editor/goto-tag)
- (progn
- (if (eq current (match-beginning 0))
- (setq exist-next-tag t)
- (setq exist-prev-tag t)
- )
- (buffer-substring (match-beginning 0) (match-end 0))
- )
+ (buffer-substring (match-beginning 0) (match-end 0))
;; Assume content type is 'text/plan'.
(mime-make-tag "text" "plain")
)))
(not (mime-test-content-type
(mime-editor/get-contype oldtag) "text")))
(setq oldtag nil))
- (cond (exist-prev-tag (insert "\n"))
- (exist-next-tag (save-excursion
- (insert "\n")
- )))
- (if (not (bolp))
- (if exist-prev-tag
- (forward-line 1)
- (insert "\n")
- ))
;; Make a new tag.
(if (or (not oldtag) ;Not text
(or mime-ignore-same-text-tag
))
(if hide-p
(progn
- (mime-flag-region (point-min) (1- (point-max)) ?\^M)
- (goto-char (point-max)))
+ (invisible-region (point-min) (point-max))
+ (goto-char (point-max))
+ )
))
;; Define encoding even if it is 7bit.
(if (stringp encoding)
t
;; At first, go to the end.
(cond ((re-search-forward mime-editor/beginning-tag-regexp nil t)
- (goto-char (match-beginning 0)) ;For multiline tag
- (forward-line -1)
- (end-of-line)
+ (goto-char (1- (match-beginning 0))) ;For multiline tag
)
(t
(goto-char (point-max))
))
;; Then search for the beginning.
(re-search-backward mime-editor/end-tag-regexp nil t)
- (beginning-of-line)
(or (looking-at mime-editor/beginning-tag-regexp)
;; Restore previous point.
(progn
(defun mime-editor/content-end ()
"Return the point of the end of content."
(save-excursion
- (let ((beg (save-excursion
- (beginning-of-line) (point))))
+ (let ((beg (point)))
(if (mime-editor/goto-tag)
(let ((top (point)))
(goto-char (match-end 0))
- (if (and (= beg top) ;Must be on the same line.
- (= (following-char) ?\^M))
- (progn
- (end-of-line)
- (point))
+ (if (invisible-p (point))
+ (next-visible-point (point))
;; Move to the end of this text.
(if (re-search-forward mime-editor/tag-regexp nil 'move)
;; Don't forget a multiline tag.
- (goto-char (match-beginning 0)))
+ (goto-char (match-beginning 0))
+ )
(point)
))
;; Assume the message begins with text/plain.
(let ((tag (buffer-substring (match-beginning 0) (match-end 0))))
(delete-region (match-beginning 0) (match-end 0))
(insert
- (mime-create-tag (mime-set-parameter
- (mime-editor/get-contype tag) "charset" charset)
- (mime-editor/get-encoding tag))))
- )))
+ (mime-create-tag
+ (mime-editor/set-parameter
+ (mime-editor/get-contype tag)
+ "charset" (upcase (symbol-name charset)))
+ (mime-editor/get-encoding tag)))
+ ))))
(defun mime-editor/define-encoding (encoding)
"Set encoding of current tag to ENCODING."
(defun mime-editor/choose-charset ()
"Choose charset of a text following current point."
- (mime/find-charset-region (point) (mime-editor/content-end))
+ (detect-mime-charset-region (point) (mime-editor/content-end))
)
(defun mime-make-text-tag (&optional subtype)
nil ;No such parameter
))
-(defun mime-set-parameter (contype parameter value)
+(defun mime-editor/set-parameter (contype parameter value)
"For given CONTYPE set PARAMETER to VALUE."
- (if (string-match
- (concat
- ";[ \t\n]*\\("
- (regexp-quote parameter)
- "[ \t\n]*=[ \t\n]*\\([^\" \t\n;]*\\|\"[^\"]*\"\\)\\)[ \t\n]*\\(;\\|$\\)")
- contype)
- ;; Change value
- (concat (substring contype 0 (match-beginning 1))
- parameter "=" value
- (substring contype (match-end 1)))
- (concat contype "; " parameter "=" value)))
+ (let (ctype opt-fields)
+ (if (string-match "\n[^ \t\n\r]+:" contype)
+ (setq ctype (substring contype 0 (match-beginning 0))
+ opt-fields (substring contype (match-beginning 0)))
+ (setq ctype contype)
+ )
+ (if (string-match
+ (concat
+ ";[ \t\n]*\\("
+ (regexp-quote parameter)
+ "[ \t\n]*=[ \t\n]*\\([^\" \t\n;]*\\|\"[^\"]*\"\\)\\)[ \t\n]*\\(;\\|$\\)")
+ ctype)
+ ;; Change value
+ (concat (substring ctype 0 (match-beginning 1))
+ parameter "=" value
+ (substring contype (match-end 1))
+ opt-fields)
+ (concat ctype "; " parameter "=" value opt-fields)
+ )))
(defun mime-strip-parameters (contype)
"Return primary content-type and subtype without parameters for CONTYPE."
(be (match-end 0))
(type (buffer-substring (match-beginning 1)(match-end 1)))
end-exp eb ee)
- (setq end-exp (format "^--}-<<%s>>\n" type))
+ (setq end-exp (format "--}-<<%s>>\n" type))
(widen)
(if (re-search-forward end-exp nil t)
(progn
(mime-editor/find-inmost)
)
(widen)
- ;;(delete-region eb ee)
(list type bb be eb)
))))
(end (match-end 0))
)
(delete-region beg end)
- (if (and (not (looking-at mime-editor/single-part-tag-regexp))
- (not (eobp)))
+ (or (looking-at mime-editor/beginning-tag-regexp)
+ (eobp)
(insert (concat (mime-make-text-tag) "\n"))
- )))
- (cond ((string= type "signed")
+ )))
+ (cond ((string-equal type "quote")
+ (mime-editor/enquote-region bb eb)
+ )
+ ((string-equal type "signed")
(cond ((eq mime-editor/signing-type 'pgp-elkins)
(mime-editor/sign-pgp-elkins bb eb boundary)
)
((eq mime-editor/signing-type 'pgp-kazu)
(mime-editor/sign-pgp-kazu bb eb boundary)
- )
- ))
- ((string= type "encrypted")
+ ))
+ )
+ ((string-equal type "encrypted")
(cond ((eq mime-editor/encrypting-type 'pgp-elkins)
(mime-editor/encrypt-pgp-elkins bb eb boundary)
)
))
boundary))))
+(defun mime-editor/enquote-region (beg end)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char beg)
+ (while (re-search-forward mime-editor/single-part-tag-regexp nil t)
+ (let ((tag (buffer-substring (match-beginning 0)(match-end 0))))
+ (replace-match (concat "- " (substring tag 1)))
+ )))))
+
+(defun mime-editor/dequote-region (beg end)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char beg)
+ (while (re-search-forward
+ mime-editor/quoted-single-part-tag-regexp nil t)
+ (let ((tag (buffer-substring (match-beginning 0)(match-end 0))))
+ (replace-match (concat "-" (substring tag 2)))
+ )))))
(autoload 'mc-pgp-lookup-key "mc-pgp")
(autoload 'mc-pgp-sign-region "mc-pgp")
beg end
(format "%s-%d" boundary i)))
))
+ (mime-editor/dequote-region (point-min)(point-max))
(let ((contype (car ret)) ;Content-Type
(encoding (nth 1 ret)) ;Content-Transfer-Encoding
)
(insert encoding)))
))))
+(defun mime-editor/translate-single-part-tag (&optional prefix)
+ (if (re-search-forward mime-editor/single-part-tag-regexp nil t)
+ (let* ((beg (match-beginning 0))
+ (end (match-end 0))
+ (tag (buffer-substring beg end))
+ )
+ (delete-region beg end)
+ (setq contype (mime-editor/get-contype tag))
+ (setq encoding (mime-editor/get-encoding tag))
+ (insert (concat prefix "--" boundary "\n"))
+ (save-restriction
+ (narrow-to-region (point)(point))
+ (insert "Content-Type: " contype "\n")
+ (if encoding
+ (insert "Content-Transfer-Encoding: " encoding "\n"))
+ (mime/encode-message-header)
+ )
+ t)))
+
(defun mime-editor/translate-region (beg end &optional boundary multipart)
(if (null boundary)
(setq boundary
(while (re-search-forward mime-editor/single-part-tag-regexp nil t)
(setq nparts (1+ nparts)))
;; Begin translation.
- (cond ((and (<= nparts 1)(not multipart))
- ;; It's a singular message.
- (goto-char (point-min))
- (while (re-search-forward
- mime-editor/single-part-tag-regexp nil t)
- (setq tag
- (buffer-substring (match-beginning 0) (match-end 0)))
- (delete-region (match-beginning 0) (1+ (match-end 0)))
- (setq contype (mime-editor/get-contype tag))
- (setq encoding (mime-editor/get-encoding tag))
- ))
- (t
- ;; It's a multipart message.
- (goto-char (point-min))
- (while (re-search-forward
- mime-editor/single-part-tag-regexp nil t)
- (setq tag
- (buffer-substring (match-beginning 0) (match-end 0)))
- (delete-region (match-beginning 0) (match-end 0))
- (setq contype (mime-editor/get-contype tag))
- (setq encoding (mime-editor/get-encoding tag))
- (insert "--" boundary "\n")
- (insert "Content-Type: " contype "\n")
- (if encoding
- (insert "Content-Transfer-Encoding: " encoding "\n"))
- )
- ;; Define Content-Type as "multipart/mixed".
- (setq contype
- (concat "multipart/mixed;\n boundary=\"" boundary "\""))
- ;; Content-Transfer-Encoding must be "7bit".
- ;; The following encoding can be `nil', but is
- ;; specified as is since there is no way that a user
- ;; specifies it.
- (setq encoding "7bit")
- ;; Insert the trailer.
- (goto-char (point-max))
- (if multipart
- (insert "--" boundary "--\n")
- (insert "\n--" boundary "--\n")
- )))
+ (cond
+ ((and (<= nparts 1)(not multipart))
+ ;; It's a singular message.
+ (goto-char (point-min))
+ (while (re-search-forward
+ mime-editor/single-part-tag-regexp nil t)
+ (setq tag
+ (buffer-substring (match-beginning 0) (match-end 0)))
+ (delete-region (match-beginning 0) (1+ (match-end 0)))
+ (setq contype (mime-editor/get-contype tag))
+ (setq encoding (mime-editor/get-encoding tag))
+ ))
+ (t
+ ;; It's a multipart message.
+ (goto-char (point-min))
+ (and (mime-editor/translate-single-part-tag)
+ (while (mime-editor/translate-single-part-tag "\n"))
+ )
+ ;; Define Content-Type as "multipart/mixed".
+ (setq contype
+ (concat "multipart/mixed;\n boundary=\"" boundary "\""))
+ ;; Content-Transfer-Encoding must be "7bit".
+ ;; The following encoding can be `nil', but is
+ ;; specified as is since there is no way that a user
+ ;; specifies it.
+ (setq encoding "7bit")
+ ;; Insert the trailer.
+ (goto-char (point-max))
+ (insert "\n--" boundary "--\n")
+ ))
(list contype encoding boundary nparts)
))))
;; Remove extra whitespaces after the tag.
(if (looking-at "[ \t]+$")
(delete-region (match-beginning 0) (match-end 0)))
+ (let ((beg (point))
+ (end (mime-editor/content-end))
+ )
+ (goto-char end)
+ (or (looking-at mime-editor/beginning-tag-regexp)
+ (eobp)
+ (insert (mime-make-text-tag) "\n")
+ )
+ (visible-region beg end)
+ (goto-char beg)
+ )
(cond
- ((= (following-char) ?\^M)
- ;; It must be image, audio or video.
- (let ((beg (point))
- (end (mime-editor/content-end)))
- ;; Insert explicit MIME tags after hidden messages.
- (forward-line 1)
- (if (and (not (eobp))
- (not (looking-at mime-editor/single-part-tag-regexp)))
- (progn
- (insert (mime-make-text-tag) "\n")
- (forward-line -1) ;Process it again as text.
- ))
- ;; Show a hidden message. The point is not altered
- ;; after the conversion.
- (mime-flag-region beg end ?\n)
- ))
((mime-test-content-type contype "message")
;; Content-type "message" should be sent as is.
(forward-line 1)
)
((mime-test-content-type contype "text")
;; Define charset for text if necessary.
- (setq charset (or charset (mime-editor/choose-charset)))
+ (setq charset (if charset
+ (intern (downcase charset))
+ (mime-editor/choose-charset)))
(mime-editor/define-charset charset)
(cond ((string-equal contype "text/x-rot13-47")
(save-excursion
(or encoding ;Encoding is not specified.
(let* ((encoding
(cdr
- (assoc charset
- mime-editor/charset-default-encoding-alist)
+ (assq charset
+ mime-editor/charset-default-encoding-alist)
))
(beg (mime-editor/content-beginning))
)
- (mime-charset-encode-region beg (mime-editor/content-end)
+ (encode-mime-charset-region beg (mime-editor/content-end)
charset)
(mime-encode-region beg (mime-editor/content-end) encoding)
(mime-editor/define-encoding encoding)
))
- (forward-line 1)
+ (goto-char (mime-editor/content-end))
)
((null encoding) ;Encoding is not specified.
;; Application, image, audio, video, and any other
(mime-encode-region beg end encoding)
(mime-editor/define-encoding encoding))
(forward-line 1)
- )
- )
+ ))
)))
(defun mime-delete-field (field)
(defun mime-editor/enclose-region (type beg end)
(save-excursion
(goto-char beg)
- (let ((current (point))
- exist-prev-tag)
- (save-excursion
- (if (mime-editor/goto-tag)
- (or (eq current (match-beginning 0))
- (setq exist-prev-tag t)
- )))
+ (let ((current (point)))
(save-restriction
(narrow-to-region beg end)
- (goto-char beg)
- (if exist-prev-tag
- (insert "\n")
- )
(insert (format "--<<%s>>-{\n" type))
(goto-char (point-max))
- (insert (format "\n--}-<<%s>>\n" type))
+ (insert (format "--}-<<%s>>\n" type))
(goto-char (point-max))
)
- (if (and (not (looking-at mime-editor/single-part-tag-regexp))
- (not (eobp)))
+ (or (looking-at mime-editor/beginning-tag-regexp)
+ (eobp)
(insert (mime-make-text-tag) "\n")
- )
+ )
)))
+(defun mime-editor/enclose-quote-region (beg end)
+ (interactive "*r")
+ (mime-editor/enclose-region "quote" beg end)
+ )
+
(defun mime-editor/enclose-mixed-region (beg end)
(interactive "*r")
(mime-editor/enclose-region "mixed" beg end)
(setq mime-editor/transfer-level 7)
))
(setq mime-editor/charset-default-encoding-alist
- (mime/make-charset-default-encoding-alist
+ (mime-editor/make-charset-default-encoding-alist
mime-editor/transfer-level))
(message (format "Current transfer-level is %d bit"
mime-editor/transfer-level))
(fields subject id number total separator)
(insert fields)
(insert (format "Subject: %s (%d/%d)\n" subject number total))
- (insert (format "Mime-Version: 1.0 (split by tm-edit %s)\n"
- mime-editor/version))
+ (insert (format "Mime-Version: 1.0 (split by %s)\n"
+ mime-editor/version-name))
(insert (format "\
Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n"
id number total separator))
)
(cond
((string-equal type "multipart")
- (let ((boundary (assoc-value "boundary" params)))
- (re-search-forward (concat "\n--" boundary) nil t)
+ (let* ((boundary (assoc-value "boundary" params))
+ (boundary-pat
+ (concat "\n--" (regexp-quote boundary) "[ \t]*\n"))
+ )
+ (re-search-forward boundary-pat nil t)
(let ((bb (match-beginning 0)) eb tag)
- (setq tag (format "\n--<<%s>>-{" stype))
+ (setq tag (format "\n--<<%s>>-{\n" stype))
(goto-char bb)
(insert tag)
(setq bb (+ bb (length tag)))
- (re-search-forward (concat "\n--" boundary "--") nil t)
+ (re-search-forward
+ (concat "\n--" (regexp-quote boundary) "--[ \t]*\n")
+ nil t)
(setq eb (match-beginning 0))
- (replace-match (format "\n--}-<<%s>>" stype))
+ (replace-match (format "--}-<<%s>>\n" stype))
(save-restriction
(narrow-to-region bb eb)
(goto-char (point-min))
- (while (re-search-forward
- (concat "\n--" boundary "\n") nil t)
+ (while (re-search-forward boundary-pat nil t)
(let ((beg (match-beginning 0))
end)
(delete-region beg (match-end 0))
(save-excursion
- (if (re-search-forward
- (concat "\n--" boundary) nil t)
+ (if (re-search-forward boundary-pat nil t)
(setq end (match-beginning 0))
(setq end (point-max))
)
(goto-char (point-min))
(or (= (point-min) 1)
(delete-region (point-min)
- (if (re-search-forward "^$" nil t)
+ (if (search-forward "\n\n" nil t)
(match-end 0)
(point-min)
)))
(progn
(goto-char he)
(insert
- (concat
- "\n"
- (mime-create-tag
- (concat type "/" stype pstr) encoding)
- ))
+ (concat "\n"
+ (mime-create-tag
+ (concat type "/" stype pstr) encoding)))
)
(delete-region (point-min) he)
(insert
- (concat "\n"
- (mime-create-tag
- (concat type "/" stype pstr) encoding)
- ))
+ (mime-create-tag
+ (concat type "/" stype pstr) encoding))
))
))))
(if code-conversion
(mime-editor::edit-again code-conversion)
(goto-char (point-min))
(save-restriction
- (narrow-to-region (point-min)
- (if (re-search-forward "^$" nil t)
- (match-end 0)
- (point-max)
- ))
+ (narrow-to-region
+ (point-min)
+ (if (re-search-forward
+ (concat "^\\(" (regexp-quote mail-header-separator) "\\)?$")
+ nil t)
+ (match-end 0)
+ (point-max)
+ ))
(goto-char (point-min))
(while (re-search-forward
"^\\(Content-.*\\|Mime-Version\\):" nil t)
projects / elisp / tm.git / blobdiff