Artem Chuprina -> [email protected] @ Thu, 29 Jun 2006 13:47:24
+0400:
AC> И есть xrsh, который ниже. Пользуется libfvwm-tcl от Витуса.
AC> Собственно, упоминающейся унутре менюшкой хостов я в результате не
AC> пользуюсь, а вычистить до конца лениво.
#!/usr/bin/wish
set under_fvwm [expr ![catch {package require Fvwm}]]
proc done {} {
if {$::under_fvwm} {wm withdraw .} {exit 0}
}
proc host {host enc} {
global hosts henc
lappend hosts $host
set henc($host) $enc
}
proc key_pressed {val} {
global hosts
set len [string length $val]
set llen [llength $hosts]
.hosts selection clear 0 end
if {$len > 0} {
for {set i 0} {$i<$llen} {incr i} {
if {[string equal -length $len $val [lindex $hosts
$i]]} {
.hosts selection set $i
.hosts see $i
break
}
}
}
return 1
}
proc execute {K} {
global hosts henc thehost env
set idx [.hosts curselection]
if {[string length $idx]} {
set thehost [lindex $hosts $idx]
}
if {$K == "Return"} {
if {[info exists henc($thehost)]} {
set K $henc($thehost)
} {
set K k
}
}
if {$K == "b"} {
set K w
if {$thehost == ""} { set thehost localhost }
set thehost [EMAIL PROTECTED]
}
array set enc {
k {ru_RU.KOI8-R KOI}
w {ru_RU.CP1251 WIN}
u {ru_RU.UTF-8 UTF}
5 {ru_RU.ISO8859-5 ISO}
1 {ru_RU.ISO8859-1 LAT}
}
set env(LANG) [lindex $enc($K) 0]
set env(RESOURCE_NAME) [lindex $enc($K) 1]
if {[string length $thehost]} {
exec xterm -title $thehost -e $env(HOME)/etc/bin/srs $thehost &
} {
exec xterm -title localhost &
}
done
}
proc updown {K} {
set idx [.hosts curselection]
if {![string length $idx]} {
set idx 0
} else {
if {$K == "Up"} {incr idx -1} {incr idx}
}
.hosts selection clear 0 end
.hosts selection set $idx
.hosts see $idx
}
proc help {} {
grid .labreturn .labaltb -sticky w
grid .labaltk .labaltw -sticky w
grid .labalt5 .labalt1 -sticky w
grid .labaltu - -sticky w
after 5000 {grid forget .labreturn .labaltb .labaltk .labaltw .labaltu
.labalt5 .labalt1}
}
proc ask_host {args} {
raise .
set ::hosts {}
if {[catch {source ~/.remote-hosts} error_message]} {
tk_messageBox -icon error -message $error_message -type ok
}
set ::hosts [lsort $::hosts]
set ::thehost {}
.hosts selection clear 0 end
.hosts see 0
wm deiconify .
focus .host
}
entry .host -textvariable thehost -width 32 -validate key -validatecommand
{key_pressed %P} -exportselection false
bind .host <Key-Return> {execute %K; break}
foreach key {b k w u 5 1} {
bind .host <Meta-Key-$key> {execute %K; break}
bind .host <Alt-Key-$key> {execute %K; break}
}
bind .host <Key-Up> {updown %K; break}
bind .host <Key-Down> {updown %K; break}
bind . <Key-Escape> done
bind . <Key-F1> help
set font [.host cget -font]
listbox .hosts -listvariable hosts -width 32 -height 4 -takefocus 0 -font $font
-exportselection false
label .labreturn -font $font -text {Return - default}
label .labaltb -font $font -text {Alt-B - [EMAIL PROTECTED]
label .labaltk -font $font -text {Alt-K - koi8-r}
label .labaltw -font $font -text {Alt-W - windows-1251}
label .labaltu -font $font -text {Alt-U - utf-8}
label .labalt5 -font $font -text {Alt-5 - iso8859-5}
label .labalt1 -font $font -text {Alt-1 - iso8859-1}
grid .host -
grid .hosts -
if {$under_fvwm} {
fvwm::setMask String
fvwm::bind String ask_host
wm withdraw .
} else {
ask_host
}
.remote-hosts, его конфиг, есть быть суть тикловый скрипт, в простейшем
виде выглядящий как
# -*- mode: Tcl -*-
host wizzle k
host castle.ran.pp.ru k
и так далее.
--
Artem Chuprina
RFC2822: <ran{}ran.pp.ru> Jabber: [EMAIL PROTECTED]
The Eclipse Platform is an open and extensible platform
for anything and yet nothing in particular.
apt-cache show eclipse-platform
--
To UNSUBSCRIBE, email to [EMAIL PROTECTED]
with a subject of "unsubscribe". Trouble? Contact [EMAIL PROTECTED]
