Added a Factor lexer (#520).

5 files changed, 670 insertions, 2 deletions

diff --git a/AUTHORS b/AUTHORS
index d102686a..dbb5c414 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -14,6 +14,7 @@ Other contributors, listed alphabetically, are:
 * Max Battcher -- Darcs patch lexer
 * Paul Baumgart, 280 North, Inc. -- Objective-J lexer
 * Michael Bayer -- Myghty lexers
+* John Benediktsson -- Factor lexer
 * Jarrett Billingsley -- MiniD lexer
 * Adam Blinkinsop -- Haskell, Redcode lexers
 * Frits van Bommel -- assembler lexers
diff --git a/CHANGES b/CHANGES
index 07138589..158b94ed 100644
--- a/CHANGES
+++ b/CHANGES
@@ -7,6 +7,8 @@ Version 1.4
 -----------
 (in development)
 
+- Added a Factor lexer (#520).
+
 - Performance improvements in the HTML formatter (#523).
 
 - With the ``noclasses`` option in the HTML formatter, some styles
diff --git a/pygments/lexers/_mapping.py b/pygments/lexers/_mapping.py
index db2134e5..4c9002de 100644
--- a/pygments/lexers/_mapping.py
+++ b/pygments/lexers/_mapping.py
@@ -75,6 +75,7 @@ LEXERS = {
     'EvoqueHtmlLexer': ('pygments.lexers.templates', 'HTML+Evoque', ('html+evoque',), ('*.html',), ('text/html+evoque',)),
     'EvoqueLexer': ('pygments.lexers.templates', 'Evoque', ('evoque',), ('*.evoque',), ('application/x-evoque',)),
     'EvoqueXmlLexer': ('pygments.lexers.templates', 'XML+Evoque', ('xml+evoque',), ('*.xml',), ('application/xml+evoque',)),
+    'FactorLexer': ('pygments.lexers.agile', 'Factor', ('factor',), ('*.factor',), ('text/x-factor',)),
     'FelixLexer': ('pygments.lexers.compiled', 'Felix', ('felix', 'flx'), ('*.flx', '*.flxh'), ('text/x-felix',)),
     'FortranLexer': ('pygments.lexers.compiled', 'Fortran', ('fortran',), ('*.f', '*.f90'), ('text/x-fortran',)),
     'GLShaderLexer': ('pygments.lexers.compiled', 'GLSL', ('glsl',), ('*.vert', '*.frag', '*.geo'), ('text/x-glslsrc',)),
@@ -109,7 +110,7 @@ LEXERS = {
     'LiterateHaskellLexer': ('pygments.lexers.functional', 'Literate Haskell', ('lhs', 'literate-haskell'), ('*.lhs',), ('text/x-literate-haskell',)),
     'LlvmLexer': ('pygments.lexers.asm', 'LLVM', ('llvm',), ('*.ll',), ('text/x-llvm',)),
     'LogtalkLexer': ('pygments.lexers.other', 'Logtalk', ('logtalk',), ('*.lgt',), ('text/x-logtalk',)),
-    'LuaLexer': ('pygments.lexers.agile', 'Lua', ('lua',), ('*.lua',), ('text/x-lua', 'application/x-lua')),
+    'LuaLexer': ('pygments.lexers.agile', 'Lua', ('lua',), ('*.lua', '*.wlua'), ('text/x-lua', 'application/x-lua')),
     'MOOCodeLexer': ('pygments.lexers.other', 'MOOCode', ('moocode',), ('*.moo',), ('text/x-moocode',)),
     'MakefileLexer': ('pygments.lexers.text', 'Makefile', ('make', 'makefile', 'mf', 'bsdmake'), ('*.mak', 'Makefile', 'makefile', 'Makefile.*', 'GNUmakefile'), ('text/x-makefile',)),
     'MakoCssLexer': ('pygments.lexers.templates', 'CSS+Mako', ('css+mako',), (), ('text/css+mako',)),
diff --git a/pygments/lexers/agile.py b/pygments/lexers/agile.py
index 2ed416e0..96e84061 100644
--- a/pygments/lexers/agile.py
+++ b/pygments/lexers/agile.py
@@ -22,7 +22,7 @@ from pygments import unistring as uni
 __all__ = ['PythonLexer', 'PythonConsoleLexer', 'PythonTracebackLexer',
            'RubyLexer', 'RubyConsoleLexer', 'PerlLexer', 'LuaLexer',
            'MiniDLexer', 'IoLexer', 'TclLexer', 'ClojureLexer',
-           'Python3Lexer', 'Python3TracebackLexer']
+           'Python3Lexer', 'Python3TracebackLexer', 'FactorLexer']
 
 # b/w compatibility
 from pygments.lexers.functional import SchemeLexer
@@ -1484,3 +1484,283 @@ class ClojureLexer(RegexLexer):
             (r'(\(|\))', Punctuation),
         ],
     }
+
+
+class FactorLexer(RegexLexer):
+    """
+    Lexer for the `Factor <http://factorcode.org>`_ language.
+
+    *New in Pygments 1.4.*
+    """
+    name = 'Factor'
+    aliases = ['factor']
+    filenames = ['*.factor']
+    mimetypes = ['text/x-factor']
+
+    flags = re.MULTILINE | re.UNICODE
+
+    builtin_kernel = (
+        r'(?:or|2bi|2tri|while|wrapper|nip|4dip|wrapper\\?|bi\\*|'
+        r'callstack>array|both\\?|hashcode|die|dupd|callstack|'
+        r'callstack\\?|3dup|tri@|pick|curry|build|\\?execute|3bi|'
+        r'prepose|>boolean|\\?if|clone|eq\\?|tri\\*|\\?|=|swapd|'
+        r'2over|2keep|3keep|clear|2dup|when|not|tuple\\?|dup|2bi\\*|'
+        r'2tri\\*|call|tri-curry|object|bi@|do|unless\\*|if\\*|loop|'
+        r'bi-curry\\*|drop|when\\*|assert=|retainstack|assert\\?|-rot|'
+        r'execute|2bi@|2tri@|boa|with|either\\?|3drop|bi|curry\\?|'
+        r'datastack|until|3dip|over|3curry|tri-curry\\*|tri-curry@|swap|'
+        r'and|2nip|throw|bi-curry|\\(clone\\)|hashcode\\*|compose|2dip|if|3tri|'
+        r'unless|compose\\?|tuple|keep|2curry|equal\\?|assert|tri|2drop|'
+        r'most|<wrapper>|boolean\\?|identity-hashcode|identity-tuple\\?|'
+        r'null|new|dip|bi-curry@|rot|xor|identity-tuple|boolean)\s'
+        )
+
+    builtin_assocs = (
+        r'(?:\\?at|assoc\\?|assoc-clone-like|assoc=|delete-at\\*|'
+        r'assoc-partition|extract-keys|new-assoc|value\\?|assoc-size|'
+        r'map>assoc|push-at|assoc-like|key\\?|assoc-intersect|'
+        r'assoc-refine|update|assoc-union|assoc-combine|at\\*|'
+        r'assoc-empty\\?|at\\+|set-at|assoc-all\\?|assoc-subset\\?|'
+        r'assoc-hashcode|change-at|assoc-each|assoc-diff|zip|values|'
+        r'value-at|rename-at|inc-at|enum\\?|at|cache|assoc>map|<enum>|'
+        r'assoc|assoc-map|enum|value-at\\*|assoc-map-as|>alist|'
+        r'assoc-filter-as|clear-assoc|assoc-stack|maybe-set-at|'
+        r'substitute|assoc-filter|2cache|delete-at|assoc-find|keys|'
+        r'assoc-any\\?|unzip)\s'
+        )
+
+    builtin_combinators = (
+        r'(?:case|execute-effect|no-cond|no-case\\?|3cleave>quot|2cleave|'
+        r'cond>quot|wrong-values\\?|no-cond\\?|cleave>quot|no-case|'
+        r'case>quot|3cleave|wrong-values|to-fixed-point|alist>quot|'
+        r'case-find|cond|cleave|call-effect|2cleave>quot|recursive-hashcode|'
+        r'linear-case-quot|spread|spread>quot)\s'
+        )
+
+    builtin_math = (
+        r'(?:number=|if-zero|next-power-of-2|each-integer|\\?1\\+|'
+        r'fp-special\\?|imaginary-part|unless-zero|float>bits|number\\?|'
+        r'fp-infinity\\?|bignum\\?|fp-snan\\?|denominator|fp-bitwise=|\\*|'
+        r'\\+|power-of-2\\?|-|u>=|/|>=|bitand|log2-expects-positive|<|'
+        r'log2|>|integer\\?|number|bits>double|2/|zero\\?|(find-integer)|'
+        r'bits>float|float\\?|shift|ratio\\?|even\\?|ratio|fp-sign|bitnot|'
+        r'>fixnum|complex\\?|/i|/f|byte-array>bignum|when-zero|sgn|>bignum|'
+        r'next-float|u<|u>|mod|recip|rational|find-last-integer|>float|'
+        r'(all-integers\\?)|2^|times|integer|fixnum\\?|neg|fixnum|sq|'
+        r'bignum|(each-integer)|bit\\?|fp-qnan\\?|find-integer|complex|'
+        r'<fp-nan>|real|double>bits|bitor|rem|fp-nan-payload|all-integers\\?|'
+        r'real-part|log2-expects-positive\\?|prev-float|align|unordered\\?|'
+        r'float|fp-nan\\?|abs|bitxor|u<=|odd\\?|<=|/mod|rational\\?|>integer|'
+        r'real\\?|numerator)\s'
+        )
+
+    builtin_sequences = (
+        r'(?:member-eq\\?|append|assert-sequence=|find-last-from|trim-head-slice|'
+        r'clone-like|3sequence|assert-sequence\\?|map-as|last-index-from|'
+        r'reversed|index-from|cut\\*|pad-tail|remove-eq!|concat-as|'
+        r'but-last|snip|trim-tail|nths|nth|2selector|sequence|slice\\?|'
+        r'<slice>|partition|remove-nth|tail-slice|empty\\?|tail\\*|'
+        r'if-empty|find-from|virtual-sequence\\?|member\\?|set-length|'
+        r'drop-prefix|unclip|unclip-last-slice|iota|map-sum|'
+        r'bounds-error\\?|sequence-hashcode-step|selector-for|'
+        r'accumulate-as|map|start|midpoint@|\\(accumulate\\)|rest-slice|'
+        r'prepend|fourth|sift|accumulate!|new-sequence|follow|map!|'
+        r'like|first4|1sequence|reverse|slice|unless-empty|padding|'
+        r'virtual@|repetition\\?|set-last|index|4sequence|max-length|'
+        r'set-second|immutable-sequence|first2|first3|replicate-as|'
+        r'reduce-index|unclip-slice|supremum|suffix!|insert-nth|'
+        r'trim-tail-slice|tail|3append|short|count|suffix|concat|'
+        r'flip|filter|sum|immutable\\?|reverse!|2sequence|map-integers|'
+        r'delete-all|start\\*|indices|snip-slice|check-slice|sequence\\?|'
+        r'head|map-find|filter!|append-as|reduce|sequence=|halves|'
+        r'collapse-slice|interleave|2map|filter-as|binary-reduce|'
+        r'slice-error\\?|product|bounds-check\\?|bounds-check|harvest|'
+        r'immutable|virtual-exemplar|find|produce|remove|pad-head|last|'
+        r'replicate|set-fourth|remove-eq|shorten|reversed\\?|'
+        r'map-find-last|3map-as|2unclip-slice|shorter\\?|3map|find-last|'
+        r'head-slice|pop\\*|2map-as|tail-slice\\*|but-last-slice|'
+        r'2map-reduce|iota\\?|collector-for|accumulate|each|selector|'
+        r'append!|new-resizable|cut-slice|each-index|head-slice\\*|'
+        r'2reverse-each|sequence-hashcode|pop|set-nth|\\?nth|'
+        r'<flat-slice>|second|join|when-empty|collector|'
+        r'immutable-sequence\\?|<reversed>|all\\?|3append-as|'
+        r'virtual-sequence|subseq\\?|remove-nth!|push-either|new-like|'
+        r'length|last-index|push-if|2all\\?|lengthen|assert-sequence|'
+        r'copy|map-reduce|move|third|first|3each|tail\\?|set-first|'
+        r'prefix|bounds-error|any\\?|<repetition>|trim-slice|exchange|'
+        r'surround|2reduce|cut|change-nth|min-length|set-third|produce-as|'
+        r'push-all|head\\?|delete-slice|rest|sum-lengths|2each|head\\*|'
+        r'infimum|remove!|glue|slice-error|subseq|trim|replace-slice|'
+        r'push|repetition|map-index|trim-head|unclip-last|mismatch)\s'
+        )
+
+    builtin_namespaces = (
+        r'(?:global|\\+@|change|set-namestack|change-global|init-namespaces|'
+        r'on|off|set-global|namespace|set|with-scope|bind|with-variable|'
+        r'inc|dec|counter|initialize|namestack|get|get-global|make-assoc)\s'
+        )
+
+    builtin_arrays = (
+        r'(?:<array>|2array|3array|pair|>array|1array|4array|pair\\?|'
+        r'array|resize-array|array\\?)\s'
+        )
+
+    builtin_io = (
+        r'(?:\\+character\\+|bad-seek-type\\?|readln|each-morsel|stream-seek|'
+        r'read|print|with-output-stream|contents|write1|stream-write1|'
+        r'stream-copy|stream-element-type|with-input-stream|'
+        r'stream-print|stream-read|stream-contents|stream-tell|'
+        r'tell-output|bl|seek-output|bad-seek-type|nl|stream-nl|write|'
+        r'flush|stream-lines|\\+byte\\+|stream-flush|read1|'
+        r'seek-absolute\\?|stream-read1|lines|stream-readln|'
+        r'stream-read-until|each-line|seek-end|with-output-stream\\*|'
+        r'seek-absolute|with-streams|seek-input|seek-relative\\?|'
+        r'input-stream|stream-write|read-partial|seek-end\\?|'
+        r'seek-relative|error-stream|read-until|with-input-stream\\*|'
+        r'with-streams\\*|tell-input|each-block|output-stream|'
+        r'stream-read-partial|each-stream-block|each-stream-line)\s'
+        )
+
+    builtin_strings = (
+        r'(?:resize-string|>string|<string>|1string|string|string\\?)\s'
+        )
+
+    builtin_vectors = (
+        r'(?:vector\\?|<vector>|\\?push|vector|>vector|1vector)\s'
+        )
+
+    builtin_continuations = (
+        r'(?:with-return|restarts|return-continuation|with-datastack|'
+        r'recover|rethrow-restarts|<restart>|ifcc|set-catchstack|'
+        r'>continuation<|cleanup|ignore-errors|restart\\?|'
+        r'compute-restarts|attempt-all-error|error-thread|continue|'
+        r'<continuation>|attempt-all-error\\?|condition\\?|'
+        r'<condition>|throw-restarts|error|catchstack|continue-with|'
+        r'thread-error-hook|continuation|rethrow|callcc1|'
+        r'error-continuation|callcc0|attempt-all|condition|'
+        r'continuation\\?|restart|return)\s'
+        )
+
+    tokens = {
+        'root': [
+            # TODO: (( inputs -- outputs ))
+            # TODO: << ... >>
+
+            # defining words
+            (r'(\s*)(:|::|MACRO:|MEMO:)(\s+)(\S+)',
+                bygroups(Text, Keyword, Text, Name.Function)),
+            (r'(\s*)(M:)(\s+)(\S+)(\s+)(\S+)',
+                bygroups(Text, Keyword, Text, Name.Class, Text, Name.Function)),
+            (r'(\s*)(GENERIC:)(\s+)(\S+)',
+                bygroups(Text, Keyword, Text, Name.Function)),
+            (r'(\s*)(HOOK:|GENERIC#)(\s+)(\S+)(\s+)(\S+)',
+                bygroups(Text, Keyword, Text, Name.Function, Text, Name.Function)),
+            (r'(\()(\s+)', bygroups(Name.Function, Text), 'stackeffect'),
+            (r'\;\s', Keyword),
+
+            # imports and namespaces
+            (r'(USING:)((?:\s|\\\s)+)', bygroups(Keyword.Namespace, Text), 'import'),
+            (r'(USE:)(\s+)(\S+)', bygroups(Keyword.Namespace, Text, Name.Namespace)),
+            (r'(UNUSE:)(\s+)(\S+)', bygroups(Keyword.Namespace, Text, Name.Namespace)),
+            (r'(QUALIFIED:)(\s+)(\S+)',
+                bygroups(Keyword.Namespace, Text, Name.Namespace)),
+            (r'(QUALIFIED-WITH:)(\s+)(\S+)',
+                bygroups(Keyword.Namespace, Text, Name.Namespace)),
+            (r'(FROM:|EXCLUDE:)(\s+)(\S+)(\s+)(=>)',
+                bygroups(Keyword.Namespace, Text, Name.Namespace, Text, Text)),
+            (r'(IN:)(\s+)(\S+)', bygroups(Keyword.Namespace, Text, Name.Namespace)),
+            (r'(?:ALIAS|DEFER|FORGET|POSTPONE):', Keyword.Namespace),
+
+            # tuples and classes
+            (r'(TUPLE:)(\s+)(\S+)(\s+<\s+)(\S+)',
+                bygroups(Keyword, Text, Name.Class, Text, Name.Class), 'slots'),
+            (r'(TUPLE:)(\s+)(\S+)', bygroups(Keyword, Text, Name.Class), 'slots'),
+            (r'(UNION:)(\s+)(\S+)', bygroups(Keyword, Text, Name.Class)),
+            (r'(INTERSECTION:)(\s+)(\S+)', bygroups(Keyword, Text, Name.Class)),
+            (r'(PREDICATE:)(\s+)(\S+)(\s+<\s+)(\S+)',
+                bygroups(Keyword, Text, Name.Class, Text, Name.Class)),
+            (r'(C:)(\s+)(\S+)(\s+)(\S+)',
+                bygroups(Keyword, Text, Name.Function, Text, Name.Class)),
+            (r'INSTANCE:', Keyword),
+            (r'SLOT:', Keyword),
+            (r'MIXIN:', Keyword),
+            (r'(?:SINGLETON|SINGLETONS):', Keyword),
+
+            # other syntax
+            (r'CONSTANT:', Keyword),
+            (r'(?:SYMBOL|SYMBOLS):', Keyword),
+            (r'ERROR:', Keyword),
+            (r'SYNTAX:', Keyword),
+            (r'(HELP:)(\s+)(\S+)', bygroups(Keyword, Text, Name.Function)),
+            (r'(MAIN:)(\s+)(\S+)', bygroups(Keyword.Namespace, Text, Name.Function)),
+            (r'(?:ALIEN|TYPEDEF|FUNCTION|STRUCT):', Keyword),
+
+            # vocab.private
+            # TODO: words inside vocab.private should have red names?
+            (r'(?:<PRIVATE|PRIVATE>)', Keyword.Namespace),
+
+            # strings
+            (r'"""\s+(?:.|\n)*?\s+"""', String),
+            (r'"(?:\\\\|\\"|[^"])*"', String),
+            (r'CHAR:\s+(\\[\\abfnrstv]*|\S)\s', String.Char),
+
+            # comments
+            (r'\!\s+.*$', Comment),
+            (r'#\!\s+.*$', Comment),
+
+            # boolean constants
+            (r'(t|f)\s', Name.Constant),
+
+            # numbers
+            (r'-?\d+\.\d+\s', Number.Float),
+            (r'-?\d+\s', Number.Integer),
+            (r'HEX:\s+[a-fA-F\d]+\s', Number.Hex),
+            (r'BIN:\s+[01]+\s', Number.Integer),
+            (r'OCT:\s+[0-7]+\s', Number.Oct),
+
+            # operators
+            (r'[-+/*=<>^]\s', Operator),
+
+            # keywords
+            (r'(?:deprecated|final|foldable|flushable|inline|recursive)\s', Keyword),
+
+            # builtins
+            (builtin_kernel, Name.Builtin),
+            (builtin_assocs, Name.Builtin),
+            (builtin_combinators, Name.Builtin),
+            (builtin_math, Name.Builtin),
+            (builtin_sequences, Name.Builtin),
+            (builtin_namespaces, Name.Builtin),
+            (builtin_arrays, Name.Builtin),
+            (builtin_io, Name.Builtin),
+            (builtin_strings, Name.Builtin),
+            (builtin_vectors, Name.Builtin),
+            (builtin_continuations, Name.Builtin),
+
+            # whitespaces - usually not relevant
+            (r'\s+', Text),
+
+            # everything else is text
+            (r'\S+', Text),
+        ],
+
+        'stackeffect': [
+            (r'\s*\(', Name.Function, 'stackeffect'),
+            (r'\)', Name.Function, '#pop'),
+            (r'\-\-', Name.Function),
+            (r'\s+', Text),
+            (r'\S+', Name.Variable),
+        ],
+
+        'slots': [
+            (r'\s+', Text),
+            (r';\s', Keyword, '#pop'),
+            (r'\S+', Name.Variable),
+        ],
+
+        'import': [
+            (r';', Keyword, '#pop'),
+            (r'\S+', Name.Namespace),
+            (r'\s+', Text),
+        ],
+    }
diff --git a/tests/examplefiles/wiki.factor b/tests/examplefiles/wiki.factor
new file mode 100644
index 00000000..d046e91c
--- /dev/null
+++ b/tests/examplefiles/wiki.factor
@@ -0,0 +1,384 @@
+! Copyright (C) 2008 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel hashtables calendar random assocs
+namespaces make splitting sequences sorting math.order present
+io.files io.directories io.encodings.ascii
+syndication farkup
+html.components html.forms
+http.server
+http.server.dispatchers
+furnace.actions
+furnace.utilities
+furnace.redirection
+furnace.auth
+furnace.auth.login
+furnace.boilerplate
+furnace.syndication
+validators
+db.types db.tuples lcs urls ;
+IN: webapps.wiki
+
+: wiki-url ( rest path -- url )
+    [ "$wiki/" % % "/" % present % ] "" make
+    <url> swap >>path ;
+
+: view-url ( title -- url ) "view" wiki-url ;
+
+: edit-url ( title -- url ) "edit" wiki-url ;
+
+: revisions-url ( title -- url ) "revisions" wiki-url ;
+
+: revision-url ( id -- url ) "revision" wiki-url ;
+
+: user-edits-url ( author -- url ) "user-edits" wiki-url ;
+
+TUPLE: wiki < dispatcher ;
+
+SYMBOL: can-delete-wiki-articles?
+
+can-delete-wiki-articles? define-capability
+
+TUPLE: article title revision ;
+
+article "ARTICLES" {
+    { "title" "TITLE" { VARCHAR 256 } +not-null+ +user-assigned-id+ }
+    { "revision" "REVISION" INTEGER +not-null+ } ! revision id
+} define-persistent
+
+: <article> ( title -- article ) article new swap >>title ;
+
+TUPLE: revision id title author date content description ;
+
+revision "REVISIONS" {
+    { "id" "ID" INTEGER +db-assigned-id+ }
+    { "title" "TITLE" { VARCHAR 256 } +not-null+ } ! article id
+    { "author" "AUTHOR" { VARCHAR 256 } +not-null+ } ! uid
+    { "date" "DATE" TIMESTAMP +not-null+ }
+    { "content" "CONTENT" TEXT +not-null+ }
+    { "description" "DESCRIPTION" TEXT }
+} define-persistent
+
+M: revision feed-entry-title
+    [ title>> ] [ drop " by " ] [ author>> ] tri 3append ;
+
+M: revision feed-entry-date date>> ;
+
+M: revision feed-entry-url id>> revision-url ;
+
+: reverse-chronological-order ( seq -- sorted )
+    [ date>> ] inv-sort-with ;
+
+: <revision> ( id -- revision )
+    revision new swap >>id ;
+
+: validate-title ( -- )
+    { { "title" [ v-one-line ] } } validate-params ;
+
+: validate-author ( -- )
+    { { "author" [ v-username ] } } validate-params ;
+
+: <article-boilerplate> ( responder -- responder' )
+    <boilerplate>
+        { wiki "page-common" } >>template ;
+
+: <main-article-action> ( -- action )
+    <action>
+        [ "Front Page" view-url <redirect> ] >>display ;
+
+: latest-revision ( title -- revision/f )
+    <article> select-tuple
+    dup [ revision>> <revision> select-tuple ] when ;
+
+: <view-article-action> ( -- action )
+    <action>
+
+        "title" >>rest
+
+        [ validate-title ] >>init
+
+        [
+            "title" value dup latest-revision [
+                from-object
+                { wiki "view" } <chloe-content>
+            ] [
+                edit-url <redirect>
+            ] ?if
+        ] >>display
+
+    <article-boilerplate> ;
+
+: <view-revision-action> ( -- action )
+    <page-action>
+
+        "id" >>rest
+
+        [
+            validate-integer-id
+            "id" value <revision>
+            select-tuple from-object
+        ] >>init
+
+        { wiki "view" } >>template
+    
+    <article-boilerplate> ;
+
+: <random-article-action> ( -- action )
+    <action>
+        [
+            article new select-tuples random
+            [ title>> ] [ "Front Page" ] if*
+            view-url <redirect>
+        ] >>display ;
+
+: amend-article ( revision article -- )
+    swap id>> >>revision update-tuple ;
+
+: add-article ( revision -- )
+    [ title>> ] [ id>> ] bi article boa insert-tuple ;
+
+: add-revision ( revision -- )
+    [ insert-tuple ]
+    [
+        dup title>> <article> select-tuple
+        [ amend-article ] [ add-article ] if*
+    ]
+    bi ;
+
+: <edit-article-action> ( -- action )
+    <page-action>
+
+        "title" >>rest
+
+        [
+            validate-title
+
+            "title" value <article> select-tuple
+            [ revision>> <revision> select-tuple ]
+            [ f <revision> "title" value >>title ]
+            if*
+
+            [ title>> "title" set-value ]
+            [ content>> "content" set-value ]
+            bi
+        ] >>init
+
+        { wiki "edit" } >>template
+
+    <article-boilerplate> ;
+
+: <submit-article-action> ( -- action )
+    <action>
+        [
+            validate-title
+
+            {
+                { "content" [ v-required ] }
+                { "description" [ [ v-one-line ] v-optional ] }
+            } validate-params
+
+            f <revision>
+                "title" value >>title
+                now >>date
+                username >>author
+                "content" value >>content
+                "description" value >>description
+            [ add-revision ] [ title>> view-url <redirect> ] bi
+        ] >>submit
+
+    <protected>
+        "edit wiki articles" >>description ;
+
+: <revisions-boilerplate> ( responder -- responder )
+    <boilerplate>
+        { wiki "revisions-common" } >>template ;
+
+: list-revisions ( -- seq )
+    f <revision> "title" value >>title select-tuples
+    reverse-chronological-order ;
+
+: <list-revisions-action> ( -- action )
+    <page-action>
+
+        "title" >>rest
+
+        [
+            validate-title
+            list-revisions "revisions" set-value
+        ] >>init
+
+        { wiki "revisions" } >>template
+
+    <revisions-boilerplate>
+    <article-boilerplate> ;
+
+: <list-revisions-feed-action> ( -- action )
+    <feed-action>
+
+        "title" >>rest
+
+        [ validate-title ] >>init
+
+        [ "Revisions of " "title" value append ] >>title
+
+        [ "title" value revisions-url ] >>url
+
+        [ list-revisions ] >>entries ;
+
+: rollback-description ( description -- description' )
+    [ "Rollback of '" "'" surround ] [ "Rollback" ] if* ;
+
+: <rollback-action> ( -- action )
+    <action>
+
+        [ validate-integer-id ] >>validate
+
+        [
+            "id" value <revision> select-tuple
+                f >>id
+                now >>date
+                username >>author
+                [ rollback-description ] change-description
+            [ add-revision ]
+            [ title>> revisions-url <redirect> ] bi
+        ] >>submit
+    
+    <protected>
+        "rollback wiki articles" >>description ;
+
+: list-changes ( -- seq )
+    f <revision> select-tuples
+    reverse-chronological-order ;
+
+: <list-changes-action> ( -- action )
+    <page-action>
+        [ list-changes "revisions" set-value ] >>init
+        { wiki "changes" } >>template
+
+    <revisions-boilerplate> ;
+
+: <list-changes-feed-action> ( -- action )
+    <feed-action>
+        [ URL" $wiki/changes" ] >>url
+        [ "All changes" ] >>title
+        [ list-changes ] >>entries ;
+
+: <delete-action> ( -- action )
+    <action>
+
+        [ validate-title ] >>validate
+
+        [
+            "title" value <article> delete-tuples
+            f <revision> "title" value >>title delete-tuples
+            URL" $wiki" <redirect>
+        ] >>submit
+
+     <protected>
+        "delete wiki articles" >>description
+        { can-delete-wiki-articles? } >>capabilities ;
+
+: <diff-action> ( -- action )
+    <page-action>
+
+        [
+            {
+                { "old-id" [ v-integer ] }
+                { "new-id" [ v-integer ] }
+            } validate-params
+
+            "old-id" "new-id"
+            [ value <revision> select-tuple ] bi@
+            [
+                over title>> "title" set-value
+                [ "old" [ from-object ] nest-form ]
+                [ "new" [ from-object ] nest-form ]
+                bi*
+            ]
+            [ [ content>> string-lines ] bi@ diff "diff" set-value ]
+            2bi
+        ] >>init
+
+        { wiki "diff" } >>template
+
+    <article-boilerplate> ;
+
+: <list-articles-action> ( -- action )
+    <page-action>
+
+        [
+            f <article> select-tuples
+            [ title>> ] sort-with
+            "articles" set-value
+        ] >>init
+
+        { wiki "articles" } >>template ;
+
+: list-user-edits ( -- seq )
+    f <revision> "author" value >>author select-tuples
+    reverse-chronological-order ;
+
+: <user-edits-action> ( -- action )
+    <page-action>
+
+        "author" >>rest
+
+        [
+            validate-author
+            list-user-edits "revisions" set-value
+        ] >>init
+
+        { wiki "user-edits" } >>template
+
+    <revisions-boilerplate> ;
+
+: <user-edits-feed-action> ( -- action )
+    <feed-action>
+        "author" >>rest
+        [ validate-author ] >>init
+        [ "Edits by " "author" value append ] >>title
+        [ "author" value user-edits-url ] >>url
+        [ list-user-edits ] >>entries ;
+
+: init-sidebars ( -- )
+    "Contents" latest-revision [ "contents" [ from-object ] nest-form ] when*
+    "Footer" latest-revision [ "footer" [ from-object ] nest-form ] when* ;
+
+: init-relative-link-prefix ( -- )
+    URL" $wiki/view/" adjust-url present relative-link-prefix set ;
+
+: <wiki> ( -- dispatcher )
+    wiki new-dispatcher
+        <main-article-action> "" add-responder
+        <view-article-action> "view" add-responder
+        <view-revision-action> "revision" add-responder
+        <random-article-action> "random" add-responder
+        <list-revisions-action> "revisions" add-responder
+        <list-revisions-feed-action> "revisions.atom" add-responder
+        <diff-action> "diff" add-responder
+        <edit-article-action> "edit" add-responder
+        <submit-article-action> "submit" add-responder
+        <rollback-action> "rollback" add-responder
+        <user-edits-action> "user-edits" add-responder
+        <list-articles-action> "articles" add-responder
+        <list-changes-action> "changes" add-responder
+        <user-edits-feed-action> "user-edits.atom" add-responder
+        <list-changes-feed-action> "changes.atom" add-responder
+        <delete-action> "delete" add-responder
+    <boilerplate>
+        [ init-sidebars init-relative-link-prefix ] >>init
+        { wiki "wiki-common" } >>template ;
+
+: init-wiki ( -- )
+    "resource:extra/webapps/wiki/initial-content" [
+        [
+            dup ".txt" ?tail [
+                swap ascii file-contents
+                f <revision>
+                    swap >>content
+                    swap >>title
+                    "slava" >>author
+                    now >>date
+                add-revision
+            ] [ 2drop ] if
+        ] each
+    ] with-directory-files ;
\ No newline at end of file