;;;;
;;;; Process all subdirectories that are managed by either CVS or SVN
;;;;
-;;;; $Id: xlunit.asd 7061 2003-09-07 06:34:45Z kevin $
+;;;; $Id$
;;;; *************************************************************************
(defun process-vcs-directory (dir action options)
(flet ((process (dir type-name)
- (let ((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))
- ""))))))
+ (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)
+ (shell-command-output cmd :directory dir :whole t)
(if (zerop status)
- (format t "~A ~A: ~A~%" cmd (namestring dir) output)
- (format t "~A ~A: ~A ~A ~A~%" cmd (namestring dir) output
- error status))))))
+ (format t "~A~%" output)
+ (format t "Exit status ~D: ~A ~A~%" status output error))))))
(cond
((is-cvs-managed dir)
(process dir "cvs"))