# tkterm.tcl

# Functions to tell about this program
#
proc AboutMessage {} {
  catch {destroy .about}
  toplevel .about
  wm title .about "About TkTerm"
  wm iconname .about "AboutTkTerm"
  label .about.title -text {TkTerm}\
    -font -adobe-times-bold-i-normal--24-240-75-75-p-128-iso8859-1
  pack .about.title -side top -pady 15
  message .about.subtitle -width 10c -justify center \
    -font -adobe-times-bold-i-normal-*-14-140-75-75-p-77-iso8859-1 \
    -text "A VT100 terminal emulator based\non the Tcl/Tk Text widget"
  pack .about.subtitle -side top -pady 10 -padx 15
  message .about.msg -width 10c -text "
By D. Richard Hipp
Hipp, Wyrick & Company, Inc.
6200 Maple Cove Lane
Charlotte, NC 28269
704-948-4565
drh@vnet.net" \
    -font -adobe-times-medium-r-normal-*-12-120-75-75-p-64-iso8859-1
  pack .about.msg -padx 15 -anchor w
  button .about.dismiss -text {Dismiss} -command {destroy .about}
  pack .about.dismiss -pady 8
  wm withdraw .about
  update idletasks
  set x [expr [winfo rootx .] + ([winfo width .]-[winfo reqwidth .about])/2]
  set y [expr [winfo rooty .] + ([winfo height .]-[winfo reqheight .about])/2]
  wm geometry .about +$x+$y
  wm deiconify .about
}

# The function key editor
#
proc EditFunctionKeys {} {
  catch {destroy .keyedit}
  toplevel .keyedit
  wm title .keyedit "TkTerm Function Key Bindings"
  wm iconname .keyedit "TkTerm Bindings"
  set f [frame .keyedit.f1 -bd 1 -relief raised]
  pack $f -side bottom -fill x -expand 1
  button $f.b1 -text OK -highlightthickness 0 -command {
    foreach i $MacroNames {
      set Macros($i) [.keyedit.f2.f.e$i.e get]
    }
    SaveMacros
    destroy .keyedit
  }
  button $f.b2 -text Cancel -highlightthickness 0 -command {destroy .keyedit}
  pack $f.b1 $f.b2 -side right -pady 5 -padx 10 -expand 1
  set f [frame .keyedit.f2 -bd 1 -relief raised]
  pack $f -side bottom -fill both -expand 1
  global Macros MacroNames
  CheckMacros
  set f [frame $f.f]
  pack $f -padx 10 -pady 10
  foreach i $MacroNames {
    set e [frame $f.e$i]
    pack $e -side top -fill x -anchor c
    label $e.l -text $i -width 3 -anchor w
    pack $e.l -side left
    entry $e.e -width 30 -bd 2 -relief sunken
    $e.e insert end $Macros($i)
    pack $e.e -side left
    bind $e.e <Return> {tkEntryInsert %W %A}
    bind $e.e <Tab> {tkEntryInsert %W %A; break}
  }
  wm withdraw .keyedit
  update idletasks
  set x [expr [winfo rootx .] + ([winfo width .]-[winfo reqwidth .keyedit])/2]
  set y [expr [winfo rooty .] + ([winfo height .]-[winfo reqheight .keyedit])/2]
  wm geometry .keyedit +$x+$y
  wm deiconify .keyedit
}

##### The following routines are responsible for loading function
# key macros from the .tkterm.macros file, or writing them back.
#
proc LoadMacros {} {
  global Macros MacroNames MacroFile MacroModTime
  if [info exists Macros] {unset Macros}
  if {[file readable $MacroFile]} {
    foreach i [exec cat $MacroFile] {
      set tag [lindex $i 0]
      set value [lindex $i 1]
      if {[regexp {F1?[0-9]} $tag]} {
        set Macros($tag) $value
      }
    }
    set MacroModTime [file mtime $MacroFile]
  }
  foreach i $MacroNames {
    if {![info exists Macros($i)]} {set Macros($i) $i}
  }
}
proc SaveMacros {} {
  global Macros MacroNames MacroFile
  set out {}
  foreach i $MacroNames {
    lappend out [list $i $Macros($i)]
  }
  catch {exec echo $out >$MacroFile 2>/dev/null}
}
proc CheckMacros {} {
  global MacroModTime MacroFile
  if {[file readable $MacroFile] && [file mtime $MacroFile]>$MacroModTime} {
    LoadMacros
  }
}



# Change the width of the text widget
proc ChangeWidth {newWidth} {
  .term config -width $newWidth
  WindowSizeChangeNotify
}
# Change the height of the text widget
proc ChangeHeight {newHeight} {
  .term config -height $newHeight
  WindowSizeChangeNotify
}
# Change the font of the text widget
proc ChangeFont {newFont} {
  global F FB
  .term config -font $F($newFont)
  if {[info exists FB($newFont)]} {
    .term tag config bd -font $FB($newFont) -foreground Black
  } else {
    .term tag config bd -font $F($newFont) -foreground Blue
  }
}

proc RetrieveSelection {offset max} {
  global Selection
  return [string range $Selection $offset [expr {$offset+$max}]]
}

# This routine is called whenever "." owns the selection but another
# window claims ownership.
#
proc LoseSelection {} {
  global Selection
  set Selection {}
}

# Copy the text selected in the text widget into the Selection variable,
# then claim ownership of the selection.
#
proc EditCopy {} {
  global Selection
  catch {
    set Selection [.term get sel.first sel.last]
    selection own . LoseSelection
  }
}

########
# The following is for debugging use only.
#
proc Dump {} {
  global Btm CurX CurY ScrollTop ScrollBtm

  return "iBtm=$Btm iCur=$CurY.$CurX iScroll=$ScrollTop-$ScrollBtm end=[.term index end] insert=[.term index insert]"
}
#
# Creating of tkterm Window
proc CreateTermWin {} {
  global params gparams
  global cmd_dir cmd_name
  global Width Height Font
  global F

#  toplevel .term
#  update idletasks
#  wm title .term Terminal
#  wm iconname .term Terminal
#  set x [winfo rootx .]
#  set y [winfo rooty .]
#  set x [expr $x+[winfo width .]+10]
#  wm geometry .term +${x}+${y}

#  set MacroNames {F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 F11 F12}
#  set MacroFile [glob ~]/.tkterm.macros
#  set MacroModTime 0

  # Construct the menu bar
  #
#  frame .term.menubar -bd 2 -relief raised
#  pack .term.menubar -side top -fill x

#  menubutton .term.menubar.file -text File -menu .term.menubar.file.m
#  pack .term.menubar.file -side left -padx 10
#  menu .term.menubar.file.m
#    .term.menubar.file.m add command -label {New} \
#        -command "Paste \"$cmd_dir/$cmd_name &\n\""
#    .term.menubar.file.m add separator
#    .term.menubar.file.m add command -label {Exit} -command {destroy .}

#  menubutton .term.menubar.edit -text Edit -menu .term.menubar.edit.m
#  pack .term.menubar.edit -side left -padx 10
#  menu .term.menubar.edit.m
#    .term.menubar.edit.m add command -label {Copy} \
#       -command EditCopy
#    .term.menubar.edit.m add command -label {Paste} \
#       -command {Paste [selection get]}

#  menubutton .term.menubar.options -text Options -menu .term.menubar.options.m
#  pack .term.menubar.options -side left -padx 10
#  menu .term.menubar.options.m
#    .term.menubar.options.m add cascade -label {Font Size} \
#      -menu .term.menubar.options.m.fontsize
#    menu .term.menubar.options.m.fontsize
#    foreach i {Tiny Small Short Normal Large {Very Large} Huge} {
#      .term.menubar.options.m.fontsize add radiobutton -label $i \
#         -value $i -variable Font -command "ChangeFont \"$i\""
#    }
#
#  menubutton .term.menubar.help -text Help -menu .term.menubar.help.menu
#  pack .term.menubar.help -side left -padx 5
#  menu .term.menubar.help.menu
#    .term.menubar.help.menu add command -label {About This Program} \
#       -command AboutMessage
  ####
  # Default window settings
  #
  set Width 80
  set Height 25
  set Font Normal

  ######
  # These are all the valid fonts.  FB(x) is the bold font which
  # corresponds to F(x).  If there is no FB(x), then no bold text
  # will be shown.
  #
  set F(Tiny) -schumacher-clean-medium-r-normal-*-6-60-75-75-c-40-iso8859-1
  set F(Small) -schumacher-clean-medium-r-normal-*-8-80-75-75-c-50-iso8859-1
  set F(Short) -schumacher-clean-medium-r-normal-*-10-100-75-75-c-60-iso8859-1
  set FB(Short) -schumacher-clean-bold-r-normal-*-10-100-75-75-c-60-iso8859-1
  set F(Normal) -misc-fixed-medium-r-semicondensed-*-13-120-75-75-c-60-iso8859-1
  set FB(Normal) -misc-fixed-bold-r-semicondensed-*-13-120-75-75-c-60-iso8859-1
  set F(Large) -misc-fixed-medium-r-normal-*-14-130-75-75-c-70-iso8859-1
  set FB(Large) -misc-fixed-bold-r-normal-*-14-130-75-75-c-70-iso8859-1
  set F(Very\ Large) -misc-fixed-medium-r-normal-*-15-140-75-75-c-90-iso8859-1
  set FB(Very\ Large) -misc-fixed-bold-r-normal-*-15-140-75-75-c-90-iso8859-1
  set F(Huge) -misc-fixed-medium-r-normal-*-20-200-75-75-c-100-iso8859-1

  ##### Construct the text widget with its scrollbar
  #
#  text .term -bd 1 -relief raised -yscrollcommand {.term.sb set} \
#    -height 24 -width 80 -exportselection 1 \
#    -wrap none -padx 2 -pady 2 \
#    -font $F($Font) -highlightthickness 0
#  pack .term -side left -fill both -expand 1
#  scrollbar .term.sb -command {.term yview} -orient vertical \
#    -highlightthickness 0 -bd 1 -relief raised
#  pack .term.sb -side left -fill y

  catch {
    .term config -font \
      [list $gparams(font) $gparams(fontsize) $gparams(fontstyle)]
  }
  .term tag config ul -underline 1
  .term tag config iv -foreground [.term cget -background]
  .term tag config iv -background [.term cget -foreground]
  if {[info exists FB($Font)]} {
    .term tag config bd -font $FB($Font)
  } else {
    .term tag config bd -font $F($Font)
  }
  
#  bindtags .term [list .term Text]
  bindtags .term {.term}
  bind .term <Alt-F5> {set params(log_end) end}
#  bind .term <Up> {.term yview scroll -1 pages}
#  bind .term <Down> {.term yview scroll +1 pages}
  bind .term <Prior> {.term yview scroll -1 units}
  bind .term <Next> {.term yview scroll +1 units}
  bind .term <Home> {.term yview moveto 0}
  bind .term <End> {.term yview moveto 1}

 # A routine for dispensing the selection.  The selection is always owned
  # by the window ".".  Its value is stored in the variable "Selection"
  #
#  set Selection {}
#  selection handle .term RetrieveSelection
}
########

proc TermBind {} {
  bind .term <KeyPress> {SendToTTY %N}
  bind .term <Control-KeyPress> {SendToTTY [expr %N&0x1f]}
  bind .term <Control-space> {SendZeroToTTY}
  bind .term <Return> {SendToTTY 10}
  bind .term <Escape> {SendToTTY 033}
  bind .term <BackSpace> {SendToTTY 8}
  bind .term <Delete> {SendToTTY 0177}
  bind .term <Up> {SendToTTY 033;SendToTTY 91;SendToTTY 65}
  bind .term <Down> {SendToTTY 033;SendToTTY 91;SendToTTY 66}
#  bind .term <Down> {SendToTTY 1}

  # Button bindings copied from the default Text widget bindings
  #
#  foreach b {
#    1 Double-1 Triple-1 Shift-1 Double-Shift-1
#    Triple-Shift-1 B1-Leave B1-Enter ButtonRelease-1 Control-1
#  } {
#    bind .term <$b> [bind Text <$b>]
#    bind .term <$b> {+.term mark set insert $CurY.$CurX}
#  }
#  bind .term <1> {
#    tkTextButton1 %W %x %y
#    %W tag remove sel 0.0 end
#  }
#  bind .term <B1-Motion> {
#    set tkPriv(x) %x
#    set tkPriv(y) %y
#    tkTextSelectTo %W %x %y
#  }
}

proc TermUnbind {} {
  bind .term <KeyPress> {}
  bind .term <Control-KeyPress> {}
  bind .term <Control-space> {}
  bind .term <Return> {}
  bind .term <Escape> {}
  bind .term <BackSpace> {}
  bind .term <Delete> {}
}

#proc focusLog {} {
#  global gparams
#
#  set old_focus [focus]
#  if {$gparams(showout)} {
#   raise .term 
#  } else {
#    wm deiconify .term
#    set gparams(showout) 1
#  }
#  xfocus .term
#  tkwait variable params(log_end)
#  puts stderr "FocusLog end"
#  xfocus $old_focus
#}

#proc catfile {file} {
#  global params
#  
#  set old_focus [focus]
#  if {$params(ShowOut)} {
#   raise .term 
#  } else {
#    wm deiconify .t
#  }
#  .term mark set insert end
#  .term insert insert \n
#  set pos [.term index insert]
#  .term insert insert \
#  "--- $file -------------------------------------\n"
#  if {[catch {set fd [open $file r]} msg]} {
#    OutMsg $msg
#    return
#  }
#  while {![eof $fd]} {
#    if {[gets $fd s] != -1} {
#      .term insert insert $s\n
#    }
#  }
#  .term insert insert "---End-of-file---Press-Q-to-Quit---\n"
#  close $fd
#  set params(log_end) ""
#  .term mark set insert $pos
#  .term yview insert
#  xfocus .term 
#  bind .term <Down> {
#    %W mark set insert "insert + 1 l"
#    %W yview -pickplace insert
#  }
#  bind .term <Up> {
#    %W mark set insert "insert - 1 l"
#    %W yview -pickplace insert
#  }
#  bind .term <Next> {
#    %W mark set insert "insert + 15 l"
#    %W yview -pickplace insert
#  }
#  bind .term <Prior> {
#    %W mark set insert "insert - 15 l"
#    %W yview -pickplace insert
#  }
#  bind .term <Any-Key> {
#    switch -regexp -- "%A" {
#      \003 {
#        %W insert insert "\n INT "
#        %W yview -pickplace insert
#        set cmd(end) end
#      }
#      \004 {
#        %W mark set insert end
#        %W insert insert "\n EOF "
#        %W yview -pickplace insert
#        set params(log_end) end
#      }
#      \r {
#        %W mark set insert "insert + 1 lines"
#        %W yview -pickplace insert
#      }
#      [qQ] {
#        %W insert insert "\n QUIT "
#        %W yview -pickplace insert
#        set params(log_end) end
#      }
#    }
#  }
#  tkwait variable params(log_end)
#  bind .term <Any-Key> { }
#  .term mark set insert end
#  xfocus $old_focus
#  update idletasks
#  if {!$params(ShowOut)} {
#    wm withdraw .term
#  }
#}