X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=wl%2Fwl-news.el.in;h=d3803cb00dfa8dce611fac5fe859a2259540268b;hb=0dde8858aebea5d441e0156d7649f766706d45d7;hp=32c24458d942e088c659b8f32338d235dc0f8047;hpb=43bef88ef9bcbd1dc92cc14ee47e4755251d4ffb;p=elisp%2Fwanderlust.git

diff --git a/wl/wl-news.el.in b/wl/wl-news.el.in
index 32c2445..d3803cb 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 -*-
@@ -61,121 +68,169 @@
 ;;; -*- news-list-end -*-
 
 (defun wl-news-previous-version-load ()
-  (save-excursion
+  (with-temp-buffer
     (let ((filename (expand-file-name
 		     wl-news-version-file-name
 		     elmo-msgdb-directory))
-	  (tmp-buffer (get-buffer-create " *wl-news-version-tmp*"))
 	  insert-file-contents-pre-hook
 	  insert-file-contents-post-hook
 	  ret-val)
       (if (not (file-readable-p filename))
-	  wl-news-default-previous-version
-	(set-buffer tmp-buffer)
+	  (cons wl-news-default-previous-version
+		wl-news-default-previous-version)
 	(insert-file-contents filename)
-	(setq ret-val
-	      (condition-case nil
-		  (read (current-buffer))
-		(error nil nil)))
-	(kill-buffer tmp-buffer)
-	ret-val))))
-
-(defun wl-news-previous-version-save (version)
-  (save-excursion
+	(condition-case nil
+	    (read (current-buffer))
+	  (error nil nil))))))
+
+(defun wl-news-previous-version-save (current-version previous-version)
+  (with-temp-buffer
     (let ((filename (expand-file-name
 		     wl-news-version-file-name
 		     elmo-msgdb-directory))
-	  (tmp-buffer (get-buffer-create " *wl-news-version-tmp*")))
-      (set-buffer tmp-buffer)
-      (erase-buffer)
-      (prin1 version tmp-buffer)
-      (princ "\n" tmp-buffer)
+	  print-length print-level)
+      (prin1 (cons current-version previous-version) (current-buffer))
+      (princ "\n" (current-buffer))
       (if (file-writable-p filename)
 	  (write-region (point-min) (point-max)
 			filename nil 'no-msg)
-	(message "%s is not writable." filename))
-      (kill-buffer tmp-buffer))))
+	(message "%s is not writable." filename)))))
 
 (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))))
-    (if no-mime-tag
-	(insert "\n")
-      (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 <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 folder))
+		 (elmo-folder-append-buffer
+		  (wl-folder-get-elmo-folder folder))))
+      (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 "\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-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)
+  (define-key wl-news-mode-map "\177"  'wl-news-previous-page)
+  ;; re-bind commands of outline-mode
+  (define-key wl-news-mode-map "n"     'outline-next-visible-heading)
+  (define-key wl-news-mode-map "p"     'outline-previous-visible-heading)
+  (define-key wl-news-mode-map "u"     'outline-up-heading)
+  (define-key wl-news-mode-map "N"     'outline-forward-same-level)
+  (define-key wl-news-mode-map "P"     'outline-backward-same-level))
 
-(defun wl-news-mode ()
+(require 'derived)
+(define-derived-mode wl-news-mode outline-mode "NEWS"
   "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 ()
-  (interactive)
-  (setq wl-news-winconf (current-window-configuration))
-  (let* ((previous-version (wl-news-previous-version-load))
+(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)
-    (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)
-    (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)
+		  (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)
@@ -185,13 +240,69 @@
   (interactive)
   (scroll-up))
 
+(defun wl-news-previous-page ()
+  (interactive)
+  (scroll-down))
+
+(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)
-  (kill-buffer (current-buffer))
-  (if wl-news-winconf
-      (set-window-configuration wl-news-winconf)))
+  (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 "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))
 
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
 ;;; wl-news.el ends here