;;;; -*- Scheme -*-
;;;; $Header: /home/panda/pg/bevan/progs/elk/scm/RCS/scheme-tags.scm,v 1.3 91/04/02 14:25:59 bevan Exp $
;;;+c
;;; This is an Emacs tag file generator for Scheme programs.
;;; This was written as an excersize in Scheme programming, it is not
;;; meant to be a serious replacement for etags.
;;;
;;; An example useage is :-
;;;
;;;   (scheme-tags:tags "TAGS" "scheme-tags.scm" "string-extensions.scm")
;;;
;;; This will create a tag file TAGS out of scheme-tags.scm and
;;;  string-extension.scm
;;;
;;; System : ELK
;;; System Specific Features :-
;;;   regular expressions (this makes it totally non-portable !)
;;;   provide/require (as in CommonLisp)
;;;
;;; The code is based on the Python program eptags.py by Guido van Rossum <guido@cwi.nl>
;;;-c
(require 'gnu_regexp.o)
(require 'ieee)

;;; A pattern that will match any top level definitions.
;;; (Actually it will match nested defines as well.  Should change this !)
(define scheme-define-matcher
  (gnu:make-regexp "^[ \t]*(define[ \t]+(?\\([---A-Za-z0-9:?]+\\)[ \t]*"))

;;; Generate the tag information for a file.
;;;
(define (scheme-tags:generate-tags line line-number infile tags size char-count)
  (if (eof-object? line)
      (cons tags size)
      (let ((matches (gnu:regexp-exec scheme-define-matcher line 0)))
	(if (gnu:regexp-match? matches)
	    (let* ((pattern (substring line
				       (gnu:regexp-start matches 0)
				       (gnu:regexp-end matches 0)))
		   (name (substring line
				    (gnu:regexp-start matches 1)
				    (gnu:regexp-end matches 1)))
		   (tag (string-append pattern
				       "\177"
				       (number->string line-number)
				       ","
				       (number->string char-count))))
	      (scheme-tags:generate-tags (read-string infile) (+ 1 line-number) infile (cons tag tags) (+ size (string-length tag)) (+ char-count (string-length line))))
	    (scheme-tags:generate-tags (read-string infile) (+ 1 line-number) infile tags size (+ char-count (string-length line)))))))

;;; Output the tag file information.
;;;
(define (scheme-tags:output-file-information tags size outfile output)
  (display "\014" output)
  (newline output)
  (display outfile output)
  (display "," output)
  (display size output)
  (newline output)
  (let do-tags ((tags tags))
    (if (not (null? tags))
	(begin
	  (do-tags (cdr tags))
	  (display (car tags) output)
	  (newline output)))))

;;; Generate a the tags for the given file and write them out to the given
;;; output port
;;;
(define (scheme-tags:process-file in-file out-port)
  (let* ((in-port (open-input-file in-file))
	 (tags+size (scheme-tags:generate-tags (read-string in-port) 1 in-port '() 0 0)))
    (scheme-tags:output-file-information (car tags+size) (cdr tags+size) in-file out-port)
    (close-input-port in-port)))

;;;+f
;;; Given an output file name and a list of input files, it generates an
;;; Emacs tag file with the output file name.  For example :-
;;;   (scheme-tags:tags "TAGS" "scheme-tags.scm" "string-extensions.scm")
;;;-f
(define scheme-tags:tags
  (lambda (out-file . in-files)
    (let ((out-port (open-output-file out-file)))
      (for-each
       (lambda (in-file) (scheme-tags:process-file in-file out-port))
       in-files)
      (close-output-port out-port))))
