#* 
#* ------------------------------------------------------------------
#* Role PlayingDB V2.0 by Deepwoods Software
#* ------------------------------------------------------------------
#* RPGHelp.tcl - Help functions
#* Created by Robert Heller on Sun Mar 28 00:57:42 1999
#* ------------------------------------------------------------------
#* Modification History: 
#* $Log: RPGHelp.tcl,v $
#* Revision 1.2  1999/07/13 01:29:16  heller
#* Fix documentation: spelling, punctuation, etc.
#*
#* Revision 1.1  1999/04/20 13:54:42  heller
#* Initial revision
#*
#* ------------------------------------------------------------------
#* Contents:
#* ------------------------------------------------------------------
#*  
#*     Role Playing DB -- A database package that creates and maintains
#* 		       a database of RPG characters, monsters, treasures,
#* 		       spells, and playing environments.
#* 
#*     Copyright (C) 1995,1998,1999  Robert Heller D/B/A Deepwoods Software
#* 			51 Locke Hill Road
#* 			Wendell, MA 01379-9728
#* 
#*     This program is free software; you can redistribute it and/or modify
#*     it under the terms of the GNU General Public License as published by
#*     the Free Software Foundation; either version 2 of the License, or
#*     (at your option) any later version.
#* 
#*     This program is distributed in the hope that it will be useful,
#*     but WITHOUT ANY WARRANTY; without even the implied warranty of
#*     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#*     GNU General Public License for more details.
#* 
#*     You should have received a copy of the GNU General Public License
#*     along with this program; if not, write to the Free Software
#*     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#* 
#*  
#* 

#@Chapter:RPGHelp.tcl -- Online Help subsystem
#@Label:RPGHelp.tcl
#$Id: RPGHelp.tcl,v 1.2 1999/07/13 01:29:16 heller Rel1 $
# This file contains the code to implement the Online Help subsystem.

global HelpDir
# This is the path to the help file directory.  It is computed from
# the script library directory.
# [index] HelpDir!global variable

catch {set HelpDir "[file join [file dirname $LibDir] Help]"}

global HLinePattern
# This is the help file pattern to pick up a help header line.

set HLinePattern {^([0-9]+)[ 	](.*)$}

global HelpHistoryList
# This is the help history list.

set HelpHistoryList {}

global HelpHistoryListIndex
# This is the help history index.

set HelpHistoryListIndex -1

proc TkIsLoadedP {} {
# This procedure checks to see  if the Tk package is loaded -- this is only
# used to protect the global binding code to allow pkg_mkIndex to work
# properly.

  foreach p [info loaded] {
    if {[string compare "[lindex $p 1]" {Tk}] == 0} {return 1}
  }
  return 0
}

if {[TkIsLoadedP] == 1} {

# Normal, non-destructive Text bindings (lifted from text.tcl)

bind HelpText <1> {
    tkTextButton1 %W %x %y
    %W tag remove sel 0.0 end
}
bind HelpText <B1-Motion> {
    set tkPriv(x) %x
    set tkPriv(y) %y
    tkTextSelectTo %W %x %y
}
bind HelpText <Double-1> {
    set tkPriv(selectMode) word
    tkTextSelectTo %W %x %y
    catch {%W mark set insert sel.first}
}
bind HelpText <Triple-1> {
    set tkPriv(selectMode) line
    tkTextSelectTo %W %x %y
    catch {%W mark set insert sel.first}
}
bind HelpText <Shift-1> {
    tkTextResetAnchor %W @%x,%y
    set tkPriv(selectMode) char
    tkTextSelectTo %W %x %y
}
bind HelpText <Double-Shift-1>	{
    set tkPriv(selectMode) word
    tkTextSelectTo %W %x %y
}
bind HelpText <Triple-Shift-1>	{
    set tkPriv(selectMode) line
    tkTextSelectTo %W %x %y
}
bind HelpText <B1-Leave> {
    set tkPriv(x) %x
    set tkPriv(y) %y
    tkTextAutoScan %W
}
bind HelpText <B1-Enter> {
    tkCancelRepeat
}
bind HelpText <ButtonRelease-1> {
    tkCancelRepeat
}
bind HelpText <Control-1> {
    %W mark set insert @%x,%y
}
bind HelpText <Left> {
    tkTextSetCursor %W insert-1c
}
bind HelpText <Right> {
    tkTextSetCursor %W insert+1c
}
bind HelpText <Up> {
    tkTextSetCursor %W [tkTextUpDownLine %W -1]
}
bind HelpText <Down> {
    tkTextSetCursor %W [tkTextUpDownLine %W 1]
}
bind HelpText <Shift-Left> {
    tkTextKeySelect %W [%W index {insert - 1c}]
}
bind HelpText <Shift-Right> {
    tkTextKeySelect %W [%W index {insert + 1c}]
}
bind HelpText <Shift-Up> {
    tkTextKeySelect %W [tkTextUpDownLine %W -1]
}
bind HelpText <Shift-Down> {
    tkTextKeySelect %W [tkTextUpDownLine %W 1]
}
bind HelpText <Control-Left> {
    tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
}
bind HelpText <Control-Right> {
    tkTextSetCursor %W [tkTextNextWord %W insert]
}
bind HelpText <Control-Up> {
    tkTextSetCursor %W [tkTextPrevPara %W insert]
}
bind HelpText <Control-Down> {
    tkTextSetCursor %W [tkTextNextPara %W insert]
}
bind HelpText <Shift-Control-Left> {
    tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
}
bind HelpText <Shift-Control-Right> {
    tkTextKeySelect %W [tkTextNextWord %W insert]
}
bind HelpText <Shift-Control-Up> {
    tkTextKeySelect %W [tkTextPrevPara %W insert]
}
bind HelpText <Shift-Control-Down> {
    tkTextKeySelect %W [tkTextNextPara %W insert]
}
bind HelpText <Prior> {
    tkTextSetCursor %W [tkTextScrollPages %W -1]
}
bind HelpText <Shift-Prior> {
    tkTextKeySelect %W [tkTextScrollPages %W -1]
}
bind HelpText <Next> {
    tkTextSetCursor %W [tkTextScrollPages %W 1]
}
bind HelpText <Shift-Next> {
    tkTextKeySelect %W [tkTextScrollPages %W 1]
}
bind HelpText <Control-Prior> {
    %W xview scroll -1 page
}
bind HelpText <Control-Next> {
    %W xview scroll 1 page
}

bind HelpText <Home> {
    tkTextSetCursor %W {insert linestart}
}
bind HelpText <Shift-Home> {
    tkTextKeySelect %W {insert linestart}
}
bind HelpText <End> {
    tkTextSetCursor %W {insert lineend}
}
bind HelpText <Shift-End> {
    tkTextKeySelect %W {insert lineend}
}
bind HelpText <Control-Home> {
    tkTextSetCursor %W 1.0
}
bind HelpText <Control-Shift-Home> {
    tkTextKeySelect %W 1.0
}
bind HelpText <Control-End> {
    tkTextSetCursor %W {end - 1 char}
}
bind HelpText <Control-Shift-End> {
    tkTextKeySelect %W {end - 1 char}
}
bind HelpText <Tab> {
  focus [tk_focusNext %W]
}
bind HelpText <Control-Tab> {
    focus [tk_focusNext %W]
}
bind HelpText <Control-Shift-Tab> {
    focus [tk_focusPrev %W]
}
bind HelpText <Control-i> {
    focus [tk_focusNext %W]
}
bind HelpText <Control-space> {
    %W mark set anchor insert
}
bind HelpText <Select> {
    %W mark set anchor insert
}
bind HelpText <Control-Shift-space> {
    set tkPriv(selectMode) char
    tkTextKeyExtend %W insert
}
bind HelpText <Shift-Select> {
    set tkPriv(selectMode) char
    tkTextKeyExtend %W insert
}
bind HelpText <Control-slash> {
    %W tag add sel 1.0 end
}
bind HelpText <Control-backslash> {
    %W tag remove sel 1.0 end
}
bind HelpText <<Copy>> {
    tk_textCopy %W
}
# Additional emacs-like bindings:

bind HelpText <Control-a> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W {insert linestart}
    }
}
bind HelpText <Control-b> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W insert-1c
    }
}
bind HelpText <Control-d> {
    if {!$tk_strictMotif} {
	%W delete insert
    }
}
bind HelpText <Control-e> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W {insert lineend}
    }
}
bind HelpText <Control-f> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W insert+1c
    }
}
bind HelpText <Control-n> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W [tkTextUpDownLine %W 1]
    }
}
bind HelpText <Control-o> {
    if {!$tk_strictMotif} {
	%W insert insert \n
	%W mark set insert insert-1c
    }
}
bind HelpText <Control-p> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W [tkTextUpDownLine %W -1]
    }
}
if {$tcl_platform(platform) != "windows"} {
bind HelpText <Control-v> {
    if {!$tk_strictMotif} {
	tkTextScrollPages %W 1
    }
}
}
bind HelpText <Meta-b> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
    }
}
bind HelpText <Meta-f> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W [tkTextNextWord %W insert]
    }
}
bind HelpText <Meta-less> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W 1.0
    }
}
bind HelpText <Meta-greater> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W end-1c
    }
}
# Macintosh only bindings:

# if text black & highlight black -> text white, other text the same
if {$tcl_platform(platform) == "macintosh"} {
bind HelpText <FocusIn> {
    %W tag configure sel -borderwidth 0
    %W configure -selectbackground systemHighlight -selectforeground systemHighlightText
}
bind HelpText <FocusOut> {
    %W tag configure sel -borderwidth 1
    %W configure -selectbackground white -selectforeground black
}
bind HelpText <Option-Left> {
    tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
}
bind HelpText <Option-Right> {
    tkTextSetCursor %W [tkTextNextWord %W insert]
}
bind HelpText <Option-Up> {
    tkTextSetCursor %W [tkTextPrevPara %W insert]
}
bind HelpText <Option-Down> {
    tkTextSetCursor %W [tkTextNextPara %W insert]
}
bind HelpText <Shift-Option-Left> {
    tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
}
bind HelpText <Shift-Option-Right> {
    tkTextKeySelect %W [tkTextNextWord %W insert]
}
bind HelpText <Shift-Option-Up> {
    tkTextKeySelect %W [tkTextPrevPara %W insert]
}
bind HelpText <Shift-Option-Down> {
    tkTextKeySelect %W [tkTextNextPara %W insert]
}

# End of Mac only bindings
}


# Hyperhelp bindings

bind HelpText <g> {
  rpgHelpTextHHGoto %W %x %y
}

bind HelpText <G> {
  rpgHelpTextHHGoto %W %x %y
}

bind HelpText <s> {
  rpgHelpTextHHSearch %W %x %y
}

bind HelpText <S> {
  rpgHelpTextHHSearch %W %x %y
}

bind HelpText <r> {
  rpgHelpTextHHRSearch %W %x %y
}

bind HelpText <R> {
  rpgHelpTextHHRSearch %W %x %y
}

}

proc rpgHelpTextHHGoto {widget x y} {
# Function to implement the g/G key binding.

  global HelpWindowInput
  set HelpWindowInput 0
  .helpWindow.command.prompt configure -text "Goto:"
  set oldFocus [focus]
  set oldGrab [grab current .helpWindow]
  if {$oldGrab != ""} {
    set grabStatus [grab status $oldGrab]
  }
  .helpWindow.command.input delete 0 end
  grab .helpWindow.command.input
  focus .helpWindow.command.input
  tkwait variable HelpWindowInput
  catch {focus $oldFocus}
  grab release .helpWindow.command.input
  if {$oldGrab != ""} {  
    if {$grabStatus == "global"} {
      grab -global $oldGrab
    } else {
      grab $oldGrab
    }
  }
  HelpTopic "[.helpWindow.command.input get]"
}

proc rpgHelpTextHHSearch {widget x y} {
# Function to implement the s/S key binding.

  global HelpWindowInput
  set HelpWindowInput 0
  .helpWindow.command.prompt configure -text "Search forward:"
  set oldFocus [focus]
  set oldGrab [grab current .helpWindow]
  if {$oldGrab != ""} {
    set grabStatus [grab status $oldGrab]
  }
  .helpWindow.command.input delete 0 end
  grab .helpWindow.command.input
  focus .helpWindow.command.input
  tkwait variable HelpWindowInput
  catch {focus $oldFocus}
  grab release .helpWindow.command.input
  if {$oldGrab != ""} {  
    if {$grabStatus == "global"} {
      grab -global $oldGrab
    } else {
      grab $oldGrab
    }
  }
  set string "[.helpWindow.command.input get]"
  set found [.helpWindow.indexText.helpTextFrame.helpText search -forwards -nocase -- \
    $string insert end]
  if {[string length "$found"] == 0} {
    .helpWindow.modeStatus configure -text "'$string' not found!"
  } else {
    .helpWindow.indexText.helpTextFrame.helpText mark set insert $found
    .helpWindow.indexText.helpTextFrame.helpText see $found
  }
}

proc rpgHelpTextHHRSearch {widget x y} {
# Function to implement the r/R key binding.

  global HelpWindowInput
  set HelpWindowInput 0
  .helpWindow.command.prompt configure -text "Search backward:"
  set oldFocus [focus]
  set oldGrab [grab current .helpWindow]
  if {$oldGrab != ""} {
    set grabStatus [grab status $oldGrab]
  }
  .helpWindow.command.input delete 0 end
  grab .helpWindow.command.input
  focus .helpWindow.command.input
  tkwait variable HelpWindowInput
  catch {focus $oldFocus}
  grab release .helpWindow.command.input
  if {$oldGrab != ""} {  
    if {$grabStatus == "global"} {
      grab -global $oldGrab
    } else {
      grab $oldGrab
    }
  }
  set string "[.helpWindow.command.input get]"
  set found [.helpWindow.indexText.helpTextFrame.helpText search -backwards -nocase -- \
    $string insert 1.0]
  if {[string length "$found"] == 0} {
    .helpWindow.modeStatus configure -text "'$string' not found!"
  } else {
    .helpWindow.indexText.helpTextFrame.helpText mark set insert $found
    .helpWindow.indexText.helpTextFrame.helpText see $found
  }
}

proc helptext {wname args} {
# Create a helptext widget.
#
# <in> wname -- the name of the widget.
# <in> args  -- options.

  text $wname
  eval [concat $wname configure $args]
  set bts [bindtags $wname]
  set ti [lsearch $bts {Text}]
  set bts [lreplace $bts $ti $ti HelpText]
  bindtags $wname $bts
  return $wname
}

proc CreateHelpWindow {} {
# Procedure to create the help window.

  if {[winfo exists .helpWindow]} {
    wm deiconify .helpWindow
    return
  }

# .helpWindow
# The above line makes pasting MUCH easier for me.
# It contains the pathname of the cutted widget.
# Tcl version: 8.0 (Tcl/Tk/XF)
# Tk version: 8.0
# XF version: 4.0
#

  # build widget .helpWindow
  if {"[info procs XFEdit]" != ""} {
    catch "XFDestroy .helpWindow"
  } {
    catch "destroy .helpWindow"
  }
  toplevel .helpWindow -class Help

  # Window manager configurations
  wm positionfrom .helpWindow ""
  wm sizefrom .helpWindow ""
  wm maxsize .helpWindow 1000 1000
  wm minsize .helpWindow 10 10
  wm title .helpWindow {RPG Help Window}


  # build widget .helpWindow.indexText
  frame .helpWindow.indexText \
    -borderwidth {2} \
    -relief {ridge}

  # build widget .helpWindow.indexText.indexLBFrame
  frame .helpWindow.indexText.indexLBFrame \
    -borderwidth {2}

  # build widget .helpWindow.indexText.indexLBFrame.lbysFrame
  frame .helpWindow.indexText.indexLBFrame.lbysFrame

  # build widget .helpWindow.indexText.indexLBFrame.lbysFrame.lbFrame
  frame .helpWindow.indexText.indexLBFrame.lbysFrame.lbFrame \
    -borderwidth {2}

  # build widget .helpWindow.indexText.indexLBFrame.lbysFrame.lbFrame.indexLB
  listbox .helpWindow.indexText.indexLBFrame.lbysFrame.lbFrame.indexLB \
    -xscrollcommand {.helpWindow.indexText.indexLBFrame.frame2.frame5.scrollbar10 set} \
    -yscrollcommand {.helpWindow.indexText.indexLBFrame.lbysFrame.frame4.scrollbar9 set}
  bind .helpWindow.indexText.indexLBFrame.lbysFrame.lbFrame.indexLB <Double-1> \
	{HelpTopic [string trim [%W get [%W nearest %y]]]}

  # build widget .helpWindow.indexText.indexLBFrame.lbysFrame.frame4
  frame .helpWindow.indexText.indexLBFrame.lbysFrame.frame4 \
    -borderwidth {2}

  # build widget .helpWindow.indexText.indexLBFrame.lbysFrame.frame4.scrollbar9
  scrollbar .helpWindow.indexText.indexLBFrame.lbysFrame.frame4.scrollbar9 \
    -command {.helpWindow.indexText.indexLBFrame.lbysFrame.lbFrame.indexLB yview} \
    -width {13}

  # build widget .helpWindow.indexText.indexLBFrame.frame2
  frame .helpWindow.indexText.indexLBFrame.frame2 \
    -borderwidth {1}

  # build widget .helpWindow.indexText.indexLBFrame.frame2.frame5
  frame .helpWindow.indexText.indexLBFrame.frame2.frame5 \
    -borderwidth {2}

  # build widget .helpWindow.indexText.indexLBFrame.frame2.frame5.scrollbar10
  scrollbar .helpWindow.indexText.indexLBFrame.frame2.frame5.scrollbar10 \
    -command {.helpWindow.indexText.indexLBFrame.lbysFrame.lbFrame.indexLB xview} \
    -orient {horizontal} \
    -width {13}

  # build widget .helpWindow.indexText.indexLBFrame.frame2.frame6
  frame .helpWindow.indexText.indexLBFrame.frame2.frame6 \
    -borderwidth {2}

  # build widget .helpWindow.indexText.indexLBFrame.frame2.frame6.frame11
  frame .helpWindow.indexText.indexLBFrame.frame2.frame6.frame11 \
    -borderwidth {2} \
    -height {13} \
    -width {16}

  # build widget .helpWindow.indexText.helpTextFrame
  frame .helpWindow.indexText.helpTextFrame \
    -relief {raised}

  # build widget .helpWindow.indexText.helpTextFrame.scrollbar1
  scrollbar .helpWindow.indexText.helpTextFrame.scrollbar1 \
    -command {.helpWindow.indexText.helpTextFrame.helpText yview} \
    -relief {raised}

  # build widget .helpWindow.indexText.helpTextFrame.helpText
  helptext .helpWindow.indexText.helpTextFrame.helpText \
    -wrap {word} \
    -yscrollcommand {.helpWindow.indexText.helpTextFrame.scrollbar1 set}

  # build widget .helpWindow.modeStatus
  label .helpWindow.modeStatus -justify left -anchor w

  # build widget .helpWindow.command
  frame .helpWindow.command \
    -borderwidth {2} \
    -relief {ridge}

  # build widget .helpWindow.command.prompt
  label .helpWindow.command.prompt

  # build widget .helpWindow.command.input
  entry .helpWindow.command.input \
    -width {0}
  bind .helpWindow.command.input <Return> {
	global HelpWindowInput
	set HelpWindowInput 1
  }

  # build widget .helpWindow.buttons
  frame .helpWindow.buttons \
    -borderwidth {2}

  # build widget .helpWindow.buttons.button7
  button .helpWindow.buttons.button7 \
    -padx {9} \
    -pady {3} \
    -text {Close} \
    -command {wm withdraw .helpWindow} 
  wm protocol .helpWindow WM_DELETE_WINDOW {wm withdraw .helpWindow}

  # build widget .helpWindow.buttons.button9
  button .helpWindow.buttons.button9 \
    -padx {9} \
    -pady {3} \
    -text {Back} \
    -command {HelpBackTopic}

  # build widget .helpWindow.buttons.button10
  button .helpWindow.buttons.button10 \
    -padx {9} \
    -pady {3} \
    -text {Forward} \
    -command {HelpForwardTopic}

  # build widget .helpWindow.buttons.button8
  button .helpWindow.buttons.button8 \
    -padx {9} \
    -pady {3} \
    -text {Help} \
    -command {HelpTopic Help}

  # pack master .helpWindow.indexText
  pack configure .helpWindow.indexText.indexLBFrame \
    -expand 1 \
    -fill both \
    -side left
  pack configure .helpWindow.indexText.helpTextFrame \
    -expand 1 \
    -fill both \
    -side right

  # pack master .helpWindow.indexText.indexLBFrame
  pack configure .helpWindow.indexText.indexLBFrame.lbysFrame \
    -expand 1 \
    -fill both
  pack configure .helpWindow.indexText.indexLBFrame.frame2 \
    -fill x \
    -side bottom

  # pack master .helpWindow.indexText.indexLBFrame.lbysFrame
  pack configure .helpWindow.indexText.indexLBFrame.lbysFrame.lbFrame \
    -expand 1 \
    -fill both \
    -side left
  pack configure .helpWindow.indexText.indexLBFrame.lbysFrame.frame4 \
    -fill y \
    -side right

  # pack master .helpWindow.indexText.indexLBFrame.lbysFrame.lbFrame
  pack configure .helpWindow.indexText.indexLBFrame.lbysFrame.lbFrame.indexLB \
    -expand 1 \
    -fill both \
    -side left

  # pack master .helpWindow.indexText.indexLBFrame.lbysFrame.frame4
  pack configure .helpWindow.indexText.indexLBFrame.lbysFrame.frame4.scrollbar9 \
    -expand 1 \
    -fill y

  # pack master .helpWindow.indexText.indexLBFrame.frame2
  pack configure .helpWindow.indexText.indexLBFrame.frame2.frame5 \
    -expand 1 \
    -fill both \
    -side left
  pack configure .helpWindow.indexText.indexLBFrame.frame2.frame6 \
    -fill y \
    -side right

  # pack master .helpWindow.indexText.indexLBFrame.frame2.frame5
  pack configure .helpWindow.indexText.indexLBFrame.frame2.frame5.scrollbar10 \
    -expand 1 \
    -fill x \
    -side left

  # pack master .helpWindow.indexText.indexLBFrame.frame2.frame6
  pack configure .helpWindow.indexText.indexLBFrame.frame2.frame6.frame11 \
    -expand 1 \
    -fill both

  # pack master .helpWindow.indexText.helpTextFrame
  pack configure .helpWindow.indexText.helpTextFrame.scrollbar1 \
    -fill y \
    -side right
  pack configure .helpWindow.indexText.helpTextFrame.helpText \
    -expand 1 \
    -fill both

  # pack master .helpWindow.command
  pack configure .helpWindow.command.prompt \
    -side left
  pack configure .helpWindow.command.input \
    -expand 1 \
    -fill x \
    -side right

  # pack master .helpWindow.buttons
  pack configure .helpWindow.buttons.button7 \
    -expand 1 \
    -side left
  pack configure .helpWindow.buttons.button9 \
    -expand 1 \
    -side left
  pack configure .helpWindow.buttons.button10 \
    -expand 1 \
    -side left
  pack configure .helpWindow.buttons.button8 \
    -expand 1 \
    -side right

  # pack master .helpWindow
  pack configure .helpWindow.indexText \
    -expand 1 \
    -fill both
  pack configure .helpWindow.modeStatus \
    -fill x
  pack configure .helpWindow.command \
    -fill x
  pack configure .helpWindow.buttons \
    -fill x

  .helpWindow.indexText.helpTextFrame.helpText insert end {}
  .helpWindow.command.input insert end {}
  focus .helpWindow.indexText.helpTextFrame.helpText

  global HelpDir
  set index [file join $HelpDir hh.index]
  if {[file readable $index]} {
    global HelpList HelpIndex
    set HelpList {}
    set ifp [open $index r]
    while {[gets $ifp line] >= 0} {
      set indexKey [lindex $line 0]
      set fileInfo [lindex $line 1]
      set HelpIndex($indexKey) "$fileInfo"
      lappend HelpList "$indexKey"
      set HKL [split "$indexKey" {>}]
      set prefix [dup { } [expr ([llength $HKL] - 1) * 2]]
      .helpWindow.indexText.indexLBFrame.lbysFrame.lbFrame.indexLB insert end \
	"$prefix[lindex $HKL end]"
    }
    close $ifp
  }
# end of widget tree

}

proc dup {str count} {
# Function to dup a string.

  set dup {}
  for {set i 0} {$i < $count} {incr i} {append dup "$str"}
  return "$dup"
}

proc HelpBackTopic {} {
# Procedure to go ``back'' in the history list.

  global HelpHistoryList HelpHistoryListIndex
  if {$HelpHistoryListIndex > 0} {
    incr HelpHistoryListIndex -1
    HelpTopic [lindex $HelpHistoryList $HelpHistoryListIndex] 0
  }
}

proc HelpForwardTopic {} {
# Procedure to go ``forward'' in the history list.

  global HelpHistoryList HelpHistoryListIndex
  if {$HelpHistoryListIndex < [expr [llength $HelpHistoryList] - 1]} {
    incr HelpHistoryListIndex
    HelpTopic [lindex $HelpHistoryList $HelpHistoryListIndex] 0
  }
}

proc HelpTopic {{topic {}} {updateHistory 1}} {
# This procedure pops up a help dialog.
# <in> topic -- the topic to get help on.

  CreateHelpWindow
  global HelpList HelpIndex HelpDir HLinePattern 
  global HelpHistoryList HelpHistoryListIndex

  if {$updateHistory == 1} {
    if {$HelpHistoryListIndex >= 0} {
      set HelpHistoryList [lrange $HelpHistoryList 0 $HelpHistoryListIndex]
      lappend HelpHistoryList "$topic"
      incr HelpHistoryListIndex      
    } else {
      set HelpHistoryList [list "$topic"]
      set HelpHistoryListIndex 0
    }
  }

  set an [array names HelpIndex "*$topic"]
  if {[string length "$an"] == 0} {
    .helpWindow.modeStatus configure -text "$topic not found"
  } else {
    .helpWindow.indexText.helpTextFrame.helpText delete 1.0 end
    set an [lindex $an 0]
    set index [lsearch -exact $HelpList $an]
    .helpWindow.indexText.indexLBFrame.lbysFrame.lbFrame.indexLB see $index
    .helpWindow.indexText.indexLBFrame.lbysFrame.lbFrame.indexLB selection clear 0 end
    .helpWindow.indexText.indexLBFrame.lbysFrame.lbFrame.indexLB selection set $index
    set fileInfo [set HelpIndex($an)]
    set file [file join $HelpDir [lindex $fileInfo 0]]
    set fpos [lindex $fileInfo 1]
    set buffer {}
    if {[catch [list open $file r] fp]} {
      .helpWindow.indexText.helpTextFrame.helpText insert end "Can't load $topic: $fp"
      return
    }
    seek $fp $fpos start
    set headline [gets $fp]
    if {[regsub {^[0-9]+} "$headline" {} newheadline] > 0} {
      set headline [string trim "$newheadline"]
    }
    while {[gets $fp line] >= 0} {
      if {[regexp "$HLinePattern" "$line" whole d1 d2] > 0} {break}
      append buffer "\n$line"
    }
    close $fp
    
    HeaderFormat .helpWindow.indexText.helpTextFrame.helpText "$headline"
    BodyFormat .helpWindow.indexText.helpTextFrame.helpText "$buffer"
    .helpWindow.indexText.helpTextFrame.helpText mark set insert 1.0
    .helpWindow.indexText.helpTextFrame.helpText see 1.0
  }
}

proc HeaderFormat {text hline} {
# Procedure to format a header line.

  global tk_version
  if {$tk_version < 8.0} {
    regsub -nocase medium [$text cget -font] bold x
  } else {
    regsub -nocase normal [font actual [$text cget -font]] bold x
  }
  $text tag configure header -font "$x"
  $text insert end "$hline" header
}

proc BodyFormat {text body} {
# Procedure to format the body.

  global HelpDir
  $text tag configure link -foreground blue -underline 1
  set abspos 0
  while {[regexp -indices "\[<\{\[\]" "$body" ii] > 0} {
    set i [lindex $ii 0]
    set prefix [string range "$body" 0 [expr $i - 1]]
    if {[string compare "[string index $body $i]" {<}] == 0} {
      set j [string first {>} "$body"]
      $text insert end "$prefix" normal
      set link [string range "$body" [expr $i + 1] [expr $j - 1]]
      set body [string range "$body" [expr $j + 1] end]
      set pos [expr $abspos + $i]
      incr abspos [expr $j + 1]
      $text insert end "$link" [list link link$pos]
      $text tag bind link$pos <1> [list HelpTopic "$link"]
    } elseif {[string compare "[string index $body $i]" {[}] == 0} {
      set j [string first {]} "$body"]
      $text insert end "$prefix" normal
      set head [string range "$body" [expr $i + 1] [expr $j - 1]]
      set body [string range "$body" [expr $j + 1] end]
      set pos [expr $abspos + $i]
      incr abspos [expr $j + 1]
      $text insert end "$head" header
    } else {
      set j [string first "\}" "$body"]
      $text insert end "$prefix" normal
      set imagefile [file join $HelpDir \
			[string range "$body" [expr $i + 1] [expr $j - 1]]]
      set body [string range "$body" [expr $j + 1] end]
      set pos [expr $abspos + $i]
      image create photo himg$pos -format ppm -file $imagefile
      incr abspos [expr $j + 1]
      $text image create end -image himg$pos -align top
    }
  }
  $text insert end "$body" normal
}
    

proc BindTagsAll {} {
# Procedure to set up the XmTrackingLocate bind tag.

  BindTagsW .
}

proc BindTagsW {w} {
# Helper procedure to set up the XmTrackingLocate bind tag.

  if {[lsearch -exact [bindtags $w] XmTrackingLocateTag] < 0} {
    bindtags $w [concat XmTrackingLocateTag [bindtags $w]]
  }
  foreach c [winfo children $w] {
    BindTagsW $c
  }
}
  
proc XmTrackingLocate {widget cursor} {
# Procedure to implement Motif's XmTrackingLocate function.

  global XmTrackingLocateInfo
  BindTagsAll
  set tl [winfo toplevel $widget]
  set XmTrackingLocateInfo(cursor) "[$tl cget -cursor]"
  set XmTrackingLocateInfo(widget) {}
  set XmTrackingLocateInfo(grab) "[grab current $tl]"
  if {[string length "$XmTrackingLocateInfo(grab)"] > 0} {
    set XmTrackingLocateInfo(grabType) "[grab status $XmTrackingLocateInfo(grab)]"
  }
  $tl configure -cursor "$cursor"
  bind XmTrackingLocateTag <ButtonPress-1> "XmTrackingLocateClick $tl %X %Y;break"
  grab -global $tl
  tkwait variable XmTrackingLocateInfo(widget)
  grab release $tl
  if {[string length "$XmTrackingLocateInfo(grab)"] > 0} {
    if {"$XmTrackingLocateInfo(grabType)" == "global"} {
      grab set -global $XmTrackingLocateInfo(grab)
    } else {
      grab set $XmTrackingLocateInfo(grab)
    }
  }
  return $XmTrackingLocateInfo(widget)  
}

proc XmTrackingLocateClick {tl X Y} {
# XmTrackingLocate binding function.

  global XmTrackingLocateInfo 
  bind XmTrackingLocateTag <ButtonPress-1> {}
  $tl configure -cursor "$XmTrackingLocateInfo(cursor)"
  set XmTrackingLocateInfo(widget) "[winfo containing $X $Y]"
}
  


proc HelpContext {{widget .}} {
# This procedure pops up an ``On Context'' help dialog.

  set widget "[XmTrackingLocate $widget question_arrow]"
  if {[string length "$widget"] > 0} {
    HelpWindow $widget
  }
}

proc HelpWindow {{widget .}} {
# This procedure pops up help for the current toplevel.

  CreateHelpWindow

  set tl [winfo toplevel $widget]
  set tlClass [winfo class $tl]

  regsub \\$tl $widget tl$tlClass. widgetCL

  while {[regsub -all {\.\.} $widgetCL {.} widgetCL1] > 0} {
    set widgetCL $widgetCL1
  }
  while {[regsub -all {\.$}  $widgetCL {}  widgetCL1] > 0} {
    set widgetCL $widgetCL1
  }

  global HelpIndex

  set topicL [split $widgetCL {.}]
  while {[llength $topicL] > 0} {
    set topic [join $topicL {.}]
    set an [array names HelpIndex "*$topic"]
    if {[string length "$an"] > 0} break;
    set topicL [lrange $topicL 0 [expr [llength $topicL] - 2]]
  }
  if {[llength $topicL] > 0} {
    HelpTopic $topic
  } else {
    HelpTopic $widgetCL
  }
}




package provide RPGHelp 1.0