1#
2# mh.tcl --
3#	MH support. This is divided into two parts:
4#		Thin layers on the MH commands
5#		Parsing and setting up the mhProfile
6#
7# Copyright (c) 1993 Xerox Corporation.
8# Use and copying of this software and preparation of derivative works based
9# upon this software are permitted. Any distribution of this software or
10# derivative works must comply with all applicable United States export
11# control laws. This software is made available AS IS, and Xerox Corporation
12# makes no warranty about the software, its performance or its conformity to
13# any specification.
14
15proc Mh_Init {} {
16    global exmh nmh
17    MhParseProfile
18
19    catch {MhExec repl -help} output
20    set nmh [string match *group* $output]
21
22    # set $exmh(mh_vers) to a pretty-printable string...
23    set exmh(mh_vers) "unknown"
24    if { $nmh } {
25	# 'repl -- version [compiled etc etc]' - catch version
26	catch {MhExec repl -version} d
27	regexp {.*-- *([^ ]*)[ ]} $d {} exmh(mh_vers)
28	# See if it's an nmh patched to support setting info for rfc3461 DSNs
29	set exmh(nmh_dsn) 0
30	catch {MhExec send -help} d
31	set d1 [ split $d "\n"]
32	foreach line $d1 {
33	    regexp {envid} $line d2
34	    if [info exists d2] { set exmh(nmh_dsn) 1 }
35	}
36    } else {
37	# UCI MH - 'version: .*'
38	# weirdness - 6.8 puts 'version (build on ...)', 6.6 (blech) doesnt.
39	catch {MhExec repl -help} d
40	set d1 [ split $d "\n"]
41	foreach line $d1 {
42	    regexp {^version:[ ]*([^(]*)} $line d2
43	    if [info exists d2] { set exmh(mh_vers) [string trim $d2] }
44	}
45    }
46    # Test for now, only present in nmh 1.6+dev and 1.7
47   if { $nmh} {
48        catch {MhExec mhical -version} d
49        regexp {.*-- *([^ ]*)[ ]} $d d2
50        if [info exists d2] {set exmh(have_mhical) 1 }
51        catch {MhExec gcalcli --version} d
52        regexp {.*v([.0-9]*)[ ]} $d d2
53        if [info exists d2] {set exmh(have_gcalcli) 1 }
54   }
55}
56
57proc Mh_Preferences {} {
58    global mhProfile
59    Preferences_Add "MH Tweaks" \
60"Note that most of MH is parameterized by your [file tail $mhProfile(profile)] file.
61These options just affect a few things particular to exmh." [list \
62	{mhProfile(scan-proc) scanProc {scan -noheader} {Scan program}
63"If you have a custom scan program, name it here."} \
64	{mhProfile(sendType) sendType {CHOICE wait async xterm} {How to send messages}
65"There are three ways exmh can send a message for you:
66wait: exmh waits until the message is successfully posted.
67It displayes any error messages and lets you retry after a failure.
68async: exmh does not wait for the message to be posted.
69If there are errors, they are mailed back to you.
70xterm: exmh runs send in an xterm.  Exmh does not wait for
71your interaction with send to complete."} \
72	{mhProfile(xtermcmd) xtermCmd {xterm -g 80x5} {xterm command parameters}
73"When \"Send in xterm window\" is selected,
74this option controls extra parameters provided
75to the xterm program to control how it is started."} \
76	{mhProfile(forwtweak) forwTweak ON {Tweak subject lines of forwarded messages}
77"If this option is enabled, the subject line of forwarded messages
78will be tweaked, in a similar manner to the prefixing of \"Re:\" to
79the subject of replies.  This is only performed if the draft message
80does not already contain a subject line (or if it is empty), as given
81in your forwcomps file."} \
82	{mhProfile(forwsubj) forwSubj {$subj (fwd)} {Subject line for forwarded messages}
83"When \"Tweak subject lines of forwarded messages\" is enabled, this
84option specifies the particular tweak to perform.  This usually consists
85of suffixing \"(fwd)\" or prefixing \"Fw:\" (both of which are removed
86if present in the original subject line).  The variable \$subj here is
87replaced with the subject of the original message."} \
88	[list mhProfile(delprefix) delPrefix [MhBackup] {Prefix of rmm'd files} \
89"The Delete operation in MH really only renames a message file to have
90a prefix like # or , (comma).  This prefernce setting is used to
91set that prefix if you have a custom remove proc. The default setting is
92correct for your version of MH."] \
93	{mhProfile(purgeage) purgeAge 7 {Age, in days of files to purge}
94"The Purge operation will remove deleted messages that are older
95than this number of days."} \
96    ]
97    #
98    # Backwards compatibility.  Nuke when 1.6alpha and 1.5.3 are dead.
99    #
100    set async [option get . sendAsync {}]
101    if {[string length $async]} {
102	set mhProfile(sendType) [expr {$async ? "async" : "wait"}]
103    }
104}
105
106proc MhBackup {} {
107    set sbackup {}
108    catch {set sbackup [exec mhparam sbackup]}
109    if {[string length $sbackup] == 0} {
110	catch {exec mhparam -help} x
111	regexp {SBACKUP="\"([^\"]+)\""} $x match sbackup
112    }
113    if {[string length $sbackup] == 0} {
114	set sbackup #
115    }
116    return $sbackup
117}
118
119# Run an MH program and check for errors.
120# If the context file gets corrupted, just remove it and try again.
121proc MhExec { args } {
122    global mhProfile
123    Audit $args
124    set args [join $args]
125    if {[catch {eval exec $args} result]} {
126	global errorInfo
127	if {[regexp {exmhcontext is poorly formatted} $result]} {
128	    Exmh_Status "Resetting .exmhcontext" error
129	    exec cat /dev/null > $mhProfile(path)/.exmhcontext
130	    return [eval exec $args]
131	} else {
132	    error $result $errorInfo
133	}
134    } else {
135#	These Exmh_Debug calls break up the atomicity of commit actions
136#	by the background process because of Tk send and timer handling.
137#	The periodic maintenence task can sneak in on us.
138#	Exmh_Debug MhExec $args
139	return $result
140    }
141}
142
143# The following are default comp, repl, and forw setup procedures
144# passed to Msg_Comp, Msg_Reply, and Msg_Forward, respectively.
145proc Mh_CompSetup {} {
146    global exmh mhProfile msg
147    set indrafts [expr \
148	{[string compare $exmh(folder) $mhProfile(draft-folder)] == 0}]
149    if {$indrafts && ([string length $msg(id)] != 0)} {
150	Exmh_Status "comp -use $msg(id)"
151	Mh_SetCur $mhProfile(draft-folder) $msg(id)
152    } else {
153        set path [Mh_FindFile "components"]
154	if {0 != [string length $path]} {
155	    Exmh_Status "comp -form $path/components"
156	    MhExec comp -nowhatnowproc -form $path/components
157	} else {
158	    Exmh_Status "comp"
159	    MhExec comp -nowhatnowproc
160	}
161	if {$indrafts} {
162	    # In drafts with no previously current message
163	    Scan_Folder $exmh(folder)
164	    Msg_Change [Seq_Msgs $exmh(folder) cur]
165	}
166    }
167    set exmh([Mh_Cur $mhProfile(draft-folder)],action) comp
168}
169proc Mh_CompUseSetup {} {
170    global exmh msg
171    if {$msg(id) != {}} {
172	Exmh_Status "comp -use $msg(id)"
173	MhExec comp +$exmh(folder) $msg(id) -nowhatnowproc
174    } else {
175	Exmh_Status "No current message" warn
176    }
177    set exmh([Mh_Cur $mhProfile(draft-folder)],action) comp
178}
179proc Mh_ReplySetup { folder msg } {
180    global mhProfile exmh
181    set path [Mh_FindFile "replcomps"]
182    if {0 != [string length $path]} {
183	Exmh_Status "repl +$folder $msg -form $path/replcomps"
184	MhExec repl +$folder $msg -nowhatnowproc -nocc cc -nocc to -form $path/replcomps
185    } else {
186	Exmh_Status "repl +$folder $msg"
187	MhExec repl +$folder $msg -nowhatnowproc -nocc cc -nocc to
188    }
189    MhAnnoSetup $folder $msg repl
190}
191proc Mh_ReplyAllSetup { folder msg } {
192    global mhProfile exmh
193    set path [Mh_FindFile "replcomps"]
194    if {0 != [string length $path]} {
195	Exmh_Status "repl +$folder $msg -form $path/replcomps"
196	MhExec repl +$folder $msg -nowhatnowproc -cc cc -cc to -form $path/replcomps
197    } else {
198	Exmh_Status "repl +$folder $msg"
199	MhExec repl +$folder $msg -nowhatnowproc -cc cc -cc to
200    }
201    MhAnnoSetup $folder $msg repl
202}
203proc Mh_Forw_MungeSubj { folder msgs } {
204    global mhProfile
205    set draftID [Mh_Cur $mhProfile(draft-folder)]
206    if {![catch {eval exec scan +$folder -noheader -format "%{subject}" $msgs} subj]} {
207	# just take the first line of $subj (in case of >1 messages)
208	set subj [lindex [split $subj "\n"] 0]
209	# strip off leading and trailing "fw:", "(fwd)", "<fwd>" and whitespace
210	regsub -nocase "^(\[ 	\]*((fwd?:)|(\\(fwd?\\))|(<fwd?>)))*" $subj {} subj
211	regsub -nocase "(((\\(fwd?\\))|(<fwd?>))\[ 	\]*)*$" $subj {} subj
212	set subj [string trim $subj]
213	# quote any rogue \'s or &'s in the subject line
214	regsub -all {\\} $subj {\\\\} subj
215	regsub -all {&} $subj {\\\&} subj
216	# now do the required munging, and quote \'s and &'s again
217	regsub -all {\$subj} $mhProfile(forwsubj) $subj subj
218	regsub -all {\\} $subj {\\\\} subj
219	regsub -all {&} $subj {\\\&} subj
220	catch {
221	    set fd [open $mhProfile(path)/$mhProfile(draft-folder)/$draftID r]
222	    set msgtxt [read $fd]
223	    close $fd
224	    if {[regexp -indices "\n(--+)?(\n|\$)" $msgtxt posn]} {
225		set cpos [lindex $posn 0]
226		set hdrtxt [string range $msgtxt 0 [expr {$cpos-1}]]
227		set bodytxt [string range $msgtxt $cpos end]
228	    } else {
229		set hdrtxt $msgtxt
230		set bodytxt {}
231	    }
232	    unset msgtxt
233	    if {[regexp "^|\n\[Ss\]ubject:" $hdrtxt]} {
234		regsub "(^|\n)(\[Ss\]ubject:)\[ 	\]*(\n|\$)" $hdrtxt "\\1\\2 $subj\\3" nhdrtxt
235	    } else {
236		set nhdrtxt "$hdrtxt\nSubject: $subj"
237	    }
238	    set fd [open $mhProfile(path)/$mhProfile(draft-folder)/$draftID w]
239	    puts -nonewline $fd $nhdrtxt
240	    puts -nonewline $fd $bodytxt
241	    close $fd
242	}
243    }
244}
245proc Mh_ForwSetup { folder msgs } {
246    global mhProfile exmh
247    set path [Mh_FindFile "forwcomps"]
248    if {0 != [string length $path]} {
249	Exmh_Status "forw +$folder $msgs -form $path/forwcomps"
250	eval {MhExec forw +$folder} $msgs -nowhatnowproc -form $path/forwcomps
251    } else {
252	Exmh_Status "forw +$folder $msgs"
253	eval {MhExec forw +$folder} $msgs -nowhatnowproc
254    }
255    MhAnnoSetup $folder $msgs forw
256    if {$mhProfile(forwtweak)} {
257	Mh_Forw_MungeSubj $folder $msgs
258    }
259}
260proc Mh_DistSetup { folder msg } {
261    global exmh mhProfile
262    set path [Mh_FindFile "distcomps"]
263    if {0 != [string length $path]} {
264	Exmh_Status "dist +$folder $msg -form $path/distcomps"
265        MhExec dist +$folder $msg -nowhatnowproc -form $path/distcomps
266    } else {
267        Exmh_Status "dist +$folder $msg"
268        MhExec dist +$folder $msg -nowhatnowproc
269    }
270    MhAnnoSetup $folder $msg dist
271}
272proc MhAnnoSetup { folder msg key args } {
273    global mhProfile exmh
274    set draftID [Mh_Cur $mhProfile(draft-folder)]
275    set exmh($draftID,mhaltmsg) $mhProfile(path)/$folder/$msg
276    set exmh($draftID,mhfolder) $mhProfile(path)/$folder
277    set exmh($draftID,folder) $folder
278    set exmh($draftID,mhmessages) $msg
279    set exmh($draftID,action) $key
280    Exmh_Debug MhAnnoSetup action $key for $draftID
281
282	# I don't assume both alternative options will be set together
283	set noannoIX [lsearch $args -noannotate]
284	set annoIX [lsearch $args -annotate]
285	if { ($exmh(anno,$key) || ($annoIX >= 0)) &&  ($noannoIX < 0) } {
286		set exmh($draftID,mhanno$key) 1
287	}
288
289	set noinplaceIX [lsearch $args -noinplace]
290	set inplaceIX [lsearch $args -inplace]
291    if { ($exmh(inplace,$key) || ($inplaceIX >= 0)) && \
292		 ($noinplaceIX < 0) } {
293			set exmh($draftID,mhinplace$key) 1
294    }
295}
296proc Mh_AnnoEnviron { draftID } {
297    global exmh env
298    if {![info exists exmh($draftID,mhaltmsg)]} {
299	return 0
300    }
301    set env(mhaltmsg) $exmh($draftID,mhaltmsg)
302    set env(mhfolder) $exmh($draftID,mhfolder)
303    set env(mhmessages) $exmh($draftID,mhmessages)
304    if {[info exists exmh($draftID,mhinplace)]} {
305      set env(mhinplace) 1
306    }
307    if {$exmh($draftID,action) == "dist"} {
308	# dist requires annotation; it just does.
309	set env(mhdist) 1
310	set env(mhannodist) 1
311	set env(mhannotate) "Resent"
312	return [info exists exmh($draftID,mhannodist)]
313    }
314    if {[info exists exmh($draftID,mhannorepl)]} {
315	set env(mhannorepl) 1
316	set env(mhannotate) "Replied"
317	return $exmh($draftID,mhannorepl)
318    }
319    if {[info exists exmh($draftID,mhannoforw)]} {
320	set env(mhannoforw) 1
321	set env(mhannotate) "Forwarded"
322	return $exmh($draftID,mhannoforw)
323    }
324    return 0
325}
326proc Mh_AnnoCleanup { draftID } {
327    global exmh env
328
329    foreach key {mhannoforw mhannorepl mhannodist mhannotate mhdist
330		 mhaltmsg mhfolder mhmessages mhinplace folder action} {
331	if {[info exist exmh($draftID,$key)]} {
332	    unset exmh($draftID,$key)	;# Faster than catch-unset
333	}
334	if {[regexp ^mh $key]} {
335	    catch {unset env($key)}
336	}
337    }
338}
339
340proc Mh_Folder { f } {
341    if {[catch {MhExec folder +$f < /dev/null} info]} {
342	Exmh_Debug Mh_Folder caught $info
343	return {}
344    } else {
345	if {[regexp {\+[^0-9]+ ([0-9]+) [^(]*\(([^)]+)\)} $info x total range]} {
346	    regsub -all { } $range {} range
347	    return "$f+ $total msgs ($range)"
348	} else {
349	    return $info
350	}
351    }
352}
353proc Mh_FolderNew { f } {       ;# Not sure if this name is still used
354    Mh_SetContext Current-Folder $f
355}
356proc Mh_FolderFast { f } {
357    Mh_SetContext Current-Folder $f
358}
359proc Mh_SetContext { key value } {
360    global mhProfile
361    set in [open $mhProfile(context) r]
362    if {[catch {open $mhProfile(context).new w} out] == 0} {
363	while {[gets $in line] >= 0} {
364	    if {[regexp -nocase "^$key: (.*)$" $line match oldvalue]} {
365		puts $out "$key: $value"
366	    } else {
367		if {$line != {}} {
368		    puts $out $line
369		}
370	    }
371	}
372	close $in
373	close $out
374	file rename -force $mhProfile(context).new $mhProfile(context)
375	return $value
376    } else {
377	close $in
378	Exmh_Status "Cannot write $mhProfile(context).new" error
379    }
380}
381proc Mh_MsgChk {} {
382    global inc pop
383
384    if {[string length $inc(pophost)]} {
385	# See if we know the password for this host
386	Pop_GetPassword $inc(pophost)
387	catch {exec msgchk -nodate -notify mail -host $inc(pophost) << $pop(password)} result
388	Exmh_Debug Mh_MsgChk $result
389	# Remove 'Password (host:user):' prompt from result string, and
390	# msgchk returned 1 because no messages were waiting, remove the
391	# error message left by 'exec'
392	regsub {.*\):} $result {} result
393	regsub "\n.*" $result {} result
394    } else {
395	catch {MhExec msgchk -nodate -notify mail} result
396    }
397
398    return $result
399}
400proc Mh_MsgCount { spool } {
401    return [exec egrep "^From " $spool | wc -l]
402}
403proc Mh_CurSafe { folder } {
404    MhExec folder +$folder -push < /dev/null
405    if {[catch {MhExec pick +$folder -list cur} cur]} {
406	set cur {}
407    }
408    MhExec folder -pop < /dev/null
409    return $cur
410}
411
412proc Mh_SetCur { folder msgid } {
413    global mhPriv
414    if {[info exists mhPriv(cur,$folder)] &&
415	($mhPriv(cur,$folder) == $msgid)} {
416	return
417    }
418    Mh_SequenceUpdate $folder replace cur $msgid
419    Seq_Set $folder cur $msgid
420    set mhPriv(cur,$folder) $msgid
421}
422proc Mh_Cur { folder } {
423    global mhPriv
424    if {[catch {MhCur $folder} cur]} {
425	set cur [Mh_CurSafe $folder]
426    }
427    set mhPriv(cur,$folder) $cur
428    return $mhPriv(cur,$folder)
429}
430proc MhCur { folder } {
431    # pick +folder cur changes the context, so we access the files directly
432    global mhProfile
433    if {$folder == {}} {
434	return {}
435    }
436    set cur [Seq_Msgs $folder cur]
437    if {[file exists $mhProfile(path)/$folder/$cur]} {
438	return $cur
439    } else {
440	return {}
441    }
442}
443proc MhReadSeqs {folder seqsvar} {
444    global mhProfile mhPriv
445    upvar $seqsvar seqs
446    # First read the private sequence
447    set mhPriv(changed,private) 0
448    set filename $mhProfile(context)
449    if {![catch {set mtime [file mtime $filename]}]} {
450	if {![info exists mhPriv(privmtime)] || ($mtime != $mhPriv(privmtime))} {
451            array unset mhPriv privseq,${folder},*
452            FlistUncacheLocal $folder
453	    if {[catch {open $filename r} in] == 0} {
454		Exmh_Debug MhReadSeqs Reading $filename
455		set old [read $in]
456		close $in
457		set mhPriv(otherpriv) {}
458		foreach line [split $old \n] {
459		    if {$line != {}} {
460			if {[regexp {^([^:]*):\s*(.*)$} $line foo tag msgids]} {
461			    if {[regexp "atr-(.*)-$mhProfile(path)/(.*)" $tag foo seq thisfolder]} {
462				set mhPriv(privseq,$thisfolder,$seq) [MhSeqExpand $thisfolder $msgids]
463				set mhPriv(mode,$seq) private
464			    } else {
465				lappend mhPriv(otherpriv) "$line"
466			    }
467			} else {
468			    Exmh_Status "Bad line in $filename: $line"
469			}
470		    }
471		}
472		set mhPriv(privmtime) $mtime
473	    }
474	}
475    } elseif {[info exists mhPriv(privmtime)]} {
476	unset mhPriv(privmtime)
477        array unset mhPriv privseq,${folder},*
478        FlistUncacheLocal $folder
479    }
480    # mhPriv(privseq,folder,sequence) contains list of message IDs
481    foreach elem [array names mhPriv privseq,${folder},*] {
482	set indices [split $elem ,]
483        set seqs([lindex $indices 2]) $mhPriv($elem)
484    }
485    # Then read the public sequence
486    set mhPriv(changed,public) 0
487    set filename "$mhProfile(path)/$folder/$mhProfile(mh-sequences)"
488    if {![catch {set mtime [file mtime $filename]}]} {
489	if {![info exists mhPriv(seqmtime,$folder)] || ($mtime != $mhPriv(seqmtime,$folder))} {
490            array unset mhPriv pubseq,${folder},*
491            FlistUncacheLocal $folder
492	    if {[catch {open $filename r} in] == 0} {
493		Exmh_Debug MhReadSeq Reading $filename
494		set old [read $in]
495		close $in
496		foreach line [split $old \n] {
497		    if {$line != {}} {
498			if {[regexp {^([^:]*):\s*(.*)$} $line foo seq msgids]} {
499			    if {[info exists mhPriv(mode,$seq)] && $mhPriv(mode,$seq) == "private" && [info exists mhPriv(pubseq,$folder,$seq)]} {
500				# If this was also in the private file, merge the two
501				# and move to the public file.
502				set mhPriv(changed,private) 1
503				lappend mhPriv(pubseq,$folder,$seq) [MhSeq $folder $seq add $mhPriv(pubseq,$folder,$seq) [MhSeqExpand $folder $msgids]]
504			    } else {
505				set mhPriv(pubseq,$folder,$seq) [MhSeqExpand $folder $msgids]
506			    }
507			    set mhPriv(mode,$seq) public
508			} else {
509			    Exmh_Status "Bad line in $filename: $line"
510			}
511		    }
512		}
513		set mhPriv(seqmtime,$folder) $mtime
514	    }
515	}
516    } elseif {[info exists mhPriv(seqmtime,$folder)]} {
517	unset mhPriv(seqmtime,$folder)
518        array unset mhPriv pubseq,${folder},*
519        FlistUncacheLocal $folder
520    }
521    foreach elem [array names mhPriv pubseq,${folder},*] {
522	set indices [split $elem ,]
523        set seqs([lindex $indices 2]) $mhPriv($elem)
524    }
525}
526
527proc MhGetSeqCache {folder seq } {
528    global mhPriv
529    set seqlist ""
530    if {[info exists mhPriv(pubseq,$folder,$seq)]} {
531        set seqlist $mhPriv(pubseq,$folder,$seq)
532    }
533    if {[info exists mhPriv(privseq,$folder,$seq)]} {
534        lappend seqlist $mhPriv(privseq,$folder,$seq)
535    }
536    return $seqlist
537}
538
539proc Mh_Sequences { folder } {
540    MhReadSeqs $folder seqs
541    return [array names seqs]
542}
543proc Mh_Sequence { folder seq } {
544    # pick +folder cur changes the context, so we access the files directly
545    MhReadSeqs $folder seqs
546    if [info exists seqs($seq)] {
547	return [MhSeqExpand $folder $seqs($seq)]
548    } else {
549	return {}
550    }
551}
552proc MhSeqExpand { folder sequence } {
553    global mhProfile
554    # Explode a sequence into a list of message numbers
555    set seq {}
556    set rseq {}
557    foreach range [split [string trim $sequence]] {
558	if ![regexp {^[0-9]+(-[0-9]+)?$} $range] {
559	    # just ignore anything bogus
560	    continue;
561	}
562	set parts [split [string trim $range] -]
563	if {[llength $parts] == 1} {
564	    lappend seq $parts
565	    set rseq [concat $parts $rseq]
566	} else {
567	    for {set m [lindex $parts 0]} {$m <= [lindex $parts 1]} {incr m} {
568		lappend seq $m
569		set rseq [concat $m $rseq]
570	    }
571	}
572    }
573    # Hack to weed out sequence numbers for messages that don't exist
574    foreach m $rseq {
575	if ![file exists $mhProfile(path)/$folder/$m] {
576	    Exmh_Debug $mhProfile(path)/$folder/$m not found
577	    set ix [lsearch $seq $m]
578	    set seq [lreplace $seq $ix $ix]
579	} else {
580	    # Real hack
581	    break
582	}
583    }
584    return $seq
585}
586
587# Directly modify the context files to add/remove/clear messages
588# from a sequence
589proc Mh_SequenceUpdate { folder how seq {msgids {}} {which public}} {
590    global mhProfile mhPriv
591    if {0} {
592	Exmh_Debug Mh_SequenceUpdate $folder $how $seq $msgids $which
593	set l [info level]
594	while {[incr l -1] > 0} {
595	    Exmh_Debug "    : [info level $l]"
596	}
597    }
598    if {[info exist seqs]} {
599      unset seqs
600    }
601    array unset mhPriv(mode,$folder)    ;# array unset is ok if already unset
602    MhReadSeqs $folder seqs
603    # Set the value for the sequence we're updating
604    if {[info exist seqs($seq)]} {
605        set oldmsgids $seqs($seq)
606    } else {
607	set oldmsgids {}
608    }
609    set seqs($seq) [MhSeq $folder $seq $how $oldmsgids $msgids]
610    if {![catch {set mhPriv(mode,$seq)}] && ($mhPriv(mode,$seq) != $which)} {
611	set mhPriv(changed,$mhPriv(mode,$seq)) 1
612    }
613    set mhPriv(mode,$seq) $which
614    set oldseq [MhSeqMake $oldmsgids]
615    if {$seqs($seq) != $oldseq} {
616	Exmh_Debug "$seq: $oldseq => $seqs($seq)"
617	set mhPriv(changed,$which) 1
618    }
619    if {$mhPriv(changed,public) == 1} {
620	set mhPriv(pubseq,$folder,$seq) [MhSeqExpand $folder $seqs($seq)]
621        FlistUncacheLocal $folder
622	set filename $mhProfile(path)/$folder/$mhProfile(mh-sequences)
623	if {[catch {open $filename.new w} out] == 0} {
624	    Exmh_Debug Writing $filename
625	    foreach thisseq [array names seqs] {
626		if {![info exists mhPriv(mode,$thisseq)]} {
627		    set mhPriv(mode,$thisseq) public
628		}
629		if {$mhPriv(mode,$thisseq) == "public"} {
630		    if {![regexp {^ *$} $seqs($thisseq)]} {
631			if [regexp -- {-} $seqs($thisseq)] {
632			    set realseq $seqs($thisseq)
633			} else {
634			    set realseq [MhSeqMake $seqs($thisseq)]
635			}
636			puts $out "$thisseq: $realseq"
637		    }
638		}
639	    }
640	    close $out
641	    Mh_Rename $filename.new $filename
642	    set mhPriv(seqmtime,$folder) [file mtime $filename]
643	} else {
644	    Exmh_Status "Couldn't write to $mhProfile(path)/$folder/$mhProfile(mh-sequences).new"
645	    set mhPriv(changed,private) 1
646	    foreach thisseq [array names seqs] {
647		set mhPriv(mode,$thisseq) "private"
648	    }
649	}
650    }
651    if {$mhPriv(changed,private) == 1} {
652	set mhPriv(privseq,$folder,$seq) [MhSeqExpand $folder $seqs($seq)]
653        FlistUncacheLocal $folder
654	set filename $mhProfile(context)
655	if {[catch {open $filename.new w} out] == 0} {
656	    Exmh_Debug Writing $filename
657	    puts $out [join $mhPriv(otherpriv) "\n"]
658	    foreach thisseq [array names seqs] {
659		if {[string compare $mhPriv(mode,$thisseq) "private"] == 0} {
660		    if {![regexp {^ *$} $seqs($thisseq)]} {
661			if [regexp -- {-} $seqs($thisseq)] {
662			    set realseq $seqs($thisseq)
663			} else {
664			    set realseq [MhSeqMake $seqs($thisseq)]
665			}
666			puts $out "atr-$thisseq-$mhProfile(path)/$folder: $realseq"
667		    }
668		}
669	    }
670	    close $out
671	    Mh_Rename $filename.new $filename
672	    set mhPriv(privmtime) [file mtime $filename]
673	}
674    }
675}
676proc MhSeq { folder seq how oldmsgids msgids } {
677    set new [MhSeqExpand $folder $msgids]
678    set old [MhSeqExpand $folder $oldmsgids]
679    if {[string compare $how "add"] == 0} {
680	set merge [lsort -integer -increasing [concat $old $new]]
681	set seq [MhSeqMake $merge]
682	return $seq
683    } elseif {[string compare $how "del"] == 0} {
684	set ix 0
685	set new [lsort -integer -increasing $new]
686	set next [lindex $new 0]
687	set merge {}
688	foreach id [lsort -integer -increasing $old] {
689	    while {$id > $next} {
690		incr ix
691		set next [lindex $new $ix]
692		if {[string length $next] == 0} {
693		    incr ix -1
694		    set next [lindex $new $ix]
695		    break
696		}
697	    }
698	    if {$id == $next} {
699		incr ix
700		set next [lindex $new $ix]
701	    } else {
702		lappend merge $id
703	    }
704	}
705	return [MhSeqMake $merge]
706    } elseif {[string compare $how "replace"] == 0} {
707	# replace
708	return [MhSeqMake $msgids]
709    } else {
710	return {}
711    }
712}
713proc MhSeqMakeOld { msgs } {
714    set result [lindex $msgs 0]
715    set first $result
716    set last $result
717    set id {}
718    foreach id [lrange $msgs 1 end] {
719	if {$id != $last} {
720	    if {$id == $last + 1} {
721		set last $id
722	    } else {
723		if {$last != $first} {
724		    append result -$last
725		}
726		set first $id
727		set last $id
728		append result " $first"
729	    }
730	}
731    }
732    if {$id == $last && [string length $msgs]} {
733	append result -$last
734    }
735    return $result
736}
737proc MhSeqMake { msgids } {
738    set result {}
739    set first {}
740    set last {}
741    foreach id $msgids {
742	if {$id == $last} {
743	    # Skipit
744	} elseif {($last != {}) && ($id == $last + 1)} {
745	    if {$first == {}} {
746		set first $last
747	    }
748	} else {
749	    if {$first != {}} {
750		lappend result "$first-$last"
751	    } elseif {$last != {}} {
752		lappend result $last
753	    }
754	    set first {}
755	}
756	set last $id
757    }
758    if {$first != {}} {
759	lappend result "$first-$last"
760    } elseif {$last != {}} {
761	lappend result $last
762    }
763    return $result
764}
765
766proc Mh_Path { folder msg } {
767    global mhProfile
768    if {[regexp {^[0-9]+$} $msg]} {
769	return $mhProfile(path)/$folder/$msg
770    } else {
771	return [MhExec mhpath +$folder $msg]
772    }
773}
774
775# Note - do not put Exmh_Debug calls into Mh_Refile, Mh_Copy, or Mh_Rmm
776# because that seems to open a window that allows the periodic background
777# tasks to run.  This causes a race between commit actions and background
778# inc/flist actions.
779
780proc Mh_Refile {srcFolder msgids folder} {
781    while {[llength $msgids] > 0} {
782	set chunk [lrange $msgids 0 19]
783	set msgids [lrange $msgids 20 end]
784	eval {MhExec refile} $chunk {-src +$srcFolder +$folder}
785    }
786}
787proc Mh_RefileFile {folder file} {
788    Exmh_Debug exec refile -link -file $file +$folder
789    eval {exec refile -link -file $file +$folder}
790}
791proc Mh_Copy {srcFolder msgids folder} {
792    while {[llength $msgids] > 0} {
793	set chunk [lrange $msgids 0 19]
794	set msgids [lrange $msgids 20 end]
795	eval {MhExec refile} $chunk {-link -src +$srcFolder +$folder}
796    }
797}
798proc Mh_Rmm { folder msgids } {
799    while {[llength $msgids] > 0} {
800	set chunk [lrange $msgids 0 19]
801	set msgids [lrange $msgids 20 end]
802	eval {MhExec rmm +$folder} $chunk
803    }
804}
805proc Mh_Send { msgid argu} {
806    global mhProfile
807
808    set path $mhProfile(path)/$mhProfile(draft-folder)/$msgid
809    set dst [Misc_PostProcess $path]
810
811    switch -- $mhProfile(sendType) {
812	"async" {
813	    MhExec $mhProfile(sendproc) -draftf +$mhProfile(draft-folder) \
814		-draftm $dst $argu -push -forward < /dev/null
815	}
816	"wait" {
817	    MhExec $mhProfile(sendproc) -draftf +$mhProfile(draft-folder) \
818		-draftm $dst $argu < /dev/null
819	}
820	"xterm" {
821	    eval exec $mhProfile(xtermcmd) { \
822		-title "Sending $mhProfile(draft-folder)/$msgid ..." \
823		-e sh -c "$mhProfile(sendproc) -draftf +$mhProfile(draft-folder) -draftm $dst $argu || whatnow -draftf +$mhProfile(draft-folder) -draftm $dst" &}
824	}
825    }
826    if {$msgid != $dst} {
827	# In case we made a copy during post processing.
828	Mh_Rmm $mhProfile(draft-folder) $msgid
829    }
830}
831proc Mh_Whom { msgid } {
832    global mhProfile
833    if {![regexp {^[0-9]+$} $msgid]} {
834	MhExec whom $msgid
835    } else {
836	MhExec whom -draftf +$mhProfile(draft-folder) -draftm $msgid
837    }
838}
839
840proc Mh_Sort { f args } {
841    if {[catch {eval {MhExec sortm +$f} $args} err]} {
842	Exmh_Status $err error
843    }
844}
845proc Mh_Pack { f } {
846    if {[catch {MhExec folder +$f -pack} err]} {
847	Exmh_Status $err error
848    }
849}
850
851proc MhParseProfile {} {
852    global mhProfile env
853    if {[info exists env(MH)]} {
854	set mhProfile(profile) $env(MH)
855    } else {
856	set mhProfile(profile) $env(HOME)/.mh_profile
857    }
858    if {[catch {open $mhProfile(profile) "r"} input]} {
859	if {[info exists mhProfile(FAIL)]} {
860	    puts stderr "Cannot open $mhProfile(profile): $input"
861	    exit 1
862	} else {
863	    set mhProfile(FAIL) 1
864	    MhSetupNewUser
865	    MhParseProfile
866	    unset mhProfile(FAIL)
867	    return
868	}
869    }
870    while {![eof $input]} {
871	set numBytes [gets $input line]
872	if {$numBytes > 0} {
873	    if {[regexp {^\s+(.*)$} $line foo other]} {
874		# handle continued lines
875		if {[info exists key]} {
876		    append mhProfile($key) " [string trim $other]"
877		}
878		continue
879	    }
880	    set parts [split $line :]
881	    set key [string tolower [lindex $parts 0]]
882	    set other [lindex $parts 1]
883	    set value [string trim $other]
884	    set mhProfile($key) $value
885	}
886    }
887    close $input
888    if {![info exists mhProfile(path)]} {
889	if {[info exists mhProfile(FAIL)]} {
890	    puts stderr "No Path entry in your [file tail $mhProfile(profile)] file."
891	    puts stderr "Run the \"inc\" command to get your"
892	    puts stderr "MH environment initialized right."
893	    exit 1
894	} else {
895	    set mhProfile(FAIL) 1
896	    MhSetupNewUser
897	    MhParseProfile
898	    unset mhProfile(FAIL)
899	    return
900	}
901    } else {
902	if {[string index $mhProfile(path) 0] != "/"} {
903	    set mhProfile(path) [glob ~]/$mhProfile(path)
904	}
905	if {![file isdirectory $mhProfile(path)]} {
906	    MhSetupNewUserInner
907	}
908    }
909    if {[info exists env(MHCONTEXT)]} {
910	set mhProfile(context) $env(MHCONTEXT)
911    }
912    if {![info exists mhProfile(context)]} {
913	set mhProfile(context) context
914    }
915    set mhProfile(context) [Mh_Pathname $mhProfile(context)]
916    if {![file exists $mhProfile(context)]} {
917	close [open $mhProfile(context) w]
918    }
919
920    if {![info exists mhProfile(mh-sequences)]} {
921	set mhProfile(mh-sequences) .mh_sequences
922    }
923    if {$mhProfile(mh-sequences) == {}} {
924	set mhProfile(mh-sequences) .mh_sequences
925    }
926    if {![info exists mhProfile(editor)]} {
927	if {[info exists env(EDITOR)]} {
928	    set mhProfile(editor) $env(EDITOR)
929	} else {
930	    set mhProfile(editor) sedit
931	}
932    }
933    if {![info exists mhProfile(draft-folder)]} {
934	MhSetupDraftFolder
935    } else {
936	set mhProfile(draft-folder) [string trim $mhProfile(draft-folder) +]
937	if {![file isdirectory $mhProfile(path)/$mhProfile(draft-folder)]} {
938	    Exmh_Status "Creating drafts folder"
939	    if {[catch {file mkdir $mhProfile(path)/$mhProfile(draft-folder)} msgid]} {
940		catch {
941		    puts stderr "Cannot create drafts folder $mhProfile(path)/$mhProfile(draft-folder)"
942		}
943	    }
944	}
945    }
946    if {![info exists mhProfile(unseen-sequence)]} {
947	MhSetupUnseenSequence
948    }
949    if {![info exists mhProfile(header-suppress)]} {
950	set mhProfile(header-suppress) {.*}
951    } else {
952	set suppress {}
953	foreach item $mhProfile(header-suppress) {
954	    lappend suppress [string tolower $item]
955	}
956	set mhProfile(header-suppress) $suppress
957    }
958    if {![info exists mhProfile(header-display)]} {
959	set mhProfile(header-display) {subject from date to cc newsgroups}
960    } else {
961	set display {}
962	foreach item $mhProfile(header-display) {
963	    lappend display [string tolower $item]
964	}
965	set mhProfile(header-display) $display
966    }
967    if {![info exists mhProfile(folder-order)]} {
968	set mhProfile(folder-order) {inbox *}
969    }
970    if {![info exists mhProfile(folder-unseen)]} {
971	set mhProfile(folder-unseen) {*}
972    }
973    if {![info exists mhProfile(folder-ignore)]} {
974	set mhProfile(folder-ignore) {.* */.* */*/.* */*/*/.*}
975    }
976    foreach key {dist forw repl} {
977	global exmh
978	set exmh(anno,$key) 0
979	set exmh(inplace,$key) 0
980	if {[info exists mhProfile($key)]} {
981	    if {[lsearch $mhProfile($key) -annotate] >= 0} {
982		set exmh(anno,$key) 1
983		Exmh_Debug "MH anno $key"
984	    }
985	    if {[lsearch $mhProfile($key) -inplace] >= 0} {
986		set exmh(inplace,$key) 1
987		Exmh_Debug "MH inplace $key"
988	    }
989	}
990    }
991    if {![info exists mhProfile(sendproc)]} {
992	set mhProfile(sendproc) send
993    }
994    if {![info exists mhProfile(msg-protect)]} {
995	set mhProfile(msg-protect) 0644
996    }
997}
998proc MhSetupNewUser {} {
999    global mhProfile
1000    Widget_Toplevel .newuser "Setup MH environment"
1001    Widget_Message .newuser msg -aspect 1000 -text "
1002Exmh is a front end to the MH mail handling system.
1003Feel free to send comments and bug reports to
1004	Brent.Welch@acm.org
1005
1006It appears you have not used the MH mail system before.
1007(Your [file tail $mhProfile(profile)] is missing or incomplete.)
1008Normally MH creates a directory named ~/Mail and puts
1009its mail folders and some other files under there.
1010If you want your folders elsewhere, you will have to
1011exit Exmh and run the program /usr/bin/mh/install-mh by hand.
1012
1013Is it ok if Exmh sets up your MH environment for you?
1014"
1015
1016    Widget_Frame .newuser rim Pad {top expand fill}
1017    .newuser.rim configure -bd 10
1018
1019    Widget_Frame .newuser.rim but Menubar {top fill}
1020    Widget_AddBut .newuser.rim.but yes "Yes" MhSetupNewUserInner
1021    Widget_AddBut .newuser.rim.but no "No, Exit" { destroy .newuser ; exit }
1022    tkwait window .newuser
1023}
1024proc MhSetupNewUserInner {} {
1025    global mhProfile exmh
1026    set exmh(newuser) 1
1027    catch {file mkdir [glob ~]/Mail}
1028    if {![file exists $mhProfile(profile)]} {
1029	set out [open $mhProfile(profile) w]
1030	puts $out "Path: Mail\nMsg-Protect: 600\nFolder-Protect: 700"
1031	close $out
1032    }
1033    catch {MhExec inc < /dev/null} result
1034    Exmh_Status $result
1035    catch {destroy .newuser}
1036}
1037proc MhSetupDraftFolder {} {
1038    global mhProfile
1039    Widget_Toplevel .draft "Setup Draft Folder"
1040    Widget_Message .draft msg -aspect 1000 -text "
1041For the Compose, Reply, and Forward operations to work,
1042you need to have an MH drafts folder.  Creating one
1043requires making a directory (you choose the name)
1044and adding a draft-folder: entry
1045to your [file tail $mhProfile(profile)].
1046
1047Should Exmh help you do that now?"
1048
1049    Widget_Frame .draft rim Pad {top expand fill}
1050    .draft.rim configure -bd 10
1051
1052    Widget_Label .draft.rim l {left} -text "Folder name: "
1053    Widget_Entry .draft.rim e {left fill}  -bg white
1054    .draft.rim.e insert 0 drafts
1055
1056    Widget_Frame .draft.rim but Menubar {top fill}
1057    Widget_AddBut .draft.rim.but yes "Yes" MhSetupDraftFolderInner
1058    Widget_AddBut .draft.rim.but no "Exit" { exit }
1059    update
1060    tkwait window .draft
1061}
1062proc MhSetupDraftFolderInner {} {
1063    global mhProfile
1064
1065    set dirname [.draft.rim.e get]
1066    set mhProfile(draft-folder) $dirname
1067
1068    set dir $mhProfile(path)/$mhProfile(draft-folder)
1069    if {![file isdirectory $dir]} {
1070	if {[catch {
1071	    file mkdir $dir
1072	    Exmh_Status "Created drafts folder \"+drafts\""
1073	} err]} {
1074	    Exmh_Status "Cannot create a drafts folder! $err" error
1075	    unset mhProfile(draft-folder)
1076	    destroy .draft
1077	    return
1078	}
1079    }
1080    if {[catch {open $mhProfile(profile) a} out]} {
1081	Exmh_Status "Cannot open $mhProfile(profile): $out" error
1082	unset mhProfile(draft-folder)
1083	destroy .draft
1084	return
1085    }
1086    puts $out "draft-folder: $dirname"
1087    Exmh_Status "draft-folder: $dirname"
1088    close $out
1089
1090    destroy .draft
1091}
1092proc MhSetupUnseenSequence {} {
1093    global mhProfile
1094    set mhProfile(unseen-sequence) unseen
1095
1096    if {[catch {open $mhProfile(profile) a} out]} {
1097	Exmh_Status "Cannot open $mhProfile(profile): $out" error
1098	unset mhProfile(unseen-sequence)
1099	exit
1100    }
1101    catch {puts $out "unseen-sequence: $mhProfile(unseen-sequence)"}
1102    close $out
1103    Exmh_Status "Added unseen-sequence to [file tail $mhProfile(profile)]"
1104}
1105proc MhSetMailDrops {} {
1106    global exdrops env mhProfile exdropMtime
1107
1108    global inc
1109    if {![regexp multi $inc(style)]} {
1110	return
1111    }
1112    if {[file exists $env(HOME)/.exmhdrop]} {
1113	catch {puts stderr ".exmhdrop should be named .xmhcheck"}
1114	set name .exmhdrop
1115    } else {
1116	set name .xmhcheck
1117    }
1118
1119    if {[file exists $env(HOME)/$name]} then {
1120	set mtime [file mtime $env(HOME)/$name]
1121	if {[info exists exdropMtime]} {
1122	    if {$mtime <= $exdropMtime} {
1123		return
1124	    }
1125	}
1126	set exdropMtime $mtime
1127    }
1128    set exdrops(foo) bar	;# Ensure empty array variable
1129    foreach unique [array names exdrops] {
1130	unset exdrops($unique)
1131    }
1132    if {[file exists $env(HOME)/$name]} then {
1133	set df [open $env(HOME)/$name]
1134	while {![eof $df]} {
1135	    # The second field is either a dropbox pathname
1136	    # (absolute or env(HOME) relative), or it is
1137	    # a POP hostname followed by an optional POP username
1138	    gets $df line
1139	    set fields [scan $line "%s %s %s" f d u]
1140	    if {$fields < 2} {
1141		Exmh_Status "Invalid .xmhcheck: $line"
1142	    } else {
1143		Exmh_Status "Found dropbox $d to folder $f"
1144		if {[string first / $d] > 0} {
1145		    # hostnames ought not to have /'s
1146		    set d "$env(HOME)/$d"
1147		}
1148		set folderDirectory "$mhProfile(path)/$f"
1149		if {![file isdirectory $folderDirectory]} {
1150		    Exmh_Status "No directory for folder $f ($name)"
1151		    continue
1152		}
1153		# Setup $unique as a unique identifier for this maildrop
1154		# avoids clashes when you have 2 drops going to one folder
1155		if {$fields == 2} {
1156		    set u "local"
1157		}
1158		set unique "$f-$d-$u"
1159		set exdrops($unique) [list $f $d $u]
1160	    }
1161	}
1162	close $df
1163    } else {
1164	catch {puts stderr "Multidrop needs $name mapping file"}
1165    }
1166}
1167proc Mhbuild_DeleteOrig { msgid } {
1168    global mhProfile
1169    set path $mhProfile(path)/$mhProfile(draft-folder)/$mhProfile(delprefix)$msgid
1170    if {[file exists $path.orig]} {
1171	Exmh_Debug Mhbuild_DeleteOrig deleting $path.orig
1172	File_Delete $path.orig
1173    }
1174}
1175
1176proc Mhbuild_RenameOrig { msgid } {
1177    global mhProfile
1178    set path $mhProfile(path)/$mhProfile(draft-folder)/$mhProfile(delprefix)$msgid
1179    if {[file exists $path.orig]} {
1180	Exmh_Debug Edit_Done moving $path.orig to $path
1181	catch {Mh_Rename $path.orig $path}
1182    }
1183}
1184# Map from a pathname in the MH profile to an absolute pathname.
1185proc Mh_Pathname { profile } {
1186    global mhProfile
1187    if {[string match /* $profile]} {
1188	return $profile
1189    }
1190    if {[regexp {^~/(.*)} $profile match relative]} {
1191	return [glob ~]/$relative
1192    } elseif {[regexp {^~([^/]+)/(.*)} $profile match user relative]} {
1193	return [glob ~$user]/$relative
1194    }
1195    return $mhProfile(path)/$profile
1196}
1197
1198proc Mh_Rename { old new } {
1199	file rename -force $old $new
1200}
1201
1202# find a *comp* file going up from the current folder
1203proc Mh_FindFile { filename } {
1204    global mhProfile exmh
1205    if {[file exists [file join $mhProfile(path) $exmh(folder) $filename]]} {
1206	return $exmh(folder)
1207    }
1208    set path $exmh(folder)
1209    while {[string compare [set path [file dirname $path]] "."] != 0} {
1210	if {[file exists [file join $mhProfile(path) $path $filename]]} {
1211	    return $path
1212	}
1213    }
1214    # Not found until got to $mhProfile(path), return null string
1215    return ""
1216
1217}
1218# exmh-2.5 APIs
1219# Mh_ClearCur
1220# Mh_Unseen
1221
1222proc Mh_MarkSeen {folder ids} {
1223    global mhProfile
1224    Seq_Del $folder $mhProfile(unseen-sequence) $ids
1225}
1226proc Mh_MarkUnseen {folder ids} {
1227    Seq_Add $folder $mhProfile(unseen-sequence) $ids
1228}
1229