# SpecTcl, by S. A. Uhler and Ken Corey
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.txt" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
proc recipe_box {canvas args} {
    global tcl_platform

    frame $canvas -bd 0 -relief flat
    frame $canvas.holder -bd 2 -relief raised
    if {$tcl_platform(platform) == "macintosh"} {
        $canvas config -bg #a0a0a0
        $canvas.holder config -bg #a0a0a0
    }
    grid $canvas.holder -row 1 -column 0 -sticky nsew
    grid rowconfigure $canvas.holder 0 -minsize 5
    grid rowconfigure $canvas.holder 1 -weight 1
    grid columnconfigure $canvas.holder 0 -weight 1
    upvar \#0 [winfo name $canvas]combobox c
    grid rowconfigure $canvas 0 -minsize 20
    grid rowconfigure $canvas 1 -weight 1
    grid columnconfigure $canvas 0 -weight 1
    grid propagate $canvas 1
    frame $canvas.hide -bd 0 -relief flat
    grid $canvas.hide -in $canvas.holder -row 0 -column 0 -sticky nsew \
        -rowspan 2
    set c(currenttab) 0
    set c(totaltabs) 0
    set c(next) 15
    set c(xpadding) 5
    set c(ypadding) 5
    set c(top) 5
    set c(contentheight) 0
    foreach {t f} $args {
        if {$t != "" && $f != ""} {
            eval "recipe_tab $canvas [list $t] [list $f]"
        }
    }
    return $canvas
}

proc recipe_tab {canvas text win} {
    upvar \#0 [winfo name $canvas]combobox c
    global tcl_platform

    set i [incr c(totaltabs)]

    frame $canvas.$i -bd 2 -relief raised
    if {$tcl_platform(platform) == "macintosh"} {
        $canvas.$i config -bg #a0a0a0
    }
    set font "Helvetica,12,Bold"
    OutFilter_font dummy font font
    label $canvas.$i.l -text $text -padx $c(xpadding) -pady $c(ypadding) \
        -font $font -anchor n
    set wideness [expr [winfo reqwidth $canvas.$i.l]+14]
    pack $canvas.$i.l -side top -expand yes -fill both
    bind $canvas.$i.l <1> "recipe_raise_tab $canvas $i"
    bind $canvas.$i <1> "recipe_raise_tab $canvas $i"
    set c($i) $win
    recipe_raise_tab $canvas $i
    update idletasks
    if {$i > 1} {
        set idx 1
        set x 0
        while {$idx < $i} {
            set x [expr $x + [winfo reqwidth $canvas.$idx] + 8]
            incr idx
        }
        set h [winfo reqheight $canvas.[expr $i-1].l]
    } else {
        set x 0
        set y 0
        set h 0
    }
    set height [grid rowconfigure $canvas 0 -minsize]
    if {$h > $height} {
        grid rowconfigure $canvas 0 -minsize [expr $h + 5]
    }
    place $canvas.$i -x [expr $x] -y 0 -height 100 -width $wideness
    grid $win -in $canvas.holder -row 1 -column 0 -sticky nsew
}

proc recipe_raise_tab {canvas tab} {
    upvar \#0 [winfo name $canvas]combobox c
    if {[info exist c(last)]} {
        set f [$canvas.$c(last).l cget -font]
        InFilter_font f
        set base {}
        set style {}
        if {[regexp {([^,]*,[^,]*)(.*)} $f dummy base style]} {
            regsub -- {Bold} $style {} style
            set f $base,$style
            OutFilter_font dummy f f
            catch {$canvas.$c(last).l config -font $f}
        }
    }
    
    set c(last) $tab
    set f [$canvas.$tab.l cget -font]
    InFilter_font f
    set base {}
    set style {}
    if {[regexp {([^,]*,[^,]*)(.*)} $f dummy base style]} {
        regsub -- {Bold} $style {} style
        set f "$base,${style}Bold"
        OutFilter_font dummy f f
        catch {$canvas.$tab.l config -font $f}
    }

    raise $canvas.holder
    raise $canvas.$tab
    raise $c($tab)
    raise $canvas.hide
}

# SpecTcl, by S. A. Uhler and Ken Corey
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.txt" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# This file contains the data filtering and validation filters for the
# forms package
#   The filters take a window and variable name as an argument, and replace its
#     value with the translated one, then return Success or failure.
#
#   The input filter is invoked just as the data is written onto the form
#               if the input conversion fails, the result should be set to {}
#
#   The output filter translates the data on the form to the format used
#         by the application.  Upon failure, an error message is placed into
#     the argument, instead of the conversion.  The output filter is called
#         any time the user "leaves" an entry field
#               output filters take 3 arguments:
#                The name of the widget
#                The option being filtered
#                The name of the variable the old/new value is to be stored in

# map Font names to hide X naming grungyness
# This is temporary until TK supports a better strategy
# These are configured as forms data filters.

# X wants "-*-Helvetica-Bold-R-Normal-*-*-120-*-*-*-*-*-*"
# We'll use: format: <family>,<size>,[<Bold>,<Italic>]

# convert X font representation to UI representation
# convert the data in place, return 1/0 for conversion success

proc InFilter_font {variable args} {
    # Hacked to parse abbreviated font specifications.
    upvar $variable data
    global tcl_version
    set family {}
    set size   12     ;# default size
    set weight medium ;# default weight
    set style  r      ;# default style

    if {$tcl_version >= 8.0} {
        # Tk 8.0 has builf-in font command to handle this stuff.
        #
        if ![catch {set xxsize [lindex $data 1]}] {
            if [regexp {(^[-][0-9]+$)|(^[0-9]+$)} $xxsize] {
                array set qq [font actual $data]
                set family [lindex $data 0]
                if {[string comp $qq(-weight) bold] == 0} {
                    set weight bold
                }
                if {[string comp $qq(-weight) italic] == 0} {
                    set style I
                }
                set size [expr abs($xxsize)]
                set done 1
            }
        }
    }

    if ![info exists done] {
        if {[string index $data 0] == "-"} {
            set fields [split $data -]
            switch [llength $fields] {
                1 {
                    set family [lindex $fields 0]
                }
                2 { set family [lindex $fields 0]
                    set size   [lindex $fields 1]
                }
                3 {
                    set family [lindex $fields 0]
                    set weight [lindex $fields 1]
                    set size   [lindex $fields 2]
                }
                15 {
                    set family [lindex $fields 2]
                    set weight [lindex $fields 3]
                    set style  [lindex $fields 4]
                    catch {set size [expr [lindex $fields 8] / 10]}
                }
                default {
                    uplevel "set $variable {}"
                    puts stderr "$data"
                    return 0
                }
            }
        } else {
            #this is tough...for font 7x14, the base is '7x14'.  for 
            #a12biluc, the base is 'a12biluc'.  for courier14, it's 'courier'.
            if {[regexp {^[0-9]} $data]} {
                regexp {([0-9]*)$} $data dummy size
            } elseif {[regexp {([0-9]*)$} $data dummy size]} {
                regsub {[0-9]*} $data {} data
            }
            # we don't have standard X font syntax...try something else...
            foreach q {bold black demi} {
                if {[regexp "$q" $data]} {
                    regsub "$q" $data {} data
                    set weight bold
                    break
                }
            }
            foreach q {italic oblique} {
                if {[regexp "$q" $data]} {
                    regsub "$q" $data {} data
                    set style i
                    break
                }
            }
            foreach q {roman normal medium book} {
                if {[regexp "$q" $data]} {
                    regsub "$q" $data {} data
                    set style r
                    break
                }
            }
            foreach q {narrow light} {
                # can't handle these...but we've got to pull them out
                # if they're here.
                if {[regexp "$q" $data]} {
                    regsub "$q" $data {} data
                    break
                }
            }
            while {[regexp {\-$} $data]} {
                regsub {\-$} $data {} data
            }
            set family $data
        }
    }
    set result $family,$size
    if {[string tolower $weight] == "bold"} {append result ,Bold}
    if {$style == "I"} {append result ,Italic}
    uplevel "set $variable \"$result\""
    return 1
}

# convert font from UI representation to X representation

proc OutFilter_font {win option variable args} {
    upvar $variable data
    set ok 1
    set fields [split $data ,]
    set family [string trim [lindex $fields 0]]
    set sizeString [string trim [lindex $fields 1]]
    regsub -all {^[0]*} $sizeString "" sizeString
    set size ${sizeString}0
    set weight Medium
    set style R
    foreach i {2 3} {
        switch -glob [set arg [string trim [lindex $fields $i]]] {
            {[iI]talic} {set style I}
            {[bB]old}   {set weight Bold}
            {}                  {;}
            default {
                set error \
                    "Invalid font style \"$arg\", try \"Bold\" or \"Italic\""
                uplevel "[list set $variable $error]"
                return 0
            }
        }
    }
    if {$size == {}} {set size 100}
    if {$family == {}} {set family Times}
    set result "-*-${family}-${weight}-${style}-Normal-*-*-${size}-*-*-*-*-*-*"
    catch  "label ._font_test_"
    
    # bad font.  Figure out why for message
    
    if {[catch "._font_test_ configure -font [list $result]"]} {
        set wrong 1
        if {$weight == "Bold"} {
            set tryweight {bold black demi}
        } else {
            set tryweight {{}}
        }
        if {$style == "R"} {
            set trystyle {{} normal medium book roman} 
        } elseif {$style == "I"} {
            set trystyle {oblique italic}
        } else {
            set trystyle {{}}
        }
        set result {}
        foreach fweight $tryweight {
            foreach fstyle $trystyle {
                set test "${family}${fweight}${fstyle}"
                if {[catch "._font_test_ config -font $test"]} {
                    set test "${family}-${fweight}${fstyle}"
                    if {[catch "._font_test_ config -font $test"]} {
                        set test "${family}-${fweight}-${fstyle}"
                        if {[catch "._font_test_ config -font $test"]} {
                        } else {
                            set result $test
                            break
                        }
                    } else {
                        set result $test
                        break
                    }
                } else {
                    set result $test
                    break
                }
            }
            if {$result != ""} {
                break
            }
        }
        if {$result == ""} {
            set test "-*-${family}-${weight}-${style}-Normal-*-*-*-*-*-*-*-*-*"
            if {![catch "._font_test_ configure -font [list $test]"]} {
                set result "Invalid font size \"$sizeString\" for $family,$style"
            } else {
                set test "-*-${family}-*-*-Normal-*-*-*-*-*-*-*-*-*"
                if {[catch "._font_test_ configure -font [list $test]"]} {
                    set result "Invalid font family \"$family\""
                } else {
                    set result "Unsupported font style combination"
                }
            }
            set ok 0
        }
    }
    uplevel "[list set $variable $result]"
    return $ok
}

#
# from Jay Sekora js@priceton.edu

# -------------------------------------
global HelpPriv

option add *help.roman "-adobe-helvetica-medium-r-normal--*-120-*"
option add *help.italic "-adobe-helvetica-medium-o-normal--*-120-*"
option add *help.bold "-adobe-helvetica-bold-r-normal--*-120-*"
option add *help.bolditalic "-adobe-helvetica-bold-o-normal--*-120-*"
option add *help.typewriter "-adobe-courier-medium-r-normal--*-120-*"
option add *help.headline1 "-adobe-helvetica-bold-r-normal--*-140-*"
option add *help.headline2 "-adobe-helvetica-bold-r-normal--*-120-*"
option add *help.linkfg "#ff0000"
option add *help.itemlabel "*"
option add *help*Text.background "#f4f0c4"
option add *help.helpfile "help.tkhelp"

proc H_SetDefaults {} {
    global HelpPriv
    foreach option {\
            roman \
            italic \
            bold \
            bolditalic \
            typewriter \
            headline1 \
            headline2 \
            linkfg \
            itemlabel \
            helpfile
        } {
        set HelpPriv(res:$option) \
                [option get $HelpPriv(W:help) $option $option]
    }
}

proc H_SetTags {text} {
    global HelpPriv
    foreach tag {\
            roman \
            italic \
            bold \
            bolditalic \
            typewriter \
            headline1 \
            headline2 } {
        $text tag configure $tag -font $HelpPriv(res:$tag)
    }
    $text tag configure headline1 -underline 1
    $text tag configure headline2 -underline 1
}




#--------------------------------------------------------------------
# not modify from here (a priori :-)
set HelpPriv(bitmap_help) questhead

#--------------------------------------
#
# Widget hierarchy
#
#
global HelpPriv
# help hierarchy
set {HelpPriv(W:help)}                {.help}
set {HelpPriv(W:bar)}                 {.help.menu}
set {HelpPriv(W:button:back)}         {.help.menu.back}
set {HelpPriv(W:button:forw)}         {.help.menu.forw}
set {HelpPriv(W:section:button)}      {.help.menu.sections}
set {HelpPriv(W:sections)}            {.help.menu.sections.menu}
set {HelpPriv(W:subsection:button)}   {.help.menu.subsections}
set {HelpPriv(W:subsections)}         {.help.menu.subsections.menu}
set {HelpPriv(W:helpbutton)}          {.help.menu.help}
set {HelpPriv(W:helpmenu)}            {.help.menu.help.menu}
set {HelpPriv(W:help:frame)}          {.help.frame}
set {HelpPriv(W:button:next)}         {.help.frame.next}
set {HelpPriv(W:button:prev)}         {.help.frame.prev}
set {HelpPriv(W:dismiss)}             {.help.frame.done}
set {HelpPriv(W:text)}                {.help.text}
set {HelpPriv(W:scroll)}              {.help.scrollbar}
set {HelpPriv(W:bottom)}              {.help.bottomline}
set {HelpPriv(W:top)}                 {.help.topline}
set {HelpPriv(W:vline)}               {.help.vline}

# alert hierarchy
set {HelpPriv(alert)}          {.alert}


######################################################################
# various procs used to display text
######################################################################

# insertWithTags - append to a text widget in a particular style
# (lifted from mkStyles.tcl demo)
#
# The procedure below inserts text into a given text widget and
# applies one or more tags to that text.  The arguments are:
#
# w             Window in which to insert
# text          Text to insert (it's inserted at the "insert" mark)
# args          One or more tags to apply to text.  If this is empty
#               then all tags are removed from the text.




proc H_insertWithTags {w text args} {
    set start [$w index insert]
    $w insert insert $text
    foreach tag [$w tag names $start] {
        $w tag remove $tag $start insert
    }
    foreach i $args {
        $w tag add $i $start insert
    }
}

# rm - insert at end of HelpPriv(W:text) in a plain font


proc rm {text} {
  global HelpPriv
  H_insertWithTags $HelpPriv(W:text) $text roman
}

# it - insert at end of HelpPriv(W:text) in an italic font


proc it {text} {
  global HelpPriv
  H_insertWithTags $HelpPriv(W:text) $text italic
}

# bf - insert at end of HelpPriv(W:text) in a bold font


proc bf {text} {
  global HelpPriv
  H_insertWithTags $HelpPriv(W:text) $text bold
}

# bi - insert at end of HelpPriv(W:text) in a bold italic font

proc bi {text} {
  global HelpPriv
  H_insertWithTags $HelpPriv(W:text) $text bolditalic
}

# tt - insert at end of HelpPriv(W:text) in a typewriter-text font


proc tt {text} {
  global HelpPriv
  H_insertWithTags $HelpPriv(W:text) $text typewriter
}

# hl - insert at end of HelpPriv(W:text) in a big headline font


proc hl {text {level 1}} {
  global HelpPriv
  H_insertWithTags $HelpPriv(W:text) $text headline$level
}

# section - section title (stick in menu)


proc section {title body} {
    global HelpPriv
    global HelpPriv

    $HelpPriv(W:sections) add command \
        -label $title \
        -command [format {
            set HelpPriv(subsection:ctr) 0
            set HelpPriv(section:ctr) %d
            $HelpPriv(W:text) configure -state normal
            $HelpPriv(W:subsection:button) configure -state disabled
            $HelpPriv(W:subsections) delete 0 last
            $HelpPriv(W:text) delete 1.0 end
            H_RemoveTags
            hl {%s}
            cr
            par
            eval {%s}
            $HelpPriv(W:text) configure -state disabled
            if {$HelpPriv(subsection:ctr)} {
                $HelpPriv(W:subsection:button) configure -state normal
            }
        } $HelpPriv(section:ctr) $title $body ]
    incr HelpPriv(section:ctr) 
}

proc subsection {title body} {
    global HelpPriv
    set index [$HelpPriv(W:text) index insert]
    $HelpPriv(W:subsections) add command \
        -label $title \
        -command "$HelpPriv(W:text) yview $index"
    cr
    cr
    incr HelpPriv(subsection:ctr)
    hl $title 2
    cr
    par 
    eval $body
}

######################################################################

# par - start a new paragraph
# par : insert a white space
# par text
# insert text in roman
# par style text
# insert text with style style

proc par {args} {
    global HelpPriv
    rm "\n"
    set start [$HelpPriv(W:text) index insert]
    switch [llength $args] {
        0 {
            set cmd rm
            set text " "
        }
        1 {
            set cmd rm
            set text [lindex $args 0]
        }
        2 {
            set cmd [lindex $args 0]
            set text [lindex $args 1]
        }
    }
    $cmd "$text"
    $HelpPriv(W:text) tag add par $start \
            [$HelpPriv(W:text) index insert]
    $HelpPriv(W:text) tag configure par -lmargin1 10
}

# cr - insert a line break at end of HelpPriv(W:text)


proc cr {} {
  global HelpPriv
  rm "\n"
}

# tab - insert a tab at end of HelpPriv(W:text)

proc tab {} {
  global HelpPriv
  rm "\t"
}
set HelpPriv(tab:level) 0
set HelpPriv(tab:tag) 0
proc itemBody {text} {
    global HelpPriv
    incr HelpPriv(tab:level) 20
    cr
    set start [$HelpPriv(W:text) index insert]
    eval $text
    incr  HelpPriv(tab:tag)
    $HelpPriv(W:text) tag add tab$HelpPriv(tab:tag) \
            $start [$HelpPriv(W:text) index insert]
    $HelpPriv(W:text) tag configure tab$HelpPriv(tab:tag) \
            -lmargin1 $HelpPriv(tab:level) \
            -lmargin2 [expr $HelpPriv(tab:level) + 20]
    
    incr HelpPriv(tab:level) -20

    $HelpPriv(W:text) tag add itemskip3 \
            "insert -1 char linestart" "insert -1 char"
    $HelpPriv(W:text) tag configure itemskip3 -spacing3 4
}

# description - description LaTeX-like environment
proc description {text} {
    global HelpPriv
    set HelpPriv(item:type) description
    itemBody $text
}

# enumerate - enumerate LaTeX-like environment
proc enumerate {text} {
    global HelpPriv
    set HelpPriv(item:type) enumerate
    set HelpPriv(item:ctr) 1
    itemBody $text
}

# itemize - itemize LaTeX-like environment
proc itemize {text} {
    global HelpPriv
    set HelpPriv(item:type) itemize
    itemBody $text
}

# item for previous enviroment
proc item {args} {
    global HelpPriv
    switch [llength $args] {
        1 {
            set item ""
            set text [lindex $args 0]
        }
        2 {
            set item [lindex $args 0]
            set text [lindex $args 1]
        }
        default {
            error "wrong #args"
        }
    } 
    set face roman
    switch $HelpPriv(item:type) {
        description {
            if {$item!=""} {
                set face bold
            }
        }
        enumerate {
            if {$item==""} {
                set item "$HelpPriv(item:ctr)-"
                incr HelpPriv(item:ctr)
            } 
        }
        itemize {
            if {$item==""} {
                set item $HelpPriv(res:itemlabel)
            }
        }
    }
    set start [$HelpPriv(W:text) index insert]
    H_insertWithTags $HelpPriv(W:text) "$item " $face
    $HelpPriv(W:text) tag add itemskip1 $start [$HelpPriv(W:text) index insert]
    $HelpPriv(W:text) tag configure itemskip1 -spacing1 4
    eval $text
    cr
}
######################################################################
#
# mark - save the current line for later x-ref

proc mark {label} {
    global HelpPriv
    set HelpPriv(link:$label) [$HelpPriv(W:text) index insert]
}

######################################################################
#
# ref - set a tag for xref. 
# section is the place where to found the label label
# text is the activable text
proc ref {text section label} {
    global HelpPriv

    append tag XREF [incr HelpPriv(tag:ctr)]
    $HelpPriv(W:text) tag configure $tag \
            -foreground $HelpPriv(res:linkfg) 
    
    # $HelpPriv(W:text) tag bind $tag <Enter> {
       # $HelpPriv(W:text) configure -cursor hand2
    # }
    $HelpPriv(W:text) tag bind $tag <Leave> {
        $HelpPriv(W:text) configure -cursor top_left_arrow
    }
    
    $HelpPriv(W:text) tag bind $tag <1> \
    [format {
        set section {%s}
        if {[catch "%s invoke \"$section\"" err]} {
            puts stderr "no section $section ($err)"
        } else {
            H_AddIndexToHistory $section
            set label {%s}
            if {[info exist HelpPriv(link:$label)]} {
                $HelpPriv(W:text) yview -pickplace $HelpPriv(link:$label)
            } else {
                puts stderr "no label $label in section $section"            
            }
        }
    } $section $HelpPriv(W:sections) $label]

    # set the tag.
    H_insertWithTags $HelpPriv(W:text) $text $tag
}

######################################################################
#
# H_RemoveTags - removes all the tag from the text

proc H_RemoveTags {} {
    global HelpPriv
    # remove any tags
    set tags [$HelpPriv(W:text) tag names]
    set ind [lsearch $tags sel]
    foreach tag [lreplace $tags $ind $ind] {
        $HelpPriv(W:text) tag remove $tag 0.0 end
    }
    set HelpPriv(tag:ctr) 0

}

######################################################################
# cmd_quit - quit
#

proc H_Quit {} {
    global HelpPriv
    destroy $HelpPriv(W:help)
}




proc HelpWindow { {section ""} } {
    global HelpPriv HelpPriv

    if { [winfo exist $HelpPriv(W:help) ] } {
        if {$section!=""} {
            $HelpPriv(W:sections) invoke $section
        } 
        raise $HelpPriv(W:help)
        return
    }

    global HelpPriv

    ######################################################################
    # interface elements
    #
    set HelpPriv(section:ctr) 0
    toplevel $HelpPriv(W:help) -class Help

    H_SetDefaults

    frame $HelpPriv(W:bar)
    menubutton $HelpPriv(W:section:button)\
        -text {Sections} \
        -menu $HelpPriv(W:sections)
    menu $HelpPriv(W:sections) -tearoff 0

    menubutton $HelpPriv(W:subsection:button)\
        -text {Subsections} \
        -menu $HelpPriv(W:subsections) \
        -state disabled
    menu $HelpPriv(W:subsections) -tearoff 0

    menubutton $HelpPriv(W:helpbutton) \
        -text {Help} \
        -menu $HelpPriv(W:helpmenu)
    
    menu $HelpPriv(W:helpmenu) -tearoff 0

    $HelpPriv(W:helpmenu) \
         add command \
         -label {Help on Help} \
         -command H_HelpOnHelp
    $HelpPriv(W:helpmenu) \
         add command \
         -label {Quit} \
         -command "H_Quit"

    button $HelpPriv(W:button:back) \
            -highlightthickness 0 \
            -padx 0 \
            -text Back \
            -relief flat

    button $HelpPriv(W:button:forw) \
            -highlightthickness 0 \
            -padx 0 \
            -text Forw \
            -relief flat

    pack $HelpPriv(W:helpbutton) \
        $HelpPriv(W:section:button) \
        $HelpPriv(W:subsection:button) \
        $HelpPriv(W:button:back) \
        $HelpPriv(W:button:forw) \
        -in $HelpPriv(W:bar) \
        -side left

    frame $HelpPriv(W:help:frame) -borderwidth 2

    button $HelpPriv(W:button:prev) \
            -highlightthickness 0 \
            -padx 0 \
            -text "Previous section"

    button $HelpPriv(W:button:next) \
            -highlightthickness 0 \
            -padx 0 \
            -text "Next section"

    button $HelpPriv(W:dismiss) \
      -text Dismiss \
      -command "H_Quit"
    
    text $HelpPriv(W:text) \
        -yscrollcommand "$HelpPriv(W:scroll) set" \
        -width 70 -height 18 \
        -setgrid true -wrap word \
        -cursor top_left_arrow

    H_SetTags  $HelpPriv(W:text)

    scrollbar $HelpPriv(W:scroll) \
       -relief flat \
       -command "$HelpPriv(W:text) yview"
    
    # horizontal separators between menu and text, and text and button
    frame $HelpPriv(W:top) \
        -height 2 -width 20 -borderwidth 1 -relief sunken
    frame $HelpPriv(W:bottom) \
        -height 2 -width 20 -borderwidth 1 -relief sunken

    
    # vertical separator between text and scrollbar
    frame $HelpPriv(W:vline) \
    -width 2 -height 20 -borderwidth 1 -relief sunken

    
    pack $HelpPriv(W:bar)   \
        $HelpPriv(W:top)    \
        -in $HelpPriv(W:help) \
        -side top -fill x 

    pack $HelpPriv(W:button:prev) \
            $HelpPriv(W:button:next) \
            $HelpPriv(W:dismiss)   \
            -in $HelpPriv(W:help:frame) \
            -side left -expand 1 -ipadx 1m -ipady 0.5m

    pack $HelpPriv(W:help:frame) \
            $HelpPriv(W:bottom) \
            -in $HelpPriv(W:help) \
            -side bottom -fill x

    pack $HelpPriv(W:scroll) \
        $HelpPriv(W:vline)   \
        -in $HelpPriv(W:help)  \
        -side right -fill y
    pack $HelpPriv(W:text)  \
        -in $HelpPriv(W:help) \
        -side right -expand 1 -fill both -padx 4
    
    
    ######################################################################
    # keyboard bindings
    #

    FocusBinding $HelpPriv(W:help)
    # bind $HelpPriv(W:help) <Control-q> {H_Quit}
    bind $HelpPriv(W:help) <Control-h> {HelpWindow Help; break}
    # apply any changes to the text-appearance variables
    
    bind $HelpPriv(W:help) <Control-p> {
        H_PrevSection 
        break;
    }
    $HelpPriv(W:button:prev) configure -command H_PrevSection

    bind $HelpPriv(W:help) <Control-n> {
        H_NextSection
        break;
    }
    $HelpPriv(W:button:next) configure \
            -command H_NextSection

    regsub -all -- {%W} [bind Text <Next>] "$HelpPriv(W:text)" bind
    bind $HelpPriv(W:help) <space> $bind

    regsub -all -- {%W} [bind Text <Prior>] "$HelpPriv(W:text)" bind
    bind $HelpPriv(W:help) <BackSpace> $bind

    $HelpPriv(W:button:back) configure -command H_BackSection -state disabled
    $HelpPriv(W:button:forw) configure -command H_ForwSection -state disabled

    H_FillText

    if {$section!=""} {
        $HelpPriv(W:sections) invoke $section
    } 
}

proc H_NextSection {} {
    global HelpPriv

    set sectionIndex [expr $HelpPriv(section:ctr) + 1]
    if {[catch { $HelpPriv(W:sections) invoke $sectionIndex}] == 0} {
        H_AddIndexToHistory $sectionIndex
    }
}

proc H_PrevSection {} {
    global HelpPriv

    set sectionIndex [expr $HelpPriv(section:ctr) - 1]
    if {[catch { $HelpPriv(W:sections) invoke $sectionIndex}] == 0} {
        H_AddIndexToHistory $sectionIndex
    }
}

proc H_AddIndexToHistory {sectionIndex} {
    global HelpPriv

    if {$HelpPriv(historyIndex) < [expr [llength $HelpPriv(history)] -1]} {
        set newList [lreplace $HelpPriv(history) \
                [expr $HelpPriv(historyIndex) + 1 ] end]
        unset HelpPriv(history)
        set HelpPriv(history) $newList
    }
    lappend HelpPriv(history) $sectionIndex
    incr HelpPriv(historyIndex)
    $HelpPriv(W:button:back) configure -state normal
    $HelpPriv(W:button:forw) configure -state disabled
}

proc H_BackSection {} {
    global HelpPriv

    incr HelpPriv(historyIndex) -1
    if {$HelpPriv(historyIndex) == 0} {
        $HelpPriv(W:button:back) configure -state disabled
    }
    if {$HelpPriv(historyIndex) < [expr [llength $HelpPriv(history)]-1]} {
        $HelpPriv(W:button:forw) configure -state normal
    }
    set sectionIndex [lindex $HelpPriv(history) $HelpPriv(historyIndex)]
    catch {$HelpPriv(W:sections) invoke $sectionIndex}
}

proc H_ForwSection {} {
    global HelpPriv

    incr HelpPriv(historyIndex)
    if {$HelpPriv(historyIndex) == [expr [llength $HelpPriv(history)] - 1]} {
        $HelpPriv(W:button:forw) configure -state disabled
    }
    if {$HelpPriv(historyIndex) != 0 } {
        $HelpPriv(W:button:back) configure -state normal
    }
    set sectionIndex [lindex $HelpPriv(history) $HelpPriv(historyIndex)]
    catch {$HelpPriv(W:sections) invoke $sectionIndex}
}

proc DestroyHelpWindow { } {
     global HelpPriv
     catch "destroy $HelpPriv(about)"
     destroy $HelpPriv(W:help)
}    



proc H_FillText { } {
    global HelpPriv
    global HelpPriv

    ######################################################################
    # search for help file
    # the contents of the help file will set up the Sections menu
    #
    set HelpPriv(section:ctr) 0
    $HelpPriv(W:sections) delete 0 last
    set filename $HelpPriv(res:helpfile)
    
    if {! [file exists $filename ] } then {
      $HelpPriv(W:section:button) configure \
          -state disabled
      hl "Unable to find file `$filename'."
      par
      rm "The requested help file was not found.  "
      rm "It may not have been installed at your site."
      tkwait window $HelpPriv(W:help)
      return
    } else {
        source $filename
    }
    set HelpPriv(section:ctr) 0
    wm title $HelpPriv(W:help)  "Help"
    wm iconbitmap $HelpPriv(W:help) $HelpPriv(bitmap_help)
    # display the first section of help:
    $HelpPriv(W:sections) invoke $HelpPriv(section:ctr)

    # History of sections
    set HelpPriv(history) "0"
    set HelpPriv(historyIndex) 0
}

proc H_HelpOnHelp {} {
    global HelpPriv
    $HelpPriv(W:text) configure -state normal
    $HelpPriv(W:text) delete 1.0 end
hl "Help On Help"
cr
par "The help is divided into sections and subsections. To go directly"
rm " to a topic use the "
bf "Sections"
rm " and "
bf "Subsections"
rm " menus. Note: if a section has no subsection, the subsection menu "
rm "is disabled. In a section there are several bindings:"
description {
item "<space>" {
rm "move one page down"
}
item "<Control-b>" {
rm "move one page up"
}
item "<Control-p>" {
rm "go to the previous section"
}
item "<Control-n>" {
rm "go to the next section"
}
}
rm "There are hypertext-like links too. Some words (generally found as in "
rm "\"see "
bf "word"
rm "\" are pointers to other sections. When the mouse cursor moves over "
rm "them, they change of color. Click on them to directly jump to the "
rm "topic."
par
rm "When finished, click on the "
bf "Dismiss"
rm " button, or select the "
bf "Quit"
rm " entry in the help menu."
$HelpPriv(W:text) configure -state disabled
}

if {[info proc CenterWindowOnScreen]==""} {
    proc CenterWindowOnScreen w {
        wm withdraw $w
        update idletasks
        set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
                - [winfo vrootx [winfo parent $w]]]
        set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
                - [winfo vrooty [winfo parent $w]]]
        wm geom $w +$x+$y
        wm deiconify $w
    }
}

#----------------------------------------------------------------
# FocusBinding
#
#    set focus for the window W whenever it contains the mouse pointer
# Return:
#    none
#
# Side effects:
#    set focus
#----------------------------------------------------------------
if {[info proc FocusBinding]==""} {
    proc FocusBinding w {
        bind $w  <FocusIn> {            
            if {[string match "%d" "NotifyVirtual"]} {
                focus  %W
            }
        }
    }
}




