(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 -*-
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
(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
(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)
(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 <wl@lists.airs.net>")
- (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 <wl@lists.airs.net>")
+ (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
(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)."
(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)
(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))
projects / elisp / wanderlust.git / commitdiff