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
 }

 #==============================================================================

----
!!!!!!
%| [Category Package] |%
!!!!!!