summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/skr/api.skr2
-rw-r--r--doc/user/bib.skb4
-rw-r--r--doc/user/sectioning.skb2
-rw-r--r--src/guile/skribilo/evaluator.scm4
-rw-r--r--src/guile/skribilo/module.scm3
-rw-r--r--src/guile/skribilo/package/Makefile.am2
-rw-r--r--src/guile/skribilo/package/base.scm (renamed from src/guile/skribilo/skribe/api.scm)117
-rw-r--r--src/guile/skribilo/package/eq.scm2
-rw-r--r--src/guile/skribilo/package/pie.scm8
-rw-r--r--src/guile/skribilo/skribe/Makefile.am2
-rw-r--r--src/guile/skribilo/utils/compat.scm12
11 files changed, 100 insertions, 58 deletions
diff --git a/doc/skr/api.skr b/doc/skr/api.skr
index a86e745..369c605 100644
--- a/doc/skr/api.skr
+++ b/doc/skr/api.skr
@@ -330,7 +330,7 @@
(idx *markup-index*)
(idx-note "definition")
(idx-suffix #f)
- (source "skribilo/skribe/api.scm")
+ (source "skribilo/package/base.scm")
(def #f)
(see-also '())
(others '())
diff --git a/doc/user/bib.skb b/doc/user/bib.skb
index aa357e8..dd7ceb6 100644
--- a/doc/user/bib.skb
+++ b/doc/user/bib.skb
@@ -207,7 +207,7 @@ pre-existing functions for sorting entries:])
(doc-markup 'bib-sort/authors
'((l [The list of entries.]))
:force-engines *api-engines*
- :source "skribilo/skribe/bib.scm"
+ :source "skribilo/biblio.scm"
:others '(bib-sort/idents bib-sort/dates)
:common-args '())
@@ -217,7 +217,7 @@ entries identifier. The last one sorts according to entries date.])
(example-produce
(example :legend "Sorting bibliography entries"
- (prgm :file "skribilo/skribe/bib.scm"
+ (prgm :file "skribilo/biblio.scm"
:definition 'bib-sort/idents)))))
;*---------------------------------------------------------------------*/
diff --git a/doc/user/sectioning.skb b/doc/user/sectioning.skb
index 5f1dc3f..9d11d08 100644
--- a/doc/user/sectioning.skb
+++ b/doc/user/sectioning.skb
@@ -101,7 +101,7 @@ paragraphs.])
(p [The function ,(code "p") is an alias for ,(code "paragraph").])
(doc-markup 'p
'((#!rest node... "The nodes of the paragraph."))
- :source "skribilo/skribe/api.scm"
+ :source "skribilo/package/base.scm"
:see-also '(document chapter section paragraph)))
;*--- blockquote -----------------------------------------------------*/
diff --git a/src/guile/skribilo/evaluator.scm b/src/guile/skribilo/evaluator.scm
index 11d2be5..abee2fd 100644
--- a/src/guile/skribilo/evaluator.scm
+++ b/src/guile/skribilo/evaluator.scm
@@ -57,8 +57,8 @@
;;;
(define (%evaluate expr)
;; Evaluate EXPR, an arbitrary S-expression that may contain calls to the
- ;; markup functions defined in `(skribilo skribe api)', e.g., `(bold
- ;; "hello")'.
+ ;; markup functions defined in a markup package such as
+ ;; `(skribilo package base)', e.g., `(bold "hello")'.
(let ((result (eval expr (current-module))))
(if (ast? result)
diff --git a/src/guile/skribilo/module.scm b/src/guile/skribilo/module.scm
index 41f9c64..f68d4aa 100644
--- a/src/guile/skribilo/module.scm
+++ b/src/guile/skribilo/module.scm
@@ -45,6 +45,7 @@
(srfi srfi-13) ;; strings
(ice-9 optargs) ;; `define*'
+ (skribilo package base) ;; the core markups
(skribilo utils syntax) ;; `unless', `when', etc.
(skribilo utils compat) ;; `skribe-load-path', etc.
(skribilo utils keywords) ;; `the-body', `the-options'
@@ -87,7 +88,7 @@
((ice-9 receive) . (receive))))
(define %skribe-core-modules
- '("api" "index" "param" "sui"))
+ '("index" "param" "sui"))
diff --git a/src/guile/skribilo/package/Makefile.am b/src/guile/skribilo/package/Makefile.am
index 16b4a1d..693f088 100644
--- a/src/guile/skribilo/package/Makefile.am
+++ b/src/guile/skribilo/package/Makefile.am
@@ -2,6 +2,6 @@ guilemoduledir = $(GUILE_SITE)/skribilo/package
dist_guilemodule_DATA = acmproc.scm french.scm jfp.scm letter.scm \
lncs.scm scribe.scm sigplan.scm skribe.scm \
slide.scm web-article.scm web-book.scm \
- eq.scm pie.scm
+ eq.scm pie.scm base.scm
SUBDIRS = slide eq pie
diff --git a/src/guile/skribilo/skribe/api.scm b/src/guile/skribilo/package/base.scm
index b5abde2..69818da 100644
--- a/src/guile/skribilo/skribe/api.scm
+++ b/src/guile/skribilo/package/base.scm
@@ -1,4 +1,4 @@
-;;; api.scm -- The markup API of Skribe/Skribilo.
+;;; base.scm -- The base markup package of Skribe/Skribilo.
;;;
;;; Copyright 2003, 2004 Manuel Serrano
;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr>
@@ -19,10 +19,33 @@
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;;; USA.
-(define-skribe-module (skribilo skribe api)
+(define-module (skribilo package base)
+ :use-syntax (skribilo lib)
+ :use-syntax (skribilo reader)
+ :use-syntax (skribilo utils syntax)
+ :use-syntax (ice-9 optargs)
+
+ :use-module (skribilo ast)
+ :use-module (skribilo resolve)
+ :use-module (skribilo utils keywords)
+ :autoload (srfi srfi-1) (every any filter)
+ :autoload (skribilo evaluator) (include-document)
+ :autoload (skribilo engine) (engine?)
+
+ ;; optional ``sub-packages''
+ :autoload (skribilo biblio) (default-bib-table resolve-bib)
+ :autoload (skribilo color) (skribe-use-color!)
+ :autoload (skribilo source) (language? source-read-lines source-fontify)
+ :autoload (skribilo prog) (make-prog-body resolve-line)
+
+ :use-module (skribilo module) ;; needed before loading the following one
+ :autoload (skribilo skribe index) (make-index-table)
+
:replace (symbol))
-;;; Author: Manuel Serrano
+(fluid-set! current-reader (make-reader 'skribe))
+
+;;; Author: Manuel Serrano
;;; Commentary:
;;;
;;; This module contains all the core markups of Skribe/Skribilo.
@@ -30,8 +53,8 @@
;;; Code:
-;;; The contents of the file below are unchanged compared to Skribe 1.2d's
-;;; `api.scm' file found in the `common' directory.
+;;; The contents of the file below are (almost) unchanged compared to Skribe
+;;; 1.2d's `api.scm' file found in the `common' directory.
@@ -41,7 +64,7 @@
(define-markup (include file)
(if (not (string? file))
(skribe-error 'include "Illegal file (string expected)" file)
- (skribe-include file)))
+ (include-document file)))
;*---------------------------------------------------------------------*/
;* document ... */
@@ -56,7 +79,7 @@
(markup 'document)
(ident (or ident
(ast->string title)
- (symbol->string (gensym 'document))))
+ (symbol->string (gensym "document"))))
(class class)
(required-options '(:title :author :ending))
(options (the-options opts :ident :class :env))
@@ -101,7 +124,7 @@
(skribe-error 'author "Illegal align value" align)
(new container
(markup 'author)
- (ident (or ident (symbol->string (gensym 'author))))
+ (ident (or ident (symbol->string (gensym "author"))))
(class class)
(required-options '(:name :title :affiliation :email :url :address :phone :photo :align))
(options `((:name ,name)
@@ -121,7 +144,7 @@
(let ((body (the-body opts)))
(new container
(markup 'toc)
- (ident (or ident (symbol->string (gensym 'toc))))
+ (ident (or ident (symbol->string (gensym "toc"))))
(class class)
(required-options '())
(options `((:chapter ,chapter)
@@ -161,7 +184,7 @@
title (html-title #f) (file #f) (toc #t) (number #t))
(new container
(markup 'chapter)
- (ident (or ident (symbol->string (gensym 'chapter))))
+ (ident (or ident (symbol->string (gensym "chapter"))))
(class class)
(required-options '(:title :file :toc :number))
(options `((:toc ,toc)
@@ -201,7 +224,7 @@
title (file #f) (toc #t) (number #t))
(new container
(markup 'section)
- (ident (or ident (symbol->string (gensym 'section))))
+ (ident (or ident (symbol->string (gensym "section"))))
(class class)
(required-options '(:title :toc :file :toc :number))
(options `((:number ,(section-number number 'section))
@@ -228,7 +251,7 @@
title (file #f) (toc #t) (number #t))
(new container
(markup 'subsection)
- (ident (or ident (symbol->string (gensym 'subsection))))
+ (ident (or ident (symbol->string (gensym "subsection"))))
(class class)
(required-options '(:title :toc :file :number))
(options `((:number ,(section-number number 'subsection))
@@ -252,7 +275,7 @@
title (file #f) (toc #f) (number #t))
(new container
(markup 'subsubsection)
- (ident (or ident (symbol->string (gensym 'subsubsection))))
+ (ident (or ident (symbol->string (gensym "subsubsection"))))
(class class)
(required-options '(:title :toc :number :file))
(options `((:number ,(section-number number 'subsubsection))
@@ -272,7 +295,7 @@
(define-markup (~ #!rest opts #!key (class #f))
(new markup
(markup '~)
- (ident (gensym '~))
+ (ident (gensym "~"))
(class class)
(required-options '())
(options (the-options opts :class))
@@ -286,7 +309,7 @@
;; The `:label' option used to be called `:number'.
(new container
(markup 'footnote)
- (ident (symbol->string (gensym 'footnote)))
+ (ident (symbol->string (gensym "footnote")))
(class class)
(required-options '())
(options `((:label
@@ -306,7 +329,7 @@
;*---------------------------------------------------------------------*/
(define-markup (linebreak #!rest opts #!key (ident #f) (class #f))
(let ((ln (new markup
- (ident (or ident (symbol->string (gensym 'linebreak))))
+ (ident (or ident (symbol->string (gensym "linebreak"))))
(class class)
(markup 'linebreak)))
(num (the-body opts)))
@@ -330,7 +353,7 @@
(width 100.) (height 1))
(new markup
(markup 'hrule)
- (ident (or ident (symbol->string (gensym 'hrule))))
+ (ident (or ident (symbol->string (gensym "hrule"))))
(class class)
(required-options '())
(options `((:width ,width)
@@ -348,7 +371,7 @@
(bg #f) (fg #f) (width #f) (margin #f))
(new container
(markup 'color)
- (ident (or ident (symbol->string (gensym 'color))))
+ (ident (or ident (symbol->string (gensym "color"))))
(class class)
(required-options '(:bg :fg :width))
(options `((:bg ,(if bg (skribe-use-color! bg) bg))
@@ -366,7 +389,7 @@
(width #f) (margin 2) (border 1))
(new container
(markup 'frame)
- (ident (or ident (symbol->string (gensym 'frame))))
+ (ident (or ident (symbol->string (gensym "frame"))))
(class class)
(required-options '(:width :border :margin))
(options `((:margin ,margin)
@@ -387,7 +410,7 @@
(size #f) (face #f))
(new container
(markup 'font)
- (ident (or ident (symbol->string (gensym 'font))))
+ (ident (or ident (symbol->string (gensym "font"))))
(class class)
(required-options '(:size))
(options (the-options opts :ident :class))
@@ -405,7 +428,7 @@
((center left right)
(new container
(markup 'flush)
- (ident (or ident (symbol->string (gensym 'flush))))
+ (ident (or ident (symbol->string (gensym "flush"))))
(class class)
(required-options '(:side))
(options (the-options opts :ident :class))
@@ -440,7 +463,7 @@
(skribe-error 'prog "Illegal mark" mark)
(new container
(markup 'prog)
- (ident (or ident (symbol->string (gensym 'prog))))
+ (ident (or ident (symbol->string (gensym "prog"))))
(class class)
(required-options '(:line :mark))
(options (the-options opts :ident :class :linedigit))
@@ -537,7 +560,7 @@
(let ((s (ast->string legend)))
(if (not (string=? s ""))
s
- (symbol->string (gensym 'figure))))))
+ (symbol->string (gensym "figure"))))))
(class class)
(required-options '(:legend :number :multicolumns))
(options `((:number
@@ -590,7 +613,7 @@
(define-markup (itemize #!rest opts #!key (ident #f) (class "itemize") symbol)
(new container
(markup 'itemize)
- (ident (or ident (symbol->string (gensym 'itemize))))
+ (ident (or ident (symbol->string (gensym "itemize"))))
(class class)
(required-options '(:symbol))
(options `((:symbol ,symbol) ,@(the-options opts :ident :class)))
@@ -602,7 +625,7 @@
(define-markup (enumerate #!rest opts #!key (ident #f) (class "enumerate") symbol)
(new container
(markup 'enumerate)
- (ident (or ident (symbol->string (gensym 'enumerate))))
+ (ident (or ident (symbol->string (gensym "enumerate"))))
(class class)
(required-options '(:symbol))
(options `((:symbol ,symbol) ,@(the-options opts :ident :class)))
@@ -614,7 +637,7 @@
(define-markup (description #!rest opts #!key (ident #f) (class "description") symbol)
(new container
(markup 'description)
- (ident (or ident (symbol->string (gensym 'description))))
+ (ident (or ident (symbol->string (gensym "description"))))
(class class)
(required-options '(:symbol))
(options `((:symbol ,symbol) ,@(the-options opts :ident :class)))
@@ -631,7 +654,7 @@
(skribe-type-error 'item "Illegal key:" key "node")
(new container
(markup 'item)
- (ident (or ident (symbol->string (gensym 'item))))
+ (ident (or ident (symbol->string (gensym "item"))))
(class class)
(required-options '(:key))
(options `((:key ,key) ,@(the-options opts :ident :class :key)))
@@ -682,7 +705,7 @@
(else
(new container
(markup 'table)
- (ident (or ident (symbol->string (gensym 'table))))
+ (ident (or ident (symbol->string (gensym "table"))))
(class class)
(required-options '(:width :frame :rules))
(options `((:frame ,frame)
@@ -697,7 +720,7 @@
(define-markup (tr #!rest opts #!key (ident #f) (class #f) (bg #f))
(new container
(markup 'tr)
- (ident (or ident (symbol->string (gensym 'tr))))
+ (ident (or ident (symbol->string (gensym "tr"))))
(class class)
(required-options '())
(options `(,@(if bg `((:bg ,(if bg (skribe-use-color! bg) bg))) '())
@@ -738,7 +761,7 @@
(else
(new container
(markup 'tc)
- (ident (or ident (symbol->string (gensym 'tc))))
+ (ident (or ident (symbol->string (gensym "tc"))))
(class class)
(required-options '(:width :align :valign :colspan))
(options `((markup ,m)
@@ -795,7 +818,7 @@
(else
(new markup
(markup 'image)
- (ident (or ident (symbol->string (gensym 'image))))
+ (ident (or ident (symbol->string (gensym "image"))))
(class class)
(required-options '(:file :url :width :height))
(options (the-options opts :ident :class))
@@ -878,7 +901,13 @@
(skribe-error 'processor "Illegal engine" engine))
((and procedure
(or (not (procedure? procedure))
- (not (correct-arity? procedure 2))))
+ (not (let ((a (procedure-property procedure 'arity)))
+ (and (pair? a)
+ (let ((compulsory (car a))
+ (optional (cadr a))
+ (rest? (caddr a)))
+ (or rest?
+ (>= (+ compulsory optional) 2))))))))
(skribe-error 'processor "Illegal procedure" procedure))
(else
(new processor
@@ -926,7 +955,7 @@
(define-markup (mailto #!rest opts #!key (ident #f) (class "mailto") text)
(new markup
(markup 'mailto)
- (ident (or ident (symbol->string (gensym 'ident))))
+ (ident (or ident (symbol->string (gensym "ident"))))
(class class)
(required-options '(:text))
(options (the-options opts :ident :class))
@@ -935,7 +964,7 @@
;*---------------------------------------------------------------------*/
;* *mark-table* ... */
;*---------------------------------------------------------------------*/
-(define *mark-table* (make-hashtable))
+(define *mark-table* (make-hash-table))
;*---------------------------------------------------------------------*/
;* mark ... */
@@ -964,7 +993,7 @@
(class class)
(options (the-options opts :ident :class :text))
(body text))))
- (hashtable-put! *mark-table* bs n)
+ (hash-set! *mark-table* bs n)
n)))))
;*---------------------------------------------------------------------*/
@@ -1057,7 +1086,7 @@
(skribe-type-error 'mark "Illegal mark, " mark "string")
(new unresolved
(proc (lambda (n e env)
- (let ((s (hashtable-get *mark-table* mark)))
+ (let ((s (hash-ref *mark-table* mark)))
(if s
(new markup
(markup 'ref)
@@ -1227,11 +1256,11 @@
"Illegal index table, "
index
"index"))))
- (m (mark (symbol->string (gensym))))
+ (m (mark (symbol->string (gensym "mark"))))
(h (new handle (ast m)))
(new (new markup
(markup '&index-entry)
- (ident (or ident (symbol->string (gensym 'index))))
+ (ident (or ident (symbol->string (gensym "index"))))
(class class)
(options `((name ,ename) ,@(the-options opts :ident :class)))
(body (if url
@@ -1240,10 +1269,12 @@
;; New is bound to a dummy option of the mark in order
;; to make new options verified.
(markup-option-add! m 'to-verify new)
- (hashtable-update! table
- ename
- (lambda (cur) (cons new cur))
- (list new))
+
+ (let ((handle (hash-get-handle table ename)))
+ (if (not handle)
+ (hash-set! table ename (list new))
+ (set-cdr! handle (cons new (cdr handle)))))
+
m))
;*---------------------------------------------------------------------*/
@@ -1270,7 +1301,7 @@
(skribe-error 'the-index "Illegal char offset" char-offset))
((not (integer? column))
(skribe-error 'the-index "Illegal column number" column))
- ((not (every? index? bd))
+ ((not (every index? bd))
(skribe-error 'the-index
"Illegal indexes"
(filter (lambda (o) (not (index? o))) bd)))
diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm
index 6f50d7c..4f5020e 100644
--- a/src/guile/skribilo/package/eq.scm
+++ b/src/guile/skribilo/package/eq.scm
@@ -27,7 +27,7 @@
:use-module (skribilo utils syntax)
:use-module (skribilo module)
:use-module (skribilo utils keywords) ;; `the-options', etc.
- :autoload (skribilo skribe api) (it symbol sub sup)
+ :autoload (skribilo package base) (it symbol sub sup)
:autoload (skribilo engine lout) (lout-illustration)
:use-module (ice-9 optargs))
diff --git a/src/guile/skribilo/package/pie.scm b/src/guile/skribilo/package/pie.scm
index 5256f22..8ccf858 100644
--- a/src/guile/skribilo/package/pie.scm
+++ b/src/guile/skribilo/package/pie.scm
@@ -28,10 +28,10 @@
:use-module (skribilo utils keywords) ;; `the-options', etc.
:use-module (skribilo utils strings) ;; `make-string-replace'
:use-module (skribilo module)
- :autoload (skribilo color) (skribe-color->rgb)
- :autoload (skribilo skribe api) (bold)
- :autoload (skribilo engine lout) (lout-illustration)
- :autoload (ice-9 popen) (open-output-pipe)
+ :autoload (skribilo color) (skribe-color->rgb)
+ :autoload (skribilo package base) (bold)
+ :autoload (skribilo engine lout) (lout-illustration)
+ :autoload (ice-9 popen) (open-output-pipe)
:use-module (ice-9 optargs)
:export (%ploticus-program %ploticus-debug?
pie-sliceweight-value pie-remove-markup))
diff --git a/src/guile/skribilo/skribe/Makefile.am b/src/guile/skribilo/skribe/Makefile.am
index ff40489..91e3944 100644
--- a/src/guile/skribilo/skribe/Makefile.am
+++ b/src/guile/skribilo/skribe/Makefile.am
@@ -1,2 +1,2 @@
guilemoduledir = $(GUILE_SITE)/skribilo/skribe
-dist_guilemodule_DATA = api.scm index.scm param.scm sui.scm
+dist_guilemodule_DATA = index.scm param.scm sui.scm
diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm
index 41c9200..9032bcf 100644
--- a/src/guile/skribilo/utils/compat.scm
+++ b/src/guile/skribilo/utils/compat.scm
@@ -270,7 +270,17 @@
(use-modules ((srfi srfi-19) #:renamer (symbol-prefix-proc 's19:)))
-(define (date)
+(define-public (date)
(s19:date->string (s19:current-date) "~c"))
+(define-public (correct-arity? proc argcount)
+ (let ((a (procedure-property proc 'arity)))
+ (and (pair? a)
+ (let ((compulsory (car a))
+ (optional (cadr a))
+ (rest? (caddr a)))
+ (or rest?
+ (>= (+ compulsory optional) argcount))))))
+
+
;;; compat.scm ends here
generated by cgit v1.2.3 (git 2.45.0) at 2024-07-01 14:22:09 +0000