From: Victor Wagner Date: Fri, 24 Feb 2006 18:40:33 +0000 (+0000) Subject: reimport X-Git-Url: http://wagner.pp.ru/gitweb/?a=commitdiff_plain;h=5f464388004a348c0f8788833b2cfd6634100688;p=oss%2Ffvwm-tcl.git reimport --- 5f464388004a348c0f8788833b2cfd6634100688 diff --git a/Fvwm.3tcl b/Fvwm.3tcl new file mode 100644 index 0000000..2d7fd14 --- /dev/null +++ b/Fvwm.3tcl @@ -0,0 +1,250 @@ +.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 + + + + diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..c2ccd1f --- /dev/null +++ b/Makefile @@ -0,0 +1,6 @@ +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: diff --git a/debian/README.Debian b/debian/README.Debian new file mode 100644 index 0000000..b2f189f --- /dev/null +++ b/debian/README.Debian @@ -0,0 +1,19 @@ +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 , Sun, 1 Oct 2000 12:27:39 +0400 diff --git a/debian/changelog b/debian/changelog new file mode 100644 index 0000000..186af83 --- /dev/null +++ b/debian/changelog @@ -0,0 +1,43 @@ +libfvwm-tcl (1.3-2) unstable; urgency=low + + * ÷ÓÔÁ×ÌÅÎÁ ÂÏÒØÂÁ Ó ÐÏÐÏÌÚÛÉÍ ÈÅÄÅÒÏÍ × ÎÅÄÒÁÈ fvwm É ÐÅÒÅÔÒÑÈÎÕÔÙ ÓÌÅÇËÁ + ÚÁ×ÉÓÉÍÏÓÔÉ + + -- Artem Chuprina Sat, 26 Mar 2005 00:42:50 +0300 + +libfvwm-tcl (1.3-1) unstable; urgency=low + + * ðÏÐÒÁ×ÌÅÎÁ ÒÁÂÏÔÁ ÓÏ ÓÐÉÓËÏÍ ÏËÏÎ + + -- Victor B. Wagner 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 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 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 Tue, 28 Nov 2000 00:28:46 +0300 + +libfvwm-tcl (1.0-1) unstable; urgency=low + + * Initial Release. + + -- Victor B. Wagner Sun, 1 Oct 2000 12:27:39 +0400 + +Local variables: +mode: debian-changelog +End: diff --git a/debian/control b/debian/control new file mode 100644 index 0000000..300084f --- /dev/null +++ b/debian/control @@ -0,0 +1,23 @@ +Source: libfvwm-tcl +Section: unknown +Priority: optional +Maintainer: Victor B. Wagner +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. diff --git a/debian/copyright b/debian/copyright new file mode 100644 index 0000000..aeea40d --- /dev/null +++ b/debian/copyright @@ -0,0 +1,11 @@ +This package was debianized by Victor B. Wagner 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 + +Copyright: + +BSD style license, like Tcl itself. diff --git a/debian/dirs b/debian/dirs new file mode 100644 index 0000000..ca882bb --- /dev/null +++ b/debian/dirs @@ -0,0 +1,2 @@ +usr/bin +usr/sbin diff --git a/debian/docs b/debian/docs new file mode 100644 index 0000000..eafd677 --- /dev/null +++ b/debian/docs @@ -0,0 +1 @@ +quit.tcl diff --git a/debian/rules b/debian/rules new file mode 100755 index 0000000..224d69e --- /dev/null +++ b/debian/rules @@ -0,0 +1,77 @@ +#!/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 diff --git a/fvwm.tcl b/fvwm.tcl new file mode 100644 index 0000000..7c262ee --- /dev/null +++ b/fvwm.tcl @@ -0,0 +1,479 @@ +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 diff --git a/pkgIndex.tcl b/pkgIndex.tcl new file mode 100644 index 0000000..ae8a38a --- /dev/null +++ b/pkgIndex.tcl @@ -0,0 +1,11 @@ +# 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" diff --git a/quit.tcl b/quit.tcl new file mode 100755 index 0000000..469a535 --- /dev/null +++ b/quit.tcl @@ -0,0 +1,9 @@ +#!/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