[Gd-chatter] r11168 - trunk/libraries/network/wiki
hannes at gwydiondylan.org
hannes at gwydiondylan.org
Sat Feb 10 18:54:39 CET 2007
Author: hannes
Date: Sat Feb 10 18:54:37 2007
New Revision: 11168
Added:
trunk/libraries/network/wiki/monday-parser.dylan (contents, props changed)
trunk/libraries/network/wiki/new-library.dylan (contents, props changed)
trunk/libraries/network/wiki/parser-test.dylan (contents, props changed)
Log:
Job: minor
(non-working) wiki grammar using monday
also, tests for markup
Added: trunk/libraries/network/wiki/monday-parser.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/wiki/monday-parser.dylan Sat Feb 10 18:54:37 2007
@@ -0,0 +1,203 @@
+module: wiki
+author: Hannes Mehnert <hannes at mehnert.org>
+synopsis: markup definition for dylan wiki
+
+define function extract-action
+ (token-string :: <byte-string>,
+ token-start :: <integer>,
+ token-end :: <integer>)
+ => (result :: <byte-string>);
+ copy-sequence(token-string, start: token-start, end: token-end);
+end;
+
+define function count-chars
+ (string :: <byte-string>,
+ tstart :: <integer>,
+ tend :: <integer>)
+ => (res :: <integer>)
+ tend - tstart
+end;
+define constant $base-url = "/wiki/view.dsp?title=";
+define constant $wiki-tokens
+ = simple-lexical-definition
+ token EOF;
+
+ inert "([ ])+";
+
+ token LBRACKET = "\\[";
+ token RBRACKET = "\\]";
+
+ token EQUALS = "(=)+",
+ semantic-value-function: count-chars;
+
+ token AMPERSAND = "&";
+
+ token HASHMARK = "#";
+ token STAR = "*";
+ token MINUS = "-";
+
+ token PIPE = "\\|";
+
+ token SMALLER = "<";
+ token GREATER = ">";
+
+ token NEWLINE = "(\n|\r|\r\n)";
+ //todo: ignore spaces?!
+
+ token TEXT = "[a-zA-Z_0-9\\.]+",
+ semantic-value-function: extract-action;
+
+ token URL = "(http|ftp|https)://",
+ semantic-value-function: extract-action;
+end;
+
+define constant $wiki-productions
+ = simple-grammar-productions
+
+ production description :: false-or(<string>) => [TEXT] (data)
+ if (TEXT.size = 0) #f else TEXT end;
+
+ production wiki-page-name :: <string> => [TEXT] (data)
+ TEXT;
+
+ production myurl :: <string> => [URL TEXT] (data)
+ concatenate(URL, TEXT);
+
+ production external-link :: xml$<element> => [LBRACKET myurl RBRACKET] (data)
+ with-xml() a(myurl, href => myurl) end;
+
+ production external-link :: xml$<element> => [LBRACKET myurl description RBRACKET] (data)
+ with-xml() a(description, href => myurl) end;
+
+ production internal-link :: xml$<element> => [LBRACKET LBRACKET wiki-page-name RBRACKET RBRACKET] (data)
+ with-xml() a(wiki-page-name, href => concatenate($base-url, wiki-page-name)) end;
+
+ production internal-link :: xml$<element> => [LBRACKET LBRACKET wiki-page-name PIPE description RBRACKET RBRACKET] (data)
+ with-xml() a(description, href => concatenate($base-url, wiki-page-name)) end;
+
+ production header :: xml$<element> => [EQUALS wiki-text EQUALS], action:
+ method (p :: <simple-parser>, data, s, e)
+ let left = p[0];
+ let right = p[2];
+ unless (left = right)
+ format-out("Unbalanced number of '=' in header %s, left: %d right: %d, using %d\n",
+ p[1], left, right, max(left, right));
+ end;
+ make(xml$<element>,
+ name: concatenate("h", integer-to-string(max(left, right))),
+ children: p[1]);
+ end;
+
+ production unnumbered-list :: xml$<element> => [STAR list-elements] (data)
+ format-out("Hit unnumbered-list %=\n", list-elements);
+ with-xml () ul { list-elements } end;
+
+ production list-elements :: <collection> => [list-element NEWLINE more-list-elements] (data)
+ format-out("Hit list-elements\n");
+ add!(more-list-elements, list-element);
+
+ production more-list-elements :: <collection> => [STAR list-element more-list-elements] (data)
+ format-out("Hit more-list-elements\n");
+ add!(more-list-elements | #(), list-element);
+
+// production more-list-elements :: <collection> => [] (data)
+// format-out("Hit more-list-elements, empty\n");
+// #();
+
+ production list-element :: xml$<element> => [wiki-text] (data)
+ format-out("Hit list-element %=\n", wiki-text);
+ wiki-text;
+
+ production wiki-text :: <collection> => [TEXT more-wiki-text] (data)
+ add!(more-wiki-text, with-xml() text(TEXT) end);
+
+ production wiki-text :: <collection> => [internal-link more-wiki-text] (data)
+ add!(more-wiki-text, internal-link);
+
+ production wiki-text :: <collection> => [external-link more-wiki-text] (data)
+ add!(more-wiki-text, external-link);
+
+ production more-wiki-text :: <collection> => [wiki-text more-wiki-text] (data)
+ add!(more-wiki-text, wiki-text);
+
+ production more-wiki-text :: <collection> => [] (data)
+ #();
+
+ production line :: <collection> => [wiki-text NEWLINE] (data)
+ wiki-text;
+
+ production line :: xml$<element> => [NEWLINE] (data)
+ with-xml() p end;
+
+ production line :: xml$<element> => [header NEWLINE] (data)
+ header;
+
+ production line :: xml$<element> => [unnumbered-list] (data)
+ unnumbered-list;
+
+ production lines => [] (data)
+
+ production lines => [line lines] (data)
+ data.my-real-data := add!(data.my-real-data, line);
+end;
+
+define constant $wiki-parser-automaton
+ = simple-parser-automaton($wiki-tokens, $wiki-productions,
+ #[#"lines"]);
+
+define function consume-token
+ (consumer-data,
+ token-number :: <integer>,
+ token-name :: <object>,
+ semantic-value :: <object>,
+ start-position :: <integer>,
+ end-position :: <integer>)
+ => ();
+ //let srcloc
+ // = range-source-location(consumer-data, start-position, end-position);
+ format-out("%d - %d: token %d: %= value %=\n",
+ start-position,
+ end-position,
+ token-number,
+ token-name,
+ semantic-value);
+ simple-parser-consume-token(consumer-data, token-number, token-name, semantic-value, start-position, end-position);
+end function;
+
+define sealed class <my-data> (<object>)
+ slot my-real-data = #();
+end;
+
+define function parse-wiki-markup (input :: <string>)
+ let rangemap = make(<source-location-rangemap>);
+ rangemap-add-line(rangemap, 0, 1);
+ unless(input[input.size - 1] = '\n')
+ input := add!(input, '\n')
+ end;
+ let scanner = make(<simple-lexical-scanner>,
+ definition: $wiki-tokens,
+ rangemap: rangemap);
+ let data = make(<my-data>);
+ let parser = make(<simple-parser>,
+ automaton: $wiki-parser-automaton,
+ start-symbol: #"lines",
+ rangemap: rangemap,
+ consumer-data: data);
+ format-out("before scan-tokens, input: %s\n", input);
+ scan-tokens(scanner,
+ //simple-parser-consume-token,
+ consume-token,
+ parser,
+ input,
+ end: input.size,
+ partial?: #f);
+ let end-position = scanner.scanner-source-position;
+ format-out("before consuming EOF at %d\n", end-position);
+ simple-parser-consume-token(parser, 0, #"EOF", parser, end-position, end-position);
+ format-out("data (%d) is %=\n", data.my-real-data.size, data.my-real-data);
+ data.my-real-data;
+end;
+
+begin
+ parse-wiki-markup("==foo==\nfoo[[bar]]");
+end;
Added: trunk/libraries/network/wiki/new-library.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/wiki/new-library.dylan Sat Feb 10 18:54:37 2007
@@ -0,0 +1,72 @@
+Module: dylan-user
+Author: Carl Gay
+Copyright: This code is in the public domain.
+
+define library wiki
+ use common-dylan,
+ import: { common-dylan, threads };
+ use io,
+ import: { streams, format, format-out };
+ use system,
+ import: { file-system, locators, date };
+ use koala,
+ import: { dsp };
+ use dylan-basics;
+ use regular-expressions;
+ use xml-rpc-common;
+ use strings;
+ use web-framework;
+ use xml-parser;
+ use collection-extensions, import: { sequence-diff };
+ use string-extensions, import: { substring-search };
+ use xmpp-bot;
+ //use meta;
+ use testworks;
+
+
+ use source-location;
+ use grammar;
+ use simple-parser;
+ use regular;
+
+ export wiki;
+end;
+
+define module wiki
+ use common-dylan,
+ exclude: { split, format-to-string };
+ use locators;
+ use streams;
+ use format;
+ use file-system;
+ use threads;
+ use dylan-basics;
+ use date;
+ //use meta;
+ use dsp;
+ use regular-expressions,
+ import: { regexp-position };
+ use xml-rpc-common,
+ import: { base64-encode, base64-decode };
+ use strings, import: { index-of, case-insensitive-equal? };
+ use web-framework, exclude: { respond-to-get, respond-to-post, slot-type };
+ use users;
+ use storage;
+ use sequence-diff;
+ use xml-parser, prefix: "xml$";
+ use simple-xml, import: { escape-xml, with-xml };
+ use substring-search;
+ use testworks;
+
+ use format-out;
+
+ use simple-parser;
+ use source-location;
+ use source-location-rangemap;
+ use grammar;
+ use simple-lexical-scanner;
+
+ use xmpp-bot;
+end;
+
+
Added: trunk/libraries/network/wiki/parser-test.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/wiki/parser-test.dylan Sat Feb 10 18:54:37 2007
@@ -0,0 +1,104 @@
+module: wiki
+
+define variable *markup-method* = parse-wiki-markup;
+
+
+define test newline ()
+ check-equal("Newline inserts paragraph", "foo<p/>bar", *markup-method*("foo\n\nbar\n"));
+end;
+
+define test internal-link ()
+ check-equal("Internal link to unknown page",
+ "<a href=\"/wiki/view.dsp?title=foo\">[?]foo</a>",
+ *markup-method*("[[foo]]"));
+end;
+
+define test external-link ()
+ check-equal("External link",
+ "<a href=\"http://www.ccc.de\">http://www.ccc.de</a>",
+ *markup-method*("[http://www.ccc.de]"));
+end;
+
+define test external-link-with-label ()
+ check-equal("External Link with label",
+ "<a href=\"http://www.ccc.de\">foobar</a>",
+ *markup-method*("[http://www.ccc.de foobar]"));
+end;
+
+define test heading2 ()
+ check-equal("Heading 2", "<h2>foo</h2>", *markup-method*("==foo=="));
+end;
+
+define test heading3 ()
+ check-equal("Heading 3", "<h3>fooo</h3>", *markup-method*("===fooo==="));
+end;
+
+define test heading4 ()
+ check-equal("Heading 4", "<h4> foooo </h4>", *markup-method*("==== foooo ===="));
+end;
+
+define test heading5 ()
+ check-equal("Heading 5", "<h5> fooooo </h5>", *markup-method*("===== fooooo ====="));
+end;
+
+define test heading54 ()
+ check-equal("Heading 54", "<h5> fooooo </h5>", *markup-method*("===== fooooo ===="));
+end;
+
+define test unnumbered-list ()
+ check-equal("Unnumbered list",
+ "<ul><li>one</li><li>two</li><li>three</li></ul>",
+ *markup-method*("* one\n* two\n* three\n"));
+end;
+
+define test numbered-list ()
+ check-equal("Numbered list",
+ "<ol><li>one</li><li>two</li><li>three</li></ol>",
+ *markup-method*("# one\n# two\n# three\n"));
+end;
+
+define test nested-list ()
+ check-equal("Nested list",
+ "<ul><li>one</li><li>two</li><ul><li>two and a half</li></ul><li>three</li></ul>",
+ *markup-method*("* one\n* two\n** two and a half\n* three\n"));
+end;
+
+define test horizontal-line ()
+ check-equal("Horizontal line", "<hr/>", *markup-method*("----"));
+end;
+
+define test nowiki-markup ()
+ check-equal("Nowiki markup",
+ "foo [http://foo]",
+ *markup-method*("<nowiki>foo [http://foo]</nowiki>"));
+end;
+
+define test pre-formatted ()
+ check-equal("Pre-formatted text",
+ "<pre> this is pre-text\n and another line</pre>",
+ *markup-method*(" this is pre-text\n and another line"));
+
+end;
+
+define suite parser-suite ()
+ test newline;
+ test internal-link;
+ test external-link;
+ test external-link-with-label;
+ test heading2;
+ test heading3;
+ test heading4;
+ test heading5;
+ test heading54;
+ test unnumbered-list;
+ //test numbered-list;
+ //test nested-list;
+ //test horizontal-line;
+ //test nowiki-markup;
+ //test pre-formatted;
+end;
+
+begin
+ run-test-application(parser-suite)
+end;
+
More information about the chatter
mailing list