#!wish -f
#
# Background processing script for exmh.
# This does stuff and then sends messages to the background module
# in the main exmh application.  In particular, the time-consuming things
# like running inc are done here instead of the main-line.
#
# Copyright (c) 1993-8 Brent Welch
# Copyright (c) 1993 Xerox Corporation.
# Copyright (c) 1996-8 Sun Microsystems
# Use and copying of this software and preparation of derivative works based
# upon this software are permitted. Any distribution of this software or
# derivative works must comply with all applicable United States export
# control laws. This software is made available AS IS, and Xerox Corporation
# and Sun Microsystems
# make no warranty about the software, its performance or its conformity to
# any specification.

#CONFIGURATION
#END CONFIGURATION

package require Tk
wm withdraw .

if {$argc < 3} {
    puts stderr "exmh-bg requires some arguments:"
    puts stderr "Usage: exmh-bg interpName libDirectory mh_path"
    exit 1
}

set exmh(interp) [lindex $argv 0]
set exmh(library) [lindex $argv 1]
set mh_path [lindex $argv 2]

proc auto_path_update { path } {
    # Add library directories to the auto_path,
    # ensuring that later paths have precedence
    # and that function override works
    global auto_path
    if [file exists $path/tclIndex] {
	if {[info tclversion] != 7.0} {
	    set auto_path "$path $auto_path"
	} else {
	    lappend auto_path $path
	}
	# auto_reset call eliminated
    }
}
auto_path_update $exmh(library)

# Support per-user directory containing .tcl files.
foreach exmh(userLibrary) [list [glob ~]/.exmh/lib [glob ~]/.tk/exmh] {
    if {[file exists [file join $exmh(userLibrary) tclIndex]]} {
	auto_path_update $exmh(userLibrary)	;# library for new modules
	break
    }
}

# Set up environment variables
Env_Init

proc Exmh_Status { string args } {
    # Just a stub version until we rendez-vous with the front end.
    # If the userLibrary Preferences_Add is done after we define the
    # full blown Exmh_Status, then the auto_path_update and its
    # auto_reset seem to result in the Exmh_Status from main.tcl
    # being faulted in from the library.
    catch {puts stderr "exmh-bg: $string"}
}
# Tk 4.0b3 bogosity
if [catch {tk colormodel .}] {
    rename tk tk-orig
    proc tk { option args } {
	switch -- $option {
	    colormodel {
		if {[winfo depth $args] > 4} {
		    return color
		} else {
		    return monochrome
		}
	    }
	    default {
		return [eval {tk-orig $option} $args]
	    }
	}
    }
}

Preferences_Init ~/.exmh/exmh-defaults $exmh(library)/app-defaults

if [catch {User_Init} err] {
    catch {puts stderr "User_Init: $err"}
}

proc Exmh_Debug { args } {
    global exmh
    if [info exists exmh(pid)] {
	BgRPC Exmh_Debug exmh-bg $args
    } else {
	catch {puts stderr "exmh-bg $args"}
    }
}
# Register ourselves with the UI
proc BgRegister { exmhInterp } {
    global exmh
    set exmh(sendErrors) 0
    if {[catch {
	send $exmhInterp [list Background_Register [winfo name .] [pid]]
    } alist] == 0} {
	# set bg parameters returned as a result of registration
	foreach pair $alist {
	    set _var [lindex $pair 0]
	    set _val [lindex $pair 1]
	    uplevel #0 [list set $_var $_val]
	}
	return 1
    } else {
	if [regexp {no registered interpreter} $alist] {
	    catch {puts stderr "exmh-bg lost UI - exiting."}
	    exit
	}
	catch {puts stderr "BgRegister $alist"}
	return 0
    }
}
set ok 0
foreach try {1 2 3 4 5} {
    set ok [BgRegister $exmh(interp)]
    if {$ok} {
	break
    }
    exec sleep [expr $try*$try]
}
if {! $ok} {
    catch {
	puts stderr \
"exmh-bg cannot rendez-vous with UI - exiting.
  Usually this is because Tk send is not working.
  Check the notes under Frequently Asked Questions #4a and #4b.
  You can find this under the Help menu."
    }
    exit 1
}

proc Exmh_Status { string {color black} } {
    global exmh
    if [info exists exmh(instatus)] {
	catch {puts stderr "exmh-bg: $string"}
	return
    }
    set exmh(instatus) 1
# All this code to evaluate something that should be evaluated in
# the main Exmh interpreter if BgRPC suceeds - and if we call our stub
# Exmh_Status the value is ignored anyhow.
#   if ![info exists exmh(c_st_bg_msgs)] {
#	if {[tk colormodel .] == "color"} {
#	    set exmh(c_st_bg_msgs) [option get . c_st_bg_msgs {}]
#	    if {$exmh(c_st_bg_msgs) == {}} {
#		set exmh(c_st_bg_msgs) [option get . bgMsgColor {}]
#		if {$exmh(c_st_bg_msgs) != {}} {
#		    puts stderr "Warning: old resource bgMsgColor, changed to c_st_bg_msgs"
#		} else {
#		    set exmh(c_st_bg_msgs) "medium sea green"
#		}
#	    }
#	} else {
#	    set exmh(c_st_bg_msgs) [option get . c_st_bg_msgs {}]
#	    if {$exmh(c_st_bg_msgs) == {}} {set exmh(c_st_bg_msgs) black}
#	    if {$exmh(c_st_bg_msgs) != "white" && $exmh(c_st_bg_msgs) != "black"} {
#		set exmh(c_st_bg_msgs) black
#	    }
#	}
#   }
    BgRPC Exmh_Status $string background
    unset exmh(instatus)
}

proc Exmhbg_Done {interp} {
    # Die asynchronously so the front-end gets a response
    # to its send request first.  Set a dead flag so BgRPC
    # doesn't try to talk to the front end
    global exmh
    if {$exmh(interp) == $interp} {
	set exmh(dead) 1
	after 1 {
	    catch {Audit_CheckPoint}
	    destroy .
	}
    }
}

# Now do things periodically.  We fault in routines from
# the regular library of exmh procedures.  The Inc'ing
# routines have been tweaked to understand the (possible)
# split into a separate process, and the above hack to
# Exmh_Status handles the simpler cases.

Mh_Init
Inc_Init
Ftoc_Init		;# Need ftoc(scanWidth)
Flist_Init
Seq_Init                ;# Need seqwin(nevershow)
Post_Init
set busy(style) none
Background_Init
Background_DoPeriodic