tm-comp.el

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