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-func '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-func . '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         (msg (save-excursion
  79                (set-buffer editing-buffer)
  80                (or wl-draft-buffer-file-name
  81                    (setq wl-draft-buffer-file-name
  82                          (expand-file-name
  83                           im-wl-default-temp-file-name))))))
  84     ;; current buffer is raw buffer.
  85     (save-excursion
  86       (goto-char (point-max))
  87       ;; require one newline at the end.
  88       (or (= (preceding-char) ?\n)
  89           (insert ?\n))
  90       ;; Change header-delimiter to be what imput expects.
  91       (let (delimline
  92             (case-fold-search t))
  93         (save-restriction
  94           (std11-narrow-to-header mail-header-separator)
  95           ;; Insert Message-ID: 'cause wl-do-fcc() does not take care..
  96           (goto-char (point-min))
  97           (when (and wl-insert-message-id
  98                      (not (re-search-forward "^Message-ID[ \t]*:" nil t)))
  99             (insert (concat "Message-ID: "
 100                             (wl-draft-make-message-id-string) "\n")))
 101           ;; Insert date field.
 102           (goto-char (point-min))
 103           (or (re-search-forward "^Date[ \t]*:" nil t)
 104               (wl-draft-insert-date-field)))
 105         (run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
 106         (goto-char (point-min))
 107         (re-search-forward
 108          (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
 109         (replace-match "\n")
 110         (forward-char -1)
 111         (setq delimline (point-marker))
 112         ;; ignore any blank lines in the header
 113         (goto-char (point-min))
 114         (while (and (re-search-forward "\n\n\n*" delimline t)
 115                     (< (point) delimline))
 116           (replace-match "\n"))
 117         ;; Find and handle any FCC fields.
 118         ;; 'cause imput can NOT handle `Fcc: %IMAP'.
 119         (goto-char (point-min))
 120         (if (re-search-forward "^FCC:" delimline t)
 121             (wl-draft-do-fcc delimline))))
 122     (set-buffer-modified-p t)
 123     (as-binary-output-file
 124      (write-region (point-min)(point-max) msg nil t))
 125     ;; The local variables must be binded to 'watch-buffer.
 126     (set-buffer (setq watch-buffer (generate-new-buffer " *Wl Watch*")))
 127     (setq im-wl-buffer-sending-buffer sending-buffer)
 128     (setq im-wl-buffer-editing-buffer editing-buffer)
 129     (setq im-wl-buffer-kill-when-done kill-when-done)
 130     (setq im-wl-dispatcher-error-msg error-msg-regexp)
 131     ;; Variables specified in wl-draft-config-alist are buffer-local, so
 132     ;; we have to run subprocess under the editing-buffer.
 133     ;; The filter function can find 'watch-buffer by process-buffer().
 134     (set-buffer sending-buffer)
 135     (setq buffer-process
 136           ;; start-process-shell-command() is Emacs19/20's function.
 137           (start-process
 138            "DISPATCHER" watch-buffer
 139            shell-file-name shell-command-switch
 140            (format "%s < %s"
 141                    (mapconcat 'identity im-wl-dispatcher " ") msg)))
 142     (set-process-sentinel buffer-process 'im-wl-watch-process-async)
 143     (message "Sending a message in background")
 144     (if kill-when-done
 145         (wl-draft-hide editing-buffer))))
 146
 147 (defun im-wl-watch-process-async (process event)
 148   (let ((process-buffer (process-buffer process))
 149         editing-buffer kill-when-done raw-buffer)
 150     (set-buffer process-buffer)
 151     (setq editing-buffer im-wl-buffer-editing-buffer)
 152     (setq kill-when-done im-wl-buffer-kill-when-done)
 153     (setq raw-buffer im-wl-buffer-sending-buffer)
 154     (goto-char (point-min))
 155     (if (null (re-search-forward im-wl-dispatcher-error-msg nil t))
 156         (progn
 157           ;; sent successfully.
 158           (kill-buffer raw-buffer)
 159           (kill-buffer process-buffer)
 160           (if kill-when-done
 161               (wl-draft-delete editing-buffer)))
 162       (ding)
 163       (message "Send failed")
 164       (kill-buffer raw-buffer)
 165       (switch-to-buffer editing-buffer)
 166       (condition-case ()
 167           (progn
 168             (split-window-vertically)
 169             (select-window (next-window)))
 170         (error)) ; ignore error.
 171       (switch-to-buffer process-buffer)
 172       (beginning-of-line))))
 173
 174 (provide 'im-wl)
 175
 176 ;;; im-wl.el ends here