#!/usr/bin/guile \
-e "(scripts generate-autoload)" -s
!#
;;; generate-autoload --- Display define-module form with autoload info

;; 	Copyright (C) 2001,2003,2005 Free Software Foundation, Inc.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this software; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;
;; As a special exception, the Free Software Foundation gives permission
;; for additional uses of the text contained in its release of GUILE.
;;
;; The exception is that, if you link the GUILE library with other files
;; to produce an executable, this does not by itself cause the
;; resulting executable to be covered by the GNU General Public License.
;; Your use of that executable is in no way restricted on account of
;; linking the GUILE library code into it.
;;
;; This exception does not however invalidate any other reasons why
;; the executable file might be covered by the GNU General Public License.
;;
;; This exception applies only to the code released by the
;; Free Software Foundation under the name GUILE.  If you copy
;; code from other Free Software Foundation releases into a copy of
;; GUILE, as the General Public License permits, the exception does
;; not apply to the code that you add in this way.  To avoid misleading
;; anyone as to the status of such modified files, you must delete
;; this exception notice from them.
;;
;; If you write modifications of your own for GUILE, it is your choice
;; whether to permit this exception to apply to your modifications.
;; If you do not wish that, delete this exception notice.

;;; Author: Thien-Thi Nguyen <ttn@gnu.org>

;;; Commentary:

;; Usage: generate-autoload [OPTIONS] FILE1 FILE2 ...
;;
;; The autoload form is displayed to standard output:
;;
;; (define-module (guile-user)
;;   #:autoload (ZAR FOO) (FOO-1 FOO-2 ...)
;;     :
;;     :
;;   #:autoload (ZAR BAR) (BAR-1 BAR-2 ...))
;;
;; For each file, a symbol triggers an autoload if it is found in one
;; of these situations:
;;  - in the `#:export' clause of a `define-module' form
;;  - in a top-level `export' or `export-syntax' form
;;  - in a `define-public' form
;;  - in a `defmacro-public' form
;;
;; The module name is inferred from the `define-module' form.  If either the
;; module name or the exports list cannot be determined, no autoload entry is
;; generated for that file.
;;
;; Options:
;; --target MODULE-NAME         -- Use MODULE-NAME instead of `(guile-user)'.
;;                                 Note that some shells may require you to
;;                                 quote the argument to handle parentheses
;;                                 and spaces.
;;
;;
;; Usage examples from Scheme code as a module:
;; (use-modules (scripts generate-autoload))
;; (generate-autoload "generate-autoload")
;; (generate-autoload "--target" "(my module)" "generate-autoload")
;; (apply generate-autoload "--target" "(my module)" '("foo" "bar" "baz"))
;;
;; This module also provides the procedure:
;;
;;  (module-names/exports REFERENCE) => (MODULE-NAME EXPORTS), or #f
;;
;; REFERENCE is either a list of symbols to be taken as a module name,
;; like `(ice-9 q)', or a string that is taken to be a filename.  Both
;; MODULE-NAME and EXPORTS are lists of symbols.  If either the module
;; name cannot be determined, or the exports list is empty, return #f.

;;; Code:

(define-module (scripts generate-autoload)
  #:autoload (ice-9 gumm) (module-name->catalog-entry)
  #:autoload (ice-9 rdelim) (read-line)
  #:autoload (ice-9 popen) (open-input-pipe)
  #:autoload (scripts scan-md-module) (scan-md-module-file)
  #:autoload (scripts PROGRAM) (HVQC-MAIN)
  #:export (module-name/exports
            generate-autoload))

(define (file-autoload-info file)
  (define (at-least x len)
    (and (pair? x)
         (or (= 1 len)
             (at-least (cdr x) (1- len)))))
  (let ((p (open-input-file file)))
    (let loop ((form (read p)) (module-name #f) (exports '()))
      (if (eof-object? form)
          (begin
            (close-port p)
            (and module-name
                 (not (null? exports))
                 (list module-name exports))) ; ret
          (cond ((and (at-least form 1)
                      (eq? 'define-module (car form)))
                 (loop (read p)
                       (cadr form)
                       (let eloop ((rest (cddr form)) (acc '()))
                         (if (null? rest)
                             (apply append! exports acc)
                             (if (memq (car rest) '(:export
                                                    :export-syntax
                                                    :re-export
                                                    :re-export-syntax
                                                    #:export
                                                    #:export-syntax
                                                    #:re-export
                                                    #:re-export-syntax))
                                 (eloop (cddr rest) (cons (cadr rest) acc))
                                 (eloop (cdr rest) acc))))))
                ((and (at-least form 1)
                      (memq (car form) '(export export-syntax)))
                 (loop (read p)
                       module-name
                       (append (cdr form) exports)))
                ((and (at-least form 2)
                      (eq? 'define-public (car form))
                      (pair? (cadr form))
                      (symbol? (caadr form)))
                 (loop (read p)
                       module-name
                       (cons (caadr form) exports)))
                ((and (at-least form 2)
                      (eq? 'define-public (car form))
                      (symbol? (cadr form)))
                 (loop (read p)
                       module-name
                       (cons (cadr form) exports)))
                ((and (at-least form 3)
                      (eq? 'defmacro-public (car form))
                      (symbol? (cadr form)))
                 (loop (read p)
                       module-name
                       (cons (cadr form) exports)))
                (else (loop (read p) module-name exports)))))))

(define (binary-module-autoload-info filename)
  (let* ((name (and=> (scan-md-module-file filename) car))
         (p (and name (open-input-pipe
                       (simple-format
                        #f "strings ~A | sed '/^#_export /!d;s///'"
                        filename)))))
    (and p (let loop ((line (read-line p)) (acc '()))
             (if (eof-object? line)
                 (and (not (null? acc))
                      (list name acc))
                 (loop (read-line p)
                       (append! acc (with-input-from-string line read))))))))

(define (module-name/exports ref)
  (cond ((pair? ref)
         (let ((entry (module-name->catalog-entry ref)))
           (cond ((string? entry)
                  (file-autoload-info entry))
                 ((pair? entry)
                  (case (car entry)
                    ((scm_init_module)
                     (binary-module-autoload-info
                      (cdr (last-pair entry))))
                    (else
                     (error "unrecognized catalog entry:" entry))))
                 (else
                  #f))))
        ((string? ref)
         (file-autoload-info ref))
        (else
         #f)))

(define (generate-autoload . args)
  (let* ((module-count 0)
         (syms-count 0)
         (target-override (cond ((member "--target" args) => cadr)
                                (else #f)))
         (refs (if target-override (cddr args) args)))
    (display ";;; do not edit --- generated ")
    (display (strftime "%Y-%m-%d %H:%M:%S" (localtime (current-time))))
    (newline)
    (display "(define-module ")
    (display (or target-override "(guile-user)"))
    (for-each (lambda (ref)
                (cond ((module-name/exports
                        (if (char=? #\( (string-ref ref 0))
                            (with-input-from-string ref read)
                            ref))
                       => (lambda (info)
                            (apply (lambda (module-name exports)
                                     (set! module-count (1+ module-count))
                                     (set! syms-count (+ (length exports)
                                                         syms-count))
                                     (for-each display
                                               (list "\n  #:autoload "
                                                     module-name " "
                                                     exports)))
                                   info)))))
              refs)
    (display ")")
    (newline)
    (for-each display (list "  ;;; "
                            syms-count " symbols in "
                            module-count " modules\n"))))

(define (main args)
  (HVQC-MAIN args (lambda (args)
                    (apply generate-autoload (cdr args)))
             '(usage . commentary)
             '(package . "Guile")))

;;; generate-autoload ends here
