utils/im-wl.el

   1 ;;; im-wl.el -- IM/Nifty4U+ interface for Wanderlust.  (not completed.)
   2
   3 ;; Copyright (C) 1998,1999 OKUNISHI Fujikazu <fuji0924@mbox.kyoto-inet.or.jp>
   4 ;; Copyright (C) 1998,1999 Yuuichi Teranishi <teranisi@gohome.org>
   5
   6 ;; Author: OKUNISHI Fujikazu <fuji0924@mbox.kyoto-inet.or.jp>
   7 ;;      Yuuichi Teranishi <teranisi@gohome.org>
   8 ;; Keywords: mail, news, Wanderlust, IM, Nifty4U+
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24 ;;
  25
  26 ;;; Commentary:
  27
  28 ;;  General settings:
  29 ;;  (autoload 'wl-draft-send-with-imput-async "im-wl")
  30 ;;  (setq wl-draft-send-function 'wl-draft-send-with-imput-async)
  31 ;;
  32 ;;  for Nifty4U+ users:
  33 ;;  (add-hook 'wl-mail-setup-hook '(lambda () (require 'im-wl)))
  34 ;;  (setq wl-draft-config-alist
  35 ;;         '(("^Newsgroups: nifty\\..*"
  36 ;;            ;; to avoid header-encoding.
  37 ;;            ;; [cf.  slrn-ja-0.9.4.6.jp4/doc/README.macros.euc]
  38 ;;            ;(eword-field-encoding-method-alist . '((t .  iso-2022-jp-2)))
  39 ;;            (wl-draft-send-function . 'wl-draft-send-with-imput-async)
  40 ;;            (im-wl-dispatcher . '("~/nifty4u-plus/inews-nifty4u" "-h"))
  41 ;;            (im-wl-dispatcher-error-msg
  42 ;;             . (format "^%s :" (expand-file-name (car im-wl-dispatcher)))))))
  43
  44 ;;; Code:
  45 ;;;(require 'emu)
  46
  47 ;;; Variables:
  48 (defvar im-wl-dispatcher
  49   '("imput" "-h" "-watch" "--debug=no" "-verbose" "--Queuing=yes")
  50   "Program to post an article and its arguments.
  51 This is most commonly `imput(impost)' or `inews-nifty4u'.")
  52
  53 (defvar im-wl-dispatcher-error-msg (format "^%s: ERROR:" (car im-wl-dispatcher))
  54   "Error message of dispatcher.")
  55
  56 (defvar im-wl-default-temp-file-name "~/.imput-temp"
  57   "Default temporary file name (for async).")
  58
  59 ;; xxx for Emacs18/19.x
  60 (or (boundp 'shell-command-switch)
  61     (defvar shell-command-switch "-c"))
  62
  63 ;; Buffer local variables (For async).
  64 (defvar im-wl-buffer-editing-buffer nil)
  65 (defvar im-wl-buffer-sending-buffer nil)
  66 (defvar im-wl-buffer-kill-when-done nil)
  67 (make-variable-buffer-local 'im-wl-buffer-editing-buffer)
  68 (make-variable-buffer-local 'im-wl-buffer-sending-buffer)
  69 (make-variable-buffer-local 'im-wl-buffer-kill-when-done)
  70
  71 \f
  72 ;;;###autoload
  73 (defun wl-draft-send-with-imput-async (editing-buffer kill-when-done)
  74   "Send the message in the current buffer with imput asynchronously."
  75   (let (buffer-process process-connection-type watch-buffer
  76         (sending-buffer (current-buffer))
  77         (error-msg-regexp im-wl-dispatcher-error-msg)
  78         (number wl-draft-buffer-message-number)
  79         msg)
  80     (with-current-buffer editing-buffer
  81       (if (elmo-message-file-p
  82            (wl-folder-get-elmo-folder wl-draft-folder)
  83            number)
  84           (setq msg
  85                 (elmo-message-file-name
  86                  (wl-folder-get-elmo-folder wl-draft-folder)
  87                  number))
  88         (with-temp-file (setq msg (make-temp-file "im-wl"))
  89           (elmo-message-fetch (wl-folder-get-elmo-folder wl-draft-folder)
  90                               number (elmo-make-fetch-strategy 'entire)
  91                               nil (current-buffer)))))
  92     ;; current buffer is raw buffer.
  93     (save-excursion
  94       (goto-char (point-max))
  95       ;; require one newline at the end.
  96       (or (= (preceding-char) ?\n)
  97           (insert ?\n))
  98       ;; Change header-delimiter to be what imput expects.
  99       (let (delimline
 100             (case-fold-search t))
 101         (save-restriction
 102           (std11-narrow-to-header mail-header-separator)
 103           ;; Insert Message-ID: 'cause wl-do-fcc() does not take care..
 104           (goto-char (point-min))
 105           (when (and wl-insert-message-id
 106                      (not (re-search-forward "^Message-ID[ \t]*:" nil t)))
 107             (insert (concat "Message-ID: "
 108                             (funcall wl-message-id-function) "\n")))
 109           ;; Insert date field.
 110           (goto-char (point-min))
 111           (or (re-search-forward "^Date[ \t]*:" nil t)
 112               (wl-draft-insert-date-field)))
 113         (run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
 114         (goto-char (point-min))
 115         (re-search-forward
 116          (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
 117         (replace-match "\n")
 118         (forward-char -1)
 119         (setq delimline (point-marker))
 120         ;; ignore any blank lines in the header
 121         (goto-char (point-min))
 122         (while (and (re-search-forward "\n\n\n*" delimline t)
 123                     (< (point) delimline))
 124           (replace-match "\n"))
 125         ;; Find and handle any FCC fields.
 126         ;; 'cause imput can NOT handle `Fcc: %IMAP'.
 127         (goto-char (point-min))
 128         (if (re-search-forward "^FCC:" delimline t)
 129             (wl-draft-do-fcc delimline))))
 130     (set-buffer-modified-p t)
 131     (as-binary-output-file
 132      (write-region (point-min)(point-max) msg nil t))
 133     ;; The local variables must be binded to 'watch-buffer.
 134     (set-buffer (setq watch-buffer (generate-new-buffer " *Wl Watch*")))
 135     (setq im-wl-buffer-sending-buffer sending-buffer)
 136     (setq im-wl-buffer-editing-buffer editing-buffer)
 137     (setq im-wl-buffer-kill-when-done kill-when-done)
 138     (setq im-wl-dispatcher-error-msg error-msg-regexp)
 139     ;; Variables specified in wl-draft-config-alist are buffer-local, so
 140     ;; we have to run subprocess under the editing-buffer.
 141     ;; The filter function can find 'watch-buffer by process-buffer().
 142     (set-buffer sending-buffer)
 143     (setq buffer-process
 144           ;; start-process-shell-command() is Emacs19/20's function.
 145           (start-process
 146            "DISPATCHER" watch-buffer
 147            shell-file-name shell-command-switch
 148            (format "%s < %s"
 149                    (mapconcat 'identity im-wl-dispatcher " ") msg)))
 150     (set-process-sentinel buffer-process 'im-wl-watch-process-async)
 151     (message "Sending a message in background")
 152     (if kill-when-done
 153         (wl-draft-hide editing-buffer))))
 154
 155 (defun im-wl-watch-process-async (process event)
 156   (let ((process-buffer (process-buffer process))
 157         editing-buffer kill-when-done raw-buffer)
 158     (set-buffer process-buffer)
 159     (setq editing-buffer im-wl-buffer-editing-buffer)
 160     (setq kill-when-done im-wl-buffer-kill-when-done)
 161     (setq raw-buffer im-wl-buffer-sending-buffer)
 162     (goto-char (point-min))
 163     (if (null (re-search-forward im-wl-dispatcher-error-msg nil t))
 164         (progn
 165           ;; sent successfully.
 166           (kill-buffer raw-buffer)
 167           (kill-buffer process-buffer)
 168           (if kill-when-done
 169               (wl-draft-delete editing-buffer)))
 170       (ding)
 171       (message "Send failed")
 172       (kill-buffer raw-buffer)
 173       (switch-to-buffer editing-buffer)
 174       (condition-case ()
 175           (progn
 176             (split-window-vertically)
 177             (select-window (next-window)))
 178         (error)) ; ignore error.
 179       (switch-to-buffer process-buffer)
 180       (beginning-of-line))))
 181
 182 (provide 'im-wl)
 183
 184 ;;; im-wl.el ends here