Posts tagged ‘Tcl’

proc globRecursive {dir masks} {
  set result [list]
  foreach cur [lsort [glob -nocomplain -dir $dir *]] {
    if {[file type $cur] == "directory"} {
      eval lappend result [globRecursive $cur $masks]
    } else {
      foreach mask $masks {
        if {[string match $mask $cur]} {
          lappend result $cur
          break
        }
      }
    }
  }
  return $result
}

package require Tk
package require hashtrie 1.0
package require  unicodeblock 1.1
package require edit  ? 1.0 ? 
edit pathName  ? options ? 
edit::addHighlightWord pathName word class
edit::deleteHighlightWord pathName word
edit::generateHighlightRule sourcefile rulefile
edit::addHighlightRgx pathName pattern tagname
edit::deleteHighlightRgx pathName pattern
edit::defineBrackets pathName brackets
edit::defineTextTag filename
edit::applyTextTags pathName tags
edit::linemapPopup X Y menu
edit::getAllMarkedIndex pathName startIndex endIndex
edit::getMarkedLine pathName index direction
pathName highlight startIndex endIndex
pathName copy
pathName cut
pathName paste
pathName append
pathName configure option value  ? ... ?
pathName refresh

% package require hashtrie
1.0
% set trie [hashtrie::new]
{} {} 0 {}
% set trie [hashtrie::add $trie test テスト]
{t-0 1 e-1 2 s-2 3 t-3 4} {4 テスト} 4 {4 test}
% set trie [hashtrie::add $trie check チェック]
{t-0 1 e-1 2 s-2 3 t-3 4 c-0 5 h-5 6 e-6 7 c-7 8 k-8 9} {4 テスト 9 チェック} 9 {4 test 9 check}
% set d [dict create 今日 きょう 明日 あした 明後日 あさって]
今日 きょう 明日 あした 明後日 あさって
% set trie [hashtrie::import $trie $d]
{t-0 1 e-1 2 s-2 3 t-3 4 c-0 5 h-5 6 e-6 7 c-7 8 k-8 9 今-0 10 日-10 11 明-0 12 日-12 13 後-12 14 日-14 15} {4 テスト 9 チェック 11 きょう 13 あした 15 あさって} 15 {4 test 9 check 11 今日 13 明日 15 明後日}
% hashtrie::exists $trie 今日
1
% hashtrie::replace $trie "今日と明日はtestで忙しい。"
きょうとあしたはテストで忙しい。
% hashtrie::remove trie check
1
% puts $trie
{t-0 1 e-1 2 s-2 3 t-3 4 c-0 5 h-5 6 e-6 7 c-7 8 k-8 9 今-0 10 日-10 11 明-0 12 日-12 13 後-12 14 日-14 15} {4 テスト 11 きょう 13 あした 15 あさって} 15 {4 test 11 今日 13 明日 15 明後日}

set blockname [unicodeblock::getblock "字"]