if {[info exists login]} {
html "✉ $login 751"
html "✹1 ✹5 | "
html "Logout | "
} else {
html "Login | "
}
if {[hascap s]} {
html "Admin | "
} elseif {[hascap a]} {
html "Users | "
}
Fossil manual |
catch { ui::lang_stats }
$
$</b></h2>
<th1>
catch {ui::search_on_wiki}
</th1>'
config /config 909
1392538406 'footer' value '</div><!--container-->
<footer class=footer>
<p><a href=http://fossil-scm.org/>Fossil</a> version <tt>$release_version</tt> | Manifest: $manifest_version | Manifest date: $manifest_date</p>
<p>
<a href=wiki>wiki</a>
| <a href=login>account</a>
| <a href=setup>admin</a>
| <a href=home>home</a>
</p>
<ul>
<li><a href=tree?ci=tip>Files</a>
<li><a href=zip/trunk.zip?uuid=trunk>ZIP</a>
<li><a href=tarball/trunk.zip?uuid=trunk>TGZ</a>
<li><a href=timeline>Timeline</a>
<li><a href=brlist>Branches</a>
<li><a href=taglist>Tags</a>
<li><a href=reportlist>Tickets</a>
<li><a href=reports>Reports</a>
</ul>
<p>
Skin inspired by <a href=//s.tk/so>Stackoverflow</a>
</p>
</footer>
</body>
</html>
'
config /config 9097
1395068051 'th1-setup' value '
# -------------------------------------------------------------------
# Control structures
#
# ++ varname
# ?: [if] {then} {else}
# isset varname
# eq str1 str2
#
# while {cond} {code}
# foreach varname {list} {code}
# switch value { val1 {code1} val2 {code2} ... }
#
#-- Pre-increment [++ varname]
proc ++ {varname} {
upvar 1 $varname i
return [uplevel 1 "set {$varname} [expr 1+$i]"]
}
#-- ternary / if-shorthand (cond/then/else may be literals, or {[expressions]} themselves)
proc ?: {cond then else} {
uplevel 1 "if {$cond} { return $then; } else { return $else; }"
}
#-- info exists shorthand
proc isset {varname} {
return [uplevel 1 "info exists {$varname}"]
}
#-- string equality shorthand
proc eq {str1 str2} {
return [expr {$str1 eq $str2}]
}
#-- while loop
proc while {condition code} {
return [uplevel 1 "for {} {$condition} {} {$code}"]
}
#-- foreach list
#
# foreach VAR "abc xyz 123" { puts "($VAR) " }
#
proc foreach {varname list code} {
upvar 1 $varname val
for {set i 0} {$i < [llength $list]} {++ i} {
set val [lindex $list $i]
uplevel 1 "$code"
}
}
#-- A switch statement.
#
# switch "val" {
# "cmp1" {code1}
# "cmp2" {code2}
# "cmp3" {code3}
# {{default}} {codeN}
# }
#
proc switch {compare_value val_code_pairs} {
set len [llength $val_code_pairs]
# loop over compare values + code pairs
for {set n 0} {$n < $len} {++ n} {
set cmp [lindex $val_code_pairs $n];
if {[expr $cmp eq $compare_value || $cmp eq {{default}} ]} {
return [uplevel 1 [lindex $val_code_pairs [++ n]]];
}
}
}
# -------------------------------------------------------------------
# String functions
#
# str::contains needle haystack
# str::next needle haystack startindex
# str::wrap haystack needle addbefore addafter
#
#-- returns true if string contained in another string
proc str::contains {needle haystack} {
return [expr {-1 != [string first $needle $haystack]}]
}
#-- wrapper for [string first ...] to support startindex
proc str::next {search content start} {
# cut out $content at $start before searching
set p [string first $search [string range $content $start [string length $content]]]
if [expr $p>=0] {
set p [expr $start+$p]
}
return $p
}
#-- enclose string in e.g. html tags
proc str::wrap {content search before after} {
set len [string length $search]
set p 0
while {[expr [set p [str::next $search $content $p]]>=0]} {
set content "[string range $content 0 [expr $p-1]]$before$search$after[string range $content [expr $p+$len] 2000]";
set p [expr $p+[string length "$before+$search+$after"]]; # skip a little further
}
return $content
}
#-- Split string into list on delimiter character
# (basically just turns delimiter into space)
#
proc str::explode {delim str} {
set r ""
set len [string length $str]
while {-1 != [set p [string first $delim $str]]} {
set r "$r [string range $str 0 [expr $p-1]]"
set str [string range $str [++ p] $len]
}
return [list [string trim "$r $str"]]
}
# -------------------------------------------------------------------
# User Interface utility code
#
# sql::allowed safe_string
# ui::page_exists WikiPage
# ui::file_exists file.name
#
# ui::search terms baseurl
# ui::search_on_wiki
# ui::stats
# ui::lang_stats
#
#-- Whitelist permissible characters for SQL context
# * A workaround for the lack of SQL escaping here (or the new query API branch)
# * Used in LIKE context, so ? and % are not allowed
# * And '' and \ or " not included in the whitelist for obvious reasons.
proc sql::allowed {str} {
return [regexp {^[a-zA-Z0-9 !$&/(){}=<>,.;:-_+#*@]+$} $str]
}
#-- Search function
# * Requires fossil-search.php to build the according table
# (reading from the raw blobs is impossible) as cronjob
# * And a patched `fossil` binary src/report.c to allow
# SELECTs on the `search` table.
proc ui::search {terms baseurl} {
# cleanup $terms
if [sql::allowed $terms] {
# prepare search query
set WHERE "1"
foreach search $terms {
set WHERE "$WHERE AND content LIKE ''%$search%''"
}
# perform search
query "SELECT path, type, name, content FROM fx_search WHERE $WHERE" {
# conent excerpt and highlighting
set p [string first $terms $content]
set excerpt [string range $content [expr $p-50] [expr $p+450]]
foreach search $terms {
set excerpt [str::wrap "$excerpt" $search <mark> </mark>]
}
# format result list
html "
<div class=search-result>
<b>[htmlize $type]</b>
<a href=[htmlize $path]>[htmlize $name]</a> <br>
<span class=search-link><a href=[htmlize $path]>$baseurl/[htmlize $path]</a></span> <br>
<small class=search-excerpt>$excerpt</small>
</div>\n";
}
}
}
#-- Check for existence of wiki page
proc ui::page_exists {name} {
if [sql::allowed $name] {
query "SELECT 1 FROM tag WHERE tagname = ''wiki-$name''" {
return 1
}
}
return 0
}
#-- Check if file exists in repository
proc ui::file_exists {name} {
if [sql::allowed $name] {
query "SELECT 1 FROM filename WHERE name = ''$name''" {
return 1
}
}
return 0
}
#-- Call ui::search on non-existant wiki pages
# * We can get $<title> as search terms
# (no way to access query string parameters otherwise)
# * But this is also convenient, as it doubles as wiki page search
proc ui::search_on_wiki {} {
upvar 1 title title baseurl baseurl current_page current_page
if [expr {[regexp {^wiki[?]name=} $current_page] && ! [ui::page_exists $title]}] {
html "<h2 class=search-headline>Search</h2>";
ui::search $title $baseurl
html "<br><br><br><br>"
}
}
#-- Ordered list of project statistics (will populate global $stats() array)
proc ui::stats {} {
uplevel 1 { query {SELECT
(SELECT count(objid) FROM event WHERE type=''ci'' LIMIT 1) AS `stats_checkins`,
(SELECT count(name) FROM filename LIMIT 1) AS `stats_files`,
(SELECT count(status) FROM ticket LIMIT 1) AS `stats_tickets`,
(SELECT count(DISTINCT user) FROM event LIMIT 1) AS `stats_developers`,
(SELECT count(DISTINCT value) FROM tagxref WHERE tagid=8) AS `stats_branches`,
(SELECT count(tagname) FROM tag WHERE tagname LIKE ''sym-%'') AS `stats_tags`,
(SELECT count(tagname) FROM tag WHERE tagname REGEXP ''^sym[\\-\\w_.]+\\d+\\.\\d+'') AS `stats_releases`
} {} }
}
#-- Language/Content statistics (outputs colored bar graph)
proc ui::lang_stats {} {
# fetch $lang(js/...), $lang_color(js), $lang_list, $total_size
query {SELECT name, value FROM fx_stats ORDER by VALUE DESC} {
set $name $value
}
# output color bar for language proportions
#html "<div class=language-bar style=''width:100%; height:3pt; box-sizing:border-box;''>"
foreach name $lang_list {
set percent "[expr $lang($name)*100]%"
html "<span class=code-rate-$name style=''height:100%; width:$percent; display:inline-block; background-color:#$lang_color($name)'' title=''$percent $name''></span>";
}
#html "</div>";
}
#-- print two table rows for last commit
proc ui::last_commit {} {
query {SELECT *, CAST(julianday(''now'')-mtime AS INT) AS age, substr(comment,0,199) AS msg, substr(uuid, 0, 10) AS short_uuid
FROM event JOIN blob ON blob.rid=event.objid
WHERE type=''ci'' ORDER BY mtime DESC LIMIT 1
} {
html " <tr><th colspan=3>$msg</th></tr>";
html " <tr><th colspan=3 style=background:#fff><a href=''timeline?u=$user'' class=user>$user</a> authored $age days ago
<span style=float:right>last checkin <a href=''ci/$uuid''>$short_uuid</a></span></th></tr>";
}
}
#-- outputs table rows containing top-level filenames and recent checkin comments
proc ui::recent_files {} {
set seen ""
# files
query {
SELECT DISTINCT
instr(name, ''/'') as dir,
(CASE instr(name,''/'') WHEN 0 THEN name
ELSE substr(name,0,instr(name, ''/'')) END) AS name,
substr(comment, 0, 70) AS comment,
uuid,
CAST(julianday(''now'')-mtime AS INT) AS age
FROM filename
JOIN mlink ON filename.fnid=mlink.fnid
JOIN event ON mlink.mid=event.objid
JOIN blob ON blob.rid=event.objid
GROUP BY name ORDER BY dir DESC, mtime DESC
} {
if {$dir && [str::contains $name $seen]} { continue } else { set seen "$name,$seen" }
html " <tr><td>";
if {$dir > 0} {
html "<a class=dir href=''tree?name=[htmlize $name]''><b class=glyph>📂</b> [htmlize $name]</a>";
} else {
html "<a class=file href=''ci/$uuid?sbs=0''><b class=glyph>📄</b> [htmlize $name]</a>";
}
html "</td> <td>[htmlize $comment]</td> <td>[htmlize $age] days ago</td></tr>\n";
}
}'