#!/usr/bin/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 Xerox Corporation.
# Copyright (c) 1996 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
set wish /usr/bin/wish
set exmh(version) {version 1.6.7 05/05/96}
set exmh(maintainer) Brent.Welch@eng.sun.com
set mh_path /usr/bin/mh
set exmh(slocal) /usr/lib/mh/slocal
set mime(dir) /usr/bin
set mailcap_default /etc/mailcap
set exmh(expect) /usr/bin/expect
set faces(dir) /usr/local/faces/faces
set faces(set) {parc logos news facesaver}
set faces(defaultDomain) parc.xerox.com
set pgp(path) /usr/bin
set glimpse(path) /usr/bin
set sound(cmd) {/usr/bin/play}
set exmh(library) /usr/lib/exmh-1.6.7
set install(dir,bin) /usr/bin
set install(dir,man) /usr/man/man1
set install(dir,lib) /usr/lib/exmh-1.6.7

#END CONFIGURATION

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 tk_version
    if [file exists $path/tclIndex] {
	if {[info tclversion] != 7.0} {
	    set auto_path "$path $auto_path"
	} else {
	    lappend auto_path $path
	}
	catch {auto_reset} ;# Needed for per-user override, but breaks w/ TCLX
    }
}
auto_path_update $exmh(library)

# 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-defaults $exmh(library)/app-defaults

# Add this preference to initialize exmh(userLibrary) and exmh(logEnabled)
Preferences_Add "Hacking Support" \
"These items support the extension of Exmh by User code." {
        {exmh(userLibrary)      userLibrary ~/.tk/exmh  {User library directory}
"You can override modules of the exmh implementation
by putting your versions into a private library directory.
Remember to update the tclIndex file with auto_mkindex
after you add things to that directory."}
 }

# Support per-user customization
if [info exists exmh(userLibrary)] {
    auto_path_update $exmh(userLibrary)
}

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
    if ![info exists exmh(c_st_background)] {
	if {[tk colormodel .] == "color"} {
	    set exmh(c_st_background) [option get . c_st_background {}]
	    if {$exmh(c_st_background) == {}} {
		set exmh(c_st_background) [option get . bgMsgColor {}]
		if {$exmh(c_st_background) != {}} {
		    puts stderr "Warning: old resource bgMsgColor, changed to c_st_background"
		} else {
		    set exmh(c_st_background) "medium sea green"
		}
	    }
	} else {
	    set exmh(c_st_background) [option get . c_st_background {}]
	    if {$exmh(c_st_background) == {}} {set exmh(c_st_background) black}
	    if {$exmh(c_st_background) != "white" && $exmh(c_st_background) != "black"} {
		set exmh(c_st_background) black
	    }
	}
    }
    BgRPC Exmh_Status $string $exmh(c_st_background)
    unset exmh(instatus)
}

proc Exmhbg_Done {} {
    # Die asynchronously so the front-end gets a response
    # to its send request first.
    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
set busy(style) none
Background_Init
Background_DoPeriodic