module/scripts/generate-autoload.scm

   1 ;;; generate-autoload --- Display define-module form with autoload info
   2
   3 ;;      Copyright (C) 2001, 2006, 2011 Free Software Foundation, Inc.
   4 ;;
   5 ;; This program is free software; you can redistribute it and/or
   6 ;; modify it under the terms of the GNU Lesser General Public License
   7 ;; as published by the Free Software Foundation; either version 3, or
   8 ;; (at your option) any later version.
   9 ;;
  10 ;; This program is distributed in the hope that it will be useful,
  11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;; Lesser General Public License for more details.
  14 ;;
  15 ;; You should have received a copy of the GNU Lesser General Public
  16 ;; License along with this software; see the file COPYING.LESSER.  If
  17 ;; not, write to the Free Software Foundation, Inc., 51 Franklin
  18 ;; Street, Fifth Floor, Boston, MA 02110-1301 USA
  19
  20 ;;; Author: Thien-Thi Nguyen
  21
  22 ;;; Commentary:
  23
  24 ;; Usage: generate-autoload [OPTIONS] FILE1 FILE2 ...
  25 ;;
  26 ;; The autoload form is displayed to standard output:
  27 ;;
  28 ;; (define-module (guile-user)
  29 ;;   :autoload (ZAR FOO) (FOO-1 FOO-2 ...)
  30 ;;     :
  31 ;;     :
  32 ;;   :autoload (ZAR BAR) (BAR-1 BAR-2 ...))
  33 ;;
  34 ;; For each file, a symbol triggers an autoload if it is found in one
  35 ;; of these situations:
  36 ;;  - in the `:export' clause of a `define-module' form
  37 ;;  - in a top-level `export' or `export-syntax' form
  38 ;;  - in a `define-public' form
  39 ;;  - in a `defmacro-public' form
  40 ;;
  41 ;; The module name is inferred from the `define-module' form.  If either the
  42 ;; module name or the exports list cannot be determined, no autoload entry is
  43 ;; generated for that file.
  44 ;;
  45 ;; Options:
  46 ;; --target MODULE-NAME         -- Use MODULE-NAME instead of `(guile-user)'.
  47 ;;                                 Note that some shells may require you to
  48 ;;                                 quote the argument to handle parentheses
  49 ;;                                 and spaces.
  50 ;;
  51 ;; Usage examples from Scheme code as a module:
  52 ;; (use-modules (scripts generate-autoload))
  53 ;; (generate-autoload "generate-autoload")
  54 ;; (generate-autoload "--target" "(my module)" "generate-autoload")
  55 ;; (apply generate-autoload "--target" "(my module)" '("foo" "bar" "baz"))
  56
  57 ;;; Code:
  58
  59 (define-module (scripts generate-autoload)
  60   :export (generate-autoload))
  61
  62 (define %include-in-guild-list #f)
  63 (define %summary "Generate #:autoload clauses for a module.")
  64
  65 (define (autoload-info file)
  66   (let ((p (open-input-file file)))
  67     (let loop ((form (read p)) (module-name #f) (exports '()))
  68       (if (eof-object? form)
  69           (and module-name
  70                (not (null? exports))
  71                (list module-name exports)) ; ret
  72           (cond ((and (list? form)
  73                       (< 1 (length form))
  74                       (eq? 'define-module (car form)))
  75                  (loop (read p)
  76                        (cadr form)
  77                        (cond ((member ':export form)
  78                               => (lambda (val)
  79                                    (append (cadr val) exports)))
  80                              (else exports))))
  81                 ((and (list? form)
  82                       (< 1 (length form))
  83                       (memq (car form) '(export export-syntax)))
  84                  (loop (read p)
  85                        module-name
  86                        (append (cdr form) exports)))
  87                 ((and (list? form)
  88                       (< 2 (length form))
  89                       (eq? 'define-public (car form))
  90                       (list? (cadr form))
  91                       (symbol? (caadr form)))
  92                  (loop (read p)
  93                        module-name
  94                        (cons (caadr form) exports)))
  95                 ((and (list? form)
  96                       (< 2 (length form))
  97                       (eq? 'define-public (car form))
  98                       (symbol? (cadr form)))
  99                  (loop (read p)
 100                        module-name
 101                        (cons (cadr form) exports)))
 102                 ((and (list? form)
 103                       (< 3 (length form))
 104                       (eq? 'defmacro-public (car form))
 105                       (symbol? (cadr form)))
 106                  (loop (read p)
 107                        module-name
 108                        (cons (cadr form) exports)))
 109                 (else (loop (read p) module-name exports)))))))
 110
 111 (define (generate-autoload . args)
 112   (let* ((module-count 0)
 113          (syms-count 0)
 114          (target-override (cond ((member "--target" args) => cadr)
 115                                 (else #f)))
 116          (files (if target-override (cddr args) (cdr args))))
 117     (display ";;; do not edit --- generated ")
 118     (display (strftime "%Y-%m-%d %H:%M:%S" (localtime (current-time))))
 119     (newline)
 120     (display "(define-module ")
 121     (display (or target-override "(guile-user)"))
 122     (for-each (lambda (file)
 123                 (cond ((autoload-info file)
 124                        => (lambda (info)
 125                             (and info
 126                                  (apply (lambda (module-name exports)
 127                                           (set! module-count (1+ module-count))
 128                                           (set! syms-count (+ (length exports)
 129                                                               syms-count))
 130                                           (for-each display
 131                                                     (list "\n  :autoload "
 132                                                           module-name " "
 133                                                           exports)))
 134                                         info))))))
 135               files)
 136     (display ")")
 137     (newline)
 138     (for-each display (list "  ;;; "
 139                             syms-count " symbols in "
 140                             module-count " modules\n"))))
 141
 142 (define main generate-autoload)
 143
 144 ;;; generate-autoload ends here