[sawfish] added debian packaging scripts based on the official ones
- From: Christopher Bratusek <chrisb src gnome org>
- To: svn-commits-list gnome org
- Cc:
- Subject: [sawfish] added debian packaging scripts based on the official ones
- Date: Sat, 24 Oct 2009 21:27:02 +0000 (UTC)
commit 4c1aa73f9e1662ae7f76d2abb12b1eb272d5f416
Author: Christopher Roy Bratusek <chris nanolx org>
Date: Sat Oct 24 23:26:43 2009 +0200
added debian packaging scripts based on the official ones
ChangeLog | 2 +
configure.in | 4 +
debian/README.Debian | 45 ++
debian/README.sawfish-data | 5 +
debian/README.source | 57 ++
debian/README.themes | 1 +
debian/changelog.in | 5 +
debian/clean | 15 +
debian/compat | 1 +
debian/control | 65 +++
debian/copyright | 44 ++
debian/postinst | 18 +
debian/postrm | 10 +
debian/preinst | 9 +
debian/prerm | 11 +
debian/rules | 163 ++++++
debian/sawfish-data.info | 1 +
debian/sawfish-data.install.in | 8 +
debian/sawfish-dbg.links | 1 +
debian/sawfish-lisp-source.links | 1 +
debian/sawfish-lisp-source.lintian | 1 +
debian/sawfish.dirs | 5 +
debian/sawfish.el | 1003 ++++++++++++++++++++++++++++++++++++
debian/sawfish.emacsen-install | 41 ++
debian/sawfish.emacsen-remove | 15 +
debian/sawfish.emacsen-startup | 11 +
debian/sawfish.install | 9 +
debian/sawfish.links | 1 +
debian/watch | 3 +
src/display.c | 20 +-
30 files changed, 1572 insertions(+), 3 deletions(-)
---
diff --git a/ChangeLog b/ChangeLog
index 0eb0f30..a8d5874 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -4,6 +4,8 @@
* scripts/Makefile.in
* scripts/sawfish-about.jl.in: switched from custom about-dialog to GtkAboutDialog
+ * debian/*: added debian packaging scripts based on the official ones
+
2009-10-24 Teika kazura <teika lavabit com>
* lisp/sawfish/wm/user.jl
* man/news.texi: minor news & comment fix.
diff --git a/configure.in b/configure.in
index 7376a9d..3d4f55a 100644
--- a/configure.in
+++ b/configure.in
@@ -338,8 +338,11 @@ if test "x$KDEDIR" = x; then
KDEDIR="/usr/share/apps/"
fi
+gitdate=`date +%y%m%d`
+
dnl Nonstandard exported symbols
AC_SUBST(version)
+AC_SUBST(gitdate)
AC_SUBST(subversion)
AC_SUBST(sawfishdir)
AC_SUBST(sawfishexecdir)
@@ -403,6 +406,7 @@ scripts/Makefile
sounds/Makefile
src/Makefile
themes/Makefile
+debian/changelog
])
AC_OUTPUT
diff --git a/debian/README.Debian b/debian/README.Debian
new file mode 100644
index 0000000..7e813be
--- /dev/null
+++ b/debian/README.Debian
@@ -0,0 +1,45 @@
+Sawfish for Debian
+------------------
+
+The sawfish package includes sawfish.el, written by Dave Pearson
+<davep davep org>, which is normally distributed from his web site
+http://www.davep.org/sawfish/
+
+For each upstream release you need to restart sawfish with :
+
+sawfish-client -f restart
+
+I'll close all bugs report related to this feature.
+
+Also if you have this error:
+
+$ sawfish-ui
+error--> (file-error "No such file or directory" "gui/gtk")
+
+This is because you have mixed up Ximian packages and Debian packages.
+You need to replace all Ximian packages related to sawfish by the Debian
+packages (rep, rep-gtk, librep9).
+
+Why this doesn't work ?
+
+Because Ximian doesn't follow the Debian policy (Chapter 12.1) :
+
+ If a program needs to specify an _architecture specification string_
+ in some place, the following format should be used:
+
+ <arch>-<os>
+
+ where <arch>' is one of the following: i386, alpha, arm, m68k,
+ powerpc, sparc and <os>' is one of: linux, gnu. Use of _gnu_ in this
+ string is reserved for the GNU/Hurd operating system.
+
+I'll close all bugs report related to this feature too.
+
+Since GNOME 2 use AA (Anti Aliased) fonts, you should remove/disable usage
+of libgdkxft0.
+
+If rep take 100% CPU when you try to access to custom popup menu (with
+middle mouse click on the root window), you should install the
+gnome-control-center package or forget to access this menu entry.
+
+Christian
diff --git a/debian/README.sawfish-data b/debian/README.sawfish-data
new file mode 100644
index 0000000..71f40fa
--- /dev/null
+++ b/debian/README.sawfish-data
@@ -0,0 +1,5 @@
+This package contains the architecture independent data for sawfish,
+that is the compiled lisp files and the translations. It is unlikely
+to be of any use if you don't have sawfish installed.
+
+If you want to see the lisp code, install sawfish-lisp-source.
diff --git a/debian/README.source b/debian/README.source
new file mode 100644
index 0000000..8646078
--- /dev/null
+++ b/debian/README.source
@@ -0,0 +1,57 @@
+This package uses quilt to manage all modifications to the upstream
+source. Changes are stored in the source package as diffs in
+debian/patches and applied during the build.
+
+To configure quilt to use debian/patches instead of patches, you want
+either to export QUILT_PATCHES=debian/patches in your environment
+or use this snippet in your ~/.quiltrc:
+
+ for where in ./ ../ ../../ ../../../ ../../../../ ../../../../../; do
+ if [ -e ${where}debian/rules -a -d ${where}debian/patches ]; then
+ export QUILT_PATCHES=debian/patches
+ fi
+ done
+
+To get the fully patched source after unpacking the source package, cd to
+the root level of the source package and run:
+
+ quilt push -a
+
+The last patch listed in debian/patches/series will become the current
+patch.
+
+To add a new set of changes, first run quilt push -a, and then run:
+
+ quilt new <patch>
+
+where <patch> is a descriptive name for the patch, used as the filename in
+debian/patches. Then, for every file that will be modified by this patch,
+run:
+
+ quilt add <file>
+
+before editing those files. You must tell quilt with quilt add what files
+will be part of the patch before making changes or quilt will not work
+properly. After editing the files, run:
+
+ quilt refresh
+
+to save the results as a patch.
+
+Alternately, if you already have an external patch and you just want to
+add it to the build system, run quilt push -a and then:
+
+ quilt import -P <patch> /path/to/patch
+ quilt push -a
+
+(add -p 0 to quilt import if needed). <patch> as above is the filename to
+use in debian/patches. The last quilt push -a will apply the patch to
+make sure it works properly.
+
+To remove an existing patch from the list of patches that will be applied,
+run:
+
+ quilt delete <patch>
+
+You may need to run quilt pop -a to unapply patches first before running
+this command.
diff --git a/debian/README.themes b/debian/README.themes
new file mode 100644
index 0000000..bd5603c
--- /dev/null
+++ b/debian/README.themes
@@ -0,0 +1 @@
+This directory is the central location for Sawfish themes.
\ No newline at end of file
diff --git a/debian/changelog.in b/debian/changelog.in
new file mode 100644
index 0000000..41d41b7
--- /dev/null
+++ b/debian/changelog.in
@@ -0,0 +1,5 @@
+sawfish (1:@version ~@gitdate -1nano) unstable; urgency=low
+
+ * New upstream GIT
+
+ -- Christopher Roy Bratusek <zanghar freenet de> Sat, 24 Oct 2009 22:55:17 +0200
diff --git a/debian/clean b/debian/clean
new file mode 100644
index 0000000..88f7a54
--- /dev/null
+++ b/debian/clean
@@ -0,0 +1,15 @@
+configure
+aclocal.m4
+libtool
+config.guess
+config.sub
+po/messages
+po/*mo
+po/Makefile
+themes/*.tar.gz
+lisp/sawfish/gtk/widgets/font.jl
+debian/sawfish-lisp-source.install
+debian/sawfish-data.install
+DOC
+FAQ
+USERDOC
diff --git a/debian/compat b/debian/compat
new file mode 100644
index 0000000..7f8f011
--- /dev/null
+++ b/debian/compat
@@ -0,0 +1 @@
+7
diff --git a/debian/control b/debian/control
new file mode 100644
index 0000000..b3f7770
--- /dev/null
+++ b/debian/control
@@ -0,0 +1,65 @@
+Source: sawfish
+Section: x11
+Build-Conflicts: autoconf2.13, automake1.4
+Priority: optional
+Maintainer: Christopher Roy Bratusek <zanghar freenet de>
+Standards-Version: 3.8.3
+Build-Depends: gettext (>= 0.10.37), debhelper (>= 7.0.0), libxinerama-dev,
+ rep-gtk (>= 1:0.90.0), libgmp3-dev (>= 4.1.4-8),
+ texinfo (<< 4.11) | texinfo (>= 4.11.dfsg.1-3),
+ libgtk2.0-dev (>= 2.12), libxrender-dev, libxext-dev,
+ autotools-dev, automake1.10, quilt (>=0.40), librep-dev (>= 0.90.1),
+ rep, libtool
+Homepage: http://sawfish.wikia.com/
+
+Package: sawfish
+Architecture: any
+Depends: ${shlibs:Depends}, ${misc:Depends}, librep9 (>=0.90.0), rep,
+ rep-gtk (>= 0.18.4), gnome-terminal | x-terminal-emulator,
+ sawfish-data (= ${source:Version})
+Suggests: menu, gnome-control-center, yelp
+Provides: x-window-manager
+Replaces: sawfish-lisp-source (<= 0.38-6), sawfish2
+Conflicts: sawfish2, sawfish-themer, menu (<< 2.1.14)
+Description: a window manager for X11
+ Sawfish is an extensible window manager using an Emacs Lisp-like scripting
+ language. All window decorations are configurable, the basic idea is to
+ have as much user-interface policy as possible controlled through the Lisp
+ language.
+
+Package: sawfish-dbg
+Architecture: any
+Depends: ${misc:Depends}, sawfish (= ${binary:Version}),
+ sawfish-data (= ${source:Version})
+Recommends: sawfish-lisp-source
+Section: debug
+Priority: extra
+Description: sawfish debugging symbols
+ This package contains the debugging symbols from the sawfish window manager.
+ It is not needed for normal operation of the package.
+ .
+ Install it if you need to debug problems in sawfish. You will also almost
+ certainly need sawfish-lisp-source in that case.
+
+Package: sawfish-data
+Architecture: all
+Depends: ${misc:Depends}
+Replaces: sawfish (<< 1:1.5.0-1)
+Conflicts: sawfish (<= 1:1.3+cvs20060518-2)
+Description: sawfish architecture independent data
+ This package contains the architecture independent lisp compiled files
+ and other data, such as theme pixmaps. It is unlikely to be of any
+ use without the sawfish window manager.
+ .
+ The lisp source files are in the sawfish-lisp-source package.
+
+Package: sawfish-lisp-source
+Architecture: all
+Depends: ${misc:Depends}, sawfish-data (= ${source:Version})
+Recommends: sawfish
+Description: sawfish lisp files
+ This package contains the lisp source files in case you want to modify,
+ study or debug the behaviour of the window manager.
+ .
+ It is not required for normal use of sawfish and not installing it will save
+ space in small systems.
diff --git a/debian/copyright b/debian/copyright
new file mode 100644
index 0000000..ca60345
--- /dev/null
+++ b/debian/copyright
@@ -0,0 +1,44 @@
+This package was debianized by Mikolaj J. Habryn <dichro rcpt to> on
+Tue, 19 Oct 1999 16:12:32 +1000.
+
+It was downloaded from
+https://sourceforge.net/project/showfiles.php?group_id=32&package_id=17
+
+Upstream Author: John Harper <jsh unfactored org> and the sawfish community.
+
+Copyright (C) 1997-1998 Stuart Parmenter and Elliot Lee
+Copyright (C) 1999 Ryan Lovett <ryan ocf berkeley edu>
+Copyright (C) 1999-2002 John Harper
+Copyright (C) 2000 Topi Paavola <tjp iki fi>
+Copyright (C) 2000 Unai Uribarri <unaiur telecable es>
+Copyright (C) 2000-2001 Kai Grossjohann <Kai Grossjohann CS Uni-Dortmund DE>
+Copyright (C) 2001 Eazel, Inc
+Copyright (C) 2002 mx & ta
+
+License:
+
+ 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 of the License, 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, write to the Free Software
+ Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
+
+On Debian systems, the complete text of the GNU General Public License
+version 2 can be found in /usr/share/common-licenses/GPL-2 file.
+
+The Debian package itself is
+
+Copyright (C) 1999-2000 Mikolaj J. Habryn
+Copyright (C) 2000 Ian McKellar
+Copyright (C) 2000-2006 Christian Marillat
+Copyright (C) 2006-2009 Rodrigo Gallardo
+
+And is distributed under the same terms as sawfish.
diff --git a/debian/patches/series b/debian/patches/series
new file mode 100644
index 0000000..e69de29
diff --git a/debian/postinst b/debian/postinst
new file mode 100644
index 0000000..bb3bc2e
--- /dev/null
+++ b/debian/postinst
@@ -0,0 +1,18 @@
+#!/bin/sh -e
+
+if [ "$1" = "configure" ]; then
+
+# Touch all jlc files
+ find /usr/share/sawfish/*/lisp -name *.jlc | xargs touch
+
+# Because dh_installwm don't install a slave manpage
+ update-alternatives --install /usr/bin/x-window-manager \
+ x-window-manager /usr/bin/sawfish 70 \
+ --slave /usr/share/man/man1/x-window-manager.1.gz \
+ x-window-manager.1.gz /usr/share/man/man1/sawfish.1.gz
+
+fi
+
+#DEBHELPER#
+
+exit 0
diff --git a/debian/postrm b/debian/postrm
new file mode 100644
index 0000000..e7d75b8
--- /dev/null
+++ b/debian/postrm
@@ -0,0 +1,10 @@
+#! /bin/sh -e
+
+if [ "$1" = purge ]; then
+ rm -rf /etc/X11/sawfish 2>/dev/null || true
+ rm -rf /var/lib/sawfish 2>/dev/null || true
+fi
+
+#DEBHELPER#
+
+exit 0
diff --git a/debian/preinst b/debian/preinst
new file mode 100644
index 0000000..8174461
--- /dev/null
+++ b/debian/preinst
@@ -0,0 +1,9 @@
+#! /bin/sh -e
+
+if [ -d /var/lib/sawfish ]; then
+ rm -rf /var/lib/sawfish 2>/dev/null || true
+fi
+
+#DEBHELPER#
+
+exit 0
diff --git a/debian/prerm b/debian/prerm
new file mode 100644
index 0000000..1521d1f
--- /dev/null
+++ b/debian/prerm
@@ -0,0 +1,11 @@
+#!/bin/sh -e
+
+if [ "$1" = "remove" ]; then
+
+# Because dh_installwm don't remove a slave manpage
+ update-alternatives --remove x-window-manager /usr/bin/sawfish
+fi
+
+#DEBHELPER#
+
+exit 0
diff --git a/debian/rules b/debian/rules
new file mode 100755
index 0000000..b4e642e
--- /dev/null
+++ b/debian/rules
@@ -0,0 +1,163 @@
+#!/usr/bin/make -f
+
+export DH_VERBOSE=1
+
+include /usr/share/quilt/quilt.make
+
+version = $(shell sed -n 's/version="\(.*\)"/\1/p' configure.in | head -n 1)
+
+DEB_HOST_GNU_TYPE ?= $(shell dpkg-architecture -qDEB_HOST_GNU_TYPE)
+DEB_BUILD_GNU_TYPE ?= $(shell dpkg-architecture -qDEB_BUILD_GNU_TYPE)
+
+ifeq ($(DEB_BUILD_GNU_TYPE), $(DEB_HOST_GNU_TYPE))
+ confflags += --build $(DEB_HOST_GNU_TYPE)
+else
+ confflags += --build $(DEB_BUILD_GNU_TYPE) --host $(DEB_HOST_GNU_TYPE)
+endif
+
+CFLAGS += -Wall -g -fno-strict-aliasing
+
+ifneq (,$(findstring noopt,$(DEB_BUILD_OPTIONS)))
+ CFLAGS += -O0
+else
+ CFLAGS += -O2
+endif
+
+LC_ALL=
+LINGUAS=
+LANG=
+export LC_ALL LINGUAS LANG
+
+configure: configure-stamp
+configure-stamp: $(QUILT_STAMPFN)
+ dh_testdir
+
+ cp /usr/share/misc/config.guess .
+ cp /usr/share/misc/config.sub .
+
+ aclocal-1.10
+ autoconf
+
+ CFLAGS="$(CFLAGS)" ./configure --prefix=/usr --with-readline \
+ --libexecdir=/usr/lib $(confflags)
+
+# Get rid of rpath
+ set -e; \
+ tmpfile=`mktemp`; \
+ sed "s/^REP_LIBS=\(.*\)-Wl,--rpath -Wl,[^ ]* \(.*\)$$/REP_LIBS=\1 \2/" Makedefs >$$tmpfile ;\
+ mv $$tmpfile Makedefs
+
+ touch configure-stamp
+
+build: build-stamp
+build-stamp: configure-stamp
+
+ $(MAKE)
+
+ touch build-stamp
+
+clean:
+ dh_testdir
+ dh_testroot
+ rm -f build-stamp configure-stamp
+
+ [ ! -f Makefile ] || $(MAKE) distclean
+
+ rm -rf src/.libexec
+ rm -rf src/.libs
+ rm -rf autom4te.cache/
+
+ dh_clean
+ $(MAKE) -f debian/rules unpatch
+
+install: build
+ dh_testdir
+ dh_testroot
+ dh_installdirs
+
+ $(MAKE) install DESTDIR=$(CURDIR)/debian/tmp
+
+# Fixup libdir in .la files
+ find debian/tmp -name \*.la | while read file; do \
+ libdir=`echo $$file | sed -e 's debian/tmp\(.*\)/[^/]*la$$ \1@' `; \
+ tmpfile=`mktemp`; \
+ sed "s ^libdir= *@libdir='$$libdir'@" $$file >$$tmpfile; \
+ mv $$tmpfile $$file; \
+ done
+
+# Remove info files installed by Makefile. dh_installinfo will do it again without creating info.dir
+ find debian -type d -name info | xargs rm -rf
+
+ [ ! -f debian/sawfish-lisp-source.install ] || rm debian/sawfish-lisp-source.install
+ find debian/tmp/usr/share/sawfish/*/lisp -name \*.jl | \
+ cut -d/ -f3- | grep -v 'autoload\|custom-defaults' > debian/sawfish-lisp-source.install
+
+ cp debian/sawfish-data.install.in debian/sawfish-data.install
+ find debian/tmp/usr/share/sawfish/*/lisp -name \*.jlc | \
+ cut -d/ -f3- | grep -v 'main' >> debian/sawfish-data.install
+
+ dh_install --fail-missing
+
+# These are scripts. (Actually, they are /usr/bin/sawfish-config before and after compiling)
+# Should that be a symlink?
+ chmod a+x debian/sawfish/usr/share/sawfish/$(version)/lisp/sawfish/cfg/main.jlc
+ chmod a+x debian/sawfish-lisp-source/usr/share/sawfish/$(version)/lisp/sawfish/cfg/main.jl
+
+
+# Build architecture-independent files here.
+binary-indep: build install
+ dh_testdir -i
+ dh_testroot -i
+ dh_installdocs -psawfish-data FAQ NEWS README TODO OPTIONS KEYBINDINGS USERDOC
+ dh_installinfo -psawfish-data
+ dh_installexamples -psawfish-data
+ dh_installmenu -psawfish-data
+ dh_installchangelogs -psawfish-data
+ dh_link -i
+ dh_compress -i
+ dh_fixperms -i
+ dh_installdeb -i
+ dh_gencontrol -i
+ dh_md5sums -i
+ dh_builddeb -i
+
+# Build architecture-dependent files here.
+binary-arch: build install
+ dh_testdir
+ dh_testroot
+ dh_installmenu -a
+ dh_installman -a
+ dh_installemacsen -a -psawfish
+ dh_link -a
+ dh_strip -a --dbg-package=sawfish-dbg
+ dh_compress -a
+ dh_fixperms -a
+ dh_installdeb -a
+ dh_shlibdeps -a
+ dh_gencontrol -a
+ dh_md5sums -a
+ dh_builddeb -a
+
+binary: binary-indep binary-arch
+
+# Obtain upstream source snapshot from svn. Leaves it in
+# debian/sawfish_$version.orig.tar.gz
+# By default will get the latest version available, but can be controlled
+# by setting SVN_REV before calling make
+
+SVN_REPO ?= svn://svn.gnome.org/svn/sawfish/trunk
+SVN_REV ?= $(shell LANG=C svn info $(SVN_REPO) | grep Revision: | cut -d: -f 2 | sed 's/^ *\([^ ]*\) *$$/\1/')
+export_dir = debian/tmp-src
+
+source:
+ dh_testdir
+ mkdir -p $(export_dir)
+ svn export -q -r $(SVN_REV) $(SVN_REPO) $(export_dir)/sawfish
+# remove unneeded files
+ cd $(export_dir)/sawfish; \
+ find . -name .cvsignore | xargs rm
+ cd $(export_dir); \
+ tar czf ../sawfish_$$(sed -n 's/version="\(.*\)"/\1/p' sawfish/configure.in | head -n 1)+svn$(SVN_REV).orig.tar.gz sawfish
+ -rm -rf $(export_dir)
+
+.PHONY: build clean binary-indep binary-arch binary install configure
diff --git a/debian/sawfish-data.info b/debian/sawfish-data.info
new file mode 100644
index 0000000..d94b8dd
--- /dev/null
+++ b/debian/sawfish-data.info
@@ -0,0 +1 @@
+man/sawfish.info*
diff --git a/debian/sawfish-data.install.in b/debian/sawfish-data.install.in
new file mode 100644
index 0000000..6765d4e
--- /dev/null
+++ b/debian/sawfish-data.install.in
@@ -0,0 +1,8 @@
+debian/README.themes usr/share/sawfish/themes
+usr/share/locale
+usr/share/sawfish/*/lisp/sawfish/wm/autoload.jl
+usr/share/sawfish/*/lisp/sawfish/wm/custom-defaults.jl
+usr/share/sawfish/*/monitor.png
+usr/share/sawfish/*/sounds
+usr/share/sawfish/*/themes
+usr/share/man/man1/sawfish*.gz
diff --git a/debian/sawfish-dbg.links b/debian/sawfish-dbg.links
new file mode 100644
index 0000000..bb74d90
--- /dev/null
+++ b/debian/sawfish-dbg.links
@@ -0,0 +1 @@
+usr/share/doc/sawfish-data usr/share/doc/sawfish-dbg
diff --git a/debian/sawfish-lisp-source.links b/debian/sawfish-lisp-source.links
new file mode 100644
index 0000000..b0f7bc0
--- /dev/null
+++ b/debian/sawfish-lisp-source.links
@@ -0,0 +1 @@
+usr/share/doc/sawfish-data usr/share/doc/sawfish-lisp-source
diff --git a/debian/sawfish-lisp-source.lintian b/debian/sawfish-lisp-source.lintian
new file mode 100644
index 0000000..f9370bc
--- /dev/null
+++ b/debian/sawfish-lisp-source.lintian
@@ -0,0 +1 @@
+sawfish-lisp-source: script-not-executable ./usr/share/sawfish/1.3/lisp/sawfish/ui/main.jl
diff --git a/debian/sawfish.dirs b/debian/sawfish.dirs
new file mode 100644
index 0000000..44adb57
--- /dev/null
+++ b/debian/sawfish.dirs
@@ -0,0 +1,5 @@
+etc/emacs/site-start.d
+usr/share/emacs/site-lisp/sawfish
+usr/share/gnome/wm-properties
+usr/share/xsessions
+var/lib/sawfish
diff --git a/debian/sawfish.el b/debian/sawfish.el
new file mode 100644
index 0000000..f1fdc85
--- /dev/null
+++ b/debian/sawfish.el
@@ -0,0 +1,1003 @@
+;;; sawfish.el --- Sawfish mode.
+;; Copyright 1999,2000,2001,2002,2003,2004 by Dave Pearson <davep davep org>
+;; $Revision: 1.32 $
+
+;; sawfish.el is free software distributed under the terms of the GNU
+;; General Public Licence, version 2. For details see the file COPYING.
+
+;;; Commentary:
+;;
+;; sawfish.el is an emacs mode for writing code for the sawfish window
+;; manager <URL:http://sawmill.sourceforge.net/>. As well as providing a
+;; programming mode it also allows for direct interaction with the running
+;; window manager.
+;;
+;; The latest sawfish.el is always available from:
+;;
+;; <URL:http://www.davep.org/emacs/#sawfish.el>
+
+;;; THANKS:
+;;
+;; John Harper <john dcs warwick ac uk> for help regarding sawfish and rep.
+;;
+;; Stefan Monnier for finding the font-lock (or lack of) with derived modes
+;; problem and providing a fix for GNU Emacs.
+;;
+;; Jan Vroonhof for his invaluable pointers regarding XEmacs.
+;;
+;; Hubert Selhofer for the code to syntax highlight "#||#" comments, for the
+;; GNU emacs font-lock code to provide support for various rep and sawfish
+;; "keywords" and for the GNU emacs emacs-lisp menu removal kludge.
+;;
+;; Kai Grossjohann for his enhancments to `sawfish-console'.
+;;
+;; Markus Holmberg for the code that improves integration with info.
+
+;;; BUGS:
+;;
+;; o The handling of the apropos buffer totally breaks down under XEmacs.
+;;
+;; o sawfish.el needs a total rewrite. When I started this mode rep (the
+;; lisp that sawfish is based around) was an elisp-a-like. Since then it
+;; has turned into a scheme-a-like that happens to retain some
+;; elisp-a-like bits. Ideally a new sawfish.el would be written in terms
+;; of a librep.el which would be a ground-up-rewritten mode for dealing
+;; with rep.
+
+;;; INSTALLATION:
+;;
+;; o Drop sawfish.el somwehere into your `load-path'. Try your site-lisp
+;; directory for example (you might also want to byte-compile the file).
+;;
+;; o Add autoloads for the various sawfish functions to ~/.emacs. At the
+;; very least you want to do something like:
+;;
+;; (autoload 'sawfish-mode "sawfish" "sawfish-mode" t)
+;;
+;; o Add the following to ~/.emacs to ensure that sawfish mode is used when
+;; you go to edit sawfish code:
+;;
+;; (setq auto-mode-alist (cons '("\\.sawfishrc$" . sawfish-mode) auto-mode-alist)
+;; auto-mode-alist (cons '("\\.jl$" . sawfish-mode) auto-mode-alist)
+;; auto-mode-alist (cons '("\\.sawfish/rc$" . sawfish-mode) auto-mode-alist))
+
+;;; Code:
+
+;; Things we need:
+(eval-when-compile
+ (require 'cl)
+ (require 'info))
+(require 'thingatpt)
+(require 'font-lock)
+(require 'regexp-opt)
+(require 'pp)
+(require 'easymenu)
+(require 'inf-lisp)
+
+;; Shut the compiler up.
+(eval-when-compile
+
+ ;; Keep everyone quiet.
+ (defvar sawfish-mode-map)
+ (defvar sawfish-mode-menu)
+
+ ;; Things to keep XEmacs quiet.
+ (unless (boundp 'font-lock-defaults-alist)
+ (defvar font-lock-defaults-alist))
+
+ ;; Things to keep GNU Emacs quiet.
+ (unless (boundp 'delete-menu-item)
+ (defun delete-menu-item (path)
+ nil)))
+
+;; Attempt to handle older/other emacs.
+(eval-and-compile
+ ;; If customize isn't available just use defvar instead.
+ (unless (fboundp 'defgroup)
+ (defmacro defgroup (&rest rest) nil)
+ (defmacro defcustom (symbol init docstring &rest rest)
+ `(defvar ,symbol ,init ,docstring))))
+
+;; Customize options.
+
+(defgroup sawfish nil
+ "Mode for editing the configuration of and interacting with the sawfish
+window manager."
+ :group 'languages
+ :prefix "sawfish-")
+
+(defcustom sawfish-client "sawfish-client"
+ "*Command for interacting with the window manager."
+ :type 'string
+ :group 'sawfish)
+
+(defcustom sawfish-exec-parameter "-e"
+ "*Parameter for `sawfish-client' that tells it to eval a form and exit."
+ :type 'string
+ :group 'sawfish)
+
+(defcustom sawfish-interactive-parameter "-"
+ "*Interactive mode parameter for `sawfish-client'."
+ :type 'string
+ :group 'sawfish)
+
+(defcustom sawfish-result-buffer "*sawfish*"
+ "*Name of the long result display buffer."
+ :type 'string
+ :group 'sawfish)
+
+(defcustom sawfish-help-buffer "*sawfish-help*"
+ "*Name of the sawfish help buffer."
+ :type 'string
+ :group 'sawfish)
+
+(defcustom sawfish-apropos-buffer "*sawfish-apropos*"
+ "*Name of the sawfish apropos buffer."
+ :type 'string
+ :group 'sawfish)
+
+(defcustom sawfish-scratch-buffer "*sawfish-scratch*"
+ "*Name of the sawfish scratch buffer."
+ :type 'string
+ :group 'sawfish)
+
+(defcustom sawfish-buffer-symbol-lists t
+ "*Buffer the lists of function and variable names?"
+ :type 'boolean
+ :group 'sawfish)
+
+(defcustom sawfish-apropos-searches-info-files t
+ "*Search info files for apropos \"one-liner\" help?
+
+This variable controls the action of the sawfish apropos functions. When nil
+the apropos functions won't go looking in the sawfish info files for a
+one-line doc-string to display in the apropos buffer if the symbol doesn't
+have a doc-string. This will make apropos calls a lot faster."
+ :type 'boolean
+ :group 'sawfish)
+
+(defcustom sawfish-mode-hook nil
+ "*List of hooks to execute on entry to sawfish-mode."
+ :type 'hook
+ :group 'sawfish)
+
+(defcustom sawfish-info-files '(("sawfish" "Function Index" "Variable Index")
+ ("librep" "Function Index" "Variable Index"))
+ "*List of info files to search when looking for info documentation.
+
+This is a list of lists. Each entry in the list is of the format:
+
+ (INFO-FILE FUNCTION-INDEX VARIABLE-INDEX)"
+ :type '(repeat (list :tag "Info file information"
+ (string :tag "Info file name")
+ (string :tag "Function index name")
+ (string :tag "Variable index name")))
+ :group 'sawfish)
+
+(defcustom sawfish-comint-prompt "^sawfish% "
+ "*Regular expression for matching the sawfish-client prompt."
+ :type 'regexp
+ :group 'sawfish)
+
+(defcustom sawfish-extra-keyword-list
+ '("add-frame-style" "call-after-load" "call-after-property-changed"
+ "call-after-state-changed" "custom-set-property")
+ "List of extra keywords for Sawfish used in highlighting.
+Highlight these expressions with `font-lock-keyword-face'."
+ :group 'sawfish
+ :type '(repeat (string :tag "Keyword: ")))
+
+(defcustom sawfish-warning-keyword-list
+ '("fixme" "FIXME" "Fixme" "fix me" "Fix me" "!!!" "Grrr" "Bummer")
+ "List of keywords for Sawfish used in highlighting.
+Highlight these expressions with `font-lock-warning-face' even if
+already fontified."
+ :group 'sawfish
+ :type '(repeat (string :tag "Keyword: ")))
+
+;; Non customising variables.
+
+(defvar sawfish-function-list nil
+ "List of sawfish functions.")
+
+(defvar sawfish-variable-list nil
+ "List of sawfish variables.")
+
+(defvar sawfish-function-p '(lambda (s)
+ (and
+ (boundp s)
+ (or
+ (functionp (symbol-value s))
+ (macrop (symbol-value s))
+ (special-form-p (symbol-value s)))))
+ "Closure to pass to sawfish-client for testing if a symbol is a function.")
+
+(defvar sawfish-variable-p `(lambda (s)
+ (and (boundp s)
+ (not (,sawfish-function-p s))))
+ "Closure to pass to sawfish-client for testing if a symbol is a variable.")
+
+(defvar sawfish-read-expression-map nil
+ "Minibuffer keymap used for reading sawfish lisp expressions.")
+
+(defvar sawfish-interaction-mode-map nil
+ "Keymap for use with `sawfish-interaction'.")
+
+(defvar sawfish-read-expression-history nil
+ "History list for `sawfish-eval-expression'.")
+
+(defvar sawfish-describe-symbol
+ '(lambda (s)
+ (if (boundp s)
+ (cond ((special-form-p (symbol-value s)) "Special form")
+ ((macrop (symbol-value s)) "Macro")
+ ((subrp (symbol-value s)) "Built-in function")
+ ((commandp (symbol-value s)) "Command")
+ ((functionp (symbol-value s)) "Function")
+ ((binding-immutable-p s ) "Constant")
+ (t "Variable"))
+ "Symbol"))
+ "Closure to pass to sawfish-client that will describe a symbol's binding.")
+
+;; Constants.
+
+(defconst sawfish-defines-regexp
+ (concat "(\\("
+ (regexp-opt
+ ;; A cute way to obtain the list below would be:
+ ;; (sawfish-code (mapcar symbol-name (apropos "^define")))
+ ;;
+ ;; It would, however, mean that you'd have a list of "keywords"
+ ;; define in your running instance of sawfish. It would also
+ ;; mean that you'd have to have sawfish running at the time
+ ;; that this constant is defined.
+ (list
+ "define" "define-command-args" "define-command-to-screen"
+ "define-custom-deserializer" "define-custom-serializer"
+ "define-custom-setter" "define-datum-printer"
+ "define-file-handler" "define-focus-mode"
+ "define-frame-class" "define-frame-type-mapper"
+ "define-interface" "define-linear-viewport-commands"
+ "define-match-window-formatter"
+ "define-match-window-group" "define-match-window-property"
+ "define-match-window-setter" "define-parse"
+ "define-placement-mode" "define-record-type"
+ "define-record-discloser" "define-scan-body"
+ "define-scan-form" "define-scan-internals"
+ "define-structure" "define-value"
+ "define-window-animator"))
+ "\\)\\>[ \t'(]*\\(\\sw+\\)?")
+ "List of define-structures known by Sawfish.")
+
+(defconst sawfish-additional-keywords
+ (append lisp-font-lock-keywords-2
+ (list
+ ;; highlight define-*
+ (list
+ sawfish-defines-regexp
+ '(1 font-lock-keyword-face)
+ `(,(regexp-opt-depth sawfish-defines-regexp)
+ font-lock-variable-name-face nil t))
+ ;; extra keywords
+ (if sawfish-extra-keyword-list
+ (list (concat "\\<"
+ `,(regexp-opt sawfish-extra-keyword-list)
+ "\\>")
+ '(0 font-lock-keyword-face)))
+ ;; highlight warnings
+ (if sawfish-warning-keyword-list
+ (list (concat "\\<"
+ `,(regexp-opt sawfish-warning-keyword-list)
+ "\\>")
+ '(0 font-lock-warning-face prepend)))))
+ "Some additonal keywords to highlight in `sawfish-mode'.")
+
+;; Main code:
+
+;;;###autoload
+(define-derived-mode sawfish-mode emacs-lisp-mode "Sawfish"
+ "Major mode for editing sawfish files and for interacting with sawfish.
+
+Special commands:
+
+\\{sawfish-mode-map}"
+ ;; `define-derived-mode' in both GNU Emacs and XEmacs doesn't appear to
+ ;; derive the font-lock settings. So, depending on the editor in use we
+ ;; need to drag those settings down to us in different ways (hmm)....
+ (if (and (boundp 'running-xemacs) (symbol-value 'running-xemacs))
+ ;; XEmacs appears to do something like this...
+ (put 'sawfish-mode 'font-lock-defaults
+ (get 'emacs-lisp-mode 'font-lock-defaults))
+ ;; ...with GNU Emacs we need to pull it from `font-lock-defaults-alist'.
+ (unless font-lock-defaults
+ (set (make-local-variable 'font-lock-defaults)
+ (cdr (assoc 'emacs-lisp-mode font-lock-defaults-alist)))
+ ;; Add the additional font-lock pattern to `font-lock-defaults'
+ ;; only once
+ (unless (memq 'sawfish-additional-keywords (car font-lock-defaults))
+ (setq font-lock-defaults (copy-alist font-lock-defaults))
+ (setcar font-lock-defaults
+ (append (car font-lock-defaults)
+ '(sawfish-additional-keywords))))))
+ ;; Menu stuff.
+ (if (and (boundp 'running-xemacs) (symbol-value 'running-xemacs))
+ ;; XEmacs.
+ (progn
+ ;; For some odd reason `delete-menu-item' doesn't seem to always work.
+ ;; Anyone know why?
+ (delete-menu-item '("Emacs-Lisp"))
+ ;; XEmacs seems to require that you add the menu yourself.
+ (easy-menu-add sawfish-mode-menu))
+ ;; See the end of this file for the code that removes the emacs lisp
+ ;; menu.
+ )
+ ;; Add support for #| ... |# style comments (call it style b) see GNU
+ ;; Emacs Lisp Reference Manual (Rev. 2.5), p. 673-675
+ (modify-syntax-entry ?# "' 14b") ; quote or comment (style b)
+ (modify-syntax-entry ?| "_ 23b") ; symbol or comment (style b)
+ (modify-syntax-entry ?\n ">a") ; end comment (style a)
+ ;; The following adds some indentation information to help sawfish-mode
+ ;; (rep is a sort of elisp/scheme hybrid with some extra stuff of its own,
+ ;; we inherit from emacs-lisp-mode so we need to add a sprinkle of scheme
+ ;; support).
+ (loop for sym in '((define . 1)
+ (define-interface . 1)
+ (define-record-discloser . 1)
+ (define-record-type . 1)
+ (define-structure . 3)
+ (letrec . 1)
+ (structure . 2)
+ (with-output-to-screen . 0))
+ do (unless (get (car sym) 'lisp-indent-function)
+ (put (car sym) 'lisp-indent-function (cdr sym)))))
+
+(defun sawfish-eval (sexp &optional target-buffer)
+ "Pass SEXP to sawfish for evaluation.
+
+SEXP can either be a list or a string.
+
+If passed the result of the evaluation is inserted into TARGET-BUFFER."
+ (call-process sawfish-client nil target-buffer nil sawfish-exec-parameter
+ (if (stringp sexp) sexp (format "%S" sexp))))
+
+(defun sawfish-string-readable-p (sexp)
+ "Can string SEXP be safely `read'?"
+ (not (string-match "#<\\w+" sexp)))
+
+(defun sawfish-buffer-readable-p (&optional buffer)
+ "Can the content of BUFFER be safely `read'?"
+ (sawfish-string-readable-p
+ (with-current-buffer (or buffer (current-buffer))
+ (buffer-string))))
+
+(defun sawfish-eval-noread (sexp)
+ "Eval SEXP and return the result without `read'ing it."
+ (with-temp-buffer
+ (sawfish-eval sexp t)
+ (buffer-substring-no-properties (point-min) (1- (point-max)))))
+
+(defun sawfish-eval-read (sexp)
+ "Eval SEXP and return the result of `read'ing the result.
+
+SEXP can either be a list or a string."
+ (let ((result (sawfish-eval-noread sexp)))
+ (if (sawfish-string-readable-p result)
+ (read result)
+ result)))
+
+;;;###autoload
+(defun sawfish-eval-region (start end &optional target-buffer)
+ "Evaluate the region bounded by START and END.
+
+TARGET-BUFFER is the optional target for the return value of the
+evaluation."
+ (interactive "r")
+ (sawfish-eval (buffer-substring-no-properties start end) target-buffer))
+
+;;;###autoload
+(defun sawfish-eval-buffer ()
+ "Evaluate the whole buffer."
+ (interactive)
+ (sawfish-eval-region (point-min) (point-max) nil))
+
+;;;###autoload
+(defun sawfish-eval-defun (insert-value)
+ "Evaluate the top level form at or near `point'.
+
+INSERT-VALUE is a prefix parameter, if it is non-NIL the value of the
+expression is inserted into the buffer after the form."
+ (interactive "P")
+ (save-restriction
+ (save-excursion
+ (narrow-to-defun)
+ (setf (point) (point-max))
+ (let ((result (sawfish-eval-last-sexp nil)))
+ (if insert-value
+ (let ((standard-output (current-buffer)))
+ (setf (point) (point-min))
+ (end-of-defun)
+ (unless (bolp)
+ (terpri))
+ (princ result)
+ (terpri))
+ (sawfish-output result))))))
+
+;;;###autoload
+(defun sawfish-eval-expression (sexp &optional insert-value)
+ "Evaluate SEXP and display the value in the minibuffer.
+
+If the optional parameter INSERT-VALUE is supplied as a non-NIL value the
+value of SEXP will be inserted into the current buffer."
+ (interactive
+ (list
+ (read-from-minibuffer "Sawfish Eval: " nil sawfish-read-expression-map t 'sawfish-read-expression-history)
+ current-prefix-arg))
+ (let ((result (sawfish-eval-noread sexp)))
+ (if insert-value
+ (let ((standard-output (current-buffer)))
+ (princ result))
+ (sawfish-output result))))
+
+(defun sawfish-output (output)
+ "Display output either in mini-buffer or a seperate buffer.
+
+If the output is empty then the string \"No output\" is displayed.
+
+If the output is one line long and the length of the line is less than the
+`frame-width' then it is displayed using `message'.
+
+If the output has multiple lines or is longer than `frame-width' then a new
+buffer is opened and the text is displayed there. The name of the buffer is
+set by the variable `sawfish-result-buffer'"
+ (with-temp-buffer
+ (let ((temp-buffer (current-buffer)))
+ (insert output)
+ (let ((lines (count-lines (point-min) (point-max))))
+ (cond
+ ((zerop lines) ; Nothing to display.
+ (message "No output"))
+ ((and (= 1 lines) ; If there is only one line
+ (< (- (point-max) ; and it isn't too wide for
+ (point-min)) ; the display.
+ (frame-width)))
+ (setf (point) (point-min))
+ (replace-string "\n" "") ; Strip any trailing EOLs.
+ (when (get-buffer-window sawfish-result-buffer)
+ ;; The long result buffer is visible, delete it.
+ (delete-window (get-buffer-window sawfish-result-buffer)))
+ (message "%s" (buffer-string)))
+ (t ; Too large for message area, use a buffer.
+ (with-output-to-temp-buffer sawfish-result-buffer
+ (with-current-buffer sawfish-result-buffer
+ (if (sawfish-string-readable-p output)
+ (pp (read output) (current-buffer))
+ (setf (buffer-string) (format "%s" (with-current-buffer temp-buffer
+ (buffer-string)))))
+ (shrink-window-if-larger-than-buffer (display-buffer (current-buffer))))
+ (bury-buffer (current-buffer)))))))))
+
+(defun sawfish-insert (string)
+ "Insert STRING into `current-buffer', pretty print if at all possible."
+ (if (sawfish-string-readable-p string)
+ (pp (read string) (current-buffer))
+ (insert string)))
+
+;;;###autoload
+(defun sawfish-eval-last-sexp (to-buffer)
+ "Version of `eval-last-sexp' that interacts with sawfish."
+ (interactive "P")
+ (let ((home-buffer (current-buffer)))
+ (with-temp-buffer
+ (let ((temp-buffer (current-buffer)))
+ (with-current-buffer home-buffer
+ (sawfish-eval-region (save-excursion
+ (backward-sexp)
+ (point))
+ (point)
+ temp-buffer)
+ (funcall (if to-buffer
+ #'sawfish-insert
+ #'sawfish-output)
+ (with-current-buffer temp-buffer (buffer-string))))))))
+
+;;;###autoload
+(defun sawfish-eval-print-last-sexp ()
+ (interactive)
+ (insert "\n")
+ (sawfish-eval-last-sexp t))
+
+(defmacro sawfish-code (&rest body)
+ "Pass BODY to sawfish for evaluation."
+ `(sawfish-eval-read (cons 'progn (quote ,body))))
+
+(defun sawfish-load-helpers ()
+ "Load modules that help us work with sawfish."
+ (sawfish-code
+ (require 'rep.structures)
+ (require 'lisp-doc)))
+
+(defun sawfish-load-symbols (&optional force)
+ "Loads the names of the sawfish functions and variables."
+ (unless (and (not (or force (not sawfish-buffer-symbol-lists)))
+ sawfish-function-list sawfish-variable-list)
+ (setq sawfish-function-list nil
+ sawfish-variable-list nil)
+ (flet ((sawfish-fun-p (sym) (second sym))
+ (sawfish-var-p (sym) (third sym)))
+ (loop for sym in (sawfish-eval-read
+ `(mapcar (lambda (sym)
+ (list
+ (symbol-name sym)
+ (or (macrop sym) (,sawfish-function-p sym))
+ (,sawfish-variable-p sym)))
+ (apropos ".")))
+ if (sawfish-fun-p sym) do (push (list (car sym)) sawfish-function-list)
+ if (sawfish-var-p sym) do (push (list (car sym)) sawfish-variable-list)))))
+
+(defun sawfish-documentation (symbol &optional is-variable)
+ "Get the documentation for SYMBOL."
+ (sawfish-eval-read `(documentation (quote ,symbol) ,is-variable)))
+
+(defun sawfish-funcall-at-point ()
+ "Try and work out the function being called at or near `point'."
+ ;; `thing-at-point', when trying to grab a list, doesn't appear to do what
+ ;; I need most of the time. I need to figure out what is wrong or write
+ ;; something better.
+ (let ((list (thing-at-point 'list)))
+ (when list
+ (let ((fun (symbol-name (car (read list)))))
+ (when (assoc fun sawfish-function-list)
+ fun)))))
+
+(defun sawfish-variable-at-point ()
+ "Try and work out the variable being called at or near `point'."
+ (let ((sym (thing-at-point 'symbol)))
+ (when sym
+ (let ((var (symbol-name (read sym))))
+ (when (assoc var sawfish-variable-list)
+ var)))))
+
+(defun sawfish-describe-ask (default description lookups)
+ "Ask the user for a symbol.
+
+The symbol will be described as DESCRIPTION with a completing read using
+LOOKUPS for the completion. DEFAULT should be a function that returns a
+default value for the read."
+ (sawfish-load-symbols)
+ (intern (completing-read (format "Sawfish %s: " description)
+ (symbol-value lookups)
+ nil
+ t
+ (funcall default))))
+
+(defun sawfish-describe-ask-function ()
+ "Ask for a function name."
+ (sawfish-describe-ask #'sawfish-funcall-at-point "function" 'sawfish-function-list))
+
+(defun sawfish-describe-ask-variable ()
+ "Ask for a variable name."
+ (sawfish-describe-ask #'sawfish-variable-at-point "variable" 'sawfish-variable-list))
+
+(defun sawfish-info-function-index (info-file)
+ "Return the name of the function index from INFO-FILE.
+
+This function is used to pull information from the entries found in the
+variable `sawfish-info-files'."
+ (cadr info-file))
+
+(defun sawfish-info-variable-index (info-file)
+ "Return the name of the variable index from INFO-FILE.
+
+This function is used to pull information from the entries found in the
+variable `sawfish-info-files'."
+ (car (cddr info-file)))
+
+(defun sawfish-info-index-function (is-variable)
+ "Return the a function for accessing the info file list."
+ (if is-variable #'sawfish-info-variable-index #'sawfish-info-function-index))
+
+(defun sawfish-describe-show (symbol &optional is-variable)
+ "Show the sawfish description for SYMBOL."
+ (with-output-to-temp-buffer sawfish-help-buffer
+ (princ (format "`%s' is a %s" symbol
+ (sawfish-eval-read `(,sawfish-describe-symbol (quote ,symbol)))))
+ (when is-variable
+ (princ "\n\nValue:\n\n")
+ (pp (sawfish-eval-read symbol)))
+ (princ "\n\nDocumentation:\n\n")
+ (let ((doc (or (sawfish-documentation symbol is-variable)
+ (sawfish-search-and-grab-info (sawfish-info-index-function is-variable) symbol))))
+ (if doc
+ (princ doc)
+ (princ (format "%s is undocumented" symbol))))
+ (let ((plist (sawfish-eval-read `(symbol-plist (quote ,symbol)))))
+ (when (and plist (listp plist))
+ (princ "\n\nProperty list for symbol:\n")
+ (loop for prop on plist by #'cddr
+ do (princ (format "\n%s: %S" (car prop) (cadr prop))))))))
+
+;;;###autoload
+(defun sawfish-describe-function (function)
+ "Display the doc-string for FUNCTION."
+ (interactive (list (sawfish-describe-ask-function)))
+ (sawfish-load-helpers)
+ (sawfish-describe-show function))
+
+;;;###autoload
+(defun sawfish-describe-variable (variable)
+ "Display the doc-string for VARIABLE."
+ (interactive (list (sawfish-describe-ask-variable)))
+ (sawfish-load-helpers)
+ (sawfish-describe-show variable t))
+
+(defun sawfish-find-info-entry (info-file node symbol)
+ "Try to find SYMBOL in NODE of INFO-FILE.
+
+If the symbol isn't found the Info buffer is killed and the function returns
+nil, otherwise the Info buffer is left as the `current-buffer'."
+ (condition-case nil
+ (progn
+ (require 'info)
+ (Info-find-node info-file node)
+ (Info-menu (format "%s" symbol))
+ t)
+ (error
+ (when (string= (buffer-name) "*info*")
+ (kill-buffer (current-buffer)))
+ nil)))
+
+(defun sawfish-jump-to-info-documentaiton (symbol)
+ "Jump to the documentation for SYMBOL in an info buffer.
+
+Returns NIL if the documentation could not be found. Note that the
+`current-buffer' must be the info buffer you are searching."
+ (prog1
+ (search-forward-regexp (format "^ - .*: %s" symbol) nil t)
+ (beginning-of-line)))
+
+(defun sawfish-extract-info-entry (symbol)
+ "Extract the info documentation for SYMBOL as a string."
+ (when (sawfish-jump-to-info-documentaiton symbol)
+ ;; For some odd reason, in XEmacs, the `current-buffer' inside
+ ;; `with-output-to-string' is the string output buffer, not your
+ ;; `current-buffer' before the call to `with-output-to-string'. Bizarre!
+ ;; GNU emacs does the right thing.
+ ;;
+ ;; Anyway, to get round this odd behaviour you'll see lots of pointless
+ ;; calls to `with-current-buffer' <sigh>.
+ (let ((info-buffer (current-buffer)))
+ (with-output-to-string nil
+ (princ (with-current-buffer info-buffer
+ (buffer-substring-no-properties
+ (+ (point) 3) ; Strip the leading " - ".
+ (save-excursion
+ (end-of-line)
+ (point)))))
+ (terpri)
+ (terpri)
+ (with-current-buffer info-buffer
+ (forward-line))
+ (loop while (with-current-buffer info-buffer
+ ;; I'm not 100% sure what to look for when trying to
+ ;; find the end of a info entry. This seems to work.
+ (and (not (eobp))
+ (or (looking-at "^ ")
+ (looking-at "^ *$"))))
+ do (let ((eol (with-current-buffer info-buffer
+ (save-excursion
+ (end-of-line)
+ (point)))))
+ (princ (with-current-buffer info-buffer
+ (buffer-substring-no-properties
+ (min (+ (point) 5) eol) ; Strip the leading white space.
+ eol))))
+ (terpri)
+ (with-current-buffer info-buffer
+ (forward-line)))))))
+
+(defun sawfish-search-and-grab-info (index-function symbol)
+ "Look for SYMBOL in all the sawfish info files, return the docs.
+
+INDEX-FUNCTION is used to decide which index name will be searched. The
+function is used to access the lists in `sawfish-info-files'."
+ (save-excursion
+ (loop for info-file in sawfish-info-files
+ if (sawfish-find-info-entry (car info-file) (funcall index-function info-file) symbol)
+ return (prog1 (sawfish-extract-info-entry symbol) (kill-buffer (current-buffer)))
+ finally return nil)))
+
+(defun sawfish-search-info-files (index-function symbol)
+ "Look for SYMBOL in all the sawfish info files.
+
+INDEX-FUNCTION is used to decide which index name will be searched. The
+function is used to access the lists in `sawfish-info-files'."
+ (loop for info-file in sawfish-info-files
+ if (sawfish-find-info-entry (car info-file) (funcall index-function info-file) symbol) return t
+ finally (error "No info documentation found for %s" symbol)))
+
+(defun sawfish-search-info-files-for-function (function)
+ "Search for info documentation for FUNCTION."
+ (sawfish-search-info-files #'sawfish-info-function-index function))
+
+(defun sawfish-search-info-files-for-variable (variable)
+ "Search for info documentation for VARIABLE."
+ (sawfish-search-info-files #'sawfish-info-variable-index variable))
+
+;;;###autoload
+(defun sawfish-info-function (function)
+ "Display the Info documentation for FUNCTION."
+ (interactive (list (sawfish-describe-ask-function)))
+ (sawfish-search-info-files-for-function function)
+ (sawfish-jump-to-info-documentaiton function))
+
+;;;###autoload
+(defun sawfish-info-variable (variable)
+ "Display the Info documentation for VARIABLE."
+ (interactive (list (sawfish-describe-ask-variable)))
+ (sawfish-search-info-files-for-variable variable)
+ (sawfish-jump-to-info-documentaiton variable))
+
+(defsubst sawfish-apropos-symbol (sym)
+ "`sawfish-apropos' support function."
+ (nth 0 sym))
+
+(defsubst sawfish-apropos-symbol-name (sym)
+ "`sawfish-apropos' support function."
+ (symbol-name (sawfish-apropos-symbol sym)))
+
+(defsubst sawfish-apropos-description (sym)
+ "`sawfish-apropos' support function."
+ (nth 1 sym))
+
+(defsubst sawfish-apropos-variable-p (sym)
+ "`sawfish-apropos' support function."
+ (nth 2 sym))
+
+(defsubst sawfish-apropos-doc-string (sym)
+ "`sawfish-apropos' support function."
+ (nth 3 sym))
+
+(defun sawfish-doc-string-first-line (doc-string)
+ "Given doc string DOC-STRING return the first line.
+
+If the doc-string is NIL (no documentation) then \"Undocumented\" is
+returned."
+ (if doc-string
+ (with-temp-buffer
+ (insert doc-string)
+ (setf (point) (point-min))
+ (end-of-line)
+ (buffer-substring-no-properties (point-min) (point)))
+ "Undocumented"))
+
+(defun sawfish-remove-info-one-liner-intro (doc-string)
+ "Remove the leading symbol type text from an info derived doc-string."
+ (when doc-string
+ (with-temp-buffer
+ (insert doc-string)
+ (setf (point) (point-min))
+ (if (search-forward-regexp ": +" nil t)
+ (buffer-substring-no-properties (point) (point-max))
+ doc-string))))
+
+(defun sawfish-apropos-insert-link (sym)
+ "Insert a documentation link for SYM into the apropos buffer."
+ (let ((start (point)))
+ (insert (sawfish-apropos-symbol-name sym))
+ (put-text-property start (point) 'face 'bold))
+ (insert "\n ")
+ (let ((start (point)))
+ (insert (sawfish-apropos-description sym) ":")
+ (put-text-property start (point) 'mouse-face 'highlight)
+ (let ((local-map (make-sparse-keymap))
+ (desc `(lambda ()
+ (interactive)
+ (,(if (sawfish-apropos-variable-p sym)
+ #'sawfish-describe-variable #'sawfish-describe-function)
+ (quote ,(sawfish-apropos-symbol sym))))))
+ (define-key local-map [mouse-2] desc)
+ (define-key local-map [return] desc)
+ (put-text-property (- start 2) (point) 'local-map local-map)))
+ (insert " "
+ (sawfish-doc-string-first-line (or (sawfish-apropos-doc-string sym)
+ (and sawfish-apropos-searches-info-files
+ (sawfish-remove-info-one-liner-intro
+ (sawfish-search-and-grab-info
+ (sawfish-info-index-function
+ (sawfish-apropos-variable-p sym))
+ (sawfish-apropos-symbol sym))))))
+ "\n"))
+
+;;;###autoload
+(defun sawfish-apropos (regexp)
+ "Show all bound sawfish symbols whose names match REGEXP."
+ (interactive "sSawfish Apropos (regexp): ")
+ (sawfish-load-helpers)
+ (let ((hits (sort (sawfish-eval-read
+ `(progn
+ (require (quote lisp-doc))
+ (mapcar
+ (lambda (s)
+ (list s
+ (,sawfish-describe-symbol s)
+ (,sawfish-variable-p s)
+ (documentation s (,sawfish-variable-p s))))
+ (apropos ,regexp))))
+ (lambda (symX symY)
+ (string< (sawfish-apropos-symbol-name symX)
+ (sawfish-apropos-symbol-name symY))))))
+ (if (not (zerop (length hits)))
+ (with-output-to-temp-buffer sawfish-apropos-buffer
+ (with-current-buffer sawfish-apropos-buffer
+ (setf (buffer-string) "")
+ (loop for sym in hits do (sawfish-apropos-insert-link sym))))
+ (message "No apropos matches for `%s'" regexp))))
+
+;;;###autoload
+(defun sawfish-complete-symbol ()
+ "Attempt to complete the symbol at `point'."
+ (interactive)
+ (let ((sym (thing-at-point 'symbol)))
+ (when sym
+ (let* ((sym (symbol-name (read sym)))
+ (sym-re (concat "^" (regexp-quote sym)))
+ (completion (sawfish-eval-read
+ `(complete-string ,sym (mapcar symbol-name (apropos ,sym-re))))))
+ (if completion
+ (if (equal completion sym)
+ (let ((sym-list (sawfish-eval-read `(mapcar symbol-name (apropos ,(format "^%s" sym))))))
+ (when (> (length sym-list) 1)
+ (with-output-to-temp-buffer "*Completions*"
+ (display-completion-list
+ (sawfish-eval-read `(mapcar symbol-name (apropos ,sym-re)))))))
+ (let ((bounds (bounds-of-thing-at-point 'symbol)))
+ (delete-region (car bounds) (cdr bounds))
+ (insert completion)))
+ (error "No completion for `%s'" sym))))))
+
+;;;###autoload
+(defun sawfish-info ()
+ "View the sawfish info file."
+ (interactive)
+ (info "sawfish"))
+
+;;;###autoload
+(defun sawfish-rep-info ()
+ "View the librep info file."
+ (interactive)
+ (info "librep"))
+
+(define-derived-mode sawfish-console-mode inferior-lisp-mode
+ "*sawfish-console*" nil
+ (make-local-variable 'inferior-lisp-prompt)
+ (setq inferior-lisp-prompt sawfish-comint-prompt))
+
+;;;###autoload
+(defun sawfish-console ()
+ "Run the sawfish client as an inferior lisp."
+ (interactive)
+ ;; TODO: How to set lisp-*-command variables for this particular
+ ;; instantiation of the inferior lisp buffer?
+ (unless (comint-check-proc "*sawfish-client*")
+ (set-buffer (make-comint "sawfish-client" sawfish-client nil sawfish-interactive-parameter))
+ (sawfish-console-mode))
+ (set (make-local-variable 'inferior-lisp-buffer) "*sawfish-client*")
+ (pop-to-buffer "*sawfish-client*"))
+
+(defun sawfish-interaction-mode ()
+ "Extend `sawfish-mode' for use with `sawfish-interaction'."
+ (sawfish-mode)
+ (setq major-mode 'sawfish-interaction-mode
+ mode-name "sawfish interaction")
+ (use-local-map sawfish-interaction-mode-map))
+
+;;;###autoload
+(defun sawfish-interaction ()
+ "Create a sawfish interaction buffer."
+ (interactive)
+ (let ((new-buffer (not (get-buffer sawfish-scratch-buffer))))
+ (switch-to-buffer (get-buffer-create sawfish-scratch-buffer))
+ (when new-buffer
+ (insert ";; This buffer is for interacting with the sawfish window manager.\n\n")))
+ (sawfish-interaction-mode))
+
+;; Define the sawfish-mode keymap.
+(define-key sawfish-mode-map [(control x) (control e)] #'sawfish-eval-last-sexp)
+(define-key sawfish-mode-map [(meta control x)] #'sawfish-eval-defun)
+(define-key sawfish-mode-map [(meta :)] #'sawfish-eval-expression)
+(define-key sawfish-mode-map [(control c) (control h) ?a] #'sawfish-apropos)
+(define-key sawfish-mode-map [(control c) (control h) ?f] #'sawfish-describe-function)
+(define-key sawfish-mode-map [(control c) (control h) (control f)] #'sawfish-info-function)
+(define-key sawfish-mode-map [(control c) (control h) ?v] #'sawfish-describe-variable)
+(define-key sawfish-mode-map [(control c) (control h) (control v)] #'sawfish-info-variable)
+(define-key sawfish-mode-map [(meta tab)] #'sawfish-complete-symbol)
+(define-key sawfish-mode-map [(control c) (control h) ?i] #'sawfish-info)
+(define-key sawfish-mode-map [(control meta :)] #'eval-expression)
+
+;; Define the minibuffer keymap.
+(unless sawfish-read-expression-map
+ (setq sawfish-read-expression-map (make-sparse-keymap))
+ (set-keymap-parent sawfish-read-expression-map minibuffer-local-map)
+ (define-key sawfish-read-expression-map [(meta tab)] #'sawfish-complete-symbol))
+
+;; Define the sawfish-interaction keymap.
+(unless sawfish-interaction-mode-map
+ (setq sawfish-interaction-mode-map (make-sparse-keymap))
+ (set-keymap-parent sawfish-interaction-mode-map sawfish-mode-map)
+ (define-key sawfish-interaction-mode-map [(control j)] #'sawfish-eval-print-last-sexp))
+
+;; Further define the sawfish-console-mode keymap. It is initialised already
+;; because of define-derived-mode.
+(define-key sawfish-console-mode-map [(tab)] #'sawfish-complete-symbol)
+(define-key sawfish-console-mode-map [(control c) (control h) ?a] #'sawfish-apropos)
+(define-key sawfish-console-mode-map [(control c) (control h) ?f] #'sawfish-describe-function)
+(define-key sawfish-console-mode-map [(control c) (control h) (control f)] #'sawfish-info-function)
+(define-key sawfish-console-mode-map [(control c) (control h) ?v] #'sawfish-describe-variable)
+(define-key sawfish-console-mode-map [(control c) (control h) (control v)] #'sawfish-info-variable)
+
+;; Indentation hints for macros and functions provided by sawfish.el
+(put 'sawfish-code 'lisp-indent-function 0)
+
+;;; Menus
+
+;; GNU Emacs/XEmacs difference crap.
+(defun sawfish-region-active-p ()
+ "Is there an active region?"
+ (if (and (boundp 'running-xemacs) (symbol-value 'running-xemacs))
+ (funcall (symbol-function 'region-exists-p))
+ (symbol-value 'mark-active)))
+
+(easy-menu-define sawfish-mode-menu sawfish-mode-map "sawfish commands"
+ '("Sawfish"
+ ["Indent Line" lisp-indent-line t]
+ ["Indent Region" indent-region (sawfish-region-active-p)]
+ ["Comment Out Region" comment-region (sawfish-region-active-p)]
+ "----"
+ ["Evaluate Last S-expression" sawfish-eval-last-sexp t]
+ ["Evaluate Top Level Form" sawfish-eval-defun t]
+ ["Evaluate Region" sawfish-eval-region (sawfish-region-active-p)]
+ ["Evaluate Buffer" sawfish-eval-buffer t]
+ ["Evaluate Expression" sawfish-eval-expression t]
+ "----"
+ ["Describe Sawfish Variable" sawfish-describe-variable t]
+ ["Describe Sawfish Function" sawfish-describe-function t]
+ ["Info on Variable" sawfish-info-variable t]
+ ["Info on Function" sawfish-info-function t]
+ ["Apropos" sawfish-apropos t]
+ "----"
+ ["Open Sawfish Interaction Buffer" sawfish-interaction t]
+ ["Open Sawfish Console" sawfish-console t]
+ "----"
+ ["Read Sawfish Documentation" sawfish-info t]
+ ["Read librep Documentation" sawfish-rep-info t]))
+
+;; GNU emacs emacs-lisp menu removal kludge.
+
+(defvar sawfish-gnu-emacs-menu-kludged nil
+ "Check if we've kludged the menu in GNU emacs.")
+
+(unless (and (boundp 'running-xemacs) (symbol-value 'running-xemacs))
+ (unless sawfish-gnu-emacs-menu-kludged
+ (let ((old-emacs-lisp-mode-map (copy-keymap emacs-lisp-mode-map)))
+ ;; Remove the binding for the emacs-lisp menu.
+ (define-key emacs-lisp-mode-map [menu-bar emacs-lisp] 'undefinded)
+ ;; Initialise sawfish-mode.
+ (with-temp-buffer (sawfish-mode))
+ ;; Restore the emacs-lisp-mode keymap.
+ (setq emacs-lisp-mode-map (copy-keymap old-emacs-lisp-mode-map)))
+ (setq sawfish-gnu-emacs-menu-kludged t)))
+
+;; Helpful hints for info lookups (provided by Markus Holmberg).
+
+(eval-after-load "info-look"
+ '(info-lookup-maybe-add-help
+ :mode 'sawfish-mode
+ :regexp "[^()`',\" \t\n]+"
+ :doc-spec '(("(sawfish)Function Index" nil "^ - [^:]+: " "\\b")
+ ("(sawfish)Variable Index" nil "^ - [^:]+: " "\\b")
+ ("(librep)Function Index" nil "^ - [^:]+: " "\\b")
+ ("(librep)Variable Index" nil "^ - [^:]+: " "\\b"))))
+
+(provide 'sawfish)
+
+;;; sawfish.el ends here
diff --git a/debian/sawfish.emacsen-install b/debian/sawfish.emacsen-install
new file mode 100644
index 0000000..d8d7553
--- /dev/null
+++ b/debian/sawfish.emacsen-install
@@ -0,0 +1,41 @@
+#! /bin/sh -e
+# /usr/lib/emacsen-common/packages/install/sawfish
+
+FLAVOR=$1
+PACKAGE=sawfish
+
+if [ ${FLAVOR} = emacs ]; then exit 0; fi
+
+echo install/${PACKAGE}: Handling install for emacsen flavor ${FLAVOR}
+
+FLAVORTEST=`echo $FLAVOR | cut -c-6`
+if [ ${FLAVORTEST} = xemacs ] ; then
+ SITEFLAG="-no-site-file"
+else
+ SITEFLAG="--no-site-file"
+fi
+FLAGS="${SITEFLAG} -q -batch -l path.el -f batch-byte-compile"
+
+ELDIR=/usr/share/emacs/site-lisp/${PACKAGE}
+ELCDIR=/usr/share/${FLAVOR}/site-lisp/${PACKAGE}
+
+# Install-info-altdir does not actually exist.
+# Maybe somebody will write it.
+if test -x /usr/sbin/install-info-altdir; then
+ echo install/${PACKAGE}: install Info links for ${FLAVOR}
+ install-info-altdir --quiet --section "" "" --dirname=${FLAVOR} /usr/info/${PACKAGE}.info.gz
+fi
+
+install -m 755 -d ${ELCDIR}
+cd ${ELDIR}
+FILES=`echo *.el`
+cp ${FILES} ${ELCDIR}
+cd ${ELCDIR}
+
+cat << EOF > path.el
+(setq load-path (cons "." load-path) byte-compile-warnings nil)
+EOF
+${FLAVOR} ${FLAGS} ${FILES}
+rm -f *.el path.el
+
+exit 0
diff --git a/debian/sawfish.emacsen-remove b/debian/sawfish.emacsen-remove
new file mode 100644
index 0000000..4cd4e32
--- /dev/null
+++ b/debian/sawfish.emacsen-remove
@@ -0,0 +1,15 @@
+#!/bin/sh -e
+# /usr/lib/emacsen-common/packages/remove/sawfish
+
+FLAVOR=$1
+PACKAGE=sawfish
+
+if [ ${FLAVOR} != emacs ]; then
+ if test -x /usr/sbin/install-info-altdir; then
+ echo remove/${PACKAGE}: removing Info links for ${FLAVOR}
+ install-info-altdir --quiet --remove --dirname=${FLAVOR} /usr/info/a2ps.info.gz
+ fi
+
+ echo remove/${PACKAGE}: purging byte-compiled files for ${FLAVOR}
+ rm -rf /usr/share/${FLAVOR}/site-lisp/${PACKAGE}
+fi
diff --git a/debian/sawfish.emacsen-startup b/debian/sawfish.emacsen-startup
new file mode 100644
index 0000000..6431b7c
--- /dev/null
+++ b/debian/sawfish.emacsen-startup
@@ -0,0 +1,11 @@
+;; -*-emacs-lisp-*-
+
+(setq load-path (cons (concat "/usr/share/"
+ (symbol-name flavor)
+ "/site-lisp/sawfish") load-path))
+
+(autoload 'sawfish-mode "sawfish" "sawfish-mode" t)
+
+(setq auto-mode-alist (cons '("\\.sawfishrc$" . sawfish-mode) auto-mode-alist)
+auto-mode-alist (cons '("\\.jl$" . sawfish-mode) auto-mode-alist)
+auto-mode-alist (cons '("\\.sawfish/rc$" . sawfish-mode) auto-mode-alist))
diff --git a/debian/sawfish.install b/debian/sawfish.install
new file mode 100644
index 0000000..78d9f5b
--- /dev/null
+++ b/debian/sawfish.install
@@ -0,0 +1,9 @@
+debian/sawfish.el usr/share/emacs/site-lisp/sawfish
+usr/share/applications/sawfish.desktop
+usr/share/gnome/wm-properties/sawfish-wm.desktop
+usr/share/apps/ksmserver/windowmanagers/sawfish.desktop
+usr/share/sawfish/sawfish.png
+usr/share/xsessions/sawfish.desktop
+usr/share/sawfish/*/lisp/sawfish/cfg/main.jlc
+usr/lib
+usr/bin
diff --git a/debian/sawfish.links b/debian/sawfish.links
new file mode 100644
index 0000000..6090aa2
--- /dev/null
+++ b/debian/sawfish.links
@@ -0,0 +1 @@
+usr/share/doc/sawfish-data usr/share/doc/sawfish
diff --git a/debian/watch b/debian/watch
new file mode 100644
index 0000000..2b423fa
--- /dev/null
+++ b/debian/watch
@@ -0,0 +1,3 @@
+version=3
+
+http://sf.net/sawmill/sawfish-([\d.]+)\.tar\.(?::gz|bz2) debian
diff --git a/src/display.c b/src/display.c
index cbc509a..e21f35d 100644
--- a/src/display.c
+++ b/src/display.c
@@ -82,9 +82,23 @@ error_handler (Display *dpy, XErrorEvent *ev)
if (w != NULL)
{
DB(("error_handler (%s)\n", rep_STR(w->name)));
-
+
if (!WINDOW_IS_GONE_P (w))
- remove_window (w, TRUE, TRUE);
+ {
+ /* don't unmap a window that had send an X_ConfigureWindow request */
+ if(
+ /* ev->type == 0 what is the "type" ? but I've seen that type is always 0 */
+ /*&&*/ ev->error_code==BadWindow /* the window is bad, because it is not configured yet */
+ && ev->request_code==X_ConfigureWindow
+ && ev->minor_code==0 /* X_ConfigureWindow is not in an Xlib extension, so it must be 0 */
+ )
+ {
+ return 0;
+ } else
+ {
+ remove_window (w, TRUE, TRUE);
+ }
+ }
/* so we call emit_pending_destroys () at some point */
rep_mark_input_pending (ConnectionNumber (dpy));
@@ -442,7 +456,7 @@ void
send_client_message (Window w, Atom a, Time time)
{
XClientMessageEvent ev;
-
+
ev.type = ClientMessage;
ev.window = w;
ev.message_type = xa_wm_protocols;
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
