January 2005 - XEmacs-Patches - XEmacs Mailing List Archives

[21.5R21.4] Add 3rd arg to make-obsolete(-variable) 19 years, 3 months

Ville Skyttä

21.5 RECOMMEND 21.4 This patch syncs the API of make-obsolete(-variable) with GNU Emacs. The result is one annoyance less later when syncing other stuff. Will commit soon unless there are objections. Applies also to 21.4, with a 1-line offset in lisp/bytecomp-runtime.el.

2 participants
2 comments

[C] xemacs-21.5: Correct docstring of start-process-shell-command 19 years, 3 months

Adrian Aichner

COMMIT Ben, Mike, could you please look this over and confirm that fixing the docstring was the right thing to do. Best regards, Adrian xemacs-21.5 ChangeLog patch: Diff command: cvs -q diff -U 0 Files affected: lisp/ChangeLog Index: lisp/ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v retrieving revision 1.605 diff -u -U0 -r1.605 ChangeLog --- lisp/ChangeLog 3 Jan 2005 10:29:11 -0000 1.605 +++ lisp/ChangeLog 9 Jan 2005 09:43:45 -0000 ＠＠ -0,0 +1,4 ＠＠ +2005-01-09 Adrian Aichner <adrian(a)xemacs.org> + + * process.el (start-process-shell-command): Correct docstring. + xemacs-21.5 source patch: Diff command: cvs -f -z3 -q diff -u -w -N Files affected: lisp/process.el Index: lisp/process.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/process.el,v retrieving revision 1.18 diff -u -w -r1.18 process.el --- lisp/process.el 5 Jan 2003 18:38:37 -0000 1.18 +++ lisp/process.el 9 Jan 2005 09:32:25 -0000 ＠＠ -66,8 +66,9 ＠＠ Process output goes at end of that buffer, unless you specify an output stream or filter function to handle the output. BUFFER may be also nil, meaning that this process is not associated - with any buffer -Third arg is command name, the name of a shell command. + with any buffer. +Variables `shell-file-name' and `shell-command-switch' are used to +start the process. Remaining arguments are the arguments for the command. Wildcards and redirection are handled as usual in the shell." ;; We used to use `exec' to replace the shell with the command, -- Adrian Aichner mailto:adrian＠xemacs.org http://www.xemacs.org/

1 participants
0 comments

[C] xemacsweb: URL typo fix for Download/optLibs.content 19 years, 3 months

Adrian Aichner

COMMIT Thanks for the many link updates, Ben! Adrian xemacsweb ChangeLog patch: Diff command: cvs -q diff -U 0 Files affected: Download/ChangeLog Index: Download/ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacsweb/Download/ChangeLog,v retrieving revision 1.152 diff -u -U0 -r1.152 ChangeLog --- Download/ChangeLog 29 Dec 2004 04:53:47 -0000 1.152 +++ Download/ChangeLog 8 Jan 2005 18:58:04 -0000 ＠＠ -0,0 +1,4 ＠＠ +2005-01-08 Adrian Aichner <adrian(a)xemacs.org> + + * optLibs.content: URL typo fix. + xemacsweb source patch: Diff command: cvs -f -z3 -q diff -u -w -N Files affected: Download/optLibs.content Index: Download/optLibs.content =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacsweb/Download/optLibs.content,v retrieving revision 1.31 diff -u -w -r1.31 optLibs.content --- Download/optLibs.content 29 Dec 2004 04:53:47 -0000 1.31 +++ Download/optLibs.content 8 Jan 2005 18:57:41 -0000 ＠＠ -299,7 +299,7 ＠＠ CVS is the version control system used by XEmacs to manage the sources. <a href="http://ftp.xemacs.org/pub/xemacs/aux/cvs-1.11.18.tar.gz">cvs-1.11.1... /> - <a href="https:/www.cvshome.org/">https:/www.cvshome.org/</a> + <a href="https://www.cvshome.org/">https://www.cvshome.org/</a> bzip2 is a compressor that compresses much better than gzip. -- Adrian Aichner mailto:adrian＠xemacs.org http://www.xemacs.org/

1 participants
0 comments

[PATCH] xemacsweb: URL typo fix for Download/optLibs.content 19 years, 3 months

Adrian Aichner

Thanks for the many link updates, Ben! Adrian xemacsweb ChangeLog patch: Diff command: cvs -q diff -U 0 Files affected: Download/ChangeLog Index: Download/ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacsweb/Download/ChangeLog,v retrieving revision 1.152 diff -u -U0 -r1.152 ChangeLog --- Download/ChangeLog 29 Dec 2004 04:53:47 -0000 1.152 +++ Download/ChangeLog 8 Jan 2005 18:58:04 -0000 ＠＠ -0,0 +1,4 ＠＠ +2005-01-08 Adrian Aichner <adrian(a)xemacs.org> + + * optLibs.content: URL typo fix. + xemacsweb source patch: Diff command: cvs -f -z3 -q diff -u -w -N Files affected: Download/optLibs.content Index: Download/optLibs.content =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacsweb/Download/optLibs.content,v retrieving revision 1.31 diff -u -w -r1.31 optLibs.content --- Download/optLibs.content 29 Dec 2004 04:53:47 -0000 1.31 +++ Download/optLibs.content 8 Jan 2005 18:57:41 -0000 ＠＠ -299,7 +299,7 ＠＠ CVS is the version control system used by XEmacs to manage the sources. <a href="http://ftp.xemacs.org/pub/xemacs/aux/cvs-1.11.18.tar.gz">cvs-1.11.1... /> - <a href="https:/www.cvshome.org/">https:/www.cvshome.org/</a> + <a href="https://www.cvshome.org/">https://www.cvshome.org/</a> bzip2 is a compressor that compresses much better than gzip. -- Adrian Aichner mailto:adrian＠xemacs.org http://www.xemacs.org/

1 participants
0 comments

[AS] [C] xemacsweb: Fix spelling of LINKLINT_IGNORESET 19 years, 3 months

Adrian Aichner

APPROVE SUPERSEDES <87pt0sb275.fsf(a)tleepslib.sk.tsukuba.ac.jp> COMMIT Happy New Year, All! Thanks for noticing this typo, Stephen! This superseding patch also takes care of Makefile, which contains the same typo just to prove my thoroughness :-) I'll also update Local.rules on the three master websites now. Best regards, Adrian xemacsweb ChangeLog patch: Diff command: cvs -q diff -U 0 Files affected: ChangeLog Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacsweb/ChangeLog,v retrieving revision 1.220 diff -u -U0 -r1.220 ChangeLog --- ChangeLog 18 Dec 2004 01:02:24 -0000 1.220 +++ ChangeLog 8 Jan 2005 17:47:21 -0000 ＠＠ -0,0 +1,8 ＠＠ +2005-01-08 Adrian Aichner <adrian(a)xemacs.org> + + * Makefile (linklint): Fix typo in LINKLINT_IGNORESET. + +2004-12-30 Stephen J. Turnbull <stephen(a)xemacs.org> + + * Local.rules.template (LINKLINT_IGNORESET): Fix typo. + xemacsweb source patch: Diff command: cvs -f -z3 -q diff -u -w -N Files affected: Makefile Local.rules.template Index: Local.rules.template =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacsweb/Local.rules.template,v retrieving revision 1.4 diff -u -w -r1.4 Local.rules.template --- Local.rules.template 5 Dec 2004 10:21:44 -0000 1.4 +++ Local.rules.template 8 Jan 2005 17:46:32 -0000 ＠＠ -20,7 +20,7 ＠＠ # LINKLINT_CASE=-case # APA: Ignore checking of links into the XEmacs CVS repository via ViewCVS. # These checks are expensive and links are correct by design. -LINKLINT_INGORESET=-ignore http://cvs.xemacs.org/viewcvs.cgi/XEmacs/＠ +LINKLINT_IGNORESET=-ignore http://cvs.xemacs.org/viewcvs.cgi/XEmacs/＠ GENPAGE_CONF="genpage.conf" Index: Makefile =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacsweb/Makefile,v retrieving revision 1.50 diff -u -w -r1.50 Makefile --- Makefile 16 Dec 2004 22:45:03 -0000 1.50 +++ Makefile 8 Jan 2005 17:46:32 -0000 ＠＠ -44,7 +44,7 ＠＠ # and not hidden by index.html, which does not reference url*.html # files. linklint: FORCE - $(LINKLINT) $(LINKLINT_CASE) -docbase http://www.xemacs.org -net -limit 0 -db3 /＠ -doc $(LINKLINT_OUTDIR) $(LINKLINT_INGORESET) -output_index site -timeout 30 + $(LINKLINT) $(LINKLINT_CASE) -docbase http://www.xemacs.org -net -limit 0 -db3 /＠ -doc $(LINKLINT_OUTDIR) $(LINKLINT_IGNORESET) -output_index site -timeout 30 # APA: To be run after initial checkout of module. # Create directory for commit logs. -- Adrian Aichner mailto:adrian＠xemacs.org http://www.xemacs.org/

1 participants
0 comments

RE: Re: [COMMIT] "Son of a bitch." 19 years, 3 months

Ben Wing

hmm ... i remember now that the place where this text occurs was different; but somewhere in 21.4 you definitely have a line (insert-file-contents file nil 1 3001) which should read (insert-file-contents file nil 0 3000) ------- Original Message ------- On Thu, 06 Jan 2005 22:16:13 -0500 Vin Shelton wrote:Ben Wing <ben(a)xemacs.org> writes: > NOTE: This patch has been committed. > > That's what you say when you discover a bug like this. > > Definitely goes in 21.4. > > lisp/ChangeLog addition: > > 2004-12-11 Ben Wing <ben(a)xemacs.org> > > * files.el (find-coding-system-magic-cookie-in-file): > File positions are 0 based not 1 based. > > > build source patch: > Diff command: bash -ci "cvs-diff --show-c-function -no-changelog " > Files affected: lisp/files.el > > > Index: lisp/files.el > =================================================================== > RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/files.el,v > retrieving revision 1.70 > diff -u -p -r1.70 files.el > --- lisp/files.el 2004/06/06 23:58:44 1.70 > +++ lisp/files.el 2004/12/12 02:44:25 > ＠＠ -2107,7 +2107,7 ＠＠ ISO 2022 encoding of most non-ASCII char > (save-excursion > (with-temp-buffer > (let ((coding-system-for-read 'raw-text)) > - (insert-file-contents file nil 1 3001)) > + (insert-file-contents file nil 0 3000)) > (goto-char (point-min)) > (or (and (looking-at > "^[^\n]*-\\*-[^\n]*coding: \$[^ \t\n;]+\$[^\n]*-\\*-") Ben, This patch doesn't apply (at all) to 21.4. Can you please investigate to see whether or not it's necessary? Thanks, Vin

2 participants
1 comments

[COMMIT] "Son of a bitch." 19 years, 3 months

Ben Wing

NOTE: This patch has been committed. That's what you say when you discover a bug like this. Definitely goes in 21.4. lisp/ChangeLog addition: 2004-12-11 Ben Wing <ben(a)xemacs.org> * files.el (find-coding-system-magic-cookie-in-file): File positions are 0 based not 1 based. build source patch: Diff command: bash -ci "cvs-diff --show-c-function -no-changelog " Files affected: lisp/files.el Index: lisp/files.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/files.el,v retrieving revision 1.70 diff -u -p -r1.70 files.el --- lisp/files.el 2004/06/06 23:58:44 1.70 +++ lisp/files.el 2004/12/12 02:44:25 ＠＠ -2107,7 +2107,7 ＠＠ ISO 2022 encoding of most non-ASCII char (save-excursion (with-temp-buffer (let ((coding-system-for-read 'raw-text)) - (insert-file-contents file nil 1 3001)) + (insert-file-contents file nil 0 3000)) (goto-char (point-min)) (or (and (looking-at "^[^\n]*-\\*-[^\n]*coding: \$[^ \t\n;]+\$[^\n]*-\\*-")

2 participants
1 comments

[PATCH] DRAFT autoconf 2.59 support. 19 years, 3 months

Malcolm Purvis

AKA What I did on my Holidays. This is a rewrite of configure.in (now called configure.ac) to work with autoconf 2.59. It isn't ready for prime-time but is feature complete and I'm interested in how it behaves in configurations other than mine. Configure.in has been rebuilt from the ground up and tries to follow the 2.59 conventions wherever possible. I did, however, use the SuSe patch as one starting point so thanks a lot to the SuSe guys! Note: This patch requires config.sub and config.guess from automake 1.9. I have not included them to save space but please copy them over before running the new configure. The most significant change is with the command line arguments. The only custom command line arguments allowed in 2.59 are --with-X for using external packages and --enable-X for compiling in optional internal features. I have renamed the options to conform to this pattern. This results in changes such as --with-mule now being --enable-mule. The full translation of command line arguments are: Old | New ------------------------------------------ General options: ---------------- --help Unchanged --verbose Unchanged --extra-verbose Removed Compilation options: -------------------- --compiler --with-compiler --xemacs-compiler --with-xemacs-compiler --with-gcc Unchanged --cflags --with-cflags --cflags-warning --with-cflags-warning --cpp --with-cpp --cppflags --with-cppflags --libs --with-libs --ldflags --with-ldflags --site-includes --with-site-includes --site-libraries --with-site-libraries --site-prefixes --with-site-prefixes --site-runtime-libraries --with-site-runtime-libraries --dynamic --with-dynamic --srcdir Unchanged Installation options: --------------------- --prefix Unchanged --with-prefix Unchanged --with-netinstall Unchanged --bindir Unchanged --datadir Unchanged --statedir Unchanged --libdir Unchanged --infodir Unchanged --mandir Unchanged --lispdir --with-lispdir --sitelispdir Removed --etcdir --with-etcdir --lockdir Removed --archlibdir --with-archlibdir --docdir --with-docdir --moduledir --with-moduledir Run-time path-searching options: -------------------------------- --with-site-lisp Unchanged --with-site-modules Unchanged --package-prefix --with-package-prefix --package-path --with-package-path --infopath --with-infopath Window-system options: ---------------------- --with-gtk Unchanged --with-gnome Unchanged --with-x11 Unchanged --x-includes Unchanged --x-libraries Unchanged --with-msw Unchanged --with-toolbars --enable-toolbars --with-wmcommand Unchanged --with-athena Unchanged --with-menubars --enable-menubars --with-scrollbars --enable-scrollbars --with-dialogs --enable-dialogs --with-widgets --enable-widgets --with-dragndrop Unchanged --with-cde Unchanged --with-offix Unchanged --with-xmu Unchanged --external-widget --enable-external-widget TTY (character terminal) options: --------------------------------- --with-tty Unchanged --with-ncurses Unchanged --with-gpm Unchanged Image options: -------------- --with-xpm Unchanged --with-png Unchanged --with-jpeg Unchanged --with-tiff Unchanged --with-xface Unchanged --with-gif Unchanged Sound options: -------------- --with-sound --enable-sound --native-sound-lib=LIB --with-native-sound-lib Internationalization options: ----------------------------- --with-mule --enable-mule --with-xim Unchanged --with-canna Unchanged --with-wnn Unchanged --with-wnn6 Unchanged --with-xfs Unchanged File-related options: --------------------- --with-default-eol-detection --enable-default-eol-detection --with-clash-detection --enable-clash-detection Database options: ----------------- --with-database --enable-database --with-ldap Unchanged --with-postgresql Unchanged Mail options: ------------- --mail-locking=TYPE --with-mail-locking --with-pop Unchanged --with-kerberos Unchanged --with-hesiod Unchanged Networking options: ------------------- --with-tooltalk Unchanged --with-socks Unchanged --with-dnet Unchanged --with-ipv6-cname Unchanged Memory allocation options: -------------------------- --rel-alloc --with-rel-alloc --with-dlmalloc Unchanged --with-system-malloc Unchanged --with-debug-malloc Unchanged Emacs Lisp options: ------------------- --use-number-lib --enable-bignum Debugging options: ------------------ --debug --enable-debug --error-checking --enable-error-checking --memory-usage-stats --enable-memory-usage-stats --quick-build --enable-quick-build --use-union-type --enable-union-type --with-quantify Unchanged --with-purify Unchanged Developer options: ------------------ --with-workshop Unchanged --pdump --enable-pdump --use-kkcc --enable-kkcc --with-modules --enable-modules The output files produced by this new configure should be almost identical to those produced by the old. This can be tested with the attached regression test script. This script runs the two versions of configure with the supplied list of command line arguments and reports any differences. Please add your favorite configuration command lines to the list before running the test. The script is run as: $ regressiontest.pl /absolute/path/to/2.13/configure \ /absolute/path/to/2.59/configure >diffs.txt The only differences should be: - those related to changes in the command line arguments - the change of SYS_SIGLIST_DECLARED to HAVE_DECL_SYS_SIGLIST (because the old form has been removed), and - The removal of trailing comments in src/config.h. Applying the attached patch config-h-213.patch to the 2.13 work area will remove these. This patch makes no functional changes to the configuration and will cut the size of diffs.txt by about 60%. At this stage please review this patch for the accuracy of the generated configuration files and the command line arguments. I shall improve the documentation and formatting before posting the final patch. Thanks, Malcolm ChangeLog addition: 2005-01-04 Malcolm Purvis <malcolmp(a)xemacs.org> * aclocal.m4: Changes to support autoconf 2.59 * config.guess: * config.sub: Upgraded to the version in from automake 1.9 * configure.ac: Rewritten for autoconf 2.59 support. lib-src/ChangeLog addition: 2005-01-04 Malcolm Purvis <malcolmp(a)xemacs.org> * config.values.sh (FileContents): Different regex for autoconf 2.59. src/ChangeLog addition: 2005-01-04 Malcolm Purvis <malcolmp(a)xemacs.org> * config.h.in: Remove trailing comments, which autoconf 2.59 does not like. Use autoconf 2.59's HAVE_DECL_SYS_SIGLIST instead of SYS_SIGLIST_DECLARED. * syssignal.h: Use autoconf 2.59's HAVE_DECL_SYS_SIGLIST instead of SYS_SIGLIST_DECLARED. xemacs-autoconf-2.5 source patch: Diff command: cvs -q diff -u Files affected: src/syssignal.h src/config.h.in lib-src/config.values.sh lib-src/config.values.in version.sh configure.ac configure config.sub config.guess aclocal.m4 Index: aclocal.m4 =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/aclocal.m4,v retrieving revision 1.11 diff -u -r1.11 aclocal.m4 --- aclocal.m4 2004/05/14 15:35:29 1.11 +++ aclocal.m4 2005/01/04 00:05:40 ＠＠ -39,8 +39,8 ＠＠ dll_post= dll_ldo="-o" ld_dynamic_link_flags= -xehost=$canonical -xealias=$internal_configuration +xehost=$ac_cv_build +xealias=$ac_cv_build_alias AC_CHECKING([how to build dynamic libraries for ${xehost}]) # Transform *-*-linux* to *-*-linux-gnu*, to support old configure scripts. ＠＠ -49,11 +49,9 ＠＠ *-*-linux*) xehost=`echo $xehost | sed 's/^$.*-.*-linux$$.*$$/\1-gnu\2/'` esac -changequote(<<, >>)dnl -xehost_cpu=`echo $xehost | sed 's/^$[^-]*$-$[^-]*$-$.*$$/\1/'` -xehost_vendor=`echo $xehost | sed 's/^$[^-]*$-$[^-]*$-$.*$$/\2/'` -xehost_os=`echo $xehost | sed 's/^$[^-]*$-$[^-]*$-$.*$$/\3/'` -changequote([, ])dnl +xehost_cpu=`echo $xehost | sed 's/^$[[^-]]*$-$[[^-]]*$-$.*$$/\1/'` +xehost_vendor=`echo $xehost | sed 's/^$[[^-]]*$-$[[^-]]*$-$.*$$/\2/'` +xehost_os=`echo $xehost | sed 's/^$[[^-]]*$-$[[^-]]*$-$.*$$/\3/'` case "$xehost_os" in aix3*) ＠＠ -71,7 +69,7 ＠＠ if test "$GCC" = "yes"; then XEGCC=yes else - AC_MSG_CHECKING(checking whether we are using GNU C) + AC_MSG_CHECKING([whether we are using GNU C]) AC_EGREP_CPP(yes,[ #ifdef __GNUC__ yes; ＠＠ -80,7 +78,7 ＠＠ AC_MSG_RESULT([${XEGCC}]) fi -AC_MSG_CHECKING(how to produce PIC code) +AC_MSG_CHECKING([how to produce PIC code]) wl= can_build_shared=yes ＠＠ -245,7 +243,7 ＠＠ cc_produces_so=no xldf= xcldf= -AC_MSG_CHECKING(if C compiler can produce shared libraries) +AC_MSG_CHECKING([if C compiler can produce shared libraries]) if test "$XEGCC" = yes -o "$__ICC" = yes; then case "$xehost_os" in *darwin*) ＠＠ -318,7 +316,7 ＠＠ ac_prog=ld if test "$XEGCC" = yes; then # Check if gcc -print-prog-name=ld gives a path. - AC_MSG_CHECKING(for ld used by GCC) + AC_MSG_CHECKING([for ld used by GCC]) ac_prog=`($CC -print-prog-name=ld) 2>&5` case "$ac_prog" in # Accept absolute paths. ＠＠ -343,7 +341,7 ＠＠ ;; esac else - AC_MSG_CHECKING(for GNU ld) + AC_MSG_CHECKING([for GNU ld]) fi if test -z "$LTLD"; then ＠＠ -383,7 +381,7 ＠＠ ld_dynamic_link_flags= # Check to see if it really is or isn't GNU ld. -AC_MSG_CHECKING(if the linker is GNU ld) +AC_MSG_CHECKING([if the linker is GNU ld]) # I'd rather use --version here, but apparently some GNU ld's only accept -v. if $LTLD -v 2>&1 </dev/null | egrep '(GNU|with BFD)' 1>&5; then xe_gnu_ld=yes ＠＠ -418,7 +416,7 ＠＠ else # OK - only NOW do we futz about with ld. # See if the linker supports building shared libraries. - AC_MSG_CHECKING(whether the linker supports shared libraries) + AC_MSG_CHECKING([whether the linker supports shared libraries]) dll_ld=$CC dll_ldflags=$LDFLAGS ld_shlibs=yes Index: configure.ac =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/configure.ac,v retrieving revision 1.1 diff -u -r1.1 configure.ac --- configure.ac 2001/09/25 10:20:11 1.1 +++ configure.ac 2005/01/04 00:07:16 ＠＠ -1,6 +1,5636 ＠＠ -AC_FATAL([ +dnl XEmacs config script for autoconf 2.5. +dnl ------------------------------------------------------------------------- +dnl Overrides of standard autoconf macros. -#### Autoconf 2.5x is not yet supported by XEmacs. -#### Our configure script is known *not* to work with these versions of -#### Autoconf. Please continue using Autoconf 2.13 for now. +# AC_LANG(C) +# ---------- +# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. +m4_define([AC_LANG(C)], +[ac_ext=c +xe_cppflags='$CPPFLAGS $c_switch_site $c_switch_machine $c_switch_system $c_switch_x_site $X_CFLAGS' +xe_ldflags='$LDFLAGS $ld_switch_site $ld_switch_machine $ld_switch_system $ld_switch_x_site $ld_switch_run' +xe_libs='$ld_call_shared $xe_check_libs $X_EXTRA_LIBS $libs_x $libs_gtk $X_PRE_LIBS $LIBS $libs_machine $libs_system $libs_standard' +ac_cpp='$CPP '"$xe_cppflags" +ac_compile='$CC -c $CFLAGS'"$xe_cppflags"' conftest.$ac_ext >&AS_MESSAGE_LOG_FD' +ac_link='$CC -o conftest$ac_exeext $CFLAGS '"$xe_cppflags $xe_ldflags"' conftest.$ac_ext '"$xe_libs"' >&AS_MESSAGE_LOG_FD' +ac_compiler_gnu=$ac_cv_c_compiler_gnu ]) + +dnl ------------------------------------------------------------------------- +dnl Autoconf startup. + +AC_PREREQ(2.59)dnl +AC_INIT(src/lisp.h)dnl + +dnl ------------------------------------------------------------------------- +dnl Local copyright notices. + +AC_COPYRIGHT( +[#### Configuration script for XEmacs. Largely divergent from FSF. +#### Guess values for system-dependent variables and create Makefiles. +#### Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc. +#### Copyright (C) 1993-1995 Board of Trustees, University of Illinois. +#### Copyright (C) 1996, 1997 Sun Microsystems, Inc. +#### Copyright (C) 1995, 1996, 2002, 2003, 2004 Ben Wing. +#### Copyright (C) 2000, 2001 Martin Buchholz. +#### Copyright (C) 1998, 1999 J. Kean Johnston. +#### Copyright (C) 2005 Malcolm Purvis + +### Don't edit this script! +### This script was automatically generated by the `autoconf' program +### from the file `./configure.in'. +### To rebuild it, execute the command +### autoconf +### in the this directory. You must have autoconf version 2.13 or later. +### Note: this script has not yet been ported to autoconf version 2.5x. + +### This file is part of XEmacs. + +### XEmacs 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. + +### XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free +### Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +### 02111-1307, USA. + +### For usage, run `./configure --help' +### For more detailed information on building and installing XEmacs, +### read the file `INSTALL'. +### +### If configure succeeds, it leaves its status in config.status. +### A log of configuration tests can be found in config.log. +### If configure fails after disturbing the status quo, +### config.status is removed. +]) + +dnl ------------------------------------------------------------------------- +dnl Local macros + +define([USAGE_ERROR], +[(echo "$progname: Usage error:" +echo " " $1 +echo " Use \`$progname --help' to show usage.") >&2 && exit 1]) + +dnl PRINT_VAR(var var ...) prints values of shell variables +define([PRINT_VAR],[for var in patsubst([$1],[[ +]+],[ ]); do eval "echo \"$var = '\$$var'\""; done]) + +dnl XE_ADD_OBJS(foo.o ...) +define([XE_ADD_OBJS], +[extra_objs="$extra_objs [$1]" && dnl + if test "$extra_verbose" = "yes"; then + echo " xemacs will be linked with \"[$1]\"" + fi])dnl XE_ADD_OBJS + +dnl XE_APPEND(value, varname) +define([XE_APPEND], +[[$2]="$[$2] [$1]" && dnl + if test "$extra_verbose" = "yes"; then echo " Appending \"[$1]\" to \$[$2]"; fi]) + +dnl XE_PREPEND(value, varname) +define([XE_PREPEND], +[[$2]="[$1] $[$2]" && dnl + if test "$extra_verbose" = "yes"; then echo " Prepending \"[$1]\" to \$[$2]"; fi]) + +dnl XE_DIE(message) +define([XE_DIE], [{ echo "Error:" $1 >&2; exit 1; }]) + +dnl XE_CHECK_FEATURE_DEPENDENCY(feature1, feature2) +define([XE_CHECK_FEATURE_DEPENDENCY], +[if test "$with_$1 $with_$2" = "yes no"; then + USAGE_ERROR("--with-$1 requires --with-$2") +elif test "$with_$2" = "no" ; then with_$1=no +elif test "$with_$1" = "yes"; then with_$2=yes +fi +]) + +dnl XE_STRIP_4TH_COMPONENT(var) +dnl Changes i986-pc-linux-gnu to i986-pc-linux, as God (not RMS) intended. +define([XE_STRIP_4TH_COMPONENT], +[$1=`echo "$$1" | sed '[s/^$[^-][^-]*-[^-][^-]*-[^-][^-]*$-.*$/\1/]'`]) + +dnl Do our best to deal with automounter brokenness +dnl CANONICALIZE_PATH(varname) +define([CANONICALIZE_PATH], +[if test -d "/net"; then + if test -d "/tmp_mnt/net"; then tdir="tmp_mnt/net"; else tdir="tmp_mnt"; fi + $1=`echo "[$]$1" | \ + sed -e "s|^${tdir}/|/net/|" -e "s|^/a/|/net/|" -e "s|^/amd/|/net/|"` +fi])dnl + +dnl XE_PROTECT_LINKER_FLAGS(shell_var) +define([XE_PROTECT_LINKER_FLAGS], [ +if test "$GCC" = "yes"; then + set x $[$1]; shift; [$1]="" + while test -n "[$]1"; do + case [$]1 in + -L | -l | -u ) [$1]="$[$1] [$]1 [$]2"; shift ;; + -L* | -l* | -u* | -Wl* | -pg ) [$1]="$[$1] [$]1" ;; + -Xlinker* ) ;; + * ) [$1]="$[$1] -Xlinker [$]1" ;; + esac + shift + done +fi])dnl + +dnl Allow use of either ":" or spaces for lists of directories +define(COLON_TO_SPACE, + [case "$[$1]" in *:* [)] [$1]="`echo '' $[$1] | sed -e 's/^ //' -e 's/:/ /g'`";; esac])dnl + +dnl XE_ADD_RUNPATH_DIR(directory) +define([XE_ADD_RUNPATH_DIR],[{ +xe_runpath_dir=$1 +dnl PRINT_VAR(ld_switch_site ld_switch_x_site runpath xe_runpath_dir LD_RUN_PATH xe_ldflags) + test "$xe_runpath_dir" != "/lib" -a \ + "$xe_runpath_dir" != "/usr/lib" -a \ + -n "`ls ${xe_runpath_dir}/*.s[[ol]] 2>/dev/null`" && \ + eval "$xe_add_unique_runpath_dir" +}])dnl + +dnl XE_COMPUTE_RUNPATH() +define([XE_COMPUTE_RUNPATH],[ +if test "$add_runtime_path" = "yes" -a -n "$dash_r"; then + dnl Remove runtime paths from current ld switches + ld_switch_site=`echo '' $ld_switch_site | sed -e 's:^ ::' -e "s/$dash_r[[^ ]]*//g"` + ld_switch_x_site=`echo '' $ld_switch_x_site | sed -e 's:^ ::' -e "s/$dash_r[[^ ]]*//g"` + dnl PRINT_VAR(ld_switch_site ld_switch_x_site) + + dnl Fix up Runtime path + dnl If LD_RUN_PATH is set in environment, use that. + dnl In this case, assume user has set the right value. + runpath="" runpath_dirs="" + if test -n "$LD_RUN_PATH"; then + runpath="$LD_RUN_PATH" + elif test "$GCC" = "yes"; then + dnl Compute runpath from gcc's -v output + ld_switch_run_save="$ld_switch_run"; ld_switch_run="" + echo "int main(int argc, char *argv[[]]) {return 0;}" > conftest.c + xe_runpath_link='${CC-cc} -o conftest -v $CFLAGS '"$xe_ldflags"' conftest.$ac_ext 2>&1 1>/dev/null' + for arg in `eval "$xe_runpath_link" | grep ' -L'`; do + case "$arg" in P,* | -L* | -R* ) + for dir in `echo '' "$arg" | sed -e 's:^ ::' -e 's/^..//' -e 'y/:/ /'`; do + XE_ADD_RUNPATH_DIR("$dir") + done ;; + esac + done + ld_switch_run="$ld_switch_run_save" + rm -f conftest* + else + dnl Add all directories with .so files to runpath + for arg in $ld_switch_site $ld_switch_x_site; do + case "$arg" in -L*) XE_ADD_RUNPATH_DIR(`echo '' "$arg" | sed -e 's:^ ::' -e 's/^-L//'`);; esac + done + dnl Sometimes /opt/SUNWdt/lib is the only installed Motif available + if test "$opsys $need_motif" = "sol2 yes"; then + xe_runpath_dir="/opt/SUNWdt/lib"; + eval "$xe_add_unique_runpath_dir"; + fi + fi dnl Compute $runpath + + if test -n "$runpath"; then + ld_switch_run="${dash_r}${runpath}" + XE_PROTECT_LINKER_FLAGS(ld_switch_run) + test "$extra_verbose" = "yes" && echo "Setting runpath to $runpath" + fi +fi +])dnl + +dnl The construct foo=`echo $w1 $w2 $w3` fails on some systems if $w1 = -e or -n +dnl So we use the following instead. +dnl XE_SPACE(var, words) +define([XE_SPACE],[ +T="" +for W in $2; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done +$1="$T" +])dnl XE_SPACE + +dnl ------------------------------------------------------------------------- +XE_APPEND(lib-src, MAKE_SUBDIR) +XE_APPEND(lib-src, INSTALL_ARCH_DEP_SUBDIR) +with_dragndrop_default="no" +dnl ------------------------------------------------------------------------- +dnl Command line argument processing. + +AC_ARG_WITH([prefix], + AC_HELP_STRING([--with-prefix=no],[Don't compile the value of --prefix into the executable.]), + [true], [with_prefix=yes]) +AC_ARG_WITH([site-lisp], + AC_HELP_STRING([--with-site-lisp=no],[Allow for a site-lisp directory in the XEmacs hierarchy searched before the installation packages.]), + [true], [with_site_lisp=no]) +AC_ARG_WITH([site-modules], + AC_HELP_STRING([--with-site-modules],[Disable site-modules directory in the XEmacs hierarchy, which is searched before the installation modules.]), + [], []) +AC_ARG_WITH([gtk], + AC_HELP_STRING([--with-gtk],[Support GTK on the X Window System. (EXPERIMENTAL)]), + [true], [with_gtk=no]) +AC_ARG_WITH([gnome], + AC_HELP_STRING([--with-gnome],[Support GNOME on the X Window System. (EXPERIMENTAL)]), + [true], [with_gnome=no]) +AC_ARG_WITH([msw], + AC_HELP_STRING([--with-msw],[Support MS Windows as a window system (only under Cygwin and MinGW). `--with-msw=no' may be needed on *nix systems with Wine installed.]), + [], []) +AC_ARG_WITH([gcc], + AC_HELP_STRING([--with-gcc],[Use GCC to compile XEmacs.]), + [], []) +AC_ARG_WITH([dynamic], + AC_HELP_STRING([--with-dynamic],[Link dynamically if supported by system. 'No' forces static linking.]), + [], []) +AC_ARG_WITH([ncurses], + AC_HELP_STRING([--with-ncurses],[Use the ncurses library for tty support.]), + [], []) +AC_ARG_WITH([dnet], + AC_HELP_STRING([--with-dnet],[Compile with support for DECnet.]), + [], []) +AC_ARG_WITH([socks], + AC_HELP_STRING([--with-socks],[Compile with support for SOCKS (an Internet proxy).]), + [], []) +AC_ARG_WITH([dragndrop], + AC_HELP_STRING([--with-dragndrop],[Compile in the generic drag and drop API. This is automatically added if one of the drag and drop + protocols is found (currently CDE, OffiX, MSWindows, + and GTK). + *WARNING* The Drag'n'drop support is under development + and is considered experimental.]), + [], []) +AC_ARG_WITH([cde], + AC_HELP_STRING([--with-cde],[Compile in support for CDE drag and drop.]), + [], []) +AC_ARG_WITH([offix], + AC_HELP_STRING([--with-offix],[Compile in support for OffiX drag and drop. + *WARNING* If you compile in OffiX, you may not be + able to use multiple X displays success- + fully. If the two servers are from + different vendors, the results may be + unpredictable.]), + [], []) +AC_ARG_WITH([gpm], + AC_HELP_STRING([--with-gpm],[Compile in GPM mouse support for ttys.]), + [], []) +AC_ARG_WITH([xpm], + AC_HELP_STRING([--with-xpm],[Compile with support for XPM images. PRACTICALLY + REQUIRED. Although this library is nonstandard and + a real hassle to build, many basic things (e.g. + toolbars) depend on it, and you will run into + many problems without it.]), + [], []) +AC_ARG_WITH([xface], + AC_HELP_STRING([--with-xface],[Compile with support for X-Face mail headers. + Requires the compface package. Of doubtful + usefulness.]), + [], []) +AC_ARG_WITH([gif], + AC_HELP_STRING([--with-gif],[Compile without the (builtin) support for GIF images.]), + [], []) +AC_ARG_WITH([jpeg], + AC_HELP_STRING([--with-jpeg],[Compile with support for JPEG images. Useful if + you are using a mail, news reader, or web browser + in XEmacs, so that JPEG images can be displayed.]), + [], []) +AC_ARG_WITH([png], + AC_HELP_STRING([--with-png],[Compile with support for PNG images. Recommended + because the images on the About page are not viewable + without it.]), + [], []) +AC_ARG_WITH([tiff], + AC_HELP_STRING([--with-tiff],[Compile with support for TIFF images. Possibly + useful, for the same reason as JPEG images.]), + [], []) +AC_ARG_WITH([zlib], + AC_HELP_STRING([--with-zlib],[]), + [], []) +AC_ARG_WITH([wmcommand], + AC_HELP_STRING([--with-wmcommand],[Compile without realized leader window which will + keep the WM_COMMAND property.]), + [], []) +AC_ARG_WITH([xmu], + AC_HELP_STRING([--with-xmu],[For those unfortunates whose vendors don't ship Xmu.]), + [], []) +AC_ARG_WITH([purify], + AC_HELP_STRING([--with-purify],[Add support for memory debugging using Purify.]), + [], []) +AC_ARG_WITH([quantify], + AC_HELP_STRING([--with-quantify],[Add support for performance debugging using Quantify.]), + [], []) +AC_ARG_ENABLE([toolbars], + AC_HELP_STRING([--with-toolbars],[Don't compile with any toolbar support.]), + [], []) +AC_ARG_WITH([tty], + AC_HELP_STRING([--with-tty],[Don't support ttys.]), + [], []) +AC_ARG_WITH([xfs], + AC_HELP_STRING([--with-xfs],[Compile with XFontSet support for internationalized + menubar. Incompatible with `--with-xim=motif'. + `--enable-menubars=lucid' (the default) is desirable.]), + [], []) +AC_ARG_ENABLE([mule], + AC_HELP_STRING([--enable-mule],[Compile with Mule (MUlti-Lingual Emacs) support, + needed to support non-Latin-1 (including Asian) + languages.]), + [], []) +AC_ARG_ENABLE([default-eol-detection], + AC_HELP_STRING([--enable-default-eol-detection],[Turns on by default auto-detection of end-of-line type + when reading a file. Applies to those platforms where + auto-detection is off by default (non-Mule Unix). Has + no effect otherwise.]), + [], []) +AC_ARG_WITH([canna], + AC_HELP_STRING([--with-canna],[Compile with support for Canna (a Japanese input method + used in conjunction with Mule support).]), + [], []) +AC_ARG_WITH([wnn], + AC_HELP_STRING([--with-wnn],[Compile with support for Wnn (a multi-language input + method used in conjunction with Mule support).]), + [], []) +AC_ARG_WITH([wnn6], + AC_HELP_STRING([--with-wnn6],[Compile with support for the commercial package Wnn6.]), + [], []) +AC_ARG_WITH([workshop], + AC_HELP_STRING([--with-workshop],[Support the Sun WorkShop (formerly Sparcworks) + development environment.]), + [], []) +AC_ARG_WITH([sparcworks], + AC_HELP_STRING([--with-sparcworks],[Alias for --with-workshop]), + [], []) +AC_ARG_WITH([tooltalk], + AC_HELP_STRING([--with-tooltalk],[Support the ToolTalk IPC protocol.]), + [], []) +AC_ARG_WITH([ldap], + AC_HELP_STRING([--with-ldap],[Compile with support for the LDAP protocol.]), + [], []) +AC_ARG_WITH([postgresql], + AC_HELP_STRING([--with-postgresql],[Compile with support for the PostgreSQL RDBMS.]), + [], []) +AC_ARG_WITH([pop], + AC_HELP_STRING([--with-pop],[Support POP for mail retrieval.]), + [], []) +AC_ARG_WITH([kerberos], + AC_HELP_STRING([--with-kerberos],[Support Kerberos-authenticated POP.]), + [], []) +AC_ARG_WITH([hesiod], + AC_HELP_STRING([--with-hesiod],[Support Hesiod to get the POP server host.]), + [], []) +AC_ARG_WITH([infodock], + AC_HELP_STRING([--with-infodock],[]), + [], []) +AC_ARG_WITH([native-sound-lib], + AC_HELP_STRING([--with-native-sound-lib],[]), + [], []) +AC_ARG_WITH([netinstall], + AC_HELP_STRING([--with-netinstall],[Compile in support for installation over the internet. + Only functional on the MS Windows platforms.]), + [], [with_netinstall="no"]) +AC_ARG_WITH([ipv6-cname], + AC_HELP_STRING([--with-ipv6-cname],[Try IPv6 information first when canonicalizing host names. This option has no effect unless system supports getaddrinfo(3) and getnameinfo(3).]), + [], [with_ipv6_cname="no"]) +AC_ARG_WITH([site-includes], + AC_HELP_STRING([--with-site-includes],[]), + [], []) +AC_ARG_WITH([site-libraries], + AC_HELP_STRING([--with-site-libraries],[]), + [], []) +AC_ARG_WITH([site-prefixes], + AC_HELP_STRING([--with-site-prefixes],[]), + [], []) +AC_ARG_WITH([statedir], + AC_HELP_STRING([--with-statedir],[]), + [], [with_statedir='${prefix}/lib']) +AC_ARG_WITH([lispdir], + AC_HELP_STRING([--with-lispdir],[]), + [AC_DEFINE(LISPDIR_USER_DEFINED)], [with_lispdir='${datadir}/${instvardir}/lisp']) +AC_ARG_WITH([archlibdir], + AC_HELP_STRING([--with-archlibdir],[]), + [AC_DEFINE(ARCHLIBDIR_USER_DEFINED)], [with_archlibdir='${libdir}/${instvardir}/${configuration}']) +AC_ARG_WITH([moduledir], + AC_HELP_STRING([--with-moduledir],[]), + [AC_DEFINE(MODULEDIR_USER_DEFINED)], [with_moduledir='${libdir}/${instvardir}/${configuration}/modules']) +AC_ARG_WITH([etcdir], + AC_HELP_STRING([--with-etcdir],[]), + [AC_DEFINE(ETCDIR_USER_DEFINED)], [with_etcdir='${datadir}/${instvardir}/etc']) +AC_ARG_WITH([infopath], + AC_HELP_STRING([--with-infopath],[]), + [AC_DEFINE(INFOPATH_USER_DEFINED)], []) +AC_ARG_WITH([docdir], + AC_HELP_STRING([--with-docdir],[]), + [AC_DEFINE(DOCDIR_USER_DEFINED)], [with_docdir='${archlibdir}']) +AC_ARG_WITH([site-runtime-libraries], + AC_HELP_STRING([--with-site-runtime-libraries],[]), + [], []) +AC_ARG_WITH([package-prefix], + AC_HELP_STRING([--with-package-prefix],[]), + [AC_DEFINE(PACKAGE_PATH_USER_DEFINED)], []) +AC_ARG_WITH([package-path], + AC_HELP_STRING([--with-package-path],[]), + [AC_DEFINE(PACKAGE_PATH_USER_DEFINED)], []) +AC_ARG_ENABLE([external-widget], + AC_HELP_STRING([--enable-external-widget],[]), + [], []) +AC_ARG_ENABLE([kkcc], + AC_HELP_STRING([--enable-kkcc],[]), + [], []) +AC_ARG_ENABLE([union-type], + AC_HELP_STRING([--enable-union-type],[]), + [], []) +AC_ARG_ENABLE([pdump], + AC_HELP_STRING([--enable-pdump],[]), + [], []) +AC_ARG_ENABLE([debug], + AC_HELP_STRING([--enable-debug],[]), + [], []) +AC_ARG_ENABLE([assertions], + AC_HELP_STRING([--enable-assertions],[]), + [], []) +AC_ARG_ENABLE([memory-usage-stats], + AC_HELP_STRING([--enable-memory-usage-stats],[]), + [], []) +AC_ARG_ENABLE([clash-detection], + AC_HELP_STRING([--enable-clash-detection],[Disable use of lock files to detect multiple edits + of the same file.]), + [], []) +AC_ARG_ENABLE([modules], + AC_HELP_STRING([--enable-modules],[Compile in experimental support for dynamically + loaded libraries (Dynamic Shared Objects).]), + [], []) +AC_ARG_ENABLE([quick-build], + AC_HELP_STRING([--enable-quick-build],[Speed up the build cycle by leaving out steps where + XEmacs will still work (more or less) without them. + Potentially dangerous if you don't know what you're + doing. This (1) doesn't garbage-collect after loading + each file during dumping, (2) doesn't + automatically rebuild the DOC file (remove it by hand + to get it rebuilt), (3) Removes config.h, lisp.h and + associated files from the dependency lists, so changes + to these files don't automatically cause all .c files + to be rebuilt.]), + [], []) + +AC_ARG_WITH([compiler], + AC_HELP_STRING([--with-compiler],[C compiler to use]), + [], []) + +AC_ARG_WITH([xemacs-compiler], + AC_HELP_STRING([--with-xemacs-compiler],[compiler to use to compile just the xemacs executable. + If you want to compile XEmacs as C++, use e.g. + `--xemacs-compiler=g++'. This turns on a lot of + additional error-checking.]), + [], []) + +AC_ARG_WITH([cflags], + AC_HELP_STRING([--with-cflags],[Compiler flags (such as -O); setting this overrides + all default compiler flags except those that control + warnings.]), + [], []) + +AC_ARG_WITH([cflags-warning], + AC_HELP_STRING([--with-cflags-warning],[Override compiler flags used to control warnings. + Normally, don't set this, as XEmacs already turns on + the maximum safe warning level.]), + [], []) + +AC_ARG_WITH([cpp], + AC_HELP_STRING([--with-cpp],[C preprocessor to use (e.g. /usr/ccs/lib/cpp or cc -E)]), + [CPP="$with_cpp"], []) + +AC_ARG_WITH([cppflags], + AC_HELP_STRING([--with-cppflags],[C preprocessor flags (e.g. -I/foo or -Dfoo=bar)]), + [CPPFLAGS="$with_cppflags"], []) + +AC_ARG_WITH([libs], + AC_HELP_STRING([--with-libs],[Additional libraries (e.g. -lfoo)]), + [LIBS="$with_libs"], []) + +AC_ARG_WITH([ldflags], + AC_HELP_STRING([--with-ldflags],[Additional linker flags (e.g. -L/foo)]), + [LDFLAGS="$with_ldflags"], []) + +AC_ARG_WITH([rel-alloc], + AC_HELP_STRING([--with-rel-alloc],[]), + [], [with_rel_alloc='default']) + +AC_ARG_WITH([dlmalloc], + AC_HELP_STRING([--with-dlmalloc],[]), + [], [with_dlmalloc='default']) + +AC_ARG_WITH([debug-malloc], + AC_HELP_STRING([--with-debug-malloc],[]), + [], []) + +AC_ARG_WITH([system-malloc], + AC_HELP_STRING([--with-system-malloc],[]), + [], [with_system_malloc='default']) + +#Enable code. + +AC_ARG_ENABLE([database], + AC_HELP_STRING([--enable-database],[Compile with database support. Valid types are + `no' or a comma-separated list of one or more + of `berkdb' and either `dbm' or `gnudbm'.]), + [ +with_database_berkdb=no +with_database_dbm=no +with_database_gdbm=no +for x in `echo "$enable_database" | sed -e 's/,/ /g'` ; do + case "$x" in + no ) ;; + b | be | ber | berk | berkd | berkdb ) with_database_berkdb=yes ;; + d | db | dbm ) with_database_dbm=yes ;; + g | gn | gnu | gnud | gnudb | gnudbm | gdbm) with_database_gdbm=yes ;; + * ) USAGE_ERROR(["The \`--$optname' option value +must be either \`no' or a comma-separated list +of one or more of \`berkdb' and either \`dbm' or \`gnudbm'."]) ;; + esac +done +if test "$with_database_dbm" = "yes" -a "$with_database_gdbm" = "yes"; then + USAGE_ERROR("Only one of \`dbm' and \`gnudbm' may be specified +with the \`--$optname' option.") +fi +], []) + +AC_ARG_ENABLE([sound], + AC_HELP_STRING([--enable-sound],[Compile with sound support. + Valid types are `native', `nas' and `esd'. + Prefix a type with 'no' to disable. + The first type can be `none' or `all'. `none' means + `nonative,nonas,noesd'. `all' means `native,nas,esd'. + Later options override earlier ones for the same TYPE. + The default is to autodetect all sound support except + for ESD which defaults to off.]), + [ +dnl values is a subset of all,native,nas,esd +dnl or their negatives: none,nonative,nonas,noesd +for x in `echo "$enable_sound" | sed -e 's/,/ /g'` ; do + case "$x" in + dnl all and none are only permitted as the first in the list. + n | no | non | none ) new_sdefault=no ;; + a | al | all | both ) new_sdefault=yes ;; + + native ) with_native_sound=yes ;; + nonative ) with_native_sound=no ;; + + nas ) with_nas_sound=yes ;; + nonas ) with_nas_sound=no ;; + + esd ) with_esd_sound=yes ;; + noesd ) with_esd_sound=no ;; + + * ) bogus_sound=yes ;; + esac + if test "$bogus_sound" -o \ + $ -n "$new_sdefault" -a -n "$sound_notfirst" $ ; then + types="\`all', \`none', \`(no)native', \`no(nas)', \`(no)esd'." + USAGE_ERROR(["Valid types for the \`--$optname' option are: +$types. +Option \`all' or \`none' must be first in the list. +The default is to autodetect native and NAS sound support."]) + elif test -n "$new_sdefault" ; then + with_native_sound=$new_sdefault + with_nas_sound=$new_sdefault + with_esd_sound=$new_sdefault + new_sdefault= # reset this + fi + sound_notfirst=true +done +], [with_esd_sound=no]) + +AC_ARG_WITH([athena], + AC_HELP_STRING([--with-athena],[Use TYPE Athena widgets (xaw, 3d, next, 95, or xpm).]), +[case "$with_athena" in + xa | xaw ) val=xaw ;; + 3 | 3d | xaw3d ) val=3d ;; + dnl No `n' for next, someone may try `no' + ne | nex | next | naxtaw) val=next ;; + dnl Have not tested the next two... + 9 | 95 | xaw95 ) val=95 ;; + xp | xpm | xawxpm ) val=xpm ;; + * ) USAGE_ERROR(["The \`--with-athena' option must have one of these values: + \`xaw', \`3d', \`next', \`95', or \`xpm'."]) ;; + esac +eval "$with_athena=\"$val\"" +] +)dnl + +AC_ARG_WITH([xim], + AC_HELP_STRING([--with-xim],[]), + [ +case "$with_xim" in + y | ye | yes ) val=yes ;; + n | no | non | none ) val=no ;; + x | xl | xli | xlib ) val=xlib ;; + m | mo | mot | moti | motif ) val=motif ;; + * ) USAGE_ERROR(["The \`--$optname' option must have one of these values: + \`motif', \`xlib', \`yes', or \`no'."]) ;; +esac +eval "$with_xim=\"$val\"" +], []) + +AC_ARG_WITH([mail-locking], + AC_HELP_STRING([--with-mail-locking],[Specify the locking to be used by movemail to prevent + concurrent updates of mail spool files. Valid types + are `lockf', `flock', `dot', `locking' or `mmdf'.]), + [ +case "$with_mail_locking" in + lockf ) val=lockf ;; + flock ) val=flock ;; + file | dot ) val=file ;; + locking ) val=locking ;; + mmdf ) val=mmdf ;; + pop ) val=pop ;; + * ) USAGE_ERROR(["The \`--$optname' option must have one of these values: + \`lockf', \`flock', \`file', \`dot', \`locking', \`mmdf', or \`pop'."]) ;; +esac +eval "$with_mail_locking=\"$val\"" +], []) + +AC_ARG_ENABLE([bignum], + AC_HELP_STRING([--enable-bignum=TYPE],[Compile in support for bignums, ratios, or bigfloats + using library support. TYPE must be one of "gmp" + (for GNU MP), "mp" (for BSD MP), or "no" (disabled).]), + [ +case "$enable_bignum" in + gmp ) val=gmp ;; + mp ) val=mp ;; + no|non|none ) val=no ;; + * ) USAGE_ERROR(["The \`--$optname' option must have one of these values: +\`gmp', \`mp', or \`no'."]) ;; +esac +eval "$enable_bignum=\"$val\"" +], [enable_bignum="no"]) + +AC_ARG_ENABLE([error-checking], + AC_HELP_STRING([--enable-error-checking],[Compile with internal error-checking added. + Causes noticeable loss of speed. Valid types + are extents, bufpos, malloc, gc, typecheck.]), + [ +dnl value can be all, none, and/or a list of categories to check. +dnl Example: --enable-error-checking=all,noextents,nocharbpos +dnl Example: --enable-error-checking=none,malloc,gc + +for x in `echo "$enable_error_checking" | sed -e 's/,/ /g'` ; do + case "$x" in + dnl all and none are only permitted as the first in the list. + n | no | non | none ) new_default=no ;; + a | al | all ) new_default=yes ;; + + extents ) error_check_extents=yes ;; + noextents ) error_check_extents=no ;; + + types ) error_check_types=yes ;; + notypes ) error_check_types=no ;; + + text ) error_check_text=yes ;; + notext ) error_check_text=no ;; + + gc ) error_check_gc=yes ;; + nogc ) error_check_gc=no ;; + + malloc ) error_check_malloc=yes ;; + nomalloc ) error_check_malloc=no ;; + + byte_code ) error_check_byte_code=yes ;; + nobyte_code ) error_check_byte_code=no ;; + + glyphs ) error_check_glyphs=yes ;; + noglyphs ) error_check_glyphs=no ;; + + display ) error_check_display=yes ;; + nodisplay ) error_check_display=no ;; + + structures ) error_check_structures=yes ;; + nostructures ) error_check_structures=no ;; + + * ) bogus_error_check=yes ;; + esac + + if test "$bogus_error_check" -o \ + $ -n "$new_default" -a -n "$echeck_notfirst" $ ; then + if test "$error_check_default" = yes ; then + types="\`all' (default), \`none', \`noextents', \`notypes', \`notext', \`nogc', \`nomalloc', \`noglyphs', \`nobyte-code', \`nodisplay', \`nostructures'." + else + types="\`all', \`none' (default), \`extents', \`types', \`text', \`gc', \`malloc', \`glyphs', \`byte-code', \`display', \`structures'." + fi + USAGE_ERROR(["Valid types for the \`--$optname' option are: +$types."]) + elif test -n "$new_default" ; then + error_check_extents=$new_default + error_check_types=$new_default + error_check_text=$new_default + error_check_gc=$new_default + error_check_malloc=$new_default + error_check_byte_code=$new_default + error_check_glyphs=$new_default + error_check_display=$new_default + error_check_structures=$new_default + new_default= # reset this + fi + echeck_notfirst=true + done +], []) + +AC_ARG_ENABLE([menubars], + AC_HELP_STRING([--enable-menubars=TYPE],[Use TYPE menubars (lucid, motif, or no). The Lucid + widgets emulate Motif (mostly) but are faster. + *WARNING* The Motif menubar is currently broken. + Lucid menubars are the default.]), + [ +case "$enable_menubars" in + l | lu | luc | luci | lucid ) val=lucid ;; + mo | mot | moti | motif ) val=motif ;; + a | at | ath | athe | athen | athena ) val=athena ;; + n | no | non | none ) val=no ;; + y | ye | yes ) val=yes ;; + g | gt | gtk ) val=gtk ;; + ms | msw ) val=msw ;; + * ) USAGE_ERROR(["The \`--$optname' option must have one of these values: + \`gtk', \`lucid', \`motif', \`athena', \`yes', or \`no'."]) ;; +esac +eval "$enable_menubars=\"$val\"" +], []) + +AC_ARG_ENABLE([scrollbars], + AC_HELP_STRING([--enable-scrollbars=TYPE],[Use TYPE scrollbars (lucid, motif, athena, or no). + Lucid scrollbars are the default.]), + [ +case "$enable_scrollbars" in + l | lu | luc | luci | lucid ) val=lucid ;; + mo | mot | moti | motif ) val=motif ;; + a | at | ath | athe | athen | athena ) val=athena ;; + n | no | non | none ) val=no ;; + y | ye | yes ) val=yes ;; + g | gt | gtk ) val=gtk ;; + ms | msw ) val=msw ;; + * ) USAGE_ERROR(["The \`--$optname' option must have one of these values: + \`gtk', \`lucid', \`motif', \`athena', \`yes', or \`no'."]) ;; +esac +eval "$enable_scrollbars=\"$val\"" +], []) + +AC_ARG_ENABLE([dialogs], + AC_HELP_STRING([--enable-dialogs=TYPE],[Use TYPE dialog boxes (lucid, motif, athena, or no). + There are no true Lucid dialogs; Motif dialogs will be + used if Motif can be found, else Athena is used.]), + [ +case "$enable_dialogs" in + l | lu | luc | luci | lucid ) val=lucid ;; + mo | mot | moti | motif ) val=motif ;; + a | at | ath | athe | athen | athena ) val=athena ;; + n | no | non | none ) val=no ;; + y | ye | yes ) val=yes ;; + g | gt | gtk ) val=gtk ;; + ms | msw ) val=msw ;; + * ) USAGE_ERROR(["The \`--$optname' option must have one of these values: + \`gtk', \`lucid', \`motif', \`athena', \`yes', or \`no'."]) ;; +esac +eval "$enable_dialogs=\"$val\"" +], []) + +AC_ARG_ENABLE([widgets], + AC_HELP_STRING([--enable-widgets],[Use TYPE native widgets (lucid, motif, athena, or no). + Other widget types are currently unsupported. + There are no true Lucid widgets; Motif widgets will be + used if Motif can be found, else Athena is used.]), + [ +case "$enable_widgets" in + l | lu | luc | luci | lucid ) val=lucid ;; + mo | mot | moti | motif ) val=motif ;; + a | at | ath | athe | athen | athena ) val=athena ;; + n | no | non | none ) val=no ;; + y | ye | yes ) val=yes ;; + g | gt | gtk ) val=gtk ;; + ms | msw ) val=msw ;; + * ) USAGE_ERROR(["The \`--$optname' option must have one of these values: + \`gtk', \`lucid', \`motif', \`athena', \`yes', or \`no'."]) ;; +esac +eval "$enable_widgets=\"$val\"" +], []) + +dnl ------------------------------------------------------------------------- +dnl Final command line argument checks. + +dnl --with-quantify or --with-purify imply --with-system-malloc +if test "$with_purify" = "yes" -o "$with_quantify" = "yes"; then + test "$with_system_malloc" = "default" && with_system_malloc=yes +fi + +dnl CDE requires tooltalk +XE_CHECK_FEATURE_DEPENDENCY(cde, tooltalk) + +dnl ------------------------------------------------------------------------- +dnl Local paths +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +if test "x$exec_prefix" = xNONE +then + exec_prefix='${prefix}' +else + AC_DEFINE(EXEC_PREFIX_USER_DEFINED) +fi +if test "x$datadir" != 'x${prefix}/share' +then + AC_DEFINE(INFODIR_USER_DEFINED) + AC_DEFINE(LISPDIR_USER_DEFINED) + AC_DEFINE(MODULEDIR_USER_DEFINED) + AC_DEFINE(ETCDIR_USER_DEFINED) + AC_DEFINE(DOCDIR_USER_DEFINED) + AC_DEFINE(ARCHLIBDIR_USER_DEFINED) +else + datadir='${prefix}/lib' +fi +if test "x$libdir" != 'x${exec_prefix}/lib' +then + AC_DEFINE(ARCHLIBDIR_USER_DEFINED) +fi +if test "x$mandir" = 'x${prefix}/man' +then + mandir='${prefix}/man/man1' +fi +if test "x$infodir" != 'x${prefix}/info' +then + AC_DEFINE(INFODIR_USER_DEFINED) +else + infodir='${datadir}/${instvardir}/info' +fi + +with_sitelispdir='${datadir}/${inststaticdir}/site-lisp' +inststaticdir='${PROGNAME}' +instvardir='${PROGNAME}-${version}' +sitemoduledir='${libdir}/${inststaticdir}/site-modules' + +AC_SUBST(inststaticdir) +AC_SUBST(statedir,$with_statedir) + +dnl ------------------------------------------------------------------------- +AC_CONFIG_AUX_DIR_DEFAULT +AC_CANONICAL_BUILD +dnl ------------------------------------------------------------------------- + +AC_PROG_LN_S + +dnl Make symlinks for etc, lisp, and info directories while the path +dnl is still relative. We do not symlink lock because someone may +dnl have stuck the source on a read-only partition. Instead we +dnl create it as an actual directory later on if it does not already +dnl exist. +for dir in lisp etc man info tests; do + if test ! -d "$dir" ; then + echo Making symbolic link to "$srcdir/$dir" + ${LN_S} "$srcdir/$dir" "$dir" + fi +done + +dnl Calculate canonical name for blddir (i.e. current directory). +dnl PWD may already be the preferable absolute name for ".", +dnl but we can't trust it - it is sometimes inaccurate. +absolute_pwd="`pwd`"; +if test -n "$PWD" -a "`cd $PWD && pwd`" = "$absolute_pwd" +then blddir="$PWD" +else blddir="$absolute_pwd"; CANONICALIZE_PATH(blddir) +fi +AC_SUBST(blddir) + +dnl Make srcdir absolute, if not already. It is important to +dnl avoid running the path through pwd unnecessary, since pwd can +dnl give you automounter prefixes, which can go away. +case "$srcdir" in + /* ) ;; + . ) srcdir="$blddir" ;; + * ) srcdir="`cd $srcdir && pwd`"; CANONICALIZE_PATH(srcdir) ;; +esac + +dnl Check if the source directory already has a configured system in it. +if test `pwd` != `sh -c cd $srcdir && pwd` \ + && test -f "$srcdir/src/config.h"; then + (echo "$progname: WARNING: The directory tree \`$srcdir' is being used" + echo " as a build directory right now; it has been configured in its own" + echo " right. To configure in another directory as well, you MUST" + echo " use GNU make. If you do not have GNU make, then you must" + echo " now do \`make distclean' in $srcdir," + echo " and then run $progname again.") >&2 + extrasub='/^VPATH[[ ]]*=/c\ +vpath %.c $(srcdir)\ +vpath %.h $(srcdir)\ +vpath %.y $(srcdir)\ +vpath %.l $(srcdir)\ +vpath %.s $(srcdir)\ +vpath %.in $(srcdir)' +fi + +dnl ---------------------------------------- +dnl Find out which version of XEmacs this is +dnl ---------------------------------------- +. "$srcdir/version.sh" || exit 1; +dnl Must do the following first to determine verbosity for AC_DEFINE +if test -n "$emacs_is_beta"; then beta=yes; else beta=no; fi +: "${extra_verbose=$beta}" +version="${emacs_major_version}.${emacs_minor_version}" +AC_DEFINE_UNQUOTED(EMACS_MAJOR_VERSION, $emacs_major_version) +AC_DEFINE_UNQUOTED(EMACS_MINOR_VERSION, $emacs_minor_version) +if test -n "$emacs_beta_version" ; then + if test "$beta" = "yes"; then + version="${version}-b${emacs_beta_version}" + AC_DEFINE_UNQUOTED(EMACS_BETA_VERSION, $emacs_beta_version) + else + version="${version}.${emacs_beta_version}" + AC_DEFINE_UNQUOTED(EMACS_PATCH_LEVEL, $emacs_beta_version) + fi +fi +AC_DEFINE_UNQUOTED(XEMACS_CODENAME, "$xemacs_codename") +if test "$xemacs_extra_name" != ""; then + AC_DEFINE_UNQUOTED(XEMACS_EXTRA_NAME, "$xemacs_extra_name") +fi +AC_DEFINE_UNQUOTED(EMACS_VERSION, "$version") + +if test "$with_infodock" = "yes"; then + if test ! -f ../../ID-INSTALL; then + echo "Cannot build InfoDock without InfoDock sources" + with_infodock=no + fi +fi + +if test "$with_infodock" = "yes"; then + dnl InfoDock version numbers. XEmacs will use the same style of numbering + dnl after the release of XEmacs 21.0. + AC_DEFINE_UNQUOTED(INFODOCK_MAJOR_VERSION, $infodock_major_version) + AC_DEFINE_UNQUOTED(INFODOCK_MINOR_VERSION, $infodock_minor_version) + AC_DEFINE_UNQUOTED(INFODOCK_BUILD_VERSION, $infodock_build_version) + version=${infodock_major_version}.${infodock_minor_version}.${infodock_build_version} + PROGNAME=infodock + CPPFLAGS="$CPPFLAGS -DINFODOCK" +else + PROGNAME=xemacs +fi + +AC_DEFINE_UNQUOTED(EMACS_PROGNAME, "$PROGNAME") + +dnl ---------------------------------- +dnl Error checking and debugging flags +dnl ---------------------------------- +dnl Error checking default to "yes" in beta versions, to "no" in releases. +dnl Same goes for --enable-debug and --extra-verbosity. +if test -n "$emacs_is_beta"; then beta=yes; else beta=no; fi +test "${error_check_extents=$beta}" = yes && AC_DEFINE(ERROR_CHECK_EXTENTS) +test "${error_check_types=$beta}" = yes && AC_DEFINE(ERROR_CHECK_TYPES) +test "${error_check_text=$beta}" = yes && AC_DEFINE(ERROR_CHECK_TEXT) +test "${error_check_gc=$beta}" = yes && AC_DEFINE(ERROR_CHECK_GC) +test "${error_check_malloc=$beta}" = yes && AC_DEFINE(ERROR_CHECK_MALLOC) +test "${error_check_byte_code=$beta}" = yes && AC_DEFINE(ERROR_CHECK_BYTE_CODE) +test "${error_check_glyphs=$beta}" = yes && AC_DEFINE(ERROR_CHECK_GLYPHS) +test "${error_check_display=$beta}" = yes && AC_DEFINE(ERROR_CHECK_DISPLAY) +test "${error_check_structures=$beta}" = yes && AC_DEFINE(ERROR_CHECK_STRUCTURES) +dnl enable_debug=yes must be set when error checking is present. This should be +dnl fixed up. +dnl enable_debug implies other options +if test "${enable_debug:=$beta}" = "yes"; then + enable_assertions=yes + enable_memory_usage_stats=yes + AC_DEFINE(DEBUG_XEMACS) +fi +test "$enable_assertions" = "yes" && AC_DEFINE(USE_ASSERTIONS) +test "$enable_memory_usage_stats" = "yes" && AC_DEFINE(MEMORY_USAGE_STATS) + +dnl ------------------------------ +dnl Determine the s&m files to use +dnl ------------------------------ +dnl Given the configuration name, set machfile and opsysfile to the +dnl names of the m/*.h and s/*.h files we should use. + +dnl Canonicalize the configuration name. +XE_STRIP_4TH_COMPONENT(ac_cv_build_alias) +XE_STRIP_4TH_COMPONENT(ac_cv_build) +AC_SUBST(configuration, $ac_cv_build) + +dnl If you add support for a new configuration, add code to this +dnl switch statement to recognize your configuration name and select +dnl the appropriate operating system and machine description files. + +dnl You would hope that you could choose an m/*.h file pretty much +dnl based on the machine portion of the configuration name, and an s- +dnl file based on the operating system portion. However, it turns out +dnl that each m/*.h file is pretty manufacturer-specific - for +dnl example, apollo.h, hp9000s300.h, mega68k, news.h, and tad68k are +dnl all 68000 machines; mips.h, pmax.h, and news-risc are all MIPS +dnl machines. So we basically have to have a special case for each +dnl configuration name. + +dnl As far as handling version numbers on operating systems is +dnl concerned, make sure things will fail in a fixable way. If +dnl /etc/MACHINES says nothing about version numbers, be +dnl prepared to handle anything reasonably. If version numbers +dnl matter, be sure /etc/MACHINES says something about it. + +dnl Eric Raymond says we should accept strings like "sysvr4" to mean +dnl "System V Release 4"; he writes, "The old convention encouraged" +dnl "confusion between `system' and `release' levels'." + +machine='' opsys='' + +dnl Straightforward machine determination +case "$ac_cv_build" in + sparc-*-* ) machine=sparc ;; + alpha*-*-* ) machine=alpha ;; + vax-*-* ) machine=vax ;; + mips-dec-* ) machine=pmax ;; + mips-sgi-irix6* ) machine=iris6d ;; + mips-sgi-* ) machine=iris4d ;; + mips*-linux ) machine=mips ;; + romp-ibm-* ) machine=ibmrt ;; + rs6000-ibm-aix* ) machine=ibmrs6000 ;; + powerpc-ibm-aix* ) machine=ibmrs6000 ;; + powerpc*-* ) machine=powerpc ;; + hppa-*-* ) machine=hp800 ;; + m88k-dg-* ) machine=aviion ;; + m68*-sony-* ) machine=news ;; + mips-sony-* ) machine=news-risc ;; + clipper-* ) machine=clipper ;; + arm* ) machine=arm ;; + ns32k-* ) machine=ns32000 ;; +esac + +dnl Straightforward OS determination +case "$ac_cv_build" in + *-*-linux* ) opsys=linux ;; + *-*-netbsd* ) opsys=netbsd ;; + *-*-openbsd* ) opsys=openbsd ;; + *-*-nextstep* ) opsys=nextstep ;; + *-*-vms ) opsys=vms ;; + + dnl DEC OSF + *-dec-osf1.3 | *-dec-osf2* ) opsys=decosf1-3 ;; + *-dec-osf1.2 | *-dec-osf1* ) opsys=decosf1-2 ;; + *-dec-osf3.[[2-9]] ) opsys=decosf3-2 ;; + *-dec-osf3* ) opsys=decosf3-1 ;; + *-dec-osf[[4-9]]* ) opsys=decosf4-0 ;; + + dnl DEC Ultrix + *-*-ultrix[[0-3]].* | *-*-ultrix4.0* ) opsys=bsd4-2 ;; + *-*-ultrix4.[[12]]* ) opsys=bsd4-3 ;; + *-*-ultrix* ) opsys=ultrix4-3 ;; + + dnl AIX + *-*-aix3.1* ) opsys=aix3-1 ;; + *-*-aix3.2.5 ) opsys=aix3-2-5 ;; + *-*-aix3* ) opsys=aix3-2 ;; + *-*-aix4.0* ) opsys=aix4 ;; + *-*-aix4.1* ) opsys=aix4-1 ;; + *-*-aix[[4-9]]* ) opsys=aix4-2 ;; + + dnl Other generic OSes + *-gnu* ) opsys=gnu ;; + *-*-bsd4.[[01]] ) opsys=bsd4-1 ;; + *-*-bsd4.2 ) opsys=bsd4-2 ;; + *-*-bsd4.3 ) opsys=bsd4-3 ;; + *-*-aos4.2 ) opsys=bsd4-2 ;; + *-*-aos* ) opsys=bsd4-3 ;; + *-*-sysv0 | *-*-sysvr0 ) opsys=usg5-0 ;; + *-*-sysv2 | *-*-sysvr2 ) opsys=usg5-2 ;; + *-*-sysv2.2 | *-*-sysvr2.2 ) opsys=usg5-2-2 ;; + *-*-sysv3* | *-*-sysvr3* ) opsys=usg5-3 ;; + *-*-sysv4.1* | *-*-sysvr4.1* )opsys=usg5-4 NON_GNU_CPP=/usr/lib/cpp ;; + *-*-sysv4.[[2-9]]* | *-sysvr4.[[2-9]]* ) + if test -z "$NON_GNU_CPP" ; then + for prog in "/usr/ccs/lib/cpp" "/lib/cpp"; do + if test -f "$prog"; then NON_GNU_CPP="$prog"; break; fi + done + fi + opsys=usg5-4-2 ;; + *-sysv4* | *-sysvr4* ) opsys=usg5-4 ;; + *-*-mach_bsd4.3* ) opsys=mach-bsd4-3 ;; +esac + +case "$ac_cv_build" in + + dnl NetBSD ports + *-*-netbsd* ) + case "ac_cv_build" in + i[[3-9]]86-*-netbsd*) machine=intel386 ;; + hp300-*-netbsd* | amiga-*-netbsd* | sun3-*-netbsd* | mac68k-*-netbsd* | da30-*-netbsd* | m68k-*-netbsd* ) + dnl Yes, this is somewhat bogus. + machine=hp9000s300 ;; + pc532-*-netbsd* | ns32k-*-netbsd* ) machine=ns32000 ;; + pmax-*-netbsd* | mips-*-netbsd* ) machine=pmax ;; + esac + ;; + + dnl OpenBSD ports + *-*-openbsd* ) + case "${ac_cv_build}" in + i386-*-openbsd*) machine=intel386 ;; + m68k-*-openbsd*) machine=hp9000s300 ;; + mipsel-*-openbsd*) machine=pmax ;; + esac + ;; + + dnl Acorn RISCiX: + arm-acorn-riscix1.1* ) machine=acorn opsys=riscix1-1 ;; + arm-acorn-riscix1.2* | arm-acorn-riscix ) machine=acorn opsys=riscix1-2 ;; + + dnl Alliant machines + fx80-alliant-* ) machine=alliant4 opsys=bsd4-2 ;; + i860-alliant-* ) machine=alliant-2800 opsys=bsd4-3 ;; + + dnl Altos 3068 + m68*-altos-sysv* ) machine=altos opsys=usg5-2 ;; + + dnl Amdahl UTS + 580-amdahl-sysv* ) machine=amdahl opsys=usg5-2-2 ;; + + dnl Apollo, Domain/OS + m68*-apollo-* ) machine=apollo opsys=bsd4-3 ;; + + dnl AT&T 3b2, 3b5, 3b15, 3b20 + we32k-att-sysv* ) machine=att3b opsys=usg5-2-2 ;; + + dnl AT&T 3b1 - The Mighty Unix PC! + m68*-att-sysv* ) machine=7300 opsys=usg5-2-2 ;; + + dnl Bull machines + rs6000-bull-bosx* ) machine=ibmrs6000 opsys=aix3-2 ;; # dpx20 + m68*-bull-sysv3* ) machine=dpx2 opsys=usg5-3 ;; # dpx2 + m68*-bull-sysv2* ) machine=sps7 opsys=usg5-2 ;; # sps7 + + dnl CCI 5/32, 6/32 -- see "Tahoe". + + dnl Celerity + celerity-celerity-bsd* ) machine=celerity opsys=bsd4-2 ;; + + dnl Convex + *-convex-bsd* | *-convex-convexos* ) + machine=convex opsys=bsd4-3 + NON_GNU_CPP="cc -E -P" + ;; + + dnl Cubix QBx/386 + i[[3-9]]86-cubix-sysv* ) machine=intel386 opsys=usg5-3 ;; + + dnl Darwin, a.k.a. MacOS X (based on Mach and Freebsd) + *-*-darwin*) + opsys=darwin + ;; + + dnl Data General AViiON Machines + i586-dg-dgux*R4* | i586-dg-dgux5.4.4* ) machine=aviion opsys=dgux5-4r4 ;; + m88k-dg-dgux5.4R3* | m88k-dg-dgux5.4.3* ) opsys=dgux5-4r3 ;; + m88k-dg-dgux5.4R2* | m88k-dg-dgux5.4.2* ) opsys=dgux5-4r2 ;; + m88k-dg-dgux* ) opsys=dgux ;; + + dnl Motorola Delta machines + m68k-motorola-sysv* | m68000-motorola-sysv* ) machine=delta opsys=usg5-3 ;; + m88k-motorola-sysv4* ) + dnl jbotte(a)bnr.ca says that UNIX_System_V <hostName> 4.0 R40V4.3 m88k mc88110 + dnl needs POSIX_SIGNALS and therefore needs usg5-4-2. + dnl I hope there are not other 4.0 versions for this machine + dnl which really need usg5-4 instead. + machine=delta88k opsys=usg5-4-2 + ;; + m88k-motorola-sysv* | m88k-motorola-m88kbcs* ) machine=delta88k opsys=usg5-3 ;; + + dnl Dual machines + m68*-dual-sysv* ) machine=dual opsys=usg5-2 ;; + m68*-dual-uniplus* ) machine=dual opsys=unipl5-2 ;; + + dnl Encore machines + ns16k-encore-bsd* ) machine=ns16000 opsys=umax ;; + + dnl Gould Power Node and NP1 + pn-gould-bsd4.2* ) machine=gould opsys=bsd4-2 ;; + pn-gould-bsd4.3* ) machine=gould opsys=bsd4-3 ;; + np1-gould-bsd* ) machine=gould-np1 opsys=bsd4-3 ;; + + dnl Harris Night Hawk machines running CX/UX (a 5000 looks just like a 4000 + dnl as far as XEmacs is concerned). + m88k-harris-cxux* ) + dnl Build needs to be different on 7.0 and later releases + case "`uname -r`" in + [[56]].[[0-9]] ) machine=nh4000 opsys=cxux ;; + [[7]].[[0-9]] ) machine=nh4000 opsys=cxux7 ;; + esac + NON_GNU_CPP="/lib/cpp" + ;; + dnl Harris ecx or gcx running CX/UX (Series 1200, Series 3000) + m68k-harris-cxux* ) machine=nh3000 opsys=cxux ;; + dnl Harris power pc NightHawk running Power UNIX (Series 6000) + powerpc-harris-powerunix ) machine=nh6000 opsys=powerunix NON_GNU_CPP="cc -Xo -E -P" ;; + + dnl Honeywell XPS100 + xps*-honeywell-sysv* ) machine=xps100 opsys=usg5-2 ;; + + dnl HP 9000 series 200 or 300 + m68*-hp-bsd* ) machine=hp9000s300 opsys=bsd4-3 ;; + + dnl HP-UX + *-hp-hpux* ) + dnl Figure out machine and opsys orthogonally + case "$ac_cv_build" in + m68* ) machine=hp9000s300 ;; + hppa* ) machine=hp800 ;; + esac + + case "$ac_cv_build" in + *-hp-hpux7* ) opsys=hpux ;; + *-hp-hpux8* ) opsys=hpux8 ;; + *-hp-hpux9* ) opsys=hpux9 ;; + *-hp-hpux10* ) opsys=hpux10 ;; + *-hp-hpux11* ) opsys=hpux11 ;; + * ) opsys=hpux ;; + esac + + dnl HP has a broken "strcat" + case "$opsys" in hpux9 | hpux10 ) XE_ADD_OBJS(strcat.o) ;; esac + + if test "$opsys" = "hpux10" -o "$opsys" = "hpux11"; then \ + ansi_flag="-Ae"; else ansi_flag="-Aa"; fi + NON_GNU_CC="cc $ansi_flag" NON_GNU_CPP="cc $ansi_flag -E" + + case "$ac_cv_build" in *-hp-hpux*shr* ) opsys="${opsys}-shr" ;; esac + ;; + + dnl Orion machines + orion-orion-bsd* ) machine=orion opsys=bsd4-2 ;; + clipper-orion-bsd* ) machine=orion105 opsys=bsd4-2 ;; + + dnl IBM machines + i[[3-9]]86-ibm-aix1.1* ) machine=ibmps2-aix opsys=usg5-2-2 ;; + i[[3-9]]86-ibm-aix1.[[23]]* | i[[3-9]]86-ibm-aix* ) machine=ibmps2-aix opsys=usg5-3 ;; + i370-ibm-aix*) machine=ibm370aix opsys=usg5-3 ;; + romp-ibm-aos* ) opsys=bsd4-3 ;; + romp-ibm-bsd* ) opsys=bsd4-3 ;; + romp-ibm-mach* ) opsys=mach-bsd4-3 ;; + + dnl Integrated Solutions "Optimum V" + m68*-isi-bsd4.2* ) machine=isi-ov opsys=bsd4-2 ;; + m68*-isi-bsd4.3* ) machine=isi-ov opsys=bsd4-3 ;; + + dnl Intel 386 machines where we do care about the manufacturer + i[[3-9]]86-intsys-sysv* ) machine=is386 opsys=usg5-2-2 ;; + + dnl Prime EXL + i[[3-9]]86-prime-sysv* ) machine=i386 opsys=usg5-3 ;; + + dnl Sequent Symmetry running Dynix + i[[3-9]]86-sequent-bsd* ) machine=symmetry opsys=bsd4-3 ;; + + dnl Sequent Symmetry running DYNIX/ptx + i[[3-9]]86-sequent-ptx* ) machine=sequent-ptx opsys=ptx NON_GNU_CPP="/lib/cpp" ;; + + dnl Unspecified sysv on an ncr machine defaults to svr4.2. + dnl (Plain usg5-4 does not turn on POSIX signals, which we need.) + i[[3-9]]86-ncr-sysv* ) machine=ncr386 opsys=usg5-4-2 ;; + + dnl Intel Paragon OSF/1 + i860-intel-osf1* ) machine=paragon opsys=osf1 NON_GNU_CPP=/usr/mach/lib/cpp ;; + + dnl Intel 860 + i860-*-sysv4* ) machine=i860 opsys=usg5-4 NON_GNU_CC="/bin/cc" NON_GNU_CPP="/usr/ccs/lib/cpp" ;; + + dnl Masscomp machines + m68*-masscomp-rtu* ) machine=masscomp opsys=rtu ;; + + dnl Megatest machines + m68*-megatest-bsd* ) machine=mega68 opsys=bsd4-2 ;; + + dnl Workstations sold by MIPS + dnl This is not necessarily all workstations using the MIPS processor - + dnl Irises are produced by SGI, and DECstations by DEC. + mips-mips-usg* ) machine=mips4 ;; + mips-mips-riscos4 ) + machine=mips4 + NON_GNU_CC="cc -systype bsd43" + NON_GNU_CPP="cc -systype bsd43 -E" + case "$ac_cv_build" in + mips-mips-riscos4* ) opsys=bsd4-3 ;; + mips-mips-riscos5* ) opsys=riscos5 ;; + esac + ;; + mips-mips-bsd* ) machine=mips opsys=bsd4-3 ;; + mips-mips-* ) machine=mips opsys=usg5-2-2 ;; + + dnl NeXT + m68*-next-* | m68k-*-nextstep* ) machine=m68k opsys=nextstep ;; + + dnl The complete machine from National Semiconductor + ns32k-ns-genix* ) machine=ns32000 opsys=usg5-2 ;; + + dnl NCR machines + m68*-ncr-sysv2* | m68*-ncr-sysvr2* ) machine=tower32 opsys=usg5-2-2 ;; + m68*-ncr-sysv3* | m68*-ncr-sysvr3* ) machine=tower32v3 opsys=usg5-3 ;; + + dnl Nixdorf Targon 31 + m68*-nixdorf-sysv* ) machine=targon31 opsys=usg5-2-2 ;; + + dnl Nu (TI or LMI) + m68*-nu-sysv* ) machine=nu opsys=usg5-2 ;; + + dnl Plexus + m68*-plexus-sysv* ) machine=plexus opsys=usg5-2 ;; + + dnl Pyramid machines + pyramid-pyramid-bsd* ) machine=pyramid opsys=bsd4-2 ;; + + dnl Sequent Balance + ns32k-sequent-bsd4.2* ) machine=sequent opsys=bsd4-2 ;; + ns32k-sequent-bsd4.3* ) machine=sequent opsys=bsd4-3 ;; + + dnl Siemens Nixdorf + mips-siemens-sysv* | mips-sni-sysv*) + machine=mips-siemens opsys=usg5-4 + NON_GNU_CC=/usr/ccs/bin/cc + NON_GNU_CPP=/usr/ccs/lib/cpp + ;; + + dnl NEC + mips-nec-sysv*) + machine=mips-nec + NON_GNU_CC=/usr/ccs/bin/cc + NON_GNU_CPP=/usr/ccs/lib/cpp + ;; + + dnl Silicon Graphics machines + dnl Iris 2500 and Iris 2500 Turbo (aka the Iris 3030) + m68*-sgi-iris3.5* ) machine=irist opsys=iris3-5 ;; + m68*-sgi-iris3.6* | m68*-sgi-iris*) machine=irist opsys=iris3-6 ;; + dnl Iris 4D + mips-sgi-irix3.* ) opsys=irix3-3 ;; + mips-sgi-irix4.* ) opsys=irix4-0 ;; + mips-sgi-irix6* ) opsys=irix6-0 ;; + mips-sgi-irix5.1* ) opsys=irix5-1 ;; + mips-sgi-irix5.2* ) opsys=irix5-2 ;; + mips-sgi-irix5.* ) opsys=irix5-3 ;; + mips-sgi-irix* ) opsys=irix5-0 ;; + + dnl SONY machines + *-sony-newsos[[34]]* | *-sony-news[[34]]* ) opsys=bsd4-3 ;; + *-sony-news* ) opsys=newsos5 ;; + + dnl Stride + m68*-stride-sysv* ) machine=stride opsys=usg5-2 ;; + + dnl Suns + *-*-solaris* | *-*-sunos* | *-sun-mach* | *-sun-bsd* ) + dnl Hardware type + case "$ac_cv_build" in + m68*-sunos1* ) machine=sun1 ;; + m68*-sunos2* ) machine=sun2 ;; + m68* ) machine=sun3 ;; + i*86*-sun-sunos[[34]]* ) machine=sun386 ;; + i*86-*-* ) machine=intel386 ;; + rs6000* ) machine=rs6000 ;; + esac + + dnl Make $canonical even more so. + case "$ac_cv_build" in *-sunos5*) + ac_cv_build=`echo $ac_cv_build | sed -e s/sunos5/solaris2/`;; + esac + + dnl On SunOS 4, use /usr/lib/cpp, sans dynodump, /bin/ranlib + dnl On SunOS 5, use cc -E, need dynodump, RANLIB not needed + dnl But, SunOS 5.6 no longer needs dynodump because it has a similar + dnl function integrated. + case "$ac_cv_build" in + *-sunos4* ) + #test -f /usr/lib/cpp && NON_GNU_CPP=/usr/lib/cpp ;; + : ;; + *-solaris2* ) + #test -f /usr/ccs/lib/cpp && NON_GNU_CPP=/usr/ccs/lib/cpp + RANLIB=':' ;; + esac + + case "$ac_cv_build" in + *-solaris* ) + opsys=sol2 + os_release_major=`uname -r | sed -e 's/^$[[0-9]]\{1,\}$\.$[[0-9]]\{1,\}$.*/\1/'` + os_release_minor=`uname -r | sed -e 's/^$[[0-9]]\{1,\}$\.$[[0-9]]\{1,\}$.*/\2/'` + case "$os_release_minor" in [[0-9]]) + os_release_minor="0${os_release_minor}";; + esac + os_release="${os_release_major}${os_release_minor}" + AC_DEFINE_UNQUOTED(OS_RELEASE, $os_release) ;; + + dnl The last Sun386 ran 4.0. + i*86-*-sunos4* ) opsys=sunos4-0 ;; + *-sunos4.0* ) opsys=sunos4-0 ;; + *-sunos4.1.2* ) opsys=sunos4-1-2 ;; + *-sunos4.1.3* ) opsys=sunos4-1-3 ;; + *-sunos4.1.[[4-9]]* ) opsys=sunos4-1-4 ;; + *-sunos4* | *-sunos ) opsys=sunos4-1 ;; + *-mach* ) opsys=mach-bsd4-3 ;; + * ) opsys=bsd4-2 ;; + esac + + case "$ac_cv_build" in *-sunos4*shr* ) opsys="${opsys}-shr" ;; esac + + dnl Watch out for a compiler guaranteed not to work. + test "$opsys $CC" = "sol2 /usr/ucb/cc" && CC="" + ;; + + dnl Tadpole 68k + m68*-tadpole-sysv* ) machine=tad68k opsys=usg5-3 ;; + + dnl Tahoe machines + tahoe-tahoe-bsd4.2* ) machine=tahoe opsys=bsd4-2 ;; + tahoe-tahoe-bsd4.3* ) machine=tahoe opsys=bsd4-3 ;; + + dnl Tandem Integrity S2 + mips-tandem-sysv* ) machine=tandem-s2 opsys=usg5-3 ;; + + dnl Tektronix XD88 + m88k-tektronix-sysv3* ) machine=tekxd88 opsys=usg5-3 ;; + + dnl Tektronix 16000 box (6130?) + ns16k-tektronix-bsd* ) machine=ns16000 opsys=bsd4-2 ;; + dnl Tektronix 4300 + dnl src/m/tek4300.h hints that this is a m68k machine. + m68*-tektronix-bsd* ) machine=tek4300 opsys=bsd4-3 ;; + + dnl Titan P2 or P3 + titan-titan-sysv* ) machine=titan opsys=usg5-3 ;; + + dnl Ustation E30 (SS5E) + m68*-unisys-uniplus* ) machine=ustation opsystem=unipl5-2 ;; + + dnl Vaxen. + vax-dec-* ) + case "$ac_cv_build" in + *-sysv[[01]]* | *-sysvr[[01]]* ) opsys=usg5-0 ;; + *-sysv2* | *-sysvr2* ) opsys=usg5-2 ;; + *-mach* ) opsys=mach-bsd4-3 ;; + esac + ;; + + dnl Whitechapel MG1 + ns16k-whitechapel-* ) machine=mg1 ;; + + dnl Wicat + m68*-wicat-sysv* ) machine=wicat opsys=usg5-2 ;; + + dnl Intel 386 machines where we do not care about the manufacturer + i[[3-9]]86-*-* ) + machine=intel386 + case "$ac_cv_build" in + *-isc1.* | *-isc2.[[01]]* ) opsys=386-ix ;; + *-isc2.2* ) opsys=isc2-2 ;; + *-isc4.0* ) opsys=isc4-0 ;; + *-isc4.* ) opsys=isc4-1 + GCC_TEST_OPTIONS=-posix + NON_GCC_TEST_OPTIONS=-Xp + ;; + *-isc* ) opsys=isc3-0 ;; + *-esix5* ) opsys=esix5r4 NON_GNU_CPP=/usr/lib/cpp ;; + *-esix* ) opsys=esix ;; + *-mach* ) opsys=mach-bsd4-3 ;; + *-xenix* ) opsys=xenix ;; + *-sco3.2v4* ) opsys=sco4 NON_GNU_CPP=/lib/cpp ;; + *-bsd386* | *-bsdi1* ) opsys=bsd386 ;; + *-bsdi4* ) opsys=bsdos4 ;; + *-bsdi3* ) opsys=bsdos3 ;; + *-bsdi2.1* ) opsys=bsdos2-1 ;; + *-bsdi2* ) opsys=bsdos2 ;; + *-sco3.2v5* ) opsys=sco5 ;; + *-sysv5* ) opsys=sco7 ;; + *-386bsd* ) opsys=386bsd ;; + *-freebsd* ) opsys=freebsd ;; + *-nextstep* ) opsys=nextstep ;; + *-pc-cygwin* ) opsys=cygwin32 ;; + *-pc-mingw* ) opsys=mingw32 ; + test -z "$with_tty" && with_tty="no";; + dnl Otherwise, we fall through to the generic opsys code at the bottom. + esac + ;; + + dnl Linux/68k + m68k-*-linux* ) machine=m68k opsys=linux ;; + +esac + +dnl Initialize machine from $canonical if not in our database above. +test -z "$machine" && machine=`echo $ac_cv_build | sed 's/-.*$//'` + +dnl Initialize opsys from `uname -s` if not in our database above. +test -z "$opsys" && opsys=`uname -s | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz` + +dnl Use configure-time autodetection if s&m not available +if test -r "${srcdir}/src/m/${machine}.h"; then + machfile="m/${machine}.h" + AC_DEFINE_UNQUOTED(config_machfile, "$machfile") +else + echo "XEmacs has no builtin knowledge of \`$machine' machines." + echo "Using configure-time autodetection only." +fi + +if test -r "${srcdir}/src/s/${opsys}.h"; then + opsysfile="s/${opsys}.h" + AC_DEFINE_UNQUOTED(config_opsysfile, "$opsysfile") +else + echo "XEmacs has no builtin knowledge of \`$opsys' operating systems." + echo "Using configure-time autodetection only." +fi + + +dnl -------------------------------------------------------------- +dnl $opsys detection complete; defaults depending on $opsys follow +dnl -------------------------------------------------------------- + +if test -z "$enable_pdump"; then + case "$opsys" in + linux* ) enable_pdump=yes ;; dnl glibc 2.3.1 seems to hose unexec + darwin ) enable_pdump=yes ;; dnl No "native" working dumper available + cygwin* ) enable_pdump=yes ;; dnl unexec is broken + * ) enable_pdump=no ;; + esac +fi + +if test -z "$with_dynamic"; then + case "$opsys" in + hpux* | sunos4* ) with_dynamic=no ;; + *) with_dynamic=yes ;; + esac +fi +if test "$with_dynamic" = "yes"; then + case "$opsys" in + hpux* | sunos4* | sco5 ) opsys="${opsys}-shr" ;; + decosf* ) ld_call_shared="-call_shared" ;; + darwin ) AC_DEFINE(DLSYM_NEEDS_UNDERSCORE) ;; + esac +else dnl "$with_dynamic" = "no" + case "$opsys" in + sol2 ) + echo "Static linking is not supported on Solaris 2." + echo "Rerun configure without specifying --without-dynamic." + exit 1 ;; + linux ) ld_call_shared="-Bstatic" ;; + decosf* ) ld_call_shared="-non_shared" ;; + esac +fi + +dnl Tools configuration +case "$opsys" in + aix* ) NON_GNU_CC=xlc ;; dnl Use xlc by default on AIX + darwin ) RANLIB="ranlib -c" ;; dnl Avoid link error in lwlib-config.c +esac + +stack_trace_eye_catcher=`echo ${PROGNAME}_${version}_${ac_cv_build} | sed 'y/.-/__/'` +AC_DEFINE_UNQUOTED(STACK_TRACE_EYE_CATCHER, $stack_trace_eye_catcher) + +dnl -------------------------------------------------- +dnl Determine the compiler, set up for feature testing +dnl -------------------------------------------------- + +dnl Sun Development environment support +test "$with_sparcworks" = "yes" && with_workshop=yes # compatibility alias +XE_CHECK_FEATURE_DEPENDENCY(workshop, tooltalk) +if test "$with_workshop" = "yes"; then + AC_DEFINE(SUNPRO) +fi + +if test "$enable_clash_detection" != "no"; then + AC_DEFINE(CLASH_DETECTION) +fi + +dnl Choose a compiler from (in order) +dnl --compiler, env var CC, with_gcc=no && ${NON_GNU_CC:-cc}, AC_PROG_CC +test -n "$with_compiler" && CC="$with_compiler" +if test "$with_gcc" = "no"; then dnl Try to find a non-gcc compiler + case "$CC" in "" | *gcc* ) CC="${NON_GNU_CC-cc}" ;; esac +fi + +dnl If we don't set CFLAGS here, AC_PROG_CC will set it. +dnl But we know better what's good for us, so we do our own +dnl computation of real CFLAGS later. +dnl --with_cflags overrides environment variable CFLAGS +test "${with_cflags-unset}" != unset && CFLAGS="$with_cflags" +if test "${CFLAGS-unset}" != unset + then cflags_specified=yes; + else cflags_specified=no; +fi + +if test "${with_cflags_warning-unset}" != unset + then cflags_warning_specified=yes; + else cflags_warning_specified=no; +fi + +xe_save_CFLAGS="$CFLAGS" + +AC_AIX dnl Defines _ALL_SOURCE on AIX. + +AC_PROG_CC dnl Autoconf has its own magic for compiler autodetection + +dnl Retry using random guesswork if AC_PROG_CC got it wrong... +if test "$with_gcc" = "no" -a "$GCC" = "yes"; then + CC=${NON_GNU_CC-cc} + AC_PROG_CC +elif test "$with_gcc" = "yes" -a "$GCC" != "yes" ; then + CC=gcc + AC_PROG_CC +fi +CFLAGS="$xe_save_CFLAGS" + +dnl Determine GCC version. +if test "$GCC" = "yes"; then +AC_RUN_IFELSE([AC_LANG_SOURCE([int main () { +#if __GNUC__ >= 3 +return 11; +#else +return 0; +#endif +}])], [:], +[case "$?" in + 11) echo "You appear to be using GCC version 3 or above."; __GCC3=yes ;; +esac]) +fi + +dnl Support for using a different compiler for xemacs itself. +dnl Useful for building XEmacs with a C++ compiler. +dnl For example, `configure --compiler=gcc --xemacs-compiler=g++ + +dnl The compiler used to build xemacs, as opposed to the compiler +dnl used by configure and lib-src, is determined from the following +dnl sources, in order of priority: +dnl o --xemacs-compiler configure flag +dnl o XEMACS_CC environment variable +dnl o same as the regular compiler, (determined previously) + +dnl We don't do AC_PROG_CC for XEMACS_CC; if we can't trust these people.... +test -n "$with_xemacs_compiler" && XEMACS_CC="$with_xemacs_compiler" +: ${XEMACS_CC:="$CC"} + +dnl Figure out what C preprocessor to use. + +dnl On Sun systems, people sometimes set up the variable CPP +dnl with a value that is a directory, not an executable at all. +dnl Detect that case, and ignore that value. +test -n "$CPP" -a -d "$CPP" && CPP= + +test -n "$NON_GNU_CPP" -a "$GCC" != "yes" -a -z "$CPP" && CPP="$NON_GNU_CPP" + +AC_PROG_CPP + +dnl -------------------------------------------------------------------- +dnl Compiler feature macros +dnl -------------------------------------------------------------------- + +dnl We want feature macros defined here *and* in config.h.in, so that +dnl the compilation environment at configure time and compile time agree. + +AC_MSG_CHECKING(for GNU libc) +AC_TRY_COMPILE([#include <features.h>],[ +#if ! (defined __GLIBC__ || defined __GNU_LIBRARY__) +#error Not a GNU libc system :-( +******* ======= ******** &&&&&&&& +#endif +], have_glibc=yes, have_glibc=no) +AC_MSG_RESULT($have_glibc) +dnl I'm tired of pop being broken with GLIBC -slb +dnl Well. then why not fix fucking pop? +test "$have_glibc" = "yes" && AC_DEFINE(_GNU_SOURCE) + +dnl We'd like to use vendor extensions, where available. +dnl We'd like to use functions from the latest Unix98 standards. +dnl See http://www.opengroup.org/onlinepubs/007908799/xsh/compilation.html +case "$opsys" in + sol2) + AC_DEFINE(__EXTENSIONS__) + dnl Solaris 2 before 2.5 had some bugs with feature test macro interaction. + if test "$os_release" -ge 505; then + AC_DEFINE(_XOPEN_SOURCE,500) + AC_DEFINE(_XOPEN_SOURCE_EXTENDED) + fi ;; + linux) + AC_DEFINE(_POSIX_C_SOURCE,199506L) + dnl #### should this be 600? + AC_DEFINE(_XOPEN_SOURCE,500) + AC_DEFINE(_XOPEN_SOURCE_EXTENDED) + ;; + freebsd4*) + AC_DEFINE(_POSIX_C_SOURCE,199506L) + dnl #### Do we want these too? Apparently yes for _XOPEN_SOURCE=500. + AC_DEFINE(_XOPEN_SOURCE,500) + dnl AC_DEFINE(_XOPEN_SOURCE_EXTENDED) + ;; +esac + +dnl Identify compilers to enable compiler-specific hacks. +dnl Add support for other compilers HERE! +dnl GCC is already identified elsewhere. +AC_RUN_IFELSE([AC_LANG_SOURCE([int main () { +#if defined __SUNPRO_C +return 11; +#elif defined __DECC +return 12; +#elif defined __USLC__ && defined __SCO_VERSION__ +return 13; +#elif defined __INTEL_COMPILER +return 14; +#else +return 0; +#endif +}])], [], +[case "$?" in + 11) echo "You appear to be using the SunPro C compiler." ; __SUNPRO_C=yes ;; + 12) echo "You appear to be using the DEC C compiler." ; __DECC=yes ;; + 13) echo "You appear to be using the SCO C compiler." ; __USLC__=yes ;; + 14) echo "You appear to be using the Intel C++ compiler."; __ICC=yes + dnl Newer versions of icc claim to be GCC + GCC=no ;; +esac]) + +dnl -------------------------------------------------------------------- +dnl Extract some information from the operating system and machine files +dnl -------------------------------------------------------------------- + +echo "Extracting information from the machine- and system-dependent headers..." + +dnl It is not important that this name contain the PID; you cannot run +dnl two configures in the same directory and have anything work +dnl anyway. +tempcname="conftest.c" + +dnl CPP_to_sh(CPP_SYMBOL, SH_VAR, DEFAULT_VALUE) +define([CPP_to_sh], +[[#]ifndef [$1] +[#]define [$1]ifelse([$3],,, [ "$3"]) +[#]endif +configure___ [$2]=[$1] +])dnl CPP_to_sh + +dnl CPP_boolean_to_sh(CPP_SYMBOL, SH_VAR) +define([CPP_boolean_to_sh], +[[#]ifdef [$1] +configure___ [$2]=yes +[#]else +configure___ [$2]=no +[#]endif +])dnl CPP_boolean_to_sh + +cat > $tempcname < confdefs.h +cat >> $tempcname <<EOF +#define NOT_C_CODE +#define C_SWITCH_SITE +#define C_SWITCH_X_SITE +#define LD_SWITCH_SITE +#define LD_SWITCH_X_SITE +#define LD_SWITCH_X_SITE_AUX +#define OS_RELEASE $os_release + +#ifdef config_opsysfile +#include "$srcdir/src/$opsysfile" +#endif + +#ifdef config_machfile +#include "$srcdir/src/$machfile" +#endif + +CPP_to_sh(LIBS_MACHINE, libs_machine) +CPP_to_sh(LIBS_SYSTEM, libs_system) +CPP_to_sh(LIBS_TERMCAP, libs_termcap) +CPP_to_sh(LIB_STANDARD, libs_standard) + +CPP_to_sh(OBJECTS_MACHINE, objects_machine) +CPP_to_sh(OBJECTS_SYSTEM, objects_system) + +CPP_to_sh(C_SWITCH_MACHINE, c_switch_machine) +CPP_to_sh(C_SWITCH_SYSTEM, c_switch_system) + +CPP_to_sh(LD_SWITCH_MACHINE, ld_switch_machine) +CPP_to_sh(LD_SWITCH_SYSTEM, ld_switch_system) + +CPP_to_sh(UNEXEC, unexec) + +CPP_to_sh(SYSTEM_TYPE, system_type) + +CPP_to_sh(LD_SWITCH_SHARED, ld_switch_shared, -c) + +#define ORDINARY_LD "\$(CC) \$(CFLAGS)" +configure___ ordinary_ld=ORDINARY_LD + +#ifdef ORDINARY_LINK +#define LD ORDINARY_LD +#else /* no ORDINARY LINK */ +#ifdef COFF_ENCAPSULATE +#define LD "\$(CC) -nostdlib" +#else /* not COFF_ENCAPSULATE */ +#ifdef LINKER +#define LD LINKER +#else /* ! defined (LINKER) */ +#define LD "ld" +#endif /* ! defined (LINKER) */ +#endif /* ! defined (COFF_ENCAPSULATE) */ +#endif /* not ORDINARY_LINK */ +configure___ ld=LD + +CPP_to_sh(LIB_GCC, lib_gcc) +CPP_to_sh(LD_TEXT_START_ADDR, ld_text_start_addr) + +#if ! defined (ORDINARY_LINK) && !defined (START_FILES) +#ifdef NO_REMAP +#ifdef COFF_ENCAPSULATE +#define START_FILES "pre-crt0.o /usr/local/lib/gcc-crt0.o" +#else /* ! defined (COFF_ENCAPSULATE) */ +#define START_FILES "pre-crt0.o /lib/crt0.o" +#endif /* ! defined (COFF_ENCAPSULATE) */ +#else /* ! defined (NO_REMAP) */ +#define START_FILES "ecrt0.o" +#endif /* ! defined (NO_REMAP) */ +#endif /* no ORDINARY_LINK */ +#ifndef START_FILES +#define START_FILES +#endif +configure___ start_files=START_FILES + +CPP_boolean_to_sh(ORDINARY_LINK, ordinary_link) +CPP_boolean_to_sh(SYSTEM_MALLOC, system_malloc) +CPP_boolean_to_sh(TERMINFO, have_terminfo) +dnl The MAIL_USE_xxx variables come from the s&m headers +CPP_boolean_to_sh(MAIL_USE_FLOCK, mail_use_flock) +CPP_boolean_to_sh(MAIL_USE_LOCKF, mail_use_lockf) +CPP_boolean_to_sh(MAIL_USE_LOCKING, mail_use_locking) +CPP_boolean_to_sh(HAVE_WIN32_PROCESSES, win32_processes) +EOF + +dnl The value of CPP is a quoted variable reference, so we need to do this +dnl to get its actual value... +CPP=`eval "echo $CPP $CPPFLAGS"` +define(TAB, [ ])dnl +eval `$CPP -Isrc $tempcname \ + | sed -n -e "s/[[ TAB]]*=[[ TAB\"]]*/='/" -e "s/[[ TAB\"]]*\$/'/" -e "s/^configure___//p"` + +rm $tempcname + +dnl s&m files shouldn't be required to define anything, or even to exist. +dnl So we default SYSTEM_TYPE to the obvious documented standard, `uname -s`, +dnl appropriately emacsulated. +test -z "$system_type" && \ + AC_DEFINE_UNQUOTED(SYSTEM_TYPE,"`uname -s | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz`") + +dnl If the s&m files don't define a system-specific dumper, simply use pdump. +dnl Sometime in the future, we'll remove all definitions of UNEXEC +dnl from all the s&m files. +test -z "$unexec" && enable_pdump=yes + +if test "$enable_pdump" = "yes"; then + ordinary_link="yes" + ld="${ordinary_ld}" + start_files= + libs_standard= + unexec= + lib_gcc= +fi + +dnl For debugging... +dnl test "$extra_verbose" = "yes" && \ + PRINT_VAR(libs_machine libs_system libs_termcap libs_standard + objects_machine objects_system c_switch_machine c_switch_system + ld_switch_machine ld_switch_system unexec ld_switch_shared + ld lib_gcc ld_text_start_addr start_files ordinary_link + have_terminfo mail_use_flock mail_use_lockf) && echo "" + +dnl Pick up mingw include path +dnl We only cope with headers in mingw, not mingw32: no previous version of +dnl XEmacs supported mingw and cygnus have made this incompatible change +dnl so we just go with the flow. +case "$opsys" in mingw* | cygwin*) + cygwin_include=`eval "gcc -print-file-name=libc.a"` ; + cygwin_include=`eval "dirname $cygwin_include"` ; + cygwin_include="-I$cygwin_include/../include" ; + extra_includes="$cygwin_include/mingw $cygwin_include" ; + case "$opsys" in mingw*) + XE_APPEND($extra_includes, c_switch_system) ;; + esac + ;; +esac + +dnl Non-ordinary link usually requires -lc +test "$ordinary_link" = "no" -a -z "$libs_standard" && libs_standard="-lc" + +dnl ----------------------- +dnl Compiler-specific hacks +dnl ----------------------- + +dnl DEC C `-std1' means ANSI C mode +test "$__DECC" = "yes" && XE_APPEND(-std1, c_switch_site) + +dnl Some versions of SCO native compiler need -Kalloca +if test "$__USLC__" = yes; then + AC_MSG_CHECKING(for whether the -Kalloca compiler flag is needed) + need_kalloca=no + AC_TRY_LINK([], [void *x = alloca(4);], [:], [ + xe_save_c_switch_system="$c_switch_system" + c_switch_system="$c_switch_system -Kalloca" + AC_TRY_LINK([], [void *x = alloca(4);], [ need_kalloca=yes ]) + c_switch_system="$xe_save_c_switch_system"]) + AC_MSG_RESULT($need_kalloca) + test "$need_kalloca" = "yes" && XE_APPEND(-Kalloca,c_switch_system) +fi + +dnl If we're specifying XEMACS_CC, it'd better be in the same family +dnl as CC or the following flag calculations are bogus. +dnl #### We may want to actually error and abort here, but I am not sure. +if test "$CC" != "$XEMACS_CC"; then + if test "$XEMACS_CC" = "g++" -a "$GCC" != "yes"; then + AC_MSG_WARN([CC and g++ are mismatched; XE_CFLAGS may be wrong]) + xemacs_cc_cc_mismatch=yes + elif test -n "$GCC" -a "$XEMACS_CC" != "g++"; then + AC_MSG_WARN([gcc and XEMACS_CC are mismatched; XE_CFLAGS may be wrong]) + xemacs_cc_cc_mismatch=yes + dnl #### Add other detectable mismatches here. + else + xemacs_cc_cc_mismatch=no + fi +fi + +dnl #### This may need to be overhauled so that all of XEMACS_CC's flags +dnl are handled separately, not just the xe_cflags_warning stuff. + +AC_MSG_CHECKING([for preferred CFLAGS]) + +dnl Use either command line flag, environment var, or autodetection +if test "$cflags_specified" = "no"; then + dnl Following values of CFLAGS are known to work well. + dnl Should we take debugging options into consideration? + if test "$GCC" = "yes"; then + CFLAGS="-g -O3" + elif test "$__SUNPRO_C" = "yes"; then + case "$opsys" in + sol2 ) CFLAGS="-xO4" ;; + sunos4* ) CFLAGS="-xO2" ;; + esac + elif test "$__DECC" = "yes"; then + CFLAGS="-O3" + elif test "$CC" = "xlc"; then + CFLAGS="-g -O3 -qstrict -qnoansialias -qlibansi -qro -qmaxmem=20000" + elif test "$__ICC" = "yes"; then + CFLAGS="-g -O3 -Ob2" + dnl ### Add optimal CFLAGS support for other compilers HERE! + else + CFLAGS="-O" ;dnl The only POSIX-approved flag + fi +fi +AC_MSG_RESULT([${CFLAGS}]) + +dnl Calculate warning flags. We separate the flags for warnings from +dnl the other flags because we want to force the warnings to be seen +dnl by everyone who doesn't specifically override them. + +AC_MSG_CHECKING([for preferred warning flags for XEMACS_CC]) + +dnl If this stays nil, it will be set to cflags_warning before use. +xe_cflags_warning="" + +if test "$cflags_warning_specified" = "no"; then + dnl Following warning flags are known to work well. + if test "$__SUNPRO_C" = "yes"; then + case "$opsys" in + sol2 ) with_cflags_warning="-v" ;; + esac + elif test "$CC" = "xlc"; then + with_cflags_warning="-qinfo" + elif test "$GCC" = "yes"; then + with_cflags_warning="-Wall -Wno-switch -Wmissing-prototypes" + dnl This is not very useful, as it issues warnings that may appear + dnl or disappear rather randomly, cannot easily be fixed, and are + dnl not a big deal. If you want it, add it yourself. + dnl with_cflags_warning="$with_cflags_warning -Winline" + + dnl Yuck, bad compares have been worth at least 3 crashes! + dnl Warnings about char subscripts are pretty pointless, though, + dnl and we use them in various places. + with_cflags_warning="$with_cflags_warning -Wsign-compare -Wno-char-subscripts" + with_cflags_warning="$with_cflags_warning -Wundef -Wstrict-prototypes" + test "$__GCC3" = "yes" && with_cflags_warning="$with_cflags_warning -Wpacked" + dnl glibc is intentionally not `-Wpointer-arith'-clean. + dnl Ulrich Drepper has rejected patches to fix the glibc header files. + test "$have_glibc" != "yes" && \ + with_cflags_warning="$with_cflags_warning -Wpointer-arith" + dnl Warning flags that may differ for gcc and g++ (xemacs_compiler) + dnl With g++, -Wshadow produces five zillion utterly random warnings -- + dnl a local var named `buffer' conflicts with `struct buffer' for + dnl example. Even with gcc, -Wshadow is questionable because of its + dnl complaints about parameters with the same names as global functions. + dnl There is no -Wmissing-declarations under g++. + dnl But gcc warns about -Weffc++ in C compiles. + dnl With g++, there is no effective way to use -Wunused-parameter without + dnl some very ugly code changes. + if test "$with_xemacs_compiler" = "g++"; then + xe_cflags_warning="$with_cflags_warning -Weffc++" + elif test "$__GCC3" = "yes"; then + xe_cflags_warning="$with_cflags_warning -Wunused-parameter" + fi + with_cflags_warning="$with_cflags_warning -Wshadow -Wmissing-declarations" + dnl **** If more gcc/g++ flags are added, from here on must handle + dnl **** with_cflags_warning and xe_cflags_warning in parallel + elif test "$__ICC" = "yes"; then + with_cflags_warning="-Wall -w1 -we147" + dnl ### Add optimal with_cflags_warning support for other compilers HERE! + fi +fi +test -z "$xe_cflags_warning" && xe_cflags_warning="$with_cflags_warning" +AC_MSG_RESULT([${xe_cflags_warning}]) + +AC_MSG_CHECKING([for preferred warning flags for CC]) +AC_MSG_RESULT([${with_cflags_warning}]) + +dnl Now combine all C flags. Put the warning flags first so that +dnl user-specified flags will override. +dnl Do XE_CFLAGS before adding warning flags to CFLAGS. +dnl Flags for XEMACS_CC: +XE_CFLAGS="$xe_cflags_warning $CFLAGS" +dnl Flags for CC: +CFLAGS="$with_cflags_warning $CFLAGS" + +dnl Search for GCC specific build problems we know about +if test "$GCC" = "yes"; then +AC_MSG_CHECKING(for buggy gcc versions) +GCC_VERSION=`$CC --version` +case `uname -s`:`uname -m`:$GCC_VERSION in + dnl egcs 2.90.21 (egcs-1.00 release) + dnl egcs 2.90.29 (egcs-1.0.3 release) + *:sun4*:2.8.1|*:sun4*:egcs-2.90.*) + dnl Don't use -O2 with gcc 2.8.1 and egcs 1.0 under SPARC architectures + dnl without also using `-fno-schedule-insns'. + case "$CFLAGS" in + *-O2*|*-O3*) + case "$CFLAGS" in + *-fno-schedule-insns*) ;; + *) + AC_MSG_RESULT(yes) + AC_MSG_WARN([Don't use -O2 with gcc 2.8.1 and egcs 1.0 under SPARC architectures]) + AC_MSG_WARN([without also using -fno-schedule-insns.]) + AC_MSG_ERROR([Aborting due to known problem]) + ;; + esac + ;; + esac + ;; + dnl egcs-2.91.57 (egcs-1.1 release) + dnl egcs-2.91.66 (egcs-1.1.2 release) + Linux:alpha:egcs-2.91.*) + AC_MSG_RESULT(yes) + AC_MSG_WARN([There have been reports of egcs-1.1 not compiling XEmacs correctly on]) + AC_MSG_WARN([Alpha Linux. There have also been reports that egcs-1.0.3a is O.K.]) + AC_MSG_ERROR([Aborting due to known problem]) + ;; + *:i*86*:2.7.2*) + case "$CFLAGS" in + *-O2*|*-O3*) + case "$GCC_VERSION" in + 2.7.2) + case "$CFLAGS" in + *-fno-strength-reduce*) ;; + *) + AC_MSG_RESULT(yes) + AC_MSG_WARN([Don't use -O2 with gcc 2.7.2 under Intel/XXX without also using]) + AC_MSG_WARN([-fno-strength-reduce.]) + AC_MSG_ERROR([Aborting due to known problem]) + ;; + esac + ;; + esac + case "$CFLAGS" in + *-fno-caller-saves*) ;; + *) + AC_MSG_RESULT(yes) + AC_MSG_WARN([Don't use -O2 with gcc 2.7.2 under Intel/XXX without also using]) + AC_MSG_WARN([-fno-caller-saves.]) + AC_MSG_ERROR([Aborting due to known problem]) + ;; + esac + ;; + esac + ;; +esac +AC_MSG_RESULT(no) +fi + +dnl GNU ld now defaults to combreloc, which screws up unexec, but not pdump. +dnl Note that it's OK if the GNU style long option causes non-GNU ld to barf +dnl a usage message, that's often good enough. Please report it, though. +dnl #### Should make this Solaris-friendly. +dnl Link with -z nocombreloc for now. +if test "$enable_pdump" != "yes"; then + AC_MSG_CHECKING(for \"-z nocombreloc\" linker flag) + case "`ld --help 2>&1`" in + *-z\ nocombreloc* ) AC_MSG_RESULT(yes) + XE_PREPEND(-z nocombreloc, ld_switch_site) ;; + *) AC_MSG_RESULT(no) ;; + esac +fi + +dnl Inform compiler that certain flags are meant for the linker +XE_PROTECT_LINKER_FLAGS(ld_switch_system) +XE_PROTECT_LINKER_FLAGS(ld_switch_machine) +XE_PROTECT_LINKER_FLAGS(ld_switch_site) +XE_PROTECT_LINKER_FLAGS(LDFLAGS) +XE_PROTECT_LINKER_FLAGS(ld_call_shared) + +dnl Add s&m-determined objects (including unexec) to link line +test -n "$objects_machine" && XE_ADD_OBJS($objects_machine) +test -n "$objects_system" && XE_ADD_OBJS($objects_system) +test -n "$unexec" && test ! "$enable_pdump" = "yes" && XE_ADD_OBJS($unexec) +test "$enable_pdump" = "yes" && XE_ADD_OBJS(dumper.o) + +dnl Dynodump (Solaris 2.x, x<6) +AC_MSG_CHECKING(for dynodump) +if test "$unexec" != "unexsol2.o"; then + AC_MSG_RESULT(no) +else + AC_MSG_RESULT(yes) + AC_DEFINE(DYNODUMP) + XE_APPEND(dynodump, MAKE_SUBDIR) + XE_APPEND(dynodump, SRC_SUBDIR_DEPS) + case "$machine" in + sparc ) dynodump_arch=sparc ;; + *86* ) dynodump_arch=i386 ;; + powerpc ) dynodump_arch=ppc ;; + esac + dnl Dynodump requires the system linker + test "$GCC" = "yes" && XE_APPEND(-fno-gnu-linker, ld_switch_site) +fi + +dnl Feed s&m crud to src/Makefile + +dnl Linux/powerpc needs the following magic for some reason +dnl [Not needed with YellowDog 2.3 and causes link problems with YellowDog 3.0, +dnl the two most popular PowerPC distributions.] +dnl test "$machine$opsys" = "powerpclinux" && start_flags="-T $srcdir/src/ppc.ldscript" + +AC_LANG(C) +if test "$unexec" = "unexaix.o"; then +dnl AIX needs various hacks to make static linking work. + if test "$with_dynamic" = "no"; then + start_flags="-Wl,-bnso,-bnodelcsect" + test "$GCC" = "yes" && start_flags="-B/bin/ ${start_flags}" + for f in "/lib/syscalls.exp" "/lib/threads.exp"; do + if test -r "$f"; then start_flags="${start_flags},-bI:${f}"; fi + done + for f in "/usr/lpp/X11/bin/smt.exp" "/usr/bin/X11/smt.exp"; do + if test -r "$f"; then start_flags="${start_flags},-bI:${f}"; break; fi + done + AC_CHECK_LIB([c], [terminateAndUnload], [XE_APPEND(-lC, libs_system)]) + fi +elif test -n "$ld_text_start_addr"; then + start_flags="-T $ld_text_start_addr -e __start" +fi +AC_SUBST(start_flags) + +AC_SUBST(ld_switch_shared) +AC_SUBST(start_files) +if test "$ordinary_link" = "no" -a "$GCC" = "yes"; then + test -z "$linker" && linker='$(CC) -nostdlib' + test -z "$lib_gcc" && lib_gcc='`$(CC) -print-libgcc-file-name`' +fi +test "$GCC" != "yes" && lib_gcc= +AC_SUBST(ld) +AC_SUBST(lib_gcc) + +dnl --------------------------------------------------------------- +dnl Get version information for: +dnl C compiler, libc +dnl #### should do CC compiler, too, if different from XEMACS_CC +dnl --------------------------------------------------------------- + +compiler_version="" +gcc_compiler_specs="" +libc_version="" + +AC_MSG_CHECKING([for compiler version information]) + +dnl First try portable compilers, then crack system secrets +dnl #### Is this code correct if $XEMACS_CC != $CC? XEMACS_CC hasn't been +dnl run through the AC_PROG_CC mill. +dnl Would anybody really build libsrc with GCC and XEmacs with non-GCC? +if test "$GCC" = "yes"; then + compiler_version=`$XEMACS_CC --version | head -1` + gcc_compiler_specs=`$XEMACS_CC -v 2>&1 | sed 's/.* $[[^ ]]$/\1/' | head -1` +else case "$XEMACS_CC" in + dnl The Intel cc compiler + ic*) + compiler_version=`icc -V 2>&1 | head -1` + ;; + dnl non-gcc machine-specific magic - contributions welcome + *) case "$ac_cv_build" in + *-*-aix* ) + dnl Yes, it's this ugly for AIX... + realcc=`which $XEMACS_CC` + dnl Might be a symlink created by replaceCset command + if test -L $realcc ; then + ccdir=`dirname $realcc` + ccprog=`/bin/ls -l $realcc | sed 's/.* $[[^ ]]$/\1/'` + dnl This doesn't handle ../../xlc type stuff, but I've not seen one... + case $ccprog in + */*) realcc=$ccprog;; + *) realcc=$ccdir/$ccprog;; + esac + fi + lpp=`lslpp -wqc $realcc | cut -f2 -d:` + if test ! -z "$lpp" ; then + lppstr=`lslpp -Lqc $lpp` + lpplev=`echo "$lppstr" | cut -f3 -d:` + lppdesc=`echo "$lppstr" | cut -f8 -d:` + fi + if test ! -z "$lpplev" ; then + compiler_version="$lpp $lpplev - $lppdesc" + fi + ;; + + *-*-solaris*) + compiler_version=`$XEMACS_CC -V 2>&1 | head -1` + ;; + + alpha*-dec-osf*) + compiler_version=`$XEMACS_CC -V | tr '\n' ' '` + ;; + + mips-sgi-irix*) + compiler_version=`$XEMACS_CC -version` + ;; + esac + esac +fi + +dnl Awww, shucks. +if test -z "$compiler_version"; then + compiler_version="detection failed (please report this)" +fi + +AC_MSG_CHECKING(for standard C library version information) + +case "$ac_cv_build" in + *-*-linux*) + dnl #### who would ever _not_ be running the distro's libc? + dnl Maybe it would be better to get/augment this info with ldd? + if test -f /etc/redhat-release ; then + libc_version=`rpm -q glibc` + elif test -f /etc/debian_version ; then + libc_version=`dpkg-query --showformat='${version}' --show libc6` + libc_version="GNU libc $libc_version (Debian)" + dnl need SuSE et al checks here... + fi + dnl #### Tested on Debian, does this actually work elsewhere? ;-) + if test -z "$libc_version"; then + libc_version=`ls /lib/libc-*.so | sed -e 's,/lib/libc-$.*$\.so,\1,'` + fi + ;; + + *-*-aix*) + libc_version="bos.rte.libc `lslpp -Lqc bos.rte.libc | cut -f3 -d:`" + ;; + + *-*-solaris*) + libc=`pkginfo -l SUNWcsl | grep VERSION: | awk '{print $2}'` + libc_version="SUNWcsl $libc" + + ;; + + mips-sgi-irix*) + libc_version="IRIX libc `uname -sRm`" + ;; + + alpha*-dec-osf*) + dnl Another ugly case + (cd /usr/.smdb.; + libc_version=` grep -h libc.so *.inv | awk '$9 == "f" {print $12}' | tr '\n' ','` + ) + ;; +esac + +dnl Awww, shucks. +if test -z "libc_version"; then + libc_version="detection failed (please report this)" +fi + +dnl --------------------------------------------------------------- +dnl Add site and system specific flags to compile and link commands +dnl --------------------------------------------------------------- + +dnl --with-site-libraries (multiple dirs) +COLON_TO_SPACE(with_site_libraries) +if test -n "$with_site_libraries"; then + for arg in $with_site_libraries; do + case "$arg" in + -* ) ;; + * ) test -d "$arg" || \ + XE_DIE("Invalid site library \`$arg': no such directory") + arg="-L${arg}" ;; + esac + XE_APPEND($arg, ld_switch_site) + done +fi + +dnl --with-site-includes (multiple dirs) +COLON_TO_SPACE(with_site_includes) +if test -n "$with_site_includes"; then + for arg in $with_site_includes; do + case "$arg" in + -* ) ;; + * ) test -d "$arg" || \ + XE_DIE("Invalid site include \`$arg': no such directory") + arg="-I${arg}" ;; + esac + XE_APPEND($arg, c_switch_site) + done +fi + +dnl --with-site-prefixes (multiple dirs) +dnl --with-site-prefixes=dir1:dir2 is a convenient shorthand for +dnl --with-site-libraries=dir1/lib:dir2/lib --with-site-includes=dir1/include:dir2/include +dnl Site prefixes take precedence over the standard places, but not over +dnl with-site-includes and with-site-libraries. +COLON_TO_SPACE(with_site_prefixes) +if test -n "$with_site_prefixes"; then + for dir in $with_site_prefixes; do + lib_dir="${dir}/lib" + inc_dir="${dir}/include" + if test ! -d "$dir"; then + XE_DIE("Invalid site prefix \`$dir': no such directory") + elif test ! -d "$lib_dir"; then + XE_DIE("Invalid site prefix \`$dir': no such directory \`$lib_dir'") + else + if test -d "$inc_dir"; then + XE_APPEND("-I$inc_dir", c_switch_site) + fi + XE_APPEND("-L$lib_dir", ld_switch_site) + fi + done +fi + +dnl GNU software installs by default into /usr/local/{include,lib} +dnl if test -d "/usr/local/include" -a -d "/usr/local/lib"; then +dnl XE_APPEND("-L/usr/local/lib", ld_switch_site) +dnl XE_APPEND("-I/usr/local/include", c_switch_site) +dnl fi + +dnl Extra system-specific library directories - please add to list +for dir in "/usr/ccs/lib"; do + test -d "$dir" && XE_APPEND(-L${dir}, ld_switch_system) +done + +dnl --with-site-runtime-libraries (multiple dirs) +COLON_TO_SPACE(with_site_runtime_libraries) +if test -n "$with_site_runtime_libraries"; then + LD_RUN_PATH="`echo $with_site_runtime_libraries | sed -e 's/ */:/g'`" + export LD_RUN_PATH +fi + +dnl Linux systems have dynamic runtime library directories listed in +dnl /etc/ld.so.conf. Since those are used at run time, it seems pretty +dnl safe to use them at link time, and less controversial than forcing +dnl the run-time to use the link-time libraries. This also helps avoid +dnl mismatches between the link-time and run-time libraries. + +dnl #### Unfortunately, there are horrible libc4 and libc5 libraries +dnl listed in /etc/ld.so.conf on some systems, and including them on +dnl the link path leads to linking in utterly broken libc's. +dnl There are many clever ways of approaching this problem, +dnl but finding one that actually works... + +dnl if test -z "$LD_RUN_PATH" -a -r "/etc/ld.so.conf"; then +dnl for dir in `cat /etc/ld.so.conf`; do +dnl test -d "$dir" && XE_APPEND(-L${dir}, ld_switch_system) +dnl done +dnl add_runtime_path=no +dnl fi + +dnl ------------------------------------- +dnl Compute runtime library path +dnl ------------------------------------- + +if test -n "$add_runtime_path"; then :; +elif test "$with_dynamic" = "no"; then add_runtime_path=no +elif test -n "$LD_RUN_PATH"; then add_runtime_path=yes +else case "$opsys" in + sol2 | irix* | *bsd* | decosf* ) add_runtime_path=yes ;; + * ) add_runtime_path=no ;; + esac +fi + +if test "$add_runtime_path" = "yes"; then + dnl Try to autodetect runtime library flag (usually -R), + dnl and whether it works (or at least does no harm) + AC_MSG_CHECKING("for runtime libraries flag") + case "$opsys" in + sol2 ) dash_r="-R" ;; + decosf* | linux* | irix*) dash_r="-rpath " ;; + *) + dash_r="" + for try_dash_r in "-R" "-R " "-rpath "; do + xe_check_libs="${try_dash_r}/no/such/file-or-directory" + XE_PROTECT_LINKER_FLAGS(xe_check_libs) + AC_TRY_LINK(, , dash_r="$try_dash_r") + xe_check_libs="" + test -n "$dash_r" && break + done ;; + esac + if test -n "$dash_r"; + then AC_MSG_RESULT("\"${dash_r}\"") + else AC_MSG_RESULT(NONE) + fi +fi + +xe_add_unique_runpath_dir=' + xe_add_p=yes + for xe_dir in $runpath_dirs; do dnl Uniquify + test "$xe_dir" = "$xe_runpath_dir" && xe_add_p=no + done + if test "$xe_add_p" = "yes"; then + test -n "$runpath" && runpath="${runpath}:" + runpath="${runpath}${xe_runpath_dir}" + runpath_dirs="$runpath_dirs $xe_runpath_dir" + fi' + +XE_COMPUTE_RUNPATH() + +dnl ----------------------------------- +dnl Do some misc autoconf-special tests +dnl ----------------------------------- + +dnl Do the opsystem or machine files prohibit the use of the GNU malloc? +dnl Assume not, until told otherwise. +GNU_MALLOC=yes +if test "$with_dlmalloc" != "no"; then + doug_lea_malloc=yes +else + doug_lea_malloc=no +fi +after_morecore_hook_exists=yes +AC_CHECK_FUNC(malloc_set_state, ,doug_lea_malloc=no) +AC_MSG_CHECKING(whether __after_morecore_hook exists) +AC_TRY_LINK([extern void (* __after_morecore_hook)();],[__after_morecore_hook = 0], + [AC_MSG_RESULT(yes)], + [AC_MSG_RESULT(no) + after_morecore_hook_exists=no]) +if test "$system_malloc" = "yes" ; then + GNU_MALLOC=no + GNU_MALLOC_reason=" + - The GNU allocators don't work with this system configuration." +elif test "$with_system_malloc" = "yes" ; then + GNU_MALLOC=no + GNU_MALLOC_reason=" + - User chose not to use GNU allocators." +elif test "$with_debug_malloc" = "yes" ; then + GNU_MALLOC=no + GNU_MALLOC_reason=" + - User chose to use Debugging Malloc." +fi + +if test "$doug_lea_malloc" = "yes" -a "$GNU_MALLOC" = "yes" ; then + GNU_MALLOC_reason=" + - Using Doug Lea's new malloc from the GNU C Library." + AC_DEFINE(DOUG_LEA_MALLOC) + if test "$after_morecore_hook_exists" = "no" ; then + GNU_MALLOC_reason=" + - Using Doug Lea's new malloc from the Linux C Library." + AC_DEFINE(_NO_MALLOC_WARNING_) + fi +fi + +dnl #### mcheck is broken in all versions of Linux libc and glibc. +dnl Try this again when 2.1 hits the streets. +dnl Avoid using free-hook.c if support exists for malloc debugging in libc +dnl have_libmcheck=no +dnl if test "$error_check_malloc" = "yes" -a \ +dnl "$have_glibc" = "yes" -a \ +dnl "$doug_lea_malloc" = "yes"; then +dnl AC_CHECK_HEADERS(mcheck.h) +dnl AC_CHECK_LIB(mcheck, mcheck, have_libmcheck=yes, have_libmcheck=no) +dnl fi + +dnl if test "$have_libmcheck" = "yes"; then +dnl AC_DEFINE(HAVE_LIBMCHECK) +dnl libmcheck=-lmcheck +dnl AC_SUBST(libmcheck) +dnl fi + +dnl Some other nice autoconf tests. If you add a test here which +dnl should make an entry in src/config.h, do not forget to add an +dnl #undef clause to src/config.h.in for autoconf to modify. + +AC_PROG_RANLIB +AC_PROG_INSTALL +AC_PROG_YACC + +dnl checks for header files +AC_CHECK_HEADERS(dnl + a.out.h dnl + elf.h dnl + cygwin/version.h dnl + fcntl.h dnl + inttypes.h dnl + libgen.h dnl + locale.h dnl + wchar.h dnl + mach/mach.h dnl + sys/param.h dnl + sys/pstat.h dnl + sys/resource.h dnl + sys/time.h dnl + sys/timeb.h dnl + sys/times.h dnl + sys/un.h dnl + sys/vlimit.h dnl + ulimit.h dnl + unistd.h dnl +) +AC_HEADER_SYS_WAIT +AC_HEADER_STDC +AC_HEADER_TIME +AC_CHECK_DECLS([sys_siglist],,, +[#include <signal.h> +/* NetBSD declares sys_siglist in unistd.h. */ +#if HAVE_UNISTD_H +# include <unistd.h> +#endif +]) + + +dnl ---------------------------------------------------------------- +dnl Checking for utime() or utimes(). +dnl We prefer utime, since it is more standard. +dnl Some systems have utime.h but do not declare the struct anyplace, +dnl so we use a more sophisticated test for utime than AC_CHECK_FUNCS. +dnl ---------------------------------------------------------------- +AC_MSG_CHECKING(for utime) +AC_TRY_COMPILE([#include <sys/types.h> +#include <utime.h>], +[struct utimbuf x; x.actime = x.modtime = 0; utime ("/", &x);], + [AC_MSG_RESULT(yes) + AC_DEFINE(HAVE_UTIME)], + [AC_MSG_RESULT(no) + dnl We don't have utime(); how about utimes()? + AC_CHECK_FUNCS(utimes)]) + + +dnl checks for typedefs +AC_TYPE_SIGNAL +AC_TYPE_SIZE_T +AC_TYPE_PID_T +AC_TYPE_UID_T +AC_TYPE_MODE_T +AC_TYPE_OFF_T +AC_CHECK_TYPE(ssize_t, int) + +dnl not AC_CHECK_TYPE; lisp.h does hairy conditional typedef +if test "$ac_cv_header_inttypes_h" != "yes"; then +AC_MSG_CHECKING(for intptr_t in sys/types.h) +AC_TRY_COMPILE([#include <sys/types.h> +intptr_t x; +],[],[AC_MSG_RESULT(yes) + AC_DEFINE(HAVE_INTPTR_T_IN_SYS_TYPES_H,1)], + [AC_MSG_RESULT(no)]) +fi + +dnl check for Unix98 socklen_t +AC_MSG_CHECKING(for socklen_t) +AC_TRY_COMPILE([#include <sys/types.h> +#include <sys/socket.h> +socklen_t x; +],[],[AC_MSG_RESULT(yes)],[ +AC_TRY_COMPILE([#include <sys/types.h> +#include <sys/socket.h> +int accept (int, struct sockaddr *, size_t *); +],[],[ +AC_MSG_RESULT(size_t) +AC_DEFINE(socklen_t,size_t)], [ +AC_MSG_RESULT(int) +AC_DEFINE(socklen_t,int)])]) + +AC_MSG_CHECKING(for struct timeval) +AC_TRY_COMPILE([#ifdef TIME_WITH_SYS_TIME +#include <sys/time.h> +#include <time.h> +#else +#ifdef HAVE_SYS_TIME_H +#include <sys/time.h> +#else +#include <time.h> +#endif +#endif], [static struct timeval x; x.tv_sec = x.tv_usec;], + [AC_MSG_RESULT(yes) + HAVE_TIMEVAL=yes + AC_DEFINE(HAVE_TIMEVAL)], + [AC_MSG_RESULT(no) + HAVE_TIMEVAL=no]) + +dnl checks for structure members +AC_STRUCT_TM +AC_STRUCT_TIMEZONE + +dnl checks for compiler characteristics +AC_C_CONST + +dnl check for Make feature +AC_PROG_MAKE_SET + +dnl check byte order +AC_C_BIGENDIAN + +dnl define SIZEOF_TYPE +AC_CHECK_SIZEOF(short) +if test "$ac_cv_sizeof_short" = 0; then + echo "" + echo "*** PANIC *** Configure tests are not working - compiler is broken." + echo "*** PANIC *** Please examine config.log for compilation errors." + exit 1 +fi +AC_CHECK_SIZEOF(int) +AC_CHECK_SIZEOF(long) +AC_CHECK_SIZEOF(long long) +AC_CHECK_SIZEOF(void *) +AC_CHECK_SIZEOF(double) + +dnl check for long file names +AC_SYS_LONG_FILE_NAMES + +dnl -lm is required for floating point support, among other things +AC_CHECK_FUNC(sin, ,AC_CHECK_LIB(m, sin)) + +AC_TRY_LINK([#include <math.h>], + [return atanh(1.0) + asinh(1.0) + acosh(1.0); ], + AC_DEFINE(HAVE_INVERSE_HYPERBOLIC)) + +dnl See if mkstemp is available +AC_CHECK_FUNCS(mkstemp) + +dnl Determine type of mail locking from configure args and s&m headers +AC_CHECKING(type of mail spool file locking) +AC_CHECK_FUNCS(lockf flock) +dnl The mail_use_xxx variables are set according to the s&m headers. +test -z "$with_mail_locking" -a "$mail_use_flock" = "yes" && with_mail_locking=flock +test -z "$with_mail_locking" -a "$mail_use_lockf" = "yes" && with_mail_locking=lockf +test -z "$with_mail_locking" -a "$mail_use_locking" = "yes" && with_mail_locking=locking +if test -z "$with_mail_locking"; then + case "$opsys" in cygwin* | mingw*) + with_mail_locking=pop ;; + esac +fi + +if test "$with_mail_locking" = "lockf"; then AC_DEFINE(MAIL_LOCK_LOCKF) +elif test "$with_mail_locking" = "flock"; then AC_DEFINE(MAIL_LOCK_FLOCK) +elif test "$with_mail_locking" = "locking"; then AC_DEFINE(MAIL_LOCK_LOCKING) +elif test "$with_mail_locking" = "pop"; then + with_pop=yes + with_mail_locking= +elif test "$with_mail_locking" = "mmdf"; then AC_DEFINE(MAIL_LOCK_MMDF) +else with_mail_locking="file"; AC_DEFINE(MAIL_LOCK_DOT) +fi +test "$with_mail_locking" = "lockf" -a "$ac_cv_func_lockf" != "yes" && \ + XE_DIE("lockf mail locking requested but not available.") +test "$with_mail_locking" = "flock" -a "$ac_cv_func_flock" != "yes" && \ + XE_DIE("flock mail locking requested but not available.") +test "$with_mail_locking" = "locking" -a "$ac_cv_func_locking" != "yes" && \ + XE_DIE("locking mail locking requested but not available.") + +case "$opsys" in decosf*) + AC_CHECK_LIB(pthreads, cma_open) + test "$ac_cv_lib_pthreads_cma_open" = "yes" && \ + c_switch_site="$c_switch_site -threads" ;; +esac + +dnl ---------------------------------------------------------------- +dnl Miscellaneous flags +dnl ---------------------------------------------------------------- + +AC_MSG_CHECKING(whether the -xildoff compiler flag is required) +if ${CC-cc} '-###' -xildon no_such_file.c 2>&1 | grep '^[^ ]*/ild ' > /dev/null ; then + if ${CC-cc} '-###' -xildoff no_such_file.c 2>&1 | grep '^[^ ]*/ild ' > /dev/null ; + then AC_MSG_RESULT(no); + else AC_MSG_RESULT(yes); XE_APPEND(-xildoff, ld_switch_site) + fi + else AC_MSG_RESULT(no) +fi + +dnl Link with "-z ignore" on Solaris if supported +if test "$opsys" = "sol2"; then + if test "$os_release" -ge 506; then + AC_MSG_CHECKING(for \"-z ignore\" linker flag) + case "`ld -h 2>&1`" in + *-z\ ignore\|record* ) AC_MSG_RESULT(yes) + XE_PREPEND(-z ignore, ld_switch_site) ;; + *) AC_MSG_RESULT(no) ;; + esac + fi +fi + +dnl ---------------------- +dnl Choose a window system +dnl ---------------------- + +AC_CHECKING("for specified window system") + +dnl Autodetection of Gdk libraries and includes +dnl ------------------------------------------- +dnl On some systems (FreeBSD springs to mind), they use +dnl versions on the utility routines, so instead of gtk-config +dnl you must use gtk12-config, etc, etc. + +GNOME_CONFIG=no +GTK_CONFIG=no + +if test "$with_gnome" != "no"; then + AC_MSG_CHECKING(for GNOME configuration script) + for possible in gnome-config + do + possible_version=`${possible} --version 2> /dev/null` + if test "x${possible_version}" != "x"; then + GNOME_CONFIG="${possible}" + with_gnome=yes + with_gtk=yes + break + fi + done + AC_MSG_RESULT([${GNOME_CONFIG}]) +fi + +if test "${GNOME_CONFIG}" != "no"; then + GNOME_LIBS=`${GNOME_CONFIG} --libs gnomeui` + GNOME_CFLAGS=`${GNOME_CONFIG} --cflags gnomeui` + AC_DEFINE(HAVE_GNOME) + XE_APPEND(${GNOME_LIBS}, libs_gtk) + XE_APPEND(${GNOME_CFLAGS}, c_switch_gtk) +fi + +if test "$with_gtk" != "no";then + AC_MSG_CHECKING(for GTK configuration script) + for possible in gtk12-config gtk14-config gtk-config + do + possible_version=`${possible} --version 2> /dev/null` + if test "x${possible_version}" != "x"; then + GTK_CONFIG="${possible}" + case "${possible_version}" in + 1.0.*) AC_MSG_WARN([GTK 1.2 is required, please upgrade your version of GTK.]); with_gtk=no;; + 1.3.*) AC_MSG_WARN([GTK 1.3 is not supported right now]); with_gtk=no;; + 1.2.*) + with_gtk=yes + break + ;; + *) AC_MSG_WARN([Found unsupported version of GTK: $possible_version]);; + esac + fi + done + AC_MSG_RESULT([${GTK_CONFIG}]) +fi + +if test "${GTK_CONFIG}" != "no"; then + AC_MSG_CHECKING(gtk version) + GTK_VERSION=`${GTK_CONFIG} --version` + AC_MSG_RESULT(${GTK_VERSION}) + + AC_MSG_CHECKING(gtk libs) + GTK_LIBS=`${GTK_CONFIG} --libs` + XE_APPEND(${GTK_LIBS}, libs_gtk) + AC_MSG_RESULT(${GTK_LIBS}) + + AC_MSG_CHECKING(gtk cflags) + GTK_CFLAGS=`${GTK_CONFIG} --cflags` + if test "$GCC" = "yes"; then + GTK_CFLAGS="${GTK_CFLAGS} -Wno-shadow" + fi + XE_APPEND(${GTK_CFLAGS}, c_switch_gtk) + AC_MSG_RESULT(${GTK_CFLAGS}) + + AC_CHECK_LIB(gdk_imlib, main, XE_PREPEND(-lgdk_imlib, libs_gtk)) + AC_CHECK_LIB(Imlib, Imlib_init, XE_APPEND(-lImlib, libs_gtk)) + AC_CHECK_FUNCS(gdk_imlib_init) + + AC_DEFINE(HAVE_XPM) + AC_DEFINE(HAVE_GTK) + AC_SUBST(GTK_CONFIG) + + window_system=gtk + with_gtk=yes + if test "$with_x11" != "no"; then + AC_MSG_WARN([Configuring GTK, forcing with_x11 to no]) + with_x11=no + fi + + for feature in scrollbars toolbars menubars dialogs widgets + do + eval "feature_value=\${enable_${feature}}" + case "${feature_value}" in + yes|no|gtk|"" ) + ;; + * ) + feature_conflict_with_gtk=yes + AC_MSG_WARN([--enable-${feature}=${feature_value} is incompatible with --with-gtk]) ;; + esac + done + if test "${feature_conflict_with_gtk}" = "yes"; then + XE_DIE(["One or more GUI toolkit features conflict with GTK"]) + fi + + test "${enable_scrollbars}" != "no" && enable_scrollbars=gtk + test "${enable_toolbars}" != "no" && enable_toolbars=gtk + test "${enable_menubars}" != "no" && enable_menubars=gtk + test "${enable_dialogs}" != "no" && enable_dialogs=gtk + test "${enable_widgets}" != "no" && enable_widgets=gtk + + dnl Check for libglade support (it rocks) + OLD_CFLAGS="${CFLAGS}" + OLD_CPPFLAGS="${CPPFLAGS}" + OLD_LDFLAGS="${LDFLAGS}" + CFLAGS="${GTK_CFLAGS} ${CFLAGS}" + CPPFLAGS="${GTK_CFLAGS} ${CFLAGS}" + LDFLAGS="${LDFLAGS} ${GTK_LIBS}" + AC_CHECK_HEADERS(glade/glade.h glade.h) + AC_CHECK_LIB(xml, main, XE_PREPEND(-lxml, libs_gtk)) + AC_CHECK_LIB(glade, main, XE_PREPEND(-lglade, libs_gtk)) + AC_CHECK_LIB(glade-gnome, main, XE_PREPEND(-lglade-gnome, libs_gtk)) + AC_EGREP_HEADER([char \*txtdomain;], [glade/glade-xml.h], + [AC_MSG_RESULT(yes) + AC_DEFINE(LIBGLADE_XML_TXTDOMAIN,1)], + [AC_MSG_RESULT(no)]) + CFLAGS="${OLD_CFLAGS}" + CPPFLAGS="${OLD_CPPFLAGS}" + LDFLAGS="${OLD_LDFLAGS}" +fi + +dnl We may eventually prefer gtk/gdk over vanilla X11... + +if test "$with_x11" != "no"; then + dnl User-specified --x-includes or --x-libraries implies --with-x11. + test "$x_includes $x_libraries" != "NONE NONE" && \ + window_system=x11 with_x11=yes + + dnl Autodetection of X11 libraries and includes + dnl ------------------------------------------- + dnl AC_PATH_XTRA thinks it can find our X headers and includes, but + dnl it often gets it wrong, so we only use it as a last resort. + + dnl $OPENWINHOME implies --x-includes and --x-libraries + dnl Not (yet) handled by autoconf2 + if test "$x_includes $x_libraries" = "NONE NONE" \ + -a -n "$OPENWINHOME" \ + -a "$OPENWINHOME" != "/usr/openwin" \ + -a -d "$OPENWINHOME"; then + test -d "$OPENWINHOME/lib" && x_libraries="$OPENWINHOME/lib" + test -d "$OPENWINHOME/include" && x_includes="$OPENWINHOME/include" + test -d "$OPENWINHOME/share/include" && x_includes="$OPENWINHOME/share/include" + fi + + if test "$x_includes" = "NONE"; then + dnl AC_PATH_XTRA often guesses /usr/include, when some other + dnl include directory is a MUCH better guess (Linux, HP-UX 10.20). + dnl This is a workaround for idiot (esp. HP) system vendors, who + dnl provide a /usr/include/X11, but DON'T FULLY POPULATE IT. + for dir in "/usr/X11" "/usr/X11R6"; do + if test -d "$dir/include/X11"; then x_includes="$dir/include"; break; fi + done + fi + + if test "$x_libraries" = "NONE"; then + for dir in "/usr/X11/lib" "/usr/X11R6/lib" "/usr/lib/X11R6"; do + if test -r "$dir/libX11.a"; then x_libraries="$dir"; break; fi + done + fi + + AC_PATH_XTRA # Autoconf claims to find X library and include dirs for us. + if test "$no_x" = "yes" + then with_x11=no window_system=none HAVE_X_WINDOWS=no + else with_x11=yes window_system=x11 HAVE_X_WINDOWS=yes + fi +fi + +dnl #### wmperry:: !x11 != NONE +dnl case "$with_x11" in +dnl yes ) window_system=x11 HAVE_X_WINDOWS=yes ;; +dnl no ) window_system=none HAVE_X_WINDOWS=no ;; +dnl esac + +if test "$with_x11" = "yes"; then + AC_DEFINE(HAVE_X_WINDOWS) + XE_APPEND(lwlib, MAKE_SUBDIR) + XE_APPEND(lwlib, SRC_SUBDIR_DEPS) + + dnl Look for Motif, but only if not found in $x_includes and $x_libraries + AC_CHECK_HEADER(Xm/Xm.h, [AC_CHECK_LIB(Xm, XmStringFree, got_motif=yes)]) + + if test "$got_motif" != "yes"; then + dnl Try to find Motif/CDE/Tooltalk dirs + dnl These take precedence over other X libs/includes, so PRE-pend + for lib_dir in "/usr/dt/lib" "/usr/lib/Motif2.1" \ + "/usr/lib/Motif1.2" "/usr/lib/Motif1.1"; do + inc_dir=`echo $lib_dir | sed -e 's/lib/include/'` + if test -d "$lib_dir" -a -d "$inc_dir"; then + case "$x_libraries" in *"$lib_dir"* ) ;; *) + x_libraries="$lib_dir $x_libraries" + XE_PREPEND(-L${lib_dir}, X_LIBS) ;; + esac + case "$x_includes" in "$inc_dir"* ) ;; *) + x_includes="$inc_dir $x_includes" + XE_PREPEND(-I${inc_dir}, X_CFLAGS) ;; + esac + break; dnl only need ONE Motif implementation! + fi + done + fi + + dnl Contrib X libs/includes do NOT take precedence, so AP-pend + for rel in "X11R6" "X11R5" "X11R4"; do + lib_dir="/usr/contrib/$rel/lib" inc_dir="/usr/contrib/$rel/include" + if test -d "$lib_dir" -a -d "$inc_dir"; then + case "$x_libraries" in *"$lib_dir"* ) ;; *) + x_libraries="$x_libraries $lib_dir" + XE_APPEND(-L${lib_dir}, X_LIBS) + esac + case "$x_includes" in "$inc_dir"* ) ;; *) + x_includes="$x_includes $inc_dir" + XE_APPEND(-I${inc_dir}, X_CFLAGS) + esac + break; dnl Only need ONE X11 implementation ! + fi + done + + dnl Avoid version mismatch for shared library libXm.so on osf4 + case "$opsys" in + decosf*) if test "$GCC" = yes -a -d /usr/shlib; then XE_APPEND(-L/usr/shlib, X_LIBS); fi ;; + esac + + ld_switch_x_site="$X_LIBS" + + XE_COMPUTE_RUNPATH() + + if test "$extra_verbose" = "yes"; then + echo; echo "X11 compilation variables:" + PRINT_VAR(x_libraries x_includes X_CFLAGS X_LIBS X_PRE_LIBS X_EXTRA_LIBS) + echo + fi + + dnl Set up bitmaps search path. + dnl The original suggestion was to unconditionally to append X11/bitmaps + dnl to each element of $x_includes, I'm pretty sure this is the wrong + dnl thing to do. We test for bitmaps and X11/bitmaps directories on each + dnl element and add them to BITMAPDIR if they exist. + bitmapdirs= + if test "$x_includes" != NONE; then + for i in $x_includes; do + if test -d "$i/bitmaps"; then + bitmapdirs="$i/bitmaps:$bitmapdirs" + fi + if test -d "$i/X11/bitmaps"; then + bitmapdirs="$i/X11/bitmaps:$bitmapdirs" + fi + done + bitmapdirs=`echo "$bitmapdirs" | sed s/.$//` + fi + test ! -z "$bitmapdirs" && AC_DEFINE_UNQUOTED(BITMAPDIR, "$bitmapdirs") + + dnl Autodetect defines extracted from X config by xmkmf, e.g. NARROWPROTO + AC_CHECKING(for X defines extracted by xmkmf) + rm -fr conftestdir + if mkdir conftestdir; then + cd conftestdir + cat > Imakefile <<'EOF' +xetest: + ＠echo ${PROTO_DEFINES} ${STD_DEFINES} +EOF + if (xmkmf) >/dev/null 2>/dev/null && test -f Makefile; then + # GNU make sometimes prints "make[1]: Entering...", which would confuse us. + xmkmf_defines=`${MAKE-make} xetest 2>/dev/null | grep -v make` + fi + cd .. + rm -fr conftestdir + for word in $xmkmf_defines; do + case "$word" in + -D__STDC__*) ;; + -D* ) + sym=`echo '' $word | sed -e 's:^ *-D::' -e 's:=.*::'` + case "$word" in + -D*=* ) val=`echo '' $word | sed -e 's:^.*=::'` ;; + * ) val=1 ;; + esac +dnl Avoid re-AC_DEFINE-ing xmkmf symbols we've already defined above. + if grep "^#define $sym " confdefs.h >/dev/null; then :; else + if test "$val" = "1" + then AC_DEFINE_UNQUOTED($sym) + else AC_DEFINE_UNQUOTED($sym,$val) + fi + fi ;; + esac + done + fi + + dnl make sure we can find Intrinsic.h + AC_CHECK_HEADER(X11/Intrinsic.h, , + [AC_MSG_ERROR([Unable to find X11 header files.])]) + + dnl -lXt and -lX11 are required + dnl Some broken systems require the magic "-b i486-linuxaout" flag + AC_CHECK_LIB(X11, XOpenDisplay, have_lib_x11=yes) + if test "$have_lib_x11" != "yes"; then + AC_CHECK_LIB(X11, XGetFontProperty, + ld_switch_x_site="-b i486-linuxaout $ld_switch_x_site", + [AC_MSG_ERROR([Unable to find X11 libraries.])], + -b i486-linuxaout) + fi + libs_x="-lX11" + test "$extra_verbose" = "yes" && echo " Setting libs_x to \"-lX11\"" + + dnl Autodetect -lXext + AC_CHECK_LIB(Xext, XShapeSelectInput, XE_PREPEND(-lXext, libs_x)) + + dnl Require -lXt + AC_CHECK_LIB(Xt, XtOpenDisplay, XE_PREPEND(-lXt, libs_x), + AC_MSG_ERROR([Unable to find X11 libraries.])) + + AC_MSG_CHECKING(the version of X11 being used) + AC_RUN_IFELSE([AC_LANG_SOURCE([#include <X11/Intrinsic.h> + int main(int c, char *v[]) { return c>1 ? XlibSpecificationRelease : 0; }])], + [./conftest foobar; x11_release=$?],[x11_release=4],[x11_release=4]) + AC_MSG_RESULT(R${x11_release}) + AC_DEFINE_UNQUOTED(THIS_IS_X11R${x11_release}) + + if test "${x11_release}" = "4"; then + case "$enable_widgets" in + "" | "no") enable_widgets=no ;; + *) XE_DIE("Widget support requires X11R5 or greater") ;; + esac + fi + + AC_CHECK_FUNCS(XConvertCase) + + AC_CHECK_HEADERS(X11/Xlocale.h) + + dnl XFree86 has a non-standard prototype for this X11R6 function + AC_CHECK_FUNCS(XRegisterIMInstantiateCallback) + AC_MSG_CHECKING(for standard XRegisterIMInstantiateCallback prototype) + AC_TRY_COMPILE([ +#define NeedFunctionPrototypes 1 +#include <X11/Xlib.h> +extern Bool XRegisterIMInstantiateCallback( + Display*, struct _XrmHashBucketRec*, char*, char*, XIMProc, XPointer*); +], [], + [AC_MSG_RESULT(yes)], + [AC_MSG_RESULT(no) + AC_DEFINE(XREGISTERIMINSTANTIATECALLBACK_NONSTANDARD_PROTOTYPE)]) + + dnl autodetect -lXmu + test -z "$with_xmu" && { AC_CHECK_LIB(Xmu, XmuReadBitmapDataFromFile, + with_xmu=yes, with_xmu=no) } + if test "$with_xmu" = "no"; then + XE_ADD_OBJS(xmu.o) + else + XE_PREPEND(-lXmu, libs_x) + AC_DEFINE(HAVE_XMU) + fi + + dnl Autodetect -lXbsd + dnl #### Someone, please add a better function than main + AC_CHECK_LIB(Xbsd, main, XE_PREPEND(-lXbsd, libs_x)) + + dnl Problem with the MIT distribution of X on AIX + if test "$unexec" = "unexaix.o" -a "$x11_release" = "6"; then + dnl X11R6 requires thread-safe code on AIX for some reason + if test "$GCC" = "yes"; then + XE_PREPEND(-mthreads, X_CFLAGS) + XE_PREPEND(-mthreads, libs_x) + else + case "$CC" in + "xlc" ) CC="xlc_r" ;; + "xlC" ) CC="xlC_r" ;; + "cc" ) CC="cc_r" ;; + esac + fi + fi + +fi dnl $with_x11 = yes + +if test "$with_msw" != "no"; then + AC_CHECKING(for MS-Windows) + AC_CHECK_LIB(gdi32,main,with_msw=yes) + if test "$with_msw" = "yes"; then + AC_DEFINE(HAVE_MS_WINDOWS) + + dnl The net installer only works with MS-Windows currently + if test "$with_netinstall" = "yes"; then + XE_APPEND(netinstall, MAKE_SUBDIR) + XE_APPEND(netinstall, SRC_SUBDIR_DEPS) + XE_APPEND(netinstall, INSTALL_ARCH_DEP_SUBDIR) + fi + + install_pp="$srcdir/lib-src/installexe.sh" + XE_APPEND(-limm32 -lshell32 -lgdi32 -luser32 -lcomdlg32 -lcomctl32 -lole32 -luuid -lwinspool -lmpr, libs_system) + if test "$with_dragndrop" != no; then + XE_APPEND(msw, dragndrop_proto) + with_dragndrop=yes + fi + if test "$window_system" != x11; then + window_system=msw + test "$enable_scrollbars" != "no" && enable_scrollbars=msw + test "$enable_menubars" != "no" && enable_menubars=msw + test "$enable_toolbars" != "no" && enable_toolbars=msw + test "$enable_dialogs" != "no" && enable_dialogs=msw + test "$enable_widgets" != "no" && enable_widgets=msw + fi + dnl check for our special version of select + AC_RUN_IFELSE([AC_LANG_SOURCE([#include <fcntl.h> + int main() { return (open("/dev/windows", O_RDONLY, 0) > 0)? 0 : 1; }])], + [AC_DEFINE(HAVE_MSG_SELECT)]) + fi +fi + +AC_SUBST(install_pp) + +test -z "$with_dragndrop" && with_dragndrop="$with_dragndrop_default" +test -z "$window_system" && window_system="none" + +dnl Test for features that require a window system - ANY window system +if test "$window_system" = "none"; then + for feature in menubars scrollbars toolbars dialogs dragndrop xface + do + if eval "test -n \"\$enable_${feature}\" -a \"\$enable_${feature}\" != no" ; then + AC_MSG_WARN([--enable-$feature ignored: Not valid without window system support]) + fi + eval "enable_${feature}=no" + done +else + test -z "$enable_toolbars" && enable_toolbars=yes +fi + +dnl ### Test for features that require mswindows support - currently none +dnl ### MS-Windows folks: add code here..... (martin) +if test "$with_msw" != "yes"; then + for feature in MARTIN_IS_CLUELESS_ABOUT_MSW_FEATURES + do + if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then + AC_MSG_WARN([--with-$feature ignored: Not valid without MS-Windows support]) + fi + eval "with_${feature}=no" + done +else +: +fi + +dnl Test for features that require X11 support +if test "$with_x11" != "yes"; then + dnl It ought to be reasonable to have no output device at all, and only use + dnl XEmacs in --batch mode. + dnl if test "$with_tty" = "no" ; then + dnl AC_MSG_ERROR([No window system support and no TTY support - Unable to proceed.]) + dnl fi + for feature in tooltalk cde offix wmcommand xim xmu nas_sound + do + if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then + AC_MSG_WARN([--with-$feature ignored: Not valid without X support]) + fi + eval "with_${feature}=no" + done +fi + +dnl Balloon Help requires the Shape extension, not available everywhere, +dnl for example not on AIX 4.3. +if test "$with_x11" = "yes"; then + AC_CHECK_HEADER(X11/extensions/shape.h, [ + AC_DEFINE(HAVE_BALLOON_HELP) + ]) +fi + +dnl FSF 19.29 has some bitmapdir stuff here. +bitmapdir= + +case "$window_system" in + x11 ) HAVE_X_WINDOWS=yes; echo " Using X11." ;; + msw ) HAVE_X_WINDOWS=no ; echo " Using MS-Windows." ;; + gtk ) + HAVE_X_WINDOWS=no + test "$with_gnome" = "yes" && echo " Using GNOME." + test "$with_gnome" = "no" && echo " Using GTK." + ;; + none ) HAVE_X_WINDOWS=no ; echo " Using no window system." ;; +esac + +case "$x_libraries" in *X11R4* ) + test "$opsys" = "hpux9" && opsysfile="s/hpux9-x11r4.h" + test "$opsys" = "hpux9-shr" && opsysfile="s/hpux9shxr4.h" +esac + +dnl Enable or disable proper handling of WM_COMMAND +AC_CHECKING(for WM_COMMAND option); +dnl if test "$with_wmcommand" = "yes"; then +if test "$with_wmcommand" != "no"; then + AC_DEFINE(HAVE_WMCOMMAND) +fi + +dnl Autodetect Xauth +dnl -lXau is only used by gnuclient, so use a special variable for Xauth X libs +test -z "$with_xauth" && test "$window_system" = "none" && with_xauth=no +test -z "$with_xauth" && { AC_CHECK_HEADER(X11/Xauth.h, ,with_xauth=no) } +test -z "$with_xauth" && { AC_CHECK_LIB(Xau, XauGetAuthByAddr,[:],with_xauth=no) } +test -z "$with_xauth" && with_xauth=yes +if test "$with_xauth" = "yes"; then + AC_DEFINE(HAVE_XAUTH) + XE_SPACE(libs_xauth, $GTK_LIBS $X_EXTRA_LIBS -lXau $libs_x $X_PRE_LIBS) +fi +AC_SUBST(libs_xauth) + +dnl This one is for the static initializeds variables in +dnl offix.c, so that the thing is dumped after lastfile.o +AC_SUBST(dnd_objs) + +dnl Autodetect dll support + +dnl If g++ is used, we have to explicitly link modules with -lstdc++ on Cygwin +dnl to avoid undefined symbol errors. This will never hurt, so just do it on +dnl all platforms in case others have the same brain damage. +if test "$with_xemacs_compiler" = "g++"; then + LIBSTDCPP=-lstdc++ +else + LIBSTDCPP= +fi +AC_SUBST(LIBSTDCPP) + +dnl This must come before the detection code for anything that is in a module +if test "$enable_modules" != "no"; then + AC_CHECKING(for module support) + + case "$opsys" in + mingw* | cygwin* ) have_dl=yes ;; + darwin ) have_dl=yes + AC_DEFINE(HAVE_DYLD) + ;; + * ) + dnl Check for the ELFish dlopen() + AC_CHECK_HEADER(dlfcn.h, [ + AC_MSG_CHECKING([for dlopen in -lc]) + AC_TRY_LINK([#include <dlfcn.h>],dnl + [dlopen ("", 0);], [ have_dl=yes ], [ + AC_MSG_CHECKING([for dlopen in -ldl]) + ac_save_LIBS="$LIBS" + LIBS="$LIBS -ldl" + AC_TRY_LINK([#include <dlfcn.h>],dnl + [dlopen ("", 0);], [ have_dl=yes ], [ + AC_MSG_CHECKING([for dlopen in -lsvld]) + LIBS="$ac_save_LIBS -lsvld" + AC_TRY_LINK([#include <dlfcn.h>],dnl + [dlopen ("", 0);], [ have_dl=yes ], [LIBS="$ac_save_LIBS"])])])]) + if test "$have_dl" = "yes"; then + AC_DEFINE(HAVE_DLOPEN) + else + dnl Check for HP/UX shl_load + AC_CHECK_HEADER(dl.h, [ + AC_MSG_CHECKING([for shl_load in -lc]) + AC_TRY_LINK([#include <dl.h>],dnl + [shl_load ("", 0, 0);], [have_dl=yes], [ + AC_MSG_CHECKING([for shl_load in -ldl]) + ac_save_LIBS="$LIBS" + LIBS="$LIBS -ldld" + AC_TRY_LINK([#include <dl.h>],dnl + [shl_load ("", 0, 0);], [have_dl=yes], [LIBS="$ac_save_LIBS"])])]) + if test "$have_dl" = "yes"; then + AC_DEFINE(HAVE_SHL_LOAD) + else + dnl Check for libtool's libltdl + AC_CHECK_HEADER(ltdl.h, [ + AC_MSG_CHECKING([for lt_dlinit in -lltdl]) + ac_save_LIBS="$LIBS" + LIBS="$LIBS -lltdl" + AC_TRY_LINK([#include <ltdl.h>],dnl + [lt_dlinit ();], [have_dl=yes], [LIBS="$ac_save_LIBS"])]) + if test "$have_dl" = "yes"; then + AC_DEFINE(HAVE_LTDL) + fi + dnl end !HP/UX + fi + dnl end !dlopen + fi + ac_save_LIBS= + dnl end !darwin + esac + + if test -n "$have_dl"; then + dnl XE_SHLIB_STUFF (in aclocal.m4) defines $can_build_shared + XE_SHLIB_STUFF + fi + + if test "$can_build_shared" = "yes"; then + AC_DEFINE(HAVE_SHLIB) + dnl src must be built before modules on MacOSX and Windows platforms, since + dnl the binary must be available to properly link the modules + dnl For no-module builds, this is added *after* the module directories + XE_APPEND(src, MAKE_SUBDIR) + XE_APPEND(src, INSTALL_ARCH_DEP_SUBDIR) + test -n "$libdl" && XE_PREPEND(-l${libdl}, LIBS) + AC_CHECK_FUNCS(dlerror _dlerror) + enable_modules=yes + MOD_CC="../../lib-src/ellcc" + MODCFLAGS="\$(CFLAGS) --mode=compile --mod-output=\$＠ -I../../src -I\$(srcdir)/../../src" + INSTALLPATH="\$(moduledir)" + MOD_INSTALL_PROGRAM=${INSTALL_PROGRAM} + OBJECT_TO_BUILD="\$(MODNAME).ell" + else + if test "$enable_modules" = "yes"; then + XE_DIE("Required module support cannot be provided.") + else + echo " No module support." + fi + enable_modules=no + fi +fi +if test "$enable_modules" != "yes"; then + MOD_CC="$XEMACS_CC" + MODCFLAGS="\$(XE_CFLAGS) -I../../src -I\$(srcdir)/../../src" + INSTALLPATH="" + MOD_INSTALL_PROGRAM="true" + OBJECT_TO_BUILD="\$(MODNAME).o" +fi +MODARCHDIR= +MAKE_DOCFILE="../../lib-src/make-docfile" +AC_SUBST(with_modules, $enable_modules) +AC_SUBST(MOD_CC) +AC_SUBST(MODARCHDIR) +AC_SUBST(MAKE_DOCFILE) +AC_SUBST(MODCFLAGS) +AC_SUBST(INSTALLPATH) +AC_SUBST(MOD_INSTALL_PROGRAM) +AC_SUBST(OBJECT_TO_BUILD) + +dnl Autodetect tooltalk +if test "$with_tooltalk" != "no" ; then + dnl autodetect the location of tt_c.h + dnl tt_c.h might be in Tt or desktop include directories + for dir in "" "Tt/" "desktop/" ; do + AC_CHECK_HEADER(${dir}tt_c.h, tt_c_h_file="${dir}tt_c.h"; break) + done + if test -z "$tt_c_h_file"; then + if test "$with_tooltalk" = "yes"; then + USAGE_ERROR("Unable to find required tooltalk header files.") + fi + with_tooltalk=no + fi +fi +if test "$with_tooltalk" != "no" ; then + for extra_libs in "" "-lI18N -lce" "-lcxx"; do + AC_CHECK_LIB(tt, tt_message_create, + tt_libs="-ltt $extra_libs"; break, [:],$extra_libs) + done + if test -z "$tt_libs"; then + if test "$with_tooltalk" = "yes"; then + USAGE_ERROR("Unable to find required tooltalk libraries.") + fi + with_tooltalk=no + fi +fi +test -z "$with_tooltalk" && with_tooltalk=yes +if test "$with_tooltalk" = "yes"; then + AC_DEFINE(TOOLTALK) + AC_DEFINE_UNQUOTED(TT_C_H_FILE, "$tt_c_h_file") + XE_PREPEND($tt_libs, libs_x) +fi + +dnl Autodetect CDE +test -z "$with_cde" && { AC_CHECK_HEADER(Dt/Dt.h, , with_cde=no) } +test -z "$with_cde" && { AC_CHECK_LIB(DtSvc, DtDndDragStart, [:], with_cde=no) } +if test "$with_dragndrop" = "no" ; then + if test "$with_cde" = "yes" ; then + AC_MSG_WARN([--with-cde forced to \`no'; no generic Drag'n'Drop support]) + fi + with_cde=no +fi +test -z "$with_cde" && with_cde=yes +if test "$with_cde" = "yes" ; then + AC_DEFINE(HAVE_CDE) + XE_PREPEND(-lDtSvc, libs_x) + XE_APPEND(CDE, dragndrop_proto) + with_tooltalk=yes # CDE requires Tooltalk + need_motif=yes # CDE requires Motif +fi + +dnl Always compile OffiX unless --without-offix is given, no +dnl X11 support is compiled in, no standard Xmu is available, +dnl or dragndrop support is disabled +dnl Because OffiX support currently loses when more than one display +dnl is in use, we now disable it by default -slb 07/10/1998. +test "$window_system" != "x11" && with_offix=no +if test "$with_xmu" != yes -a "$with_x11" = yes; then + if test "$with_offix" = "yes" ; then + AC_MSG_WARN([--with-offix forced to \`no'; no real Xmu support]) + fi + with_offix=no +fi +if test "$with_dragndrop" = no; then + if test "$with_offix" = "yes" ; then + AC_MSG_WARN([--with-offix forced to \`no'; no generic Drag'n'Drop support]) + fi + with_offix=no +fi +if test "$with_cde" = yes; then + if test "$with_offix" = "yes" ; then + AC_MSG_WARN([--with-offix forced to \`no'; CDE already found]) + fi + with_offix=no +fi +test -z "$with_offix" && with_offix=no +if test "$with_offix" = "yes"; then + AC_DEFINE(HAVE_OFFIX_DND) + XE_APPEND(offix.o, dnd_objs) + XE_APPEND(OffiX, dragndrop_proto) +fi +if test "$with_gtk" = "yes"; then + XE_APPEND(GTK, dragndrop_proto) +fi + +dnl Autodetect Drag'n'Drop support +dnl always included if CDE, Offix, or MSWindows are defined +if test "$with_dragndrop" != "no" ; then + AC_MSG_CHECKING(if drag and drop API is needed) + if test -n "$dragndrop_proto" ; then + with_dragndrop=yes + AC_MSG_RESULT([yes (${dragndrop_proto} )]) + AC_DEFINE(HAVE_DRAGNDROP) + XE_APPEND(dragdrop.o, extra_objs) + else + with_dragndrop=no + AC_MSG_RESULT(no) + fi +fi + +dnl Autodetect LDAP +AC_CHECKING(for LDAP) +ldap_libs= +test -z "$with_ldap" && { AC_CHECK_HEADER(ldap.h, ,with_ldap=no) } +test -z "$with_ldap" && { AC_CHECK_HEADER(lber.h, ,with_ldap=no) } +if test "$with_ldap" != "no"; then + AC_CHECK_LIB(ldap, ldap_search, with_ldap=yes) + dnl Check for other libraries we need to link with to get the main routines. + test "$with_ldap" != "yes" && { AC_CHECK_LIB(ldap, ldap_open, [with_ldap=yes with_ldap_lber=yes], , -llber) } + test "$with_ldap" != "yes" && { AC_CHECK_LIB(ldap, ldap_open, [with_ldap=yes with_ldap_lber=yes with_ldap_krb=yes], , -llber -lkrb) } + test "$with_ldap" != "yes" && { AC_CHECK_LIB(ldap, ldap_open, [with_ldap=yes with_ldap_lber=yes with_ldap_krb=yes with_ldap_des=yes], , -llber -lkrb -ldes) } + dnl Recently, we need -lber even though the main routines are elsewhere, + dnl because otherwise be get link errors w.r.t. ber_pvt_opt_on. So just + dnl check for that (it's a variable not a fun but that doesn't seem to + dnl matter in these checks) and stick in -lber if so. Can't hurt (even to + dnl stick it in always shouldn't hurt, I don't think) ... #### Someone who + dnl #### understands LDAP needs to fix this properly. + test "$with_ldap_lber" != "yes" && { AC_CHECK_LIB(lber, ber_pvt_opt_on, with_ldap_lber=yes) } +fi +if test "$with_ldap" = "yes"; then + AC_DEFINE(HAVE_LDAP) + if test "$with_ldap_des" = "yes" ; then + XE_PREPEND(-ldes, ldap_libs) + fi + if test "$with_ldap_krb" = "yes" ; then + XE_PREPEND(-lkrb, ldap_libs) + fi + if test "$with_ldap_lber" = "yes" ; then + XE_PREPEND(-llber, ldap_libs) + fi + XE_PREPEND(-lldap, ldap_libs) + save_LIBS="$LIBS" LIBS="$LIBS $ldap_libs" + AC_CHECK_FUNCS(ldap_set_option ldap_get_lderrno ldap_result2error ldap_parse_result) + LIBS="$save_LIBS" + XE_APPEND(modules/ldap, MAKE_SUBDIR) + need_modules_common=yes + if test "$enable_modules" = "yes"; then + XE_APPEND(modules/ldap, INSTALL_ARCH_DEP_SUBDIR) + fi +fi +AC_SUBST(ldap_libs) + +dnl Autodetect PostgreSQL +dnl On many Linux systems, PostgreSQL is packaged to be installed in /usr; +dnl in this case, configure will easily detect it there. +dnl +dnl If PostgreSQL is installed into a different prefix, +dnl (such as the default /usr/local/pgsql when building from source), +dnl that prefix must be specified using the --with-site-prefixes flag. +postgresql_libs= +if test "$with_postgresql" != "no"; then + AC_CHECKING(for PostgreSQL) + +dnl Look for these standard header file locations, known to be used on Linux + for header_dir in "" "pgsql/" "postgresql/"; do + AC_CHECK_HEADER(${header_dir}libpq-fe.h, + libpq_fe_h_file=${header_dir}libpq-fe.h; break) + done + + test -n "$libpq_fe_h_file" && { AC_CHECK_LIB(pq,PQconnectdb,have_libpq=yes) } + + if test -n "$libpq_fe_h_file" -a "$have_libpq" = "yes"; then + with_postgresql=yes + AC_DEFINE(HAVE_POSTGRESQL) + AC_CHECK_LIB(pq,PQconnectStart, [ + with_postgresqlv7=yes; + AC_DEFINE(HAVE_POSTGRESQLV7)]) + AC_DEFINE_UNQUOTED(LIBPQ_FE_H_FILE, "$libpq_fe_h_file") + XE_PREPEND(-lpq, postgresql_libs) + XE_APPEND(modules/postgresql, MAKE_SUBDIR) + need_modules_common=yes + if test "$enable_modules" = "yes"; then + XE_APPEND(modules/postgresql, INSTALL_ARCH_DEP_SUBDIR) + fi + elif test "$with_postgresql" = "yes"; then + XE_DIE("Required PostgreSQL support cannot be provided. Check --with-site-prefixes.") + fi +fi +AC_SUBST(postgresql_libs) + +dnl ---------------------- +dnl Graphics libraries +dnl ---------------------- + +if test "$window_system" != "none"; then + AC_CHECKING([for graphics libraries]) + + dnl add special code to handle xpm-nox on Cygwin (csw) + dnl -- should only happen if CYGWIN && WITH_XPM && WITH_MSW && !WITH_X + libpath_xpm= + incpath_xpm= + case "$opsys" in + cygwin*) + cygwin_top=`eval "gcc -print-file-name=libc.a"` ; + cygwin_top=`eval "dirname ${cygwin_top}"`; + cygwin_top="${cygwin_top}/.."; + case "$window_system" in + dnl use "standard" search pattern + x11) ;; + dnl hardcode "standard" non-X11 xpm lib/inc dirs + msw) libpath_xpm="-L${cygwin_top}/lib/noX" + incpath_xpm="-I${cygwin_top}/include/noX" + ;; + dnl not supported on cygwin (yet?) + gtk) ;; + dnl probably not reached... + none) ;; + dnl ditto + *) ;; + esac + ;; + dnl use "standard" search pattern for all other OS's + *) ;; + esac + dnl Autodetect Xpm + xpm_problem="" + if test -z "$with_xpm"; then + XE_PREPEND("$incpath_xpm", CFLAGS) + XE_PREPEND("$libpath_xpm", LDFLAGS) + AC_MSG_CHECKING(for Xpm - no older than 3.4f) + xe_check_libs=-lXpm + AC_RUN_IFELSE([AC_LANG_SOURCE([#define XPM_NUMBERS +#include <X11/xpm.h> + int main(int c, char **v) { + return c == 1 ? 0 : + XpmIncludeVersion != XpmLibraryVersion() ? 1 : + XpmIncludeVersion < 30406 ? 2 : 0 ;}])], + [./conftest dummy_arg; xpm_status=$?; + if test "$xpm_status" = "0"; then + with_xpm=yes; + else + with_xpm=no; + if test "$xpm_status" = "1"; then + xpm_problem="Xpm library version and header file version don't match!" + elif test "$xpm_status" = "2"; then + xpm_problem="Xpm library version is too old!" + else + xpm_problem="Internal xpm detection logic error!" + fi + echo " +*** WARNING *** $xpm_problem + I'm not touching that with a 10-foot pole! + If you really want to use the installed version of Xpm, rerun + configure and add '--with-xpm=yes', but don't blame me if XEmacs crashes!" + fi], + [with_xpm=no]) + xe_check_libs= + AC_MSG_RESULT($with_xpm) + fi + if test "$with_xpm" = "yes"; then + dnl #### This code assumes that if AC_CHECK_LIB fails, + dnl #### then it will succeed if FOR_MSW is defined, + dnl #### but doesn't actually verify this assumption. + AC_DEFINE(HAVE_XPM) + XE_PREPEND("$libpath_xpm", LDFLAGS) + XE_PREPEND(-lXpm, libs_x) + XE_PREPEND("$incpath_xpm", CFLAGS) + AC_MSG_CHECKING(for \"FOR_MSW\" xpm) + xe_check_libs=-lXpm + AC_TRY_LINK(, [XpmCreatePixmapFromData()], + [xpm_for_msw=no], + [xpm_for_msw=yes]) + xe_check_libs= + AC_MSG_RESULT($xpm_for_msw) + if test "$xpm_for_msw" = "yes"; then + AC_DEFINE(FOR_MSW) + fi + fi + + dnl Autodetect XFACE + test -z "$with_xface" && { AC_CHECK_HEADER(compface.h, ,with_xface=no) } + test -z "$with_xface" && { AC_CHECK_LIB(compface, UnGenFace,[:] ,with_xface=no) } + test -z "$with_xface" && with_xface=yes + if test "$with_xface" = "yes"; then + AC_DEFINE(HAVE_XFACE) + XE_PREPEND(-lcompface, libs_x) + fi + + dnl For a brief period we had the GIF code split out into a separate library, + dnl but patent problems, etc. sort of squashed that idea. + dnl We default to building with builtin GIF decoding + if test "$with_gif" != "no"; then + with_gif="yes" + AC_DEFINE(HAVE_GIF) + fi + + dnl Too many stupid linkers can't detect cascaded lib dependencies until runtime + dnl So we always search for libz compression support. + if test "$with_png $with_tiff" != "no no"; then + AC_CHECK_LIB(c, inflate, [:], [ + AC_CHECK_LIB(z, inflate, [XE_PREPEND(-lz, libs_x)],[ + AC_CHECK_LIB(gz, inflate, [XE_PREPEND(-lgz, libs_x)])])]) + fi + + dnl autodetect JPEG + test -z "$with_jpeg" && { AC_CHECK_HEADER(jpeglib.h, ,with_jpeg=no) } + test -z "$with_jpeg" && { AC_CHECK_LIB(jpeg, jpeg_destroy_decompress,[:],with_jpeg=no) } + test -z "$with_jpeg" && with_jpeg=yes + if test "$with_jpeg" = "yes"; then + AC_DEFINE(HAVE_JPEG) + XE_PREPEND(-ljpeg, libs_x) + fi + + dnl autodetect PNG + png_problem="" + test -z "$with_png" && { AC_CHECK_FUNC(pow, ,with_png=no) } + test -z "$with_png" && { AC_CHECK_HEADER(png.h, ,with_png=no) } + test -z "$with_png" && { AC_CHECK_LIB(png, png_read_image,[:],with_png=no) } + if test -z "$with_png"; then + AC_MSG_CHECKING(for workable png version information) + xe_check_libs="-lpng -lz" + AC_RUN_IFELSE([AC_LANG_SOURCE([#include <png.h> + int main(int c, char **v) { + if (c == 1) return 0; + if (strcmp(png_libpng_ver, PNG_LIBPNG_VER_STRING) != 0) return 1; + return (PNG_LIBPNG_VER < 10002) ? 2 : 0 ;}])], + [./conftest dummy_arg; png_status=$?; + if test "$png_status" = "0"; then + with_png=yes; + else + with_png=no; + if test "$png_status" = "1"; then + png_problem="PNG library version and header file don't match!" + elif test "$png_status" = "2"; then + png_problem="PNG library version too old (pre 1.0.2)!" + fi + echo " +*** WARNING *** $png_problem + I'm not touching that with a 10-foot pole! + If you really want to use the installed version of libPNG, rerun + configure and add '--with-png=yes', but don't blame me if XEmacs crashes!" + fi], + [with_png=no]) + xe_check_libs= + AC_MSG_RESULT($with_png) + fi + if test "$with_png" = "yes"; then + AC_DEFINE(HAVE_PNG) + XE_PREPEND(-lpng, libs_x) + fi + + dnl autodetect TIFF + test -z "$with_tiff" && { AC_CHECK_HEADER(tiffio.h, ,with_tiff=no) } + test -z "$with_tiff" && { AC_CHECK_LIB(tiff, TIFFClientOpen,[:],with_tiff=no) } + test -z "$with_tiff" && with_tiff=yes + if test "$with_tiff" = "yes"; then + AC_DEFINE(HAVE_TIFF) + XE_PREPEND(-ltiff, libs_x) + fi +fi + +dnl ---------------------- +dnl GTK-Specific Graphics libraries +dnl ---------------------- + +if test "$with_gtk" = "yes"; then + dnl Autodetect XFACE + test -z "$with_xface" && { AC_CHECK_HEADER(compface.h, ,with_xface=no) } + test -z "$with_xface" && { AC_CHECK_LIB(compface, UnGenFace,[:] ,with_xface=no) } + test -z "$with_xface" && with_xface=yes + if test "$with_xface" = "yes"; then + AC_DEFINE(HAVE_XFACE) + XE_PREPEND(-lcompface, libs_gtk) + fi +fi + + +dnl ---------------------- +dnl X-Specific Graphics libraries +dnl ---------------------- + +if test "$with_x11" = "yes"; then + AC_CHECKING(for X11 graphics libraries) +fi + +dnl We don't automatically trigger widgets if athena is present +dnl because of stability concerns. +dnl But if the user wants widgets, still offer him autodetections +case "$enable_widgets" in + "yes" | "athena") detect_athena=yes ;; + *) detect_athena=no ;; +esac + +if test "$with_x11" = "yes" -a "$detect_athena" = "yes" ; then + AC_CHECKING(for the Athena widgets) + + dnl What in heck did the user actually want? + case "$with_athena" in + dnl This is the default, old fashioned flat Athena. + "xaw" | "") athena_variant=Xaw athena_3d=no ;; + "3d") athena_variant=Xaw3d athena_3d=yes ;; + "next") athena_variant=neXtaw athena_3d=yes ;; + "95") athena_variant=Xaw95 athena_3d=yes ;; + "xpm") athena_variant=XawXpm athena_3d=yes ;; + *) XE_DIE("Unknown Athena widget set \`$with_athena'. This should not happen.") ;; + esac + + dnl Search for the Athena library... + if test "$athena_3d" = "no"; then + AC_CHECK_LIB($athena_variant, XawScrollbarSetThumb, + [ + dnl Must not be a 3d library... + AC_CHECK_LIB($athena_variant, threeDClassRec, + [AC_MSG_WARN([Could not find a non-3d Athena widget library.])], + athena_lib=$athena_variant) + ], + AC_MSG_WARN([Could not find an Athena widget library.])) + else + dnl The real configuration, need 3d library + AC_CHECK_LIB($athena_variant, threeDClassRec, athena_lib=$athena_variant, + dnl OK, couldn't find it with a proper name, try the standard Athena lib + dnl If that is 3d, presume the user asked for what they have installed. + AC_CHECK_LIB(Xaw, threeDClassRec, + [ + athena_lib=Xaw; + AC_MSG_WARN([Assuming that libXaw is actually $athena_variant.]); + ], + [AC_MSG_WARN([Could not find a 3d Athena widget library that looked like $athena_variant.])])) + fi + + dnl Now we locate the Athena headers that we need. + if test "$athena_3d" = "no"; then + AC_CHECK_HEADER(X11/Xaw/ThreeD.h, + [AC_MSG_WARN([Could not find a non-3d Athena header set.])], + [AC_CHECK_HEADER(X11/Xaw/XawInit.h, + [athena_h_path=X11/Xaw], + [AC_MSG_WARN([Could not find a non-3d Athena header set.])])]) + else + dnl The three-d Athena headers are so much more slippery. + dnl Curse this `Lets replace standard libraries' thing that they did. :/ + AC_CHECK_HEADER(X11/$athena_variant/XawInit.h, + [AC_CHECK_HEADER(X11/$athena_variant/ThreeD.h, + [athena_h_path=X11/$athena_variant])]) + + dnl Is the variant specific header directory directly under include? + if test -z "$athena_h_path"; then + AC_CHECK_HEADER($athena_variant/XawInit.h, + [AC_CHECK_HEADER($athena_variant/ThreeD.h, + athena_h_path=$athena_variant)]) + fi + + dnl If we couldn't find the specific variant, try the generic Athena 3d headers + if test -z "$athena_h_path" -a "$athena_variant" != "Xaw3d"; then + AC_CHECK_HEADER(X11/Xaw3d/XawInit.h, + [AC_CHECK_HEADER(X11/Xaw3d/ThreeD.h, + [ + AC_MSG_WARN([Assuming that X11/Xaw3d headers are suitable for $athena_variant.]) + athena_h_path=X11/Xaw3d + ])]) + fi + + dnl Also generic 3d headers directly under include dir + if test -z "$athena_h_path" -a "$athena_variant" != "Xaw3d"; then + AC_CHECK_HEADER(Xaw3d/XawInit.h, + [AC_CHECK_HEADER(Xaw3d/ThreeD.h, + [ + AC_MSG_WARN([Assuming that Xaw3d headers are suitable for $athena_variant.]) + athena_h_path=Xaw3d + ])]) + fi + + dnl If nothing yet found, see if Xaw is a 3d header set... + dnl We AC_MSG_WARN if we fail because I am all out of ideas... + if test -z "$athena_h_path"; then + AC_CHECK_HEADER(X11/Xaw/ThreeD.h, + [ + AC_MSG_WARN([Assuming that X11/Xaw headers are suitable for $athena_variant.]) + athena_h_path=X11/Xaw + ], + [AC_MSG_WARN([Could not find a suitable 3d Athena header set.])]) + fi + fi + + dnl Do we actually have a usable Athena widget set? Please? + if test -n "$athena_lib" -a -n "$athena_h_path"; then + have_xaw=yes + else + have_xaw=no + fi + +else + have_xaw=no +fi dnl "$with_x11" = "yes" -a "detect_athena" = "yes" + +if test "$with_x11" = "yes"; then + dnl autodetect Motif - but only add to libs_x later (if necessary) + dnl Use a different function to the earlier test to avoid problems with the + dnl internal cache. + AC_CHECK_HEADER(Xm/Xm.h, + [AC_CHECK_LIB(Xm, XmStringCreate, have_motif=yes, have_motif=no)], + have_motif=no) + + if test "$have_motif" = "yes"; then + dnl autodetect lesstif + AC_MSG_CHECKING(for Lesstif) + AC_EGREP_CPP(yes, +[#include <Xm/Xm.h> +#ifdef LESSTIF_VERSION +yes +#endif +], have_lesstif=yes, have_lesstif=no) + AC_MSG_RESULT($have_lesstif) + fi + +fi dnl "$with_x11" = "yes" + +dnl Finish ensuring that we have values for the various toolkit items. +dnl Not all toolkits support all widgets +dnl if Motif is available we use it for the dialog boxes. + +case "$enable_menubars" in "" | "yes" | "athena" ) + enable_menubars="lucid" ;; +esac +case "$enable_dialogs" in "" | "yes" | "lucid" ) + if test "$have_motif" = "yes"; then enable_dialogs="motif" + elif test "$have_xaw" = "yes"; then enable_dialogs="athena" + elif test "$with_msw" = "yes"; then enable_dialogs="msw" + else enable_dialogs=no + fi ;; +esac +case "$enable_scrollbars" in "" | "yes" ) + enable_scrollbars="lucid" ;; +esac +case "$enable_widgets" in "" | "yes" | "lucid") + if test "$have_motif" = "yes"; then enable_widgets="motif" + elif test "$have_xaw" = "yes"; then enable_widgets="athena" + elif test "$with_msw" = "yes"; then enable_widgets="msw" + else enable_widgets=no + fi ;; +esac + +all_widgets="$enable_menubars $enable_scrollbars $enable_dialogs $enable_toolbars $enable_widgets" + +case "$all_widgets" in + *athena* ) + if test "$have_xaw" != "yes"; then + XE_DIE("Could not find a suitable Athena library to build with.") + fi + + dnl Add the Lucid widget Athena code + XE_APPEND(lwlib-Xaw.o, lwlib_objs) + + dnl Add the Athena widget library we located earlier + XE_PREPEND(-l$athena_lib, libs_x) + + dnl Tell lwlib where to find the Athena header files. + dnl Many people have tried to create a `smart' way of doing this, + dnl but all have failed. Before changing the following ugly definitions, + dnl consult the veterans of many a battle. + AC_DEFINE_UNQUOTED(ATHENA_Scrollbar_h_,"$athena_h_path/Scrollbar.h") + AC_DEFINE_UNQUOTED(ATHENA_Dialog_h_,"$athena_h_path/Dialog.h") + AC_DEFINE_UNQUOTED(ATHENA_Form_h_,"$athena_h_path/Form.h") + AC_DEFINE_UNQUOTED(ATHENA_Command_h_,"$athena_h_path/Command.h") + AC_DEFINE_UNQUOTED(ATHENA_Label_h_,"$athena_h_path/Label.h") + AC_DEFINE_UNQUOTED(ATHENA_LabelP_h_,"$athena_h_path/LabelP.h") + AC_DEFINE_UNQUOTED(ATHENA_Toggle_h_,"$athena_h_path/Toggle.h") + AC_DEFINE_UNQUOTED(ATHENA_ToggleP_h_,"$athena_h_path/ToggleP.h") + AC_DEFINE_UNQUOTED(ATHENA_AsciiText_h_,"$athena_h_path/AsciiText.h") + AC_DEFINE_UNQUOTED(ATHENA_XawInit_h_,"$athena_h_path/XawInit.h") + + AC_DEFINE(LWLIB_USES_ATHENA) + AC_DEFINE(NEED_ATHENA) + need_athena="yes" + + if test "$athena_3d" = "yes"; then + AC_DEFINE(HAVE_ATHENA_3D) + fi + ;; +esac + +case "$all_widgets" in *motif* ) + AC_DEFINE(LWLIB_USES_MOTIF) + AC_DEFINE(NEED_MOTIF) + XE_APPEND(lwlib-Xm.o, lwlib_objs) + need_motif=yes ;; +esac + +test "$enable_menubars" = "lucid" && XE_APPEND(xlwmenu.o, lwlib_objs) +test "$enable_menubars" = "motif" && XE_APPEND(xlwmenu.o, lwlib_objs) +test "$enable_scrollbars" = "lucid" && XE_APPEND(xlwscrollbar.o, lwlib_objs) +test "$enable_widgets" != "no" && test "$enable_widgets" != "msw" && \ + XE_APPEND(xlwtabs.o xlwgcs.o, lwlib_objs) +case "$enable_widgets" in athena* ) + XE_APPEND(xlwradio.o xlwcheckbox.o xlwgauge.o, lwlib_objs);; +esac +case "$all_widgets" in *lucid* ) + AC_DEFINE(NEED_LUCID) + XE_APPEND(lwlib-Xlw.o, lwlib_objs) ;; +esac + +AC_SUBST(lwlib_objs) + +test "$enable_scrollbars" = "athena" && AC_DEFINE(LWLIB_SCROLLBARS_ATHENA) +test "$enable_dialogs" = "athena" && AC_DEFINE(LWLIB_DIALOGS_ATHENA) + +if test "$athena_3d" = "yes"; then + test "$enable_scrollbars" = "athena" && AC_DEFINE(LWLIB_SCROLLBARS_ATHENA3D) + test "$enable_dialogs" = "athena" && AC_DEFINE(LWLIB_DIALOGS_ATHENA3D) +fi + +case "$enable_widgets" in athena* ) AC_DEFINE(LWLIB_WIDGETS_ATHENA);; esac +test "$enable_widgets" != "no" && test "$enable_widgets" != "msw" && \ + AC_DEFINE(LWLIB_TABS_LUCID) + +test "$enable_menubars" != "no" && AC_DEFINE(HAVE_MENUBARS) +test "$enable_scrollbars" != "no" && AC_DEFINE(HAVE_SCROLLBARS) +test "$enable_dialogs" != "no" && AC_DEFINE(HAVE_DIALOGS) +test "$enable_toolbars" != "no" && AC_DEFINE(HAVE_TOOLBARS) +test "$enable_widgets" != "no" && AC_DEFINE(HAVE_WIDGETS) + +test "$enable_menubars" = "lucid" && AC_DEFINE(LWLIB_MENUBARS_LUCID) +test "$enable_scrollbars" = "lucid" && AC_DEFINE(LWLIB_SCROLLBARS_LUCID) + +test "$enable_menubars" = "motif" && AC_DEFINE(LWLIB_MENUBARS_MOTIF) +test "$enable_scrollbars" = "motif" && AC_DEFINE(LWLIB_SCROLLBARS_MOTIF) +test "$enable_dialogs" = "motif" && AC_DEFINE(LWLIB_DIALOGS_MOTIF) +test "$enable_widgets" = "motif" && AC_DEFINE(LWLIB_WIDGETS_MOTIF) + +dnl ---------------------- +dnl Mule-dependent options +dnl ---------------------- + +test -z "$enable_mule" && enable_mule=no + +dnl if test "$enable_mule" = "yes" && test ! -d "$srcdir/lisp/mule"; then +dnl echo "Attempt to Build with Mule without Mule/Lisp" +dnl echo "Please install the XEmacs/Mule tarball or" +dnl echo "rerun configure with --with-mule=no" +dnl exit 1 +dnl fi + +if test "$enable_default_eol_detection" = "yes"; then + AC_DEFINE(HAVE_DEFAULT_EOL_DETECTION) +fi + +if test "$enable_mule" = "yes" ; then + AC_CHECKING(for Mule-related features) + AC_DEFINE(MULE) + + dnl Use -lintl to get internationalized strerror for Mule + AC_CHECK_HEADERS(libintl.h) + AC_CHECK_LIB(intl, strerror) + + AC_CHECKING(for Mule input methods) + dnl Do we have the XmIm* routines? And if so, do we want to use them? + dnl XIM seems to be flaky except on Solaris... + dnl test -z "$with_xim" -a "$opsys" != "sol2" && with_xim=no + case "$with_xim" in "" | "yes" ) + AC_CHECKING(for XIM) + AC_CHECK_LIB(X11, XOpenIM, with_xim=xlib, with_xim=no) + dnl XIM + Lesstif is not (yet?) usable + if test "$have_motif $have_lesstif" = "yes no"; then + AC_CHECK_LIB(Xm, XmImMbLookupString, with_xim=motif) + fi ;; + esac + if test "$with_xim" != "no"; then + AC_DEFINE(HAVE_XIM) + if test "$with_xim" = "xlib"; then + AC_DEFINE(XIM_XLIB) + XE_ADD_OBJS(input-method-xlib.o) + fi + if test "$with_xim" = "motif"; then + AC_DEFINE(XIM_MOTIF) + need_motif=yes + XE_ADD_OBJS(input-method-motif.o) + fi + if test "$with_xim" = "motif"; then + with_xfs=no + fi + fi + + dnl "with_xfs" = "yes" + if test "$with_xfs" = "yes" ; then + AC_CHECKING(for XFontSet) + AC_CHECK_LIB(X11, XmbDrawString, [:], with_xfs=no) + if test "$with_xfs" = "yes" && test "$enable_menubars" = "lucid"; then + AC_DEFINE(USE_XFONTSET) + if test "$with_xim" = "no" ; then + XE_ADD_OBJS(input-method-xlib.o) + fi + fi + fi dnl with_xfs + + dnl Autodetect WNN + test "$with_wnn6" = "yes" && with_wnn=yes # wnn6 implies wnn support + test -z "$with_wnn" && { AC_CHECK_HEADER(wnn/jllib.h, ,with_wnn=no) } + dnl gcc 2.97 fixincludes breaks inclusion of wnn/commonhd.h + test -z "$with_wnn" && { AC_CHECK_HEADER(wnn/commonhd.h, ,with_wnn=no) } + dnl Detour to find crypt + if test "$with_wnn" != "no"; then + AC_CHECK_FUNCS(crypt) + test "$ac_cv_func_crypt" != "yes" && { AC_CHECK_LIB(crypt, crypt) } + fi + dnl Back to our regularly scheduled wnn hunting + if test -z "$with_wnn" -o "$with_wnn" = "yes"; then + AC_CHECK_LIB(wnn,jl_dic_list_e,libwnn=wnn, + AC_CHECK_LIB(wnn4,jl_dic_list_e,libwnn=wnn4, + AC_CHECK_LIB(wnn6,jl_dic_list_e,libwnn=wnn6, + AC_CHECK_LIB(wnn6_fromsrc,dic_list_e,libwnn=wnn6_fromsrc,with_wnn=no)))) + fi + test -z "$with_wnn" && with_wnn=yes + if test "$with_wnn" = "yes"; then + AC_DEFINE(HAVE_WNN) + XE_PREPEND(-l$libwnn, libs_x) + if test "$with_wnn6" != "no"; then + AC_CHECK_LIB($libwnn, jl_fi_dic_list, with_wnn6=yes) + test "$with_wnn6" = "yes" && AC_DEFINE(WNN6) + fi + fi + + dnl Autodetect canna + canna_includes_found=no + if test "$with_canna" != "no"; then + AC_CHECK_HEADER(canna/jrkanji.h,canna_includes_found=yes) + fi + if test "$canna_includes_found" = "no" -a "$with_canna" != "no" -a \ + -d "/usr/local/canna/include"; then + save_c_switch_site="$c_switch_site" + c_switch_site="$c_switch_site -I/usr/local/canna/include" + AC_CHECK_HEADER(canna/jrkanji.h,canna_includes_found=yes) + if test "$canna_includes_found" != "yes"; then + c_switch_site="$save_c_switch_site" + with_canna="no" + fi + fi + + test -z "$with_canna" && { AC_CHECK_HEADER(canna/RK.h, , with_canna=no) } + test -z "$with_canna" && { AC_CHECK_LIB(RKC, RkBgnBun, [:],with_canna=no) } + test -z "$with_canna" && { AC_CHECK_LIB(canna,jrKanjiControl,[:],with_canna=no) } + test -z "$with_canna" && with_canna=yes + if test "$with_canna" = "yes"; then + AC_DEFINE(HAVE_CANNA) + XE_PREPEND(-lcanna -lRKC, libs_x) + fi + +else dnl "$enable_mule" = "no" + for feature in xim canna wnn; do + if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then + AC_MSG_WARN([--with-${feature} ignored: Not valid without Mule support]) + fi + eval "with_${feature}=no" + done +fi dnl with_mule + + +dnl At this point, we know whether we need the motif lib or not. +if test "$need_motif" = "yes" ; then + XE_PREPEND(-lXm, libs_x) + dnl AIX needs the following library for use with Motif + AC_CHECK_LIB(i18n, layout_object_getvalue, [XE_PREPEND(-li18n, libs_x)]) + XE_COMPUTE_RUNPATH() +fi + +dnl ---------------------------------------------------------------- +dnl Check for POSIX functions. +dnl ---------------------------------------------------------------- + +AC_CHECK_FUNCS(cbrt closedir dup2 eaccess fmod fpathconf frexp fsync ftime ftruncate getaddrinfo gethostname getnameinfo getpagesize getrlimit gettimeofday getcwd link logb lrand48 matherr mkdir mktime perror poll random readlink rename res_init rint rmdir select setitimer setpgid setsid sigblock sighold sigprocmask snprintf strerror strlwr strupr symlink tzset ulimit umask usleep vlimit vsnprintf waitpid wcscmp wcslen) + +dnl getaddrinfo() is borked under hpux11 +if test "$ac_cv_func_getaddrinfo" != "no" ; then + case "$opsys" in + hpux11 ) + AC_MSG_WARN([Use of getaddrinfo is disabled for HP-UX 11.XX.]) + ac_cv_func_getaddrinfo=no + ;; + esac +fi + +dnl ---------------------------------------------------------------- +dnl Check for Unixoid pty/process support. +dnl ---------------------------------------------------------------- + +dnl There is no "standard" pty allocation method. Every system is different. +dnl getpt() is the preferred pty allocation method on glibc systems. +dnl _getpty() is the preferred pty allocation method on SGI systems. +dnl grantpt(), unlockpt(), ptsname() are defined by Unix98. +AC_CHECK_FUNCS(getpt _getpty grantpt unlockpt ptsname killpg tcgetpgrp) + +dnl openpty() is the preferred pty allocation method on BSD and Tru64 systems. +dnl openpty() might be declared in: +dnl - pty.h (Tru64 or Linux) +dnl - libutil.h (FreeBSD) +dnl - util.h (NetBSD) +AC_CHECK_FUNC(openpty, have_openpty=yes, [ + AC_CHECK_LIB(util, openpty, have_openpty=yes need_libutil=yes)]) +if test "$have_openpty" = "yes"; then + AC_DEFINE(HAVE_OPENPTY) + AC_CHECK_HEADERS(libutil.h util.h, break) + test "$need_libutil" = "yes" && XE_APPEND(-lutil, libs_system) +fi + +dnl Check for system-specific pty header files +dnl Often the TIOCSIG* symbols are hiding there. +case "$opsys" in + dnl HPUX pty.h #defines TRUE and FALSE, so just use ptyio.h there. + hpux*) AC_CHECK_HEADERS(sys/ptyio.h) ;; + *) AC_CHECK_HEADERS(pty.h) + test "$ac_cv_header_pty_h" = "no" && AC_CHECK_HEADERS(sys/pty.h) + ;; +esac + +dnl Check for STREAM support functions. +dnl Confusingly, "str" means both "string" and "SysV Streams". +AC_CHECK_HEADERS(stropts.h) +if test "$ac_cv_header_stropts_h" = "yes"; then + AC_CHECK_FUNCS(isastream) + AC_CHECK_HEADERS(strtio.h) dnl TIOCSIGNAL +fi + +dnl Check whether the system provides getloadavg(). +AC_CHECK_FUNCS(getloadavg) + +if test "$ac_cv_func_getloadavg" = "yes"; then + dnl Solaris 8 declares getloadavg() in <sys/loadavg.h>. + dnl glibc 2.2 declares getloadavg() in <stdlib.h>... + dnl ...if we #define _GNU_SOURCE, which we do. + AC_CHECK_HEADERS(sys/loadavg.h) +else + dnl We define our own getloadavg() using lower level functions. + XE_ADD_OBJS(getloadavg.o) + + dnl Used by getloadavg() - does not require root priveleges + AC_CHECK_LIB(kstat, kstat_open) + AC_CHECK_HEADERS(kstat.h) + + dnl Another way to get the load average + AC_CHECK_LIB(kvm, kvm_read) +fi + +dnl If netdb.h does not declare h_errno, we must declare it by hand. +AC_MSG_CHECKING(whether netdb declares h_errno) +AC_TRY_LINK([#include <netdb.h>], + [return h_errno;], + [AC_MSG_RESULT(yes) + AC_DEFINE(HAVE_H_ERRNO)], + [AC_MSG_RESULT(no)]) + +AC_MSG_CHECKING(for sigsetjmp) +AC_TRY_COMPILE([#include <setjmp.h>], + [sigjmp_buf bar; sigsetjmp (bar, 0);], + [AC_MSG_RESULT(yes) + AC_DEFINE(HAVE_SIGSETJMP)], + [AC_MSG_RESULT(no)]) + +AC_MSG_CHECKING(whether localtime caches TZ) +AC_CACHE_VAL(emacs_cv_localtime_cache, +[if test "$ac_cv_func_tzset" = "yes"; then +AC_RUN_IFELSE([AC_LANG_SOURCE([#include <time.h> +#if STDC_HEADERS +# include <stdlib.h> +#endif +extern char **environ; +unset_TZ () +{ + char **from, **to; + for (to = from = environ; (*to = *from); from++) + if (! (to[[0]][[0]] == 'T' && to[[0]][[1]] == 'Z' && to[[0]][[2]] == '=')) + to++; +} +char TZ_GMT0[[]] = "TZ=GMT0"; +char TZ_PST8[[]] = "TZ=PST8"; +main() +{ + time_t now = time ((time_t *) 0); + int hour_GMT0, hour_unset; + if (putenv (TZ_GMT0) != 0) + exit (1); + hour_GMT0 = localtime (&now)->tm_hour; + unset_TZ (); + hour_unset = localtime (&now)->tm_hour; + if (putenv (TZ_PST8) != 0) + exit (1); + if (localtime (&now)->tm_hour == hour_GMT0) + exit (1); + unset_TZ (); + if (localtime (&now)->tm_hour != hour_unset) + exit (1); + exit (0); +}])], emacs_cv_localtime_cache=no, emacs_cv_localtime_cache=yes, +[# If we have tzset, assume the worst when cross-compiling. +emacs_cv_localtime_cache=yes]) +else + # If we lack tzset, report that localtime does not cache TZ, + # since we can't invalidate the cache if we don't have tzset. + emacs_cv_localtime_cache=no +fi],[:])dnl +AC_MSG_RESULT($emacs_cv_localtime_cache) +if test $emacs_cv_localtime_cache = yes; then + AC_DEFINE(LOCALTIME_CACHE) +fi + +if test "$HAVE_TIMEVAL" = "yes"; then +AC_MSG_CHECKING(whether gettimeofday accepts one or two arguments) +AC_TRY_LINK([ +#ifdef TIME_WITH_SYS_TIME +#include <sys/time.h> +#include <time.h> +#else +#ifdef HAVE_SYS_TIME_H +#include <sys/time.h> +#else +#include <time.h> +#endif +#endif + ], + [ + struct timeval time; + gettimeofday (&time, 0); +], + [AC_MSG_RESULT(two)], + [AC_MSG_RESULT(one) + AC_DEFINE(GETTIMEOFDAY_ONE_ARGUMENT)]) +fi + + +AC_C_INLINE +test "$ac_cv_c_inline" != "no" -a "$GCC" = "yes" && XE_ADD_OBJS(inline.o) + +dnl check for the typeof extension +AC_MSG_CHECKING(for typeof) +AC_TRY_COMPILE(, [int i; __typeof__(i) j;], typeofname="__typeof__", + [AC_TRY_COMPILE(, [int i; typeof(i) j;], typeofname="typeof", + typeofname=no)]) +AC_MSG_RESULT($typeofname) +if test "$typeofname" != "no"; then + AC_DEFINE_UNQUOTED(TYPEOF, $typeofname) +fi + +dnl HP-UX has a working alloca in libPW. +dnl case "${GCC}${opsys}" in hpux* ) +dnl AC_CHECK_FUNC(alloca, [:], [AC_CHECK_LIB(PW, alloca)]) +dnl esac + +dnl AC_FUNC_ALLOCA doesn't know about DEC C's #pragma intrinsic(alloca) +if test "$__DECC" != "yes"; then + AC_FUNC_ALLOCA + test -n "$ALLOCA" && XE_ADD_OBJS($ALLOCA) +fi + +AC_MSG_CHECKING(for working alloca in function calls) +AC_RUN_IFELSE([AC_LANG_SOURCE([ +#if defined (__CYGWIN__) +#include <alloca.h> +#elif defined (__GNUC__) +#define alloca __builtin_alloca +#elif defined (__DECC) +#include <alloca.h> +#pragma intrinsic(alloca) +#elif defined (HAVE_ALLOCA_H) +#include <alloca.h> +#elif defined (_AIX) +#pragma alloca +#elif ! defined (alloca) +#ifdef C_ALLOCA +#define alloca xemacs_c_alloca +#else +void *alloca (); +#endif /* C_ALLOCA */ +#endif /* !defined (alloca) */ + +void +f1 (double a, void *ptr, int b) +{ + unsigned char *ptr2 = (unsigned char *) ptr; + if (ptr2[[0]] != 0xBF || ptr2[[1]] != 0xBF || ptr2[[3000]] != 0xBF) + exit (1); + if (a != 3.1415 || b != -5490) + exit (1); +} + +int +f2 (short c, void *ptr, long e) +{ + unsigned char *ptr2 = (unsigned char *) ptr; + if (ptr2[[0]] != 0xFB || ptr2[[1]] != 0xFB || ptr2[[1000]] != 0xFB) + exit (1); + if (c != 665 || e != 776776776) + exit (1); + f1 (3.1415, memset (alloca (3001), 0xBF, 3001), -5490); + return 42; +} + +int +main (int argc, char *argv[]) +{ + if (f2 (665, memset (alloca (1001), 0xFB, 1001), 776776776) != 42) + return 1; + return 0; +} +])], working_alloca_in_function_calls=yes, working_alloca_in_function_calls=no) +AC_MSG_RESULT($working_alloca_in_function_calls) +test "$working_alloca_in_function_calls" != "yes" && \ + AC_DEFINE(BROKEN_ALLOCA_IN_FUNCTION_CALLS) + +AC_MSG_CHECKING([for working scanf]) +AC_RUN_IFELSE([AC_LANG_SOURCE([ +int +main (int argc, char **argv) +{ + int ret, cp1, cp2, endcount; + char *p = "0x7d 0x000E "; + ret = sscanf (p, "%i %i%n", &cp1, &cp2, &endcount); + /* endcount should be 13 but it's 11 in Cygwin newlib after 6/04; + this breaks unicode.c */ + return endcount != 13; +} +])], working_scanf=yes, working_scanf=no) +AC_MSG_RESULT($working_scanf) +test "$working_scanf" != "yes" && \ + AC_DEFINE(CYGWIN_SCANF_BUG) + +dnl Check whether strcoll exists and works correctly. (This does more +dnl than just check for its existence.) If so, it defines HAVE_STRCOLL. +AC_FUNC_STRCOLL + +dnl If `getpgrp' takes no argument (the POSIX.1 version), define +dnl `GETPGRP_VOID'. Otherwise, it is the BSD version, which takes a +dnl process ID as an argument. +AC_CHECK_FUNCS(getpgrp) +AC_FUNC_GETPGRP + +dnl We used to call AC_FUNC_MMAP here +dnl Instead we now use following, suggested by Neal Becker +AC_MSG_CHECKING(for working mmap) +case "$opsys" in ultrix* ) have_mmap=no ;; *) +AC_RUN_IFELSE([AC_LANG_SOURCE([#include <stdio.h> +#include <unistd.h> +#include <fcntl.h> +#include <sys/mman.h> + +#ifndef MAP_VARIABLE +#define MAP_VARIABLE 0 +#endif + +#ifndef MAP_FAILED +#define MAP_FAILED -1 +#endif + +int main (int argc, char *argv[]) +{ + int fd = -1; + caddr_t p; +#ifndef MAP_ANONYMOUS + fd = open ("/dev/zero", O_RDWR); + if (fd < 0) + return 1; +#define MAP_ANONYMOUS 0 +#endif + if (mmap(0, 1024, PROT_READ | PROT_WRITE, + MAP_PRIVATE | MAP_VARIABLE | MAP_ANONYMOUS, + fd, 0) != (void *) MAP_FAILED) + return 0; + perror ("conftest: mmap failed"); + return 1; +}])], have_mmap=yes, have_mmap=no) ;; +esac +AC_MSG_RESULT($have_mmap) +test "$have_mmap" = "yes" && AC_DEFINE(HAVE_MMAP) + +dnl By default we switch off rel-alloc on cygwin as it generally causes us grief +case "$opsys" in cygwin*) + test "$with_rel_alloc" = "default" && with_rel_alloc=no ;; +esac +dnl rel_alloc requires either GNU malloc or system malloc with mmap +dnl We only turn rel_alloc on by default if mmap is available. +test "$GNU_MALLOC" != "yes" -a "$have_mmap" != "yes" && with_rel_alloc=no +if test "$with_rel_alloc $have_mmap" = "default yes"; then + if test "$doug_lea_malloc" = "yes"; then + dnl Check if malloc() calls mmap(), making rel_alloc pointless. + AC_MSG_CHECKING(for M_MMAP_THRESHOLD) + AC_TRY_COMPILE([#include <malloc.h>],[ +#ifndef M_MMAP_THRESHOLD +#error No M_MMAP_THRESHOLD :-( +!＠+$%^&*_)(_ - unlikely to compile... +#endif +], [with_rel_alloc=no; AC_MSG_RESULT(yes);], [with_rel_alloc=yes; AC_MSG_RESULT(no);]) + else + with_rel_alloc=yes + fi +fi +test "$with_rel_alloc" = "yes" && AC_DEFINE(REL_ALLOC) + +dnl Check for terminal I/O variants +dnl TERMIOS systems may have termio.h, but not vice-versa, I think. +AC_CHECK_HEADER(termios.h, + AC_DEFINE(HAVE_TERMIOS) + AC_DEFINE(SIGNALS_VIA_CHARACTERS) + AC_DEFINE(NO_TERMIO), + [AC_CHECK_HEADER(termio.h, [AC_DEFINE(HAVE_TERMIO)])]) + + +dnl Check for Internet sockets. +AC_CHECK_FUNC(socket, + [AC_CHECK_HEADER(netinet/in.h, + [AC_CHECK_HEADER(arpa/inet.h, [ + AC_DEFINE(HAVE_SOCKETS) + AC_MSG_CHECKING("for sun_len member in struct sockaddr_un") + AC_TRY_LINK([ +#include <sys/types.h> +#include <sys/socket.h> +#include <sys/un.h> + ], + [static struct sockaddr_un x; x.sun_len = 1;], + [AC_MSG_RESULT(yes); AC_DEFINE(HAVE_SOCKADDR_SUN_LEN)], + [AC_MSG_RESULT(no)]) + AC_MSG_CHECKING("for ip_mreq struct in netinet/in.h") + AC_TRY_LINK([ +#include <sys/types.h> +#include <netinet/in.h> + ], + [static struct ip_mreq x;], + [AC_MSG_RESULT(yes); AC_DEFINE(HAVE_MULTICAST)], + [AC_MSG_RESULT(no)])])])]) + +dnl Check for SYS V IPC. (Inferior to sockets.) +AC_CHECK_FUNC(msgget, + [AC_CHECK_HEADER(sys/ipc.h, + [AC_CHECK_HEADER(sys/msg.h, + [AC_DEFINE(HAVE_SYSVIPC)])])]) + +dnl Check for directory variants +AC_CHECK_HEADER(dirent.h, [AC_DEFINE(SYSV_SYSTEM_DIR)], + [AC_CHECK_HEADER(sys/dir.h, , [AC_DEFINE(NONSYSTEM_DIR_LIBRARY)])]) + +dnl Check for nlist.h +AC_CHECK_HEADER(nlist.h, AC_DEFINE(NLIST_STRUCT), ) + +dnl Check for sound of various sorts. + +dnl Autodetect native sound +AC_CHECKING("for sound support") +test -z "$with_native_sound" -a -n "$with_native_sound_lib" && with_native_sound=yes + +if test "$with_native_sound" != "no"; then + dnl Maybe sound is already on include path... + if test -n "$with_native_sound_lib"; then + AC_CHECK_HEADER(multimedia/audio_device.h, + [sound_found=yes sound_cflags="" + XE_ADD_OBJS(sunplay.o)]) + fi + + dnl Autodetect Sun native sound from SUNWaudmo package + if test -z "$sound_found" -a -d "/usr/demo/SOUND"; then + if test -d "/usr/demo/SOUND/include/multimedia"; then + sun_sound_cflags="-I/usr/demo/SOUND/include" + elif test -d "/usr/demo/SOUND/multimedia"; then + sun_sound_cflags="-I/usr/demo/SOUND" + fi + + if test -n "$with_native_sound_lib"; then + sun_sound_lib="$with_native_sound_lib" + elif test -r "/usr/demo/SOUND/lib/libaudio.a"; then + sun_sound_lib="/usr/demo/SOUND/lib/libaudio.a" + elif test -r "/usr/demo/SOUND/libaudio.a"; then + sun_sound_lib="/usr/demo/SOUND/libaudio.a" + fi + + if test -n "$sun_sound_cflags" -a -n "$sun_sound_lib"; then + with_native_sound_lib="$sun_sound_lib" + sound_cflags="$sun_sound_cflags" + sound_found=yes + XE_ADD_OBJS(sunplay.o) + fi + fi + + dnl Check for SGI and HP native sound libs + if test -z "$sound_found"; then + case "$ac_cv_build" in + *-sgi-* ) + if test -z "$with_native_sound_lib"; then + AC_CHECK_LIB(audio, ALopenport, with_native_sound_lib="-laudio") + fi + if test -n "$with_native_sound_lib"; then + sound_found=yes sound_cflags="" + XE_ADD_OBJS(sgiplay.o) + fi ;; + hppa*-hp-hpux* ) + if test -z "$with_native_sound_lib"; then + AC_CHECK_LIB(Alib, AOpenAudio, with_native_sound_lib="-lAlib") + fi + if test -n "$with_native_sound_lib"; then + sound_found=yes + XE_ADD_OBJS(hpplay.o) + if test "$GCC" = "yes" # Kludge city + then sound_cflags="-Dconst= -Dvolatile= -I/usr/audio/examples" + else sound_cflags="+e -I/usr/audio/examples" + fi + fi ;; + esac + fi + + dnl Win32 Native uses native sound + if test -z "$sound_found"; then + if test "$with_msw" = "yes"; then + sound_found=yes + with_native_sound_lib= + XE_ADD_OBJS(ntplay.o) + fi + fi + + dnl Check for Linux/BSD native sound (also on recent Cygwins) + if test -z "$sound_found"; then + for dir in "machine" "sys" "linux"; do + AC_CHECK_HEADER(${dir}/soundcard.h, + sound_found=yes + need_miscplay=yes + XE_ADD_OBJS(linuxplay.o) + [AC_DEFINE_UNQUOTED(SOUNDCARD_H_FILE, "${dir}/soundcard.h")] + break) + done + fi + + test "$sound_found" = "yes" && with_native_sound=yes +fi + +if test "$with_native_sound" = "yes"; then + AC_DEFINE(HAVE_NATIVE_SOUND) + test -n "$with_native_sound_lib" && XE_PREPEND($with_native_sound_lib, LIBS) +fi + +dnl NAS Sound support +if test "$with_nas_sound" != "no"; then + AC_CHECK_HEADER(audio/audiolib.h, [ + AC_CHECK_LIB(audio, AuOpenServer, have_nas_sound=yes)]) + if test "$have_nas_sound" = "yes"; then + with_nas_sound=yes + AC_DEFINE(HAVE_NAS_SOUND) + XE_ADD_OBJS(nas.o) + XE_PREPEND(-laudio, libs_x) + dnl If the nas library does not contain the error jump point, + dnl then we force safer behavior. + AC_EGREP_HEADER(AuXtErrorJump,audio/Xtutil.h,,[old_nas=yes; AC_DEFINE(NAS_NO_ERROR_JUMP)]) + else + test "$with_nas_sound" = "yes" && \ + XE_DIE("Required NAS sound support cannot be provided.") + with_nas_sound=no + fi +fi + +dnl ESD Sound support +if test "$with_esd_sound" != "no"; then + AC_CHECK_PROG(have_esd_config, esd-config, yes, no) + if test "$have_esd_config" = "yes"; then + save_c_switch_site="$c_switch_site" save_LIBS="$LIBS" + XE_APPEND(`esd-config --cflags`, c_switch_site) + XE_PREPEND(`esd-config --libs`, LIBS) + AC_CHECK_FUNC(esd_play_stream, + have_esd_sound=yes, + c_switch_site="$save_c_switch_site" LIBS="$save_LIBS") + fi + + if test "$have_esd_sound" = "yes"; then + with_esd_sound=yes + need_miscplay=yes + XE_ADD_OBJS(esd.o) + AC_DEFINE(HAVE_ESD_SOUND) + else + test "$with_esd_sound" = "yes" && \ + XE_DIE("Required ESD sound support cannot be provided.") + with_esd_sound=no + fi +fi + +test "$need_miscplay" = "yes" && XE_ADD_OBJS(miscplay.o) + +dnl --------------------- +dnl TTY-dependent options +dnl --------------------- + +test -z "$with_tty" && with_tty=yes + +if test "$with_tty" = "yes" ; then + AC_CHECKING(for TTY-related features) + AC_DEFINE(HAVE_TTY) + + dnl Autodetect ncurses. + if test -z "$with_ncurses"; then + AC_CHECK_LIB(ncurses, tgetent, with_ncurses=yes, with_ncurses=no) + fi + if test "$with_ncurses" = "yes"; then + AC_DEFINE(HAVE_NCURSES) + AC_CHECK_HEADER(ncurses/curses.h, curses_h_file=ncurses/curses.h) + AC_CHECK_HEADER(ncurses/term.h, term_h_file=ncurses/term.h) + XE_ADD_OBJS(terminfo.o) + XE_PREPEND(-lncurses, LIBS) + + if test "$ac_cv_header_ncurses_curses_h" != "yes" ; then + dnl Try again, and check for the bogus ncurses/ include bug. + dnl (i.e. ncurses/curses.h bogusly includes <unctrl.h> instead of + dnl <ncurses/unctrl.h>) + save_c_switch_site="$c_switch_site" + c_switch_site="$c_switch_site -I/usr/include/ncurses" + AC_CHECK_HEADER(ncurses/curses.h, curses_h_file=ncurses/curses.h) + if test "$ac_cv_header_ncurses_curses_h" = "yes" + then AC_MSG_WARN([Your system has the bogus ncurses include bug.]) + else c_switch_site="$save_c_switch_site" + fi + fi + else dnl "$with_ncurses" = "no" + dnl Autodetect terminfo/-lcurses/-ltermlib/-ltermcap + if test "$have_terminfo" = "yes"; then + XE_ADD_OBJS(terminfo.o) + if test -n "$libs_termcap"; then + XE_PREPEND($libs_termcap, LIBS) + else + for lib in curses termlib termcap; do + AC_CHECK_LIB($lib, tgetent, XE_PREPEND(-l${lib}, LIBS); break) + done + fi + else dnl "$have_terminfo" = "no" && "with_ncurses" = "no" + XE_ADD_OBJS(tparam.o) + dnl The HP-UX curses library seems to have a badly broken version of select(2) + dnl that makes "poll: interrupted system call" messages to appear and + dnl Emacs subprocesses to hang (e.g. TeX compilation w/ AUCTeX) */ + case "$opsys" in *-hp-hpux* ) libs_termcap="-ltermcap" ;; esac + if test -n "$libs_termcap"; then + XE_PREPEND($libs_termcap, LIBS) + else + AC_CHECK_LIB(curses, tgetent, XE_PREPEND(-lcurses, LIBS), + AC_CHECK_LIB(termcap, tgetent, XE_PREPEND(-ltermcap, LIBS), + XE_ADD_OBJS(termcap.o))) + fi + fi + fi + AC_DEFINE_UNQUOTED(CURSES_H_FILE, "${curses_h_file-curses.h}") + AC_DEFINE_UNQUOTED(TERM_H_FILE, "${term_h_file-term.h}") + + dnl General Purpose Mouse (libgpm) support + if test "$with_gpm" != "no"; then + AC_CHECK_HEADER(gpm.h, [ + AC_CHECK_LIB(gpm, Gpm_Open, have_gpm=yes)]) + if test "$have_gpm" = "yes"; then + with_gpm=yes + AC_DEFINE(HAVE_GPM) + XE_PREPEND(-lgpm, LIBS) + elif test "$with_gpm" = "yes"; then + XE_DIE(["GPM requested, but gpm.h or libgpm seems to be missing."]) + else + with_gpm=no + fi + fi + +else dnl "$with_tty" = "no" + for feature in ncurses gpm; do + if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then + AC_MSG_WARN([--with-${feature} ignored: Not valid without TTY support]) + fi + eval "with_${feature}=no" + done +fi dnl with_tty + +dnl Database support +dnl We do not necessarily have to have libdb/lib(g)dbm for DB/(G)DBM support. +dnl On FreeBSD, both DB and DBM are part of libc. +dnl By default, we check for DBM support in libgdbm, then libc, then libdbm. + +test "$with_database_gdbm $with_database_dbm $with_database_berkdb" \ + != "no no no" && AC_CHECKING(for database support) + +dnl Check for ndbm.h, required for either kind of DBM support. +if test "$with_database_gdbm $with_database_dbm" != "no no"; then + AC_CHECK_HEADER(ndbm.h, [:], [ + test "$with_database_gdbm" = "yes" -o \ + "$with_database_dbm" = "yes" && \ + XE_DIE("Required DBM support cannot be provided.") + with_database_gdbm=no with_database_dbm=no]) +fi + +dnl Check for DBM support in libgdbm. +if test "$with_database_gdbm" != "no"; then + AC_CHECK_LIB(gdbm, dbm_open, [ + with_database_gdbm=yes with_database_dbm=no libdbm=-lgdbm], [ + if test "$with_database_gdbm" = "yes"; then + XE_DIE("Required GNU DBM support cannot be provided.") + fi + with_database_gdbm=no]) +fi + +dnl Check for DBM support in libc and libdbm. +if test "$with_database_dbm" != "no"; then + AC_CHECK_FUNC(dbm_open, [with_database_dbm=yes libdbm=], [ + AC_CHECK_LIB(dbm, dbm_open, [with_database_dbm=yes libdbm=-ldbm], [ + test "$with_database_dbm" = "yes" && \ + XE_DIE("Required DBM support cannot be provided.") + with_database_dbm=no])]) +fi + +dnl Tell make about the DBM support we detected. +test -n "$libdbm" && XE_PREPEND("$libdbm", LIBS) +test "$with_database_gdbm" = "yes" -o \ + "$with_database_dbm" = "yes" && \ + AC_DEFINE(HAVE_DBM) + +dnl Check for Berkeley DB. +if test "$with_database_berkdb" != "no"; then + AC_MSG_CHECKING(for Berkeley db.h) + for header in "db/db.h" "db.h"; do + AC_TRY_COMPILE([ +#include <stdlib.h> +#if !(defined __GLIBC__ && __GLIBC_MINOR__ >= 1) +#ifdef HAVE_INTTYPES_H +#define __BIT_TYPES_DEFINED__ +#include <inttypes.h> +typedef uint8_t u_int8_t; +typedef uint16_t u_int16_t; +typedef uint32_t u_int32_t; +#ifdef WE_DONT_NEED_QUADS +typedef uint64_t u_int64_t; +#endif +#endif +#endif +#include <$header> +],[], db_h_file="$header"; break) + done + if test -z "$db_h_file" + then AC_MSG_RESULT(no); with_database_berkdb=no + else AC_MSG_RESULT($db_h_file) + fi + + if test "$with_database_berkdb" != "no"; then + AC_MSG_CHECKING(for Berkeley DB version) + AC_EGREP_CPP(yes, +[#include <$db_h_file> +#if DB_VERSION_MAJOR > 1 +yes +#endif +], [AC_EGREP_CPP(yes, +[#include <$db_h_file> +#if DB_VERSION_MAJOR > 2 +yes +#endif +], [AC_EGREP_CPP(yes, +[#include <$db_h_file> +#if DB_VERSION_MAJOR > 3 +yes +#endif +], [AC_MSG_RESULT(4); dbfunc=db_create; dbver=4],[ + AC_MSG_RESULT(3); dbfunc=db_create; dbver=3])],[ + AC_MSG_RESULT(2); dbfunc=db_open; dbver=2])],[ + AC_MSG_RESULT(1); dbfunc=dbopen; dbver=1]) + AC_CHECK_FUNC($dbfunc, with_database_berkdb=yes need_libdb=no, [ + AC_CHECK_LIB(db, $dbfunc, with_database_berkdb=yes need_libdb=yes)]) + fi + + dnl Berk db 4.1 decorates public functions with version information + if test "$with_database_berkdb" != "yes" -a "$dbver" = "4"; then + rm -f $tempcname + echo "#include <$db_h_file>" > $tempcname + echo "configure___ dbfunc=db_create" >> $tempcname + define(TAB, [ ])dnl + eval `$CPP -Isrc $tempcname \ + | sed -n -e "s/[[ TAB]]*=[[ TAB\"]]*/='/" -e "s/[[ TAB\"]]*\$/'/" -e "s/^configure___//p"` + rm -f $tempcname + AC_MSG_WARN("db_create is really $dbfunc") + AC_CHECK_LIB(db, $dbfunc, with_database_berkdb=yes need_libdb=yes) + fi + + if test "$with_database_berkdb" = "yes"; then + AC_DEFINE_UNQUOTED(DB_H_FILE, "$db_h_file") + AC_DEFINE(HAVE_BERKELEY_DB) + test "$need_libdb" = "yes" && XE_PREPEND(-ldb, LIBS) + else with_database_berkdb=no + fi +fi + +if test "$with_database_gdbm $with_database_dbm $with_database_berkdb" \ + != "no no no"; then + AC_DEFINE(HAVE_DATABASE) +fi + +dnl Socks support +if test "$with_socks" = "yes"; then + AC_CHECK_LIB(socks, SOCKSinit) + test -n "$ac_cv_lib_socks_SOCKSinit" && AC_DEFINE(HAVE_SOCKS) +fi + +dnl Usage tracking (undocumented and likely unused option) +if test "$usage_tracking" = "yes"; then + AC_DEFINE(USAGE_TRACKING) + XE_PREPEND(-Bstatic -lut -Bdynamic, LIBS) +fi + +dnl Enhanced number support +if test "$enable_bignum" = "gmp"; then + AC_CHECK_HEADER(gmp.h, [ + AC_CHECK_LIB(gmp, __gmpz_init, have_mpz_init=yes)]) + if test "$have_mpz_init" = "yes"; then + AC_DEFINE(WITH_NUMBER_TYPES) + AC_DEFINE(WITH_GMP) + XE_PREPEND(-lgmp, LIBS) + else + XE_DIE("Required GMP numeric support cannot be provided.") + fi +elif test "$enable_bignum" = "mp"; then + for library in "" "-lcrypto"; do + AC_CHECK_HEADER(mp.h, [ + AC_CHECK_LIB(mp, mp_mfree, have_mp_mfree=yes; break, [ + AC_CHECK_LIB(mp, mfree, have_mfree=yes; break, , $library)], + $library)]) + done + if test "$have_mp_mfree" = "yes"; then + AC_DEFINE(MP_PREFIX) + XE_APPEND(-lmp, LIBS) + if test "$library" != ""; then + XE_APPEND($library, LIBS) + fi + AC_CHECK_FUNC(mp_move, [AC_DEFINE(HAVE_MP_MOVE)]) + elif test "$have_mfree" = "yes"; then + XE_APPEND(-lmp, LIBS) + if test "$library" != ""; then + XE_APPEND($library, LIBS) + fi + AC_CHECK_FUNC(move, [AC_DEFINE(HAVE_MP_MOVE)]) + else + XE_DIE("Required MP numeric support cannot be provided.") + fi + AC_DEFINE(WITH_NUMBER_TYPES) + AC_DEFINE(WITH_MP) +fi + +dnl Unfortunately, just because we can link doesn't mean we can run. +dnl One of the above link tests may have succeeded but caused resulting +dnl executables to fail to run. Also any tests using AC_RUN_IFELSE will +dnl have reported incorrect results. +AC_RUN_IFELSE([AC_LANG_SOURCE([int main(int c,char *v[]){return 0;}])],[:],[ + echo "" + echo "*** PANIC *** The C compiler can no longer build working executables." + echo "*** PANIC *** Please examine the tail of config.log for runtime errors." + echo "*** PANIC *** The most likely reason for this problem is that configure" + echo "*** PANIC *** links with shared libraries, but those libraries cannot be" + echo "*** PANIC *** found at run time." + echo "*** PANIC ***" + echo "*** PANIC *** On a Linux system, edit /etc/ld.so.conf and re-run ldconfig." + echo "*** PANIC *** On other systems, try telling configure where to find the" + echo "*** PANIC *** shared libraries using the --with-site-runtime-libraries option" + echo "*** PANIC ***" + echo "*** PANIC *** Another way to shoot yourself in the foot is to specify" + echo "*** PANIC *** --with-FEATURE when FEATURE is not actually installed" + echo "*** PANIC *** on your system. Don't do that." + exit 1]) + +dnl Process support +if test "$win32_processes" != "yes"; then + AC_DEFINE(HAVE_UNIX_PROCESSES) +fi + +dnl -------------------------------- +dnl Compute SUBST-itutable variables +dnl -------------------------------- + +dnl We ignore (C|LD)_SWITCH_X_(MACHINE|SYSTEM) +dnl Use XE_SPACE instead of plain assignment statements to remove extraneous blanks +if test "$enable_modules" = "yes"; then + ld_libs_module= +else + XE_SPACE(ld_libs_module, $ldap_libs $postgresql_libs) +fi + +XE_SPACE(CFLAGS, $CFLAGS) +XE_SPACE(extra_objs, $extra_objs) +XE_SPACE(c_switch_general, -DHAVE_CONFIG_H $c_switch_site $c_switch_machine $c_switch_system) +XE_SPACE(c_switch_window_system, $c_switch_x_site $c_switch_gtk $X_CFLAGS) +XE_SPACE(c_switch_all, $c_switch_general $c_switch_window_system) +XE_SPACE(ld_switch_general, $ld_switch_site $ld_switch_machine $ld_switch_system $ld_switch_run) +XE_SPACE(ld_switch_window_system, $ld_switch_x_site) +XE_SPACE(ld_switch_all, $ld_switch_general $ld_switch_window_system) +XE_SPACE(ld_libs_general, $LIBS $libs_machine $libs_system $libs_standard) +XE_SPACE(ld_libs_window_system, $X_EXTRA_LIBS $libs_x $libs_gtk $X_PRE_LIBS) +XE_SPACE(ld_libs_all, $ld_libs_window_system $ld_libs_general $ld_libs_module) + +dnl For no-module builds, make the src dir last +if test "$enable_modules" = "no"; then + XE_APPEND(src, MAKE_SUBDIR) +fi + +dnl Compute lists of Makefiles and subdirs +AC_SUBST(SRC_SUBDIR_DEPS) +internal_makefile_list="Makefile.in" +SUBDIR_MAKEFILES='' +test -d lock || mkdir lock +for dir in $MAKE_SUBDIR; do + case "$dir" in */* ) dnl Implement mkdir -p + ( for d in `echo $dir | sed 's:/: :g'` ; do + test -d "$d" || mkdir "$d"; cd "$d" + done ) ;; + * ) test -d "$dir" || mkdir "$dir" ;; + esac + XE_SPACE(SUBDIR_MAKEFILES, $SUBDIR_MAKEFILES $dir/Makefile $dir/GNUmakefile) + XE_SPACE(internal_makefile_list, $internal_makefile_list $dir/Makefile.in) +done +AC_SUBST(INSTALL_ARCH_DEP_SUBDIR) +AC_SUBST(MAKE_SUBDIR) +AC_SUBST(SUBDIR_MAKEFILES) + +dnl Make s&m symlinks in the src directory, for config.h. +for dir in src/s src/m; do + if test ! -d "$dir" ; then + echo Making symbolic link to "$srcdir/$dir" + ${LN_S} "$srcdir/$dir" "$dir" + fi +done + +dnl Also make modules/common link if needed for the module Makefiles. +if test "$need_modules_common" = "yes"; then + for dir in modules/common; do + if test ! -d "$dir" ; then + echo Making symbolic link to "$srcdir/$dir" + ${LN_S} "$srcdir/$dir" "$dir" + fi + done +fi + +if test "$extra_verbose" = "yes"; then + echo "" + PRINT_VAR(extra_objs + c_switch_general c_switch_window_system c_switch_all + ld_switch_general ld_switch_window_system ld_switch_all + ld_libs_general ld_libs_window_system ld_libs_all) + echo "" +fi + +dnl ---------------------------------------------- +dnl Create some auxiliary files for developers. +dnl ---------------------------------------------- + +dnl Create a .gdbinit useful for debugging XEmacs +if test -f "$srcdir/src/.gdbinit" -a ! -f "src/.gdbinit"; then + test "$extra_verbose" = "yes" && echo "creating src/.gdbinit" + echo "source $srcdir/src/.gdbinit" > "src/.gdbinit" +fi + +dnl Create a .dbxrc useful for debugging XEmacs +if test -f "$srcdir/src/.dbxrc" -a ! -f "src/.dbxrc"; then + test "$extra_verbose" = "yes" && echo "creating src/.dbxrc" + echo ". $srcdir/src/.dbxrc" > "src/.dbxrc" +fi + +dnl Create a useful TAGS file +if test -f "$srcdir/TAGS" -a ! -f "TAGS"; then + test "$extra_verbose" = "yes" && echo "creating TAGS" + echo " +$srcdir/TAGS,include" > "TAGS" +fi + +dnl Create top level .sbinit for Sun compilers +if test "$__SUNPRO_C" = "yes"; then + test "$extra_verbose" = "yes" && echo "creating .sbinit" + ( echo "# For use with Sun WorkShop's Source browser." + echo "# See sbquery(1) and sbinit(4) for more information" + for dir in $MAKE_SUBDIR; do echo "import $dir"; done + ) > .sbinit +fi + +dnl There are no more compile tests; remove the core they created. +rm -f core + +dnl ---------------------------------------------- +dnl Substitute into Makefile, config.h and paths.h +dnl ---------------------------------------------- + +dnl what sort of things to edit into Makefile, config.h and paths.h +dnl configuration here uncanonicalized to avoid exceeding size limits. + +AC_SUBST(PROGNAME) +AC_SUBST(version) +AC_SUBST(inststaticdir) +AC_SUBST(instvardir) +AC_SUBST(srcdir) +AC_SUBST(bindir) +AC_SUBST(datadir) +AC_SUBST(statedir) +AC_SUBST(libdir) +AC_SUBST(mandir) +AC_SUBST(extra_includes) + +AC_SUBST(prefix) +AC_SUBST(PREFIX_USER_DEFINED) +dnl Yo, Stephen Bourne! I want to marry you! +PREFIX=$prefix +while true; do + case "$PREFIX" in + *\$* ) eval "PREFIX=$PREFIX" ;; + *) break ;; + esac +done +AC_SUBST(PREFIX) + +AC_SUBST(exec_prefix) +AC_SUBST(EXEC_PREFIX_USER_DEFINED) +EXEC_PREFIX=$exec_prefix +while true; do + case "$EXEC_PREFIX" in + *\$* ) eval "EXEC_PREFIX=$EXEC_PREFIX" ;; + *) break ;; + esac +done +AC_SUBST(EXEC_PREFIX) + +AC_SUBST(infodir) +AC_SUBST(INFODIR_USER_DEFINED) +INFODIR=$infodir +while true; do + case "$INFODIR" in + *\$* ) eval "INFODIR=$INFODIR" ;; + *) break ;; + esac +done +AC_SUBST(INFODIR) + +AC_SUBST(infopath,$with_infopath) +AC_SUBST(INFOPATH_USER_DEFINED) +INFOPATH=$with_infopath +while true; do + case "$INFOPATH" in + *\$* ) eval "INFOPATH=$INFOPATH" ;; + *) break ;; + esac +done +AC_SUBST(INFOPATH) + +if test -z "$with_package_path" && test -n "$with_package_prefix" ; then + if test "$enable_mule" = "yes" ; then + with_package_path="~/.xemacs::${with_package_prefix}/site-packages:${with_package_prefix}/xemacs-packages:${with_package_prefix}/mule-packages" + else + with_package_path="~/.xemacs::${with_package_prefix}/site-packages:${with_package_prefix}/xemacs-packages" + fi +fi + +AC_SUBST(package_path,$with_package_path) +AC_SUBST(PACKAGE_PATH_USER_DEFINED) +PACKAGE_PATH=$with_package_path +while true; do + case "$PACKAGE_PATH" in + *\$* ) eval "PACKAGE_PATH=$PACKAGE_PATH" ;; + *) break ;; + esac +done +AC_SUBST(PACKAGE_PATH) + +AC_SUBST(lispdir, $with_lispdir) +AC_SUBST(LISPDIR_USER_DEFINED) +LISPDIR=$with_lispdir +while true; do + case "$LISPDIR" in + *\$* ) eval "LISPDIR=$LISPDIR" ;; + *) break ;; + esac +done +AC_SUBST(LISPDIR) + +AC_SUBST(moduledir,$with_moduledir) +AC_SUBST(MODULEDIR_USER_DEFINED) +MODULEDIR=$with_moduledir +while true; do + case "$MODULEDIR" in + *\$* ) eval "MODULEDIR=$MODULEDIR" ;; + *) break ;; + esac +done +AC_SUBST(MODULEDIR) + +AC_SUBST(sitelispdir,$with_sitelispdir) +AC_SUBST(SITELISPDIR_USER_DEFINED) +SITELISPDIR=$sitelispdir +while true; do + case "$SITELISPDIR" in + *\$* ) eval "SITELISPDIR=$SITELISPDIR" ;; + *) break ;; + esac +done +AC_SUBST(SITELISPDIR) + +AC_SUBST(sitemoduledir) +AC_SUBST(SITEMODULEDIR_USER_DEFINED) +SITEMODULEDIR=$sitemoduledir +while true; do + case "$SITEMODULEDIR" in + *\$* ) eval "SITEMODULEDIR=$SITEMODULEDIR" ;; + *) break ;; + esac +done +AC_SUBST(SITEMODULEDIR) + +AC_SUBST(etcdir,$with_etcdir) +AC_SUBST(ETCDIR_USER_DEFINED) +ETCDIR=$with_etcdir +while true; do + case "$ETCDIR" in + *\$* ) eval "ETCDIR=$ETCDIR" ;; + *) break ;; + esac +done +AC_SUBST(ETCDIR) + +AC_SUBST(archlibdir,$with_archlibdir) +AC_SUBST(ARCHLIBDIR_USER_DEFINED) +ARCHLIBDIR=$with_archlibdir +while true; do + case "$ARCHLIBDIR" in + *\$* ) eval "ARCHLIBDIR=$ARCHLIBDIR" ;; + *) break ;; + esac +done +AC_SUBST(ARCHLIBDIR) + +AC_SUBST(docdir,$with_docdir) +AC_SUBST(DOCDIR_USER_DEFINED) +DOCDIR=$with_docdir +while true; do + case "$DOCDIR" in + *\$* ) eval "DOCDIR=$DOCDIR" ;; + *) break ;; + esac +done +AC_SUBST(DOCDIR) + +AC_SUBST(docdir) +AC_SUBST(bitmapdir) +AC_SUBST(extra_objs) + +dnl The following flags combine all the information from: +dnl - command line options (user always gets priority) +dnl - user environment variables +dnl - determined by configure +dnl - the s&m header files (required for ellcc) +AC_SUBST(machfile) +AC_SUBST(opsysfile) +AC_SUBST(c_switch_general) +AC_SUBST(c_switch_window_system) +AC_SUBST(c_switch_all) +AC_SUBST(ld_switch_general) +AC_SUBST(ld_switch_window_system) +AC_SUBST(ld_switch_all) +AC_SUBST(ld_libs_general) +AC_SUBST(ld_libs_window_system) +AC_SUBST(ld_libs_all) +AC_SUBST(CFLAGS) +AC_SUBST(CPPFLAGS) +AC_SUBST(LDFLAGS) +RECURSIVE_MAKE_ARGS="\$(MFLAGS) CC='\$(CC)' CFLAGS='\$(CFLAGS)' LDFLAGS='\$(LDFLAGS)' CPPFLAGS='\$(CPPFLAGS)'" +AC_SUBST(RECURSIVE_MAKE_ARGS) + +AC_SUBST(native_sound_lib,$with_native_sound_lib) +AC_SUBST(sound_cflags) +AC_SUBST(RANLIB) +AC_SUBST(dynodump_arch) + +AC_SUBST(XEMACS_CC) +AC_SUBST(XE_CFLAGS) + +dnl The default is yes +if test "$with_prefix" = "yes"; then + AC_DEFINE(PREFIX_USER_DEFINED) +fi + +dnl The default is no +if test "$with_site_lisp" = "no"; then + AC_DEFINE(INHIBIT_SITE_LISP) +fi +dnl The default is yes +if test "$with_site_modules" = "no"; then + AC_DEFINE(INHIBIT_SITE_MODULES) +fi + +XE_SPACE(ac_configure_args, $ac_configure_args) +AC_DEFINE_UNQUOTED(EMACS_CONFIGURATION, "$ac_cv_build") +AC_DEFINE_UNQUOTED(EMACS_CONFIG_OPTIONS, "$ac_configure_args") + +dnl Following are deprecated + +null_string="" +AC_DEFINE_UNQUOTED(LD_SWITCH_X_SITE, $null_string) +AC_DEFINE_UNQUOTED(LD_SWITCH_X_SITE_AUX, $null_string) +AC_DEFINE_UNQUOTED(C_SWITCH_X_SITE, $null_string) +AC_DEFINE_UNQUOTED(LD_SWITCH_SITE, $null_string) +AC_DEFINE_UNQUOTED(C_SWITCH_SITE, $null_string) + +dnl Note: as a general rule, *only* define things here that are not +dnl autodetected. For things that are autodetected, define them +dnl at the point where the autodetection occurs or would occur, +dnl so that the user gets immediate feedback on the results of the +dnl autodetection. + +if test "$GNU_MALLOC" = "yes"; then AC_DEFINE(GNU_MALLOC) +elif test "$with_system_malloc" = "yes"; then AC_DEFINE(USE_SYSTEM_MALLOC) +elif test "$with_debug_malloc" = "yes"; then AC_DEFINE(USE_DEBUG_MALLOC) + AC_DEFINE(USE_SYSTEM_MALLOC) +fi +test "$GCC" = "yes" && AC_DEFINE(USE_GCC) +test "$enable_external_widget" = "yes" && AC_DEFINE(EXTERNAL_WIDGET) +test "$enable_kkcc" = "yes" && AC_DEFINE(USE_KKCC) +test "$enable_quick_build" = "yes" && AC_DEFINE(QUICK_BUILD) +test "$with_purify" = "yes" && AC_DEFINE(PURIFY) +test "$with_quantify" = "yes" && AC_DEFINE(QUANTIFY) +test "$with_pop" = "yes" && AC_DEFINE(MAIL_USE_POP) +test "$with_kerberos" = "yes" && AC_DEFINE(KERBEROS) +test "$with_hesiod" = "yes" && AC_DEFINE(HESIOD) +test "$enable_union_type" = "yes" && AC_DEFINE(USE_UNION_TYPE) +test "$enable_pdump" = "yes" && AC_DEFINE(PDUMP) +test "$with_ipv6_cname" = "yes" && AC_DEFINE(IPV6_CANONICALIZE) + + + +dnl ------------------------------------------------------------------------- +dnl ------------------------------- +dnl Report on what we decided to do +dnl ------------------------------- + +dnl #### We should tag this as the _build_ environment. +dnl Before doing that, though, must check if tools care about line 1. + +( +dnl /etc/osversion is on SONY NEWS-OS +if test -f /etc/osversion; then dnl SONY NEWS-OS + echo "osversion: `cat /etc/osversion`" +else + echo "uname -a: `uname -a`" +fi +echo "" +echo "$0 $ac_configure_args" +) > Installation + +if test ! -z ${emacs_beta_version} ; then + if test -z "${emacs_is_beta}" ; then + xemacs_betaname=".${emacs_beta_version}" + else + xemacs_betaname="-b${emacs_beta_version}" + fi +else + xemacs_betaname="" +fi + +dnl Start stdout redirection to '| tee -a Installation' +( +echo " + +XEmacs ${emacs_major_version}.${emacs_minor_version}${xemacs_betaname} \"$xemacs_codename\" $xemacs_extra_name configured for \`$ac_cv_build'. +" +echo " +Compilation Environment and Installation Defaults:" +echo " Source code location: $srcdir" +echo " Installation prefix: $prefix" +if test -n "$with_site_includes"; then + echo " Additional header files: $with_site_includes" +fi +if test -n "$with_site_libraries"; then + echo " Additional libraries: $with_site_libraries" +fi +if test -n "$with_site_prefixes"; then + echo " Additional prefixes: $with_site_prefixes" +fi +if test -n "$runpath"; then + echo " Runtime library search path: $runpath" +fi + +if test -n "$opsysfile" +then echo " Operating system description file: \`$opsysfile'" +else echo " Not using any operating system description file" +fi +if test -n "$machfile" +then echo " Machine description file: \`$machfile'" +else echo " Not using any machine description file" +fi + +echo " Compiler version: $compiler_version" +if test -n "$gcc_compiler_specs"; then + echo " - GCC specs file: $gcc_compiler_specs" +fi +echo " - Compiler command: $XEMACS_CC $XE_CFLAGS" +if test "$CC" != "$XEMACS_CC"; then + echo " Compiler version for lib-src: (detection code unimplemented)" + echo " - Compiler command for lib-src: $CC $CFLAGS" + if test "$xemacs_cc_cc_mismatch" = "yes"; then + echo " WARNING: CC and XEMACS_CC mismatched; check CFLAGS carefully." + fi +fi +echo " libc version: $libc_version" +echo " Relocating allocator for buffers: $with_rel_alloc" +echo " GNU version of malloc: ${GNU_MALLOC}${GNU_MALLOC_reason}" +case "$ld_switch_site" in + *nocombreloc*) echo " Linking with \`-z nocombreloc'. + - Consider configuring with --enable-pdump." ;; +esac + +echo " +Window System:" +if test "$with_msw" = "yes"; then + echo " Compiling in support for the Microsoft window system." +fi +if test "$with_x11" = "yes"; then + echo " Compiling in support for the X window system:" + echo " - X Windows headers location: $x_includes" + echo " - X Windows libraries location: $x_libraries" + if test "$with_xauth" != yes; then + echo " - Xau (X authority) not available." + fi + if test "$with_xmu" != yes; then + echo " - Xmu library not available; substituting equivalent routines." + fi + if test "$with_wmcommand" != no; then + echo " - Handling WM_COMMAND properly." + fi +fi +if test "$need_athena" = "yes"; then + echo " Compiling in support for the Athena widget set:" + echo " - Athena headers location: $athena_h_path" + echo " - Athena library to link: $athena_lib" +fi +case "$enable_menubars" in + gtk ) echo " Using GTK menubars." ;; + lucid ) echo " Using Lucid menubars." ;; + motif ) echo " Using Motif menubars." + echo " *WARNING* The Motif menubar implementation is currently buggy." + echo " We recommend using the Lucid menubar instead." + echo " Re-run configure with --enable-menubars='lucid'." ;; + msw ) echo " Using MS-Windows menubars." ;; +esac +case "$enable_scrollbars" in + gtk ) echo " Using GTK scrollbars." ;; + lucid ) echo " Using Lucid scrollbars." ;; + motif ) echo " Using Motif scrollbars." ;; + athena ) echo " Using Athena scrollbars." ;; + msw ) echo " Using MS-Windows scrollbars." ;; +esac +case "$enable_dialogs" in + gtk ) echo " Using GTK dialog boxes." ;; + motif ) echo " Using Motif dialog boxes." + if test "$unexec" = "unexaix.o"; then if test "`uname -v`" = 4 -a "`uname -r`" -ge 3; then + echo " *WARNING* The Motif dialog boxes cause problems on AIX 4.3 and higher." + echo " We recommend using the Athena dialog boxes instead." + echo " Install libXaw and re-run configure with --enable-dialogs='athena'." + echo " Read the PROBLEMS file for more information." + fi; fi ;; + athena ) echo " Using Athena dialog boxes." ;; + msw ) echo " Using MS-Windows dialog boxes." ;; +esac +case "$enable_widgets" in + gtk ) echo " Using GTK native widgets." ;; + motif ) echo " Using Motif native widgets." ;; + athena ) echo " Using Athena native widgets." ;; + msw ) echo " Using MS-Windows native widgets." ;; +esac +if test "$with_dragndrop" = yes; then + echo " Compiling in support for Drag'n'Drop (EXPERIMENTAL)." + echo " - Drag'n'Drop prototype: $dragndrop_proto." +fi + +echo " +TTY:" +test "$with_ncurses" = yes && echo " Compiling in support for ncurses." +test "$with_gpm" = yes && echo " Compiling in support for GPM (General Purpose Mouse)." + +echo " +Images:" +test "$with_gif" = yes && echo " Compiling in support for GIF images (builtin)." +if test "$with_xpm" = yes; then + echo " Compiling in support for XPM images." +elif test "$with_x11" = yes; then + echo " WARNING: -----------------------------------------------------------" + echo " WARNING: Compiling without XPM image support." + if test "$xpm_problem" != ""; then + echo " Reason: $xpm_problem" + fi + echo " WARNING: You should strongly consider installing XPM." + echo " WARNING: Otherwise toolbars and other graphics will look suboptimal." + echo " WARNING: (a copy may be found in ftp://ftp.xemacs.org/pub/xemacs/aux)" + echo " WARNING: -----------------------------------------------------------" +fi +if test "$with_png" = yes; then + echo " Compiling in support for PNG images." +elif test "$window_system" != "none"; then + echo " WARNING: -----------------------------------------------------------" + echo " WARNING: Compiling without PNG image support." + if test "$png_problem" != ""; then + echo " Reason: $png_problem" + fi + echo " WARNING: You should strongly consider installing the PNG libraries." + echo " WARNING: Otherwise certain images and glyphs may not display." + echo " WARNING: (a copy may be found in ftp://ftp.xemacs.org/pub/xemacs/aux)" + echo " WARNING: -----------------------------------------------------------" +fi +test "$with_jpeg" = yes && echo " Compiling in support for JPEG images." +test "$with_tiff" = yes && echo " Compiling in support for TIFF images." +test "$with_xface" = yes && echo " Compiling in support for X-Face message headers." + +echo " +Sound:" +test "$with_native_sound" = yes && echo " Compiling in support for sound (native)." +test "$with_nas_sound" = yes && echo " Compiling in support for NAS (network audio system)." +test "$old_nas" = yes && echo " - NAS library lacks error trapping; will play synchronously." +test "$with_esd_sound" = yes && echo " Compiling in support for ESD (Enlightened Sound Daemon)." + +echo " +Databases:" +test "$with_database_berkdb" = yes && echo " Compiling in support for Berkeley database." +test "$with_database_dbm" = yes && echo " Compiling in support for DBM." +test "$with_database_gdbm" = yes && echo " Compiling in support for GNU DBM." +test "$with_ldap" = yes && echo " Compiling in support for LDAP." +if test "$with_postgresql" = yes; then + echo " Compiling in support for PostgreSQL." + echo " - Using PostgreSQL header file: $libpq_fe_h_file" + test "$with_postgresqlv7" = yes && echo " - Using PostgreSQL V7 bindings." +fi + +echo " +Internationalization:" +test "$enable_mule" = yes && echo " Compiling in support for Mule (multi-lingual Emacs)." +test "$with_xim" != no && echo " Compiling in support for XIM (X11R5+ I18N input method)." +test "$with_xim" = motif && echo " - Using Motif to provide XIM support." +test "$with_xim" = xlib && echo " - Using raw Xlib to provide XIM support." +test "$with_xfs" = yes && echo " - Using XFontSet to provide bilingual menubar." +test "$with_canna" = yes && echo " Compiling in support for Canna on Mule." +if test "$with_wnn" = yes; then + echo " Compiling in support for the WNN input method on Mule." + test "$with_wnn6" = yes && echo " - Using WNN version 6." +fi + +echo " +Mail:" +test "$with_pop" = yes && echo " Compiling in support for POP mail retrieval." +test "$with_kerberos" = yes && echo " Compiling in support for Kerberos POP authentication." +test "$with_hesiod" = yes && echo " Compiling in support for Hesiod POP server access." +test -n "$with_mail_locking" && echo " Compiling in support for \"$with_mail_locking\" mail spool file locking method." + +echo " +Other Features:" +test "$with_ipv6_cname" = no && echo " Inhibiting IPv6 canonicalization at startup." +test "$with_tooltalk" = yes && echo " Compiling in support for ToolTalk." +test "$with_workshop" = yes && echo " Compiling in support for Sun WorkShop." +test "$with_socks" = yes && echo " Compiling in support for SOCKS." +test "$with_dnet" = yes && echo " Compiling in support for DNET." +test "$enable_modules" = "yes" && echo " Compiling in support for dynamic shared object modules." +test "$enable_bignum" = "gmp" && echo " Compiling in support for more number types using the GNU MP library." +test "$enable_bignum" = "mp" && echo " Compiling in support for more number types using the BSD MP library." +if test "$enable_union_type" = yes ; then + echo " Using the union type for Lisp_Objects." + echo " WARNING: ---------------------------------------------------------" + echo " WARNING: This tends to trigger compiler bugs, especially when" + echo " WARNING: combined with MULE and ERROR_CHECKING. Crashes have" + echo " WARNING: been seen with various versions of GCC (up to about 2.95)," + echo " WARNING: and recently with Visual C++ as well (mid-2003)." + echo " WARNING: More recent versions may be safer, or not." + echo " WARNING: ---------------------------------------------------------" +fi +test "$enable_kkcc" = yes && echo " Using the new GC algorithms." +test "$enable_pdump" = yes && echo " Using the new portable dumper." +test "$enable_debug" = yes && echo " Compiling in support for extra debugging code." +test "$usage_tracking" = yes && echo " Compiling in support for active usage tracking (Sun internal)." +if test "$error_check_extents $error_check_types $error_check_text $error_check_gc $error_check_malloc $error_check_glyphs $error_check_byte_code $error_check_display $error_check_structures" \ + != "no no no no no no no no no"; then + echo " Compiling in support for runtime error checking." + echo " WARNING: ---------------------------------------------------------" + echo " WARNING: XEmacs will run noticeably more slowly as a result." + echo " WARNING: Error checking is on by default for XEmacs beta releases." + echo " WARNING: ---------------------------------------------------------" +fi +echo "" +) | tee -a Installation +dnl echo "The above configure report is appended to \"Installation\" file." +echo "" + +dnl ----------------------------------- +dnl Now generate config.h and Makefiles +dnl ----------------------------------- +AC_CONFIG_HEADER(src/config.h lwlib/config.h) + +dnl This has to be called in order for this variable to get into config.status +AC_SUBST(internal_makefile_list) +# Remove any trailing slashes in these variables. +test -n "$prefix" && + prefix=`echo '' "$prefix" | sed -e 's:^ ::' -e 's,$[[^/]]$/*$,\1,'` +test -n "$exec_prefix" && + exec_prefix=`echo '' "$exec_prefix" | sed -e 's:^ ::' -e 's,$[[^/]]$/*$,\1,'` + +dnl Build Makefile.in's from Makefile.in.in's +dnl except ./Makefile from $srcdir/Makefile.in +dnl src/Makefile.in will have src/depend appended to it; +dnl module Makefiles will have the common text in +dnl modules/common/Makefile.common appended. + +for file in $internal_makefile_list; do + case $file in + src/Makefile.in ) file="src/Makefile.in:src/Makefile.in.in:src/depend" ;; + modules/* ) file="${file}:${file}.in:modules/common/Makefile.common" ;; + esac + AC_CONFIG_FILES($file) +done +AC_CONFIG_FILES(src/paths.h src/xemacs.def.in lib-src/config.values) +test "$enable_modules" = "yes" && AC_CONFIG_FILES(lib-src/ellcc.h) + + +dnl Normally []'s are used for quoting but this will cause problems +dnl since we use brackets in sed. When not inside of a macro definition, +dnl two brackets become one, but inside of a macro definition you need +dnl more, or something -- I don't understand, but Martin probably does. +dnl We put the brackets back later. +dnl [ben] + +dnl MAKE_JUNK_C(filename): +dnl Copy a .in file to junk.c in preparation for passing through the +dnl C preprocessor. Delete comment lines, pass lines that will be +dnl interpreted by cpp through directly, and put quotes around remaining +dnl lines, to avoid problems from overly helpful preprocessors that +dnl "helpfully" put extra quotes in various places for later use by the +dnl compiler. Later, the quotes will be removed. + +m4_define([MAKE_JUNK_C], +[ rm -f junk.c + < $1 \ + sed -e '/^# Generated/d' \ + -e 's%/\*\*/#.*%%' \ + -e 's/^ *# */#/' \ +dnl Delete Makefile.in.in comment lines + -e '/^##/d' \ +dnl Pass through CPP directives unchanged + -e '/^#/ { +p +d +}' \ +dnl Quote other lines to protect from CPP substitution + -e '/./ { +s/$[[\"]]$/\\\1/g +s/^/"/ +s/$/"/ +}' > junk.c; +])dnl MAKE_JUNK_C + +dnl CPP_MAKEFILE(CPPFLAGS,filename): +dnl Pass junk.c through the preprocessor and put the result in FILENAME. + +m4_define([CPP_MAKEFILE], +[echo creating $dir/$2 +$CPP -I. -I${srcdir}/src $1 junk.c \ +dnl Delete line directives inserted by $CPP + | sed -e 's/^\#.*//' \ +dnl Delete spurious blanks inserted by $CPP + -e 's/^[[ TAB]][[ TAB]]*$//'\ + -e 's/^ /TAB/' \ +dnl Delete blank lines + -e '/^[[ ]]*$/d' \ +dnl Restore lines quoted above to original contents. + -e '/^\"/ { + s/\\$[[\"]]$/\1/g + s/^[[ TAB]]*\"// + s/\"[[ TAB]]*$// +}' > Makefile.new + chmod 444 Makefile.new + mv -f Makefile.new $2 +])dnl CPP_MAKEFILE + +AC_CONFIG_COMMANDS([default], +[for dir in . $MAKE_SUBDIR; do + ( + cd $dir + +dnl Create a GNUmakefile and Makefile from Makefile.in. +dnl Create xemacs.def from xemacs.def.in in the same fashion, +dnl if it exists (i.e. in the src/ directory). + MAKE_JUNK_C(Makefile.in) + CPP_MAKEFILE(,Makefile) + CPP_MAKEFILE(-DUSE_GNU_MAKE,GNUmakefile) + if test -r "xemacs.def.in"; then +dnl #### We should be using MAKE_JUNK_C instead of the next two lines. +dnl #### But the comments in xemacs.def.in need to be converted from C-style +dnl #### to lines beginning with ##. + rm -f junk.c + cp xemacs.def.in junk.c + CPP_MAKEFILE(,xemacs.def) + fi + rm -f junk.c + ) +done + +dnl Append AC_DEFINE information to lib-src/config.values +dnl (AC_SUBST information is already there (see config.values.sh). +sed < config.status >> lib-src/config.values \ + -e '/{ac_dA}.*{ac_dB}.*{ac_dC}.*{ac_dD}$/!d' \ + -e 's/\${ac_dA}$.*$\${ac_dB}.*\${ac_dC}$.*$\${ac_dD}/\1 \2/' \ + -e 's/^$[[^ ]]*$ $/\1 ""/' \ + -e 's/ 1$/ t/' + +], +[CPP="$CPP" + MAKE_SUBDIR="$MAKE_SUBDIR" +])dnl + +AC_OUTPUT()dnl + Index: lib-src/config.values.sh =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lib-src/config.values.sh,v retrieving revision 1.3 diff -u -r1.3 config.values.sh --- lib-src/config.values.sh 2001/05/17 13:44:34 1.3 +++ lib-src/config.values.sh 2005/01/04 00:07:19 ＠＠ -80,7 +80,7 ＠＠ my %done; for my $var (sort { $a cmp $b } $configure_contents =~ - /^s\%\＠([A-Za-z0-9_]+)\＠\%\$[A-Za-z0-9_]+\%g/mg) { + /^s\,\＠([A-Za-z0-9_]+)\＠\,\$[A-Za-z0-9_]+\,;t t/mg) { $new_cvi_contents .= "$var \"\＠$var\＠\"\n" unless exists $done{$var}; $done{$var} = 1; } Index: src/config.h.in =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/config.h.in,v retrieving revision 1.95 diff -u -r1.95 config.h.in --- src/config.h.in 2004/11/04 23:06:17 1.95 +++ src/config.h.in 2005/01/04 00:07:23 ＠＠ -322,7 +322,7 ＠＠ #undef HAVE_LIBRESOLV /* Is `sys_siglist' declared by <signal.h>? */ -#undef SYS_SIGLIST_DECLARED +#undef HAVE_DECL_SYS_SIGLIST /* Is `struct timeval' declared by <sys/time.h>? */ #undef HAVE_TIMEVAL ＠＠ -417,22 +417,38 ＠＠ #undef HAVE_SIGSETJMP /* Many flavors of PTY support */ -#undef HAVE_GETPT /* glibc's easy pty allocation function */ -#undef HAVE__GETPTY /* SGI's easy pty allocation function */ -#undef HAVE_OPENPTY /* BSD's easy pty allocation function */ -#undef HAVE_GRANTPT /* Unix98 */ -#undef HAVE_UNLOCKPT /* Unix98 */ -#undef HAVE_PTSNAME /* Unix98 */ -#undef HAVE_KILLPG /* BSD */ -#undef HAVE_TCGETPGRP /* Posix 1 */ -#undef HAVE_ISASTREAM /* SysV streams */ -#undef HAVE_SYS_PTY_H /* AIX */ -#undef HAVE_SYS_PTYIO_H /* HP-UX */ -#undef HAVE_PTY_H /* Linux, Tru64 */ -#undef HAVE_LIBUTIL_H /* BSD openpty */ -#undef HAVE_UTIL_H /* NetBSD openpty */ -#undef HAVE_STROPTS_H /* SysV streams */ -#undef HAVE_STRTIO_H /* SysV streams TIOCSIGNAL */ +/* glibc's easy pty allocation function */ +#undef HAVE_GETPT +/* SGI's easy pty allocation function */ +#undef HAVE__GETPTY +/* BSD's easy pty allocation function */ +#undef HAVE_OPENPTY +/* Unix98 */ +#undef HAVE_GRANTPT +/* Unix98 */ +#undef HAVE_UNLOCKPT +/* Unix98 */ +#undef HAVE_PTSNAME +/* BSD */ +#undef HAVE_KILLPG +/* Posix 1 */ +#undef HAVE_TCGETPGRP +/* SysV streams */ +#undef HAVE_ISASTREAM +/* AIX */ +#undef HAVE_SYS_PTY_H +/* HP-UX */ +#undef HAVE_SYS_PTYIO_H +/* Linux, Tru64 */ +#undef HAVE_PTY_H +/* BSD openpty */ +#undef HAVE_LIBUTIL_H +/* NetBSD openpty */ +#undef HAVE_UTIL_H +/* SysV streams */ +#undef HAVE_STROPTS_H +/* SysV streams TIOCSIGNAL */ +#undef HAVE_STRTIO_H #undef HAVE_SOCKETS #undef HAVE_SOCKADDR_SUN_LEN ＠＠ -509,7 +525,8 ＠＠ /* Do we have PostgreSQL RDBMS support? */ #undef HAVE_POSTGRESQL #undef HAVE_POSTGRESQLV7 -#undef LIBPQ_FE_H_FILE /* main PostgreSQL header file */ +/* main PostgreSQL header file */ +#undef LIBPQ_FE_H_FILE /* Do you have the Xauth library present? This will add some extra functionality to gnuserv. */ Index: src/syssignal.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/syssignal.h,v retrieving revision 1.15 diff -u -r1.15 syssignal.h --- src/syssignal.h 2004/09/20 19:20:02 1.15 +++ src/syssignal.h 2005/01/04 00:07:25 ＠＠ -267,10 +267,10 ＠＠ # endif #endif -/* SYS_SIGLIST_DECLARED is determined by configure. On Linux, it seems, +/* HAVE_DECL_SYS_SIGLIST is determined by configure. On Linux, it seems, configure incorrectly fails to find it, so s/linux.h defines HAVE_SYS_SIGLIST. */ -#if !defined (SYS_SIGLIST_DECLARED) && !defined (HAVE_SYS_SIGLIST) +#if !defined (HAVE_DECL_SYS_SIGLIST) && !defined (HAVE_SYS_SIGLIST) extern const char *sys_siglist[]; #endif -- Malcolm Purvis <malcolmpurvis(a)optushome.com.au> Q: Why did the chicken cross the Mobius strip? A: To get to the other... uh... err...

1 participants
0 comments

[AC] Fix path-searching breakage 19 years, 3 months

Michael Sperber

2005-01-03 Mike Sperber <mike(a)xemacs.org> * dumped-lisp.el (preloaded-file-list): Prefix Mule files with mule/, unbreaking the build. Index: lisp/dumped-lisp.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/dumped-lisp.el,v retrieving revision 1.49 retrieving revision 1.50 diff -u -r1.49 -r1.50 --- lisp/dumped-lisp.el 4 Nov 2004 23:05:55 -0000 1.49 +++ lisp/dumped-lisp.el 3 Jan 2005 10:29:13 -0000 1.50 ＠＠ -158,23 +158,23 ＠＠ "unicode" ;;;;;;;;;;;;;;;;;; MULE support (when (featurep 'mule) - '("mule-charset" - "mule-cmds" ; to sync with Emacs 20.1 - "mule-coding" - "mule-composite-stub" - "mule-composite" + '("mule/mule-charset" + "mule/mule-cmds" ; to sync with Emacs 20.1 + "mule/mule-coding" + "mule/mule-composite-stub" + "mule/mule-composite" )) ;; may initialize coding systems - (when (featurep '(and mule x)) "mule-x-init") - (when (featurep '(and mule tty)) "mule-tty-init") + (when (featurep '(and mule x)) "mule/mule-x-init") + (when (featurep '(and mule tty)) "mule/mule-tty-init") (when (and (featurep 'mule) (memq system-type '(windows-nt cygwin32))) - "mule-win32-init") + "mule-mule/win32-init") "code-init" ; set up defaults ;; All files after this can have extended characters in them. (when (featurep 'mule) - '("mule-category" - "mule-ccl" - "kinsoku" + '("mule/mule-category" + "mule/mule-ccl" + "mule/kinsoku" )) ;; after this goes the specific lisp routines for a particular input system ＠＠ -196,35 +196,35 ＠＠ ;; compile with -no-packages. (when (featurep 'mule) - '("arabic" - "chinese" - "cyrillic" - "english" - "ethiopic" - "european" - "greek" - "hebrew" - "indian" - "devanagari" ; must be loaded after indian.el - "japanese" - "korean" - "lao" - "latin" - "misc-lang" + '("mule/arabic" + "mule/chinese" + "mule/cyrillic" + "mule/english" + "mule/ethiopic" + "mule/european" + "mule/greek" + "mule/hebrew" + "mule/indian" + "mule/devanagari" ; must be loaded after indian.el + "mule/japanese" + "mule/korean" + "mule/lao" + "mule/latin" + "mule/misc-lang" ;; "thai" #### merge thai and thai-xtis!!! - "thai-xtis" - "tibetan" - "vietnamese" + "mule/thai-xtis" + "mule/tibetan" + "mule/vietnamese" )) ;; Specialized language support - (when (featurep '(and mule CANNA)) "canna-leim") + (when (featurep '(and mule CANNA)) "mule/canna-leim") ;; Egg/Its is now a package ; (when (featurep '(and mule wnn)) ; '("egg-leim" "egg-kwnn-leim" "egg-cwnn-leim")) -; (when (featurep 'mule) "egg-sj3-leim") +; (when (featurep 'mule) "mule/egg-sj3-leim") ;; SKK is now a package -; (when (featurep 'mule) "skk-leim") +; (when (featurep 'mule) "mule/skk-leim") ;; Enable Mule capability for Gnus, mail, etc... ;; Moved to sunpro-load.el - the default only for Sun. ＠＠ -233,7 +233,7 ＠＠ ;; needs access to the charsets created by the above ;; language-specific files. (when (and (featurep 'mule) (valid-console-type-p 'mswindows)) - "mule-msw-init-late") + "mule/mule-msw-init-late") ;;; mule-load.el ends here -- Cheers =8-} Mike Friede, Völkerverständigung und überhaupt blabla

1 participants
0 comments

[AC] [PACKAGES (xwem)] Version 2.0 is released! 19 years, 4 months

Steve Youngs

APPROVE COMMIT Norbert! This is good to go. NOTE: This patch has been committed. xwem patch: ChangeLog files diff command: cvs -q diff -U 0 Files affected: ChangeLog Source files diff command: cvs -q diff -uN Files affected: man/xwem.texi man/xwem-version.texi lisp/xwem-xfig.el lisp/xwem-worklog.el lisp/xwem-win.el lisp/xwem-weather.el lisp/xwem-transient.el lisp/xwem-theme.el lisp/xwem-tabbing.el lisp/xwem-strokes.el lisp/xwem-special.el lisp/xwem-sound.el lisp/xwem-selections.el lisp/xwem-rooticon.el lisp/xwem-root.el lisp/xwem-register.el lisp/xwem-pager.el lisp/xwem-osd.el lisp/xwem-netwm.el lisp/xwem-mouse.el lisp/xwem-modes.el lisp/xwem-minibuffer.el lisp/xwem-manage.el lisp/xwem-main.el lisp/xwem-load.el lisp/xwem-keytt.el lisp/xwem-keymacro.el lisp/xwem-keydefs.el lisp/xwem-keyboard.el lisp/xwem-interactive.el lisp/xwem-icons.el lisp/xwem-holer.el lisp/xwem-help.el lisp/xwem-frametrans.el lisp/xwem-framei.el lisp/xwem-frame.el lisp/xwem-focus.el lisp/xwem-faces.el lisp/xwem-events.el lisp/xwem-edprops.el lisp/xwem-edmacro.el lisp/xwem-diagram.el lisp/xwem-desktop.el lisp/xwem-compat.el lisp/xwem-clswi.el lisp/xwem-clients.el lisp/xwem-clgen.el lisp/xwem-battery.el lisp/xwem-appcollect.el lisp/ixwem.el icons/mini-xv.xpm icons/mini-graph.xpm icons/mini-display.xpm icons/README package-info.in Makefile ChangeLog.upstream Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/ChangeLog,v retrieving revision 1.74 diff -u -U0 -r1.74 ChangeLog --- ChangeLog 16 Dec 2004 08:07:47 -0000 1.74 +++ ChangeLog 1 Jan 2005 04:41:39 -0000 ＠＠ -0,0 +1,8 ＠＠ +2005-01-01 Steve Youngs <steve(a)youngs.au.com> + + * Makefile (AUTHOR_VERSION): Bump. + (REQUIRES): Add elib, ilisp, and mail-lib. + + This is the version 2.0 release. For details see + ChangeLog.upstream. + Index: ChangeLog.upstream =================================================================== RCS file: ChangeLog.upstream diff -N ChangeLog.upstream --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ ChangeLog.upstream 1 Jan 2005 04:41:09 -0000 ＠＠ -0,0 +1,730 ＠＠ +# do not edit -- automatically generated by arch changelog +# non-id: automatic-ChangeLog--lg(a)xwem.org--2004/xwem--main--2.0 +# + +2005-01-01 02:30:16 GMT Zajcev Evgeny <lg(a)xwem.org> version-0 + + Summary: + Version 2.0 is released + Revision: + xwem--main--2.0--version-0 + + + new files: + .arch-ids/README.id README + + +2004-12-29 22:32:15 GMT Zajcev Evgeny <lg(a)xwem.org> patch-19 + + Summary: + xparent problem kind of fix, dedicated problem kind of fix + Revision: + xwem--main--2.0--patch-19 + + * lisp/xwem-clgen.el (on-kill): [fix?] Do not do XDestroyWindow + + * lisp/xwem-clients.el (xwem-clded-disassociate-frame): [fix] check + xwem-cl-win for validity before operating on it. + + + + modified files: + lisp/xwem-clgen.el lisp/xwem-clients.el + + +2004-12-23 22:26:45 GMT Zajcev Evgeny <lg(a)xwem.org> patch-18 + + Summary: + very tiny fixes + Revision: + xwem--main--2.0--patch-18 + + * lisp/xwem-icons.el (xwem-icons-list): [fix] Removed redundant .* + + * lisp/xwem-keymacro.el (xwem-misc): [addon] Require xwem-misc + + * lisp/xwem-manage.el (xwem-applications-alist): [fix] xemacs to match + GNU Emacs, XEmacs and SXEmacs. + + + + + modified files: + lisp/xwem-icons.el lisp/xwem-keymacro.el lisp/xwem-manage.el + + +2004-12-20 21:03:40 GMT Zajcev Evgeny <lg(a)xwem.org> patch-17 + + Summary: + Merged with 2004-w + Revision: + xwem--main--2.0--patch-17 + + Patches applied: + + * dev(a)xwem.org--2004-w/xwem--dev--2.0--patch-3 + Merged with main, some fixes + + + modified files: + Makefile lisp/xwem-keymacro.el lisp/xwem-minibuffer.el + lisp/xwem-misc.el man/Makefile + + new patches: + dev(a)xwem.org--2004-w/xwem--dev--2.0--patch-3 + + +2004-12-19 22:45:44 GMT Zajcev Evgeny <lg(a)xwem.org> patch-16 + + Summary: + xwem tray fixes to support dockapp's map/unmap, osd fix + Revision: + xwem--main--2.0--patch-16 + + * lisp/xwem-keyboard.el (xwem-kbd-quit): [typo] + + * lisp/xwem-tray.el (xwem-tray-remove-dapp): [fix] check dapp state. + + * lisp/xwem-tray.el (xwem-tray-hide-dapp): [new] + + * lisp/xwem-tray.el (xwem-tray-show-dapp): [new] + + * lisp/xwem-tray.el (xwem-tray-get-proper-position): [fix] check dapp's + state. + + * lisp/xwem-tray.el (xwem-tray-new-dapp): [fix] change dapp's state after + XMapWindow. + + * lisp/xwem-tray.el (xwem-tray-init): [fix] Handle MapNotify/UnmapNotify + events. + + * lisp/xwem-tray.el (xwem-tray-handle-xevent): [fix] Handle + MapNotify/UnmapNotify events. + + * utils/xwem-osd.el (xwem-osd-rect-add): [Sem] Optional FILL-P argument + added. + + modified files: + lisp/xwem-keyboard.el lisp/xwem-tray.el utils/xwem-osd.el + + +2004-12-19 01:40:32 GMT Zajcev Evgeny <lg(a)xwem.org> patch-15 + + Summary: + compile custom-load.el + Revision: + xwem--main--2.0--patch-15 + + * Makefile (EXTRA_OBJ): [addon] custom-load.elc + + * Makefile (distclean): [addon] remove .elc files expilicitely. + + modified files: + Makefile + + +2004- + + modified files: + Makefile lisp/xwem-frame.el lisp/xwem-minibuffer.el + lisp/xwem-misc.el lisp/xwem-tabbing.el lisp/xwem-theme.el + lisp/xwem-win.el lpath.el man/Makefile + + +2004-12-11 21:22:18 GMT Evgeny Zajcev <lg(a)xwem.org> patch-5 + + Summary: + hot fix + Revision: + xwem--main--2.0--patch-5 + + + modified files: + Makefile lisp/xwem-clients.el lisp/xwem-main.el + lisp/xwem-minibuffer.el lisp/xwem-root.el + + +2004-12-11 20:33:02 GMT Evgeny Zajcev <lg(a)xwem.org> patch-4 + + Summary: + Sync with CVS, some fixes. + Revision: + xwem--main--2.0--patch-4 + + lisp/xwem-clgen.el (xwem-withdraw-generic): [rem] Evil things removed to + avoid BadWindow X errors. + + lisp/xwem-keyboard.el (modifiers): [sch] Modifiers handling changed. Alt + key should work, however not checked. + + lisp/xwem-clients.el (xwem-client-apply-state): [fix] Handle change to + withdrawn state specially to avoid BadWindow X errors. + + lisp/xwem-root.el (xwem-root-events-handler): [addon] X-MappingNotify + handler added. + + lisp/xwem-events.el (xwem-ev-reconfig): [fix] Do things more safely, + should fix opera issue. + + lisp/xwem-win.el (xwem-frame-set-win-config-frame-params): [fix] use + `xwem-frame-apply-xgeom-1'. + + + modified files: + lisp/xwem-clgen.el lisp/xwem-clients.el lisp/xwem-events.el + lisp/xwem-keyboard.el lisp/xwem-main.el lisp/xwem-root.el + lisp/xwem-win.el + + +2004-12-10 23:29:27 GMT Evgeny Zajcev <lg(a)xwem.org> patch-3 + + Summary: + merge from steve (build cleanup) + Revision: + xwem--main--2.0--patch-3 + + Patches applied: + + * steve(a)eicq.org--2004/xwem--steve--2.0--patch-4 + sync to lg + + * steve(a)eicq.org--2004/xwem--steve--2.0--patch-5 + fix some function foo not known to be defined warnings + + + modified files: + lpath.el + + new patches: + steve(a)eicq.org--2004/xwem--steve--2.0--patch-4 + steve(a)eicq.org--2004/xwem--steve--2.0--patch-5 + + +2004-12-10 22:46:33 GMT Evgeny Zajcev <lg(a)xwem.org> patch-2 + + Summary: + makefile changes + Revision: + xwem--main--2.0--patch-2 + + + modified files: + Makefile + + +2004-12-10 21:51:10 GMT Evgeny Zajcev <lg(a)xwem.org> patch-1 + + Summary: + merge from steve + Revision: + xwem--main--2.0--patch-1 + + Patches applied: + + * steve(a)eicq.org--2004/xwem--steve--2.0--base-0 + tag of lg(a)xwem.org--2004/xwem--main--2.0--base-0 + + * steve(a)eicq.org--2004/xwem--steve--2.0--patch-1 + Add some missing files to the repo + + * steve(a)eicq.org--2004/xwem--steve--2.0--patch-2 + Introduce a tla-stlye version string, clean up the build + + * steve(a)eicq.org--2004/xwem--steve--2.0--patch-3 + emergancy build fix + + + new files: + .arch-ids/Makefile.id .arch-ids/xwem-loaddefs-gen.el.id + Makefile battery/.arch-ids/=id battery/.arch-ids/Makefile.id + battery/.arch-ids/battery.c.id battery/Makefile + battery/battery.c dockapp/.arch-ids/.arch-inventory.id + dockapp/.arch-ids/=id dockapp/.arch-ids/xwem-battery.el.id + dockapp/.arch-ids/xwem-framei.el.id + dockapp/.arch-ids/xwem-pager.el.id + dockapp/.arch-ids/xwem-time.el.id + dockapp/.arch-ids/xwem-weather.el.id dockapp/.arch-inventory + dockapp/xwem-battery.el dockapp/xwem-framei.el + dockapp/xwem-pager.el dockapp/xwem-time.el + dockapp/xwem-weather.el extra/.arch-ids/.arch-inventory.id + extra/.arch-ids/=id extra/.arch-ids/ixwem.el.id + extra/.arch-ids/xwem-edprops.el.id + extra/.arch-ids/xwem-frametrans.el.id + extra/.arch-ids/xwem-recover.el.id + extra/.arch-ids/xwem-smartmods.el.id + extra/.arch-ids/xwem-vert.el.id extra/.arch-inventory + extra/ixwem.el extra/xwem-edprops.el extra/xwem-frametrans.el + extra/xwem-recover.el extra/xwem-smartmods.el + extra/xwem-vert.el icons/.arch-ids/=id + icons/.arch-ids/README.id icons/.arch-ids/mini-acroread.xpm.id + icon + icons/mini-xchat1.xpm icons/mini-xdvi.xpm + icons/mini-xemacs.xpm icons/mini-xemacs1.xpm + icons/mini-xemacsC.xpm icons/mini-xemacsgnus.xpm + icons/mini-xemacsinfo.xpm icons/mini-xemacspy.xpm + icons/mini-xemacstex.xpm icons/mini-xfig.xpm + icons/mini-xkeycaps.xpm icons/mini-xterm.xpm + icons/mini-xterm1.xpm icons/mini-xv.xpm icons/mini-xv1.xpm + icons/mini-xwem.xpm icons/mini-zoom.xpm + icons/mini32x32-help.xpm icons/root-icon.xpm + lisp/.arch-ids/.arch-inventory.id lisp/.arch-ids/=id + lisp/.arch-ids/xwem-clgen.el.id + lisp/.arch-ids/xwem-clients.el.id + lisp/.arch-ids/xwem-clswi.el.id + lisp/.arch-ids/xwem-compat.el.id + lisp/.arch-ids/xwem-desktop.el.id + lisp/.arch-ids/xwem-edmacro.el.id + lisp/.arch-ids/xwem-events.el.id + lisp/.arch-ids/xwem-faces.el.id + lisp/.arch-ids/xwem-focus.el.id + lisp/.arch-ids/xwem-frame.el.id + lisp/.arch-ids/xwem-gamma.el.id lisp/.arch-ids/xwem-help.el.id + lisp/.arch-ids/xwem-icons.el.id + lisp/.arch-ids/xwem-interactive.el.id + lisp/.arch-ids/xwem-keyboard.el.id + lisp/.arch-ids/xwem-keydefs.el.id + lisp/.arch-ids/xwem-keymacro.el.id + lisp/.arch-ids/xwem-launcher.el.id + lisp/.arch-ids/xwem-load.el.id lisp/.arch-ids/xwem-main.el.id + lisp/.arch-ids/xwem-manage.el.id + lisp/.arch-ids/xwem-minibuffer.el.id + lisp/.arch-ids/xwem-misc.el.id lisp/.arch-ids/xwem-modes.el.id + lisp/.arch-ids/xwem-mouse.el.id + lisp/.arch-ids/xwem-netwm.el.id + lisp/.arch-ids/xwem-ratanot.el.id + lisp/.arch-ids/xwem-register.el.id + lisp/.arch-ids/xwem-report.el.id + lisp/.arch-ids/xwem-root.el.id + lisp/.arch-ids/xwem-rooter.el.id + lisp/.arch-ids/xwem-rooticon.el.id + lisp/.arch-ids/xwem-selections.el.id + lisp/.arch-ids/xwem-sound.el.id + lisp/.arch-ids/xwem-special.el.id + lisp/.arch-ids/xwem-strokes.el.id + lisp/.arch-ids/xwem-struct.el.id + lisp/.arch-ids/xwem-tabbing.el.id + lisp/.arch-ids/xwem-theme.el.id + lisp/.arch-ids/xwem-transient.el.id + lisp/.arch-ids/xwem-tray.el.id lisp/.arch-ids/xwem-win.el.id + lisp/.arch-inventory lisp/xwem-clgen.el lisp/xwem-clients.el + lisp/xwem-clswi.el lisp/xwem-compat.el lisp/xwem-desktop.el + lisp/xwem-edmacro.el lisp/xwem-events.el lisp/xwem-faces.el + lisp/xwem-focus.el lisp/xwem-frame.el lisp/xwem-gamma.el + lisp/xwem-help.el lisp/xwem-icons.el lisp/xwem-interactive.el + lisp/xwem-keyboard.el lisp/xwem-keydefs.el + lisp/xwem-keymacro.el lisp/xwem-launcher.el lisp/xwem-load.el + lisp/xwem-main.el lisp/xwem-manage.el lisp/xwem-minibuffer.el + lisp/xwem-misc.el lisp/xwem-modes.el lisp/xwem-mouse.el + lisp/xwem-netwm.el lisp/xwem-ratanot.el lisp/xwem-register.el + lisp/xwem-report.el lisp/xwem-root.el lisp/xwem-rooter.el + lisp/xwem-rooticon.el lisp/xwem-selections.el + lisp/xwem-sound.el lisp/xwem-special.el lisp/xwem-strokes.el + lisp/xwem-struct.el lisp/xwem-tabbing.el lisp/xwem-theme.el + lisp/xwem-transient.el lisp/xwem-tray.el lisp/xwem-win.el + man/.arch-ids/.arch-inventory.id man/.arch-ids/=id + man/.arch-ids/Makefile.id man/.arch-ids/addons.texi.id + man/.arch-ids/client.texi.id man/.arch-ids/frame.texi.id + man/.arch-ids/help.texi.id man/.arch-ids/hooking.texi.id + man/.arch-ids/logging.texi.id man/.arch-ids/manda.texi.id + man/.arch-ids/minibuf.texi.id man/.arch-ids/overview.texi.id + man/.arch-ids/primitives.texi.id man/.arch-ids/start.texi.id + man/.arch-ids/subsystems.texi.id + man/.arch-ids/textspec.texi.id man/.arch-ids/tray.texi.id + man/.arch-ids/win.texi.id man/.arch-ids/xwem.texi.id + man/.arch-inventory man/Makefile man/addons.texi + man/client.texi man/frame.texi man/help.texi man/hooking.texi + man/logging.texi man/manda.texi man/minibuf.texi + man/overview.texi man/primitives.texi man/start.texi + man/subsystems.texi man/textspec.texi man/tray.texi + man/win.texi man/xwem.texi utils/.arch-ids/.arch-inventory.id + utils/.arch-ids/=id utils/.arch-ids/xwem-appcollect.el.id + utils/.arch-ids/xwem-diagram.el.id + utils/.arch-ids/xwem-holer.el.id + utils/.arch-ids/xwem-osd.el.id + utils/.arch-ids/xwem-worklog.el.id + utils/.arch-ids/xwem-xfig.el.id utils/.arch-inventory + utils/xwem-appcollect.el utils/xwem-diagram.el + utils/xwem-holer.el utils/xwem-osd.el utils/xwem-worklog.el + utils/xwem-xfig.el xwem-loaddefs-gen.el + + modified files: + lpath.el package-info.in + + renamed files: + .arch-ids/Makefile.id + ==> .arch-ids/Makfile.CVS.id + Makefile + ==> Makfile.CVS + + new directories: + battery battery/.arch-ids dockapp dockapp/.arch-ids extra + extra/.arch-ids icons icons/.arch-ids lisp lisp/.arch-ids man + man/.arch-ids utils utils/.arch-ids + + new patches: + steve(a)eicq.org--2004/xwem--steve--2.0--base-0 + steve(a)eicq.org--2004/xwem--steve--2.0--patch-1 + steve(a)eicq.org--2004/xwem--steve--2.0--patch-2 + steve(a)eicq.org--2004/xwem--steve--2.0--patch-3 + + +2004-12-08 19:22:14 GMT Evgeny Zajcev <lg(a)xwem.org> base-0 + + Summary: + Initial import of xwem sources. + Revision: + xwem--main--2.0--base-0 + + + new files: + ChangeLog.CVS Makefile TODO logo.xpm lpath.el package-info.in + + Index: Makefile =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/Makefile,v retrieving revision 1.29 diff -u -u -r1.29 Makefile --- Makefile 16 Dec 2004 08:07:47 -0000 1.29 +++ Makefile 1 Jan 2005 04:41:09 -0000 ＠＠ -18,11 +18,12 ＠＠ # Boston, MA 02111-1307, USA. VERSION = 1.18 -AUTHOR_VERSION = 0.2 +AUTHOR_VERSION = lg(a)xwem.org--2004/xwem--main--2.0--version-0 MAINTAINER = Zajcev Evgeny <zevlg(a)yandex.ru> PACKAGE = xwem PKG_TYPE = regular -REQUIRES = xwem xemacs-base xlib strokes edit-utils text-modes time slider +REQUIRES = xwem xemacs-base xlib strokes edit-utils text-modes time slider \ + elib ilisp mail-lib CATEGORY = standard DONTCOMPILE = lisp/_pkg.el lisp/auto-autoloads.el lisp/custom-load.el Index: package-info.in =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/package-info.in,v retrieving revision 1.4 diff -u -u -r1.4 package-info.in --- package-info.in 16 Dec 2004 08:07:48 -0000 1.4 +++ package-info.in 1 Jan 2005 04:41:09 -0000 ＠＠ -13,17 +13,21 ＠＠ filename FILENAME md5sum MD5SUM size SIZE - provides (xwem-clients xwem-compat xwem-events xwem-faces - xwem-focus xwem-frame xwem-help xwem-icons - xwem-interactive xwem-keyboard xwem-keydefs - xwem-keymacro xwem-launcher xwem-load xwem-macros - xwem-main xwem-manage xwem-minibuffer xwem-misc - xwem-mouse xwem-root xwem-sound xwem-special - xwem-strokes xwem-tabbing xwem-tray xwem-win - xwem-clswi xwem-diagram xwem-edmacro xwem-framei - xwem-gamma xwem-holer xwem-osd xwem-register - xwem-rooter xwem-smartmods xwem-time xwem-worklog - xwem-xfig xwem-keytt) + provides (ixwem xwem-appcollect xwem-battery xwem-clgen + xwem-clients xwem-clswi xwem-compat xwem-desktop + xwem-diagram xwem-edmacro xwem-edprops xwem-events + xwem-faces xwem-focus xwem-frame xwem-framei + xwem-frametrans xwem-gamma xwem-help xwem-holer + xwem-icons xwem-interactive xwem-keyboard xwem-keydefs + xwem-keymacro xwem-keytt xwem-launcher xwem-load + xwem-loaddefs xwem-macros xwem-main xwem-manage + xwem-minibuffer xwem-misc xwem-modes xwem-mouse + xwem-netwm xwem-osd xwem-pager xwem-ratanot xwem-recover + xwem-register xwem-report xwem-root xwem-rooter + xwem-rooticon xwem-selections xwem-smartmods xwem-sound + xwem-special xwem-strokes xwem-struct xwem-tabbing + xwem-theme xwem-time xwem-transient xwem-tray xwem-version + xwem-vert xwem-weather xwem-win xwem-worklog xwem-xfig) requires (REQUIRES) type regular )) Index: icons/README =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/icons/README,v retrieving revision 1.3 diff -u -u -r1.3 README --- icons/README 16 Dec 2004 08:07:58 -0000 1.3 +++ icons/README 1 Jan 2005 04:41:09 -0000 ＠＠ -37,6 +37,10 ＠＠ * "};" must be on its own line at the end of file. * ' ' must be used for None color. + + * Do not use ',' character to denote color. + + * No trailing spaces in any line. Recommended, but not required: Index: icons/mini-display.xpm =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/icons/mini-display.xpm,v retrieving revision 1.3 diff -u -u -r1.3 mini-display.xpm --- icons/mini-display.xpm 16 Dec 2004 08:07:58 -0000 1.3 +++ icons/mini-display.xpm 1 Jan 2005 04:41:09 -0000 ＠＠ -1,28 +1,27 ＠＠ /* XPM */ static char *mini_display_xpm[] = { /* columns rows colors chars-per-pixel */ -"16 16 6 1", +"16 16 5 1", " c None", ". c gray50", "X c white", "o c black", "O c blue", -"+ c gray85", /* pixels */ -" ", -" ............ ", -" .XXXXXXXXXXXXo ", -" .Xooooooooo.Xo ", -" .XoOOOOOOOO.Xo ", -" .XoOXOOOOOO.Xo ", -" .XoOOOOOOOO.Xo ", -" .XoOOOOOOOO.Xo ", -" .XoOOOOOOOO.Xo ", -" .XoOOOOOOOO.Xo ", -" .Xo.........Xo ", -" .XXXXXXXXXXXXo ", -" oooooooooooo ", -" .XXXX+.o ", -" oooooooooooo ", -" " +" ", +" ............ ", +" .XXXXXXXXXXXXo ", +" .Xooooooooo.Xo ", +" .XoOOOOOOOO.Xo ", +" .XoOXXOOOOO.Xo ", +" .XoOOOOOOOO.Xo ", +" .XoOOOOOOOO.Xo ", +" .XoOOOOOOOO.Xo ", +" .XoOOOOOOOO.Xo ", +" .Xo.........Xo ", +" .XXXXXXXXXXXXo ", +" oooooooooooo ", +" .XXXX..o ", +" oooooooooooo ", +" " }; Index: icons/mini-graph.xpm =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/icons/mini-graph.xpm,v retrieving revision 1.3 diff -u -u -r1.3 mini-graph.xpm --- icons/mini-graph.xpm 16 Dec 2004 08:07:58 -0000 1.3 +++ icons/mini-graph.xpm 1 Jan 2005 04:41:09 -0000 ＠＠ -10,6 +10,7 ＠＠ "r c red", "＠ c #808080", /* pixels */ +" ", " ### ", " mm# ", " mm# ", ＠＠ -24,8 +25,5 ＠＠ " gg# bb# mm# rr#", " gg# bb# mm# rr#", "################", -" ＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠", -" " -}; - - \ No newline at end of file +" ＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠" +}; Index: icons/mini-xv.xpm =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/icons/mini-xv.xpm,v retrieving revision 1.3 diff -u -u -r1.3 mini-xv.xpm --- icons/mini-xv.xpm 16 Dec 2004 08:07:58 -0000 1.3 +++ icons/mini-xv.xpm 1 Jan 2005 04:41:09 -0000 ＠＠ -3,9 +3,9 ＠＠ /* width height num_colors chars_per_pixel */ "16 16 4 1", " c None", -"# c black", -"r c red", -". c white", +"# c black s xblack", +"r c red s xred", +". c white s xwhite", /* pixels */ " ", " ", Index: lisp/ixwem.el =================================================================== RCS file: lisp/ixwem.el diff -N lisp/ixwem.el --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ lisp/ixwem.el 1 Jan 2005 04:41:09 -0000 ＠＠ -0,0 +1,150 ＠＠ +;;; ixwem.el --- + +;; Copyright (C) 2004 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Created: Sat Sep 11 21:38:13 GMT 2004 +;; Keywords: xwem +;; X-CVS: $Id: ixwem.el,v 1.2 2004/12/05 05:52:26 youngs Exp $ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; + +;;; Code: + + +;; Highlighting. +;; TODO: +;; - font lock faces +;; - +(require 'xwem-load) + +(defgroup ixwem nil + "Group to customize IXWEM." +:prefix "ixwem-" +:group 'xwem) + +(defcustom ixwem-name-length 32 + "*Maximum length of xwem client name to display." +:type 'number +:group 'ixwem) + +;;; Internal variables + +(defvar ixwem-header-line + (concat " IMD Manda Client Size Frame Uptime\n" + " --- ----- ------ ---- ----- ------\n")) + +(defvar ixwem-local-map + (let ((map (make-sparse-keymap))) + (define-key map ?q 'ixwem-quit) + map) + "Keymap used when in ixwem mode.") + + +(defun ixwem-client-format (cl) + (format (format " %%.%ds\n" ixwem-name-length) + (xwem-client-name cl))) + +(defun ixwem-draw-tree (buf) + "Draw clients tree in buffer BUF." + (with-current-buffer buf + (erase-buffer buf) + + (insert (concat " Name" (make-string (- ixwem-name-length 3) ?\x20) + "Size " "Uptime " "Recency\n")) + (insert (concat " ----" (make-string (- ixwem-name-length 3) ?\x20) + "---- " "------ " "-------\n")) + (mapc (lambda (ma) + (insert (format "[%S]\n" (xwem-manda-name ma))) + (cond ((eq (xwem-manda-name ma) 'generic) + (mapc (lambda (fr) + (insert (format " {F%d: %s}\n" + (xwem-frame-num fr) (xwem-frame-name fr))) + (mapc (lambda (cl) + (when (and (eq (xwem-cl-frame cl) fr) + (eq (xwem-cl-manda cl) ma)) + (insert (ixwem-client-format cl)))) + xwem-clients)) + xwem-frames-list)) + (t (mapc (lambda (cl) + (when (eq (xwem-cl-manda cl) ma) + (insert (ixwem-client-format cl)))) + xwem-clients)))) + xwem-manda-list) + )) + +(defun ixwem-list-clients (buf) + "List xwem clients in BUF buffer." + (with-current-buffer buf + (erase-buffer) + + ;; Display header + (insert ixwem-header-line) + + ;; Display clients tree + (mapcar (lambda (cl) + (let ((bstr (make-string 40 ?\x20))) + (insert + (format " *# %.9s %.24s %.8s %.8s %.20s\n" + (concat (symbol-name (xwem-manda-name (xwem-cl-manda cl))) bstr) + (concat (xwem-client-name cl) bstr) + (concat (let ((gg (xwem-cl-get-usize cl))) + (format "%dx%d" (car gg) (cdr gg))) + bstr) + (if (xwem-cl-frame cl) + (concat (xwem-frame-name (xwem-cl-frame cl)) bstr) + bstr) + (concat (xwem-cl-get-uptime cl) bstr))))) + xwem-clients) + )) + +(defun ixwem-mode () + "Enter ixwem mode." + (setq major-mode 'ixwem) + (setq mode-name "IXWEM") + (use-local-map ixwem-local-map) + ) + +;;;###autoload(autoload 'ixwem "ixwem" "" t) +(define-xwem-command ixwem () + "Interactive xwem clients browsing." + (xwem-interactive) + + (let ((buf (get-buffer-create "*ixwem*"))) + (switch-to-buffer buf) + (ixwem-draw-tree buf) +; (ixwem-list-clients buf) + (ixwem-mode) + )) + +(defun ixwem-quit () + "Quit IXWEM." + (interactive) + + (bury-buffer)) + + +(provide 'ixwem) + +;;; ixwem.el ends here Index: lisp/xwem-appcollect.el =================================================================== RCS file: lisp/xwem-appcollect.el diff -N lisp/xwem-appcollect.el --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ lisp/xwem-appcollect.el 1 Jan 2005 04:41:09 -0000 ＠＠ -0,0 +1,105 ＠＠ +;;; xwem-appcollect.el --- + +;; Copyright (C) 2004 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Created: Fri Oct 29 04:35:18 MSD 2004 +;; Keywords: xwem +;; X-CVS: $Id: xwem-appcollect.el,v 1.1 2004/11/29 20:42:25 lg Exp $ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; Helpfull util to create `xwem-applications-alist'. +;; Usage: +;; +;; (xwem-appcollect '("xterm" "mozilla")) + +;; (xwem-appcollect '("xterm" "mozilla") '(name class) 'or) + +;; (xwem-appcollect '("xterm" "mozilla") '(command) 'or) + +;;; Code: + +(require 'xwem-load) +(require 'xwem-manage) +(require 'xwem-launcher) + +(define-xwem-method manage appcollect (cl) + "Manage method when collecting info about applications." + (declare (special xwem-app-collection)) + (declare (special xwem-app-collect-wait)) + + (let ((app-name (xwem-cl-get-prop cl 'xwem-appcollect-app-name)) + (op (xwem-cl-get-prop cl 'xwem-appcollect-op)) + (params (xwem-cl-get-prop cl 'xwem-appcollect-params)) + mspec) + + (setq mspec (list op)) + (mapc (lambda (par) + (cond ((eq par 'class) + (push `(and (class-inst ,(concat "^" (car (xwem-hints-wm-class (xwem-cl-hints cl))) "$")) + (class-name ,(concat "^" (cdr (xwem-hints-wm-class (xwem-cl-hints cl))) "$"))) + mspec)) + ((eq par 'name) + (push `(name ,(concat "^" (xwem-hints-wm-name (xwem-cl-hints cl)) "$")) + mspec)) + ((eq par 'command) + (push `(command ,(concat "^" (xwem-hints-wm-command (xwem-cl-hints cl)) "$")) + mspec)))) + params) + (setq mspec (nreverse mspec)) + + (setq xwem-app-collection (put-alist app-name (list mspec) xwem-app-collection)) + (xwem-client-kill cl t) + (setq xwem-app-collect-wait nil))) + +;;;###xwem-autoload(autoload 'xwem-appcollect "xwem-appcollect" nil nil) +(defun xwem-appcollect (app-names &optional params operation) + "Collect and return applications manage specs. +APP-NAMES is a list of applications to collect. + +PARAMS is a list of elements where each element is one of: + `class' - Include class-inst/class-name into mspec. + `name' - Include app name into mspec. + `command' - Include command into mspec." + (let ((xwem-app-collection nil)) + (declare (special xwem-app-collection)) + + (mapc (lambda (app) + (let ((cmd (xwem-launcher-normalize-cmd app)) + (xwem-app-collect-wait t)) + (declare (special xwem-app-collect-wait)) + (xwem-manda-add-expectance + `(appcollect (xwem-appcollect-op ,(or operation 'and) xwem-appcollect-params ,(or params '(class)) + xwem-appcollect-app-name ,app) + (eval t)) 120) + (xwem-execute-program cmd) + (while xwem-app-collect-wait + (dispatch-event (next-event))))) + app-names) + + (nreverse xwem-app-collection))) + + +(provide 'xwem-appcollect) + +;;; xwem-appcollect.el ends here Index: lisp/xwem-battery.el =================================================================== RCS file: lisp/xwem-battery.el diff -N lisp/xwem-battery.el --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ lisp/xwem-battery.el 1 Jan 2005 04:41:09 -0000 ＠＠ -0,0 +1,292 ＠＠ +;;; xwem-battery.el --- Dockapp APM battery monitor for XWEM. + +;; Copyright (C) 2004 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Steve Youngs <steve(a)youngs.au.com> +;; Created: Thu Sep 2 01:14:36 GMT 2004 +;; Keywords: xwem +;; X + X-ButtonPress X-ButtonRelease)) + + (xwem-XTrayInit (xwem-dpy) bxwin dockip dockgroup dockalign) + + (X-Win-put-prop bxwin 'xwem-batt-timer + (start-itimer "xwem-batt" + `(lambda () (xwem-batt-win-update ,bxwin)) + xwem-batt-update-interval xwem-batt-update-interval)) + 'started)) + + +;;;; In case there is no battery.ell +(unless (fboundp 'apm-battery) + (defvar apm-program "apm") + (defvar apm-state-percent-arguments "-bl") + (defvar apm-status-alist + '((0 . high) (1 . low) (2 . critical) (3 . charging))) + + (defun apm-battery () + "Return battery status." + (let (state percents) + (with-temp-buffer + (call-process apm-program nil (current-buffer) + nil apm-state-percent-arguments) + (goto-char (point-min)) + (setq state (cdr (assq (string-to-int + (buffer-substring (point-at-bol) + (point-at-eol))) + apm-status-alist))) + (forward-line) + (setq percents (string-to-int + (buffer-substring (point-at-bol) + (point-at-eol))))) + (list (eq state 'charging) state percents)))) + + +(provide 'xwem-battery) + +;;; xwem-battery.el ends here Index: lisp/xwem-clgen.el =================================================================== RCS file: lisp/xwem-clgen.el diff -N lisp/xwem-clgen.el --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ lisp/xwem-clgen.el 1 Jan 2005 04:41:10 -0000 ＠＠ -0,0 +1,408 ＠＠ +;;; xwem-clgen.el --- Generic model to manage clients. + +;; Copyright (C) 2004 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Steve Youngs <steve(a)youngs.au.com> +;; Created: Sat Aug 28 14:31:39 MSD 2004 +;; Keywords: xwem +;; X-CVS: $Id: xwem-clgen.el,v 1.3 2004/12/05 22:37:32 lg Exp $ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; Generic managing model. + +;;; Code: + +(require 'xwem-load) +(require 'xwem-manage) + +;;; Customisation +(defgroup xwem-clgen nil + "Group to customise management of generic clients." +:prefix "xwem-clgen-" +:group 'xwem-modes) + +(defcustom xwem-clgen-other-strategy 'samewin + "*Strategy used when searching for other client in window. +Possible values are: + + `samewin' - Search for client managed in window. + + `sameframe-nonactive' - Search for nonactive client managed + in window's frame. + + `sameframe-any' - Search for any client managed in window's + frame. + + `samemanda-nonactive' - Search for any nonactive client with same + manage entry as other client. + + `any-nonactive' - Search for any nonactive client." +:type '(choice (const :tag "Same Window" samewin) + (const :tag "Inactive in same frame" sameframe-nonactive) + (const :tag "Any in same frame" sameframe-any) + (const :tag "Inactive with same manda" samemanda-nonactive) + (const :tag "Any inactive" any-nonactive)) +:group 'xwem-clgen) + +(defcustom xwem-clgen-other-on-split t + "*Non-nil mean activate c +;;; xwem-clgen.el ends here Index: lisp/xwem-clients.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-clients.el,v retrieving revision 1.13 diff -u -u -r1.13 xwem-clients.el --- lisp/xwem-clients.el 16 Dec 2004 08:08:04 -0000 1.13 +++ lisp/xwem-clients.el 1 Jan 2005 04:41:10 -0000 ＠＠ -3,9 +3,11 ＠＠ ;; Copyright (C) 2003 by Free Software Foundation, Inc. ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Steve Youngs <steve(a)youngs.au.com> +;; Richard Klinda <ignotus(a)hixsplit.hu> ;; Created: 2 Mar 2003 ;; Keywords: xlib, xwem -;; X-CVS: $Id: xwem-clients.el,v 1.13 2004/12/16 08:08:04 youngs Exp $ +;; X-CVS: $Id: xwem-clients.el,v 1.12 2004/12/05 22:37:32 lg Exp $ ;; This file is part of XWEM. ＠＠ -32,15 +34,11 ＠＠ ;; ;; Client state(`xwem-cl-state') is one of: ;; -;; 'managed - Client has `xwem-cl-win' and in WIN's clients list, but -;; not current in WIN. +;; 'active - Client managed and activated. ;; -;; 'managed-current - As 'managed, but CL aslo current in WIN. +;; 'inactive - CL managed, but not viewable. ;; -;; 'demanaged - CL may have valid `xwem-cl-win', but not in WIN's -;; clients list and not current in any window. -;; -;; 'iconified - Same as 'demanaged +;; 'iconified - CL iconified, not viewable. ;; ;; 'destroyed - CL's x window destroyed. ;; ＠＠ -56,23 +54,32 ＠＠ ;; `xwem-cl-state-change-hook' - Called when CL changes state to one ;; described above. ;; -;; `xwem-cl-manage-hook' - Called when CL just managed in some -;; window. +;; `xwem-cl-manage-hook' - Called when CL just managed. +;; +;; `xwem-cl-activate-hook' - Called when CL is activated in its context. ;; -;; `xwem-cl-demanage-hook' - Called when CL just demanaged from some -;; window. +;; `xwem-cl-deactivate-hook' - Called when CL is deactivated in its context. +;; +;; `xwem-cl-withdraw-hook' - Called when CL is about to move to withdrawn state. ;; -;; `xwem-cl-mark-hook' - Called when CL marked or unmarked. + +;; +;; Supported client properties: +;; +;; `noselect' - Non-nil to make client non-selectable. + ;;; Code: (eval-when-compile ;; Shutup compiler - (require 'xlib-xwin) - (require 'xwem-macros) - (require 'iswitchb) + (autoload 'subtract-time "time-date") + (defvar xwem-frame-ev-mask) ) -(require 'xwem-frame) + +(require 'xwem-load) +(require 'xwem-manage) +(require 'xwem-misc) ;;; Variables (defgroup xwem-cl nil ＠＠ -80,12 +87,28 ＠＠ :prefix "xwem-cl-" :group 'xwem) +(defgroup xwem-modes nil + "Group to customize XWEM managing modes." +:prefix "xwem-" +:group 'xwem) + (defcustom xwem-cl-use-parent-xwin t "*Non-nil mean that CL will use some X window, where it(CL) lowered. -This is need to fullish some X applications, which accuire clients in such evil manner." +This is need to fullish some X applications, which accuire clients in +such evil manner." :type 'boolean :group 'xwem-cl) +(defcustom xwem-cl-noname-name "<noname>" + "*Name for clients which does not have name." +:type 'string +:group 'xwem-cl) + +(defcustom xwem-cl-noicon-name "<noname>" + "*Icon name for clients which does not have their own." +:type 'string +:group 'xwem-cl) + (defcustom xwem-cl-other-strategy 'samewin "*Strategy to be used to select other CL. One of 'any 'samewin 'sameframe. ＠＠ -95,21 +118,74 ＠＠ (const :tag "Any" any)) :group 'xwem-cl) -(defcustom xwem-cl-other-on-split t - "Non-nil mean manage other client when split occurs in new window. -Minor mode." +(defcustom xwem-frame-iresize-mode 'normal + "*Default type of drawing outlines when resizing frame interactively. +It is not recommeded to use 'opaque resize mode." +:type '(choice (const :tag "Normal border" normal) + (const :tag "Contiguous borders" contiguous) + (const :tag "Outline Corners" corners) + -:type 'hook -:group 'xwem-hooks) - -(defcustom xwem-cl-wmname-change-hooks nil - "Hooks to be called when WM_NAME changes." +;;;###autoload +(defcustom xwem-client-select-hook nil + "*Hooks called when new client just selected. +It is pretty guarantied that `xwem-selected-client' is valid xwem-cl +structure at time of hook execution." :type 'hook :group 'xwem-hooks) -(defcustom xwem-cl-wmcommand-chage-hooks nil - "Hooks to be called when WM_COMMAND changes." +;;;###autoload +(defcustom xwem-client-deselect-hook nil + "Hooks called with one arg - cl, when cl deselected. +It is pretty guarantied that `xwem-selected-client' is valid xwem-cl +structure at time of hook execution." :type 'hook :group 'xwem-hooks) -(defcustom xwem-cl-wmclass-change-hooks nil - "Hooks to be called when WM_CLASS changes." -:type 'hook -:group 'xwem-hooks) +;;; Internal variables -(defcustom xwem-cl-wmh-change-hooks nil - "Hooks to be called when WM_HINTS changes." -:type 'hook -:group 'xwem-hooks) + +(defconst xwem-client-ev-mask + (Xmask-or XM-ColormapChange XM-PropertyChange + XM-FocusChange XM-EnterWindow XM-LeaveWindow + XM-StructureNotify XM-ResizeRedirect) + "Event mask for xwem's client.") -;;;###autoload -(defvar xwem-clients nil "Clients Windows list") +;;;###xwem-autoload +(defvar xwem-clients nil + "List of all managed clients.") + +;;;###xwem-autoload +(defvar xwem-current-cl nil + "Internal variable. +Use `xwem-cl-selected' to get selected client.") + +;;;###xwem-autoload +(defvar xwem-last-cl nil + "Last selected client. +Use `(xwem-last-client)' to get last selected client.") ;;;###autoload (defvar xwem-cl-mark-ring nil "The list of marked clients.") -;;;###autoload -(defstruct xwem-hints - ;; TODO: add more - wm-normal-hints - wm-hints - wm-class - wm-command - wm-name - wm-transient-for - wm-protocols) - -(defconst xwem-client-ev-mask (Xmask-or XM-ColormapChange XM-PropertyChange - XM-FocusChange XM-EnterWindow XM-LeaveWindow - XM-StructureNotify XM-ResizeRedirect) - "Event mask for xwem's client.") +;;;###xwem-autoload +(defmacro xwem-cl-marked-p (cl) + "Return non-nil if client CL is marked, i.e. in `xwem-cl-mark-ring' list." + `(memq ,cl xwem-cl-mark-ring)) -;;;###autoload -(defstruct (xwem-cl (:predicate xwem-iscl-p)) - xwin ; X-Win - saved-name ; saved WM_NAME - xgeom ; X-Geom etry for cl - xattrs ; X-Attr ibutes +;;; Client properties +;;;###xwem-autoload +(defvar xwem-supported-client-properties nil + "List of supported client's properties definitions. +Property definition is list in form: +\(NAME . (MANAGE-TYPE (KEYWORD VAL ...) ...)). + +Valid KEYWORD are: + + `:type' - Same as for `defcustom'. eval composite type added. + + `:set' - Function to call when setting this property. Default is + `xwem-cl-put-prop'. Function called with three + arguments - CL PROP VAL. + + `:get' - Function to call in order to fetch property value. Default + is `xwem-cl-get-prop'. Function called with two + arguments - CL PROP. +") + +;;;###xwem-autoload +(defmacro define-xwem-client-property (name manage-type doc &rest keys-vals) + "Define new xwem client property NAME." + `(xwem-support-cl-property (quote ,name) (quote ,manage-type) + (list :doc ,doc ,＠keys-vals))) + +;;;###xwem-autoload +(defun xwem-property-supported-p (prop) + "Return non-nil if client property PROP is supported." + (assq prop xwem-supported-client-properties)) + +;;;###xwem-autoload +(defun xwem-support-cl-property (prop-name manage-type keys-val) + "Add supported client property." + (let ((pdef (assq prop-name xwem-supported-client-properties))) + (unless pdef + (setq pdef (cons prop-name nil)) + (setq xwem-supported-client-properties + (cons pdef xwem-supported-client-properties))) + + (setcdr pdef (plist-put (cdr pdef) manage-type keys-val)))) + +;;;###xwem-autoload +(defun xwem-unsupport-cl-property (prop-name manage-type) + "Remove PROP-NAME from supported property for MANAGE-TYPE." + (let ((pdef (assq prop-name xwem-supported-client-properties))) + (when pdef + (setcdr pdef (plist-remprop (cdr pdef) manage-type)) + (when (null (cdr pdef)) + (setq xwem-supported-client-properties + (delq pdef xwem-supported-client-properties)))))) + +(defun xwem-clprop-get-keyword (cl prop keyword &optional default) + "Return CL's property KEYWORD value. +If no KEYWORD for such CL, return default KEYWORD value. +Return DEFAULT if KEYWORD not found." + (let ((prop-def (assq prop xwem-supported-client-properties))) + (or (plist-get (plist-get (cdr prop-def) (xwem-cl-manage-type cl)) keyword) + (plist-get (plist-get (cdr prop-def) nil) keyword default)))) - win ; xwem-win dow - hints ; xwem-hints - manda ; xwem-manda entry - transient-for ; non-nil if client is transient for window - (ev-mask xwem-client-ev-mask) ; event mask for certain client - - (state 'unknown) ; state of client, 'managed, 'iconified, 'unknown, etc - start-time ; start-time - recency ; last time when CL was active - translist ; list of transient-for windows for this client +;;;###xwem-autoload +(defun xwem-client-set-property (cl prop val) + "Set client property." + (funcall (xwem-clprop-get-keyword cl prop :set 'xwem-cl-put-prop) + cl prop val)) + +;;;###xwem-autoload +(defun xwem-client-property (cl prop) + "Return CL's property PROP." + (funcall (xwem-clprop-get-keyword cl prop :get 'xwem-cl-get-prop) + cl prop)) + +(defun xwem-client-properties (cl) + "Return CL's properties list." + (let ((cplist (xwem-cl-plist cl)) + (rplist nil)) + (while cplist + (when (xwem-property-supported-p (car cplist)) + (setq rplist (plist-put rplist (car cplist) (cadr cplist)))) + (setq cplist (cddr cplist))) + rplist)) - plist ; user defined plist - ) +(define-xwem-client-property x-border-width nil + "CL's xwin border width." +:type 'number +:set 'xwem-client-set-x-border-width) + +(define-xwem-client-property x-border-color nil + "CL's xwin border color." +:type 'color +:set 'xwem-client-set-x-border-color) + +(define-xwem-client-property noselect nil + "Non-nil mean CL can't be selected." +:type 'boolean) + +(define-xwem-client-property skip-deselect nil + "CL skips deselecting." +:type 'boolean) + +(define-xwem-client-property override-skip-deselect nil + "CL overrides skip-deselect property of selected client." +:type 'boolean) + +(define-xwem-client-property skip-initial-state nil + "Non-nil mean skip CL's initial state hint." +:type 'boolean) ;;; Functions -;;;###autoload -(defun xwem-cl-p (cl &optional sig) - "Returns t if CL is XWEM client window." - (let ((iscl (xwem-iscl-p cl))) - (if (and (not iscl) sig) - (signal 'wrong-type-argument (list sig 'xwem-cl-p cl)) - iscl))) +(defun xwem-client-set-x-border-width (cl bprop width) + "Change CL's border with to WIDTH. +Default WIDTH is 0." + (xwem-cl-put-prop cl bprop width) ; save it in props + + (unless (numberp width) + (setq width 0)) ; XXX + + (setf (xwem-cl-new-xgeom cl) (make-X-Geom :border-width width)) + (xwem-refit cl)) + +(defun xwem-client-set-x-border-color (cl bprop col) + "Change CL's border color to COL." + (xwem-cl-put-prop cl bprop col) ; save it in props + + (unless col + (setq col "black")) ; XXX + + (XSetWindowBorder (xwem-dpy) (xwem-cl-xwin cl) + (XAllocColor (xwem-dpy) (XDefaultColormap (xwem-dpy)) + (xwem-make-color col)))) + +(defun xwem-cl-focus-selected () + "If CL is selected, set focus on it. +Used in `xwem-post-deffering-hook'." + (xwem-focus-set (xwem-cl-selected))) + +;;;###xwem-autoload +(defun xwem-cl-select (cl) + "Set CL to be current cl." + (xwem-client-local-variables-import (xwem-cl-selected)) + + ;; Set CL to be current client + (setf (xwem-last-client) (xwem-cl-selected)) + (setf (xwem-cl-selected) cl) + + (xwem-client-local-vari + (t t))))))))))) + +;;;###xwem-autoload +(defun xwem-cl-other (cl &optional clients-list also-active no-sort) + "Return xwem client other then CL selecting from CLIENTS-LIST. +Default CLIENTS-LIST is what is returned by `xwem-clients-list'. +Deactivated clients are preferred to activated, unless ALSO-ACTIVE is non-nil. Special clients excluded. -If CL is not actually xwem client, nil returned." - (if (xwem-cl-p cl) - (let ((cll (cond ((eq xwem-cl-other-strategy 'any) xwem-clients) - - ((eq xwem-cl-other-strategy 'samewin) - (xwem-win-make-cl-list-sort-by-recency (xwem-cl-win cl))) - - ((eq xwem-cl-other-strategy 'sameframe) - (xwem-frame-make-cl-list (xwem-cl-frame cl))) - - (t xwem-clients))) - (rcl nil) - (notgoodcl nil)) ;not so good candidate as rcl - - (while cll - (when (not (eq (car cll) cl)) ;skip ourself - (if (and (not (xwem-cl-exclude-p (car cll))) - (or visible (not (xwem-win-cl-current-p (car cll))))) - (progn - (setq rcl (car cll)) - (setq cll nil)) - - (when (and visible (null notgoodcl)) - (setq notgoodcl (car cll))))) - (setq cll (cdr cll))) +Use `(xwem-cl-other cl nil t)' form to fetch most recent +client, other then CL. + +CLIENTS-LIST is sorted by recency unless NO-SORT is non-nil." + (unless clients-list + (setq clients-list (xwem-clients-list))) + + (unless no-sort + (setq clients-list + (xwem-cl-list-sort-by-recency clients-list))) + + (let ((rcl nil) + (notgoodcl nil)) ;not so good candidate as rcl + + (while clients-list + (when (and (xwem-cl-p (car clients-list)) ; skip non-clients + (not (eq (car clients-list) cl)) ; skip ourself + (not (eq (xwem-cl-state (car clients-list)) 'iconified))) ; skip iconified + (if (or also-active (not (eq (xwem-cl-state (car clients-list)) 'active))) + ;; Found pretty good candidate + (setq rcl (car clients-list) + clients-list nil) + + (when (and also-active (null notgoodcl)) + (setq notgoodcl (car clients-list))))) + (setq clients-list (cdr clients-list))) - (or rcl notgoodcl)) + ;; Return + (or rcl notgoodcl))) - ;; [else] invalid CL - nil)) +;;;###xwem-autoload +(defun xwem-select-some-client () + (unless (and (xwem-cl-alive-p (xwem-cl-selected)) + (eq (xwem-cl-state (xwem-cl-selected)) 'active)) + (xwem-select-client nil))) + +;;;###xwem-autoload +(defun xwem-select-last-or-other-client (cl &optional force allow-dummy) + "Select last or other client according to CL. +New client selected only if CL is current selected or FORCE is non-nil +or dummy client currently selected. -(defun xwem-cl-bury (cl) - "Put CL to the and of clients list. -Maybe used in `xwem-cl-manage-hook' or `xwem-cl-demanage-hook'." - (setq xwem-clients - (nconc (delete cl xwem-clients) (list cl))) - nil) ; continue hooks processing +`xwem-select-last-or-other-client' tries to avoid selecting dummy +clients, unless ALLOW-DUMMY is non-nil." + (when (or force + (xwem-cl-selected-p cl) + (xwem-cl-selected-p (xwem-dummy-client))) + (if (and (xwem-cl-alive-p (xwem-last-client)) + (not (eq (xwem-last-client) cl)) + (or allow-dummy + (not (xwem-dummy-client-p (xwem-last-client))))) + (xwem-select-client (xwem-last-client)) + (xwem-select-client (xwem-cl-other cl nil t))))) -;;; Manda functions begin -;;;###autoload +;;;###xwem-autoload (defun xwem-cl-correct-size-for-size (cl new-geom &optional x-type y-type) "Make CL's geometry as close to NEW-GEOM as possible. X-TYPE is one of 'center 'left or 'right, default is 'center. Y-TYPE is one of 'center 'top or 'bottom, default is 'center." - (let* ((hthi (X-Geom-border-width new-geom)) + (let* ((hthi (or (X-Geom-border-width new-geom) 0)) + (he (X-Geom-height new-geom)) + (wi (X-Geom-width new-geom)) (clgmt (xwem-cl-xgeom cl)) + (wmnh (xwem-hints-wm-normal-h +When used with prefix ARG, then focus to that other window." (xwem-interactive "cXWEM-CL Other: \nP") - (let ((wn (xwem-win-next (xwem-win-selected))) - (xwem-cl-manage-hook nil)) ; skip setup hooks - - (when cl - (when (xwem-win-only-one-p (xwem-win-selected)) - (xwem-frame-split-vert nil) - (setq wn (xwem-win-next (xwem-win-selected)))) - - (when wn - (xwem-manda-manage cl wn) - - (when arg - (xwem-window-select wn))) - ))) + (let (nwin) + (when (xwem-win-only-one-p (xwem-win-selected)) + (xwem-window-split-vertically nil)) ; XXX + (setq nwin (xwem-win-next (xwem-win-selected))) + + (xwem-win-set-cl nwin cl) + (when arg + (xwem-select-window nwin)))) ;;;###autoload(autoload 'xwem-cl-switch-other-frame "xwem-clients" "" t) (define-xwem-command xwem-cl-switch-other-frame (cl &optional arg) "Switch to CL in other XWEM frame. When used with prefix ARG, then create embedded frame, if creation is needed at all." - (xwem-interactive "cXWEM-CL Other frame: \nP") + (xwem-interactive + (list (xwem-read-client + "XWEM-CL Other frame: " + (xwem-cl-list-sort-by-recency + (xwem-clients-list + (lambda (cl) + (xwem-manage-property (xwem-cl-manage-type cl) 'win-support))))) + xwem-prefix-arg)) (let ((ofr (or (xwem-frame-other (xwem-frame-selected)) - (xwem-make-frame-1 arg nil nil t)))) + (xwem-make-frame-1 (or (and arg 'embedded) 'desktop) +:noselect t)))) - (xwem-manda-manage cl (xwem-frame-selwin ofr)) - (xwem-frame-select ofr)) - ) + (xwem-cl-change-window cl (xwem-frame-selwin ofr)) + (xwem-select-client cl))) ;;;###autoload(autoload 'xwem-cl-switch-to-other "xwem-clients" "" t) -(define-xwem-command xwem-cl-switch-to-other (n &optional window) - "Switch to other client." - (xwem-interactive "p") +(define-xwem-command xwem-cl-switch-to-other (cl &optional n) + "Switch to xwem client other then CL. +Default CL is selected client. +If prefix argument N is specified, switch to N's other client." + (xwem-interactive (list (xwem-cl-selected) + (prefix-numeric-value xwem-prefix-arg))) + + (while (> n 0) + (setq cl (xwem-method-other-client cl)) + (decf n)) - (let* ((win (or window (xwem-win-selected))) - (ocl (xwem-win-cl win))) - (while (> n 0) - (setq ocl (xwem-cl-other ocl)) - (setq n (- n 1))) - (if (xwem-cl-p ocl) - (xwem-manda-manage ocl win) - (xwem-message 'note "No other client available.")))) + (unless (xwem-cl-alive-p cl) + (error 'xwem-error "No other client available")) + + (xwem-select-client cl)) ;;;###autoload(autoload 'xwem-cl-switch-to-other-in-other-win "xwem-clients" "" t) (define-xwem-command xwem-cl-switch-to-other-in-other-win (n) - "Like `xwem-cl-switch-to-other', but in other window." + "Switch to other client in other window then selected," (xwem-interactive "p") - (xwem-cl-switch-to-other n (xwem-window-other 1))) + (when (xwem-win-only-one-p) + (error 'xwem-error "Only one window")) + + (let* ((win (xwem-window-other 1)) + (cl (xwem-win-cl win))) + (while (> n 0) + (setq cl (xwem-cl-other cl (xwem-win-clients win))) + (decf n)) + + (unless (xwem-cl-alive-p cl) + (error 'xwem-error "Invalid client")) + + (xwem-activate cl))) ;;;###autoload(autoload 'xwem-kill-cl-and-window "xwem-clients" "" t) -(define-xwem-command xwem-kill-cl-and-window (arg) - "Kill selected client and window. +(define-xwem-command xwem-kill-cl-and-window (window &optional arg) + "Kill WINDOW an client currently activated in it. If used with prefix ARG then kill client in other window and other window (not implemented)." - (xwem-interactive "P") + (xwem-interactive (list (xwem-win-selected) + xwem-prefix-arg)) - (let* ((win (if arg (xwem-window-other 1) (xwem-win-selected))) + (let* ((win (if arg (xwem-window-other 1 window) window)) (cl (xwem-win-cl win))) + ;; kill client (when (xwem-cl-p cl) - ;; Deassociate CL from WIN so no client will be managed when we - ;; kill CL. - (setf (xwem-cl-win cl) nil) - (setf (xwem-win-cl win) nil) - (xwem-client-kill t cl) - - ;; Make sure CL is removed from clients list - (xwem-remove-client cl)) - - (xwem-window-delete win) - (xwem-frame-redraw (xwem-win-frame win)) - )) + (xwem-client-kill cl)) + + ;; kill window + (xwem-window-delete win))) ;;;###autoload(autoload 'xwem-cl-transpose "xwem-clients" "" t) -(define-xwem-command xwem-cl-transpose (arg &optional cl) +(define-xwem-command xwem-cl-transpose (cl &optional arg) "Transpose CL with client at right in CL's WIN. If ARG is non-nil transpose with left client. If CL is ommited than selected client will be used." - (xwem-interactive "P") - - (let* ((cl (or cl (xwem-cl-selected))) - (sw (xwem-cl-win cl)) - (tai (cadr (member cl (funcall (if arg 'reverse 'identity) (xwem-win-make-cl-list sw)))))) - (when (not (xwem-cl-p tai)) - (setq tai (cadr (member cl (funcall (if arg 'identity 'reverse) (xwem-win-make-cl-list sw)))))) - - (when (and (xwem-cl-p cl) (xwem-cl-p tai)) - (xwem-list-exchange-els xwem-clients cl tai) + (xwem-interactive (list (xwem-cl-selected) + xwem-prefix-arg)) - (run-hook-with-args 'xwem-win-clients-change-hook sw)) - )) - -(defun xwem-client-rearrange-top (cl) - "Move CL on top of `xwem-clients'." - (when (xwem-win-selected-p (xwem-cl-win cl)) - (setq xwem-clients (cons cl (delete cl xwem-clients)))) - - nil) ;continue hooks processing + (when (xwem-cl-p cl) + (let* ((sw (xwem-cl-win cl)) + (tai (cadr (memq cl (funcall (if arg 'reverse 'identity) + (xwem-win-clients sw)))))) + (unless (xwem-cl-p tai) + (setq tai (cadr (memq cl (funcall (if arg 'identity 'reverse) + (xwem-win-clients sw)))))) + + (when (xwem-cl-p tai) + (xwem-list-exchange-els (xwem-win-clients sw) cl tai) + (run-hook-with-args 'xwem-win-clients-change-hook sw)) + ))) +(put 'xwem-cl-transpose 'xwem-frame-command t) -;;;###autoload -(defun xwem-init-clients () +(defun xwem-clients-init () "Clients part initializer" - (xwem-message 'msg "Initializing clients ... wait") + (xwem-message 'init "Initializing clients ...") (setq xwem-clients nil) - ;; Gentle handling of window splitting - (add-hook 'xwem-win-after-split-hook 'xwem-cl-other-on-split) + ;; Add default select/deselect hooks + (add-hook 'xwem-client-select-hook 'xwem-client-default-select-hook t) + (add-hook 'xwem-client-deselect-hook 'xwem-client-default-deselect-hook t) - (when xwem-cl-use-set-focus - (add-hook 'xwem-cl-manage-hook 'xwem-client-focus)) + ;; Initialise dummy client + (xwem-dummy-client-init) - (when xwem-cl-use-recent-cl-on-top - (add-hook 'xwem-cl-manage-hook 'xwem-client-rearrange-top)) -; (add-hook 'xwem-cl-demanage-hook 'xwem-cl-bury)) - - ;; Setup - (when xwem-cl-use-parent-xwin - (add-hook 'xwem-cl-create-hook 'xwem-cl-parent-on-creation) - (add-hook 'xwem-cl-destroy-hook 'xwem-cl-parent-on-destroy) - (add-hook 'xwem-cl-state-change-hook 'xwem-cl-parent-on-change-state)) - ) + (xwem-message 'init "Initializing clients ... done")) -;;;###autoload +;;;###xwem-autoload (defun xwem-client-sendmsg-atom (cl atom &optional time) "Send Client message to client CL." (XSendEvent (xwem-dpy) (xwem-cl-xwin cl) nil 0 - (X-Create-message - (list [1 X-ClientMessage] ;type - [1 32] ;format - [2 1000] ;XXX seq - [4 (X-Win-id (xwem-cl-xwin cl))] ; window - [4 (X-Atom-id (X-Atom-find-by-name (xwem-dpy) "WM_PROTOCOLS"))] - [4 (X-Atom-id atom)] - [4 (or time X-CurrentTime)] - [4 nil])))) + (X-Create-message + (list [1 X-ClientMessage] ; type + [1 X-format-32] ; format + [2 1000] ; XXX seq + [4 (X-Win-id (xwem-cl-xwin cl))] ; wind - (xwem-frame-selwin fr))) - xwem-frames-list))) - - ;; Setup focus mode - (xwem-focus-mode-set new-cl xwem-default-focus-mode) - - ;; Run new client hook - (run-hook-with-args 'xwem-cl-create-hook new-cl) - - ;; Finnally manage new client - (if (xwem-win-p dwin) - (xwem-manda-manage new-cl dwin) - (xwem-manda-manage new-cl))) - ))) - )) + (setf (xwem-cl-initial-xattrs new-cl) + (XGetWindowAttributes (xwem-dpy) xwin)) + (setf (xwem-cl-initial-xgeom new-cl) + (XGetGeometry (xwem-dpy) xwin)) + (setf (xwem-cl-xgeom new-cl) + (copy-X-Geom (xwem-cl-initial-xgeom new-cl))) + (setf (xwem-cl-start-time new-cl) + (current-time)) + + ;; Apply properties + (xwem-cl-apply-plist new-cl props) + + new-cl))) + +(defun xwem-unmake-client (cl) + "Unmake client CL." + ;; If unmaking selected client, then select dummy client + (when (xwem-cl-selected-p cl) + (xwem-select-client nil)) + + (X-Win-rem-prop (xwem-cl-xwin cl) 'xwem-cl) + (X-Win-EventHandler-rem (xwem-cl-xwin cl) 'xwem-cl-events-handler) + + ;; Make sure CL not in xwem-clients + (setq xwem-clients (delq cl xwem-clients)) + + (X-invalidate-cl-struct cl)) + +(defun xwem-client-first-manage (cl) + "Manage client CL for the first time. +Return non-nil if CL successfully managed." + ;; Find match spec for CL + (let ((mspec (xwem-manda-find-match cl))) + (when mspec + ;; Add CL to clients list + (pushnew cl xwem-clients :test 'eq) + + ;; Apply plist before setting managing model, becase seting + ;; properties may depend on it and will fail because client is + ;; not yet managed by this managing model. + + ;; On the other hand not seting managing model before applying + ;; properties may cause seting property to fail, for example + ;; 'expect-win property, which only set for 'generic managing + ;; model. + (setf (xwem-cl-manage-spec cl) mspec) + (xwem-cl-apply-plist cl (cadr mspec)) + + (xwem-debug 'xwem-cl "Managing model: %S selected" '(xwem-cl-manage-type cl)) + + ;; Setup focus mode if not already setuped + (unless (xwem-client-property cl 'xwem-focus-mode) + (xwem-focus-mode-set cl)) + + (xwem-debug 'xwem-cl "Focus model: %S selected" + '(xwem-client-property cl 'xwem-focus-mode)) + + ;; Run manage method + (xwem-manage cl) + + ;; Unmark CL as it was expected in case `xwem-manda-find-match' + ;; marked it. + (xwem-cl-was-expected cl nil) + + ;; Run new client hook + (when (xwem-cl-alive-p cl) + (run-hook-with-args 'xwem-cl-create-hook cl)) + cl))) + +;;;###xwem-autoload +(defun xwem-xwin-try-to-manage (xwin) + "Try to manage X window XWIN. +Return managed client, or nil if client wasnt managed." + (unless (xwem-xwin-cl xwin) + (let ((cl (xwem-make-client xwin xwem-client-default-properties))) + (when (xwem-cl-p cl) + (unless (xwem-client-first-manage cl) + (xwem-unmake-client cl))) + (and (xwem-cl-p cl) cl)))) + +;;;###xwem-autoload +(defun xwem-cl-destroy (cl) + "Tottally destroy CL." + (setf (xwem-cl-state cl) 'destroyed) + + (xwem-method-on-kill cl) + (run-hook-with-args 'xwem-cl-destroy-hook cl) + + (xwem-select-some-client) + (xwem-deffered-funcall 'xwem-unmake-client cl)) + +;;;###xwem-autoload +(defun xwem-cl-apply-plist (cl nplist) + "Set plist's properties in CL." + (while nplist + (unless (eq (cadr nplist) (xwem-client-property cl (car nplist))) + (xwem-client-set-property cl (car nplist) (cadr nplist))) + (setq nplist (cdr (cdr nplist))))) + +;;;###xwem-autoload +(defun xwem-cl-apply-new-xgeom (cl &optional correct-including-border hold-size) + "Apply entries in `xwem-cl-new-xgeom' to CL's x geometry. +When CORRECT-INCLUDING-BORDER is non-nil, then +`xwem-cl-correct-size-for-size' will correct size reguarding new +border +(define-xwem-command xwem-client-run-copy (cl &optional arg) "Run the same command as selected CL. -With prefix arg run it in other window. -With double prefix arg run in other window and select. -With numeric prefix arg run ARG copies." - (xwem-interactive "P") +Prefix ARG specifies how many copies to run." + (xwem-interactive (list (xwem-cl-selected) + (prefix-numeric-value xwem-prefix-arg))) - (let* ((cl (or cl (xwem-cl-selected))) - (nw (and (xwem-cl-p cl) (xwem-cl-win cl)))) - - (if (not (xwem-cl-p cl)) - (xwem-message 'warn "No client selected to copy.") + (unless (xwem-cl-alive-p cl) + (error 'xwem-error "Invalid client")) - (let ((cmd (xwem-hints-wm-command (xwem-cl-hints cl))) - (cnt (if (numberp arg) arg 1)) ;how many clients to start - (i 0)) - (if (or (not (stringp cmd)) (string= cmd "")) - (xwem-message 'warn "Invalid cmd: \"%s\"" cmd) - - (when (and (listp arg) (not (null arg))) - (setq nw (xwem-win-next nw)) - (when (not (xwem-win-p nw)) - ;; Create window - (xwem-frame-split-vert nil) - (setq nw (xwem-win-next (xwem-win-selected)))) - - (when (xwem-win-p nw) - (when (= (prefix-numeric-value arg) 4) - (xwem-win-expt-inc nw cmd cnt)) - - (when (= (prefix-numeric-value arg) 16) - (xwem-window-select-maybe-redraw nw)))) - - (when (xwem-win-p nw) - (while (< i cnt) - (xwem-execute-program cmd) - (setq i (1+ i)))) - ))))) + (let* ((cmd (xwem-hints-wm-command (xwem-cl-hints cl))) + (mspec (xwem-cl-manage-spec cl)) + (mtype (car mspec)) + (mplist (copy-list (cadr mspec)))) + + ;; Check command for validity + (when (or (not (stringp cmd)) (string= cmd "")) + (error 'xwem-error "Invalid command: " cmd)) + + ;; XXX Adjust plist + (setq mplist (plist-put mplist 'expect-win (xwem-cl-win cl))) + + (setq mspec (list mtype mplist (list 'command cmd))) + ;; Execute copies using expectances + (while (> arg 0) + +q (xwem-manda-add-expectance mspec) + (xwem-execute-program cmd) + (setq arg (1- arg))))) ;;;###autoload(autoload 'xwem-client-run-copy-other-win "xwem-clients" "" t) (define-xwem-command xwem-client-run-copy-other-win (arg &optional cl) ＠＠ -1131,11 +1331,10 ＠＠ (xwem-interactive "P") (let ((cl (or cl (xwem-cl-selected))) - (xwem-win-after-split-hook nil) ; prevent hooks cmd own) (when (or (not (xwem-cl-p cl)) (not (xwem-win-p (xwem-cl-win cl)))) - (error "Can't run copy of invalid client")) + (error 'xwem-error "Can't run copy of invalid client")) (setq cmd (xwem-hints-wm-command (xwem-cl-hints cl))) (setq own (xwem-window-other 1 (xwem-cl-win cl))) ＠＠ -1144,12 +1343,13 ＠＠ ;; Check is there split needed (when (eq own (xwem-win-selected)) (if arg - (xwem-frame-split-horiz 0) - (xwem-frame-split-vert 0)) + (xwem-window-split-horizontally 0) + (xwem-window-split-vertically 0)) (setq own (xwem-win-next (xwem-win-selected)))) - ;; Install expectance - (xwem-win-expt-inc own cmd) + ;; Install expectance in hope it will be managed by generic + ;; manage type, or some other type that suppors expectances. + (xwem-manda-add-expectance `(nil (expect-win ,own) (command ,cmd))) ;; Finnaly run command (xwem-execute-program cmd)) ＠＠ -1167,56 +1367,68 ＠＠ (when (or (not (xwem-cl-p cl)) (not (xwem-frame-p (xwem-cl-frame cl)))) - (error "Can't run copy of invalide client")) + (error 'xwem-error "Can't run copy of invalid client")) (setq cmd (xwem-hints-wm-command (xwem-cl-hints cl))) (setq ofr (xwem-frame-other (xwem-cl-frame cl))) (when cmd (unless (xwem-frame-p ofr) - (setq ofr (xwem-make-frame-1 arg nil nil t))) + (setq ofr (xwem-make-frame-1 (or (and arg 'embedded) 'desktop) +:noselect t))) ;; Setup expectance - (xwem-win-expt-inc (xwem-frame-selwin ofr) cmd) - - ( + (setf (xwem-cl-state cl) 'unknown)) (setq xwem-clients (cdr xwem-clients)))) -;;;###autoload -(defun xwem-client-hide (cl &optional new-state) - "Hide CL's window. Optionally you may specify NEW-STATE." - ;; Just move off the screen - (XMoveWindow (xwem-dpy) (xwem-cl-xwin cl) - (X-Geom-width (xwem-rootgeom)) - (X-Geom-height (xwem-rootgeom))) - - (XUnmapWindow (xwem-dpy) (xwem-cl-xwin cl)) - (xwem-client-change-state cl (or new-state 'iconified)) - ) - -;;;###autoload -(defun xwem-client-show (cl &optional new-state) - "Show xwem client CL." - ;; Make sure CL's frame is CL's parent - (XReparentWindow (xwem-dpy) (xwem-cl-xwin cl) - (xwem-frame-xwin (xwem-cl-frame cl)) - (X-Geom-width (xwem-rootgeom)) (X-Geom-height (xwem-rootgeom))) - - (if (xwem-cl-transient-for cl) - (XRaiseWindow (xwem-dpy) (xwem-cl-xwin cl)) - - ;; Must be lowered - (XLowerWindow (xwem-dpy) (xwem-cl-xwin cl))) - - (XMoveWindow (xwem-dpy) (xwem-cl-xwin cl) - (X-Geom-x (xwem-cl-xgeom cl)) - (X-Geom-y (xwem-cl-xgeom cl))) - - (XMapWindow (xwem-dpy) (xwem-cl-xwin cl)) - (xwem-client-change-state cl (or new-state 'managed-current)) - ) - ;;; Events handling for client windows (defun xwem-cl-hproperty (cl xev) ＠＠ -1452,150 +1646,670 ＠＠ rhook) ;; Some CL's property changed - (X-Dpy-log (xwem-dpy) "CLIENT .. PropertyNotify: Atom-id = %d\n" 'atom-id) + (xwem-debug 'xwem-cl "CLIENT .. PropertyNotify: Atom-id = %d" 'atom-id) - (cond - ((and (= atom-id (X-Atom-id XA-wm-normal-hints)) (= state X-PropertyNewValue)) - (setf (xwem-hints-wm-normal-hints (xwem-cl-hints cl)) (XGetWMNormalHints (xwem-dpy) xwin)) - (setq rhook 'xwem-cl-wmnh-change-hooks)) - - ((and (= atom-id (X-Atom-id XA-wm-hints)) (= state X-PropertyNewValue)) - (setf (xwem-hints-wm-hints (xwem-cl-hints cl)) (XGetWMHints (xwem-dpy) xwin)) - (setq rhook 'xwem-cl-wmh-change-hooks)) - - ((and (= atom-id (X-Atom-id XA-wm-class)) (= state X-PropertyNewValue)) - (setf (xwem-hints-wm-class (xwem-cl-hints cl)) (XGetWMClass (xwem-dpy) xwin)) - (setq rhook 'xwem-cl-wmclass-change-hooks)) - - ((and (= atom-id (X-Atom-id XA-wm-command)) (= state X-PropertyNewValue)) - (setf (xwem-hints-wm-command (xwem-cl-hints cl)) (XGetWMCommand (xwem-dpy) xwin)) - (setq rhook 'xwem-cl-wmcommand-chage-hooks)) - - ((and (= atom-id (X-Atom-id XA-wm-name)) (= state X-PropertyNewValue)) - (setf (xwem-hints-wm-name (xwem-cl-hints cl)) (XGetWMName (xwem-dpy) xwin)) - (unless (equal (xwem-hints-wm-name (xwem-cl-hints cl)) (xwem-cl-saved-name cl)) - (setf (xwem-cl-saved-name cl) (xwem-hints-wm-name (xwem-cl-hints cl))) - (setq rhook 'xwem-cl-wmname-change-hooks))) - ) + (cond ((and (= atom-id (X-Atom-id XA-wm-normal-hints)) + (= state X-PropertyNewValue)) + ;; WM_NORMAL_HINTS changed + (setf (xwem-cl-wm-normal-hints cl) + (XGetWMNormalHints (xwem-dpy) xwin)) + (setq rhook t)) + + ((and (= atom-id (X-Atom-id XA-wm-hints)) + (= state X-PropertyNewValue)) + ;; WM_HINTS changed + (setf (xwem-cl-wm-hints cl) (XGetWMHints (xwem-dpy) xwin)) + (setq rhook t)) + + ((and (= atom-id (X-Atom-id XA-wm-class)) + (= state X-PropertyNewValue)) + ;; WM_CLASS changed + (multiple-value-bind (ci cn) + (values-list (XGetWMClass (xwem-dpy) xwin)) + (setf (xwem-cl-wm-class cl) (cons ci cn))) + (setq rhook t)) + + ((and (= atom-id (X-Atom-id XA-wm-command)) + (= state X-PropertyNewValue)) + ;; WM_COMMAND changed + (setf (xwem-cl-wm-command cl) (XGetWMCommand (xwem-dpy) xwin)) + (setq rhook t)) + + ((and (= atom-id (X-Atom-id XA-wm-name)) + (= state X-PropertyNewValue)) + ;; WM_NAME changed + (setf (xwem-cl-wm-name cl) (XG + + `deactivate' - Client must be deactivate. + + `deselect' - Client is deselecting. + +Default TYPE is `deactivate'." + (unless type + (setq type 'deactivate)) + + (cond ((eq type 'deselect) + (xwem-method-deactivate cl type)) + + ((eq (xwem-cl-state cl) 'active) + (xwem-client-change-state cl 'inactive) + (xwem-method-deactivate cl type) + (xwem-select-some-client)) + + ((not (eq (xwem-cl-state cl) 'inactive)) + (xwem-method-deactivate cl type) + (xwem-select-some-client)))) + +;;;###xwem-autoload +(defun xwem-iconify (cl) + "Function to iconify client CL. +ARGS - arguments." + (unless (eq (xwem-cl-state cl) 'iconified) + (xwem-client-change-state cl 'iconified) + (xwem-method-iconify cl)) + + (xwem-select-some-client)) + +;;;###xwem-autoload +(defun xwem-refit (cl) + "Function to refit client CL. +ARGS - arguments." + ;; Reguard border width change + (when (and (xwem-cl-new-xgeom cl) + (xwem-manage-property (xwem-cl-manage-type cl) 'reguard-x-border-width) + (X-Geom-border-width (xwem-cl-new-xgeom cl))) + (setf (X-Geom-border-width (xwem-cl-xgeom cl)) + (X-Geom-border-width (xwem-cl-new-xgeom cl)))) + + (xwem-method-refit cl) + + ;; Apply (new) CL geometry to life + (xwem-cl-apply-xgeom cl) + + ;; Finally run hooks + (run-hook-with-args 'xwem-cl-refit-hook cl)) + +;;;###xwem-autoload +(defun xwem-withdraw (cl) + "Withdraw client CL." + (xwem-client-change-state cl 'withdrawn) + (xwem-method-withdraw cl) + + (xwem-select-some-client) + (run-hook-with-args 'xwem-cl-withdraw-hook cl)) + +;;;; ---- Default manage methods ---- + +(define-xwem-deffered xwem-default-apply-state (cl) + "Apply CL's state to life." + (cond ((eq (xwem-cl-state cl) 'active) + (XMapWindow (xwem-dpy) (xwem-cl-xwin cl))) + ((memq (xwem-cl-state cl) '(inactive iconified)) + (XUnmapWindow (xwem-dpy) (xwem-cl-xwin cl))))) + +(define-xwem-method activate default (cl &optional type) + "Default method to activate client CL." + (cond ((eq type 'select) + (xwem-deffered-funcall 'XRaiseWindow (xwem-dpy) (xwem-cl-xwin cl))) + ((eq type 'activate) + (xwem-default-apply-state cl)))) + +(define-xwem-method deactivate default (cl &optional type) + "Default method to deactivate client CL." + (cond ((eq type 'deactivate) + (xwem-default-apply-state cl)))) + +(define-xwem-method iconify default (cl) + "Default method to iconify CL." + (xwem-default-apply-state cl)) + +(define-xwem-method refit default (cl) + "Default method to refit CL." + (xwem-cl-apply-new-xgeom cl) + (xwem-cl-apply-xgeom cl)) + +;; New method to select other client +(defun xwem-method-other-client (cl) + "Return xwem client other then CL." + (xwem-execute-method 'other-client (xwem-cl-manage-type cl) cl)) + +(define-xwem-method other-client default (cl) + "Default other-client method." + (xwem-cl-other cl nil t)) + + +;;; Dummy client, used, when selecting `nil' client. +(defvar xwem-dummy-client nil + "Internal variable.") + +(define-xwem-client-property dummy-client-p nil + "Non-nil for dummy clients." +:type 'boolean) + +;;;###xwem-autoload +(defun xwem-dummy-client-p (cl) + "Return non-nil if CL is dummy client." + (xwem-client-property cl 'dummy-client-p)) + +;;;###xwem-autoload +(defun xwem-non-dummy-client-p (cl) + "Opposit to `xwem-dummy-client-p'." + (not (xwem-dummy-client-p cl))) + +;;;###xwem-autoload +(defun xwem-dummy-client () + "Return dummy client." + (or xwem-dummy-client + (progn (xwem-dummy-client-init) xwem-dummy-client))) + +(defun xwem-dummy-client-init () + "Create dummy client" + (unless xwem-dummy-client + (setq xwem-dummy-client + (xwem-make-client (XCreateWindow (xwem-dpy) nil 0 0 1 1 0 nil nil nil + (make-X-Attr :override-redirect t)) + '(dummy-client-p t ignore-has-input-p t))) + + (XSelectInput (xwem-dpy) (xwem-cl-xwin xwem-dummy-client) + (Xmask-or X + +;;;###xwem-autoload +(defun xwem-client-local-variable-value (client variable) + "Return CLINEN's local VARIABLE value. +Or global VARIABLE value if CLIENT does not have local value." + (let ((lval (assq variable (xwem-cl-local-variables client)))) + (if lval + (cdr lval) + (get variable 'xwem-default-value)))) + +(defun xwem-client-local-variables-import (cl) + "Set client local variables in CL." + (when (xwem-cl-p cl) + (setf (xwem-cl-local-variables cl) + (mapcar (lambda (var) + (cons var (symbol-value var))) + xwem-client-local-variables)))) + +(defun xwem-client-local-variables-export (cl) + "Set variables using CL's client local variables." + (when (xwem-cl-p cl) + (mapc (lambda (var) + (let ((val (assq var (xwem-cl-local-variables cl)))) + (if val + (set var (cdr val)) + (set var (get var 'xwem-default-value))))) + xwem-client-local-variables))) + +;;; Clients configurations +(defun xwem-client-configuration () + "Return current clients configuration." + ) -(defun xwem-cl-parent-on-destroy (cl) - "CL is about to be destroyed." - (let ((pwin (xwem-cl-get-prop cl 'parent-xwin))) - (when (X-Win-p pwin) - (XDestroyWindow (xwem-dpy) pwin)))) +(defun xwem-set-client-configuration (config) + "Set client configuration to CONFIG." + ) (provide 'xwem-clients) + +;;;; On-load actions: +;; Define dummy manage type +(define-xwem-manage-model dummy + "Managing model for dummy clients. +Dummy client is client which can't do anything." +:match-spec '(function (lambda (cl) (xwem-client-property cl 'dummy-client-p)))) + +(if xwem-started + (xwem-clients-init) + (add-hook 'xwem-before-init-wins-hook 'xwem-clients-init)) ;;; xwem-clients.el ends here Index: lisp/xwem-clswi.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-clswi.el,v retrieving revision 1.6 diff -u -u -r1.6 xwem-clswi.el --- lisp/xwem-clswi.el 16 Dec 2004 08:08:04 -0000 1.6 +++ lisp/xwem-clswi.el 1 Jan 2005 04:41:10 -0000 ＠＠ -1,10 +1,11 ＠＠ -;;; xwem-clswi.el --- Client switching package. +;;; xwem-clswi.el --- Simple clients switching. ;; Copyright (C) 2003 by Free Software Foundation, Inc. ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Steve Youngs <steve(a)youngs.au.com> ;; Keywords: xwem -;; X-CVS: $Id: xwem-clswi.el,v 1.6 2004/12/16 08:08:04 youngs Exp $ +;; X-CVS: $Id: xwem-clswi.el,v 1.5 2004/12/05 22:37:33 lg Exp $ ;; This file is NOT part of XEmacs. ＠＠ -27,106 +28,121 ＠＠ ;;; Commentary: -;; To use this package add something like: -;; -;; (autoload 'xwem-clswi-enable "xwem-clswi" "Enable client switching." t) -;; (add-hook 'xwem-load-hook 'xwem-clswi-enable) -;; -;; to your xwemrc.el. It will install new bindings `H-]' for -;; switching to next client and `H-[' for switching to previous -;; client. +;; Included as default bindings, `H-[', `H-]', `H-{', `H-}'. + +;; If current client supports windowing, than next/prev client in its +;; window is selected. If client does not support windowing (for +;; example fullscreen client) next/prev client of same manage type is +;; selected. ;;; Code: +(require 'xwem-clients) + (defgroup xwem-clswi nil "Group to customize clients switcher." :prefix "xwem-clswi-" :group 'xwem) -(defcustom xwem-clswi-beep-on-error nil +(defcustom xwem-clswi-beep-on-error t "*Non-nil mean beep on any error." :type 'boolean :group 'xwem-clswi) (defcustom xwem-clswi-show-info nil - "*Non-nil mean show info about client in xwem minibuffer after switch." -:type 'boolean + "*Non-nil mean show info about client in xwem minibuffer after switch. +It also can be a function which accepts one argument - client and +return non-nil to show info." +:type '(restricted-sexp :match-alternatives (functionp boolean-p)) :group 'xwem-clswi) -(defvar xwem-clswi-enabled nil - "Non-nil means that xwem-clswi is enabled. -Do not ch + (xwem-interactive (list (xwem-cl-selected) + (prefix-numeric-value xwem-prefix-arg))) - (xwem-message (if xwem-clswi-beep-on-error 'warn 'warn-nobeep) - "No clients to switch.")))) + (xwem-clswi-next cl (- arg))) -(define-xwem-command xwem-clswi-prev (arg &optional win) - "Switch to ARG previous client in WIN. -If WIN is ommited then in selected window." +;;;###autoload(autoload 'xwem-clswi-next-other-window "xwem-clswi" nil t) +(define-xwem-command xwem-clswi-next-other-window (arg) + "Switch next ARG client in other window." (xwem-interactive "p") - (xwem-clswi-next (- arg) win)) + (let ((win (xwem-window-other 1 (xwem-win-selected)))) + (when (and (xwem-win-p win) + (not (eq win (xwem-win-selected)))) + (xwem-clswi-next (xwem-win-cl win) arg)))) + +;;;###autoload(autoload 'xwem-clswi-prev-other-window "xwem-clswi" nil t) +(define-xwem-command xwem-clswi-prev-other-window (arg) + "Switch previous ARG client in other window." + (xwem-interactive "p") + (xwem-clswi-next-other-window (- arg))) (provide 'xwem-clswi) Index: lisp/xwem-compat.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-compat.el,v retrieving revision 1.5 diff -u -u -r1.5 xwem-compat.el --- lisp/xwem-compat.el 16 Dec 2004 08:08:04 -0000 1.5 +++ lisp/xwem-compat.el 1 Jan 2005 04:41:10 -0000 ＠＠ -5,7 +5,7 ＠＠ ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> ;; Created: Fri Dec 12 15:51:10 MSK 2003 ;; Keywords: xwem, xlib -;; X-CVS: $Id: xwem-compat.el,v 1.5 2004/12/16 08:08:04 youngs Exp $ +;; X-CVS: $Id: xwem-compat.el,v 1.4 2004/11/29 20:41:47 lg Exp $ ;; This file is part of XWEM. ＠＠ -33,11 +33,10 ＠＠ ;;; Code: -;;;###autoload + (defvar xwem-gnuemacs-p (string-match "GNU Emacs" emacs-version) "Non-nil when running under GNU Emacs.") -;;;###autoload (defun xwem-define-prefix-command (name &optional mapvar) "Compat version for `define-prefix-command'." (if xwem-gnuemacs-p Index: lisp/xwem-desktop.el =================================================================== RCS file: lisp/xwem-desktop.el diff -N lisp/xwem-desktop.el --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ lisp/xwem-desktop.el 1 Jan 2005 04:41:10 -0000 ＠＠ -0,0 +1,160 ＠＠ +;;; xwem-desktop.el --- + +;; Copyright (C) 2004 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Steve Youngs <steve(a)youngs.au.com> +;; Created: Wed Jul 14 10:16:20 MSD 2004 +;; Keywords: xwem, desktop +;; X-CVS: $Id: xwem-desktop.el,v 1.4 2004/12/05 22:37:33 lg Exp $ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; To start using, add something like: + +;; (add-hook 'xwem-exit-hook 'xwem-desktop-save) +;; (xwem-desktop-load) + +;; to your xwemrc. + +;;; TODO: + +;; * Save registers betwean sessions, maybe by using expectances. + +;;; Code: + +(require 'xwem-load) +(require 'xwem-frame) + +;;; Customisation +(defgroup xwem-desktop nil + "Group to customize xwem desktop." +:prefix "xwem-desktop-" +:group 'xwem) + +(defcustom xwem-desktop-goals + '(frames-config + (keymap . xwem-user-macros-prefix) + (xwem-launcher-history . 100) + (xwem-read-expression-history . 100)) + "*List of variables to save. +Each element is eather symbol or cons cell in form. +$symbol . maxsize$." +:type '(repeat (choice (const :tag "Frames configuration" frames-config) + (cons :tag "Keymap goal" + (const :tag "Keymap" keymap) + (symbol :tag "Keymap prefix")) + (cons :tag "History" + (choice (const :tag "Launcher history" xwem-launcher-history) + (const :tag "Expression history" xwem-read-expression-history) + (symbol :tag "Custom history")) + (number :tag "Max Size")))) +:group 'xwem-desktop) + +;;; Internal variables + +(defun xwem-desktop-save-element (el &optional buffer) + "Save element EL. +EL is one of that occurs in `xwem-desktop-goals'." + (unless buffer + (setq buffer (current-buffer))) + (cond ((eq el 'frames-config) + ;; Store frames configuration here + (xwem-frame-config-dump1 (xwem-frame-configuration) buffer t)) + + ((symbolp el) + (princ "\n;; Symbol value\n" buffer) + (princ (concat "(setq " (symbol-name el) " " + (if (listp (symbol-value el)) + (concat "(quote " (prin1-to-string (symbol-value el)) ")") + (prin1-to-string (symbol-value el))) + ")\n") + buffer)) + + ((and (consp el) (numberp (cdr el))) + (princ "\n;; List\n" buffer) + (let ((result nil) + (clist (symbol-value (car el))) + (limit (cdr el))) + (while (and clist (> limit 0)) + (unless (member (car clist) result) + (setq result (cons (car clist) result)) + (decf limit)) + (setq clist (cdr clist))) + (setq result (nreverse result)) + (princ (concat "(setq " (symbol-name (car el)) " " + "(quote " (prin1-to-string result) ")" + ")\n") + buffer))) + + ((and (consp el) (eq (car el) 'keymap)) + (let* ((kmap (xwem-kbd-fixup-keymap (cdr el))) + (kmap-name (keymap-name kmap))) + (princ (format "\n;; Keymap (%s)\n" kmap-name) buffer) + (map-keymap (lambda (kseq fbind) + (princ (concat "(define-key (quote " (prin1-to-string kmap-name) ") " + "(quote " (prin1-to-string kseq) ") " + "(quote " (prin1-to-string fbind) ")" + ")\n") + buffer)) + kmap))) + + (t (xwem-message 'warning "Strange el: `%S', skiping .." el)))) + +;;;###autoload(autoload 'xwem-desktop-save "xwem-desktop" nil t) +(define-xwem-command xwem-desktop-save (&optional file) + "Save things described in `xwem-desktop-goals' into FILE. +Defaultly FILE is ~/.xwem/xwem-desktop.el" + (xwem-interactive "FSave xwem desktop to: ") + (unless file + (setq file (expand-file-name "xwem-desktop.el" xwem-dir))) + + (with-temp-buffer + (erase-buffer) + (insert + (format ";;; %s --- Desktop configuration for XWEM.\n" + (file-name-nondirectory file)) + "\n;; NOTE: This file is automatically generated by xwem-desktop\n\n") + + ;; Set print-XX to nil to make full printing of objects + (let ((print-length nil) + (print-level nil)) + (mapc 'xwem-desktop-save-element xwem-desktop-goals)) + + (insert (format "\n;;; %s ends here\n" (file-name-nondirectory file))) + (write-region (point-min) (point-max) file))) + +;;;###autoload(autoload 'xwem-desktop-load "xwem-desktop" nil t) +(define-xwem-command xwem-desktop-load (&optional file) + "Load saved desktop from FILE. +Default FILE is ~/.xwem/xwem-desktop.el." + (xwem-interactive "FLoad xwem desktop from: ") + + (unless file + (setq file (expand-file-name "xwem-desktop.el" xwem-dir))) + + (load-file file)) + + +(provide 'xwem-desktop) + +;;; xwem-desktop.el ends here Index: lisp/xwem-diagram.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-diagram.el,v retrieving revision 1.4 diff -u -u -r1.4 xwem-diagram.el --- lisp/xwem-diagram.el 16 Dec 2004 08:08:05 -0000 1.4 +++ lisp/xwem-diagram.el 1 Jan 2005 04:41:11 -0000 ＠＠ -5,7 +5,7 ＠＠ ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> ;; Created: Sat Mar 6 17:09:58 MSK 2004 ;; Keywords: xwem -;; X-CVS: $Id: xwem-diagram.el,v 1.4 2004/12/16 08:08:05 youngs Exp $ +;; X-CVS: $Id: xwem-diagram.el,v 1.3 2004/12/03 19:43:36 lg Exp $ ;; This file is part of XWEM. ＠＠ -39,6 +39,11 ＠＠ ;;; Code: +(require 'xlib-xlib) + +(require 'xwem-faces) + + (defun xwem-diag-dot-distance (dot1 dot2) "Return distance betwean DOT1 and DOT2." (let ((w (abs (- (X-Point-x dot1) (X-Point-x dot2)))) ＠＠ -351,7 +356,6 ＠＠ (list d1 dd1 dd2 dd3 d3 d4 d1 d2 d3 d2 dd2)) )) -;;;###autoload (defun xwem-diag-draw-percentage (type spec d edge-gc x y width height &optional sector-width label-factor label-font) "Draw percentage sector of TYPE. TYPE is one of 'plain or '3d. ＠＠ -378,10 +382,10 ＠＠ ;; Validate spec ; (when (> (apply '+ (mapcar (lambda (el) (aref el 0)) spec)) 100) -; (error "Invalid spec" spec)) +; (error "XWEM Invalid spec" spec)) (let ((draw-sector (lambda (sel angbeg angle) - (xwem-face-set-foreground temp-fill-face (aref sel 2)) + (xwem-set-face-foreground temp-fill-face (aref sel 2)) (let ((xint-off 0) (yint-off 0)) ＠＠ -411,7 +415,8 ＠＠ (gc edge-gc) (text (if (stringp (aref sel 1)) (aref sel 1) (format "%d%%" (aref sel 0))))) (XDrawString xdpy d gc - (- (X-Point-x (nth 2 cd)) (/ (X-Text-width xdpy (X-Gc-font gc) text) 2)) + (- (X-Point-x (nth 2 cd)) + (/ (X-Text-width xdpy (X-Gc-font gc) text) 2)) (+ (/ (X-Text-height xdpy (X-Gc-font gc) text) 2) (X-Point-y (nth 2 cd))) text))) ＠＠ -463,7 +468,6 ＠＠ ))) -;;;###autoload (defun xwem-diag-plot-coordinates (d gc x y w h x-step y-step &rest params) "Draw coordinates system." (let ((notch-len (or (plist-get params :notch-len) 4)) ＠＠ -483,12 +487,18 ＠＠ (setq noff (% center-x x-step)) (while (< noff w) - (setq x-notches (cons (cons (cons (+ x noff) (- y center-y)) (cons (+ x noff) (- y center-y notch-len))) x-notches)) + (setq x-notches (cons (cons (cons (+ x noff) + (- y center-y)) + (cons (+ x noff) (- y center-y notch-len))) + x-notches)) (setq noff (+ noff x-step))) (setq noff (% center-y y-step)) (while (< noff h) - (setq y-notches (cons (cons (cons (+ x center-x) (- y noff)) (cons (+ x center-x notch-len) (- y noff))) y-notches)) + (setq y-notches (cons (cons (cons (+ x center-x) + (- y noff)) + (cons (+ x center-x notch-len) (- y noff))) + y-notches)) (setq noff (+ noff y-step))) ;; Set dashes ＠＠ -496,19 +506,21 ＠＠ (setq sls (X-Gc-line-style gc)) (setf (X-Gc-line-style gc) X-LineOnOffDash) (XChangeGC xdpy gc) - (XSetDashes xdpy gc 0 (list grid-dash-even grid-dash-odd grid-dash-even grid-dash-odd)) + (XSetDashes xdpy gc 0 (list grid-dash-even grid-dash-odd + grid-dash-even grid-dash-odd)) (unwind-protect (progn - (XDrawSegments xdpy d gc (mapcar (lam + (apply 'nconc (mapcar* (lambda (d dn) + (if dn + (list d (cons (X-Point-x d) (X-Point-y dn))) + (list d))) + dots (nconc (cdr dots) (list nil)))))) ((eq type 'histeps) ;; TODO: write me ＠＠ -625,7 +652,6 ＠＠ )) )) -;;;###autoload (defun xwem-diag-read-data-file (file &optional using x-scale y-scale) "Read data FILE and return list of dots lists. USING is cons cell that specifies which columns to use. Index: lisp/xwem-edmacro.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-edmacro.el,v retrieving revision 1.7 diff -u -u -r1.7 xwem-edmacro.el --- lisp/xwem-edmacro.el 16 Dec 2004 08:08:05 -0000 1.7 +++ lisp/xwem-edmacro.el 1 Jan 2005 04:41:11 -0000 ＠＠ -3,9 +3,10 ＠＠ ;; Copyright (C) 2003 by Free Software Foundation, Inc. ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Steve Youngs <steve(a)youngs.au.com> ;; Created: Fri Dec 12 11:19:50 MSK 2003 ;; Keywords: xwem, xlib -;; X-CVS: $Id: xwem-edmacro.el,v 1.7 2004/12/16 08:08:05 youngs Exp $ +;; X-CVS: $Id: xwem-edmacro.el,v 1.6 2004/12/05 22:37:33 lg Exp $ ;; This file is part of XWEM. ＠＠ -37,11 +38,12 ＠＠ ;;; Code: - (eval-and-compile - (require 'xwem-macros) (require 'edmacro)) +(require 'xwem-load) + +;;; Customization (defgroup xwem-edmacro nil "Group to customize `xwem-edmacro' addon." :prefix "xwem-edmacro-" ＠＠ -59,6 +61,8 ＠＠ :type 'boolean :group 'xwem-edmacro) +;;; Internal variables + ;; Variables (defvar xwem-edmacro-prefix-arg nil "Value of prefix argument. ＠＠ -81,8 +85,17 ＠＠ ;; redefine key in user macros map (define-key xwem-global-map xwem-edmacro-store-place mac))) - (setq xwem-edmacro-store-place nil) - ) + (setq xwem-edmacro-store-place nil)) + +(defun xwem-edmacro-finish (frame) + "Called when edmacro finishes. +FRAME is special emacs frame where macro editing occurs. +Keep selected buffer to be selected even after FRAME deleted." + (let ((buf (current-buffer))) + (if (frame-live-p frame) + (delete-frame frame t) + (xwem-special-revert-focus nil)) + (set-buffer buf))) ;;;###autoload(autoload 'xwem-edmacro-edit-kbd-macro "xwem-edmacro" "" t) (define-xwem-command xwem-edmacro-edit-kbd-macro (xwem-keys &optional arg) ＠＠ -92,18 +105,18 ＠＠ (list (xwem-read-key-sequence (substitute-command-keys - (concat "Enter \\<xwem-global-map>\\[xwem-keymacro-play-last] " - "or one of \\<xwem-global-map>\\[xwem-user-keymacros-prefix] XXX: "))) + (concat "Enter `\\<xwem-global-map>\\[xwem-keymacro-play-last]' " + "or one of `\\<xwem-global-map>\\[xwem-user-macros-prefix] XXX': "))) (prefix-numeric-value xwem-prefix-arg))) (xwem-kbd-stop-grabbing) - (let ((xwem-cmd (xwem-kbd-key-binding xwem-keys)) - xwem-evs) + (let ((xwem-cmd (xwem-kbd-get-binding xwem-keys)) + xwem-evs frame) (setq xwem-evs (cond ((eq xwem-cmd 'xwem-keymacro-play-last) (setq xwem-edmacro-store-place 'xwem-keymacro-last-kbd-macro) - xwem-keymacro-last-kbd-macro) + (or xwem-keymacro-last-kbd-macro [])) ((vectorp xwem-cmd) (setq xwem-edmacro-store-place xwem-keys) ＠＠ -120,19 +133,19 ＠＠ (t nil))) (if (null xwem-evs) - (cond ((and (null xwem-edmacro-can-edit-unbinded) (null xwem-cmd)) - (xwem-message 'warn (concat "Dissalowed to edit unbinded key " - (key-description xwem-keys) - " by `xwem-edmacro-can-edit-unbinded'"))) - ((null xwem-edmacro-can-edit-nonmacro) - (xwem-message 'warn (concat "Dissalowed to edit non-macro key " - (key-description xwem-keys) - " by `xwem-edmacro-can-edit-nonmacro'."))) - (t (xwem-message 'warn "Invalid keyboard macro given."))) + (cond ((and (not xwem-edmacro-can-edit-unbinded) (null xwem-cmd)) + (xwem-message 'warning (concat "Dissalowed to edit unbinded key " + (key-description xwem-keys) + " by `xwem-edmacro-can-edit-unbinded'"))) + ((not xwem-edmacro-can-edit-nonmacro) + (xwem-message 'warning (concat "Dissalowed to edit non-macro key " + (key-description xwem-keys) + " by `xwem-edmacro-can-edit-nonmacro'."))) + (t (xwem-message 'warning "Invalid keyboard macro given."))) ;; XXX (when xwem-edmacro-store-place - (xwem-special-popup-frame (get-buffer-create "*Edit Macro*") t) + (setq frame (xwem-special-popup-frame (get-buffer-create "*Edit Macro*") t)) ;; Add some info in *Edit Macro* buffer (let ((edmacro-format-hook ＠＠ -159,7 +172,10 ＠＠ (mapvector (lambda (k) (if (and (listp k) (= (length k) 1)) (car k) k)) xwem-evs)) - (edit-kbd-macro xwem-evs arg 'xwem-special-revert-focus 'xwem-edmacro-store))) + ;; Start edmacro + (edit-kbd-macro xwem-evs arg + `(lambda () (xwem-edmacro-finish ,frame)) + 'xwem-edmacro-store))) ))) Index: lisp/xwem-edprops.el =================================================================== RCS file: lisp/xwem-edprops.el diff -N lisp/xwem-edprops.el --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ lisp/xwem-edprops.el 1 Jan 2005 04:41:11 -0000 ＠＠ -0,0 +1,154 ＠＠ +;;; xwem-edprops.el --- Interactively edit xwem client's properties. + +;; Copyright (C) 2004 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Created: Wed Oct 27 11:15:39 MSD 2004 +;; Keywords: xwem, edit +;; X-CVS: $Id: xwem-edprops.el,v 1.1 2004/11/29 20:41:30 lg Exp $ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; Mode to edit xwem client's properties. + +;;; Code: +(require 'xwem-load) + + +;; Various stuff +(defvar xwem-edprops-mode-hook nil + "*Hooks to call when entering xwem edprops mode.") + +(defvar xwem-edprops-client nil) +(make-variable-buffer-local 'xwem-client-edprops-client) + +(defvar xwem-edprops-mode nil + "Non-nil mean xwem edprops mode is enabled.") +(make-variable-buffer-local 'xwem-edprops-mode) +(set-default 'xwem-edprops-mode nil) + +(defvar xwem-edprops-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-c" 'xwem-edprops-finish) + (define-key map "\C-c\C-q" 'xwem-edprops-quit) + map) + "Keymap when editing client properties.") + +(or (assq 'xwem-edprops-mode minor-mode-alist) + (setq minor-mode-alist + (cons (list 'xwem-edprops-mode + " XWEM-edprops") + minor-mode-alist))) + +(or (assq 'xwem-edprops-mode minor-mode-map-alist) + (setq minor-mode-map-alist + (cons (cons 'xwem-edprops-mode + xwem-edprops-map) + minor-mode-map-alist))) + + +(defun xwem-edprops-quit (cl) + "Quit editing properties for CL discarding changes." + (interactive (list xwem-edprops-client)) + + (set-buffer-modified-p nil) + (kill-buffer (current-buffer))) + +(defun xwem-edprops-finish (cl) + "Finish editing properties for CL, saving changes." + (interactive (list xwem-edprops-client)) + + (set-buffer-modified-p nil) + (let ((nplist (read (buffer-string))) + (oplist (xwem-cl-plist cl))) + (kill-buffer (current-buffer)) + + ;; Remove all supported properties that not in NPLIST + (while oplist + (when (and (xwem-property-supported-p (car oplist)) + (not (plist-get nplist (car oplist)))) + (xwem-message 'info "Removing property %S ..\n" (car oplist)) + (xwem-client-set-property cl (car oplist) nil)) + (setq oplist (cddr oplist))) + + (xwem-cl-apply-plist cl nplist))) + +(defun xwem-edprops-mode () + "Enable xwem-edprops mode in current buffer." + (setq xwem-edprops-mode t) + + (run-hooks 'xwem-edprops-mode-hook)) + +;;;###autoload(autoload 'xwem-edit-client-properties "xwem-edprops" "Interactively edit client's properties." t) +(define-xwem-command xwem-edit-client-properties (cl) + "Interactive edit CL's properties." + (xwem-interactive (list (xwem-cl-selected))) + + (when (eq cl (xwem-dummy-client)) + (error "XWEM Can't edit properties for dummy client")) + + (with-current-buffer (get-buffer-create " *CL-PROPS*") + (kill-all-local-variables) + (setq xwem-edprops-client cl) + + (emacs-lisp-mode) + (setq xwem-edprops-mode t) ; enable edprops mode + + (erase-buffer) + (insert ";; Bindings:\n") + (insert ";; ") (where-is 'xwem-edprops-finish t) (insert "\n") + (insert ";; ") (where-is 'xwem-edprops-quit t) (insert "\n") + + (insert + "\n" + ";; XWEM Client\n\n" + (format ";; Manage mode: %s\n" (upcase (symbol-name (xwem-cl-manage-type cl)))) + (format ";; Name: %s\n" (xwem-client-name cl)) + (format ";; Class: %S\n" (xwem-hints-wm-class (xwem-cl-hints cl))) + (format ";; Command: %S\n" (xwem-hints-wm-command (xwem-cl-hints cl))) + "(\n\n") + (save-excursion + (mapc (lambda (kv) + (when (or (numberp (cdr kv)) + (symbolp (cdr kv)) + (stringp (cdr kv))) + (insert (format "%S %S\n" (car kv) (cdr kv))))) + (plist-to-alist (xwem-cl-plist cl))) + + (insert "\n\n;;; Supported properties:\n") + (let ((print-level 4)) ; Restrict huge output + (mapc (lambda (sp) + (unless (memq (car sp) (xwem-cl-plist cl)) + (insert (format "; %S %S\n" (car sp) (xwem-client-property cl (car sp)))))) + xwem-supported-client-properties)) + (insert "\n)")) + + ;; Enter editing properties mode + (xwem-edprops-mode) + + (xwem-special-popup-frame (current-buffer)) + )) + + +(provide 'xwem-edprops) + +;;; xwem-edprops.el ends here Index: lisp/xwem-events.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-events.el,v retrieving revision 1.9 diff -u -u -r1.9 xwem-events.el --- lisp/xwem-events.el 16 Dec 2004 08:08:05 -0000 1.9 +++ lisp/xwem-events.el 1 Jan 2005 04:41:11 -0000 ＠＠ -3,9 +3,10 ＠＠ ;; Copyright (C) 2003 by Free Software Foundation, Inc. ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Steve Youngs <steve(a)youngs.au.com> ;; Created: 21 Mar 2003 ;; Keywords: xlib, xwem -;; X-CVS: $Id: xwem-events.el,v 1.9 2004/12/16 08:08:05 youngs Exp $ +;; X-CVS: $Id: xwem-events.el,v 1.6 2004/12/05 22:37:33 lg Exp $ ;; This file is part of XWEM. ＠＠ -33,199 +34,239 ＠＠ ;; ;;; Code -(eval-when-compile - (require 'xlib-xwin)) - -(defun xwem-ev-defhnd (xdpy win xev) - "Default X-Events handler." - - (X-Event-CASE xev -; (:X-ClientMessage (xwem-ev-clnmsg xdpy win xev)) -; (:X-PropertyNotify (xwem-ev-property xdpy win xev)) - (:X-ConfigureRequest (xwem-ev-reconfig xdpy win xev)) - (:X-MapRequest (xwem-ev-remap xdpy win xev)) - (:X-DestroyNotify (xwem-ev-destroy xdpy win xev)) - (:X-ResizeRequest (xwem-ev-reresize xdpy win xev))) - ) +(require 'xwem-load) +;;;###xwem-autoload (defun xwem-ev-reconfig (xdpy win xev) "Common ConfigureRequest handler." (let* ((win (X-Event-xconfigurerequest-wind + ;; Remember some information about command invocation + (setq xwem-last-xevent x-ev + xwem-event-client (xwem-event-client x-ev) + xwem-last-event e-ev + xwem-this-command-keys (vconcat (and (not (xwem-kbd-global-map-current-p)) + xwem-this-command-keys) + (vector e-ev)))) + + +;;;###xwem-autoload +(defun xwem-next-command-event (&optional prompt) + "Return next command event. +Actually return cons cell where car is Emacs event and cdr is X Event." + (let (eev cev xev) + ;; Normal + (when prompt + (xwem-message 'prompt prompt)) + + ;; Process while interesting event occur + (while (and (setq eev (next-event)) + (not (cond ((and (eval-event-p eev) + (X-Event-p (setq xev (event-object eev))) + (memq (X-Event-type xev) + (list X-KeyPress X-ButtonPress + X-ButtonRelease X-MotionNotify)) + (setq cev (car (xwem-xevents->emacs-events (list xev) t)))) + (X-Event-put-property xev 'emacs-event cev) + 'break) + + ((and (eval-event-p eev) + (eventp (setq cev (event-object eev))) + (eq (event-function eev) 'xwem-dispatch-command-event)) + ;; Unread command event + (setq xev nil) + 'break)))) + (dispatch-event eev)) + + (when prompt + (xwem-clear-message)) + + (xwem-event-as-command cev xev) + (cons cev xev))) + +;;;###xwem-autoload +(defun xwem-dispatch-command-event (eev &optional xev) + "Dispatch command Emacs event EEV." + (let* ((ecl (xwem-event-client xev)) + (bind (or (xwem-lookup-key ecl (vector eev)) + ;; Then check for quit key + (and (equal xwem-quit-key (events-to-keys (vector eev))) + xwem-quit-command) + ;; Then accept even default bindings + (xwem-lookup-key ecl (vector eev) t)))) + ;; If some button press/release does not have binding - ignore it + (unless (and (null bind) (button-event-p eev)) + (xwem-event-as-command eev xev) + (xwem-kbd-dispatch-binding bind)))) + +;;;###xwem-autoload +(defun xwem-dispatch-command-xevent (xev) + "Dispatch command event XEV." + ;; If we are grabbing keyboard now and modifier pressed do nothing. + (unless (or (= (X-Event-type xev) X-KeyRelease) + (and (= (X-Event-type xev) X-KeyPress) + (xwem-kbd-kcode-modifier-p (X-Event-xkey-keycode xev)))) + (setf (xwem-xevent-emacs-event xev) + (car (xwem-xevents->emacs-events (list xev) t))) + (xwem-dispatch-command-event + (xwem-xevent-emacs-event xev) xev))) + +;;; Unread command events support +;;;###xwem-autoload +(defun xwem-unread-command-event (eev-or-xev) + "Make event EV to be readed by `xwem-next-command-event' later, +or to be executed by `xwem-dispatch-command-event'. +Event EV can be either Emacs event, or X-Event." + (enqueue-eval-event (if (X-Event-p eev-or-xev) + 'xwem-dispatch-command-xevent + 'xwem-dispatch-command-event) + eev-or-xev)) + + (provide 'xwem-events) ;;; xwem-events.el ends here Index: lisp/xwem-faces.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-faces.el,v retrieving revision 1.10 diff -u -u -r1.10 xwem-faces.el --- lisp/xwem-faces.el 16 Dec 2004 08:08:05 -0000 1.10 +++ lisp/xwem-faces.el 1 Jan 2005 04:41:11 -0000 ＠＠ -3,9 +3,10 ＠＠ ;; Copyright (C) 2003 by Free Software Foundation, Inc. ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Steve Youngs <steve(a)youngs.au.com> ;; Created: Mon Dec 29 12:04:19 MSK 2003 ;; Keywords: xwem -;; X-CVS: $Id: xwem-faces.el,v 1.10 2004/12/16 08:08:05 + (setq spec (specifier-spec-list spec nil tag-set t)) + (cdr (car (cdr (car spec))))))) + +;; Getters +(defsubst xwem-face-foreground (face &optional tag-set domain) + "Return FACE foreground color in TAG-SET." + (or (xwem-face-generic-specifier face 'foreground tag-set domain) + (xwem-face-generic-specifier face 'foreground) + (face-foreground-name face))) +(defsubst xwem-face-background (face &optional tag-set domain) + "Return FACE background color in TAG-SET." + (or (xwem-face-generic-specifier face 'background tag-set domain) + (xwem-face-generic-specifier face 'background) + (face-background-name face))) +(defsubst xwem-face-font (face &optional tag-set domain) + "Return FACE font in TAG-SET." + (or (xwem-face-generic-specifier face 'font tag-set domain) + (xwem-face-generic-specifier face 'font) + (face-font-name face))) +(defsubst xwem-face-line-style (face &optional tag-set domain) + "Return FACE's line style in TAG-SET." + (or (xwem-face-generic-specifier face 'line-style tag-set domain) + (xwem-face-generic-specifier face 'line-style))) +(defsubst xwem-face-line-width (face &optional tag-set domain) + "Return FACE's line width TAG-SET." + (or (xwem-face-generic-specifier face 'line-width tag-set domain) + (xwem-face-generic-specifier face 'line-width))) +(defsubst xwem-face-cap-style (face &optional tag-set domain) + "Return FACE's cap style in TAG-SET." + (or (xwem-face-generic-specifier face 'cap-style tag-set domain) + (xwem-face-generic-specifier face 'cap-style))) +(defsubst xwem-face-join-style (face &optional tag-set domain) + "Return FACE's join style in TAG-SET." + (or (xwem-face-generic-specifier face 'join-style tag-set domain) + (xwem-face-generic-specifier face 'join-style))) +(defsubst xwem-face-function (face &optional tag-set domain) + "Return FACE's function in TAG-SET." + (or (xwem-face-generic-specifier face 'function tag-set domain) + (xwem-face-generic-specifier face 'function))) +(defsubst xwem-face-subwindow-mode (face &optional tag-set domain) + "Return FACE's cap style in TAG-SET." + (or (xwem-face-generic-specifier face 'subwindow-mode tag-set domain) + (xwem-face-generic-specifier face 'subwindow-mode))) +(defsubst xwem-face-graphics-exposures (face &optional tag-set domain) + "Return FACE's graphics exposures in TAG-SET." + (or (xwem-face-generic-specifier face 'graphics-exposures tag-set domain) + (xwem-face-generic-specifier face 'graphics-exposures) + X-False)) + +(defsubst xwem-face-x-gc (face &optional tag-set domain) + "Return FACE's X-Gc in TAG-SET." + (or (face-property face (xwem-face-generic-specifier face 'x-gc tag-set domain)) + (face-property face 'xwem-x-gc))) + +;; Setters +(defun xwem-face-set-domain-face (face &optional domain) + (cond ((null domain) (xwem-face-get-domain-face face)) + ((xwem-cl-p domain) + (or (cdr (assq face (xwem-cl-get-sys-prop domain 'domain-faces))) + (let ((nface (intern (symbol-name (gensym "xwem-cl-domain-face"))))) + (xwem-cl-put-sys-prop domain 'domain-faces + (cons (cons face (xwem-copy-face face nface)) + (xwem-cl-get-sys-prop domain 'domain-faces))) + nface))) + ((xwem-win-p domain) + (or (cdr (assq face (xwem-win-get-prop domain 'domain-faces))) + (let ((nface (intern (symbol-name (gensym "xwem-win-domain-face"))))) + (xwem-win-put-prop domain 'domain-faces + (cons (cons face (xwem-copy-face face nface)) + (xwem-win-get-prop domain 'domain-faces))) + nface))) + ((xwem-frame-p domain) + (or (cdr (assq face (xwem-frame-get-prop domain 'domain-faces))) + (let ((nface (intern (symbol-name (gensym "xwem-frame-domain-face"))))) + (xwem-frame-put-prop domain 'domain-faces + (cons (cons face (xwem-copy-face face nface)) + (xwem-frame-get-prop domain 'domain-faces))) + + (XDefaultRootWindow xdpy)) + (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy) +:line-style (xwem-face-line-style face tag-set 'nodomain) +:line-width (xwem-face-line-width face tag-set 'nodomain) +:cap-style (xwem-face-cap-style face tag-set 'nodomain) +:join-style (xwem-face-join-style face tag-set 'nodomain) +:function (xwem-face-function face tag-set 'nodomain) +:subwindow-mode (xwem-face-subwindow-mode face tag-set 'nodomain) +:graphics-exposures (xwem-face-graphics-exposures face tag-set 'nodomain) +:foreground (let ((fc (xwem-face-foreground face tag-set 'nodomain))) + (if (stringp fc) + (XAllocColor xdpy cmap (xwem-make-color fc)) + fc)) +:background (let ((bc (xwem-face-background face tag-set 'nodomain))) + (if (stringp bc) + (XAllocColor xdpy cmap (xwem-make-color bc)) + bc)) +:font (X-Font-get xdpy (xwem-face-font face tag-set 'nodomain)))))) + (xwem-set-face-x-gc face gc tag-set 'nodomain) + gc))) - (let ((xdpy (xwem-dpy)) - (gc (xwem-face-get-gc face)) - (fgcol (xwem-misc-colorspec->rgb-vector-safe (face-foreground-name face) [0 0 0]))) - (setf (X-Gc-foreground gc) (XAllocColor xdpy (XDefaultColormap xdpy) - (make-X-Color :red (aref fgcol 0) -:green (aref fgcol 1) -:blue (aref fgcol 2)))) - (XChangeGC xdpy gc))) +(put 'xwem-face-get-gc 'lisp-indent-function 1) (provide 'xwem-faces) Index: lisp/xwem-focus.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-focus.el,v retrieving revision 1.8 diff -u -u -r1.8 xwem-focus.el --- lisp/xwem-focus.el 16 Dec 2004 08:08:06 -0000 1.8 +++ lisp/xwem-focus.el 1 Jan 2005 04:41:11 -0000 ＠＠ -3,9 +3,10 ＠＠ ;; Copyright (C) 2003 by Free Software Foundation, Inc. ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Steve Youngs <steve(a)youngs.au.com> ;; Created: Fri Dec 19 13:25:30 MSK 2003 ;; Keywords: xwem, xlib -;; X-CVS: $Id: xwem-focus.el,v 1.8 2004/12/16 08:08:06 youngs Exp $ +;; X-CVS: $Id: xwem-focus.el,v 1.7 2004/12/05 22:37:33 lg Exp $ ;; This file is part of XWEM. ＠＠ -32,174 +33,246 ＠＠ ;;; Code: -(eval-when-compile - (require 'xlib-xwin) - (require 'xwem-clients)) +(require 'xwem-load) ;;;###autoload +(defcustom xwem-default-focus-mode 'generic + "*Default CL's focus mode." +:type '(choice (const :tag "Generic mode" generic) + (const :tag "Click to focus" click-focus) + (const :tag "Follow mouse" follow-mouse)) +:group 'xwem) + +;;; Internal variables + (defvar xwem-focus-stack nil "Last thing that has focus. Internal variable, do not modify.") -;;;###autoload +;;;###xwem-autoload (defun xwem-focus-xcurrent () "Return current focus." (let ((cf (XGetInputFocus (xwem-dpy)))) cf)) -;;;###autoload (defun xwem-focus-push (&optional xwin) "Push current focus or XWIN to `xwem-focus-stack'." (push (or xwin (xwem-focus-xcurrent)) xwem-focus-stack)) -;;;###autoload +;;;###xwem-autoload (defun xwem-focus-pop () "Pop value from `xwem-focus-stack'." (pop xwem-focus-stack)) -;;;###autoload (defun xwem-focus-push-set (xwin) "Push current focus to `xwem-focus-stack' and set focus to XWIN." (xwem-focus-push) (XSetInputFocus (xwem-dpy) xwin X-RevertToParent)) -;;;###autoload (defun xwem-focus-pop-set () "Pop from `xwem-focus-stack' and s +(define-xwem-client-property xwem-focus-mode nil + "Client focus model." +:type '(eval (list 'choice xwem-focus-mode-names)) +:set 'xwem-focus-set-focus-mode) + +(defun xwem-focus-set-focus-mode (cl prop mode) + "Set CL focus mode property PROP to MODE." + (xwem-focus-mode-invoke cl 'before-mode-change) + (xwem-cl-put-prop cl prop (or mode xwem-default-focus-mode)) + (xwem-focus-mode-invoke cl 'after-mode-change)) -(defun xwem-focus-mode-define (name fun) +(defmacro define-xwem-focus-mode (name args &optional docstring &rest body) "Define new focus mode named by NAME. FUN specifies function to call when focus changes." - (add-to-list 'xwem-focus-modes (cons name fun)) - (put name 'xwem-focus-mode fun)) + (let ((fun (or (and (functionp args) `(function ,args)) + `(lambda ,args + ,docstring + ,＠body)))) + `(progn + (put (quote ,name) 'xwem-focus-mode ,fun) + (add-to-list 'xwem-focus-mode-names + (cons (list 'const :tag ,docstring (quote ,name)) (quote ,fun)))))) +(put 'define-xwem-focus-mode 'lisp-indent-function 'defun) -;;;###autoload +;;;###xwem-autoload (defun xwem-focus-mode-invoke (cl &rest args) - "Invoke CL's focus mode function with ARGS." + "Invoke CL's focus mode function with ARGS. +Invoke focus mode, car of ARGS normally type of invocation. +Built-in invocation types are: + + 'before-mode-change - Called before focus mode changed. + 'after-mode-change - Called after focus mode has been changed. + 'focus-in - When CL receives focus. + 'focus-out - When CL looses focus. + 'enter - When CL enters. + 'leave - When CL leaves. + 'before-keymap-change - Before CL's local map changed. + 'after-keymap-change - After CL's local map changed. +" (when (xwem-cl-p cl) - (let* ((mode (xwem-cl-get-prop cl 'xwem-focus-mode)) + (let* ((mode (xwem-client-property cl 'xwem-focus-mode)) (fun (get mode 'xwem-focus-mode))) (when fun (apply fun cl args))))) -;;;###autoload -(defun xwem-focus-mode-set (cl mode) - "For CL window set focus mode to MODE." - (unless (eq (xwem-cl-get-prop cl 'xwem-focus-mode) mode) - (xwem-focus-mode-invoke cl 'before-mode-change) - (xwem-cl-put-prop cl 'xwem-focus-mode mode) - (xwem-focus-mode-invoke cl 'after-mode-change))) +;;;###xwem-autoload +(defun xwem-focus-mode-set (cl &optional mode) + "For CL window set focus mode to MODE. +If MODE is ommited, `xwem-default-focus-mode' is used." + (xwem-focus-set-focus-mode cl 'xwem-focus-mode mode)) ;; Some built-in focus modes -(xwem-focus-mode-define 'generic - (lambda (cl action &optional xev) - nil)) - -(xwem-focus-mode-define 'follow-mouse - (lambda (cl action &optional xev) - (cond ((and (eq action 'enter) - (eq (X-Event-xcrossing-mode xev) X-NotifyNormal)) - (xwem-cl-pop-to-client cl)) - ))) +(define-xwem-focus-mode generic ignore "Generic mode") +(define-xwem-focus-mode follow-mouse (cl action &optional xev) + "Focus follow mouse" + (cond ((and (eq action 'enter) + (eq (X-Event-xcrossing-mode xev) X-NotifyNormal)) + (xwem-select-client cl)) + )) + +;;; Click to focus model +(defvar xwem-focus-click-to-focus-map + (let ((map (make-sparse-keymap))) + (define-key map [button1] 'xwem-focus-click-on) + (define-key map [button2] 'xwem-focus-click-on) + (define-key map [button3] 'xwem-focus-click-on) + map) + "Keymap used for click to focus model.") + +(defvar xwem-focus-click-minor-mode nil + "*Non-nil mean `xwem-focus-click-to-focus-map' is enabled.") +(xwem-make-variable-client-local 'xwem-focus-click-minor-mode) + +(defun xwem-turn-on-focus-click-mode (cl) + "On CL, turn on click to focus minor mode." + (unless (xwem-client-local-variable-value cl 'xwem-focus-click-minor-mode) + (xwem-kbd-install-grab xwem-focus-click-to-focus-map (xwem-cl-xwin cl) X-GrabModeSync) + (xwem-client-local-variable-set cl 'xwem-focus-click-minor-mode t))) + +(defun xwem-turn-off-focus-click-mode (cl) + "On CL, turn off click to focus minor mode." + (when (xwem-client-local-variable-value cl 'xwem-focus-click-minor-mode) + (XAllowEvents (xwem-dpy) X-ReplayPointer) + (xwem-kbd-uninstall-grab xwem-focus-click-to-focus-map (xwem-cl-xwin cl)) + (xwem-client-local-variable-set cl 'xwem-focus-click-minor-mode nil))) + +(defun xwem-focus-click-mode (cl) + "On CL, toggle click to focus minor mode." + (if (xwem-client-local-variable-value cl 'xwem-focus-click-minor-mode) + (xwem-turn-off-focus-click-mode cl) + (xwem-turn-on-focus-click-mode cl))) + +;;;###autoload(autoload 'xwem-focus-click-on "xwem-focus" nil t) (define-xwem-command xwem-focus-click-on () "Command used by `click-focus' focus mode." (xwem-interactive) - (let* ((xev xwem-last-xevent) - (cl (xwem-find-client (X-Event-win xev)))) - (when (xwem-cl-p cl) - (xwem-cl-pop-to-client cl)))) - -(xwem-focus-mode-define 'click-focus - (lambda (cl action &optional xev) - (cond ((and (eq action 'focus-in) - (or (eq (X-Event-xfocus-mode xev) X-NotifyNormal) - (eq (X-Event-xfocus-mode xev) X-NotifyWhileGrabbed))) - ;; Remove button1 from local keymap and ungrab it - (xwem-message 'info "focus in")) - - ((and (eq action 'focus-out) - (or (eq (X-Event-xfocus-mode xev) X-NotifyNormal) - (eq (X-Event-xfocus-mode xev) X-NotifyWhileGrabbed))) - ;; Add button1 to local keymap and grab for it - (xwem-local-set-key [button1] 'xwem-focus-click-on cl) - (xwem-message 'info "focus out")) - - ((eq action 'before-mode-change) - ;; Remove button1 from local keymap and ungrab it - ) - ))) - -(put 'xwem-focus-mode-define 'lisp-indent-function 1) + (when (xwem-cl-p xwem-event-client) + (xwem-select-client xwem-event-client)) + + ;; Pass the click + (XAllowEvents (xwem-dpy) X-ReplayPointer)) + +(define-xwem-focus-mode click-focus (cl action &optional xev) + "Click to focus" + (cond ((and (eq action 'focus-in) + (or (eq (X-Event-xfocus-mode xev) X-NotifyNormal) + (eq (X-Event-xfocus-mode xev) X-NotifyWhileGrabbed))) + ;; Remove button[123] from local keymap and ungrab it + (xwem-turn-off-focus-click-mode cl)) + + ((and (eq action 'focus-out) + (or (eq (X-Event-xfocus-mode xev) X-NotifyNormal) + (eq (X-Event-xfocus-mode xev) X-NotifyWhileGrabbed))) + ;; Add button[123] to local keymap and grab for it + (xwem-turn-on-focus-click-mode cl)) + + ((memq action '(after-mode-change after-keymap-change)) + ;; Start grabing button1 in sync mode + (unless (xwem-cl-selected-p cl) + (xwem-turn-on-focus-click-mode cl))) + + ((memq action '(before-mode-change before-keymap-change)) + ;; Remove button1 from local keymap and ungrab it + (xwem-turn-off-focus-click-mode cl)) + )) + +;; Register minor mode +(xwem-add-minor-mode 'xwem-focus-click-minor-mode + 'xwem-focus-click-minor-mode + xwem-focus-click-to-focus-map) (provide 'xwem-focus) Index: lisp/xwem-frame.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-frame.el,v retrieving revision 1.13 diff -u -u -r1.13 xwem-frame.el --- lisp/xwem-frame.el 16 Dec 2004 08:08:06 -0000 1.13 +++ lisp/xwem-frame.el 1 Jan 2005 04:41:12 -0000 ＠＠ -3,9 +3,10 ＠＠ ;; Copyright (C) 2003 by Free Software Foundation, Inc. ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Steve Youngs <steve(a)youngs.au.com> ;; Created: 21 Mar 2003 ;; Keywords: xlib, xwem -;; X-CVS: $Id: xwem-frame.el,v 1.13 2004/12/16 08:08:06 youngs Exp $ +;; X-CVS: $Id: xwem-frame.el,v 1.12 2004/12/05 22:37:33 lg Exp $ ;; This file is part of XWEM. ＠＠ -32,13 +33,13 ＠＠ ;; ;;; Code - -(eval-when-compile - (require 'xlib-xlib) - (require 'xwem-misc)) +(require 'xlib-xlib) (require 'xlib-xinerama) +(require 'xwem-load) +(require 'xwem-misc) + ;;; Variables (defgroup xwem-frame nil "Group + (setf (xwem-frame-link-prev ,frame2) pf))) + +(defmacro xwem-frame-link-remove (frame) + "Remove FRAME from linkage." + `(let ((nfr (xwem-frame-link-next ,frame)) + (pfr (xwem-frame-link-prev ,frame))) + (when (xwem-frame-p pfr) + (setf (xwem-frame-link-next pfr) nfr)) + (when (xwem-frame-p nfr) + (setf (xwem-frame-link-prev nfr) pfr)))) + +(defmacro xwem-frame-link-head (frame) + "Returns head frame of FRAME's linkage." + `(let ((fr ,frame)) + (while (xwem-frame-p (xwem-frame-link-prev fr)) + (setq fr (xwem-frame-link-prev fr))) + fr)) + +(defmacro xwem-frame-linkage-map (frame fn) + "Call FN for each frame in FRAME's linkage. +FN called with one argument - frame." + ;; TODO: avoid infinit recursion + `(let ((fr (xwem-frame-link-head ,frame))) + + (while (xwem-frame-p fr) + (funcall ,fn fr) + (setq fr (xwem-frame-link-next fr))))) +;;; Functions +(define-xwem-deffered xwem-frame-apply-state (frame) + "Apply FRAME's state to life." + (cond ((eq (xwem-frame-state frame) 'mapped) + (XMapWindow (xwem-dpy) (xwem-frame-xwin frame))) + ((eq (xwem-frame-state frame) 'unmapped) + (XUnmapWindow (xwem-dpy) (xwem-frame-xwin frame))))) + (defun xwem-frame-unmap (frame) "Unmap frame FRAME." - (when (xwem-frame-mapped-p frame) - (XSelectInput (xwem-dpy) (xwem-frame-xwin frame) 0) - (XUnmapWindow (xwem-dpy) (xwem-frame-xwin frame)) - (setf (xwem-frame-state frame) 'unmapped))) + (setf (xwem-frame-state frame) 'unmapped) + (xwem-frame-apply-state frame)) +;;;###xwem-autoload (defun xwem-frame-map (frame) "Map frame FRAME." - (unless (xwem-frame-mapped-p frame) - (XSelectInput (xwem-dpy) (xwem-frame-xwin frame) xwem-frame-ev-mask) + (setf (xwem-frame-state frame) 'mapped) + (xwem-frame-apply-state frame)) - (XMapWindow (xwem-dpy) (xwem-frame-xwin frame)) - (setf (xwem-frame-state frame) 'mapped))) +(define-xwem-deffered xwem-frame-apply-raise-lower (frame) + "Apply FRAME's raise/lower state to life." + (let ((rl (xwem-frame-get-prop frame 'raise-lower-state))) + (cond ((eq rl 'raise) + (XRaiseWindow (xwem-dpy) (xwem-frame-xwin frame))) + ((eq rl 'lower) + (XLowerWindow (xwem-dpy) (xwem-frame-xwin frame)))))) -;;;###autoload -(defun xwem-frame-selected () - "Return selected frame." - xwem-current-frame) +;;;###autoload(autoload 'xwem-frame-lower "xwem-frame" "" t) +(define-xwem-command xwem-frame-lower (frame) + "Lower FRAME's window." + (xwem-interactive (list (xwem-frame-selected))) -;;;###autoload -(defun xwem-frame-selected-p (frame) - "Return non-nil if FRAME is selected." - (eq frame (xwem-frame-selected))) + (xwem-frame-put-prop frame 'raise-lower-state 'lower) + (xwem-frame-apply-raise-lower frame)) +(put 'xwem-frame-lower 'xwem-frame-command t) + +;;;###autoload(autoload 'xwem-frame-raise "xwem-frame" "" t) +(define-xwem-command xwem-frame-raise (frame) + "Raise FRAME's window." + (xwem-interactive (list (xwem-frame-selected))) + + (xwem-frame-map frame) ; make sure frame is mapped + (xwem-frame-put-prop frame 'raise-lower-state 'raise) + (xwem-frame-apply-raise-lower frame)) +(put 'xwem-frame-raise 'xwem-frame-command t) (defun xwem-frame-embedded-for-frame (frame) "Return XWEM frame for which FRAME is embedded." (let* ((cl (and (xwem-frame-p frame) - (xwem-find-client (xwem-frame-xwin frame)))) + (xwem-frame-get-prop frame 'xwem-embedded-cl))) (rv (and (xwem-cl-p cl) (xwem-cl-frame cl)))) rv)) -(defun xwem-frame-embedded-pop (frame) - "Pop embedded FRAME, see also `xwem-cl-pop-to-client'." - (let* ((cl (xwem-find-client (xwem-frame-xwin frame))) - (clfr (and (xwem-cl-p cl) (xwem-cl-frame cl))) - (clw (and (xwem-cl-p cl) (xwem-cl-win cl)))) - - (when (null clfr) - (setq clfr (xwem-frame-selected))) - (when (null clw) - (setq clw (xwem-win-selected))) - - ;; Raise frame in which we are embedded. - (when (not (xwem-frame-selected-p clfr)) - (if (xwem-frame-embedded-p clfr) - (xwem-frame-embedded-pop clfr) - (xwem-frame-raise clfr))) - - (when (not (xwem-win-selected-p clw)) - (xwem-window-select clw)) - - (xwem-manda-manage cl clw))) - -(defun xwem-frame-unembedd (frame) +(defun xwem-frame-unembedd (frame &optional new-type) "Unembedd FRAME." (when (xwem-frame-embedded-p frame) - (let* ((cl (xwem-find-client (xwem-frame-xwin frame))) - (ngeom (nthcdr 4 (XTranslateCoordinates (xwem-dpy) (xwem-frame-xwin frame) - (xwem-rootwin) (xwem-frame-x frame) - (xwem-frame-y frame))))) + (let* ((cl (xwem-frame-get-prop frame 'xwem-embedded-cl)) + (tpnt (car (XTranslateCoordinates (xwem-dpy) (xwem-frame-xwin frame) + (xwem-rootwin) (xwem-frame-x frame) + (xwem-frame-y frame))))) ;; Remove clients stuff - (X-Win-EventHandler-rem (xwem-cl-xwin cl) 'xwem-cl-events-handler) - (xwem-cl-hdestroy-notify cl nil) + (xwem-cl-destroy cl) + + ;; Unmark FRAME as embedded + (xwem-cl-rem-prop cl 'xwem-embedded-frame) + (xwem-frame-rem-prop frame 'xwem-embedded-cl) + + ;; Set new frame TYPE + (setf (xwem-frame-type frame) (or new-type 'desktop)) (XReparentWindow (xwem-dpy) (xwem-frame-xwin frame) (xwem-rootwin) - (car ngeom) (cadr ngeom)) - (setf (xwem-frame-embedded-p frame) nil) - (xwem-frame-set-pos frame (car ngeom) (cadr ngeom)) + (X-Point-x tpnt) (X-Point-y tpnt)) + (xwem-frame-set-pos frame (X-Point-x tpnt) (X-Point-y tpnt)) + (xwem-frame-apply-state frame) ))) -;;;###autoload -(defun xwem-frame-select (frame &optional dnr-hooks) - "Set FRAME as selected frame. -If DNR-HOOKS is non-nil, than do not run hooks." - - (let ((ofr (xwem-frame-selected)) - (nfr frame)) - ;; If FRAME is embedded frame we should raise frame in whose - ;; window FRAME is embedded. - (when (xwem-frame-embedded-p frame) - (xwem-frame-embedded-pop frame)) +;;;###xwem-autoload +(defun xwem-select-frame (frame) + "Set FRAME to be selected frame. +Actually all the work done in `xwem-select-window'." + (or (xwem-frame-alive-p frame) + (error 'xwem-error "Selecting dead frame")) + (xwem-select-window (xwem-frame-selwin frame))) + +(defun xwem-frame-autoiconify-on-deselect () + "Maybe iconify FRAME, when deselecting FRAME." + (when (eq xwem-frame-autoiconify-mode 'always) + ;; NOTE: double deffering + (xwem-deffered-funcall 'xwem-frame-unmap (xwem-frame-selected)))) + +(defun xwem-frame-autoiconify-on-select () + "Maybe iconify some frames when selecting FRAME." + (when (eq xwem-frame-autoiconify-mode 'intersect) + (let ((nfr-rect (X-Geom-to-X-Rect (xwem-frame-xgeom (xwem-frame-selected)))) + (frames (xwem-frames-list))) + (while frames + (when (and (not (eq (xwem-frame-selected) (car frames))) + (xwem-frame-mapped-p (car frames)) + (X-Rect-intersect-p nfr-rect (X-Geom-to-X-Rect (xwem-frame-xgeom (car frames))))) + ;; NOTE: double deffering + (xwem-deffered-funcall 'xwem-frame-unmap (car frames))) + (setq frames (cdr frames)))))) - (setq xwem-current-frame frame) - - ;; Now raise and set input focus to FRAME - (xwem-frame-raise nfr) - (xwem-focus-set frame) - - (when (not dnr-hooks) - (run-hook-with-args 'xwem-frame-switch-hook ofr nfr)))) - -(defun xwem-frame-maybe-autoiconify (ofr nfr) - "This function aimed to be used in `xwem-frame-switch-hook'. -According to `xwem-frame-autoiconify-mode' it possible iconfies OFR -frame." - (when (and xwem-frame-autoiconify-mode (not (eq ofr nfr)) - (or (eq xwem-frame-autoiconify-mode 'always) - (and (eq xwem-frame-autoiconify-mode 'intersect) (xwem-frame-p nfr) - (X-Rect-intersect-p (X-Geom-to-X-Rect (xwem-frame-xgeom nfr)) - (X-Geom-to-X-Rect (xwem-frame-xgeom ofr)))))) - (xwem-frame-unmap ofr))) - -(defun xwem-frame-select-defhook (ofr nfr) - "Default hook for `xwem-frame-switch-hook'. -NOT USED." - ;; Here is OFR may be invisible, but we redraw it in case it is - ;; visible. - (X-Dpy-send-excursion (xwem-dpy) - (when (and (xwem-frame-p ofr) - (xwem-frame-alive-p ofr)) - (xwem-frame-redraw ofr)) - - (when (and (xwem-frame-p nfr) - (xwem-frame-alive-p nfr)) - (xwem-frame-redraw nfr)) - )) - -;;;###autoload -(defun xwem-make-frame-1 (&optional embedded-p params props non-select) +;;;###xwem-autoload(autoload 'xwem-make-frame-1 "xwem-frame") +(defun* xwem-make-frame-1 (type &key params props noselect) "Create new frame with optional frame properties PROPS. If EMBEDDED-p is non-nil than create embedded frame. -If NON-SELECT is non-nil then do not select newly created frame to be +If NOSELECT is non-nil then do not select newly created frame to be current." - (let* ((fplist (copy-sequence xwem-frame-defprops)) - (frame (apply 'make-xwem-frame params))) - - (setf (xwem-frame-embedded-p frame) embedded-p) - - ;; setup properties - (while props - (setq fplist (plist-put fplist (car props) (cadr props))) - (setq props (cddr props))) - (setf (xwem-frame-props frame) fplist) + (let* ((fplist (copy-list xwem-frame-default-properties)) + (frame (apply 'make-xwem-frame params)) + fwin parwin) + + (setf (xwem-frame-type frame) type) + (setf (xwem-frame-state frame) 'unmapped) + ;;; Initialise FRAME's geometry (unless (xwem-frame-xgeom frame) (setf (xwem-frame-xgeom frame) (make-X-Geom))) ＠＠ -459,111 +449,92 ＠＠ (X-Geom-height (xwem-minib-xgeom xwem-minibuffer)) 0)))) - ;; We should not process events before frame's window events - ;; handler installed - (setf (xwem-frame-xwin frame) - (XCreateWindow - (xwem-dpy) nil - (xwem-frame-x frame) - (xwem-frame-y frame) - (xwem-frame-width frame) - (xwem-frame-height frame) - (xwem-frame-get-prop frame 'inner-border-width) - nil ;DefaultDepth - nil ;CopyFromParent - nil ;CopyFromParent - (make-X-Attr :override-redirect 0 - :background-pixel (XAllocNamedColor - (xwem-dpy) (XDefaultColormap (xwem-dpy)) - xwem-frame-background) - :border-pixel (XBlackPixel (xwem-dpy)) -:backing-store X-WhenMapped - :cursor xwem-frame-cursor - :event-mask xwem-frame-ev-mask))) - - (let ((fwin (xwem-frame-xwin frame)) - parwin) - (X-Win-put-prop fwin 'xwem-frame frame) - - ;; Setup events handlers - (X-Win-EventHandler-add-new fwin 'xwem-frame-events-handler 200) - (X-Win-EventHandler-add-new fwin 'xwem-ev-reconfig 90 (list X-ConfigureRequest)) - - ;; XXX Setup WM_XXX stuff - (XSetWMProtocols (xwem-dpy) fwin - (list (X-Atom-find-by-name (xwem-dpy) "WM_DELETE_WINDOW"))) - - (XSetWMClass (xwem-dpy) fwin - '("xwem-frame" "xwem-frame")) - (XSetWMName (xwem-dpy) fwin - (format "xwem-frame[%d]" (length xwem-frames-list))) - - ;; Initialize root window - (setq parwin (xwem-win-new (list :frame frame) nil)) - - (setf (xwem-win-x parwin) - (xwem-frame-get-prop frame 'otter-border-width)) - (setf (xwem-win-y parwin) - (+ (xwem-frame-get-prop frame 'title-height) - (xwem-frame-get-prop frame 'otter-border-width))) - (setf (xwem-win-width parwin) - (- (xwem-frame-width frame) - (* 2 (xwem-frame-get-prop frame 'otter-border-width)))) - (setf (xwem-win-height parwin) - (- (xwem-frame-height frame) - (xwem-frame-get-prop frame 'title-height) - (* 2 (xwem-frame-get-prop frame 'otter-border-width)))) - - (setf (xwem-frame-selwin frame) parwin) - (setf (xwem-frame-rootwin frame) parwin) - - ;; Add to the end of frames list - (if xwem-frames-list - (setcdr (last xwem-frames-list) (list frame)) - (setq xwem-frames-list (list frame))) - - ;; Handle as client, i.e. make frame to be embedded - (when embedded-p - (xwem-make-client (xwem-frame-xwin frame))) - - ;; Finally map and maybe select newly created frame - (xwem-frame-map frame) - - ;; TODO: - ;; Actually here we should wait for an Expose event, according to - ;; some standard. -; (unless embedded-p -; ;; Not for embedded frames -; (XIfEvent (xwem-dpy) -; (lambda (xev) -; (and (= (X-Event-type xev) X-Expose) -; (= (X-Win-id (X-Event-win xev)) (X-Win-id fwin)))))) - - ;; Install grabbing - (unless embedded-p - (xwem-kbd-install-grab xwem-global-map fwin)) - - (unless non-select - (xwem-frame-select frame)) + ;;; Initialize FRAME's X window + (setq fwin (XCreateWindow + (xwem-dpy) nil + (xwem-frame-x frame) + (xwem-frame-y frame) + (xwem-frame-width frame) + (xwem-frame-height frame) + 0 ; border width + nil ;DefaultDepth + nil ;CopyFromParent + nil ;CopyFromParent + (make-X-Attr :override-redirect (not (xwem-frame-embedded-p frame)) +:backing-store X-Always +:cursor xwem-frame-cursor +:event-mask xwem-frame-ev-mask))) + (X-Win-put-prop fwin 'xwem-frame frame) + (setf (xwem-frame-xwin frame) fwin) + + ;; Install events handlers + (X-Win-EventHandler-add-new fwin 'xwem-frame-events-handler 150) + (X-Win-EventHandler-add-new fwin 'xwem-ev-reconfig 40 (list X-ConfigureRequest)) + + ;; XXX Setup WM_XXX stuff + (XSetWMProtocols (xwem-dpy) fwin + (list (X-Atom-find-by-name (xwem-dpy) "WM_DELETE_WINDOW") + (X-Atom-find-by-name (xwem-dpy) "WM_TAKE_FOCUS"))) + (XSetWMClass (xwem-dpy) fwin + (list (symbol-name (xwem-frame-type frame)) + "xwem-frame")) + (XSetWMName (xwem-dpy) fwin "xwem-frame") + + ;; Install grabbing + (xwem-kbd-install-grab 'xwem-frame-prefix fwin) + + ;;; Initialise FRAME properties + ;; Adjust frame properties in case FRAME is embedded or dedicated + ;; frame. + (setq fplist (xwem-misc-merge-plists + fplist + (cond ((xwem-frame-embedded-p frame) + xwem-embedded-frame-default-properties) + ((xwem-frame-dedicated-p frame) + xwem-dedicated-frame-defalut-properties)))) + + ;;; Initialize FRAME's root window + (setq parwin (xwem-win-new (list :frame frame) nil)) + (setf (xwem-frame-selwin frame) parwin) + (setf (xwem-frame-rootwin frame) parwin) + + ;; Set FRAME properties + (xwem-frame-set-properties frame (xwem-misc-merge-plists fplist props)) + + ;; Setup rootwin's geometry + (xwem-frame-setup-root-win frame) + + ;; Add to the end of frames list + (setq xwem-frames-list + (append xwem-frames-list (list frame))) + + ;; Handle as client, i.e. make frame to be embedded + (when (xwem-frame-embedded-p frame) + (let ((ecl (xwem-xwin-try-to-manage (xwem-frame-xwin frame)))) + (when (xwem-cl-p ecl) + (xwem-frame-put-prop frame 'xwem-embedded-cl ecl) + (xwem-cl-put-sys-prop ecl 'xwem-embedded-frame frame)))) + + ;; Finally map and maybe select newly created frame + (unless (xwem-frame-property frame 'initially-unmapped) + (xwem-frame-map frame)) - ;; Now draw frames contents. -; (unless embedded-p -; (xwem-frame-draw frame nil)) - ) + (unless noselect + (xwem-select-frame frame)) ;; Now run on-create hooks (run-hook-with-args 'xwem-frame-creation-hook frame) - frame)) (defun xwem-init-frame-at-rect (xrect) "Create frame to fit in XRECT rectangle." (let ((xmrect (make-X-Rect :x 0 :y 0 :width (X-Geom-width (xwem-rootgeom)) - :height - (if (xwem-minib-frame xwem-minibuffer) - (+ (* 2 (frame-property (xwem-minib-frame xwem-minibuffer) 'border-width)) - (frame-pixel-height (xwem-minib-frame xwem-minibuffer))) - 0)))) + :height (if (xwem-minib-xgeom xwem-minibuffer) + (X-Geom-height (xwem-minib-xgeom xwem-minibuffer)) + (+ (* 2 xwem-minibuffer-border-width) + (frame-pixel-height (xwem-minib-frame xwem-minibuffer)) + xwem-minibuffer-outer-border-width + xwem-minibuffer-outer-border-width))))) (when (X-Rect-intersect-p xmrect xrect) ;; Take into account this intersection ＠＠ -571,17 +542,24 ＠＠ (- (X-Rect-height xrect) (X-Rect-height xmrect)))) - (xwem-make-frame-1 nil (list :xgeom (X-Rect-to-X-Geom xrect)) nil t))) + (xwem-make-frame-1 'desktop +:params (list :xgeom (X-Rect-to-X-Geom xrect)) +:noselect t))) (defun xwem-frame-adjust-geom (frame new-rect) "Adjust FRAME geom according to NEW-RECT and xwem-minibuffer geom." (let ((mrect (X-Geom-to-X-Rect (xwem-minib-xgeom xwem-minibuffer))) + (brd (X-Geom-border-width (xwem-minib-xgeom xwem-minibuffer))) ngeom) - - (when (X-Rect-intersect-p new-rect mrect) - (setf (X-Rect-height new-rect) - (- (X-Rect-height new-rect) - (X-Rect-height mrect)))) + (when (eq (xwem-cl-state (xwem-minib-cl xwem-minibuffer)) 'active) + (when brd + (incf (X-Rect-width mrect) (+ brd brd)) + (incf (X-Rect-height mrect) (+ brd brd))) + + (when (X-Rect-intersect-p new-rect mrect) + (setf (X-Rect-height new-rect) + (- (X-Rect-height new-rect) + (X-Rect-height mrect))))) (setq ngeom (X-Rect-to-X-Geom new-rect)) (setf (X-Geom-border-width ngeom) ＠＠ -589,72 +567,85 ＠＠ (setf (xwem-frame-xgeom frame) ngeom))) -;;;###autoload -(defun xwem-init-frames () - "xwem frames initializer." - (xwem-message 'msg "Initializing frames ... wait") - (setq xwem-frames-list nil) - (setq xwem-current-frame nil) - - ;; Create cursor used while pointer is over xwem frame - (setq xwem-frame-cursor (xwem-make-cursor (eval xwem-frame-cursor-shape) - xwem-frame-cursor-foreground-color - xwem-frame-cursor-background-color)) - - ;; Default swich hook - (add-hook 'xwem-frame-switch-hook 'xwem-frame-select-defhook) - ;; Add autoiconifier hook - (add-hook 'xwem-frame-switch-hook 'xwem-frame-maybe-autoiconify) +(defun xwem-frame-default-select-hook () + "Do various default things when frame selected. +To be used in `xwem-frame-select-hook'." + (xwem-frame-autoiconify-on-select) + (xwem-frame-deffered-redraw-inner-border (xwem-frame-selected))) + +(defun xwem-frame-default-deselect-hook () + "Do various default things when frame deselected. +To be used in `xwem-frame-deselect-hook'." + (xwem-frame-autoiconify-on-deselect) + (xwem-frame-deffered-redraw-inner-border (xwem-frame-selected))) + +(defun xwem-frame-create-initial () + "Create initial frames." + (if xwem-frame-dumped-config + ;; Create frames from saved configuration + (xwem-frame-config-restore1) - (unless xwem-frame-omit-init-frame ;; Xinerama stuff - (let ((xin (X-XIneramaQueryScreens (xwem-dpy)))) + (let ((xin (X-XIneramaQueryScreens (xwem-dpy))) + frame frame-old) (if (car xin) - ;; XInerama enabled + ;; XInerama enabled, so construct frames linkage (while (setq xin (cdr xin)) - (xwem-init-frame-at-rect (car xin))) + (setq frame (xwem-init-frame-at-rect (car xin))) + (when frame-old + (xwem-frame-link-insert-after frame-old frame)) + (setq frame-old frame)) - ;; No XInerama + ;; No XInerama, crate just one frame (xwem-init-frame-at-rect (X-Geom-to-X-Rect (xwem-rootgeom))))) ;; Select very first frame - (xwem-frame-select (car xwem-frames-list))) - ) + (xwem-select-frame (car (xwem-frames-list))))) -;;;###autoload -(define-xwem-command xwem-frame-split-horiz (arg &optional frame) - "Split FRAME horizontally. -Prefix argument specifies how many pixels splitted window will be after split." - (xwem-interactive "p") - - (let* ((sp-frame (or frame (xwem-frame-selected)))) - (when (xwem-frame-dedicated-p sp-frame) - (error "Can't split dedicated frame.")) - - (xwem-win-split (xwem-frame-selwin sp-frame) 'horizontal arg) - (xwem-frame-redraw sp-frame) - )) - -;;;###autoload(autoload 'xwem-frame-split-vert "xwem-frame" "" t) -(define-xwem-command xwem-frame-split-vert (arg &optional frame) - "Split FRAME vertically. -Prefix argument specifies how many pixels splitted window will be after split." - (xwem-interactive "p") - - (let* ((sp-frame (or frame (xwem-frame-selected)))) - (when (xwem-frame-dedicated-p sp-frame) - (error "Can't split dedicated frame.")) - (xwem-win-split (xwem-frame-selwin sp-frame) 'vertical arg) - (xwem-frame-redraw sp-frame) - )) - -;;;###autoload(autoload 'xwem-frame-win-enlarge-hor "xwem-frame" "" t) -(define-xwem-command xwem-frame-win-enlarge-hor (n &optional win) - "Enlarge WIN or selected window N pixels horizontaly." - (xwem-interactive "p") - - (xwem-window-enlarge n nil (or win (xwem-win-selected))) - (xwem-frame-draw (xwem-win-frame (or win (xwem-win-selected))) nil)) - -;;;###autoload(autoload 'xwem-frame-win-enlarge-ver "xwem-frame" "" t) -(define-xwem-command xwem-frame-win-enlarge-ver (n &optional win) - "Enlarge WIN or selected window N pixels horizontaly." - (xwem-interactive "p") - - (xwem-window-enlarge n t (or win (xwem-win-selected))) - (xwem-frame-draw (xwem-win-frame (or win (xwem-win-selected))) nil)) + (xwem-frame-total-remove frame))) +(put 'xwem-frame-destroy 'xwem-frame-command t) (defun xwem-frame-goto (n direction &optional frame) "Goto window at DIRECTION on FRAME N times. DIRECTION is one of 'next, 'prev, 'next-vert, ..." (let* ((gframe (or frame (xwem-frame-selected))) (cwin (xwem-frame-selwin gframe))) + + ;; Adjust N and DIRECTION if needed + (when (and (eq direction 'next) + (< n 0)) + (setq n (- n) + direction 'prev)) + (while (> n 0) (cond ((eq direction 'next) (setq cwin (xwem-window-next cwin))) ＠＠ -1330,12 +1225,11 ＠＠ (setq cwin (xwem-window-prev cwin))) ((eq direction 'next-vert) (setq cwin (xwem-window-next-vertical cwin))) - (t (error "Bad DIRECTION in xwem-frame-goto, should be one of 'next or 'prev"))) + (t (error 'xwem-error "Bad DIRECTION in `xwem-frame-goto', should be one of 'next or 'prev"))) (setq n (1- n))) - (xwem-window-select cwin) - (xwem-frame-redraw gframe)) - ) + (xwem-select-window cwin) + )) ;;;###autoload(autoload 'xwem-frame-goto-next "xwem-frame" "" t) (define-xwem-command xwem-frame-goto-next (arg) ＠＠ -1402,7 +1296,7 ＠＠ xoff yoff) (when (xwem-frame-embedded-p frm) - (error "Can't split embedded frame")) + (error 'xwem-error "Can't split embedded frame")) (if vertp (progn ＠＠ -1425,14 +1319,13 ＠＠ (samey (xwem-frame-y frm))) (while (> n 0) (setq nframe - (xwem-make-frame-1 nil - (list :xgeom - (make-X-Geom :x (if vertp samex (+ samex xoff)) - :y (if vertp (+ samey yoff) samey) - :width nwi - :height nhe)) - nil - t)) + (xwem-make-frame-1 (xwem-frame-type frm) + :params (list :xgeom + (make-X-Geom :x (if vertp samex (+ samex xoff)) +:y (if vertp (+ samey yoff) samey) +:width nwi +:height nhe)) +:noselect t)) ;; Now setup linkage (xwem-frame-link-insert-after oframe nframe) (setq oframe nframe) ＠＠ -1448,19 +1341,21 ＠＠ "Make horizontal sbs split N times for selected frame." (xwem-interactive "p") (xwem-frame-sp + + (:X-MotionNotify + ;; Update curr-xrect + (setf (X-Rect-x curr-xrect) + (+ (X-Rect-x curr-xrect) (- (X-Event-xmotion-root-x xev) sx))) + (setq sx (X-Event-xmotion-root-x xev)) + (setf (X-Rect-y curr-xrect) + (+ (X-Rect-y curr-xrect) (- (X-Event-xmotion-root-y xev) sy))) + (setq sy (X-Event-xmotion-root-y xev)) + + (when (or (> (abs (- (X-Rect-x curr-xrect) (X-Rect-x last-xrect))) step) + (> (abs (- (X-Rect-y curr-xrect) (X-Rect-y last-xrect))) step)) + (unless (eq imove-mode 'opaque) + (xwem-misc-outline last-xrect imove-mode)) + + (setf (X-Rect-x last-xrect) (X-Rect-x curr-xrect)) + (setf (X-Rect-y last-xrect) (X-Rect-y curr-xrect)) + (if (eq imove-mode 'opaque) + (xwem-frame-set-pos frame (X-Rect-x last-xrect) (X-Rect-y last-xrect)) + (xwem-misc-outline last-xrect imove-mode)))))) + + (xwem-mouse-ungrab) + (unless (eq imove-mode 'opaque) + (xwem-misc-outline last-xrect imove-mode)) + + ;; Apply changes + (xwem-frame-set-pos frame (X-Rect-x last-xrect) (X-Rect-y last-xrect))) + ;; Dispatch map requests + (mapc 'X-Dpy-event-dispatch pevs))) + ;;;###autoload(autoload 'xwem-frame-imove "xwem-frame" "" t) -(define-xwem-command xwem-frame-imove (&optional step) +(define-xwem-command xwem-frame-imove () "Interactively move FRAME." (xwem-interactive) (unless (or (interactive-p) (= (X-Event-type xwem-last-xevent) X-ButtonPress)) - (error "xwem-frame-imove must be binded to mouse event")) + (error 'xwem-error "`xwem-frame-imove'' must be binded to mouse event")) (let* ((srx (X-Event-xbutton-root-x xwem-last-xevent)) (sry (X-Event-xbutton-root-y xwem-last-xevent)) - (frame (or (xwem-frame-find 'xwin (X-Event-win xwem-last-xevent)) - (xwem-frame-at srx sry))) - (imove-mode (funcall xwem-frame-imoveresize-mode-function frame 'move)) - (last-xrect (X-Geom-to-X-Rect (xwem-frame-xgeom frame))) - (curr-xrect (copy-sequence last-xrect)) - moving done xev) - - (if (not (xwem-frame-p frame)) - (error "Click on non-XWEM frame") + (frame (or (xwem-xwin-frame (X-Event-xbutton-event xwem-last-xevent)) + (xwem-frame-at srx sry)))) - (unless step - (setq step 1)) ; XXX + (unless (xwem-frame-p frame) + (error 'xwem-error "`xwem-frame-imove' on non-frame")) - (xwem-mouse-grab xwem-cursor-move (xwem-frame-xwin frame) - (Xmask-or XM-ButtonRelease XM-ButtonMotion)) - (unwind-protect - (while (not done) - (setq xev (xwem-next-event)) - (X-Event-CASE xev - (:X-ButtonRelease - (setq done t)) - - (:X-MotionNotify - ;; Update curr-xrect - (setf (X-Rect-x curr-xrect) - (+ (X-Rect-x curr-xrect) (- (X-Event-xmotion-root-x xev) srx))) - (setq srx (X-Event-xmotion-root-x xev)) - (setf (X-Rect-y curr-xrect) - (+ (X-Rect-y curr-xrect) (- (X-Event-xmotion-root-y xev) sry))) - (setq sry (X-Event-xmotion-root-y xev)) - - (when (or (> (abs (- (X-Rect-x curr-xrect) (X-Rect-x last-xrect))) step) - (> (abs (- (X-Rect-y curr-xrect) (X-Rect-y last-xrect))) step)) - (if moving - (unless (eq imove-mode 'opaque) - (XGrabServer (xwem-dpy)) - (xwem-misc-outline last-xrect imove-mode)) - (setq moving t)) - - (setf (X-Rect-x last-xrect) (X-Rect-x curr-xrect)) - (setf (X-Rect-y last-xrect) (X-Rect-y curr-xrect)) - (if (eq imove-mode 'opaque) - (xwem-frame-set-pos frame (X-Rect-x last-xrec + +(defun xwem-frame-set-showing-mode (frame prop val) + "Set FRAME's showing mode PROP to VAL." + (xwem-frame-put-prop frame prop val) + (if val + (xwem-frame-enter-showing-mode frame) + (xwem-frame-leave-showing-mode frame))) -;;;###autoload -(defun xwem-frame-make-cl-list (frame) - "Make list of all clients FRAME holds." - (let ((rcls nil)) - (xwem-win-map (lambda (win) - (setq rcls (nconc rcls (xwem-win-make-cl-list win)))) - (xwem-window-next (xwem-frame-selwin frame))) - rcls)) +(define-xwem-frame-property showing-mode + "Frame's showing mode." +:type 'boolean +:set 'xwem-frame-set-showing-mode) (provide 'xwem-frame) Index: lisp/xwem-framei.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-framei.el,v retrieving revision 1.6 diff -u -u -r1.6 xwem-framei.el --- lisp/xwem-framei.el 16 Dec 2004 08:08:07 -0000 1.6 +++ lisp/xwem-framei.el 1 Jan 2005 04:41:12 -0000 ＠＠ -3,9 +3,10 ＠＠ ;; Copyright (C) 2004 by Free Software Foundation, Inc. ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Steve Youngs <steve(a)youngs.au.com> ;; Created: Tue Jan 27 08:01:43 MSK 2004 ;; Keywords: xwem -;; X-CVS: $Id: xwem-framei.el,v 1.6 2004/12/16 08:08:07 youngs Exp $ +;; X-CVS: $Id: xwem-framei.el,v 1.4 2004/12/05 22:37:28 lg Exp $ ;; This file is part of XWEM. ＠＠ -33,15 +34,20 ＠＠ ;; Add something like this to your xwemrc.el to start using frame ;; indicator: ;; -;; (autoload 'xwem-framei-init "xwem-framei") ;; (add-hook 'xwem-after-init-hook 'xwem-framei-init) ;; +;; To use framei dockapp add: + +;; (add-hook 'xwem-after-init-hook 'xwem-framei-dockapp) + ;;; Code: -(require 'xwem-compat) +(require 'xwem-load) +(require 'xwem-frame) (require 'xwem-osd) +;;; Customisation (defgroup xwem-framei nil "*Group to customize xwem frame indicator." :prefix "xwem-framei-" ＠＠ -62,13 +68,16 ＠＠ :type 'number :group 'xwem-framei) -(defcustom xwem-framei-show-frame-name t - "*Non-nil mean show frame name aswell as frame number." -:type 'boolean -:group 'xwem-framei) - -(defface xwem-framei-face - `((t (:foreground "green2" :size 128 :family "helvetica"))) +(define-xwem-face xwem-framei-face + `(((background dark desktop) (:foreground "magenta" :size 34 :family "helvetica")) + ((background desktop light) (:foreground "darkmagenta" :size 34 :family "helvetica")) + ((background dark embedded) (:foreground "magenta" :size 24 :family "helvetica")) + ((background embedded light) (:foreground "darkmagenta" :size 24 :family "helvetica")) + ((background dark embedded-desktop) (:foreground "magenta" :size 24 :family "helvetica")) + ((background embedded-desktop light) (:foreground "darkmagenta" :size 24:family "helvetica")) + ((background dark dedicated) (:foreground "magenta" :size 20 :family "fixed")) + ((background dedicated light) (:foreground "darkmagenta" :size 20 :family "fixed")) + (t (:foreground "green2" :size 24 :family "helvetica"))) "*Face used to draw frame number." :group 'xwem-framei) ＠＠ -86,6 +95,37 ＠＠ :type 'function :group 'xwem-framei) +(defcustom xwem-framei-format-function 'xwem-framei-default-format + "Function passed with one arg - frame, should return string to display." +:type 'funtion +:group 'xwem-framei) + +(define-xwem-face xwem-framei-dockapp-face + `(((desktop) (:foreground "magenta4" :bold t)) + ((embedded-desktop) (:foreground "magenta4")) + ((dedicated) (:foreground "yellowgreen")) + (t (:foreground "magenta4" :bold t))) + "Face used to draw in framei dockapp." +:group 'xwem-faces) + +(defcustom xwem-framei-dockapp-format-function 'xwem-framei-dockapp-default-format + "Function passed with one arg - frame, should return string to display." +:type 'funtion +:group 'xwem-framei) + +;;; Internal variables + +(defun xwem-framei-default-format (frame) + "Default function used in `xwem-framei-format-function'. +Return string in form \"NUM: NAME\"" + (case (xwem-frame-type frame) + (when (xwem-osd-p xwem-framei-dockapp-osd) - (xwem-osd-destroy xwem-framei-dockapp-osd)) - ) + (xwem-osd-destroy xwem-framei-dockapp-osd))) -;; commands -(define-xwem-command xwem-framei-dockapp-frames-menu () +;;;###autoload +(defun xwem-framei-dockapp (&optional dockid dockgroup dockalign) + "Start frame indicator dockapp." + (unless (xwem-osd-p xwem-framei-dockapp-osd) + (let ((width (* (face-width 'xwem-framei-dockapp-face) 8)) + (height (face-height 'xwem-framei-dockapp-face))) + + (setq xwem-framei-dockapp-osd + (xwem-osd-create-dock (xwem-dpy) width height + (list 'keymap xwem-framei-dockapp-keymap))) + + ;; Try to display current frame + (xwem-framei-dockapp-update) + + ;; Add frame hooks + (add-hook 'xwem-frame-select-hook 'xwem-framei-dockapp-update) + (add-hook 'xwem-frame-change-hook 'xwem-framei-dockapp-update)))) + +;; Commands +;;;###autoload(autoload 'xwem-framei-dockapp-popup-menu "xwem-framei" nil t) +(define-xwem-command xwem-framei-dockapp-popup-menu () "Popup frames menu." (xwem-interactive) - (xwem-popup-menu (list "XWEM Frames" :filter - (lambda (not-used) - (mapcar (lambda (el) - (let ((fn (xwem-frame-num el))) - (vector - (concat "Frame " (int-to-string fn) ": " (xwem-frame-name el)) - `(xwem-frame-switch-nth ,fn)))) - xwem-frames-list)))) - ) + (xwem-popup-menu + (list "XWEM Frames" :filter + (lambda (not-used) + (nconc + (mapcar (lambda (frame) + (vector + (case (xwem-frame-type frame) + (dedicated + (if (xwem-frame-cl frame) + (format "D[%d]: %s" (xwem-frame-num frame) + (xwem-client-name (xwem-frame-cl frame))) + (format "D[%d]: <none>" (xwem-frame-num frame)))) + (t (format "%s %d: %s" + (capitalize (symbol-name (xwem-frame-type frame))) + (xwem-frame-num frame) (xwem-frame-name frame)))) + `(xwem-select-frame ,frame))) + xwem-frames-list) + (list "---" + (vector "Destroy" 'xwem-framei-stop-dockapp))))))) + +;;;###autoload(autoload 'xwem-framei-dockapp-popup-alt-menu "xwem-framei" nil t) +(define-xwem-command xwem-framei-dockapp-popup-alt-menu () + "Popup alternative menu." + (xwem-interactive) + + (xwem-popup-menu + (nconc '("XWEM Frames") + (mapcar (lambda (type) + (nconc (list (capitalize (symbol-name type))) + (mapcar (lambda (frame) + (vector + (format "%d: %s" + (xwem-frame-num frame) + (case (xwem-frame-type frame) + (dedicated + (if (xwem-frame-cl frame) + (xwem-client-name (xwem-frame-cl frame)) + "<none>")) + (t (xwem-frame-name frame)))) + `(xwem-select-frame ,frame))) + (xwem-frames-list type)))) + xwem-frame-types) + '("---" ["Destroy" xwem-framei-stop-dockapp])))) (provide 'xwem-framei) Index: lisp/xwem-frametrans.el =================================================================== RCS file: lisp/xwem-frametrans.el diff -N lisp/xwem-frametrans.el --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ lisp/xwem-frametrans.el +(require 'xwem-load) +(require 'xwem-misc) + (defface xwem-gamma-face `((t (:foreground "#1a1a1a" :background "black"))) "Face used to adjust gamma.") ＠＠ -60,6 +64,7 ＠＠ (gg (+ 0.1 (* k (cadr clist)))) (bg (+ 0.1 (* k (caddr clist))))) (X-XF86VidModeSetGamma xwem-gamma-display rg gg bg xwem-gamma-screen) + (XFlush xwem-gamma-display) (xwem-message 'nolog "New gamma: r=%f g=%f b=%f" rg gg bg))) (defun xwem-gamma-widget (xdpy &optional screen-num) Index: lisp/xwem-help.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-help.el,v retrieving revision 1.6 diff -u -u -r1.6 xwem-help.el --- lisp/xwem-help.el 16 Dec 2004 08:08:07 -0000 1.6 +++ lisp/xwem-help.el 1 Jan 2005 04:41:12 -0000 ＠＠ -5,7 +5,7 ＠＠ ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> ;; Created: 1 Sep 2003 ;; Keywords: xlib, xwem -;; X-CVS: $Id: xwem-help.el,v 1.6 2004/12/16 08:08:07 youngs Exp $ +;; X-CVS: $Id: xwem-help.el,v 1.5 2004/12/05 22:37:34 lg Exp $ ;; This file is part of XWEM. ＠＠ -32,8 +32,21 ＠＠ ;;; Code: +(require 'xwem-load) +(require 'xwem-misc) + +(defmacro xwem-help-display (title &rest forms) + "Evaluate FORMS in special emacs frame and xwem help buffer." + `(let ((temp-buffer-show-function 'xwem-special-popup-frame)) + (with-displaying-help-buffer + (lambda () + (set-buffer standard-output) + ,＠forms) + (format "xwem %s" (or ,title ""))))) +(put 'xwem-help-display 'lisp-indent-function 'defun) + ;;; Some help stuff -;;;###autoload +;;;###xwem-autoload (defun xwem-logo-string () "Return textified XWEM's logo string." (concat (xwem-str-with-faces "X" (list 'bold-italic)) ＠＠ -46,128 +59,157 ＠＠ "Display some help info." (xwem-interactive) - (xwem-help-display - (progn - (insert "Hello, this is help for ") - (insert (xwem-logo-string)) - (insert "\n\n")) - (progn - (insert "TODO: here is some description for ") - (insert (xwem-logo-string)) - (insert " stuff.\n")) - (insert "\n") - ;; Frames config - (progn - (insert "---=== Frames Info ===---\n\n") - (insert (format "You have %d frames now and [%d] frame is selected.\n" - (length xwem-frames-list) (xwem-frame-num (xwem-frame-selected)))) - (insert "\n")) - - ;; Clients - ;; Maybe use tree-widget package to display this info? - (let ((curr-classn "") - (curr-classi "")) - (insert "---=== Clients Info ===---\n") - (mapc - (lambda (el) - (let ((clclass (xwem-hints-wm-class (xwem-cl-hints el))) - (clgeom (xwem-cl-xgeom el))) - (when (not (string= curr-classn (cadr clclass))) - (setq curr-classn (cadr clclass)) - (insert (format "\n= Begin for class name: <%s> =\n" curr-classn))) - (when (not (string= curr-classi (car clclass))) - (setq curr-classi (car clclass)) - (insert (format "\n- Class instance: <%s> -\n" curr-classi))) - (insert (format "WM-NAME: <%s>, Geom: %dx%d+%d+%d\n" - (xwem-hints-wm-name (xwem-cl-hints el)) - (X-Geom-width clgeom) - (X-Geom-height clgeom) - (X-Geom-x clgeom) - (X-Geom-y clgeom))))) - (sort (copy-list xwem-clients) - (lambda (el1 el2) (let ((cl1-clas (xwem-hints-wm-class (xwem-cl-hints el1))) - (cl1-name (xwem-hints-wm-name (xwem-cl-hints el1))) - (cl2-clas (xwem-hints-wm-class (xwem-cl-hints el2))) - (cl2-name (xwem-hints-wm-name (xwem-cl-hints el2)))) - ;; Sort by class name, than by class - ;; instance, than by wm-name. - (or (string-lessp (cadr cl1-clas) (cadr cl2-clas)) - (and (string= (cadr cl1-clas) (cadr cl2-clas)) - (string-lessp (car cl1-clas) (car cl2-clas))) - (and (string= (car cl1-clas) (car cl2-clas)) - (string-lessp cl1-name cl2-name)))))) - ) - (insert "\n")) - - (progn - (insert "---=== Bindings for `") - (insert (xwem-str-with-faces "xwem-global-map" 'font-lock-keyword-face)) - (insert "' ===---\n")) - (des + (xwem-message 'todo "`xwem-help-clients' is not written yet.") ) ;;;###autoload(autoload 'xwem-help-where-is "xwem-help" "" t) Index: lisp/xwem-holer.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-holer.el,v retrieving revision 1.5 diff -u -u -r1.5 xwem-holer.el --- lisp/xwem-holer.el 16 Dec 2004 08:08:07 -0000 1.5 +++ lisp/xwem-holer.el 1 Jan 2005 04:41:12 -0000 ＠＠ -5,7 +5,7 ＠＠ ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> ;; Created: Thu Jan 15 12:39:04 MSK 2004 ;; Keywords: xwem -;; X-CVS: $Id: xwem-holer.el,v 1.5 2004/12/16 08:08:07 youngs Exp $ +;; X-CVS: $Id: xwem-holer.el,v 1.2 2004/12/05 05:52:34 youngs Exp $ ;; This file is part of XWEM. ＠＠ -33,21 +33,21 ＠＠ ;; ;; Add something following to your ~/.xwem/xwemrc.el to start using ;; holer: - -;; ;; Making holes in frames -;; (require 'xwem-holer) +;; ;; (define-key xwem-global-map (xwem-kbd "H-x h") 'xwem-holer-prefix) +;; +;; Note: in xwem2.0-rc2 binded by default to `H-x h' ;;; BUGS: ;; -;; - You can create/manipulate holes only on selected frame. +;; - You can create/manipulate holes only on selected frame. ;;; Code: -(require 'xlib-xshape) -(eval-when-compile - (require 'xlib-xlib) - (require 'xwem-misc)) +(require 'xlib-xshape) + +(require 'xwem-load) +(require 'xwem-compat) (defgroup xwem-holer nil "Group to customize xwem holer." ＠＠ -61,7 +61,7 ＠＠ (defcustom xwem-holer-outline-color "blue2" "*Color of holer outliner." -:type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) +:type 'color :group 'xwem-holer) (defcustom xwem-holer-move-cursor-shape 'X-XC-fleur ＠＠ -71,22 +71,22 ＠＠ (defcustom xwem-holer-move-cursor-foreground "#0000AA" "*Cursor's foreground when moving holer." -:type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) +:type 'color :group 'xwem-holer) (defcustom xwem-holer-move-cursor-background "#000088" "*Cursor's background when moving holer." -:type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) +:type 'color :group 'xwem-holer) (defcustom xwem-holer-resize-cursor-foreground "#0000AA" "*Cursor's foreground when resizing holer." -:type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) +:type 'color :group 'xwem-holer) (defcustom xwem-holer-resize-cursor-background "#000088" "*Cursor's background when resizing holer." -:type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) +:type 'color :group 'xwem-holer) (defcustom xwem-holer-min-pixels 10 ＠＠ -95,8 +95,11 ＠＠ :type 'number :group 'xwem-holer) +;;; Internal variables + ;;; Define holer prefix map +;;;###autoload(autoload 'xwem-holer-prefix "xwem-holer" nil nil 'keymap) (xwem-define-prefix-command 'xwem-holer-prefix t) (defvar xwem-holer-map (symbol-function 'xwem-holer-prefix) "Keymap for holer (\\<xwem-global-map>\\[xwem-holer-prefix]) commands. ＠＠ -400,21 +403,19 ＠＠ (when (= (X-Event-type xev) X-ButtonPress) (let* ((xdpy (X-Event-dpy xev)) (frame (xwem-holer-find-frame xev)) - (xt (and (xwem-frame-p frame) - (XTranslateCoordinates xdpy (XDefaultRootWindow xdpy) - (xwem-frame-xwin frame) - (X-Event-xbutton-root-x xev) - (X-Event-xbutton-root-y xev)))) - (chw (nth 3 xt)) + (chw (and (xwem-frame-p frame) + (cdr (XTranslateCoordinates xdpy (XDefaultRootWindow xdpy) + (xwem-frame-xwin frame) + (X-Event-xbutton-root-x xev) + (X-Event-xbutton-root-y xev))))) (hl (and (X-Win-p chw) (X-Win-get-prop chw 'xwem-holer)))) (when (xwem-holer-p hl) - (let ((hlxt (XTranslateCoordinates - xdpy (XDefaultRootWindow xdpy) - (xwem-holer-outliner-win hl) - (X-Event-xbutton-root-x xev) (X-Event-xbutton-root-y xev)))) - (setf (xwem-holer-click-xoff hl) (nth 4 hlxt)) - (setf (xwem-holer-click-yoff hl) (nth 5 hlxt)) - + (let ((tpnt (car (XTranslateCoordinates + xdpy (XDefaultRootWindow xdpy) + (xwem-holer-outliner-win hl) + (X-Event-xbutton-root-x xev) (X-Event-xbutton-root-y xev))))) + (setf (xwem-holer-click-xoff hl) (X-Point-x tpnt)) + (setf (xwem-holer-click-yoff hl) (X-Point-y tpnt)) hl))))) (define-xwem-command xwem-holer-imove () ＠＠ -487,6 +488,8 ＠＠ (truncate (Xmask-or XM-ButtonPress XM-ButtonRelease XM-ButtonMotion)) cursor) (X-Win-EventHandler-add-new (xwem-holer-outliner-win hl) 'xwem-holer-event-handler) + (while (xwem-holer-mode hl) + (dispatch-event (next-event))) )))) (define-xwem-command xwem-holer-idestroy () Index: lisp/xwem-icons.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-icons.el,v retrieving revision 1.8 diff -u -u -r1.8 xwem-icons.el --- lisp/xwem-icons.el 16 Dec 2004 08:08:08 -0000 1.8 +++ lisp/xwem-icons.el 1 Jan 2005 04:41:12 -0000 ＠＠ -3,9 +3,10 ＠＠ ;; Copyright (C) 2003 by Free Software Foundation, Inc. ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Steve Youngs <steve(a)youngs.au.com> ;; Created: Sat Dec 27 15:38:24 MSK 2003 ;; Keywords: xwem -;; X-CVS: $Id: xwem-icons.el,v 1.8 2004/12/16 08:08:08 youngs Exp $ +;; X-CVS: $Id: xwem-icons.el,v 1.7 2004/12/05 22:37:34 lg Exp $ ;; This file is part of XWEM. ＠＠ -30,93 +31,246 ＠＠ ;; Icons support. -;;; Code: +;; Supports client properties: + +;; `xwem-tab-face' - Face to draw tabber item (overrides `xwem-tabber-face' +;; `xwem-icon-name' - Name of icon to use (overrides `xwem-icons-alist') -(eval-when-compile - (require 'xlib-xlib)) +;;; Code: + (require 'xlib-xpm) -(defvar xwem-icons-dir (locate-data-directory "xwem") - "Directory where icons for use by XWEM lies.") +(require 'xwem-load) -(defvar xwem-icons-list nil - "List of already loaded icons.") +;;;###autoload +(defcustom xwem-icons-dir (locate-data-directory "xwem") + "Directory where icons for use by XWEM lies." +:type 'directory +:group 'xwem) ;;;###autoload -(defvar xwem-icons-alist - ;; [ wm-name wm-class-name wm-class-instance ] . icon-name - '(([".*" ".term" ".Term"] . "mini-term.xpm") - ([".*" "xclock" "XClock"] . "mini-clock.xpm") - ([".*" "xload" "XLoad"] . "mini-measure.xpm") - ([".*" "xcalc" "XCalc"] . "mini-calc.xpm") - - ([".*" "xkeycaps" "XKeyCaps"] . "mini-xkeycaps.xpm") - ([".*" "xdvi" "XDvi"] . "mini-xdvi.xpm") - ([".*" "xv" "XV.*"] . "mini-xv.xpm") - ([".*" ".*" "AcroRead"] . "mini-acroread.xpm") - ([".*" ".*" "Xpdf"] . "mini-acroread.xpm") - ([".*" ".*" "Xman"] . "mini-info.xpm") - - ([".*" "Mozilla" ".*"] . "mini-mozilla.xpm") - ([".*" "gv" "GV"] . "mini-gv.xpm") - ([".*" "ghostview" "Ghostview"] . "mini-gv.xpm") - ([".*" "xfig" "Fig"] . "mini-xfig.xpm") - ([".*" "ethereal" "Ethereal"] . "mini-ethereal.xpm") - ([".*" "xfd" "Xfd"] . "mini-font.xpm") - ([".*" "xfontsel" "XFontSel"] . "mini-font.xpm") - ([".*" "xconsole" "XConsole"] . "mini-sh1.xpm") - ([".*" "xcolors" "Xcolors"] . "mini-colors.xpm") - ([".*" ".*" "X-Chat"] . "mini-xchat.xpm") - - ;; Match by WM_NAME since WM_CLASS is not setuped - (["Lupe" ".*" ".*"] . "mini-zoom.xpm") - (["xcmap" "" ".*"] . "mini-colors.xpm") - +(defcustom xwem-icons-list + '(("mini-display.xpm" (class-inst "^Terminal$") (class-name "^Terminal$")) + ("mini-clock.xpm" (application "xclock")) + ("mini-measure.xpm" (application "xload")) + ("mini-calc.xpm" + (or (buffer-major-mode calc-mode) + (class-name "[cC]alc"))) + + ("mini-xkeycaps.xpm" (application "xkeycaps")) + ("mini-xv.xpm" (application "xv")) + ("mini-imagemagic.xpm" (application "display")) + + ("mini-xdvi.xpm" (class-inst "^xdvi$") (class-name "^XDvi$")) + ("mini-acroread.xpm" (class-name "^AcroRead\\|Xpdf$")) + ("min + (pm (and (nth 3 kw) (make-X-Pixmap :dpy (xwem-dpy) :id (nth 3 kw)))) + (gg nil)) + (if (not (and pp pm)) + (xwem-cl-put-sys-prop cl 'kwm-win-icon 'no-kwm-win-icon) + + (setq gg (XGetGeometry (xwem-dpy) pp)) + (setf (X-Pixmap-width pp) (X-Geom-width gg)) + (setf (X-Pixmap-height pp) (X-Geom-height gg)) + + (setq gg (XGetGeometry (xwem-dpy) pm)) + (setf (X-Pixmap-width pm) (X-Geom-width gg)) + (setf (X-Pixmap-height pm) (X-Geom-height gg)) + + (xwem-cl-put-sys-prop cl 'kwm-win-icon (setq gg (cons pp pm)))) + gg)) + (t kwi)))) + +;;;###xwem-autoload +(defun xwem-icons-cl-icon (cl &optional tag-set) + "Get X-Image of CL's icon. +Return cons cell where car is X-Pixmap of icon and cdr is X-Pixmap +where mask for icon is stored. + +TAG-SET specifies environment list for which icon is created." + (or (xwem-icons-cl-kwm-win-icon cl tag-set) + (xwem-icons-cl-buildin-icon cl tag-set))) (provide 'xwem-icons) Index: lisp/xwem-interactive.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-interactive.el,v retrieving revision 1.11 diff -u -u -r1.11 xwem-interactive.el --- lisp/xwem-interactive.el 16 Dec 2004 08:08:08 -0000 1.11 +++ lisp/xwem-interactive.el 1 Jan 2005 04:41:13 -0000 ＠＠ -3,9 +3,10 ＠＠ ;; Copyright (C) 2003 by Free Software Foundation, Inc. ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Steve Youngs <steve(a)youngs.au.com> ;; Created: Thu Dec 18 05:49:52 MSK 2003 ;; Keywords: xwem, xlib -;; X-CVS: $Id: xwem-interactive.el,v 1.11 2004/12/16 08:08:08 youngs Exp $ +;; X-CVS: $Id: xwem-interactive.el,v 1.10 2004/12/05 22:37:34 lg Exp $ ;; This file is part of XWEM. ＠＠ -35,126 +36,183 ＠＠ (eval-when-compile ;; Shutup compiler (defvar iswitchb-buflist nil) - (autoload 'iswitchb-read-buffer "iswitchb")) + (autoload 'iswitchb-read-buffer "iswitchb") + ) + +(require 'xlib-xlib) + +(require 'xwem-struct) +(require 'xwem-loaddefs) + + +(defcustom xwem-completing-read-type 'iswitchb + "*Type of interactive client reading. +Possible values are `iswitchb', requires iswitchb package, or +`complete' uses standard `completing-read'." +:type '(choice (const :tag "Iswitchb" iswitchb) + (const :tag "Standard" complete)) +:group 'xwem-misc) + +;;; Internal variables -;;;###autoload (defvar xwem-interactively nil "Non-nil when xwem in interactive mode. -Internal variable, do not modify.") +Internal variabel, do not modify.") + +;; Save read-from-minibuffer for further use +(eval-and-compile + (define-function 'read-from-minibuffer-for-xwem + (symbol-function 'read-from-minibuffer))) + +(defmacro xwem-interactive (&rest ispec) + "Just like `interactive', but accepts xwem specific arguments. +Code letters available are: +s -- String. +k -- Single key. +K -- Key sequence that executes command. +c -- Client. +f -- Existing file. +F -- Possible non-existing file. +p -- Prefix argument as number. +P -- Prefix argument in raw form. +C -- Command. +e -- External command." + (let ((is (cond ((and (= (length ispec) 1) + (stringp (car ispec))) + (setq ispec (car ispec)) + (split-string ispec "\n")) + + (t ispec)))) + + (if (not (stringp ispec)) + `(interactive (let ((xwem-interactively t)) + (prog1 (progn ,＠ispec) + (setq xwem-prefix-arg nil)))) + + `(interactive (prog1 (xwem-interactive-ilist (quote ,is)) + (setq xwem-prefix-arg nil)))) + )) -(defalias 'read-from-minibuffer-for-xwem (symbol-function 'read-from-minibuffer)) +(defmacro define-xwem-command (funsym args docstring inter &rest body) + "Same as `xwem-defun', but make FUNSYM to be interactive command. +INTER is actually a for of `xwem-interactive'." + `(defun ,funsym ,args + ,docstring + ,(macroexpand inter) + ;; Maybe run command without GCing (xwem-kbd-wait-key-release (X-Event-xkey-keycode xwem-last-xevent))) ;; Remove ?* from first element in SPEC ＠＠ -198,6 +257,7 ＠＠ ((eq code ?e) (xwem-read-external-command prompt)) ))) spec))) + (provide 'xwem-interactive) Index: lisp/xwem-keyboard.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-keyboard.el,v retrieving revision 1.14 diff -u -u -r1.14 xwem-keyboard.el --- lisp/xwem-keyboard.el 16 Dec 2004 08:08:08 -0000 1.14 +++ lisp/xwem-keyboard.el 1 Jan 2005 04:41:13 -0000 ＠＠ -3,10 +3,11 ＠＠ ;; Copyright (C) 2003 by Free Software Foundation, Inc. ;; Authors: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Steve Youngs <steve(a)youngs.au.com> ;; Alex Ott <ottalex(a)narod.ru> ;; Created: 21 Mar 2003 ;; Keywords: xwem, xlib -;; X-CVS: $Id: xwem-keyboard.el,v 1.14 2004/12/16 08:08:08 youngs Exp $ +;; X-CVS: $Id: xwem-keyboard.el,v 1.13 2004/12/08 08:30:55 youngs Exp $ ;; This file is part of XWEM. ＠＠ -36,11 +37,12 ＠＠ ;;; Code: - -(eval-when-compile - (require 'xwem-clients)) +(require 'xlib-xlib) (require 'xlib-xtest) -(require 'xwem-compat) +(require 'xlib-keysymdb) + +(require 'xwem-load) +(require 'xwem-misc) ;;{{{ [-] Custamizable xwem-keyboard group ＠＠ -50,6 +52,7 ＠＠ :prefix "xwem-" :group 'xwem) +;;;###autoload (defcustom xwem-pre-command-hook nil "*Hooks to run just before executing command. This may examine `xwem-this-command' variable to find out which ＠＠ -59,15 +62,17 ＠＠ :group 'xwem-keyboard :group 'xwem-hooks) +;;;###autoload (defcustom xwem-post-command-hook nil "*Hooks to run after command execution." :type 'hook :group 'xwem-keyboard :group 'xwem-hooks) -(defcustom xwem-keyboard-echo-keystrokes t - "*If non-nil than echo unfinished commands in echo area." -:type 'boolean +;;;###autoload +(defcustom xwem-keyboard-echo-keystrokes 1 + "*If non-nil than echo unfinished commands in echo area after this many seconds of pause." +:type 'number :group 'xwem-keyboard) (defcustom xwem-hyper-modifier 'hyper ＠＠ -75,7 +80,8 ＠＠ :type '(choice (const :tag "Meta" meta) (const :tag "Control" control) (const :tag "Super" super) - (const :tag "Hyper" hyper)) + (const :tag "Hyper" hyper) + (const :tag "Alt" alt)) :group 'xwem-keyboard) (defcustom xwem-meta-modifier 'meta ＠＠ -83,7 +89,8 ＠＠ :type '(choice (const :tag "Meta" meta) (const :tag "Control" control) (const :tag "Super" super) - (const :tag "Hyper" hyper)) + (const :tag "Hyper" hyper) + (const :tag "Alt" alt)) :group 'xwem-keyboard) (defcustom xwem-control-modifier 'control ＠＠ -91,7 +98,8 ＠＠ :type '(choice (const :tag "Meta" meta) (const :tag "Control" control) (const :tag "Super" super) - (const :tag "Hyper" hyper)) + (const :tag "Hyper" hyper) + (const :tag "Alt" alt)) :group 'xwem-keyboard) (defcustom xwem-kbd-evillocks (list XK-NumLock XK-Caps-Lock) ＠＠ -106,31 +114,37 ＠＠ "List of evil masks. Internal variable, DO NOT MODIFY.") +;;;###autoload (defcustom xwem-quit-key [(hyper ?g)] "Quit command key." :type 'sexp :group 'xwem-keyboard) +;;;###autoload (defcustom xwem-quit-command 'xwem-keyboard-quit "Default command to be called when `xwem-quit-key' pressed." :type 'function :group 'xwem-keyboard) +;;;###autoload (defcustom xwem-help-key [(hyper ?h)] "Help command key." :type 'sexp :group 'xwem-keyboard) +;;;###autoload (defcustom xwem-prefix-help-command 'xwem-describe-prefix-bindings "Default command to be called when `xwem-help-key' pressed." :type 'function :group 'xwem-keys) +;;;###autoload (defcustom xwem-universal-key [(hyper ?u)] "Key for universal argument commands." :type 'sexp :group 'xwem-keyboard) +;;;###autoload (defcustom xwem-kbd-quit-hook nil "*Hooks to be runned when KBD exits. Runned only on \\<xwem-global-map>\\[xwem-kbd-quit], but not on ＠＠ -139,23 +153,33 + ;; Create new local keymap for client if needed + (unless (keymapp (xwem-local-map cl)) + (setf (xwem-local-map cl) (make-sparse-keymap))) + + (xwem-define-key (xwem-cl-xwin cl) (xwem-local-map cl) key command pgrab-mode kgrab-mode)) + +;;;###xwem-autoload +(defun xwem-use-local-map (keymap &optional cl) + "Select KEYMAP as local CL's keymap." + (unless cl + (setq cl (xwem-cl-selected))) + + (setf (xwem-local-map cl) keymap)) ;;}}} ＠＠ -349,23 +406,20 ＠＠ (define-xwem-command xwem-undefined-command () "Called when key is not binded." (xwem-interactive) - (xwem-message 'warn "Command undefined for key %S." xwem-last-event)) + (signal 'undefined-keystroke-sequence xwem-this-command-keys)) ;;;###autoload(autoload 'xwem-self-insert-or-undefined "xwem-keyboard" "" t) (define-xwem-command xwem-self-insert-or-undefined (arg) "Self insert or undefined command. Prefix ARG specifies how many characters to insert." - (xwem-interactive "*_p") - - (let ((lev xwem-last-event)) - ;; TODO: - ;; * Check is LEV is actually self insertable event - (if arg - (xwem-key-send-ekeys (make-vector arg lev)) - - (xwem-message 'warn "%s is not defined, prefix arg is %S." - (key-description xwem-this-command-keys) arg) - ))) + (xwem-interactive "*_P") + + (if (= (length xwem-this-command-keys) 1) + ;; Self insert command allowed only for normal clients + (unless (xwem-dummy-client-p (xwem-cl-selected)) + (xwem-key-send-ekeys + (make-vector (prefix-numeric-value arg) xwem-last-event))) + (error 'xwem-error (format "%s is undefined" (key-description xwem-this-command-keys))))) ;;}}} ＠＠ -376,8 +430,11 ＠＠ "Send quit signal." (xwem-interactive) + (setq xwem-override-map nil) (signal 'quit '(xwem)) - (xwem-message 'info "quit.")) + + ;; NOT REACHED + (xwem-message 'error "quit.")) ;;;###autoload(autoload 'xwem-kbd-quit "xwem-keyboard" "" t) (define-xwem-command xwem-kbd-quit () ＠＠ -387,85 +444,9 ＠＠ (xwem-kbd-stop-grabbing) (setq xwem-kbd-private-prefix-map nil) (XSetInputFocus (xwem-dpy) X-PointerRoot X-RevertToPointerRoot X-CurrentTime) - (xwem-message 'note "[kbd-quit] InputFocus is PonterRoot, prfxmap is nil.") + (xwem-message 'note "[kbd-quit] InputFocus set PointerRoot") - (run-hooks 'xwem-kbd-quit-hook) - ) - -;;}}} - -;;{{{ [-] Initializators - -(defun xwem-kbd-initialize-private-modifiers () - "Create internal modifier representation to speedup futher work. -Also update `xwem-kbd-evilmasks' if `xwem-kbd-evillocks' is non-nil." - (setq xwem-kbd-private-modifiers (make-vector 7 nil)) - (let* ((ctrls (list (car (xwem-kbd-xksym->xkcode XK-Control-L)) - (car (xwem-kbd-xksym->xkcode XK-Control-R)))) - (locks (list (car (xwem-kbd-xksym->xkcode XK-Caps-Lock)))) - (shifts (list (car (xwem-kbd-xksym->xkcode XK-Shift-L)) - (car (xwem-kbd-xksym->xkcode XK-Shift-R)))) - (metas (list (car (xwem-kbd-xksym->xkcode XK-Meta-L)) - (car (xwem-kbd-xksym->xkcode XK-Meta-R)))) - (hypers (list (car (xwem-kbd-xksym->xkcode XK-Hyper-L)) - (car (xwem-kbd-xksym->xkcode XK-Hyper-R)))) - (supers (list (car (xwem-kbd-xksym->xkcode XK-Super-L)) - (car (xwem-kbd-xksym->xkcode XK-Super-R)))) - (numlocks (list (car (xwem-kbd-xksym->xkcode XK-NumLock)))) - (evils (mapcar (lambda (ks) - (car (xwem-kbd-xksym->xkcode ks))) xwem-kbd-evillocks)) - (mlist (mapcar 'truncate (list X-Shift X-Lock X-Control X-Mod1 X-Mod2 - X-Mod3 X-Mod4 X-Mod5))) - (slist (car (last xwem-xmods-mapping)))) - - (while slist - ;; Update some private modifier mask - (when (intersection (car slist) shifts) - (aset xwem-kbd-private-modifiers 0 (cons (car mlist) (aref xwem-kbd-private-modifiers 0)))) - (when (intersection (car slist) locks) - (aset xwem-kbd-private-modifiers 1 (cons (car mlist) (aref xwem-kbd-private-modifiers 1)))) - (when (intersection (car slist) ctrls) - (aset xwem-kbd-private-modifiers 2 (cons (car mlist) (aref xwem-kbd-private-modifiers 2)))) - (when (intersection (car slist) metas) - (aset xwem-kbd-private-modifiers 3 (cons (car mlist) (aref xwem-kbd-private-modifiers 3)))) - (when (intersection (car slist) hypers) - (aset xwem-kbd-private-modifiers 4 (cons (car mlist) (aref xwem-kbd-private-modifiers 4)))) - (when (intersection (car slist) supers) - (aset xwem-kbd-private-modifiers 5 (cons (car mlist) (aref xwem-kbd-private-modifiers 5)))) - (when (intersection (car slist) numlocks) - (aset xwem-kbd-private-modifiers 6 (cons (car mlist) (aref xwem-kbd-private-modifiers 6)))) - - ;; Update Evil locks - (when (intersection (car slist) evils) - (push (car mlist) xwem-kbd-evilmasks)) - - (setq slist (cdr slist)) - (setq mlist (cdr mlist))))) - -;;;###autoload -(defun xwem-kbd-init () - "Init part for keys. -Fetches KeyboardMapping from the X server and stores it in -`xwem-xkeys-mapping'" - (xwem-message 'msg "Initializing keyboard ... wait") - (xwem-kbd-set-current-prefix-keymap nil) - - ;; Hmm FSFmacs issued "invalid instraction" in `XGetKeyboardMapping' - (setq xwem-xkeys-mapping - (XGetKeyboardMapping (xwem-dpy) - (X-Dpy-min-keycode (xwem-dpy)) - (- (X-Dpy-max-keycode (xwem-dpy)) - (X-Dpy-min-keycode (xwem-dpy))))) - - (setq xwem-xmods-mapping - (XGetModifierMapping (xwem-dpy))) - - ;; Initialize `xwem-kbd-private-modifiers' - (xwem-kbd-initialize-private-modifiers) - - ;; Initialize keyboard macrosing - (xwem-keymacro-init) - ) + (run-hooks 'xwem-kbd-quit-hook)) ;;}}} ＠＠ -502,6 +483,9 ＠＠ ((= ksym XK-Insert) 'insert) ((= ksym XK-Pause) 'pause) ((= ksym XK-Space) 'space) + + ((= ksym XK-Next) 'next) + ((= ksym XK-Prior) 'prior) ;; TODO: add more ((= ksym XK-F1) 'f1) ＠＠ -519,7 +503,8 ＠＠ ((= ksym 0) nil) - (t (XCharacter ksym)))) ;nil or proper character + (t (or (X-XKeysymDB-keysym->sym ksym) + (XCharacter ksym))))) ;nil or proper character (defun xwem-kbd-emacs->xksym (ksym) "Convert back from Emacs key symbol KSYM to proper X key symbol." ＠＠ -547,6 +532,9 ＠＠ ((string= symname "insert") XK-Insert) ((string= symname "pause") XK-Pause) + ((string= symname "next") XK-Next) + ((string= symname "prior") XK-Prior) + ;; Mouse buttons ((string= symname "button1") (list X-XButton1)) ((string= symname "button2") (list X-XButton2)) ＠＠ -555,14 +543,15 ＠＠ ((string= symname "button5") (list X-XButton5)) ;; Functional keys - ((string-match "[fF]\$[0-9]+\$" symname) + ((string-match "^[fF]\$[0-9]+\$$" symname) (symbol-value (intern (concat "XK-F" (substring symname (match-beginning 1) (match-end 1)))))) - (t (Xforcenum (string-to-char osymname)))))) + (t (or (X-XKeysymDB-sym->keysym ksym) + (Xforcenum (string-to-char osymname))))))) ((characterp ksym) (Xforcenum ksym)) ;Should not be there ＠＠ -570,27 +559,16 ＠＠ (defun xwem-kbd-emods->xmodmask (emods) "Convert Emacs modifiers list EMODS to X modifers mask." - (Xmask-or - (if (member 'control emods) (xwem-kbd-controlmask) 0) - (if (member 'shift emods) (xwem-kbd-shiftmask) 0) - (if (member 'meta emods) (xwem-kbd-metamask) 0) - (if (member 'hyper emods) (xwem-kbd-hypermask) 0) - (if (member 'super emods) (xwem-kbd-supermask) 0))) + (apply 'Xmask-or 0 (mapcar (lambda (mod) + (or (get mod 'x-mod-mask) 0)) + emods))) (defun xwem-kbd-xmodmask->emods (mmask) "Convert X modifiers mask MMASK to Emacs modifiers list." - (let (rmods) - (when (Xtest mmask (xwem-kbd-controlmask)) - (push 'control rmods)) - (when (Xtest mmask (xwem-kbd-shiftmask)) - (push 'shift rmods)) - (when (Xtest mmask (xwem-kbd-hypermask)) - (push 'hyper rmods)) - (when (Xtest mmask (xwem-kbd-metamask)) - (push 'meta rmods)) - (when (Xtest mmask (xwem-kbd-supermask)) - (push 'super rmods)) - rmods)) + (delq nil (mapcar (lambda (mod) + (and (Xtest mmask (or (get mod 'x-mod-mask) 0)) + mod)) + '(shift control alt meta hyper super)))) ;; keysyms and keycodes converters (defun xwem-kbd-xksym->xkcode (ksym) ＠＠ -598,25 +576,24 ＠＠ Convert keysym to cons cell where car is keycode and cdr is modifiers list, using `xwem-xkeys-mapping' list. NOTE: only 'shift modifier supported." - (setq ksym (float ksym)) ; for sure - (let ((kslist (car (last xwem-xkeys-mapping))) - (kcode (X-Dpy-min-keycode (xwem-dpy))) - (kmods nil) - kel) - + (let* ((kcode (X-Dpy-min-keycode (xwem-dpy))) + (kslist (car (last xwem-xkeys-mapping))) + (ksyms-per-kcode (length (car kslist))) + (ksym-off 0) + (kmods nil)) (while kslist - (setq kel (car kslist)) - (if (member ksym kel) - (progn - (cond ((= ksym (nth 0 kel)) nil) - ((= ksym (nth 1 kel)) - (setq kmods (cons 'shift kmods))) - (t nil)) - (setq kslist nil)) - - (setq kslist (cdr kslist)) - (setq kcode (1+ kcode)) - )) + (cond ((= ksym (nth ksym-off (car kslist))) + (setq kslist nil)) + ((= ksym (nth (1+ ksym-off) (car kslist))) + (setq kslist nil + kmods (cons 'shift kmods))) + (t (setq kslist (cdr kslist) + kcode (1+ kcode)) + (when (and (null kslist) + (setq ksym-off (+ 2 ksym-off)) + (< ksym-off ksyms-per-kcode)) + (setq kslist (car (last xwem-xkeys-mapping)) + kcode (X-Dpy-min-keycode (xwem-dpy))))))) (cons kcode kmods))) (defun xwem-kbd-xkcode->xksym (kcode) ＠＠ -626,40 +603,21 ＠＠ ) ;;; Various subroutines -;;;###autoload (defun xwem-kbd-emod->kcode (emod &optional any) "Convert Emacs modifier EMOD to X keycode. Behaviour is undefined If ANY argument is supplied. DO NOT RELY ON THIS FUNCTION." - (let* ((mods (car (last xwem-xmods-mapping))) - (rmod (cond ((eq emod 'shift) (nth 0 mods)) - ;; locks skiped - ((eq emod 'control) (nth 2 mods)) - ((eq emod 'meta) (nth 3 mods)) - ;; numlock skiped - ((eq emod 'hyper) (nth 5 mods)) - ((eq emod 'super) (nth 6 mods)) - (t (error (format "Bad modifier `%S'" emod)))))) - (if any - rmod - (car rmod)))) + (funcall (if any 'identity 'car) (get emod 'x-key-codes))) -;;;###autoload (defun xwem-kbd-kcode->emod (kcode) "Convert key code KCODE to Emacs modifier, if KCODE is actually a modifier. See also `xwem-kbd-kcode-modifier-p'." - (let* ((mods (car (last xwem-xmods-mapping))) - (rmod (cond ((member kcode (nth 0 mods)) 'shift) - ;; locks skiped - ((member kcode (nth 2 mods)) 'control) - ((member kcode (nth 3 mods)) 'meta) - ;; numlock skiped - ((member kcode (nth 5 mods)) 'hyper) - ((member kcode (nth 6 mods)) 'super) - (t nil)))) - rmod)) + (let ((emods '(shift control alt meta super hyper))) + (while (and emods (not (member kcode (get (car emods) 'x-key-codes)))) + (setq emods (cdr emods))) + (car emods))) -;;;###autoload +;;;###xwem-autoload (defun xwem-kbd-kcode-modifier-p (kcode) "Return non-nil if key code KCODE is modifier." (let ((mods (car (last xwem-xmods-mapping)))) ＠＠ -686,8 +644,27 ＠＠ modifiers)) -;;;###autoload -(defun xwem-kbd-xevents->emacs-events (xevs &optional trust-modbits) +(defun xwem-kbd-hack-mouse (xev) + "Return (X . Y) to be used in mouse Emacs event." + (let ((cl (xwem-misc-find-cl-by-emacs-frame (last-nonminibuf-frame))) + xpnt x y) + + (if (member (X-Event-type xev) (list X-ButtonPress X-ButtonRelease)) + (setq x (X-Event-xbutton-root-x xev) + y (X-Event-xbutton-root-y xev)) + (setq x (X-Event-xmotion-root-x xev) + y (X-Event-xmotion-root-y xev))) + + (when cl + (setq xpnt (car (XTranslateCoordinates (xwem-dpy) (xwem-cl-xwin cl) (xwem-rootwin) 0 0)))) + + (when xpnt + (setq x (- x (X-Point-x xpnt))) + (setq y (- y (X-Point-y xpnt)))) + (cons x y))) + +;;;###xwem-autoload +(defun xwem-xevents->emacs-events (xevs &optional trust-modbits) "Convert X-Events XEVS to Emacs events. If TRUST-MODBITS is non-nil than we can trust modifier bits in ＠＠ -710,7 +687,7 ＠＠ (setq xevtype (X-Event-type xev)) (unless (member xevtype (list X-KeyPress X-KeyRelease X-ButtonPress X-ButtonRelease X-MotionNotify)) - (error "Invalid event type: %s" (X-Event-name xev))) + (error 'xwem-error "Invalid event type: %s" (X-Event-name xev))) (setq kcode nil mbutton nil) ＠＠ -738,25 +715,20 ＠＠ (X-Event-xbutton-state xev)) ((eq xevtype X-MotionNotify) (X-Event-xmotion-state xev)))))) - (make-event (cond ((eq xevtype X-KeyPress) 'key-press) - ((eq xevtype X-ButtonPress) 'button-press) - ((eq xevtype X-ButtonRelease) 'button-release) - ((eq xevtype X-MotionNotify) 'motion) - (t (error "Unknown event: %s" (X-Event-name xev)))) - (nconc (when (member xevtype (list X-ButtonPress X-ButtonRelease X-MotionNotify)) - (list 'x (cond ((member xevtype (list X-ButtonPress X-ButtonRelease)) - (X-Event-xbutton-root-x xev)) ; XXX what about 'channel? - (t (X-Event-xmotion-root-x xev))) - 'y (cond ((member xevtype (list X-ButtonPress X-ButtonRelease)) - (X-Event-xbutton-root-y xev)) ; XXX what about 'channel? - (t (X-Event-xmotion-root-y xev))))) - (list 'modifiers (xwem-kbd-adjust-modifiers kcode current-modifiers)) - (when (eq xevtype X-KeyPress) - (list 'key (xwem-kbd-xksym->emacs - (xwem-kbd-adjust-keycode kcode current-modifiers)))) - (when (member xevtype (list X-ButtonPress X-ButtonRelease)) - (list 'button mbutton))))) - )) + (make-event (cond ((eq xevtype X-KeyPress) 'key-press) + ((eq xevtype X-ButtonPress) 'button-press) + ((eq xevtype X-ButtonRelease) 'button-release) + ((eq xevtype X-MotionNotify) 'motion) + (t (error 'xwem-error "Unknown event: %s" (X-Event-name xev)))) + (nconc (when (member xevtype (list X-ButtonPress X-ButtonRelease X-MotionNotify)) + (let ((xm (xwem-kbd-hack-mouse xev))) + (list 'x (car xm) 'y (cdr xm)))) + (list 'modifiers (xwem-kbd-adjust-modifiers kcode current-modifiers)) + (when (eq xevtype X-KeyPress) + (list 'key (xwem-kbd-xksym->emacs + (xwem-kbd-adjust-keycode kcode current-modifiers)))) + (when (member xevtype (list X-ButtonPress X-ButtonRelease)) + (list 'button mbutton))))))) rxevs)) ;; Remove non-events from list ＠＠ -767,7 +739,6 ＠＠ "Convert Emacs EVENTS list to X events list." ) -;;;###autoload (defun xwem-kbd-ekeys->eevents (ekeys) "Convert Emacs keys sequence EKEYS to Emacs events vector." (mapvector (lambda (key) ＠＠ -787,25 +758,37 ＠＠ ;;{{{ [-] Sending +(defvar xwem-private-xtest-keycode-sequence nil) + ;; Sending(using XTEST) +(defun xwem-key-sendseq-1 (&optional keycode-seq) + "Emulate key presses/releases of KEYCODE-SEQ sequence using XTEST extension." + (unless keycode-seq + (setq keycode-seq xwem-private-xtest-keycode-sequence )) + (mapc (lambda (ksel) + (let ((ktype (car ksel)) + (kcode nil) + (ktime nil)) + (cond ((vectorp (cdr ksel)) + (setq kcode (aref (cdr ksel) 0)) + (setq ktime (aref (cdr ksel) 1))) + (t (setq kcode (cdr ksel)) + (setq ktime X-CurrentTime))) + (X-XTest-FakeInput (xwem-dpy) ktype kcode X-None 0 0 ktime))) + keycode-seq) + + (when (eq keycode-seq xwem-private-xtest-keycode-sequence) + (setq xwem-private-xtest-keycode-sequence nil))) + (defun xwem-key-sendseq (keycode-seq) "Emulate KEYCODE-SEQ. KEYCODE-SEQ is list of cons cells where car is event type and cdr is keycode. Supported event types are `X-Xtest-KeyPress' and `X-Xtest-KeyRelease'." - (mapc (lambda (ksel) - (let ((ktype (car ksel)) - (kcode nil) - (ktime nil)) - (cond ((vectorp (cdr ksel)) - (setq kcode (aref (cdr ksel) 0)) - (setq ktime (aref (cdr ksel) 1))) - (t - (setq kcode (cdr ksel)) - (setq ktime X-CurrentTime))) - (X-XTest-FakeInput (xwem-dpy) ktype kcode X-None 0 0 ktime))) - keycode-seq)) + (setq xwem-private-xtest-keycode-sequence + (append xwem-private-xtest-keycode-sequence keycode-seq)) + (xwem-add-hook-post-deffering 'xwem-key-sendseq-1 t)) -;;;###autoload +;;;###xwem-autoload (defun xwem-key-send-ekeys (keys) "Send Emacs key sequence KEYS using XTEST extension." (let (lseq) ＠＠ -837,38 +820,44 ＠＠ (setq lseq (nreverse lseq)) (xwem-key-sendseq lseq))) -;;;###autoload +;;;###xwem-autoload (defun xwem-kbd-wait-key-release (keycode) "Wait for key with KEYCODE for release." (unless xwem-executing-kbd-macro - ;; Increase events queue protecs so no events will be - ;; processed inside `XIfEvent'. - (incf (X-Dpy-evq-protects (xwem-dpy))) - - ;; Wait for a keyrelease - (unwind-protect - (XIfEvent (xwem-dpy) - (lambda (xev) + ;; Now wait key release event + (XNextEvent (xwem-dpy) nil + (lambda (xev) (and (= (X-Event-type xev) X-KeyRelease) (= (X-Event-xkey-keycode xev) keycode)))) + )) +; ;; Increase events queue protecs so no events will be +; ;; processed inside `XIfEvent'. +; (incf (X-Dpy-evq-protects (xwem-dpy))) + +; ;; Wait for a keyrelease +; (unwind-protect +; (XIfEvent (xwem-dpy) +; (lambda (xev) +; (and (= (X-Event-type xev) X-KeyRelease) +; (= (X-Event-xkey-keycode xev) keycode)))) - ;; Allow later events processing - (decf (X-Dpy-evq-protects (xwem-dpy)))))) +; ;; Allow later events processing +; (decf (X-Dpy-evq-protects (xwem-dpy))))) + -;;;###autoload +;;;###xwem-autoload (defun xwem-kbd-force-mods-release () "Force release of some modifiers." (let* ((xmods (car (last xwem-xmods-mapping))) - (mods (list (car (nth 0 xmods)) ; shift - (car (nth 2 xmods)) ; control - (car (nth 3 xmods)) ; meta - (car (nth 5 xmods)) ; hyper - (car (nth 6 xmods))))) ; super - (mapc (lambda (mod) - (X-XTest-FakeInput (xwem-dpy) X-Xtest-KeyRelease mod (xwem-rootwin) 0 0)) - (delete 0 mods)) - )) + (mods (list (nth 0 xmods) ; shift + (nth 2 xmods) ; control + (nth 3 xmods) ; meta + (nth 5 xmods) ; hyper + (nth 6 xmods)))) ; super + (xwem-key-sendseq-1 + (mapcar (lambda (el) (cons X-Xtest-KeyRelease el)) + (delete 0 (mapcar 'car mods)))))) (defun xwem-kbd-wait-button-release (button) "Wait for BUTTON for release." ＠＠ -878,49 +867,121 ＠＠ ;;{{{ [-] keypress/KeyRelease processing -(defun xwem-kbd-echolastkey () - "Echo key sequence already pressed in xwem minibuffer." - (when xwem-keyboard-echo-keystrokes - ;; XXX if there message from XWEM in minibuffer than add, otherwise - (if (xwem-interactive-p) - (append-message 'command (concat (single-key-description xwem-last-event) " ")) +;;;###xwem-autoload +(defun xwem-kbd-add-default-keymap (keymap) + "Add KEYMAP to default keymaps. +KEYMAP MUST NOT HAS PARENTS!" + (unless (memq keymap (keymap-parents xwem-default-parent-map)) + (set-keymap-parents xwem-default-parent-map + (cons keymap (keymap-parents xwem-default-parent-map))))) + +;;; Keys echoing +(defvar xwem-kbd-echoing-keys nil "Non-nil mean we are echoing command keys.") +(defvar xwem-kbd-scheduled-keys [] "Keys scheduled for echoing.") +(defvar xwem-kbd-scheduled-timer nil) + +(+ (and (lookup-key (xwem-kbd-fixup-keymap xwem-global-map) + keys accept-default) + xwem-global-map))))))) + +;;;###xwem-autoload +(defun xwem-global-key-binding (cl keys &optional accept-default) + "Return global binding for KEYS." + (lookup-key xwem-global-map keys accept-default)) -(defun xwem-kbd-process-after-lookup (lkm) - "Process keymap or command entry LKM after `lookup-key'." - (X-Dpy-log (xwem-dpy) "lkm = %S\n" 'lkm) - - (let ((slkm lkm) ;save lkm - (prfx-plist (when (and xwem-kbd-private-prefix-map - (symbolp xwem-kbd-private-prefix-map)) - (symbol-plist xwem-kbd-private-prefix-map))) - (splist (when (symbolp lkm) (symbol-plist lkm)))) - - (when (and (symbolp lkm) - (functionp lkm) - (keymapp (symbol-function lkm))) - (setq lkm (symbol-function lkm))) - - (X-Dpy-log (xwem-dpy) "PRFX-PLIST = %S, SPLIST = %S\n" 'prfx-plist 'splist) - - ;; Check for special mode, when we just reading single keystroke - (when xwem-kbd-reading-key - (xwem-read-keys-stop nil)) - - ;; Last chance to try default command - (when (null lkm) - (setq lkm (keymap-default-binding (xwem-kbd-current-map))) - (setq splist (and (symbolp lkm) (symbol-plist lkm)))) - - ;; Check is there need for prefix help or quit command - (when (and (null lkm) - xwem-kbd-now-grabbing) - (setq lkm - (let ((etk (events-to-keys (vector xwem-last-event)))) - (cond ((equal etk xwem-help-key) xwem-prefix-help-command) - ((equal etk xwem-quit-key) xwem-quit-command) - (t nil))))) - - ;; Now take a look at lkm - (cond ((null lkm) - ;; Check are we reading keysequence now - (when xwem-kbd-reading-keyseq - (xwem-read-keys-stop t)) - - (unless (eq (event-type xwem-last-event) 'button-release) - (xwem-play-sound 'undefined-key) - (xwem-message 'info "%s not binded." (key-description xwem-this-command-keys))) - - (xwem-kbd-stop-grabbing) - (xwem-kbd-set-current-prefix-keymap nil) - (setq xwem-this-command-keys []) - (setq xwem-kbd-reading-key nil) - (setq xwem-kbd-reading-keyseq nil) - - (let ((ex-fun (plist-get prfx-plist 'exit-fun))) - (when ex-fun (funcall ex-fun))) - ) - - ;; Prefix map - ((keymapp lkm) - - (xwem-kbd-set-current-prefix-keymap slkm) - (let ((enter-fun (plist-get splist 'enter-fun))) - (when enter-fun (funcall enter-fun))) - - (xwem-kbd-start-grabbing)) - - ;; Binded command or something else - (t - - ;; Check are we reading keysequence now - (when xwem-kbd-reading-keyseq - (xwem-read-keys-stop t)) - - ;; Reset privat keymap prefix - (xwem-kbd-set-current-prefix-keymap nil) - - ;; Now run command or keyboard macro - (unwind-protect - (condition-case err - (cond ((vectorp lkm) - ;; Keyboard macro. - ;; Wait for keyrelease, ungrab keyboard, than play it. - (when (= (X-Event-type xwem-last-xevent) X-KeyPress) - (xwem-kbd-wait-key-release (X-Event-xkey-keycode xwem-last-xevent))) - (xwem-kbd-stop-grabbing) - (xwem-keymacro-internal-play lkm (prefix-numeric-value xwem-prefix-arg))) - - ((commandp lkm) - ;; Execute command - (setq xwem-this-command lkm) - (run-hooks 'xwem-pre-command-hook) - - (call-interactively xwem-this-command) - - (setq xwem-last-command xwem-this-command)) - - (t (error "Unknown lkm %S" lkm))) - - (error - (xwem-play-sound 'command-fail) - (xwem-message 'err-nobeep "In cmd(%S): %s" lkm (error-message-string err))) - - (quit - (if (and (boundp 'xwem-bypass-quit) - (symbol-value 'xwem-bypass-quit)) - (signal 'quit (list 'xwem-bypass-quit (symbol-value 'xwem-bypass-quit))) - - (xwem-play-sound 'quit) - (xwem-message 'info "Quit: %s" err)))) - - ;; XXX Generic post command processing - (when (xwem-kbd-global-map-current-p) +;;;###xwem-autoload +(defun xwem-local-key-binding (cl keys &optional accept-default) + "Return local binding for KEYS." + (let ((lkmap (xwem-local-map cl))) + (and (keymapp lkmap) + (lookup-key lkmap keys accept-default)))) + +;;;###xwem-autoload +(defun xwem-minor-mode-key-binding (cl keys &optional accept-default) + "Return CL's minor mode binding for KEYS. +Retun cons cell in form `(MODENAME . BINDING)'." + (let ((mlist xwem-minor-mode-map-alist) + (bind nil)) + ;; Scan minor modes for binding + (while (and mlist (not bind)) + (when (xwem-client-local-variable-value cl (car (car mlist))) + (setq bind (lookup-key (xwem-kbd-fixup-keymap (cdr (car mlist))) + keys accept-default))) + (unless bind + (setq mlist (cdr mlist)))) + (when bind + (cons (car (car mlist)) bind)))) + +;;;###xwem-autoload +(defun xwem-lookup-key (client keys &optional accept-default) + "In CLIENT's context, lookup for KEYS binding. +`xwem-lookup-key' omits default binding unless ACCEPT-DEFAULT is +non-nil." + (unless client + (setq client (xwem-cl-selected))) + + (let (lkmap) + (if (setq lkmap (or (and (= (length keys) 1) + xwem-kbd-private-prefix-map) + xwem-override-map + xwem-override-local-map)) + (lookup-key (xwem-kbd-fixup-keymap lkmap) keys accept-default) + + ;; Try looking up in next order: + ;; - Minor modes map + ;; - Local map + ;; - Default parent map + ;; - Global map + (or (cdr (xwem-minor-mode-key-binding client keys accept-default)) + (xwem-local-key-binding client keys accept-default) + (xwem-global-key-binding client keys accept-default))))) + +;;;###xwem-autoload +(defun xwem-kbd-get-binding (keys &optional client) + "Get binding value for KEYS." + (xwem-lookup-key client keys t)) + +(defun xwem-kbd-fixate-current-lkm (lkm) + "In case LKM is not usable, fixate it. +Return fixated LKM." + (when (null lkm) + (let ((etk (events-to-keys (vector xwem-last-event)))) + (cond ((equal etk xwem-help-key) + (setq lkm xwem-prefix-help-command)) + ((equal etk xwem-quit-key) + (setq lkm xwem-quit-command)) + + ;; Last chance in re-lookup command keys + (t (setq lkm (or (xwem-lookup-key xwem-event-client xwem-this-command-keys) + (xwem-lookup-key xwem-event-client xwem-this-command-keys t))))))) + lkm) + +;;;###xwem-autoload +(defun xwem-kbd-dispatch-binding (lkm) + "Process keymap or command entry LKM after `lookup-key'. +Return non-nil if some action was performed." + ;; Check for special mode, when we just reading single keystroke + (when xwem-kbd-reading-key + (xwem-read-keys-stop nil)) + + ;; Fixate LKM, if it is bad + (setq lkm (xwem-kbd-fixate-current-lkm lkm)) + + (xwem-debug 'xwem-event "KBD Dispatcher: %S, lkm = %S" + 'xwem-this-command-keys 'lkm) + + (if (keymapp (xwem-kbd-fixup-keymap lkm)) + (progn + ;; Subkeymap + (xwem-kbd-set-current-prefix-keymap lkm) + (xwem-kbd-start-grabbing (eval (plist-get (xwem-kbd-keymap-plist lkm) 'cursor))) + + ;; Show keymap's prompt + (let ((prompt (or (eval (plist-get (xwem-kbd-keymap-plist lkm) 'prompt)) + (keymap-prompt lkm)))) + (if prompt + (xwem-message 'prompt prompt) + (xwem-kbd-schedule-command-keys-echoing)))) + + ;; Check are we reading keysequence now + (when xwem-kbd-reading-keyseq + (xwem-read-keys-stop t)) + + ;; Reset privat keymap prefix + (xwem-kbd-set-current-prefix-keymap nil) + + ;; Now run command or keyboard macro + (xwem-unwind-protect + (cond ((or (vectorp lkm) (stringp lkm)) + ;; Keyboard macro. + ;; Wait for keyrelease, ungrab keyboard, than play it. + (when (= (X-Event-type xwem-last-xevent) X-KeyPress) + (xwem-kbd-wait-key-release (X-Event-xkey-keycode xwem-last-xevent))) (xwem-kbd-stop-grabbing) - (setq xwem-this-command-keys [])) - ) + (xwem-keymacro-internal-play lkm (prefix-numeric-value xwem-prefix-arg))) - ;; Run post command hook - (run-hooks 'xwem-post-command-hook) - ) + ((commandp lkm) + ;; Fix LKM in case it is frame command + (when (and (symbolp lkm) + (get lkm 'xwem-frame-command) + (not (or (xwem-frame-p (xwem-cl-frame xwem-event-client)) + (eq (xwem-dummy-client) xwem-event-client)))) + (setq lkm 'ignore)) + + ;; Schedule it in hope that it will install prefix map + (xwem-kbd-schedule-command-keys-echoing) + + ;; Execute command + (setq xwem-this-command lkm) + (run-hooks 'xwem-pre-command-hook) + (call-interactively xwem-this-command) + (setq xwem-last-command xwem-this-command) + (run-hooks 'xwem-post-command-hook)) + + ((null lkm) + ;; Just echo key + (xwem-kbd-schedule-command-keys-echoing)) + + (t (error 'xwem-error (format "Unknown command: '%S'" lkm)))) + + ;; XXX Generic post command processing + (when (xwem-kbd-global-map-current-p) + (setq xwem-this-command-keys [])) + ;; Do it deffering, becase there maybe pending command events + ;; which need to be processed. + (xwem-deffered-funcall + (lambda () + (when (xwem-kbd-global-map-current-p) + (xwem-kbd-stop-command-keys-echoing) + (xwem-kbd-stop-grabbing))))) - (t (error - (format "Hm .. strange lkm=%S" lkm)))))) + (and lkm 'done))) ;;}}} ;;{{{ [-] Grabbing -(defun xwem-kbd-graugra-key (key win mode &optional button-mask) +;;;###xwem-autoload +(defun xwem-kbd-graugra-key (key win mode &optional button-mask pgrab-mode kgrab-mode) "Grab or Ungrab KEY on WIN. MODE is either 'grab or 'ungrab. BUTTON-MASK is mask passed to `XGrabButton' if MODE is 'grab and key is actually a mouse key." + (xwem-keyboard-init) ; make sure keyboard initialised + (let* ((key (aref (key-sequence-list-description key) 0)) (kmods (butlast key)) (ksyko (xwem-kbd-emacs->xksym (car (last key)))) ＠＠ -1141,109 +1214,195 ＠＠ (if mouse (if (eq mode 'grab) (XGrabButton (xwem-dpy) mouse (Xmask-or kmods m1 m2) win - (or button-mask (Xmask-or XM-ButtonPress XM-ButtonRelease)) nil t) + (or button-mask (Xmask-or XM-ButtonPress XM-ButtonRelease)) + nil t pgrab-mode kgrab-mode) (XUngrabButton (xwem-dpy) mouse (Xmask-or kmods m1 m2) win)) (if (eq mode 'grab) - (XGrabKey (xwem-dpy) ksyko (Xmask-or kmods m1 m2) win t) + (XGrabKey (xwem-dpy) ksyko (Xmask-or kmods m1 m2) win + t pgrab-mode kgrab-mode) (XUngrabKey (xwem-dpy) ksyko (Xmask-or kmods m1 m2) win)))) xwem-kbd-evilmasks)) xwem-kbd-evilmasks) )) -(defun xwem-kbd-grab-key (key win) +(defun xwem-kbd-grab-key (key win &optional pgrab kgrab) "Grab KEY on WIN." - (xwem-kbd-graugra-key key win 'grab)) + (xwem-kbd-graugra-key key win 'grab nil pgrab kgrab)) (defun xwem-kbd-ungrab-key (key win) "Stop grabbing KEY on WIN." (xwem-kbd-graugra-key key win 'ungrab)) -;;;###autoload -(defun xwem-kbd-install-grab (keymap win) +;;;###xwem-autoload +(defun xwem-kbd-install-grab (keymap win &optional pgrab kgrab) "Install KEYMAP grabs on X window WIN." - (map-keymap (lambda (key unused) - (xwem-kbd-grab-key key win)) - keymap)) + (map-keymap (lambda (key bind) + (unless (and (symbolp bind) (get bind 'xwem-no-grab)) + (xwem-kbd-grab-key key win pgrab kgrab))) + (xwem-kbd-fixup-keymap keymap)) + + ;; Also grab KEYMAP's parents + (mapc (lambda (pkeymap) + (xwem-kbd-install-grab pkeymap win pgrab kgrab)) + (keymap-parents (xwem-kbd-fixup-keymap keymap)))) + +;;;###xwem-autoload +(defun xwem-kbd-uninstall-grab (keymap win &optional predict) + "Uninstall KEYMAP grabs on X window WIN. + +Optionally you can specify PREDICT to decide for which keys grabbing +should be uinstalled. PREDICT must accept two arguments - KEY and +BINDING, and return non-nil if this KEY must be ungrabbed. + +By default all keys are ungrabbed." + (map-keymap (lambda (key bind) + (when (or (not predict) + (funcall predict key bind)) + (xwem-kbd-ungrab-key key win))) + (xwem-kbd-fixup-keymap keymap)) + + ;; Also ungrab KEYMAP's parents + (mapc (lambda (pkeymap) + (xwem-kbd-uninstall-grab pkeymap win predict)) + (keymap-parents (xwem-kbd-fixup-keymap keymap)))) -;;;###autoload -(defun xwem-kbd-uninstall-grab (keymap win) - "Uninstall KEYMAP grabs on X window WIN." - (map-keymap (lambda (key unused) - (xwem-kbd-ungrab-key key win)) - keymap)) - -;;;###autoload +(defun xwem-kbd-apply-grabbing () + "Start/stop grabbing according to `xwem-kbd-now-grabbing'." + (if xwem-kbd-now-grabbing + (unless xwem-executing-kbd-macro + (XGrabKeyboard (xwem-dpy) (or (xwem-focus-xcurrent) (xwem-rootwin)) nil) + (xwem-mouse-grab xwem-kbd-now-grabbing) + (XAllowEvents (xwem-dpy) X-SyncBoth)) + (unless xwem-executing-kbd-macro + (XUngrabKeyboard (xwem-dpy)) + (xwem-mouse-ungrab)))) + +;;;###xwem-autoload (defun xwem-kbd-start-grabbing (&optional cursor) "Begin grabbing keyboard (some key-prefix is entered). Optionally you can specify CURSOR to be used, while grabbing." (unless xwem-kbd-now-grabbing - (unless xwem-executing-kbd-macro - (XGrabKeyboard (xwem-dpy) (or (xwem-focus-xcurrent) (xwem-rootwin)) nil) - (xwem-mouse-grab (or cursor xwem-cursor-wait))) - - (setq xwem-kbd-now-grabbing t))) - -;;;###autoload -(defun xwem-kbd-start-grabbing-sync (&optional cursor) - "Same as `xwem-kbd-start-grabbing', but initiate grabs in Sync mode. -CURSOR argument is same is for `xwem-kbd-start-grabbing'." - (unless xwem-kbd-now-grabbing - (unless xwem-executing-kbd-macro - (XGrabKeyboard (xwem-dpy) (or (xwem-focus-xcurrent) (xwem-rootwin)) - nil X-GrabModeSync X-GrabModeSync) - (xwem-mouse-grab (or cursor xwem-cursor-wait)) - ) + (setq xwem-kbd-now-grabbing (or cursor xwem-cursor-wait)) + (xwem-kbd-apply-grabbing))) - (setq xwem-kbd-now-grabbing t))) - -;;;###autoload +;;;###xwem-autoload (defun xwem-kbd-stop-grabbing () "Stop grabbing keyboard." (when xwem-kbd-now-grabbing - (unless xwem-executing-kbd-macro - (XUngrabKeyboard (xwem-dpy)) - (xwem-mouse-ungrab)) + (setq xwem-kbd-now-grabbing nil) + (xwem-kbd-apply-grabbing))) - (setq xwem-kbd-now-grabbing nil))) +;;;###autoload(autoload 'xwem-kbd-quote-command "xwem-keyboard" "" t) +(define-xwem-command xwem-kbd-quote-command () + "Pass event EV to currently active window. +DOES NOT WORK." + (xwem-interactive "_") + + (let ((xwin (xwem-focus-xcurrent)) + xev) + (when (X-Win-p xwin) + (XGrabKeyboard (xwem-dpy) xwin nil X-GrabModeSync X-GrabModeSync) + (XGrabPointer (xwem-dpy) xwin (Xmask-or XM-ButtonPress XM-ButtonRelease) + xwem-cursor-quote nil X-GrabModeSync X-GrabModeSync) + (XAllowEvents (xwem-dpy) X-SyncBoth) + + (xwem-message 'prompt "[Quote key]") + (xwem-unwind-protect + (while (and (setq xev (xwem-next-event nil + (list X-KeyPress X-KeyRelease X-ButtonPress X-ButtonRelease))) + (not (xwem-xevents->emacs-events (list xev) t) )) + (XAllowEvents (xwem-dpy) X-SyncBoth)) + (XAllowEvents (xwem-dpy) X-ReplayKeyboard) + (XAllowEvents (xwem-dpy) X-ReplayPointer) + (XUngrabKeyboard (xwem-dpy)) + (XUngrabPointer (xwem-dpy)) + (xwem-clear-message))))) + +;;}}} -;;; FIXME: this does bad, naughty things. -;; ;;;###autoload(autoload 'xwem-kbd-quote-command "xwem-keyboard" "" t) -;; (define-xwem-command xwem-kbd-quote-command () -;; "Pass event EV to currently active window. -;; DOES NOT WORK." -;; (xwem-interactive "_") - -;; (let ((xwin (xwem-focus-xcurrent))) -;; (when (X-Win-p xwin) -;; (XGrabKeyboard (xwem-dpy) xwin nil X-GrabModeAsync X-GrabModeSync) -;; (XGrabPointer (xwem-dpy) xwin (Xmask-or XM-ButtonPress XM-ButtonRelease) -;; xwem-cursor-quote nil X-GrabModeSync) -;; (XAllowEvents (xwem-dpy) X-SyncBoth) - -;; (xwem-message 'info "[Quote key]") -;; (unwind-protect -;; (let ((done nil) -;; xev) -;; (while (not done) -;; (setq xev (xwem-next-event 1)) -;; (cond ((X-Event-p xev) -;; (if (and (member (X-Event-type xev) -;; (list X-KeyPress X-ButtonPress X-ButtonRelease)) -;; (xwem-kbd-xevents->emacs-events (list xev) t)) -;; (progn -;; (xwem-message 'info "here") -;; (XAllowEvents (xwem-dpy) X-ReplayKeyboard) -;; (XAllowEvents (xwem-dpy) X-ReplayPointer) -;; (xwem-clear-message) -;; (setq done t)) - -;; (XAllowEvents (X-Event-dpy xev) X-SyncBoth))) -;; (t (setq done t))))) - -;; (XUngrabKeyboard (xwem-dpy)) -;; (XUngrabPointer (xwem-dpy)) -;; )))) +;;{{{ [-] Initializators + +;;;###xwem-autoload +(defun xwem-kbd-initialize-modifiers () + "Create internal modifier representation to speedup futher work. +Also update `xwem-kbd-evilmasks' if `xwem-kbd-evillocks' is non-nil." + (setq xwem-xmods-mapping + (XGetModifierMapping (xwem-dpy))) + + (let* ((ctrls (list (car (xwem-kbd-xksym->xkcode XK-Control-L)) + (car (xwem-kbd-xksym->xkcode XK-Control-R)))) + (alts (list (car (xwem-kbd-xksym->xkcode XK-Alt-L)) + (car (xwem-kbd-xksym->xkcode XK-Alt-R)))) + (locks (list (car (xwem-kbd-xksym->xkcode XK-Caps-Lock)))) + (shifts (list (car (xwem-kbd-xksym->xkcode XK-Shift-L)) + (car (xwem-kbd-xksym->xkcode XK-Shift-R)))) + (metas (list (car (xwem-kbd-xksym->xkcode XK-Meta-L)) + (car (xwem-kbd-xksym->xkcode XK-Meta-R)))) + (hypers (list (car (xwem-kbd-xksym->xkcode XK-Hyper-L)) + (car (xwem-kbd-xksym->xkcode XK-Hyper-R)))) + (supers (list (car (xwem-kbd-xksym->xkcode XK-Super-L)) + (car (xwem-kbd-xksym->xkcode XK-Super-R)))) + (numlocks (list (car (xwem-kbd-xksym->xkcode XK-NumLock)))) + (evils (mapcar (lambda (ks) + (car (xwem-kbd-xksym->xkcode ks))) xwem-kbd-evillocks)) + (mlist (mapcar 'truncate (list X-Shift X-Lock X-Control X-Mod1 X-Mod2 + X-Mod3 X-Mod4 X-Mod5))) + (slist (car (last xwem-xmods-mapping)))) + + ;; Clear modifiers info + (mapc (lambda (mod-sym) + (put mod-sym 'x-key-codes nil) + (put mod-sym 'x-mod-mask nil)) + '(shift lock control alt meta hyper super numlock)) + + (while slist + ;; Update some private modifier mask + (mapc (lambda (mods mod-sym) + (when (intersection (car slist) mods) + (put mod-sym 'x-key-codes mods) + (put mod-sym 'x-mod-mask (Xmask-or (car mlist) + (or (get mod-sym 'x-mod-mask) 0))))) + (list shifts locks ctrls alts metas hypers supers numlocks) + '(shift lock control alt meta hyper super numlock)) + + ;; Update Evil locks + (when (intersection (car slist) evils) + (push (car mlist) xwem-kbd-evilmasks)) + + (setq slist (cdr slist)) + (setq mlist (cdr mlist))) + + ;; Hack over Alt-Meta problem + (when (eql (get 'alt 'x-mod-mask) (get 'meta 'x-mod-mask)) + (put 'alt 'x-mod-mask 0)))) + +(defun xwem-keyboard-init () + "Initialize xwem keyboard. +Fetches KeyboardMapping from the X server and stores it in +`xwem-xkeys-mapping'" + (unless (get 'xwem-keyboard 'initialized) + (xwem-message 'init "Initializing keyboard ...") + + (xwem-kbd-set-current-prefix-keymap nil) + + ;; Hmm FSFmacs issued "invalid instraction" in `XGetKeyboardMapping' + (setq xwem-xkeys-mapping + (XGetKeyboardMapping (xwem-dpy) + (X-Dpy-min-keycode (xwem-dpy)) + (- (X-Dpy-max-keycode (xwem-dpy)) + (X-Dpy-min-keycode (xwem-dpy))))) + + ;; Initialize modifiers + (xwem-kbd-initialize-modifiers) + + ;; Some messaging configuration + (add-to-list 'xwem-messages-ignore-labels 'keys) + (add-to-list 'xwem-messages-ignore-labels 'keys-continuator) + + (run-hooks 'xwem-keyboard-init-hook) + (put 'xwem-keyboard 'initialized t) + (xwem-message 'init "Initializing keyboard ... done"))) ;;}}} ＠＠ -1277,8 +1436,14 ＠＠ map) "Keymap used while processing \\<xwem-global-map>\\[xwem-universal-argument].") +(defvar xwem-universal-argument-num-events nil + "Number of argument-specifying events read by +`xwem-universal-argument'.") + (defun xwem-universal-common-begin () "Common begin for universal argument." + (setq xwem-universal-argument-num-events + (length xwem-this-command-keys)) (if xwem-kbd-now-grabbing (setq xwem-override-map xwem-universal-map) ＠＠ -1316,7 +1481,8 ＠＠ (setq xwem-prefix-arg (list (* 4 (car arg)))) (setq xwem-prefix-arg arg) - (setq xwem-override-map nil))) + (setq xwem-override-map nil)) + (setq xwem-universal-argument-num-events (length xwem-this-command-keys))) ;;;###autoload(autoload 'xwem-universal-minus "xwem-keyboard" "" t) (define-xwem-command xwem-universal-minus (arg) ＠＠ -1349,38 +1515,27 ＠＠ (xwem-universal-common-begin))) -(defun xwem-reset-this-command-lengths () - "For some documentation look at `reset-this-command-lengths'." - ;; This brokes some things, like H-1 H-2 H-3 will not be properly - ;; displayed in minibuffer, so i disabled it. - - ;; Also there is notice in event-stream.c to - ;; `reset-this-command-lengths': - ;; - ;; /* #### I don't understand this at all, so currently it does nothing. - ;; If there is ever a problem, maybe someone should investigate. */ - - ; (setq xwem-this-command-keys (vector xwem-last-event)) - ) - ;;;###autoload(autoload 'xwem-universal-command "xwem-keyboard" "" t) (define-xwem-command xwem-universal-command (arg) "Handle universal argument functionality." (xwem-interactive "P") (setq xwem-prefix-arg arg) - (xwem-reset-this-command-lengths) - (xwem-kbd-set-current-prefix-keymap nil) - (setq xwem-override-map nil) + (let ((keylist (append xwem-this-command-keys nil))) + (mapc 'xwem-unread-command-event + (nthcdr xwem-universal-argument-num-events keylist))) - (xwem-kbd-process-after-lookup - (xwem-kbd-key-binding-evs (vector xwem-last-event))) - ) + (setq xwem-override-map nil)) ;;}}} (provide 'xwem-keyboard) + +;;;; On-load actions: +(if xwem-started + (xwem-keyboard-init) + (add-hook 'xwem-before-init-wins-hook 'xwem-keyboard-init)) ;;; xwem-keyboard.el ends here Index: lisp/xwem-keydefs.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-keydefs.el,v retrieving revision 1.10 diff -u -u -r1.10 xwem-keydefs.el --- lisp/xwem-keydefs.el 16 Dec 2004 08:08:08 -0000 1.10 +++ lisp/xwem-keydefs.el 1 Jan 2005 04:41:13 -0000 ＠＠ -5,7 +5,7 ＠＠ ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> ;; Created + +(define-key xwem-global-map (xwem-kbd "H-x b") 'xwem-switch-client) +(define-key xwem-global-map (xwem-kbd "H-x a") 'xwem-attach-client) +(define-key xwem-global-map (xwem-kbd "H-x H-b") 'xwem-ixwem) + (define-key xwem-global-map (xwem-kbd "H-x r") 'xwem-launch-program) (define-key xwem-global-map (xwem-kbd "H-:") 'xwem-eval-expression) (define-key xwem-global-map (xwem-kbd "H-!") 'xwem-shell-command) (define-key xwem-global-map (xwem-kbd "H-M-x") 'xwem-execute-extended-command) (define-key xwem-global-map (xwem-kbd "H-#") 'xwem-mini-calc) - -(define-key xwem-global-map (xwem-kbd "H-<") 'xwem-beginning-of-cl) -(define-key xwem-global-map (xwem-kbd "H->") 'xwem-end-of-cl) +(define-key xwem-global-map (xwem-kbd "H-TAB") 'xwem-minibuffer-activate) (define-key xwem-global-map (xwem-kbd "H-f12") 'xwem-misc-make-screenshot) (define-key xwem-global-map (xwem-kbd "H-z") 'xwem-misc-pause) (define-key xwem-global-map (xwem-kbd "H-pause") 'xwem-misc-pause) +;; Register commands +(define-key xwem-global-map (xwem-kbd "H-x 6") 'xwem-register-win-config) +(define-key xwem-global-map (xwem-kbd "H-x 8") 'xwem-register-frame-config) +(define-key xwem-global-map (xwem-kbd "H-x /") 'xwem-register-client) +(define-key xwem-global-map (xwem-kbd "H-x j") 'xwem-register-jump) + +;; Client switcher +(define-key xwem-global-map (xwem-kbd "H-f") 'xwem-forward-application) +(define-key xwem-global-map (xwem-kbd "H-b") 'xwem-backward-application) + +(define-key xwem-global-map (xwem-kbd "H-]") 'xwem-clswi-next) +(define-key xwem-global-map (xwem-kbd "H-[") 'xwem-clswi-prev) +(define-key xwem-global-map (xwem-kbd "H-}") 'xwem-clswi-next-other-window) +(define-key xwem-global-map (xwem-kbd "H-{") 'xwem-clswi-prev-other-window) + +;; Cutbuffers +(define-key xwem-global-map (xwem-kbd "H-w") 'xwem-copy-cutbuffer) +(define-key xwem-global-map (xwem-kbd "H-y") 'xwem-paste-cutbuffer) + +;;; Misc bindings +;; Making holer in frames +(define-key xwem-global-map (xwem-kbd "H-x h") 'xwem-holer-prefix) +;; Log your work +(define-key xwem-global-map (xwem-kbd "H-W") 'xwem-worklog-prefix) +;; Interactively edit client's property +(define-key xwem-global-map (xwem-kbd "H-c H-e") 'xwem-edit-client-properties) + ;; Compat layer, must move to xwem-compat.el (if xwem-gnuemacs-p (progn (define-key xwem-global-map [s-mouse-1] 'xwem-strokes-begin) (define-key xwem-global-map [h-mouse-1] 'xwem-strokes-cmplx-begin)) (progn - (define-key xwem-global-map (xwem-kbd "Sh-C-button1") 'xwem-frame-imove) - (define-key xwem-global-map (xwem-kbd "Sh-C-button3") 'xwem-frame-iresize) - - (define-key xwem-global-map (xwem-kbd "M-button1") 'xwem-strokes-begin) - (define-key xwem-global-map (xwem-kbd "H-button1") 'xwem-strokes-cmplx-begin))) + ;;; Root keymap + ;; No-need to grab button1/button3 + (define-key xwem-root-map (xwem-kbd "<button1>") 'xwem-popup-auto-menu) + (define-key xwem-root-map (xwem-kbd "<button3>") 'xwem-popup-clients-menu) + + ;;; Frame keymap + ;; No-need to grab button1/button3 + (define-key xwem-frame-map (xwem-kbd "<button1>") 'xwem-frame-on-delim-resize) + (put 'xwem-frame-on-delim-resize 'xwem-no-grab t) + (define-key xwem-frame-map (xwem-kbd "<button3>") 'xwem-frame-on-delim-menu) + (put 'xwem-frame-on-delim-menu 'xwem-no-grab t) + ;; Frame imove/iresize + (define-key xwem-frame-map (xwem-kbd "Sh-C-button1") 'xwem-frame-imove) + (define-key xwem-frame-map (xwem-kbd "Sh-C-button3") 'xwem-frame-iresize) + + ;; Strokes bindings + (define-key xwem-default-parent-map (xwem-kbd "M-<button1>") 'xwem-strokes-begin) + (define-key xwem-default-parent-map (xwem-kbd "H-<button1>") 'xwem-strokes-cmplx-begin) + )) (provide 'xwem-keydefs) Index: lisp/xwem-keymacro.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-keymacro.el,v retrieving revision 1.9 diff -u -u -r1.9 xwem-keymacro.el --- lisp/xwem-keymacro.el 16 Dec 2004 08:08:08 -0000 1.9 +++ lisp/xwem-keymacro.el 1 Jan 2005 04:41:13 -0000 ＠＠ -1,11 +1,13 ＠＠ + ;;; xwem-keymacro.el --- Recording/playing keyboard macros. ;; Copyright (C) 2003 by Free Software Foundation, Inc. ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Steve Youngs <steve(a)youngs.au.com> ;; Created: Fri Dec 12 17:18:00 MSK 2003 ;; Keywords: xwem, xlib -;; X-CVS: $Id: xwem-keymacro.el,v 1.9 2004/12/16 08:08:08 youngs Exp $ +;; X-CVS: $Id: xwem-keymacro.el,v 1.8 2004/12/05 22:37:34 lg Exp $ ;; This file is part of XWEM. ＠＠ -68,17 +70,19 ＠＠ ;;; Code: -(require 'xwem-compat) -(eval-and-compile - (require 'xlib-xtest) - (require 'xlib-xrecord)) + +(require 'xlib-xtest) +(require 'xlib-xrecord) + +(require 'xwem-load) +(require 'xwem-misc) ;; Macros customization (defcustom xwem-keymacro-minib-bg "gray60" "*Background color for xwem's minibuffer while recording KBD macro. If nil - background will not change." -:type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) +:type 'color :group 'xwem-keyboard) (defcustom xwem-keymacro-debug nil ＠＠ -96,20 +100,15 ＠＠ :type 'file :group 'xwem-keyboard) +;;; Internal variables + ;;; Macros recording/playing internal variables -;;;###autoload +;;;###xwem-autoload (defvar xwem-executing-kbd-macro nil - "Non-nil when executing keyboard macro. -Actually Emacs keysequence(vector of keys) to be executed. -Internal variable, do not modify.") - -;;;###autoload -(defvar xwem-executing-kbd-macro-index nil - "Indexes current key in `xwem-excuting-kbd-macro' vector. -Internal variable, do not modify.") + "Non-nil when executing keyboard macro.") -;;;###autoload +;;;###xwem-autoload (defvar xwem-keymacro-last-kbd-macro nil "Last KBD macro.") (defvar xwem-keymacro-default-command 'xwem-keymacro-default ＠＠ -144,19 +143,20 ＠＠ "Non-nil when keyboard macrosing initialized. Internal variable, do not modify it directly.") -;;;###autoload (defun xwem-keymacro-init () "Initialize keyboard macrosing stuff." - ;; User xlib-xrecord extension to intercept KeyPress/KeyRelease + (pushnew '(macro "Macro") xwem-messages-label-prefixes) + + ;; Use xlib-xrecord extension to intercept KeyPress/KeyRelease ;; events. (let ((xrec-ext (X-XRecordQueryVersion (xwem-dpy))) (xtest-ext (XQueryExtension (xwem-dpy) "XTEST"))) (if (or (null (car xrec-ext)) (null (car xtest-ext))) - ;; Not XRECORD or XTEST extension support - (xwem-message 'warn "No XRECORD or XTEST extension on dpy, you can't use keyboard macros saving.") + ;; No XRECORD or XTEST extension support + (xwem-message 'warning "No XRECORD or XTEST extension on dpy, you can't use keyboard macros saving.") - ;; Dpy supports XRECORD extension + ;; (xwem-dpy) supports XRECORD extension (setq xwem-keymacro-rcontext (make-X-RecordContext :dpy (xwem-dpy) :id (X-Dpy-get-id (xwem-dpy)))) (setq xwem-keymacro-rranges ;; We are only interested in KeyPrees/KeyRelease events ＠＠ -177,57 +177,45 ＠＠ (when xwem-keymacro-debug (setf (X-Dpy-log-buffer xwem-keymacro-dpy) "XREC.log")) - (setq xwem-keymacro-initialized t) - ))) + (setq xwem-keymacro-initialized t)))) (defun xwem-keymacro-extract (xevs &optional cutlen) "Extract keyboard macro from X-Events list XEVS. Return list of Emacs events. CUTLEN is how many events cut from the end (default is 1)." - (let ((evs (butlast (xwem-kbd-xevents->emacs-events xevs nil) + (let ((evs (butlast (xwem-xevents->emacs-events xevs nil) (or cutlen 1)))) (key-sequence-list-description (vconcat evs)))) -;;;###autoload +(defun xwem-keymacro-start-executing-keys (&rest args) + "Start executing keyboard macro." + (setq xwem-executing-kbd-macro t)) + +(defun xwem-keymacro-stop-executing-keys (&rest args) + "Stop executing keyboard macro." + (setq xwem-executing-kbd-macro nil)) + +;;;###xwem-autoload (defun xwem-keymacro-execute-keys (keys) "Execute keyboard macro KEYS." - (let ((xwem-executing-kbd-macro keys) - (xwem-executing-kbd-macro-index 0) - eev cmd) - - (while (< xwem-executing-kbd-macro-index - (length xwem-executing-kbd-macro)) - ;; Construct Emacs event - (setq eev (aref xwem-executing-kbd-macro xwem-executing-kbd-macro-index)) - (setq eev (make-event 'key-press (list 'modifiers (butlast eev) 'key (car (last eev))))) - - (setq cmd (xwem-kbd-key-binding-evs (vector eev))) - - ;; If current map is `xwem-global-map' and command not found, it - ;; is most possible that this is normal input, i.e. not an XWEM - ;; command. - (if (or cmd (not (xwem-kbd-global-map-current-p))) - (xwem-kbd-handle-keybutton-from-emacs eev) - - ;; Otherwise send fake event. Should we have default command - ;; in `xwem-global-map' to self-insert last command keys? - (xwem-key-send-ekeys eev)) + (enqueue-eval-event 'xwem-keymacro-start-executing-keys t) + (mapc 'xwem-unread-command-event keys) + (enqueue-eval-event 'xwem-keymacro-stop-executing-keys t) + ) - (incf xwem-executing-kbd-macro-index)))) - -;;;###autoload(autoload 'xwem-keymacro-begin "xwem-keymacro") +;;;###autoload(autoload 'xwem-keymacro-begin "xwem-keymacro" nil t) (define-xwem-command xwem-keymacro-begin (arg) "Start to record keyboard macro. If used with prefix ARG, then query for bind after macro define." (xwem-interactive "P") (when (not xwem-keymacro-initialized) - (error "Keyboard macros not initialized, use `xwem-keymacro-init'")) + (error 'xwem-error "Keyboard macros not initialized, use `xwem-keymacro-init'")) (if xwem-keymacro-saving - (xwem-message 'warn "Already defining macro...") + (xwem-message 'warning "Already defining macro...") - (xwem-message 'msg "Defining KBD macro ...") + (xwem-message 'macro "Defining KBD macro ...") ;; Clear events queue and enable context (setf (X-Dpy-evq xwem-keymacro-dpy) nil) ＠＠ -236,7 +224,7 ＠＠ ;; Change xwem's minibuffer background (when xwem-keymacro-minib-bg (setq xwem-keymacro-minib-old-bg - (face-background 'default (xwem-minib-frame xwem-minibuffer))) + (face-background-name 'default (xwem-minib-frame xwem-minibuffer))) (set-face-property 'default 'background xwem-keymacro-minib-bg (xwem-minib-frame xwem-minibuffer))) ＠＠ -244,21 +232,19 ＠＠ (setq xwem-keymacro-saving t) )) -;;;###autoload(autoload 'xwem-keymacro-end "xwem-keymacro") -(define-xwem-command xwem-keymacro-end (arg &optional key) +;;;###autoload(autoload 'xwem-keymacro-end "xwem-keymacro" nil t) +(define-xwem-command xwem-keymacro-end (arg) "Stop recording keyboard macro. -If recording done with prefix argument, then query for bind." - (xwem-interactive - (progn - (when (= (X-Event-type xwem-last-xevent) X-KeyPress) - (xwem-kbd-wait-key-release (X-Event-xkey-keycode xwem-last-xevent))) - - (list xwem-keymacro-prefix-arg - (when xwem-keymacro-prefix-arg - (xwem-read-key "Enter character to bind: "))))) +If recording done with prefix argument, then query for key to bind." + (xwem-interactive (list xwem-keymacro-prefix-arg)) (if (not xwem-keymacro-saving) - (xwem-message 'warn "Not recording KBD macro.") + (xwem-message 'warning "Not recording KBD macro.") + + ;; Wait last keyrelease, so `xwem-keymacro-extract' will cut keys + ;; properly. + (when (= (X-Event-type xwem-last-xevent) X-KeyPress) + (xwem-kbd-wait-key-release (X-Event-xkey-keycode xwem-last-xevent))) (X-XRecordDisableContext (xwem-dpy) xwem-keymacro-rcontext) (setq xwem-keymacro-saving nil) ＠＠ -274,12 +260,12 ＠＠ ;; Save last keyboard macro (setq xwem-keymacro-last-kbd-macro kmacro) - (define-key xwem-user-macros-map (events-to-keys (vector key)) kmacro))) + (let ((key (xwem-read-key "Enter character to bind: "))) + (define-key 'xwem-user-macros-prefix (events-to-keys (vector key)) kmacro)))) - (xwem-message 'msg "KBD macro defined.") - )) + (xwem-message 'macro "KBD macro defined."))) -;;;###autoload +;;;###xwem-autoload (defun xwem-keymacro-internal-play (keys &optional times) "Play Emacs KEYS TIMES times." (unless times ＠＠ -291,8 +277,7 ＠＠ (setq xwem-prefix-arg nil) (when xwem-keymacro-show-macro - (xwem-message 'info "Executing macro: '%s'" - (key-description keys))) + (xwem-message 'macro "Executing macro: '%s'" (key-description keys))) ;; Force release of modifiers (xwem-kbd-force-mods-release) ＠＠ -302,12 +287,12 ＠＠ (make-list times keys))) ;; Commands to be used in `xwem-keymacro-user-macros' -;;;###autoload(autoload 'xwem-keymacro-undefined "xwem-keymacro") +;;;###autoload(autoload 'xwem-keymacro-undefined "xwem-keymacro" nil t) (define-xwem-command xwem-keymacro-undefined () "Undefined macro command." (xwem-interactive) - (xwem-message 'warn "Macro key `%s' is not defined" (key-description xwem-this-command-keys))) + (xwem-message 'warning "Macro key `%s' is not defined" (key-description xwem-this-command-keys))) ;;;###autoload(autoload 'xwem-keymacro-play-last "xwem-keymacro") (define-xwem-command xwem-keymacro-play-last (arg) ＠＠ -315,15 +300,15 ＠＠ (xwem-interactive "*_p") (if xwem-keymacro-saving - (xwem-message 'warn "Can't play macro while recording.") + (xwem-message 'warning "Can't play macro while recording.") (if (not xwem-keymacro-last-kbd-macro) - (xwem-message 'warn "No KBD macros have been saved.") + (xwem-message 'macro "No KBD macros have been saved.") (xwem-keymacro-internal-play xwem-keymacro-last-kbd-macro arg)) )) -;;;###autoload(autoload 'xwem-keymacro-recursive-edit "xwem-keymacro") +;;;###autoload(autoload 'xwem-keymacro-recursive-edit "xwem-keymacro" nil t) (define-xwem-command xwem-keymacro-recursive-edit (arg) "Enter recursive edit. Using \\<xwem-global-map>\\[xwem-keymacro-recursive-edit] you can ＠＠ -335,7 +320,7 ＠＠ (or xwem-executing-kbd-macro xwem-keymacro-saving - (error "Not defining or executing keyboard macro")) + (error 'xwem-error "Not defining or executing keyboard macro")) (let ((xwem-this-command-keys []) (xwem-prefix-arg nil)) ＠＠ -349,7 +334,7 ＠＠ (X-XRecordEnableContext xwem-keymacro-dpy xwem-keymacro-rcontext)) )) -;;;###autoload(autoload 'xwem-keymacro-exit-recursive-edit "xwem-keymacro") +;;;###autoload(autoload 'xwem-keymacro-exit-recursive-edit "xwem-keymacro" nil t) (define-xwem-command xwem-keymacro-exit-recursive-edit () "Exit recursive edition." (xwem-interactive "*") ＠＠ -370,8 +355,8 ＠＠ (map-keymap (lambda (kseq fbind) (when (vectorp fbind) - (insert (format "(define-key xwem-user-macros-map '%S %S)\n" kseq fbind)))) - xwem-user-macros-map) + (insert (format "(define-key 'xwem-user-macros-prefix '%S %S)\n" kseq fbind)))) + (xwem-kbd-fixup-keymap 'xwem-user-macros-prefix)) (write-file (or file (expand-file-name xwem-keymacro-macrofile xwem-dir))) (kill-buffer buf)))) ＠＠ -385,4 +370,9 ＠＠ (provide 'xwem-keymacro) +;;; On-load actions +(if xwem-started + (xwem-keymacro-init) + (add-hook 'xwem-keyboard-init-hook 'xwem-keymacro-init)) + ;;; xwem-keymacro.el ends here Index: lisp/xwem-keytt.el =================================================================== RCS file: lisp/xwem-keytt.el diff -N lisp/xwem-keytt.el --- lisp/xwem-keytt.el 16 Dec 2004 08:08:08 -0000 1.3 +++ /dev/null 1 Jan 1970 00:00:00 -0000 ＠＠ -1,74 +0,0 ＠＠ -;;; xwem-keytt.el --- Keypress translation table. - -;; Copyright (C) 2003 by Free Software Foundation, Inc. - -;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> -;; Created: Fri Dec 12 19:33:35 MSK 2003 -;; Keywords: xwem, xlib -;; X-CVS: $Id: xwem-keytt.el,v 1.3 2004/12/16 08:08:08 youngs Exp $ - -;; This file is part of XWEM. - -;; XWEM 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. - -;; XWEM 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 t (xwem-launcher-join-cmd ncmd)))) -;;;###autoload +;;;###xwem-autoload (defun xwem-launcher-query (&optional prompt) "Query for command to launch using PROMPT." - (let ((cmd (xwem-launcher-read-command - (if prompt (concat prompt "XWEM-Run: ") "XWEM-Run: ")))) - + (let ((cmd (xwem-launcher-read-command (or prompt "XWEM-Run: ")))) (xwem-launcher-normalize-cmd cmd))) ;;;###autoload(autoload 'xwem-run-program "xwem-launcher" "" t) ＠＠ -223,6 +242,13 ＠＠ (xwem-execute-program command)) +(defun xwem-next-job-number () + "Return next job number for use by xwem." + (let ((job-number 1)) + (while (get-process (format "xwem-run-%d" job-number)) + (setq job-number (1+ job-number))) + job-number)) + ;;;###autoload (defun xwem-execute-program (command &optional buffer-name) "Execute COMMAND in buffer with BUFFER-NAME. ＠＠ -230,28 +256,41 ＠＠ (let* ((cmdargs (condition-case nil (split-string command " ") (t (list command)))) ; due to split-string args-out-of-range bug (prg (car cmdargs)) (args (cdr cmdargs)) - (job-number 1) - job-name) - (while (get-process (setq job-name (format "xwem-run-%d" job-number))) - (setq job-number (1+ job-number))) + (emacs-env (getenv "EMACS")) + (job-number (xwem-next-job-number)) + (job-name (format "xwem-run-%d" job-number)) + proc) - (or buffer-name - (setq buffer-name (format " *%s*" job-name))) + (unless buffer-name + (setq buffer-name (format " *%s*" job-name))) (with-current-buffer (get-buffer-create buffer-name) + ;; Sometimes `default-directory' became nil for some reason, I + ;; don't know why. Maybe XEmacs bug? --lg + (unless default-directory + (setq default-directory (expand-file-name "~/"))) + (erase-buffer) + (insert (format "--- Working directory: %S\n%% %S\n" default-directory command)) - (insert "--- working directory: %S" default-directory - "\n% " command ?\n) + ;; Set our EMACS environment variable so comint-exec doesn't do it + ;; for us. Note that if the environment is already set, we may + ;; not want to do it again. + (unless emacs-env + (setenv "EMACS" "xwem")) + + (setq proc (get-buffer-process + (comint-exec buffer-name job-name prg nil args))) + (comint-mode) + ;; COND because the proc may have died before the G-B-P is called. + (cond (proc (set-process-sentinel proc 'xwem-program-sentinel) + (xwem-message 'note "Job [%d] '%s' PID=%d" job-number command (process-id proc)))) + (setq mode-name "XWEM-Run") - (let ((proc (get-buffer-process - (comint-exec buffer-name job-name prg nil args)))) - (comint-mode) - ;; COND because the proc may have died before the G-B-P is called. - (cond (proc (set-process-sentinel proc 'xwem-program-sentinel) - (message "[%d] %d" job-number (process-id proc)))) - (setq mode-name "XWEM-Run") - proc)))) + ;; Restore our Emacs environment variable to its previous state. + (setenv "EMACS" emacs-env) + + proc))) (defun xwem-program-sentinel (process msg) "Called when PROCESS changed state to MSG." ＠＠ -265,9 +304,8 ＠＠ (substring msg 1 -1)))))) (when xwem-launcher-beep-done (xwem-play-sound 'ready)) - (xwem-message 'info "[%s] %s '%s'" (process-name process) - msg - (mapconcat 'identity (process-command process) " ")) + (xwem-message 'note "Job [%s] %s '%s'" (process-name process) + msg (mapconcat 'identity (process-command process) " ")) (if (null (buffer-name (process-buffer process))) (set-process-buffer process nil) ; WHY? Olin. ＠＠ -282,25 +320,48 ＠＠ (set-buffer-modified-p nil))))) (store-match-data ms)))) +;;;###xwem-autoload +(defun xwem-execute-cmd-expecting (cmd &optional manage-type cl-plist) + "Execute CMD expecting till client will be managed. +MANAGE-TYPE specifies which manage type to use in expectance. +CL-PLIST is properties for expected client. +Return managed client." + (setq cmd (XFreePixmap xdpy xpix-mask) + (X-Win-rem-prop xwin 'ladock-state) + (X-Win-rem-prop xwin 'ladock-action) + (X-Win-rem-prop xwin 'ladock-xgc) + (X-Win-rem-prop xwin 'ladock-xpix) + (X-Win-rem-prop xwin 'ladock-xpix-mask) + (when force (XDestroyWindow xdpy xwin)))) ;;;###autoload -(defun xwem-launch-button-start (xpm-file action &optional xdpy) +(defun xwem-launch-button-start (xpm-file action &optional dockid dockgroup dockalign) "Create new dockapp button with XPM-FILE image and doing ACTION on click. ACTION is cons cell wher car is one of 'elisp or 'cmd and cdr is string. For 'elisp car, cdr is real elisp expression, to evaluate on click. For 'cmd car, cdr is cmd to run on click." - (unless xdpy - (setq xdpy (xwem-dpy))) - (let (xwin xpix xpix-mask ximg xgc) - (setq xwin (XCreateWindow xdpy nil 0 0 xwem-launch-dock-width xwem-launch-dock-height 0 nil nil nil + (setq xwin (XCreateWindow (xwem-dpy) nil + 0 0 + xwem-launch-dock-width + xwem-launch-dock-height + 0 nil nil nil (make-X-Attr :override-redirect t -:backing-store X-WhenMapped -:background-pixel (XAllocNamedColor xdpy (XDefaultColormap xdpy) "gray50") -:border-pixel (XAllocNamedColor xdpy (XDefaultColormap xdpy) "gray80")) +:backing-store X-Always +:background-pixel (XAllocNamedColor (xwem-dpy) (XDefaultColormap (xwem-dpy)) "gray50") +:border-pixel (XAllocNamedColor (xwem-dpy) (XDefaultColormap (xwem-dpy)) "gray80")) )) ;; Create pixmap - (setq xpix (X:xpm-pixmap-from-file xdpy xwin xpm-file)) + (setq xpix (X:xpm-pixmap-from-file (xwem-dpy) xwin (expand-file-name xpm-file xwem-icons-dir))) (setq ximg (X-Pixmap-get-prop xpix 'ximg)) - (setq xpix-mask (X:xpm-pixmap-from-file xdpy xwin xpm-file t)) + (setq xpix-mask (X:xpm-pixmap-from-file (xwem-dpy) xwin (expand-file-name xpm-file xwem-icons-dir) t)) - (setq xgc (XCreateGC xdpy xpix - (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy) + (setq xgc (XCreateGC (xwem-dpy) xpix + (make-X-Gc :dpy (xwem-dpy) :id (X-Dpy-get-id (xwem-dpy)) :clip-x-origin (/ (- xwem-launch-dock-width (X-Image-width ximg)) 2) :clip-y-origin (/ (- xwem-launch-dock-height (X-Image-height ximg)) 2) :clip-mask xpix-mask))) ＠＠ -719,12 +790,11 ＠＠ (X-Win-put-prop xwin 'ladock-xpix xpix) (X-Win-put-prop xwin 'ladock-xpix-mask xpix-mask) - (XSelectInput xdpy xwin (Xmask-or XM-Exposure XM-StructureNotify XM-ButtonPress XM-ButtonRelease)) + (XSelectInput (xwem-dpy) xwin (Xmask-or XM-Exposure XM-StructureNotify XM-ButtonPress XM-ButtonRelease)) (X-Win-EventHandler-add xwin 'xwem-ladock-evhandler nil - (list X-Expose X-ButtonPress X-ButtonRelease X-DestroyNotify)) - - (XTrayInit xdpy xwin) + (list X-Expose X-MapNotify X-ButtonPress X-ButtonRelease X-DestroyNotify)) + (xwem-XTrayInit (xwem-dpy) xwin dockid dockgroup dockalign) xwin)) Index: lisp/xwem-load.el =================================================================== RCS file: lisp/xwem-load.el diff -N lisp/xwem-load.el --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ lisp/xwem-load.el 1 Jan 2005 04:41:14 -0000 ＠＠ -0,0 +1,46 ＠＠ +;;; xwem-load.el --- XWEM functionality loader. + +;; Copyright (C) 2004 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Created: Tue Aug 24 13:48:56 MSD 2004 +;; Keywords: xwem +;; X-CVS: $Id: xwem-load.el,v 1.4 2004/11/29 20:41:52 lg Exp $ + +;; This file is part of XWEM. + +;; XWEM is free software; you can redistribute i - (const :tag "Inverted Copy" X-GXCopyInverted) - (const :tag "Set" X-GXSet)))) - - -(provide 'xwem-macros) - -;;; xwem-macros.el ends here Index: lisp/xwem-main.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-main.el,v retrieving revision 1.16 diff -u -u -r1.16 xwem-main.el --- lisp/xwem-main.el 16 Dec 2004 08:08:09 -0000 1.16 +++ lisp/xwem-main.el 1 Jan 2005 04:41:14 -0000 ＠＠ -5,7 +5,7 ＠＠ ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> ;; Created: 21 Mar 2003 ;; Keywords: xlib, xwem -;; X-CVS: $Id: xwem-main.el,v 1.16 2004/12/16 08:08:09 youngs Exp $ +;; X-CVS: $Id: xwem-main.el,v 1.14 2004/12/05 05:52:29 youngs Exp $ ;; This file is part of XWEM. ＠＠ -50,20 +50,28 ＠＠ ;; "\\|define-xwem-command" ;; "\\)\\s-+%s\$\\s-\\|$\$")) +;; XWEM core: +;; List of files XWEM can't live without. +;; +;; xwem-interactive.el - Interactive stuff +;; xwem-focus.el - Focuses +;; xwem-minibuffer.el - XWEM Minibuffer. +;; xwem-manage.el - Manage database. +;; xwem-keyboard.el - Keyboard stuff. +;; xwem-clients.el - Clients support. +;; xwem-win.el - Windows. +;; xwem-frames.el - Frames support. + ;;; Code: (eval-when-compile - (require 'cl) ;last, intersection etc - (require 'xlib-xwin)) -(eval-when 'load - (load "xwem-keydefs") - (run-hooks 'xwem-load-hook)) -(require 'xwem-root) + (require 'cl)) ;last, intersection etc -;;;###autoload -(defconst xwem-version "xwem(xemacs-package): $Revision: 1.16 $") +(require 'xwem-load) +(require 'xwem-minibuffer) +(require 'xwem-version) (defgroup xwem nil "XWEM window manager." ＠＠ -82,13 +90,37 ＠＠ :type 'directory :group 'xwem) -;;;###autoload +(defcustom xwem-inhibit-startup-message nil + "*Non-nil mean, do not show message after successful XWEM start." +:type 'boolean +:group 'xwem) + (defcustom xwem-debug nil "*Non-nil mean run xlib and xwem in debugging mode." :type 'boolean :group 'xwem) ;;;###autoload +(defcustom xwem-debug-routines + '(xwem-cl xwem-event xwem-frame xwem-misc xwem-root xwem-deffered xwem-tray + ;; and X routines + x-misc x-event x-tray x-error x-record) + "Routines to debug on." +:type '(set (const :tag "XWEM CLients" xwem-cl) + (const :tag "XWEM Events" xwem-event) + (const :tag "XWEM Frames" xwem-frame) + (const :tag "XWEM Misc" xwem-misc) + (const :tag "XWEM Root" xwem-root) + (const :tag "XWEM Deffered calls" xwem-deffered) + (const :tag "XWEM Tray" xwem-tray) + (const :tag "X Misc" x-misc) + (const :tag "X Event" x-event) + (const :tag "X Tray" x-tray) + (const :tag "X Error" x-error) + (const :tag "X RECORD" x-record)) +:group 'xwem) + +;;;###xwem-autoload (defcustom xwem-commands-inhibit-gc t "*Non-nil mean that xwem interactive commands runs without GCing." :type 'boolean ＠＠ -96,24 +128,42 ＠＠ (defcustom xwem-custom-display nil ;"127.0.0.1:2" "*Custom display, mostly for debugging purposes." -:type '(restricted-sexp :match-alternatives (stringp null)) +:type '(choice (const :tag "No custom display" nil) + (const "127.0.0.1:2") + (string :tag "Custom display")) :group 'xwem) +;;;###autoload (defcustom xwem-load-hook nil "*Hooks to call after xwem was load." :type 'hook :group 'xwem-hooks) +;;;###autoload +(defcustom xwem-config-read-hook nil + "*Hooks to call after xwem read config file." +:type 'hook +:group 'xwem-hooks) + +;;;###autoload (defcustom xwem-before-init-wins-hook nil "Hooks called before `xwem-init-wins'." :type 'hook :group 'xwem-hooks) +;;;###autoload (defcustom xwem-after-init-wins-hook nil "Hooks called after `xwem-init-wins'." :type 'hook :group 'xwem-hooks) +;;;###autoload +(defcustom xwem-before-init-hook nil + "Hooks to be run before xwem initialization." +:type 'hook +:group 'xwem-hooks) + +;;;###autoload (defcustom xwem-after-init-hook nil "Hooks to be runned after xwem initialisation." :type 'hook ＠＠ -133,48 +183,37 ＠＠ ;;; Functions -(defun xwem-init-wins () - "Manage all mapped X windows." - (xwem-message 'msg "Initializing X windows ... wait") +(defun xwem-initial-manage () + "Manage all visible clients. +Even clients with override-redirect attribute set can be managed." + (xwem-message 'init "Initializing X windows ...") (run-hooks 'xwem-before-init-wins-hook) (let ((wins (XQueryTree (xwem-dpy) (xwem-rootwin))) - cln-wins attrs) + cln-wins) (setq wins (cdr (cdr (cdr (cdr wins))))) - (X-Dpy-log (xwem-dpy) "IN xwem-init-wins: wins length = %d\n" '(length wins)) + (xwem-debug 'xwem-misc "IN xwem-initial-manage: wins length = %d" '(length wins)) (while wins - (X-Dpy-log (xwem-dpy) "XGetWindowAttr BEGIN in xwem-init-wins\n") - (setq attrs (XGetWindowAttributes (xwem-dpy) (car wins))) - (X-Dpy-log (xwem-dpy) "XGetWindowAttr END in xwem-init-wins, as=%s\n" 'attrs) - - (when (and (not (X-Attr-override-redirect attrs)) - (= (X-Attr-mapstate attrs) X-Viewable) + (when (and (= (X-Attr-mapstate (XGetWindowAttributes (xwem-dpy) (car wins))) X-Viewable) (not (X-Win-get-prop (car wins) 'xwem-frame))) ;; X window visible and not an XWEM frame (setq cln-wins (cons (car wins) cln-wins))) - (setq wins (cdr wins))) ;; Manage all visible clients - (X-Dpy-log (xwem-dpy) "IN xwem-init-wins: managing wins length = %d\n" '(length shcfgl)) - (mapc 'xwem-make-client cln-wins) - ) + (mapc 'xwem-xwin-try-to-manage cln-wins)) (run-hooks 'xwem-after-init-wins-hook) - ) + (xwem-message 'init "Initializing X windows ... done")) (defun xwem-after-window-setup () "Function which will be added to `window-setup-hook'. Called after ~/.emacs file loaded and Emacs X window subsystems initialized." - ;; Create XWEM minibuffer - (xwem-minib-create) - - ;; revert back `menubar-visible-p' specifier - (set-specifier menubar-visible-p xwem-saved-menubar-visible-p) + (run-hooks 'xwem-before-init-hook) (let ((dfen (or xwem-custom-display (getenv "DISPLAY")))) (xwem-init-root ＠＠ -182,36 +221,27 ＠＠ (concat "127.0.0.1" dfen) dfen))) - ;; Select input on root window - (XSelectInput (xwem-dpy) (xwem-rootwin) xwem-root-ev-mask) - (X-Win-EventHandler-add-new (xwem-rootwin) 'xwem-root-events-handler 100) - - (xwem-init-cursors) - (xwem-init-faces) - (xwem-init-events) - (xwem-kbd-init) - (xwem-init-frames) - (xwem-init-win) - (xwem-init-misc) - - ;; Handle all X clients - (xwem-init-wins) + ;; Debugging? yes + (when xwem-debug + (setf (X-Dpy-log-buffer (xwem-dpy)) "*xwem-debug*") + (X-Dpy-set-log-routines (xwem-dpy) xwem-debug-routines)) - (when xwem-strokes-enabled - (xwem-strokes-init)) + (setq xwem-started t) - ;; Initialize xwem system tray - (when xwem-tray-enabled - (xwem-tray-startit (xwem-dpy))) + ;; Create initial frames + (xwem-frames-init) - (setq xwem-started t) + ;; Handle all X clients + (xwem-initial-manage) ;; Now xwem is fully intialized and it is time to run hooks (run-hooks 'xwem-after-init-hook) (XSync (xwem-dpy)) - (xwem-message 'asis (concat (xwem-logo-string) - " succesfully started. Start with `M-x xwem-help RET'.")) + (unless xwem-inhibit-startup-message + (xwem-message 'asis (concat (xwem-logo-string) + " succesfully started. Start with `" + (substitute-command-keys "\\<xwem-global-map>\\[xwem-help-prefix]") "'."))) ) (defcustom xwem-use-presetup t ＠＠ -219,50 +249,83 ＠＠ :type 'boolean :group 'xwem) +;;; Internal variables + ;;;###autoload (defun xwem-init () "Initialization of xwem subsystems." - (require 'xwem-keydefs) ; load keyboard difinitions - (setq inhibit-startup-message t) ; DO NOT REMOVE (when xwem-use-presetup - ;; default presetup - (setf allow-deletion-of-last-visible-frame t) + (setf allow-deletion-of-last-visible-frame t + auto-lower-frame t + + ;; Printing + ;print-level 2 + + ;; Yes, do it + max-specpdl-size 10000 + max-lisp-eval-depth 10000) + + ;; Destroy XEmacs frame when killing dedicated buffer (defadvice kill-buffer (before delete-dedicated-frame activate) "Work around dedicated frame problem." (let ((frame (buffer-dedicated-frame (get-buffer (or (ad-get-arg 0) (current-buffer)))))) (when (framep frame) (delete-frame frame)))) - (xwem-init-tabber)) + + ;; When XEmacs frame deselects, select xwem minibuffer + (add-hook 'deselect-frame-hook + (lambda () + (unless (eq (xwem-minib-frame xwem-minibuffer) + (selected-frame)) + (select-frame (xwem-minib-frame xwem-minibuffer))))) + + ;; Raise/lower minibuffer + (add-hook 'xwem-minibuffer-focusin-hook 'xwem-minib-focusin-autoraise) + (add-hook 'xwem-minibuffer-focusout-hook 'xwem-minib-focusout-autolower) + + ;; Generic managing model + (require 'xwem-clgen) + ;; Use nice tabber for frames + (require 'xwem-tabbing) + ;; Transient-for clients support + (require 'xwem-transient) + ;; Support netwm stuff + (require 'xwem-netwm)) + + ;; Load default keys definitions + (require 'xwem-keydefs) +; (load "xwem-keydefs") ;; read configuration (let ((cfg (expand-file-name "xwemrc.el" xwem-dir))) (if (file-exists-p cfg) (load cfg) - (xwem-message 'warn "Configuration file `%s' does not exists" cfg))) + (xwem-message 'warning "Configuration file `%s' does not exists" cfg))) - ;; Initialize various stuff that does not need display - (xwem-manda-init) + ;; Config just readed, so run hooks + (run-hooks 'xwem-config-read-hook) (add-hook 'window-setup-hook 'xwem-after-window-setup) (add-hook 'kill-emacs-hook 'xwem-fini t) ) -;;;###autoload -(defun xwem-fini () +;;;###autoload(autoload 'xwem-fini "xwem-main" nil t) +(define-xwem-command xwem-fini () "Fini all subsystems." - (xwem-kbd-quit) - (xwem-fini-events) - (xwem-fini-frames) - (xwem-fini-clients) - (when xwem-tray-enabled - (xwem-tray-fini)) - (xwem-fini-root) + (xwem-interactive) +; (xwem-kbd-quit) +; (xwem-frames-fini) +; (xwem-fini-clients) ;; Finally run exit hooks - (run-hooks 'xwem-exit-hook)) + (run-hooks 'xwem-exit-hook) + + ;; And close display + (xwem-fini-root) + ) (provide 'xwem-main) Index: lisp/xwem-manage.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-manage.el,v retrieving revision 1.9 diff -u -u -r1.9 xwem-manage.el --- lisp/xwem-manage.el 16 Dec 2004 08:08:09 -0000 1.9 +++ lisp/xwem-manage.el 1 Jan 2005 04:41:14 -0000 ＠＠ -3,9 +3,10 ＠＠ ;; Copyright (C) 2003 by Free Software Foundation, Inc. ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Richard Klinda <ignotus(a)hixsplit.hu> ;; Created: 21 Mar 2003 ;; Keywords: xlib, xwem -;; X-CVS: $Id: xwem-manage.el,v 1.9 2004/12/16 08:08:09 youngs Exp $ +;; X-CVS: $Id: xwem-manage.el,v 1.8 2004/12/05 22:37:34 lg Exp $ ;; This file is part of XWEM. ＠＠ -28,199 +29,523 ＠＠ ;;; Commentary: -;; +;; Manage database. Manage database is list of manda entries, which +;; are used to decide how to manage certain client. Every manda entry +;; has methods to operate on client. + +;;; Customization: + +;; Only one customisable variable is `xwem-manage-list' is a list +;; where each element is a list in form: + +;; $MANAGE-TYPE CLIENT-PLIST MATCH-SPEC$ + +;; Configuration looks like this: + +;; (setq xwem-manage-list +;; '((fullscreen (ignore-has-input-p t fs-real-size t +;; x-border-width 2 x-border-color "brown4" +;; xwem-focus-mode follow-mouse) +;; (application "rdesktop")) +;; (rooter (dum - 'xwem-cl-iconify 'xwem-cl-refit) - - ;; Manda entry to handle xwem minibuffer - (define-xwem-manda 'xwem-minibuffer (xwem-class-matcher (concat "^" xwem-minibuffer-name "$")) - 0 t - 'xwem-minibuffer-init 'xwem-minib-manage nil nil 'xwem-minib-refit) - - ;; Manda entry to manage special Emacs frames - (define-xwem-manda 'xwem-special (xwem-class-matcher (concat "^" xwem-special-frame-name "$")) - 0 t - 'xwem-special-frame-init 'xwem-special-frame-manage - 'xwem-special-frame-demanage 'xwem-special-frame-iconify) - - ;; Manda entry to manage transient-for(dialogs) windows - (define-xwem-manda 'transient-for (lambda (cl) - (xwem-hints-wm-transient-for (xwem-cl-hints cl))) - 0 t - nil 'xwem-trans-for-manage 'xwem-trans-for-demanage - 'xwem-trans-for-demanage) - - ;; run init functions - (mapc (lambda (manel) - (xwem-manda-fun-run manel 'init)) - xwem-manda-list)) +(defvar xwem-manage-expectances nil + "List of expectances in `xwem-manage-list' format. +The difference from `xwem-manage-list' is that, when matching occurs +in `xwem-manage-expectances', matched entry removed from +`xwem-manage-expectances' list.") + +;;; Internal variables -;; Transient for clients handling -(defcustom xwem-cl-transient-border-color "blue4" - "Border color for transient for windows." -:type '(restricted-sexp :match-alternatives (xwem-misc-colorspec-valid-p)) -:group 'xwem-cl) +;;; Matching -(defcustom xwem-cl-transient-border-width 2 - "Border width in pixels of transient for windows." -:type 'number -:group 'xwem-cl) +;;;###xwem-autoload +(defun xwem-class-match-p (cl cli-regex &optional cln-regex wmname-regex) + "Return non-nil if CL matches CLI-REGEX, CLN-REGEX, WMNAME-REGEX. +CLI-REGEX is regexp to match class instance name. +CLN-REGEX is regexp to match class name. +WMNAME-REGEX is regexp to match CL's WM_NAME." + (let* ((case-fold-search nil) + (hints (xwem-cl-hints cl)) + (class (xwem-hints-wm-class hints)) + (wmname (xwem-hints-wm-name hints))) + (and (or (null cli-regex) + (string-match cli-regex (or (car class) ""))) + (or (null cln-regex) + (string-match cln-regex (or (cdr class) ""))) + (or (null wmname-regex) + (string-match wmname-regex wmname))))) + +(defmacro define-xwem-class-matcher (cli-regex &optional cln-regex wmname-regex) + "Create and return new class matcher function. + +Result of this macro is function which is passed with on argument - CL. + +This function returns non-nil if CL's WM_CLASS matches +CLI-REGEX/CLN-REGEX and CL's WM_NAME matches WMNAME-REGEX. +If CLN-REGEX or WMNAME-REGEX ommited, then \".*\" expression will be +used (i.e. match everything)." + `(lambda (cl) + (xwem-class-match-p cl ,cli-regex ,cln-regex ,wmname-regex))) + +;;;###xwem-autoload +(defun xwem-cl-match-p (cl match-spec) + "Check whether CL matches MATCH-SPEC. +MATCH-SPEC format is a list in form + + (or (TYPE PARAM) ..) + +or + + (and (TYPE PARAM) ..). + +TYPE is one of: + + `class-name' - To match CL's class name (PARAM is regex). + + `class-inst' - To match CL's class instance name (PARAM is regex). -(defun xwem-trans-for-manage (cl &rest others) - "Manage CL that have transient-for flag." - ;; Map window for witch CL is transient and just map and raise CL - ;; over it - (let* ((xwin (xwem-cl-xwin cl)) - (tfwin (xwem-cl-transient-for cl)) - (trc (xwem-find-client tfwin))) - - (XChangeWindowAttributes (xwem-dpy) xwin - (make-X-Attr :border-pixel (XAllocNamedColor - (xwem-dpy) (XDefaultColormap (xwem-dpy)) - xwem-cl-transient-border-color))) - (XSetWindowBorderWidth (xwem-dpy) xwin xwem-cl-transient-border-width) - -; (XMoveWindow (xwem-dpy) xwin (X-Geom-x (xwem-cl-xgeom cl)) (X-Geom-y (xwem-cl-xgeom trc))) - - (XMapWindow (xwem-dpy) (xwem-cl-xwin cl)) - (XRaiseWindow (xwem-dpy) (xwem-cl-xwin cl)) - (XSelectInput (xwem-dpy) (xwem-cl-xwin cl) (Xmask-or XM-StructureNotify)) - - (when (xwem-cl-p trc) - + (let ((fun (get method-name manda-type))) + (when (or fun (setq fun (get method-name 'default))) + (apply fun args)))) + +(defsubst xwem-method-manage (cl) + (xwem-execute-method 'manage (xwem-cl-manage-type cl) cl)) + +(defsubst xwem-method-activate (cl &optional type) + "Activation method for CL. +For TYPE, see documentation for `xwem-activate'." + (xwem-execute-method 'activate (xwem-cl-manage-type cl) cl type)) + +(defsubst xwem-method-deactivate (cl &optional type) + (xwem-execute-method 'deactivate (xwem-cl-manage-type cl) cl type)) + +(defsubst xwem-method-refit (cl) + (xwem-execute-method 'refit (xwem-cl-manage-type cl) cl)) + +(defsubst xwem-method-iconify (cl) + (xwem-execute-method 'iconify (xwem-cl-manage-type cl) cl)) + +(defsubst xwem-method-withdraw (cl) + (xwem-execute-method 'withdraw (xwem-cl-manage-type cl) cl)) + +(defsubst xwem-method-on-kill (cl) + (xwem-execute-method 'on-kill (xwem-cl-manage-type cl) cl)) + +(defsubst xwem-method-on-type-change (cl &optional new-type) + (xwem-execute-method 'on-type-change (xwem-cl-manage-type cl) cl new-type)) + +(defmacro define-xwem-method (method-name manda-type arg-list &optional doc-string &rest forms) + "Define new method METHOD-NAME for MANDA-TYPE. +DOC-STRING is documentation. +FORMS - elisp forms to eval." + (let ((sym (intern (format "xwem:-%s-%s" manda-type method-name)))) + `(eval-and-compile + (defun ,sym ,arg-list + ,doc-string + ,＠forms) + (put (quote ,method-name) (quote ,manda-type) (quote ,sym))))) (provide 'xwem-manage) Index: lisp/xwem-minibuffer.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-minibuffer.el,v retrieving revision 1.10 diff -u -u -r1.10 xwem-minibuffer.el --- lisp/xwem-minibuffer.el 16 Dec 2004 08:08:10 -0000 1.10 +++ lisp/xwem-minibuffer.el 1 Jan 2005 04:41:14 -0000 ＠＠ -5,7 +5,7 ＠＠ ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> ;; Created: Thu Dec 4 15:13:12 MSK 2003 ;; Keywords: xwem, xlib -;; X-CVS: $Id: xwem-minibuffer.el,v 1.10 2004/12/16 08:08:10 youngs Exp $ +;; X-CVS: $Id: xwem-minibuffer.el,v 1.9 2004/12/08 19:11:30 lg Exp $ ;; This file is part of XWEM. ＠＠ -33,41 +33,20 ＠＠ ;; such as messages displaying, system tray, etc. ;;; Code: -(eval-when-compile - (require 'xlib-xwin) - (require 'xwem-misc)) -;;;###autoload -(defstruct xwem-minib - frame ; Emacs frame - (evmask 0.0) ; events to select - cl - - plist ; User defined plist - ) - -;;;###autoload -(defmacro xwem-minib-xgeom (minb) - "Get MINB xgeom." - `(xwem-cl-xgeom (xwem-minib-cl ,minb))) - -(defmacro xwem-minib-xwin (minb) - "Get MINB xwin." - `(xwem-cl-xwin (xwem-minib-cl ,minb))) - -(defsetf xwem-minib-xgeom (minb) (xgeom) - `(setf (xwem-cl-xgeom (xwem-minib-cl ,minb)) ,xgeom)) +(require 'xwem-load) +(require 'xwem-focus) +(require 'xwem-manage) -(defsetf xwem-minib-xwin (minb) (xwin) - `(setf (xwem-cl-xwin (xwem-minib-cl ,minb)) ,xwin)) +(eval-when-compile + (defvar x-emacs-application-class nil)) ;; Customization (defgroup xwem-minibuffer nil "Group to customize XWEM minibuffer." :prefix "xwem-minibuffer-" -:group 'xwem) +:group 'xwem-modes) -;;;###autoload (defcustom xwem-minibuffer-name "xwem-minibuffer" "*Minibuffer name to be used by XWEM." :type 'string ＠＠ -75,10 +54,10 ＠＠ (defcustom xwem-minibuffer-bgcol "gray80" "*Background color to be used in `xwem-minib-frame'." -:type '(restricted-sexp :match-alternatives (xwem-misc-colorspec-valid-p)) +:type 'color :group 'xwem-minibuffer) -(defcustom xwem-minibuffer-font nil +(defcustom xwem-minibuffer-font (face-font-name 'default) "*Font to be used in `xwem-minib-frame'. May be nil or string." :type '(restricted-sexp :match-alternatives ('nil try-font-name)) :group 'xwem-minibuffer) ＠＠ -86,26 +65,75 ＠＠ (defcustom xwem-minibuffer-height 1 "Height of `xwem-minibuffer'." :type 'number +:set (lambda (sym val) + (set sym val) + ;; DO NOT RELY on `set-frame-height' + (let ((frame (and xwem-minibuffer (xwem-minib-frame xwem-minibuffer))) + (mcl (and xwem-minibuffer (xwem-minib-cl xwem-minibuffer)))) + (when (and frame mcl) + (setq st (/ (frame-pixel-height frame) (frame-height frame)) + nsz (* st xwem-minibuffer-height)) + (xwem-client-resize mcl nil nsz)))) +:initialize 'custom-initialize-default :group 'xwem-minibuffer) (defcustom xwem-minibuffer-width 80 "*Usable width of `xwem-minibuffer' frame." :type 'number +:set (lambda (sym val) + (set sym val) + ;; DO NOT RELY on `set-frame-width' + (let ((frame (and xwem-minibuffer (xwem-minib-frame xwem-minibuffer))) + (mcl (and xwem-minibuffer (xwem-minib-cl xwem-minibuffer)))) + (when (and frame mcl) + (setq st (/ (frame-pixel-width frame) (frame-width frame)) + nsz (* st xwem-minibuffer-width)) + (xwem-client-resize mcl nsz nil)))) +:initialize 'custom-initialize-default :group 'xwem-minibuffer) +;;;###xwem-autoload (defcustom xwem-minibuffer-border-width 3 "Border width for `xwem-minibuffer'." :type 'number +:set (lambda (sym val) + (set sym val) + (let ((cl (and xwem-minibuffer (xwem-minib-cl xwem-minibuffer)))) + (when (xwem-cl-p cl) + (xwem-client-set-property cl 'x-border-width xwem-minibuffer-border-width)))) +:initialize 'custom-initialize-default :group 'xwem-minibuffer) (defcustom xwem-minibuffer-passive-border-color "blue3" "Border color for `xwem-minibuffer'." -:type '(restricted-sexp :match-alternatives (xwem-misc-colorspec-valid-p)) +:type 'color +:set (lambda (sym val) + (set sym val) + (let ((cl (and xwem-minibuffer (xwem-minib-cl xwem-minibuffer)))) + (when (xwem-cl-p cl) + (xwem-set-face-foreground + 'x-border-face xwem-minibuffer-passive-border-color nil cl) + (xwem-client-set-property + cl 'x-border-color + (xwem-face-foreground + 'x-border-face (and (xwem-cl-selected-p cl) '(selected)) cl))))) +:initialize 'custom-initialize-default :group 'xwem-minibuffer) (defcustom xwem-minibuffer-active-border-color "blue" "Border color for `xwem-minibuffer' when it focused." -:type '(restricted-sexp :match-alternatives (xwem-misc-colorspec-valid-p)) +:type 'color +:set (lambda (sym val) + (set sym val) + (let ((cl (and xwem-minibuffer (xwem-minib-cl xwem-minibuffer)))) + (when (xwem-cl-p cl) + (xwem-set-face-foreground + 'x-border-face xwem-minibuffer-active-border-color '(selected) cl) + (xwem-client-set-property + cl 'x-border-color + (xwem-face-foreground + 'x-border-face (and (xwem-cl-selected-p cl) '(selected)) cl))))) +:initialize 'custom-initialize-default :group 'xwem-minibuffer) (defcustom xwem-minibuffer-hide-cursor-mode t ＠＠ -115,174 +143,373 ＠＠ :type 'boolean :group 'xwem-minibuffer) -(defcustom xwem-minibuffer-emacs-frames-has-minibuffer nil +(defcustom xwem-minibuffer-hide-show-parameter 0 + "*Animation delay parameter, when hiding/showing xwem minibuffer." +:type 'number +:group 'xwem-minibuffer) + +(defcustom xwem-minibuffer-autohide-timeout nil + "*Non-nil number, mean xwem minibuffer will be autohided, after that many seconds. +NOT YET IMPLEMENTED." +:type '(choice (const :tag "Disabled" nil) + (number :tag "Seconds")) +:set (lambda (sym value) + (set sym value) + (let ((mcl (xwem-minib-cl xwem-minibuffer))) + (when mcl + (if value + (xwem-minibuffer-enable-autohide-timer mcl) + (xwem-activate mcl) + (xwem-minibuffer-disable-autohide-timer mcl))))) +:initialize 'custom-initialize-default +:group 'xwem-minibuffer) + +(defcustom xwem-minibuffer-raise-when-active t + "*Non-nil mean xwem minibuffer is raised when activated." +:type 'boolean +:group 'xwem-minibuffer) + +(defcustom xwem-minibuffer-emacs-frames-has-minibuffer t "*Non-nil mean Emacs frames will have their own minibuffers." :type 'boolean :group 'xwem-minibuffer) -;; Variables +(defcustom xwem-minibuffer-set-default-minibuffer-frame t + "*Non-nil mean that xwem minibuffer frame will be set as `default-minibuffer-frame'." +:type 'boolean +:group 'xwem-minibuffer) + +;;;###xwem-autoload +(defcustom xwem-minibuffer-outer-border-width 1 + "*Outer border width for xwem minibuffer." +:type 'number +:group 'xwem-minibuffer) + +(defcustom xwem-minibuffer-outer-border-color "black" + "*Outer border color for xwem minibuffer." +:type 'color +:group 'xwem-minibuffer) + ;;;###autoload +(defcustom xwem-minibuffer-focusin-hook nil + "*Hooks called when xwem minibuffer got focus." +:type 'hook +:group 'xwem-minibuffer +:group 'xwem-hooks) + +;;;###autoload +(defcustom xwem-minibuffer-focusout-hook nil + "*Hooks called when xwem minibuffer lose focus." +:type 'hook +:group 'xwem-minibuffer +:group 'xwem-hooks) + +(defcustom xwem-minib-resize-exact t + "*If non-`nil', make minibuffer frame exactly the size needed to display all its contents. +Otherwise, the minibuffer frame can temporarily increase in size but +never get smaller while it is active." +:type 'boolean +:group 'xwem-minibuffer) + +(defcustom xwem-minib-specifiers + '((default-toolbar-visible-p . nil) + (menubar-visible-p . nil) + (horizontal-scrollbar-visible-p . nil) + ((face-font 'default) . xwem-minibuffer-font)) + "*Alist of specifiers to be set for xwem minibuffer." +:type '(repeat (cons (sexp :tag "Specifier sexp") + (sexp :tag "Specifier value sexp"))) +:set (lambda (sym value) + (set sym value) + (when (and xwem-minibuffer + (frame-live-p (xwem-minib-frame xwem-minibuffer))) + (xwem-minib-apply-specifiers (xwem-minib-frame xwem-minibuffer)))) +:group 'xwem-minibuffer) + +;;; Internal variables + +;; Variables +;;;###xwem-autoload (defvar xwem-minibuffer nil - "Internal variable, holds `xwem-minibuffer' structure.") + "Default xwem minibuffer.") + +(defvar xwem-minibuffer-map + (let ((map (make-sparse-keymap))) + (define-key map (xwem-kbd "H-g") 'minibuffer-keyboard-quit) + map) + "Keymap used while in xwem.") -(defvar xwem-minib-after-creat-hooks nil - "Hooks to be called after xwem minibuffer created.") +(defun xwem-minib-apply-specifiers (frame) + "Apply `xwem-minib-specifiers' to FRAME." + (mapc (lambda (spc) + (set-specifier (eval (car spc)) (eval (cdr spc)) frame nil 'remove-locale)) + xwem-minib-specifiers)) -;;;###autoload (defun xwem-minib-create () "Create minibuffer that will be used by xwem, or use existen." (let ((mframe (xwem-misc-find-frame xwem-minibuffer-name))) - (when (null mframe) - ;; not yet created - (setq mframe (make-frame minibuffer-frame-plist))) + ;; xwem minib not yet created + (setq mframe (make-frame minibuffer-frame-plist (default-x-device)))) -; (setq default-minibuffer-frame mframe) (setf (xwem-minib-frame xwem-minibuffer) mframe) - ;; XXX - maybe move it to `xwem-minib-after-creat-hooks'? - (when xwem-minibuffer-font - (set-face-property 'default 'font xwem-minibuffer-font - (xwem-minib-frame xwem-minibuffer))) - (when xwem-minibuffer-bgcol - (set-face-property 'default 'background xwem-minibuffer-bgcol - (xwem-minib-frame xwem-minibuffer))) - - ;; TODO: run after create hooks - )) - -;; Manda functions -;;;###autoload -(defun xwem-minib-refit (cl &rest args) - "Refit xwem minibuffer. -CL is non-nil when `xwem-minib-refit' is called internally by xwem-minb-manage. -ARGS is additional arguments." - ;; Adjust geometry a little - (xwem-cl-correct-size-for-size cl (xwem-cl-xgeom cl) 'left 'bottom) - - (let ((mgeom (xwem-minib-xgeom xwem-minibuffer))) - (XMoveResizeWindow (xwem-dpy) (xwem-minib-xwin xwem-minibuffer) - (X-Geom-x mgeom) (X-Geom-y mgeom) (X-Geom-width mgeom) (X-Geom-height mgeom))) - ) - -;;;###autoload -(defun xwem-minibuffer-on-select () - "Function to be used in `select-frame-hook'." - (when (eq (xwem-minib-frame xwem-minibuffer) (selected-frame)) - (set-frame-property (xwem-minib-frame xwem-minibuffer) - 'border-color xwem-minibuffer-active-border-color) - (when xwem-minibuffer-hide-cursor-mode - (set-frame-property (xwem-minib-frame xwem-minibuffer) 'text-cursor-visible-p t)) - )) - -;;;###autoload -(defun xwem-minibuffer-on-deselect () - "Function to be used in `deselect-frame-hook'." - (set-frame-property (xwem-minib-frame xwem-minibuffer) - 'border-color xwem-minibuffer-passive-border-color) - (when xwem-minibuffer-hide-cursor-mode - (set-frame-property (xwem-minib-frame xwem-minibuffer) 'text-cursor-visible-p nil)) - ) + ;; Set specifiers values for MFRAME + (xwem-minib-apply-specifiers mframe) + (redraw-frame mframe t) ; KEEP THIS! + mframe)) + +(defmacro xwem-cl-minibuffer (cl) + `(xwem-cl-get-sys-prop ,cl 'xwem-minibuffer)) +(defsetf xwem-cl-minibuffer (cl) (minib) + `(xwem-cl-put-sys-prop ,cl 'xwem-minibuffer ,minib)) + +;;; Minibuffer focus model +(define-xwem-focus-mode minibuffer (cl action &optional xev) + "Focus mode for xwem minibuffer" + (let ((mb (xwem-cl-minibuffer cl))) + (when (and (xwem-minib-p mb) + (X-Event-p xev) + (not (member (X-Event-xfocus-mode xev) + (list X-NotifyVirtual X-NotifyNonlinearVirtual)))) + (cond ((eq action 'focus-in) + ;; XWEM Minibuffer activates + (run-hook-with-args 'xwem-minibuffer-focusin-hook mb)) + ((eq action 'focus-out) + ;; XWEM Minibuffer deactivates + (run-hook-with-args 'xwem-minibuffer-focusout-hook mb)))))) -;;;###autoload -(defun xwem-minib-manage (cl) - "Manage XWEM's minibuffer client CL." - (setf (xwem-minib-cl xwem-minibuffer) cl) - (setf (xwem-cl-xgeom cl) - (make-X-Geom :x 0 :y (- (X-Geom-height (xwem-rootgeom)) - (X-Geom-height (xwem-cl-xgeom cl))) - :width (X-Geom-width (xwem-rootgeom)) - :height (X-Geom-height (xwem-cl-xgeom cl)) - :border-width 0)) - - ;; Add these hooks instead of tracking X events -; (add-hook 'select-frame-hook 'xwem-minibuffer-on-select) -; (add-hook 'deselect-frame-hook 'xwem-minibuffer-on-deselect) - - ;; Install event handler for xwem minibuffer window. - (setf (xwem-minib-evmask xwem-minibuffer) - (Xmask-or (xwem-minib-evmask xwem-minibuffer) XM-FocusChange)) - (XSelectInput (xwem-dpy) (xwem-minib-xwin xwem-minibuffer) (xwem-minib-evmask xwem-minibuffer)) - (X-Win-EventHandler-add-new (xwem-minib-xwin xwem-minibuffer) 'xwem-minib-events-handler) - - ;; Install grabs - (xwem-kbd-install-grab xwem-global-map (xwem-minib-xwin xwem-minibuffer)) - - (xwem-minib-refit cl)) +;;;; ---- XWEM Minibuffer manage type ---- +(defun xwem-minibuffer-client-p (cl) + "Return non-nil if CL is minibuffer client." + (xwem-cl-minibuffer cl)) + +(defun xwem-manage-minibuffer (cl) + "Manage method for xwem minibuffers." + (let* ((xgeom (make-X-Geom :x 0 ; XXX +:y (X-Geom-height (xwem-rootgeom)) +:width (- (X-Geom-width (xwem-rootgeom)) + xwem-minibuffer-outer-border-width + xwem-minibuffer-outer-border-width) +:height (X-Geom-height-with-borders (xwem-cl-xgeom cl)) +:border-width xwem-minibuffer-outer-border-width)) + (minib (make-xwem-minib +:frame (xwem-misc-find-emacs-frame cl) +:cl cl +:xgeom xgeom))) + + (setf (xwem-minib-xwin minib) + (XCreateWindow (xwem-dpy) nil + (X-Geom-x xgeom) + (X-Geom-y xgeom) + (X-Geom-width xgeom) + (X-Geom-height xgeom) + (X-Geom-border-width xgeom) + nil nil nil + (make-X-Attr :override-redirect t +:background-pixel + (XAllocNamedColor + (xwem-dpy) (XDefaultColormap (xwem-dpy)) + xwem-minibuffer-bgcol)))) + ;; Setup window a little + (when xwem-minibuffer-outer-border-color + (XSetWindowBorder (xwem-dpy) (xwem-minib-xwin minib) + (XAllocNamedColor (xwem-dpy) (XDefaultColormap (xwem-dpy)) + xwem-minibuffer-outer-border-color))) + + ;; Save CL's minibuffer + (setf (xwem-cl-minibuffer cl) minib) + + ;; Setup x-border-face for minibuffer + (xwem-set-face-foreground 'x-border-face xwem-minibuffer-active-border-color + '(selected) cl) + (xwem-set-face-foreground 'x-border-face xwem-minibuffer-passive-border-color + nil cl) + (xwem-client-set-property cl 'x-border-width xwem-minibuffer-border-width) + (xwem-client-set-property cl 'x-border-color + (xwem-face-foreground 'x-border-face + (and (xwem-cl-selected-p cl) '(selected)) cl)) + + ;; Reparent xwem minib client to parent + ;; XXX XXX + (setf (X-Geom-x (xwem-cl-xgeom cl)) 0) + (setf (X-Geom-y (xwem-cl-xgeom cl)) 0) + (XReparentWindow (xwem-dpy) (xwem-minib-cl-xwin minib) + (xwem-minib-xwin minib) 0 0) + + ;; Set minibuffer focus model + (xwem-focus-mode-set cl 'minibuffer) + + ;; Install minibuffer local keymap + (xwem-use-local-map xwem-minibuffer-map cl) + + ;; Finnally refit cl and map parent + (xwem-refit cl) + (XMapWindow (xwem-dpy) (xwem-minib-xwin minib)) + + ;; Set default minibuffer, if not already set + (unless (xwem-cl-p (xwem-minib-cl xwem-minibuffer)) + (setq xwem-minibuffer minib) + (when xwem-minibuffer-set-default-minibuffer-frame + (setq default-minibuffer-frame (xwem-minib-frame xwem-minibuffer)))) + + ;; Now activate minibuffer + (xwem-activate cl))) + +(define-xwem-deffered xwem-minib-apply-pxgeom (minib) + "Apply MINIB's parent geometry to life." + (let ((pxgeom (xwem-minib-xgeom minib))) + (XMoveResizeWindow (xwem-dpy) + (xwem-minib-xwin minib) + (X-Geom-x pxgeom) + (X-Geom-y pxgeom) + (X-Geom-width pxgeom) + (X-Geom-height pxgeom)))) + +;; +;; Some bug here: + +;; Do `(xwem-refit (xwem-minib-cl xwem-minibuffer))' - xwem minib +;; will change its width. (ONLY when xwem-minib-resize-mode is on) + +(defun xwem-refit-minibuffer (cl) + "Refit xwem minibuffer client CL." + (xwem-debug 'xwem-minib "Refiting ..") + + (let ((cl-xgeom (xwem-cl-xgeom cl)) + (pxgeom (xwem-minib-xgeom (xwem-cl-minibuffer cl)))) + + ;; Adjust geometry a little to fill into xwem-minib-xwin and apply + ;; changes to life + (xwem-cl-apply-new-xgeom cl) + (xwem-cl-correct-size-for-size cl + (make-X-Geom :x 0 :y 0 +:width (X-Geom-width-with-borders cl-xgeom) +:height (X-Geom-height-with-borders cl-xgeom) +:border-width (X-Geom-border-width cl-xgeom)) + 'left 'top) + (xwem-cl-apply-xgeom cl) + + ;; Check maybe parent need to be resized/moved? + (unless (= (X-Geom-height-with-borders cl-xgeom) + (X-Geom-height pxgeom)) + (decf (X-Geom-y pxgeom) + (- (X-Geom-height-with-borders cl-xgeom) + (X-Geom-height pxgeom))) + (setf (X-Geom-height pxgeom) + (X-Geom-height-with-borders cl-xgeom)) + (xwem-minib-apply-pxgeom (xwem-cl-minibuffer cl))))) + +(defun xwem-minibuffer-autohide-timer (cl) + (when (and (numberp xwem-minibuffer-autohide-timeout) + +;; X-CVS: $Id: xwem-misc.el,v 1.15 2004/12/08 19:11:30 lg Exp $ ;; This file is part of XWEM. ＠＠ -40,47 +40,205 ＠＠ ;;; Code: ;; -(require 'xlib-xwin) +(require 'xlib-xlib) +(require 'xlib-img) + +(require 'xwem-load) (eval-and-compile + (defvar iswitchb-buflist nil) ; shutup compiler + (defvar x-emacs-application-class nil) + (autoload 'iswitchb-read-buffer "iswitchb") ; shutup compiler + (defvar elp-function-list nil) ; shut up compiler (autoload 'elp-instrument-list "elp" nil t) (autoload 'elp-results "elp" nil t) (autoload 'calc-eval "calc")) +(defmacro xwem-gc-function-choice () + "Return choice dialog to select GC function." + `(`(choice (const :tag "None" nil) + (const :tag "Clear" X-GXClear) + (const :tag "And" X-GXAnd) + (const :tag "Reverse And" X-GXAndReverse) + (const :tag "Inverted And" X-GXAndInverted) + (const :tag "Xor" X-GXXor) + (const :tag "Or" X-GXOr) + (const :tag "Reverse Or" X-GXOrReverse) + (const :tag "Inverted Or" X-GXOrInverted) + (const :tag "Nor" X-GXNor) + (const :tag "Equive" X-GXEquiv) + (const :tag "Invert" X-GXInvert) + (const :tag "Copy" X-GXCopy) + (const :tag "Inverted Copy" X-GXCopyInverted) + (const :tag "Set" X-GXSet)))) + +(defmacro xwem-cursor-shape-choice () + "Return choice dialog to select cursor shape." + `(`(choice (const :tag "Left" X-XC-left_ptr) + (const :tag "Left w/mask" (X-XC-left_ptr)) + (const :tag "Right" X-XC-right_ptr ) + (const :tag "Right w/mask" (X-XC-right_ptr )) + (const :tag "Cross" X-XC-cross) + (const :tag "Cross w/mask" (X-XC-cross)) + (const :tag "Reverse Cross" X-XC-cross_reverse) + (const :tag "Reverse Cross w/mask" (X-XC-cross_reverse)) + (const :tag "Crosshair" X-XC-crosshair) + (const :tag "Crosshair w/mask" (X-XC-crosshair)) + (const :tag "Daimond cross" X-XC-diamond_cross) + (const :tag "Daimond cross w/mask" (X-XC-diamond_cross)) + ;; TODO: add more, take a look at Cursors section in + ;; xlib-const.el + (const :tag "Dot" X-XC-dot) + (const :tag "Dot w/mask" (X-XC-dot)) + (const :tag "Square Icon" X-XC-icon) + (const :tag "Square Icon w/mask" (X-XC-icon)) + (const :tag "Fluer" X-XC-fleur) + (const :tag "Fluer w/mask" (X-XC-fleur)) + + ;; Arrows + (const :tag "Down Arrow" X-XC-sb_down_arrow) + (const :tag "Down Arrow w/mask" (X-XC-sb_down_arrow)) + (const :tag "Question Arrow" X-XC-question_arrow) + (const :tag "Question Arrow w/mask" (X-XC-question_arrow)) + + (const :tag "TopLeft Arrow" X-XC-top_left_arrow) + (const :tag "TopLeft Arrow w/mask" (X-XC-top_left_arrow)) + (const :tag "Draft large" X-XC-draft_large) + (const :tag "Draft large w/mask" (X-XC-draft_large)) + (const :tag "Draft small" X-XC-draft_small) + (const :tag "Draft small w/mask" (X-XC-draft_small)) + + ;; Corners + (const :tag "Bottom Left corner" X-XC-bottom_left_corner) + (const :tag "Bottom Left corner w/mask" (X-XC-bottom_left_corner)) + (const :tag "Bottom Right corner" X-XC-bottom_right_corner) + (const :tag "Bottom Right corner w/mask" (X-XC-bottom_right_corner)) + (const :tag "Top Left corner" X-XC-top_left_corner) + (const :tag "Top Left corner w/mask" (X-XC-top_left_corner)) + (const :tag "Top Right corner" X-XC-top_right_corner) + (const :tag "Top Right corner w/mask" (X-XC-top_right_corner)) + + (const :tag "Gumby guy" X-XC-gumby) + (const :tag "Gumby guy w/mask" (X-XC-gumby)) + ))) + +(defmacro xwem-cus-set-cursor-foreground (cursor) + "Generate :set function to change CURSOR's foreground" + `(lambda (sym val) + (set sym val) + (when ,cursor + (xwem-cursor-recolorize ,cursor val)))) + +(defmacro xwem-cus-set-cursor-background (cursor) + "Generate :set function to change CURSOR's background" + `(lambda (sym val) + (set sym val) + (when ,cursor + (xwem-cursor-recolorize ,cursor nil val)))) + +(defmacro xwem-cus-set-cursor-shape (cursor &optional xwin) + "Generate :set function to change CURSOR's background" + `(lambda (sym val) + (set sym val) + (when ,cursor + (let ((ncur (copy-X-Cursor ,cursor)) + src-char msk-char) + (cond ((listp val) + (setq src-char (eval (car val)) + msk-char (1+ src-char))) + (t (setq src-char (eval val) + msk-char src-char))) + (setf (X-Cursor-id ncur) (X-Dpy-get-id (X-Cursor-dpy ,cursor))) + (setf (X-Cursor-src-char ncur) src-char) + (setf (X-Cursor-msk-char ncur) msk-char) + (XFreeCursor (X-Cursor-dpy ,cursor) ,cursor) + (XCreateGlyphCursor (X-Cursor-dpy ncur) ncur) + (setq ,cursor ncur))) + (if (listp ,xwin) + (mapc (lambda (xw) + (when (and xw (X-Win-p xw)) + (XSetWindowCursor (X-Win-dpy xw) xw ,cursor))) + ,xwin) + (when (and ,xwin (X-Win-p ,xwin)) + (XSetWindowCursor (X-Win-dpy ,xwin) ,xwin ,cursor))))) + (define-error 'xwem-internal-error "Internal XWEM error.") (defgroup xwem-misc nil "Group to customize miscellaneous options." -:prefix "xwem-misc-" +:prefix "xwem-" :group 'xwem) (defcustom xwem-messages-buffer-name " *xwem-messages*" "*Buffer name for xwem messages." :type 'string -:group 'xwem) +:group 'xwem-misc) (defcustom xwem-messages-buffer-lines 1000 "*Maximum lines in xwem messages buffer." :type 'number -:group 'xwem) +:group 'xwem-misc) + +(defconst xwem-messages-builtin-labels + '(info note error warning alarm todo prompt progress nolog asis) + "List of builtin labels.") + +;;;###autoload +(defcustom xwem-messages-ignore-labels + '(prompt progress nolog) + "*List of message labels to ignore putting them into xwem message log buffer." +:type '(repeat (choice (symbol :tag "Custom label") + (const :tag "Alarm" alarm) + (const :tag "Error" error) + (const :tag "Warning" warning) + (const :tag "Info" info) + (const :tag "Note" note) + (const :tag "TODO" todo) + (const :tag "Prompt" prompt) + (const :tag "Progress" progress) + (const :tag "NoLog" nolog))) +:group 'xwem-misc) -(defcustom xwem-misc-functions-to-profile - '(X-Create-message - X-Dpy-parse-message - string->int - string4->int - X-Dpy-grab-bytes - X-Dpy-filter - X-Dpy-parse-message-guess - accept-process-output - X-Text-width - X-Text-height - XImagePut) +(defcustom xwem-messages-beeps-alist + '((warning . warning) + (error . error) + (alarm . alarm)) + "*Alist in form (MSG-LABEL . SOUND). +Where SOUND is element of `xwem-sound-alist'." +:type `(repeat (cons (symbol :tag "Message Label") + ,(nconc '(choice) + (mapcar (lambda (ss) + (list 'const :tag (symbol-name (car ss)) (car ss))) + xwem-sound-alist) + '((symbol :tag "Sound type"))))) +:group 'xwem-misc) + +(defcustom xwem-messages-label-prefixes + '((warning "Warning" (red)) + (error "Erorr" (red bold)) + (alarm "Alarm" (red bold italic)) + (note "Note" (yellow)) + (info "Info" (default)) + (todo "TODO" (bold))) + "List of prefixes for certain labels. +CAR is label." +:type '(list (symbol :tag "Message label") string (repeat face)) +:group 'xwem-misc) + +(defcustom xwem-misc-functions-to-profile nil "List of functions to profile using xwem profiler." -:type '(repeat function) +:type (list 'repeat (cons 'choice + (delq nil + (mapcar (lambda (fun) + (and (symbolp fun) + (fboundp fun) + (> (length (symbol-name fun)) 4) + (string= "xwem" (substring (symbol-name fun) 0 4)) + (list 'function-item fun))) + obarray)))) :group 'xwem-misc) ;;; Cursors ＠＠ -93,137 +251,219 ＠＠ (defcustom xwem-cursor-default-shape 'X-XC-left_ptr "*Shape of default xwem cursor." :type (xwem-cursor-shape-choice) +:set (xwem-cus-set-cursor-shape xwem-cursor-default) +:initialize 'custom-initialize-default :group 'xwem-cursor) (defcustom xwem-cursor-default-foreground-color "#002800" "*Default cursor's foreground color." -:type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) +:type 'color +:set (xwem-cus-set-cursor-foreground xwem-cursor-default) +:initialize 'custom-initialize-default :group 'xwem-cursor) (defcustom xwem-cursor-default-background-color "#000000" "*Default cursor's background color." -:type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) +:type 'color +:set (xwem-cus-set-cursor-background xwem-cursor-default) +:initialize 'custom-initialize-default :group 'xwem-cursor) ;; wait cursor (defcustom xwem-cursor-wait-shape 'X-XC-icon "*Shape of cursor, when XWEM wait for something." :type (xwem-cursor-shape-choice) +:set (xwem-cus-set-cursor-shape xwem-cursor-wait) +:initialize 'custom-initialize-default :group 'xwem-cursor) (defcustom xwem-cursor-wait-foreground-color "#ea0000" "*Cursor's foreground color when XWEM wait for something." -:type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) +:type 'color +:set (xwem-cus-set-cursor-foreground xwem-cursor-wait) +:initialize 'custom-initialize-default :group 'xwem-cursor) -(defcustom xwem-cursor-wait-background-color nil;"#280000" +(defcustom xwem-cursor-wait-background-color "#280000" "*Cursor's background color when XWEM waiit for something." -:type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) +:type 'color +:set (xwem-cus-set-cursor-background xwem-cursor-wait) +:initialize 'custom-initialize-default :group 'xwem-cursor) ;; move cursor (defcustom xwem-cursor-move-shape 'X-XC-fleur "*Shape of cursor, when moving something." :type (xwem-cursor-shape-choice) +:set (xwem-cus-set-cursor-shape xwem-cursor-move) +:initialize 'custom-initialize-default :group 'xwem-cursor) (defcustom xwem-cursor-move-foreground-color "#777777" "*Cursor's foreground color when moving something." -:type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) +:type 'color +:set (xwem-cus-set-cursor-foreground xwem-cursor-move) +:initialize 'custom-initialize-default :group 'xwem-cursor) -(defcustom xwem-cursor-move-background-color nil;"#280000" +(defcustom xwem-cursor-move-background-color "#280000" "*Cursor's background color when moving something." -:type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) +:type 'color +:set (xwem-cus-set-cursor-background xwem-cursor-move) +:initialize 'custom-initialize-default +:group 'xwem-cursor) + +;; Resize cursor +(defcustom xwem-cursor-resize-shape 'X-XC-sizing + "*Shape of cursor, when resizing something." +:type (xwem-cursor-shape-choice) +:set (xwem-cus-set-cursor-shape xwem-cursor-resize) +:initialize 'custom-initialize-default +:group 'xwem-cursor) + +(defcustom xwem-cursor-resize-foreground-color "#777777" + "*Cursor's foreground color when resizing something." +:type 'color +:set (xwem-cus-set-cursor-foreground xwem-cursor-resize) +:initialize 'custom-initialize-default +:group 'xwem-cursor) + +(defcustom xwem-cursor-resize-background-color "#280000" + "*Cursor's background color when resizing something." +:type 'color +:set (xwem-cus-set-cursor-background xwem-cursor-resize) +:initialize 'custom-initialize-default :group 'xwem-cursor) ;; quote cursor (defcustom xwem-cursor-quote-shape 'X-XC-sb_down_arrow "*Shape of cursor, when XWEM quoting keyboard or mouse." :type (xwem-cursor-shape-choice) +:set (xwem-cus-set-cursor-shape xwem-cursor-quote) +:initialize 'custom-initialize-default :group 'xwem-cursor) (defcustom xwem-cursor-quote-foreground-color "#0000BB" "*Cursor's foreground color when XWEM quoting keyboard/mouse." -:type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) +:type 'color +:set (xwem-cus-set-cursor-foreground xwem-cursor-quote) +:initialize 'custom-initialize-default :group 'xwem-cursor) (defcustom xwem-cursor-quote-background-color "#000099" "*Cursor's background color when XWEM quoting keyboard/mouse." -:type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) +:type 'color +:set (xwem-cus-set-cursor-background xwem-cursor-quote) +:initialize 'custom-initialize-default :group 'xwem-cursor) ;; help cursor -(defcustom xwem-cursor-help-shape 'X-XC-question_arrow +(defcustom xwem-cursor-help-shape '(X-XC-question_arrow) "*Shape of cursor, when getting help with XWEM." :type (xwem-cursor-shape-choice) +:set (xwem-cus-set-cursor-shape xwem-cursor-help) +:initialize 'custom-initialize-default :group 'xwem-cursor) (defcustom xwem-cursor-help-foreground-color "#00BB00" "*Cursor's foreground color when quering XWEM for help." -:type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) +:type 'color +:set (xwem-cus-set-cursor-foreground xwem-cursor-help) +:initialize 'custom-initialize-default :group 'xwem-cursor) (defcustom xwem-cursor-help-background-color "#009900" "*Cursor's background color when quering XWEM for help." -:type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) +:type 'color +:set (xwem-cus-set-cursor-background xwem-cursor-help) +:initialize 'custom-initialize-default :group 'xwem-cursor) +;;; Internal variables + ;; cursor storages -;;;###autoload (defvar xwem-cursor-fnt nil "Font for \"cursor\" series.") -;;;###autoload (defvar xwem-cursor-default nil "Default cursor.") -;;;###autoload (defvar xwem-cursor-left nil "Left cursor.") -;;;###autoload (defvar xwem-cursor-right nil "Right cursor.") -;;;###autoload (defvar xwem-cursor-wait nil "Cursor when we are wait.") -;;;###autoload (defvar xwem-cursor-drag nil "Cursor when we drag. Drug is a bad idea.") -;;;###autoload (defvar xwem-cursor-move nil "Cursor when we move something.") -;;;###autoload +(defvar xwem-cursor-rsz-vert nil) +(defvar xwem-cursor-rsz-horz nil) (defvar xwem-cursor-resize nil "Cursor when we resize.") -;;;###autoload (defvar xwem-cursor-quote nil "Cursor when quoting key.") -;;;###autoload (defvar xwem-cursor-help nil "Cursor when in help mode.") +(defvar xwem-misc-mask-pixmap nil "Pixmap with depth 1.") +;;;###xwem-autoload +(defvar xwem-misc-mask-fgc nil "X-Gc with foreground 1.0 destination drawable has depth 1.") +;;;###xwem-autoload +(defvar xwem-misc-mask-bgc nil "X-Gc with foreground 1.0 destination drawable has depth 1.") + +;;; Macros +(defmacro xwem-xwin-frame (xwin) + "Return XWEM frame, which X window is XWIN." + `(X-Win-get-prop ,xwin 'xwem-frame)) + +;;;###xwem-autoload +(defmacro xwem-xwin-cl (xwin) + "Return CL, which X window is XWIN." + `(X-Win-get-prop ,xwin 'xwem-cl)) +(defsetf xwem-xwin-cl (xwin) (cl) + `(if (not ,cl) + (X-Win-rem-prop ,xwin 'xwem-cl) + (X-Win-put-prop ,xwin 'xwem-cl ,cl))) + ;;; Functions -(defsubst xwem-misc-colorspec->rgb-vector (colspec) +;;;###xwem-autoload +(defun xwem-misc-colorspec->rgb-vector (colspec) "Conver color specification COLSPEC to internal representation. COLSPEC maybe in form: #RRGGBB or name like 'green4'." (vconcat (color-instance-rgb-components (make-color-instance colspec)))) -(defsubst xwem-misc-colorspec->rgb-vector-safe (colspec &optional defret) +;;;###xwem-autoload +(defun xwem-misc-colorspec->rgb-vector-safe (colspec &optional defret) "Validate COLSPEC to be color specification in safe manner. Return DEFRET or [0 0 0] if there was error." (condition-case nil (xwem-misc-colorspec->rgb-vector colspec) (t (or defret [0 0 0])))) -(defsubst xwem-misc-colorspec-valid-p (colspec) +;;;###xwem-autoload +(defun xwem-misc-colorspec-valid-p (colspec) "Return non-nil if COLSPEC is valid color specification. Valid colorspecification is spec in form: #RRGGBB or name like 'green4'." (condition-case nil (xwem-misc-colorspec->rgb-vector colspec) (t nil))) -;;;###autoload +;;;###xwem-autoload +(defun xwem-make-color (colorspec &optional cmap) + "Create X-Color according to COLORSPEC." + (let ((ccol (xwem-misc-colorspec->rgb-vector-safe colorspec [0 0 0]))) + (make-X-Color :red (aref ccol 0) :green (aref ccol 1) :blue (aref ccol 2)))) + +;;;###xwem-autoload (defun xwem-make-cursor (type &optional fgcol bgcol) "Make new cursor of TYPE and store it in WHERE-STORE. BGCOL maybe nil, that mean masking will not be done." + (xwem-cursors-init) ; make sure cursor font loaded + (let ((fgc (xwem-misc-colorspec->rgb-vector-safe fgcol [0 0 0])) (bgc (xwem-misc-colorspec->rgb-vector-safe bgcol 'invalid-bgcol)) - cursor) + src-char msk-char cursor) + (cond ((listp type) + (setq src-char (eval (car type)) + msk-char (1+ src-char))) + (t (setq src-char (eval type) + msk-char src-char))) (setq cursor (make-X-Cursor :dpy (xwem-dpy) :id (X-Dpy-get-id (xwem-dpy)) :source xwem-cursor-fnt :mask xwem-cursor-fnt -:src-char type -:msk-char (+ (if (eq bgc 'invalid-bgcol) 0 1) type) +:src-char src-char +:msk-char msk-char :fgred (aref fgc 0) :fggreen (aref fgc 1) :fgblue (aref fgc 2))) ＠＠ -235,48 +475,60 ＠＠ (XCreateGlyphCursor (xwem-dpy) cursor) cursor)) -;;;###autoload -(defun xwem-init-cursors () - "Initialize cursors." - ;; Make cursors - (xwem-message 'msg "Initializing cursors ... wait") - - (setq xwem-cursor-fnt (make-X-Font :dpy (xwem-dpy) :id (X-Dpy-get-id (xwem-dpy)) -:name "cursor")) - (XOpenFont (xwem-dpy) xwem-cursor-fnt) +;;;###xwem-autoload +(defun xwem-cursor-recolorize (cursor new-fg &optional new-bg) + "Recolorize CURSOR to use NEW-FG foreground and NEW-BG background." + (let ((fgc (xwem-misc-colorspec->rgb-vector-safe + new-fg (vector (X-Cursor-fgred cursor) + (X-Cursor-fggreen cursor) + (X-Cursor-fgblue cursor)))) + (bgc (xwem-misc-colorspec->rgb-vector-safe + new-bg (vector (X-Cursor-bgred cursor) + (X-Cursor-bggreen cursor) + (X-Cursor-bgblue cursor))))) + (XRecolorCursor (xwem-dpy) cursor + (aref fgc 0) (aref fgc 1) (aref fgc 2) + (aref bgc 0) (aref bgc 1) (aref bgc 2)))) - (setq xwem-cursor-default (xwem-make-cursor (eval xwem-cursor-default-shape) +(defun xwem-cursors-init () + "Initialize cursors." + (unless xwem-cursor-fnt + ;; Make cursors + (xwem-message 'init "Initializing cursors ...") + + (setq xwem-cursor-fnt (make-X-Font :dpy (xwem-dpy) :id (X-Dpy-get-id (xwem-dpy)) +:name "cursor")) + (XOpenFont (xwem-dpy) xwem-cursor-fnt) + + (setq xwem-cursor-default (xwem-make-cursor xwem-cursor-default-shape + xwem-cursor-default-foreground-color + xwem-cursor-default-background-color) + xwem-cursor-left (xwem-make-cursor X-XC-left_ptr + xwem-cursor-default-foreground-color + + "Clear xwem minibuffer's buffer." + (clear-message label (xwem-minib-frame xwem-minibuffer))) + +(defun xwem-message-insert (label msg &optional append-p) + "Insert message MSG into xwem minibuffer's buffer." + ;; Workaround XEmacs ''feature''. When minibuffer is activated, + ;; and someone uses echo are, XEmacs will wait 2 seconds, so we + ;; will got lag! (see DEFUN `command-loop-1' in cmdloop.c) --lg + ;; + ;; However in newer XEmacsen there is + ;; `minibuffer-echo-wait-function' variable, which controls + ;; behaviour. --lg + (when (zerop (minibuffer-depth)) + ;; Activate minibuffer, if not ignoring this label + (when (and xwem-minibuffer + (xwem-minib-cl xwem-minibuffer) + (not (memq label xwem-messages-ignore-labels))) + (xwem-activate (xwem-minib-cl xwem-minibuffer))) + (add-to-list 'log-message-ignore-labels label) ; avoid logging in *Messages* + (if append-p + (append-message label msg (and xwem-minibuffer (xwem-minib-frame xwem-minibuffer))) + (display-message label msg (and xwem-minibuffer (xwem-minib-frame xwem-minibuffer)))))) + +(defun xwem-message-label-prefix (label) + "Return prefix string, according to LABEL. +Return nil if no prefix required for label." + (let ((lp (assq label xwem-messages-label-prefixes))) + (when lp + (concat "XWEM" (if (and (stringp (cadr lp)) + (not (zerop (length (cadr lp))))) + "-" "") + (funcall 'xwem-str-with-faces (cadr lp) (caddr lp)) + ": ")))) + +(defun xwem-message-maybe-beep (label) + "If LABEL is beepable, then beep." + ;; Beep if needed + (let ((snd (assq label xwem-messages-beeps-alist))) + (when snd + (xwem-play-sound (cdr snd))))) + +(defun xwem-message-1 (label fmt append-p &rest args) + (let* ((print-level 3) ; XXX limit print level + (msg (if (eq label 'asis) fmt (apply 'format fmt args))) + (lp (xwem-message-label-prefix label))) + (when lp + (setq msg (concat lp msg))) + (xwem-message-log label msg) + (xwem-message-maybe-beep label) + + (xwem-message-insert label msg append-p))) + +(defun xwem-message-append (label fmt &rest args) + "Append message of LABEL type. +Message formatted using FTM and ARGS." + (apply 'xwem-message-1 label fmt t args)) + +;;;###xwem-autoload +(defun xwem-message (label fmt &rest args) + "Display xwem message of TYPE using FMT format." + (apply 'xwem-message-1 label fmt nil args)) -;;;###autoload(autoload 'xwem-show-message-log "xwem-misc") +;;;###autoload(autoload 'xwem-show-message-log "xwem-misc" nil t) (define-xwem-command xwem-show-message-log (arg) "Show `xwem-messages-buffer-name'. If prefix ARG is given, than behaviour is undefined." ＠＠ -519,10 +845,9 ＠＠ (with-current-buffer mbuf (setq mode-name "XWEM-log") (local-set-key (kbd "q") 'delete-frame) - (message "Press `q' to eliminate buffer.") + (xwem-message 'msg "Press `q' to eliminate buffer.") ))) -;;;###autoload (defun xwem-list-to-string (list len) "Convert LIST of characterters to string with length LEN." (let ((rstr "")) ＠＠ -533,15 +858,15 ＠＠ rstr)) ;;;; Misc commands. -;;;###autoload(autoload 'xwem-ignore-command "xwem-misc") -(define-xwem-command xwem-ignore-command () +;;;###autoload(autoload 'xwem-ignore-command "xwem-misc" nil t) +(define-xwem-command xwem-ignore-command (&rest args) "Generic ignore command." (xwem-interactive)) (defvar xwem-read-expression-history nil "*History of expressions evaled using `xwem-eval-expression'.") -;;;###autoload(autoload 'xwem-eval-expression "xwem-misc") +;;;###autoload(autoload 'xwem-eval-expression "xwem-misc" nil t) (define-xwem-command xwem-eval-expression (expr &optional arg) "Eval Lisp expression interactively. When used with prefix ARG, then insert the result into selected client." ＠＠ -557,21 +882,20 ＠＠ (if arg (xwem-key-send-ekeys (prin1-to-string (car values))) - (xwem-message 'info "%S => %S" expr (c -;;;###autoload (defun xwem-misc-linesp-height (linesp) "Return height of line spec LINESP." (apply 'max (mapcar (lambda (el) ＠＠ -777,7 +1105,6 ＠＠ (cdr el))) linesp))) -;;;###autoload (defun xwem-misc-linesp-show (xwin x y linesp &optional type default-background) "In x window XWIN at X and Y coordinates show line spec LINESP. TYPE is one of XImageString or XDrawString, default is XImageString." ＠＠ -796,7 +1123,6 ＠＠ (X-Gc-font (xwem-face-get-gc (car el))) (cdr el))))) linesp))) -;;;###autoload (defun xwem-misc-textsp-show (xwin x y textsp &optional type default-background) "In x window XWIN at X and Y coordinates show text spec TEXTSP. TYPE is one of XImageString or XDrawString, default is XImageString. ＠＠ -804,38 +1130,46 ＠＠ that have different than DEFAULT-BACKGROUND baground color are drawed using XImageString." (let ((yoff 0)) - (X-Dpy-send-excursion (X-Win-dpy xwin) - (mapc (lambda (el) - (xwem-misc-linesp-show xwin x (+ y yoff) el type default-background) - (setq yoff (+ yoff (xwem-misc-linesp-height el)))) - textsp) - ))) + (mapc (lambda (el) + (xwem-misc-linesp-show xwin x (+ y yoff) el type default-background) + (setq yoff (+ yoff (xwem-misc-linesp-height el)))) + textsp) + )) ;;; Outlining -(defface xwem-misc-outline-face1 - `((t (:foreground "white" :background "black" :function X-GXXor :subwindow-mode X-IncludeInferiors :line-width 4))) +(define-xwem-face xwem-misc-outline-face1 + `((t (:foreground "white" :background "black" +:function X-GXXor :subwindow-mode X-IncludeInferiors +:line-width 4))) "Face used to outline something." +:group 'xwem-misc :group 'xwem-faces) -(defface xwem-misc-outline-face2 - `((t (:foreground "white" :background "black" :function X-GXXor :subwindow-mode X-IncludeInferiors :line-width 2))) +(define-xwem-face xwem-misc-outline-face2 + `((t (:foreground "white" :background "black" +:function X-GXXor :subwindow-mode X-IncludeInferiors +:line-width 2))) "Face used to outline something." +:group 'xwem-misc :group 'xwem-faces) -;;;###autoload -(defun xwem-misc-outline (xrect how) - "Outline XRECT using HOW method. -Valid HOW is 'normal, ..." +(defun xwem-misc-outline (xrect how &optional xwin) + "Outline XRECT using HOW method in XWIN. +Valid HOW is 'normal, ... +If XWIN is not specified, X root window is used." + (unless xwin + (setq xwin (xwem-rootwin))) + (let ((x (X-Rect-x xrect)) (y (X-Rect-y xrect)) (w (X-Rect-width xrect)) (h (X-Rect-height xrect))) (cond ((eq how 'normal) - (XDrawRectangles (xwem-dpy) (xwem-rootwin) (xwem-face-get-gc 'xwem-misc-outline-face1) (list xrect))) + (XDrawRectangles (xwem-dpy) xwin (xwem-face-get-gc 'xwem-misc-outline-face1) (list xrect))) ((eq how 'contiguous) (xwem-misc-outline xrect 'normal) - (XDrawSegments (xwem-dpy) (xwem-rootwin) (xwem-face-get-gc 'xwem-misc-outline-face2) + (XDrawSegments (xwem-dpy) xwin (xwem-face-get-gc 'xwem-misc-outline-face2) (list (cons (cons x 0) (cons x (X-Geom-height (xwem-rootgeom)))) (cons (cons (+ x w) 0) ＠＠ -850,7 +1184,7 ＠＠ (let* ((cornw (/ w 8)) (cornh (/ h 8)) (crw (/ (+ cornh cornw) 2))) - (XDrawSegments (xwem-dpy) (xwem-rootwin) (xwem-face-get-gc 'xwem-misc-outline-face1) + (XDrawSegments (xwem-dpy) xwin (xwem-face-get-gc 'xwem-misc-outline-face1) (list ;; Top left (cons (cons x y) (cons (+ x cornw) y)) ＠＠ -875,7 +1209,7 ＠＠ ((eq how 'grid) (xwem-misc-outline xrect 'normal) - (XDrawSegments (xwem-dpy) (xwem-rootwin) (xwem-fa + (while (not (string= utf8-string "")) + (setq fc (aref utf8-string 0)) + (when (= (logand #xa0 fc) #xa0) + (error "unsupported utf8 character type %d" fc)) + (setq ulen (if (zerop (logand #x80 fc)) 1 2)) + + (if (= ulen 1) + (setq rstr (concat rstr (char-to-string fc)) + utf8-string (substring utf8-string 1)) + (setq rstr (concat rstr + (char-to-string + (xwem-misc-utf8-to-koi8-char + (logior (lsh (logand #xf fc) 6) + (logand #x3f (aref utf8-string 1)))))) + utf8-string (substring utf8-string 2)))) + rstr)) + +;;; Image rotator +(defun xwem-misc-rotidx-left (i w h depth) + (setq i (/ i depth)) + (let* ((y (/ i w)) + (x (% i w)) + (x1 y) + (y1 (- w x 1))) + (* (+ (* y1 h) x1) depth))) + +(defun xwem-misc-rotidx-right (i w h depth) + (setq i (/ i depth)) + (let* ((y (/ i w)) + (x (% i w)) + (x1 (- h y 1)) + (y1 x)) + (* (+ (* y1 h) x1) depth))) + +;;;###xwem-autoload +(defun xwem-misc-rotate-data (data w h depth &optional rotate) + "Rotate DATA obtained from XGetImage for use by XPutImage." + (unless (member depth '(8 16 24 32)) + (error 'xwem-error (format "Unsupported depth %d, use one of (8 16 24 32)" depth))) + (setq depth (truncate (/ depth 8))) + + (unless rotate + (setq rotate 'left)) + (setq rotate + (if (eq rotate 'left) + 'xwem-misc-rotidx-left + 'xwem-misc-rotidx-right)) + + (let* ((gc-cons-threshold most-positive-fixnum) ; inhibit GCing + (dstr (make-string (* w h depth) ?\x00)) + (dlen (length data)) + (i 0) + off j) + (while (< i dlen) + (setq off (funcall rotate i w h depth)) + (setq j 0) + (while (< j depth) + (aset dstr (+ off j) (aref data (+ i j))) + (incf j)) + (setq i (incf i depth))) + dstr)) + +;;;###xwem-autoload +(defun xwem-debug (routine fmt &rest fmt-args) + (let ((print-level 3)) ; XXX Restrict huge output + (apply 'X-Dpy-log (xwem-dpy) routine fmt fmt-args))) + (provide 'xwem-misc) + +;;; On-load hooks: +; - Misc initialize +(if xwem-started + (xwem-misc-init) + (add-hook 'xwem-before-init-wins-hook 'xwem-misc-init)) ;;; xwem-misc.el ends here Index: lisp/xwem-modes.el =================================================================== RCS file: lisp/xwem-modes.el diff -N lisp/xwem-modes.el --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ lisp/xwem-modes.el 1 Jan 2005 04:41:15 -0000 ＠＠ -0,0 +1,89 ＠＠ +;;; xwem-modes.el --- + +;; Copyright (C) 2004 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Created: Mon Oct 18 22:36:23 MSD 2004 +;; Keywords: xwem +;; X-CVS: $Id: xwem-modes.el,v 1.1 2004/11/29 20:41:54 lg Exp $ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; + +;;; Code: + +(require 'xwem-load) + +;;;###xwem-autoload +(defvar xwem-minor-mode-alist nil + "Alist saying how to show minor modes. +Each element is a list which looks like (VAR STRING). +STRING is shown when VAR is non-nil.") + +;;;###xwem-autoload +(defvar xwem-minor-mode-map-alist nil + "Alist of keymaps for use of minor modes. +Each element looks like (VAR . KEYMAP).") + +;;;###xwem-autoload +(defun xwem-add-minor-mode (toggle name &optional keymap) + "Add a minor mode to `xwem-minor-mode-alist'. + +For TOGGLE, NAME, KEYMAP, usage take a look at `add-minor-mode'." + (setq xwem-minor-mode-alist + (put-alist toggle (list name) xwem-minor-mode-alist)) + (when (keymapp keymap) + (setq xwem-minor-mode-map-alist + (put-alist toggle keymap xwem-minor-mode-map-alist)))) + +;;;###xwem-autoload +(defun xwem-turn-on-minor-mode (cl mm-toggle) + "On CL, turn on minor mode MM-TOGGLE." + (unless (or (and (xwem-client-local-variable-p mm-toggle) + (xwem-client-local-variable-value cl mm-toggle)) + (symbol-value mm-toggle)) + (let ((kmap (assq mm-toggle xwem-minor-mode-map-alist))) + (when (keymapp (cdr kmap)) + (xwem-kbd-install-grab (cdr kmap) (xwem-cl-xwin cl)))) + + (if (xwem-client-local-variable-p mm-toggle) + (xwem-client-local-variable-set cl mm-toggle t) + (set-variable mm-toggle t)))) + +;;;###xwem-autoload +(defun xwem-turn-off-minor-mode (cl mm-toggle) + "On CL, turn off minor mode MM-TOGGLE." + (when (or (and (xwem-client-local-variable-p mm-toggle) + (xwem-client-local-variable-value cl mm-toggle)) + (symbol-value mm-toggle)) + (let ((kmap (assq mm-toggle xwem-minor-mode-map-alist))) + (when (keymapp (cdr kmap)) + (xwem-kbd-uninstall-grab (cdr kmap) (xwem-cl-xwin cl)))) + (if (xwem-client-local-variable-p mm-toggle) + (xwem-client-local-variable-set cl mm-toggle nil) + (set-variable mm-toggle nil)))) + + +(provide 'xwem-modes) + +;;; xwem-modes.el ends here Index: lisp/xwem-mouse.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-mouse.el,v retrieving revision 1.8 diff -u -u -r1.8 xwem-mouse.el --- lisp/xwem-mouse.el 16 Dec 2004 08:08:10 -0000 1.8 +++ lisp/xwem-mouse.el 1 Jan 2005 04:41:15 -0000 ＠＠ -5,7 +5,7 ＠＠ ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> ;; Created: 21 Mar 2003 ;; Keywords: xlib, xwem -;; X-CVS: $Id: xwem-mouse.el,v 1.8 2004/12/16 08:08:10 youngs Exp $ +;; X-CVS: $Id: xwem-mouse.el,v 1.7 2004/12/05 05:52:29 youngs Exp $ ;; This file is part of XWEM. ＠＠ -32,6 +32,10 ＠＠ ;;; Code: +(require 'xwem-load) +(require 'xwem-manage) + +;;; Customisation (defcustom xwem-popup-menu-function 'popup-menu "*Function used to popup menus. It is created for case when you change default `popup-menu' function, ＠＠ -39,6 +43,8 ＠＠ :type 'function :group 'xwem) +;;; Internal variables + (defun xwem-mouse-change-cursor (cursor) "XXX. ＠＠ -65,47 +71,159 ＠＠ ) ;;; Menus +;;;###autoload +(defun xwem-popup-menu (menu &optional event) + "Popup MENU. +MENU and EVENT is same as for `popup-menu'." + (xwem-mouse-ungrab) + + (funcall xwem-popup-menu-function menu + (or event (and (member (event-type xwem-last-event) '(button-press button-release motion)) xwem-last-event)))) + (defvar xwem-applications-submenu '("Applications" - ["XEmacs" (make-frame)] - ["xterm" (xwem-execute-program "xterm")] - ["gv" (xwem-execute-program "gv")] - ["xfontsel" (xwem-execute-program "xfontsel")] - ) + ("XEmacs" + ["New frame" (make-frame nil (default-x-device))] + ["*scratch* frame" (with-selected-frame (make-frame nil (default-x-device)) + (switch-to-buffer "*scratch*"))]) + ("XTerm" + ["Default xterm" (xwem-launch-xterm nil)] + ["2 xterm" (xwem-launch-xterm 2)] + ["3 xterm" (xwem-launch-xterm 3)] + ["4 xterm" (xwem-launch-xterm 4)]) + ["Mozilla" (xwem-execute-program "mozilla")] + "--" + ["GhostView" (xwem-execute-program "gv")] + ["xfontsel" (xwem-execute-program "xfontsel")] + ["Lupe" (xwem-launch-lupe nil)] + ) "Submenu with applications.") -(defvar xwem-menu - (list "XWEM Menu" - xwem-applications-submenu - '("Windows" - ["Vertical Split" (xwem-frame-split-vert nil)] - ["Horizontal Split" (xwem-frame-split-horiz nil)] - ["Delete Window" (xwem-window-delete)] - ["Delete Others" (xwem-window-delete-others)] - ["Balance" (xwem-balance-windows (xwem-frame-selected))]) - ) - "Popup menu to be used by xwem." - ) +;;;###xwem-autoload +(defun xwem-generate-window-menu (title &optional win) + "Generate menu for WIN." + (unless title + (setq title "Window")) + (list title + (vector "Vertical Split" `(xwem-window-split-vertically nil ,win)) + (vector "Horizontal Split" `(xwem-window-split-horizontally nil ,win)) + (vector "Delete Window" `(xwem-window-delete ,win)) + (vector "Delete Others" `(xwem-window-delete-others ,win)) + (vector "Balance" `(xwem-balance-windows ,win)))) + +(defun xwem-generate-iconified-cl-menu (title &optional max-mwidth) + "Generate menu for iconified clients with TITLE. +MAX-MWIDTH specifies maximum menu width." + (list (xwem-misc-fixup-string title max-mwidth) +:filter + `(lambda (not-used) + (delq nil + (mapcar (lambda (cl) + (when (eq (xwem-cl-state cl) 'iconified) + (vector (xwem-misc-fixup-string (xwem-client-name cl) ,max-mwidth) + `(xwem-select-client ,cl) +:active (xwem-non-dummy-client-p cl)))) + xwem-clients))))) + +(defun xwem-generate-applications-cl-menu (title &optional max-mwidth) + "Generate menu for applications." + (list (xwem-misc-fixup-string title max-mwidth) +:filter `(lambda (not-used) + (mapcar (lambda (app-spec) + (list (xwem-misc-fixup-string (car app-spec) ,max-mwidth) +:filter `(lambda (not-used) + (delq nil + (mapcar (lambda (cl) + (when (xwem-cl-match-p cl (cdr (quote ,app-spec))) + (vector (xwem-misc-fixup-string (xwem-client-name cl) ,,max-mwidth) + `(xwem-select-client ,cl) +:active (xwem-non-dummy-client-p cl)))) + xwem-clients))))) + xwem-applications-alist)))) + +;;;###xwem-autoload +(defun xwem-generate-clients-menu (title &optional max-mwidth) + "Generate clients menu. +TITLE is menu title. +Optional MAX-MWIDTH argument specifies maximum width for menu items, +default is 42." + (unless max-mwidth + (setq max-mwidth 42)) + + (let (malist) + (mapc (lambda (cl) + (let ((kv (assq (xwem-cl-manage-type cl) malist))) + (if kv + (setcdr kv (cons cl (cdr kv))) + (setq malist (put-alist (xwem-cl-manage-type cl) (list cl) malist))))) + xwem-clients) + + (nconc (list (xwem-misc-fixup-string title max-mwidth)) + (mapcar (lambda (mc) + (list (xwem-misc-fixup-string (symbol-name (car mc)) max-mwidth) +:filter + `(lambda (not-used) + (mapcar (lambda (mccl) + (vector (xwem-misc-fixup-string (xwem-client-name mccl) ,max-mwidth) + `(xwem-select-client ,mccl) +:active (xwem-non-dummy-client-p mccl))) + (cdr (quote ,mc)))))) + malist) + + ;; Iconified + (list "==") + (list (xwem-generate-iconified-cl-menu "Iconified" max-mwidth)) + + ;; Applications + (list "--") + (list (xwem-generate-applications-cl-menu "Applications" max-mwidth)) + ))) -(defun xwem-menu-generate () +;;;###xwem-autoload +(defun xwem-generate-menu () "Generate xwem menu on fly." (list "XWEM Menu" - '("xwem-frames" :filter - (lambda (not-used) - (mapcar (lambda (el) - (let ((fn (xwem-frame-num el))) - (vector - (concat "Frame " (int-to-string fn) ": " (xwem-frame-name el)) - `(xwem-frame-switch-nth ,fn)))) - xwem-frames-list))) - - '("xwem-clients" :filter - (lambda (not-used) - (mapcar (lambda (el) - (let ((nam (xwem-hints-wm-name (xwem-cl-hints el)))) - (vector nam `(xwem-cl-pop-to-client ,el) -:active (if (xwem-cl-exclude-p el) nil t)))) - xwem-clients))) + (list "Minibuffer" + ["Hide" (xwem-iconify (xwem-minib-cl xwem-minibuffer)) +:active (eq (xwem-cl-state (xwem-minib-cl xwem-minibuffer)) 'active) ] + ["Show" (xwem-activate (xwem-minib-cl xwem-minibuffer)) +:active (not (eq (xwem-cl-state (xwem-minib-cl xwem-minibuffer)) 'active)) ] + ["Restore size" (xwem-minib-rsz-resize 1)]) + (xwem-generate-window-menu "Window" (xwem-win-selected)) + "--" + (list "Frames" :filter + (lambda (not-used) + (nconc + (list (list "Operations" + ["New Frame" (xwem-make-frame 'desktop)] + ["Next" (xwem-frame-next 1)] + ["Previous" (xwem-frame-previous 1)] + ["Iconify" (xwem-frame-hide (xwem-frame-selected))] + ["Transpose" (xwem-transpose-frames 1)] + "--" + ["Destroy" (xwem-frame-destroy (xwem-frame-selected))]) + (list "Side-by-side" + ["Vertical" (xwem-frame-sbs-vert-split 1)] + ["Horizontal" (xwem-frame-sbs-hor-split 1)]) + "--" + ["Show Root" (xwem-frame-showroot)] + ["Lower" (xwem-frame-lower (xwem-frame-selected))] + ["Raise" (xwem-frame-raise (xwem-frame-selected))] + ) + (list "==") + (mapcar (lambda (el) + (let ((fn (xwem-frame-num el))) + (vector + (concat "Frame " (int-to-string fn) ": " (xwem-frame-name el)) + `(xwem-frame-switch-nth ,fn)))) + xwem-frames-list)))) + + (list "Clients" :filter + (lambda (not-used) + (nconc + (cdr (xwem-generate-clients-menu nil)) + (list "==") + (and (xwem-cl-selected) (cdr (xwem-generate-cl-menu (xwem-cl-selected) 32)))))) "--" xwem-applications-submenu ＠＠ -117,24 +235,10 ＠＠ "Popup clients menu." (xwem-interactive) - (let ((menu (list "XWEM Clients" :filter - (lambda (not-used) - (mapcar (lambda (cl) - (let ((frame (xwem-cl-frame cl)) - (name (xwem-hints-wm-name (xwem-cl-hints cl)))) - (vector (if (xwem-frame-p frame) - (format "[%d](%s): %s" (xwem-frame-num (xwem-cl-frame cl)) - (xwem-frame-name (xwem-cl-frame cl)) - name) - name) - `(xwem-cl-pop-to-client ,cl) -:active (if (xwem-cl-exclude-p cl) nil t)))) - xwem-clients))))) + (xwem-popup-menu (xwem-generate-clients-menu "XWEM Clients"))) - (xwem-popup-menu menu))) - -;;;###autoload -(defun xwem-gen-cl-menu (cl &optional maxnlen) +;;;###xwem-autoload +(defun xwem-generate-cl-menu (cl &optional maxnlen) "Generate menu for CL. MAXNLEN - maximum menu width in characters." (unless maxnlen ＠＠ -149,46 +253,28 ＠＠ (vector "Info" `(xwem-client-info ,cl)) (vector "Iconify" `(xwem-client-iconify ,cl)) "--:singleDashedLine" - (vector "Transpose ==>" `(xwem-cl-transpose nil ,cl)) - (vector "Transpose <==" `(xwem-cl-transpose '(4) ,cl)) + (vector "Transpose ==>" `(xwem-cl-transpose ,cl)) + (vector "Transpose <==" `(xwem-cl-transpose ,cl '(4))) (vector "Mark client" `(if (xwem-cl-marked-p ,cl) (xwem-client-unset-mark ,cl) - (xwem-client-set-mark nil ,cl)) + (xwem-client-set-mark ,cl)) :style 'toggle :selected `(xwem-cl-marked-p ,cl)) "--:singleDashedLine" (vector "Run Copy" `(xwem-client-run-copy nil ,cl)) (vector "Run Copy other win" `(xwem-client-run-copy-other-win nil ,cl)) (vector "Run Copy other frame" `(xwem-client-run-copy-other-frame nil ,cl)) "--:doubleLine" - (vector "X Soft kill" `(xwem-client-kill nil ,cl)) - (vector "X Hard kill" `(xwem-client-kill '(4) ,cl)) + (vector "X Soft kill" `(xwem-client-kill ,cl)) + (vector "X Hard kill" `(xwem-client-kill ,cl '(4))) )) -;;;###autoload -(defun xwem-popup-menu (menu &optional event) - "Popup MENU. -MENU and EVENT is same as for `popup-menu'." - (xwem-mouse-ungrab) - - (funcall xwem-popup-menu-function menu event)) - -;;;###autoload(autoload 'xwem-popup-function-menu "xwem-mouse") -(define-xwem-command xwem-popup-function-menu (arg) - "Just popup `xwem-menu'. -ARG - Not used yet." - (xwem-interactive "_P") - - ;; TODO: - ;; * use ARG - (xwem-popup-menu xwem-menu)) - -;;;###autoload(autoload 'xwem-popup-auto-menu "xwem-mouse") +;;;###autoload(autoload 'xwem-popup-auto-menu "xwem-mouse" nil t) (define-xwem-command xwem-popup-auto-menu (arg) - "Popup menu generated by `xwem-menu-generate'. + "Popup menu generated by `xwem-generate-menu'. ARG - Not used yet." (xwem-interactive "_P") - (xwem-popup-menu (xwem-menu-generate))) + (xwem-popup-menu (xwem-generate-menu))) (provide 'xwem-mouse) Index: lisp/xwem-netwm.el =================================================================== RCS file: lisp/xwem-netwm.el diff -N lisp/xwem-netwm.el --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ lisp/xwem-netwm.el 1 Jan 2005 04:41:15 -0000 ＠＠ -0,0 +1,582 ＠＠ +;;; xwem-netwm.el --- NETWM stuff. + +;; Copyright (C) 2004 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Steve Youngs <steve(a)youngs.au.com> +;; Created: Sat May 15 19:44:58 MSD 2004 +;; Keywords: xwem +;; X-CVS: $Id: xwem-netwm.el,v 1.3 2004/12/05 22:37:35 lg Exp $ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; Support for NETWM hints. See specification at: +;; http://www.freedesktop.org/standards/wm-spec/index.html. + +;;; Code: + +(require 'xlib-xlib) +(require 'xlib-xinerama) + +(require 'xwem-load) +(require 'xwem-manage) +(require 'xwem-version) + +(defgroup xwem-fullscreen nil + "Group to customize fullscreen managing + _NET_WM_STATE_BELOW _NET_WM_ALLOWED_ACTIONS _NET_WM_ACTION_MOVE + _NET_WM_ACTION_RESIZE _NET_WM_ACTION_MINIMIZE _NET_WM_ACTION_SHADE + _NET_WM_ACTION_STICK _NET_WM_ACTION_MAXIMIZE_HORZ + _NET_WM_ACTION_MAXIMIZE_VERT _NET_WM_ACTION_FULLSCREEN + _NET_WM_ACTION_CHANGE_DESKTOP _NET_WM_ACTION_CLOSE _NET_WM_STRUT + _NET_WM_ICON_GEOMETRY _NET_WM_ICON _NET_WM_PID _NET_WM_HANDLED_ICONS + _NET_WM_STRUT + + _NET_CURRENT_DESKTOP + _NET_SHOWING_DESKTOP + _NET_SUPPORTING_WM_CHECK + _NET_NUMBER_OF_DESKTOPS + _NET_DESKTOP_GEOMETRY + _NET_ACTIVE_WINDOW)) + +(defconst xwem-nwm-supported + (list _NET_WM_NAME _NET_CURRENT_DESKTOP + _NET_NUMBER_OF_DESKTOPS + _NET_DESKTOP_NAMES _NET_SHOWING_DESKTOP + _NET_WM_STATE _NET_WM_STATE_FULLSCREEN + _NET_CLIENT_LIST _NET_CLIENT_LIST_STACKING + _NET_ACTIVE_WINDOW + ) + ) + +(defun xwem-nwm-init () + "Initialize netwm stuff." + (xwem-message 'init "Initializing NET_WM support ...") + + (mapc (lambda (name) + (XInternAtom (xwem-dpy) name)) + xwem-nwm-atom-names) + + ;; Add client message handler on root window + (X-Win-EventHandler-add-new (xwem-rootwin) 'xwem-nwm-root-evhandler 100 + (list X-ClientMessage X-MapRequest)) + (X-Dpy-EventHandler-add (xwem-dpy) 'xwem-nwm-root-clnmsg 100 + (list X-ClientMessage)) +; ;; Update root event mask +; (setq xwem-root-ev-mask (Xmask-or xwem-root-ev-mask XM- +; (XSelectInput (xwem-dpy) + + ;; Add hooks + (add-hook 'xwem-frame-select-hook 'xwem-nwm-on-frame-select) + (add-hook 'xwem-frame-creation-hook 'xwem-nwm-set-number-of-desktops) + (add-hook 'xwem-frame-destroy-hook 'xwem-nwm-set-number-of-desktops) + + (add-hook 'xwem-cl-create-hook 'xwem-nwm-set-client-list) + (add-hook 'xwem-cl-destroy-hook 'xwem-nwm-set-client-list) + (add-hook 'xwem-client-select-hook 'xwem-nwm-set-active-window) + + ;; Set some properties + (xwem-nwm-set-supported) + (xwem-nwm-set-supporting-wm-check) + + (xwem-nwm-set-number-of-desktops) + (xwem-nwm-set-current-desk) + (xwem-nwm-set-desk-geometry) + + (xwem-nwm-set-client-list) + + (xwem-message 'init "Initializing NET_WM support ... done")) + +(defun xwem-nwm-on-frame-select () + "Called when frame switching occurs, i.e. member of `xwem-frame-select-hook'." + (xwem-nwm-set-current-desk (xwem-frame-selected))) + +(defun xwem-nwm-root-evhandler (xdpy xwin xev) + "Handle netwm's event" + (X-Event-CASE xev + (:X-ClientMessage + (xwem-nwm-root-clnmsg xdpy xwin xev)) + (:X-MapRequest + (xwem-nwm-root-mapreq xdpy xwin xev)))) + +(defun xwem-nwm-root-clnmsg (xdpy xwin xev) + "Dispatch ClientMessage event on root window." + (cond ((string= (X-Atom-name (X-Event-xclient-atom xev)) _NET_CURRENT_DESKTOP) + (let ((num (truncate (caar (X-Event-xclient-msg xev))))) + (xwem-frame-switch-nth num))) + + ((string= (X-Atom-name (X-Event-xclient-atom xev)) _NET_WM_STATE) + (xwem-debug 'xwem-misc "_NET_WM_STATE: -> %S" '(X-Event-xclient-msg xev)) + + (let ((vop (caar (X-Event-xclient-msg xev))) + (stype (caadr (X-Event-xclient-msg xev))) + (cl (xwem-xwin-cl xwin))) + ;; XXX Can handle only FULLSCREEN state + (when (= stype (X-Atom-id (XInternAtom (xwem-dpy) _NET_WM_STATE_FULLSCREEN))) + (cond ((= vop 0) + (xwem-toggle-fullscreen cl 'off)) + ((= vop 1) + (xwem-toggle-fullscreen cl 'on)))))) + )) + +(defun xwem-nwm-root-mapreq (xdpy xwin xev) + "Dispatch map request of XWIN to set _NET_WM_STATE property." + (XChangeProperty xdpy xwin + (XInternAtom xdpy _NET_WM_STATE) + XA-atom X-format-32 X-PropModeReplace + nil) + ) + +(defun xwem-nwm-set-state (xwin &optional state) + "Set XWIN's _NET_WM_STATE property to STATE. +If STATE is nil, then remove property." + (XChangeProperty (xwem-dpy) xwin + + (or (null force) (eq force 'on))) + (xwem-nwm-set-state xwin _NET_WM_STATE_FULLSCREEN) + (xwem-client-change-manage-type cl '(fullscreen)))))) + +;;;###autoload(autoload 'xwem-switch-to-fullscreen-cl "xwem-netwm" nil t) +(define-xwem-command xwem-switch-to-fullscreen-cl () + "Switch to client that in fullscreen mode." + (xwem-interactive) + + (let* ((fsclients (xwem-clients-list 'xwem-cl-fullscreen-p)) + (cl (and fsclients (xwem-read-client "Fullscreen CL: " fsclients)))) + + (unless (xwem-cl-alive-p cl) + (error 'xwem-error "No fullscreen clients")) + + (xwem-select-client cl))) + + +(provide 'xwem-netwm) +;;;; On-load actions + +;; Fullscreen manage type +(define-xwem-manage-model fullscreen + "Managing model to show client at fullscreen size." +:match-spec '(function xwem-netwm-fullscreen-p) + +:manage-method 'xwem-manage-fullscreen +:activate-method 'xwem-activate-fullscreen +:deactivate-method 'xwem-deactivate-fullscreen +:refit-method 'xwem-refit-fullscreen +:iconify-method 'xwem-iconify-fullscreen) + +(if xwem-started + (xwem-nwm-init) + (add-hook 'xwem-after-init-hook 'xwem-nwm-init)) + +;;; xwem-netwm.el ends here Index: lisp/xwem-osd.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-osd.el,v retrieving revision 1.5 diff -u -u -r1.5 xwem-osd.el --- lisp/xwem-osd.el 16 Dec 2004 08:08:11 -0000 1.5 +++ lisp/xwem-osd.el 1 Jan 2005 04:41:15 -0000 ＠＠ -5,7 +5,7 ＠＠ ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> ;; Created: Mon Jan 12 13:14:32 MSK 2004 ;; Keywords: xwem -;; X-CVS: $Id: xwem-osd.el,v 1.5 2004/12/16 08:08:11 youngs Exp $ +;; X-CVS: $Id: xwem-osd.el,v 1.4 2004/12/05 22:37:38 lg Exp $ ;; This file is part of XWEM. ＠＠ -79,11 +79,26 ＠＠ ;;; Code: (eval-when-compile - (require 'cl) - (require 'xlib-xlib)) + (require 'cl)) + (require 'xlib-xshape) +(require 'xlib-tray) +(require 'xlib-xpm) + +(require 'xwem-diagram) -(defconst xwem-osd-instance-types '(text line dots arc rect) +(defcustom xwem-osd-default-font "fixed" + "Default font for text drawed in osd.") + +(defcustom xwem-osd-default-color "black" + "Default color used to draw.") + +(defcustom xwem-osd-always-ontop t + "*Non-nil mean that OSD's winow will be always on top.") + +;;; Internal variables + +(defconst xwem-osd-instance-types '(text line dots arc rect icon) "List of valid types of osd instance.") ＠＠ -93,7 +108,24 ＠＠ (depth 0) ; depth xwin xmask - color) ; instance background color + color ; instance background color + + plist) ; User defined plist + +(defsubst xwem-osd-instance-put-prop (osin prop val) + "In OSD's instance OSIN properties list put property PROP with value VAL." + (setf (xwem-osd-instance-plist osin) + (plist-put (xwem-osd-instance-plist osin) prop val))) +(put 'xwem-osd-instance-put-prop 'lisp-indent-function 2) + +(defsubst xwem-osd-instance-get-prop (osin prop) + "Return OSD's instance OSIN property PROP." + (plist-get (xwem-osd-instance-plist osin) prop)) + +(defsubst xwem-osd-instance-rem-prop (osin prop) + "Remove OSD's instance OSIN property PROP." + (setf (xwem-osd-instance-plist osin) + (plist-remprop (xwem-osd-instance-plist osin) prop))) (defmacro xwem-osd-instance-xdpy (osin) "Return display of OSIN osd instance." ＠＠ -125,14 +157,10 ＠＠ "Return OSD's property PROP." (plist-get (xwem-osd-plist osd) prop)) -(defcustom xwem-osd-default-font "fixed" - "Default font for text drawed in osd.") - -(defcustom xwem-osd-default-color "black" - "Default color used to draw.") - -(defcustom xwem-osd-always-ontop t - "*Non-nil mean that OSD's winow will be always on top.") +(defsubst xwem-osd-rem-prop (osd prop) + "Remove OSD's property PROP." + (setf (xwem-osd-plist osd) + (plist-remprop (xwem-osd-plist osd) prop))) ;;; Functions ＠＠ -140,7 +168,6 ＠＠ "On X display XDPY and window XWIN handle X Event XEV." x (+ y yoff) string) ＠＠ -480,7 +541,7 ＠＠ x (+ y yoff) string) (X-XShapeMask xdpy (xwem-osd-xwin osd) X-XShape-Bounding X-XShapeUnion 0 0 (xwem-osd-xmask osd)) - )) + osin)) (defun xwem-osd-set-line-width (osd new-line-width) "Set OSD's gc line width to NEW-LINE-WIDTH." ＠＠ -491,13 +552,13 ＠＠ (XChangeGC (xwem-osd-xdpy osd) (xwem-osd-mask-gc osd)) ) -(defun xwem-osd-line-add (osd x0 y0 x1 y1 &optional color) +(defun xwem-osd-line-add (osd x0 y0 x1 y1 &optional depth color) "In OSD's window add line." (let ((xdpy (xwem-osd-xdpy osd)) osin) ;; Create OSD line instance - (setq osin (xwem-osd-add-instance osd 0 color)) + (setq osin (xwem-osd-add-instance osd depth color)) (setf (xwem-osd-instance-type osin) 'line) (XDrawLine xdpy (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd) x0 y0 x1 y1) ＠＠ -510,15 +571,15 ＠＠ x0 y0 x1 y1) (X-XShapeMask (xwem-osd-xdpy osd) (xwem-osd-xwin osd) X-XShape-Bounding X-XShapeUnion 0 0 (xwem-osd-xmask osd)) - )) + osin)) -(defun xwem-osd-dots-add (osd dots type &optional color) +(defun xwem-osd-dots-add (osd dots type &optional depth color) "In OSD's window add DOTS of TYPE." (let ((xdpy (xwem-osd-xdpy osd)) osin) ;; Create OSD dots instancne - (setq osin (xwem-osd-add-instance osd 0 color)) + (setq osin (xwem-osd-add-instance osd depth color)) (setf (xwem-osd-instance-type osin) 'dots) (xwem-diag-plot-dots type (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd) 0 (xwem-osd-height osd) dots) ＠＠ -531,15 +592,15 ＠＠ 0 (xwem-osd-height osd) dots) (X-XShapeMask (xwem-osd-xdpy osd) (xwem-osd-xwin osd) X-XShape-Bounding X-XShapeUnion 0 0 (xwem-osd-xmask osd)) - )) + osin)) -(defun xwem-osd-arc-add (osd xarc &optional color) +(defun xwem-osd-arc-add (osd xarc &optional depth color) "In OSD's window draw arc specified by XARC." (let ((xdpy (xwem-osd-xdpy osd)) osin) ;; Create OSD arc instance - (setq osin (xwem-osd-add-instance osd 0 color)) + (setq osin (xwem-osd-add-instance osd depth color)) (setf (xwem-osd-instance-type osin) 'arc) (XDrawArcs xdpy (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd) (list xarc)) ＠＠ -551,27 +612,89 ＠＠ (list xarc)) (X-XShapeMask (xwem-osd-xdpy osd) (xwem-osd-xwin osd) X-XShape-Bounding X-XShapeUnion 0 0 (xwem-osd-xmask osd)) - )) + osin)) -(defun xwem-osd-rect-add (osd x y width height &optional color) - "In OSD's window add rectangle specified by X Y WIDTH and HEIGHT." +(defun xwem-osd-rect-add (osd x y width height &optional depth color fill-p) + "In OSD's window add rectangle specified by X Y WIDTH and HEIGHT. +If FILL-P is non-nil, rectangle will be filled instead of outdrawing." (let ((xdpy (xwem-osd-xdpy osd)) osin) ;; Created OSD rect instance - (setq osin (xwem-osd-add-instance osd 0 color)) + (setq osin (xwem-osd-add-instance osd depth color)) (setf (xwem-osd-instance-type osin) 'rect) - (XDrawRectangle xdpy (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd) - x y width height) + (XDrawRectangles xdpy (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd) + (list (make-X-Rect :x x :y y :width width :height height)) + fill-p) (X-XShapeMask xdpy (xwem-osd-instance-xwin osin) X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask osin)) ;; Update OSD shape - (XDrawRectangle xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd) - x y width height) + (XDrawRectangles xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd) + (list (make-X-Rect :x x :y y :width width :height height)) + fill-p) (X-XShapeMask (xwem-osd-xdpy osd) (xwem-osd-xwin osd) X-XShape-Bounding X-XShapeUnion 0 0 (xwem-osd-xmask osd)) - )) + osin)) + +(defun xwem-osd-icon-data-add (osd xpm-data &optional x y depth) + "In OSD's window add icon. +X and Y specifies +;; (text (format-time-string "%a, %b %e")) +;; (width (+ 3 (X-Text-width +;; (xwem-dpy) +;; (X-Font-get (xwem-dpy) +;; (face-font-name face)) +;; text))) +;; (height (+ 3 (X-Text-height +;; (xwem-dpy) +;; (X-Font-get (xwem-dpy) +;; (face-font-name face)) +;; text)))) +;; (setq sy-osd-date (xwem-osd-create-dock +;; (xwem-dpy) +;; width +;; height +;; (list 'keymap sy-osd-date-keymap))) +;; (xwem-osd-set-color sy-osd-date (face-foreground-name face)) +;; (xwem-osd-set-font sy-osd-date (face-font-name face)) +;; (xwem-osd-text sy-osd-date text) +;; (xwem-osd-show sy-osd-date))) + +;; (defun sy-update-osd-date-maybe (&optional force) +;; "Update the OSD date at midnight. + +;; Optional Argument FORCE means to update the date now." +;; (let* ((now (decode-time)) +;; (cur-hour (nth 2 now)) +;; (cur-min (nth 1 now)) +;; (cur-comp-time (+ (* cur-hour 60) cur-min))) +;; (when (or force (= 0 cur-comp-time)) +;; (when (xwem-osd-p sy-osd-date) +;; (xwem-osd-text sy-osd-date (format-time-string "%a, %b %e")))))) + +;; (defun sy-update-osd-date () +;; "*Force update of the OSD date." +;; (interactive) +;; (when (xwem-osd-p sy-osd-date) +;; (sy-update-osd-date-maybe t))) + +;; (defun sy-delete-osd-date () +;; "*Delete the OSD date." +;; (interactive) +;; (when (xwem-osd-p sy-osd-date) +;; (when (itimerp "sy-osd-date-itimer") +;; (delete-itimer "sy-osd-date-itimer")) +;; (xwem-osd-destroy sy-osd-date))) + +;; (add-hook 'xwem-after-init-hook (lambda () +;; (progn +;; (sy-show-date-osd) +;; (start-itimer "sy-osd-date-itimer" +;; 'sy-update-osd-date-maybe +;; 60 60)))) Index: lisp/xwem-pager.el =================================================================== RCS file: lisp/xwem-pager.el diff -N lisp/xwem-pager.el --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ lisp/xwem-pager.el 1 Jan 2005 04:41:15 -0000 ＠＠ -0,0 +1,278 ＠＠ +;;; xwem-pager.el --- Simple frame pager. + +;; Copyright (C) 2004 by Free Software Foundation, Inc. + +;; Author: Richard Klinda <ignotus(a)hixsplit.hu> +;; Zajcev Evgeny <zevlg(a)yandex.ru> +;; Created: Wed Aug 18 08:05:09 MSD 2004 +;; Keywords: xwem +;; X-CVS: $Id: xwem-pager.el,v 1.3 2004/12/05 22:50:13 lg Exp $ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; Simple dockapp to show xwem frames. Somekind of extension of +;; xwem-framei.el + +;;; Code: + +(require 'xwem-load) +(require 'xlib-xshape) + + +;; veryvery simple pager / 2d viewport support +;; the code works, do the following: +;; +;; add to XWEM-after-init-hook: +;; +;; (setq *pager-dockapp* (xwem-2dframes-start-dockapp)) +;; +;; ugly i know, that starts the dockapp +;; +;; (xwem-2dframes-make-frames) +;; +;; that will create the frames +;; +;; load this code, restart your XWEM and be happy. If you want to try it +;; out without restarting then MAKE SURE you have only 1 frame, load the +;; code then: +;; M-x xwem-2dframes-make-frames +;; +;; eval (setq *pager-dockapp* (xwem-2dframes-start-dockapp)) +;; +;; change viewports / frames somehow so the dockapp gets updated +;; +;; i know this code is hackis, but if you rename the variables / sturcture +;; the code like you wan +;; `xwem-recover-do-recover' command to force recovering. + +;;; Code: + +(require 'xwem-load) + +(defgroup xwem-recover nil + "Group to customize xwem recovering tool." +:prefix "xwem-recover-" +:group 'xwem) + +(defcustom xwem-recover-parameter '(12 . 3) + "*How many errors allowed without recovering. +car specifies number of errors, cdr specifies time in seconds." +:type '(cons number number) +:group 'xwem-recover) + +;;; Internal variables + +(defvar xwem-recover-mode nil + "Non-nil mean we are in recovering mode. +Use `xwem-recover-turn-on', `xwem-recover-turn-off' and +`xwem-recover-toggle' to change mode.") + +(defvar xwem-recover-errors nil + "List of times when X error occurs. +Internal variable.") + + +(define-xwem-deffered xwem-recover-real-recover () + "Do real recovering routines." + (setf (X-Dpy-snd-queue (xwem-dpy)) nil) + (setf (X-Dpy-message-buffer (xwem-dpy)) "") + (setf (X-Dpy-evq (xwem-dpy)) nil)) + +;;;###autoload(autoload 'xwem-recover-do-recover "xwem-recover" "" t) +(define-xwem-command xwem-recover-do-recover (xdpy) + "Recover XDPY from desyncronisation with X server." + (xwem-interactive (list (xwem-dpy))) + + (flet ((old-x-dpy-filter (proc out))) + (fset 'old-x-dpy-filter (symbol-function 'X-Dpy-filter)) + (flet ((X-Dpy-filter (proc out) + ;; Skip any data on XDPY, but continue processing on + ;; other displays. + (unless (eq (X-Dpy-proc xdpy) proc) + (old-x-dpy-filter proc out)))) + (while (accept-process-output (X-Dpy-proc xdpy) 2)) + + ;; At this point all pending readed, so do cleanup things. This + ;; is not 100% will work. In some circumstances this will only + ;; add problems. + (xwem-recover-real-recover) + ))) + +(defun xwem-recover-xerr-hook (xdpy xerr) + "Called when on display XDPY X error XERR occured. +Check excedance of `xwem-recover-parameter' and if it seems like xlib +got desyncronised with X server, start recovering routines." + + (let ((ct (current-time))) + (setq xwem-recover-errors (nreverse xwem-recover-errors)) + (while (and xwem-recover-errors + (> (itimer-time-difference ct (car xwem-recover-errors)) + (cdr xwem-recover-parameter))) + (setq xwem-recover-errors (cdr xwem-recover-errors))) + (setq xwem-recover-errors + (cons ct (nreverse xwem-recover-errors))) + + ;; Check (car xwem-recover-errors) is not exceeded + (when (or (> (length xwem-recover-errors) (car xwem-recover-parameter)) + ;; Also recover when error code isn't recognized + (not (memq (X-Event-xerror-code xerr) + '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 128 255)))) + (xwem-message 'alarm "Recovering from desyncronisation .. (errors = %d)\n" + (length xwem-recover-errors)) + (xwem-recover-do-recover xdpy)) + )) + +;;;###autoload(autoload 'xwem-recover-turn-on "xwem-recover" "" t) +(define-xwem-command xwem-recover-turn-on () + "Enable xwem recovering mode." + (xwem-interactive) + + (unless xwem-recover-mode + (pushnew 'xwem-recover-xerr-hook (X-Dpy-error-hooks (xwem-dpy))) + (setq xwem-recover-mode t))) + +;;;###autoload(autoload 'xwem-recover-turn-off "xwem-recover" "" t) +(define-xwem-command xwem-recover-turn-off () + "Turn off xwem recovering mode." + (xwem-interactive) + + (when xwem-recover-mode + (setf (X-Dpy-error-hooks (xwem-dpy)) + (delq 'xwem-recover-xerr-hook (X-Dpy-error-hooks (xwem-dpy)))) + (setq xwem-recover-mode nil))) + +;;;###autoload(autoload 'xwem-recover-toggle "xwem-recover" "" t) +(define-xwem-command xwem-recover-toggle (arg) + "Toggle xwem recovering mode. +With positive ARG turn it on, with negative turn it off. +If ARG is ommited - toggle it." + (xwem-interactive "P") + + (cond ((null arg) + (if xwem-recover-mode + (xwem-recover-turn-off) + (xwem-recover-turn-on))) + ((< (prefix-numeric-value arg) 0) + (xwem-recover-turn-off)) + (t (xwem-recover-turn-on)))) + + +(provide 'xwem-recover) + +;;; xwem-recover.el ends here Index: lisp/xwem-register.el ==================== + (message "Malformed sources in file %s" file) + (narrow-to-region (point-min) (point)) + (goto-char (point-min)) + (while (setq expr (ignore-errors (read (current-buffer)))) + (ignore-errors + (and (or (eq (car expr) 'defvar) + (eq (car expr) 'defcustom)) + (stringp (nth 3 expr)) + (or (not (boundp (nth 1 expr))) + (not (equal (eval (nth 2 expr)) + (symbol-value (nth 1 expr))))) + (push (nth 1 expr) olist))))))) + (kill-buffer (current-buffer))) + (when (setq olist (nreverse olist)) + (insert "\n")) + (while olist + (when (boundp (car olist)) + (condition-case () + (pp `(setq ,(car olist) + ,(if (or (consp (setq sym (symbol-value (car olist)))) + (and (symbolp sym) + (not (or (eq sym nil) + (eq sym t))))) + (list 'quote (symbol-value (car olist))) + (symbol-value (car olist)))) + (current-buffer)) + (error + (format "(setq %s 'whatever)\n" (car olist))))) + ;(insert ";; (makeunbound '" (symbol-name (car olist)) ")\n")) + (setq olist (cdr olist))) + ;; Remove any control chars - they seem to cause trouble for some + ;; mailers. (Byte-compiled output from the stuff above.) + (goto-char point) + (while (re-search-forward "[\000-\010\013-\037\200-\237]" nil t) + (replace-match (format "\\%03o" (string-to-char (match-string 0))) + t t)))) + +(defun xwem-bug-packages-list () + "Insert into the current buffer a list of installed packages." + (let ((pkgs packages-package-list)) + (while pkgs + (insert + (format "(%s ver: %s upstream: %s)\n" + (nth 0 (car pkgs)) + (nth 2 (car pkgs)) + (nth 4 (car pkgs)))) + (setq pkgs (cdr pkgs))))) + +(eval-when-compile + (autoload 'xwem-dpy "xwem-struct" nil nil 'macro) + (require 'xlib-xc)) + +(defun xwem-prepare-report () + "Grabs the variables, features to include in bug report. +Then put it all into a mail buffer, nicely formatted." + (mail-to) + (insert xwem-bug-address) + (mail-text) + (forward-line 1) + (setq after-sep-pos (point)) + (setq final-resting-place (point-marker)) + (insert + "\n\n" + "===============================================================\n" + "System info to help the XWEM boys and girls try to fix your bug:\n" + "===============================================================" + "\n\n") + (insert (format "%s" xwem-version) "\n" + (format "%s" xlib-version) "\n\n") + ;; xdpyinfo + (insert "Output from xdpyinfo:\n--------------------\n\n" + (shell-command-to-string (concat "xdpyinfo -display " + (X-Dpy-name (xwem-dpy)))) + "\n") + ;; backtrace & messages buffers + (let ((lisptrace (get-buffer "*Backtrace*")) + (ctrace (get-buffer "*gdb-xemacs*")) + (debug (get-buffer "*xwem-debug*")) + (msgs (get-buffer " *xwem-messages*"))) + (when lisptrace + (insert "Lisp Backtrace:\n--------------\n\n") + (insert-buffer-substring lisptrace) + (insert "\n\n")) + (when ctrace + (insert "C Backtrace:\n-----------\n\n") + (insert-buffer-substring ctrace) + (insert "\n\n")) + (when debug + (insert "xwem-debug buffer:\n-----------------\n\n") + (insert-buffer-substring debug) + (insert "\n\n")) + (when msgs + (insert "xwem-messages buffer:\n--------------------\n\n") + (insert-buffer-substring msgs) + (insert "\n\n"))) + ;; Insert all the XWEM vars that have been changed from default. + ;; The actual work for this is done in `xwem-bug-debug', but it + ;; needs to be called toward the end of this function. + (insert "\n\nXWEM variables of note:\n----------------------\n") + (when window-setup-hook + (insert "\n\nwindow-setup-hook:") + (cl-prettyprint (symbol-value 'window-setup-hook))) + (when kill-emacs-hook + (insert "\n\nkill-emacs-hook:") + (cl-prettyprint (symbol-value 'kill-emacs-hook))) + ;; Insert the output of 'describe-installation'. + (insert "\n\n" + (symbol-value 'Installation-string)) + ;; Load-path shadows can cause some grief. + (flet ((append-message + (&rest args) ()) + (clear-message + (&optional label frame stdout-p no-restore) + ())) + (insert "\n\nLoad-Path Lisp Shadows:\n" + "----------------------\n") + (let ((before-shadows (point))) + (insert + (format "%s" + (find-emacs-lisp-shadows load-path))) + (save-restriction + (narrow-to-region before-shadows (point)) + (fill-paragraph t) + (insert "\n")))) + ;; Insert a list of installed packages. + (insert "\n\nInstalled XEmacs Packages:\n" + "-------------------------\n") + (xwem-bug-packages-list) + (insert "\n") + ;; Insert a list of installed modules. + (if (fboundp 'list-modules) + (progn + (insert "\n\nInstalled Modules:\n" + "-----------------\n") + (let* ((mods (list-modules))) + (while mods + (cl-prettyprint (cdr (car mods))) + (setq mods (cdr mods)))))) + ;; Insert a list of loaded features + (let ((before-features (point))) + (insert + (format "\n\nFeatures:\n--------\n\n%s" (symbol-value 'features))) + (save-restriction + (narrow-to-region before-features (point)) + (fill-paragraph t) + (insert "\n\n"))) + ;; Insert the contents of the user's init file if it exists + ;; and the user wants it sent. + (if xwem-report-bug-send-init + (if (file-readable-p user-init-file) + (save-excursion + (goto-char (point-max)) + (forward-line -3) + (beginning-of-line) + (insert "\n\nUser Init File:\n--------------\n\n") + (insert-file-contents user-init-file)))) + (xwem-report-pre-hook) + (xwem-report-post-hook) + (mail-text) + (insert + (aref xwem-report-salutations + (% (+ (% (random) 1000) 1000) + (length xwem-report-salutations))) "\n") + (re-search-forward "XWEM variables of note:" nil t) + (forward-line 2) + (xwem-report-debug) + (goto-char final-resting-place) + (forward-line 2) + (set-marker final-resting-place nil) + (message "Please enter your report. Type C-c C-c to send, C-x k to abort.")) + +;;;###autoload +(defun xwem-report-bug (&optional no-confirm) + "Submit a bug report for XWEM. +Optional argument BLURB is a string that adds a preamble to the bug report. +Optional argument NO-CONFIRM if 't' will not ask for confirmation." + (interactive) + (if (or no-confirm + (y-or-n-p "Do you want to submit a bug report on XWEM? ")) + (progn + (mail) + (xwem-prepare-report)))) + +(provide 'xwem-report) + +;;; xwem-report.el ends here Index: lisp/xwem-root.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-root.el,v retrieving revision 1.8 diff -u -u -r1.8 xwem-root.el --- lisp/xwem-root.el 16 Dec 2004 08:08:12 -0000 1.8 +++ lisp/xwem-root.el 1 Jan 2005 04:41:16 -0000 ＠＠ -3,9 +3,10 ＠＠ ;; Copyright (C) 2003 by Free Software Foundation, Inc. ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Steve Youngs <steve(a)youngs.au.com> ;; Created: 21 Mar 2003 ;; Keywords: xlib, xwem -;; X-CVS: $Id: xwem-root.el,v 1.8 2004/12/16 08:08:12 youngs Exp $ +;; X-CVS: $Id: xwem-root.el,v 1.7 2004/12/05 22:37:35 lg Exp $ ;; This file is part of XWEM. ＠＠ -31,53 +32,102 ＠＠ ;; This file used to manipulate and agragate information about root ;; window. Also has macros to work with geometry. ;; -;;; Code -(require 'xlib-xlib) +;;; TODO: + +;; * WM_ICON_SIZE on root window. (ICCCM 4.1.3.2) + +;;; Code -;;; Variables +(require 'xwem-load) +(require 'xwem-misc) -(defconst xwem-root-ev-mask (Xmask-or XM-SubstructureNotify XM-SubstructureRedirect - XM-KeyPress XM-ButtonPress XM-ButtonRelease - XM-PropertyChange - XM-FocusChange - XM-EnterWindow - XM-ResizeRedirect) +;;; Variables +(defconst xwem-root-ev-mask (Xmask-or XM-SubstructureRedirect + XM-KeyPress XM-ButtonPress XM-ButtonRelease) "Event mask for X root window.") -;;;###autoload -(defvar xwem-root-screen nil - "Description of root screen") +(defgroup xwem-root nil + "Group to customize root screen." +:prefix - (while (not done) - (setq xev (xwem-next-event)) - (X-Event-CASE xev - (:X-ButtonRelease - (setq done t)) - (:X-MotionNotify - (let ((xoff (X-Event-xmotion-event-x xev)) - (yoff (X-Event-xmotion-event-y xev))) - ;; XXX workaround INT/CARD bug - (xwem-message 'info "x=%d, y=%d" xoff yoff) - (when (and (< xoff 40000) (< yoff 40000)) - (XResizeWindow (xwem-dpy) xwin xoff yoff)))) - ))) - (XUngrabPointer (xwem-dpy))))) - -(define-xwem-command xwem-rooter-destroy () - "Destroy rooter client." - (xwem-interactive "_") +(defvar xwem-rooter-mode-hook nil + "*Hooks to call when client enters rooter mode. +Called with one argument - client.") - (let* ((mev xwem-last-xevent) - (xwin (X-Event-xbutton-event mev))) - - (when (X-Win-p xwin) - (XDestroyWindow (X-Win-dpy xwin) xwin)))) - +;;;###autoload(autoload 'xwem-rooter-raise "xwem-rooter" nil t) (define-xwem-command xwem-rooter-raise () "Raise rooter window." (xwem-interactive "_") - (XRaiseWindow (xwem-dpy) xwem-event-window)) + (XRaiseWindow (xwem-dpy) (xwem-cl-xwin xwem-event-client))) +;;;###autoload(autoload 'xwem-rooter-lower "xwem-rooter" nil t) (define-xwem-command xwem-rooter-lower () "Lower rooter window." (xwem-interactive "_") - (XLowerWindow (xwem-dpy) xwem-event-window)) + (XLowerWindow (xwem-dpy) (xwem-cl-xwin xwem-event-client))) + + +;;;; Manage methods -(defun xwem-rooter-manage (cl &rest args) +;;;###autoload +(defun xwem-manage-rooter (cl) "Manage rooter client CL." (let ((xdpy (xwem-dpy)) (xwin (xwem-cl-xwin cl)) (xgeom (xwem-cl-xgeom cl))) + (xwem-client-set-property cl 'noselect t) ; rooted clients can't be selected + (xwem-client-set-property cl 'nokeyecho t) ; no keyboard echoing (xwem-focus-mode-set cl nil) ; no focus mode - (XReparentWindow xdpy xwin (xwem-rootwin) (X-Geom-x xgeom) (X-Geom-y xgeom)) + (XReparentWindow xdpy xwin (xwem-rootwin) + (X-Geom-x xgeom) (X-Geom-y xgeom)) (XLowerWindow xdpy xwin) (XMapWindow xdpy xwin) ;; Install client local keymap - (xwem-focus-excursion xwin - (map-keymap (lambda (key bind) - (xwem-local-set-key key bind cl)) - xwem-rooter-keymap)) - )) + (xwem-use-local-map xwem-rooter-mode-map cl) + + ;; Finnaly run hook + (run-hook-with-args 'xwem-rooter-mode-hook cl))) + +(defun xwem-activate-rooter (cl &optional type) + "Activate method for rooter clients." + (when (eq type 'select) + (error 'xwem-error "Trying to select rooted client!!!")) + + (XRaiseWindow (xwem-dpy) (xwem-cl-xwin cl))) + +(defun xwem-deactivate-rooter (cl &optional type) + "Deactivate method for rooter clients." + (when (eq type 'deselect) + (error 'xwem-error "Trying to deselect rooted client!!!")) + + (XLowerWindow (xwem-dpy) (xwem-cl-xwin cl))) (provide 'xwem-rooter) + +;;;; On-load actions +;; Rooter manage type +(define-xwem-manage-model rooter + "Managing model to show client on root window." +:manage-method 'xwem-manage-rooter +:activate-method 'xwem-activate-rooter +:deactivate-method 'xwem-deactivate-rooter) ;;; xwem-rooter.el ends here Index: lisp/xwem-rooticon.el =================================================================== RCS file: lisp/xwem-rooticon.el diff -N lisp/xwem-rooticon.el --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ lisp/xwem-rooticon.el 1 Jan 2005 04:41:16 -0000 ＠＠ -0,0 +1,374 ＠＠ +;;; xwem-rooticon.el --- Support Icons on root window. + +;; Copyright (C) 2004 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Created: +;; Keywords: xwem +;; X-CVS: $Id: xwem-rooticon.el,v 1.5 2004/12/05 05:52:30 youngs Exp $ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; + +;;; Code: + +(require 'xwem-load) +(require 'xwem-misc) + +(require 'xlib-xpm) +(require 'xlib-xshape) + +(defgroup xwem-rooticon nil + "Group to customize rooticon behaviour." +:prefix "xwem-rooticon-" +:group 'xwem) + +(defcustom xwem-rooticon-placing 'behind-minibuffer + "*Placing behaviour." +:type '(choice (const :tag "Behind minibuffer" behind-minibuffer) + (const :tag "Random" random)) +:group 'xwem-rooticon) + +(defcustom xwem-rooticon-show-label nil + "*Non-nil mean show Icon name in rooticon." +:type 'boolean +:group 'xwem-rooticon) + +(defcustom xwem-rooticon-default-icon "root-icon.xpm" + "*Default rooticon to use. +This icon is used which client does not have its own icon." +:type 'file +:group 'xwem-rooticon) + +(defcustom xwem-rooticon-default-show-label t + "*Non-nil mean show label, when `xwem-rooticon-default-icon' is used." +:type 'boolean +:group 'xwem-rooticon) + +;;; Internal variables + +(defstruct xwem-rooticon + cl + xgeom + xriwin + xiconwin + xpixmap + xpixmask) + +(define-xwem-face xwem-rooticon-face + `((t (:foreground "black" :background "tan" +:font "-misc-fixed-medium-r-*-*-10-*-*-*-*-*-*-*"))) + "Face to draw text on root icon.") + +(defvar xwem-rooticon-map + (let ((map (make-sparse-keymap))) + (define-key map [button1] 'xwem-rooticon-smart-move) + (define-key map [button1up] 'xwem-rooticon-select-cl) + (define-key map [button3] 'xwem-rooticon-menu) + map) + "Keymap for rooticon windows.") + +(defvar xwem-rooticon-default-pixmap nil) + +(defun xwem-rooticon-ev-handler (xdpy xwin xev) + (let ((ri (X-Win-get-prop xwin 'xwem-rooticon))) + (when (xwem-rooticon-p ri) + (X-Event-CASE xev + ((:X-ButtonPress :X-ButtonRelease) + (xwem-overriding-local-map xwem-rooticon-map + (let ((xwem-click-rooticon ri)) + (declare (special xwem-click-rooticon)) + (xwem-dispatch-command-xevent xev)))) + + (:X-Expose + (xwem-rooticon-draw ri (X-Event-xexpose-x xev) (X-Event-xexpose-y xev) + (X-Event-xexpose-width xev) (X-Event-xexpose-height xev))) + + (:X-DestroyNotify + (xwem-cl-rem-sys-prop (xwem-rooticon-cl ri) 'xwem-rooticon) + (X-invalidate-cl-struct ri)))))) + +(defun xwem-rooticon-icons () + "Return list of root icons sorted by X." + (sort (delq nil (mapcar (lambda (cl) + (xwem-cl-get-sys-prop cl 'xwem-rooticon)) + xwem-clients)) + (lambda (ri1 ri2) + (> (X-Geom-x (xwem-rooticon-xgeom ri1)) + (X-Geom-x (xwem-rooticon-xgeom ri2)))))) + +(defun xwem-rooticon-select-place (cl w h) + "Select place for rooticon." + (or (xwem-client-property cl 'rooticon-position) + (cond ((eq xwem-rooticon-placing 'behind-minibuffer) + ;; Behind the minibuffer + (let ((ris (sort (delq nil (mapcar (lambda (cl) + (let ((ri (xwem-cl-get-sys-prop cl 'xwem-rooticon))) + (and ri (>= (+ (X-Geom-y (xwem-rooticon-xgeom ri)) + (X-Geom-height (xwem-rooticon-xgeom ri))) + (- (X-Geom-height (xwem-rootgeom)) h)) + ri))) + xwem-clients)) + (lambda (ri1 ri2) + (< (X-Geom-x (xwem-rooticon-xgeom ri1)) + (X-Geom-x (xwem-rooticon-xgeom ri2)))))) + ri1 ri2 + (x 0)) + (while ris + (setq ri1 (car ris) + ri2 (cadr ris)) + (setq x (+ (X-Geom-x (xwem-rooticon-xgeom ri1)) + (X-Geom-width (xwem-rooticon-xgeom ri1)))) + (when (and ri1 ri2 + (>= (- (X-Geom-x (xwem-rooticon-xgeom ri2)) x) w)) + (setq ris nil)) + (setq ris (cdr ris))) + (cons x (- (X-Geom-height (xwem-rootgeom)) h)))) + + ((eq xwem-rooticon-placing 'random) + (cons (random (- (X-Geom-width (xwem-rootgeom)) w)) + (random (- (X-Geom-height (xwem-rootgeom)) h))))))) + +(defun xwem-rooticon-create (cl) + "Create rooticon for CL." + (let ((wmh (xwem-hints-wm-hints (xwem-cl-hints cl))) + (ri (make-xwem-rooticon :cl cl)) + place) + ;; Fill pixmap/mask fields + (cond ((and (X-WMHints-iconpixmap-p wmh) + (= (XGetDepth (xwem-dpy) (xwem-rootwin)) + (XGetDepth (xwem-dpy) (make-X-Pixmap :id (X-WMHints-icon-pixmap wmh))))) + ;; Has a pixmap of same depth as root window + (setf (xwem-rooticon-xpixmap ri) + (make-X-Pixmap :id (X-WMHints-icon-pixmap wmh))) + (when (X-WMHints-iconmask-p wmh) + (setf (xwem-rooticon-xpixmask ri) + (make-X-Pixmap :id (X-WMHints-icon-mask wmh))))) + (t (unless xwem-rooticon-default-pixmap + (setq xwem-rooticon-default-pixmap + (cons (X:xpm-pixmap-from-file + (xwem-dpy) (xwem-rootwin) + (expand-file-name xwem-rooticon-default-icon xwem-icons-dir)) + (X:xpm-pixmap-from-file + (xwem-dpy) (xwem-rootwin) + (expand-file-name xwem-rooticon-default-icon xwem-icons-dir) + t)))) + (setf (xwem-rooticon-xpixmap ri) (car xwem-rooticon-default-pixmap)) + (setf (xwem-rooticon-xpixmask ri) (cdr xwem-rooticon-default-pixmap)))) + + (setf (xwem-rooticon-xgeom ri) + (XGetGeometry (xwem-dpy) (xwem-rooticon-xpixmap ri))) + + (setq place (xwem-rooticon-select-place + cl (X-Geom-width (xwem-rooticon-xgeom ri)) + (X-Geom-height (xwem-rooticon-xgeom ri)))) + (setf (X-Geom-x (xwem-rooticon-xgeom ri)) (car place)) + (setf (X-Geom-y (xwem-rooticon-xgeom ri)) (cdr place)) + (setf (xwem-rooticon-xriwin ri) + (XCreateWindow (xwem-dpy) (xwem-rootwin) + (X-Geom-x (xwem-rooticon-xgeom ri)) + (X-Geom-y (xwem-rooticon-xgeom ri)) + (X-Geom-width (xwem-rooticon-xgeom ri)) + (X-Geom-height (xwem-rooticon-xgeom ri)) + 0 + nil nil nil + (make-X-Attr :override-redirect t +:event-mask (Xmask-or XM-ButtonPress + XM-ButtonRelease + XM-ButtonMotion + XM-Exposure)))) + + ;; Apply mask + (when (xwem-rooticon-xpixmask ri) + (X-XShapeMask (xwem-dpy) (xwem-rooticon-xriwin ri) + X-XShape-Bounding X-XShapeSet 0 0 + (xwem-rooticon-xpixmask ri))) + + (X-Win-EventHandler-add (xwem-rooticon-xriwin ri) + 'xwem-rooticon-ev-handler nil + (list X-ButtonPress X-ButtonRelease + X-DestroyNotify X-Expose)) + (X-Win-put-prop (xwem-rooticon-xriwin ri) 'xwem-rooticon ri) + (xwem-cl-put-sys-prop cl 'xwem-rooticon ri) + ri)) + +(defun xwem-rooticon-draw (ri &optional x y w h) + (XCopyArea (xwem-dpy) (xwem-rooticon-xpixmap ri) + (xwem-rooticon-xriwin ri) (XDefaultGC (xwem-dpy)) + (or x 0) (or y 0) + (or w (X-Geom-width (xwem-rooticon-xgeom ri))) + (or h (X-Geom-height (xwem-rooticon-xgeom ri))) + (or x 0) (or y 0)) + + ;; Icon label + (when (or xwem-rooticon-show-label + (and xwem-rooticon-default-show-label + (eq (car xwem-rooticon-default-pixmap) + (xwem-rooticon-xpixmap ri)) + (eq (cdr xwem-rooticon-default-pixmap) + (xwem-rooticon-xpixmask ri)))) + (XImageString (xwem-dpy) (xwem-rooticon-xriwin ri) + (xwem-face-get-gc 'xwem-rooticon-face nil (xwem-rooticon-cl ri)) + 0 (- (X-Geom-height (xwem-rooticon-xgeom ri)) + (X-Font-fontdescent (X-Gc-font (xwem-face-get-gc 'xwem-rooticon-face)))) + (xwem-cl-wm-icon-name (xwem-rooticon-cl ri))))) + +;;; Hooking into clients handling +(define-xwem-deffered xwem-rooticon-apply-state (ri) + "Show/hide rooticon RI according to RI's client state." + (when (xwem-rooticon-p ri) + (case (xwem-cl-state (xwem-rooticon-cl ri)) + (iconified + (XLowerWindow (xwem-dpy) (xwem-rooticon-xriwin ri)) + (XMapWindow (xwem-dpy) (xwem-rooticon-xriwin ri)) + (xwem-rooticon-draw ri)) + + (t (XUnmapWindow (xwem-dpy) (xwem-rooticon-xriwin ri)))))) + +(defun xwem-rooticon-cl-state-change-hook (cl old-state new-state) + "Handle CL's state change." + (let ((ri (xwem-cl-get-sys-prop cl 'xwem-rooticon))) + ;; Create rooticon if not yet created + (when (and (eq new-state 'iconified) + (not ri)) + (setq ri (xwem-rooticon-create cl))) + (when ri + (xwem-rooticon-apply-state ri)))) + +(defun xwem-rooticon-cl-destroy (cl) + (let ((ri (xwem-cl-get-sys-prop cl 'xwem-rooticon))) + (when ri + (xwem-cl-rem-sys-prop cl 'xwem-rooticon) + (XDestroyWindow (xwem-dpy) (xwem-rooticon-xriwin ri)) + (X-invalidate-cl-struct ri)))) + +(defun xwem-rooticon-init () + "Initialize root icons." + (xwem-message 'init "Initializing root icons ...") + (add-hook 'xwem-cl-state-change-hook 'xwem-rooticon-cl-state-change-hook) + (add-hook 'xwem-cl-destroy-hook 'xwem-rooticon-cl-destroy) + (xwem-message 'init "Initializing root icons ... done")) + +;;; Commands +(define-xwem-command xwem-rooticon-smart-move () + "Interactively move rooticon. +If only clicked(not moving) bypass button release event." + (xwem-interactive) + + (unless (button-press-event-p xwem-last-event) + (error 'xwem-error "`xwem-rooticon-smart-move' must be bound to mouse event")) + + (let ((xev (xwem-next-event nil (list X-ButtonRelease X-MotionNotify)))) + (X-Event-CASE xev + (:X-ButtonRelease + (xwem-dispatch-command-xevent xev)) + + (:X-MotionNotify + (declare (special xwem-click-rooticon)) + (let ((sx (- (X-Event-xmotion-root-x xev) + (X-Geom-x (xwem-rooticon-xgeom xwem-click-rooticon)))) + (sy (- (X-Event-xmotion-root-y xev) + (X-Geom-y (xwem-rooticon-xgeom xwem-click-rooticon)))) + (done nil)) + (xwem-mouse-grab xwem-cursor-move (xwem-rooticon-xriwin xwem-click-rooticon) + (Xmask-or XM-ButtonMotion XM-ButtonRelease)) + (xwem-unwind-protect + (while (not done) + (X-Event-CASE + (setq xev (xwem-next-event + nil (list X-MotionNotify X-ButtonRelease))) + (:X-ButtonRelease (setq done t)) + + (:X-MotionNotify + (setf (X-Geom-x (xwem-rooticon-xgeom xwem-click-rooticon)) + (- (X-Event-xmotion-root-x xev) sx)) + (setf (X-Geom-y (xwem-rooticon-xgeom xwem-click-rooticon)) + (- (X-Event-xmotion-root-y xev) sy)) + (XMoveWindow (xwem-dpy) (xwem-rooticon-xriwin xwem-click-rooticon) + (X-Geom-x (xwem-rooticon-xgeom xwem-click-rooticon)) + (X-Geom-y (xwem-rooticon-xgeom xwem-click-rooticon)))))) + (xwem-mouse-ungrab))))))) + +(define-xwem-command xwem-rooticon-select-cl () + "Select roowin client." + (xwem-interactive) + + (unless (or (button-press-event-p xwem-last-event) + (button-release-event-p xwem-last-event)) + (error 'xwem-error "`xwem-rooticon-select-cl' must be bound to mouse event")) + + (declare (special xwem-click-rooticon)) + (let ((ricl (xwem-rooticon-cl xwem-click-rooticon))) + (when (and (xwem-cl-p ricl) (xwem-cl-managed-p ricl)) + (if (xwem-dummy-client-p ricl) + (xwem-activate ricl) + (xwem-select-client ricl))))) + +(defun xwem-rooticon-genmenu (ri) + (list "XWEM RootIcon" + (vector "Select" `(xwem-select-client ,(xwem-rooticon-cl ri))) + (vector "Info" `(xwem-client-info ,(xwem-rooticon-cl ri))))) + +(define-xwem-command xwem-rooticon-menu () + "Popup rooticon menu." + (xwem-interactive) + (let ((ri (X-Win-get-prop (X-Event-win xwem-last-xevent) 'xwem-rooticon))) + (when (xwem-rooticon-p ri) + (xwem-popup-menu (xwem-rooticon-genmenu ri))))) + +(defun xwem-rooticon-set-position (cl prop val) + "Set CL's rooticon position property PROP to VAL." + (let ((ri (xwem-cl-get-sys-prop cl 'xwem-rooticon))) + (if (not (xwem-rooticon-p ri)) + (xwem-cl-put-prop cl prop val) + + (setf (X-Geom-x (xwem-rooticon-xgeom ri)) (car val)) + (setf (X-Geom-y (xwem-rooticon-xgeom ri)) (cdr val)) + (XMoveWindow (xwem-dpy) (xwem-rooticon-xriwin ri) + (X-Geom-x (xwem-rooticon-xgeom ri)) + (X-Geom-y (xwem-rooticon-xgeom ri)))))) + +(defun xwem-rooticon-get-position (cl prop) + "Return CL's rooticon position property PROP." + (let ((ri (xwem-cl-get-sys-prop cl 'xwem-rooticon))) + (if (not (xwem-rooticon-p ri)) + (xwem-cl-get-prop cl prop) + (cons (X-Geom-x (xwem-rooticon-xgeom ri)) + (X-Geom-y (xwem-rooticon-xgeom ri)))))) + +(define-xwem-client-property rooticon-position nil + "Client's rooticon position." +:type '(cons (number :tag "X") + (number :tag "Y")) +:set 'xwem-rooticon-set-position +:get 'xwem-rooticon-get-position) + + +(provide 'xwem-rooticon) + +;;;; On-load actions: +(if xwem-started + (xwem-rooticon-init) + (add-hook 'xwem-before-init-wins-hook 'xwem-rooticon-init)) + +;;; xwem-rooticon.el ends here Index: lisp/xwem-selections.el =================================================================== RCS file: lisp/xwem-selections.el diff -N lisp/xwem-selections.el --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ lisp/xwem-selections.el 1 Jan 2005 04:41:16 -0000 ＠＠ -0,0 +1,154 ＠＠ +;;; xwem-selections.el --- Support for X selections. + +;; Copyright (C) 2004 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Created: Wed May 5 17:06:41 MSD 2004 +;; Keywords: xwem +;; X-CVS: $Id: xwem-selections.el,v 1.2 2004/12/05 05:52:30 youngs Exp $ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; + +;;; Code: + +(re + +;;; On-load actions +(add-to-list 'xwem-minor-mode-alist + '(xwem-sm-mode xwem-sm-mode-line)) (provide 'xwem-smartmods) Index: lisp/xwem-sound.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-sound.el,v retrieving revision 1.6 diff -u -u -r1.6 xwem-sound.el --- lisp/xwem-sound.el 16 Dec 2004 08:08:13 -0000 1.6 +++ lisp/xwem-sound.el 1 Jan 2005 04:41:16 -0000 ＠＠ -5,7 +5,7 ＠＠ ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> ;; Wed Jan 28 22:25:44 MSK 2004 ;; Keywords: xwem -;; X-CVS: $Id: xwem-sound.el,v 1.6 2004/12/16 08:08:13 youngs Exp $ +;; X-CVS: $Id: xwem-sound.el,v 1.5 2004/12/05 05:52:30 youngs Exp $ ;; This file is part of XWEM. ＠＠ -34,7 +34,9 ＠＠ ;;; Code: +(require 'xwem-load) +;;; Customisation (defgroup xwem-sound nil "Group to customize XWEM sounds." :prefix "xwem-sound-" ＠＠ -42,15 +44,14 ＠＠ :group 'xwem) (defcustom xwem-sound-default-alist - '((default :sound bass) - (undefined-key :sound drum) - (command-fail :sound bass) - (quit :sound quiet :volume 75) - (ready :sound cuckoo) - (alarm :sound cuckoo :volume 100) - (msg-warning :sound clink :volume 70) - (msg-error :sound bong :volume 100) - ) + '((default :sound bass) + (undefined-key :sound drum) + (command-fail :sound bass) + (quit :sound quiet :volume 75) + (ready :sound cuckoo) + (alarm :sound cuckoo :volume 100) + (warning :sound clink :volume 70) + (error :sound bong :volume 100)) "The alist of sounds and associated error symbols. Used to set `xwem-sound-alist' in `xwem-sound-load-default'." :group 'xwem-sound ＠＠ -83,10 +84,8 ＠＠ ;; alarm: used by reminders (alarm :sound t :pitch 2000 :duration 150 :volume 100) - ;; (xwem-message 'warn ..) - (msg-warning :sound t :pitch 50 :duration 10 :volume 100) - ;; (xwem-message 'err ..) - (msg-error :sound t :pitch 3000 :duration 50 :volume 100) + (warning :sound t :pitch 50 :duration 10 :volume 100) + (error :sound t :pitch 3000 :duration 50 :volume 100) ) "X Bell oriented candidate for `xwem-sound-alist'. Format is identical as for `xwem-sound-default-alist'." ＠＠ -124,6 +123,7 ＠＠ :type 'string :group 'xwem-sound) +;;;###autoload (defcustom xwem-sound-list '((xwem-sound-file-load "bass-snap" 'bass 100) (xwem-sound-file-load "drum-beep" 'drum 100) ＠＠ -143,6 +143,8 ＠＠ :type 'boolean :group 'xwem-sound) +;;; Internal variables + ;;;###autoload (defvar xwem-sound-alist nil "Sound alist for use by XWEM. ＠＠ -152,23 +154,23 ＠＠ quit -- After \\<xwem-global-map>\\[xwem-kbd-quit] undefined-key -- Keybinding undefined. command-fail -- When execution of command failed. - msg-warning -- Some one warnings you. - msg-error -- Some one reports you an error. + warning -- Some one warnings you. + error -- Some one reports you an error. ready -- Time consumed task has been done. alarm -- Used by reminders.") (defun xwem-sound-file-load (filename sound-name &optional volume) "Read an audio FILE and return a valid node for use in `xwem-sound-alist'." (unless (symbolp sound-name) - (error "SOUND-NAME not a symbol")) + (error 'xwem-error "SOUND-NAME not a symbol")) (unless (or (null volume) (integerp volume)) - (error "VOLUME not an integer or nil")) + (error 'xwem-error "VOLUME not an integer or nil")) (let ((file (locate-file filename xwem-sound-directory-list xwem-sound-extension-list)) buf data) (unless file - (error "Couldn't locate sound file %s" filename)) + (error 'xwem-error "Couldn't locate sound file %s" filename)) (unwind-protect (save-excursion ＠＠ -194,9 +196,8 ＠＠ (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy) :function X-GXInvert :subwindow-mode X-IncludeInferiors)))) - (XGrabServer xdpy) - (unwind-protect + (xwem-unwind-protect (progn (XFillRectangle xdpy (xwem-frame-xwin frame) gc 0 0 (xwem-frame-width frame) ＠＠ -209,10 +210,7 ＠＠ gc 0 0 (xwem-frame-width frame) (xwem-frame-height frame))) (XUngrabServer xdpy) - (XFreeGC xdpy gc)) - - (XSyncEvents (xwem-dpy)) - )) + (XFreeGC xdpy gc)))) ;;;###autoload (defun xwem-play-sound (sound &optional volume) Index: lisp/xwem-special.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-special.el,v retrieving revision 1.9 diff -u -u -r1.9 xwem-special.el --- lisp/xwem-special.el 16 Dec 2004 08:08:13 -0000 1.9 +++ lisp/xwem-special.el 1 Jan 2005 04:41:17 -0000 ＠＠ -5,7 +5,7 ＠＠ ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> ;; Created: Thu Dec 4 15:01:21 MSK 2003 ;; Keywords: xwem, xlib -;; X-CVS: $Id: xwem-special.el,v 1.9 2004/12/16 08:08:13 youngs Exp $ +;; X-CVS: $Id: xwem-special.el,v 1.8 2004/12/08 19:11:30 lg Exp $ ;; This file is part of XWEM. ＠＠ -57,22 +57,19 ＠＠ ;; - Models ;;; Code: -(eval-when-compile - (require 'xlib-xwin) - (require 'xwem-misc)) +(require 'xwem-load) +(require 'xwem-manage) + +(eval-when-compile + (defvar x-emacs-application-class nil)) + +;;; Customisation (defgroup xwem-special nil "Group to customize special emacs frames handling." :prefix "xwem-special-" -:group 'xwem) +:group 'xwem-modes) -;;;###autoload -(defcustom xwem-special-enabled t - "*Non-nil mean make xwem to understand emacs special frames." -:type 'boolean -:group 'xwem-special) - -;;;###autoload (defcustom xwem-special-frame-name "xwem-special-frame" "*Name for special emacs frames" :type 'string ＠＠ -92,7 +89,20 ＠＠ (defcustom xwem-special-border-color "red4" "Border color of special Emacs frames." -:type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) +:type 'color +:group 'xwem-special) + +(defcustom xwem-special-auto-hide nil + "*Non-nill mean that special frames will autohide when loses focus or visibility." +:type 'boolean +:group 'xwem-special) + +(defcustom xwem-special-hide-method 'XDestroyWindow + "*Method used to hide special frames. +One of 'XDestroyWindow or 'XUnmapWindow. +If 'XUnmapWindow than special frames will not be removed from clients +list, so it will be possible to access them after hidding." +:type 'boolean :group 'xwem-special) (defcustom xwem-special-menubar-visible-p nil ＠＠ -105,10 +115,52 ＠＠ :type 'boolean :group 'xwem-special) -;; Internal variables +(defcustom xwem-special-display-buffer-names nil + "*List of buffer names to display using special frame." +:type '(repeat string) +:group 'xwem-special) + +(defcustom xwem-special-display-buffer-strategy 'half + "*Strategy to use when display one of `xwem-special-display-buffer-names' buffer in special frame." +:type '(choice (const :tag "Half screen" half) + (const :tag "Center" centre)) +:group 'xwem-special) + +(defcustom xwem-special-default-strategy 'half + "*Default strategy to use when displaying special Emacs frame." +:type '(choice (const :tag "Half screen" half) + (const :tag "Fill current client" fill) + (const :tag "Center" centre)) +:group 'xwem-special) + +(defcustom xwem-special-fill-border-width 10 + "*Pixels border when using `fill' strategy." +:type 'number +:group 'xwem-special) + +;;; Internal variables + (defvar xwem-special-frames-list nil "List of special frames.") +(defun xwem-special-frame-init () + "Initialize stuff to work with special emacs frames." + (setq special-display-frame-plist + (plist-put special-display-frame-plist 'minibuffer nil)) + (setq special-display-frame-plist + (plist-put special-display-frame-plist 'name xwem-special-frame-name)) + (setq special-display-frame-plist + (plist-put special-display-frame-plist 'border-width xwem-special-border-width)) + (setq special-display-frame-plist + (plist-put special-display-frame-plist 'border-color xwem-special-border-color)) + (setq special-displa + + ;; Operate on unmapped window + (XSelectInput (xwem-dpy) win 0) + + (when fgeom + (xwem-cl-correct-size-for-size cl fgeom)) + (xwem-cl-apply-xgeom-1 cl) + + (XReparentWindow (xwem-dpy) win par-win + (X-Geom-x (xwem-cl-xgeom cl)) + (X-Geom-y (xwem-cl-xgeom cl))) - ;; XXX -- this should be in ~/.xwem/xwemrc.el -; (add-to-list 'special-display-regexps (cons "*Help" nil)) -; (add-to-list 'special-display-regexps (cons "*Completions" nil)) - ) + ;; Setup events handler for special frames + (XSelectInput (xwem-dpy) win + (Xmask-or XM-FocusChange XM-VisibilityChange XM-StructureNotify)) + (X-Win-EventHandler-add-new win 'xwem-special-evhandler) + + ;; Select client + (xwem-special-select cl))) +(define-xwem-deffered xwem-special-apply-state (cl) + "Apply CL's state to life." + (cond ((eq (xwem-cl-state cl) 'active) + (XRaiseWindow (xwem-dpy) (xwem-cl-xwin cl)) + (XMapWindow (xwem-dpy) (xwem-cl-xwin cl))) + + ((eq (xwem-cl-state cl) '(inactive iconify)) + (XUnmapWindow (xwem-dpy) (xwem-cl-xwin cl)) + (xwem-special-revert-focus cl)))) + +(defun xwem-activate-emacs-special (cl &optional type) + "Activate method for special emacs frame client CL." + (xwem-special-apply-state cl)) + +(defun xwem-deactivate-emacs-special (cl &optional type) + "Demanage specal xwem client CL." + (cond ((eq type 'deactivate) + (xwem-special-apply-state cl)))) + +(defun xwem-iconify-emacs-special (cl) + "Iconify handler for special frame." + (xwem-special-apply-state cl)) (provide 'xwem-special) + +;;;; On-load actions: +;; Define application +(add-to-list 'xwem-applications-alist + `("xemacs-xwem-special" + (and (class-name ,(concat "^" x-emacs-application-class "$")) + (class-inst ,(concat "^" xwem-special-frame-name "$"))))) + +;; Add manage type +(define-xwem-manage-model emacs-special + "Managing model for special Emacs frames." +:match-spec '(application "xemacs-xwem-special") + +:manage-method 'xwem-manage-emacs-special +:activate-method 'xwem-activate-emacs-special +:deactivate-method 'xwem-deactivate-emacs-special +:iconify-method 'xwem-iconify-emacs-special) + +;; - Before init hook +(if xwem-started + (xwem-special-frame-init) + (add-hook 'xwem-before-init-hook 'xwem-special-frame-init)) ;;; xwem-special.el ends here Index: lisp/xwem-strokes.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-strokes.el,v retrieving revision 1.8 diff -u -u -r1.8 xwem-strokes.el --- lisp/xwem-strokes.el 16 Dec 2004 08:08:14 -0000 1.8 +++ lisp/xwem-strokes.el 1 Jan 2005 04:41:17 -0000 ＠＠ -3,9 +3,10 ＠＠ ;; Copyright (C) 2003 by Free Software Foundation, Inc. ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Steve Youngs <steve(a)youngs.au.com> ;; Created: Thu Dec 4 17:42:12 MSK 2003 ;; Keywords: xwem, xlib -;; X-CVS: $Id: xwem-strokes.el,v 1.8 2004/12/16 08:08:14 youngs Exp $ +;; X-CVS: $Id: xwem-strokes.el,v 1.7 2004/12/05 22:37:35 lg Exp $ ;; This file is part of XWEM. ＠＠ -31,23 +32,17 ＠＠ ;; ;;; Code: -(eval-when-compile - (require 'xwem-misc)) + (require 'strokes) -(require 'xwem-compat) -(require 'xwem-keyboard) +(require 'xwem-load) +(require 'xwem-misc) +;;; Customisation (defgroup xwem-strokes nil "Group to customize XWEM strokes." :prefix "xwem-strokes-" :group 'xwem) -;;;###autoload -(defcustom xwem-strokes-enabled t - "*Non-nil mean xwem-stroke is enabled." -:type 'boolean -:group 'xwem-strokes) - (defcustom xwem-strokes-grid 25 "*XWEM strokes Grid resolution. Look at `strokes-grid-resolution' for details." ＠＠ -61,30 +56,33 ＠＠ (defcustom xwem-strokes-file "xwem-strokes.el" "*File contained strokes for xwem stroke mode." -:type 'string +:type 'file :group 'xwem-strokes) -(defcustom xwem-strokes-click-command - (lambda () - (interactive) - (xwem-message 'info "Default `xwem-strokes-click-command'.")) +(defcustom xwem-strokes-click-command 'xwem-strokes-default-click-command "*Command to execute when stroke is actually a `click'." :type 'function :group 'xwem-strokes) -(defcustom xwem-strokes-cursor-type 'X-XC-dot +(defcustom xwem-strokes-cursor-type '(X-XC-dot) "*Type of cursor to use when XWEM enters strokes mode." :type (xwem-cursor-shape-choice) +:set (xwem-cus-set-cursor-shape xwem-strokes-cursor) +:initialize 'custom-initialize-default :group 'xwem-strokes) (defcustom xwem-strokes-cursor-foreground-color "#00ea00" "*Cursor's foreground color when XWEM in strokes mode." -:type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) +:type 'color +:set (xwem-cus-set-cursor-foreground xwem-strokes-cursor) +:initialize 'custom-initialize-default :group 'xwem-strokes) (defcustom xwem-strokes-cursor-background-color "#002800" "*Cursor's background color when XWEM in strokes mode." -:type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) +:type 'color +:set (xwem-cus-set-cursor-background xwem-strokes-cursor) +:initialize 'custom-initialize-default :group 'xwem-strokes) (defcustom xwem-strokes-gc-function 'X-GXCopy ＠＠ -92,34 +90,32 ＠＠ :type (xwem-gc-function-choice) :group 'xwem-strokes) -(defcustom xwem-strokes-sleep 0.2 - "*How many seconds sleep before executing stroke." -:type 'float -:group 'xwem-strokes) - -(defface xwem-face-strokes-begin - `((t (:foreground "red4" :background "black" :line-width 10 - :subwindow-mode X-IncludeInferiors - :function (eval xwem-strokes-gc-function)))) - "Face used to begin stroke." +(define-xwem-face xwem-strokes-face + `(((background light) + (:foreground "red4" :background "black")) + ((background dark) + (:foreground "red" :background "black")) + ((background begin light) + (:foreground "magenta4" :background "black" +:line-width 12 :cap-style X-CapRound)) + ((background begin dark) + (:foreground "magenta" :background "black" +:line-width 12 :cap-style X-CapRound)) + (t (:foreground "red4" :background "black" +:line-width 8 :cap-style X-CapRound +:subwindow-mode X-IncludeInferiors +:function (eval xwem-strokes-gc-function)))) + "Face used to draw strokes." :group 'xwem-strokes :group 'xwem-faces) -(defface xwem-face-strokes - `((t (:foreground "magenta4" :background "black" :line-width 7 - :subwindow-mode X-IncludeInferiors - :function (eval xwem-strokes-gc-function) - :cap-style X-CapRound))) - "Face used to draw stroke." -:group 'xwem-strokes -:group 'xwem-faces) +;;; Internal variables ;; Stroke variables (defvar xwem-strokes-keymap (let ((map (make-sparse-keymap))) (set-keymap-default-binding map 'xwem-strokes-nocmd) - (define-key map xwem-quit-key 'xwem-keyboard-quit) (define-key map [button2] 'xwem-strokes-idescribe) (define-key map [button1] 'xwem-strokes-ibutton1) (define-key map [button1up] 'xwem-strokes-ibutton1up) ＠＠ -132,12 +128,21 ＠＠ (defvar xwem-strokes-map nil "Stroke map for XWEM.") -(defvar xwem-strokes-curr nil "Current events list, it passed to `stroke-' routines.") -(defvar xwem-strokes-defining nil "Non-nil mean that we defining stroke now.") +(defvar xwem-strokes-curr nil + "Current events list, it passed to `stroke-' routines.") +(defvar xwem-strokes-defining nil + "Non-nil mean that we defining stroke now.") -(defvar xwem-strokes-cursor nil "Cursor used while reading stroke.") +(defvar xwem-strokes-cursor nil + "Cursor used while reading stroke.") ;; Functions +(define-xwem-command xwem-strokes-default-click-command () + "Default command to execute when strokes detected click. +Click is detected when no mouse moving occured while doing stroke." + (xwem-interactive) + (xwem-message 'info "Such an ugly `xwem-strokes-click-command', which you normally should customize.")) + (defun xwem-strokes-save-strokes () "Save user defined strokes to file named by `xwem-strokes-file'. Modification to `strokes-prompt-user-save-strokes' to work with xwem's stuff." ＠＠ -145,7 +150,7 ＠＠ (strokes-file (expand-file-name xwem-strokes-file xwem-dir))) (flet ((yes-or-no-p-maybe-dialog-box (prompt) - (lambda () (xwem-under-minib-focus (yes-or-no-p prompt))))) + (lambda () (xwem-under-minibuffer (yes-or-no-p prompt))))) (funcall 'strokes-prompt-user-save-strokes)) ;; Fix stroke-file .. ＠＠ -161,7 +166,7 ＠＠ (defun xwem-strokes-load-strokes () "Load user defined strokes from file named by `xwem-strokes-file'." (if (file-exists-p (expand-file-name xwem-strokes-file xwem-dir)) -; (xwem-under-minib-focus +; (xwem-under-minibuffer ; (and (y-or-n-p ; (format "XWEM: No strokes loaded. Load `%s'? " ; (expand-file-name xwem-strokes-file xwem-dir))) ＠＠ -204,7 +209,7 ＠＠ ((string= type "key") (let ((xwem-interactively t)) (prog1 - (xwem-kbd-key-binding + (xwem-kbd-get-binding (xwem-read-key-sequence "XWEM Stroke key: ")) (xwem-kbd-stop-grabbing)))) (t nil)))) ＠＠ -215,8 +220,8 ＠＠ "Execute CMD. CMD is one of interactive command or keysequence." (if (xwem-strokes-cmd-valid-p cmd) (cond ((stringp cmd) - (xwem-kbd-force-mods-release) - (xwem-key-send-ekeys cmd)) + (xwem-deffered-funcall 'xwem-kbd-force-mods-release) + (xwem-deffered-funcall 'xwem-key-send-ekeys cmd)) ((vectorp cmd) (xwem-kbd-force-mods-release) ＠＠ -225,7 +230,7 ＠＠ (t (command-execute cmd))) - (xwem-message 'err "Invalid CMD in `xwem-strokes-execute-command'."))) + (xwem-message 'error "Invalid strokes command `%S'" cmd))) (defun xwem-strokes-execute-stroke (stroke) "Given STROKE, execute the command corresponds to it." ＠＠ -244,13 +249,13 ＠＠ (xwem-strokes-load-strokes) (if (null xwem-strokes-map) - (xwem-message 'err "No strokes defined; use `xwem-strokes-global-set-stroke'") + (xwem-message 'error "No strokes defined; use `xwem-strokes-global-set-stroke'") ;; Re-execute stroke in hope it will be founded in loaded ;; xwem-strokes-map. (xwem-strokes-execute-stroke stroke))) - (t (xwem-message 'err "No stroke matches; see variable `xwem-strokes-minimum-match-score'"))) + (t (xwem-message 'error "No stroke matches; see variable `xwem-strokes-minimum-match-score'"))) )) (defun xwem-strokes-define-or-execute (st) ＠＠ -270,9 +275,9 ＠＠ "Start new stroke or new stick at X Y point." (push (cons x y) xwem-strokes-curr) (XDrawArc (xwem-dpy) (xwem-rootwin) - (xwem-face-get-gc 'xwem-face-strokes-begin) - x y 1 1 0 (* 360 64)) - ) + (xwem-face-get-gc 'xwem-strokes-face + (list 'background 'begin (xwem-misc-xwin-background-mode (xwem-rootwin) x y))) + x y 1 1 0 (* 360 64))) (defun xwem-strokes-continue (x y) "Continue stroke at X Y." ＠＠ -282,7 +287,7 ＠＠ (push (cons x y) xwem-strokes-curr) (XDrawLine (xwem-dpy) (xwem-rootwin) - (xwem-face-get-gc 'xwem-face-strokes) + (xwem-face-get-gc 'xwem-strokes-face) old-x old-y x y))) ;;;###autoload(autoload 'xwem-strokes-define "xwem-strokes" "" t) ＠＠ -373,43 +378,30 ＠＠ (Xmask-or XM-ButtonPress XM-ButtonRelease XM-ButtonMotion)) (setq xwem-strokes-curr nil) - (xwem-strokes-start-new (X-Event-xbutton-root-x xwem-last-xevent) (X-Event-xbutton-root-y xwem-last-xevent)) ;; Event loop - (unwind-protect + (xwem-unwind-protect (let ((gc-cons-threshold most-positive-fixnum) ; inhibit GC'ing - (xwem-override-map xwem-strokes-keymap) - (xwem-keyboard-echo-keystrokes) ; Do not show - (xwem-bypass-quit t) ; Bypass quit signal in `xwem-kbd-handle-keybutton-from-emacs' - (xwem-stroke-complexp complexp) - (xwem-stroke-done nil) - xev eev) - (declare (special xwem-stroke-done)) - (declare (special xwem-stroke-complexp)) - - (setq xwem-bypass-quit xwem-bypass-quit) ;shutup compiler - - (while (not xwem-stroke-done) - (setq xev (xwem-next-event)) - - (when (member (X-Event-type xev) - (list X-KeyPress X-ButtonPress X-ButtonRelease X-MotionNotify)) - (setq eev (car (xwem-kbd-xevents->emacs-events (list xev) t))) - - (if (eq (event-type eev) 'motion) - (xwem-strokes-motion xev) - - (xwem-kbd-handle-keybutton-from-emacs eev xev))) - )) + (xwem-override-local-map xwem-strokes-keymap) ; override local keymap + (xwem-keyboard-echo-keystrokes nil) ; Do not show + (xwem-stroke-complexp complexp) + (xwem-stroke-done nil) + xev) + (declare (special xwem-stroke-done)) + (declare (special xwem-stroke-complexp)) + + (while (not xwem-stroke-done) + (X-Event-CASE (setq xev (xwem-next-event)) + (:X-MotionNotify (xwem-strokes-motion xev)) + ((:X-KeyPress :X-ButtonPress :X-ButtonRelease) + (xwem-dispatch-command-xevent xev))))) (xwem-strokes-done)) ;; Execute or define stroke (let* ((grid-locs (strokes-renormalize-to-grid xwem-strokes-curr xwem-strokes-grid)) (st (strokes-fill-stroke (strokes-eliminate-consecutive-redundancies grid-locs)))) - - (xwem-strokes-define-or-execute st)) - ) + (xwem-strokes-define-or-execute st))) (defun xwem-strokes-done (&optional xev) "Uninstalls stuff installed by `xwem-strokes-go'. ＠＠ -421,8 +413,9 ＠＠ (X-Event-xbutton-root-y xev))) (cons 0 0))))) (x 10000000) (y 1000000) (xma 0) (yma 0) - (thi (* 2 (max (xwem-face-tag 'xwem-face-strokes-begin :line-width) - (xwem-face-tag 'xwem-face-strokes :line-width))))) + (thi (* 2 (max (xwem-face-line-width 'xwem-strokes-face '(background begin light)) + (xwem-face-line-width 'xwem-strokes-face '(background begin dark)) + (xwem-face-line-width 'xwem-strokes-face))))) (while xsc (while (not (consp (car xsc))) ＠＠ -458,7 +451,7 ＠＠ (strokes-renormalize-to-grid pix-lock xwem-strokes-grid))) xwem-strokes-map)) - (xwem-message 'info "Current stroke stands for: %S" (car match)))) + (xwem-message 'info "Current stroke executes: %S" (car match)))) ;;;###autoload(autoload 'xwem-strokes-begin "xwem-strokes" "" t) (define-xwem-command xwem-strokes-begin (arg) ＠＠ -497,6 +490,22 ＠＠ (xwem-message 'info "Last stroke has been deleted.")) (xwem-message 'info "Nothing done."))) +(defun xwem-strokes-sort (smap &optional how) + "Sort strokes map SMAP." + (sort (copy-list smap) + (lambda (s1 s2) + (let ((c1 (cdr s1)) + (c2 (cdr s2))) + (cond ((and (stringp c1) (stringp c2)) + (string-lessp c1 c2)) + ((and (symbolp c1) (symbolp 2)) + (string-lessp (symbol-name c1) (symbol-name c2))) + ((stringp c1) t) + ((and (vectorp c1) (not (stringp c2))) t) + ((and (symbolp c1) (not (stringp c2)) (not (vectorp c2))) t) + ((and (functionp c1) (not (stringp c2)) (not (vectorp c2)) (not (symbolp c2))) t)))) + )) + ;;;###autoload(autoload 'xwem-strokes-list "xwem-strokes" "" t) (define-xwem-command xwem-strokes-list (arg) "List strokes defined for XWEM use. ＠＠ -508,7 +517,6 ＠＠ (let ((stb (get-buffer-create "*XWEM Strokes*"))) (xwem-special-popup-frame stb) - (with-current-buffer stb (setq buffer-read-only nil) (erase-buffer) ＠＠ -521,14 +529,14 ＠＠ (when (xwem-strokes-cmd-valid-p stroke-cmd) (strokes-xpm-for-stroke stroke " *strokes-xpm*") (newline 1) - (insert-char ?\x20 60) + (insert-char ?\x20 62) (beginning-of-line) (insert (xwem-strokes-cmd-type stroke-cmd)) (beginning-of-line) - (forward-char 18) + (forward-char 17) (insert (xwem-strokes-cmd-description stroke-cmd)) (beginning-of-line) - (forward-char 61) + (forward-char 62) (make-annotation (make-glyph (list (vector 'xpm ＠＠ -537,14 +545,17 ＠＠ (point-max " *strokes-xpm*") " *strokes-xpm*")) [string :data "[Image]"])) - + (xwem-win-cl (xwem-frame-selwin frame))) + + +;;;; Win structures +(defstruct xwem-win + geom ; window geometry (border width is internal window width) + clients ; xwem clients list managed in window + cl ; Current window's client + frame ; xwem frame + dead ; non-nil if window is dead + deleted ; non-nil if window was deleted + next ; next window in windows chain + prev ; previous window in windows chain + hchild ; horisontal child (if any) + vchild ; vertical child (if any) + parent ; parent window + + plist) ; User defined plist + +(defstruct (xwem-win-saved (:predicate xwem-iswinsaved-p)) + geom ; saved window geometry + clients ; clients managed in window + cl ; Current window's client + plist ; properties + selwin-p ; non-nil if window is selected in frame + first-hchild first-vchild + next prev) + +(defstruct (xwem-win-config (:predicate xwem-iswinconfig-p)) + frame ; window's frame + frame-xgeom ; saved frame X-Geom + frame-properties ; saved frame properties + current-cl ; cl in selected window + min-width min-height + saved-root-window) + +(defsubst xwem-win-alive-p (window) + "Return non-nil if WINDOW is alive." + (and (xwem-win-p window) + (xwem-frame-alive-p (xwem-win-frame window)) + (not (xwem-win-deleted window)) + (not (xwem-win-dead window)))) + +(defmacro xwem-win-x (win) + `(X-Geom-x (xwem-win-geom ,win))) +(defsetf xwem-win-x (win) (x) + `(setf (X-Geom-x (xwem-win-geom ,win)) ,x)) + +(defmacro xwem-win-y (win) + `(X-Geom-y (xwem-win-geom ,win))) +(defsetf xwem-win-y (win) (y) + `(setf (X-Geom-y (xwem-win-geom ,win)) ,y)) + +(defmacro xwem-win-width (win) + `(X-Geom-width (xwem-win-geom ,win))) +(defsetf xwem-win-width (win) (width) + `(setf (X-Geom-width (xwem-win-geom ,win)) ,width)) + +(defmacro xwem-win-height (win) + `(X-Geom-height (xwem-win-geom ,win))) +(defsetf xwem-win-height (win) (height) + `(setf (X-Geom-height (xwem-win-geom ,win)) ,height)) + +(defmacro xwem-win-border-width (win) + `(X-Geom-border-width (xwem-win-geom ,win))) +(defsetf xwem-win-border-width (win) (border-width) + `(setf (X-Geom-border-width (xwem-win-geom ,win)) ,border-width)) + +(defsubst xwem-win-get-prop (win prop) + "Get WIN's property PROP." + (plist-get (xwem-win-plist win) prop)) + +(defsubst xwem-win-rem-prop (win prop) + "Remove WIN's property PROP." + (setf (xwem-win-plist win) + (plist-remprop (xwem-win-plist win) prop))) + +(defsubst xwem-win-put-prop (win prop val) + "Set WIN's property PROP to VAL." + (if val + (setf (xwem-win-plist win) + (plist-put (xwem-win-plist win) prop val)) + (xwem-win-rem-prop win prop))) +(put 'xwem-win-put-prop 'lisp-indent-function 2) + +(defmacro xwem-win-selected () + "Return selected window." + '(and (xwem-frame-alive-p (xwem-frame-selected)) + (xwem-frame-selwin (xwem-frame-selected)))) + +(defmacro xwem-win-selected-p (win) + "Return non-nil if WIN is currently selected window." + `(eq ,win (xwem-win-selected))) + +(defsubst xwem-win-selwin-p (win) + "Return non-nil if WIN is localy selected window in WIN's frame." + (and (xwem-win-p win) + (eq win (xwem-frame-selwin (xwem-win-frame win))))) + +(defsubst xwem-win-cl-current-p (cl &optional win) + "Return non-nil if CL is current WIN's client." + (unless win + (setq win (xwem-cl-win cl))) + (when (xwem-win-p win) + (eq cl (xwem-win-cl win)))) + + +;;;; Client structures +(defstruct xwem-hints + ;; TODO: add more + wm-normal-hints + wm-hints + wm-class + wm-command + wm-name + wm-icon-name + wm-transient-for + wm-protocols) + (eq (cdr e1) (cdr e2))))) + (cons fun args) + (dll-element xwem-deffered-dll node)) + (setq exists t)))) + (setq node (elib-node-right node))) + + (if exists + (dll-delete xwem-deffered-dll node) + (enqueue-eval-event 'xwem-deffered-process nil)) + + (xwem-debug 'xwem-deffered "---------> IN %S" 'fun) + (dll-enter-last xwem-deffered-dll (cons fun args)))) + +(defun xwem-deffered-process (obj-notused) + "Process deffering commands." + (declare (special xwem-deffering-p)) + + (unless xwem-deffering-p + (let ((xwem-deffering-p t)) + (run-hooks 'xwem-pre-deffering-hook) + (setq xwem-pre-deffering-hook nil))) + + (while (not (dll-empty xwem-deffered-dll)) + (let ((el (dll-first xwem-deffered-dll)) + (xwem-deffering-p t)) + (xwem-debug 'xwem-deffered "<--------- OUT %S" '(car el)) + (dll-delete-first xwem-deffered-dll) + (apply (car el) (cdr el)))) + + (unless xwem-deffering-p + (let ((xwem-deffering-p t)) + (run-hooks 'xwem-post-deffering-hook) + (setq xwem-post-deffering-hook nil)))) + +(defun xwem-add-hook-post-deffering (hook &optional append) + "Add HOOK to `xwem-post-deffering-hook'." + (add-hook 'xwem-post-deffering-hook hook append) + ;; Run it to be sure to enter deffering + (xwem-deffered-push 'ignore)) + +;; Dont know where to put this macro, so putten here. +(defmacro define-xwem-deffered (deff-name normal-name arglist docstring &rest body) + "Define new deffered function with function name DEFF-NAME. +Deffered function is function which is called when XEmacs is about to became idle. + +Another advantage of deffered function is that only one instance of +function will be called with same arguments. For example if you have +`my-defffun' deffered function and you call twice `(my-defffun 1)', +`(my-defffun 1)' - then when XEmacs will be about idle only one call +occurs to `my-defffun'. However if you pass different arguments, all +calls with different arguments are called. Arguments are equal if +they are either `eq' or both are lists, where each element is `eq'. + +NAME, ARGLIST, DOCSTRING and BODY argument have same meaning as for `defun'. +If NORMAL-NAME is specified, also define non-deffered variant of DEFF-NAME function. +If NORMAL-NAME is ommited, then normal-name constructed by +concatination of DEFF-NAME and \"-1\"." + (unless (and (not (null normal-name)) + (symbolp normal-name)) + ;; If NORMAL-NAME ommited + (setq body (cons docstring body)) + (setq docstring arglist) + (setq arglist normal-name) + (setq normal-name (intern (concat (symbol-name deff-name) "-1")))) + + `(progn + (defun ,normal-name ,arglist + ,docstring + ,＠body) + + (defun ,deff-name (&rest args) + ,(concat "Deffered variant of `" (symbol-name normal-name) "'.") + (apply (quote xwem-deffered-push) (quote ,normal-name) args)))) + +(defmacro xwem-deffered-funcall (fun &rest args) + "Call FUN with ARGS, deffering funcall to FUN." + `(xwem-deffered-push ,fun ,＠args)) + +(defmacro xwem-unwind-protect (body-form &rest unwind-forms) + "Execute BODY-FORM protecting it in safe more with UNWIND-FORMS. +`xwem-unwind-protect' differs from `unwind-protect' that +`xwem-unwind-protect' executes UNWIND-FORMS even when debugging." + `(prog1 + (condition-case xwem-unwind-error + ,body-form + (t ,＠unwind-forms + (apply 'error (car xwem-unwind-error) (cdr xwem-unwind-error)))) + ,＠unwind-forms)) +(put 'xwem-unwind-protect 'lisp-indent-function 1) + +(defmacro xwem-overriding-local-map (nlm &rest forms) + "Execute FORMS installing `xwem-overriding-local-map' to NLM. +Do it in safe manner." + `(xwem-unwind-protect + (let ((xwem-override-local-map ,nlm)) + ,＠forms))) +(put 'xwem-overriding-local-map 'lisp-indent-function 'defun) + + +(provide 'xwem-struct) + +;;; xwem-struct.el ends here Index: lisp/xwem-tabbing.el ====================================== (define-xwem-command xwem-tabber-popup-cl-menu () "Popup clients menu." (xwem-interactive) (when (xwem-cl-alive-p xwem-tabber-click-cl) - (xwem-popup-menu (xwem-gen-cl-menu xwem-tabber-click-cl)) - )) - -(defun xwem-tabber-event-handler (xdpy xwin xev) - "On display XDPY and window XWIN handle event XEV." - (let ((tabber (X-Win-get-prop xwin 'xwem-tabber))) - (when (xwem-tabber-p tabber) - (X-Event-CASE xev - (:X-Expose - (when (eq (xwem-frame-state (xwem-tabber-frame tabber)) 'mapped) - (xwem-tabber-draw tabber)) - ) - - (:X-DestroyNotify - (X-invalidate-cl-struct tabber)) - - ((:X-ButtonPress :X-ButtonRelease) - ;; Handle button press/release event - (let* ((x (X-Event-xbutton-event-x xev)) - (y (X-Event-xbutton-event-y xev)) - (xwem-tabber-click-frame (xwem-tabber-frame tabber)) - (xwem-tabber-click-titem - (xwem-tabber-item-at (xwem-frame-selwin xwem-tabber-click-frame) x y tabber)) - (xwem-tabber-click-cl (and (xwem-tab-item-p xwem-tabber-click-titem) - (xwem-tab-item-cl xwem-tabber-click-titem))) - (xwem-keyboard-echo-keystrokes nil) ; XXX - (xwem-override-global-map xwem-tabber-map)) - - (xwem-kbd-handle-keybutton xev))) - )))) - -;;;###autoload -(defun xwem-tabber-create (frame geom initial-state) - "Create new tabber for FRAME with GEOM and INITIAL-STATE." - (let ((xft (make-xwem-tabber :frame frame - :xgeom geom - :state initial-state)) - (xdpy (xwem-dpy)) - w preparer) - (setq w (XCreateWindow xdpy - (xwem-frame-xwin frame) - (X-Geom-x geom) (X-Geom-y geom) - (X-Geom-width geom) (X-Geom-height geom) - (X-Geom-border-width geom) - nil nil nil;X-InputOutput nil - (make-X-Attr :background-pixel (XWhitePixel (xwem-dpy)) -:backing-store X-WhenMapped - ))) - (setf (xwem-tabber-xwin xft) w) - (X-Win-put-prop w 'xwem-tabber xft) - - (XSelectInput xdpy w (Xmask-or XM-Exposure XM-StructureNotify XM-ButtonPress XM-ButtonRelease XM-ButtonMotion)) - (X-Win-EventHandler-add w 'xwem-tabber-event-handler 0 - (list X-Expose X-DestroyNotify X-ButtonPress X-ButtonRelease X-MotionNotify)) - - (setq preparer (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy)) - w (XDefaultDepth xdpy) (X-Geom-width geom) (X-Geom-height geom))) - - (setf (xwem-tabber-xpreparer xft) preparer) + (xwem-popup-menu (xwem-generate-cl-menu xwem-tabber-click-cl)))) - (XMapWindow (X-Win-dpy w) w) - xft)) - -(defun xwem-tabber-add-tab-item (tabber tab-item) - "Into TABBER tab items list add TAB-ITEM." - (pushnew tab-item (xwem-tabber-tab-items tabber))) - -(defun xwem-tabber-item-at (win x y &optional tabber) - "Return tab item at X Y in tabber." - (let ((cls (xwem-win-make-cl-list win)) - ti) - (while (and cls (not ti)) - (let* ((tit (xwem-cl-get-prop (car cls) 'xwem-tab-item)) - (xg (and (xwem-tab-item-p tit) (xwem-tab-item-rect tit)))) - (when (and xg - (<= (X-Rect-x xg) x) - (>= (+ (X-Rect-x xg) (X-Rect-width xg)) x) - (<= (X-Rect-y xg) y) - (>= (+ (X-Rect-y xg) (X-Rect-height xg)) y)) - (setq ti tit))) - (setq cls (cdr cls))) - (or ti (and (xwem-tabber-p tabber) (xwem-tabber-empty-tabi tabber))))) - -(defun xwem-tabber-headers-width (xft) - "Return width of XFT's headers." - (apply (lambda (els) - (if els (apply '+ els) 0)) - (mapcar (lambda (ti) - (X-Rect-width (xwem-tab-item-rect ti))) - (xwem-tabber-header-tabis xft)))) - -(defun xwem-tabber-tailers-width (xft) - "Return width of XFT's tailers." - (apply (lambda (els) - (if els (apply '+ els) 0)) - (mapcar (lambda (ti) - (X-Rect-width (xwem-tab-item-rect ti))) - (xwem-tabber-tailer-tabis xft)))) - -;;;###autoload -(defun xwem-tabber-regeom-window (win &optional draw-p) - (let ((tabber (xwem-frame-get-prop (xwem-win-frame win) 'xwem-tabber))) - (when (xwem-tabber-p tabber) - (xwem-tabber-regeom tabber win draw-p)))) - -;;;###autoload -(defun xwem-tabber-regeom (tabber window &optional draw-p) - "Adjust tabs geometries in TABBER." - ;; TODO: - ;; - Take into account large delimeters - (let* ((frame (xwem-tabber-frame tabber)) - (hw 0);(xwem-tabber-headers-width tabber)) - (tw 0);(xwem-tabber-tailers-width tabber)) - (twidth (- (xwem-frame-width frame) hw tw)) - (off hw) - (cls (xwem-win-make-cl-list (or window (xwem-frame-selwin (xwem-tabber-frame tabber))))) - (clsn (length cls)) ; number of clients - (dw 2) ; XXX delimeter width - (ldw 4) ; XXX large delimeter width - dwc ldwc ; dws counter and ldws counter - tiw twrem tabi rect) - - (when cls - (setq ldwc (/ clsn xwem-tab-delim-interval)) - (setq dwc (- clsn ldwc 1)) - (setq tiw (/ (- twidth (* dw dwc) (* ldw ldwc)) clsn)) ; tab item width - (setq twrem (% (- twidth (* dw dwc) (* ldw ldwc)) clsn)) ; reminder - - (while cls - (setq tabi (xwem-cl-get-prop (car cls) 'xwem-tab-item)) - (setq rect (xwem-tab-item-rect tabi)) +(defun xwem-tabber-cl-at (tabber x y) + "Return client of TABBER which rectangle covers point at X Y." + (let ((clients (xwem-tabber-clients tabber)) + (tmp-rect (xwem-tabber-rect->xpix-rect + tabber (make-X-Rect :x x :y y :width 0 :height 0))) + rect ret-cl) + ;; Adjust X and Y + (setq x (X-Rect-x tmp-rect) + y (X-Rect-y tmp-rect)) + (while clients + (setq rect (xwem-cl-tab-rect (car clients))) + (if (and rect + (<= (X-Rect-x rect) x) + (>= (+ (X-Rect-x rect) (X-Rect-width rect)) x) + (<= (X-Rect-y rect) y) + (>= (+ (X-Rect-y rect) (X-Rect-height rect)) y)) + (setq ret-cl (car clients) + clients nil) + (setq clients (cdr clients)))) + ret-cl)) + +(defun xwem-tabber-regeom (tabber) + "Adjust tab items geometries in TABBER." + ;; TODO: handle margins + (let* ((twidth (X-Geom-width (xwem-tabber-xgeom tabber))) + (theight (X-Geom-height (xwem-tabber-xgeom tabber))) + (clients (xwem-tabber-clients tabber)) + (clsn (length clients )) ; number of clients + (off 0) + tiw twrem rect) + + (when clients + (setq tiw (/ twidth clsn) + twrem (% twidth clsn)) + + (while clients + ;; Setup CL's tab rectangle rectangle + (unless (xwem-cl-tab-rect (car clients)) + (setf (xwem-cl-tab-rect (car clients)) + (make-X-Rect :x 0 :y 0 :width 0 :height 0))) + (setq rect (xwem-cl-tab-rect (car clients))) (setf (X-Rect-x rect) off) - (setf (X-Rect-width rect) (+ tiw (if (cdr cls) 0 twrem))) - - ;; XXX - (setf (X-Rect-height rect) (X-Geom-height (xwem-tabber-xgeom tabber))) - - (if (zerop (% (length cls) xwem-tab-delim-interval)) - (progn - (setf (xwem-tab-item-delim-width tabi) ldw) - (setq off (+ off tiw ldw))) - - (setf (xwem-tab-item-delim-width tabi) dw) - (setq off (+ off tiw dw))) - - (setq cls (cdr cls)))) + (setf (X-Rect-width rect) (+ tiw (if (cdr clients) 0 twrem))) + (setf (X-Rect-height rect) theight) - (when draw-p - (xwem-tabber-draw tabber)) - )) + (setq off (+ off (X-Rect-width rect))) + (setq clients (cdr clients)))))) (defsubst xwem-tabber-safe-regeom (tabber &optional draw-p) "Saf variant of `xwem-tabber-regeom'." (and (xwem-tabber-p tabber) - (xwem-tabber-regeom tabber nil draw-p))) - -(defun xwem-tabber-draw-empty (tabber) - "Draw empty." - (let* ((frame (xwem-tabber-frame tabber)) - (selected-p (xwem-frame-selected-p frame)) - (xgeom (xwem-tabber-xgeom tabber))) - - ;; Create fake CL and tabi - (setf (xwem-tabber-empty-tabi tabber) - (make-xwem-tab-item :rect (make-X-Rect :x (X-Geom-x xgeom) -:y (X-Geom-y xgeom) -:width (X-Geom-width xgeom) -:height(X-Geom-height xgeom)) -:state (if selected-p - 'xwem-face-tab-selected-active - 'xwem-face-tab-nonselected-active) -:format xwem-tab-empty-name)) - - (xwem-tab-item-draw-format-1 (xwem-tabber-empty-tabi tabber) tabber))) + (xwem-tabber-regeom tabber))) -;;;###autoload -(defun xwem-tabber-draw (tabber) - "Draw tabber." - (let* ((cls (xwem-win-make-cl-list (xwem-frame-selwin (xwem-tabber-frame tabber)))) - (tabis (mapcar (lambda (cl) (xwem-cl-get-prop cl 'xwem-tab-item)) cls));(xwem-tabber-tab-items tabber)) - tab-item) - - (if (not tabis) - (xwem-tabber-draw-empty tabber) - - (X-invalidate-cl-struct (xwem-tabber-empty-tabi tabber)) ; make sure here no empty tabitem - (while tabis - (setq tab-item (car tabis)) - (xwem-tab-item-draw-format tab-item) - - (setq tabis (cdr tabis)) - )))) - -(defun xwem-tab-item-get-fill-gc (tabi &optional tabber) - "Return GC associated with TABI." - ;; TODO: write me - (xwem-face-get-gc (xwem-tab-item-state tabi))) - -(defun xwem-tab-item-get-draw-gc (tabi &optional tabber) - "Return GC to draw TABI's text." - (xwem-face-get-gc (xwem-tab-item-state tabi))) - - -;;; Drawers -;;;###autoload -(defun xwem-tab-item-draw-format (tabi) - (when (and (xwem-cl-p (xwem-tab-item-cl tabi)) - (xwem-frame-p (xwem-cl-frame (xwem-tab-item-cl tabi)))) - (xwem-tab-item-draw-format-1 tabi))) - -(defun xwem-tab-item-draw-format-1 (tabi &optional tabber) - "Draw TABI's format string." - (let* ((rect (xwem-tab-item-rect tabi)) - (tabxwin (xwem-tabber-xwin (or tabber (xwem-tab-item-tabber tabi)))) - (xprep (xwem-tabber-xpreparer (or tabber (xwem-tab-item-tabber tabi)))) - (cl (xwem-tab-item-cl tabi)) - (fmt (xwem-tab-item-format tabi)) +;; Drawings +(defun xwem-tabber-xpix-rect->rect (tabber rect) + (let ((x0 (X-Rect-x rect)) + (y0 (X-Rect-y rect)) + (w0 (X-Rect-width rect)) + (h0 (X-Rect-height rect)) + x y w h) + (case (xwem-frame-property (xwem-tabber-frame tabber) 'title-layout) + (left + (setq y x0 + x (- (X-Geom-width (xwem-tabber-xgeom tabber)) y0 h0) + h w0 + w h0)) + (right + (setq x y0 + y (- (X-Geom-height (xwem-tabber-xgeom tabber)) x0 w0) + w h0 + h w0)) + (t (setq x x0 + y y0 + w w0 + h h0))) + (make-X-Rect :x x :y y :width w :height h))) + +(defun xwem-tabber-rect->xpix-rect (tabber rect) + (xwem-tabber-xpix-rect->rect tabber rect)) + +(define-xwem-deffered xwem-tabber-redraw xwem-tabber-redraw-1 (tabber &optional x y width height) + "Redraw TABBER's rectangle specified by X, Y, WIDTH and HEIGHT. +If one of optional arguments ommited, full redraw." + (when (xwem-tabber-p tabber) + (let* ((xgeom (xwem-tabber-xgeom tabber)) + (x (or x 0)) + (y (or y 0)) + (width (or width (X-Geom-width xgeom))) + (height (or height (X-Geom-height xgeom))) + (tl (xwem-frame-property (xwem-tabber-frame tabber) 'title-layout))) + (cond ((memq tl '(top bottom)) + (XCopyArea (xwem-dpy) (xwem-tabber-xpix-copy tabber) (xwem-tabber-xwin tabber) + (XDefaultGC (xwem-dpy)) x y width height x y)) + ((memq tl '(left right)) + (let* ((ximg (XGetImage (xwem-dpy) (xwem-tabber-xpix-copy tabber) + x y width height X-AllPlanes X-ZPixmap)) + (rxd (xwem-misc-rotate-data (nth 4 ximg) width height + (XGetDepth (xwem-dpy) + (xwem-tabber-xpix-copy tabber)) + (if (eq tl 'left) 'left 'right))) + (dst-height width) + (dst-width height) + dst-x dst-y) + (if (eq tl 'left) + (setq dst-x y + dst-y (- (X-Geom-width xgeom) x width)) + (setq dst-x (- (X-Geom-height xgeom) y height) + dst-y x)) + (XPutImage (xwem-dpy) (xwem-tabber-xwin tabber) + (XDefaultGC (xwem-dpy)) + (XGetDepth (xwem-dpy) (xwem-tabber-xpix-copy tabber)) + dst-width dst-height dst-x dst-y nil X-ZPixmap rxd))))))) + +(define-xwem-deffered xwem-tabber-redraw-xrect xwem-tabber-redraw-xrect-1 (tabber &optional xrect) + "Redraw part of TABBER. +XRECT specifies geometry to redraw. +Defaultly full redraw." + (when (xwem-tabber-p tabber) + (unless xrect + (setq xrect (X-Geom-to-X-Rect (xwem-tabber-xgeom tabber)))) + + (xwem-tabber-redraw tabber + (X-Rect-x xrect) (X-Rect-y xrect) + (X-Rect-width xrect) (X-Rect-height xrect)))) + +(defsubst xwem-tabber-frame-win-clients (tabber) + "Return list of managed clients in TABBER's window." + (delq nil (mapcar (lambda (cl) + (and (xwem-cl-managed-p cl '(active inactive)) cl)) + (xwem-win-clients (xwem-frame-selwin (xwem-tabber-frame tabber)))))) + +(defsubst xwem-tabber-clients-equal (cls1 cls2) + "Return non-nil if each element of CLS1 and CLS2 is `eq'." + (and (= (length cls1) (length cls2)) + (not (memq nil (or (mapcar* 'eq cls1 cls2)))))) + +(define-xwem-deffered xwem-tabber-draw-format xwem-tabber-draw-format-1 (cl &optional tabber force-update) + "Draw CL's tab. +If FORCE-UPDATE is non-nil also copy to TABBER x window." + (when (or (null cl) (xwem-cl-alive-p cl)) + ;; Either empty or valid client + (let* ((tabber (or tabber (xwem-cl-tabber cl))) + (rect (or (and (xwem-cl-p cl) (xwem-cl-tab-rect cl)) + (let ((xgeom (xwem-tabber-xgeom tabber))) + (make-X-Rect :x 0 :y 0 :width (X-Geom-width xgeom) +:height (X-Geom-height xgeom))))) + (fmt (or (and (xwem-cl-p cl) + (xwem-client-property cl 'xwem-tab-format)) + xwem-tab-empty-format)) + (xprep (xwem-tabber-xpreparer tabber)) + (xpcop (xwem-tabber-xpix-copy tabber)) (xoff (X-Rect-x rect)) (yoff (X-Rect-y rect)) - fill-gc currgc fi item fmt-index - sfg) + tag-set currgc fi item fmt-index sfg) - ;; Update tabi's state - (when (xwem-cl-p cl) - (let ((frame (xwem-cl-frame cl))) - (when (xwem-frame-p frame) - (if (xwem-frame-selected-p frame) - (setf (xwem-tab-item-state tabi) - (if (xwem-win-cl-current-p cl) - 'xwem-face-tab-selected-active - 'xwem-face-tab-selected-passive)) - - ;; XXX - (setf (xwem-tab-item-state tabi) - (if (xwem-win-cl-current-p cl) - 'xwem-face-tab-nonselected-active - 'xwem-face-tab-nonselected-passive)))))) - - (setq fill-gc (xwem-tab-item-get-fill-gc tabi tabber)) - (setq currgc (xwem-tab-item-get-draw-gc tabi tabber)) - - (setq sfg (X-Gc-foreground fill-gc)) - (unwind-protect - (progn - (setf (X-Gc-foreground fill-gc) (X-Gc-background fill-gc)) - (XChangeGC (xwem-dpy) fill-gc) - - (XFillRectangles (xwem-dpy) xprep fill-gc (list rect))) + ;; Setup TAG-SET + (if (xwem-frame-selected-p (xwem-tabber-frame tabber)) + (if (xwem-cl-p cl) + (if (xwem-win-cl-current-p cl) + (setq tag-set (list 'frame-selected 'tab-selected)) + (setq tag-set (list 'frame-selected 'tab-nonselected))) + + ;; Empty tab item + (setq tag-set (list 'frame-selected 'tab-selected))) + + (if (xwem-cl-p cl) + (if (xwem-win-cl-current-p cl) + (setq tag-set (list 'frame-nonselected 'tab-selected)) + (setq tag-set (list 'frame-nonselected 'tab-nonselected))) - (setf (X-Gc-foreground fill-gc) sfg) - (XChangeGC (xwem-dpy) fill-gc)) + ;; Empty tab item + (setq tag-set (list 'frame-nonselected 'tab-selected)))) - (XSetClipRectangles (xwem-dpy) fill-gc 0 0 (list rect)) + ;; Setup currgc, xprep, tabxwin + (setq currgc (xwem-face-get-gc (xwem-cl-tab-face cl) tag-set cl)) (XSetClipRectangles (xwem-dpy) currgc 0 0 (list rect)) - ;; In case there no cl attached, skip format field - (unless (xwem-cl-p cl) - (setq fmt xwem-tab-empty-name)) + (setq sfg (X-Gc-foreground currgc)) + (xwem-unwind-protect + (progn + (setf (X-Gc-foreground currgc) (X-Gc-background currgc)) + (XChangeGC (xwem-dpy) currgc) + (XFillRectangles (xwem-dpy) xprep currgc (list rect)) + (XFillRectangles (xwem-dpy) xpcop currgc (list rect))) + (setf (X-Gc-foreground currgc) sfg) + (XChangeGC (xwem-dpy) currgc)) + ;; Process format string (setq fmt-index 0) (while (and (< xoff (+ (X-Rect-x rect) (X-Rect-width rect))) - (< fmt-index (length fmt))) - (setq fi (aref fmt fmt-index)) + (< fmt-index (length fmt))) + ;; Extract ITEM + (setq fi (aref fmt fmt-index)) (incf fmt-index) (if (eq fi ?%) - (progn - (setq fi (aref fmt fmt-index)) - (setq item (cond ((= fi ?n) (xwem-hints-wm-name (xwem-cl-hints cl))) - ((= fi ?c) (car (xwem-hints-wm-class (xwem-cl-hints cl)))) - ((= fi ?C) (cadr (xwem-hints-wm-class (xwem-cl-hints cl)))) - ((= fi ?i) (xwem-icons-cl-icon cl)) - ((= fi ?s) (xwem-cl-get-psize cl)) - ((= fi ?S) (xwem-cl-get-usize cl)) - ((= fi ?u) (xwem-cl-get-uptime cl)) - ((= fi ?U) (xwem-cl-get-uptime cl)) - ((= fi ?f) (int-to-string (xwem-frame-num (xwem-cl-frame cl)))) - ((= fi ?*) (if (xwem-cl-marked-p cl) "*" "-")) - ((= fi ?#) (if (XWMProtocol-set-p (xwem-dpy) - (xwem-hints-wm-protocols (xwem-cl-hints cl)) - "WM_DELETE_WINDOW") - "#" "-")) - ((= fi ?%) "%") - - ;; Emacs lisp - ((= fi ?{) - (let ((substr (substring fmt (1+ fmt-index))) - elstr) - (unless (string-match "\$\\([^%]\\|%[^}]\$*\\)%}" substr) - (signal 'search-failed fmt "%}")) + (progn + (setq fi (aref fmt fmt-index)) + (setq item (cond ((= fi ?n) (xwem-client-name cl)) + ((= fi ?c) (car (xwem-hints-wm-class (xwem-cl-hints cl)))) + ((= fi ?C) (cdr (xwem-hints-wm-class (xwem-cl-hints cl)))) + ((= fi ?i) (xwem-icons-cl-icon cl (and (not (xwem-frame-selected-p (xwem-cl-frame cl))) + '(shade)))) + ((= fi ?s) (xwem-cl-get-psize cl)) + ((= fi ?S) (xwem-cl-get-usize cl)) + ((= fi ?u) (xwem-cl-get-uptime cl)) + ((= fi ?U) (xwem-cl-get-uptime cl)) + ((= fi ?f) (int-to-string (xwem-frame-num (xwem-cl-frame cl)))) + ((= fi ?F) (xwem-frame-name (xwem-cl-frame cl))) + ((= fi ?*) (if (xwem-cl-marked-p cl) "*" "-")) + ((= fi ?#) (if (XWMProtocol-set-p (xwem-dpy) + (xwem-hints-wm-protocols (xwem-cl-hints cl)) + "WM_DELETE_WINDOW") + "#" "-")) + ((= fi ?I) (let ((ip (X-WMHints-input-p (xwem-hints-wm-hints (xwem-cl-hints cl)))) + (tf (XWMProtocol-set-p (xwem-dpy) + (xwem-hints-wm-protocols (xwem-cl-hints cl)) + "WM_TAKE_FOCUS"))) + (cond ((and ip tf) "L") + (ip "P") + + (xwem-frame-selected-p (xwem-tabber-frame tabber))) + (xwem-tabber-put-prop tabber 'xwem-frame-selected-p + (xwem-frame-selected-p (xwem-tabber-frame tabber))) + (setq force-draw t)) + + (if (or (xwem-tabber-regeom-p tabber) force-draw) + (setq cls-to-draw (or (xwem-tabber-clients tabber) (list nil)) + need-draw-p t) ; all clients + (setq cls-to-draw (delq nil (mapcar (lambda (cl) + (and (xwem-cl-get-sys-prop cl 'xwem-tab-need-redraw) cl)) + (xwem-tabber-clients tabber))) + need-draw-p cls-to-draw)) + + (when need-draw-p + (mapc '(lambda (cl) (xwem-tabber-draw-format-1 cl tabber)) cls-to-draw) + (xwem-tabber-redraw-1 tabber))))) + +(defun xwem-tabber-event-handler (xdpy xwin xev) + "On display XDPY and window XWIN handle event XEV." + (let ((tabber (X-Win-get-prop xwin 'xwem-tabber))) + (when (xwem-tabber-p tabber) + (X-Event-CASE xev + (:X-Expose + (xwem-tabber-redraw-xrect + tabber (xwem-tabber-rect->xpix-rect + tabber + (make-X-Rect :x (X-Event-xexpose-x xev) +:y (X-Event-xexpose-y xev) +:width (X-Event-xexpose-width xev) +:height (X-Event-xexpose-height xev))))) + + (:X-DestroyNotify + (when (xwem-tabber-p tabber) + (XFreePixmap (xwem-dpy) (xwem-tabber-xpreparer tabber)) + (XFreePixmap (xwem-dpy) (xwem-tabber-xpix-copy tabber)) + (X-invalidate-cl-struct tabber))) + + ((:X-ButtonPress :X-ButtonRelease) + ;; Handle button press/release event + (let* ((x (X-Event-xbutton-event-x xev)) + (y (X-Event-xbutton-event-y xev)) + (xwem-tabber-click-frame (xwem-tabber-frame tabber)) + (xwem-tabber-click-cl (xwem-tabber-cl-at tabber x y)) + (xwem-keyboard-echo-keystrokes nil)) ; XXX + (xwem-overriding-local-map + (if (xwem-frame-dedicated-p (xwem-tabber-frame tabber)) + xwem-tabber-dedicated-map + xwem-tabber-map) + (xwem-dispatch-command-xevent xev)))) + )))) + +(defun xwem-tabber-create (frame) + "Create new tabber for FRAME." + (let* ((xgeom (make-X-Geom :x 0 :y 0 +:width 1 :height 1 +:border-width 0)) ; XXX + (tabber (make-xwem-tabber :frame frame +:xgeom xgeom)) + (xdpy (xwem-dpy)) + (w (XCreateWindow xdpy + (xwem-frame-xwin frame) + (X-Geom-x xgeom) (X-Geom-y xgeom) + (X-Geom-width xgeom) (X-Geom-height xgeom) + (X-Geom-border-width xgeom) + nil nil nil ;X-InputOutput nil + (make-X-Attr :background-pixel (XWhitePixel (xwem-dpy)) +:bit-gravity X-StaticGravity +:backing-store X-Always)))) + + (setf (xwem-tabber-xwin tabber) w) + (X-Win-put-prop w 'xwem-tabber tabber) + + (XSelectInput xdpy w (Xmask-or XM-Exposure XM-StructureNotify + XM-ButtonPress XM-ButtonRelease XM-ButtonMotion)) + (X-Win-EventHandler-add w 'xwem-tabber-event-handler 0 + (list X-Expose X-DestroyNotify X-ButtonPress + X-ButtonRelease X-MotionNotify)) + + ;; Adjust XGEOM and create Preparer and xpix-copy +; (setf (xwem-tabber-xpreparer tabber) +; (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy)) +; w (XDefaultDepth xdpy) (X-Geom-width xgeom) (X-Geom-height xgeom))) +; (setf (xwem-tabber-xpix-copy tabber) +; (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy)) +; w (XDefaultDepth xdpy) (X-Geom-width xgeom) (X-Geom-height xgeom))) + (xwem-tabber-resize tabber) + + ;; Draw tabber contents and map its window + (xwem-tabber-draw-1 tabber t) + (XMapWindow (X-Win-dpy w) w) + tabber)) + +(defun xwem-tabber-move-resize (tabber) + "Move TABBER to its place according to title-layout, etc," + (let* ((frame (xwem-tabber-frame tabber)) + (th (xwem-frame-property frame 'title-height)) + (ibw (xwem-frame-property frame 'inner-border-width)) + (xgeom (xwem-tabber-xgeom tabber)) + x y w h) + (when (xwem-frame-p frame) + (case (xwem-frame-property frame 'title-layout) + (top + (setf (X-Geom-width xgeom) (- (xwem-frame-width frame) ibw ibw) + (X-Geom-height xgeom) th) + (setq x ibw + y ibw + w (X-Geom-width xgeom) + h (X-Geom-height xgeom))) + (bottom + (setf (X-Geom-width xgeom) (- (xwem-frame-width frame) ibw ibw) + (X-Geom-height xgeom) th) + (setq x ibw + y (- (xwem-frame-height frame) th ibw) + w (X-Geom-width xgeom) + h (X-Geom-height xgeom))) + (left + (setf (X-Geom-width xgeom) (- (xwem-frame-height frame) ibw ibw) + (X-Geom-height xgeom) th) + (setq x ibw + y ibw + w (X-Geom-height xgeom) + h (X-Geom-width xgeom))) + + (right + (setf (X-Geom-width xgeom) (- (xwem-frame-height frame) ibw ibw) + (X-Geom-height xgeom) th) + (setq x (- (xwem-frame-width frame) th ibw) + y ibw + w (X-Geom-height xgeom) + h (X-Geom-width xgeom)))) + + (XMoveResizeWindow (xwem-dpy) (xwem-tabber-xwin tabber) x y w h)))) -(defun xwem-tabber-resize (tabber width height) +(defun xwem-tabber-resize (tabber) "Resize TABBER to WIDTH, HEIGHT." (let* ((xgeom (xwem-tabber-xgeom tabber)) (owidth (X-Geom-width xgeom)) (oheight (X-Geom-height xgeom))) - (setf (X-Geom-width xgeom) width) - (setf (X-Geom-height xgeom) height) - (XResizeWindow (xwem-dpy) (xwem-tabber-xwin tabber) width height) - (when (or (> width owidth) (> height oheight)) + (xwem-tabber-move-resize tabber) + + (when (or (> (X-Geom-width xgeom) owidth) + (> (X-Geom-height xgeom) oheight)) ;; Recreate xpreparer - (XFreePixmap (xwem-dpy) (xwem-tabber-xpreparer tabber)) + (when (X-Pixmap-p (xwem-tabber-xpreparer tabber)) + (XFreePixmap (xwem-dpy) (xwem-tabber-xpreparer tabber))) + (when (X-Pixmap-p (xwem-tabber-xpix-copy tabber)) + (XFreePixmap (xwem-dpy) (xwem-tabber-xpix-copy tabber))) (setf (xwem-tabber-xpreparer tabber) - (XCreatePixmap (xwem-dpy) (make-X-Pixmap :dpy (xwem-dpy) :id (X-Dpy-get-id (xwem-dpy))) - (xwem-tabber-xwin tabber) (XDefaultDepth (xwem-dpy)) (X-Geom-width xgeom) (X-Geom-height xgeom)))) - )) + (XCreatePixmap (xwem-dpy) (make-X-Pixmap :dpy (xwem-dpy) +:id (X-Dpy-get-id (xwem-dpy))) + (xwem-tabber-xwin tabber) (XDefaultDepth (xwem-dpy)) + (X-Geom-width xgeom) (X-Geom-height xgeom))) + (setf (xwem-tabber-xpix-copy tabber) + (XCreatePixmap (xwem-dpy) (make-X-Pixmap :dpy (xwem-dpy) +:id (X-Dpy-get-id (xwem-dpy))) + (xwem-tabber-xwin tabber) (XDefaultDepth (xwem-dpy)) + (X-Geom-width xgeom) (X-Geom-height xgeom)))) + + (xwem-tabber-regeom tabber))) ;;; Frame Hooks -(defun xwem-tabber-on-frame-redraw (frame) - "To be used in `xwem-frame-redraw-hook'." - (let ((tabber (xwem-frame-get-prop frame 'xwem-tabber))) - (when (xwem-tabber-p tabber) - (xwem-tabber-draw tabber)))) +(defun xwem-tabber-on-frame-select-deselect () + "Redraw tabbers when switching frames." + (when (xwem-frame-p (xwem-frame-selected)) + (xwem-tabber-draw (xwem-frame-tabber (xwem-frame-selected))))) (defun xwem-tabber-on-frame-resize (frame) "FRAME just resized, apply changes to tabber, if any." - (let ((tabber (xwem-frame-get-prop frame 'xwem-tabber))) + (let ((tabber (xwem-frame-tabber frame))) (when (xwem-tabber-p tabber) - (xwem-tabber-resize tabber (xwem-frame-width frame) - (xwem-frame-get-prop frame 'title-height)) - (xwem-win-map (lambda (win) - (xwem-tabber-regeom tabber win (xwem-win-selected-p win))) - (xwem-frame-selwin frame)) - ))) + (xwem-tabber-resize tabber) + (xwem-tabber-draw tabber t)))) (defun xwem-tabber-on-frame-creation (frame) "FRAME just created." - (xwem-frame-put-prop frame 'xwem-tabber - (xwem-tabber-create frame (make-X-Geom :x 0 :y 0 :width (xwem-frame-width frame) -:height (xwem-frame-get-prop frame 'title-height)) - 'unknown))) + (setf (xwem-frame-tabber frame) (xwem-tabber-create frame))) + +(defun xwem-tabber-frame-prop-notifier (frame prop value) + "FRAME just changed property PROP to VALUE." + (let ((tabber (xwem-frame-tabber frame))) + (when (xwem-tabber-p tabber) + (case prop + (title-layout + (if (eq value 'none) + (XUnmapWindow (xwem-dpy) (xwem-tabber-xwin tabber)) + (XMapWindow (xwem-dpy) (xwem-tabber-xwin tabber)))) + ) + (xwem-tabber-on-frame-resize frame)))) +;; Win hooks (defun xwem-tabber-on-win-switch (owin nwin) "Window switch occured OWIN -> NWIN." - (when (not (eq owin nwin)) - (xwem-tabber-check-and-regeom nwin))) + (and (xwem-win-selwin-p nwin) + (xwem-tabber-draw (xwem-frame-tabber (xwem-win-frame nwin))))) (defun xwem-tabber-on-win-change (win) "WIN's clients list changed." - (xwem-tabber-check-and-regeom win)) + (and (xwem-win-selwin-p win) + (xwem-tabber-draw (xwem-frame-tabber (xwem-win-frame win))))) +(defun xwem-tabber-on-win-ccl-change (win old-cl new-cl) + "WIN's current client just changed." + (when (xwem-cl-p old-cl) + (xwem-tabber-on-cl-change old-cl)) + (when (xwem-cl-p new-cl) + (xwem-tabber-on-cl-change new-cl))) + +;; CL hooks (defun xwem-tabber-on-cl-creation (cl) "CL just created." - ;; Make tab item for CL - (xwem-cl-put-prop cl 'xwem-tab-item - (make-xwem-tab-item :type 'client -:state 'unmapped :rect (make-X-Rect :y 0 :x 0 :width 0 :height 0) -:cl cl :format xwem-tab-default-format))) - -(defun xwem-tabber-on-cl-destroy (cl) - "CL is about to be destroyed." - (let ((tab-item (xwem-cl-get-prop cl 'xwem-tab-item)) - (win (xwem-cl-win cl))) - (when (xwem-tab-item-p tab-item) - (xwem-cl-put-prop cl 'xwem-tab-item nil) - (X-invalidate-cl-struct tab-item)) - - (xwem-tabber-check-and-regeom win) - )) - -(defun xwem-tabber-check-and-regeom (win &optional force) - "Check is regeometry needed of CL's tabber. -Return non-nil if regeom occured." - (let* ((frame (and (xwem-win-p win) (xwem-win-frame win))) - (tabber (and (xwem-frame-p frame) (xwem-frame-get-prop frame 'xwem-tabber))) - (cls (xwem-win-make-cl-list win))) - (when (xwem-tabber-p tabber) - (unless (and (not force) - (equal (xwem-tabber-get-prop tabber 'last-units) cls) - (eq (xwem-tabber-get-prop tabber 'last-win) win)) - (xwem-tabber-put-prop tabber 'last-units cls) - (xwem-tabber-put-prop tabber 'last-win win) - (xwem-tabber-regeom tabber win (xwem-win-selected-p win)) - t)))) + ;; Make tab rect for CL + (unless (xwem-cl-tab-rect cl) + (setf (xwem-cl-tab-rect cl) + (make-X-Rect :x 0 :y 0 :width 0 :height 0))) + ) (defun xwem-tabber-on-cl-change (cl &rest args) "CL just changed its component." - (let ((tab-item (xwem-cl-get-prop cl 'xwem-tab-item)) - (win (xwem-cl-win cl))) - (when (xwem-tab-item-p tab-item) - (when (and (not (xwem-tabber-check-and-regeom win)) - (xwem-win-selected-p win)) - (xwem-tab-item-draw-format-1 tab-item))))) - -;;; Test: -;(xwem-init-tabber) -;(setq tb (xwem-tabber-create (car xwem-frames-list) (make-X-Geom :x 0 :y 0 :width 600 :height 20) -; 'normal)) -;(setq ti (make-xwem-tab-item :type 'test :tabber tb -; :state 'tab-selected-active -; :rect (make-X-Rect :x 10 :y 0 :width 500 :height 20) -; :cl (xwem-cl-selected) -; :format "test %n test1")) -;(setf (xwem-tab-item-format ti) "Test %i test1") -;(setf (xwem-tab-item-state ti) 'nonselected-passive) -;(xwem-tab-item-draw-format ti) - -;(XClearArea (xwem-dpy) (xwem-tabber-xwin tb) 0 0 600 20 nil) -;(XDestroyWindow (xwem-dpy) (xwem-tabber-xwin tb)) + (let ((tabber (xwem-cl-tabber cl))) + (when (and tabber + (memq cl (xwem-tabber-clients tabber)) + (xwem-win-selwin-p (xwem-cl-win cl))) + (xwem-cl-put-sys-prop cl 'xwem-tab-need-redraw t) ; mark cl as need to be redrawed + (xwem-tabber-draw tabber)))) (provide 'xwem-tabbing) + +;;;; On-load actions: +;; - Initialize tabber +(xwem-tabber-init) ;;; xwem-tabbing.el ends here Index: lisp/xwem-theme.el =================================================================== RCS file: lisp/xwem-theme.el diff -N lisp/xwem-theme.el --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ lisp/xwem-theme.el 1 Jan 2005 04:41:17 -0000 ＠＠ -0,0 +1,506 ＠＠ +;;; xwem-theme.el --- Themes support for xwem. + +;; Copyright (C) 2004 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Created: Tue Nov 23 14:49:41 MSK 2004 +;; Keywords: xwem +;; X-CVS: $Id: xwem-theme.el,v 1.2 2004/12/05 05:52:31 youngs Exp $ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; + +;;; Code: + +(require 'xwem-load) +(require 'xwem-strokes) ; for xwem-strokes-face + +(defgroup xwem-theme nil + "Group to customize xwem themes." +:prefix "xwem-theme-" +:group 'xwem) + +(defcustom xwem-theme-default + `((face xwem-tabber-face + (((frame-selected tab-selected) + (:foreground "white" :background "green4" :bold t)) + ((delimiter-left frame-selected tab-selected) + (:foreground "white")) + ((delimiter-right frame-selected tab-selected) + (:foreground "black")) + + ((frame-selected tab-nonselected) + (:foreground "black" :background "gray80")) + ((delimiter-left frame-selected tab-nonselected) + (:foreground "white")) + ((delimiter-right frame-selected tab-nonselected) + (:foreground "black")) + + ((frame-nonselected tab-selected) + (:foreground "gray80" :background "DarkGreen" :bold t)) + ((delimiter-left frame-nonselected tab-selected) + (:foreground "white")) + ((delimiter-right frame-nonselected tab-selected) + (:foreground "black")) + + ((frame-nonselected tab-nonselected) + (:foreground "black" :background "gray40")) + ((delimiter-left frame-nonselected tab-nonselected) + (:foreground "white")) + ((delimiter-right frame-nonselected tab-nonselected) + (:foreground "black")) + + (t (:foreground "white")))) + + (face x-border-face + (((selected) (:foreground "green")) + (t (:foreground "gray80")))) + + (face xwem-frame-inner-border-face + (((light nonselected) + (:foreground "gray80" :background "gray80")) + ((medium nonselected) + (:foreground "gray50" :background "gray50")) + ((dark nonselected) + (:foreground "gray20" :background "gray20")) + ((light selected) + (:foreground "cyan2" :background "cyan2")) + ((medium selected) + (:foreground "royalblue" :background "royalblue")) + ((dark selected) + (:foreground "blue4" :background "blue4")))) + + (face xwem-launch-dock-face + (((background-light) + (:foreground "gray70")) + ((background-light shadow-light) + (:foreground "white")) + ((background-light shadow-dark) + (:foreground "black")) + ((background-dark) + (:foreground "gray 50")) + ((background-dark shadow-light) + (:foreground "white")) + ((background-dark shadow-dark) + (:foreground "black")) + (t (:foreground "gray70" :background "black")))) + + (face xwem-strokes-face + (((background light) + (:foreground "red4" :background "black")) + ((background dark) + (:foreground "red" :background "black")) + ((background begin light) + (:foreground "magenta4" :background "black" +:line-width 12 :cap-style X-CapRound)) + ((background begin dark) + (:foreground "magenta" :background "black" +:line-width 12 :cap-style X-CapRound)))) + + (face xwem-tray-delimiter-face + (((background light) + (:foreground "gray40")) + ((background light shadow) + (:foreground "gray30")) + ((background dark) + (:foreground "gray70")) + ((background dark shadow) + (:foreground "gray80")))) + + (face xwem-window-outline-face + (((frame-selected win-selected) + (:foreground "green" :background "green4" :line-width 4)) + ((frame-selected win-nonselected) + (:foreground "gray70" :background "gray70" :line-width 4)) + ((frame-nonselected win-selected) + (:foreground "green3" :background "green4" :line-width 4)) + ((frame-nonselected win-nonselected) + (:foreground "gray60" :background "gray40" :line-width 4)))) + + (face xwem-window-delimiter-face + (((horizontal) + (:foreground "royalblue" :background "black")) + ((horizontal shadow) + (:foreground "blue4" :background "black")) + ((horizontal light shadow) + (:foreground "cyan" :background "black")) + ((vertical) + (:foreground "royalblue" :background "black")) + ((shadow vertical) + (:foreground "blue4" :background "black")) + ((light shadow vertical) + (:foreground "cyan" :background "black")) + (t (:foreground "gray20" :background "black")))) + + ;; Frames properties + (frame-property inner-border-width 8) + (frame-property inner-border-thickness 2) + (frame-property title-height 18) + + ;; Clients properties + (client-property x-border-width 2) + + ;; Custom settings + (custom xwem-cursor-help-foreground-color "#00BB00") + (custom xwem-cursor-help-background-color "#009900") + (custom xwem-root-cursor-foreground-color "white") + (custom xwem-root-cursor-background-color "black") + (custom xwem-frame-cursor-foreground-color "#111111") + (custom xwem-frame-cursor-background-color "#EEEEEE") + ) + "Default xwem theme." +:type 'xwem-theme +:group 'xwem-theme) + +(defcustom xwem-theme-extrim + `((face xwem-tabber-face + (((frame-selected tab-selected) + (:foreground "white" :background "gray20" +:font "-*-fixed-medium-r-*-*-12-*-*-*-*-*-*-*" :bold t)) + ((delimiter-left frame-selected tab-selected) + (:foreground "white")) + ((delimiter-right frame-selected tab-selected) + (:foreground "black")) + + ((frame-selected tab-nonselected) + (:foreground "black" :background "gray80" :font "-*-fixed-medium-r-*-*-12-*-*-*-*-*-*-*")) + ((delimiter-left frame-selected tab-nonselected) + (:foreground "white")) + ((delimiter-right frame-selected tab-nonselected) + (:foreground "black")) + + ((frame-nonselected tab-selected) + (:foreground "gray80" : ;; Mail ＠＠ -869,10 +1039,12 ＠＠ (let* ((xdpy (X-Pixmap-dpy mask-pixmap))) (XSelectInput xdpy win (apply 'Xmask-or (delete XM-Exposure xwem-time-window-mask))) - (XCopyArea xdpy (cdr pixmap) mask-pixmap xwem-time-mask-gc + (XCopyArea xdpy (cdr pixmap) mask-pixmap + (X-Win-get-prop win 'time-mask-gc) x-off y-off width height x y) (X-XShapeMask xdpy win X-XShape-Bounding X-XShapeSet 0 0 mask-pixmap) - (XCopyArea (X-Win-dpy win) (car pixmap) win xwem-time-gc + (XCopyArea (X-Win-dpy win) (car pixmap) win + (X-Win-get-prop win 'time-gc) x-off y-off width height x y) (XSelectInput xdpy win (apply 'Xmask-or xwem-time-window-mask)) ＠＠ -958,6 +1130,26 ＠＠ "Show 0 at WIN's X Y." (xwem-time-show win x y 'load-pixmap 60 0 10 13)) +(defsubst xwem-time-show-load-35 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'load-pixmap 70 0 10 13)) + +(defsubst xwem-time-show-load-40 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'load-pixmap 80 0 10 13)) + +(defsubst xwem-time-show-load-45 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'load-pixmap 90 0 10 13)) + +(defsubst xwem-time-show-load-50 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'load-pixmap 100 0 10 13)) + +(defsubst xwem-time-show-load-55 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'load-pixmap 110 0 10 13)) + (defsubst xwem-time-show-letter (win x y) "Show 0 at WIN's X Y." (xwem-time-show win x y 'mail-pixmap 00 0 18 13)) ＠＠ -966,17 +1158,21 ＠＠ "Show 0 at WIN's X Y." (xwem-time-show win x y 'mail-pixmap 18 0 18 13)) -(defun xwem-time-show-load (win x y load-string) +(defun xwem-time-show-load (win x y load-number) "In WIN at X Y show load average represented by LOAD-STRING. Return how many pixels used." - (let ((load-number (string-to-number load-string)) - (alist (list (cons "00" 0.0) - (cons "05" (car xwem-time-load-list)) - (cons "10" (cadr xwem-time-load-list)) - (cons "15" (caddr xwem-time-load-list)) - (cons "20" (cadddr xwem-time-load-list)) - (cons "25" (cadr (cdddr xwem-time-load-list))) - (cons "30" (caddr (cdddr xwem-time-load-list))) + (let ((alist (list (cons "00" 0.0) + (cons "05" (nth 0 xwem-time-load-list)) + (cons "10" (nth 1 xwem-time-load-list)) + (cons "15" (nth 2 xwem-time-load-list)) + (cons "20" (nth 3 xwem-time-load-list)) + (cons "25" (nth 4 xwem-time-load-list)) + (cons "30" (nth 5 xwem-time-load-list)) + (cons "35" (nth 6 xwem-time-load-list)) + (cons "40" (nth 7 xwem-time-load-list)) + (cons "45" (nth 8 xwem-time-load-list)) + (cons "50" (nth 9 xwem-time-load-list)) + (cons "55" (nth 10 xwem-time-load-list)) (cons "100000" 100000))) elem load-elem) (while (>= load-number (cdr (setq elem (pop alist)))) ＠＠ -1015,16 +1211,12 ＠＠ (xwem-time-show-no-letter win x y)) 18) -(defun xwem-time-win-update (win) +(define-xwem-deffered xwem-time-win-update (win) "Show current time at X Y." (let* ((now (current-time)) (nowhigh (* (- (nth 0 now) (* (/ (nth 0 now) 10) 10)) 65536)) (time (substring (current-time-string now) 11 16)) - (load (condition-case () - (if (zerop (car (load-average))) "" - (let ((str (format " %03d" (car (load-average))))) - (concat (substring str 0 -2) "." (substring str -2)))) - (error ""))) + (load (car (load-average t))) (mail-spool-file (or display-time-mail-file (getenv "MAIL") (concat rmail-spool-directory ＠＠ -1042,7 +1234,9 ＠＠ nowhigh (* (- (nth 0 now) (* (/ (nth 0 now) 10) 10)) 65536)) (if (> (- (+ (nth 1 now) nowhigh) (+ (nth 1 start-time) - (* (- (nth 0 start-time) (* (/ (nth 0 start-time) 10) 10)) 65536))) + (* (- (nth 0 start-time) + (* (/ (nth 0 start- + (let ((xtw (xwem-time-init (xwem-dpy)))) + (unless (X-Win-p xtw) + (error 'xwem-error "Can't create xwem time window")) + + (XSelectInput (xwem-dpy) xtw (apply 'Xmask-or xwem-time-window-mask)) + (X-Win-EventHandler-add xtw 'xwem-time-event-handler nil + (list X-Expose X-MapNotify X-DestroyNotify + X-ButtonPress X-ButtonRelease)) - (XTrayInit xdpy xwem-time-window) + (xwem-XTrayInit (xwem-dpy) xtw dockid dockgroup dockalign) - (start-itimer "xwem-time" 'xwem-time-win-update - xwem-time-interval xwem-time-interval nil t xwem-time-window) - t)) + (X-Win-put-prop xtw 'xwem-time-timer + (start-itimer "xwem-time-time" + `(lambda () (xwem-time-win-update ,xtw)) + xwem-time-time-interval xwem-time-time-interval)) + (X-Win-put-prop xtw 'xwem-time-load + (start-itimer "xwem-time-load" + `(lambda () (xwem-time-load-update ,xtw)) + xwem-time-load-interval xwem-time-load-interval)) + 'started)) + +(define-xwem-command xwem-time-show-current-time-and-date () + "Display current time and date in the minibuffer." + (xwem-interactive) + (xwem-message 'info "Time: %s, Load: %S" + (current-time-string) (load-average))) + +(define-xwem-command xwem-time-popup-menu () + "Popup menu for time dockapp." + (xwem-interactive) + + (unless (button-event-p xwem-last-event) + (error 'xwem-error "`xwem-time-popup-menu' must be bound to mouse event")) + + (let ((twin (X-Event-win xwem-last-xevent))) + (xwem-popup-menu + (list "Time" + (vector "Show Time" 'xwem-time-show-current-time-and-date) + "---" + (vector "Destroy" `(XDestroyWindow (xwem-dpy) ,twin)))))) (provide 'xwem-time) Index: lisp/xwem-transient.el =================================================================== RCS file: lisp/xwem-transient.el diff -N lisp/xwem-transient.el --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ lisp/xwem-transient.el 1 Jan 2005 04:41:18 -0000 ＠＠ -0,0 +1,188 ＠＠ +;;; xwem-transient.el --- Transient for clients support. + +;; Copyright (C) 2004 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Steve Youngs <steve(a)youngs.au.com> +;; Created: Sat Jun 5 01:33:25 MSD 2004 +;; Keywords: xwem +;; X-CVS: $Id: xwem-transient.el,v 1.3 2004/12/05 22:37:35 lg Exp $ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; + +;;; Code: + +(require 'xwem-load) +(require 'xwem-focus) +(require 'xwem-manage) + +;;; Customisation +(defgroup xwem-transient nil + "Group to customize transient clients support." +:prefix "xwem-transient-" +:group 'xwem-cl) + +(defcustom xwem-transient-client-properties + '(x-border-width 2 x-border-color "blue4") + "*Client properties to use when managing transient clients." +:type 'list +:group 'xwem-transient) + +(defcustom xwem-transient-switch-back t + "*Non-nil mean when transient client dies, switch to client who created it." +:type 'boolean +:group 'xwem-transient) + +;;; Internal variables + +(defvar xwem-transient-keymap + (let ((map (make-sparse-keymap))) + (define-key map (xwem-kbd "C-<button1>") 'xwem-client-imove) + (define-key map (xwem-kbd "C-<button2>") 'xwem-client-idestroy) + (define-key map (xwem-kbd "C-<button3>") 'xwem-client-iresize) + map) + "Local keymap for transient-for clients.") + +(define-xwem-deffered xwem-transient-on-select-cl (&optional cl) + "CL just selected, check if it has transient-for windows. +If so, popup them." + (unless cl + (setq cl (xwem-cl-selected))) + + (when (xwem-cl-p cl) + (let ((trfcls (xwem-cl-list-sort-by-recency (xwem-cl-translist cl)))) + (while trfcls + (when (eq (xwem-cl-state (car trfcls)) 'active) + (xwem-select-client (car trfcls)) + (setq trfcls nil)) + (setq trfcls (cdr trfcls))) + ))) + +;;;; ---- Transient for manage methods ---- + +;; NOTE: Uses default refit +(defun xwem-cl-transient-for-p (cl) + "Return non-nil if CL is transient for client." + (xwem-hints-wm-transient-for (xwem-cl-hints cl))) + +(defun xwem-manage-transient-for (cl) + "Manage CL that have transient-for flag." + ;; Map window for witch CL is transient and just map and raise CL + ;; over it + (let ((xwin (xwem-cl-xwin cl)) + (trc (xwem-xwin-cl (xwem-cl-transient-for cl)))) + + ;; Apply properties specific to transient-for clients + (xwem-cl-apply-plist cl xwem-transient-client-properties) + + (XReparentWindow (xwem-dpy) xwin (xwem-rootwin) + (X-Geom-x (xwem-cl-xgeom cl)) + (X-Geom-y (xwem-cl-xgeom cl))) + + (when (xwem-cl-p trc) + (setf (xwem-cl-translist trc) + (cons cl (xwem-cl-translist trc)))) + + ;; Install transient local keymap + (xwem-use-local-map xwem-transient-keymap cl) + + ;; Select it if needed + (when (or (null trc) + (xwem-cl-selected-p trc)) + (xwem-select-client cl)) + )) + +(define-xwem-deffered xwem-transient-apply-state (cl) + "Apply CL's state to life." + (cond ((eq (xwem-cl-state cl) 'active) + (XRaiseWindow (xwem-dpy) (xwem-cl-xwin cl)) + (XMapWindow (xwem-dpy) (xwem-cl-xwin cl))) + + ((eq (xwem-cl-state cl) 'inactive) + (XLowerWindow (xwem-dpy) (xwem-cl-xwin cl))) + ((eq (xwem-cl-state cl) 'iconified) + (XUnmapWindow (xwem-dpy) (xwem-cl-xwin cl))))) + +(defun xwem-activate-transient-for (cl &optional type) + "Activate method for transient-for client CL." + (cond ((eq type 'select) + (let ((trc (xwem-xwin-cl (xwem-cl-transient-for cl)))) + (when (xwem-cl-p trc) + (xwem-activate trc))) + (xwem-deffered-funcall 'XRaiseWindow (xwem-dpy) (xwem-cl-xwin cl))) + + ((eq type 'activate) + (xwem-transient-apply-state cl) + (let ((trc (xwem-xwin-cl (xwem-cl-transient-for cl)))) + (when (and (xwem-cl-p trc) + (xwem-cl-selected-p trc)) + (xwem-select-client cl)))) + )) + +(defun xwem-deactivate-transient-for (cl &optional type) + "Deactivate method for transient-for client CL." + (cond ((eq type 'deactivate) + (xwem-transient-apply-state cl)))) + +(defun xwem-iconify-transient-for (cl &optional type) + "Iconify method for transient-for client CL." + (xwem-transient-apply-state cl)) + +(defun xwem-withdraw-transient-for (cl) + "Withdraw method for transient-for CL." + (let ((trc (xwem-xwin-cl (xwem-cl-transient-for cl)))) + (when (and (xwem-cl-selected-p cl) + (xwem-cl-p trc) (xwem-cl-active-p trc)) + (xwem-select-client trc)))) + +;;; Additional methods +(define-xwem-method on-kill transient-for (cl) + "On-kill method for transient-for clients." + (let ((trc (xwem-xwin-cl (xwem-cl-transient-for cl)))) + (when (xwem-cl-p trc) + (setf (xwem-cl-translist trc) + (delq cl (xwem-cl-translist trc))) + + (when (and (xwem-cl-selected-p cl) + (xwem-cl-active-p trc)) + (xwem-select-client trc))))) + + +(provide 'xwem-transient) + +;;; On-load actions +(define-xwem-manage-model transient-for + "Manage models for clients with TRANSIENT_FOR property." +:match-spec '(function xwem-+ +(defun xwme-tray-group-repositionate-dapps (group) + "Repositionate GROUP's dock applications." + (let ((gdapps (xwem-tray-group-dockapps group)) + (step 3) + (coff 3)) + (while gdapps + (setf (X-Geom-x (xwem-dapp-geom (car gdapps))) coff) + ;; XXX do it deffering + (XMoveWindow (xwem-dpy) (xwem-dapp-xwin (car gdapps)) + (X-Geom-x (xwem-dapp-geom (car gdapps))) + (X-Geom-y (xwem-dapp-geom (car gdapps)))) + (incf coff (X-Geom-width (xwem-dapp-geom (car gdapps)))) + (incf coff step) + (setq gdapps (cdr gdapps))) + + (when (> coff (X-Geom-width (xwem-tray-group-xgeom group))) + (xwem-tray-group-resize + group coff + (X-Geom-height (xwem-tray-group-xgeom group)))))) + +(defun xwem-tray-group-attach-dapp (group dapp) + "To tray GROUP attach dock application DAPP." + (let ((gdapps (xwem-tray-group-dockapps group))) + (XReparentWindow (xwem-dpy) (xwem-tray-group-xwin group) + (xwem-dapp-xwin dapp) 0 0) + (while (and gdapps + (> (xwem-dapp-id (car gdapps)) + (xwem-dapp-id dapp))) + (setq gdapps (cdr gdapps))) + (if (not gdapps) + (setf (xwem-tray-group-dockapps group) + (append (xwem-tray-group-dockapps group) + (list dapp))) + (setcdr gdapps (cons (car gdapps) (cdr gdapps))) + (setcar gdapps dapp)) + + (xwme-tray-group-repositionate-dapps group))) + +(defun xwem-tray-group-find-create (name) + "Find existing or create new group." + (or (xwem-tray-group-find name) + (xwem-tray-group-create name))) + +;;}}} + +;;;###xwem-autoload +(defun xwem-XTrayInit (xdpy xwin &optional dockid dockgroup dockalign) + "Same as `XTrayInit'. +You should use this function instead of direct calls to `XTrayInit', +because in time you doing it xwem-tray may be uninitialised." + (xwem-tray-startit xdpy) ; make sure systray initialized + + (when dockid + (XChangeProperty xdpy xwin (XInternAtom xdpy "XWEM_DOCK_ID") + XA-integer X-format-16 X-PropModeReplace dockid)) + (when dockgroup + (XChangeProperty xdpy xwin (XInternAtom xdpy "XWEM_DOCK_GROUP") + XA-string X-format-8 X-PropModeReplace dockgroup)) + (when dockalign + (XChangeProperty xdpy xwin (XInternAtom xdpy "XWEM_DOCK_ALIGN") + XA-integer X-format-16 X-PropModeReplace dockalign)) + + (XTrayInit xdpy xwin)) + +;;;###xwem-autoload (defun xwem-tray-find-dapp (xwin) "Finds dock application by X window XWIN." - (let ((dal xwem-tray-dapp-list) - (rdapp nil)) - (while dal - (if (eq (xwem-dapp-xwin (car dal)) xwin) - (progn - (setq rdapp (car dal)) - (setq dal nil)) - (setq dal (cdr dal)))) - rdapp)) + (car (member* xwin xwem-tray-dapp-list +:test (lambda (xwin dapp) + (X-Win-equal xwin (xwem-dapp-xwin dapp)))))) (defun xwem-tray-message-defhook (dapp) "Default function for message from dock apps handling." - (if xwem-special-enabled - ;; XXX - (xwem-help-display - (insert (xwem-dapp-mess dapp))) - (xwem-message 'err "message arrived from dock app, but special frames not enabled.") - )) + (if (featurep 'xwem-special) + (xwem-help-display "tray message" + (insert (xwem-dapp-mess dapp))) + (xwem-message 'error "Message arrived from dock app, but special frames not enabled."))) + +;;; XXX these three functions: +;; +;; - xwem-tray-remove-dapp +;; - xwem-tray-hide-dapp +;; - xwem-tray-show-dapp +;; +;; Has many of common code, get rid of it --lg (defun xwem-tray-remove-dapp (dapp) "Remove dock application DAPP from xwem tray dockapps list." - (setq xwem-tray-dapp-list (delete dapp xwem-tray-dapp-list))) + (let ((dgeom (xwem-dapp-geom dapp)) + (state (xwem-dapp-state dapp))) + ;; Remove from dapps list + (setq xwem-tray-dapp-list + (delq dapp xwem-tray-dapp-list)) + (X-invalidate-cl-struct dapp) + + -; ((= evtype X-PropertyNotify) 'xwem-tray-handle-prop-notify) -; ((= evtype X-Expose) 'xwem-tray-handle-expose) -; ((= evtype X-DestroyNotify) 'xwem-tray-handle-unmap-or-destroy-notify) -; ((= evtype X-ConfigureNotify) 'xwem-tray-handle-config-notify) - (t nil)))) - (when fn - (funcall fn win xev)) - nil)) - -(defcustom xwem-tray-config nil - "*Config file for xwem-tray. -It is list of vectors in form [TYPE VALUE], TYPE is one of XWEM-TRAY-DOCK where VALUE for it is a string, which will be runned with `background' or XWEM-TRAY-DILEM where VALUE is offset in pixels which should delim docks. - -For example: - '([XWEM-TRAY-DOCK \"/home/lg/prog/xwem/modules/xwem-minitime -f 004400 -b bbbbbb\"] - [XWEM-TRAY-DOCK \"/home/lg/prog/xwem/modules/xwem-miniapm\"] - [XWEM-TRAY-DELIM 10] - [XWEM-TRAY-DOCK \"/home/lg/prog/xwem/modules/xwem-minilaunch /home/lg/prog/xwem/modules/icons/xterm_big.xpm xterm\"]" -:type 'list -:group 'xwem-tray) - -(defcustom xwem-tray-sit-for-pause 0.1 - "*Pause in seconds we should sit-for between launching XWEM-TRAY-DOCK. -UNUSED" -:type 'number -:group 'xwem-tray) - -(defun xwem-tray-run-config (&optional config) - "Parse and execute xwem tray CONFIG. -If CONFIG is ommited `xwem-tray-config' will be used." - (unless config - (setq config xwem-tray-config)) - - (while config - (let ((type (aref (car config) 0)) - (data (aref (car config) 1))) - (cond ((eq type 'XWEM-TRAY-DOCK) - (xwem-execute-program data)) - - ((eq type 'XWEM-TRAY-DELIM) - (setq xwem-tray-curroffset (- xwem-tray-curroffset data))) - (t nil))) - (setq config (cdr config)))) + (t (setf (xwem-dapp-mess dapp) "") + (setf (xwem-dapp-mess-currlen dapp) 0) + (setf (xwem-dapp-mess-waitlen dapp) (truncate (car (nth 3 (X-Event-xclient-msg xev))))) + (setf (xwem-dapp-mess-type dapp) opc)) + ))) + (t (xwem-message 'warning "Unknown mes-type %d from dock app." mes-type))) + nil)) + +(defun xwem-dapp-handle-xevent (xdpy xwin xev) + "X Events handler for dockapps." + (xwem-debug 'xwem-tray "DAPP: X Event: %S" '(X-Event-name xev)) + + (X-Event-CASE xev + (:X-ClientMessage + (xwem-dapp-handle-client-message xev)) + )) (defun xwem-tray-create (dpy) "Creates new XWEM system tray on DPY. ＠＠ -391,99 +686,133 ＠＠ dpy nil 0 0 1 1 0 0 X-InputOnly nil - (make-X-Attr :override-redirect 1 + (make-X-Attr :override-redirect t :event-mask xwem-tray-evmask))) - (X-Win-EventHandler-add-new win 'xwem-tray-evhandler 100) + (X-Win-EventHandler-add-new win 'xwem-tray-handle-client-message + 100 (list X-ClientMessage)) ;; Setup various hints (XSetWMClass dpy win xwem-tray-class) (XSetWMName dpy win xwem-tray-name) (setf (xwem-tray-xwin xwem-tray) win) - (setf (xwem-tray-props xwem-tray) nil) + (setf (xwem-tray-plist xwem-tray) nil) ;; TODO: install Selections and properties we will need - -; (XMapWindow dpy win) )) (defun xwem-tray-init (dpy) "Initialize xwem tray." (setq xwem-tray - (make-xwem-tray :atoms (make-vector 40 nil))) + (make-xwem-tray :atoms (make-vector 40 nil) +:xwin (xwem-minib-xwin xwem-minibuffer))) (let ((xwem-atoms (xwem-tray-atoms xwem-tray))) - (aset xwem-atoms 0 (XInternAtom dpy "_NET_WM_WINDOW_TYPE" nil)) - (aset xwem-atoms 1 (XInternAtom dpy "_NET_WM_WINDOW_TYPE_DOCK" nil)) - (aset xwem-atoms 3 (XInternAtom dpy "_NET_SYSTEM_TRAY_OPCODE" nil)) - (aset xwem-atoms 4 (XInternAtom dpy "_XEMBED_INFO" nil)) - (aset xwem-atoms 5 (XInternAtom dpy "_XEMBED" nil)) - (aset xwem-atoms 6 (XInternAtom dpy "MANAGER" nil)) - (aset xwem-atoms 7 (XInternAtom dpy "_MB_DOCK_ALIGN" nil)) - (aset xwem-atoms 8 (XInternAtom dpy "_MB_DOCK_ALIGN_EAST" nil)) - (aset xwem-atoms 9 (XInternAtom dpy "_NET_SYSTEM_TRAY_MESSAGE_DATA" nil)) - (aset xwem-atoms 10 (XInternAtom dpy "_NET_WM_WINDOW_TYPE_SPLASH" nil)) - (aset xwem-atoms 11 (XInternAtom dpy "WM_PROTOCOLS" nil)) - (aset xwem-atoms 12 (XInternAtom dpy "WM_DELETE_WINDOW" nil)) - (aset xwem-atoms 13 (XInternAtom dpy "_MB_THEME" nil)) - (aset xwem-atoms 14 (XInternAtom dpy "_MB_PANEL_TIMESTAMP" nil)) - (aset xwem-atoms 15 (XInternAtom dpy "_NET_WM_STRUT" nil)) - (aset xwem-atoms 16 (XInternAtom dpy "_MB_PANEL_BG" nil)) - (aset xwem-atoms 17 (XInternAtom dpy "WM_CLIENT_LEADER" nil)) - (aset xwem-atoms 18 (XInternAtom dpy "_NET_WM_ICON" nil)) - (aset xwem-atoms 19 (XInternAtom dpy "_NET_WM_PID" nil)) - (aset xwem-atoms 20 (XInternAtom dpy "_XROOTPMAP_ID" nil)) + (aset xwem-atoms 0 (XInternAtom dpy "_NET_WM_WINDOW_TYPE")) + (aset xwem-atoms 1 (XInternAtom dpy "_NET_WM_WINDOW_TYPE_DOCK")) + (aset xwem-atoms 3 (XInternAtom dpy "_NET_SYSTEM_TRAY_OPCODE")) + (aset xwem-atoms 4 (XInternAtom dpy "_XEMBED_INFO")) + (aset xwem-atoms 5 (XInternAtom dpy "_XEMBED")) + (aset xwem-atoms 6 (XInternAtom dpy "MANAGER")) + (aset xwem-atoms 9 (XInternAtom dpy "_NET_SYSTEM_TRAY_MESSAGE_DATA")) + (aset xwem-atoms 10 (XInternAtom dpy "_NET_WM_WINDOW_TYPE_SPLASH")) + (aset xwem-atoms 15 (XInternAtom dpy "_NET_WM_STRUT")) + (aset xwem-atoms 18 (XInternAtom dpy "_NET_WM_ICON")) + (aset xwem-atoms 19 (XInternAtom dpy "_NET_WM_PID")) + (aset xwem-atoms 20 (XInternAtom dpy "_XROOTPMAP_ID")) + + (aset xwem-atoms 30 (XInternAtom dpy "XWEM_DOCK_ID")) + (aset xwem-atoms 31 (XInternAtom dpy "XWEM_DOCK_GROUP")) + (aset xwem-atoms 32 (XInternAtom dpy "XWEM_DOCK_ALIGN")) ;; Use emacs pid as tray identificator (aset xwem-atoms 2 - (XInternAtom dpy (format "_NET_SYSTEM_TRAY_S%i" xwem-tray-id) nil))) + (XInternAtom dpy (format "_NET_SYSTEM_TRAY_S%i" xwem-tray-id)))) (setenv "SYSTEM_TRAY_ID" (format "%i" xwem-tray-id)) - ;; Must do: - ;; - Calculate start possition. - ;; - Add handler for UnmapNotify and DestroyNotify events. - (cond ((eq xwem-tray-minib-position 'right) - (setq xwem-tray-curroffset - (X-Geom-width (xwem-minib-xgeom xwem-minibuffer)))) - - (t (xwem-message "Unsupported `xwem-tray-minib-position': %S" - xwem-tray-minib-position))) - - ;; Subscribe on substructure change events for xwem minibuffer - ;; window. - (setf (xwem-minib-evmask xwem-minibuffer) - (Xmask-or (xwem-minib-evmask xwem-minibuffer) XM-SubstructureNotify)) - (XSelectInput (xwem-dpy) (xwem-minib-xwin xwem-minibuffer) - (xwem-minib-evmask xwem-minibuffer)) - (X-Win-EventHandler-add-new (xwem-minib-xwin xwem-minibuffer) - 'xwem-tray-handle-unmap-or-destroy-notify - -1 (list X-UnmapNotify X-DestroyNotify)) - - ;; Configure systray cursor - (setq xwem-tray-cursor (xwem-make-cursor (eval xwem-tray-cursor-shape) - xwem-tray-cursor-foreground-color - xwem-tray-cursor-background-color)) + ;; Subscribe on substructure change events for xwem tray window. + (XSelectInput (xwem-dpy) (xwem-tray-xwin xwem-tray) + (Xmask-or XM-SubstructureNotify XM-StructureNotify + (X-Attr-event-mask + (XGetWindowAttributes + (xwem-dpy) (xwem-tray-xwin xwem-tray))))) + (X-Win-EventHandler-add-new (xwem-tray-xwin xwem-tray) + 'xwem-tray-handle-xevent -1 + (list X-MapNotify X-UnmapNotify + X-DestroyNotify X-ConfigureNotify)) + (X-Win-EventHandler-add-new (xwem-tray-xwin xwem-tray) + 'xwem-tray-handle-xevent 100 + (list X-ClientMessage)) - (XChangeWindowAttributes (xwem-dpy) (xwem-minib-xwin xwem-minibuffer) - (make-X-Attr :cursor xwem-tray-cursor)) - ) + ;; Configure systray cursor + (setq xwem-tray-cursor + (xwem-make-cursor xwem-tray-cursor-shape + xwem-tray-cursor-foreground-color + xwem-tray-cursor-background-color)) + (XSetWindowCursor (xwem-dpy) (xwem-tray-xwin xwem-tray) + xwem-tray-cursor)) + (san (sin angel)) + (can (cos angel)) + (x-off x) + (y-off y) + nfont mb1 me1) + (when (string-match x-font-regexp fn) + (setq mb1 (match-beginning 5) + me1 (match-end 5)) + (setq nfont (concat (substring fn 0 mb1) + (replace-in-string + (format "[%S %S %S %S]" + (truncate (* fps can)) + (truncate (* fps san)) + (truncate (- (* fps san))) + (truncate (* fps can)) + ) + "-" "~") + (substring fn me1))) + (setf (X-Gc-font gc) (X-Font-get (xwem-dpy) nfont)) + (XChangeGC (xwem-dpy) gc) + + (mapc (lambda (chr) + (XDrawString (xwem-dpy) d gc x-off y-off (char-to-string chr)) + (setq x-off (+ x-off (* (X-Font-char-width chr sfont) can))) + (setq y-off (+ y-off (* (X-Font-char-width chr sfont) (- san))))) + str) + + ;; Revert font + (setf (X-Gc-font gc) sfont) + (XChangeGC (xwem-dpy) gc) + ))) + +;(xwem-vert-draw-text (xwem-frame-xwin (xwem-frame-selected)) +; (xwem-face-get-gc 'my-test-face) (/ pi 2) +; 40 700 "abcdefghjklmnopqrstuvwxyz") +; + + +(provide 'xwem-vert) + +;;; xwem-vert.el ends here Index: lisp/xwem-weather.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-weather.el,v retrieving revision 1.3 diff -u -u -r1.3 xwem-weather.el --- lisp/xwem-weather.el 16 Dec 2004 08:08:16 -0000 1.3 +++ lisp/xwem-weather.el 1 Jan 2005 04:41:18 -0000 ＠＠ -5,7 +5,7 ＠＠ ;; Author: Steve Youngs <steve(a)youngs.au.com> ;; Created: 2004-06-22 ;; Keywords: xwem -;; X-CVS: $Id: xwem-weather.el,v 1.3 2004/12/16 08:08:16 youngs Exp $ +;; X-CVS: $Id: xwem-weather.el,v 1.2 2004/12/05 05:52:24 youngs Exp $ ;; This file is part of XWEM. ＠＠ -37,13 +37,15 ＠＠ ;; (customize-set-variable 'xwem-weather-update-frequency 3600) ;; (add-hook 'xwem-after-init-hook 'xwem-weather-init) - ;;; Code: -(require 'xwem-osd) (require 'itimer) +(require 'xwem-osd) +(require 'xwem-interactive) +(require 'xwem-help) + (defgroup xwem-weather nil "XWEM Weather options." :prefix "xwem-weather-" ＠＠ -54,13 +56,45 ＠＠ The default setting is the author's local station, Brisbane, Australia. So you can all be jealous of the wonderful weather we -have in Australia. :-P" +have in Australia. :-P + +You should be able to find out what the code is for your nearest +weather station at http://weather.noaa.gov/" :type 'string +:link '(url-link "http://weather.noaa.gov/") +:group 'xwem-weather) + +(defcustom xwem-weather-data-directory xwem-dir + "*The directory to story weather data files." +:type '(directory :must-match t) +:group 'xwem-weather) + +(defcustom xwem-weather-data-file + (expand-file-name xwem-weather-station-id xwem-weather-data-directory) + "*File to hold the weather data." +:type 'file +:group 'xwem-weather) + +(defcustom xwem-weather-temperature-format 'celsius + "*Display temperature in Celsius or Fahrenheit." +:type '(choice + (const :tag "Celsius" celsius) + (const :tag "Fahrenheit" fahrenheit)) +:group 'xwem-weather) + +(defface xwem-weather-osd-face + '((((class color)) + (:foreground "cyan" :family "fixed" :size "12pt")) + (t + (:family "fixed" :size "12pt"))) + "*Face for the weather OSD." :group 'xwem-weather) +;;; Internal variables + (defvar xwem-weather-osd nil) -(defvar xwem-weather-frequency) +(defvar xwem-weather-frequency 0) (defun xwem-weather-alter-update-frequency (value) "Alters the update frequency of the weather updates. ＠＠ -76,24 +110,27 ＠＠ update the weather data." (let ((itimer (get-itimer "xwem-weather-itimer"))) (cond ((and (xwem-osd-p xwem-weather-osd) - value - itimer) - (set-itimer-value itimer value) - (set-itimer-restart itimer valu + xwem-weather-frequency))) (provide 'xwem-weather) + +;;; On-load actions +(define-key xwem-global-map (xwem-kbd "H-c W d") 'xwem-weather-show-details) +(define-key xwem-global-map (xwem-kbd "H-c W u") 'xwem-weather-update) ;;; xwem-weather.el ends here Index: lisp/xwem-win.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-win.el,v retrieving revision 1.7 diff -u -u -r1.7 xwem-win.el --- lisp/xwem-win.el 16 Dec 2004 08:08:16 -0000 1.7 +++ lisp/xwem-win.el 1 Jan 2005 04:41:18 -0000 ＠＠ -5,7 +5,7 ＠＠ ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> ;; Created: 21 Mar 2003 ;; Keywords: xlib, xwem -;; X-CVS: $Id: xwem-win.el,v 1.7 2004/12/16 08:08:16 youngs Exp $ +;; X-CVS: $Id: xwem-win.el,v 1.6 2004/12/05 05:52:31 youngs Exp $ ;; This file is part of XWEM. ＠＠ -34,33 +34,42 ＠＠ ;;; Code -(eval-when-compile - (require 'xwem-clients)) +(require 'xwem-load) -;;; Customization +;;; Customisation (defgroup xwem-win nil "Group to customize XWEM windows." :prefix "xwem-win-" :group 'xwem) +;;;###autoload (defcustom xwem-win-min-width 80 "*Minimal width for window" :type 'number :group 'xwem-win) +;;;###autoload (defcustom xwem-win-min-height 80 "*Minimal height for window" :type 'number :group 'xwem-win) -;;;###autoload -(defcustom xwem-win-delim-width 3 - "*Window delimeter width, including shadowness." -:type 'number +;;;###xwem-autoload +(defcustom xwem-win-vertical-delim-width '(8 . 1) + "*Width in pixels for vertical delimiters. +car is delimiter width, cdr is shadow thickness." +:type '(cons number number) :group 'xwem-win) -(defcustom xwem-win-delim-shadow-thicksness 1 - "*How thick to draw 3D shadows around window delims." +;;;###xwem-autoload +(defcustom xwem-win-horizontal-delim-width '(6 . 1) + "*Width in pixels for horizontal delimiters. +car is delimiter width, cdr is shadow thickness." +:type '(cons number number) +:group 'xwem-win) + +(defcustom xwem-win-default-border-width 1 + "*Default border width for newly created windows." :type 'number :group 'xwem-win) ＠＠ -84,7 +93,7 ＠＠ :type '(restricted-sexp :match-alternatives (valid-plist-p)) :group 'xwem-win) -(defcustom xwem-win-winmove-allow-jupming t +(defcustom xwem-win-winmove-allow-jumping t "*Non-nil allows jumping to opposite edge, when no window founded." :type 'boolean :group 'xwem-win) ＠＠ -120,65 +129,75 ＠＠ :group 'xwem-hooks) ;;;###autoload -(defcustom xwem-win-after-split-hook nil +(defcustom xwem-win-split-hook nil "Hook to be called after window split. -Functions will be called with three arguments: WIN HOW and NEW-SIZE." +Functions will be called with two arguments: SPLIT-WIN, NEW-WIN." :type 'hook :group 'xwem-hooks) - -;;; Structures -;;;###autoload -(defstruct (xwem-win (:include X-Geom) - (:predicate xwem-iswin-p)) - clients ; xwem clients list managed in this win - props ; property list aka plist - cl ; xwem client - frame ; xwem frame - dead - deleted - next - prev - hchild - vchild - parent - expectances) ; expectances list +(define-xwem-face xwem-window-outline-face + `(((frame-selected win-selected) + (:foreground "green" :background "green4" :line-width 4)) + ((frame-selected win-nonselected) + (:foreground "gray70" :background "gray70" :line-width 4)) + ((frame-nonselected win-selected) + (:foreground "green3" :background "green4" :line-width 4)) + ((frame-nonselected win-nonselected) + (:foreground "gray60" :background "gray40" :line-width 4))) + "Face to outline frame windows." +:group 'xwem-win +:group 'xwem-faces) + +(define-xwem-face xwem-window-delimiter-face + `(((horizontal) + (:foreground "royalblue")) + ((horizontal shadow) + (:foreground "blue4")) + ((horizontal light shadow) + (:foreground "cyan")) + ((vertical) + (:foreground "royalblue")) + ((shadow vertical) + (:foreground "blue4")) + ((light shadow vertical) + (:foreground "cyan")) + (t (:foreground "gray20" :background "black"))) + "Face to draw window delimiter." +:group 'xwem-win +:group 'xwem-faces) -;;;###autoload -(defstruct (xwem-win-saved (:include X-Geom) - (:predicate xwem-iswinsaved-p)) - clients ; clients managed in window - cl ; xwem client sele - props ; properties - expectances ; expectances list - currentp ; non-nil for selected window - first-hchild first-vchild - next prev) +;;; Internal variables -;;;###autoload -(defstruct (xwem-win-config (:predicate xwem-iswinconfig-p)) - frame frame-width frame-height - current-cl ; cl in selected window - min-width min-height - saved-root-window) - -;; Functions -;;;###autoload -(defun xwem-win-cl-current-p (cl &optional win) - "Return non-nil if CL is current WIN's client." - (let ((ww (or win (xwem-cl-win cl)))) - (when (xwem-win-p ww) - (eq cl (xwem-win-cl ww))))) - -;;;###autoload -(defun xwem-win-p (window &optional sig) - "Return t if WINDOW is XWEM frame's window." - (let ((iswin (xwem-iswin-p window))) - (if (and (not iswin) sig) - (signal 'wrong-type-argument (list sig 'xwem-win-p window)) - iswin))) +;;;; Win macros +(defmacro xwem-win-child (window) + "Return child of WINDOW, hchild checked first then if not set vchild + tested." + `(or (xwem-win-hchild ,window) (xwem-win-vchild ,window))) + +(defmacro xwem-win-mark-deleted (win) + "Mark WIN as deleted window." + `(setf (xwem-win-deleted ,win) t)) + +;;;###xwem-autoload +(defun xwem-win-delim-width (window) + "Return WIN's delimiter width." + (let ((pwin (xwem-win-parent window))) + (or (and pwin (xwem-win-hchild pwin) (car xwem-win-horizontal-delim-width)) + (and pwin (xwem-win-vchild pwin) (car xwem-win-vertical-delim-width)) + 0))) + +;;;###xwem-autoload +(defun xwem-win-delim-shadow-thickness (window) + "Return WIN's delimiter width." + (let ((pwin (xwem-win-parent window))) + (or (and pwin (xwem-win-hchild pwin) (cdr xwem-win-horizontal-delim-width)) + (and pwin (xwem-win-vchild pwin) (cdr xwem-win-vertical-delim-width)) + 0))) + +;;;; Functions +;;;###xwem-autoload (defun xwem-win-make-list-by-next (window) "Create list of WINDOW and all next windows." (let ((wins window) ＠＠ -188,41 +207,103 ＠＠ (setq wins (xwem-win-next wins))) (nreverse rlist))) -;;;###autoload -(defun xwem-win-selected (&optional frame) - "Return selected window in selected frame." - (unless frame - (setq frame (xwem-frame-selected))) - (when (xwem-frame-p frame) - (xwem-frame-selwin frame))) +;;;###xwem-autoload +(defun xwem-cl-set-win (cl win) + "Associate CL with WIN. +WIN is valid WIN or nil." + (unless (eq (xwem-cl-win cl) win) + (let ((owin (xwem-cl-win cl))) + ;; Deactivate CL, when changing window + (xwem-deactivate cl) + + (setf (xwem-cl-win cl) win) + + ;; Remove CL from OWIN's clients list + (when (xwem-win-p owin) + (xwem-win-rem-cl owin cl)))) + + ;; Add CL to WIN's clients list + (when (xwem-win-p win) + (xwem-win-add-cl win cl))) + +;;;###xwem-autoload +(defun xwem-win-add-cl (win cl) + "Into WIN's clients list add new client CL." + (unless (or (not (xwem-cl-p cl)) + (memq cl (xwem-win-clients win))) + + (when (and (xwem-frame-dedicated-p (xwem-win-frame win)) + (xwem-win-clients win)) + (error 'xwem-error "Window in dedicted frame already has client")) + + ;; Insert CL in WIN's clients list in proper place (as in + ;; `xwem-clients') + (let ((wcls (xwem-win-clients win))) + (while (and wcls (memq cl (memq (car wcls) xwem-clients))) + (setq wcls (cdr wcls))) + (if (not wcls) + (setf (xwem-win-clients win) + (append (xwem-win-clients win) (list cl))) + (setcdr wcls (cons (car wcls) (cdr wcls))) + (setcar wcls cl))) + + (run-hook-with-args 'xwem-win-clients-change-hook win))) + +;;;###xwem-autoload +(defun xwem-win-rem-cl (win cl) + "From WIN's clients list remove client CL." + (when (and (xwem-cl-p cl) + (memq cl (xwem-win-clients win))) + (setf (xwem-win-clients win) + (delq cl (xwem-win-clients win))) + + ;; If CL is current client in WIN, also unset it + (when (eq cl (xwem-win-cl win)) + (xwem-win-set-cl win nil)) + + (run-hook-with-args 'xwem-win-clients-change-hook win))) + +;;;###xwem-autoload +(defun xwem-win-set-cl (win cl) + "Associate WIN with CL as current client in WIN." + ;; When CL isnt in WIN's clients list yet, add it. + (unless (eq (xwem-win-cl win) cl) + (when (xwem-cl-p cl) + (xwem-cl-set-win cl win)) + + (let ((ocl (xwem-win-cl win))) + (setf (xwem-win-cl win) cl) + + (when (xwem-cl-alive-p (xwem-win-cl win)) + (xwem-activate (xwem-win-cl win))) + (when (xwem-cl-alive-p ocl) + (xwem-deactivate ocl)) -;;;###autoload -(defun xwem-win-selected-p (win) - "Return non-nil if WIN is selected window." - (and (xwem-win-p win) - (eq win (xwem-frame-selwin (xwem-win-frame win))))) + (when (or (null ocl) (null (xwem-win-cl win))) + (xwem-win-redraw-win win))))) ;;;###autoload (defun xwem-win-new (&optional params props) "Create new window with properties PROPS." (let ((nwin (apply 'make-xwem-win params)) - (rplist (copy-sequence xwem-win-default-properties))) + (rplist (copy-list xwem-win-default-properties))) ;; Prepare window properties - (while props - (setq rplist (plist-put rplist (car props) (cadr props))) - (setq props (cddr props))) - + (setq rplist (xwem-misc-merge-plists rplist props)) + + (setf (xwem-win-geom nwin) + (make-X-Geom :x 0 :y 0 :width 1 :height 1 +:border-width xwem-win-default-border-width)) (setf (xwem-win-clients nwin) nil) ; list of clients - (setf (xwem-win-props nwin) rplist) ; window properties (setf (xwem-win-cl nwin) nil) ; no visible client yet + (setf (xwem-win-plist nwin) rplist) ; window properties nwin)) (defun xwem-win-replace (old new) "Replace OLD window with contents of NEW window." (when (not (and (xwem-win-p old) (xwem-win-p new))) - (error "Hmm .. one of OLD or NEW is not a xwem window.")) + (error 'xwem-error "Hmm .. one of OLD or NEW is not a xwem window")) (when (eq (xwem-frame-rootwin (xwem-win-frame old)) old) (setf (xwem-frame-rootwin (xwem-win-frame old)) new)) ＠＠ -269,7 +350,7 ＠＠ (setf (xwem-win-parent window) pwin) )) -;;;###autoload +;;;###xwem-autoload (defun xwem-window-next (&optional window) "Return next window after WINDOW in canonical ordering of windows. If omitted, WINDOW defaults to the `(xwem-win-selected)'." ＠＠ -295,7 +376,7 ＠＠ (t nil))) ;break win)) -;;;###autoload +;;;###xwem-autoload (defun xwem-window-next-vertical (&optional window) "Return next window which is vertically after WINDOW. If WINDOW is not given `(xwem-win-selected)' will be used." ＠＠ -333,7 +414,7 ＠＠ (null rwin))) rwin)))) -;;;###autoload +;;;###xwem-autoload (defun xwem-window-prev (&optional window) "Retrun previous window before WINDOW in canonical ordering of windows. If ommitted, WINDOW defaults to the `(xwem-win-selected)'." ＠＠ -364,7 +445,7 ＠＠ t))) win)) -;;;###autoload +;;;###xwem-autoload (defun xwem-window-other (cnt &optional window) "Return CNT's next window for WINDOW if CNT is greater then zero and previous if negative." ＠＠ -380,7 +461,7 ＠＠ "Returns non-nil if X Y lies in WIN. If INC-GUTTER is non-nil, than include gutters width as WIN area." (let ((edges (xwem-win-pixel-edges win)) - (gw (if inc-gutter xwem-win-delim-width 0))) + (gw (if inc-gutter (xwem-win-delim-width win) 0))) (and (>= x (- (nth 0 edges) gw)) (<= x (+ (nth 2 edges) gw)) (>= y (- (nth 1 edges) gw)) ＠＠ -397,9 +478,10 ＠＠ ;;; -- Moving around windows -- ;; -(defun xwem-winmove-distance () +(defun xwem-winmove-distance (&optional win) "Returns distance between windows." - (+ xwem-win-delim-width 0)) + ;; 2 is XXX + (+ (xwem-win-delim-width (or win (xwem-win-selected))) 2)) (defun xwem-winmove-refloc (&optional arg window) "Calculates the reference location for directional window selection. ＠＠ -437,7 +519,7 ＠＠ (cons (car refpoint) (+ (nth 3 edges) (xwem-winmove-distance)))) - (t (error "`xwem-winmove-other-window': Invalid direction %s" dir))))) + (t (error 'xwem-error "`xwem-winmove-other-window': Invalid direction %s" dir))))) (defun xwem-winmove-select (dir &optional arg window) "Moves to the window in DIR direction." ＠＠ -447,7 +529,7 ＠＠ (y (cdr owin-loc)) (owin (xwem-window-at x y frame))) - (when xwem-win-winmove-allow-jupming + (when xwem-win-winmove-allow-jumping (let ((rwin (xwem-frame-rootwin (xwem-win-frame (or window (xwem-win-selected)))))) (when (not (xwem-win-xy-in-p x y rwin)) ;; we are outside root window ＠＠ -463,150 +545,298 ＠＠ (abs y)))) ((eq dir 'down) (cons x (+ (- y (nth 3 (xwem-win-pixel-edges rwin))) (nth 1 (xwem-win-pixel-edges rwin))))) - (t (error "invalid direction.")))) + (t (error 'xwem-error "Invalid direction")))) (setq owin (xwem-window-at (car owin-loc) (cdr owin-loc) frame))))) - (if (not (xwem-win-p owin)) - (xwem-message 'err "No window at %s" dir) - (xwem-window-select-maybe-redraw owin)) + (if (not (xwem-win-p owin)) + (xwem-message 'error "No window at %S" dir) + (xwem-select-window owin)) )) +;;;###autoload(autoload 'xwem-other-window "xwem-win" "Switch to other window." t) +(defalias 'xwem-other-window 'xwem-frame-goto-next) + ;;;###autoload(autoload 'xwem-winmove-up "xwem-win" "" t) (define-xwem-command xwem-winmove-up (arg) "Selects window that up for selected." (xwem-interactive "P") (xwem-winmove-select 'up arg)) +(put 'xwem-winmove-up 'xwem-frame-command t) ;;;###autoload(autoload 'xwem-winmove-down "xwem-win" "" t) (define-xwem-command xwem-winmove-down (arg) "Selects window that down for selected." (xwem-interactive "P") (xwem-winmove-select 'down arg)) +(put 'xwem-winmove-down 'xwem-frame-command t) ;;;###autoload(autoload 'xwem-winmove-left "xwem-win" "" t) (define-xwem-command xwem-winmove-left (arg) "Selects window that left for selected." (xwem-interactive "P") (xwem-winmove-select 'left arg)) +(put 'xwem-winmove-left 'xwem-frame-command t) ;;;###autoload(autoload 'xwem-winmove-right "xwem-win" "" t) (define-xwem-command xwem-winmove-right (arg) "Selects window that right for selected." (xwem-interactive "P") (xwem-winmove-select 'right arg)) +(put 'xwem-winmove-right 'xwem-frame-command t) -;;; -;;;###autoload -(defun xwem-window-select (window) - "Select WINDOW as current for WINDOW's frame. -Runs `xwem-win-switch-hook'." - (let* ((wframe (xwem-win-frame window)) - (ow (xwem-frame-selwin wframe))) - (setf (xwem-frame-selwin wframe) window) +;;; Windows oriented drawers +(define-xwem-deffered xwem-win-redraw-delims (win) + "Draw delimetrs in window WIN." + (when (xwem-win-p win) + (let ((wf (xwem-win-frame win)) + (hc (xwem-win-hchild win)) + (vc (xwem-win-vchild win))) + + (while (xwem-win-p hc) + ;; For horizontal split + (when (xwem-win-p (xwem-win-next hc)) + (xwem-misc-draw-bar + (xwem-dpy) (xwem-frame-xwin wf) + (xwem-face-get-gc 'xwem-window-delimiter-face '(horizontal) hc) + (xwem-face-get-gc 'xwem-window-delimiter-face '(horizontal shadow light) hc) + (xwem-face-get-gc 'xwem-window-delimiter-face '(horizontal shadow) hc) + (+ (xwem-win-x hc) (xwem-win-width hc)) + (xwem-win-y hc) + (xwem-win-delim-width hc) + (xwem-win-height hc) + (xwem-win-delim-shadow-thickness hc))) - ;; Now run switch hook - (run-hook-with-args 'xwem-win-switch-hook ow window))) + (xwem-win-redraw-delims-1 hc) + (setq hc (xwem-win-next hc))) -;;;###autoload -(defun xwem-window-select-maybe-redraw (window) - "Select window WINDOW and if maybe redraw WINDOW's frame." - (let* ((wframe (xwem-win-frame window)) - (ow (xwem-frame-selwin wframe))) - (xwem-window-select window) - (unless (eq ow window) - (xwem-frame-redraw wframe)))) + (while (xwem-win-p vc) + ;; For vertical split + (when (xwem-win-p (xwem-win-next vc)) + (xwem-misc-draw-bar + (xwem-dpy) (xwem-frame-xwin wf) + (xwem-face-get-gc 'xwem-window-delimiter-face '(vertical) vc) + (xwem-face-get-gc 'xwem-window-delimiter-face '(light shadow vertical) vc) + (xwem-face-get-gc 'xwem-window-delimiter-face '(shadow vertical) vc) + (xwem-win-x vc) + (+ (xwem-win-y vc) (xwem-win-height vc)) + (xwem-win-width vc) + (xwem-win-delim-width vc) + (xwem-win-delim-shadow-thickness vc))) -;;;###autoload + (xwem-win-redraw-delims-1 vc) + (setq vc (xwem-win-next vc))) + ))) + +(defun xwem-win-choose-outline-gc (win) + "Choose X-Gc according to WIN's current state." + (xwem-face-get-gc 'xwem-window-outline-face + (list (if (xwem-frame-selected-p (xwem-win-frame win)) 'frame-selected 'frame-nonselected) + (if (xwem-win-selwin-p win) 'win-selected 'win-nonselected)) + win)) + +(define-xwem-deffered xwem-win-redraw-win (win) + "Redraw only one WIN in WIN's frame." + (XClearArea (xwem-dpy) (xwem-frame-xwin (xwem-win-frame win)) + (xwem-win-x win) (xwem-win-y win) + (xwem-win-width win) (xwem-win-height win) nil) + (if (xwem-win-cl win) + (XFillRectangles (xwem-dpy) (xwem-frame-xwin (xwem-win-frame win)) + (xwem-win-choose-outline-gc win) + (list (make-X-Rect :x (xwem-win-x win) +:y (xwem-win-y win) +:width (xwem-win-width win) +:height (xwem-win-border-width win)) + (make-X-Rect :x (xwem-win-x win) +:y (xwem-win-y win) +:width (xwem-win-border-width win) +:height (xwem-win-height win)) + (make-X-Rect :x (+ (xwem-win-x win) + (xwem-win-width win) + (- (xwem-win-border-width win))) +:y (xwem-win-y win) +:width (xwem-win-border-width win) +:height (xwem-win-height win)) + (make-X-Rect :x (xwem-win-x win) +:y (+ (xwem-win-y win) + (xwem-win-height win) + (- (xwem-win-border-width win))) +:width (xwem-win-width win) +:height (xwem-win-border-width win)))) + + (let ((cgc (xwem-win-choose-outline-gc win))) + (XSetClipRectangles (xwem-dpy) cgc 0 0 (list (X-Geom-to-X-Rect (xwem-win-geom win)))) + (XDrawRectangle (xwem-dpy) (xwem-frame-xwin (xwem-win-frame win)) + cgc + (xwem-win-x win) (xwem-win-y win) + (xwem-win-width win) (xwem-win-height win)) + (setf (X-Gc-clip-mask cgc) X-None) + (XChangeGC (xwem-dpy) cgc) + ))) + +(define-xwem-deffered xwem-win-redraw-frame (frame) + "Outline windows in FRAME if needed." + (when (and (xwem-frame-alive-p frame) + (eq (xwem-frame-state frame) 'mapped)) + (xwem-win-map 'xwem-win-redraw-win (xwem-frame-selwin frame)) + (xwem-win-redraw-delims (xwem-frame-rootwin frame)))) + +;;;###xwem-autoload +(defun xwem-select-window (window) + "Set WINDOW to be selected window." + (when (xwem-win-alive-p window) + (let* ((wframe (xwem-win-frame window)) + (ow (xwem-frame-selwin wfr - ) +(defun xwem-win-subr-first-member (l1 l2) + "Return first element in L1, which also in L2. +Comparison done using `eq'." + (while (and l1 (not (memq (car l1) l2))) + (setq l1 (cdr l1))) + l1) + +(defun xwem-reorder-clients (clients clients-list) + "Reorder CLIENTS to be in same order as in CLIENTS-LIST. +This is destructive function, it will modify CLIENTS list directly." + (let ((cls clients) + (scls clients-list) + t1 t2) + (while scls + (when (setq t1 (memq (car scls) cls)) + (setq t2 (xwem-win-subr-first-member cls scls)) + (xwem-list-exchange-els clients (car t1) (car t2)) + (setq scls t1) + (setq cls t2)) + (setq scls (cdr scls)) + (setq cls (cdr cls))))) + +(defun xwem-win-reorder-clients (saved-win) + "Reorder `xwem-clients' in SAVED-WIN clients order." + (let ((cls xwem-clients) + (scls (xwem-win-saved-clients saved-win)) + t1 t2) + (while scls + (when (setq t1 (memq (car scls) cls)) + (setq t2 (xwem-win-subr-first-member cls scls)) + (xwem-list-exchange-els xwem-clients (car t1) (car t2)) + (setq scls t1) + (setq cls t2)) + + (setq scls (cdr scls)) + (setq cls (cdr cls))))) + (defun xwem-win-restore-win-params (config win saved-win) "Restore the windown parameters stored in SAVED-WIN on WIN." - (declare (special xwem-win-config-current-window)) (let ((cln (xwem-win-saved-cl saved-win))) - (setf (xwem-win-props win) (copy-sequence (xwem-win-saved-props saved-win))) - (setf (xwem-win-expectances win) (copy-sequence (xwem-win-saved-expectances saved-win))) + (setf (xwem-win-plist win) + (copy-list (xwem-win-saved-plist saved-win))) - ;; Collect clients + ;; Resort clients in WIN's order + (xwem-win-reorder-clients saved-win) + + ;; Collect clients to WIN (mapc (lambda (cl) (when (xwem-cl-alive-p cl) - (xwem-manda-manage cl win))) + (xwem-cl-set-win cl win))) (xwem-win-saved-clients saved-win)) - (when (xwem-cl-alive-p cln) - (xwem-manda-manage cln win)) - + ;; Restore window geometry (when (and (not (xwem-win-saved-first-hchild saved-win)) (not (xwem-win-saved-first-vchild saved-win))) (when (not (eq win (xwem-frame-rootwin (xwem-win-frame win)))) - (xwem-window-enlarge (- (xwem-win-saved-width saved-win) - (xwem-win-width win)) - nil - win) - (xwem-window-enlarge (- (xwem-win-saved-height saved-win) - (xwem-win-height win)) - t - win))) + (xwem-window-enlarge (- (X-Geom-width (xwem-win-saved-geom saved-win)) + (xwem-win-width win)) nil win) + (xwem-window-enlarge (- (X-Geom-height (xwem-win-saved-geom saved-win)) + (xwem-win-height win)) t win))) - (when (xwem-win-saved-currentp saved-win) - (setq xwem-win-config-current-window win)) - )) + ;; Remanage current WIN's client + (when (xwem-cl-alive-p cln) + ;; Check manage + (xwem-cl-change-window cln win) + (xwem-activate cln)) + + (when (xwem-win-saved-selwin-p saved-win) + (setf (xwem-frame-selwin (xwem-win-frame win)) win)))) ;;; END: -;;;###autoload(autoload 'xwem-window-configuration-to-register "xwem-win" "" t) -(define-xwem-command xwem-window-configuration-to-register (reg) - "Save current window configuration to register." - (xwem-interactive "rRegister: ") +;;;###autoload(autoload 'xwem-window-split-horizontally "xwem-win" nil t) +(define-xwem-command xwem-window-split-horizontally (arg &optional window) + "Split WINDOW horizontally." + (xwem-interactive (list (prefix-numeric-value xwem-prefix-arg) + (xwem-win-selected))) + + (unless window + (setq window (xwem-win-selected))) + (unless (xwem-win-p window) + (error 'xwem-error "Invalid window" window)) + + (when (xwem-frame-dedicated-p (xwem-win-frame window)) + (error 'xwem-error "Can't split dedicated frame")) + + (xwem-win-split window 'horizontal arg)) +(put 'xwem-window-split-horizonta -;;;###autoload (defun xwem-window-enlarge (n &optional height-p window) "Make WINDOW N pixels bigger. If HEIGHT-P is non-nil then enlarge vertically. If WINDOW is ommited then selected window will be used." (xwem-window-change-size (or window (xwem-win-selected)) n height-p)) -;;;###autoload (defun xwem-window-shrink (n &optional height-p window) "Make WINDON N pixels smaller. If HEIGHT-P is non-nil then shrink vertically. If WINDOW is ommited then selected window will be used." (xwem-window-change-size (or window (xwem-win-selected)) (- n) height-p)) -(defun xwem-win-focus (owin nwin) - "Focus NWIN. To be used in `xwem-win-switch-hook'." - (xwem-focus-set nwin)) - -;;;###autoload -(defun xwem-win-make-cl-list (win) - "Makes list of CLs that belongs to WIN." - (let (rcls) - (mapc (lambda (cl) - (when (xwem-cl-managed-p cl win) - (setq rcls (cons cl rcls)))) - xwem-clients) - (nreverse rcls))) - -;;;###autoload -(defun xwem-win-make-cl-list-sort-by-recency (win) - "Return list of clients managed in WIN, sorted by recency field." - (let ((cls (xwem-win-make-cl-list win))) - (sort cls (lambda (cl1 cl2) - (let ((rc1 (xwem-cl-recency cl1)) - (rc2 (xwem-cl-recency cl2))) - - (if (or (not rc1) (not rc2)) - (not (null rc1)) - - (cond ((> (nth 0 rc1) (nth 0 rc2)) - t) - ((< (nth 0 rc1) (nth 0 rc2)) - nil) - (t (cond ((> (nth 1 rc1) (nth 1 rc2)) - t) - ((< (nth 1 rc1) (nth 1 rc2)) - nil) - (t (cond ((> (nth 2 rc1) (nth 2 rc2)) - t) - ((< (nth 2 rc1) (nth 2 rc2)) - nil) - (t t)))))))))))) - -;;;###autoload -(defun xwem-init-win () - "Initialize xwem windows. Now just installs `xwem-win-switch-hook'" - (add-hook 'xwem-win-switch-hook 'xwem-win-focus) +;;;###xwem-autoload +(defun xwem-window-set-size (win new-width new-height) + "Set WIN's size to be NEW-WIDTH, NEW-HEIGHT." + (xwem-window-change-size win (- new-width (xwem-win-width win)) nil) + (xwem-window-change-size win (- new-height (xwem-win-height win)) t)) + +(defsubst xwem-win-redraw-selected-frame () + "Redraw selected frame." + (xwem-win-redraw-frame (xwem-frame-selected))) + +(defun xwem-win-init () + "Initialize xwem windows." + (add-hook 'xwem-win-switch-hook + (lambda (owin nwin) + (when (xwem-win-p owin) + (xwem-win-redraw-win owin)) + (when (xwem-win-p nwin) + (xwem-win-redraw-win nwin)))) + + (add-hook 'xwem-frame-select-hook 'xwem-win-redraw-selected-frame) + (add-hook 'xwem-frame-deselect-hook 'xwem-win-redraw-selected-frame) + (add-hook 'xwem-frame-redraw-hook 'xwem-win-redraw-frame) ) +;;; Win properties +(defvar xwem-win-supported-properties '(domain-faces) + "List of supported window properties.") + +(defun xwem-win-properties (win) + "Return list of win's properties." + (let ((wplist (xwem-win-plist win)) + (rplist nil)) + (while wplist + (when (memq (car wplist) xwem-win-supported-properties) + (setq rplist (plist-put rplist (car wplist) (cadr wplist)))) + (setq wplist (cddr wplist))) + rplist)) + + (provide 'xwem-win) + +;;;; On-load actions: +;; - Initialize windows +(xwem-win-init) ;;; xwem-win.el ends here Index: lisp/xwem-worklog.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-worklog.el,v retrieving revision 1.9 diff -u -u -r1.9 xwem-worklog.el --- lisp/xwem-worklog.el 16 Dec 2004 08:08:16 -0000 1.9 +++ lisp/xwem-worklog.el 1 Jan 2005 04:41:19 -0000 ＠＠ -3,9 +3,10 ＠＠ ;; Copyright (C) 2004 by Free Software Foundation, Inc. ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> +;; Richard Klinda <ignotus(a)hixsplit.hu> ;; Created: Thu Feb 26 01:00:25 MSK 2004 ;; Keywords: xwem -;; X-CVS: $Id: xwem-worklog.el,v 1.9 2004/12/16 08:08:16 youngs Exp $ +;; X-CVS: $Id: xwem-worklog.el,v 1.7 2004/12/05 22:37:38 lg Exp $ ;; This file is part of XWEM. ＠＠ -30,14 +3 +(define-key xwem-worklog-map (xwem-kbd "s N") 'xwem-worklog-sort-by-Name) +(define-key xwem-worklog-map (xwem-kbd "s t") 'xwem-worklog-sort-by-today-time) +(define-key xwem-worklog-map (xwem-kbd "s T") 'xwem-worklog-sort-by-Today-time) +(define-key xwem-worklog-map (xwem-kbd "s g") 'xwem-worklog-sort-by-total-time) +(define-key xwem-worklog-map (xwem-kbd "s G") 'xwem-worklog-sort-by-Total-time) (defvar xwem-worklog-pause-map (let ((map (make-sparse-keymap))) ＠＠ -302,34 +434,41 ＠＠ "Hooks called when updating pause window contents. For internal usage only.") -(defstruct xwem-worklog-dockapp - win - update-itimer ; itimer to update worklog-dockapp +(defvar xwem-worklog-logged-in nil + "Non-nil if we are logged in.") - ;; dockapp and sector geometry - width height - sector-width) + +;;; Functions +(defun xwem-worklog-current-task () + "Return current worklog task." + xwem-worklog-current-task) -(defvar xwem-worklog-dockapp nil - "Dockapp.") +(defun xwem-worklog-create-cmd (template) + "Create symbol from TEMPLATE string." + (let ((fsym (intern (concat "xwem-worklog-custom-" (replace-in-string template " " "-"))))) + (fset fsym `(lambda () + (interactive) + (xwem-worklog-begin-task ,template))) + fsym)) + +(defun xwem-worklog-lookup-description (name) + "Lookup description for task named by NAME." + (assoc name xwem-worklog-tasks-description)) - (defun xwem-worklog-register-task (name &optional no-binding) "Register new task with NAME in `xwem-worklog-tasks-description'. Query for keybinding unless NO-BINDING is non-nil." - (let ((tal xwem-worklog-tasks-description)) - (while (and tal (not (string= (aref (car tal) 0) name))) - (setq tal (cdr tal))) - - (unless tal - (let ((key (and (not no-binding) - (xwem-read-key (format "Key for '%s' task: " name))))) - (when key - (setq key (events-to-keys (vector key))) - (define-key xwem-worklog-map key (xwem-worklog-create-cmd name))) - - (setq xwem-worklog-tasks-description (cons (vector name key nil) xwem-worklog-tasks-description)))) - )) + (unless (xwem-worklog-lookup-description name) + (let ((key (and (not no-binding) + (xwem-read-key (format "Key for '%s' task: " name)))) + (col (xwem-read-from-minibuffer (format "Color for '%s' task: " name)))) + (when key + (setq key (events-to-keys (vector key))) + (define-key xwem-worklog-map key (xwem-worklog-create-cmd name))) + + (setq xwem-worklog-tasks-description + (cons (list name (list :key key :color col)) + xwem-worklog-tasks-description))))) (defun xwem-worklog-find-task (name &optional create) "Search for task with NAME in tasks list." ＠＠ -344,20 +483,43 ＠＠ (setq xwem-worklog-task-list (cons task xwem-worklog-task-list)) task)))) -(defun xwem-worklog-lookup-description (name) - "Lookup description for task named by NAME." - (let ((tal xwem-worklog-tasks-description)) - (while (and tal (not (string= (aref (car tal) 0) name))) - (setq tal (cdr tal))) - (car tal))) +(defun xwem-worklog-sorted-task-list () + "Return sorted `xwem-worklog-task-list'." + (sort (copy-list xwem-worklog-task-list) + (lambda (e1 e2) + (cond ((eq xwem-worklog-sort-type 'name) + (string-lessp (xwem-worklog-task-name e1) + (xwem-worklog-task-name e2))) + ((eq xwem-worklog-sort-type 'Name) + (string-lessp (xwem-worklog-task-name e2) + (xwem-worklog-task-name e1))) + + ((memq xwem-worklog-sort-type '(today-time Today-time)) + (let ((tt1 (xwem-worklog-get-today-time e1)) + (tt2 (xwem-worklog-get-today-time e2)) + tdiff) + (cond ((eq xwem-worklog-sort-type 'today-time) + (setq tdiff (xwem-worklog-time-diff tt1 tt2))) + ＠＠ -909,69 +1085,36 ＠＠ (and (= (nth 0 a-time) (nth 0 b-time)) (<= (nth 1 a-time) (nth 1 b-time))))) -(defun xwem-worklog-add-entry (string &optional time) - "Add entry to `xwem-worklog-file'." - (require 'worklog) +;; Sorting +(define-xwem-command xwem-worklog-sort-by-name () + "Sort tasks by name." + (xwem-interactive) + (setq xwem-worklog-sort-type 'name)) - (let ((buf (find-file-noselect (expand-file-name xwem-worklog-file xwem-dir)))) - (save-excursion - (unwind-protect - (with-current-buffer buf - ;; Avoid using `end-of-buffer' - (goto-char (point-max)) - (unless (bolp) - (newline)) - (insert (worklog-make-date-time) " ") - - (insert (concat string "\n")) - (save-buffer)) - (kill-buffer buf))))) - -(defun xwem-worklog-show () - "Show xwem worklog file." - (interactive) - - (require 'worklog) - (find-file (expand-file-name xwem-worklog-file xwem-dir)) - (worklog-mode)) - -(defun xwem-worklog-summarize () - "Just like `worklog-summarize-tasks', but uses xwem worklog file." - (interactive) - (require 'worklog) - - (let ((worklog-file (expand-file-name xwem-worklog-file xwem-dir))) - (worklog-summarize-tasks))) - -(defun xwem-worklog-write-file (&optional file) - "Write FILE in `worklog.el' format. -If FILE is not given, `xwem-worklog-file' from `xwem-dir' will be used." - (require 'worklog) - - (let ((buf (find-file-noselect (or file (expand-file-name xwem-worklog-file xwem-dir))))) - (unwind-protect - (with-current-buffer buf - (goto-char (point-max)) ; append to the end of buffer - - ;; TODO: - ;; - write me - (save-buffer)) - (kill-buffer buf)))) - -(defun xwem-worklog-read-file (&optional time) - "Read FILE in `worklog.el' format. -If FILE is not given, `xwem-worklog-file' from `xwem-dir' will be used." - (require 'worklog) - - (let ((buf (find-file-noselect (expand-file-name xwem-worklog-file xwem-dir)))) - (unwind-protect - (with-current-buffer buf - (goto-char (point-min)) - - ;; TODO: - ;; - write me - ) - (kill-buffer buf)))) +(define-xwem-command xwem-worklog-sort-by-Name () + "Sort tasks by name." + (xwem-interactive) + (setq xwem-worklog-sort-type 'Name)) + +(define-xwem-command xwem-worklog-sort-by-today-time () + "Sort tasks by today time." + (xwem-interactive) + (setq xwem-worklog-sort-type 'today-time)) + +(define-xwem-command xwem-worklog-sort-by-Today-time () + "Sort tasks by Today time." + (xwem-interactive) + (setq xwem-worklog-sort-type 'Today-time)) + +(define-xwem-command xwem-worklog-sort-by-total-time () + "Sort tasks by total time." + (xwem-interactive) + (setq xwem-worklog-sort-type 'total-time)) + +(define-xwem-command xwem-worklog-sort-by-Total-time () + "Sort tasks by Total time." + (xwem-interactive) + (setq xwem-worklog-sort-type 'Total-time)) ;; Worklog notification facilities (defvar xwem-worklog-notifier-timer nil ＠＠ -991,7 +1134,8 ＠＠ (when (itimerp xwem-worklog-notifier-timer) (delete-itimer xwem-worklog-notifier-timer) (setq xwem-worklog-notifier-timer nil))) - + +;;;###autoload(autoload 'xwem-worklog-login "xwem-worklog" nil t) (define-xwem-command xwem-worklog-login () "Stop login notifier, start logout notifier." (xwem-interactive) ＠＠ -1000,9 +1144,10 ＠＠ ;; Install logout notifier (setq xwem-worklog-notifier-timer - (xwem-worklog-today-start-at xwem-worklog-day-ends 0 - 'xwem-worklog-logout-notifier - (* 60 xwem-worklog-logout-notify-period))) + (xwem-worklog-today-start-at + xwem-worklog-day-ends 0 + 'xwem-worklog-logout-notifier + (* 60 xwem-worklog-logout-notify-period))) ;; Recalculate today time for every task (mapc (lambda (task) ＠＠ -1010,8 +1155,11 ＠＠ xwem-worklog-task-list) (xwem-worklog-begin-task "login") + (setq xwem-worklog-logged-in t) + (run-hooks 'xwem-worklog-login-hook)) +;;;###autoload(autoload 'xwem-worklog-logout "xwem-worklog" nil t) (define-xwem-command xwem-worklog-logout () "Stop logout notifier, start login notifier." (xwem-interactive) ＠＠ -1020,11 +1168,14 ＠＠ ;; Install login notifier (setq xwem-worklog-notifier-timer - (xwem-worklog-tomorow-start-at xwem-worklog-day-start 0 - 'xwem-worklog-login-notifier - (* 60 xwem-worklog-login-notify-period))) + (xwem-worklog-tomorow-start-at + xwem-worklog-day-start 0 + 'xwem-worklog-login-notifier + (* 60 xwem-worklog-login-notify-period))) (xwem-worklog-begin-task "logout") + (setq xwem-worklog-logged-in nil) + (run-hooks 'xwem-worklog-logout-hook)) (defun xwem-worklog-login-notifier () ＠＠ -1036,9 +1187,7 ＠＠ 'xwem-worklog-notifier-stop (* 60 xwem-worklog-login-stop-period)))) - (xwem-message 'asis (concat (xwem-str-with-faces "XWEM WORKLOG: " '(red bold)) - "Workday started, but you're not logged in.")) - (xwem-play-sound 'alarm)) + (xwem-message 'alarm "[WORKLOG] Workday started, but you're not logged in.")) (defun xwem-worklog-logout-notifier () "Notify that you need to logout." ＠＠ -1049,9 +1198,7 ＠＠ 'xwem-worklog-logout (* 60 xwem-worklog-logout-auto-period)))) - (xwem-message 'asis (concat (xwem-str-with-faces "XWEM WORKLOG: " '(red bold)) - "Workday ended, but you're still working.")) - (xwem-play-sound 'alarm)) + (xwem-message 'alarm "[WORKLOG] Workday ended, but you're still working.")) (defun xwem-worklog-doat (time func &optional restart) "Run function FUNC at a given TIME. ＠＠ -1086,58 +1233,64 ＠＠ (xwem-worklog-doat (apply 'encode-time ctime) fun restart))) ;; Diagram drawing +(define-xwem-face xwem-worklog-temp-face + `((t (:foreground "black"))) + "Temporary face used by worklog.") + (defun xwem-worklog-show-color-breaks () "Show color breaks." - (when (eq (xwem-worklog-pause-type xwem-worklog-pause-p) 'list) ;; Do it only in listing - (let* ((tmp-face (make-face 'tmp-face)) - (face-height (font-height (face-font 'default))) - (w 10) - (y (- (* 5 face-height) (/ w 2))) - (x 6)) + (let* ((face-height (font-height (face-font 'default))) + (w 10) (y (- (* 5 face-height) (/ w 2))) (x 6)) (mapc (lambda (task) - (let ((d (xwem-worklog-lookup-description (xwem-worklog-task-name task)))) - (xwem-face-set-foreground tmp-face (or (and d (aref d 2)) "black")) - (xwem-diag-draw-rect (xwem-worklog-pause-pwin xwem-worklog-pause-p) - (xwem-face-get-gc 'default) - (cons x y) (cons (+ x w) y) - (cons (+ x w) (+ y w)) (cons x (+ y w)) (xwem-face-get-gc tmp-face)) - (setq y (+ y face-height)))) - xwem-worklog-task-list) - ))) + (xwem-set-face-foreground 'xwem-worklog-temp-face + (or (plist-get (cadr (xwem-worklog-lookup-description + (xwem-worklog-task-name task))) :color) "black")) + (xwem-diag-draw-rect (xwem-worklog-pause-pwin xwem-worklog-pause-p) + (xwem-face-get-gc 'default) + (cons x y) (cons (+ x w) y) + (cons (+ x w) (+ y w)) (cons x (+ y w)) + (xwem-face-get-gc 'xwem-worklog-temp-face)) + (setq y (+ y face-height))) + (xwem-worklog-sorted-task-list))))) (defun xwem-worklog-generate-percentage-spec (sector-width &optional no-labels no-yoff) "Generates percentage diagram spec. If NO-LABELS is non-nil, labels will be avoided." - (let ((today-seconds (* 60.0 60 (- xwem-worklog-day-ends xwem-worklog-day-start))) - spec spec1) - - (setq spec1 (mapcar (lambda (task) - (let* ((d (xwem-worklog-lookup-description (xwem-worklog-task-name task))) + (let* ((today-seconds + (* 60.0 60 + (if (> xwem-worklog-day-ends xwem-worklog-day-start) + (- xwem-worklog-day-ends xwem-worklog-day-start) + (- (+ 24 xwem-worklog-day-ends) + xwem-worklog-day-start)))) + (spec1 (mapcar (lambda (task) + (let* ((td (xwem-worklog-lookup-description (xwem-worklog-task-name task))) (tt (xwem-worklog-get-today-time task)) (ts (+ (* (car tt) 65536.0) (cadr tt))) (per (truncate (* 100.0 (/ ts today-seconds)))) - (rv (and d (> per 0) - (vector per (not no-labels) (aref d 2) 0 0 + (rv (and td (> per 0) + (vector per (not no-labels) (plist-get (cadr td) :color) 0 0 (if (and (not no-yoff) (eq task xwem-worklog-current-task)) - (- (/ sector-width 2)) 0))))) + (- (/ sector-width 2)) + 0))))) rv)) xwem-worklog-task-list)) + spec) ;; Remove invalid fields (while spec1 (when (car spec1) (setq spec (cons (car spec1) spec))) (setq spec1 (cdr spec1))) - spec)) (defun xwem-worklog-draw-today-diagram () - "" + "Draw stuff for today." (when (eq (xwem-worklog-pause-type xwem-worklog-pause-p) 'list) ;; Do it only in listing - (let* ((buf-lines (with-current-buffer (xwem-worklog-pause-pbuf xwem-worklog-pause-p) (count-lines (point-min) (point-max)))) + (let* ((buf-lines (with-current-buffer (xwem-worklog-pause-pbuf xwem-worklog-pause-p) + (count-lines (point-min) (point-max)))) (face-height (font-height (face-font 'default))) (t-off 2) (y-off (* face-height (+ t-off buf-lines))) ＠＠ -1154,92 +1307,307 ＠＠ (xwem-face-get-gc 'default) x-off y-off wwid whei sec-hei)) ))) -;;; Worklog dockapp +(defvar xwem-worklog-dockapp-map + (let ((map (make-sparse-keymap))) + (define-key map [button1] 'xwem-worklog-task-list) + (define-key map [button3] 'xwem-worklog-dockapp-menu) + map) + "Keymap used by worklog dockapp.") + +(defstruct xwem-worklog-dockapp + win + update-itimer ; itimer to update worklog-dockapp + + ;; dockapp and sector geometry + width height + sector-width) + (defconst xwem-worklog-dockapp-event-mask (list XM-Exposure XM-StructureNotify XM-ButtonPress XM-ButtonRelease)) (defun xwem-worklog-meaning-update-time () "Return seconds." - (/ (* 60 60 (- xwem-worklog-day-ends xwem-worklog-day-start)) 100)) + (if (> xwem-worklog-day-ends xwem-worklog-day-start) + (/ (* 60 60 (- xwem-worklog-day-ends xwem-worklog-day-start)) 100) + (/ (* 60 60 (- (+ 24 xwem-worklog-day-ends) xwem-worklog-day-start)) + 100))) + +(define-xwem-deffered xwem-worklog-dockapp-update (dockapp) + "Update worklog dockapp." + (when (xwem-worklog-dockapp-p dockapp) + (let* ((win (xwem-worklog-dockapp-win dockapp)) + (xdpy (X-Win-dpy win)) + (w (xwem-worklog-dockapp-width dockapp)) + (h (xwem-worklog-dockapp-height dockapp)) + (sec-w (xwem-worklog-dockapp-sector-width dockapp)) + (spec (xwem-worklog-generate-percentage-spec sec-w t t)) + td) + + (XClearArea xdpy win 0 0 (+ 1 w) (+ 1 h (* 2 sec-w)) nil) + (when spec + (xwem-diag-draw-percentage + xwem-worklog-dockapp-diagram-type + spec win (xwem-face-get-gc 'default) + (/ sec-w 2) (/ sec-w 2) w h sec-w)) + + (when (and xwem-worklog-current-task + (setq td (xwem-worklog-lookup-description + (xwem-worklog-task-name xwem-worklog-current-task)))) + (xwem-set-face-foreground 'xwem-worklog-temp-face (or (plist-get (cadr td) :color) "black")) + (XFillRectangle xdpy win (xwem-face-get-gc 'xwem-worklog-temp-face) 0 0 6 6))))) (defun xwem-worklog-dockapp-event-handler (xdpy xwin xev) "Event handler for worklog dockapp." - (X-Event-CASE xev - (:X-Expose - (xwem-worklog-dockapp-update)) - - (:X-DestroyNotify - (delete-itimer (xwem-worklog-dockapp-update-itimer xwem-worklog-dockapp)) - (remove-hook 'xwem-worklog-task-start-hook 'xwem-worklog-dockapp-update) - (setq xwem-worklog-dockapp nil)) - )) + (let ((dockapp (X-Win-get-prop xwin 'xwem-worklog-dockapp))) + (when (xwem-worklog-dockapp-p dockapp) + (X-Event-CASE xev + ((:X-Expose :X-MapNotify) + (xwem-worklog-dockapp-update dockapp)) + + ((:X-ButtonPress :X-ButtonRelease) + (xwem-overriding-local-map xwem-worklog-dockapp-map + (xwem-dispatch-command-xevent xev))) -(defun xwem-worklog-dockapp-update () - "Update worklog dockapp." - (when xwem-worklog-dockapp - (let* ((win (xwem-worklog-dockapp-win xwem-worklog-dockapp)) - (xdpy (X-Win-dpy win)) - (w (xwem-worklog-dockapp-width xwem-worklog-dockapp)) - (h (xwem-worklog-dockapp-height xwem-worklog-dockapp)) - (sec-w (xwem-worklog-dockapp-sector-width xwem-worklog-dockapp)) - (spec (xwem-worklog-generate-percentage-spec sec-w t t))) - - (X-Dpy-send-excursion xdpy - (XClearArea xdpy win 0 0 (+ 1 w) (+ 1 h (* 2 sec-w)) nil) - (when spec - (xwem-diag-draw-percentage - xwem-worklog-dockapp-diagram-type - spec win (xwem-face-get-gc 'default) - (/ sec-w 2) (/ sec-w 2) w h sec-w)) - - (when xwem-worklog-current-task - (let ((rd (xwem-worklog-lookup-description (xwem-worklog-task-name xwem-worklog-current-task))) - tface) - (when rd - (setq tface (make-face 'temp-face)) - (xwem-face-set-foreground tface (or (aref rd 2) "black")) - (XFillRectangle xdpy win (xwem-face-get-gc tface) 0 0 6 6)) - )) - )) - )) + (:X-DestroyNotify + (xwem-worklog-dockapp-stop dockapp)))))) ;;;###autoload -(defun xwem-worklog-start-dockapp (&optional xdpy w h sector-width) - "Start dockapp." - (unless xdpy - (setq xdpy (xwem-dpy))) - (unless w - (setq w 32)) ; XXX - (unless h - (setq h 24)) ; XXX - (unless sector-width - (setq sector-width 0)) ; XXX - - (let ((wd (make-xwem-worklog-dockapp -:win (XCreateWindow xdpy nil 0 0 (+ 1 w) (+ 1 h (* 2 sector-width)) 0 nil nil nil - (make-X-Attr :override-redirect t -:background-pixel (XAllocNamedColor xdpy (XDefaultColormap xdpy) - (face-background-name 'default)) ; XXX - )) -:width w :height h :sector-width sector-width))) +(defun xwem-worklog-start-dockapp (&optional dockid dockgroup dockalign) + "Start xwem worklog dockapp." + (let* ((w xwem-worklog-dockapp-width) + (h xwem-worklog-dockapp-height) + (sw xwem-worklog-dockapp-sector-width) + (wd (make-xwem-worklog-dockapp +:win (XCreateWindow (xwem-dpy) nil 0 0 (+ 1 w) (+ 1 h (* 2 sw)) + 0 nil nil nil + (make-X-Attr :override-redirect t +:background-pixel + (XAllocNamedColor (xwem-dpy) (XDefaultColormap (xwem-dpy)) + (face-background-name 'default)) ; XXX + )) +:width w :height h :sector-width sw))) - (setq xwem-worklog-dockapp wd) + (X-Win-put-prop (xwem-worklog-dockapp-win wd) 'xwem-worklog-dockapp wd) - (XSelectInput xdpy (xwem-worklog-dockapp-win wd) (apply 'Xmask-or xwem-worklog-dockapp-event-mask)) + (XSelectInput (xwem-dpy) (xwem-worklog-dockapp-win wd) + (apply 'Xmask-or xwem-worklog-dockapp-event-mask)) (X-Win-EventHandler-add (xwem-worklog-dockapp-win wd) 'xwem-worklog-dockapp-event-handler nil - (list X-Expose X-ButtonPress X-ButtonRelease - X-DestroyNotify)) + (list X-Expose X-MapNotify X-ButtonPress X-ButtonRelease X-DestroyNotify)) ;; Initialize wd in sys tray - (XTrayInit xdpy (xwem-worklog-dockapp-win wd)) + (xwem-XTrayInit (xwem-dpy) (xwem-worklog-dockapp-win wd) dockid dockgroup dockalign) ;; Start updater (setf (xwem-worklog-dockapp-update-itimer wd) - (start-itimer "xwem-worklog-dockapp-updater" 'xwem-worklog-dockapp-update - (xwem-worklog-meaning-update-time) (xwem-worklog-meaning-update-time))) + (start-itimer "xwem-worklog-dockapp-updater" + `(lambda () (xwem-worklog-dockapp-update ,wd)) + (xwem-worklog-meaning-update-time) + (xwem-worklog-meaning-update-time))) + + (add-hook 'xwem-worklog-task-start-hook + `(lambda () (xwem-worklog-dockapp-update ,wd))) + wd)) + +(defun xwem-worklog-dockapp-stop (dockapp) + "Stop worklog dockapp." + (when (xwem-worklog-dockapp-p dockapp) + (remove-hook 'xwem-worklog-task-start-hook + `(lambda () (xwem-worklog-dockapp-update ,dockapp))) + (delete-itimer (xwem-worklog-dockapp-update-itimer dockapp)) + (X-Win-rem-prop (xwem-worklog-dockapp-win dockapp) 'xwem-worklog-dockapp) + (X-invalidate-cl-struct dockapp))) + +(define-xwem-command xwem-worklog-task-info (task) + "Show info about TASK." + (xwem-interactive (list xwem-worklog-current-task)) + (xwem-message 'info "Task: '%s', running %s" + (xwem-worklog-task-name task) + (xwem-worklog-last-time-string task 20))) - (add-hook 'xwem-worklog-task-start-hook 'xwem-worklog-dockapp-update) - )) +(define-xwem-command xwem-worklog-dockapp-menu () + "Popup menu for dockapp." + (xwem-interactive) + + (unless (button-event-p xwem-last-event) + (error 'xwem-error "`xwem-worklog-dockapp-menu' must be bound to mouse event")) + + (xwem-popup-menu + (list "Worklog" + (vector "Current Task Info" `(xwem-worklog-task-info ,xwem-worklog-current-task)) + (cons "Start task" + (mapcar (lambda (td) + (vector (car td) `(xwem-worklog-begin-task ,(car td)))) + xwem-worklog-tasks-description)) + "---" + (vector "Pause" `(xwem-worklog-pause nil)) + (vector "List tasks" `(xwem-worklog-pause nil 'list))))) + +;;; MISC +(defun xwem-worklog-on-select-cl (&optional cl) + "New CL just selected, change task if needed. +To be used in `xwem-client-select-hook'." + (unless cl + (setq cl (xwem-cl-selected))) + + (when (xwem-cl-selected-p cl) + (let ((td (xwem-manda-find-match-1 cl xwem-worklog-tasks-description))) + (when (and td + (not (string= (xwem-worklog-task-name xwem-worklog-current-task) + (car td)))) + (xwem-worklog-begin-task (car td)))))) + +(defun xwem-worklog-init () + "Initialise xwem worklog." + (xwem-message 'init "Initializing worklog ...") + + ;; Add our label to label prefixes + (add-to-list 'xwem-messages-label-prefixes + '(worklog "Worklog")) + + (add-hook 'xwem-worklog-login-hook + (lambda () + (add-hook 'xwem-client-select-hook 'xwem-worklog-on-select-cl) + (add-hook 'xwem-cl-change-hook 'xwem-worklog-on-select-cl) + (when (xwem-cl-p (xwem-cl-selected)) + + ;; When logging out, also save history + (xwem-worklog-history-save))) + +(defun xwem-worklog-history-on-stop () + "Called when task just stoped. +To be used in `xwem-worklog-task-stop-hook'." + (unless (or (string= (xwem-worklog-task-name (xwem-worklog-current-task)) "logout") + (string= (xwem-worklog-task-name (xwem-worklog-current-task)) "login")) + (xwem-worklog-history-add-entry "stop"))) + + +;;;; On-load actions: +;; - Add custom bindings +(mapc (lambda (el) + (let ((key (plist-get (cadr el) :key))) + (when key + (define-key xwem-worklog-map key (xwem-worklog-create-cmd (car el)))))) + xwem-worklog-tasks-description) + +;; - Initialize worklog +(xwem-worklog-init) (run-hooks 'xwem-worklog-load-hook) Index: lisp/xwem-xfig.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/lisp/xwem-xfig.el,v retrieving revision 1.3 diff -u -u -r1.3 xwem-xfig.el --- lisp/xwem-xfig.el 16 Dec 2004 08:08:17 -0000 1.3 +++ lisp/xwem-xfig.el 1 Jan 2005 04:41:19 -0000 ＠＠ -5,7 +5,7 ＠＠ ;; Author: Zajcev Evgeny <zevlg(a)yandex.ru> ;; Created: Sat Mar 6 13:32:11 MSK 2004 ;; Keywords: xwem -;; X-CVS: $Id: xwem-xfig.el,v 1.3 2004/12/16 08:08:17 youngs Exp $ +;; X-CVS: $Id: xwem-xfig.el,v 1.1 2004/11/29 20:42:27 lg Exp $ ;; This file is part of XWEM. ＠＠ -305,7 +305,7 ＠＠ ((= ob 4) (xwem-xfig-parse-text line)) ((= ob 5) (xwem-xfig-parse-arc line)) ((= ob 6) (xwem-xfig-parse-compound line)) - (t (error "Invalid line format" line))) + (t (error "XWEM Invalid line format" line))) (xwem-xfig-objects xfig)))) Index: man/xwem-version.texi =================================================================== RCS file: man/xwem-version.texi diff -N man/xwem-version.texi --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ man/xwem-version.texi 1 Jan 2005 04:41:19 -0000 ＠＠ -0,0 +1 ＠＠ +＠set VERSION lg＠(a)xwem.org--2004/xwem--main--2.0--version-0 \ No newline at end of file Index: man/xwem.texi =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xwem/man/xwem.texi,v retrieving revision 1.1 diff -u -u -r1.1 xwem.texi --- man/xwem.texi 16 Mar 2004 20:33:29 -0000 1.1 +++ man/xwem.texi 1 Jan 2005 04:41:19 -0000 ＠＠ -8,7 +8,6 ＠＠＠c ＠setchapternewpage odd ＠c %**end of header ＠set EDITION 1.0 -＠set VERSION 0.0.1 ＠set UPDATED May 25, 2003 ＠dircategory Lisp ＠＠ -17,6 +16,7 ＠＠＠end direntry ＠ifinfo +＠include xwem-version.texi This manual for XWEM project version ＠value{VERSION}. The manual was last updated ＠value{UPDATED}. -- |---<Steve Youngs>---------------<GnuPG KeyID: A94B3003>---| | In space, | | No one can hear you rip a stinky | |---------------------------------------<steve(a)xwem.org>---|

1 participants
0 comments

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

XEmacs-Patches January 2005