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-folder)
  39
  40 (defvar wl-news-version-file-name "previous-version")
  41 (defvar wl-news-default-previous-version '(2 0 0))
  42
  43 (defvar wl-news-send-to-address nil
  44   "*The recipient address to send NEWS.")
  45
  46 (defun wl-news-check ()
  47   (let* ((previous-version (wl-news-previous-version-load))
  48          (current-version (product-version (product-find 'wl-version)))
  49          (updated (< 0 (product-version-compare
  50                         current-version previous-version))))
  51     (when updated
  52       (and wl-news-lang
  53            wl-news-send-to-address
  54            (wl-news-send-news previous-version))
  55       (wl-news-previous-version-save current-version))
  56     updated))
  57
  58 ;;; -*- news-list -*-
  59
  60
  61 ;;; -*- news-list-end -*-
  62
  63 (defun wl-news-previous-version-load ()
  64   (save-excursion
  65     (let ((filename (expand-file-name
  66                      wl-news-version-file-name
  67                      elmo-msgdb-directory))
  68           (tmp-buffer (get-buffer-create " *wl-news-version-tmp*"))
  69           insert-file-contents-pre-hook
  70           insert-file-contents-post-hook
  71           ret-val)
  72       (if (not (file-readable-p filename))
  73           wl-news-default-previous-version
  74         (set-buffer tmp-buffer)
  75         (insert-file-contents filename)
  76         (setq ret-val
  77               (condition-case nil
  78                   (read (current-buffer))
  79                 (error nil nil)))
  80         (kill-buffer tmp-buffer)
  81         ret-val))))
  82
  83 (defun wl-news-previous-version-save (version)
  84   (save-excursion
  85     (let ((filename (expand-file-name
  86                      wl-news-version-file-name
  87                      elmo-msgdb-directory))
  88           (tmp-buffer (get-buffer-create " *wl-news-version-tmp*")))
  89       (set-buffer tmp-buffer)
  90       (erase-buffer)
  91       (prin1 version tmp-buffer)
  92       (princ "\n" tmp-buffer)
  93       (if (file-writable-p filename)
  94           (write-region (point-min) (point-max)
  95                         filename nil 'no-msg)
  96         (message "%s is not writable." filename))
  97       (kill-buffer tmp-buffer))))
  98
  99 (defun wl-news-append-news (lang previous-version &optional no-mime-tag)
 100   (require 'wl-mime)
 101   (let* ((news-list (cdr (assoc lang wl-news-news-alist))))
 102     (if no-mime-tag
 103         (insert "\n")
 104       (mime-edit-insert-tag "text" "plain" "" ""))
 105     (while (< 0
 106               (product-version-compare
 107                (car (car news-list))
 108                previous-version))
 109       (insert (cdr (car news-list)) "\n\n")
 110       (setq news-list (cdr news-list)))))
 111
 112 (defun wl-news-send-news (previous-version)
 113   (require 'wl-draft)
 114   (let ((lang (if (listp wl-news-lang)
 115                   wl-news-lang
 116                 (list wl-news-lang)))
 117         wl-fcc wl-bcc)
 118     (save-window-excursion
 119       (wl-draft-create-buffer)
 120       (wl-draft-create-contents
 121            (list (cons 'From "WL Release 'Bot <wl@lists.airs.net>")
 122                  (cons 'To (wl-draft-eword-encode-address-list
 123                             wl-news-send-to-address))
 124                  (cons 'Subject "Wanderlust NEWS")
 125                  (cons 'Date (wl-make-date-string))
 126                  (cons 'User-Agent wl-generate-mailer-string-function)))
 127       (wl-draft-insert-mail-header-separator)
 128       (wl-draft-prepare-edit)
 129       (goto-char (point-max))
 130       (insert "\nThis message is automatically generated by Wanderlust.\n\n")
 131       ;; insert news
 132       (while (car lang)
 133         (wl-news-append-news
 134          (car lang) previous-version)
 135         (setq lang (cdr lang)))
 136       ;; send
 137       (let (wl-interactive-send)
 138         (wl-draft-send 'kill-when-done)))))
 139
 140 ;;; wl-news-mode
 141
 142 (defvar wl-news-buf-name "NEWS")
 143 (defvar wl-news-mode-map nil)
 144 (defvar wl-news-winconf nil)
 145
 146 (unless wl-news-mode-map
 147   (setq wl-news-mode-map (make-sparse-keymap))
 148   (define-key wl-news-mode-map "q"    'wl-news-exit)
 149   (define-key wl-news-mode-map "\C-m" 'wl-news-next-line)
 150   (define-key wl-news-mode-map " "    'wl-news-next-page))
 151
 152 (defun wl-news-mode ()
 153   "Mode for Wanderlust NEWS(.ja)."
 154   (interactive)
 155   (kill-all-local-variables)
 156   (use-local-map wl-news-mode-map)
 157   (setq major-mode 'wl-news-mode)
 158   (setq mode-name "NEWS")
 159   (setq buffer-read-only t))
 160
 161 (defun wl-news ()
 162   (interactive)
 163   (setq wl-news-winconf (current-window-configuration))
 164   (let* ((previous-version (wl-news-previous-version-load))
 165          (lang wl-news-lang)
 166          window-lines lines)
 167     (set-buffer (get-buffer-create wl-news-buf-name))
 168     (wl-news-mode)
 169     (buffer-disable-undo (current-buffer))
 170     ;; insert news
 171     (let ((buffer-read-only nil))
 172       (insert "--- Wanderlust NEWS ---  press 'q' for exit\n\n")
 173       (while (car lang)
 174         (wl-news-append-news
 175          (car lang) previous-version t)
 176         (setq lang (cdr lang))))
 177     (switch-to-buffer wl-news-buf-name)
 178     (delete-other-windows)
 179     (goto-char (point-min))))
 180
 181 (defun wl-news-next-line ()
 182   (interactive)
 183   (scroll-up 1))
 184
 185 (defun wl-news-next-page ()
 186   (interactive)
 187   (scroll-up))
 188
 189 (defun wl-news-exit ()
 190   (interactive)
 191   (kill-buffer (current-buffer))
 192   (if wl-news-winconf
 193       (set-window-configuration wl-news-winconf)))
 194
 195 (require 'product)
 196 (product-provide (provide 'wl-news) (require 'wl-version))
 197
 198 ;;; wl-news.el ends here