}

# Invokes web request page procs
proc webpage_hook {} {
  #if {! [anycap ro]} { break }
  catch { "webpage_$::web_name"; return TH_CONTINUE; }
}

# -------------------------------------------------------------------
# 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"]]
}   


#-- Extract dirname from path/file/name
proc str::dirname {path} {
   return [string range $path 0 [expr [string last "/" $path]-1]]
}





# -------------------------------------------------------------------
# SQL query tools
#
#   sql::allowed safe_string
#   sql::allowed_regexp safe_string
#   sql::page_exists WikiPage
#   sql::file_exists file.name
#   sql::find_file
#   sql::dir_exists
#


#-- Whitelist for SQL params
# Just realized this is redundant; because query {} accepts
# uninterpolated \$varnames as parameter placeholders.
proc sql::allowed {str} {
   return [regexp {^[-a-zA-Z0-9 !$&/(){}=<>,.;:_+#*@]+$} $str]
}
#-- Also prohibit regex special chars
proc sql::allowed_regexp {str} {
   return [regexp {^[-a-zA-Z0-9 !$&/    =<>,.;:_ # @]+$} $str]
}


#-- Check for existence of wiki page
proc sql::page_exists {name} {
   query {SELECT 1 FROM tag WHERE tagname = ('wiki-' || $name)} { return 1 }
   return 0
}


#-- Check if exact file name (including path) exists in repository
proc sql::file_exists {name} {
   query {SELECT 1 FROM filename WHERE name = $name} { return 1 }
   return 0
}


#-- Find file by basename
proc sql::find_file {path} {
   if {![sql::allowed_regexp $path]} { return 0 }
   query {SELECT name FROM filename WHERE name REGEXP ('(^|/)' || $path || '\$')} { return $name }
   return ""
}


#-- Check if directory exists
proc sql::dir_exists {path} {
   if {![sql::allowed_regexp $path]} { return 0 }
   query {SELECT name FROM filename WHERE name REGEXP ('^' || $path || '/.+')} { return 1 }
   return 0
}





# -------------------------------------------------------------------
# User Interface utility code
#
#   ui::stats
#   ui::lang_stats
#   ui::last_commit
#   ui::recent_files $dirname?
#   ui::social_links $baseurl



#-- 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[-a-z0-9_.]+\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 <span class=glyph>&#x2398;</span></a></span></th></tr>";
   }
}


#-- outputs table rows containing top-level filenames and recent checkin comments
proc ui::recent_files {dirname} {
   set seen ".gitignore"
   
   # search files using directory as base path
   set branch "trunk"
   set cutname 0
   set AND_DIR ""
   if {[string length $dirname]} {
       set dirname "$dirname/"
       set cutname [string length $dirname]
       set AND_DIR " AND substr(name, 0, \$cutname+1) = \$dirname "
   }

   # files   // vcache.rid=mlink.fid would be easier to skip deleted files, but access is prohibited(?)
   query "
       SELECT DISTINCT
          mlink.fnid,
          instr(substr(name,\$cutname+1),'/')  AS  is_dir,
          name                                AS  pathname,
          bf.rid   AS  fn_rid,     bf.uuid    AS  fn_uuid,
          bm.rid   AS  ci_rid,     bm.uuid    AS  ci_uuid,
          substr(comment, 0, 70)              AS  comment,
          CAST(julianday('now')-event.mtime AS INT) AS  age
       FROM
          filename
          JOIN mlink ON mlink.fnid=filename.fnid
          JOIN blob bf ON bf.rid=mlink.fid
          JOIN blob bm ON bm.rid=mlink.mid
          JOIN event ON event.objid=mlink.mid
       WHERE
          mlink.fnid NOT IN (SELECT fnid FROM mlink LEFT JOIN tagxref ON mlink.mid=tagxref.rid WHERE fid=0 AND tagxref.value='$branch')
          $AND_DIR
       GROUP BY
          name
       ORDER BY
          is_dir DESC, name ASC, event.mtime DESC
   " {

      # separate directories and files
      set name [string range $pathname $cutname 2048]
      set dir [string first "/" $name]
      if {$dir>0} { set name [string range $name 0 [expr $dir-1]] }

      # skip seen files
      if [str::contains $name $seen] { continue } else { set seen "$name,$seen" }
      
      # output table entries
      html "               <tr><td>";
      if {$dir>0} {
          # if there is an equivalent wiki page for a directory, then we mix filebox + wiki
          set display "wiki"
          #set display [?: [sql::page_exists "$dirname$name"] "wiki" "tree"]
          html "<a class=dir href='$display?name=[htmlize $dirname$name]'><b class=glyph>📂</b> [htmlize $name]</a>";
      } else {
          html "<a class=file href='artifact/$fn_uuid'><b class=glyph>📄</b> [htmlize $name]</a>";
      }
      html "</td> <td>[htmlize $comment]<a href='ci/$ci_uuid'>‹›</a></td> <td>[htmlize $age] days ago</td></tr>\n";
   }
}



#-- social media share links
proc ui::social_links {baseurl} {
  html "
   <a class=sml-go href='https://plus.google.com/share?url=$baseurl' title=google+>g+</a> &middot;
   <a class=sml-fb href='https://www.facebook.com/sharer/sharer.php?u=$baseurl' title=facebook>fb</a> &middot;
   <a class=sml-tw href='https://twitter.com/intent/tweet?url=$baseurl' title=twitter>tw</a> &middot;
   <a class=sml-rd href='http://reddit.com/submit?url=$baseurl' title=reddit>rd</a> &middot;
   <a class=sml-in href='https://www.linkedin.com/shareArticle?mini=true&amp;url=$baseurl' title=linkedin>in</a> &middot;
   <a class=sml-su href='https://www.stumbleupon.com/submit?url=$baseurl' title=stumbleupon>su</a> &middot;
   <a class=sml-dl href='https://del.icio.us/post?url=$baseurl' title=delicious>dl</a>
  ";
}