;pathproc.scm
;SLaTeX Version 1.99
;File-manipulation routines used by SLaTeX
;(c) Dorai Sitaram, Rice U., 1991, 1994

(module SLaTeX.)

(local *texinputs* *texinputs-list* *path-separator*
  *directory-mark* *file-hider* path-to-list find-some-file
  file-extension basename full-texfile-name
  full-scmfile-name new-aux-file subjobname
  new-primary-aux-file new-secondary-aux-file)

(define *texinputs* "")

(define *texinputs-list* '())

(define *path-separator*
  (cond ((eq? *op-sys* 'unix) #\:)
	((memq *op-sys* '(os2 dos os2fat)) #\;)
	(else (error '*path-separator* 'cant-determine))))

(define *directory-mark*
  (cond ((eq? *op-sys* 'unix) "/")
	((memq *op-sys* '(os2 dos os2fat)) "\\")
	(else (error '*directory-mark* 'cant-determine))))

(define *file-hider*
  (cond ((memq *op-sys* '(os2 unix)) ".")
	((memq *op-sys* '(dos os2fat)) "x") ;no such luck for dos & os2fat
	(else "."))) ;use any old character

(define path-to-list
  (lambda (p)
    ;;convert a unix or dos representation of a path to a list of
    ;;directory names (strings)
    (let loop ((p (string->list p)) (r (list "")))
      (let ((separator-pos (position-char *path-separator* p)))
	(if separator-pos
	    (loop (list-tail p (+ separator-pos 1))
		  (cons (list->string (sublist p 0 separator-pos))
		    r))
	    (reverse! (cons (list->string p) r)))))))

;debug: can unix paths also be space-separated?
'(define path-to-list
  (lambda (p)
    (let loop ((p (string->list p)) (r (list "")))
      (let ((space-pos (position-char #\space p))
	    (colon-pos (position-char #\: p)))
	(if (and (not space-pos) (not colon-pos))
	    (reverse! (cons (list->string p) r))
	    (let ((i (cond ((not space-pos) colon-pos)
			   ((not colon-pos) space-pos)
			   (else (min space-pos colon-pos)))))
	      (loop (list-tail p (+ i 1))
		    (cons
		      (list->string (sublist p 0 i))
		      r))))))))

(define find-some-file
  (lambda (path . files)
    ;;look through each directory in path till one of files is found
    (let loop ((path path))
      (if (null? path) #f
	(let ((dir (car path)))
	  (let loop2 ((files
			(if (or (string=? dir "") (string=? dir "."))
			    files
			    (map (lambda (file)
				   (string-append dir *directory-mark*
				     file)) files))))
	    (if (null? files) (loop (cdr path))
	      (let ((file (car files)))
		(if (file-exists? file) file
		  (loop2 (cdr files)))))))))))

(define file-extension
  (lambda (filename)
    ;;find extension of filename
    (let ((i (string-position-right #\. filename)))
      (if i (substring filename i (string-length filename))
	  #f))))

(define basename
  (lambda (filename ext)
    ;;find basename of filename if it has extension ext
    (let* ((filename-len (string-length filename))
	   (ext-len (string-length ext))
	   (len-diff (- filename-len ext-len)))
      (cond ((> ext-len filename-len) filename)
	    ((equal? ext (substring filename len-diff filename-len))
	     (substring filename 0 len-diff))
	    (else filename)))))

(define full-texfile-name
  (lambda (filename)
    ;;find the full pathname of the .tex/.sty file filename
    (let ((extn (file-extension filename)))
      (if (and extn (or (string=? extn ".sty") (string=? extn ".tex")))
	  (find-some-file *texinputs-list* filename)
	  (find-some-file *texinputs-list*
	    (string-append filename ".tex") filename)))))

(define full-styfile-name
  (lambda (filename)
    ;;find the full pathname of the .sty file filename
    (find-some-file *texinputs-list*
      (string-append filename ".sty"))))
      
(define full-clsfile-name
  (lambda (filename)
    ;;find the full pathname of the .cls file filename
    (find-some-file *texinputs-list*
      (string-append filename ".cls"))))

(define full-scmfile-name
  (lambda (filename)
    ;;find the full pathname of the scheme file filename;
    ;;acceptable extensions are .scm .ss .s
    (apply find-some-file *texinputs-list*
      filename
      (map (lambda (extn) (string-append filename extn))
	   '(".scm" ".ss" ".s")))))

(define new-aux-file
  (lambda e
    ;;create a new auxiliary file with provided extension if any
    (apply (if *slatex-in-protected-region?* new-secondary-aux-file
	     new-primary-aux-file) e)))

(define subjobname 'fwd)

(define primary-aux-file-count -1)

(define new-primary-aux-file
  (lambda e
    ;;used by new-aux-file unless in protected region;
    ;;this is the default
    (set! primary-aux-file-count
      (+ primary-aux-file-count 1))
    (apply string-append *file-hider* "Z"
      (number->string primary-aux-file-count)
      subjobname e)))

(define new-secondary-aux-file
  (let ((n -1))
    (lambda e
      ;;used by new-aux-file when in protected region
      (set! n (+ n 1))
      (apply string-append *file-hider*
	"ZZ" (number->string n) subjobname e))))