projects
/
vcs-tree.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
update upstream host name
[vcs-tree.git]
/
main.lisp
diff --git
a/main.lisp
b/main.lisp
index 1490525d7f7665f689ace5d01c1a83874ae40c33..861fcd280b9044fa9fd7d9cdafb897bade2cae06 100644
(file)
--- a/
main.lisp
+++ b/
main.lisp
@@
-21,6
+21,8
@@
(string= "CVS"
(car (last (pathname-directory x))))
(string= ".svn"
(string= "CVS"
(car (last (pathname-directory x))))
(string= ".svn"
+ (car (last (pathname-directory x))))
+ (string= ".git"
(car (last (pathname-directory x)))))))
(defun is-cvs-managed (dir)
(car (last (pathname-directory x)))))))
(defun is-cvs-managed (dir)
@@
-33,9
+35,14
@@
(make-pathname :directory '(:relative ".svn"))
dir)))
(make-pathname :directory '(:relative ".svn"))
dir)))
+(defun is-git-managed (dir)
+ (probe-directory (merge-pathnames
+ (make-pathname :directory '(:relative ".git"))
+ dir)))
+
(defun filter-tree (tree)
"Called for a directory tree. First argument is name of current tree.
(defun filter-tree (tree)
"Called for a directory tree. First argument is name of current tree.
-Returns a list of directories managed by CVS
or SVN
."
+Returns a list of directories managed by CVS
, SVN, or GIT
."
(when (and (listp tree) (not (is-vcs-directory (car tree))))
(let* ((managed-pair
(cond
(when (and (listp tree) (not (is-vcs-directory (car tree))))
(let* ((managed-pair
(cond
@@
-44,6
+51,11
@@
Returns a list of directories managed by CVS or SVN."
(car (last (pathname-directory (car x))))))
:test 'equal)
(cons (car tree) :svn))
(car (last (pathname-directory (car x))))))
:test 'equal)
(cons (car tree) :svn))
+ ((find ".git" (cdr tree)
+ :key (lambda (x) (when (pathnamep (car x))
+ (car (last (pathname-directory (car x))))))
+ :test 'equal)
+ (cons (car tree) :git))
((find "CVS" (cdr tree)
:key (lambda (x) (when (pathnamep (car x))
(car (last (pathname-directory (car x))))))
((find "CVS" (cdr tree)
:key (lambda (x) (when (pathnamep (car x))
(car (last (pathname-directory (car x))))))
@@
-76,6
+88,9
@@
Returns a list of directories managed by CVS or SVN."
(:svn
(make-pathname :name "entries" :type nil
:directory '(:relative ".svn")))
(:svn
(make-pathname :name "entries" :type nil
:directory '(:relative ".svn")))
+ (:git
+ (make-pathname :name "HEAD" :type nil
+ :directory '(:relative ".git")))
(:cvs
(make-pathname :name "Entries" :type nil
:directory '(:relative "CVS"))))
(:cvs
(make-pathname :name "Entries" :type nil
:directory '(:relative "CVS"))))
@@
-83,12
+98,12
@@
Returns a list of directories managed by CVS or SVN."
(entries (read-file-to-strings entries-path))
(dir-name (car (last (pathname-directory subdir))))
(match (case type
(entries (read-file-to-strings entries-path))
(dir-name (car (last (pathname-directory subdir))))
(match (case type
- (
:svn
+ (
(:svn :git)
(concatenate 'string "name=\"" dir-name "\""))
(:cvs
(concatenate 'string "D/" dir-name "////")))))
(case type
(concatenate 'string "name=\"" dir-name "\""))
(:cvs
(concatenate 'string "D/" dir-name "////")))))
(case type
- (
:svn
+ (
(:svn :git)
(some (lambda (line) (string= match (string-trim-whitespace line)))
entries))
(:cvs
(some (lambda (line) (string= match (string-trim-whitespace line)))
entries))
(:cvs
@@
-103,7
+118,11
@@
Returns a list of directories managed by CVS or SVN."
(let* ((vcs-cmd
(ecase action
(:update
(let* ((vcs-cmd
(ecase action
(:update
- (format nil "~A update" type-name))
+ (cond
+ ((equal type-name "git")
+ (format nil "~A pull" type-name))
+ (t
+ (format nil "~A update" type-name))))
(:status
(format nil "~A status" type-name))
(:commit
(:status
(format nil "~A status" type-name))
(:commit
@@
-123,6
+142,8
@@
Returns a list of directories managed by CVS or SVN."
(process dir "cvs"))
((is-svn-managed dir)
(process dir "svn"))
(process dir "cvs"))
((is-svn-managed dir)
(process dir "svn"))
+ ((is-git-managed dir)
+ (process dir "git"))
(t
(format *error-output*
"INTERAL ERROR: not a version control system directory ~A" dir)
(t
(format *error-output*
"INTERAL ERROR: not a version control system directory ~A" dir)