wl/wl-news.el.in

   1 ;;; wl-news.el --- Create notification from NEWS(.ja) for Wanderlust.
   2
   3 ;; Copyright (C) 2002 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
   4 ;; Copyright (C) 2002 Kenichi OKADA <okada@opaopa.org>
   5
   6 ;; Author: Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
   7 ;;      Kenichi OKADA <okada@opaopa.org>
   8 ;; Keywords: mail, net news
   9
  10 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
  11
  12 ;; This program is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16 ;;
  17 ;; This program is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21 ;;
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26 ;;
  27
  28 ;;; Commentary:
  29 ;;
  30
  31 ;;; Code:
  32 ;;
  33
  34 (require 'elmo)
  35 (require 'wl-vars)
  36 (require 'wl-util)
  37 (require 'wl-address)
  38 (require 'wl-draft)
  39 (require 'wl-folder)
  40
  41 (defvar wl-news-version-file-name "previous-version")
  42 (defvar wl-news-default-previous-version '(2 0 0))
  43
  44 (defun wl-news-check ()
  45   (let ((previous-version (wl-news-previous-version-load))
  46         (current-version (product-version (product-find 'wl-version))))
  47     (if (and (< 0 (product-version-compare
  48                    current-version previous-version))
  49              (wl-news-append-news-to-folder previous-version))
  50         (wl-news-previous-version-save current-version))))
  51
  52
  53 ;;; -*- news-list -*-
  54
  55
  56 ;;; -*- news-list-end -*-
  57
  58 (defun wl-news-previous-version-load ()
  59   (save-excursion
  60     (let ((filename (expand-file-name
  61                      wl-news-version-file-name
  62                      elmo-msgdb-directory))
  63           (tmp-buffer (get-buffer-create " *wl-news-version-tmp*"))
  64           insert-file-contents-pre-hook
  65           insert-file-contents-post-hook
  66           ret-val)
  67       (if (not (file-readable-p filename))
  68           wl-news-default-previous-version
  69         (set-buffer tmp-buffer)
  70         (insert-file-contents filename)
  71         (setq ret-val
  72               (condition-case nil
  73                   (read (current-buffer))
  74                 (error nil nil)))
  75         (kill-buffer tmp-buffer)
  76         ret-val))))
  77
  78 (defun wl-news-previous-version-save (version)
  79   (save-excursion
  80     (let ((filename (expand-file-name
  81                      wl-news-version-file-name
  82                      elmo-msgdb-directory))
  83           (tmp-buffer (get-buffer-create " *wl-news-version-tmp*")))
  84       (set-buffer tmp-buffer)
  85       (erase-buffer)
  86       (prin1 version tmp-buffer)
  87       (princ "\n" tmp-buffer)
  88       (if (file-writable-p filename)
  89           (write-region (point-min) (point-max)
  90                         filename nil 'no-msg)
  91         (message "%s is not writable." filename))
  92       (kill-buffer tmp-buffer))))
  93
  94 (defun wl-news-append-news-to-folder (previous-version)
  95   (let ((news-list wl-news-news-alist)
  96         (news-list-ja wl-news-news-ja-alist))
  97     (with-temp-buffer
  98       (insert "Subject: Wanderlust NEWS\n"
  99               "From: \"WL Release 'Bot\"\n"
 100               "To: " (wl-address-header-extract-address wl-from) "\n"
 101               "Date: " (wl-make-date-string) "\n"
 102               "Message-ID: " (funcall wl-message-id-function) "\n"
 103               "Content-Type: multipart/mixed;\n\tboundary=Multipart\n\n"
 104               "--Multipart\n"
 105               "Content-Type: text/plain\n\n")
 106       (while (< 0
 107                 (product-version-compare
 108                  (car (car news-list))
 109                  previous-version))
 110         (insert (cdr (car news-list)) "\n\n")
 111         (setq news-list (cdr news-list)))
 112       (insert "--Multipart\n")
 113       (insert "Content-Type: text/plain; charset=ISO-2022-JP\n\n")
 114       (while (< 0
 115                 (product-version-compare
 116                  (car (car news-list-ja))
 117                  previous-version))
 118         (insert (cdr (car news-list-ja)) "\n\n")
 119         (setq news-list-ja (cdr news-list-ja)))
 120       (encode-coding-region (point-min) (point-max) 'iso-2022-7bit)
 121       (if (elmo-folder-writable-p (wl-folder-get-elmo-folder wl-draft-folder))
 122           (elmo-folder-append-buffer
 123            (wl-folder-get-elmo-folder wl-default-folder) t)))))
 124
 125 (require 'product)
 126 (product-provide (provide 'wl-news) (require 'wl-version))
 127
 128 ;;; wl-news.el ends here