Check Tcl support Thread or not

proc is_threaded {} {
 return [expr {[info exists ::tcl_platform(threaded)] && $::tcl_platform(threaded)}]
}

然後就可以使用 is_threaded 來判斷是否有支援 Thread.


如果要共用資料，可以使用 tsv command。下面是改寫以後的備份程式：

#!/usr/local/bin/tclsh
#
# This file is used to backup my homepage
#


proc is_threaded {} {
 return [expr {[info exists ::tcl_platform(threaded)] && $::tcl_platform(threaded)}]
}

set support [is_threaded]

proc backup_to_7z {} {
  set backupfile $::env(HOME)
  append backupfile "/Homepage-"
  append backupfile [clock format [clock seconds] -format %Y%m%d]
  append backupfile ".7z"

  set backupdir $::env(HOME)
  append backupdir "/public_html"

  set fileExist [file exists $backupfile]
  if {$fileExist > 0} {
      puts "Now try to remove old backup file."
      file delete $backupfile
  }

  set var [list 7z -p12345 a $backupfile $backupdir]
  exec {*}$var
}


if {$support == 1} {
  package require Tk
  package require Thread

  set ::gThread [thread::create {thread::wait} ]
  tsv::set body_backup_to_7z shared [info body backup_to_7z]


  label .greetings -text "Now backup my homepage..." -bd 4 -relief ridge
  pack .greetings -fill both

  wm title . "Backup"

  thread::send -async $::gThread { 
    set command [tsv::get body_backup_to_7z shared]
    eval $command
  } result  

  vwait result
} else {
  puts "No thread support..., so this script can't use Thread."

  backup_to_7z
}

exit

利用 Tcl 的特性，所以可以取得 proc body 以後當成是共用資料傳遞，如果資料量很小的時候，這是個很好玩的做法。