1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +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:
Andy Wingo 2009-04-17 11:19:42 +02:00
parent 798244609b
commit 6d66647d5b
30 changed files with 134 additions and 290 deletions

1
.gitignore vendored
View file

@ -53,7 +53,6 @@ conftest.c
depcomp
elisp-comp
guile-*.tar.gz
guile-tools
install-sh
libtool
ltconfig

View file

@ -25,7 +25,7 @@
AUTOMAKE_OPTIONS = 1.10
SUBDIRS = lib meta libguile guile-readline emacs \
scripts srfi doc examples test-suite benchmark-suite lang am \
srfi doc examples test-suite benchmark-suite lang am \
module testsuite
include_HEADERS = libguile.h

View file

@ -1537,7 +1537,6 @@ AC_CONFIG_FILES([
examples/Makefile
lang/Makefile
libguile/Makefile
scripts/Makefile
srfi/Makefile
test-suite/Makefile
test-suite/standalone/Makefile
@ -1556,7 +1555,6 @@ AC_CONFIG_FILES([meta/guile-1.8.pc])
AC_CONFIG_FILES([meta/guile-1.8-uninstalled.pc])
AC_CONFIG_FILES([check-guile], [chmod +x check-guile])
AC_CONFIG_FILES([benchmark-guile], [chmod +x benchmark-guile])
AC_CONFIG_FILES([meta/guile-tools], [chmod +x meta/guile-tools])
AC_CONFIG_FILES([meta/guile], [chmod +x meta/guile])
AC_CONFIG_FILES([meta/uninstalled-env], [chmod +x meta/uninstalled-env])
AC_CONFIG_FILES([meta/gdb-uninstalled-guile], [chmod +x meta/gdb-uninstalled-guile])

View file

@ -329,7 +329,7 @@ load.x: libpath.h
include $(top_srcdir)/am/pre-inst-guile
alldotdocfiles = $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES)
snarf2checkedtexi = GUILE="$(GUILE_FOR_BUILD)" $(top_srcdir)/scripts/snarf-check-and-output-texi
snarf2checkedtexi = $(top_builddir)/meta/uninstalled-env guile-tools snarf-check-and-output-texi
dotdoc2texi = cat $(alldotdocfiles) | $(snarf2checkedtexi)
guile.texi: $(alldotdocfiles) guile$(EXEEXT)

View file

@ -21,7 +21,7 @@
## Floor, Boston, MA 02110-1301 USA
bin_SCRIPTS=guile-config guile-tools
EXTRA_DIST=guile-tools.in guile.m4 ChangeLog-2008 \
EXTRA_DIST=guile.m4 ChangeLog-2008 \
guile-1.8.pc.in guile-1.8-uninstalled.pc.in
pkgconfigdir = $(libdir)/pkgconfig

98
meta/guile-tools Executable file
View file

@ -0,0 +1,98 @@
#!/bin/sh
# -*- scheme -*-
exec guile $GUILE_FLAGS -e '(@@ (guile-tools) main)' -s "$0" "$@"
!#
;;;; guile-tools --- running scripts bundled with Guile
;;;; Jim Blandy <jim@red-bean.com> --- September 1997
;;;;
;;;; Copyright (C) 1998, 2001, 2004, 2005, 2006, 2008, 2009 Free Software Foundation, Inc.
;;;;
;;;; This library 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 2.1 of the License, or (at your option) any later version.
;;;;
;;;; This library 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 library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (guile-tools)
#:use-module (srfi srfi-1))
(define (help)
(display "\
Usage: guile-tools --version
guile-tools --help
guile-tools PROGRAM [ARGS]
If PROGRAM is \"list\" or omitted, display available scripts, otherwise
PROGRAM is run with ARGS.
"))
(define (directory-files dir)
(if (and (file-exists? dir) (file-is-directory? dir))
(let ((dir-stream (opendir dir)))
(let loop ((new (readdir dir-stream))
(acc '()))
(if (eof-object? new)
(begin
(closedir dir-stream)
acc)
(loop (readdir dir-stream)
(if (or (string=? "." new) ; ignore
(string=? ".." new)) ; ignore
acc
(cons new acc))))))
'()))
(define (strip-extensions path)
(or-map (lambda (ext)
(and
(string-suffix? ext path)
(substring path 0
(- (string-length path) (string-length ext)))))
(append %load-extensions %load-compiled-extensions)))
(define (unique l)
(cond ((null? l) l)
((null? (cdr l)) l)
((equal? (car l) (cadr l)) (unique (cdr l)))
(else (cons (car l) (unique (cdr l))))))
(define (find-submodules head)
(let ((shead (map symbol->string head)))
(unique
(sort
(append-map (lambda (path)
(fold (lambda (x rest)
(let ((stripped (strip-extensions x)))
(if stripped (cons stripped rest) rest)))
'()
(directory-files
(fold (lambda (x y) (in-vicinity y x)) path shead))))
%load-path)
string<?))))
(define (list-scripts)
(for-each (lambda (x)
;; would be nice to show a summary.
(format #t "~A\n" x))
(find-submodules '(scripts))))
(define (find-script s)
(let ((m (resolve-module (append '(scripts) (list (string->symbol s))))))
(and (module-public-interface m)
m)))
(define (main args)
(if (or (equal? (cdr args) '())
(equal? (cdr args) '("list")))
(list-scripts)
(let ((mod (find-script (cadr args))))
(exit ((module-ref mod 'main) (cdr args))))))

View file

@ -1,118 +0,0 @@
#!/bin/sh
# Copyright (C) 2001, 2003, 2006, 2008 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
# Usage: See `help' func below.
#
# TODO
# - handle pre-install invocation
# - "full" option processing (but see comment below)
#
# Author: Thien-Thi Nguyen
help ()
{
cat <<EOF
Usage: guile-tools --version
guile-tools --help
guile-tools [OPTION] PROGRAM [ARGS]
If PROGRAM is "list" or omitted, display contents of scripts dir, otherwise
PROGRAM is run w/ ARGS. Options (only one of which may be used at a time):
--scriptsdir DIR -- Look in DIR for scripts
--guileversion VERS -- Look in $pkgdatadir/VERS/scripts for scripts
--source -- Display PROGRAM source (ignore ARGS) to stdout
Default scripts dir: $default_scriptsdir
EOF
}
prefix="@prefix@"
datarootdir="@datarootdir@"
pkgdatadir="@datadir@/@PACKAGE@"
guileversion="@GUILE_EFFECTIVE_VERSION@"
default_scriptsdir=$pkgdatadir/$guileversion/scripts
top_srcdir="@top_srcdir_absolute@"
top_builddir="@top_builddir_absolute@"
# pre-install invocation frob
mydir=$(cd $(dirname $0) && pwd)
if [ "$mydir" = "$top_builddir/meta" ] ; then
default_scriptsdir=$top_srcdir/scripts
fi
# option processing -- basically, you can override either the script dir
# completely, or just the guile version. we choose implementation simplicity
# over orthogonality.
case x"$1" in
x--version)
echo $0 $guileversion
exit 0
;;
x--help)
help
exit 0
;;
esac
if [ x"$1" = x--scriptsdir ] ; then
user_scriptsdir=$2
shift
shift
elif [ x"$1" = x--guileversion ] ; then
user_scriptsdir=$pkgdatadir/$2/scripts
shift
shift
fi
scriptsdir=${user_scriptsdir-$default_scriptsdir}
if [ ! -d $scriptsdir ] ; then
echo $0: no such directory: $scriptsdir
exit 1
fi
if [ x"$1" = x -o x"$1" = xlist ] ; then
ls $scriptsdir
exit 0
fi
if [ x"$1" = x--source ] ; then
if [ x"$2" = x ] ; then echo $0: need to specify program ; exit 1 ; fi
if [ -x $scriptsdir/$2 ] ; then
cat $scriptsdir/$2
exit 0
else
echo $0: no such program: $2
exit 1
fi
fi
program=$scriptsdir/$1
shift
if [ -x $program ] ; then
exec $program "$@"
else
echo $0: no such program: $program
exit 1
fi
# guile-tools ends here

View file

@ -23,6 +23,8 @@
# when building the rest.
SUBDIRS = . ice-9 srfi oop
include $(top_srcdir)/am/guilec
# We're at the root of the module hierarchy.
modpath =
@ -44,7 +46,9 @@ SOURCES = \
$(SCHEME_LANG_SOURCES) $(ECMASCRIPT_LANG_SOURCES) \
$(GHIL_LANG_SOURCES) $(GLIL_LANG_SOURCES) \
$(ASSEMBLY_LANG_SOURCES) $(BYTECODE_LANG_SOURCES) \
$(OBJCODE_LANG_SOURCES) $(VALUE_LANG_SOURCES)
$(OBJCODE_LANG_SOURCES) $(VALUE_LANG_SOURCES) \
\
$(SCRIPTS_SOURCES)
SCHEME_LANG_SOURCES = \
language/scheme/amatch.scm language/scheme/expand.scm \
@ -84,7 +88,29 @@ ECMASCRIPT_LANG_SOURCES = \
language/ecmascript/array.scm \
language/ecmascript/compile-ghil.scm
SCRIPTS_SOURCES = \
scripts/PROGRAM.scm \
scripts/autofrisk.scm \
scripts/compile.scm \
scripts/disassemble.scm \
scripts/display-commentary.scm \
scripts/doc-snarf.scm \
scripts/frisk.scm \
scripts/generate-autoload.scm \
scripts/lint.scm \
scripts/punify.scm \
scripts/read-scheme-source.scm \
scripts/read-text-outline.scm \
scripts/use2dot.scm \
scripts/snarf-check-and-output-texi.scm \
scripts/summarize-guile-TODO.scm \
scripts/scan-api.scm \
scripts/api-diff.scm \
scripts/read-rfc822.scm \
scripts/snarf-guile-m4-docs.scm
EXTRA_DIST += scripts/ChangeLog-2008
EXTRA_DIST += scripts/README
NOCOMP_SOURCES = \
system/repl/describe.scm
include $(top_srcdir)/am/guilec

5
scripts/PROGRAM → module/scripts/PROGRAM.scm Executable file → Normal file
View file

@ -1,8 +1,3 @@
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(scripts PROGRAM)) '\'main')'
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; PROGRAM --- Does something
;; Copyright (C) 2002, 2006 Free Software Foundation, Inc.

5
scripts/api-diff → module/scripts/api-diff.scm Executable file → Normal file
View file

@ -1,8 +1,3 @@
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(scripts api-diff)) '\'main')'
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; api-diff --- diff guile-api.alist files
;; Copyright (C) 2002, 2006 Free Software Foundation, Inc.

5
scripts/autofrisk → module/scripts/autofrisk.scm Executable file → Normal file
View file

@ -1,8 +1,3 @@
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(scripts autofrisk)) '\'main')'
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; autofrisk --- Generate module checks for use with auto* tools
;; Copyright (C) 2002, 2006 Free Software Foundation, Inc.

6
scripts/compile → module/scripts/compile.scm Executable file → Normal file
View file

@ -1,7 +1,3 @@
#!/bin/sh
# -*- scheme -*-
exec ${GUILE-guile} -e '(@ (scripts compile) compile)' -s $0 "$@"
!#
;;; Compile --- Command-line Guile Scheme compiler
;; Copyright 2005,2008,2009 Free Software Foundation, Inc.
@ -135,6 +131,8 @@ Report bugs to <guile-user@gnu.org>.~%")
#:opts compile-opts)))
input-files)))
(define main compile)
;;; Local Variables:
;;; coding: latin-1
;;; End:

6
scripts/disassemble → module/scripts/disassemble.scm Executable file → Normal file
View file

@ -1,7 +1,3 @@
#!/bin/sh
# -*- scheme -*-
exec ${GUILE-guile} -e '(@ (scripts disassemble) disassemble)' -s $0 "$@"
!#
;;; Disassemble --- Disassemble .go files into something human-readable
;; Copyright 2005,2008 Free Software Foundation, Inc.
@ -39,3 +35,5 @@ exec ${GUILE-guile} -e '(@ (scripts disassemble) disassemble)' -s $0 "$@"
(for-each (lambda (file)
(disassemble (load-objcode file)))
(cdr args)))
(define main disassemble)

View file

@ -1,8 +1,3 @@
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(scripts display-commentary)) '\'main')'
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; display-commentary --- As advertized
;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.

5
scripts/doc-snarf → module/scripts/doc-snarf.scm Executable file → Normal file
View file

@ -1,8 +1,3 @@
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(scripts doc-snarf)) '\'main')'
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; doc-snarf --- Extract documentation from source files
;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.

5
scripts/frisk → module/scripts/frisk.scm Executable file → Normal file
View file

@ -1,8 +1,3 @@
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(scripts frisk)) '\'main')'
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; frisk --- Grok the module interfaces of a body of files
;; Copyright (C) 2002, 2006 Free Software Foundation, Inc.

View file

@ -1,8 +1,3 @@
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(scripts generate-autoload)) '\'main')'
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; generate-autoload --- Display define-module form with autoload info
;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.

5
scripts/lint → module/scripts/lint.scm Executable file → Normal file
View file

@ -1,8 +1,3 @@
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(scripts lint)) '\'main')'
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; lint --- Preemptive checks for coding errors in Guile Scheme code
;; Copyright (C) 2002, 2006 Free Software Foundation, Inc.

5
scripts/punify → module/scripts/punify.scm Executable file → Normal file
View file

@ -1,8 +1,3 @@
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(scripts punify)) '\'main')'
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; punify --- Display Scheme code w/o unnecessary comments / whitespace
;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.

5
scripts/read-rfc822 → module/scripts/read-rfc822.scm Executable file → Normal file
View file

@ -1,8 +1,3 @@
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(scripts read-rfc822)) '\'main')'
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; read-rfc822 --- Validate RFC822 file by displaying it to stdout
;; Copyright (C) 2002, 2004, 2006 Free Software Foundation, Inc.

View file

@ -1,8 +1,3 @@
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(scripts read-scheme-source)) '\'main')'
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; read-scheme-source --- Read a file, recognizing scheme forms and comments
;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.

View file

@ -1,8 +1,3 @@
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(scripts read-text-outline)) '\'main')'
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; read-text-outline --- Read a text outline and display it as a sexp
;; Copyright (C) 2002, 2006 Free Software Foundation, Inc.

5
scripts/scan-api → module/scripts/scan-api.scm Executable file → Normal file
View file

@ -1,8 +1,3 @@
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(scripts scan-api)) '\'main')'
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; scan-api --- Scan and group interpreter and libguile interface elements
;; Copyright (C) 2002, 2006 Free Software Foundation, Inc.

View file

@ -1,8 +1,3 @@
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main="(module-ref (resolve-module '(scripts snarf-check-and-output-texi)) 'main)"
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; snarf-check-and-output-texi --- called by the doc snarfer.
;; Copyright (C) 2001, 2002, 2006 Free Software Foundation, Inc.

View file

@ -1,8 +1,3 @@
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(scripts snarf-guile-m4-docs)) '\'main')'
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; snarf-guile-m4-docs --- Parse guile.m4 comments for texi documentation
;; Copyright (C) 2002, 2006 Free Software Foundation, Inc.

View file

@ -1,8 +1,3 @@
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(scripts summarize-guile-TODO)) '\'main')'
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; summarize-guile-TODO --- Display Guile TODO list in various ways
;; Copyright (C) 2002, 2006 Free Software Foundation, Inc.

5
scripts/use2dot → module/scripts/use2dot.scm Executable file → Normal file
View file

@ -1,8 +1,3 @@
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(scripts use2dot)) '\'main')'
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; use2dot --- Display module dependencies as a DOT specification
;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.

View file

@ -1,70 +0,0 @@
## Process this file with automake to produce Makefile.in.
##
## Copyright (C) 2002, 2006, 2008 Free Software Foundation, Inc.
##
## This file is part of GUILE.
##
## GUILE 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.
##
## GUILE 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 GUILE; see the file COPYING. If not, write
## to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
## Floor, Boston, MA 02110-1301 USA
AUTOMAKE_OPTIONS = gnu
# These should be installed and distributed.
scripts_sources = \
PROGRAM \
autofrisk \
compile \
disassemble \
display-commentary \
doc-snarf \
frisk \
generate-autoload \
lint \
punify \
read-scheme-source \
read-text-outline \
use2dot \
snarf-check-and-output-texi \
summarize-guile-TODO \
scan-api \
api-diff \
read-rfc822 \
snarf-guile-m4-docs
subpkgdatadir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)/scripts
subpkgdata_SCRIPTS = $(scripts_sources)
EXTRA_DIST = $(scripts_sources) ChangeLog-2008
list:
@echo $(scripts_sources)
include $(top_srcdir)/am/pre-inst-guile
overview: $(scripts_sources)
@echo '----------------------------'
@echo Overview
@echo I. Commentaries
@echo II. Module Interfaces
@echo '----------------------------'
@echo I. Commentaries
@echo '----------------------------'
$(preinstguiletool)/display-commentary $^
@echo '----------------------------'
@echo II. Module Interfaces
@echo '----------------------------'
$(preinstguiletool)/frisk $^
# Makefile.am ends here