1# main.tcl
2#
3# Main body of the application.  Note that system-dependent global
4# variable settings have been defined in the exmh script.
5#
6# Copyright (c) 1993 Xerox Corporation.
7# Use and copying of this software and preparation of derivative works based
8# upon this software are permitted. Any distribution of this software or
9# derivative works must comply with all applicable United States export
10# control laws. This software is made available AS IS, and Xerox Corporation
11# makes no warranty about the software, its performance or its conformity to
12# any specification.
13
14proc Exmh {} {
15    global exmh argv
16
17    Tcl_Tk_Vers_Init	;# Do per-release Tcl/Tk setup here
18    Mh_Init		;# Defines mhProfile and identifies mh vs nmh
19
20    Preferences_Init "~/.exmh/exmh-defaults" "$exmh(library)/app-defaults"
21
22    TopTenPreferences
23
24    # Add this preference to initialize and exmh(logEnabled)
25    Preferences_Add "Hacking Support" \
26"These items support the extension of Exmh by User code.
27The default location for this code is either
28~/.tk/exmh or ~/.exmh/lib.  Put your .tcl files there
29and create a tclIndex file for them." {
30	{exmh(sourceHook)	sourceHook OFF	{Enable source hook}
31"The source hook lets you keep a set of patches in your exmh user library.
32These files are sourced right after the associated file from the main
33script library is sourced.  This lets you override parts of a file.
34If the main script is flist.tcl, then your patch should be flist.patch.
35NOTE: You must restart exmh for this change to take effect."}
36	{exmh(logEnabled)	logEnabled OFF	{Debug log enabled}
37"Debug information is recorded in a log that you can view
38from within exmh.  Turning off the log may save some
39memory usage.  You can enable the log temporarily."}
40	{exmh(logLines)	logLines 1000	{Max lines in debug log}
41"The log is implemented in a text widget.  This setting limits
42the number of lines kept in the log."}
43    {exmh(auditEnabled) auditEnabled OFF {Audit log enabled}
44	"This option controls the recording of an audit trail of operations on mail messages.
45 Audit information is collected in .exmhaudit in the exmh tempdir, and appended to ~/Mail/.exmhaudit on exit."}
46	{flist(debug)		flistDebug OFF	{Debug flist}
47"A listbox that displays the unseen and unvisited folder state
48is displayed to debug the flist module."}
49    }
50
51    ExmhArgv		;# snarf up command-line arguments
52    ExmhResources	;# and some resources we need soon
53
54    SourceHook_Init				;# patches for old modules
55
56    Exec_Init		;# Wrapper around exec
57    Mh_Preferences
58    Sedit_BindInit	;# Text, Entry class bindings
59    Widget_TextInit	;# Text scrolling
60    ExmhLogInit		;# Enables debug loging
61
62    if [catch {User_Init} err] {
63	puts stderr "User_Init: $err"
64    }
65
66    catch {exec date} d
67    Audit "Startup $d $argv"
68
69    # The order of the following mainly determines the way
70    # their associated items appear in the Preferences dialog
71    # The "startup_code" variable is an artifact to make it
72    # easy to add an Exmh_Debug call as each init proc is called.
73
74set startup_code {
75    Sedit_Init		;# built in editor
76    Ispell_Preferences
77    Signature_Init
78    Edit_Init		;# interface to external editors
79    SlowDisplay_Init	;# See if we're on a slow display
80    Print_Init
81    Buttons_Init
82    Ftoc_Init
83    Msg_Init		;# Depends on Ftoc_Init, Buttons_Init
84    Mime_Init
85    URI_Init
86    Html_Init
87    Folder_Init		;# Sets exmh(folder)
88    Inc_Init
89    Exwin_Init
90    Flist_Init
91    Seq_Init
92    Seq_TraceInit
93    Fcache_Init
94    Fdisp_Init		;# After Flist and Fcache
95    Sound_Init
96    Faces_Init
97    Crypt_Init
98    Pgp_Init
99    Glimpse_Init
100    Addr_Init
101    Background_Init
102    fileselect_Init
103    Busy_Init
104    Post_Init
105    Quote_Init
106    Bogo_Init
107}
108    foreach line [split $startup_code \n] {
109      Exmh_Debug [lindex $line 0]
110      eval $line
111    }
112    wm protocol . WM_DELETE_WINDOW Exmh_Done
113    Exwin_Layout
114    if [catch {User_Layout} err] {
115	global errorInfo
116	puts stderr "Error in User_Layout:\n $errorInfo"
117    }
118    Exmh_Status $exmh(version)
119    if {! $exmh(iconic)} {
120	wm deiconify .
121    } else {
122	wm iconify .
123    }
124    update
125    bind . <Unmap> {ExmhUnmapped %W}
126    bind . <Map> {ExmhMapped %W}
127
128    Folder_Change $exmh(folder)
129
130    # Do this late because the WM seems to call the SAVE_YOURSELF hook
131    # and we want to make sure we are in the current folder before
132    # we checkpoint state.  Used to loose the current message because
133    # this was done too early.
134    wm protocol . WM_SAVE_YOURSELF [list Exmh_Done 0]
135
136    # This stuff can take a while, so we show a busy cursor
137    # while it happens
138    busy ExmhJunk
139}
140proc ExmhJunk {} {
141    Inc_Startup
142    Exmh_Focus
143    Background_Startup
144}
145
146proc ExmhArgv {} {
147    global argc argv exmh editor faces
148    set extra {}
149    set geo [option get . geometry Geometry]
150    set icon [option get . iconposition IconPosition]
151    set iconic [option get . iconic Iconic]
152    set editor(sedit!) 0	;# defeat accidental saving of override
153    set faces(enabled!) 0	;# defeat accidental saving of override
154    set bg_action {}
155    for {set i 0} {$i < $argc} {incr i} {
156	set arg [lindex $argv $i]
157	case $arg {
158	    "-geo*" {
159		incr i
160		set geo [lindex $argv $i]
161	    }
162	    "-iconposition" {
163		incr i
164		set icon [lindex $argv $i]
165	    }
166	    "-iconic" {
167		set iconic 1
168		option add *Fltop.iconic 1
169	    }
170	    "-bgAction" {
171		incr i
172		set exmh(background) [lindex $argv $i]
173	    }
174	    "-bgPeriod" {
175		incr i
176		set exmh(bgPeriod) [lindex $argv $i]
177	    }
178	    "-sedit" {
179		set editor(sedit!) 1
180	    }
181	    "-nofaces" {
182		set faces(enabled!) 1
183	    }
184	    "-*" {
185		catch {puts stderr "Unknown flag argument $arg"}
186	    }
187	    default {
188		lappend extra $arg
189	    }
190	}
191    }
192    # wish snarfs up -geometry and puts it into "geometry"
193    global geometry
194    if [info exists geometry] {
195	set geo $geometry
196    }
197    if {$geo != {}} {
198	if [catch {wm geometry . $geo} err] {
199	    catch {puts stderr "-geometry $geo: $err"}
200	}
201    }
202    switch $iconic {
203	""	{set exmh(iconic) 0}
204	True	-
205	TRUE	-
206	true	-
207	Yes	-
208	YES	-
209	yes	-
210	1	{set exmh(iconic) 1}
211	False	-
212	FALSE	-
213	false	-
214	no	-
215	NO	-
216	No	-
217	0	{set exmh(iconic) 0}
218    }
219    if {$icon != {}} {
220	Exwin_IconPosition . $icon
221    }
222
223    set argv $extra
224    set argc [llength $extra]
225}
226proc Exmh_Focus {} {
227    global exwin
228    if {[info exist exwin(mtext)]} {
229      focus $exwin(mtext)
230    }
231}
232proc ExmhResources {} {
233    global exmh
234    if {[winfo depth .] > 4} {
235	Preferences_Resource exmh(c_st_normal) c_st_normal blue
236	Preferences_Resource exmh(c_st_error) c_st_error purple
237	Preferences_Resource exmh(c_st_warn) c_st_warn red
238	Preferences_Resource exmh(c_st_bg_msgs) c_st_bg_msgs "medium sea green"
239	Preferences_Resource exmh(c_st_background) c_st_background "\#d9d9d9"
240    } else {
241	Preferences_Resource exmh(c_st_normal) c_st_normal black
242	if {$exmh(c_st_normal) != "white" && $exmh(c_st_normal) != "black"} {
243	    set exmh(c_st_normal) black
244	}
245	set exmh(c_st_error) $exmh(c_st_normal)
246	set exmh(c_st_warn) $exmh(c_st_normal)
247	set exmh(c_st_background) $exmh(c_st_normal)
248    }
249}
250
251proc Exmh_Status {string { level normal } } {
252    global exmh exwin
253    if {[string compare $string 0] == 0 } { set string $exmh(version) }
254    if [info exists exwin(status)] {
255	switch -- $level {
256	    warn	{ # do nothing }
257	    error	{ # do nothing }
258	    background	{set level bg_msgs}
259	    normal	{ # do nothing }
260	    default	{set level normal}
261	}
262	if ![info exists exmh(c_st_$level)] {
263	    set exmh(c_st_$level) black
264	}
265	$exwin(status) configure -state normal
266	catch {$exwin(status) configure -fg $exmh(c_st_$level)}
267	$exwin(status) delete 0 end
268	$exwin(status) insert 0 $string
269	# get the readonlyBackground to match the regular one...
270	set state_color [lindex [ $exwin(status) configure -background ] 4 ]
271	$exwin(status) configure -state readonly -readonlybackground $state_color
272	ExmhLog $string
273	update idletasks
274    } else {
275	catch {puts stderr "exmh: $string"}
276    }
277}
278proc Exmh_OldStatus {} {
279    global exwin
280    if [info exists exwin(status)] {
281	return [$exwin(status) get]
282    } else {
283	return ""
284    }
285}
286
287proc Exmh_CheckPoint {} {
288    # This is really "folder change" CheckPoint
289    Exmh_Debug Scan_CacheUpdate [time Scan_CacheUpdate]
290}
291
292proc Exmh_Done {{exit 1}} {
293    global exmh exwin
294
295    if { !$exit || ([Ftoc_Changes "exit"] == 0)} then {
296	if $exit {
297	    $exwin(mainButtons).quit config -state disabled
298	    catch {exec date} d
299	    Audit "Quit $d"
300	}
301	Exmh_Status "Checkpointing state" warning
302	if [info exists exmh(newuser)] {
303	    PreferencesSave nodismiss	;# Save tuned parameters
304	    unset exmh(newuser)
305	}
306	# The following is done in response to WM_SAVE_YOURSELF
307	foreach cmd {Sedit_CheckPoint Aliases_CheckPoint
308		    Exmh_CheckPoint Fcache_CheckPoint
309		    Exwin_CheckPoint } {
310	    if {[info command $cmd] != {}} {
311		Exmh_Status $cmd
312		if [catch $cmd err] {
313		    catch {puts stderr "$cmd: $err"}
314		}
315	    }
316	}
317	if {$exit} {
318	    # This only happens when we quit.
319	    Background_Wait
320	    set cmds [concat {Scan_CacheUpdate Background_Cleanup
321			Audit_CheckPoint Addr_CheckPoint Mime_Cleanup
322			Pgp_CheckPoint Cache_Cleanup} \
323			[info commands Hook_CheckPoint*]]
324
325	    foreach cmd $cmds {
326		if {[info command $cmd] != {}} {
327		    Exmh_Status $cmd
328		    if [catch $cmd err] {
329			catch {puts stderr "$cmd: $err"}
330		    }
331		}
332	    }
333	    destroy .
334	} else {
335	    # Tell the session manager we are done saving state
336	    global argv0 argv
337	    wm command . [concat $argv0 $argv]
338	    wm group . .
339	}
340    }
341}
342proc Exmh_Abort {} {
343    Background_Cleanup
344    destroy .
345}
346
347proc ExmhUnmapped {w} {
348    # This triggers auto-commit
349    if {$w == "."} {
350	Ftoc_Changes iconified
351    }
352}
353proc ExmhMapped {w} {
354    if {$w == "."} {
355	Inc_Mapped
356    }
357}
358
359#### Exmh_Debugging
360
361proc Exmh_Debug { args } {
362    global exmhDebug
363    if ![info exists exmhDebug] {
364	set exmhDebug 0
365    }
366    if {$exmhDebug} {
367	puts stderr $args
368    }
369    ExmhLog $args
370}
371
372proc ExmhLogInit {} {
373    global exmh
374    set exmh(logInit) 1
375    set exmh(logButton) 0
376    set exmh(logWindow) 0
377    set exmh(logWrite) 0
378}
379proc ExmhLog { stuff } {
380    global exmh
381    if {![info exists exmh(logInit)]} {
382	return
383    }
384    if {! $exmh(logEnabled)} {
385	return
386    }
387    if {! $exmh(logButton)} {
388	global exwin
389	if [info exists exwin(mainButtons)] {
390	    Widget_AddBut $exwin(mainButtons) log "Log" { ExmhLogShow }
391	    set exmh(logButton) 1
392	}
393    }
394    if {! $exmh(logWindow)} {
395	ExmhLogCreate
396	wm withdraw $exmh(logTop)
397    }
398    if {! $exmh(logWrite)} {
399	return
400    }
401    if [info exists exmh(log)] {
402	catch {
403	    $exmh(log) insert end [clock format [clock seconds] -format "%H:%M:%S "]
404            set sec [clock seconds]
405            set now [clock clicks -milliseconds]
406            if {[info exist exmh(logLastClicks)]} {
407                set delta [expr {$now - $exmh(logLastClicks)}]
408                set delta_sec [expr {$sec - $exmh(logLastSeconds)}]
409
410                # We don't really know how long the clock clicks value
411                # runs before wrapping.  If the seconds delta is "too big",
412                # we just ditch the milliseconds
413                if {$delta < 0 || $delta_sec > 20} {
414                  $exmh(log) insert end "([format %d. $delta_sec]) "
415                } else {
416                  set delta_sec 0
417                  while {$delta > 1000} {
418                    incr delta_sec
419                    incr delta -1000
420                  }
421                  $exmh(log) insert end "([format %d.%.03d $delta_sec $delta]) "
422                }
423            }
424            set exmh(logLastClicks) $now
425            set exmh(logLastSeconds) $sec
426	    $exmh(log) insert end $stuff
427	    $exmh(log) insert end \n
428	    if {$exmh(logYview)} {
429		$exmh(log) yview -pickplace "end - 1 lines"
430	    }
431	    scan [$exmh(log) index end] %d numlines
432	    if {$numlines > $exmh(logLines)} {
433		set numlines [expr {$numlines - $exmh(logLines)}]
434		$exmh(log) delete 1.0 $numlines.0
435	    }
436	}
437    }
438}
439proc ExmhLogCreate {} {
440    global exmh
441    set exmh(logWindow) 1
442    Exwin_Toplevel .log "Exmh Log" Log
443    set exmh(logTop) .log
444    set exmh(logDisableBut) \
445	[Widget_AddBut $exmh(logTop).but swap "Disable" ExmhLogToggle]
446    set exmh(logWrite) 1
447    Widget_AddBut $exmh(logTop).but trunc "Truncate" ExmhLogTrunc
448    Widget_AddBut $exmh(logTop).but save "Save To File" ExmhLogSave
449    set exmh(logYview) 1
450    Widget_CheckBut $exmh(logTop).but yview "View Tail" exmh(logYview)
451    set exmh(log) [Widget_Text $exmh(logTop) 20 \
452	    -setgrid true -yscroll {.log.sv set} ]
453    #
454    # Set up Tcl command type-in
455    #
456    Widget_BindEntryCmd $exmh(log) <Control-c>  \
457	"focus $exmh(logTop).cmd.entry"
458    bindtags $exmh(log) [list $exmh(log) Text $exmh(logTop) all]
459    Widget_BeginEntries 4 80 Exmh_DoCommand
460    Widget_LabeledEntry $exmh(logTop).cmd Tcl: exmh(command)
461}
462
463proc ExmhSourceFile {} {
464    global exmh
465    if ![info exists exmh(lastsource)] {
466	set exmh(lastsource) $exmh(library)
467    }
468    set name [FSBox "Source File" $exmh(lastsource) read]
469    if {$name != ""} {
470	Exmh_Debug source $name
471	source $name
472	set exmh(lastsource) $name
473    }
474}
475proc LOG { what } {
476    if {[info commands log_dump] == "log_dump"} {
477	log $what	;# in-memory logging
478    }
479}
480proc ExmhLogShow {} {
481    global exmh
482    if [Exwin_Toplevel .log "Exmh Log" Log] {
483	ExmhLogCreate
484    } else {
485	# Exwin_Toplevel raises the window with saved geometry
486    }
487}
488proc ExmhLogTrunc {} {
489    global exmh
490    $exmh(log) delete 1.0 end
491}
492proc ExmhLogSave {} {
493    global exmh
494    for {set id 0} {$id < 100} {incr id} {
495	set name [Env_Tmp]/exmhlog.$id
496	if ![file exists $name] {
497	    if ![catch {open $name w} logfile] {
498		break
499	    }
500	}
501    }
502    if [catch {
503	puts $logfile [$exmh(log) get 1.0 end]
504	close $logfile
505	Exmh_Status "Saved log in [Env_Tmp]/exmhlog.$id"
506    } msg] {
507	Exmh_Status "Cannot save log: $msg" error
508    }
509}
510proc ExmhLogToggle {} {
511    global exmh
512
513    set exmh(logWrite) [expr ! $exmh(logWrite)]
514    $exmh(logDisableBut) configure -text [lindex {"Enable " Disable} $exmh(logWrite)]
515}
516#### Misc
517
518proc DoNothing { args } {
519    return ""
520}
521proc Exmh_DoCommand {} {
522    global exmh
523    if {[string length $exmh(command)] == 0} {
524	return
525    }
526    set t $exmh(log)
527    $t insert end $exmh(command)\n
528    update idletasks
529    if [catch {uplevel #0 $exmh(command)} result] {
530	global errorInfo
531	$t insert end "ERROR\n$errorInfo\n\n"
532    } else {
533	$t insert end $result\n\n
534    }
535    $t see end
536}
537
538proc Tcl_Tk_Vers_Init {} {
539    # Here we do any special tuning needed for specific Tcl/Tk releases
540    # For instance, 8.4a2 and later moved some private variables into
541    # namespaces, so we need to do backward-compatibility until we
542    # fix the code everyplace.
543    global tk_version tk_patchLevel tcl_version tcl_patchLevel
544    if {[info exists tk_version] && ($tk_version > "8.3")} {
545        ::tk::unsupported::ExposePrivateCommand tkEntryBackspace
546        ::tk::unsupported::ExposePrivateCommand tkEntrySeeInsert
547        ::tk::unsupported::ExposePrivateCommand tkMenuUnpost
548        ::tk::unsupported::ExposePrivateCommand tkTextButton1
549        ::tk::unsupported::ExposePrivateCommand tkEntryButton1
550        ::tk::unsupported::ExposePrivateCommand tkTextResetAnchor
551        ::tk::unsupported::ExposePrivateVariable tkPriv
552    }
553}
554