Update domain name to kpe.io

[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"
+                 (car (last (pathname-directory x))))
+        (string= ".git"
                  (car (last (pathname-directory x)))))))
 
 (defun is-cvs-managed (dir)
@@ -33,9 +35,14 @@
                     (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.
-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
@@ -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))
+             ((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))))))
@@ -76,6 +88,9 @@ Returns a list of directories managed by CVS or 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"))))
@@ -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
-                  (:svn
+                  ((:svn :git)
                    (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
@@ -103,7 +118,11 @@ Returns a list of directories managed by CVS or SVN."
            (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
@@ -123,6 +142,8 @@ Returns a list of directories managed by CVS or 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)