; @echo off && REM -*- scheme -*- ; if not "%MZSCHEME%" == "" goto :run ; set MZSCHEME=mzscheme.exe ; :run ; "%MZSCHEME%" "%~f0" %* ; exit /b #lang scheme (require xml) (permissive-xexprs #t) ;(read-comments #t) ;;; Filter to scrub whitespace ;;; (define f (eliminate-whitespace '(project path target property fileset condition copy exec cvs commandline tar classpath tarfileset manifest section junit jar java and or not uptodate javac javadoc delete move) (lambda (x) x))) ;;; Move "name" attribute to the beginning of any attribute list in an xexpr ;;; (define (name-first-attrib l) (letrec ;; take attribute list, move any "name" element to its car ((reorder-attrs (lambda (alist) (cond ((null? alist) alist) ((assq 'name alist) => (lambda (el) (cons el (remove 'name alist (lambda (x y) (eq? x (car y))))))) (else alist)))) ;; process any element (tag attrs el*) (process-element (lambda (el) (cons (car l) (cons (reorder-attrs (cadr l)) (map name-first-attrib (cddr l)))))) ) (if (pair? l) (process-element l) l))) (define (process in out) (pretty-print (name-first-attrib (xml->xexpr (f (document-element (read-xml in))))) out)) ;;; Open input file before output file, so that an error upon opening input doesn't create a zero-length output file ;;; If either parameter is #f, default to stdin/stdout ;;; (define (call-filter-with-files in-file out-file proc) (let ((output-processing-thunk (lambda (from) (if out-file (call-with-output-file out-file (lambda (to) (proc from to))) (proc from (current-output-port)))))) (if in-file (call-with-input-file in-file output-processing-thunk) (output-processing-thunk (current-input-port))))) (define input-file (make-parameter #f)) (define output-file (make-parameter #f)) (command-line #:program "ant-make-scm" #:once-each (("--output" "-o") filename "Create S-expression format Ant buildfile" (output-file filename)) #:args (build.xml) (unless (string=? "-" build.xml) (input-file build.xml))) (call-filter-with-files (input-file) (output-file) process)
