--- /dev/null
+This program requires the SBCL Common Lisp system (http://www.sbcl.org)
+to compile and run. Because of its use of a new feature in the
+sb-executable module, vcs-tree requires SBCL version 0.8.3.55 or greater.
+
+Once you have SBCL installed on your system, you can give the command
+ make
+which will create the executable file "vcs-tree". You can then copy
+that file to any directory in your path, such as /usr/local/bin/
--- /dev/null
+##############################################################################
+# FILE IDENTIFICATION
+#
+# Name: Makefile
+# Purpose: Makefile for the vcs-tree, creates binary executable
+# Author: Kevin M. Rosenberg
+# Date Started: Sep 2003
+#
+# $Id: Makefile 7061 2003-09-07 06:34:45Z kevin $
+##############################################################################
+
+
+pkg :=vcs-tree
+sources :=$(pkg).asd main.lisp loader.lisp package.lisp kmrcl-excerpt.lisp
+
+$(pkg): $(sources)
+ $(MAKE) clean
+ sbcl --load "$(pkg).asd" --eval "(asdf:oos 'asdf:load-op '$(pkg))" --eval "(sb-ext:quit :unix-status 0)"
+
+clean:
+ rm -f *.fasl $(pkg)
--- /dev/null
+vcs-tree (0.1-1) unstable; urgency=low
+
+ * Initial upload
+
+ -- Kevin M. Rosenberg <kmr@debian.org> Fri, 12 Sep 2003 08:26:41 -0600
--- /dev/null
+Source: vcs-tree
+Section: devel
+Priority: optional
+Maintainer: Kevin M. Rosenberg <kmr@debian.org>
+Build-Depends: debhelper (>> 4.0.0), sbcl
+Standards-Version: 3.6.1.0
+
+Package: vcs-tree
+Architecture: i386 sparc powerpc mips mipsel alpha
+Depends: ${shlibs:Depends}, sbcl (>= 0.8.3.53)
+Description: Version Control System Tree Walker
+ vcs-tree walks through a directory tree and performs actions on CVS
+ or Subversion directories. vcs-tree works differently than just using
+ CVS or Subversion since vcs-tree finds and processes directories
+ that are below non-version control system managed directories.
--- /dev/null
+Debian Copyright Section
+========================
+
+Upstream Source URL: http://files.b9.com/vcs-tree/
+Upstream Authors: Kevin M. Rosenberg <kevin@rosenberg.net>
+Debian Maintainer: Kevin M. Rosenberg <kmr@debian.org>
+
+
+Upstream Copyright Statement
+============================
+Copyright (c) 2003 Kevin M. Rosenberg <kevin@rosenberg.net>
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+3. Neither the name of the author nor the names of the contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGE.
--- /dev/null
+#!/usr/bin/make -f
+
+pkg := vcs-tree
+debpkg := vcs-tree
+
+
+bin-dir := usr/bin
+doc-dir := usr/share/doc/$(debpkg)
+
+
+configure: configure-stamp
+configure-stamp:
+ dh_testdir
+ # Add here commands to configure the package.
+ touch configure-stamp
+
+
+build: build-stamp
+
+build-stamp: configure-stamp
+ dh_testdir
+ # Add here commands to compile the package.
+ $(MAKE) ${pkg}
+ touch build-stamp
+
+clean:
+ dh_testdir
+ dh_testroot
+ rm -f build-stamp configure-stamp
+ # Add here commands to clean up after the build process.
+ $(MAKE) clean
+ rm -f debian/${debpkg}.postinst.* debian/${debpkg}.prerm.*
+ dh_clean
+
+install: build
+ dh_testdir
+ dh_testroot
+ dh_clean -k
+ # Add here commands to install the package into debian/xlunit.
+ dh_installdirs $(bin-dir)
+ dh_install ${pkg} $(bin-dir)
+
+# Build architecture-independent files here.
+binary-indep: build install
+
+
+# Build architecture-dependent files here.
+binary-arch: build install
+ dh_testdir
+ dh_testroot
+# dh_installdebconf
+ dh_installdocs
+ dh_installexamples
+# dh_installmenu
+# dh_installlogrotate
+# dh_installemacsen
+# dh_installpam
+# dh_installmime
+# dh_installinit
+# dh_installcron
+ dh_installman ${pkg}.1
+# dh_installinfo
+# dh_undocumented
+ dh_installchangelogs
+ dh_strip
+ dh_compress
+ dh_fixperms
+# dh_makeshlibs
+ dh_installdeb
+# dh_perl
+ dh_shlibdeps
+ dh_gencontrol
+ dh_md5sums
+ dh_builddeb
+
+binary: binary-indep binary-arch
+.PHONY: build clean binary-indep binary-arch binary install configure
+
--- /dev/null
+#!/bin/sh
+set -e
+
+dup vcs-tree -Uftp.med-info.com -D/home/ftp/vcs-tree -C"/home/kevin/bin/remove-old-versions vcs-tree latest" -su $*
--- /dev/null
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: getopt.lisp
+;;;; Purpose: Excerpted from cl-getopt package
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Sep 2003
+;;;;
+;;;; $Id: package.lisp 7814 2003-09-10 12:56:02Z kevin $
+;;;;
+;;;; *************************************************************************
+
+(in-package vcs-tree)
+
+
+(defun is-short-option (arg)
+ (and (>= (length arg) 2)
+ (char= #\- (schar arg 0))
+ (char/= #\- (schar arg 1))))
+
+(defun is-option-terminator (arg)
+ (and (= 2 (length arg))
+ (char= #\- (schar arg 0))
+ (char= #\- (schar arg 1))))
+
+(defun is-long-option (arg)
+ (and (> (length arg) 2)
+ (char= #\- (schar arg 0))
+ (char= #\- (schar arg 1))
+ (char/= #\- (schar arg 3))))
+
+(defun decompose-arg (arg option-type)
+ "Returns base-name,argument"
+ (let ((start (ecase option-type
+ (:long 2)
+ (:short 1)))
+ (name-end (position #\= arg)))
+
+ (values (subseq arg start 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)
+ ((is-long-option arg) :long)
+ (t :arg))))
+ (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))))
+
+
+(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)))
+ (when pos
+ (nth pos options))))
+
+(defun match-option (arg options)
+ "Matches an argument to an option. Returns option-list,option-type,base-name,argument"
+ (multiple-value-bind (option-type base-name argument) (analyze-arg arg)
+ (let ((match (find-option base-name options)))
+ (values match option-type (when match (car match)) argument))))
+
+
+;;; EXPORTED functions
+
+(defun match-unique-abbreviation (abbr strings)
+ "Returns position of ABBR in STRINGS. ABBR may be a unique abbreviation.
+Returns NIL if no match found."
+ (let ((len (length abbr))
+ (matches nil))
+ (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))))))
+ (when (= 1 (length matches))
+ (cdr (first matches)))))
+
+
+(defun getopt (args options)
+ "Processes a list of arguments and options. Returns filtered argument
+list and alist of options.
+opts is a list of option lists. The fields of the list are
+ - NAME name of the long option
+ - HAS-ARG with legal values of :NONE, :REQUIRED, :OPTIONAL
+ - VAL value to return for a option with no arguments"
+ (do ((pos args (cdr pos))
+ (finished-options)
+ (out-opts)
+ (out-args)
+ (errors))
+ ((null pos) (values (nreverse out-args) (nreverse out-opts) errors))
+ (cond
+ (finished-options
+ (push (car pos) out-args))
+ ((is-option-terminator (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))))))))))
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: vcs-tree -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: kmrcl-excerpt.lisp
+;;;; Purpose: Excerpted functions from KMRCL to support vcs-tree
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Sep 2003
+;;;;
+;;;; $Id: xlunit.asd 7061 2003-09-07 06:34:45Z kevin $
+;;;; *************************************************************************
+
+(in-package vcs-tree)
+
+(defun read-file-to-strings (file)
+ "Opens a reads a file. Returns the contents as a list of strings"
+ (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)))
+ (nreverse lines))))
+
+
+(defvar *whitespace-chars* '(#\space #\tab #\return #\linefeed))
+
+(defun string-trim-whitespace (str)
+ (string-trim *whitespace-chars* str))
+
+(defmacro aif (test then &optional else)
+ `(let ((it ,test))
+ (if it ,then ,else)))
+
+(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))))))
+
+(defun mklist (obj)
+ "Make into list if atom"
+ (if (listp obj) obj (list obj)))
+
+(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))))
+ (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)))))
+
+
+(defun canonicalize-directory-name (filename)
+ (flet ((un-unspecific (value)
+ (if (eq value :unspecific) nil value)))
+ (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))))
+ (if new-dir
+ (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
+ (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 allegro clisp cmu lispworks sbcl scl)
+ (probe-file path)))
+
+
+(defun cwd (&optional dir)
+ "Change directory and set default pathname"
+ (cond
+ ((not (null dir))
+ (when (and (typep dir 'logical-pathname)
+ (translate-logical-pathname dir))
+ (setq dir (translate-logical-pathname dir)))
+ (when (stringp dir)
+ (setq dir (parse-namestring dir)))
+ #+allegro (excl:chdir dir)
+ #+clisp (#+lisp=cl ext:cd #-lisp=cl lisp:cd dir)
+ #+(or cmu scl) (setf (ext:default-directory) dir)
+ #+cormanlisp (ccl:set-current-directory dir)
+ #+(and mcl (not openmcl)) (ccl:set-mac-default-directory dir)
+ #+openmcl (ccl:cwd dir)
+ #+gcl (si:chdir dir)
+ #+lispworks (hcl:change-directory 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 ".")))
+ (when (stringp dir)
+ (setq dir (parse-namestring dir)))
+ dir))))
+
+
+
+(defun quit (&optional (code 0))
+ "Function to exit the Lisp implementation. Copied from CLOCC's QUIT function."
+ #+allegro (excl:exit code :quiet t)
+ #+clisp (#+lisp=cl ext:quit #-lisp=cl lisp:quit code)
+ #+(or cmu scl) (ext:quit code)
+ #+cormanlisp (win32:exitprocess code)
+ #+gcl (lisp:bye code)
+ #+lispworks (lw:quit :status code)
+ #+lucid (lcl:quit code)
+ #+sbcl (sb-ext:quit :unix-status (typecase code (number code) (null 0) (t 1)))
+ #+mcl (ccl:quit code)
+ #-(or allegro clisp cmu scl cormanlisp gcl lispworks lucid sbcl mcl)
+ (error 'not-implemented :proc (list 'quit code)))
+
+
+(defun command-line-arguments ()
+ #+allegro (system:command-line-arguments)
+ #+sbcl sb-ext:*posix-argv*
+ )
+
+(defun shell-command-output (cmd &key directory whole)
+ #+allegro (excl.osi:command-output cmd :directory directory :whole whole)
+ #+sbcl
+ (let* ((out (make-array '(0) :element-type 'base-char :fill-pointer 0
+ :adjustable t))
+ (err (make-array '(0) :element-type 'base-char :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))
+ )
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: cl-user -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: loader.lisp
+;;;; Purpose: loads any required modules, contains RUN function
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Sep 2003
+;;;;
+;;;; $Id: xlunit.asd 7061 2003-09-07 06:34:45Z kevin $
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+;;; Nothing to load since the executable contains all of the required
+;;; fasls
+
+
+(defun run ()
+ (handler-case
+ (funcall #'vcs-tree::main (list* "vcs-tree" (cdr *posix-argv*)))
+ (error (c)
+ (format *error-output* "vcs-tree failed due to error:~% ~A~%" c)
+ (sb-ext:quit :unix-status 1))))
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: vcs-tree -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: main.lisp
+;;;; Purpose: Main functions for vcs-tree
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Sep 2003
+;;;;
+;;;; Process all subdirectories that are managed by either CVS or SVN
+;;;;
+;;;; $Id: xlunit.asd 7061 2003-09-07 06:34:45Z kevin $
+;;;; *************************************************************************
+
+
+(in-package vcs-tree)
+
+(defun is-vcs-directory (x)
+ (and (pathnamep x)
+ (or
+ (string= "CVS"
+ (car (last (pathname-directory x))))
+ (string= ".svn"
+ (car (last (pathname-directory x)))))))
+
+(defun is-cvs-managed (dir)
+ (probe-directory (merge-pathnames
+ (make-pathname :directory '(:relative "CVS"))
+ dir)))
+
+(defun is-svn-managed (dir)
+ (probe-directory (merge-pathnames
+ (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
+ (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
+ (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
+ (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)))
+ entries))
+ (:cvs
+ (or
+ (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)
+ (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))
+ ""))))))
+ (multiple-value-bind (output error status)
+ (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))))))
+ (cond
+ ((is-cvs-managed dir)
+ (process dir "cvs"))
+ ((is-svn-managed dir)
+ (process dir "svn"))
+ (t
+ (format *error-output*
+ "INTERAL ERROR: not a version control system directory ~A" dir)
+ (quit 1)))))
+
+(defvar *progname* "")
+
+(defun usage (&optional msg &rest msg-args)
+ (format *error-output* "usage: ~A action [OPTIONS]~%" *progname*)
+ (if msg
+ (progn
+ (apply #'format *error-output* msg msg-args)
+ (write-char #\Newline *error-output*))
+ (format *error-output*
+ "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~%"))
+
+(defun parse-action-arg (arg)
+ (cond
+ ((string= arg "ci")
+ :commit)
+ (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)))))))
+
+
+(defun main (&optional (argv (command-line-arguments)))
+ (let ((*progname* (car argv)))
+ (multiple-value-bind (args options errors)
+ (getopt (cdr argv) '(("m" :required)))
+ (when (or errors (/= 1 (length args)))
+ (usage)
+ (quit 1))
+ (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))))
+ (quit 0)))
+
+;;(main)
+;;(quit 0)
+
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: vcs-tree -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: package.lisp
+;;;; Purpose: Package definition for vcs-tree
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Sep 2003
+;;;;
+;;;; $Id: xlunit.asd 7061 2003-09-07 06:34:45Z kevin $
+;;;; *************************************************************************
+
+(in-package cl-user)
+(defpackage vcs-tree
+ (:use #:cl)
+ (:export #:main))
+(in-package vcs-tree)
--- /dev/null
+.\" -*- NROFF -*-
+.\"
+.\" vcs-tree.1
+.\"
+.\" Author: Kevin Rosenberg <kevin@ctsim.org>
+.\"
+.\" $Id: vcs-tree.1,v 1.5 2002/05/03 10:45:52 kevin Exp $
+.\"
+.TH "vcs-tree" "1" "" "Kevin M. Rosenberg" "Utilities"
+.SH "NAME"
+vcs-tree \- Version Control System Tree Walker
+
+.SH "SYNOPSIS"
+.B vcs-tree action [OPTIONS]
+
+.SH "DESCRIPTION "
+\fIvcs-tree\fP walks through a directory tree and performs actions
+on Subversion and CVS managed directories. As opposed to CVS and
+Subversion, \fIvcs-tree\fP finds and operates on
+directories even if they are below non-version control system
+managed directories.
+
+.SH "ACTIONS"
+update, status, or commit. Abbreviations are
+accepted.
+
+.SH "OPTIONS"
+\fIvcs-tree\fP accepts the following options:
+.TP 16
+.B \-m
+Sets the commit message when performing an commit action.
+
+.SH "AUTHOR"
+Kevin Rosenberg <kevin@rosenberg.net>
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: vcs-tree-system -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: vcs-tree.asd
+;;;; Purpose: ASDF file for vcs-tree to create executable
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Sep 2003
+;;;;
+;;;; $Id: xlunit.asd 7061 2003-09-07 06:34:45Z kevin $
+;;;; *************************************************************************
+
+(in-package vcs-tree-system)
+(defpackage vcs-tree-system (:use #:cl #:asdf))
+(in-package vcs-tree-system)
+
+(require 'sb-executable)
+
+;;; From asdf-install.asd
+(defclass exe-file (cl-source-file) ())
+(defmethod perform :after ((o compile-op) (c exe-file))
+ (sb-executable:make-executable
+ (make-pathname :name "vcs-tree"
+ :type nil
+ :defaults (component-pathname c))
+ '("package.fasl" "kmrcl-excerpt.fasl" "getopt-excerpt.fasl" "main.fasl"
+ "loader.fasl")
+ :initial-function "RUN"
+ :muffled-warning t))
+
+(defmethod perform ((o load-op) (c exe-file)) nil)
+
+(defsystem vcs-tree
+ :version "0.1"
+ :components ((:file "package")
+ (:exe-file "loader" :depends-on ("main"))
+ (:file "kmrcl-excerpt" :depends-on ("package"))
+ (:file "getopt-excerpt" :depends-on ("package"))
+ (:file "main" :depends-on ("kmrcl-excerpt" "getopt-excerpt"))))
+
+(defmethod perform :after ((o load-op) (c (eql (find-system :vcs-tree))))
+ (provide 'vcs-tree))
+
+(defmethod perform ((o test-op) (c (eql (find-system :vcs-tree))))
+ t)
+
projects / vcs-tree.git / commitdiff