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
|
# select.tcl
#
# Keystroke bindings to select for message or folder
#
# 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.
# Select_Bindings creates bindings on the message and ftoc windows
# that in turn warp focus to the Status window for folder & message selection
proc Select_Bindings { w } {
global select
set select(sel) {}
set select(prompt) {}
foreach digit {0 1 2 3 4 5 6 7 8 9} {
bind $w <Key-$digit> {SelectDigit %W %A}
}
bind $w <Key-plus> {SelectPlus %W}
set select(toggle) { Change Target }
}
proc SelectPlus { w } {
global select
$select(entry) configure -state normal
focus $select(entry)
set select(sel) {}
set select(prompt) "[lindex $select(toggle) 0] Folder:"
set select(folder) 1
Exmh_Status "$select(prompt) "
}
proc SelectDigit {w digit} {
global select
$select(entry) configure -state normal
focus $select(entry)
set select(sel) $digit
set select(prompt) Msg:
catch {unset select(folder)}
Exmh_Status "Select Msg: $select(sel)"
Msg_Change $select(sel) noshow
}
# These are the bindings on the status entry widget
proc Select_EntryBind { w } {
global select
set select(entry) $w
bindtags $w [list $w Entry]
bind $w <Any-Key> {SelectTypein %W %A}
bind $w <Key-plus> {SelectToggle %W }
bind $w <Key-minus> {SelectPrev %W }
bind $w <space> {SelectComplete %W}
bind $w <Tab> {SelectComplete %W}
bind $w <Return> {SelectReturn %W}
bind $w <Key-s> {SelectReturn %W %A}
bind $w <BackSpace> {SelectBackSpace %W}
bind $w <Control-h> {SelectBackSpace %W}
bind $w <Delete> {SelectBackSpace %W}
bind $w <Control-c> {SelectCancel %W}
bind $w <Control-g> {SelectCancel %W}
bind $w <Control-u> {SelectClear %W}
}
proc SelectTypein {w {a {}}} {
global select
if {$a == {}} {
return
}
if [info exists select(match)] {
set select(sel) $select(match)
unset select(match)
catch {unset select(allfolders)}
}
append select(sel) $a
Exmh_Status "$select(prompt) $select(sel)"
if ![info exists select(folder)] {
catch { Msg_Change $select(sel) noshow }
}
}
proc SelectBackSpace { w } {
global select
if [info exists select(match)] {
set select(sel) $select(match)
unset select(match)
catch {unset select(allfolders)}
}
set select(sel) [string range $select(sel) 0 [expr [string length $select(sel)]-2]]
Exmh_Status "$select(prompt) $select(sel)"
if ![info exists select(folder)] {
catch { Msg_Change $select(sel) noshow }
}
}
proc SelectToggle {w} {
global select
if [info exists select(folder)] {
if {$select(sel) != ""} {
SelectTypein $w +
return
}
set select(toggle) [list [lindex $select(toggle) 1] [lindex $select(toggle) 0]]
set select(prompt) "[lindex $select(toggle) 0] Folder:"
} else {
catch {
if [regexp {^[0-9]+$} $select(sel)] {
incr select(sel)
}
Msg_Change $select(sel) noshow
}
}
Exmh_Status "$select(prompt) $select(sel)"
}
proc SelectPrev {w} {
global select
if [info exists select(folder)] {
SelectTypein $w "-"
} else {
catch {
if [regexp {^[0-9]+$} $select(sel)] {
incr select(sel) -1
}
Msg_Change $select(sel) noshow
}
Exmh_Status "$select(prompt) $select(sel)"
}
}
proc SelectComplete { w } {
global select
if [info exists select(folder)] {
global flist
if ![info exists select(allfolders)] {
set select(allfolders) $flist(allfolders)
}
set ix 0
foreach f $select(allfolders) {
incr ix
if [string match $select(sel)* $f] {
set select(allfolders) [lrange $select(allfolders) $ix end]
if {$select(allfolders) == {}} {
unset select(allfolders)
}
set select(match) $f
Exmh_Status "$select(prompt) $f"
return
}
}
unset select(allfolders)
catch {unset select(match)}
Exmh_Status "$select(prompt) $select(sel)"
}
}
proc SelectReturn { w {a {}} } {
global select
if [info exists select(folder)] {
if {$a != {}} {
SelectTypein $w $a
return
}
if [info exists select(match)] {
set select(sel) $select(match)
unset select(match)
}
if [string length $select(sel)] {
Folder_[lindex $select(toggle) 0] $select(sel)
}
unset select(folder)
catch {unset select(allfolders)}
} else {
if [regexp {^[0-9]+$} $select(sel)] {
Msg_Change $select(sel) show
}
}
$select(entry) configure -state disabled
Exmh_Focus
}
proc SelectCancel { w } {
global select
if [info exists select(folder)] {
set select(toggle) { Change Target }
unset select(folder)
}
$select(entry) configure -state disabled
Exmh_Status ""
Exmh_Focus
}
proc SelectClear { w } {
global select
set select(sel) {}
Exmh_Status "$select(prompt) $select(sel)"
}
|