Factorized `bib-ref+', add a `:sort-bib-refs' options to `ref'.

* src/guile/skribilo/biblio.scm (bib-sort-refs/number): New.

* src/guile/skribilo/engine/base.scm: Use `%skribilo-module-reader'
  instead of the Skribe reader.
  (bib-ref, bib-ref+): New writer.  Handle `:sort-bib-refs' in
  `bib-ref+'.

* src/guile/skribilo/engine/context.scm (bib-ref+): Removed.

* src/guile/skribilo/engine/html.scm (bib-ref+): Removed.

* src/guile/skribilo/engine/latex.scm (bib-ref, bib-ref+): Removed.

* src/guile/skribilo/engine/lout.scm (lout-bib-refs-sort/number):
  Removed.
  (lout-engine): Documented `bib-refs-sort-proc' as unused.
  (bib-ref, bib-ref+): Removed.

* src/guile/skribilo/package/base.scm (ref): New `:sort-bib-refs' option.
  [bib-ref]: Add it to the markup's option list.

git-archimport-id: lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-80

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)