#!/usr/bin/wish -f
#
# ddt: Dosemu debugging tool for X11.
#
# Copyright (C) 1995 by Pasi Eronen.
#
# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 2 of the License, or (at your option)
# any later version.
#
# Version 0.1 (1995-08-19): initial coding.
#
set version "0.1 (1995-08-19)"

# Choose fonts. If the first alternative doesn't exist, use the second
set titleFonts {titleFont {-*-lucida-medium-r-normal-*-*-240*} \
  {-*-times-medium-r-normal-*-*-240*}}
set xtermFonts {xtermFont "lucidasanstypewriter-14" "9x15"}
set dialogFont "-*-helvetica-medium-r-normal--*-140*"
set buttonFont "-*-helvetica-medium-r-normal--*-140*"
label .test
foreach x [list $titleFonts $xtermFonts] {
  if {[catch ".test config -font [lindex $x 1]"]} {
    set [lindex $x 0] [lindex $x 2]
  } else {
    set [lindex $x 0] [lindex $x 1]
  }
}
destroy .test
#set bgColor bisque1
set bgColor lightgray
. config -bg $bgColor

# Create main window
label .title -text "DDT" -font $titleFont -bg $bgColor
pack .title -side left -padx 15
frame .buttons -bg $bgColor
pack .buttons -side left -padx 2 
button .buttons.dosemu -width 15 -font $buttonFont -bg $bgColor
button .buttons.options -text "Options..." -command {options} -width 15 \
  -font $buttonFont -bg $bgColor
button .buttons.about -text "About..." -command {about} -width 15 \
  -font $buttonFont -bg $bgColor
button .buttons.quit -text Quit -command quit -width 15 -font $buttonFont\
  -bg $bgColor
pack .buttons.dosemu .buttons.options .buttons.about .buttons.quit \
  -side left -padx 2
bind . <Control-c> {destroy .}
bind . q {quit}

# This allows you to place DDT on another virtual desktop (at least with fvwm)
while {[string compare [wm state .] "normal"]} {
  update
}
wm withdraw .
wm geometry . "+0+0"
wm title . "dosemu debugging tool"
wm deiconify .

# Start output window
set dosPid 0
set logPid 0
set fifoFilename "/tmp/.ddt-fifo"
set pidFilename "/tmp/.ddt-pid"
catch "exec rm -f $fifoFilename"
catch "exec mkfifo -m 0600 $fifoFilename"
catch "exec rm -rf $pidFilename"
exec xterm -fn $xtermFont -geometry 80x10+0-0 -sl 2000 -si -sk \
  -title "dosemu output" -e ddt-output ddt-output $fifoFilename $pidFilename &

set commandLine ""
set regexp ""


proc isRunning {pid} {
  return [expr [catch "exec ps $pid"]?0:1]
}

proc kill {pid} {
  catch "exec kill $pid"
}

proc sendLogCommand {command} {
  global logPid fifoFilename
  if {[isRunning $logPid]} {
    catch "exec echo __DDT__:$command >> $fifoFilename"
  }
}

proc startDosemu {} {
  global dosPid commandLine fifoFilename
  set dosPid [exec xdos -o $fifoFilename $commandLine >>& $fifoFilename &]
}

proc killDosemu {} {
  global dosPid
  kill $dosPid
  set dosPid 0
}


proc options {} {
  global commandLine regexp dialogFont buttonFont bgColor
  catch {destroy .options}
  toplevel .options -bg $bgColor
  wm geometry .options "+200+200"
  wm title .options "debugging options"
  
  frame .options.empty1 -bg $bgColor
  pack .options.empty1 -side top -fill both -pady 5
  frame .options.buttons -bg $bgColor
  pack .options.buttons -side bottom -fill both 
  frame .options.empty2 -bg $bgColor
  pack .options.empty2 -side bottom -fill both -pady 5

  frame .options.frame1 -bg $bgColor
  pack .options.frame1 -side top -fill both -padx 10 -pady 2
  label .options.frame1.msg -text "Command line" -font $dialogFont \
    -width 20 -anchor w -bg $bgColor
  pack .options.frame1.msg -side left 
  entry .options.frame1.entry -relief sunken -font $dialogFont \
    -width 30 -bg $bgColor
  .options.frame1.entry insert 0 $commandLine
  pack .options.frame1.entry -side right -fill x
  bind .options.frame1.entry <Return> "focus .options.frame2.entry"
  bind .options.frame1.entry <Any-Tab> "focus .options.frame2.entry"
  bind .options.frame1.entry <Escape> {destroy .options}
  
  frame .options.frame2 -bg $bgColor
  pack .options.frame2 -side top -fill both -padx 10 -pady 2
  label .options.frame2.msg -text "Filter regexp" -font $dialogFont \
    -width 20 -anchor w -bg $bgColor
  pack .options.frame2.msg -side left
  entry .options.frame2.entry -relief sunken -font $dialogFont\
    -width 30 -bg $bgColor
  .options.frame2.entry insert 0 $regexp
  pack .options.frame2.entry -side right -fill x
  bind .options.frame2.entry <Return> {.options.buttons.ok activate;\
   .options.buttons.ok invoke}
  bind .options.frame2.entry <Any-Tab> "focus .options.frame1.entry"
  bind .options.frame2.entry <Escape> {destroy .options}
  
  focus .options.frame1.entry

  button .options.buttons.ok -text OK -font $buttonFont -bg $bgColor \
    -command {set commandLine [.options.frame1.entry get]; \
    set regexp [.options.frame2.entry get]; \
    sendLogCommand [format "r:%s" $regexp]; \
    destroy .options}
  button .options.buttons.cancel -text Cancel -font $buttonFont -bg $bgColor \
    -command {destroy .options}
  pack .options.buttons.ok .options.buttons.cancel -side left -expand yes \
    -fill both
}


proc about {} {
  global dialogFont buttonFont titleFont bgColor version
  catch {destroy .about}
  toplevel .about -bg $bgColor
  wm geometry .about "+200+200"
  wm title .about "about dosemu debugging tool"
  frame .about.empty1 -bg $bgColor
  pack .about.empty1 -side top -fill both -pady 5
  label .about.text1 -font $titleFont -text "DDT -- Dosemu Debugging Tool" \
    -bg $bgColor
  pack .about.text1 -side top -fill both -padx 20
  label .about.text2 -font $dialogFont -text "Copyright (C) 1995 Pasi Eronen."\
    -bg $bgColor
  pack .about.text2 -side top -fill both -pady 0
  label .about.text3 -font $dialogFont -text "Version $version" -bg $bgColor
  pack .about.text3 -side top -fill both -pady 0
  message .about.text4 -font $dialogFont -bg $bgColor -aspect 500 -text {This\
program is free software; you can redistribute it and/or modify\
it under the terms of the GNU General Public License as published by\
the Free Software Foundation; either version 2 of the License, or\
(at your option) any later version.}
  pack .about.text4 -side top -fill both -pady 5
  frame .about.buttons -bg $bgColor
  pack .about.buttons -side bottom -fill both 
  frame .about.empty2 -bg $bgColor
  pack .about.empty2 -side bottom -fill both -pady 5
  
  button .about.buttons.ok -text OK -font $buttonFont -bg $bgColor -command \
    {destroy .about}
  pack .about.buttons.ok -side left -expand yes -fill both
}


proc quit {} {
  global logPid dosPid fifoFilename
  sendLogCommand "q"
  kill $dosPid
  catch "exec rm -f $fifoFilename"
  destroy .
}


proc idle {} {
  global dosPid logPid pidFilename
  after 500 idle
  if ([expr $logPid == 0]) {
    catch "exec cat $pidFilename" output
    if {[expr [scan $output "pid=%d" tmp] == 1]} {
      set logPid $tmp
      catch "exec rm -f $pidFilename"
    }
  }
  if {[isRunning $dosPid]} {
    .buttons.dosemu config -text "Kill dosemu" -command killDosemu
  } else {
    .buttons.dosemu config -text "Start dosemu" -command startDosemu
  }
}

idle
