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 ;; Keywords: gitolite clone git
;; URL: https://github.com/IvanMalison/gitolite-cloone ;; URL: https://github.com/IvanMalison/gitolite-cloone
;; Version: 0.1.0 ;; 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 ;; 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 ;; it under the terms of the GNU General Public License as published by
@ -33,57 +33,105 @@
(require 'pcache) (require 'pcache)
(require 's) (require 's)
(defvar gitolite-clone:pcache-repository (pcache-repository "gitolite-clone")) (defvar gitolite-clone-pcache-repository (pcache-repository "gitolite-clone"))
(defvar gitolite-clone:username "gitolite") (defcustom gitolite-clone-username "gitolite"
(defvar gitolite-clone:host) "The username that will be used to connect to gitolite by gitoline-clone."
(defvar gitolite-clone:ttl (* 60 60 24 3)) ;; 3 day ttl by default :group 'gitolite-clone)
(defvar gitolite-clone:base-path "~") (defcustom gitolite-clone-host ""
(defvar gitolite-clone:determine-target 'gitolite-clone:default-determine-target) "The gitolite host that will be connected to by default by gitoline-clone."
(defvar gitolite-clone:action 'gitolite-clone:default-action) :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) (defun gitolite-clone-default-determine-target (username host repo-name)
(format "%s/%s" gitolite-clone:base-path (-last-item (s-split "/" 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)) (dired target))
(defun gitolite-clone:info-command (username host) (defun gitolite-clone-info-command (username host)
(format "ssh %s@%s info" username host)) "Generate command to retrieve the list of repositories from gitolite.
(defun gitolite-clone:get-projects-list-string (username host) USERNAME is the username used on the gitolite server and HOST is
(shell-command-to-string (gitolite-clone:info-command username host))) 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) (defun gitolite-clone-get-projects-list-string (username host)
(s-match-strings-all "^ \[RWC ]* \\(\[^ *\]*\\)$" projects-list-string)) "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) (defun gitolite-clone-parse-projects-list-string (projects-list-string)
(cl-loop for matches in (gitolite-clone:repo-matches 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))) when (not (s-contains? "*" (nth 1 matches)))
collect (nth 1 matches))) collect (nth 1 matches)))
(defun gitolite-clone:get-projects (&optional username host force-refresh) (defun gitolite-clone-get-projects (&optional username host force-refresh)
(unless username (setq username gitolite-clone:username)) "Retrieve and parse the list of projects available from gitolite.
(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) USERNAME is the username used on the gitolite server and HOST is
(completing-read "Choose a repository:" (gitolite-clone:get-projects username host))) 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 ;;;###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) (interactive)
(unless username (setq username gitolite-clone:username)) (unless username (setq username gitolite-clone-username))
(unless host (setq host gitolite-clone:host)) (unless host (setq host gitolite-clone-host))
(unless determine-target (setq determine-target gitolite-clone:determine-target)) (unless determine-target (setq determine-target gitolite-clone-determine-target))
(unless action (setq action gitolite-clone:action)) (unless action (setq action gitolite-clone-action))
(let* ((repository (gitolite-clone:select-repository)) (let* ((repository (gitolite-clone-select-repository))
(target (funcall determine-target username host 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) (unless (file-exists-p target)
(shell-command git-command)) (shell-command git-command))
(when (file-exists-p target) (when (file-exists-p target)