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 (require 'wl-mime)
  41
  42 (defvar wl-news-version-file-name "previous-version")
  43 (defvar wl-news-default-previous-version '(2 0 0))
  44
  45 (defun wl-news-check ()
  46   (let ((previous-version (wl-news-previous-version-load))
  47         (current-version (product-version (product-find 'wl-version))))
  48     (if (and (< 0 (product-version-compare
  49                    current-version previous-version))
  50              wl-news-lang
  51              (wl-news-send-news previous-version))
  52         (wl-news-previous-version-save current-version))))
  53
  54
  55 ;;; -*- news-list -*-
  56
  57
  58 ;;; -*- news-list-end -*-
  59
  60 (defun wl-news-previous-version-load ()
  61   (save-excursion
  62     (let ((filename (expand-file-name
  63                      wl-news-version-file-name
  64                      elmo-msgdb-directory))
  65           (tmp-buffer (get-buffer-create " *wl-news-version-tmp*"))
  66           insert-file-contents-pre-hook
  67           insert-file-contents-post-hook
  68           ret-val)
  69       (if (not (file-readable-p filename))
  70           wl-news-default-previous-version
  71         (set-buffer tmp-buffer)
  72         (insert-file-contents filename)
  73         (setq ret-val
  74               (condition-case nil
  75                   (read (current-buffer))
  76                 (error nil nil)))
  77         (kill-buffer tmp-buffer)
  78         ret-val))))
  79
  80 (defun wl-news-previous-version-save (version)
  81   (save-excursion
  82     (let ((filename (expand-file-name
  83                      wl-news-version-file-name
  84                      elmo-msgdb-directory))
  85           (tmp-buffer (get-buffer-create " *wl-news-version-tmp*")))
  86       (set-buffer tmp-buffer)
  87       (erase-buffer)
  88       (prin1 version tmp-buffer)
  89       (princ "\n" tmp-buffer)
  90       (if (file-writable-p filename)
  91           (write-region (point-min) (point-max)
  92                         filename nil 'no-msg)
  93         (message "%s is not writable." filename))
  94       (kill-buffer tmp-buffer))))
  95
  96 (defun wl-news-append-news (lang previous-version)
  97   (let* ((news-list (cdr (assoc lang wl-news-news-alist))))
  98     (mime-edit-insert-tag "text" "plain" "" "")
  99     (while (< 0
 100               (product-version-compare
 101                (car (car news-list))
 102                previous-version))
 103       (insert (cdr (car news-list)) "\n\n")
 104       (setq news-list (cdr news-list)))))
 105
 106 (defun wl-news-send-news (previous-version)
 107   (let ((lang (if (listp wl-news-lang)
 108                   wl-news-lang
 109                 (list wl-news-lang))))
 110     (save-window-excursion
 111       (wl-draft-create-buffer)
 112       (wl-draft-create-contents
 113            (list (cons 'From "WL Release 'Bot <wl@lists.airs.net>")
 114                  (cons 'To (wl-draft-eword-encode-address-list wl-from) )
 115                  (cons 'Subject "Wanderlust NEWS")
 116                  (cons 'User-Agent wl-generate-mailer-string-function)
 117                  (cons 'Organization wl-organization)
 118                  (and wl-auto-insert-x-face
 119                       (file-exists-p wl-x-face-file)
 120                       'wl-draft-insert-x-face-field-here)))
 121       (wl-draft-insert-mail-header-separator)
 122       (wl-draft-prepare-edit)
 123       (goto-char (point-max))
 124       (while (car lang)
 125         (wl-news-append-news
 126          (car lang) previous-version)
 127         (setq lang (cdr lang)))
 128       (let (wl-interactive-send)
 129         (wl-draft-send 'kill-when-done)))))
 130
 131 (require 'product)
 132 (product-provide (provide 'wl-news) (require 'wl-version))
 133
 134 ;;; wl-news.el ends here