#! /usr/local/bin/scm \ %0 %1 %2 %3 %4 %5 %6 %7 %8 %9
- !#
;;;;"includes" List files included by file.
;;; Copyright 1998-2004 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 'string-search)
(require 'filename)
(require 'scanf)
(require-if 'compiling 'manifest)

(define (includes.script args)
  (cond ((not (<= 1 (length args)))
	 (includes.usage))
	((and (positive? (string-length (car args)))
	      (eqv? #\- (string-ref (car args) 0)))
	 (includes.usage))
	(else (apply includes args) #t)))

(define (includes.usage)
  (display "\
\
Usage: includes file1.c [...]
Usage: includes file1.h [...]
Usage: includes file1.txi [...]
\
  Outputs each FILEn: and its include files on a line.

Usage: includes file1.scm [...]
\
  Outputs each FILEn: and the SLIB files it includes on a line.

http://swissnet.ai.mit.edu/~jaffer/Docupage/includes
"
	   (current-error-port))
  #f)

(define (texi-includes file)
  (define includes '())
  (call-with-input-file file
    (lambda (port)
      (do ((pos (find-string-from-port? "@include" port)
		(find-string-from-port? "@include" port)))
	  ((not pos) includes)
	(let ((fname #f))
	  (cond ((eqv? 1 (fscanf port " %s" fname))
		 (set! includes (cons fname includes)))))))))

(define (c-includes file)
  (define includes '())
  (define nl-sharp (string #\newline #\#))
  (call-with-input-file file
    (lambda (port)
      (do ((pos (find-string-from-port? nl-sharp port)
		(find-string-from-port? nl-sharp port)))
	  ((not pos) includes)
	(let ((fname #f))
	  (cond ((eqv? 1 (fscanf port " include \"%[^\"]" fname))
		 (set! includes (cons fname includes)))))))))

(define scheme-includes
  (let ((slib:catalog
	 (append (catalog:try-read (user-vicinity) "usercat")
		 (cdr (member (assq 'null *catalog*) *catalog*))))
	(prov? (lambda (x) #f))
	(lv (library-vicinity))
	(lenv (string-length (library-vicinity))))
    (lambda (file)
      (require 'manifest)
      (map (lambda (path)
	     (cond ((eqv? 0 (substring? lv path))
		    (substring path lenv (string-length path)))
		   ((substring-ci? "slib/" path) =>
		    (lambda (idx)
		      (substring path (+ 5 idx) (string-length path))))
		   (else path)))
	   (features->files (file->requires* file prov? slib:catalog)
			    prov? slib:catalog)))))

(define (features->files lst provided? catalog)
  (define features '())
  (define files '())
  (define (f2f feature)
    (or (memq feature features)
	(provided? feature)
	(let ((path (cdr (or (assq feature catalog) '(#f . #f)))))
	  (cond
	   ((not path)	       ;(slib:warn 'feature->files feature '?)
	    )
	   ((string? path)
	    (cond ((member path files))
		  (else (set! files (cons (string-append path ".scm") files))
			(set! features (cons feature features)))))
	   ((symbol? path) (f2f path))
	   (else
	    (set! features (cons path features))
	    (f2f (car path))
	    (case (car path)
	      ((macro syntactic-closures syntax-case macros-that-work
		      macro-by-example defmacro source)
	       (set! files (cons (string-append (cadr path) ".scm") files)))
	      ((compiled spectral-tristimulus-values color-names)
	       (set! files (cons path files)))
	      ((aggregate)
	       (lambda feature (for-each f2f feature)))))))))
  (for-each f2f lst)
  files)

(define txi-file? (filename:match-ci?? "*??txi"))
(define texi-file? (let ((tex? (filename:match-ci?? "*??tex"))
			 (texi? (filename:match-ci?? "*??texi")))
		     (lambda (filename) (or (txi-file? filename)
					    (tex? filename)
					    (texi? filename)))))
(define c-file? (let ((c? (filename:match-ci?? "*?.c"))
		      (cpp? (filename:match-ci?? "*?.cpp")))
		  (lambda (filename) (or (c? filename) (cpp? filename)))))
(define scheme-file? (let ((scm? (filename:match-ci?? "*??scm"))
			   (sch? (filename:match-ci?? "*??sch")))
		       (lambda (filename) (or (scm? filename)
					      (sch? filename)))))

(define (includes . args)
  (for-each (lambda (file)
	      (display file) (display ": ")
	      (cond ((not (file-exists? file))
		     (display "No such file"))
		    ((texi-file? file)
		     (for-each (lambda (x) (display x) (display #\ ))
			       (texi-includes file)))
		    ((c-file? file)
		     (for-each (lambda (x) (write x) (display #\ ))
			       (c-includes file)))
		    (else		;(scheme-file? file)
		     (for-each (lambda (x) (display x) (display #\ ))
			       (scheme-includes file))))
	      (newline))
	    args))

;;; Local Variables:
;;; mode:scheme
;;; End:
(if *script* (exit (includes.script (list-tail *argv* *optind*))))