Re: CVS script

[Russ McManus <mcmanr@eq.gs.com>]

Jim Blandy <jimb@red-bean.com> writes:

> *choke*  I am utterly destroyed...
> 
> [Greg sent the script below to me in personal E-mail,  I suspect to
> avoid embarassing me.  But that's not necessary. :) ]
> 
> > For comparison (performance testing, perhaps?), this was my (very very)
> > quick hack to do the same thing a couple of week ago.  It uses Zsh and
> > Perl (I'm sure it'd be faster if I just used one perl script, but, like
> > I said, I was interested in a mostly one-shot script).  I'm a little
> > surprised that things were so long in the guile version--- perhaps some
> > of the wildcard matching functionality of Zsh would be nice to port to
> > guile.

How would the guile version have looked if the following procedures where
available in some library?  BTW, I agree that stuff like this should exist
somewhere in the guile tree.

-russ


(define (find-files dir . arg-ls)
  "Return a list of files within directory DIR.  Two optional arguements
are supported, PREDICATE and RECURSE?.  PREDICATE should be a procedure
of one argument that determines whether a particular file should be included
in the returned list.  As a special case, if PREDICATE is a string, it is
compiled into a regular expression, and a predicate is generated that applies
this regular expression to the filename.  RECURSE? determines whether the
procedure descends into subdirectories, and it defaults to #t.  Symbolic
links are not followed."
  (let* ((n-args (length arg-ls))
	 (pred (cond ((= n-args 0)
		      (lambda (file) #t))
		     ((procedure? (list-ref arg-ls 0))
		      (list-ref arg-ls 0))
		     ((string? (list-ref arg-ls 0))
		      (let ((rx (make-regexp (list-ref arg-ls 0))))
			(lambda (file) (regexp-exec rx file))))
		     (#t (error "bad predicate" (list-ref arg-ls 0)))))
	 (recurse? (if (>= n-args 2) (list-ref arg-ls 1) #t)))
    (define (do-file file basename ret-ls)
      (let* ((v (lstat file)))
	(cond ((string=? basename ".") ret-ls)
	      ((string=? basename "..") ret-ls)
	      ((and (eq? (stat:type v) 'directory)
		    recurse?)
	       (do-dir file ret-ls))
	      ((pred file) (cons file ret-ls))
	      (#t ret-ls))))
    (define (do-dir dir-name ret-ls)
      (let ((dir (opendir dir-name)))
	(do ((file (readdir dir) (readdir dir)))
	    ((eof-object? file) ret-ls)
	  (set! ret-ls (do-file (string dir-name "/" file) file ret-ls)))
	(closedir dir)
	ret-ls))
    (do-dir dir '())))

(define (file-for-each-with-backup proc backup-suffix file-ls . error-handler)
  "Call PROC once for each file in FILE-LS.  Before calling PROC, make a copy of the
file using BACKUP-SUFFIX to generate a backup file name.  ERROR-HANDLER is a
optional argument that should be an error handler procedure that captures errors
during the processing of a single file in FILE-LS."
  (let ((error-handler (and (not (null? error-handler)) (car error-handler))))
    (define (do-one-file file)
      (copy-file file (string-append file "." backup-suffix))
      (proc file))
    (define (loop file-ls)
      (cond ((null? file-ls)
	     #t)
	    (error-handler
	     (catch 'system-error (lambda () (do-one-file (car file-ls))) error-handler)
	     (loop (cdr file-ls)))
	    (#t
	     (do-one-file (car file-ls))
	     (loop (cdr file-ls)))))
    (loop file-ls)))





--
Why be difficult when, with a bit of effort, you could be impossible?