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