midfavila
/
Generic_Window_Manager
1
0
Fork 0
Code Issues 4 Pull Requests Projects Releases Wiki Activity

Initial commit. Removed spyware routines.

This commit is contained in:
Mid Favila 2021-11-07 23:31:59 -03:00
parent 966701e70f
commit bdc3ad778d
372 changed files with 133548 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2018
CHANGES Normal file
View File

File diff suppressed because it is too large Load Diff

102
CONTENTS Normal file
View File

@ -0,0 +1,102 @@
Contents of the files of the GWM distribution
Contents of the files FILES:
FILES: all sources
FILES_KIT: doc + data (distributed)
FILES_BAK: other files saved on daily backup
FILES_AUX: other files (big) to be preserved when cleaning dir
So, the differents sets of files are determined by: (distrib is KIT)
ALL SHAR KIT(with src) KIT(binary)
FILES FILES FILES gwm
FILES_KIT FILES_KIT FILES_KIT FILES_KIT
FILES_BAK
FILES_AUX
Contents of the files:
wool.h
wool.c
main body of the WOOL interpreter, macros to allow our object-oriented
C programming, definition of "pure lisp" objects
wool.lex
wool.yac
WOOL parser
malloc.c
Fast malloc/free with extensive debugging facilities
reference.c
memory management module via reference count
wool-gwm.c
WOOL-GWM interface. Here are defined extensions in C to build new WOOL
functions to handle GWM primitives.
Look at this file to know how to code new WOOL primitives
wob.h
wob.c
generic wob routines
plug.c
bar.c
menu.c
client.c
screen.c
specific routines to each wob type
Makefile
Make.TEMPLATE
installation/revision management routines
wops.c
Window OPerationS (non interactive)
user.c
Interactive operations (rubberbanding)
wl_*.h
wl_*.c
Definition and implementation module for each of the WOOL types
gwm.h
global GWM variables
gwm.c
main body of GWM
machine.h
machine.c
portability patches
error.c
X error handlers
icccm.c
routines to implement ICCCM conventions
EXTERN.h
INTERN.h
package to simulate the IMPORT/EXPORT of modula II
COPYRIGHT
the full copyright text
doc/
The LaTeX documentation
shar/unshar
(same file) Shell-archive maker/extracter, WITHOUT checksums, to be
used with RCS to manage revisions on only ONE file, the full
distribution
gwm-parsers/
lex.yy.c and y.tab.c for systems which can not produce these.
gwm/
directories for WOOL programs and X11 bitmaps

41
COPYRIGHT Normal file
View File

@ -0,0 +1,41 @@
/*
* GWM - Generic Window Manager - Copyright (C) 1989-94 GROUPE BULL
* Copyright (C) 2021 Mid Favila
*
* Permission is hereby granted, free of charge, to any person obtaining a
* copy of this software and associated documentation files
* (the "Software"), to deal in the Software without restriction, including
* without limitation the rights to use, copy, modify, merge, publish,
* distribute, sublicense, and/or sell copies of the Software, and to permit
* persons to whom the Software is furnished to do so, subject to the
* following conditions:
* The above copyright notice and this permission notice shall be included
* in all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
* OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
* IN NO EVENT SHALL GROUPE BULL BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
* DEALINGS IN THE SOFTWARE.
*
* Except as contained in this notice, the names of GROUPE BULL and Mid
* Favila shall not be used in advertising or otherwise to promote the
* sale, use or other dealings in this Software without prior written
* authorization from the respective party.
*/
Colas NAHABOO BULL Research FRANCE -- Koala Project
(GWM X11 Window Manager)
Internet: colas@sophia.inria.fr
Surface Mail: Colas NAHABOO, INRIA - Sophia Antipolis,
BP 93,
06902 Sophia Antipolis Cedex
FRANCE
Voice phone: (33) 93.65.77.70, Fax: (33) 93 65 77 65
Mid Favila Super Dimensional Fortress -- GWM Restoration Crew
(GWM X11 Window Manager)
Internet: midfavila@sdf.org

23
EXTERN.h Normal file
View File

@ -0,0 +1,23 @@
/* Copyright 1989 GROUPE BULL -- See license conditions in file COPYRIGHT
* Copyright 1989 Massachusetts Institute of Technology
*/
/****************************************************\
* *
* package to help maintaining one .h file per type *
* EXTERN means "import" for all following includes *
* *
\****************************************************/
#ifdef EXT
#undef EXT
#endif
#define EXT extern
#ifdef INIT
#undef INIT
#endif
#define INIT(x)
#ifdef DO_INIT
#undef DO_INIT
#endif

79
FILES Normal file
View File

@ -0,0 +1,79 @@
revision.c
FILES
FILES_KIT
README
INSTALL
COPYRIGHT
CONTENTS
PROBLEMS
Imakefile
Makefile
gwm_util
bar.c
gwm.c
gwm.h
client.c
def_bitmap.h
error.c
icccm.c
menu.c
plug.c
screen.c
user.c
wob.c
wob.h
wool-gwm.c
wops.c
EXTERN.h
INTERN.h
machine.c
machine.h
malloc.c
reference.c
wl_active.c
wl_active.h
wl_atom.c
wl_atom.h
wl_bar.c
wl_bar.h
wl_pixmap.c
wl_pixmap.h
wl_client.c
wl_client.h
wl_coll.c
wl_coll.h
wl_cursor.c
wl_cursor.h
wl_event.c
wl_event.h
wl_fsm.c
wl_fsm.h
wl_func.c
wl_func.h
wl_label.c
wl_label.h
wl_list.c
wl_list.h
wl_menu.c
wl_menu.h
wl_name.c
wl_name.h
wl_number.c
wl_number.h
wl_plug.c
wl_plug.h
wl_pointer.c
wl_pointer.h
wl_string.c
wl_string.h
wool.c
wool.h
wool.lex
wool.flex
wool.yac
yacc.h
main.c
gwm-parsers
gwm-parsers/README
gwm-parsers/lex.yy.c
gwm-parsers/y.tab.c

278
FILES_KIT Normal file
View File

@ -0,0 +1,278 @@
unshar
.dbxinit
.gdbinit
Make.TEMPLATE
Make
gwm.man
contrib
contrib/gwmsh
contrib/gwmsh/gwmsh.c
contrib/gwmsh/version.c
contrib/gwmsh/Makefile
contrib/gwmsh/rcshead
contrib/gwmsh/ChangeLog
contrib/gwmsh/PATCH-GWM
contrib/gwmsh/README
contrib/gwmsend
contrib/gwmsend/gwmsend.c
contrib/gwmchat
contrib/gwmchat/gwmchat.c
contrib/gwmchat/gwmchat.readme
contrib/widgets
contrib/widgets/widgets.el
contrib/rxterm
contrib/rxterm/rx-sh
contrib/rxterm/rxterm.script
contrib/emacs-mode
contrib/emacs-mode/emacs-mode.readme
contrib/gwm-buffer
contrib/gwm-buffer/gwm-buffer.el
contrib/lisp-modes
contrib/lisp-modes/amc-lisp.el
contrib/lisp-modes/gwm-lisp.el
contrib/command_menus
contrib/command_menus/README
contrib/scripts
contrib/scripts/find-bar-nils
contrib/scripts/find-bar-nils.README
doc
doc/Makefile
doc/KNOWN_BUGS
doc/BUG_REPORT
doc/TO_BE_DONE
CHANGES
doc/gwm.ps
doc/gwm.tex
doc/colas.sty
doc/idraw.pro
doc/title.tex
doc/usage.tex
doc/overview.tex
doc/wool_ref.tex
doc/contents.tex
doc/quick_ref.tex
doc/index.tex
doc/standard.tex
doc/window.id
doc/icons.id
doc/term-icons.id
doc/frame-win.id
doc/simple-ed-win.id
doc/simple-win.id
doc/places1.id
doc/places2.id
doc/gravity.id
doc/PostBig.id
doc/mwm-wins.sid
doc/twm-wins.sid
doc/KoalaLogo.id
data
data/Imakefile
data/ImakeB
data/ImakeE
data/Makefile
data/.gwmrc.gwm
data/.profile.gwm
data/trace-func.gwm
data/icon-groups.gwm
data/icon-groups-old.gwm
data/std-popups.gwm
data/def-menus.gwm
data/emacs-mouse.gwm
data/dlists.gwm
data/placements.gwm
data/simple-ed-win.gwm
data/simple-win.gwm
data/no-decoration.gwm
data/simple-icon.gwm
data/term-icon.gwm
data/compat.gwm
data/gwm.ml
data/arrow-f.xbm
data/arrow-m.xbm
data/arrowhole-f.xbm
data/arrowhole-m.xbm
data/arrow3d-f.xbm
data/arrow3d-m.xbm
data/back.xbm
data/grainy.xbm
data/bull_1.xbm
data/bull_2.xbm
data/icon20.xbm
data/xterm-b.xbm
data/xterm-bl.xbm
data/xterm-br.xbm
data/xterm-l.xbm
data/xterm-r.xbm
data/xterm-t.xbm
data/xterm-tl.xbm
data/xterm-tr.xbm
data/frame-win.gwm
data/frame3d-b.xpm
data/frame3d-bl.xpm
data/frame3d-br.xpm
data/frame3d-l.xpm
data/frame3d-r.xpm
data/frame3d-t.xpm
data/frame3d-tl.xpm
data/frame3d-tr.xpm
data/frame2d-b.xbm
data/frame2d-bl.xbm
data/frame2d-br.xbm
data/frame2d-l.xbm
data/frame2d-r.xbm
data/frame2d-t.xbm
data/frame2d-tl.xbm
data/frame2d-tr.xbm
data/utils.gwm
data/cursor-names.gwm
data/mwm.gwm
data/mwmprofile.gwm
data/mwmrc.gwm
data/mwm-menusrc.gwm
data/mwm-bindings.gwm
data/mwm-buttons.gwm
data/mwm-functions.gwm
data/mwm-icon.gwm
data/mwm-menus.gwm
data/mwm-placements.gwm
data/mwm-utils.gwm
data/mwm-win.gwm
data/mwm-zoom-win.gwm
data/X.xbm
data/cornerPlug.xbm
data/mwm-iclb.xbm
data/mwm-iclt.xbm
data/mwm-icrb.xbm
data/mwm-icrt.xbm
data/mwm-ictlb.xbm
data/mwm-ictlt.xbm
data/mwm-ictb.xbm
data/mwm-ictt.xbm
data/mwm-ictrb.xbm
data/mwm-ictrt.xbm
data/mwm-emulation.txt
data/mwm-internal.gwmMwmrc
data/mwm-typical.gwmMwmrc
data/xterm.xbm
data/itemSep.xbm
data/mini.xbm
data/right-arrow.xbm
data/dvrooms.gwm
data/README.twm
data/hilite.xbm
data/iconify.xbm
data/resize.xbm
data/twm-icon-mgr.gwm
data/twm-menus.gwm
data/twm-popups.gwm
data/twm-titled-win.gwm
data/twm.gwm
data/twmrc.gwm
data/move-opaque.gwm
data/deltabutton.gwm
data/float.gwm
data/unconf-move.gwm
data/suntools-keys.gwm
data/vb-term.gwm
data/vb-bar.gwm
data/vb-button.gwm
data/iconify-vb.xbm
data/kill.xbm
data/raise.xbm
data/lower.xbm
data/barA2.l.xpm
data/barA2..xpm
data/barA2.r.xpm
data/xload.xbm
data/xenon.xpm
data/plaid.xpm
data/vscreen.gwm
data/mon-keys.gwm
data/simple-icon-old.gwm
data/simple-win-old.gwm
data/epoch.gwm
data/near-mouse.gwm
data/profile-colas.gwm
data/en-recover.gwm
data/framemaker.gwm
data/fast.gwm
data/my-menus.gwm
data/drop-menus.doc
data/drop-menus.gwm
data/style.gwm
data/widgets.gwm
data/em-drop-menus.gwm
data/em-widgets.gwm
data/em-example.gwm
data/wbrooms.gwm
data/xpm-icon.gwm
data/Xmh-icon.48.xpm
data/Xmh-icon.78.xpm
data/term-icon-xpm.gwm
data/xterm2-n.xpm
data/xterm2-s.xpm
data/xterm2-nw.xpm
data/xterm2-ne.xpm
data/xterm2-w.xpm
data/xterm2-e.xpm
data/xterm2-sw.xpm
data/xterm2-se.xpm
data/xterm3-e.xpm
data/xterm3-n.xpm
data/xterm3-ne.xpm
data/xterm3-nw.xpm
data/xterm3-s.xpm
data/xterm3-se.xpm
data/xterm3-sw.xpm
data/xterm3-w.xpm
data/hilite2.xbm
data/iconify2.xbm
data/load-icon-mgr.gwm
data/load-virtual.gwm
data/pick.gwm
data/resize2.xbm
data/std-func.gwm
data/virtual.gwm
data/vtwm-icon-mgr.gwm
data/vtwm-menu.gwm
data/vtwm-window.gwm
data/vtwm.gwm
data/vtwmrc.gwm
data/menu.xbm
data/virtual-door.gwm
data/virtual-pan.gwm
data/virtual-action.gwm
data/vtwm-zoom.gwm
data/zoom.xbm
data/README.icon-mgr
data/README.virtual
data/string.gwm
data/bind-key.gwm
data/gray.xbm
data/stripes.xbm
data/vtwm-squeezed-window.gwm
data/vtwm-squeezed-window2.gwm
data/README-vtwmrc-0.3-1.0
data/README-vtwmrc-0.2-1.0
data/xterm.xpm
data/pixmap.xpm
data/LRom1.xpm
data/datebook.xpm
data/mosaic.xpm
data/cdrom1.xpm
data/netscape-small.xpm
data/clipboard.xpm
data/App_write.xpm
data/std-virtual.gwm
data/xpostit-icon.xpm
data/xcol-icon.xpm
data/xrn-nonews.xpm
data/xrn-busy.xpm
data/xrn.xpm
data/Xrn-icon.xpm
data/close-18.xbm
data/Zircon-icon.yes
data/Zircon-icon.no
data/wallpaper.gwm
data/timeout-win.gwm

314
INSTALL Normal file
View File

@ -0,0 +1,314 @@
______ ____ __
/ ___\ \ / / \/ |
| | _ \ \ /\ / /| |\/| |
| |_| | \ V V / | | | |
\____| \_/\_/ |_| |_|
___ _ _ _ _ _ ____ _ _
|_ _|_ __ ___| |_ __ _| | | __ _| |_(_) ___ _ __ / ___|_ _(_) __| | ___
| || '_ \/ __| __/ _` | | |/ _` | __| |/ _ \| '_ \ | | _| | | | |/ _` |/ _ \
| || | | \__ \ || (_| | | | (_| | |_| | (_) | | | | | |_| | |_| | | (_| | __/
|___|_| |_|___/\__\__,_|_|_|\__,_|\__|_|\___/|_| |_| \____|\__,_|_|\__,_|\___|
==============================================================================
WHAT IS GWM?
============
The GWM (Generic Window Manager) is an extensible Window Manager for
the X Window System Version 11. It is based upon a WOOL (Window Object
Oriented Langage) kernel, which is an interpreted dialect of Lisp with
specific window management primitives. The user builds a window
manager by writing WOOL files to describe objects on the screen,
including a Finite State Machine triggering WOOL actions on response
to X events (e.g. mouse buttons) on that object. These objects can be
used as decorations around X applications windows, as pop-up menus or
as independent windows.
GWM should be able to emulate efficiently other window managers, and play
the same role for window managers as EMACS does for text editors.
WHERE IS GWM?
=============
All new "official" gwm releases can be found by ftp on:
Europe: koala.inria.fr:/pub/gwm/
USA: ftp.x.org:/contrib/window_managers/
and all the ftp.x.org mirrors (find them by a "archie GettingR6")
There is a web page: http://www.inria.fr/koala/gwm
UNPACKING a new distribution:
=============================
Unpack the distrib in a GWMDIR directory created for the compilation process
The installation of gwm will look like:
GWMDIR
|
gwm ---shadows----- sun4 -- linux -- dec ...
| (symb. links)
C source files +----+----+
| | |
doc Make data
The files will be then compiled in brother directories of "gwm" (sons of
GWMDIR) in a stand-alone installation (using the Makefile.noXtree makefile), or
directly in the "gwm" directory itself in case of an installation by imake.
The Make directory will contain all your configuration options, that you will
be able to re-use between different gwm releases.
INSTALLATION:
=============
************************************ WARNING *********************************
GWM sends me an udp packet with just the value of "gethostname" for
my private statistics on startup. You can disable this feature by (re)compiling
with -DNO_GWM_LOG or -DNO_KOALA_SPY, or you can also set the shell
environments NO_GWM_LOG or NO_KOALA_SPY to disable this feature without
recompilation.
******************************************************************************
Files of interest:
INSTALL Documentation on the compilation flags for many architectures
PROBLEMS Answer to common compilation problems
doc/KNOWN_BUGS known bugs for this version
doc/TO_BE_DONE lists the planned enhancements
CHANGES summary of the user-visible changes
revision.c the detailled internal change log
NOTE: some contributed software that can/must be installed by hand are in the
contrib/ directory, including emacs modes, and way to interact with gwm from
emacs or the shell. among them are:
rxterm/ scripts to remote launch X commands on other machines
command_menus/ some menus to launch unix commands
emacs-mode/ emacs mode to run intarctively wool code on a live gwm
gwm-buffer/ same for epoch
gwmchat/ C program for typing commands to gwm (obsolete?)
gwmsend/ C prog to send commands to gwm
gwmsh/ C prog to to run intarctively wool code on a live gwm
lisp-modes/ emacs lisp modes to edit wool code
widgets/ package to add GWM scrollbars and menus to epoch
The "data/" directory contains bitmaps, and wool (gwm built-in lisp) profiles.
installing gwm is putting the executable "gwm" somewhere in your path, and
copying somewhere the data/ contents (without forgetting the 2 files beginning
by .) and make GWMPATH point on it, if not defined already at compile time.
Contrib/rxterm contains the "rxterm" shell script used to spawn remote xterms. If
you do not have such a script already installed, you should install this script
and also make "rx" and "rxload" commands as links to it. (it is NOT installed
automatically to preserve existing ones)
____ _ _ _ _
/ ___|___ _ __ ___ _ __ (_) | __ _| |_(_) ___ _ __
| | / _ \| '_ ` _ \| '_ \| | |/ _` | __| |/ _ \| '_ \
| |__| (_) | | | | | | |_) | | | (_| | |_| | (_) | | | |
\____\___/|_| |_| |_| .__/|_|_|\__,_|\__|_|\___/|_| |_|
|_|
COMPILING:
==========
Then you can either compile gwm via "imake" or in a stand-alone way.
WITH IMAKE:
The Imakefile is provided. You should know how to use imake to build
the Gwm Makefile, by either:
ximake TOP
if your X source tree is in directory TOP, or:
xmkmf
if your X source tree has been fully installed
then do a "make Makefiles" to build all the subdirectory
Makefiles, then do a "make" which will build the "gwm" binary,
and then do a "make install" and "make install.man" which will
install the gwm binary, the data files in the "data/"
subdirectory and the manual page.
If it fails, you may edit the Imakefile to add compilation flags to
suit your machine. (see make.TEMPLATE for the description of these
flags). If you have to modify the provided Imakefile to compile on
your machine, PLEASE mail me the changes!
NOTE: the installation of the "data" subdir works only with the X11R6,
X11R5 and X11R4 users will have to replace XCOMM strings in Imakefiles
by #, with X11R3, you will have to do it by hand. (do a
"cp data/.*gwm data/* GWMDIR" where GWMDIR can be found in the
Imakefile.
WITHOUT IMAKE:
To compile or install gwm, you must, in the "gwm" directory you just
created, do a:
cp Makefile.noXtree Makefile
and for each type of machine on which you decide to install it:
decide which name you will give to this type of machine ("dpx1000",
"sun", "vax"). Suppose it is "dpx" in the following. Don't try to name
it "gwm" however!
type: "make DIR=../dpx sdir" (or make DIR=dpx dir if you don't have
symbolic links on your system)
This will build a directory "../dpx", link all source files in it,
copy the Make.TEMPLATE file to "Make.dpx" in the ../dpx
directory, and make a link to this newly created file in "Make"
subdirectory. If you want to create the target directory on another
filesystem, you can use symbolic links to do so, Just say "make
DIR=path sdir" where "path" is the complete pathname of the target
directory, for instance "/usr/maalea/local/src/GWM/dpx"
go into it ("cd ../dpx"), and edit the "Make.dpx" file to adapt it
to your local installation.
Then, type "make" and a "gwm" executable should be built.
In case of errors, a simple "make" should resume the
compilation process after the first "make" command has been issued.
If you have the message "Make: Don't know how to make .dir. Stop.",
that means that you have forgotten to do "cd ../dpx".
VERY IMPORTANT: if you encounter compilation problems, please mail me
the problems and the patches you had to apply to make it compile
on your system, so that I can include them in future releases!
If everything is OK, type "make install", it should copy the
executable and the whole ./data subdirectory. If you want to install
it by hand, just copy gwm into your path, and the whole contents of
the data directory (which can be shared between machines) into the gwm
built-in path. (the built-in path is printed by gwm by: gwm -?)
Then, you can delete the working directory. The only thing you need
to keep is the "Make" directory, which contains all the things you may
have defined or adapted for your configuration.
A link to the "Make.machine" in the "Make" subdirectory was
REPORTING BUGS:
===============
See the file doc/BUG_REPORT to mail back bugs to me. nothing formal here, just
to be sure you dont forget to send the context of the bug...
PS: I maintain a mailing list about gwm: gwm-talk@sophia.inria.fr
(all mail sent to these address will be redispatched to all members)
mail requests to be added to these lists to: gwm-talk-requests@sophia.inria.fr
or gwm@sophia.inria.fr.
New updates are announced on the comp.windows.x newsgroup, and on the
"gwm-talk" list.
If you don't have ftp, use the mail<->ftp gateways ftpmail@decwrl.dec.com or
bitftp@pucc.princeton.edu. (send a message with the word HELP in it to these
adresses).
Here is the list of the various flags you may set up for compiling GWM:
======================================================================
X version: (default is X11R6)
---------
-DX11R1 For compiling with vanilla X11R1 library
-DX11R2 For compiling with vanilla X11R2 library
-DX11R3 For compiling with vanilla X11R3 library
(for now the previous defines are equivalent)
-DX11R4 For compiling with vanilla X11R4 library
-DX11R5 For compiling with vanilla X11R5 library
-DX11R6 For compiling with vanilla X11R6 library
(for now the previous defines are equivalent)
Recommended flags: (you should leave them in DEFINES= )
-----------------
-DSECURE turns on sanity checks on many functions, should be defined.
-DUSE_STANDARD_MALLOC Otherwise my malloc is used, but on modern systems it is
not needed anymore
-DUSER_DEBUG Enable user-level debugging functions (trace)
OS variants:
-----------
Autodetected: sparc, apollo, linux
-DSYSV for System V R3 or previous systems (BSD 4.x is default)
-DSVR4 for System V R4 systems (solaris, irix). Do not define SYSV.
-DPAGE_SIZE=int for Virtual Memory page size (for SYSV only!) in
bytes. (defaults to 8192).
-DPTR_TYPE=int What is the (int, long...) type which is the same size
as any pointer on your machine? (int is default)
-DCARD32=long What is the numerical type 32 bit long? defaults to long
-DIBM_RT For compiling on an IBM PC/RT with AIX
-Dsm90 for BULL's sps7, dpx
-DNO_GETPAGESIZE if you dont have getpagesize()
-DSYSV_TIME if you cannot use BSD ftime function
-DSYSV_STRINGS if you include <string.h> instead of <strings.h>
-DSYSV_UTSNAME if you don't have gethostname()
-DSYSV_SIGNALS if you dont have wait3()
-DNO_BCOPY if you dont have bcopy and friends
-DHAS_STRCHR if strchr already exists
-DNO_MALLOC_DECLARE if your includes already declares char *malloc()
-DVOID_SIGNALS if signal handlers return a void * (default an int)
-DVOID_MALLOC if your malloc returns a void * (default a char *)
-DNO_STRUCTURE_OFFSETS if your compiler cannot compute struct offset on types,
only on instances (apollo)
Workarounds for bugs:
--------------------
-DSTUPID if your compiler chokes on complicated expressions (vax)
-DDOUBLE_ALIGN for machines where structure fields MUST be aligned
on double float boundaries! (GOULD's powernodes, solaris 2.x)
-DDO_NOT_REDEFINE_MALLOC if you are compiling with the
standard DEC WINDOWS Xlib, or some very GCC-specific systems
where malloc is built-in the compiler (some linuxes?)
Debugging-only flags:
--------------------
-DTRACE=n Enable tracing at default level n (mofifiable with -T option)
-DDEBUG Enable debugging via assertions, include routines for DBX,
Replace some macros by function calls, Synchronize X calls.
Range checks mallocs.
-DMLEAK Enable malloc's leaks tracing (very slow)
-DDO_BUS_ERROR Force a bus error on error for debugging via (yeech!) adb
-DMONITOR Include flags for profiling information (use -pg Cflags)
Exemples:
========
DEFINES= -DSECURE -DUSE_STANDARD_MALLOC -DUSER_DEBUG +these_additional_flags...
BSD machines, suns with SUNOS 4.x: none
Suns with Solaris (aka SUNOS 5.x): -DSVR4
and: LIBS = -lXext -lX11 -lsocket -lnsl
NOTE: some suns seems to require -DUSE_STANDARD_MALLOC, otherwise you get
a bus error in color-make at runtime.
vax: -DSTUPID
sm90: -DSTUPID -DSYSV
dpx: -DSYSV
Hp9000 -DSYSV +Ns2000 +Nd2000
IBM RS6000/AIX: -DSYSV -DDO_NOT_DECLARE_STRCHR -DNEED_SELECT_H
IBM/RT: -DSYSV -DIBM_RT -Nn3000
SGI Irix 5.3: -DSVR4 -DNO_STRUCTURE_OFFSETS
Unixware: -DSVR4 -DDO_NOT_REDEFINE_MALLOC
linux: no flags, should auto-compile (some linuxes need -DDO_NOT_USE_SBRK to prevent crash)
FreeBSD: no flags, should auto-compile (detects __FreeBSD__)
decstations 5100 (mips): -DSECURE -DSTATS -DUSER_DEBUG -DSIMPLE_LHS -G 0 -DVOID_MALLOC -DHAS_STRCHR -DNO_STRUCTURE_OFFSETS -I/usr/include/X11/extensions
alpha: -DLONG_ALIGN -DNO_STRUCTURE_OFFSETS

22
INTERN.h Normal file
View File

@ -0,0 +1,22 @@
/* Copyright 1989 GROUPE BULL -- See license conditions in file COPYRIGHT
* Copyright 1989 Massachusetts Institute of Technology
*/
/****************************************************\
* *
* package to help maintaining one .h file per type *
* INTERN means "export" (and allocate memory) for *
* all following includes *
* *
\****************************************************/
#ifdef EXT
#undef EXT
#endif
#define EXT
#ifdef INIT
#undef INIT
#endif
#define INIT(x) = x
#define DO_INIT

149
Imakefile Normal file
View File

@ -0,0 +1,149 @@
XCOMM
XCOMM Copyright (C) 1989-94 GROUPE BULL
XCOMM
XCOMM Permission is hereby granted, free of charge, to any person obtaining a
XCOMM copy of this software and associated documentation files
XCOMM (the "Software"), to deal in the Software without restriction, including
XCOMM without limitation the rights to use, copy, modify, merge, publish,
XCOMM distribute, sublicense, and/or sell copies of the Software, and to permit
XCOMM persons to whom the Software is furnished to do so, subject to the
XCOMM following conditions:
XCOMM The above copyright notice and this permission notice shall be included
XCOMM in all copies or substantial portions of the Software.
XCOMM
XCOMM THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
XCOMM OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
XCOMM MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
XCOMM IN NO EVENT SHALL GROUPE BULL BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
XCOMM LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
XCOMM FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
XCOMM DEALINGS IN THE SOFTWARE.
XCOMM
XCOMM Except as contained in this notice, the name of GROUPE BULL shall not be
XCOMM used in advertising or otherwise to promote the sale, use or other
XCOMM dealings in this Software without prior written authorization from
XCOMM GROUPE BULL.
XCOMM
XCOMM
XCOMM Imakefile for gwm
XCOMM Use Makefile.noXtree if you do not want to use imake
XCOMM
XCOMM Configuration parameters:
XCOMM comment out if you don't have installed libXpm.a with the rest of X
#define UseInstalledXpm Yes
XCOMM CONFIGDEFS=-Dbison
XCOMM ************* WARNING: IF YOU CHANGE THIS CHANGE ALSO IN data/Imakefile
GWMDIR = /usr/local/lib/gwm
#if defined (UseInstalledXpm)
XPMINC =
XPMLIB = -lXpm
DEPXPMLIB = $(USRLIBDIR)/libXpm.a
#else
XPMINC = -I/where_I_can_find_X11/xpm.h
XPMLIB = /whereever_I_Have_stored_it/libXpm.a
DEPXPMLIB = $(XPMLIB)
#endif
XCOMM ----- end of configuration parameters, do not edit below -----
SUBDIRS = data
#define IHaveSubdirs
#define PassCDebugFlags 'CDEBUGFLAGS=$(CDEBUGFLAGS)'
OPTIONSDEFS = -DX11R6 -DSECURE -DSTATS -DUSER_DEBUG -DNO_GWM_LOG \
-DWOOL_APP_NAME=\"GWM\" -DWOOL_APP_name=\"gwm\" -DGWM
PATHDEFS = -DINSTALL_PATH=\"$(GWMDIR)\" \
-DINSTALL_DIR=\"$(GWMDIR)\" -DDEFAULT_DEFAULT_WLPATH=\"$(GWMDIR)\"
EXTRA_INCLUDES=-I$(INCDIR)/extensions -I$(INCDIR)/X11/extensions
#ifdef SYSV
OSDEFS = -DSYSV
#endif
#ifdef SparcArchitecture
CONFIGDEFS = -DDOUBLE_ALIGN
#endif
#if defined(VaxArchitecture) && (HasGcc == NO)
CONFIGDEFS = -DSTUPID
#endif
#ifdef HPArchitecture
CONFIGDEFS = -DNO_STRUCTURE_OFFSETS -DUSE_STANDARD_MALLOC
#endif
#ifdef IBMArchitecture
#ifdef RsArchitecture
CONFIGDEFS = -DSYSV -DDO_NOT_DECLARE_STRCHR -DNEED_SELECT_H
#else
#ifdef PS2Architecture
CONFIGDEFS = -DIBM_RT -DNO_STRUCTURE_OFFSETS
#else
CONFIGDEFS = -DIBM_RT -Nn3000
#endif
#endif
#endif
#ifdef AlphaArchitecture
CONFIGDEFS = -DLONG_ALIGN -DNO_STRUCTURE_OFFSETS
#endif
#ifdef LinuxArchitecture
CONFIGDEFS = -DDO_NOT_USE_SBRK
#endif
#ifdef sm90
CONFIGDEFS = -DSTUPID -DSYSV
#endif
#ifdef gould
CONFIGDEFS = -DDOUBLE_ALIGN
#endif
#ifdef sequent
EXTRA_LIBRARIES = -lseq
#endif
LOCAL_LIBRARIES = $(XPMLIB)
SYS_LIBRARIES = $(EXTENSIONLIB) $(XLIB)
DEPLIBS = $(DEPXPMLIB) $(DEPEXTENSIONLIB) $(DEPXLIB)
DEFINES = $(OPTIONSDEFS) $(PATHDEFS) $(OSDEFS) $(CONFIGDEFS) $(XPMINC)
SRCS = bar.c client.c error.c gwm.c icccm.c machine.c malloc.c \
menu.c plug.c reference.c revision.c screen.c user.c \
wl_active.c wl_atom.c wl_bar.c wl_client.c wl_coll.c \
wl_cursor.c wl_event.c wl_fsm.c wl_func.c wl_label.c wl_list.c \
wl_menu.c wl_name.c wl_number.c wl_pixmap.c wl_plug.c \
wl_pointer.c wl_string.c wob.c wool-gwm.c wool.c wops.c
OTHERSRCS = wool.yac wool.lex
OBJS = y.tab.o \
bar.o client.o error.o gwm.o icccm.o machine.o malloc.o \
menu.o plug.o reference.o revision.o screen.o user.o \
wl_active.o wl_atom.o wl_bar.o wl_client.o wl_coll.o \
wl_cursor.o wl_event.o wl_fsm.o wl_func.o wl_label.o wl_list.o \
wl_menu.o wl_name.o wl_number.o wl_pixmap.o wl_plug.o \
wl_pointer.o wl_string.o wob.o wool-gwm.o wool.o wops.o
ComplexProgramTarget(gwm)
MakeSubdirs($(SUBDIRS))
DependSubdirs($(SUBDIRS))
ForceSubdirs($(SUBDIRS))
depend:: lex.yy.c y.tab.c
lex.yy.c : wool.lex
lex wool.lex
-if grep FLEX lex.yy.c;then cp gwm-parsers/lex.yy.c .; fi
y.tab.c : wool.yac
yacc wool.yac
-if grep YYBYACC y.tab.c;then cp gwm-parsers/y.tab.c .;fi
y.tab.o: lex.yy.c y.tab.c
clean::
$(RM) lex.yy.c y.tab.c
all:: gwm

60
Make.TEMPLATE Normal file
View File

@ -0,0 +1,60 @@
# NOTE: A link to this file is kept in the Make/ subdirectory, so that you
# can overwrite your src directory with a new version without losing these
# modifications
# the directory where X11 include files can be found (or in a X11 directory
# just underneath). Must not be blank (should be /usr/include on most systems)
# EXTRA_INCLUDES can be set to other -I directives to specifu other paths
XDIR = /usr/include
EXTRA_INCLUDES=
# the linker option(s) to specify directories where X librairies stay (BSD)
# must be blank if your linker doesn't have a -L option (SYSV)
# put here where the Xpm library is, if it is not in a standard place
XLIBDIR = -L/usr/lib/X11
# the X11 library, and any other useful. Use -l (BSD) or complete pathname
# (e.g. /usr/lib/X11/libX11.a) if your linker doesn't understand "-L" (SYSV)
# you will need to have -lXext -lX11 if you compiled with -DX11R4 or later
# only -lX11 with X11R1 to X11R3
LIBS = -lXext -lX11
# compilation flags , -O or -g
FLAGS = -O
# name (absolute or relative) of the compiler: cc, /bin/cc,
# gcc -pipe -traditional, ... (use -traditional with gcc)
C_COMPILER= cc
# various defines: (See INSTALL for list)
# normally, at least -DX11R6 -DSECURE -DSTATS -DUSER_DEBUG
# and OS/platform dependant flags
DEFINES = -DX11R6 -DSECURE -DSTATS -DUSER_DEBUG -DNO_GWM_LOG
# other linker -specific flags
LFLAGS =
# unix command to apply to executable after link
# set it to ":" if no processing is done (most machines. some must set the stack)
POSTPROCESSING = :
# directory to copy the executable to on install
INSTALL_GWM=/usr/local/bin/gwm
# directory to copy be the standard wool files and bitmaps
INSTALL_DIR=/usr/local/lib/gwm
# path to be appended to: .:$HOME:$HOME/gwm for GWMPATH
# Must be defined, but normally contains only INSTALL_DIR
INSTALL_PATH=$(INSTALL_DIR)

1379
Makefile Normal file
View File

File diff suppressed because it is too large Load Diff

281
PROBLEMS Normal file
View File

@ -0,0 +1,281 @@
____ _ _ _ _
/ ___|___ _ __ ___ _ __ (_) | __ _| |_(_) ___ _ __
| | / _ \| '_ ` _ \| '_ \| | |/ _` | __| |/ _ \| '_ \
| |__| (_) | | | | | | |_) | | | (_| | |_| | (_) | | | |
\____\___/|_| |_| |_| .__/|_|_|\__,_|\__|_|\___/|_| |_|
|_|
____ _ _
| _ \ _ __ ___ | |__ | | ___ _ __ ___ ___
| |_) | '__/ _ \| '_ \| |/ _ \ '_ ` _ \/ __|
| __/| | | (_) | |_) | | __/ | | | | \__ \
|_| |_| \___/|_.__/|_|\___|_| |_| |_|___/
/*****************************************************************************\
* CONTENTS *
\*****************************************************************************/
[0] Errors while compiling on modern Linux boxes
[1] Errors while compiling parsers
[2] Compiling on DEC alphas
[3] Compiling on GWM and XPM on HP9000 series 300/400/800 computers
[4] Undefined function: strcasecmp when linking
[5] Error message when loading gwm ld: unrecognized option: -p
[6] Errors on SPARCS (sun4) bus error in (color-make value)
[7] Error in loading: gwm not linked with Xlib
[8] On HP machines: /bin/ld: Unsatisfied symbols: XError (data)
[9] Error in wl_event.c after line 80
[10] Type errors in malloc.c
[11] GWM crashes on a HP/Apollo 68040:
[12] Compiling on a NeXT with c-Xist:
[13] Compiling with FLEX instead of LEX
[14] makdepend complains: includes EXTERN.h more than once!
[15] runtime WOOL ERROR: Internal error: bus error: (color-make value)
[16] Undefined function XmbTextPropertyToTextList at link time
/*****************************************************************************\
* DETAILS *
\*****************************************************************************/
[1] Errors while compiling parsers
==================================
Gwm can ONLY run with standard lex and yacc, it cannot work with flex, bison,
byacc or others. If you dont have them (linux, FreeBSD, NetBSD...) do a:
cp gwm-parsers/lex.yy.c . ; cp gwm-parsers/y.tab.c
and all should work OK.
[2] Compiling on DEC alphas
===========================
GWM may not run on 64-bit machines where integers are not the same size as
pointers (DEC alphas, but runs ok on SGI R4000s). If there are
problems, try either the define -DLONG_ALIGN, or the -taso flag, or
the -misaligned flag, or compile it on a DEC 5000 and translate the
32-bit binary with the "mx" utility.
[3] Compiling on GWM and XPM on HP9000 series 300/400/800 computers
===================================================================
Makefile for hp300:
XLIBDIR =
C_COMPILER= gcc -pipe -traditional
DEFINES = -DSYSV -DX11R4 -DSECURE -DSTATS -DUSER_DEBUG
Makefile for hp800:
XLIBDIR =
LIBS = -lX11R3 hpXError.o
DEFINES = -DSYSV -DX11R3 -DSECURE -DSTATS -DUSER_DEBUG
------------------------------------------------------------------------------
[4] Undefined function: strcasecmp when linking
===============================================
add the flag -DNEED_STRCASECMP to the makefile (needed only in the
subdirectory xpm, actually).
------------------------------------------------------------------------------
[5] Error message when loading gwm ld: unrecognized option: -p
==============================================================
ld: unrecognized option: -p
ld: unrecognized option: -m
in Makefile, change -Lxpm by -L xpm
------------------------------------------------------------------------------
[6] Errors on SPARCS (sun4) bus error in (color-make value)
===========================================================
* GWM seemed to crash when compiled with -O with SUN's cc
* do NOT compile with the cc flags "-dalign", or use the define -DDOUBLE_ALIGN
Symptom: at runtime gwm crashes with message:
WOOL ERROR: Internal error: bus error
[5] (color-make value)
------------------------------------------------------------------------------
[7] Error in loading: gwm not linked with Xlib
==============================================
(a lot of _X... undefined references)
Might happen, just do a
rm -f gwm;make
------------------------------------------------------------------------------
[8] On HP machines: /bin/ld: Unsatisfied symbols: XError (data)
=================================================================
change in gwm.c line 34:
extern XErrorHandler XError;
to:
extern int XError();
------------------------------------------------------------------------------
[9] Error in wl_event.c after line 80
=====================================
add -DNO_STRUCTURE_OFFSETS to DEFINES
------------------------------------------------------------------------------
[10] Type errors in malloc.c
============================
malloc.c:286: conflicting types for `malloc'
wool.h:200: previous declaration of `malloc'
malloc.c:490: conflicting types for `realloc'
wool.h:200: previous declaration of `realloc'
malloc.c:536: conflicting types for `calloc'
wool.h:200: previous declaration of `calloc'
===> add -DVOID_MALLOC to compile options.
Any other errors: use -DUSE_STANDARD_MALLOC. This bypasses the gwm-provided
malloc which provided debugging (stats) info, and was much faster than old
SYSV mallocs, but is no more faster than most modern mallocs. Bypassing GWM
malloc will get rid of any compiling errors anyways.
------------------------------------------------------------------------------
[11] GWM crashes on a HP/Apollo 68040:
======================================
with:
C source file "malloc.c" line 415
WOOL ERROR: assertion failed: op -> ov_magic == MAGIC
GWM: -- cannot decorate windows, aborting
apply this patch:
% diff -c gwm.c.orig gwm.c
*** gwm.c.orig Sun Oct 13 14:37:02 1991
--- gwm.c Sun Oct 13 14:37:45 1991
***************
*** 720,727 ****
}
}
GWM_ProcessingExistingWindows = 0;
! if (children)
! Free((char *) children);
}
}END_OF_ALL_SCREENS;
}
--- 720,727 ----
}
}
GWM_ProcessingExistingWindows = 0;
! /* if (children) */
! /* Free((char *) children); */
}
}END_OF_ALL_SCREENS;
}
------------------------------------------------------------------------------
[12] Compiling on a NeXT with c-Xist:
=====================================
To: colas@mirsa.inria.fr
Subject: GWM1.7n on NeXT
Date: Mon, 12 Oct 92 13:33:29 -0400
From: anderson@sapir.cog.jhu.edu
Colas,
I used to use gwm regularly when I used a Sun - a year ago, though, I
got rid of my Sun and switched to a NeXT. Until recently, I didn't use
X of any sort on my NeXT, but I've installed co-Xist and its
associated development environment now, so I thought I'd bring up gwm
again. You asked that if people bring up gwm on a new machine, they
let you know what had to be done to get it to work, so here's a data
point for you.
I started from the file gwm-1.7n.tar.Z which I found on export. I
tried using imake to build it but found it too hard to make the
necessary modifications. The other procedure, with plain make, worked
fine (after I figured out how to do it).
The version of c-Xist I'm using is 3.0 beta - not yet released, but
coming out soon and presently in beta test. This is a full
implementation of X11R5 (the current release version is 2.1.2, based
on X11R4). I'm running version 3.0 of NeXTstep on a NeXTdimension
(full color) system. The system software (cc, etc.) is based on gcc
1.9x: i.e., a pre-release version of gcc2 with lots of
(undocumented...) NeXT-specific stuff.
I managed to get gwm to compile under this setup with the following
set of defines:
DEFINES = -DX11R5 -DSECURE -DUSER_DEBUG -DHAS_STRCHR -DDO_NOT_REDEFINE_MALLOC -DNO_STRUCTURE_OFFSETS
Each of the changes from your proposed "vanilla bsd" defines was
necessary to get some part of gwm to compile. I didn't try
"-DUSE_STANDARD_MALLOC" instead of "-DDO_NOT_REDEFINE_MALLOC", but at
least the latter works.
I used plain cc (no "-traditional": that breaks the rather wierd new
setup of include files under NS3.0, and isn't necesary anyway). The
only other changes I made in the Make.NeXT file were to put stuff in
/usr/bin/X11 and /usr/lib/X11 (instead of /usr/local/...) because
that's where all the co-Xist stuff lives anyway.
I haven't tested it at all extensively, but I do know that it runs and
seems to behave as it should. Thanks a lot for your efforts. I should
mention also that once I stopped trying to be clever and just did what
your directions told me to do, building gwm from this distribution
turned out to be very straightforward.
Best regards,
--Steve Anderson
Dept. of Cognitive Science
The Johns Hopkins University
<anderson@sapir.cog.jhu.edu>
------------------------------------------------------------------------------
[13] Compiling with FLEX instead of LEX
=======================================
use wool.flex intead of wool.lex
(Code donated by Olaf Kirch <okir@mathematik.th-darmstadt.de>)
------------------------------------------------------------------------------
[14] makdepend complains: includes EXTERN.h more than once!
===========================================================
That's normal. Gwm uses EXTERN.h and INTERN.h to better manage public/private
info in .h, which was not intended by makedepend. ignore these messages.
------------------------------------------------------------------------------
[15] runtime WOOL ERROR: Internal error: bus error: (color-make value)
======================================================================
seems to happen on some SUNs, notably Solaris ones. define:
-DUSE_STANDARD_MALLOC
and recompile EVERYTHING (do a make clean before make)
------------------------------------------------------------------------------
[16] Undefined function XmbTextPropertyToTextList at link time
==============================================================
You have X11R5 X11 libraries. Upgrade to X11R6, or add the compile flag -DX11R5
:

190
README Normal file
View File

@ -0,0 +1,190 @@
______ ____ __ _
/ ___\ \ / / \/ | _ __ ___ __ _ __| |_ __ ___ ___
| | _ \ \ /\ / /| |\/| | | '__/ _ \/ _` |/ _` | '_ ` _ \ / _ \
| |_| | \ V V / | | | | | | | __/ (_| | (_| | | | | | | __/
\____| \_/\_/ |_| |_| |_| \___|\__,_|\__,_|_| |_| |_|\___|
* What is GWM?
* What is new in this version?
* Where is GWM? Current version: 1.8, June 30 1995
* A warning GWM by default sends me a message on startup
For all inquiries, contact:
gwm@sophia.inria.fr (or see W3 page: http://www.inria.fr/koala/gwm)
-------------------------------------------------------------------------------
What is GWM?
============
The GWM (Generic Window Manager) is an extensible Window Manager for the X
Window System Version 11. It is based upon a WOOL (Window Object Oriented
Langage) kernel, which is an interpreted dialect of Lisp with specific window
management primitives. The user builds a window manager by writing WOOL files
to describe objects on the screen, including a Finite State Machine triggering
WOOL actions on response to X events (e.g. mouse buttons) on that object. These
objects can be used as decorations around X applications windows, as pop-up
menus or as independent windows. GWM should be able to emulate efficiently
other window managers, and play the same role for window managers as EMACS does
for text editors.
GWM comes with already defined profiles (standard, vtwm-like, twm-like,
mwm-like). Some screenshots are avialable on the W3 page. Or you can design
exactly what you want.
Copyright
---------
Freeware, with sources. GWM is Copyrighted by Bull, but bears the same
licensing conditions as the X distribution, i.e. you are free to do anything
with it, but Bull offers no guarantee nor support.
Author
------
GWM has been designed and realized by Colas Nahaboo, in the Koala Project with
the invaluable help of the community of GWM users all over the world on the
internet since 1989.
History
-------
Our Koala project was one of the first to base its experiments on the new X11
window system. One of our ambitions was to continue the research work of the
ROOMS team at Xerox, who designed this revolutionary window managing system
back in 1986 but on proprietary systems. We planned to realize a research
prototype flexible enough to prototype easily new ideas, but at the same time
always validate our ideas by making real users use our prototype in everyday
use to gain relevant feedback, so the system could be run on low-end
workstations currently in use, e.g. 68020s with 4M ram total.
I decided to go the emacs way, but with a lisp dialect that would be much more
efficient in machine ressource use. So I designed WOOL, a very special kind of
lisp dialect in January 1988. After a first rewrite, GWM was running better
than we could expected so we make it publicly available in July 1989.
GWM was a success, but was overwhelmed by its maintenance and support due to
the feedback brought back by the internet community, so that in the following
years I did not have time to put actual research work on the original goal, the
profiles on top of the kernel. Then I became too busy to maintain it so I kept
a low profile so as not to attract new user and keep a small base of faithful
users. I wanted to change a lot of things but did not want as it would have
induced incompatibilties for my users. So I waited for GWM to die slowly and
some other new Window Manager to come and replace it.
Present state
-------------
But, 6 years after, I still use GWM. Why? because it stills offers the best
environment a hacker can dream of among the available WMs. So I decided to
clean the distribition, integrate all the patches sent to me by contributors,
and issue the 1.8 release (30 June 1995) to offer a stable useful base for all
hackers to use while I could begin writing a new incompatible incarnation with
all insight gained by these years. GWM now can now do a suprising amount of
things, at the expense of a quite involved hacking part from profile writers.
So gwm 1.8 can be seen as the "final edition" of gwm.
What is GWM for?
----------------
Although GWM can be used by normal users, hackers will feel much more at ease
with it. If you do not want to edit your emacs profiles, chances are that GWM
is not for you.
On what machines does GWM run?
------------------------------
All unixes.
-------------------------------------------------------------------------------
What is new in this version?
============================
This version (1.8) has three important new features, thanks to the main
contribution of Anders Holst aho@nada.kth.se:
* recursive bars. now GWM decorations are quite flexible.
* shaped elements anywhere. weird shapes are now possible.
* bug fixes. all known bugs or memory leaks have been fixed.
You can see the list of changes in detail.
What about the next version?
----------------------------
The last version (1.7o) was issued 18 months ago (sept. 1993), and this 1.8
version should be the last one as far as the C code is concerned (except bug
fixes or patches to work around some buggy applications). It is very likely
that I will make a new version of gwm, but it will be incompatible with the
current gwm , so I will likely call it by another name, but dont hold your
breath! The lisp part is ready, however (see /pub/Klone on ftp at
koala.inria.fr, but I need to re-design the C part and the base profiles, in my
spare time...
Support
-------
GWM is not what I am paid for. It serves me a lot to test my ideas, and I want
to help people to use it, but most of the time I will be too busy to answer
beginner questions, so try to post questions about its use on the news or
mailing list instead of mailing only to me. Moreover, as I use only the
standard profile, I am of very little help on questions specific to the other
profiles (mwm, twm, vtwm...)
-------------------------------------------------------------------------------
Where is GWM?
=============
GWM is available by FTP on the X consortium ftp site, ftp.x.org, in
/contrib/window_managers/gwm and all its mirrors, or on the koala project ftp
site, koala.inria.fr, in /pub/gwm, where pre-compiled executables are also
stored for some architectures.
Mailing list
------------
Discussions on GWM happen on the GWM mailing list, gwm-talk@sophia.inria.fr.
You can subscribe/unsubscribe by mailing to:
gwm@sophia.inria.fr
And on the koala.inria.fr ftp site you can browse:
* The list of mailing list members
* The archive of past mails
* General info on this list
Newsgroups
----------
Best places to ask questions are comp.windows.x.apps and comp.windows.x. Please
try to put the uppercase "GWM" in the subject of the post to allow easy
spotting by other users among the numerous messages there.
-------------------------------------------------------------------------------
************************************ WARNING *********************************
A warning
When gwm starts (and after that once a day) GWM by default sends me an UDP
packet transparently for me to have a rough idea of gwm use in the world. By
default the only value inside the packet is the hostname of the machine, and I
will keep these data private, but you can of course supress this feature if
you want. Just (re)compile with the compilation flag -DNO_GWM_LOG, or for 1.8a
or later you can also set the shell environments NO_GWM_LOG or NO_KOALA_SPY to
disable this feature without recompilation.
******************************************************************************
-------------------------------------------------------------------------------
Colas Nahaboo, Koala, BULL @ INRIA Sophia, http://www.inria.fr/koala/colas
colas@sophia.inria.fr
33 (FRANCE) 93.65.77.70 (VOICE PHONE)
Colas Nahaboo (SURFACE MAIL)
INRIA
B.P. 93
06902 Sophia Antipolis cedex
FRANCE

672
bar.c Normal file
View File

@ -0,0 +1,672 @@
/* Copyright 1989 GROUPE BULL -- See license conditions in file COPYRIGHT
* Copyright 1989 Massachusetts Institute of Technology
*/
/*********************************************\
* *
* BULL WINDOW MANAGER for X11 . *
* *
* MODULE defining the Bar Wob class. *
* *
\*********************************************/
/* include */
#include "EXTERN.h"
#include "wool.h"
#include "wl_atom.h"
#include "gwm.h"
#include "wl_fsm.h"
#include "wl_pixmap.h"
#include "wl_cursor.h"
#include "wl_bar.h"
/* local constants */
/* external */
extern Wob NewWob();
extern Plug NewPlug();
extern WOOL_METHOD WLMenu[];
extern Bar BarOpen();
extern BarEventHandler(), BarClose(), UpdateBarGeometry(), ReconfigureBar();
#ifdef SHAPE /* compile with -I/usr/include/X11 AND
-I/usr/include/X11/extensions to work on
machines having shapes.h in either place */
#include <shape.h>
extern BarIsShaped(), UpdateBarShape();
#define TileIsShaped(tile) \
(tile && (tile)->type == WLPixmap) && ((WOOL_Pixmap) (tile)) -> mask
#endif /* SHAPE */
WOB_METHOD BarClass[] = {
0, /* METHODS_ARRAY */
WobEval,
WobPrint,
WobRelease,
WobExecute,
WobSet,
WobGetCValue,
(WOB_METHOD) BarOpen,
BarClose,
BarEventHandler,
(WOB_METHOD) wool_undefined_method_1,
WobGetDimensions,
(WOB_METHOD) wool_undefined_method_2,
(WOB_METHOD) wool_undefined_method_2,
ReconfigureBar,
(WOB_METHOD) wool_undefined_method_2,
(WOB_METHOD) wool_undefined_method_1,
(WOB_METHOD) wool_undefined_method_1,
(WOB_METHOD) wool_undefined_method_1,
(WOB_METHOD) wool_undefined_method_1,
(WOB_METHOD) wool_undefined_method_1
};
/* routines */
/*
* NewBar
* Creates a new bar object from a WOOL_Bar description
* Warning: a plug may be NULL to indicate an extensible space
*/
Bar
NewBar(parent, wl_bar, dir)
Wob parent;
WOOL_Bar wl_bar;
short dir;
{
Bar bar = (Bar) NewWob(sizeof(struct _Bar)
+ sizeof(Plug) * Max(0, (wl_bar -> plugs_size - 1)));
int i;
WOOL_OBJECT object;
wl_bar = (WOOL_Bar) wool_type_or_evaluate(wl_bar, WLBar);
bar -> type = BarClass;
bar -> parent = parent;
bar -> direction = dir;
bar -> elength = 0;
bar -> ewidth = (wl_bar -> plugs_size ? 1 : 0);
/* set up the box info */
bar -> box.width = bar -> box.height = wl_bar -> min_width;
bar -> min_width = wl_bar -> min_width;
bar -> max_width = wl_bar -> max_width;
bar -> box.borderwidth = wl_bar -> borderwidth;
bar -> box.borderpixel = wl_bar -> borderpixel;
bar -> box.background = wl_bar -> background;
bar -> plug_separator = wl_bar -> plug_separator;
increase_reference(bar -> menu =
wool_type_or_evaluate(wl_bar -> menu, WLMenu));
increase_reference(bar -> property = (WOOL_OBJECT) wl_bar -> property);
increase_reference(bar -> bordertile =
wool_type_or_evaluate(wl_bar -> bordertile, WLPixmap));
increase_reference(bar -> fsm =
wool_type_or_evaluate(wl_bar -> fsm, WLFsm));
increase_reference(bar -> cursor =
wool_type_or_evaluate(wl_bar -> cursor, WLCursor));
increase_reference(bar -> tile = (wl_bar -> tile == TRU ? wl_bar -> tile :
wool_type_or_evaluate(wl_bar -> tile, WLPixmap)));
/* then recursively sets plug infos */
bar -> nplugs = wl_bar -> plugs_size;
for (i = 0; i < wl_bar -> plugs_size; i++) {
object = (WOOL_OBJECT) wl_bar -> plugs[i];
if ((object != NIL) &&
(object -> type != WLBar) &&
(object -> type != WLPlug)) {
object = WOOL_send(WOOL_eval, object, (object));
if (object == UNDEFINED_WOOL_VALUE)
wool_error(UNDEFINED_VARIABLE, "");
else if ((object != NIL) &&
(object -> type != WLBar) &&
(object -> type != WLPlug))
bad_argument(object, 0, "PLUG or BAR");
}
if (object -> type == WLPlug) {
bar -> plugs[i] = (Wob) NewPlug(bar, object);
bar -> ewidth = 0;
}
else if (object -> type == WLBar) {
bar -> plugs[i] = (Wob) NewBar(bar, object, !dir);
if (((Bar) bar -> plugs[i]) -> ewidth) bar -> elength = 1;
if (!(((Bar) bar -> plugs[i]) -> elength))
bar -> ewidth = 0;
}
else {
bar -> plugs[i] = (Wob) NULL;
bar -> elength = 1;
}
}
return bar;
}
BarClose(bar)
Bar bar;
{
int i;
if(!bar) return;
for (i = 0; i < bar -> nplugs; i++) {
if (bar -> plugs[i])
if (bar -> plugs[i] -> type == PlugClass)
PlugClose(bar -> plugs[i]);
else if (bar -> plugs[i] -> type == BarClass)
BarClose(bar -> plugs[i]);
}
WobRelease(bar);
}
/*
* Open a Bar
*/
Bar
BarOpen(bar)
Bar bar;
{
int i;
if(!bar)
return bar;
check_window_size(bar);
bar -> hook = XCreateSimpleWindow(dpy, bar -> parent -> hook,
bar -> box.x, bar -> box.y,
bar -> box.width, bar -> box.height,
bar -> box.borderwidth,
bar -> box.borderpixel,
bar -> box.background);
if (bar -> parent -> type == ScreenClass)
bar -> status |= TopLevelXWindowStatus;
WobRecordHook(bar);
if (bar -> cursor != NIL)
XDefineCursor(dpy, bar -> hook,
((WOOL_Cursor) bar -> cursor) -> cursor);
if (bar -> tile != NIL && bar -> tile != TRU)
XSetWindowBackgroundPixmap(dpy, bar -> hook,
((WOOL_Pixmap) bar -> tile) -> pixmap);
if (bar -> bordertile != NIL)
XSetWindowBorderPixmap(dpy, bar -> hook,
((WOOL_Pixmap) bar -> bordertile) -> pixmap);
bar -> curstate = (int) WOOL_send(WOOL_open, bar -> fsm, (bar -> fsm));
for (i = 0; i < bar -> nplugs; i++) {
if (bar -> plugs[i])
WOOL_send(WOOL_open, bar -> plugs[i], (bar -> plugs[i]));
}
bar -> input_mask = WobMask | ((WOOL_Fsm) bar -> fsm) -> mask;
XSelectInput(dpy, bar -> hook, bar -> input_mask);
#ifdef SHAPE
if (BarIsShaped(bar)) {
bar -> shaped = 1;
UpdateBarShape(bar);
}
#endif /* SHAPE */
XMapWindow(dpy, bar -> hook);
XMapSubwindows(dpy, bar -> hook);
return bar;
}
int
CalcNaturalBarWidth(bar)
Bar bar;
{
Plug *plugs;
int i, curr_width = 1;
plugs = (Plug *) & ((bar -> plugs)[0]);
if (bar -> direction == HORIZONTAL) {
if (!bar -> nplugs && bar -> tile != NIL && bar -> tile != TRU)
curr_width = ((WOOL_Pixmap) bar -> tile) -> height;
for (i = 0; i < bar -> nplugs; i++) {
if (plugs[i])
if (plugs[i] -> type == PlugClass) {
UpdatePlugGeometry(plugs[i]);
curr_width = Max(curr_width,
plugs[i] -> box.height + 2 * plugs[i] -> box.borderwidth);
} else {
curr_width = Max(curr_width,
CalcNaturalBarLength(plugs[i]) + 2 * plugs[i] -> box.borderwidth);
}
}
curr_width = Min(bar -> max_width, Max(bar -> min_width, curr_width));
return curr_width;
} else {
if (!bar -> nplugs && bar -> tile != NIL && bar -> tile != TRU)
curr_width = ((WOOL_Pixmap) bar -> tile) -> width;
for (i = 0; i < bar -> nplugs; i++) {
if (plugs[i])
if (plugs[i] -> type == PlugClass) {
UpdatePlugGeometry(plugs[i]);
curr_width = Max(curr_width,
plugs[i] -> box.width + 2 * plugs[i] -> box.borderwidth);
} else {
curr_width = Max(curr_width,
CalcNaturalBarLength(plugs[i]) + 2 * plugs[i] -> box.borderwidth);
}
}
curr_width = Min(bar -> max_width, Max(bar -> min_width, curr_width));
return curr_width;
}
}
int
CalcNaturalBarLength(bar)
Bar bar;
{
Plug *plugs;
int i, tmp;
int current_pos = 0;
int space_len = 0, n_spaces = 0;
plugs = (Plug *) & ((bar -> plugs)[0]);
if (bar -> direction == HORIZONTAL) {
for (i = 0; i < bar -> nplugs; i++)
if (!plugs[i]) {
n_spaces++;
current_pos += space_len;
} else if (plugs[i] -> type == PlugClass) {
UpdatePlugGeometry(plugs[i]);
current_pos += plugs[i] -> box.width
+ bar -> plug_separator + 2 * plugs[i] -> box.borderwidth;
} else {
tmp = CalcNaturalBarWidth(plugs[i]);
if (((Bar) plugs[i]) -> ewidth)
if (tmp > space_len) {
current_pos += n_spaces * (tmp - space_len);
n_spaces++;
space_len = tmp;
} else {
n_spaces++;
tmp = space_len;
}
current_pos += tmp
+ bar -> plug_separator + 2 * plugs[i] -> box.borderwidth;
}
if (current_pos)
current_pos -= bar -> plug_separator;
else if (!bar -> nplugs && bar -> tile != NIL && bar -> tile != TRU)
current_pos = ((WOOL_Pixmap) bar -> tile) -> width;
else
current_pos = 1;
} else {
for (i = 0; i < bar -> nplugs; i++)
if (!plugs[i]) {
n_spaces++;
current_pos += space_len;
} else if (plugs[i] -> type == PlugClass) {
UpdatePlugGeometry(plugs[i]);
current_pos += plugs[i] -> box.height
+ bar -> plug_separator + 2 * plugs[i] -> box.borderwidth;
} else {
tmp = CalcNaturalBarWidth(plugs[i]);
if (((Bar) plugs[i]) -> ewidth)
if (tmp > space_len) {
current_pos += n_spaces * (tmp - space_len);
n_spaces++;
space_len = tmp;
} else {
n_spaces++;
tmp = space_len;
}
current_pos += tmp
+ bar -> plug_separator + 2 * plugs[i] -> box.borderwidth;
}
if (current_pos)
current_pos -= bar -> plug_separator;
else if (!bar -> nplugs && bar -> tile != NIL && bar -> tile != TRU)
current_pos = ((WOOL_Pixmap) bar -> tile) -> height;
else
current_pos = 1;
}
return current_pos;
}
int
CalcMinBarLength(bar)
Bar bar;
{
Plug *plugs;
int i, current_pos = 0;
plugs = (Plug *) & ((bar -> plugs)[0]);
if (bar -> direction == HORIZONTAL) {
for (i = 0; i < bar -> nplugs; i++)
if (plugs[i])
if (plugs[i] -> type == PlugClass) {
UpdatePlugGeometry(plugs[i]);
current_pos += plugs[i] -> box.width
+ bar -> plug_separator + 2 * plugs[i] -> box.borderwidth;
} else {
current_pos += bar -> plug_separator + 2 * plugs[i] -> box.borderwidth
+ (((Bar) plugs[i]) -> ewidth ? 1 : CalcNaturalBarWidth(plugs[i]));
}
if (current_pos) {
current_pos -= bar -> plug_separator;
}
} else {
for (i = 0; i < bar -> nplugs; i++)
if (plugs[i])
if (plugs[i] -> type == PlugClass) {
UpdatePlugGeometry(plugs[i]);
current_pos += plugs[i] -> box.height
+ bar -> plug_separator + 2 * plugs[i] -> box.borderwidth;
} else {
current_pos += bar -> plug_separator + 2 * plugs[i] -> box.borderwidth
+ (((Bar) plugs[i]) -> ewidth ? 1 : CalcNaturalBarWidth(plugs[i]));
}
if (current_pos) {
current_pos -= bar -> plug_separator;
}
}
return current_pos;
}
/*
* Called BEFORE adjusting the client
* Here we take a bar setup, and suppose that its box data is updated.
* Then we ask for the dimension of plugs and proceed to position them.
* Adjust the width of the bars
*/
int
UpdateBarWidth(bar)
Bar bar;
{
Plug *plugs;
int i;
if (!bar)
return 0;
if (bar -> direction == HORIZONTAL) {
bar -> box.height = CalcNaturalBarWidth(bar);
} else {
bar -> box.width = CalcNaturalBarWidth(bar);
}
return 2 * bar -> box.borderwidth + (bar -> direction == HORIZONTAL ?
bar -> box.height : bar -> box.width);
}
/*
* Called AFTER adjusting the client
* Adjust space in the length of the bar.
* If we encounter a NULL plug, treat it as an extensible space
*/
UpdateBarLength(bar)
Bar bar;
{
Plug *plugs;
int i, n = 0, current_pos = 0, n_spaces = 0;
int total_space, delta = 0, shift = 0;
if (!bar)
return;
plugs = (Plug *) & ((bar -> plugs)[0]);
for (i = 0; i < bar -> nplugs; i++)
if (!plugs[i])
n_spaces++;
else if ((plugs[i] -> type == BarClass) && ((Bar) plugs[i]) -> ewidth)
n_spaces++;
total_space = (bar -> direction == HORIZONTAL ? bar -> box.width
: bar -> box.height) - CalcMinBarLength(bar);
if (n_spaces && (total_space > 0)) {
shift = total_space / n_spaces;
delta = total_space % n_spaces;
}
if (bar -> direction == HORIZONTAL) {
for (i = 0; i < bar -> nplugs; i++)
if (plugs[i])
if (plugs[i] -> type == PlugClass) {
plugs[i] -> box.x = current_pos;
plugs[i] -> box.y = (bar -> box.height
- plugs[i]->box.height - 2 * plugs[i] -> box.borderwidth) / 2;
current_pos += plugs[i] -> box.width
+ bar -> plug_separator + 2 * plugs[i] -> box.borderwidth;
} else {
plugs[i] -> box.x = current_pos;
plugs[i] -> box.y = 0;
if (((Bar) plugs[i]) -> ewidth)
plugs[i] -> box.width = 1 + (++n == n_spaces ? shift+delta : shift);
else if (bar -> nplugs == 1)
plugs[i] -> box.width = bar -> box.width - 2 * plugs[i] -> box.borderwidth;
else
plugs[i] -> box.width = CalcNaturalBarWidth(plugs[i]);
plugs[i] -> box.height = bar -> box.height - 2 * plugs[i] -> box.borderwidth;
UpdateBarLength(plugs[i]);
current_pos += plugs[i] -> box.width
+ bar -> plug_separator + 2 * plugs[i] -> box.borderwidth;
}
else {
current_pos += (++n == n_spaces ? shift+delta : shift);
}
} else {
for (i = 0; i < bar -> nplugs; i++)
if (plugs[i])
if (plugs[i] -> type == PlugClass) {
plugs[i] -> box.y = current_pos;
plugs[i] -> box.x = (bar -> box.width
- plugs[i]->box.width - 2 * plugs[i] -> box.borderwidth) / 2;
current_pos += plugs[i] -> box.height
+ bar -> plug_separator + 2 * plugs[i] -> box.borderwidth;
} else {
plugs[i] -> box.y = current_pos;
plugs[i] -> box.x = 0;
if (((Bar) plugs[i]) -> ewidth)
plugs[i] -> box.height = 1 + (++n == n_spaces ? shift+delta : shift);
else if (bar -> nplugs == 1)
plugs[i] -> box.height = bar -> box.height - 2 * plugs[i] -> box.borderwidth;
else
plugs[i] -> box.height = CalcNaturalBarWidth(plugs[i]);
plugs[i] -> box.width = bar -> box.width - 2 * plugs[i] -> box.borderwidth;
UpdateBarLength(plugs[i]);
current_pos += plugs[i] -> box.height
+ bar -> plug_separator + 2 * plugs[i] -> box.borderwidth;
}
else {
current_pos += (++n == n_spaces ? shift+delta : shift);
}
}
}
int
NaturalBarLength(bar)
Bar bar;
{
Plug *plugs;
int i;
if (!bar)
return 0;
if (bar -> direction == HORIZONTAL) {
bar -> box.width = CalcNaturalBarLength(bar);
} else {
bar -> box.height = CalcNaturalBarLength(bar);
}
return 2 * bar -> box.borderwidth + (bar -> direction == HORIZONTAL ?
bar -> box.width : bar -> box.height);
}
BarEventHandler(bar, evt)
Bar bar;
XEvent *evt;
{
int i;
switch (evt -> type) {
case Expose:
XClearWindow(dpy, bar -> hook);
break;
case GWMUserEvent: /* TODO: no more test on plugs masks*/
WLFsm_action(bar -> fsm, bar, evt);
if (GWM_Propagate_user_events)
for (i = 0; i < bar -> nplugs; i++)
if ((bar -> plugs[i])) {
WOOL_send(WOOL_process_event, bar -> plugs[i],
(bar -> plugs[i], evt));
}
break;
default:
WLFsm_action(bar -> fsm, bar, evt);
}
}
ReconfigureBar(bar, culprit)
Bar bar;
Wob culprit; /* parent or plug */
{
int i, width, height, must_resize = 1;
if (!bar)
return;
width = bar -> box.width;
height = bar -> box.height;
if (culprit != (Wob) bar -> parent) { /* from plug or bar below */
UpdateBarWidth(bar);
WOOL_send(WOOL_reconfigure, bar -> parent, (bar -> parent, bar));
}
else { /* from above */
if (culprit && culprit -> type != BarClass)
UpdateBarLength(bar);
XMoveResizeWindow(dpy, bar -> hook, bar -> box.x, bar -> box.y,
bar -> box.width, bar -> box.height);
for (i = 0; i < bar -> nplugs; i++)
if (bar -> plugs[i])
if (bar -> plugs[i] -> type == PlugClass)
ReconfigurePlug(bar -> plugs[i], bar);
else
ReconfigureBar(bar -> plugs[i], bar);
#ifdef SHAPE
if (bar -> shaped || (bar -> shaped = BarIsShaped(bar)))
UpdateBarShape(bar);
#endif /* SHAPE */
XClearWindow(dpy, bar -> hook);
}
}
set_bar_bitmap(bar, wl_pixmap)
Bar bar;
WOOL_OBJECT wl_pixmap;
{
int shaped_tile = 0;
if (((wl_pixmap -> type == WLAtom) && (wl_pixmap != TRU) && (wl_pixmap != NIL))
|| wl_pixmap -> type == WLList)
return;
if (bar -> tile == TRU)
shaped_tile = -1;
else if (TileIsShaped(bar -> tile))
shaped_tile = 1;
decrease_reference(bar -> tile);
increase_reference(bar -> tile = wl_pixmap);
if ((shaped_tile == -1) && (bar -> tile == TRU))
shaped_tile = 0; /* No reconfigure necessary if it remains TRU */
else if ((bar -> tile == TRU) || TileIsShaped(bar -> tile))
shaped_tile = 1;
if (wl_pixmap == NIL)
XSetWindowBackground(dpy, bar->hook, bar -> box.background);
else if (wl_pixmap -> type == WLPixmap)
XSetWindowBackgroundPixmap(dpy, bar->hook,
((WOOL_Pixmap) wl_pixmap) -> pixmap);
/* Reconfigure only if anything will change */
if (shaped_tile ||
((!bar -> nplugs) &&
((bar -> direction == HORIZONTAL ? bar -> box.height : bar -> box.width) != CalcNaturalBarWidth(bar) ||
(bar -> direction == HORIZONTAL ? bar -> box.width : bar -> box.height) != CalcNaturalBarLength(bar)))) {
ReconfigureBar(bar, 0);
}
XClearWindow(dpy, bar -> hook);
}
#ifdef SHAPE
/* non-rectangular extension */
int
BarIsShaped(bar)
Bar bar;
{
int i;
if ((bar -> tile == TRU) || TileIsShaped(bar -> tile))
return 1;
for (i = 0; i < bar -> nplugs; i++)
if (bar -> plugs[i])
if (bar -> plugs[i] -> type == PlugClass) {
if (((Plug) bar -> plugs[i]) -> graphic -> type == WLPixmap
&& (((WOOL_Pixmap) (((Plug) bar -> plugs[i]) -> graphic))->mask))
return 1;
} else {
if (((Bar) bar -> plugs[i]) -> shaped)
return 1;
}
return 0;
}
UpdateBarShape(bar)
Bar bar;
{
XRectangle rect, rect2;
Plug *plugs;
int i;
int shaped_tile = TileIsShaped(bar -> tile);
rect.x = - bar -> box.borderwidth;
rect.y = - bar -> box.borderwidth;
rect.width = bar -> box.width + 2 * bar -> box.borderwidth;
rect.height = bar -> box.height + 2 * bar -> box.borderwidth;
XShapeCombineRectangles(dpy, bar -> hook, ShapeBounding,
0, 0,
&rect, 1, ShapeSet, 0);
/* transparent tile */
if (bar -> tile == TRU || shaped_tile) {
rect2.x = 0;
rect2.y = 0;
rect2.width = bar -> box.width;
rect2.height = bar -> box.height;
XShapeCombineRectangles(dpy, bar -> hook, ShapeBounding,
0, 0,
&rect2, 1, ShapeSubtract, 0);
}
/* shaped tile */
if (shaped_tile) {
int x_offset, y_offset;
/* we do the tiling ourselves by hand */
for (x_offset = 0; x_offset < bar -> box.width;
x_offset += ((WOOL_Pixmap) (bar -> tile)) -> width) {
for (y_offset = 0; y_offset < bar -> box.height;
y_offset += ((WOOL_Pixmap) (bar -> tile))->height) {
XShapeCombineMask(dpy, bar -> hook, ShapeBounding,
x_offset, y_offset,
((WOOL_Pixmap) (bar -> tile)) -> mask,
ShapeUnion);
}
}
}
plugs = (Plug *) & ((bar -> plugs)[0]);
for (i = 0; i < bar -> nplugs; i++)
if (plugs[i]) {
rect2.x = plugs[i] -> box.x + plugs[i] -> box.borderwidth;
rect2.y = plugs[i] -> box.y + plugs[i] -> box.borderwidth;
rect2.width = plugs[i] -> box.width;
rect2.height = plugs[i] -> box.height;
XShapeCombineRectangles(dpy, bar -> hook, ShapeBounding,
0, 0,
&rect2, 1, ShapeSubtract, 0);
XShapeCombineShape(dpy, bar -> hook, ShapeBounding,
rect2.x,
rect2.y,
plugs[i] -> hook, ShapeBounding,
ShapeUnion);
}
XShapeCombineRectangles(dpy, bar -> hook, ShapeBounding,
0, 0,
&rect, 1, ShapeIntersect, 0);
}
#endif /* SHAPE */

1942
client.c Normal file
View File

File diff suppressed because it is too large Load Diff

81
contrib/command_menus/README Normal file
View File

@ -0,0 +1,81 @@
From: uwe@snoopy.niif.spb.su (Valeriy E. Ushakov)
Message-Id: <9409301950.AA00492@snoopy.niif.spb.su>
Subject: gwmsh etc...
To: colas@mirsa.inria.fr
Date: Fri, 30 Sep 1994 22:50:36 +0300 (MSK)
In-Reply-To: <199409290958.AA22263@arthur.inria.fr> from "Colas Nahaboo" at Sep 29, 94 10:58:51 am
Organization: Physics Institute of St.Petersburg State Universisty
X-Operating-System: SunOS 4.1.3C 8
X-Phone: +7 (812) 428-45-27
X-Mailer: ELM [version 2.4 PL23]
Mime-Version: 1.0
Content-Type: text/plain; charset=ISO-8859-8
Content-Transfer-Encoding: 8bit
Content-Length: 2854
Hi, Colas!
Here is also a little package of command templates menu. A xterm with
specified command is started.
;;;; --- from my-menus.gwm ---
;; List of templates with default values:
;;(cmd-type ((formal1 default1 ...) (strings that makes up a command )))
(: command-template-list
'(Rlogin ((host "localhost" user ())
("rlogin " host " -8" (if user (+ " -l " user))))
Telnet ((host "localhost" port ())
("telnet " host (if port (+ " " port))))
Mud ((world ())
("tf " (if world world)))))
;; Sample commands to place in the menu.
;; Actual params for templates are given here.
(: command-list
;; Title Cmd Actual params
'(("Doors" Rlogin (host "doors"))
("Dux" Rlogin (host "dux.spb.su"))
("Base" Rlogin (host "base.dux.spb.su"))
("Phim" Telnet (host "phim1"))
("Snark.Smtp" Telnet (host "snark" port "25"))
("Unter" Mud)
("SunCircle" Mud (world "SunCircle"))))
;; Place this menu to root pop-up
(insert-at '(item-make "Commands..." (std-pop-menu cmd-pop))
root-pop-items 4)
;;;; --- def-menus.gwm initialisation ---
(for screen (list-of-screens)
.......
(setq cmd-items
'(menu-make (pop-label-make "Commands")))
;; uh-oh... Any simpler way to do this?
(for cmd command-list
(with (cmd-name (# 0 cmd)
cmd-type (# 1 cmd)
cmd-args (# 2 cmd))
(with (cmd-template (# cmd-type command-template-list))
(with (cmd-defaults (# 0 cmd-template)
cmd-parts (# 1 cmd-template))
(with-eval cmd-defaults
(with-eval cmd-args
(with-eval (list 'command (+ (list '+) cmd-parts))
(: cmd-items
(+ cmd-items
(list (list 'item-make (+ cmd-type " " cmd-name)
(list '! "/bin/sh" "-c"
(+ "xterm +ls -T " cmd-name " -n " cmd-name
" -e " command)))))))))))))
(: cmd-pop (eval cmd-items))
.....
)
Best regards!
SY, Uwe.
--------
Valeriy E. Ushakov (aka Uwe) | Zu Grunde kommen
uwe@niif.spb.su | Ist zu Grunde gehen

109
contrib/emacs-mode/emacs-mode.readme Normal file
View File

@ -0,0 +1,109 @@
Date: Wed, 26 Jan 1994 12:25:34 +0100
Return-Path: owner-gwmtalk@sophia.inria.fr
From: Sven Wischnowsky <oberon@cs.tu-berlin.de>
Message-Id: <199401261125.AA00332@mail.cs.tu-berlin.de>
To: geroahde@w250zrz.zrz.TU-Berlin.DE
Cc: gwm-talk@mirsa.inria.fr
In-Reply-To: <9401241755.AA22923@w250zrz.zrz.TU-Berlin.DE> (message from Gero Guenther on Mon, 24 Jan 94 18:55:29 +0100)
Subject: Re: gwm support for emacs-19.22
No-Reply-To: oberon@cs.tu-berlin.de
Content-Length: 6754
Gero Guenther wrote:
> Hello folks,
>
> are there patches available for emacs-19.22
> to support the wool-interaction-mode and the other comunication with
> gwm I know from epoch?
>
> I lost the account with my addr on the mailinglist for gwm so please
> respond with email or put me on the mailinglist again before
> responding.
>
Well, not exactly...
My solution to this problem was to patch gwm. Below is a patch for the
gwm.c file (version 1.7o) which adds two new options:
-I: this one makes gwm read its stdin (and, of course, evaluate it)
-P: together with -I makes gwm print a simple prompt showing the
number of currently open parentheses
COLAS NOTE: these patches has been added in the current version...
The rest is simple, something like this (in emacs):
(defvar gwm-proc nil)
(defvar gwm-buf nil)
(if (not gwm-proc)
(let ((b (generate-new-buffer "*gwm*"))
(ob (current-buffer))
(m (copy-keymap lisp-mode-map)))
(set-buffer b)
(use-local-map m)
(local-set-key "\C-j" 'gwm-send)
(set-buffer ob)
(setq gwm-buf b)
(setq gwm-proc (start-process "gwm"
b
(if (string-equal system-type
"usg-unix-v")
"/home/pub/bin/sol2/gwm"
"/home/pub/bin/sun4/gwm")
"-I"))
(process-kill-without-query gwm-proc)
(set-process-filter gwm-proc 'gwm-filter)
(set-process-sentinel gwm-proc 'gwm-sentinel)))
(defun gwm-filter (p s)
(let ((ob (current-buffer)))
(unwind-protect
(let ((i 0) (l (length s)) (p (point)))
(set-buffer zg-buf)
(insert s)
(if (string-match "\012--emacs-exec:\012\\(.*\\)\012--end" s)
(eval-region (+ p (match-beginning 1))
(+ p (match-end 1))))))
(set-buffer ob)))
(defun gwm-sentinel (process message)
(setq gwm-proc (start-process "gwm"
gwm-buf
(if (string-equal system-type
"usg-unix-v")
"/home/pub/bin/sol2/gwm"
"/home/pub/bin/sun4/gwm")
"-I"))
(process-kill-without-query gwm-proc)
(set-process-filter gwm-proc 'gwm-filter)
(set-process-sentinel gwm-proc 'gwm-sentinel))
(defun gwm-exec (s)
(interactive "Sgwm: ")
(send-string gwm-proc (concat s "\n")))
(defun gwm-send ()
(interactive)
(let ((op (point))
(stab (syntax-table)))
(set-syntax-table emacs-lisp-mode-syntax-table)
(forward-sexp -1)
(gwm-exec (buffer-substring (point) op))
(goto-char op)
(insert "\n")
(set-syntax-table stab)))
The filter function allows you to execute emacs code from gwm:
(defun eval-emacs (s)
(print "\n--emacs-exec:\n" s "\n--end\n"))
Hope this helps...
Bye
Sven

89
contrib/gwm-buffer/gwm-buffer.el Normal file
View File

@ -0,0 +1,89 @@
;; -*-Emacs-Lisp-*-
;; WOOL Interactive mode
;; Copyright (C) 1992 Mike Fletcher
;; gt0293b@prism.gatech.edu, fletch@cad.gatech.edu,
;; ccastmf@prism.gatech.edu
;;; File: wool-mode.el
;;; Description: WOOL interactive editing mode for Epoch & GWM
;;; Author: Mike Fletcher <gt0293b@prism.gatech.edu>
;;; Idea taken from: Lisp interaction mode from std. distribution
;;; First created: May 26, 1992
;;; Last Modified: May 26, 1992
;;; Version: 1.0
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 1, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;; WOOL interaction mode is for use with Epoch and the GWM window
;; manager. It provides functionallity similar to the builtin
;; lisp-interaction-mode of Emacs for GWM WOOL code. Basically the
;; only change was making a new function (gwm-eval-last-sexp) to grab
;; the last sexp and send it to GWM by way of the 'GWM_EXECUTE' X
;; property. See the GWM manual for more details on GWM and WOOL.
(if (not (boundp 'emacs-lisp-mode-map)) ; Need to make sure standard
(load-library "lisp-mode")) ; lisp mode stuff has been loaded
(defvar wool-interaction-mode-map ()
"Keymap for WOOL interaction mode.")
(if wool-interaction-mode-map ; If need to bind keys
()
(setq wool-interaction-mode-map (make-sparse-keymap))
(lisp-mode-commands wool-interaction-mode-map)
(define-key wool-interaction-mode-map "\n" 'gwm-eval-last-sexp))
(defun gwm-eval-last-sexp (arg)
"Sends sexp before point to GWM via the GWM_EXECUTE property of the
window. Output is sent to stderr of the GWM process."
(interactive "P")
(copy-to-register 24
(let ((stab (syntax-table)))
(unwind-protect
(save-excursion
(set-syntax-table emacs-lisp-mode-syntax-table)
(forward-sexp -1)
(point))
(set-syntax-table stab)))
(point) ())
(epoch::set-property "GWM_EXECUTE" (get-register 24)))
(defun wool-interaction-mode ()
"Major mode for typing and evaluating WOOL code for the GWM window
manager. Mostly a direct rip off of Lisp-interaction mode from the
Emacs distribution. Only works under Epoch.
Commands:
Same as Lisp-interaction mode, except LFD sends the current sexp to
GWM to be executed (by means of the GWM_EXECUTE property).
\\{wool-interaction-mode-map}"
(interactive)
(if (boundp 'epoch::version) ; See if running under epoch
(progn
(kill-all-local-variables)
(use-local-map wool-interaction-mode-map)
(set-syntax-table emacs-lisp-mode-syntax-table)
(setq major-mode 'wool-interaction-mode)
(setq mode-name "WOOL Interaction")
(lisp-mode-variables ())
(run-hooks 'wool-interaction-mode-hook))
(message "Sorry, need to be running Epoch to work.")))
(defun gwm-buffer ()
"Opens up a new buffer named *GWM* in WOOL interaction mode."
(interactive)
(switch-to-buffer (get-buffer-create "*GWM*"))
(wool-interaction-mode))

337
contrib/gwmchat/gwmchat.c Normal file
View File

@ -0,0 +1,337 @@
/*
gwmchat.c
Author: Anders Holst (aho@nada.kth.se)
Copyright (C) 1994 Anders Holst
This file is copyrighted under the same terms as the rest of GWM
(see the X Inc license for details). There is no warranty that it
works.
Compiles with one of:
gcc -o gwmchat gwmchat.c -lreadline -ltermcap -lX11
gcc -o gwmchat gwmchat.c -DNORL -lX11
*/
#include <stdio.h>
#include <math.h>
#include <stdlib.h>
#include <unistd.h>
#include <malloc.h>
#include <X11/Xatom.h>
#include <X11/X.h>
#include <X11/Xlib.h>
#include <signal.h>
#include <fcntl.h>
#include <sys/wait.h>
#ifndef NORL
char* readline(char* prompt);
void add_history(char* line);
void rl_refresh_line();
#endif
enum killstat {normalgwm, killedgwm, normalchat, killedchat, anysignal};
Display* display;
char* dispName;
Atom gwmprop;
int waiting = 0;
void die(char* str)
{
fprintf(stderr, "gwmchat: %s\n", str);
exit(1);
}
/* The normal "getopt" is not appropriate here */
char* getoptarg(char** argv, char* opt)
{
while (*argv && strcmp(*argv,opt))
argv++;
if (*argv && *(argv+1) && (**(argv+1) != '-'))
return *(argv+1);
else
return 0;
}
/* The normal "getc" and "gets" cannot be called "recursively"
(from eg. a signal handler). */
int readc (FILE* stream)
{
int result;
unsigned char c;
result = read (fileno (stream), &c, sizeof (unsigned char));
if (result == sizeof (unsigned char))
return (c);
return (EOF);
}
char* getline(char* buf, int len)
{
char ch;
char* bp = buf;
int i = 1;
fflush(stdout);
while ((!feof(stdin)) && ((ch = readc(stdin)) != '\n'))
if (i++<len)
*bp++ = ch;
*bp = 0;
return buf;
}
void setSignal(void (*func)())
{
if (signal(SIGINT, func) == BADSIG ||
signal(SIGQUIT, func) == BADSIG ||
signal(SIGTSTP, func) == BADSIG)
die("Setting signals failed");
}
void closeStdin()
{
if (close(0) == -1)
die("Coudn't close stdin");
if (open("/dev/null", O_RDONLY) == -1)
die("Coudn't open /dev/null");
}
void initDisplay(int argc, char** argv)
{
dispName = getoptarg(argv, "-d");
if (!dispName)
dispName = getenv("DISPLAY");
if (!dispName)
die("Could not connect to server. Check your DISPLAY environment variable.\n");
if (!(display = XOpenDisplay(dispName)))
die("Could not connect to server. Check your DISPLAY environment variable.\n");
gwmprop = XInternAtom(display, "GWM_EXECUTE", 0);
if (gwmprop == None)
die("Could not create GWM_EXECUTE property");
XSelectInput(display, DefaultRootWindow(display), PropertyChangeMask);
}
void sendGwm(char* str)
{
int len;
len = strlen(str);
XChangeProperty(display, DefaultRootWindow(display),
gwmprop, XA_STRING, 8, PropModeReplace, str, len);
XFlush(display);
}
void awaitGwm(int wait)
{
XEvent xev;
int done = 0;
if (wait) {
waiting = 1;
while (!done) {
XMaskEvent(display, PropertyChangeMask, &xev);
if (xev.xproperty.atom == gwmprop && xev.xproperty.state == PropertyDelete)
done = 1;
}
waiting = 0;
}
while (XCheckMaskEvent(display, PropertyChangeMask, &xev));
}
void chatloop()
{
char *cmd = NULL;
char buf[512];
#ifdef NORL
char buf2[512];
#endif
while (1) {
#ifndef NORL
if (cmd) free(cmd);
cmd = readline("gwm> ");
#else
fprintf(stdout, "gwm> ");
cmd = getline(buf2, 512);
#endif
if (cmd && cmd[0]) {
#ifndef NORL
add_history(cmd);
#endif
sprintf(buf, "(? %s)", cmd);
awaitGwm(0);
sendGwm(buf);
awaitGwm(1);
sendGwm("t");
awaitGwm(1);
fprintf(stdout, "\n");
} else {
sendGwm("t");
awaitGwm(1);
}
}
}
void chatSignalHandler(int sig)
{
int c;
char buf[20];
fprintf(stdout, "\n");
fprintf(stdout, "Really kill GWM ? ");
c = *getline(buf, 20);
if (c != 'y' && c != 'Y') {
if (waiting)
sendGwm("t"); /* Jog GWM in case of hanging */
else {
#ifndef NORL
rl_refresh_line();
#else
fprintf(stdout, "gwm> ");
fflush(stdout);
#endif
}
return;
}
fprintf(stdout, "Start a shell instead ? ");
c = *getline(buf, 20);
if (c != 'y' && c != 'Y')
exit(0);
else
exit(1);
}
void ignore() /* Not the same as SIG_IGN, but used the same way */
{
if (waiting) sendGwm("t"); /* Jog GWM to get gwmchat going */
}
int startGwm(int argc, char** argv, int chatpid)
{
int pid;
int i;
char** newargv;
char** p;
char *numstr;
/* Add -k flag, to get notification when gwm is ready */
newargv = malloc((argc + 5) * sizeof(char*));
numstr = malloc(20);
for (i=0, p=newargv; i<argc; i++, p++, argv++)
*p = *argv;
*p++ = "-k";
sprintf(numstr, "%d", chatpid);
*p++ = numstr;
*p++ = "-K";
*p++ = "14";
*p = 0;
newargv[0] = "gwm";
switch (pid = fork()) {
case -1:
die("Forking GWM failed");
case 0:
closeStdin();
sigblock(131078);
execvp("gwm", newargv);
die("Failed to start GWM");
}
return pid;
}
int startChat(int argc, char** argv)
{
int pid;
char* tmp;
int GWM_kill_pid, GWM_kill_pid_sig;
/* Reimplement treatment of -k flags */
if ((tmp = getoptarg(argv, "-k")))
GWM_kill_pid = atoi(tmp);
else
GWM_kill_pid = 0;
if ((tmp = getoptarg(argv, "-K")))
GWM_kill_pid_sig = atoi(tmp);
else
GWM_kill_pid_sig = SIGALRM;
switch (pid = fork()) {
case -1:
die("Forking Chat failed");
case 0:
setSignal(chatSignalHandler);
signal(SIGALRM, ignore);
initDisplay(argc, argv);
sigpause(0);
if (GWM_kill_pid)
kill(GWM_kill_pid, GWM_kill_pid_sig);
chatloop();
die("Chat failed");
}
return pid;
}
void startShell(int argc, char** argv)
{
char* shell;
shell = getenv("SHELL");
if (!shell)
shell = "tcsh";
setSignal(SIG_DFL);
fprintf(stdout, "Starting a shell.\n");
argv[0] = shell; argv[1] = 0;
execlp(shell, shell, (char*) 0);
die("Failed to start shell");
}
enum killstat waitfor(int gwmpid, int chatpid)
{
pid_t pid;
union wait status;
pid = wait(&status);
if (pid == chatpid && status.w_status)
return killedchat;
if (pid == chatpid)
return normalchat;
if (pid == gwmpid && status.w_status)
return killedgwm;
if (pid == gwmpid)
return normalgwm;
return anysignal;
}
void main(int argc, char** argv)
{
int chatpid, gwmpid;
setSignal(SIG_IGN);
chatpid = startChat(argc, argv);
gwmpid = startGwm(argc, argv, chatpid);
switch (waitfor(gwmpid, chatpid)) {
case normalgwm:
fprintf(stderr, "GWM exited normally\n");
kill(chatpid, SIGKILL);
break;
case killedgwm:
fprintf(stderr, "GWM was killed\n");
kill(chatpid, SIGKILL);
startShell(argc, argv);
break;
case normalchat:
fprintf(stderr, "GWM was killed by gwmchat\n");
kill(gwmpid, SIGKILL);
break;
case killedchat:
fprintf(stderr, "GWM was killed by gwmchat\n");
kill(gwmpid, SIGKILL);
startShell(argc, argv);
break;
default:
fprintf(stderr, "Something unexpected happened\n");
kill(gwmpid, SIGKILL);
kill(chatpid, SIGKILL);
break;
}
}

59
contrib/gwmchat/gwmchat.readme Normal file
View File

@ -0,0 +1,59 @@
Date: Wed, 8 Jun 1994 20:29:54 +0200
From: Anders Holst <aho@sans.kth.se>
Message-Id: <199406081829.AA16250@thalamus.sans.kth.se>
To: gwm-talk@mirsa.inria.fr
Subject: gwmchat - an interactive shell to gwm
This is my contribution to the discussion about easier interaction
with gwm. It is a small program that is compiled separately from gwm.
When started it forks off a gwm-process, and then feeds text from
stdin to gwm. (It actually starts a third process also, that waits for
any of the other two to die, and which catches signals).
I saw (after already having written it) that Sven Wischnowsky
(oberon@cs.tu-berlin.de) actually had written a patch to gwm with much
the same effect (ie. making it read commands from stdin). That is
of course the right solution. However my program can be useful for
those which have no permission, or time, to change the version
installed on their machine.
Just compile gwmchat with one of the two commands below, and start it
with the same flags as you would have started gwm (eg. "gwmchat -f
mwm"). From your .xinitrc or .xsession or wherever gwm is started now,
you can say something like "xterm -e gwmchat -f mwm;".
NOTE: I have only tried it out on DEC-stations (with Ultrix), and on
Sun4:s. I have no idea if it works on other machines !
Also, it assumes that gwm is in your path.
There is one small problem though - I tried to make it use readline,
but I can't get it to work properly. Readline keeps mangling up the
prompt when walking around in the history list, or editing the
command. This is because the prompt is not written out through
readline, but through gwm, to make it sync with the result. Thus
readline knows of no prompt, and sometimes redraws the whole line. I
can't seem to get around this.
Therefore there are two different ways to compile the program. Use:
gcc -o gwmchat gwmchat.c -lreadline -liberty -ltermcap -lX11
if you want to try the readline interface. If you don't have readline,
or it behaves too strangely at your place, try this instead:
gcc -o gwmchat gwmchat.c -DNORL -lX11
This will however give no commandline editing whatsoever, not even
going backwards or forwards with the arrows. So a recommendation, to
make it acceptable, is that gwmchat is started within an emacs
shell, and thus can rely on emacs editing, completion, and history
commands.
I'm sure you can find various strange behaviors from it. (For example I
sometimes get a strange message about "swap error" when gwm exits, and
I can't figure out what is wrong.) However I find it very useful
already now.
Enough talk. Here follows the code.
Anders Holst (aho@sans.kth.se)

64
contrib/gwmsend/gwmsend.c Normal file
View File

@ -0,0 +1,64 @@
/*
gwmsend.c
Author: Anders Holst (aho@nada.kth.se)
Copyright (C) 1994 Anders Holst
This file is copyrighted under the same terms as the rest of GWM
(see the X Inc license for details). There is no warranty that it
works.
Compiles with:
gcc -o gwmsend gwmsend.c -L/usr/lib/X11R6 -lX11
Usage:
gwmsend 'WOOL-expression'
*/
/* Colas Nahaboo <colas@sa.inria.fr> 22 July 1995:
* XChangeProperty now in PropModeAppend to avoid race conditions
*/
#include <stdio.h>
#include <stdlib.h>
#include <X11/Xatom.h>
#include <X11/X.h>
#include <X11/Xlib.h>
Display* display;
char* dispName;
Atom gwmprop;
char buf[512];
void die(char* str)
{
fprintf(stderr, str);
exit(1);
}
int initDisplay()
{
if (!(dispName = getenv("DISPLAY")))
return 0;
if (!(display = XOpenDisplay(dispName)))
return 0;
gwmprop = XInternAtom(display, "GWM_EXECUTE", 1);
if (gwmprop == None)
return 0;
return 1;
}
void sendGwm(char* str)
{
int len;
sprintf(buf, "(? %s \"\\n\")", str);
len = strlen(buf);
XChangeProperty(display, DefaultRootWindow(display),
gwmprop, XA_STRING, 8, PropModeAppend, buf, len);
XFlush(display);
}
void main(int argc, char** argv)
{
if (argc != 2)
die("Usage: gwmsend 'expression'\n");
if (!initDisplay())
die("Could not connect to server. Check your DISPLAY environment variable.\n");
sendGwm(argv[1]);
}

26
contrib/gwmsh/ChangeLog Normal file
View File

@ -0,0 +1,26 @@
Fri Sep 30 17:36:38 1994 Valeriy E. Ushakov <uwe@niif.spb.su>
* version 1.0 relesed.
* Makefile: New targets for creating distributions.
* gwmsh.c (xmalloc): New function. In case there's no -liberty.
Thu Sep 29 18:29:40 1994 Valeriy E. Ushakov <uwe@niif.spb.su>
* rcshead: New file. Auxilary shell script.
* gwmsh.c (get_window_property_string): Now read initial portion
of property value and read the rest if any. (original scheme read
zero bytes to determine the size and then slurped the whole value).
* version.c: Initial revision
Wed Sep 21 20:50:49 1994 Valeriy E. Ushakov <uwe@niif.spb.su>
* gwmsh.c:
Fixed typo in declaration of get_window_property_string argument dpy.
It's a Display* -- silly typo.
* Makefile, gwmsh.c: Initial revision

124
contrib/gwmsh/Makefile Normal file
View File

@ -0,0 +1,124 @@
# $Id: gwm.shar,v 1.115 1995/12/08 07:51:55 colas Exp $
#
# $Log: gwm.shar,v $
# Revision 1.115 1995/12/08 07:51:55 colas
# ********************
# *** Version 1.8c ***
# ********************
#
* Revision 1.100 1995/05/29 15:56:57 colas
* simple-win.gwm: new parameters:
* label like simple-icon
* legend to place the label on sides of window
* lpad and rpad: number of () to pad the label with stretchable space
* bar-max-wdths set by default to 1000
*
* John Carr <jfc@MIT.EDU>: patches to supress warnings on AIX/RS_6000/xlc
* rxterm install fixed once more
*
* Revision 1.97 1995/05/16 16:16:36 colas
* contrib/scripts/find-bar-nils
*
# Revision 1.5 1995/05/15 22:29:34 colas
# bar can have abitrary shaped backgrounds (shaped tiles)
#
* Revision 1.95 1995/05/11 17:06:56 colas
* better spy
*
* Revision 1.93 1995/04/26 16:34:51 colas
* Makefile added in distrib
*
* simple-icon.gwm:
*
* - customize item "legend" can now be instead of () or t the strings:
* "top" "base" "right" "left" for the positions where you want the string
* to appear
* e.g: (customize simple-icon any XTerm "left")
*
* - new customization item "label" to provide either a fixed string or a
* lambda which will be used to filter the label
* must return a non-empty string otherwise the unfiltered label is used
* e.g: to supress the Netscape: in netscape icon titles
* (customize simple-icon any Netscape
* label (lambdaq (s) (match "Netscape: \\(.*\\)$" s 1))
* )
*
* iconify a window doesnt not loose the window anymore in case of error in wool
* code
*
* Revision 1.92 1995/04/25 14:31:09 colas
* *** Version 1.7p_beta_2 ***
*
# Revision 1.3 1994/09/30 18:55:08 uwe
# Distribution targets uses parent directory to keep
# emacs VC happy when making snapshots.
#
# Revision 1.2 1994/09/30 17:40:28 uwe
# New targets for creating distributions.
#
# Revision 1.1 1994/09/21 20:48:22 uwe
# Initial revision
#
PROG = gwmsh
all: $(PROG)
SRCS = gwmsh.c version.c
OBJS = gwmsh.o version.o
NONSRCS = Makefile rcshead ChangeLog PATCH-GWM README
THINGS_TO_RELEASE = $(SRCS) $(NONSRCS)
LN = ln
TAR = gtar -v
COMPRESS= gzip -9
SHAR = shar -o
CC = gcc
CDEBUG = -ggdb3 -Wall -Wshadow
#CC = cc
#CDEBUG = -g
CINC = -I/usr/openwin/include -I/usr/gnu/include
CDEFS = -DUSE_READLINE # -DNO_LIBERTY
CFLAGS = $(CDEBUG) $(CINC) $(CDEFS)
READLINE= -lreadline -ltermcap
LIBS = $(READLINE) -liberty -lX11 -lm
LDFLAGS = -L/usr/gnu/lib -L/usr/openwin/lib
$(PROG): $(OBJS)
$(CC) -o $(PROG) $(OBJS) $(LDFLAGS) $(LIBS)
clean:
-rm -f core $(PROG) $(OBJS)
new: clean $(PROG)
distdir: $(THINGS_TO_RELEASE)
@RELEASE=$(PROG)-`./rcshead version.c`;\
echo Creating "$$RELEASE" in parent directory;\
rm -rf ../"$$RELEASE";\
mkdir ../"$$RELEASE";\
$(LN) $(THINGS_TO_RELEASE) ../"$$RELEASE"
tardist: distdir
@RELEASE=$(PROG)-`./rcshead version.c`;\
echo Making tar archive;\
cd ..;\
$(TAR) -c -v -f "$$RELEASE".tar $$RELEASE
tgzdist: tardist
@RELEASE=$(PROG)-`./rcshead version.c`;\
echo Compressing tar archive;\
cd ..;\
$(COMPRESS) "$$RELEASE".tar
shardist: distdir
@RELEASE=$(PROG)-`./rcshead version.c`;\
echo Making shar archive;\
cd ..;\
$(SHAR) "$$RELEASE".part "$$RELEASE"

106
contrib/gwmsh/PATCH-GWM Normal file
View File

@ -0,0 +1,106 @@
This will give you with-output-to-string function
gwmsh uses to get back results from gwm.
(with-output-to-string
<form1>
...
<formN>)
Forms are evaluated as in prog, but all output from calls to print
is directed to string returned as with-output-to-string value.
diff -c gwm-1.7o-dist/wool.c gwm-1.7o/wool.c
*** gwm-1.7o-dist/wool.c Fri Sep 30 21:06:51 1994
--- gwm-1.7o/wool.c Fri Sep 30 21:07:17 1994
***************
*** 1145,1150 ****
--- 1145,1186 ----
return result;
}
+ /*XXX-UWE-XXX*/
+ static int expand_string_stream ();
+
+ WOOL_OBJECT
+ wool_with_output_to_string (argc, argv)
+ int argc;
+ WOOL_OBJECT *argv;
+ {
+ WOOL_STRING_STREAM str, WOOL_STRING_STREAM_make ();
+ int old_type;
+ char *old_stream;
+ WOOL_OBJECT result;
+
+ str = WOOL_STRING_STREAM_make (256, expand_string_stream);
+ old_type = wool_output_redirect (1, str, &old_stream);
+ progn (argc, argv);
+ wool_output_redirect (old_type, old_stream, NULL);
+
+ result = (WOOL_OBJECT) WLString_make (str->buffer);
+ WOOL_STRING_STREAM_free (str);
+ return result;
+ }
+
+ static int
+ expand_string_stream (str)
+ WOOL_STRING_STREAM str;
+ {
+ char *new_buf;
+ int nbytes = str->last - str->buffer + 1;
+ int ptr_pos = str->ptr - str->buffer;
+
+ str->buffer = Realloc (str->buffer, 2*nbytes);
+ str->last = str->buffer + nbytes - 1;
+ str->ptr = str->buffer + ptr_pos;
+ }
+ /*XXX-UWE-XXX*/
/*
* (progn inst1 ... instn)
* evals the n instructions then return the last one's result
***************
*** 1987,1992 ****
--- 2023,2032 ----
wool_subr_make(WLSubr, shell, "!", NARY);
increase_reference(wool_atom("print") -> c_val =
wool_subr_make(WLSubr, wool_print_nary, "?", NARY));
+ /*XXX-UWE-XXX*/
+ wool_subr_make(WLFSubr, wool_with_output_to_string,
+ "with-output-to-string", NARY);
+ /*XXX-UWE-XXX*/
wool_subr_make(WLSubr, not, "not", 1);
wool_subr_make(WLFSubr, and, "and", NARY);
wool_subr_make(WLFSubr, or, "or", NARY);
diff -c gwm-1.7o-dist/wool.flex gwm-1.7o/wool.flex
*** gwm-1.7o-dist/wool.flex Fri Sep 30 21:06:51 1994
--- gwm-1.7o/wool.flex Fri Sep 30 21:07:17 1994
***************
*** 135,142 ****
yyoutflush(){
if(yyout_is_string){
ASSERT(yystrout->overflow_handler);
! (*(yystrout->overflow_handler))(yystrout->buffer);
! yystrout->ptr = yystrout-> buffer;
}else{
fflush(yyout);
}
--- 135,144 ----
yyoutflush(){
if(yyout_is_string){
ASSERT(yystrout->overflow_handler);
! /*XXX-UWE-XXX*/
! (*(yystrout->overflow_handler))(yystrout);
! /* yystrout->ptr = yystrout-> buffer; */
! /*XXX-UWE-XXX*/
}else{
fflush(yyout);
}
***************
*** 271,276 ****
--- 273,279 ----
WOOL_STRING_STREAM str = (WOOL_STRING_STREAM)
Malloc(sizeof(struct _WOOL_STRING_STREAM));
str->buffer = (char *) Malloc(nbytes);
+ *str->buffer = '\0'; /*XXX-UWE-XXX*/
str->ptr = str->buffer;
str->last = str->buffer + nbytes -1;
str->overflow_handler = handler;

16
contrib/gwmsh/README Normal file
View File

@ -0,0 +1,16 @@
GWMSH-1.0
This program is a simple interface to gwm. To use it you should apply
my patch to gwm-1.7o (enclosed in the distribution) that gives you
with-output-to-string gwm built-in function. Gwmsh uses this function
to retrieve from gwm results of any type in printed form.
NOTE: no need to apply this patch in 1.8 or later, as it is included
I found this program useful for quick examination of gwm variables
or test runs of newly defined functions. Use it if you like it. Any
comments and suggestions are greatly appreciated.
Enjoy.
Uwe. <uwe@niif.spb.su>

879
contrib/gwmsh/gwmsh.c Normal file
View File

@ -0,0 +1,879 @@
/* gwmsh.c - Simple minded gwm interface
*
* Copyright (C) 1994 Valeriy E. Ushakov
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, you can either send email to this
* program's author (see below) or write to:
*
* The Free Software Foundation, Inc.
* 675 Mass Ave.
* Cambridge, MA 02139, USA.
*
* Please send bug reports, etc. to uwe@niif.spb.su
*
* Description:
*
* This programm is intended to be a simple line oriented interface
* to GWM. Besides all, it was written for learning purposes (being my
* first X hack). Canonical GNU Emacs have no interface to x11 so this
* might be a kind of quick and dirty solution for this, thou this
* part is yet to be written.
*
* $Id: gwm.shar,v 1.115 1995/12/08 07:51:55 colas Exp $
*
* $Log: gwm.shar,v $
* Revision 1.115 1995/12/08 07:51:55 colas
* ********************
* *** Version 1.8c ***
* ********************
*
* Revision 1.100 1995/05/29 15:56:57 colas
* simple-win.gwm: new parameters:
* label like simple-icon
* legend to place the label on sides of window
* lpad and rpad: number of () to pad the label with stretchable space
* bar-max-wdths set by default to 1000
*
* John Carr <jfc@MIT.EDU>: patches to supress warnings on AIX/RS_6000/xlc
* rxterm install fixed once more
*
* Revision 1.97 1995/05/16 16:16:36 colas
* contrib/scripts/find-bar-nils
*
# Revision 1.5 1995/05/15 22:29:34 colas
# bar can have abitrary shaped backgrounds (shaped tiles)
#
* Revision 1.95 1995/05/11 17:06:56 colas
* better spy
*
* Revision 1.93 1995/04/26 16:34:51 colas
* Makefile added in distrib
*
* simple-icon.gwm:
*
* - customize item "legend" can now be instead of () or t the strings:
* "top" "base" "right" "left" for the positions where you want the string
* to appear
* e.g: (customize simple-icon any XTerm "left")
*
* - new customization item "label" to provide either a fixed string or a
* lambda which will be used to filter the label
* must return a non-empty string otherwise the unfiltered label is used
* e.g: to supress the Netscape: in netscape icon titles
* (customize simple-icon any Netscape
* label (lambdaq (s) (match "Netscape: \\(.*\\)$" s 1))
* )
*
* iconify a window doesnt not loose the window anymore in case of error in wool
* code
*
* Revision 1.92 1995/04/25 14:31:09 colas
* *** Version 1.7p_beta_2 ***
*
* Revision 1.3 1994/09/30 17:36:38 uwe
* (get_window_propety_string): Is smarter now. It reads some portion of property and make
* second query only if property value was not read completely at first try.
* (xmalloc): New function. In case there's no -liberty.
*
* Revision 1.2 1994/09/21 20:50:49 uwe
* Fixed typo in declaration of get_window_property_string argument dpy.
* It's a Display* -- silly typo.
*
* Revision 1.1 1994/09/21 20:35:42 uwe
* Initial revision
*
*/
#ifdef sun4 /* XXX: This belongs elsewhere */
# define HAVE_ALLOCA_H
#endif
#ifdef HAVE_ALLOCA_H
# include <alloca.h>
#endif
#include <signal.h>
#include <setjmp.h>
#include <ctype.h>
#if defined(USG) || defined(_POSIX_VERSION)
# include <string.h>
#else
# include <strings.h>
#endif
#include <stdio.h>
#include <getopt.h>
#include <varargs.h>
#include <X11/Xlib.h>
#include <X11/Xatom.h>
#ifdef USE_READLINE
#include <readline/readline.h>
#include <readline/history.h>
#else
char *readline ();
#endif
#ifndef __STDC__
# ifdef __GNUC__
# define const __const__
# define volatile __volatile__
# else /* !__STDC__ && !__GNUC__ */
# define const
# define volatile
# endif
#endif /* !__STDC__ */
#ifdef __GNUC__
# define NORETURN __attribute__ ((noreturn))
#else
# define NORETURN
#endif
/* Application name */
char *progname;
/* Command line options */
int under_emacs_p;
int query_only_p;
int use_WINDOWID_p;
char *gwm_single_command = NULL;
/* Type of windows to apply batch commands to */
int all_p;
int icon_p;
int main_p;
int mapped_p;
int stacking_p;
/* any of icon main mapped stacking*/
int all_specific_p;
/* X realted globals */
char *display_name = NULL; /* Use $DISPLAY by default */
Display *dpy; /* Display */
Screen screen_num; /* Screen number */
Window working_window; /* Window to communicate with GWM */
Atom XA_GWM_RUNNING; /* Whether gwm is running */
Atom XA_GWM_EXECUTE; /* Text for gwm to execute */
Atom XA_GWM_RESULT; /* To get eval result from gwm */
/* Shell functions */
char *get_gwm_form ();
void gwm_shell () NORETURN; /* Shell motor function */
void gwmsh_eval_print ();
void gwmsh_eval_print_for_all ();
/* Communication */
Bool gwm_running_p ();
void gwm_execute ();
unsigned char *gwm_get_result ();
/* Window functions */
Bool window_valid_p ();
Bool find_window_in_hierarchy ();
unsigned char *get_window_property_string ();
/* Jump buffer to handle intrs while reading */
jmp_buf intr_while_reading;
void abort_result_waiting_loop ();
/* Auxilary staff */
char *save_optarg ();
volatile void barf () NORETURN;
volatile void die () NORETURN;
char *xmalloc ();
void free ();
/*
* Function: usage
*
* Prints out on stderr usage summary
*
* Returns: Nothing
* Parameters: None
*/
void
usage ()
{
fputs ("--all -A For all windows\n\
--command -c Execute the command.\n\
--emacs -e Run gwmsh from under emacs. Not intended for ordinary use.\n\
--help -h Print this usage and exit successfully.\n\
--icons -I For all icons\n\
--main -W For all main windows\n\
--mapped -M For all mapped\n\
--query -q Query if GWM is running\n\
--stacking -S For all in stacking order\n\
--window -w Use $WINDOWID window to communicate with GWM.\n",
stderr);
}
/*
* Function: main
*
* I'm not *THAT* bore.
*/
void
main (ac, av)
int ac;
char **av;
{
char *s;
progname = av[0];
if (s = rindex (progname, '/'))
progname = s+1;
for (;;) {
static const struct option long_option[] = {
{ "all", no_argument, 0, 'A'},
{ "command", required_argument, 0, 'c'},
{ "display", required_argument, 0, 'd'},
{ "emacs", no_argument, &under_emacs_p, 1 },
{ "help", no_argument, 0, 'h'},
{ "icon", no_argument, 0, 'I'},
{ "main", no_argument, 0, 'W'},
{ "mapped", no_argument, 0, 'M'},
{ "query", no_argument, &query_only_p, 1 },
{ "stacking",no_argument, 0, 'S'},
{ "window", no_argument, &use_WINDOWID_p, 1 },
{ NULL, 0, 0, 0}
};
int option_index = 0;
int c = getopt_long_only (ac, av, "c:ehqwAIMSW", long_option, &option_index);
if (c == EOF)
break;
option_switch:
switch (c) {
case 0: /* Non-flag long option. */
/*Pass it along to the code that handles short one */
c = long_option[option_index].val;
goto option_switch;
case 1:
break;
case 'c':
save_optarg (&gwm_single_command);
break;
case 'd': /* !!! This is NOT in short options !!! */
save_optarg (&display_name);
break;
case 'e':
under_emacs_p = 1;
break;
case 'h':
usage ();
die (0);
break;
case 'q':
query_only_p = 1;
break;
case 'w':
use_WINDOWID_p = 1;
break;
case 'A':
all_p = 1;
break;
case 'I':
icon_p = 1;
break;
case 'M':
mapped_p = 1;
break;
case 'S':
stacking_p = 1;
break;
case 'W':
main_p = 1;
break;
case '?':
usage ();
die (1);
break;
default:
barf ("panic, getopt returned 0%o\n", c);
}
}
if (main_p && icon_p)
barf ("-I and -W are mutually exclusive");
all_specific_p = icon_p || main_p || mapped_p || stacking_p;
if (all_p && all_specific_p)
barf ("-A should be the only option");
dpy = XOpenDisplay (display_name);
if (dpy == NULL)
barf ("Cannot open display %s", XDisplayName (display_name));
/* Check for GWM running */
if (!gwm_running_p ())
barf ("GWM is not running on %s", XDisplayName(display_name));
else if (query_only_p)
die (0);
/* Get window we will use to communicate to GWM */
if (use_WINDOWID_p) {
extern char *getenv ();
char *wid = getenv ("WINDOWID");
if (!wid)
barf ("No WINDOWID environment variable");
if (!sscanf (wid, "%ld", &working_window))
barf ("corrupted $WINDOWID = %ld", wid);
if (!window_valid_p (working_window))
barf ( "Invalid window %ld", working_window);
}
else {
working_window = DefaultRootWindow (dpy);
}
/* Create atoms to comunicate with GWM */
XA_GWM_EXECUTE = XInternAtom (dpy, "GWM_EXECUTE", True);
if (XA_GWM_EXECUTE == None)
barf ("Can't intern GWM_EXECUTE");
XA_GWM_RESULT = XInternAtom (dpy, "GWM_RESULT", False);
if (XA_GWM_RESULT == None)
barf ("Can't intern GWM_RESULT");
XSelectInput (dpy, working_window, PropertyChangeMask);
signal (SIGINT, SIG_IGN);
/* Ok, we are ready to pass commands to GWM */
if (all_p || all_specific_p) {
/* XXX: More consistent batch commands parsing*/
char *spec = alloca (100); /* XXX: Magic number here */
spec [0] = '\0';
if (icon_p)
strcat (spec, " 'icon");
else if (main_p)
strcat (spec, " 'window");
if (mapped_p)
strcat (spec, " 'mapped");
if (stacking_p)
strcat (spec, " 'stacking-order");
if (gwm_single_command)
gwmsh_eval_print_for_all (spec, gwm_single_command);
else
/* XXX: Would wrapping them all together be more logical? */
while (optind < ac)
gwmsh_eval_print_for_all (spec, av[optind++]);
}
else if (gwm_single_command)
gwmsh_eval_print (gwm_single_command);
else
gwm_shell ();
die (0);
}
/*
* Function: gwm_running_p
*
* Check if gwm is running on the display
*
* Returns: Bool
-
* Parameters: None
*/
Bool
gwm_running_p ()
{
/* Hidden window GWM creates */
Window gwm_window;
Status result;
Atom actual_type;
int actual_format;
unsigned long nitems;
unsigned long bytes_after;
Window *gwm_window_id_ptr;
/* Check for GWM_RUNNING presence */
XA_GWM_RUNNING = XInternAtom (dpy, "GWM_RUNNING", True);
if (XA_GWM_RUNNING == None)
return (False);
/* Make shure that GWM_RUNNING is valid */
result = XGetWindowProperty (dpy, DefaultRootWindow (dpy), XA_GWM_RUNNING,
0l, 1l, False, XA_GWM_RUNNING,
&actual_type, &actual_format,
&nitems, &bytes_after,
(unsigned char **) &gwm_window_id_ptr);
if (!((result == Success)
&& (actual_type == XA_GWM_RUNNING)
&& (actual_format == 32)
&& (nitems == 1)
&& (bytes_after == 0)))
barf ("XGetWindowProperty failed to read GWM_RUNNING");
gwm_window = *gwm_window_id_ptr;
XFree ((void *) gwm_window_id_ptr);
/* Well, make shure gwm_window exists */
return (window_valid_p (gwm_window));
}
/*
* Function: gwm_shell
*
* Shell read - pass to gwm - read from gwm - print loop
*
* Returns: Never
* Parameters: None
*/
void
gwm_shell ()
{
char *form;
for (;;) {
form = get_gwm_form ("gwm> ");
if (!form) {
putchar ('\n');
die (0);
}
gwmsh_eval_print (form);
}
}
/*
* Function: gwmsh_eval_print
*
* Prints out result of text evaluation.
*
* Returns: Nothing
* Parameters: text - gwm form to pass to gwm_execute after wrapping
* it so that result would come to us via GWM_RESULT property.
*/
void
gwmsh_eval_print (text)
char *text;
{
char *gwm_command;
char *gwm_result;
gwm_command = alloca (strlen (text) + 200); /* XXX: Magic numer here */
sprintf (gwm_command,
"(set-x-property \"GWM_RESULT\"\
(with-output-to-string\
(if (error-occurred (? %s))\
(? \"Wool Error\"))))", text);
gwm_execute (gwm_command, False);
gwm_result = gwm_get_result ();
if (gwm_result) {
fputs (gwm_result, stdout);
fputc ('\n', stdout);
free (gwm_result);
}
}
/*
* Function: gwmsh_eval_print_for_all
*
* Wrap up text in the loop thru all windows and pass it to
* gwmsh_eval_print.
*
* Returns: Nothing
* Parameters: spec - Loop thru this kind of windows only.
* text - Command to be executes for these windows.
*/
void
gwmsh_eval_print_for_all (spec, text)
char *spec;
char *text;
{
char *gwm_command;
gwm_command = alloca (strlen (text) + 50); /* XXX: magic number here */
sprintf (gwm_command, "(for window (list-of-windows %s) %s)", spec, text);
gwmsh_eval_print (gwm_command);
}
/*
* Function: gwm_execute
*
* Pass text to gwm via GWM_EXECUTE property. Sync with server
* according to sync_p flag.
*
* Returns: Nothing
* Parameters: text - Pointer to gwm form to be passed to gwm
* sync_p - Should we sync with server
*/
void
gwm_execute (text, sync_p)
char *text;
Bool sync_p;
{
XChangeProperty (dpy, working_window, XA_GWM_EXECUTE,
XA_STRING, 8, PropModeReplace,
text, strlen (text) + 1);
if (sync_p)
XSync (dpy, False);
}
/*
* Function: abort_result_waiting_loop (signal hanldler).
*
* Aborts the gwm_get_result event waiting loop upon SIGINT.
*
* Returns: Nothing
* Parameters: None
*/
void
abort_result_waiting_loop ()
{
longjmp (intr_while_reading, 1);
}
/*
* Function: gwm_get_result
*
* Looks for the result returned by gwm in GWM_RESULT property.
*
* Returns: char *
-
* Parameters: None
*/
unsigned char *
gwm_get_result ()
{
XEvent ev;
unsigned char *gwm_result = NULL;
if (setjmp (intr_while_reading)) {
signal (SIGINT, SIG_IGN);
gwm_result = "Inerrupted";
goto deliver_result;
}
signal (SIGINT, abort_result_waiting_loop);
/* Get evaluation result from GWM_RESULT property */
for (;;) {
XNextEvent (dpy, &ev);
switch (ev.type) {
case PropertyNotify:
if ((ev.xproperty.atom == XA_GWM_RESULT)
&& (ev.xproperty.state == PropertyNewValue)) {
gwm_result = get_window_property_string (dpy, working_window,
XA_GWM_RESULT, True);
if (!gwm_result)
fputs ("Error reading GWM_RESULT.\n", stderr);
goto deliver_result;
}
break; /* to next event */
default:
fprintf (stderr, "Unexpected event %d ignored\n", ev.type);
}
}
deliver_result:
signal (SIGINT, SIG_IGN);
return gwm_result;
}
/* --------------------------------------
* Utility functions to deal with windows
*/
/*
* Function: get_window_property_string
*
* Looks for the given property of type XA_STRING and arbitrary
* length. If anyone know better way of doing this, please fix.
*
* Returns: char *
-
* Parameters: dpy - Display
* w - Window
* prop - Property to be read
* delete_p - Delete it?
*/
#define INITIAL_QUERY_LEN 20l
unsigned char *
get_window_property_string (dpy, w, prop, delete_p)
Display *dpy; /* XXX: shadows global dpy */
Window w;
Atom prop;
Bool delete_p;
{
Status retcode;
Atom actual_type;
int actual_format;
unsigned long nitems;
unsigned long bytes_after;
unsigned char *buf = NULL;
unsigned long len;
unsigned long already_read;
unsigned long real_size_in_bytes;
unsigned char *prop_val;
retcode = XGetWindowProperty (dpy, w, prop,
0l, INITIAL_QUERY_LEN, False, XA_STRING,
&actual_type, &actual_format,
&nitems, &bytes_after,
&buf);
if ((actual_type != XA_STRING)
|| (actual_format != 8)) {
XFree (buf);
return NULL;
}
real_size_in_bytes = nitems + bytes_after;
already_read = nitems;
prop_val = (unsigned char *) xmalloc (real_size_in_bytes + 1);
memcpy (prop_val, buf, nitems + 1); /* Including trailing null! */
XFree (buf);
if (!bytes_after)
return prop_val;
len = (bytes_after + 3) / 4;
retcode = XGetWindowProperty (dpy, w, prop,
INITIAL_QUERY_LEN, len, delete_p, XA_STRING,
&actual_type, &actual_format,
&nitems, &bytes_after,
&buf);
if ((retcode != Success)
|| (actual_type != XA_STRING)
|| (actual_format != 8)) {
XFree (buf);
free (prop_val);
return NULL;
}
memcpy (prop_val + already_read, buf, nitems + 1);
XFree (buf);
return prop_val;
}
/*
* Function: window_valid_p
*
* Whether gived window id is valid
*
* Returns: Bool
-
* Parameters: w - Window to validate
*/
Bool
window_valid_p (w)
Window w;
{
/* XXX: Any simpler way to walidate window ??? */
return find_window_in_hierarchy (DefaultRootWindow (dpy), w);
}
/*
* Function: find_window_in_hierarchy
*
* Status of search for the given window in the hierarchy
*
* Returns: Bool
-
* Parameters: hier_root - Window hierarchy root
* sought_win - Window sought
*/
Bool
find_window_in_hierarchy (hier_root, sought_win)
Window hier_root;
Window sought_win;
{
int found = False;
int child_no;
Window root_ignored;
Window parent_ignored;
Window *child;
int n_children;
XQueryTree (dpy, hier_root, &root_ignored, &parent_ignored,
&child, &n_children);
/* Search it breadth first, for sought_win is most likely the top one */
for (child_no = 0; child_no < n_children; ++child_no)
if (child[child_no] == sought_win) {
found = True;
goto done;
}
/* Hmm. It's not here try to recurse */
for (child_no = 0; child_no < n_children; ++child_no)
if (find_window_in_hierarchy (child[child_no], sought_win)) {
found = True;
goto done;
}
done:
XFree ((void *) child);
return (found);
}
/* --------------------------------
* Misc functions to make life easy
*/
/*
* Function: get_gwm_form
*
* Generic wrapper for read. One day it might look after parens and
* allow multiple line commands.
*
* Returns: char *
-
* Parameters: prompt
*/
char *
get_gwm_form (prompt)
char *prompt;
{
static char *line_read = NULL;
register char *s;
if (line_read) {
free (line_read);
line_read = NULL;
}
s = line_read = readline (prompt);
if (s) {
while (isspace (*s))
++s;
if (*s)
add_history (s);
}
return s;
}
#ifndef USE_READLINE
#define BUFSIZE 1000
/*
* Function: readline
*
* Cheap plastic imitation of GNU readline.
*
* Returns: char *
-
* Parameters: prompt
*/
char *
readline (prompt)
char *prompt;
{
char buf[BUFSIZE+2];
if (prompt)
fputs (prompt, stdout);
return fgets (buf, BUFSIZE, stdin);
}
#endif /* !USE_READLINE */
/*
* Function: save_optarg
*
* Rather silly function that just copies global optarg where told.
*
* Returns: char *
-
* Parameters: to - place to copy to
*/
char *
save_optarg (to)
char **to;
{
*to = xmalloc (strlen (optarg) + 1);
return strcpy (*to, optarg);
}
/*
* Function: barf
*
* Barf and die.
*
* Returns: Never
* Parameters: Those of printf
*/
volatile void
barf (va_alist)
va_dcl
{
va_list ap;
register char *format;
fprintf (stderr, "%s: ", progname);
va_start (ap);
format = va_arg (ap, char *);
vfprintf (stderr, format, ap);
va_end (ap);
fputc ('\n', stderr);
die (1);
}
/*
* Function: die
*
* Nothing is permanent.
*
* Returns: Never
* Parameters: code - to return upon exit
*/
volatile void
die (code)
int code;
{
if (dpy != NULL)
XCloseDisplay (dpy);
exit (code);
}
#ifdef NO_LIBERTY
/*
* Function: xmalloc
*
* Malloc wrapper. Exits on malloc failure.
*
* Returns: char *
-
* Parameters: size - size
*/
char *
xmalloc (size)
unsigned size;
{
char *malloc ();
char *s = malloc (size);
if (!s)
barf ("Out of core");
return s;
}
#endif

14
contrib/gwmsh/rcshead Executable file
View File

@ -0,0 +1,14 @@
#!/bin/sh
#
# Usage:
# rcshead file
#
# Prints head revision number of the specified file.
#
if [ x"$1" = x ]; then
echo usage: rschead file 1>&2
exit 1
fi
rlog $1 | sed -n 's/^head: *//p'

79
contrib/gwmsh/version.c Normal file
View File

@ -0,0 +1,79 @@
/* version.c - Tracking releases
*
* Copyright (C) 1994 Valeriy E. Ushakov
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, you can either send email to this
* program's author (see below) or write to:
*
* The Free Software Foundation, Inc.
* 675 Mass Ave.
* Cambridge, MA 02139, USA.
*
* Please send bug reports, etc. to uwe@niif.spb.su
*
* $Log: gwm.shar,v $
* Revision 1.115 1995/12/08 07:51:55 colas
* ********************
* *** Version 1.8c ***
* ********************
*
* Revision 1.100 1995/05/29 15:56:57 colas
* simple-win.gwm: new parameters:
* label like simple-icon
* legend to place the label on sides of window
* lpad and rpad: number of () to pad the label with stretchable space
* bar-max-wdths set by default to 1000
*
* John Carr <jfc@MIT.EDU>: patches to supress warnings on AIX/RS_6000/xlc
* rxterm install fixed once more
*
* Revision 1.97 1995/05/16 16:16:36 colas
* contrib/scripts/find-bar-nils
*
# Revision 1.5 1995/05/15 22:29:34 colas
# bar can have abitrary shaped backgrounds (shaped tiles)
#
* Revision 1.95 1995/05/11 17:06:56 colas
* better spy
*
* Revision 1.93 1995/04/26 16:34:51 colas
* Makefile added in distrib
*
* simple-icon.gwm:
*
* - customize item "legend" can now be instead of () or t the strings:
* "top" "base" "right" "left" for the positions where you want the string
* to appear
* e.g: (customize simple-icon any XTerm "left")
*
* - new customization item "label" to provide either a fixed string or a
* lambda which will be used to filter the label
* must return a non-empty string otherwise the unfiltered label is used
* e.g: to supress the Netscape: in netscape icon titles
* (customize simple-icon any Netscape
* label (lambdaq (s) (match "Netscape: \\(.*\\)$" s 1))
* )
*
* iconify a window doesnt not loose the window anymore in case of error in wool
* code
*
* Revision 1.92 1995/04/25 14:31:09 colas
* *** Version 1.7p_beta_2 ***
*
* Revision 1.0 1994/09/29 18:29:40 uwe
* Initial revision
*
*/
static char *Version = "$Id: gwm.shar,v 1.115 1995/12/08 07:51:55 colas Exp $";

286
contrib/lisp-modes/amc-lisp.el Normal file
View File

@ -0,0 +1,286 @@
;; Copyright 1990 Alan M. Carroll
;;
;; Permission to use, copy, modify, and distribute this software and its
;; documentation for any purpose and without fee is hereby granted, provided
;; that the above copyright notice appear in all copies and that both that
;; copyright notice and this permission notice appear in supporting
;; documentation, and that the name of Alan M. Carroll not be used in
;; advertising
;; or publicity pertaining to distribution of the software without specific,
;; written prior permission. Alan M. Carroll makes no representations about the
;; suitability of this software for any purpose. It is provided "as is"
;; without express or implied warranty.
;;
;; Alan M. Carroll disclaims all warranties with regard to this software,
;; including all implied warranties of merchantability and fitness,
;; in no event shall Alan M. Carroll be liable for any special,
;; indirect or consequential damages or any damages
;; whatsoever resulting from loss of use, data or profits,
;; whether in an action of contract, negligence or other tortious
;; action, arising out of or in connection with the use
;; or performance of this software.
(defvar lisp-indent-level 2
"*Indentation of Lisp Statements per pending open paren."
)
(defvar lisp-auto-newline t
"*Automatically put excess closing parens on the next line."
)
(defun calculate-lisp-indent (&optional parse-start)
"Return appropriate indentation for current line as Lisp code.
Lines are indented by a constant times the number of pending
open parens, not counting characters on the line except for
leading close parens (so open/close pairs line up in columns).[amc]"
(save-excursion
(beginning-of-line)
(skip-chars-forward " \t)")
(let
;; vars
(
(indent-point (point)) ; where we started
state ; parse state holder
)
;; body
;; Find outermost containing sexp
(if parse-start
(goto-char parse-start)
(beginning-of-defun)
)
; How many outstanding open parens?
; parse sexp's up to the start of the line
(setq state (parse-partial-sexp (point) indent-point))
; we should now be able to calc the indent depth -
; the rule is, lisp-indent-level * paren depth, unless in
; a string, or starting char is a close-paren
; get to first non-blank on the indent line
(goto-char indent-point)
(skip-chars-forward " \t")
;; calculate the return value
(if (elt state 3) ; non-nil if inside a string
;; then
(current-column) ; don't change anything
;; else
;; use paren depth unless first char is a close-paren
;; state[0] is the paren nesting depth
(* lisp-indent-level
(- (elt state 0) (if (looking-at ")") 1 0))
)))))
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
; this will be attached to the paren characters, and executed whenever
; they are typed. this version automatically puts excess closes on the
; next line if lisp-auto-newline is set. If you never want it set, you
; can remove the entire and clause from the cond
(defun electric-lisp-paren ()
"Insert character and correct line's indentation for LISP.[amc]"
(interactive)
(let
;; vars
(
; flags for various conditions
(first-on-line (save-excursion (skip-chars-backward " \t") (bolp)))
(here (point))
state
start-of-line
only-closes
)
;; body
; need to check if we are in a comment or a string
; state[3] != nil if in string, and state[4] != nil if in comment
; so we parse from the start of the line to where the key was pressed
(setq state
(save-excursion
(beginning-of-line)
(setq start-of-line (point))
(setq only-closes
(and
(= last-command-char ?\))
(looking-at "[ \t)]*)[ \t)]*$")
))
(parse-partial-sexp (point) here)
))
(cond
; if in a string or a comment just insert the char
((or (elt state 3) (elt state 4))
(insert-char last-command-char 1) ; might as well blow off the blink
)
; if first paren on the line, put it in and indent the line
((and first-on-line (not only-closes))
(insert-char last-command-char 1) ; avoid the match blink here
(lisp-indent-line) ; indent the line
(funcall blink-paren-hook) ; now do the blink
)
; if the auto-flag is set, and it was a closing paren at
; the end of the line
((and
lisp-auto-newline
(= last-command-char ?\) )
(or (eolp) only-closes)
)
;; then check to see if this is an excess close, and if so
;; put the new close paren on the next line
(if only-closes (end-of-line)) ;put it at the end of the line
;; parse from beginning of line to the end, to see how paren depth
(setq state (parse-partial-sexp start-of-line (point)))
;; state[0] now has the paren depth for the line
(if (<= (elt state 0) 0) ; no pending opens on this line
;; then
(progn
(if (not (and (eq lisp-auto-newline t) only-closes))
(newline) ; put in the new line
)
(insert-char ?\) 1) ; now the closing paren
(lisp-indent-line) ; indent it
(funcall blink-paren-hook) ; do the blink
)
;; else
(self-insert-command 1) ; not enough closes, put in-line
) ; if
)
;; if no special conditions, just insert the character
(t (self-insert-command 1))
) ; cond
) ; let
)
;;; --------------------------------------------------------------------------
(defun set-lisp-indent-of-line (depth)
"Set the indentation of a lisp to the correct value for DEPTH"
(save-excursion
(beginning-of-line)
(let ((bol (point)))
(skip-chars-forward " \t")
(delete-region bol (point))
)
(indent-to-column
(+
base ;what is this? where is it set?
;;; (if (looking-at ")") (- lisp-indent-level) 0)
(* (nth 0 state) lisp-indent-level)
)
)
)
)
;;; --------------------------------------------------------------------------
;;; This version doesn't break up extra multiple close parens...maybe I can
;;; live with that.
(defun amcize-sexp (&optional brutal)
"Indent the following S-expression. If the optional flag BRUTAL is non nil, then groups of parentheses are broken up."
(interactive)
(message "Indenting...")
(save-excursion (forward-sexp 1)) ; check for complete sexp
(lisp-indent-line) ; fix up this line
(let
(
(base (current-indentation))
(state nil)
(old-state (list 0))
old-pos
bol
(here (point))
)
(while
(and
(not (eobp))
(or (not state) (> (nth 0 state) 0))
)
;; parse up to end of line
(setq old-pos (point)) ;save location
;;;
; (setq state
; (parse-partial-sexp
; (point) (save-excursion (end-of-line) (point)) nil nil state
; )
; )
; (forward-char 1) ;goto the next line
; (setq bol (point))
(end-of-line) (forward-char 1) (skip-chars-forward " \t)")
(setq bol (point))
(setq state (parse-partial-sexp old-pos (point) nil nil state))
;;;
(setcar (nthcdr 4 state) nil) ;clear in comment flag
;; deal with the parse results
(cond
((nth 3 state) ) ; inside a string
((looking-at ";") ) ; comment at start of line
;; More than 1 unclosed open paren on a line
((and brutal (> (car state) (+ 1 (car old-state))))
;;want to allow the special case of multiple opens at the start of
;;a line
(let
(
(this-pos (point)) ;save where we are
tmp-state
)
(goto-char old-pos) ;go back
(skip-chars-forward " \t") ;skip leading whitespace
(skip-chars-forward "(") ;skip leading open parens
(save-excursion ;check to see if still extra opens
(setq tmp-state (parse-partial-sexp (point) this-pos))
)
(if (< 0 (car tmp-state)) ;yep, still extra opens
(progn ;so break them up
(parse-partial-sexp (point) this-pos 1) ;find first extra
(forward-char -1) ;back up over it
(insert "\n") ;put in the newline
(goto-char old-pos) ;restore to known valid state
(setq state old-state)
)
;; ELSE only starting opens, so just set the indent
(progn
(goto-char this-pos)
(set-lisp-indent-of-line (car state))
)
)
)
)
((and brutal (< (car state) (car old-state)) (nth 2 state))
;; extra close parens plus an sexp
(goto-char (nth 2 state))
(forward-sexp 1)
(insert "\n")
(goto-char old-pos) ;restore known valid state
(setq state old-state)
)
((and brutal (< (+ 1 (car state)) (car old-state)) )
;; multiple extra close parens and no sexp
(parse-partial-sexp old-pos (point) -2)
(forward-char -1)
(insert "\n")
(goto-char old-pos) ;restore known valid state
(setq state old-state)
)
(t (set-lisp-indent-of-line (nth 0 state)))
)
(setq old-state state) ;save this state
)
(goto-char here) ;restore old point
)
(message "Indenting...done")
)
(defun indent-sexp () (interactive) (amcize-sexp nil))
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;
; this function installs the electric paren function on the paren keys
(defun amc-emacs-lisp-hook ()
(define-key emacs-lisp-mode-map "(" 'electric-lisp-paren)
(define-key emacs-lisp-mode-map ")" 'electric-lisp-paren)
)
; this function installs the electric paren function on the paren keys
(defun amc-lisp-hook ()
(define-key lisp-mode-map "(" 'electric-lisp-paren)
(define-key lisp-mode-map ")" 'electric-lisp-paren)
)
; now set the hook to activate them when entering emacs-lisp-mode
(setq emacs-lisp-mode-hook 'amc-emacs-lisp-hook)
(setq lisp-mode-hook 'amc-lisp-hook)

190
contrib/lisp-modes/gwm-lisp.el Normal file
View File

@ -0,0 +1,190 @@
;;;file: gwm-lisp.el
;;;============================================================
;;;
;;; GWM Lisp Mode
;;;
;;; This package provides a GWM Lisp major mode in Epoch.
;;;
;;; by Barry Kaplan
;;; kaplanb@ajpo.sei.cmu.edu
;;;============================================================
(defvar gwm::lisp-mode-map ())
(if gwm::lisp-mode-map
()
(setq gwm::lisp-mode-map (make-sparse-keymap))
(lisp-mode-commands gwm::lisp-mode-map)
)
(defun gwm::lisp-mode ()
"Entry to this mode calls the value of gwm-lisp-mode-hook if that
value is non-nil."
(interactive)
(kill-all-local-variables)
(use-local-map gwm::lisp-mode-map)
(setq major-mode 'gwm::lisp-mode)
(setq mode-name "GWM-Lisp")
(lisp-mode-variables t)
(run-hooks 'gwm::lisp-mode-hook)
)
(defun gwm::eval-defun ()
(interactive)
(save-excursion
(end-of-defun)
(let ((end (point)))
(beginning-of-defun)
(epoch::set-property "GWM_EXECUTE"
(buffer-substring (point) end))
)))
(defun gwm::eval-region () ; should be independent of Epoch drag button...
(interactive)
(epoch::set-property "GWM_EXECUTE"
(buffer-substring
(epoch::button-start drag-button)
(epoch::button-end drag-button)
)))
(setq gwm::eval-expression 'eval-expression) ;; Not implemented yet.
(defun gwm::eval-current-buffer ()
(interactive)
(epoch::set-property "GWM_EXECUTE" (buffer-string))
)
;;;
;;; Put the gwm file extension on the auto-mode-list.
;;;
(setq auto-mode-alist
(append
'(("\\.gwm$" . gwm::lisp-mode))
auto-mode-alist
))
;;;------------------------------------------------------------
(provide 'gwm-lisp)
;;; ---EOF---
I also redefine some of the standard emacs key definitions in
the \e map. For me the actual keys the functions are defined to
is abitrary since I use them only to define function keys later
on. The following are fragmants from my .emacs.
;;;file fragment: .emacs
(require 'keybind-functions)
(require 'gwm-lisp )
(require 'amc-lisp )
;;;----
;;; Lisp keys (non-standard, used by function keys below)
;;;----
(define-key lisp-mode-map "\e\C-x" 'eval-defun )
(define-key emacs-lisp-mode-map "\e\C-x" 'eval-defun )
(define-key lisp-interaction-mode-map "\e\C-x" 'eval-defun )
(define-key gwm::lisp-mode-map "\e\C-x" 'gwm::eval-defun)
(define-key lisp-mode-map "\e\e" 'eval-expression )
(define-key emacs-lisp-mode-map "\e\e" 'eval-expression )
(define-key lisp-interaction-mode-map "\e\e" 'eval-expression )
(define-key gwm::lisp-mode-map "\e\e" 'gwm::eval-expression)
(define-key lisp-mode-map "\e\C-@" 'eval-region )
(define-key emacs-lisp-mode-map "\e\C-@" 'eval-region )
(define-key lisp-interaction-mode-map "\e\C-@" 'eval-region )
(define-key gwm::lisp-mode-map "\e\C-@" 'gwm::eval-region)
(define-key lisp-mode-map "\e\C-h" 'eval-current-buffer )
(define-key emacs-lisp-mode-map "\e\C-h" 'eval-current-buffer )
(define-key lisp-interaction-mode-map "\e\C-h" 'eval-current-buffer )
(define-key gwm::lisp-mode-map "\e\C-h" 'gwm::eval-current-buffer)
(rebind-key-0-l "F5" "\e\C-x") ; F5 = eval-defun
(rebind-key-s-l "F5" "\e\C-@") ; s-F5 = eval-region
(rebind-key-c-l "F5" "\e\e") ; c-F5 = eval-expression
(rebind-key-s-c-l "F5" "\e\C-h") ; s-c-F5 = eval-current-buffer
(rebind-key-0-l "F6" "\M-xdescribe-function\C-m") ; F6 = describe-function
(rebind-key-s-l "F6" "\M-xdescribe-variable\C-m") ; s-F6 = describe-variable
(rebind-key-0-l "F7" "\M-xdescribe-key\C-m") ; F6 = describe-key
(rebind-key-s-l "F7" "\M-xhelp-with-mouse\C-m") ; s-F6 = describe-mouse
;;; ---EOF---
The rebind-key-* functions above are defined shown below. They are
only convenience routines to make it easy to bind function keys
whether the caps lock is on or off. If you of a better to accomplish
this please let me know.
;;; file fragment: keybind-functions.el
(setq epoch::function-key-mapping nil)
(defun rebind-key-all (keyname keystring)
(interactive)
(rebind-key keyname 0 keystring)
(rebind-key keyname 'lock keystring)
(rebind-key keyname 'shift keystring)
(rebind-key keyname 'control keystring)
(rebind-key keyname (list 'control 'shift) keystring)
(rebind-key keyname (list 'lock 'shift) keystring)
(rebind-key keyname (list 'lock 'control) keystring)
(rebind-key keyname (list 'lock 'control 'shift) keystring)
)
(defun rebind-key-0-l (keyname keystring)
(interactive)
(rebind-key keyname 0 keystring)
(rebind-key keyname 'lock keystring)
)
(defun rebind-key-s-l (keyname keystring)
(interactive)
(rebind-key keyname 'shift keystring)
(rebind-key keyname (list 'shift 'lock) keystring)
)
(defun rebind-key-c-l (keyname keystring)
(interactive)
(rebind-key keyname 'control keystring)
(rebind-key keyname (list 'control 'lock) keystring)
)
(defun rebind-key-s-c-l (keyname keystring)
(interactive)
(rebind-key keyname (list 'shift 'control) keystring)
(rebind-key keyname (list 'shift 'control 'lock) keystring)
)
;;;------------------------------------------------------------
(provide 'keybind-functions)
;;; ---EOF---
Also, if you are using amc-lisp.el, add the following to the
end of amc-lisp.el.
;;;file fragment: amc-lisp.el
(defun amc-gwm-lisp-hook () ;; This may not be necessary since gwm::lisp-mode-map
;; is derived from the standard lisp-mode-map (I think).
(define-key gwm::lisp-mode-map "(" 'electric-lisp-paren)
(define-key gwm::lisp-mode-map ")" 'electric-lisp-paren)
)
(setq gwm::lisp-mode-hook 'amc-gwm-lisp-hook)
;;; ---EOF---

93
contrib/rxterm/rx-sh Executable file
View File

@ -0,0 +1,93 @@
#!/bin/sh
#
# Original Author: fm@mirsa.fr , modified by H.Leroy
rx()
{ shift; comm="$*"
if [ "$mach" = "$HOSTNAME" ]
then
# eval to have double evaluation as when using rsh
# Hack: use "| :" instead of "&" to spawn a process in background
# without catching INT and QUIT (for a bug of xterm X10)
eval "$comm < /dev/null > $logf 2>&1 | :"
else
# Rshd open one file-descriptor (number 7 often) and does'nt terminate
# before its closing!!!!
# Cshell close first every file-descriptors ...
# ~~ Assume that the remote shell is the same that the current one
if [ "$mach" = "mirsa" -o "$mach" = "mirsa.inria.fr" ]
then PATH=/usr/bin/X11:$PATH
export PATH
fi
# valider :
xhost +$mach > /dev/null
case $SHELL in
*csh* )
rsh $mach "setenv PATH $PATH; setenv DISPLAY $DISPLAY; \
setenv MANPATH $MANPATH; \
exec $comm </dev/null >&! $logf"
;;
*sh* )rsh $mach "PATH=$PATH DISPLAY=$DISPLAY MANPATH=$MANPATH; \
export PATH DISPLAY MANPATH ; \
$comm < /dev/null > $logf 2>&1 \
3>&1 4>&1 5>&1 6>&1 7>&1 8>&1 9>&1 \
3>&- 4>&- 5>&- 6>&- 7>&- 8>&- 9>&- | :"
;;
* )
echo "Unknown shell: SHELL=$SHELL"
exit 10
;;
esac
fi
}
rxterm()
{ shift;
[ "$mach" != "$HOSTNAME" ] && set -- -ls "$@" # Login shell if remote
case $* in
*-e* )
# Extract the entry name of the command to execute
name=`echo $* | sed -e "s/^.*-e //" | awk '{print $1}'`
if [ -z "$name" ]
then echo "missing command name for -e switch" ;exit 1
fi
name=`basename $name`@$mach # Ex: emacs@mirsa
;;
* )
# Just the machine name
name=$mach
;;
esac
# Use of -n and not -T to be compatible with X10
# X11 xterm uses -n to specify the icon name but default the title name
# with the icon name
rx $mach xterm -n $name "$@"
}
rxload()
{ shift; rx $mach xload "$@"
}
logf='${HOME}/.rx.log'
mach=$1;
HOSTNAME=`hostname 2> /dev/null || uuname -l `
xscreen=`expr "$DISPLAY" : "[^:]*\(.*\)"`
if [ $xscreen = x ]
then
xscreen=":0.0"
fi
DISPLAY=unix:0
if [ "$HOSTNAME" != "$mach" ]
then
DISPLAY=${HOSTNAME}$xscreen
fi
`basename $0` "$@"

135
contrib/rxterm/rxterm.script Executable file
View File

@ -0,0 +1,135 @@
#!/bin/sh
usage='Usage: rx <remhost> <X-command> [<args>]
rxterm <remhost> [<args>]
rxload <remhost> [<args>]
rxcmdtool <remhost> [<args>]
Executes <X-command> on <remhost> and redirects its standard and error output
to the file $HOME/.rx.log on <remhost>.
The connection to <remhost> terminates as soon as <X-command> is launched, not
when <X-command> terminates.
The user should have permission to use rsh from the current host to <remhost>
and to execute X clients on <remhost>. See rsh, xhost.
'
[ $# = 0 ] && { echo "$usage" >&2; exit 1; }
case $1 in
-* )
echo "$usage" >&2; exit 1;;
esac
remhost=$1; shift; comm="$*"
case $0 in
*rxload )
comm="xload $comm"
;;
*rxterm )
case $comm in
*-e* )
# Extract the entry name of the command to execute
name=`echo $comm | sed 's/.*-e[ ]*\([^ ]*\).*/\1/'`
if [ -z "$name" ]
then
echo "missing command name for -e switch"
exit 1
fi
name=`basename $name`@$remhost # Ex: emacs@mirsa
;;
* )
# Just the machine name
name=$remhost
;;
esac
# Always login shell!
comm="xterm -ls -T $name $comm"
;;
*rxcmdtool )
case $comm in
*-e* )
# Extract the entry name of the command to execute
name=`echo $comm | sed 's/.*-e[ ]*\([^ ]*\).*/\1/'`
if [ -z "$name" ]
then
echo "missing command name for -e switch"
exit 1
fi
name=`basename $name`@$remhost # Ex: emacs@mirsa
;;
* )
# Just the machine name
name=$remhost
;;
esac
# Always login shell!
comm="cmdtool -label $name $comm"
;;
esac
# Current Host
hostname=${HOSTNAME-`hostname || /usr/5bin/uname -n 2> /dev/null`}
[ -z "$DISPLAY" ] && DISPLAY=unix:0 # Default for DISPLAY
IFS=:
set $DISPLAY
IFS='
'
xhostname=$1 xscreen=$2
if [ -z "$xscreen" ]
then
xscreen=$xhostname
xhostname=$hostname
fi
[ "$xhostname" = unix ] && xhostname=$hostname
case $remhost in
*.*.* )
# May be a different domain: we have to find the full name of the xhostname
# Search for the name server, then N.I.S, then /etc/hosts
oldpath=$PATH
PATH=/usr/etc:/usr/ucb:/etc:/bin:/usr/bin:/usr/etc/yp
host=`(nslookup $xhostname) 2> /dev/null | \
sed -n 's/Name:[ ]*\(.*\)/\1/p'`
if [ -z "$host" ]
then
host=`(ypmatch $xhostname hosts) 2> /dev/null | \
sed -n 's/[^ ]*[ ]*\([^ ]*\).*/\1/p'`
fi
if [ -z "$host" ]
then
host=`sed -n /$xhostname/'s/[^ ]*[ ]*\([^ ]*\).*/\1/p' \
/etc/hosts`
fi
xhostname=$host
PATH=$oldpath
esac
# For efficiency, use of unix:0 for local clients
if [ "$xhostname" = "$remhost" ]
then
DISPLAY=unix:$xscreen
else
DISPLAY=$xhostname:$xscreen
fi
# Rshd open one file-descriptor (number 7 often) and does'nt terminate
# before it is closed!!!!
# List of variables to export through rsh if they are defined
vars='PATH DISPLAY XENVIRONMENT XAPPLRESDIR PRINTER LD_LIBRARY_PATH OPENWINHOME GUIDEHOME'
env= var= val=
for var in $vars
do
eval val=\$$var
[ -n "$val" ] && env="${env}$var=$val;export $var;"
done
xhost +$remhost > /dev/null
# Using rsh even localy permits to unattach the xcommand from the
# current tty if any
exec rsh $remhost -n "exec sh -c \" $env $comm < /dev/null > .rx.log 2>&1 \
3>&1 4>&1 5>&1 6>&1 7>&1 8>&1 9>&1 \
3>&- 4>&- 5>&- 6>&- 7>&- 8>&- 9>&- &\" "

84
contrib/scripts/find-bar-nils Executable file
View File

@ -0,0 +1,84 @@
#!/usr/local/bin/klone
;;Skeleton of a typical klone script
;;(stack-dump-on-error t)
;;(kdb t)
(defvar ExpressionToFind '(bar-make ()))
(setq files (getopts "USAGE: find-bar-nils files...
prints usage of (bar-make ()) which will conflict with the new syntax"
("-v" () verbose "verbose operation")
))
(setq *quote-inlines* t)
(defun main (&aux
)
(dolist (file files)
(catch 'ALL
(process-file file)
)
)
)
(defun process-file (file &aux
(fd (open file))
expr
)
(catch 'EOF
(while t
(setq expr (read fd))
(setq is-in-expr:count 0)
(if (is-in-expr expr ExpressionToFind)
(print-format "%0:%1: %2 occurences in: %3\n"
file (file-lineno fd) is-in-expr:count (truncate-to expr 40)
)))))
;; find current line in file
(defun file-lineno (fd &aux
(cur-pos (file-position fd))
(line 0)
)
(file-position fd 0) ;rewind
(catch 'EOF
(while (< (file-position fd) cur-pos) ;count from start
(read-line fd)
(incf line)
))
(file-position fd cur-pos)
line
)
(defvar is-in-expr:count 0)
(defun is-in-expr (expr subexpr)
(if (= expr subexpr)
(incf is-in-expr:count)
(if (typep expr List)
(catch 'Found
(dolist (se expr)
(if (is-in-expr se subexpr)
(throw 'Found t)
))
()
)
()
)))
(defun truncate-to (expr N &aux
(s (print-format String "%0" expr))
)
(if (> (length s) N)
(subseq s 0 N)
s
)
)
(main)
;;; EMACS MODES
;;; Local Variables: ***
;;; mode:lisp ***
;;; End: ***

9
contrib/scripts/find-bar-nils.README Normal file
View File

@ -0,0 +1,9 @@
find-bar-nils is a KLONE script to detect all uses of the construct
(bar-make ()) that changed semantics between gwm 1.7p_beta_2 and gwm
1.7p_beta_3 (more generally between 1.x and 1.8)
These constructs should be replaced by (bar-make)
KLONE is a free scripting language that can be found by ftp at
koala.inria.fr:/pub/Klone

136
contrib/widgets/widgets.el Normal file
View File

@ -0,0 +1,136 @@
;;; --------
;;; handlers
;;; --------
;;; last modified: blk@mitre.org Tue Jan 22 12:48:07 1991
;;; --------
;;Author: Brian L. Kahn
;;Copyright 1992, MITRE Corporation
;;Not for sale or resale, distribution unlimited
(require 'event)
(require 'property)
(provide 'widgets)
;; widgets - Drop-menus, Pop-menus, and scrollbar
;; ==============================================
(defun widget:read-property (prop)
"Read a property, return a lisp obj."
(car (read-from-string (get-property prop))))
;;; WIDGET HANDLER
(setq epoch::event-handler-abort nil)
(push-property "gwm-result" 'widget:result-handler)
(push-property "scrollbar" 'widget:scrollbar-handler)
(push-property "Dmenu" 'widget:Dmenu-handler)
(push-property "Pmenu" 'widget:Pmenu-handler)
;;; gwm-result
;; the gwm-return macro invokes a command via GWM_EXECUTE property
;; result goes into gwm-result property
(defun widget:result-handler (type xatom scr)
"Display result from gwm-result macro."
(message (get-property "gwm-result")))
;; Scroll bar
(defconst widget:scrollbar-funcs
'((1 . scroll-up) (2 . line-up-point) (3 . scroll-down)))
(defun widget:scrollbar-handler (type xatom scr)
"scroll screen up and down"
(let* ((msg (widget:read-property "scrollbar"))
(why (nth 3 msg))
(height (nth 3 (screen-information)))
(where (/ (* height why) 100))
(loc (epoch::coords-to-point 10 where scr))
)
;; note that loc is nil if click next to mode line
(if loc
(let* ((what (nth 1 msg))
(func (cdr-safe (assoc what widget:scrollbar-funcs)))
(win (nth 2 loc))
(font-size (nth 2 (font)))
(screen-line (/ where font-size))
(window-begin (nth 1 (window-edges win)))
(window-line (1+ (- screen-line window-begin)))
)
(eval-in-window win (funcall func window-line))
))))
(defun line-up-point (line)
"Scrolls point to window LINE."
(scroll-down (- line (count-lines (window-start) (point)))))
(defun widget:scroll-index (index scr)
"Jumps index% into the file."
(eval-in-screen scr
(if (>= index 98)
(goto-char (point-max))
(progn
(goto-char (+ (point-min) ; For narrowed regions.
(/ (* (- (point-max) (point-min))
index) 100)))
(beginning-of-line))
)
(what-cursor-position)))
;;; Menu handlers
;; Dmenus are assumed to asynchronous. Message is an elisp command.
;; Pmenus should be synchronous. Message returned is menu selection.
(defun widget:Dmenu-handler (type xatom scr)
"Execute the function requested by user, mousing the Drop-menus."
(let* ((msg (widget:read-property "Dmenu"))
(act (nth 3 msg)))
(if (fboundp (car-safe act))
(eval act)
(message "Dmenu error: %s" act))
))
(defvar widget:Pmenu-return nil "Return value from popup menu")
(defun widget:Pmenu-handler (type xatom scr)
"Store value returned by popup menu in widget:Pmenu-return."
(let* ((msg (widget:read-property "Pmenu"))
(selection (nth 3 msg)))
(setq widget:Pmenu-return selection)
(throw 'widget:Pmenu-return selection)
))
;;; from sun-mouse.el
(defmacro eval-in-window (window &rest forms)
"Switch to WINDOW, evaluate FORMS, return to original window."
(` (let ((OriginallySelectedWindow (selected-window)))
(unwind-protect
(progn
(select-window (, window))
(,@ forms))
(select-window OriginallySelectedWindow)))))
;;; adapted from eval-in-window
(defmacro eval-in-screen (screen &rest forms)
"Switch to SCREEN, evaluate FORMS, return to original screen."
(` (let ((OrigScreen (current-screen)))
(unwind-protect
(progn
(select-screen (, screen))
(,@ forms))
(select-screen OrigScreen)))))

615
data/.gwmrc.gwm Normal file
View File

@ -0,0 +1,615 @@
;;=============================================================================
;; STANDARD GWM PROFILE
;;=============================================================================
;;File: .gwmrc.gwm -- the GWM standard profile
;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
;;Revision: 1.4 -- June 12 1989
;;State: Exp
;;GWM Version: 1.4
;;=============================================================================
;; Initialisations
;;=============================================================================
; banner
; ======
(load 'trace-func)
(stack-print-level 3)
(setq display-name-radix (match "\\([^:]*:[0-9][0-9]*\\)" display-name 1))
(defname 'x-screen-name screen. '(+ display-name-radix "." (itoa screen)))
(if (= gwm-quiet 0)
(progn
(for screen (list-of-screens)
(? x-screen-name " " screen-width " x " screen-height " x "
screen-depth "\n"))
(print "reading...")
(: original-load load)
(defun load (file) (? ".")(original-load file))
))
; appearance
; ==========
(: name-font (font-make "9x15"))
(: meter-font (font-make "9x15"))
(: bull-font (font-make "9x15"))
(: small-font (font-make "6x10"))
; global switches
; ===============
(: move-grid-style 3)
(: resize-grid-style 4)
(: property ())
(: borderwidth 1)
(: any-button (button any any))
(: any-key (key any any))
(: select-button 1)
(: action-button 2)
(: menu-button 3)
(: autoraise ())
(: autocolormap t)
(: no-set-focus ())
(: to-be-done-after-setup '(progn)) ; obsolete: use screen-opening
(: screen-opening '(progn)) ; actions to be done before operation
(: screen-closing ; actions to be done when ending
'(progn
))
(setq left "left")
(setq base "base")
(setq bottom "bottom")
(setq right "right")
(setq top "top")
; per-screen data setting
; =======================
(defunq defname-in-screen-to args
(with (value (eval (# 0 args))
vars (sublist 1 (length args) args))
(for var vars
(defname var screen. value))))
(defunq set-color (name value)
(if (not (= screen. (namespace-of name)))
(progn
(defname name screen.)
(for screen (list-of-screens)
(set name (color-make value)))
)))
(defunq set-pixmap args
(with (name (# 0 args)
pixmap-make-call (# 0 args 'pixmap-make))
(if (not (= screen. (namespace-of name)))
(progn
(defname name screen.)
(for screen (list-of-screens)
(set name (eval pixmap-make-call)))
))))
; per-screen data
; ===============
(defname-in-screen-to () tile screen-tile bordertile menu root-cursor)
(defname 'root-pop screen.)
(defname 'window-pop screen.)
(defname 'icon-pop screen.)
(set-color black Black)
(set-color white White)
(set-color grey Grey)
(set-color darkgrey DarkSlateGrey)
(set-color lightgrey LightGrey)
(set-pixmap icon-pixmap "icon20")
(defname 'look-3d screen.)
(for screen (list-of-screens)
(if (= 'mono screen-type)
(: look-3d ())
(: look-3d t)
(: invert-color (bitwise-xor black white))
))))
; functions to affect decorations to a client name
; =================================================
; The assignement of decorations to client names:
; a decoration is either:
; a function yielding the decoration
; an unbound variable: the corresponding file is then loaded, which
; must define the function
(load 'utils)
;;=============================================================================
;; X resource management for the standard profile
;;=============================================================================
;;
(defun std-resource-get args
(with (resource-class (# 0 args) resource-name (# 1 args) Name () Class ())
(: Name (+ -screen-name '.
window-client-class '.
(make-string-usable-for-resource-key-non-nil window-client-name) '.
(make-string-usable-for-resource-key-non-nil window-name) '.
screen-type '.
window-machine-name '.
(if resource-name resource-name resource-class)
))
;; (: Class (+ "S......" resource-class)) ;; makes Xrm crash on sun4s
(: Class (+ "S.any.any.any.any.any.any" resource-class))
;; (? "resource-get " Name " " Class " = " (resource-get Name Class) "\n")
(resource-get Name Class)
))
;; puts resource:
;; (std-resource-put resource-name
;; [screen-type] clientclass[name[windnowname[machine]]]]
;; value)
(defun std-resource-put (Resource args)
(with (Client-desc () Value () Screen () Name ())
(if (= 3 (length args))
(progn
(: Client-desc (# 1 args))
(: Value (# 2 args))
(: Screen (# 0 args))
)
(progn
(: Client-desc (# 0 args))
(: Value (# 1 args))
))
(: Name (std-resource-expand Client-desc Screen Resource))
;; (? "resource-put " Name " " Value "\n")
(resource-put Name Value)
))
;; expands class[.name[.wname[.machine]]] visual Resource
;; into ScreenNumber.class.name.wname.visual.machine.Resource
(defun std-resource-expand (desc visual resource)
(if (match "[*]" desc)
(+ -screen-name
(if (match "^[*]" desc) () '.)
desc
(if (match "[*]$" desc) () '.)
resource)
(with (tmp (match
"^\\([^.]*\\)[.]*\\([^.]*\\)[.]*\\([^.]*\\)[.]*\\([^.]*\\)$"
desc 1 2 3 4
))
(make-resource-string -screen-name (# 0 tmp) (# 1 tmp) (# 2 tmp)
visual (# 3 tmp) 'any resource
))))
;; appends list elements with '.', collapsing consecutive void (or any)
;; elements into *
(defun make-resource-string l
(with (star () first t l2
(mapfor elt l
(if (or (= "any" elt) (not elt))
(if star
""
(progn
(setq star t)
"*"
)
)
(progn
(setq star ())
(if first (progn (setq first ()) elt)
(+ "." elt)
)))))
(eval (+ '(+) l2))
))
;(trace-func std-resource-put)
;; customisation of decos by context
;; (customize deco screen application context...)
(defun customize-usage (string)
(? "USAGE: (customize deco screen application context...),\n"
"error was: " string "\n"
(exit customize)
))
(defunq customize args
(tag customize
(with (Deco (# 0 args)
Screen (# 1 args)
Application (# 2 args)
Context (if (and (= 4 (length args)) (= 'list (type (# 3 args))))
(# 3 args)
(sublist 3 (length args) args)
)
l (length Context)
i 1
)
(while (< i l)
(## i Context (eval (# i Context)))
(setq i (+ 2 i))
)
(std-resource-put Deco (list Screen Application Context))
)))
;; recursively evaluates till we obtain a context
(defun get-context (name)
(do-get-context name 0)
)
(defun do-get-context (name level)
(if (> level max-autoload-evaluation) name
(progn
(setq name
(if (# (type name) string-types)
(progn ; atoms:
(if (= 'string (type name))
(: name (atom name))) ; string->atom to test if defined
(if (boundp name)
(eval name) ; defined: eval
(progn
(load name) ; undefined, load and returns itself
name
)))
(# (type name) func-types) ; function: called without args
(eval (list name))
(= (type name) 'list)
(if (= (% (length name) 2) 0) ; if even list, its a context
name
(= 1 (length name)) ; if one element, return it
(# 0 name)
(eval name) ; if odd list, eval
)
(eval name) ; others: eval
))
(if (or (not name)
(and (= (type name) 'list)(= (% (length name) 2) 0)))
name
(do-get-context name (+ 1 level)
)))))
;;=============================================================================
;; user-callable resource settings
;;=============================================================================
(defname '-screen-name screen.)
(for screen (list-of-screens)
(: -screen-name (+ "S" (itoa screen)))
(std-resource-put 'GwmWindow (list screen-type ()))
(std-resource-put 'GwmIconWindow (list screen-type ()))
(std-resource-put 'GwmIconPixmap (list screen-type ()))
(std-resource-put 'GwmPlacement (list screen-type ()))
(std-resource-put 'GwmIconPlacement (list screen-type ()))
)
(: string-types '(string t atom t pointer t active t))
(: func-types '(expr t fexpr t subr t fsubr t))
(setq max-autoload-evaluation 10)
(defun autoload-description (name)
(with (level 0)
(do-autoload-description name level)
))
;; recursively evaluates or load description to obtain a wl_client
(defun do-autoload-description (name level)
(if (> level max-autoload-evaluation) name
(progn
(setq name
(if (# (type name) string-types)
(progn ; atoms:
(if (= 'string (type name))
(: name (atom name))) ; string->atom to test if defined
(if (boundp name)
(eval name) ; defined: eval
(progn
(load name) ; undefined, load and returns itself
name
)))
(# (type name) func-types) ; function: called without args
(eval (list name))
(eval name) ; others: evalb
))
(if (= 'client (type name)) name
(do-autoload-description name (+ 1 level)
))))))
(defun autoload-description (name)
(do-autoload-description name 0)
)
(defunq set-window args (std-resource-put 'GwmWindow args))
(defunq set-icon-window args (std-resource-put 'GwmIconWindow args))
(defunq set-icon args
(## (- (length args) 1) args (expand-pixmap (# (- (length args) 1) args)))
(std-resource-put 'GwmIconPixmap args)
)
(defun expand-pixmap (obj)
(if (and obj (# (type obj) string-types))
(pixmap-make obj)
(eval obj)))
(defunq set-placement args (std-resource-put 'GwmPlacement args))
(defunq set-icon-placement args (std-resource-put 'GwmIconPlacement args))
;;=============================================================================
;; automatic placement
;;=============================================================================
(de apply1 (func arg)
(eval (list (eval func) arg)))
(: opening
'(progn
(apply1 (if (= window-status 'icon)
(std-resource-get 'GwmIconPlacement)
(= window-status 'window)
(std-resource-get 'GwmPlacement)
)
t)))
(: closing
'(progn
(apply1 (if (= window-status 'icon)
(std-resource-get 'GwmIconPlacement)
(= window-status 'window)
(std-resource-get 'GwmPlacement)
)
())
))
; default placement make title bar in screen
(defun default-placement (flag)
(if flag
(if (< window-y 0) (move-window window-x 0))))
(load "placements")
;;=============================================================================
;; std-... wrappers for raise-current flag
;;=============================================================================
(if (not (boundp 'std-move-window))
(progn
(: raise-on-move t)
(defun std-move-window ()
(if raise-on-move (raise-window))
(move-window)
)
(: raise-on-resize t)
(defun std-resize-window ()
(if raise-on-resize (raise-window))
(resize-window)
)
(: raise-on-iconify t)
(defun std-iconify-window ()
(iconify-window)
(if raise-on-iconify (raise-window))
)))
;;=============================================================================
;; default behaviors
;;=============================================================================
;; standard-behavior is the default actions for all items
;; to make a fsm for a window or icon, do a
;; (fsm-make (state-make <your-actions> window-behavior standard-behavior)
;; (fsm-make (state-make <your-actions> icon-behavior standard-behavior)
(: standard-behavior
(state-make
(on (buttonpress select-button alone)
(std-move-window))
(on (button select-button with-shift) (lower-window))
(on (buttonpress select-button with-alt)
(std-move-window))
(on (button select-button (together with-shift with-alt))
(lower-window))
(on (buttonpress menu-button alone)
(progn (set-colormap-focus ()) (std-pop-menu)))
(on (buttonpress menu-button with-alt)
(progn (set-colormap-focus ()) (std-pop-menu)))
))
;; actions specific to window titles. should be used before
;; standard-behavior in further fsms
(: standard-title-behavior
(state-make
(on (buttonpress action-button alone)
(std-resize-window))
(on (buttonpress action-button with-alt)
(std-resize-window))
))
;; actions specific to windows
(: window-behavior
(state-make
(on (buttonpress action-button alone)
(std-resize-window))
(on (buttonpress action-button with-alt)
(std-resize-window))
(on name-change (send-user-event 'name-change))
(on focus-in (progn (if autoraise (raise-window))
(send-user-event 'focus-in)))
(on focus-out (send-user-event 'focus-out))
(if no-set-focus
(on enter-window (progn (if autoraise (raise-window))
(if autocolormap (set-colormap-focus))))
(on enter-window (progn (if autoraise (raise-window))
(set-focus)
(if autocolormap (set-colormap-focus)))))
(if (not no-set-focus)
(on leave-window (set-focus ())))
(on name-change (send-user-event 'name-change))
(on (property-change 'WM_ICON_NAME)
(if (window-icon?)
(send-user-event 'get-icon window-icon)))
(on window-icon-pixmap-change
(if (window-icon?)
(send-user-event 'icon-pixmap-change window-icon)))
))
;; icon-specific actions
(: icon-behavior
(state-make
(on (buttonrelease action-button any)
(std-iconify-window))
))
;; root-window actions
;; make root menu appear on any modifier combinations in case of problems
(: root-behavior
(state-make
(on (buttonpress menu-button any) (pop-root-menu))
))
(: old-standard-behavior ())
(: old-standard-title-behavior ())
(: old-window-behavior ())
(: old-icon-behavior ())
(: old-root-behavior ())
(: grabs (: root-grabs (: window-grabs (: icon-grabs (list
(button any with-alt)
(button select-button (together with-shift with-alt))
)))))
;; the function to call when redefining behaviors, to re-create fsms
;;==================================================================
(defun reparse-standard-behaviors ()
(if (not (and
(eq window-behavior old-window-behavior)
(eq standard-behavior old-standard-behavior)
))
(progn
(: window-fsm (fsm-make (state-make window-behavior standard-behavior)))
(: old-window-behavior window-behavior)
))
(if (not (and
(eq icon-behavior old-icon-behavior)
(eq standard-behavior old-standard-behavior)
))
(progn
(: icon-fsm (fsm-make (state-make icon-behavior standard-behavior)))
(: old-icon-behavior icon-behavior)
))
(if (not (eq root-behavior old-root-behavior))
(progn
(: root-fsm (fsm-make (state-make root-behavior)))
(: old-root-behavior root-behavior)
))
(: old-standard-behavior standard-behavior)
;; some sensible defaults for buggy decos
(: fsm window-fsm)
(: grabs window-grabs)
)
(reparse-standard-behaviors)
;;=============================================================================
;; User Profile
;;=============================================================================
; Pop-ups
; =======
(load "std-popups.gwm") ; default: the standard menu package
(for screen (list-of-screens) (: menu 'window-pop)))
; read user customizations in .profile.gwm, once per screen
; =========================================================
(if (= 0 gwm-quiet) (? "["))
(for screen (list-of-screens)
(load ".profile.gwm")
(if (= 'string (type screen-tile))
(: screen-tile (pixmap-make screen-tile)))
)
(if (= 0 gwm-quiet) (? "]"))
(load menu.builder) ; build menus from set-up descs
; The simplest window: no-decoration
; ==================================
(defun simple-window-decoration ()
(with (fsm window-fsm
borderwidth 0
inner-borderwidth any
menu window-pop)
(window-make () () () () ())))
(: no-frame-no-borders (: simple-icon-decoration
(: no-decoration simple-window-decoration))
)
; no-decoration by a small border
(df no-frame () (window-make ()()()()()))
;;=============================================================================
;; DESCRIBE-SCREEN & DESCRIBE-WINDOW
;;=============================================================================
(de describe-screen ()
(with (fsm root-fsm cursor root-cursor menu root-pop tile screen-tile
grabs root-grabs
opening '(progn (eval to-be-done-after-setup)
(eval screen-opening)
(if (= 0 gwm-quiet)
(? "Screen #" screen " ready.\n")))
closing '(eval screen-closing)
)
(window-make () () () () ()))))
(de describe-window ()
(list
(autoload-description
(if (: tmp (std-resource-get 'GwmWindow))
tmp
'simple-win)
)
'(autoload-description ; defer evaluation till iconification
(if (: tmp (std-resource-get 'GwmIconWindow))
tmp
'simple-icon)
)))
; Bye bye
; ========
(if (= 0 gwm-quiet)
(progn
(setq load original-load)
(print "...done\n")
)
(bell)
)
;(trace-func do-autoload-description name)

1145
data/.profile.gwm Normal file
View File

File diff suppressed because it is too large Load Diff

41
data/App_write.xpm Normal file
View File

@ -0,0 +1,41 @@
/* XPM */
static char *App_write_xpm[] = {
"32 32 6 1",
" c None s None",
". c black",
"X c LightCyan2",
"o c navy",
"O c MistyRose",
"+ c white",
" . ",
" .X. ",
" .XXX. ",
" .XXXXX. ",
" .XXXXXXX. ",
" .XXXXXXXXX. ",
" .XXoXXoXXXXX. ",
" .XXoXXoXXXXXXX. ",
" .XXoXXXXXoXXXXXX. ",
" .XXXXXoXXoXXoXXXXX. ",
" .XXoXXooXXXooXXXXXXX. ",
" .XXooXXXXoXXoXXXXXXXXX. ",
" .XXXXXoXXoXXoXXXXXXXXXXX. ",
" .XXooXoXXoXXooXXXXXXXXXXXX. ",
" .XXoXXoXXXXXXXXXX......XXXXX. ",
".XXoXXoXXoXXoXXXX.OOOOOO.XXXXX. ",
" .XXXoXXoXXooXXX.OOOOOOOO.XXXXX.",
" .XXXXoXXoXXXX.OO..OOOOOO.XXX.+",
" .XXoXXoXXXXX...++.OOOOOO.X.++",
" .XXXoXXo...OO........OOO....",
" .XXXXoXXX.OOO..OOOOOOOOO...",
" .XXoXXXXX.OOOOOOOOOOOOO...",
" .XXXXXXXX.OOOOOOOOOOOO...",
" .XXXXXXXX..OOOOOOOOOO...",
" .XXXXXXXXX........OO...",
" .XXXXXXXXXXX. .....",
" .XXXXXXXXX. ...",
" .XXXXXXX. ",
" .XXXXX. ",
" .XXX. ",
" .X. ",
" . "};

38
data/ImakeB Normal file
View File

@ -0,0 +1,38 @@
XCOMM
XCOMM Copyright (C) 1989-94 GROUPE BULL
XCOMM
XCOMM Permission is hereby granted, free of charge, to any person obtaining a
XCOMM copy of this software and associated documentation files
XCOMM (the "Software"), to deal in the Software without restriction, including
XCOMM without limitation the rights to use, copy, modify, merge, publish,
XCOMM distribute, sublicense, and/or sell copies of the Software, and to permit
XCOMM persons to whom the Software is furnished to do so, subject to the
XCOMM following conditions:
XCOMM The above copyright notice and this permission notice shall be included
XCOMM in all copies or substantial portions of the Software.
XCOMM
XCOMM THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
XCOMM OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
XCOMM MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
XCOMM IN NO EVENT SHALL GROUPE BULL BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
XCOMM LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
XCOMM FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
XCOMM DEALINGS IN THE SOFTWARE.
XCOMM
XCOMM Except as contained in this notice, the name of GROUPE BULL shall not be
XCOMM used in advertising or otherwise to promote the sale, use or other
XCOMM dealings in this Software without prior written authorization from
XCOMM GROUPE BULL.
XCOMM
XCOMM
XCOMM Imakefile for gwm/data
XCOMM
XCOMM ************* WARNING: IF YOU CHANGE THIS CHANGE ALSO IN ../Imakefile
GWMDIR = /usr/local/lib/gwm
all::
depend::

5
data/ImakeE Normal file
View File

@ -0,0 +1,5 @@
MakeDirectories(install,$(GWMDIR))
InstallMultipleFlags($(DATA),$(GWMDIR),$(INSTDATFLAGS))

281
data/Imakefile Normal file
View File

@ -0,0 +1,281 @@
XCOMM
XCOMM Copyright (C) 1989-94 GROUPE BULL
XCOMM
XCOMM Permission is hereby granted, free of charge, to any person obtaining a
XCOMM copy of this software and associated documentation files
XCOMM (the "Software"), to deal in the Software without restriction, including
XCOMM without limitation the rights to use, copy, modify, merge, publish,
XCOMM distribute, sublicense, and/or sell copies of the Software, and to permit
XCOMM persons to whom the Software is furnished to do so, subject to the
XCOMM following conditions:
XCOMM The above copyright notice and this permission notice shall be included
XCOMM in all copies or substantial portions of the Software.
XCOMM
XCOMM THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
XCOMM OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
XCOMM MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
XCOMM IN NO EVENT SHALL GROUPE BULL BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
XCOMM LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
XCOMM FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
XCOMM DEALINGS IN THE SOFTWARE.
XCOMM
XCOMM Except as contained in this notice, the name of GROUPE BULL shall not be
XCOMM used in advertising or otherwise to promote the sale, use or other
XCOMM dealings in this Software without prior written authorization from
XCOMM GROUPE BULL.
XCOMM
XCOMM
XCOMM Imakefile for gwm/data
XCOMM
XCOMM ************* WARNING: IF YOU CHANGE THIS CHANGE ALSO IN ../Imakefile
GWMDIR = /usr/local/lib/gwm
all::
depend::
DATA = \
.gwmrc.gwm \
.profile.gwm \
App_write.xpm \
LRom1.xpm \
README.cutewin \
README.icon-mgr \
README.twm \
README.virtual \
X.xbm \
Xmh-icon.48.xpm \
Xmh-icon.78.xpm \
Xrn-icon.xpm \
Zircon-icon.no \
Zircon-icon.yes \
advice.gwm \
arrow-f.xbm \
arrow-m.xbm \
arrow3d-f.xbm \
arrow3d-m.xbm \
arrowhole-f.xbm \
arrowhole-m.xbm \
back.xbm \
barA2..xpm \
barA2.l.xpm \
barA2.r.xpm \
bind-key.gwm \
bull_1.xbm \
bull_2.xbm \
cdrom1.xpm \
clipboard.xpm \
close-18.xbm \
close.xpm \
close_pressed.xpm \
compat.gwm \
cornerPlug.xbm \
cursor-names.gwm \
custom-install.gwm \
custom-menu.gwm \
cutewin.gwm \
datebook.xpm \
def-menus.gwm \
deltabutton.gwm \
dir-focus.gwm \
dlists.gwm \
drop-menus.doc \
drop-menus.gwm \
dvrooms.gwm \
edit-plug.gwm \
em-drop-menus.gwm \
em-example.gwm \
em-widgets.gwm \
emacs-mouse.gwm \
en-recover.gwm \
epoch.gwm \
fast.gwm \
float.gwm \
frame-win.gwm \
frame2d-b.xbm \
frame2d-bl.xbm \
frame2d-br.xbm \
frame2d-l.xbm \
frame2d-r.xbm \
frame2d-t.xbm \
frame2d-tl.xbm \
frame2d-tr.xbm \
frame3d-b.xpm \
frame3d-bl.xpm \
frame3d-br.xpm \
frame3d-l.xpm \
frame3d-r.xpm \
frame3d-t.xpm \
frame3d-tl.xpm \
frame3d-tr.xpm \
framemaker.gwm \
fvwm-autoraise.gwm \
fvwm-icon.gwm \
fvwm-menu.gwm \
fvwm-multimenu.gwm \
fvwm-window.gwm \
fvwm.gwm \
fvwmrc.gwm \
grainy.xbm \
gray.xbm \
gwm.ml \
hilite.xbm \
hilite2.xbm \
icon-groups-old.gwm \
icon-groups.gwm \
icon20.xbm \
iconify-vb.xbm \
iconify.xbm \
iconify2.xbm \
iconise.xpm \
iconise_pressed.xpm \
inform.xpm \
inform_pressed.xpm \
itemSep.xbm \
kill.xbm \
kill.xpm \
kill_pressed.xpm \
load-icon-mgr.gwm \
load-virtual.gwm \
lower.xbm \
maximise.xpm \
maximise_pressed.xpm \
menu.xbm \
mini.xbm \
mon-keys.gwm \
mosaic.xpm \
move-opaque.gwm \
mwm-bindings.gwm \
mwm-buttons.gwm \
mwm-emulation.txt \
mwm-functions.gwm \
mwm-iclb.xbm \
mwm-iclt.xbm \
mwm-icon.gwm \
mwm-icrb.xbm \
mwm-icrt.xbm \
mwm-ictb.xbm \
mwm-ictlb.xbm \
mwm-ictlt.xbm \
mwm-ictrb.xbm \
mwm-ictrt.xbm \
mwm-ictt.xbm \
mwm-internal.gwmMwmrc \
mwm-menus.gwm \
mwm-menusrc.gwm \
mwm-placements.gwm \
mwm-typical.gwmMwmrc \
mwm-utils.gwm \
mwm-win.gwm \
mwm-zoom-win.gwm \
mwm.gwm \
mwmprofile.gwm \
mwmrc.gwm \
my-menus.gwm \
near-mouse.gwm \
netscape-small.xpm \
no-decoration.gwm \
pick.gwm \
pixmap.xpm \
placements.gwm \
plaid.xpm \
profile-colas.gwm \
raise.xbm \
resize.xbm \
resize2.xbm \
right-arrow.xbm \
safe-quit.gwm \
simple-ed-win.gwm \
simple-icon-old.gwm \
simple-icon.gwm \
simple-win-old.gwm \
simple-win.gwm \
staynormal.xpm \
staynormal_pressed.xpm \
stayonbottom_pressed.xpm \
stayontop.xpm \
stayontop_pressed.xpm \
std-func.gwm \
std-popups.gwm \
std-virtual.gwm \
string.gwm \
stripes.xbm \
style.gwm \
suntools-keys.gwm \
term-icon-xpm.gwm \
term-icon.gwm \
timeout-win.gwm \
trace-func.gwm \
twm-icon-mgr.gwm \
twm-menus.gwm \
twm-popups.gwm \
twm-titled-win.gwm \
twm.gwm \
twmrc.gwm \
unconf-move.gwm \
up-door.gwm \
utils.gwm \
vb-bar.gwm \
vb-button.gwm \
vb-term.gwm \
virtual-action.gwm \
virtual-door.gwm \
virtual-pan.gwm \
virtual.gwm \
vscreen.gwm \
vtwm-icon-mgr.gwm \
vtwm-icon.gwm \
vtwm-menu.gwm \
vtwm-multimenu.gwm \
vtwm-squeezed-window.gwm \
vtwm-squeezed-window2.gwm \
vtwm-window.gwm \
vtwm-zoom.gwm \
vtwm.gwm \
vtwmrc.gwm \
wallpaper.gwm \
wbrooms.gwm \
widgets.gwm \
wind-menu.gwm \
xcol-icon.xpm \
xenon.xpm \
xload.xbm \
xpm-icon.gwm \
xpostit-icon.xpm \
xrn-busy.xpm \
xrn-nonews.xpm \
xrn.xpm \
xterm-b.xbm \
xterm-bl.xbm \
xterm-br.xbm \
xterm-l.xbm \
xterm-r.xbm \
xterm-t.xbm \
xterm-tl.xbm \
xterm-tr.xbm \
xterm.xbm \
xterm.xpm \
xterm2-e.xpm \
xterm2-n.xpm \
xterm2-ne.xpm \
xterm2-nw.xpm \
xterm2-s.xpm \
xterm2-se.xpm \
xterm2-sw.xpm \
xterm2-w.xpm \
xterm3-e.xpm \
xterm3-n.xpm \
xterm3-ne.xpm \
xterm3-nw.xpm \
xterm3-s.xpm \
xterm3-se.xpm \
xterm3-sw.xpm \
xterm3-w.xpm \
zoom.xbm
MakeDirectories(install,$(GWMDIR))
InstallMultipleFlags($(DATA),$(GWMDIR),$(INSTDATFLAGS))

57
data/LRom1.xpm Normal file
View File

@ -0,0 +1,57 @@
/* XPM */
static char *LRom1_xpm[] = {
"68 34 20 1",
" c None s None",
". c maroon",
"X c gray10",
"o c pink4",
"O c PeachPuff4",
"+ c DarkSlateGray",
"@ c white",
"# c tan",
"$ c SlateBlue",
"% c gainsboro",
"& c yellow",
"* c cyan",
"= c blue",
"- c green",
"; c LimeGreen",
": c LightSkyBlue",
"? c orange",
"> c OrangeRed",
", c SlateGray",
"< c black",
" ..... ",
" ..... XXXXXXXXX oooooooo ",
" ..... XXXXXXXXX oooooooo ",
" OOOOOOO..... XX+++++XX oooooooo ",
" OOOOOOO..... XX+@@@+XX oooooooo ",
" OO+++OO..... XX+@@@+XX oooooooo ######### ",
" OO+@+OO.....$$$$$$$$XX+@@@+XX%%%&***** oooooooo ######### ",
" OO+@+OO.....$======$XX+++++-%%%%&******* oooooooo ##OOOOO## ",
" OO+@+OO.....$======$XXXXX;;;-%%%&********* oooooooo ##O@@@O## ",
" OO+@+OO.....$======$XXXX;;;;-%%%&***********ooooooo ##O@@@O## ",
" OO+++OO.....$======$XXX;;;;;;-%%&***********ooooooo ##O@@@O## ",
" OOOOOOO.....$======$XX:;;;;;;-%%&************oooooo ##O@@@O## ",
" OOOOOOO.....$======$XX?:;;;;;;-%&*************ooooo ##OOOOO## ",
" OOOOOOO.....$======$X???::;;;;-%%&************ooooo ######### ",
" OOOOOOO.....$======$X?????:;;;;-%&************ooooo ######### ",
" OOOOOOO.....$======$>>?????:;;;,,,,,***********oooo ######### ",
" OOOOOOO.....$======$**>>>???::,,-&*,,**********oooo ######### ",
" OOOOOOO.....$======$*****>>>>,,;+++*,,*********oooo ######### ",
" OOOOOOO.....$======$*********,>+++++*,*********oooo ######### ",
" OOOOOOO.....$======$*********,*+++++*,*********OOOo ######### ",
" OOOOOOO.....$======$*********,*+++++>,*********oooo ######### ",
" O+++++O.....$======$*********,,*+++:,,>>>>*****oooo ######### ",
" O@@@@@O.<<<.$@@@@@@$**********,,*&%,,:????>>>**OOOo ######### ",
" O+++++O.@@@.$@@@@@@$***********,,,,,;;:??????>>@@@o #OOOOOOO# ",
" OOOOOOO.<<<.$@@@@@@$X************&%%-;;:??????OOOOo #@@@@@@@# ",
" O+++++O.....$@@@@@@$X************&%%-;;;::????ooooo #@@@@@@@# ",
" OOOOOOO.....$======$X ************&%%-;;;;::?oooooo #OOOOOOO# ",
" OOOOOOO.....$======$X ************&%%-;;;;;:?oooooo ######### ",
" OOOOOOO.....$$$$$$$$XXX***********&%%%-;;;;;ooooooo ######### ",
" ???????????????????????????**********&%%%-;;;;??????????????????? ",
" ????????????????????????????*********&%%%%-;;???????????????????? ",
" *******&%%%%- ",
" *****&%%% ",
" "};

1163
data/Makefile Normal file
View File

File diff suppressed because it is too large Load Diff

41
data/README.cutewin Normal file
View File

@ -0,0 +1,41 @@
Hi.
This is my first attempt to create a decoration for my favourite window manager GWM.
This file borrows generously from Colas Nahaboo's original version of simple-ed-win.gwm.
Check this window decoration out. All you have to do is to extract this archive in your
GWMPATH and set the decorations for the client you want as follows in your .profile.gwm:
(set-window XTerm cutewin) ; XTerm Clients
If you have any suggestions to improve it, please do let me know. Since I barely know
WOOLisp, (and never did anything with LISP before) if you think some function can be speeded
up by some nifty object-file-looking-code, feel free to email me.
(NOT !! all your suggestions must be in the 0x20 <= x <= 0x7e) range !)
Credits are due of course to Colas for the window manager itself and simple-ed-win.gwm;
Thanks are due to Anders Holst for helping me with the techniques for redefining
standard definitions and also for encouraging me to put this out on the gwm-talk list
along with the instructions for it !!
HAGT
Sundar Ranganathan
sundar@fj-icl.com
Files:
cutewin.gwm
close.xpm
close_pressed.xpm
iconise.xpm
iconise_pressed.xpm
inform.xpm
inform_pressed.xpm
kill.xpm
kill_pressed.xpm
maximise.xpm
maximise_pressed.xpm
staynormal.xpm
staynormal_pressed.xpm
stayonbottom_pressed.xpm
stayontop.xpm
stayontop_pressed.xpm

19
data/README.icon-mgr Normal file
View File

@ -0,0 +1,19 @@
To use the icon manager package, load the file "load-icon-mgr.gwm"
somewhere at the end of your "*rc.gwm" or ".profile.gwm".
If you want to test it first by loading it with eg. "Exec cut", then
you have to do (show-icon-mgr) right after, to make things take effect.
There are still some problems with the MWM profile (since it has to do
everything differently...). First you might need to apply the patch to
the MWM profile I sent out recently, to prevent it from freezing the
server. Still then the icon managers tend to move up or down slowly
every time they are updated. If this happens to you, the fast and ugly
fix for it (until I have found exactly why it happens) is to insert the
following piece of code in "vtwm-icon-mgr.gwm", in the function
'imgr-show-menu', right after the call to 'place-menu' (inside the
same 'progn'):
(with (wob (with (wob menuwob) wob-parent))
(move-window (- (imgr-xpos ele) window-client-x)
(- (imgr-ypos ele) window-client-y)))

115
data/README.twm Normal file
View File

@ -0,0 +1,115 @@
TWM EMULATOR FOR GWM
====================
Arup Mukherjee (arup@grasp.cis.upenn.edu)
December, 1989
RESTRICTIONS
- ------------
Feel free to do whatever you want with this code, as long as
you respect the gwm copyright for all code derived from the gwm
standard profiles. It would be nice, however, if my name were to
remain in it somewhere.
If you enhance the code in any useful way, or have suggestions
for improvement, I would be happy to hear from you. Send mail to
arup@grip.cis.upenn.edu or arup@grasp.cis.upenn.edu
I DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL I
BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION
OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
Author: Arup Mukherjee, University of Pennsylvania.
GETTING STARTED
- ---------------
To get get the twm emulator to be loaded and executed, simply
use the command "gwm -f twm" to load it.
This allows you the additional flexibility, if you decide to
customize your setup, to copy twmrc.gwm and/or twm.gwm to your
home (or home/gwm) directory and modify them there.
CUSTOMIZING
- -----------
twmrc.gwm :
Numerous options (mainly colors) can be set from here. The
file is well commented, and most of the color variables have
self-explanatory names. You can also specify from here whether or not
the icon manager code is to be loaded (in particular, if you are on a
multi-screen system *and do not want to use the icon manager* you MUST
disable it or the "normal" iconification will not work properly.
.profile.gwm also contains definitions for the three variables
emacs-list, xterm-list, and xload-list. The specified hostnames are
used to build menus from which you can have gwm execute the respective
command on a host via the "rsh" mechanism (note that your .rhosts
files must be set up correctly for this to work). Note that unlike
with the standard profile, the rxterm and rxload scripts are *NOT*
used.
twm.gwm :
The only things that one might wish to customize here are the
behaviors (which specify the action of a given button on a given
portion of the screen). If the twm menu package is too slow on your
machine, you might also want to try loading the standard package from
here.
twm-menus :
The contents of all the menus are specified here. To change
more than the xterm, xload, or emacs lists, you should modify this
file.
MISCELLANEOUS
- -------------
Since the twm-titled-win frame type is derived from
simple-ed-win, you can edit the title bar : press ctrl-alt-left on the
title (!).
In future, I plan to add code to produce a drop-down menu of
windows, much like the "TWM Windows" menu that you can get with twm.
If anyone has ideas for other useful features, I'd love to hear them.
Also, I'd like to thank Paul Keener for providing me with
access to a machine with multiple screens to test the namespace stuff
on, Colas Nahaboo for help with debugging at various stages of the
game, and Tom LaStrange, for coming up with the nice twm interface in
the first place.
December, 1989 : Thanks to J.K.Wight@newcastle.ac.uk for his redesign
suggestions, and to kaplan@cs.uiuc.edu for information that helped
with debugging.
FILES:
- ------
data/README.twm
data/hilite.xbm
data/iconify.xbm
data/resize.xbm
data/twm-icon-mgr.gwm
data/twm-menus.gwm
data/twm-popups.gwm
data/twm-titled-win.gwm
data/twm.gwm
data/twmrc.gwm

32
data/README.virtual Normal file
View File

@ -0,0 +1,32 @@
The virtual screen package consists of the files "virtual.gwm",
"virtual-door.gwm" and "virtual-pan.gwm".
It is a inspired by (and in large parts stolen directly from) Emanuel
Jay Berkenbilt's "vscreen.gwm".
Differences with "virtual.gwm" compared to "vscreen.gwm" include:
* The map looks neater, and you can specify different colors for
different kinds of windows.
* It is updated automatically when the window configuration changes.
* The map obeys some mouse events: You can move the real screen by
clicking the left button on the map, or move specific windows by
dragging them on the map with the middle button. Just in case the
map would not get updated automatically in some obscure situation,
you can update it by clicking the right button.
* The file "virtual-door.gwm" provides doors to places on the virtual
screen.
* The file "virtual-pan.gwm" provides either autopanning or "pan on
click", dependent of the value of the variable 'pan-on-click'.
To use it, load "load-virtual.gwm" somewhere at the end of your
"*rc.gwm" or ".profile.gwm". It will load all three files and set up
necessary variables. Check the three files individually for
customization variables.
If you want to test it first by loading it with eg. "Exec cut", then
you also have to do the following (at least the first line, the rest
is optional), to make things take effect:
(virtual-show)
(install-pan-lists)
(add-door "Home")
(add-door "Free Area")

35
data/X.xbm Normal file
View File

@ -0,0 +1,35 @@
#define iImage_width 50
#define iImage_height 50
static char iImage_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0xe0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x38, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0xfe, 0x01, 0x00, 0xe0, 0x1d, 0x00, 0x00, 0xfc,
0x03, 0x00, 0xf0, 0x00, 0x00, 0x00, 0xf8, 0x07, 0x00, 0xf0, 0x0e, 0x00,
0xfc, 0xfb, 0x07, 0xe0, 0x79, 0x00, 0x00, 0x00, 0xf0, 0x0f, 0x00, 0xbc,
0x03, 0x00, 0xf0, 0xef, 0x1f, 0x78, 0x1e, 0x00, 0x00, 0x00, 0xc0, 0x3f,
0x00, 0xde, 0x01, 0x00, 0xe0, 0xdf, 0x3f, 0x3c, 0x0f, 0x00, 0x00, 0x00,
0x80, 0x7f, 0x80, 0x77, 0x00, 0x00, 0x80, 0x7f, 0xff, 0x8c, 0x07, 0x00,
0x00, 0x00, 0x00, 0xfe, 0xc1, 0x3b, 0x00, 0x00, 0x00, 0xfe, 0xfd, 0xe3,
0x01, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xf3, 0x0e, 0x00, 0x00, 0x00, 0xfc,
0xfb, 0xf3, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x79, 0x1f, 0x00, 0x00,
0x00, 0xf8, 0xf7, 0x3d, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xbe, 0x7f,
0x00, 0x00, 0x00, 0xe0, 0x7b, 0x3e, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3c,
0x7f, 0xff, 0x00, 0x00, 0x00, 0xc0, 0x3d, 0xff, 0x00, 0x00, 0x00, 0x00,
0x00, 0x1e, 0xff, 0xfe, 0x01, 0x00, 0x00, 0x70, 0x6f, 0xfe, 0x01, 0x00,
0x00, 0x00, 0x80, 0x07, 0xfc, 0xfb, 0x07, 0x00, 0x00, 0xb8, 0xf7, 0xf9,
0x07, 0x00, 0x00, 0x00, 0xc0, 0x03, 0xf0, 0xef, 0x1f, 0x00, 0x00, 0xee,
0xf9, 0xf7, 0x0f, 0x00, 0x00, 0x00, 0xe0, 0x01, 0xe0, 0xdf, 0x3f, 0x00,
0x00, 0xf7, 0xe0, 0xdf, 0x3f, 0x00, 0x00, 0x00, 0x78, 0x00, 0x80, 0x7f,
0xff, 0x00, 0xc0, 0x3d, 0xc0, 0xbf, 0x7f, 0x00, 0x00, 0x00, 0x3c, 0x00,
0x00, 0xff, 0x00, 0x00, 0xe0, 0x1e, 0x00, 0xff, 0xfe, 0x01, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x38, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0e, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00};

49
data/Xmh-icon.48.xpm Normal file
View File

@ -0,0 +1,49 @@
/* XPM */
static char *xmail_xpm[] = {
"64 38 8 1",
" c None s None",
". c LightSteelBlue4",
"X c LightYellow",
"o c black",
"O c red",
"+ c gray30",
"@ c DarkSlateGray",
"# c gray50",
" ................................. ",
" ..XXXXX.XXXXXXXXXXXXXXXXXXXXXXXXXXX.. ",
" .XXXXXXXXX.XXXXXXXXXXXXXXXXXXXXXXXXXX.. ",
" ..XXXXXXXXXX.XXXXXXXXXXXXXXXXXXXXXXXXXXX.. ",
" .XXXXXXXXXXXX.XXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
" ..XXXXXXXXXXXX.XXXXXXXXXXXXXXXXXXXXXXXXXXX.. ",
" .XXXXXXXXXXXXXX.XXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
" ..XXXXXXXXXXXXXX.XXXXXXXXXXXXXXXXXXXXXXXXXXX.. ",
" .XXXXXXXXXXXXXXXX.XXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
" .XXXXXXXXXXXXXXXX.XXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
" .XXXXXXXXXXXXXXXX.XXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
" .XXXXXXXXXXXXXXXX.XXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
" .XXXXXXXXXXXXXXXXX.XXXXXXXXXXXXXXXXXXXXXXXXXX. ",
" .XXXXXXXXXXXXXXXXX.XXXXXXXXXXXXXXXXXXXXXXXXXX. ",
" .XXXXXXXXXXXXXXXXX.XXXXXXXXXXXXXXXXXXXXXoooooo ",
" .XXXXXXXXXXXXXXXXX.XXXXXXXXXXXXXXXooooooooooOo ",
" .XXXXXXXXXXXXXXXXX.XXXXXXXXooooooooooooooOOOOo ",
" .XXXXXXXXXXXXXXXXX.XXXoooooooooooooooXXoOOOOOo ",
" .XXXXXXXXXXXXXXXXX.XXoooooooooooo......oOOOOOo ",
" .XXXXXXXXXXXXXXXXX.XXoooooooo..........oOOOOOo ",
" .XXXXXXXXXXXXXXXXX.XXXoooX.......XXXX..oOOOOOo ",
" .XXXXXXXXXXXXXXXXX.XXXXX....XXXXXXXXX..oOOOOOo ",
" .XXXXXXXXXXXXXXXXX.XXXXXXXXXXXXXXXXXX..oOOOOOo ",
" .XXXXXXXXXXXXXXXXX.XXXXXXXXXXXXXXXXXX..oOOOOOo ",
" .XXXXXXXXXXXXXXXXX.XXXXXXXXXXXXXXXXXX..oOOOOOo ",
" .XXXXXXXXXXXXXXXXX.XXXXXXXXXXXXXXXXXX..oOOOOOo ",
" ..XXXXXXXXXXXXXXXX.XXXXXXXXXXXXXXXXXX..oOOOOOo ",
" ...XXXXXXXXXXXXX.XXXXXXXXXXXXXXX... oOOOOOo ",
" ...XXXXXXXXXX.XXXXXXXXXXX.... oOOOoo ",
" ..XXXXXXXX.XXXXXXXX... oOOo ",
" ...XXXXX.XXXXX...++. ooo ",
" ...XX.X....+++++. o ",
" ...@+++++++++. ",
" .@@@@+++++++. ",
" @@@@@++++###. ",
" @@@@@+######. ",
" @@@@@#######. ",
" @@@@@#######. "};

64
data/Xmh-icon.78.xpm Normal file
View File

@ -0,0 +1,64 @@
/* XPM */
static char *xnomail_xpm[] = {
"64 51 10 1",
" c None s None",
". c gray30",
"X c LightSteelBlue4",
"o c red",
"O c DarkSlateGray",
"+ c yellow",
"@ c gray70",
"# c gray20",
"$ c white",
"% c gray50",
" ooo ",
" oooooo ",
" ooooooooo ",
" .oooooooooooo ",
" .oooooooooooo ",
" .oooooooooooo ",
" .oooooooooooo ",
" .......XXXXXXXXX.ooooooooooooXXXXX ",
" ..OOOOO..++++++++.oooooooooooo+++++XX ",
" ..OOOOOOO..+++++++.oooooooooooo++++++XX ",
" .OOOOOOOOOOO.++++++.oooooooooooo++++++++XX ",
" .XXXOOOOOOOOO.++@@@.oooooooooooo+++++++++X ",
" .XXXXXOOOOOOOOO++@@@.ooooooooooo.+++++++++XX ",
" .XXXXXXOOOOOOOO.++@@.ooooooooo..+++++++++++X ",
" .XXXXXXXOOOOOOOOO++@@.ooooooo..@@@++++++++++XX ",
" .XXXXXXXXOOOOOOOO.+@@.ooooo..@@@@@+++++++++++X ",
" .XXXXXXXXOOOOOOOO.+@@.ooo..@@@@++++++++++++++X ",
" .XXXXXXXXOOOOOOOO.++@.oo.@@@@++++++++++++++++X ",
" .XXXXXXXXXOOOOOOO.++@.oo@@@++++++++++++++++++X ",
" .XXXXXXXXXOOOOOO##.+@.oo@++++++++++++++++++++X ",
" .XXXXXXXXOOO####$$.+@.oo+++++++++++++++++++++X ",
" .XXXXXXX####$$$$$$.+@.oo+++++++++++++++++++++X ",
" .XXX####$$$$$$$$$$.+@.oo+++++++++++++++++++++X ",
" ####$$$$$$$$$$$$$$.+@.oo+++++++++++++++++++++X ",
" ####$$$$$$$$$$$$$$$$$$.+@.oo+++++++++++++++++++++X ",
" ##$$$$$$$$$$$$$$$$$$$$$$.+@.oo+++++++++++++++++++++X ",
" #####$$$$$$$$$$$$$$$$$$.+@.oo+++++++++++++++++++++X ",
" #$$$#######$$$$$$$$$$$.+@.oo+++++++++++++++++++++X ",
" #$$$$$$$$$#######$$$$.@..ooo++++++++++++++++++++X ",
" ##$$$$$$$$$$$$$$####.@.ooooo+++++++++++++++++++X ",
" #$$$$$$$$$$$$$$$$$.+.ooooo+++++++++++++++++X%X ",
" .#$$$$$$$$$$$$$$$$.+.ooooo+++++++++++++++%%% ",
" .O#$$$$$$$$$$$$$$$.+..oooo+++++++++++++XX ",
" ...O#$$$$$$$$$$$$$$.++..oo+++++++++++XXX ",
" .++...#$$$$$$$$$$$$$.+++++++++++++++XXX ",
" ..++++++#$$$$$$$$$$$$.++++++++++++XXX ",
" ..++++++++#$$$$$$$$$$$.+++++++++XXX ",
" .+++++++++++##$$$$$$$$$.++++++XXX.X ",
"...+++++++++++++#$$$$$$$#.+++XXX....X ",
".++++++++++++++++#$$$$##X.XXXX......X ",
"++++++++++++++++++#$##+++.XOO.......X ",
"+++++++++++++++++++#++++..OOO....%%%X ",
"++++++++++++++++++++++...OOOO.%%%%%%X ",
"+++++++++++++++++++++.. OOOOO%%%%%%%X ",
"++++++++++++++++++.. OOOOO%%%%%%%X ",
"++++++++++++++++.. OOOOO%%%%%%%X ",
"++++++++++++++.. OOOOO%%%%%%%X ",
"++++++++++++.. OOOOO%%%%%%%X ",
"+++++++... OOOOO%%%%%%%X ",
"++.. OOOOO%%%%%%%X ",
".. OOOOO%%%%%%%X "};

55
data/Xrn-icon.xpm Normal file
View File

@ -0,0 +1,55 @@
/* XPM */
static char *xrn_xpm[] = {
/*blue*/
"64 38 13 1",
" c None s None",
". c blue",
"X c green",
"o c OrangeRed",
"O c LightSkyBlue",
"+ c cyan",
"@ c violet",
"# c gray",
"$ c LightSteelBlue4",
"% c yellow",
"& c gray70",
"* c gainsboro",
"= c navy",
" ..... ",
" ............. ",
" ................. ",
" ................... ",
" ....................... ",
" .XX....XX.............oo. ",
" .XXX....XXX............ooo. ",
" .XXX....XXX...........oooo. ",
" .XXXX...XXXX...........ooooo. ",
" .XXXXXX..XXX............oooooo. ",
" .XXXXXXX.XX......X...ooooooooo. ",
" .XXXXXXXX.........XXX.oooooooooo. ",
" .XXXXXXX..........XXXOOOoooooooo. ",
" .XXXXXX..........XXXOOOOooX++++X. ",
" .XXXXXX..........XXXOOOOXX+++++X. ",
" .XXX.XXX..........XXOOOOOXX+++++... ",
" .X...XX............XO.@@OXX+++XXXX. ",
" #####..............X....X..@@XXX+++XXXX. ",
" ### #$$$$$..............XX......@@@XXX+XXXXX. ",
" $$$# #$$ .X.............XXX....@@@XXXXXXXXX. ",
" $# $## #$ ..............XX..o@@@@@XXXX...X. ",
" $# $$$#$$ .X...........XXX.oo@@@%%XXX...... ",
" $$ $$$ .XX.............oooo%%%%XXXXX.... ",
" $# .XX.............ooooo%ooXXXXXX... ",
" $# .XXX...........oooooooo....XXX. ",
" $$#######$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ ",
" $$$$$$$$&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&$$ ",
" $$&&***********=====**********===**=*=*=*=$$$ ",
" $&&&&==============================*=*====$$$$ ",
" $&&****************************=&*=*=*=&&&$$$$$ ",
" $&&&============================&&*=*=*=&&$$$$$ ",
" $&&**=*************************=&&*=*=*=&&$$$$$=== ",
" $$&&&============================&&*=*=*=&&$$$$==== ",
" $&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&$$$$==== ",
" $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$=== ",
" $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$==== ",
" $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$=== ",
" =========================================== "};

30
data/Zircon-icon.no Normal file
View File

@ -0,0 +1,30 @@
/* XPM */
static char * Zircon-icon_no[] = {
"21 21 6 1 0 0",
" s None c None",
". c yellow",
"X c yellow3",
"o c hot pink",
"O c indianred2",
"+ c red",
" ..... ",
" ........... ",
" ....XXXXX.... ",
" ...XXXXXXXXX... ",
" ..XXXXoooooXXXX.. ",
" ...XXoooooooooXX... ",
" ..XXoooOOOOOoooXX.. ",
" ..XXooOOOOOOOooXX.. ",
"..XXooOOO+++OOOooXX..",
"..XXooOO+++++OOooXX..",
"..XXooOO+++++OOooXX..",
"..XXooOO+++++OOooXX..",
"..XXooOOO+++OOOooXX..",
" ..XXooOOOOOOOooXX.. ",
" ..XXoooOOOOOoooXX.. ",
" ...XXoooooooooXX... ",
" ..XXXXoooooXXXX.. ",
" ...XXXXXXXXX... ",
" ....XXXXX.... ",
" ........... ",
" ..... "};

72
data/Zircon-icon.yes Normal file
View File

@ -0,0 +1,72 @@
/* XPM */
static char * Zircon-icon_yes[] = {
"61 61 8 1",
" s None c None",
". c yellow",
"X c red",
"o c blue1",
"O c green",
"+ c yellow3",
"@ c hot pink",
"# c indianred2",
" ..................... ",
" ........................... ",
" ............................... ",
" ................................. ",
" ..................................... ",
" .............XXXXXXXXXXXXX............. ",
" ............XXXXXXXXXXXXXXXXXXX............ ",
" ...........XXXXXXXXXXXXXXXXXXXXXXX........... ",
" ..........XXXXXXXXXXXXXXXXXXXXXXXXXXX.......... ",
" ..........XXXXXXXXXXXXXXXXXXXXXXXXXXXXX.......... ",
" ........XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX........ ",
" ........XXXXXXXXXXXXoooooooooooXXXXXXXXXXXX........ ",
" ........XXXXXXXXXXoooooooooooooooooXXXXXXXXXX........ ",
" .......XXXXXXXXXoooooooooooooooooooooXXXXXXXXX....... ",
" .......XXXXXXXXXoooooooooooooooooooooooXXXXXXXXX....... ",
" ........XXXXXXXoooooooooooooooooooooooooooXXXXXXX........ ",
" .......XXXXXXXoooooooooOOOOOOOOOOOoooooooooXXXXXXX....... ",
" .......XXXXXXXooooooooOOOOOOOOOOOOOOOooooooooXXXXXXX....... ",
" .......XXXXXXXoooooooOOOOOOOOOOOOOOOOOoooooooXXXXXXX....... ",
" ......XXXXXXXooooooOOOOOOOOOOOOOOOOOOOOOooooooXXXXXXX...... ",
".......XXXXXXooooooOOOOOOOOO+++++OOOOOOOOOooooooXXXXXX.......",
"......XXXXXXXooooooOOOOOO+++++++++++OOOOOOooooooXXXXXXX......",
"......XXXXXXooooooOOOOOO+++++++++++++OOOOOOooooooXXXXXX......",
"......XXXXXXoooooOOOOOO+++++++++++++++OOOOOOoooooXXXXXX......",
".....XXXXXXXoooooOOOOO++++++@@@@@++++++OOOOOoooooXXXXXXX.....",
".....XXXXXXoooooOOOOO+++++@@@@@@@@@+++++OOOOOoooooXXXXXX.....",
".....XXXXXXoooooOOOOO++++@@@#####@@@++++OOOOOoooooXXXXXX.....",
".....XXXXXXoooooOOOOO++++@@#######@@++++OOOOOoooooXXXXXX.....",
".....XXXXXXoooooOOOO++++@@###XXX###@@++++OOOOoooooXXXXXX.....",
".....XXXXXXoooooOOOO++++@@##XXXXX##@@++++OOOOoooooXXXXXX.....",
".....XXXXXXoooooOOOO++++@@##XXXXX##@@++++OOOOoooooXXXXXX.....",
".....XXXXXXoooooOOOO++++@@##XXXXX##@@++++OOOOoooooXXXXXX.....",
".....XXXXXXoooooOOOO++++@@###XXX###@@++++OOOOoooooXXXXXX.....",
".....XXXXXXoooooOOOOO++++@@#######@@++++OOOOOoooooXXXXXX.....",
".....XXXXXXoooooOOOOO++++@@@#####@@@++++OOOOOoooooXXXXXX.....",
".....XXXXXXoooooOOOOO+++++@@@@@@@@@+++++OOOOOoooooXXXXXX.....",
".....XXXXXXXoooooOOOOO++++++@@@@@++++++OOOOOoooooXXXXXXX.....",
"......XXXXXXoooooOOOOOO+++++++++++++++OOOOOOoooooXXXXXX......",
"......XXXXXXooooooOOOOOO+++++++++++++OOOOOOooooooXXXXXX......",
"......XXXXXXXooooooOOOOOO+++++++++++OOOOOOooooooXXXXXXX......",
".......XXXXXXooooooOOOOOOOOO+++++OOOOOOOOOooooooXXXXXX.......",
" ......XXXXXXXooooooOOOOOOOOOOOOOOOOOOOOOooooooXXXXXXX...... ",
" .......XXXXXXXoooooooOOOOOOOOOOOOOOOOOoooooooXXXXXXX....... ",
" .......XXXXXXXooooooooOOOOOOOOOOOOOOOooooooooXXXXXXX....... ",
" .......XXXXXXXoooooooooOOOOOOOOOOOoooooooooXXXXXXX....... ",
" ........XXXXXXXoooooooooooooooooooooooooooXXXXXXX........ ",
" .......XXXXXXXXXoooooooooooooooooooooooXXXXXXXXX....... ",
" .......XXXXXXXXXoooooooooooooooooooooXXXXXXXXX....... ",
" ........XXXXXXXXXXoooooooooooooooooXXXXXXXXXX........ ",
" ........XXXXXXXXXXXXoooooooooooXXXXXXXXXXXX........ ",
" ........XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX........ ",
" ..........XXXXXXXXXXXXXXXXXXXXXXXXXXXXX.......... ",
" ..........XXXXXXXXXXXXXXXXXXXXXXXXXXX.......... ",
" ...........XXXXXXXXXXXXXXXXXXXXXXX........... ",
" ............XXXXXXXXXXXXXXXXXXX............ ",
" .............XXXXXXXXXXXXX............. ",
" ..................................... ",
" ................................. ",
" ............................... ",
" ........................... ",
" ..................... "};

200
data/advice.gwm Normal file
View File

@ -0,0 +1,200 @@
;; advice.gwm --- A general package for redefining functions
;;
;; Author: Anders Holst (aho@sans.kth.se)
;; Copyright (C) 1996 Anders Holst
;; Last change: 23/3 1996
;;
;; This file is copyrighted under the same terms as the rest of GWM
;; (see the X Inc license for details). There is no warranty that it
;; works.
;;
;; ---------------------------------------------------------------------
;;
;; This package implements a way to redefine functions in a controlled
;; and uniform way. It is modeled mainly after the "advice" package in
;; Emacs. If everyone uses this package when they redefine functions
;; in GWM, this will minimize the risk of collisions between different
;; packages redefining the same function. It will also prevent the
;; case that a function gets ruined because some file is (accidentally)
;; loaded twice, and then tries to redefine the same function twice.
;;
;; The main function 'advice' is used like this:
;; (advice <FUNCTION> <TAG> <TYPE> <BODY ...>)
;; The <TAG> is an atom which is used as a label for this piece of
;; advice. If the same function is adviced twice with the same label
;; (and with the same <TYPE>), the old advice will be replaced. Also it
;; makes it possible to remove a particular advice.
;; There are three possible values of <TYPE>: 'before', 'after', and
;; 'around', depending on whether the advice is to be run before, after,
;; or around the call to the original function.
;; <FUNCTION> can actually be either the function name, or a list with
;; the function name followed by formal arguments. These arguments will
;; then be bound to the corresponding actual arguments during execution
;; of the body. In both cases the symbol 'args' will be bound to the
;; whole argument list.
;; During execution of the body of an 'around' advice, the original
;; function name is temporarily rebound to the original function (or,
;; well, it's a little complicated, but something to that effect
;; anyway), so to mark where the original function should go you just
;; call the function again at that point. If you are not sure how many
;; arguments the function got, or don't want to use the optional
;; parameter list, you can always call the original function with the
;; construct '(apply <FUNCTION> args)'.
;; Note that if you advice a "macro" (ie defunq) its arguments is
;; unevaluated during the execution of the body, and still the "original"
;; function in an 'around' advice works like a macro, which means that
;; the arguments to the original call may be evaluated once too less if
;; you are not careful. In any case it should always work to call the
;; original function as '(apply <FUNCTION> args)'.
;;
;; There is also a function 'unadvice' which is used like this:
;; (unadvice <FUNCTION> [<TAG>])
;; It removes the advice with tag <TAG> from the function (or it
;; removes advices with that tag of all three advice types). If no
;; tag is given, all advices are removed, and the function is set to
;; its original again.
;;
;; If some package would like to be sure to use the original,
;; un-redefined version of some function by some reason, it can always
;; use '(advice-original <FUNCTION>)' to retrieve it. But NOTE, this
;; should *not* be used in the body of an 'around' advice, since this
;; would ruin other packages 'around' advices.
;;
(defun advice-embed-body (argl body)
(if (not argl)
(eval (+ '(lambda (args)) body))
(with (len (length argl)
ctx (list-make (* len 2))
i 0)
(while (< i len)
(## (* i 2) ctx (# i argl))
(## (+ (* i 2) 1) ctx (list '# i 'args))
(setq i (+ i 1)))
(eval (list 'lambda '(args) (+ (list 'with ctx) body))))))
(defun advice-construct-inner (hooks i symb origf)
(if (not hooks)
origf
(not (< i (length hooks)))
(if (member (type origf) '(fsubr fexpr))
(eval (` (lambdaq args
(with ((, symb)
(, (eval symb)))
(eval (+ (list (, origf)) args))))))
(eval (` (lambda args
(with ((, symb)
(, (eval symb)))
(eval (+ (list (, origf))
(mapfor ele args (list 'quote ele)))))))))
(if (member (type origf) '(fsubr fexpr))
(eval (` (lambdaq args
(with ((, symb)
(, (advice-construct-inner hooks (+ i 1) symb origf)))
((, (# i hooks)) args)))))
(eval (` (lambda args
(with ((, symb)
(, (advice-construct-inner hooks (+ i 1) symb origf)))
((, (# i hooks)) args))))))))
(defunq advice args
(with (func (if (= (type (# 0 args)) 'list)
(# 0 (# 0 args))
(# 0 args))
argl (if (= (type (# 0 args)) 'list)
(sublist 1 (length (# 0 args)) (# 0 args))
())
adtag (eval (# 1 args))
adtype (eval (# 2 args))
body (sublist 3 (length args) args)
origsymb (atom (+ "ad_" func "_orig"))
presymb (atom (+ "ad_" func "_pre"))
postsymb (atom (+ "ad_" func "_post"))
insymb (atom (+ "ad_" func "_in"))
hook () pos ())
(if (not (boundp origsymb))
(progn
(set origsymb (eval func))
(set presymb (copy '(() ())))
(set postsymb (copy '(() ())))
(set insymb (copy '(() () ())))
(set func (if (member (type (eval func)) '(fsubr fexpr))
(eval (` (lambdaq args
(with (ad_res ())
(for f (# 0 (, presymb)) (f args))
(setq ad_res
(eval (+ (list (# 2 (, insymb))) args)))
(for f (# 0 (, postsymb)) (f args))
ad_res))))
(eval (` (lambda args
(with (ad_res ())
(for f (# 0 (, presymb)) (f args))
(setq ad_res
(eval (+ (list (# 2 (, insymb)))
(mapfor e args (list 'quote e)))))
(for f (# 0 (, postsymb)) (f args))
ad_res))))))
(## 2 (eval insymb) (eval origsymb))))
(setq hook (if (= adtype 'before)
(eval presymb)
(= adtype 'after)
(eval postsymb)
(= adtype 'around)
(eval insymb)))
(setq pos (member adtag (# 1 hook)))
(if hook
(progn
(if pos
(## pos (# 0 hook) (advice-embed-body argl body))
(= adtype 'after)
(progn
(## 0 hook (+ (# 0 hook)
(list (advice-embed-body argl body))))
(## 1 hook (+ (# 1 hook) (list adtag))))
(progn
(## 0 hook (+ (list (advice-embed-body argl body))
(# 0 hook)))
(## 1 hook (+ (list adtag) (# 1 hook)))))
(if (= adtype 'around)
(## 2 hook (advice-construct-inner (# 0 hook) 0 func (eval origsymb))))
)
(? "Bad advice type: " adtype))
(if hook t ())))
(defunq unadvice args
(with (func (if (= (type (# 0 args)) 'list)
(# 0 (# 0 args))
(# 0 args))
adtag (eval (# 1 args))
origsymb (atom (+ "ad_" func "_orig"))
presymb (atom (+ "ad_" func "_pre"))
postsymb (atom (+ "ad_" func "_post"))
insymb (atom (+ "ad_" func "_in"))
hook () pos () ret ())
(if (boundp origsymb)
(if adtag
(progn
(for hook (list (eval presymb) (eval postsymb) (eval insymb))
(setq pos (member adtag (# 1 hook)))
(if pos
(progn
(setq ret t)
(delete-nth pos (# 0 hook))
(delete-nth pos (# 1 hook)))))
(if pos
(## 2 hook (advice-construct-inner (# 0 hook)
0 func (eval origsymb))))
ret)
(progn
(set func (eval origsymb))
(unbind presymb)
(unbind postsymb)
(unbind insymb)
(unbind origsymb)
t)))))
(defunq advice-original (func)
(with (origsymb (atom (+ "ad_" func "_orig")))
(if (boundp origsymb)
(eval origsymb)
(eval func))))

13
data/arrow-f.xbm Normal file
View File

@ -0,0 +1,13 @@
#define arrowFore_width 19
#define arrowFore_height 32
#define arrowFore_x_hot 1
#define arrowFore_y_hot 0
static char arrowFore_bits[] = {
0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x06, 0x00, 0x00, 0x0e, 0x00, 0x00,
0x1e, 0x00, 0x00, 0x3e, 0x00, 0x00, 0x7e, 0x00, 0x00, 0xfe, 0x00, 0x00,
0xfe, 0x01, 0x00, 0xfe, 0x03, 0x00, 0xfe, 0x07, 0x00, 0xfe, 0x0f, 0x00,
0xfe, 0x1f, 0x00, 0xfe, 0x3f, 0x00, 0xfe, 0x7f, 0x00, 0xfe, 0xff, 0x00,
0xfe, 0xff, 0x01, 0xfe, 0xff, 0x03, 0xfe, 0x07, 0x00, 0xfe, 0x0f, 0x00,
0xbe, 0x0f, 0x00, 0x8e, 0x1f, 0x00, 0x02, 0x1f, 0x00, 0x00, 0x3f, 0x00,
0x00, 0x3e, 0x00, 0x00, 0x7e, 0x00, 0x00, 0x7c, 0x00, 0x00, 0xfc, 0x00,
0x00, 0xf8, 0x00, 0x00, 0xf8, 0x00, 0x00, 0x30, 0x00, 0x00, 0x00, 0x00};

13
data/arrow-m.xbm Normal file
View File

@ -0,0 +1,13 @@
#define arrowMask_width 19
#define arrowMask_height 32
#define arrowMask_x_hot 1
#define arrowMask_y_hot 0
static char arrowMask_bits[] = {
0x02, 0x00, 0x00, 0x07, 0x00, 0x00, 0x0f, 0x00, 0x00, 0x1f, 0x00, 0x00,
0x3f, 0x00, 0x00, 0x7f, 0x00, 0x00, 0xff, 0x00, 0x00, 0xff, 0x01, 0x00,
0xff, 0x03, 0x00, 0xff, 0x07, 0x00, 0xff, 0x0f, 0x00, 0xff, 0x1f, 0x00,
0xff, 0x3f, 0x00, 0xff, 0x7f, 0x00, 0xff, 0xff, 0x00, 0xff, 0xff, 0x01,
0xff, 0xff, 0x03, 0xff, 0xff, 0x07, 0xff, 0xff, 0x03, 0xff, 0x1f, 0x00,
0xff, 0x1f, 0x00, 0xff, 0x3f, 0x00, 0x8f, 0x3f, 0x00, 0x82, 0x7f, 0x00,
0x00, 0x7f, 0x00, 0x00, 0xff, 0x00, 0x00, 0xfe, 0x00, 0x00, 0xfe, 0x01,
0x00, 0xfc, 0x01, 0x00, 0xfc, 0x01, 0x00, 0xf8, 0x00, 0x00, 0x30, 0x00};

16
data/arrow3d-f.xbm Normal file
View File

@ -0,0 +1,16 @@
#define arrow3d_width 32
#define arrow3d_height 32
#define arrow3d_x_hot 0
#define arrow3d_y_hot 0
static char arrow3d_bits[] = {
0x03, 0x00, 0x00, 0x00, 0x0d, 0x00, 0x00, 0x00, 0x36, 0x00, 0x00, 0x00,
0xca, 0x00, 0x00, 0x00, 0x14, 0x03, 0x00, 0x00, 0x24, 0x0c, 0x00, 0x00,
0x48, 0x30, 0x00, 0x00, 0x88, 0xc1, 0x00, 0x00, 0x90, 0x06, 0x03, 0x00,
0x10, 0x19, 0x0c, 0x00, 0x20, 0x61, 0x30, 0x00, 0x20, 0x82, 0xc1, 0x00,
0x40, 0x02, 0x06, 0x03, 0x40, 0x04, 0xf8, 0x07, 0x80, 0x04, 0x54, 0x03,
0x80, 0x08, 0xaa, 0x01, 0x00, 0x09, 0xd5, 0x0a, 0x00, 0x91, 0x6a, 0x55,
0x00, 0x52, 0xb5, 0x2a, 0x00, 0xa2, 0x5a, 0x15, 0x00, 0x64, 0xad, 0x0a,
0x00, 0xa4, 0x56, 0x05, 0x00, 0x68, 0xab, 0x02, 0x00, 0xa8, 0x55, 0x01,
0x00, 0xf0, 0xaa, 0x00, 0x00, 0x70, 0x55, 0x00, 0x00, 0xa0, 0x2a, 0x00,
0x00, 0x00, 0x15, 0x00, 0x00, 0x80, 0x0a, 0x00, 0x00, 0x00, 0x05, 0x00,
0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x01, 0x00};

16
data/arrow3d-m.xbm Normal file
View File

@ -0,0 +1,16 @@
#define arrow3d-mask_width 32
#define arrow3d-mask_height 32
#define arrow3d-mask_x_hot 0
#define arrow3d-mask_y_hot 0
static char arrow3d-mask_bits[] = {
0x07, 0x00, 0x00, 0x00, 0x1f, 0x00, 0x00, 0x00, 0x7f, 0x00, 0x00, 0x00,
0xfe, 0x01, 0x00, 0x00, 0xfe, 0x07, 0x00, 0x00, 0xfc, 0x1f, 0x00, 0x00,
0xfc, 0x7f, 0x00, 0x00, 0xf8, 0xff, 0x01, 0x00, 0xf8, 0xff, 0x07, 0x00,
0xf0, 0xff, 0x1f, 0x00, 0xf0, 0xff, 0x7f, 0x00, 0xe0, 0xff, 0xff, 0x01,
0xe0, 0xff, 0xff, 0x07, 0xc0, 0xff, 0xff, 0x0f, 0xc0, 0xff, 0xff, 0x07,
0x80, 0xff, 0xff, 0x03, 0x80, 0xff, 0xff, 0x0a, 0x00, 0xff, 0x7f, 0x55,
0x00, 0xff, 0xbf, 0x2a, 0x00, 0xfe, 0x5f, 0x15, 0x00, 0xfe, 0xaf, 0x0a,
0x00, 0xfc, 0x57, 0x05, 0x00, 0xfc, 0xab, 0x02, 0x00, 0xf8, 0x55, 0x01,
0x00, 0xf8, 0xaa, 0x00, 0x00, 0x70, 0x55, 0x00, 0x00, 0xf0, 0x2a, 0x00,
0x00, 0x20, 0x15, 0x00, 0x00, 0x80, 0x0a, 0x00, 0x00, 0x00, 0x05, 0x00,
0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x01, 0x00};

14
data/arrowhole-f.xbm Normal file
View File

@ -0,0 +1,14 @@
#define arrowholeFore_width 21
#define arrowholeFore_height 34
#define arrowholeFore_x_hot 1
#define arrowholeFore_y_hot 0
static char arrowholeFore_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x0c, 0x00, 0x00,
0x1c, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x7c, 0x00, 0x00, 0xfc, 0x00, 0x00,
0xfc, 0x01, 0x00, 0xdc, 0x03, 0x00, 0x9c, 0x07, 0x00, 0x1c, 0x0f, 0x00,
0x1c, 0x1e, 0x00, 0x1c, 0x3c, 0x00, 0x1c, 0x78, 0x00, 0x1c, 0xf0, 0x00,
0x1c, 0xfe, 0x01, 0xdc, 0xff, 0x03, 0xfc, 0xff, 0x07, 0xfc, 0x0f, 0x00,
0xfc, 0x1f, 0x00, 0x7c, 0x1f, 0x00, 0x1c, 0x3f, 0x00, 0x04, 0x3e, 0x00,
0x00, 0x7e, 0x00, 0x00, 0x7c, 0x00, 0x00, 0xfc, 0x00, 0x00, 0xf8, 0x00,
0x00, 0xf8, 0x01, 0x00, 0xf0, 0x01, 0x00, 0xf0, 0x01, 0x00, 0x60, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00};

14
data/arrowhole-m.xbm Normal file
View File

@ -0,0 +1,14 @@
#define arrowholeMask_width 21
#define arrowholeMask_height 34
#define arrowholeMask_x_hot 1
#define arrowholeMask_y_hot 0
static char arrowholeMask_bits[] = {
0x00, 0x00, 0x00, 0x04, 0x00, 0x00, 0x0e, 0x00, 0x00, 0x1e, 0x00, 0x00,
0x3e, 0x00, 0x00, 0x7e, 0x00, 0x00, 0xfe, 0x00, 0x00, 0xfe, 0x01, 0x00,
0xfe, 0x03, 0x00, 0xfe, 0x07, 0x00, 0xfe, 0x0f, 0x00, 0xbe, 0x1f, 0x00,
0x3e, 0x3f, 0x00, 0x3e, 0x7e, 0x00, 0x3e, 0xfc, 0x00, 0x3e, 0xfe, 0x01,
0xfe, 0xff, 0x03, 0xfe, 0xff, 0x07, 0xfe, 0xff, 0x0f, 0xfe, 0xff, 0x07,
0xfe, 0x3f, 0x00, 0xfe, 0x3f, 0x00, 0xfe, 0x7f, 0x00, 0x1e, 0x7f, 0x00,
0x04, 0xff, 0x00, 0x00, 0xfe, 0x00, 0x00, 0xfe, 0x01, 0x00, 0xfc, 0x01,
0x00, 0xfc, 0x03, 0x00, 0xf8, 0x03, 0x00, 0xf8, 0x03, 0x00, 0xf0, 0x01,
0x00, 0x60, 0x00, 0x00, 0x00, 0x00};

4
data/back.xbm Normal file
View File

@ -0,0 +1,4 @@
#define back_width 8
#define back_height 8
static char back_bits[] = {
0x21, 0x84, 0x22, 0x88, 0x12, 0x41, 0x04, 0x51};

42
data/barA2..xpm Normal file
View File

@ -0,0 +1,42 @@
/* XPM */
static char *barA2__xpm[] = {
"11 34 4 2",
" c white",
". c DarkGray",
"X c gray30",
"o c black",
/* pixels*/
" ",
" ",
". . . . . . . . . . . ",
". . . . . . . . . . . ",
". . . X X . . . . ",
". . X . . X . . . ",
". X . . . . X . . ",
" X . . . . . . X . ",
"X . . . . . . X . ",
". X . . . . X . . ",
". . X . . X . . . ",
". . . X X . . . . ",
". . . . . . . . . . . ",
". . . X X . . . . ",
". . X . . X . . . ",
". X . . . . X . . ",
" X . . . . . . X . ",
"X . . . . . . X . ",
". X . . . . X . . ",
". . X . . X . . . ",
". . . X X . . . . ",
". . . . . . . . . . . ",
". . . X X . . . . ",
". . X . . X . . . ",
". X . . . . X . . ",
" X . . . . . . X . ",
"X . . . . . . X . ",
". X . . . . X . . ",
". . X . . X . . . ",
". . . X X . . . . ",
". . . . . . . . . . . ",
". . . . . . . . . . . ",
"o o o o o o o o o o o ",
"o o o o o o o o o o o "};

41
data/barA2.l.xpm Normal file
View File

@ -0,0 +1,41 @@
/* XPM */
static char *barA2_l_xpm[] = {
"5 34 3 2",
" c white",
". c DarkGray",
"X c black",
/* pixels*/
" ",
" ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" . . . ",
" X X X X ",
"X X X X X "};

41
data/barA2.r.xpm Normal file
View File

@ -0,0 +1,41 @@
/* XPM */
static char *barA2_r_xpm[] = {
"5 34 3 2",
" c white",
". c black",
"X c DarkGray",
/* pixels*/
" ",
" . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
"X X X . . ",
". . . . . ",
". . . . . "};

64
data/bind-key.gwm Normal file
View File

@ -0,0 +1,64 @@
;; bind-key.gwm --- Bind keys or buttons to actions dynamically
;;
;; Author: Anders Holst (aho@sans.kth.se)
;; Copyright (C) 1995 Anders Holst
;; Last change: 9/2
;;
;; This file is copyrighted under the same terms as the rest of GWM
;; (see the X Inc license for details). There is no warranty that it
;; works.
;;
;; ---------------------------------------------------------------------
;;
;; The function 'bind-key' can be used to globally (ie in all windows
;; and in the root) bind a key or button to some WOOL code action.
;; The binding takes effect immediately after the call.
;;
;; The first argument to 'bind-key' can be an event (constructed with
;; key, keypress, keyrelease, button, buttonpress or buttonrelease), a
;; string denoting a key (like "a" or "F1" or "Insert"), or a number
;; denoting a mouse button. It may also be a list where the first element
;; is a string or number and the second element specifies which modifiers
;; to use (with-shift, with-alt etc).
;;
;; The second argument is the WOOL code to run. To unbind a key or
;; button, use () as the second argument.
;;
;; For example:
;; (bind-key "F1" '(? "Silly action\n")) ; Bind F1.
;; (bind-key "F1" ()) ; Unbind it again.
;;
(defun bind-interpret-event (event)
(if (= (type event) 'event)
event
(= (type event) 'string)
(keypress (key-make event) alone)
(= (type event) 'number)
(buttonbress event alone)
(and (= (type event) 'list)
(= (type (# 0 event)) 'string))
(keypress (key-make (# 0 event))
(eval (+ '(together) (sublist 1 (length event) event))))
(and (= (type event) 'list)
(= (type (# 0 event)) 'number))
(buttonpress (# 0 event)
(eval (+ '(together) (sublist 1 (length event) event))))))
(defun bind-root-behavior (event action)
(if (boundp 'root-behavior)
(with (wob root-window
behavior (eval (list 'on event action))
grab (eval event))
(setq root-behavior (state-make behavior root-behavior))
(setq root-fsm (fsm-make root-behavior))
(wob-fsm root-fsm)
(if action
(set-grabs grab)
(unset-grabs grab)))))
(defun bind-key (event action)
(with (event (bind-interpret-event event))
(if event
(bind-root-behavior event action))))

17
data/bull_1.xbm Normal file
View File

@ -0,0 +1,17 @@
#define bull_1_width 60
#define bull_1_height 20
static char bull_1_bits[] = {
0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x01, 0xff, 0x1f, 0xc2,
0xff, 0xff, 0xff, 0xff, 0x01, 0xfe, 0x1f, 0xc2, 0xff, 0xff, 0xff, 0xff,
0x33, 0xfe, 0x7f, 0xce, 0xff, 0xff, 0xff, 0xff, 0x73, 0xfe, 0x7f, 0xce,
0xff, 0xff, 0xff, 0xff, 0x73, 0xfe, 0x7f, 0xce, 0xff, 0xff, 0xff, 0xff,
0x73, 0xfe, 0x7f, 0xce, 0xff, 0xff, 0xff, 0xff, 0x03, 0x86, 0x73, 0xce,
0xff, 0xff, 0xff, 0xff, 0x03, 0x87, 0x73, 0xce, 0xff, 0xff, 0xff, 0xff,
0x73, 0x9e, 0x73, 0xce, 0xff, 0xff, 0xff, 0xff, 0xf3, 0x9c, 0x73, 0xce,
0xff, 0xff, 0xff, 0xff, 0xf3, 0x9c, 0x73, 0xce, 0xff, 0xff, 0xff, 0xff,
0xf3, 0x9c, 0x73, 0xce, 0xff, 0xff, 0xff, 0xff, 0x73, 0x9c, 0x71, 0xce,
0xff, 0xff, 0xff, 0xff, 0x01, 0x1c, 0x70, 0xce, 0xff, 0xff, 0xff, 0xff,
0x01, 0x3e, 0x20, 0x84, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
0xff, 0xff, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0,
0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
0xff, 0xff, 0xff, 0xff};

17
data/bull_2.xbm Normal file
View File

@ -0,0 +1,17 @@
#define bull_2_width 60
#define bull_2_height 20
static char bull_2_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0xa0, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x50, 0x0d, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0xa9, 0x4a, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x55, 0x55, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0xab, 0x6a, 0x00, 0x00, 0x00, 0x00, 0x00,
0x80, 0x55, 0xd5, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0xab, 0x6a, 0x01,
0x00, 0x00, 0x00, 0x00, 0x80, 0xd5, 0xd5, 0x01, 0x00, 0x00, 0x00, 0x00,
0x00, 0xab, 0x6d, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe5, 0xd7, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x81, 0x49, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x81, 0x41, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe1, 0x47, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0xff, 0xff, 0xff, 0xff,
0xff, 0xff, 0xff, 0x0f};

56
data/cdrom1.xpm Normal file
View File

@ -0,0 +1,56 @@
/* XPM */
static char *cdrom1_xpm[] = {
/*blue*/
"64 38 14 1",
" c None s None",
". c gray",
"X c navy",
"o c SlateBlue",
"O c gray70",
"+ c violet",
"@ c gainsboro",
"# c yellow",
"$ c LightSteelBlue4",
"% c orange",
"& c white",
"* c black",
"= c LightSkyBlue",
"- c cyan",
" .......................................X ",
" ......................................XX ",
" ..ooooooooooooooooooooooooooooooooooooXX ",
" ..ooooooooooooooooOOOOOoooooooooooooooXX ",
" ..oooooooooooooOOO+++++OOOooooooooooooXX ",
" ..oooooooooooOO@++++++++++OOooooooooooXX ",
" ##$.oooooooooOO@@@@+++++++++++OOooooooooXX ",
" ###$ ##$$$.ooooooooO@@@@@@+++++++++++++OoooooooXX ",
" ##$$ #$ ..oooooooO@@@@@@@++++++++++++++OooooooXX ",
" ##$ #$ ..ooooooO@@@@@@@@@++++++++++++++OoooooXX ",
" #$ #$ ..ooooooO@@@@@@@@@++++++++++++++OoooooXX ",
" $#$ %# ..oooooO@@@@@@@@@@@++++++++++++++OooooXX ",
" $#$ $%%#..oooooO+@@@@@@@@@@++++++++++++++OooooXX ",
" $%# $$%##ooooO++++@@@@@@@@&&&++++++++++++OoooXX ",
" $%# $%%#oooO++++++@@@@OO@++&&++++++++++OoooXX ",
" $# $$%%#oO++++++++@OO@***++&+++++++++OoooXX ",
" $# ..$$%##++++#####&@*ooo*+&++++++++++OooXX ",
" $% ..oo$%%#++##===##*ooooo*+&+++++++++OooXX ",
" $% ..ooo$$%###=&&&==#ooooo*+&+++++++++O*oXX ",
" $%# ..oooO+$###===&==##oooo*+&+++++++++O*oXX ",
" $%# ##### ..oooO+$#==&&&==&-#ooo*@@@+++++++++O*oXX ",
" $%# ##=====##.ooooO#=====&&&-&##**@@@O@@@+++++O**oXX ",
" $%# ##==&&&==##oooo$#=======&&==#++@OOO@@@@@@@+O**oXX ",
" $# #=====&&==##ooo$#========&#=#&&+@@@@@@@@@@@O*ooXX ",
" $% ##=&&&&--&==##oo$#==========###++@@@@@@@@@@O**ooXX ",
" $%# #=====&&--&==#oo$#============#+++@@@@@@@@@O*oooXX ",
" $%# #=======&&===##$##==========###+++@@@@@@@@O**oooXX ",
" $%# #========&====#$#=======####$$$+++@@@@@@@@O*ooooXX ",
" $%# #=============#$#===####$$$$$$$++++@@@@@@O**ooooXX ",
" $%###==============####$$$$$$$$$+++++++@@@@@O**oooooXX ",
" $$%#===========####$$$$$$$$$++++++++++++@@OO**ooooooXX ",
" $%#========##$$$$$$$$$oo**OO+++++++++++OO***oooooooXX ",
" $%#===##$$$$$$$$$$oooooooo**OOO+++++OOO****ooooooooXX ",
" $%##$$$$$$$$$..ooooooooooooo***OOOOO*****ooooooooooXX ",
" $$$$$$$$ ..oooooooooooooooo*******oooooooooooooXX ",
" $$$ ..ooooooooooooooooooooooooooooooooooooXX ",
" ..XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ",
" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX "};

36
data/clipboard.xpm Normal file
View File

@ -0,0 +1,36 @@
/* XPM */
static char *clipboard_xpm[] = {
"47 28 5 1",
" c None m None g None s None",
". c black m black g black",
"X c DarkGray m white g gray65",
"o c yellow m white g gray80",
"O c white m white g white",
" ...... ",
" .XXXXXX. ",
" .XXXXXXXX. ",
" .. .XXX....XX. ",
" .XX... .XXX. ..XX. ",
" ..XXX... .XXX....XXXX. ",
" ..XXXX.... .XXX.XXXXXXX. ",
" ...XXXXX... .XXXXXXXXXX.. ",
" ..XXXXXX....XXXXXXX... ",
" ...XXXXXXX..XXX.. .",
" ...XXX..........................",
" ...XXX.X.oooooooooooooooooooooooo..",
" ...XXXXX...ooooooo...o.ooooooooooooo..",
" ..XXXX.......ooooooo.ooo.ooooooooooooo..",
" ..XXXX...OOOOO.ooooooo.ooo.o.o.o...ooooo..",
" ..XXX...OOOOOOOO.ooooooo.o.o.o.o.o.o.ooooo..",
" .XX... ...OOOOO.ooooooo.o.o.o.o.o...ooooo..",
" .. .......ooooooo.o.o.o.o.o.ooooooo..",
" O .ooooooo...o.o...o...ooooo..",
" OOO .oooooooooooooooooooooooo..",
" O O ..........................",
" OOO .",
" OOOOO ",
" OOO OOO ",
" OOOOO O ",
" OOOOO ",
" OOOOO ",
" OOO "};

8
data/close-18.xbm Normal file
View File

@ -0,0 +1,8 @@
#define close_18_width 18
#define close_18_height 18
static char close_18_bits[] = {
0x00, 0x00, 0x03, 0x00, 0x00, 0x03, 0x5c, 0xd5, 0x03, 0xbc, 0xea, 0x03,
0x7c, 0xf5, 0x03, 0xf8, 0xfa, 0x03, 0xf4, 0x7d, 0x03, 0xe8, 0xbf, 0x03,
0xd4, 0x5f, 0x03, 0xa8, 0xaf, 0x03, 0xd4, 0x5f, 0x03, 0xe8, 0xbf, 0x03,
0xf4, 0x7d, 0x03, 0xf8, 0xfa, 0x03, 0x7c, 0xf5, 0x03, 0xbc, 0xea, 0x03,
0xff, 0xff, 0x03, 0xff, 0xff, 0x03};

29
data/close.xpm Normal file
View File

@ -0,0 +1,29 @@
/* XPM */
static char * close_xpm[] = {
"24 24 2 1",
" c #FFFFFFFFFFFF",
". c #000000000000",
" .",
" ..",
" . . . . . . . . . ...",
" . . . . . . . . . . ..",
" . . . . . . . . . ...",
" . . . . . . . . . . ..",
" . . . . . . . . . ...",
" . . ... . . ... . . ..",
" . ..... . ..... . ...",
" . . ..... ..... . . ..",
" . . ......... . . ...",
" . . . ....... . . . ..",
" . . . ..... . . . ...",
" . . . ....... . . . ..",
" . . ......... . . ...",
" . . ..... ..... . . ..",
" . ..... . ..... . ...",
" . . ... . . ... . . ..",
" . . . . . . . . . ...",
" . . . . . . . . . . ..",
" . . . . . . . . . ...",
" . . . . . . . . . . ..",
" .......................",
"........................"};

29
data/close_pressed.xpm Normal file
View File

@ -0,0 +1,29 @@
/* XPM */
static char * close_pressed_xpm[] = {
"24 24 2 1",
" c #000000000000",
". c #FFFFFFFFFFFF",
" .",
" ..",
" . . . . . . . . . . ..",
" . . . . . . . . . ...",
" . . . . . . . . . . ..",
" . . . . . . . . . ...",
" . . . . . . . . . . ..",
" . . . . . . . ...",
" . . . . . . ..",
" . . . . . ...",
" . . . . . . ..",
" . . . . . . ...",
" . . . . . . . . ..",
" . . . . . . ...",
" . . . . . . ..",
" . . . . . ...",
" . . . . . . ..",
" . . . . . . . ...",
" . . . . . . . . . . ..",
" . . . . . . . . . ...",
" . . . . . . . . . . ..",
" . . . . . . . . . ...",
" ......................",
" ......................."};

26
data/compat.gwm Normal file
View File

@ -0,0 +1,26 @@
; GWM: backwards compatibility
; ============================
;;File: compat.gwm -- redefines old behaviors
;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
;;Revision: 1.0 -- Aug 29 89
;;State: Exp
;;GWM Version: 1.4
; say (uses-gwm-version "1.4.1.13" t) at the head of sections needing
; 1.4.1.13 behavior, and (uses-gwm-version "1.4.1.13" ()) to revert to current
; version.
(defun uses-gwm-version (old-version entering)
(if
(= old-version "1.4.1.13")
(if entering {
} {
}
)
)
)))

4
data/cornerPlug.xbm Normal file
View File

@ -0,0 +1,4 @@
#define corner_width 2
#define corner_height 2
static char corner_bits[] = {
0x02, 0x03};

80
data/cursor-names.gwm Normal file
View File

@ -0,0 +1,80 @@
; list of names for standard cursors
; from: cursorfont.h,v 1.2 88/09/06 16:44:27 jim Exp
(: XC_X_cursor 0)
(: XC_arrow 2)
(: XC_based_arrow_down 4)
(: XC_based_arrow_up 6)
(: XC_boat 8)
(: XC_bogosity 10)
(: XC_bottom_left_corner 12)
(: XC_bottom_right_corner 14)
(: XC_bottom_side 16)
(: XC_bottom_tee 18)
(: XC_box_spiral 20)
(: XC_center_ptr 22)
(: XC_circle 24)
(: XC_clock 26)
(: XC_coffee_mug 28)
(: XC_cross 30)
(: XC_cross_reverse 32)
(: XC_crosshair 34)
(: XC_diamond_cross 36)
(: XC_dot 38)
(: XC_dotbox 40)
(: XC_double_arrow 42)
(: XC_draft_large 44)
(: XC_draft_small 46)
(: XC_draped_box 48)
(: XC_exchange 50)
(: XC_fleur 52)
(: XC_gobbler 54)
(: XC_gumby 56)
(: XC_hand1 58)
(: XC_hand2 60)
(: XC_heart 62)
(: XC_icon 64)
(: XC_iron_cross 66)
(: XC_left_ptr 68)
(: XC_left_side 70)
(: XC_left_tee 72)
(: XC_leftbutton 74)
(: XC_ll_angle 76)
(: XC_lr_angle 78)
(: XC_man 80)
(: XC_middlebutton 82)
(: XC_mouse 84)
(: XC_pencil 86)
(: XC_pirate 88)
(: XC_plus 90)
(: XC_question_arrow 92)
(: XC_right_ptr 94)
(: XC_right_side 96)
(: XC_right_tee 98)
(: XC_rightbutton 100)
(: XC_rtl_logo 102)
(: XC_sailboat 104)
(: XC_sb_down_arrow 106)
(: XC_sb_h_double_arrow 108)
(: XC_sb_left_arrow 110)
(: XC_sb_right_arrow 112)
(: XC_sb_up_arrow 114)
(: XC_sb_v_double_arrow 116)
(: XC_shuttle 118)
(: XC_sizing 120)
(: XC_spider 122)
(: XC_spraycan 124)
(: XC_star 126)
(: XC_target 128)
(: XC_tcross 130)
(: XC_top_left_arrow 132)
(: XC_top_left_corner 134)
(: XC_top_right_corner 136)
(: XC_top_side 138)
(: XC_top_tee 140)
(: XC_trek 142)
(: XC_ul_angle 144)
(: XC_umbrella 146)
(: XC_ur_angle 148)
(: XC_watch 150)
(: XC_xterm 152)

274
data/custom-install.gwm Normal file
View File

@ -0,0 +1,274 @@
;; custom-install.gwm --- Hack to install custom-menu functionality
;;
;; Author: Anders Holst (aho@sans.kth.se)
;; Copyright (C) 1996 Anders Holst
;; Last change: 23/3 1996
;;
;; This file is copyrighted under the same terms as the rest of GWM
;; (see the X Inc license for details). There is no warranty that it
;; works.
;;
;; ---------------------------------------------------------------------
;;
;; This file tries to install the "custom-menu" package functionality.
;; It loads the suitable files, it installs loading and saving of the
;; customization file in the appropriate hooks, it tries to insert
;; the "Customize" alternative in the root menu, and it redefines a
;; bunch of functions to fool packages which do not support custom-menu
;; to support it anyway.
;;
;; In the standard profile you should load this file at the beginning of
;; ".profile.gwm".
;; In the vtwm profile, for maximum effect you have to load it from the
;; file "vtwm.gwm", just after the settings of 'screen-opening' and
;; 'screen-closing', but before the definition of user customizable
;; variables (that is, load it around line 449, if there are no changes
;; done to the distributed file).
;; For the mwm profile, the custom-menu package is unfortunately not
;; applicable, since the mwm profile is too different in its philosophy
;; of how things should be done.
;;
(load "edit-plug")
(load "advice")
(load "custom-menu")
(defaults-to
custom-hierarchy-by-name t
custom-root-menu-position 1)
;;
;; Make sure that the customization file is loaded in the beginning
;; and saved again at the end of the session.
;;
(defunq ci-add-hook (hook expr)
(if (not (boundp hook))
(set hook expr)
(= (# 0 (eval hook)) 'progn)
(set hook (+ '(progn) (list expr)
(sublist 1 (length (eval hook)) (eval hook))))
(set hook (+ '(progn) (list expr) (list (eval hook))))))
(custom-load-preferences)
(ci-add-hook screen-opening (custom-apply-preferences custom-global-preferences))
(ci-add-hook screen-closing (custom-save-preferences))
;;
;; Here we try to redefine some suitable functions, to make packages
;; install themselves in the global customization menu.
;;
(setq load-filename ())
(setq custom-already-installed ())
(setq custom-install-list ())
;; Make sure to advice the *original* load
(if (and (boundp 'original-load)
(not (eq original-load load)))
(advice (original-load f)
'custom-install 'around
(with (res ()
load-filename (match "\\([^/]*\\)$" f 1)
custom-already-installed ()
custom-install-list ())
(setq res (original-load f))
(if (not custom-already-installed)
(custom-smart-install load-filename custom-install-list))
res))
(advice (load f)
'custom-install 'around
(with (res ()
load-filename (match "\\([^/]*\\)$" f 1)
custom-already-installed ()
custom-install-list ())
(setq res (load f))
(if (not custom-already-installed)
(custom-smart-install load-filename custom-install-list))
res))
)
(advice defaults-to
'custom-install 'before
(setq custom-install-list (+ custom-install-list args)))
(advice custom-install-symbols
'custom-install 'before
(setq custom-already-installed t))
(ci-add-hook screen-opening
(if (not custom-already-installed)
(custom-smart-install () custom-install-list)))
(setq custom-smart-install-hooks
'(virtual (virtual-show)
virtual-door (door-mgr-show)
virtual-pan (if show-pan-lists
(install-pan-lists)
(remove-pan-lists))
vtwm-icon-mgr (icon-mgr-show)
fvwm-window (custom-redecorate-some-windows 'fvwm-window)
fvwm-icon (custom-redecorate-some-icons 'fvwm-icon)
vtwm-window (progn (custom-redecorate-some-windows 'vtwm-window)
(custom-redecorate-some-windows ()))
simple-ed-win (progn (setq simple-ed-win.data ())
(custom-redecorate-some-windows 'simple-ed-win))
))
(setq custom-smart-install-avoid
'(() (root-pop root-behavior vtwm-grabs)
vtwm-icon-mgr (default-icon-mgr icon-mgr-list)
load-virtual t
def-menus (root-pop window-pop icon-pop)
))
(defun custom-redecorate-some-windows (win-func)
(with (oldwob wob)
(setq wob root-window)
(for wob (list-of-windows 'window)
(if (and (not (= window-client-class 'Gwm))
(= win-func (std-resource-get 'GwmWindow)))
(re-decorate-window)))
(if (wob-is-valid oldwob)
(setq wob oldwob))))
(defun custom-redecorate-some-icons (win-func)
(with (oldwob wob)
(setq wob root-window)
(for wob (list-of-windows 'icon)
(if (and (not (= window-client-class 'Gwm))
(= win-func (std-resource-get 'GwmIconWindow)))
(re-decorate-window)))
(if (wob-is-valid oldwob)
(setq wob oldwob))))
(defun custom-smart-install (name args)
(with (basename (if (match "^\\(.[^.]*\\)" name)
(match "^\\(.[^.]*\\)" name 1))
partname (if (match "^\\([^-]*\\)" name)
(match "^\\([^-]*\\)" name 1))
instname basename
len (/ (length args) 2)
res (list-make len)
hook (# (atom basename) custom-smart-install-hooks)
avoid (# (atom basename) custom-smart-install-avoid)
i 0)
(while (< i len)
(## i res (# (* i 2) args))
(setq i (+ i 1)))
(if (= avoid t)
(setq res ())
avoid
(while (> i 0)
(setq i (- i 1))
(if (member (# i res) avoid)
(delete-nth i res))))
(if custom-hierarchy-by-name
(if (and basename partname
(not (= basename partname))
(custom-find-name custom-global-menu-descr partname))
(setq instname (list partname basename))))
(if res
(custom-install-symbols instname res))
(if (and res hook)
(custom-install-hook instname hook))))
;;
;; Try to install a call to '(custom-global-menu)' in the root menu.
;; This is easy in the standard profile, but trickier for vtwm.
;;
(if (not custom-root-menu-position)
()
(and (boundp 'insert-at)
(boundp 'root-pop-items))
(if (not (with (found ())
(for ele root-pop-items
(if (and (= (type ele) 'list)
(member '(custom-global-menu) ele))
(setq found t)))
found))
(insert-at '(item-make "Customize" (custom-global-menu))
root-pop-items (max 1 (min (length root-pop-items)
(if (< custom-root-menu-position 0)
(+ (length root-pop-items)
custom-root-menu-position 1)
custom-root-menu-position)))))
(boundp 'construct-menu)
(advice construct-menu
'custom-install2 'around
(if (and (= (type (# 0 args)) 'string)
(match "^[Rr]oot" (# 0 args))
(not (with (found ())
(for ele args
(if (and (= (type ele) 'list)
(member '(custom-global-menu) ele))
(setq found t)))
found)))
(setq args (+ (sublist 0 (max 1 (min (length args)
(if (< custom-root-menu-position 0)
(+ (length args)
custom-root-menu-position 1)
custom-root-menu-position) args)))
'(("Customize" (custom-global-menu)))
(sublist (max 1 (min (length args)
(if (< custom-root-menu-position 0)
(+ (length args)
custom-root-menu-position 1)
custom-root-menu-position)))
(length args) args))))
(apply construct-menu args))
(advice (load f)
'custom-install2 'after
(if (boundp 'construct-menu)
(progn
(advice construct-menu
'custom-install2 'around
(if (and (= (type (# 0 args)) 'string)
(match "^[Rr]oot" (# 0 args))
(not (with (found ())
(for ele args
(if (and (= (type ele) 'list)
(member '(custom-global-menu) ele))
(setq found t)))
found)))
(setq args (+ (sublist 0
(max 1 (min (length args)
(if (< custom-root-menu-position 0)
(+ (length args)
custom-root-menu-position 1)
custom-root-menu-position)))
args)
'(("Customize" (custom-global-menu)))
(sublist (max 1 (min (length args)
(if (< custom-root-menu-position 0)
(+ (length args)
custom-root-menu-position 1)
custom-root-menu-position)))
(length args) args))))
(apply construct-menu args))
(unadvice load 'custom-install2))))
)
;;
;; Install this package's variables, in the same menu as "custom-menu".
;;
(with (custom-already-installed ())
(custom-install-symbols '("custom-menu")
'("custom-install"
custom-hierarchy-by-name
custom-root-menu-position))
)

692
data/custom-menu.gwm Normal file
View File

@ -0,0 +1,692 @@
;; custom-menu.gwm --- User-friendlier package customizations
;;
;; Author: Anders Holst (aho@sans.kth.se)
;; Copyright (C) 1996 Anders Holst
;; Last change: 23/3 1996
;;
;; This file is copyrighted under the same terms as the rest of GWM
;; (see the X Inc license for details). There is no warranty that it
;; works.
;;
;; ---------------------------------------------------------------------
;;
;; This file implements a way for other packages to provide easy
;; customization via menus, without spending too much effort on it
;; themselves.
;;
;;
;; The main function is '(custom-menu <MENU-DESCRIPTION>)'.
;;
;; In the simplest case its argument is a list of strings and variables,
;; and it constructs a menu where the user can edit the values of the
;; given variables. Typically the first element in the list should be
;; the name of the menu, but any strings in the list show up as labels.
;;
;; The list can also contain other "menu descriptions" as elements.
;; They will turn up as buttons leading to these "sub-menus". Note that
;; then the first element in each sub-menu description *must* be
;; the name of it (and not a variable or a sub-description).
;;
;; Actually, the first element in each menu-description can also be a
;; list where the first element is the name of it and the rest an
;; association list. Currently the only supported field in this
;; association list is 'hook', which should be some code to run whenever
;; the value of a variable is changed in the menu.
;;
;; To start edit a value in the menu, you click in the corresponding
;; field. If the variable 'custom-immediate-change' is non-nil, the
;; variable is assigned to the new value as soon you finish editing.
;; There is also a special construct, to allow more complex values. If
;; the field starts with a comma (,) the following expression is
;; evaluated before the assignment.
;;
;; But that's all there is to it really.
;;
;; The rest of the code in this file is to provide a simple way
;; for packages to install their customizable variables in a global
;; custom-menu hierarchy, and to maintain the user's variable settings
;; between GWM sessions.
;;
;;
;; There are two functions intended to be used by the package developer:
;; (custom-install-symbols <PACKAGE-NAME> <SYMBOL-LIST>)
;; (custom-install-hook <PACKAGE-NAME> <HOOK-CODE>)
;;
;; The <PACKAGE-NAME> is either a string, or a list of strings serving
;; as a "path" through the menu hierarchy. <SYMBOL-LIST> is the list of
;; all customizable variables in the package. <HOOK-CODE> is a piece of
;; code (quoted) to run whenever any of the customizable variables
;; have changed. It is of course not necessary to provide such a hook,
;; but it is very nice to have one.
;;
;; Another thing to consider for the package developer is to make the
;; variables suitable for customization in this way. Colors and fonts
;; should *not* be stored as numbers but as the strings used when
;; creating them. The contents of variables should preferably not be
;; very long lists, since these are hard to edit. If values are cached
;; there should be some way of updating the cache when the values have
;; changed, and if values are not cached the package should not assume
;; that the contents of variables will remain the same during the whole
;; session.
;;
;;
;; There are three functions intended for the GWM user:
;; (custom-global-menu)
;; (custom-load-preferences)
;; (custom-save-preferences)
;;
;; '(custom-global-menu)' brings you into the top of the custom-menu
;; hierarchy. It is most suitably called from the root menu.
;;
;; The function '(custom-load-preferences)' can be called either when
;; loading the profile, or from the 'screen-opening' hook and
;; '(custom-save-preferences)' can be called from the 'screen-closing'
;; hook. They try to maintain a file ".customize.gwm" where the
;; variables the user have changed through the custom menus are saved.
;;
(declare-screen-dependent
custom-font
custom-symbol-font
custom-value-font
custom-value-font-slant
custom-background
custom-foreground
custom-button-background
custom-value-background
custom-value-frame
custom-immediate-feedback
custom-immediate-change
custom-keep-comma-string
custom-preference-file
custom-global-preferences
custom-preferences-changed
custom-global-menu-descr
)
;;
;; USER CUSTOMIZABLE VARIABLES
;; ---------------------------
;; Adjust these in your own profile
;;
(with (wob wob)
(for screen (list-of-screens)
(defaults-to
custom-font "6x13bold"
custom-symbol-font "6x13"
custom-value-font "6x13"
custom-value-font-slant 0
custom-foreground "black"
custom-background "lightcyan"
custom-button-background "white"
custom-value-background "white"
custom-value-frame t
custom-immediate-feedback t
custom-immediate-change t
custom-keep-comma-string t
)))
(with (wob wob)
(for screen (list-of-screens)
(setq custom-global-preferences ())
(setq custom-preferences-changed ())
(setq custom-global-menu-descr '("Customizations"))
))
(with (tmp (getenv "GWM_CUSTOM_FILE"))
(if (= tmp "")
(setq custom-preference-file "./.customize.gwm")
(match "/" tmp)
(setq custom-preference-file tmp)
(setq custom-preference-file (+ "./" tmp))))
(if (not (boundp 'edit-plug-make))
(load "edit-plug"))
(defun custom-print-to-string (val)
(if (member (type val) '(subr fsubr expr fexpr))
"<PROC>"
(= (type val) 'string)
(+ "\"" val "\"")
(= (type val) 'list)
(with (parts (mapfor ele val (custom-print-to-string ele))
len (length parts)
res (list-make (+ (* len 2) 1))
i 0 j 1)
(## 0 res "(")
(while (< i len)
(## j res (# i parts))
(## (+ j 1) res " ")
(setq i (+ i 1))
(setq j (+ j 2)))
(## (max 1 (- j 1)) res ")")
(apply + res))
(with-output-to-string (? val))))
(defun custom-read-from-string (_str_)
(with (_res_ ()
_bad_ t)
(error-occurred
(if (match "^," _str_)
(execute-string (+ "(setq _bad_ (error-occurred (setq _res_ "
(match "^.\\(.*\\)$" _str_ 1)
")))"))
(execute-string (+ "(setq _bad_ (error-occurred (setq _res_ (quote "
_str_
"))))"))))
(if _bad_
()
(list _res_))))
(defun custom-substitute-in-string (from to str)
(with (res ()
mlst ()
head str)
(while (> (length (setq mlst (match (+ "\\(.*\\)\\(" from "\\)\\(.*\\)")
head 1 2 3)))
0)
(setq res (+ (list to (# 2 mlst)) res))
(setq head (# 0 mlst)))
(eval (+ '(+) (list head) res))))
;; Specialized normal state, how to start editing.
(: custom-edit-normal-state
(state-make
(on (button any any)
(progn
(send-user-event 'edit-plug-start wob)
(edit-plug-xposition (current-event-relative-x))))
edit-plug-normal-state
))
;; Specialized active state, when to stop or abort editing.
(: custom-edit-active-state
(state-make
(on focus-out
(send-user-event 'edit-plug-done wob))
edit-plug-active-state
))
;; Things to do when starting editing.
(defun custom-start-edit ()
(set-focus wob)
(process-events)) ; To let the focus change take effect before the
; fsm enters the active state. Otherwise the fsm
; may immediately leave the active state again,
; due to some spurious focus-out event.
;; Things to do when editing is done.
(defun custom-end-edit ()
(with (menuwob (custom-top-parent)
immch (# 'immch menuwob)
sym (# 'symbol wob)
str (edit-plug-get)
comma (and custom-keep-comma-string (match "^," str))
res (custom-read-from-string str))
(if res
(if (not (equal (# 2 sym) (if comma str res)))
(progn
(if (not (# 3 sym))
(## 3 sym (or (# 2 sym) t)))
(## 2 sym (if comma str res))
(if immch
(progn
(set (# 0 sym) (# 0 res))
(## 4 sym t)
(eval (# 'hook wob))))
(if (and (not comma) custom-immediate-feedback)
(edit-plug-change (custom-print-to-string (# 0 res))))))
(if custom-immediate-feedback
(edit-plug-change (if (# 2 sym)
(if (= (type (# 2 sym)) 'string)
(# 2 sym)
(custom-print-to-string (# 0 (# 2 sym))))
""))))))
(defun custom-abort-edit ()
())
(defun custom-plug-separator (size)
(with (fsm ()
foreground background)
(plug-make (pixmap-make size 1))))
(defun custom-symbol-plug (label)
(with (fsm ()
font (if (= (type custom-symbol-font) 'number)
custom-symbol-font
(font-make custom-symbol-font))
label-horizontal-margin 2
label-vertical-margin 2)
(plug-make (label-make label))))
(defun custom-label-plug (label)
(with (fsm ()
font (if (= (type custom-font) 'number)
custom-font
(font-make custom-font))
label-horizontal-margin 2
label-vertical-margin 2)
(plug-make (label-make label))))
(defun custom-value-plug (item)
(with (font (if (= (type custom-value-font) 'number)
custom-value-font
(font-make custom-value-font))
font-slant (or custom-value-font-slant 0)
label-horizontal-margin 4
label-vertical-margin 1
edit-plug-start-hook '(custom-start-edit)
edit-plug-done-hook '(custom-end-edit)
edit-plug-abort-hook '(custom-abort-edit)
edit-plug-normal-state custom-edit-normal-state
edit-plug-active-state custom-edit-active-state
property (+ (list 'symbol item 'hook hook) property))
(with (borderwidth (if custom-value-frame 1 0)
borderpixel foreground)
(bar-make
(with (borderwidth 0)
(bar-make
(with (borderwidth 1
background (if custom-value-background
(if (= (type custom-value-background)
'number)
custom-value-background
(color-make custom-value-background))
background)
borderpixel background
active-borderpixel foreground)
(edit-plug-make (if (# 2 item)
(if (= (type (# 2 item)) 'string)
(# 2 item)
(custom-print-to-string (# 0 (# 2 item))))
"")))))))))
(defun custom-button-plug (label action)
(with (font (if (= (type custom-font) 'number)
custom-font
(font-make custom-font))
outer-background background
background (if custom-button-background
(if (= (type custom-button-background) 'number)
custom-button-background
(color-make custom-button-background))
background)
label-horizontal-margin 5
label-vertical-margin 3
pix (label-make label)
dim (dimensions pix))
(draw-rectangle pix 2 2 (- (# 2 dim) 4) (- (# 3 dim) 4) 2 1)
(with (foreground outer-background)
(draw-line pix 0 0 0 1)
(draw-line pix 1 0 1 0)
(draw-line pix 0 (- (# 3 dim) 2) 0 (- (# 3 dim) 1))
(draw-line pix 1 (- (# 3 dim) 1) 1 (- (# 3 dim) 1))
(draw-line pix (- (# 2 dim) 1) 0 (- (# 2 dim) 1) 1)
(draw-line pix (- (# 2 dim) 2) 0 (- (# 2 dim) 2) 0)
(draw-line pix (- (# 2 dim) 1) (- (# 3 dim) 2)
(- (# 2 dim) 1) (- (# 3 dim) 1))
(draw-line pix (- (# 2 dim) 2) (- (# 3 dim) 1)
(- (# 2 dim) 2) (- (# 3 dim) 1)))
(draw-line pix 2 2 2 2)
(draw-line pix (- (# 2 dim) 3) 2 (- (# 2 dim) 3) 2)
(draw-line pix 2 (- (# 3 dim) 3) 2 (- (# 3 dim) 3))
(draw-line pix (- (# 2 dim) 3) (- (# 3 dim) 3)
(- (# 2 dim) 3) (- (# 3 dim) 3))
(with (fsm (fsm-make (state-make (on-eval '(button any any) action))))
(plug-make pix))))
(defun custom-top-parent ()
(with (wob wob
par wob-parent)
(while (not (= par window))
(setq wob wob-parent)
(setq par wob-parent))
wob))
(defun custom-done ()
(with (menuwob (custom-top-parent)
descr (# 'descr menuwob)
hook (# 'hook menuwob)
change ()
res ())
(set-focus)
(process-events)
(for sym descr
(if (and (# 0 sym) (# 2 sym) (# 3 sym) (not (# 4 sym)))
(if (= (type (# 2 sym)) 'string)
(if (setq res (custom-read-from-string (# 2 sym)))
(progn
(set (# 0 sym) (# 0 res))
(setq change t)))
(progn
(set (# 0 sym) (# 0 (# 2 sym)))
(setq change t)))))
(if change
(with (custom-refresh-menu ())
(eval hook)))
(for sym descr
(if (and (# 0 sym) (# 2 sym) (# 3 sym))
(custom-put-preference (# 0 sym) (# 2 sym))))
(if (window-is-valid window)
(delete-window window))))
(defun custom-cancel ()
(with (menuwob (custom-top-parent)
descr (# 'descr menuwob)
hook (# 'hook menuwob)
change ()
res ())
(set-focus)
(process-events)
(for sym descr
(if (and (# 0 sym) (# 3 sym) (# 4 sym))
(if (= (# 3 sym) t)
(unbind (# 0 sym))
(= (type (# 3 sym)) 'string)
(if (setq res (custom-read-from-string (# 3 sym)))
(progn
(set (# 0 sym) (# 0 res))
(setq change t)))
(progn
(set (# 0 sym) (# 0 (# 3 sym)))
(setq change t)))))
(if change
(with (custom-refresh-menu ())
(eval hook)))
(delete-window window)))
(defun custom-construct-menu (descr)
(with (fsm ()
bordertile ()
bar-max-width 3000
bar-min-width 0
background (if (= (type custom-background) 'number)
custom-background
(color-make custom-background))
foreground (if (= (type custom-foreground) 'number)
custom-foreground
(color-make custom-foreground))
borderpixel background
borderwidth 1
direction vertical
align-column 0
bar-list ()
hook (if (not (# 0 (# 0 descr))) (# 'hook (# 2 (# 0 descr)))))
(with (m 0 sz ())
(for ele descr
(if (# 0 ele)
(with (font (if (= (type custom-symbol-font) 'number)
custom-symbol-font
(font-make custom-symbol-font)))
(setq sz (# 2 (dimensions (+ (# 0 ele)))))
(## 1 ele sz)
(setq m (max m sz)))))
(setq align-column (+ m 2)))
(setq bar-list
(mapfor ele descr
(if (# 0 ele)
(bar-make
(custom-plug-separator 5)
(custom-symbol-plug (# 0 ele))
(custom-plug-separator (- align-column (# 1 ele)))
(custom-value-plug ele)
(custom-plug-separator 10))
(= (type (# 1 ele)) 'list)
(bar-make
(custom-plug-separator 10)
(custom-button-plug (if (= (type (# 0 (# 1 ele))) 'string)
(# 0 (# 1 ele))
(# 0 (# 0 (# 1 ele))))
(list 'custom-menu
(list 'quote (# 1 ele))
'(+ window-x 15)
'(+ window-y 15))))
(= (type (# 1 ele)) 'string)
(bar-make
(custom-plug-separator 10)
(custom-label-plug (# 1 ele))))))
(setq bar-list (+ bar-list
(list (bar-make
(custom-plug-separator 10)
(custom-button-plug "Done" '(custom-done))
(custom-plug-separator 15)
(custom-button-plug "Cancel" '(custom-cancel))
(custom-plug-separator 10)))))
(with (property (+ (list 'descr descr
'hook hook
'immch custom-immediate-change) property)
borderpixel foreground)
(apply menu-make bar-list))))
(defun custom-menu _args_
(with (descr (mapfor _cele_ (# 0 _args_)
(if (not (member (type _cele_) '(string list)))
(list _cele_ ()
(or (with (res (custom-get-preference _cele_))
(if (and res (= (type res) 'string)) res ()))
(if (boundp _cele_) (list (eval _cele_)) ()))
() ())
(list () _cele_)))
xpos (if (= (type (# 1 _args_)) 'number) (# 1 _args_))
ypos (if (= (type (# 2 _args_)) 'number) (# 2 _args_))
mn ())
(if (and (not (# 0 (# 0 descr)))
(= (type (# 1 (# 0 descr))) 'list)
(= (type (# 0 (# 1 (# 0 descr)))) 'string))
(## 0 descr (list ()
(# 0 (# 1 (# 0 descr)))
(sublist 1 (length (# 1 (# 0 descr)))
(# 1 (# 0 descr))))))
(setq mn (custom-construct-menu descr))
(if mn
(with (reenter-on-opening ()
dim (dimensions mn)
x (max 10 (/ (- screen-width (# 2 dim)) 3))
y (max 10 (/ (- screen-height (# 3 dim)) 3)))
(if (and xpos ypos)
(place-menu 'custom mn xpos ypos)
(place-menu 'custom mn x y))))))
(defun custom-refresh-menu ()
(with (menuwob (custom-top-parent)
descr (# 'descr menuwob)
hook (# 'hook menuwob)
immch (# 'immch menuwob)
xpos (+ window-x window-client-x
(with (wob window) wob-borderwidth)
(with (wob menuwob) (- wob-borderwidth))
window-client-borderwidth)
ypos (+ window-y window-client-y
(with (wob window) wob-borderwidth)
(with (wob menuwob) (- wob-borderwidth))
window-client-borderwidth)
mn ())
(if (not (= immch custom-immediate-change))
(for sym descr
(if (and (# 0 sym) (# 4 sym))
(## 4 sym ()))))
(setq mn (custom-construct-menu descr))
(if mn
(with (reenter-on-opening ())
(delete-window window)
(place-menu 'custom mn xpos ypos)))))
(defun custom-save-file (file lst)
(with-output-to-file (+ file ":")
(? "(setq tmp '(\n")
(with (i 0)
(while (< i (length lst))
(? (custom-print-to-string (# i lst)) " "
(custom-print-to-string
(if (= (type (# (+ i 1) lst)) 'string)
(custom-substitute-in-string "\"" "\\\""
(# (+ i 1) lst))
(# (+ i 1) lst)))
"\n")
(setq i (+ i 2))))
(? "))\n"))
(! "sh" "-c" (+ "mv " file " " file "~ ; mv " file ": " file " ;"))
)
(defun custom-read-file (file)
(with (tmp 'magicatom)
(error-occurred
(load file))
(if (= tmp 'magicatom)
()
tmp)))
(defun custom-put-preference (var val)
(if (member var custom-global-preferences)
(## var custom-global-preferences val)
(setq custom-global-preferences
(+ custom-global-preferences
(list var val))))
(setq custom-preferences-changed t))
(defun custom-get-preference (var)
(# var custom-global-preferences))
(defun custom-apply-preferences (prefs)
(with (len (length prefs)
i 0
res ())
(while (< i len)
(if (= (type (# (+ i 1) prefs)) 'string)
(if (setq res (custom-read-from-string (# (+ i 1) prefs)))
(set (# i prefs) (# 0 res)))
(set (# i prefs) (# 0 (# (+ i 1) prefs))))
(setq i (+ i 2)))))
(defun custom-save-preferences ()
(if custom-preferences-changed
(custom-save-file custom-preference-file custom-global-preferences))
(setq custom-preferences-changed ()))
(defun custom-load-preferences ()
(setq custom-global-preferences (custom-read-file custom-preference-file))
(custom-apply-preferences custom-global-preferences)
(setq custom-preferences-changed ()))
(defun custom-insert-symbols (lst syms)
(with (len (length lst)
i (- len 1)
syms (copy syms)
s1 ()
s2 ())
(while (and (> i 0) (= (type (# i lst)) 'list))
(setq i (- i 1)))
(setq s1 (sublist 0 (+ i 1) lst))
(setq s2 (sublist (+ i 1) len lst))
(setq i (- (length syms) 1))
(while (> i -1)
(if (member (# i syms) s1)
(delete-nth i syms))
(setq i (- i 1)))
(+ s1 syms s2)))
(defun custom-insert-hook (head hook)
(if (not (= (type head) 'list))
(list head 'hook hook)
(not (member 'hook head))
(+ head (list 'hook hook))
(with (oh (# 'hook head))
(## 'hook head
(if (not oh)
hook
(and (= (type oh) 'list) (= (# 0 oh) 'progn))
(+ oh (list hook))
(list 'progn oh hook))))))
(defun custom-find-name (lst name)
(with (len (length lst)
i 1)
(while (and (< i len)
(not (and (= (type (# i lst)) 'list)
(or (and (= (type (# 0 (# i lst))) 'string)
(= (# 0 (# i lst)) name))
(and (= (type (# 0 (# i lst))) 'list)
(= (type (# 0 (# 0 (# i lst)))) 'string)
(= (# 0 (# 0 (# i lst))) name))))))
(setq i (+ i 1)))
(if (< i len)
i
())))
(defun custom-install-symbols (name syms)
(if (not name)
(setq custom-global-menu-descr
(custom-insert-symbols custom-global-menu-descr syms))
(with (name (if (not (= (type name) 'list)) (list name) name)
len (length name)
i 0
lst1 ()
pos1 ()
lst custom-global-menu-descr
pos ())
(while (< i len)
(setq pos (custom-find-name lst (# i name)))
(if (not pos)
(progn
(if pos1
(## pos1 lst1 (setq lst (+ lst (list (list (# i name))))))
(setq lst (setq custom-global-menu-descr
(+ custom-global-menu-descr
(list (list (# i name)))))))
(setq pos (- (length lst) 1))))
(setq pos1 pos)
(setq lst1 lst)
(setq lst (# pos1 lst1))
(setq i (+ i 1)))
(## pos1 lst1 (custom-insert-symbols lst syms)))))
(defun custom-install-hook (name hook)
(if (not name)
(## 0 custom-global-menu-descr
(custom-insert-hook (# 0 custom-global-menu-descr) hook))
(with (name (if (not (= (type name) 'list)) (list name) name)
len (length name)
i 0
lst1 ()
pos1 ()
lst custom-global-menu-descr
pos ())
(while (< i len)
(setq pos (custom-find-name lst (# i name)))
(if (not pos)
(progn
(if pos1
(## pos1 lst1 (setq lst (+ lst (list (list (# i name))))))
(setq lst (setq custom-global-menu-descr
(+ custom-global-menu-descr
(list (list (# i name)))))))
(setq pos (- (length lst) 1))))
(setq pos1 pos)
(setq lst1 lst)
(setq lst (# pos1 lst1))
(setq i (+ i 1)))
(## 0 lst (custom-insert-hook (# 0 lst) hook)))))
(defun custom-global-menu ()
(custom-menu custom-global-menu-descr))
;; Now, let this package install itself
(custom-install-symbols "custom-menu"
'(custom-font
custom-symbol-font
custom-value-font
custom-value-font-slant
custom-foreground
custom-background
custom-button-background
custom-value-background
custom-value-frame
custom-immediate-feedback
custom-immediate-change
custom-keep-comma-string)
)
(custom-install-hook "custom-menu" '(custom-refresh-menu))

367
data/cutewin.gwm Normal file
View File

@ -0,0 +1,367 @@
; Frame with name on the right
; Iconify, Maximise, Close and Stayontop buttons on the left
; This is my first attempt at writing a gwm window decoration
; ===========================================================================
;;File: cutewin.gwm
;;Author: Sundar Ranganathan - Techlead Corporation Inc.
;;Credit: Colas Nahaboo - Generously borrowed from Colas' simple-ed-win.gwm
;;GWM Version: 1.8c
(defaults-to
cutewin.borderwidth 3
cutewin.font (font-make "-*-clean-bold-*-*-*-16-*-*-*-*-*-*-*")
cutewin.active darkgrey
cutewin.inactive grey
cutewin.label.background (color-make 'navyblue)
cutewin.label.foreground white
edit-keys.return "Return"
edit-keys.backspace "BackSpace"
edit-keys.delete "Delete"
cutewin.context (list
'borderwidth cutewin.borderwidth
'font cutewin.font
'active cutewin.active
'inactive cutewin.inactive
'background cutewin.label.background
'foreground cutewin.label.foreground
)
)
(: cutewin.maximise-fsm
(fsm-make
(state-make
(on (buttonpress 1 any)
(wob-pixmap (pixmap-load "maximise_pressed.xpm")))
(on (buttonrelease 1 any)
(with (cerx (current-event-relative-x)
cery (current-event-relative-y))
(progn
(wob-pixmap (pixmap-load "maximise.xpm"))
(if (and (> cerx 0) (> cery 0) (< cerx wob-width) (< cery wob-height))
(progn (resize-window screen-width screen-height) (move-window 0 0))
))))
standard-title-behavior
standard-behavior
)))
(: cutewin.close-fsm
(fsm-make
(state-make
(on (buttonpress 1 any)
(wob-pixmap (pixmap-load "close_pressed.xpm")))
(on (buttonrelease 1 any)
(with (cerx (current-event-relative-x)
cery (current-event-relative-y))
(progn
(wob-pixmap (pixmap-load "close.xpm"))
(if (and (> cerx 0) (> cery 0) (< cerx wob-width) (< cery wob-height))
(delete-window))
)))
standard-title-behavior
standard-behavior
)))
(: cutewin.kill-fsm
(fsm-make
(state-make
(on (buttonpress 1 any)
(wob-pixmap (pixmap-load "kill_pressed.xpm")))
(on (buttonrelease 1 any)
(with (cerx (current-event-relative-x)
cery (current-event-relative-y))
(progn
(wob-pixmap (pixmap-load "kill.xpm"))
(if (and (> cerx 0) (> cery 0) (< cerx wob-width) (< cery wob-height))
(kill-window))
)))
standard-title-behavior
standard-behavior
)))
(: cutewin.iconise-fsm
(fsm-make
(state-make
(on (buttonpress 1 any)
(wob-pixmap (pixmap-load "iconise_pressed.xpm")))
(on (buttonrelease 1 any)
(with (cerx (current-event-relative-x)
cery (current-event-relative-y))
(progn
(wob-pixmap (pixmap-load "iconise.xpm"))
(if (and (> cerx 0) (> cery 0) (< cerx wob-width) (< cery wob-height))
(progn (iconify-window)(raise-window)))
)))
standard-title-behavior
standard-behavior
)))
(: cutewin.inform-fsm
(fsm-make
(state-make
(on (buttonpress 1 any)
(wob-pixmap (pixmap-load "inform_pressed.xpm")))
(on (buttonrelease 1 any)
(with (cerx (current-event-relative-x)
cery (current-event-relative-y))
(progn
(wob-pixmap (pixmap-load "inform.xpm"))
(if (and (> cerx 0) (> cery 0) (< cerx wob-width) (< cery wob-height))
(print-window-info))
)))
standard-title-behavior
standard-behavior
)))
(: cutewin.stayontop-fsm
(fsm-make
(state-make
(on (buttonpress 1 any)
(wob-pixmap (pixmap-load "stayontop_pressed.xpm")))
(on (buttonpress 2 any)
(wob-pixmap (pixmap-load "stayonbottom_pressed.xpm")))
(on (buttonrelease 1 any)
(with (cerx (current-event-relative-x)
cery (current-event-relative-y))
(progn
(wob-pixmap (pixmap-load "stayontop.xpm"))
(if (and (> cerx 0) (> cery 0) (< cerx wob-width) (< cery wob-height))
(float.toggle 'up))
)))
(on (buttonrelease 2 any)
(with (cerx (current-event-relative-x)
cery (current-event-relative-y))
(progn
(wob-pixmap (pixmap-load "stayontop.xpm"))
(if (and (> cerx 0) (> cery 0) (< cerx wob-width) (< cery wob-height))
(float.toggle 'down))
)))
standard-title-behavior
standard-behavior
)))
(: cutewin.staynormal-fsm
(fsm-make
(state-make
(on (buttonpress 1 any)
(wob-pixmap (pixmap-load "staynormal_pressed.xpm")))
(on (buttonrelease 1 any)
(with (cerx (current-event-relative-x)
cery (current-event-relative-y))
(progn
(wob-pixmap (pixmap-load "staynormal.xpm"))
(if (and (> cerx 0) (> cery 0) (< cerx wob-width) (< cery wob-height))
(float.toggle ()))
)))
standard-title-behavior
standard-behavior
)))
(: cutewin.size-fsm
(fsm-make
(state-make
(on (user-event 'resize)
(wob-tile (label-make (+ "Width: " (itoa window-width) " Height: " (itoa window-height)) cutewin.font )))
standard-title-behavior
standard-behavior
)))
(: cutewin.position-fsm
(fsm-make
(state-make
(on (user-event 'windowmove)
(wob-tile (label-make (+ "X: " (itoa window-x) " Y: " (itoa window-y)) cutewin.font )))
standard-title-behavior
standard-behavior
)))
(: cutewin.titleplug-fsm
(fsm-make
(state-make
(on (user-event 'name-change)
(with (foreground cutewin.label.foreground)
(wob-tile (active-label-make window-name cutewin.font))))
)))
(: cutewin.close-plug
'(with (borderwidth 0 background cutewin.label.background
foreground cutewin.label.foreground
cursor
(with (background (color-make 'DeepPink)
foreground (color-make 'yellow))
(cursor-make XC_hand2)
)
borderpixel background fsm cutewin.close-fsm)
(plug-make (pixmap-load "close.xpm"))))
(: cutewin.kill-plug
'(with (borderwidth 0 background cutewin.label.background
foreground cutewin.label.foreground
cursor
(with (background (color-make 'DeepPink)
foreground (color-make 'yellow))
(cursor-make XC_hand2)
)
borderpixel background fsm cutewin.kill-fsm)
(plug-make (pixmap-load "kill.xpm"))))
(: cutewin.maximise-plug
'(with (borderwidth 0 background cutewin.label.background
foreground cutewin.label.foreground
cursor
(with (background (color-make 'DeepPink)
foreground (color-make 'yellow))
(cursor-make XC_hand2)
)
borderpixel background fsm cutewin.maximise-fsm)
(plug-make (pixmap-load "maximise.xpm"))))
(: cutewin.iconise-plug
'(with (borderwidth 0 background cutewin.label.background
foreground cutewin.label.foreground
cursor
(with (background (color-make 'DeepPink)
foreground (color-make 'yellow))
(cursor-make XC_hand2)
)
borderpixel background fsm cutewin.iconise-fsm)
(plug-make (pixmap-load "iconise.xpm"))))
(: cutewin.inform-plug
'(with (borderwidth 0 background cutewin.label.background
foreground cutewin.label.foreground
cursor
(with (background (color-make 'DeepPink)
foreground (color-make 'yellow))
(cursor-make XC_hand2)
)
borderpixel background fsm cutewin.inform-fsm)
(plug-make (pixmap-load "inform.xpm"))))
(: cutewin.stayontop-plug
'(with (borderwidth 0 background cutewin.label.background
foreground cutewin.label.foreground
cursor
(with (background (color-make 'DeepPink)
foreground (color-make 'yellow))
(cursor-make XC_hand2)
)
borderpixel background fsm cutewin.stayontop-fsm)
(plug-make (pixmap-load "stayontop.xpm"))))
(: cutewin.staynormal-plug
'(with (borderwidth 0 background cutewin.label.background
foreground cutewin.label.foreground
cursor
(with (background (color-make 'DeepPink)
foreground (color-make 'yellow))
(cursor-make XC_hand2)
)
borderpixel background fsm cutewin.staynormal-fsm)
(plug-make (pixmap-load "staynormal.xpm"))))
(: cutewin.title-plug
'(with (borderwidth 0 background cutewin.label.background
foreground cutewin.label.foreground
font cutewin.font
borderpixel background fsm cutewin.titleplug-fsm)
(plug-make '(label-make window-name cutewin.font))))
(: cutewin.size-plug
'(with (borderwidth 0 background cutewin.label.background
foreground cutewin.label.foreground
font cutewin.font
borderpixel background fsm cutewin.size-fsm)
(plug-make '(label-make (+ "Width: " (itoa window-width) " Height: " (itoa window-height)) cutewin.font ))))
(: cutewin.position-plug
'(with (borderwidth 0 background cutewin.label.background
foreground cutewin.label.foreground
font cutewin.font
borderpixel background fsm cutewin.position-fsm)
(plug-make '(label-make (+ "X: " (itoa window-x) " Y: " (itoa window-y)) cutewin.font ))))
(defun update-icon (update-icon.title)
(if (window-icon?)
(send-user-event 'get-title (window-icon))))
(: cutewin.titlebar-fsm
(fsm-make
(state-make
(on (user-event 'focus-in) (wob-background cutewin.active))
(on (user-event 'focus-out) (wob-background cutewin.inactive))
standard-title-behavior
standard-behavior)))
(: cutewin.titlebar
(with (borderwidth 1 background cutewin.inactive
fsm cutewin.titlebar-fsm
plug-separator 1
borderpixel cutewin.label.foreground
)
(bar-make () cutewin.title-plug ())))
(: cutewin.rightbar
(with (borderwidth 1 background cutewin.inactive
fsm cutewin.titlebar-fsm
plug-separator 1
borderpixel cutewin.label.foreground
)
(bar-make cutewin.inform-plug cutewin.iconise-plug cutewin.maximise-plug
cutewin.stayontop-plug cutewin.staynormal-plug cutewin.close-plug
() cutewin.kill-plug)))
(: cutewin.bottombar
(with (borderwidth 1 background cutewin.inactive
fsm cutewin.titlebar-fsm
plug-separator 1
borderpixel cutewin.label.foreground
)
(bar-make cutewin.size-plug () cutewin.position-plug)))
(: cutewin.result '(with (inner-borderwidth 1 fsm cutewin.window-fsm
borderwidth cutewin.borderwidth
borderpixel cutewin.inactive)
; grabs (+ window-grabs
; (if (and (boundp 'emacs-mouse-loaded)
; emacs-mouse-loaded)
; (list (button any with-control)))))
(window-make cutewin.titlebar () cutewin.rightbar
cutewin.bottombar ())))
(defname 'cutewin.data screen. ())
(df cutewin () (if cutewin.data cutewin.data
(: cutewin.data (eval cutewin.result))))
(: cutewin.window-fsm
(fsm-make
(state-make
(on focus-in
(progn
(if autoraise (raise-window))
(send-user-event 'focus-in)
(wob-borderpixel cutewin.active)))
(on focus-out
(progn (send-user-event 'focus-out)
(wob-borderpixel cutewin.inactive)))
window-behavior
standard-behavior
)))
(if (not (boundp 'cutewin-move-window-orig))
(progn
(: cutewin-move-window-orig move-window)
(defun move-window args
(eval (+ (list 'cutewin-move-window-orig) args))
(send-user-event 'windowmove))
))
(if (not (boundp 'cutewin-resize-window-orig))
(progn
(: cutewin-resize-window-orig resize-window)
(defun resize-window args
(eval (+ (list 'cutewin-resize-window-orig) args))
(send-user-event 'resize))
))

53
data/datebook.xpm Normal file
View File

@ -0,0 +1,53 @@
/* XPM */
static char *datebook_recol[] = {
"64 38 12 1",
" c none",
". c black",
"X c blue",
"o c red",
"O c SkyBlue",
"+ c navy",
"@ c DarkGreen",
"# c LemonChiffon",
"$ c gray",
"% c tan",
"& c SlateGray",
"* c wheat",
" ",
" ",
" ..................... XXXXXXXX ",
" ..ooooooooooooooooooo. X OXXXXXXX ",
" .o.ooooooooooooooooooo. X OXXXXXXXXX ",
" .o.ooooooooooooooooooo. XX OOXXXXXXXXXXXX ",
" .o.ooooooooooooooooooo. XXOOOOOOOOOOXXXXXXX ",
" .o.ooooooooooooooooooo. +++++++++++++++++++ ",
" .o..................... @@@@@@@@@@@@@@@@@@@ ",
" .o.##################. XXXXXX$$$XXXXXX ",
" ..%.#################. XXX$$&&&+&&&&$XXX ",
" .%%.########+++######. XXX$$$$$$+$$&&&$XXX ",
" .%*.###++##++#++#####. XX$$$$$$$+++$$&&&$$XX ",
" .%*.###++##++#++#####. XX$$$$$$$$+++$$$&&&$$XX ",
" .%*.###+++####++++###. @XXX$$$$$$$$+++$$$$$&&$XXX ",
" .%*.###+#+###++##++###. @@XX$$$$$$$$$+++$$$$$&&&$XX ",
" .%*.###+#+########++##. @@X$$$$$$$$$$+++$$$$$&&&&$XX ",
" .%*.###+#++########+##.@@XX$$$$$$$$$$+++$$$$$$&&&$XX ",
" .%*.######+########+###@@XX$$$$$$$$$$$+$$$$$$$$&&$XXX ",
" .%*..#####++#######+##@@@X$$$$$$$$$$$$+$$$$$$$$&&&$XX ",
" .%*..######++##++#++##@@XX$$$$$$$$$$$$+$$$$$$$$$&&$XX ",
" .%*.*.######++##+++###@@XX$$$$$$$$$$$+$+$$$$$$$$&&$XX ",
" .%*.*.#######++#######@@XX$$$$$$$$$$$$+$$$$$$$$$&&$XX ",
" .%*..*.###############@@XX$$$$$$$$$$$$$$++$$$$$$&$$XX ",
" .%*..*.###############@@@XX$$$$$$$$$$$$$+++$$$$$&$XXX ",
" .%*.*.*.#########.####@@@XX$$$$$$$$$$$$$$++$$$$$$$XXX ",
" .%*.*.**.#######..#####@@XX$$$$$$$$$$$$$$$$+$$$$$$XX ",
" .%*.*.***..####.##.####@@@XX$$$$$$$$$$$$$$$$$$$$$XX ",
" .%**.*.#**&....####.....@@XXX$$$$$$$$$$$$$$$$$$$XXX ",
" .%%*..*.#**&&.#######..#@@@XX$$$$$$$$$$$$$$$$$$$XX ",
" .%%**.**.#***&.......&#..@@@XX$$$$$$$$$$$$$$$$$XX ",
" .%%%*..#.#*******###.... @@@XXX$$$$$$$$$$$$$XXX ",
" .%%%%*..............%. @@XXXX$$$$$$$$$$$XXXX ",
" .%%%%%*************%%. @@XX@XXXXX$$$XXXXXXXX ",
" ...................... @XX@@@@@XXXXXX@@X@@@@X ",
" @@X @@@@@@@@@@@ @@@XX ",
" @X @@X ",
" "};

61
data/def-menus.gwm Normal file
View File

@ -0,0 +1,61 @@
; DEFAULT MENUS
; =============
;;File: def-menus.gwm -- default root/window/icon menus
;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
;;Revision: 1.4 -- July 20 1989
;;State: Exp
;;GWM Version: 1.4
; create menus with lists of xterms and xloads
; ============================================
(defname-in-screen-to () xterm-pop xload-pop)
(defaults-to xterm-list ())
(defaults-to xload-list ())
(for screen (list-of-screens)
(with (fsm pop-fsm menu ())
(defaults-to root-pop (menu-make-from-list root-pop-items))
(defaults-to window-pop (menu-make-from-list window-pop-items))
(if (eq window-pop-items icon-pop-items)
(defaults-to icon-pop window-pop)
(defaults-to icon-pop (menu-make-from-list icon-pop-items)))
(menu-default-action root-pop '(refresh))
(menu-default-item root-pop 3)
(menu-default-action window-pop '(std-iconify-window))
(menu-default-action icon-pop '(std-iconify-window))
(setq xterm-items
'(menu-make (pop-label-make "Xterms")
(item-make "Local" (! "xterm" "-n" hostname
"-display" x-screen-name))))
(for xterm-item xterm-list
(: xterm-items
(+ xterm-items
(list (list 'item-make xterm-item
(list '! "/bin/sh" "-c"
(+ "DISPLAY=" x-screen-name
";export DISPLAY; rxterm "
xterm-item "</dev/null")))))))
(: xterm-pop (eval xterm-items))
(setq xload-items
'(menu-make (pop-label-make "Xloads")
(item-make "Local" (! "xload" "-display" x-screen-name))))
(for xload-item xload-list
(: xload-items
(+ xload-items
(list (list 'item-make xload-item
(list '! "/bin/sh" "-c"
(+ "DISPLAY=" x-screen-name
";export DISPLAY; rxload "
xload-item "</dev/null")))))))
(: xload-pop (eval xload-items)))
)
(de pop-root-menu ()
(set-colormap-focus ()) ; bugged on dpx???
(std-pop-menu root-pop))

37
data/deltabutton.gwm Normal file
View File

@ -0,0 +1,37 @@
;; a function to have a delta functionnality with gwm
; how to use it: in your .profile, before any deco, do
; (load 'deltabutton)
; (: standard-behavior
; (state-make
; (on (buttonpress 1 alone) (if (deltabutton)
; (progn (raise-window)(move-window))
; (raise-window)))
; standard-behavior
; ))
; (reparse-standard-behaviors)
(defaults-to deltabutton.delta 4)
(de abs (n)
(if (> n 0) n
(- n)))
(de deltabutton ()
(if (and (> (current-event-code) 0) ; last event received
(< (current-event-modifier) 256)) ; is a buttonpress
(tag DELTABUTTON
(: e-m (# (current-event-code) '(0 1 2 4)))
(: e-x (current-event-x))
(: e-y (current-event-y))
(: m-p (current-mouse-position))
(while (= (/ (# 2 m-p) 256) e-m) ; the button is still pressed
(: dx (abs (- (# 0 m-p) e-x)))
(: dy (abs (- (# 1 m-p) e-y)))
(if (or (> dx deltabutton.delta)
(> dy deltabutton.delta))
(exit DELTABUTTON t))
(: m-p (current-mouse-position)))
()))
)

80
data/dir-focus.gwm Normal file
View File

@ -0,0 +1,80 @@
;; dir-focus.gwm -- moves the focus to the closest window in a given direction
;;
;; Author: Teemu Hirsimaki <thirsima@cc.hut.fi>
;; Last change: 8 Nov 1998
;;
;; The function is "(focus-dir DIR)" where DIR is 'north, 'east,
;; 'south or 'west. It searches the closest window in the given
;; direction and sets focus in it. The variable dir-skip-list
;; specifies regular expressions for windows to ignore.
(defaults-to
dir-skip-list '(
"^panlist$" "^virtual$" "^door-mgr$" "load$" "lock$" "^Gwm$")
)
(defun abs (x)
(if (< x 0) (- x) x)
)
;; Score function
(defun dir-score-function (distance offset)
(if (< distance 1)
0
(+ (/ (* 1000 (abs offset)) distance) distance)
)))
;; Calculates a score for a window. The smaller the better.
(defun dir-calculate-score (cur dir)
(with (win-x (+ window-x (/ window-width 2)) win-y window-y)
(with (window cur)
(with (cur-x (+ window-x (/ window-width 2)) cur-y window-y)
(cond
((= dir 'north)
(dir-score-function (- cur-y win-y) (- cur-x win-x))
)
((= dir 'south)
(dir-score-function (- win-y cur-y) (- cur-x win-x))
)
((= dir 'east)
(dir-score-function (- win-x cur-x) (- cur-y win-y))
)
((= dir 'west)
(dir-score-function (- cur-x win-x) (- cur-y win-y))
))))))
;; Checks if the window is in dir-skip-list
(defun dir-legal-window ()
(tag return
(for exp dir-skip-list
(if (match exp window-name)
(exit return ())
))
t
))
;; Moves focus to the closest window in the given direction
(defun dir-focus (dir)
(with (cur window best-score 0 best-win ())
(for window (list-of-windows 'mapped 'window)
(if (dir-legal-window)
(with (score (dir-calculate-score cur dir))
(if
(and (> score 0)
(or (< score best-score)
(= best-win ())))
(progn
(setq best-score score)
(setq best-win window)))))
)
(if (not (= best-win ()))
(with (window best-win)
(if (boundp 'virtual-make-window-visible)
(virtual-make-window-visible))
(warp-pointer (/ window-width 2) 2 best-win)
(process-events)
(set-focus best-win)
))))
;; end of file

64
data/dlists.gwm Normal file
View File

@ -0,0 +1,64 @@
; Dynamic lists
; ==============
;;File: dlists.gwm -- manage dynamic lists
;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
;;Revision: 2 -- Dec 20 1989
;;State: Exp
;;GWM Version: 1.4
(setq Dlists t) ;package is loaded
; making a new list:
; (Dlists.make)
; of name foo: (Dlists.make 'foo)
; with pre-set size n: (Dlists.make n)
(defunq Dlists.make args
(with (list.name ())
(if (not args)
(set (setq list.name (Dlists.name.new)) ())
(= (type (# 0 args)) 'number)
(set (setq list.name (Dlists.name.new)) (list-make (# 0 args)))
t
(set (setq list.name (# 0 args)) ()))
list.name))
(setq Dlists.name.count 0) ;gensyms for Dlists: Dlist#78
(defun Dlists.name.new ()
(atom (+ "Dlist#" (itoa (setq Dlists.name.count
(+ Dlists.name.count 1))))))
; appending one element
(defun Dlists.append (l obj)
(## (length (eval l)) l obj))
; removing an element (returns pos)
(defun Dlists.remove (l obj)
(if (setq Dlists.remove.pos (member obj (eval l)))
(progn
(delete-nth Dlists.remove.pos (eval l))
Dlists.remove.pos
)
0
)
)
; getting the list of a Dlist
(defun Dlists.list (dlist)
(eval dlist))
; getting the length of a Dlist
(defun Dlists.length (dlist)
(length (Dlists.list dlist)))
; setting the list of a dlist to some list (which is copied into it)
(defun Dlists.set (dlist l)
(set dlist l))

87
data/drop-menus.doc Normal file
View File

@ -0,0 +1,87 @@
From: blk@vanity.mitre.org (Brian L. Kahn)
Subject: Drop menus, scrollbars .shar file
Date: Tue, 19 May 92 12:58:56 EDT
These WOOL and elisp files implement a flexible and useful approach
to drop down menus and scrollbars for epoch under GWM. This README
file is not adequate documentation, but unfortunately this is all you
get. If things don't work, try looking through the code.
These are the files included:
drop-menus.gwm - definition of some drop down menus
style.gwm - example of a drop-menus bar in a style
widgets.gwm - all the code implementing drop-menus and scrollbars
widgets.el - the epoch code that interprets events from GWM
The files should be loaded in this order: widgets, drop-menus, style.
HOW IT LOOKS
------------
The drop-menus are part of a window decoration style. Normally an
Xwindow class or program name will have the same decoration, altho you
can fiddle with that. Style.gwm shows how to select the decoration
based on any old characteristic you wish. I used that to give a
different decoration to epoch windows I refered to as popups, little
information type windows not meant for editing. Simple usage gives
the same decoration to all your epoch windows except the minibuffer.
The drop-down menus are collected into a menubar, a bar with bunch of
little buttons in them which drop down menus. A quick click/release
selects the first thing on the menu.
I suggest putting this bar on top, because the code does drop-down
menus. If you don't like sacrificing your title bar, try changing the
code to make jump-up menus and put it at the bottom!
The scrollbar doesn't have any slider. A slider seems to be a lot of
effort for little payoff. The scrollbar doesn't visually split when
the epoch screens split, but epoch interprets events on a per-window
basis. This lets you scroll the other window very easily, a big
advantage.
HOW IT WORKS
------------
The WOOL code communicates with epoch by setting the properties
"Dmenu" or "scrollbar" when events occur. Pushing a couple of
property handlers grabs the messages and deals with them. The Dmenu
handler just takes the message as a string and executes it. The
scrollbar handler takes different actions for each of the three
buttons, easily changed by the scrollbar-funcs constant:
(defconst widget:scrollbar-funcs
'((1 . scroll-up) (2 . line-up-point) (3 . scroll-down)))
If the epoch screen is split into several windows, the scrollbar
handler figures out which window is next to the scrollbar and acts on
that window. The information sent to epoch by GWM tells how far down
the scrollbar (in percent, 0-100) the mouse click was, so proportional
scrolling through the file should be easy to do.
POSSIBLE PROBLEMS
-----------------
When the cursor is on a button, the font changes to bold - a nice
effect assuming you have the right fonts. Note that the fonts I used
have the same width in regular or bold, so the buttons don't shift to
the right when I bold one of them. I think these fonts are part of
the standard X distribution.
I last used this a long time ago, under earlier versions of GWM and
epoch. Some around here are still using this stuff, but I can't vouch
for compatability. Also, I pulled this out as a piece from my larger
set of personal preferences in GWM. I may have forgotten some little
support function.
COPYRIGHT
---------
As it says in each file, use as you like but don't try to sell it.
Like anyone would pay for this, right? This does not prevent you from
including this along with something you *are* selling, as long as the

133
data/drop-menus.gwm Normal file
View File

@ -0,0 +1,133 @@
; DECORATIONS FOR EPOCH
; =====================
;;File: epoch.gwm -- window decorations for epoch
;;Heritage: simple-win.gwm
;;Author: Brian L. Kahn blk@security.mitre.org
;;Copyright 1992, MITRE Corporation
;;Not for sale or resale, distribution unlimited
;; the Dmenu: function creates a named drop-down menu with N items
;; arguments are the GWM name, menu name string, and a list of items
;; each item has an item name string and a GWM or elisp command
;; Dmenu.exec is an example of a GWM command
;; elisp commands are in quotes, and are sent to the window
(Dmenu: Dmenu.exec
'("exec"
(("execute cut buffer" (execute-string (+ "(? " cut-buffer ")")))
)))
(Dmenu: Dmenu.db
'("db"
(("toggle debug" "(setq debug-on-error (not debug-on-error))")
("debug on" "(setq debug-on-error t)")
("debug off" "(setq debug-on-error f)")
)))
(Dmenu: Dmenu.files
'("files"
(("open files" "(buffer-menu-sized)")
("directory" "(dired default-directory)")
("elisp lib" "(dired (expand-file-name "~/lib/emacs"))")
)))
(Dmenu: Dmenu.buffers
'("buffers"
(("other buffer" "(switch-to-buffer (other-buffer))")
("*scratch* buffer" "(switch-to-buffer \"*scratch*\")")
("-" (bell))
("kill buffer" "(kill-buffer (current-buffer))")
)))
(Dmenu: Dmenu.windows
'("windows"
(("one window" "(delete-other-windows)")
("split screen" "(split-window-vertically)")
)))
(Dmenu: Dmenu.screens
'("screens"
(("new screen" "(epoch:create-screen-offset 18)")
("delete screen" "(delete-screen)")
("name screen" "(epoch::icon-name (buffer-name))")
)))
(Dmenu: Dmenu.fonts
'("fonts"
(("screen-14" "(progn (font \"screen.r.14\") (redraw-display))")
("screen-11" "(progn (font \"screen.r.11\") (redraw-display))")
("screen-7" "(progn (font \"screen.r.7\") (redraw-display))")
("serif-16" "(progn (font \"serif.r.16\") (redraw-display))")
("misc-15" "(progn (font \"-misc*medium*-15-*\") (redraw-display))")
("misc-15-bold" "(progn (font \"-misc*bold*-15-*\") (redraw-display))")
("misc-20-bold" "(progn (font \"-misc*bold*-20-*\") (redraw-display))")
("courier-20" "(progn (font \"-*-courier-medium-r-*-20-*\") (redraw-display))")
)))
(Dmenu: Dmenu.mail
'("mail"
(("read mail" "(mh-rmail)")
("send mail" "(mh-smail)")
)))
(Dmenu: Dmenu.info
'("info" (("info & help" "(info)"))))
(Dmenu: Dmenu.news
'("news" (("usenet news" "(gnus)"))))
(Dmenu: Dmenu.shell
'("shell" (("csh" "(progn (csh) (end-of-buffer))"))))
(Dmenu: Dmenu.space
'(" "
(("redisplay" "(redraw-display)")
)))
;; a little box with the hostname in it
(: Dmenu.HOST
'(with (background black foreground white fsm ())
(plug-make (label-make hostname widget.font))))
;; an empty white box, for use as a separator
(: Dmenu.BOX
'(with (background black foreground white fsm ())
(plug-make (label-make " " widget.font))))
;; A menu bar is made from a list of drop-down menus, like this:
;; (window-make (widget:Dmenubar-make Dmenu.epoch-menus) () () () () ))
(: Dmenu.epoch-menus
(list
Dmenu.db
Dmenu.fonts
Dmenu.exec
Dmenu.space
Dmenu.files
Dmenu.buffers
Dmenu.windows
Dmenu.screens
Dmenu.space
Dmenu.mail
Dmenu.info
Dmenu.news
Dmenu.shell
Dmenu.db
))

680
data/dvrooms.gwm Normal file
View File

@ -0,0 +1,680 @@
; group windows into dvrooms
;
;;File: dvrooms.gwm
;;Author: duanev@mcc.com (Duane Voth)
;;Revision: 1.5 -- Nov 18 1990
;
; History: 1.0 -- Oct 18 1989 original
; 1.1 -- Oct 26 1989 windows are placed back on the screen (in
; iconic form) when a dvroom manager dies
; 1.2 -- Nov 21 1989 use gwm-quiet
; 1.3 -- Nov 22 1989 create rmgrs from wool (colas)
; 1.4 -- May 11 1990 use GWM_ROOM property to remeber room windows
; 1.5 -- Nov 18 1990 Philippe Kaplan (phk)
; act as icon boxes:
; do (setq dvroom.icon-box t) before load
; exit bug fixed around line 190
;
; dvrooms.gwm must be loaded in the .profile.gwm before any set-window,
; set-icon-window, set-placement, or set-icon-placement calls. it should
; also follow loading of icon-groups.gwm if used. (this probably isn't
; necessary but it seems to be programatically correct)
;
; to use rooms, the following can be added to your .profile.gwm:
;
; (defun screen-startup ()
; (setq count-of-windows-on-screen (length (list-of-windows)))
; (new-dvroom-manager "home")
; (new-dvroom-manager "lisp")
; (new-dvroom-manager "wysiwyg")
; (dvroom-reattach)
; (if (= 0 count-of-windows-on-screen)
; (! "/bin/sh" "-c" "$HOME/.xrc")))
;
; (setq to-be-done-after-setup (+ to-be-done-after-setup '((screen-startup))))
;
; be sure also to attach add-to-dvroom and remove-from-dvroom to some unused
; mouse button / keyboard modifier combinations. Example:
;
; (: standard-behavior
; (state-make
; ....
; (on (buttonpress 1 with-control) (add-to-room))
; (on (buttonpress 3 with-control) (remove-from-room))
; ))
;
;;=============================================================================
;; 1.5
;;=============================================================================
; New version of "dvrooms.gwm". Small changes produce big results:
;
; - You may open any number of rooms, instead of only one.
; - you can attach a window to several rooms.
;
; Be carefull:
;
; - The notion of current-dvroom becomes "the last room openned" (add-to-room
; and remove-from-room use current-dvroom).
;
; Since it changes the concept of rooms, we'd better speak about "icon boxes".
; Note that you can again remove and add any window to/from any room, so
; this is clever than icon-group.gwm.
;
; To enable this feature, put:
; (setq dvroom.icon-box t)
; before
; (load "dvrooms")
;
; Put in your .profile.gwm some lines like:
;
; (defun epoch-decos ()
; '(if (member "Minibuffer" window-name)
; (no-frame)
; (progn
; (if (and (boundp 'dvroom-managers) (find-dvroom-by-name "epoch"))
; (add-to-dvroom-group (find-dvroom-by-name "epoch") (wob))
; (set-x-property "GWM_ROOM" "epoch"))
; (simple-win))))
;
; (set-window Emacs epoch-decos)
;
; (set-icon-placement Gwm rows.top-left.placement) ; set rooms placements
; (set-placement Gwm rows.top-left.placement)
;
; So every new epoch screen belongs to "epoch"'s room.
;;=============================================================================
;; code
;;=============================================================================
; global dvroom variables
(declare-screen-dependent
dvroom.font
dvroom.background
dvroom.foreground
)
(setq dvroom-managers ()) ; list of windows for dvroom managers
(setq current-dvroom ()) ; index into dvroom-managers of the current dvroom
; user-settable resources
(for screen (list-of-screens)
(defaults-to
dvroom.font (font-make "8x13")
dvroom.background white
dvroom.foreground black
))
(defaults-to
dvroom.borderwidth borderwidth
dvroom.auto-add () ; new windows added to current room?
dvroom.icon-box () ; act as icon boxes
dvroom.x 0
dvroom.y 0
dvroom.name "Room #"
dvroom.rootmenupos 5 ; where to place root menu items
dvroom.menupos 2 ; where to place menu menu items
edit-keys.return "Return"
edit-keys.backspace "BackSpace"
edit-keys.delete "Delete"
)
(defaults-to dvroom.name.number 0)
; save current iconify-window function
(if (not (boundp 'pre-dvrooms-iconify-window))
(setq pre-dvrooms-iconify-window iconify-window))
; add w to the list of windows managed by a dvroom-manager
(defun add-to-dvroom-group (dvroom-manager w)
(if (not (member w (nth 'rgroup dvroom-manager)))
(progn
(with (wob w) (setq window-wm-state-icon
(with (wob dvroom-manager) window-icon)))
(replace-nth 'rgroup dvroom-manager (+ (nth 'rgroup dvroom-manager) (list w))))))
; remove w from the list of windows managed by a dvroom-manager
;; be careful, the window might not exist anymore, if we get called on closing
;; of an application!
(defun remove-from-dvroom-group (dvroom-manager w)
(if (window-is-valid w)
(with (wob w) (setq window-wm-state-icon 0))
)
(with (slot (member w (nth 'rgroup dvroom-manager)))
(if slot (delete-nth slot (nth 'rgroup dvroom-manager)))))
; a version of print that honors gwm-quiet
(defun qprint args
(if (= gwm-quiet 0) (eval (+ '(print) args))))
; open all windows in a dvroom
; assumes "window" is the dvroom manager being opened
(defun open-dvroom ()
(for window (nth 'rgroup window-window)
; map the window if it was mapped, else map the icon
(if (nth 'rgroup-state window)
(map-window window)
(map-window window-icon))))
; close all windows in a dvroom
; assumes "window" is the dvroom manager being closed
(defun close-dvroom ()
(for window (nth 'rgroup window)
; save window state - is it a window or an icon
(replace-nth 'rgroup-state window window-is-mapped)
; remove both windows and icons from the screen
(if window-is-mapped (unmap-window window))
(if (window-icon?)
(with (window window-icon)
(if window-is-mapped (unmap-window window))))))
; redefine iconify-window so we can do dvroom specific stuff
(defun iconify-window ()
(if (= window-name "rmgr")
; (de)iconifing a dvroom manager
(if (= window-status 'window)
; iconifing (closing) a dvroom manager
(progn
(close-dvroom)
(if (not dvroom.icon-box)
(setq current-dvroom ()))
(pre-dvrooms-iconify-window)
)
; deiconifing (opening) a dvroom manager
(with (rmgr-index (member window-window dvroom-managers))
; close previous dvroom manager
(if (and current-dvroom (not dvroom.icon-box))
(with (window (nth current-dvroom dvroom-managers))
(if (= window-status 'window)
(iconify-window) ; recurse to close dvroom
)
)
)
(if rmgr-index
; existing dvroom manager
(open-dvroom)
; register a new dvroom manager
(progn
; save window-window as the manager may be iconic and
; we need a consistent value in the dvroom-mgr list
(setq dvroom-managers
(+ dvroom-managers (list window-window)))
(setq rmgr-index (member window-window dvroom-managers))
)
)
(setq current-dvroom rmgr-index)
(pre-dvrooms-iconify-window)
)
)
; (de)iconifing other windows
(progn
(pre-dvrooms-iconify-window)
)
)
)
(defun dvroom-icon-name (dvroom)
(with (window dvroom) window-icon-name))
(defun find-dvroom-by-name (name)
(tag room-found
(for dvroom dvroom-managers
(if (= name (dvroom-icon-name dvroom))
(exit room-found dvroom)))))
;; register a new dvroom manager -or- readd a window to a room
;; (should be called when new windows become known to gwm (ie. via
;; gwm global opening))
;; assumes "window" is the new dvroom manager or window
(defun add-dvroom-manager ()
(if (= window-name "rmgr")
(if (not (member window-window dvroom-managers))
(progn (qprint "new dvroom manager " window-icon-name "\n")
;; save window-window as the manager may be iconic and
;; we need a consistent value in the dvroom-mgr list
(setq dvroom-managers (+ dvroom-managers (list window-window)))))
;; else it's not a manager. see if this window previously belonged to
;; a room and add a new manager if the named manager does not exist
(with (room-name (get-x-property "GWM_ROOM"))
(if (< 0 (length room-name))
(if (not (find-dvroom-by-name room-name))
(new-dvroom-manager room-name))))
()
;; if dvroom.auto-add is true, then add to current dvroom if one exists
(if (and dvroom.auto-add (= (type current-dvroom) 'number))
(add-to-dvroom))
)
)
; add add-dvroom-manager to progn of funcs to eval when opening a new window
; assumes dvroom.gwm is before the set-* calls in .profile.gwm
(setq opening (+ opening '((add-dvroom-manager))))
; reattach windows that have a GWM_ROOM property to the room managers
(defun dvroom-reattach window-list
(for window (if window-list window-list (list-of-windows))
(with (room-name (get-x-property "GWM_ROOM"))
(if (< 0 (length room-name))
(for dvroom dvroom-managers
(if (= room-name (dvroom-icon-name dvroom))
(progn
(add-to-dvroom-group dvroom window)
(if (not (= dvroom current-dvroom))
(progn
; remove both window and icon from the screen
(if window-is-mapped (unmap-window window))
(if (window-icon?)
(with (window window-icon)
(if window-is-mapped (unmap-window window))))))
(qprint "adding <" window-name "> to dvroom "
(dvroom-icon-name dvroom) "\n"))))))))
; add a window to a dvroom
; assumes "window" is the application window to add
(defun add-to-dvroom ()
(with (window window-window)
(if (and (= (type current-dvroom) 'number)
(not (= window-name "rmgr")))
(with (dvroom-manager (nth current-dvroom dvroom-managers))
(if (not (member window (nth 'rgroup dvroom-manager)))
(progn (add-to-dvroom-group dvroom-manager window)
(set-x-property "GWM_ROOM"
(with (wob dvroom-manager) window-icon-name))
; give the user *some* kind of feed back
(qprint "adding <" window-name "> to dvroom "
(dvroom-icon-name dvroom-manager) "\n")))))))
; remove a window from a dvroom
; assumes "window" is the application window to remove
(defun remove-from-dvroom ()
(with (window window-window)
(if (= (type current-dvroom) 'number)
(with (dvroom-manager (nth current-dvroom dvroom-managers))
(if (member window (nth 'rgroup dvroom-manager))
(progn
(set-x-property "GWM_ROOM" "")
; give the user *some* kind of feed back
(qprint "removing <" window-name "> from dvroom "
(dvroom-icon-name dvroom-manager) "\n"))
(qprint "not a dvroom member\n"))
(remove-from-dvroom-group dvroom-manager window)))))
; if a normal window, remove it from any dvroom manager, but if a dvroom
; manager and not current, make all of the dvrooms windows visible.
; (this function needs to be called when an application exits (ie. via gwm
; global closing) so that gwm won't try to operate on non-existant windows)
; assumes "window" is the application window that is exiting
(defun flush-dvroom-lists ()
(for dvroom-manager dvroom-managers
(remove-from-dvroom-group dvroom-manager window-window))
(with (index (member window-window dvroom-managers))
; if a dvroom manager
(if index
(progn
(if (= current-dvroom index)
(setq current-dvroom ())
(progn
(open-dvroom)
(if (> current-dvroom index)
(setq current-dvroom (- current-dvroom 1)))))
(delete-nth index dvroom-managers)))))
; add flush-dvroom-lists to progn of funcs to eval when closing an old window
; assumes dvroom.gwm is loaded before the set-* calls in .profile.gwm
(setq closing (+ closing '((flush-dvroom-lists))))
; colas: create dvroom managers as placed menus
(defun new-dvroom-manager args
(if (not (find-dvroom-by-name (# 0 args)))
(with (fsm window-fsm
background dvroom.background foreground dvroom.foreground
borderwidth dvroom.borderwidth
direction vertical
label-horizontal-margin 4 label-vertical-margin 2
menu-min-width 30 menu-max-width 1000
name (if args (# 0 args) (new-dvroom-manager-name))
)
(setq wob
(with (icon-name name starts-iconic t)
(place-menu
'rmgr
(menu-make
(bar-make
(with (fsm dvroom.fsm
property (+ (list
'title name
'background dvroom.background
'foreground dvroom.foreground
'borderwidth dvroom.borderwidth
'font dvroom.font
) property))
(plug-make
(label-make name dvroom.font)))))
dvroom.x dvroom.y)))
(## 'title wob name)
(add-dvroom-manager))))
; generates a new dvroom name
(defun new-dvroom-manager-name ()
(setq dvroom.name.number (+ 1 dvroom.name.number))
(+ dvroom.name (itoa dvroom.name.number)))
; editable plug fsm
(setq dvroom.fsm
(fsm-make
(: dvroom.edit-fsm.normal
(state-make
(on (double-button any any)
(progn
(set-focus wob)
(wob-background (# 'foreground wob))
(with (
foreground (# 'background wob)
background (# 'foreground wob)
)
(wob-tile
(active-label-make
(# 'title wob) (# 'font wob)))))
dvroom.edit-fsm.editable)
(on (button any (together with-alt with-control))
(progn
(set-focus wob)
(wob-background (# 'foreground wob))
(with (
foreground (# 'background wob)
background (# 'foreground wob)
)
(wob-tile
(active-label-make
(# 'title wob) (# 'font wob)))))
dvroom.edit-fsm.editable)
icon-behavior
standard-behavior
))
(: dvroom.edit-fsm.editable
(state-make
(on (keypress (key-make edit-keys.return) any)
(dvroom.edit-fsm.de-edit)
dvroom.edit-fsm.normal)
(on (double-button any any)
(dvroom.edit-fsm.de-edit)
dvroom.edit-fsm.normal)
(on (keypress edit-keys.backspace any)
(progn
(## 'title wob
(if (: s (match "\\(.*\\)."
(# 'title wob) 1))
s
(setq s "")))
(with (
foreground (# 'background wob)
background (# 'foreground wob)
)
(wob-tile (active-label-make s (# 'font wob))))
))
(on (keypress edit-keys.delete any)
(progn
(## 'title wob (: s ""))
(with (
foreground (# 'background wob)
background (# 'foreground wob)
)
(wob-tile (active-label-make s (# 'font wob))))
))
(on (keypress any any)
(progn
(## 'title wob
(: s (+ (# 'title wob) (last-key))))
(with (
foreground (# 'background wob)
background (# 'foreground wob)
)
(wob-tile (active-label-make s (# 'font wob))))
))
(on focus-out
(dvroom.edit-fsm.de-edit)
dvroom.edit-fsm.normal)
icon-behavior
standard-behavior
))
))
))
(if (not (boundp 'update-icon))
(defun update-icon (update-icon.title)
(if (window-icon?)
(send-user-event 'get-title (window-icon)))))
(de dvroom.edit-fsm.de-edit ()
(wob-background (# 'background wob))
(with (background (# 'background wob)
foreground (# 'foreground wob)
)
(wob-tile (label-make (# 'title wob) (# 'font wob)))
(update-icon (# 'title wob)))
)
;
; find dvroom window belongs to
;
(defun find-window-in-any-dvroom (win)
(tag found-in-manager
(for dvr dvroom-managers
(with (slot (member win (nth 'rgroup dvr)))
(if slot (exit found-in-manager dvr))
)
)
)
)
;
; detach window from all room managers
;
(defun remove-window-from-all-dvroom (win)
(with (dvr (find-window-in-any-dvroom win))
(if dvr (remove-from-dvroom-group dvr win))
)
)
;
; automatic room attachment based upon name
;
(defun auto-window-attach (w)
(with (w-name (with (window w) (window-name)))
(with (d-name (match "\\(.*\\)::" w-name 1))
(if (< 0 (length d-name))
(with (dvr (find-dvroom-by-name d-name))
(if dvr
;;
;; by now, we've found a dvroom with the desired name
;; just in case, try to detach this window from it's dvroom
;; and attach it to the target dvroom
;;
(progn
(qprint "Auto-Add " w-name " to " d-name "\n" )
(remove-window-from-all-dvroom w)
(add-to-dvroom-group dvr w)
(set-x-property "GWM_ROOM" d-name)
)
)
)
)
)
)
)
;
; automatic room attachment for all windows
;
(defun magic-dvroom-attach ()
(for win (list-of-windows 'window)
(auto-window-attach win)
)
)
;
; unmap all windows/icon that belong to a room
;
(defun dvroom-remapping ()
(for win (list-of-windows 'window)
(with (dvr (find-window-in-any-dvroom win))
(if dvr
(with (window win)
(if window-is-mapped (unmap-window win))
(if (window-icon?)
(with (window window-icon)
(if window-is-mapped (unmap-window window-icon))
)
)
)
)
)
)
)
;
; Next dvroom number
;
(defun increment-dvroom ()
(with (room-leng (length dvroom-managers))
(if (> room-leng 0)
(if current-dvroom
(with (room (+ current-dvroom 1))
(if (= room (length dvroom-managers))
0
room
)
)
0
)
()
)
)
)
;
; Previous dvroom number
;
(defun decrement-dvroom ()
(with (room-leng (length dvroom-managers))
(if (> room-leng 0)
(if current-dvroom
(with (room (- current-dvroom 1))
(if (< room 0)
(- room-leng 1)
room
)
)
(- room-leng 1)
)
()
)
)
)
;
; Close current Room
;
(defun close-current-dvroom ()
(if current-dvroom
(with (window (# current-dvroom dvroom-managers))
(progn
(close-dvroom)
(setq current-dvroom ())
(pre-dvrooms-iconify-window)
)
)
)
)
;
; Open dvroom by number
;
(defun open-room-number (room)
(if room
(progn
(close-current-dvroom)
(with (window (# room dvroom-managers))
(progn
(open-dvroom)
(setq current-dvroom room)
(with (window window-icon)
(pre-dvrooms-iconify-window)
)
)
)
)
)
)
;
; Open next room
;
(defun roll-rooms-up ()
(open-room-number (increment-dvroom))
)
;
; Open previous room
;
(defun roll-rooms-down ()
(open-room-number (decrement-dvroom))
)
;; adds the "add to room" and "remove from room" menu items in the
;; window menu, "New dvroom" in the root menu
(if (not (boundp 'dvroom.menu-added)) (progn
(setq dvroom.menu-added t)
(if (eq window-pop-items icon-pop-items)
(setq window-pop-equals-icon-pop t)
(setq window-pop-equals-icon-pop ()))
(insert-at '(item-make "New dvroom" (new-dvroom-manager))
root-pop-items
dvroom.rootmenupos)
(insert-at '(multi-item-make
"Room: "
()
("Add" (add-to-dvroom))
("Remove" (remove-from-dvroom)))
window-pop-items
dvroom.menupos)
(if window-pop-equals-icon-pop
(setq icon-pop-items window-pop-items))
))

399
data/edit-plug.gwm Normal file
View File

@ -0,0 +1,399 @@
;; edit-plug.gwm --- Code for general editable plug
;;
;; Author: Anders Holst (aho@sans.kth.se)
;; Copyright (C) 1996 Anders Holst
;; Last change: 19/1 1996
;;
;; This file is copyrighted under the same terms as the rest of GWM
;; (see the X Inc license for details). There is no warranty that it
;; works.
;;
;; ---------------------------------------------------------------------
;;
;; This code implements a simple editable plug, which can be used in
;; various places in GWM. Simple examples include dialogues where the
;; user can feed in some text string to GWM (eg. the name of a new
;; virtual door to create or a machine to log into), or editable name
;; plugs in window and icon decorations.
;;
;; To create an editable plug, you just call '(edit-plug-make "string")'
;; where it would otherwise have said '(plug-make (label-make "string"))'.
;; Most communication with the plug is done via user events. To enable
;; editing you send it the event 'edit-plug-start'. To finish or abort
;; editing (that is, go into the passive state) you send 'edit-plug-done'
;; or 'edit-plug-abort' depending on whether the edit should have any
;; effect or not. To find out the new string in an editable plug, you can
;; send the event 'edit-plug-query' and then look at the variable
;; 'edit-plug-result', or you can use the function '(edit-plug-query)'
;; which does exactly this.
;;
;; When the plug is in its active state it obeys several editing keys,
;; including RETURN which finishes editing, and C-c or ESC which aborts
;; editing. (Unfortunately there is no keymap mechanism to allow the
;; user to redefine the meaning of the different keys, other than
;; modifying the fsm:s, see below.)
;;
;; 'edit-plug-make' considers several context variables. In addition to
;; the ones considered by 'plug-make' and 'label-make' it considers
;; 'font-slant' (which if defined determines the slant of the small bar
;; indicating the edit point in the string), 'active-foreground',
;; 'active-background', 'active-borderpixel' (which determines the colors
;; of the plug when in its active state), 'edit-plug-start-hook',
;; 'edit-plug-done-hook', and 'edit-plug-abort-hook' (which contains
;; code to run when starting, finishing, and aborting edit respectively).
;;
;; The fsm is built from the states 'edit-plug-normal-state' and
;; 'edit-plug-active-state'. To specify which events should start and stop
;; the editing, more events can be added to these states.
;; NOTE: Only change these variables in a with-statement and not
;; globally, since edit-plugs might be used in more than one place,
;; and the same behavior might not be appropriate everywhere.
;;
;; As an example of how the edit-plug can be used, there is a function
;; '(simple-dialogue "prompt")' defined, which prompts the user for a
;; string that is then returned. The color and appearance of the simple
;; dialogue box is affected by many of the above mentioned context
;; variables.
;;
(defun edit-plug-make (str)
(with (cnx (list 'foreground foreground 'background background
'borderpixel borderpixel 'font font
'active-foreground (default active-foreground foreground)
'active-background (default active-background background)
'active-borderpixel (default active-borderpixel ())
'font-slant (default font-slant 0)
'label-horizontal-margin label-horizontal-margin
'label-vertical-margin label-vertical-margin)
property (+ (list 'internals (list str () ())
'context cnx
'start-hook (default edit-plug-start-hook ())
'done-hook (default edit-plug-done-hook ())
'abort-hook (default edit-plug-abort-hook ()))
property)
fsm (fsm-make edit-plug-normal-state edit-plug-active-state))
(plug-make (edit-plug-label str ()))))
(defun edit-plug-label (str1 str2)
(with (str (if (and (= str1 "") (or (not str2) (= str2 "")))
" "
(+ str1 str2))
xoff (if (not str2)
()
(= str1 "")
(- label-horizontal-margin 1)
(- (# 2 (dimensions str1)) label-horizontal-margin 1))
lab ())
(setq lab (label-make str))
(if xoff
(draw-line lab
(+ xoff (- font-slant (/ font-slant 2)))
label-vertical-margin
(- xoff (/ font-slant 2))
(- (# 3 (dimensions " ")) label-vertical-margin 1)))
lab))
(defun edit-plug-update ()
(with (ilist (# 'internals wob-property)
cnx (# 'context wob-property))
(with cnx
(if (# 1 ilist)
(progn
(setq background active-background)
(setq foreground active-foreground)
(if active-borderpixel
(setq borderpixel active-borderpixel))))
(wob-tile (edit-plug-label (# 0 ilist) (# 1 ilist)))
(if active-borderpixel
(wob-borderpixel borderpixel)))))
(defun edit-plug-start ()
(with (ilist (# 'internals wob-property)
hook (# 'start-hook wob-property))
(eval hook)
(if (not (# 1 ilist))
(## 1 ilist ""))
(if (not (# 2 ilist))
(## 2 ilist (# 0 ilist)))
(edit-plug-update)))
(defun edit-plug-start-dialogue ()
(with (ilist (# 'internals wob-property)
hook (# 'start-hook wob-property))
(eval hook)
(if (not (# 1 ilist))
(## 1 ilist ""))
(if (not (# 2 ilist))
(## 2 ilist (# 0 ilist)))
(edit-plug-update)
(with (grab-keyboard-also 1) (grab-server wob))))
(defun edit-plug-done ()
(with (ilist (# 'internals wob-property)
hook (# 'done-hook wob-property))
(if (# 1 ilist)
(## 0 ilist (+ (# 0 ilist) (# 1 ilist))))
(## 1 ilist ())
(## 2 ilist ())
(edit-plug-update)
(ungrab-server wob)
(setq edit-plug-result (# 0 ilist))
(eval hook)))
(defun edit-plug-abort ()
(with (ilist (# 'internals wob-property)
hook (# 'abort-hook wob-property))
(if (# 2 ilist)
(progn
(## 0 ilist (# 2 ilist))
(## 1 ilist ())
(## 2 ilist ())))
(edit-plug-update)
(ungrab-server wob)
(setq edit-plug-result ())
(eval hook)))
(defun edit-plug-insert (ch)
(with (ilist (# 'internals wob-property))
(## 0 ilist (+ (# 0 ilist) ch))
(edit-plug-update)))
(defun edit-plug-delete ()
(with (ilist (# 'internals wob-property))
(if (# 1 ilist)
(## 1 ilist (match ".\\(.*\\)$" (# 1 ilist) 1)))
(edit-plug-update)))
(defun edit-plug-backspace ()
(with (ilist (# 'internals wob-property))
(if (not (= (# 0 ilist) ""))
(## 0 ilist (match "\\(.*\\).$" (# 0 ilist) 1)))
(edit-plug-update)))
(defun edit-plug-delete-rest ()
(with (ilist (# 'internals wob-property))
(if (# 1 ilist)
(## 1 ilist ""))
(edit-plug-update)))
(defun edit-plug-clear ()
(with (ilist (# 'internals wob-property))
(if (# 1 ilist)
(## 1 ilist ""))
(## 0 ilist "")
(edit-plug-update)))
(defun edit-plug-undo ()
(with (ilist (# 'internals wob-property))
(if (# 1 ilist)
(## 1 ilist ""))
(if (# 2 ilist)
(## 0 ilist (# 2 ilist)))
(edit-plug-update)))
(defun edit-plug-eol ()
(with (ilist (# 'internals wob-property))
(if (# 1 ilist)
(progn
(## 0 ilist (+ (# 0 ilist) (# 1 ilist)))
(## 1 ilist "")))
(edit-plug-update)))
(defun edit-plug-bol ()
(with (ilist (# 'internals wob-property))
(## 1 ilist (if (# 1 ilist) (+ (# 0 ilist) (# 1 ilist)) (# 0 ilist)))
(## 0 ilist "")
(edit-plug-update)))
(defun edit-plug-backward ()
(with (ilist (# 'internals wob-property))
(if (not (= (# 0 ilist) ""))
(progn
(## 1 ilist (+ (match ".*\\(.\\)$" (# 0 ilist) 1)
(or (# 1 ilist) "")))
(## 0 ilist (match "\\(.*\\).$" (# 0 ilist) 1))))
(edit-plug-update)))
(defun edit-plug-forward ()
(with (ilist (# 'internals wob-property))
(if (# 1 ilist)
(progn
(## 0 ilist (+ (# 0 ilist)
(match "\\(.\\).*$" (# 1 ilist) 1)))
(## 1 ilist (match ".\\(.*\\)$" (# 1 ilist) 1))))
(edit-plug-update)))
(defun edit-plug-fit-text (str wdt)
(with (ctx (# 'context wob-property)
wdt (+ wdt label-horizontal-margin 1)
pair () rest "")
(with ctx
(while (and (> (width str) wdt) (> (length str) 0))
(setq pair (match "\\(.*\\)\\(.\\)$" str 1 2))
(setq rest (+ (# 1 pair) rest))
(setq str (# 0 pair)))
(list str rest))))
(defun edit-plug-midstring (pair1 pair2 tot)
(with (n1 (length (# 0 pair1))
n2 (length (# 0 pair2))
n (length tot)
m (min n1 n2)
d (abs (- n1 n2))
reg ())
(if (= n1 n2) ""
(= n1 0) (# 0 pair2)
(= n2 0) (# 0 pair1)
(= n1 n) (# 1 pair2)
(= n2 n) (# 1 pair1)
t (progn
(setq reg (+ (apply + (list-make m ".")) "\\("
(apply + (list-make d ".")) "\\)"))
(match reg tot 1)))))
(defun edit-plug-xposition (pos)
(with (ilist (# 'internals wob-property)
str (if (# 1 ilist) (+ (# 0 ilist) (# 1 ilist)) (# 0 ilist))
pair (edit-plug-fit-text str pos))
(## 0 ilist (# 0 pair))
(## 1 ilist (# 1 pair))
(edit-plug-update)))
(defun edit-plug-xposcopy (pos)
(with (ilist (# 'internals wob-property)
str (if (# 1 ilist) (+ (# 0 ilist) (# 1 ilist)) (# 0 ilist))
pair (edit-plug-fit-text str pos))
(if (not (= (# 0 pair) (# 0 ilist)))
(progn
(setq cut-buffer (edit-plug-midstring ilist pair str))
(## 0 ilist (# 0 pair))
(## 1 ilist (# 1 pair))
(edit-plug-update)))))
(defun edit-plug-change (str)
(with (ilist (# 'internals wob-property))
(## 0 ilist str)
(if (# 1 ilist)
(## 1 ilist ""))
(edit-plug-update)))
(defun edit-plug-get ()
(with (ilist (# 'internals wob-property))
(if (# 1 ilist) (+ (# 0 ilist) (# 1 ilist)) (# 0 ilist))))
(defun edit-plug-query ()
(with (edit-plug-result ())
(send-user-event 'edit-plug-query wob)
edit-plug-result))
(defun edit-plug-reply ()
(setq edit-plug-result (edit-plug-get)))
(defun edit-plug-dialogue ()
(with (edit-plug-result t)
(send-user-event 'edit-plug-dialogue)
(while (= edit-plug-result t) (process-events))
edit-plug-result))
(setq edit-plug-active-state
(state-make
(on (user-event 'edit-plug-query)
(edit-plug-reply))
(on (user-event 'edit-plug-done)
(edit-plug-done)
edit-plug-normal-state)
(on (user-event 'edit-plug-abort)
(edit-plug-abort)
edit-plug-normal-state)
(on (user-event 'edit-plug-take-focus)
(set-focus wob))
(on (keypress (key-make "Return") alone)
(edit-plug-done)
edit-plug-normal-state)
(on (keypress (key-make "Left") alone)
(edit-plug-backward))
(on (keypress (key-make "Right") alone)
(edit-plug-forward))
(on (keypress (key-make "Home") alone)
(edit-plug-bol))
(on (keypress (key-make "End") alone)
(edit-plug-eol))
(on (keypress (key-make "Delete") alone)
(edit-plug-backspace))
(on (keypress (key-make "BackSpace") alone)
(edit-plug-backspace))
(on (keypress (key-make "Escape") alone)
(edit-plug-abort)
edit-plug-normal-state)
(on (keypress (key-make "c") with-control)
(edit-plug-abort)
edit-plug-normal-state)
(on (keypress (key-make "d") with-control)
(edit-plug-delete))
(on (keypress (key-make "f") with-control)
(edit-plug-forward))
(on (keypress (key-make "b") with-control)
(edit-plug-backward))
(on (keypress (key-make "e") with-control)
(edit-plug-eol))
(on (keypress (key-make "a") with-control)
(edit-plug-bol))
(on (keypress (key-make "k") with-control)
(edit-plug-delete-rest))
(on (keypress (key-make "w") with-control)
(edit-plug-clear))
(on (keypress (key-make "u") with-control)
(edit-plug-undo))
(on (keypress any any)
(with (code (keycode-to-keysym (current-event-code) (current-event-modifier)))
(if (and (> code 31) (< code 256))
(edit-plug-insert (last-key)))))
(on (buttonpress 1 alone)
(edit-plug-xposition (current-event-relative-x)))
(on (buttonrelease 1 alone)
(edit-plug-xposcopy (current-event-relative-x)))
(on (buttonpress 2 alone)
(progn
(edit-plug-xposition (current-event-relative-x))
(if cut-buffer (edit-plug-insert cut-buffer))))))
(setq edit-plug-normal-state
(state-make
(on (user-event 'edit-plug-query)
(edit-plug-reply))
(on (user-event 'edit-plug-dialogue)
(edit-plug-start-dialogue)
edit-plug-active-state)
(on (user-event 'edit-plug-start)
(edit-plug-start)
edit-plug-active-state)
(on (user-event 'edit-plug-take-focus)
(set-focus wob))))
(defun simple-dialogue args
(with (prompt (or (# 0 args) "")
def (or (# 1 args) "")
reenter-on-opening ()
old-borderwidth borderwidth
old-borderpixel borderpixel
bordertile ()
borderpixel background
borderwidth 1
res ()
mn (with (direction vertical)
(menu-make
(bar-make (with (borderwidth old-borderwidth)
(plug-make (label-make prompt))))
(bar-make (with (borderwidth old-borderwidth
borderpixel old-borderpixel)
(edit-plug-make def))))))
(if mn
(with (dim (dimensions mn)
x (/ (- screen-width (# 2 dim)) 2)
y (/ (- screen-height (# 3 dim)) 2)
wob (place-menu 'dialogue mn x y))
(setq res (edit-plug-dialogue))
(delete-window)
res))))

167
data/em-drop-menus.gwm Normal file
View File

@ -0,0 +1,167 @@
; DECORATIONS FOR EPOCH
; =====================
;;File: epoch.gwm -- window decorations for epoch
;;Heritage: simple-win.gwm
;;Author: Brian L. Kahn blk@security.mitre.org
;;Not for sale or resale, distribution unlimited
;; the Dmenu: function creates a named drop-down menu with N items
;; arguments are the GWM name, menu name string, and a list of items
;; each item has an item name string and a GWM or elisp command
;; Dmenu.exec is an example of a GWM command
;; elisp commands are in quotes, and are sent to the window
(Dmenu: Dmenu.exec
'("exec"
(("execute cut buffer" (execute-string (+ "(? " cut-buffer ")")))
)))
(Dmenu: Dmenu.db
'("db"
(("toggle debug" "(setq debug-on-error (not debug-on-error))")
("debug on" "(setq debug-on-error t)")
("debug off" "(setq debug-on-error f)")
)))
(Dmenu: Dmenu.files
'("files"
(("open files" "(buffer-menu-sized)")
("directory" "(dired default-directory)")
("elisp lib" "(dired (expand-file-name "~/lib/emacs"))")
)))
(Dmenu: Dmenu.buffers
'("buffers"
(("other buffer" "(switch-to-buffer (other-buffer))")
("*scratch* buffer" "(switch-to-buffer \"*scratch*\")")
("-" (bell))
("kill buffer" "(kill-buffer (current-buffer))")
)))
(Dmenu: Dmenu.windows
'("windows"
(("one window" "(delete-other-windows)")
("split screen" "(split-window-vertically)")
)))
(Dmenu: Dmenu.screens
'("screens"
(("new screen" "(epoch:create-screen-offset 18)")
("delete screen" "(delete-screen)")
("name screen" "(epoch::icon-name (buffer-name))")
)))
(Dmenu: Dmenu.fonts
'("fonts"
(("screen-14" "(progn (font \"screen.r.14\") (redraw-display))")
("screen-11" "(progn (font \"screen.r.11\") (redraw-display))")
("screen-7" "(progn (font \"screen.r.7\") (redraw-display))")
("serif-16" "(progn (font \"serif.r.16\") (redraw-display))")
("misc-15" "(progn (font \"-misc*medium*-15-*\") (redraw-display))")
("misc-15-bold" "(progn (font \"-misc*bold*-15-*\") (redraw-display))")
("misc-20-bold" "(progn (font \"-misc*bold*-20-*\") (redraw-display))")
("courier-20" "(progn (font \"-*-courier-medium-r-*-20-*\") (redraw-display))")
)))
(Dmenu: Dmenu.mail
'("mail"
(("read mail" "(mh-rmail)")
("send mail" "(mh-smail)")
)))
(Dmenu: Dmenu.info
'("info" (("info & help" "(info)"))))
(Dmenu: Dmenu.news
'("news" (("usenet news" "(gnus)"))))
(Dmenu: Dmenu.shell
'("shell" (("csh" "(progn (csh) (end-of-buffer))"))))
(Dmenu: Dmenu.space
'(" "
(("redisplay" "(redraw-display)")
)))
;; a little box with the hostname in it
(: Dmenu.HOST
'(with (background black foreground white fsm ())
(plug-make (label-make hostname widget.font))))
;; an empty white box, for use as a separator
(: Dmenu.BOX
'(with (background black foreground white fsm ())
(plug-make (label-make " " widget.font))))
;; A menu bar is made from a list of drop-down menus, like this:
;; (window-make (widget:Dmenubar-make Dmenu.epoch-menus) () () () () ))
(: Dmenu.epoch-menus
(list
Dmenu.db
Dmenu.fonts
Dmenu.exec
Dmenu.space
Dmenu.files
Dmenu.buffers
Dmenu.windows
Dmenu.screens
Dmenu.space
Dmenu.mail
Dmenu.info
Dmenu.news
Dmenu.shell
Dmenu.db
))
;; File: style.gwm -- window styles for epoch, santt
;;Author: Brian L. Kahn
;;Not for sale or resale, distribution unlimited
(df style:epoch ()
(window-make (widget:Dmenubar-make Dmenu.epoch-menus)
widget:scrollbar-make () () () ))
(df style:minibuf ()
(window-make ()()()()()))
(df style:pop ()
(window-make ()()()()()))
(df style:select ()
'(or (# (atom (or (get-x-property "style")
(window-client-name)))
(list 'epoch (style:epoch)
'minibuf (style:minibuf)
'pop (style:pop)
))
(style:epoch))
)
(set-window Epoch style:select)

122
data/em-example.gwm Normal file
View File

@ -0,0 +1,122 @@
;; an example on how to customize em-drop-menus.gwm em-widgets.gwm
;; experimental epoch menus
;; first some color & font customisations
(setq epoch-color "bisque")
(for i '("1" "2" "3" "4")
(set (atom (+ "epoch-color" i))
(color-make (+ epoch-color i))
))
(: widget.Bfont (font-make "*clean-medium*--10*c-60*"))
(: widget.font (font-make "*clean-bold*--10*c-60*"))
(setq widget.foreground epoch-color4)
(setq widget.background epoch-color1)
(setq widget.name-font (font-make "fixed"))
(setq widget.name-foreground black)
(: widget.weave (pixmap-make
epoch-color4
"/usr/include/X11/bitmaps/cross_weave"
epoch-color1
))
(: widget.black (pixmap-make
black
"/usr/include/X11/bitmaps/black"
epoch-color4
))
(: widget.gray (pixmap-make
black
"/usr/include/X11/bitmaps/black"
epoch-color4
))
(: widget.lt-gray (pixmap-make
black
"/usr/include/X11/bitmaps/black"
epoch-color2
))
(load "em-widgets.gwm") ; then load the packages
(load "em-drop-menus.gwm")
; then some menus and code to implement
; direct choosing of buffer or file
; from a list with 2nd mouse button
(set-window Emacs.epoch style:select)
(Dmenu: Dmenu.fonts
'("fonts" (
("screen-11" "(progn (font \"screen.r.11\") (redraw-display))")
("screen-12" "(progn (font \"screen.r.12\") (redraw-display))")
("screen-12-Bold" "(progn (font \"screen.b.12\") (redraw-display))")
("screen-13" "(progn (font \"screen.r.13\") (redraw-display))")
("screen-14" "(progn (font \"screen.r.14\") (redraw-display))")
("screen-14-Bold" "(progn (font \"screen.b.14\") (redraw-display))")
("screen-7" "(progn (font \"screen.r.7\") (redraw-display))")
("fixed" "(progn (font \"fixed\") (redraw-display))")
)))
(Dmenu: Dmenu.buffers
'("buffers" (
("list of buffers"
"(progn \
(list-buffers) \
(switch-to-buffer \"*Buffer List*\") \
(delete-other-windows) \
(if (not (boundp 'mouse-Buffer-menu-select)) (progn \
(setq mouse-Buffer-menu-select t)\
(defun mouse-Buffer-menu-select (&optional mdata) (interactive) \
(Buffer-menu-select) \
))) \
(if (boundp 'imouse-version)\
(local-set-mouse mouse-middle mouse-down 'mouse-set-point-or-select) \
(local-set-mouse mouse-middle mouse-down 'mouse::set-point)) \
(local-set-mouse mouse-middle mouse-up 'mouse-Buffer-menu-select) \
)")
("other buffer" "(switch-to-buffer (other-buffer))")
("*scratch* buffer" "(switch-to-buffer \"*scratch*\")")
("-" (bell))
("kill buffer" "(kill-buffer (current-buffer))")
)))
(Dmenu: Dmenu.files
'("files" (
("list of directory"
"(progn \
(dired \".\") \
(delete-other-windows) \
(if (not (boundp 'mouse-dired-find-file)) (progn \
(setq mouse-dired-find-file t)\
(defun mouse-dired-find-file (&optional mdata) (interactive) \
(dired-find-file) \
))) \
(if (boundp 'imouse-version)\
(local-set-mouse mouse-middle mouse-down 'mouse-set-point-or-select) \
(local-set-mouse mouse-middle mouse-down 'mouse::set-point)) \
(local-set-mouse mouse-middle mouse-up 'mouse-dired-find-file) \
)")
(" - - - " "")
(".Xdefaults" "(find-file \"~/.Xdefaults\")")
("profile-epoch" "(find-file \"~/el/profile-epoch-4.0.el\")")
("wool" "(find-file \"~/Gwm2/wool/TODO\")")
)))
(Dmenu: Dmenu.db
'("db"
(
(" " "")
("byte-compile-current-file" "(byte-compile-current-file)")
("toggle debug" "(setq debug-on-error (not debug-on-error))")
("debug on" "(setq debug-on-error t)")
("debug off" "(setq debug-on-error f)")
)))
(: Dmenu.epoch-menus
(list
Dmenu.fonts
Dmenu.files
Dmenu.buffers
Dmenu.db
))

365
data/em-widgets.gwm Normal file
View File

@ -0,0 +1,365 @@
;;;File: widgets.gwm -- various widgets for decorations
;;Author: Brian L. Kahn
;;Not for sale or resale, distribution unlimited
;; modified by colas for more customizability
(load "cursor-names.gwm")
(defaults-to
widget.bar-cursor
(cursor-make XC_fleur)
widget.menu-cursor
(cursor-make XC_crosshair)
widget.scroll-cursor
(cursor-make XC_sb_v_double_arrow)
widget.scroll-up-cursor
(cursor-make XC_sb_up_arrow)
widget.scroll-down-cursor
(cursor-make XC_sb_down_arrow)
widget.scroll-index-cursor
(cursor-make XC_sb_right_arrow)
widget.weave
(pixmap-make "/usr/include/X11/bitmaps/cross_weave")
widget.gray
(pixmap-make "/usr/include/X11/bitmaps/gray")
widget.lt-gray
(pixmap-make "/usr/include/X11/bitmaps/light_gray")
widget.black
(pixmap-make "/usr/include/X11/bitmaps/black")
widget.font
(font-make "widget")
widget.Bfont
(font-make "widgetBold")
widget.foreground
black
widget.background
white
widget.name-font
widget.font
widget.name-background
widget.background
widget.name-foreground
widget.foreground
widget.close-pixmap
(pixmap-make widget.background "close-18.xbm" widget.foreground)
)
;(: widget.font (font-make "*clean-medium*--10*c-60*"))
;(: widget.Bfont (font-make "*clean-bold*--10*c-60*"))
(setq widget.invert-color (bitwise-xor widget.foreground widget.background))
;PROGRAMMING
;===========
(defun widget:message message
;; put "who what when why" into property for this widget
(with (output (+ "(" ;who
(or (# 'name message) (# 'name wob-property) "widget")
" " ;what
(if (= 0 (bitwise-and current-event-modifier with-shift))
(itoa (current-event-code))
(itoa (+ 3 (current-event-code)))
)
" " ;when
(itoa (current-event-modifier))
" " ;why
(or (# 'message message) (# 0 message) "no-message")
")"
))
(set-x-property (or (# 'widget message) (# 'widget wob-property))
output)
))
(: widget:scrollbar-fsm
(fsm-make
(: inactive
(state-make
(on (buttonpress 1 any)
(wob-cursor widget.scroll-up-cursor)
active)
(on (buttonpress 1 with-shift)
(wob-cursor widget.scroll-index-cursor)
active)
(on (buttonpress 2 any)
(wob-cursor widget.scroll-index-cursor)
active)
(on (buttonpress 3 any)
(wob-cursor widget.scroll-down-cursor)
active)
))
(: active
(state-make
(on (buttonrelease any any)
(progn
(wob-cursor widget.scroll-cursor)
(widget:message
(itoa (/ (* 100 (current-event-relative-y))
(height wob)))))
inactive)
))
))
(: widget:scrollbar-make
(with (fsm widget:scrollbar-fsm
borderwidth 1
tile widget.weave
cursor widget.scroll-cursor
property (list 'widget "scrollbar" 'name "leftside")
bar-min-width 14)
(bar-make)))
(: widget:Dmenu-fsm
(fsm-make
(: menu-off
(state-make
(on enter-window
(wob-tile (# 'on-pix wob-property)))
(on leave-window
(wob-tile (# 'off-pix wob-property)))
(on (buttonpress menu-button any)
(progn
(wob-tile (# 'off-pix wob-property))
(if wob-menu
(pop-menu))
))
(on (buttonpress any any) (progn
(setq invert-color widget.invert-color)
(wob-invert)
)
menu-on)
))
(: menu-on
(state-make
(on (buttonrelease any any)
(progn
(setq invert-color widget.invert-color)
(wob-invert)
(eval (# 'action wob-property)))
menu-off)
(on leave-window
(progn
(setq invert-color widget.invert-color)
(wob-invert)
(wob-tile (# 'off-pix wob-property)))
menu-off)
))
))
(: widget:Dmenubar-fsm
(fsm-make
(state-make
(on (user-event 'focus-in)
(wob-tile widget.gray))
(on (user-event 'focus-out)
(wob-tile widget.lt-gray))
standard-title-behavior)))
(defun widget:Dmenubar-make (menulist)
(with (fsm widget:Dmenubar-fsm
tile widget.gray
plug-separator 8
borderwidth 1
cursor widget.bar-cursor
bar-min-width 2
bar-max-width 24
menulist (+
(list widget.close-plug)
'(())
menulist
'(()()()())
(list '(widget.name-plug))
)
)
(apply 'bar-make menulist)
)))
(setq widget.close-plug (with (
fsm (fsm-make
(state-make
(on (buttonpress any alone) (delete-window))
standard-title-behavior
standard-behavior
))
borderwidth 0
)
(plug-make widget.close-pixmap)
))
(defun widget.name-plug () (with (
fsm (fsm-make
(state-make
(on (user-event 'name-change)
(with (
font widget.name-font
background widget.name-background
foreground widget.name-foreground
)
(wob-tile (label-make (window-name))))
)
standard-title-behavior
standard-behavior
))
font widget.name-font
background widget.name-background
foreground widget.name-foreground
borderwidth 0
)
(plug-make (label-make window-name))
)
)))
(defun widget:Dmenu-make (args)
;; Make a plug that drops a menu.
;; ARGS is '(name (item ... item))
;; item is ("label" action)
;; action is "(elisp-function args)" or (wool-function args)
(with (name (# 0 args)
widget "Dmenu"
pop-item.background widget.background
pop-item.foreground widget.foreground
item-list (# 1 args)
action (widget:action (# 1 (# 0 item-list)))
menu (widget:menu-make item-list)
fsm widget:Dmenu-fsm
borderwidth 1
cursor widget.menu-cursor
property (list 'widget widget
'name name
'action action
'off-pix (with (
foreground widget.foreground
background widget.background
)
(label-make name widget.font)
)
'on-pix (with (
foreground widget.background
background widget.foreground
)
(label-make name widget.Bfont))
)
)
(plug-make (# 'off-pix property))))
(defun widget:menu-make (item-list)
(with (
property (+ property (list 'invert-color
(bitwise-xor pop-item.foreground pop-item.background)
))
)
(menu-make-from-list
(mapfor item item-list
(list 'item-make
(# 0 item)
(widget:action (# 1 item)))
))))
; action is "(elisp-function args)" or (wool-function args)
(defun widget:action (action)
(cond ((eq 'string (type action))
(list 'widget:message ''message action))
((eq 'list (type action))
action)
(t (progn (? "Invalid widget:action - ")
(? action)))
))
(: widget:Pmenu-fsm
(fsm-make
(setq initial (state-make
(on enter-window-not-from-grab ; init menu colors
(: invert-color (bitwise-xor pop-item.foreground
pop-item.background))
realized ; then go in normal mode
)
(on (buttonrelease any any) ; ButRel before menu appeared
(progn ; then call default action
(with (calling-wob wob-parent Menu wob)
(setq std-popups.action
(# 'action wob-property))
(wob wob-parent)
(send-user-event 'depop Menu t)
(wob calling-wob)
(eval std-popups.action))
)
waiting-for-enter-window ; must trap the actual menu map
)
(on (user-event 'depop) (unpop-menu) initial)
))
(setq realized (state-make
(on (buttonrelease any any) ; ButRel outside of menu
(progn
(with (quit (# 'quit wob-property))
(if quit (eval quit)))
(unpop-menu)
)
initial)
(on (user-event 'depop) (unpop-menu) initial)
))
(setq waiting-for-enter-window (state-make
(on enter-window-not-from-grab () initial)
))
))
(defun widget:Pmenu-make spec
;; Make a pop-up menu that returns index of selection
(with (
fsm widget:Pmenu-fsm
pop-item.background widget.background
pop-item.foreground widget.foreground
item-list (# 0 spec)
property (list 'widget "Pmenu"
'name "Pmenu"
'quit '(widget:message 'message "nil" 'widget 'Pmenu)
'action '(widget:message 'message 0 'widget 'Pmenu)
)
index -1 ; starts at 0, pre-incremented
)
(eval
(+ '(menu-make)
(mapfor item item-list
(list 'item-make
item
(list 'widget:message
''message (itoa (: index (+ index 1)))
''widget "Pmenu")
))))
))
;; for convenience in defining Dmenus
(defunq Dmenu: (Dmenu.name arglist)
;; assign DMENU.NAME equal to the Dmenu created using ARGLIST.
(set Dmenu.name (eval (list 'widget:Dmenu-make arglist))))

58
data/emacs-mouse.gwm Normal file
View File

@ -0,0 +1,58 @@
; EMACS MOUSE CODES
; =================
;;File: emacs-mouse.gwm -- control codes for GOSLING emacs mouse support
;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
;;Revision: 1.0 -- Jan 31 1989
;;State: Exp
;;GWM Version: 1.4
; This package traps mouse control-clicks and send them as keycodes to the
; underneath xterm, supposedly running a Gosling emacs. You will need the
; "gwm.ml" MockLisp package to interpret them
; Sends: ^X 7 x ; y ; n
; Where x,y are the click coordinates in char (increment) positions,
; and n the button number
; The variable "emacs-mouse-loaded" is set to t for decorations supporting it
(defname 'emacs-pop screen.)
(de emacs-click (n)
(: l (current-event-window-coords))
(send-key-to-window 0x78 with-control) ; ^X
(send-key-to-window 0x37 alone) ; 7
(: x (# 0 l))
(: y (# 1 l))
(send-key-to-window (+ 0x30 (/ x 10)) alone); x
(send-key-to-window (+ 0x30 (% x 10)) alone)
(send-key-to-window 0x3b alone) ; ;
(send-key-to-window (+ 0x30 (/ y 10)) alone); y
(send-key-to-window (+ 0x30 (% y 10)) alone)
(send-key-to-window 0x3b alone) ; ;
(send-key-to-window (+ 0x30 n) alone) ; button number
))
(with (fsm pop-fsm menu ())
(: emacs-pop
(menu-make
(item-make "Macro" ; ^Xe
(progn (send-key-to-window 0x78 with-control)
(send-key-to-window 0x65 alone)))
(item-make "Copy" ; Esc-W
(progn (send-key-to-window 0xff1b alone)
(send-key-to-window 0x77 alone)))
(item-make "Cut" ; ^W
(progn (send-key-to-window 0x77 with-control)))
(item-make "Paste" ; ^Y
(progn (send-key-to-window 0x79 with-control)))
(item-make "Re-Search" ; ^S^M
(progn (send-key-to-window 0x73 with-control)
(send-key-to-window 0x6d with-control)))
(item-make "Goto Func" ; Esc-xv fu
(progn
(send-key-to-window 0xff1b alone)
(send-key-to-window "xv fu " alone)))
))
)
(: emacs-mouse-loaded t)

93
data/en-recover.gwm Normal file
View File

@ -0,0 +1,93 @@
;;From: Eyvind Ness <eyvind@hrp.no>
;;Date: Wed, 22 Jan 92 13:30 GMT
;;Reply-To: Eyvind.Ness@hrp.no
;;To: gwm-talk@mirsa.inria.fr
;;Subject: lost windows and how to recover them
;; Here is a little GWM code to recover from major window lossage.
;; I have experienced that Xclients suddenly become out of GWM's reach due
;; to corrupted values for window co-ordinates, size, mapped-status etc. In
;; case some of you have seen similar problems, you may find the follwing
;; code-fragments of interest.
;;
;; Eyvind.
;;
;;
;; +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+
;; Eyvind Ness Internet Email: eyvind@hrp.no
;; Research Scientist Phone: +47 9 183100
;; Control Room Systems Division Fax: +47 9 187109
;; OECD Halden Reactor Project Surface Mail: P.O. Box 173, N-1751 Halden
;; Norway
;; +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+
;;;
;;; Put this at the bottom of your ~/.profile.gwm
(require 'dvrooms) ; or remove the call to (dvroom-reattach) below
;;; make a new menu entry, or modify standard-behaviour, if you prefer.
(if (not (boundp 'en-recover.menu-added)) (progn
(setq en-recover.menu-added t)
(insert-at
'(item-make "Recover lost windows" (recover-lost-windows))
root-pop-items 1)
))
(defun recover-lost-windows ()
(progn
(print "\nRecovering lost windows...\n")
(setq ix 20) (setq iy 100)
(setq window-list (list-of-windows 'window))
;; Now, sort all windows ordered by their width:
(setq
window-list
(sort
window-list
'(lambda (w1 w2)
(compare (with (window w2) window-width)
(with (window w1) window-width)))))
;; Then, arrange potential patological cases from top-left to
;; bottom-right. Patology is suspected in the following situations:
;; - the window is unmapped
;; - current position is outside the screen
;; - the window width > the screen width, or < 5 pixels
;; - the window height > the screen height, or < 5 pixels
(for window window-list
(if (or
(not window-is-mapped)
(< window-width 5)
(> window-width screen-width)
(< window-height 5)
(> window-height screen-height)
(< window-x 0)
(> window-x screen-width)
(< window-y 0)
(> window-y screen-height))
(progn
(map-window window)
(move-window window ix iy)
(raise-window)
(if (or
(< window-width 5) (< window-height 5)
(> window-width screen-width)
(> window-height screen-height))
;; restore the corrupted values to some arbitrary,
;; though not totally absurd, value:
(resize-window 100 100))
(print window-status
" " window-name
"(" window ") moved to (" ix ", " iy ")\n")
(setq ix (+ ix 20)) (setq iy (+ iy 20)))))
;; Strictly speaking, this could be defined as a separate item in
;; the main menu. Added here for convenience only:
(dvroom-reattach)
;; Typically, you dont't want the icons to be stacked, so re-pack
;; them if disturbed by the procedure above:
(rows.pack)
(print "\nRecovering lost windows... done.\n")))

37
data/epoch.gwm Normal file
View File

@ -0,0 +1,37 @@
;;; Code to communicate with epoch
;; Colas 1991-02-18
;; this needs the epoch code "property.el" loaded into epoch
;; (property.el is in the epocgh distribution)
;; routine to send a string to be executed by epoch, supposed to be the
;; current window
(setq epoch:menu ())
(defun send-epoch (code)
(set-x-property "EPOCH_EXECUTE"
(+ "(let ((protect epoch::event-handler)) (unwind-protect "
code
"(setq epoch::event-handler protect))))"
)))
;; Menu package:
;; how to make a menu of epoch buffers to select current buffer
(defunq string-menu-make (args)
(if epoch:menu
(with (wob (menu-wob epoch:menu)) (delete-window))
)
(pop-menu
(setq epoch:menu (menu-make-from-list (+
'((pop-label-make "Epoch Screens"))
(mapfor s args (list 'item-make s (list 'send-epoch-switch-buffer s))
))))))
(defunq send-epoch-switch-buffer (name)
(send-epoch (+ "(switch-to-buffer \"" name "\")")
))
;; All done
(provide 'epoch)

33
data/fast.gwm Normal file
View File

@ -0,0 +1,33 @@
;; fast decorations (minimal)
;; invoke with gwm -f fast
;; ejb@era.com (Jay Berkenbilt)
(setq grabs (list (button any with-alt)))
(setq opening '(progn))
(setq closing '(progn))
(setq borderwidth 0)
(setq fsm
(fsm-make
(state-make
(on (buttonpress 1 with-alt)
(lower-window))
(on (buttonpress 2 with-alt)
(move-window))
(on (buttonpress 3 with-alt)
(raise-window)))))
(setq root-fsm
(fsm-make
(state-make
(on (buttonrelease 1 with-alt)
(end)))))
(defun describe-window ()
(list
(window-make () () () () ())
(window-make () () () () (plug-make (label-make window-icon-name)))
))
(defun describe-screen ()
(with (opening '(bell) fsm root-fsm)
(window-make () () () () ())))

102
data/float.gwm Normal file
View File

@ -0,0 +1,102 @@
;; package to have some windows always float on top of others
;; toi use, just include (load 'float) in your .profile.gwm
;; rwhitby@adl.austek.oz.au (Rod Whitby)
;; Rod Whitby
;; Austek Microsystems Pty. Ltd.
;; Technology Park
;; Adelaide, SA 5095 Australia
;;
;; ACSnet: rwhitby@austek.oz ARPA: rwhitby@austek.oz.au
;; UUCP: uunet.uu.net!munnari!austek.oz.au!rwhitby
;;
;; modified & integrated by colas Dec 27 90.
;; Changes to the standard behaviour to add auto-raise functionality.
(defaults-to
float.menupos 2
float.iconmenupos 2
float.menufont (font-make "*-symbol-medium-r-normal--14-*")
float.up "\xad"
float.down "\xaf"
float.no "\xbb"
)
(if (= float.menufont font) (progn
(setq float.menufont (font-make "cursor"))
(: float.up "\x72")
(: float.down "\x6a")
(: float.no "\x2a")
))
(defun float.top-window ()
(with (l (list-of-windows 'stacking-order)
len (length l)
i (- len 1))
(tag ret
(while (> i -1)
(with (win (# i l))
(if (and (not (= (with (wob win) window-client-class) 'Gwm))
(not (= (# 'float win) 'up))
(not (= wob win)))
(exit ret win))
(: i (- i 1)))))))
(setq standard-behavior
(state-make
standard-behavior
(on visibility-fully-obscured
(if (= (# 'float window) 'up)
(raise-window (float.top-window)))
)
(on visibility-partially-obscured
(if (# 'float window)
(if (= (# 'float window) 'up)
(raise-window (float.top-window))
(= (# 'float window) 'down)
(lower-window)))
)
(on visibility-unobscured
(if (= (# 'float window) 'down)
(lower-window)))
))
(if (boundp 'reparse-standard-behaviors)
(reparse-standard-behaviors)
)
;; Now add some routines to the window menu to toggle floating
(defun float.toggle (dir)
(## 'float window dir)))
;; add toggle float menu item to window menu
(if (and (not (boundp 'float.menu-added))
(boundp 'window-pop-items)
(boundp 'icon-pop-items))
(progn
(setq float.menu-added t)
(insert-at '(multi-item-make
"Float: "
()
("Up" (float.toggle 'up))
("Down" (float.toggle 'down))
("No" (float.toggle ()))
)
window-pop-items
float.menupos)
;; same with smaller labels for icon menu
(insert-at '(multi-item-make
"Float: "
()
((label-make float.up float.menufont) (float.toggle 'up))
((label-make float.down float.menufont) (float.toggle 'down))
((label-make float.no float.menufont) (float.toggle ()))
)
icon-pop-items
float.iconmenupos)
))

154
data/frame-win.gwm Normal file
View File

@ -0,0 +1,154 @@
; General-frame decoration (for clock, mail, ...)
; ========================
;;File: frame-win.gwm -- General-frame decoration
;;Author: vincent@mirsa.inria.fr (Vincent BOUTHORS) -- Bull Research FRANCE
;;Revision: 1.0 -- Feb 7 1989
;;State: Exp
;;GWM Version: 1.4
; Exported functions and variables:
; frame-win
; frame3d-win
; frame3d-context
; frame2d-win
; frame2d-context
; External variable used:
; look-3d:
; can be set to () (default) or tri-dim1 (t)
; frame.top-text
; frame.bottom-text
; if these variables are set they are evaluated at creation
; to form a label (string type is mandatory)
; frame.font
; font of text
; frame.pixmap-file must contain prefix of 8 bitmap files:
; suffixes are: t l r b (top left right bottom)
; tl tr bl br (corners)
; default: "frame2d"
; frame.pixmap-format indicates wich format is used;
; 'bitmap (default) standard bitmap format, pixmap-make is used
; 'pixmap pixmap oriented format, pixmap-load is used
; frame.name-separator indicates which character is used to separate
; suffix from prefix in filename (default "-")
; frame.bar-width
; (default 1)
; frame.inner-border-width
; (default 1)
(de frame.suffix (name1 name2)
(+ name1 frame.name-separator name2))
(de frame.win ()
(with (
fsm (fsm-make (state-make window-behavior standard-behavior))
name (default frame.pixmap-file "frame2d")
frame.name-separator (default frame.name-separator "-")
frame.font (default frame.font small-font)
pixmap-make (if (= (default frame.pixmap-format 'bitmap) 'pixmap)
pixmap-load
pixmap-make)
frame.bar-width (if (boundp 'frame.bar-width)
frame.bar-width
10)
)
(with (
borderwidth 0
bar-min-width frame.bar-width
bar-max-width frame.bar-width)
(: side-top (pixmap-make (frame.suffix name "t")))
(: side-left (pixmap-make (frame.suffix name "l")))
(: side-right (pixmap-make (frame.suffix name "r")))
(: side-bottom (pixmap-make (frame.suffix name "b")))
(: plug-corner-tl (plug-make(pixmap-make(frame.suffix name "tl"))))
(: plug-corner-br (plug-make(pixmap-make(frame.suffix name "br"))))
(: plug-corner-bl (plug-make(pixmap-make(frame.suffix name "bl"))))
(: plug-corner-tr (plug-make(pixmap-make(frame.suffix name "tr"))))
(: bar-top
(with (tile side-top borderwidth 0)
(if (boundp 'frame.top-text)
(bar-make
plug-corner-tl
()
(list 'plug-make
(list 'label-make
frame.top-text
'frame.font))
()
plug-corner-tr)
(bar-make
plug-corner-tl
()
plug-corner-tr))))
(: bar-bottom
(with (tile side-bottom borderwidth 0)
(if (boundp 'frame.bottom-text)
(bar-make
plug-corner-bl
()
(list 'plug-make
(list 'label-make
frame.bottom-text
'frame.font))
()
plug-corner-br)
(bar-make
plug-corner-bl
()
plug-corner-br))))
(: bar-left (with (tile side-left) (bar-make)))
(: bar-right (with (tile side-right) (bar-make)))
)
; : result
(with (
inner-borderwidth (default frame.inner-border-width 1)
borderwidth (default frame.border-width 1))
(window-make bar-top bar-left bar-right bar-bottom ())))
)
(setq frame3d-context
'(
frame.pixmap-file "frame3d"
frame.name-separator "-"
frame.bar-width 8
frame.pixmap-format 'pixmap
frame.inner-border-width 0
frame.border-width (default frame.border-width 1)
))
(df frame3d-win ()
(with frame3d-context
(frame.win)))
(setq frame2d-context
'(
frame.pixmap-file "frame2d"
frame.name-separator "-"
frame.bar-width 10
frame.pixmap-format 'bitmap
frame.inner-border-width 0
frame.border-width (default frame.border-width 1)
))
(df frame2d-win ()
(with frame2d-context
(frame.win)))
(df frame-win ()
(if (= t (default look-3d ()))
(frame3d-win)
(frame2d-win)))

5
data/frame2d-b.xbm Normal file
View File

@ -0,0 +1,5 @@
#define bordc4.bit_width 10
#define bordc4.bit_height 10
static char bordc4.bit_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00,
0xff, 0x03, 0x00, 0x00, 0xff, 0x03, 0xff, 0x03};

5
data/frame2d-bl.xbm Normal file
View File

@ -0,0 +1,5 @@
#define bordcll.bit_width 10
#define bordcll.bit_height 10
static char bordcll.bit_bits[] = {
0x4b, 0x00, 0x4b, 0x00, 0x4b, 0x00, 0xcb, 0x03, 0x0b, 0x00, 0x0b, 0x00,
0xfb, 0x03, 0x03, 0x00, 0xff, 0x03, 0xff, 0x03};

5
data/frame2d-br.xbm Normal file
View File

@ -0,0 +1,5 @@
#define bordclr.bit_width 10
#define bordclr.bit_height 10
static char bordclr.bit_bits[] = {
0x48, 0x03, 0x48, 0x03, 0x48, 0x03, 0x4f, 0x03, 0x40, 0x03, 0x40, 0x03,
0x7f, 0x03, 0x00, 0x03, 0xff, 0x03, 0xff, 0x03};

5
data/frame2d-l.xbm Normal file
View File

@ -0,0 +1,5 @@
#define bordc2.bit_width 10
#define bordc2.bit_height 10
static char bordc2.bit_bits[] = {
0x4b, 0x00, 0x4b, 0x00, 0x4b, 0x00, 0x4b, 0x00, 0x4b, 0x00, 0x4b, 0x00,
0x4b, 0x00, 0x4b, 0x00, 0x4b, 0x00, 0x4b, 0x00};

Some files were not shown because too many files have changed in this diff Show More