#
# Debugging trace functions adapted from set by Marcel Koelewijn
#

proc gen_log:init {} {
  global cvscfg
  global cvsglb
  global tcl_platform
  
  toplevel .trace
  wm protocol .trace WM_DELETE_WINDOW { .trace.close invoke }
  if {[info exists cvscfg(tracgeom)]} {
    wm geometry .trace $cvscfg(tracgeom)
  }
  
  # Define the colors right away
  set logcolor(C) navy
  set logcolor(E) maroon
  set logcolor(S) darkgreen
  set logcolor(T) goldenrod4
  set logcolor(D) red
  set logcolor(F) black
  
  # White background so the colored text shows up
  text .trace.text -setgrid yes -relief sunken -borderwidth 2 \
      -background white \
      -insertwidth 0 -exportselection 1 \
      -yscrollcommand ".trace.scroll set"
  ttk::scrollbar .trace.scroll -command ".trace.text yview"
  frame .trace.bottom
  
  button .trace.bottom.clear -text "Clear" \
      -command gen_log:clear
  button .trace.bottom.save -text "Save to File" \
      -command gen_log:save
  
  # Classic Tk color so the colored text shows up
  frame .trace.top -background #d9d9d9
  # Old-style checkbuttons so we can control the color
  checkbutton .trace.top.c -text "commands (C)" \
      -variable logclass(C) -onvalue "C" -offvalue "" \
      -highlightthickness 0 -background #d9d9d9 -selectcolor #d9d9d9 \
      -foreground $logcolor(C) -command gen_log:changeclass
  checkbutton .trace.top.e -text "stderr (E)" \
      -variable logclass(E) -onvalue "E" -offvalue "" \
      -highlightthickness 0 -background #d9d9d9 -selectcolor #d9d9d9 \
      -foreground $logcolor(E) -command gen_log:changeclass
  checkbutton .trace.top.t -text "Function entry/exit (T)" \
      -variable logclass(T) -onvalue "T" -offvalue "" \
      -highlightthickness 0 -background #d9d9d9 -selectcolor #d9d9d9 \
      -foreground $logcolor(T) -command gen_log:changeclass
  checkbutton .trace.top.d -text "Debugging (D)" \
      -variable logclass(D) -onvalue "D" -offvalue "" \
      -highlightthickness 0 -background #d9d9d9 -selectcolor #d9d9d9 \
      -foreground $logcolor(D) -command gen_log:changeclass
  checkbutton .trace.top.s -text "stdout (S)" \
      -variable logclass(S) -onvalue "S" -offvalue "" \
      -highlightthickness 0 -background #d9d9d9 -selectcolor #d9d9d9 \
      -foreground $logcolor(S) -command gen_log:changeclass
  checkbutton .trace.top.f -text "files (F)" \
      -variable logclass(F) -onvalue "F" -offvalue "" \
      -highlightthickness 0 -background #d9d9d9 -selectcolor #d9d9d9 \
      -foreground $logcolor(F) -command gen_log:changeclass
  
  search_textwidget_init
  button .trace.bottom.srchbtn -text Search \
      -command "search_textwidget .trace.text"
  entry .trace.bottom.entry -width 20 -textvariable cvsglb(searchstr)
  bind .trace.bottom.entry <Return> \
      "search_textwidget .trace.text"
  
  button .trace.close -text "Stop Tracing" \
      -command { gen_log:quit; exit_cleanup 0 }
  
  pack .trace.top -side top -fill x
  foreach logtype {c e s t d f} {
    pack .trace.top.$logtype -side left -anchor w
  }
  
  pack .trace.bottom -side bottom -fill x
  pack .trace.scroll -side right -fill y
  pack .trace.text -fill both -expand 1
  
  pack .trace.bottom.srchbtn -side left
  pack .trace.bottom.entry -side left
  pack .trace.bottom.clear -side left -expand 1 -anchor c
  pack .trace.bottom.save -side left
  pack .trace.close -in .trace.bottom -side right
  
  #.trace.text configure -background gray92
  .trace.text tag configure tagC -foreground $logcolor(C) \
     -selectbackground $logcolor(C) -selectforeground white
  .trace.text tag configure tagE -foreground $logcolor(E) \
     -selectbackground $logcolor(E) -selectforeground white
  .trace.text tag configure tagT -foreground $logcolor(T) \
     -selectbackground $logcolor(T) -selectforeground white
  .trace.text tag configure tagD -foreground $logcolor(D) \
     -selectbackground $logcolor(D) -selectforeground white
  .trace.text tag configure tagS -foreground $logcolor(S) \
     -selectbackground $logcolor(S) -selectforeground white
  .trace.text tag configure tagF -foreground $logcolor(F) \
     -selectbackground $logcolor(F) -selectforeground white
  
  # Disable key presses and make a popup for mouse Copy
  ro_textbindings .trace.text
  
  # Focus in the text widget to activate the text bindings
  focus .trace.text
  
  wm title .trace "TkRev Trace"
  if { [tk windowingsystem] eq "x11" } {
    wm iconphoto .trace Trace
  }
}

proc gen_log:log { class string } {
  global cvscfg
  
  # check class+level first, if no logging required, skip
  if {$cvscfg(logging) && [string match "*\[$class\]*" $cvscfg(log_classes)]} {
    set callerlevel [expr {[info level] - 1}]
    if { $callerlevel == 0 } {
      # called from the toplevel
      set callerid "toplevel"
    } else {
      set callerid [lindex [info level $callerlevel] 0]
    }
    # Uncomment this to see the trace on stdout
    #puts "$class ($callerid) $string"
    .trace.text insert end [format "\[%s] %s\n" $callerid "$string"] tag$class
    set overflow [expr {[.trace.text index end] - $cvscfg(trace_savelines)}]
    if { $overflow > 10 } {
      .trace.text delete 0.0 $overflow
    }
    .trace.text yview end
  }
}

proc gen_log:quit { } {
  global cvscfg
  
  set cvscfg(logging) false
  if {[winfo exists .trace]} {
    set cvscfg(tracgeom) [wm geometry .trace]
    destroy .trace
  }
}

proc gen_log:clear { } {
  .trace.text delete 1.0 end
}

proc gen_log:save { } {
  global tcl_version

  set initialfile "tkrev_log.txt"
  
  set types  {{ "Text Files" {*.txt *.log}} {"All Files" {*}} }
  set savfile [ \
      tk_getSaveFile -title "Save Trace" \
      -filetypes $types \
      -initialfile $initialfile \
      -parent .trace
  ]
  if {$savfile == ""} {
    return
  }
  
  if {[catch {set fo [open $savfile w]}]} {
    puts "Cannot open $savfile for writing"
    return
  }
  if {$tcl_version >= 9.0} {chan configure $fo -profile tcl8}
  puts $fo [.trace.text get 1.0 end]
  close $fo
}

proc gen_log:changeclass { } {
  global cvscfg
  global logclass
  
  set cvscfg(log_classes) ""
  foreach c [array names logclass] {
    append cvscfg(log_classes) $logclass($c)
  }
}

# This is for the startup messages that detect desktop colors
proc gen_log:color {array} {
  foreach line $array {
    set callerid "startup"
    if { [string match {CoLoR_*} $line] } {
      # color detected
      regsub {^CoLoR_} $line {} line
      set colorstr [lindex $line end]
      if {[string length $colorstr] < 3} { continue }
      set linebegin [lrange $line 0 end-1]
      catch {.trace.text tag configure tag$colorstr -background $colorstr}
      .trace.text tag configure tag$colorstr -foreground [colors:contrast $colorstr]
      .trace.text insert end [format "\[%s] %s" $callerid "$linebegin"] tagF
      .trace.text insert end " $colorstr\n" tag$colorstr
    } elseif { [string match {FoNt_*} $line] } {
      regsub {^FoNt_} $line {} line
      # font detected
      set ourlabel [lindex $line 0]
      set lineremainder [lrange $line 1 end]
      set fonttype $lineremainder
      set ret [catch {set actualfont [font actual $fonttype -displayof .trace.text]} out]
      if {$ret} {
         .trace.text insert end "$line\n" tagF
         gen_log:log E "$out"
         continue
      }
      .trace.text tag configure tag$ourlabel -font "$actualfont" \
         -background white -foreground black
      .trace.text insert end "\[$callerid\] $ourlabel $fonttype" tagF
      .trace.text insert end " ($actualfont)\n" tag$ourlabel
    } else {
      # nothing special about this line
      .trace.text insert end [format "\[%s] %s" $callerid "$line\n"] tagF
    }
  }
}

