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>
7 ;;; and MORIOKA Tomohiko
19 (defconst mime/composer-RCS-ID
20 "$Id: tm-comp.el,v 3.3 1994/12/16 12:54:23 morioka Exp $")
22 (defconst mime/composer-version (get-version-string mime/composer-RCS-ID))
28 (defvar mime/message-default-max-length 1000)
30 (defvar mime/message-max-length-alist
31 '((news-reply-mode . 500)))
33 (defconst mime/message-nuke-headers
34 "\\(^[Cc]ontent-\\|^[Ss]ubject:\\|^[Mm][Ii][Mm][Ee]-[Vv]ersion:\\)")
35 (defvar mime/message-blind-headers
36 "\\(^[BDFbdf][Cc][Cc]:\\|^[Cc][Cc]:[ \t]*$\\)")
38 (defvar mime/message-default-sender-alist
39 '((mail-mode . mail-send-and-exit)
40 (mh-letter-mode . mh-send-letter)
41 (news-reply-mode . gnus-inews-news)))
43 (defvar mime/message-sender-alist
44 '((mail-mode . (lambda ()
48 (mh-letter-mode . (lambda (&optional arg)
50 (write-region (point-min) (point-max)
53 (format "Sending %d/%d..." (+ i 1) total))
55 (pop-to-buffer "MH mail delivery")
57 (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush"
58 "-nodraftfolder" mh-send-args mime/draft-file-name)
59 (goto-char (point-max)) ; show the interesting part
63 (apply 'mh-exec-cmd-quiet t mh-send-prog
65 (list "-nopush" "-nodraftfolder" "-noverbose" "-nowatch" mh-send-args mime/draft-file-name)))))
67 (format "Sending %d/%d... done" (+ i 1) total))
69 (news-reply-mode . (lambda ()
72 (goto-char (point-min))
77 (goto-char (point-min))
78 (search-forward (concat "\n" mail-header-separator "\n"))
80 ;; Mail the message too if To: or Cc: exists.
81 (if (or (mail-fetch-field "to" nil t)
82 (mail-fetch-field "cc" nil t))
83 (if gnus-mail-send-method
86 (format "Sending (%d/%d) via mail..." (+ i 1) total))
88 (funcall gnus-mail-send-method)
90 (format "Sending (%d/%d) via mail... done" (+ i 1) total))
92 (message "No mailer defined. To: and/or Cc: fields ignored.")
95 (format "Posting %d/%d to USENET..." (+ i 1) total))
96 (if (gnus-inews-article)
98 (format "Posting %d/%d to USENET... done" (+ i 1) total))
99 ;; We cannot signal an error.
102 (format "Article %d/%d rejected: %s" (+ i 1) total (gnus-status-message)))
108 (defvar mime/window-config-alist
110 (mh-letter-mode . mh-previous-window-config)
111 (news-reply-mode . (prog1
112 gnus-winconf-post-news
113 (setq gnus-winconf-post-news nil)
117 (defvar mime/news-reply-mode-server-running nil)
119 (defvar mime/message-before-send-hook-alist
120 '((mh-letter-mode . mh-before-send-letter-hook))
121 (news-reply-mode . '(lambda ()
122 (let ((case-fold-search nil))
123 (or (boundp 'mime/news-reply-mode-server-running)
124 (make-variable-buffer-local 'mime/news-reply-mode-server-running))
125 (setq mime/news-reply-mode-server-running (gnus-server-opened))
127 (gnus-start-server-process)
129 (goto-char (point-min))
130 (run-hooks 'news-inews-hook)
135 (goto-char (point-min))
136 (search-forward (concat "\n" mail-header-separator "\n"))
139 (goto-char (point-min))
140 (if (search-forward-regexp "^Newsgroups: +" nil t)
144 (if (re-search-forward "^[^ \t]" nil 'end)
147 (goto-char (point-min))
148 (replace-regexp "\n[ \t]+" " ")
149 (goto-char (point-min))
150 (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",")
155 (defvar mime/message-after-send-hook-alist
156 '((mh-letter-mode . '(lambda ()
158 (mh-annotate-msg mh-sent-from-msg
161 "-component" mh-annotate-field
165 (mh-get-field "Cc:"))))))
166 (news-reply-mode . '(lambda ()
167 (or mime/news-reply-mode-server-running
169 (and (fboundp 'bury-buffer) (bury-buffer))))
176 ;; Insert the binary content after MIME tag.
177 ;; modified by MORITA Masahiro <hiro@isl.ntt.JP>
179 (defun tm-comp::mime-insert-binary-file (file &optional encoding)
180 "Insert binary FILE at point.
181 Optional argument ENCODING specifies an encoding method such as base64."
182 (let ((tmpbuf (get-buffer-create " *MIME insert*")))
186 (let ((mc-flag nil) ;Mule
187 (file-coding-system-for-read
188 (if (featurep 'mule) *noconv*))
189 (kanji-flag nil)) ;NEmacs
190 (insert-file-contents file)))
192 (if (string-equal (downcase encoding) "x-uue")
193 (let ((mime-transfer-encoders
194 (copy-alist (cons (list "x-uue" "uuencode"
195 (file-name-nondirectory file))
196 mime-transfer-encoders))))
197 (mime-insert-binary-buffer tmpbuf encoding))
198 (mime-insert-binary-buffer tmpbuf encoding))
199 (kill-buffer tmpbuf))))
201 ;; Insert the binary content after MIME tag.
202 ;; modified by MORITA Masahiro <hiro@isl.ntt.JP>
204 (defun tm-comp::mime-insert-binary-buffer (buffer &optional encoding)
205 "Insert binary BUFFER at point.
206 Optional argument ENCODING specifies an encoding method such as base64."
207 (let* ((tagend (1- (point))) ;End of the tag
208 (hide-p (and mime-auto-hide-body
210 (let ((en (downcase encoding)))
211 (or (string-equal en "base64")
212 (string-equal en "x-uue")
216 (narrow-to-region (1- (point)) (point))
217 (let ((start (point)))
218 (insert-buffer-substring buffer)
219 ;; Encode binary message if necessary.
221 (mime-encode-region encoding start (point-max))))
224 (mime-flag-region (point-min) (1- (point-max)) ?\^M)
225 (goto-char (point-max)))
227 ;; Define encoding even if it is 7bit.
228 (if (stringp encoding)
230 (goto-char tagend) ;Make sure which line the tag is on.
231 (mime-define-encoding encoding)))
238 (defun mime/split-and-send (&optional cmd)
240 (let ((mime/message-max-length
241 (or (cdr (assq major-mode mime/message-max-length-alist))
242 mime/message-default-max-length))
243 (lines (count-lines (point-min) (point-max)))
245 (if (<= lines mime/message-max-length)
247 (or cmd (cdr (assq major-mode mime/message-default-sender-alist))))
248 (let* ((mime/draft-file-name
249 (or (buffer-file-name)
250 (make-temp-name (expand-file-name "tm-draft" mime/tmp-dir))))
251 (separator mail-header-separator)
252 (config (eval (cdr (assq major-mode mime/window-config-alist))))
254 (replace-space-with-underline (current-time-string))
255 "@" (system-name) "\"")))
257 (let ((hook (eval (cdr (assq major-mode mime/message-before-send-hook-alist)))))
259 (let* ((header (message/get-header-string-except
260 mime/message-nuke-headers separator))
261 (orig-header (message/get-header-string-except
262 mime/message-blind-headers separator))
263 (subject (mail-fetch-field "subject"))
264 (total (+ (/ lines mime/message-max-length)
265 (if (> (mod lines mime/message-max-length) 0)
268 (l mime/message-max-length)
269 (the-buf (current-buffer))
270 (buf (get-buffer "*tmp-send*"))
273 (cdr (assq major-mode mime/message-sender-alist))
274 (cdr (assq major-mode mime/message-default-sender-alist))))
276 (goto-char (point-min))
277 (if (re-search-forward (concat "^" (regexp-quote separator) "$")
283 (switch-to-buffer buf)
285 (switch-to-buffer the-buf)
287 (setq buf (get-buffer-create "*tmp-send*"))
289 (switch-to-buffer buf)
290 (make-variable-buffer-local 'mail-header-separator)
291 (setq mail-header-separator separator)
292 (switch-to-buffer the-buf)
293 (goto-char (point-min))
294 (re-search-forward "^$" nil t)
296 (setq buf (get-buffer "*tmp-send*"))
297 (setq data (buffer-substring
303 (switch-to-buffer buf)
306 (format "Subject: %s (%d/%d)\n" subject (+ i 1) total))
308 (format "Mime-Version: 1.0\n"))
311 "Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n"
312 id (+ i 1) total separator))
314 (insert orig-header))
317 (call-interactively command))
319 (switch-to-buffer the-buf)
320 (setq l (+ l mime/message-max-length))
324 (let ((hook (eval (cdr (assq major-mode mime/message-after-send-hook-alist)))))
326 (set-buffer-modified-p nil)
327 (cond ((y-or-n-p "Kill draft buffer? ")
328 (kill-buffer (current-buffer))
330 (set-window-configuration config))))
334 (defun tm-comp::mime-mode-exit-and-run ()
337 (call-interactively 'mime/split-and-send)
344 (add-hook 'mime-mode-hook
347 (if (not (fboundp 'original::mime-insert-binary-file))
349 (fset 'original::mime-insert-binary-file
350 (symbol-function 'mime-insert-binary-file))
351 (fset 'mime-insert-binary-file
352 'tm-comp::mime-insert-binary-file)
354 (if (not (fboundp 'original::mime-insert-binary-buffer))
356 (fset 'original::mime-insert-binary-buffer
357 (symbol-function 'mime-insert-binary-buffer))
358 (fset 'mime-insert-binary-buffer
359 'tm-comp::mime-insert-binary-buffer)
361 (if (not (fboundp 'original::mime-mode-exit-and-run))
363 (fset 'original::mime-mode-exit-and-run
364 (symbol-function 'mime-mode-exit-and-run))
365 (fset 'mime-mode-exit-and-run
366 'tm-comp::mime-mode-exit-and-run)
370 (autoload 'mime/viewer-mode "tm-view" nil t)
372 (defun mime/draft-preview ()
374 (goto-char (point-min))
376 (pop-to-buffer (current-buffer)))
378 (defun message/get-header-string-except (pat boundary)
381 (narrow-to-region (goto-char (point-min))
384 (concat "^\\(" (regexp-quote boundary) "\\)?$")
388 (goto-char (point-min))
390 (while (re-search-forward message/field-regexp nil t)
391 (setq field (buffer-substring (match-beginning 0)
394 (if (not (string-match pat field))
395 (setq header (concat header field "\n"))
400 (defun replace-space-with-underline (str)