--- /dev/null
+.TH Fvwm n "Version 1.0" "Tcl Fvmw module interface"
+.SH NAME
+Fvwm \- Fvwm module interface for Tcl
+
+.SH SYNOPSIS
+package require \fBFvwm\fR
+.PP
+\fBfvwm::send\fR \fIcommand\fR ?\fIwindowid\fR?
+.PP
+\fBfvwm::bind \fIevent\fR ?\fIscript\fR?
+.PP
+\fBfvwm::getConfig \fIvarname\fR ?\fIglobPattern\fR?
+.PP
+\fBfvwm::getWindowList \fIvarname\fR
+.PP
+\fBfvwm::setMask \fIlist\fR
+.PP
+\fBfvwm::iconPath \fIname\fR ?\fIoption\fR?
+.SH DESCRIPTION
+
+\fBFvwm\fR package is a Tcl-only package which provides a way to build
+\fBfvwm\fR(1) modules on Tcl/Tk. Upon package initialization it checks
+if script is invoked as fvwm module and set ups pipes to communicate
+with \fBfvwm\fR. If script doesn't started as fvwm module, package
+initialization fails. Package provides procedures to set commands
+to fvwm and obtain information from it. It provides procedures
+to parse fvwm \fBWindowList\fR and \fBConfigInfo\fR messages and
+way to handle messages sended by fvwm just like Tk events.
+.PP
+Upon initialization \fBFvwm\fR package removes all fvwm-specific
+information from global \fBargv\fR variable and changes \fBargc\fR
+accordingly. This information can be accessed via package variables.
+.SH VARIABLES
+.TP 8
+.B Context
+Contain information about context in which module is called. It can
+be one of following strings:
+.RS
+.PP
+\fBNO_CONTEXT\fR, \fBWINDOW\fR, \fBTITLE\fR, \fBICON\fR, \fBROOT\fR,
+\fBFRAME\fR, \fBSIDEBAR\fR, \fBLEFT1\fR - \fBLEFT5\fR, \fBRIGHT1\fR -
+\fBRIGHT5\fR
+.PP
+which corresponds with parts of window decorations, provided by fvwm
+.RE
+.TP 8
+.B WindowId
+Integer (decimal) identifier of window, in whose context script was
+called
+.TP 8
+.B configFile
+Name of \fBfvwm\fR configuration file (probably useless for fvwm 2.0,
+because configuration info could be requested from fvwm itself.
+
+.SH FUNCTIONS
+.TP 8
+\fBsend\fR \fIcommand\fR ?\fIwindowId\fR?
+
+sends a command to fvwm. Command is a string exactly as it appears in
+\fB.fvwmrc\fR file. Command may be optionally followed by \fIwindow
+id\fR, in this case it can be applied to given window.
+.TP 8
+\fBsetMask\fR \fIlist\fR
+Instructs \fBfvwm\fR to send only certain events to this script.
+List should contain list of event names (see EVENTS below)
+.TP 8
+\fBbind\fR \fIevent\fR ?\fIscript\fR?
+binds a script with specific fvwm event (see EVENTS below)
+Script will be executed in global namespace
+appended by list of event arguments. If script is omitted,
+current script would be returned. Specifying empty string disables
+processing of given event.
+.TP 8
+\fBgetConfig\fR \fIvarname\fR ?\fIglobPattern\fR?
+Requests configuration information from fvwm and stores it
+in the array \fIvarname\fR. Glob pattern allows to restrict
+configuration to lines matching pattern.
+.RS
+.PP
+Global configuration lines such as \fBPixmapPath\fR would be always
+returned, but module-specific lines (those which start from \fB`*'\fR),
+would be returned only if they (with `*' stripped off) match given
+pattern. First word in line (without `*') would be used as array index.
+If multiple lines have same first word, they would be concatenated
+into Tcl list.
+.PP
+Entries which are lists of directories (\fBIconPath\fR,
+\fBPixmapPath\fR) are converted to Tcl list too.
+.RE
+.TP 8
+\fBgetWindowList\fR \fIvarname\fR
+Requests information about current desktop state and stores it
+in the given array variable. This array would have indices:
+.RS
+.TP 4
+.B Desk
+Number of current desk
+.TP 4
+.B Page
+list of four coordinates of current page
+.TP 4
+.B Focus
+containing Id of toplevel window.
+.TP 4
+.B DefaultIcon
+name of default icon (used for windows which have no icon defined)
+\fIwindowId\fB,frame\fR
+for each window there is list of following values: windowId of window
+frame, X of frame, Y of frame, width of frame, height of frame, height of title, border width,
+.TP 4
+\fIwindowId\fB,desk\fR
+number of desktop,
+.TP 4
+\fIwindowId\fB,flags\fR
+window flags field
+.TP 4
+\fIwindowId\fB,base\fR
+Offset of window base coordinates from top-left frame corner
+.TP 4
+\fIwindowId\fB,grid\fR
+resize width increment, resize height increment,
+.TP 4
+\fIwindowId\fB,min\fR
+minimum width, minimum height.
+.TP 4
+\fIwindowId\fB,max\fR
+maximum width, maximum height.
+.TP 4
+\fIwindowId\fB,iconIds\fR
+icon label window id (or 0), icon pixmap window id (or 0),
+.TP 4
+\fIwindowId\fB,gravity\fRwindow
+gravity, string, as defined in /usr/X11R6/include/X11/X.h
+.TP 4
+\fIwindowId\fB,title\fR
+Title of window
+.TP 4
+\fIwindowId\fB,iconName\fR
+Title of icon for this window
+.TP 4
+\fIwindowId\fB,resource\fR
+Resource name for this window
+.TP 4
+\fIwindowId\fB,class\fR
+Resource class for this window
+.TP 4
+\fIwindowId\fB,icon\fR
+Name of xpm file which is used as icon for this window
+.TP 4
+\fIwindowId\fB,miniIcon\fR
+Name of xpm file which is used as title icon (fvwm-95 only).
+.RE
+.TP 8
+\fBiconPath\fR \fIfilename\fR ?\fIoption\fR?
+Searches for given filename in fvwm pixmap or icon path and returns
+full pathname of it if found. I don't like an idea to return Tcl image
+because there is two Tcl extension which can create Xpm images - Img and
+Tix and I don't know which you'll prefer.
+.RS
+.PP
+\fIoption\fR can be either \fB-pixmap\fR or \fB-icon\fR which would
+cause \fBPixmapPath\fR or \fBIconPath\fR to be searched. Defaults to
+\fBPixmapPath\fR.
+
+.SH EVENTS
+
+Fvwm events are described in file \fBdocs/modules.tex\fR in fvwm
+distribution. If you are seriously planning to develop fvwm module,
+you should read it anyway. Note that event names in tcl Fvwm package
+differs in capitalization from C constants, defined in fvwm's
+\fBmodule.h\fR. List of names is shown below.
+.PP
+When event handler is called it is appended by long list of
+arguments. First argument passed is always event name, thus allowing
+you to use same handlers for several event types. All other fields
+are all field from fvwm packet body, even they are appear completely
+useless. Refer to \fBmodules.tex\fR for description of this fields
+.PP
+For convinience we would note that if event is related to particular
+window, its ID is passed as first argument, and if event have text
+message associated with it, it is always fourth (don't counting event
+name).
+.PP
+There is one additional event type \fBDeadPipe\fR, which occurs if
+eof on pipe is encountered. This event have default handler, which
+exits from script. It can be redefined to perform applicaton cleanup.
+.PP
+Event of type \fBError\fR have default handler, which raises Tcl error
+with same message as original event. This error is raised from
+\fBafter idle\fR handler to avoid closing pipe, which is default Tcl
+behavoir in case of unhandled errors in fileevent scripts.
+
+.SH EVENT LIST
+
+.TP 4
+.B FVWM 2.0.43 events
+NewPage
+NewDesk
+AddWindow
+RaiseWindow
+LowerWindow
+ConfigureWindow
+FocusChange
+DestroyWindow
+Iconify
+Deiconify
+WindowName
+IconName
+ResClass
+ResName
+End_WindowList
+IconLocation
+Map
+Error
+ConfigInfo
+End_ConfigInfo
+IconFile
+DefaultIcon
+String
+
+.TP 4
+.B FVWM-95 only
+FunctionEnd
+MiniIcon
+ScrollRegion
+.TP 4
+.B Dummy event, generated by package itself
+DeadPipe
+
+.SH ERROR REPORTING
+
+
+.SH SEE ALSO
+\fBfvwm(1)\fR, \fBdocs/modules.tex\fR in fvwm distribution
+
+.SH BUGS
+getWindowList doesn't properly handle pixel color values, returned by
+fvwm. Parsing event args should be better (may be keyed lists),
+especially for AddWindow and ConfigureWindow. There could be
+problems with wrong capitalization in fvwm config file, because
+\fBgetConfig\fR and \fBiconPath\fR work in case-sensitive manner, and
+fvwm seems to be case-insensitive.
+
+.SH AUTHOR
+
+Victor Wagner <vitus@ice.ru>
+
+
+
+
--- /dev/null
+install: fvwm.tcl pkgIndex.tcl
+ install -m 755 -d $(DESTDIR)/usr/lib/fvwm-tcl
+ install -m 644 fvwm.tcl $(DESTDIR)/usr/lib/fvwm-tcl
+ install -m 644 pkgIndex.tcl $(DESTDIR)/usr/lib/fvwm-tcl
+
+clean:
--- /dev/null
+libfvwm-tcl for Debian
+----------------------
+
+This package provides Tcl interface to make fvwm modules.
+
+It is documented in manual page Fvwm(3tcl)
+
+Example module "quit.tcl" which quits session is provided here.
+
+One interesting ability which is usially overseen is that if you have
+fvwm module which uses Tk, you can connect to it from another app
+running on same desktop and send tcl (and consequentually, fvwm)
+commands to it using Tk send command.
+
+Module requires Tclx module which is not part of Debian distribution.
+Debian package for it is provided on my ftp site. (I've debianized it
+solely for use with this module)
+
+ -- Victor B. Wagner <vitus@ice.ru>, Sun, 1 Oct 2000 12:27:39 +0400
--- /dev/null
+libfvwm-tcl (1.3-2) unstable; urgency=low
+
+ * ÷ÓÔÁ×ÌÅÎÁ ÂÏÒØÂÁ Ó ÐÏÐÏÌÚÛÉÍ ÈÅÄÅÒÏÍ × ÎÅÄÒÁÈ fvwm É ÐÅÒÅÔÒÑÈÎÕÔÙ ÓÌÅÇËÁ
+ ÚÁ×ÉÓÉÍÏÓÔÉ
+
+ -- Artem Chuprina <ran@ran.pp.ru> Sat, 26 Mar 2005 00:42:50 +0300
+
+libfvwm-tcl (1.3-1) unstable; urgency=low
+
+ * ðÏÐÒÁ×ÌÅÎÁ ÒÁÂÏÔÁ ÓÏ ÓÐÉÓËÏÍ ÏËÏÎ
+
+ -- Victor B. Wagner <vitus@45.free.net> Sun, 4 Apr 2004 19:38:08 +0400
+
+libfvwm-tcl (1.2-1) unstable; urgency=low
+
+ * Added support of fvwm2.5.x messages
+ * Added ability to run on Linux without Tclx
+
+ -- Victor B. Wagner <vitus@45.free.net> Fri, 4 Jul 2003 21:20:55 +0400
+
+libfvwm-tcl (1.1-1) unstable; urgency=low
+
+ * Updated upstream release to handle Unicode-enabled version of
+ Tcl. Added some event types new for fvwm 2.4
+ * Changed dependency from tcl 8.0 to tcl 8.3
+
+ -- Victor Wagner <vitus@ice.ru> Sat, 20 Apr 2002 15:03:09 +0400
+
+libfvwm-tcl (1.0-2) unstable; urgency=low
+
+ * Fixed namespace of default Error handler
+
+ -- Victor B. Wagner <vitus@ice.ru> Tue, 28 Nov 2000 00:28:46 +0300
+
+libfvwm-tcl (1.0-1) unstable; urgency=low
+
+ * Initial Release.
+
+ -- Victor B. Wagner <vitus@ice.ru> Sun, 1 Oct 2000 12:27:39 +0400
+
+Local variables:
+mode: debian-changelog
+End:
--- /dev/null
+Source: libfvwm-tcl
+Section: unknown
+Priority: optional
+Maintainer: Victor B. Wagner <vitus@ice.ru>
+Standards-Version: 3.0.1
+
+Package: libfvwm-tcl
+Architecture: all
+Depends: tcl8.4 | tcl8.3, fvwm
+Recommends: tclx8.4 | tclx8.3
+Suggests: tk8.4 | tk8.3
+Description: Tcl interface to fvwm window manager
+ Tcl-only library which allows to write FVWM modules on Tcl
+ .
+ Contains commands to send commands to Fvwm, obtain list of currently
+ open windows and configuration variables, bind Tcl procs to fvwm
+ events.
+ .
+ Doesn't require Tk but you'll probably need it if you want your module
+ to have some interface.
+ .
+ Uses Tclx for do unix-specific things which fvwm expects from its
+ modules.
--- /dev/null
+This package was debianized by Victor B. Wagner <vitus@ice.ru> on
+Sun, 1 Oct 2000 12:27:39 +0400.
+
+It wasn't downloaded from http://www.ice.ru/~vitus/works/tcl.html
+(becouse it is simplier to debianize my working copy on my local disk)
+
+Upstream Author(s): Victor B. Wagner <vitus@ice.ru>
+
+Copyright:
+
+BSD style license, like Tcl itself.
--- /dev/null
+usr/bin
+usr/sbin
--- /dev/null
+#!/usr/bin/make -f
+# Sample debian/rules that uses debhelper.
+# GNU copyright 1997 to 1999 by Joey Hess.
+
+# Uncomment this to turn on verbose mode.
+#export DH_VERBOSE=1
+
+# This is the debhelper compatability version to use.
+export DH_COMPAT=1
+
+build: build-stamp
+build-stamp:
+ dh_testdir
+
+
+ # Add here commands to compile the package.
+ #$(MAKE)
+
+ touch build-stamp
+
+clean:
+ dh_testdir
+ dh_testroot
+ rm -f build-stamp
+
+ # Add here commands to clean up after the build process.
+ -$(MAKE) clean
+
+ dh_clean
+
+install: build
+ dh_testdir
+ dh_testroot
+ dh_clean -k
+ dh_installdirs
+
+ # Add here commands to install the package into debian/tmp.
+ $(MAKE) install DESTDIR=`pwd`/debian/tmp
+
+
+# Build architecture-independent files here.
+binary-arch: build install
+# We have nothing to do by default.
+
+# Build architecture-dependent files here.
+binary-indep: build install
+# dh_testversion
+ dh_testdir
+ dh_testroot
+# dh_installdebconf
+ dh_installdocs
+ dh_installexamples
+ dh_installmenu
+# dh_installemacsen
+# dh_installpam
+# dh_installinit
+ dh_installcron
+ dh_installmanpages
+ dh_installinfo
+# dh_undocumented
+ dh_installchangelogs
+ dh_link
+ dh_strip
+ dh_compress
+ dh_fixperms
+ # You may want to make some executables suid here.
+# dh_suidregister
+# dh_makeshlibs
+ dh_installdeb
+# dh_perl
+ dh_shlibdeps
+ dh_gencontrol
+ dh_md5sums
+ dh_builddeb
+
+binary: binary-indep binary-arch
+.PHONY: build clean binary-indep binary-arch binary install
--- /dev/null
+package require Tcl 8.0 ;# we need binary command
+namespace eval fvwm {
+#
+# Define fvwm message types of fvwm95-2.0.43
+#
+variable msgType
+array set msgType {
+1 NewPage
+2 NewDesk
+4 AddWindow
+8 RaiseWindow
+16 LowerWindow
+32 ConfigureWindow
+64 FocusChange
+128 DestroyWindow
+256 Iconify
+512 Deiconify
+1024 WindowName
+2048 IconName
+4096 ResClass
+8192 ResName
+16384 End_WindowList
+32768 IconLocation
+65536 Map
+131072 Error
+262144 ConfigInfo
+524288 End_ConfigInfo
+1048576 IconFile
+2097152 DefaultIcon
+4194304 String
+8388608 FunctionEnd
+16777216 MiniIcon
+33554432 ScrollRegion
+67108864 VisibleName
+134217728 Unknown2
+268435456 Restack
+536870912 NewAddWindow
+1073741824 NewConfigureWindow
+}
+
+variable gravityText
+array set gravityText {
+0 ForgetGravity
+1 NorthWestGravity
+2 NorthGravity
+3 NorthEastGravity
+4 WestGravity
+5 CenterGravity
+6 EastGravity
+7 SouthWestGravity
+8 SouthGravity
+9 SouthEastGravity
+10 StaticGravity}
+variable msgCodes
+variable AllEvents 0
+foreach {code name} [array get msgType] {
+ set msgCodes($name) $code
+ set AllEvents [expr $AllEvents|$code]
+}
+set msgCodes(DeadPipe) 0
+variable WindowListMask [expr $msgCodes(End_WindowList)|\
+ $msgCodes(NewDesk)|$msgCodes(NewPage)| $msgCodes(FocusChange)|\
+ $msgCodes(DefaultIcon)|$msgCodes(ConfigureWindow)|\
+ $msgCodes(WindowName)|$msgCodes(IconName)| $msgCodes(ResName)|\
+ $msgCodes(ResClass)|$msgCodes(IconFile)|$msgCodes(MiniIcon)]
+variable MessagesWithString [expr $msgCodes(WindowName)|$msgCodes(IconName)|\
+ $msgCodes(ResClass)|$msgCodes(ResName)|$msgCodes(Error)|\
+ $msgCodes(ConfigInfo)|$msgCodes(String)|$msgCodes(DefaultIcon)|\
+ $msgCodes(IconFile)|$msgCodes(MiniIcon)|$msgCodes(VisibleName)]
+#
+# Find out how to format binary integers
+# Note, on 64-bit platform there should be 64bit integer
+variable intSize 4
+variable intFormat
+if {$::tcl_platform(byteOrder)=="littleEndian"} {
+ set intFormat "i"
+} else {
+ set intFormat "I"
+}
+if {$::argc<5||![regexp {[0-9]+} [lindex $::argv 0]]||
+ ![regexp {[0-9]+} [lindex $::argv 1]]||
+ ! [regexp {[0-9]+} [lindex $::argv 3]]||
+ ![regexp {[0-9]+} [lindex $::argv 4]]} {
+ error "Should be started as fvwm module" {FVWM 0 "Invalid invocation"}
+}
+if {[catch {package require Tclx}]} {
+ if {[string equal $tcl_platform(os) Linux]} {
+ variable outfd [open /dev/fd/[lindex $::argv 0] w]
+ variable infd [open /dev/fd/[lindex $::argv 1] r]
+ } else {
+ error "Tclx is required for all systems except Linux"
+ }
+} else {
+ variable outfd [dup [lindex $::argv 0]]
+ variable infd [dup [lindex $::argv 1]]
+}
+if {[info tclversion]>=8.1} {
+fconfigure $outfd -buffering none -translation binary -encoding binary
+fconfigure $infd -buffering none -blocking yes -translation binary -encoding binary
+proc get_eventString {infd stringLen} {
+ return [encoding convertfrom [lindex [split [read $infd $stringLen] "\0"] 0]]
+}
+} else {
+fconfigure $outfd -buffering none -translation binary
+fconfigure $infd -buffering none -blocking yes -translation binary
+ proc get_eventString {infd stringLen} {
+ return [lindex [split [read $infd $stringLen] "\0"] 0]
+ }
+}
+variable configFile [lindex $::argv 2]
+variable WindowId [lindex $::argv 3]
+variable Context
+variable Mask $AllEvents
+switch [lindex $::argv 4] {
+0 {set Context NO_CONTEXT}
+1 {set Context WINDOW}
+2 {set Context TITLE}
+4 {set Context ICON}
+8 {set Context ROOT}
+16 {set Context FRAME}
+32 {set Context SIDEBAR}
+64 {set Context LEFT1}
+128 {set Context LEFT2}
+256 {set Context LEFT3}
+512 {set Context LEFT4}
+1024 {set Context LEFT5}
+2048 {set Context RIGHT1}
+4096 {set Context RIGHT2}
+8192 {set Context RIGHT3}
+16384 {set Context RIGHT4}
+32768 {set Context RIGHT5}
+default {set Context Unknown}
+}
+incr ::argc -5
+set ::argv {lrange 5 end $::argv}
+variable handlers
+array set handlers {
+Error Error
+DeadPipe ::fvwm::myExit
+}
+
+proc myExit {args} {
+ exit 1
+}
+#
+# Send message to fvwm
+#
+proc send {message {window 0}} {
+ variable outfd
+ variable intFormat
+ puts -nonewline $outfd [binary format ${intFormat}2 \
+ [list $window [string length $message]]]
+ puts -nonewline $outfd $message
+ puts -nonewline $outfd [binary format $intFormat 1]
+}
+#
+# Used for special event handling during list asquition
+#
+variable internalHandler ""
+variable listToFill
+#
+# Indicates that list is done
+#
+#
+variable listDone 0
+# Fileevent handler for fvwm input pipe
+#
+proc getMessage {} {
+ variable infd
+ variable handlers
+ variable internalHandler
+ if [eof $infd] {
+ set type "DeadPipe"
+ set event {}
+ } else {
+ set event [ReadMessage]
+ set type [lindex $event 0]
+ }
+ #
+ # Process getting list specially
+ #
+ if [string length $internalHandler] {
+ eval $internalHandler $event
+ return
+ }
+ if [info exist handlers($type)] {
+ namespace eval :: "$handlers($type) $event"
+ }
+}
+#
+# Parses fvwm message and converts it to list
+#
+proc ReadMessage {} {
+ variable infd
+ variable msgType
+ variable intFormat
+ variable intSize
+ variable MessagesWithString
+ variable internalHandler
+ binary scan [read $infd $intSize] $intFormat sign
+ binary scan [read $infd $intSize] $intFormat type
+ binary scan [read $infd $intSize] $intFormat len
+ binary scan [read $infd $intSize] $intFormat timestamp
+ if {[eof $infd] && ![ info exist type]} {
+ return "DeadPipe"
+ }
+ set stringLen 0
+ if {![info exist msgType($type)]} {
+ after idle {error "Unknown message type [format %x $type]"\
+ [list FVWM 1 $type "Unknown message"]
+ }
+ }
+ set event $msgType($type)
+ if {($type & $MessagesWithString) !=0} {
+ set stringLen [expr ($len-7)*$intSize]
+ set len 7
+ }
+ for {set i 4} {$i<$len} {incr i} {
+ binary scan [read $infd 4] $intFormat value
+ lappend event $value
+ }
+ if {$stringLen} {
+lappend event [get_eventString $infd $stringLen]
+
+ }
+ return $event
+}
+#
+#
+# setMask - set event mask for fvwm
+#
+proc setMask list {
+ variable msgCodes
+ variable Mask
+ if {[llength $list]==1&&![catch {expr $list+1}]} {
+ #mask is numeric. Suppose user knows what he does
+ send "Set_Mask $list"
+ set Mask $list
+ return
+ }
+ set value 0
+ foreach type $list {
+ if {![info exist msgCodes($type)]} {
+ return -code error -errorcode [list FVWM 3 $type "Invalid event"]\
+ "Invalid event name $type"
+ }
+ set value [expr {$value|$msgCodes($type)}]
+ }
+ send "Set_Mask $value"
+ set Mask $value
+}
+#
+# Binds handler to specific event
+#
+proc bind {args} {
+ variable msgCodes
+ variable handlers
+ if ![llength $args] {
+ return [array names handlers]
+ }
+ set type [lindex $args 0]
+ if ![info exist msgCodes($type)] {
+ return -code error -errorcode [list FVWM 3 $type "Invalid event"]\
+ "Invalid event name $type"
+ }
+ if [llength $args]==1 {
+ if [info exist handlers($type)] {
+ return $handlers($type)
+ } else {
+ return
+ }
+ }
+ if {![llength $args]>2} {
+ return -code error -errorcode NONE "Wrong # args should be \
+ ::fvwm::bind event script"
+ }
+ set handlers($type) [lindex $args 1]
+ return
+}
+
+
+
+#
+# configHandler - internal procedure which handles config
+# messages
+#
+proc configHandler {type args} {
+ variable configPattern
+ variable listToFill
+ variable internalHandler
+ if {$type=="End_ConfigInfo"} {
+ uplevel \#0 set ::fvwm::listDone 1
+ } elseif {$type=="ConfigInfo"} {
+ regsub "\[\t\n\r \]*$" [lindex $args 3] "" line
+ if {[regexp "\\*(\[a-zA-Z0-9_-\]+)\[ \t\]*(.*)\$" $line junk name value]} {
+ if [string match $configPattern $name] {
+ lappend listToFill($name) $value
+ }
+ } elseif {[regexp "(\[a-zA-Z0-9_-\]+)\[ \t\]*(.*)\$" $line junk\
+ name value]} {
+ if [string match *Path $name] {
+ eval lappend listToFill($name) [split $value ":"]
+ } else {
+ lappend listToFill($name) $value
+ }
+ }
+ }
+}
+#
+# getConfig - requests from fvwm configuration info and fills given
+# array
+#
+proc getConfig {array {pattern *}} {
+ variable listToFill
+ variable configPattern
+ variable Mask
+ variable msgCodes
+ variable internalHandler
+ variable IconPath
+ variable PixmapPath
+ upvar $array res
+ set myMask [expr $msgCodes(ConfigInfo)|$msgCodes(End_ConfigInfo)]
+ if {($Mask&$myMask)!=$myMask} {
+ send "Set_Mask $myMask"
+ }
+ set configPattern $pattern
+ set internalHandler configHandler
+ send "Send_ConfigInfo"
+ vwait ::fvwm::listDone
+ set internalHandler ""
+ if [info exists listToFill(PixmapPath)] {
+ set PixmapPath $listToFill(PixmapPath)
+ } else {
+ set PixmapPath ""
+ }
+ if [info exists listToFill(IconPath)] {
+ set IconPath $listToFill(IconPath)
+ } else {
+ set IconPath ""
+ }
+ uplevel array set $array [list [array get listToFill]]
+ #unset listToFill
+ if {($Mask&$myMask)!=$myMask} {
+ send "Set_Mask $Mask"
+ }
+}
+#
+# winListHandler - handles various events which fvwm sends in response
+# to Send_WindowList
+#
+proc winListHandler {type args} {
+ variable listToFill
+ variable listDone
+ variable gravityText
+ switch $type {
+ End_WindowList {uplevel #0 set ::fvwm::listDone 1}
+ NewDesk {set listToFill(Desk) [lindex $args 0]}
+ NewPage {
+ set listToFill(Page) [concat [lrange $args 0 1] [lrange $args 2 3]]
+ }
+ FocusChange {
+ set listToFill(Focus) [lindex $args 0]
+ # Don't know how to convert fvwm color info to something
+ # useful
+ # set listToFill(FocusColors) [list\
+ # [format "#%06x" [lindex $args 1]]\
+ # [format "#%06x" [lindex $args 2]]]
+ }
+ DefaultIcon {set listToFill(DefaultIcon) [lindex $args 3]}
+ ConfigureWindow {
+ set windowId [lindex $args 0]
+ set listToFill($windowId,frame) [concat [lindex $args 1]\
+ [lrange $args 3 6] [lrange $args 9 10]]
+ set listToFill($windowId,desk) [lindex $args 7]
+ set listToFill($windowId,flags) [lindex $args 8]
+ set listToFill($windowId,base) [lrange $args 11 12]
+ set listToFill($windowId,grid) [lrange $args 13 14]
+ set listToFill($windowId,minSize) [lrange $args 15 16]
+ set listToFill($windowId,maxSize) [lrange $args 17 18]
+ set listToFill($windowId,iconIds) [lrange $args 19 20]
+ set listToFill($windowId,gravity) $gravityText([lindex $args 22])
+ # set listToFill($windowId,colors) [list\
+ # [format "#%06x" [lindex $args 22]]\
+ # [format "#%06x" [lindex $args 23]]]
+ }
+ NewConfigureWindow {
+ set windowId [lindex $args 0]
+ set listToFill($windowId,frame) [concat [lindex $args 1]\
+ [lrange $args 3 6] [lrange $args 9 10]]
+ set listToFill($windowId,desk) [lindex $args 7]
+ set listToFill($windowId,flags) [lindex $args 26]
+ set listToFill($windowId,base) [lrange $args 10 11]
+ set listToFill($windowId,grid) [lrange $args 12 13]
+ set listToFill($windowId,minSize) [lrange $args 14 15]
+ set listToFill($windowId,maxSize) [lrange $args 16 17]
+ set listToFill($windowId,iconIds) [lrange $args 18 19]
+# set fd [open $::env(HOME)/tflog a]
+# puts $fd [array get listToFill $windowId,*]
+# close $fd
+ set listToFill($windowId,gravity) $gravityText([lindex $args 22])
+ # set listToFill($windowId,colors) [list\
+ # [format "#%06x" [lindex $args 22]]\
+ # [format "#%06x" [lindex $args 23]]]
+ }
+ WindowName {set listToFill([lindex $args 0],title) [lindex $args 3]}
+ IconName {set listToFill([lindex $args 0],iconName) [lindex $args 3]}
+ ResName {set listToFill([lindex $args 0],resource) [lindex $args 3]}
+ ResClass {set listToFill([lindex $args 0],class) [lindex $args 3]}
+ IconFile {set listToFill([lindex $args 0],icon) [lindex $args 3]}
+ MiniIcon {set listToFill([lindex $args 0],miniIcon) [lindex $args 3]}
+ Iconify {set listToFill([lindex $args 0],iconic) 1}
+ }
+ }
+ #
+ # getWindowList - fills given array with info of current desktop
+ #
+ proc getWindowList {array {pattern *}} {
+ variable listToFill
+ variable listDone
+ variable Mask
+ variable msgCodes
+ variable WindowListMask
+ variable internalHandler
+ set listDone 0
+
+ if {($Mask&$WindowListMask)!=$WindowListMask} {
+ send "Set_Mask $WindowListMask"
+ }
+ catch {unset listToFill}
+ set internalHandler winListHandler
+ send "Send_WindowList"
+ vwait ::fvwm::listDone
+ set internalHandler ""
+ uplevel array set $array [list [array get listToFill]]
+ unset listToFill
+ if {($Mask&$WindowListMask)!=$WindowListMask} {
+ send "Set_Mask $WindowListMask"
+ }
+}
+#
+# searches icon through fvwm PixmapPath or IconPath
+#
+proc iconPath {name {where -pixmap}} {
+ variable PixmapPath
+ variable IconPath
+ if {![info exist PixmapPath]&&![info exist IconPath]} {
+ getConfig
+ }
+ if {$where=="-pixmap"} {
+ set path $PixmapPath
+ } elseif {$where=="-icon"} {
+ set path $IconPath
+ } else {
+ return -code error "Invalid option. Should be -pixmap or -icon"
+ }
+
+ foreach dir $path {
+ if {[lsearch -exact [glob -nocomplain [file join $dir *]]\
+ [file join $dir $name]]!=-1} {
+ return [file join $dir $name]
+ }
+ }
+ return
+}
+
+
+
+fileevent $infd readable [namespace code getMessage]
+}
+# Default handler for fvwm error message. Raises Tcl asynchroneus error
+# after idle to avoid closing pipe. Defined in the global namespace
+#
+
+if {[llength [info command Error]]==0} {
+proc Error {msgtype zero0 zero1 zero2 msg} {
+ after idle "error [list $msg] \{[list FVWM 2 $msg]\}"
+}
+}
+package provide Fvwm 1.3
--- /dev/null
+# Tcl package index file, version 1.0
+# This file is generated by the "pkg_mkIndex" command
+# and sourced either when an application starts up or
+# by a "package unknown" script. It invokes the
+# "package ifneeded" command to set up package-related
+# information so that packages will be loaded automatically
+# in response to "package require" commands. When this
+# script is sourced, the variable $dir must contain the
+# full path name of this file's directory.
+
+package ifneeded Fvwm 1.0 "source $dir/fvwm.tcl"
--- /dev/null
+#!/usr/bin/wish
+package require Fvwm
+wm withdraw .
+if {[tk_dialog .t "Confirmation" "This will end your session.
+Please, Confirme" warning -1 " Yes, log me out " " No, I continue "]==0} {
+ ::fvwm::send Quit
+}
+
+exit 0
projects / oss / fvwm-tcl.git / commitdiff