# $Header: /home/yew/yew5/users/phelps/spine/sb/RCS/sb.tcl,v 1.1 1993/08/30 03:45:01 phelps Exp phelps $

#
# sb - an xless-like front end to demonstrate the searchbox mega widget
#
#   by Tom Phelps (phelps@cs.Berkeley.EDU)
#      August 29, 1993
#
#
# 29-Aug  much code transcribed from TkMan
#         mentioned on comp.lang.tcl, uploaded to harbor
#

source $sbx(lib)/taputils.tcl
source $sbx(lib)/searchbox.tcl


### user customization ###

set sb(scrollbarside) right
# list of (screen name,file name) pairs?
set sb(fontList) {
   "-adobe-new century schoolbook-medium-r-normal--*-100-*"
   "-adobe-new century schoolbook-medium-r-normal--*-120-*"
   "-adobe-new century schoolbook-medium-r-normal--*-140-*"
   "-adobe-courier-medium-r-normal--*-80-*"
   "-adobe-courier-medium-r-normal--*-100-*"
   "-adobe-courier-medium-r-normal--*-120-*"
}
set sb(wrapList) {none char word}
set sb(printList) {lpr enscript}
set sb(text,font) "-adobe-new century schoolbook-medium-r-normal--*-120-*"
set sb(geom) 500x800+300+10
set sb(text,wrap) word
set sb(text,fontcolor) black
set sb(text,margin) 5
set sb(regexp,case) 1
set sb(incr,case) 0
set sbx(uid) 0

if [file exists ~/.sb] {source ~/.sb}


# build gui, bind to searchbox, show file
# see xless for more functions to add
#  help, search, editor, reload, change file, instantiate, print, close


proc sbGUI {{w .sb}} {
   global sb sbx

   if {![winfo exists $w]} {toplevel $w}
   wm minsize $w 100 100
   wm geometry $w $sb(geom)

   # command bar
   frame $w.mb

   label $w.mb.status -text bozo

   button $w.help -text "Help"

   menubutton $w.mb.font -text "Font" -menu $w.mb.font.m
   menu $w.mb.font.m
   foreach i $sb(fontList) {
      $w.mb.font.m add radiobutton -label $i -variable sb(text,font) \
         -command "$w.text configure -font [list $i]"
   }

   menubutton $w.mb.wrap -text "Wrap" -menu $w.mb.wrap.m
   menu $w.mb.wrap.m
   foreach i {none char word} {
      $w.mb.wrap.m add radiobutton -label $i -variable sb(text,wrap) \
         -command "$w.text configure -wrap $i"
   }

#   button $w.inst -text "New View"
#   button $w.reload -text "Reload"
#   button $w.change -text "Change"

   menubutton $w.mb.print -text "Print" -menu $w.mb.print.m
   menu $w.mb.print.m
   foreach i $sb(printList) {
      $w.mb.print.m add command -label $i -command "sbPrint $w $i"
   }

   menubutton $w.mb.options -text "Options" -menu $w.mb.options.m
   menu $w.mb.options.m
   $w.mb.options.m add checkbutton -label "Incremental Search Case Sensitive" \
      -variable sb(incr,case)
   $w.mb.options.m add checkbutton -label "Regexp Search Case Sensitive" \
      -variable sb(regexp,case)

   pack $w.mb.font $w.mb.wrap $w.mb.print $w.mb.options -side left
   pack $w.mb.status -in $w.mb -side left -fill x -expand yes
   tk_menuBar $w.mb $w.mb.font $w.mb.wrap $w.mb.print $w.mb.options
#   pack configure $w.help $w.mb.options -expand no


   # text box

   frame $w.t
   text $w.text -font $sb(text,font) -foreground $sb(text,fontcolor) \
      -relief sunken -borderwidth 2 -padx $sb(text,margin) -pady $sb(text,margin) \
      -yscrollcommand "$w.v set" -exportselection yes -wrap $sb(text,wrap) \
      -height 10 -width 5
   bind $w.text <Meta-KeyPress-q> sbQuit
   $w.text tag configure search \
      -foreground [lindex [$w.text configure -background] 4] \
      -background [lindex [$w.text configure -foreground] 4]
   bind $w.text <Any-KeyPress> "
      searchboxKeyNav \[key_state2mnemon %s\] %K \$sb(incr,case) $w.text $w.v $w.mb.status 0
   "
   scrollbar $w.v -orient vertical -command "$w.text yview"
   pack $w.v -in $w.t -side $sb(scrollbarside) -fill y
   pack $w.text -in $w.t -side $sb(scrollbarside) -fill both -expand yes


   # bottom

   # searching
   frame $w.s
   button $w.search -text "Search" -command "
      if !\[catch {selection get}\] {set sbx(search,string$w) \[selection get\]}
      searchboxSearch \$sbx(search,string$w) 1 \$sb(regexp,case) search $w.text $w.v $w.mb.status $w.cnt
   "
   button $w.next -text "Next" -command "searchboxNext search $w.text $w.v $w.mb.status"

   entry $w.searchpat -relief sunken -textvariable sbx(search,string$w)
   emacsbind $w.searchpat
   bind $w.searchpat <Meta-KeyPress-q> sbQuit
   set sbx(search,oldstring$w) ""
   bind $w.searchpat <KeyPress-Return> "
      selection clear $w.text
      if {\$sbx(search,oldstring$w)!=\$sbx(search,string$w)} {
         set sbx(search,oldstring$w) \$sbx(search,string$w)
         $w.search invoke
      } else {$w.next invoke}"
   label $w.cnt
   button $w.quit -text "Quit" -command sbQuit; # write out new params?

   pack $w.search -in $w.s -side left
   pack $w.next -in $w.s -side left -padx 6
   pack $w.searchpat -in $w.s -side left -fill x -expand yes -ipadx 10 -anchor w
   pack $w.cnt -in $w.s -side left

   # quit
   pack $w.quit -in $w.search -side left -padx 3
   bind all <Meta-KeyPress-q> "$w.quit invoke"
   pack $w.quit -in $w.s -side left


   # pack subregions
#   pack $w.mb.status $w.mb -fill x -pady 4
   pack $w.mb -fill x -pady 4
   pack $w.t -fill both -expand yes
   pack $w.s -fill x -pady 6


   # generous hit regions, tab between
   foreach i {t text v} {bind $w.$i <Enter> "focus $w.text"}
   bind $w.s <Enter> "focus $w.searchpat"
   foreach k {KeyPress-Tab Shift-KeyPress-Tab} {
      bind $w.searchpat <$k> "focus $w.text"
      bind $w.text <$k> "focus $w.searchpat"
   }

   focus $w
   return $w
}


proc sbReadFile {w f} {
   global sb sbx

   if {[catch {set lf [glob $f]}]} {puts stderr "sb: $f doesn't exist"}
   set f [lfirst $lf]; if {![file readable $f]} {puts stderr "sb: $f isn't readable"}
   $w.mb.status configure -text $f

   # open file
   if {$f=="stdin"} {set fid "stdin"} {
      if {[catch {set fid [open $f]}]} {puts stderr "sb: can't read $f"; exit 1}
   }

   # read file
   set cnt 0
   while {![eof $fid]} {
      $w.text insert end [gets $fid]\n
      incr cnt
   }
   close $fid

   # show stats
   switch $cnt {
      0 {set cnttxt "empty"}
      1 {set cnttxt "1 line"}
      default {set cnttxt "$cnt lines"}
   }
   $w.cnt configure -text $cnttxt

   $w.text configure -state disabled
}


proc sbPrint {w cmd} {
   set fid [open "|$cmd" w]
   scan [$w.text index end] "%d" end
   for {set i 1} {$i<$end} {incr i} {
      puts $fid [$w.text get $i.0 "$i.0 lineend"]
   }
   close $fid
}


proc sbQuit {} {
   # maybe save state later
   destroy .
}


# startup

wm withdraw .
if {$tk_version<3.3} {puts stderr "Tcl 7.0/Tk 3.3 required"; exit 1}
bind Text <B1-Motion> {textb1motion %W @%x,%y}
bind Text <ButtonRelease-1> { global test; set text(txnd) 0 }
if [llength $argv]==0 {set f stdin} {set f [lfirst $argv]}
sbReadFile [sbGUI] $f
