diff --git a/Makefile.am b/Makefile.am deleted file mode 100644 index 2cb2f41..0000000 --- a/Makefile.am +++ /dev/null @@ -1,89 +0,0 @@ -bin_SCRIPTS = scripts/bible-app \ - scripts/word-counter \ - scripts/bible2latex - -# Handle substitution of fully-expanded Autoconf variables. -do_subst = $(SED) \ - -e 's,[@]GUILE[@],$(GUILE),g' \ - -e 's,[@]guilemoduledir[@],$(guilemoduledir),g' \ - -e 's,[@]guileobjectdir[@],$(guileobjectdir),g' \ - -e 's,[@]localedir[@],$(localedir),g' - -nodist_noinst_SCRIPTS = pre-inst-env - -GOBJECTS = $(SOURCES:%.scm=%.go) - -moddir=$(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION) -godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache -ccachedir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache - -nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES) -nobase_go_DATA = $(GOBJECTS) - -# Make sure source files are installed first, so that the mtime of -# installed compiled files is greater than that of installed source -# files. See -# -# for details. -guile_install_go_files = install-nobase_goDATA -$(guile_install_go_files): install-nobase_modDATA - -EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES) -GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat -SUFFIXES = .scm .go -.scm.go: - $(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<" - -SOURCES = bible-tools/latex-export.scm \ - bible-tools/count-words.scm \ - bible-tools.scm - -TESTS = - -TEST_EXTENSIONS = .scm -SCM_LOG_DRIVER = \ - $(top_builddir)/pre-inst-env \ - $(GUILE) --no-auto-compile -e main \ - $(top_srcdir)/build-aux/test-driver.scm - -# Tell 'build-aux/test-driver.scm' to display only source file names, -# not indivdual test names. -AM_SCM_LOG_DRIVER_FLAGS = --brief=yes - -AM_SCM_LOG_FLAGS = --no-auto-compile -L "$(top_srcdir)" - -AM_TESTS_ENVIRONMENT = abs_top_srcdir="$(abs_top_srcdir)" - -info_TEXINFOS = doc/bible-tools.texi -dvi: # Don't build dvi docs - -EXTRA_DIST += ChangeLog \ - AUTHORS \ - NEWS \ - README \ - README.org \ - HACKING \ - COPYING \ - pre-inst-env.in \ - Makefile.am \ - configure.ac \ - build-aux/test-driver.scm \ - build-aux/texinfo.tex \ - build-aux/mdate-sh \ - build-aux/missing \ - build-aux/install-sh \ - guix.scm \ - .gitignore \ - hall.scm \ - build-aux/test-driver.scm \ - $(TESTS) - -ACLOCAL_AMFLAGS = -I m4 - -clean-go: - -$(RM) $(GOBJECTS) -.PHONY: clean-go - -CLEANFILES = \ - $(GOBJECTS) \ - $(TESTS:tests/%.scm=%.log) diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm deleted file mode 100644 index 0c555ea..0000000 --- a/build-aux/test-driver.scm +++ /dev/null @@ -1,179 +0,0 @@ -;;;; test-driver.scm - Guile test driver for Automake testsuite harness - -(define script-version "2019-01-15.13") ;UTC - -;;; Copyright © 2015, 2016 Mathieu Lirzin -;;; Copyright © 2019 Alex Sassmannshausen -;;; -;;; 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 3 of the License, 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 program. If not, see . - -;;;; Commentary: -;;; -;;; This script provides a Guile test driver using the SRFI-64 Scheme API for -;;; test suites. SRFI-64 is distributed with Guile since version 2.0.9. -;;; -;;; This script is a lightly modified version of the orignal written by -;;; Matthieu Lirzin. The changes make it suitable for use as part of the -;;; guile-hall infrastructure. -;;; -;;;; Code: - -(use-modules (ice-9 getopt-long) - (ice-9 pretty-print) - (srfi srfi-26) - (srfi srfi-64)) - -(define (show-help) - (display "Usage: - test-driver --test-name=NAME --log-file=PATH --trs-file=PATH - [--expect-failure={yes|no}] [--color-tests={yes|no}] - [--enable-hard-errors={yes|no}] [--brief={yes|no}}] [--] - TEST-SCRIPT [TEST-SCRIPT-ARGUMENTS] -The '--test-name', '--log-file' and '--trs-file' options are mandatory. -")) - -(define %options - '((test-name (value #t)) - (log-file (value #t)) - (trs-file (value #t)) - (color-tests (value #t)) - (expect-failure (value #t)) ;XXX: not implemented yet - (enable-hard-errors (value #t)) ;not implemented in SRFI-64 - (brief (value #t)) - (help (single-char #\h) (value #f)) - (version (single-char #\V) (value #f)))) - -(define (option->boolean options key) - "Return #t if the value associated with KEY in OPTIONS is 'yes'." - (and=> (option-ref options key #f) (cut string=? <> "yes"))) - -(define* (test-display field value #:optional (port (current-output-port)) - #:key pretty?) - "Display 'FIELD: VALUE\n' on PORT." - (if pretty? - (begin - (format port "~A:~%" field) - (pretty-print value port #:per-line-prefix "+ ")) - (format port "~A: ~S~%" field value))) - -(define* (result->string symbol #:key colorize?) - "Return SYMBOL as an upper case string. Use colors when COLORIZE is #t." - (let ((result (string-upcase (symbol->string symbol)))) - (if colorize? - (string-append (case symbol - ((pass) "") ;green - ((xfail) "") ;light green - ((skip) "") ;blue - ((fail xpass) "") ;red - ((error) "")) ;magenta - result - "") ;no color - result))) - -(define* (test-runner-gnu test-name #:key color? brief? out-port trs-port) - "Return an custom SRFI-64 test runner. TEST-NAME is a string specifying the -file name of the current the test. COLOR? specifies whether to use colors, -and BRIEF?, well, you know. OUT-PORT and TRS-PORT must be output ports. The -current output port is supposed to be redirected to a '.log' file." - - (define (test-on-test-begin-gnu runner) - ;; Procedure called at the start of an individual test case, before the - ;; test expression (and expected value) are evaluated. - (let ((result (cute assq-ref (test-result-alist runner) <>))) - (format #t "test-name: ~A~%" (result 'test-name)) - (format #t "location: ~A~%" - (string-append (result 'source-file) ":" - (number->string (result 'source-line)))) - (test-display "source" (result 'source-form) #:pretty? #t))) - - (define (test-on-test-end-gnu runner) - ;; Procedure called at the end of an individual test case, when the result - ;; of the test is available. - (let* ((results (test-result-alist runner)) - (result? (cut assq <> results)) - (result (cut assq-ref results <>))) - (unless brief? - ;; Display the result of each test case on the console. - (format out-port "~A: ~A - ~A~%" - (result->string (test-result-kind runner) #:colorize? color?) - test-name (test-runner-test-name runner))) - (when (result? 'expected-value) - (test-display "expected-value" (result 'expected-value))) - (when (result? 'expected-error) - (test-display "expected-error" (result 'expected-error) #:pretty? #t)) - (when (result? 'actual-value) - (test-display "actual-value" (result 'actual-value))) - (when (result? 'actual-error) - (test-display "actual-error" (result 'actual-error) #:pretty? #t)) - (format #t "result: ~a~%" (result->string (result 'result-kind))) - (newline) - (format trs-port ":test-result: ~A ~A~%" - (result->string (test-result-kind runner)) - (test-runner-test-name runner)))) - - (define (test-on-group-end-gnu runner) - ;; Procedure called by a 'test-end', including at the end of a test-group. - (let ((fail (or (positive? (test-runner-fail-count runner)) - (positive? (test-runner-xpass-count runner)))) - (skip (or (positive? (test-runner-skip-count runner)) - (positive? (test-runner-xfail-count runner))))) - ;; XXX: The global results need some refinements for XPASS. - (format trs-port ":global-test-result: ~A~%" - (if fail "FAIL" (if skip "SKIP" "PASS"))) - (format trs-port ":recheck: ~A~%" - (if fail "yes" "no")) - (format trs-port ":copy-in-global-log: ~A~%" - (if (or fail skip) "yes" "no")) - (when brief? - ;; Display the global test group result on the console. - (format out-port "~A: ~A~%" - (result->string (if fail 'fail (if skip 'skip 'pass)) - #:colorize? color?) - test-name)) - #f)) - - (let ((runner (test-runner-null))) - (test-runner-on-test-begin! runner test-on-test-begin-gnu) - (test-runner-on-test-end! runner test-on-test-end-gnu) - (test-runner-on-group-end! runner test-on-group-end-gnu) - (test-runner-on-bad-end-name! runner test-on-bad-end-name-simple) - runner)) - -;;; -;;; Entry point. -;;; - -(define (main . args) - (let* ((opts (getopt-long (command-line) %options)) - (option (cut option-ref opts <> <>))) - (cond - ((option 'help #f) (show-help)) - ((option 'version #f) (format #t "test-driver.scm ~A" script-version)) - (else - (let ((log (open-file (option 'log-file "") "w0")) - (trs (open-file (option 'trs-file "") "wl")) - (out (duplicate-port (current-output-port) "wl"))) - (redirect-port log (current-output-port)) - (redirect-port log (current-warning-port)) - (redirect-port log (current-error-port)) - (test-with-runner - (test-runner-gnu (option 'test-name #f) - #:color? (option->boolean opts 'color-tests) - #:brief? (option->boolean opts 'brief) - #:out-port out #:trs-port trs) - (load-from-path (option 'test-name #f))) - (close-port log) - (close-port trs) - (close-port out)))) - (exit 0))) diff --git a/configure.ac b/configure.ac deleted file mode 100644 index 02878dd..0000000 --- a/configure.ac +++ /dev/null @@ -1,36 +0,0 @@ -dnl -*- Autoconf -*- - -AC_INIT(bible-tools, 1.0) -AC_SUBST(HVERSION, "\"1.0\"") -AC_SUBST(AUTHOR, "\"\"") -AC_SUBST(COPYRIGHT, "'(2022)") -AC_SUBST(LICENSE, gpl3+) -AC_CONFIG_SRCDIR(bible-tools.scm) -AC_CONFIG_AUX_DIR([build-aux]) -AM_INIT_AUTOMAKE([1.12 gnu silent-rules subdir-objects color-tests parallel-tests -Woverride -Wno-portability]) -AM_SILENT_RULES([yes]) - -AC_CONFIG_FILES([Makefile]) -AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env]) -AC_CONFIG_FILES([scripts/bible-app],[chmod +x scripts/bible-app]) -AC_CONFIG_FILES([scripts/word-counter],[chmod +x scripts/word-counter]) -AC_CONFIG_FILES([scripts/bible2latex],[chmod +x scripts/bible2latex]) -dnl Search for 'guile' and 'guild'. This macro defines -dnl 'GUILE_EFFECTIVE_VERSION'. -GUILE_PKG([3.0 2.2 2.0]) -GUILE_PROGS -GUILE_SITE_DIR -if test "x$GUILD" = "x"; then - AC_MSG_ERROR(['guild' binary not found; please check your guile-2.x installation.]) -fi - -dnl Hall auto-generated guile-module dependencies - - -dnl Installation directories for .scm and .go files. -guilemoduledir="${datarootdir}/guile/site/$GUILE_EFFECTIVE_VERSION" -guileobjectdir="${libdir}/guile/$GUILE_EFFECTIVE_VERSION/site-ccache" -AC_SUBST([guilemoduledir]) -AC_SUBST([guileobjectdir]) - -AC_OUTPUT diff --git a/doc/bible-tools.texi b/doc/bible-tools.texi index a924753..a01ce95 100644 --- a/doc/bible-tools.texi +++ b/doc/bible-tools.texi @@ -72,14 +72,14 @@ the bible. It takes the name of a bible book as the first argument and additionally 3 flags: [-h, -v, -c]. -@list +@itemize @item -h shows a help message @item -v shows the version @item -c specifies a chapter -@end list +@end itemize @c********************************************************************* @node bible2latex diff --git a/hall.scm b/hall.scm index 00ff5d8..dd2827c 100644 --- a/hall.scm +++ b/hall.scm @@ -15,34 +15,25 @@ "bible-tools" ((scheme-file "latex-export") (scheme-file "count-words"))) - (scheme-file "bible-tools"))) + (scheme-file "bible-tools"))) (tests ((directory "tests" ()))) (programs ((directory "scripts" ((in-file "bible-app") (in-file "word-counter") - (in-file "bible2latex"))))) + (in-file "bible2latex") + (in-file "read-bible"))))) (documentation - ((text-file "ChangeLog") - (text-file "AUTHORS") - (text-file "NEWS") + ((directory "doc" ((texi-file "bible-tools"))) + (text-file "COPYING") + (text-file "HACKING") (symlink "README" "README.org") (org-file "README") - (text-file "HACKING") - (text-file "COPYING") - (directory "doc" ((texi-file "bible-tools"))))) + (text-file "NEWS") + (text-file "AUTHORS") + (text-file "ChangeLog"))) (infrastructure - ((in-file "pre-inst-env") - (automake-file "Makefile") - (autoconf-file "configure") - (directory - "build-aux" - ((scheme-file "test-driver") - (tex-file "texinfo") - (text-file "mdate-sh") - (text-file "missing") - (text-file "install-sh"))) - (scheme-file "guix") + ((scheme-file "hall") (text-file ".gitignore") - (scheme-file "hall"))))) + (scheme-file "guix"))))) diff --git a/pre-inst-env.in b/pre-inst-env.in deleted file mode 100644 index 31c499d..0000000 --- a/pre-inst-env.in +++ /dev/null @@ -1,13 +0,0 @@ -#!/bin/sh - -abs_top_srcdir="`cd "@abs_top_srcdir@" > /dev/null; pwd`" -abs_top_builddir="`cd "@abs_top_builddir@" > /dev/null; pwd`" - -GUILE_LOAD_COMPILED_PATH="$abs_top_builddir${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH" -GUILE_LOAD_PATH="$abs_top_builddir:$abs_top_srcdir${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH" -export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH - -PATH="$abs_top_builddir/scripts:$PATH" -export PATH - -exec "$@" diff --git a/scripts/read-bible.in b/scripts/read-bible.in new file mode 100644 index 0000000..727d268 --- /dev/null +++ b/scripts/read-bible.in @@ -0,0 +1,41 @@ +#! /usr/bin/env sh +exec guile -e '(@ (read-bible) main)' -s "$0" "$@" +!# + +(define-module (read-bible) + #:use-module (bible-tools) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:export (main)) + +(define (verse->string v) + (string-append (book v) " " (chapter v) ":" (verse v) "\t" (text v))) + +(define (print-text txt) + (for-each (lambda (str) (display str) (newline)) + (map verse->string txt))) + +(define (help) + (display "Usage: read-bible bible [-b book] [-c chapter] [-h] [-v]\n") + (display "\t-b book\t\tthe book to read\n") + (display "\t-c chapter\tthe chapter to read\n") + (display "\t-h\t\tdisplay this help message\n") + (display "\t-v\t\tdisplay the current version\n")) + +(define (version) + (display "read-bible v1.0.0\n")) + +(define (main args) + (define flag? (cut member <> args)) + (define get (compose cadr flag?)) + (define-syntax conf + (syntax-rules (else) + ((_ (f e)... (else g)) (cond ((flag? f) e)... (else g))))) + (with-bible (cadr args) + (conf ("-h" (help)) + ("-v" (version)) + ("-b" (if (flag? "-c") + (call-with-chapter (get "-b") (get "-c") + print-text) + (call-with-book (get "-b") print-text))) + (else (help)))))