[Date Prev][Date Next][Thread Prev][][Date Index][Thread Index]

Re: savannah



> へへぇー、何か持ってまいります。
キャッシュを用意しました。

ローカルにためてあるグループキャッシュを見て、
あれば、それを使います。なければ、ユーザにネットワーク経由でキャッシュを生成する
か問いあわせます。ネットワーク経由でキャッシュを生成しないのであれば、staticに
定義されているデータ(shimbun-savannah-group-static-path-alist)を使います。

一度生成したらいつキャッシュをアップデートするのかという問題が残っています。
どうしたもんでしょうか。

shimbun-savannah-group-update-cached-path-alist
をinteractiveにはしてあるのですが...


Index: shimbun/sb-savannah.el
===================================================================
RCS file: /storage/cvsroot/emacs-w3m/shimbun/sb-savannah.el,v
retrieving revision 1.8
diff -u -r1.8 sb-savannah.el
--- shimbun/sb-savannah.el	13 Mar 2003 22:58:42 -0000	1.8
+++ shimbun/sb-savannah.el	28 May 2003 14:07:16 -0000
@@ -34,26 +34,109 @@
 (require 'shimbun)
 (require 'sb-mhonarc)
 
-(luna-define-class shimbun-savannah (shimbun-mhonarc) ())
+(luna-define-class shimbun-savannah (shimbun-mhonarc) (group-status))
+(luna-define-internal-accessors 'shimbun-savannah)
 
 (defvar shimbun-savannah-url "http://mail.gnu.org/archive/html/")
 
-(defvar shimbun-savannah-group-path-alist
-  '(("bug-gnu-emacs" . "bug-gnu-emacs")
-    ("emacs-bidi" . "emacs-bidi")
-    ("emacs-commit" . "emacs-commit")
-    ("emacs-devel" . "emacs-devel")
-    ("emacs-diffs" . "emacs-diffs")
-    ("emacs-pretest-bug" . "emacs-pretest-bug")
-    ("gnu-emacs-sources" . "gnu-emacs-sources")
-    ("help-emacs-windows" . "help-emacs-windows")
-    ("help-gnu-emacs" . "help-gnu-emacs")
-    ("info-gnu-emacs" . "info-gnu-emacs")
-    ("tramp-devel" . "tramp-devel")
-    ("vms-gnu-emacs" . "vms-gnu-emacs")))
+(defgroup sb-savannah nil
+  "sb-savannah.el --- shimbun backend for gnu list archives on savannah."
+  :group 'shimbun)
+
+(defcustom shimbun-savannah-group-static-path-alist '(("bug-gnu-emacs" . "bug-gnu-emacs")
+						      ("emacs-bidi" . "emacs-bidi")
+						      ("emacs-commit" . "emacs-commit")
+						      ("emacs-devel" . "emacs-devel")
+						      ("emacs-diffs" . "emacs-diffs")
+						      ("emacs-pretest-bug" . "emacs-pretest-bug")
+						      ("gnu-emacs-sources" . "gnu-emacs-sources")
+						      ("help-emacs-windows" . "help-emacs-windows")
+						      ("help-gnu-emacs" . "help-gnu-emacs")
+						      ("info-gnu-emacs" . "info-gnu-emacs")
+						      ("tramp-devel" . "tramp-devel")
+						      ("vms-gnu-emacs" . "vms-gnu-emacs"))
+  "Table of mailing lists which is archived by savannah. 
+If you don't have cache data in the local file, this statically defined datum are used."
+  :group 'sb-savannah
+  :type  '(repeat
+	   (cons (string :tag "Group")
+		 (string :tag "Path"))))
+
+(defcustom shimbun-savannah-group-cache-file "~/.sb-savannah"
+  "File in which groups of shimbun-savannah are stored.
+The groups are retrieved from `shimbun-savannah-url'."
+  :group 'sb-savannah
+  :type 'file)
+
+(defvar shimbun-savannah-group-cached-path-alist nil
+  "Table of mailing lists which is archived by savannah. 
+The value is retrieved and cached in the local file by 
+`shimbun-savannah-group-update-cached-path-alist'.")
+
+(defun shimbun-savannah-group-load-cached-path-alist ()
+  "Load the cached value for `shimbun-savannah-group-cached-path-alist' from the local file.
+`shimbun-savannah-group-cache-file' is used for the cache file name."
+  (if (file-readable-p (expand-file-name 
+			shimbun-savannah-group-cache-file))
+      (let ((value (with-temp-buffer
+		     (insert-file (expand-file-name 
+				   shimbun-savannah-group-cache-file))
+		     (goto-char (point-min))
+		     (condition-case nil
+			 (read (current-buffer))
+		       (error nil)))))
+	(setq shimbun-savannah-group-cached-path-alist value))
+    nil))
+
+(defconst shimbun-savannah-group-regexp 
+  "<span class=\"listName\"><a href=\"/archive/html/\\(.*\\)/\">\\(.*\\)</a></span>")
+(defun shimbun-savannah-group-update-cached-path-alist ()
+  "Update `shimbun-savannah-group-cached-path-alist'."
+  (interactive)
+  (with-temp-buffer
+    (shimbun-retrieve-url shimbun-savannah-url 'no-cache 'no-decode)
+    (goto-char (point-min))
+    (while (re-search-forward shimbun-savannah-group-regexp nil t)
+      (setq shimbun-savannah-group-cached-path-alist
+	    (cons (cons (match-string 2) (match-string 1))
+		  shimbun-savannah-group-cached-path-alist)))
+    (shimbun-savannah-group-save-cached-path-alist)))
+
+(defun  shimbun-savannah-group-save-cached-path-alist ()
+  "Save `shimbun-savannah-group-cached-path-alist' to the local file.
+`shimbun-savannah-group-cache-file' is used for the cache file name."
+  (with-temp-file (expand-file-name shimbun-savannah-group-cache-file)
+    (pp shimbun-savannah-group-cached-path-alist (current-buffer))))
+
+(luna-define-generic shimbun-savannah-group-path-alist (entity))
+(luna-define-method shimbun-savannah-group-path-alist ((entity shimbun-savannah))
+  "Return groups of shimbun-savannah. 
+Loads the local cache or retrieves from `shimbun-savannah-url' if necessary."
+  (if shimbun-savannah-group-cached-path-alist
+      ;; Already loaded
+      shimbun-savannah-group-cached-path-alist
+    ;; Not yet
+    (let ((status (shimbun-savannah-group-status-internal entity)))
+      (ecase status
+       ('nil				; This is the first time.
+	(shimbun-savannah-group-load-cached-path-alist)
+	(shimbun-savannah-set-group-status-internal entity 'loading)
+	(shimbun-savannah-group-path-alist entity))
+       (loading
+	(if (y-or-n-p "Update shimbun-savannah's group cache?[network connection is required] ")
+	    (progn
+	      (shimbun-savannah-group-update-cached-path-alist)
+	      (shimbun-savannah-set-group-status-internal entity 'updated))
+	  (shimbun-savannah-set-group-status-internal entity 'reject))
+	(shimbun-savannah-group-path-alist entity))
+       (reject				; The user already rejected retrieving.
+	shimbun-savannah-group-static-path-alist)
+       (updated
+	(message "Updated might be failed.")
+	shimbun-savannah-group-static-path-alist)))))
 
-(defvar shimbun-savannah-groups
-  (mapcar 'car shimbun-savannah-group-path-alist))
+(luna-define-method shimbun-groups ((shimbun shimbun-savannah))
+  (mapcar 'car (shimbun-savannah-group-path-alist shimbun)))
 
 (defvar shimbun-savannah-reverse-flag t)
 
@@ -70,7 +153,7 @@
 (defun shimbun-savannah-index-url (entity)
   (concat (shimbun-url-internal entity)
 	  (cdr (assoc (shimbun-current-group-internal entity)
-		      shimbun-savannah-group-path-alist))
+		      (shimbun-savannah-group-path-alist entity)))
 	  "/"))
 
 (luna-define-method shimbun-index-url ((shimbun shimbun-savannah))