File: flist.tcl

package info (click to toggle)
exmh 1%3A2.9.0-1
  • links: PTS
  • area: main
  • in suites: buster
  • size: 4,216 kB
  • sloc: tcl: 38,046; perl: 1,647; makefile: 130; sh: 101; exp: 75; csh: 9; sed: 2
file content (503 lines) | stat: -rw-r--r-- 13,982 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
#
# flist.tcl
#
# Manage the folder list.
# For folder display (fdisp.tcl):
#	What folders have nested folders under them
#	What folders have unseen messages
# For scan listing (ftoc.tcl):
#	What messages are unread.
#
# Some of the routines here are set up to run in a background interpreter.
# When you see calls to BgRPC it is invoking the routine in the
# forground UI interpreter, whether or not the current routine
# is already running there.
#
# Copyright (c) 1993 Xerox Corporation.
# Use and copying of this software and preparation of derivative works based
# upon this software are permitted. Any distribution of this software or
# derivative works must comply with all applicable United States export
# control laws. This software is made available AS IS, and Xerox Corporation
# makes no warranty about the software, its performance or its conformity to
# any specification.


proc Flist_Init {} {
    global flist
    FlistResetVars		;# Reset unseen msgs state
    set flist(context) {}
    set flist(contextMtime) 0
    set flist(cacheFileMtime) 0
    set flist(active) 0
    Flist_FindAllFolders
    # NOTE the flist variable is traced by Seq_Trace
}
proc FlistResetVars {} {
    global flist mhProfile flistcache
    set flist($mhProfile(unseen-sequence)) {}	;# Sequence of folders to visit
    set flist(unvisited) {}	;# Unseen folders not yet visited
    Exmh_Debug FlistResetVars
    set flist(unvisitedNext) {}	;# Temporary copy (next iteration)
    if {[info exist flistcache]} {
        unset flistcache
    }

    # flist(seqcount,$folder,$seq)
    #	number of sequence elements in a folder
    #	(Update with care; 'trace'd by Seq_Trace)
    # flist(oldseqcount,$folder,$seq)
    #	previous number of sequence elements in a folder
    # flist(seq,$folder,$seq)
    #	message id's of messages in $seq
    # flist(mtime,$folder)
    #	modification time of .mh_sequences file
    # flist(totalcount,$seq)	;# Total count of messages in sequence

    foreach x [lsort -ascii [array names flist]] {
	if [regexp {^(seq),} $x] {
	    # reset state
	    set flist($x) {}
	} elseif [regexp {^(mtime|totalcount|seqcount|oldseqcount),} $x] {
	    # reset state
	    set flist($x) 0
	}
    }
}

### Routines to find all folders, figure out which have nested folders, etc.

# This is commonly bound to the "Flist" button - reset the state
# about folders.

proc Flist_Refresh {} {
    global flist
    FlistResetVars
    FlistFindAllInner
    Fdisp_Redisplay
    Flist_FindSeqs 1
    Folder_FindShared
    Inc_PresortFinish
}

proc Flist_FindAllFolders {{force 0}} {
    global flist mhProfile flistSubCache flistParents

    if ![info exists flist(cacheFile)] {
	set flist(cacheFile) $mhProfile(path)/.folders
    }
    if {$force || ![file readable $flist(cacheFile)] ||
	    [file size $flist(cacheFile)] == 0} {
	FlistFindAllInner
    } elseif {![info exists flist(allfolders)]||
	    [file mtime $flist(cacheFile)] > $flist(cacheFileMtime)} {
	set in [open $flist(cacheFile)]
	set flist(allfolders) [FlistSort [split [read $in] \n]]
	close $in
	set flist(cacheFileMtime) [file mtime $flist(cacheFile)]
	FlistSubFoldersInit
	FlistUnseenFoldersInit
    }
    Folder_FindShared
}
proc FlistFindAllInner {} {
    global flist flistSubCache flistParents mhProfile
    catch {destroy .scanning}
    Widget_Toplevel .scanning "Scanning..."
    Widget_Message .scanning msg -cursor watch -text "
Scanning for nested folders.
(folders -all -fast -recurse)

The results are cached in
$mhProfile(path)/.folders
so you won't have to wait like
this until you press the Folders
button to update the folder set.

Please wait...
"
    Exmh_Status "Scanning for nested folders ..." warn
    update
    set bogus [catch {exec folders -all -fast -recurse} raw]
    set raw [split $raw \n]
    if {$bogus} {
	set ix [lsearch -glob $raw "* * *"]
	if {$ix >= 0} {
	    set msg [lindex $raw $ix]
	    .scanning.msg config -text $msg
	    Exmh_Status $msg
	    catch {puts stderr $raw}
	    update
	    after 1000
	    set raw [lreplace $raw $ix $ix]
	} else {
	    Exmh_Status "Folders error report on stderr"
	    catch {puts stderr $raw}
	}
    }

    set flist(allfolders) [FlistSort $raw]
    FlistSubFoldersInit
    FlistUnseenFoldersInit
    FlistCacheFolderList
    destroy .scanning
}
proc Flist_AddFolder { folder } {
    global flist
    if {[lsearch $flist(allfolders) $folder] >= 0} {
	Exmh_Debug "Flist_AddFolder already has $folder"
    } else {
	lappend flist(allfolders) $folder
    }
    set flist(allfolders) [FlistSort $flist(allfolders)]
    FlistSubFoldersInit
    FlistUnseenFoldersInit
    FlistCacheFolderList
    Fdisp_Redisplay
}
proc Flist_DelFolder { folder } {
    global flist
    set ix [lsearch $flist(allfolders) $folder]
    if {$ix < 0} {
	return
    }
    set flist(allfolders) [FlistSort [lreplace $flist(allfolders) $ix $ix]]
    FlistSubFoldersInit
    FlistUnseenFoldersInit
    FlistCacheFolderList
    Fdisp_Redisplay
}
proc FlistCacheFolderList {} {
    global flist
    if [catch {open $flist(cacheFile) w} out] {
	Exmh_Status "Cannot cache folder list: $out" warning
    } else {
	foreach f $flist(allfolders) {
	    puts $out $f
	}
	close $out
	set flist(cacheFileMtime) [file mtime $flist(cacheFile)]
    }
}
proc FlistUnseenFoldersInit {} {
    global flist mhProfile

    set flist(unseenfolders) {}
    foreach f $flist(allfolders) {
        foreach pat $mhProfile(folder-unseen) {
	    if {[string compare ! [string range $pat 0 0]] == 0} {
		if [string match [string range $pat 1 end] $f] {
			break
		}
	    }
            if [string match $pat $f] {
                lappend flist(unseenfolders) $f
                break
            }
        }
    }
}
proc FlistSubFoldersInit {} {
    global flist subFolders flistSubCache flistParents

    catch {unset subFolders}	;# Map from name to list of children
    catch {unset flistSubCache}
    catch {unset flistParents}
    foreach f $flist(allfolders) {
	append subFolders([file dirname $f]) "$f "
    }
}
proc Flist_SubFolders {{folder .}} {
    global subFolders

    return [info exists subFolders($folder)]
}
proc Flist_FolderSet { {subfolder .} } {
    #  Find all folders at a given level in the folder hierarchy
    global flist flistSubCache
    if [info exists flistSubCache($subfolder)] {
	return $flistSubCache($subfolder)
    }
    foreach f $flist(allfolders) {
	set parent [file dirname $f]
	if {$subfolder == $parent || $subfolder == $f} {
	    lappend result $f
	}
    }
    if ![info exists result] {
	return {}
    } else {
	set flistSubCache($subfolder) $result
	return $result
    }
}

# exmh-2.5
# FlistSeq
# Flist_ForgetUnseen
# Flist_AddUnseen

proc Flist_Done { {resetVisited 1} } {
    global flist exmh

    # Flag_Trace  ;# called via a variable trace

    Exmh_Debug Flist_Done
    if {$resetVisited} {
      # This procedure is called from FolderChange, which doesn't
      # want to reset this list, and from external sorting, which does
      set flist(unvisited) [FlistSort $flist(unvisitedNext)]
    }
    set flist(active) 0
}


# Call Flist_UnseenUpdate from external sorting programs after
# they add messages to a folder

proc Flist_UnseenUpdate { folder {resetVisited 1} } {
    global exmh flist ftoc mhProfile
    Exmh_Debug Flist_UnseenUpdate $folder
    foreach seq [Mh_Sequences $folder] {
	Seq_Set $folder $seq [MhGetSeqCache $folder $seq]
    }
    if {[string compare $folder $exmh(folder)] == 0} {
	if {$ftoc(autoSort)} {
	    if [Flist_NumUnseen $folder $mhProfile(unseen-sequence)] {
		Ftoc_Sort
	    }
	}
	Scan_FolderUpdate $folder
    } elseif {[lsearch $flist(unvisited) $folder] < 0} {
	lappend flist(unvisited) $folder
	set flist(unvisitedNext) $flist(unvisited)
    }
    # This wiggles the flag and sorts flist(unvisited)
    Flist_Done $resetVisited
}
proc Flist_UnseenFolders {} {
    global flist mhProfile
    return $flist($mhProfile(unseen-sequence))
}

# Flist enumerates folders that have unseen messages.
proc Flist_FindSeqs {{reset 0}} {
    Exmh_Debug Flist_FindSeqs reset=$reset
    Exmh_Debug Flist_FindSeqs end [time [list FlistFindSeqs $reset]]
}

proc FlistFindStart {reset} {
    global flist
    if ![info exists flist(active)] {
	set flist(active) 0
    }
    Exmh_Debug FlistFindStart reset=$reset active=$flist(active)
    if {$flist(active)} {
	return 0
    }
    set flist(active) 1
    if {$reset} {
	Fdisp_ClearHighlights
	FlistResetVars
    }
    return 1
}

proc FlistFindSeqsInner {} {
    global flist seqwin flistcache
    if {[catch {
    FlistGetContext
    foreach folder $flist(unseenfolders) {
        foreach seq [Mh_Sequences $folder] {
            if {[lsearch $seqwin(nevershow) $seq] < 0} {
                set seqlist [MhGetSeqCache $folder $seq]
                if {![info exist flistcache($folder,$seq)] ||
                    [string compare $seqlist $flistcache($folder,$seq)]} {

                  # Cache added 2/11/03
                  # Sequence is different than last time we checked
                  # This causes an flist inconsistency, but helps me
                  # so much that I'm leaving it in.  The bug is that if you
                  # get a few new messages (e.g., 1), then read and delete
                  # that message, and exactly one new message comes in,
                  # the cache doesn't realize it.  Perhaps we just need
                  # to unset the flistcache when we do deletes.
                  set flistcache($folder,$seq) $seqlist
                  BgRPC Seq_Set $folder $seq $seqlist
                }
            }
	}
    }
    } err]} {
	# An error here is most likely a flakey NFS connection
	# It is important to trap this so we can mark the
	# flist action as "Done" below.  Otherwise, we'll stop
	# looking for new messages.
	Exmh_Debug "FlistFindSeqs: $err"
    }
}

proc FlistUncache {folder} {
    global flistcache
    # Clear it from both processes because the FlistFindSeqInner
    # can run in either place
    FlistUncacheLocal $folder
    BgAction FlistUncache FlistUncacheLocal $folder
}
proc FlistUncacheLocal {folder} {
    global flistcache
    array unset flistcache $folder,*
}

proc FlistFindSeqs {reset} {
    global flist
    if {![BgRPC FlistFindStart $reset]} {
	# Flist active
	return
    }
    #BgRPC FlistFindSeqsInner
    FlistFindSeqsInner
    BgRPC Flist_Done
}
proc FlistGetContext {} {
    global flist mhProfile
    if {$flist(contextMtime) < [file mtime $mhProfile(context)]} {
	if {[catch {open $mhProfile(context)} in] == 0} {
	    set flist(context) [split [read $in] \n]
	    set flist(contextMtime) [file mtime $mhProfile(context)]
	    close $in
	}
    }
}
proc Flist_SeenAll { folder } {
    FlistUnseenFolder $folder
}
proc FlistUnseenFolder { folder } {
    global flist mhProfile
    Exmh_Debug FlistUnseenFolder $folder
    set flist(seqcount,$folder,$mhProfile(unseen-sequence)) 0
    set flist(seq,$folder,$mhProfile(unseen-sequence)) {}
    Fdisp_UnHighlightUnseen $folder
    set ix [lsearch $flist($mhProfile(unseen-sequence)) $folder]
    if {$ix >= 0} {
	set flist($mhProfile(unseen-sequence)) [lreplace $flist($mhProfile(unseen-sequence)) $ix $ix]
	if {[llength $flist($mhProfile(unseen-sequence))] == 0} {
	    Flag_NoUnseen
	}
    }
    set ix [lsearch $flist(unvisited) $folder]
    if {$ix >= 0} {
	set flist(unvisited) [lreplace $flist(unvisited) $ix $ix]
    }
    set ix [lsearch $flist(unvisitedNext) $folder]
    if {$ix >= 0} {
	set flist(unvisitedNext) [lreplace $flist(unvisitedNext) $ix $ix]
    }
}

proc FlistSort { dirlist } {
    # Order the folder list according to a pattern template.
    # Patterns early in the list have higher priority.

    # Hack to check against mh-e .folders file
    if [regexp {\("\+} $dirlist] {
	global flist
	error \
"Conflict with mh-e $flist(cacheFile).  Either remove it or override its name.
The mh-e variable is mh-folder-list-filename.
For exmh, set the variable flist(cacheFile) to another file.
Add this to your user.tcl file (see exmh-custom man page for details).
set flist(cacheFile) /usr/joe/Mail/.exmhfolders
"
    }
    global mhProfile
    set patterns $mhProfile(folder-order)

    set max [llength $patterns]
    set dirlist [lsort $dirlist]
    foreach f $dirlist {
	set patLength($f) 0
    }
    foreach f $dirlist {
	set hit 0
	for {set pri 0} {$pri < $max} {incr pri} {
	    set pat [lindex $patterns $pri]
	    set patLen [string length $pat]
	    if {$patLen > $patLength($f)} {
		if [string match $pat $f] {
		    set priority($f) $pri
		    set patLength($f) $patLen
		    set hit 1
		}
	    }
	}
	if {! $hit} {
	    set priority($f) $max
	}
    }
    foreach f $dirlist {
	set hide 0
	if {$f == {}} {
	    set hide 1
	}
	foreach pat $mhProfile(folder-ignore) {
	    if [string match $pat $f] {
		set hide 1
		break
	    }
	}
	if {! $hide} {
	    lappend pset($priority($f)) $f
	}
    }
    set result ""
    for {set pri 0} {$pri <= $max} {incr pri} {
	if [info exists pset($pri)] {
	    append result $pset($pri) " "
	}
    }
    return $result
}

proc Flist_NextUnvisited { } {
    # Return the next folder in Folder-Order that has unseen messages
    global flist exmh mhProfile

    foreach f $flist(unvisited) {
	if {[string compare $f $exmh(folder)] != 0} {
	    return $f
	}
    }
    foreach f $flist($mhProfile(unseen-sequence)) {
	if {[string compare $f $exmh(folder)] != 0} {
	    return $f
	}
    }
    set first [lindex $flist(allfolders) 0]
    if {$flist(cycleBack) && [string compare $first $exmh(folder)]} {
	return $first
    } else {
	return {}
    }
}
proc Flist_Visited { f } {
    global flist
    set ix [lsearch $flist(unvisited) $f]
    if {$ix >= 0} {
	set flist(unvisited) [lreplace $flist(unvisited) $ix $ix]
    }
}

# exmh-2.5 APIS
proc Flist_FindUnseen args {
  eval Flist_FindSeqs $args
}
proc Flist_NumUnseen {folder seq} {
  Seq_Count $folder $seq
}
# Flist_AddUnseen
# Flist_ForgetUnseen
# Flist_MsgSeen
# Flist_NextUnseen
# Flist_NumUnseen
# Flist_ResetUnseen
# Flist_UnseenMsgs