diff options
Diffstat (limited to 'src/guile')
| -rw-r--r-- | src/guile/skribilo/biblio.scm | 37 | ||||
| -rw-r--r-- | src/guile/skribilo/engine/base.scm | 54 | ||||
| -rw-r--r-- | src/guile/skribilo/engine/context.scm | 22 | ||||
| -rw-r--r-- | src/guile/skribilo/engine/html.scm | 23 | ||||
| -rw-r--r-- | src/guile/skribilo/engine/latex.scm | 33 | ||||
| -rw-r--r-- | src/guile/skribilo/engine/lout.scm | 87 | ||||
| -rw-r--r-- | src/guile/skribilo/package/base.scm | 12 |
7 files changed, 96 insertions, 172 deletions
diff --git a/src/guile/skribilo/biblio.scm b/src/guile/skribilo/biblio.scm index 64eaea4..0f5cfce 100644 --- a/src/guile/skribilo/biblio.scm +++ b/src/guile/skribilo/biblio.scm @@ -48,9 +48,12 @@ ;; entry labels assign-entries-numbers! assign-entries-name+years! - ;; sorting entries + ;; sorting the bibliography bib-sort/authors bib-sort/idents bib-sort/dates + ;; sorting consecutive entries in a `ref' + bib-sort-refs/number + ;; error conditions &biblio-error &biblio-entry-error &biblio-template-error &biblio-parse-error @@ -307,7 +310,7 @@ ;;; -;;; Sorting. +;;; Sorting the bibliography. ;;; ;*---------------------------------------------------------------------*/ @@ -400,12 +403,38 @@ ;;; +;;; Sorting consecutive entries in a `ref'. +;;; + +;; The following procedure handles sorting entries in a `ref' with multiple +;; entries: +;; +;; (ref :bib '("smith81:disintegration" "corgan07:zeitgeist")) +;; +;; This is pleasant when entries are numbered since it allows them to appear +;; in the right order, e.g., "[2,5]". + +(define (bib-sort-refs/number entry1 entry2) + ;; Default implementation of the `bib-refs-sort-proc' custom. Compare + ;; bibliography entries `entry1' and `entry2' (of type `&bib-entry') for + ;; use by `sort' in `bib-ref+'. + (let ((ident1 (markup-option entry1 :title)) + (ident2 (markup-option entry2 :title))) + (and (markup? ident1) (markup? ident2) + (let ((n1 (markup-option ident1 'number)) + (n2 (markup-option ident2 'number))) + (and (number? n1) (number? n2) + (< n1 n2)))))) + + + +;;; ;;; Bibliography creation and entry name assignment. ;;; (define (assign-entries-numbers! entries) ;; Traverse `&bib-entry' markups in ENTRIES and add them a `:title' option - ;; whose content is a `&bib-entry-ident' markup suitable numbered. + ;; whose content is a `&bib-entry-ident' markup suitably numbered. (let loop ((es entries) (i 1)) (if (pair? es) @@ -491,7 +520,7 @@ es))) ;; XXX: Assigning identifiers through side-effects is somewhat - ;; broken since it precludes the production of more several + ;; flawed since it precludes the production of several ;; bibliographies with different styles in a single document (e.g., ;; the user manual cannot illustrate more than one style). (assign-entries-identifiers! (if (eq? count 'full) es fes)) diff --git a/src/guile/skribilo/engine/base.scm b/src/guile/skribilo/engine/base.scm index 9941ff1..9e9445e 100644 --- a/src/guile/skribilo/engine/base.scm +++ b/src/guile/skribilo/engine/base.scm @@ -31,12 +31,11 @@ :autoload (skribilo biblio template) (make-bib-entry-template/default output-bib-entry-template) ;; syntactic sugar - :use-module (skribilo reader) :use-module (skribilo utils syntax) :export (base-engine)) -(fluid-set! current-reader (make-reader 'skribe)) +(fluid-set! current-reader %skribilo-module-reader) ;*---------------------------------------------------------------------*/ @@ -195,6 +194,57 @@ :action #f) ;*---------------------------------------------------------------------*/ +;* bib-ref ... */ +;*---------------------------------------------------------------------*/ +(markup-writer 'bib-ref + :options '(:text :bib) + :before "[" + :action (lambda (n e) + (let* ((ref (markup-body n)) + (entry (handle-ast ref))) + (output (markup-option entry :title) e))) + :after "]") + +;*---------------------------------------------------------------------*/ +;* bib-ref+ ... */ +;*---------------------------------------------------------------------*/ +(markup-writer 'bib-ref+ + :options '(:text :bib :sort-bib-refs) + :before "[" + :action (lambda (n e) + (define (make-sort-proc proc) + ;; Return a safe sort procedure that passes PROC two + ;; `&bib-entry' markups. + (lambda (r1 r2) + ;; don't pass `unref's to PROC + (and (is-markup? r1 'bib-ref) + (is-markup? r2 'bib-ref) + (let ((e1 (handle-ast (markup-body r1))) + (e2 (handle-ast (markup-body r2)))) + (proc e1 e2))))) + + (define sort-refs (markup-option n :sort-bib-refs)) + + (let loop ((refs (if (procedure? sort-refs) + (sort (markup-body n) + (make-sort-proc sort-refs)) + (markup-body n)))) + (cond + ((null? refs) + #f) + (else + (if (is-markup? (car refs) 'bib-ref) + (invoke (writer-action (markup-writer-get 'bib-ref e)) + (car refs) + e) + (output (car refs) e)) + (if (pair? (cdr refs)) + (begin + (display ", ") + (loop (cdr refs)))))))) + :after "]") + +;*---------------------------------------------------------------------*/ ;* &the-bibliography ... */ ;*---------------------------------------------------------------------*/ (markup-writer '&the-bibliography diff --git a/src/guile/skribilo/engine/context.scm b/src/guile/skribilo/engine/context.scm index 87d36df..1b4301b 100644 --- a/src/guile/skribilo/engine/context.scm +++ b/src/guile/skribilo/engine/context.scm @@ -1051,28 +1051,6 @@ (format #t "\\goto{~a}[~a]" ref (string-canonicalize ident)))) :after (lambda (n e) (output "]" e))) -;;; ====================================================================== -;;; bib-ref+ ... -;;; ====================================================================== -(markup-writer 'bib-ref+ - :options '(:text :bib) - :before (lambda (n e) (output "[" e)) - :action (lambda (n e) - (let loop ((rs (markup-body n))) - (cond - ((null? rs) - #f) - (else - (if (is-markup? (car rs) 'bib-ref) - (invoke (writer-action (markup-writer-get 'bib-ref e)) - (car rs) - e) - (output (car rs) e)) - (if (pair? (cdr rs)) - (begin - (display ",") - (loop (cdr rs)))))))) - :after (lambda (n e) (output "]" e))) ;;; ====================================================================== ;;; url-ref ... diff --git a/src/guile/skribilo/engine/html.scm b/src/guile/skribilo/engine/html.scm index 86af489..688d33d 100644 --- a/src/guile/skribilo/engine/html.scm +++ b/src/guile/skribilo/engine/html.scm @@ -2032,28 +2032,9 @@ (markup-writer 'bib-ref :options '(:text :bib) :before "[" - :action (lambda (n e) (output n e (markup-writer-get 'ref e))) - :after "]") - -;*---------------------------------------------------------------------*/ -;* bib-ref+ ... */ -;*---------------------------------------------------------------------*/ -(markup-writer 'bib-ref+ - :options '(:text :bib) - :before "[" :action (lambda (n e) - (let loop ((rs (markup-body n))) - (cond - ((null? rs) - #f) - (else - (if (is-markup? (car rs) 'bib-ref) - (output (car rs) e (markup-writer-get 'ref e)) - (output (car rs) e)) - (if (pair? (cdr rs)) - (begin - (display ",") - (loop (cdr rs)))))))) + ;; Produce a hyperlink. + (output n e (markup-writer-get 'ref e))) :after "]") ;*---------------------------------------------------------------------*/ diff --git a/src/guile/skribilo/engine/latex.scm b/src/guile/skribilo/engine/latex.scm index 50b59d6..9b49545 100644 --- a/src/guile/skribilo/engine/latex.scm +++ b/src/guile/skribilo/engine/latex.scm @@ -1545,39 +1545,6 @@ (string-canonicalize id))))))) ;*---------------------------------------------------------------------*/ -;* bib-ref ... */ -;*---------------------------------------------------------------------*/ -(markup-writer 'bib-ref - :options '(:text :bib) - :before "[" - :action (lambda (n e) - (output (markup-option (handle-ast (markup-body n)) :title) e)) - :after "]") - -;*---------------------------------------------------------------------*/ -;* bib-ref+ ... */ -;*---------------------------------------------------------------------*/ -(markup-writer 'bib-ref+ - :options '(:text :bib) - :before "[" - :action (lambda (n e) - (let loop ((rs (markup-body n))) - (cond - ((null? rs) - #f) - (else - (if (is-markup? (car rs) 'bib-ref) - (invoke (writer-action (markup-writer-get 'bib-ref e)) - (car rs) - e) - (output (car rs) e)) - (if (pair? (cdr rs)) - (begin - (display ",") - (loop (cdr rs)))))))) - :after "]") - -;*---------------------------------------------------------------------*/ ;* url-ref ... */ ;*---------------------------------------------------------------------*/ (markup-writer 'url-ref diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm index b500488..bc796bd 100644 --- a/src/guile/skribilo/engine/lout.scm +++ b/src/guile/skribilo/engine/lout.scm @@ -538,21 +538,6 @@ (output (bold title) engine) (output title engine))))) -(define (lout-bib-refs-sort/number entry1 entry2) - ;; Default implementation of the `bib-refs-sort-proc' custom. Compare - ;; bibliography entries `entry1' and `entry2' (of type `&bib-entry') for - ;; use by `sort' in `bib-ref+'. - (let ((ident1 (markup-option entry1 :title)) - (ident2 (markup-option entry2 :title))) - (if (and (markup? ident1) (markup? ident2)) - (let ((n1 (markup-option ident1 'number)) - (n2 (markup-option ident2 'number))) - (and (number? n1) (number? n2) - (< n1 n2))) - (begin - (format (current-error-port) "i1: ~a, ~a" ident1 entry1) - (format (current-error-port) "i2: ~a, ~a" ident2 entry2))))) - (define (lout-pdf-bookmark-title node engine) ;; Default implementation of the `pdf-bookmark-title-proc' custom that ;; returns a title (a string) for the PDF bookmark of `node'. @@ -636,14 +621,8 @@ (doc-cover-sheet-proc ,lout-make-doc-cover-sheet) - ;; Procedure used to sort bibliography - ;; references when several are referred to at - ;; the same time, as in: - ;; (ref :bib '("smith03" "jones98")) . - ;; By default they are sorted by number. If - ;; `#f' is given, they are left as is. - (bib-refs-sort-proc - ,lout-bib-refs-sort/number) + ;; Kept for backward compability, do not use. + (bib-refs-sort-proc #f) ;; Lout code for paragraph gaps (similar to ;; `@PP' with `@ParaGap' equal to `1.0vx' by @@ -2458,68 +2437,6 @@ (if show-page-num? (format #t (lout-page-of ident)))))))))) - -;*---------------------------------------------------------------------*/ -;* bib-ref ... */ -;*---------------------------------------------------------------------*/ -(markup-writer 'bib-ref - :options '(:text :bib) - :before "[" - :action (lambda (n e) - (let ((entry (handle-ast (markup-body n)))) - (output (markup-option entry :title) e))) - :after "]") - -;*---------------------------------------------------------------------*/ -;* bib-ref+ ... */ -;*---------------------------------------------------------------------*/ -(markup-writer 'bib-ref+ - ;; When several references are passed. Strangely enough, the list of - ;; entries passed to this writer (as its body) contains both `bib-ref' and - ;; `bib-entry' objects, hence the `canonicalize-entry' function below. - :options '(:text :bib) - :before "[" - :action (lambda (n e) - (let* ((entries (markup-body n)) - (canonicalize-entry (lambda (x) - (cond - ((is-markup? x 'bib-entry) x) - ((is-markup? x 'bib-ref) - (handle-ast (markup-body x))) - ((is-markup? x 'unref) #f) - (else - (skribe-error - 'lout - "bib-ref+: invalid entry type" - x))))) - (help-proc (lambda (proc) - (lambda (e1 e2) - (let ((e1 (canonicalize-entry e1)) - (e2 (canonicalize-entry e2))) - ;; don't pass `unref's to PROC - (if (and e1 e2) - (proc e1 e2) - #f))))) - (sort-proc (engine-custom e 'bib-refs-sort-proc))) - - (let loop ((rs (if sort-proc - (sort entries (help-proc sort-proc)) - entries))) - (cond - ((null? rs) - #f) - (else - (if (is-markup? (car rs) 'bib-ref) - (invoke (writer-action (markup-writer-get 'bib-ref e)) - (car rs) - e) - (output (car rs) e)) - (if (pair? (cdr rs)) - (begin - (display ", ") - (loop (cdr rs))))))))) - :after "]") - ;*---------------------------------------------------------------------*/ ;* lout-make-url-breakable ... */ ;*---------------------------------------------------------------------*/ diff --git a/src/guile/skribilo/package/base.scm b/src/guile/skribilo/package/base.scm index 28cd0fb..9f6de43 100644 --- a/src/guile/skribilo/package/base.scm +++ b/src/guile/skribilo/package/base.scm @@ -34,7 +34,7 @@ ;; optional ``sub-packages'' :autoload (skribilo biblio) (*bib-table* resolve-bib - bib-load! bib-add!) + bib-load! bib-add! bib-sort-refs/number) :autoload (skribilo color) (skribe-use-color!) :autoload (skribilo source) (language? source-read-lines source-fontify) :autoload (skribilo prog) (make-prog-body resolve-line) @@ -1063,7 +1063,8 @@ (handle #f) (line #f) (skribe #f) - (page #f)) + (page #f) + (sort-bib-refs bib-sort-refs/number)) (define (unref ast text kind) (let ((msg (format #f "can't find `~a': " kind))) (if (ast? ast) @@ -1188,8 +1189,8 @@ (o (markup-option s 'used))) (markup-option-add! s 'used (if (pair? o) (cons h o) (list h))) n) - (unref #f v 'bib)))) ; FIXME: This prevents source location - ; info to be provided in the warning msg + (unref #f v 'bib)))) ; FIXME: This prevents source location info + ; from being provided in the warning msg (define (bib-ref text) (if (pair? text) (new markup @@ -1197,7 +1198,8 @@ (ident (symbol->string (gensym "bib-ref+"))) (class class) (loc &invocation-location) - (options (the-options opts :ident :class)) + (options `((:sort-bib-refs ,sort-bib-refs) + ,@(the-options opts :ident :class))) (body (map make-bib-ref text))) (make-bib-ref text))) (define (url-ref) |