#!/afs/ece/usr/tcl/bin/wish -f
# The next line is executed by most shells, but not Tcl \
wish $0 $*


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

# Help text.
set Help "" ; append Help {Lispth -- Add keybindings for standard Lisp function/comment management.

This program teaches text widgets about Lisp functions and comments. It is
assumed that the widget will contain Lisp or Scheme code.

} $TH_Bindings_Help {

Widgets of Lispth
} $TH_Frame_Help {

The heuristic for finding a function's boundaries are: A function begins with
defun (or define in Scheme), at the beginning of a line (including the open
paren), and ends with the corresponding close paren

The width used for comment formatting is the width of the text widget, which
may not necessarily be the actual window size.}


# Gives app all the code necessary to do our functions.
proc teach_code {} {
  global Widget App Class
  if {$Class != "Text"} {return ""}
  include_files {lisp.tcl th_defun_begin} \
	{modes.tcl th_Text_tag_regions} \
	{edit.Text.tcl th_Text_indent} \
	{edit.Misc.tcl th_indent} \
	{browse.Text.tcl th_Text_select_range} \
	{paren.Text.tcl th_Text_left_exp}

  do_cmd_set TH(Paint,Hook,$Widget) "th_Text_tag_regions $Widget FUNCTION th_defun_begin th_defun_end th_defun_next \$start \$end"
  do_cmd "$Widget tag configure FUNCTION -background MidnightBlue\n" 0
  do_cmd "th_Misc_paint_add $Widget STRING [list {"[^"]*"}] {} -foreground yellow\n" 0
  do_cmd "th_Misc_paint_add $Widget STRING [list {'(.|\\.|\\[0-9]*)'}] {} -foreground yellow\n" 0
  do_cmd "th_Misc_paint_add $Widget ATOM [list {'[A-Za-z\*0-9_-]*}] {} -foreground orange\n" 0
  do_cmd "th_Misc_paint_add $Widget KEYWORD [list {[^A-Za-z0-9](if|else|when|unless|cond|do|dotimes|dolist)[^A-Za-z0-9]}] [list {[A-Za-z0-9_]+}] -foreground red\n" 0
  do_cmd "th_Misc_paint_add $Widget INCLUDE [list {\((require|load) .*\)}] {} -foreground cyan\n" 0
  do_cmd "th_Misc_paint_add $Widget COMMENT [list {;.*}] {} -foreground wheat\n" 0
  do_cmd "$Widget tag raise sel\n" 0
}

# For a widget, returns the appropriate bindings. (They will depend on the
# widget)
proc widget_bindings {} {
  global Bindings Class
  if {$Class != "Text"} {return ""}
  return [widget_frame_bindings $Bindings(Lisp)]
}
