aboutsummaryrefslogtreecommitdiff
path: root/src/guile/skribilo/engine
diff options
context:
space:
mode:
Diffstat (limited to 'src/guile/skribilo/engine')
-rw-r--r--src/guile/skribilo/engine/base.scm121
-rw-r--r--src/guile/skribilo/engine/lout.scm36
2 files changed, 59 insertions, 98 deletions
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))))
;*---------------------------------------------------------------------*/
generated by cgit v1.2.3 (git 2.44.0) at 2024-06-02 09:15:13 +0000