summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/guile/skribilo/package/base.scm64
-rw-r--r--src/guile/skribilo/package/eq.scm2
-rw-r--r--src/guile/skribilo/package/pie.scm5
-rw-r--r--src/guile/skribilo/package/slide.scm12
4 files changed, 76 insertions, 7 deletions
diff --git a/src/guile/skribilo/package/base.scm b/src/guile/skribilo/package/base.scm
index 1971ca5..73cf93d 100644
--- a/src/guile/skribilo/package/base.scm
+++ b/src/guile/skribilo/package/base.scm
@@ -1,7 +1,7 @@
;;; base.scm -- The base markup package of Skribe/Skribilo.
;;;
;;; Copyright 2003, 2004 Manuel Serrano
-;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr>
+;;; Copyright 2005, 2006, 2007 Ludovic Courtès <ludovic.courtes@laas.fr>
;;;
;;;
;;; This program is free software; you can redistribute it and/or modify
@@ -31,6 +31,7 @@
:autoload (srfi srfi-1) (every any filter)
:autoload (skribilo evaluator) (include-document)
:autoload (skribilo engine) (engine?)
+ :autoload (skribilo parameters)(*document-path*)
;; optional ``sub-packages''
:autoload (skribilo biblio) (*bib-table* resolve-bib
@@ -80,6 +81,7 @@
(ast->string title)
(symbol->string (gensym "document"))))
(class class)
+ (loc &invocation-location)
(required-options '(:title :author :ending))
(options (the-options opts :ident :class :env))
(body (the-body opts))
@@ -125,6 +127,7 @@
(markup 'author)
(ident (or ident (symbol->string (gensym "author"))))
(class class)
+ (loc &invocation-location)
(required-options '(:name :title :affiliation :email :url :address :phone :photo :align))
(options `((:name ,name)
(:align ,align)
@@ -145,6 +148,7 @@
(markup 'toc)
(ident (or ident (symbol->string (gensym "toc"))))
(class class)
+ (loc &invocation-location)
(required-options '())
(options `((:chapter ,chapter)
(:section ,section)
@@ -154,6 +158,7 @@
(body (cond
((null? body)
(new unresolved
+ (loc &invocation-location)
(proc (lambda (n e env)
(handle
(resolve-search-parent n env document?))))))
@@ -185,6 +190,7 @@
(markup 'chapter)
(ident (or ident (symbol->string (gensym "chapter"))))
(class class)
+ (loc &invocation-location)
(required-options '(:title :file :toc :number))
(options `((:toc ,toc)
(:number ,(and number
@@ -225,6 +231,7 @@
(markup 'section)
(ident (or ident (symbol->string (gensym "section"))))
(class class)
+ (loc &invocation-location)
(required-options '(:title :toc :file :toc :number))
(options `((:number ,(section-number number 'section))
(:toc ,toc)
@@ -252,6 +259,7 @@
(markup 'subsection)
(ident (or ident (symbol->string (gensym "subsection"))))
(class class)
+ (loc &invocation-location)
(required-options '(:title :toc :file :number))
(options `((:number ,(section-number number 'subsection))
(:toc ,toc)
@@ -276,6 +284,7 @@
(markup 'subsubsection)
(ident (or ident (symbol->string (gensym "subsubsection"))))
(class class)
+ (loc &invocation-location)
(required-options '(:title :toc :number :file))
(options `((:number ,(section-number number 'subsubsection))
(:toc ,toc)
@@ -296,6 +305,7 @@
(markup '~)
(ident (symbol->string (gensym "~")))
(class class)
+ (loc &invocation-location)
(required-options '())
(options (the-options opts :class))
(body (the-body opts))))
@@ -315,6 +325,7 @@
(markup 'footnote)
(ident (symbol->string (gensym "footnote")))
(class class)
+ (loc &invocation-location)
(required-options '())
(options `((:label
,(cond ((string? label) label)
@@ -335,6 +346,7 @@
(let ((ln (new markup
(ident (or ident (symbol->string (gensym "linebreak"))))
(class class)
+ (loc &invocation-location)
(markup 'linebreak)))
(num (the-body opts)))
(cond
@@ -359,6 +371,7 @@
(markup 'hrule)
(ident (or ident (symbol->string (gensym "hrule"))))
(class class)
+ (loc &invocation-location)
(required-options '())
(options `((:width ,width)
(:height ,height)
@@ -377,6 +390,7 @@
(markup 'color)
(ident (or ident (symbol->string (gensym "color"))))
(class class)
+ (loc &invocation-location)
(required-options '(:bg :fg :width))
(options `((:bg ,(if bg (skribe-use-color! bg) bg))
(:fg ,(if fg (skribe-use-color! fg) fg))
@@ -395,6 +409,7 @@
(markup 'frame)
(ident (or ident (symbol->string (gensym "frame"))))
(class class)
+ (loc &invocation-location)
(required-options '(:width :border :margin))
(options `((:margin ,margin)
(:border ,(cond
@@ -416,6 +431,7 @@
(markup 'font)
(ident (or ident (symbol->string (gensym "font"))))
(class class)
+ (loc &invocation-location)
(required-options '(:size))
(options (the-options opts :ident :class))
(body (the-body opts))))
@@ -434,6 +450,7 @@
(markup 'flush)
(ident (or ident (symbol->string (gensym "flush"))))
(class class)
+ (loc &invocation-location)
(required-options '(:side))
(options (the-options opts :ident :class))
(body (the-body opts))))
@@ -469,6 +486,7 @@
(markup 'prog)
(ident (or ident (symbol->string (gensym "prog"))))
(class class)
+ (loc &invocation-location)
(required-options '(:line :mark))
(options (the-options opts :ident :class :linedigit))
(body (make-prog-body (the-body opts) line linedigit mark)))))
@@ -566,6 +584,7 @@
s
(symbol->string (gensym "figure"))))))
(class class)
+ (loc &invocation-location)
(required-options '(:legend :number :multicolumns))
(options `((:number
,(new unresolved
@@ -619,6 +638,7 @@
(markup 'itemize)
(ident (or ident (symbol->string (gensym "itemize"))))
(class class)
+ (loc &invocation-location)
(required-options '(:symbol))
(options `((:symbol ,symbol) ,@(the-options opts :ident :class)))
(body (parse-list-of 'itemize 'item (the-body opts)))))
@@ -631,6 +651,7 @@
(markup 'enumerate)
(ident (or ident (symbol->string (gensym "enumerate"))))
(class class)
+ (loc &invocation-location)
(required-options '(:symbol))
(options `((:symbol ,symbol) ,@(the-options opts :ident :class)))
(body (parse-list-of 'enumerate 'item (the-body opts)))))
@@ -643,6 +664,7 @@
(markup 'description)
(ident (or ident (symbol->string (gensym "description"))))
(class class)
+ (loc &invocation-location)
(required-options '(:symbol))
(options `((:symbol ,symbol) ,@(the-options opts :ident :class)))
(body (parse-list-of 'description 'item (the-body opts)))))
@@ -660,6 +682,7 @@
(markup 'item)
(ident (or ident (symbol->string (gensym "item"))))
(class class)
+ (loc &invocation-location)
(required-options '(:key))
(options `((:key ,key) ,@(the-options opts :ident :class :key)))
(body (the-body opts)))))
@@ -711,6 +734,7 @@
(markup 'table)
(ident (or ident (symbol->string (gensym "table"))))
(class class)
+ (loc &invocation-location)
(required-options '(:width :frame :rules))
(options `((:frame ,frame)
(:rules ,rules)
@@ -726,6 +750,7 @@
(markup 'tr)
(ident (or ident (symbol->string (gensym "tr"))))
(class class)
+ (loc &invocation-location)
(required-options '())
(options `(,@(if bg `((:bg ,(if bg (skribe-use-color! bg) bg))) '())
,@(the-options opts :ident :class :bg)))
@@ -767,6 +792,7 @@
(markup 'tc)
(ident (or ident (symbol->string (gensym "tc"))))
(class class)
+ (loc &invocation-location)
(required-options '(:width :align :valign :colspan))
(options `((markup ,m)
(:align ,align)
@@ -824,6 +850,7 @@
(markup 'image)
(ident (or ident (symbol->string (gensym "image"))))
(class class)
+ (loc &invocation-location)
(required-options '(:file :url :width :height))
(options (the-options opts :ident :class))
(body (the-body opts))))))
@@ -881,6 +908,7 @@
symbol)))))
(new markup
(markup 'symbol)
+ (loc &invocation-location)
(body v))))
;*---------------------------------------------------------------------*/
@@ -890,6 +918,7 @@
(if (not (string? format))
(skribe-type-error '! "Illegal format:" format "string")
(new command
+ (loc &invocation-location)
(fmt format)
(body node))))
@@ -915,6 +944,7 @@
(skribe-error 'processor "Illegal procedure" procedure))
(else
(new processor
+ (loc &invocation-location)
(combinator combinator)
(engine engine)
(procedure (or procedure (lambda (n e) n)))
@@ -936,14 +966,17 @@
(section
(error 'handle "Illegal handle `section' option" section)
(new unresolved
+ (loc &invocation-location)
(proc (lambda (n e env)
(let ((s (resolve-ident section 'section n env)))
(new handle
+ (loc &invocation-location)
(ast s)))))))
((and (pair? body)
(null? (cdr body))
(markup? (car body)))
(new handle
+ (loc &invocation-location)
(ast (car body))))
(else
(skribe-error 'handle "Illegal handle" opts)))))
@@ -961,6 +994,7 @@
(markup 'mailto)
(ident (or ident (symbol->string (gensym "ident"))))
(class class)
+ (loc &invocation-location)
(required-options '(:text))
(options (the-options opts :ident :class))
(body (the-body opts))))
@@ -995,6 +1029,7 @@
(markup 'mark)
(ident (symbol->string (gensym bs)))
(class class)
+ (loc &invocation-location)
(options (the-options opts :ident :class :text))
(body text))))
(hash-set! *mark-table* bs n)
@@ -1037,6 +1072,7 @@
(markup 'unref)
(ident (symbol->string (gensym "unref")))
(class class)
+ (loc &invocation-location)
(required-options '(:text))
(options `((kind ,kind) ,@(the-options opts :ident :class)))
(body (list text ": " (ast->file-location ast)))))
@@ -1046,11 +1082,12 @@
(markup 'unref)
(ident (symbol->string (gensym "unref")))
(class class)
+ (loc &invocation-location)
(required-options '(:text))
(options `((kind ,kind) ,@(the-options opts :ident :class)))
(body text))))))
(define (skribe-ref skribe)
- (let ((path (find-file/path skribe (skribe-path))))
+ (let ((path (search-path (*document-path*) skribe)))
(if (not path)
(unref #f skribe 'sui-file)
(let* ((sui (load-sui path))
@@ -1064,6 +1101,7 @@
(markup 'ref)
(ident (symbol->string (gensym "handle-ref")))
(class class)
+ (loc &invocation-location)
(required-options '(:text))
(options `((kind handle) ,@(the-options opts :ident :class)))
(body text)))
@@ -1071,6 +1109,7 @@
(if (not (string? title))
(skribe-type-error 'ref "illegal reference" title "string")
(new unresolved
+ (loc &invocation-location)
(proc (lambda (n e env)
(let* ((doc (ast-document n))
(s (find1-down
@@ -1084,6 +1123,7 @@
(markup 'ref)
(ident (symbol->string (gensym "title-ref")))
(class class)
+ (loc &invocation-location)
(required-options '(:text))
(options `((kind ,kind)
(mark ,title)
@@ -1095,6 +1135,7 @@
(if (not (string? text))
(skribe-type-error 'ref "Illegal reference" text "string")
(new unresolved
+ (loc &invocation-location)
(proc (lambda (n e env)
(let ((s (resolve-ident text kind n env)))
(if s
@@ -1102,6 +1143,7 @@
(markup 'ref)
(ident (symbol->string (gensym "ident-ref")))
(class class)
+ (loc &invocation-location)
(required-options '(:text))
(options `((kind ,kind)
(mark ,text)
@@ -1113,6 +1155,7 @@
(if (not (string? mark))
(skribe-type-error 'mark "Illegal mark, " mark "string")
(new unresolved
+ (loc &invocation-location)
(proc (lambda (n e env)
(let ((s (hash-ref *mark-table* mark)))
(if s
@@ -1120,6 +1163,7 @@
(markup 'ref)
(ident (symbol->string (gensym "mark-ref")))
(class class)
+ (loc &invocation-location)
(required-options '(:text))
(options `((kind mark)
(mark ,mark)
@@ -1134,6 +1178,7 @@
(markup 'bib-ref)
(ident (symbol->string (gensym "bib-ref")))
(class class)
+ (loc &invocation-location)
(required-options '(:text))
(options (the-options opts :ident :class))
(body (new handle
@@ -1150,6 +1195,7 @@
(markup 'bib-ref+)
(ident (symbol->string (gensym "bib-ref+")))
(class class)
+ (loc &invocation-location)
(options (the-options opts :ident :class))
(body (map make-bib-ref text)))
(make-bib-ref text)))
@@ -1158,10 +1204,12 @@
(markup 'url-ref)
(ident (symbol->string (gensym "url-ref")))
(class class)
+ (loc &invocation-location)
(required-options '(:url :text))
(options (the-options opts :ident :class))))
(define (line-ref line)
(new unresolved
+ (loc &invocation-location)
(proc (lambda (n e env)
(let ((l (resolve-line line)))
(if (pair? l)
@@ -1169,6 +1217,7 @@
(markup 'line-ref)
(ident (symbol->string (gensym "line-ref")))
(class class)
+ (loc &invocation-location)
(options `((:text ,(markup-ident (car l)))
,@(the-options opts :ident :class)))
(body (new handle
@@ -1201,6 +1250,7 @@
(separator ".") (class #f))
;; Produce a numbered reference to `ident'.
(new unresolved
+ (loc &invocation-location)
(proc (lambda (n e env)
(let* ((parent (ast-parent n))
(doc (ast-document n))
@@ -1216,6 +1266,7 @@
(markup 'unref)
(ident (symbol->string (gensym "unref")))
(class class)
+ (loc &invocation-location)
(required-options '(:text))
(options `((kind numref)
,@(the-options opts :ident :class)))
@@ -1240,6 +1291,7 @@
;*---------------------------------------------------------------------*/
(define-markup (resolve fun)
(new unresolved
+ (loc &invocation-location)
(proc fun)))
;*---------------------------------------------------------------------*/
@@ -1280,6 +1332,7 @@
"Cound must be either `partial' or `full'"
count)
(new unresolved
+ (loc &invocation-location)
(proc (lambda (n e env)
(resolve-the-bib bib-table
(new handle (ast n))
@@ -1333,6 +1386,7 @@
(markup '&index-entry)
(ident (or ident (symbol->string (gensym "index"))))
(class class)
+ (loc &invocation-location)
(options `((name ,ename) ,@(the-options opts :ident :class)))
(body (if url
(ref :url url :text (or shape ename))
@@ -1378,6 +1432,7 @@
(filter (lambda (o) (not (index? o))) bd)))
(else
(new unresolved
+ (loc &invocation-location)
(proc (lambda (n e env)
(resolve-the-index (ast-loc n)
ident class
@@ -1394,8 +1449,8 @@
;*---------------------------------------------------------------------*/
;* p ... */
;*---------------------------------------------------------------------*/
-(define-markup (p #!rest opt #!key ident (class #f) &skribe-eval-location)
- (paragraph :ident ident :class class :loc &skribe-eval-location
+(define-markup (p #!rest opt #!key ident (class #f))
+ (paragraph :ident ident :class class :loc &invocation-location
(the-body opt)))
;*---------------------------------------------------------------------*/
@@ -1453,6 +1508,7 @@
(define-markup (q #!rest opt)
(new markup
(markup 'q)
+ (loc &invocation-location)
(options (the-options opt))
(body (the-body opt))))
diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm
index af2c906..7ad39d8 100644
--- a/src/guile/skribilo/package/eq.scm
+++ b/src/guile/skribilo/package/eq.scm
@@ -203,6 +203,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g.,
(markup 'eq-display)
(ident (or ident (symbol->string (gensym "eq-display"))))
(class class)
+ (loc &invocation-location)
(options (the-options opts :ident :class))
(body (the-body opts))))
@@ -214,6 +215,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g.,
(markup 'eq)
(ident (or ident (symbol->string (gensym "eq"))))
(class class)
+ (loc &invocation-location)
(options `((:div-style ,div-style) (:align-with ,align-with)
(:mul-style ,mul-style)
,@(the-options opts
diff --git a/src/guile/skribilo/package/pie.scm b/src/guile/skribilo/package/pie.scm
index 8ccf858..232ef9c 100644
--- a/src/guile/skribilo/package/pie.scm
+++ b/src/guile/skribilo/package/pie.scm
@@ -1,6 +1,6 @@
;;; pie.scm -- An pie-chart formatting package.
;;;
-;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr>
+;;; Copyright 2005, 2006, 2007 Ludovic Courtès <ludovic.courtes@laas.fr>
;;;
;;;
;;; This program is free software; you can redistribute it and/or modify
@@ -52,6 +52,7 @@
(new container
(markup 'pie)
(ident (or ident (symbol->string (gensym "pie"))))
+ (loc &invocation-location)
(options (the-options opts))
(body (the-body opts))))
@@ -60,6 +61,7 @@
(new container
(markup 'slice)
(ident (or ident (symbol->string (gensym "slice"))))
+ (loc &invocation-location)
(weight weight)
(color color)
(detach? detach?)
@@ -71,6 +73,7 @@
(new markup
(markup 'sliceweight)
(ident (or ident (symbol->string (gensym "sliceweight"))))
+ (loc &invocation-location)
(percentage? percentage?)
(options (the-options opts))
(body '())))
diff --git a/src/guile/skribilo/package/slide.scm b/src/guile/skribilo/package/slide.scm
index cbcae0b..cb5edda 100644
--- a/src/guile/skribilo/package/slide.scm
+++ b/src/guile/skribilo/package/slide.scm
@@ -1,7 +1,7 @@
;;; slide.scm -- Overhead transparencies.
;;;
;;; Copyright 2003, 2004 Manuel Serrano
-;;; Copyright 2006 Ludovic Courtès <ludovic.courtes@laas.fr>
+;;; Copyright 2006, 2007 Ludovic Courtès <ludovic.courtes@laas.fr>
;;;
;;;
;;; This program is free software; you can redistribute it and/or modify
@@ -68,6 +68,7 @@
(symbol->string (gensym "slide"))
ident))
(class class)
+ (loc &invocation-location)
(required-options '(:title :number :toc))
(options `((:number
,(cond
@@ -145,6 +146,7 @@
;*---------------------------------------------------------------------*/
(define-markup (slide-pause)
(new markup
+ (loc &invocation-location)
(markup 'slide-pause)))
;*---------------------------------------------------------------------*/
@@ -153,6 +155,7 @@
(define-markup (slide-vspace #!rest opt #!key (unit 'cm))
(new markup
(markup 'slide-vspace)
+ (loc &invocation-location)
(options `((:unit ,unit) ,@(the-options opt :unit)))
(body (the-body opt))))
@@ -174,7 +177,7 @@
command)
(new markup
(markup 'slide-embed)
- (loc &skribe-eval-location)
+ (loc &invocation-location)
(required-options '(:alt))
(options `((:geometry-opt ,geometry-opt)
(:alt ,alt)
@@ -191,6 +194,7 @@
(markup 'slide-record)
(ident ident)
(class class)
+ (loc &invocation-location)
(options `((:play ,play) ,@(the-options opt)))
(body (the-body opt)))))
@@ -204,6 +208,7 @@
(markup 'slide-play)
(ident ident)
(class class)
+ (loc &invocation-location)
(options `((:color ,(if color (skribe-use-color! color) #f))
,@(the-options opt :color)))
(body (the-body opt)))))
@@ -223,6 +228,7 @@
(markup 'slide-play*)
(ident ident)
(class class)
+ (loc &invocation-location)
(options `((:color ,(if color (skribe-use-color! color) #f))
(:scolor ,(if color (skribe-use-color! scolor) #f))
,@(the-options opt :color :scolor)))
@@ -250,6 +256,7 @@
(required-options '(:title :outline?))
(ident (or ident (symbol->string (gensym "slide-topic"))))
(class class)
+ (loc &invocation-location)
(options `((:outline? ,outline?)
,@(the-options opt :outline? :class)))
(body (the-body opt))))
@@ -265,6 +272,7 @@
(required-options '(:title :outline?))
(ident (or ident (symbol->string (gensym "slide-subtopic"))))
(class class)
+ (loc &invocation-location)
(options `((:outline? ,outline?)
,@(the-options opt :outline? :class)))
(body (the-body opt))))
generated by cgit v1.2.3 (git 2.45.2) at 2024-11-01 08:14:10 +0000