aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/guile/skribilo/biblio.scm37
-rw-r--r--src/guile/skribilo/engine/base.scm54
-rw-r--r--src/guile/skribilo/engine/context.scm22
-rw-r--r--src/guile/skribilo/engine/html.scm23
-rw-r--r--src/guile/skribilo/engine/latex.scm33
-rw-r--r--src/guile/skribilo/engine/lout.scm87
-rw-r--r--src/guile/skribilo/package/base.scm12
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)
generated by cgit v1.2.3 (git 2.45.2) at 2024-12-22 18:49:30 +0000