Here is another little proc which monitores filesystem objects (files, dirs) for changes. If a change happens (that is, the objects modification time changed), a callback or specified command is triggered. Callbacks have access to the changed objects name, so they can be generalized.
This proc only tells that a change occured, but not what kind of change this was (could be creation, alteration, deletetion.....).
This code is a generalized and enhanced version of some fragments used here and there in my programs - I don't want to maint and test them separately anymore!
There are other pages on this wiki, which show similar solutions (I think I posted some fragments somewhere, too), but I can't locate them at the moment, and there are other, more powerfull high-level solutions like that built in TWAPI.
However, with this proc you can monitor an arbitrary number of objects in arbitrary intervalls. Each monitoring process which has its own handle can be canceled later. It should be noticed that it is not a good idea to monitor many projects in short intervalls, because such polling slows the computer down....
###############################################################################
# Modul : watch.tcl #
# Changed : 28.02.2008 #
# Purpose : observing directories or files for changes, triggering callback. #
# Author : M.Hoffmann #
# Remarks : callback(scripts) are evaluated in the scope of the caller. #
# Todo : stop watching if command/callback returns error/break. #
# History : #
# 28.02.08 : v1.0 1st version made out of several of my progs. #
###############################################################################
package provide watch 1.0
namespace eval watch {
variable nextHandle 0
variable activeIDs
array set activeIDs {}
}
proc watch::FSChange {obj intv script {lastMTime ""} {handle 0}} {
variable nextHandle
variable activeIDs
# Att: obj, intv and script are not fully checked by us yet
catch {file mtime $obj} nowMTime
if [string eq $lastMTime ""] {
# new call, no recursion
incr nextHandle; # caution: no reuse yet, simply increment each time
set handle $nextHandle
set lastMTime $nowMTime
} elseif {$nowMTime != $lastMTime} {
if {[uplevel info procs [lindex $script 0]] != ""} {
catch {uplevel $script $obj};# append objectname to callback proc
} else {
catch {uplevel [string map [list %O $obj] $script]}
}
set lastMTime $nowMTime
}
set activeIDs($handle) \
[after $intv [list watch::FSChange $obj $intv $script $lastMTime $handle]]
return $handle
}
proc watch::Cancel {handle} {
variable activeIDs
set script ""
catch {
set script [lrange [join [after info $activeIDs($handle)]] 1 end-3]
after cancel $activeIDs($handle)
unset activeIDs($handle)
}
return $script
}
#============================================================================== ###############################################################################
# Modul : watch.tcl #
# Changed : 28.02.2008 #
# Purpose : observing directories or files for changes, triggering callback. #
# Author : M.Hoffmann #
# Remarks : callback(scripts) are evaluated in the scope of the caller. #
# Todo : stop watching if command/callback returns error/break. #
# History : #
# 28.02.08 : v1.0 1st version made out of several of my progs. #
###############################################################################
package provide watch 1.0
namespace eval watch {
variable nextHandle 0
variable activeIDs
array set activeIDs {}
}
proc watch::FSChange {obj intv script {lastMTime ""} {handle 0}} {
variable nextHandle
variable activeIDs
# Att: obj, intv and script are not fully checked by us yet
catch {file mtime $obj} nowMTime
if [string eq $lastMTime ""] {
# new call, no recursion
incr nextHandle; # caution: no reuse yet, simply increment each time
set handle $nextHandle
set lastMTime $nowMTime
} elseif {$nowMTime != $lastMTime} {
if {[uplevel info procs [lindex $script 0]] != ""} {
catch {uplevel $script $obj};# append objectname to callback proc
} else {
catch {uplevel [string map [list %O $obj] $script]}
}
set lastMTime $nowMTime
}
set activeIDs($handle) \
[after $intv [list watch::FSChange $obj $intv $script $lastMTime $handle]]
return $handle
}
proc watch::Cancel {handle} {
variable activeIDs
set script ""
catch {
set script [lrange [join [after info $activeIDs($handle)]] 1 end-3]
after cancel $activeIDs($handle)
unset activeIDs($handle)
}
return $script
}
#==============================================================================