utils/im-wl.el

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