mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
guile-tools is a scheme script that loads scheme modules
* meta/guile-tools: Changed to be a scheme script. Instead of looking for executables in a "scripts dir", we just look for modules in (scripts), and load the modules directly. * module/Makefile.am: * module/scripts/: Move the scripts into module/ so they can be compiled. Rename scripts from `foo' to `foo.scm'. * libguile/Makefile.am: Invoke the snarf->texi code via guile-tools. * configure.in: * .gitignore: Update for changes.
This commit is contained in:
parent
798244609b
commit
6d66647d5b
30 changed files with 134 additions and 290 deletions
141
module/scripts/generate-autoload.scm
Normal file
141
module/scripts/generate-autoload.scm
Normal file
|
@ -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 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
|
||||
|
||||
;;; 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
|
Loading…
Add table
Add a link
Reference in a new issue