Notice of CVSROOT-commit by stephent in CVSROOT
19 years
CVS Monitor
CVS Monitor
Commit done by stephent
Tue Apr 5 06:32:23 CEST 2005
Update of /pack/xemacscvs/CVSROOT
In directory sunsite.dk:/tmp/cvs-serv11789
Modified Files:
avail
Log Message:
reenable Steve Y for CVSROOT
- 1 participants
- 0 comments
CVS update by viteno xemacs ...
19 years
CVS Monitor
CVS Monitor
User: viteno
Date: 05/04/04 23:51:31
Modified: xemacs version.sh
Log:
Update xemacs_extra_name.
Revision Changes Path
1.1118 +1 -1 XEmacs/xemacs/version.sh
Index: version.sh
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/version.sh,v
retrieving revision 1.1117
retrieving revision 1.1118
diff -u -p -r1.1117 -r1.1118
--- version.sh 2005/04/03 21:51:48 1.1117
+++ version.sh 2005/04/04 21:51:30 1.1118
＠＠ -8,5 +8,5 ＠＠ emacs_kit_version=
infodock_major_version=4
infodock_minor_version=0
infodock_build_version=8
-xemacs_extra_name="(+CVS-20050403)"
+xemacs_extra_name="(+CVS-20050404)"
xemacs_release_date="2005-02-18"
- 1 participants
- 0 comments
CVS update by adrian packages/xemacs-packages/psgml ...
19 years
CVS Monitor
CVS Monitor
User: adrian
Date: 05/04/04 23:49:06
Modified: packages/xemacs-packages/psgml ChangeLog psgml.el
Log:
[PATCH] packages: Add auto-mode-alist autoload cookie for .xsd to <hdim5nbp.fsf(a)smtprelay.t-online.de>
Revision Changes Path
1.74 +4 -0 XEmacs/packages/xemacs-packages/psgml/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/psgml/ChangeLog,v
retrieving revision 1.73
retrieving revision 1.74
diff -u -p -r1.73 -r1.74
--- ChangeLog 2004/06/21 18:22:44 1.73
+++ ChangeLog 2005/04/04 21:49:01 1.74
＠＠ -1,3 +1,7 ＠＠
+2005-04-04 Adrian Aichner <adrian(a)xemacs.org>
+
+ * psgml.el: Add auto-mode-alist autoload cookie for .xsd.
+
2004-06-21 Norbert Koch <viteno(a)xemacs.org>
* Makefile (VERSION): XEmacs package 1.43 released.
1.26 +1 -0 XEmacs/packages/xemacs-packages/psgml/psgml.el
Index: psgml.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/psgml/psgml.el,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -p -r1.25 -r1.26
--- psgml.el 2004/06/21 18:08:21 1.25
+++ psgml.el 2005/04/04 21:49:01 1.26
＠＠ -1803,6 +1803,7 ＠＠ otherwise it will be added at the first
;; XEmacs additions
;;;###autoload(add-to-list 'auto-mode-alist '("\\.\\(?:sgml?\\|dtd\\)\\'" . sgml-mode))
;;;###autoload(add-to-list 'auto-mode-alist '("\\.xml\\'" . xml-mode))
+;;;###autoload(add-to-list 'auto-mode-alist '("\\.xsd\\'" . xml-mode))
;;;; Last provisions
- 1 participants
- 0 comments
CVS update by adrian packages/xemacs-packages/xemacs-base ...
19 years
CVS Monitor
CVS Monitor
User: adrian
Date: 05/04/04 23:37:03
Modified: packages/xemacs-packages/xemacs-base ChangeLog tq.el
Log:
packages: Sync tq.el with GNU Emacs tq.el<1.18>
-------------------- ChangeLog entries follow: --------------------
xemacs-packages/xemacs-base/ChangeLog addition:
2005-04-04 Adrian Aichner <adrian(a)xemacs.org>
* tq.el (tq-create): Sync tq.el with GNU Emacs tq.el<1.18>.
Revision Changes Path
1.166 +4 -0 XEmacs/packages/xemacs-packages/xemacs-base/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xemacs-base/ChangeLog,v
retrieving revision 1.165
retrieving revision 1.166
diff -u -p -r1.165 -r1.166
--- ChangeLog 2005/03/05 19:19:16 1.165
+++ ChangeLog 2005/04/04 21:37:02 1.166
＠＠ -1,3 +1,7 ＠＠
+2005-04-04 Adrian Aichner <adrian(a)xemacs.org>
+
+ * tq.el (tq-create): Sync tq.el with GNU Emacs tq.el<1.18>.
+
2005-03-05 Norbert Koch <viteno(a)xemacs.org>
* Makefile (VERSION): XEmacs package 1.96 released.
1.3 +1 -1 XEmacs/packages/xemacs-packages/xemacs-base/tq.el
Index: tq.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xemacs-base/tq.el,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -p -r1.2 -r1.3
--- tq.el 2004/11/07 23:43:10 1.2
+++ tq.el 2005/04/04 21:37:03 1.3
＠＠ -51,7 +51,7 ＠＠ to a tcp server on another machine."
(process-name process)))))))
(set-process-filter process
`(lambda (proc string)
- (tq-filter '(, tq) string)))
+ (tq-filter ',tq string)))
tq))
;;; accessors
- 1 participants
- 0 comments
CVS update by lg packages/xemacs-packages/xlib/lisp, xlib-const.el, xlib-keysymdb.el, xlib-tray.el, xlib-xc.el, xlib-xlib.el, xlib-xshape.el ...
19 years
CVS Monitor
CVS Monitor
User: lg
Date: 05/04/04 21:55:33
Modified: packages/xemacs-packages/xlib/lisp xlib-composer.el
xlib-const.el xlib-hello.el xlib-img.el
xlib-keysymdb.el xlib-math.el xlib-testing.el
xlib-tray.el xlib-version.el xlib-vidmode.el
xlib-xc.el xlib-xdpms.el xlib-xinerama.el
xlib-xlib.el xlib-xpm.el xlib-xr.el xlib-xrecord.el
xlib-xshape.el xlib-xtest.el xlib-xwin.el
Log:
Sync with Xlib 2.1 Release
Revision Changes Path
1.2 +288 -0 XEmacs/packages/xemacs-packages/xlib/ChangeLog.upstream
Index: ChangeLog.upstream
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/ChangeLog.upstream,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -p -r1.1 -r1.2
--- ChangeLog.upstream 2005/01/01 04:40:11 1.1
+++ ChangeLog.upstream 2005/04/04 19:55:25 1.2
＠＠ -1,4 +1,292 ＠＠
# do not edit -- automatically generated by arch changelog
+# arch-tag: automatic-ChangeLog--lg(a)xwem.org--2005/xlib--main--2.1
+#
+
+2005-04-04 18:25:15 GMT Zajcev Evgeny <lg(a)xwem.org> version-0
+
+ Summary:
+ Xlib 2.1 is released
+ Revision:
+ xlib--main--2.1--version-0
+
+
+
+2005-03-30 22:24:01 GMT Zajcev Evgeny <lg(a)xwem.org> patch-12
+
+ Summary:
+ Support for COMPOUNT_TEXT properties.
+ Revision:
+ xlib--main--2.1--patch-12
+
+ * lisp/xlib-xlib.el (XDecodeCompoundText): [new] Function to extract text
+ from COMPOUND_TEXT text.
+
+ * lisp/xlib-xlib.el (XGetPropertyString): [fix] Use `XDecodeCompoundText'
+ in case of property in COMPOUND_TEXT encoding.
+
+ modified files:
+ lisp/xlib-xlib.el
+
+ new patches:
+ dev(a)xwem.org--2004-w/xlib--dev--2.1--patch-7
+
+
+2005-02-26 17:48:25 GMT Zajcev Evgeny <lg(a)xwem.org> patch-11
+
+ Summary:
+ merge from ckent, compilation warnings elimination
+ Revision:
+ xlib--main--2.1--patch-11
+
+ * lisp/xlib-xrecord.el (predicateds): Some predicateds moved on top.
+
+ * lisp/xlib-xwin.el (predicateds): Some predicateds moved on top.
+
+ modified files:
+ lisp/xlib-xrecord.el lisp/xlib-xwin.el
+
+ new patches:
+ dev(a)xwem.org--2004-w/xlib--dev--2.1--patch-6
+
+
+2005-02-25 10:55:05 GMT Zajcev Evgeny <lg(a)xwem.org> patch-10
+
+ Summary:
+ lambda fixes
+ Revision:
+ xlib--main--2.1--patch-10
+
+
+ modified files:
+ lisp/xlib-img.el lisp/xlib-testing.el lisp/xlib-xc.el
+ lisp/xlib-xlib.el lisp/xlib-xpm.el lisp/xlib-xr.el
+ lisp/xlib-xrecord.el lisp/xlib-xwin.el
+
+
+2005-02-13 23:02:44 GMT Zajcev Evgeny <lg(a)xwem.org> patch-9
+
+ Summary:
+ Useful addons
+ Revision:
+ xlib--main--2.1--patch-9
+
+ * lisp/xlib-xlib.el (XDeleteProperty): [new] X request to delete X
+ property.
+
+ * lisp/xlib-xlib.el (XSetWindowBackgroundPixmap): [new] Set window
+ background pixmap.
+
+ * lisp/xlib-xlib.el (XSetPropertyString): [new] To set textual X
+ properties.
+
+ * lisp/xlib-xr.el (X-EventsList): [fix] sanitify creation.
+
+ * lisp/xlib-const.el (errors): [addon] X error codes added.
+
+ modified files:
+ lisp/xlib-const.el lisp/xlib-xlib.el lisp/xlib-xr.el
+
+
+2005-02-10 00:18:24 GMT Zajcev Evgeny <lg(a)xwem.org> patch-8
+
+ Summary:
+ logging changed a little
+ Revision:
+ xlib--main--2.1--patch-8
+
+ * lisp/xlib-xr.el: Logging for inter events changed a little. to be used
+ in catching evil bug.
+
+ modified files:
+ lisp/xlib-xr.el
+
+
+2005-02-06 20:00:08 GMT Zajcev Evgeny <lg(a)xwem.org> patch-7
+
+ Summary:
+ Merge from ckent
+ Revision:
+ xlib--main--2.1--patch-7
+
+ Patches applied:
+
+ * dev(a)xwem.org--2004-w/xlib--dev--2.1--patch-3
+ Copyright string changes
+
+
+ modified files:
+ lisp/xlib-composer.el lisp/xlib-const.el lisp/xlib-hello.el
+ lisp/xlib-img.el lisp/xlib-keysymdb.el lisp/xlib-math.el
+ lisp/xlib-testing.el lisp/xlib-tray.el lisp/xlib-vidmode.el
+ lisp/xlib-xc.el lisp/xlib-xdpms.el lisp/xlib-xinerama.el
+ lisp/xlib-xlib.el lisp/xlib-xpm.el lisp/xlib-xr.el
+ lisp/xlib-xrecord.el lisp/xlib-xshape.el lisp/xlib-xtest.el
+ lisp/xlib-xwin.el
+
+ new patches:
+ dev(a)xwem.org--2004-w/xlib--dev--2.1--patch-3
+
+
+2005-02-03 23:52:26 GMT Zajcev Evgeny <lg(a)xwem.org> patch-6
+
+ Summary:
+ merge from ckent, X Event define/declare addons
+ Revision:
+ xlib--main--2.1--patch-6
+
+ * lisp/xlib-xr.el (X-Event-define): [addon] DESCR splited to EV-NAME,
+ EV-MSG and WIN-IDX. New parameter EVENT-WIN-IDX added.
+
+ * lisp/xlib-xr.el (X-Event-declare): [addon] Ditto.
+
+ modified files:
+ lisp/xlib-xc.el lisp/xlib-xr.el
+
+ new patches:
+ dev(a)xwem.org--2004-w/xlib--dev--2.1--patch-2
+
+
+2005-02-02 23:52:31 GMT Zajcev Evgeny <lg(a)xwem.org> patch-5
+
+ Summary:
+ XDestroy declaration fix|try
+ Revision:
+ xlib--main--2.1--patch-5
+
+
+ modified files:
+ lisp/xlib-xr.el
+
+
+2005-02-02 22:11:17 GMT Zajcev Evgeny <lg(a)xwem.org> patch-4
+
+ Summary:
+ 2 serious bug fixes
+ Revision:
+ xlib--main--2.1--patch-4
+
+ * lisp/xlib-xlib.el (xlib-opcodes-alist): [rem] moved to xlib-xr.el
+
+ * lisp/xlib-xr.el (xlib-opcodes-alist): [new] moved from xlib-xlib.el
+
+ * lisp/xlib-xr.el (X-Dpy-send-read): [BUG fix] Serious BUG fixed. Do
+ flushing under reading protection, because in some (pretty ofter)
+ circumstances flushing can execute deffered calls by side effect which
+ may lead to desyncronisation.
+
+ * lisp/xlib-xr.el (X-Dpy-parse-message): [BUG fix] Serious BUG fixed.
+ Dispatch intermediate event or error only after all reply to request is
+ fetched. Executing intermediate event or error may cause unexpected
+ reading by side effect.
+
+ * lisp/xlib-xr.el (code): [cleanup] Untabification.
+
+ * lisp/xlib-xrecord.el (X-XRecord-parse-guess): [fix] fixes to make it
+ more resistable for errors.
+
+ * lisp/xlib-xrecord.el (code): [cleanup] Untabification.
+
+ modified files:
+ lisp/xlib-xlib.el lisp/xlib-xr.el lisp/xlib-xrecord.el
+
+ new patches:
+ dev(a)xwem.org--2004-w/xlib--dev--2.1--base-0
+ dev(a)xwem.org--2004-w/xlib--dev--2.1--patch-1
+
+
+2005-02-01 23:04:15 GMT Zajcev Evgeny <lg(a)xwem.org> patch-3
+
+ Summary:
+ Root of most of the X timeout problems founded at last
+ Revision:
+ xlib--main--2.1--patch-3
+
+ * lisp/xlib-xr.el (X-Dpy-send-read): [BUG fix] Root of most of X timeout
+ errors founded here. This is response parsing problem. In some
+ circumstances we can request X server for data, while processing data.
+ This eventually lead to desyncronization. This is caused by
+ xwem-misc-xerr-hook, which can be called from inside `X-Dpy-send-read'
+ and xwem-misc-xerr-hook can also do `X-Dpy-send-read', now we restrict
+ `X-Dpy-send-read' reentering to avoid desyncronization. This is quite
+ rarely situation when `X-Dpy-send-read' reenters, but when it happens
+ xlib hangs forever.
+
+ Many thanks to all of you guys for pushing me about this stuff!
+
+ * lisp/xlib-xr.el (xxx): [misc] Some tiny cleanups, and more some logs
+ added. Errors raising clarified, etc.
+
+
+ modified files:
+ lisp/xlib-xr.el
+
+
+2005-01-08 01:51:45 GMT Zajcev Evgeny <lg(a)xwem.org> patch-2
+
+ Summary:
+ inhibit C-g while parsing message
+ Revision:
+ xlib--main--2.1--patch-2
+
+ * lisp/xlib-xr.el (X-Dpy-parse-message): [fix] inhibit C-g while parsing,
+ so pressing C-g will not desync xlib.
+
+ modified files:
+ lisp/xlib-xr.el
+
+
+2005-01-01 02:54:34 GMT Zajcev Evgeny <lg(a)xwem.org> patch-1
+
+ Summary:
+ start of 2.1
+ Revision:
+ xlib--main--2.1--patch-1
+
+
+ new files:
+ ChangeLog.d/.arch-ids/=id
+ ChangeLog.d/.arch-ids/ChangeLog-2.0.id
+ ChangeLog.d/ChangeLog-2.0
+
+ modified files:
+ Makefile
+
+ new directories:
+ ChangeLog.d ChangeLog.d/.arch-ids
+
+
+2005-01-01 02:44:45 GMT Zajcev Evgeny <lg(a)xwem.org> base-0
+
+ Summary:
+ tag of lg(a)xwem.org--2004/xlib--main--2.0--version-0
+ Revision:
+ xlib--main--2.1--base-0
+
+ (automatically generated log message)
+
+ new patches:
+ dev(a)xwem.org--2004-w/xlib--dev--2.0--patch-5
+ dev(a)xwem.org--2004-w/xlib--dev--2.0--patch-6
+ dev(a)xwem.org--2004-w/xlib--dev--2.0--patch-7
+ dev(a)xwem.org--2004-w/xlib--dev--2.0--patch-8
+ dev(a)xwem.org--2004-w/xlib--dev--2.0--patch-9
+ lg(a)xwem.org--2004/xlib--main--2.0--base-0
+ lg(a)xwem.org--2004/xlib--main--2.0--patch-1
+ lg(a)xwem.org--2004/xlib--main--2.0--patch-2
+ lg(a)xwem.org--2004/xlib--main--2.0--patch-3
+ lg(a)xwem.org--2004/xlib--main--2.0--patch-4
+ lg(a)xwem.org--2004/xlib--main--2.0--patch-5
+ lg(a)xwem.org--2004/xlib--main--2.0--patch-6
+ lg(a)xwem.org--2004/xlib--main--2.0--patch-7
+ lg(a)xwem.org--2004/xlib--main--2.0--patch-8
+ lg(a)xwem.org--2004/xlib--main--2.0--patch-9
+ lg(a)xwem.org--2004/xlib--main--2.0--version-0
+ steve(a)eicq.org--2004/xlib--steve--2.0--base-0
+ steve(a)eicq.org--2004/xlib--steve--2.0--patch-1
+ steve(a)eicq.org--2004/xlib--steve--2.0--patch-2
+
+
+# do not edit -- automatically generated by arch changelog
# non-id: automatic-ChangeLog--lg(a)xwem.org--2004/xlib--main--2.0
#
1.23 +1 -1 XEmacs/packages/xemacs-packages/xlib/Makefile
Index: Makefile
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/Makefile,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -p -r1.22 -r1.23
--- Makefile 2005/01/04 11:07:13 1.22
+++ Makefile 2005/04/04 19:55:26 1.23
＠＠ -18,7 +18,7 ＠＠
# Boston, MA 02111-1307, USA.
VERSION = 1.13
-AUTHOR_VERSION = lg(a)xwem.org--2004/xlib--main--2.0--version-0
+AUTHOR_VERSION = lg(a)xwem.org--2005/xlib--main--2.1--version-0
MAINTAINER = Zajcev Evgeny <zevlg(a)yandex.ru>
PACKAGE = xlib
PKG_TYPE = regular
1.2 +1 -1 XEmacs/packages/xemacs-packages/xlib/lisp/xlib-composer.el
Index: xlib-composer.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-composer.el,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -p -r1.1 -r1.2
--- xlib-composer.el 2005/01/01 04:40:14 1.1
+++ xlib-composer.el 2005/04/04 19:55:28 1.2
＠＠ -1,11 +1,11 ＠＠
;;; xlib-composer.el ---
-;; Copyright (C) 2004 by Free Software Foundation, Inc.
+;; Copyright (C) 2004,2005 by XWEM Org.
;; Author: Zajcev Evgeny <zevlg(a)yandex.ru>
;; Created: Fri Jun 4 18:46:04 MSD 2004
;; Keywords: xlib
-;; X-CVS: $Id: xlib-composer.el,v 1.1 2005/01/01 04:40:14 youngs Exp $
+;; X-CVS: $Id: xlib-composer.el,v 1.2 2005/04/04 19:55:28 lg Exp $
;; This file is part of XWEM.
1.8 +22 -0 XEmacs/packages/xemacs-packages/xlib/lisp/xlib-const.el
Index: xlib-const.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-const.el,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -p -r1.7 -r1.8
--- xlib-const.el 2005/01/01 04:40:15 1.7
+++ xlib-const.el 2005/04/04 19:55:28 1.8
＠＠ -1,11 +1,12 ＠＠
;;; xlib-const.el --- Constants used in Xlib for masks and the like.
;; Copyright (C) 1996, 1997, 1998 Eric M. Ludlam
+;; Copyright (C) 2003-2005 XWEM Org.
;;
;; Author: Eric M. Ludlam <zappo(a)gnu.ai.mit.edu>
;; Modified: Zajcev Evgeny <zevlg(a)yandex.ru>
;; Keywords: xlib, xwem
-;; X-RCS: $Id: xlib-const.el,v 1.7 2005/01/01 04:40:15 youngs Exp $
+;; X-RCS: $Id: xlib-const.el,v 1.8 2005/04/04 19:55:28 lg Exp $
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
＠＠ -573,6 +574,27 ＠＠
;; Byte order
(defconst X-LSBFirst 0)
(defconst X-MSBFirst 1)
+
+;; X errors
+(defconst X-BadRequest 1)
+(defconst X-BadValue 2)
+(defconst X-BadWindow 3)
+(defconst X-BadPixmap 4)
+(defconst X-BadAtom 5)
+(defconst X-BadCursor 6)
+(defconst X-BadFont 7)
+(defconst X-BadMatch 8)
+(defconst X-BadDrawable 9)
+(defconst X-BadAccess 10)
+(defconst X-BadAlloc 11)
+(defconst X-BadColor 12)
+(defconst X-BadGC 13)
+(defconst X-BadIDChoice 14)
+(defconst X-BadName 15)
+(defconst X-BadLength 16)
+(defconst X-BadImplementation 17)
+(defconst X-BadFirstExtension 128)
+(defconst X-BadLastExtension 255)
(provide 'xlib-const)
1.8 +1 -1 XEmacs/packages/xemacs-packages/xlib/lisp/xlib-hello.el
Index: xlib-hello.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-hello.el,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -p -r1.7 -r1.8
--- xlib-hello.el 2005/01/01 04:40:15 1.7
+++ xlib-hello.el 2005/04/04 19:55:28 1.8
＠＠ -1,11 +1,11 ＠＠
;;; xlib-hello.el --- Hello world example using new xlib.
-;; Copyright (C) 2003 by Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005 by XWEM Org.
;; Author: Eric M. Ludlam <zappo(a)gnu.ai.mit.edu>
;; Modified: Zajcev Evgeny <zevlg(a)yandex.ru>
;; Keywords: xlib
-;; X-CVS: $Id: xlib-hello.el,v 1.7 2005/01/01 04:40:15 youngs Exp $
+;; X-CVS: $Id: xlib-hello.el,v 1.8 2005/04/04 19:55:28 lg Exp $
;; This file is part of XWEM.
1.5 +3 -3 XEmacs/packages/xemacs-packages/xlib/lisp/xlib-img.el
Index: xlib-img.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-img.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -p -r1.4 -r1.5
--- xlib-img.el 2005/01/01 04:40:15 1.4
+++ xlib-img.el 2005/04/04 19:55:28 1.5
＠＠ -1,11 +1,11 ＠＠
;;; xlib-img.el --- Imaging for Xlib.
-;; Copyright (C) 2003 by Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005 by XWEM Org.
;; Author: Zajcev Evgeny <zevlg(a)yandex.ru>
;; Created: Fri Dec 12 11:22:19 MSK 2003
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-img.el,v 1.4 2005/01/01 04:40:15 youngs Exp $
+;; X-CVS: $Id: xlib-img.el,v 1.5 2005/04/04 19:55:28 lg Exp $
;; This file is part of XWEM.
＠＠ -235,8 +235,8 ＠＠
(setq ex-mcc (cons (nreverse tline) ex-mcc)
tline nil)))
(setq ex-mcc (nreverse ex-mcc))
- (setq xdata (mapcar (lambda (l)
- (mapconcat 'identity (mapcar 'int->string2 l) ""))
+ (setq xdata (mapcar #'(lambda (l)
+ (apply 'concat (mapcar 'int->string2 l)))
ex-mcc))
(setq ximg (XCreateImage xdpy nil (XDefaultDepth xdpy)
1.4 +1 -1 XEmacs/packages/xemacs-packages/xlib/lisp/xlib-keysymdb.el
Index: xlib-keysymdb.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-keysymdb.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -p -r1.3 -r1.4
--- xlib-keysymdb.el 2005/01/01 04:40:15 1.3
+++ xlib-keysymdb.el 2005/04/04 19:55:28 1.4
＠＠ -1,11 +1,11 ＠＠
;;; xlib-keysymdb.el --- XKeysymDB for xlib.
-;; Copyright (C) 2004 by Free Software Foundation, Inc.
+;; Copyright (C) 2004,2005 by XWEM Org.
;; Author: Zajcev Evgeny <zevlg(a)yandex.ru>
;; Created: Tue Dec 7 20:23:10 MSK 2004
;; Keywords: xlib
-;; X-CVS: $Id: xlib-keysymdb.el,v 1.3 2005/01/01 04:40:15 youngs Exp $
+;; X-CVS: $Id: xlib-keysymdb.el,v 1.4 2005/04/04 19:55:28 lg Exp $
;; This file is part of XEmacs.
1.8 +1 -0 XEmacs/packages/xemacs-packages/xlib/lisp/xlib-math.el
Index: xlib-math.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-math.el,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -p -r1.7 -r1.8
--- xlib-math.el 2005/01/01 04:40:16 1.7
+++ xlib-math.el 2005/04/04 19:55:28 1.8
＠＠ -1,11 +1,12 ＠＠
;;; xlib-math.el --- icky math things such as 4 byte ints, and int->string stuff.
;; Copyright (C) 1996, 1997, 1998 Eric M. Ludlam
+;; Copyright (C) 2003-2005 XWEM Org.
;;
;; Author: Eric M. Ludlam <zappo(a)gnu.ai.mit.edu>
;; Modified: Zajcev Evgeny <zevlg(a)yandex.ru>
;; Keywords: xlib, xwem
-;; X-RCS: $Id: xlib-math.el,v 1.7 2005/01/01 04:40:16 youngs Exp $
+;; X-RCS: $Id: xlib-math.el,v 1.8 2005/04/04 19:55:28 lg Exp $
;; This file is part of XWEM.
1.4 +13 -13 XEmacs/packages/xemacs-packages/xlib/lisp/xlib-testing.el
Index: xlib-testing.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-testing.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -p -r1.3 -r1.4
--- xlib-testing.el 2005/01/01 04:40:16 1.3
+++ xlib-testing.el 2005/04/04 19:55:29 1.4
＠＠ -1,11 +1,11 ＠＠
;;; xlib-testing.el --- Testing suite for xlib.
-;; Copyright (C) 2004 by Free Software Foundation, Inc.
+;; Copyright (C) 2004,2005 by XWEM Org.
;; Author: Zajcev Evgeny <zevlg(a)yandex.ru>
;; Created: Thu Nov 25 15:34:59 MSK 2004
;; Keywords: xlib
-;; X-CVS: $Id: xlib-testing.el,v 1.3 2005/01/01 04:40:16 youngs Exp $
+;; X-CVS: $Id: xlib-testing.el,v 1.4 2005/04/04 19:55:29 lg Exp $
;; This file is part of XEmacs.
＠＠ -155,18 +155,18 ＠＠
(insert "===> BEGIN at " (format-time-string "%R %S")
"\n")
(let ((X-default-timeout 2.5)) ; 2 seconds
- (mapc (lambda (r)
- (let (begtime endtime result)
- (condition-case err
- (setq begtime (current-time)
- result (funcall r)
- endtime (current-time))
- (t (setq result (cons 'error err))))
- (insert (format "%s ... %f %S" (substring (symbol-name r) 3)
- (itimer-time-difference (or endtime (current-time))
- (or begtime (current-time)))
- result)
- "\n")))
+ (mapc #'(lambda (r)
+ (let (begtime endtime result)
+ (condition-case err
+ (setq begtime (current-time)
+ result (funcall r)
+ endtime (current-time))
+ (t (setq result (cons 'error err))))
+ (insert (format "%s ... %f %S" (substring (symbol-name r) 3)
+ (itimer-time-difference (or endtime (current-time))
+ (or begtime (current-time)))
+ result)
+ "\n")))
xt-test-routines))
(insert "<=== DONE at " (format-time-string "%R %S")
"\n")))
1.8 +1 -1 XEmacs/packages/xemacs-packages/xlib/lisp/xlib-tray.el
Index: xlib-tray.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-tray.el,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -p -r1.7 -r1.8
--- xlib-tray.el 2005/01/01 04:40:16 1.7
+++ xlib-tray.el 2005/04/04 19:55:29 1.8
＠＠ -1,11 +1,11 ＠＠
;;; xlib-tray.el --- XEMBED support.
-;; Copyright (C) 2003 by Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005 by XWEM Org.
;; Author: Zajcev Evgeny <zevlg(a)yandex.ru>
;; Created: Tue Dec 9 14:14:07 MSK 2003
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-tray.el,v 1.7 2005/01/01 04:40:16 youngs Exp $
+;; X-CVS: $Id: xlib-tray.el,v 1.8 2005/04/04 19:55:29 lg Exp $
;; This file is part of XWEM.
1.2 +1 -1 XEmacs/packages/xemacs-packages/xlib/lisp/xlib-version.el
Index: xlib-version.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-version.el,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -p -r1.1 -r1.2
--- xlib-version.el 2005/01/01 04:40:16 1.1
+++ xlib-version.el 2005/04/04 19:55:29 1.2
＠＠ -1,5 +1,5 ＠＠
;;; Automatically generated file -- DO NOT EDIT OR DELETE
;;;###autoload
(defconst xlib-version
- "lg(a)xwem.org--2004/xlib--main--2.0--version-0")
+ "lg(a)xwem.org--2005/xlib--main--2.1--version-0")
(provide 'xlib-version)
1.5 +1 -1 XEmacs/packages/xemacs-packages/xlib/lisp/xlib-vidmode.el
Index: xlib-vidmode.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-vidmode.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -p -r1.4 -r1.5
--- xlib-vidmode.el 2005/01/01 04:40:16 1.4
+++ xlib-vidmode.el 2005/04/04 19:55:29 1.5
＠＠ -1,11 +1,11 ＠＠
;;; xlib-vidmode.el --- XF86VidMode extension support.
-;; Copyright (C) 2004 by Free Software Foundation, Inc.
+;; Copyright (C) 2004,2005 by XWEM Org.
;; Author: Zajcev Evgeny <zevlg(a)yandex.ru>
;; Created: Fri Jan 16 18:39:44 MSK 2004
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-vidmode.el,v 1.4 2005/01/01 04:40:16 youngs Exp $
+;; X-CVS: $Id: xlib-vidmode.el,v 1.5 2005/04/04 19:55:29 lg Exp $
;; This file is part of XWEM.
1.7 +12 -27 XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xc.el
Index: xlib-xc.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xc.el,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -p -r1.6 -r1.7
--- xlib-xc.el 2005/01/01 04:40:16 1.6
+++ xlib-xc.el 2005/04/04 19:55:29 1.7
＠＠ -1,11 +1,11 ＠＠
;;; xlib-xc.el --- X Connection.
-;; Copyright (C) 2003 by Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005 by XWEM Org.
;; Author: Zajcev Evgeny <zevlg(a)yandex.ru>
;; Created: 18 October 2003
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-xc.el,v 1.6 2005/01/01 04:40:16 youngs Exp $
+;; X-CVS: $Id: xlib-xc.el,v 1.7 2005/04/04 19:55:29 lg Exp $
;; X-URL: http://lgarc.narod.ru/xwem/index.html
;; This file is part of XWEM.
＠＠ -323,7 +323,7 ＠＠ If XDPY is nil, then put into current bu
(save-excursion
(goto-char (point-min))
(insert (format "%d %S: " (nth 1 (current-time)) routine))
- (insert (apply 'format (mapcar (lambda (arg) (eval arg)) args)))
+ (insert (apply 'format (mapcar 'eval args)))
(insert "\n")))))
(defun X-Dpy-log-verbatim (xdpy arg)
＠＠ -351,23 +351,6 ＠＠ There is special mode when we are collec
;; increase request sequence number
(incf (X-Dpy-rseq-id xdpy)))
-;;; Event dispatcher
-(defun X-Dpy-default-events-dispatcher (xdpy win xev)
- "Default events dispatcher."
- (X-Dpy-log xdpy 'x-event "Get event: %S, for win: %S" '(X-Event-name xev)
- '(if (X-Win-p win) (X-Win-id win) win))
-
- (when (X-Win-p win)
- ;; First run display handlers
- (when (X-Dpy-event-handlers xdpy)
- (X-Dpy-EventHandler-runall xdpy xev))
-
- ;; Then run WIN specific handlers
- (when (X-Win-event-handlers win)
- ;; WIN has its own event handlers
- (X-Win-EventHandler-runall win xev))
- ))
-
;;; Sending section
(defmacro X-Force-char-num (maybechar)
"Force MAYBECHAR to be a number for XEmacs platform."
＠＠ -522,9 +505,9 ＠＠ TYPE-DESCRIPTION is list where car of it
(X-type-pack dpy (cadr xtd) val))
((eq xt 'listof)
- (mapconcat (lambda (el)
- (X-type-pack dpy (cadr xtd) el))
- val ""))
+ (apply 'concat (mapcar #'(lambda (el)
+ (X-type-pack dpy (cadr xtd) el))
+ val)))
((eq xt 'setof)
(funcall (cond ((= (cadr xtd) 1) 'int->string1)
＠＠ -533,9 +516,10 ＠＠ TYPE-DESCRIPTION is list where car of it
(apply 'Xmask-or val)))
((eq xt 'struct)
- (mapconcat (lambda (tt)
- (X-type-pack dpy (cdr tt) (funcall (car tt) val)))
- (cddr xt) ""))
+ (apply 'concat (mapcar #'(lambda (tt)
+ (X-type-pack dpy (cdr tt)
+ (funcall (car tt) val)))
+ (cddr xt))))
((eq xt 'or)
(setq xt (cdr xt))
＠＠ -588,8 +572,9 ＠＠ TYPE-DESCRIPTION is list where car of it
((eq xt 'struct)
(let ((rval (funcall (cadr xtd))))
- (mapc (lambda (tt)
- (eval `(setf (,(car tt) rval) (X-type-extract dpy ,(cdr tt)))))
+ (mapc #'(lambda (tt)
+ (eval `(setf (,(car tt) rval)
+ (X-type-extract dpy ,(cdr tt)))))
(cdr xtd))
rval)))))
1.2 +2 -2 XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xdpms.el
Index: xlib-xdpms.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xdpms.el,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -p -r1.1 -r1.2
--- xlib-xdpms.el 2004/03/22 17:36:25 1.1
+++ xlib-xdpms.el 2005/04/04 19:55:29 1.2
＠＠ -1,11 +1,11 ＠＠
;;; xlib-xdpms.el --- DPMS extension support.
-;; Copyright (C) 2003 by Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005 by XWEM Org.
;; Author: Zajcev Evgeny <zevlg(a)yandex.ru>
;; Created: Tue Nov 18 03:19:16 MSK 2003
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-xdpms.el,v 1.1 2004/03/22 17:36:25 lg Exp $
+;; X-CVS: $Id: xlib-xdpms.el,v 1.2 2005/04/04 19:55:29 lg Exp $
;; This file is part of XWEM.
1.7 +1 -1 XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xinerama.el
Index: xlib-xinerama.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xinerama.el,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -p -r1.6 -r1.7
--- xlib-xinerama.el 2005/01/01 04:40:16 1.6
+++ xlib-xinerama.el 2005/04/04 19:55:29 1.7
＠＠ -1,11 +1,11 ＠＠
;;; xlib-xinerama.el --- Xinerama support.
-;; Copyright (C) 2003 by Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005 by XWEM Org.
;; Author: Zajcev Evgeny <zevlg(a)yandex.ru>
;; Created: Mon Nov 17 19:23:03 MSK 2003
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-xinerama.el,v 1.6 2005/01/01 04:40:16 youngs Exp $
+;; X-CVS: $Id: xlib-xinerama.el,v 1.7 2005/04/04 19:55:29 lg Exp $
;; This file is part of XWEM.
1.9 +112 -147 XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xlib.el
Index: xlib-xlib.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xlib.el,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -p -r1.8 -r1.9
--- xlib-xlib.el 2005/01/01 04:40:17 1.8
+++ xlib-xlib.el 2005/04/04 19:55:30 1.9
＠＠ -1,11 +1,11 ＠＠
;;; xlib-xlib.el --- X library part of new xlib.
-;; Copyright (C) 2003 by Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005 by XWEM Org.
;; Author: Eric M. Ludlam <zappo(a)gnu.ai.mit.edu>
;; Zajcev Evgeny <zevlg(a)yandex.ru>
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-xlib.el,v 1.8 2005/01/01 04:40:17 youngs Exp $
+;; X-CVS: $Id: xlib-xlib.el,v 1.9 2005/04/04 19:55:30 lg Exp $
;; This file is part of XWEM.
＠＠ -32,92 +32,6 ＠＠
(require 'xlib-xr)
-(defvar xlib-opcodes-alist
- '((104 . XBell)
- (1 . XCreateWindow)
- (2 . XChangeWindowAttributes)
- (3 . XGetWindowAttributes)
- (12 . XConfigureWindow)
- (8 . XMapWindow)
- (10 . XUnmapWindow)
- (4 . XDestroyWindow)
- (5 . XDestroySubwindows)
- (15 . XQueryTree)
- (16 . XInternAtom)
- (17 . XGetAtomName)
- (18 . XChangeProperty)
- (20 . XGetWindowProperty)
- (78 . XCreateColormap)
- (79 . XFreeColormap)
- (84 . XAllocColor)
- (85 . XAllocNamedColor)
- (86 . XAllocColorCells)
- (89 . XStoreColors)
- (88 . XFreeColors)
- (91 . XQueryColors)
- (55 . XCreateGC)
- (56 . XChangeGC)
- (58 . XSetDashes)
- (59 . XSetClipRectangles)
- (60 . XFreeGC)
- (61 . XClearArea)
- (62 . XCopyArea)
- (63 . XCopyPlane)
- (64 . XDrawPoints)
- (65 . XDrawLines)
- (69 . XFillPoly)
- (66 . XDrawSegments)
- (67 . XDrawRectangles)
- (70 . XDrawRectangles)
- (68 . XDrawArcs)
- (71 . XDrawArcs)
- (74 . XDrawString)
- (76 . XImageString)
- (72 . XPutImage)
- (73 . XGetImage)
- (22 . XSetSelectionOwner)
- (23 . XGetSelectionOwner)
- (24 . XConvertSelection)
- (41 . XWarpPointer)
- (36 . XGrabServer)
- (37 . XUngrabServer)
- (38 . XQueryPointer)
- (31 . XGrabKeyboard)
- (32 . XUngrabKeyboard)
- (26 . XGrabPointer)
- (27 . XUngrabPointer)
- (28 . XGrabButton)
- (29 . XUngrabButton)
- (33 . XGrabKey)
- (34 . XUngrabKey)
- (43 . XGetInputFocus)
- (42 . XSetInputFocus)
- (7 . XReparentWindow)
- (14 . XGetGeometry)
- (40 . XTranslateCoordinates)
- (6 . XChangeSaveSet)
- (25 . XSendEvent)
- (44 . XQueryKeymap)
- (101 . XGetKeyboardMapping)
- (119 . XGetModifierMapping)
- (45 . XOpenFont)
- (47 . XQueryFont)
- (48 . XQueryTextExtents)
- (53 . XCreatePixmap)
- (54 . XFreePixmap)
- (93 . XCreateCursor)
- (94 . XCreateGlyphCursor)
- (95 . XFreeCursor)
- (96 . XRecolorCursor)
- (30 . XChangeActivePointerGrab)
- (98 . XQueryExtension)
- (107 . XSetScreenSaver)
- (108 . XGetScreenSaver)
- (113 . XKillClient)
- (115 . XForceScreenSaver))
- "Alist of X opcodes in form (OPCODE . FUNCTION).
-This is only informative variable.")
-
(defun XOpenDisplay (name &optional dispnum screen)
"Open an X connection to the display named NAME such as host:0.1.
Optionally you may pass DISPNUM - display number and SCREEN - screen number."
＠＠ -158,53 +72,55 ＠＠ Optionally you may pass DISPNUM - displa
;; Fill formats list
(setf (X-Dpy-formats xdpy)
- (mapcar (lambda (fmt)
- (make-X-ScreenFormat :depth (nth 0 fmt)
- :bits-per-pixel (nth 1 fmt)
- :scanline-pad (nth 2 fmt)))
+ (mapcar #'(lambda (fmt)
+ (make-X-ScreenFormat :depth (nth 0 fmt)
+ :bits-per-pixel (nth 1 fmt)
+ :scanline-pad (nth 2 fmt)))
(nth 15 X-info)))
;; Fill screens list
(setf (X-Dpy-screens xdpy)
- (mapcar (lambda (scr)
- (let (nscreen)
- (setq nscreen (make-X-Screen :root (X-Win-find-or-make xdpy (nth 0 scr))
- :colormap (make-X-Colormap :dpy xdpy :id (nth 1 scr))
- :white-pixel (make-X-Color :dpy xdpy :id (nth 2 scr))
- :black-pixel (make-X-Color :dpy xdpy :id (nth 3 scr))
- :root-event-mask (nth 4 scr)
- :width (nth 5 scr)
- :height (nth 6 scr)
- :mwidth (nth 7 scr)
- :mheight (nth 8 scr)
- :min-maps (nth 9 scr)
- :max-maps (nth 10 scr)
- :visualid (nth 11 scr)
- :backingstores (nth 12 scr)
- :save-unders (nth 13 scr)
- :root-depth (nth 14 scr)))
-
- (setf (X-Screen-depths nscreen)
- (mapcar (lambda (dpth)
- (make-X-Depth :depth (nth 0 dpth)
- :visuals (mapcar (lambda (vis)
- (make-X-Visual :id (nth 0 vis)
- :class (nth 1 vis)
- :bits-per-rgb (nth 2 vis)
- :cmap-entries (nth 3 vis)
- :red-mask (nth 4 vis)
- :green-mask (nth 6 vis)
- :blue-mask (nth 5 vis)))
- (nth 1 dpth))))
- (nth 15 scr)))
-
- ;; Create default GC
- (setf (X-Screen-default-gc nscreen)
- (XCreateGC xdpy (X-Screen-root nscreen)
- (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy)
- :foreground (X-Screen-white-pixel nscreen)
- :background (X-Screen-black-pixel nscreen))))
- nscreen))
+ (mapcar #'(lambda (scr)
+ (let (nscreen)
+ (setq nscreen
+ (make-X-Screen
+ :root (X-Win-find-or-make xdpy (nth 0 scr))
+ :colormap (make-X-Colormap :dpy xdpy :id (nth 1 scr))
+ :white-pixel (make-X-Color :dpy xdpy :id (nth 2 scr))
+ :black-pixel (make-X-Color :dpy xdpy :id (nth 3 scr))
+ :root-event-mask (nth 4 scr)
+ :width (nth 5 scr)
+ :height (nth 6 scr)
+ :mwidth (nth 7 scr)
+ :mheight (nth 8 scr)
+ :min-maps (nth 9 scr)
+ :max-maps (nth 10 scr)
+ :visualid (nth 11 scr)
+ :backingstores (nth 12 scr)
+ :save-unders (nth 13 scr)
+ :root-depth (nth 14 scr)))
+
+ (setf (X-Screen-depths nscreen)
+ (mapcar #'(lambda (dpth)
+ (make-X-Depth :depth (nth 0 dpth)
+ :visuals (mapcar #'(lambda (vis)
+ (make-X-Visual :id (nth 0 vis)
+ :class (nth 1 vis)
+ :bits-per-rgb (nth 2 vis)
+ :cmap-entries (nth 3 vis)
+ :red-mask (nth 4 vis)
+ :green-mask (nth 6 vis)
+ :blue-mask (nth 5 vis)))
+ (nth 1 dpth))))
+ (nth 15 scr)))
+
+ ;; Create default GC
+ (setf (X-Screen-default-gc nscreen)
+ (XCreateGC xdpy (X-Screen-root nscreen)
+ (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy)
+ :foreground (X-Screen-white-pixel nscreen)
+ :background (X-Screen-black-pixel nscreen))))
+ nscreen))
(nth 16 X-info)))
;; Alert user
＠＠ -350,9 +266,9 ＠＠ Optionally you may pass DISPNUM - displa
"On display XDPY for window WIN, set the background to PIXEL."
(XChangeWindowAttributes xdpy win (make-X-Attr :background-pixel pixel)))
-;(defun X-SetWindowForeground (xdpy win pixel)
-; "On display XDPY for window WIN, set the foreground to PIXEL."
-; (XChangeWindowAttributes xdpy win (make-X-Attr :foreground-pixel pixel)))
+(defun XSetWindowBackgroundPixmap (xdpy win pixmap)
+ "On display XDPY for window WIN, set the background pixmap to PIXMAP."
+ (XChangeWindowAttributes xdpy win (make-X-Attr :background-pixmap pixmap)))
(defun XSetWindowBorder (xdpy win pixel)
"On display XDPY for window WIN, set the border color to PIXEL."
＠＠ -645,8 +561,25 ＠＠ There are NElements."
data (cdr data)))))
(X-Dpy-send xdpy (X-Create-message ListOfFields))))
+(defun XDeleteProperty (xdpy win atom)
+ "On display XDPY for window WIN delete property denoted by ATOM."
+ (X-Win-p win 'XDeleteProperty)
+ (X-Atom-p atom 'XDeleteProperty)
+
+ (let ((ListOfFields
+ (list [1 19] ;opcode
+ [1 nil] ;unused
+ [2 3] ;length
+ [4 (X-Win-id win)] ;window
+ [4 (X-Atom-id atom)]))) ;atom
+ (X-Dpy-send xdpy (X-Create-message ListOfFields))))
+
;; These are Xlib convenience routines
-;;
+(defun XSetPropertyString (xdpy win atom string &optional mode)
+ "On display XDPY and window WIN set ATOM property to STRING."
+ (XChangeProperty xdpy win atom XA-string X-format-8 (or mode X-PropModeReplace)
+ string))
+
(defun XSetWMProtocols (xdpy win protocol_atoms)
"On display XDPY, set window's WIN protocols to PROTOCOL_ATOMS.
Convenience routine which calls `XChangeProperty'"
＠＠ -825,17 +758,45 ＠＠ BYTES_AFTER contains the exact amount of
:base-height (Xtruncate (nth 16 wmnh))
:gravity (Xtruncate (nth 17 wmnh))))))
+(defun XDecodeCompoundText (text)
+ "Decode compound TEXT, to native string.
+Evil hack, invent something better."
+ (if (string-match "\x1b\x25\x2f\x31\\(.\\)\\(.\\)\\(.*?\\)\x02" text)
+ (let ((len (+ (* (- (char-to-int (string-to-char (match-string 1 text))) 128) 128)
+ (- (char-to-int (string-to-char (match-string 2 text))) 128))))
+ (let ((seq-beg (match-beginning 0))
+ (data-beg (match-end 0))
+ (data-end (+ len (match-beginning 3)))
+ (cs (intern (match-string 3 text))))
+ (concat (substring text 0 seq-beg)
+ (if (fboundp 'decode-coding-string)
+ (decode-coding-string (substring text data-beg data-end) cs)
+ (substring text data-beg data-end))
+ (XDecodeCompoundText (substring text data-end)))))
+ text))
+
(defun XGetPropertyString (xdpy win atom)
"On display XDPY, and window XWIN, get string property of type ATOM."
- (let ((propdata (XGetWindowProperty xdpy win atom 0 1024 nil XA-string))
+ (let ((propdata (XGetWindowProperty xdpy win atom 0 1024))
+ (tdata nil)
(retstring ""))
- (when propdata
- (setq retstring (nth 2 propdata))
+ (when (and propdata (setq tdata (nth 2 propdata)))
+ (setq retstring tdata)
+ (when (= (car propdata)
+ (X-Atom-id (XInternAtom xdpy "COMPOUND_TEXT")))
+ ;; Adjust RETSTRING in case of COMPOUND_TEXT
+ (setq retstring (XDecodeCompoundText retstring)))
+
(when (> (nth 1 propdata) 0.0)
- (setq propdata (XGetWindowProperty xdpy win atom
- 1024 (nth 0 propdata) nil XA-string))
- (when propdata
- (setq retstring (concat retstring (nth 2 propdata))))))
+ (setq propdata
+ (XGetWindowProperty xdpy win atom
+ 1024 (nth 0 propdata)))
+ (when (and propdata (setq tdata (nth 2 propdata)))
+ (if (= (car propdata)
+ (X-Atom-id (XInternAtom xdpy "COMPOUND_TEXT")))
+ (setq retstring
+ (concat retstring (XDecodeCompoundText tdata)))
+ (setq retstring (concat retstring tdata))))))
retstring))
(defun XGetWMName (xdpy win)
＠＠ -1167,8 +1128,9 ＠＠ PLANES if you don't know what it's for."
[4 (X-Colormap-id cmap)] ;Colormap
[4 planes])) ;plane mask
(msg (concat (X-Create-message ListOfFields)
- (X-Generate-message-for-list colors
- (lambda (col) (int->string4 (X-Color-id col)))))))
+ (X-Generate-message-for-list
+ colors
+ #'(lambda (col) (int->string4 (X-Color-id col)))))))
(X-Dpy-send xdpy msg)
;; NOTE:
＠＠ -1191,7 +1153,9 ＠＠ PLANES if you don't know what it's for."
[4 (X-Colormap-id cmap)] ;COLORMAP
))
(msg (concat (X-Create-message ListOfFields)
- (X-Generate-message-for-list color-ids (lambda (colid) (int->string4 colid)))))
+ (X-Generate-message-for-list
+ color-ids
+ #'(lambda (colid) (int->string4 colid)))))
(ReceiveFields
(list [1 success]
nil
＠＠ -1254,7 +1218,7 ＠＠ I.e. update GC's info on server."
(X-Dpy-p xdpy 'XSetDashes)
(X-Gc-p gc 'XSetDashes)
- (let* ((dstr (mapconcat (lambda (d) (int->string1 d)) dashes ""))
+ (let* ((dstr (apply 'concat (mapcar 'int->string1 dashes)))
(ListOfFields
(list [1 58] ;opcode
[1 nil] ;unused
＠＠ -1534,7 +1498,7 ＠＠ args (DISPLAY D GC X Y WIDTH HEIGHT ANGL
;; Check len, must be < 255
(when (or (and len (>= len 255))
(>= (length str) 255))
- (signal 'overflow-error (list str (or len (length str)))))
+ (setq str (substring str 0 254)))
(let* ((slen (if len len (length str))) ;make len optional
(ListOfFields
＠＠ -2279,7 +2243,8 ＠＠ Evil hack, do not use this function."
[2 (+ 2 (X-padlen (concat string string)))] ;length
[4 (X-Font-id font)]))
(msg (concat (X-Create-message ListOfFields)
- (mapconcat (lambda (c) (string ?\0 c)) string "")
+ (apply 'concat
+ (mapcar #'(lambda (c) (string ?\0 c)) string))
(when (> (% (length string) 2) 0) (make-string 2 ?\0))
))
(ReceiveFields
1.7 +7 -6 XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xpm.el
Index: xlib-xpm.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xpm.el,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -p -r1.6 -r1.7
--- xlib-xpm.el 2005/01/01 04:40:17 1.6
+++ xlib-xpm.el 2005/04/04 19:55:30 1.7
＠＠ -1,11 +1,11 ＠＠
;;; xlib-xpm.el --- XPM library for Xlib.
-;; Copyright (C) 2003 by Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005 by XWEM Org.
;; Author: Zajcev Evgeny <zevlg(a)yandex.ru>
;; Created: Fri Nov 28 01:28:18 MSK 2003
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-xpm.el,v 1.6 2005/01/01 04:40:17 youngs Exp $
+;; X-CVS: $Id: xlib-xpm.el,v 1.7 2005/04/04 19:55:30 lg Exp $
;; This file is part of XWEM.
＠＠ -278,11 +278,12 ＠＠ Return data for `X-XYPixmap' format."
(setq xpm-index (1+ xpm-index)))
- (setq data (mapvector (lambda (row)
- (X-formatpad xdpy depth
- (mapconcat (lambda (col)
- (X-formatint xdpy depth col))
- row "")))
+ (setq data (mapvector #'(lambda (row)
+ (X-formatpad xdpy depth
+ (apply 'concat
+ (mapcar #'(lambda (col)
+ (X-formatint xdpy depth col))
+ row))))
xpm))
;; XXX
(setq ximg (XCreateImage xdpy nil depth X-ZPixmap 0 data
1.10 +844 -740 XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xr.el
Index: xlib-xr.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xr.el,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -p -r1.9 -r1.10
--- xlib-xr.el 2005/01/01 04:40:17 1.9
+++ xlib-xr.el 2005/04/04 19:55:30 1.10
＠＠ -1,11 +1,11 ＠＠
;;; xlib-xr.el --- X receive part.
-;; Copyright (C) 2003 by Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005 by XWEM Org.
;; Author: Eric M. Ludlam <zappo(a)gnu.ai.mit.edu>
-;; Zajcev Evgeny <zevlg(a)yandex.ru>
+;; Zajcev Evgeny <zevlg(a)yandex.ru>
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-xr.el,v 1.9 2005/01/01 04:40:17 youngs Exp $
+;; X-CVS: $Id: xlib-xr.el,v 1.10 2005/04/04 19:55:30 lg Exp $
;; This file is part of XWEM.
＠＠ -58,11 +58,11 ＠＠
"Take list LST and turn it into a vector.
This makes random access of its fields much faster."
(let ((nv (make-vector (length lst) nil))
- (cnt 0))
+ (cnt 0))
(while lst
(aset nv cnt (if (and (car lst) (listp (car lst)))
- (XVectorizeList (car lst))
- (car lst)))
+ (XVectorizeList (car lst))
+ (car lst)))
(setq cnt (1+ cnt))
(setq lst (cdr lst)))
nv))
＠＠ -72,24 +72,24 ＠＠ This makes random access of its fields m
NOTE: * Core event are less than 35, but extensions may generate greater.
* Eight bit is syntetic bit.")
-(defvar X-EventsList (make-vector X-Event-LASTEvent nil)
+(defvar X-EventsList (make-vector X-Event-LASTEvent ["Unknown" nil 0 0])
"List of event descriptions.")
(defstruct (X-Event (:predicate X-Event-isevent-p))
- dpy ; display
- type ; type of event
- synth-p ; non-nil if event came from SendEvent request
- evdata ; binary event represetation
- evinfo ; parsed variant of evdata
+ dpy ; display
+ type ; type of event
+ synth-p ; non-nil if event came from SendEvent request
+ evdata ; binary event represetation
+ evinfo ; parsed variant of evdata
- list ;for use in X-Generate-message
- properties ; User defined plist
+ list ;for use in X-Generate-message
+ properties ; User defined plist
)
(defsubst X-Event-put-property (xev prop val)
"Put property PROP with value VAL in XEV's properties list."
(setf (X-Event-properties xev)
- (plist-put (X-Event-properties xev) prop val)))
+ (plist-put (X-Event-properties xev) prop val)))
(defsubst X-Event-get-property (xev prop)
"Get property PROP from XEV's properties list."
＠＠ -103,7 +103,7 ＠＠ NOTE: * Core event are less than 35, but
"Return non-nil if EV is X-Event."
(let ((isev (X-Event-isevent-p ev)))
(if (and (not isev) sig)
- (signal 'wrong-type-argument (list sig 'X-Event-p ev))
+ (signal 'wrong-type-argument (list sig 'X-Event-p ev))
isev)))
(defsubst X-Event-detail (xev)
＠＠ -115,11 +115,17 ＠＠ NOTE: * Core event are less than 35, but
(nth 1 (X-Event-evinfo xev)))
(defsubst X-Event-win (xev)
- "Return window for which EV generated.
-Return nil if there no window for which event XEV is generated."
+ "Return window which is the subject of the XEV.
+Return nil if there no such window."
(let ((evd (aref (aref X-EventsList (X-Event-type xev)) 2)))
(and (numberp evd) (nth evd (X-Event-evinfo xev)))))
+(defsubst X-Event-win-event (xev)
+ "Return window for which XEV is generated.
+Return nil if there is no such window."
+ (let ((evd (aref (aref X-EventsList (X-Event-type xev)) 3)))
+ (and (numberp evd) (nth evd (X-Event-evinfo xev)))))
+
(defsubst X-Event-name (xev)
"Return symbolic XEV name."
(aref (aref X-EventsList (X-Event-type xev)) 0))
＠＠ -127,23 +133,26 ＠＠ Return nil if there no window for which
(defun X-Event-make (&rest args)
"Like `make-X-Event', but also fills list field automatically."
(let* ((xev (apply 'make-X-Event args))
- (evspec (aref (X-Event-type xev) X-EventsList)))
+ (evspec (aref (X-Event-type xev) X-EventsList)))
;; TODO: write me ..
))
-(defmacro X-Event-declare (type descr)
+(defmacro X-Event-declare (type ev-name ev-msg &optional win-idx event-win-idx)
"Only declare event of TYPE with DESCR in `X-EventsList'."
- `(aset X-EventsList ,type ,descr))
+ `(aset X-EventsList ,type
+ (vector ,ev-name (quote ,ev-msg) ,win-idx (or ,event-win-idx ,win-idx))))
-(defmacro X-Event-define (type name dnames descr)
+(defmacro X-Event-define (type name dnames ev-name ev-msg &optional win-idx event-win-idx)
"Define new event of TYPE, NAME and description of event DESCR."
(let ((offs 0)
- fsym forms)
- (push `(aset X-EventsList ,type ,descr) forms)
+ fsym forms)
+ (push `(aset X-EventsList ,type
+ (vector ,ev-name (quote ,ev-msg) ,win-idx (or ,event-win-idx ,win-idx)))
+ forms)
(while dnames
(when (car dnames)
- (setq fsym (intern (concat "X-Event-" name "-" (symbol-name (car dnames)))))
- (push `(defsubst* ,fsym (ev)
+ (setq fsym (intern (concat "X-Event-" name "-" (symbol-name (car dnames)))))
+ (push `(defsubst* ,fsym (ev)
(nth ,offs (X-Event-evinfo ev)))
forms))
(setq offs (1+ offs))
＠＠ -154,40 +163,40 ＠＠ Return nil if there no window for which
"Convert XEV type to symbolic name, return keyword."
(let ((evt (X-Event-type xev)))
(cond ((= evt X-KeyPress) :X-KeyPress)
- ((= evt X-KeyRelease) :X-KeyRelease)
- ((= evt X-ButtonPress) :X-ButtonPress)
- ((= evt X-ButtonRelease) :X-ButtonRelease)
- ((= evt X-MotionNotify) :X-MotionNotify)
- ((= evt X-EnterNotify) :X-EnterNotify)
- ((= evt X-LeaveNotify) :X-LeaveNotify)
- ((= evt X-FocusIn) :X-FocusIn)
- ((= evt X-FocusOut) :X-FocusOut)
- ((= evt X-KeymapNotify) :X-KeymapNotify)
- ((= evt X-Expose) :X-Expose)
- ((= evt X-GraphicsExpose) :X-GraphicsExpose)
- ((= evt X-NoExpose) :X-NoExpose)
- ((= evt X-VisibilityNotify) :X-VisibilityNotify)
- ((= evt X-CreateNotify) :X-CreateNotify)
- ((= evt X-DestroyNotify) :X-DestroyNotify)
- ((= evt X-UnmapNotify) :X-UnmapNotify)
- ((= evt X-MapNotify) :X-MapNotify)
- ((= evt X-MapRequest) :X-MapRequest)
- ((= evt X-ReparentNotify) :X-ReparentNotify)
- ((= evt X-ConfigureRequest) :X-ConfigureRequest)
- ((= evt X-ConfigureNotify) :X-ConfigureNotify)
- ((= evt X-GravityNotify) :X-GravityNotify)
- ((= evt X-ResizeRequest) :X-ResizeRequest)
- ((= evt X-CirculateNotify) :X-CirculateNotify)
- ((= evt X-CirculateRequest) :X-CirculateRequest)
- ((= evt X-PropertyNotify) :X-PropertyNotify)
- ((= evt X-SelectionClear) :X-SelectionClear)
- ((= evt X-SelectionRequest) :X-SelectionRequest)
- ((= evt X-SelectionNotify) :X-SelectionNotify)
- ((= evt X-ColormapNotify) :X-ColormapNotify)
- ((= evt X-ClientMessage) :X-ClientMessage)
- ((= evt X-MappingNotify) :X-MappingNotify)
+ ((= evt X-KeyRelease) :X-KeyRelease)
+ ((= evt X-ButtonPress) :X-ButtonPress)
+ ((= evt X-ButtonRelease) :X-ButtonRelease)
+ ((= evt X-MotionNotify) :X-MotionNotify)
+ ((= evt X-EnterNotify) :X-EnterNotify)
+ ((= evt X-LeaveNotify) :X-LeaveNotify)
+ ((= evt X-FocusIn) :X-FocusIn)
+ ((= evt X-FocusOut) :X-FocusOut)
+ ((= evt X-KeymapNotify) :X-KeymapNotify)
+ ((= evt X-Expose) :X-Expose)
+ ((= evt X-GraphicsExpose) :X-GraphicsExpose)
+ ((= evt X-NoExpose) :X-NoExpose)
+ ((= evt X-VisibilityNotify) :X-VisibilityNotify)
+ ((= evt X-CreateNotify) :X-CreateNotify)
+ ((= evt X-DestroyNotify) :X-DestroyNotify)
+ ((= evt X-UnmapNotify) :X-UnmapNotify)
+ ((= evt X-MapNotify) :X-MapNotify)
+ ((= evt X-MapRequest) :X-MapRequest)
+ ((= evt X-ReparentNotify) :X-ReparentNotify)
+ ((= evt X-ConfigureRequest) :X-ConfigureRequest)
+ ((= evt X-ConfigureNotify) :X-ConfigureNotify)
+ ((= evt X-GravityNotify) :X-GravityNotify)
+ ((= evt X-ResizeRequest) :X-ResizeRequest)
+ ((= evt X-CirculateNotify) :X-CirculateNotify)
+ ((= evt X-CirculateRequest) :X-CirculateRequest)
+ ((= evt X-PropertyNotify) :X-PropertyNotify)
+ ((= evt X-SelectionClear) :X-SelectionClear)
+ ((= evt X-SelectionRequest) :X-SelectionRequest)
+ ((= evt X-SelectionNotify) :X-SelectionNotify)
+ ((= evt X-ColormapNotify) :X-ColormapNotify)
+ ((= evt X-ClientMessage) :X-ClientMessage)
+ ((= evt X-MappingNotify) :X-MappingNotify)
- (t :X-Unknown))))
+ (t :X-Unknown))))
(defmacro X-Event-CASE (xev &rest body)
"Run event case. BODY in form (EVTYPE FORMS) (EVTYPE FORMS) ..
＠＠ -199,11 +208,11 ＠＠ EVTYPE is one of :X-KeyPress, :X-KeyRele
(defstruct X-EventHandler
priority
- evtypes-list ; list of event types
- handler ; function to call
- (active t) ; Non-nil mean event handler activated
+ evtypes-list ; list of event types
+ handler ; function to call
+ (active t) ; Non-nil mean event handler activated
- plist) ; user defined plist
+ plist) ; user defined plist
;;;###autoload
(defun X-EventHandler-add (evhlist handler &optional priority evtypes-list)
＠＠ -220,14 +229,14 ＠＠ Return new list, use it like `(setq lst
(setq priority 0))
(let ((xeh (make-X-EventHandler :priority priority
- :evtypes-list evtypes-list
- :handler handler)))
+ :evtypes-list evtypes-list
+ :handler handler)))
;; Insert new event handler and sort event handlers by priority.
(sort (cons xeh evhlist)
- (lambda (xeh1 xeh2)
- (> (X-EventHandler-priority xeh1)
- (X-EventHandler-priority xeh2))))))
+ #'(lambda (xeh1 xeh2)
+ (> (X-EventHandler-priority xeh1)
+ (X-EventHandler-priority xeh2))))))
;;;###autoload
(defun X-EventHandler-isset (evhlist handler &optional prioritiy evtypes-list)
＠＠ -237,9 +246,9 ＠＠ If event handler not found - nil will be
(let ((evhs evhlist))
;; Find appopriate handler
(while (and evhs
- (not (and (eq (X-EventHandler-handler (car evhs)) handler)
- (if prioritiy (equal prioritiy (X-EventHandler-priority (car evhs))) t)
- (if evtypes-list (equal evtypes-list (X-EventHandler-evtypes-list (car evhs))) t))))
+ (not (and (eq (X-EventHandler-handler (car evhs)) handler)
+ (if prioritiy (equal prioritiy (X-EventHandler-priority (car evhs))) t)
+ (if evtypes-list (equal evtypes-list (X-EventHandler-evtypes-list (car evhs))) t))))
(setq evhs (cdr evhs)))
(car evhs)))
＠＠ -272,15 +281,15 ＠＠ Return new list, use it like `(setq lst
(defun X-EventHandler-runall (evhlist xev)
"Run all event handlers in EVHLIST on XEV.
Signal `X-Events-stop' to stop events processing."
- (let ((evhs evhlist)) ; EVHS should be already sorted by priority
+ (let ((evhs evhlist)) ; EVHS should be already sorted by priority
(condition-case nil
- (while evhs
- ;; Check is there appopriate event handler to handle XEV event.
- (when (and (X-EventHandler-active (car evhs))
- (or (null (X-EventHandler-evtypes-list (car evhs)))
- (memq (X-Event-type xev) (X-EventHandler-evtypes-list (car evhs)))))
+ (while evhs
+ ;; Check is there appopriate event handler to handle XEV event.
+ (when (and (X-EventHandler-active (car evhs))
+ (or (null (X-EventHandler-evtypes-list (car evhs)))
+ (memq (X-Event-type xev) (X-EventHandler-evtypes-list (car evhs)))))
(funcall (X-EventHandler-handler (car evhs)) (X-Event-dpy xev) (X-Event-win xev) xev))
- (setq evhs (cdr evhs)))
+ (setq evhs (cdr evhs)))
(X-Events-stop nil))))
;;; X Events description.
＠＠ -288,393 +297,392 ＠＠ Signal `X-Events-stop' to stop events pr
;; TODO:
;; - Should be X-Dpy depended to support extensions derived events
(X-Event-define X-KeyPress "xkey" (keycode nil time root event child root-x root-y event-x event-y state same-screen)
- [ "KeyPress"
- ( [1 integerp] ; keycode
- [2 integerp] ; sequence
- [4 integerp] ; time
- [4 :X-Win] ; root
- [4 :X-Win] ; event
- [4 :X-Win] ; child
- [2 integerp] ; root_x
- [2 integerp] ; root_y
- [2 integerp] ; event_x
- [2 integerp] ; event_y
- [2 integerp] ; state
- [1 booleanp] ; same_screen
- [1 nil] )
- 4 ])
+ "KeyPress"
+ ([1 integerp] ; keycode
+ [2 integerp] ; sequence
+ [4 integerp] ; time
+ [4 :X-Win] ; root
+ [4 :X-Win] ; event (WIN-EVENT)
+ [4 :X-Win] ; child
+ [2 integerp] ; root_x
+ [2 integerp] ; root_y
+ [2 integerp] ; event_x
+ [2 integerp] ; event_y
+ [2 integerp] ; state
+ [1 booleanp] ; same_screen
+ [1 nil])
+ 4)
(X-Event-declare X-KeyRelease
- [ "KeyRelease"
- ( [1 integerp] ; keycode
- [2 integerp] ; sequence
- [4 integerp] ; time
- [4 :X-Win] ; root
- [4 :X-Win] ; event
- [4 :X-Win] ; child
- [2 integerp] ; root_x
- [2 integerp] ; root_y
- [2 integerp] ; event_x
- [2 integerp] ; event_y
- [2 integerp] ; state
- [1 booleanp] ; same_screen
- [1 nil] )
- 4 ])
+ "KeyRelease"
+ ([1 integerp] ; keycode
+ [2 integerp] ; sequence
+ [4 integerp] ; time
+ [4 :X-Win] ; root
+ [4 :X-Win] ; event
+ [4 :X-Win] ; child
+ [2 integerp] ; root_x
+ [2 integerp] ; root_y
+ [2 integerp] ; event_x
+ [2 integerp] ; event_y
+ [2 integerp] ; state
+ [1 booleanp] ; same_screen
+ [1 nil])
+ 4)
(X-Event-define X-ButtonPress "xbutton" (button nil time root event child root-x root-y event-x event-y state same-screen)
- [ "ButtonPress"
- ( [1 integerp] ; button
- [2 integerp] ; sequence
- [4 integerp] ; time
- [4 :X-Win] ; root
- [4 :X-Win] ; event
- [4 :X-Win] ; child
- [2 integerp] ; root_x
- [2 integerp] ; root_y
- [2 integerp] ; event_x
- [2 integerp] ; event_y
- [2 integerp] ; state
- [1 booleanp] ; same_screen
- [1 nil] )
- 4 ])
+ "ButtonPress"
+ ( [1 integerp] ; button
+ [2 integerp] ; sequence
+ [4 integerp] ; time
+ [4 :X-Win] ; root
+ [4 :X-Win] ; event
+ [4 :X-Win] ; child
+ [2 integerp] ; root_x
+ [2 integerp] ; root_y
+ [2 integerp] ; event_x
+ [2 integerp] ; event_y
+ [2 integerp] ; state
+ [1 booleanp] ; same_screen
+ [1 nil] )
+ 4)
(X-Event-declare X-ButtonRelease
- [ "ButtonRelease"
- ( [1 integerp] ; button
- [2 integerp] ; sequence
- [4 integerp] ; time
- [4 :X-Win] ; root
- [4 :X-Win] ; event
- [4 :X-Win] ; child
- [2 integerp] ; root_x
- [2 integerp] ; root_y
- [2 integerp] ; event_x
- [2 integerp] ; event_y
- [2 integerp] ; state
- [1 booleanp] ; same_screen
- [1 nil] )
- 4 ])
+ "ButtonRelease"
+ ( [1 integerp] ; button
+ [2 integerp] ; sequence
+ [4 integerp] ; time
+ [4 :X-Win] ; root
+ [4 :X-Win] ; event
+ [4 :X-Win] ; child
+ [2 integerp] ; root_x
+ [2 integerp] ; root_y
+ [2 integerp] ; event_x
+ [2 integerp] ; event_y
+ [2 integerp] ; state
+ [1 booleanp] ; same_screen
+ [1 nil] )
+ 4)
(X-Event-define X-MotionNotify "xmotion" (nil nil time root event child root-x root-y event-x event-y state same-screen)
- [ "MotionNotify"
- ( [1 integerp] ; detail
- [2 integerp] ; sequence
- [4 integerp] ; time
- [4 :X-Win] ; root
- [4 :X-Win] ; event
- [4 :X-Win] ; child
- [2 integerp] ; root_x
- [2 integerp] ; root_y
- [2 integerp] ; event_x
- [2 integerp] ; event_y
- [2 integerp] ; state
- [1 booleanp] ; same_screen
- [1 nil] )
- 4 ])
+ "MotionNotify"
+ ( [1 integerp] ; detail
+ [2 integerp] ; sequence
+ [4 integerp] ; time
+ [4 :X-Win] ; root
+ [4 :X-Win] ; event
+ [4 :X-Win] ; child
+ [2 integerp] ; root_x
+ [2 integerp] ; root_y
+ [2 integerp] ; event_x
+ [2 integerp] ; event_y
+ [2 integerp] ; state
+ [1 booleanp] ; same_screen
+ [1 nil] )
+ 4)
(X-Event-define X-EnterNotify "xcrossing" (nil nil time root event child root-x root-y event-x event-y state mode same-screen-focus)
- [ "EnterNotify"
- ( [1 integerp] ; detail
- [2 integerp] ; sequence
- [4 integerp] ; time
- [4 :X-Win] ; root
- [4 :X-Win] ; event
- [4 :X-Win] ; child
- [2 integerp] ; root_x
- [2 integerp] ; root_y
- [2 integerp] ; event_x
- [2 integerp] ; event_y
- [2 integerp] ; state
- [1 integerp] ; mode
- [1 integerp]) ; same-screen, focus
- 4 ])
+ "EnterNotify"
+ ( [1 integerp] ; detail
+ [2 integerp] ; sequence
+ [4 integerp] ; time
+ [4 :X-Win] ; root
+ [4 :X-Win] ; event
+ [4 :X-Win] ; child
+ [2 integerp] ; root_x
+ [2 integerp] ; root_y
+ [2 integerp] ; event_x
+ [2 integerp] ; event_y
+ [2 integerp] ; state
+ [1 integerp] ; mode
+ [1 integerp]) ; same-screen, focus
+ 4)
(X-Event-declare X-LeaveNotify
- [ "LeaveNotify"
- ( [1 integerp] ; detail
- [2 integerp] ; sequence
- [4 integerp] ; time
- [4 :X-Win] ; root
- [4 :X-Win] ; event
- [4 :X-Win] ; child
- [2 integerp] ; root_x
- [2 integerp] ; root_y
- [2 integerp] ; event_x
- [2 integerp] ; event_y
- [2 integerp] ; state
- [1 integerp] ; mode
- [1 integerp] ) ; same-screen, focus
- 4 ])
+ "LeaveNotify"
+ ( [1 integerp] ; detail
+ [2 integerp] ; sequence
+ [4 integerp] ; time
+ [4 :X-Win] ; root
+ [4 :X-Win] ; event
+ [4 :X-Win] ; child
+ [2 integerp] ; root_x
+ [2 integerp] ; root_y
+ [2 integerp] ; event_x
+ [2 integerp] ; event_y
+ [2 integerp] ; state
+ [1 integerp] ; mode
+ [1 integerp] ) ; same-screen, focus
+ 4)
(X-Event-define X-FocusIn "xfocus" (nil nil event mode)
- [ "FocusIn"
- ( [1 integerp] ; detail
- [2 integerp] ; sequence
- [4 :X-Win] ; event
- [1 integerp] ; mode
- [23 nil] )
- 2 ])
+ "FocusIn"
+ ( [1 integerp] ; detail
+ [2 integerp] ; sequence
+ [4 :X-Win] ; event
+ [1 integerp] ; mode
+ [23 nil] )
+ 2)
(X-Event-declare X-FocusOut
- [ "FocusOut"
- ( [1 integerp] ; detail
- [2 integerp] ; sequence
- [4 :X-Win] ; event
- [1 integerp] ; mode
- [23 nil] )
- 2 ])
+ "FocusOut"
+ ( [1 integerp] ; detail
+ [2 integerp] ; sequence
+ [4 :X-Win] ; event
+ [1 integerp] ; mode
+ [23 nil] )
+ 2)
;; TODO: X-KeymapNotify
(X-Event-define X-Expose "xexpose" (nil nil window x y width height count)
- [ "Expose"
- ( [1 integerp] ; detail
- [2 integerp] ; sequence
- [4 :X-Win] ; window
- [2 integerp] ; x
- [2 integerp] ; y
- [2 integerp] ; width
- [2 integerp] ; height
- [2 integerp] ; count
- [14 nil] )
- 2 ])
+ "Expose"
+ ( [1 integerp] ; detail
+ [2 integerp] ; sequence
+ [4 :X-Win] ; window
+ [2 integerp] ; x
+ [2 integerp] ; y
+ [2 integerp] ; width
+ [2 integerp] ; height
+ [2 integerp] ; count
+ [14 nil] )
+ 2)
(X-Event-define X-GraphicsExpose "xgraphicsexpose" (nil nil drawable x y width height minor-event count major-event)
- [ "GraphicsExpose"
- ([1 integerp]
- [2 integerp]
- [4 integerp] ; drawable
- [2 integerp] ; x
- [2 integerp] ; y
- [2 integerp] ; width
- [2 integerp] ; height
- [2 integerp] ; minorEvent
- [2 integerp] ; count
- [1 integerp] ; majorEvent
- [11 nil])
- 2 ])
+ "GraphicsExpose"
+ ([1 integerp]
+ [2 integerp]
+ [4 integerp] ; drawable
+ [2 integerp] ; x
+ [2 integerp] ; y
+ [2 integerp] ; width
+ [2 integerp] ; height
+ [2 integerp] ; minorEvent
+ [2 integerp] ; count
+ [1 integerp] ; majorEvent
+ [11 nil])
+ 2)
(X-Event-define X-NoExpose "xnoexpose" (nil nil drawable minor-event major-event)
- [ "NoExpose"
- ([1 integerp]
- [2 integerp]
- [4 integerp] ; drawable
- [2 integerp] ; minorEvent
- [1 integerp] ; majorEvent
- [21 nil])
- 2 ])
+ "NoExpose"
+ ([1 integerp]
+ [2 integerp]
+ [4 integerp] ; drawable
+ [2 integerp] ; minorEvent
+ [1 integerp] ; majorEvent
+ [21 nil])
+ 2)
(X-Event-define X-VisibilityNotify "xvisibility" (nil nil window state)
- [ "VisibilityNotify"
- ([1 integerp]
- [2 integerp]
- [4 :X-Win] ; window
- [1 integerp] ; state
- [23 nil])
- 2 ])
+ "VisibilityNotify"
+ ([1 integerp]
+ [2 integerp]
+ [4 :X-Win] ; window
+ [1 integerp] ; state
+ [23 nil])
+ 2)
(X-Event-define X-CreateNotify "xcreatewindow" (nil nil parent window x y width height border-width override)
- [ "CreateNotify"
- ([1 integerp] ; detail
- [2 integerp] ; sequence
- [4 :X-Win] ; parent window
- [4 :X-Win] ; window
- [2 integerp] ; x
- [2 integerp] ; y
- [2 integerp] ; width
- [2 integerp] ; height
- [2 integerp] ; border width
- [1 booleanp] ; override-redirect
- [9 nil])
- 2 ])
+ "CreateNotify"
+ ([1 integerp] ; detail
+ [2 integerp] ; sequence
+ [4 :X-Win] ; parent window
+ [4 :X-Win] ; window
+ [2 integerp] ; x
+ [2 integerp] ; y
+ [2 integerp] ; width
+ [2 integerp] ; height
+ [2 integerp] ; border width
+ [1 booleanp] ; override-redirect
+ [9 nil])
+ 2)
(X-Event-define X-DestroyNotify "xdestroywindow" (nil nil event window)
- [ "DestroyNotify"
- ( [1 integerp] ; detail
- [2 integerp] ; sequence
- [4 :X-Win] ; event window
- [4 :X-Win] ; window
- [20 nil])
- 3 ])
+ "DestroyNotify"
+ ( [1 integerp] ; detail
+ [2 integerp] ; sequence
+ [4 :X-Win] ; event window
+ [4 :X-Win] ; window
+ [20 nil])
+ 3 2)
(X-Event-define X-UnmapNotify "xunmap" (nil nil event window from-configure)
- [ "UnmapNotify"
- ( [1 integerp] ; detail
- [2 integerp] ; sequence
- [4 :X-Win] ; event
- [4 :X-Win] ; window
- [1 booleanp] ; fromconfigure
- [19 nil])
- 2 ])
+ "UnmapNotify"
+ ( [1 integerp] ; detail
+ [2 integerp] ; sequence
+ [4 :X-Win] ; event
+ [4 :X-Win] ; window
+ [1 booleanp] ; fromconfigure
+ [19 nil])
+ 3 2)
(X-Event-define X-MapNotify "xmap" (nil nil event window override)
- [ "MapNotify"
- ( [1 integerp] ; detail
- [2 integerp] ; sequence
- [4 :X-Win] ; event window
- [4 :X-Win] ; window
- [1 booleanp] ; override-redirect
- [19 nil])
- 2 ])
+ "MapNotify"
+ ( [1 integerp] ; detail
+ [2 integerp] ; sequence
+ [4 :X-Win] ; event window
+ [4 :X-Win] ; window
+ [1 booleanp] ; override-redirect
+ [19 nil])
+ 3 2)
(X-Event-define X-MapRequest "xmaprequest" (nil nil parent window)
- [ "MapRequest"
- ( [1 integerp] ; detail
- [2 integerp] ; sequence
- [4 :X-Win] ; parent window
- [4 :X-Win] ; window
- [20 nil])
- 2 ])
+ "MapRequest"
+ ( [1 integerp] ; detail
+ [2 integerp] ; sequence
+ [4 :X-Win] ; parent window
+ [4 :X-Win] ; window
+ [20 nil])
+ 3 2)
(X-Event-define X-ReparentNotify "xreparent" (nil nil event window parent x y override)
- [ "ReparentNotify"
- ( [1 integerp] ; detail
- [2 integerp] ; sequence
- [4 :X-Win] ; event
- [4 :X-Win] ; window
- [4 :X-Win] ; parent
- [2 integerp] ; x
- [2 integerp] ; y
- [1 integerp] ; override
- [11 nil])
- 2 ])
+ "ReparentNotify"
+ ( [1 integerp] ; detail
+ [2 integerp] ; sequence
+ [4 :X-Win] ; event
+ [4 :X-Win] ; window
+ [4 :X-Win] ; parent
+ [2 integerp] ; x
+ [2 integerp] ; y
+ [1 integerp] ; override
+ [11 nil])
+ 3 2)
(X-Event-define X-ConfigureNotify "xconfigure" (nil nil event window above-sibling x y width height border-width override-redirect)
- [ "ConfigureNotify"
- ( [1 integerp] ; detail
- [2 integerp] ; sequence
- [4 :X-Win] ; event
- [4 :X-Win] ; window
- [4 :X-Win] ; above-sibling
- [2 integerp] ; x
- [2 integerp] ; y
- [2 integerp] ; width
- [2 integerp] ; height
- [2 integerp] ; border-width
- [1 booleanp] ; override-redirect
- [5 nil] )
- 2 ])
+ "ConfigureNotify"
+ ( [1 integerp] ; detail
+ [2 integerp] ; sequence
+ [4 :X-Win] ; event
+ [4 :X-Win] ; window
+ [4 :X-Win] ; above-sibling
+ [2 integerp] ; x
+ [2 integerp] ; y
+ [2 integerp] ; width
+ [2 integerp] ; height
+ [2 integerp] ; border-width
+ [1 booleanp] ; override-redirect
+ [5 nil] )
+ 3 2)
(X-Event-define X-ConfigureRequest "xconfigurerequest" (stackmode nil parent window sibling x y width height border-width value-mask)
- [ "ConfigureRequest"
- ( [1 integerp] ; detail
- [2 integerp] ; sequence
- [4 :X-Win] ; parent window
- [4 :X-Win] ; window
- [4 :X-Win] ; sibling
- [2 integerp] ; x
- [2 integerp] ; y
- [2 integerp] ; width
- [2 integerp] ; height
- [2 integerp] ; border width
- [2 integerp] ; value mask
- [4 nil])
- 2 ])
+ "ConfigureRequest"
+ ( [1 integerp] ; detail
+ [2 integerp] ; sequence
+ [4 :X-Win] ; parent window
+ [4 :X-Win] ; window
+ [4 :X-Win] ; sibling
+ [2 integerp] ; x
+ [2 integerp] ; y
+ [2 integerp] ; width
+ [2 integerp] ; height
+ [2 integerp] ; border width
+ [2 integerp] ; value mask
+ [4 nil])
+ 3 2)
(X-Event-define X-GravityNotify "xgravity" (nil nil event window x y)
- [ "GravityNotify"
- ([1 integerp]
- [2 integerp]
- [4 :X-Win] ; event window
- [4 :X-Win] ; window
- [2 integerp] ; x
- [2 integerp] ; y
- [16 nil])
- 2 ])
+ "GravityNotify"
+ ([1 integerp]
+ [2 integerp]
+ [4 :X-Win] ; event window
+ [4 :X-Win] ; window
+ [2 integerp] ; x
+ [2 integerp] ; y
+ [16 nil])
+ 3 2)
(X-Event-define X-ResizeRequest "xresizerequest" (nil nil window width height)
- [ "ResizeRequest"
- ( [1 integerp] ; detail
- [2 integerp] ; sequence
- [4 :X-Win] ; window
- [2 integerp] ; width
- [2 integerp] ; height
- [20 nil] )
- 2 ])
+ "ResizeRequest"
+ ( [1 integerp] ; detail
+ [2 integerp] ; sequence
+ [4 :X-Win] ; window
+ [2 integerp] ; width
+ [2 integerp] ; height
+ [20 nil] )
+ 2)
(X-Event-define X-CirculateNotify "xcirculate" (nil nil event window parent place)
- [ "CirculateNotify"
- ([1 integerp]
- [2 integerp]
- [4 :X-Win] ; event window
- [4 :X-Win] ; window
- [4 :X-Win] ; parent
- [1 integerp] ; place
- [15 nil])
- 2 ])
+ "CirculateNotify"
+ ([1 integerp]
+ [2 integerp]
+ [4 :X-Win] ; event window
+ [4 :X-Win] ; window
+ [4 :X-Win] ; parent
+ [1 integerp] ; place
+ [15 nil])
+ 3 2)
;; The event field in the xcirculate record is really the parent when this
;; is used as a CirculateRequest instead of a CircluateNotify
(X-Event-declare X-CirculateRequest
- [ "CirculateRequest"
- ([1 integerp]
- [2 integerp]
- [4 :X-Win] ; event window
- [4 :X-Win] ; window
- [4 :X-Win] ; parent
- [1 integerp] ; place
- [15 nil])
- 2 ])
+ "CirculateRequest"
+ ([1 integerp]
+ [2 integerp]
+ [4 :X-Win] ; event window
+ [4 :X-Win] ; window
+ [4 :X-Win] ; parent
+ [1 integerp] ; place
+ [15 nil])
+ 3 2)
(X-Event-define X-PropertyNotify "xproperty" (nil nil window atom time state)
- [ "PropertyNotify"
- ( [1 integerp]
- [2 integerp]
- [4 :X-Win] ; window
- [4 :X-Atom] ; atom
- [4 integerp] ; time
- [1 integerp] ; state
- [15 nil]
- ) 2 ])
+ "PropertyNotify"
+ ( [1 integerp]
+ [2 integerp]
+ [4 :X-Win] ; window
+ [4 :X-Atom] ; atom
+ [4 integerp] ; time
+ [1 integerp] ; state
+ [15 nil])
+ 2)
(X-Event-define X-SelectionClear "xselectionclear" (nil nil time window atom)
- [ "SelectionClear"
- ([1 integerp]
- [2 integerp]
- [4 integerp] ; time
- [4 :X-Win] ; window
- [4 :X-Atom] ; atom
- [16 nil])
- 3 ])
+ "SelectionClear"
+ ([1 integerp]
+ [2 integerp]
+ [4 integerp] ; time
+ [4 :X-Win] ; window
+ [4 :X-Atom] ; atom
+ [16 nil])
+ 3)
(X-Event-define X-SelectionRequest "xselectionrequest" (nil nil time owner requestor selection target property)
- [ "SelectionRequest"
- ([1 integerp]
- [2 integerp]
- [4 integerp] ; time
- [4 :X-Win] ; owner
- [4 :X-Win] ; requestor
- [4 :X-Atom] ; selection atom
- [4 :X-Atom] ; target atom
- [4 :X-Atom] ; property atom
- [4 nil])
- 4 ])
+ "SelectionRequest"
+ ([1 integerp]
+ [2 integerp]
+ [4 integerp] ; time
+ [4 :X-Win] ; owner
+ [4 :X-Win] ; requestor
+ [4 :X-Atom] ; selection atom
+ [4 :X-Atom] ; target atom
+ [4 :X-Atom] ; property atom
+ [4 nil])
+ 4)
(X-Event-define X-SelectionNotify "xselection" (nil nil time requestor selection target property)
- [ "SelectionNotify"
- ([1 integerp]
- [2 integerp]
- [4 integerp] ; time
- [4 :X-Win] ; requestor
- [4 :X-Atom] ; selection atom
- [4 :X-Atom] ; target atom
- [4 :X-Atom] ; property atom
- [8 nil])
- 3 ])
+ "SelectionNotify"
+ ([1 integerp]
+ [2 integerp]
+ [4 integerp] ; time
+ [4 :X-Win] ; requestor
+ [4 :X-Atom] ; selection atom
+ [4 :X-Atom] ; target atom
+ [4 :X-Atom] ; property atom
+ [8 nil])
+ 3)
(X-Event-define X-ColormapNotify "xcolormap" (nil nil window colormap new state)
- [ "ColormapNotify"
- ([1 integerp] ; detail
- [2 integerp] ; sequence
- [4 :X-Win] ; window
- [4 integerp] ; colormap
- [1 booleanp] ; new
- [1 booleanp] ; state
- [18 nil])
- 2 ])
+ "ColormapNotify"
+ ([1 integerp] ; detail
+ [2 integerp] ; sequence
+ [4 :X-Win] ; window
+ [4 integerp] ; colormap
+ [1 booleanp] ; new
+ [1 booleanp] ; state
+ [18 nil])
+ 2)
(X-Event-define X-ClientMessage "xclient" (nil window atom msg)
- [ "ClientMessage"
- ([1 length-1] ; format
- [2 integerp] ; sequence number
- [4 :X-Win] ; window
- [4 :X-Atom] ; atom
- ;; This reads in the correct number of integers of a type
- ;; specified by the format which is 8, 16, or 32.
- [(/ 20 (/ length-1 8)) ( [ (/ length-1 8) integerp ] ) ] )
- 1 ])
+ "ClientMessage"
+ ([1 length-1] ; format
+ [2 integerp] ; sequence number
+ [4 :X-Win] ; window
+ [4 :X-Atom] ; atom
+ ;; This reads in the correct number of integers of a type
+ ;; specified by the format which is 8, 16, or 32.
+ [(/ 20 (/ length-1 8)) ( [ (/ length-1 8) integerp ] ) ] )
+ 1)
(X-Event-define X-MappingNotify "xmapping" (nil nil request first-keycode count)
- [ "MappingNotify"
- ([1 integerp]
- [2 integerp]
- [1 integerp] ; request
- [1 integerp] ; firstKeyCode
- [1 integerp] ; count
- [25 nil])
- nil ])
+ "MappingNotify"
+ ([1 integerp]
+ [2 integerp]
+ [1 integerp] ; request
+ [1 integerp] ; firstKeyCode
+ [1 integerp] ; count
+ [25 nil]))
;; error event
(X-Event-define 0 "xerror" (code nil resourceid min-op maj-op)
- ["XError"
- ([1 integerp] ; err code
- [2 integerp] ; sequence
- [4 integerp] ; id
- [2 integerp] ; minor opcode
- [1 integerp] ; major opcode
- [21 nil])])
-
+ "XError"
+ ([1 integerp] ; err code
+ [2 integerp] ; sequence
+ [4 integerp] ; id
+ [2 integerp] ; minor opcode
+ [1 integerp] ; major opcode
+ [21 nil]))
+
;;; All receive message types will exclude the first byte which IDs it.
;;
;; a symbol gets 'set, functions such as integerp mean turn it into that,
＠＠ -685,74 +693,74 ＠＠ Signal `X-Events-stop' to stop events pr
(defconst X-connect-response
(list [1 success]
- (list [1 length-1] ; fail message len
- [2 integerp] ; major version
- [2 integerp] ; minor version
- [2 length-2] ; pad length
- [length-1 stringp] ; error conditions
- [(X-mod-4 length-1) nil] ; padding
- )
- (list [1 nil] ; successful list (this is unused)
- [2 integerp] ; major version
- [2 integerp] ; minor version
- [2 length-1] ; len additional data (pad)
- [4 integerp] ; release number
- [4 integerp] ; resource id base
- [4 integerp] ; resource id mask
- [4 integerp] ; motion buffer size
- [2 length-2] ; vendor length
- [2 integerp] ; max request len
- [1 length-4] ; number of screens
- [1 length-3] ; number of formats in pix list
- [1 integerp] ; image byte order
- [1 integerp] ; bitmap byte order
- [1 integerp] ; bitmap format scanline thingy
- [1 integerp] ; bitmap format scanline pad
- [1 integerp] ; min keycode
- [1 integerp] ; max keycode
- [4 nil] ; unused
- [length-2 stringp] ; the vendor
- [(X-mod-4 length-2) nil] ; padding
- [length-3 ; sublist of formats
- ( [1 integerp] ; depth
- [1 integerp] ; bits/pixel
- [1 integerp] ; scanline-pad
- [5 nil] ) ] ; padding
- [length-4
- ( [4 integerp] ; root window
- [4 integerp] ; colormap
- [4 integerp] ; white-pixel
- [4 integerp] ; black-pixel
- [4 integerp] ; event-flags
- [2 integerp] ; screen-width
- [2 integerp] ; screen-height
- [2 integerp] ; milimeters width
- [2 integerp] ; milimeters height
- [2 integerp] ; min-installed-maps
- [2 integerp] ; max installed maps
- [4 integerp] ; visualid
- [1 integerp] ; backingstores
- [1 booleanp] ; save-unders
- [1 integerp] ; root depth
- [1 length-1] ; # depths in depth
- [length-1 ; list of depths
- ( [1 integerp] ; depth
- [1 nil]
- [2 length-1] ; # visual types
- [4 nil]
- [length-1 ; the visuals
- ( [4 integerp] ; visual id
- [1 integerp] ; class
- [1 integerp] ; bits/rgb value
- [2 integerp] ; colormap entities
- [4 integerp] ; red mask
- [4 integerp] ; green mask
- [4 integerp] ; blue mask
- [4 nil])
- ] )
- ] )
- ] )
- )
+ (list [1 length-1] ; fail message len
+ [2 integerp] ; major version
+ [2 integerp] ; minor version
+ [2 length-2] ; pad length
+ [length-1 stringp] ; error conditions
+ [(X-mod-4 length-1) nil] ; padding
+ )
+ (list [1 nil] ; successful list (this is unused)
+ [2 integerp] ; major version
+ [2 integerp] ; minor version
+ [2 length-1] ; len additional data (pad)
+ [4 integerp] ; release number
+ [4 integerp] ; resource id base
+ [4 integerp] ; resource id mask
+ [4 integerp] ; motion buffer size
+ [2 length-2] ; vendor length
+ [2 integerp] ; max request len
+ [1 length-4] ; number of screens
+ [1 length-3] ; number of formats in pix list
+ [1 integerp] ; image byte order
+ [1 integerp] ; bitmap byte order
+ [1 integerp] ; bitmap format scanline thingy
+ [1 integerp] ; bitmap format scanline pad
+ [1 integerp] ; min keycode
+ [1 integerp] ; max keycode
+ [4 nil] ; unused
+ [length-2 stringp] ; the vendor
+ [(X-mod-4 length-2) nil] ; padding
+ [length-3 ; sublist of formats
+ ( [1 integerp] ; depth
+ [1 integerp] ; bits/pixel
+ [1 integerp] ; scanline-pad
+ [5 nil] ) ] ; padding
+ [length-4
+ ( [4 integerp] ; root window
+ [4 integerp] ; colormap
+ [4 integerp] ; white-pixel
+ [4 integerp] ; black-pixel
+ [4 integerp] ; event-flags
+ [2 integerp] ; screen-width
+ [2 integerp] ; screen-height
+ [2 integerp] ; milimeters width
+ [2 integerp] ; milimeters height
+ [2 integerp] ; min-installed-maps
+ [2 integerp] ; max installed maps
+ [4 integerp] ; visualid
+ [1 integerp] ; backingstores
+ [1 booleanp] ; save-unders
+ [1 integerp] ; root depth
+ [1 length-1] ; # depths in depth
+ [length-1 ; list of depths
+ ( [1 integerp] ; depth
+ [1 nil]
+ [2 length-1] ; # visual types
+ [4 nil]
+ [length-1 ; the visuals
+ ( [4 integerp] ; visual id
+ [1 integerp] ; class
+ [1 integerp] ; bits/rgb value
+ [2 integerp] ; colormap entities
+ [4 integerp] ; red mask
+ [4 integerp] ; green mask
+ [4 integerp] ; blue mask
+ [4 nil])
+ ] )
+ ] )
+ ] )
+ )
"Connection response structure.")
(defun X-invalidate-cl-struct (cl-x)
＠＠ -767,7 +775,7 ＠＠ NOTE: works only if CL-X is vector."
;;; Protecting macros
(defmacro X-Dpy-read-excursion (xdpy &rest forms)
"Execute FORMS in reading mode."
- `(let ((gc-cons-threshold most-positive-fixnum)) ; inhibit GC'ing
+ `(let ((gc-cons-threshold most-positive-fixnum)) ; inhibit GC'ing
(incf (X-Dpy-readings ,xdpy))
(prog1
(condition-case err
＠＠ -779,17 +787,12 ＠＠ NOTE: works only if CL-X is vector."
(defun X-Dpy-send-read (xdpy s rf)
"Send S to display XDPY and receive answer according to receive fields RF."
- (let (reqid)
- ;; Remember request id
- (setq reqid (X-Dpy-rseq-id xdpy))
-
- ;; Flush output buffer
- (X-Dpy-send xdpy s)
- (X-Dpy-send-flush xdpy)
-
+ (let ((reqid (X-Dpy-rseq-id xdpy))) ; Remember request id
(X-Dpy-read-excursion xdpy
- (X-Dpy-parse-message rf reqid xdpy)
- )))
+ ;; Flush output buffer
+ (X-Dpy-send xdpy s)
+ (X-Dpy-send-flush xdpy)
+ (X-Dpy-parse-message rf reqid xdpy))))
;;;###autoload
(defvar X-default-timeout 60
＠＠ -804,14 +807,14 ＠＠ NOTE: works only if CL-X is vector."
(while (< (length (X-Dpy-message-buffer xdpy)) num)
(when (null (accept-process-output (X-Dpy-proc xdpy)
(or to-secs X-default-timeout) (or to-msecs 0)))
- ;; Timeouted
- (error "X: Timeout while reading from server.")))
+ ;; Timeouted
+ (error "X: Timeout while reading from server.")))
(setq rstr (substring (X-Dpy-message-buffer xdpy) 0 num)) ; save bytes to string
;; Update message-buffer
(setf (X-Dpy-message-buffer xdpy)
- (substring (X-Dpy-message-buffer xdpy) num))
+ (substring (X-Dpy-message-buffer xdpy) num))
rstr))
;; These are defined so we can use them recursivly below
＠＠ -855,227 +858,320 ＠＠ A variable-length string can occur like
(X-Dpy-p xdpy 'X-Dpy-parse-message)
- (let ((rlist nil)
- (reverse-me t)
- (length-1 (if (boundp 'length-1) length-1 nil))
- (length-2 (if (boundp 'length-2) length-2 nil))
- (length-3 (if (boundp 'length-3) length-3 nil))
- (length-4 (if (boundp 'length-4) length-4 nil)) )
+ (let ((inhibit-quit t) ; so C-g will not desync
+ (rlist nil)
+ (reverse-me t)
+ (length-1 (if (boundp 'length-1) length-1 nil))
+ (length-2 (if (boundp 'length-2) length-2 nil))
+ (length-3 (if (boundp 'length-3) length-3 nil))
+ (length-4 (if (boundp 'length-4) length-4 nil)) )
(while (and message-s (listp message-s))
(let* ((tvec (car message-s))
- (tlen (aref tvec 0))
- (tval1 (aref tvec 1))
- (tval (if (and (listp tval1)
- (member (car tval1) '(or if cond))) ;XXX
- (eval tval1)
- tval1))
- (result (unless (and tval (listp tval))
- ;; Do not grab bytes for sub-lists
- (if (or (symbolp tlen) (listp tlen))
- (X-Dpy-grab-bytes xdpy (eval tlen))
- (X-Dpy-grab-bytes xdpy tlen)))))
-
- ;; We need to put in code to represent sizes sometimes,
- ;; this will get that size.
- (when (or (listp tlen) (symbolp tlen))
- (setq tlen (eval tlen)))
-
- ;; Check for use of an argument.
- (when (equal tval 'arg)
- (setq tval (car arglist))
- (setq arglist (cdr arglist)))
-
- ;; If the val is a list, and it is an if statement, then
- ;; we want to evaluate it to get the real tval type.
- (when (and (listp tval)
- (member (car tval) '(if or make-list)))
- (setq tval (eval tval)))
-
- (cond
- ;; boolean success stories.
- ((equal tval 'success)
- (let ((sublst
- (cond ((= (aref result 0) 1)
- ;; success condition
- (setq result t)
- (X-Dpy-parse-message (car (cdr (cdr message-s))) req-id xdpy arglist))
-
- (t
- ;; Here is event or error arrived, process
- ;; errors in time or store event in events
- ;; queue.
- (catch 'processed
-
- (condition-case xerr
- (X-Dpy-parse-event xdpy (Xforcenum (aref result 0)))
- (X-Error
- ;; Here is if error's sequence numbers matches
- ;; with last request sequence, then end response
- ;; evaluating.
- (X-Dpy-log xdpy 'x-error "Get ERROR seq: %d, rseq-id: %d"
- '(X-Event-seq (cadr xerr)) 'req-id)
- (when (= (X-Event-seq (cadr xerr)) (logand req-id 65535))
- (throw 'processed (setq result nil)))))
-
- ;; Repeat processing XXX excluding t or nil
- (let ((pmsg (X-Dpy-parse-message message-s req-id xdpy arglist)))
- (setq result (car pmsg))
- (cdr pmsg))))
- )))
- (setq rlist (cons result sublst)))
-
- (setq message-s nil)
- (setq reverse-me nil))
-
- ;; numberp means natural number, not safe!
- ((eq tval 'numberp)
- (setq rlist (cons (funcall (if (<= tlen 2)
- 'string2->number
- 'string4->number) result)
- rlist)))
-
- ;; integerp means tac onto end of list as an int
- ((eq tval 'integerp)
- (if (<= tlen 2)
- (setq rlist (cons (string->int result) rlist))
- (setq rlist (cons (string4->int result) rlist))))
-
- ;; stringp means tac onto end of list as string (verbatim)
- ((eq tval 'stringp)
- (setq rlist (cons result rlist)))
-
- ;; booleans don't really exist, but turn a 0 into nil, and 1 into t
- ((eq tval 'booleanp)
- (setq rlist (cons (if (= 0 (string->int result)) nil t) rlist)))
-
- ;; TODO: maybe add card8, card16, card32, int8, int16, int32,
- ;; string8, string16, etc?
-
- ;; Special forms
- ((eq tval :X-Rect)
- (setq tlen (/ tlen 8))
- (while (> tlen 0)
- (setq rlist (cons (make-X-Rect :x (string->int (substring result 0 2))
- :y (string->int (substring result 2 4))
- :width (string->int (substring result 4 6))
- :height (string->int (substring result 6 8)))
- rlist))
- (setq result (substring result 8))
- (setq tlen (1- tlen))))
-
- ((eq tval :X-Win)
- (setq tlen (/ tlen 4))
- (while (> tlen 0)
- (setq rlist (cons (X-Win-find-or-make xdpy (string4->int result))
- rlist))
- (setq result (substring result 4))
- (setq tlen (1- tlen))))
-
- ((eq tval :X-Atom)
- (setq tlen (/ tlen 4))
- (while (> tlen 0)
- (setq rlist (cons (X-Atom-find-or-make xdpy (string4->int result))
- rlist))
- (setq result (substring result 4))
- (setq tlen (1- tlen))))
-
- ;; if it is a list, then we need to recursivly call ourselvs X
- ;; times on it.
- ((and tval (listp tval))
- ;; WARNING: subparts cannot use args. ;(
- (let ((sublst nil))
- (while (> tlen 0)
- (setq sublst (cons (X-Dpy-parse-message tval req-id xdpy arglist) sublst))
- (setq tlen (1- tlen)))
- ;; The sub-list of items is backwards: fix
- (setq rlist (cons (nreverse sublst) rlist))))
-
- ;; not a type, but some other symbol, then put it there!
- ;; if it is one of the lengththings, intify it.
- ((and tval (symbolp tval) (not (keywordp tval)))
- (if (string-match "length" (symbol-name tval))
- (set tval (string->int result))
- (set tval result)))
-
- ;; do nothing
- ((equal tval nil))
-
- ;; error case.
- (t
- (error "Error parsing X response!!!"))))
+ (tlen (aref tvec 0))
+ (tval1 (aref tvec 1))
+ (tval (if (and (listp tval1)
+ (member (car tval1) '(or if cond))) ;XXX
+ (eval tval1)
+ tval1))
+ (result (unless (and tval (listp tval))
+ ;; Do not grab bytes for sub-lists
+ (if (or (symbolp tlen) (listp tlen))
+ (X-Dpy-grab-bytes xdpy (eval tlen))
+ (X-Dpy-grab-bytes xdpy tlen)))))
+
+ ;; We need to put in code to represent sizes sometimes,
+ ;; this will get that size.
+ (when (or (listp tlen) (symbolp tlen))
+ (setq tlen (eval tlen)))
+
+ ;; Check for use of an argument.
+ (when (equal tval 'arg)
+ (setq tval (car arglist))
+ (setq arglist (cdr arglist)))
+
+ ;; If the val is a list, and it is an if statement, then
+ ;; we want to evaluate it to get the real tval type.
+ (when (and (listp tval)
+ (member (car tval) '(if or make-list)))
+ (setq tval (eval tval)))
+
+ (cond
+ ;; boolean success stories.
+ ((equal tval 'success)
+ (let ((sublst
+ (cond ((= (aref result 0) 1)
+ ;; success condition
+ (setq result t)
+ (X-Dpy-parse-message (car (cdr (cdr message-s)))
+ req-id xdpy arglist))
+
+ (t
+ ;; Here is event or error arrived, process
+ ;; errors in time or store event in events
+ ;; queue.
+ (X-Dpy-log xdpy 'x-event "!!: Inter Evaluating event ..")
+ (let ((xev (X-Dpy-parse-event
+ xdpy (Xforcenum (aref result 0))))
+ pmsg)
+ (prog1
+ (if (and (= (X-Event-type xev) 0)
+ (= (X-Event-seq xev)
+ (logand req-id 65535)))
+ ;; Error of current request
+ (setq result nil)
+
+ ;; Repeat processing XXX excluding t or nil
+ (X-Dpy-log xdpy 'x-event "!!: Reprocessing: %d bytes pending, msg=%S"
+ '(length (X-Dpy-message-buffer xdpy)) 'message-s)
+ (setq pmsg (X-Dpy-parse-message
+ message-s req-id xdpy arglist)
+ result (car pmsg))
+ (X-Dpy-log xdpy 'x-event "!!: Reprocessing done %d bytes pending."
+ '(length (X-Dpy-message-buffer xdpy)))
+ (cdr pmsg))
+ (X-Dpy-dispatch-event xev)))))))
+ (setq rlist (cons result sublst)))
+
+ (setq message-s nil)
+ (setq reverse-me nil))
+
+ ;; numberp means natural number, not safe!
+ ((eq tval 'numberp)
+ (setq rlist (cons (funcall (if (<= tlen 2)
+ 'string2->number
+ 'string4->number) result)
+ rlist)))
+
+ ;; integerp means tac onto end of list as an int
+ ((eq tval 'integerp)
+ (if (<= tlen 2)
+ (setq rlist (cons (string->int result) rlist))
+ (setq rlist (cons (string4->int result) rlist))))
+
+ ;; stringp means tac onto end of list as string (verbatim)
+ ((eq tval 'stringp)
+ (setq rlist (cons result rlist)))
+
+ ;; booleans don't really exist, but turn a 0 into nil, and 1 into t
+ ((eq tval 'booleanp)
+ (setq rlist (cons (if (= 0 (string->int result)) nil t) rlist)))
+
+ ;; TODO: maybe add card8, card16, card32, int8, int16, int32,
+ ;; string8, string16, etc?
+
+ ;; Special forms
+ ((eq tval :X-Rect)
+ (setq tlen (/ tlen 8))
+ (while (> tlen 0)
+ (setq rlist (cons (make-X-Rect :x (string->int (substring result 0 2))
+ :y (string->int (substring result 2 4))
+ :width (string->int (substring result 4 6))
+ :height (string->int (substring result 6 8)))
+ rlist))
+ (setq result (substring result 8))
+ (setq tlen (1- tlen))))
+
+ ((eq tval :X-Win)
+ (setq tlen (/ tlen 4))
+ (while (> tlen 0)
+ (setq rlist (cons (X-Win-find-or-make xdpy (string4->int result))
+ rlist))
+ (setq result (substring result 4))
+ (setq tlen (1- tlen))))
+
+ ((eq tval :X-Atom)
+ (setq tlen (/ tlen 4))
+ (while (> tlen 0)
+ (setq rlist (cons (X-Atom-find-or-make xdpy (string4->int result))
+ rlist))
+ (setq result (substring result 4))
+ (setq tlen (1- tlen))))
+
+ ;; if it is a list, then we need to recursivly call ourselvs X
+ ;; times on it.
+ ((and tval (listp tval))
+ ;; WARNING: subparts cannot use args. ;(
+ (let ((sublst nil))
+ (while (> tlen 0)
+ (setq sublst (cons (X-Dpy-parse-message tval req-id xdpy arglist) sublst))
+ (setq tlen (1- tlen)))
+ ;; The sub-list of items is backwards: fix
+ (setq rlist (cons (nreverse sublst) rlist))))
+
+ ;; not a type, but some other symbol, then put it there!
+ ;; if it is one of the lengththings, intify it.
+ ((and tval (symbolp tval) (not (keywordp tval)))
+ (if (string-match "length" (symbol-name tval))
+ (set tval (string->int result))
+ (set tval result)))
+
+ ;; do nothing
+ ((equal tval nil))
+
+ ;; error case.
+ (t
+ (error "Error parsing X response!!!"))))
(setq message-s (cdr message-s)))
;; Now that that is over, conditionally reverse the list.
(if reverse-me
- (nreverse rlist)
+ (nreverse rlist)
rlist)))
(defun X-Dpy-eval-error-or-event (xdpy)
"There data on XDPY, it is error or event."
(X-Dpy-read-excursion xdpy
(let* ((result (X-Dpy-grab-bytes xdpy 1))
- (evetype (Xforcenum (aref result 0))))
+ (evetype (Xforcenum (aref result 0))))
- (cond ((= evetype 1) ; reply, should not happen
- (X-Dpy-log xdpy 'x-error "Got unknown reply")
- nil)
-
- (t (X-Dpy-parse-event xdpy evetype))) ; error or event
+ (cond ((= evetype 1) ; reply, should not happen
+ (X-Dpy-log xdpy 'x-error "Got unknown reply, while expecting XEvent! CRITICAL!")
+ (error "Got unknown reply, while expecting XEvent!"))
+ ;; Below code is not quite correct. Because X exntensions
+ ;; that generates events may use values greater then
+ ;; X-MaxEvent.
+; ((>= evetype X-MaxEvent)
+; (X-Dpy-log xdpy 'x-error "Got XEvent id(%d) greater than X-MaxEvent! CRITICAL!"
+; 'evetype)
+; (error (format "Got X Event id(%d) greater than X-MaxEvent!" evetype)))
+ (t (X-Dpy-dispatch-event
+ (X-Dpy-parse-event xdpy evetype)))) ; error or event
)))
;; Events/Errors dispatchers
+(defvar xlib-opcodes-alist
+ '((104 . XBell)
+ (1 . XCreateWindow)
+ (2 . XChangeWindowAttributes)
+ (3 . XGetWindowAttributes)
+ (12 . XConfigureWindow)
+ (8 . XMapWindow)
+ (10 . XUnmapWindow)
+ (4 . XDestroyWindow)
+ (5 . XDestroySubwindows)
+ (15 . XQueryTree)
+ (16 . XInternAtom)
+ (17 . XGetAtomName)
+ (18 . XChangeProperty)
+ (20 . XGetWindowProperty)
+ (78 . XCreateColormap)
+ (79 . XFreeColormap)
+ (84 . XAllocColor)
+ (85 . XAllocNamedColor)
+ (86 . XAllocColorCells)
+ (89 . XStoreColors)
+ (88 . XFreeColors)
+ (91 . XQueryColors)
+ (55 . XCreateGC)
+ (56 . XChangeGC)
+ (58 . XSetDashes)
+ (59 . XSetClipRectangles)
+ (60 . XFreeGC)
+ (61 . XClearArea)
+ (62 . XCopyArea)
+ (63 . XCopyPlane)
+ (64 . XDrawPoints)
+ (65 . XDrawLines)
+ (69 . XFillPoly)
+ (66 . XDrawSegments)
+ (67 . XDrawRectangles)
+ (70 . XDrawRectangles)
+ (68 . XDrawArcs)
+ (71 . XDrawArcs)
+ (74 . XDrawString)
+ (76 . XImageString)
+ (72 . XPutImage)
+ (73 . XGetImage)
+ (22 . XSetSelectionOwner)
+ (23 . XGetSelectionOwner)
+ (24 . XConvertSelection)
+ (41 . XWarpPointer)
+ (36 . XGrabServer)
+ (37 . XUngrabServer)
+ (38 . XQueryPointer)
+ (31 . XGrabKeyboard)
+ (32 . XUngrabKeyboard)
+ (26 . XGrabPointer)
+ (27 . XUngrabPointer)
+ (28 . XGrabButton)
+ (29 . XUngrabButton)
+ (33 . XGrabKey)
+ (34 . XUngrabKey)
+ (43 . XGetInputFocus)
+ (42 . XSetInputFocus)
+ (7 . XReparentWindow)
+ (14 . XGetGeometry)
+ (40 . XTranslateCoordinates)
+ (6 . XChangeSaveSet)
+ (25 . XSendEvent)
+ (44 . XQueryKeymap)
+ (101 . XGetKeyboardMapping)
+ (119 . XGetModifierMapping)
+ (45 . XOpenFont)
+ (47 . XQueryFont)
+ (48 . XQueryTextExtents)
+ (53 . XCreatePixmap)
+ (54 . XFreePixmap)
+ (93 . XCreateCursor)
+ (94 . XCreateGlyphCursor)
+ (95 . XFreeCursor)
+ (96 . XRecolorCursor)
+ (30 . XChangeActivePointerGrab)
+ (98 . XQueryExtension)
+ (107 . XSetScreenSaver)
+ (108 . XGetScreenSaver)
+ (113 . XKillClient)
+ (115 . XForceScreenSaver))
+ "Alist of X opcodes in form (OPCODE . FUNCTION).
+This is only informative variable.")
+
+(defun X-Dpy-run-error-hooks (xdpy xev)
+ "Run XDPY's error hooks."
+ (when (X-Dpy-error-hooks xdpy)
+ (mapcar #'(lambda (fun)
+ (funcall fun xdpy xev))
+ (X-Dpy-error-hooks xdpy))))
+
(defun X-Dpy-error-dispatch (xev)
"Dispatch error event XEV."
- (let ((xdpy (X-Event-dpy xev)))
- (cond ((= (X-Event-xerror-code xev) 2)
- (X-Dpy-log xdpy 'x-error "Bad value %s sequence %d ops %d %d"
- '(Xmask-string (X-Event-xerror-resourceid xev))
- '(X-Event-seq xev)
- '(X-Event-xerror-maj-op xev)
- '(X-Event-xerror-min-op xev)))
-
- ((= (X-Event-xerror-code xev) 3)
- (X-Dpy-log xdpy 'x-error "Bad window %.0f sequence %d ops %d %d"
- '(X-Event-xerror-resourceid xev)
- '(X-Event-seq xev)
- '(X-Event-xerror-maj-op xev)
- '(X-Event-xerror-min-op xev)))
- ((= (X-Event-xerror-code xev) 9)
- (X-Dpy-log xdpy 'x-error "Bad Drawable %.0f sequence %d ops %d %d"
- '(X-Event-xerror-resourceid xev)
- '(X-Event-seq xev)
- '(X-Event-xerror-maj-op xev)
- '(X-Event-xerror-min-op xev)))
-
- ((= (X-Event-xerror-code xev) 11)
- (X-Dpy-log xdpy 'x-error "Alloc failure id=%.0f" '(X-Event-xerror-resourceid xev)))
-
- ((= (X-Event-xerror-code xev) 14)
- (X-Dpy-log xdpy 'x-error "Bad id %s sequence %d ops %d %d"
- '(Xmask-string (X-Event-xerror-resourceid xev))
- '(X-Event-seq xev)
- '(X-Event-xerror-maj-op xev)
- '(X-Event-xerror-min-op xev)))
-
- ((= (X-Event-xerror-code xev) 16)
- (X-Dpy-log xdpy 'x-error "Length error! sequence %d ops %d %d"
- '(X-Event-seq xev)
- '(X-Event-xerror-maj-op xev)
- '(X-Event-xerror-min-op xev)))
-
- (t
- (X-Dpy-log xdpy 'x-error "Got error event %d!!!" '(X-Event-xerror-code xev))))
+ (let* ((xdpy (X-Event-dpy xev))
+ (err (X-Event-xerror-code xev))
+ (badth (X-Event-xerror-resourceid xev))
+ (seq (X-Event-seq xev))
+ (maj (X-Event-xerror-maj-op xev))
+ (opfun (cdr (assq maj xlib-opcodes-alist)))
+ (min (X-Event-xerror-min-op xev))
+ (bstr (cond ((= err 1) "Request")
+ ((= err 2) "Value")
+ ((= err 3) "Window")
+ ((= err 4) "Pixmap")
+ ((= err 5) "Atom")
+ ((= err 6) "Cursor")
+ ((= err 7) "Font")
+ ((= err 8) "Match")
+ ((= err 9) "Drawable")
+ ((= err 10) "Access")
+ ((= err 11) "Alloc")
+ ((= err 12) "Color")
+ ((= err 13) "GC")
+ ((= err 14) "IDChoice")
+ ((= err 15) "Name")
+ ((= err 16) "Length")
+ ((= err 17) "Implementation")
+ ((= err 128) "FirstExtension")
+ ((= err 255) "LastExtension")
+ (t "Unknown"))))
+ (declare (special bstr))
+ (declare (special min))
+ (declare (special opfun))
+ (declare (special seq))
+ (declare (special badth))
+ (X-Dpy-log xdpy 'x-error "X-Error: Bad %s %f seq=%f:%d ops=%d:%d/%S"
+ 'bstr 'badth 'seq '(X-Dpy-rseq-id xdpy) 'maj 'min 'opfun)
;; Now run hooks if any
- (when (X-Dpy-error-hooks xdpy)
- (mapcar (lambda (fun)
- (funcall fun xdpy xev))
- (X-Dpy-error-hooks xdpy)))
+ (X-Dpy-run-error-hooks xdpy xev)))
- ;; Finnally signal an error.
- (error 'X-Error xev)
- ))
-
;;; Some usefull macroses (NOT USED)
(defmacro X-Generic-enqueue (obj queue)
"Enqueue object QBJ into setf'able QUEUE."
＠＠ -1094,55 +1190,63 ＠＠ A variable-length string can occur like
obj))
;;; Events queue support
+(defun X-Dpy-default-events-dispatcher (xdpy xev)
+ "Default events dispatcher."
+ (let ((win-ev (X-Event-win-event xev)))
+ (when (X-Win-p win-ev)
+ ;; First run display handlers
+ (when (X-Dpy-event-handlers xdpy)
+ (X-Dpy-EventHandler-runall xdpy xev))
+
+ ;; Then run WIN specific handlers
+ (when (X-Win-event-handlers win-ev)
+ ;; WIN has its own event handlers
+ (X-Win-EventHandler-runall win-ev xev)))))
+
(defun X-Dpy-event-dispatch (xev)
"Dispatch event XEV."
- (let ((win (X-Event-win xev))
- (xdpy (X-Event-dpy xev)))
-
- (X-Dpy-log xdpy 'x-event "Ready to dispatch event: %S for win %S"
- '(X-Event-name xev) '(if (X-Win-p (X-Event-win xev))
- (X-Win-id (X-Event-win xev))
- (X-Event-win xev)))
+ (let ((xdpy (X-Event-dpy xev)))
+ (X-Dpy-log xdpy 'x-event "Got X event: %S for win %S / %S"
+ '(X-Event-name xev)
+ '(if (X-Win-p (X-Event-win-event xev))
+ (X-Win-id (X-Event-win-event xev))
+ (X-Event-win-event xev))
+ '(if (X-Win-p (X-Event-win xev))
+ (X-Win-id (X-Event-win xev))
+ (X-Event-win xev)))
(when (X-Dpy-events-dispatcher xdpy)
- (funcall (X-Dpy-events-dispatcher xdpy) xdpy win xev))
- ))
+ (funcall (X-Dpy-events-dispatcher xdpy) xdpy xev))))
-(defsubst X-Dpy-event-enqueue (xdpy event)
+(defsubst X-Dpy-event-enqueue (event)
"Enqueue EVENT in XDPY's events queue."
(enqueue-eval-event 'X-Dpy-event-dispatch event))
+(defun X-Dpy-dispatch-event (xev)
+ "Dispatch X Event or error XEV."
+ (if (= (X-Event-type xev) 0)
+ (X-Dpy-error-dispatch xev)
+ (X-Dpy-event-enqueue xev)))
+
(defun X-Dpy-parse-event (xdpy evtype)
"On XDPY construct and enqueue event of EVTYPE type."
- (X-Dpy-log xdpy 'x-event "XLIB: Getting event ....")
-
;; TODO: what about X-Event-evdata?
;; (evdata (substring (X-Dpy-message-buffer xdpy) 0 31))
;; :evdata (concat (char-to-string (XCharacter type)) evdata)
(X-Dpy-read-excursion xdpy
(let* ((type evtype)
- (synth (= (logand X-SyntheticMask type) X-SyntheticMask))
- (type (if synth (- type X-SyntheticMask) type))
- (xev (make-X-Event :dpy xdpy :type type :synth-p synth))
- (evspec (aref X-EventsList type))
- (evin (X-Dpy-parse-message (or (and evspec (aref evspec 1)) (list [31 nil])) 0 xdpy)))
+ (synth (= (logand X-SyntheticMask type) X-SyntheticMask))
+ (type (if synth (- type X-SyntheticMask) type))
+ (xev (make-X-Event :dpy xdpy :type type :synth-p synth))
+ (evspec (aref X-EventsList type))
+ (evin (X-Dpy-parse-message (or (and evspec (aref evspec 1)) (list [31 nil])) 0 xdpy)))
(setf (X-Event-evinfo xev) evin)
-;;; Commented out, because causes some problems
-;; ;; Here is special case of DestroyNotify event. We dont want to
-;; ;; keep X-Win structure in xdpy's windows list, because there
-;; ;; will be no other way remove it, and someday XDPY's windows
-;; ;; list will became huge.
-;; (when (= (X-Event-type xev) X-DestroyNotify)
-;; (X-Dpy-log xdpy 'x-event "XDPY Removing window from XDPY: %S"
-;; '(X-Win-id (X-Event-xdestroywindow-window xev)))
-;; (X-Win-invalidate xdpy (X-Event-xdestroywindow-window xev)))
-
- (if (= (X-Event-type xev) 0)
- ;; Dispatch this error
- (X-Dpy-error-dispatch xev)
+ (X-Dpy-log xdpy 'x-event "XLIB: Get new event %d(%s) win=%S ...."
+ '(X-Event-type xev) '(X-Event-name xev)
+ '(and (X-Win-p (X-Event-win xev))
+ (X-Win-id (X-Event-win xev))))
- (X-Dpy-event-enqueue xdpy xev))
xev)))
;;; Function to call when there data in XDPY, but noone reading it.
＠＠ -1152,9 +1256,9 ＠＠ Try to guess what it is."
(X-Dpy-p xdpy 'X-Dpy-parse-message-guess)
;; If no-one reading now, mean than error or event arrived.
- (when (zerop (X-Dpy-readings xdpy))
- (while (> (length (X-Dpy-message-buffer xdpy)) 0)
- (X-Dpy-eval-error-or-event xdpy))))
+ (while (and (zerop (X-Dpy-readings xdpy))
+ (> (length (X-Dpy-message-buffer xdpy)) 0))
+ (X-Dpy-eval-error-or-event xdpy)))
(provide 'xlib-xr)
1.8 +277 -262 XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xrecord.el
Index: xlib-xrecord.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xrecord.el,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -p -r1.7 -r1.8
--- xlib-xrecord.el 2005/01/01 04:40:17 1.7
+++ xlib-xrecord.el 2005/04/04 19:55:30 1.8
＠＠ -1,11 +1,11 ＠＠
;;; xlib-xrecord.el --- RECORD extension for xlib.
-;; Copyright (C) 2003 by Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005 by XWEM Org.
;; Author: Zajcev Evgeny <zevlg(a)yandex.ru>
;; Created: 18 October 2003
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-xrecord.el,v 1.7 2005/01/01 04:40:17 youngs Exp $
+;; X-CVS: $Id: xlib-xrecord.el,v 1.8 2005/04/04 19:55:30 lg Exp $
;; This file is part of XWEM.
＠＠ -72,56 +72,91 ＠＠
(defconst X-XRecordEndOfData 5)
+;; Message generators
+(defsubst X-RecordRange8-message (xrr8)
+ "Return a string representing the record range8 XRR8."
+ (if (null xrr8)
+ (make-string 2 ?\x00)
+ (concat (int->string1 (car xrr8)) (int->string1 (cdr xrr8)))))
+
+(defsubst X-RecordRange16-message (xrr16)
+ "Return a string representing the record range16 XRR16."
+ (if (null xrr16)
+ (make-string 4 ?\x00)
+ (concat (int->string2 (car xrr16)) (int->string2 (cdr xrr16)))))
+
+(defsubst X-RecordExtrange-message (xer)
+ "Return a string representing the extrange XER."
+ (if (null xer)
+ (make-string 12 ?\x00)
+ (concat (X-RecordRange8-message (car xer)) (X-RecordRange16-message (cdr xer)))))
+
+(defsubst X-RecordRange-message (xrr)
+ "Return a string representing the record range XRR."
+ (X-Generate-simple-message 'X-RecordRange xrr))
+
+(defsubst X-RecordClientSpec-message (xrcs)
+ "Return a string representing the client spec XRCS."
+ (int->string4 xrcs))
+
(defstruct (X-RecordContext (:predicate X-RecordContext-isrc-p))
dpy id
- props) ; User defined plist
+ props) ; User defined plist
(defstruct (X-RecordExtrange (:predicate X-RecordExtrange-isrer-p))
- major ; X-RecordRange8
- minor ; X-RecordRange16
+ major ; X-RecordRange8
+ minor ; X-RecordRange16
;; List of extractors
(list '(((lambda (re)
- (X-RecordRange8-message (X-RecordExtrange-major re))) . 2)
- ((lambda (re)
- (X-RecordRange16-message (X-RecordExtrange-minor re))) . 4)))
+ (X-RecordRange8-message (X-RecordExtrange-major re))) . 2)
+ ((lambda (re)
+ (X-RecordRange16-message (X-RecordExtrange-minor re))) . 4)))
)
(defstruct (X-RecordRange (:predicate X-RecordRange-isrr-p))
- core-requests ; X-RecordRange8
- core-replies ; X-RecordRange8
- ext-requests ; X-RecordExtrange
- ext-replies ; X-RecordExtrange
- delivered-events ; X-RecordRange8
- device-events ; X-RecordRange8
- errors ; X-RecordRange8
- client-started ; BOOL
- client-died ; BOOL
+ core-requests ; X-RecordRange8
+ core-replies ; X-RecordRange8
+ ext-requests ; X-RecordExtrange
+ ext-replies ; X-RecordExtrange
+ delivered-events ; X-RecordRange8
+ device-events ; X-RecordRange8
+ errors ; X-RecordRange8
+ client-started ; BOOL
+ client-died ; BOOL
;; List of extractors
- (list '(((lambda (rr)
- (X-RecordRange8-message (X-RecordRange-core-requests rr))) . 2)
- ((lambda (rr)
- (X-RecordRange8-message (X-RecordRange-core-replies rr))) . 2)
- ((lambda (rr)
- (X-RecordExtrange-message (X-RecordRange-ext-requests rr))) . 6)
- ((lambda (rr)
- (X-RecordExtrange-message (X-RecordRange-ext-replies rr))) . 6)
- ((lambda (rr)
- (X-RecordRange8-message (X-RecordRange-delivered-events rr))) . 2)
- ((lambda (rr)
- (X-RecordRange8-message (X-RecordRange-device-events rr))) . 2)
- ((lambda (rr)
- (X-RecordRange8-message (X-RecordRange-errors rr))) . 2)
- (X-RecordRange-client-started . 1)
- (X-RecordRange-client-died . 1))))
+ (list (list
+ (cons #'(lambda (rr)
+ (X-RecordRange8-message (X-RecordRange-core-requests rr)))
+ 2)
+ (cons #'(lambda (rr)
+ (X-RecordRange8-message (X-RecordRange-core-replies rr)))
+ 2)
+ (cons #'(lambda (rr)
+ (X-RecordExtrange-message (X-RecordRange-ext-requests rr)))
+ 6)
+ (cons #'(lambda (rr)
+ (X-RecordExtrange-message (X-RecordRange-ext-replies rr)))
+ 6)
+ (cons #'(lambda (rr)
+ (X-RecordRange8-message (X-RecordRange-delivered-events rr)))
+ 2)
+ (cons #'(lambda (rr)
+ (X-RecordRange8-message (X-RecordRange-device-events rr)))
+ 2)
+ (cons #'(lambda (rr)
+ (X-RecordRange8-message (X-RecordRange-errors rr)))
+ 2)
+ (cons 'X-RecordRange-client-started 1)
+ (cons 'X-RecordRange-client-died 1))))
(defstruct (X-RecordClientInfo (:predicate X-RecordClientInfo-isrci-p))
- client-spec ; X-RecordClientSpec
- ranges) ; list of X-RecordRange
+ client-spec ; X-RecordClientSpec
+ ranges) ; list of X-RecordRange
(defstruct X-RecordState
- enabled ; BOOL
- datum-flags ; int
- client-infos ; list of X-RecordClientInfo
+ enabled ; BOOL
+ datum-flags ; int
+ client-infos ; list of X-RecordClientInfo
)
＠＠ -147,33 +182,6 ＠＠
(defsubst X-RecordClientInfo-p (xrci &optional sig)
(X-Generic-p 'X-RecordClientInfo 'X-RecordClientInfo-isrci-p xrci sig))
-;; Message generators
-(defsubst X-RecordRange8-message (xrr8)
- "Return a string representing the record range8 XRR8."
- (if (null xrr8)
- (make-string 2 ?\x00)
- (concat (int->string1 (car xrr8)) (int->string1 (cdr xrr8)))))
-
-(defsubst X-RecordRange16-message (xrr16)
- "Return a string representing the record range16 XRR16."
- (if (null xrr16)
- (make-string 4 ?\x00)
- (concat (int->string2 (car xrr16)) (int->string2 (cdr xrr16)))))
-
-(defsubst X-RecordExtrange-message (xer)
- "Return a string representing the extrange XER."
- (if (null xer)
- (make-string 12 ?\x00)
- (concat (X-RecordRange8-message (car xer)) (X-RecordRange16-message (cdr xer)))))
-
-(defsubst X-RecordRange-message (xrr)
- "Return a string representing the record range XRR."
- (X-Generate-simple-message 'X-RecordRange xrr))
-
-(defsubst X-RecordClientSpec-message (xrcs)
- "Return a string representing the client spec XRCS."
- (int->string4 xrcs))
-
;;; Functions
(defun X-XRecordQueryVersion (xdpy &optional major minor)
＠＠ -181,23 +189,23 ＠＠
(X-Dpy-p xdpy 'X-XRecordQueryVersion)
(let* ((xrec-ext (X-Dpy-get-extension xdpy "RECORD"))
- (ListOfFields
- (list (vector 1 (nth 4 xrec-ext)) ; opcode
- [1 X-XRecord-op-QueryVersion]
- [2 2] ;length
-
- [2 (or major X-XRecord-major)]
- [2 (or minor X-XRecord-minor)]))
- (msg (X-Create-message ListOfFields))
- (ReceiveFields
- (list [1 success] ;success field
- nil
- (list [1 nil] ;not used
- [2 integerp] ;sequence number
- [4 nil] ;length
- [2 integerp] ;major version
- [2 integerp] ;minor version
- [20 nil])))) ;pad
+ (ListOfFields
+ (list (vector 1 (nth 4 xrec-ext)) ; opcode
+ [1 X-XRecord-op-QueryVersion]
+ [2 2] ;length
+
+ [2 (or major X-XRecord-major)]
+ [2 (or minor X-XRecord-minor)]))
+ (msg (X-Create-message ListOfFields))
+ (ReceiveFields
+ (list [1 success] ;success field
+ nil
+ (list [1 nil] ;not used
+ [2 integerp] ;sequence number
+ [4 nil] ;length
+ [2 integerp] ;major version
+ [2 integerp] ;minor version
+ [20 nil])))) ;pad
(and (car xrec-ext)
(X-Dpy-send-read xdpy msg ReceiveFields))))
＠＠ -211,19 +219,19 ＠＠ RANGES is list of X-RecordRange."
(X-Dpy-p xdpy 'X-XRecordCreateContext)
(let* ((xrec-ext (X-Dpy-get-extension xdpy "RECORD" 'X-XRecordCreateContext))
- (ListOfFields
- (list (vector 1 (nth 4 xrec-ext)) ;opcode
- [1 X-XRecord-op-CreateContext]
- [2 (+ 5 (length clspecs) (* 6 (length ranges)))] ;length
-
- [4 (X-RecordContext-id rc)] ; context
- [1 elhead]
- [3 nil] ; not used
- [4 (length clspecs)]
- [4 (length ranges)]))
- (msg (concat (X-Create-message ListOfFields)
- (X-Generate-message-for-list clspecs 'X-RecordClientSpec-message)
- (X-Generate-message-for-list ranges 'X-RecordRange-message))))
+ (ListOfFields
+ (list (vector 1 (nth 4 xrec-ext)) ;opcode
+ [1 X-XRecord-op-CreateContext]
+ [2 (+ 5 (length clspecs) (* 6 (length ranges)))] ;length
+
+ [4 (X-RecordContext-id rc)] ; context
+ [1 elhead]
+ [3 nil] ; not used
+ [4 (length clspecs)]
+ [4 (length ranges)]))
+ (msg (concat (X-Create-message ListOfFields)
+ (X-Generate-message-for-list clspecs 'X-RecordClientSpec-message)
+ (X-Generate-message-for-list ranges 'X-RecordRange-message))))
(X-Dpy-send xdpy msg)
rc))
＠＠ -233,18 +241,18 ＠＠ RANGES is list of X-RecordRange."
(X-RecordContext-p rc 'X-XRecordRegisterClients)
(let* ((xrec-ext (X-Dpy-get-extension xdpy "RECORD" 'X-XRecordRegisterClients))
- (ListOfFields
- (list (vector 1 (nth 4 xrec-ext)) ; opcode
- [1 X-XRecord-op-RegisterClients]
- [2 (+ 5 (length clspecs) (* 6 (length ranges)))] ; length
- [4 (X-RecordContext-id rc)]
- [1 elhead]
- [3 nil] ; not used
- [4 (length clspecs)]
- [4 (length ranges)]))
- (msg (concat (X-Create-message ListOfFields)
- (X-Generate-message-for-list clspecs 'X-RecordClientSpec-message)
- (X-Generate-message-for-list ranges 'X-RecordRange-message))))
+ (ListOfFields
+ (list (vector 1 (nth 4 xrec-ext)) ; opcode
+ [1 X-XRecord-op-RegisterClients]
+ [2 (+ 5 (length clspecs) (* 6 (length ranges)))] ; length
+ [4 (X-RecordContext-id rc)]
+ [1 elhead]
+ [3 nil] ; not used
+ [4 (length clspecs)]
+ [4 (length ranges)]))
+ (msg (concat (X-Create-message ListOfFields)
+ (X-Generate-message-for-list clspecs 'X-RecordClientSpec-message)
+ (X-Generate-message-for-list ranges 'X-RecordRange-message))))
(X-Dpy-send xdpy msg)))
(defun X-XRecordUnregisterClients (xdpy rc clspecs)
＠＠ -253,14 +261,14 ＠＠ RANGES is list of X-RecordRange."
(X-RecordContext-p rc 'X-XRecordRegisterClients)
(let* ((xrec-ext (X-Dpy-get-extension xdpy "RECORD" 'X-XRecordRegisterClients))
- (ListOfFields
- (list (vector 1 (nth 4 xrec-ext)) ; opcode
- [1 X-XRecord-op-UnregisterClients]
- [2 (+ 3 (length clspecs))] ; length
- [4 (X-RecordContext-id rc)]
- [4 (length clspecs)]))
- (msg (concat (X-Create-message ListOfFields)
- (X-Generate-message-for-list clspecs 'X-RecordClientSpec-message))))
+ (ListOfFields
+ (list (vector 1 (nth 4 xrec-ext)) ; opcode
+ [1 X-XRecord-op-UnregisterClients]
+ [2 (+ 3 (length clspecs))] ; length
+ [4 (X-RecordContext-id rc)]
+ [4 (length clspecs)]))
+ (msg (concat (X-Create-message ListOfFields)
+ (X-Generate-message-for-list clspecs 'X-RecordClientSpec-message))))
(X-Dpy-send xdpy msg)))
(defun X-XRecordGetContext (xdpy rc)
＠＠ -269,52 +277,52 ＠＠ RANGES is list of X-RecordRange."
(X-RecordContext-p rc 'X-XRecordRegisterClients)
(let* ((xrec-ext (X-Dpy-get-extension xdpy "RECORD" 'X-XRecordGetContext))
- (ListOfFields
- (list (vector 1 (nth 4 xrec-ext)) ; opcode
- [1 X-XRecord-op-GetContext]
- [2 2] ; length
- [4 (X-RecordContext-id rc)])) ; context
- (msg (concat (X-Create-message ListOfFields)))
- (ReceiveFields
- (list [1 success] ;success field
- nil
- (list [1 integerp] ;enabled
- [2 integerp] ;sequence number
- [4 length-1] ;length
- [1 integerp] ;elhead
- [3 nil] ;not used
- [4 length-2] ;n, number of intercepted-clients
- [16 nil] ;not used
- [length-2 ([4 integerp]
- [4 length-3]
- [length-3
- ([1 integerp]
- [1 integerp]
-
- [1 integerp]
- [1 integerp]
-
- [1 integerp]
- [1 integerp]
- [2 integerp]
- [2 integerp]
-
- [1 integerp]
- [1 integerp]
- [2 integerp]
- [2 integerp]
-
- [1 integerp]
- [1 integerp]
-
- [1 integerp]
- [1 integerp]
-
- [1 integerp]
- [1 integerp]
-
- [1 booleanp]
- [1 booleanp])])]))))
+ (ListOfFields
+ (list (vector 1 (nth 4 xrec-ext)) ; opcode
+ [1 X-XRecord-op-GetContext]
+ [2 2] ; length
+ [4 (X-RecordContext-id rc)])) ; context
+ (msg (concat (X-Create-message ListOfFields)))
+ (ReceiveFields
+ (list [1 success] ;success field
+ nil
+ (list [1 integerp] ;enabled
+ [2 integerp] ;sequence number
+ [4 length-1] ;length
+ [1 integerp] ;elhead
+ [3 nil] ;not used
+ [4 length-2] ;n, number of intercepted-clients
+ [16 nil] ;not used
+ [length-2 ([4 integerp]
+ [4 length-3]
+ [length-3
+ ([1 integerp]
+ [1 integerp]
+
+ [1 integerp]
+ [1 integerp]
+
+ [1 integerp]
+ [1 integerp]
+ [2 integerp]
+ [2 integerp]
+
+ [1 integerp]
+ [1 integerp]
+ [2 integerp]
+ [2 integerp]
+
+ [1 integerp]
+ [1 integerp]
+
+ [1 integerp]
+ [1 integerp]
+
+ [1 integerp]
+ [1 integerp]
+
+ [1 booleanp]
+ [1 booleanp])])]))))
(X-Dpy-send-read xdpy msg ReceiveFields)))
; (X-log dpy "Get X-XRecordGetContext replay: %s\n" 'resp)
＠＠ -330,31 +338,31 ＠＠ by the recording client over the data co
(X-Dpy-p xdpy 'X-XRecordEnableContext)
(let* ((xrec-ext (X-Dpy-get-extension xdpy "RECORD" 'X-XRecordEnableContext))
- (ListOfFields
- (list (vector 1 (nth 4 xrec-ext)) ;opcode
- [1 X-XRecord-op-EnableContext]
- [2 2] ;length
- [4 (X-RecordContext-id rc)]))
- (msg (concat (X-Create-message ListOfFields)))
- (ReceiveFields
- (list [1 success] ;success field
- nil
- (list [1 integerp] ;category
- [2 integerp] ;sequence number
- [4 length-1] ;length
- [1 integerp] ;elhead
- [1 integerp] ;client-swapped
- [2 nil] ;not used
- [4 integerp] ;id-baes
- [4 integerp] ;server-time
- [4 integerp] ;recorded sequence number
- [8 nil] ;not used
- [(* length-1 4) stringp])))
- (rep (X-Dpy-send-read xdpy msg ReceiveFields)))
+ (ListOfFields
+ (list (vector 1 (nth 4 xrec-ext)) ;opcode
+ [1 X-XRecord-op-EnableContext]
+ [2 2] ;length
+ [4 (X-RecordContext-id rc)]))
+ (msg (concat (X-Create-message ListOfFields)))
+ (ReceiveFields
+ (list [1 success] ;success field
+ nil
+ (list [1 integerp] ;category
+ [2 integerp] ;sequence number
+ [4 length-1] ;length
+ [1 integerp] ;elhead
+ [1 integerp] ;client-swapped
+ [2 nil] ;not used
+ [4 integerp] ;id-baes
+ [4 integerp] ;server-time
+ [4 integerp] ;recorded sequence number
+ [8 nil] ;not used
+ [(* length-1 4) stringp])))
+ (rep (X-Dpy-send-read xdpy msg ReceiveFields)))
(X-Dpy-log xdpy 'x-record "X-XRecordEnableContext: rep=%S" 'rep)
(when (and (car rep)
- (= (nth 1 rep) X-XRecordStartOfData))
+ (= (nth 1 rep) X-XRecordStartOfData))
;; Set events guess parser and events dispatcher
(setf (X-Dpy-parse-guess-dispatcher xdpy) 'X-XRecord-parse-guess)
(setf (X-Dpy-events-dispatcher xdpy) 'X-XRecord-event-dispatcher))
＠＠ -366,13 +374,14 ＠＠ by the recording client over the data co
(X-RecordContext-p rc 'X-XRecordRegisterClients)
(let* ((xrec-ext (X-Dpy-get-extension xdpy "RECORD" 'X-XRecordGetContext))
- (ListOfFields
- (list (vector 1 (nth 4 xrec-ext)) ; opcode
- [1 X-XRecord-op-DisplayContext]
- [2 2] ; length
- [4 (X-RecordContext-id rc)])) ; context
- (msg (X-Create-message ListOfFields)))
- (X-Dpy-send xdpy msg)))
+ (ListOfFields
+ (list (vector 1 (nth 4 xrec-ext)) ; opcode
+ [1 X-XRecord-op-DisplayContext]
+ [2 2] ; length
+ [4 (X-RecordContext-id rc)])) ; context
+ (msg (X-Create-message ListOfFields)))
+ (X-Dpy-send xdpy msg))
+ (X-Dpy-log xdpy 'x-record "X-XRecordDisableContext: rc=%S" '(X-RecordContext-id rc)))
(defun X-XRecordFreeContext (xdpy rc)
"On display XDPY free record context RC."
＠＠ -380,12 +389,12 ＠＠ by the recording client over the data co
(X-RecordContext-p rc 'X-XRecordRegisterClients)
(let* ((xrec-ext (X-Dpy-get-extension xdpy "RECORD" 'X-XRecordGetContext))
- (ListOfFields
- (list (vector 1 (nth 4 xrec-ext)) ; opcode
- [1 X-XRecord-op-FreeContext]
- [2 2] ; length
- [4 (X-RecordContext-id rc)])) ; context
- (msg (X-Create-message ListOfFields)))
+ (ListOfFields
+ (list (vector 1 (nth 4 xrec-ext)) ; opcode
+ [1 X-XRecord-op-FreeContext]
+ [2 2] ; length
+ [4 (X-RecordContext-id rc)])) ; context
+ (msg (X-Create-message ListOfFields)))
(X-Dpy-send xdpy msg)))
＠＠ -398,73 +407,79 ＠＠ by the recording client over the data co
"Parse message received in data connection."
(X-Dpy-p xdpy 'X-XRecord-parse-guess)
- (when (zerop (X-Dpy-readings xdpy))
- (X-Dpy-read-excursion
- xdpy
- (while (> (length (X-Dpy-message-buffer xdpy)) 0)
- (let* ((msg (X-Dpy-parse-message (list [1 integerp] ; reply
- [1 integerp] ;category
- [2 integerp] ;sequence number
- [4 integerp] ;length
- [1 integerp] ;elhead
- [1 integerp] ;client-swapped
- [2 nil] ;not used
- [4 integerp] ;id-baes
- [4 integerp] ;server-time
- [4 integerp] ;recorded sequence number
- [8 nil]) ;not used
- 0 xdpy))
- (mcategory (nth 1 msg)) ; message categery
- (len (nth 3 msg))
- (elh (nth 4 msg))
- elh-value
- result)
-
- (while (> len 0)
- ;; There data
- (setq elh-value nil)
- (when (> elh 0)
- ;; there elhead
- (setq elh-value (X-Dpy-grab-bytes xdpy 4))
- (setq len (- len 4)))
-
- (setq result (Xforcenum (aref (X-Dpy-grab-bytes xdpy 1) 0)))
- (setq len (- len 1))
-
- (cond ((= mcategory X-XRecordFromServer)
- ;; Error, Event or Reply
- (cond ((= result 0)
- ;; Error, TODO
- (setq len 0)
- )
- ((= result 1)
- ;; Reply, TODO
- (setq len 0)
- )
-
- ;; Event
- (t ;(< result X-MaxEvent)
- ;; Valid event
- (let ((xev (X-Dpy-parse-event xdpy result)))
- ;; Put some interception info
- (X-Event-put-property xev 'XRecord-Category (nth 1 msg))
- (X-Event-put-property xev 'XRecord-Sequence (nth 2 msg))
- (X-Event-put-property xev 'XRecord-Elhead (nth 4 msg))
- (X-Event-put-property xev 'XRecord-Elhead-value elh-value)
- (X-Event-put-property xev 'XRecord-Swaped (nth 5 msg))
- (X-Event-put-property xev 'XRecord-Idbase (nth 6 msg))
- (X-Event-put-property xev 'XRecord-Servertime (nth 7 msg))
- (X-Event-put-property xev 'XRecord-RecSeq (nth 8 msg))
-
- (X-Dpy-log (X-Event-dpy xev) 'x-record "XRECORD EXTENSION: Get Event: %S, win=%S"
- '(X-Event-name xev) '(X-Win-id (X-Event-win xev)))
-
- (setq len (- len 31))))))
-
- ;; TODO: what about other categeries?
- ))
- )))
- ))
+ (while (and (zerop (X-Dpy-readings xdpy))
+ (> (length (X-Dpy-message-buffer xdpy)) 31))
+ (X-Dpy-read-excursion xdpy
+ (let* ((msg (X-Dpy-parse-message
+ (list [1 integerp] ; reply
+ [1 integerp] ;category
+ [2 integerp] ;sequence number
+ [4 integerp] ;length
+ [1 integerp] ;elhead
+ [1 integerp] ;client-swapped
+ [2 nil] ;not used
+ [4 integerp] ;id-baes
+ [4 integerp] ;server-time
+ [4 integerp] ;recorded sequence number
+ [8 nil]) ;not used
+ 0 xdpy))
+ (mcategory (nth 1 msg)) ; message categery
+ (len (* 4 (nth 3 msg)))
+ (elh (nth 4 msg))
+ elh-value
+ result)
+
+ (while (> len 0)
+ ;; There data
+ (setq elh-value nil)
+ (when (> elh 0)
+ ;; there elhead
+ (setq elh-value
+ (X-Dpy-parse-message (list [4 integerp]) 0 xdpy))
+ (setq len (- len 4)))
+
+ (setq result (Xforcenum (aref (X-Dpy-grab-bytes xdpy 1) 0)))
+ (setq len (- len 1))
+
+ (cond ((= mcategory X-XRecordFromServer)
+ ;; Error, Event or Reply
+ (cond ((or (= result 0)
+ (= result 1))
+ ;; Error or Reply .. just flush the data
+ (X-Dpy-grab-bytes xdpy len)
+ (setq len 0))
+
+ ;; Event
+ (t ;(< result X-MaxEvent)
+ ;; Valid event
+ (let ((xev (X-Dpy-parse-event xdpy result)))
+ (setq len (- len 31))
+
+ ;; Put some interception info
+ (X-Event-put-property xev 'XRecord-Category (nth 1 msg))
+ (X-Event-put-property xev 'XRecord-Sequence (nth 2 msg))
+ (X-Event-put-property xev 'XRecord-Elhead (nth 4 msg))
+ (X-Event-put-property xev 'XRecord-Elhead-value elh-value)
+ (X-Event-put-property xev 'XRecord-Swaped (nth 5 msg))
+ (X-Event-put-property xev 'XRecord-Idbase (nth 6 msg))
+ (X-Event-put-property xev 'XRecord-Servertime (nth 7 msg))
+ (X-Event-put-property xev 'XRecord-RecSeq (nth 8 msg))
+
+ (X-Dpy-log (X-Event-dpy xev) 'x-record "XRECORD EXTENSION: Get Event: %S(%S[%S]), win=%S"
+ '(X-Event-name xev) '(X-Event-detail xev)
+ '(int-to-char (truncate (car (xwem-kbd-xkcode->xksym (X-Event-detail xev)))))
+ '(X-Win-id (X-Event-win xev)))
+
+ ;; Add event to event queue
+ (setf (X-Dpy-evq xdpy)
+ (append (X-Dpy-evq xdpy) (list xev)))))))
+
+ (t
+ ;; Unsupported category
+ (X-Dpy-grab-bytes xdpy len)
+ (setq len 0)))
+ )))
+ ))
;;; Testing section:
1.6 +1 -1 XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xshape.el
Index: xlib-xshape.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xshape.el,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -p -r1.5 -r1.6
--- xlib-xshape.el 2005/01/01 04:40:17 1.5
+++ xlib-xshape.el 2005/04/04 19:55:30 1.6
＠＠ -1,11 +1,11 ＠＠
;;; xlib-xshape.el --- Shape extension support.
-;; Copyright (C) 2003 by Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005 by XWEM Org.
;; Author: Zajcev Evgeny <zevlg(a)yandex.ru>
;; Created: Mon Nov 17 19:23:03 MSK 2003
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-xshape.el,v 1.5 2005/01/01 04:40:17 youngs Exp $
+;; X-CVS: $Id: xlib-xshape.el,v 1.6 2005/04/04 19:55:30 lg Exp $
;; This file is part of XWEM.
1.5 +1 -1 XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xtest.el
Index: xlib-xtest.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xtest.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -p -r1.4 -r1.5
--- xlib-xtest.el 2005/01/01 04:40:17 1.4
+++ xlib-xtest.el 2005/04/04 19:55:31 1.5
＠＠ -1,11 +1,11 ＠＠
;;; xlib-xtest.el --- XTEST extension for xlib.
-;; Copyright (C) 2003 by Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005 by XWEM Org.
;; Author: Zajcev Evgeny <zevlg(a)yandex.ru>
;; Created: 18 October 2003
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-xtest.el,v 1.4 2005/01/01 04:40:17 youngs Exp $
+;; X-CVS: $Id: xlib-xtest.el,v 1.5 2005/04/04 19:55:31 lg Exp $
;; X-URL: http://lgarc.narod.ru/xwem/index.html
;; This file is part of XWEM.
1.9 +149 -130 XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xwin.el
Index: xlib-xwin.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xwin.el,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -p -r1.8 -r1.9
--- xlib-xwin.el 2005/01/01 04:40:17 1.8
+++ xlib-xwin.el 2005/04/04 19:55:31 1.9
＠＠ -1,11 +1,11 ＠＠
;;; xlib-xwin.el --- Core X structures.
-;; Copyright (C) 2003 by Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005 by XWEM Org.
;; Author: Zajcev Evgeny <zevlg(a)yandex.ru>
;; Created: 18 October 2003
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-xwin.el,v 1.8 2005/01/01 04:40:17 youngs Exp $
+;; X-CVS: $Id: xlib-xwin.el,v 1.9 2005/04/04 19:55:31 lg Exp $
;; X-URL: http://lgarc.narod.ru/xwem/index.html
;; This file is part of XWEM.
＠＠ -111,8 +111,8 ＠＠
(defun X-Rect-intersect-p (&rest xrects)
"Return non-nil if rectangles in XRECTS are intersects."
(while (and xrects
- (not (member t (mapcar (lambda (r)
- (X-Rect-internal-intersect-p (car xrects) r))
+ (not (member t (mapcar #'(lambda (r)
+ (X-Rect-internal-intersect-p (car xrects) r))
(cdr xrects)))))
(setq xrects (cdr xrects)))
＠＠ -209,8 +209,8 ＠＠ If SIG is given and ATOM is not atom str
(defsubst X-Atom-insert (xdpy atom)
"Insert ATOM in XDPY's atoms list, if not already there."
(pushnew atom (X-Dpy-atoms xdpy)
- :test (lambda (a1 a2)
- (= (X-Atom-id a1) (X-Atom-id a2)))))
+ :test #'(lambda (a1 a2)
+ (= (X-Atom-id a1) (X-Atom-id a2)))))
(defsubst X-Atom-find (xdpy aid)
"Find atom with id AID on X display XDPY."
＠＠ -312,7 +312,29 ＠＠ If SIG is given and ATOM is not atom str
(defconst XA-wm-class (make-X-Atom :id 67.0 :name "WM_CLASS") "Atom wm-class eoncoding.")
(defconst XA-wm-transient-for (make-X-Atom :id 68.0 :name "WM_TRANSIENT_FOR") "Atom wm-transient-for eoncoding.")
-;; Attributes operations
+
+;;; Common predicates
+(defsubst X-Win-p (win &optional sig)
+ "Return non-nil if WIN is X-Win structure.
+If SIG is given and WIN is not X-Win structure, SIG will
+be signaled."
+ (X-Generic-p 'X-Win 'X-Win-iswin-p win sig))
+
+(defsubst X-Pixmap-p (pixmap &optional sig)
+ "Return non-nil if PIXMAP is X-Pixmap structure.
+If SIG is given and PIXMAP is not X-Pixmap structure, SIG will be signaled."
+ (X-Generic-p 'X-Pixmap 'X-Pixmap-ispixmap-p pixmap sig))
+
+(defsubst X-Colormap-p (cmap &optional sig)
+ "Return non-nil if CMAP is X-Colormap structure.
+If SIG is given and CMAP is not X-Colormap structure, SIG will be signaled."
+ (X-Generic-p 'X-Colormap 'X-Colormap-iscmap-p cmap sig))
+
+(defsubst X-Cursor-p (cursor &optional sig)
+ (X-Generic-p 'X-Cursor 'X-Cursor-iscursor-p cursor sig))
+
+
+;;; Attributes operations
(defstruct (X-Attr (:predicate X-Attr-isattr-p))
;; any *-pixel is X-Color structure
dpy id
＠＠ -329,43 +351,50 ＠＠ If SIG is given and ATOM is not atom str
visualid
mapstate
;; List of extractors
- (list '(((lambda (attr)
- (if (X-Pixmap-p (X-Attr-background-pixmap attr))
- (X-Pixmap-id (X-Attr-background-pixmap attr))
- (X-Attr-background-pixmap attr))) . 4)
- ((lambda (attr)
- (if (X-Color-p (X-Attr-background-pixel attr))
- (X-Color-id (X-Attr-background-pixel attr))
- (X-Attr-background-pixel attr))) . 4)
- ((lambda (attr)
- (if (X-Pixmap-p (X-Attr-border-pixmap attr))
- (X-Pixmap-id (X-Attr-border-pixmap attr))
- (X-Attr-border-pixmap attr))) . 4)
- ((lambda (attr)
- (if (X-Color-p (X-Attr-border-pixel attr))
- (X-Color-id (X-Attr-border-pixel attr))
- (X-Attr-border-pixel attr))) . 4)
- (X-Attr-bit-gravity . 1)
- (X-Attr-win-gravity . 1)
- (X-Attr-backing-store . 1)
- (X-Attr-backing-planes . 4)
- ((lambda (attr)
- (if (X-Color-p (X-Attr-backing-pixel attr))
- (X-Color-id (X-Attr-backing-pixel attr))
- (X-Attr-backing-pixel attr))) . 4)
- (X-Attr-override-redirect . 1)
- (X-Attr-save-under . 1)
- (X-Attr-event-mask . 4)
- (X-Attr-do-not-propagate-mask . 4)
- ((lambda (attr)
- (if (X-Colormap-p (X-Attr-colormap attr))
- (X-Colormap-id (X-Attr-colormap attr))
- (X-Attr-colormap attr))) . 4)
- ((lambda (attr)
- (if (X-Cursor-p (X-Attr-cursor attr))
- (X-Cursor-id (X-Attr-cursor attr))
- (X-Attr-cursor attr))) . 4)
- )))
+ (list (list
+ (cons #'(lambda (attr)
+ (if (X-Pixmap-p (X-Attr-background-pixmap attr))
+ (X-Pixmap-id (X-Attr-background-pixmap attr))
+ (X-Attr-background-pixmap attr)))
+ 4)
+ (cons #'(lambda (attr)
+ (if (X-Color-p (X-Attr-background-pixel attr))
+ (X-Color-id (X-Attr-background-pixel attr))
+ (X-Attr-background-pixel attr)))
+ 4)
+ (cons #'(lambda (attr)
+ (if (X-Pixmap-p (X-Attr-border-pixmap attr))
+ (X-Pixmap-id (X-Attr-border-pixmap attr))
+ (X-Attr-border-pixmap attr)))
+ 4)
+ (cons #'(lambda (attr)
+ (if (X-Color-p (X-Attr-border-pixel attr))
+ (X-Color-id (X-Attr-border-pixel attr))
+ (X-Attr-border-pixel attr)))
+ 4)
+ (cons 'X-Attr-bit-gravity 1)
+ (cons 'X-Attr-win-gravity 1)
+ (cons 'X-Attr-backing-store 1)
+ (cons 'X-Attr-backing-planes 4)
+ (cons #'(lambda (attr)
+ (if (X-Color-p (X-Attr-backing-pixel attr))
+ (X-Color-id (X-Attr-backing-pixel attr))
+ (X-Attr-backing-pixel attr)))
+ 4)
+ (cons 'X-Attr-override-redirect 1)
+ (cons 'X-Attr-save-under 1)
+ (cons 'X-Attr-event-mask 4)
+ (cons 'X-Attr-do-not-propagate-mask 4)
+ (cons #'(lambda (attr)
+ (if (X-Colormap-p (X-Attr-colormap attr))
+ (X-Colormap-id (X-Attr-colormap attr))
+ (X-Attr-colormap attr)))
+ 4)
+ (cons #'(lambda (attr)
+ (if (X-Cursor-p (X-Attr-cursor attr))
+ (X-Cursor-id (X-Attr-cursor attr))
+ (X-Attr-cursor attr)))
+ 4))))
(defun X-Attr-p (attr &optional sig)
"Return non-nil if ATTR is attributes structure.
＠＠ -379,7 +408,6 ＠＠ If SIG is given and ATTR is not attribut
"Return a string representing the attributes ATTR."
(X-Generate-message 'X-Attr attr))
-
;;;Configure window structure
;;
(defstruct (X-Conf (:predicate X-Conf-isconf-p))
＠＠ -388,16 +416,18 ＠＠ If SIG is given and ATTR is not attribut
border-width
sibling
stackmode
- (list '((X-Conf-x . 2)
- (X-Conf-y . 2)
- (X-Conf-width . 2)
- (X-Conf-height . 2)
- (X-Conf-border-width . 2)
- ((lambda (conf)
- (if (X-Win-p (X-Conf-sibling conf))
- (X-Win-id (X-Conf-sibling conf))
- (X-Conf-sibling conf))) . 4)
- (X-Conf-stackmode . 1))))
+ (list (list
+ (cons 'X-Conf-x 2)
+ (cons 'X-Conf-y 2)
+ (cons 'X-Conf-width 2)
+ (cons 'X-Conf-height 2)
+ (cons 'X-Conf-border-width 2)
+ (cons #'(lambda (conf)
+ (if (X-Win-p (X-Conf-sibling conf))
+ (X-Win-id (X-Conf-sibling conf))
+ (X-Conf-sibling conf)))
+ 4)
+ (cons 'X-Conf-stackmode 1))))
(defsubst X-Conf-p (conf &optional sig)
"Return non-nil if CONF is X-Conf structure.
＠＠ -419,10 +449,10 ＠＠ If SIG is given and CONF is not X-Conf s
(defun X-Win-invalidate (xdpy win)
"Remove WIN from dpy list and invalidate cl struct."
(add-timeout X-default-timeout
- (lambda (xdpy-win)
- (setf (X-Dpy-windows (car xdpy-win))
- (delq (cdr xdpy-win) (X-Dpy-windows (car xdpy-win))))
- (X-invalidate-cl-struct (cdr xdpy-win)))
+ #'(lambda (xdpy-win)
+ (setf (X-Dpy-windows (car xdpy-win))
+ (delq (cdr xdpy-win) (X-Dpy-windows (car xdpy-win))))
+ (X-invalidate-cl-struct (cdr xdpy-win)))
(cons xdpy win)))
;; Properties list operations
＠＠ -488,12 +518,6 ＠＠ If you does not specify PRIORITY and EVT
Signal `X-Events-stop' to stop events processing."
(X-EventHandler-runall (X-Win-event-handlers win) xev))
-(defsubst X-Win-p (win &optional sig)
- "Return non-nil if WIN is X-Win structure.
-If SIG is given and WIN is not X-Win structure, SIG will
-be signaled."
- (X-Generic-p 'X-Win 'X-Win-iswin-p win sig))
-
(defun X-Win-find (xdpy wid)
"Find X-Win with id WID on XDPY."
(X-Dpy-p xdpy 'X-Win-find)
＠＠ -519,11 +543,6 ＠＠ be signaled."
plist) ; User defined plist
-(defsubst X-Pixmap-p (pixmap &optional sig)
- "Return non-nil if PIXMAP is X-Pixmap structure.
-If SIG is given and PIXMAP is not X-Pixmap structure, SIG will be signaled."
- (X-Generic-p 'X-Pixmap 'X-Pixmap-ispixmap-p pixmap sig))
-
(defun X-Pixmap-find-or-make (dpy id)
(make-X-Pixmap :dpy dpy :id id))
＠＠ -591,11 +610,6 ＠＠ If SIG, then signal on error."
dpy id
colors) ; list of X-Color [unused]
-(defsubst X-Colormap-p (cmap &optional sig)
- "Return non-nil if CMAP is X-Colormap structure.
-If SIG is given and CMAP is not X-Colormap structure, SIG will be signaled."
- (X-Generic-p 'X-Colormap 'X-Colormap-iscmap-p cmap sig))
-
(defun X-Colormap-lookup-by-rgb (cmap col)
"Lookup color in colormap CMAP by R G B values of X-Color COL."
(let ((cols (X-Colormap-colors cmap)))
＠＠ -667,41 +681,46 ＠＠ If SIG is given and CMAP is not X-Colorm
clip-mask
dash-offset dashes
arc-mode
- (list '((X-Gc-function . 1)
- (X-Gc-plane-mask . 4)
- ((lambda (gc)
- (if (X-Color-p (X-Gc-foreground gc))
- (X-Color-id (X-Gc-foreground gc))
- (X-Gc-foreground gc))) . 4)
- ((lambda (gc)
- (if (X-Color-p (X-Gc-background gc))
- (X-Color-id (X-Gc-background gc))
- (X-Gc-background gc))) . 4)
- (X-Gc-line-width . 2)
- (X-Gc-line-style . 1)
- (X-Gc-cap-style . 1)
- (X-Gc-join-style . 1)
- (X-Gc-fill-style . 1)
- (X-Gc-fill-rule . 1)
- (X-Gc-tile . 4)
- (X-Gc-stipple . 4)
- (X-Gc-tile-stipple-x-origin . 2)
- (X-Gc-tile-stipple-y-origin . 2)
- ((lambda (gc)
- (if (X-Font-p (X-Gc-font gc))
- (X-Font-id (X-Gc-font gc))
- (X-Gc-font gc))) . 4)
- (X-Gc-subwindow-mode . 1)
- (X-Gc-graphics-exposures . 1)
- (X-Gc-clip-x-origin . 2)
- (X-Gc-clip-y-origin . 2)
- ((lambda (gc)
- (if (X-Pixmap-p (X-Gc-clip-mask gc))
- (X-Pixmap-id (X-Gc-clip-mask gc))
- (X-Gc-clip-mask gc))) . 4)
- (X-Gc-dash-offset . 2)
- (X-Gc-dashes . 1)
- (X-Gc-arc-mode . 1))))
+ (list (list
+ (cons 'X-Gc-function 1)
+ (cons 'X-Gc-plane-mask 4)
+ (cons #'(lambda (gc)
+ (if (X-Color-p (X-Gc-foreground gc))
+ (X-Color-id (X-Gc-foreground gc))
+ (X-Gc-foreground gc)))
+ 4)
+ (cons #'(lambda (gc)
+ (if (X-Color-p (X-Gc-background gc))
+ (X-Color-id (X-Gc-background gc))
+ (X-Gc-background gc)))
+ 4)
+ (cons 'X-Gc-line-width 2)
+ (cons 'X-Gc-line-style 1)
+ (cons 'X-Gc-cap-style 1)
+ (cons 'X-Gc-join-style 1)
+ (cons 'X-Gc-fill-style 1)
+ (cons 'X-Gc-fill-rule 1)
+ (cons 'X-Gc-tile 4)
+ (cons 'X-Gc-stipple 4)
+ (cons 'X-Gc-tile-stipple-x-origin 2)
+ (cons 'X-Gc-tile-stipple-y-origin 2)
+ (cons #'(lambda (gc)
+ (if (X-Font-p (X-Gc-font gc))
+ (X-Font-id (X-Gc-font gc))
+ (X-Gc-font gc)))
+ 4)
+ (cons 'X-Gc-subwindow-mode 1)
+ (cons 'X-Gc-graphics-exposures 1)
+ (cons 'X-Gc-clip-x-origin 2)
+ (cons 'X-Gc-clip-y-origin 2)
+ (cons #'(lambda (gc)
+ (if (X-Pixmap-p (X-Gc-clip-mask gc))
+ (X-Pixmap-id (X-Gc-clip-mask gc))
+ (X-Gc-clip-mask gc)))
+ 4)
+ (cons 'X-Gc-dash-offset 2)
+ (cons 'X-Gc-dashes 1)
+ (cons 'X-Gc-arc-mode 1))))
(defun X-Gc-p (gc &optional sig)
(X-Generic-p 'X-Gc 'X-Gc-isgc-p gc sig))
＠＠ -817,8 +836,8 ＠＠ If FONT-DESC is non-nil, return FONT's d
(if (not X-use-queryfont)
(nth 7 (XQueryTextExtents dpy font text))
- (apply '+ (mapcar (lambda (chr)
- (X-Font-char-width chr font))
+ (apply '+ (mapcar #'(lambda (chr)
+ (X-Font-char-width chr font))
text))))
;;; Fontable stuff
＠＠ -854,26 +873,26 ＠＠ If SIG, then signal on error."
src-char msk-char
fgred fggreen fgblue
bgred bggreen bgblue
-
- (list '(((lambda (curs)
- (if (X-Font-p (X-Cursor-source curs))
- (X-Font-id (X-Cursor-source curs))
- (X-Cursor-source curs))) . 4)
- ((lambda (curs)
- (if (X-Font-p (X-Cursor-mask curs))
- (X-Font-id (X-Cursor-mask curs))
- (X-Cursor-mask curs))) . 4)
- (X-Cursor-src-char . 2)
- (X-Cursor-msk-char . 2)
- (X-Cursor-fgred . 2)
- (X-Cursor-fggreen . 2)
- (X-Cursor-fgblue . 2)
- (X-Cursor-bgred . 2)
- (X-Cursor-bggreen . 2)
- (X-Cursor-bgblue . 2))))
-(defsubst X-Cursor-p (cursor &optional sig)
- (X-Generic-p 'X-Cursor 'X-Cursor-iscursor-p cursor sig))
+ (list (list
+ (cons #'(lambda (curs)
+ (if (X-Font-p (X-Cursor-source curs))
+ (X-Font-id (X-Cursor-source curs))
+ (X-Cursor-source curs)))
+ 4)
+ (cons #'(lambda (curs)
+ (if (X-Font-p (X-Cursor-mask curs))
+ (X-Font-id (X-Cursor-mask curs))
+ (X-Cursor-mask curs)))
+ 4)
+ (cons 'X-Cursor-src-char 2)
+ (cons 'X-Cursor-msk-char 2)
+ (cons 'X-Cursor-fgred 2)
+ (cons 'X-Cursor-fggreen 2)
+ (cons 'X-Cursor-fgblue 2)
+ (cons 'X-Cursor-bgred 2)
+ (cons 'X-Cursor-bggreen 2)
+ (cons 'X-Cursor-bgblue 2))))
(defun X-Cursor-find-or-make (dpy id)
(make-X-Cursor :dpy dpy :id id))
- 1 participants
- 0 comments
CVS update by lg ( User: lg Date: 05/04/04 21:49:42) XEmacs/packages/xemacs-packages/xwem/xwem-agent
19 years
CVS Monitor
CVS Monitor
XEmacs/packages/xemacs-packages/xwem/xwem-agent - New directory
- 1 participants
- 0 comments
CVS update by viteno xemacs-builds/viteno ...
19 years
CVS Monitor
CVS Monitor
User: viteno
Date: 05/04/04 21:11:25
Modified: xemacs-builds/viteno package-index setup-packages.ini
Log:
Package database backup:
- vm-7.19
- xetla-1.00
Revision Changes Path
1.206 +29 -6 XEmacs/xemacs-builds/viteno/package-index
Index: package-index
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs-builds/viteno/package-index,v
retrieving revision 1.205
retrieving revision 1.206
diff -u -p -r1.205 -r1.206
--- package-index 2005/04/03 12:32:59 1.205
+++ package-index 2005/04/04 19:11:23 1.206
＠＠ -1,6 +1,29 ＠＠
;; Package Index file -- Do not edit manually.
;;;＠＠＠
(package-get-update-base-entry (quote
+(xetla
+ (standards-version 1.1
+ version "1.00"
+ author-version "steve(a)eicq.org--2005/xetla--main--1.0--version-0"
+ date "2005-04-04"
+ build-date "2005-04-04"
+ maintainer "Steve Youngs <steve(a)youngs.au.com>"
+ distribution xemacs
+ priority low
+ category "standard"
+ dump nil
+ description "Frontend to GNU/arch (tla)."
+ filename "xetla-1.00-pkg.tar.gz"
+ md5sum "307c4435ccc92fa52875a3ca66c09d0d"
+ size 295300
+ provides (ewoc smerge xetla-browse xetla-core
+ xetla-defs xetla-tips xetla-version xetla)
+ requires (ediff xemacs-base jde mail-lib dired prog-modes)
+ type regular
+))
+))
+;;;＠＠＠
+(package-get-update-base-entry (quote
(re-builder
(standards-version 1.1
version "1.02"
＠＠ -2562,19 +2585,19 ＠＠ semantic-sas
(package-get-update-base-entry (quote
(vm
(standards-version 1.1
- version "7.18"
+ version "7.19"
author-version "7.17"
- date "2003-10-31"
- build-date "2003-10-31"
+ date "2005-04-04"
+ build-date "2005-04-04"
maintainer "Kyle Jones <kyle_jones(a)wonderworks.com>"
distribution xemacs
priority medium
category "standard"
dump nil
description "An Emacs mailer."
- filename "vm-7.18-pkg.tar.gz"
- md5sum "25a353d78f64c2dd2e1001719158a315"
- size 812340
+ filename "vm-7.19-pkg.tar.gz"
+ md5sum "5025f5145f9dba720945428e84df50eb"
+ size 821785
provides (tapestry vm-byteopts vm-delete vm-digest vm-easymenu vm-edit vm-folder vm-imap vm-license vm-macro vm-mark vm-menu vm-message vm-mime vm-minibuf vm-misc vm-motion vm-mouse vm-page vm-pop vm-reply vm-save vm-search vm-sort vm-startup vm-summary vm-thread vm-toolbar vm-undo vm-user vm-vars vm vm-version vm-virtual vm-window)
requires (mail-lib xemacs-base)
type regular
1.198 +6 -2 XEmacs/xemacs-builds/viteno/setup-packages.ini
Index: setup-packages.ini
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs-builds/viteno/setup-packages.ini,v
retrieving revision 1.197
retrieving revision 1.198
diff -u -p -r1.197 -r1.198
--- setup-packages.ini 2005/04/03 12:32:59 1.197
+++ setup-packages.ini 2005/04/04 19:11:24 1.198
＠＠ -44,8 +44,8 ＠＠ version: 1.12
install: packages/sounds-wav-1.12-pkg.tar.gz 149624
＠ vm
-version: 7.18
-install: packages/vm-7.18-pkg.tar.gz 812340
+version: 7.19
+install: packages/vm-7.19-pkg.tar.gz 821785
＠ w3
version: 1.30
＠＠ -458,5 +458,9 ＠＠ install: packages/xwem-1.19-pkg.tar.gz 6
＠ re-builder
version: 1.02
install: packages/re-builder-1.02-pkg.tar.gz 17058
+
+＠ xetla
+version: 1.00
+install: packages/xetla-1.00-pkg.tar.gz 295300
# setup-packages.ini file ends here
- 1 participants
- 0 comments
CVS update by viteno packages/xemacs-packages/xetla ...
19 years
CVS Monitor
CVS Monitor
User: viteno
Date: 05/04/04 21:05:50
Modified: packages/xemacs-packages/xetla ChangeLog Makefile
Log:
Increment VERSION in Makefile
Revision Changes Path
1.2 +4 -0 XEmacs/packages/xemacs-packages/xetla/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xetla/ChangeLog,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -p -r1.1 -r1.2
--- ChangeLog 2005/04/04 13:27:19 1.1
+++ ChangeLog 2005/04/04 19:05:48 1.2
＠＠ -1,3 +1,7 ＠＠
+2005-04-04 Norbert Koch <viteno(a)xemacs.org>
+
+ * Makefile (VERSION): XEmacs package 1.00 released.
+
2005-04-04 Steve Youngs <steve(a)sxemacs.org>
* New package
1.2 +1 -1 XEmacs/packages/xemacs-packages/xetla/Makefile
Index: Makefile
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xetla/Makefile,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -p -r1.1 -r1.2
--- Makefile 2005/04/04 13:27:19 1.1
+++ Makefile 2005/04/04 19:05:48 1.2
＠＠ -17,7 +17,7 ＠＠
# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
-VERSION = 0.99
+VERSION = 1.00
AUTHOR_VERSION = steve(a)eicq.org--2005/xetla--main--1.0--version-0
MAINTAINER = Steve Youngs <steve(a)youngs.au.com>
PACKAGE = xetla
- 1 participants
- 0 comments
CVS update by viteno packages/xemacs-packages/vm ...
19 years
CVS Monitor
CVS Monitor
User: viteno
Date: 05/04/04 21:05:11
Modified: packages/xemacs-packages/vm ChangeLog Makefile
Log:
Increment VERSION in Makefile
Revision Changes Path
1.56 +4 -0 XEmacs/packages/xemacs-packages/vm/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/vm/ChangeLog,v
retrieving revision 1.55
retrieving revision 1.56
diff -u -p -r1.55 -r1.56
--- ChangeLog 2005/04/04 10:25:36 1.55
+++ ChangeLog 2005/04/04 19:05:10 1.56
＠＠ -1,3 +1,7 ＠＠
+2005-04-04 Norbert Koch <viteno(a)xemacs.org>
+
+ * Makefile (VERSION): XEmacs package 7.19 released.
+
2005-04-04 Aidan Kehoe <kehoea(a)parhasard.net>
* vm-mime.el (vm-coding-system-priorities): New.
1.66 +1 -1 XEmacs/packages/xemacs-packages/vm/Makefile
Index: Makefile
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/vm/Makefile,v
retrieving revision 1.65
retrieving revision 1.66
diff -u -p -r1.65 -r1.66
--- Makefile 2004/12/08 01:31:57 1.65
+++ Makefile 2005/04/04 19:05:10 1.66
＠＠ -17,7 +17,7 ＠＠
# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
-VERSION = 7.18
+VERSION = 7.19
AUTHOR_VERSION = 7.17
MAINTAINER = Kyle Jones <kyle_jones(a)wonderworks.com>
PACKAGE = vm
- 1 participants
- 0 comments
CVS update by viteno packages ...
19 years
CVS Monitor
CVS Monitor
User: viteno
Date: 05/04/04 21:04:32
Modified: packages ChangeLog
Log:
Package release
Revision Changes Path
1.517 +4 -0 XEmacs/packages/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/ChangeLog,v
retrieving revision 1.516
retrieving revision 1.517
diff -u -p -r1.516 -r1.517
--- ChangeLog 2005/04/04 13:27:15 1.516
+++ ChangeLog 2005/04/04 19:04:31 1.517
＠＠ -1,3 +1,7 ＠＠
+2005-04-04 Norbert Koch <viteno(a)xemacs.org>
+
+ * Packages released: vm xetla.
+
2005-04-04 Steve Youngs <steve(a)sxemacs.org>
* package-compile.el (package-directory-map): Add xetla.
- 1 participants
- 0 comments