#
# A simple multi-window X11 "terminal" emulator, based on the TK
# text widget.
#
# It must run using extended TCL, with the addinput/readpending patches
#
# Dave Clemans, June 1993
# dave_clemans@mentorg.com
#

#
# Establish a basic runtime environment, get our utilities, etc.
#
set tkt_library [file dirname [info script]]
source $tkt_library/utils.tk

# Stuff for accessing tke, so we can subinvoke it from the terminal emulator
set tke_library $tkt_library

#
# Set our version numbers
#
set tktVersion 0.2

#
# Basic parameters
#
set tktDefaultShell "/bin/ksh"
set tktShell $tktDefaultShell
set tktSessionCounter 0
set tktMiscWinNumber 0
set tktFindCtypeCmd 0
if {[info commands findctype] != ""} {
   set tktFindCtypeCmd 1
}

#
# Subroutines
#
source $tkt_library/ansiterm.tk
source $tkt_library/tkfs.tk
set tktStartoffCmd "$tkt_library/$tkutVco/startoff"

#
# Be able to subinvoke our editor
#
source $tkt_library/tkedit.tk

if {"$env(DISPLAY)" == "" || "$env(DISPLAY)" == ":0" || "$env(DISPLAY)" == ":0.0"} {
   set env(DISPLAY) $tkutLocalSystem:0
}

#
# Local parameterization, such as it is
#
set tktLocalFile "$tkt_library/tktlocal.tk"
if {[file readable $tktLocalFile]} {
   source $tktLocalFile
}

#
# A null routine, for null bindings
#
proc tktNULL {} {
}

#
# Minimal copy/paste support
#
proc tktSelCopy {w} {
    set rc [catch {set str [selection get]}]
    if {$rc == 0} {
        tkutKillRingPush "$str"
    }
}

proc tktPasteTop {fd} {
    set str [tkutKillRingGet]
    catch {puts -nonewline $fd "$str"}
}

#
# Catch a keypress and send it down the given channel to the slave process
#
proc tktKeyToShell {fd char} {
   if {"$char" == "\r"} {
      catch {puts -nonewline $fd "\n"}
   } else {
      catch {puts -nonewline $fd "$char"}
   }
}

#
# Handle output coming back from the slave process, displaying
# it on our window
# Note: this code is extremely performance critical!
#
proc tktShellToWindow {w fd} {
   global tktFindCtypeCmd
   set chars ""
   set chars [readpending $fd]
   if {"$chars" == ""} {
      destroy [winfo toplevel $w]
      tkutDelMainWindow
      removeinput $fd
      return
   }
   if {[eof $fd]} {
      destroy [winfo toplevel $w]
      tkutDelMainWindow
      removeinput $fd
      return
   }
   set ctrlpos 0
   set plen 0
   for {set len [string length "$chars"]} {$len > 0} {} {
      if {$tktFindCtypeCmd == 0} {
         set bsppos [string first "\b" "$chars"]
         set retpos [string first "\r" "$chars"]
         set tcappos [string first "\035" "$chars"]
         set ctrlpos -1
         if {$bsppos != -1} {
            if {$ctrlpos == -1 || $ctrlpos > $bsppos} {
               set ctrlpos $bsppos
            }
         }
         if {$retpos != -1} {
            if {$ctrlpos == -1 || $ctrlpos > $retpos} {
               set ctrlpos $retpos
            }
         }
         if {$tcappos != -1} {
            if {$ctrlpos == -1 || $ctrlpos > $tcappos} {
               set ctrlpos $tcappos
            }
         }
      } else {
         set ctrlpos [findctype cntrl "$chars"]
      }
      if {[$w compare $w.ic >= end] && $ctrlpos != 0} {
         if {$ctrlpos < 0} {
            $w insert $w.ic "$chars"
            set chars ""
            set plen $len
            set len 0
         } else {
            set plen $ctrlpos
            $w insert $w.ic [string range "$chars" 0 [expr "$ctrlpos - 1"]]
            set chars [string range "$chars" $ctrlpos end]
            set len [expr "$len - $ctrlpos"]
         }
         if {$plen > 160} {
            update idletasks
         }
         $w mark set $w.ic end
         $w mark set insert end
         continue
      }
      set c [string index "$chars" 0]
      set chars [string range "$chars" 1 end]
      incr len -1
      if {"$c" == "\n"} {
         $w insert end "\n"
         $w mark set $w.ic end
         $w mark set insert end
         continue
      }
      if {"$c" == "\b"} {
         $w mark set $w.ic $w.ic-1c
         $w mark set insert $w.ic
         continue
      }
      if {"$c" == "\r"} {
         if {$len > 0} {
            set c [string index "$chars" 0]
            if {"$c" == "\n"} {
               continue
            }
         }
         $w mark set $w.ic "$w.ic linestart"
         $w mark set insert $w.ic
         continue
      }
      if {"$c" == "\035"} {
         set nw [tktEmulatorSession $w "$chars" $fd]
         removeinput $fd
         addinput $fd "tktShellToEmulator $nw %F"
         break
      }
      if {"$c" == "\033"} {
         while {$len > 0 && [ctype alpha "$c"] == 0} {
            set chars [string range "$chars" 1 end]
            incr len -1
            set c [string index "$chars" 0]
         }
         if {$len > 0} {
            set chars [string range "$chars" 1 end]
            incr len -1
         }
         continue
      }
      $w delete $w.ic
      $w insert $w.ic "$c"
      $w mark set insert $w.ic
   }
   $w yview -pickplace end
   update idletasks
}

#
# Treat the current selection as the name of a file, and try to open
# an editor window on that file
#
proc tktEditSelected {} {
    set rc [catch {set str [selection get]}]
    if {$rc == 0 && "$str" != ""} {
      tkeEditFile dummy "$str"
    }
}

#
# Build the menubar for a new terminal session window
#
proc tktBuildMenuBar {w menu fd} {
   global tktVersion
   global tkutTclVersion
   global tkutTclXVersion
   global tkutTkVersion
   global tkutSaveBackFiles
   global tkutKillRingSize
   global tktShell
   global tkutWindowRows
   global tkutWindowCols
   global tkutSearchString

   set wp [winfo toplevel $w]

   menubutton $menu.file -text "File" -menu $menu.file.m
   menu $menu.file.m
   $menu.file.m add command -label "About TKT" -command \
      "tkutDialogBox \"TKT: A Multi-Window X11-based Shell Wrapper Version $tktVersion\nrunning on Tcl $tkutTclVersion / TclX $tkutTclXVersion / TK $tkutTkVersion\nDave Clemans, June 1993\""
   $menu.file.m add separator
   $menu.file.m add command -label "New Shell Window" \
      -command {set w [tktSession $tktShell];wm geometry $w ${tkutWindowCols}x${tkutWindowRows}}
   $menu.file.m add separator
   $menu.file.m add command -label "Save Transcript..." \
      -command "tkutFileReq $w \"Save Transcript As\" tkutSave"
   $menu.file.m add command -label "Save Selection..." \
      -command "tkutFileReq $w \"Save Selection As\" tkutSelSave"
   $menu.file.m add separator
   $menu.file.m add command -label "Quit" -command \
      "destroy $wp;tkutDelMainWindow;return"

   menubutton $menu.edit -text "Edit" -menu $menu.edit.m
   menu $menu.edit.m
   $menu.edit.m add command -label "Copy Selection" -command "tktSelCopy $w"
   $menu.edit.m add command -label "Paste" -command "tktPasteTop $fd"
   $menu.edit.m add separator
   $menu.edit.m add command -label "Show Kill Ring" -command "tkutShowKillRing"
   $menu.edit.m add separator
   $menu.edit.m add command -label "Goto Transcript Top" \
      -command "$w mark set $w.pc \[$w index {0.0 linestart}\];$w yview -pickplace $w.pc"
   $menu.edit.m add command -label "Goto Transcript Bottom" \
      -command "$w mark set $w.pc \[$w index {end linestart}\];$w yview -pickplace $w.pc"
   $menu.edit.m add separator
   $menu.edit.m add command -label "Edit Selected" \
      -command "tktEditSelected"

   menubutton $menu.search -text "Search" -menu $menu.search.m
   menu $menu.search.m
   $menu.search.m add command -label "Regexp Search For..." -command "tkutSearchFor $w \"Search For\" tkutSearchForNext tkutRegexpMatch"
   $menu.search.m add command -label "Regexp Search Again" \
      -command "tkutSearchForNext $w \$tkutSearchString search tkutRegexpMatch"
   $menu.search.m add command -label "String Search For..." -command "tkutSearchFor $w \"Search For\" tkutSearchForNext tkutStringMatch"
   $menu.search.m add command -label "String Search Again" \
      -command "tkutSearchForNext $w \$tkutSearchString search tkutStringMatch"
   $menu.search.m add separator
   $menu.search.m add command -label "Regexp Find All..." -command "tkutSearchFor $w \"Find All\" tkutSearchForAll tkutRegexpMatch"
   $menu.search.m add command -label "String Find All..." -command "tkutSearchFor $w \"Find All\" tkutSearchForAll tkutStringMatch"
   $menu.search.m add separator
   $menu.search.m add command -label "Clear Search Highlights" -command "tkutSearchClear $w"

   menubutton $menu.options -text "Options" -menu $menu.options.m
   menu $menu.options.m
   $menu.options.m add check -label "Create .bak Files" \
      -variable tkutSaveBackFiles
   $menu.options.m add separator
   $menu.options.m add command -label "Kill Ring Size" \
      -accelerator "$tkutKillRingSize" \
      -command "tkutGetNumber $menu.options.m \"Kill Ring Size\" tkutKillRingSize"
   $menu.options.m add command -label "Default Height" \
      -accelerator "$tkutWindowRows" \
      -command "tkutGetNumber $menu.options.m \"Default Height\" tkutWindowRows"
   $menu.options.m add command -label "Default Width" \
      -accelerator "$tkutWindowCols" \
      -command "tkutGetNumber $menu.options.m \"Default Width\" tkutWindowCols"

   #
   # layout the pieces of the menubar
   #
   pack append $menu $menu.file left
   pack append $menu $menu.edit left
   pack append $menu $menu.search left
   pack append $menu $menu.options left

   #
   # Call the user menubar hook, if present
   #
   if {[info procs tktUserMenuHook] != ""} {
      tktUserMenuHook $menu
   }
}

#
# Set the mouse bindings for a terminal window
#
proc tktMouseBindings {w fd} {
   $w mark set $w.sc 1.0
   $w mark set anchor 1.0
   bind $w <1> {
      set tk_priv(selectMode) char
      %W mark set %W.sc @%x,%y
      %W mark set anchor %W.sc
      if {[lindex [%W config -state] 4] == "normal"} {focus %W}
   }
   bind $w <Double-1> {
      set tk_priv(selectMode) word
      %W mark set %W.sc "@%x,%y wordstart"
      tk_textSelectTo %W %W.sc
   }
   bind $w <Triple-1> {
      set tk_priv(selectMode) line
      %W mark set %W.sc "@%x,%y linestart"
      tk_textSelectTo %W %W.sc
   }
   bind $w <B1-Motion> {tk_textSelectTo %W @%x,%y}
   bind $w <Shift-1> {
      tk_textResetAnchor %W @%x,%y
      tk_textSelectTo %W @%x,%y
   }
   bind $w <Shift-B1-Motion> {tk_textSelectTo %W @%x,%y}
   bind $w <2> "tktSelCopy $w;tktPasteTop $fd"
   bind $w <B2-Motion> {tktNULL}
   bind $w <3> {%W scan mark %y}
   bind $w <B3-Motion> {%W scan dragto %y}
}

#
# Start a new terminal session
#
proc tktSession {shell} {
   global tkutWindowRows
   global tkutWindowCols
   global tktStartoffCmd
   global tkutVco
   global tktSessionCounter
   global tkutLocalSystem
   global tkt_library
   global tktWindowPtys

   #
   # Figure out what pseudo-tty to use and connect the
   # input side of our window to it
   # NOTE: this is system specific
   #
   set masterTerm ""
   set slaveTerm ""
   set masterFd ""
   case $tkutVco in {
      {sss} {
         foreach i {0 1 2 3 4 5 6 7 8 9 a b c d e f} {
            set masterFd ""
            set slaveTerm /dev/ttyp$i
            set masterTerm /dev/ptyp$i
            catch {set masterFd [open $masterTerm r+]}
            if {"$masterFd" == ""} {
               continue
            }
            break
         }
      }
      {hpu} {
         foreach s {p q r s t u v} {
            foreach i {0 1 2 3 4 5 6 7 8 9 a b c d e f} {
               set masterFd ""
               set slaveTerm /dev/pty/tty$s$i
               set masterTerm /dev/ptym/pty$s$i
               catch {set masterFd [open $masterTerm r+]}
               if {"$masterFd" == ""} {
                  continue
               }
               break
            }
            if {"$masterFd" != ""} {
               break
            }
         }
      }
      {m} {
         foreach i {0 1 2 3 4 5 6 7 8 9 a b c d e f} {
            set masterFd ""
            set slaveTerm /dev/ttyp$i
            set masterTerm /dev/ptyp$i
            catch {set masterFd [open $masterTerm r+]}
            if {"$masterFd" == ""} {
               continue
            }
            break
         }
      }
      default {
         puts stdout "Unknown pty system type"
      }
   }
   if {[string compare "$masterFd" ""] == 0} {
      puts stdout "Cannot open pseudo-tty"
      exit
   }
   fcntl $masterFd CLOEXEC 1
   fcntl $masterFd NOBUF 1
   fcntl $masterFd NONBLOCK 1

   set name .tkt$tktSessionCounter
   incr tktSessionCounter

   #
   # first create a toplevel text widget window, with a scroll bar
   #
   toplevel $name -class Text
   text $name.text -relief raised -bd 2 -yscrollcommand "$name.scroll set" \
      -setgrid true
   scrollbar $name.scroll -relief flat -command "$name.text yview"
   $name.text mark set $name.text.ic 0.0
   bind $name <Any-Enter> "focus $name.text"
   wm protocol $name WM_DELETE_WINDOW "destroy $name;tkutDelMainWindow;return"

   #
   # give the window a menubar
   #
   frame $name.menu -relief raised -borderwidth 1
   tktBuildMenuBar $name.text $name.menu $masterFd

   #
   # layout the pieces of the window
   #
   pack append $name $name.menu {top fillx}
   pack append $name $name.scroll {right filly} $name.text {expand fill}

   #
   # Send input down the pseudo-tty
   #
   bind $name.text <Any-KeyPress> "tktKeyToShell $masterFd \"%A\""
   tktMouseBindings $name.text $masterFd
   
   #
   # Give the window a title
   #
   set title [file tail $shell]
   wm iconname $name "$title"
   append title " @ $tkutLocalSystem:$slaveTerm"
   wm title $name "$title"

   #
   # Fork off the child process (shell)
   #
   set childPid 0
   flush stdout
   flush stderr
   if {[set childPid [fork]] == 0} {
      execl $tktStartoffCmd "$tkutWindowCols $tkutWindowRows $slaveTerm $tkt_library $shell"
   }
   if {"$childPid" < 0} {
      puts stdout "Cannot fork shell $shell"
      exit
   }
   
   addinput $masterFd "tktShellToWindow $name.text %F"

   focus $name.text
   tkutSearchInit $name.text
   $name.text mark set $name.text.ic end
   tkutNewMainWindow
   set tktWindowPtys($name) $slaveTerm
   return $name
}

wm withdraw .
tkutKillRingInit

if {"$tkutTclXVersion" == ""} {
   puts stderr "tkt: Error: TclX not present. It is needed to run tkt."
   exit 1
}

set tktWindowPtys(0) ""
set tktConsole ""
set tktShell $tktDefaultShell
set tktGeometry ${tkutWindowCols}x${tkutWindowRows}
if {[info globals geometry] != ""} {
   if {"$geometry" != ""} {
      set tktGeometry $geometry
      scan $tktGeometry %dx%d tkutWindowCols tkutWindowRows
   }
}
for {set ai 0} {$ai < $argc} {incr ai} {
   set av [lindex $argv $ai]
   case "$av" in {
      -g* {
         incr ai
         set tktGeometry [lindex $argv $ai]
         scan $tktGeometry %dx%d tkutWindowCols tkutWindowRows
      }
      -C {
         set tktConsole "console"
      }
      default {
         set tktShell $av
      }
   }
}
set tktFirstWindow [tktSession $tktShell]
wm geometry $tktFirstWindow $tktGeometry
if {"$tkutVco" == "sss" && "$tktConsole" == "console"} {
   set result ""
   set rc [catch {set result [exec $tkt_library/sss/sunConsole $tktWindowPtys($tktFirstWindow)]}]
   if {"$result" == "System console changed."} {
      set title [wm title $tktFirstWindow]
      append title " (CONSOLE)"
      wm title $tktFirstWindow $title
   }
}

tkutWaitForNoWindows
exit 0
