Bug#4623: threading in exmh
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 <martinez@fundesco.es>) 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 <martinez@fundesco.es>
# 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
debian-devel-REQUEST@lists.debian.org . Trouble? e-mail to Bruce@Pixar.com
Reply to: