[chatter] r11795 - in trunk/sandbox/dydoc: . internal-rep markup-parser markup-translator source-files support tool topic-resolver workflows
agent at mccarthy.opendylan.org
agent at mccarthy.opendylan.org
Sat May 3 06:24:58 CEST 2008
Author: agent
Date: Sat May 3 06:24:57 2008
New Revision: 11795
Added:
trunk/sandbox/dydoc/
trunk/sandbox/dydoc/Makefile (contents, props changed)
trunk/sandbox/dydoc/dydoc.lid (contents, props changed)
trunk/sandbox/dydoc/internal-rep/
trunk/sandbox/dydoc/internal-rep/body-elements.dylan (contents, props changed)
trunk/sandbox/dydoc/internal-rep/helpers.dylan (contents, props changed)
trunk/sandbox/dydoc/internal-rep/misc-elements.dylan (contents, props changed)
trunk/sandbox/dydoc/internal-rep/module.dylan (contents, props changed)
trunk/sandbox/dydoc/internal-rep/printers.dylan (contents, props changed)
trunk/sandbox/dydoc/internal-rep/quote-elements.dylan (contents, props changed)
trunk/sandbox/dydoc/internal-rep/toc-nav-elements.dylan (contents, props changed)
trunk/sandbox/dydoc/internal-rep/topic-elements.dylan (contents, props changed)
trunk/sandbox/dydoc/markup-parser/
trunk/sandbox/dydoc/markup-parser/grammar.txt (contents, props changed)
trunk/sandbox/dydoc/markup-parser/literal-tokenizers.dylan (contents, props changed)
trunk/sandbox/dydoc/markup-parser/markup-parser.dylan (contents, props changed)
trunk/sandbox/dydoc/markup-parser/method-tokenizers.dylan (contents, props changed)
trunk/sandbox/dydoc/markup-parser/module.dylan (contents, props changed)
trunk/sandbox/dydoc/markup-parser/parser-helpers.dylan (contents, props changed)
trunk/sandbox/dydoc/markup-parser/rule-tokenizers.dylan (contents, props changed)
trunk/sandbox/dydoc/markup-translator/
trunk/sandbox/dydoc/markup-translator/check-helpers.dylan (contents, props changed)
trunk/sandbox/dydoc/markup-translator/module.dylan (contents, props changed)
trunk/sandbox/dydoc/markup-translator/token-processing.dylan (contents, props changed)
trunk/sandbox/dydoc/source-files/
trunk/sandbox/dydoc/source-files/file-parser.dylan (contents, props changed)
trunk/sandbox/dydoc/source-files/module.dylan (contents, props changed)
trunk/sandbox/dydoc/support/
trunk/sandbox/dydoc/support/common.dylan (contents, props changed)
trunk/sandbox/dydoc/support/configs-module.dylan (contents, props changed)
trunk/sandbox/dydoc/support/configs.dylan (contents, props changed)
trunk/sandbox/dydoc/support/errors-module.dylan (contents, props changed)
trunk/sandbox/dydoc/support/errors.dylan (contents, props changed)
trunk/sandbox/dydoc/support/library.dylan (contents, props changed)
trunk/sandbox/dydoc/support/ordered-tree-module.dylan (contents, props changed)
trunk/sandbox/dydoc/support/ordered-tree.dylan (contents, props changed)
trunk/sandbox/dydoc/tool/
trunk/sandbox/dydoc/tool/main.dylan (contents, props changed)
trunk/sandbox/dydoc/tool/module.dylan (contents, props changed)
trunk/sandbox/dydoc/topic-resolver/
trunk/sandbox/dydoc/topic-resolver/arranging.dylan (contents, props changed)
trunk/sandbox/dydoc/topic-resolver/merging.dylan (contents, props changed)
trunk/sandbox/dydoc/topic-resolver/module.dylan (contents, props changed)
trunk/sandbox/dydoc/topic-resolver/resolving.dylan (contents, props changed)
trunk/sandbox/dydoc/topic-resolver/visitors.dylan (contents, props changed)
trunk/sandbox/dydoc/workflows/
trunk/sandbox/dydoc/workflows/create-docs.dylan (contents, props changed)
trunk/sandbox/dydoc/workflows/module.dylan (contents, props changed)
Log:
Job: minor
Temp code for housel to look at.
Added: trunk/sandbox/dydoc/Makefile
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/Makefile Sat May 3 06:24:57 2008
@@ -0,0 +1,25 @@
+all: dydoc.out
+
+src = support/*.dylan \
+ internal-rep/*.dylan \
+ source-files/*.dylan \
+ markup-parser/*.dylan \
+ markup-translator/*.dylan \
+ topic-resolver/*.dylan \
+ workflows/*.dylan \
+ tool/*.dylan
+
+MONDAY_LIBDIR = /Users/dvoss/Documents/Projects/Dylan-SVN/libs/monday/lib
+UTILITY_LIBDIR = /Users/dvoss/Documents/Projects/Dylan-SVN/libs/utilities
+
+libs = -L$(UTILITY_LIBDIR)/command-line-parser \
+ -L$(UTILITY_LIBDIR)/peg-parser \
+ -L$(MONDAY_LIBDIR)/language/grammar \
+ -L$(MONDAY_LIBDIR)/program-representation/source-location
+
+dydoc.out: dydoc.lid $(src)
+ d2c -g $(libs) dydoc.lid
+
+clean:
+ -rm -f *.o *.s *.a *.c *.du *.el *.mak *~
+ -rm -rf .libs
Added: trunk/sandbox/dydoc/dydoc.lid
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/dydoc.lid Sat May 3 06:24:57 2008
@@ -0,0 +1,39 @@
+library: dydoc
+executable: dydoc.out
+files: support/library
+ support/common
+ support/errors-module
+ support/errors
+ support/ordered-tree-module
+ support/ordered-tree
+ internal-rep/module
+ internal-rep/body-elements
+ internal-rep/helpers
+ internal-rep/misc-elements
+ internal-rep/printers
+ internal-rep/quote-elements
+ internal-rep/toc-nav-elements
+ internal-rep/topic-elements
+ support/configs-module
+ support/configs
+ source-files/module
+ source-files/file-parser
+ markup-parser/module
+ markup-parser/literal-tokenizers
+ markup-parser/markup-parser
+ markup-parser/method-tokenizers
+ markup-parser/parser-helpers
+ markup-parser/rule-tokenizers
+ markup-translator/module
+ markup-translator/check-helpers
+ markup-translator/token-processing
+ topic-resolver/module
+ topic-resolver/arranging
+ topic-resolver/merging
+ topic-resolver/resolving
+ topic-resolver/visitors
+ workflows/module
+ workflows/create-docs
+ tool/module
+ tool/main
+
\ No newline at end of file
Added: trunk/sandbox/dydoc/internal-rep/body-elements.dylan
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/internal-rep/body-elements.dylan Sat May 3 06:24:57 2008
@@ -0,0 +1,107 @@
+module: internal-rep
+synopsis: Classes comprising documentation.
+
+/// Synopsis: List of elements corresponding to the markup-words grammar.
+/// text - <string> and <character>
+/// image-ref - <inline-image>
+/// quote - <xref>, <toc-xref>, <api-name>, <bold>, etc.
+/// bracketed-render-block - <dita-content> or <html-content>
+/// api-ref - Basically converts to an API qv.
+/// marker-ref - An <xref> to a <footnote> or <ph-marker>.
+/// synopsis-ref - <conref> with the #"title" or #"shortdesc" style.
+define constant <markup-deque> = limited(<deque>,
+ of: type-union(<string>, <character>, <inline-image>, <html-content>,
+ <dita-content>, <conref>, <xref>, <toc-xref>, <api-name>,
+ <parm-name>, <term>, <term-style>, <code-phrase>, <entity>,
+ <cite>, <bold>, <italic>, <underline>, <emphasis>));
+
+define class <section> (<interm-element>)
+ slot id :: false-or(<string>);
+ slot title = make(<title-deque>);
+ slot content = make(<deque>);
+end class;
+
+define class <footnote> (<interm-element>)
+ slot number;
+ slot content = make(<deque>);
+end class;
+
+define class <paragraph> (<interm-element>)
+ slot content = make(<markup-deque>);
+end class;
+
+define class <note> (<interm-element>)
+ slot content;
+end class;
+
+define class <warning-note> (<note>)
+end class;
+
+define class <conref> (<interm-element>)
+ slot target :: type-union(<topic>, <target-placeholder>);
+ slot style :: one-of(#"title", #"shortdesc", #"toc");
+end class;
+
+/// This will be rendered as an empty DITA <ph> or HTML anchor. Technically,
+/// DITA <codeph> is a sub-class of <ph>, but I'm not using them at all the same.
+/// Don't want to include content in the tag in case DITA processors won't consider
+/// it as code in a code block.
+define class <ph-marker> (<interm-element>)
+ slot index :: false-or(type-union(<integer>, <character>)),
+ init-keyword: #"index";
+end class;
+
+define class <ordered-list> (<interm-element>)
+ slot style :: one-of(#"num", #"alpha");
+ slot start :: <integer> = 1;
+ slot items;
+end class;
+
+define class <unordered-list> (<interm-element>)
+ slot items;
+end class;
+
+define class <defn-list> (<interm-element>)
+ slot items :: <array>;
+end class;
+
+define class <one-line-defn-list> (<defn-list>)
+end class;
+
+define class <two-line-defn-list> (<defn-list>)
+end class;
+
+define class <fig> (<interm-element>)
+ slot image;
+ slot abs-size :: false-or(<integer>);
+ slot rel-size :: false-or(<integer>);
+ slot title :: <string>;
+end class;
+
+define class <inline-image> (<interm-element>)
+ slot image, init-keyword: #"image";
+ slot alt-text :: <string>, init-keyword: #"alt-text";
+end class;
+
+define class <pre> (<interm-element>)
+ slot content;
+end class;
+
+define class <simple-table> (<interm-element>)
+ slot headings;
+ slot items :: <array>;
+end class;
+
+define class <code-block> (<pre>)
+end class;
+
+define class <parm-list> (<defn-list>)
+end class;
+
+define class <html-content> (<interm-element>)
+ slot content :: <string>, init-keyword: #"content";
+end class;
+
+define class <dita-content> (<interm-element>)
+ slot content :: <string>, init-keyword: #"content";
+end class;
Added: trunk/sandbox/dydoc/internal-rep/helpers.dylan
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/internal-rep/helpers.dylan Sat May 3 06:24:57 2008
@@ -0,0 +1,58 @@
+module: internal-rep
+
+
+/// Synopsis: Records the characteristics of a topic level style.
+define class <topic-level-style> (<object>)
+ slot line-character :: <character>, init-keyword: #"char";
+ slot underline? :: <boolean>, init-keyword: #"under";
+ slot midline? :: <boolean>, init-keyword: #"mid";
+ slot overline? :: <boolean>, init-keyword: #"over";
+end class;
+
+
+define method \= (style1 :: <topic-level-style>, style2 :: <topic-level-style>)
+=> (equal? :: <boolean>)
+ style1.line-character = style2.line-character &
+ style1.underline? = style2.underline? &
+ style1.midline? = style2.midline? &
+ style1.overline? = style2.overline?
+end method;
+
+
+/// Synopsis: Converts a title to a string. This can be done without resolving
+/// anything.
+define method stringify-title (title :: <title>) => (title :: <string>)
+ stringify-title-part(title.content)
+end method;
+
+define method stringify-title-part (string :: <string>) => (string :: <string>)
+ string
+end method;
+
+define method stringify-title-part (char :: <character>) => (string :: <string>)
+ as(<string>, char)
+end method;
+
+define method stringify-title-part (img :: <inline-image>) => (string :: <string>)
+ img.alt-text | "[img]"
+end method;
+
+define method stringify-title-part
+ (qt :: type-union(<emphasis>, <term-style>, <underline>, <italic>,
+ <bold>, <cite>, <code-phrase>, <term>))
+=> (string :: <string>)
+ stringify-title-part(qt.text)
+end method;
+
+define method stringify-title-part (entity :: <entity>) => (string :: <string>)
+ select (entity.code)
+ #x2018, #x2019 => "'";
+ #x201C, #x201C => "\"";
+ otherwise =>
+ if (entity.code < #x100) as(<string>, as(<character>, entity.code)) else "?" end;
+ end select
+end method;
+
+define method stringify-title-part (seq :: <sequence>) => (string :: <string>)
+ apply(concatenate-as, <string>, map(stringify-title-part, seq))
+end method;
Added: trunk/sandbox/dydoc/internal-rep/misc-elements.dylan
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/internal-rep/misc-elements.dylan Sat May 3 06:24:57 2008
@@ -0,0 +1,28 @@
+module: internal-rep
+synopsis: Placeholders that are replaced by actual elements after all is read.
+
+define class <interm-element> (<object>)
+ // False for topics; topics' parents are indicated by parent slot.
+ slot element-owner :: false-or(<interm-element>), init-keyword: #"owner";
+ slot element-source = #f;
+end class;
+
+/// Synopsis: Used when the target is unknown. May generally refer to a topic,
+/// API, argument, etc.
+define class <target-placeholder> (<interm-element>)
+ slot target :: <string>, init-keyword: #"link";
+end class;
+
+define method \= (obj-1 :: <target-placeholder>, obj-2 :: <target-placeholder>)
+=> (equal? :: <boolean>)
+ case-insensitive-equal(obj-1.target, obj-2.target)
+end method;
+
+define class <api-list-placeholder> (<interm-element>)
+ slot type :: <symbol>;
+ slot scope;
+end class;
+
+define class <ditto-placeholder> (<interm-element>)
+ slot target :: type-union(<topic>, <target-placeholder>);
+end class;
Added: trunk/sandbox/dydoc/internal-rep/module.dylan
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/internal-rep/module.dylan Sat May 3 06:24:57 2008
@@ -0,0 +1,36 @@
+module: dylan-user
+synopsis: Internal representation of documentation.
+
+define module internal-rep
+ use common;
+ use ordered-tree;
+
+ // from system
+ use locators, import: { <url> }, export: all;
+
+ export
+ <api-doc>, <api-list-placeholder>, <api-name>, <bold>, <cite>,
+ <class-doc>, <code-block>, <code-phrase>, <con-topic>, <conref>,
+ <defn-list>, <dita-content>, <ditto-placeholder>, <emphasis>, <entity>,
+ <fig>, <footnote>, <function-doc>, <generic-doc>, <html-content>,
+ <inline-image>, <interm-element>, <italic>, <library-doc>, <macro-doc>,
+ <module-doc>, <note>, <one-line-defn-list>, <ordered-list>, <paragraph>,
+ <parm-list>, <parm-name>, <ph-marker>, <pre>, <ref-topic>, <section>,
+ <simple-table>, <slot-doc>, <target-placeholder>, <term-style>, <term>,
+ <title>, <toc-xref>, <topic-ref>, <topic>, <two-line-defn-list>,
+ <underline>, <unordered-list>, <variable-doc>, <warning-note>, <xref>;
+
+ export
+ args-section, args-section-setter, conds-section, conds-section-setter,
+ content, content-setter, element-owner, element-owner-setter,
+ element-source, headings, headings-setter, id, id-setter, items,
+ items-setter, keywords-section, keywords-section-setter, parent,
+ parent-setter, relevant-to, see-also, see-also-section,
+ see-also-section-setter, shortdesc, shortdesc-setter, target,
+ target-setter, text, text-setter, title, title-setter, vals-section,
+ vals-section-setter;
+
+ export
+ <topic-level-style>, stringify-title;
+
+end module;
\ No newline at end of file
Added: trunk/sandbox/dydoc/internal-rep/printers.dylan
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/internal-rep/printers.dylan Sat May 3 06:24:57 2008
@@ -0,0 +1,28 @@
+module: internal-rep
+
+define method print-object (o :: <topic>, s :: <stream>) => ()
+ format(s, "{topic title %=, id %s, parent %=, content %=}",
+ o.title, o.id, o.parent, o.content);
+end method;
+
+define method print-object (o :: <title>, s :: <stream>) => ()
+ print-object(o.content, s);
+end method;
+
+define method print-object (o :: <paragraph>, s :: <stream>) => ()
+ format(s, "{para %=}", o.content)
+end method;
+
+define method print-object (o :: <toc-xref>, s :: <stream>) => ()
+ format(s, "{toc-xref %= ", o.text);
+ if (instance?(o.target, <topic>))
+ format(s, "{topic title %=, id %s}", o.target.title, o.target.id);
+ else
+ format(s, "%=", o.target);
+ end if;
+ format(s, "}");
+end method;
+
+define method print-object (o :: <target-placeholder>, s :: <stream>) => ()
+ format(s, "{placeholder %=}", o.target)
+end method;
Added: trunk/sandbox/dydoc/internal-rep/quote-elements.dylan
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/internal-rep/quote-elements.dylan Sat May 3 06:24:57 2008
@@ -0,0 +1,68 @@
+module: internal-rep
+synopsis: Intermediate elements from quote directives.
+
+
+define class <xref> (<interm-element>)
+ // If the target is <topic>, <footnote>, <ph-marker>, or <section>, the DITA
+ // xref tag will have a format attr of "dita," else based on the URL; the
+ // scope attr will be "local," else "external."
+ slot target :: type-union(<topic>, <footnote>, <section>, <ph-marker>, <url>,
+ <target-placeholder>),
+ init-keyword: #"target";
+ slot text :: type-union(<api-name>, <parm-name>, <string>),
+ init-keyword: #"text";
+end class;
+
+/// Synopsis: Represents a toc quotation directive (as opposed to <xref>'s qv
+/// directive).
+define class <toc-xref> (<xref>)
+ inherited slot target /* :: type-union(<topic>, <target-placeholder>) */;
+end class;
+
+define class <api-name> (<interm-element>)
+ slot text :: <string>;
+end class;
+
+define class <parm-name> (<interm-element>)
+ slot text :: <string>;
+end class;
+
+define class <term> (<interm-element>)
+ slot text;
+end class;
+
+/// Synopsis: Like <emphasis>, this is a style that will be rendered as bold,
+/// italic, whatever. It is associated with a <term>, but is separate to allow
+/// for typographical quotes that are appropriately styled but not part of the
+/// actual term.
+define class <term-style> (<interm-element>)
+ slot text;
+end class;
+
+define class <code-phrase> (<interm-element>)
+ slot text;
+end class;
+
+define class <entity> (<interm-element>)
+ slot code :: <integer>, init-keyword: #"code";
+end class;
+
+define class <cite> (<interm-element>)
+ slot text;
+end class;
+
+define class <bold> (<interm-element>)
+ slot text;
+end class;
+
+define class <italic> (<interm-element>)
+ slot text;
+end class;
+
+define class <underline> (<interm-element>)
+ slot text;
+end class;
+
+define class <emphasis> (<interm-element>)
+ slot text;
+end class;
Added: trunk/sandbox/dydoc/internal-rep/toc-nav-elements.dylan
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/internal-rep/toc-nav-elements.dylan Sat May 3 06:24:57 2008
@@ -0,0 +1,14 @@
+module: internal-rep
+synopsis: Classes comprising the table-of-contents and navigation map.
+
+define class <toc-map> (<object>)
+ slot title :: <string>;
+ slot shortdesc;
+ constant slot authors = make(<stretchy-vector>);
+end class;
+
+define class <topic-ref> (<object>)
+ slot navtitle :: <string>;
+ slot target :: false-or(type-union(<topic>, <url>, <target-placeholder>));
+ slot automatic-default? :: <boolean> = #f;
+end class;
Added: trunk/sandbox/dydoc/internal-rep/topic-elements.dylan
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/internal-rep/topic-elements.dylan Sat May 3 06:24:57 2008
@@ -0,0 +1,109 @@
+module: internal-rep
+synopsis: Classes comprising API reference topics.
+
+/// Synopsis: List of elements corresponding to the title-words grammar.
+/// text - <string> and <character>
+/// image-ref - <inline-image>
+/// quote - <bold>, etc., but not <xref>, <toc-xref>, <api-name>,
+/// or <parm-name> which are introducted by qv and toc.
+/// bracketed-render-block - <dita-content> or <html-content>
+define constant <title-deque> = limited(<deque>,
+ of: type-union(<string>, <character>, <inline-image>, <html-content>,
+ <dita-content>, <term>, <term-style>, <code-phrase>, <entity>,
+ <cite>, <bold>, <italic>, <underline>, <emphasis>));
+
+define class <topic> (<interm-element>)
+ // No placeholder needed for fixed-parent, because the parent is known from
+ // topic nesting markup.
+ slot fixed-parent :: false-or(<topic>) = #f;
+ // parent is parent topic as indicated by "Section:" directive. If not false,
+ // should end up being the same as fixed-parent (if fixed-parent is not false).
+ // If not, caught during placeholder resolution.
+ slot parent :: false-or(type-union(<topic>, <target-placeholder>)) = #f;
+ slot id :: false-or(<string>) = #f;
+ slot title :: <title>;
+ slot shortdesc :: false-or(<paragraph>) = #f;
+ slot content :: false-or(<markup>) = #f;
+ slot see-also = make(<deque>) /* of <topic>, <url>, or <target-placeholder> */;
+ slot relevant-to = make(<deque>) /* of <topic> or <target-placeholder> */;
+ // see-also-section is filled in later after all see-alsos are resolved.
+ slot see-also-section :: false-or(<section>) = #f;
+end class;
+
+define class <title> (<interm-element>)
+ slot content :: <sequence> = make(<deque>);
+end class;
+
+define class <ref-topic> (<topic>)
+end class;
+
+define class <con-topic> (<topic>)
+end class;
+
+define class <api-doc> (<ref-topic>)
+end class;
+
+define method make (class == <api-doc>, #key topic-type) => (inst :: <api-doc>)
+ select (topic-type)
+ #"class" => make(<class-doc>);
+ #"variable" => make(<variable-doc>);
+ #"function" => make(<function-doc>);
+ #"generic-function" => make(<generic-doc>);
+ #"library" => make(<library-doc>);
+ #"module" => make(<module-doc>);
+ #"macro" => make(<macro-doc>);
+ otherwise => error("Unknown topic-type in make(<api-doc>)");
+ end select;
+end method;
+
+define class <class-doc> (<api-doc>)
+ slot export-section :: <section>;
+ slot keywords-section :: <section>;
+ slot modifiers-section :: <section>;
+ slot supers-section :: <section>;
+ slot subs-section :: <section>;
+ slot funcs-on-section :: <section>;
+ slot funcs-returning-section :: <section>;
+end class;
+
+/// Only used temporarily for comment blocks associated with a slot. Split up
+/// into getter, setter, and init-keyword ASAP.
+define class <slot-doc> (<api-doc>)
+ slot setter-name :: false-or(<string>);
+ slot getter-name :: false-or(<string>);
+ slot keyword-name :: false-or(<string>);
+end class;
+
+define class <variable-doc> (<api-doc>)
+ slot export-section :: <section>;
+ slot type-section :: <section>;
+ slot value-section :: <section>;
+end class;
+
+define class <function-doc> (<api-doc>)
+ slot export-section :: <section>;
+ slot args-section :: <section>;
+ slot vals-section :: <section>;
+ slot conds-section :: <section>;
+end class;
+
+define class <generic-doc> (<function-doc>)
+ slot modifiers-section :: <section>;
+ slot method-topics :: <sequence>;
+end class;
+
+define class <library-doc> (<api-doc>)
+ slot modules-section :: <section>;
+end class;
+
+define class <module-doc> (<api-doc>)
+ slot export-section :: <section>;
+ slot names-section :: <section>;
+end class;
+
+define class <macro-doc> (<api-doc>)
+ slot export-section :: <section>;
+ slot syntax-section :: <section>;
+ slot args-section :: <section>;
+ slot vals-section :: <section>;
+end class;
Added: trunk/sandbox/dydoc/markup-parser/grammar.txt
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/markup-parser/grammar.txt Sat May 3 06:24:57 2008
@@ -0,0 +1,332 @@
+http://en.wikipedia.org/wiki/Parsing_expression_grammar
+
+Primitive tokens are:
+ SOL - Start of line. Doesn't consume any characters.
+ SOL-IND - A number of spaces equal to the current indent level.
+ NEW-SOL-IND - A number of spaces, setting a new indent level.
+ EOS - End of stream
+ LS - Unicode LS/PS, CR, LF, CRLF
+ CHAR - Any character, including LS characters
+ NUMBER - One or more digits
+ ORDINAL - Character in a progressive sequence (i.e. "a..z")
+
+All tabs should be converted to spaces before parsing. Strings are
+case-insensitive. There are no escape sequences; use '...' [unq] for that
+effect.
+
+Parsing constraints that I can't (or won't) express in the grammar:
+ - Tables.
+ - Some quote options are ignored in titles or other places.
+ - Link names, words, and phrases could be further specified into topic
+ titles, nicknames, and URLs.
+
+Note that literal strings should be sorted from largest to smallest to reflect
+the greedy parsing.
+
+
+markup-block:
+ ( topic / flush-content )+ SPC-OR-LS* EOS
+
+topic:
+ topic-directive / titled-topic
+topic-directive:
+ topic-directive-spec topic-content?
+titled-topic:
+ topic-title topic-content?
+
+topic-directive-spec:
+ ascii-overline? SOL-IND ascii-line? topic-directive-spec-text ':' SPC*
+ text-til-spc-ascii-ls ascii-line? SPC-LS ascii-underline?
+
+topic-title:
+ topic-title-style-midline-style / topic-title-bare-style
+topic-title-style-midline-style:
+ ascii-overline?
+ ( title-midline-line* title-midline-nickname-line / title-midline-line )
+ ascii-underline?
+topic-title-bare-style:
+ ascii-overline?
+ ( title-bare-line* title-bare-nickname-line / title-bare-line )
+ ascii-underline
+title-midline-line:
+ !title-midline-nickname-line
+ SOL-IND ascii-line SPC+ ( !ascii-line !SPC-LS title-word SPC* )+ ascii-line? SPC-LS
+title-bare-line:
+ !title-bare-nickname-line
+ SOL-IND ( !SPC-LS title-word SPC* )+ SPC-LS
+title-midline-nickname-line:
+ SOL-IND ascii-line SPC+ ( !ascii-line !'[' title-word SPC* )*
+ ( ascii-line SPC+ )? [-SPC nickname-word SPC-] SPC-LS
+title-bare-nickname-line:
+ SOL-IND ( !'[' title-word SPC* )* [-SPC nickname-word SPC-] SPC-LS
+
+topic-content:
+ ( section-directive / flush-content / footnote )+
+section-directive:
+ paragraph-directive / link-directive / links-directive /
+ indented-directive / null-directive
+footnote:
+ SOL-IND [-SPC ( NUMBER / ORDINAL ) ( SPC-] ':' / ':' SPC-] )
+ SPC+ markup-words? LS flush-content?
+
+flush-content:
+ flush-content-at-level+
+flush-content-at-level:
+ &NEW-SOL-IND? lines-content
+indented-content:
+ &NEW-SOL-IND flush-content
+
+lines-content:
+ line-content+
+line-content:
+ !eos !topic-directive-spec !topic-title !section-directive !footnote
+ ( blank-lines / marginal-code-block / marginal-verbatim-block /
+ figure-ref-line / content-ref-line / ditto-ref-line / bracketed-raw-block /
+ table / bullet-list / numeric-list / hyphenated-list / phrase-list /
+ paragraph )
+paragraph:
+ paragraph-line+
+paragraph-til-null-directive:
+ ( !null-directive-spec paragraph-line )+
+bracketed-line:
+ &'[' ( figure-ref-line / content-ref-line / ditto-ref-line /
+ bracket-raw-block-start-line )
+
+marginal-code-block:
+ marginal-code-block-line+
+marginal-verbatim-block:
+ marginal-verbatim-block-line+
+bullet-list:
+ bullet-list-first-item ( blank-lines? bullet-list-item )*
+numeric-list:
+ numeric-list-first-item ( blank-lines? numeric-list-item )*
+phrase-list:
+ phrase-list-item ( blank-lines? phrase-list-item )*
+hyphenated-list:
+ hyphenated-list-item ( blank-lines? hyphenated-list-item )*
+table:
+ table-header table-row* table-footer
+figure-ref-line:
+ SOL-IND [-SPC "FIG" SPC-OR-LS+ filename ( SPC-OR-LS+
+ ( perc-scale / mult-scale ) )? SPC-] text-til-spc-ls? SPC-LS
+content-ref-line:
+ SOL-IND [-SPC "CONTENTS" ( SPC-OR-LS+ "OF" SPC-OR-LS+ link-til-end-brack )?
+ SPC-] SPC-LS
+ditto-ref-line:
+ SOL-IND [-SPC "DITTO" SPC-OR-LS+ link-til-end-brack SPC-] SPC-LS
+api-list-ref-line:
+ SOL-IND [-SPC "LIST" SPC-OR-LS+ "OF" SPC-OR-LS+ api-list-spec-text SPC-] SPC-LS
+bracketed-raw-block:
+ bracketed-raw-block-start-line
+ ( SOL-IND !bracketed-raw-block-end-line raw-line )*
+ bracketed-raw-block-end-line
+blank-lines:
+ ( SOL SPC-LS )+
+
+bullet-list-item:
+ bullet-list-line indented-content?
+bullet-list-item:
+ bullet-list-line indented-content?
+numeric-list-first-item:
+ numeric-list-first-line indented-content?
+numeric-list-item:
+ numeric-list-line indented-content?
+hyphenated-list-item:
+ hyphenated-list-line indented-content?
+phrase-list-item:
+ phrase-list-label indented-content
+
+paragraph-line:
+ !blank-lines !bracketed-line !marginal-code-block !marginal-verbatim-block
+ !bullet-list-line !numeric-list-first-line !hyphenated-list-line
+ SOL-IND markup-words SPC-LS
+paragraph-line-til-hyphen-spc-ls:
+ !blank-lines !bracketed-line !marginal-code-block !marginal-verbatim-block
+ !bullet-list-line !numeric-list-first-line !hyphenated-list-line
+ SOL-IND ( !( '-' SPC-LS ) markup-word spaces )+ ( &'-' / LS )
+
+bracketed-raw-block-start-line:
+ SOL-IND [-SPC bracketed-raw-block-spec-text SPC-] SPC-LS
+bracketed-raw-block-end-line:
+ SOL-IND [-SPC "END" ( SPC-OR-LS+ bracketed-raw-block-spec-text )? SPC-] SPC-LS
+table-header:
+ SOL-IND ...
+table-row:
+ SOL-IND ...
+table-footer:
+ SOL-IND ...
+
+marginal-code-block-line:
+ SOL-IND ':' SPC raw-line
+marginal-verbatim-block-line:
+ SOL-IND ( '>' / '|' ) SPC raw-line
+bullet-list-line:
+ SOL-IND bullet-char SPC+ markup-words LS
+numeric-list-first-line:
+ SOL-IND ( NUMBER / ORDINAL ) ( ':' / ')' / '.' ) SPC+ markup-words LS
+numeric-list-line:
+ SOL-IND ( NUMBER / ORDINAL / '#' ) ( ':' / ')' / '.' ) SPC+ markup-words LS
+hyphenated-list-line:
+ SOL-IND markup-word SPC+ '-' spaces markup-words LS
+phrase-list-label:
+ !topic-directive-spec !topic-title !section-directive !footnote
+ paragraph-line-til-hyphen-spc-ls+ hyphen SPC-LS
+
+raw-line:
+ ( !raw-line-end CHAR )* raw-line-end
+raw-line-end:
+ line-marker? SPC-LS
+line-marker:
+ '[' ':' ( NUMBER / ORDINAL ) ']'
+perc-scale:
+ NUMBER '%'
+mult-scale:
+ NUMBER 'X'
+
+paragraph-directive:
+ paragraph-directive-spec markup-words? SPC-LS paragraph-til-null-directive?
+link-directive:
+ link-directive-spec link-til-spc-ls SPC-LS
+links-directive:
+ links-directive-spec link-words* SPC-LS indented-link-words?
+indented-directive:
+ indented-directive-spec markup-words? SPC-LS indented-content?
+null-directive:
+ null-directive-spec markup-words? SPC-LS flush-content?
+
+paragraph-directive-spec:
+ ascii-overline? SOL-IND paragraph-directive-spec-text ':' SPC*
+ ( LS ascii-underline )?
+link-directive-spec:
+ ascii-overline? SOL-IND link-directive-spec-text ':' SPC*
+ ( LS ascii-underline )?
+links-directive-spec:
+ ascii-overline? SOL-IND links-directive-spec-text ':' SPC*
+ ( LS ascii-underline )?
+indented-directive-spec:
+ ascii-overline? SOL-IND indented-directive-spec-text ':' SPC*
+ ( LS ascii-underline )?
+null-directive-spec:
+ ascii-overline? SOL-IND null-directive-spec-text ':' SPC*
+ ( LS ascii-underline )?
+
+markup-words:
+ ( markup-word SPC* )+
+markup-word:
+ title-word / api-ref / marker-ref / synopsis-ref
+title-word:
+ image-ref / quote / bracketed-render-block / text-til-spc-or-ls
+
+ascii-overline:
+ SOL-IND ascii-line SPC-LS
+ascii-underline:
+ SOL-IND ascii-line SPC-LS
+ascii-line:
+ SOL-IND ascii-line-char ascii-line-char ascii-line-char+ SPC-LS
+image-ref:
+ [-SPC "IMG" SPC-OR-LS+ filename ( SPC-OR-LS+ text-til-spc-cls-brack )? SPC-]
+marker-ref:
+ [-SPC ( NUMBER / ORDINAL ) SPC-]
+bracketed-render-block:
+ bracketed-render-block-start
+ ( !bracketed-render-block-end CHAR )*
+ bracketed-render-block-end
+bracketed-render-block-start:
+ [-SPC bracketed-render-block-spec-text SPC-]
+bracketed-render-block-end:
+ [-SPC "END" ( SPC-OR-LS+ bracketed-render-block-spec-text )? SPC-]
+synopsis-ref:
+ [-SPC "SYNOPSIS" SPC-OR-LS+ "OF" SPC-OR-LS+ link-til-end-brack SPC-]
+api-ref:
+ ...
+
+topic-directive-spec-text:
+ "FUNCTION" / "VARIABLE" / ( "GENERIC" spaces "FUNCTION" ) / "LIBRARY" /
+ "MODULE" / "CLASS" / "MACRO"
+paragraph-directive-spec-text:
+ "SYNOPSIS" / "SYN"
+link-directive-spec-text:
+ "SECTION"
+links-directive-spec-text:
+ "RELEVANT" spaces "TO" / "SEE" spaces "ALSO"
+indented-directive-spec-text:
+ "INIT-KEYWORDS" / "CONDITIONS" / "EXCEPTIONS" / "ARGUMENTS" / "KEYWORDS" /
+ "SIGNALS" / "WARNING" / "ERRORS" / "VALUES" / "ARGS" /
+ ( "MAKE" spaces "KEYWORDS" ) / "NOTE" / user-defined
+null-directive-spec-text:
+ "DISCUSSION"
+api-list-spec-text:
+ "FUNCTIONS" / "LIBRARIES" / "VARIABLES" / "BINDINGS" / "CLASSES" / "MODULES" / "MACROS"
+bracketed-raw-block-spec-text:
+ "VERBATIM" / "DIAGRAM" / "EXAMPLE" / "CODE"
+bracketed-render-block-spec-text:
+ "DITA" / "HTML"
+
+indented-link-words:
+ &NEW-SOL-IND link-word-lines
+link-word-lines:
+ ( SOL-IND link-words SPC-LS )+
+link-words:
+ link-word ( spaces link-word )*
+link-word:
+ start-quote text-til-end-quote end-quote / text-til-spc-or-ls
+link-til-spc-ls:
+ text-til-spc-ls
+link-til-end-brack:
+ text-til-spc-cls-brack
+filename:
+ start-quote text-til-end-quote end-quote
+nickname-word:
+ ( !SPC !']' CHAR )+
+
+quote:
+ quoted-words ( SPC-OR-LS+ quote-spec )?
+quoted-words:
+ ( '(' / '[' / '{' / '<' )* start-quote text-til-end-quote? end-quote
+ text-til-spc-or-ls?
+start-quote:
+ ''' / '"' / '`' / user-defined
+end-quote:
+ ''' / '"' / '`' / user-defined
+quote-spec:
+ [-SPC ( quote-spec-option SPC-OR-LS* )* quote-spec-link-option? SPC-]
+quote-spec-option:
+ "CODE" / "TERM" / "BIB" / "SIC" / "TOC" / "UNQ" / "EM" / "QQ" / "QV" /
+ "B" / "I" / "U" / "Q"
+quote-spec-link-option:
+ ( "TOC" / "QV" ) SPC-OR-LS+ text-til-spc-cls-brack
+
+text-til-spc:
+ ( !SPC CHAR )+
+text-til-ls:
+ ( !LS CHAR )+
+text-til-spc-ls:
+ ( !SPC-LS CHAR )+
+text-til-spc-ascii-ls:
+ ( !( SPC* ( LS / ascii-line ) ) CHAR )+
+text-til-spc-cls-brack:
+ ( !SPC-] CHAR )+
+text-til-end-quote:
+ ( !end-quote CHAR )+
+text-til-spc-or-ls:
+ ( !SPC !LS CHAR )+
+spaces:
+ SPC+
+opt-spaces:
+ SPC*
+
+SPC:
+ ' '
+SPC-LS:
+ SPC* LS
+SPC-OR-LS:
+ SPC / LS
+[-SPC:
+ '[' SPC-OR-LS*
+SPC-]:
+ SPC-OR-LS* ']'
+
+ascii-line-char:
+ '=' / '-' / ':' / '.' / '~' / '^' / '_' / '*' / '+' / '#' / user-defined
+bullet-char:
+ '-' / '*' / '+' / 'o' / user-defined
Added: trunk/sandbox/dydoc/markup-parser/literal-tokenizers.dylan
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/markup-parser/literal-tokenizers.dylan Sat May 3 06:24:57 2008
@@ -0,0 +1,115 @@
+module: markup-parser
+
+define method parse-literal
+ (stream :: <positionable-stream>, string :: <string>, context)
+=> (token :: <symbol>)
+ let string = as-lowercase(string);
+ let pos = stream.stream-position;
+ let stream-string = read(stream, string.size, on-end-of-stream: #f);
+ if (~stream-string | as-lowercase(stream-string) ~= string)
+ error(make(<parse-failure>, position: pos,
+ expected: concatenate("\"", string, "\"")))
+ end if;
+ as(<symbol>, string)
+end method;
+
+define method parse-literal
+ (stream :: <positionable-stream>, char :: <character>, context)
+=> (token :: <symbol>)
+ let pos = stream.stream-position;
+ let stream-char = read-element(stream, on-end-of-stream: #f);
+ if (stream-char ~= char)
+ let expected-str = format-to-string("\"%c\"", char);
+ error(make(<parse-failure>, position: pos,
+ expected: expected-str))
+ end if;
+ as(<symbol>, as(<string>, stream-char))
+end method;
+
+define macro literal-parsers-definer
+ { define literal-parsers ?literals end } => { ?literals }
+literals:
+ { ?:name = ?:expression; ... }
+ => { define parser-method ?name (stream, context) => (token)
+ parse-literal(stream, ?expression, context)
+ end;
+ ... }
+ { } => { }
+end macro;
+
+define literal-parsers
+ colon = ':';
+ percent = '%';
+ spc = ' ';
+ lt = '<';
+ gt = '>';
+ bar = '|';
+ left-brace = '{';
+ left-paren = '(';
+ right-paren = ')';
+ hash = '#';
+ hyphen = '-';
+ open-bracket = '[';
+ close-bracket = ']';
+ period = '.';
+ also-lit = "also";
+ args-lit = "args";
+ arguments-lit = "arguments";
+ b-lit = "b";
+ bib-lit = "bib";
+ bindings-lit = "bindings";
+ class-lit = "class";
+ classes-lit = "classes";
+ code-lit = "code";
+ conditions-lit = "conditions";
+ contents-lit = "contents";
+ diagram-lit = "diagram";
+ discussion-lit = "discussion";
+ dita-lit = "dita";
+ ditto-lit = "ditto";
+ em-lit = "em";
+ end-lit = "end";
+ errors-lit = "errors";
+ example-lit = "example";
+ exceptions-lit = "exceptions";
+ fig-lit = "fig";
+ function-lit = "function";
+ functions-lit = "functions";
+ generic-lit = "generic";
+ html-lit = "html";
+ i-lit = "i";
+ img-lit = "img";
+ init-keywords-lit = "init-keywords";
+ keywords-lit = "keywords";
+ libraries-lit = "libraries";
+ library-lit = "library";
+ list-lit = "list";
+ macro-lit = "macro";
+ macros-lit = "macros";
+ make-lit = "make";
+ module-lit = "module";
+ modules-lit = "modules";
+ note-lit = "note";
+ of-lit = "of";
+ q-lit = "q";
+ qq-lit = "qq";
+ qv-lit = "qv";
+ relevant-lit = "relevant";
+ section-lit = "section";
+ see-lit = "see";
+ sic-lit = "sic";
+ signals-lit = "signals";
+ syn-lit = "syn";
+ synopsis-lit = "synopsis";
+ term-lit = "term";
+ to-lit = "to";
+ toc-lit = "toc";
+ u-lit = "u";
+ unq-lit = "unq";
+ values-lit = "values";
+ variable-lit = "variable";
+ variables-lit = "variables";
+ verbatim-lit = "verbatim";
+ warning-lit = "warning";
+ x-lit = "x";
+end;
Added: trunk/sandbox/dydoc/markup-parser/markup-parser.dylan
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/markup-parser/markup-parser.dylan Sat May 3 06:24:57 2008
@@ -0,0 +1,75 @@
+module: markup-parser
+synopsis: Parser initialization and overall control.
+
+
+/// Synopsis: Tracks parser state and grammar variables.
+define class <markup-context> (<object>)
+ slot indent-stack :: <deque> = make(<deque>);
+ slot end-quote-char :: false-or(<character>) = #f;
+ slot end-bracket-spec :: false-or(<symbol>) = #f;
+ slot ascii-line-char :: false-or(<character>) = #f;
+ slot list-stack :: <deque> = make(<deque>);
+end class;
+
+
+// Synopsis: A way to note the file stream from which a token came.
+define class <token-source> (<object>)
+ slot token-source :: <file-stream>
+end class;
+
+
+/// Synopsis: Entry point into parsing.
+/// Conditions: Throws <parse-failure> if stream has syntax error.
+define method parse-markup (text :: <file-stream>) => (contents :: <sequence>)
+ let context = make(<markup-context>);
+ let markup-block-contents = parse-markup-block(text, context);
+ log-object("Markup", markup-block-contents);
+ visit-token-sources(markup-block-contents, rcurry(token-source-setter, text));
+ markup-block-contents
+end method;
+
+
+/// Generic Function: visit-token-sources
+/// Synopsis: Visits all <token>s that are also <token-source>s.
+///
+/// Arguments:
+/// element - The <token-source> to visit.
+/// operation - A <function> on 'element'.
+/// Values:
+/// result - The result of 'operation'.
+
+define collection-recursive slot-visitor visit-token-sources
+ <topic-directive-token>, content;
+ <titled-topic-token>, content;
+ <footnote-token>, content;
+ <paragraph-token>, content;
+ <marginal-code-block-token>, content;
+ <marginal-verbatim-block-token>, content;
+ <bullet-list-token>, content;
+ <numeric-list-token>, content;
+ <phrase-list-token>, content;
+ <hyphenated-list-token>, content;
+ <figure-ref-line-token>, scale-factor;
+ <content-ref-line-token>, ;
+ <ditto-ref-line-token>, ;
+ <api-list-ref-line-token>, ;
+ <bracketed-raw-block-token>, content;
+ <bullet-list-item-token>, content;
+ <numeric-list-first-item-token>, content;
+ <numeric-list-item-token>, content;
+ <hyphenated-list-item-token>, content, item-label;
+ <phrase-list-item-token>, content, item-label;
+ <raw-line-token>, ;
+ <perc-scale-token>, ;
+ <mult-scale-token>, ;
+ <paragraph-directive-token>, content;
+ <link-directive-token>, ;
+ <links-directive-token>, links;
+ <indented-directive-token>, content;
+ <image-ref-token>, ;
+ <marker-ref-token>, ;
+ <bracketed-render-block-token>, ;
+ <synopsis-ref-token>, ;
+ <quote-token>, ;
+ <ascii-line-token>, ;
+end slot-visitor;
Added: trunk/sandbox/dydoc/markup-parser/method-tokenizers.dylan
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/markup-parser/method-tokenizers.dylan Sat May 3 06:24:57 2008
@@ -0,0 +1,373 @@
+module: markup-parser
+
+// exported
+define class <ascii-line-token> (<token>, <token-source>)
+ slot content :: <string>, init-keyword: #"content"
+end;
+
+
+define parser-method eos (stream, context)
+=> (token :: <symbol>)
+ let pos = stream.stream-position;
+ if (~stream.stream-at-end?)
+ error(make(<parse-failure>, position: pos, expected: "end of stream"))
+ end if;
+ #"eos"
+end parser-method;
+
+
+define method count-spaces (stream, context, #key to :: false-or(<integer>) = #f)
+=> (count :: <integer>)
+ for (count from 0,
+ while: peek(stream, on-end-of-stream: #f) = ' '
+ & if (to) count < to else #t end)
+ read-element(stream)
+ finally count
+ end for
+end method;
+
+
+define parser-method opt-spaces (stream, context)
+=> (token :: false-or(<symbol>))
+ let count = count-spaces(stream, context);
+ (count ~= 0) & (#"opt-spaces")
+end parser-method;
+
+
+define parser-method spaces (stream, context)
+=> (token :: <symbol>)
+ let count = count-spaces(stream, context);
+ if (count = 0)
+ error(make(<parse-failure>, position: stream.stream-position, expected: "spaces"))
+ end;
+ #"spaces"
+end parser-method;
+
+
+define parser-method sol (stream, context)
+=> (false :: <boolean>)
+ // This method *may* skip to the start of the next line of a comment block
+ // or check an EOL status in the context, or else is a no-op.
+ if (stream.stream-at-end?)
+ error(make(<parse-failure>, position: stream.stream-position,
+ expected: "start of line"))
+ end;
+ #f
+end parser-method;
+
+
+define parser-method sol-ind (stream, context)
+=> (token :: <symbol>)
+ let pos = stream.stream-position;
+ parse-sol(stream, context);
+ let expected-level =
+ if (context.indent-stack.empty?) 0 else context.indent-stack.first end;
+ let actual-level = count-spaces(stream, context, to: expected-level);
+ if (actual-level < expected-level)
+ error(make(<parse-failure>, position: pos, expected:
+ format-to-string("flush line at %d (got %d)", expected-level, actual-level)));
+ end;
+ #"sol-ind"
+end parser-method;
+
+
+define parser-method opt-new-sol-ind (stream, context)
+=> (token :: false-or(<symbol>))
+ parse-sol(stream, context);
+ let pos = stream.stream-position;
+ let indent-level =
+ if (context.indent-stack.empty?) 0 else context.indent-stack.first end;
+ let spaces = count-spaces(stream, context);
+ stream.stream-position := pos;
+ case
+ spaces > indent-level =>
+ push(context.indent-stack, spaces);
+ #"opt-new-sol-ind";
+ spaces = indent-level =>
+ #f;
+ spaces < indent-level =>
+ error(make(<parse-failure>, position: pos,
+ expected: "flush or indented line"));
+ end case
+end;
+
+
+define parser-method new-sol-ind (stream, context)
+=> (token :: <symbol>)
+ parse-sol(stream, context);
+ let pos = stream.stream-position;
+ let indent-level =
+ if (context.indent-stack.empty?) 0 else context.indent-stack.first end;
+ let spaces = count-spaces(stream, context);
+ stream.stream-position := pos;
+ case
+ spaces > indent-level =>
+ push(context.indent-stack, spaces);
+ #"new-sol-ind";
+ otherwise =>
+ error(make(<parse-failure>, position: pos,
+ expected: "indented line"));
+ end case
+end parser-method;
+
+
+define parser-method ls (stream, context)
+=> (token :: <symbol>)
+ let pos = stream.stream-position;
+ let char = read-element(stream, on-end-of-stream: #f);
+ select (char)
+ '\<0d>' =>
+ if (peek(stream, on-end-of-stream: #f) = '\<0a>')
+ read-element(stream)
+ end if;
+ '\<0a>', '\<0c>' /* (no Unicode) '\<2028>', '\<2029>' */ =>
+ ;
+ otherwise =>
+ error(make(<parse-failure>, position: pos, expected: "new line"));
+ end select;
+ #"ls"
+end parser-method;
+
+
+define parser-method char (stream, context)
+=> (character :: <character>)
+ let pos = stream.stream-position;
+ let char = read-element(stream, on-end-of-stream: #f);
+ if (~char)
+ error(make(<parse-failure>, position: pos, expected: "character"))
+ end if;
+ char
+end parser-method;
+
+
+define parser-method number (stream, context)
+=> (token :: <integer>)
+ let pos = stream.stream-position;
+ let num-str = "";
+ while (~stream.stream-at-end? & digit?(peek(stream)))
+ num-str := add!(num-str, read-element(stream))
+ end while;
+ if (num-str.empty?)
+ error(make(<parse-failure>, position: pos, expected: "number"))
+ end if;
+ string-to-integer(num-str)
+end parser-method;
+
+
+define parser-method ordinal (stream, context)
+=> (token :: <character>)
+ let pos = stream.stream-position;
+ let char = peek(stream, on-end-of-stream: #f);
+ if (~char | ~alphabetic?(char))
+ error(make(<parse-failure>, position: pos, expected: "ordinal character"))
+ end if;
+ read-element(stream);
+ char
+end parser-method;
+
+
+define parser-method spc-or-ls (stream, context)
+=> (token :: <symbol>)
+ let pos = stream.stream-position;
+ let char = read-element(stream, on-end-of-stream: #f);
+ select (char)
+ ' ', '\<0d>', '\<0a>', '\<0c>' /* (no Unicode) '\<2028>', '\<2029>' */ =>
+ #"spc-or-ls";
+ otherwise =>
+ error(make(<parse-failure>, position: pos, expected: "space or new line"));
+ end select
+end parser-method;
+
+
+define method count-spc-or-ls (stream, context)
+=> (count :: <integer>)
+ for (count from 0,
+ while: member?(peek(stream, on-end-of-stream: #f),
+ " \<0d>\<0a>\<0c>" /* (no Unicode) "\<2028>\<2029>" */ ))
+ read-element(stream)
+ finally
+ count
+ end for
+end method;
+
+
+define parser-method many-spc-or-ls (stream, context)
+=> (token :: <symbol>)
+ let pos = stream.stream-position;
+ let count = count-spc-or-ls(stream, context);
+ if (count = 0)
+ error(make(<parse-failure>, position: pos, expected: "spaces or new line"))
+ end if;
+ #"many-spc-or-ls"
+end parser-method;
+
+
+define parser-method opt-many-spc-or-ls (stream, context)
+=> (token :: false-or(<symbol>))
+ let count = count-spc-or-ls(stream, context);
+ (count ~= 0) & (#"many-spc-or-ls")
+end parser-method;
+
+
+define parser-method flush-content-at-level (stream, context)
+=> (content :: <sequence>)
+ let ind? = parse-opt-new-sol-ind(stream, context);
+ block()
+ parse-lines-content(stream, context);
+ cleanup
+ if (ind?) pop(context.indent-stack) end;
+ end block
+end parser-method;
+
+
+define parser-method indented-content (stream, context)
+=> (content :: <sequence>)
+ parse-new-sol-ind(stream, context);
+ block()
+ parse-flush-content(stream, context);
+ cleanup
+ pop(context.indent-stack);
+ end block;
+end parser-method;
+
+
+define parser-method indented-link-words (stream, context)
+=> (content :: <sequence>)
+ parse-new-sol-ind(stream, context);
+ block()
+ parse-link-word-lines(stream, context);
+ cleanup
+ pop(context.indent-stack);
+ end block;
+end parser-method;
+
+
+define parser-method text-til-ls (stream, context)
+=> (text :: <string>)
+ let pos = stream.stream-position;
+ let text = "";
+ while (~member?(peek(stream, on-end-of-stream: '\<00>'),
+ "\<00>\<0d>\<0a>\<0c>" /* (no Unicode) "\<2028>\<2029>" */))
+ text := add!(text, read-element(stream))
+ end while;
+ if (text.empty?)
+ error(make(<parse-failure>, position: pos, expected: "text"))
+ end if;
+ text
+end parser-method;
+
+
+define parser-method text-til-spc-or-ls (stream, context)
+=> (text :: <string>)
+ let pos = stream.stream-position;
+ let text = "";
+ while (~member?(peek(stream, on-end-of-stream: '\<00>'),
+ " \<00>\<0d>\<0a>\<0c>" /* (no Unicode) "\<2028>\<2029>" */))
+ text := add!(text, read-element(stream))
+ end while;
+ if (text.empty?)
+ error(make(<parse-failure>, position: pos, expected: "text"))
+ end if;
+ text
+end parser-method;
+
+
+define parser-method text-til-end-quote (stream, context)
+=> (text :: <string>)
+ let pos = stream.stream-position;
+ let (text, found?) = read-to(stream, context.end-quote-char, on-end-of-stream: #f);
+ if ((text & text.size = 0) | ~found?)
+ error(make(<parse-failure>, position: pos, expected: "text"))
+ end if;
+ text
+end parser-method;
+
+
+define parser-method start-quote (stream, context)
+=> (quote :: <string>)
+ let pos = stream.stream-position;
+ let quote = read-element(stream, on-end-of-stream: #f);
+ case
+ member?(quote, $open-quote-chars) =>
+ let quote-index = position($open-quote-chars, quote);
+ context.end-quote-char := $close-quote-chars[quote-index];
+ otherwise =>
+ if (quote) unread-element(stream, quote) end;
+ error(make(<parse-failure>, position: stream.stream-position,
+ expected: concatenate("one of \"", $open-quote-chars, "\"")));
+ end case;
+ as(<string>, quote);
+end;
+
+
+define parser-method end-quote (stream, context)
+=> (quote :: <string>)
+ let pos = stream.stream-position;
+ let quote = read-element(stream, on-end-of-stream: #f);
+ select (quote)
+ context.end-quote-char =>
+ context.end-quote-char := #f;
+ as(<string>, quote);
+ otherwise =>
+ if (quote) unread-element(stream, quote) end;
+ let expected-str = format-to-string("\"%c\"", context.end-quote-char);
+ error(make(<parse-failure>, position: pos, expected: expected-str));
+ end select
+end;
+
+
+define parser-method bullet-char (stream, context)
+=> (bullet :: <string>)
+ let pos = stream.stream-position;
+ let char = peek(stream, on-end-of-stream: #f);
+ if (~member?(char, $bullet-chars))
+ let exp-str = concatenate("one of \"", $bullet-chars, "\"");
+ error(make(<parse-failure>, position: pos, expected: exp-str));
+ end if;
+ read-element(stream);
+ as(<string>, char);
+end;
+
+
+define parser-method ascii-line (stream, context)
+=> (token :: <ascii-line-token>)
+ let pos = stream.stream-position;
+ let ascii-line = "";
+ let ascii-char = peek(stream, on-end-of-stream: #f);
+ case
+ context.ascii-line-char & context.ascii-line-char ~= ascii-char =>
+ error(make(<parse-failure>, position: pos,
+ expected: format-to-string("\"%c\"", context.end-quote-char)));
+ member?(ascii-char, $ascii-line-chars) =>
+ ascii-line := read-to(stream, ascii-char, test: \~=, on-end-of-stream: #f);
+ end case;
+ when (ascii-line.size < 3)
+ error(make(<parse-failure>, position: pos,
+ expected: concatenate("several of \"", $ascii-line-chars, "\"")))
+ end when;
+ unless (context.ascii-line-char)
+ context.ascii-line-char := ascii-char;
+ end unless;
+ make(<ascii-line-token>, start: pos, end: stream.stream-position, content: ascii-line)
+end parser-method;
+
+
+define parser-method table-header (stream, context) => (token)
+ error(make(<parse-failure>, position: stream.stream-position,
+ expected: "table header"));
+end;
+
+define parser-method table-row (stream, context) => (token)
+ error(make(<parse-failure>, position: stream.stream-position,
+ expected: "table row"));
+end;
+
+define parser-method table-footer (stream, context) => (token)
+ error(make(<parse-failure>, position: stream.stream-position,
+ expected: "table footer"));
+end;
+
+define parser-method api-ref (stream, context) => (token)
+ error(make(<parse-failure>, position: stream.stream-position,
+ expected: "api reference"));
+end;
Added: trunk/sandbox/dydoc/markup-parser/module.dylan
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/markup-parser/module.dylan Sat May 3 06:24:57 2008
@@ -0,0 +1,43 @@
+module: dylan-user
+synopsis: This module parses Doxygen markup read from a stream.
+
+define module markup-parser
+ use common, exclude: { table };
+ use configs;
+
+ // from peg-parser
+ use peg-parser, export:
+ { <token>, <parse-failure>, parse-expected, failure-position,
+ *parser-trace* };
+
+ // from string-extensions
+ use character-type, exclude: { case-insensitive-equal };
+
+ export
+ parse-markup;
+
+ export
+ <topic-directive-token>, <titled-topic-token>, <footnote-token>,
+ <paragraph-token>, <marginal-code-block-token>,
+ <marginal-verbatim-block-token>, <bullet-list-token>,
+ <numeric-list-token>, <phrase-list-token>, <hyphenated-list-token>,
+ <figure-ref-line-token>, <content-ref-line-token>,
+ <ditto-ref-line-token>, <api-list-ref-line-token>,
+ <bracketed-raw-block-token>, <bullet-list-first-item-token>,
+ <bullet-list-item-token>, <numeric-list-first-item-token>,
+ <numeric-list-item-token>, <hyphenated-list-item-token>,
+ <phrase-list-item-token>, <raw-line-token>, <perc-scale-token>,
+ <mult-scale-token>, <paragraph-directive-token>, <link-directive-token>,
+ <links-directive-token>, <indented-directive-token>, <image-ref-token>,
+ <marker-ref-token>, <bracketed-render-block-token>,
+ <synopsis-ref-token>, <quote-token>, <ascii-line-token>;
+
+ export
+ ascii-line-char, ascii-midline?, ascii-overline?, ascii-underline?,
+ block-type, caption, close-quote, content, directive-type, factor,
+ filename, index, item-label, link, links, list-start, list-type,
+ open-quote, quote-spec, quoted-content, postquoted-content,
+ prequoted-content, scale-factor, topic-nickname, topic-title,
+ topic-type;
+
+end module;
Added: trunk/sandbox/dydoc/markup-parser/parser-helpers.dylan
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/markup-parser/parser-helpers.dylan Sat May 3 06:24:57 2008
@@ -0,0 +1,235 @@
+module: markup-parser
+synopsis: Parser simplification and print-out functions.
+
+
+/// SYNOPSIS: Simplifies bullet-list etc. product.
+define function combined-list-items (items :: <sequence>)
+=> (simplified-items :: <sequence>)
+ let opt-many-items = items[1];
+ if (opt-many-items)
+ // Each element of opt-many-items will be #(#f, item).
+ concatenate(vector(items[0]),
+ map(method (seq-items) seq-items.last end, opt-many-items))
+ else
+ vector(items[0])
+ end if
+end function;
+
+
+/// SYNOPSIS: Integrates the contents of a sequence.
+///
+/// For example, `#[a, #[b, c], #d]` would become `#[a, b, c, d]`.
+define function integrate-sequences (items :: <sequence>)
+=> (integrated-items :: <sequence>)
+ let new-items = make(<deque>);
+ for (item in items)
+ if (instance?(item, <sequence>))
+ new-items := concatenate!(new-items, item);
+ else
+ push-last(new-items, item);
+ end if;
+ end for;
+ new-items
+end function;
+
+
+/// SYNOPSIS: Prepends a line to flush-content etc. product.
+///
+/// In the following example of an argument list section, the line
+/// "Of course..." needs to be prepended to the paragraph following.
+///
+/// [EXAMPLE]
+/// [1]: Of course, the translation here
+/// needs some work. Refer to these sources:
+/// - Pratchett, Terry. "Dwarven Dieties"
+/// [END]
+///
+/// ARGUMENTS:
+/// words - A sequence of markup words, or #f.
+/// body - A <token>, a sequence of <token>s, or #f.
+///
+/// VALUES:
+/// new-body - A sequence of <token>s or #f. The first element of 'new-body'
+/// will have 'words', either merged with the first element of
+/// 'body', or in a separate <paragraph-token> with elements of
+/// 'body' following.
+define generic prepend-words
+ (words :: false-or(<sequence>),
+ body :: false-or(type-union(<sequence>, <token>)))
+=> (new-body);
+
+define method prepend-words (words == #f, body :: false-or(<sequence>))
+=> (new-body :: false-or(<sequence>))
+ body
+end method;
+
+define method prepend-words (words == #f, body :: <token>)
+=> (new-body :: <sequence>)
+ vector(body)
+end method;
+
+define method prepend-words (words :: <sequence>, body == #f)
+=> (new-body :: <sequence>)
+ let para = make(<paragraph-token>, start: #f, end: #f);
+ para.content := words;
+ vector(para)
+end method;
+
+define method prepend-words (words :: <sequence>, body :: <sequence>)
+=> (new-body :: <sequence>)
+ replace-subsequence!(body,
+ prepend-words(words, element(body, 0, default: #f)), start: 0, end: 1)
+end method;
+
+define method prepend-words (words :: <sequence>, body :: <paragraph-token>)
+=> (new-body :: <sequence>)
+ body.content := concatenate(words, body.content);
+ vector(body)
+end method;
+
+define method prepend-words (words :: <sequence>, body :: <token>)
+=> (new-body :: <sequence>)
+ concatenate(prepend-words(words, #f), vector(body))
+end method;
+
+
+//// print-object
+
+define method print-object (o :: <topic-directive-token>, s :: <stream>) => ()
+ format(s, "{topic (%s) %=: %=}",
+ o.topic-type, o.topic-title, o.content)
+end method;
+
+define method print-object (o :: <titled-topic-token>, s :: <stream>) => ()
+ format(s, "{topic %= id %s: %=}",
+ o.topic-title, o.topic-nickname, o.content)
+end method;
+
+/*
+define method print-object (o :: <footnote-token>, s :: <stream>) => ()
+end method;
+*/
+
+define method print-object
+ (o :: type-union(<paragraph-token>, <paragraph-til-null-directive-token>),
+ s :: <stream>)
+=> ()
+ format(s, "{para %=}", o.content)
+end method;
+
+define method print-object (o :: <marginal-code-block-token>, s :: <stream>) => ()
+ format(s, "{code block %=}", o.content)
+end method;
+
+define method print-object (o :: <marginal-verbatim-block-token>, s :: <stream>) => ()
+ format(s, "{verbatim block %=}", o.content)
+end method;
+
+define method print-object (o :: <bullet-list-token>, s :: <stream>) => ()
+ format(s, "{bull list %=}", o.content)
+end method;
+
+define method print-object (o :: <numeric-list-token>, s :: <stream>) => ()
+ format(s, "{num list from %=: %=}", o.list-start, o.content)
+end method;
+
+define method print-object (o :: <phrase-list-token>, s :: <stream>) => ()
+ format(s, "{phrase list: %=}", o.content)
+end method;
+
+define method print-object (o :: <hyphenated-list-token>, s :: <stream>) => ()
+ format(s, "{hyph list: %=}", o.content)
+end method;
+
+/*
+define method print-object (o :: <figure-ref-line-token>, s :: <stream>) => ()
+end method;
+
+define method print-object (o :: <content-ref-line-token>, s :: <stream>) => ()
+end method;
+
+define method print-object (o :: <ditto-ref-line-token>, s :: <stream>) => ()
+end method;
+
+define method print-object (o :: <api-list-ref-line-token>, s :: <stream>) => ()
+end method;
+*/
+
+define method print-object (o :: <bracketed-raw-block-token>, s :: <stream>) => ()
+ format(s, "{[%s] block: %=}", o.block-type, o.content)
+end method;
+
+define method print-object
+ (o :: type-union(<bullet-list-first-item-token>, <bullet-list-item-token>,
+ <numeric-list-first-item-token>, <numeric-list-item-token>),
+ s :: <stream>)
+=> ()
+ format(s, "{item: %=}", o.content)
+end method;
+
+define method print-object
+ (o :: type-union(<hyphenated-list-item-token>, <phrase-list-item-token>),
+ s :: <stream>)
+=> ()
+ format(s, "{item %=: %=}", o.item-label, o.content)
+end method;
+
+define method print-object (o :: <raw-line-token>, s :: <stream>) => ()
+ if (o.index)
+ format(s, "{line #%s %=}", o.index, o.content)
+ else
+ format(s, "{line %=}", o.content)
+ end if
+end method;
+
+/*
+define method print-object (o :: <perc-scale-token>, s :: <stream>) => ()
+end method;
+
+define method print-object (o :: <mult-scale-token>, s :: <stream>) => ()
+end method;
+*/
+
+define method print-object (o :: <paragraph-directive-token>, s :: <stream>) => ()
+ format(s, "{%s %=}", o.directive-type, o.content)
+end method;
+
+define method print-object (o :: <link-directive-token>, s :: <stream>) => ()
+ format(s, "{%s %=}", o.directive-type, o.link)
+end method;
+
+define method print-object (o :: <links-directive-token>, s :: <stream>) => ()
+ format(s, "{%s %=}", o.directive-type, o.links)
+end method;
+
+define method print-object (o :: <indented-directive-token>, s :: <stream>) => ()
+ format(s, "{%s %=}", o.directive-type, o.content)
+end method;
+
+/*
+define method print-object (o :: <image-ref-token>, s :: <stream>) => ()
+end method;
+
+define method print-object (o :: <marker-ref-token>, s :: <stream>) => ()
+end method;
+*/
+
+define method print-object (o :: <bracketed-render-block-token>, s :: <stream>) => ()
+ format(s, "{render %s %=}", o.block-type, o.content)
+end method;
+
+/*
+define method print-object (o :: <synopsis-ref-token>, s :: <stream>) => ()
+end method;
+*/
+
+define method print-object (o :: <quote-token>, s :: <stream>) => ()
+ format(s, "{quote %s%s%s%s%s %s}",
+ o.prequoted-content | "", o.open-quote, o.quoted-content | "",
+ o.close-quote, o.postquoted-content | "", o.quote-spec | "(def)")
+end method;
+
+/*
+define method print-object (o :: <ascii-line-token>, s :: <stream>) => ()
+end method;
+*/
Added: trunk/sandbox/dydoc/markup-parser/rule-tokenizers.dylan
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/markup-parser/rule-tokenizers.dylan Sat May 3 06:24:57 2008
@@ -0,0 +1,975 @@
+module: markup-parser
+
+define parser markup-block
+ rule seq(many(choice(topic, flush-content)), opt-many-spc-or-ls, eos) => tokens;
+ yield integrate-sequences(tokens[0]);
+end;
+
+define parser topic
+ rule choice(topic-directive, titled-topic) => token;
+ yield token;
+end;
+
+// exported
+define parser topic-directive (<token-source>)
+ rule seq(topic-directive-spec, opt(topic-content)) => tokens;
+ slot topic-type :: <symbol> =
+ tokens[0].topic-type;
+ slot topic-title :: <string> =
+ tokens[0].topic-title;
+ slot content :: false-or(<sequence>) =
+ tokens[1];
+end;
+
+// exported
+define parser titled-topic (<token-source>)
+ rule seq(topic-title, opt(topic-content)) => tokens;
+ slot ascii-line-char :: <character> = tokens[0].ascii-line-char;
+ slot ascii-overline? :: <boolean> = tokens[0].ascii-overline?;
+ slot ascii-midline? :: <boolean> = tokens[0].ascii-midline?;
+ slot ascii-underline? :: <boolean> = tokens[0].ascii-underline?;
+ slot topic-title :: <sequence> = tokens[0].topic-title;
+ slot topic-nickname :: false-or(<string>) = tokens[0].topic-nickname;
+ slot content :: false-or(<sequence>) = tokens[1];
+end;
+
+// contents promoted to <topic-directive-token>
+define parser topic-directive-spec ()
+ rule seq(opt(ascii-full-line), sol-ind, opt(ascii-line),
+ topic-directive-spec-text, colon, opt-spaces, text-til-spc-ascii-ls,
+ opt(ascii-line), spc-ls, opt(ascii-full-line))
+ => tokens;
+ slot topic-type :: <symbol> =
+ tokens[3];
+ slot topic-title :: <string> =
+ tokens[6];
+end;
+
+define parser topic-title
+ rule choice(topic-title-midline-style, topic-title-bare-style)
+ => token;
+ yield token;
+cleanup (context)
+ context.ascii-line-char := #f
+end;
+
+// contents promoted to <titled-topic-token>
+define parser topic-title-midline-style ()
+ rule seq(opt(ascii-full-line),
+ choice(seq(opt-many(title-midline-line), title-midline-nickname-line),
+ seq(title-midline-line)),
+ opt(ascii-full-line))
+ => tokens;
+ slot ascii-line-char :: <character> =
+ // last retrieves title-midline-nickname-line or title-midline-line
+ tokens[1].last.ascii-line-char;
+ slot ascii-overline? :: <boolean> = true?(tokens[0]);
+ slot ascii-midline? :: <boolean> = #t;
+ slot ascii-underline? :: <boolean> = true?(tokens[2]);
+ slot topic-title :: <sequence> =
+ begin
+ // tokens[1] will be one of:
+ // #[ #[title-midline-line,...], title-midline-nickname-line ]
+ // #[ #f, title-midline-nickname-line ]
+ // #[ title-midline-line ]
+ // We want contents of each -line (optional for -nickname-line).
+ let flat-lines = integrate-sequences(choose(true?, tokens[1]));
+ apply(concatenate, choose(true?, map(content, flat-lines)))
+ end;
+ slot topic-nickname :: false-or(<string>) =
+ instance?(tokens[1].last, <title-midline-nickname-line-token>) &
+ tokens[1].last.topic-nickname;
+end;
+
+// contents promoted to <titled-topic-token>
+define parser topic-title-bare-style ()
+ rule seq(opt(ascii-full-line),
+ choice(seq(opt-many(title-bare-line), title-bare-nickname-line),
+ seq(title-bare-line)),
+ ascii-full-line)
+ => tokens;
+ slot ascii-line-char :: <character> = tokens[2].content[0];
+ slot ascii-overline? :: <boolean> = true?(tokens[0]);
+ slot ascii-midline? :: <boolean> = #f;
+ slot ascii-underline? :: <boolean> = #t;
+ slot topic-title :: <sequence> =
+ begin
+ // tokens[1] will be one of:
+ // #[ #[title-bare-line,...], title-bare-nickname-line ]
+ // #[ #f, title-bare-nickname-line ]
+ // #[ title-bare-line ]
+ // We want contents of each -line (optional for -nickname-line).
+ let flat-lines = integrate-sequences(choose(true?, tokens[1]));
+ apply(concatenate, choose(true?, map(content, flat-lines)))
+ end;
+ slot topic-nickname :: false-or(<string>) =
+ instance?(tokens[1].last, <title-bare-nickname-line-token>) &
+ tokens[1].last.topic-nickname;
+end;
+
+// contents promoted to <topic-title-midline-style-token>
+define parser title-midline-line ()
+ rule seq(not-next(title-midline-nickname-line),
+ sol-ind, ascii-line, spaces,
+ many(seq(not-next(ascii-line), not-next(spc-ls), title-word, opt-spaces)),
+ opt(ascii-line), spc-ls)
+ => tokens;
+ slot ascii-line-char :: <character> = tokens[2].content[0];
+ slot content :: <sequence> = collect-subelements(tokens[4], 2);
+end;
+
+// contents promoted to <topic-title-bare-style-token>
+define parser title-bare-line ()
+ rule seq(not-next(title-bare-nickname-line),
+ sol-ind, many(seq(not-next(spc-ls), title-word, opt-spaces)), spc-ls)
+ => tokens;
+ slot content :: <sequence> = collect-subelements(tokens[2], 1);
+end;
+
+// contents promoted to <topic-title-midline-style-token>
+define parser title-midline-nickname-line ()
+ rule seq(sol-ind, ascii-line, spaces,
+ opt-many(seq(not-next(ascii-line), not-next(open-bracket), title-word, opt-spaces)),
+ opt-seq(ascii-line, spaces),
+ opn-brack-spc, nickname-word, spc-cls-brack, spc-ls)
+ => tokens;
+ slot ascii-line-char :: <character> =
+ tokens[1].content[0];
+ slot content :: false-or(<sequence>) =
+ tokens[3] & collect-subelements(tokens[3], 2);
+ slot topic-nickname :: <string> =
+ tokens[6];
+end;
+
+// contents promoted to <topic-title-bare-style-token>
+define parser title-bare-nickname-line ()
+ rule seq(sol-ind,
+ opt-many(seq(not-next(open-bracket), title-word, opt-spaces)),
+ opn-brack-spc, nickname-word, spc-cls-brack, spc-ls)
+ => tokens;
+ slot content :: false-or(<sequence>) =
+ tokens[1] & collect-subelements(tokens[1], 1);
+ slot topic-nickname :: <string> =
+ tokens[3];
+end;
+
+define parser topic-content
+ rule many(choice(section-directive, flush-content, footnote))
+ => items;
+ yield integrate-sequences(choose(true?, items));
+end;
+
+// null-directive yields flush-content
+define parser section-directive
+ rule choice(paragraph-directive, link-directive, links-directive,
+ indented-directive, null-directive)
+ => token;
+ yield token;
+end;
+
+// exported
+define parser footnote (<token-source>)
+ rule seq(sol-ind, opn-brack-spc, choice(number, ordinal),
+ choice(seq(spc-cls-brack, colon), seq(colon, spc-cls-brack)),
+ spaces, opt(markup-words), ls, opt(flush-content))
+ => tokens;
+ slot index :: type-union(<integer>, <character>) =
+ tokens[2];
+ slot content :: false-or(<sequence>) =
+ prepend-words(tokens[5], tokens[7]);
+end;
+
+define parser flush-content
+ rule many(flush-content-at-level) => tokens;
+ yield (apply(concatenate, tokens));
+end;
+
+define parser lines-content
+ rule many(line-content)
+ => tokens;
+ yield choose(true?, tokens);
+end;
+
+// #"blank-lines" counts as #f
+define parser line-content :: false-or(<token>)
+ rule seq(not-next(eos), not-next(topic-directive-spec), not-next(topic-title),
+ not-next(section-directive), not-next(footnote),
+ choice(blank-lines, marginal-code-block, marginal-verbatim-block,
+ figure-ref-line, content-ref-line, ditto-ref-line,
+ api-list-ref-line, bracketed-raw-block, table,
+ bullet-list, numeric-list, hyphenated-list, phrase-list,
+ paragraph))
+ => tokens;
+ yield (tokens[5] ~= #"blank-lines") & tokens[5];
+end;
+
+// exported -- contents are those of paragraph-line tokens combined
+define parser paragraph (<token-source>)
+ rule many(paragraph-line)
+ => items;
+ slot content :: <sequence> =
+ apply(concatenate, items);
+end;
+
+// exported as paragraph -- contents are those of paragraph-line tokens combined
+define parser paragraph-til-null-directive (<paragraph-token>)
+ rule many(seq(not-next(null-directive-spec), paragraph-line))
+ => items;
+ inherited slot content /* :: <sequence> */ =
+ apply(concatenate, collect-subelements(items, 1));
+end;
+
+// only used for look-ahead
+define parser bracketed-line
+ rule seq(req-next(open-bracket),
+ choice(figure-ref-line, content-ref-line, ditto-ref-line,
+ api-list-ref-line, bracketed-raw-block-start-line))
+end;
+
+// exported
+define parser marginal-code-block (<token-source>)
+ rule many(marginal-code-block-line) => lines;
+ slot content :: <sequence> = lines;
+end;
+
+// exported
+define parser marginal-verbatim-block (<token-source>)
+ rule many(marginal-verbatim-block-line) => lines;
+ slot content :: <sequence> = lines;
+end;
+
+// exported -- content is sequence of items
+define parser bullet-list (<token-source>)
+ rule seq(bullet-list-first-item, opt-many(seq(opt(blank-lines), bullet-list-item)))
+ => items;
+ slot content :: <sequence> = combined-list-items(items);
+afterwards (context, tokens)
+ pop(context.list-stack);
+end;
+
+// exported -- content is sequence of items
+define parser numeric-list (<token-source>)
+ rule seq(numeric-list-first-item, opt-many(seq(opt(blank-lines), numeric-list-item)))
+ => items;
+ slot list-start :: type-union(<integer>, <character>) =
+ items[0].ordinal;
+ slot content :: <sequence> =
+ combined-list-items(items);
+afterwards (context, tokens)
+ pop(context.list-stack);
+end;
+
+// exported -- content is sequence of items
+define parser phrase-list (<token-source>)
+ rule seq(phrase-list-item, opt-many(seq(opt(blank-lines), phrase-list-item)))
+ => items;
+ slot content :: <sequence> = combined-list-items(items);
+end;
+
+// exported -- content is sequence of items
+define parser hyphenated-list (<token-source>)
+ rule seq(hyphenated-list-item, opt-many(seq(opt(blank-lines), hyphenated-list-item)))
+ => items;
+ slot content :: <sequence> = combined-list-items(items);
+end;
+
+define parser table
+ rule seq(table-header, opt-many(table-row), table-footer)
+end;
+
+// exported
+define parser figure-ref-line (<token-source>)
+ rule seq(sol-ind, opn-brack-spc, fig-lit, many-spc-or-ls, filename,
+ opt-seq(many-spc-or-ls, choice(perc-scale, mult-scale)),
+ spc-cls-brack, opt(text-til-spc-ls), spc-ls)
+ => tokens;
+ slot filename :: <string> =
+ tokens[4];
+ slot scale-factor :: false-or(type-union(<perc-scale-token>, <mult-scale-token>)) =
+ tokens[5] & tokens[5][1];
+ slot caption :: false-or(<string>) =
+ tokens[7];
+end;
+
+// exported -- link can be false if referring to sub-topics of current topic
+define parser content-ref-line (<token-source>)
+ rule seq(sol-ind, opn-brack-spc, contents-lit,
+ opt-seq(many-spc-or-ls, of-lit, many-spc-or-ls,
+ link-til-end-brack),
+ spc-cls-brack, spc-ls)
+ => tokens;
+ slot link :: false-or(<string>) = tokens[3] & tokens[3][3];
+end;
+
+// exported
+define parser ditto-ref-line (<token-source>)
+ rule seq(sol-ind, opn-brack-spc, ditto-lit, many-spc-or-ls,
+ link-til-end-brack, spc-cls-brack, spc-ls)
+ => tokens;
+ slot link :: <string> = tokens[4];
+end;
+
+// exported
+define parser api-list-ref-line (<token-source>)
+ rule seq(sol-ind, opn-brack-spc, list-lit, many-spc-or-ls, of-lit,
+ many-spc-or-ls, api-list-spec-text, spc-cls-brack, spc-ls)
+ => tokens;
+ slot list-type :: <symbol> = tokens[6];
+end;
+
+// exported
+define parser bracketed-raw-block (<token-source>)
+ rule seq(bracketed-raw-block-start-line,
+ opt-many(seq(sol-ind, not-next(bracketed-raw-block-end-line),
+ raw-line)),
+ bracketed-raw-block-end-line)
+ => tokens;
+ slot block-type :: <symbol> =
+ tokens[0];
+ slot content :: false-or(<sequence>) =
+ tokens[1] & collect-subelements(tokens[1], 2);
+cleanup (context)
+ context.end-bracket-spec := #f
+end;
+
+define parser blank-lines
+ rule many(seq(sol, spc-ls))
+end;
+
+// exported
+define parser bullet-list-first-item (<token-source>)
+ rule seq(bullet-list-line, opt(indented-content)) => tokens;
+ slot content :: <sequence> =
+ prepend-words(tokens[0].content, tokens[1]);
+afterwards (context, tokens)
+ push(context.list-stack, tokens[0].bullet);
+end;
+
+// exported
+define parser bullet-list-item (<token-source>)
+ rule seq(bullet-list-line, opt(indented-content)) => tokens;
+ slot content :: <sequence> =
+ prepend-words(tokens[0].content, tokens[1]);
+afterwards (context, tokens)
+ unless (tokens[0].bullet = context.list-stack.first)
+ error(make(<parse-failure>, expected:
+ format-to-string("bullet \"%s\"", context.list-stack.first)))
+ end unless;
+end;
+
+// exported
+define parser numeric-list-first-item (<token-source>)
+ rule seq(numeric-list-first-line, opt(indented-content)) => tokens;
+ slot ordinal :: type-union(<integer>, <character>) =
+ tokens[0].ordinal;
+ slot content :: <sequence> =
+ prepend-words(tokens[0].content, tokens[1]);
+afterwards (context, tokens)
+ let ord-type =
+ if (instance?(tokens[0].ordinal, <integer>)) #"number" else #"alpha" end;
+ let list-pair = pair(ord-type, tokens[0].separator);
+ push(context.list-stack, list-pair);
+end;
+
+// exported
+define parser numeric-list-item (<token-source>)
+ rule seq(numeric-list-line, opt(indented-content)) => tokens;
+ slot content :: <sequence> =
+ prepend-words(tokens[0].content, tokens[1]);
+afterwards (context, tokens)
+ let list-pair = pair(tokens[0].ordinal-type, tokens[0].separator);
+ let stack-pair = context.list-stack.first;
+ let type-matches? =
+ list-pair.head = #"hash" | (list-pair.head = stack-pair.head);
+ let sep-matches? = (list-pair.tail = stack-pair.tail);
+ unless (type-matches? & sep-matches?)
+ error(make(<parse-failure>, expected: format-to-string("%s or hash followed by %s",
+ as(<string>, stack-pair.head), as(<string>, stack-pair.tail))))
+ end unless;
+end;
+
+// exported
+define parser hyphenated-list-item (<token-source>)
+ rule seq(hyphenated-list-line, opt(indented-content)) => tokens;
+ slot item-label :: <sequence> =
+ tokens[0].item-label;
+ slot content :: <sequence> =
+ prepend-words(tokens[0].content, tokens[1]);
+end;
+
+// exported
+define parser phrase-list-item (<token-source>)
+ rule seq(phrase-list-label, indented-content) => tokens;
+ slot item-label :: <sequence> =
+ tokens[0];
+ slot content :: <sequence> =
+ tokens[1];
+end;
+
+define parser paragraph-line
+ rule seq(not-next(blank-lines), not-next(bracketed-line),
+ not-next(marginal-code-block-line),
+ not-next(marginal-verbatim-block-line), not-next(bullet-list-line),
+ not-next(numeric-list-first-line), not-next(hyphenated-list-line),
+ sol-ind, markup-words, spc-ls)
+ => tokens;
+ yield tokens[8];
+end;
+
+define parser paragraph-line-til-hyphen-spc-ls
+ rule seq(not-next(blank-lines), not-next(bracketed-line),
+ not-next(marginal-code-block-line),
+ not-next(marginal-verbatim-block-line), not-next(bullet-list-line),
+ not-next(numeric-list-first-line), not-next(hyphenated-list-line),
+ sol-ind,
+ many(seq(not-next(seq(hyphen, spc-ls)), markup-word, spaces)),
+ choice(req-next(hyphen), ls))
+ => tokens;
+ yield collect-subelements(tokens[8], 1);
+end;
+
+define parser bracketed-raw-block-start-line
+ rule seq(sol-ind, opn-brack-spc, bracketed-raw-block-spec-text,
+ spc-cls-brack, spc-ls)
+ => tokens;
+ yield tokens[2];
+afterwards (context, tokens)
+ context.end-bracket-spec := tokens[2]
+end;
+
+define parser bracketed-raw-block-end-line
+ rule seq(sol-ind, opn-brack-spc, end-lit,
+ opt-seq(many(spc-or-ls), bracketed-raw-block-spec-text),
+ spc-cls-brack, spc-ls);
+afterwards (context, tokens)
+ when (tokens[3] & tokens[3][1] ~= context.end-bracket-spec)
+ error(make(<parse-failure>, expected:
+ format-to-string("\"%s\"", context.end-bracket-spec)))
+ end when
+end;
+
+define parser marginal-code-block-line
+ rule seq(sol-ind, colon, spc, raw-line) => tokens;
+ yield tokens[3];
+end;
+
+define parser marginal-verbatim-block-line
+ rule seq(sol-ind, choice(gt, bar), spc, raw-line) => tokens;
+ yield tokens[3];
+end;
+
+// contents promoted to <bullet-list-item> or <bullet-list-first-item>
+define parser bullet-list-line ()
+ rule seq(sol-ind, bullet-char, spaces, markup-words, ls)
+ => tokens;
+ slot bullet :: <string> = tokens[1];
+ slot content :: <sequence> = tokens[3];
+end;
+
+// contents promoted to <numeric-list-first-item>
+define parser numeric-list-first-line ()
+ rule seq(sol-ind, choice(number, ordinal), choice(colon, right-paren, period),
+ spaces, markup-words, ls)
+ => tokens;
+ slot ordinal :: type-union(<integer>, <character>) =
+ tokens[1];
+ slot separator :: <symbol> =
+ tokens[2];
+ slot content :: <sequence> =
+ tokens[4];
+end;
+
+// contents promoted to <numeric-list-item>
+define parser numeric-list-line ()
+ rule seq(sol-ind, choice(number, ordinal, hash), choice(colon, right-paren, period),
+ spaces, markup-words, ls)
+ => tokens;
+ slot ordinal-type :: <symbol> =
+ select (tokens[1] by instance?)
+ <integer> => #"number";
+ <character> => #"alpha";
+ <symbol> => #"hash";
+ end select;
+ slot separator :: <symbol> =
+ tokens[2];
+ slot content :: <sequence> =
+ tokens[4];
+end;
+
+// contents promoted to <hyphenated-list-item>
+define parser hyphenated-list-line ()
+ rule seq(sol-ind, markup-word, spaces, hyphen, spaces, markup-words, ls)
+ => tokens;
+ slot item-label :: <sequence> =
+ tokens[1];
+ slot content :: <sequence> =
+ tokens[5];
+end;
+
+define parser phrase-list-label
+ rule seq(not-next(topic-directive-spec), not-next(topic-title),
+ not-next(section-directive), not-next(footnote),
+ many(paragraph-line-til-hyphen-spc-ls), hyphen, spc-ls)
+ => tokens;
+ yield tokens[4];
+end;
+
+// exported
+define parser raw-line (<token-source>)
+ rule seq(opt-many(seq(not-next(raw-line-end), char)), raw-line-end)
+ => tokens;
+ slot content :: <string> =
+ begin
+ let first-part =
+ if (tokens[0])
+ map-as(<string>, method (seq-items) seq-items.last end, tokens[0]);
+ else
+ ""
+ end if;
+ concatenate(first-part, tokens[1].content)
+ end;
+ slot index :: false-or(type-union(<integer>, <character>)) =
+ tokens[1].index;
+end;
+
+// content promoted to <raw-line-token> -- includes literal string representation
+define parser raw-line-end ()
+ rule seq(opt(line-marker), spc-ls) => tokens;
+ slot content :: <string> =
+ (tokens[0] & tokens[0].content) | "";
+ slot index :: false-or(type-union(<integer>, <character>)) =
+ tokens[0] & tokens[0].index
+end;
+
+// content promoted to <raw-line-end-token> -- includes literal string representation
+define parser line-marker ()
+ rule seq(open-bracket, colon, choice(number, ordinal), close-bracket)
+ => tokens;
+ slot content :: <string> =
+ format-to-string("[:%s]", tokens[2]);
+ slot index :: type-union(<integer>, <character>) =
+ tokens[2];
+end;
+
+// exported
+define parser perc-scale (<token-source>)
+ rule seq(number, percent) => tokens;
+ slot factor :: <integer> = tokens[0];
+end;
+
+// exported
+define parser mult-scale (<token-source>)
+ rule seq(number, x-lit) => tokens;
+ slot factor :: <integer> = tokens[0];
+end;
+
+// exported
+define parser paragraph-directive (<token-source>)
+ rule seq(paragraph-directive-spec, opt(markup-words), spc-ls,
+ opt(paragraph-til-null-directive))
+ => tokens;
+ slot directive-type :: <symbol> =
+ tokens[0];
+ slot content :: false-or(<paragraph-token>) =
+ begin
+ let body = prepend-words(tokens[1], tokens[3]);
+ body & body.first
+ end;
+end;
+
+// exported
+define parser link-directive (<token-source>)
+ rule seq(link-directive-spec, link-til-spc-ls, spc-ls) => tokens;
+ slot directive-type :: <symbol> = tokens[0];
+ slot link :: <string> = tokens[1];
+end;
+
+// exported
+define parser links-directive (<token-source>)
+ rule seq(links-directive-spec, opt-many(link-words), spc-ls,
+ opt(indented-link-words))
+ => tokens;
+ slot directive-type :: <symbol> =
+ tokens[0];
+ slot links :: <sequence> =
+ concatenate(tokens[1], tokens[3]);
+end;
+
+// exported
+define parser indented-directive (<token-source>)
+ rule seq(indented-directive-spec, opt(markup-words), spc-ls,
+ opt(indented-content))
+ => tokens;
+ slot directive-type :: <symbol> =
+ tokens[0];
+ slot content :: false-or(<sequence>) =
+ prepend-words(tokens[1], tokens[3]);
+end;
+
+define parser null-directive
+ rule seq(null-directive-spec, opt(markup-words), spc-ls,
+ opt(flush-content))
+ => tokens;
+ yield prepend-words(tokens[1], tokens[3]);
+end;
+
+define parser paragraph-directive-spec
+ rule seq(opt(ascii-full-line), sol-ind, opt-seq(ascii-line, spaces),
+ paragraph-directive-spec-text, colon, opt-spaces,
+ opt-seq(ascii-line, spaces), opt-seq(ls, ascii-full-line))
+ => tokens;
+ yield tokens[3];
+cleanup (context)
+ context.ascii-line-char := #f
+end;
+
+define parser link-directive-spec
+ rule seq(opt(ascii-full-line), sol-ind, opt-seq(ascii-line, spaces),
+ link-directive-spec-text, colon, opt-spaces,
+ opt-seq(ascii-line, spaces), opt-seq(ls, ascii-full-line))
+ => tokens;
+ yield tokens[3];
+cleanup (context)
+ context.ascii-line-char := #f
+end;
+
+define parser links-directive-spec
+ rule seq(opt(ascii-full-line), sol-ind, opt-seq(ascii-line, spaces),
+ links-directive-spec-text, colon, opt-spaces,
+ opt-seq(ascii-line, spaces), opt-seq(ls, ascii-full-line))
+ => tokens;
+ yield tokens[3];
+cleanup (context)
+ context.ascii-line-char := #f
+end;
+
+define parser indented-directive-spec
+ rule seq(opt(ascii-full-line), sol-ind, opt-seq(ascii-line, spaces),
+ indented-directive-spec-text, colon, opt-spaces,
+ opt-seq(ascii-line, spaces), opt-seq(ls, ascii-full-line))
+ => tokens;
+ yield tokens[3];
+cleanup (context)
+ context.ascii-line-char := #f
+end;
+
+define parser null-directive-spec
+ rule seq(opt(ascii-full-line), sol-ind, opt-seq(ascii-line, spaces),
+ null-directive-spec-text, colon, opt-spaces,
+ opt-seq(ascii-line, spaces), opt-seq(ls, ascii-full-line));
+cleanup (context)
+ context.ascii-line-char := #f
+end;
+
+define parser title-words
+ rule many(seq(opt-spaces, opt-seq(ls, sol, opt-spaces, not-next(ls)),
+ not-next(open-bracket), not-next(ascii-line), title-word))
+ => items;
+ yield collect-subelements(items, 4);
+end;
+
+define parser markup-words
+ rule many(seq(markup-word, opt-spaces)) => items;
+ yield collect-subelements(items, 0);
+end;
+
+define parser title-word
+ rule choice(image-ref, quote, bracketed-render-block, text-til-spc-or-ls)
+ => token;
+ yield token;
+end;
+
+define parser markup-word
+ rule choice(title-word, api-ref, marker-ref, synopsis-ref)
+ => token;
+ yield token;
+end;
+
+define parser ascii-full-line
+ rule seq(sol-ind, ascii-line, spc-ls) => tokens;
+ yield tokens[1];
+end;
+
+// exported
+define parser image-ref (<token-source>)
+ rule seq(opn-brack-spc, img-lit, many-spc-or-ls, filename,
+ opt-seq(many-spc-or-ls, text-til-spc-cls-brack), spc-cls-brack)
+ => tokens;
+ slot filename :: <string> = tokens[3];
+ slot caption :: false-or(<string>) = tokens[4] & tokens[4][1];
+end;
+
+// exported
+define parser marker-ref (<token-source>)
+ rule seq(opn-brack-spc, choice(number, ordinal), spc-cls-brack) => tokens;
+ slot index :: type-union(<integer>, <character>) = tokens[1];
+end;
+
+// exported
+define parser bracketed-render-block (<token-source>)
+ rule seq(bracketed-render-block-start,
+ opt-many(seq(not-next(bracketed-render-block-end), char)),
+ bracketed-render-block-end)
+ => tokens;
+ slot block-type :: <symbol> =
+ tokens[0];
+ slot content :: <string> =
+ tokens[1] & map-as(<string>, method (seq-items) seq-items.last end, tokens[1]);
+cleanup (context)
+ context.end-bracket-spec := #f
+end;
+
+define parser bracketed-render-block-start
+ rule seq(opn-brack-spc, bracketed-render-block-spec-text, spc-cls-brack)
+ => tokens;
+ yield tokens[1];
+afterwards (context, tokens)
+ context.end-bracket-spec := tokens[1]
+end;
+
+define parser bracketed-render-block-end
+ rule seq(opn-brack-spc, end-lit,
+ opt-seq(many(spc-or-ls), bracketed-render-block-spec-text),
+ spc-cls-brack);
+afterwards (context, tokens)
+ when (tokens[2] & tokens[2][1] ~= context.end-bracket-spec)
+ error(make(<parse-failure>, expected:
+ format-to-string("\"%s\"", context.end-bracket-spec)))
+ end when
+end;
+
+// exported
+define parser synopsis-ref (<token-source>)
+ rule seq(opn-brack-spc, synopsis-lit, many-spc-or-ls, of-lit,
+ many-spc-or-ls, link-til-end-brack, spc-cls-brack)
+ => tokens;
+ slot link :: <string> = tokens[5];
+end;
+
+define parser topic-directive-spec-text
+ rule choice(function-lit, variable-lit, seq(generic-lit, spaces, function-lit),
+ library-lit, module-lit, class-lit, macro-lit)
+ => token;
+ yield (instance?(token, <symbol>) & token) | #"generic-function";
+end;
+
+define parser paragraph-directive-spec-text
+ rule choice(synopsis-lit, syn-lit) => token;
+ yield
+ select (token)
+ #"synopsis", #"syn" => #"synopsis";
+ end select;
+end;
+
+define parser link-directive-spec-text
+ rule section-lit => token;
+ yield token;
+end;
+
+define parser links-directive-spec-text
+ rule choice(seq(relevant-lit, spaces, to-lit),
+ seq(see-lit, spaces, also-lit))
+ => token;
+ yield
+ select (token[0])
+ #"relevant" => #"relevant-to";
+ #"see" => #"see-also";
+ end select;
+end;
+
+define parser indented-directive-spec-text
+ rule choice(init-keywords-lit, conditions-lit, exceptions-lit, arguments-lit,
+ keywords-lit, signals-lit, warning-lit, errors-lit, values-lit,
+ args-lit, seq(make-lit, spaces, keywords-lit), note-lit)
+ => token;
+ yield
+ select (token)
+ #"arguments", #"args" => #"arguments";
+ #"values" => #"values";
+ #"note" => #"note";
+ #"warning" => #"warning";
+ #"conditions", #"signals", #"errors", #"exceptions" => #"conditions";
+ otherwise => #"keywords";
+ end select;
+end;
+
+define parser null-directive-spec-text
+ rule discussion-lit;
+end;
+
+define parser api-list-spec-text
+ rule choice(functions-lit, libraries-lit, variables-lit, bindings-lit,
+ classes-lit, modules-lit, macros-lit) => token;
+ yield token;
+end;
+
+define parser bracketed-raw-block-spec-text
+ rule choice(verbatim-lit, diagram-lit, example-lit, code-lit) => token;
+ yield token;
+end;
+
+define parser bracketed-render-block-spec-text
+ rule choice(dita-lit, html-lit) => token;
+ yield token;
+end;
+
+// yields a list of link-word elements
+define parser link-word-lines
+ rule many(seq(sol-ind, link-words, spc-ls))
+ => tokens;
+ yield collect-subelements(tokens, 2);
+end;
+
+// yields a list of link-word elements
+define parser link-words
+ rule seq(link-word, opt-many(seq(spaces, link-word)))
+ => tokens;
+ yield
+ begin
+ let first-items = vector(tokens[0]);
+ let many-items = tokens[1];
+ if (many-items)
+ apply(concatenate, first-items,
+ map(method (seq-items) seq-items.last end, many-items))
+ else
+ first-items
+ end if;
+ end;
+end;
+
+define parser link-word
+ rule choice(seq(start-quote, text-til-end-quote, end-quote), text-til-spc-or-ls)
+ => token;
+ yield (instance?(token, <string>) & token) | token[1];
+end;
+
+define parser link-til-spc-ls
+ rule text-til-spc-ls => token;
+ yield token;
+end;
+
+define parser link-til-end-brack
+ rule text-til-spc-cls-brack => token;
+ yield token;
+end;
+
+define parser filename
+ rule seq(start-quote, text-til-end-quote, end-quote) => tokens;
+ yield tokens[1];
+end;
+
+define parser nickname-word
+ rule many(seq(not-next(spc), not-next(close-bracket), char)) => items;
+ yield map-as(<string>, method (seq-items) seq-items.last end, items);
+end;
+
+// exported
+define parser quote (<token-source>)
+ rule seq(quoted-words, opt-seq(many-spc-or-ls, quote-spec))
+ => tokens;
+ slot prequoted-content :: false-or(<string>) =
+ tokens[0].prequoted-content;
+ slot open-quote :: <string> =
+ tokens[0].open-quote;
+ slot quoted-content :: false-or(<string>) =
+ tokens[0].quoted-content;
+ slot close-quote :: <string> =
+ tokens[0].close-quote;
+ slot postquoted-content :: false-or(<string>) =
+ tokens[0].postquoted-content;
+ slot quote-spec :: false-or(<sequence>) =
+ tokens[1] & tokens[1][1];
+end;
+
+// content promoted to <quote-token>
+define parser quoted-words ()
+ rule seq(opt-many(choice(left-paren, open-bracket, left-brace, lt)),
+ start-quote, opt(text-til-end-quote), end-quote,
+ opt(text-til-spc-or-ls))
+ => tokens;
+ slot prequoted-content :: false-or(<string>) =
+ tokens[0] & apply(concatenate,
+ map(method (sym) as(<string>, sym) end, tokens[0]));
+ slot open-quote :: <string> =
+ tokens[1];
+ slot quoted-content :: false-or(<string>) =
+ tokens[2];
+ slot close-quote :: <string> =
+ tokens[3];
+ slot postquoted-content :: false-or(<string>) =
+ tokens[4];
+end;
+
+define parser quote-spec
+ rule seq(opn-brack-spc, opt-many(seq(quote-spec-option, opt-many-spc-or-ls)),
+ opt(quote-spec-link-option), spc-cls-brack)
+ => tokens;
+ // tokens[1] will be false-or( #( #(option, #f), ...))
+ yield
+ begin
+ let simple-options = collect-subelements(tokens[1], 0);
+ let link-options = (tokens[2] & vector(tokens[2].option, tokens[2].link)) | #();
+ concatenate(simple-options, link-options)
+ end;
+end;
+
+define parser quote-spec-option
+ rule choice(code-lit, term-lit, bib-lit, sic-lit, toc-lit, unq-lit,
+ em-lit, qq-lit, qv-lit, b-lit, i-lit, u-lit, q-lit)
+ => token;
+ yield token;
+end;
+
+// content promoted to quote spec list
+define parser quote-spec-link-option ()
+ rule seq(choice(toc-lit, qv-lit), many-spc-or-ls, text-til-spc-cls-brack)
+ => tokens;
+ slot option = tokens[0];
+ slot link = tokens[2];
+end;
+
+define parser text-til-spc-ls
+ rule many(seq(not-next(spc-ls), char)) => items;
+ yield map-as(<string>, method (seq-items) seq-items.last end, items);
+end;
+
+define parser text-til-spc-ascii-ls
+ rule many(text-til-spc-ascii-ls-3) => items;
+ // yield map-as(<string>, method (seq-items) seq-items.last end, items);
+ yield concatenate-as(<string>, items);
+end;
+
+define parser text-til-spc-ascii-ls-3
+ rule seq(text-til-spc-ascii-ls-2, char) => items;
+ yield items[1];
+end;
+
+define parser text-til-spc-ascii-ls-2
+ rule not-next(text-til-spc-ascii-ls-1);
+end;
+
+define parser text-til-spc-ascii-ls-1
+ rule seq(opt-spaces, choice(ls, ascii-line, spc-ls));
+end;
+
+define parser text-til-spc-cls-brack
+ rule many(seq(not-next(spc-cls-brack), char)) => items;
+ yield map-as(<string>, method (seq-items) seq-items.last end, items);
+end;
+
+define parser text-til-end
+ rule many(seq(not-next(seq(opn-brack-spc, end-lit)), char)) => items;
+ yield map-as(<string>, method (seq-items) seq-items.last end, items);
+end;
+
+define parser opn-brack-spc
+ rule seq(open-bracket, opt-many-spc-or-ls)
+end;
+
+define parser spc-cls-brack
+ rule seq(opt-many-spc-or-ls, close-bracket)
+end;
+
+define parser spc-ls
+ rule seq(opt-spaces, ls)
+end;
Added: trunk/sandbox/dydoc/markup-translator/check-helpers.dylan
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/markup-translator/check-helpers.dylan Sat May 3 06:24:57 2008
@@ -0,0 +1,152 @@
+module: markup-translator
+synopsis: Code to integrate sections and intermediate objects into the greater whole.
+
+
+/// Synopsis: References to markers that have yet to be assigned. Scope limited
+/// to a file/comment block.
+/// Discussion: This table contains actual <ph-marker> instances, but their
+/// owners are not defined. When the marker is placed, it is not made anew, but
+/// rather retrieved from this table and its owner set.
+define constant $block-markers = make(<object-table>);
+
+
+/// IDs can have any character except space, "/", "[", "]".
+define inline method check-topic-id (id :: <string>) => ()
+ when (member?(' ', id) | member?('/', id) | member?('[', id) | member?(']', id))
+ error("Topic or section tag cannot have space, slash, open bracket, or "
+ "close bracket characters.");
+ end when;
+ when (id.first = ':')
+ error("Topic or section tag cannot have leading colon.")
+ end when;
+end method;
+
+
+/// Titles (in string form) cannot have leading colon. I say string form,
+/// because that is the one used in links, and this restriction is to avoid
+/// ambuiguous links.
+define inline method check-topic-title (title :: <title>) => ()
+ when (title.stringify-title.first = ':')
+ error("Title cannot have leading colon.")
+ end when;
+end method;
+
+
+/// Synopsis: There can only be one Synopsis section in a topic. This method
+/// is used to check within a single topic; this is also checked across multiple
+/// topics when merging [TODO].
+define inline method check-no-shortdesc (topic :: <topic>) => ()
+ when (slot-initialized?(topic, shortdesc))
+ error("Only one synopsis in a topic.")
+ end when;
+end method;
+
+
+define method check-quote-specifiers
+ (quote :: <quote-token>, default-specs :: <table>, #key for-title) => ()
+ let specs = remove-duplicates(
+ if (quote.quote-spec.empty?)
+ default-specs[quote.open-quote]
+ else
+ quote.quote-spec
+ end if);
+
+ when (member?(#"q", specs) & member?(#"qq", specs))
+ error("Can't have both q and qq specifiers.")
+ end when;
+
+ // Titles cannot have links. This excludes qv, toc. Can have code if we don't
+ // link to APIs. In DITA, they cannot have <cite>, but we can fake that.
+ when (for-title & (member?(#"qv", specs) | member?(#"toc", specs)))
+ error("Titles can't have qv or toc specifiers.")
+ end when;
+
+ // A quote can basically be a qv/toc, bib, or term. Former trumps latter.
+ when (member?(#"qv", specs) | member?(#"toc", specs))
+ specs := remove!(specs, #"bib");
+ specs := remove!(specs, #"term");
+ end when;
+ when (member?(#"bib", specs))
+ specs := remove!(specs, #"term");
+ end when;
+end method;
+
+
+//
+// Sections allowed in topics
+//
+
+
+define method check-allowed-sections (section :: <section-token>, topic :: <topic>)
+=> ()
+ when (~allowed-markup-section?(section, topic))
+ error("Topic cannot have %s sections.", section.directive-type)
+ end when;
+end method;
+
+
+/// Synopsis: Determine if a given section directive is valid for a topic.
+define generic allowed-markup-section?
+ (section :: <section-token>, topic :: <topic>)
+=> (okay? :: <boolean>);
+
+define method allowed-markup-section?
+ (section :: <section-token>, topic :: <topic>)
+=> (okay? :: <boolean>)
+ member?(section.directive-type, #[ #"synopsis", #"note", #"warning" ])
+end method;
+
+define method allowed-markup-section?
+ (section :: <section-token>, topic :: <class-doc>)
+=> (okay? :: <boolean>)
+ (section.directive-type = #"keywords") | next-method()
+end method;
+
+define method allowed-markup-section?
+ (section :: <section-token>, topic :: <function-doc>)
+=> (okay? :: <boolean>)
+ member?(section.directive-type, #[ #"arguments", #"values", #"conditions" ])
+ | next-method()
+end method;
+
+define method allowed-markup-section?
+ (section :: <section-token>, topic :: <macro-doc>)
+=> (okay? :: <boolean>)
+ member?(section.directive-type, #[ #"arguments", #"values" ]) | next-method()
+end method;
+
+
+//
+// Classification of topic tokens into <topic> or <section>
+//
+
+
+define method non-section-topic? (token :: <token>)
+=> (non-section-topic? :: <boolean>)
+ #f
+end method;
+
+define method non-section-topic? (token :: <topic-directive-token>)
+=> (non-section-topic? :: <boolean>)
+ #t
+end method;
+
+define method non-section-topic? (token :: <titled-topic-token>)
+=> (non-section-topic? :: <boolean>)
+ let style = make(<topic-level-style>, char: token.ascii-line-char,
+ under: token.ascii-underline?, mid: token.ascii-midline?,
+ over: token.ascii-overline?);
+ style ~= $section-style
+end method;
+
+
+//
+//
+//
+
+
+define method ensure-marker (index :: type-union(<character>, <integer>))
+=> (marker :: <ph-marker>)
+ element($block-markers, index, default: #f) |
+ ($block-markers[index] := make(<ph-marker>, index: index))
+end method;
Added: trunk/sandbox/dydoc/markup-translator/module.dylan
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/markup-translator/module.dylan Sat May 3 06:24:57 2008
@@ -0,0 +1,19 @@
+module: dylan-user
+synopsis: This module converts from tokens to intermediate markup (the DITA-style
+ markup used internally).
+
+define module markup-translator
+ use common;
+ use markup-parser, rename: { content => token-content };
+ use internal-rep;
+ use ordered-tree;
+ use configs;
+
+ // from collection-extensions
+ use sequence-utilities, import: { partition };
+ // from system
+ use locators, import: { <url> };
+
+ export
+ process-markup;
+end module;
Added: trunk/sandbox/dydoc/markup-translator/token-processing.dylan
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/markup-translator/token-processing.dylan Sat May 3 06:24:57 2008
@@ -0,0 +1,334 @@
+module: markup-translator
+synopsis: These functions take tokens from the markup-parser module and turn
+ them into the higher-level representations of this module.
+
+
+/// Synopsis: An umbrella type.
+define constant <topic-token> =
+ type-union(<topic-directive-token>, <titled-topic-token>);
+
+/// [ditto <topic-token>]
+define constant <section-token> =
+ type-union(<paragraph-directive-token>, <indented-directive-token>);
+
+
+/// Synopsis: Returns <topic>s from a markup block.
+define method process-markup
+ (tokens :: <sequence>, context-topic :: false-or(<topic>))
+=> (result :: <sequence>)
+ block ()
+ let (topics, bare-content) = partition(non-section-topic?, tokens);
+
+ // Put bare content into context topic.
+ when (~bare-content.empty?)
+ when (~context-topic)
+ error(make(<simple-warning>, format-string:
+ "Please provide a topic; no implicit topic found for this location."))
+ end when;
+ process-tokens(context-topic, bare-content);
+ end when;
+
+ concatenate(if (context-topic) vector(context-topic) else #() end,
+ map(make-topic-from-token, topics));
+ cleanup
+ $block-markers.remove-all-keys!
+ end block;
+end method;
+
+
+/// Synopsis: Generate a topic from a topic token.
+define generic make-topic-from-token (token :: <topic-token>)
+=> (topic :: <topic>);
+
+
+define method make-topic-from-token (token :: <topic-directive-token>)
+=> (topic :: <api-doc>)
+ let topic = make(<api-doc>, topic-type: token.topic-type);
+
+ // token.topic-title is a simple string, but topic.title is a <title>.
+ // Make a <title> for token.topic-title. topic.id is specified in automatic
+ // topic created by scanning API.
+ topic.title := make(<title>, owner: topic);
+ push-last(topic.title.content, token.topic-title);
+ topic.id := #f;
+ process-tokens(topic, token.token-content);
+
+ check-topic-title(topic.title);
+ check-topic-id(topic.id);
+ topic
+end method;
+
+
+define method make-topic-from-token (token :: <titled-topic-token>)
+=> (topic :: <con-topic>)
+ // TODO: Topic fixed-parent needs to be computed. Where? Add level style to <topic>?
+ let topic = make(<con-topic>);
+ topic.title := make(<title>, owner: topic);
+ process-tokens(topic.title, token.topic-title);
+ topic.id := token.topic-nickname;
+ process-tokens(topic, token.token-content);
+
+ check-topic-title(topic.title);
+ check-topic-id(topic.id);
+ topic
+end method;
+
+
+/// Synopsis: Add a token into an intermediate object, merging if necessary.
+/// Arguments:
+/// owner - An intermediate object.
+/// token - The token or tokens to process and add to 'owner'.
+define generic process-tokens
+ (owner :: <interm-element>, tokens :: type-union(<token>, <sequence>))
+=> ();
+
+
+//
+// process-tokens for <topic>s
+//
+
+// TODO: Remove this? Should all <interm-element>s except <markup> and <title>
+// have non-sequence fields? Should <markup> and <title> be sub-classes of
+// <deque> in addition to <interm-element>, or should they merely have a <deque>
+// slot? I prefer the former.
+define method process-tokens
+ (elem :: <interm-element>, content :: <sequence>)
+=> ()
+ do(curry(process-tokens, elem), content);
+end method;
+
+
+/// Will only be called for <titled-topic-token>s that are sections; topics
+/// will have been separated out already.
+define method process-tokens
+ (topic :: <topic>, section-token :: <titled-topic-token>)
+=> ()
+ debug-assert(~non-section-topic?, "Non-section being added to topic");
+
+ let section = make(<section>, owner: topic);
+ section.id := section-token.topic-nickname;
+ section.title := make(<title>, owner: section);
+ process-tokens(section.title, section-token.topic-title);
+ process-tokens(section, section-token.token-content);
+
+ check-topic-title(section.title);
+ check-topic-id(section.id);
+ push-last(topic.content, section);
+end method;
+
+
+define method process-tokens
+ (topic :: <topic>, section-token :: <section-token>)
+=> ()
+ check-allowed-sections(section-token, topic);
+ select (section-token.directive-type)
+ #"synopsis" =>
+ check-no-shortdesc(topic);
+ topic.shortdesc = make(<markup>, owner: topic);
+ process-tokens(topic.shortdesc, section-token.token-content);
+ #"keywords", #"conditions", #"arguments", #"values" =>
+ let (setter, section-id, section-title) =
+ select (section-token.directive-type)
+ #"keywords" =>
+ values(keywords-section-setter, ":Keywords", "Make Keywords");
+ #"conditions" =>
+ values(conds-section-setter, ":Conditions", "Conditions");
+ #"arguments" =>
+ values(args-section-setter, ":Arguments", "Arguments");
+ #"values" =>
+ values(vals-section-setter, ":Values", "Values");
+ end select;
+ let section = make(<section>, owner: topic);
+ section.id := section-id;
+ section.title := make(<title>, owner: section);
+ section.content := make(<markup>, owner: section);
+ process-tokens(section.title, section-token.topic-title);
+ process-tokens(section.content, section-token.token-content);
+ setter(section, topic);
+ #"note", #"warning" =>
+ let note-class = select (section-token.directive-type)
+ #"note" => <note>;
+ #"warning" => <warning-note>;
+ end select;
+ let note = make(note-class, owner: topic);
+ note.content := make(<markup>, owner: note);
+ process-tokens(note.content, section-token.token-content);
+ push-last(topic.content, note);
+ end select;
+end method;
+
+
+define method process-tokens
+ (topic :: <topic>, para-token :: <paragraph-token>)
+=> ()
+ let para = make(<paragraph>, owner: topic);
+ process-tokens(para, para-token.token-content);
+ push-last(topic.content, para);
+end method;
+
+
+define method process-tokens
+ (topic :: <topic>, section-token :: <link-directive-token>)
+=> ()
+ let target = make(<target-placeholder>, owner: topic,
+ link: section-token.link);
+ select (section-token.directive-type)
+ #"section" => topic.parent := target;
+ end select;
+end method;
+
+
+//
+// process-tokens for <paragraph>s and <title>s
+//
+
+define method process-tokens
+ (para :: type-union(<paragraph>, <title>), word :: <string>)
+=> ()
+ if (~para.content.empty?) push-last(para.content, ' ') end;
+ push-last (para.content, word);
+end method;
+
+
+define method process-tokens
+ (para :: type-union(<paragraph>, <title>), quote :: <quote-token>)
+=> ()
+ let elements = quote-elements(para, quote, $default-quote-spec);
+ if (~instance?(elements, <sequence>))
+ elements := vector(elements);
+ end if;
+ if (~para.content.empty?) push-last(para.content, ' ') end;
+ if (quote.prequoted-content) push-last(para.content, quote.prequoted-content) end;
+ para.content := concatenate!(para.content, elements);
+ if (quote.postquoted-content) push-last(para.content, quote.postquoted-content) end;
+end method;
+
+
+define method process-tokens
+ (para :: type-union(<paragraph>, <title>), image-ref :: <image-ref-token>)
+=> ()
+ push-last(para.content,
+ make(<inline-image>, owner: para,
+ image: image-ref.filename, alt-text: image-ref.caption | ""));
+end method;
+
+
+define method process-tokens
+ (para :: type-union(<paragraph>, <title>), block-tok :: <bracketed-render-block-token>)
+=> ()
+ let render-content =
+ make(if (block-tok.block-type = #"html") <html-content> else <dita-content> end,
+ owner: para, content: block-tok.token-content);
+ push-last(para.content, render-content);
+end method;
+
+
+//
+// process-tokens for <paragraph>s
+//
+
+define method process-tokens
+ (para :: <paragraph>, ref :: <marker-ref-token>)
+=> ()
+ let marker = ensure-marker(ref.index);
+ push-last(para.content, make(<xref>, owner: para, target: marker));
+end method;
+
+
+define method process-tokens (para :: <paragraph>, ref :: <synopsis-ref-token>)
+=> ()
+ push-last(para.content, make(<conref>, owner: para, type: #"shortdesc",
+ target: make(<target-placeholder>, link: ref.link)));
+end method;
+
+
+/// Synopsis: Returns the intermediate elements that make up a quote.
+///
+/// Discussion: Style changes affect the entire render. Link and monospace
+/// affect everything inside typographical quotes. The actual link tag is
+/// innermost so its text can be replaced easily by a topic title or an
+/// <api-name> or <parameter-name> object (perhaps surrounded by an <xref>).
+///
+/// From innermost to outermost, the quoted text is wrapped in:
+/// link-placeholder, term, code, typographical quotes, bib, b, i, u, term formatting, em
+///
+define method quote-elements
+ (quote-owner :: <interm-element>, quote :: <quote-token>, default-specs :: <table>)
+=> (outer-quote-elem :: <interm-element>)
+ let specs = check-quote-specifiers(quote, default-specs,
+ for-title: instance?(quote-owner, <title>));
+ let interior =
+ if (member?(#"sic", specs))
+ concatenate(quote.open-quote, quote.quoted-content, quote.close-quote)
+ else
+ quote.quoted-content
+ end if;
+ let link-target = if (instance?(specs.last, <string>)) specs.last else interior end;
+ let ownable = #f; // Not all interiors are ownable; this is outermost ownable.
+ let owner = #f; // Not all outermost can own, since elements have to chain;
+ // this is #f if outermost element can't own.
+ let first-term = #t;
+
+ for (spec in choose(rcurry(member?, specs),
+ #[ #"qv", #"toc", #"term", #"code", #"q", #"qq", #"bib", #"b", #"i", #"u", #"term", #"em" ]))
+ let (new-interior, new-owner) =
+ select (spec)
+ #"qv", #"toc" =>
+ let link = make( if (spec = #"toc") <toc-xref> else <xref> end );
+ link.text := interior;
+ link.target := make(<target-placeholder>, owner: link,
+ link: link-target);
+ values(link, link);
+ #"term" =>
+ let term = make( if (first-term) <term> else <term-style> end );
+ term.text := interior;
+ first-term := #f;
+ values(term, term);
+ #"code" =>
+ let phrase = make(<code-phrase>);
+ phrase.text := interior;
+ values(phrase, phrase);
+ #"q" =>
+ if (~instance?(interior, <sequence>))
+ interior := vector(interior);
+ end if;
+ // left and right single curly quotes, decimal entities
+ let left-quote = vector(make(<entity>, code: #x2018));
+ let right-quote = vector(make(<entity>, code: #x2019));
+ values(concatenate-as(<deque>, left-quote, interior, right-quote), #f);
+ #"qq" =>
+ if (~instance?(interior, <sequence>))
+ interior := vector(interior);
+ end if;
+ // left and right double curly quotes, decimal entities
+ let left-quote = vector(make(<entity>, code: #x201C));
+ let right-quote = vector(make(<entity>, code: #x201D));
+ values(concatenate-as(<deque>, left-quote, interior, right-quote), #f);
+ #"bib" =>
+ let cite = make(<cite>);
+ cite.text := interior;
+ values(cite, cite);
+ #"b" =>
+ let bold = make(<bold>);
+ bold.text := interior;
+ values(bold, bold);
+ #"i" =>
+ let ital = make(<italic>);
+ ital.text := interior;
+ values(ital, ital);
+ #"u" =>
+ let ul = make(<underline>);
+ ul.text := interior;
+ values(ul, ul);
+ #"em" =>
+ let em = make(<emphasis>);
+ em.text := interior;
+ values(em, em);
+ end select;
+ if (new-owner & ownable) ownable.element-owner := new-owner end;
+ ownable := new-owner | ownable;
+ interior := new-interior;
+ end for;
+ if (ownable) ownable.element-owner := owner end;
+ interior
+end method;
Added: trunk/sandbox/dydoc/source-files/file-parser.dylan
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/source-files/file-parser.dylan Sat May 3 06:24:57 2008
@@ -0,0 +1,30 @@
+module: source-files
+synopsis: Gets doc markup out of doc files or comment blocks.
+
+/// Synopsis: Records what is known a priori about a block of markup.
+/// Discussion: Used to resolve API references and to construct a topic for the
+/// block.
+define class <topic-context> (<object>)
+ /// Synopsis: The default parent topic of all topics in this block.
+ ///
+ /// Discussion: The default parent for a comment block is a topic in the
+ /// reference section of the documentation for the file's library and
+ /// module. For a file, there is no parent topic. The result either stands
+ /// alone at the top level, or is placed in a hierarchy based on other
+ /// directives or the TOC file.
+ slot default-parent :: false-or(type-union(<topic>, <section>)) = #f;
+
+ /// Synopsis: The skeleton of the first or anonymous topic within the block.
+ ///
+ /// Discussion: A comment block or file has a main topic. Any topics within
+ /// the block after the first are supplementary; they are either sibling
+ /// topics to the main one, or subtopics of the main one. The main topic
+ /// for an API element can be partially filled out by scanning the source
+ /// code; the comment's main topic puts meat on that skeleton.
+ ///
+ /// The main topic of a comment block or file must be implied, in which case
+ /// there will be a skeleton topic, or else must be specified in the comment
+ /// block or file itself. In the latter case, this field is #f.
+ slot topic :: false-or(<topic>) = #f;
+end class;
+
Added: trunk/sandbox/dydoc/source-files/module.dylan
==============================================================================
--- (empty file)
+++ trunk/sandbox/dydoc/source-files/module.dylan Sat May 3 06:24:57 2008
@@ -0,0 +1,11 @@
+module: dylan-user
+
+define module source-files
+ use common;
+ use ordered-tree;
+ use internal-rep;
+
+ // from system
+ use locators;
+ use file-system;
+end module;
Added: trunk/sandbox/dydoc/support/common.dylan
===================================