Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Added little Tcl framework to do pages.

  • Loading branch information...
commit 502c1cd0a64d3177ea557da431127bbb9e344548 1 parent adf5039
@davidw authored
Showing with 297 additions and 0 deletions.
  1. +59 −0 layout.tcl
  2. +64 −0 tclrivet.tcl
  3. +174 −0 tclrivetparser.tcl
View
59 layout.tcl
@@ -0,0 +1,59 @@
+source [file join [file dirname [info script]] tclrivet.tcl]
+
+proc getlayout {filehandle} {
+ if { ! [info exists ::layout] } {
+ set fl [open layout.rvt]
+ set ::layout [read $fl]
+ close $fl
+ }
+ tclrivetparser::setoutputcmd [list puts -nonewline $filehandle]
+ set layoutparsed [tclrivetparser::parserivetdata $::layout]
+ return $layoutparsed
+}
+
+proc render {filename} {
+ namespace eval page {}
+
+ set htmlfile "[file rootname $fl].html"
+ set htmlfileexists [file exists $htmlfile]
+ if { $htmlfileexists } {
+ set htmlmtime [file mtime $htmlfile]
+ set rvtmtime [file mtime $fl]
+ }
+
+ if { $htmlfileexists && $htmlmtime > $rvtmtime } {
+ puts "$htmlfile up to date"
+ continue
+ }
+
+ set ::page::obuffer ""
+ tclrivetparser::setoutputcmd { append ::page::obuffer }
+ namespace eval page [list rivet $fl]
+
+ set ofile [open $htmlfile w]
+
+ proc contents {} [list namespace eval page [list puts -nonewline $ofile $::page::obuffer]]
+
+ namespace eval page [getlayout $ofile]
+ close $ofile
+
+ namespace delete page
+}
+
+proc all {} {
+ foreach fl [glob *.rvt] {
+ if { $fl eq "layout.rvt" } { continue }
+
+ render $fl
+ }
+}
+
+proc clean {} {
+ foreach fl [glob *.rvt] {
+ if { $fl eq "layout.rvt" } { continue }
+
+ file delete "[file rootname $fl].html"
+ }
+}
+
+eval [lindex $argv 0]
View
64 tclrivet.tcl
@@ -0,0 +1,64 @@
+# Tcl versions of Rivet commands.
+
+# Copyright 2003-2004 The Apache Software Foundation
+
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+
+# http://www.apache.org/licenses/LICENSE-2.0
+
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+# $Id: tclrivet.tcl 561309 2007-07-31 12:27:34Z davidw $
+
+package provide tclrivet 0.1
+
+source [file join [file dirname [info script]] tclrivetparser.tcl]
+
+# rivet --
+#
+# The rivet command runs a file in Rivet-like environment.
+#
+# Arguments:
+# filename - the name of the file to run.
+#
+# Side Effects:
+# Many, potentially. Output is sent to stdout.
+#
+# Results:
+# None.
+
+proc rivet { filename } {
+ set fl [open $filename]
+ set parsed [tclrivetparser::parserivetdata [read $fl]]
+ close $fl
+ uplevel $parsed
+}
+
+proc include { filename } {
+ set fl [open $filename]
+ fconfigure $fl -translation binary
+ puts -nonewline [ read $fl ]
+ close $fl
+}
+
+# We need to fill these in, of course.
+
+proc makeurl {} {}
+proc headers {} {}
+proc load_env {} {}
+proc load_headers {} {}
+proc var {} {}
+proc var_qs {} {}
+proc var_post {} {}
+proc upload {} {}
+proc parse {} {}
+proc no_body {} {}
+proc env {} {}
+proc abort_page {} {}
+proc virtual_filename {} {}
View
174 tclrivetparser.tcl
@@ -0,0 +1,174 @@
+# tclrivetparser.tcl -- parse Rivet files in pure Tcl.
+
+# Copyright 2003-2004 The Apache Software Foundation
+
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+
+# http://www.apache.org/licenses/LICENSE-2.0
+
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+# $Id: tclrivetparser.tcl 561309 2007-07-31 12:27:34Z davidw $
+
+package provide tclrivetparser 0.1
+
+namespace eval tclrivetparser {
+ set starttag <?
+ set endtag ?>
+ set outputcmd {puts -nonewline}
+ namespace export parserivetdata
+}
+
+# tclrivetparser::setoutputcmd --
+#
+# Set the output command used. In regular Rivet scripts, we use
+# puts, but that might not be ideal if you want to parse Rivet
+# pages in a Tcl script.
+#
+# Arguments:
+# newcmd - if empty, return the current command, if not, set the
+# command.
+#
+# Side Effects:
+# May set the output command used.
+#
+# Results:
+# The current output command.
+
+proc tclrivetparser::setoutputcmd { {newcmd ""} } {
+ variable outputcmd
+
+ if { $outputcmd == "" } {
+ return $outputcmd
+ }
+ set outputcmd $newcmd
+}
+
+# tclrivetparser::parse --
+#
+# Parse a buffer, transforming <? and ?> into the appropriate
+# Tcl strings. Note that initial 'puts "' is not performed
+# here.
+#
+# Arguments:
+# data - data to scan.
+# outbufvar - name of the output buffer.
+#
+# Side Effects:
+# None.
+#
+# Results:
+# Returns the $inside variable - 1 if we are inside a <? ?>
+# section, 0 if we outside.
+
+proc tclrivetparser::parse { data outbufvar } {
+ variable outputcmd
+ variable starttag
+ variable endtag
+ set inside 0
+
+ upvar $outbufvar outbuf
+
+ set i 0
+ set p 0
+ set len [expr {[string length $data] + 1}]
+ set next [string index $data 0]
+ while {$i < $len} {
+ incr i
+ set cur $next
+ set next [string index $data $i]
+ if { $inside == 0 } {
+ # Outside the delimiting tags.
+ if { $cur == [string index $starttag $p] } {
+ incr p
+ if { $p == [string length $starttag] } {
+ append outbuf "\"\n"
+ set inside 1
+ set p 0
+ continue
+ }
+ } else {
+ if { $p > 0 } {
+ append outbuf [string range $starttag 0 [expr {$p - 1}]]
+ set p 0
+ }
+ switch -exact -- "$cur" {
+ {\{} {
+ append outbuf "\\{"
+ }
+ {\}} {
+ append outbuf "\\}"
+ }
+ "\$" {
+ append outbuf "\\$"
+ }
+ {[} {
+ append outbuf {\[}
+ }
+ {]} {
+ append outbuf {\]}
+ }
+ "\"" {
+ append outbuf "\\\""
+ }
+ "\\" {
+ append outbuf "\\\\"
+ }
+ default {
+ append outbuf $cur
+ }
+ }
+ continue
+ }
+ } else {
+ # Inside the delimiting tags.
+ if { $cur == [string index $endtag $p] } {
+ incr p
+ if { $p == [string length $endtag] } {
+ append outbuf "\n$outputcmd \""
+ set inside 0
+ set p 0
+ }
+ } else {
+ if { $p > 0 } {
+ append outbuf [string range $endtag 0 $p]
+ set p 0
+ }
+ append outbuf $cur
+ }
+ }
+ }
+
+ return $inside
+}
+
+
+# tclrivetparser::parserivetdata --
+#
+# Parse a rivet script, and add the relavant opening and closing
+# bits.
+#
+# Arguments:
+# data - data to parse.
+#
+# Side Effects:
+# None.
+#
+# Results:
+# Returns the parsed script.
+
+proc tclrivetparser::parserivetdata { data } {
+ variable outputcmd
+ set outbuf {}
+ append outbuf "$outputcmd \""
+ if { [parse $data outbuf] == 0 } {
+ append outbuf "\"\n"
+ }
+ return $outbuf
+}

0 comments on commit 502c1cd

Please sign in to comment.
Something went wrong with that request. Please try again.