X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-news.el.in;h=dee1fbdda5d3717872d40e42caf0e6274891f36f;hb=b2e555277b2bdb26aab81311036b32a2177a272b;hp=5d1c987192d5b71d1fa89a949cdb5bc7c3613431;hpb=f720c5ad7dccab81eaa4860b8af3dfed8ff9768d;p=elisp%2Fwanderlust.git diff --git a/wl/wl-news.el.in b/wl/wl-news.el.in index 5d1c987..dee1fbd 100644 --- a/wl/wl-news.el.in +++ b/wl/wl-news.el.in @@ -40,19 +40,26 @@ (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.") +(defvar wl-news-lang + (if (and (boundp 'current-language-environment) + (string-equal "Japanese" + (symbol-value 'current-language-environment))) + '("ja" "en") '("en" "ja")) + "The list of languages to show NEWS. (order sensitive)") (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 +77,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,15 +88,16 @@ (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 elmo-msgdb-directory)) - (tmp-buffer (get-buffer-create " *wl-news-version-tmp*"))) + (tmp-buffer (get-buffer-create " *wl-news-version-tmp*")) + print-length print-level) (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) @@ -96,44 +105,201 @@ (message "%s is not writable." filename)) (kill-buffer tmp-buffer)))) -(defun wl-news-append-news (lang previous-version) +(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)))) - (mime-edit-insert-tag "text" "plain" "" "") - (while (< 0 - (product-version-compare - (car (car news-list)) - previous-version)) - (insert (cdr (car news-list)) "\n\n") - (setq news-list (cdr news-list))))) - -(defun wl-news-send-news (previous-version) + (let ((news-list (cdr (assoc lang wl-news-news-alist))) + ret) + (when news-list + (if no-mime-tag + (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)))) + 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-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 folder) (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 folder)) + (elmo-folder-append-buffer + (wl-folder-get-elmo-folder folder) t))) + (wl-draft-hide send-buffer) + (wl-draft-delete send-buffer)) + ret)) + +;;; wl-news-mode + +(defvar wl-news-buf-name "NEWS") +(defvar wl-news-mode-map nil) +(defvar wl-news-winconf nil) +(defvar wl-news-buffer-oldest-version nil) +(make-variable-buffer-local 'wl-news-buffer-oldest-version) + +(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 "Q" 'wl-news-force-exit) + (define-key wl-news-mode-map "\C-xk" 'wl-news-exit) + (define-key wl-news-mode-map "a" 'wl-news-show-all) + (define-key wl-news-mode-map "m" 'wl-news-append-to-folder) + (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)." + (interactive) + (kill-all-local-variables) + (use-local-map wl-news-mode-map) + (setq major-mode 'wl-news-mode) + (setq mode-name "NEWS") + (setq buffer-read-only t)) + +(defun wl-news (&optional arg) + (interactive "P") + (remove-hook 'wl-hook 'wl-news) + (let* ((previous-version (if arg wl-news-default-previous-version + (cdr (wl-news-previous-version-load)))) + (lang wl-news-lang) + window-lines lines) + (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) + (setq wl-news-buffer-oldest-version previous-version) + (buffer-disable-undo (current-buffer)) + ;; insert news + (let ((buffer-read-only nil)) + (insert "--- Wanderlust NEWS --- press 'a' to show all NEWS\n") + (insert " press 'm' to mail this NEWS to your folder\n") + (insert " press 'q' to quit\n") + (insert " press 'Q' to force quit\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) + (scroll-up 1)) + +(defun wl-news-next-page () + (interactive) + (scroll-up)) + +(defun wl-news-show-all () + (interactive) + (when (eq major-mode 'wl-news-mode) + (kill-buffer (current-buffer)) + (wl-news t))) + +(defun wl-news-exit () + (interactive) + (let* ((oldest-version (cdr (wl-news-previous-version-load))) + (current-version (product-version (product-find 'wl-version))) + (new-old-version current-version) + (buf (get-buffer wl-news-buf-name))) + (when buf + (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)))) + (wl-news-previous-version-save + current-version new-old-version) + (kill-buffer (current-buffer)) + (if wl-news-winconf + (set-window-configuration wl-news-winconf)) + (kill-buffer buf) + (if wl-news-winconf + (set-window-configuration wl-news-winconf))))) + +(defun wl-news-append-to-folder () + (interactive) + (let* ((current-version (product-version (product-find 'wl-version))) + (new-old-version current-version) + (folder wl-default-folder)) + (if (or (and (elmo-folder-writable-p + (wl-folder-get-elmo-folder folder)) + (y-or-n-p (format + "Do you want to append this message to %s ? " + wl-default-folder))) + (setq folder + (wl-summary-read-folder wl-default-folder "to append "))) + (or (wl-news-send-news wl-news-buffer-oldest-version wl-news-lang folder) + (error + (format "Cannot append NEWS mail to %s" folder)))))) + +(defun wl-news-force-exit () + (interactive) + (let ((buf)) + (when (setq buf (get-buffer wl-news-buf-name)) + (wl-news-previous-version-save + (product-version (product-find 'wl-version)) + (cdr (wl-news-previous-version-load))) + (kill-buffer buf) + (if wl-news-winconf + (set-window-configuration wl-news-winconf))))) + (require 'product) (product-provide (provide 'wl-news) (require 'wl-version))