diff --git a/lib/linguist/samples.json b/lib/linguist/samples.json index 2fd22b9e..9a09956e 100644 --- a/lib/linguist/samples.json +++ b/lib/linguist/samples.json @@ -455,6 +455,9 @@ ".svh", ".vh" ], + "Tcl": [ + ".tm" + ], "Tea": [ ".tea" ], @@ -575,8 +578,8 @@ ".gemrc" ] }, - "tokens_total": 456690, - "languages_total": 569, + "tokens_total": 457823, + "languages_total": 571, "tokens": { "ABAP": { "*/**": 1, @@ -45948,6 +45951,127 @@ "x": 6, "endfunction": 1 }, + "Tcl": { + "#": 7, + "package": 2, + "require": 2, + "Tcl": 2, + "namespace": 6, + "eval": 2, + "stream": 61, + "{": 148, + "export": 3, + "[": 76, + "a": 1, + "-": 5, + "z": 1, + "]": 76, + "*": 19, + "}": 148, + "ensemble": 1, + "create": 7, + "proc": 28, + "first": 24, + "restCmdPrefix": 2, + "return": 22, + "list": 18, + "lassign": 11, + "foldl": 1, + "cmdPrefix": 19, + "initialValue": 7, + "args": 13, + "set": 34, + "numStreams": 3, + "llength": 5, + "if": 14, + "FoldlSingleStream": 2, + "lindex": 5, + "elseif": 3, + "FoldlMultiStream": 2, + "else": 5, + "Usage": 4, + "foreach": 5, + "numArgs": 7, + "varName": 7, + "body": 8, + "ForeachSingleStream": 2, + "(": 11, + ")": 11, + "&&": 2, + "%": 1, + "end": 2, + "items": 5, + "lrange": 1, + "ForeachMultiStream": 2, + "fromList": 2, + "_list": 4, + "index": 4, + "expr": 4, + "+": 1, + "isEmpty": 10, + "map": 1, + "MapSingleStream": 3, + "MapMultiStream": 3, + "rest": 22, + "select": 2, + "while": 6, + "take": 2, + "num": 3, + "||": 1, + "<": 1, + "toList": 1, + "res": 10, + "lappend": 8, + "#################################": 2, + "acc": 9, + "streams": 5, + "firsts": 6, + "restStreams": 6, + "uplevel": 4, + "nextItems": 4, + "msg": 1, + "code": 1, + "error": 1, + "level": 1, + "XDG": 11, + "variable": 4, + "DEFAULTS": 8, + "DATA_HOME": 4, + "CONFIG_HOME": 4, + "CACHE_HOME": 4, + "RUNTIME_DIR": 3, + "DATA_DIRS": 4, + "CONFIG_DIRS": 4, + "SetDefaults": 3, + "ne": 2, + "file": 9, + "join": 9, + "env": 8, + "HOME": 3, + ".local": 1, + "share": 3, + ".config": 1, + ".cache": 1, + "/usr": 2, + "local": 1, + "/etc": 1, + "xdg": 1, + "XDGVarSet": 4, + "var": 11, + "info": 1, + "exists": 1, + "XDG_": 4, + "Dir": 4, + "subdir": 16, + "dir": 5, + "dict": 2, + "get": 2, + "Dirs": 3, + "rawDirs": 3, + "split": 1, + "outDirs": 3, + "XDG_RUNTIME_DIR": 1 + }, "Tea": { "<%>": 1, "template": 1, @@ -49702,6 +49826,7 @@ "Stylus": 76, "SuperCollider": 133, "SystemVerilog": 541, + "Tcl": 1133, "Tea": 3, "TeX": 2701, "Turing": 44, @@ -49853,6 +49978,7 @@ "Stylus": 1, "SuperCollider": 1, "SystemVerilog": 4, + "Tcl": 2, "Tea": 1, "TeX": 2, "Turing": 1, @@ -49873,5 +49999,5 @@ "Xtend": 2, "YAML": 2 }, - "md5": "369eb61211321cd0a217de22110731ac" + "md5": "0cf73610115419ee252a48415b538180" } \ No newline at end of file diff --git a/samples/Tcl/stream-0.1.tm b/samples/Tcl/stream-0.1.tm new file mode 100644 index 00000000..24510d07 --- /dev/null +++ b/samples/Tcl/stream-0.1.tm @@ -0,0 +1,201 @@ +# A stream ensemble +# +# Copyright (c) 2013 Lawrence Woodman +# +# Licensed under an MIT licence. Please see LICENCE.md for details. +# + +package require Tcl 8.5 + +namespace eval stream { + namespace export {[a-z]*} + namespace ensemble create +} + +proc stream::create {first restCmdPrefix} { + return [list $first $restCmdPrefix] +} + +proc stream::first {stream} { + lassign $stream first + return $first +} + +proc stream::foldl {cmdPrefix initialValue args} { + set numStreams [llength $args] + if {$numStreams == 1} { + FoldlSingleStream $cmdPrefix $initialValue [lindex $args 0] + } elseif {$numStreams > 1} { + FoldlMultiStream $cmdPrefix $initialValue $args + } else { + Usage "stream foldl cmdPrefix initalValue stream ?stream ..?" + } +} + +proc stream::foreach {args} { + set numArgs [llength $args] + if {$numArgs == 3} { + lassign $args varName stream body + ForeachSingleStream $varName $stream $body + } elseif {($numArgs > 3) && (($numArgs % 2) == 1)} { + set body [lindex $args end] + set items [lrange $args 0 end-1] + ForeachMultiStream $items $body + } else { + Usage "stream foreach varName stream ?varName stream ..? body" + } +} + +proc stream::fromList {_list {index 0}} { + if {$index >= [llength $_list]} {return {}} + create [lindex $_list $index] [list fromList $_list [expr {$index + 1}]] +} + +proc stream::isEmpty {stream} { + expr {[llength $stream] == 0} +} + +proc stream::map {cmdPrefix args} { + set numArgs [llength $args] + if {$numArgs == 1} { + MapSingleStream $cmdPrefix [lindex $args 0] + } elseif {$numArgs > 1} { + MapMultiStream $cmdPrefix $args + } else { + Usage "stream map cmdPrefix stream ?stream ..?" + } +} + +proc stream::rest {stream} { + set rest [lindex $stream 1] + {*}$rest +} + +# Note: This will work through the elements of the stream until it finds +# the first element that is matched by the cmdPrefix predicate. +proc stream::select {cmdPrefix stream} { + while {![isEmpty $stream]} { + lassign $stream first rest + if {[{*}$cmdPrefix $first]} { + return [create $first [list select $cmdPrefix [{*}$rest]]] + } else { + set stream [{*}$rest] + } + } + return $stream +} + +proc stream::take {num stream} { + if {[isEmpty $stream] || $num <= 0} { + return [::list] + } else { + lassign $stream first rest + create $first [list take [expr {$num - 1}] [{*}$rest]] + } +} + +proc stream::toList {stream} { + set res [::list] + while {![isEmpty $stream]} { + lassign $stream first rest + lappend res $first + set stream [{*}$rest] + } + return $res +} + + +################################# +# Internal +################################# + +proc stream::FoldlSingleStream {cmdPrefix initialValue stream} { + set acc $initialValue + while {![isEmpty $stream]} { + lassign $stream first rest + set acc [{*}$cmdPrefix $acc $first] + set stream [{*}$rest] + } + return $acc +} + +proc stream::FoldlMultiStream {cmdPrefix initialValue streams} { + set acc $initialValue + + while 1 { + set firsts [::list] + set restStreams [::list] + ::foreach stream $streams { + if {[isEmpty $stream]} { + return $acc + } + lassign $stream first rest + lappend firsts $first + lappend restStreams [{*}$rest] + } + set acc [{*}$cmdPrefix $acc {*}$firsts] + set streams $restStreams + } + return $acc +} + +proc stream::ForeachSingleStream {varName stream body} { + set res {} + while {![isEmpty $stream]} { + lassign $stream first rest + uplevel 2 [list set $varName $first] + set stream [{*}$rest] + set res [uplevel 2 $body] + } + return $res +} + +proc stream::ForeachMultiStream {items body} { + set res {} + + while 1 { + set nextItems [::list] + ::foreach {varName stream} $items { + if {[isEmpty $stream]} { + return $res + } + lassign $stream first rest + uplevel 2 [list set $varName $first] + lappend nextItems $varName + lappend nextItems [{*}$rest] + } + set res [uplevel 2 $body] + set items $nextItems + } + + return $res +} + +proc stream::MapSingleStream {cmdPrefix stream} { + if {[isEmpty $stream]} { + return $stream + } + lassign $stream first rest + create [{*}$cmdPrefix $first] [list MapSingleStream $cmdPrefix [{*}$rest]] +} + +proc stream::MapMultiStream {cmdPrefix streams} { + set firsts [::list] + set restStreams [::list] + + ::foreach stream $streams { + if {[isEmpty $stream]} { + return $stream + } + lassign $stream first rest + lappend firsts $first + lappend restStreams [{*}$rest] + } + + return [create [{*}$cmdPrefix {*}$firsts] \ + [list MapMultiStream $cmdPrefix $restStreams]] +} + +proc stream::Usage {msg} { + return -code error -level 2 "wrong # args: should be \"$msg\"" +} diff --git a/samples/Tcl/xdgbasedir-0.3.tm b/samples/Tcl/xdgbasedir-0.3.tm new file mode 100644 index 00000000..cc5cd8a6 --- /dev/null +++ b/samples/Tcl/xdgbasedir-0.3.tm @@ -0,0 +1,76 @@ +# XDG Base Directory Specification handling +# +# Copyright (C) 2013 Lawrence Woodman +# +# Licensed under an MIT licence. Please see LICENCE.md for details. +# +# For XDG Base Directory Specification +# http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html +# +package require Tcl 8.5 + +namespace eval XDG { + variable DEFAULTS "" + namespace export DATA_HOME CONFIG_HOME CACHE_HOME + namespace export RUNTIME_DIR DATA_DIRS CONFIG_DIRS +} + +proc XDG::SetDefaults {} { + variable DEFAULTS + if {$DEFAULTS ne ""} return + set DEFAULTS [list \ + DATA_HOME [file join $::env(HOME) .local share] \ + CONFIG_HOME [file join $::env(HOME) .config] \ + CACHE_HOME [file join $::env(HOME) .cache] \ + DATA_DIRS [list [file join /usr local share] [file join /usr share]] \ + CONFIG_DIRS [list [file join /etc xdg ]] + ] +} + +proc XDG::XDGVarSet {var} { + expr {[info exists ::env(XDG_$var)] && $::env(XDG_$var) ne ""} +} + +proc XDG::Dir {var {subdir ""} } { + variable DEFAULTS + SetDefaults + set dir [dict get $DEFAULTS $var] + + if {[XDGVarSet $var]} { + set dir $::env(XDG_$var) + } + + return [file join $dir $subdir] +} + +proc XDG::Dirs {var {subdir ""} } { + variable DEFAULTS + SetDefaults + set rawDirs [dict get $DEFAULTS $var] + + if {[XDGVarSet $var]} { + set rawDirs [split $::env(XDG_$var) ":"] + } + + set outDirs {} + foreach dir $rawDirs { + lappend outDirs [file join $dir $subdir] + } + return $outDirs +} + +# The remaining procs reference the environmental variables XDG_ +# followed by the proc name. +proc XDG::DATA_HOME {{subdir ""}} {Dir DATA_HOME $subdir} +proc XDG::CONFIG_HOME {{subdir ""}} {Dir CONFIG_HOME $subdir} +proc XDG::CACHE_HOME {{subdir ""}} {Dir CACHE_HOME $subdir} + +proc XDG::RUNTIME_DIR {{subdir ""}} { + if {![XDGVarSet RUNTIME_DIR]} { return {} } + return [file join $::env(XDG_RUNTIME_DIR) $subdir] +} + +# The following procs returning the directories as a list with the most +# important first. +proc XDG::DATA_DIRS {{subdir ""}} {Dirs DATA_DIRS $subdir} +proc XDG::CONFIG_DIRS {{subdir ""}} {Dirs CONFIG_DIRS $subdir}