Silas Vedder
2 years ago
commit
8b23959fed
16 changed files with 753 additions and 0 deletions
@ -0,0 +1,65 @@ |
|||||||
|
*.eps |
||||||
|
*.go |
||||||
|
*.log |
||||||
|
*.pdf |
||||||
|
*.png |
||||||
|
*.tar.xz |
||||||
|
*.tar.gz |
||||||
|
*.tmp |
||||||
|
*~ |
||||||
|
.#* |
||||||
|
\#*\# |
||||||
|
,* |
||||||
|
/ABOUT-NLS |
||||||
|
/INSTALL |
||||||
|
/aclocal.m4 |
||||||
|
/autom4te.cache |
||||||
|
/build-aux/ar-lib |
||||||
|
/build-aux/compile |
||||||
|
/build-aux/config.guess |
||||||
|
/build-aux/config.rpath |
||||||
|
/build-aux/config.sub |
||||||
|
/build-aux/depcomp |
||||||
|
/build-aux/install-sh |
||||||
|
/build-aux/mdate-sh |
||||||
|
/build-aux/missing |
||||||
|
/build-aux/test-driver |
||||||
|
/build-aux/texinfo.tex |
||||||
|
/config.status |
||||||
|
/configure |
||||||
|
/doc/*.1 |
||||||
|
/doc/.dirstamp |
||||||
|
/doc/contributing.*.texi |
||||||
|
/doc/*.aux |
||||||
|
/doc/*.cp |
||||||
|
/doc/*.cps |
||||||
|
/doc/*.fn |
||||||
|
/doc/*.fns |
||||||
|
/doc/*.html |
||||||
|
/doc/*.info |
||||||
|
/doc/*.info-[0-9] |
||||||
|
/doc/*.ky |
||||||
|
/doc/*.pg |
||||||
|
/doc/*.toc |
||||||
|
/doc/*.t2p |
||||||
|
/doc/*.tp |
||||||
|
/doc/*.vr |
||||||
|
/doc/*.vrs |
||||||
|
/doc/stamp-vti |
||||||
|
/doc/version.texi |
||||||
|
/doc/version-*.texi |
||||||
|
/m4/* |
||||||
|
/pre-inst-env |
||||||
|
/test-env |
||||||
|
/test-tmp |
||||||
|
/tests/*.trs |
||||||
|
GPATH |
||||||
|
GRTAGS |
||||||
|
GTAGS |
||||||
|
Makefile |
||||||
|
Makefile.in |
||||||
|
config.cache |
||||||
|
stamp-h[0-9] |
||||||
|
tmp |
||||||
|
/.version |
||||||
|
/doc/stamp-[0-9] |
||||||
@ -0,0 +1,3 @@ |
|||||||
|
This project's license is GPL 3+. |
||||||
|
|
||||||
|
You can read the full license at https://www.gnu.org/licenses/gpl.html. |
||||||
@ -0,0 +1 @@ |
|||||||
|
For a complete log, please see the Git commit log at </PATH/TO/LOG>. |
||||||
@ -0,0 +1,47 @@ |
|||||||
|
# -*- mode: org; coding: utf-8; -*- |
||||||
|
|
||||||
|
#+TITLE: Hacking bible-tools |
||||||
|
|
||||||
|
* Contributing |
||||||
|
|
||||||
|
By far the easiest way to hack on bible-tools is to develop using Guix: |
||||||
|
|
||||||
|
#+BEGIN_SRC bash |
||||||
|
# Obtain the source code |
||||||
|
cd /path/to/source-code |
||||||
|
guix environment -l guix.scm |
||||||
|
# In the new shell, run: |
||||||
|
hall dist --execute && autoreconf -vif && ./configure && make check |
||||||
|
#+END_SRC |
||||||
|
|
||||||
|
You can now hack this project's files to your heart's content, whilst |
||||||
|
testing them from your `guix environment' shell. |
||||||
|
|
||||||
|
To try out any scripts in the project you can now use |
||||||
|
|
||||||
|
#+BEGIN_SRC bash |
||||||
|
./pre-inst-env scripts/${script-name} |
||||||
|
#+END_SRC |
||||||
|
|
||||||
|
If you'd like to tidy the project again, but retain the ability to test the |
||||||
|
project from the commandline, simply run: |
||||||
|
|
||||||
|
#+BEGIN_SRC bash |
||||||
|
./hall clean --skip "scripts/${script-name},pre-inst-env" --execute |
||||||
|
#+END_SRC |
||||||
|
|
||||||
|
** Manual Installation |
||||||
|
|
||||||
|
If you do not yet use Guix, you will have to install this project's |
||||||
|
dependencies manually: |
||||||
|
- autoconf |
||||||
|
- automake |
||||||
|
- pkg-config |
||||||
|
- texinfo |
||||||
|
- guile-hall |
||||||
|
|
||||||
|
Once those dependencies are installed you can run: |
||||||
|
|
||||||
|
#+BEGIN_SRC bash |
||||||
|
hall dist -x && autoreconf -vif && ./configure && make check |
||||||
|
#+END_SRC |
||||||
@ -0,0 +1,75 @@ |
|||||||
|
bin_SCRIPTS = scripts/bible2latex \
|
||||||
|
scripts/count-words
|
||||||
|
|
||||||
|
# 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
|
||||||
|
# <http://lists.gnu.org/archive/html/guile-devel/2010-07/msg00125.html>
|
||||||
|
# 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.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 += COPYING \
|
||||||
|
HACKING \
|
||||||
|
README \
|
||||||
|
README.org \
|
||||||
|
hall.scm \
|
||||||
|
.gitignore \
|
||||||
|
guix.scm \
|
||||||
|
build-aux/test-driver.scm \
|
||||||
|
$(TESTS)
|
||||||
|
|
||||||
|
ACLOCAL_AMFLAGS = -I m4
|
||||||
|
|
||||||
|
clean-go: |
||||||
|
-$(RM) $(GOBJECTS)
|
||||||
|
.PHONY: clean-go |
||||||
|
|
||||||
|
CLEANFILES = \
|
||||||
|
$(GOBJECTS) \
|
||||||
|
$(TESTS:tests/%.scm=%.log)
|
||||||
@ -0,0 +1,14 @@ |
|||||||
|
# -*- mode: org; coding: utf-8; -*- |
||||||
|
|
||||||
|
#+TITLE: Bible-Tools NEWS ? history of user-visible changes |
||||||
|
#+STARTUP: content hidestars |
||||||
|
|
||||||
|
Copyright ? (2022) <INSERT EMAIL HERE> |
||||||
|
|
||||||
|
Copying and distribution of this file, with or without modification, |
||||||
|
are permitted in any medium without royalty provided the copyright |
||||||
|
notice and this notice are preserved. |
||||||
|
|
||||||
|
Please send Bible-Tools bug reports to INSERT EMAIL HERE. |
||||||
|
|
||||||
|
* Publication at 1.0 |
||||||
@ -0,0 +1,35 @@ |
|||||||
|
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/bible2latex],[chmod +x scripts/bible2latex]) |
||||||
|
AC_CONFIG_FILES([scripts/count-words],[chmod +x scripts/count-words]) |
||||||
|
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 |
||||||
@ -0,0 +1,60 @@ |
|||||||
|
\input texinfo |
||||||
|
@c -*-texinfo-*- |
||||||
|
|
||||||
|
@c %**start of header |
||||||
|
@setfilename bible-tools.info |
||||||
|
@documentencoding UTF-8 |
||||||
|
@settitle Bible-Tools Reference Manual |
||||||
|
@c %**end of header |
||||||
|
|
||||||
|
@include version.texi |
||||||
|
|
||||||
|
@copying |
||||||
|
Copyright @copyright{} 2022 |
||||||
|
|
||||||
|
Permission is granted to copy, distribute and/or modify this document |
||||||
|
under the terms of the GNU Free Documentation License, Version 1.3 or |
||||||
|
any later version published by the Free Software Foundation; with no |
||||||
|
Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. A |
||||||
|
copy of the license is included in the section entitled ``GNU Free |
||||||
|
Documentation License''. |
||||||
|
@end copying |
||||||
|
|
||||||
|
@dircategory The Algorithmic Language Scheme |
||||||
|
@direntry |
||||||
|
* Bible-Tools: (bible-tools). |
||||||
|
@end direntry |
||||||
|
|
||||||
|
@titlepage |
||||||
|
@title The Bible-Tools Manual |
||||||
|
@author |
||||||
|
|
||||||
|
@page |
||||||
|
@vskip 0pt plus 1filll |
||||||
|
Edition @value{EDITION} @* |
||||||
|
@value{UPDATED} @* |
||||||
|
|
||||||
|
@insertcopying |
||||||
|
@end titlepage |
||||||
|
|
||||||
|
@contents |
||||||
|
|
||||||
|
@c ********************************************************************* |
||||||
|
@node Top |
||||||
|
@top Bible-Tools |
||||||
|
|
||||||
|
This document describes Bible-Tools version @value{VERSION}. |
||||||
|
|
||||||
|
@menu |
||||||
|
* Introduction:: Why Bible-Tools? |
||||||
|
@end menu |
||||||
|
|
||||||
|
@c ********************************************************************* |
||||||
|
@node Introduction |
||||||
|
@chapter Introduction |
||||||
|
|
||||||
|
INTRODUCTION HERE |
||||||
|
|
||||||
|
This documentation is a stub. |
||||||
|
|
||||||
|
@bye |
||||||
@ -0,0 +1,84 @@ |
|||||||
|
(use-modules |
||||||
|
(guix packages) |
||||||
|
((guix licenses) #:prefix license:) |
||||||
|
(guix download) |
||||||
|
(guix build-system gnu) |
||||||
|
(gnu packages) |
||||||
|
(gnu packages autotools) |
||||||
|
(gnu packages guile) |
||||||
|
(gnu packages guile-xyz) |
||||||
|
(gnu packages pkg-config) |
||||||
|
(gnu packages texinfo)) |
||||||
|
|
||||||
|
(package |
||||||
|
(name "bible-tools") |
||||||
|
(version "1.0") |
||||||
|
(source "./bible-tools-1.0.tar.gz") |
||||||
|
(build-system gnu-build-system) |
||||||
|
(arguments |
||||||
|
`(#:modules |
||||||
|
((ice-9 match) |
||||||
|
(ice-9 ftw) |
||||||
|
,@%gnu-build-system-modules) |
||||||
|
#:phases |
||||||
|
(modify-phases |
||||||
|
%standard-phases |
||||||
|
(add-after |
||||||
|
'install |
||||||
|
'hall-wrap-binaries |
||||||
|
(lambda* (#:key inputs outputs #:allow-other-keys) |
||||||
|
(let* ((compiled-dir |
||||||
|
(lambda (out version) |
||||||
|
(string-append |
||||||
|
out |
||||||
|
"/lib/guile/" |
||||||
|
version |
||||||
|
"/site-ccache"))) |
||||||
|
(uncompiled-dir |
||||||
|
(lambda (out version) |
||||||
|
(string-append |
||||||
|
out |
||||||
|
"/share/guile/site" |
||||||
|
(if (string-null? version) "" "/") |
||||||
|
version))) |
||||||
|
(dep-path |
||||||
|
(lambda (env modules path) |
||||||
|
(list env |
||||||
|
":" |
||||||
|
'prefix |
||||||
|
(cons modules |
||||||
|
(map (lambda (input) |
||||||
|
(string-append |
||||||
|
(assoc-ref inputs input) |
||||||
|
path)) |
||||||
|
,''()))))) |
||||||
|
(out (assoc-ref outputs "out")) |
||||||
|
(bin (string-append out "/bin/")) |
||||||
|
(site (uncompiled-dir out ""))) |
||||||
|
(match (scandir site) |
||||||
|
(("." ".." version) |
||||||
|
(for-each |
||||||
|
(lambda (file) |
||||||
|
(wrap-program |
||||||
|
(string-append bin file) |
||||||
|
(dep-path |
||||||
|
"GUILE_LOAD_PATH" |
||||||
|
(uncompiled-dir out version) |
||||||
|
(uncompiled-dir "" version)) |
||||||
|
(dep-path |
||||||
|
"GUILE_LOAD_COMPILED_PATH" |
||||||
|
(compiled-dir out version) |
||||||
|
(compiled-dir "" version)))) |
||||||
|
,''("bible2latex" "count-words")) |
||||||
|
#t)))))))) |
||||||
|
(native-inputs |
||||||
|
`(("autoconf" ,autoconf) |
||||||
|
("automake" ,automake) |
||||||
|
("pkg-config" ,pkg-config) |
||||||
|
("texinfo" ,texinfo))) |
||||||
|
(inputs `(("guile" ,guile-3.0))) |
||||||
|
(propagated-inputs `()) |
||||||
|
(synopsis "") |
||||||
|
(description "") |
||||||
|
(home-page "") |
||||||
|
(license license:gpl3+)) |
||||||
@ -0,0 +1,46 @@ |
|||||||
|
(hall-description |
||||||
|
(name "bible-tools") |
||||||
|
(prefix "") |
||||||
|
(version "1.0") |
||||||
|
(author "") |
||||||
|
(copyright (2022)) |
||||||
|
(synopsis "") |
||||||
|
(description "") |
||||||
|
(home-page "") |
||||||
|
(license gpl3+) |
||||||
|
(dependencies `()) |
||||||
|
(skip ()) |
||||||
|
(files (libraries ((directory "bible-tools" ()))) |
||||||
|
(tests ((directory "tests" ()))) |
||||||
|
(programs |
||||||
|
((directory |
||||||
|
"scripts" |
||||||
|
((in-file "bible2latex") (in-file "count-words"))))) |
||||||
|
(documentation |
||||||
|
((text-file "ChangeLog") |
||||||
|
(text-file "AUTHORS") |
||||||
|
(text-file "NEWS") |
||||||
|
(symlink "README" "README.org") |
||||||
|
(text-file "HACKING") |
||||||
|
(text-file "COPYING") |
||||||
|
(directory |
||||||
|
"doc" |
||||||
|
((texi-file "bible-tools") |
||||||
|
(text-file "stamp-vti") |
||||||
|
(info-file "bible-tools") |
||||||
|
(text-file ".dirstamp") |
||||||
|
(texi-file "version"))))) |
||||||
|
(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") |
||||||
|
(text-file ".gitignore") |
||||||
|
(scheme-file "hall"))))) |
||||||
@ -0,0 +1,13 @@ |
|||||||
|
#!/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 "$@" |
||||||
@ -0,0 +1,62 @@ |
|||||||
|
#! /usr/bin/env sh |
||||||
|
exec guile -l bible-tools.scm -e '(@ (bible2latex) main)' -s bible2latex "$@" |
||||||
|
!# |
||||||
|
|
||||||
|
(define-module (bible2latex) |
||||||
|
#:use-module (bible-tools) |
||||||
|
#:use-module (srfi srfi-1) |
||||||
|
#:export (main)) |
||||||
|
|
||||||
|
(define (verse-to-latex v) |
||||||
|
(string-append (if (string=? (verse v) "1") |
||||||
|
(string-append (if (string=? (chapter v) "1") |
||||||
|
(string-append "\\section{" (book v) "}\n") "") |
||||||
|
"\\textbf{\\large{" (chapter v) "}}\n") |
||||||
|
"") |
||||||
|
"\\textsuperscript{" (verse v) "}" (text v))) |
||||||
|
|
||||||
|
(define (print-text text) |
||||||
|
(let ((result (string-append "\\documentclass{article}\n\n" |
||||||
|
"\\usepackage{fullpage}\n\n" |
||||||
|
"\\begin{document}\n\n" |
||||||
|
(string-join |
||||||
|
(map verse-to-latex text) |
||||||
|
"\n\n") |
||||||
|
"\n\\end{document}"))) |
||||||
|
(display result) |
||||||
|
(newline))) |
||||||
|
|
||||||
|
|
||||||
|
(define (help) |
||||||
|
(display "Usage: bible2latex [-b book] [-c chapter] [-h] [-v]\n") |
||||||
|
(display "\t-b book\t\texport the book to latex\n") |
||||||
|
(display "\t-c chapter\texport this chapter to latex\n") |
||||||
|
(display "\t-h\t\tdisplay this help message\n") |
||||||
|
(display "\t-v\t\tdisplay the current version\n")) |
||||||
|
|
||||||
|
(define (version) |
||||||
|
(display "bible2latex v1.0.0\n")) |
||||||
|
|
||||||
|
(define (print-book book) |
||||||
|
(lambda (bible) |
||||||
|
(print-text (get-book book bible)))) |
||||||
|
|
||||||
|
(define (print-chapter book chapter) |
||||||
|
(lambda (bible) |
||||||
|
(print-text (get-chapter (string->number chapter) |
||||||
|
(get-book book bible))))) |
||||||
|
|
||||||
|
|
||||||
|
(define (main args) |
||||||
|
(define (get-flag flag) |
||||||
|
(cadr (member flag args))) |
||||||
|
(define (flag? flag) |
||||||
|
(member flag args)) |
||||||
|
(with-bible "jantzen" |
||||||
|
(cond ((flag? "-h") (help)) |
||||||
|
((flag? "-v") (version)) |
||||||
|
((flag? "-b") (if (flag? "-c") |
||||||
|
(print-chapter (get-flag "-b") |
||||||
|
(get-flag "-c")) |
||||||
|
(print-book (get-flag "-b")))) |
||||||
|
(else print-text)))) |
||||||
@ -0,0 +1,65 @@ |
|||||||
|
#! /usr/bin/env sh |
||||||
|
exec guile -l bible-tools.scm -e '(@ (count-words) main)' -s count-words "$@" |
||||||
|
!# |
||||||
|
|
||||||
|
(define-module (count-words) |
||||||
|
#:use-module (bible-tools) |
||||||
|
#:use-module (srfi srfi-1) |
||||||
|
#:export (main)) |
||||||
|
|
||||||
|
(define (split/stuff str) |
||||||
|
(let ((words (string-split str #\space)) |
||||||
|
(fs (map (lambda (char) |
||||||
|
(lambda (str) (string-split str char))) |
||||||
|
'(#\, #\: #\. #\! #\? #\; #\< #\>)))) |
||||||
|
(filter (lambda (str) (not (string=? "" str))) |
||||||
|
(fold (lambda (f val) (mapcan f val)) words fs)))) |
||||||
|
|
||||||
|
(define (count verse result) |
||||||
|
(let ((words (split/stuff verse))) |
||||||
|
(fold (lambda (word res) |
||||||
|
(let ((val (assoc word res))) |
||||||
|
(if val |
||||||
|
(alist-cons word (+ (cdr val) 1) res) |
||||||
|
(alist-cons word 1 res)))) |
||||||
|
result words))) |
||||||
|
|
||||||
|
(define (count-words verses) |
||||||
|
(delete-duplicates (sort (fold count '() verses) |
||||||
|
(lambda (a b) (> (cdr a) (cdr b)))) |
||||||
|
(lambda (a b) (equal? (car a) (car b))))) |
||||||
|
|
||||||
|
(define (show-meta txt) |
||||||
|
(let ((count (count-words (map text txt)))) |
||||||
|
(for-each (lambda (word) |
||||||
|
(display |
||||||
|
(string-append (car word) |
||||||
|
":\t" |
||||||
|
(number->string (cdr word)) |
||||||
|
"\n"))) |
||||||
|
count))) |
||||||
|
|
||||||
|
(define (help) |
||||||
|
(display "Usage: count-words [book] [-c chapter] [-h] [-v]\n") |
||||||
|
(display "\t-c chapter count the words in this chapter\n") |
||||||
|
(display "\t-h display this help message\n") |
||||||
|
(display "\t-v display the current version\n")) |
||||||
|
|
||||||
|
(define (version) |
||||||
|
(display "count-words v1.0.0\n")) |
||||||
|
|
||||||
|
(define (show-book book) |
||||||
|
(lambda (bible) |
||||||
|
(show-meta (get-book book bible)))) |
||||||
|
|
||||||
|
(define (show-chapter book chapter) |
||||||
|
(lambda (bible) |
||||||
|
(show-meta (get-chapter chapter (get-book book bible))))) |
||||||
|
|
||||||
|
(define (main args) |
||||||
|
(with-bible "jantzen" |
||||||
|
(cond ((< (length args) 2) (help)) |
||||||
|
((member "-h" args) (help)) |
||||||
|
((member "-v" args) (version)) |
||||||
|
((member "-c" args) (show-chapter (cadr args) (string->number (cadr (member "-c" args))))) |
||||||
|
(else (show-book (cadr args)))))) |
||||||
Loading…
Reference in new issue