Simplify save-repositories-list
Simplify `save-repositories-list' by extracting some of the functionality into its own procedures. Since there is now a `repository-name<?' procedure the `repository<?' procedure is renamed to `repository-location<?' for clarity and accuracy, since that is what it really checks.
This commit is contained in:
parent
95125d682c
commit
9df3b848e0
3 changed files with 30 additions and 18 deletions
|
@ -37,7 +37,8 @@
|
|||
repo-location
|
||||
repo-name
|
||||
repository?
|
||||
repository<?
|
||||
repository-location<?
|
||||
repository-name<?
|
||||
same-repository?))
|
||||
|
||||
(define show-unchanged-branches? #f)
|
||||
|
@ -60,10 +61,14 @@
|
|||
(define (repository? repo)
|
||||
(is-a? repo <repository>))
|
||||
|
||||
(define (repository<? repo1 repo2)
|
||||
"Compary REPO1 and REPO2 to see if REPO1 should be considered smaller."
|
||||
(define (repository-location<? repo1 repo2)
|
||||
"Compary REPO1 and REPO2 to see if REPO1 should be considered less."
|
||||
(string<? (repo-location repo1) (repo-location repo2)))
|
||||
|
||||
(define (repository-name<? repo1 repo2)
|
||||
"Compare REPO1 and REPO2 to see if REPO1 should be considered less."
|
||||
(string<? (repo-name repo1) (repo-name repo2)))
|
||||
|
||||
(define-method (branch-pullable (branch <branch>))
|
||||
(force (slot-ref branch 'pullable)))
|
||||
|
||||
|
|
|
@ -43,7 +43,8 @@
|
|||
|
||||
(define (list-repository-locations)
|
||||
"List the registered locations of repositories."
|
||||
(for-each print-repository-location (sort repositories repository<?)))
|
||||
(for-each print-repository-location
|
||||
(sort repositories repository-location<?)))
|
||||
|
||||
(define (print-repository-location repo)
|
||||
"Print the location of REPO."
|
||||
|
@ -60,20 +61,10 @@
|
|||
|
||||
(define (save-repositories-list)
|
||||
"Save the list of repositories."
|
||||
(let ((dir (data-dir)))
|
||||
(unless (file-exists? dir)
|
||||
(mkdir dir)))
|
||||
|
||||
(ensure-directory-exists. (data-dir))
|
||||
;; Sort first
|
||||
(set! repositories
|
||||
(sort repositories
|
||||
(lambda (s1 s2)
|
||||
(string<? (repo-name s1) (repo-name s2)))))
|
||||
|
||||
(let ((port (open-output-file repositories-file))
|
||||
(repos (map repo-location repositories)))
|
||||
(write repos port)
|
||||
(close-port port)))
|
||||
(set! repositories (sort repositories repository-name<?))
|
||||
(write-repositories!))
|
||||
|
||||
(define (show-global-config)
|
||||
"Show the template specified in `global-config'."
|
||||
|
@ -112,6 +103,13 @@ Don't do anything if REPO has been added to `config-exclusion-list'."
|
|||
"Check if REPO is or could be made usable as a repository."
|
||||
(or (repository? repo) (string? repo)))
|
||||
|
||||
(define (write-repositories!)
|
||||
"Write the repositories to the repositories file."
|
||||
(let ((port (open-output-file repositories-file))
|
||||
(repos (map repo-location repositories)))
|
||||
(write repos port)
|
||||
(close-port port)))
|
||||
|
||||
(define config-exclusion-list '())
|
||||
(define repositories-file (data-file "repos.scm"))
|
||||
|
||||
|
|
|
@ -17,6 +17,15 @@
|
|||
;; along with gitto. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gitto path)
|
||||
#:export (realpath))
|
||||
#:export (realpath
|
||||
ensure-directory-exists.))
|
||||
|
||||
(load-extension "libguile-gitto-path" "init_gitto")
|
||||
|
||||
(define (ensure-directory-exists. path)
|
||||
"Make sure PATH exists.
|
||||
|
||||
Check if PATH exists, and if so do nothing. If PATH doesn't exist,
|
||||
create it."
|
||||
(unless (file-exists? path)
|
||||
(mkdir path)))
|
||||
|
|
Loading…
Reference in a new issue