
#!/bin/sh
#the next line restarts using wish \
exec wish "$0" "$@"



#    makehelp, a Tcl/Tk script for the production of helpfiles for use in
#    and with Tk windows.
#    Copyright (C) 1996  H. D. Baecker
#    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.
#
#    H. D. Baecker, Box 474, Lake Cowichan, BC, V0R 2G0, Canada
#    hbaecker@duncan.island.net


proc dialog {w name stuff pref args} {
   global button
   
   toplevel $w -class Dialog
   wm title $w $name
   wm iconname $w Dialog
   frame $w.top -relief raised -bd 1
   pack $w.top -side top -fill both
   frame $w.bot -relief raised -bd 1
   pack $w.bot -side bottom -fill both
   
   message $w.top.msg -width 3i -text $stuff \
      -font -Adobe-Times-Medium-R-Normal-*-180-*
   pack $w.top.msg -side right -expand 1 -fill both \
      -padx 3m -pady 3m
   
   set i 0
   foreach but $args {
      button $w.bot.button$i -text $but -command \
         "set button $i"
      if {$i == $pref} {
         frame $w.bot.pref -relief sunken -bd 1
         raise $w.bot.button$i
         pack $w.bot.pref -side left -expand 1 \
            -padx 3m -pady 2m
         pack $w.bot.button$i -in $w.bot.pref \
            -side left -padx 2m -pady 2m \
            -ipadx 2m -ipady 1m
      } else {
         pack $w.bot.button$i -side left -expand 1 \
            -padx 3m -pady 3m -ipadx 2m -ipady 1m
      }
      incr i
   }
   
   if {$pref >= 0} {
      bind $w <Return> "$w.bot.button$pref flash; \
         set button $pref"
   }
   
   set oldFocus [focus]
   grab set $w
   focus $w
   
   tkwait variable button
   destroy $w
   focus $oldFocus
   return $button
}

proc cmdOpen {} {

uplevel #0 {
.labelf configure -text $filename
set sw 1
set f [open $filename $how]
if {$i > 1} {
   set W($buf,NT) [.text get 1.0 end]
   .text delete 1.0 end
   .label configure -text ""
   }
set buf $i    
set W($i,FD) $f
seek $f 0
if {$new} {
   puts $f "1000000"
   set W($i,LP) [tell $f]
   return
   }
gets $f tmp
if {$tmp == 1000000} {
   set W($i,LP) [tell $f] 
   return
   }
seek $f $tmp
gets $f plonk;#throw away title
gets $f plonk
set W($i,LP) $tmp
set W($i,C) $plonk
set W($i,CN) 1
set sum 0
for {set j 1} {$j <= $plonk} {incr j} {
   gets $f W($i,$j,T)
   gets $f W($i,$j,BP)
   gets $f W($i,$j,S)
   set W($i,$j,D) 0
   incr sum [expr $W($i,$j,S)+13]  
   }
if {[expr $tmp - $sum] > [expr 0.2 * $tmp]} {
   set save 0
   Compact
   }
} 
}
       
proc cmOpen {} {

# get the filename to open

uplevel #0 {
if {($i == 1) && $argc} {
   set filename $argv
   } else {
   set filename [exec FileSelect -patt "*.help"]
   }
if {$filename == ""} {
   dialog .p "" {No file selected} 0 {OK}
   return}
   
if {[file extension $filename] != $notes} {append filename $notes}
set shortname [file tail $filename]

if {$i > 1} {
               if {$W($buf,M) < 10} {
                  PutNote
                  }
               .text delete 1.0 end               
      for {set k 1} {$i >= $k} {incr k} {
         if {$filename == $W($k,FN)} {
            set W($i,FN) $filename
            set W($i,FD) $W($k,FD)
            set W($i,W) $k
            set W($i,CN) 1
            set buf $i
            set out $k
            return}
}
}
   
if {[catch {set fh [open $filename RDWR]}]} {
      if {![file exists $filename]} {
         if {![dialog .p $shortname \
            "Either this file does not exist or you \
            do not have access along its path. \
            Make it in the Current Directory?" \
            0 {YES} {NO}]} {
             set name $shortname; set how w+; set new 1
 	     cmdOpen
	     }
	     return
	     } 
      if {![file readable $filename]} {
         dialog .p $shortname
            {You do not have read permission for this file} \
              0 {OK}] 
             return}

      if {![file writable $filename]} {
         if {![dialog .p $shortname \
            {You do not have write permission for this file. \       
            Accept as read-only?} 0 {OK} {NO}]} {
               set name $filename; set how r; set new 0   
               cmdOpen}
         return
         }         	

   dialog .p $shortname {Unidentified problem opening file. Try again.} \
       0 {OK}
   return
}
set W($i,FN) $filename
set name $shortname; set how r+; set new 0
cmdOpen        
}
}

proc cmExit {} {

uplevel #0 {
   set W($buf,NT) [.text get 1.0 end] 
   for {set k 1} {$k < $i} {incr k} {
         set f $W($k,FD)
         if {($W($k,M) < 10) && ($f != "")} {
         set buf $k    
         PutNote
         }
}
   exit
}
}
   
proc cmAdd {} {

uplevel #0 {
   set x 0
   if {[cmShowText]} {return}
   set it 0
   toplevel .e -class Title
   wm title .e Title
      
   label .e.label -text "Note Title:"
   entry .e.entry  -width 40 -relief sunken -bd 2
   pack .e.label .e.entry -side left -padx 1m -pady 2m
   
   bind .e.entry <Return> "set it 1"   

   set oldFocus [focus]
   grab set .e
   focus .e.entry
   
   tkwait variable it
   set h [.e.entry get]
   destroy .e
   focus $oldFocus
   set c [incr W($buf,C)]
   set W($buf,$c,T) $h
   set W($buf,CN) $c
   set W($buf,$c,D) 0
   .label configure -text $W($buf,$c,T)
}   
}

proc cmClose {}      {

uplevel #0 {
   if {($W($buf,M) < 10)} {
      set W($buf,NT) [.text get 1.0 end]
      if {[string length $W($buf,NT)] > 0} {
      PutNote
      }
      }
   .text delete 1.0 end
   .labelf configure -text ""
   .label configure -text ""
     set j 0   
     for {set k 1} {$k <= $i} {incr k} {   
        if {$W($k,W) == $buf} {
         incr j
         break      
         }
      }   
      if {!$j} {close $W($buf,FD)}
      set W($buf,FD) ""
      for {set k $W($buf,C)} {$k >= 1} {incr k -1} {
            unset W($buf,$k,T) W($buf,$k,BP) W($buf,$k,S) \
                W($buf,$k,D) 
                }
            set W($buf,FN) ""
            set W($buf,NT) ""
            set W($buf,M) 20
            set W($buf,C) 0
            set W($buf,CN) 0
            set W($buf,W) 0
            set W($buf,LP) 0 
 }  
}

proc cmHide {} {

uplevel #0 {   

    if {$W($buf,FD) == ""} {
      dialog .p {No Notebook} {No Notebook is Open} 0 {OK}
      return
      }
   set temp [expr {($it == 1) ? "Hide" : "Restore"}]
   set which $it
   set h "Select Note to $temp"   
   if {[notelist] == -1} {  
      dialog .p {No Notes} {There are No Notes to $temp  \
         or none is selected} 0 {OK}
      return
      }
   for {set k $W($buf,C)} {$k > 0} {incr k -1} {
         if {$phrase == $W($buf,$k,T)} {
              set W($buf,$k,D) $which
            return
            }
      }          
}         
}

proc cmCB {} {

uplevel #0 {
   clipboard clear
   clipboard append [selection get]
   if {$cut} {selection clear .text}
      {.text tag delete sel}
}
}

proc cmPaste {} {

   uplevel #0 {.text insert [clipboard get]}
}

proc cmSel {} {

   uplevel #0 {.text tag add sel 1.0 end}
}
   
proc cmShowText {} {

uplevel #0 {   
    if {$W($buf,FD) == ""} {
      dialog .p {No Notebook} {No Notebook is Open} 0 {OK}
      if {!$x} {return 1}
      return
      }
   if {($W($buf,X) != 0) && ($W($buf,M) < 10)} {
       set W($buf,NT) [.text get 1.0 end]        
       PutNote
        }
   .text delete 1.0 end
   set W($buf,X) 3             
   set W($buf,M) $x
   if {!$x} {return 0}
   .label configure -text ""
   set temp [expr {($x == 1) ? "Edit" : "Show"}]
   set h "Select Note to $temp"             
   set which 1
   set L [notelist]
   if {$L == -1} {
      dialog .p {No Notes} {No Active Notes in Notebook \
         or action cancelled} 0 {OK}
      return
      }
   set W($buf,CN) $L      
   set f $W($buf,FD)
   seek $f $W($buf,$L,BP)
      .text insert end [read $f $W($buf,$L,S)]    
      .label configure -text $W($buf,$L,T) 
}    
}

proc cmSave {} {

uplevel #0 {
    if {($W($buf,FD) == "") && !$W($buf,W)} {
      dialog .p {No Notebook} {No Notebook is Open} 0 {OK}
      return
      }

    if {$W($buf,M) > 9} {
      dialog .p {No Note} {There is No Active Note to Save} 0 {OK}
      return
      }
    set W($buf,NT) [.text get 1.0 end]       
    PutNote
    set W($buf,M) 10
}
}
    
proc cmDelete {} {

uplevel #0 {
   if {$W$buf(M)} {
      dialog .p {Too Late!} {You cannot cancel an already \
         stored Note; delete it later \
         using a text editor} 0 {OK}
      return
      }
   .text delete 1.0 end; .label configure -text "" 
   set W($buf,M) 20
}
}
     
proc cmInput {} {

uplevel #0 {
               if {$W($buf,M) < 10} {
                  set W($buf,NT) [.text get 1.0 end]              
                  PutNote
                  }
               .text delete 1.0 end               
   set filename [exec FileSelect -patt "*"]
   if {$filename == ""} {
       dialog .p "" {No file selected} 0 {OK}
       return}
   set f [open $filename]
   gets $f tmp 
   .label configure -text $tmp
   .text insert end [read $f] 
   set c [incr W($buf,C)]
   set W($buf,CN) $c
   set W($buf,M) 0
   set W($buf,$c,T) $tmp
   set W($buf,$c,D) 0
   set W($buf,$c,BP) 0
   set W($buf,$c,S) 0
   close $f
}
}

proc cmExp {} {

uplevel #0 {
   set filename [exec FileSelect -patt "*"]
   if {$filename == ""} {
       dialog .p "" {No file selected} 0 {OK}
       return}

   set f [open $filename a]
   puts $f $W($buf,$W($buf,CN),T)
   set tmp [.text get 1.0 end]
   set tmp [string trimright $tmp]
   puts $f $tmp
   close $f
}
}

proc cmPrint {} {

uplevel #0 {   
   set name [exec date {+'%j%H%M'}]
   set f [open $name w]
   set space "        "
   set t [.text get 1.0 end]
   string trimright $t
   append t " "
   set margin 71
   set begin 0
   set more 1
   set first 1
   while {$more != 0} {
      puts $f "\n\n\n\n\n"
      set count 56      
      if {$first} {
         set line $space
         append line $W($buf,$W($buf,CN),T)
         puts $f $line
         puts $f "\n"
         incr count -2
         set first 0
         }
      while {$count != 0} {
         set line $space
         set margin [string last " " [string range $t $begin $margin]]          
         if {$margin == -1} {
            set more 0
            break  
            }
         set margin [expr $margin + $begin]    
         set rest [string range $t $begin $margin]
         set nl [string first "\n" $rest]
         if {$nl != -1} {
            set rest [string range $rest 0 $nl]     
            set margin [expr $begin + $nl]
            }
         append line $rest
         puts $f $line
         set begin [incr margin]
         set margin [expr $begin + 71]
         }         
      puts $f "\f"
      }
      close $f
      exec lpr -h "" -r $name &
}
}
   
proc lister {name listing} {
 
      global item phrase
       
   toplevel .l -class Lister
   wm iconname .l Listing
   frame .l.topest -relief raise -bd 1
   pack .l.topest -side top -fill both
   label .l.topest.lab1 -text $name
   label .l.topest.lab2 -text "To cancel press <Return>"
   label .l.topest.lab3 -text "To Select Double-Click Button 1"
   pack .l.topest.lab1 .l.topest.lab2 .l.topest.lab3 -side top
   frame .l.top -relief raised -bd 1
   pack .l.top -side top -fill both
   frame .l.bot -relief raised -bd 1
   pack .l.bot -side bottom -fill both
   
   listbox .l.top.things -relief raised -borderwidth 2 \
      -height 0 -width 0 -selectmode single \
      -yscrollcommand ".l.top.scroll set" \
       -xscrollcommand ".l.bot.scrollx set"
   pack .l.top.things -side left -fill both -expand yes
   scrollbar .l.top.scroll -command ".l.top.things yview"
   pack .l.top.scroll -side right -fill y
   scrollbar .l.bot.scrollx -orient horizontal \
      -command ".l.top.things xview"
   pack .l.bot.scrollx -side bottom -fill x
   foreach thing $listing {
      .l.top.things insert end $thing
   }           
     
   bind .l.top.things <Double-Button-1> \
     {set phrase [.l.top.things get active]
      set item [.l.top.things curselection]}
     
   bind .l.top.things <Return> {set item -1}
          
   set oldFocus [focus]
   grab set .l
   focus .l.top.things
   tkwait variable item
   
   destroy .l
   focus $oldFocus
   return $item
}

   
proc PutNote {} {

uplevel #0 {
set W($buf,NT) [string trim $W($buf,NT)]
if {$W($buf,NT) == ""} {return}
set f $W($buf,FD)
set lp $W($buf,LP)
seek $f $lp
puts $f $notes
set c $W($buf,CN)
incr lp 6
set W($buf,$c,BP) $lp
puts $f $W($buf,NT)
set np [tell $f]
set W($buf,$c,S) [expr $np - $lp]
set W($buf,LP) $np
seek $f 0
puts $f $np
seek $f $np 
puts $f $t
set c $W($buf,C)
puts $f $c
for {set k 1} {$k <= $c} {incr k} {
      puts $f $W($buf,$k,T)
      puts $f $W($buf,$k,BP)
      puts $f $W($buf,$k,S)
   }
flush $f
}
}

# There is an associative array W which is the central data object
# of the program. The first dimension of the array identifies the open
# notebooks of the current program execution in the order in which
# they were opened. Closed notebooks cause a gap in the ordering.
# The second dimension of the array holds various values associated
# with each open notebook, see below. The third dimension is an
# index of the notes in the notebook, in the order of their
# addition to the notebook.

# FN 0 Notebook filename
# FD 1 Fileid
# M  2 Mode, integer
# CN 6 Current Note, integer
# W  7 Where is index, integer
# LP 8 Last BytePos used file (actually first free)
# C  9 No of index entries following

# The note index, per note:
 
# T  0 Title
# BP 1 Byte Position in file
# S  2 Size in bytes
# P  3 Picture file name
# D  4 Deletion
# F  5 Found


proc Compact {} {

uplevel #0 {
    if {$W($buf,FD) == ""} {
      dialog .p {No Notebook} {No Notebook is Open} 0 {OK}
      return
      }
   if {$save} {
      set j 0
      for {set k 1} {$k < $i} {incr k} {
         if {$W($k,FD) == $W($buf,FD)} {
            incr j
            }
            }
      if {$j > 1} {
         dialog .p {Cannot Compact} {You can not Compact a \
            Notebook open in more than one window} 0 {OK}
         return
         }         
      }
   set tname [exec date {+D%j%I%M}]
   set tf [open $tname w]    
   puts $tf 1000000
   set wf $W($buf,FD)
   set c 0
   for {set k 1} {$k <= $W($buf,C)} {incr k} {
      if {$save && $W($buf,$k,D)} {
         if {![dialog .p "Delete?" $W($buf,$k,T) \
              0 {YES} {NO}]} {
                continue}
            }         
      seek $wf $W($buf,$k,BP)
      incr c
      puts $tf $notes
      set W($buf,$c,BP) [tell $tf]
      set rec [read $wf $W($buf,$k,S)]
      puts -nonewline $tf $rec
      if {$c != $k} {
         set W($buf,$c,T) $W($buf,$k,T)
         set W($buf,$c,S) $W($buf,$k,S)
          set W($buf,$c,D) $W($buf,$k,D)
         }
      }
for {set k [incr c]} {$k <= $W($buf,C)} {incr k} {
   unset W($buf,$k,T) W($buf,$k,BP) W($buf,$k,S) \
      W($buf,$k,D)
      }         
   set W($buf,C) [incr c -1]  
   set np [tell $tf]
   set W($buf,LP) $np
puts $tf $t
puts $tf $c
for {set k 1} {$k <= $c} {incr k} {
   puts $tf $W($buf,$k,T)
   puts $tf $W($buf,$k,BP)
   puts $tf $W($buf,$k,S)
   } 
   seek $tf 0   
   puts $tf $np
   flush $tf   
   close $wf
   exec mv -f $tname $W($buf,FN)
   close $tf
   set W($buf,FD) [open $W($buf,FN)]
}
}

proc notelist {} {

uplevel #0 {
   set dino {}
   set num {}
   for {set k 1} {$k <= $W($buf,C)} {incr k} {
         if {$W($buf,$k,D) != $which} {
               lappend dino $W($buf,$k,T)
               lappend num $k
         }
         }
   if {$num == ""} {return -1}      
   set L [lister $h $dino]
   if {$L == -1} {return -1}
   return [lindex $num $L]
}
}

proc cmSelectWindow {} {

uplevel #0 {
   set dino {}
   set num {}
   for {set k 1} {$k <= $i} {incr k} {
         if {$W($k,FD) != ""} {
               lappend dino $W($k,FN)
               lappend num $k
         }
         }
   if {$num == ""} {
      dialog .p {No Notebook} {No Notebook is Open} 0 {OK}
      return
      }      
   set L [lister "Select Notebook" $dino]
   if {$L == -1} {
      dialog .p {No Notes} {Action cancelled} 0 {OK}
      return
   }
   set W($buf,NT) [.text get 1.0 end]
   .text delete 1.0 end
   set buf [lindex $num $L]
      .text insert end $W($buf,NT)]    
      .label configure -text $W($buf,$W($buf,CN),T) 
   set W($buf,NT) ""
   .labelf configure -text $W($buf,FN)
}
}

proc cmHelp {} {
   exec usehelp /usr/doc/tkhelp/makehelp.help &
   }
   
#Main Program
 
set nbook "MakeHelp"
    
set t "@Index"
set sw 1

#make menu

frame .mbar -relief raised -bd 2 
pack .mbar -side top -fill both
wm iconname . $nbook
wm title . $nbook

menubutton .mbar.file -text File -underline 0 -menu .mbar.file.menu
menu .mbar.file.menu
.mbar.file.menu add command -label "New" -underline 0 \
	-command {exec makehelp &}
.mbar.file.menu add command -label "Open" -underline 0 \
      -command cmOpen 
      
.mbar.file.menu add separator
.mbar.file.menu add command -label "Compact" -underline 1 \
      -command {set save 1; Compact}
.mbar.file.menu add separator
.mbar.file.menu add command -label "Close" -underline 0 \
       -command cmClose 
.mbar.file.menu add command -label "Exit" -underline 1 -command cmExit

menubutton .mbar.edit -text Edit -underline 0 -menu .mbar.edit.menu
menu .mbar.edit.menu
.mbar.edit.menu add command -label "Cut" -underline 0 \
     -command {cmCB 1}
.mbar.edit.menu add command -label "Copy" -underline 1 \
       -command {cmCB 0}
.mbar.edit.menu add command -label "Paste" -underline 0 -command cmPaste
.mbar.edit.menu add command -label "Select All" -underline 7 \
		-command cmSel  
.mbar.edit.menu add command -label "Clear" -underline 1 -command cmClear

menubutton .mbar.notes -text Notes -underline 0 -menu .mbar.notes.menu
menu .mbar.notes.menu
.mbar.notes.menu add command -label "Add" -underline 0 -command cmAdd
.mbar.notes.menu add command -label "Display" -underline 0 \
	-command {set x 10; cmShowText}
.mbar.notes.menu add command -label "Edit" -underline 0 \
	-command {set x 1; cmShowText}
.mbar.notes.menu add separator	
.mbar.notes.menu add command -label "Save" -underline 0 \
         -command cmSave
.mbar.notes.menu add command -label "Cancel" -underline 0 \
         -command cmDelete         	          	 
.mbar.notes.menu add separator
.mbar.notes.menu add command -label "Hide" -underline 0 \
          -command {set it 1;cmHide}
.mbar.notes.menu add command -label "Restore" -underline 0 \
		-command {set it 0;cmHide}
.mbar.notes.menu add separator
.mbar.notes.menu add command -label "Import" -underline 0 -command cmInput
.mbar.notes.menu add command -label "Print" -underline 0 \
         -command cmPrint 
.mbar.notes.menu add command -label "Export" -underline 1 -command cmExp

menubutton .mbar.window -text Window -underline 0 \
		-menu .mbar.window.menu
menu .mbar.window.menu
.mbar.window.menu add command -label "Select" -underline 0 \
		-command cmSelectWindow

menubutton .mbar.help -text Help -underline 0 -menu .mbar.help.menu
menu .mbar.help.menu
.mbar.help.menu add command -label "Help" -underline 0 -command cmHelp

pack .mbar.file .mbar.edit .mbar.notes .mbar.window -side left
pack .mbar.help -side right

tk_menuBar .mbar .mbar.file .mbar.edit .mbar.notes \
	 .mbar.window .mbar.help

label .labelf -relief groove -width 72 -height 1 -bg grey
label .label -relief groove -width 72 -height 1 -bg Grey
  
text .text -relief raised -bd 2 -width 72 -height 20 -wrap word \
   -yscrollcommand ".scroll set"
scrollbar .scroll -command ".text yview"
pack .scroll -side right -fill y
pack .text -side left
pack .mbar .labelf .label -side top
pack .text -side bottom
update
    .text insert 1.0 "Makehelp version .60, Copyright (C) 1996 H. D. Baecker \
    Makehelp comes with ABSOLUTELY NO WARRANTY; for details see the \
    enclosed file COPYING. \
    This is free software, and you are welcome to redistribute it
    under certain conditions, which are also defined in the \
    enclosed file COPYING."
after 5000   
focus .text

set i 1
set buf 1
set W(1,FN) ""
set W(1,FD) 0
set W(1,M) 20
set W(1,NT) ""
set W(1,CN) 0
set W(1,W) 0
set W(1,LP) 0
set W(1,C) 0
set W(1,X) 0 
set notes ".help"
update
cmOpen

update

while {1 == 1} {
   if {$sw} {
      set sw 0
      incr i
      set W($i,FN) ""
set W($i,FD) 0
set W($i,M) 20
set W($i,NT) ""
set W($i,CN) 0
set W($i,W) 0
set W($i,LP) 0
set W($i,C) 0
set W($i,X) 0 
   }   
   update
   after 13
}
   



                                     


















































































































































































