tm-comp.el

   1 ;;;
   2 ;;; $Id: tm-comp.el,v 1.2 1994/09/26 12:37:03 morioka Exp $
   3 ;;;
   4
   5 (provide 'tm-comp)
   6 (require 'tl-header)
   7 (require 'mail-utils)
   8
   9 (defvar mime/tmp-dir (or (getenv "TM_TMPDIR") "/tmp/"))
  10
  11 (defvar mime/message-max-length 1000)
  12 (defvar mime/message-sender-alist
  13   '((mail-mode . sendmail-send-it)
  14     (mh-letter-mode . (lambda ()
  15                         (write-region (point-min) (point-max)
  16                                       mime/draft-file-name)
  17                         (call-process
  18                          (expand-file-name mh-send-prog mh-progs)
  19                          nil nil nil mime/draft-file-name)
  20                         ))
  21     (news-reply-mode . gnus-inews-article)
  22     ))
  23 (defvar mime/window-config-alist
  24   '((mail-mode       . nil)
  25     (mh-letter-mode  . mh-previous-window-config)
  26     (news-reply-mode . (prog1
  27                            gnus-winconf-post-news
  28                          (setq gnus-winconf-post-news nil)
  29                          ))
  30     ))
  31
  32 (defun mime/split-and-send (&optional cmd)
  33   (interactive)
  34   (if (null cmd)
  35       (setq cmd (cdr (assq major-mode mime/message-sender-alist)))
  36     )
  37   (let ((mime/draft-file-name (buffer-file-name))
  38         (lines (count-lines (point-min)(point-max)))
  39         (separator mail-header-separator)
  40         (config (eval (cdr (assq major-mode mime/window-config-alist))))
  41         )
  42     (if (null mime/draft-file-name)
  43         (setq mime/draft-file-name
  44               (make-temp-name (expand-file-name "tm-draft" mime/tmp-dir)))
  45       )
  46     (if (and (boundp 'mime-mode-flag) mime-mode-flag)
  47         (mime-mode-exit))
  48     (if (<= lines mime/message-max-length)
  49         (funcall cmd)
  50       (let ((header (message/get-header-string-except
  51                      "\\(^[Cc]ontent-\\|^[Ss]ubject:\\)" separator))
  52             (subject (mail-fetch-field "subject"))
  53             (id (concat "\""
  54                         (replace-space-with-underline (current-time-string))
  55                         "@" (system-name) "\""))
  56             )
  57         (goto-char (point-min))
  58         (if (re-search-forward (concat "^" (regexp-quote separator) "$")
  59                                nil t)
  60             (replace-match "")
  61           )
  62         (let* ((total (+ (/ lines mime/message-max-length)
  63                          (if (> (mod lines mime/message-max-length) 0)
  64                              1)))
  65                (i 0)(l mime/message-max-length)
  66                (the-buf (current-buffer))
  67                (buf (get-buffer "*tmp-send*"))
  68                data)
  69           (if buf
  70               (progn
  71                 (switch-to-buffer buf)
  72                 (erase-buffer)
  73                 (switch-to-buffer the-buf)
  74                 )
  75             (setq buf (get-buffer-create "*tmp-send*"))
  76             )
  77           (switch-to-buffer buf)
  78           (make-variable-buffer-local 'mail-header-separator)
  79           (setq mail-header-separator separator)
  80           (switch-to-buffer the-buf)
  81           (goto-char (point-min))
  82           (while (< i total)
  83             (setq buf (get-buffer "*tmp-send*"))
  84
  85             (setq data (buffer-substring
  86                         (point)
  87                         (progn
  88                           (goto-line l)
  89                           (point))
  90                         ))
  91             (switch-to-buffer buf)
  92             (insert header)
  93             (insert
  94              (format "Subject: %s (%d/%d)\n" subject (+ i 1) total))
  95             (insert
  96              (format
  97               "Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n"
  98               id (+ i 1) total separator))
  99             (insert data)
 100             (funcall cmd)
 101             (erase-buffer)
 102             (switch-to-buffer the-buf)
 103             (setq l (+ l mime/message-max-length))
 104             (setq i (+ i 1))
 105             )
 106           )))
 107     (set-buffer-modified-p nil)
 108     (kill-buffer (current-buffer))
 109     (if config
 110         (set-window-configuration config)
 111       )
 112     ))
 113
 114 (add-hook 'mime-mode-hook
 115           (function
 116            (lambda ()
 117              (if (not (fboundp 'default-mime-mode-exit-and-run))
 118                  (progn
 119                    (make-variable-buffer-local 'mime/send-message-method)
 120                    (fset 'default-mime-mode-exit-and-run
 121                          'mime-mode-exit-and-run)
 122                    (fset 'mime-mode-exit-and-run
 123                          'mime/split-and-send)
 124                    )))))
 125
 126 (defun message/get-header-string-except (pat boundary)
 127   (save-excursion
 128     (save-restriction
 129       (narrow-to-region (goto-char (point-min))
 130                         (progn
 131                           (re-search-forward
 132                            (concat "^\\(" (regexp-quote boundary) "\\)?$")
 133                            nil t)
 134                           (match-beginning 0)
 135                           ))
 136       (goto-char (point-min))
 137       (let (field header)
 138         (while (re-search-forward message/field-regexp nil t)
 139           (setq field (buffer-substring (match-beginning 0)
 140                                         (match-end 0)
 141                                         ))
 142           (if (not (string-match pat field))
 143               (setq header (concat header field "\n"))
 144             ))
 145         header)
 146       )))
 147
 148 (defun replace-space-with-underline (str)
 149   (mapconcat (function
 150               (lambda (arg)
 151                 (char-to-string
 152                  (if (= arg 32)
 153                      ?_
 154                    arg)))) str "")
 155   )