#!/afs/ece/usr/tcl/bin/wisha -f

# ELS (Editor Left Simple) This program is very simple; it is meant to be
# expanded to Elsbeth, although it functions decently on its own. It can read in
# files or piped commands into text widgets. Besides normal text bindings, M-q
# destroys the window its done on. Lis exits when all windows are destroyed.

# To run this program, you should make sure the top line reflects the location
# of wish on your system.

# Els takes any number of arguments. Args consist of options and configurations
# Each option brings up a separate Els toplevel window. Configs modify all
# subsequent Els windows.


set Els_Help {ELS command-line arguments:
ELS creates one text window for each option:
        0       Create empty window
        X       Fill window with X Selection
        -       Fill window with standard input
        =       Fill window with standard input gradually
        file    Fill window with contents of file
        |cmd    Execute command, load output
        |cmd&   Execute command, load output gradually
ELS takes the following configuration parameters for each option. Any parameter
given before an option applies to that and all future options.
        -w configs      Configure text widget with configs
        -i              Iconify text window
        -t word         Add word to window & icon title
        -c cmd          Execute cmd after set up.
        -a              Run alone, in a new wish interpreter.
        -H              Print help (this text)
}

# Note that an old Els interpreter may have a different pwd than the one you
# invoke a new Els interpreter in. Els will fix pathnames of filenames, but
# pipes could be problematic. You should probably give absolute pathnames when
# opening pipes with a current Els running. Also if you want to give stdin to
# Els, you have to specify the -a option, since the old Els won't have the same
# stdin.


# For arbitrary symbol generation

global Els_Symname Els_Symnum
set Els_Symname "sym"
set Els_Symnum 0

# Returns a new symbol upon each call
proc els_gensym {} {
  global Els_Symname Els_Symnum
  incr Els_Symnum
  return $Els_Symname$Els_Symnum
}


# Procedures for filling the text widget.

# Loads w with contents of TH(File,$w)
# if insert_flag is given, then insert, otherwise load.
# (Similar to file.Misc.tcl's version, but allows for gradual reading, too.)
proc els_load_file {w {insert_flag 0}} {
  global TH
  if {[catch "set TH(Pipe)"]} {set TH(Pipe) 0}

  # Open file or pipe, set graduated to 1 if gradual reading is requested.
  set graduated 0

  if {([set index [string first "|" $TH(File,$w)]] >= 0)} {
    cd [string range $TH(File,$w) 0 [expr $index - 2]]
    set filename [string range $TH(File,$w) $index end]
  } elseif $TH(Pipe) {
    cd [file dirname $TH(File,$w)]
    set filename [file tail $TH(File,$w)]
  } else {  set filename $TH(File,$w)}

  if {([string match \|* $filename]) &&
      ([string match *\& $filename] || $TH(Gradual))} {
    set file [open [string trimright $filename {& }] r]
    set graduated 1
  } else {set file [open $filename r]}

  if {![file writable [string trimright $TH(File,$w) {&}]] &&
	[file exists [string trimright $TH(File,$w) {&}]]} {
    if {[info procs th_flash_label] != ""} {
      th_flash_label $w -text "File is not writable!"
  }}

  if $insert_flag {
    if {![catch "set TH(File,Old,$w)"]} {set TH(File,$w) $TH(File,Old,$w)}
    els_insert_file $w $file $graduated
    set TH(Modified,$w) 1
  } else {
    els_update_window_title [winfo toplevel $w] $TH(File,$w)
    els_read_file $w $file $graduated
    catch {set TH(Mtime,$w) [file mtime $TH(File,$w)]}
    set TH(Modified,$w) 0
    if {[info procs th_kill_undos] != ""} {th_kill_undos $w}
    if {[info procs th_file_update_widgets] != ""} {th_file_update_widgets $w}
    set TH(File,Last,$w) "r"
  }
  close $file
}


# Changes w to contain contents of file descriptor f.
# If grad is set, reads gradually.
proc els_read_file {w f {grad 0}} {
  $w delete 1.0 end
  if $grad { els_busy $w els_gradual_read $w $f [$w index insert]
  } else {$w insert 1.0 [read $f]}
  $w mark set insert 1.0
  $w yview 1.0
}

# Inserts contents of f at insert in w.
proc els_insert_file {w f {grad 0}} {
  $w mark set file_start insert
  set i [$w index insert]

  if $grad { els_busy $w els_gradual_read $w $f [$w index insert]
  } else {  $w insert insert [read $f]}

  if {[info procs th_Text_figure_out_undo_insert] != ""} {
    th_Text_figure_out_undo_insert $w [$w get file_start $i]}
  $w mark set insert $i
  $w yview -pickplace insert
  $w mark unset file_start
}

global Els_Busy ; set Els_Busy 0

# Indicates lis is busy.
proc els_busy {t args} {
  global Els_Busy ; set Els_Busy 1
  set cursor [lindex [$t config -cursor] 4]
  set parent [winfo toplevel $t]
  set title [wm title $parent] ; set iconname [wm iconname $parent]

  # Indicate process is busy
  $t config -cursor watch
  wm iconname $parent "* $iconname" ; wm title $parent "*BUSY* $title"
  update

  set error [catch {uplevel #0 $args} result]

  # Free up program now.
  $t config -cursor $cursor
   wm iconname $parent $iconname ; wm title $parent $title
  update

  set Els_Busy 0
  if $error {  error $result} else {  return $result
}}

# Updates the display iff it is not getting choked with data.
proc els_update_text_display {t} {
  after 100 "if {[$t index insert] == \[$t index insert\]} {
      if {[$t compare insert == new_stuff]} {
        $t yview -pickplace insert}
      update idletasks ; update}"
}

# Reads file a line at a time, and updates t per line.
# Since Tk can only handle events immediately after a line is read, this
# causes many problems, besides being a pain if the command is slow.
proc els_read_file_graduated {t file} {
  set v [lindex [$t configure -height] 4] ; incr v -1
  while {![eof "$file"]} {
    $t insert new_stuff [gets "$file"]
    $t insert new_stuff \n
    els_update_text_display $t
    global Els_Interrupt
    if $Els_Interrupt break
}}

# The 'better' way to handle background file reading.
proc els_addinput_read {t f events} {
  global Els_Interrupt
  set result [gets $f line]
  if {$Els_Interrupt || ($result < 0)} {
          removeinput $f
    global Els_Graduated_Done
    set Els_Graduated_Done 1
    return
  }
  $t insert new_stuff "$line\n"
  els_update_text_display $t
}

# fills text widget t with contents from "$file", which must be opened for
# reading. Does not clear text widget.
proc els_gradual_read {t file index} {
  # Enable user to interrupt with a C-g. or Cancel if TH bindings are loaded.
  global Els_Interrupt;  set Els_Interrupt 0

  if {[info procs th_bind] != ""} {
    set binding [th_bind $t Cancel]
    th_bind $t Cancel "set Els_Interrupt 1 ; th_beep"
  } else {
    set binding [bind $t <Control-g>]
    bind $t <Control-g> "set Els_Interrupt 1 ; "
  }
  $t mark set new_stuff $index
  # Use addinput extension, if possible
  if {[info commands addinput] == ""} {
    els_read_file_graduated $t "$file"
  } else {global Els_Graduated_Done ; set Els_Graduated_Done 0
    addinput "$file" "els_addinput_read $t %F %E"
    tkwait variable Els_Graduated_Done
  }
  $t mark unset new_stuff

  if {[info procs th_bind] != ""} {
    th_bind $t Cancel $binding
  } else {
    bind $t <Control-g> $binding
}}


# Widget creation / destruction routines

proc els_new_text {} {
  set tl ".[els_gensym]"
  toplevel $tl ; wm iconify $tl
  text $tl.t -relief sunken -setgrid true
  pack $tl.t -in $tl -side right -expand yes -fill both
  focus $tl.t

# This is for beth to add things to.
  frame $tl.th_frame
  pack $tl.th_frame -side bottom -fill x -before $tl.t

  return $tl
}

# Destroy toplevel window, exit if all toplevels destroyed.
proc els_destroy_text {t} {
  destroy [winfo parent $t]
  set next_child ""
  foreach child [winfo children .] {
# Ignore any .th windows
    if {[string match ".sym*" $child]} {set next_child $child ; break}}
  if {$next_child == ""} {exit}
  focus "$next_child.t"
}


# Set configs and fork off text windows for each file.

# Reads command line arguments.
proc els_parse_configs {argc argv} {
  if {([lsearch $argv "-a"] < 0) && $argc} {
    set interps [winfo interps]
    set my_name [lindex [winfo name .] 0]
    set interp [lindex $interps [lsearch -glob $interps "[set my_name]*"]]
    if {$interp != [winfo name .]} {
      if {![catch "send $interp info procs els_parse_configs" result]} {
        if {$result != ""} {
          send $interp cd [pwd]
          catch {send $interp els_parse_configs $argc \{$argv\}}
          exit
  }}}}

  if {([lsearch $argv -H] >= 0) || ($argc == 0)} {
    global Els_Help
    puts $Els_Help
  }

  set option_flag 0
  set i 0
  set configs ""
  while {$i < $argc} {
    set item [lindex $argv $i]
    if {[string match {-[twc]} $item]} {
      incr i
      lappend configs $item [lindex $argv $i]
    } elseif {[string match -? $item]} {
      lappend configs $item
    } else {els_process_item $configs $item ; set option_flag 1}
    incr i
  }
  if {!$option_flag} {exit}
}

proc els_process_item {configs option} {
  global Els_Title_Comment
  set Els_Title_Comment "[els_return_option_assocs "-t" $configs] "
  if {$Els_Title_Comment == " "} {set Els_Title_Comment ""}

  set tl [els_process_option $option]
  if {![winfo exists $tl]} {return}

  if {([lsearch $configs -i] < 0)} { wm deiconify $tl }

  eval $tl.t configure [lindex [els_return_option_assocs "-w" $configs] 0]

  set cmd [els_return_option_assocs "-c" $configs]
  if {$cmd != ""} {
    uplevel #0 [lindex $cmd 0]
}}

proc els_update_window_title {tl name} {
  if {([string match /* $name])} {
    set title [file tail $name]
  } else {set title $name}
  global Els_Title_Comment App_Name Els_Busy
  if $Els_Busy {
    wm title $tl "*BUSY* [set Els_Title_Comment][set App_Name]: [set title]"
    wm iconname $tl "* [set Els_Title_Comment][string index $App_Name 0] [set title]"
  } else {
    wm title $tl "[set Els_Title_Comment][set App_Name]: [set title]"
    wm iconname $tl "[set Els_Title_Comment][string index $App_Name 0] [set title]"
  }
}

proc els_return_option_assocs {option list} {
  set result ""
  set append_flag 0
  foreach item $list {
    if $append_flag {set result [lappend result $item]}
    set append_flag 0
    if {$item == $option} {set append_flag 1}
  }
  return $result
}

# Create new text window with option. Return toplevel window.
# Toplevel window also gets titled appropriatly, and sets the File() array.
proc els_process_option {option} {
  global TH
  set tl [els_new_text]
  set TH(Pipe) 0
  set TH(Gradual) 0

  if {($option == "0")} {
    set TH(File,$tl.t) ""
    els_update_window_title $tl 0
  } elseif {($option == "X")} {
    set TH(File,$tl.t) ""
    els_update_window_title $tl X
    if {[catch {$tl.t insert insert "[selection get]"}]} {}
    $tl.t mark set insert 1.0
  } elseif {($option == "-")} {
    set TH(File,$tl.t) ""
    els_update_window_title $tl -
    after 0 els_read_file $tl.t stdin
  } elseif {($option == "=")} {
    set TH(File,$tl.t) ""
    els_update_window_title $tl =
    after 0 els_read_file $tl.t stdin 1
  } else {if {([string match /* $option])} {
      set TH(File,$tl.t) $option
    } else {set TH(File,$tl.t) [pwd]/$option}
    if {(![file exists $TH(File,$tl.t)] || ![file readable $TH(File,$tl.t)]) &&
	![string match "*/|*" $TH(File,$tl.t)]} {
      els_update_window_title $tl [file tail $TH(File,$tl.t)]
      if {[info procs th_flash_label] != ""} {
        th_flash_label $tl.t -text "No File: $TH(File,$tl.t)"
      }
    } else {if {[string match "*&" $TH(File,$tl.t)]} {
         after 1000 els_load_file $tl.t
       } else {els_load_file $tl.t}
  }}

  if {[info procs elsbeth_new_text] != ""} {elsbeth_new_text $tl}
  return $tl
}

proc els_source_local_files {name} {
  global env
  if {[file exists $env(HOME)/.th/$name]} {
    source $env(HOME)/.th/$name
  }
  if {[file exists ".$name"] && ([pwd] != "$env(HOME)/.th")} {
    source ".$name"
}}


# Global stuff
if {[info globals App_Name] == ""} {
  global App_Name
  set App_Name [string toupper [string index [file tail [info script]] 0]]
  append App_Name [string tolower [string range [file tail [info script]] 1 end]]
}

wm withdraw .
if {[info procs elsbeth_new_text] == ""} {
  bind Text <Meta-q> "catch {els_destroy_text %W}"
}
bind Toplevel <Leave> {+set Els_Focus(%W) [focus]}
bind Toplevel <Enter> {+if {[catch {focus $Els_Focus(%W)}] || (![string match "%W*" $Els_Focus(%W)])} {focus %W.t}}
els_source_local_files [string tolower $App_Name]
els_parse_configs $argc $argv


