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

sourceforge.el --- sourceforge minor mode stacked on emacs-w3m



大和です.

sourceforgeをブラウズするのにちょっとだけ便利なキー/コマンド定義集を
作ってみました.
;; Subjectではminor modeと書いていますが,まだ
;; minor modeになってません.

emacs-w3mが持っているであろうフレームワークを利用していませんが,現状
のコードでも少しは便利だと思うので報告することにしました.savannah.el
も作っています.savannah.elの方もある程度動いたらsavannahに登録するつ
もりです.

sourceforge.elでできること

--- 任意のバッファから ---

M-x sourceforge-goto-project-summary プロジェクト名
で指定したプロジェクトの summaryページに移動できます.

    e.g. 
    M-x sourceforge-goto-project-summary
    Project: autotrace

M-x sourceforge-goto-project-viewcvs プロジェクト名
で指定したプロジェクトの viewcvsのページに移動できます.


--- 任意のw3mのバッファから ---

Xx プロジェクト名
で指定したプロジェクトの summaryページに移動できます.

Xv プロジェクト名
で指定したプロジェクトの viewcvsのページに移動できます.

--- sourceforgeのあるプロジェクトのページを開いているw3mのバッファから ---

Xx 
現在開いているプロジェクトのsummaryページに移動できます.

Xv 
現在開いているプロジェクトのviewcvsページに移動できます.

C-u Xx プロジェクト名
で指定したプロジェクトの summaryページに移動できます.

C-u Xv 
で指定したプロジェクトの viewcvsページに移動できます.
;;; sourceforge.el --- sourceforge minor mode stacked on emacs-w3m

;; Copyright (C) 2002 Masatake YAMATO

;; Author: Masatake YAMATO <jet@gyve.org>

;; 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:
;; (require 'sourceforge)

(require 'w3m)

;;;;;;;
;;
;; 1. Developer access(TODO)
;;

;;;;;;;;
;;
;; 2. Anonymous access
;;

;;
;; 2.1 Project generic commands
;;
(defun sourceforge-search (string)
  (interactive "Sourceforge search: ")
  (w3m (format "http://sourceforge.net/search/?type_of_search=soft&words=%s"; string)))
			   
;;
;; 2.2 Project specific commands
;;
(defvar sourceforge-anonymous-access-key-prefix "X" "*")
(let ((prefix sourceforge-anonymous-access-key-prefix))
  (define-key w3m-mode-map prefix (make-sparse-keymap))
  (define-key w3m-mode-map (concat prefix "x") 'sourceforge-goto-project-summary)
  (define-key w3m-mode-map (concat prefix "h") 'sourceforge-goto-project-home-page)
  (define-key w3m-mode-map (concat prefix "t") 'sourceforge-goto-project-tracker)
  (define-key w3m-mode-map (concat prefix "f") 'sourceforge-goto-project-forum)
  (define-key w3m-mode-map (concat prefix "d") 'sourceforge-goto-project-docman)
  (define-key w3m-mode-map (concat prefix "m") 'sourceforge-goto-project-mail)
  (define-key w3m-mode-map (concat prefix "p") 'sourceforge-goto-project-pm)
  (define-key w3m-mode-map (concat prefix "s") 'sourceforge-goto-project-survey)
  (define-key w3m-mode-map (concat prefix "X") 'sourceforge-goto-project-cvs)
  (define-key w3m-mode-map (concat prefix "v") 'sourceforge-goto-project-viewcvs)
  (define-key w3m-mode-map (concat prefix "l") 'sourceforge-goto-project-memberlist))

(defun sourceforge-goto-project-summary (&optional project)
  (interactive (sourceforge-read-project))
  (sourceforge-goto-generic project "http://sourceforge.net/projects/%s";))

;; TODO, if a project has its own web site, this function will fail.
(defun sourceforge-goto-project-home-page (project)
  (interactive (sourceforge-read-project))
  (sourceforge-goto-generic project "http://%s.sourceforge.net";))

;;
(defun sourceforge-goto-project-tracker (project)
  (interactive (sourceforge-read-project))
  (let ((id (if project
		(sourceforge-get-project-id-for-project project)
	      (error "wrong project"))))
    (if id
	(sourceforge-goto-generic id "http://sourceforge.net/tracker/?group_id=%s";)
      (error "cannot get project id for %s" project))))

;;
(defun sourceforge-goto-project-forum (project)
  (interactive (sourceforge-read-project))
  (let ((id (if project
		(sourceforge-get-project-id-for-project project)
	      (error "wrong project"))))
    (if id
	(sourceforge-goto-generic id "http://sourceforge.net/forum/?group_id=%s";)
      (error "cannot get project id for %s" project))))

;;
(defun sourceforge-goto-project-docman (project)
  (interactive (sourceforge-read-project))
  (let ((id (if project
		(sourceforge-get-project-id-for-project project)
	      (error "wrong project"))))
    (if id
	(sourceforge-goto-generic id "http://sourceforge.net/docman/?group_id=%s";)
      (error "cannot get project id for %s" project))))

;;
(defun sourceforge-goto-project-mail (project)
  (interactive (sourceforge-read-project))
  (let ((id (if project
		(sourceforge-get-project-id-for-project project)
	      (error "wrong project"))))
    (if id
	(sourceforge-goto-generic id "http://sourceforge.net/mail/?group_id=%s";)
      (error "cannot get project id for %s" project))))

;;
(defun sourceforge-goto-project-pm (project)
  (interactive (sourceforge-read-project))
  (let ((id (if project
		(sourceforge-get-project-id-for-project project)
	      (error "wrong project"))))
    (if id
	(sourceforge-goto-generic id "http://sourceforge.net/pm/?group_id=%s";)
      (error "cannot get project id for %s" project))))

;;
(defun sourceforge-goto-project-survey (project)
  (interactive (sourceforge-read-project))
  (let ((id (if project
		(sourceforge-get-project-id-for-project project)
	      (error "wrong project"))))
    (if id
	(sourceforge-goto-generic id "http://sourceforge.net/survey/?group_id=%s";)
      (error "cannot get project id for %s" project))))

;;
(defun sourceforge-goto-project-cvs (project)
  (interactive (sourceforge-read-project))
  (let ((id (if project
		(sourceforge-get-project-id-for-project project)
	      (error "wrong project"))))
    (if id
	(sourceforge-goto-generic id "http://sourceforge.net/cvs/?group_id=%s";)
      (error "cannot get project id for %s" project))))

;; 
(defun sourceforge-goto-project-viewcvs (project)
  (interactive (sourceforge-read-project))
  (sourceforge-goto-generic project "http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/%s/";))

;;
(defun sourceforge-goto-project-memberlist (project)
  (interactive (sourceforge-read-project))
  (let ((id (if project
		(sourceforge-get-project-id-for-project project)
	      (error "wrong project"))))
    (if id
	(sourceforge-goto-generic id "http://sourceforge.net/project/memberlist.php?group_id=%s";)
      (error "cannot get project id for %s" project))))

;;
;; 2.3 Utils
;;
(defun sourceforge-get-project-id ()
  (sourceforge-get-project-id-for-project (sourceforge-get-project-name)))

(defun sourceforge-get-project-id-for-project (project)
  (let ((old-url (if (equal (sourceforge-get-project-name-from-url
			     w3m-current-url)
			    project)
		     nil
		   (prog1
		       w3m-current-url
		     (sourceforge-goto-project-summary project)))))
    (prog1
	(save-excursion
	  (save-match-data
	    (goto-char (point-max))
	    (if (re-search-backward "CVS Repository" nil t)
		(let ((url (w3m-anchor)))
		  (if (and url
			   (string-match 
			    "http://sourceforge\\.net/cvs/\\?group_id=\\([0-9]+\\)"
			    url))
		      (match-string 1 url))))))
      (if old-url
	  (w3m old-url)))))

(defun sourceforge-get-project-name ()
  (sourceforge-get-project-name-from-url w3m-current-url))

(defun sourceforge-get-project-name-from-url (url)
  (if (and url (stringp url))
      (cond
       ((string-match "http://sourceforge\\.net/projects/\\(.*\\).*" url)
	(match-string 1 url))
       ((string-match "http://\\(.*\\)\\.sourceforge\\.net.*" url)
	(match-string 1 url))
       (t
	nil))
    nil))

(defun sourceforge-read-project ()
  (if (and (eq major-mode 'w3m-mode)
	   (null current-prefix-arg)
	   ;; FIXME: Next line is dirty.
	   (sourceforge-get-project-name))
      (list (sourceforge-get-project-name))
    (list (read-string "Project: "))))

(defun sourceforge-goto-generic (project format-string)
  (if (and (or (null project) (and (stringp project) (string= "" project)))
	   (eq major-mode 'w3m-mode))
      (setq project (sourceforge-get-project-name)))
  (if project
      (w3m (format format-string project))
    (error "wrong project")))

(provide 'sourceforge)