Wiki
Download
Manual
Eggs
API
Tests
Bugs
show
edit
history
You can edit this page using
wiki syntax
for markup.
Article contents:
== Outdated egg! This is an egg for CHICKEN 3, the unsupported old release. You're almost certainly looking for [[/eggref/4/svnwiki-chicken|the CHICKEN 4 version of this egg]], if it exists. If it does not exist, there may be equivalent functionality provided by another egg; have a look at the [[https://wiki.call-cc.org/chicken-projects/egg-index-4.html|egg index]]. Otherwise, please consider porting this egg to the current version of CHICKEN. [[tags: egg]] == svnwiki-chicken [[toc:]] === Introduction The svnwiki-chicken egg extends [[http://wiki.freaks-unidos.net/svnwiki|Svnwiki]] to provide functionality useful for repositories of Scheme code and documentation about Scheme code such as [[.|The Chicken Wiki]]. === Preamble <enscript highlight=scheme filename='svnwiki-chicken'> ; $id$ ; ; Copyright 2008 Alejandro Forero Cuervo <azul@freaks-unidos.net> ; All Rights Reserved ; ; This code is available under the GPLv3 license. ; ; The authoritative source for this program, where new versions may be ; available, is: ; ; http://wiki.call-cc.org/egg/svnwiki-chicken </enscript> This egg does not export any symbols: <enscript highlight=scheme filename='svnwiki-chicken'> (declare (export)) </enscript> === Dependencies <enscript highlight=scheme filename='svnwiki-chicken'> (use svnwiki-extensions-support svn-post-commit-hooks orders format-modular srfi-40 html-stream stream-ext embedded-test sqlite3 stream-wiki) </enscript> === chickenegg We define a {{chickenegg}} tag, used by the eggs post-commit functionality when building the [[Eggs Unlimited]] wiki pages. The {{chickenegg}} tag expects a set of parameters describing an egg and expands to an HTML row presenting it. <enscript highlight=scheme filename='svnwiki-chicken'> (define *url-eggs* "http://www.call-with-current-continuation.org/eggs/") (define (chickenegg-html env) (let-from-environment env (params parse path-in output-format) (or (and-let* ((eq? output-format 'html) (name-stream (assoc 'name params)) (name (stream->string (cdr name-stream))) (description (assoc 'description params)) (license (assoc 'license params)) (author (assoc 'author params)) (major (assoc 'major params))) (parse (html-stream (tr (td (if (file-exists? (svnwiki-repository-path env name))) (format #f "[[~A]]" name) (if major (format #f "[[~A~A/~A.html|~A]]" *url-eggs* (stream->string (cdr major)) name name) (format #f "[[~A~A.html|~A]]" *url-eggs* name name)))) (td (cdr description)) (td (cdr license)) (td "[[" (cdr author) "]]") (td "[[http://wiki.call-cc.org/dep-graphs/" name ".png|Dependencies]]"))))) stream-null))) (svnwiki-extension-define 'code-break 'chickenegg chickenegg-html) </enscript> It should be noted that the Eggs Unlimited pages should not be commited to the wiki (they are automatically generated), but that's what we have right now. === Definitions We define some markup for definitions documented in a wiki page. The basic usage would be this: <nowiki><procedure>(string-append a b ...)</procedure></nowiki> First we define a function that, given the text inside a definition (eg. “{{(string-append a b ...)}}”), evaluates whether it is a proper list: <enscript highlight=scheme filename='svnwiki-chicken'> (define (definition-list? text) (and (not (stream-null? text)) (char=? (stream-car text) #\() (char=? (stream-last text) #\)) (not (char=? #\) (stream-car (stream-drop-while char-whitespace? (stream-cdr text))))))) </enscript> <enscript highlight="scheme"> (definition-list? (string->stream "(foo)")) => #t (definition-list? (string->stream "(foo bar)")) => #t (definition-list? (string->stream "foo")) => #f (definition-list? (string->stream "( )")) => #f (definition-list? (string->stream "")) => #f </enscript> Based on that, we define a function that, given the text inside a definition, returns the symbol being defined: <enscript highlight=scheme filename='svnwiki-chicken'> (define (get-definition-name text) (stream-take-while (disjoin (complement char-whitespace?) (cut char=? <> #\)) (if (definition-list? text) (stream-cdr (stream-butlast text)) text))) </enscript> <enscript highlight="scheme"> (stream->string (get-definition-name (string->stream "foo"))) => "foo" (stream->string (get-definition-name (string->stream "(foo)"))) => "foo" (stream->string (get-definition-name (string->stream "(foo bar)"))) => "foo" (stream->string (get-definition-name (string->stream "(stream= proc str str ...)"))) => "stream=" </enscript> With all that in place, we create a procedure to handle the definitions. It will be instantiated several types with {{type}} set to the type of definition (eg. “{{procedure}}”). If the output format is the {{scheme-definitions}}, it returns the name and type of the definition. Otherwise, it returns a nice view of the definition. <enscript highlight=scheme filename='svnwiki-chicken'> (define (chicken-def type env) (let-from-environment env (path text parse output-format) ; Remove whitespace at beginning or end (let ((text (stream-reverse (stream-drop-while char-whitespace? (stream-reverse (stream-drop-while char-whitespace? text)))))) (case output-format ((scheme-definitions) (let-from-environment env (return) (return (list type (get-definition-name text)))) stream-null) (else (parse (html-stream ((a name (format #f "xsvnwiki-scheme-~A" (stream->string (get-definition-name text)))) "[" type "] {{" (if (definition-list? text) (receive (name rest) (stream-break char-whitespace? (stream-cdr (stream-butlast text))) (html-stream "('''" name "'''" rest ")")) text) "}}\n\n")))))))) </enscript> Now the actual instantiations, for all the types of definitions we support: <enscript highlight=scheme filename='svnwiki-chicken'> (for-each (lambda (type) (svnwiki-extension-define 'code-span type (cut chicken-def (symbol->string type) <>))) '(procedure macro read parameter record string class method integer constant)) </enscript> === Database ==== Definition We will keep a database as a cache for interesting information found in the wiki. The {{definitions}} table will be used for a list of symbols documented in wiki pages. It has the following attributes: ; name : The name of a symbol. ; type : The type of definition, such as “procedure”, “string”, etc.. The actual list of types will be defined elsewhere. ; page : The path to the page on which it is defined. The {{tests}} table has a list of tests found in the wiki, with the following attributes: ; expr : The Scheme expression that should be evaluated (eg. “{{(string-append "foo" "bar")}}”). ; expect : Another Scheme expression which should evaluate to the expected value (eg. “{{"foobar"}}”). ; cmp : If provided, a Scheme expresion that should evaluate to a procedure of 2 arguments that is used to compare the values that {{expr}} and {{expect}} evaluated to. If empty, {{equal?}} should be used. ; page : The page in the wiki in which the test was found. ; blessed : This will be set to false (the empty string) by default. Once the admin approves a test, he should set it to true (the string "true"). The {{tests_results}} table contains results for the tests. <enscript highlight=scheme filename='svnwiki-chicken'> (define (scheme-definitions-db-create env) (db-run env "CREATE TABLE definitions ( name varchar, type varchar, page varchar );") (db-run env "CREATE TABLE tests ( expr varchar, expect varchar, cmp varchar, page varchar, blessed boolean );") (db-run env "CREATE TABLE tests_results ( version varchar, received varchar, pass boolean, date integer );")) </enscript> ==== Usage Now some support functions for using the database: <enscript highlight=scheme filename='svnwiki-chicken'> (define *db* #f) (define *max-retries* 8) (define (db-run env query . params) (let-from-environment env (data) (unless *db* (let* ((db-path (svnwiki-make-pathname data "scheme-definitions" "db")) (existed (file-exists? db-path))) (format (current-error-port) "Opening DB: ~A~%" db-path) (set! *db* (sqlite3:open db-path)) (unless existed (format (current-error-port) "Creating initial tables in DB: ~A~%" db-path) (scheme-definitions-db-create env)))) (let loop ((attempt 0)) (condition-case (let ((result (iterator->stream (lambda (capture stop) (receive (stmt rest) (sqlite3:prepare *db* query) (apply (stream-wrap-proc-string sqlite3:for-each-row) (compose capture vector) stmt params) (sqlite3:finalize! stmt)))))) (stream-length result) ; force execution result) (e (exn sqlite3) (format (current-error-port) "SQLite error: ~A, attempt ~A~%" ((condition-property-accessor 'sqlite3 'status) e) attempt) (cond ((and (member ((condition-property-accessor 'sqlite3 'status) e) '(locked busy)) (< attempt *max-retries*)) (let ((seconds-wait (expt 2 attempt))) (format (current-error-port) (svnwiki-translate #f "scheme-definitions database locked, attempt #~A, retry in ~A seconds~%") attempt seconds-wait) (sleep seconds-wait)) (loop (+ attempt 1))) (else (signal e)))))))) </enscript> === Examples and tests TODO: Document. <enscript highlight=scheme filename='svnwiki-chicken'> (define (chicken-examples env) (let-from-environment env (params parse text output-format) (let ((filename (assoc 'filename params)) (testgroup (assoc 'testgroup params))) (format (current-error-port) "Tests: [filename:~A][testgroup:~A]~%" (and filename (stream->string (cdr filename))) (and testgroup (stream->string (cdr testgroup)))) (if (or (not (eq? output-format 'enscript)) (and filename testgroup)) (parse (html-stream "Examples:\n\n" "<enscript highlight=scheme" (if (and filename testgroup) (format #f " filename='~A'" (stream->string (stream-remove (cut char=? <> #\') (cdr filename)))) "") ">" (if (and filename testgroup (eq? output-format 'enscript)) (format #f "\n(test-group ~A" (stream->string (cdr testgroup))) "") (parse text) (if (and filename testgroup (eq? output-format 'enscript)) ")\n" "") "</enscript>")) stream-null)))) (define (chicken-example env) (let-from-environment env (text output-format parse) (html-stream (if (eq? output-format 'enscript) "\n (test" "") (parse text) (if (eq? output-format 'enscript) ")" "")))) (define (chicken-expr env) (let-from-environment env (text output-format) (if (eq? output-format 'enscript) (html-stream " " text) (html-stream text "\n")))) (define (chicken-result include prefix env) (let-from-environment env (text output-format) (if (eq? output-format 'enscript) (html-stream " " text) (html-stream prefix " " text "\n")))) (define (chicken-result-cmp env) (let-from-environment env (text output-format) (if (eq? output-format 'enscript) (html-stream " " text) stream-null))) (define (redirect-scheme env) (let-from-environment env (path return) (unless (file-exists? (svnwiki-repository-path env)) (let ((targets (db-run env "SELECT page FROM definitions WHERE name = ?;" path))) (unless (stream-null? targets) (return (format #f "~A#xsvnwiki-scheme-~A" (vector-ref (stream-car targets) 0) path))))))) (svnwiki-extension-define 'redirect 'scheme-definitions redirect-scheme) (svnwiki-extension-define 'code-span 'examples chicken-examples) (svnwiki-extension-define 'code-span 'example chicken-example) ; For the time being, we just ignore these: (svnwiki-extension-define 'code-span 'init (lambda (env) stream-null)) (svnwiki-extension-define 'code-span 'expr chicken-expr) (svnwiki-extension-define 'code-span 'result (cut chicken-result #t "=>" <>)) (svnwiki-extension-define 'code-span 'resultcmp chicken-result-cmp) (svnwiki-extension-define 'code-span 'input (cut chicken-result #f "[input]" <>)) (svnwiki-extension-define 'code-span 'output (cut chicken-result #f "[output]" <>)) </enscript> === Update notify TODO: Get the list of tests and store it in the database. <enscript highlight=scheme filename='svnwiki-chicken'> (define (update-notify-scheme env) (let-from-environment env (path-in path) (format (current-error-port) "Start scheme update: ~A~%" path) (db-run env "DELETE FROM definitions WHERE page = ?;" path) (stream-for-each (lambda (data) (db-run env "INSERT INTO definitions VALUES ( ?, ?, ? );" (cadr data) (car data) path)) (iterator->stream (lambda (return stop) (wiki-extension 'scheme-definitions (wiki-open path-in path) stream-null path (constantly stream-null) (lambda (name tail) tail) (make-hash-table) (environment-capture env (return)))))))) (svnwiki-extension-define 'update-notify-recursive 'scheme-definitions update-notify-scheme) </enscript> === Version history ; 1.0 : First public release.
Description of your changes:
I would like to authenticate
Authentication
Username:
Password:
Spam control
What do you get when you multiply 8 by 5?