#################################################################################
# TCL Interactive Spell Checker Version .6
# Developed for use in EXMH by John McLaughlin (john@sr.hp.com) 1/21/97
# 
# This new spell checking code for EXMH was developed out of
# frustration with the current spell checking EXMH code
# mostly I could not get it to work the way I wanted it to.
# Because I couldn't get the spell checker to work as well
# as I would like, I found myself spending inordinate amounts
# of time when writing e-mail, constantly fretting over
# the spelling.  This little piece of code has two different
# modes, it can either spell check as you type, marking words
# in a variety of ways (underline, bold, italic, etc) that are
# not spelled correctly.  Also it can put a button in the sedit
# window to allow in place spell checking. 
#
# This code depends on the excellent 'ispell' program and most
# of the variables & procedure's get their name from it.
# This code was developed under ispell v3.1.20
#
#######################################################################
#             INSTALLATION
# to Use: 3 easy steps (Note: EXMH should not be running when you do this)
#
# 1) add to the file ~/.tk/exmh/user.tcl in the function 'User_Init'
#    a call to ispell_Preferences.  If you don't have a user.tcl
#    get one, Usually it can be found in '/usr/local/exmh-<version>'
#    where <version> is the version of exmh you are running
# 
#    if you are really desperate for a user.tcl the following
#    should work (just make a file called user.tcl with the
#    following line.....
#    proc User_Init {} { ispell_Preferences }
#
# 
# 2) add the following to your .exmh-defaults at the TOP of the file
# 
# *Sedit.Menubar.ubuttonlist: ispell
# *Sedit.Menubar.ispell.text: Ispell	    
# *Sedit.Menubar.ispell.command: ispell_Check_Entire_Window $t
#
# 3) in your ~/.tk/exmh directory type 'wish' then type auto_mkindex . *.tcl
#    than type 'exit'
# 
#  
# That should be it!  There should be a preferences menu for 'I-Spell' now to allow
# control of various parts of the ispell package... Also the 'Sedit' window should
# have a 'ispell' button to check the entire document...
# if a word is marked misspelled right click on it to add to dictionary or
# select an alternate version
#
############## Trouble Shooting ######################
#
# Did you make sure that....
# Ispell was turned on? (from I-spell/preferences menu)
# A 'Miss-Spelled word style' is selected? (from preferences/I-spell)
# the User Library directory is ~/.tk/exmh (preferences/Hacking Support)
# the changes above were made with EXMH NOT running?
#
######################################################
#
# Enjoy, if you find it useful or have any comments
# please let me know (john@sr.hp.com) also if you 
# make any improvements please send them to me
#
# - John McLaughlin, HP Santa Rosa, January 1997 (john@sr.hp.com)
######################################################

#########################################################
# ispell_init is called to start the entire process off
#########################################################
proc ispell_init { } { 
    global ispellVars
    
    puts "Ispell init Called (should only be called once!"
    # These things are now specified by the 'Preferences' menu
    #    a good choice for the spell command is "ispell -a"
    #   
    set ispellVars(last_word) "dummy" 
    # this variable are the alternate spellings of the misspelled word...
    set ispellVars(choices) "" 

    # how to view, see the text.n man page for other ideas
    # options include -background <color> -foreground <color> 
    # -font <font> etc..
    #    set ispellVars(viewStyle) "-underline t"

    if { [ info exists ispellVars(spell_buffer) ] } {
	catch {
	    close $ispellVars(spell_buffer)
	}
    }

    set ispellVars(spell_buffer) [ open "|$ispellVars(command)" r+ ]; 
    
    gets $ispellVars(spell_buffer);

    ispell_write_spell_buffer "!" ; # enter terse mode
}

######################
# preferences
######################

proc ispell_Preferences {} { 

    Preferences_Add "I-Spell" \
	    "This is a module to allow interactive spelling within a sedit window
    it has many fine features include suggested correction and the ability
    to add new words to a session or to your personnel dictionary" { 

	{ ispellVars(on) ispellOnOff OFF {Turn Ispell On/Off} 
	"This turns the ispell feature on/off.  Note that the feature
needs to be enabled BEFORE a message is brought up" } 

	{ ispellVars(ReCheckAfterAdd) ispellRecheckAfterAdd ON {Re-Verify after Adds?} 
	"Check this box if you want to re spell check words 
currently marked Miss Spelled after you add to the dictionary 
or session.  In general a good idea except if you work 
in extremely long documents a small delay may be noticed 
after you add words to your personal dictionary
Additionally the right mouse button can be used to
accept suggested words" }


	{ ispellVars(command) ispellCommand "ispell -a" {Speller invocation}
	"This is the program used to actually do the real work
'ispell -a' is probably a good choice" } 

	
	{ ispellVars(viewStyle) ispellStyle {CHOICE underline italic bold bgcolor fgcolor other } {Miss-spelled word style}
	" this is how to display misspelled words
use the built in types or create your own
using 'other', for 'color' ones fill in the color 
examples using other include 
-underline t
-background red
-foreground Bisque
-font <font>
-fgstipple <bitmap>
-bgstipple <bitmap>

Bitmap's can be many things, 'gray50' and 'gray25' are popular

For example....

     -font *italic*
or   -font *bold*
or   -font *24*    (Big!)

or   -font *italic*24* (big italics)

-relief <relief> (see tk doc's for more info...)

	
Effects can also be combined as in 
	       
-underline t -foreground red
-bgstipple gray25 -color red

	
" } 
	{ ispellVars(viewStyle-Color) ispellStyleColor red {color:} 
	"color for fgcolor and bgcolor" }
	{ ispellVars(viewStyle-Other) ispellStyleOther {-underline t -foreground red}  {other:}
	"Style if 'other' is selected" }
    }
    if { [ info exists ispellVars(CheckButton) ] } {
	if {$ispellVars(CheckButton) == 1} {

	    option add *Sedit.Menubar.ubuttonlist {ispell}
	    
	    option add *Sedit.Menubar.ispell.text {Ispell}
	    
	    option add *Sedit.Menubar.ispell.command {ispell_Check_Entire_Window $t}
	}
    }
    
}



# a safe procedure to write to the ispell buffer
# this procedure dumps the variable 'word' to the spell buffer
# if the buffer has died, it will restart it

proc ispell_write_spell_buffer { word } {
    global ispellVars
    
    puts $ispellVars(spell_buffer) $word
    if { [ catch { flush $ispellVars(spell_buffer) } ] } {
	puts "Ispell process terminated!!!!!, restarting"
	ispell_init
	return "*" ; # return if we had to restart
    }
}

# This procedure kills the ispell buffer
# 
proc ispell_kill {} { 
    global ispellVars
    close $ispellVars(spell_buffer)
    set ispellVars(on) 0
}

##########################################
# this is the proc that does the 
# actual spell checking, it will return a 
# '*' if everything is cool, otherwise
# it returns a list of possible miss-spelled
# words.  See ispell(1) for more details
proc ispell_words line { 
    global ispellVars

    set count [ llength $line ] 
    set result ""

    fileevent $ispellVars(spell_buffer) readable {} ; # clear out filevent
    # so the puts stuf doesn't freak out
    # CRITCAL prepend a '^' to keep the buffer from freaking
    puts $ispellVars(spell_buffer) "^$line"
    # we have to put the ^ in front of the line so ispell works correctly
    # see ispell(1) for more details
    if { [ catch { flush $ispellVars(spell_buffer) } ] } {
	puts "Ispell process terminated!!!!!, restarting"
	ispell_init
	return "*" ; # return if we had to restart
    }

    # loop through list of words, usually there is just 1
    for { set i 0 } { $i <= $count } {  incr i } { 
	gets $ispellVars(spell_buffer) var
	if {$var == {} } then {
	    lappend result "*";
	    break;
	}
	lappend result $var
    }
    # invoke a fileevent to help flush out the data so wer are always in sync
    fileevent $ispellVars(spell_buffer) readable {
	global ispellVars
	gets $ispellVars(spell_buffer) dummy 
    }
    return $result
}


# this proc spell checks the word under the current cursor
# marking it with a 'MissSpelled' tag if it is in fact incorrect
# text is the text window
# adjustment is how to adjust it (i.e. - 1 chars, - 1 line, + 1 line, etc)

proc ispell_TextWindow { text  adjustmentStart adjustmentEnd} { 
    set stopIndex [ $text index "insert $adjustmentEnd"  ]

    set startIndex [ $text index "insert $adjustmentStart" ] 
    set word  " [ string trim [ $text get $startIndex $stopIndex ] \
	    "\;\:\$ \{\}\"\\ \t\n\r\b\a\f\v\n"] " ; # "  

    ispell_mark_word $text $startIndex $stopIndex $word 
}

####################################################
# proc to mark words in the text window, with the given 
# indexes, the 'word' is the word in question
####################################################
proc ispell_mark_word {text startIndex stopIndex word} {

    global ispellVars ;

    set result [ ispell_words $word ]
    set result_key [ string index [ lindex $result 0 ] 0 ]; # * means fine, + means a root?

    if { ($result_key != "*") && ( $result_key != "+")  } {
	
	$text tag add MissSpelled $startIndex $stopIndex
	set prompt "Suggested: [ lreplace [ lindex $result 0 ] 0 3 ]"
	# EXMH Specific 
	Exmh_Status $prompt
	
    } else {
	$text tag remove MissSpelled $startIndex $stopIndex 
    }
    
    set ispellVars(last_word) $word ; # store word so we don't re-check next
    # time
    return $result
}

##############################################################
# Proedure to call to mark words after the dictionary has been
# modified, called from within the 'add' menus.....
# 
##############################################################

proc ispell_ReCheckBuffer { window startIndex stopIndex word } { 
    global ispellVars;
    
    # first let's make sure it's a real word....
    if { $word == "" } return ;

    ispell_mark_word $window $startIndex $stopIndex $word; 

    # check word requested
    if { [ info exists ispellVars(ReCheckAfterAdd) ] }  {
	
	if { $ispellVars(ReCheckAfterAdd) } { 
	    ispell_recheck_words $window ; 
	    # re-check buffer if requested..
	}   
    }
}

##########################################################
# This proc will take the word currently under the mouse pointer
# spell check it, and pop up a menu with suggestions or allowing
# additions to the ispell-dictionary
# 'text' is the text window, x,y are the co-ordinates relative to the
# window, X,Y are the co-ordinates relative to the root window
##########################################################

proc ispell_PostMenuChoices { text x y   X Y } { 
    set adjustment {} 
    set stopIndex [ $text index "@$x,$y wordend"  ]
    set startIndex [ $text index "$stopIndex  - 1 chars wordstart" ]
    set word  " [ string trim [ $text get $startIndex "$stopIndex wordend" ] \
	    "\:\;\$ \{\}\"\\ \t\n\r\b\a\f\v\n "] " ; # "
    set word [ string trim $word ] ; # get rid of white space

    # if there is no word to mention, don't even post a menu...

    if { $word == "" } return ; 

    set result [ ispell_mark_word $text $startIndex $stopIndex $word ]

    # create a meanu
    set menu "$text.m"
    catch { 
	destroy $menu
    }
    menu $menu -tearoff f

    # remember the menu name so we can unpost it later.
    set ispellVars(PopupMenu) $menu

    $menu add separator 
    $menu add command -label "Add '$word' to Dictionary" -command  \
	    "ispell_write_spell_buffer \"*$word\";\
	    ispell_write_spell_buffer \#;\
	    ispell_ReCheckBuffer $text $startIndex $stopIndex $word;"
    # add word to dictionary, save dictionary, recheck word
    
    $menu add command -label "Accept '$word' for this session" -command \
	    "ispell_write_spell_buffer \"@$word\";\
	    ispell_ReCheckBuffer $text $startIndex  $stopIndex $word;"
    # add word for this session, recheck word

    $menu add separator
    foreach i   [ split [ lreplace [ lindex $result 0 ] 0 3 ] ]   {
	set choice [ string trim $i "," ]
	$menu add command -label $choice -command "ispell_ReplaceWordInText $text $x $y $choice " 
    }
    tk_popup $menu $X $Y 
}

#######################################################
#
# Procedure called to Unpost 
# the menu
#######################################################
proc ispell_unPostMenuChoices {window } { 
    global ispellVars

catch {
    tkMenuUnpost $ispellVars(PopupMenu) 
}
}

#########################################################
# This proc will replace whatever word is listed at x,y
# with 'word'
#########################################################
proc ispell_ReplaceWordInText { text x y word } { 
    set adjustment {} 
    set newkey [ $text index "@$x,$y wordend"  ]
    set oldkey [ $text index "$newkey  - 1 chars wordstart" ]
    $text delete $oldkey $newkey 
    $text insert $oldkey $word
}

##########################################################
# EXMH Specific procedure to bind the window in question 
# note that this has to be in the current process
# it won't automagically be sucked in
# a call to 'ispell_Preferences' should do the trick...
##########################################################
proc Hook_SeditInit_TagMissSpelled { file window } {
    global ispellVars
    # only configure the window for ispell support if it is
    # actually needed, and if the appropriate variables exist
    # 
    # bind the window.....
    # use default style of underline
    set style "-underline t"
    
    switch -exact -- $ispellVars(viewStyle) \
	    underline  { set style "-underline t"} \
	    italic     { set style "-font *italic*" } \
	    bold       { set style "-font *bold*"}  \
	    other      { set style "$ispellVars(viewStyle-Other)" } \
	    bgcolor    { set style "-background $ispellVars(viewStyle-Color)" } \
	    fgcolor    { set style "-foreground $ispellVars(viewStyle-Color)" } \ 
    
    eval $window tag configure MissSpelled $style

    # Only bind the window if 'ispell' is turned on...
    if { [ info exists ispellVars(on) ] } {
	if { $ispellVars(on) == 1 } { 
	    set ispellVars($window,effect) 1
	    ispell_bind $window 

	}
    }

    # Only init the spell checker if it had already not been previously init'd
    if { ! [ info exists ispellVars(spell_buffer) ] } { 
	ispell_init ; # init if the spell buffer is undefine
    }
} 

# this procedure re-checks the entire buffer in the
# window specified by 'window'
proc ispell_Check_Entire_Window { window } { 
    global ispellVars


    # First things first, because this function COULD be called without
    # using any of the other ispell stuff, first ensure that the ispell 
    # process is running...
    # Only init the spell checker if it had already not been previously init'd

    if { ! [ info exists ispellVars(spell_buffer) ] } { 
	ispell_init ; # init if the spell buffer is undefine
    }

    # Pop up a little window to allow spell checking to be turned off......
    #
    set ispellVars(label) "Stop Spell Checking"
    set top [ toplevel .ispellStopWindow ] 
    button $top.b  -textvariable ispellVars(label) -command { 
	set ispellVars(label) "" 
    }
    label $top.l1 -bitmap warning
    label $top.l2 -bitmap warning
    
    pack $top.l1 -side left
    pack $top.b -side left
    pack $top.l2 -side left
    
    set end [ $window index end ] ; # get the last index mark
    set current 1.0

    # here is the actual code to spell check the document
    while { [ expr $current < $end ] }  {
	if { $ispellVars(label) == "" } { break} 
	set startIndex [ $window index "$current + 1 chars wordstart" ] 
	set stopIndex  [ $window index "$current + 1 chars wordend" ] 
	set current $stopIndex
	set word  " [ string trim [ $window get $startIndex $stopIndex ] \
		"\;\:\$ \{\}\"\\ \t\n\r\b\a\f\v\n"] " ; # " 
	$window see $current
	update 
	ispell_mark_word $window $startIndex $stopIndex $word 
    }
   
    destroy $top
}
	

########################################################
# procedure to re-check bound words to reconfirm they
# are still missspelled
# note that if quite a few words are missSpelled this could
# take quite a while.... Also note that this should probably
# only be called AFTER the dictionary has changed/updated
########################################################

proc ispell_recheck_words {window} { 
    global ispellVars
    

    set ranges [ $window tag ranges MissSpelled ] 
    set ispellVars(label) "Stop Spell Checking"

    if { [ expr [ llength $ranges ] > 100 ] } { 
	toplevel .t
	button .t.b  -textvariable ispellVars(label) -command { 
	    set ispellVars(label) "" 
	}
	label .t.l1 -bitmap warning
	label .t.l2 -bitmap warning
	
	pack .t.l1 -side left
	pack .t.b -side left
	pack .t.l2 -side left
    }

    # loop through all the current words marked as misspelled
    #
    for { set i 0 } { $i < [ expr [llength $ranges] / 2 ] } { incr i } {
	set startIndex [ lindex $ranges [ expr $i*2 ] ] 
	set stopIndex  [ lindex $ranges [ expr $i*2+1 ] ]
 
	set word  " [ string trim [ $window get $startIndex $stopIndex ] \
		"\;\:\$ \{\}\"\\ \t\n\r\b\a\f\v\n"] " ; # "

	if { $ispellVars(label) == "" } { break }
	$window see $startIndex
	update
	set result [ ispell_mark_word $window $startIndex $stopIndex $word ]

    }

    # destroy the toplevel window

    catch {
	destroy .t
    }

    # put the window back under the insert cursor

    $window see insert
}


# Call this procedure with the text window path to bind the spell command

proc ispell_bind { text } { 

    set command {ispell_TextWindow %W} ; 
    
 
    bind $text <Key-space> "$command {- 1 chars wordstart } {}" 
    bind $text <Key-exclam> "$command {- 1 chars wordstart } {}" 
    bind $text <Key-at> "$command {- 1 chars wordstart } {}" 
    bind $text <Key-period> "$command {- 1 chars wordstart } {}" 
    bind $text <Key-comma> "$command {- 1 chars wordstart } {}" 
    bind $text <Key-numbersign> "$command {- 1 chars wordstart } {}" 
    bind $text <Key-Tab> "$command {- 1 chars wordstart } {}" 
    bind $text <Key-asterisk> "$command {- 1 chars wordstart } {}" 
    bind $text <Key-semicolon> "$command {- 1 chars wordstart } {}" 
    bind $text <Key-colon> "$command {- 1 chars wordstart } {}" 
    bind $text <Key-quotedbl> "$command {- 1 chars wordstart } {}" 
    bind $text <Key-apostrophe> "$command {- 1 chars wordstart } {}" 

    
    bind $text <Key-Right> "$command {wordstart} {wordend}"   
    bind $text <Key-Left>  "$command {wordstart } {wordend}"    
    bind $text <Key-Down>  "$command {wordstart } {wordend} "
    bind $text <Key-Up>    "$command {wordstart } {wordend} "
    
    bind $text <Key-Return> " $command {- 1 chars wordstart} {wordend} "

    bind $text <ButtonPress-3> { ispell_PostMenuChoices %W %x %y %X %Y }
    bind $text <Any-ButtonRelease-3> { ispell_unPostMenuChoices %W } 

}








