diff options
author | Ludovic Courtès <ludo@gnu.org> | 2009-08-17 23:39:56 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2009-08-18 00:06:45 +0200 |
commit | fbb857a472eb4e69c1cba05e86646b7004f32df6 (patch) | |
tree | ff23e64de5a558b575ed812349d8af6e64d8ceb4 /module/scripts/generate-autoload.scm | |
parent | 49c9839eae84f7f3cd10db45f389fa1ea1050659 (diff) | |
parent | e33a910dd0f430f34c32fe6846899aee33fc2cf6 (diff) | |
download | guile-fbb857a472eb4e69c1cba05e86646b7004f32df6.tar.gz |
Merge branch 'master' into boehm-demers-weiser-gc
Conflicts:
lib/Makefile.am
libguile/Makefile.am
libguile/frames.c
libguile/gc-card.c
libguile/gc-freelist.c
libguile/gc-mark.c
libguile/gc-segment.c
libguile/gc_os_dep.c
libguile/load.c
libguile/macros.c
libguile/objcodes.c
libguile/programs.c
libguile/strings.c
libguile/vm.c
m4/gnulib-cache.m4
m4/gnulib-comp.m4
m4/inline.m4
Diffstat (limited to 'module/scripts/generate-autoload.scm')
-rw-r--r-- | module/scripts/generate-autoload.scm | 141 |
1 files changed, 141 insertions, 0 deletions
diff --git a/module/scripts/generate-autoload.scm b/module/scripts/generate-autoload.scm new file mode 100644 index 000000000..781931015 --- /dev/null +++ b/module/scripts/generate-autoload.scm @@ -0,0 +1,141 @@ +;;; generate-autoload --- Display define-module form with autoload info + +;; Copyright (C) 2001, 2006 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 (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 |