;;; browse-cvs-repository.el --- browse cvs repository via web

;; Copyright (C) 2006 Yoichi NAKAYAMA <yoichi@geiin.org>

;; Author: Yoichi NAKAYAMA <yoichi@geiin.org>
;; Keywords: CVS, version control, release management

;; This file is not part of GNU Emacs.

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;

;;; Commentary:
;;

;;; Code:
;;

(require 'pcvs)

(defvar browse-cvs-repository-alist
  '((":pserver:anonymous@cvs.m17n.org:/cvs/root"
     "http://cvs.m17n.org/viewcvs/")
    (":ext:freebsdanoncvs@anoncvs.FreeBSD.org:/home/ncvs"
     "http://www.freebsd.org/cgi/cvsweb.cgi/")
    (":pserver:anonymous@cvs.sv.gnu.org:/cvsroot/emacs"
     "http://savannah.gnu.org/cgi-bin/viewcvs/emacs/")))

(defun browse-cvs-repository ()
  "Browse related cvs repository via web."
  (interactive)
  (let ((module (cvs-get-module))
	(root (cvs-get-cvsroot))
	elem)
    (when (eq (length module) 0)
      (error "not managed by CVS"))
    (setq elem (assoc root browse-cvs-repository-alist))
    (if elem
	(let (tag url)
	  (if (and (file-readable-p "CVS/Tag")
		   (setq tag (cvs-file-to-string "CVS/Tag"))
		   (string-match "\\`T" tag))
	      (setq tag (substring tag 1))
	    (setq tag "MAIN"))
	  (setq url (concat (car (cdr elem))
			    module "/"
			    (and buffer-file-name
				 (file-name-nondirectory (buffer-file-name)))
			    "?only_with_tag="
			    tag))
	  (browse-url url))
      (error "cannot detect related url"))))

(provide 'browse-cvs-repository)

;;; browse-cvs-repository.el ends here