packages feed

DisTract (empty) → 0.2.5

raw patch · 58 files changed

+7790/−0 lines, 58 filesdep +Cabaldep +basedep +chunkssetup-changedbinary-added

Dependencies added: Cabal, base, chunks, containers, directory, filepath, hinstaller, old-locale, parsec, pretty, process, template-haskell, time, xhtml

Files

+ DisTract.cabal view
@@ -0,0 +1,99 @@+name:          DisTract+version:       0.2.5+stability:     Alpha+category:      System+copyright:     Matthew Sackman+author:        Matthew Sackman+maintainer:    Matthew Sackman <matthew@wellquite.org>+homepage:      http://distract.wellquite.org/+license:       BSD3+license-file:  LICENSE+build-type:    Simple+Cabal-Version: >= 1.2+Tested-With:   GHC==6.8.2+synopsis:      Distributed Bug Tracking System+description:+              A distributed bug tracker layered on top of Monotone.++data-files: html/lib/desc.png, html/lib/markdown.js, html/lib/arrows.svg,+            html/lib/prototype.js, html/lib/asc.png, html/lib/DisTractBug.js,+            html/lib/sortable.js, html/lib/style.css, html/lib/json.js,+            html/lib/DisTractRun.js, html/lib/unordered.png, html/templates/bugList.html,+            html/templates/fields.html, html/templates/bugView.html, html/templates/bugNew.html,+            scripts/defaultFields/Assigned, scripts/defaultFields/Reporter, scripts/defaultFields/Created+            scripts/defaultFields/Title, scripts/defaultFields/Milestone, scripts/defaultFields/Status, scripts/setup.sh+            scripts/monotonerc, scripts/addCommentToRoot.json, scripts/newBug.json++Library {+        ghc-options:     -Wall -fno-warn-name-shadowing -O2+        build-depends: base, parsec, filepath, chunks >= 2007.4.18, hinstaller >= 2007.5.13,+               xhtml, template-haskell, Cabal >= 1.2, time, old-locale, containers, pretty,+               directory, process+        hs-source-dirs:  src+        exposed-modules: Test,+                          JSON,+                          DisTract.Version, DisTract.IOUtils, DisTract.BugFileInputLoader+                          DisTract.Utils, DisTract.Types,+                          DisTract.HTML.BugList, DisTract.HTML.BugNew, DisTract.HTML.BugView, DisTract.HTML.Fields,+                          DisTract.Monotone.Types, DisTract.Monotone.Parser, DisTract.Monotone.Interaction,+                          DisTract.Bug, DisTract.Bug.PseudoField, DisTract.Bug.Field, DisTract.Bug.Comment,+                          DisTract.JSONUtils, DisTract.Parsers, DisTract.Config,+                          DisTract.Config.Parser, DisTract.Layout+}++executable DisTractNewBug+           main-is: DisTractNewBug.hs+           ghc-options: -Wall -fno-warn-name-shadowing -O2+           hs-source-dirs: src++executable DisTractModifyBug+           main-is: DisTractModifyBug.hs+           ghc-options: -Wall -fno-warn-name-shadowing -O2+           hs-source-dirs: src++executable DisTractUpdateFormatAllBugs+           main-is: DisTractUpdateFormatAllBugs.hs+           ghc-options: -Wall -fno-warn-name-shadowing -O2+           hs-source-dirs: src++executable DisTractUpdateFormatBug+           main-is: DisTractUpdateFormatBug.hs+           ghc-options: -Wall -fno-warn-name-shadowing -O2+           hs-source-dirs: src++executable DisTractFormatNew+           main-is: DisTractFormatNew.hs+           ghc-options: -Wall -fno-warn-name-shadowing -O2+           hs-source-dirs: src++executable DisTractSortBugs+           main-is: DisTractSortBugs.hs+           ghc-options: -Wall -fno-warn-name-shadowing -O2+           hs-source-dirs: src++executable DisTractInstaller+           main-is: DisTractInstaller.hs+           hs-source-dirs: src+           ghc-options: -Wall -fno-warn-name-shadowing+                   -optl hinstaller-tmp/DisTractFormatNew.o+                   -optl hinstaller-tmp/DisTractModifyBug.o+                   -optl hinstaller-tmp/DisTractUpdateFormatAllBugs.o+                   -optl hinstaller-tmp/DisTractUpdateFormatBug.o+                   -optl hinstaller-tmp/DisTractNewBug.o+                   -optl hinstaller-tmp/DisTractSortBugs.o+                   -optl hinstaller-tmp/Milestone.o+                   -optl hinstaller-tmp/Status.o+                   -optl hinstaller-tmp/Title.o+                   -optl hinstaller-tmp/Created.o+                   -optl hinstaller-tmp/Reporter.o+                   -optl hinstaller-tmp/Assigned.o+                   -optl hinstaller-tmp/style.o+                   -optl hinstaller-tmp/prototype.o+                   -optl hinstaller-tmp/markdown.o+                   -optl hinstaller-tmp/json.o+                   -optl hinstaller-tmp/DisTractRun.o+                   -optl hinstaller-tmp/DisTractBug.o+                   -optl hinstaller-tmp/sortable.o+                   -optl hinstaller-tmp/unordered.o+                   -optl hinstaller-tmp/asc.o+                   -optl hinstaller-tmp/desc.o
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+        notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+        copyright notice, this list of conditions and the following+        disclaimer in the documentation and/or other materials+        provided with the distribution.++    * The names of the contributors to this software may not be used+        to endorse or promote products derived from this software+        without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,5 @@+#!/usr/bin/runhaskell++import Distribution.Simple++main = defaultMainWithHooks defaultUserHooks
+ html/lib/DisTractBug.js view
@@ -0,0 +1,99 @@+/*+ * DisTractBug.js+ *     - utils for dealing with bugs+ *+ * Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)+ *+ * DisTract is freely distributable under the terms of a 3-Clause+ * BSD-style license. For details, see the DisTract web site:+ *   http://distract.wellquite.org/+ *+ */++var comments = new Object();+var fields = new Object();+fields.ary = new Array();++function registerComment (commentId, text, date, author) {+    var preamble = "*On " + date + ", " + author + " wrote:*\n\n";+    comments.commentId = preamble + text.replace(/^/mg, '> ') + "\n";+    $(commentId).innerHTML = markdownToHTML(text, []);+    return true;+}++function registerField (name, origValue) {+    var obj = new Object();+    obj.name = name;+    obj.value = origValue;+    fields.ary.push(obj);+    return true;+}++function makeFieldsObject () {+  var result = new Object();+  for (var idx = 0; idx < fields.ary.length; ++idx) {+    var name = fields.ary[idx].name;+    var origVal = fields.ary[idx].value;+    var inputEl = $(name);+    var newVal = origVal;+    if ('text' == inputEl.type) {+      newVal = inputEl.value;+    } else if (undefined !== inputEl.selectedIndex &&+               null != inputEl.selectedIndex) {+      newVal = inputEl[inputEl.selectedIndex].text;+    } else {+      var inputs = inputEl.getElementsByTagName ('input');+      if (undefined !== inputs && null != inputs) {+        for (var i = 0; i < inputs.length; ++i) {+          if (inputs[i].type == 'radio' &&+              inputs[i].name == name &&+              inputs[i].checked) {+            newVal = inputs[i].value;+          }+        }+      }+    }+    if (undefined !== origVal && null != origVal &&+        undefined !== newVal && null != newVal &&+        origVal != newVal) {+      result[name] = newVal;+    }+  }+  return result;+}++function makeCommentsObject () {+  var inReplyTo = $('comment-inReplyTo').value;+  var text = $('comment-textarea').value;+  var obj = new Object();+  if (text.length > 0) {+    obj.text = text;+    obj.inReplyTo = inReplyTo;+  }+  return obj;+}++function appendToReplyFunc (commentTextArea, commentInReplyTo, updateFunc) {+    var func = function (commentId) {+                   var text = comments.commentId;+                   text = $(commentTextArea).value + text;+                   $(commentTextArea).value = text;+                   updateFunc(text);+                   $(commentInReplyTo).value = commentId;+                   return true;+               }+    return func;+}++function updateCommentPreviewFunc (commentPreview) {+    var func = function (text) {+                   $(commentPreview).innerHTML = markdownToHTML(text, []);+                   return true;+               }+    return func;+}++function makeWikiLinkString(name, pages) {+  return name; // no wiki links (yet?)+}+
+ html/lib/DisTractRun.js view
@@ -0,0 +1,128 @@+/*+ * DisTractRun.js+ *     - utils for running the DisTract binaries+ *+ * Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)+ *+ * DisTract is freely distributable under the terms of a 3-Clause+ * BSD-style license. For details, see the DisTract web site:+ *   http://distract.wellquite.org/+ *+ */++function writeToTempFile (text, continuationFunc) {+    try {+        netscape.security.PrivilegeManager.enablePrivilege("UniversalXPConnect");+        var file = Components.classes["@mozilla.org/file/directory_service;1"]+                             .getService(Components.interfaces.nsIProperties)+                             .get("TmpD", Components.interfaces.nsIFile);+        file.append("DisTractTemp.tmp");+        file.createUnique(Components.interfaces.nsIFile.NORMAL_FILE_TYPE, 0600);+        var foStream = Components.classes["@mozilla.org/network/file-output-stream;1"]+                                 .createInstance(Components.interfaces.nsIFileOutputStream);+        foStream.init(file, 0x02 | 0x08 | 0x20, 0664, 0); // write, create, truncate+        foStream.write(text, text.length);+        foStream.close();+        var result = continuationFunc(file);+        file.remove(false); // not recursive+        if (result !== undefined) {+            return result;+        }+        return true;+    } catch (e) {+        alert(e);+        return false;+    }+}++function runProcess (execFilePath, args) {+    try {+        netscape.security.PrivilegeManager.enablePrivilege("UniversalXPConnect");+        // create an nsILocalFile for the executable+        var exeFile = Components.classes["@mozilla.org/file/local;1"]+                                .createInstance(Components.interfaces.nsILocalFile);+        exeFile.initWithPath(execFilePath);++        // create an nsIProcess+        var process = Components.classes["@mozilla.org/process/util;1"]+                                .createInstance(Components.interfaces.nsIProcess);+        process.init(exeFile);++        // Run the process.+        // If first param is true, calling thread will be blocked until+        // called process terminates.+        // Second and third params are used to pass command-line arguments+        // to the process.+        process.run(true, args, args.length);+        return true;+    } catch (e) {+        alert(e);+        return false;+    }+}++function runModifyBugFunc (basePath) {+    var func = function (tempFile) {+                   var args = [basePath, tempFile.path];+                   var exePath = basePath + "/bin/DisTractModifyBug";+                   runProcess(exePath, args);+                   rebuildBugList(basePath);+                   return true;+               }+    return func;+}++function runRebuildBugFunc (basePath) {+    var func = function (bugId, update) {+                   var args = [basePath, bugId, update];+                   var exePath = basePath + "/bin/DisTractUpdateFormatBug";+                   runProcess(exePath, args);+                   rebuildBugList(basePath);+                   return true;+               }+    return func;+}++function runRebuildAllFunc (basePath) {+    var func = function () {+                   var args = [basePath];+                   var exePath = basePath + "/bin/DisTractUpdateFormatAllBugs";+                   runProcess(exePath, args);+                   rebuildBugList(basePath);+                   return true;+               }+    return func;+}++function rebuildBugList (basePath) {+    var args = [basePath];+    var exePath = basePath + "/bin/DisTractSortBugs";+    runProcess(exePath, args);+    return true;+}++function runNewBugFunc (basePath) {+    var func = function (tempFile) {+                   var args = [basePath, tempFile.path];+                   var exePath = basePath + "/bin/DisTractNewBug";+                   runProcess(exePath, args);+                   var bugId = null;+                   var istream = Components.classes["@mozilla.org/network/file-input-stream;1"]+                                           .createInstance(Components.interfaces.nsIFileInputStream);+                   istream.init(tempFile, 0x01, 0400, 0);+                   istream.QueryInterface(Components.interfaces.nsILineInputStream);++                   var line = {};+                   istream.readLine(line);+                   if (null != line.value) {+                       bugId = line.value;+                   }+                   istream.close();++                   rebuildBugList(basePath);++                   return bugId;+               }+    return func;+}+
+ html/lib/arrows.svg view
@@ -0,0 +1,252 @@+<?xml version="1.0" encoding="UTF-8" standalone="no"?>+<!-- Created with Inkscape (http://www.inkscape.org/) -->+<svg+   xmlns:dc="http://purl.org/dc/elements/1.1/"+   xmlns:cc="http://web.resource.org/cc/"+   xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"+   xmlns:svg="http://www.w3.org/2000/svg"+   xmlns="http://www.w3.org/2000/svg"+   xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"+   xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"+   width="744.09448"+   height="1052.3622"+   id="svg2"+   sodipodi:version="0.32"+   inkscape:version="0.45"+   version="1.0"+   sodipodi:docbase="/home/matthew/distract/html/lib"+   sodipodi:docname="arrows.svg"+   inkscape:output_extension="org.inkscape.output.svg.inkscape"+   sodipodi:modified="TRUE">+  <defs+     id="defs4">+    <marker+       inkscape:stockid="TriangleInM"+       orient="auto"+       refY="0.0"+       refX="0.0"+       id="TriangleInM"+       style="overflow:visible">+      <path+         id="path3232"+         d="M 5.77,0.0 L -2.88,5.0 L -2.88,-5.0 L 5.77,0.0 z "+         style="fill-rule:evenodd;stroke:#000000;stroke-width:1.0pt;marker-start:none"+         transform="scale(-0.4)" />+    </marker>+    <marker+       inkscape:stockid="TriangleOutM"+       orient="auto"+       refY="0.0"+       refX="0.0"+       id="TriangleOutM"+       style="overflow:visible">+      <path+         id="path3223"+         d="M 5.77,0.0 L -2.88,5.0 L -2.88,-5.0 L 5.77,0.0 z "+         style="fill-rule:evenodd;stroke:#000000;stroke-width:1.0pt;marker-start:none"+         transform="scale(0.4)" />+    </marker>+  </defs>+  <sodipodi:namedview+     id="base"+     pagecolor="#ffffff"+     bordercolor="#666666"+     borderopacity="1.0"+     gridtolerance="10000"+     guidetolerance="10"+     objecttolerance="10"+     inkscape:pageopacity="0.0"+     inkscape:pageshadow="2"+     inkscape:zoom="0.9350393"+     inkscape:cx="372.04724"+     inkscape:cy="526.18109"+     inkscape:document-units="px"+     inkscape:current-layer="layer1"+     width="744.09449px"+     height="1052.3622px"+     showgrid="true"+     inkscape:grid-points="true"+     inkscape:window-width="1598"+     inkscape:window-height="1198"+     inkscape:window-x="0"+     inkscape:window-y="0" />+  <metadata+     id="metadata7">+    <rdf:RDF>+      <cc:Work+         rdf:about="">+        <dc:format>image/svg+xml</dc:format>+        <dc:type+           rdf:resource="http://purl.org/dc/dcmitype/StillImage" />+      </cc:Work>+    </rdf:RDF>+  </metadata>+  <g+     inkscape:label="Layer 1"+     inkscape:groupmode="layer"+     id="layer1">+    <g+       id="g9515"+       transform="translate(8.2053057,2.0000024)"+       style="fill:#000000;fill-opacity:0.50256413;stroke:#000000;stroke-opacity:0.50256413;opacity:0.5;stroke-width:5.31496063;stroke-miterlimit:4;stroke-dasharray:none;stroke-linejoin:round;stroke-linecap:round"+       inkscape:export-filename="/home/matthew/distract/html/lib/unordered.png"+       inkscape:export-xdpi="29.995619"+       inkscape:export-ydpi="29.995619">+      <g+         id="g9505"+         style="fill:#000000;fill-opacity:0.50256413;stroke:#000000;stroke-opacity:0.50256413;stroke-width:5.31496063;stroke-miterlimit:4;stroke-dasharray:none;stroke-linejoin:round;stroke-linecap:round">+        <path+           sodipodi:type="star"+           style="fill:#000000;fill-opacity:0.50256413;fill-rule:nonzero;stroke:#000000;stroke-width:5.31496063;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:0.50256413;stroke-linecap:round"+           id="path8532"+           sodipodi:sides="3"+           sodipodi:cx="120"+           sodipodi:cy="402.36218"+           sodipodi:r1="12.583173"+           sodipodi:r2="6.2915869"+           sodipodi:arg1="0.52359878"+           sodipodi:arg2="1.5707963"+           inkscape:flatsided="false"+           inkscape:rounded="0"+           inkscape:randomized="0"+           d="M 130.89735,408.65377 L 120,408.65377 L 109.10265,408.65377 L 114.55133,399.21639 L 120,389.77901 L 125.44867,399.21639 L 130.89735,408.65377 z " />+        <path+           style="fill:#000000;fill-opacity:0.50256413;fill-rule:evenodd;stroke:#000000;stroke-width:5.31496063;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:0.50256413"+           d="M 120,432.36218 L 120,402.36218"+           id="path8534" />+      </g>+      <g+         transform="matrix(1,0,0,-1,20.897347,830.14119)"+         id="g9509"+         style="fill:#000000;fill-opacity:0.50256413;stroke:#000000;stroke-opacity:0.50256413;stroke-width:5.31496063;stroke-miterlimit:4;stroke-dasharray:none;stroke-linejoin:round;stroke-linecap:round">+        <path+           sodipodi:type="star"+           style="fill:#000000;fill-opacity:0.50256413;fill-rule:nonzero;stroke:#000000;stroke-width:5.31496063;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:0.50256413;stroke-linecap:round"+           id="path9511"+           sodipodi:sides="3"+           sodipodi:cx="120"+           sodipodi:cy="402.36218"+           sodipodi:r1="12.583173"+           sodipodi:r2="6.2915869"+           sodipodi:arg1="0.52359878"+           sodipodi:arg2="1.5707963"+           inkscape:flatsided="false"+           inkscape:rounded="0"+           inkscape:randomized="0"+           d="M 130.89735,408.65377 L 120,408.65377 L 109.10265,408.65377 L 114.55133,399.21639 L 120,389.77901 L 125.44867,399.21639 L 130.89735,408.65377 z " />+        <path+           style="fill:#000000;fill-opacity:0.50256413;fill-rule:evenodd;stroke:#000000;stroke-width:5.31496063;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:0.50256413"+           d="M 120,432.36218 L 120,402.36218"+           id="path9513" />+      </g>+    </g>+    <g+       id="g18292"+       inkscape:export-filename="/home/matthew/distract/html/lib/asc.png"+       inkscape:export-xdpi="30"+       inkscape:export-ydpi="30">+      <g+         style="fill:#410000;fill-opacity:1;stroke:#410000;stroke-opacity:1;stroke-width:5.31496063;stroke-miterlimit:4;stroke-dasharray:none;stroke-linejoin:miter;stroke-linecap:round"+         transform="translate(70.897347,2.5831728)"+         id="g9525">+        <path+           sodipodi:type="star"+           style="fill:#410000;fill-opacity:1;fill-rule:nonzero;stroke:#410000;stroke-width:5.31496063;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;stroke-linecap:round"+           id="path9527"+           sodipodi:sides="3"+           sodipodi:cx="120"+           sodipodi:cy="402.36218"+           sodipodi:r1="12.583173"+           sodipodi:r2="6.2915869"+           sodipodi:arg1="0.52359878"+           sodipodi:arg2="1.5707963"+           inkscape:flatsided="false"+           inkscape:rounded="0"+           inkscape:randomized="0"+           d="M 130.89735,408.65377 L 120,408.65377 L 109.10265,408.65377 L 114.55133,399.21639 L 120,389.77901 L 125.44867,399.21639 L 130.89735,408.65377 z " />+        <path+           style="fill:#410000;fill-opacity:1;fill-rule:evenodd;stroke:#410000;stroke-width:5.31496063;stroke-linecap:round;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"+           d="M 120,432.36218 L 120,402.36218"+           id="path9529" />+      </g>+      <g+         style="fill:#000000;fill-opacity:0.50256413;opacity:0.5;stroke:#000000;stroke-opacity:0.50256413;stroke-width:5.31496063;stroke-miterlimit:4;stroke-dasharray:none;stroke-linejoin:round;stroke-linecap:round"+         transform="matrix(1,0,0,-1,91.794694,832.72436)"+         id="g9531">+        <path+           sodipodi:type="star"+           style="fill:#000000;fill-opacity:0.50256413;fill-rule:nonzero;stroke:#000000;stroke-width:5.31496063;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:0.50256413;stroke-linecap:round"+           id="path9533"+           sodipodi:sides="3"+           sodipodi:cx="120"+           sodipodi:cy="402.36218"+           sodipodi:r1="12.583173"+           sodipodi:r2="6.2915869"+           sodipodi:arg1="0.52359878"+           sodipodi:arg2="1.5707963"+           inkscape:flatsided="false"+           inkscape:rounded="0"+           inkscape:randomized="0"+           d="M 130.89735,408.65377 L 120,408.65377 L 109.10265,408.65377 L 114.55133,399.21639 L 120,389.77901 L 125.44867,399.21639 L 130.89735,408.65377 z " />+        <path+           style="fill:#000000;fill-opacity:0.50256413;fill-rule:evenodd;stroke:#000000;stroke-width:5.31496063;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:0.50256413"+           d="M 120,432.36218 L 120,402.36218"+           id="path9535" />+      </g>+    </g>+    <g+       id="g18284"+       inkscape:export-filename="/home/matthew/distract/html/lib/desc.png"+       inkscape:export-xdpi="30"+       inkscape:export-ydpi="30">+      <g+         style="fill:#000000;fill-opacity:0.50256413;stroke:#000000;stroke-opacity:0.50196081;opacity:0.5;stroke-width:5.31496063;stroke-miterlimit:4;stroke-dasharray:none;stroke-linejoin:round;stroke-linecap:round"+         transform="translate(128.20531,2.5831728)"+         id="g9539">+        <path+           sodipodi:type="star"+           style="fill:#000000;fill-opacity:0.50256413;fill-rule:nonzero;stroke:#000000;stroke-width:5.31496063;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:0.50196081;stroke-linecap:round"+           id="path9541"+           sodipodi:sides="3"+           sodipodi:cx="120"+           sodipodi:cy="402.36218"+           sodipodi:r1="12.583173"+           sodipodi:r2="6.2915869"+           sodipodi:arg1="0.52359878"+           sodipodi:arg2="1.5707963"+           inkscape:flatsided="false"+           inkscape:rounded="0"+           inkscape:randomized="0"+           d="M 130.89735,408.65377 L 120,408.65377 L 109.10265,408.65377 L 114.55133,399.21639 L 120,389.77901 L 125.44867,399.21639 L 130.89735,408.65377 z " />+        <path+           style="fill:#000000;fill-opacity:0.50256413;fill-rule:evenodd;stroke:#000000;stroke-width:5.31496063;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:0.50196081"+           d="M 120,432.36218 L 120,402.36218"+           id="path9543" />+      </g>+      <g+         style="fill:#410000;fill-opacity:1;stroke:#410000;stroke-opacity:1;stroke-width:5.31496063;stroke-miterlimit:4;stroke-dasharray:none;stroke-linejoin:miter;stroke-linecap:round"+         transform="matrix(1,0,0,-1,149.10266,832.72436)"+         id="g9545">+        <path+           sodipodi:type="star"+           style="fill:#410000;fill-opacity:1;fill-rule:nonzero;stroke:#410000;stroke-width:5.31496063;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1;stroke-linecap:round"+           id="path9547"+           sodipodi:sides="3"+           sodipodi:cx="120"+           sodipodi:cy="402.36218"+           sodipodi:r1="12.583173"+           sodipodi:r2="6.2915869"+           sodipodi:arg1="0.52359878"+           sodipodi:arg2="1.5707963"+           inkscape:flatsided="false"+           inkscape:rounded="0"+           inkscape:randomized="0"+           d="M 130.89735,408.65377 L 120,408.65377 L 109.10265,408.65377 L 114.55133,399.21639 L 120,389.77901 L 125.44867,399.21639 L 130.89735,408.65377 z " />+        <path+           style="fill:#410000;fill-opacity:1;fill-rule:evenodd;stroke:#410000;stroke-width:5.31496063;stroke-linecap:round;stroke-linejoin:miter;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"+           d="M 120,432.36218 L 120,402.36218"+           id="path9549" />+      </g>+    </g>+  </g>+</svg>
+ html/lib/asc.png view

binary file changed (absent → 512 bytes)

+ html/lib/desc.png view

binary file changed (absent → 495 bytes)

+ html/lib/json.js view
@@ -0,0 +1,120 @@+/*+    json.js+    2006-04-28++    This file adds these methods to JavaScript:++        object.toJSONString()++            This method produces a JSON text from an object. The+            object must not contain any cyclical references.++        array.toJSONString()++            This method produces a JSON text from an array. The+            array must not contain any cyclical references.++        string.parseJSON()++            This method parses a JSON text to produce an object or+            array. It will return false if there is an error.+*/+(function () {+    var m = {+            '\b': '\\b',+            '\t': '\\t',+            '\n': '\\n',+            '\f': '\\f',+            '\r': '\\r',+            '"' : '\\"',+            '\\': '\\\\'+        },+        s = {+            array: function (x) {+                var a = ['['], b, f, i, l = x.length, v;+                for (i = 0; i < l; i += 1) {+                    v = x[i];+                    f = s[typeof v];+                    if (f) {+                        v = f(v);+                        if (typeof v == 'string') {+                            if (b) {+                                a[a.length] = ',';+                            }+                            a[a.length] = v;+                            b = true;+                        }+                    }+                }+                a[a.length] = ']';+                return a.join('');+            },+            'boolean': function (x) {+                return String(x);+            },+            'null': function (x) {+                return "null";+            },+            number: function (x) {+                return isFinite(x) ? String(x) : 'null';+            },+            object: function (x) {+                if (x) {+                    if (x instanceof Array) {+                        return s.array(x);+                    }+                    var a = ['{'], b, f, i, v;+                    for (i in x) {+                        v = x[i];+                        f = s[typeof v];+                        if (f) {+                            v = f(v);+                            if (typeof v == 'string') {+                                if (b) {+                                    a[a.length] = ',';+                                }+                                a.push(s.string(i), ':', v);+                                b = true;+                            }+                        }+                    }+                    a[a.length] = '}';+                    return a.join('');+                }+                return 'null';+            },+            string: function (x) {+                if (/["\\\x00-\x1f]/.test(x)) {+                    x = x.replace(/([\x00-\x1f\\"])/g, function(a, b) {+                        var c = m[b];+                        if (c) {+                            return c;+                        }+                        c = b.charCodeAt();+                        return '\\u00' ++                            Math.floor(c / 16).toString(16) ++                            (c % 16).toString(16);+                    });+                }+                return '"' + x + '"';+            }+        };++    Object.prototype.toJSONString = function () {+        return s.object(this);+    };++    Array.prototype.toJSONString = function () {+        return s.array(this);+    };+})();++String.prototype.parseJSON = function () {+    try {+        return !(/[^,:{}\[\]0-9.\-+Eaeflnr-u \n\r\t]/.test(+                this.replace(/"(\\.|[^"\\])*"/g, ''))) &&+            eval('(' + this + ')');+    } catch (e) {+        return false;+    }+};
+ html/lib/markdown.js view
@@ -0,0 +1,525 @@+/*+ * markdown.js+ *     - an javascript implementation of the "markdown" markup syntax+ *+ * Copyright (c) 2006, 2007, Matthew Sackman (matthew@wellquite.org)+ *+ * DisTract is freely distributable under the terms of a 3-Clause+ * BSD-style license. For details, see the DisTract web site:+ *   http://distract.wellquite.org/+ *+ */++function markdownToHTML(text, pages) {+  var formatter = buildFormatter();+  formatter.knownPages = pages;+  var result = formatter.format(text);+  result = doRefLinksSubstitutions(result, formatter.linkRefs);+  result = doRefImgsSubstitutions(result, formatter.imgRefs);+  return result;+}++function doRefLinksSubstitutions(text, links) {+  var swap = function(linkObj, _idx, _ary) {+    var reString = '(?:\\[(' + linkObj.id + ')\\][ \\t]*\\[\\])|(?:\\[([^\\]]+)\\][ \\t]*\\[' + linkObj.id + '\\])';+    var re = new RegExp(reString, 'gi');+    text = text.replace(re,+                        function(_matched, id1, linkText, _str, _offset) {+                          var linkText = linkText ? linkText : id1;+                          var title = linkObj.title ? ' title="' + linkObj.title + '"' : '';+                          return '<a href="' + linkObj.url + '"' + title + '>' + linkText + '</a>';+                        }+                       );+  };+  links.forEach(swap);+  return text;+}++function doRefImgsSubstitutions(text, imgs) {+  var swap = function(linkObj, _idx, _ary) {+    var reString = '!(?:(?:\\[(' + linkObj.id + ')\\][ \\t]*\\[\\])|(?:\\[([^\\]]+)\\][ \\t]*\\[' + linkObj.id + '\\]))';+    var re = new RegExp(reString, 'gi');+    text = text.replace(re,+                        function(_matched, id1, altText, _str, _offset) {+                          var altText = altText ? altText : id1;+                          var title = linkObj.title ? ' title="' + linkObj.title + '"' : '';+                          return '<img src="' + linkObj.url + '"' + title + ' alt="' + altText + '" />';+                        }+                       );+  };+  imgs.forEach(swap);+  return text;+}++function buildFormatterClone(formatter) {+  var formatterClone = buildFormatter();+  formatterClone.wrapRemainingInParaOrig = formatter.wrapRemainingInParaOrig;+  formatterClone.knownPages = formatter.knownPages;+  formatterClone.linkRefs = formatter.linkRefs;+  formatterClone.imgRefs = formatter.imgRefs;+  return formatterClone;+}++function buildFormatter() {+  var formatter = new Object();+  formatter.wrapRemainingInParaOrig = true;++  formatter.linkRefs = new Array();+  formatter.imgRefs = new Array();++  formatter.paraSplitters = new Array();+  formatter.paraSplitters.push(getSimpleParaSplitter());++  formatter.blockFormatters = new Array();+  formatter.blockFormatters.push(getBlockHeadersUnderline());+  formatter.blockFormatters.push(getBlockHeadersHash());+  formatter.blockFormatters.push(getBlockHR());+  formatter.blockFormatters.push(getBlockCoder());+  formatter.blockFormatters.push(getBlockQuoter());+  formatter.blockFormatters.push(getBlockLister());++  formatter.spanFormatters = new Array();+  formatter.spanFormatters.push(getSpanReferenceSlurper());+  formatter.spanFormatters.push(getSpanCode());+  formatter.spanFormatters.push(getSpanWikiLinker());+  formatter.spanFormatters.push(getSpanImager());+  formatter.spanFormatters.push(getSpanLinker());+  formatter.spanFormatters.push(getSpanBR());+  formatter.spanFormatters.push(getSpanBoldItalic());+  formatter.spanFormatters.push(getSpanAutoLinks());++  formatter.invokeNextBlockFormatter = getNextBlockFun(formatter);+  formatter.invokeNextSpanFormatter = getNextSpanFun(formatter);+  formatter.format = getFormatFun(formatter);++  return formatter;+}++function encodeAmpsAngles(text) {+  return text.replace(/&/g, "&amp;").replace(/</g, "&lt;").replace(/>/g, "&gt;");+}++function getNextBlockFun(formatter) {+  return function() {+    if (1 + formatter.blockIdx >= formatter.blockFormatters.length) {+      formatter.invokeNextSpanFormatter();+    } else {+      formatter.blockIdx++;+      var formatterFun = formatter.blockFormatters[formatter.blockIdx];+      formatterFun(formatter);+    }+  };+}++function getNextSpanFun(formatter) {+  return function() {+    if (1 + formatter.spanIdx >= formatter.spanFormatters.length) {+      return;+    } else {+      formatter.spanIdx++;+      var formatterFun = formatter.spanFormatters[formatter.spanIdx];+      formatterFun(formatter);+    }+  };+}++function getFormatFun(formatter) {+  return function(text) {+    if (! text) {+      return '';+    }+    formatter.wrapRemainingInPara = formatter.wrapRemainingInParaOrig;+    formatter.remaining = text;+    var paraFun = formatter.paraSplitters[formatter.paraSplitters.length - 1];+    paraFun(formatter);++    formatter.unitDone = new Array();+    formatter.blockIdx = -1;+    formatter.spanIdx = -1;++    formatter.invokeNextBlockFormatter();++    if (formatter.unit) {+      if (formatter.wrapRemainingInPara) {+        formatter.unitDone.push('<p>' + formatter.unit + '</p>');+      } else {+        formatter.unitDone.push(formatter.unit);+      }+      formatter.unit = '';+    }+    var result = formatter.unitDone.join('\n');++    if (formatter.remaining) {+      result += '\n' + formatter.format(formatter.remaining);+    }+    return result;+  };+}++function getSimpleParaSplitter() {+  return function(state) {+    var text = state.remaining;+    if (undefined != text && null != text) {+      text = text.replace(/^([ \t]*\n)+/g, '');+      var matches = text.match(/^((?:.+\n)*.+)(?:$|(?:(?:\n)(?:[ \t]*\n)+))((?:.|\n)*)/);+      if (matches) {+        state.unit = matches[1];+        state.remaining = matches[2] ? matches[2] : '';+      } else {+        state.unit = text;+        state.remaining = '';+      }+    } else {+      alert("Unable to split text into paragraphs:\n'" + text + "'");+    }+    return state;+  };+}++function getBlockQuoter() {+  return function(state) {+    if (/^>[ \t]?/.test(state.unit)) {+      var inner = state.unit.replace(/^>[ \t]?/mg, '');+      var formatter = buildFormatterClone(state);+      formatter.wrapRemainingInParaOrig = true;+      state.unitDone.push('<blockquote>' + formatter.format(inner) + '</blockquote>');+      state.unit = '';+    } else {+      state.invokeNextBlockFormatter();+    }+  };+}++function getBlockCoder() {+  return function(state) {+    if (/^(?:(?:    )|\t)/.test(state.unit)) {+      var matches = state.unit.match(/^((?:(?:(?:    )|\t)(?:.*)(?:\n(?=(    )|\t))?)+)((?:.|\n)*)$/);+      if (matches) {+        var code = matches[1].replace(/^(?:(?:    )|\t)/mg, '');+        state.unitDone.push('<pre><code>' + encodeAmpsAngles(code) + '</pre></code>');+        var formatter = buildFormatterClone(state);+        state.unitDone.push(formatter.format(matches[2]));+        state.unit = '';+      } else {+        alert('Error on code block parser: ' + state.unit);+      }+    }+    state.invokeNextBlockFormatter();+  };+}++function getBlockLister() {+  return function(state) {+    var testerRe = /^(?:(?:\d+\.)|(?:[\+\*\-]))(?: |\t)+/;+    if (state.inList) {+      testerRe = /^(?:(?:\d+\.)|(?:[\+\*\-]))(?: |\t)+/m;+    }+    if (testerRe.test(state.unit)) {++      var innerFormatter = buildFormatterClone(state);+      innerFormatter.inList = false;++      state.unit.replace(testerRe,+                         function(all, offset, _str) {+                           var pre = state.unit.substr(0, offset);+                           if (pre) {+                             state.unitDone.push(innerFormatter.format(pre));+                             state.unit = state.unit.substr(offset);+                           }+                         }+                        );++      innerFormatter.inList = true;+      var listEnd = '';+      var listChar = '';+      if (/^(?:\d+\.)/.test(state.unit)) {+        state.unitDone.push('<ol>');+        listEnd = '</ol>';+        testerRe = /^(?:\d+\.)(?: |\t)+/;+        if (state.inList) {+          testerRe = /^(?:\d+\.)(?: |\t)+/m;+        }+        listChar = "\\d+\\.";+      } else {+        state.unitDone.push('<ul>');+        listEnd = '</ul>';+        var char = /^(.)/.exec(state.unit)[0];+        testerRe = new RegExp("^(?:[" + char + "])(?: |\\t)+", '');+        if (state.inList) {+          testerRe = new RegExp("^(?:[" + char + "])(?: |\\t)+", 'm');+        }+        listChar = "[" + char + "]";+      }++      var paraSplitter = getSimpleParaSplitter();+      var listElems = new Array();++      var innerParaRe = /^(?:(?:    )|\t)/;+      var nextParaObject = new Object();+      nextParaObject.unit = state.unit;+      nextParaObject.remaining = state.remaining;++      do {+        var elem = nextParaObject.unit;+        paraSplitter(nextParaObject);++        while (innerParaRe.test(nextParaObject.unit)) {+          elem += '\n\n' + nextParaObject.unit;+          paraSplitter(nextParaObject);+        }+        listElems.push(elem);+      } while (testerRe.test(nextParaObject.unit));++      state.unit = '';+      var extra = nextParaObject.unit ? nextParaObject.unit + '\n\n' : '';+      state.remaining = extra + nextParaObject.remaining;++      var formatFunction = function(e, _idx, _ary) {+        innerFormatter.wrapRemainingInParaOrig = /^$\n[ \t]*\S+/m.test(e);+        state.unitDone.push('<li>' + innerFormatter.format(e) + '</li>');+      };++      for (var idx = 0; idx < listElems.length; ++idx) {+        var allListItems = new Array();+        var leftOver = explodeListPara(listChar, listElems[idx], allListItems);++        if (idx + 1 < listElems.length) {+          // there's another para so the last list in this para is a p+          var lastItem = allListItems.pop();+          allListItems.forEach(formatFunction);+          innerFormatter.wrapRemainingInParaOrig = true;+          state.unitDone.push('<li>' + innerFormatter.format(lastItem) + '</li>');+        } else {+          // we're on the last para+          if (listElems.length == 1) {+            // if only para then all not p+            allListItems.forEach(formatFunction);++          } else {+            // if more than 1 elem then first is p, rest aren't else p+            var firstItem = allListItems.shift();+            innerFormatter.wrapRemainingInParaOrig = true;+            state.unitDone.push('<li>' + innerFormatter.format(firstItem) + '</li>');+            +            allListItems.forEach(formatFunction);+          }+        }++        if (leftOver) {+          var remaining = leftOver;+          if (idx + 1 < listElems.length) {+            remaining = remaining + "\n\n" + (listElems.slice(idx + 1).join("\n\n"));+            idx = listElems.length;+          }+          state.remaining = remaining + (state.remaining ? "\n\n" + state.remaining : '');+        }+          +      }++      state.unitDone.push(listEnd);+++    } else {+      state.invokeNextBlockFormatter();+    }+  };+}++function explodeListPara(char, text, ary) {+  var re = new RegExp("^(?:[ \\t]*\\n*)(?:(?:" + char + ")[ \\t]+)((?:.+|\\n(?!((\\d+\\.)|([\\+\\*\\-]))))*)", '');+  var simpleItem = null;+  while (simpleItem = re.exec(text)) {+    var item = simpleItem[1].replace(/^(?:(?:    )|\t)/gm, '');+    ary.push(item);+    text = text.substr(simpleItem[0].length);+  }+  return text;+}++function getBlockHeadersHash() {+  return function(state) {+    if (/^#{1,6}( |\t)*(.+)/m.test(state.unit)) {+      state.unit.replace(/^(#{1,6})(?: |\t)*(.+)(?: |\t)*(?:#{0,6})(?: |\t)*$/m,+                         function(all, g1, g2, offset, _str) {+                           var pre = state.unit.substr(0, offset);+                           var post = state.unit.substr(offset + all.length);+                           var header = '<h' + g1.length + '>' + g2 + '</h' + g1.length + '>';+                           var innerFormatter = buildFormatterClone(state);+                           if (pre) {+                             state.unitDone.push(innerFormatter.format(pre));+                           }+                           innerFormatter.wrapRemainingInParaOrig = false;+                           state.unitDone.push(innerFormatter.format(header));+                           if (post) {+                             state.remaining = post + '\n\n' + state.remaining;+                           }+                           state.unit = '';+                         }+                        );++    } else {+      state.invokeNextBlockFormatter();+    }+  };+}++function getBlockHeadersUnderline() {+  return function(state) {+    if (/^(?: |\t)*(.+?)(?: |\t)*\n(=+|-+)(?: |\t)*$/m.test(state.unit)) {+      state.unit.replace(/^(?: |\t)*(.+?)(?: |\t)*\n(=+|-+)(?: |\t)*$/m,+                         function(all, g1, g2, offset, _str) {+                           var pre = state.unit.substr(0, offset);+                           var post = state.unit.substr(offset + all.length);+                           var number = g1.match(/^=/) ? 1 : 2;+                           var header = '<h' + number + '>' + g1 + '</h' + number + '>';+                           var innerFormatter = buildFormatterClone(state);+                           if (pre) {+                             state.unitDone.push(innerFormatter.format(pre));+                           }+                           innerFormatter.wrapRemainingInParaOrig = false;+                           state.unitDone.push(innerFormatter.format(header));+                           if (post) {+                             state.remaining = post + '\n\n' + state.remaining;+                           }+                           state.unit = '';+                         }+                        );+    } else {+      state.invokeNextBlockFormatter();+    }+  }+}++function getBlockHR() {+  return function(state) {+    if (/^((( |\t)*\*){3,}( |\t)*)|((( |\t)*-){3,}( |\t)*)$/m.test(state.unit)) {+       state.unit.replace(/^(?:(?:(?: |\t)*\*){3,}(?: |\t)*)|(?:(?:(?: |\t)*-){3,}(?: |\t)*)$/m,+                         function(all, offset, _str) {+                           var pre = state.unit.substr(0, offset);+                           var post = state.unit.substr(offset + all.length);+                           var innerFormatter = buildFormatterClone(state);+                           if (pre) {+                             state.unitDone.push(innerFormatter.format(pre));+                           }+                           state.unitDone.push('<hr />');+                           if (post) {+                             state.remaining = post + '\n\n' + state.remaining;+                           }+                           state.unit = '';+                         }+                        );+    } else {+      state.invokeNextBlockFormatter();+    }+  };+}++function getSpanWikiLinker() {+  return function (state) {+    state.unit = state.unit.replace(/\b[A-Z][^ ]*[a-z][A-Z][^ ]*\b/g,+                                    function(matched, _str, _offset) {+                                      return makeWikiLinkString(matched, state.knownPages);+                                    }+                                   );+    state.invokeNextSpanFormatter();+  };+}++function getSpanLinker() {+  return function(state) {+    state.unit = state.unit.replace(/\[([^\]]+)\]\(([^)]+)\)/g,+                                    function(_matched, g1, g2, _str, _offset) {+                                      var title = g2.match(/ "([^"]+)"\s*$/);+                                      if (null == title || 0 == title.length) {+                                        return '<a href="' + g2 + '">' + g1 + '</a>';+                                      } else {+                                        var href = g2.match(/^(.+) "([^"]+)"\s*$/)[1];+                                        title = title[1];+                                        return '<a href="' + href + '" title="' + title + '">' + g1 + '</a>';+                                      }+                                    }+                                   );+    state.invokeNextSpanFormatter();+  };+}++function getSpanImager() {+  return function(state) {+    state.unit = state.unit.replace(/!\[([^\]]*)\]\(([^)]+)\)/g,+                                    function(_matched, g1, g2, _str, _offset) {+                                      var title = g2.match(/ "([^"]+)"\s*$/);+                                      if (null == title || 0 == title.length) {+                                        return '<img src="' + g2 + '" alt="' + g1 + '" />';+                                      } else {+                                        var href = g2.match(/^(.+) "([^"]+)"\s*$/)[1];+                                        title = title[1];+                                        return '<img src="' + href + '" title="' + title + '" alt="' + g1 + '" />';+                                      }+                                    }+                                   );+    state.invokeNextSpanFormatter();+  };+}++function getSpanBR() {+  return function (state) {+    state.unit = state.unit.replace(/\s{2,}$/mg, '<br />');+    state.invokeNextSpanFormatter();+  };+}++function getSpanBoldItalic() {+  return function (state) {+    var text = state.unit;+    text = text.replace(/(__)(.+?)(__)/g, "<strong>$2</strong>");+    text = text.replace(/(\*\*)(.+?)(\*\*)/g, "<strong>$2</strong>");++    text = text.replace(/(_)(.+?)(_)/g, "<em>$2</em>");+    text = text.replace(/(\*)(.+?)(\*)/g, "<em>$2</em>");++    state.unit = text;+    state.invokeNextSpanFormatter();+  };+}++function getSpanCode() {+  return function (state) {+    state.unit = state.unit.replace(/(`+)((?:.|[\n\r])+?)\1/g,+                                    function(_matched, _g1, g2, _str, _offset) {+                                      return "<code>" + encodeAmpsAngles(g2) + "</code>";+                                    }+                                   );+    state.invokeNextSpanFormatter();+  };+}++function getSpanAutoLinks() {+  return function (state) {+    state.unit = state.unit.replace(/<([^ @\f\n\r\t]+?@[^ @\f\n\r\t]+?)>/g,+                                    '<a href="mailto:$1">$1</a>');+    state.unit = state.unit.replace(/<((?:http(?:s)?|ftp|gopher):\/\/[^ \f\n\r\t]+)>/g,+                                    '<a href="$1">$1</a>');+    state.invokeNextSpanFormatter();+  };+}++function getSpanReferenceSlurper() {+  return function(state) {+    state.unit = state.unit.replace(/^[ \t]*(!?)\[([^\]]+)\]:[ \t]+<?([^ \f\n\r\t]+)>?(?:[ \t]+(?:\n[ \t]*)?(?:(?:(["'])(.+)\4)|(?:\((.+)\))))?[ \t]*$\n?/mg,+                                    function(_matched, bang, id, url, _sep, title1, title2, _str, _offset) {+                                      var title = title1 ? title1 : title2;+                                      var linkObj = new Object();+                                      linkObj.title = title;+                                      linkObj.url = url;+                                      linkObj.id = id;+                                      if (bang) {+                                        state.imgRefs.push(linkObj);+                                      } else {+                                        state.linkRefs.push(linkObj);+                                      }+                                      return '';+                                    }+                                   );+    state.invokeNextSpanFormatter();+  };+}
+ html/lib/prototype.js view
@@ -0,0 +1,2515 @@+/*  Prototype JavaScript framework, version 1.5.0+ *  (c) 2005-2007 Sam Stephenson+ *+ *  Prototype is freely distributable under the terms of an MIT-style license.+ *  For details, see the Prototype web site: http://prototype.conio.net/+ *+/*--------------------------------------------------------------------------*/++var Prototype = {+  Version: '1.5.0',+  BrowserFeatures: {+    XPath: !!document.evaluate+  },++  ScriptFragment: '(?:<script.*?>)((\n|\r|.)*?)(?:<\/script>)',+  emptyFunction: function() {},+  K: function(x) { return x }+}++var Class = {+  create: function() {+    return function() {+      this.initialize.apply(this, arguments);+    }+  }+}++var Abstract = new Object();++Object.extend = function(destination, source) {+  for (var property in source) {+    destination[property] = source[property];+  }+  return destination;+}++Object.extend(Object, {+  inspect: function(object) {+    try {+      if (object === undefined) return 'undefined';+      if (object === null) return 'null';+      return object.inspect ? object.inspect() : object.toString();+    } catch (e) {+      if (e instanceof RangeError) return '...';+      throw e;+    }+  },++  keys: function(object) {+    var keys = [];+    for (var property in object)+      keys.push(property);+    return keys;+  },++  values: function(object) {+    var values = [];+    for (var property in object)+      values.push(object[property]);+    return values;+  },++  clone: function(object) {+    return Object.extend({}, object);+  }+});++Function.prototype.bind = function() {+  var __method = this, args = $A(arguments), object = args.shift();+  return function() {+    return __method.apply(object, args.concat($A(arguments)));+  }+}++Function.prototype.bindAsEventListener = function(object) {+  var __method = this, args = $A(arguments), object = args.shift();+  return function(event) {+    return __method.apply(object, [( event || window.event)].concat(args).concat($A(arguments)));+  }+}++Object.extend(Number.prototype, {+  toColorPart: function() {+    var digits = this.toString(16);+    if (this < 16) return '0' + digits;+    return digits;+  },++  succ: function() {+    return this + 1;+  },++  times: function(iterator) {+    $R(0, this, true).each(iterator);+    return this;+  }+});++var Try = {+  these: function() {+    var returnValue;++    for (var i = 0, length = arguments.length; i < length; i++) {+      var lambda = arguments[i];+      try {+        returnValue = lambda();+        break;+      } catch (e) {}+    }++    return returnValue;+  }+}++/*--------------------------------------------------------------------------*/++var PeriodicalExecuter = Class.create();+PeriodicalExecuter.prototype = {+  initialize: function(callback, frequency) {+    this.callback = callback;+    this.frequency = frequency;+    this.currentlyExecuting = false;++    this.registerCallback();+  },++  registerCallback: function() {+    this.timer = setInterval(this.onTimerEvent.bind(this), this.frequency * 1000);+  },++  stop: function() {+    if (!this.timer) return;+    clearInterval(this.timer);+    this.timer = null;+  },++  onTimerEvent: function() {+    if (!this.currentlyExecuting) {+      try {+        this.currentlyExecuting = true;+        this.callback(this);+      } finally {+        this.currentlyExecuting = false;+      }+    }+  }+}+String.interpret = function(value){+  return value == null ? '' : String(value);+}++Object.extend(String.prototype, {+  gsub: function(pattern, replacement) {+    var result = '', source = this, match;+    replacement = arguments.callee.prepareReplacement(replacement);++    while (source.length > 0) {+      if (match = source.match(pattern)) {+        result += source.slice(0, match.index);+        result += String.interpret(replacement(match));+        source  = source.slice(match.index + match[0].length);+      } else {+        result += source, source = '';+      }+    }+    return result;+  },++  sub: function(pattern, replacement, count) {+    replacement = this.gsub.prepareReplacement(replacement);+    count = count === undefined ? 1 : count;++    return this.gsub(pattern, function(match) {+      if (--count < 0) return match[0];+      return replacement(match);+    });+  },++  scan: function(pattern, iterator) {+    this.gsub(pattern, iterator);+    return this;+  },++  truncate: function(length, truncation) {+    length = length || 30;+    truncation = truncation === undefined ? '...' : truncation;+    return this.length > length ?+      this.slice(0, length - truncation.length) + truncation : this;+  },++  strip: function() {+    return this.replace(/^\s+/, '').replace(/\s+$/, '');+  },++  stripTags: function() {+    return this.replace(/<\/?[^>]+>/gi, '');+  },++  stripScripts: function() {+    return this.replace(new RegExp(Prototype.ScriptFragment, 'img'), '');+  },++  extractScripts: function() {+    var matchAll = new RegExp(Prototype.ScriptFragment, 'img');+    var matchOne = new RegExp(Prototype.ScriptFragment, 'im');+    return (this.match(matchAll) || []).map(function(scriptTag) {+      return (scriptTag.match(matchOne) || ['', ''])[1];+    });+  },++  evalScripts: function() {+    return this.extractScripts().map(function(script) { return eval(script) });+  },++  escapeHTML: function() {+    var div = document.createElement('div');+    var text = document.createTextNode(this);+    div.appendChild(text);+    return div.innerHTML;+  },++  unescapeHTML: function() {+    var div = document.createElement('div');+    div.innerHTML = this.stripTags();+    return div.childNodes[0] ? (div.childNodes.length > 1 ?+      $A(div.childNodes).inject('',function(memo,node){ return memo+node.nodeValue }) :+      div.childNodes[0].nodeValue) : '';+  },++  toQueryParams: function(separator) {+    var match = this.strip().match(/([^?#]*)(#.*)?$/);+    if (!match) return {};++    return match[1].split(separator || '&').inject({}, function(hash, pair) {+      if ((pair = pair.split('='))[0]) {+        var name = decodeURIComponent(pair[0]);+        var value = pair[1] ? decodeURIComponent(pair[1]) : undefined;++        if (hash[name] !== undefined) {+          if (hash[name].constructor != Array)+            hash[name] = [hash[name]];+          if (value) hash[name].push(value);+        }+        else hash[name] = value;+      }+      return hash;+    });+  },++  toArray: function() {+    return this.split('');+  },++  succ: function() {+    return this.slice(0, this.length - 1) ++      String.fromCharCode(this.charCodeAt(this.length - 1) + 1);+  },++  camelize: function() {+    var parts = this.split('-'), len = parts.length;+    if (len == 1) return parts[0];++    var camelized = this.charAt(0) == '-'+      ? parts[0].charAt(0).toUpperCase() + parts[0].substring(1)+      : parts[0];++    for (var i = 1; i < len; i++)+      camelized += parts[i].charAt(0).toUpperCase() + parts[i].substring(1);++    return camelized;+  },++  capitalize: function(){+    return this.charAt(0).toUpperCase() + this.substring(1).toLowerCase();+  },++  underscore: function() {+    return this.gsub(/::/, '/').gsub(/([A-Z]+)([A-Z][a-z])/,'#{1}_#{2}').gsub(/([a-z\d])([A-Z])/,'#{1}_#{2}').gsub(/-/,'_').toLowerCase();+  },++  dasherize: function() {+    return this.gsub(/_/,'-');+  },++  inspect: function(useDoubleQuotes) {+    var escapedString = this.replace(/\\/g, '\\\\');+    if (useDoubleQuotes)+      return '"' + escapedString.replace(/"/g, '\\"') + '"';+    else+      return "'" + escapedString.replace(/'/g, '\\\'') + "'";+  }+});++String.prototype.gsub.prepareReplacement = function(replacement) {+  if (typeof replacement == 'function') return replacement;+  var template = new Template(replacement);+  return function(match) { return template.evaluate(match) };+}++String.prototype.parseQuery = String.prototype.toQueryParams;++var Template = Class.create();+Template.Pattern = /(^|.|\r|\n)(#\{(.*?)\})/;+Template.prototype = {+  initialize: function(template, pattern) {+    this.template = template.toString();+    this.pattern  = pattern || Template.Pattern;+  },++  evaluate: function(object) {+    return this.template.gsub(this.pattern, function(match) {+      var before = match[1];+      if (before == '\\') return match[2];+      return before + String.interpret(object[match[3]]);+    });+  }+}++var $break    = new Object();+var $continue = new Object();++var Enumerable = {+  each: function(iterator) {+    var index = 0;+    try {+      this._each(function(value) {+        try {+          iterator(value, index++);+        } catch (e) {+          if (e != $continue) throw e;+        }+      });+    } catch (e) {+      if (e != $break) throw e;+    }+    return this;+  },++  eachSlice: function(number, iterator) {+    var index = -number, slices = [], array = this.toArray();+    while ((index += number) < array.length)+      slices.push(array.slice(index, index+number));+    return slices.map(iterator);+  },++  all: function(iterator) {+    var result = true;+    this.each(function(value, index) {+      result = result && !!(iterator || Prototype.K)(value, index);+      if (!result) throw $break;+    });+    return result;+  },++  any: function(iterator) {+    var result = false;+    this.each(function(value, index) {+      if (result = !!(iterator || Prototype.K)(value, index))+        throw $break;+    });+    return result;+  },++  collect: function(iterator) {+    var results = [];+    this.each(function(value, index) {+      results.push((iterator || Prototype.K)(value, index));+    });+    return results;+  },++  detect: function(iterator) {+    var result;+    this.each(function(value, index) {+      if (iterator(value, index)) {+        result = value;+        throw $break;+      }+    });+    return result;+  },++  findAll: function(iterator) {+    var results = [];+    this.each(function(value, index) {+      if (iterator(value, index))+        results.push(value);+    });+    return results;+  },++  grep: function(pattern, iterator) {+    var results = [];+    this.each(function(value, index) {+      var stringValue = value.toString();+      if (stringValue.match(pattern))+        results.push((iterator || Prototype.K)(value, index));+    })+    return results;+  },++  include: function(object) {+    var found = false;+    this.each(function(value) {+      if (value == object) {+        found = true;+        throw $break;+      }+    });+    return found;+  },++  inGroupsOf: function(number, fillWith) {+    fillWith = fillWith === undefined ? null : fillWith;+    return this.eachSlice(number, function(slice) {+      while(slice.length < number) slice.push(fillWith);+      return slice;+    });+  },++  inject: function(memo, iterator) {+    this.each(function(value, index) {+      memo = iterator(memo, value, index);+    });+    return memo;+  },++  invoke: function(method) {+    var args = $A(arguments).slice(1);+    return this.map(function(value) {+      return value[method].apply(value, args);+    });+  },++  max: function(iterator) {+    var result;+    this.each(function(value, index) {+      value = (iterator || Prototype.K)(value, index);+      if (result == undefined || value >= result)+        result = value;+    });+    return result;+  },++  min: function(iterator) {+    var result;+    this.each(function(value, index) {+      value = (iterator || Prototype.K)(value, index);+      if (result == undefined || value < result)+        result = value;+    });+    return result;+  },++  partition: function(iterator) {+    var trues = [], falses = [];+    this.each(function(value, index) {+      ((iterator || Prototype.K)(value, index) ?+        trues : falses).push(value);+    });+    return [trues, falses];+  },++  pluck: function(property) {+    var results = [];+    this.each(function(value, index) {+      results.push(value[property]);+    });+    return results;+  },++  reject: function(iterator) {+    var results = [];+    this.each(function(value, index) {+      if (!iterator(value, index))+        results.push(value);+    });+    return results;+  },++  sortBy: function(iterator) {+    return this.map(function(value, index) {+      return {value: value, criteria: iterator(value, index)};+    }).sort(function(left, right) {+      var a = left.criteria, b = right.criteria;+      return a < b ? -1 : a > b ? 1 : 0;+    }).pluck('value');+  },++  toArray: function() {+    return this.map();+  },++  zip: function() {+    var iterator = Prototype.K, args = $A(arguments);+    if (typeof args.last() == 'function')+      iterator = args.pop();++    var collections = [this].concat(args).map($A);+    return this.map(function(value, index) {+      return iterator(collections.pluck(index));+    });+  },++  size: function() {+    return this.toArray().length;+  },++  inspect: function() {+    return '#<Enumerable:' + this.toArray().inspect() + '>';+  }+}++Object.extend(Enumerable, {+  map:     Enumerable.collect,+  find:    Enumerable.detect,+  select:  Enumerable.findAll,+  member:  Enumerable.include,+  entries: Enumerable.toArray+});+var $A = Array.from = function(iterable) {+  if (!iterable) return [];+  if (iterable.toArray) {+    return iterable.toArray();+  } else {+    var results = [];+    for (var i = 0, length = iterable.length; i < length; i++)+      results.push(iterable[i]);+    return results;+  }+}++Object.extend(Array.prototype, Enumerable);++if (!Array.prototype._reverse)+  Array.prototype._reverse = Array.prototype.reverse;++Object.extend(Array.prototype, {+  _each: function(iterator) {+    for (var i = 0, length = this.length; i < length; i++)+      iterator(this[i]);+  },++  clear: function() {+    this.length = 0;+    return this;+  },++  first: function() {+    return this[0];+  },++  last: function() {+    return this[this.length - 1];+  },++  compact: function() {+    return this.select(function(value) {+      return value != null;+    });+  },++  flatten: function() {+    return this.inject([], function(array, value) {+      return array.concat(value && value.constructor == Array ?+        value.flatten() : [value]);+    });+  },++  without: function() {+    var values = $A(arguments);+    return this.select(function(value) {+      return !values.include(value);+    });+  },++  indexOf: function(object) {+    for (var i = 0, length = this.length; i < length; i++)+      if (this[i] == object) return i;+    return -1;+  },++  reverse: function(inline) {+    return (inline !== false ? this : this.toArray())._reverse();+  },++  reduce: function() {+    return this.length > 1 ? this : this[0];+  },++  uniq: function() {+    return this.inject([], function(array, value) {+      return array.include(value) ? array : array.concat([value]);+    });+  },++  clone: function() {+    return [].concat(this);+  },++  size: function() {+    return this.length;+  },++  inspect: function() {+    return '[' + this.map(Object.inspect).join(', ') + ']';+  }+});++Array.prototype.toArray = Array.prototype.clone;++function $w(string){+  string = string.strip();+  return string ? string.split(/\s+/) : [];+}++if(window.opera){+  Array.prototype.concat = function(){+    var array = [];+    for(var i = 0, length = this.length; i < length; i++) array.push(this[i]);+    for(var i = 0, length = arguments.length; i < length; i++) {+      if(arguments[i].constructor == Array) {+        for(var j = 0, arrayLength = arguments[i].length; j < arrayLength; j++)+          array.push(arguments[i][j]);+      } else {+        array.push(arguments[i]);+      }+    }+    return array;+  }+}+var Hash = function(obj) {+  Object.extend(this, obj || {});+};++Object.extend(Hash, {+  toQueryString: function(obj) {+    var parts = [];++	  this.prototype._each.call(obj, function(pair) {+      if (!pair.key) return;++      if (pair.value && pair.value.constructor == Array) {+        var values = pair.value.compact();+        if (values.length < 2) pair.value = values.reduce();+        else {+        	key = encodeURIComponent(pair.key);+          values.each(function(value) {+            value = value != undefined ? encodeURIComponent(value) : '';+            parts.push(key + '=' + encodeURIComponent(value));+          });+          return;+        }+      }+      if (pair.value == undefined) pair[1] = '';+      parts.push(pair.map(encodeURIComponent).join('='));+	  });++    return parts.join('&');+  }+});++Object.extend(Hash.prototype, Enumerable);+Object.extend(Hash.prototype, {+  _each: function(iterator) {+    for (var key in this) {+      var value = this[key];+      if (value && value == Hash.prototype[key]) continue;++      var pair = [key, value];+      pair.key = key;+      pair.value = value;+      iterator(pair);+    }+  },++  keys: function() {+    return this.pluck('key');+  },++  values: function() {+    return this.pluck('value');+  },++  merge: function(hash) {+    return $H(hash).inject(this, function(mergedHash, pair) {+      mergedHash[pair.key] = pair.value;+      return mergedHash;+    });+  },++  remove: function() {+    var result;+    for(var i = 0, length = arguments.length; i < length; i++) {+      var value = this[arguments[i]];+      if (value !== undefined){+        if (result === undefined) result = value;+        else {+          if (result.constructor != Array) result = [result];+          result.push(value)+        }+      }+      delete this[arguments[i]];+    }+    return result;+  },++  toQueryString: function() {+    return Hash.toQueryString(this);+  },++  inspect: function() {+    return '#<Hash:{' + this.map(function(pair) {+      return pair.map(Object.inspect).join(': ');+    }).join(', ') + '}>';+  }+});++function $H(object) {+  if (object && object.constructor == Hash) return object;+  return new Hash(object);+};+ObjectRange = Class.create();+Object.extend(ObjectRange.prototype, Enumerable);+Object.extend(ObjectRange.prototype, {+  initialize: function(start, end, exclusive) {+    this.start = start;+    this.end = end;+    this.exclusive = exclusive;+  },++  _each: function(iterator) {+    var value = this.start;+    while (this.include(value)) {+      iterator(value);+      value = value.succ();+    }+  },++  include: function(value) {+    if (value < this.start)+      return false;+    if (this.exclusive)+      return value < this.end;+    return value <= this.end;+  }+});++var $R = function(start, end, exclusive) {+  return new ObjectRange(start, end, exclusive);+}++var Ajax = {+  getTransport: function() {+    return Try.these(+      function() {return new XMLHttpRequest()},+      function() {return new ActiveXObject('Msxml2.XMLHTTP')},+      function() {return new ActiveXObject('Microsoft.XMLHTTP')}+    ) || false;+  },++  activeRequestCount: 0+}++Ajax.Responders = {+  responders: [],++  _each: function(iterator) {+    this.responders._each(iterator);+  },++  register: function(responder) {+    if (!this.include(responder))+      this.responders.push(responder);+  },++  unregister: function(responder) {+    this.responders = this.responders.without(responder);+  },++  dispatch: function(callback, request, transport, json) {+    this.each(function(responder) {+      if (typeof responder[callback] == 'function') {+        try {+          responder[callback].apply(responder, [request, transport, json]);+        } catch (e) {}+      }+    });+  }+};++Object.extend(Ajax.Responders, Enumerable);++Ajax.Responders.register({+  onCreate: function() {+    Ajax.activeRequestCount++;+  },+  onComplete: function() {+    Ajax.activeRequestCount--;+  }+});++Ajax.Base = function() {};+Ajax.Base.prototype = {+  setOptions: function(options) {+    this.options = {+      method:       'post',+      asynchronous: true,+      contentType:  'application/x-www-form-urlencoded',+      encoding:     'UTF-8',+      parameters:   ''+    }+    Object.extend(this.options, options || {});++    this.options.method = this.options.method.toLowerCase();+    if (typeof this.options.parameters == 'string')+      this.options.parameters = this.options.parameters.toQueryParams();+  }+}++Ajax.Request = Class.create();+Ajax.Request.Events =+  ['Uninitialized', 'Loading', 'Loaded', 'Interactive', 'Complete'];++Ajax.Request.prototype = Object.extend(new Ajax.Base(), {+  _complete: false,++  initialize: function(url, options) {+    this.transport = Ajax.getTransport();+    this.setOptions(options);+    this.request(url);+  },++  request: function(url) {+    this.url = url;+    this.method = this.options.method;+    var params = this.options.parameters;++    if (!['get', 'post'].include(this.method)) {+      // simulate other verbs over post+      params['_method'] = this.method;+      this.method = 'post';+    }++    params = Hash.toQueryString(params);+    if (params && /Konqueror|Safari|KHTML/.test(navigator.userAgent)) params += '&_='++    // when GET, append parameters to URL+    if (this.method == 'get' && params)+      this.url += (this.url.indexOf('?') > -1 ? '&' : '?') + params;++    try {+      Ajax.Responders.dispatch('onCreate', this, this.transport);++      this.transport.open(this.method.toUpperCase(), this.url,+        this.options.asynchronous);++      if (this.options.asynchronous)+        setTimeout(function() { this.respondToReadyState(1) }.bind(this), 10);++      this.transport.onreadystatechange = this.onStateChange.bind(this);+      this.setRequestHeaders();++      var body = this.method == 'post' ? (this.options.postBody || params) : null;++      this.transport.send(body);++      /* Force Firefox to handle ready state 4 for synchronous requests */+      if (!this.options.asynchronous && this.transport.overrideMimeType)+        this.onStateChange();++    }+    catch (e) {+      this.dispatchException(e);+    }+  },++  onStateChange: function() {+    var readyState = this.transport.readyState;+    if (readyState > 1 && !((readyState == 4) && this._complete))+      this.respondToReadyState(this.transport.readyState);+  },++  setRequestHeaders: function() {+    var headers = {+      'X-Requested-With': 'XMLHttpRequest',+      'X-Prototype-Version': Prototype.Version,+      'Accept': 'text/javascript, text/html, application/xml, text/xml, */*'+    };++    if (this.method == 'post') {+      headers['Content-type'] = this.options.contentType ++        (this.options.encoding ? '; charset=' + this.options.encoding : '');++      /* Force "Connection: close" for older Mozilla browsers to work+       * around a bug where XMLHttpRequest sends an incorrect+       * Content-length header. See Mozilla Bugzilla #246651.+       */+      if (this.transport.overrideMimeType &&+          (navigator.userAgent.match(/Gecko\/(\d{4})/) || [0,2005])[1] < 2005)+            headers['Connection'] = 'close';+    }++    // user-defined headers+    if (typeof this.options.requestHeaders == 'object') {+      var extras = this.options.requestHeaders;++      if (typeof extras.push == 'function')+        for (var i = 0, length = extras.length; i < length; i += 2)+          headers[extras[i]] = extras[i+1];+      else+        $H(extras).each(function(pair) { headers[pair.key] = pair.value });+    }++    for (var name in headers)+      this.transport.setRequestHeader(name, headers[name]);+  },++  success: function() {+    return !this.transport.status+        || (this.transport.status >= 200 && this.transport.status < 300);+  },++  respondToReadyState: function(readyState) {+    var state = Ajax.Request.Events[readyState];+    var transport = this.transport, json = this.evalJSON();++    if (state == 'Complete') {+      try {+        this._complete = true;+        (this.options['on' + this.transport.status]+         || this.options['on' + (this.success() ? 'Success' : 'Failure')]+         || Prototype.emptyFunction)(transport, json);+      } catch (e) {+        this.dispatchException(e);+      }++      if ((this.getHeader('Content-type') || 'text/javascript').strip().+        match(/^(text|application)\/(x-)?(java|ecma)script(;.*)?$/i))+          this.evalResponse();+    }++    try {+      (this.options['on' + state] || Prototype.emptyFunction)(transport, json);+      Ajax.Responders.dispatch('on' + state, this, transport, json);+    } catch (e) {+      this.dispatchException(e);+    }++    if (state == 'Complete') {+      // avoid memory leak in MSIE: clean up+      this.transport.onreadystatechange = Prototype.emptyFunction;+    }+  },++  getHeader: function(name) {+    try {+      return this.transport.getResponseHeader(name);+    } catch (e) { return null }+  },++  evalJSON: function() {+    try {+      var json = this.getHeader('X-JSON');+      return json ? eval('(' + json + ')') : null;+    } catch (e) { return null }+  },++  evalResponse: function() {+    try {+      return eval(this.transport.responseText);+    } catch (e) {+      this.dispatchException(e);+    }+  },++  dispatchException: function(exception) {+    (this.options.onException || Prototype.emptyFunction)(this, exception);+    Ajax.Responders.dispatch('onException', this, exception);+  }+});++Ajax.Updater = Class.create();++Object.extend(Object.extend(Ajax.Updater.prototype, Ajax.Request.prototype), {+  initialize: function(container, url, options) {+    this.container = {+      success: (container.success || container),+      failure: (container.failure || (container.success ? null : container))+    }++    this.transport = Ajax.getTransport();+    this.setOptions(options);++    var onComplete = this.options.onComplete || Prototype.emptyFunction;+    this.options.onComplete = (function(transport, param) {+      this.updateContent();+      onComplete(transport, param);+    }).bind(this);++    this.request(url);+  },++  updateContent: function() {+    var receiver = this.container[this.success() ? 'success' : 'failure'];+    var response = this.transport.responseText;++    if (!this.options.evalScripts) response = response.stripScripts();++    if (receiver = $(receiver)) {+      if (this.options.insertion)+        new this.options.insertion(receiver, response);+      else+        receiver.update(response);+    }++    if (this.success()) {+      if (this.onComplete)+        setTimeout(this.onComplete.bind(this), 10);+    }+  }+});++Ajax.PeriodicalUpdater = Class.create();+Ajax.PeriodicalUpdater.prototype = Object.extend(new Ajax.Base(), {+  initialize: function(container, url, options) {+    this.setOptions(options);+    this.onComplete = this.options.onComplete;++    this.frequency = (this.options.frequency || 2);+    this.decay = (this.options.decay || 1);++    this.updater = {};+    this.container = container;+    this.url = url;++    this.start();+  },++  start: function() {+    this.options.onComplete = this.updateComplete.bind(this);+    this.onTimerEvent();+  },++  stop: function() {+    this.updater.options.onComplete = undefined;+    clearTimeout(this.timer);+    (this.onComplete || Prototype.emptyFunction).apply(this, arguments);+  },++  updateComplete: function(request) {+    if (this.options.decay) {+      this.decay = (request.responseText == this.lastText ?+        this.decay * this.options.decay : 1);++      this.lastText = request.responseText;+    }+    this.timer = setTimeout(this.onTimerEvent.bind(this),+      this.decay * this.frequency * 1000);+  },++  onTimerEvent: function() {+    this.updater = new Ajax.Updater(this.container, this.url, this.options);+  }+});+function $(element) {+  if (arguments.length > 1) {+    for (var i = 0, elements = [], length = arguments.length; i < length; i++)+      elements.push($(arguments[i]));+    return elements;+  }+  if (typeof element == 'string')+    element = document.getElementById(element);+  return Element.extend(element);+}++if (Prototype.BrowserFeatures.XPath) {+  document._getElementsByXPath = function(expression, parentElement) {+    var results = [];+    var query = document.evaluate(expression, $(parentElement) || document,+      null, XPathResult.ORDERED_NODE_SNAPSHOT_TYPE, null);+    for (var i = 0, length = query.snapshotLength; i < length; i++)+      results.push(query.snapshotItem(i));+    return results;+  };+}++document.getElementsByClassName = function(className, parentElement) {+  if (Prototype.BrowserFeatures.XPath) {+    var q = ".//*[contains(concat(' ', @class, ' '), ' " + className + " ')]";+    return document._getElementsByXPath(q, parentElement);+  } else {+    var children = ($(parentElement) || document.body).getElementsByTagName('*');+    var elements = [], child;+    for (var i = 0, length = children.length; i < length; i++) {+      child = children[i];+      if (Element.hasClassName(child, className))+        elements.push(Element.extend(child));+    }+    return elements;+  }+};++/*--------------------------------------------------------------------------*/++if (!window.Element)+  var Element = new Object();++Element.extend = function(element) {+  if (!element || _nativeExtensions || element.nodeType == 3) return element;++  if (!element._extended && element.tagName && element != window) {+    var methods = Object.clone(Element.Methods), cache = Element.extend.cache;++    if (element.tagName == 'FORM')+      Object.extend(methods, Form.Methods);+    if (['INPUT', 'TEXTAREA', 'SELECT'].include(element.tagName))+      Object.extend(methods, Form.Element.Methods);++    Object.extend(methods, Element.Methods.Simulated);++    for (var property in methods) {+      var value = methods[property];+      if (typeof value == 'function' && !(property in element))+        element[property] = cache.findOrStore(value);+    }+  }++  element._extended = true;+  return element;+};++Element.extend.cache = {+  findOrStore: function(value) {+    return this[value] = this[value] || function() {+      return value.apply(null, [this].concat($A(arguments)));+    }+  }+};++Element.Methods = {+  visible: function(element) {+    return $(element).style.display != 'none';+  },++  toggle: function(element) {+    element = $(element);+    Element[Element.visible(element) ? 'hide' : 'show'](element);+    return element;+  },++  hide: function(element) {+    $(element).style.display = 'none';+    return element;+  },++  show: function(element) {+    $(element).style.display = '';+    return element;+  },++  remove: function(element) {+    element = $(element);+    element.parentNode.removeChild(element);+    return element;+  },++  update: function(element, html) {+    html = typeof html == 'undefined' ? '' : html.toString();+    $(element).innerHTML = html.stripScripts();+    setTimeout(function() {html.evalScripts()}, 10);+    return element;+  },++  replace: function(element, html) {+    element = $(element);+    html = typeof html == 'undefined' ? '' : html.toString();+    if (element.outerHTML) {+      element.outerHTML = html.stripScripts();+    } else {+      var range = element.ownerDocument.createRange();+      range.selectNodeContents(element);+      element.parentNode.replaceChild(+        range.createContextualFragment(html.stripScripts()), element);+    }+    setTimeout(function() {html.evalScripts()}, 10);+    return element;+  },++  inspect: function(element) {+    element = $(element);+    var result = '<' + element.tagName.toLowerCase();+    $H({'id': 'id', 'className': 'class'}).each(function(pair) {+      var property = pair.first(), attribute = pair.last();+      var value = (element[property] || '').toString();+      if (value) result += ' ' + attribute + '=' + value.inspect(true);+    });+    return result + '>';+  },++  recursivelyCollect: function(element, property) {+    element = $(element);+    var elements = [];+    while (element = element[property])+      if (element.nodeType == 1)+        elements.push(Element.extend(element));+    return elements;+  },++  ancestors: function(element) {+    return $(element).recursivelyCollect('parentNode');+  },++  descendants: function(element) {+    return $A($(element).getElementsByTagName('*'));+  },++  immediateDescendants: function(element) {+    if (!(element = $(element).firstChild)) return [];+    while (element && element.nodeType != 1) element = element.nextSibling;+    if (element) return [element].concat($(element).nextSiblings());+    return [];+  },++  previousSiblings: function(element) {+    return $(element).recursivelyCollect('previousSibling');+  },++  nextSiblings: function(element) {+    return $(element).recursivelyCollect('nextSibling');+  },++  siblings: function(element) {+    element = $(element);+    return element.previousSiblings().reverse().concat(element.nextSiblings());+  },++  match: function(element, selector) {+    if (typeof selector == 'string')+      selector = new Selector(selector);+    return selector.match($(element));+  },++  up: function(element, expression, index) {+    return Selector.findElement($(element).ancestors(), expression, index);+  },++  down: function(element, expression, index) {+    return Selector.findElement($(element).descendants(), expression, index);+  },++  previous: function(element, expression, index) {+    return Selector.findElement($(element).previousSiblings(), expression, index);+  },++  next: function(element, expression, index) {+    return Selector.findElement($(element).nextSiblings(), expression, index);+  },++  getElementsBySelector: function() {+    var args = $A(arguments), element = $(args.shift());+    return Selector.findChildElements(element, args);+  },++  getElementsByClassName: function(element, className) {+    return document.getElementsByClassName(className, element);+  },++  readAttribute: function(element, name) {+    element = $(element);+    if (document.all && !window.opera) {+      var t = Element._attributeTranslations;+      if (t.values[name]) return t.values[name](element, name);+      if (t.names[name])  name = t.names[name];+      var attribute = element.attributes[name];+      if(attribute) return attribute.nodeValue;+    }+    return element.getAttribute(name);+  },++  getHeight: function(element) {+    return $(element).getDimensions().height;+  },++  getWidth: function(element) {+    return $(element).getDimensions().width;+  },++  classNames: function(element) {+    return new Element.ClassNames(element);+  },++  hasClassName: function(element, className) {+    if (!(element = $(element))) return;+    var elementClassName = element.className;+    if (elementClassName.length == 0) return false;+    if (elementClassName == className ||+        elementClassName.match(new RegExp("(^|\\s)" + className + "(\\s|$)")))+      return true;+    return false;+  },++  addClassName: function(element, className) {+    if (!(element = $(element))) return;+    Element.classNames(element).add(className);+    return element;+  },++  removeClassName: function(element, className) {+    if (!(element = $(element))) return;+    Element.classNames(element).remove(className);+    return element;+  },++  toggleClassName: function(element, className) {+    if (!(element = $(element))) return;+    Element.classNames(element)[element.hasClassName(className) ? 'remove' : 'add'](className);+    return element;+  },++  observe: function() {+    Event.observe.apply(Event, arguments);+    return $A(arguments).first();+  },++  stopObserving: function() {+    Event.stopObserving.apply(Event, arguments);+    return $A(arguments).first();+  },++  // removes whitespace-only text node children+  cleanWhitespace: function(element) {+    element = $(element);+    var node = element.firstChild;+    while (node) {+      var nextNode = node.nextSibling;+      if (node.nodeType == 3 && !/\S/.test(node.nodeValue))+        element.removeChild(node);+      node = nextNode;+    }+    return element;+  },++  empty: function(element) {+    return $(element).innerHTML.match(/^\s*$/);+  },++  descendantOf: function(element, ancestor) {+    element = $(element), ancestor = $(ancestor);+    while (element = element.parentNode)+      if (element == ancestor) return true;+    return false;+  },++  scrollTo: function(element) {+    element = $(element);+    var pos = Position.cumulativeOffset(element);+    window.scrollTo(pos[0], pos[1]);+    return element;+  },++  getStyle: function(element, style) {+    element = $(element);+    if (['float','cssFloat'].include(style))+      style = (typeof element.style.styleFloat != 'undefined' ? 'styleFloat' : 'cssFloat');+    style = style.camelize();+    var value = element.style[style];+    if (!value) {+      if (document.defaultView && document.defaultView.getComputedStyle) {+        var css = document.defaultView.getComputedStyle(element, null);+        value = css ? css[style] : null;+      } else if (element.currentStyle) {+        value = element.currentStyle[style];+      }+    }++    if((value == 'auto') && ['width','height'].include(style) && (element.getStyle('display') != 'none'))+      value = element['offset'+style.capitalize()] + 'px';++    if (window.opera && ['left', 'top', 'right', 'bottom'].include(style))+      if (Element.getStyle(element, 'position') == 'static') value = 'auto';+    if(style == 'opacity') {+      if(value) return parseFloat(value);+      if(value = (element.getStyle('filter') || '').match(/alpha\(opacity=(.*)\)/))+        if(value[1]) return parseFloat(value[1]) / 100;+      return 1.0;+    }+    return value == 'auto' ? null : value;+  },++  setStyle: function(element, style) {+    element = $(element);+    for (var name in style) {+      var value = style[name];+      if(name == 'opacity') {+        if (value == 1) {+          value = (/Gecko/.test(navigator.userAgent) &&+            !/Konqueror|Safari|KHTML/.test(navigator.userAgent)) ? 0.999999 : 1.0;+          if(/MSIE/.test(navigator.userAgent) && !window.opera)+            element.style.filter = element.getStyle('filter').replace(/alpha\([^\)]*\)/gi,'');+        } else if(value == '') {+          if(/MSIE/.test(navigator.userAgent) && !window.opera)+            element.style.filter = element.getStyle('filter').replace(/alpha\([^\)]*\)/gi,'');+        } else {+          if(value < 0.00001) value = 0;+          if(/MSIE/.test(navigator.userAgent) && !window.opera)+            element.style.filter = element.getStyle('filter').replace(/alpha\([^\)]*\)/gi,'') ++              'alpha(opacity='+value*100+')';+        }+      } else if(['float','cssFloat'].include(name)) name = (typeof element.style.styleFloat != 'undefined') ? 'styleFloat' : 'cssFloat';+      element.style[name.camelize()] = value;+    }+    return element;+  },++  getDimensions: function(element) {+    element = $(element);+    var display = $(element).getStyle('display');+    if (display != 'none' && display != null) // Safari bug+      return {width: element.offsetWidth, height: element.offsetHeight};++    // All *Width and *Height properties give 0 on elements with display none,+    // so enable the element temporarily+    var els = element.style;+    var originalVisibility = els.visibility;+    var originalPosition = els.position;+    var originalDisplay = els.display;+    els.visibility = 'hidden';+    els.position = 'absolute';+    els.display = 'block';+    var originalWidth = element.clientWidth;+    var originalHeight = element.clientHeight;+    els.display = originalDisplay;+    els.position = originalPosition;+    els.visibility = originalVisibility;+    return {width: originalWidth, height: originalHeight};+  },++  makePositioned: function(element) {+    element = $(element);+    var pos = Element.getStyle(element, 'position');+    if (pos == 'static' || !pos) {+      element._madePositioned = true;+      element.style.position = 'relative';+      // Opera returns the offset relative to the positioning context, when an+      // element is position relative but top and left have not been defined+      if (window.opera) {+        element.style.top = 0;+        element.style.left = 0;+      }+    }+    return element;+  },++  undoPositioned: function(element) {+    element = $(element);+    if (element._madePositioned) {+      element._madePositioned = undefined;+      element.style.position =+        element.style.top =+        element.style.left =+        element.style.bottom =+        element.style.right = '';+    }+    return element;+  },++  makeClipping: function(element) {+    element = $(element);+    if (element._overflow) return element;+    element._overflow = element.style.overflow || 'auto';+    if ((Element.getStyle(element, 'overflow') || 'visible') != 'hidden')+      element.style.overflow = 'hidden';+    return element;+  },++  undoClipping: function(element) {+    element = $(element);+    if (!element._overflow) return element;+    element.style.overflow = element._overflow == 'auto' ? '' : element._overflow;+    element._overflow = null;+    return element;+  }+};++Object.extend(Element.Methods, {childOf: Element.Methods.descendantOf});++Element._attributeTranslations = {};++Element._attributeTranslations.names = {+  colspan:   "colSpan",+  rowspan:   "rowSpan",+  valign:    "vAlign",+  datetime:  "dateTime",+  accesskey: "accessKey",+  tabindex:  "tabIndex",+  enctype:   "encType",+  maxlength: "maxLength",+  readonly:  "readOnly",+  longdesc:  "longDesc"+};++Element._attributeTranslations.values = {+  _getAttr: function(element, attribute) {+    return element.getAttribute(attribute, 2);+  },++  _flag: function(element, attribute) {+    return $(element).hasAttribute(attribute) ? attribute : null;+  },++  style: function(element) {+    return element.style.cssText.toLowerCase();+  },++  title: function(element) {+    var node = element.getAttributeNode('title');+    return node.specified ? node.nodeValue : null;+  }+};++Object.extend(Element._attributeTranslations.values, {+  href: Element._attributeTranslations.values._getAttr,+  src:  Element._attributeTranslations.values._getAttr,+  disabled: Element._attributeTranslations.values._flag,+  checked:  Element._attributeTranslations.values._flag,+  readonly: Element._attributeTranslations.values._flag,+  multiple: Element._attributeTranslations.values._flag+});++Element.Methods.Simulated = {+  hasAttribute: function(element, attribute) {+    var t = Element._attributeTranslations;+    attribute = t.names[attribute] || attribute;+    return $(element).getAttributeNode(attribute).specified;+  }+};++// IE is missing .innerHTML support for TABLE-related elements+if (document.all && !window.opera){+  Element.Methods.update = function(element, html) {+    element = $(element);+    html = typeof html == 'undefined' ? '' : html.toString();+    var tagName = element.tagName.toUpperCase();+    if (['THEAD','TBODY','TR','TD'].include(tagName)) {+      var div = document.createElement('div');+      switch (tagName) {+        case 'THEAD':+        case 'TBODY':+          div.innerHTML = '<table><tbody>' +  html.stripScripts() + '</tbody></table>';+          depth = 2;+          break;+        case 'TR':+          div.innerHTML = '<table><tbody><tr>' +  html.stripScripts() + '</tr></tbody></table>';+          depth = 3;+          break;+        case 'TD':+          div.innerHTML = '<table><tbody><tr><td>' +  html.stripScripts() + '</td></tr></tbody></table>';+          depth = 4;+      }+      $A(element.childNodes).each(function(node){+        element.removeChild(node)+      });+      depth.times(function(){ div = div.firstChild });++      $A(div.childNodes).each(+        function(node){ element.appendChild(node) });+    } else {+      element.innerHTML = html.stripScripts();+    }+    setTimeout(function() {html.evalScripts()}, 10);+    return element;+  }+};++Object.extend(Element, Element.Methods);++var _nativeExtensions = false;++if(/Konqueror|Safari|KHTML/.test(navigator.userAgent))+  ['', 'Form', 'Input', 'TextArea', 'Select'].each(function(tag) {+    var className = 'HTML' + tag + 'Element';+    if(window[className]) return;+    var klass = window[className] = {};+    klass.prototype = document.createElement(tag ? tag.toLowerCase() : 'div').__proto__;+  });++Element.addMethods = function(methods) {+  Object.extend(Element.Methods, methods || {});++  function copy(methods, destination, onlyIfAbsent) {+    onlyIfAbsent = onlyIfAbsent || false;+    var cache = Element.extend.cache;+    for (var property in methods) {+      var value = methods[property];+      if (!onlyIfAbsent || !(property in destination))+        destination[property] = cache.findOrStore(value);+    }+  }++  if (typeof HTMLElement != 'undefined') {+    copy(Element.Methods, HTMLElement.prototype);+    copy(Element.Methods.Simulated, HTMLElement.prototype, true);+    copy(Form.Methods, HTMLFormElement.prototype);+    [HTMLInputElement, HTMLTextAreaElement, HTMLSelectElement].each(function(klass) {+      copy(Form.Element.Methods, klass.prototype);+    });+    _nativeExtensions = true;+  }+}++var Toggle = new Object();+Toggle.display = Element.toggle;++/*--------------------------------------------------------------------------*/++Abstract.Insertion = function(adjacency) {+  this.adjacency = adjacency;+}++Abstract.Insertion.prototype = {+  initialize: function(element, content) {+    this.element = $(element);+    this.content = content.stripScripts();++    if (this.adjacency && this.element.insertAdjacentHTML) {+      try {+        this.element.insertAdjacentHTML(this.adjacency, this.content);+      } catch (e) {+        var tagName = this.element.tagName.toUpperCase();+        if (['TBODY', 'TR'].include(tagName)) {+          this.insertContent(this.contentFromAnonymousTable());+        } else {+          throw e;+        }+      }+    } else {+      this.range = this.element.ownerDocument.createRange();+      if (this.initializeRange) this.initializeRange();+      this.insertContent([this.range.createContextualFragment(this.content)]);+    }++    setTimeout(function() {content.evalScripts()}, 10);+  },++  contentFromAnonymousTable: function() {+    var div = document.createElement('div');+    div.innerHTML = '<table><tbody>' + this.content + '</tbody></table>';+    return $A(div.childNodes[0].childNodes[0].childNodes);+  }+}++var Insertion = new Object();++Insertion.Before = Class.create();+Insertion.Before.prototype = Object.extend(new Abstract.Insertion('beforeBegin'), {+  initializeRange: function() {+    this.range.setStartBefore(this.element);+  },++  insertContent: function(fragments) {+    fragments.each((function(fragment) {+      this.element.parentNode.insertBefore(fragment, this.element);+    }).bind(this));+  }+});++Insertion.Top = Class.create();+Insertion.Top.prototype = Object.extend(new Abstract.Insertion('afterBegin'), {+  initializeRange: function() {+    this.range.selectNodeContents(this.element);+    this.range.collapse(true);+  },++  insertContent: function(fragments) {+    fragments.reverse(false).each((function(fragment) {+      this.element.insertBefore(fragment, this.element.firstChild);+    }).bind(this));+  }+});++Insertion.Bottom = Class.create();+Insertion.Bottom.prototype = Object.extend(new Abstract.Insertion('beforeEnd'), {+  initializeRange: function() {+    this.range.selectNodeContents(this.element);+    this.range.collapse(this.element);+  },++  insertContent: function(fragments) {+    fragments.each((function(fragment) {+      this.element.appendChild(fragment);+    }).bind(this));+  }+});++Insertion.After = Class.create();+Insertion.After.prototype = Object.extend(new Abstract.Insertion('afterEnd'), {+  initializeRange: function() {+    this.range.setStartAfter(this.element);+  },++  insertContent: function(fragments) {+    fragments.each((function(fragment) {+      this.element.parentNode.insertBefore(fragment,+        this.element.nextSibling);+    }).bind(this));+  }+});++/*--------------------------------------------------------------------------*/++Element.ClassNames = Class.create();+Element.ClassNames.prototype = {+  initialize: function(element) {+    this.element = $(element);+  },++  _each: function(iterator) {+    this.element.className.split(/\s+/).select(function(name) {+      return name.length > 0;+    })._each(iterator);+  },++  set: function(className) {+    this.element.className = className;+  },++  add: function(classNameToAdd) {+    if (this.include(classNameToAdd)) return;+    this.set($A(this).concat(classNameToAdd).join(' '));+  },++  remove: function(classNameToRemove) {+    if (!this.include(classNameToRemove)) return;+    this.set($A(this).without(classNameToRemove).join(' '));+  },++  toString: function() {+    return $A(this).join(' ');+  }+};++Object.extend(Element.ClassNames.prototype, Enumerable);+var Selector = Class.create();+Selector.prototype = {+  initialize: function(expression) {+    this.params = {classNames: []};+    this.expression = expression.toString().strip();+    this.parseExpression();+    this.compileMatcher();+  },++  parseExpression: function() {+    function abort(message) { throw 'Parse error in selector: ' + message; }++    if (this.expression == '')  abort('empty expression');++    var params = this.params, expr = this.expression, match, modifier, clause, rest;+    while (match = expr.match(/^(.*)\[([a-z0-9_:-]+?)(?:([~\|!]?=)(?:"([^"]*)"|([^\]\s]*)))?\]$/i)) {+      params.attributes = params.attributes || [];+      params.attributes.push({name: match[2], operator: match[3], value: match[4] || match[5] || ''});+      expr = match[1];+    }++    if (expr == '*') return this.params.wildcard = true;++    while (match = expr.match(/^([^a-z0-9_-])?([a-z0-9_-]+)(.*)/i)) {+      modifier = match[1], clause = match[2], rest = match[3];+      switch (modifier) {+        case '#':       params.id = clause; break;+        case '.':       params.classNames.push(clause); break;+        case '':+        case undefined: params.tagName = clause.toUpperCase(); break;+        default:        abort(expr.inspect());+      }+      expr = rest;+    }++    if (expr.length > 0) abort(expr.inspect());+  },++  buildMatchExpression: function() {+    var params = this.params, conditions = [], clause;++    if (params.wildcard)+      conditions.push('true');+    if (clause = params.id)+      conditions.push('element.readAttribute("id") == ' + clause.inspect());+    if (clause = params.tagName)+      conditions.push('element.tagName.toUpperCase() == ' + clause.inspect());+    if ((clause = params.classNames).length > 0)+      for (var i = 0, length = clause.length; i < length; i++)+        conditions.push('element.hasClassName(' + clause[i].inspect() + ')');+    if (clause = params.attributes) {+      clause.each(function(attribute) {+        var value = 'element.readAttribute(' + attribute.name.inspect() + ')';+        var splitValueBy = function(delimiter) {+          return value + ' && ' + value + '.split(' + delimiter.inspect() + ')';+        }++        switch (attribute.operator) {+          case '=':       conditions.push(value + ' == ' + attribute.value.inspect()); break;+          case '~=':      conditions.push(splitValueBy(' ') + '.include(' + attribute.value.inspect() + ')'); break;+          case '|=':      conditions.push(+                            splitValueBy('-') + '.first().toUpperCase() == ' + attribute.value.toUpperCase().inspect()+                          ); break;+          case '!=':      conditions.push(value + ' != ' + attribute.value.inspect()); break;+          case '':+          case undefined: conditions.push('element.hasAttribute(' + attribute.name.inspect() + ')'); break;+          default:        throw 'Unknown operator ' + attribute.operator + ' in selector';+        }+      });+    }++    return conditions.join(' && ');+  },++  compileMatcher: function() {+    this.match = new Function('element', 'if (!element.tagName) return false; \+      element = $(element); \+      return ' + this.buildMatchExpression());+  },++  findElements: function(scope) {+    var element;++    if (element = $(this.params.id))+      if (this.match(element))+        if (!scope || Element.childOf(element, scope))+          return [element];++    scope = (scope || document).getElementsByTagName(this.params.tagName || '*');++    var results = [];+    for (var i = 0, length = scope.length; i < length; i++)+      if (this.match(element = scope[i]))+        results.push(Element.extend(element));++    return results;+  },++  toString: function() {+    return this.expression;+  }+}++Object.extend(Selector, {+  matchElements: function(elements, expression) {+    var selector = new Selector(expression);+    return elements.select(selector.match.bind(selector)).map(Element.extend);+  },++  findElement: function(elements, expression, index) {+    if (typeof expression == 'number') index = expression, expression = false;+    return Selector.matchElements(elements, expression || '*')[index || 0];+  },++  findChildElements: function(element, expressions) {+    return expressions.map(function(expression) {+      return expression.match(/[^\s"]+(?:"[^"]*"[^\s"]+)*/g).inject([null], function(results, expr) {+        var selector = new Selector(expr);+        return results.inject([], function(elements, result) {+          return elements.concat(selector.findElements(result || element));+        });+      });+    }).flatten();+  }+});++function $$() {+  return Selector.findChildElements(document, $A(arguments));+}+var Form = {+  reset: function(form) {+    $(form).reset();+    return form;+  },++  serializeElements: function(elements, getHash) {+    var data = elements.inject({}, function(result, element) {+      if (!element.disabled && element.name) {+        var key = element.name, value = $(element).getValue();+        if (value != undefined) {+          if (result[key]) {+            if (result[key].constructor != Array) result[key] = [result[key]];+            result[key].push(value);+          }+          else result[key] = value;+        }+      }+      return result;+    });++    return getHash ? data : Hash.toQueryString(data);+  }+};++Form.Methods = {+  serialize: function(form, getHash) {+    return Form.serializeElements(Form.getElements(form), getHash);+  },++  getElements: function(form) {+    return $A($(form).getElementsByTagName('*')).inject([],+      function(elements, child) {+        if (Form.Element.Serializers[child.tagName.toLowerCase()])+          elements.push(Element.extend(child));+        return elements;+      }+    );+  },++  getInputs: function(form, typeName, name) {+    form = $(form);+    var inputs = form.getElementsByTagName('input');++    if (!typeName && !name) return $A(inputs).map(Element.extend);++    for (var i = 0, matchingInputs = [], length = inputs.length; i < length; i++) {+      var input = inputs[i];+      if ((typeName && input.type != typeName) || (name && input.name != name))+        continue;+      matchingInputs.push(Element.extend(input));+    }++    return matchingInputs;+  },++  disable: function(form) {+    form = $(form);+    form.getElements().each(function(element) {+      element.blur();+      element.disabled = 'true';+    });+    return form;+  },++  enable: function(form) {+    form = $(form);+    form.getElements().each(function(element) {+      element.disabled = '';+    });+    return form;+  },++  findFirstElement: function(form) {+    return $(form).getElements().find(function(element) {+      return element.type != 'hidden' && !element.disabled &&+        ['input', 'select', 'textarea'].include(element.tagName.toLowerCase());+    });+  },++  focusFirstElement: function(form) {+    form = $(form);+    form.findFirstElement().activate();+    return form;+  }+}++Object.extend(Form, Form.Methods);++/*--------------------------------------------------------------------------*/++Form.Element = {+  focus: function(element) {+    $(element).focus();+    return element;+  },++  select: function(element) {+    $(element).select();+    return element;+  }+}++Form.Element.Methods = {+  serialize: function(element) {+    element = $(element);+    if (!element.disabled && element.name) {+      var value = element.getValue();+      if (value != undefined) {+        var pair = {};+        pair[element.name] = value;+        return Hash.toQueryString(pair);+      }+    }+    return '';+  },++  getValue: function(element) {+    element = $(element);+    var method = element.tagName.toLowerCase();+    return Form.Element.Serializers[method](element);+  },++  clear: function(element) {+    $(element).value = '';+    return element;+  },++  present: function(element) {+    return $(element).value != '';+  },++  activate: function(element) {+    element = $(element);+    element.focus();+    if (element.select && ( element.tagName.toLowerCase() != 'input' ||+      !['button', 'reset', 'submit'].include(element.type) ) )+      element.select();+    return element;+  },++  disable: function(element) {+    element = $(element);+    element.disabled = true;+    return element;+  },++  enable: function(element) {+    element = $(element);+    element.blur();+    element.disabled = false;+    return element;+  }+}++Object.extend(Form.Element, Form.Element.Methods);+var Field = Form.Element;+var $F = Form.Element.getValue;++/*--------------------------------------------------------------------------*/++Form.Element.Serializers = {+  input: function(element) {+    switch (element.type.toLowerCase()) {+      case 'checkbox':+      case 'radio':+        return Form.Element.Serializers.inputSelector(element);+      default:+        return Form.Element.Serializers.textarea(element);+    }+  },++  inputSelector: function(element) {+    return element.checked ? element.value : null;+  },++  textarea: function(element) {+    return element.value;+  },++  select: function(element) {+    return this[element.type == 'select-one' ?+      'selectOne' : 'selectMany'](element);+  },++  selectOne: function(element) {+    var index = element.selectedIndex;+    return index >= 0 ? this.optionValue(element.options[index]) : null;+  },++  selectMany: function(element) {+    var values, length = element.length;+    if (!length) return null;++    for (var i = 0, values = []; i < length; i++) {+      var opt = element.options[i];+      if (opt.selected) values.push(this.optionValue(opt));+    }+    return values;+  },++  optionValue: function(opt) {+    // extend element because hasAttribute may not be native+    return Element.extend(opt).hasAttribute('value') ? opt.value : opt.text;+  }+}++/*--------------------------------------------------------------------------*/++Abstract.TimedObserver = function() {}+Abstract.TimedObserver.prototype = {+  initialize: function(element, frequency, callback) {+    this.frequency = frequency;+    this.element   = $(element);+    this.callback  = callback;++    this.lastValue = this.getValue();+    this.registerCallback();+  },++  registerCallback: function() {+    setInterval(this.onTimerEvent.bind(this), this.frequency * 1000);+  },++  onTimerEvent: function() {+    var value = this.getValue();+    var changed = ('string' == typeof this.lastValue && 'string' == typeof value+      ? this.lastValue != value : String(this.lastValue) != String(value));+    if (changed) {+      this.callback(this.element, value);+      this.lastValue = value;+    }+  }+}++Form.Element.Observer = Class.create();+Form.Element.Observer.prototype = Object.extend(new Abstract.TimedObserver(), {+  getValue: function() {+    return Form.Element.getValue(this.element);+  }+});++Form.Observer = Class.create();+Form.Observer.prototype = Object.extend(new Abstract.TimedObserver(), {+  getValue: function() {+    return Form.serialize(this.element);+  }+});++/*--------------------------------------------------------------------------*/++Abstract.EventObserver = function() {}+Abstract.EventObserver.prototype = {+  initialize: function(element, callback) {+    this.element  = $(element);+    this.callback = callback;++    this.lastValue = this.getValue();+    if (this.element.tagName.toLowerCase() == 'form')+      this.registerFormCallbacks();+    else+      this.registerCallback(this.element);+  },++  onElementEvent: function() {+    var value = this.getValue();+    if (this.lastValue != value) {+      this.callback(this.element, value);+      this.lastValue = value;+    }+  },++  registerFormCallbacks: function() {+    Form.getElements(this.element).each(this.registerCallback.bind(this));+  },++  registerCallback: function(element) {+    if (element.type) {+      switch (element.type.toLowerCase()) {+        case 'checkbox':+        case 'radio':+          Event.observe(element, 'click', this.onElementEvent.bind(this));+          break;+        default:+          Event.observe(element, 'change', this.onElementEvent.bind(this));+          break;+      }+    }+  }+}++Form.Element.EventObserver = Class.create();+Form.Element.EventObserver.prototype = Object.extend(new Abstract.EventObserver(), {+  getValue: function() {+    return Form.Element.getValue(this.element);+  }+});++Form.EventObserver = Class.create();+Form.EventObserver.prototype = Object.extend(new Abstract.EventObserver(), {+  getValue: function() {+    return Form.serialize(this.element);+  }+});+if (!window.Event) {+  var Event = new Object();+}++Object.extend(Event, {+  KEY_BACKSPACE: 8,+  KEY_TAB:       9,+  KEY_RETURN:   13,+  KEY_ESC:      27,+  KEY_LEFT:     37,+  KEY_UP:       38,+  KEY_RIGHT:    39,+  KEY_DOWN:     40,+  KEY_DELETE:   46,+  KEY_HOME:     36,+  KEY_END:      35,+  KEY_PAGEUP:   33,+  KEY_PAGEDOWN: 34,++  element: function(event) {+    return event.target || event.srcElement;+  },++  isLeftClick: function(event) {+    return (((event.which) && (event.which == 1)) ||+            ((event.button) && (event.button == 1)));+  },++  pointerX: function(event) {+    return event.pageX || (event.clientX ++      (document.documentElement.scrollLeft || document.body.scrollLeft));+  },++  pointerY: function(event) {+    return event.pageY || (event.clientY ++      (document.documentElement.scrollTop || document.body.scrollTop));+  },++  stop: function(event) {+    if (event.preventDefault) {+      event.preventDefault();+      event.stopPropagation();+    } else {+      event.returnValue = false;+      event.cancelBubble = true;+    }+  },++  // find the first node with the given tagName, starting from the+  // node the event was triggered on; traverses the DOM upwards+  findElement: function(event, tagName) {+    var element = Event.element(event);+    while (element.parentNode && (!element.tagName ||+        (element.tagName.toUpperCase() != tagName.toUpperCase())))+      element = element.parentNode;+    return element;+  },++  observers: false,++  _observeAndCache: function(element, name, observer, useCapture) {+    if (!this.observers) this.observers = [];+    if (element.addEventListener) {+      this.observers.push([element, name, observer, useCapture]);+      element.addEventListener(name, observer, useCapture);+    } else if (element.attachEvent) {+      this.observers.push([element, name, observer, useCapture]);+      element.attachEvent('on' + name, observer);+    }+  },++  unloadCache: function() {+    if (!Event.observers) return;+    for (var i = 0, length = Event.observers.length; i < length; i++) {+      Event.stopObserving.apply(this, Event.observers[i]);+      Event.observers[i][0] = null;+    }+    Event.observers = false;+  },++  observe: function(element, name, observer, useCapture) {+    element = $(element);+    useCapture = useCapture || false;++    if (name == 'keypress' &&+        (navigator.appVersion.match(/Konqueror|Safari|KHTML/)+        || element.attachEvent))+      name = 'keydown';++    Event._observeAndCache(element, name, observer, useCapture);+  },++  stopObserving: function(element, name, observer, useCapture) {+    element = $(element);+    useCapture = useCapture || false;++    if (name == 'keypress' &&+        (navigator.appVersion.match(/Konqueror|Safari|KHTML/)+        || element.detachEvent))+      name = 'keydown';++    if (element.removeEventListener) {+      element.removeEventListener(name, observer, useCapture);+    } else if (element.detachEvent) {+      try {+        element.detachEvent('on' + name, observer);+      } catch (e) {}+    }+  }+});++/* prevent memory leaks in IE */+if (navigator.appVersion.match(/\bMSIE\b/))+  Event.observe(window, 'unload', Event.unloadCache, false);+var Position = {+  // set to true if needed, warning: firefox performance problems+  // NOT neeeded for page scrolling, only if draggable contained in+  // scrollable elements+  includeScrollOffsets: false,++  // must be called before calling withinIncludingScrolloffset, every time the+  // page is scrolled+  prepare: function() {+    this.deltaX =  window.pageXOffset+                || document.documentElement.scrollLeft+                || document.body.scrollLeft+                || 0;+    this.deltaY =  window.pageYOffset+                || document.documentElement.scrollTop+                || document.body.scrollTop+                || 0;+  },++  realOffset: function(element) {+    var valueT = 0, valueL = 0;+    do {+      valueT += element.scrollTop  || 0;+      valueL += element.scrollLeft || 0;+      element = element.parentNode;+    } while (element);+    return [valueL, valueT];+  },++  cumulativeOffset: function(element) {+    var valueT = 0, valueL = 0;+    do {+      valueT += element.offsetTop  || 0;+      valueL += element.offsetLeft || 0;+      element = element.offsetParent;+    } while (element);+    return [valueL, valueT];+  },++  positionedOffset: function(element) {+    var valueT = 0, valueL = 0;+    do {+      valueT += element.offsetTop  || 0;+      valueL += element.offsetLeft || 0;+      element = element.offsetParent;+      if (element) {+        if(element.tagName=='BODY') break;+        var p = Element.getStyle(element, 'position');+        if (p == 'relative' || p == 'absolute') break;+      }+    } while (element);+    return [valueL, valueT];+  },++  offsetParent: function(element) {+    if (element.offsetParent) return element.offsetParent;+    if (element == document.body) return element;++    while ((element = element.parentNode) && element != document.body)+      if (Element.getStyle(element, 'position') != 'static')+        return element;++    return document.body;+  },++  // caches x/y coordinate pair to use with overlap+  within: function(element, x, y) {+    if (this.includeScrollOffsets)+      return this.withinIncludingScrolloffsets(element, x, y);+    this.xcomp = x;+    this.ycomp = y;+    this.offset = this.cumulativeOffset(element);++    return (y >= this.offset[1] &&+            y <  this.offset[1] + element.offsetHeight &&+            x >= this.offset[0] &&+            x <  this.offset[0] + element.offsetWidth);+  },++  withinIncludingScrolloffsets: function(element, x, y) {+    var offsetcache = this.realOffset(element);++    this.xcomp = x + offsetcache[0] - this.deltaX;+    this.ycomp = y + offsetcache[1] - this.deltaY;+    this.offset = this.cumulativeOffset(element);++    return (this.ycomp >= this.offset[1] &&+            this.ycomp <  this.offset[1] + element.offsetHeight &&+            this.xcomp >= this.offset[0] &&+            this.xcomp <  this.offset[0] + element.offsetWidth);+  },++  // within must be called directly before+  overlap: function(mode, element) {+    if (!mode) return 0;+    if (mode == 'vertical')+      return ((this.offset[1] + element.offsetHeight) - this.ycomp) /+        element.offsetHeight;+    if (mode == 'horizontal')+      return ((this.offset[0] + element.offsetWidth) - this.xcomp) /+        element.offsetWidth;+  },++  page: function(forElement) {+    var valueT = 0, valueL = 0;++    var element = forElement;+    do {+      valueT += element.offsetTop  || 0;+      valueL += element.offsetLeft || 0;++      // Safari fix+      if (element.offsetParent==document.body)+        if (Element.getStyle(element,'position')=='absolute') break;++    } while (element = element.offsetParent);++    element = forElement;+    do {+      if (!window.opera || element.tagName=='BODY') {+        valueT -= element.scrollTop  || 0;+        valueL -= element.scrollLeft || 0;+      }+    } while (element = element.parentNode);++    return [valueL, valueT];+  },++  clone: function(source, target) {+    var options = Object.extend({+      setLeft:    true,+      setTop:     true,+      setWidth:   true,+      setHeight:  true,+      offsetTop:  0,+      offsetLeft: 0+    }, arguments[2] || {})++    // find page position of source+    source = $(source);+    var p = Position.page(source);++    // find coordinate system to use+    target = $(target);+    var delta = [0, 0];+    var parent = null;+    // delta [0,0] will do fine with position: fixed elements,+    // position:absolute needs offsetParent deltas+    if (Element.getStyle(target,'position') == 'absolute') {+      parent = Position.offsetParent(target);+      delta = Position.page(parent);+    }++    // correct by body offsets (fixes Safari)+    if (parent == document.body) {+      delta[0] -= document.body.offsetLeft;+      delta[1] -= document.body.offsetTop;+    }++    // set position+    if(options.setLeft)   target.style.left  = (p[0] - delta[0] + options.offsetLeft) + 'px';+    if(options.setTop)    target.style.top   = (p[1] - delta[1] + options.offsetTop) + 'px';+    if(options.setWidth)  target.style.width = source.offsetWidth + 'px';+    if(options.setHeight) target.style.height = source.offsetHeight + 'px';+  },++  absolutize: function(element) {+    element = $(element);+    if (element.style.position == 'absolute') return;+    Position.prepare();++    var offsets = Position.positionedOffset(element);+    var top     = offsets[1];+    var left    = offsets[0];+    var width   = element.clientWidth;+    var height  = element.clientHeight;++    element._originalLeft   = left - parseFloat(element.style.left  || 0);+    element._originalTop    = top  - parseFloat(element.style.top || 0);+    element._originalWidth  = element.style.width;+    element._originalHeight = element.style.height;++    element.style.position = 'absolute';+    element.style.top    = top + 'px';+    element.style.left   = left + 'px';+    element.style.width  = width + 'px';+    element.style.height = height + 'px';+  },++  relativize: function(element) {+    element = $(element);+    if (element.style.position == 'relative') return;+    Position.prepare();++    element.style.position = 'relative';+    var top  = parseFloat(element.style.top  || 0) - (element._originalTop || 0);+    var left = parseFloat(element.style.left || 0) - (element._originalLeft || 0);++    element.style.top    = top + 'px';+    element.style.left   = left + 'px';+    element.style.height = element._originalHeight;+    element.style.width  = element._originalWidth;+  }+}++// Safari returns margins on body which is incorrect if the child is absolutely+// positioned.  For performance reasons, redefine Position.cumulativeOffset for+// KHTML/WebKit only.+if (/Konqueror|Safari|KHTML/.test(navigator.userAgent)) {+  Position.cumulativeOffset = function(element) {+    var valueT = 0, valueL = 0;+    do {+      valueT += element.offsetTop  || 0;+      valueL += element.offsetLeft || 0;+      if (element.offsetParent == document.body)+        if (Element.getStyle(element, 'position') == 'absolute') break;++      element = element.offsetParent;+    } while (element);++    return [valueL, valueT];+  }+}++Element.addMethods();
+ html/lib/sortable.js view
@@ -0,0 +1,328 @@+/*+Table sorting script  by Joost de Valk, check it out at http://www.joostdevalk.nl/code/sortable-table/.+Based on a script from http://www.kryogenix.org/code/browser/sorttable/.+Distributed under the MIT license: http://www.kryogenix.org/code/browser/licence.html .++Copyright (c) 1997-2006 Stuart Langridge, Joost de Valk.++Version 1.5.6+*/++/* You can change these values */+var image_path = "html/lib/";+var image_up = "asc.png";+var image_down = "desc.png";+var image_none = "unordered.png";+var europeandate = true;+var alternate_row_colors = true;++/* Don't change anything below this unless you know what you're doing */+addEvent(window, "load", sortables_init);++var SORT_COLUMN_INDEX;+var thead = false;++function sortables_init() {+	// Find all tables with class sortable and make them sortable+	if (!document.getElementsByTagName) return;+	tbls = document.getElementsByTagName("table");+	for (ti=0;ti<tbls.length;ti++) {+		thisTbl = tbls[ti];+		if (((' '+thisTbl.className+' ').indexOf("sortable") != -1) && (thisTbl.id)) {+			ts_makeSortable(thisTbl);+		}+	}+}++function ts_makeSortable(t) {+	if (t.rows && t.rows.length > 0) {+		if (t.tHead && t.tHead.rows.length > 0) {+			var firstRow = t.tHead.rows[t.tHead.rows.length-1];+			thead = true;+		} else {+			var firstRow = t.rows[0];+		}+	}+	if (!firstRow) return;+	+	// We have a first row: assume it's the header, and make its contents clickable links+	for (var i=0;i<firstRow.cells.length;i++) {+		var cell = firstRow.cells[i];+		var txt = ts_getInnerText(cell);+		if (cell.className != "unsortable" && cell.className.indexOf("unsortable") == -1) {+			cell.innerHTML = '<a href="#" class="sortheader" onclick="ts_resortTable(this, '+i+');return false;">'+txt+'<span class="sortarrow">&nbsp;&nbsp;<img src="'+ image_path + image_none + '" alt="&darr;"/></span></a>';+		}+	}+	if (alternate_row_colors) {+		alternate(t);+	}+}++function ts_getInnerText(el) {+	if (typeof el == "string") return el;+	if (typeof el == "undefined") { return el };+	if (el.innerText) return el.innerText;	//Not needed but it is faster+	var str = "";+	+	var cs = el.childNodes;+	var l = cs.length;+	for (var i = 0; i < l; i++) {+		switch (cs[i].nodeType) {+			case 1: //ELEMENT_NODE+				str += ts_getInnerText(cs[i]);+				break;+			case 3:	//TEXT_NODE+				str += cs[i].nodeValue;+				break;+		}+	}+	return str;+}++function ts_resortTable(lnk, clid) {+	var span;+	for (var ci=0;ci<lnk.childNodes.length;ci++) {+		if (lnk.childNodes[ci].tagName && lnk.childNodes[ci].tagName.toLowerCase() == 'span') span = lnk.childNodes[ci];+	}+	var spantext = ts_getInnerText(span);+	var td = lnk.parentNode;+	var column = clid || td.cellIndex;+	var t = getParent(td,'TABLE');+	// Work out a type for the column+	if (t.rows.length <= 1) return;+	var itm = "";+	var i = 1;+	while (itm == "") {+		var itm = ts_getInnerText(t.tBodies[0].rows[i].cells[column]);+		itm = trim(itm);+		if (itm.substr(0,4) == "<!--" || itm.length == 0) {+			itm = "";+		}+		i++;+	}+	sortfn = ts_sort_caseinsensitive;+	if (itm.match(/^\d\d[\/\.-][a-zA-z][a-zA-Z][a-zA-Z][\/\.-]\d\d\d\d$/)) sortfn = ts_sort_date;+	if (itm.match(/^\d\d[\/\.-]\d\d[\/\.-]\d\d\d{2}?$/)) sortfn = ts_sort_date;+	if (itm.match(/^-?[£$€Û¢´]\d/)) sortfn = ts_sort_numeric;+	if (itm.match(/^-?(\d+[,\.]?)+(E[-+][\d]+)?%?$/)) sortfn = ts_sort_numeric;+	SORT_COLUMN_INDEX = column;+	var firstRow = new Array();+	var newRows = new Array();+	for (k=0;k<t.tBodies.length;k++) {+		for (i=0;i<t.tBodies[k].rows[0].length;i++) { +			firstRow[i] = t.tBodies[k].rows[0][i]; +		}+	}+	for (k=0;k<t.tBodies.length;k++) {+		if (!thead) {+			// Skip the first row+			for (j=1;j<t.tBodies[k].rows.length;j++) { +				newRows[j-1] = t.tBodies[k].rows[j];+			}+		} else {+			// Do NOT skip the first row+			for (j=0;j<t.tBodies[k].rows.length;j++) { +				newRows[j] = t.tBodies[k].rows[j];+			}+		}+	}+	newRows.sort(sortfn);+	if (span.getAttribute("sortdir") == 'down') {+			ARROW = '&nbsp;&nbsp;<img src="'+ image_path + image_down + '" alt="&darr;"/>';+			newRows.reverse();+			span.setAttribute('sortdir','up');+	} else {+			ARROW = '&nbsp;&nbsp;<img src="'+ image_path + image_up + '" alt="&uarr;"/>';+			span.setAttribute('sortdir','down');+	} +    // We appendChild rows that already exist to the tbody, so it moves them rather than creating new ones+    // don't do sortbottom rows+    for (i=0; i<newRows.length; i++) { +		if (!newRows[i].className || (newRows[i].className && (newRows[i].className.indexOf('sortbottom') == -1))) {+			t.tBodies[0].appendChild(newRows[i]);+		}+	}+    // do sortbottom rows only+    for (i=0; i<newRows.length; i++) {+		if (newRows[i].className && (newRows[i].className.indexOf('sortbottom') != -1)) +			t.tBodies[0].appendChild(newRows[i]);+	}+	// Delete any other arrows there may be showing+	var allspans = document.getElementsByTagName("span");+	for (var ci=0;ci<allspans.length;ci++) {+		if (allspans[ci].className == 'sortarrow') {+			if (getParent(allspans[ci],"table") == getParent(lnk,"table")) { // in the same table as us?+				allspans[ci].innerHTML = '&nbsp;&nbsp;<img src="'+ image_path + image_none + '" alt="&darr;"/>';+			}+		}+	}		+	span.innerHTML = ARROW;+	alternate(t);+}++function getParent(el, pTagName) {+	if (el == null) {+		return null;+	} else if (el.nodeType == 1 && el.tagName.toLowerCase() == pTagName.toLowerCase()) {+		return el;+	} else {+		return getParent(el.parentNode, pTagName);+	}+}++function sort_date(date) {	+	// y2k notes: two digit years less than 50 are treated as 20XX, greater than 50 are treated as 19XX+	dt = "00000000";+	if (date.length == 11) {+		mtstr = date.substr(3,3);+		mtstr = mtstr.toLowerCase();+		switch(mtstr) {+			case "jan": var mt = "01"; break;+			case "feb": var mt = "02"; break;+			case "mar": var mt = "03"; break;+			case "apr": var mt = "04"; break;+			case "may": var mt = "05"; break;+			case "jun": var mt = "06"; break;+			case "jul": var mt = "07"; break;+			case "aug": var mt = "08"; break;+			case "sep": var mt = "09"; break;+			case "oct": var mt = "10"; break;+			case "nov": var mt = "11"; break;+			case "dec": var mt = "12"; break;+			// default: var mt = "00";+		}+		dt = date.substr(7,4)+mt+date.substr(0,2);+		return dt;+	} else if (date.length == 10) {+		if (europeandate == false) {+			dt = date.substr(6,4)+date.substr(0,2)+date.substr(3,2);+			return dt;+		} else {+			dt = date.substr(6,4)+date.substr(3,2)+date.substr(0,2);+			return dt;+		}+	} else if (date.length == 8) {+		yr = date.substr(6,2);+		if (parseInt(yr) < 50) { +			yr = '20'+yr; +		} else { +			yr = '19'+yr; +		}+		if (europeandate == true) {+			dt = yr+date.substr(3,2)+date.substr(0,2);+			return dt;+		} else {+			dt = yr+date.substr(0,2)+date.substr(3,2);+			return dt;+		}+	}+	return dt;+}++function ts_sort_date(a,b) {+	dt1 = sort_date(ts_getInnerText(a.cells[SORT_COLUMN_INDEX]));+	dt2 = sort_date(ts_getInnerText(b.cells[SORT_COLUMN_INDEX]));+	+	if (dt1==dt2) {+		return 0;+	}+	if (dt1<dt2) { +		return -1;+	}+	return 1;+}+function ts_sort_numeric(a,b) {+	var aa = ts_getInnerText(a.cells[SORT_COLUMN_INDEX]);+	aa = clean_num(aa);+	var bb = ts_getInnerText(b.cells[SORT_COLUMN_INDEX]);+	bb = clean_num(bb);+	return compare_numeric(aa,bb);+}+function compare_numeric(a,b) {+	var a = parseFloat(a);+	a = (isNaN(a) ? 0 : a);+	var b = parseFloat(b);+	b = (isNaN(b) ? 0 : b);+	return a - b;+}+function ts_sort_caseinsensitive(a,b) {+	aa = ts_getInnerText(a.cells[SORT_COLUMN_INDEX]).toLowerCase();+	bb = ts_getInnerText(b.cells[SORT_COLUMN_INDEX]).toLowerCase();+	if (aa==bb) {+		return 0;+	}+	if (aa<bb) {+		return -1;+	}+	return 1;+}+function ts_sort_default(a,b) {+	aa = ts_getInnerText(a.cells[SORT_COLUMN_INDEX]);+	bb = ts_getInnerText(b.cells[SORT_COLUMN_INDEX]);+	if (aa==bb) {+		return 0;+	}+	if (aa<bb) {+		return -1;+	}+	return 1;+}+function addEvent(elm, evType, fn, useCapture)+// addEvent and removeEvent+// cross-browser event handling for IE5+,	NS6 and Mozilla+// By Scott Andrew+{+	if (elm.addEventListener){+		elm.addEventListener(evType, fn, useCapture);+		return true;+	} else if (elm.attachEvent){+		var r = elm.attachEvent("on"+evType, fn);+		return r;+	} else {+		alert("Handler could not be removed");+	}+}+function clean_num(str) {+	str = str.replace(new RegExp(/[^-?0-9.]/g),"");+	return str;+}+function trim(s) {+	while (s.substring(0,1) == ' ') {+		s = s.substring(1,s.length);+	}+	while (s.substring(s.length-1,s.length) == ' ') {+		s = s.substring(0,s.length-1);+	}+	return s;+}+function alternate(table) {+	// Take object table and get all it's tbodies.+	var tableBodies = table.getElementsByTagName("tbody");+	// Loop through these tbodies+	for (var i = 0; i < tableBodies.length; i++) {+		// Take the tbody, and get all it's rows+		var tableRows = tableBodies[i].getElementsByTagName("tr");+		// Loop through these rows+		// Start at 1 because we want to leave the heading row untouched+		for (var j = 0; j < tableRows.length; j++) {+			// Check if j is even, and apply classes for both possible results+			if ( (j % 2) == 0  ) {+				if ( !(tableRows[j].className.indexOf('odd') == -1) ) {+					tableRows[j].className = tableRows[j].className.replace('odd', 'even');+				} else {+					if ( tableRows[j].className.indexOf('even') == -1 ) {+						tableRows[j].className += " even";+					}+				}+			} else {+				if ( !(tableRows[j].className.indexOf('even') == -1) ) {+					tableRows[j].className = tableRows[j].className.replace('even', 'odd');+				} else {+					if ( tableRows[j].className.indexOf('odd') == -1 ) {+						tableRows[j].className += " odd";+					}+				}+			} +		}+	}+}
+ html/lib/style.css view
@@ -0,0 +1,156 @@+body {+  margin: 0;+  padding: 0;+}++.comments {+  margin: 5px;+  width: 700px;+  border-width: 0.1px;+  border-style: solid;+  border-color: saddlebrown;+  padding: 5px;+}++.commentReply {+  border-width: 0.1px;+  border-style: solid;+  border-color: saddlebrown;+  padding: 5px;+  margin-top: 5px;+  margin-bottom: 5px;+  margin-left: auto;+  margin-right: auto;+  background: cornsilk;+  width: 670px;+  display: block;+}++.commentClassF {+  border: inherit;+  padding: inherit;+  margin: 5px;+  background: snow;+}++.commentClassT {+  border: inherit;+  padding: inherit;+  margin: 5px;+  background: cornsilk;+}++.replies {+  font-family: sans-serif;+  font-style: italic;+  font-size: 80%;+  text-align: right;+}++.commentMeta {+  font-family: sans-serif;+  font-style: italic;+  font-size: 90%;+  text-align: center;+}++h1 { margin-top: 0;}++.rightAlign {+  margin-left: auto;+  margin-right: 0;+  display: block;+  padding: inherit;+}++th { text-align: left; }++.textField {+  width: 256px;+}++#navcontainer ul {+  padding-right: 0;+  margin-right: 0;+  margin-top: 0;+  background-color: cornsilk;+  color: saddlebrown;+  float: right;+  width: 100%;+  border-bottom: 1px solid saddlebrown;+  font-family: sans-serif;+}++#navcontainer ul li { display: inline; }++#navcontainer ul li a+{+  padding: 3px 15px 3px 15px;+  background-color: cornsilk;+  color: saddlebrown;+  text-decoration: none;+  float: right;+  border-left: 1px solid saddlebrown;+}++#navcontainer ul li a:hover+{+  background-color: snow;+  text-decoration: underline;+  color: saddlebrown;+}++.sortable {+  border-collapse: collapse;+  margin: 5px;+  padding: 5px;+}++.unsortable {+  display: none;+}++.sortable .tableHeading {+  text-align: center;+  font-weight: bold;+  background-color: white;+}++.sortable .tableHeading a {+  text-decoration: none;+  color: saddlebrown;+}++.sortable .tableHeading a:hover {+  text-decoration: underline;+  color: saddlebrown;+}++.sortable td {+  border: 1px solid saddlebrown;+  margin: 2px;+  padding: 4px;+}++.odd {+  background: snow;+}++.even {+  background: cornsilk;+}++.sortable a img {+  border-style: none;+}++.sortable a {+  text-decoration: none;+  color: black;+}++.sortable a:hover {+  text-decoration: underline;+  color: black;+}+
+ html/lib/unordered.png view

binary file changed (absent → 482 bytes)

+ html/templates/bugList.html view
@@ -0,0 +1,89 @@+<!-- BEGIN page -->+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">+<html>++ <head>+  <meta http-equiv="Content-Type" content="text/html">+  <meta http-equiv="pragma" content="no-cache">+  <meta http-equiv="expires" content="-1">+  <title>Bug Listing</title>+  <base href="file://##base##">+  <link rel="stylesheet" href="html/lib/style.css" type="text/css" media="screen, projection">+  <script type="text/javascript" src="html/lib/json.js"></script>+  <script type="text/javascript" src="html/lib/prototype.js"></script>+  <script type="text/javascript" src="html/lib/DisTractRun.js"></script>++  <script type="text/javascript">+  var basePath = '##base##';++  var rebuildAllFunc = runRebuildAllFunc(basePath);++  function rebuildAll () {+    rebuildAllFunc();+    reloadList();+  }++  function reloadList () {+    var url = 'file://' + basePath + 'html/list.html';+    window.location.replace(url);+    return true;+  }++  window.onload=populateTable();++  function populateTable () {+    return function () {+      var table = $("listingTable");+      var thRow = table.insertRow(-1);+      for (var idx=0; idx < fieldsList.length; ++idx) {+        var th = thRow.insertCell(-1);+        var text = document.createTextNode(fieldsList[idx] + "_hidden");+        th.className = "unsortable";+        th.appendChild(text);+        th = thRow.insertCell(-1);+        text = document.createTextNode(fieldsList[idx]);+        th.className = "tableHeading";+        th.appendChild(text);+      }++      for (var bugIdx=0; bugIdx < bugsList.length; ++bugIdx) {+        var bug = bugsList[bugIdx];+        var bugPage = 'html/' + bug['BugId'] + '.html';+        var tr = table.insertRow(-1);+        for (var fieldIdx=0; fieldIdx < fieldsList.length; ++fieldIdx) {+          var field = fieldsList[fieldIdx];+          var td = tr.insertCell(-1);+          var link = document.createElement("a");+          link.href = bugPage;+          var text = document.createTextNode(bug[field]);+          link.appendChild(text);+          td.appendChild(link);+          td = tr.insertCell(-1);+          text = document.createTextNode(bug[field + "_order"]);+          td.appendChild(text);+          td.className = "unsortable";+        }+      }+    };+  }++##bugsList##+  </script>++  <script type="text/javascript" src="html/lib/sortable.js"></script>+ </head>+ <body>+  <div id="navcontainer">+   <ul id="navlist">+    <li id="active"><a href="html/list.html" id="current">List Bugs</a></li>+    <li><a href="html/newBug.html">Enter New Bug</a></li>+    <li><a href="#" onclick="rebuildAll(); return false;">Rebuild All Bugs</a></li>+   </ul>+  </div>+  <h1>Bug Listing</h1>+  <table id="listingTable" class="sortable">+  </table>+  <div class="replies">Page generated at ##generation_time## by ##version##</div>+ </body>+</html>+<!-- END -->
+ html/templates/bugNew.html view
@@ -0,0 +1,77 @@+<!-- BEGIN page -->+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">+<html>+ <head>+  <meta http-equiv="Content-Type" content="text/html">+  <meta http-equiv="pragma" content="no-cache">+  <meta http-equiv="expires" content="-1">+  <title>Enter New Bug</title>+  <base href="file://##base##">+  <link rel="stylesheet" href="html/lib/style.css" type="text/css" media="screen, projection">+  <script type="text/javascript" src="html/lib/json.js"></script>+  <script type="text/javascript" src="html/lib/markdown.js"></script>+  <script type="text/javascript" src="html/lib/prototype.js"></script>+  <script type="text/javascript" src="html/lib/DisTractBug.js"></script>+  <script type="text/javascript" src="html/lib/DisTractRun.js"></script>+  <script type="text/javascript">+var updatePreviewFunc = updateCommentPreviewFunc('description-preview');+var basePath = '##base##';++var newBugFunc = runNewBugFunc(basePath);+var rebuildBugFunc = runRebuildBugFunc(basePath);+var rebuildAllFunc = runRebuildAllFunc(basePath);++function rebuild (bugId) {+  rebuildBugFunc(bugId, 'False');+  var url = 'file://' + basePath + 'html/' + bugId + '.html';+  window.location.assign(url);+  return true;+}++function makeNewBugObject () {+  var obj = new Object();+  var text = $('description-textarea').value;+  if (text.length > 0) {+    obj.text = text;+  }+  obj.fields = makeFieldsObject();+  var jsonString = obj.toJSONString();+  var bugId = writeToTempFile(jsonString, newBugFunc);+  if (null == bugId) {+    alert('Could not create the bug. Ensure fields are filled out correctly.');+  } else {+    rebuild(bugId);+  }+  return true;+}++  </script>+ </head>+ <body>+  <div id="navcontainer">+   <ul id="navlist">+    <li id="active"><a href="html/list.html" id="current">List Bugs</a></li>+    <li><a href="html/newBug.html">Enter New Bug</a></li>+    <li><a href="#" onclick="rebuildAllFunc(); return false;">Rebuild All Bugs</a></li>+   </ul>+  </div>+  <h1>Enter New Bug</h1>+  <div class="comments">+   <form>+    <table style="margin-left: auto; margin-right: auto;">+##fields##+    </table>+    <div class="replies">Description Preview</div>+    <div class="commentReply" id="description-preview"></div>+    <textarea class="commentReply" name="description-textarea"+              rows="20" id="description-textarea" style="background: white;"+              onkeyup="updatePreviewFunc(this.value);"+    ></textarea>+    <input type="button" onclick="makeNewBugObject();"+           value="Create Bug" class="rightAlign">+   </form>+  </div>+  <div class="replies">Page generated at ##generation_time## by ##version##</div>+ </body>+</html>+<!-- END -->
+ html/templates/bugView.html view
@@ -0,0 +1,111 @@+<!-- BEGIN page -->+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">+<html>+<!-- ##title## -->+<!-- BEGIN header -->+ <head>+  <meta http-equiv="Content-Type" content="text/html">+  <meta http-equiv="pragma" content="no-cache">+  <meta http-equiv="expires" content="-1">+  <title>Viewing bug ##bugId##</title>+  <base href="file://##base##">+  <link rel="stylesheet" href="html/lib/style.css" type="text/css" media="screen, projection">+  <script type="text/javascript" src="html/lib/json.js"></script>+  <script type="text/javascript" src="html/lib/markdown.js"></script>+  <script type="text/javascript" src="html/lib/prototype.js"></script>+  <script type="text/javascript" src="html/lib/DisTractBug.js"></script>+  <script type="text/javascript" src="html/lib/DisTractRun.js"></script>+  <script type="text/javascript">+var updatePreviewFunc = updateCommentPreviewFunc('comment-preview');+var appendToReply = appendToReplyFunc('comment-textarea',+                                      'comment-inReplyTo',+                                      updatePreviewFunc);++var basePath = '##base##';+var bugId = '##bugId##';++var modifyBugFunc = runModifyBugFunc(basePath);+var rebuildBugFunc = runRebuildBugFunc(basePath);+var rebuildAllFunc = runRebuildAllFunc(basePath);++function rebuild (bugId) {+  rebuildBugFunc(bugId, 'True');+  reloadThisBug();+}++function rebuildAll () {+  rebuildAllFunc();+  reloadThisBug();+}++function reloadThisBug () {+  var url = 'file://' + basePath + 'html/' + bugId + '.html';+  window.location.replace(url);+  return true;+}++function modifyBug () {+  var obj = new Object();+  obj.bugId = bugId;+  obj.fields = makeFieldsObject();+  obj.comment = makeCommentsObject();+  var jsonString = obj.toJSONString();+  writeToTempFile(jsonString, modifyBugFunc);+  rebuild(bugId);+  return true;+}++  </script>+ </head>+ <body>+  <div id="navcontainer">+   <ul id="navlist">+    <li id="active"><a href="html/list.html" id="current">List Bugs</a></li>+    <li><a href="html/newBug.html">Enter New Bug</a></li>+    <li><a href="#" onclick="rebuild(bugId); return false;">Rebuild This Bug</a></li>+    <li><a href="#" onclick="rebuildAll(); return false;">Rebuild All Bugs</a></li>+   </ul>+  </div>+  <h1>##bugId##</h1>+<!-- END -->+  <div class="comments">+   <table style="margin-left: auto; margin-right: auto;">+<!-- ##summary## -->+   </table>+<!-- ##comments## -->+<!-- BEGIN comment -->+   <div class="##class##"><a name="##id##"></a>+    <div class="commentMeta">Comment ##id## by ##author## at ##date##</div>+    <div class="comment" id="##id##"></div>+    <script type="text/javascript">+      registerComment('##id##', ##textJson##, '##date##', '##author##');+    </script>+    <div class="commentMeta"><a href="html/##bugFile###replyAnchor"+                                onclick="appendToReply('##id##');">Reply to this comment</a></div>+##replies##+<!-- BEGIN commentReplies -->+    <div class="replies">Replies</div>+##replies##+<!-- END -->+   </div>+<!-- END -->+   <form>+    <div class="replies">Reply Preview</div>+    <input type="hidden" value="root"+           name="comment-inReplyTo" id="comment-inReplyTo">+    <div class="commentReply" id="comment-preview"></div>+    <a name="replyAnchor"></a><textarea class="commentReply" name="comment-textarea"+              rows="20" id="comment-textarea" style="background: white;"+              onkeyup="updatePreviewFunc(this.value);"+    ></textarea>+    <table style="margin-left: auto; margin-right: auto;">+##fields##+    </table>+    <input type="button" onclick="modifyBug();"+           value="Commit Changes" class="rightAlign">+   </form>+  </div>+  <div class="replies">Page generated at ##generation_time## by ##version##</div>+ </body>+</html>+<!-- END -->
+ html/templates/fields.html view
@@ -0,0 +1,27 @@+<!-- BEGIN field -->+<!-- BEGIN summary -->+<th>##name##</th><td>##value##</td>+<!-- END -->+<th>##name##</th><td>##input##</td>+<script type="text/javascript">registerField('##name##', ##valueJson##);</script>+<!-- BEGIN freeform -->+<input class="textField" type="text" id="##name##" name="##name##" value="">+<script type="text/javascript">$("##name##").value=##valueJson##;</script>+<!-- END -->+<!-- BEGIN simpleValues -->+<select id="##name##" name="##name##" size="1">+##options##+<!-- BEGIN selectOption -->+<option value=##valueJson## ##selected##>##text##</option>+<!-- END -->+</select>+<!-- END -->+<!-- BEGIN graphValues -->+<div id="##name##">+##options##+<!-- BEGIN radioOption -->+<label><input type="radio" name="##name##" value=##valueJson## ##checked##>##text##</label>+<!-- END -->+</div>+<!-- END -->+<!-- END -->
+ scripts/addCommentToRoot.json view
@@ -0,0 +1,7 @@+{"bugId":"bug-20070417T142719S283-matthew@wellquite.org",+ "fields":{},+ "comment":{"inReplyTo":"root",+            "text":"A reply to the root comment. Two!\nWith a second line!"+	   }+}+
+ scripts/defaultFields/Assigned view
@@ -0,0 +1,3 @@+{"default":"",+ "type":"free"+}
+ scripts/defaultFields/Created view
@@ -0,0 +1,1 @@+{"type":"pseudo"}
+ scripts/defaultFields/Milestone view
@@ -0,0 +1,9 @@+{"default":"Milestone 1",+ "type":"simple",+ "values":["Milestone 1",+           "Milestone 2",+           "Milestone 3",+           "Milestone 4",+           "Milestone 5"+          ]+}
+ scripts/defaultFields/Reporter view
@@ -0,0 +1,1 @@+{"type":"pseudo"}
+ scripts/defaultFields/Status view
@@ -0,0 +1,8 @@+{"default":"New",+ "type":"graph",+ "values":{"New":{"Accept":"Accepted","Mark as Duplicate":"Duplicated"},+           "Accepted":{"New":"New","Resolve Fixed":"Fixed"},+           "Duplicated":{"Reopen":"New"},+           "Fixed":{"Reopen":"New"}+          }+}
+ scripts/defaultFields/Title view
@@ -0,0 +1,3 @@+{"default":"",+ "type":"free"+}
+ scripts/monotonerc view
@@ -0,0 +1,37 @@+-- special monotonerc file to be installed in bugs/_MTN/+-- force the merge to use our magic merge system++function merge3 (anc_path, left_path, right_path, merged_path, ancestor, left, right)+   local result = nil+   local lfile = write_to_temporary_file (left, "left")+   local afile = write_to_temporary_file (ancestor, "ancestor")+   local rfile = write_to_temporary_file (right, "right")+   local outfile = write_to_temporary_file ("", "merged")++   local path = "disTractMerger"+   if (program_exists_in_path (path)) then+      local returnCode = execute(path,+                                 anc_path,+                                 left_path,+                                 right_path,+                                 merged_path,+                                 afile,+                                 lfile,+                                 rfile,+                                 outfile)+      if (returnCode == 0) then+         result = read_contents_of_file (outfile, "r")+      end+   end++   if (result == nil) then+      io.write (string.format(gettext("Error executing disTractMerger: '%s'\n"), path))+   end++   os.remove (lfile)+   os.remove (rfile)+   os.remove (afile)+   os.remove (outfile)++   return result+end
+ scripts/newBug.json view
@@ -0,0 +1,5 @@+{"text":"This is a comment belonging to this new bug!",+ "fields":{"title":"The title of this new bug",+           "milestone":"Milestone 2"+          }+}
+ scripts/setup.sh view
@@ -0,0 +1,109 @@+#! /bin/sh++# What's needed:+# Monotone+# TMPDIR++BINARIES="DisTractNewBug DisTractUpdateBug DisTractUpdateAllBugs DisTractFormatBug DisTractFormatNew"++MTN=$(which mtn)+if [[ "x$MTN" == "x" || ! -x $MTN ]]+then+    echo "Unable to locate monotone (mtn) executable."+    exit 1+fi++MKTEMP=$(which mktemp)+if [[ "x$MKTEMP" == "x" || ! -x $MKTEMP ]]+then+    echo "Unable to locate mktemp executable."+    exit 1+fi++RM=$(which rm)+if [[ "x$RM" == "x" || ! -x $RM ]]+then+    echo "Unable to locate rm executable!"+    exit 1+fi++MKDIR=$(which mkdir)+if [[ "x$MKDIR" == "x" || ! -x $MKDIR ]]+then+    echo "Unable to locate mkdir executable!"+    exit 1+fi++SED=$(which sed)+if [[ "x$SED" == "x" || ! -x $SED ]]+then+    echo "Unable to locate sed executable!"+    exit 1+fi++HEAD=$(which head)+if [[ "x$HEAD" == "x" || ! -x $HEAD ]]+then+    echo "Unable to locate head executable!"+    exit 1+fi++DIR_TEMPLATE=DisTractSetup.XXXXXXXXXX+DIR=$($MKTEMP -t -d $DIR_TEMPLATE) || exit 1+MTNDB=$DIR/db.mtn+INITDIR=$(pwd)+#1. Make new mtn database+#2. Make necessary directories+#3. Create suitable branches+   $MTN -d $MTNDB db init \+&& USER=$($MTN -d $MTNDB ls keys | $SED -n '/\[private/,${/^[0-9a-f]/s/[0-9a-f]* //p}' | $HEAD -n 1) \+&& if [ -z $USER ]+   then+     echo "Can't find suitable user from monotone private keys"+     exit 1+   else+     echo "Using userid $USER"+   fi \+&& for d in bugs bin html prefs+   do+     $MKDIR $DIR/$d+   done \+&& $MTN -d $MTNDB setup -b DisTract.bugs $DIR/bugs \+&& $MTN -d $MTNDB setup -b DisTract.prefs.$USER $DIR/prefs \+&& cp monotonerc $DIR/bugs/_MTN/ \+&& pushd . \+&& cd $DIR/prefs \+&& echo -e "mtn=$MTN\ndb=$MTNDB" > config \+&& echo "^config$" > .mtn-ignore \+&& $MTN -d $MTNDB add .mtn-ignore \+&& $MTN -d $MTNDB ci -m "Adding .mtn-ignore" . \+&& cd $DIR/bugs \+&& echo "^bug-" > .mtn-ignore \+&& $MKDIR fields \+&& cp $INITDIR/defaultFields/* fields/ \+&& $MTN -d $MTNDB ls unknown | xargs $MTN -d $MTNDB add \+&& $MTN -d $MTNDB ci -m "Adding .mtn-ignore and default fields" . \+&& popd++for binary in $BINARIES+do+    if [ -x ../haskell/dist/build/$binary/$binary ]+    then+        cp ../haskell/dist/build/$binary/$binary $DIR/bin/$binary+    fi+done++if [ -d ../html/lib ]+then+    cp -a ../html/lib $DIR/html/+fi++$DIR/bin/DisTractFormatNew $DIR++if [ -z $NOCLEAN ]+then+    $($RM -rf $DIR)+else+    echo "NOCLEAN set, not cleaning up $DIR"+    echo "PATH=$DIR/bin:\$PATH"+fi
+ src/DisTract/Bug.hs view
@@ -0,0 +1,139 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module DisTract.Bug+    (makeNewBug,+     loadBug,+     updateBug+    )+where++import System.Directory+import System.FilePath+import System.IO+import DisTract.Types+import DisTract.Layout+import DisTract.Bug.Comment+import DisTract.Bug.Field+import DisTract.Bug.PseudoField+import DisTract.Monotone.Interaction+import Data.Maybe+import Data.Time+import qualified Data.Map as M+import qualified JSON as J++makeNewBug :: Config -> String -> M.Map String J.Value -> IO Bug+makeNewBug config@(Config { user = user, logger = logger }) comment fields+    = do { now <- getCurrentTime+         ; let bid = bid' now+         ; let bidStr = show bid+         ; logStr logger $ bidStr+         ; let bugPath = bugIdToPath config bid+         ; exists <- doesDirectoryExist bugPath+         ; result <- if exists+                     then makeNewBug config comment fields+                     else do { branchBase <- mtnFindCurrentBranch config bugs+                             ; let newBranch = branchBase ++ ('.':bidStr)+                             ; mtnSetupBranch config newBranch bugPath+                             ; addBugBranchFiles bugPath bid+                             ; createDirectory (combine bugPath commentsDir)+                             ; createDirectory (combine bugPath fieldsDir)+                             ; comments <- writeComment config bid comment Nothing+                             ; fieldsValidated <- writeFields config bid fields+                             ; mtnAddUnknownFiles config bugPath+                             ; hash <- mtnCommit config bugPath (summariseBug bidStr fieldsValidated) []+                             ; logStr logger $ "Committed revision " ++ (show hash)+                             ; let bug = Bug bid comments fieldsValidated+                             ; bug' <- loadPseudoFields config bug+                             ; return bug'+                             }+         ; return result+         }+    where+      bid' = flip BugId user+      summariseBug :: String -> FieldValues -> String+      summariseBug bugIdStr fields+          = unlines $ ("Creation of bug " ++ bugIdStr)+                      : (M.foldWithKey summariseField [] fields)+      summariseField :: String -> FieldValue -> [String] -> [String]+      summariseField key (FieldValue value _) acc+          = ((key ++ padding ++ value) : acc)+          where+            padding = replicate (15 - (length key)) ' '                                          ++addBugBranchFiles :: FilePath -> BugId -> IO ()+addBugBranchFiles path bid+    = do { h <- openFile uidPath WriteMode+         ; hPutStrLn h $ show bid+         ; hClose h+         }+    where+      uidPath = combine path uidFile++uidFile :: FilePath+uidFile = "bugId"++loadBug :: Config -> BugId -> IO (Maybe Bug)+loadBug config bid+    = do { exists <- doesDirectoryExist bugPath+         ; if exists+           then loadBugFromFiles config bid >>= return . Just+           else do { branchBase <- mtnFindCurrentBranch config bugs+                   ; let bugBranch = branchBase ++ ('.':bidStr)+                   ; log bugBranch+                   ; branchExists <- mtnDoesBranchExist config bugBranch+                   ; if branchExists+                     then do { mtnCheckOutBranch config bugs bugBranch bidStr+                             ; loadBug config bid+                             }+                     else return Nothing+                   }+         }+    where+      bugPath = bugIdToPath config bid+      bidStr = show bid+      log = logStr . logger $ config++loadBugFromFiles :: Config -> BugId -> IO Bug+loadBugFromFiles config bid+    = do { comments <- loadComments config bid+         ; fields <- loadFields config bid+         ; let bug = Bug bid comments fields+         ; bug' <- loadPseudoFields config bug+         ; return bug'+         }++updateBug :: Config -> BugId -> Maybe (String, String) -> M.Map String J.Value ->+             IO (Maybe Bug)+updateBug config bid newComment newFields+    = do { bugM <- loadBug config bid+         ; case bugM of+             Nothing -> return Nothing+             (Just bug) -> do { bugC <- addComment config bug newComment+                              ; (bugCF, newFieldValues) <- updateFields config bugC newFields+                              ; hash <- mtnCommit config bugPath (summariseBug (show bid) newFieldValues) []+                              ; log $ "Committed revision " ++ (show hash)+                              ; return $ Just $ bugCF+                              }+         }+    where+      bugPath = bugIdToPath config bid+      log = logStr . logger $ config++      summariseBug :: String -> [FieldValue] -> String+      summariseBug bugIdStr fields+          = unlines $ ("Update to bug " ++ bugIdStr)+                      : (foldr summariseField [] fields)+      summariseField :: FieldValue -> [String] -> [String]+      summariseField (FieldValue value field) acc+          = ((key ++ padding ++ value) : acc)+          where+            padding = replicate (15 - (length key)) ' '+            key = fieldName field
+ src/DisTract/Bug/Comment.hs view
@@ -0,0 +1,185 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module DisTract.Bug.Comment+    (loadComments,+     commentsDir,+     writeComment,+     addComment+    )+where++import DisTract.Utils+import DisTract.Types+import DisTract.Layout+import DisTract.JSONUtils+import DisTract.Monotone.Interaction+import DisTract.Monotone.Types+import qualified JSON as J+import qualified Data.Map as M+import Data.Maybe+import Data.List+import Data.Time+import System.FilePath+import System.Directory+import Control.Monad++commentsDir :: FilePath+commentsDir = "comments"++rootCommentFile :: FilePath+rootCommentFile = "root"++commentKeyInReplyTo :: String+commentKeyInReplyTo = "InReplyTo"++commentKeyComment :: String+commentKeyComment = "Comment"++loadComments :: Config -> BugId -> IO Comment+loadComments config bugId+    = do { files <- getDirectoryContents commentsPath+         ; comments <- mapM (readCommentFile commentsPath) files+         ; let commentsMaps = foldr buildCommentsMaps (M.empty, M.empty) comments+         ; authorsMap <- foldM fetchLog M.empty files+         ; return (buildComments commentsMaps authorsMap rootCommentFile)+         }+    where+      workspace = bugIdToPath config bugId+      commentsPath = combine workspace commentsDir+      fetchLog :: (M.Map FilePath LogBrief) -> FilePath ->+                  IO (M.Map FilePath LogBrief)+      fetchLog acc file+          = do { isFile <- doesFileExist fullPath+               ; if isFile+                 then do { [log] <- mtnLogBrief config workspace ["--last", "1"]+                                    . combine commentsDir $ file+                         ; return (M.insert file log acc)+                         }+                 else return acc+               }+          where+            fullPath = combine commentsPath file++buildComments :: (M.Map FilePath String, M.Map FilePath [FilePath]) ->+                 M.Map FilePath LogBrief -> FilePath -> Comment+buildComments maps@(m1, m2) m3 node = Comment node author time comment followups+    where+      author = logRevisionAuthor logBrief+      time = logRevisionTime logBrief+      (Just logBrief) = M.lookup node m3+      (Just comment) = M.lookup node m1+      followups = case M.lookup node m2 of+                    Nothing -> []+                    (Just next) -> map (buildComments maps m3) (sort next)++buildCommentsMaps :: Maybe (FilePath, FilePath, String) ->+                     (M.Map FilePath String, M.Map FilePath [FilePath]) ->+                     (M.Map FilePath String, M.Map FilePath [FilePath])+buildCommentsMaps Nothing maps = maps+buildCommentsMaps (Just (file, reply, comment)) (m1, m2) = (m1', m2')+    where+      m1' = M.insert file comment m1+      m2' = M.alter buildCommentsMaps' reply m2+      buildCommentsMaps' :: Maybe [FilePath] -> Maybe [FilePath]+      buildCommentsMaps' Nothing = Just [file]+      buildCommentsMaps' (Just rest) = Just (file:rest)++readCommentFile :: FilePath -> FilePath -> IO (Maybe (FilePath, FilePath, String))+readCommentFile path file+    = do { isFile <- doesFileExist fullPath+         ; if isFile+           then do { contents <- readFileStrict fullPath+                   ; return $ case J.parse contents of+                                (Just (J.Object obj)) ->+                                    Just (file,+                                          lookupJsonString obj commentKeyInReplyTo,+                                          lookupJsonString obj commentKeyComment+                                         )+                                _ -> Nothing+                   }+           else return Nothing+         }+    where fullPath = combine path file++writeComment :: Config -> BugId -> String -> Maybe String -> IO Comment+writeComment config@(Config{ user = user }) bid comment Nothing+    = writeComment' user commentsPath comment Nothing rootCommentFile+    where+      bugDir = bugIdToPath config bid+      commentsPath = combine bugDir commentsDir+writeComment config@(Config{ user = user }) bid comment (Just inReplyTo)+    = do { now <- getCurrentTime -- UTC+         ; let commentFileName = bugIdTimeFormatter now+         ; exists <- doesFileExist $ combine commentsPath commentFileName+         ; if exists+           then writeComment config bid comment (Just inReplyTo)+           else writeComment' user commentsPath comment (Just inReplyTo) commentFileName+         }+    where+      bugDir = bugIdToPath config bid+      commentsPath = combine bugDir commentsDir++writeComment' :: String -> FilePath -> String -> Maybe String -> FilePath -> IO Comment+writeComment' user commentsPath text inReplyTo commentId+-- Eek, the comment that's returned does not have a valid time.+-- This is because the time used is the commit time. Hmmm.+    = do { writeFileStrict (combine commentsPath commentId) jsonText+         ; now <- getCurrentTime+         ; return $ Comment commentId user now text []+         }+    where+      jsonText = (J.stringify (J.Object obj)) ++ "\n"+      obj = M.fromList ((commentKeyComment, J.String text):reply:[])+      reply = maybe (commentKeyInReplyTo, J.String "")+              ((,) commentKeyInReplyTo . J.String) inReplyTo++addComment :: Config -> Bug -> Maybe (String, String) -> IO Bug+addComment _ bug Nothing = return bug+addComment config bug@(Bug bid comments _) (Just newComment)+    = do { (comments', file) <- addComment' config bid newComment (comments, Nothing)+         ; case file of+             (Just fileName) -> mtnAdd config bugDir [combine commentsDir fileName]+                 where+                   bugDir = bugIdToPath config bid+             Nothing -> return ()+         ; return $ bug { bugComments = comments' }+         }++addComment' :: Config -> BugId -> (String, String) -> (Comment, Maybe FilePath) ->+               IO (Comment, Maybe FilePath)+addComment' _ _ _ cp@(_, Just _) = return cp+addComment' config bid newComment@(text, inReplyTo)+                (comment@(Comment path author time body comments), Nothing)+    = case inReplyTo == path of+        False -> do { (comments', filePathM) <- foldM addCommentHelper ([], Nothing) comments+                    ; return ((Comment path author time body (reverse comments')),+                              filePathM)+                    }+        True -> do { now <- getCurrentTime+                   ; let commentFileName = bugIdTimeFormatter now+                   ; exists <- doesFileExist $ combine commentsPath commentFileName+                   ; if exists+                     then addComment' config bid newComment (comment, Nothing)+                     else do { cmt <- writeComment' (user config) commentsPath+                                      text (Just inReplyTo) commentFileName+                             ; return ((Comment path author time body (comments ++ [cmt])),+                                       Just commentFileName)+                             }+                   }+    where+      bugDir = bugIdToPath config bid+      commentsPath = combine bugDir commentsDir+      addCommentHelper :: ([Comment], Maybe FilePath) -> Comment ->+                          IO ([Comment], Maybe FilePath)+      addCommentHelper (commentsAcc, filePathM) comment+          = do { (comment', filePathM') <- addComment' config bid newComment (comment, filePathM)+               ; return (comment':commentsAcc, filePathM')+               }
+ src/DisTract/Bug/Field.hs view
@@ -0,0 +1,247 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module DisTract.Bug.Field+    (loadFieldDfns,+     fieldsDir,+     writeFields,+     loadFields,+     updateFields+    )+where++import DisTract.Bug.PseudoField+import DisTract.Utils+import DisTract.Types+import DisTract.Layout+import qualified Data.Map as M+import qualified JSON as J+import System.FilePath+import System.Directory+import Data.Maybe+import Data.List+import Control.Monad++fieldsDir :: FilePath+fieldsDir = "fields"++defaultValueKey :: String+defaultValueKey = "default"++fieldTypeKey :: String+fieldTypeKey = "type"++fieldValuesKey :: String+fieldValuesKey = "values"++graphType :: String+graphType = "graph"++simpleType :: String+simpleType = "simple"++freeType :: String+freeType = "free"++pseudoType :: String+pseudoType = "pseudo"++loadFieldDfns :: Config -> IO (M.Map String Field)+loadFieldDfns Config{ baseDir = base }+    = do { files <- getDirectoryContents fieldsPath+         ; fieldDefs <- mapM (readFieldDef fieldsPath) files+         ; return $ M.fromList . map (fieldName >>= (,)) . catMaybes $ fieldDefs+         }+    where+      fieldsPath = combine (bugsDir base) fieldsDir++readFieldDef :: FilePath -> FilePath -> IO (Maybe Field)+readFieldDef fieldsPath field+    = do { isFile <- doesFileExist fullPath+         ; if isFile+           then do { contents <- readFileStrict fullPath+                   ; return $ case J.parse contents of+                                (Just (J.Object obj)) -> Just $ buildFieldDfn field obj+                                _ -> Nothing+                   }+           else return Nothing+         }+    where+      fullPath = combine fieldsPath field++buildFieldDfn :: String -> (M.Map String J.Value) -> Field+buildFieldDfn name obj+    = case fieldType of+        Nothing -> error $ "Cannot find field type for field '" ++ name ++ "'"+        (Just (J.String t))+            | t == graphType -> buildGraphField name obj+            | t == simpleType -> buildSimpleField name obj+            | t == freeType -> buildFreeField name obj+            | t == pseudoType -> buildPseudoField name obj+            | otherwise -> error $ "Unknown field type '" ++ t +++                           "' for field '" ++ name ++ "'"+        _ -> error $ "Cannot parse field type for field '" ++ name ++ "'"+    where+      fieldType = M.lookup fieldTypeKey obj++buildPseudoField :: String -> (M.Map String J.Value) -> Field+buildPseudoField name _ = pseudoFieldDfn (read name)++buildFreeField :: String -> (M.Map String J.Value) -> Field+buildFreeField name obj = f+    where+      f = Field { fieldName = name,+                  fieldDefault = initValue,+                  fieldType = FieldFreeForm,+                  fieldValidator = (Just . flip FieldValue f)+                }+      initValue = FieldValue init f+      init = getDefaultValueForField name obj++buildSimpleField :: String -> (M.Map String J.Value) -> Field+buildSimpleField name obj = f+    where+      f = Field { fieldName = name,+                  fieldDefault = initValue,+                  fieldType = (FieldSimpleValues values),+                  fieldValidator = validator+                }+      initValue = FieldValue init f+      init = getDefaultValueForField name obj+      (J.Array valuesJ) = fromMaybe (error $ "No values found for field '" +++                                           name ++ "'")+                          $ M.lookup fieldValuesKey obj+      values = nub $ map convert valuesJ+      validator :: Validator+      validator v = fmap (const $ FieldValue v f) (elemIndex v values)+      convert :: J.Value -> String+      convert (J.String v) = v+      convert v = error $ "Unexpected value '" ++ (show v) +++                  "' for field '" ++ name ++ "'"++buildGraphField :: String -> (M.Map String J.Value) -> Field+buildGraphField name obj = f+    where+      f = Field { fieldName = name,+                  fieldDefault = initValue,+                  fieldType = (FieldGraph values),+                  fieldValidator = validator+                }+      initValue = FieldValue init f+      init = getDefaultValueForField name obj+      (J.Object valuesObj) = fromMaybe (error $ "No values found for field '" +++                                              name ++ "'")+                             $ M.lookup fieldValuesKey obj+      values = M.map convertAndCheck valuesObj+      validator :: Validator+      validator v = if M.member v values+                    then Just $ FieldValue v f+                    else Nothing+      convertAndCheck :: J.Value -> [(String,String)]+      convertAndCheck (J.Object transitionsObj)+          = M.foldWithKey convertAndCheck' [] transitionsObj+      convertAndCheck v = error $ "Unexpected value '" ++ (show v) +++                          "' for field '" ++ name ++ "'"+      convertAndCheck' :: String -> J.Value -> [(String,String)] ->+                          [(String,String)]+      convertAndCheck' verb (J.String next) acc+          = case M.member next values of+              True -> (verb, next):acc+              _ -> error $ "Field '" ++ name ++ "' references a value '" ++ next +++                   "' without defining it."+      convertAndCheck' _ next _ = error $ "Unexpected reference '" ++ (show next) +++                                  "' in field '" ++ name ++ "'"++getDefaultValueForField :: String -> (M.Map String J.Value) -> String+getDefaultValueForField name obj = init+    where+      (J.String init) = fromMaybe+                        (error $ "Can't find default value for field '" +++                               name ++ "'")+                        $ M.lookup defaultValueKey obj++writeFields :: Config -> BugId ->+               M.Map String J.Value -> IO FieldValues+writeFields config@(Config{ fieldDfns = dfns }) bid values+    = foldM (writeField fieldsPath) M.empty validated+    where+      bugPath = bugIdToPath config bid+      fieldsPath = combine bugPath fieldsDir+      validated = M.foldWithKey validator [] $ dfns+      validator :: String -> Field -> [FieldValue] -> [FieldValue]+      validator _ (PseudoField {}) acc = acc+      validator name dfn acc+          = case value of+              (Just (J.String v)) -> (fromMaybe dflt (fieldValidator dfn v)):acc+              _ -> dflt:acc+            where+              value = M.lookup name values+              dflt = fieldDefault dfn++updateFields :: Config -> Bug ->+               M.Map String J.Value -> IO (Bug, [FieldValue])+updateFields config@(Config{ fieldDfns = dfns }) bug values+    = do { valuesNew <- foldM (writeField fieldsPath) valuesOld validated+         ; let bug' = bug { bugFields = valuesNew }+         ; bug'' <- loadPseudoFields config bug'+         ; return (bug'', validated)+         }+    where+      (Bug bid _ valuesOld) = bug+      bugPath = bugIdToPath config bid+      fieldsPath = combine bugPath fieldsDir+      validated = M.foldWithKey validator [] $ dfns+      validator :: String -> Field -> [FieldValue] -> [FieldValue]+      validator _ (PseudoField {}) acc = acc+      validator name dfn acc+          = case value of+              (Just (J.String v)) -> maybe acc (:acc) (fieldValidator dfn v)+              _ -> acc+            where+              value = M.lookup name values++writeField :: FilePath -> FieldValues -> FieldValue -> IO FieldValues+writeField _ obj fv@(FieldValue _ (PseudoField name _))+    = return $ M.insert name fv obj+writeField fieldsPath obj fv@(FieldValue value field)+    = do { writeFileStrict path value+         ; return $ M.insert name fv obj+         }+    where+      name = fieldName field+      path = combine fieldsPath name++loadFields :: Config -> BugId -> IO FieldValues+loadFields config@(Config{ fieldDfns = dfns }) bid+    = do { values <- sequence (M.fold fieldLoader [] dfns)+         ; return $ M.fromList values+         }+    where+      fieldsPath = combine bugPath fieldsDir+      bugPath = bugIdToPath config bid+      fieldLoader :: Field -> [IO (String, FieldValue)] ->+                     [IO (String, FieldValue)]+      fieldLoader (PseudoField {}) acc = acc+      fieldLoader dfn acc = loader:acc+          where+            name = fieldName dfn+            fieldPath = combine fieldsPath name+            dflt = fieldDefault dfn+            loader :: IO (String, FieldValue)+            loader = do { exists <- doesFileExist fieldPath+                        ; if exists+                          then do { value <- readFileStrict fieldPath+                                  ; case fieldValidator dfn value of+                                      Nothing -> return (name, dflt)+                                      (Just fv) -> return (name, fv)+                                  }+                          else return (name, dflt)+                        }+
+ src/DisTract/Bug/PseudoField.hs view
@@ -0,0 +1,89 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module DisTract.Bug.PseudoField+    (pseudoFieldDfn,+     loadPseudoFields+    )+    where++import DisTract.Types+import DisTract.Utils+import System.Locale+import Control.Monad+import Control.Monad.Fix+import qualified Data.Map as M+import Data.Time++data PseudoField = Reporter+                 | Created+                   deriving (Show, Eq, Ord, Enum)++instance Read PseudoField where+    readsPrec _ txt+        | reporterTxt == take reporterTxtLen txt+            = [(Reporter, drop reporterTxtLen txt)]+        | createdTxt == take createdTxtLen txt+            = [(Created, drop createdTxtLen txt)]+        | otherwise = error $ "Unknown PseudoField name '" ++ txt +++                      "'. Known PseudoFields are: " ++ (show [Reporter ..])+        where+          reporterTxt = "Reporter"+          createdTxt = "Created"+          reporterTxtLen = length reporterTxt+          createdTxtLen = length createdTxt++pseudoFieldDfn :: PseudoField -> Field+pseudoFieldDfn Reporter = pf+    where+      pf = PseudoField { fieldName = (show Reporter),+                         fieldValueExtractor = extractReporter+                       }+      extractReporter :: Bug -> IO FieldValue+      extractReporter bug = return $ FieldValue reporter pf+          where+            (BugId _ reporter) = bugId bug+pseudoFieldDfn Created = pf+    where+      pf = PseudoField { fieldName = (show Created),+                         fieldValueExtractor = extractCreated+                       }+      extractCreated :: Bug -> IO FieldValue+      extractCreated bug = do { calendarTime <- utcToLocalZonedTime createdClock+                              ; return $ FieldValue (created calendarTime) pf+                              }+          where+            (BugId createdClock _) = bugId bug+            created = formatTime defaultTimeLocale+                      humanTimeFormat++loadPseudoFields :: Config -> Bug -> IO Bug+loadPseudoFields config = fix (loadPseudoFields' config)++loadPseudoFields' :: Config -> (Bug -> IO Bug) -> (Bug -> IO Bug)+loadPseudoFields' (Config{ fieldDfns = dfns }) recFunc bug+    = do { values <- fieldValues+         ; let bug' = bug { bugFields = values }+         ; case bug == bug' of+             True -> return bug+             False -> recFunc bug'+         }+    where+      fieldValues = M.fold runPseudoField (return $ bugFields bug) dfns+      runPseudoField :: Field -> IO (M.Map String FieldValue) ->+                        IO (M.Map String FieldValue)+      runPseudoField (Field {}) accM = accM+      runPseudoField (PseudoField { fieldName = name,+                                    fieldValueExtractor = extractor+                                  }) accM+          = do { acc <- accM+               ; value <- extractor bug+               ; return $ M.insert name value acc+               }
+ src/DisTract/BugFileInputLoader.hs view
@@ -0,0 +1,76 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module DisTract.BugFileInputLoader+    (parseForNewBug,+     parseForBugUpdate+    )+where++import DisTract.Types+import DisTract.Parsers+import DisTract.Utils+import qualified Data.Map as M+import qualified JSON as J+import Control.Monad++parseForNewBug :: FilePath -> IO (Maybe (String, M.Map String J.Value))+parseForNewBug file+    -- must readFileStrict because we're going to write to it afterwards.+    = do { textJson <- readFileStrict file+         ; case J.parse textJson of+             (Just (J.Object obj)) ->+                 return $ Just (comment, fields)+                     where+                       commentM = M.lookup "text" obj+                       fieldsM = M.lookup "fields" obj+                       comment = case commentM of+                                   (Just (J.String txt)) -> txt+                                   _ -> ""+                       fields = case fieldsM of+                                  (Just (J.Object objFields)) -> objFields+                                  _ -> M.empty+             _ -> return Nothing+         }++parseForBugUpdate :: FilePath -> IO (Maybe (BugId, Maybe (String, String), M.Map String J.Value))+parseForBugUpdate file+    = do { textJson <- readFile file+         ; case J.parse textJson of+             (Just (J.Object obj)) -> return $ fmap (\bugId -> (bugId, comment, fields)) bid+                 where+                   bidM = M.lookup "bugId" obj+                   commentM = M.lookup "comment" obj+                   fieldsM = M.lookup "fields" obj+                   bid = join . fmap findBugIdJson $ bidM+                   comment' = case commentM of+                                (Just (J.Object cObj)) ->+                                    liftM2 (,) txtM inReplyToM+                                        where+                                          txtM = M.lookup "text" cObj+                                          inReplyToM = M.lookup "inReplyTo" cObj+                                _ -> Nothing+                   comment = join . fmap commentBuilder $ comment'+                   commentBuilder :: (J.Value, J.Value) -> Maybe (String, String)+                   commentBuilder ((J.String txt), (J.String inReplyTo)) = Just (txt, inReplyTo)+                   commentBuilder _ = Nothing+                   fields = case fieldsM of+                              (Just (J.Object objFields)) -> objFields+                              _ -> M.empty+             _ -> return Nothing+         }++findBugIdJson :: J.Value -> Maybe BugId+findBugIdJson (J.String txt) = case result of+                                 (Left _) -> Nothing+                                 (Right r) -> Just r+    where+      result = findBugId txt+findBugIdJson _ = Nothing
+ src/DisTract/Config.hs view
@@ -0,0 +1,146 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++{-# LANGUAGE TemplateHaskell #-}++module DisTract.Config+    (buildConfig,+     buildConfigFromArgs,+     defaultConfig,+     package_name,+     package_version+    )+where++import DisTract.Layout+import DisTract.Types+import DisTract.Monotone.Types+import DisTract.Monotone.Interaction+import DisTract.Config.Parser+import DisTract.Bug.Field+import qualified Data.Map as M+import System.IO+import System.FilePath+import System.Directory+import Data.Maybe+import Control.Monad+import System.Environment+import System.Exit+import DisTract.Version++$(getNameVersionFromCabal "DisTract.cabal")++defaultMtnDb :: FilePath -> FilePath+defaultMtnDb base = combine base "db.mtn"++sortOutBaseDir :: FilePath -> IO FilePath+sortOutBaseDir base+    = if isRel+      then do { cwd <- getCurrentDirectory+              ; baseRel <- makeRelativeToCurrentDirectory base+              ; return $ combine cwd baseRel+              }+      else return base+    where+      isRel = isRelative base++-- ok, chuck defaults in here. Try hard to find+-- defaults that are non-fatal+-- remember that all the errors here are lazy, thus if we replace them+-- later they disappear+defaultConfig :: FilePath -> [String] -> IO Config+defaultConfig base' args+    = do { base <- sortOutBaseDir base'+         ; if isRelative base+           then error $ "Unable to discover absolute path to base directory at " ++ base'+           else return ()+         ; mtnExec <- findExecutable "mtn" -- searches $PATH+         ; let mtnExec' = fromMaybe (error "Can't find mtn executable") mtnExec+         ; dbExists <- doesFileExist $ defaultMtnDb base+         ; let db = if dbExists+                    then defaultMtnDb base+                    else error "Can't find mtn database"+         ; let user = error "Can't find user"+         ; return $ Config { mtnExecutable = mtnExec',+                             mtnDb = db,+                             user = user,+                             baseDir = addTrailingPathSeparator base,+                             fieldDfns = M.empty,+                             args = args,+                             verbose = False,+                             mtnVersion = undefined,+                             logger = StdOutLog,+                             packageName = package_name,+                             packageVersion = package_version+                           }+         }++buildConfigFromArgs :: [String] -> IO Config+buildConfigFromArgs [] = error "No base dir supplied"+buildConfigFromArgs (version:_)+    | version == "-v" || version == "--version"+        = do { putStrLn $ package_name ++ ": Version " ++ package_version+             ; exitWith ExitSuccess+             }+buildConfigFromArgs (base:rest)+    = do { putStrLn $ "Using base at " ++ base+         ; defConfig <- defaultConfig base rest+         ; let configFile = combine (prefsDir base) "config"+         ; configContents <- readFile configFile+         ; let config = buildConfig' defConfig configContents+         ; version <- mtnFindVersion config+         ; let config' = config { mtnVersion = version }+         ; (_, privateKeys) <- mtnLsKeys config'+         ; branch <- mtnFindCurrentBranch config' prefs+         ; let user = findUserInPrefsBranch branch+         ; let config'' = findUser config' privateKeys user+         ; fields <- loadFieldDfns config''+         ; return $ config''{fieldDfns = fields}+         }++buildConfig :: IO Config+buildConfig = getArgs >>= buildConfigFromArgs++-- augment defaults with contents of config file+-- in the prefs dir+buildConfig' :: Config -> String -> Config+buildConfig' config@(Config{mtnExecutable = defaultMtnExecutable,+                            mtnDb = defaultMtnDb,+                            verbose = defaultVerbose,+                            logger = defaultLogger+                           }+                    )+             text+    = config { mtnExecutable = lookup "mtn" defaultMtnExecutable,+               mtnDb = lookup "db" defaultMtnDb,+               verbose = read $ lookup "verbose" (show defaultVerbose),+               logger = log+             }+    where+      log = maybe defaultLogger FileLog $ M.lookup "log" parsedMap+      parsedMap = parseConfig text++      lookup :: String -> String -> String+      lookup key def = M.findWithDefault def key parsedMap++-- check that the branch in the prefs dir is a .prefs.$user branch+-- and that we know the private key for $user+findUser :: Config -> [Key] -> String -> Config+findUser config keys userFromBranch+    = config {user = userChecked}+    where+      userChecked = if any keyMatch keys+                    then userFromBranch+                    else error ("Cannot find private key for user branch in prefs dir '" +++                                 userFromBranch ++ "'\n" ++ (show keys))++      keyMatch :: Key -> Bool+      keyMatch (PrivateKey str _) = str == userFromBranch+      keyMatch _ = False
+ src/DisTract/Config/Parser.hs view
@@ -0,0 +1,43 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module DisTract.Config.Parser+    (parseConfig,+     findUserInPrefsBranch+    )+where++import DisTract.Monotone.Parser (handleParseError)+import qualified Data.Map as M+import Text.ParserCombinators.Parsec++parseConfig :: String -> M.Map String String+parseConfig = handleParseError . runParser (configParser M.empty) ()+              "DisTract.Config.Parser"++configParser :: (M.Map String String) -> Parser (M.Map String String)+configParser m = do { key <- manyTill anyChar (try (char '='))+                    ; value <- manyTill anyChar+                               ((try (do {newline; return ()})) <|> eof)+                    ; rest <- configParser m+                    ; return (M.insert key value rest)+                    }+                 <|> return m++findUserInPrefsBranch :: String -> String+findUserInPrefsBranch = handleParseError . runParser parseUserBranch ()+                        "DisTract.Config.Parser userBranch"++parseUserBranch :: Parser String+parseUserBranch = do { manyTill anyChar (try (string ".prefs."))+                     ; user <- manyTill anyChar+                               ((try (do {newline; return ()})) <|> eof)+                     ; return user+                     }
+ src/DisTract/HTML/BugList.hs view
@@ -0,0 +1,145 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++{-# LANGUAGE TemplateHaskell #-}++module DisTract.HTML.BugList+    (formatBugList+    )+where++import Text.HTML.Chunks+import DisTract.Types+import DisTract.IOUtils+import DisTract.Utils+import DisTract.Layout+import Data.List+import Data.Maybe+import Data.Time+import qualified Data.Map as M+import qualified JSON as J+import System.FilePath++$(chunksFromFile "./html/templates/bugList.html")++formatBugList :: Config -> IO ()+formatBugList config+    = do { time <- (getZonedTime >>= formatTimeHuman)+         ; bugsList <- makeBugsList config+         ; let htmlStr = format $ Chunk_page { page_base = baseDir config,+                                               page_bugsList = bugsList,+                                               page_generation_time = time,+                                               page_version = version+                                             }+         ; writeFile path htmlStr+         ; return ()+         }+    where+      version = (packageName config) ++ " version " ++ (packageVersion config)+      path = combine (htmlDir (baseDir config)) fileName+      fileName = addExtension "list" "html"++makeBugsList :: Config -> IO String+makeBugsList config+    = do { bugsM <- loadAll config+         ; let bugsListTxt = buildBugsListTxt config (catMaybes bugsM)+         ; let fieldsListTxt = buildFieldsListTxt config+         ; return (fieldsListTxt ++ bugsListTxt)+         }++buildFieldsListTxt :: Config -> String+buildFieldsListTxt Config { fieldDfns = fields }+    = "fieldsList = " ++ J.stringify (J.Array fieldsJSON) ++ ";\n\n"+    where+      fieldsJSON = (J.String "BugId"):+                   (map fieldNameToJSON . sort . M.elems $ fields)+      fieldNameToJSON :: Field -> J.Value+      fieldNameToJSON = J.String . fieldName++buildBugsListTxt :: Config -> [Bug] -> String+buildBugsListTxt config bugs+    = "bugsList = " ++ J.stringify (J.Array orderingsJSON) ++ ";\n\n"+    where+      orderingsMap = createOrderingsMap bugs+      orderings = addOrderings (M.elems . fieldDfns $ config) bugs orderingsMap+      orderingsJSON = map convertOrderingsToJSON . M.elems $ orderings++convertOrderingsToJSON :: M.Map String (String, Int)+                       -> J.Value+convertOrderingsToJSON obj = J.Object obj'+    where+      obj' = M.foldWithKey toJSON M.empty obj+      toJSON :: String -> (String, Int) -> M.Map String J.Value ->+                M.Map String J.Value+      toJSON name (val, num) acc = acc''+          where+            acc' = M.insert name (J.String val) acc+            acc'' = M.insert (name ++ "_order") (J.Int num) acc'++addOrderings :: [Field] -> [Bug] -> M.Map BugId (M.Map String (String, Int)) ->+                M.Map BugId (M.Map String (String, Int))+addOrderings [] bugs acc = acc'+    where+      name = "BugId"+      acc' = foldr (updateBugIdMap name) acc sortedTxt+      sorted = sortBugsByBugId bugs+      sortedTxt = zipWith takeValueStringBugId sorted [1..]+      takeValueStringBugId :: Bug -> Int -> (BugId, String, Int)+      takeValueStringBugId Bug { bugId = bugId } num+          = (bugId, (show bugId), num)+addOrderings (field:fields) bugs acc = addOrderings fields bugs acc'+    where+      name = fieldName field+      acc' = foldr (updateBugIdMap name) acc sortedTxt+      sorted = sortBugsByField field bugs+      sortedTxt = zipWith takeValueString sorted [1..]+      takeValueString :: Bug -> Int -> (BugId, String, Int)+      takeValueString bug num = ((bugId bug), value, num)+          where+            (FieldValue value _) = selectField field bug++updateBugIdMap :: String -> (BugId, String, Int) ->+                  M.Map BugId (M.Map String (String, Int)) ->+                  M.Map BugId (M.Map String (String, Int))+updateBugIdMap name (bugId, value, num) obj+    = M.adjust (M.insert name (value,num)) bugId obj++createOrderingsMap :: [Bug] -> M.Map BugId (M.Map String (String, Int))+createOrderingsMap = foldr insertBugIdMap M.empty+    where+      insertBugIdMap :: Bug -> M.Map BugId (M.Map String (String, Int)) ->+                        M.Map BugId (M.Map String (String, Int))+      insertBugIdMap bug obj = M.insert (bugId bug) M.empty obj++sortBugsByBugId :: [Bug] -> [Bug]+sortBugsByBugId = sortBy bugIdSorter+    where+      bugIdSorter :: Bug -> Bug -> Ordering+      bugIdSorter b1 b2 = compare (bugId b1) (bugId b2)++sortBugsByField :: Field -> [Bug] -> [Bug]+sortBugsByField field bugs+    = sortBy (sorter fieldSelector) bugs+    where+      fieldSelector = selectField field+      sorter :: (Ord a) => (Bug -> a) -> Bug -> Bug -> Ordering+      sorter selector b1 b2 = compare (selector b1) (selector b2)++selectField :: Field -> Bug -> FieldValue+selectField field bug = fieldValue+    where+      name = fieldName field+      fields = bugFields bug+      (Just fv@(FieldValue _ field')) = M.lookup name fields+      fieldValue = case field == field' of+                     True -> fv+                     False -> error $ "Expecting field " ++ (show field) +++                              " in bug " ++ (show bug) +++                              " bug found field " ++ (show field')
+ src/DisTract/HTML/BugNew.hs view
@@ -0,0 +1,58 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++{-# LANGUAGE TemplateHaskell #-}++module DisTract.HTML.BugNew+    (formatNew,+     newToHTML+    )+where++import Text.HTML.Chunks+import DisTract.Types+import DisTract.Utils+import DisTract.Layout+import DisTract.HTML.Fields+import System.FilePath+import Data.List+import Data.Time+import qualified Data.Map as M++$(chunksFromFile "./html/templates/bugNew.html")++formatNew :: Config -> IO ()+formatNew config+    = do { htmlStr <- newToHTML config+         ; writeFile path htmlStr+         }+    where+      path = combine (htmlDir . baseDir $ config) filename+      filename = addExtension "newBug" "html"+++newToHTML :: Config -> IO String+newToHTML config+    = do { time <- (getZonedTime >>= formatTimeHuman)+         ; let page = format $ Chunk_page+                      { page_base = baseDir config,+                        page_fields = "<tr>\n" ++ fieldsFormatted ++ "</tr>\n",+                        page_generation_time = time,+                        page_version = version+                      }+         ; return page+         }+    where+      version = (packageName config) ++ " version " ++ (packageVersion config)+      fieldsSorted = sort . filter (not . isPseudoField) . M.elems .+                      fieldDfns $ config+      fieldsFormattedList = map (toFormInput . fieldDefault) fieldsSorted+      fieldsFormatted = concat . intersperseEvery 2 "</tr><tr>\n" .+                        filter (not . null) $ fieldsFormattedList
+ src/DisTract/HTML/BugView.hs view
@@ -0,0 +1,103 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++{-# LANGUAGE TemplateHaskell #-}++module DisTract.HTML.BugView+    (formatBug,+     formatBugId,+     bugToHTML+    )+where++import Text.HTML.Chunks+import DisTract.Types+import DisTract.Bug+import DisTract.Utils+import DisTract.Layout+import DisTract.HTML.Fields+import System.FilePath+import Data.List+import Data.Time+import qualified JSON as J+import qualified Data.Map as M++$(chunksFromFile "./html/templates/bugView.html")++formatBug :: Config -> Maybe Bug -> IO ()+formatBug _ Nothing = return ()+formatBug config (Just bug)+    = do { htmlStr <- bugToHTML config bug+         ; writeFile path htmlStr+         }+    where+      path = combine (htmlDir . baseDir $ config) filename+      filename = addExtension (show . bugId $ bug) "html"++formatBugId :: Config -> BugId -> IO ()+formatBugId config bid+    = loadBug config bid >>= formatBug config++bugToHTML :: Config -> Bug -> IO String+bugToHTML config (Bug bid comments fields)+    = do { time <- (getZonedTime >>= formatTimeHuman)+         ; commentsFormatted <- formatComments filename True comments+         ; return $ format $ Chunk_page+                      { page_title = header,+                        page_comments = commentsFormatted,+                        page_fields = "<tr>\n" ++ fieldsFormatted ++ "</tr>\n",+                        page_summary = "<tr>\n" ++ fieldsSummarized ++ "</tr>\n",+                        page_generation_time = time,+                        page_version = version+                      }+         }+    where+      version = (packageName config) ++ " version " ++ (packageVersion config)+      bidStr = show bid+      header = format $ Chunk_header+               { header_bugId = bidStr,+                 header_base = baseDir config+               }++      fieldsSorted = sort . M.elems $ fields+      fieldsFormattedList = map toFormInput . filter (not . isPseudoFieldValue)+                            $ fieldsSorted+      fieldsFormatted = concat . intersperseEvery 2 "</tr><tr>\n" .+                        filter (not . null) $ fieldsFormattedList+      fieldsSummarizedList = map toSummary fieldsSorted+      fieldsSummarized = concat . intersperseEvery 2 "</tr><tr>\n" $+                         fieldsSummarizedList+      filename = addExtension bidStr "html"++formatComments :: String -> Bool -> Comment -> IO String+formatComments filename classBool (Comment path author time text next)+    = do { timeStr <- formatTimeHuman time+         ; nextComments'' <- mapM (formatComments filename classBool') next+         ; let nextComments' = concat nextComments''+         ; let nextComments = case nextComments' of+                                [] -> []+                                _ -> format $ Chunk_commentReplies+                                     { commentReplies_replies = nextComments' }+         ; return $ format $ Chunk_comment+                      { comment_class = commentClass classBool,+                        comment_id = path,+                        comment_author = author,+                        comment_date = timeStr,+                        comment_textJson = J.stringify (J.String text),+                        comment_replies = nextComments,+                        comment_bugFile = filename+                      }+         }+    where+      classBool' = not classBool++commentClass :: Bool -> String+commentClass True = "commentClassT"+commentClass _ = "commentClassF"
+ src/DisTract/HTML/Fields.hs view
@@ -0,0 +1,94 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++{-# LANGUAGE TemplateHaskell #-}++module DisTract.HTML.Fields+    (toFormInput,+     toSummary+    )+where++import Text.XHtml+import Text.HTML.Chunks+import DisTract.Types+import DisTract.Utils+import qualified Data.Map as M+import qualified JSON as J++$(chunksFromFile "./html/templates/fields.html")++escape :: String -> String+escape = renderHtmlFragment . stringToHtml++toFormInput :: FieldValue -> String+toFormInput (FieldValue _ (PseudoField {})) = []+toFormInput (FieldValue value field)+    = format $ Chunk_field { field_name = name,+                             field_input = input,+                             field_valueJson = valueJson+                           }+    where+      input = toFormInputType (fieldType field) field value+      name = fieldName field+      valueJson = J.stringify (J.String value)++toSummary :: FieldValue -> String+toSummary (FieldValue value field)+    = format $ Chunk_summary { summary_name = name,+                               summary_value = escape value+                             }+    where+      name = fieldName field++toFormInputType :: FieldType -> Field -> String -> String+toFormInputType FieldFreeForm field value+    = format $ Chunk_freeform+      { freeform_name = fieldName field,+        freeform_valueJson = J.stringify (J.String value)+      }+toFormInputType (FieldSimpleValues values) field value+    = format $ Chunk_simpleValues+      { simpleValues_name = fieldName field,+        simpleValues_options = options+      }+    where+      options = concat $ map formatOption values+      formatOption :: String -> String+      formatOption v = format $ Chunk_selectOption+                       { selectOption_valueJson = J.stringify (J.String v),+                         selectOption_text = v,+                         selectOption_selected = selected+                       }+          where+            selected = if value == v then "selected" else ""+toFormInputType (FieldGraph valuesMap) field value+    = format $ Chunk_graphValues+      { graphValues_name = fieldName field,+        graphValues_options = options+      }+    where+      options = concat . intersperseEvery 1 "<br>\n" $ current : next+      nextValues = M.findWithDefault [] value valuesMap+      next = map formatNextOption nextValues+      current = format $ Chunk_radioOption+                { radioOption_name = fieldName field,+                  radioOption_valueJson = J.stringify (J.String value),+                  radioOption_checked = "checked",+                  radioOption_text = "Leave as " ++ value+                }+      formatNextOption :: (String, String) -> String+      formatNextOption (verb, noun)+          = format $ Chunk_radioOption+            { radioOption_name = fieldName field,+              radioOption_valueJson = J.stringify (J.String noun),+              radioOption_checked = "",+              radioOption_text = verb+            }
+ src/DisTract/IOUtils.hs view
@@ -0,0 +1,60 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module DisTract.IOUtils+    (loadAndUpdateAll,+     loadAll,+     updateAndLoadBug)+    where++import DisTract.Bug+import DisTract.Layout+import DisTract.Parsers+import DisTract.Monotone.Interaction+import DisTract.Types+import Data.List+import Data.Either+import Data.Maybe+import Control.Monad+import System.Directory++loadAndUpdateAll :: Config -> IO [Maybe Bug]+loadAndUpdateAll config+    = loadAllBugIds config >>= mapM (updateAndLoadBug config)++loadAll :: Config -> IO [Maybe Bug]+loadAll config+    = loadAllBugIds config >>= mapM (loadBug config)++loadAllBugIds :: Config -> IO [BugId]+loadAllBugIds config+    = do { baseBranch <- mtnFindCurrentBranch config bugs+         ; branches <- mtnGetBranches config+         ; let bugBranches = filter (isPrefixOf (baseBranch ++ "."))+                             branches+         ; return $ let len = 1 + length baseBranch+                    in map (dieErr . findBugId . drop len)+                       bugBranches+         }++dieErr :: (Show a) => Either a b -> b+dieErr (Left a) = error $ show a+dieErr (Right b) = b++updateAndLoadBug :: Config -> BugId -> IO (Maybe Bug)+updateAndLoadBug config bugId+    = do { exists <- doesDirectoryExist path+         ; if exists+           then mtnUpdate config path Nothing+           else return ()+         ; loadBug config bugId+         }+    where+      path = bugIdToPath config bugId
+ src/DisTract/JSONUtils.hs view
@@ -0,0 +1,19 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module DisTract.JSONUtils+    (lookupJsonString)+where++import qualified JSON as J+import qualified Data.Map as M++lookupJsonString :: M.Map String J.Value -> String -> String+lookupJsonString obj key = let Just (J.String str) = M.lookup key obj in str
+ src/DisTract/Layout.hs view
@@ -0,0 +1,44 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module DisTract.Layout+where++import System.FilePath+import DisTract.Types++prefs :: FilePath+prefs = "prefs"++prefsDir :: FilePath -> FilePath+prefsDir base = combine base prefs++bugs :: FilePath+bugs = "bugs"++bugsDir :: FilePath -> FilePath+bugsDir base = combine base bugs++bin :: FilePath+bin = "bin"++binDir :: FilePath -> FilePath+binDir base = combine base bin++html :: FilePath+html = "html"++htmlDir :: FilePath -> FilePath+htmlDir base = combine base html++bugIdToPath :: Config -> BugId -> String+bugIdToPath config bid+    = combine (bugsDir . baseDir $ config) (show bid)+
+ src/DisTract/Monotone/Interaction.hs view
@@ -0,0 +1,247 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module DisTract.Monotone.Interaction+    (mtnLsKeys,+     mtnGetRevision,+     mtnHeads,+     mtnFindCurrentBranch,+     mtnSetupBranch,+     mtnLogBrief,+     mtnAddUnknownFiles,+     mtnAdd,+     mtnCommit,+     mtnDoesBranchExist,+     mtnGetBranches,+     mtnCheckOutBranch,+     mtnUpdate,+     mtnInitDB,+     mtnFindVersion+    )+    where++import DisTract.Types+import DisTract.Monotone.Types+import DisTract.Monotone.Parser+import System.Process+import System.IO+import System.IO.Error+import System.FilePath+import System.Directory+import Data.Maybe+import Data.List+import Data.Either++mtnFindVersion :: Config -> IO SupportedVersion+mtnFindVersion config+    = mtnRunRaw config ["--version"] Nothing Nothing >>=+      return . dieOnErrString (read . show . findVersionHash)++mtnLsKeys :: Config -> IO ([Key],[Key])+mtnLsKeys config+    | MTN_0_34 == mtnVersion config = func+    | MTN_0_35 == mtnVersion config = func+    | MTN_0_36 == mtnVersion config = func+    | otherwise = error "Unsupported version of monotone"+    where+      func = mtnRun config (baseDir config) ["ls", "keys"] >>=+             return . dieOnErrString findKeys++mtnGetRevision :: Config -> Hash -> IO Revision+mtnGetRevision config hash+    | MTN_0_34 == mtnVersion config = func+    | MTN_0_35 == mtnVersion config = func+    | MTN_0_36 == mtnVersion config = func+    | otherwise = error "Unsupported version of monotone"+    where+      func = mtnRun config (baseDir config) ["automate", "certs", show hash] >>=+             return . dieOnErrString (Revision hash . findCerts)++mtnHeads :: Config -> FilePath -> IO [Hash]+mtnHeads config dir+    | MTN_0_34 == mtnVersion config = func+    | MTN_0_35 == mtnVersion config = func+    | MTN_0_36 == mtnVersion config = func+    | otherwise = error "Unsupported version of monotone"+    where+      func = mtnRun config dir ["automate", "heads"] >>=+             return . dieOnErrString findHashes++mtnFindCurrentBranch :: Config -> FilePath -> IO String+mtnFindCurrentBranch config dir+    | MTN_0_34 == mtnVersion config = func+    | MTN_0_35 == mtnVersion config = func+    | MTN_0_36 == mtnVersion config = func+    | otherwise = error "Unsupported version of monotone"+    where+      func = mtnRun config dir ["automate", "get_option", "branch"] >>=+             return . dieOnErrString (head . lines)++mtnSetupBranch :: Config -> String -> FilePath -> IO ()+mtnSetupBranch config@Config{ logger = logger }+               newBranch dir+    | MTN_0_34 == mtnVersion config = func+    | MTN_0_35 == mtnVersion config = func+    | MTN_0_36 == mtnVersion config = func+    | otherwise = error "Unsupported version of monotone"+    where+      func = mtnRun config (baseDir config) ["setup", dir, "-b", newBranch] >>=+             logStr logger . dieOnErrString id++mtnLogBrief :: Config -> FilePath -> [String] -> FilePath -> IO [LogBrief]+mtnLogBrief config dir extras path+    | MTN_0_34 == mtnVersion config = func+    | MTN_0_35 == mtnVersion config = func+    | MTN_0_36 == mtnVersion config = func+    | otherwise = error "Unsupported version of monotone"+    where+      func = mtnRun config dir (["log", "--brief", "--no-graph"] ++ extras ++ [path]) >>=+             return . dieOnErrString findLogBriefs++mtnAddUnknownFiles :: Config -> FilePath -> IO ()+mtnAddUnknownFiles config@Config{ logger = logger }+                   dir+    | MTN_0_34 == mtnVersion config = func+    | MTN_0_35 == mtnVersion config = func+    | MTN_0_36 == mtnVersion config = func+    | otherwise = error "Unsupported version of monotone"+    where+      func = mtnRun config dir ["add", "--recursive", "--unknown"] >>=+             logStr logger . ignoreErrString id++mtnAdd :: Config -> FilePath -> [FilePath] -> IO ()+mtnAdd _ _ [] = return ()+mtnAdd config@Config{ logger = logger } dir files+    | MTN_0_34 == mtnVersion config = func+    | MTN_0_35 == mtnVersion config = func+    | MTN_0_36 == mtnVersion config = func+    | otherwise = error "Unsupported version of monotone"+    where+      func = mtnRun config dir ("add":files) >>=+             logStr logger . ignoreErrString id++mtnCommit :: Config -> FilePath -> String -> [FilePath] -> IO (Maybe Hash)+mtnCommit config dir message files+    | MTN_0_34 == mtnVersion config = func+    | MTN_0_35 == mtnVersion config = func+    | MTN_0_36 == mtnVersion config = func+    | otherwise = error "Unsupported version of monotone"+    where+      func = do { (tmpFile, tmpH) <- makeTemporaryFile+                ; hPutStr tmpH message+                ; hClose tmpH+                ; ("",err) <- mtnRun config dir+                              ("commit":"--message-file":tmpFile:files)+                ; removeFile tmpFile+                ; return $ findHashInCommitMessage err+                }++mtnGetBranches :: Config -> IO [String]+mtnGetBranches config+    | MTN_0_34 == mtnVersion config = func+    | MTN_0_35 == mtnVersion config = func+    | MTN_0_36 == mtnVersion config = func+    | otherwise = error "Unsupported version of monotone"+    where+      func = mtnRun config (baseDir config) ["automate", "branches"] >>=+             return . dieOnErrString lines++mtnDoesBranchExist :: Config -> String -> IO Bool+mtnDoesBranchExist config branch+    | MTN_0_34 == mtnVersion config = func+    | MTN_0_35 == mtnVersion config = func+    | MTN_0_36 == mtnVersion config = func+    | otherwise = error "Unsupported version of monotone"+    where+      func = mtnGetBranches config >>=+             return . elem branch++mtnCheckOutBranch :: Config -> FilePath -> String -> FilePath -> IO ()+mtnCheckOutBranch config@Config{ logger = logger }+                  dir branch coDir+    | MTN_0_34 == mtnVersion config = func+    | MTN_0_35 == mtnVersion config = func+    | MTN_0_36 == mtnVersion config = func+    | otherwise = error "Unsupported version of monotone"+    where+      func = mtnRun config dir ["checkout", "-b", branch, coDir] >>=+             logStr logger . dieOnErrString id++mtnUpdate :: Config -> FilePath -> Maybe Hash -> IO ()+mtnUpdate config@Config{ logger = logger } dir hashM+    | MTN_0_34 == mtnVersion config = func+    | MTN_0_35 == mtnVersion config = func+    | MTN_0_36 == mtnVersion config = func+    | otherwise = error "Unsupported version of monotone"+    where+      func = mtnRun config dir (("update":) . maybe [] (("-r":) . (:[]) . show) $ hashM) >>=+             \(out, err) -> logWithPrefix logger "stdout" out >>+                            logWithPrefix logger "stderr" err++mtnInitDB :: Config -> IO ()+mtnInitDB config@Config{ logger = logger }+    | MTN_0_34 == mtnVersion config = func+    | MTN_0_35 == mtnVersion config = func+    | MTN_0_36 == mtnVersion config = func+    | otherwise = error "Unsupported version of monotone"+    where+      func = mtnRun config (baseDir config) ["db", "init"] >>=+             logStr logger . ignoreErrString id++ignoreErrString :: (String -> a) -> (String, String) -> a+ignoreErrString func (out, _) = func out++dieOnErrString :: (String -> a) -> (String, String) -> a+dieOnErrString func (out, []) = func out+dieOnErrString _ (_, err) = error err++-- we know that the base is absolute now+-- so combining with the dir is safe even if the dir is relative+mtnRun :: Config -> FilePath -> [String] -> IO (String, String)+mtnRun config@Config{mtnDb = db, baseDir = base}+       dir extraArgs+    = mtnRunRaw config args (Just wd) env+    where+      args = ["-d", db] ++ extraArgs+      env = Nothing -- allow our environment to pass through+      wd = combine base dir++mtnRunRaw :: Config -> [String] -> Maybe FilePath ->+             Maybe [(String, String)] -> IO (String, String)+mtnRunRaw Config{mtnExecutable = mtn, verbose = verbose, logger = logger}+          args wd env+    = do { if verbose+           then logStr logger $ mtn ++ " in " ++ (show wd) +++                              "; env: " ++ (show env) +++                              "; args: " ++ (show args)+           else return ()+         ; results <- try (do { (_,outH,errH,procH) <- runInteractiveProcess+                                                       mtn args wd env+                              ; out <- hGetContents outH+                              ; err <- hGetContents errH+                              ; waitForProcess procH+                              ; if verbose+                                then do { logWithPrefix logger "stdout" out+                                        ; logWithPrefix logger "stderr" err+                                        }+                                else return ()+                              ; return (out, err)+                              }+                          )+          ; either ioError return results+         }++makeTemporaryFile :: IO (FilePath, Handle)+makeTemporaryFile+    = do { tmpDir <- getTemporaryDirectory+         ; (path, hdl) <- openTempFile tmpDir "DisTract.tmp"+         ; hSetBinaryMode hdl False+         ; return (path, hdl)+         }
+ src/DisTract/Monotone/Parser.hs view
@@ -0,0 +1,162 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module DisTract.Monotone.Parser+    (findHash,+     findHashes,+     findKeys,+     findCerts,+     findLogBriefs,+     findHashInCommitMessage,+     findVersionHash,+     handleParseError+    )+where++import DisTract.Utils+import DisTract.Monotone.Types+import Text.ParserCombinators.Parsec+import Data.Either+import Data.Word+import Data.Time+import Control.Monad+import System.Locale++handleParseError :: Either ParseError a -> a+handleParseError result = case result of+                       (Left e) -> error (show e)+                       (Right r) -> r++findVersionHash :: String -> Hash+findVersionHash = handleParseError . runParser grabAnyHashParser () "DisTract.Monotone.Parser versionHash"++grabAnyHashParser :: Parser Hash+grabAnyHashParser = (try hashParser)+                    <|> (anyChar >> grabAnyHashParser)++findHash :: String -> Hash+findHash = handleParseError . runParser hashParser () "DisTract.Monotone.Parser hash"++findHashes :: String -> [Hash]+findHashes = handleParseError . runParser hashesParser () "DisTract.Monotone.Parser hashes"++hashesParser :: Parser [Hash]+hashesParser = do { hash <- hashParser+                  ; many space+                  ; rest <- hashesParser+                  ; return (hash:rest)+                  }+               <|> return []++hashParser :: Parser Hash+hashParser = do { [w1,w2,w3,w4,w5] <- sequence (replicate 5 word64Parser)+                ; return (Hash w1 w2 w3 w4 w5)+                }++word64Parser :: Parser Word64+word64Parser = sequence (replicate 8 hexDigit) >>= return . read . ("0x"++)++findKeys :: String -> ([Key],[Key])+findKeys = handleParseError . runParser keysParser () "DisTract.Monotone.Parser keys"++keysParser :: Parser ([Key], [Key])+keysParser = do { many space+                ; string "[public keys]"+                ; many1 space+                ; public <- many (keyEntry PublicKey)+                ; manyTill anyChar (try (string "[private keys]"))+                ; many1 space+                ; private <- many (keyEntry PrivateKey)+                ; return (public, private)+                }++keyEntry :: (String -> Hash -> Key) -> Parser Key+keyEntry con = do { hash <- hashParser+                  ; many1 space+                  ; address <- manyTill anyChar (try space)+                  ; many space+                  ; return (con address hash)+                  }++findCerts :: String -> [Cert]+findCerts = handleParseError . runParser certsParser () "DisTract.Monotone.Parser certs"++certsParser :: Parser [Cert]+certsParser = do { cert <- certParser+                 ; rest <- certsParser+                 ; return (cert:rest)+                 }+              <|> return []++certParser :: Parser Cert+certParser = do { key <- certKeyValuePair "key"+                ; signature <- certKeyValuePair "signature"+                ; name <- certKeyValuePair "name"+                ; value <- certKeyValuePair "value"+                ; trust <- certKeyValuePair "trust"+                ; let trust' = case trust of+                                 "trusted" -> Trusted+                                 _ -> Untrusted+                ; let signature' = case signature of+                                     "ok" -> SigOk+                                     "unknown" -> SigUnknown+                                     _ -> SigBad+                ; return (Cert { certName = name,+                                 certValue = value,+                                 certKey = key,+                                 certTrust = trust',+                                 certSignature = signature'+                               })+                }++certKeyValuePair :: String -> Parser String+certKeyValuePair key+    = do { many space+         ; string key+         ; many1 space+         ; char '"'+         ; value <- manyTill anyChar' (try (char '"' >> newline))+         ; many space+         ; return $ concat value+         }+    where+      anyChar' :: Parser String+      anyChar' = (try quotedPair)+                 <|> (anyChar >>= return . (:[]))+      quotedPair :: Parser String+      quotedPair = char '\\' >> anyChar >>= return . ('\\':) . (:[])++findLogBriefs :: String -> [LogBrief]+findLogBriefs = handleParseError . runParser logBriefParser () "DisTract.Monotone.Parser logBrief"++logBriefParser :: Parser [LogBrief]+logBriefParser = do { hash <- hashParser+                    ; many1 space+                    ; author <- manyTill anyChar (try space)+                    ; many space+                    ; dateStr <- count monotoneDateFormatLength anyChar+                    ; let dateM = parseTime defaultTimeLocale monotoneDateFormat dateStr+                    ; when (dateM == Nothing) $+                           fail $ "Unable to parse date: '" ++ dateStr ++ "'"+                    ; let (Just date) = dateM+                    ; many1 space+                    ; branch <- manyTill anyChar ((try space >> return ()) <|> eof)+                    ; many space+                    ; rest <- logBriefParser+                    ; return $ (LogBrief hash author date branch):rest+                    }+                 <|> return []++findHashInCommitMessage :: String -> (Maybe Hash)+findHashInCommitMessage = handleParseError . runParser hashInCommitParser () "DisTract.Monotone.Parser hashInCommit"++hashInCommitParser :: Parser (Maybe Hash)+hashInCommitParser = (try (grabAnyHashParser >>= return . Just))+                     <|> (return Nothing)
+ src/DisTract/Monotone/Types.hs view
@@ -0,0 +1,80 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module DisTract.Monotone.Types+    (Key(..),+     Hash(..),+     Cert(..),+     Trust(..),+     Signature(..),+     Revision(..),+     LogBrief(..)+    )+where++import Data.Word+import Data.Time+import Numeric+import System.Locale+import DisTract.Utils++data Key = PublicKey String Hash+         | PrivateKey String Hash+           deriving (Eq, Show)++-- 64 bits is 8 bytes, 8 * 5 = 40 == sha1sum size+data Hash = Hash Word64 Word64 Word64 Word64 Word64+            deriving (Eq)++instance Show Hash where+    show (Hash w1 w2 w3 w4 w5) = foldr showHexPad "" [w1,w2,w3,w4,w5]+        where+          showHexPad :: Word64 -> String -> String+          showHexPad w s = padding ++ simple+              where+                simple = showHex w s+                padding = replicate count '0'+                count = (8 - (findCols 0 w)) `mod` 8+                -- use this rather than length as it+                -- avoids eval-ing the whole string+                -- (using (length simple `mod` 8)+                -- would make the show O((n^2) /2) )+                findCols :: Int -> Word64 -> Int+                findCols c 0 = c+                findCols c n = findCols (c+1) (n `div` 16)++data Revision = Revision Hash [Cert]+            deriving (Eq, Show)+data Cert = Cert { certName :: String,+                   certValue ::  String,+                   certKey :: String,+                   certTrust :: Trust,+                   certSignature :: Signature+                 }+            deriving (Eq, Show)+data Trust = Trusted | Untrusted+            deriving (Eq, Show)+data Signature = SigOk | SigBad | SigUnknown+            deriving (Eq, Show)++data LogBrief = LogBrief { logRevisionHash :: Hash,+                           logRevisionAuthor :: String,+                           logRevisionTime :: UTCTime,+                           logRevisionBranch :: String+                         }++instance Show LogBrief where+    show (LogBrief hash author time branch)+             = "LogBrief: Revision " ++ (show hash) +++               " at " ++ timeFormatted ++ " by " ++ author +++               " on branch " ++ branch+        where+          timeFormatted = formatTime defaultTimeLocale+                          monotoneDateFormat time
+ src/DisTract/Parsers.hs view
@@ -0,0 +1,49 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module DisTract.Parsers+    (findBugId)+where++import DisTract.Types+import DisTract.Utils+import Text.ParserCombinators.Parsec+import Data.Either+import Data.Time+import Data.Fixed+import System.Locale+import Control.Monad++findBugId :: String -> Either ParseError BugId+findBugId = runParser parseBugId ()+            "DisTract.Utils findBugId"++parseBugId :: Parser BugId+parseBugId = do { string "bug-"+                ; timeStr <- count bugIdDateFormatLength anyChar+                ; let timeM = parseTime defaultTimeLocale bugIdDateFormat timeStr+                ; when (timeM == Nothing) $+                       fail $ "Unable to parse time: '" ++ timeStr ++ "'"+                ; let (Just time) = timeM+                ; char 'S'+                ; millis <- sequence $ replicate 3 digit+                ; char '-'+                ; author <- manyTill anyChar (eof <|> try (space >> return ()))+                ; let time' = setMillis millis time+                ; return $ BugId time' author+                }+    where+      setMillis :: String -> UTCTime -> UTCTime+      setMillis millisStr t@(UTCTime { utctDayTime = fromMidnight })+          = t { utctDayTime = (fromMidnight - badPicos + goodPicos) }+          where+            badPicos = fromMidnight `mod'` 0.001+            millis = read millisStr+            goodPicos = picosecondsToDiffTime ( millis * 1000000000 )
+ src/DisTract/Types.hs view
@@ -0,0 +1,192 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module DisTract.Types+    (Config(..),+     Bug(..),+     BugId(..),+     Comment(..),+     Field(..),+     Validator,+     FieldValue(..),+     FieldType(..),+     FieldDfns,+     FieldValues,+     SupportedVersion(..),+     Logger(..),+     Log(..),+     isPseudoFieldValue,+     isPseudoField,+    )+where++import qualified Data.Map as M+import Data.Time+import System.IO+import DisTract.Utils++data SupportedVersion = MTN_0_34+                      | MTN_0_35+                      | MTN_0_36+                        deriving (Eq, Ord, Enum)++instance Show SupportedVersion where+    show MTN_0_34 = "Version 0.34 (base revision: 6ae6de16b31495a773ac3002505ad51f2e4a8616)"+    show MTN_0_35 = "Version 0.35 (base revision: f92dd754bf5c1e6eddc9c462b8d68691cfeb7f8b)"+    show MTN_0_36 = "Version 0.36 (base revision: e4bc808d89e029ce623f9e8f2b10c84006b83fb5)"++instance Read SupportedVersion where+    readsPrec _ txt+        | v0_34 == take v0_34_len txt = [(MTN_0_34, drop v0_34_len txt)]+        | v0_35 == take v0_35_len txt = [(MTN_0_35, drop v0_35_len txt)]+        | v0_36 == take v0_36_len txt = [(MTN_0_36, drop v0_36_len txt)]+        | otherwise = error $ txt +++                      " is an unsupported version of Monotone. Supported versions are " +++                      (show [MTN_0_34 ..])+        where+          v0_34 = "6ae6de16b31495a773ac3002505ad51f2e4a8616"+          v0_34_len = length v0_34+          v0_35 = "f92dd754bf5c1e6eddc9c462b8d68691cfeb7f8b"+          v0_35_len = length v0_35+          v0_36 = "e4bc808d89e029ce623f9e8f2b10c84006b83fb5"+          v0_36_len = length v0_36++class Logger a where+    logStr :: a -> String -> IO ()+    logStr t txt = logWithPrefix t [] txt++    logWithPrefix :: a -> String -> String -> IO ()++data Log = StdOutLog | FileLog FilePath+               deriving (Show, Eq)++instance Logger Log where+    logWithPrefix _ _ [] = return ()+    logWithPrefix t pre txt+        | '\n' /= last txt = logWithPrefix t pre (txt ++ "\n")+    logWithPrefix StdOutLog pre txt = putStr $ pre' ++ txt+        where pre' = if null pre then pre else pre ++ ": "+    logWithPrefix (FileLog path) pre txt = appendFile path $+                                           pre' ++ txt+        where pre' = if null pre then pre else pre ++ ": "++data Config = Config { mtnExecutable :: String,+                       mtnDb :: FilePath,+                       user :: String,+                       baseDir :: FilePath,+                       fieldDfns :: FieldDfns,+                       args :: [String],+                       verbose :: Bool,+                       mtnVersion :: SupportedVersion,+                       logger :: Log,+                       packageName :: String,+                       packageVersion :: String+                     }++instance Show Config where+    show config = "Config: mtnExecutable=" ++ (mtnExecutable config) +++                  "; mtnDb=" ++ (mtnDb config) +++                  "; user=" ++ (user config) +++                  "; baseDir=" ++ (baseDir config) +++                  "; fieldDfns=(" ++ (show . fieldDfns $ config) +++                  "); args=" ++ (show . args $ config) +++                  "; verbose=" ++ (show . verbose $ config) +++                  "; mtnVersion=" ++ (show . mtnVersion $ config) +++                  "; logType=" ++ (show . logger $ config) +++                  "; packageName=" ++ (show . packageName $ config) +++                  "; packageVersion=" ++ (show . packageVersion $ config)++data Bug = Bug { bugId :: BugId,+                 bugComments :: Comment,+                 bugFields :: FieldValues+               }+           deriving (Show, Eq)++data Comment = Comment { commentId :: FilePath,+                         commentAuthor :: String,+                         commentTime :: UTCTime,+                         commentText :: String,+                         commentReplies :: [Comment]+                       }+               deriving (Show, Eq)++data BugId = BugId UTCTime String+             deriving (Eq, Ord)++instance Show BugId where+    show (BugId creation author) =+        "bug-" ++ time ++ "-" ++ author+        where+          time = bugIdTimeFormatter creation++type FieldDfns = M.Map String Field++data Field = Field { fieldName :: String,+                     fieldDefault :: FieldValue,+                     fieldType :: FieldType,+                     fieldValidator :: Validator+                   }+           | PseudoField { fieldName :: String,+                           fieldValueExtractor :: Bug -> IO FieldValue+                         }++isPseudoFieldValue :: FieldValue -> Bool+isPseudoFieldValue (FieldValue _ (PseudoField {})) = True+isPseudoFieldValue _ = False++isPseudoField :: Field -> Bool+isPseudoField (PseudoField {}) = True+isPseudoField _ = False++instance Show Field where+    show (Field name init fType _) = "Field " ++ (show name)+                                     ++ " of type " ++ (show fType)+                                     ++ " " ++ (show init)+    show (PseudoField name _) = "PseudoField " ++ (show name)++instance Eq Field where+    (==) (Field n1 (FieldValue d1 _) t1 _)+         (Field n2 (FieldValue d2 _) t2 _) = n1 == n2+                                             && t1 == t2+                                             && d1 == d2+    (==) (PseudoField n1 _) (PseudoField n2 _) = n1 == n2+    (==) _ _ = False++instance Ord Field where+    compare (PseudoField {}) (Field {}) = LT+    compare (Field {}) (PseudoField {}) = GT+    compare f1 f2 = (fieldName f1) `compare` (fieldName f2)++type Validator = String -> Maybe FieldValue++type FieldValues = M.Map String FieldValue++data FieldValue = FieldValue String Field++instance Eq FieldValue where+    (==) (FieldValue v1 f1) (FieldValue v2 f2) = f1 == f2+                                                 && v1 == v2++instance Ord FieldValue where+    compare (FieldValue v1 f1) (FieldValue v2 f2)+        | EQ == fcomp = compare v1 v2+        | otherwise = fcomp+        where+          fcomp = compare f1 f2++instance Show FieldValue where+    show (FieldValue init f) = "FieldValue for field " ++ (fieldName f) +++                               " with value '" ++ init ++ "'"++data FieldType = FieldFreeForm+               | FieldSimpleValues [String]+               | FieldGraph (M.Map String [(String, String)])+                 deriving (Show, Eq)+
+ src/DisTract/Utils.hs view
@@ -0,0 +1,86 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module DisTract.Utils+    (readFileStrict,+     writeFileStrict,+     bugIdTimeFormatter,+     monotoneDateFormat,+     monotoneDateFormatLength,+     bugIdDateFormat,+     bugIdDateFormatLength,+     humanTimeFormat,+     intersperseEvery,+     formatTimeHuman+    )+where++import System.IO+import Data.Time+import Data.Fixed+import System.Locale++readFileStrict :: FilePath -> IO String+readFileStrict file = do { h <- openFile file ReadMode+                         ; str <- hGetContents h+                         ; length str `seq` return ()+                         ; hClose h+                         ; return str+                         }++writeFileStrict :: FilePath -> String -> IO ()+writeFileStrict file txt = do { h <- openFile file WriteMode+                              ; hPutStr h txt+                              ; hClose h+                              }++bugIdTimeFormatter :: UTCTime -> String+bugIdTimeFormatter t@(UTCTime { utctDayTime = fromMidnight })+    = time ++ "S" ++ millis+    where+      time = formatTime defaultTimeLocale bugIdDateFormat+             t+--              pico = 10^-12; milli = 10^-3; hence 10^9+--              | - chop off anything smaller than 1 ms  - |+      millis' = (fromMidnight - (fromMidnight `mod'` 0.001)) `mod'` 1+      millis'' = show ((floor . toRational . (*1000) $ millis') :: Integer)+      padding = replicate (3 - (length millis'')) '0'+      millis = padding ++ millis''++bugIdDateFormat :: String+bugIdDateFormat = "%Y%m%dT%H%M%S"++bugIdDateFormatLength :: Int -- assumes that we don't hit the year 10000+bugIdDateFormatLength = 4 + 2 + 2 + 1 + 2 + 2 + 2+--                      %Y  %m  %d  T   %H  %M  %S++monotoneDateFormat :: String+monotoneDateFormat = "%Y-%m-%dT%H:%M:%S"++monotoneDateFormatLength :: Int -- assumes that we don't hit the year 10000+monotoneDateFormatLength = 4 + 1 + 2 + 1 + 2 + 1 + 2 + 1 + 2 + 1 + 2+--                         %Y  -   %m  -   %d  T   %H  :   %M  :   %S++humanTimeFormat :: String+humanTimeFormat = "%c"++intersperseEvery :: Int -> a -> [a] -> [a]+intersperseEvery n sep list+    = intersperseEvery' n 1 sep list+      where+        intersperseEvery' _ _ _ [] = []+        intersperseEvery' _ _ _ [x] = [x]+        intersperseEvery' n t sep (x:xs)+            | n == t = x : sep : intersperseEvery n sep xs+            | otherwise = x : intersperseEvery' n (t+1) sep xs++formatTimeHuman :: (FormatTime t) => t -> IO String+formatTimeHuman t+    = do { return $ formatTime defaultTimeLocale humanTimeFormat t}
+ src/DisTract/Version.hs view
@@ -0,0 +1,45 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++{-# LANGUAGE TemplateHaskell #-}++module DisTract.Version (getNameVersionFromCabal)+    where++import Data.Version+import Distribution.PackageDescription+import Distribution.Package+import Language.Haskell.TH.Syntax+import Distribution.Verbosity (silent)++getNameVersionFromCabal :: FilePath -> Q [Dec]+getNameVersionFromCabal path+    = do { desc <- runIO $ readPackageDescription silent path+         ; makeNameVersionDeclarations desc+         }++makeNameVersionDeclarations :: GenericPackageDescription -> Q [Dec]+makeNameVersionDeclarations desc+    = do { versionD <- [d| package_version :: String; package_version = $(lift $ versionStr desc) |]+         ; nameD <- [d| package_name :: String; package_name = $(lift $ name desc) |]+         ; return $ nameD ++ versionD+         }++name :: GenericPackageDescription -> String+name desc = pkgName $ pkgId desc++pkgId :: GenericPackageDescription -> PackageIdentifier+pkgId desc = package $ packageDescription desc++versionStr :: GenericPackageDescription -> String+versionStr desc = showVersion $ version desc++version :: GenericPackageDescription -> Version+version desc = pkgVersion $ pkgId desc
+ src/DisTractFormatNew.hs view
@@ -0,0 +1,19 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module Main+    (main)+    where++import DisTract.Config+import DisTract.HTML.BugNew++main :: IO ()+main = buildConfig >>= formatNew
+ src/DisTractInstaller.hs view
@@ -0,0 +1,347 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++{-# LANGUAGE TemplateHaskell, ForeignFunctionInterface #-}+{-# OPTIONS_GHC -fforce-recomp #-}++module Main+    (main)+    where++import Foreign+import Foreign.C+import System.Environment+import System.Installer+import System.IO+import System.Directory+import System.FilePath+import System.Console.GetOpt+import System.Process+import Data.List+import qualified Data.Map as M+import Control.Monad+import Control.Monad.Instances+import DisTract.Config+import DisTract.Utils+import DisTract.Types+import DisTract.Layout+import DisTract.Monotone.Interaction+import DisTract.Monotone.Types++$(installBinariesFunc "installDisTractBinary"+  [("NewBug",+    "dist/build/DisTractNewBug/DisTractNewBug"),+   ("ModifyBug",+    "dist/build/DisTractModifyBug/DisTractModifyBug"),+   ("UpdateFormatAllBugs",+    "dist/build/DisTractUpdateFormatAllBugs/DisTractUpdateFormatAllBugs"),+   ("UpdateFormatBug",+    "dist/build/DisTractUpdateFormatBug/DisTractUpdateFormatBug"),+   ("SortBugs",+    "dist/build/DisTractSortBugs/DisTractSortBugs"),+   ("FormatNew",+    "dist/build/DisTractFormatNew/DisTractFormatNew")+  ])++$(installBinariesFunc "installDisTractField"+  [("Title",+    "./scripts/defaultFields/Title"),+   ("Status",+    "./scripts/defaultFields/Status"),+   ("Milestone",+    "./scripts/defaultFields/Milestone"),+   ("Reporter",+    "./scripts/defaultFields/Reporter"),+   ("Created",+    "./scripts/defaultFields/Created"),+   ("Assigned",+    "./scripts/defaultFields/Assigned")+  ])++$(installBinariesFunc "installDisTractHTMLLib"+  [("Bug",       "./html/lib/DisTractBug.js"),+   ("Run",       "./html/lib/DisTractRun.js"),+   ("JSON",      "./html/lib/json.js"),+   ("Markdown",  "./html/lib/markdown.js"),+   ("Prototype", "./html/lib/prototype.js"),+   ("Sortable",  "./html/lib/sortable.js"),+   ("Style",     "./html/lib/style.css"),+   ("Unordered", "./html/lib/unordered.png"),+   ("Asc",       "./html/lib/asc.png"),+   ("Desc",      "./html/lib/desc.png")+  ])++data OptionFlag = Version+                | DB+                | Key+                | Branch+                  deriving (Eq, Ord, Enum, Show)++options :: [OptDescr (OptionFlag, String)]+options+    = [ Option ['v'] ["version"] (NoArg  (Version, ""))              "Show version."+      , Option ['d'] ["db"]      (ReqArg ((,) DB)     "DB Path")     "Set path to monotone database to use."+      , Option ['k'] ["key"]     (ReqArg ((,) Key)    "Signing Key") "Set key for signatures."+      , Option ['b'] ["branch"]  (ReqArg ((,) Branch) "Base Branch") "Set base branch."+      ]++optionsUsage :: String+optionsUsage = usageInfo header options+    where+      header = "Usage: DisTractInstall [Option..] Path"++parseOptions :: IO (M.Map OptionFlag String, [String])+parseOptions = do { args <- getArgs+                  ; case getOpt RequireOrder options args of+                      (opts, remaining, []) ->+                          return (M.fromList . sort $ opts, remaining)+                      (_,_,errs) ->+                          ioError . userError $ concat errs ++ optionsUsage+                  }++validateOption :: M.Map OptionFlag String -> Bool -> Config ->+                  OptionFlag -> IO Config+validateOption optsMap updating config DB+    = do { dbPath <- if isAbsolute dbPath'+                     then return dbPath'+                     else do { cwd <- getCurrentDirectory+                             ; return $ combine cwd dbPath'+                             }+         ; let config' = config { mtnDb = dbPath }+         ; exists <- doesFileExist dbPath+         ; case exists of+             False -> mtnInitDB config'+             _ -> return ()+         ; return config'+         }+    where+      dbPath' = M.findWithDefault defaultDB DB optsMap+      defaultDB = if updating+                  then mtnDb config+                  else combine base "db.mtn"+      base = baseDir config+validateOption optsMap updating config Key+    = do { (_, privateKeys) <- mtnLsKeys config+         ; defaultKey' <- case privateKeys of+                            ((PrivateKey k _):_) -> return k+                            _ -> ioError . userError $+                                 "Unable to find any private keys.\n" +++                                 optionsUsage+         ; let defaultKey = if updating then user config else defaultKey'+         ; let key = M.findWithDefault defaultKey Key optsMap+         ; case any (keyMatch key) privateKeys of+             True -> return $ config { user = key }+             False -> ioError . userError $ "Cannot find private key for '" +++                      key ++ "'\n" ++ optionsUsage+         }+    where+      keyMatch :: String -> Key -> Bool+      keyMatch key (PrivateKey k _) = k == key+      keyMatch _ _ = False+validateOption optsMap updating config Branch+    = do { (bugsBranch, prefsBranch) <-+               if updating && M.notMember Branch optsMap+               then do { bb <- mtnFindCurrentBranch config bugsPath+                       ; pb <- mtnFindCurrentBranch config prefsPath+                       ; return (bb, pb)+                       }+               else return (bugsBranch', prefsBranch')+         ; setupBranchOrCheckOutOrUpdate config updating bugsBranch bugsPath >>=+           populateBugs config+         ; setupBranchOrCheckOutOrUpdate config updating prefsBranch prefsPath >>=+           writePrefs config+         ; return config+         }+    where+      defaultBranch = "DisTract"+      branchBase = M.findWithDefault defaultBranch Branch optsMap+      bugsBranch' = branchBase ++ ".bugs"+      prefsBranch' = branchBase ++ ".prefs." ++ ( user config )+      bugsPath = bugsDir base+      prefsPath = prefsDir base+      base = baseDir config+validateOption _ _ config Version = return config++setupBranchOrCheckOutOrUpdate :: Config -> Bool -> String -> FilePath ->+                                 IO Bool+setupBranchOrCheckOutOrUpdate config updating branch dir+    = do { existsBranch <- mtnDoesBranchExist config branch+         ; if existsBranch+           then do { existsDir <- doesDirectoryExist fullPath+                   ; if existsDir && updating+                     then do { branch' <- mtnFindCurrentBranch config dir+                             ; if branch' /= branch+                               then error $ "Need to have branch " +++                                    branch ++ " in " ++ fullPath +++                                    " but directory already exists and contains branch " +++                                    branch' ++ ". Aborting."+                               else mtnUpdate config dir Nothing+                             }+                     else mtnCheckOutBranch config base branch dir+                   ; return False+                   }+           else do { mtnSetupBranch config branch dir+                   ; return True+                   }+         }+    where+      base = baseDir config+      fullPath = combine base dir++writePrefs :: Config -> Bool -> IO ()+writePrefs config newBranch+    = do { writeFileStrict configPath configText+         ; if newBranch+           then do { writeFileStrict ignorePath ignoreText+                   ; mtnAdd config prefsPath [".mtn-ignore"]+                   ; mtnCommit config prefsPath "Adding .mtn-ignore" []+                   ; return ()+                   }+           else return ()+         }+    where+      prefsPath = prefsDir base+      configPath = combine prefsPath "config"+      base = baseDir config+      configText = "mtn=" ++ (mtnExecutable config) +++                   "\ndb=" ++ (mtnDb config) +++                   "\nverbose=" ++ (show . verbose $ config) +++                   logConfig+      logConfig = case logger config of+                    StdOutLog -> ""+                    (FileLog path) -> "\nlog=" ++ path+      ignorePath = combine prefsPath ".mtn-ignore"+      ignoreText = "^config$"++populateBugs :: Config -> Bool -> IO ()+populateBugs _ False = return ()+populateBugs config True+    = do { writeFileStrict ignorePath ignoreText+         ; installAllFields fieldsPath+         ; mtnAddUnknownFiles config bugsPath+         ; mtnCommit config bugsPath "Adding .mtn-ignore and fields." []+         ; return ()+         }+    where+      bugsPath = bugsDir base+      base = baseDir config+      ignorePath = combine bugsPath ".mtn-ignore"+      ignoreText = "^bug-"+      fieldsPath = combine bugsPath "fields"++invokeFormatNew :: Config -> IO ()+invokeFormatNew config+    = runExecutable config "DisTractFormatNew"++invokeSortBugs :: Config -> IO ()+invokeSortBugs config+    = runExecutable config "DisTractSortBugs"++invokeUpdateFormatAllBugs :: Config -> IO ()+invokeUpdateFormatAllBugs config+    = runExecutable config "DisTractUpdateFormatAllBugs"++runExecutable :: Config -> String -> IO ()+runExecutable config execName+    = do { (_, outH, errH, procH) <- runInteractiveProcess+                                     execPath [base]+                                     (Just base)+                                     Nothing+         ; out <- hGetContents outH+         ; err <- hGetContents errH+         ; waitForProcess procH+         ; log "stdout" out+         ; log "stderr" err+         }+    where+      base = baseDir config+      binPath = binDir base+      execPath = combine binPath execName+      log = logWithPrefix . logger $ config++main :: IO ()+main = do { (optionFlagsMap, remaining) <- parseOptions+          ; case M.lookup Version optionFlagsMap of+              Nothing -> doInstall optionFlagsMap remaining+              _ -> putStrLn $ package_name ++ ": Version " ++ package_version+          }++doInstall :: M.Map OptionFlag String -> [String] -> IO ()+doInstall optionFlagsMap remaining+    = do { (base, configBase, updating) <-+               case remaining of+                 [] -> ioError . userError $ "No Path supplied.\n" ++ optionsUsage+                 (path:rest) ->+                     do { exists <- doesDirectoryExist path+                        ; (base, configBase) <-+                            case exists of+                              True -> do { putStrLn $ "Path " ++ path +++                                           " already exists, upgrading."+                                         ; configBase <- buildConfigFromArgs remaining+                                         ; return (path, configBase)+                                         }+                              False -> do { createDirectory path+                                          ; configBase <- defaultConfig path []+                                          ; version <- mtnFindVersion configBase+                                          ; let configBase' = configBase { mtnVersion = version, args = rest }+                                          ; return (path, configBase')+                                          }+                        ; return (base, configBase, exists)+                        }+          ; config <- foldM (validateOption optionFlagsMap updating)+                      configBase [DB ..]+          ; createAllSubDirs base+          ; installAllBinaries (binDir base)+          ; installAllHTMLLibs (combine (htmlDir base) "lib")+          ; invokeFormatNew config+          ; invokeUpdateFormatAllBugs config+          ; invokeSortBugs config+          }++createAllSubDirs :: FilePath -> IO ()+createAllSubDirs base = mapM_ (createDirectoryIfMissing False .+                               combine base)+                        ["bin","html",combine "html" "lib"]++installAllBinaries :: FilePath -> IO ()+installAllBinaries binDir+    = do { mapM_ (flip installDisTractBinary binDir)+           [Installer_installDisTractBinary_NewBug ..]+         ; binaries <- getDirectoryContents binDir+         ; mapM_ makeExecutables binaries+         }+    where+      makeExecutables :: FilePath -> IO ()+      makeExecutables file+          = do { isFile <- doesFileExist fullPath+               ; if isFile+                 then setPermissions fullPath perm+                 else return ()+               }+          where+            fullPath = combine binDir file+            perm = Permissions { readable = True,+                                 writable = True,+                                 executable = True,+                                 searchable = False+                               }++-- these are in mtn so should only be installed on a new branch+installAllFields :: FilePath -> IO ()+installAllFields fieldsDir+    = do { createDirectory fieldsDir+         ; mapM_ (flip installDisTractField fieldsDir)+                     [Installer_installDisTractField_Title ..]+         }++installAllHTMLLibs :: FilePath -> IO ()+installAllHTMLLibs libsDir+    = mapM_ (flip installDisTractHTMLLib libsDir)+      [Installer_installDisTractHTMLLib_Bug ..]
+ src/DisTractModifyBug.hs view
@@ -0,0 +1,33 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module Main+    (main)+    where++import DisTract.BugFileInputLoader+import DisTract.Config+import DisTract.Types+import DisTract.Bug++main :: IO ()+main = do { config <- buildConfig+          ; case args config of+              [] -> return ()+              (fp:_) -> do { bugDetails <- parseForBugUpdate fp+                           ; case bugDetails of+                               Nothing -> return ()+                               (Just (bid, comment, fields)) ->+                                   updateBug config bid comment fields >>=+                                   log . show+                                   where+                                     log = logStr . logger $ config+                           }+          }
+ src/DisTractNewBug.hs view
@@ -0,0 +1,36 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module Main+    (main)+    where++import DisTract.BugFileInputLoader+import DisTract.Config+import DisTract.Types+import DisTract.Bug+import DisTract.Utils++main :: IO ()+main = do { config <- buildConfig+          ; case args config of+              [] -> return ()+              (fp:_) -> do { bugDetails <- parseForNewBug fp+                           ; case bugDetails of+                               Nothing -> return ()+                               (Just (comment, fields)) ->+                                   do { bug <- makeNewBug config comment fields+                                      ; writeFileStrict fp (show . bugId $ bug)+                                      ; log . show $ bug+                                      }+                                   where+                                     log = logStr . logger $ config+                           }+          }
+ src/DisTractSortBugs.hs view
@@ -0,0 +1,19 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module Main+    (main)+    where++import DisTract.HTML.BugList+import DisTract.Config++main :: IO ()+main = buildConfig >>= formatBugList
+ src/DisTractUpdateFormatAllBugs.hs view
@@ -0,0 +1,23 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module Main+    (main)+    where++import DisTract.HTML.BugView+import DisTract.IOUtils+import DisTract.Config++main :: IO ()+main = do { config <- buildConfig+          ; bugs <- loadAndUpdateAll config+          ; mapM_ (formatBug config) bugs+          }
+ src/DisTractUpdateFormatBug.hs view
@@ -0,0 +1,41 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module Main+    (main)+    where++import DisTract.Config+import DisTract.Types+import DisTract.Parsers+import DisTract.HTML.BugView+import DisTract.IOUtils+import DisTract.Bug+import Data.Either+import Data.Maybe++main :: IO ()+main = do { config <- buildConfig+          ; case args config of+              (bugIdStr:update:_)+                  -> do { bugM <- if (read update)+                                  then updateAndLoadBug config bugId+                                  else loadBug config bugId+                        ; case bugM of+                            Nothing -> error $ "Bug " ++ (show bugId) ++ " not found"+                            (Just _) -> formatBug config bugM+                        }+                  where+                    bugId = either (\e -> error $ (show e) +++                                    "Invalid bug id " ++ bugIdStr)+                                   id+                                   (findBugId bugIdStr)+              _ -> return ()+          }
+ src/JSON.hs view
@@ -0,0 +1,187 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  JSON+-- Copyright   :  (c) Masahiro Sakai & Jun Mukai 2006+-- License     :  BSD-style+--+-- Maintainer  :  sakai@tom.sfc.keio.ac.jp+-- Stability   :  experimental+-- Portability :  portable+--+-----------------------------------------------------------------------------++module JSON+    ( Value (..)+    , parse+    , json+    , stringify+    , stringify'+    , toDoc+    , toDoc'+    ) where++import Control.Monad hiding (join)+import Text.ParserCombinators.Parsec hiding (parse)+import qualified Text.ParserCombinators.Parsec as P+import Text.PrettyPrint.HughesPJ hiding (char)+import Text.Printf (printf)+import Data.Char (ord, chr, isControl)+import Data.List (unfoldr)+import Data.Bits+import qualified Data.Map as M++-- ---------------------------------------------------------------------------+-- The Value data type++data Value+    = String String+    | Double Double+    | Int Int+    | Object !(M.Map String Value)+    | Array [Value]+    | Bool !Bool+    | Null+    deriving (Eq, Show)++{-+instance Show Value where+    showsPrec p = showsPrec p . toDoc+-}++-- ---------------------------------------------------------------------------+-- The JSON Parser++parse :: String -> Maybe Value+parse s = case P.parse json "JSON.parse" s of+          Left _ -> Nothing+          Right v  -> Just v++json :: Parser Value+json = spaces >> tok value++tok :: Parser a -> Parser a+tok p = do{ x <- p; spaces; return x }++value :: Parser Value+value = msum+        [ liftM String str+        , liftM Int numberInt+        , liftM Double numberDouble+        , liftM Array  array+        , liftM Object object+        , string "true"  >> return (Bool True)+        , string "false" >> return (Bool False)+        , string "null"  >> return Null+        ]++str :: Parser String+str = liftM decodeSurrogatePairs $+      between (char '"') (char '"') $ many c1+    where c1 =  satisfy (\c -> not (c=='"' || c=='\\' || isControl c))+            <|> (char '\\' >> c2)+          c2 = msum+               [ char '"'+               , char '\\'+               , char '/'+               , char 'b' >> return '\b'+               , char 'f' >> return '\f'+               , char 'n' >> return '\n'+               , char 'r' >> return '\r'+               , char 't' >> return '\t'+               , char 'u' >> do xs <- count 4 hexDigit+                                return $ read $ "'\\x"++xs++"'"+               ]++numberDouble :: Parser Double+numberDouble = liftM read $ try (int >>+ frac >>+ option "" exp)+    where digits = many1 digit+          int    = option "" (string "-") >>+ digits+          frac   = char '.' >>: digits+          exp    = e >>+ digits+          e      = oneOf "eE" >>: option "" (string "+" <|> string "-")+          (>>+)  = liftM2 (++)+          (>>:)  = liftM2 (:)++numberInt :: Parser Int+numberInt = liftM read $ int+    where digits = many1 digit+          int    = option "" (string "-") >>+ digits+          (>>+)  = liftM2 (++)++object :: Parser (M.Map String Value)+object = liftM M.fromList $+         between (tok (char '{')) (char '}') $+         tok member `sepBy` tok (char ',')+    where member = do k <- tok str+                      tok (char ':')+                      v <- value+                      return (k,v)++array :: Parser [Value]+array  = between (tok (char '[')) (char ']') $+         tok value `sepBy` tok (char ',')++decodeSurrogatePairs :: String -> String+decodeSurrogatePairs = unfoldr phi+    where+      phi :: String -> Maybe (Char, String)+      phi (h:l:xs)+          | '\xD800' <= h && h <= '\xDBFF' &&  '\xDC00' <= l && l <= '\xDFFF'+              = seq c $ Just (c, xs)+                where c  = chr $ ((ord h .&. 1023) `shiftL` 10 .|. ord l .&. 1023) + 0x10000+      phi (x:xs) = Just (x, xs)+      phi [] = Nothing++-- ---------------------------------------------------------------------------+-- The JSON Printer++stringify :: Value -> String+stringify = stringify' (const False)++stringify' :: (Char -> Bool) -> Value -> String+stringify' needEscape = show . toDoc' needEscape++toDoc :: Value -> Doc+toDoc = toDoc' (const False)++toDoc' :: (Char -> Bool) -> Value -> Doc+toDoc' needEscape = go+    where+      go :: Value -> Doc+      go (String s) = strToDoc s+      go (Double x)+          | isInfinite x = error "can't stringify infinity"+          | isNaN x      = error "can't stringify NaN"+          | otherwise    = double x+      go (Int x)    = int x+      go (Object m) = lbrace <+> join comma members $+$ rbrace+          where members = [fsep [strToDoc k <> colon, nest 2 (go v)]+                           | (k,v) <- M.toList m]+      go (Array xs) = lbrack <+> join comma (map go xs) <+> rbrack+      go (Bool b)   = text $ if b then "true" else "false"+      go Null       = text "null"++      strToDoc :: String -> Doc+      strToDoc = doubleQuotes . text . concatMap f+          where f '"'  = "\\\""+                f '\\' = "\\\\"+                f '\b' = "\\b"+                f '\f' = "\\f"+                f '\n' = "\\n"+                f '\r' = "\\r"+                f '\t' = "\\t"+                f c | isControl c || needEscape c =+                        if c < '\x10000'+                        then printf "\\u%04x" c+                        else case makeSurrogatePair c of+                             (h,l) -> printf "\\u%04x\\u%04x" h l+                    | otherwise = [c]++join :: Doc -> [Doc] -> Doc+join s = fcat . punctuate s++makeSurrogatePair :: Char -> (Char,Char)+makeSurrogatePair c = (chr h, chr l)+    where c' = ord c+          h  = (c' - 0x10000) `shiftR` 10 .|. 0xd800+          l  = c' .&. 1023 .|. 0xdc00
+ src/Test.hs view
@@ -0,0 +1,31 @@+ {- DisTract ------------------------------------------------------\+ |                                                                 |+ | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |+ |                                                                 |+ | DisTract is freely distributable under the terms of a 3-Clause  |+ | BSD-style license. For details, see the DisTract web site:      |+ |   http://distract.wellquite.org/                                |+ |                                                                 |+ \-----------------------------------------------------------------}++module Test+where++import DisTract.Config+import DisTract.Layout+import DisTract.Types+import DisTract.Monotone.Types+import DisTract.Monotone.Interaction+import DisTract.Monotone.Parser+import DisTract.JSONUtils+import DisTract.Bug+import DisTract.Bug.Field+import DisTract.Bug.Comment+import DisTract.BugFileInputLoader+import DisTract.Parsers+import DisTract.Utils+import DisTract.IOUtils+import qualified JSON as J+import qualified Data.Map as M+import Data.Time+import System.Locale