#!/usr/bin/env txr @(bind site-dom "rosettacode.org") @(bind site `http://@{site-dom}`) @(bind frame-html "rosetta-solutions.html") @(bind nav-html "rosetta-solutions-nav.html") @(bind main-html "rosetta-solutions-main.html") @(bind solutions "solutions.txt") @(deffilter revert ("_" " ") (":" "/")) @(define text-or-trans (text delim))@\ @(local lang)@\ @(cases)@\ {{trans|@lang}}@\ @(bind text `Translation of @lang`)@\ @(or)@\ @text@(trailer)@delim@\ @(end)@\ @(end) @(define heading (part))@\ @(local text level)@\ @(cases)@\ ====@(text-or-trans text "=")====@/\n?/@\ @(bind level 4)@\ @(or)@\ ===@(text-or-trans text "=")===@/\n?/@\ @(bind level 3)@\ @(or)@\ ==@(text-or-trans text "=")==@/\n?/@\ @(bind level 2)@\ @(end)@\ @(bind part @^(:heading ,level ,text))@\ @(end) @(define lang (part))@\ @(local lang body)@\ @(or)lang=@lang>@(end)@body@\ @(bind part @^(:lang ,lang ,body))@\ @(end) @(define pre (part))@\ @(local body)@\
@body
@\ @(bind part @^(:pre ,(html-encode* body)))@\ @(end) @(define parse-section (section))@\ @(local text desc piece rest lang dat)@\ @(assert)@\ @(cases)@\ @(trailer)-------@(bind section nil)@\ @(or)@\ @(eol)@(bind section nil)@\ @(or)@\ =={{header|TXR}}==@/\n?/@(parse-section section)@\ @(or)@\ @(cases)@\ @(heading piece)@\ @(or)@\ @(lang piece)@\ @(or)@\ @(pre piece)@\ @(or)@\ @\n* @{text /[^\n]*/}@(bind piece @^(:bullet ,text))@\ @(or)@\ {{out}}@/\n?/@(bind piece @^(:heading 5 "Output:"))@\ @(or)@\ {{out|@text}}@/\n?/@(bind piece @^(:heading 5 ,`@text:`))@\ @(or)@\ {{trans|@lang}}@(bind piece @^(:heading 3 ,`Translation of @lang`))@\ @(or)@\ {{@/[^}]*/}}@(bind piece @^(:text ""))@\ @(or)@\ [[http://@{text /[^\s\]]+/} @desc]]@(bind piece @^(:link ,text ,desc))@\ @(or)@\ [[http://@text]]@(bind piece @^(:link ,text))@\ @(or)@\ [[@{text /[^\]]*/}]]@(bind piece @^(:link ,`@{site-dom}/wiki/@text` ,text))@\ @(or)@\ '''@text'''@(bind piece @^(:bold ,text))@\ @(or)@\ ''@text''@(bind piece @^(:ital ,text))@\ @(or)@\ @{text /.[^=<\-{\[\n']*/}@\ @(bind piece @^(:text ,text))@\ @(end)@\ @(parse-section rest)@\ @(bind section @(cons piece rest))@\ @(end)@\ @(maybe)@\ @(bind section nil)@\ @(end)@\ @(end) @(define clean-html (html-in html-out)) @ (next :string html-in) @ (assert) @ (skip)
@  (freeform)
@{html-out}
@(end) @(do (defun colorize (code lang) (set lang (casequal lang ("txrlisp" "tl") (t lang))) (let ((f (open-file `tmp.@lang` "w"))) (put-string code f) (close-stream f)) (sh `./highlight.exp tmp.@lang`) (let ((f (open-file `tmp.@lang.html`))) (prog1 [cat-str (get-lines f) "\n"] (close-stream f)))) (defun clean (code) (let ((result (match-fun 'clean-html ^(,code out) nil nil))) (cdr (assoc 'out (car result))))) (defun do-render (sec) (tree-case sec (((sym arg1 arg2) . rest) (cond ((eq sym :lang) `
\n@(clean (colorize arg2 arg1))\n
\n@(do-render rest)`) ((eq sym :heading) `@arg2\n@(do-render rest)`) ((eq sym :link) `@(html-encode* arg2)\n@(do-render rest)`) (t (error "do-render: bad symbol: ~s\n" sym)))) (((sym arg1) . rest) (cond ((eq sym :pre) `
\n@arg1\n
\n@(do-render rest)`) ((eq sym :text) `@arg1@(do-render rest)`) ((eq sym :ital) `@arg1@(do-render rest)`) ((eq sym :bold) `@arg1@(do-render rest)`) ((eq sym :link) `@(html-encode* arg1)\n@(do-render rest)`) ((eq sym :bullet) `
  • @arg1
  • \n@(do-render rest)`) (t (error "do-render: bad symbol: ~s\n" sym)))) (((sym) . rest) (cond ((eq sym :ul-begin) `\n@(do-render rest)`) (t (error "do-render: bad symbol: ~s\n" sym)))) (() ()) (else (error "do-render: bad input ~s" sec)))) (defun expand-bullets-items (sec) (tree-case sec (((sym arg) . rest) (if (eq sym :bullet) ^((,sym ,arg) . ,(expand-bullets-items rest)) ^((:ul-end) (,sym ,arg) . ,(expand-bullets rest)))) ((first . rest) ^((:ul-end) ,first . ,(expand-bullets rest))) (() '((:ul-end))))) (defun expand-bullets (sec) (tree-case sec (((sym arg) . rest) (if (eq sym :bullet) ^((:ul-begin) . ,(expand-bullets-items sec)) ^((,sym ,arg) . ,(expand-bullets rest)))) ((first . rest) ^(,first . ,(expand-bullets rest))) (() ()))) (defun render-section (sec) (do-render (expand-bullets sec)))) @(output main-html) TXR Examples @(end) @(next solutions) @(collect :vars (toc)) ------- Title: @title Url: @url @ (do (put-line `processing @title`)) @ (trailer) @ (freeform) @ (parse-section section) @ (filter revert title) @ (bind toc `@title
    `) @ (output main-html :append)

    @title

    @ (render-section section) @ (end) @(end) @(output main-html :append) @(end) @(output nav-html) TXR Examples

    TXR Solutions to Rosetta Code Problems

    Click on the small arrow in each title to navigate to the Rosetta Code page which describes the programming problem, and also presents solutions in other languages.

    This page is generated using two TXR programs. The first one pulls the information directly from the Rosetta Code website. The second analyzes the data and generates the HTML. Syntax highlighting is achieved using the Vim text editor, scripted using the via the expect utility.

    @{toc "\n"} @(end) @(output frame-html) TXR Examples @(end) @(do (sh "rm tmp.*"))