#
# Hyperhelp
# ----------------------------------------------------------------------
# Implements a help facility using html formatted hypertext files.
#
# ----------------------------------------------------------------------
#  AUTHOR: Kris Raney                   EMAIL: kraney@spd.dsccc.com
#
#  @(#) $Id: hyperhelp.itk,v 1.3 2006/09/11 20:35:55 irby Exp $
# ----------------------------------------------------------------------
#            Copyright (c) 1996 DSC Technologies Corporation
# ======================================================================
# Permission to use, copy, modify, distribute and license this software
# and its documentation for any purpose, and without fee or written
# agreement with DSC, is hereby granted, provided that the above copyright
# notice appears in all copies and that both the copyright notice and
# warranty disclaimer below appear in supporting documentation, and that
# the names of DSC Technologies Corporation or DSC Communications
# Corporation not be used in advertising or publicity pertaining to the
# software without specific, written prior permission.
#
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
# SOFTWARE.
# ======================================================================

#
# Acknowledgements:
#
# Special thanks go to Sam Shen(SLShen@lbl.gov), as this code is based on his
# help.tcl code from tk inspect.

#
# Default resources.
#
option add *Hyperhelp.width 575 widgetDefault
option add *Hyperhelp.height 450 widgetDefault
option add *Hyperhelp.modality none widgetDefault
option add *Hyperhelp.vscrollMode static widgetDefault
option add *Hyperhelp.hscrollMode static widgetDefault

#
# Usual options.
#
itk::usual Hyperhelp {
    keep -activebackground -activerelief -background -borderwidth -cursor \
         -foreground -highlightcolor -highlightthickness \
         -selectbackground -selectborderwidth -selectforeground \
         -textbackground
}
 
# ------------------------------------------------------------------
#                          HYPERHELP
# ------------------------------------------------------------------
class ::iwidgets::Hyperhelp {
    inherit iwidgets::Shell

    constructor {args} {}

    itk_option define -topics topics Topics {}
    itk_option define -helpdir helpdir Directory .
    itk_option define -title title Title "Help"

    public method showtopic {topic}
    public method followlink {link}
    public method forward {}
    public method back {}
    public method updatefeedback {n max}

    protected method _readtopic {file {anchorpoint {}}}
    protected method _pageforward {}
    protected method _pageback {}
    protected method _lineforward {}
    protected method _lineback {}
    protected method _fill_go_menu {}

    protected variable _history {}      ;# History list of viewed pages
    protected variable _history_ndx -1  ;# current position in history list
    protected variable _history_len 0   ;# length of history list
    protected variable _histdir -1      ;# direction in history we just came 
                                        ;# from
    protected variable _len 0           ;# length of text to be rendered
    protected variable _file {}         ;# current topic

    private variable _rendering 0       ;# flag - in process of rendering
}

#
# Provide a lowercased access method for the Scrolledlistbox class.
#
proc ::iwidgets::hyperhelp {pathName args} {
    uplevel ::iwidgets::Hyperhelp $pathName $args
}

# ------------------------------------------------------------------
#                        CONSTRUCTOR
# ------------------------------------------------------------------
body ::iwidgets::Hyperhelp::constructor {args} {
    itk_option remove iwidgets::Shell::padx iwidgets::Shell::pady

    #
    # Create a pulldown menu
    #
    itk_component add menubar {
      frame $itk_interior.menu -relief raised -bd 2
    } {
      keep -background -cursor
    }
    pack $itk_component(menubar) -side top -fill x

    itk_component add topicmb {
      menubutton $itk_component(menubar).topicmb -text "Topics" \
           -menu $itk_component(menubar).topicmb.topicmenu \
           -underline 0 -padx 8 -pady 2
    } {
      keep -background -cursor -font -foreground \
              -activebackground -activeforeground
    }
    pack $itk_component(topicmb) -side left

    itk_component add topicmenu {
      menu $itk_component(topicmb).topicmenu -tearoff no
    } {
      keep -background -cursor -font -foreground \
              -activebackground -activeforeground
    }

    itk_component add navmb {
      menubutton $itk_component(menubar).navmb -text "Navigate" \
          -menu $itk_component(menubar).navmb.navmenu \
          -underline 0 -padx 8 -pady 2
    } {
      keep -background -cursor -font -foreground \
             -activebackground -activeforeground
    }
    pack $itk_component(navmb) -side left

    itk_component add navmenu {
      menu $itk_component(navmb).navmenu -tearoff no
    } {
      keep -background -cursor -font -foreground \
              -activebackground -activeforeground
    }
    set m $itk_component(navmenu)
    $m add command -label "Forward" -underline 0 -state disabled \
         -command [code $this forward] -accelerator f
    $m add command -label "Back" -underline 0 -state disabled \
         -command [code $this back] -accelerator b
    $m add cascade -label "Go" -underline 0 -menu $m.go

    itk_component add navgo {
      menu $itk_component(navmenu).go -postcommand [code $this _fill_go_menu]
    } {
      keep -background -cursor -font -foreground \
              -activebackground -activeforeground
    }

    #
    # Create a scrolledhtml object to display help pages
    #
    itk_component add scrtxt {
      iwidgets::scrolledhtml $itk_interior.scrtxt \
           -linkcommand [code $this followlink] \
           -feedback [code $this updatefeedback]
    } {
        keep    -hscrollmode -vscrollmode -background -textbackground \
                -fontname -fontsize -fixedfont -link \
                -linkhighlight -borderwidth -cursor -sbwidth -scrollmargin \
                -width -height -foreground -highlightcolor -visibleitems \
                -highlightthickness -padx -pady -activerelief \
                -relief -selectbackground -selectborderwidth \
                -selectforeground -setgrid -wrap -unknownimage
    }
    pack $itk_component(scrtxt) -fill both -expand yes

    #
    # Bind shortcut keys
    #
    bind $itk_component(hull) <Key-f> "$this forward"
    bind $itk_component(hull) <Key-b> "$this back"
    bind $itk_component(hull) <Alt-Right> "$this forward"
    bind $itk_component(hull) <Alt-Left> "$this back"
    bind $itk_component(hull) <Key-space> [code $this _pageforward]
    bind $itk_component(hull) <Key-Next> [code $this _pageforward]
    bind $itk_component(hull) <Key-BackSpace> [code $this _pageback]
    bind $itk_component(hull) <Key-Prior> [code $this _pageback]
    bind $itk_component(hull) <Key-Delete> [code $this _pageback]
    bind $itk_component(hull) <Key-Down> [code $this _lineforward]
    bind $itk_component(hull) <Key-Up> [code $this _lineback]

    wm title $itk_component(hull) "Help"

    eval itk_initialize $args
}

# ------------------------------------------------------------------
#                             OPTIONS
# ------------------------------------------------------------------
 
# ------------------------------------------------------------------
# OPTION: -topics
#
# Specifies the topics to display on the menu. For each topic, there should
# be a file named <helpdir>/<topic>.html
# ------------------------------------------------------------------
configbody iwidgets::Hyperhelp::topics {
    set m $itk_component(topicmenu)
    $m delete 0 last
    foreach topic $itk_option(-topics) {
      if {[lindex $topic 1] == {} } {
        $m add radiobutton -variable topic \
          -value $topic \
          -label $topic \
          -command [list $this showtopic $topic]
      } else {
        if {[file pathtype $itk_option(-helpdir)] == "relative" } {
          set link [file join $itk_option(-helpdir) [lindex $topic 1]]
        } else {
          set link [lindex $topic 1]
        }
        $m add radiobutton -variable topic \
          -value [lindex $topic 0] \
          -label [lindex $topic 0] \
          -command [list $this followlink $link]
      }
    }
    $m add separator
    $m add command -label "Close Help" -underline 0 \
      -command "delete object $this"
}

# ------------------------------------------------------------------
# OPTION: -title
#
# Specify the window title.
# ------------------------------------------------------------------
configbody iwidgets::Hyperhelp::title {
    wm title $itk_component(hull) $itk_option(-title)
}

# ------------------------------------------------------------------
# OPTION: -helpdir
#
# Set location of help files
# ------------------------------------------------------------------
configbody iwidgets::Hyperhelp::helpdir {
	if {[file pathtype $itk_option(-helpdir)] == "relative" } {
		set $itk_option(-helpdir) [file join [pwd] $itk_option(-helpdir)]
	}
	set _history {}
	set _history_len 0
	set _history_ndx -1
	$itk_component(navmenu) entryconfig 0 -state disabled
	$itk_component(navmenu) entryconfig 1 -state disabled
	configure -topics $itk_option(-topics)
   
}

# ------------------------------------------------------------------
#                            METHODS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# METHOD: showtopic topic
#
# render text of help topic <topic>. The text is expected to be found in
# <helpdir>/<topic>.html
# ------------------------------------------------------------------
body iwidgets::Hyperhelp::showtopic {topic} {
  if ![regexp {(.*)#(.*)} $topic dummy topicname anchorpart] {
    set topicname $topic
    set anchorpart {}
  }
  if {$topicname == ""} {
    set topicname $_file
    set filepath $_file
  } else {
    set filepath [file join $itk_option(-helpdir) $topicname.html]
  }
  incr _history_ndx
  set _history [lrange $_history 0 [expr $_history_ndx - 1]]
  set _history_len [expr $_history_ndx + 1]
  lappend _history [list $topicname $filepath $anchorpart]
  _readtopic $filepath $anchorpart
}

# ------------------------------------------------------------------
# METHOD: followlink link
#
# Callback for click on a link. Shows new topic.
# ------------------------------------------------------------------
body iwidgets::Hyperhelp::followlink {link} {
  if ![regexp {(.*)#(.*)} $link dummy filepart anchorpart] {
    set filepart $link
    set anchorpart {}
  }
  if {$filepart != "" && [file pathtype $filepart] == "relative"} {
    set filepart [file join [$itk_component(scrtxt) pwd] $filepart]
    set hfile $filepart
  } else {
    set hfile $_file
  }
  incr _history_ndx
  set _history [lrange $_history 0 [expr $_history_ndx - 1]]
  set _history_len [expr $_history_ndx + 1]
  lappend _history [list [file rootname [file tail $hfile]] $hfile $anchorpart]
  _readtopic $filepart $anchorpart
}

# ------------------------------------------------------------------
# METHOD: forward
#
# Show topic one forward in history list
# ------------------------------------------------------------------
body iwidgets::Hyperhelp::forward {} {
    if {$_rendering || ($_history_ndx+1) >= $_history_len} return
    incr _history_ndx
    eval _readtopic [lrange [lindex $_history $_history_ndx] 1 end]
}

# ------------------------------------------------------------------
# METHOD: back
#
# Show topic one back in history list
# ------------------------------------------------------------------
body iwidgets::Hyperhelp::back {} {
    if {$_rendering || $_history_ndx <= 0} return
    incr _history_ndx -1
    set _histdir 1
    eval _readtopic [lrange [lindex $_history $_history_ndx] 1 end]
}

# ------------------------------------------------------------------
# METHOD: updatefeedback remaining
#
# Callback from text to update feedback widget
# ------------------------------------------------------------------
body iwidgets::Hyperhelp::updatefeedback {n max} {
    set win "[$itk_interior.feedbackshell childsite].helpfeedback"
    $win configure -steps $max
    $win step $n
    update idletasks
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _readtopic 
#
# Read in file, render it in text area, and jump to anchorpoint
# ------------------------------------------------------------------
body iwidgets::Hyperhelp::_readtopic {file {anchorpoint {}}} {
  if {$file != ""} {
    if {[string compare $file $_file] != 0} {
      if {[catch {set f [open $file r]} err]} {
        incr _history_ndx $_histdir
        set _history_len [expr $_history_ndx + 1]
        set _histdir -1
        set m $itk_component(navmenu)
        if {($_history_ndx+1) < $_history_len} {
          $m entryconfig 0 -state normal
        } else {
          $m entryconfig 0 -state disabled
        }
        if {$_history_ndx > 0} {
          $m entryconfig 1 -state normal
        } else {
          $m entryconfig 1 -state disabled
        }
        error $err
      }
      set _file $file
      set txt [read $f]
      iwidgets::shell $itk_interior.feedbackshell \
          -title "Rendering HTML" -padx 1 -pady 1
      iwidgets::Feedback [$itk_interior.feedbackshell childsite].helpfeedback \
          -steps [set _len [string length $txt]] \
          -labeltext "Rendering HTML" -labelpos n
      pack [$itk_interior.feedbackshell childsite].helpfeedback
      $itk_interior.feedbackshell center $itk_interior
      $itk_interior.feedbackshell activate
      set _remaining $_len
      set _rendering 1
      if [catch {$itk_component(scrtxt) render $txt [file dirname $file]} err] {
          if [regexp "</pre>" $err] {
            $itk_component(scrtxt) render "<tt>$err</tt>"
          } else {
            $itk_component(scrtxt) render "<pre>$err</pre>"
          }
      }
      wm title $itk_component(hull) "Help: $file"
      delete object [$itk_interior.feedbackshell childsite].helpfeedback
      delete object $itk_interior.feedbackshell
      set _rendering 0
    }
  }
  set m $itk_component(navmenu)
  if {($_history_ndx+1) < $_history_len} {
    $m entryconfig 0 -state normal
  } else {
    $m entryconfig 0 -state disabled
  }
  if {$_history_ndx > 0} {
    $m entryconfig 1 -state normal
  } else {
    $m entryconfig 1 -state disabled
  }
  if {$anchorpoint != "{}"} {
    $itk_component(scrtxt) import -link #$anchorpoint
  } else {
    $itk_component(scrtxt) import -link #
  }
  set _histdir -1
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _fill_go_menu
#
# update go submenu with current history
# ------------------------------------------------------------------
body ::iwidgets::Hyperhelp::_fill_go_menu {} {
    set m $itk_component(navgo)
    catch {$m delete 0 last}
    for {set i [expr $_history_len - 1]} {$i >= 0} {incr i -1} {
      set topic [lindex [lindex $_history $i] 0]
      set filepath [lindex [lindex $_history $i] 1]
      set anchor [lindex [lindex $_history $i] 2]
      $m add command -label $topic \
         -command [list $this followlink $filepath#$anchor]
    }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _pageforward
#
# Callback for page forward shortcut key
# ------------------------------------------------------------------
body iwidgets::Hyperhelp::_pageforward {} {
    $itk_component(scrtxt) yview scroll 1 pages
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _pageback
#
# Callback for page back shortcut key
# ------------------------------------------------------------------
body iwidgets::Hyperhelp::_pageback {} {
    $itk_component(scrtxt) yview scroll -1 pages
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _lineforward
#
# Callback for line forward shortcut key
# ------------------------------------------------------------------
body iwidgets::Hyperhelp::_lineforward {} { 
    $itk_component(scrtxt) yview scroll 1 units 
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _lineback
#
# Callback for line back shortcut key
# ------------------------------------------------------------------
body iwidgets::Hyperhelp::_lineback {} { 
    $itk_component(scrtxt) yview scroll -1 units 
}