;;;
-;;; tm-comp.el: attachment for MIME composer
+;;; tm-comp.el --- attachment for MIME composer
;;;
-;;; by MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;;; and OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
-;;; modified by MORITA Masahiro <hiro@isl.ntt.JP>
-;;; MORIOKA Tomohiko,
-;;; Kazushi (Jam) MARUKAWA <kazusi-m@is.aist-nara.ac.jp>,
-;;; OKABE Yasuo,
-;;; KOBAYASHI Shuhei <shuhei@cmpt01.phys.tohoku.ac.jp>,
-;;; and YAMAOKA Katsumi <yamaoka@ga.sony.co.jp>
+;;; Copyright (C) 1995 Free Software Foundation, Inc.
+;;; Copyright (C) 1994,1995 MORIOKA Tomohiko
+;;; Copyright (C) 1994,1995 OKABE Yasuo
+;;;
+;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>,
+;;; OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
+;;; modified by MORITA Masahiro <hiro@isl.ntt.JP>
+;;; Kazushi (Jam) MARUKAWA <kazusi-m@is.aist-nara.ac.jp>,
+;;; KOBAYASHI Shuhei <shuhei@cmpt01.phys.tohoku.ac.jp>,
+;;; YAMAOKA Katsumi <yamaoka@ga.sony.co.jp>,
+;;; and Richard Stanton <stanton@haas.berkeley.edu>
+;;; Keywords: mail, news, MIME, multimedia
+;;;
+;;; This file is part of tm (Tools for MIME).
;;;
-(require 'tm-misc)
(require 'tm-view)
-(require 'tl-header)
+(require 'tl-822)
(require 'tl-list)
(require 'mail-utils)
;;;
(defconst mime/composer-RCS-ID
- "$Id: tm-comp.el,v 6.3 1995/04/18 16:38:42 morioka Exp $")
+ "$Id: tm-comp.el,v 7.2 1995/10/08 09:31:05 morioka Exp $")
(defconst mime/composer-version (get-version-string mime/composer-RCS-ID))
'((news-reply-mode . 500)))
(defconst mime/message-nuke-headers
- "\\(^[Cc]ontent-\\|^[Ss]ubject:\\|^[Mm][Ii][Mm][Ee]-[Vv]ersion:\\)")
-(defvar mime/message-blind-headers
- "\\(^[BDFbdf][Cc][Cc]:\\|^[Cc][Cc]:[ \t]*$\\)")
+ "\\(^Content-\\|^Subject:\\|^MIME-Version:\\)")
+(defvar mime/message-blind-headers "\\(^[BDFbdf]cc:\\|^cc:[ \t]*$\\)")
(defvar mime/message-default-sender-alist
'((mail-mode . mail-send-and-exit)
(message
(format "Sending %d/%d... done" (+ i 1) total))
))
- (news-reply-mode . (lambda ()
- (interactive)
- (widen)
- (goto-char (point-min))
- (save-restriction
- (narrow-to-region
- (point-min)
- (progn
- (goto-char (point-min))
- (search-forward (concat "\n" mail-header-separator "\n"))
- (point)))
- ;; Mail the message too if To: or Cc: exists.
- (if (or (mail-fetch-field "to" nil t)
- (mail-fetch-field "cc" nil t))
- (if gnus-mail-send-method
- (progn
- (message
- (format "Sending (%d/%d) via mail..." (+ i 1) total))
- (widen)
- (funcall gnus-mail-send-method)
- (message
- (format "Sending (%d/%d) via mail... done" (+ i 1) total))
- (ding)
- (message "No mailer defined. To: and/or Cc: fields ignored.")
- (sit-for 1)))))
- (message
- (format "Posting %d/%d to USENET..." (+ i 1) total))
- (if (gnus-inews-article)
- (message
- (format "Posting %d/%d to USENET... done" (+ i 1) total))
- ;; We cannot signal an error.
- (ding)
- (message
- (format "Article %d/%d rejected: %s" (+ i 1) total (gnus-status-message)))
- (sit-for 3))
- ))
))
-
+
(defvar mime/window-config-alist
'((mail-mode . nil)
(mh-letter-mode . mh-previous-window-config)
- (news-reply-mode . (prog1
- gnus-winconf-post-news
- (setq gnus-winconf-post-news nil)
- ))
+ (news-reply-mode . (cond ((boundp 'gnus-winconf-post-news)
+ (prog1
+ gnus-winconf-post-news
+ (setq gnus-winconf-post-news nil)
+ ))
+ ((boundp 'gnus-prev-winconf)
+ (prog1
+ gnus-prev-winconf
+ (setq gnus-prev-winconf nil)
+ ))
+ ))
))
(defvar mime/news-reply-mode-server-running nil)
+
(defvar mime/message-before-send-hook-alist
- '((mh-letter-mode . mh-before-send-letter-hook))
- (news-reply-mode . '(lambda ()
- (let ((case-fold-search nil))
- (or (boundp 'mime/news-reply-mode-server-running)
- (make-variable-buffer-local 'mime/news-reply-mode-server-running))
- (setq mime/news-reply-mode-server-running (gnus-server-opened))
- (save-excursion
- (gnus-start-server-process)
- (widen)
- (goto-char (point-min))
- (run-hooks 'news-inews-hook)
- (save-restriction
- (narrow-to-region
- (point-min)
- (progn
- (goto-char (point-min))
- (search-forward (concat "\n" mail-header-separator "\n"))
- (point)))
-
- (goto-char (point-min))
- (if (search-forward-regexp "^Newsgroups: +" nil t)
- (save-restriction
- (narrow-to-region
- (point)
- (if (re-search-forward "^[^ \t]" nil 'end)
- (match-beginning 0)
- (point-max)))
- (goto-char (point-min))
- (replace-regexp "\n[ \t]+" " ")
- (goto-char (point-min))
- (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",")
- ))
- ))))
- ))
+ '((mh-letter-mode . mh-before-send-letter-hook)))
(defvar mime/message-after-send-hook-alist
- '((mh-letter-mode . '(lambda ()
+ '((mh-letter-mode . (lambda ()
(if mh-annotate-char
(mh-annotate-msg mh-sent-from-msg
mh-sent-from-folder
(format "\"%s %s\""
(mh-get-field "To:")
(mh-get-field "Cc:"))))))
- (news-reply-mode . '(lambda ()
- (or mime/news-reply-mode-server-running
- (gnus-close-server))
- (and (fboundp 'bury-buffer) (bury-buffer))))
))
(defvar tm-comp/message-inserter-alist nil)
;;; @ edit
;;;
+(defun tm-comp::mime-insert-file (file)
+ "Insert a message from a file."
+ (interactive "fInsert file as MIME message: ")
+ (let* ((guess (mime-find-file-type file))
+ (pritype (nth 0 guess))
+ (subtype (nth 1 guess))
+ (parameters (nth 2 guess))
+ (default (nth 3 guess)) ;Guess encoding from its file name.
+ (encoding
+ (if (not (interactive-p))
+ default
+ (completing-read
+ (concat "What transfer encoding"
+ (if default
+ (concat " (default "
+ (if (string-equal default "") "\"\"" default)
+ ")"
+ ))
+ ": ")
+ mime-transfer-encoders nil t nil))))
+ (if (string-equal encoding "")
+ (setq encoding default))
+ (if (consp parameters)
+ (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 (file-name-nondirectory file))
+ )
+ (setq parameters (concat parameters "; " attribute "=" value))
+ (setq rest (cdr rest))
+ )))
+ (mime-insert-tag pritype subtype parameters)
+ (mime-insert-binary-file file encoding)
+ ))
+
;; Insert the binary content after MIME tag.
;; modified by MORITA Masahiro <hiro@isl.ntt.JP>
;; for x-uue
(let ((mc-flag nil) ;Mule
(file-coding-system-for-read
(if (featurep 'mule) *noconv*))
- (kanji-flag nil)) ;NEmacs
+ (kanji-flag nil) ;NEmacs
+ (emx-binary-mode t) ;Stop CRLF to LF conversion in OS/2
+ )
(let (jka-compr-compression-info-list
jam-zcat-filename-list)
(insert-file-contents file))))
)
(save-restriction
(narrow-to-region (1- (point)) (point))
- (let ((start (point)))
+ (let ((start (point))
+ (emx-binary-mode t)) ;Stop LF to CRLF conversion in OS/2
(insert-buffer-substring buffer)
;; Encode binary message if necessary.
(if encoding
(replace-space-with-underline (current-time-string))
"@" (system-name) "\"")))
- (let ((hook (eval (cdr (assq major-mode mime/message-before-send-hook-alist)))))
- (run-hooks 'hook))
- (let* ((header (message/get-header-string-except
- mime/message-nuke-headers separator))
- (orig-header (message/get-header-string-except
+ (let ((hook (cdr (assq major-mode
+ mime/message-before-send-hook-alist))))
+ (run-hooks hook))
+ (let* ((header (rfc822/get-header-string-except
+ mime/message-nuke-headers separator))
+ (orig-header (rfc822/get-header-string-except
mime/message-blind-headers separator))
(subject (mail-fetch-field "subject"))
(total (+ (/ lines mime/message-max-length)
(insert
(format "Subject: %s (%d/%d)\n" subject (+ i 1) total))
(insert
- (format "Mime-Version: 1.0\n"))
+ (format "Mime-Version: 1.0 (split by tm-comp %s)\n"
+ mime/composer-version))
(insert
(format
"Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n"
(setq i (+ i 1))
)
)
- (let ((hook (eval (cdr (assq major-mode mime/message-after-send-hook-alist)))))
+ (let ((hook
+ (cdr (assq major-mode mime/message-after-send-hook-alist))))
(run-hooks 'hook))
(set-buffer-modified-p nil)
(cond ((y-or-n-p "Kill draft buffer? ")
(add-hook 'mime-mode-hook
(function
(lambda ()
+ (if (not (fboundp 'original::mime-insert-file))
+ (progn
+ (fset 'original::mime-insert-file
+ (symbol-function 'mime-insert-file))
+ (fset 'mime-insert-file 'tm-comp::mime-insert-file)
+ ))
(if (not (fboundp 'original::mime-insert-binary-file))
(progn
(fset 'original::mime-insert-binary-file
;;; @ etc
;;;
-(defun message/get-header-string-except (pat boundary)
- (save-excursion
- (save-restriction
- (narrow-to-region (goto-char (point-min))
- (progn
- (re-search-forward
- (concat "^\\(" (regexp-quote boundary) "\\)?$")
- nil t)
- (match-beginning 0)
- ))
- (goto-char (point-min))
- (let (field header)
- (while (re-search-forward message/field-regexp nil t)
- (setq field (buffer-substring (match-beginning 0)
- (match-end 0)
- ))
- (if (not (string-match pat field))
- (setq header (concat header field "\n"))
- ))
- header)
- )))
+(defun rfc822/get-header-string-except (pat boundary)
+ (let ((case-fold-search t))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (goto-char (point-min))
+ (progn
+ (re-search-forward
+ (concat "^\\(" (regexp-quote boundary) "\\)?$")
+ nil t)
+ (match-beginning 0)
+ ))
+ (goto-char (point-min))
+ (let (field header)
+ (while (re-search-forward rfc822/field-top-regexp nil t)
+ (setq field (buffer-substring (match-beginning 0)
+ (rfc822/field-end)
+ ))
+ (if (not (string-match pat field))
+ (setq header (concat header field "\n"))
+ ))
+ header)
+ ))))
(defun replace-space-with-underline (str)
(mapconcat (function
)
-(run-hooks 'tm-comp-load-hook)
+;;; @ end
+;;;
(provide 'tm-comp)
+
+(run-hooks 'tm-comp-load-hook)
projects / elisp / tm.git / blobdiff