mixi-gnus.el

   1 ;;; mixi-gnus.el --- Gnus integration for mixi
   2
   3 ;; Copyright (C) 2007 OHASHI Akira
   4
   5 ;; Author: OHASHI Akira <bg66@koka-in.org>
   6 ;; Keywords: news
   7
   8 ;; This file is *NOT* a part of Gnus.
   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 this program; if not, you can either send email to this
  22 ;; program's maintainer or write to: The Free Software Foundation,
  23 ;; Inc.; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; To use, add the following lines to your ~/.emacs:
  28 ;;
  29 ;; (autoload 'mixi-gnus-setup "mixi-gnus")
  30 ;; (add-hook 'gnus-startup-hook 'mixi-gnus-setup)
  31
  32 ;; If you have bug reports and/or suggestions for improvement, please
  33 ;; send them via <URL:http://mixi.jp/view_community.pl?id=1596390>.
  34
  35 ;;; Code:
  36
  37 (require 'sb-mixi)
  38
  39 ;; Functions and variables which should be defined in the other module
  40 ;; at run-time.
  41 (eval-when-compile
  42   (defvar message-this-is-news)
  43   (defvar message-sent-message-via)
  44   (defvar message-send-method-alist)
  45   (autoload 'message-narrow-to-headers "message")
  46   (autoload 'message-fetch-field "message")
  47   (autoload 'message-generate-new-buffer-clone-locals "message")
  48   (autoload 'message-goto-body "message")
  49   (autoload 'mml-buffer-substring-no-properties-except-hard-newlines "mml"))
  50
  51 (defun message-mixi-p ()
  52   "Say whether the current buffer contains a mixi message."
  53   (and (not message-this-is-news)
  54        (save-excursion
  55          (save-restriction
  56            (message-narrow-to-headers)
  57            (or (message-fetch-field "mixi-to")
  58                (string-match shimbun-mixi-to-regexp
  59                              (message-fetch-field "to")))))))
  60
  61 (defun message-send-via-mixi (arg)
  62   "Send the current message via mixi."
  63   (let* ((tembuf (message-generate-new-buffer-clone-locals " message temp"))
  64          (case-fold-search nil)
  65          (mailbuf (current-buffer)))
  66     ;; Avoid matching with message-mail-p.
  67     (with-current-buffer mailbuf
  68       (goto-char (point-min))
  69       (unless (search-forward "\nMixi-To: " nil t)
  70         (when (search-forward "\nTo: " nil t)
  71           (replace-match "\nMixi-To: "))))
  72     (unwind-protect
  73         (save-excursion
  74           (set-buffer tembuf)
  75           (erase-buffer)
  76           ;; Avoid copying text props (except hard newlines).
  77           (insert (with-current-buffer mailbuf
  78                     (mml-buffer-substring-no-properties-except-hard-newlines
  79                      (point-min) (point-max))))
  80           (shimbun-mixi-send-mail (message-fetch-field "mixi-to")
  81                                   (message-fetch-field "subject")
  82                                   (buffer-substring (message-goto-body)
  83                                                     (point-max))))
  84       (kill-buffer tembuf))
  85     (set-buffer mailbuf)
  86     (push 'mixi message-sent-message-via)))
  87
  88 (defun mixi-gnus-setup ()
  89   (let ((method '(mixi message-mixi-p message-send-via-mixi)))
  90     (unless (member method message-send-method-alist)
  91       (setq message-send-method-alist
  92             (cons method message-send-method-alist)))))
  93
  94 (provide 'mixi-gnus)
  95
  96 ;;; mixi-gnus.el ends here