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

set Bind_Keyword [file tail [info script]]
source "[file dirname [info script]]/../aux/frame.tcl"

# Help text.
set Help "" ; append Help {Fileth -- Add keybindings to save/load contents of various widgets

This program teaches widgets how to save or load their contents to files or I/O
pipelines

} $TH_Bindings_Help {

Widgets of Fileth

'Monitor Changes to File' checkbutton

Generally, edith's edit commands, and fileth's file commands keep track of
changes made to the widget's contents, and if the contents have been changed
since the last Save or Read command, fileth's code will prompt the user to save
the widget's contents before doing a Read. One can also monitor the file
perodically to see if it changes by means other than fileth's. If this button is
on, then the file will be compared to the widget every time the mouse enters the
widget's window. (Actually the files last-modified-time field will be compared
to the time the file was last saved/read). If this button is off, then no
changes in the file will be noticed.


'Allow Pipe I/O' checkbutton

Tcl's open command can accept command pipelines, as well as files. This is very
powerful, but can cause problems for security if used improperly. If this
checkbutton is left off, then fileth won't allow reading or writing to pipes,
otherwise pipeline I/O is OK.


Show Path and Name checkbuttons

These checkbuttons indicate whether the file's path and name should be displayed
in the frame below the widget associated with the file. (The path for pipelines
is the current directory.) For either checkbutton to be turned on, a label will
be created in the frame that contains the path or name. One can click on the
label and change it's text to a "-". Clicking on it again will bring back the
path or name.

} $TH_Frame_Help {
The canvas postscript command only writes out the canvas currently visible, so a
scrollable canvas bigger than it's view will get clipped.
}


# Gives app all the code necessary to do our functions.
proc teach_code {} {

  if {[widget_bindings] != ""} {
    global TH_Dir Allow_Pipe Show Class App Widget
    set f [teach_frame_code]
    include_files {file.Misc.tcl th_insert_file}
    if {[file exists "$TH_Dir/lib/file.[set Class].tcl"]} {
      include_files [list file.$Class.tcl "th_[set Class]_write_file"]
    }

    do_cmd "set TH(Pipe,Enabled) $Allow_Pipe\n" 0

    if {$Show(path) && ![send $App winfo exists $f.fpl]} {
      do_cmd "label $f.fpl -relief flat -anchor e\npack $f.fpl -side left\n" 0
      do_cmd "bind $f.fpl <Any-Button> \"th_label_expand_toggle $Widget $f.fpl\"\n" 0
    }
    if {$Show(name) && ![send $App winfo exists $f.fnl]} {
      do_cmd "label $f.fnl -relief flat -anchor e\npack $f.fnl -side left\n" 0
      do_cmd "bind $f.fnl <Any-Button> \"th_label_expand_toggle $Widget $f.fnl\"\n" 0
}}}

# For a widget, returns the appropriate bindings. (They will depend on the
# widget)
proc widget_bindings {} {
  global Bindings Allow_Pipe Mtime Class

  if {[lsearch "Entry Text Canvas Listbox" $Class] < 0} {return ""}
  set bindings ""

  set bindings [concat $bindings $Bindings(File,Write)]
  if {[lsearch "Entry Text" $Class] >= 0} {
    set bindings [concat $bindings $Bindings(File,Read)]
  }

  if $Mtime { set bindings [concat $bindings $Bindings(File,Mtime)] }
  if $Allow_Pipe { set bindings [concat $bindings $Bindings(File,Pipe)] }

  return [widget_frame_bindings $bindings]
}


frame .file
pack .file -fill x

checkbutton .file.mtime -text "Monitor Changes to File" \
        -variable Mtime -onvalue 1 -offvalue 0
set Mtime 1
pack .file.mtime -side left -expand yes -fill x

checkbutton .file.pipe -text "Allow Pipe I/O" \
        -variable Allow_Pipe -onvalue 1 -offvalue 0
set Allow_Pipe 0
pack .file.pipe -side left -expand yes -fill x

frame .show
pack .show -fill x

label .show.frame -text "In frame, show"
pack .show.frame -side left

checkbutton .show.labelp -text "Path" \
    -variable Show(path) -onvalue 1 -offvalue 0
pack .show.labelp -side left -expand yes -fill x

checkbutton .show.labelf -text "Name" \
      -variable Show(name) -onvalue 1 -offvalue 0
pack .show.labelf -side left -expand yes -fill x

set Show(path) 0 ; set Show(name) 0


