~ubuntu-branches/debian/sid/tk-html3/sid

« back to all changes in this revision

Viewing changes to tools/rules/formatting

  • Committer: Package Import Robot
  • Author(s): Ole Streicher
  • Date: 2012-03-02 18:45:00 UTC
  • Revision ID: package-import@ubuntu.com-20120302184500-np17d7d6gd1jedj0
Tags: upstream-3.0~fossil20110109
ImportĀ upstreamĀ versionĀ 3.0~fossil20110109

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
# -*- tcl -*-
 
2
# Helper rules for the creation of the memchan website from the .exp files.
 
3
# General formatting instructions ...
 
4
 
 
5
proc state {} [list return [file join [pwd] state]]
 
6
 
 
7
proc use_bg {} {
 
8
    set c [bgcolor]
 
9
    #puts stderr "using $c"
 
10
    if {$c == {}} {return ""}
 
11
    return bgcolor=$c
 
12
}
 
13
 
 
14
 
 
15
proc nbsp  {} {return " "}
 
16
proc p     {} {return <p>}
 
17
proc ptop  {} {return "<p valign=top>"}
 
18
proc td    {} {return "<td [use_bg]>"}
 
19
proc trtop {} {return "<tr valign=top [use_bg]>"}
 
20
proc tr    {} {return "<tr            [use_bg]>"}
 
21
proc sect {s} {return "<b>$s</b><br><hr>"}
 
22
proc link {text url} {return "<a href=\"$url\">$text</a>"}
 
23
proc table  {} {return "<table [border] width=100% cellspacing=0 cellpadding=0>"}
 
24
proc btable {} {return "<table border=1 width=100% cellspacing=0 cellpadding=0>"}
 
25
proc stable {} {return "<table [border] cellspacing=0 cellpadding=0>"}
 
26
 
 
27
 
 
28
proc tcl_cmd {cmd} {return "<b>\[$cmd]</b>"}
 
29
proc wget    {url} {exec /usr/bin/wget -q -O - $url 2>/dev/null}
 
30
 
 
31
proc url {tag text url} {
 
32
    set body {
 
33
        switch -exact -- $what {
 
34
            link {return {<a href="%url%">%text%</a>}}
 
35
            text {return {%text%}}
 
36
            url  {return {%url%}}
 
37
        }
 
38
    }
 
39
    proc $tag {{what link}} [string map [list %text% $text %url% $url] $body]
 
40
}
 
41
 
 
42
proc img {tag alt img} {
 
43
    proc $tag {} [list return "<img alt=\"$alt\" src=\"$img\">"]
 
44
}
 
45
 
 
46
proc header {title} {
 
47
    proc pagetitle {} [list return $title]
 
48
    return "<html><head><title>[sfproject] @ SourceForge : $title</title><meta name=\"Author\" content=[author]></head><body [use_bg]>"
 
49
}
 
50
 
 
51
proc trailer {} {
 
52
    return "<hr>[table][tr]<td align=left><address>[copyright][me]</address></td><td align=right>Last update at [clock format [clock seconds]]</td></tr></table></body></html>"
 
53
}
 
54
 
 
55
proc protect {text} {return [string map [list & "&amp;" < "&lt;" > "&gt;"] $text]}
 
56
 
 
57
proc get_changelog {} {
 
58
    set cl [exec [file join [here] .. changelog_to_list] [file join [pwd] .. memchan ChangeLog]]
 
59
    proc get_changelog {} [list return $cl]
 
60
    return $cl
 
61
}
 
62
 
 
63
proc changelog {} {
 
64
    set cl   [get_changelog]
 
65
    set html "<ul>"
 
66
 
 
67
    foreach chunk $cl {
 
68
        foreach {date person items} $chunk break ; # lassign
 
69
        append html "<li><hr><b>[protect $date]</b><p align=right>[protect $person] ...<hr>[p][changelog_items $items][p]\n"
 
70
    }
 
71
 
 
72
    return $html</ul>
 
73
}
 
74
 
 
75
proc changelog_items {items} {
 
76
    set dlopen  0
 
77
    set onlykey 0
 
78
 
 
79
    set html ""
 
80
    foreach item $items {
 
81
        set key [set com {}]
 
82
        foreach {key com} $item break
 
83
 
 
84
        if {$key != {}} {
 
85
            if {!$dlopen} {
 
86
                if {$onlykey} {
 
87
                    append html [p]
 
88
                    set onlykey 0
 
89
                }
 
90
                append html <dl>\n
 
91
            }
 
92
            set dlopen 1
 
93
 
 
94
            append html <dt><i>[protect $key]</i></dt>
 
95
            if {$com != {}} {
 
96
                append html <dd>[protect $com]</dd>\n
 
97
            }
 
98
        } else {
 
99
            if {$com != {}} {
 
100
                if {$dlopen} {append html </dl>[p]\n}
 
101
                set dlopen 0
 
102
                append html [protect $com]
 
103
                set onlykey 1
 
104
            }
 
105
        }
 
106
 
 
107
    }
 
108
    if {$dlopen} {append html </dl>\n}
 
109
    return $html
 
110
}
 
111
 
 
112
proc news {} {
 
113
    set nfile [file join [state] news]
 
114
    set data [read [set fh [open $nfile r]]][close $fh]
 
115
    return [string trim $data]\n
 
116
}
 
117
 
 
118
proc stats {} {
 
119
    set nfile [file join [state] statistics]
 
120
    set data [read [set fh [open $nfile r]]][close $fh]
 
121
 
 
122
    set data [string trim $data]
 
123
 
 
124
    regsub -all {BGCOLOR="[^"]*"} $data "[use_bg]" data
 
125
    regsub -all {bgcolor="[^"]*"} $data "[use_bg]" data
 
126
 
 
127
    return [string trim $data]\n
 
128
}