# copyright (C) 1997-2001 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

set rcsId {$Id: trace.tcl,v 1.5 2001/01/27 15:08:19 jfontain Exp $}


package provide trace [lindex {$Revision: 1.5 $} 1]

namespace eval trace {

    variable nextRow 0
    variable numberOfRows 10                                                                                           ;# by default

    array set data {
        updates 0
        0,label {} 0,type integer 0,message {row creation order}
        1,label date 1,type clock 1,message {date of message occurrence}
        2,label time 2,type clock 2,message {time of message occurrence}
        3,label module 3,type dictionary 3,message {module name} 3,anchor left
        4,label message 4,type ascii 4,message {message from module} 4,anchor left
        switches {-m 1 --modules 1 --rows 1}
        pollTimes -10
        sort {0 decreasing}
    }
   set file [open trace.htm]
   set data(helpText) [read $file]                                                           ;# initialize HTML help data from file
   close $file

    proc initialize {optionsName} {
        upvar $optionsName options
        variable numberOfRows
        variable expression

        catch {set modules $options(-m)}
        catch {set modules $options(--modules)}                                                                 ;# favor long option
        if {[info exists modules]} {          ;# setup regular expression of the form ^(module|module|...)$ to filter on module name
            set expression {^(}
            set first 1
            foreach module [split $modules ,] {
                if {$first} {
                    set first 0
                } else {
                    append expression |
                }
                append expression $module
            }
            append expression {)$}
        }
        catch {set numberOfRows $options(--rows)}
    }

    proc update {module namespace message} {          ;# directly invoked by the core when it receives a trace message from a module
        variable expression
        variable nextRow
        variable data
        variable numberOfRows

        if {[info exists expression]&&![regexp $expression $module]} return                                          ;# filtered out
        set row $nextRow
        incr nextRow
        set data($row,0) $row
        set seconds [clock seconds]
        set data($row,1) [clock format $seconds -format %x]
        set data($row,2) [clock format $seconds -format %X]
        set data($row,3) $namespace
        set data($row,4) $message
        if {$numberOfRows>0} {                                                                         ;# eventually remove old rows
            incr row -$numberOfRows
            catch {unset data($row,0) data($row,1) data($row,2) data($row,3) data($row,4)}
        }
        incr data(updates)
    }

}
