# $Id: help.tcl,v 1.5 1998/10/01 19:53:32 cthulhu Exp $

#
# UTILS
#

proc FixHelpMsg {varName index op} {
    global helpMessage auxHelpMessage activeSheet auxWarnMessage
    
    if {$auxWarnMessage != -1} {
	.$activeSheet.fr.header.entry.help_msg configure -fg red
    } else {
	.$activeSheet.fr.header.entry.help_msg configure -fg blue
    }
    set helpMessage $auxHelpMessage
}
 
proc HelpMessage {msg {warning -1} {wait -1}} {
    source "[xxl_library]/globalvars.tcl"
    
    if {$msg==""} {
	set helpMessage Ready
    } else {
	set helpMessage $msg
    }
    if {$warning!=-1} {
	.$activeSheet.fr.header.entry.help_msg configure -fg red
    } else {
	.$activeSheet.fr.header.entry.help_msg configure -fg blue
    }
    if {$wait!=-1} {
	set auxHelpMessage $helpMessage
	set auxWarnMessage $warning
	trace variable helpMessage rwu FixHelpMsg
	after 2000 {trace vdelete helpMessage rwu FixHelpMsg}
    }
}

proc spec2font {{family "times"} {style "normal"} {points "medium"} {size "m"}} {
    global help
    
    set dpi $help(dpi)
    switch -exact -- $style {
	normal {set style "medium-r"}
	bold {set style "bold-r"}
	italics {
	    if [regexp -nocase $help(xmono) $family] {set style "medium-o"} {set style "medium-i"}
	}
	bold-italics {
	    if [regexp -nocase $help(xmono) $family] {set style "bold-o"} {set style "bold-i"}
	}
	default {puts stderr "nonexistent style: $style"; exit 1}
    }
    
    if {[set pts [lsearch $help(sizes) $points]]!=-1} {
	set p "[lindex [lrange $help(pts) $pts end] [lsearch {s m l} $size]]"
    } else {set p $points}
    append p "0"
    
    set font "-*-$family-$style-normal-*-*-$p-$dpi-$dpi-*"
    
    return $font
}

proc winstdout {w msg {color blue}} {
    if {![winfo exists $w]} return
    $w configure -fg $color -text $msg
    return [$w cget -text]
}

proc winstderr {w msg} {
    winstdout $w $msg red
    return
}

proc cursorBusy {{up 1}} {
	if {[. cget -cursor]!="watch"} {
		cursorSet watch
	}
}
proc cursorSet {c {w .}} {
	global cursor
	set cursor($w) [$w cget -cursor]
	$w configure -cursor $c
	foreach child [winfo children $w] {cursorSet $c $child}
}
proc cursorUnset {{w .}} {
	global cursor
	catch {$w configure -cursor $cursor($w)}
	foreach child [winfo children $w] {cursorUnset $child}
}

proc lfirst {l} {return [lindex $l 0]}

proc tabgroup {args} {
        if [llength $args]==1 {set wins [lindex $args 0]} {set wins $args}

        set l [llength $wins]
        for {set i 0} {$i<$l} {incr i} {
                set w [lindex $wins $i]
                set pw [lindex $wins [expr ($i-1)%$l]]
                set nw [lindex $wins [expr ($i+1)%$l]]

                bind $w <KeyPress-Tab> "focus $nw; break"
                bind $w <Shift-KeyPress-Tab> "focus $pw; break"
        }
}

#
# Search box functions
#

proc searchboxNext {tag t {wmsg ""} {yoff ""}} {
    global searchbox
    
    if {[$t tag ranges $tag]==""} { winstderr $wmsg "No matches!"; return }
    
    if {$yoff==""} {set yoff [winfo height $t]}
    set hit [$t tag nextrange $tag [$t index @0,$yoff]]
    if {$hit==""} {
	if {$searchbox(ratend$t)} {
	    winstdout $wmsg ""
	    set hit [$t tag nextrange $tag 1.0]
	    set searchbox(ratend$t) 0
	} else {
	    winstderr $wmsg "No more matches; try again to wrap around"
	    set searchbox(ratend$t) 1
	}
    }
    if {$hit!=""} {
	$t see [lindex $hit 0]
    }
}

proc searchboxPrev {tag t {wmsg ""}} {
    global searchbox 
    
    if {[$t tag ranges $tag]==""} { winstderr $wmsg "No matches!"; return }
    
    set hit [$t tag prevrange $tag [$t index @0,0]]
    if {$hit==""} {
	if {$searchbox(ratstart$t)} {
	    winstdout $wmsg ""
	    set hit [$t tag prevrange $tag end]
	    set searchbox(ratstart$t) 0
	} else {
	    winstderr $wmsg "No more matches; try again to wrap around"
	    set searchbox(ratstart$t) 1
	}
    }
    
    if {$hit!=""} {
	$t see [lindex $hit 0]
    }
}

proc searchboxSearch {pat regexp casesen tag t {wmsg ""} {wcnt ""}} {
    global searchbox help
    
    if {$casesen==-1} {set casesen [expr {[string tolower $pat]!=$pat}]}
    set caseopt [expr !$casesen?"-nocase":""]
    if {$regexp} {set type "regexp"} {set type "exact"}
    
    if {$pat==""} {
	winstderr $wmsg "Nothing to search for!  Type in a [expr $regexp?{regular expression}:{string}]."
	return 0
    }
    
    if {$type=="regexp"&&[catch {regexp $pat bozomaniac}]} {
	winstderr $wmsg "Malformed regular expression."
	return 0
    }
    
    $t tag remove $tag 1.0 end
    
    set cnt 0
    set index 1.0
    set len 0
    while {[set index [eval "$t search -forwards -$type $caseopt -count len -- {$pat} {$index+$len chars} end"]]!=""} {
	$t tag add $tag $index "$index + $len chars"
	$t tag configure $tag -background $help(searchbg)
	incr cnt
    }
    
    if {$cnt==0} {set txt "no matches"} elseif {$cnt==1} {set txt "$cnt match"} {set txt "$cnt matches"}
    $wcnt configure -text $txt
    
    set searchbox(ratend$t) 0; set searchbox(ratstart$t) 0
    searchboxNext $tag $t $wmsg 0
    
    return $cnt
}

proc searchboxKeyNav {m k casesen t {wmsg ""} {firstmode 0}} {
    global searchbox
    
    if {[regexp {(Shift|Control|Meta|Alt)_.} $k]} {return 0}
    
    if {![info exists searchbox(try$t)]} {
	set searchbox(try$t) 0
	set searchbox(vect$t) 1
	set searchbox(lastkeys$t) ""
	set searchbox(iatstart$t) 0; set searchbox(iatend$t) 0
	if ![info exists searchbox(lastkeys-old$t)] {set searchbox(lastkeys-old$t) ""}
    }
    
    if {!$firstmode && ($searchbox(try$t) || $searchbox(lastkeys$t)!="")} {
	switch -exact -- $k {
	    space {set k " "}
	    BackSpace -
	    Delete {
		set k ""
		set last [expr [string length $searchbox(lastkeys$t)]-2]
		set searchbox(lastkeys$t) [string range $searchbox(lastkeys$t) 0 $last]
		set searchbox(try$t) 1
	    }
	    default { if {$m==""||$m=="S"} {set k [name2char $k]} }
	}
    }
    set m [string trimright $m "S"]; # strip shift as a modifier
    set mk $m-$k
    if {$m=="literal"} {set op $k} \
	elseif {[info exists sb(key,$mk)]} {set op $sb(key,$mk)} \
	elseif {$m=="" && [string length $k]<=1} {set op default} \
	else {return 0}
    
    switch -exact -- $op {
	exchangepointandmark {
	    set tmp [$t index @0,0]
	    $t yview xmark
	    update
	    $t mark set xmark $tmp
	}
	setmark {$t mark set xmark [$t index @0,0]}
	pageup {$t yview scroll -1 pages}
	pagedown {$t yview scroll 1 pages}
	pagestart {$t yview moveto 0}
	pageend {$t yview moveto 1}
	searchkill {
	    if {$searchbox(lastkeys$t)!=""} {set searchbox(lastkeys-old$t) $searchbox(lastkeys$t)}
	    set searchbox(lastkeys$t) ""; set searchbox(try$t) 0
	    winstdout $wmsg ""
	}
	clearscreen {winstdout $wmsg ""}
	nextline {$t yview scroll 1 units}
	prevline {$t yview scroll -1 units}
	default {
	    if {$op=="incrsearch"} {
	    if {$searchbox(try$t)&&$searchbox(lastkeys$t)==""} {set searchbox(lastkeys$t) $searchbox(lastkeys-old$t)}
		set searchbox(vect$t) 1; set searchbox(try$t) 1
	    } elseif {$op=="revincrsearch"} {
		if {$searchbox(try$t)&&$searchbox(lastkeys$t)==""} {set searchbox(lastkeys$t) $searchbox(lastkeys-old$t)}
		set searchbox(vect$t) -1; set searchbox(try$t) 1
	    } elseif {$firstmode} {
		set searchbox(lastkeys$t) $k
		set searchbox(try$t) 1
	    } elseif {$searchbox(try$t)} {
		append searchbox(lastkeys$t) $k
	    }
	    
	    set keys $searchbox(lastkeys$t)
	    set casesen $help(casesens)
	    if {$casesen==-1} {set casesen [expr {[string tolower $keys]!=$keys}]}
	    set caseopt [expr !$casesen?"-nocase":""]
	    if {$searchbox(try$t)==0 && $keys==""} {return 0}
	    winstdout $wmsg "Searching for \"$keys\" ..."
	    
	    
	    if {$firstmode} {
		set start 1.0; set end end
	    } elseif {[set ranges [$t tag ranges isearch]]!=""} {
		set start [lindex $ranges 0]; set end 1.0
		if {$op=="incrsearch"} {set start [$t index "$start+1c"]}
		if {$searchbox(vect$t)==1} {set end "end"}
	    } else {
		if {$searchbox(vect$t)==1} {
		    set start [$t index @0,0]; set end "end"
		} else {
		    set start [$t index @0,[winfo height $t]]; set end "1.0"
		}
	    }
	    
	    set dir [expr {$searchbox(vect$t)==1?"-forwards":"-backwards"}]
	    set type [expr $firstmode?"-regexp":"-exact"]
	    set pfx [expr $firstmode?"^":""]
	    set search "$t search $dir $type $caseopt -count klen -- {$pfx$keys} $start"
	    set found [eval "$search $end"]
	    set anywhere [eval $search]
	    
	    if {$anywhere!=""} {
		if {$found!=""} {
		    $t tag remove isearch 1.0 end
		    $t tag add isearch $found "$found + $klen c"
		    $t tag configure isearch -background $help(searchbg)
		    $t see $found
		    set searchbox(iatstart$t) 0; set searchbox(iatend$t) 0
		} else {
		    if {$searchbox(vect$t)==1} {
			if {$searchbox(iatstart$t)} {
			    $t yview moveto 0; $t tag remove isearch 1.0 end
			    return [searchboxKeyNav $m $k $casesen $t $wmsg $firstmode]
			} else {
			    winstderr $wmsg "No more matches; try again to wrap around"
			    set searchbox(iatstart$t) 1
			}
		    } else {
			if {$searchbox(iatend$t)} {
			    $t yview moveto 1; $t tag remove isearch 1.0 end
			    return [searchboxKeyNav $m $k $casesen $t $wmsg $firstmode]
			} else {
			    winstderr $wmsg "No more matches; try again to wrap around"
			    set searchbox(iatend$t) 1
			}
		    }
		}
	    } else {
		$t tag remove isearch 1.0 end
		winstderr $wmsg "\"$keys\" not found"
		set searchbox(try$t) 0
	    }
	}
    }
    return 1
}


#
# Help page functions
#

proc helpShowHelp {fname {w .help}} {
    global help

    set wi $w.info
    
    if {[string trim $fname]==""} return
    
    regsub "\\\\" $fname "\a" fname
    
    set oname [string trimright [string trim [lfirst $fname] { ,?!;\"'}] .]

    winstdout $w.info "Searching for \"$oname\" ..."
    
    cursorBusy
    set foundList [helpShowHelpSearch $oname]
    cursorUnset
    
    set found [llength $foundList]
    
    if {!$found} {
	winstderr $w.info "$oname not found"
	set r "ERROR: manual page not found"
    } else {
	return [helpShowHelpFound $foundList 0 $w]
    }
}

proc helpShowHelpSearch {name} {
    global help
    
    set foundList ""
    
    foreach dir $help(dirs) { 
	
	set fid [open "|ls $dir | $help(egrep) -i $name"]
	while {[gets $fid f]!=-1} {
	    if {(![info exists help($dir)]) && [lsearch $foundList $dir/$f]==-1 } {
		lappend foundList $dir/$f
	    }
	}
    }
    catch {close $fid}
    
    return $foundList
}

proc helpShowHelpFound {f {keep 0} {w .help}} {
    global help
    
    set t $w.show; set wi $w.info
    
    set f [lfirst $f]    
    
    if [file isdirectory $f] {
	winstderr $w.info "$f is a directory"
	return
    }
    
    if [catch {set fid [open "|cat $f"]} info] {
	winstderr $w "ERROR: $info"
	return
    }
    
    #configura o conteudo

    helpTextOpen $w
    
    while {![eof $fid]} {$w.show insert end [read $fid 1000]}
    
    helpTextClose $w
    
    winstdout $w.info ""
    
    if [catch {close $fid} info] {
	winstderr $w "ERROR: $info"
	return
    }
    
    winstdout $w.info ""
    
    # informa utilizador da directoria onde a o texto se encontra
    
    winstdout $w.info $f
    
    wm title $w "$help(title$w): $f"
    
    return $f
}

proc helpTextOpen {w} {
    global help
    
    cursorBusy
    set t $w.show
    $t configure -state normal
    $t delete 1.0 end
    foreach i [$t mark names] {if {$i!="insert"&&$i!="current"} {$t mark unset $i}}
    $t configure -font $help(currentfont)
}

proc helpTextClose {w} {
    set t $w.show
    
    if {[$t get "end -1c"]=="\n"} {$t delete "end -1c"}
    
    $t configure -state disabled
    cursorUnset
    $t mark set xmark 1.0
}

#
# Help vars
#

set help(casesens) -1
set help(dirs) [list [xxl_home]/doc/help ]
set help(egrep) grep
set help(pts) {10 12 14 18 24}
set help(sizes) {small medium large}
set help(gui-family) Times
set help(gui-points) small
set help(gui-style) bold
set help(dpi) 75
set help(geometry) 650x500
set help(searchbg) SeaGreen2
set help(currentfont) [spec2font "Courier" $help(gui-style) $help(gui-points)]

#
# Help Widget
#

proc AbacusHelp {{helppage abacus} {srchstrg ""}} {
    global help
    
    set w .help
    toplevel $w -class abacus

    set t $w.show; set wi $w.info
    
    wm iconname $w "Help"
    
    set help(title$w) "Help"

    wm geometry $w $help(geometry)
  
    focus $w
    
    label $wi -anchor w
    
    frame $w.kind

    entry $w.helptype -relief sunken -textvariable help(typein$w) -width 25 -bg White

    bind $w.helptype <KeyPress-Return> "helpShowHelp \$help(typein$w) $w"

    menubutton $w.list -text "Topics..." -menu [set l $w.list.menu];menu $l 

    # gets the list of files in help directory

    set list ""

    foreach dir $help(dirs) { 
	
	set fid [open "|ls $dir"]
	while {[gets $fid f]!=-1} {
	    if {(![info exists help($dir)]) && [lsearch $list $f]==-1 } {
		lappend list $f
	    }
	}
    }
    catch {close $fid}

 
    foreach i $list { $l add command -label $i -command "set help(typein$w) $i;\
                                              helpShowHelp \$help(typein$w) $w"}

    pack $w.helptype -fill x -expand yes -in $w.kind -side left -ipadx 5 -anchor w
    pack $w.list -side left -anchor e -before $w.helptype

    frame $w.vf
    text $t \
	-relief sunken -borderwidth 2 \
	-yscrollcommand "$w.v set" -exportselection yes -wrap word -cursor left_ptr \
	-height 10 -width 5 -insertwidth 0 -background White
    $t tag configure info -lmargin2 0.5i 

    scrollbar $w.v -orient vertical -command "$t yview"
    pack $w.v -in $w.vf -side right -fill y

    pack $t -in $w.vf -side right -fill both -expand yes   
    
    frame $w.search
    button $w.search.s -text "Search" -command "
           set help(search,cnt$w) \[searchboxSearch \$help(search,string$w) 1 \$help(casesens) search $t $wi $w.search.cnt\]"

    button $w.search.next -text "Down" -command "searchboxNext search $t $wi"
    button $w.search.prev -text "Up" -command "searchboxPrev search $t $wi"
    label $w.search.cnt

    entry $w.search.t -relief sunken -textvariable help(search,string$w) -bg White
    set help(search,cnt$w) 0
    bind $w.search.t <KeyPress-Return> "
           if {\$help \"\" !=\$help(search,string$w) || !\$help(search,cnt$w)} {
           set help\"\" \$help(search,string$w)
           $w.search.s invoke
           } else {$w.search.next invoke}"

    pack $w.search.s -side left
    pack $w.search.next $w.search.prev -side left -padx 4
    pack $w.search.t -side left -fill x -expand yes -ipadx 10 -anchor w
    pack $w.search.cnt -side left

    checkbutton $w.help(casesens) -text "Case Sensitive" -variable help(casesens) 

    button $w.abort -text "Abort" -command "destroy .help" -padx 4
    $w.abort configure -command "destroy .help"
    
    pack $w.help(casesens) -in $w.search -side left -padx 3 -anchor e
    pack $w.abort -in $w.search -side left -padx 3
    
    pack $wi $w.kind -fill x -pady 4
    pack $w.vf -fill both -expand yes
    pack $w.search -fill x -pady 6
    
    foreach i {info kind} {bind $w.$i <Enter> "focus $w.helptype"}
    foreach i {vf show v} {bind $w.$i <Enter> "focus $t"}
    bind $w.search <Enter> "focus $w.search.t"
    
    tabgroup $w.helptype $t $w.search.t
    
    foreach i {helptype show search.t} {
	foreach k {KeyPress-Escape Control-KeyPress-g} {
	    bind $w.$i <$k> {+ set STOP 1 }
	}
    }
    
    set help(typein$w) $helppage
    helpShowHelp $help(typein$w) $w
    
    if {$srchstrg !=""} {
	set help(search,string$w) $srchstrg;
	set help(search,cnt$w) \
	    [searchboxSearch $help(search,string$w) 1 $help(casesens) search $t $wi $w.search.cnt]}
    
    return $w
}

# $Log: help.tcl,v $
# Revision 1.5  1998/10/01 19:53:32  cthulhu
# Timed-out messages can now be either warnings or regular messages.
#
# Revision 1.4  1998/09/30 00:36:06  cthulhu
# Added timeout for important help message to be displayed for a while.
#
# Revision 1.3  1998/08/29 18:03:46  cthulhu
# Added help window with search.
# Integrated help browser supports cool way of reading help docs.
#
# Revision 1.2  1998/08/24 21:48:11  cthulhu
# RCS header/footer wasn't commented out :P
#
# Revision 1.1  1998/08/22 22:04:13  cthulhu
# Initial revision
