guile-for-guile-emacs/module/scripts/generate-autoload.scm

;;; generate-autoload --- Display define-module form with autoload info

;; 	Copyright (C) 2001, 2006, 2011 Free Software Foundation, Inc.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public License
;; as published by the Free Software Foundation; either version 3, 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
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this software; see the file COPYING.LESSER.  If
;; not, write to the Free Software Foundation, Inc., 51 Franklin
;; Street, Fifth Floor, Boston, MA 02110-1301 USA

;;; Author: Thien-Thi Nguyen

;;; 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"))

;;; Code:

(define-module (scripts generate-autoload)
  :export (generate-autoload))

(define %include-in-guild-list #f)
(define %summary "Generate #:autoload clauses for a module.")

(define (autoload-info file)
  (let ((p (open-input-file file)))
    (let loop ((form (read p)) (module-name #f) (exports '()))
      (if (eof-object? form)
          (and module-name
               (not (null? exports))
               (list module-name exports)) ; ret
          (cond ((and (list? form)
                      (< 1 (length form))
                      (eq? 'define-module (car form)))
                 (loop (read p)
                       (cadr form)
                       (cond ((member ':export form)
                              => (lambda (val)
                                   (append (cadr val) exports)))
                             (else exports))))
                ((and (list? form)
                      (< 1 (length form))
                      (memq (car form) '(export export-syntax)))
                 (loop (read p)
                       module-name
                       (append (cdr form) exports)))
                ((and (list? form)
                      (< 2 (length form))
                      (eq? 'define-public (car form))
                      (list? (cadr form))
                      (symbol? (caadr form)))
                 (loop (read p)
                       module-name
                       (cons (caadr form) exports)))
                ((and (list? form)
                      (< 2 (length form))
                      (eq? 'define-public (car form))
                      (symbol? (cadr form)))
                 (loop (read p)
                       module-name
                       (cons (cadr form) exports)))
                ((and (list? form)
                      (< 3 (length form))
                      (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 (generate-autoload . args)
  (let* ((module-count 0)
         (syms-count 0)
         (target-override (cond ((member "--target" args) => cadr)
                                (else #f)))
         (files (if target-override (cddr args) (cdr 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 (file)
                (cond ((autoload-info file)
                       => (lambda (info)
                            (and 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))))))
              files)
    (display ")")
    (newline)
    (for-each display (list "  ;;; "
                            syms-count " symbols in "
                            module-count " modules\n"))))

(define main generate-autoload)

;;; generate-autoload ends here