Package: exmh Version: 1.6.9-2 Recently, in an attempt to thread messages with exmh, I wrote to the author of thread.tcl (Ignacio Martinez <[EMAIL PROTECTED]>) and asked for some help, which he has graciously given.
He said that the version of thread.tcl which was in 1.3.9 was outmoded, and sent me a new version. I've attached it below. He also said that I'd need to patch folder.tcl in order to use the revised thread.tcl. I've attached that below also. He instructed me to run auto_mkindex in /usr/lib/exmh. Finally, he said I'd have to add some buttons to my .exmh_defaults file. *Fops.ubuttonlist: thread *Fops.thread.text: Thread *Fops.thread.command: Thread_DisplayAll Two problems with the threader are: a) every time one executes a Commit after marking a message for deletion, the whole folder is automatically re-threaded. This takes a lot of time. b) threading doesn't work on folders longer than about 2000 files. In any case, I believe it would be valuable to make this updates to the exmh package. Regards, Susan Kleinmann ======================new version of thread.tcl=========================== # thread.tcl # # # Display FTOC messages in a threaded manner # # Ignacio Martinez <[EMAIL PROTECTED]> # Fundesco # Madrid, April 1996 # proc Thread_PrintReplies { msg minfo off mark {indent -1} } { upvar $minfo msginfo global exwin ftoc if {$indent < 0} { set indent 0 set blank "" } else { incr indent [expr [string length $mark] + 1] set blank [format "%*s" $indent " "] } set maxoff [expr $ftoc(scanWidth) - 2] ;# newline counted as well foreach m $msginfo(refs,$msg) { if {[lsearch $msginfo(out) $m] < 0} { set text $msginfo(text,$m) set tmplist [list [string range $text 0 $off] "$blank" "$mark " \ [string range $text [expr $off + 1] end]] set newtext [join $tmplist ""] if {[string length $newtext] > $maxoff} { set newtext [string range $newtext 0 $maxoff] } $exwin(ftext) insert end "$newtext\n" lappend msginfo(out) $m Thread_PrintReplies $m msginfo $off $mark $indent } } } proc Thread_IsRel { minfo msg } { upvar $minfo msginfo if {[lsearch $msginfo(selm) $msg] >= 0} { return 1 } foreach m $msginfo(refs,$msg) { if [Thread_IsRel msginfo $m] { return 1 } } return 0 } proc Thread_Scan { folder minfo } { upvar $minfo msginfo # # We only care about what is currently displayed into the FTOC. # New messages are ignored. # set maxlines $msginfo(maxl) set firstmsg [Ftoc_MsgNumber 1] set lastmsg [Ftoc_MsgNumber $maxlines] set scan_fmt "%(msg)%{message-id}%{in-reply-to}%{references}" set scan_cmd [list scan +$folder $firstmsg-$lastmsg \ -noheader -noclear -width 9999 -format $scan_fmt] if [catch {open "|$scan_cmd"} pipe] { Exmh_Status "scan failed: $pipe" purple return 1 } set numline 0 set status "Scanning $folder for cross-references ..." set pass [expr int($maxlines/10)] set msginfo(hits) 0 set msginfo(tref) 0 Exmh_Status $status blue while {[gets $pipe line] > 0} { if ![regexp {^ *([0-9]+)<([^>]*)>(.*)} $line x num mid newline] { # no message-id? regexp {^ *([0-9]+)} $line x num set mid {} set newline {} } if {$num != [lindex $msginfo(msgs) $numline]} { Exmh_Status "thread/scan message mismatch. Rescan?" purple return 1 } incr numline if {$maxlines > 250 && [expr $numline%$pass] == 0} { set done [expr 10*$numline/$pass] Exmh_Status "$status $done% done" blue } set msginfo(refs,$num) {} set msginfo(isref,$num) 0 set msgnum($mid) $num set line $newline while {[regexp {<([^>]*)>(.*)} $line x mid newline] == 1} { if [info exists msgnum($mid)] { set ref $msgnum($mid) lappend msginfo(refs,$ref) $num set msginfo(isref,$num) 1 incr msginfo(hits) } else { if ![info exists unres($num)] { set unres($num) {} } lappend unres($num) $mid } set line $newline incr msginfo(tref) } } close $pipe # # Second round. Disordered messages (i.e. replies received BEFORE their # originals) # foreach res [array names unres] { foreach mid $unres($res) { if [info exists msgnum($mid)] { set ref $msgnum($mid) lappend msginfo(refs,$ref) $res set msginfo(isref,$res) 1 incr msginfo(hits) } } } return 0 } proc Thread_Display { {breakoff 20} {mark "+->"} } { busy Thread_Ftoc 1 $breakoff $mark } proc Thread_DisplayAll { {breakoff 20} {mark "+->"} } { busy Thread_Ftoc 0 $breakoff $mark } proc Thread_Ftoc { {selected 0} {breakoff 20} {mark "+->"} } { global exwin exmh ftoc msg # # Check that the current FTOC corresponds to a 'real folder' scan. # if !$ftoc(displayValid) { Exmh_Status "Already threaded or not a valid display" warn return } # # Selection activated and nothing selected, so do nothing # if {$selected && [Ftoc_PickSize] < 1} { Exmh_Status "You must select at least one message first" warn return } set folder $exmh(folder) ;# the real folder name set curmsg {} ;# the current message set show noshow ;# redisplay message? # # Saving the current state # if $ftoc(pickone) { set curmsg $msg(id) if {$msg(dpy) == $curmsg} { set show show } set sellines $ftoc(curLine) } else { set sellines $ftoc(lineset) } # # Commit pending changes. We are sort of changing folders ... # if {[Ftoc_Changes "Change folder"] > 0} { return } set maxlines $ftoc(numMsgs) # # Get text ASAP to speed up the whole thing # set numline 0 set msginfo(msgs) {} set msginfo(selm) {} Exmh_Status "Getting text from the display ..." blue while {$numline < $maxlines} { incr numline set text [$exwin(ftext) get $numline.0 $numline.end] regexp {^ *([0-9]+)} $text x num set msginfo(text,$num) $text lappend msginfo(msgs) $num if {[lsearch $sellines $numline] >= 0} { lappend msginfo(selm) $num } } set msginfo(maxl) $maxlines if {[Thread_Scan $folder msginfo] != 0} { return } # # Redisplay # Ftoc_RangeUnHighlight Msg_CheckPoint Msg_Reset $maxlines $folder set ftoc(folder) {} set ftoc(displayValid) 0 ;# don't cache this display now set ftoc(displayDirty) 0 ;# but do it later if there are any changes set msginfo(out) {} Exmh_Status "Redisplaying FTOC ..." blue $exwin(ftext) configure -state normal $exwin(ftext) delete 0.0 end foreach m $msginfo(msgs) { if !$msginfo(isref,$m) { if {!$selected || [Thread_IsRel msginfo $m]} { $exwin(ftext) insert end "$msginfo(text,$m)\n" lappend msginfo(out) $m Thread_PrintReplies $m msginfo $breakoff $mark } } } $exwin(ftext) configure -state disabled set numseltext {} if $selected { set numsel [llength $msginfo(out)] set numseltext "$numsel/" } elseif {[llength $msginfo(out)] != $maxlines} { Exmh_Status "folder incorrectly threaded. line number mismatch" warn } Ftoc_ShowUnseen $folder if {$curmsg != {}} { set msg(id) $curmsg set ftoc(curLine) [Ftoc_FindMsg $curmsg] Buttons_Current 1 Msg_ShowCurrent $show } else { if $selected { Buttons_Current 0 Buttons_Range Ftoc_PickMsgs $msginfo(selm) 0 } else { Exmh_Status ok } Ftoc_Yview end } set eff 0 if {$msginfo(tref) > 0} { set eff [expr int(100*$msginfo(hits)/$msginfo(tref))] } Label_Folder {} "$folder+ $numseltext$maxlines msgs $eff% threaded" } ==============END of: new version of thread.tcl=========================== ======================patch to folder.tcl================================ *** folder.tcl.orig Tue Apr 23 15:26:34 1996 --- folder.tcl Wed Apr 24 16:08:19 1996 *************** *** 14,19 **** --- 14,20 ---- proc Folder_Init {} { global exmh argc argv mhProfile set exmh(target) {} ;# Name of target, for refile + set exmh(started) 0 ;# For Folder_Change, the first time if {$argc > 0 && \ [file isdirectory $mhProfile(path)/[lindex $argv 0]]} then { #scan named folder *************** *** 77,83 **** wm deiconify . } } ! if {[Ftoc_Changes "Change folder"] > 0} { # Need to reselect previous button here return } --- 78,84 ---- wm deiconify . } } ! if {$exmh(started) && [Ftoc_Changes "Change folder"] > 0} { # Need to reselect previous button here return } *************** *** 99,106 **** --- 100,113 ---- global mhProfile set summary [Mh_Folder $f] ;# Set MH folder state } else { + if {$ftoc(folder) == {} && $exmh(started)} { + # pseudo-display -> Checkpoint to set cur msg + # startup -> don't checkpoint (clears cur sequence) + Exmh_Debug Exmh_CheckPoint [time Exmh_CheckPoint] + } set summary {} } + set exmh(started) 1 global folderHook if [info exists folderHook(leave,$oldFolder)] { $folderHook(leave,$oldFolder) $oldFolder leave *** inc.tcl.orig Wed Apr 24 11:56:59 1996 --- inc.tcl Wed Apr 24 11:57:54 1996 *************** *** 230,236 **** proc Inc_PresortFinish {} { global exmh ftoc Mh_Folder $exmh(folder) ;# prestort inc has changed this to MyIncTmp ! if {[Flist_NumUnseen $exmh(folder)] > 0} { Label_Folder $exmh(folder) Scan_Folder $exmh(folder) $ftoc(showNew) } --- 230,236 ---- proc Inc_PresortFinish {} { global exmh ftoc Mh_Folder $exmh(folder) ;# prestort inc has changed this to MyIncTmp ! if {$ftoc(displayValid) && [Flist_NumUnseen $exmh(folder)] > 0} { Label_Folder $exmh(folder) Scan_Folder $exmh(folder) $ftoc(showNew) } *** ftoc.tcl.orig Tue Apr 23 15:46:51 1996 --- ftoc.tcl Wed Apr 24 13:37:53 1996 *************** *** 475,480 **** --- 475,492 ---- if {$msgid == {}} { return {} } + # + # Linear search for pick and thread FTOCs (pseudo-displays) + # + if !$ftoc(displayValid) { + for {set L 1} {$L <= $ftoc(numMsgs)} {incr L} { + if {[Ftoc_MsgNumber $L] == $msgid} { + return $L + } + } + return {} + } + set min 1 set max $ftoc(numMsgs) ;# Ignore trailing blank line while (1) { *************** *** 1261,1268 **** # Drag Selected proc FtocDragSelectOld {w x y wx wy} { ! global ftoc set line [lindex [split [$w index current] .] 0] set msg [Ftoc_MsgNumber $line] if {$msg == {} || $msg == 0} return --- 1273,1284 ---- # Drag Selected proc FtocDragSelectOld {w x y wx wy} { ! global exmh ftoc + set folder $ftoc(folder) + if !$ftoc(displayValid) { + set folder $exmh(folder) + } set line [lindex [split [$w index current] .] 0] set msg [Ftoc_MsgNumber $line] if {$msg == {} || $msg == 0} return *************** *** 1270,1288 **** # Hand off to Drag code global ftocDrag mhProfile set ftocDrag(source) $w ! set ftocDrag(data,foldermsg) "+$ftoc(folder) $msg" ! set ftocDrag(data,filename) $mhProfile(path)/$ftoc(folder)/$msg Drag_Source ftocDrag $x $y } proc FtocDragSelect {w x y wx wy} { ! global ftoc ftocDrag mhProfile set msgs {} if $ftoc(pickone) { set line [lindex [split [$w index current] .] 0] set msgs [Ftoc_MsgNumber $line] if {$msgs == {} || $msgs == 0} return ! set ftocDrag(data,filename) $mhProfile(path)/$ftoc(folder)/$msgs } else { foreach line $ftoc(lineset) { set msgid [Ftoc_MsgNumber $line] --- 1286,1308 ---- # Hand off to Drag code global ftocDrag mhProfile set ftocDrag(source) $w ! set ftocDrag(data,foldermsg) "+$folder $msg" ! set ftocDrag(data,filename) $mhProfile(path)/$folder/$msg Drag_Source ftocDrag $x $y } proc FtocDragSelect {w x y wx wy} { ! global exmh ftoc ftocDrag mhProfile + set folder $ftoc(folder) + if !$ftoc(displayValid) { + set folder $exmh(folder) + } set msgs {} if $ftoc(pickone) { set line [lindex [split [$w index current] .] 0] set msgs [Ftoc_MsgNumber $line] if {$msgs == {} || $msgs == 0} return ! set ftocDrag(data,filename) $mhProfile(path)/$folder/$msgs } else { foreach line $ftoc(lineset) { set msgid [Ftoc_MsgNumber $line] *************** *** 1295,1301 **** # Hand off to Drag code set ftocDrag(source) $w ! set ftocDrag(data,foldermsg) "+$ftoc(folder) $msgs" Drag_Source ftocDrag $x $y } --- 1315,1321 ---- # Hand off to Drag code set ftocDrag(source) $w ! set ftocDrag(data,foldermsg) "+$folder $msgs" Drag_Source ftocDrag $x $y } *** scan.tcl.orig Tue Apr 23 16:04:47 1996 --- scan.tcl Wed Apr 24 17:01:30 1996 *************** *** 120,125 **** --- 120,130 ---- } } proc Scan_FolderUpdate { f } { + global ftoc + + if !$ftoc(displayValid) { + return ;# don't update pseudo-displays + } Label_Folder $f Scan_Folder $f 0 } *************** *** 239,249 **** if {$folder == {}} { return } ! if {!$ftoc(displayValid) || !$ftoc(displayDirty)} { return } set cacheFile $mhProfile(path)/$folder/.xmhcache ! if [catch { set cacheIO [open $cacheFile w] set curLine [Ftoc_ClearCurrent] ;# Clear + global tk_version --- 244,270 ---- if {$folder == {}} { return } ! if !$ftoc(displayDirty) { return } set cacheFile $mhProfile(path)/$folder/.xmhcache ! ! # ! # Display is invalid but changes (deletes) still must be reflected in cache. ! # A full rescan is the penalty you have to pay for deleting messages inside ! # this thing. ! # ! if !$ftoc(displayValid) { ! set curLine [Ftoc_ClearCurrent] ;# Clear + ! if [file writable $cacheFile] { ! set scancmd [list exec $mhProfile(scan-proc) \ ! +$folder -width $ftoc(scanWidth) > $cacheFile] ! if [catch $scancmd err] { ! Exmh_Status "failed to rescan folder $folder: $err" warn ! } ! } ! Ftoc_Change [Ftoc_MsgNumber $curLine] $curLine ;# Restore it ! } elseif [catch { set cacheIO [open $cacheFile w] set curLine [Ftoc_ClearCurrent] ;# Clear + global tk_version ==============END of: patch to folder.tcl================================ -- TO UNSUBSCRIBE FROM THIS MAILING LIST: e-mail the word "unsubscribe" to [EMAIL PROTECTED] . Trouble? e-mail to [EMAIL PROTECTED]