summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/guile/README13
-rw-r--r--src/guile/skribilo.scm10
-rw-r--r--src/guile/skribilo/engine/html.scm3
-rw-r--r--src/guile/skribilo/engine/lout.scm2
-rw-r--r--src/guile/skribilo/evaluator.scm7
-rw-r--r--src/guile/skribilo/reader.scm30
-rw-r--r--src/guile/skribilo/reader/Makefile.am2
-rw-r--r--src/guile/skribilo/reader/outline.scm322
8 files changed, 377 insertions, 12 deletions
diff --git a/src/guile/README b/src/guile/README
index 8b1502c..6c5128f 100644
--- a/src/guile/README
+++ b/src/guile/README
@@ -13,6 +13,8 @@ Here are a few goals.
** Add useful markups
+- `document': add `:keywords' and `:language', maybe `:date'
+
- numbered references
- improved footnotes
@@ -25,10 +27,16 @@ Here are a few goals.
** Skribe front-end (read Skribe syntax)
+Done.
+
** Texinfo front-end
+Use guile-library's `stexi'.
+
** Simple markup front-end (à la `txt2tags', Emacs' outline mode, or Wiki)
+Almost done (Emacs `outline-mode').
+
* Back-ends (engines)
** Easier to plug-in new back-ends (no need to modify the source)
@@ -37,6 +45,8 @@ Here are a few goals.
** Lout back-end (including automatic `lout' invocation?)
+Done, except automatic invocation.
+
** Info back-end
* Packages
@@ -45,6 +55,9 @@ Here are a few goals.
** Equations
+* Toys
+
+** Document browser with guile-gnome
;;; arch-tag: 2d0a6235-5c09-4930-998c-56a4de2c0aca
diff --git a/src/guile/skribilo.scm b/src/guile/skribilo.scm
index 43885ee..285a92d 100644
--- a/src/guile/skribilo.scm
+++ b/src/guile/skribilo.scm
@@ -38,6 +38,7 @@ exec ${GUILE-guile} --debug -l $0 -c "(apply $main (cdr (command-line)))" "$@"
(define-module (skribilo)
:autoload (skribilo module) (make-run-time-module)
:autoload (skribilo engine) (*current-engine*)
+ :autoload (skribilo reader) (*document-reader*)
:use-module (skribilo utils syntax))
(use-modules (skribilo evaluator)
@@ -80,6 +81,8 @@ specifications."
`(define ,binding (quote ,(raw-options->getopt-long options))))
(define-options skribilo-options
+ (("reader" :alternate "R" :arg reader
+ (nothing)))
(("target" :alternate "t" :arg target
:help "sets the output format to <target>")
(set! engine (string->symbol target)))
@@ -194,6 +197,8 @@ specifications."
Processes a Skribilo/Skribe source file and produces its output.
+ --reader=READER Use READER to parse the input file (by default,
+ the `skribe' reader is used)
--target=ENGINE Use ENGINE as the underlying engine
--help Give this help list
@@ -381,6 +386,8 @@ Processes a Skribilo/Skribe source file and produces its output.
(define-public (skribilo . args)
(let* ((options (getopt-long (cons "skribilo" args)
skribilo-options))
+ (reader-name (string->symbol
+ (option-ref options 'reader "skribe")))
(engine (string->symbol
(option-ref options 'target "html")))
(output-file (option-ref options 'output #f))
@@ -412,7 +419,8 @@ Processes a Skribilo/Skribe source file and produces its output.
(lambda (file)
(format #t "~~ loading `~a'...~%" file))))
- (parameterize ((*current-engine* engine)
+ (parameterize ((*document-reader* (make-reader reader-name))
+ (*current-engine* engine)
(*document-path* (cons load-path (*document-path*)))
(*bib-path* (cons bib-path (*bib-path*)))
(*source-path* (cons source-path
diff --git a/src/guile/skribilo/engine/html.scm b/src/guile/skribilo/engine/html.scm
index 1f3466f..5165258 100644
--- a/src/guile/skribilo/engine/html.scm
+++ b/src/guile/skribilo/engine/html.scm
@@ -711,7 +711,8 @@
((string? ic)
ic)
((procedure? ic)
- (ic d e)))))
+ (ic d e))
+ (else #f))))
e)
;; style
(output (new markup
diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm
index 72a8338..d01b547 100644
--- a/src/guile/skribilo/engine/lout.scm
+++ b/src/guile/skribilo/engine/lout.scm
@@ -522,7 +522,7 @@
:filter (make-string-replace lout-encoding)
:custom `(;; The underlying Lout document type, i.e. one
;; of `doc', `report', `book' or `slides'.
- (document-type report)
+ (document-type doc)
;; Document style file include line (a string
;; such as `@Include { doc-style.lout }') or
diff --git a/src/guile/skribilo/evaluator.scm b/src/guile/skribilo/evaluator.scm
index 002ca54..df5e6a7 100644
--- a/src/guile/skribilo/evaluator.scm
+++ b/src/guile/skribilo/evaluator.scm
@@ -27,7 +27,7 @@
:autoload (skribilo location) (<location>)
:autoload (skribilo ast) (ast? markup?)
:autoload (skribilo engine) (engine? find-engine engine-ident)
- :autoload (skribilo reader) (%default-reader)
+ :autoload (skribilo reader) (*document-reader*)
:autoload (skribilo verify) (verify)
:autoload (skribilo resolve) (resolve!))
@@ -91,7 +91,7 @@
;;;
(define* (evaluate-document-from-port port engine
:key (env '())
- (reader %default-reader))
+ (reader (*document-reader*)))
(with-debug 2 'evaluate-document-from-port
(debug-item "engine=" engine)
(debug-item "reader=" reader)
@@ -173,8 +173,7 @@
;;; INCLUDE-DOCUMENT
;;;
(define* (include-document file :key (path (*document-path*))
- (reader %default-reader))
- ;; FIXME: We should default to `*skribilo-current-reader*'.
+ (reader (*document-reader*)))
(unless (every string? path)
(raise (condition (&invalid-argument-error (proc-name 'include-document)
(argument path)))))
diff --git a/src/guile/skribilo/reader.scm b/src/guile/skribilo/reader.scm
index 27c740b..95e545b 100644
--- a/src/guile/skribilo/reader.scm
+++ b/src/guile/skribilo/reader.scm
@@ -21,8 +21,15 @@
(define-module (skribilo reader)
:use-module (srfi srfi-9) ;; records
:use-module (srfi srfi-17) ;; generalized `set!'
+ :use-module (srfi srfi-39) ;; parameter objects
+ :use-module (skribilo condition)
+ :autoload (srfi srfi-34) (raise)
+ :use-module (srfi srfi-35)
:export (%make-reader lookup-reader make-reader
- %default-reader)
+ %default-reader *document-reader*
+
+ &reader-search-error reader-search-error?
+ reader-search-error:reader)
:export-syntax (define-reader define-public-reader))
;;; Author: Ludovic Courtès
@@ -60,6 +67,13 @@
(define-macro (define-public-reader name version make-proc)
`(define-reader ,name ,version ,make-proc))
+
+;;; Error condition.
+
+(define-condition-type &reader-search-error &skribilo-error
+ reader-search-error?
+ (reader reader-search-error:reader))
+
;;; The mechanism below is inspired by Guile-VM code written by K. Nishida.
@@ -68,10 +82,12 @@
"Look for a reader named @var{name} (a symbol) in the @code{(skribilo
reader)} module hierarchy. If no such reader was found, an error is
raised."
- (let ((m (resolve-module `(skribilo reader ,name))))
- (if (module-bound? m 'reader-specification)
+ (let ((m (false-if-exception
+ (resolve-module `(skribilo reader ,name)))))
+ (if (and (module? m)
+ (module-bound? m 'reader-specification))
(module-ref m 'reader-specification)
- (error "no such reader" name))))
+ (raise (condition (&reader-search-error (reader name)))))))
(define (make-reader name)
"Look for reader @var{name} and instantiate it."
@@ -81,4 +97,10 @@ raised."
(define %default-reader (make-reader 'skribe))
+
+;;; Current document reader.
+
+(define *document-reader* (make-parameter %default-reader))
+
+
;;; reader.scm ends here
diff --git a/src/guile/skribilo/reader/Makefile.am b/src/guile/skribilo/reader/Makefile.am
index a1c58fb..807e4a7 100644
--- a/src/guile/skribilo/reader/Makefile.am
+++ b/src/guile/skribilo/reader/Makefile.am
@@ -1,2 +1,2 @@
guilemoduledir = $(GUILE_SITE)/skribilo/reader
-dist_guilemodule_DATA = skribe.scm
+dist_guilemodule_DATA = skribe.scm outline.scm
diff --git a/src/guile/skribilo/reader/outline.scm b/src/guile/skribilo/reader/outline.scm
new file mode 100644
index 0000000..688fcdc
--- /dev/null
+++ b/src/guile/skribilo/reader/outline.scm
@@ -0,0 +1,322 @@
+;;; outline.scm -- A reader for Emacs' outline syntax.
+;;;
+;;; 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;; USA.
+
+(define-module (skribilo reader outline)
+ :use-module (skribilo utils syntax)
+ :use-module (skribilo reader)
+ :use-module (ice-9 optargs)
+ :use-module (srfi srfi-11)
+
+ :autoload (ice-9 rdelim) (read-line)
+ :autoload (ice-9 regex) (make-regexp)
+
+ :export (reader-specification
+ make-outline-reader))
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+;;; Author: Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; A reader for Emacs' outline-mode syntax.
+;;;
+;;; Code:
+
+;;; TODO:
+;;;
+;;; - add source position information;
+;;; - handle `itemize' and/or `enumerate';
+;;; - handle inline Skribe code: `\n{skribe\n(table (tr ... ))\n}\n'
+
+
+
+
+;;;
+;;; Tools.
+;;;
+
+(define (apply-any procs args)
+ "Apply the procedure listed in @var{procs} to @var{args} until one of these
+procedure returns true."
+ (let loop ((procs procs))
+ (if (null? procs)
+ #f
+ (let ((result (apply (car procs) args)))
+ (if result result (loop (cdr procs)))))))
+
+
+(define (append-trees . trees)
+ "Append markup trees @var{trees}. Trees whose car is a symbol (e.g.,
+@code{(bold \"paf\")} will be considered as sub-trees of the resulting tree."
+ (let loop ((trees trees)
+ (result '()))
+ (if (null? trees)
+ result
+ (let ((tree (car trees)))
+ (loop (cdr trees)
+ (append result
+ (if (list? tree)
+ (cond ((null? tree) '())
+ ((symbol? (car tree)) (list tree))
+ (else tree))
+ (list tree))))))))
+
+(define (null-string? s)
+ (and (string? s) (string=? s "")))
+
+
+(define empty-line-rx (make-regexp "^([[:space:]]*|;.*)$"))
+(define (empty-line? s)
+ "Return true if string @var{s} denotes an ``empty'' line, i.e., a blank
+line or a line comment."
+ (regexp-exec empty-line-rx s))
+
+
+
+;;;
+;;; In-line markup, i.e., markup that doesn't span over multiple lines.
+;;;
+
+(define %inline-markup
+ ;; Note: the order matters because, for instance, URLs must be searched for
+ ;; _before_ italics (`/italic/').
+ `(("_([^_]+)_" .
+ ,(lambda (m)
+ (values (match:prefix m) ;; before
+ (match:substring m 1) ;; body
+ (match:suffix m) ;; after
+ (lambda (body) `(emph ,body))))) ;; process-body
+ ("(f|ht)tp://[a-zA-Z0-9\\._~%/-]+" .
+ ,(lambda (m)
+ (values (match:prefix m)
+ (match:substring m)
+ (match:suffix m)
+ (lambda (url) `(ref :url ,url)))))
+ ("\\/([^\\/]+)\\/" .
+ ,(lambda (m)
+ (values (match:prefix m)
+ (match:substring m 1)
+ (match:suffix m)
+ (lambda (body) `(it ,body)))))
+ ("\\*([^\\*]+)\\*" .
+ ,(lambda (m)
+ (values (match:prefix m)
+ (match:substring m 1)
+ (match:suffix m)
+ (lambda (body) `(bold ,body)))))
+ ("``(([^`]|[^'])+)''" .
+ ,(lambda (m)
+ (values (match:prefix m)
+ (match:substring m 1)
+ (match:suffix m)
+ (lambda (body) `(q ,body)))))
+ ("`(([^`]|[^'])+)'" .
+ ,(lambda (m)
+ (values (match:prefix m)
+ (match:substring m 1)
+ (match:suffix m)
+ (lambda (body) `(tt ,body)))))))
+
+(define (make-markup-processor rx proc)
+ (lambda (line)
+ (let ((match (regexp-exec rx line)))
+ (if match
+ (proc match)
+ #f))))
+
+(define (make-line-processor markup-alist)
+ "Returns a @dfn{line processor}. A line processor is a procedure that
+takes a string and returns a list."
+ (let* ((markups (map (lambda (rx+proc)
+ (cons (make-regexp (car rx+proc) regexp/extended)
+ (cdr rx+proc)))
+ markup-alist))
+ (procs (map (lambda (rx+proc)
+ (make-markup-processor (car rx+proc) (cdr rx+proc)))
+ markups)))
+ (lambda (line)
+ (let self ((line line))
+ ;;(format #t "self: ~a~%" line)
+ (cond ((string? line)
+ (let ((result (apply-any procs (list line))))
+ (if result
+ (let-values (((before body after proc-body)
+ result))
+ (let ((body+
+ (if (string=? (string-append before body after)
+ line)
+ body (self body))))
+ (if (and (null-string? before)
+ (null-string? after))
+ (proc-body body+)
+ (append-trees (self before)
+ (proc-body body+)
+ (self after)))))
+ line)))
+ (else
+ (error "line-processor: internal error" line)))))))
+
+(define %line-processor
+ (make-line-processor %inline-markup))
+
+
+
+;;;
+;;; Large-scale structures: paragraphs, chapters, sections, etc.
+;;;
+
+(define (process-paragraph line line-proc port)
+ (let loop ((line line)
+ (result '()))
+ (if (or (eof-object? line) (empty-line? line))
+ (cons 'p result)
+ (loop (read-line port)
+ (let ((line (line-proc line)))
+ (append-trees result line "\n"))))))
+
+(define (make-node-processor rx node-type title-proc line-proc
+ subnode-proc end-of-node?)
+ "Return a procedure that reads the given string and return an AST node of
+type @var{node-type} or @code{#f}. When the original string matches the node
+header, then the rest of the node is read from @var{port}."
+ (lambda (line port)
+ (let ((match (regexp-exec rx line)))
+ (if (not match)
+ #f
+ (let ((title (line-proc (title-proc match))))
+ (let loop ((line (read-line port))
+ (body '()))
+ (cond ((or (eof-object? line)
+ (regexp-exec rx line)
+ (and (procedure? end-of-node?)
+ (end-of-node? line)))
+ (values line
+ `(,node-type :title ,title ,@(reverse! body))))
+
+ ((empty-line? line)
+ (loop (read-line port) body))
+
+ (else
+ (let ((subnode (and subnode-proc
+ (apply subnode-proc
+ (list line port)))))
+ (if subnode
+ (let-values (((line node) subnode))
+ (loop line (cons node body)))
+ (let ((par (process-paragraph line line-proc port)))
+ (loop (read-line port)
+ (cons par body)))))))))))))
+
+
+(define (node-markup-line? line)
+ (define node-rx (make-regexp "^\\*+ (.+)$" regexp/extended))
+ (regexp-exec node-rx line))
+
+(define %node-processors
+ (let ((section-proc
+ (make-node-processor (make-regexp "^\\*\\* (.+)$" regexp/extended)
+ 'section
+ (lambda (m) (match:substring m 1))
+ %line-processor
+ #f
+ node-markup-line?)))
+ (list (make-node-processor (make-regexp "^\\* (.+)$" regexp/extended)
+ 'chapter
+ (lambda (m) (match:substring m 1))
+ %line-processor
+ section-proc
+ #f))))
+
+
+
+
+;;;
+;;; The top-level parser.
+;;;
+
+(define (make-document-processor node-procs line-proc)
+ (lambda (line port)
+ (let self ((line line)
+ (doc '()))
+ ;;(format #t "doc-proc: ~a~%" line)
+ (if (eof-object? line)
+ (if (null? doc)
+ line
+ (reverse! doc))
+ (if (empty-line? line)
+ (self (read-line port) doc)
+ (let ((result (apply-any node-procs (list line port))))
+ (if result
+ (let-values (((line node) result))
+ (self line (cons node doc)))
+ (let ((par (process-paragraph line line-proc port)))
+ (self (read-line port)
+ (cons par doc))))))))))
+
+
+(define* (outline-reader :optional (port (current-input-port)))
+ (define modeline-rx
+ (make-regexp "^[[:space:]]*-\\*- [a-zA-Z-]+ -\\*-[[:space:]]*$"))
+ (define title-rx (make-regexp "^[Tt]itle: (.+)$" regexp/extended))
+ (define author-rx (make-regexp "^[Aa]uthor: (.+)$" regexp/extended))
+
+ (let ((doc-proc (make-document-processor %node-processors %line-processor)))
+
+ (let loop ((title #f)
+ (author #f)
+ (line (read-line port)))
+
+ (if (eof-object? line)
+ (if (or title author)
+ `(document :title ,title :author (author :name ,author) '())
+ line)
+ (if (or (empty-line? line)
+ (regexp-exec modeline-rx line))
+ (loop title author (read-line port))
+ (let ((title-match (regexp-exec title-rx line)))
+ (if title-match
+ (loop (match:substring title-match 1)
+ author (read-line port))
+ (let ((author-match (regexp-exec author-rx line)))
+ (if author-match
+ (loop title (match:substring author-match 1)
+ (read-line port))
+
+ ;; Let's go.
+ `(document :title ,title
+ :author (author :name ,author)
+ ,@(doc-proc line port)))))))))))
+
+
+(define* (make-outline-reader :optional (version "0.1"))
+ outline-reader)
+
+
+
+;;; The reader specification.
+
+(define-reader outline "0.1" make-outline-reader)
+
+
+;;; arch-tag: 53473e73-c811-4eed-a0b4-22ada4d6ef08
+
+;;; outline.scm ends here
+