diff options
-rw-r--r-- | ChangeLog | 217 | ||||
-rw-r--r-- | src/guile/skribilo/biblio/Makefile.am | 2 | ||||
-rw-r--r-- | src/guile/skribilo/biblio/template.scm | 194 | ||||
-rw-r--r-- | src/guile/skribilo/engine/base.scm | 121 | ||||
-rw-r--r-- | src/guile/skribilo/engine/lout.scm | 36 |
5 files changed, 471 insertions, 99 deletions
@@ -2,6 +2,124 @@ # arch-tag: automatic-ChangeLog--lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2 # +2006-11-11 23:02:57 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-83 + + Summary: + Lout engine: Make URLs breakable; make bibliography defaults sane. + Revision: + skribilo--devel--1.2--patch-83 + + * src/guile/skribilo/engine/lout.scm (lout-split-external-link): Use + `!lout' and `lout-make-url-breakable'. + (lout-make-url-breakable): New, taken from `url-ref'. + (url-ref): Use it. + (&bib-entry-title): Don't issue bold text. + (&bib-entry-url): Likewise. + + modified files: + ChangeLog src/guile/skribilo/engine/lout.scm + + +2006-11-11 22:59:55 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-82 + + Summary: + Added the `(skribilo biblio template)' module. + Revision: + skribilo--devel--1.2--patch-82 + + * src/guile/skribilo/engine/base.scm: Autoload `(skribilo biblio + template)'. + (&bib-entry-url): New writer. + (&bib-entry-body)[output-fields]: Removed. Moved to the new module as + `output-bib-entry-template'. Use it, as well as + `make-bib-entry-template/default'. + (&bib-entry-title): Don't produce bold text. + (&bib-entry-booktitle): New writer. + (&bib-entry-journal): New writer. + + * src/guile/skribilo/biblio/Makefile.am (dist_guilemodule_DATA): Added + `template.scm'. + + new files: + src/guile/skribilo/biblio/template.scm + + modified files: + ChangeLog src/guile/skribilo/biblio/Makefile.am + src/guile/skribilo/engine/base.scm + + +2006-11-11 17:44:08 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-81 + + Summary: + Merge from skribilo@sv.gnu.org--2006/skribilo--devo--1.2 + Revision: + skribilo--devel--1.2--patch-81 + + Patches applied: + + * lcourtes@laas.fr--2005-libre/skribilo--devo--1.2 (patch 71) + * skribilo@sv.gnu.org--2006/skribilo--devo--1.2 (patch 12) + + - lout engine: Fixed the default value of `lout-program-arguments'. + + modified files: + ChangeLog src/guile/skribilo/engine/lout.scm + + new patches: + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-71 + skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-12 + + +2006-11-11 17:03:53 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-80 + + Summary: + Merge from skribilo@sv.gnu.org--2006/skribilo--devo--1.2 + Revision: + skribilo--devel--1.2--patch-80 + + Patches applied: + + * lcourtes@laas.fr--2005-libre/skribilo--devo--1.2 (patch 65-70) + + - Merge from skribilo@sv.gnu.org--2006 + - Added a `:arguments' keyword to `slide-embed'. + - Lout engine: Implemented `slide-embed'. + - Lout engine: Added a `lout-program-arguments' custom. + - slide: Improved HTML output, especially wrt. the use of CSS. + - slide/html: Issue only one anchor per slide. + + * skribilo@sv.gnu.org--2006/skribilo--devo--1.2 (patch 6-11) + + - color.scm: Added support for `lightred'. :-) + - Added a `:arguments' keyword to `slide-embed'. + - Lout engine: Implemented `slide-embed'. + - Lout engine: Added a `lout-program-arguments' custom. + - slide: Improved HTML output, especially wrt. the use of CSS. + - slide/html: Issue only one anchor per slide. + + modified files: + ChangeLog doc/user/slide.skb + src/guile/skribilo/engine/lout.scm + src/guile/skribilo/package/slide.scm + src/guile/skribilo/package/slide/base.scm + src/guile/skribilo/package/slide/html.scm + src/guile/skribilo/package/slide/lout.scm + + new patches: + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-65 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-66 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-67 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-68 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-69 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-70 + skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-6 + skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-7 + skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-8 + skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-9 + skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-10 + skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-11 + + 2006-10-16 21:09:47 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-79 Summary: @@ -15,6 +133,105 @@ ChangeLog src/guile/skribilo/color.scm +2006-10-16 18:20:03 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-78 + + Summary: + Merge from skribilo@sv.gnu.org--2006/skribilo--devo--1.2 + Revision: + skribilo--devel--1.2--patch-78 + + Patches applied: + + * lcourtes@laas.fr--2005-libre/skribilo--devo--1.2 (patch 64) + * skribilo@sv.gnu.org--2006/skribilo--devo--1.2 (patch 5) + + - Lout engine: Honor `inline-definitions-proc'. + + modified files: + ChangeLog src/guile/skribilo/engine/lout.scm + + new patches: + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-64 + skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-5 + + +2006-10-15 20:46:11 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-77 + + Summary: + Merge from skribilo@sv.gnu.org--2006/skribilo--devo--1.2 + Revision: + skribilo--devel--1.2--patch-77 + + Patches applied: + + * lcourtes@laas.fr--2005-libre/skribilo--devo--1.2 (patch 62-63) + * skribilo@sv.gnu.org--2006/skribilo--devo--1.2 (patch 3-4) + + - prog: Fixed line number output (`&prog-line'). + - doc: Fixed the Fibonacci example in ``Computer Programs''. + + modified files: + ChangeLog doc/user/prgm.skb doc/user/src/prgm2.skb + src/guile/skribilo/engine/base.scm src/guile/skribilo/prog.scm + + new patches: + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-62 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-63 + skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-3 + skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-4 + + +2006-10-11 07:55:00 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-76 + + Summary: + Merge from skribilo@sv.gnu.org--2006/skribilo--devo--1.2 + Revision: + skribilo--devel--1.2--patch-76 + + Patches applied: + + * lcourtes@laas.fr--2005-libre/skribilo--devo--1.2 (patch 60-61) + + - slide: Propagate the `outline?' parameter in `slide-(sub)?topic'. + - Lout engine: Honor `date-line' for slides. + + * skribilo@sv.gnu.org--2006/skribilo--devo--1.2 (base, patch 1-2) + + - tag of lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-59 + - slide: Propagate the `outline?' parameter in `slide-(sub)?topic'. + - Lout engine: Honor `date-line' for slides. + + modified files: + ChangeLog src/guile/skribilo/engine/lout.scm + src/guile/skribilo/package/slide.scm + + new patches: + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-60 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-61 + skribilo@sv.gnu.org--2006/skribilo--devo--1.2--base-0 + skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-1 + skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-2 + + +2006-09-14 17:31:46 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-75 + + Summary: + Adding missing patch logs from `lcourtes@laas.fr--2005-libre'. + Revision: + skribilo--devel--1.2--patch-75 + + + modified files: + ChangeLog + + new patches: + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-55 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-56 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-57 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-58 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-59 + + 2006-09-04 09:15:58 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-74 Summary: diff --git a/src/guile/skribilo/biblio/Makefile.am b/src/guile/skribilo/biblio/Makefile.am index 9442562..ee81406 100644 --- a/src/guile/skribilo/biblio/Makefile.am +++ b/src/guile/skribilo/biblio/Makefile.am @@ -1,4 +1,4 @@ guilemoduledir = $(GUILE_SITE)/skribilo/biblio -dist_guilemodule_DATA = bibtex.scm author.scm abbrev.scm +dist_guilemodule_DATA = bibtex.scm author.scm abbrev.scm template.scm ## arch-tag: aeffaead-c3f0-47f3-a0b3-bb3e22da2657 diff --git a/src/guile/skribilo/biblio/template.scm b/src/guile/skribilo/biblio/template.scm new file mode 100644 index 0000000..da0c948 --- /dev/null +++ b/src/guile/skribilo/biblio/template.scm @@ -0,0 +1,194 @@ +;;; template.scm -- Template system for bibliography entries. +;;; +;;; Copyright 2003, 2004 Manuel Serrano +;;; 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;; USA. + +(define-module (skribilo biblio template) + :use-module (skribilo ast) + :autoload (skribilo lib) (skribe-error) + :autoload (skribilo output) (output) + + :use-module (ice-9 optargs) + + :use-module (skribilo utils syntax) + + :export (output-bib-entry-template + make-bib-entry-template/default + make-bib-entry-template/skribe)) + +(fluid-set! current-reader %skribilo-module-reader) + +;;; Author: Manuel Serrano, Ludovic Courtès +;;; +;;; Commentary: +;;; +;;; This module provides a helper procedure to output bibliography entries +;;; according to a given template, as well as ready-to-use templates. A +;;; template only contains part of the style information for a bibliography +;;; entry. Specific style information can be added by modifying the markup +;;; writers for `&bib-entry-author', `&bib-entry-title', etc. (see `(skribilo +;;; package base)' for details). +;;; +;;; Code: + + +;;; +;;; Outputting a bibliography entry template for a specific entry. +;;; + +(define* (output-bib-entry-template bib engine template + :optional (get-field markup-option)) + ;; Output the fields of BIB (a bibliography entry) for ENGINE according to + ;; TEMPLATE. Example of templates are found below (e.g., + ;; `make-bib-entry-template/default'). + (let loop ((template template) + (pending #f) + (armed #f)) + (cond + ((null? template) + 'done) + ((pair? (car template)) + (if (eq? (caar template) 'or) + (let ((o1 (cadr (car template)))) + (if (get-field bib o1) + (loop (cons o1 (cdr template)) + pending + #t) + (let ((o2 (caddr (car template)))) + (loop (cons o2 (cdr template)) + pending + armed)))) + (let ((o (get-field bib (cadr (car template))))) + (if o + (begin + (if (and pending armed) + (output pending engine)) + (output (caar template) engine) + (output o engine) + (if (pair? (cddr (car template))) + (output (caddr (car template)) engine)) + (loop (cdr template) #f #t)) + (loop (cdr template) pending armed))))) + ((symbol? (car template)) + (let ((o (get-field bib (car template)))) + (if o + (begin + (if (and armed pending) + (output pending engine)) + (output o engine) + (loop (cdr template) #f #t)) + (loop (cdr template) pending armed)))) + ((null? (cdr template)) + (output (car template) engine)) + ((string? (car template)) + (loop (cdr template) + (if pending pending (car template)) + armed)) + (else + (skribe-error 'output-bib-fields + "Illegal templateiption" + (car template)))))) + + +;;; +;;; Example bibliography entry templates. +;;; + +(define (make-bib-entry-template/default kind) + ;; The default bibliography entry template. + (case kind + ((techreport) + `(author ". " (or title url documenturl) ". " + number ", " institution ", " + address ", " month " " year ", " + ("pp. " pages) ".")) + ((article) + `(author ". " (or title url documenturl) ". " + "In " journal ", " volume + ("(" number ")") ", " + address ", " month " " year ", " + ("pp. " pages) ".")) + ((inproceedings) + `(author ". " (or title url documenturl) ". " + "In " booktitle ", " + (series ", ") + ("(" number ")") + ("pp. " pages ", ") + ;; FIXME: Addr., month., pub. + year ".")) + ((book) ;; FIXME: Title should be in italics + '(author ". " (or title url documenturl) ". " + publisher ", " address + ", " month " " year ", " + ("pp. " pages) ".")) + ((phdthesis) + '(author ". " (or title url documenturl) + ". " type ", " + school ", " address + ", " month " " year".")) + ((misc) + '(author ". " (or title url documenturl) ". " + publisher ", " address + ", " month " " year + (", " url) ".")) + (else + '(author ". " (or title url documenturl) ". " + publisher ", " address + ", " month " " year ", " + ("pp. " pages) ".")))) + +(define (make-bib-entry-template/skribe kind) + ;; The awful template found by default in Skribe. + (case kind + ((techreport) + `(author " -- " (or title url documenturl) " -- " + number ", " institution ", " + address ", " month ", " year ", " + ("pp. " pages) ".")) + ((article) + `(author " -- " (or title url documenturl) " -- " + journal ", " volume "" ("(" number ")") ", " + address ", " month ", " year ", " + ("pp. " pages) ".")) + ((inproceedings) + `(author " -- " (or title url documenturl) " -- " + booktitle ", " series ", " ("(" number ")") ", " + address ", " month ", " year ", " + ("pp. " pages) ".")) + ((book) + '(author " -- " (or title url documenturl) " -- " + publisher ", " address + ", " month ", " year ", " ("pp. " pages) ".")) + ((phdthesis) + '(author " -- " (or title url documenturl) " -- " type ", " + school ", " address + ", " month ", " year".")) + ((misc) + '(author " -- " (or title url documenturl) " -- " + publisher ", " address + ", " month ", " year".")) + (else + '(author " -- " (or title url documenturl) " -- " + publisher ", " address + ", " month ", " year ", " ("pp. " pages) ".")))) + + +;;; arch-tag: 5931579f-b606-442d-9a45-6047c94da5a2 + +;;; template.scm ends here diff --git a/src/guile/skribilo/engine/base.scm b/src/guile/skribilo/engine/base.scm index d49b732..3b70f66 100644 --- a/src/guile/skribilo/engine/base.scm +++ b/src/guile/skribilo/engine/base.scm @@ -20,6 +20,8 @@ ;;; USA. (define-skribe-module (skribilo engine base) + :autoload (skribilo biblio template) (make-bib-entry-template/default + output-bib-entry-template) :use-module (srfi srfi-13)) ;*---------------------------------------------------------------------*/ @@ -218,91 +220,31 @@ :after "]") ;*---------------------------------------------------------------------*/ +;* &bib-entry-author ... */ +;*---------------------------------------------------------------------*/ +; (markup-writer '&bib-entry-author +; :action (lambda (n e) +; (let ((names (markup-body n))) +; (skribe-eval +; (sc (abbreviate-first-names names)) e)))) + +;*---------------------------------------------------------------------*/ +;* &bib-entry-url ... */ +;*---------------------------------------------------------------------*/ +(markup-writer '&bib-entry-url + :action (lambda (n e) + (let ((url (markup-body n))) + (skribe-eval + (ref :text (it url) :url url) e)))) + +;*---------------------------------------------------------------------*/ ;* &bib-entry-body ... */ ;*---------------------------------------------------------------------*/ (markup-writer '&bib-entry-body :action (lambda (n e) - (define (output-fields descr) - (let loop ((descr descr) - (pending #f) - (armed #f)) - (cond - ((null? descr) - 'done) - ((pair? (car descr)) - (if (eq? (caar descr) 'or) - (let ((o1 (cadr (car descr)))) - (if (markup-option n o1) - (loop (cons o1 (cdr descr)) - pending - #t) - (let ((o2 (caddr (car descr)))) - (loop (cons o2 (cdr descr)) - pending - armed)))) - (let ((o (markup-option n (cadr (car descr))))) - (if o - (begin - (if (and pending armed) - (output pending e)) - (output (caar descr) e) - (output o e) - (if (pair? (cddr (car descr))) - (output (caddr (car descr)) e)) - (loop (cdr descr) #f #t)) - (loop (cdr descr) pending armed))))) - ((symbol? (car descr)) - (let ((o (markup-option n (car descr)))) - (if o - (begin - (if (and armed pending) - (output pending e)) - (output o e) - (loop (cdr descr) #f #t)) - (loop (cdr descr) pending armed)))) - ((null? (cdr descr)) - (output (car descr) e)) - ((string? (car descr)) - (loop (cdr descr) - (if pending pending (car descr)) - armed)) - (else - (skribe-error 'output-bib-fields - "Illegal description" - (car descr)))))) - (output-fields - (case (markup-option n 'kind) - ((techreport) - `(author " -- " (or title url documenturl) " -- " - number ", " institution ", " - address ", " month ", " year ", " - ("pp. " pages) ".")) - ((article) - `(author " -- " (or title url documenturl) " -- " - journal ", " volume "" ("(" number ")") ", " - address ", " month ", " year ", " - ("pp. " pages) ".")) - ((inproceedings) - `(author " -- " (or title url documenturl) " -- " - booktitle ", " series ", " ("(" number ")") ", " - address ", " month ", " year ", " - ("pp. " pages) ".")) - ((book) - '(author " -- " (or title url documenturl) " -- " - publisher ", " address - ", " month ", " year ", " ("pp. " pages) ".")) - ((phdthesis) - '(author " -- " (or title url documenturl) " -- " type ", " - school ", " address - ", " month ", " year".")) - ((misc) - '(author " -- " (or title url documenturl) " -- " - publisher ", " address - ", " month ", " year".")) - (else - '(author " -- " (or title url documenturl) " -- " - publisher ", " address - ", " month ", " year ", " ("pp. " pages) ".")))))) + (let* ((kind (markup-option n 'kind)) + (template (make-bib-entry-template/default kind))) + (output-bib-entry-template n e template)))) ;*---------------------------------------------------------------------*/ ;* &bib-entry-ident ... */ @@ -316,7 +258,22 @@ ;*---------------------------------------------------------------------*/ (markup-writer '&bib-entry-title :action (lambda (n e) - (skribe-eval (bold (markup-body n)) e))) + (skribe-eval (markup-body n)) e)) + +;*---------------------------------------------------------------------*/ +;* &bib-entry-booktitle ... */ +;*---------------------------------------------------------------------*/ +(markup-writer '&bib-entry-booktitle + :action (lambda (n e) + (let ((title (markup-body n))) + (skribe-eval (it title) e)))) + +;*---------------------------------------------------------------------*/ +;* &bib-entry-journal ... */ +;*---------------------------------------------------------------------*/ +(markup-writer '&bib-entry-journal + :action (lambda (n e) + (skribe-eval (it (markup-body n)) e))) ;*---------------------------------------------------------------------*/ ;* &bib-entry-publisher ... */ diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm index ddbb7b7..92977e7 100644 --- a/src/guile/skribilo/engine/lout.scm +++ b/src/guile/skribilo/engine/lout.scm @@ -472,7 +472,8 @@ (loop (- where 1)) where))))) `(,(ref :url url :text (substring text 0 split)) - ,(substring text split len))) + ,(!lout (lout-make-url-breakable + (substring text split len))))) (list markup)))) ((markup? text) @@ -2519,6 +2520,19 @@ :after "]") ;*---------------------------------------------------------------------*/ +;* lout-make-url-breakable ... */ +;*---------------------------------------------------------------------*/ +(define-public lout-make-url-breakable + ;; Make the given string (which is assumed to be a URL) breakable. + (make-string-replace `((#\/ "\"/\"&0ik{}") + (#\. ".&0ik{}") + (#\- "-&0ik{}") + (#\_ "_&0ik{}") + (#\@ "\"@\"&0ik{}") + ,@lout-verbatim-encoding + (#\newline "")))) + +;*---------------------------------------------------------------------*/ ;* url-ref ... */ ;*---------------------------------------------------------------------*/ (markup-writer 'url-ref @@ -2531,19 +2545,9 @@ (markup-option n '&transformed)) (begin (printf "{ \"~a\" @ExternalLink { " url) - (if text ;; FIXME: Should be (not (string-index text #\space)) - (output text e) - (let ((filter-url (make-string-replace - `((#\/ "\"/\"&-") - (#\. ".&-") - (#\- "&-") - (#\_ "_&-") - ,@lout-verbatim-encoding - (#\newline ""))))) - ;; Filter the URL in a way to give Lout hints on - ;; where hyphenation should take place. - (fprint (current-error-port) "Here!!!" filter-url) - (display (filter-url url) e))) + (if text + (output text e) + (display (lout-make-url-breakable url) e)) (printf " } }")) (begin (markup-option-add! n '&transformed #t) @@ -2630,7 +2634,7 @@ ;*---------------------------------------------------------------------*/ (markup-writer '&bib-entry-title :action (lambda (n e) - (let* ((t (bold (markup-body n))) + (let* ((t (markup-body n)) (en (handle-ast (ast-parent n))) (url (markup-option en 'url)) (ht (if url (ref :url (markup-body url) :text t) t))) @@ -2652,7 +2656,7 @@ :action (lambda (n e) (let* ((en (handle-ast (ast-parent n))) (url (markup-option en 'url)) - (t (bold (markup-body url)))) + (t (it (markup-body url)))) (skribe-eval (ref :url (markup-body url) :text t) e)))) ;*---------------------------------------------------------------------*/ |