r11859: Canonicalize whitespace
authorKevin M. Rosenberg <kevin@rosenberg.net>
Fri, 31 Aug 2007 18:04:31 +0000 (18:04 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Fri, 31 Aug 2007 18:04:31 +0000 (18:04 +0000)
getopt-excerpt.lisp
kmrcl-excerpt.lisp
main.lisp

index d59efeefc2832d1b69863ef58eafbb909aa06c29..0f8ca64faa324d92790cc08cdab50a9d6adbda7e 100644 (file)
@@ -3,7 +3,7 @@
 ;;;; FILE IDENTIFICATION
 ;;;;
 ;;;; Name:          getopt.lisp
 ;;;; FILE IDENTIFICATION
 ;;;;
 ;;;; Name:          getopt.lisp
-;;;; Purpose:       Excerpted from cl-getopt package 
+;;;; Purpose:       Excerpted from cl-getopt package
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Sep 2003
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Sep 2003
 ;;;;
 (defun decompose-arg (arg option-type)
   "Returns base-name,argument"
   (let ((start (ecase option-type
 (defun decompose-arg (arg option-type)
   "Returns base-name,argument"
   (let ((start (ecase option-type
-                (:long 2)
-                (:short 1)))
-       (name-end (position #\= arg)))
+                 (:long 2)
+                 (:short 1)))
+        (name-end (position #\= arg)))
 
     (values (subseq arg start name-end)
 
     (values (subseq arg start name-end)
-           (when name-end (subseq arg (1+ name-end))))))
+            (when name-end (subseq arg (1+ name-end))))))
 
 (defun analyze-arg (arg)
   "Analyzes an argument. Returns option-type,base-name,argument"
   (let* ((option-type (cond ((is-short-option arg) :short)
 
 (defun analyze-arg (arg)
   "Analyzes an argument. Returns option-type,base-name,argument"
   (let* ((option-type (cond ((is-short-option arg) :short)
-                           ((is-long-option arg) :long)
-                           (t :arg))))
+                            ((is-long-option arg) :long)
+                            (t :arg))))
     (if (or (eq option-type :short) (eq option-type :long))
     (if (or (eq option-type :short) (eq option-type :long))
-       (multiple-value-bind (base arg) (decompose-arg arg option-type)
-         (values option-type base arg))
-       (values :arg arg nil))))
+        (multiple-value-bind (base arg) (decompose-arg arg option-type)
+          (values option-type base arg))
+        (values :arg arg nil))))
 
 
 (defun find-option (name options)
   "Find an option in option list. Handles using unique abbreviations"
   (let* ((option-names (mapcar #'car options))
 
 
 (defun find-option (name options)
   "Find an option in option list. Handles using unique abbreviations"
   (let* ((option-names (mapcar #'car options))
-        (pos (match-unique-abbreviation name option-names)))
+         (pos (match-unique-abbreviation name option-names)))
     (when pos
       (nth pos options))))
 
     (when pos
       (nth pos options))))
 
   "Returns position of ABBR in STRINGS. ABBR may be a unique abbreviation.
 Returns NIL if no match found."
   (let ((len (length abbr))
   "Returns position of ABBR in STRINGS. ABBR may be a unique abbreviation.
 Returns NIL if no match found."
   (let ((len (length abbr))
-       (matches nil))
+        (matches nil))
     (dotimes (i (length strings))
       (let* ((s (nth i strings))
     (dotimes (i (length strings))
       (let* ((s (nth i strings))
-            (l (length s)))
-       (cond
-         ((= len l)
-          (when (string= abbr s)
-            (push (cons s i) matches)))
-         ((< len l)
-          (when (string= abbr (subseq s 0 len))
-            (push (cons s i) matches))))))
+             (l (length s)))
+        (cond
+          ((= len l)
+           (when (string= abbr s)
+             (push (cons s i) matches)))
+          ((< len l)
+           (when (string= abbr (subseq s 0 len))
+             (push (cons s i) matches))))))
     (when (= 1 (length matches))
       (cdr (first matches)))))
 
     (when (= 1 (length matches))
       (cdr (first matches)))))
 
@@ -106,31 +106,31 @@ opts is a list of option lists. The fields of the list are
       (setq finished-options t))
      (t
       (let ((arg (car pos)))
       (setq finished-options t))
      (t
       (let ((arg (car pos)))
-       (multiple-value-bind (option-list option-type base-name argument)
-           (match-option (car pos) options)
-         (cond
-           (option-list
-            (cond
-              (argument
-               (case (second option-list)
-                 (:none
-                  (push base-name errors))
-                 (t
-                  (push (cons base-name argument) out-opts))))
-              ((null argument)
-               (if (and (eq :required (second option-list)) (null (cdr pos)))
-                   (push base-name errors)
-                   (if (or (is-short-option (second pos))
-                           (is-long-option (second pos)))
-                       (if (eq :required (second option-list))
-                           (push base-name errors)
-                           (push (cons base-name (third option-list)) out-args))
-                       (progn
-                         (push (cons base-name (second pos)) out-opts)
-                         (setq pos (cdr pos))))))))
-           (t
-            (if (or (eq :long option-type)
-                    (eq :short option-type))
-                (push (nth-value 0 (decompose-arg arg option-type)) errors)
-              (push arg out-args))))))))))
+        (multiple-value-bind (option-list option-type base-name argument)
+            (match-option (car pos) options)
+          (cond
+            (option-list
+             (cond
+               (argument
+                (case (second option-list)
+                  (:none
+                   (push base-name errors))
+                  (t
+                   (push (cons base-name argument) out-opts))))
+               ((null argument)
+                (if (and (eq :required (second option-list)) (null (cdr pos)))
+                    (push base-name errors)
+                    (if (or (is-short-option (second pos))
+                            (is-long-option (second pos)))
+                        (if (eq :required (second option-list))
+                            (push base-name errors)
+                            (push (cons base-name (third option-list)) out-args))
+                        (progn
+                          (push (cons base-name (second pos)) out-opts)
+                          (setq pos (cdr pos))))))))
+            (t
+             (if (or (eq :long option-type)
+                     (eq :short option-type))
+                 (push (nth-value 0 (decompose-arg arg option-type)) errors)
+               (push arg out-args))))))))))
 
 
index 9a74e8cda31f8417a67cd539a01eff4c28c4622c..d425d7101f683275f4ac5a2fe946ca1e3a4915c3 100644 (file)
   (let ((lines '()))
     (with-open-file (in file :direction :input)
       (let ((eof (gensym)))
   (let ((lines '()))
     (with-open-file (in file :direction :input)
       (let ((eof (gensym)))
-       (do ((line (read-line in nil eof)
-                  (read-line in nil eof)))
-           ((eq line eof))
-         (push line lines)))
+        (do ((line (read-line in nil eof)
+                   (read-line in nil eof)))
+            ((eq line eof))
+          (push line lines)))
       (nreverse lines))))
 
 
       (nreverse lines))))
 
 
@@ -35,9 +35,9 @@
 
 (defun flatten (lis)
   (cond ((atom lis) lis)
 
 (defun flatten (lis)
   (cond ((atom lis) lis)
-       ((listp (car lis))
-        (append (flatten (car lis)) (flatten (cdr lis))))
-       (t (append (list (car lis)) (flatten (cdr lis))))))
+        ((listp (car lis))
+         (append (flatten (car lis)) (flatten (cdr lis))))
+        (t (append (list (car lis)) (flatten (cdr lis))))))
 
 (defun mklist (obj)
   "Make into list if atom"
 
 (defun mklist (obj)
   "Make into list if atom"
 (defun directory-tree (filename)
   "Returns a tree of pathnames for sub-directories of a directory"
   (let* ((root (canonicalize-directory-name filename))
 (defun directory-tree (filename)
   "Returns a tree of pathnames for sub-directories of a directory"
   (let* ((root (canonicalize-directory-name filename))
-        (subdirs (loop for path in (directory
-                                    (make-pathname :name :wild
-                                                   :type :wild
-                                                   :defaults root))
-                       when (probe-directory path)
-                       collect (canonicalize-directory-name path))))
+         (subdirs (loop for path in (directory
+                                     (make-pathname :name :wild
+                                                    :type :wild
+                                                    :defaults root))
+                        when (probe-directory path)
+                        collect (canonicalize-directory-name path))))
     (when (find nil subdirs)
       (error "~A" subdirs))
     (when (null root)
       (error "~A" root))
     (if subdirs
     (when (find nil subdirs)
       (error "~A" subdirs))
     (when (null root)
       (error "~A" root))
     (if subdirs
-       (cons root (mapcar #'directory-tree subdirs))
-       (if (probe-directory root)
-           (list root)
-           (error "root not directory ~A" root)))))
+        (cons root (mapcar #'directory-tree subdirs))
+        (if (probe-directory root)
+            (list root)
+            (error "root not directory ~A" root)))))
 
 
 (defun canonicalize-directory-name (filename)
   (flet ((un-unspecific (value)
 
 
 (defun canonicalize-directory-name (filename)
   (flet ((un-unspecific (value)
-          (if (eq value :unspecific) nil value)))
+           (if (eq value :unspecific) nil value)))
     (let* ((path (pathname filename))
     (let* ((path (pathname filename))
-          (name (un-unspecific (pathname-name path)))
-          (type (un-unspecific (pathname-type path)))
-          (new-dir
-           (cond ((and name type) (list (concatenate 'string name "." type)))
-                 (name (list name))
-                 (type (list type))
-                 (t nil))))
+           (name (un-unspecific (pathname-name path)))
+           (type (un-unspecific (pathname-type path)))
+           (new-dir
+            (cond ((and name type) (list (concatenate 'string name "." type)))
+                  (name (list name))
+                  (type (list type))
+                  (t nil))))
       (if new-dir
       (if new-dir
-         (make-pathname
-          :directory (append (un-unspecific (pathname-directory path))
-                             new-dir)
-                   :name nil :type nil :version nil :defaults path)
-         path))))
+          (make-pathname
+           :directory (append (un-unspecific (pathname-directory path))
+                              new-dir)
+                    :name nil :type nil :version nil :defaults path)
+          path))))
 
 
 (defun probe-directory (filename)
   (let ((path (canonicalize-directory-name filename)))
     #+allegro (excl:probe-directory path)
     #+clisp (values
 
 
 (defun probe-directory (filename)
   (let ((path (canonicalize-directory-name filename)))
     #+allegro (excl:probe-directory path)
     #+clisp (values
-            (ignore-errors
-              (#+lisp=cl ext:probe-directory #-lisp=cl lisp:probe-directory
-                         path)))
+             (ignore-errors
+               (#+lisp=cl ext:probe-directory #-lisp=cl lisp:probe-directory
+                          path)))
     #+(or cmu scl) (eq :directory (unix:unix-file-kind (namestring path)))
     #+lispworks (lw:file-directory-p path)
     #+sbcl (eq :directory (sb-unix:unix-file-kind (namestring path)))
     #+(or cmu scl) (eq :directory (unix:unix-file-kind (namestring path)))
     #+lispworks (lw:file-directory-p path)
     #+sbcl (eq :directory (sb-unix:unix-file-kind (namestring path)))
   (cond
    ((not (null dir))
     (when (and (typep dir 'logical-pathname)
   (cond
    ((not (null dir))
     (when (and (typep dir 'logical-pathname)
-              (translate-logical-pathname dir))
+               (translate-logical-pathname dir))
       (setq dir (translate-logical-pathname dir)))
     (when (stringp dir)
       (setq dir (parse-namestring dir)))
       (setq dir (translate-logical-pathname dir)))
     (when (stringp dir)
       (setq dir (parse-namestring dir)))
     (setq cl:*default-pathname-defaults* dir))
    (t
     (let ((dir
     (setq cl:*default-pathname-defaults* dir))
    (t
     (let ((dir
-          #+allegro (excl:current-directory)
-          #+clisp (#+lisp=cl ext:default-directory #-lisp=cl lisp:default-directory)
-          #+(or cmu scl) (ext:default-directory)
-          #+sbcl (sb-unix:posix-getcwd/)
-          #+cormanlisp (ccl:get-current-directory)
-          #+lispworks (hcl:get-working-directory)
-          #+mcl (ccl:mac-default-directory)
-          #-(or allegro clisp cmu scl cormanlisp mcl sbcl lispworks) (truename ".")))
+           #+allegro (excl:current-directory)
+           #+clisp (#+lisp=cl ext:default-directory #-lisp=cl lisp:default-directory)
+           #+(or cmu scl) (ext:default-directory)
+           #+sbcl (sb-unix:posix-getcwd/)
+           #+cormanlisp (ccl:get-current-directory)
+           #+lispworks (hcl:get-working-directory)
+           #+mcl (ccl:mac-default-directory)
+           #-(or allegro clisp cmu scl cormanlisp mcl sbcl lispworks) (truename ".")))
       (when (stringp dir)
       (when (stringp dir)
-       (setq dir (parse-namestring dir)))
+        (setq dir (parse-namestring dir)))
       dir))))
 
 
       dir))))
 
 
   #+allegro (excl.osi:command-output cmd :directory directory :whole whole)
   #+sbcl
   (let* ((out (make-array '(0) :element-type 'character :fill-pointer 0
   #+allegro (excl.osi:command-output cmd :directory directory :whole whole)
   #+sbcl
   (let* ((out (make-array '(0) :element-type 'character :fill-pointer 0
-                         :adjustable t))
-        (err (make-array '(0) :element-type 'character :fill-pointer 0
-                         :adjustable t))
-       (status
-        (sb-impl::process-exit-code
-         (with-output-to-string (out-stream out)
-           (with-output-to-string (err-stream err)
-             (sb-ext:run-program
-              "/bin/sh"
-              (list  "-c" cmd)
-              :input nil :output out-stream :error err-stream))))))
+                          :adjustable t))
+         (err (make-array '(0) :element-type 'character :fill-pointer 0
+                          :adjustable t))
+        (status
+         (sb-impl::process-exit-code
+          (with-output-to-string (out-stream out)
+            (with-output-to-string (err-stream err)
+              (sb-ext:run-program
+               "/bin/sh"
+               (list  "-c" cmd)
+               :input nil :output out-stream :error err-stream))))))
     (values out err status))
   )
     (values out err status))
   )
index a6cf82f19533decbaa14bc844c2aa6c2a002d102..1490525d7f7665f689ace5d01c1a83874ae40c33 100644 (file)
--- a/main.lisp
+++ b/main.lisp
 (defun is-vcs-directory (x)
   (and (pathnamep x)
        (or
 (defun is-vcs-directory (x)
   (and (pathnamep x)
        (or
-       (string= "CVS" 
-                (car (last (pathname-directory x))))
-       (string= ".svn" 
-                (car (last (pathname-directory x)))))))
+        (string= "CVS"
+                 (car (last (pathname-directory x))))
+        (string= ".svn"
+                 (car (last (pathname-directory x)))))))
 
 (defun is-cvs-managed (dir)
   (probe-directory (merge-pathnames
 
 (defun is-cvs-managed (dir)
   (probe-directory (merge-pathnames
-                   (make-pathname :directory '(:relative "CVS"))
-                   dir)))
+                    (make-pathname :directory '(:relative "CVS"))
+                    dir)))
 
 (defun is-svn-managed (dir)
   (probe-directory (merge-pathnames
 
 (defun is-svn-managed (dir)
   (probe-directory (merge-pathnames
-                   (make-pathname :directory '(:relative ".svn"))
-                   dir)))
+                    (make-pathname :directory '(:relative ".svn"))
+                    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."
   (when (and (listp tree) (not (is-vcs-directory (car tree))))
     (let* ((managed-pair
 
 (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."
   (when (and (listp tree) (not (is-vcs-directory (car tree))))
     (let* ((managed-pair
-           (cond
-            ((find ".svn" (cdr tree)
-                   :key (lambda (x) (when (pathnamep (car x))
-                                      (car (last (pathname-directory (car x))))))
-                   :test 'equal)
-             (cons (car tree) :svn))
-            ((find "CVS" (cdr tree) 
-                   :key (lambda (x) (when (pathnamep (car x))
-                                      (car (last (pathname-directory (car x))))))
-                   :test 'equal)
-             (cons (car tree) :cvs))))
-          (managed (car managed-pair))
-          (type (cdr managed-pair)))
+            (cond
+             ((find ".svn" (cdr tree)
+                    :key (lambda (x) (when (pathnamep (car x))
+                                       (car (last (pathname-directory (car x))))))
+                    :test 'equal)
+              (cons (car tree) :svn))
+             ((find "CVS" (cdr tree)
+                    :key (lambda (x) (when (pathnamep (car x))
+                                       (car (last (pathname-directory (car x))))))
+                    :test 'equal)
+              (cons (car tree) :cvs))))
+           (managed (car managed-pair))
+           (type (cdr managed-pair)))
       (let ((vcs-removed
       (let ((vcs-removed
-            (do* ((pos (cdr tree) (cdr pos))
-                  (curr (car pos) (car pos))
-                  (res nil))
-                ((null pos) (nreverse res))
-              (when (and (not (is-vcs-directory (car curr)))
-                         (or (not managed)
-                             (not (is-managed-dir (car curr) managed type))))
-                (push curr res)))))
-       (if vcs-removed
-           (if managed
-               (cons managed (flatten 
-                              (delete-if #'null
-                                         (mapcar 'filter-tree vcs-removed))))
-             (flatten (delete-if #'null (mapcar 'filter-tree vcs-removed))))
-         managed))
+             (do* ((pos (cdr tree) (cdr pos))
+                   (curr (car pos) (car pos))
+                   (res nil))
+                 ((null pos) (nreverse res))
+               (when (and (not (is-vcs-directory (car curr)))
+                          (or (not managed)
+                              (not (is-managed-dir (car curr) managed type))))
+                 (push curr res)))))
+        (if vcs-removed
+            (if managed
+                (cons managed (flatten
+                               (delete-if #'null
+                                          (mapcar 'filter-tree vcs-removed))))
+              (flatten (delete-if #'null (mapcar 'filter-tree vcs-removed))))
+          managed))
       )))
 
 (defun is-managed-dir (subdir dir type)
   (let* ((entries-path
       )))
 
 (defun is-managed-dir (subdir dir type)
   (let* ((entries-path
-         (merge-pathnames
-          (ecase type
-            (:svn 
-             (make-pathname :name "entries" :type nil
-                            :directory '(:relative ".svn")))
-            (:cvs 
-             (make-pathname :name "Entries" :type nil
-                            :directory '(:relative "CVS"))))
-          dir))
-        (entries (read-file-to-strings entries-path))
-        (dir-name (car (last (pathname-directory subdir))))
-        (match (case type
-                 (:svn
-                  (concatenate 'string "name=\"" dir-name "\""))
-                 (:cvs
-                  (concatenate 'string "D/" dir-name "////")))))
+          (merge-pathnames
+           (ecase type
+             (:svn
+              (make-pathname :name "entries" :type nil
+                             :directory '(:relative ".svn")))
+             (:cvs
+              (make-pathname :name "Entries" :type nil
+                             :directory '(:relative "CVS"))))
+           dir))
+         (entries (read-file-to-strings entries-path))
+         (dir-name (car (last (pathname-directory subdir))))
+         (match (case type
+                  (:svn
+                   (concatenate 'string "name=\"" dir-name "\""))
+                  (:cvs
+                   (concatenate 'string "D/" dir-name "////")))))
     (case type
       (:svn
        (some (lambda (line) (string= match (string-trim-whitespace line)))
     (case type
       (:svn
        (some (lambda (line) (string= match (string-trim-whitespace line)))
-            entries))
+             entries))
       (:cvs
        (or
       (:cvs
        (or
-       (some (lambda (line) (string= match (string-trim-whitespace line)))
-             entries)
-       (is-cvs-managed subdir))))))
+        (some (lambda (line) (string= match (string-trim-whitespace line)))
+              entries)
+        (is-cvs-managed subdir))))))
 
 
 (defun process-vcs-directory (dir action options)
   (flet ((process (dir type-name)
 
 
 (defun process-vcs-directory (dir action options)
   (flet ((process (dir type-name)
-          (let* ((vcs-cmd
-                  (ecase action
-                    (:update
-                     (format nil "~A update" type-name)) 
-                    (:status
-                     (format nil "~A status" type-name)) 
-                    (:commit
-                     (format nil "~A commit~A" type-name
-                             (aif (find "m" options :key #'car :test 'string=)
-                                  (format nil " -m \"~A\"" (cdr it))
-                                  "")))))
-                 (cmd (format nil "(cd ~A; ~A)" (namestring dir) vcs-cmd)))
-            (format t "~A ~A:~%" vcs-cmd (namestring dir))
-            (multiple-value-bind (output error status)
-                (shell-command-output cmd :directory dir :whole t)
-              (if (zerop status)
-                  (format t "~A~%" output)
-                  (format t "Exit status ~D: ~A ~A~%" status output error))))))
+           (let* ((vcs-cmd
+                   (ecase action
+                     (:update
+                      (format nil "~A update" type-name))
+                     (:status
+                      (format nil "~A status" type-name))
+                     (:commit
+                      (format nil "~A commit~A" type-name
+                              (aif (find "m" options :key #'car :test 'string=)
+                                   (format nil " -m \"~A\"" (cdr it))
+                                   "")))))
+                  (cmd (format nil "(cd ~A; ~A)" (namestring dir) vcs-cmd)))
+             (format t "~A ~A:~%" vcs-cmd (namestring dir))
+             (multiple-value-bind (output error status)
+                 (shell-command-output cmd :directory dir :whole t)
+               (if (zerop status)
+                   (format t "~A~%" output)
+                   (format t "Exit status ~D: ~A ~A~%" status output error))))))
     (cond
       ((is-cvs-managed dir)
        (process dir "cvs"))
     (cond
       ((is-cvs-managed dir)
        (process dir "cvs"))
@@ -125,7 +125,7 @@ Returns a list of directories managed by CVS or SVN."
       (process dir "svn"))
      (t
       (format *error-output*
       (process dir "svn"))
      (t
       (format *error-output*
-             "INTERAL ERROR: not a version control system directory ~A" dir)
+              "INTERAL ERROR: not a version control system directory ~A" dir)
       (quit 1)))))
 
 (defvar *progname* "")
       (quit 1)))))
 
 (defvar *progname* "")
@@ -134,10 +134,10 @@ Returns a list of directories managed by CVS or SVN."
   (format *error-output* "usage: ~A action [OPTIONS]~%" *progname*)
   (if msg
       (progn
   (format *error-output* "usage: ~A action [OPTIONS]~%" *progname*)
   (if msg
       (progn
-       (apply #'format *error-output* msg msg-args)
-       (write-char #\Newline *error-output*))
+        (apply #'format *error-output* msg msg-args)
+        (write-char #\Newline *error-output*))
       (format *error-output*
       (format *error-output*
-             "Processes a source-control managed directory tree~%"))
+              "Processes a source-control managed directory tree~%"))
   (format *error-output* "Action: update, commit, or status~%")
   (format *error-output* "OPTIONS~%")
   (format *error-output* "   -m <str>    Set commit string~%"))
   (format *error-output* "Action: update, commit, or status~%")
   (format *error-output* "OPTIONS~%")
   (format *error-output* "   -m <str>    Set commit string~%"))
@@ -149,27 +149,27 @@ Returns a list of directories managed by CVS or SVN."
     (t
      (let ((pos (match-unique-abbreviation arg '("update" "commit" "status"))))
        (cond
     (t
      (let ((pos (match-unique-abbreviation arg '("update" "commit" "status"))))
        (cond
-        ((eql pos 0) :update)
-        ((eql pos 1) :commit)
-        ((eql pos 2) :status)
-        (t
-         (usage "Unknown action: ~A" arg)
-         (quit 1)))))))
+         ((eql pos 0) :update)
+         ((eql pos 1) :commit)
+         ((eql pos 2) :status)
+         (t
+          (usage "Unknown action: ~A" arg)
+          (quit 1)))))))
 
 
 (defun main (&optional (argv (command-line-arguments)))
   (let ((*progname* (car argv)))
     (multiple-value-bind (args options errors)
 
 
 (defun main (&optional (argv (command-line-arguments)))
   (let ((*progname* (car argv)))
     (multiple-value-bind (args options errors)
-       (getopt (cdr argv) '(("m" :required)))
+        (getopt (cdr argv) '(("m" :required)))
       (when (or errors (/= 1 (length args)))
       (when (or errors (/= 1 (length args)))
-       (usage)
-       (quit 1))
+        (usage)
+        (quit 1))
       (let ((action (parse-action-arg (first args))))
       (let ((action (parse-action-arg (first args))))
-       (unless action
-         (usage "Invalid action ~A" (first args))
-         (quit 1))
-       (dolist (dir (mklist (filter-tree (directory-tree (cwd)))))
-         (process-vcs-directory dir action options))))
+        (unless action
+          (usage "Invalid action ~A" (first args))
+          (quit 1))
+        (dolist (dir (mklist (filter-tree (directory-tree (cwd)))))
+          (process-vcs-directory dir action options))))
     (quit 0)))
 
 ;;(main)
     (quit 0)))
 
 ;;(main)