#!/bin/sh 
# \
exec /usr/pkg/bin/wish "$0" "$@"

package provide app-tcltutor 1.0
package require Tk

;# NAME:   TclTutor.tcl
;# AUTHOR: Clif Flynt
;# DATE:   Apr 22, 2000
;# DESC:   
;#         
;#
;# PARAMETERS:  Tutor indices can be set from cmd line.
;#
;# RCSID: $Header: /home/cvs/TclTutor3/TclTutor.tcl,v 1.11 2014/03/20 14:27:08 clif Exp $
;#
;# This code copyright 2000 to Clif Flynt
;# 8888 Black Pine Ln
;# Whitmore Lake, MI  48189
;# clif@cflynt.com
;# All Rights Reserved.
set Tutor(revision) {$Header: /home/cvs/TclTutor3/TclTutor.tcl,v 1.11 2014/03/20 14:27:08 clif Exp $}

# console show

# Clear existing options - we'll set what we want.
option clear

# Delete existing windows - while debugging from tkcon.tcl.

foreach ch [winfo children .] {
    destroy $ch
}

#
# Check for obsolete Wish interpreters
#

if {$tcl_version < 8.4} {
    tk_messageBox -type ok \
        -message "Your Wish Interpreter ($tk_version) is too old.\n You need to get 8.4 or more recent from www.activestate.com"
    exit
}

################################################################
# proc Debug {arg}--
#    Display debug messages if Tutor(debug) is != 0
# Arguments
#   A string to display
# 
# Results
#   A string is printed to stdout on Unix boxes, and put into a 
#   scrolling textwidget in a toplevel on Windows/Mac platforms
# 
proc Debug {arg} {
    global Tutor tcl_platform

    if {$Tutor(debug) == 0} {return}

    switch $tcl_platform(platform) {
      "unix"	{
          puts "$arg"
      }
      "windows" 	-
      "macintosh" 	-
      "mac"	{
          if {(![info exists Tutor(debugWin)]) || 
	      (![winfo exists $Tutor(debugWin)])} {
		set r 0
                toplevel .debug -background $Tutor(opt,Frame.background)
		set t .debug.txt

                text $t -yscrollcommand "${t}_scroll set"
                scrollbar ${t}_scroll -command "$t yview"
                grid $t -row $r -column 0 -sticky news 
                grid ${t}_scroll -row $r -column 10 -sticky ns
                grid rowconfigure . $r -weight 10
                grid columnconfigure . $r -weight 10
                set Tutor(debugWin) $t
	  }
      $Tutor(debugWin) insert end "$arg\n"
      }
      default	{
              tk_messageBox -message \
       	      "Huh, no support for $tcl_platform(platform)" -type ok
	      exit
      }
   }
}

################################################################
# proc parseArgs {stateVar {throwError 1}}--
#    Parses $argv into a state array.
#    looks for arguments of the form -key val1 ?val2 ... valn?
#    and assigns them as ArrayName(key) "val1 ?val2 ... valn?"
#     Keys must have a default value to be assigned.
#     By default, an error is thrown if an undefaulted key is found.
#     If throwError == 0, then the undefaulted keays are appended
#        into a list of errors, which will be returned.
# Arguments
#   stateVar    The name of the associative array to have key/values set
#   throwError  Optional 0 to turn off errors and return a list.
# 
# Results
#   Any default values in stateVar are replaced with new values from the
#       command line.
# 

proc parseArgs {stateVar {throwError 1}} {
    global argv
    upvar $stateVar stateArray

    set errs ""
    
    foreach arg $argv {
        if {![string first "-" $arg]} {  
            set index [string range $arg 1 end]
            if {![info exists stateArray($index)]} {
                if {$throwError} {
                    error "No default for ${stateVar}($index)"
                } else {
                    lappend errs "No default for ${stateVar}($index)"
                }
            }
            set cmd set
        } else {
            if {[info exists cmd]} {
                $cmd stateArray($index) $arg
                set cmd lappend
            }
        }
    }
    return $errs
}


# Set platform dependant paths.

    switch $tcl_platform(platform) {
      "unix"	{
            set Tutor(sourceHome) /usr/pkg/share/tcltutor
            set Tutor(lessonHome) /usr/pkg/share/tcltutor/lesson
	    set Tutor(rcHome) $env(HOME)
            set Tutor(rcfile) [file join $Tutor(rcHome) .tcltutorrc]
            set Tutor(logFileName) [file join $Tutor(rcHome) .tcltutoract]
	    set Tutor(fontMod) -4
       }
      "windows" 	{
            set Tutor(sourceHome) [file attributes [file dirname $argv0] -shortname]
            set Tutor(lessonHome) [file attributes [file dirname $argv0] -shortname]/lesson
	    set Tutor(rcHome) [file dirname $argv0]
            if {[info exists starkit::topdir]} {
	      set Tutor(rcHome) [file dirname $Tutor(rcHome)]
            set Tutor(rcfile) [file join $Tutor(rcHome) tcltutor.rc]
	    }

            set Tutor(logFileName) [file join $Tutor(rcHome) tcltutor.act]
	    set Tutor(fontMod) -5
      }
      "macintosh" -
      "mac"	{
            set Tutor(sourceHome) /usr/pkg/share/tcltutor
            set Tutor(lessonHome) /usr/pkg/share/tcltutor/lesson
	    set Tutor(rcHome) [file dirname $argv0]
            set Tutor(rcfile) [file join $Tutor(rcHome) tcltutor.rc]
            set Tutor(logFileName) [file join $Tutor(rcHome) tcltutor.act]
	    set Tutor(fontMod) -5
       }
      default	{
          tk_messageBox -type ok \
	      message "WHAT: NO Support for: $tcl_platform(platform)"
	  exit;
      }
   }

set Tutor(noSaves) {sourceHome lessonHome logUsage mailUsage}

#
#   check if a Scripted Document 
#


if {[info exists starkit::topdir]} {
    set Tutor(sourceHome) [file join $starkit::topdir lib]
    set Tutor(lessonHome) [file join $starkit::topdir lesson]
    # The regsub is to get rid of a weird "-psn_0_123456" cmd line arg on MAC
    regsub -all -- {-[^ ]*} $argv {} argv
    if {[llength $argv] > 0} {
      set if [open [lindex $argv 0] r]
      set d [read $if]
      close $if
      eval $d
    }
} 


# Initialize the various state indices.

set Tutor(version) "3.0 beta 7"
set Tutor(debug) 0


set Tutor(maxHT) [expr [winfo screenheight .] -40]
set Tutor(maxWD) [expr [winfo screenwidth .] -20]

set Tutor(courseName) Tcl_English
set Tutor(courseLevel) 1
set Tutor(Tcl.lessonFile) Tcl0.lsn
set Tutor(geometry) "500x400"
set Tutor(unique) 0
set Tutor(interpreter) interp
set Tutor(lessonInfo) "Welcome to TclTutor :: Click Help"
set Tutor(fontSize) $Tutor(fontMod)

set Tutor(logFile) ""
set Tutor(logUsage) 0
set Tutor(mailUsage) 0
set Tutor(logCount) 0

set Tutor(terseness.0) Expert
set Tutor(terseness.1) User
set Tutor(terseness.2) Beginner

set Tutor(errorBackground)	     yellow

# set Tutor(opt,Button.background)     #38e
# set Tutor(opt,Menubutton.background) #38e
# set Tutor(opt,Frame.background)      #bff
# set Tutor(opt,Label.background)      #bff
# set Tutor(opt,Canvas.background)     #bff
# set Tutor(opt,Scrollbar.background)  #bff
# set Tutor(opt,Text.background)       #9df
# 
# set Tutor(opt,Button.font) {helvetica 10}
# set Tutor(opt,Menubutton.font) {helvetica 10}
# set Tutor(opt,Label.font) {helvetica 10}
# 
# set Tutor(opt,Button.foreground)     #000
# set Tutor(opt,Menubutton.foreground) #000
# set Tutor(opt,Frame.foreground)      #000
# set Tutor(opt,Label.foreground)      #000
# set Tutor(opt,Canvas.foreground)     #000
# set Tutor(opt,Scrollbar.foreground)  #000
# set Tutor(opt,Text.foreground)       #000
# 
# set Tutor(opt,Button.highlightbackground)     #000
# set Tutor(opt,Menubutton.highlightbackground) #000
# set Tutor(opt,Frame.highlightbackground)      #000
# set Tutor(opt,Label.highlightbackground)      #000
# set Tutor(opt,Canvas.highlightbackground)     #bff
# set Tutor(opt,Scrollbar.highlightbackground)  #000
# set Tutor(opt,Text.highlightbackground)       #000
# set Tutor(wrapNamespace) ""
# 
# These group widgets that need the same foreground/background values
#  into single units.
 
# set Tutor(grp.Buttons) {Button Menubutton}
set Tutor(grp.Labels) {Frame Canvas Label Scrollbar}
set Tutor(grp.Text) {Text}

wm title . "TclTutor   $Tutor(version)"

# Parse once to set home, and rcfile if necessary

parseArgs Tutor 0

# Save Tutor, and load .tcltutorrc.  If it's an old version,
#  wipe everything from the rc file and restore the original.

array set tmp [array get Tutor]
catch {source $Tutor(rcfile)}
if {![info exists Tutor(revision)]} {
  unset Tutor
  array set Tutor [array get tmp]
}
unset tmp

# Redo parse to let command line overrrule settings from rcfile

parseArgs Tutor

# Load the script libraries.
#  Using packages would be good, but would require some more installation
#  overhead.  This will work without making things complex.

foreach f [list options.tcl htmllib.tcl simpleTop.tcl balloon.tcl images.tcl] {
    source [file join $Tutor(sourceHome) $f]
}

# Get the color for frames, and configure the primary window for that color.

frame .f
set Tutor(background) [option get .f background Frame ]
. configure -background $Tutor(background)
destroy .f

#
# Local definitions of procedures win over those in libraries.
#

################################################################
# proc getLessonTitles {}--
#    Searches through the lesson directory for lessons that match the
#    current lesson type, and finds the titles for each lesson.
# Arguments
#   None
# 
# Results
#   Returns a list of lesson number, name and title.

proc getLessonTitles {} {
  global Tutor
  
    set filelist [glob \
       [file join $Tutor(lessonHome) $Tutor(courseName) $Tutor(courseName)\[0-9\]\[0-9\].lsn] \
        [file join $Tutor(lessonHome) $Tutor(courseName) $Tutor(courseName)\[0-9\].lsn] ]

    foreach file $filelist {
      set infl [open $file ]
      set gottitle 0;
      while {!$gottitle} {
        set len [gets $infl line]

        if {$len > 2} {
          if {[string first ":TITLE:" $line] >= 0} {
	    set gottitle 1;
	    set line [string range $line 7 end]
	    set Tutor(lsn.title) $line
            regsub ".*$Tutor(courseName)(\[0-9\]*).lsn" $file {\1} num
	    lappend titlelist [list $num [file tail $file] $Tutor(lsn.title)]
	  }
	}
      }
    close $infl;
    }

  set Tutor(lessonList) [lsort -command cmpLessonLists $titlelist]

  return $titlelist;
}

################################################################
# proc getCourseTitles {}--
#    Return a list of available courses for creating the menu
# Arguments
#   NONE
# 
# Results
#   No Side effects
# 
proc getCourseTitles {} {
  global Tutor

  foreach f [glob [file join $Tutor(lessonHome)  *]] {
    if {[string equal "directory" [file type $f]]} {
      set cName [file tail $f]
      lappend titlelist [list {} [file join $f $cName.cfg] $cName]
    }
  }

  set Tutor(courseList) $titlelist;
  return $titlelist;
} 

################################################################
# proc count {start end {incr 1}}--
#    Return a list of numbers from start to end, 
# Arguments
#   start	The first value to be returned
#   end		The last value will be less than this
#   incr	What to increment by - defaults to 1
# 
# Results
#   No Side Effects
# 
proc count {start end {incr 1}} {
    for {set i $start} {$i < $end} {incr i $incr} {
        lappend rslt $i
    }
    return $rslt
}



################################################################
# proc FillMenu {menu list cmd}--
#    Fills a cascading menu from a list of lessons or courses
# Arguments
#   menu	The menu widget to have items added to it
#   list	A list of courses/lessons
#   cmd		The command to evaluate when a command menu is selected.
# Results
#   

proc FillMenu {menu list cmd} {
  global Tutor

  destroy $menu 
  menu $menu

  set result 1;
  
  
  set length [llength $list]
  for {set i 0} {$i < $length} {incr i 10} {
     set last [expr $i + 10];
     if {$last > $length} {set last $length}

     if {$length > 10} {
        $menu add cascade -label "Lesson $i - [expr $last-1]" -menu $menu.lst$i
	set use [menu $menu.lst$i]
	} else {
	  set use $menu
     }

     for {set j $i} {$j < $last} {incr j} {
        set lesson [lindex $list $j]
        foreach {num file title} $lesson {}
	if {[string length $num] > 0} {
	    $use add command -label "$num: $title" -command "$cmd $file"
	} else {
	    $use add command -label "$title" -command "$cmd $file"
	}
     }
  }
}

################################################################
# proc selectCourse {cfgFileName}--
#    The procedure evaluated when a course is selected from the
#    "Select Course" menu
# Arguments
#   cfgFileName		The name of the configuration file to source.
# 
# Results
#   A new config file is sourced, the current lesson is loaded for 
#   that course.
# 
proc selectCourse {cfgFileName args} {
    global Tutor
    source $cfgFileName

    set Tutor(courseName) [file root [file tail $cfgFileName]]

    getLessonTitles
    FillMenu $Tutor(fileMenu).file.lessons $Tutor(lessonList) showLesson

    if {![info exists Tutor($Tutor(courseName).lessonFile)]} {
        set Tutor($Tutor(courseName).lessonFile) \
	    "$Tutor(courseName)0.lsn"
    }

    showLesson $Tutor($Tutor(courseName).lessonFile)
}

################################################################
# proc cmpLessonLists {a b}--
#    Compares two lesson lists - used to sort the lists
# Arguments
#   a, b	Two lesson lists.
# 
# Results
#   
# 
proc cmpLessonLists {a b} {
    return [expr [lindex $a 0] > [lindex $b 0]]
}

################################################################
# proc readLesson {lessonFilename}--
#    Read and parse a lesson.
# Arguments
#   lessonFileName	The name of the lesson file to read
# 
# Results
#   Tutor indices lsn* (0, 1, 2, code, setup) are initialized from
#   the file. 
# 
proc readLesson {lessonFilename} {
    global Tutor tcl_platform

  set fail [catch {open \
      [file join $Tutor(lessonHome) $Tutor(courseName) $lessonFilename]} infl]
  if {$fail} {
      global errorInfo
      Debug "Can't open [file join $Tutor(lessonHome) $lessonFilename]"
      Debug $errorInfo
  }
  foreach t [array names Tutor lsn.*] {
      set Tutor($t) ""
  }
  
  set Tutor(lsn.codeMod) ""
  set Tutor(lsn.setup) ""
  
  while {[set len [gets $infl line]] >= 0} {

      set save 1

      if {[regexp {:LESSON_TEXT_START_LEVEL ([0-9]):} $line m1 level]} {
          regsub {:LESSON_TEXT_START_LEVEL [0-9]:} $line "" line
	  set dest "lsn.$level"
	  set save 0
      }
      if {[regsub {:TEXT_END:} $line "" line]} {
          set dest "none"
	  set save 0
      }

      if {[regsub {:CODE_START:} $line "" line]} {
          set dest "lsn.code"
	  set save 0
	  eval $Tutor(lsn.setup)
      }

      if {[regsub {RCSID:} $line "RCSID:" line]} {
          set dest "none"
	  set save 0
      }

      if {[regsub {::CMD::} $line "" line]} {
          set dest "lsn.setup"
      }

      if {[regsub ":TITLE:" $line "" line]} {
          set dest "none"
      }
      
      if {$save} {
          if {[string match $dest "lsn.code"]} {
              foreach cmd $Tutor(lsn.codeMod) {
	          eval $cmd
	      }
	  }
          append Tutor($dest) "$line\n"
      }
      
  }

  close $infl

}

################################################################
# proc showLesson {lessonFilename}--
#    Loads a lesson file (invoking readLesson) and displays the
#    contents of the appropriate level, code, etc.
# Arguments
#   lessonFilename	The name of the lessonfile to display
# 
# Results
#   The display is updated to reflect the new lesson.
#   Tutor(lsn*) is updated.
#   Tutor(lessonInfo) is updated to reflect new lesson
# 
proc showLesson {lessonFilename} {
    global Tutor

    set Tutor($Tutor(courseName).lessonFile) $lessonFilename

    set list [lindex $Tutor(lessonList) [getLessonIndex]]
    foreach {num file title} $list {}
    set Tutor(lessonInfo) "#$num: $title   ---   Level: $Tutor(terseness.$Tutor(courseLevel))"
    
    logUsage "Lesson: $Tutor(courseName) [file tail $lessonFilename] Verbosity: $Tutor(courseLevel)"
    
    readLesson $lessonFilename
    
    $Tutor(lesson) configure -state normal

    foreach b [list runexample nextlesson previouslesson] {
#        .mbf entryconfigure $Tutor(button.$b) -state disabled
        $Tutor(button.$b) configure -state disabled
    }

    foreach t [list lesson code output] {
        $Tutor($t) delete 0.0 end
    }

    HMparse_html $Tutor(lsn.$Tutor(courseLevel)) "HMrender $Tutor(lesson) "
    
    $Tutor(code) insert 0.0 $Tutor(lsn.code)

    $Tutor(lesson) configure -state disabled

    foreach b [list runexample nextlesson previouslesson] {
        #.mbf entryconfigure $Tutor(button.$b) -state normal
        $Tutor(button.$b) configure -state normal
    }
    
}

################################################################
# proc setOptions {}--
#    Finds all the State variables associated with widget options, and
#    does the appropriate "option add "  commands.
# Arguments
#   No Options
# 
# Results
#   The default foreground/background colors are set using the option,
#   command, so the widget creating commands don't need tons of 
#   -foo bar settings.
# 
proc setOptions {} {
    global Tutor

    foreach i [array names Tutor opt*] {
        regsub "opt," $i "*" id
        option add $id $Tutor($i)
    }
}


################################################################
# proc createDisplay {}--
#    Generates the 3 window display
# Arguments
#   None
# 
# Results
#   The primary window gets tons of widgets and windows.
# 
proc createDisplay {} {
    global Tutor
    global Scalers
    global tcl_platform
    
    setOptions
    
    set row 0
    
    wm geometry . $Tutor(geometry)
    wm geometry . +2+2
    update idle;
    set h [winfo height .]
    set pixHt [expr {$h/3}]

    set bfrm [labelframe .bfr]
    set tbfrm [labelframe .bfr.tbfrm]

    grid .bfr -row [incr row] -column 0 -sticky news

    panedwindow .pn -orient vertical -handlesize 10
    grid .pn -row [incr row] -column 0 -sticky news
    grid rowconfigure . $row -weight 1
    grid columnconfigure . 0 -weight 1
    
    set sash -1
    set ypos $pixHt

    foreach l {lesson code output} {
      set t [labelframe .$l -text [string totitle $l] -height [expr $h/4]]
      .pn add $t
      # puts [.pn paneconfigure $t ]
      set w [text $t.txt -yscrollcommand "$t.ysb set" -wrap word]
      scrollbar $t.ysb -command "$w yview"
      grid rowconfigure $t 0 -weight 1
      grid columnconfigure $t 0 -weight 1
      grid $w -row 0 -column 0 -sticky news
      grid $t.ysb -row 0 -column 1 -sticky ns
      set Tutor($l) $w
      bind $Tutor($l) <Double-Button-1> {+
			showManEntry %W %x %y
			};

      if {$sash >= 0} {
        .pn sash place $sash 500 $ypos
        incr ypos $pixHt
      }
      incr sash
      update idle;
    }
    
    HMinit_win .lesson.txt

    set mbf [menubutton $bfrm.file -menu $bfrm.file.file -text "File"]
    set Tutor(fileMenu) $mbf
    menu $mbf.file
    pack $mbf -side left
    
    getLessonTitles

    $mbf.file add cascade -label "Lessons" -menu $mbf.file.lessons 
    FillMenu $mbf.file.lessons $Tutor(lessonList) showLesson
    
    $mbf.file add cascade -label "Courses" -menu $mbf.file.courses
    FillMenu $mbf.file.courses [lsort [getCourseTitles]] selectCourse
    
    foreach l [list "Set Font Size" "Set Colors" "Reset Example" "Exit"] {
        regsub -all " " $l "" l2
        $mbf.file add command -label $l -command $l2
    }
    
    if {0 && [string match $tcl_platform(platform) "unix"]} {
        if {$Tutor(logUsage)} {
           $mbf.file add command -label "Disable activity log" -command {set Tutor(logUsage) 0}
         } else {
           $mbf.file add command -label "Enable activity log" -command {set Tutor(logUsage) 1}
	}

        if {$Tutor(mailUsage)} {
           $mbf.file add command -label "Disable mailing log" -command {set Tutor(mailUsage) 0}
	 } else {
           $mbf.file add command -label "Enable mailing log" -command {set Tutor(mailUsage) 1}
	}
    }

    set mbf [menubutton $bfrm.terse -menu $bfrm.terse.terse -text "Terseness"]
    menu $mbf.terse
    pack $mbf -side left
    
    foreach n [count 0 3] t [list Beginner "User" "Expert"] {
        $mbf.terse add command -label $t -command "set Tutor(courseLevel) [expr 2 - $n]; showLesson \$Tutor(\$Tutor(courseName).lessonFile)"
    }

    set col 2
    
#    pack $tbfrm -side left -expand y -fill x
    pack $tbfrm -side left -padx [expr {int( [winfo width .]/5)}]

    foreach l {"Previous Lesson" "Next Lesson" "Run Example" } \
          im {im:prev im:next im:run} {
      regsub " " $l  "" c
      set w [button $tbfrm.b_$c -image $im -command $c -height 18 -width 18]
      pack $w -side left -fill y -expand y
      set_balloon $w $l
      set Tutor(button.[string tolower $c]) $w
    }

    set mbf [menubutton $bfrm.help -menu $bfrm.help.help -text "Help"]
    menu $mbf.help
    pack $mbf -side right
    
    foreach n [count 0 2] t [list Help About] {
        $mbf.help add command -label $t -command "displayHtmlFile \
	    [file join $Tutor(lessonHome) [string tolower $t].html]"
    }

    
    label .lessoninfo -textvar Tutor(lessonInfo) -width 80
    grid .lessoninfo -row [incr row] -column 0 -sticky ew
    
    setFonts
}

################################################################
# proc SaveState {}--
#    Saves the contents of the Tutor state array var.
# Arguments
#   NONE
# 
# Results
#   An rcfile is opened, and new data put into it.
# 
proc SaveState {} {
    global Tutor
    
    # Get rid of things we shouldn't save:
    foreach index $Tutor(noSaves) {
        unset Tutor($index)
    }

    # Remember where and how large this window was
    set Tutor(geometry) [winfo geometry .]

    # Clear the log file - this channel won't be here when we start again.
    set Tutor(logFile) ""
    
    # And dump the state information.
    set of [open $Tutor(rcfile) "w"]

    puts $of "array set Tutor [list [array get Tutor]]"
    close $of
    catch {
      # If windows, this succeeds. If not Windows it doesn't matter.
      file attributes $Tutor(rcfile) -hidden 1
    }
}

################################################################
# proc Exit {}--
#    Blow this popsicle stand
# Arguments
#   none
# 
# Results
#   Saves state, and exits
# 
proc Exit {} {
  logUsage "EXIT"
  SaveState
  exit
}

################################################################
# proc getLessonIndex {}--
#    Finds a lesson by file name, and 
#    returns the index of a lesson in the lesson list
# Arguments
#   NONE
# 
# Results
#   No side effects
# 
proc getLessonIndex {} {
    global Tutor

    set index [lsearch $Tutor(lessonList) "*[file tail $Tutor($Tutor(courseName).lessonFile)]*"]
    return $index 
}

################################################################
# proc NextLesson {}--
#    Load the next lesson
# Arguments
#   none
# 
# Results
#   Loads the next lesson.  All Tutor(lsn*) are updated.
# 
proc NextLesson {} {
    global Tutor
    
    set index [getLessonIndex]

    incr index;
    if {$index >= [llength $Tutor(lessonList)]} {
        incr index -1
    }
    set l [lindex $Tutor(lessonList) $index]

    set Tutor($Tutor(courseName).lessonFile) [lindex $l 1]
    showLesson [lindex $l 1]
}

################################################################
# proc PreviousLesson {}--
#    Load the Previous lesson
# Arguments
#   none
# 
# Results
#   Loads the Previous lesson.  All Tutor(lsn*) are updated.
# 
proc PreviousLesson {} {
    global Tutor
    
    set index [getLessonIndex]

    incr index -1;
    if {$index < 0} {
        incr index 1
    }
    set l [lindex $Tutor(lessonList) $index]

    set Tutor($Tutor(courseName).lessonFile) [lindex $l 1]
    showLesson [lindex $l 1]
}




################################################################
# proc dummyputs {args}--
#    A puts for the slave interpreter on Windows or Macs
# Arguments
#   args	The arguments that you'd give to puts
# 
# Results
#   If 'normal' puts, copies the output to global var "output"
#   If going to a pipe, it sends the output to the pipe via 'realputs'

proc dummyputs {args} {
  global Tutor child

#   append Tutor(example.Output) "CMD IS: $args"

  if {([llength $args] > 3) || ([llength $args] < 1)} {
    error "bad argument : should be puts ?-nonewline? ?stream? text \NOT: $args"
    }

   switch "[llength $args]" {
   {1} {
       set args [lindex $args 0]
       append Tutor(example.Output) "$args\n"  
       #   To debug in standalone mode.
       # $child eval [list realputs $args]
       }
   {2} {
       if {[string match "-nonewline" [lindex $args 0]]} {
         set args [lindex $args 1]
         append Tutor(example.Output) "$args"
       } else {
         $child eval realputs $args
        }
    }   
   {3} {
       if {([string match "-nonewline" [lindex $args 0]]) ||
           ([string match "nonewline" [lindex $args 2]])} {
         $child eval realputs $args
        } else {
        error "bad argument : should be puts ?-nonewline? ?stream? text \NOT: $args"
        }
   }
   default {
        error "DFLT: bad argument : should be puts ?-nonewline? ?stream? text \NOT: $args"
   }
 }  
}   

################################################################
# proc RunExample {}--
#    Runs the code in the example code window.
#    Reports and displays errors as best it can.
# Arguments
#   NONE
# 
# Results
#   New data is displayed in Tutor(lsn.output).
#   code window may have a highlighted section if there are errors.
# 

proc RunExample {} {
    global Tutor argv argv0 argc tk_version errorInfo child
    $Tutor(output) delete 0.0 end;
    set Tutor(example.Status) 0;
    set Tutor(example.Output) ""

    $Tutor(code) tag delete BAD

    if {![string match $Tutor(interpreter) "interp"]} {
       runExternal
       return
    } 

  set txt [subst "set argv0 \"$argv0\";\n"]
  append txt [subst "set argv \"$argv\";\n"]
  append txt [subst "set argc $argc;\n"]

  append txt "global argv argv0 env argc;\n"
  append txt [$Tutor(code) get 0.0 end]
  
  set child [interp create]

  if {[string match [string tolower $Tutor(courseName)] "tk"]} {
    load $Tutor(libTk) tk $child
    }
  

  $child eval rename puts realputs
  $child alias puts dummyputs
  $child eval {
    proc parray {a {pattern *}}  {
      upvar 1 $a array
      if {![array exists array]} {
  	error "\"$a\" isn't an array"
      }
      set maxl 0
      set names [lsort [array names array $pattern]]
      foreach name $names {
  	if {[string length $name] > $maxl} {
  	    set maxl [string length $name]
  	}
      }
      set maxl [expr {$maxl + [string length $a] + 2}]
      foreach name $names {
  	set nameString [format %s(%s) $a $name]
  	puts [format "%-*s = %s" $maxl $nameString $array($name)]
      }
    }
  }

proc killChildInterp.$child {} " \
      update idle; \
      $child eval update idle; \
      interp delete $child; "

  $child alias exit "killChildInterp.$child"

  set errorInfo ""
  
  set cmd ""

  foreach l [split $txt "\n"] {  
    append cmd "$l\n"
    if {[info complete $cmd]} {
      set fail [evalNdisplay $cmd $child]
      set Tutor(example.Output) ""
      set cmd ""
      if {$fail} {
          break;
	  }
    }
  }

  if {![string match $cmd ""]} {
    set fail [evalNdisplay $cmd $child]
  }

  if {$fail} {
      logUsage "Run Code: error"
  } else {
      logUsage "Run Code: OK"
  }
}

################################################################
# proc evalNdisplay {cmd child}--
#    Evaluate a chunk of code, and display output.
#    If an error occurs, parse the error output
# Arguments
#   cmd		The Tcl command to evaluate.
#   child	The child interpreter
# 
# Results
#   May change the display if there is an error or generated output.
# 
proc evalNdisplay {cmd child} {
    global Tutor argv argv0 argc tk_version errorInfo

      set fail [catch {$child eval $cmd} result]
      ShowOutput "$Tutor(example.Output)"
      if {$fail} {
	  set rlist [ParseError [$Tutor(code) get 0.0 end ] $cmd $result $errorInfo]
	  eval $Tutor(code) tag add BAD $rlist
          $Tutor(code) tag configure BAD -background $Tutor(errorBackground)
	  Debug "ERROR: RLIST $rlist"
	set errorInfo \
	    [string map { {(procedure "dummyputs" line 7)} {}} $errorInfo]
	regsub {invoked from within[^"]*"\$child eval \$cmd"} \
	    $errorInfo "" errorInfo
	  ShowOutput "\n--------\n[string trim $errorInfo]"
	  return 1
	  } else {
	  }
      return 0
}

################################################################
# proc ShowOutput {list}--
#    Display a list of lines
# Arguments
#   list	A list of lines to display in the output window.
# 
# Results
#   New data is displayed.
# 
proc ShowOutput {list} {
  global Tutor
  $Tutor(output) insert end "$list"
}

proc ResetExample {} {
    global Tutor
    
    set index [getLessonIndex]

    set l [lindex $Tutor(lessonList) $index]

    set Tutor($Tutor(courseName).lessonFile) [lindex $l 1]
    showLesson [lindex $l 1]
    
}

################################################################
# proc applySize {}--
#    Apply the new font size request.
# Arguments
#   None: Reads value from scaler widget textvariable
# 
# Results
#   Screen is redrawn with new sized fonts.
# 
proc applySize {} {
    global Tutor

    set Tutor(fontSize) [expr $Tutor(tmp) + $Tutor(fontMod)]

    setFonts

    showLesson $Tutor($Tutor(courseName).lessonFile)
}

################################################################
# proc setFonts {}--
#    Set the fonts in the html widget, and text windows based on
#    current value in Tutor(fontSize).
# Arguments
#   NONE
# 
# Results
#   New default fonts.
# 
proc setFonts {} {
    global Tutor HM_globals

    set HM_globals(S_adjust_size) $Tutor(fontSize)
    $Tutor(output) configure  -font [HMx_font Courier 14 medium r]
    $Tutor(code)   configure  -font [HMx_font Courier 14 medium r]

}

################################################################
# proc SetFontSize {}--
#    Creates a toplevel window for selecting font sizes.
# Arguments
#   NONE
# 
# Results
#   May redraw screen with new sized letters.
# 
proc SetFontSize {} {
  global Tutor
  catch {destroy .sizeSet}
  set t1 .sizeSet
  
  set origFont $Tutor(fontSize)

  set t [simpleTop::moveableToplevel .sizeSet "Set Font Size"]
  
  set Tutor(tmp) [expr $Tutor(fontSize) - $Tutor(fontMod)]
  
  scale $t.sc -from 0 -to 20 -length 100 -showvalue 1 \
      -variable Tutor(tmp) -orient horizontal   
  
  
  button $t.quit -text "Cancel" \
      -command "set Tutor(tmp) $origFont; applySize; destroy $t1"
  button $t.apply -text "Apply" -command "applySize"
  button $t.done -text "Done" -command "applySize; destroy $t1"
  
  grid $t.sc -row 0 -column 0 -columnspan 3
  grid $t.quit -row 1 -column 0 
  grid $t.apply -row 1 -column 1
  grid $t.done -row 1 -column 2
  
}


################################################################
# proc logUsage {str}--
#    Dump a usage line to the activity log.
#    If more than 10 lines in log, mail it.
# Arguments
#   str		The string to place in the log
# 
# Results
# If not previously opened, the log is opened/created.
# The log is larger.  
# 
proc logUsage {str} {
    global Tutor

    return
    
    if {$Tutor(logUsage) == 0} {return}

    if {[string match $Tutor(logFile) ""]} {
        set Tutor(logFile) [open $Tutor(logFileName) "a"]
    }
   
    set tm [clock format [clock seconds] -format "%d/%b/%y %H:%M:%S"]
    puts $Tutor(logFile) "$tm : $str"
    incr Tutor(logCount)
    if {($Tutor(mailUsage)) && ($Tutor(logCount) > 10)} {
        mailLog
	set Tutor(logCount) 0;
    }
}

################################################################
# proc mailLog {}--
#    Ship it- send the activity log to me
# Arguments
#   None
# 
# Results
#   The log hits the e-mail system, and gets emptied.
# 
proc mailLog {} {
  global Tutor tcl_platform

  return

  catch {close $Tutor(logFile)}
  
    switch $tcl_platform(platform) {
      "unix"	{
	    exec mail tutoractivity@cflynt.com < $Tutor(logFileName)
       }
      "windows" 	-
      "macintosh"
      "mac"	{

       }
      default	{
          tk_messageBox -type ok \
	      -message "WHAT: NO Support for: $tcl_platform(platform)"
	  exit;
      }
   }
  set Tutor(logFile) [open $Tutor(logFileName) "w"]
}

################################################################
# proc htmlWindow {text}--
#    Open a toplevel window with a scrollbar and an HTML text widget
#    Display the text in that window.
# Arguments
#   text	An HTML document to display.
# 
# Results
#   A new toplevel widget is created.  Unique is incremented.
# 
proc htmlWindow {text title} {
    global Tutor
    
    set win .w_$Tutor(unique);
    incr Tutor(unique)
    toplevel $win  
    wm title $win $title
    set r 0
    
    set t [text $win.t -yscrollcommand "${win}.scroll set"]
    set sc [scrollbar ${win}.scroll -command "$t yview"]

    if {$Tutor(maxWD) < 480} {
        $t configure -width [expr $Tutor(maxWD) / 8 ]
        $t configure -height [ expr $Tutor(maxHT) / 16]
    }

    grid $t -row $r -column 0 -sticky news
    grid $sc -row $r -column 1 -sticky ns
    grid rowconfigure $win $r -weight 10
    grid columnconfigure $win 0 -weight 10

    HMinit_win $t

    HMparse_html $text "HMrender $t"
    
    button $win.b -text "DONE" -command "destroy $win"
    grid $win.b -row 2 -column 0
}

################################################################
# proc displayHtmlFile {root}--
#    Display a file in a toplevel window.
# Arguments
#   fileName 	The root of the html file name.
# 
# Results
#   
# 
proc displayHtmlFile {fileName} {
   global Tutor
   set fn [file tail $fileName]
   if {[file exists [file join $Tutor(lessonHome) $Tutor(courseName) $fn]]} {
     set fileName [file join $Tutor(lessonHome) $Tutor(courseName) $fn]
   }
   set infl [open $fileName "r"]
   set data [read $infl]
   close $infl
   set title [file rootname [file tail $fileName]]
   htmlWindow $data $title
}

################################################################
# proc showManEntry {window xloc yloc}--
#    Displays a man page for the word at xloc,yloc in the text window.
#    If necessary, opens a new application for this.
# Arguments
#   window	The name of the text widget
#   xloc	X pixel location of a part of the word
#   yloc	Y pixel location of a part of the word
# 
# Results
#   A new window will be created, or an running man page reader
#   will have the display updated to reflect the selected word.

proc showManEntry {window xloc yloc} {
  global Tutor tcl_platform

  set manWord [$window get "@$xloc,$yloc wordstart" "@$xloc,$yloc wordend"]

  if {[info exists tcl_platform(platform)] && [string match "windows" $tcl_platform(platform)]} {
    
    # Get the help file name - several steps of directory manipulations
    #  and taking the last item in the possible list.
    set hlp [file attributes [file dirname [info nameofexecutable]] -shortname]
    set hlp [lindex [glob [file join [file dirname $hlp] doc *.hlp]] end]

    if {[file exists $hlp ]} {
      if {[string first $manWord [info commands]] >= 0} {
        exec C:/Windows/winhlp32.exe -k$manWord $hlp 
	}
      }
    } else {

    # If tkman is already running, just update the display, else start TkMan

    set lst [winfo interps];
    if {[lsearch $lst "tkman"] == -1 } {
      set fail [catch {exec tkman &} val]

      if {$fail} {
          #htmlWindow "<HTML><BODY><H1>TkMan is not available</H2></BODY></HTML>" "No Man Page Available"
	  set fail [catch {exec xterm -e man n $manWord &}]
	  return
      }

      while {[lsearch [winfo interps] "tkman"] == -1 } {
        after 100
        }
      }
     send tkman manShowMan $manWord
  }
}

################################################################
# proc SetColors {}--
#    Invoked from the Set Colors menu choice.
#    This creates the toplevel widget for selecting foreground/background colors
# Arguments
#   NONE
# 
# Results
#   May result in new colors being selected.
# 
proc SetColors {} {
  global Tutor
  
  set t1 .colorset_$Tutor(unique)
  set t [simpleTop::moveableToplevel $t1 "Select colors for display widgets"]

  update idle
  wm geometry $t1 +40+40

  incr Tutor(unique)

  set col 0;
  set row 1
  
  set prev {}
  foreach in [lsort [array names Tutor opt,*]] {

    if {[string first ground $in] < 0} {continue}

    foreach {o v} [split $in ,] {break;}
    foreach {wid fld} [split $v .] {break;}
    if {[string equal $wid $prev]} {
      incr col
    } else {
      incr row; set col 1
      set w [label $t.l_$wid -text "[string map {* {}} $wid]:" -anchor w]
      grid $w -row $row -column $col -sticky ew
      set prev $wid
      incr col
    }
    set w [button $t.b${col}-${row} -text $fld -command \
      "lower $t1; set Tutor($in) \[tk_chooseColor -initialcolor $Tutor($in) \]; applyOptions; raise $t1"]
    grid $w -row $row -column $col -sticky ew
  }
  
  incr row
  
  set fr [frame $t.buttons]
  grid $fr -row $row -column 0 -columnspan 8
  set b [button $fr.apply -text "Apply" -command "destroy $t1"]
  pack $b -side left

  set b [button $fr.quit -text "Done" -command "destroy $t1"]
  pack $b -side left

}

#
# And now, lets get this show on the road!
#

createDisplay

bind . <Destroy> {if {[string match "." %W]} {
    SaveState; 
    exit 0}
    }

selectCourse [file join \
    $Tutor(lessonHome) \
    $Tutor(courseName) \
    [format "%s.%s" $Tutor(courseName) cfg]]

applyOptions
