update gitolite-clone

This commit is contained in:
Ivan Malison 2015-08-15 20:35:12 -07:00
parent 30b0eb968f
commit 9f5d3a29d6

View File

@ -6,7 +6,7 @@
;; Keywords: gitolite clone git
;; URL: https://github.com/IvanMalison/gitolite-cloone
;; Version: 0.1.0
;; Package-Requires: ((dash "2.10.0") (s "1.9.0") (pcache "0.3.1"))
;; Package-Requires: ((dash "2.10.0") (s "1.9.0") (pcache "0.3.1") (emacs "24"))
;; 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
@ -33,57 +33,105 @@
(require 'pcache)
(require 's)
(defvar gitolite-clone:pcache-repository (pcache-repository "gitolite-clone"))
(defvar gitolite-clone:username "gitolite")
(defvar gitolite-clone:host)
(defvar gitolite-clone:ttl (* 60 60 24 3)) ;; 3 day ttl by default
(defvar gitolite-clone:base-path "~")
(defvar gitolite-clone:determine-target 'gitolite-clone:default-determine-target)
(defvar gitolite-clone:action 'gitolite-clone:default-action)
(defvar gitolite-clone-pcache-repository (pcache-repository "gitolite-clone"))
(defcustom gitolite-clone-username "gitolite"
"The username that will be used to connect to gitolite by gitoline-clone."
:group 'gitolite-clone)
(defcustom gitolite-clone-host ""
"The gitolite host that will be connected to by default by gitoline-clone."
:group 'gitolite-clone)
(defcustom gitolite-clone-ttl (* 60 60 24 3)
"The default pcache ttl that will be used for caching repository results from gitolite."
:group 'gitolite-clone)
(defcustom gitolite-clone-base-path "~"
"The base path to which `gitolite-clone-default-determine-target' will clone repositories"
:group 'gitolite-clone)
(defvar gitolite-clone-determine-target 'gitolite-clone-default-determine-target)
(defvar gitolite-clone-action 'gitolite-clone-default-action)
(defun gitolite-clone:default-determine-target (username host repo-name)
(format "%s/%s" gitolite-clone:base-path (-last-item (s-split "/" repo-name))))
(defun gitolite-clone-default-determine-target (username host repo-name)
"A sensible default for determining the path to which repositories are cloned.
(defun gitolite-clone:default-action (username host repo-name target)
USERNAME and HOST are ignored. The folder will reside in
`gitolite-clone-base-path' and its name will be the text
following the final '/' in REPO-NAME."
(format "%s/%s" gitolite-clone-base-path (-last-item (s-split "/" repo-name))))
(defun gitolite-clone-default-action (username host repo-name target)
"Open dired at on the newly cloned repository.
USERNAME, HOST, and REPO-NAME are ignored. Dired will be opened at TARGET."
(dired target))
(defun gitolite-clone:info-command (username host)
(format "ssh %s@%s info" username host))
(defun gitolite-clone-info-command (username host)
"Generate command to retrieve the list of repositories from gitolite.
(defun gitolite-clone:get-projects-list-string (username host)
(shell-command-to-string (gitolite-clone:info-command username host)))
USERNAME is the username used on the gitolite server and HOST is
the hostname of the gitolite server."
(format "ssh %s@%s info" (shell-quote-argument username) (shell-quote-argument host)))
(defun gitolite-clone:repo-matches (projects-list-string)
(s-match-strings-all "^ \[RWC ]* \\(\[^ *\]*\\)$" projects-list-string))
(defun gitolite-clone-get-projects-list-string (username host)
"Make a call to the gitolite server to retrieve list of repos.
a custom username can be provided with USERNAME and custom host
can be probided with HOST."
(shell-command-to-string (gitolite-clone-info-command username host)))
(defun gitolite-clone:parse-projects-list-string (projects-list-string)
(cl-loop for matches in (gitolite-clone:repo-matches projects-list-string)
(defun gitolite-clone-parse-projects-list-string (projects-list-string)
"Get all lines that correspond to an actual repository from PROJECTS-LIST-STRING."
(cl-loop for matches in (s-match-strings-all "^ \[RWC ]* \\(\[^ *\]*\\)$" projects-list-string)
when (not (s-contains? "*" (nth 1 matches)))
collect (nth 1 matches)))
(defun gitolite-clone:get-projects (&optional username host force-refresh)
(unless username (setq username gitolite-clone:username))
(unless host (setq host gitolite-clone:host))
(let ((result-key (intern (format "%s@%s" username host))))
(unless (and (pcache-has gitolite-clone:pcache-repository result-key) (not force-refresh))
(pcache-put gitolite-clone:pcache-repository result-key
(gitolite-clone:parse-projects-list-string
(gitolite-clone:get-projects-list-string username host)) gitolite-clone:ttl))
(pcache-get gitolite-clone:pcache-repository result-key)))
(defun gitolite-clone-get-projects (&optional username host force-refresh)
"Retrieve and parse the list of projects available from gitolite.
(defun gitolite-clone:select-repository (&optional username host)
(completing-read "Choose a repository:" (gitolite-clone:get-projects username host)))
USERNAME is the username used on the gitolite server and HOST is
the hostname of the gitolite server. The retrieval is cached an
will only occur if the result has not already been stored.
FORCE-REFRESH makes it so that the cache is ignored when non nil."
(unless username (setq username gitolite-clone-username))
(unless host (setq host gitolite-clone-host))
(let ((result-key (intern (format "%s@%s" username host))))
(unless (and (pcache-has gitolite-clone-pcache-repository result-key) (not force-refresh))
(pcache-put gitolite-clone-pcache-repository result-key
(gitolite-clone-parse-projects-list-string
(gitolite-clone-get-projects-list-string username host)) gitolite-clone-ttl))
(pcache-get gitolite-clone-pcache-repository result-key)))
(defun gitolite-clone-select-repository (&optional username host)
"Pick a repository from the one available from the gitolite server.
USERNAME is the username used on the gitolite server and HOST is
the hostname of the gitolite server."
(completing-read "Choose a repository:" (gitolite-clone-get-projects username host)))
;;;###autoload
(defun gitolite-clone:clone-repo (&optional username host determine-target action)
(defun gitolite-clone (&optional username host determine-target action)
"Clone a gitolite repo to be selected by `completing-read'.
USERNAME and HOST will be used to determine how to talk to
gitolite using ssh. They default to `gitolite-clone-username' and
`gitolite-clone-host' respectively.
DETERMINE-TARGET is a function with signature identical to that
of `gitolite-clone-default-determine-target'. It will determine
the path to which the repository should be cloned, and it
defaults to `gitolite-clone-default-determine-target'.
ACTION is a function that will be executed once the repository
has been cloned. It's signature should be that of
`gitolite-clone-default-action', which is also the default value
for this argument."
(interactive)
(unless username (setq username gitolite-clone:username))
(unless host (setq host gitolite-clone:host))
(unless determine-target (setq determine-target gitolite-clone:determine-target))
(unless action (setq action gitolite-clone:action))
(let* ((repository (gitolite-clone:select-repository))
(unless username (setq username gitolite-clone-username))
(unless host (setq host gitolite-clone-host))
(unless determine-target (setq determine-target gitolite-clone-determine-target))
(unless action (setq action gitolite-clone-action))
(let* ((repository (gitolite-clone-select-repository))
(target (funcall determine-target username host repository))
(git-command (format "git clone %s@%s:%s %s" username host repository target)))
(git-command (format "git clone %s@%s:%s %s" (shell-quote-argument username)
(shell-quote-argument host) (shell-quote-argument repository)
(shell-quote-argument target))))
(unless (file-exists-p target)
(shell-command git-command))
(when (file-exists-p target)