summaryrefslogtreecommitdiffstats
path: root/cvs.scm
diff options
context:
space:
mode:
authorSteve Langasek <vorlon@debian.org>2005-01-10 08:53:33 +0000
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:30 -0800
commite33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e (patch)
treeabbf06041619e445f9d0b772b0d58132009d8234 /cvs.scm
parentf559c149c83da84d0b1c285f0298c84aec564af9 (diff)
parent8466d8cfa486fb30d1755c4261b781135083787b (diff)
downloadslib-e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e.tar.gz
slib-e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e.zip
Import Debian changes 3a1-4.2debian/3a1-4.2
slib (3a1-4.2) unstable; urgency=low * Non-maintainer upload. * Add guile.init.local for use within the build dir, since otherwise we have an (earlier unnoticed) circular build-dep due to a difference between scm and guile. slib (3a1-4.1) unstable; urgency=low * Non-maintainer upload. * Build-depend on guile-1.6 instead of scm, since the new version of scm is wedged in unstable (closes: #281809). slib (3a1-4) unstable; urgency=low * Also check for expected creation on slibcat. (Closes: #240096) slib (3a1-3) unstable; urgency=low * Also check for /usr/share/guile/1.6/slib before installing for guile 1.6. (Closes: #239267) slib (3a1-2) unstable; urgency=low * Add format.scm back into slib until gnucash stops using it. * Call guile-1.6 new-catalog (Closes: #238231) slib (3a1-1) unstable; urgency=low * New upstream release * Remove Info section from doc-base file (Closes: #186950) * Remove period from end of description (linda, lintian) * html gen fixed upstream (Closes: #111778) slib (2d4-2) unstable; urgency=low * Fix url for upstream source (Closes: #144981) * Fix typo in slib.texi (enquque->enqueue) (Closes: #147475) * Add build depends. slib (2d4-1) unstable; urgency=low * New upstream. slib (2d3-1) unstable; urgency=low * New upstream. * Remove texi2html call in debian/rules. Now done upstream. Add make html instead. * Changes to rules and doc-base to conform to upstream html gen * Clean up upstream makefile to make sure it cleans up after itself.
Diffstat (limited to 'cvs.scm')
-rw-r--r--cvs.scm140
1 files changed, 140 insertions, 0 deletions
diff --git a/cvs.scm b/cvs.scm
new file mode 100644
index 0000000..f1c853c
--- /dev/null
+++ b/cvs.scm
@@ -0,0 +1,140 @@
+;;;;"cvs.scm" enumerate files under CVS control.
+;;; Copyright 2002 Aubrey Jaffer
+;
+;Permission to copy this software, to modify it, to redistribute it,
+;to distribute modified versions, and to use it for any purpose is
+;granted, subject to the following restrictions and understandings.
+;
+;1. Any copy made of this software must include this copyright notice
+;in full.
+;
+;2. I have made no warranty or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3. In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'scanf)
+(require 'line-i/o)
+(require 'string-search)
+
+;;@body Returns a list of the local pathnames (with prefix @1) of all
+;;CVS controlled files in @1 and in @1's subdirectories.
+(define (cvs-files directory/)
+ (cvs:entries directory/ #t))
+
+;;@body Returns a list of all of @1 and all @1's CVS controlled
+;;subdirectories.
+(define (cvs-directories directory/)
+ (and (file-exists? (in-vicinity directory/ "CVS/Entries"))
+ (cons directory/ (cvs:entries directory/ #f))))
+
+(define (cvs:entries directory do-files?)
+ (define files '())
+ (define cvse (in-vicinity directory "CVS/Entries"))
+ (define cvsel (in-vicinity directory "CVS/Entries.Log"))
+ (set! directory (substring directory
+ (if (eqv? 0 (substring? "./" directory)) 2 0)
+ (string-length directory)))
+ (if (file-exists? cvse)
+ (call-with-input-file cvse
+ (lambda (port)
+ (do ((line (read-line port) (read-line port)))
+ ((eof-object? line))
+ (let ((fname #f))
+ (cond ((eqv? 1 (sscanf line "/%[^/]" fname))
+ (and do-files?
+ (set! files
+ (cons (in-vicinity directory fname) files))))
+ ((eqv? 1 (sscanf line "D/%[^/]" fname))
+ (set! files
+ (append (cvs:entries (sub-vicinity directory fname)
+ do-files?)
+ (if do-files? '()
+ (list (sub-vicinity directory fname)))
+ files))))))))
+ (slib:warn 'cvs:entries 'missing cvse))
+ (set! files (reverse files))
+ (if (file-exists? cvsel)
+ (call-with-input-file cvsel
+ (lambda (port)
+ (do ((line (read-line port) (read-line port)))
+ ((eof-object? line) files)
+ (let ((fname #f))
+ (cond ((eqv? 1 (sscanf line "A D/%[^/]/" fname))
+ (set! files
+ (append files
+ (if do-files? '()
+ (list (sub-vicinity directory fname)))
+ (cvs:entries (sub-vicinity directory fname)
+ do-files?)))))))))
+ files))
+
+;;@body Returns the (string) contents of @var{path/}CVS/Root;
+;;or @code{(getenv "CVSROOT")} if Root doesn't exist.
+(define (cvs-root path/)
+ (if (not (vicinity:suffix? (string-ref path/ (+ -1 (string-length path/)))))
+ (slib:error 'missing 'vicinity-suffix path/))
+ (let ((rootpath (string-append path/ "CVS/Root")))
+ (if (file-exists? rootpath)
+ (call-with-input-file rootpath read-line)
+ (getenv "CVSROOT"))))
+
+;;@body Returns the (string) contents of @var{directory/}CVS/Root appended
+;;with @var{directory/}CVS/Repository; or #f if @var{directory/}CVS/Repository
+;;doesn't exist.
+(define (cvs-repository directory/)
+ (let ((root (cvs-root directory/))
+ (repath (in-vicinity (sub-vicinity directory/ "CVS/") "Repository")))
+ (define root/idx (substring? "/" root))
+ (define rootlen (string-length root))
+ (and
+ root/idx
+ (file-exists? repath)
+ (let ((repos (call-with-input-file repath read-line)))
+ (define replen (and (string? repos) (string-length repos)))
+ (cond ((not (and replen (< 1 replen))) #f)
+ ((not (char=? #\/ (string-ref repos 0)))
+ (string-append root "/" repos))
+ ((eqv? 0 (substring? (substring root root/idx rootlen) repos))
+ (string-append
+ root
+ (substring repos (- rootlen root/idx) replen)))
+ (else (slib:error 'mismatched root repos)))))))
+
+;;@body
+;;Writes @1 to file CVS/Root of @2 and all its subdirectories.
+(define (cvs-set-root! new-root directory/)
+ (define root (cvs-root directory/))
+ (define repos (cvs-repository directory/))
+ (if (not repos) (slib:error 'not 'cvs directory/))
+ (if (not (eqv? 0 (substring? root repos)))
+ (slib:error 'bad 'cvs root repos))
+ (call-with-output-file
+ (in-vicinity (sub-vicinity directory/ "CVS") "Root")
+ (lambda (port) (write-line new-root port)))
+ (call-with-output-file
+ (in-vicinity (sub-vicinity directory/ "CVS") "Repository")
+ (lambda (port)
+ (write-line
+ (substring repos (+ 1 (string-length root)) (string-length repos))
+ port))))
+
+;;@body
+;;Signals an error if CVS/Repository or CVS/Root files in @1 or any
+;;subdirectory do not match.
+(define (cvs-vet directory/)
+ (define diroot (cvs-root directory/))
+ (for-each
+ (lambda (path/)
+ (define path/CVS (sub-vicinity path/ "CVS/"))
+ (cond ((not (cvs-repository path/))
+ (slib:error 'bad (in-vicinity path/CVS "Repository")))
+ ((not (equal? diroot (cvs-root path/)))
+ (slib:error 'mismatched 'root (in-vicinity path/CVS "Root")))))
+ (or (cvs-directories directory/) (slib:error 'not 'cvs directory/))))
+
+;;(define cvs-rsh (or (getenv "CVS_RSH") "rsh"))