summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Court`es2006-05-10 16:05:57 +0000
committerLudovic Court`es2006-05-10 16:05:57 +0000
commitf4005161c08d63710871855729198bef5fe81cfb (patch)
treee4a2b6755603d4bf75d5ef61a2d41cc808796283
parent07752b6d47bef3591f1a112a6e0bbcaebfb2fdd3 (diff)
downloadskribilo-f4005161c08d63710871855729198bef5fe81cfb.tar.gz
skribilo-f4005161c08d63710871855729198bef5fe81cfb.tar.lz
skribilo-f4005161c08d63710871855729198bef5fe81cfb.zip
Added biblio helpers (abbrev, author, BibTeX) taken from my `biblib.skr'.
git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-83
-rw-r--r--configure.ac1
-rw-r--r--src/guile/skribilo/Makefile.am2
-rw-r--r--src/guile/skribilo/biblio/Makefile.am4
-rw-r--r--src/guile/skribilo/biblio/abbrev.scm83
-rw-r--r--src/guile/skribilo/biblio/author.scm134
-rw-r--r--src/guile/skribilo/biblio/bibtex.scm83
6 files changed, 306 insertions, 1 deletions
diff --git a/configure.ac b/configure.ac
index ff903ff..7a6d1a9 100644
--- a/configure.ac
+++ b/configure.ac
@@ -39,6 +39,7 @@ AC_OUTPUT([Makefile
src/guile/skribilo/package/eq/Makefile
src/guile/skribilo/skribe/Makefile
src/guile/skribilo/coloring/Makefile
+ src/guile/skribilo/biblio/Makefile
doc/Makefile
doc/user/Makefile
doc/user/src/Makefile
diff --git a/src/guile/skribilo/Makefile.am b/src/guile/skribilo/Makefile.am
index 6689d15..8c17711 100644
--- a/src/guile/skribilo/Makefile.am
+++ b/src/guile/skribilo/Makefile.am
@@ -7,4 +7,4 @@ dist_guilemodule_DATA = biblio.scm color.scm config.scm \
writer.scm ast.scm location.scm \
condition.scm
-SUBDIRS = utils reader engine package skribe coloring
+SUBDIRS = utils reader engine package skribe coloring biblio
diff --git a/src/guile/skribilo/biblio/Makefile.am b/src/guile/skribilo/biblio/Makefile.am
new file mode 100644
index 0000000..9442562
--- /dev/null
+++ b/src/guile/skribilo/biblio/Makefile.am
@@ -0,0 +1,4 @@
+guilemoduledir = $(GUILE_SITE)/skribilo/biblio
+dist_guilemodule_DATA = bibtex.scm author.scm abbrev.scm
+
+## arch-tag: aeffaead-c3f0-47f3-a0b3-bb3e22da2657
diff --git a/src/guile/skribilo/biblio/abbrev.scm b/src/guile/skribilo/biblio/abbrev.scm
new file mode 100644
index 0000000..7b477d1
--- /dev/null
+++ b/src/guile/skribilo/biblio/abbrev.scm
@@ -0,0 +1,83 @@
+;;; abbrev.scm -- Determining abbreviations.
+;;;
+;;; Copyright 2006 Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; 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 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, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;; USA.
+
+(define-module (skribilo biblio abbrev)
+ :use-module (srfi srfi-13)
+ :autoload (ice-9 regex) (regexp-substitute/global)
+ :export (is-abbreviation? is-acronym? abbreviate-word))
+
+;;; Author: Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; Heuristics to identify or generate abbreviations.
+;;;
+;;; Code:
+
+(define (is-abbreviation? str)
+ ;; Return #t if STR denotes an abbreviation or name initial.
+ (and (>= (string-length str) 2)
+ (char=? (string-ref str 1) #\.)))
+
+(define (is-acronym? str)
+ (string=? str (string-upcase str)))
+
+(define (abbreviate-word word)
+ (if (or (string=? "" word)
+ (and (>= (string-length word) 3)
+ (string=? "and" (substring word 0 3)))
+ (is-acronym? word))
+ word
+ (let ((dash (string-index word #\-))
+ (abbr (string (string-ref word 0) #\.)))
+ (if (not dash)
+ abbr
+ (string-append (string (string-ref word 0)) "-"
+ (abbreviate-word
+ (substring word (+ 1 dash)
+ (string-length word))))))))
+
+(define (abbreviate-string subst title)
+ ;; Abbreviate common conference names within TITLE based on the SUBST list
+ ;; of regexp-substitution pairs. This function also removes the
+ ;; abbreviation if it appears in parentheses right after the substitution
+ ;; regexp. Example:
+ ;;
+ ;; "Symposium on Operating Systems Principles (SOSP 2004)"
+ ;;
+ ;; yields
+ ;;
+ ;; "SOSP"
+ ;;
+ (let loop ((title title)
+ (subst subst))
+ (if (null? subst)
+ title
+ (let* ((abbr (cdar subst))
+ (abbr-rexp (string-append "( \\(" abbr "[^\\)]*\\))?"))
+ (to-replace (string-append (caar subst) abbr-rexp)))
+ (loop (regexp-substitute/global #f to-replace title
+ 'pre abbr 'post)
+ (cdr subst))))))
+
+
+;;; arch-tag: 34e0c5bb-592f-467b-b59a-d6f7d130ae4e
+
+;;; abbrev.scm ends here
diff --git a/src/guile/skribilo/biblio/author.scm b/src/guile/skribilo/biblio/author.scm
new file mode 100644
index 0000000..c2b3e6d
--- /dev/null
+++ b/src/guile/skribilo/biblio/author.scm
@@ -0,0 +1,134 @@
+;;; author.scm -- Handling author names.
+;;;
+;;; Copyright 2006 Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; 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 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, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;; USA.
+
+(define-module (skribilo biblio author)
+ :use-module (srfi srfi-13)
+ :use-module (srfi srfi-14)
+ :use-module (skribilo biblio abbrev)
+ :autoload (skribilo utils compat) (skribe-error)
+ :export (comma-separated->author-list
+ comma-separated->and-separated-authors
+
+ extract-first-author-name
+ abbreviate-author-first-names
+ abbreviate-first-names
+ first-author-last-name
+
+ bib-sort/first-author-last-name))
+
+;;; Author: Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; Heuristics to manipulate author names as strings.
+;;;
+;;; Code:
+
+(define (comma-separated->author-list authors)
+ ;; Return a list of strings where each individual string is an author
+ ;; name. AUTHORS is a string representing a list of author names separated
+ ;; by a comma.
+
+ ;; XXX: I should use SRFI-13 instead.
+ (string-split authors #\,))
+
+(define (comma-separated->and-separated-authors authors)
+ ;; Take AUTHORS, a string containing comma-separated author names, and
+ ;; return a string where author names are separated by " and " (suitable
+ ;; for BibTeX).
+ (string-join (comma-separated->author-list authors)
+ " and " 'infix))
+
+
+(define (extract-first-author-name names)
+ ;; Extract the name of the first author from string
+ ;; NAMES that is a comma-separated list of authors.
+ (let ((author-name-end (or (string-index names #\,)
+ (string-length names))))
+ (substring names 0 author-name-end)))
+
+(define (abbreviate-author-first-names name)
+ ;; Abbreviate author first names
+ (let* ((components (string-split name #\space))
+ (component-number (length components)))
+ (apply string-append
+ (append
+ (map (lambda (c)
+ (string-append (abbreviate-word c) " "))
+ (list-head components
+ (- component-number 1)))
+ (list-tail components (- component-number 1))))))
+
+(define (abbreviate-first-names names)
+ ;; Abbreviate first names in NAMES. NAMES is supposed to be
+ ;; something like "Ludovic Courtès, Marc-Olivier Killijian".
+ (let loop ((names ((make-string-replace '((#\newline " ")
+ (#\tab " ")))
+ names))
+ (result ""))
+ (if (string=? names "")
+ result
+ (let* ((len (string-length names))
+ (first-author-names-end (or (string-index names #\,)
+ len))
+ (first-author-names (substring names 0
+ first-author-names-end))
+ (next (substring names
+ (min (+ 1 first-author-names-end) len)
+ len)))
+ (loop next
+ (string-append result
+ (if (string=? "" result) "" ", ")
+ (abbreviate-author-first-names
+ first-author-names)))))))
+
+
+(define (first-author-last-name authors)
+ ;; Return a string containing exactly the last name of the first author.
+ ;; Author names in AUTHORS are assumed to be comma separated.
+ (let loop ((first-author (extract-first-author-name authors)))
+ (let ((space (string-index first-author #\space)))
+ (if (not space)
+ first-author
+ (loop (substring first-author (+ space 1)
+ (string-length first-author)))))))
+
+(define (bib-sort/first-author-last-name entries)
+ ;; May be passed as the `:sort' argument of `the-bibliography'.
+ (let ((check-author (lambda (e)
+ (if (not (markup-option e 'author))
+ (skribe-error 'web
+ "No author for this bib entry"
+ (markup-ident e))
+ #t))))
+ (sort entries
+ (lambda (e1 e2)
+ (let* ((x1 (check-author e1))
+ (x2 (check-author e2))
+ (a1 (first-author-last-name
+ (markup-body (markup-option e1 'author))))
+ (a2 (first-author-last-name
+ (markup-body (markup-option e2 'author)))))
+ (string-ci<=? a1 a2))))))
+
+
+;;; arch-tag: c9a1ef10-a2cd-4a06-bd35-fbdee1abf09a
+
+;;; author.scm ends here
diff --git a/src/guile/skribilo/biblio/bibtex.scm b/src/guile/skribilo/biblio/bibtex.scm
new file mode 100644
index 0000000..be5ed36
--- /dev/null
+++ b/src/guile/skribilo/biblio/bibtex.scm
@@ -0,0 +1,83 @@
+;;; bibtex.scm -- Handling BibTeX references.
+;;;
+;;; Copyright 2006 Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; 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 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, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;; USA.
+
+
+(define-module (skribilo biblio bibtex)
+ :autoload (skribilo runtime) (make-string-replace)
+ :autoload (skribilo ast) (markup-option ast->string)
+ :autoload (skribilo engine) (engine-filter find-engine)
+ :use-module (skribilo biblio author)
+ :use-module (srfi srfi-39)
+ :export (print-as-bibtex-entry))
+
+;;; Author: Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; A set of BibTeX tools, e.g., issuing a BibTeX entry from a `&bib-entry'
+;;; markup object.
+;;;
+;;; Code:
+
+(define *bibtex-author-filter*
+ ;; Defines how the `author' field is to be filtered.
+ (make-parameter comma-separated->and-separated-authors))
+
+(define (print-as-bibtex-entry entry)
+ "Display @code{&bib-entry} object @var{entry} as a BibTeX entry."
+ (let ((show-option (lambda (opt)
+ (let* ((o (markup-option entry opt))
+ (f (make-string-replace '((#\newline " "))))
+ (g (if (eq? opt 'author)
+ (lambda (a)
+ ((*bibtex-author-filter*) (f a)))
+ f)))
+ (if (not o)
+ #f
+ `(,(symbol->string opt)
+ " = \""
+ ,(g (ast->string (markup-body o)))
+ "\","))))))
+ (format #t "@~a{~a,~%"
+ (markup-option entry 'kind)
+ (markup-ident entry))
+ (for-each (lambda (opt)
+ (let* ((o (show-option opt))
+ (tex-filter (engine-filter
+ (find-engine 'latex)))
+ (filter (lambda (n)
+ (tex-filter (ast->string n))))
+ (id (lambda (a) a)))
+ (if o
+ (display
+ (apply string-append
+ `(,@(map (if (eq? 'url opt)
+ id filter)
+ (cons " " o))
+ "\n"))))))
+ '(author institution title
+ booktitle journal number
+ year month url pages address publisher))
+ (display "}\n")))
+
+
+;;; arch-tag: 8b5913cc-9077-4e92-839e-c4c633b7bd46
+
+;;; bibtex.scm ends here