1 ;;; wl-news.el --- Create notification from NEWS(.ja) for Wanderlust.
3 ;; Copyright (C) 2002 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
4 ;; Copyright (C) 2002 Kenichi OKADA <okada@opaopa.org>
6 ;; Author: Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
7 ;; Kenichi OKADA <okada@opaopa.org>
8 ;; Keywords: mail, net news
10 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
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)
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.
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.
40 (defvar wl-news-version-file-name "previous-version")
41 (defvar wl-news-default-previous-version '(2 0 0))
44 (if (and (boundp 'current-language-environment)
45 (string-equal "Japanese"
46 (symbol-value 'current-language-environment)))
47 '("ja" "en") '("en" "ja"))
48 "The list of languages to show NEWS. (order sensitive)")
50 (defun wl-news-check ()
51 (let* ((updated (not (wl-news-already-current-p))))
55 (cdr (wl-news-previous-version-load))
57 (not (memq 'wl-news wl-hook)))
58 (add-hook 'wl-hook 'wl-news))
59 ;; update wl-news-version-file
60 (wl-news-previous-version-save
61 (product-version (product-find 'wl-version))
62 (cdr (wl-news-previous-version-load))))
68 ;;; -*- news-list-end -*-
70 (defun wl-news-previous-version-load ()
72 (let ((filename (expand-file-name
73 wl-news-version-file-name
74 elmo-msgdb-directory))
75 insert-file-contents-pre-hook
76 insert-file-contents-post-hook
78 (if (not (file-readable-p filename))
79 (cons wl-news-default-previous-version
80 wl-news-default-previous-version)
81 (insert-file-contents filename)
83 (read (current-buffer))
86 (defun wl-news-previous-version-save (current-version previous-version)
88 (let ((filename (expand-file-name
89 wl-news-version-file-name
90 elmo-msgdb-directory))
91 print-length print-level)
92 (prin1 (cons current-version previous-version) (current-buffer))
93 (princ "\n" (current-buffer))
94 (if (file-writable-p filename)
95 (write-region (point-min) (point-max)
97 (message "%s is not writable." filename)))))
99 (defun wl-news-append-news (lang previous-version &optional no-mime-tag)
101 (let ((news-list (cdr (assoc lang wl-news-news-alist)))
105 (insert "--------------\n")
106 (mime-edit-insert-tag "text" "plain" "" ""))
108 (product-version-compare
109 (car (car news-list))
112 (insert (cdr (car news-list)) "\n\n")
113 (setq news-list (cdr news-list))))
116 (defun wl-news-check-news (version news-lang)
117 (let ((lang news-lang)
120 (setq news-list (cdr (assoc (car lang) wl-news-news-alist)))
122 (product-version-compare
123 (car (car news-list)) version))
125 (setq news-list (cdr news-list)))
126 (setq lang (cdr lang)))
129 (defun wl-news-already-current-p ()
130 (>= 0 (product-version-compare
131 (product-version (product-find 'wl-version))
132 (car (wl-news-previous-version-load)))))
134 (defun wl-news-send-news (version news-lang folder)
136 (let ((lang (if (listp wl-news-lang)
138 (list wl-news-lang)))
141 (save-window-excursion
143 (setq send-buffer (wl-draft-create-buffer)))
144 (wl-draft-create-contents
145 (list (cons 'From "WL Release 'Bot <wl@lists.airs.net>")
146 (cons 'To (wl-draft-eword-encode-address-list wl-from))
147 (cons 'Subject "Wanderlust NEWS")
148 (cons 'Date (wl-make-date-string))
149 (cons 'User-Agent wl-generate-mailer-string-function)))
150 (wl-draft-insert-mail-header-separator)
151 (wl-draft-prepare-edit)
152 (goto-char (point-max))
153 (insert "\nThis message is automatically generated by Wanderlust.\n\n")
156 (wl-news-append-news (car lang) version)
157 (setq lang (cdr lang)))
159 (let ((mime-header-encode-method-alist
160 '((eword-encode-unstructured-field-body))))
161 (mime-edit-translate-buffer))
162 (wl-draft-get-header-delimiter t)
164 (and (elmo-folder-writable-p
165 (wl-folder-get-elmo-folder folder))
166 (elmo-folder-append-buffer
167 (wl-folder-get-elmo-folder folder))))
168 (wl-draft-hide send-buffer)
169 (wl-draft-delete send-buffer))
174 (defvar wl-news-buf-name "NEWS")
175 (defvar wl-news-mode-map nil)
176 (defvar wl-news-winconf nil)
177 (defvar wl-news-buffer-oldest-version nil)
178 (make-variable-buffer-local 'wl-news-buffer-oldest-version)
180 (unless wl-news-mode-map
181 (setq wl-news-mode-map (make-sparse-keymap))
182 (define-key wl-news-mode-map "q" 'wl-news-exit)
183 (define-key wl-news-mode-map "Q" 'wl-news-force-exit)
184 (define-key wl-news-mode-map "\C-xk" 'wl-news-exit)
185 (define-key wl-news-mode-map "a" 'wl-news-show-all)
186 (define-key wl-news-mode-map "m" 'wl-news-append-to-folder)
187 (define-key wl-news-mode-map "\C-m" 'wl-news-next-line)
188 (define-key wl-news-mode-map " " 'wl-news-next-page)
189 (define-key wl-news-mode-map "\177" 'wl-news-previous-page)
190 ;; re-bind commands of outline-mode
191 (define-key wl-news-mode-map "n" 'outline-next-visible-heading)
192 (define-key wl-news-mode-map "p" 'outline-previous-visible-heading)
193 (define-key wl-news-mode-map "u" 'outline-up-heading)
194 (define-key wl-news-mode-map "N" 'outline-forward-same-level)
195 (define-key wl-news-mode-map "P" 'outline-backward-same-level))
198 (define-derived-mode wl-news-mode outline-mode "NEWS"
199 "Mode for Wanderlust NEWS(.ja)."
200 (setq buffer-read-only t))
202 (defun wl-news (&optional arg)
204 (remove-hook 'wl-hook 'wl-news)
205 (let* ((previous-version (if arg wl-news-default-previous-version
206 (cdr (wl-news-previous-version-load))))
209 (if (or (get-buffer wl-news-buf-name)
210 (if (wl-news-check-news previous-version wl-news-lang)
212 (setq wl-news-winconf (current-window-configuration))
213 (set-buffer (get-buffer-create wl-news-buf-name))
215 (setq wl-news-buffer-oldest-version previous-version)
216 (buffer-disable-undo (current-buffer))
218 (let ((buffer-read-only nil))
219 (insert "--- Wanderlust NEWS --- press 'a' to show all NEWS\n")
220 (insert " press 'm' to mail this NEWS to your folder\n")
221 (insert " press 'q' to quit\n")
222 (insert " press 'Q' to force quit\n\n")
225 (car lang) previous-version t)
226 (setq lang (cdr lang))))
231 (switch-to-buffer wl-news-buf-name)
232 (delete-other-windows)
233 (goto-char (point-min))))))
235 (defun wl-news-next-line ()
239 (defun wl-news-next-page ()
243 (defun wl-news-previous-page ()
247 (defun wl-news-show-all ()
249 (when (eq major-mode 'wl-news-mode)
250 (kill-buffer (current-buffer))
253 (defun wl-news-exit ()
255 (let* ((oldest-version (cdr (wl-news-previous-version-load)))
256 (current-version (product-version (product-find 'wl-version)))
257 (new-old-version current-version)
258 (buf (get-buffer wl-news-buf-name)))
260 (if (wl-news-check-news oldest-version wl-news-lang)
261 (if (y-or-n-p "Do you want to see this message again? ")
263 (message "Please M-x wl-news if you want to see it.")
264 (setq new-old-version oldest-version))))
265 (wl-news-previous-version-save
266 current-version new-old-version)
267 (kill-buffer (current-buffer))
269 (set-window-configuration wl-news-winconf))
272 (set-window-configuration wl-news-winconf)))))
274 (defun wl-news-append-to-folder ()
276 (let* ((current-version (product-version (product-find 'wl-version)))
277 (new-old-version current-version)
278 (folder wl-default-folder))
279 (if (or (and (elmo-folder-writable-p
280 (wl-folder-get-elmo-folder folder))
282 "Do you want to append this message to %s ? "
285 (wl-summary-read-folder wl-default-folder "to append ")))
286 (or (wl-news-send-news wl-news-buffer-oldest-version wl-news-lang folder)
287 (error "Cannot append NEWS mail to %s" folder)))))
289 (defun wl-news-force-exit ()
292 (when (setq buf (get-buffer wl-news-buf-name))
293 (wl-news-previous-version-save
294 (product-version (product-find 'wl-version))
295 (cdr (wl-news-previous-version-load)))
298 (set-window-configuration wl-news-winconf)))))
302 (product-provide (provide 'wl-news) (require 'wl-version))
306 ;; no-byte-compile: t
308 ;;; wl-news.el ends here