From: okada Date: Fri, 20 Dec 2002 21:23:34 +0000 (+0000) Subject: * wl-news.el.in (wl-news-check): X-Git-Tag: merged-trunk-to-elmo-mark-14~80 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=d59d7fd48d941e3e23f9aeffffb4b1c809ebd481;p=elisp%2Fwanderlust.git * wl-news.el.in (wl-news-check): (wl-news-previous-version-load): Change data type. (wl-news-previous-version-save): Change data type. (wl-news-append-news): Add return value. (wl-news-check-news): New function. (wl-news-already-current-p): New function. (wl-news-send-news): Rewritten. (wl-news-mode-map): Add new keybind. (wl-news): Rewritten. (wl-news-exit): Rewritten. (wl-news-discard-and-mail): New function. (wl-news-send-to-address): Abolished. * wl.el (wl-init): Delete a message. --- diff --git a/wl/ChangeLog b/wl/ChangeLog index 4b3617b..730d5f9 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,5 +1,21 @@ 2002-12-21 Kenichi OKADA + * wl-news.el.in (wl-news-check): + (wl-news-previous-version-load): Change data type. + (wl-news-previous-version-save): Change data type. + (wl-news-append-news): Add return value. + (wl-news-check-news): New function. + (wl-news-already-current-p): New function. + (wl-news-send-news): Rewritten. + (wl-news-mode-map): Add new keybind. + (wl-news): Rewritten. + (wl-news-exit): Rewritten. + (wl-news-discard-and-mail): New function. + (wl-news-send-to-address): Abolished. + * wl.el (wl-init): Delete a message. + +2002-12-21 Kenichi OKADA + * wl-news.el.in (wl-news-exit): Update previous version. * wl.el (wl-folder-mode-menu-spec): Add 'Wanderlust NEWS'. diff --git a/wl/wl-news.el.in b/wl/wl-news.el.in index 044a26e..34810ea 100644 --- a/wl/wl-news.el.in +++ b/wl/wl-news.el.in @@ -40,19 +40,19 @@ (defvar wl-news-version-file-name "previous-version") (defvar wl-news-default-previous-version '(2 0 0)) -(defvar wl-news-send-to-address nil - "*The recipient address to send NEWS.") - (defun wl-news-check () - (let* ((previous-version (wl-news-previous-version-load)) - (current-version (product-version (product-find 'wl-version))) - (updated (< 0 (product-version-compare - current-version previous-version)))) - (when updated - (and wl-news-lang - wl-news-send-to-address - (wl-news-send-news previous-version)) - (wl-news-previous-version-save current-version)) + (let* ((updated (not (wl-news-already-current-p)))) + (if updated + (if (and wl-news-lang + (wl-news-check-news + (cdr (wl-news-previous-version-load)) + wl-news-lang) + (not (memq 'wl-news wl-hook))) + (add-hook 'wl-hook 'wl-news)) + ;; update wl-news-version-file + (wl-news-previous-version-save + (product-version (product-find 'wl-version)) + (cdr (wl-news-previous-version-load)))) updated)) ;;; -*- news-list -*- @@ -70,7 +70,8 @@ insert-file-contents-post-hook ret-val) (if (not (file-readable-p filename)) - wl-news-default-previous-version + (cons wl-news-default-previous-version + wl-news-default-previous-version) (set-buffer tmp-buffer) (insert-file-contents filename) (setq ret-val @@ -80,7 +81,7 @@ (kill-buffer tmp-buffer) ret-val)))) -(defun wl-news-previous-version-save (version) +(defun wl-news-previous-version-save (current-version previous-version) (save-excursion (let ((filename (expand-file-name wl-news-version-file-name @@ -88,7 +89,7 @@ (tmp-buffer (get-buffer-create " *wl-news-version-tmp*"))) (set-buffer tmp-buffer) (erase-buffer) - (prin1 version tmp-buffer) + (prin1 (cons current-version previous-version) tmp-buffer) (princ "\n" tmp-buffer) (if (file-writable-p filename) (write-region (point-min) (point-max) @@ -98,44 +99,75 @@ (defun wl-news-append-news (lang previous-version &optional no-mime-tag) (require 'wl-mime) - (let* ((news-list (cdr (assoc lang wl-news-news-alist)))) + (let ((news-list (cdr (assoc lang wl-news-news-alist))) + ret) (if no-mime-tag - (insert "\n") + (insert "--------------\n") (mime-edit-insert-tag "text" "plain" "" "")) (while (< 0 (product-version-compare (car (car news-list)) previous-version)) + (setq ret t) (insert (cdr (car news-list)) "\n\n") - (setq news-list (cdr news-list))))) + (setq news-list (cdr news-list))) + ret)) + +(defun wl-news-check-news (version news-lang) + (let ((lang news-lang) + news-list ret) + (while (car lang) + (setq news-list (cdr (assoc (car lang) wl-news-news-alist))) + (while (< 0 + (product-version-compare + (car (car news-list)) version)) + (setq ret t) + (setq news-list (cdr news-list))) + (setq lang (cdr lang))) + ret)) -(defun wl-news-send-news (previous-version) +(defun wl-news-already-current-p () + (>= 0 (product-version-compare + (product-version (product-find 'wl-version)) + (car (wl-news-previous-version-load))))) + +(defun wl-news-send-news (version news-lang) (require 'wl-draft) (let ((lang (if (listp wl-news-lang) wl-news-lang (list wl-news-lang))) - wl-fcc wl-bcc) + send-buffer + wl-fcc wl-bcc ret) (save-window-excursion - (wl-draft-create-buffer) + (set-buffer + (setq send-buffer (wl-draft-create-buffer))) (wl-draft-create-contents - (list (cons 'From "WL Release 'Bot ") - (cons 'To (wl-draft-eword-encode-address-list - wl-news-send-to-address)) - (cons 'Subject "Wanderlust NEWS") - (cons 'Date (wl-make-date-string)) - (cons 'User-Agent wl-generate-mailer-string-function))) + (list (cons 'From "WL Release 'Bot ") + (cons 'To (wl-draft-eword-encode-address-list wl-from)) + (cons 'Subject "Wanderlust NEWS") + (cons 'Date (wl-make-date-string)) + (cons 'User-Agent wl-generate-mailer-string-function))) (wl-draft-insert-mail-header-separator) (wl-draft-prepare-edit) (goto-char (point-max)) (insert "\nThis message is automatically generated by Wanderlust.\n\n") ;; insert news (while (car lang) - (wl-news-append-news - (car lang) previous-version) + (wl-news-append-news (car lang) version) (setq lang (cdr lang))) - ;; send - (let (wl-interactive-send) - (wl-draft-send 'kill-when-done))))) + ;; encode + (let ((mime-header-encode-method-alist + '((eword-encode-unstructured-field-body)))) + (mime-edit-translate-buffer)) + (wl-draft-get-header-delimiter t) + (setq ret + (and (elmo-folder-writable-p + (wl-folder-get-elmo-folder wl-default-folder)) + (elmo-folder-append-buffer + (wl-folder-get-elmo-folder wl-default-folder) t))) + (wl-draft-hide send-buffer) + (wl-draft-delete send-buffer)) + ret)) ;;; wl-news-mode @@ -145,9 +177,11 @@ (unless wl-news-mode-map (setq wl-news-mode-map (make-sparse-keymap)) - (define-key wl-news-mode-map "q" 'wl-news-exit) - (define-key wl-news-mode-map "\C-m" 'wl-news-next-line) - (define-key wl-news-mode-map " " 'wl-news-next-page)) + (define-key wl-news-mode-map "q" 'wl-news-exit) + (define-key wl-news-mode-map "Q" 'wl-news-discard-and-mail) + (define-key wl-news-mode-map "\C-xk" 'wl-news-exit) + (define-key wl-news-mode-map "\C-m" 'wl-news-next-line) + (define-key wl-news-mode-map " " 'wl-news-next-page)) (defun wl-news-mode () "Mode for Wanderlust NEWS(.ja)." @@ -160,23 +194,33 @@ (defun wl-news () (interactive) - (setq wl-news-winconf (current-window-configuration)) - (let* ((previous-version (wl-news-previous-version-load)) + (remove-hook 'wl-hook 'wl-news) + (let* ((previous-version (cdr (wl-news-previous-version-load))) (lang wl-news-lang) window-lines lines) - (set-buffer (get-buffer-create wl-news-buf-name)) - (wl-news-mode) - (buffer-disable-undo (current-buffer)) - ;; insert news - (let ((buffer-read-only nil)) - (insert "--- Wanderlust NEWS --- press 'q' for exit\n\n") - (while (car lang) - (wl-news-append-news - (car lang) previous-version t) - (setq lang (cdr lang)))) - (switch-to-buffer wl-news-buf-name) - (delete-other-windows) - (goto-char (point-min)))) + (if (or (get-buffer wl-news-buf-name) + (if (wl-news-check-news previous-version wl-news-lang) + (progn + (setq wl-news-winconf (current-window-configuration)) + (set-buffer (get-buffer-create wl-news-buf-name)) + (wl-news-mode) + (buffer-disable-undo (current-buffer)) + ;; insert news + (let ((buffer-read-only nil)) + (insert "--- Wanderlust NEWS --- press 'q' for exit\n") + (if (wl-news-already-current-p) + (insert " press 'Q' for discard this message\n\n")) + (while (car lang) + (wl-news-append-news + (car lang) previous-version t) + (setq lang (cdr lang)))) + t) + (message "No NEWS.") + nil)) + (progn + (switch-to-buffer wl-news-buf-name) + (delete-other-windows) + (goto-char (point-min)))))) (defun wl-news-next-line () (interactive) @@ -188,12 +232,34 @@ (defun wl-news-exit () (interactive) - (unless (y-or-n-p "Do you want to look at this message again? ") - (wl-news-previous-version-save - (product-version (product-find 'wl-version)))) - (kill-buffer (current-buffer)) - (if wl-news-winconf - (set-window-configuration wl-news-winconf))) + (if (eq major-mode 'wl-news-mode) + (if (not (wl-news-already-current-p)) + (wl-news-discard-and-mail) + (kill-buffer (current-buffer)) + (if wl-news-winconf + (set-window-configuration wl-news-winconf))))) + +(defun wl-news-discard-and-mail () + (interactive) + (if (eq major-mode 'wl-news-mode) + (let* ((oldest-version (cdr (wl-news-previous-version-load))) + (current-version (product-version (product-find 'wl-version))) + (new-old-version current-version)) + (if (wl-news-check-news oldest-version wl-news-lang) + (if (y-or-n-p "Do you want to see this message again? ") + (progn + (message "Please M-x wl-news if you want to see it.") + (setq new-old-version oldest-version)) + (if (y-or-n-p "Do you want this message for a mail? ") + (or (wl-news-send-news oldest-version wl-news-lang) + (error + (format "Cannot append NEWS mail to %s" wl-default-folder)))))) + (wl-news-previous-version-save + current-version new-old-version) + (kill-buffer (current-buffer)) + (if wl-news-winconf + (set-window-configuration wl-news-winconf))))) + (require 'product) (product-provide (provide 'wl-news) (require 'wl-version)) diff --git a/wl/wl.el b/wl/wl.el index 6039c2c..ea1807b 100644 --- a/wl/wl.el +++ b/wl/wl.el @@ -697,8 +697,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (symbol-value 'wl-summary-subject-filter-function)) (setq elmo-no-from wl-summary-no-from-message) (setq elmo-no-subject wl-summary-no-subject-message) - (and (wl-news-check) - (message "Wanderlust is updated, please read NEWS(.ja) for changes.")) + (wl-news-check) (setq wl-init t) ;; This hook may contain the functions `wl-plugged-init-icons' and ;; `wl-biff-init-icons' for reasons of system internal to accord