2 ;;; tm-comp.el: attachment for MIME composer
4 ;;; by MORIOKA Tomohiko <morioka@jaist.ac.jp>
5 ;;; and OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
6 ;;; modified by MORITA Masahiro <hiro@isl.ntt.JP>
8 ;;; Kazushi (Jam) MARUKAWA <kazusi-m@is.aist-nara.ac.jp>,
10 ;;; KOBAYASHI Shuhei <shuhei@cmpt01.phys.tohoku.ac.jp>,
11 ;;; and YAMAOKA Katsumi <yamaoka@ga.sony.co.jp>
24 (defconst mime/composer-RCS-ID
25 "$Id: tm-comp.el,v 6.8 1995/08/30 00:40:26 morioka Exp $")
27 (defconst mime/composer-version (get-version-string mime/composer-RCS-ID))
33 (defvar mime/message-default-max-length 1000)
35 (defvar mime/message-max-length-alist
36 '((news-reply-mode . 500)))
38 (defconst mime/message-nuke-headers
39 "\\(^[Cc]ontent-\\|^[Ss]ubject:\\|^[Mm][Ii][Mm][Ee]-[Vv]ersion:\\)")
40 (defvar mime/message-blind-headers
41 "\\(^[BDFbdf][Cc][Cc]:\\|^[Cc][Cc]:[ \t]*$\\)")
43 (defvar mime/message-default-sender-alist
44 '((mail-mode . mail-send-and-exit)
45 (mh-letter-mode . mh-send-letter)
46 (news-reply-mode . gnus-inews-news)))
48 (defvar mime/message-sender-alist
49 '((mail-mode . (lambda ()
53 (mh-letter-mode . (lambda (&optional arg)
55 (write-region (point-min) (point-max)
58 (format "Sending %d/%d..." (+ i 1) total))
60 (pop-to-buffer "MH mail delivery")
62 (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush"
63 "-nodraftfolder" mh-send-args mime/draft-file-name)
64 (goto-char (point-max)) ; show the interesting part
68 (apply 'mh-exec-cmd-quiet t mh-send-prog
70 (list "-nopush" "-nodraftfolder" "-noverbose" "-nowatch" mh-send-args mime/draft-file-name)))))
72 (format "Sending %d/%d... done" (+ i 1) total))
77 (defvar mime/window-config-alist
79 (mh-letter-mode . mh-previous-window-config)
80 (news-reply-mode . (cond ((boundp 'gnus-winconf-post-news)
82 gnus-winconf-post-news
83 (setq gnus-winconf-post-news nil)
85 ((boundp 'gnus-prev-winconf)
88 (setq gnus-prev-winconf nil)
93 (defvar mime/news-reply-mode-server-running nil)
96 (defvar mime/message-before-send-hook-alist
97 '((mh-letter-mode . mh-before-send-letter-hook)))
99 (defvar mime/message-after-send-hook-alist
100 '((mh-letter-mode . (lambda ()
102 (mh-annotate-msg mh-sent-from-msg
105 "-component" mh-annotate-field
109 (mh-get-field "Cc:"))))))
112 (defvar tm-comp/message-inserter-alist nil)
118 ;; Insert the binary content after MIME tag.
119 ;; modified by MORITA Masahiro <hiro@isl.ntt.JP>
121 (defun tm-comp::mime-insert-binary-file (file &optional encoding)
122 "Insert binary FILE at point.
123 Optional argument ENCODING specifies an encoding method such as base64."
124 (let ((tmpbuf (get-buffer-create " *MIME insert*")))
128 (let ((mc-flag nil) ;Mule
129 (file-coding-system-for-read
130 (if (featurep 'mule) *noconv*))
131 (kanji-flag nil)) ;NEmacs
132 (let (jka-compr-compression-info-list
133 jam-zcat-filename-list)
134 (insert-file-contents file))))
136 (if (and (stringp encoding)
137 (string-equal (downcase encoding) "x-uue"))
138 (let ((mime-transfer-encoders
139 (copy-alist (cons (list "x-uue" "uuencode"
140 (file-name-nondirectory file))
141 mime-transfer-encoders))))
142 (mime-insert-binary-buffer tmpbuf encoding))
143 (mime-insert-binary-buffer tmpbuf encoding))
144 (kill-buffer tmpbuf))))
146 ;; Insert the binary content after MIME tag.
147 ;; modified by MORITA Masahiro <hiro@isl.ntt.JP>
149 (defun tm-comp::mime-insert-binary-buffer (buffer &optional encoding)
150 "Insert binary BUFFER at point.
151 Optional argument ENCODING specifies an encoding method such as base64."
152 (let* ((tagend (1- (point))) ;End of the tag
153 (hide-p (and mime-auto-hide-body
155 (let ((en (downcase encoding)))
156 (or (string-equal en "base64")
157 (string-equal en "x-uue")
161 (narrow-to-region (1- (point)) (point))
162 (let ((start (point)))
163 (insert-buffer-substring buffer)
164 ;; Encode binary message if necessary.
166 (mime-encode-region encoding start (point-max))))
169 (mime-flag-region (point-min) (1- (point-max)) ?\^M)
170 (goto-char (point-max)))
172 ;; Define encoding even if it is 7bit.
173 (if (stringp encoding)
175 (goto-char tagend) ;Make sure which line the tag is on.
176 (mime-define-encoding encoding)))
180 (defun tm-comp/insert-message (&optional message)
182 (let ((inserter (assoc-value major-mode tm-comp/message-inserter-alist)))
183 (if (and inserter (fboundp inserter))
185 (mime-insert-tag "message" "rfc822")
186 (funcall inserter message)
188 (message "Sorry, I don't have message inserter for your MUA.")
195 (defun mime/split-and-send (&optional cmd)
197 (let ((mime/message-max-length
198 (or (cdr (assq major-mode mime/message-max-length-alist))
199 mime/message-default-max-length))
200 (lines (count-lines (point-min) (point-max)))
202 (if (<= lines mime/message-max-length)
204 (or cmd (cdr (assq major-mode mime/message-default-sender-alist))))
205 (let* ((mime/draft-file-name
206 (or (buffer-file-name)
207 (make-temp-name (expand-file-name "tm-draft" mime/tmp-dir))))
208 (separator mail-header-separator)
209 (config (eval (cdr (assq major-mode mime/window-config-alist))))
211 (replace-space-with-underline (current-time-string))
212 "@" (system-name) "\"")))
214 (let ((hook (cdr (assq major-mode
215 mime/message-before-send-hook-alist))))
217 (let* ((header (message/get-header-string-except
218 mime/message-nuke-headers separator))
219 (orig-header (message/get-header-string-except
220 mime/message-blind-headers separator))
221 (subject (mail-fetch-field "subject"))
222 (total (+ (/ lines mime/message-max-length)
223 (if (> (mod lines mime/message-max-length) 0)
226 (l mime/message-max-length)
227 (the-buf (current-buffer))
228 (buf (get-buffer "*tmp-send*"))
231 (cdr (assq major-mode mime/message-sender-alist))
232 (cdr (assq major-mode mime/message-default-sender-alist))))
234 (goto-char (point-min))
235 (if (re-search-forward (concat "^" (regexp-quote separator) "$")
241 (switch-to-buffer buf)
243 (switch-to-buffer the-buf)
245 (setq buf (get-buffer-create "*tmp-send*"))
247 (switch-to-buffer buf)
248 (make-variable-buffer-local 'mail-header-separator)
249 (setq mail-header-separator separator)
250 (switch-to-buffer the-buf)
251 (goto-char (point-min))
252 (re-search-forward "^$" nil t)
254 (setq buf (get-buffer "*tmp-send*"))
255 (setq data (buffer-substring
261 (switch-to-buffer buf)
264 (format "Subject: %s (%d/%d)\n" subject (+ i 1) total))
266 (format "Mime-Version: 1.0 (split by tm-comp %s)\n"
267 mime/composer-version))
270 "Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n"
271 id (+ i 1) total separator))
273 (insert orig-header))
276 (call-interactively command))
278 (switch-to-buffer the-buf)
279 (setq l (+ l mime/message-max-length))
284 (cdr (assq major-mode mime/message-after-send-hook-alist))))
286 (set-buffer-modified-p nil)
287 (cond ((y-or-n-p "Kill draft buffer? ")
288 (kill-buffer (current-buffer))
290 (set-window-configuration config))))
294 (defun tm-comp::mime-mode-exit-and-run ()
297 (call-interactively 'mime/split-and-send)
304 (add-hook 'mime-mode-hook
307 (if (not (fboundp 'original::mime-insert-binary-file))
309 (fset 'original::mime-insert-binary-file
310 (symbol-function 'mime-insert-binary-file))
311 (fset 'mime-insert-binary-file
312 'tm-comp::mime-insert-binary-file)
314 (if (not (fboundp 'original::mime-insert-binary-buffer))
316 (fset 'original::mime-insert-binary-buffer
317 (symbol-function 'mime-insert-binary-buffer))
318 (fset 'mime-insert-binary-buffer
319 'tm-comp::mime-insert-binary-buffer)
321 (if (not (fboundp 'original::mime-mode-exit-and-run))
323 (fset 'original::mime-mode-exit-and-run
324 (symbol-function 'mime-mode-exit-and-run))
325 (fset 'mime-mode-exit-and-run
326 'tm-comp::mime-mode-exit-and-run)
328 (define-key (lookup-key (current-local-map) mime-prefix)
329 "m" 'tm-comp/insert-message)
335 ;; by "OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
336 ;; Mon, 10 Apr 1995 20:03:07 +0900
338 (defvar mime/draft-header-separator-alist
339 '((news-reply-mode . mail-header-separator)
340 (mh-letter-mode . mail-header-separator)
343 (defvar mime::article/draft-header-separator nil)
345 (defun mime/draft-preview ()
347 (let ((sep (assoc-value major-mode mime/draft-header-separator-alist)))
348 (or (stringp sep) (setq sep (eval sep)))
349 (make-variable-buffer-local 'mime::article/draft-header-separator)
350 (goto-char (point-min))
352 (concat "^\\(" (regexp-quote sep) "\\)?$"))
353 (setq mime::article/draft-header-separator
354 (buffer-substring (match-beginning 0) (match-end 0)))
356 (mime/viewer-mode (current-buffer))
357 (pop-to-buffer (current-buffer))
360 (defun mime-viewer::quitting-method/draft-preview ()
361 (let ((mother mime/mother-buffer))
363 (switch-to-buffer mother)
364 (goto-char (point-min))
368 (regexp-quote mime::article/draft-header-separator)
372 (insert mime::article/draft-header-separator)
373 (set-buffer-modified-p (buffer-modified-p))
375 (mime-viewer/kill-buffer)
376 (pop-to-buffer mother)
379 (set-alist 'mime-viewer/quitting-method-alist
381 (function mime-viewer::quitting-method/draft-preview)
384 (set-alist 'mime-viewer/quitting-method-alist
386 (function mime-viewer::quitting-method/draft-preview)
393 (defun message/get-header-string-except (pat boundary)
396 (narrow-to-region (goto-char (point-min))
399 (concat "^\\(" (regexp-quote boundary) "\\)?$")
403 (goto-char (point-min))
405 (while (re-search-forward message/field-regexp nil t)
406 (setq field (buffer-substring (match-beginning 0)
409 (if (not (string-match pat field))
410 (setq header (concat header field "\n"))
415 (defun replace-space-with-underline (str)
425 (run-hooks 'tm-comp-load-hook)