proc cvs_usercmd {args} {
  #
  # Run a cvs command from the user menu and view its output.
  # called for cvsmenu() entries.
  #
  global cvs

  gen_log:log T "ENTER ($args)"
  #gen_log:log C "$cvs $args"
  set my_viewer [viewer::new "CVS $args"]
  $my_viewer\::do "$cvs $args"
  gen_log:log T "LEAVE"
}

proc cvs_execcmd {args} {
  #
  # Run any command from the user menu without
  # a viewer to capture its output and without
  # the ability to abort it.
  # called for execmenu() entries.
  #
  gen_log:log T "ENTER ($args)"
  gen_log:log C "$args"
  eval "exec $args &"
  gen_log:log T "LEAVE"
}

proc cvs_catchcmd {args} {
  #
  # Run any command from the user menu and view its output.
  # You can abort it too.
  # called for usermenu() entries.
  #
  gen_log:log T "ENTER ($args)"
  #gen_log:log C "$args"
  set my_viewer [viewer::new "$args"]
  $my_viewer\::do "$args"
  gen_log:log T "LEAVE"
}

namespace eval ::exec {
  variable instance 0

  proc new {command {viewer {}} {show_stderr {1}} {filter {}}} {
    variable instance
    set my_idx $instance
    incr instance

    gen_log:log T "ENTER (\"$command\" \"$show_stderr\" \"$filter\")"

    namespace eval $my_idx {
      set my_idx [uplevel {concat $my_idx}]
      variable command [uplevel {concat $command}]
      variable viewer [uplevel {concat $viewer}]
      variable filter [uplevel {concat $filter}]
      variable show_stderr [uplevel {concat $show_stderr}]

      global cvscfg
      global errorCode

      variable data {}
      variable errmsg {}
      variable procout ""
      variable procerr ""
      variable errpos 0
      variable ExecDone 0
      variable v_w

      if {$viewer != ""} {
        set v_w [namespace inscope $viewer {set w}]
      }

      proc out_handler {{viewer {}} {filter {}}} {
        variable procout
        variable procerr
        variable ExecDone
        variable errmsg
        variable data
        variable v_w
        global errorCode
      
        # Blocking read -- returns -1 on EOF.  Then you get the process return
        # from errorCode
        if {[gets $procout line] < 0} {
          # [close] blocks until child process completes
          if {[catch {close $procout} res]} {
            gen_log:log E "  Close Failed - errorCode $errorCode"
            set ExecDone [list 1 $res $errorCode]
            gen_log:log E "  ExecDone $ExecDone"
            if {$errmsg == ""} { set errmsg $res }
            # Since we don't pop up an error dialog, let's at least try to show
            # what happened in the viewer window, if there is one
            if {$viewer != ""} {
               $v_w.text insert end "$res\n" stderr
               if {[tell $procerr]} {
                 seek $procerr 0
                 while {[gets $procerr erline] != -1} {
                   $v_w.text insert end "$erline\n" stderr
                 }
               }
             }
          } else {
            gen_log:log D "  Close OK"
            set ExecDone [list 0]
            gen_log:log D "  ExecDone $ExecDone"
          }
          return
        }

        if {$filter != ""} {
          set filtered_line [$filter [namespace current] $line]
          set texttag [lindex $filtered_line 0]
          set line [lindex $filtered_line 1]
        }
        append data "$line\n"
        if {$viewer != ""} {
          if {$filter != ""} {
            if {$texttag != "noshow"} {
              $v_w.text insert end "$line\n" $texttag
            }
          } else {
            $v_w.text insert end "$line\n"
          }
          $v_w.text yview end
        }
        gen_log:log D "STDOUT:  $line"
      }

      proc err_handler {} {
        variable errpos
        variable procerr
        variable errmsg
        variable viewer
        variable filter
        variable show_stderr
        variable v_w

        #SRIV this is the key to no cpu usage!
        fileevent $procerr readable {}

        # When new stuff appears in the error output file, get it.  There may
        # be more than one line.
        set errmsg ""
        if {[tell $procerr] != $errpos} {
          seek $procerr $errpos start
          while {[gets $procerr erline] != -1} {
            append errmsg "$erline"
            set errpos [tell $procerr]
          }
          gen_log:log E "$errmsg"
          if {$viewer != "" && $show_stderr == 1} {
            $v_w.text insert end "$errmsg\n" stderr
          }
        }
        
        #SRIV this is the key to no cpu usage!
        #after 1 [list catch {fileevent $procerr readable [namespace current]::err_handler}]
        catch {fileevent $procerr readable [namespace current]::err_handler}
      }

      proc abort {} {
        variable procout
        variable procerr
        variable procid
        variable ExecDone
	global tcl_platform

        gen_log:log T "ENTER"
#puts "aborting [namespace current]"
        # This does the trick but it wont work on windows
        if {![info exists procid]} {
          gen_log:log D "procid is not defined"
#puts "procid is not defined"
          return
        }
        catch "exec kill $procid" kres
        unset procid
#puts "$kres"
        catch {close $procout} cres
#puts "$cres"
        catch {close $procerr} cres
#puts "$cres"
        gen_log:log D "$kres"

        gen_log:log T "LEAVE"
      }

      proc wait {} {
        variable ExecDone
        variable procid
        variable my_idx
        gen_log:log T "ENTER"

#puts "wait: [namespace current]"
        if {!$ExecDone} {
#puts " waiting for [namespace current]::ExecDone"
          vwait [namespace current]::ExecDone
          set prev [expr $my_idx - 1]
          if {[info exists ::exec::$prev\::procid]} {
#puts "Aborting previous exec"
            ::exec::$prev\::abort
          }
#puts "end wait [namespace current]::ExecDone\n"
        }
        gen_log:log T "LEAVE"
      }

      proc output {} {
        variable data
        variable ExecDone

        gen_log:log T "ENTER"
        if {!$ExecDone} {
          [namespace current]::wait
        }
        gen_log:log T "LEAVE"
        return $data
      }

      proc run_exec {} {
        global cvscfg
        variable my_idx
        variable procout
        variable procerr
        variable procid
        variable errmsg
        variable ExecDone
        variable command
        variable viewer
        variable filter
        variable v_w
        variable w

        fconfigure stderr -blocking false -buffering line
        fconfigure stdout -blocking false -buffering line
  
        # Set up the file we send the proc's stderr to
        set errordir [file join $cvscfg(tmpdir) "cvstmpdir.[pid]"]
        file mkdir $errordir
        set errorfile [file join $errordir "exec$my_idx"]
        set procerr [open $errorfile w+]
  

        # Here's where we do it
        gen_log:log C "$command"
#puts " [namespace current] run_exec $command"
        set procout [open "| $command 2>@$procerr" r]
        set procid [pid $procout]
        # Dont ever do this.  The whole thing depends on procout blocking
        #fconfigure $procout -blocking false -buffering line

        fileevent $procout readable [list [namespace current]::out_handler $viewer $filter]
        flush $procerr
        fileevent $procerr readable [list [namespace current]::err_handler]
  
        vwait [namespace current]::ExecDone

        set status $ExecDone
#puts " finished [namespace current]"
        # If you get two execs going at once, the first one does not come
        # out if its wait and you hang forever.  This is the only way I
        # could come up with to keep from hanging all the time.
        set prev [expr $my_idx - 1]
        if {[info exists ::exec::$prev\::procid]} {
#puts "Aborting previous exec"
          ::exec::$prev\::abort
        }
        gen_log:log D "Finish vwait"

        # set buffering back to normal
        fconfigure stdout -blocking true -buffering line
        catch {fileevent $procerr readable {} }
    
        if {$viewer != {}} {
          set v_w [namespace inscope $viewer {set w}]
          pack forget $v_w.stop
          pack $v_w.close -in $v_w.bottom -side right -ipadx 15
          $v_w.close configure -state normal
        }
        update
        if {$ExecDone != 0} {
          bell
          #if {$errmsg == ""} {set errmsg "$command exited status $status"}
          #cvsfail $errmsg
        }
        namespace delete [namespace current]
      }

      after 0 [list [namespace current]::run_exec]

      return [namespace current]
    }
  }
}

namespace eval ::viewer {
  variable instance 0
  #
  # Set up a dialog containing a text box to view
  # the report of the command during execution.
  #
  proc new {title} {
    variable instance
    set my_idx $instance
    incr instance

    namespace eval $my_idx {
      global cvscfg
      variable my_idx [uplevel {concat $my_idx}]
      variable title [uplevel {concat $title}]
      variable w ".view$my_idx"
      variable log {}
      variable searchstr {}
      variable searchidx 1.0
      variable v_e

      viewer_window $w $title [namespace current]

      proc do { command {show_stderr {1}} {filter {}} } {
        global cvscfg
        variable w
        variable v_e

        gen_log:log T "ENTER (\"$command\" \"$show_stderr\" \"$filter\")"

        pack forget $w.close
        pack $w.stop -in $w.bottom -side right -ipadx 15

        # Send the command to the execution module
        set v_e [::exec::new $command [namespace current] $show_stderr $filter]

        gen_log:log T "LEAVE"
      }

      proc abort {} {
        variable v_e
        namespace inscope $v_e abort
      }

      proc wait {} {
        variable v_e
        namespace inscope $v_e wait
      }

      # Call this proc to write arbitrary text to the viewer
      proc log { text {texttag {}} } {
        variable w
        $w.text insert end $text $texttag 
        $w.text yview end
      }

      proc search {} {
        variable searchidx
        variable w

        set str [$w.bottom.entry get]
        set match [$w.text search -- $str $searchidx]
        if {[string length $match] > 0} {
          set length [string length $str]
          $w.text mark set insert $match
          $w.text tag add sel $match "$match + ${length}c"
          $w.text see $match
          set searchidx "$match + ${length}c"
        }
      }

      #update
      return [namespace current]
    }
  }
}

# Filters output lines from CVS
# returns the name of the tag to use when printing
# the line in the text widget
# This filter doesn't need its exec argument, but filters
# must have it because some do need it
proc status_colortags {exec line} {
  global cvscfg

  gen_log:log T "ENTER ($exec \"$line\")"

  set tag default
  # Return the type of the line being output
  # Neat trick I found on clt: -> is a valid variable name!
  if {[regexp {^([PUARMC?]) (.*)} $line -> mode file]} {
    switch -exact -- $mode {
      U { set tag updated }
      A { set tag added }
      R { set tag removed }
      M { set tag modified }
      C { set tag conflict }
      P { set tag patched }
      ? { set tag [expr {$cvscfg(status_filter) ? {noshow} : {unknown}}] }
      default { set tag default }
    }
  } elseif {[regexp {^cvs server: warning: .*} $line]} {
    set tag warning
  }
  gen_log:log T "LEAVE: ($tag \"$line\")"
  return [list $tag $line]
}

proc patch_colortags {exec line} {
  global cvscfg

  gen_log:log T "ENTER ($exec \"$line\")"

  # Return the type of the line being output
  if {[regexp { is new; } $line]} {
      set tag added
  } elseif {[regexp { changed from } $line]} {
      set tag modified
  } elseif {[regexp { is removed; } $line]} {
      set tag removed
  }
  return [list $tag $line]
}

proc parse_version {exec line} {
  if {[string match "Concurrent*" $line]} {
    set version [lindex [split $line] 4]
    return [list tagged $version]
  }
  return [list {} {}]
}

# This is a plain viewer that prints whatever text is sent to it
namespace eval ::view_output {
  variable instance 0

  proc new {title text_to_display} {
    variable instance
    set my_idx $instance
    incr instance

    gen_log:log T "ENTER ($title <text suppressed>)"
    namespace eval $my_idx {
      global cvscfg
      variable my_idx [uplevel {concat $my_idx}]
      variable title [uplevel {concat $title}]
      variable text_to_display [uplevel {list $text_to_display}]
      variable w ".output$my_idx"
      variable searchstr {}
      variable searchidx 1.0

      viewer_window $w $title [namespace current]

      foreach line $text_to_display {
        $w.text insert end "$line"
      }

      proc search {} {
        variable searchidx
        variable w

        set str [$w.bottom.entry get]
        set match [$w.text search -- $str $searchidx]
        if {[string length $match] > 0} {
          set length [string length $str]
          $w.text mark set insert $match
          $w.text tag add sel $match "$match + ${length}c"
          $w.text see $match
          set searchidx "$match + ${length}c"
        }
      }

    }
  }
}

proc viewer_window {w title parent} {
  global cvscfg
  global tcl_platform

  toplevel $w
  if {$tcl_platform(platform) != "windows"} {
    wm iconbitmap $w @$cvscfg(bitmapdir)/cvs-says.xbm
  }
  wm protocol $w WM_DELETE_WINDOW "$w.close invoke"

  text $w.text -setgrid yes -relief sunken -border 2 \
      -exportselection 1 \
      -yscroll "$w.scroll set"
  bind $w.text <KeyPress> {
    switch -- %K {
      "Up" -
      "Left" -
      "Right" -
      "Down" -
      "Next" -
      "Prior" -
      "Home" -
      "End" {}
      "c" -
      "C" {
          if {(%s & 0x04) == 0} {
            break
          }
        }
      default {
          break
        }
    }
  }
  bind $w.text <<Paste>> {break}
  bind $w.text <<Cut>> {break}

  # Configure the various tags
  foreach outputcolor [array names cvscfg outputColor,*] {
    regsub {^.*,} $outputcolor {} mode
    $w.text tag configure "$mode" -foreground $cvscfg($outputcolor)
  }

  scrollbar $w.scroll -relief sunken -command "$w.text yview"
  frame $w.bottom
  button $w.bottom.srchbtn -text Search -command "$parent\::search"
  
  entry $w.bottom.entry -width 20 -textvariable searchstr
  bind $w.bottom.entry <Return> "$parent\::search"
  button $w.close -text "Close" -command "
    namespace delete $parent
    destroy $w
    exit_cleanup 0
  "
  button $w.stop -text "Stop" -bg red4 -fg white \
      -state [expr {$cvscfg(allow_abort) ? {normal} : {disabled}}] \
      -command "$parent\::abort"
  pack $w.bottom -side bottom -fill x ;#-padx 25
  pack $w.scroll -side right -fill y
  pack $w.text -fill both -expand 1
  pack $w.bottom.srchbtn -side left
  pack $w.bottom.entry -side left
  pack $w.close -in $w.bottom -side right -ipadx 15

  # Focus to activate text bindings
  focus $w
  wm title $w "$title"
}
