Re: GNOME и WM

[Artem Chuprina <ran@ran.pp.ru>]

Artem Chuprina -> debian-russian@lists.debian.org  @ 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 build@$thehost
	}
	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 - build@}
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: ran@jabber.ran.pp.ru

The Eclipse Platform is an open and extensible platform
for anything and yet nothing in particular.
	apt-cache show eclipse-platform