--- /dev/null
+1. óÄÅÌÁÔØ ÞÔÏÂÙ ÐÒÉ ÎÁÖÁÔÉÉ ÎÁ ËÎÏÐËÕ Run ÉÓÔÏÒÉÑ ÐÏÓÌÅÄÎÉÈ ËÏÍÁÎÄ ÂÙÌÁ
+×ÉÄÎÁ ÓÒÁÚÕ. (×ÏÚÍÏÖÎÏ, ÏÔËÁÚÁ×ÛÉÓØ ÏÔ ÏÔÄÅÌØÎÏÊ ËÎÏÐËÉ Start)
+
+2. äÏÂÁ×ÉÔØ × ÏËÎÏ Run ÞÅËÂÏËÓ "ÅÓÌÉ ÔÁËÁÑ ÐÒÏÇÒÁÍÍÁ ÕÖÅ ×ÙÐÏÌÎÑÅÔÓÑ,
+×ÙÔÁÝÉÔØ Å£ ÎÁ×ÅÒÈ, Á ÎÅ ÚÁÐÕÓËÁÔØ ÎÏ×ÕÀ"
+
+3. ÷ ÍÅÎÀ xterm ÐÏ ÐÒÁ×ÏÊ ËÌÁ×ÉÛÅ ÐÏËÁÚÙ×ÁÔØ ÍÅÎÀ ÔÅÈ xterm-Ï×, ËÏÔÏÒÙÅ
+ÕÖÅ ÏÔËÒÙÔÙ ÎÁ ÄÁÎÎÏÍ ÈÏÓÔÅ. (ÎÏ ÞÔÏÂÙ ÂÙÌÁ ÐÏÚÉÃÉÑ New xterm)
+
+
--- /dev/null
+prefix=/usr/local
+
+PLUGINS= apm clock dict irda mail mount phonebook phone_vcf
+SCIRPTS=fm mail man
+CONFIG_FILES=holydays plugins/irda.conf
+
+all:
+
+install:
+ install -d -m 0755 $(DESTDIR)${prefix}/lib
+ install -d -m 0755 $(DESTDIR)${prefix}/lib/fubar
+ install -d -m 0755 $(DESTDIR)${prefix}/lib/fubar/plugins
+ install -d -m 0755 $(DESTDIR)${prefix}/lib/fubar/menu
+ install -m 755 -o root fubar.tcl $(DESTDIR)${prefix}/lib/fubar
+ install -m 755 -o root man $(DESTDIR)$(prefix)/lib/fubar
+ install -m 755 -o root mail $(DESTDIR)$(prefix)/lib/fubar
+ install -m 644 -o root setup_userdir $(DESTDIR)${prefix}/lib/fubar
+ install -m 644 -o root balloonhelp.tcl $(DESTDIR)${prefix}/lib/fubar
+ for i in ${SCRIPTS}; do\
+ install -m 755 -o root $$i ${DESTDIR}${prefix}/lib/fubar;\
+ done
+ for i in ${PLUGINS}; do\
+ install -m 644 -o root plugins/$$i ${DESTDIR}${prefix}/lib/fubar/plugins;\
+ done
+ for i in ${CONFIG_FILES}; do\
+ install -m 644 -o root $$i ${DESTDIR}${prefix}/lib/fubar;\
+ done
+ cp -r menu/* $(DESTDIR)${prefix}/lib/fubar/menu
+ find $(DESTDIR)$(prefix)/lib/fubar/menu -name CVS -type d |xargs rm -rf
--- /dev/null
+## balloonhelp.tcl
+## Balloon Help Routines
+##
+## Jeffrey Hobbs
+## Initiated: 28 October 1996
+##
+
+##------------------------------------------------------------------------
+## PROCEDURE
+## balloonhelp
+##
+## DESCRIPTION
+## Implements a balloon help system
+##
+## ARGUMENTS
+## balloonhelp <option> ?arg?
+##
+## clear ?pattern?
+## Stops the specified widgets (defaults to all) from showing balloon
+## help.
+##
+## delay ?millisecs?
+## Query or set the delay. The delay is in milliseconds and must
+## be at least 50. Returns the delay.
+##
+## disable
+## Disables all balloon help.
+##
+## enable
+## Enables balloon help for defined widgets.
+##
+## <widget> ?-index index? ?message?
+## If -index is specified, then <widget> is assumed to be a menu
+## and the index represents what index into the menu (either the
+## numerical index or the label) to associate the balloon help
+## message with. If message is {}, then the balloon help for that
+## widget is removed. The widget must exist prior to calling
+## balloonhelp. The current balloon help message for <widget> is
+## returned, if any.
+##
+## RETURNS: varies (see methods above)
+##
+## NAMESPACE & STATE
+## The global array BalloonHelp is used. Procs begin with BalloonHelp.
+## The overrideredirected toplevel is named $BalloonHelp(TOPLEVEL).
+##
+## EXAMPLE USAGE:
+## balloonhelp .button "A Button"
+## balloonhelp .menu -index "Load" "Loads a file"
+##
+##------------------------------------------------------------------------
+
+## An alternative to binding to all would be to bind to BalloonHelp
+## and add that to the bindtags of each widget registered.
+
+## The extra :hide call in <Enter> is necessary to catch moving to
+## child widgets where the <Leave> event won't be generated
+bind all <Enter> {
+ #BalloonHelp:hide
+ set BalloonHelp(LAST) -1
+ if {$BalloonHelp(enabled) && [info exists BalloonHelp(%W)]} {
+ set BalloonHelp(AFTERID) [after $BalloonHelp(DELAY) \
+ [list BalloonHelp:show %W $BalloonHelp(%W)]]
+ }
+}
+bind BalloonsMenu <Any-Motion> {
+ if {$BalloonHelp(enabled)} {
+ set cur [%W index active]
+ if {$cur == $BalloonHelp(LAST)} return
+ set BalloonHelp(LAST) $cur
+ BalloonHelp:hide
+ if {[info exists BalloonHelp(%W,$cur)] || \
+ (![catch {%W entrycget $cur -label} cur] && \
+ [info exists BalloonHelp(%W,$cur)])} {
+ set BalloonHelp(AFTERID) [after $BalloonHelp(DELAY) \
+ [list BalloonHelp:show %W $BalloonHelp(%W,$cur) $cur]]
+ }
+ }
+}
+bind all <Leave> { BalloonHelp:hide }
+bind Balloons <Any-KeyPress> { BalloonHelp:hide }
+bind Balloons <Any-Button> { BalloonHelp:hide }
+array set BalloonHelp {
+ enabled 1
+ DELAY 500
+ AFTERID {}
+ LAST -1
+ TOPLEVEL .__balloonhelp__
+}
+
+proc balloonhelp {w args} {
+ global BalloonHelp
+ switch -- $w {
+ clear {
+ if {[llength $args]==0} { set args .* }
+ BalloonHelp:clear $args
+ }
+ delay {
+ if {[llength $args]} {
+ if {![regexp {^[0-9]+$} $args] || $args<50} {
+ return -code error "BalloonHelp delay must be an\
+ integer greater than 50 (delay is in millisecs)"
+ }
+ return [set BalloonHelp(DELAY) $args]
+ } else {
+ return $BalloonHelp(DELAY)
+ }
+ }
+ disable {
+ set BalloonHelp(enabled) 0
+ BalloonHelp:hide
+ }
+ enable {
+ set BalloonHelp(enabled) 1
+ }
+ default {
+ if {[llength $args]} {
+ set i [uplevel BalloonHelp:register $w $args]
+ }
+ set b $BalloonHelp(TOPLEVEL)
+ if {![winfo exists $b]} {
+ toplevel $b
+ wm overrideredirect $b 1
+ wm positionfrom $b program
+ wm withdraw $b
+ pack [label $b.l -highlightthickness 0 -relief raised -bd 1 \
+ -background yellow]
+ }
+ if {[info exists BalloonHelp($i)]} { return $BalloonHelp($i) }
+ }
+ }
+}
+
+;proc BalloonHelp:register {w args} {
+ global BalloonHelp
+ set key [lindex $args 0]
+ while {[string match -* $key]} {
+ switch -- $key {
+ -index {
+ if {[catch {$w entrycget 1 -label}]} {
+ return -code error "widget \"$w\" does not seem to be a\
+ menu, which is required for the -index switch"
+ }
+ set index [lindex $args 1]
+ set args [lreplace $args 0 1]
+ }
+ default {
+ return -code error "unknown option \"$key\": should be -index"
+ }
+ }
+ set key [lindex $args 0]
+ }
+ if {[llength $args] != 1} {
+ return -code error "wrong \# args: should be \"balloonhelp widget\
+ ?-index index? message\""
+ }
+ if {[string match {} $key]} {
+ BalloonHelp:clear $w
+ } else {
+ if {![winfo exists $w]} {
+ return -code error "bad window path name \"$w\""
+ }
+ if {[info exists index]} {
+ set BalloonHelp($w,$index) $key
+ bindtags $w [linsert [bindtags $w] end BalloonsMenu]
+ return $w,$index
+ } else {
+ set BalloonHelp($w) $key
+ bindtags $w [linsert [bindtags $w] end Balloons]
+ return $w
+ }
+ }
+}
+
+;proc BalloonHelp:clear {{pattern .*}} {
+ global BalloonHelp
+ foreach w [array names BalloonHelp $pattern] {
+ unset BalloonHelp($w)
+ if {[winfo exists $w]} {
+ set tags [bindtags $w]
+ if {[set i [lsearch $tags Balloons]] != -1} {
+ bindtags $w [lreplace $tags $i $i]
+ }
+ ## We don't remove BalloonsMenu because there
+ ## might be other indices that use it
+ }
+ }
+}
+
+;proc BalloonHelp:show {w msg {i {}}} {
+ if {![winfo exists $w] || [string compare \
+ $w [eval winfo containing [winfo pointerxy $w]]]} return
+
+ global BalloonHelp
+ set b $BalloonHelp(TOPLEVEL)
+ $b.l configure -text $msg
+ update idletasks
+ if {[string compare {} $i]} {
+ set y [expr [winfo rooty $w]+[$w yposition $i]+25]
+ if {($y+[winfo reqheight $b])>[winfo screenheight $w]} {
+ set y [expr [winfo rooty $w]+[$w yposition $i]-\
+ [winfo reqheight $b]-5]
+ }
+ } else {
+ set y [expr [winfo rooty $w]+[winfo height $w]+5]
+ if {($y+[winfo reqheight $b])>[winfo screenheight $w]} {
+ set y [expr [winfo rooty $w]-[winfo reqheight $b]-5]
+ }
+ }
+ set x [expr [winfo rootx $w]+([winfo width $w]-[winfo reqwidth $b])/2]
+ if {$x<0} {
+ set x 0
+ } elseif {($x+[winfo reqwidth $b])>[winfo screenwidth $w]} {
+ set x [expr [winfo screenwidth $w]-[winfo reqwidth $b]]
+ }
+ wm geometry $b +$x+$y
+ wm deiconify $b
+ raise $b
+}
+
+;proc BalloonHelp:hide {args} {
+ global BalloonHelp
+ after cancel $BalloonHelp(AFTERID)
+ catch {wm withdraw $BalloonHelp(TOPLEVEL)}
+}
--- /dev/null
+#!/bin/sh
+#
+# Example file manager script.
+# Can be called with no arguments - to open ${HOME} or with one
+# argument -directory name to open directory.
+# You can also link dfm to ~/.fubar/fm instead
+[ -n "$1" ] && cd $1
+exec xterm -T "File manager" -name mc -e mc
--- /dev/null
+#!/usr/bin/wish
+
+package require Tclx
+set noFvwm [catch {package require Fvwm}]
+set CONFIGDIR "~/.fubar"
+set LIBRARYDIR [file dirname [info script]]
+# Host add setup
+set accessCommand [list rs ssh rsh]
+set LocaleList {ru_RU.KOI8-R ru_RU.CP1251 ru_RU.UTF-8}
+
+option add *Menu.Font -*-times-bold-r-normal--14-* widgetDefault
+option add *Menubutton.Font -*-times-bold-r-normal--14-* widgetDefault
+set WindowMenu "Window-Ops2"
+source [file join $LIBRARYDIR balloonhelp.tcl]
+option add Foobar.geometry +0+0 widgetDefault
+# No periodically executed commands by default
+set scheduled_commands {}
+#
+# Lays out an application
+#
+proc myExit {args} {exit}
+proc main {} {
+ # Just for convinience
+ global CONFIGDIR LIBRARYDIR
+ # First, transform main window into bar
+ setup_window
+ # Second, check if our config dir exist. Otherwise
+ if {![file exist $CONFIGDIR] } {
+ uplevel #0 source [file join $LIBRARYDIR setup_userdir]
+ } elseif {![file isdirectory $CONFIGDIR]} {
+ tk_messagebox -type ok -title "Error" -icon error -message "Config directory $CONFIGDIR missing and cannot be created!"
+ exit 1
+ }
+ read_hostfile
+ read_associations
+ make_startmenu
+ make_windowmenu
+ make_runbutton
+ make_termmenu
+ make_findmenu
+ read_hotkeys
+ after idle load_plugins
+ # Start tasks to be executed each minute
+ bind . <Button-1> {raise .}
+ scheduler
+}
+
+proc load_plugins {} {
+ global CONFIGDIR
+ foreach plugin [glob -nocomplain $CONFIGDIR/plugins/*] {
+ if {[string match *.txt $plugin]} continue
+ if {[catch {uplevel #0 [list source $plugin]} msg]} {
+ bgerror "Error loading plugin [file tail $plugin]\n$msg"
+ }
+ }
+}
+#
+# Sets main window up as horizontal bar
+#
+proc setup_window {} {
+ . configure -relief raised -bd 3
+ if {$::noFvwm} {
+ wm overrideredirect . yes
+ } else {
+ ::fvwm::send "Style [tk appname] NoTitle,NoHandles,BorderWidth 0,WindowListSkip, Sticky "
+ }
+ regexp {[0-9+]x[0-9+]([+-][0-9]+)([+-][0-9]+)} [wm geometry .] junk xpos ypos
+ wm geometry . [winfo screenwidth .]x30+0$ypos
+ update
+}
+##############################################################
+# Reading universal configuration
+#############################################################
+#
+# Reads file of known hosts used by run window and term menu
+#
+
+proc read_hostfile {} {
+ global HostList CONFIGDIR RunCmd XtermCmd Xterm hostTimeStamp
+ if [catch {open $CONFIGDIR/hosts} f] {
+#file not found, create default one
+ tk_messageBox -title Warning -type ok -message "Cannot open host list: $f\nCreating default one"
+ set f [open $CONFIGDIR/hosts w]
+ puts $f "#hostname rsh-command locale list"
+ puts $f "localhost - $::env(LANG)"
+ close $f
+ set f [open $CONFIGDIR/hosts]
+ }
+ set HostList {}
+ while {[gets $f line]>=0} {
+ if {![string length $line]||[regexp "^ *#" $line]} continue
+ if {[regexp "^\[ \t]*-+" $line]} {
+ lappend HostList "-"
+ } elseif {[regexp "^\[ \t]*>+\[ \t]*(.*)" $line => label]} {
+ lappend HostList ">$label"
+ } elseif {[regexp "^\[ \t]*<" $line]} {
+ lappend HostList "<"
+ } else {
+ set list [regexp -all -inline {[^[:space:]]+} $line]
+ set host [lindex $list 0]
+ set cmd [lindex $list 1]
+ set locales [lrange $list 2 end]
+ if {![llength $locales]} {
+ set locales [list $::env(LANG)]
+ }
+ set connect_name ""
+ foreach {menu_name connect_name} [split $host ":"] break
+ if {![string length $connect_name]} {
+ set connect_name $menu_name
+ }
+ if {[lindex $locales 0]==">"} {
+ set locales [lrange $locales 1 end]
+ set locales_submenu 1
+ lappend HostList ">$menu_name"
+ } else {
+ set locales_submenu 0
+ }
+ set loccount [llength $locales]
+ foreach l $locales {
+ if {$l eq $::env(LANG)} {
+ set lang_prefix ""
+ } else {
+ set lang_prefix "env LANG=$l "
+ }
+ if {$loccount >1} {
+ catch {unset charset}
+ foreach {lang charset} [split $l "."] break
+ if {[info exists charset]} {
+ set name "$menu_name\([string tolower $charset]\)"
+ } else {
+ set name "$menu_name\($lang\)"
+ }
+ } else {
+ set name $menu_name
+ }
+ if {$cmd eq "-"} {
+ set rexec ""
+ set xexec ""
+ set xtermswitch " -e "
+ } else {
+ set rexec "$cmd $connect_name"
+ set xexec "-e $cmd $connect_name"
+ set xtermswitch ""
+ }
+ lappend HostList $name
+ set RunCmd($name) [string trim "$lang_prefix$rexec"]
+ set Xterm($name) "$lang_prefix xterm -T \"Shell on $name\" $xexec"
+ set XtermCmd($name) $Xterm($name)$xtermswitch
+ }
+ if {$locales_submenu} {
+ lappend HostList "<"
+ }
+ }
+ }
+ set hostTimeStamp [clock seconds]
+}
+
+#
+# Checks mtime of hosts file and, if changed, rereads it
+#
+proc check_hostFile {} {
+ global hostTimeStamp CONFIGDIR
+ if {[file mtime $CONFIGDIR/hosts]>$hostTimeStamp} {
+ read_hostfile
+ build_xtermmenu
+ build_runhostmenu
+ }
+}
+
+proc read_hotkeys {} {
+
+}
+
+proc build_runhostmenu {} {
+ global runHost HostList
+ build_host_menu .runwindow.host.menu radiobutton {-value $host -variable runHost}
+}
+#
+# Read file of associations
+#
+proc read_associations {} {
+ global Associations CONFIGDIR noFvwm
+ array set Associations {
+ .tcl builtin
+ }
+ if {!$noFvwm} {
+ set Associations(.fvwm) builtin
+ }
+ if [file readable $CONFIGDIR/associations] {
+ set f [open $CONFIGDIR/associations]
+ catch {array set Associations [read -nonewline $f]}
+ close $f
+ }
+}
+######################################################################
+# Start menu stuff
+######################################################################
+
+#
+# Creates start menu (which is actually recreated each time as posted)
+#
+proc make_startmenu {} {
+ global CONFIGDIR
+ menubutton .start -menu .start.menu -text Start -relief raised -bd 2
+ menu .start.menu -tearoff false -postcommand scan_appdir
+ pack .start -side left -ipady 3
+ balloonhelp .start "Click here to begin ;-)"
+ menu .start.setup -tearoff 0
+ .start.setup add command -label "Open" -command [list exec\
+ $CONFIGDIR/fm [file normalize $CONFIGDIR/menu] &]
+ if {![file executable $CONFIGDIR/fm]} {
+ .start.setup entryconfigure "Open" -state disabled
+ }
+ .start.setup add command -label "Reread hotkeys..." -command "read_hotkeys"
+ .start.setup add command -label "Import history..." -command "import_history"
+ bind .start <3> [list tk_popup .start.setup %X %Y]
+}
+#
+# Deletes all items from menu and all associated submenus
+#
+proc deleteCascade {menu} {
+ while {[$menu index end]!="none"} {
+ if {[$menu type 0]=="cascade"} {
+ set submenu [$menu entrycget 0 -menu]
+ deleteCascade $submenu
+ destroy $submenu
+ }
+ $menu delete 0
+ }
+}
+
+#
+# Scans given directory and forms menu
+#
+proc make_cascade {path menu} {
+ global XtermCmd Associations HostList
+ set runHost [lindex $HostList 0]
+ set counter 0
+ foreach f [lsort -dictionary [glob -nocomplain $path/*]] {
+ set name [file tail $f]
+ if [file isdirectory $f] {
+ set submenu $menu.$counter
+ incr counter
+ $menu add cascade -label [mklabel $name] -menu $submenu
+ menu $submenu -tearoff n
+ make_cascade $f $submenu
+ } else {
+ set state normal
+ if [file executable $f] {
+ if {[file extension $f]==".xterm"} {
+ set name [file rootname $name]
+ set command "exec $XtermCmd($runHost) [list $f] >&@ stdout &"
+ } else {
+ set command "exec [list $f] >&@ stdout &"
+ }
+ } else {
+ set command "launch [list $f]"
+ if ![info exist Associations([file extension $f])] {
+ set state disabled
+ } else {
+ set name [file rootname $name]
+ }
+ }
+ $menu add command -label [mklabel $name] -command $command -state $state
+ }
+ }
+}
+#
+# Converts file name to menu label - strips off leading number if any
+# and casts underscores to spaces
+proc mklabel {name} {
+ if [regexp {^[0-9]*\.(.*)$} $name tt label] {
+ set name $label
+ }
+ regsub {_} $name " " label
+ return $label
+}
+#
+# import_history - creates Start menu items from run menu history
+#
+proc import_history {} {
+ tk_messageBox -type ok -title "Import history" -message "Not implemented yet"
+}
+
+
+#
+# launch - invokes non-executable file which have associations
+#
+proc launch {file} {
+ global Associations
+ set ext [file extension $file]
+ switch -exact $ext {
+ .tcl {
+ uplevel #0 source [list $file]
+ }
+ .fvwm {
+ set f [open $file]
+ set list [split [read -nonewline $f] "\n"]
+ close $f
+ foreach command $list {
+ if [regexp "\[ \t]*#" $command] continue
+ ::fvwm::send $command
+ }
+ }
+ default {
+ exec /bin/sh -c [format $Associations($ext) $file] >&@stdout &
+ }
+ }
+}
+
+proc scan_appdir {} {
+ global CONFIGDIR
+ deleteCascade .start.menu
+ make_cascade $CONFIGDIR/menu .start.menu
+}
+######################################################################
+# Window list hangling - only if invoked as Fvwm Module
+######################################################################
+#
+# Creates window menu which is actually recreated each time as posted
+#
+proc make_windowmenu {} {
+ global noFvwm
+ menubutton .windows -menu .windows.menu -text Windows -relief raised -bd 2
+ menu .windows.menu -tearoff false -postcommand getwinlist
+ bind .windows.menu <3> {winop_menu [.windows.menu index @%y]}
+ pack .windows -side left
+ if $noFvwm {
+ .windows configure -state disabled
+ }
+ balloonhelp .windows "Click here to list open windows"
+ balloonhelp .windows.menu "Left - raise right- winops menu"
+}
+#
+# Rescans current windows and forms window menu
+#
+proc getwinlist {} {
+ global WindowIds
+ while {[.windows.menu index 0] != "none"} {
+ .windows.menu delete 0
+ }
+ catch {unset WindowIds}
+ ::fvwm::getWindowList list
+ foreach idx [array names list *,iconName] {
+ set id [lindex [split $idx ","] 0 ]
+ if [info exist list($id,iconic)] {
+ set label "<$list($idx)>"
+ if {[string first "\0" $label"]>=0} {
+ regsub -all "\0" $label {} label
+ puts stderr "Problem with window title \"$label\""
+ }
+ set cmd "Iconify -1"
+ } else {
+ set label $list($idx)
+ if {$label == "[tk appname]"} continue
+ regsub -all "\0" $label {} label
+ set cmd "MyFocus"
+ }
+ .windows.menu add command -label $label -command \
+ [list ::fvwm::send $cmd $id]
+ #balloonhelp .windows.menu -index [.windows.menu index end] $list($id,title)
+ set WindowIds([.windows.menu index end]) $id
+
+ }
+}
+#
+# Executes executes fvwm window-ops menu on given command
+#
+proc winop_menu {index} {
+ if {$index=="none"} return
+ global WindowIds WindowMenu
+ ::fvwm::send "Popup $WindowMenu" $WindowIds($index)
+}
+#
+# Button which opens a popup window to enter command. Note that window
+# is created and only shown from this menu. See section about POPUP
+# WINDOWS
+#
+proc make_runbutton {} {
+ button .run -text Run -relief raised -pady 1 \
+ -command {show_popup .runwindow .run; focus -force .runwindow.command}
+ pack .run -side left
+ balloonhelp .run "Click here for single command prompt"
+ make_run_window
+
+}
+#
+# Creates run window
+#
+proc make_run_window {} {
+ global runHost HostList runInXterm pauseAfterRun
+ set runHost [lindex $HostList 0]
+ set runInXterm 0
+ set pauseAfterRun 0
+ popup .runwindow -relief raised -bd 2
+# Things to have inside run window
+ label .runwindow.l -text "Run:"
+ entry .runwindow.command -width 50 -textvar runCommand
+ bind .runwindow.command <Return> runACommand
+ menubutton .runwindow.history -text "v" -relief raised -bd 2 \
+ -menu .runwindow.history.menu
+ balloonhelp .runwindow.history "Click to choose from list of previous commands"
+ menu .runwindow.history.menu -tearoff no
+ read_history .runwindow.history.menu
+ button .runwindow.browse -text "Browse..." -command browse_file
+ balloonhelp .runwindow.browse "Find a file to substitute in command line"
+ label .runwindow.l2 -text "Run on:"
+ global runHost
+ menubutton .runwindow.host -textvar runHost -relief raised -indicatoron y -menu .runwindow.host.menu
+ menu .runwindow.host.menu
+ build_runhostmenu
+ # eval tk_optionMenu .runwindow.host runHost $HostList
+ trace var runHost w checkHostIsLocal
+ .runwindow.host.menu configure -postcommand check_hostFile
+ balloonhelp .runwindow.host "Select host to run on"
+ checkbutton .runwindow.xterm -text "Run in xterm" -command \
+ pauseButtonState -variable runInXterm -anchor w
+ checkbutton .runwindow.pause -text "Don't close xterm on exit"\
+ -variable pauseAfterRun -state disabled -anchor w
+ button .runwindow.run -command runACommand -text "Run"
+ balloonhelp .runwindow.run "Click here to execute"
+ button .runwindow.cancel -command {hide_popup .runwindow} -text Cancel
+ balloonhelp .runwindow.run "Click to forget about this command"
+ grid .runwindow.l -padx 10 -sticky wns
+ grid .runwindow.command - - - .runwindow.history -sticky news -padx 5
+ grid .runwindow.l2 .runwindow.host -sticky news -padx 10
+ grid x .runwindow.xterm - -sticky news
+ grid x .runwindow.pause - -sticky news
+ grid x .runwindow.browse .runwindow.run .runwindow.cancel -padx 10 -sticky news
+ focus .runwindow.command
+}
+
+proc checkHostIsLocal {args} {
+ global runHost
+ if {[string match localhost* $runHost]} {
+ .runwindow.browse configure -state normal
+ } else {
+ .runwindow.browse configure -state disabled
+ }
+}
+#
+# Reads history file (invoked once on startup)
+#
+
+proc read_history {menu} {
+ global CONFIGDIR
+ if [catch {open $CONFIGDIR/history} f] return
+ while {[gets $f line]>=0} {
+ if {[regexp {^([^ ]+) +([0-9]+) +([0-9]+) +(.*)$} \
+ $line junk host xt pause cmd]} {
+ $menu add command -label $cmd -command \
+ [list set_command $cmd $host $xt $pause] }
+ }
+ close $f
+}
+#
+# Sets widgets in run window to command got from history
+#
+proc set_command {cmd host xt pause} {
+ global runCommand runInXterm pauseAfterRun runHost
+ set runHost $host
+ set runCommand $cmd
+ set runInXterm $xt
+ set pauseAfterRun $pause
+}
+#
+# Adds current command into history and saves history to file
+#
+proc add_history {} {
+ global CONFIGDIR runHost runCommand runInXterm pauseAfterRun
+ catch {.runwindow.history.menu delete $runCommand}
+ .runwindow.history.menu insert 0 command -label $runCommand \
+ -command [list set_command $runCommand $runHost $runInXterm\
+ $pauseAfterRun]
+ while {[.runwindow.history.menu index end]>20} {
+ .runwindow.history.menu delete end
+ }
+ set f [open $CONFIGDIR/history w]
+ for {set i 0} "\$i<=[.runwindow.history.menu index end]" {incr i} {
+ set list [.runwindow.history.menu entrycget $i -command]
+ puts $f "[lindex $list 2] [lindex $list 3] [lindex $list 4] [lindex $list 1]"
+ }
+ close $f;
+}
+#
+# Pops up file dialog and inserts choosen name in place of selection
+# into command line
+#
+proc browse_file {} {
+ set name [tk_getOpenFile -parent .runwindow -title Browse]
+ set e .runwindow.command
+ if {"$name"==""} return
+ if [$e selection present] {
+ $e delete sel.first sel.last
+ $e insert selfirst $name
+ } else {
+ $e insert insert $name
+ }
+}
+#
+# Executes command entered in runwindow
+#
+proc runACommand {} {
+ global RunCmd XtermCmd runCommand runHost runInXterm pauseAfterRun
+ hide_popup .runwindow
+ add_history
+
+ if $runInXterm {
+ if $pauseAfterRun {
+ set command "/bin/sh -c '$runCommand;echo \"Hit <Return>\";read junk'"
+ } else {
+ set command $runCommand
+ }
+ exec /bin/sh -c "$XtermCmd($runHost) $command" &>@stdout &
+ } else {
+ if {$RunCmd($runHost)=="*"} {
+ tk_messageBox -title Error -type Ok \
+ -message "You cannot run X applications on $runHost"
+ return
+ }
+ exec /bin/sh -c "$RunCmd($runHost) $runCommand" &>@stdout &
+ }
+ set runCommand {}
+}
+#
+# Change state of pause button
+#
+proc pauseButtonState {} {
+ global runInXterm
+ if $runInXterm {
+ set state normal
+ } else {
+ set state disabled
+ }
+ .runwindow.pause configure -state $state
+}
+##############################################################
+# Popup borderless windows
+##############################################################
+proc popup {widget args} {
+ array set widget_args $args
+ set need_bind 0
+ if {![info exists widget_args(-class)]} {
+ set widget_args(-class) Popup
+ } else {
+ set need_bind 1
+ }
+ set w [eval toplevel $widget [array get widget_args ]]
+ if {$need_bind} {
+ foreach event [bind Popup] {
+ bind $widget_args(-class) $event [bind Popup $event]
+ }
+ }
+
+ wm overrideredirect $w yes
+ wm withdraw $w
+}
+
+proc show_popup {window origin} {
+ set x [winfo rootx $origin]
+ set y [expr [winfo rooty $origin]+[winfo height $origin]]
+ if {$y+[winfo reqheight $window]>[winfo screenheight $window]} {
+ set y [expr [winfo rooty $origin] - [winfo reqheight $window]]
+ if {$y<0} {
+ set y [expr [winfo screenheight $window]-[winfo reqheight $window]]
+ if {$y<0} {
+ set y 0
+ }
+ }
+ }
+ if {$x+[winfo reqwidth $window]>[winfo screenwidth $window]} {
+ set x [expr [winfo screenwidth $window]-[winfo reqwidth $window]]
+ if {$x<0} {
+ set x 0
+ }
+ }
+ wm geometry $window +$x+$y
+ wm deiconify $window
+ raise $window
+ grab -global $window
+}
+
+proc popupLeft {window x y} {
+ if {$x<0||$y<0||$x>[winfo width $window]||$y>[winfo height $window]} {
+ hide_popup $window
+ }
+}
+
+proc hide_popup window {
+ grab release $window
+ wm withdraw $window
+}
+bind Popup <Button-1> {popupLeft %W %x %y}
+bind Popup <Button-2> {popupLeft %W %x %y}
+bind Popup <Button-3> {popupLeft %W %x %y}
+##############################################################
+# Menu of xterms on all possible hosts
+##############################################################
+
+#
+# Creates menu for invoke shell window on any of known hosts
+#
+proc make_termmenu {} {
+ menubutton .xterm -text "Xterm" -menu .xterm.menu -bd 2 -relief raised
+ bind .xterm <ButtonRelease-3> {create_or_raise .hostlist edit_hostlist}
+ menu .xterm.menu -tearoff n -postcommand check_hostFile
+ build_xtermmenu
+ balloonhelp .xterm "Click to open new terminal window"
+}
+proc build_xtermmenu {} {
+ global Xterm
+ build_host_menu .xterm.menu command {-command {exec $Xterm($host) >&@stdout &}}
+ pack .xterm -side left
+}
+
+proc build_host_menu {menu type options } {
+ global HostList Xterm
+ set top_menu $menu
+ $menu delete 0 end
+ catch [concat destroy [winfo children $menu]]
+ set menu_stack {}
+ set submenu 0
+ foreach host $HostList {
+ if { $host == "-" } {
+ $menu add separator
+ } elseif {[regexp "^>(.*)$" $host => label]} {
+ lappend menu_stack $menu
+ $menu add cascade -label $label -menu [set menu [menu $top_menu.m[incr submenu]]]
+ } elseif { $host == "<" } {
+ set menu [lindex $menu_stack end]
+ set menu_stack [lrange $menu_stack 0 end-1]
+ } else {
+ eval [list $menu add $type -label $host ] [subst " $options"]
+ }
+ }
+}
+
+#
+# start periodic tasks like menu update
+#
+proc scheduler {} {
+ global scheduled_commands
+ foreach cmd $scheduled_commands {
+ uplevel #0 $cmd [clock seconds]
+ }
+ set sec [string trimleft [clock format [clock seconds] -format "%S"] 0]
+ if ![string length $sec] {
+ set sec 0
+ }
+ after [expr (60-$sec)*1000] scheduler
+}
+#
+# Allows plugin to register proc which would be run each minute
+#
+proc notifier {command} {
+ global scheduled_commands
+ lappend scheduled_commands $command
+}
+#
+# Find menu - allows to find out lot of useful things about system
+#
+
+proc make_findmenu {} {
+menubutton .find -text Find -relief raised -bd 2 -menu .find.m
+balloonhelp .find "Find a useful information about..."
+set m [menu .find.m -tearoff no]
+$m add command -label "File..." -command "create_or_raise\
+ .find_file find_file; focus .find_file.locate"
+#balloonhelp $m -index 0 "Search for a file on the filesystem"
+$m add command -label "Host..." -command "create_or_raise\
+ .find_host find_host;focus .find_host.addr"
+#balloonhelp $m -index 3 "Search for a person in the phonebook or passwd file"
+$m add command -label "Command..." -command "create_or_raise\
+ .find_command find_command; focus .find_command.cmd"
+#balloonhelp $m -index 4 "Search for command man page (apropos)"
+if {![findInPath "apropos"]} {
+ $m entryconfigure "Command..." -state disabled
+}
+pack .find -side left
+}
+
+proc findInPath {cmd} {
+ global env
+ foreach dir [split $env(PATH) ":"] {
+ if [file executable [file join $dir $cmd]] {
+ return 1
+ }
+ }
+ return 0
+}
+proc create_or_raise {w fillproc args} {
+ if [winfo exists $w] {
+ if {[wm state $w] != "normal"} {
+ wm deiconify $w
+ } else {
+ raise $w
+ focus $w
+ }
+ return 0
+ } else {
+ eval toplevel $w $args
+ $fillproc $w
+ }
+ return 1
+}
+
+proc find_file {w} {
+ wm title $w "Find file"
+ label $w.l1 -text "Locate:" -anchor w
+ entry $w.locate -width 30
+ bind $w.locate <Key-Return> [list do_locate $w]
+ button $w.do_locate -text "Locate" -command [list do_locate $w]
+ grid $w.l1 $w.locate $w.do_locate - -sticky news
+ label $w.l2 -text "Find:" -anchor w
+ grid $w.l2 x x x
+ entry $w.find -width 50
+ bind $w.find <Key-Return> [list do_find $w]
+ button $w.do_find -text "Find" -command [list do_find $w]
+ grid $w.find - $w.do_find - -sticky news
+ text $w.result -height 5 -yscrollcommand [list $w.y set] -state disabled
+ $w.result tag configure error -foreground red
+ $w.result tag configure done -foreground green
+ scrollbar $w.y -orient vert -command [list $w.result yview]
+ grid $w.result - - $w.y -sticky news
+ grid columnconfigure $w 0 -weight 0
+ grid columnconfigure $w 1 -weight 1
+ frame $w.b
+ grid $w.b - - - - -sticky ns
+ button $w.b.stop -text Stop -state disabled
+ button $w.b.clear -text Clear -command [list clearresult $w.result]
+ button $w.b.close -text Close -command [list find_close $w $w.b.stop]
+ pack $w.b.stop $w.b.clear $w.b.close -side left
+ wm protocol $w WM_DELETE_WINDOW [list find_close $w $w.b.stop]
+ foreach row {0 1 2 4} {
+ grid rowconfigure $w $row -weight 0
+ }
+ grid rowconfigure $w 3 -weight 1
+}
+
+proc find_close {window stop} {
+ if {[$stop cget -state] == "normal"} {
+ $stop invoke
+ }
+ destroy $window
+}
+
+proc read_cmd {channel window stopbutton} {
+ if [eof $channel] {
+ $window config -state normal
+ if [catch {close $channel} error] {
+ $window insert end $error error
+ } else {
+ $window insert end "****** done ******" done
+ }
+ $window config -state disabled
+ if [string length $stopbutton] {
+ $stopbutton configure -state disabled
+ }
+ return
+ }
+ $window config -state normal
+ $window insert end [read $channel]
+ $window see end
+ $window config -state disabled
+}
+
+proc open_pipe {window command {stopbutton {}}} {
+ $window configure -state normal
+ $window delete 0.0 end
+ $window configure -state disabled
+ set f [open "|$command" r]
+ fconfigure $f -blocking no -buffering line
+ if [string length $stopbutton] {
+ $stopbutton configure -state normal -command [list kill [pid $f]]
+ }
+ fileevent $f readable [list read_cmd $f $window $stopbutton]
+}
+
+proc do_locate {window} {
+ set pattern [$window.locate get]
+ open_pipe $window.result "locate $pattern" $window.b.stop
+}
+
+proc do_find {window} {
+ set expression [$window.find get]
+ open_pipe $window.result "find $expression" $window.b.stop
+}
+
+proc find_host {w} {
+ wm title $w "Find host"
+ label $w.l -text "Enter hostname or IP address:" -anchor w
+ entry $w.addr -width 30
+ bind $w.addr <Key-Return> [list do_dns_lookup $w]
+ label $w.l2 -text "Record type:"
+ button $w.lookup -text "Lookup DNS" -command [list do_dns_lookup $w]
+ button $w.route -text "Traceroute" -command "open_pipe $w.result\
+ \"/usr/bin/traceroute \[$w.addr get\]\" $w.b.stop"
+ tk_optionMenu $w.type nslookup_type "A/PTR" "MX" "SOA" "NS"
+ grid $w.l - - - - -sticky w
+ grid $w.addr - - - - -sticky w
+ grid $w.l2 $w.type $w.lookup $w.route - -sticky ns
+ text $w.result -height 5 -yscrollcommand [list $w.y set] -state disabled
+ $w.result tag configure error -foreground red
+ $w.result tag configure done -foreground green
+ scrollbar $w.y -orient vert -command [list $w.result yview]
+ grid $w.result - - - $w.y -sticky news
+ grid columnconfigure $w 0 -weight 0
+ grid columnconfigure $w 1 -weight 0
+ grid columnconfigure $w 2 -weight 1
+ grid columnconfigure $w 3 -weight 0
+ grid columnconfigure $w 4 -weight 0
+ frame $w.b
+ grid $w.b - - - - -sticky ns
+ button $w.b.stop -text Stop -state disabled
+ button $w.b.clear -text Clear -command [list clearresult $w.result]
+ button $w.b.close -text Close -command [list find_close $w $w.b.stop]
+ pack $w.b.stop $w.b.clear $w.b.close -side left
+ wm protocol $w WM_DELETE_WINDOW [list find_close $w $w.b.stop]
+ foreach row {0 1 2 4} {
+ grid rowconfigure $w $row -weight 0
+ }
+ grid rowconfigure $w 3 -weight 1
+}
+
+proc do_dns_lookup {w} {
+ global nslookup_type;
+ if {"$nslookup_type" == "A/PTR"} {
+ set command "host"
+ } else {
+ set command "host -t $nslookup_type"
+ }
+ open_pipe $w.result "$command [$w.addr get]" $w.b.stop
+}
+
+proc clearresult {w} {
+ $w configure -state normal
+ $w delete 0.0 end
+ $w configure -state disabled
+}
+
+
+proc find_command {w} {
+ wm title $w "Find command in manual"
+ label $w.l -text "Command:"
+ entry $w.cmd -width 30
+ bind $w.cmd <Key-Return> [list $w.find invoke]
+ button $w.find -text "Find" -command "do_apropos $w.result \[$w.cmd get\]"
+ grid $w.l $w.cmd $w.find - -sticky news
+ text $w.result -height 5 -yscrollcommand [list $w.y set] -state disabled\
+ -font 6x13
+ $w.result tag configure error -foreground red
+ $w.result tag configure done -foreground green
+ $w.result tag configure man -foreground blue -underline y
+ $w.result tag bind man <1> "show_man $w.result @%x,%y"
+ scrollbar $w.y -orient vert -command [list $w.result yview]
+ grid $w.result - - $w.y -sticky news
+ grid columnconfigure $w 0 -weight 0
+ grid columnconfigure $w 1 -weight 1
+ grid columnconfigure $w 2 -weight 0
+ grid columnconfigure $w 3 -weight 0
+ foreach row {0 1} {
+ grid rowconfigure $w $row -weight 0
+ }
+ grid rowconfigure $w 2 -weight 1
+}
+
+
+proc do_apropos {window command} {
+ $window configure -state normal
+ $window delete 0.0 end
+ $window configure -state disabled
+ set f [open "|apropos \"$command\"" r]
+ fconfigure $f -blocking no -buffering line
+ fileevent $f readable [list read_apropos $f $window]
+}
+
+proc read_apropos {channel window} {
+ if [eof $channel] {
+ $window config -state normal
+ if [catch {close $channel} error] {
+ $window insert end $error error
+ } else {
+ $window insert end "****** nothing more ******" done
+ }
+ $window config -state disabled
+ return
+ }
+ $window config -state normal
+ foreach line [split [read $channel] "\n"] {
+ if [regexp "^(\[^ \]+ \\(\[^ \]+\\))(.*$)" $line all cmd comment] {
+ $window insert end $cmd man "$comment\n" {}
+ } else {
+ $window insert end $line error "\n" {}
+ }
+ }
+ $window see end
+ $window config -state disabled
+}
+
+proc show_man {w index} {
+ global CONFIGDIR
+ set range [$w tag nextrange man "$index linestart"]
+ regexp "^(\[^ \]+) \\((\[^)\]+)\\)" [eval $w get $range] all command section
+ exec $CONFIGDIR/man $section $command &
+}
+
+
+proc edit_hostlist {w} {
+ wm title $w "Add host";
+ label $w.l1 -text "Menu label" -anchor e
+ entry $w.label
+ label $w.l2 -text "Hostname" -anchor e
+ entry $w.name
+ label $w.l3 -text "Access command" -anchor e
+ eval tk_optionMenu $w.protocol hostCommand $::accessCommand
+ labelframe $w.loc -text "Suppored locales" -labelanchor nw
+ set i 0
+ foreach locale $::LocaleList {
+ incr i
+ checkbutton $w.loc.box$i -text $locale -offvalue "" -onvalue $locale -var hostLocale$i
+ pack $w.loc.box$i -side top
+ }
+ grid $w.l1 $w.label -sticky news
+ grid $w.l2 $w.name -sticky news
+ grid $w.l3 $w.protocol -sticky news
+ grid $w.loc - -sticky news
+ button $w.save -text Save -command "add_host_entry $w"
+ button $w.cancel -text Cancel -command "wm withdraw $w"
+ grid $w.save $w.cancel
+}
+
+proc add_host_entry {w } {
+global CONFIGDIR hostCommand
+ set hostMenuLabel [$w.label get]
+ set hostName [$w.name get]
+ if {![string length $hostMenuLabel]} {
+ set $hostMenuLabel $hostName
+ }
+ if {![string length $hostName]} {
+ bell
+ return
+ }
+ if {$hostMenuLabel eq $hostName} {
+ set line $hostName
+ } else {
+ set line $hostMenuLabel:$hostName
+ }
+ append line " $hostCommand"
+ for {set i 1} {[winfo exists $w.loc.box$i]} {incr i} {
+ set l [uplevel #0 set hostLocale$i]
+ if {[string length $l]} {
+ append line " $l"
+ }
+ }
+ set f [open $CONFIGDIR/hosts a]
+ puts $f $line
+ close $f
+ wm withdraw $w
+}
+main
--- /dev/null
+1/1 red
+7/1 red
+8/3 red
+1/5 red
+2/5 red
+9/5 red
+12/6 red
--- /dev/null
+proc read_hotkey_file {} {
+ global CONFIGDIR
+ if {![file exists $CONFIGDIR/hotkeys]} return
+ set f [open $CONFIGDIR/hotkeys]
+ set count 0
+ while {[gets $f line]>=0} {
+ regsub {#.*$} $line {} command
+ if {[regexp {^\s*$} $command]} continue
+ if {[regexp {((Key|Mouse)\s+(\(\S+\))?\s*(\w+)\s+([ARWSDT\[\]-_F<^>vI0-9F]+)\s+([NCSMLA]+))\s+(\S.*$)} $command match keydescr k w key c m cmd]} {
+ puts stderr "$keydescr SendToModule *fubar* $cmd"
+ ::fvwm::send "$keydescr SendToModule *fubar* $cmd"
+ incr count
+ } else {
+ append errors "\nUnrecognized syntax: $line"
+ }
+ }
+ close $f
+ if {$count} {
+ ::fvwm::bind String interpet_hotkeys
+ ::fvwm::setMask {String}
+ }
+ if {[info exists errors]} {
+ after idle [list error $errors]
+ }
+
+}
+
+proc interpret_hotkeys {event_type id len message} {
+ set cmd hotkey_[string trim message]
+ puts stderr "Hotkey $event_type $id $len $message"
+ if [llength [info proc [lindex $cmd 0]]] {
+ uplevel #0 $cmd
+ } else {
+ set widget .[lindex $message 0]
+ if {![winfo exists $widget]} {
+ return
+ }
+ switch {[winfo class $widget]} {
+ Button -
+ Menubutton {uplevel #0 $widget invoke}
+ default {
+ event generate $widget <Button-1>
+ }
+ }
+ }
+}
+
+proc hotkey_menu {{menu_path {}}} {
+ if {![string length $menu_path]} {
+ .start invoke
+ }
+}
+
+proc hotkey_find {{menu_path {}}} {
+ if {![string length $menu_path]} {
+ .find invoke
+ } else {
+ $find.m invoke $menu_path
+ }
+}
+
--- /dev/null
+/* XPM */
+static char *mini-term[] = {
+/* width height num_colors chars_per_pixel */
+" 16 16 6 1",
+/* colors */
+" c None s None",
+". c Black",
+"# c #808080", /* gray50 */
+"a c blue",
+"b c White",
+"c c #c0c0c0", /* gray85 */
+/* pixels */
+" ",
+" ######### ",
+" #cccccccc#. ",
+" #bbbbbbbb##. ",
+" #b......b##. ",
+" #b.aaaaab##. ",
+" #b.aaaaab##. ",
+" #b.aaaaab##. ",
+" #bbbbbbbb#.##",
+" #.........#c.",
+" #bbbbbbbbb#c#.",
+" ##.#.#.#.#.##.",
+" #c.c.c.c.c.c.. ",
+"#bbbbbbbbbbbc. ",
+"............. ",
+" "
+};
--- /dev/null
+/* XPM */
+static char * fax_t_xpm[] = {
+"16 16 5 1",
+" c None s None",
+". c #808080",
+"X c black",
+"o c #c0c0c0",
+"# c white",
+" ... ",
+" .###.. ",
+" ....######X",
+" ..##.######X ",
+" .#oo..#####X ",
+" .#o..#oooo#Xo. ",
+".#o.#o.X.oooXoo.",
+".#.#o.X.X.oooo.X",
+"..#o.X.X.ooo...X",
+"..##ooX.oo.....X",
+"X.oo##ooo......X",
+" Xooo.#o.....XX ",
+" XXooo....XX ",
+" XXo..XX ",
+" XXX ",
+" "};
--- /dev/null
+/* XPM */
+static char * ir_xpm[] = {
+"16 16 2 1",
+" g None",
+". g #000000",
+" .. ",
+" .. ",
+" .. .. ",
+" .. .. ",
+" .. .. .. ",
+" .. .. .. ",
+" .. .. .. ..",
+" .... .. .. ..",
+" .... .. .. ..",
+" .. .. .. ..",
+" .. .. .. ",
+" .. .. .. ",
+" .. .. ",
+" .. .. ",
+" .. ",
+" .. "};
--- /dev/null
+/* XPM */
+static char * lan_xpm[] = {
+"16 16 3 1",
+" c None s None",
+". c #8E388A288E38",
+"X c #000000000000",
+" ",
+"..... .....",
+" ... ... ",
+" . . ",
+" X X ",
+" X X ",
+" X X ",
+" XXXXXXXXXXXX ",
+" X ",
+" X ",
+" X ",
+" X ",
+" . ",
+" ... ",
+" ..... ",
+" "};
--- /dev/null
+/* XPM */
+static char * modem_xpm[] = {
+"16 16 3 1",
+" c None s None",
+". c #000000000000",
+"X c #FFFFFFFFFFFF",
+" .. ",
+" .. ",
+" .. ",
+" ....... ",
+" ......... ",
+" ..XXXXX.. ",
+" ..XXXXX.. ",
+" ......... ",
+" ......... ",
+" .X.X.X.X. ",
+" ......... ",
+" .X.X.X.X. ",
+" ......... ",
+" .X.X.X.X. ",
+" ......... ",
+" ....... "};
--- /dev/null
+/* XPM */
+static char * mini_xterm_xpm[] = {
+"14 14 5 1",
+" c None",
+". c lightgrey",
+"X c dimgrey",
+"o c darkgreen",
+"O c white",
+" ",
+" .........X ",
+" .ooooooo.X ",
+" .oOOOooo.X ",
+" .ooooooo.XX ",
+" .ooooooo.XX ",
+" .oOoOooo.XX ",
+" .ooooooo.XX ",
+" .oOoOooo.XX ",
+" .ooooooo.X ",
+" .......X ",
+" XXXXXXXXX ",
+" XXXXXXXX.X ",
+" "};
--- /dev/null
+/* XPM */
+static char * printer_xpm[] = {
+"16 16 3 1",
+" c None s None",
+". c #000000000000",
+"X c #FFFFFFFFFFFF",
+" ........ ",
+" .XXXXXXX. ",
+" .X......X. ",
+" .XXXXXXXX. ",
+" .X......X. ",
+" .XXXXXXXX. ",
+" .X......X. ",
+" .XXXXXXXX. ",
+" ............. ",
+" ...............",
+"..XXXXXXXXXXXXX.",
+".XXXXXXXX.X.X.X.",
+"..XXXXXXXXXXXX..",
+" .............. ",
+" .XXXXXXXX. ",
+" .......... "};
--- /dev/null
+/* XPM */
+static char * unknown_xpm[] = {
+"16 16 2 1",
+" c None s None",
+". c #000000000000",
+" ...... ",
+" ...... ",
+" .. .. ",
+" .. .. ",
+" .. .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" .. ",
+" ",
+" .. ",
+" .. ",
+" "};
--- /dev/null
+#!/bin/sh
+#
+# This script launches your favorite mail progam
+# Should accept recipient email address and go into compose mode, or
+# when invoked without arguments, go into mail reading mode
+#
+exec xterm -T "Mail" -name pine -e pine ${1+"$@"}
--- /dev/null
+#!/bin/sh
+#
+# This script opens manual page in window. Called with two arguments -
+# section and page name
+#
+exec xterm -T "$2 ($1)" -name man -e man $1 $2
--- /dev/null
+::fvwm::send "Module $argv0"
+exit
--- /dev/null
+#!/bin/sh
+sudo apm -s
--- /dev/null
+#!/usr/bin wish
+if {[file exists /proc/apm]} {
+namespace eval apm {
+ variable colors
+ variable help
+
+ set c [canvas .apm -width 62 -height 15 -relief sunken -bd 1]
+ pack $c -side right
+ $c create rectangle 10 3 30 13 -outline black
+ $c create rectangle 30 6 33 10 -outline black -fill black
+
+ $c create rectangle 10 3 30 13 -outline black -stipple @[file join $tk_library demos images gray25.bmp] -fill black -tag energy
+
+ $c create polygon 2 1 6 8 3 8 8 15 6 9 9 9 5 1 -outline red -fill red -tag power
+
+ $c create polygon 35 8 38 5 38 11 -fill black -outline black -tag charge
+ $c create polygon 35 5 35 11 38 8 -fill black -outline black -tag discharge
+ $c create text 61 9 -anchor e -text 100% -font 6x10 -tag pwtext
+ bind .apm <Enter> ::apm::start_help
+ bind .apm <Leave> ::apm::cancel_help
+ bind .apm <Motion> ::apm::reset_help
+ array set colors {
+ charge black
+ discharge black
+ power red
+ }
+ proc toggle_item {tag state} {
+ variable colors
+ if {$state} {
+ .apm itemconfig $tag -fill $colors($tag) -outline $colors($tag)
+ } else {
+ .apm itemconfig $tag -fill {} -outline {}
+ }
+
+ }
+ proc set_power {percent} {
+ set x [expr 20*$percent/100+10]
+ .apm coords energy 10 3 $x 13
+ .apm itemconfig pwtext -text "$percent%"
+ }
+ proc update {} {
+ set f [open /proc/apm]
+ set status [gets $f]
+ close $f
+ variable help
+ set battery [expr [lindex $status 5]]
+ set help ""
+ if {[lindex $status 3] == 1} {
+ toggle_item power 1
+ toggle_item discharge 0
+ append help AC
+ if {$battery!=255 && ($battery&8)} {
+ toggle_item charge 1
+ append help " charging [calc_time $status] to complete"
+ } else {
+ toggle_item charge 0
+ append help " not charging"
+ }
+ .apm configure -background [lindex [.apm configure -background] 3]
+ } else {
+ toggle_item power 0
+ toggle_item discharge 1
+ toggle_item charge 0
+ if {$battery != 255} {
+ if {$battery & 1} {
+ .apm configure -background yellow
+ } elseif {$battery & 2} {
+ .apm configure -background #ff7777
+ } else {
+ .apm configure -background [lindex [.apm configure -background] 3]
+ }
+ }
+ append help "Battery [calc_time $status] remains"
+ }
+ set_power [scan [lindex $status 6] "%d%%"]
+ after 5000 ::apm::update
+
+ }
+ proc calc_time {apm_status} {
+ set units [lindex $apm_status 8]
+ set count [lindex $apm_status 7]
+ if {![regexp {[0-9]+} $count]} {
+ return ??
+ }
+ if {$units == "sec"} {
+ set sec [expr $count % 60]
+ set min1 [expr $count / 60]
+ set min [expr $min1 % 60]
+ set hours [expr $min1 /60]
+ return [format "%d:%02d:%02d" $hours $min $sec]
+ } else {
+ set min [expr $count % 60]
+ set hours [expr $count / 60]
+ return [format "%d:%02d" $hours $min]
+ }
+ }
+ proc cancel_help {} {
+ variable help_after_id
+ if [info exists help_after_id] {
+ after cancel $help_after_id
+ unset help_after_id
+ }
+ if {[wm state .apm.help]=="normal"} {
+ wm withdraw .apm.help
+ }
+ }
+ proc start_help {} {
+ variable help_after_id
+ set help_after_id [after 1000 ::apm::show_help]
+ }
+ proc reset_help {} {
+ cancel_help
+ start_help
+ }
+ proc show_help {} {
+ wm geometry .apm.help +[expr [winfo pointerx .]+2]+[expr [winfo pointery .]+2]
+ wm deiconify .apm.help
+ raise .apm.help
+ }
+
+ toplevel .apm.help
+ wm withdraw .apm.help
+ wm overrideredirect .apm.help y
+ label .apm.help.l -textvar ::apm::help -background yellow -font 6x10
+ pack .apm.help.l -side left
+ unset c
+}
+}
+::apm::update
--- /dev/null
+#
+# Clock plugin for fubar
+# Shows current time and pops up calendar for current month
+#
+
+option add *Calenar.Label.Font -*-times-bold-r-normal--12-*-*-*-*-*-iso10646-1 widgetDefault
+option add *Calendar.Canvas.BoldFont -*-times-bold-r-normal--12-*-*-*-*-*-iso10646-1 widgetDefault
+option add *Calendar.Canvas.DateFont -*-times-medium-r-normal--12-*-*-*-*-iso10646-1 widgetDefault
+namespace eval clock {
+array set monthNames {
+1 {ÑÎ×ÁÒÑ ÑÎ×ÁÒØ}
+2 {ÆÅ×ÒÁÌÑ ÆÅ×ÒÁÌØ}
+3 {ÍÁÒÔÁ ÍÁÒÔ}
+4 {ÁÐÒÅÌÑ ÁÐÒÅÌØ}
+5 {ÍÁÑ ÍÁÊ}
+6 {ÉÀÎÑ ÉÀÎØ}
+7 {ÉÀÌÑ ÉÀÌØ}
+8 {Á×ÇÕÓÔÁ Á×ÇÕÓÔ}
+9 {ÓÅÎÔÑÂÒÑ ÓÅÎÔÑÂÒØ}
+10 {ÏËÔÑÂÒÑ ÏËÔÑÂÒØ}
+11 {ÎÏÑÂÒÑ ÎÏÑÂÒØ}
+12 {ÄÅËÁÂÒÑ ÄÅËÁÂÒØ}
+}
+array set weekday {
+0 {×ÏÓËÒÅÓÅÎØÅ red}
+1 {ÐÏÎÅÄÅÌØÎÉË black}
+2 {×ÔÏÒÎÉË black}
+3 {ÓÒÅÄÁ black}
+4 {ÞÅÔ×ÅÒÇ black}
+5 {ÐÑÔÎÉÃÁ black}
+6 {ÓÕÂÂÏÔÁ red}
+}
+set weekDayAbbr {÷Ó ðÎ ÷Ô óÒ þÔ ðÔ óÂ}
+proc currentMonth {} {
+ eval fill_calendar [clock format [clock seconds] -format "%m %Y"]
+}
+proc calendar {} {
+ catch {destroy .calendar}
+ popup .calendar -bd 3 -relief raised -class Calendar
+ label .calendar.title -anchor n
+ canvas .calendar.m -width 150 -height 120
+ grid .calendar.title - - -sticky news
+ grid .calendar.m - - -sticky news
+ .calendar.m bind date <1> {::clock::showEvents [::clock::getCalendarDate %x %y]}
+ button .calendar.prev -text "<<" -command "::clock::other_month -1"
+ button .calendar.next -text ">>" -command "::clock::other_month [expr 32*86400]"
+ button .calendar.cur -text "Current" -command ::clock::currentMonth
+ grid .calendar.prev .calendar.cur .calendar.next -sticky ns
+ grid .calendar.prev -sticky nws
+ grid .calendar.next -sticky nes
+ eval fill_calendar [clock format [clock seconds] -format "%m %Y"]
+}
+
+proc other_month {offset} {
+ variable firstOfMonth
+ eval fill_calendar [clock format [expr {$firstOfMonth +$offset}] -format "%m %Y" -gmt y]
+}
+
+proc fill_calendar {month year} {
+ variable firstOfMonth
+ variable holydays
+ variable weekDayAbbr
+ variable monthNames
+ variable weekday
+ variable holydaysStamp
+ global CONFIGDIR
+ if {[file exist $CONFIGDIR/holydays]&&
+ (![info exist holydaysStamp]||
+ [file mtime $CONFIGDIR/holydays]>$holydaysStamp)} {
+ read_holydays
+ }
+ set month [string trimleft $month 0]
+ set firstOfMonth [clock scan "$month/01/$year" -gmt y]
+ set t $firstOfMonth
+ set y 1
+ set x 25
+ set color red
+
+ .calendar.m delete all
+ foreach w $weekDayAbbr { #<=List of abbreviated weekdays here
+ .calendar.m create text $x $y -anchor ne -text $w -fill $color \
+ -font [option get .calendar.m boldFont BoldFont]
+ set color black
+ incr x 19
+ }
+ incr y 18
+ .calendar.title configure -text "[lindex $monthNames($month) 1] $year"
+ for {set t $firstOfMonth} {[string trimleft \
+ [clock format $t -format "%m"] 0]==$month} {incr t 86400} {
+ set day [clock format $t -format "%e" -gmt y]
+ set wd [clock format $t -format "%w" -gmt y]
+ set x [expr $wd*19+25]
+ if {!$wd&&$day>1} { incr y 18 }
+ if [info exist holydays([string trimleft $day]/$month)] {
+ set color $holydays([string trimleft $day]/$month)
+ } else {
+ set color [lindex $weekday($wd) 1]
+ }
+ .calendar.m create text $x $y -anchor ne -text $day -fill $color \
+ -font [option get .calendar.m dateFont DateFont] -tags [list date d[string trimleft $day]]
+ }
+ if {"[string trimleft [clock format [clock seconds] -format "%m-%Y"] 0]"
+ == "$month-$year"} {
+ set box [.calendar.m bbox\
+ "d[string trimleft [clock format [clock seconds] -format "%d"] 0]" ]
+ if [llength $box] {
+ eval .calendar.m create rectangle $box -fill green -outline green -tags today
+ .calendar.m lower today
+ }
+ }
+
+}
+
+proc getCalendarDate {x y} {
+ variable firstOfMonth
+ set dateId [.calendar.m find closest $x $y]
+ set day [.calendar.m itemcget $dateId -text]
+ return "[clock format $firstOfMonth -format %m]/$day/[clock format $firstOfMonth -format %y] [clock format [clock seconds] -format "%H:%M"]"
+}
+proc read_holydays {} {
+ variable holydays
+ variable holydaysStamp
+ global CONFIGDIR
+ if {![catch {open $CONFIGDIR/holydays} f]} {
+ array set holydays [read $f]
+ close $f
+ } else {
+ set holydaysStamp 0
+ exit
+ }
+ set holydaysStamp [file mtime $CONFIGDIR/holydays]
+}
+
+proc showtime {seconds} {
+ variable TimeVar
+ set TimeVar [clock format $seconds -format "%H:%M"]
+ balloonhelp .clock [clock format $seconds]
+}
+
+proc showEvents {date} {
+ if {![winfo exists .events]} {
+ toplevel .events -class Calendar
+ label .events.l -width 20
+ pack .events.l
+ button .events.ok -text Ok -command {wm withdraw .events}
+ pack .events.ok
+ wm protocol .events WM_DELETE_WINDOW {wm withdraw .events}
+ }
+ .events.l configure -text $date
+}
+
+#
+# Setup
+#
+calendar
+catch {destroy .clock}
+catch {destroy .events}
+button .clock -textvar ::clock::TimeVar -width 7 -bd 1 -relief sunken\
+ -command {::clock::currentMonth
+ show_popup .calendar .clock}
+balloonhelp .clock "Click to view calendar"
+pack .clock -side right -padx 5
+showtime [clock seconds]
+notifier ::clock::showtime
+}
--- /dev/null
+
+option add *Dict*Text.font -*-helvetica-medium-r-normal--12-*-iso10646-1
+option add *Dict*Entry.font -*-helvetica-medium-r-normal--12-*-iso10646-1
+namespace eval ::dict {
+ set m .find.m
+ $m add command -label "Word..." -command "create_or_raise\
+ .find_dict dict::mkWindow -class Dict; focus .find_dict.e1"
+#balloonhelp $m -index 2 "Search for a word in dictionary"
+ if {![findInPath "dict"]} {
+ $m entryconfigure "Word..." -state disabled
+ }
+
+ proc mkWindow {w} {
+ wm title $w "Dictionary lookup"
+ label $w.l1 -text "Word"
+ entry $w.e1 -exportselection false
+ button $w.b1 -text Lookup -command "::dict::lookup $w \[$w.e1 get\]"
+ bind $w.e1 <Return> "::dict::lookup $w \[$w.e1 get\]"
+ text $w.t -yscrollcommand "$w.y set" -state disabled
+ bind $w.t <<Paste>> [list event generate $w.e1 <<Paste>>]
+ bind $w.t <<PasteSelection>> [list event generate $w.e1 <<PasteSelection>>]
+ bind $w.t <Double-1> {%W tag delete sel
+ %W tag add sel "@%x,%y wordstart" "@%x,%y wordend"
+ event generate [winfo parent %W].e1 <<PasteSelection>>
+ break
+ }
+ bind $w.e1 <<Paste>> {%W delete 0 end;
+ %W insert 0 [selection get -selection CLIPBOARD]
+ ::dict::lookup [winfo parent %W] [%W get]
+ break
+ }
+ bind $w.e1 <<PasteSelection>> {%W delete 0 end;
+ %W insert 0 [selection get]
+ ::dict::lookup [winfo parent %W] [%W get]
+ break
+ }
+ scrollbar $w.y -orient vert -command "$w.t yview"
+
+ grid $w.l1 $w.e1 $w.b1 - -sticky news
+ grid $w.t - - $w.y -sticky news
+ grid rowconfigure $w 1 -weight 1
+ grid columnconfigure $w 1 -weight 1
+ $w.t tag configure error -foreground red
+ $w.t tag configure source -foreground darkgreen -relief raised -borderwidth 2
+
+ }
+ proc lookup {w word} {
+ if {![string length $word]} {
+ return
+ }
+ set f [open "|dict \"[encoding convertfrom [encoding convertto utf-8 $word]]\"" r]
+ fconfigure $f -encoding utf-8
+ set answer [read $f]
+ $w.t configure -state normal
+ $w.t delete 0.0 end
+ if {[catch {close $f} msg]} {
+ $w.t insert 0.0 $msg error
+ }
+ $w.t insert 0.0 $answer
+ $w.t see 0.0
+ set mark 0.0
+ while {[string length [set mark [$w.t search -regex -- {^From .*\[[^ ]+\]:} "$mark+1lines" end]]]} {
+ $w.t tag add source $mark "$mark lineend"
+ }
+ $w.t configure -state disabled
+ $w.t see 0.0
+ $w.e1 selection range 0 end
+ }
+}
--- /dev/null
+#!/usr/bin/wish
+# If we are not started from fubar
+if {![info exists LIBRARYDIR]} {
+ set LIBRARYDIR [file dirname [info script]]
+ set CONFIGDIR ~/.fubar
+}
+if {[file exists /proc/net/irda/discovery]} {
+ namespace eval irda {
+ #variable discovery "/proc/net/irda/discovery"
+ variable discovery "/proc/net/irda/discovery"
+ variable config [file join $::CONFIGDIR irda.conf]
+ if {![file exists $config]} {
+ # create default config
+ file copy [file join $::LIBRARYDIR irda.conf] $config
+ }
+ #update interval in milliseconds
+ variable poll 2000
+ variable configread 0;#ensure config to be read on first update
+ variable canvas .irda
+ variable menu $canvas.m
+ variable hintBits {0x100 PnP 0x200 PDA 0x400 Computer 0x800 Printer
+ 0x1000 Modem 0x2000 Fax 0x4000 LAN 0x1 Telephony 0x2 FileServer
+ 0x4 Comm 0x8 Message 0x10 Http 0x20 OBEX }
+ variable stdIcons {computer
+{R0lGODlhEAAQAMIAAICAgMDAwAAAAP///wAA/////////////yH5BAEKAAcALAAAAAAQABAA
+AANIeLrcDjDGF6qtQDAwuu+QtnBCaQ7hNghE26KZyroELCokXafj92WQkWlYAgREHJ/HGDuE
+gAJoyig4WqtYTVLpOSqI4JJj7EgAADs=}
+ pda
+{R0lGODlhDgAOAMIAANPT02lpaQBkAP///////////////////yH5BAEKAAQALAAAAAAOAA4A
+AAMySLrcBDDGwIC4WAC67PjYVmVhwD3ktZ2eMJRsqpmda6u0YqViJUGnhWlIZBCJPYeSkAAA
+Ow==}
+ modem
+{R0lGODlhEAAQAKEAAAAAAKyqrL2+vf///yH+FUNyZWF0ZWQgd2l0aCBUaGUgR0lNUAAh+QQB
+CgADACwAAAAAEAAQAAACLZyPCMm3zR40oE4XgoRA5510osZ5nQBSmSagzRig6TCecx3fZl6y
+7mSbhYSIAgA7}
+ lan
+{R0lGODlhEAAQAKEAAI6KjgAAAP///////yH5BAEKAAIALAAAAAAQABAAAAInlI8pwKztmjKS
+zgNQuGYff4GCqIjBiaYnN7IJycKcfGUu5biQfU8FADs=}
+ printer
+{R0lGODlhEAAQAOcAAAAAAAEBAQICAgMDAwQEBAUFBQYGBgcHBwgICAkJCQoKCgsLCwwMDA0N
+DQ4ODg8PDxAQEBERERISEhMTExQUFBUVFRYWFhcXFxgYGBkZGRoaGhsbGxwcHB0dHR4eHh8f
+HyAgICEhISIiIiMjIyQkJCUlJSYmJicnJygoKCkpKSoqKisrKywsLC0tLS4uLi8vLzAwMDEx
+MTIyMjMzMzQ0NDU1NTY2Njc3Nzg4ODk5OTo6Ojs7Ozw8PD09PT4+Pj8/P0BAQEFBQUJCQkND
+Q0REREVFRUZGRkdHR0hISElJSUpKSktLS0xMTE1NTU5OTk9PT1BQUFFRUVJSUlNTU1RUVFVV
+VVZWVldXV1hYWFlZWVpaWltbW1xcXF1dXV5eXl9fX2BgYGFhYWJiYmNjY2RkZGVlZWZmZmdn
+Z2hoaGlpaWpqamtra2xsbG1tbW5ubm9vb3BwcHFxcXJycnNzc3R0dHV1dXZ2dnd3d3h4eHl5
+eXp6ent7e3x8fH19fX5+fn9/f4CAgIGBgYKCgoODg4SEhIWFhYaGhoeHh4iIiImJiYqKiouL
+i4yMjI2NjY6Ojo+Pj5CQkJGRkZKSkpOTk5SUlJWVlZaWlpeXl5iYmJmZmZqampubm5ycnJ2d
+nZ6enp+fn6CgoKGhoaKioqOjo6SkpKWlpaampqenp6ioqKmpqaqqqqurq6ysrK2tra6urq+v
+r7CwsLGxsbKysrOzs7S0tLW1tba2tre3t7i4uLm5ubq6uru7u7y8vL29vb6+vr+/v8DAwMHB
+wcLCwsPDw8TExMXFxcbGxsfHx8jIyMnJycrKysvLy8zMzM3Nzc7Ozs/Pz9DQ0NHR0dLS0tPT
+09TU1NXV1dbW1tfX19jY2NnZ2dra2tvb29zc3N3d3d7e3t/f3+Dg4OHh4eLi4uPj4+Tk5OXl
+5ebm5ufn5+jo6Onp6erq6uvr6+zs7O3t7e7u7u/v7/Dw8PHx8fLy8vPz8/T09PX19fb29vf3
+9/j4+Pn5+fr6+vv7+/z8/P39/f7+/v///yH5BAEKAP4ALAAAAAAQABAAAAhNAP0JFAigoMGC
+AxMC+Mew4T8ACQk+PLgQYsSFDhtaVDjx4MOI/jBm/Hixo0GSHEeiJEixpUWXMAuqHClTZcWH
+HWc6RBiTYkqaIHsODAgAOw==}
+ fax
+{R0lGODlhEAAQAMIAAICAgP///wAAAMDAwP///////////////yH5BAEKAAQALAAAAAAQABAA
+AANISLoMznCBQB90juog5Azf1inTMGSiFJylOXAnUc4C4ApmRgO1e9a7Xs4BpJiEGKLQOEx2
+cLlVkjciCKAsZcSK024X1+p3vEgAADs=}
+}
+
+ variable iconUnknown {
+R0lGODlhEAAQAIAAAAAAAP///yH5BAEKAAEALAAAAAAQABAAAAIgjA+px6bbEGAphtownZnb
+/oGhNJLl5ZWamp4u+q5vUwAAOw==
+}
+ variable validFlags
+ # óÐÉÓÏË ÄÏÐÕÓÔÉÍÙÈ ÆÌÁÇÏ× ÚÎÁÞÅÎÉÅ 1 ÅÓÌÉ ÄÏÌÖÅÎ ÂÙÔØ ÐÁÒÁÍÅÔÒ
+ array set validFlags {
+ pidfile 1
+ !pidfile 1
+ gui 1
+ silent 0
+ show 0
+ }
+ proc update {} {
+ variable discovery
+ variable configread
+ variable config
+ if {[file mtime $config]>$configread} {
+ readconfig
+ }
+ set f [open $discovery]
+ while {[gets $f line]>=0} {
+ if {[string match "nickname:*" $line]} {
+ found $line
+ close $f
+ return
+ }
+ }
+ close $f
+ not_found
+ }
+ #
+ # schedules next update
+ #
+ proc reschedule {} {
+ variable poll
+ after $poll ::irda::update
+ }
+ #
+ # ïÂÒÁÂÏÔËÁ ÐÕÓÔÏÇÏ discovery
+ # õÄÁÌÑÅÔ ×ÓÅ ÐÏÚÉÃÉÉ ÉÚ ÍÅÎÀ É ÕÄÁÌÑÅÔ ÉËÏÎËÕ
+ #
+ proc not_found {} {
+ variable hint
+ variable canvas
+ variable menu
+ $canvas delete peer
+ $menu delete 1 end
+ set hint "No IR device in range"
+ proc show_menu {} {}
+ reschedule
+ }
+ #
+ # ïÂÒÁÂÏÔËÁ ÎÁÊÄÅÎÎÏÇÏ ÕÓÔÒÏÊÓÔ×Á. ÷ÈÏÄÎÏÊ ÐÁÒÁÍÅÔÒ -
+ # ÓÔÒÏÞËÁ ÉÚ discovery
+ #
+ proc found {line} {
+ variable hint
+ variable hintBits
+ foreach field [split $line ","] {
+ if {[regexp {([a-z]+): +(.*)} $field xx name value]} {
+ set props($name) $value
+ }
+ }
+ set propList {}
+ if {![string match "$props(nickname)*" $hint]} {
+ foreach {bitMask prop} $hintBits {
+ if {$props(hint) & $bitMask} {
+ lappend propList $prop
+ }
+ }
+ set hint "$props(nickname) [join $propList ","]"
+ setup_menu $propList
+ setup_icon $props(nickname) $propList
+ }
+ reschedule
+ }
+ #
+ # ðÒÏ×ÅÒÑÅÔ ËÏÒÒÅËÔÎÏÓÔØ ÆÌÁÇÁ
+ #
+ proc checkFlag {name value file line} {
+ variable validFlags
+ if {![info exists validFlags($name)]} {
+ error "Invalid flag `$name' at $file:$line"
+ }
+ if {$value && !$validFlags($name)} {
+ error "Flag $name shouldn't have a value at $file:$line"
+ }
+ if {!$value && $validFlags($name)} {
+ error "Flag $name shouldn have a value at $file:$line"
+ }
+ }
+ #
+ # þÔÅÎÉÅ ËÏÎÆÉÇÕÒÁÃÉÏÎÎÏÇÏ ÆÁÊÌÁ ÉÚ ÇÌÏÂÁÌØÎÏÊ ÐÅÒÅÍÅÎÎÏÊ
+ # config. úÁÐÏÌÎÑÅÔ
+ # ÇÌÏÂÁÌØÎÙÊ ÍÁÓÓÉ× confsections
+ #
+ proc readconfig {} {
+ variable config
+ variable confsections
+ variable configread
+ set configread [clock seconds]
+ set f [open $config]
+ set sp "\[ \t\]+"
+ set qstr "(\"\[^\"]+\"|\[^ \t\]+)"
+ set lineno 0
+ array unset confsections {}
+ set confsections(devices) {}
+ while {[gets $f line]>=0} {
+ incr lineno
+ if {![string length $line]} continue
+ if {[regexp "^\[ \t\]*#" $line]} continue
+ if {[regexp "^(\[A-Za-z\]\+):\[ \t\]*$" $line xx secname]} {
+ set secname [string tolower $secname]
+ set confsections($secname) {}
+ } else {
+ if {![info exists secname]} {
+ error "Syntax error in $config:$lineno - menu item without sectname"
+ }
+ if {$secname != "devices"} {
+ if {![regexp "\[ \t\]*$qstr$sp$qstr$sp\(.+)$" $line xx label flags cmd]} {
+ error "Syntax eror in $config:$lineno"
+ }
+ set flagList {}
+ foreach flag [split [string trim $flags \"] ","] {
+ if {![string length $flag]} continue
+ if {[regexp {([^=]+)=(.*)} $flag xx name param]} {
+ checkFlag $name 1 $config $lineno
+ lappend flagList $name $param
+ } else {
+ checkFlag $flag 0 $config $lineno
+ lappend flagList $flag ""
+ }
+ }
+ lappend confsections($secname) [string trim $label \"] $flagList $cmd
+ } else {
+ if {![regexp "\[ \t\]*$qstr$sp(.*)" $line xx pattern filename]} {
+ error "Syntax error in $config:$lineno"
+ }
+ lappend deviceIcons $pattern filename
+ }
+ }
+ }
+ }
+ #
+ # ðÏËÁÚÙ×ÁÅÔ ÉËÏÎËÕ ÕÓÔÒÏÊÓÔ×Á. ðÁÒÁÍÅÔÒÙ nickname ÕÓÔÒÏÊÓÔ×Á
+ # É ÓÐÉÓÏË ÅÇÏ ÁÔÒÉÂÕÔÏ×.
+ proc setup_icon {name props} {
+ variable confsections
+ variable stdIcons
+ variable iconUnknown
+ # óÎÁÞÁÌÁ ÉÝÅÍ ÓÐÅÃÉÆÉÞÅÓËÕÀ ÉËÏÎËÕ × ÓÅËÃÉÉ devices
+ foreach {pattern icon} $confsections(devices) {
+ if [string match $pattern $name] {
+ foreach path [list $::CONFIGDIR $::LIBRARYDIR] {
+ set fn [file join $path "icons" $name]
+ if [file exists $fn] {
+ peer_image -file $fn
+ return
+ }
+ }
+ # åÓÌÉ ËÁÒÔÉÎËÉ ÎÅ ÎÁÊÄÅÎÏ, ÐÒÅËÒÁÝÁÅÍ ÐÅÒÅÂÏÒ
+ break
+ }
+ }
+ set searchList [string tolower $props]
+ # åÓÌÉ ÎÅ ÎÁÊÄÅÎÏ, ÉÝÅÍ ÓÔÁÎÄÁÒÔÎÕÀ
+ foreach {device image} $stdIcons {
+ if {[lsearch -exact $searchList $device]!=-1} {
+ peer_image -data $image
+ return
+ }
+ }
+ # ÕÓÔÁÎÁ×ÌÉ×ÁÅÍ ÉËÏÎËÕ ÎÅÉÚ×ÅÓÔÎÏÇÏ ÕÓÔÒÏÊÓÔ×Á
+ peer_image -data $iconUnknown
+
+ }
+ #
+ # óÏÚÄÁÅÔ ÉËÏÎËÕ Ó ÔÜÇÏÍ peer ÎÁ ËÁÎ×Å.
+ #
+ proc peer_image {option value} {
+ variable canvas
+ $canvas create image 17 8 -anchor w -tag peer \
+ -image [image create photo $option $value]
+ }
+ #
+ # äÏÂÁ×ÌÑÅÔ × ÍÅÎÀ ÐÏÚÉÃÉÉ ÓÏÏÔ×ÅÔÓÔ×ÕÀÝÉÅ Ó×ÏÊÓÔ×ÁÍ ÄÁÎÎÏÇÏ
+ # ÕÓÔÒÏÊÓÔ×Á É ÚÁÐÏÍÉÎÁÅÔ ÄÅÊÓÔ×ÉÑ, ËÏÔÏÒÙÅ ÓÌÅÄÕÅÔ ×ÙÐÏÌÎÉÔØ
+ # ÐÏ postcommand × ÐÒÏÃÅÄÕÒÅ show_menu
+ #
+ proc setup_menu {props} {
+ variable confsections
+ variable menu
+ set checkCode ""
+ foreach prop [string tolower $props] {
+ if [info exists confsections($prop)] {
+ if {[$menu index end] > 0} {
+ $menu add separator
+ }
+ foreach {name flags command} $confsections($prop) {
+ array unset flg
+ array set flg $flags
+ if {[info exists flg(pidfile)]} {
+ if {[string length $flg(pidfile)]} {
+ append checkCode [list check_pidfile $name $flg(pidfile) disable normal] "\n"
+ } else {
+ append checkCode [list check_process $name $command disable normal] "\n"
+ }
+ } elseif {[info exists flg(!pidfile)]} {
+ if {[string length $flg(!pidfile)]} {
+ append checkCode [list check_pidfile $name $flg(!pidfile) normal disable] "\n"
+ } else {
+ append checkCode [list check_process $name $command normal disable] "\n"
+ }
+ }
+ if {[info exists flg(gui)]} {
+ set cmd [list ::launch_gui $name $flg(gui) $command]
+ } elseif {[info exist flg(show)]} {
+ set cmd [list ::irda::launch_log $name $command]
+ } else {
+ set cmd [list ::irda::launch_bacground $name $command]
+ }
+ $menu add command -label $name -command $cmd
+ }
+ }
+ }
+ proc show_menu {} "$checkCode"
+
+ }
+ #
+ # ðÒÏÃÅÄÕÒÙ ÉÓÐÏÌØÚÕÅÍÙÅ × postcommand
+ #
+ # ðÒÏ×ÅÒÑÅÔ ÓÕÝÅÓÔ×Ï×ÁÎÉÅ ÕËÁÚÁÎÎÏÇÏ ÆÁÊÌÁ. ÅÓÌÉ ÏÎ ÓÕÝÅÓÔ×ÕÅÔ
+ # ×ÙÓÔÁ×ÌÑÅÔ ÓÔÁÔÕÓ ÕÇÁÚÁÎÎÙÊ × ifexists ÉÎÁÞÅ - × ifnotexists
+ #
+ proc check_pidfile {item file ifexists ifnotexists} {
+ variable menu
+ if {[file exists $file]} {
+ $menu entryconfig $item -state $ifexists
+ } else {
+ $menu entryconfig $item -state $ifnotexists
+ }
+ }
+ #
+ # ðÒÏ×ÅÒÑÅÔ ÓÕÝÅÓÔ×Ï×ÁÎÉÅ ÐÒÏÃÅÓÓÁ Ó ÕËÁÚÁÎÎÏÊ ËÏÍÁÎÄÏÊ ÓÔÒÏËÏÊ
+ #
+ proc check_process {item command ifexists ifnotexists} {
+ set f [open "|ps auxww" "r"]
+ while {[gets $f line]>=0} {
+ if {[string match *$command $line]} {
+ $menu entryconfig $item -state $ifexists
+ close $f
+ return
+ }
+ }
+ $menu entryconfig $item -state $ifnotexists
+ }
+ # ðÒÏÃÅÄÕÒÙ, ÉÓÐÏÌØÚÕÅÍÙÅ ÄÌÑ ÚÁÐÕÓËÁ ËÏÍÁÎÄ
+ # åÓÌÉ ÓÕÝÅÓÔ×ÕÅÔ ÏËÎÏ ÕËÁÚÁÎÎÏÇÏ ËÌÁÓÓÁ, ÄÅÌÁÅÔ ÅÍÕ raise
+ # ÉÎÁÞÅ - ×ÙÐÏÌÎÑÅÔ ËÏÍÁÎÄÕ
+ proc launch_gui {name class command} {
+ if [catch package require Fvwm] {
+ ::fvwm::getWindowList a
+ foreach {index value} [array get a "*,class"] {
+ if {$value == "$class"} {
+ set $id [lindex [split $index ","] 0]
+ ::fvwm::send Raise $id
+ ::fvwm::send Focus $id
+ return
+ }
+ }
+ }
+ launch_background $name $command
+ }
+ #
+ # úÁÐÕÓËÁÅÔ ËÏÍÁÎÄÕ ÎÁÐÒÁ×ÌÑÑ ÅÅ ×Ù×ÏÄ × ÏËÎÏ
+ #
+ proc launch_log {name command} {
+ set w [uniqueWindow .irda.log]
+ wm title $w $name
+ text $w.t -yscrollcomand "$w.s set" -width 80 -state disabled
+ scrollbar $w.s -command "$w.t yview" -orient vert
+ pack $w.t -side left -fill both -expand y
+ pack $w.s -side right -fill y -expand n
+ set f [open "|$command" r]
+ fconfigure $f -blocking no -buffering no
+ fileevent $f readable [list ::irda::logInput $f $w.t]
+ }
+
+ proc logInput {file window} {
+ if {[eof $f]} {
+ if [catch {close $f} msg] {
+ set string "\n********** TERMINATED *******\n$msg"
+ } else {
+ set string "\n*********** FINISHED ***************\n"
+ }
+ } else {
+ set string [read $f]
+ }
+ $w configure -state normal
+ $w insert end $string
+ $w see end
+ $w configure -state disabled
+ }
+
+ #
+ # úÁÐÕÓËÁÅÔ ËÏÍÁÎÄÕ × ÆÏÎÅ
+ #
+ proc launch_background {name command} {
+ set exec [expandFilename $name $command]
+ eval exec $command &
+ }
+
+
+ # ðÏÄÓÔÁ×ÌÑÅÔ ÉÍÑ ÆÁÊÌÁ. ÷ÏÚ×ÒÁÝÁÅÔ -code return
+ # ÅÓÌÉ ÐÏÌØÚÏ×ÁÔÅÌØ ÏÔËÁÚÁÌÓÑ ÏÔ ×ÙÂÏÒÁ
+ #
+ proc expandFilename {name command} {
+ if {![regexp -indices {%filename%} $command match]} {
+ #nothig to substitute
+ return $command
+ }
+ if {![string length [set filename [tk_openFile -title $name]][} {
+ #operation cancelled
+ return -code return
+ }
+ return [eval string replace [list $command] $match [list $filename]]
+ }
+
+ #setting up an interface
+ canvas $canvas -width 32 -height 16
+ pack $canvas -side right
+ menu $menu -postcommand ::irda::show_menu
+ bind $canvas <1> "$menu post \[winfo rootx %W\] \[expr \[winfo rooty .\]+\[winfo height .\]\]"
+ $canvas create image 1 8 -anchor w -image [image create photo\
+ -data {R0lGODlhEAAQAIAAAAAAAP///yH5BAEKAAEALAAAAAAQABAAQAIojI8AGKr2XluJSskgnVkf
+zHnX9lkL2IVptXouM4aOKdOiXbpo/q5gAQA7}]
+ #
+ # Hint window management
+ #
+ toplevel $canvas.hint
+ wm overrideredirect $canvas.hint y
+ wm withdraw $canvas.hint
+ label $canvas.hint.l -textvar ::irda::hint -font 6x10 -background yellow
+ pack $canvas.hint.l -side left
+ bind $canvas <Enter> ::irda::start_hint
+ bind $canvas <Leave> ::irda::cancel_hint
+ bind $canvas <Motion> ::irda::reset_hint
+ proc start_hint {} {
+ variable hint_after_id
+ set hint_after_id [after 1000 ::irda::show_hint]
+ }
+ proc cancel_hint {} {
+ variable hint_after_id
+ variable canvas
+ if [info exists hint_after_id] {
+ after cancel $hint_after_id
+ unset hint_after_id
+ }
+ if {[wm state $canvas.hint]=="normal"} {
+ wm withdraw $canvas.hint
+ }
+ }
+ proc reset_hint {} {
+ cancel_hint
+ start_hint
+ }
+ proc show_hint {} {
+ variable canvas
+ wm geometry $canvas.hint +[expr [winfo pointerx .]+2]+[expr [winfo pointery .]+2]
+ wm deiconify $canvas.hint
+ raise $canvas.hint
+ }
+
+ }
+ irda::update
+}
--- /dev/null
+Modem:
+ "Connect via GPRS" show,pidfile=/var/run/pppd.pid pon gprs
+ "Connect via GSM" show,pidfile=/var/run/pppd.pid pon gsm
+ "Disconnect" silent,!pidfile=/var/run/pppd.pid poff
+ "Collect Mail" show,pidfile=/var/run/pppd.pid gsm
+OBEX:
+ Phonebook gui=Tkvcf tkvcf
+ Calendar gui=Tkvcal tkvcal
+Computer:
+ "Send file" "" ircp %filename%
+ "Receive file" pidfile="" ircp -r
+PDA:
+ Synchronize gui=Jpilot jpilot
+
--- /dev/null
+õÓÔÒÏÊÓÔ×Ï IR-ÐÌÁÇÉÎÁ
+
+æÁÊÌ ËÏÎÆÉÇÒÕÁÃÉÉ
+
+~/.fubar/irda.conf
+
+ÓÏÄÅÒÖÉÔ ÒÁÚÄÅÌ ÄÌÑ ÔÉÐÁ ÕÓÔÒÏÊÓÔ×Á.
+ôÉÐÙ ÕÓÔÒÏÊÓÔ× ÐÏ /usr/src/linux/include/linux/irda.h
+ ÂÙ×ÁÀÔ
+ 0x100 PNP
+ 0x200 PDA
+ 0x400 COMPUTER
+ 0x800 PRINTER
+ 0x1000 MODEM
+ 0x2000 FAX
+ 0x4000 LAN
+ 0x8000 EXTENSION
+ 0x1 TELEPHONY
+ 0x2 FILE_SERVER
+ 0x4 COMM
+ 0x8 MESSAGE
+ 0x10 HTTP
+ 0x20 OBEX
+(ÃÉÆÒÁ ÜÔÏ ÄÌÑ ÐÒÏÇÒÁÍÍÙ. ÷ ËÏÎÆÉÇÅ ÂÕÄÅÔ ÎÁÐÉÓÁÎÏ Modem:)
+ðÏÓÌÅ ÓÔÒÏËÉ ÚÁÇÏÌÏ×ËÁ ÒÁÚÄÅÌÁ ÓÌÅÄÕÀÔ
+ÓÔÒÏËÉ ×ÉÄÁ "ÔÅËÓÔ" ÆÌÁÇÉ ËÏÍÁÎÄÁ
+ÆÌÁÇÉ ÂÙ×ÁÀÔ "silent" "show"
+"pidfile ÉÍÑ-ÆÁÊÌÁ" üÔÏ ÏÚÎÁÞÁÅÔ ÞÔÏ ÅÓÌÉ ÔÁËÏÊ ÆÁÊÌ ÓÕÝÅÓÔ×ÕÅÔ, ÔÏ
+ËÏÍÁÎÄÁ ÚÁÐÒÅÝÅÎÁ.
+pidfile="" ÚÁÓÔÁ×ÌÑÅÔ ÐÒÏ×ÅÒÑÔØ ÒÁÚÒÅÛÅÎÎÏÓÔØ ËÏÍÁÎÄÙ Ó ÐÏÍÏÝØÀ ps auxww
+
+!pidfile ÉÍÑ-ÆÁÊÌÁ - ËÏÍÁÎÄÁ ÒÁÚÒÅÛÅÎÁ ÔÏÌØËÏ ÅÓÌÉ ÓÕÝÅÓÔ×ÕÅÔ ÔÁËÏÊ ÆÁÊÌ
+gui="ËÌÁÓÓ ÏËÎÁ" ÅÓÌÉ ÏËÎÏ ÔÁËÏÇÏ ËÌÁÓÓÁ ÓÕÝÅÓÔÕÅÔ, ÔÏ ×ÙÂÏÒ ËÏÍÁÎÄÙ
+ÄÅÌÁÅÔ ÅÍÕ raise ×ÍÅÓÔÏ ÔÏÇÏ ÞÔÏÂÙ ÚÁÐÕÓËÁÔØ ËÏÍÁÎÄÕ
+
+óÔÒÏÞËÁ %filename% × ÉÍÅÎÉ ËÏÍÁÎÄÙ ÐÒÉ×ÏÄÉÔ Ë ÐÏÑ×ÌÅÎÉÀ
+ÄÉÁÌÏÇÁ ÏÔËÒÙÔÉÑ ÆÁÊÌÁ, ÒÅÚÕÌØÔÁÔ ×ÙÂÏÒÁ ÉÚ ËÏÔÏÒÏÇÏ ÐÏÄÓÔÁ×ÌÑÅÔÓÑ
+× ËÏÍÁÎÄÕ. ÷ ËÁÞÅÓÔ×Å ÚÁÇÏÌÏ×ËÁ ÏËÎÁ ÉÓÐÏÌØÚÕÅÔÓÑ ÚÁÇÏÌÏ×ÏË ÍÅÎÀ.
+
+ðÒÉÍÅÒ
+
+Modem:
+ Connect via GPRS show,pidfile=/var/run/pppd.pid pon gprs
+ Connect via GSM show,pidfile=/var/run/pppd.pid pon gsm
+ Disconnect silent,!pidfile=/var/run/pppd.pid poff
+ Collect Mail show,pidfile=/var/run/pppd.pig gsm
+OBEX:
+ Phonebook gui=Tkvcf tkvcf
+ Calendar gui=Tkvcal tkvcal
+Computer:
+ Send file ircp %filename%
+ Receive file pidfile="" ircp -r
+PDA:
+ Synchronize
+
+óÅËÃÉÑ Device ÐÏÚ×ÏÌÑÅÔ ÎÁÚÎÁÞÉÔØ ÉËÏÎËÉ ÌÀÂÉÍÙÍ ÕÓÔÒÏÊÓÔ×ÁÍ
+
+Device:
+ nickname icon
+
+åÓÌÉ × ÓÅËÃÉÉ device ÄÅ×ÁÊÓ ÎÅ ÏÐÉÓÁÎ, ÔÏ ÉËÏÎËÁ ×ÙÂÉÒÁÅÔÓÑ ÓÌÅÄÕÀÝÉÍ
+ÏÂÒÁÚÏÍ - ÐÒÏ×ÅÒÑÀÔÓÑ ÂÉÔÙ COMPUTER, PDA, MODEM, LAN, PRINTER ,FAX
+É ÒÉÓÕÅÔÓÑ ÉËÏÎËÁ, ÓÏÏÔ×ÅÔÓÔ×ÕÀÝÁÑ ÐÅÒ×ÏÍÕ ÉÚ ÕÓÔÁÎÏ×ÌÅÎÎÙÈ ÂÉÔÏ×.
+ðÒÉ ÏÂÎÁÒÕÖÅÎÉÉ ÕÓÔÒÏÊÓÔ×Á ×Ï ×ÓÐÌÙ×ÁÀÝÕÀ ÐÏÄÓËÁÚËÕ ÐÏÍÅÝÁÅÔÓÑ nickname
+ÕÓÔÒÏÊÓÔ×Á.
--- /dev/null
+#
+# Mail notifier plugin for fubar. Creates a sunken button which changes
+# color when there is new mail and executes $CONFIGDIR/mail when pressed
+#
+namespace eval mail {
+ set image [image create bitmap -background white -foreground black \
+ -data {#define mailfg_width 24
+ #define mailfg_height 12
+ static unsigned char mailfg_bits[] = {
+ 0xff, 0xff, 0xff, 0x0d, 0x00, 0xb0, 0x71, 0x00, 0x8e, 0x81, 0x83, 0x81,
+ 0x01, 0x7c, 0x80, 0x01, 0x7e, 0x80, 0x81, 0x81, 0x83, 0x71, 0x00, 0x8c,
+ 0x0d, 0x00, 0xf0, 0xff, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 };
+ } -maskdata {#define mailbgd_width 24
+ #define mailbgd_height 12
+ static unsigned char mailbgd_bits[] = {
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+ }]
+ button .mail -relief sunken -bd 1 -image $image -width 32\
+ -command { exec $CONFIGDIR/mail &}
+ set mailDefBg [.mail cget -bg]
+
+ #
+ # procedure to be invoked each minute
+ #
+ proc ::mail::checkMbox {} {
+ variable mailpath
+ return [expr {[file atime $mailpath]<[file mtime $mailpath]}]
+ }
+
+ proc ::mail::checkMailDir {} {
+ variable mailpath
+ return [llength [glob -nocomplain $mailpath/new/*]]
+ }
+
+ proc checkImap {} {
+ variable imap
+ variable imapnewmail
+ variable imapstate
+ set f [open "|$::RunCmd($imap(host)) $imap(command) 2>/dev/null" r+]
+ fconfigure $f -buffering line -blocking no
+ fileevent $f readable "::mail::imapRead $f"
+ set imapstate 1
+ vwait ::mail::imapnewmail
+ return $imapnewmail
+ }
+ proc imapRead {f} {
+ variable imapstate
+ variable imapnewmail
+ if {[eof $f]} {
+ catch {close $f}
+ return
+ }
+ set line [gets $f]
+ if {$imapstate == 1 && [regexp -nocase ready $line]} {
+ puts $f "1 EXAMINE INBOX"
+ set imapstate 2
+ } elseif {$imapstate ==2} {
+ if {[string match "1 *" $line]} {
+ puts $f "2 LOGOUT"
+ set imapstate 3
+ } elseif {[regexp {^\*[[:space:]]+([[:digit:]]+)[[:space:]]+RECENT} $line match new]} {
+ set imapnewmail $new
+ }
+ }
+ }
+
+ proc ::mail::check {args} {
+ variable mailDefBg
+ variable checkcmd
+ if {[$checkcmd]} {
+ .mail configure -bg red
+ } else {
+ .mail configure -bg $mailDefBg
+ }
+ }
+
+ variable mailpath
+ variable checkcmd
+
+ #
+ # Find out mailbox type
+ #
+ if {[file exists $::CONFIGDIR/imapmail]} {
+ set f [open $::CONFIGDIR/imapmail]
+ catch {array set imap [read $f]}
+ if {[info exists imap(host)]&&[info exists imap(command)]&&
+ [info exists ::RunCmd($imap(host))]} {
+ set checkcmd checkImap
+ } else {
+ tk_messageBox -title error -type ok -message "Incorrect syntax of imapmail file"
+ }
+ } else {
+ set tryboxes [list /var/mail/$::env(LOGNAME) /var/spool/mail/$::env(LOGNAME) ~/Maildir]
+
+ if {[info exists ::env(MAIL)]} {
+ set tryboxes [concat [list $::env(MAIL)] $tryboxes]
+ }
+
+ foreach box $tryboxes {
+ if {[file exists $box]} {
+ set mailpath $box
+ if {[file isdirectory $box]&&[file isdirectory $box/new]} {
+ set checkcmd checkMailDir
+ } else {
+ set checkcmd checkMbox
+ }
+ break
+ }
+ }
+ }
+ if {[info exists checkcmd]} {
+ pack .mail -side right -padx 10
+ notifier ::mail::check
+ }
+}
--- /dev/null
+FUBAR mail plugin documentation
+
+MAIL plugin creates small window in the right side of fubar bar with
+mail envelope icon. Window would get red background when you have new
+mail waiting. Clicking on the window brings up your favorite mail
+client.
+
+
+Configuration:
+
+By default, mail plugin checks for local mail in
+
+$MAIL (if this variable is set)
+/var/mail/$LOGNAME
+/var/spool/mail/$LOGNAME
+or ${HOME}/Maildir.
+
+First of the mailboxes found in order they are listed above, would be
+monitored. If none found, and ${HOME}/.fubar/imapmail is not present,
+plugin fails to load.
+
+If it is plain file, it is assumed to be mbox and new mail
+assumed to present if atime of the file is older than mtime.
+
+If it is directory, and new subdirectory is present, then new mail is
+indicated if there are files in new subdirectory.
+
+Ff it is directory, but not Maildir, plugin fails to load. If you want,
+write support for new mail checking in mh folders yourself.
+
+If ${HOME}/.fubar/imapmail file is present, it should contain two
+parameters (to be set into Tcl array by array set command)
+
+host - indicates host where your imap mail is stored. This host should
+be listed in the ${HOME}/.fubar/hosts file and provide command for
+executing commands on it, otherwise plugin would fail to load.
+
+command - command to run imap server in preauth mode. For uw-imap it is
+just /usr/sbin/imapd, for courier imap it is /usr/bin/imapd Maildir
+
+Your favorite mail agent is invoked by executing file named mail
+int the ${HOME}/fubar. This script is also used by some other fubar
+plugins.
+
+
--- /dev/null
+#!/usr/bin/wish
+
+namespace eval mount {
+
+# Default images for various device types.
+# First image in list - for mounted device, second - for empty
+set stdImages(floppy) [list [image create photo -data {
+R0lGODlhEAAQAMIAAAAAgAAAAP//AODg4P///8DAwP///////yH+Dk1hZGUgd2l0aCBHSU1Q
+ACH5BAEKAAcALAAAAAAQABAAAAM7CBDcHgoCQasVUY3N+8gAIY4kAXooWK4n2qkrCSp0XUtK
+oe/FXfcAno8GFNJwwdxumFPqbjje8vioPhIAOw==
+}] [image create photo -data {
+R0lGODlhEAAQAOMAAAAAgAAAAP//AODg4P///4CAgMDAwP8AAP//////////////////////
+/////////yH+Dk1hZGUgd2l0aCBHSU1QACH5BAEKAAgALAAAAAAQABAAAARLEIBAqw0SA8G7
+F5k0jGQ5hAChriyBFnAsx1hh3Hh+F0HR/gRYT6c7GIQ2nCyHPAorMecQx2LyZliaRmLg4iQo
+rvcGnmyJXfBlvY4AADs=
+}]]
+
+set stdImages(cdrom) [list [image create photo -data {
+R0lGODlhEAAQAMIAAICAgP//AMDAwAAAAAD//wD/AP///////yH+Dk1hZGUgd2l0aCBHSU1Q
+ACH5BAEKAAcALAAAAAAQABAAAANReKrQvZCBEIQdIx5AaLUXBBRE91mGkDEFSYGpylhth4Iy
+AJLAoOOZHy0zwOVwhh4HuIGhCgECaKWL0aLS1cZ6xWqbuBblK9kVMJpFA0NOuxUJADs=
+}] [image create photo -data {
+R0lGODlhEAAQAMIAAICAgP//AMDAwAAAAAD//wD/AP///////yH+Dk1hZGUgd2l0aCBHSU1Q
+ACH5BAEKAAcALAAAAAAQABAAAANKeKrQvZCBEIQdIx5AaLUXBBRE91mGkElO624AKM/AABh4
+ruONPdOCXgzUkgmDPYytgfSBdMaaa+pYbWaFAsW6YFqyGE23FhabNQkAOw==
+}]]
+
+set stdImages(zip) [list [image create photo -data {
+R0lGODlhEAAQAMIAAAAAAAAAgMDAwJYNH////+Dg4P//AP///yH+Dk1hZGUgd2l0aCBHSU1Q
+ACH5BAEKAAcALAAAAAAQABAAAANJCLrcGkHIOWF4kVJ7od4W4H0SJ3IoeqbsyqrQIA9EbRPQ
+WexD0e+7HKRGs81wnYCP1/sNhIEikVB8JmdNn6wANXgN2C/U0YAkAAA7
+}] [image create photo -data {
+R0lGODlhEAAQAMIAAOgNDYCAgMDAwAAAAP////8AAP///////yH+Dk1hZGUgd2l0aCBHSU1Q
+ACH5BAEKAAcALAAAAAAQABAAAAM9eLrc/g1IoChc9uKaJ8tHV43fFlZBqq6qEghwLMPBEBB4
+ruOpPc8FQe8VW8mGwt5gqUr6YrpjjUVVDTSPBAA7
+}]]
+
+set stdImages(memoryCard) [list [image create photo -data {
+R0lGODdhEAAQAMIAAAAAAPhAQIgAAOD8+Pj8+ODg4OD88Pj8ACwAAAAAEAAQAAADSAi63Bow
+SvmmjeDqrC3vVCQI0DiGAZmuXjm8hEnMECcUxVDcOF6XhIEgFoT9ArubMIcbHAezGRQafL50
+WIPueOh6v4ejowFJAAA7
+}] [image create photo -data {
+R0lGODdhEAAQAMIAAOiouPj8+ICAgMDAwAAAAPgAAAAAAAAAACwAAAAAEAAQAAADMwi63P4w
+ykkrCMFiJrr/niIMZGmSAiFgbMt26nkWAzyWn2nXMOF7vFippUuBjh6Ca7lMAAA7
+}]]
+
+proc listDevices {} {
+ variable mountedDevices
+ variable ejectableDevices
+ variable deviceWidgets
+ variable deviceImage
+ variable stdImages
+ frame .mount
+ set index 1
+ set f [open /etc/fstab]
+ foreach m [split [read $f] "\n"] {
+ if {![string length $m]||[regexp "^\[ \t\]*#" $m]} continue
+ set opts [split [lindex $m 3] ","]
+ set device [lindex $m 0]
+ if {[lsearch -exact $opts user]==-1||[regexp ":" $device]} continue
+ set mpoint [lindex $m 1]
+ # Guessing
+ switch -glob $device {
+ /dev/fd* { #floppy
+ set deviceImage($mpoint) $stdImages(floppy)
+ }
+ /dev/[sh]d[a-z][0-9] { #partitioned drive
+ regexp {/dev/.d[a-z]} $device ejpath
+ if {[regexp zip $mpoint]} {
+ # assume it is Zip
+ set ejectableDevices($mpoint) $ejpath
+ set deviceImage($mpoint) $stdImages(zip)
+ } else {
+ # USB flashcard or something
+ if {[regexp ejectable $m]} {
+ set ejectableDevices($mpoint) $ejpath
+ }
+ set deviceImage($mpoint) $stdImages(memoryCard)
+ }
+ }
+ default { # anything else should be CD-rom
+ set ejectableDevices($mpoint) $device
+ set deviceImage($mpoint) $stdImages(cdrom)
+ }
+ }
+ set deviceWidgets($mpoint) .mount.d$index
+ incr index
+ label $deviceWidgets($mpoint)
+ bind $deviceWidgets($mpoint) <1> [list ::mount::changeDeviceStatus $mpoint]
+ pack $deviceWidgets($mpoint) -side left
+ }
+ close $f
+ scanMtab
+ pack .mount -side right
+}
+
+proc scanMtab {args} {
+ variable deviceWidgets
+ variable deviceImage
+ set f [open /etc/mtab]
+ foreach m [split [read $f] "\n"] {
+ if {![llength $m]} continue
+ set mpoint [lindex $m 1]
+ if [info exists deviceWidgets([lindex $m 1])] {
+ set mounted($mpoint) 1
+
+ }
+ }
+ close $f
+ foreach {mpoint widget} [array get deviceWidgets] {
+ if [info exists mounted($mpoint)] {
+ $widget configure -image [lindex $deviceImage($mpoint) 0]
+ balloonhelp $widget "$mpoint (mounted)"
+ } else {
+ $widget configure -image [lindex $deviceImage($mpoint) 1]
+ balloonhelp $widget "$mpoint"
+ }
+
+ }
+}
+
+proc changeDeviceStatus {mpoint} {
+ variable deviceWidgets
+ variable deviceImage
+ if {[$deviceWidgets($mpoint) cget -image]=="[lindex $deviceImage($mpoint)\
+ 1]"} {
+ mount $mpoint
+ } else {
+ unmount $mpoint
+ }
+ scanMtab
+}
+
+proc mount {mpoint} {
+ global errorCode
+ if [catch {exec mount $mpoint} msg] {
+ # mount returns non-zero
+ if {$errorCode!="NONE"} {
+ tk_messageBox -title "Mount failed" -message $msg -icon error\
+ -type ok
+ return
+ } else {
+ # No error, but there is warning. Mounted read only
+ if [string length $msg] {
+ tk_messageBox -title "Warning" -message $msg -icon warning \
+ -type ok
+ }
+ }
+ }
+}
+
+proc unmount {mpoint} {
+ global eject ejectableDevices
+ if [catch {exec umount $mpoint} msg] {
+ tk_messageBox -title "Umount failed" -message $msg -icon error\
+ -type ok
+ return
+ }
+ if {[info exists ejectableDevices($mpoint)]} {
+ if [catch {exec eject $ejectableDevices($mpoint) 2>/dev/null} msg] {
+
+ tk_messageBox -title "Eject failed" -message "Device is unmounted\
+ but cannot be ejected:\n$msg" -icon error\
+ -type ok
+ }
+ }
+}
+listDevices
+}
+notifier ::mount::scanMtab
--- /dev/null
+#!/usr/bin/wish
+# Fubar plug-in to handle phonebook
+package require Img
+if {![file exists ~/.phonebook.vcf]} {
+ error "Phonebook file $env(HOME)/.phonebook.vcf not found"
+}
+namespace eval phonebook {
+ # Returns true if phonebook was reread, false if it is not changed
+ #
+ proc read_phonebook {} {
+ variable phones
+ variable phonebookstamp
+ if {[info exists phonebookstamp]&&[file mtime ~/.phonebook.vcf]<$phonebookstamp} {
+ return 0
+ }
+ if {[info exists phones]} {unset phones}
+ set f [open ~/.phonebook.vcf r]
+ fconfigure $f -encoding utf-8
+ set state "none"
+ while {[gets $f line]>=0} {
+ if {![string length $line]} continue
+ if {$state eq "photo"} {
+ if {![regexp ":" $line]} {
+ set index [lindex [array names cur_record "PHOTO*"] 0]
+ append cur_record($index) "$line\n"
+ continue
+ } else {
+ set state "record"
+ }
+ }
+ foreach {field value} [split $line :] break
+ set list [split $field ";"]
+ if {[llength $list>1]} {
+ set field [lindex $list 0]
+ foreach opt [lrange $list 1 end] {
+ if {[string match CHARSET=* $opt]||
+ [string match ENCODING=* $opt]||
+ $opt eq "PREF"} continue
+ lappend field $opt
+ }
+ }
+ if {$field eq "END"} {
+ assemble_record cur_record
+ set state "none"
+ array unset cur_record
+ } elseif {$field eq "BEGIN"} {
+ if {[info exists currecord]} {
+ array unset cur_record
+ }
+ set state "record"
+ } else {
+ if {[string match "PHOTO*" $field]} {
+ set cur_record($field) "$value\n"
+ set state "photo"
+ } else {
+ set cur_record($field) ""
+ foreach subval [split $value ";"] {
+ set cur_record($field) "$subval $cur_record($field)"
+ }
+ }
+ }
+ }
+ close $f
+ set phonebookstamp [clock seconds]
+ return 1
+ }
+
+ proc assemble_record {var} {
+ upvar $var record
+ variable phones
+ set index $record(N)
+ if [info exists record(ORG)] { append index ",$record(ORG)"}
+ if [info exists record(TITLE)] { append index ",$record(TITLE)"}
+ set phones($index) [array get record]
+ }
+
+ proc mkwindow {w} {
+ wm title $w "Phone book"
+ frame $w.search
+ entry $w.search.pattern
+ button $w.search.loc -text "Find"\
+ -command [list ::phonebook::position $w]
+ button $w.search.filter -text "Filter"\
+ -command [list ::phonebook::filter $w]
+ button $w.search.new -text "New"\
+ -command [list ::phonebook::new_rec $w]
+ bind $w.search.pattern <Key-Return> [list $w.search.loc invoke]
+ bind $w.search.pattern <Control-Return> [list $w.search.filter invoke]
+ bind $w.search.pattern <Control-n> [list $w.search.new invoke]
+ pack $w.search.pattern -side left -fill x -expand y
+ pack $w.search.loc $w.search.filter $w.search.new -side left
+ listbox $w.list -yscrollcommand "$w.y set" -width 20
+ bind $w.list <<ListboxSelect>> "::phonebook::show_record $w \[%W get \[%W curselection\]\]"
+ bind $w.list <Key> [list ::phonebook::keyEvent $w.search.pattern %k %s %A %K]
+ scrollbar $w.y -orient vert -command "$w.list yview"
+ frame $w.record
+ foreach {name title} {name "éÍÑ" org "ïÒÇÁÎÉÚÁÃÉÑ" title "ú×ÁÎÉÅ"
+ telcell "ôÅÌ. íÏÂ" telwork "ôÅÌ.òÁÂ." telhome "ôÅÌ.äÏÍ." telother
+ "ðÒÏÞÅÅ" fax "æÁËÓ" email "E-Mail"} {
+ label $w.record.l$name -text $title -anchor e
+ label $w.record.$name -anchor w
+ grid $w.record.l$name $w.record.$name -sticky news
+ }
+ label $w.record.image
+ button $w.record.edit -text Edit -command "::phonebook::edit_record"
+ button $w.record.mail -text Mail -state disabled -command "::phonebook::mail_to"
+ grid $w.record.image - -sticky news
+ grid $w.record.mail $w.record.edit -sticky ns
+ grid columnconfigure $w.record 1 -weight 1
+ grid columnconfigure $w.record 0 -weight 0
+ grid $w.search - - -sticky news
+ grid $w.list $w.y $w.record -sticky news
+ grid columnconfigure $w 0 -weight 1
+ grid columnconfigure $w 1 -weight 0
+ grid columnconfigure $w 2 -weight 1
+ }
+ proc keyEvent {window keycode state char keysym} {
+ if {![string length $char]} return;#ignore noncharacter keys
+ focus $window
+ event generate $window <KeyPress> -keycode $keycode -keysym $keysym\
+ -state $state -when tail
+ }
+ proc show_record {w index} {
+ variable phones
+ variable current
+ if {[info exists phones($index)]} {
+ array set record $phones($index)
+ set current $index
+ } else {
+ array set record {}
+ if {[info exists current]} {unset current}
+ }
+ $w.record.name configure -text $record(N);
+ set_if_exists $w.record.org record(ORG)
+ set_if_exists $w.record.title record(TITLE)
+ set_if_exists $w.record.telcell "record(TEL CELL)"
+ set_if_exists $w.record.telhome "record(TEL HOME)"
+ set_if_exists $w.record.telwork "record(TEL WORK)"
+ set_if_exists $w.record.telother "record(TEL)"
+ set_if_exists $w.record.fax "record(TEL FAX)"
+ set_if_exists $w.record.email "record(EMAIL INTERNET)"
+ if {[info exists "record(EMAIL INTERNET)"]} {
+ $w.record.mail configure -state normal
+ } else {
+ $w.record.mail configure -state disabled
+ }
+ if {[llength [set img_index [lindex [array names record PHOTO*] 0]]]} {
+ if {![regexp {TYPE=([^[:space:]]+)} $img_index msg fmt]} {
+ set fmt JPEG
+ }
+ $w.record.image configure -image [image create photo -format $fmt -data $record($img_index)]
+ } else {
+ $w.record.image configure -image ""
+ }
+ }
+
+ proc set_if_exists {w var} {
+ upvar $var v
+ if {[info exists v]} {
+ $w configure -text $v
+ } else {
+ $w configure -text {}
+ }
+ }
+
+ proc fill_window {w} {
+ variable phones
+ variable filter
+ variable current
+ read_phonebook
+ set list [lsort [array names phones]]
+ if {[info exists filter]} {
+ set list [lsearch -all -inline -regexp $list $filter ]
+ }
+ $w.list delete 0 end
+ eval $w.list insert 0 $list
+ if {![info exists current]||[set index [lsearch -exact $list $current]]<0} {
+ set index 0
+ }
+ $w.list selection clear 0 end
+ $w.list selection set $index
+ event generate $w.list <<ListboxSelect>>
+ after idle "$w.list see $index;focus $w.list"
+ focus $w.search.pattern
+ }
+
+ proc position {w} {
+ set pattern [$w.search.pattern get]
+ set list [$w.list get 0 end]
+ set index [lsearch -regexp $list $pattern]
+ if {$index!= -1} {
+ $w.list selection clear 0 end
+ $w.list selection set $index
+ event generate $w.list <<ListboxSelect>>
+ after idle "$w.list see $index;focus $w.list"
+ }
+ }
+
+ proc filter {w} {
+ variable filter
+ set filter [$w.search.pattern get]
+ if {![string length $filter]} {
+ unset filter
+ }
+ fill_window $w
+ }
+#
+# Create an interface
+#
+if {$::argv0 ne [info script]} {
+ set m .find.m
+ $m add command -label "Phone..." -command\
+ "create_or_raise .phonebook ::phonebook::mkwindow; ::phonebook::fill_window .phonebook"
+} else {
+ button .b -text "Phonebook" -command "toplevel .phonebook;
+ ::phonebook::mkwindow .phonebook
+ ::phonebook::fill_window .phonebook"
+ pack .b
+}
+
+proc mail_to {} {
+ variable current
+ variable phones
+ global CONFIGDIR
+ array set r $phones($current)
+ if {![info exists "r(EMAIL INTERNET)"]} {
+ return
+ }
+ set address ${r(EMAIL INTERNET)}
+ exec $CONFIGDIR/mail $address &
+}
+
+proc new_rec {} {
+ variable edited
+ catch {unset edited}
+ edit_window
+}
+
+proc edit_record {} {
+ variable current
+ variable phones
+ variable edited
+ set edited $current
+ edit_window
+}
+
+proc edit_window {} {
+
+}
+}
--- /dev/null
+
+namespace eval phonebook {
+ set m .find.m
+#balloonhelp $m -index "Search for a host on the network"
+$m add command -label "Person..." -command [list create_or_raise\
+ .find_phone ::phonebook::find]
+
+proc find {w} {
+ wm title $w "Find person"
+ label $w.l -text "Enter name:" -anchor w
+ entry $w.name -width 30 -font 6x13
+ bind $w.name <Key-Return> [list search_phonebook $w]
+ button $w.phone -text "Phonebook" -command [list search_phonebook $w]
+ button $w.finger -text "Finger" -command "open_pipe $w.result\
+ \"finger \\\"\[$w.name get\]\\\"\""
+ button $w.add -text "Add to phonebook" -command "create_or_raise \
+ .add_phone ::phonebook::add"
+ grid $w.l $w.name - - -sticky news
+ grid $w.finger $w.phone $w.add - -sticky ns
+
+ text $w.result -height 5 -yscrollcommand [list $w.y set] -state disabled\
+ -font 6x13
+ $w.result tag configure error -foreground red
+ $w.result tag configure done -foreground green
+ $w.result tag configure mail -foreground blue -underline y
+ $w.result tag bind mail <1> "mail_person $w.result @%x,%y"
+ scrollbar $w.y -orient vert -command [list $w.result yview]
+ grid $w.result - - $w.y -sticky news
+ grid columnconfigure $w 0 -weight 0
+ grid columnconfigure $w 1 -weight 1
+ grid columnconfigure $w 2 -weight 0
+ grid columnconfigure $w 3 -weight 0
+ foreach row {0 1} {
+ grid rowconfigure $w $row -weight 0
+ }
+ grid rowconfigure $w 2 -weight 1
+}
+
+proc search_phonebook {w} {
+ global CONFIGDIR
+ set pattern [$w.name get]
+ set f [open "$CONFIGDIR/phonebook"]
+ clearresult $w.result
+ while {[gets $f line]>=0} {
+ if {[regexp "\[ \t\]*#" $line]} {
+ continue
+ }
+ foreach {n1 n2 t num time mail} [split $line :] break
+ if {[regexp $pattern $n1]||[regexp $pattern $n2]} {
+ show_phone $w.result $n1 $t $num $time $mail
+ }
+ }
+ close $f
+}
+
+proc show_phone {win name type num time mail} {
+ $win configure -state normal
+ $win insert end "$name\($type\)\t$num"
+ if [string length $time] {
+ $win insert end "\($time\)"
+ }
+ if [string length $mail] {
+ $win insert end "\t" {} $mail mail
+ }
+ $win insert end \n
+ $win see end
+ $win configure -state disabled
+}
+
+proc mail_person {w index} {
+ global CONFIGDIR
+ set range [$w tag nextrange mail "$index linestart"]
+ set address [eval $w get $range]
+ exec $CONFIGDIR/mail $address &
+}
+
+proc add {w} {
+ wm title $w "Add to phone book"
+ label $w.l1 -text "Person name:"
+ entry $w.name -width 30 -font 6x13
+ label $w.l2 -text "Person nickname:"
+ entry $w.nick -width 30 -font 6x13
+ label $w.l3 -text "Type of phone:"
+ tk_optionMenu $w.type phone_type ÄÏÍ. ÒÁÂ. ÐÅÊÄÖÅÒ ÆÁËÓ ÍÏÄÅÍ ËÏÎÔÁËÔ
+ label $w.l4 -text "Phone number:"
+ entry $w.phone -width 30 -font 6x13
+ label $w.l5 -text "Time interval:"
+ entry $w.time -width 30 -font 6x13
+ label $w.l6 -text "E-Mail"
+ entry $w.mail -width 30 -font 6x13
+ button $w.add -command "add_phone $w" -text "Add"
+ button $w.cancel -command "destroy $w" -text Cancel
+ grid $w.l1 $w.name -sticky w
+ grid $w.l2 $w.nick -sticky w
+ grid $w.l3 $w.type -sticky w
+ grid $w.l4 $w.phone -sticky w
+ grid $w.l5 $w.time -sticky w
+ grid $w.l6 $w.mail -sticky w
+ grid $w.add $w.cancel -sticky ns
+}
+
+proc add_phone {w} {
+ global CONFIGDIR
+ global phone_type
+ set f [open "$CONFIGDIR/phonebook" a+]
+ puts $f [join [list [$w.name get] [$w.nick get] $phone_type\
+ [$w.phone get] [$w.time get] [$w.mail get]] :]
+ close $f
+ wm withdraw $w
+}
+}
--- /dev/null
+#
+# This is a helper script for FUBAR, which creates user preferences
+# directory and populates it with default files, taken from system-wide
+# library directory
+#
+
+if [llength [info command link]] {
+ proc symlink {source dest} {
+ link -sym $source $dest
+ }
+} else {
+ proc symlink {source dest} {
+ exec ln -s $source $dest
+ }
+}
+#
+# variables CONFIGDIR and LIBRARYDIR should be provided by invoking
+# script
+#
+proc copyhier {src dest} {
+ file mkdir $dest
+ foreach f [glob -nocomplain $src/*] {
+ set s [file join $dest [file tail $f]]
+ if [catch {file readlink $f} d] {
+ if [file isdirectory $f] {
+ copyhier $f $s
+ } else {
+ symlink $f $s
+ }
+ } else {
+ symlink $d $s
+ }
+ }
+}
+
+
+file mkdir $CONFIGDIR
+copyhier $LIBRARYDIR/menu $CONFIGDIR/menu
+
+foreach file [glob -nocomplain $LIBRARYDIR/plugins/*] {
+ # skip documentation
+ if {[string match *.txt $file]} continue
+ symlink $f [file join $CONFIGDIR plugins [file tail $file]]
+}
+
+foreach f {hosts associations holydays} {
+ if [file exists $LIBRARYDIR/$f] {
+ file copy $LIBRARYDIR/$f $CONFIGDIR/$f
+ }
+}
+
+symlink $LIBRARYDIR/mail $CONFIGDIR/mail
+
+close [open "$CONFIGDIR/phonebook" a+]
+
--- /dev/null
+#
+# Package tooltip - creates floating tips for widget
+# tips can display
+# 1. Static text set upon tip creation
+# 2. Contents of specified variable
+# 3. Result of command execution
+#
+# Tooltips are really top-level windows with class Tooltip named
+# $widget.tooltip
+#
+
+# Uses resources *Tooltip*Font
+# *Tooltip*Foreground
+# *Tooltip*Background
+# *Tooltip.Delay (popup delay, ms)
+
+# Default options
+
+package require Tk
+
+option set *Tooltip*Font {Fixed 10} widgetDefault
+option set *Tooltip*Background yellow widgetDefault
+option set *Tooltip*Foreground black widgetDefault
+option set *Tooltip.BorderWidth 1 widgetDefault
+option set *Tooltip.Delay 2000 widgetDefault
+
+#
+# Syntax:
+# tooltip widget ?-text "Text" | -variable varname | -command command?
+#
+#
+
+namespace eval tooltip {
+ proc tooltip {widget args} {
+ variable tipcommand
+ if [winfo exist $widget.tooltip] {
+ clearTipCommand $widget
+ setupTipLabel $widget $args
+ } else {
+ toplevel $widget.tooltip -class Tooltip
+ label $widget.tooltip.l
+ pack $widget.tooltip.l
+ wm withdraw $widget.tooltip
+ wm overrideredirect $widget.tooltip
+ setupBindings $widget
+ setupTipLabel $widget $args
+ }
+ }
+ proc clearTipCommand widget {
+ variable tipcommand
+ if [info exists tipcommand($widget)] {
+ unset tipcommand($widget.tooltip)
+ }
+ }
+
+
+ proc setupBindings {widget} {
+ bind $widget <Enter> {+::tooltip::start %W}
+ bind $widget <Leave> {+::tooltip::cancel %W}
+ bind $widget <Motion> {+::tooltip::reset %W}
+ bind $widget <Destroy> {+::tooltip::cancel %W;
+ ::tooltip::clearTipCommand %W}
+ }
+
+ proc start {widget} {
+ variable afterId
+ set afterId($widget) [after [option get $widget.tooltip delay Delay] [list ::tooltip::show $widget]]
+ }
+
+ proc cancel {widget} {
+ variable afterId
+ if {[info exists afterId($widget)]} {
+ after cancel $afterId($widget)
+ unset afterId($widget)
+ }
+ if {[wm state $widget.tooltip]=="normal"} {
+ wm withdraw $widget.tooltip
+ }
+ }
+
+ proc show {widget} {
+ variable tipcommand
+ if [info exists tipcommand($widget)] {
+ $widget.tooltip.l configure -text [uplevel $tipcommand($widget)]
+ }
+ wm geometry $widget.tooltip +[expr [winfo pointerx $widget]+2]+[expr [winfo pointery $widget]+2]
+ wm deiconify $widget.tooltip
+ raise $widget.tooltip
+ }
+
+ proc reset {widget} {
+ cancel $widget
+ start $widget
+ }
+ proc setupTipLabel {widget arglist} {
+ variable tipcommand
+ foreach {type value} $arglist break
+ switch -glob -- $type {
+ -text {$widget.tooltip.l configure -text $value}
+ -var* {$widget.tooltip.l configure -textvar $value}
+ -comm* {set tipcommand($widget) $value}
+ default {
+ return -code error "Invalid option should be one of -text -variable -command"
+ }
+ }
+ }
+ namespace export tooltip
+}
+ namespace import tooltip::*
+
+package provide tooltip 0.1
projects / oss / fubar.git / commitdiff
