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-lang 44 (if (string-equal "Japanese" 45 (symbol-value 'current-language-environment)) 46 '("ja" "en") '("en" "ja")) 47 "The list of languages to show NEWS. (order sensitive)") 48 49(defun wl-news-check () 50 (let* ((updated (not (wl-news-already-current-p)))) 51 (if updated 52 (if (and wl-news-lang 53 (wl-news-check-news 54 (cdr (wl-news-previous-version-load)) 55 wl-news-lang) 56 (not (memq 'wl-news wl-hook))) 57 (add-hook 'wl-hook 'wl-news)) 58 ;; update wl-news-version-file 59 (wl-news-previous-version-save 60 (product-version (product-find 'wl-version)) 61 (cdr (wl-news-previous-version-load)))) 62 updated)) 63 64;;; -*- news-list -*- 65 66 67;;; -*- news-list-end -*- 68 69(defun wl-news-previous-version-load () 70 (with-temp-buffer 71 (let ((filename (expand-file-name 72 wl-news-version-file-name 73 elmo-msgdb-directory)) 74 insert-file-contents-pre-hook 75 insert-file-contents-post-hook 76 ret-val) 77 (if (not (file-readable-p filename)) 78 (cons wl-news-default-previous-version 79 wl-news-default-previous-version) 80 (insert-file-contents filename) 81 (condition-case nil 82 (read (current-buffer)) 83 (error nil nil)))))) 84 85(defun wl-news-previous-version-save (current-version previous-version) 86 (with-temp-buffer 87 (let ((filename (expand-file-name 88 wl-news-version-file-name 89 elmo-msgdb-directory)) 90 print-length print-level) 91 (prin1 (cons current-version previous-version) (current-buffer)) 92 (princ "\n" (current-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 98(defun wl-news-append-news (lang previous-version &optional no-mime-tag) 99 (require 'wl-mime) 100 (let ((news-list (cdr (assoc lang wl-news-news-alist))) 101 ret) 102 (when news-list 103 (if no-mime-tag 104 (insert "--------------\n") 105 (mime-edit-insert-tag "text" "plain" "" "")) 106 (while (< 0 107 (product-version-compare 108 (car (car news-list)) 109 previous-version)) 110 (setq ret t) 111 (insert (cdr (car news-list)) "\n\n") 112 (setq news-list (cdr news-list)))) 113 ret)) 114 115(defun wl-news-check-news (version news-lang) 116 (let ((lang news-lang) 117 news-list ret) 118 (while (car lang) 119 (setq news-list (cdr (assoc (car lang) wl-news-news-alist))) 120 (while (< 0 121 (product-version-compare 122 (car (car news-list)) version)) 123 (setq ret t) 124 (setq news-list (cdr news-list))) 125 (setq lang (cdr lang))) 126 ret)) 127 128(defun wl-news-already-current-p () 129 (>= 0 (product-version-compare 130 (product-version (product-find 'wl-version)) 131 (car (wl-news-previous-version-load))))) 132 133(defun wl-news-send-news (version news-lang folder) 134 (require 'wl-draft) 135 (let ((lang (if (listp wl-news-lang) 136 wl-news-lang 137 (list wl-news-lang))) 138 send-buffer 139 wl-fcc wl-bcc ret) 140 (save-window-excursion 141 (set-buffer 142 (setq send-buffer (wl-draft-create-buffer))) 143 (wl-draft-create-contents 144 (list (cons 'From "WL Release 'Bot <wl@ml.gentei.org>") 145 (cons 'To (wl-draft-eword-encode-address-list wl-from)) 146 (cons 'Subject "Wanderlust NEWS") 147 (cons 'Date (wl-make-date-string)) 148 (cons 'User-Agent wl-generate-mailer-string-function))) 149 (wl-draft-insert-mail-header-separator) 150 (wl-draft-prepare-edit) 151 (goto-char (point-max)) 152 (insert "\nThis message is automatically generated by Wanderlust.\n\n") 153 ;; insert news 154 (while (car lang) 155 (wl-news-append-news (car lang) version) 156 (setq lang (cdr lang))) 157 ;; encode 158 (let ((mime-header-encode-method-alist 159 '((eword-encode-unstructured-field-body)))) 160 (mime-edit-translate-buffer)) 161 (wl-draft-get-header-delimiter t) 162 (setq ret 163 (and (elmo-folder-writable-p 164 (wl-folder-get-elmo-folder folder)) 165 (elmo-folder-append-buffer 166 (wl-folder-get-elmo-folder folder)))) 167 (wl-draft-hide send-buffer) 168 (wl-draft-delete send-buffer)) 169 ret)) 170 171;;; wl-news-mode 172 173(defvar wl-news-buf-name "NEWS") 174(defvar wl-news-mode-map nil) 175(defvar wl-news-winconf nil) 176(defvar wl-news-buffer-oldest-version nil) 177(make-variable-buffer-local 'wl-news-buffer-oldest-version) 178 179(unless wl-news-mode-map 180 (setq wl-news-mode-map (make-sparse-keymap)) 181 (define-key wl-news-mode-map "q" 'wl-news-exit) 182 (define-key wl-news-mode-map "Q" 'wl-news-force-exit) 183 (define-key wl-news-mode-map "\C-xk" 'wl-news-exit) 184 (define-key wl-news-mode-map "a" 'wl-news-show-all) 185 (define-key wl-news-mode-map "m" 'wl-news-append-to-folder) 186 (define-key wl-news-mode-map "\C-m" 'wl-news-next-line) 187 (define-key wl-news-mode-map " " 'wl-news-next-page) 188 (define-key wl-news-mode-map "\177" 'wl-news-previous-page) 189 ;; re-bind commands of outline-mode 190 (define-key wl-news-mode-map "n" 'outline-next-visible-heading) 191 (define-key wl-news-mode-map "p" 'outline-previous-visible-heading) 192 (define-key wl-news-mode-map "u" 'outline-up-heading) 193 (define-key wl-news-mode-map "N" 'outline-forward-same-level) 194 (define-key wl-news-mode-map "P" 'outline-backward-same-level)) 195 196(require 'derived) 197(define-derived-mode wl-news-mode outline-mode "NEWS" 198 "Mode for Wanderlust NEWS(.ja)." 199 (setq buffer-read-only t)) 200 201(defun wl-news (&optional arg) 202 (interactive "P") 203 (remove-hook 'wl-hook 'wl-news) 204 (let* ((previous-version (if arg wl-news-default-previous-version 205 (cdr (wl-news-previous-version-load)))) 206 (lang wl-news-lang) 207 window-lines lines) 208 (if (or (get-buffer wl-news-buf-name) 209 (if (wl-news-check-news previous-version wl-news-lang) 210 (progn 211 (setq wl-news-winconf (current-window-configuration)) 212 (set-buffer (get-buffer-create wl-news-buf-name)) 213 (wl-news-mode) 214 (setq wl-news-buffer-oldest-version previous-version) 215 (buffer-disable-undo (current-buffer)) 216 ;; insert news 217 (let ((buffer-read-only nil)) 218 (insert "--- Wanderlust NEWS --- press 'a' to show all NEWS\n") 219 (insert " press 'm' to mail this NEWS to your folder\n") 220 (insert " press 'q' to quit\n") 221 (insert " press 'Q' to force quit\n\n") 222 (while (car lang) 223 (wl-news-append-news 224 (car lang) previous-version t) 225 (setq lang (cdr lang)))) 226 t) 227 (message "No NEWS.") 228 nil)) 229 (progn 230 (switch-to-buffer wl-news-buf-name) 231 (delete-other-windows) 232 (goto-char (point-min)))))) 233 234(defun wl-news-next-line () 235 (interactive) 236 (scroll-up 1)) 237 238(defun wl-news-next-page () 239 (interactive) 240 (scroll-up)) 241 242(defun wl-news-previous-page () 243 (interactive) 244 (scroll-down)) 245 246(defun wl-news-show-all () 247 (interactive) 248 (when (eq major-mode 'wl-news-mode) 249 (kill-buffer (current-buffer)) 250 (wl-news t))) 251 252(defun wl-news-exit () 253 (interactive) 254 (let* ((oldest-version (cdr (wl-news-previous-version-load))) 255 (current-version (product-version (product-find 'wl-version))) 256 (new-old-version current-version) 257 (buf (get-buffer wl-news-buf-name))) 258 (when buf 259 (if (wl-news-check-news oldest-version wl-news-lang) 260 (if (y-or-n-p "Do you want to see this message again? ") 261 (progn 262 (message "Please M-x wl-news if you want to see it.") 263 (setq new-old-version oldest-version)))) 264 (wl-news-previous-version-save 265 current-version new-old-version) 266 (kill-buffer (current-buffer)) 267 (if wl-news-winconf 268 (set-window-configuration wl-news-winconf)) 269 (kill-buffer buf) 270 (if wl-news-winconf 271 (set-window-configuration wl-news-winconf))))) 272 273(defun wl-news-append-to-folder () 274 (interactive) 275 (let* ((current-version (product-version (product-find 'wl-version))) 276 (new-old-version current-version) 277 (folder wl-default-folder)) 278 (if (or (and (elmo-folder-writable-p 279 (wl-folder-get-elmo-folder folder)) 280 (y-or-n-p (format 281 "Do you want to append this message to %s ? " 282 wl-default-folder))) 283 (setq folder 284 (wl-summary-read-folder wl-default-folder "to append "))) 285 (or (wl-news-send-news wl-news-buffer-oldest-version wl-news-lang folder) 286 (error "Cannot append NEWS mail to %s" folder))))) 287 288(defun wl-news-force-exit () 289 (interactive) 290 (let ((buf)) 291 (when (setq buf (get-buffer wl-news-buf-name)) 292 (wl-news-previous-version-save 293 (product-version (product-find 'wl-version)) 294 (cdr (wl-news-previous-version-load))) 295 (kill-buffer buf) 296 (if wl-news-winconf 297 (set-window-configuration wl-news-winconf))))) 298 299 300(require 'product) 301(product-provide (provide 'wl-news) (require 'wl-version)) 302 303 304;; Local Variables: 305;; no-byte-compile: t 306;; End: 307;;; wl-news.el ends here 308