Norbert!
This should be good to go. The XWEM update follows in a minute.
BTW, Evgeny will be out of touch until about the 11th or 12th of Jan
(he's drinking until the 10th and then a couple of days to sober up
:-P).
NOTE: This patch has been committed.
xlib patch:
ChangeLog files diff command: cvs -q diff -U 0
Files affected: ChangeLog
Source files diff command: cvs -q diff -uN
Files affected: lisp/xlib-xwin.el lisp/xlib-xtest.el
lisp/xlib-xshape.el lisp/xlib-xrecord.el lisp/xlib-xr.el lisp/xlib-xpm.el
lisp/xlib-xlib.el lisp/xlib-xinerama.el lisp/xlib-xc.el lisp/xlib-vidmode.el
lisp/xlib-version.el lisp/xlib-tray.el lisp/xlib-testing.el lisp/xlib-math.el
lisp/xlib-keysymdb.el lisp/xlib-img.el lisp/xlib-hello.el lisp/xlib-const.el
lisp/xlib-composer.el package-info.in Makefile ChangeLog.upstream
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/ChangeLog,v
retrieving revision 1.32
diff -u -U0 -r1.32 ChangeLog
--- ChangeLog 16 Dec 2004 07:48:58 -0000 1.32
+++ ChangeLog 1 Jan 2005 04:35:37 -0000
@@ -0,0 +1,7 @@
+2005-01-01 Steve Youngs <steve@xxxxxxxxxxxxx>
+
+ * Makefile (AUTHOR_VERSION): Bump.
+
+ This is the version 2.0 release. For details please see
+ ChangeLog.upstream.
+
Index: ChangeLog.upstream
===================================================================
RCS file: ChangeLog.upstream
diff -N ChangeLog.upstream
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ ChangeLog.upstream 1 Jan 2005 04:35:21 -0000
@@ -0,0 +1,222 @@
+# do not edit -- automatically generated by arch changelog
+# non-id: automatic-ChangeLog--lg@xxxxxxxxxxxxxx/xlib--main--2.0
+#
+
+2005-01-01 02:21:03 GMT Zajcev Evgeny <lg@xxxxxxxx> version-0
+
+ Summary:
+ Version 2.0 is released
+ Revision:
+ xlib--main--2.0--version-0
+
+
+ new files:
+ .arch-ids/README.id README
+
+
+2004-12-30 23:12:56 GMT Zajcev Evgeny <lg@xxxxxxxx> patch-9
+
+ Summary:
+ xpm parsing fixes
+ Revision:
+ xlib--main--2.0--patch-9
+
+ * lisp/xlib-xpm.el (X:xpm-goto-color-def): [fix] Use `re-search-forward'
+ instead of `looking-at' loop. Use `forward-line' instead of
+ `next-line'.
+
+ * lisp/xlib-xpm.el (X:xpm-goto-body-line): [fix] Use `forward-line'
+ instead of `next-line'
+
+ * lisp/xlib-xpm.el (X:xpm-extract-shape-colors): [fix] Ditto.
+
+ * lisp/xlib-xpm.el (X:xpm-extract-colors): [fix] Ditto.
+
+ modified files:
+ lisp/xlib-xpm.el
+
+
+2004-12-29 20:54:17 GMT Zajcev Evgeny <lg@xxxxxxxx> patch-8
+
+ Summary:
+ Makefile fix, X-Win-invalidate commented out
+ Revision:
+ xlib--main--2.0--patch-8
+
+ * Makefile (lisp/xlib-version.el): [fix]
+
+ * lisp/xlib-xr.el (X-Dpy-parse-event): [fix] X-Win-invalidate commented
+ out, because causing some problems.
+
+
+
+ modified files:
+ Makefile lisp/xlib-xr.el
+
+
+2004-12-23 22:24:12 GMT Zajcev Evgeny <lg@xxxxxxxx> patch-7
+
+ Summary:
+ Very simple X-Win garbage collector
+ Revision:
+ xlib--main--2.0--patch-7
+
+ * Makefile: [addon] Dependences.
+
+ * lisp/xlib-xlib (X-invalidate-cl-struct): [rem] Moved to xlib-xr.el
+
+ * lisp/xlib-xlib (XOpenDisplay): [addon] Schedule garbage collector.
+
+ * lisp/xlib-xr (X-invalidate-cl-struct): [new] Moved from xlib-xlib.el
+
+ * lisp/xlib-xr (X-Dpy-parse-event): [addon] Schedule garbage collector
+ in case of X-DestroyNotify event.
+
+ * lisp/xlib-xwin (X-Win-invalidate): [rewritten]
+
+
+ modified files:
+ Makefile lisp/xlib-xlib.el lisp/xlib-xr.el lisp/xlib-xwin.el
+
+
+2004-12-20 21:01:42 GMT Zajcev Evgeny <lg@xxxxxxxx> patch-6
+
+ Summary:
+ Merged with 2004-w
+ Revision:
+ xlib--main--2.0--patch-6
+
+ Patches applied:
+
+ * dev@xxxxxxxxxxxxxxxx/xlib--dev--2.0--patch-9
+ Merge with main, makefile change
+
+
+ modified files:
+ Makefile
+
+ new patches:
+ dev@xxxxxxxxxxxxxxxx/xlib--dev--2.0--patch-9
+
+
+2004-12-19 23:01:09 GMT Zajcev Evgeny <lg@xxxxxxxx> patch-5
+
+ Summary:
+ makefile clarification
+ Revision:
+ xlib--main--2.0--patch-5
+
+ * Makefile: Clarification. make pkg should work properly now.
+
+
+
+
+ modified files:
+ Makefile
+
+
+2004-12-18 21:36:46 GMT Zajcev Evgeny <lg@xxxxxxxx> patch-4
+
+ Summary:
+ merged with dev@xxxxxxxxxxxxxxxx/xlib--dev--2.0
+ Revision:
+ xlib--main--2.0--patch-4
+
+ * lisp/xlib-xr.el (X-Dpy-send-read): [fix] Removed send-read protection
+ crap.
+
+ modified files:
+ lisp/xlib-xr.el
+
+ new patches:
+ dev@xxxxxxxxxxxxxxxx/xlib--dev--2.0--patch-5
+ dev@xxxxxxxxxxxxxxxx/xlib--dev--2.0--patch-6
+ dev@xxxxxxxxxxxxxxxx/xlib--dev--2.0--patch-7
+ dev@xxxxxxxxxxxxxxxx/xlib--dev--2.0--patch-8
+
+
+2004-12-17 01:59:47 GMT Evgeny Zajcev <lg@xxxxxxxx> patch-3
+
+ Summary:
+ xlib-xr typo fix
+ Revision:
+ xlib--main--2.0--patch-3
+
+ * lisp/xlib-xr.el (X-Dpy-eval-error-or-event): [typo] Thanks to Andrey
+ Slusar <anray@xxxxxx>
+
+
+ modified files:
+ lisp/xlib-xr.el
+
+
+2004-12-17 00:46:40 GMT Evgeny Zajcev <lg@xxxxxxxx> patch-2
+
+ Summary:
+ X send-read protection introduced using recursive-edit
+ Revision:
+ xlib--main--2.0--patch-2
+
+ * lisp/xlib-xr.el (X-Dpy-send-read): [EXP fix] send-read protection.
+
+ modified files:
+ Makefile lisp/xlib-xr.el
+
+
+2004-12-10 21:20:16 GMT Evgeny Zajcev <lg@xxxxxxxx> patch-1
+
+ Summary:
+ merge from steve
+ Revision:
+ xlib--main--2.0--patch-1
+
+ Patches applied:
+
+ * steve@xxxxxxxxxxxxxx/xlib--steve--2.0--base-0
+ tag of lg@xxxxxxxxxxxxxx/xlib--main--2.0--base-0
+
+ * steve@xxxxxxxxxxxxxx/xlib--steve--2.0--patch-1
+ Move to tla style version string
+
+ * steve@xxxxxxxxxxxxxx/xlib--steve--2.0--patch-2
+ quick Makefile fix -- XLIB doesn't have any texi files
+
+
+ new files:
+ .arch-ids/Makefile.id Makefile
+ lisp/.arch-ids/.arch-inventory.id lisp/.arch-inventory
+
+ modified files:
+ lisp/xlib-const.el package-info.in
+
+ renamed files:
+ .arch-ids/Makefile.id
+ ==> .arch-ids/Makefile.CVS.id
+ Makefile
+ ==> Makefile.CVS
+
+ new patches:
+ steve@xxxxxxxxxxxxxx/xlib--steve--2.0--base-0
+ steve@xxxxxxxxxxxxxx/xlib--steve--2.0--patch-1
+ steve@xxxxxxxxxxxxxx/xlib--steve--2.0--patch-2
+
+
+2004-12-08 18:52:15 GMT Evgeny Zajcev <lg@xxxxxxxx> base-0
+
+ Summary:
+ Initial import of xlib sources.
+ Revision:
+ xlib--main--2.0--base-0
+
+
+ new files:
+ ChangeLog.CVS Makefile convmod/Makefile convmod/xlib.c
+ lisp/README 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 package-info.in
+
+
Index: Makefile
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/Makefile,v
retrieving revision 1.20
diff -u -u -r1.20 Makefile
--- Makefile 16 Dec 2004 07:48:58 -0000 1.20
+++ Makefile 1 Jan 2005 04:35:22 -0000
@@ -18,7 +18,7 @@
# Boston, MA 02111-1307, USA.
VERSION = 1.12
-AUTHOR_VERSION = 0.2
+AUTHOR_VERSION = lg@xxxxxxxxxxxxxx/xlib--main--2.0--version-0
MAINTAINER = Zajcev Evgeny <zevlg@xxxxxxxxx>
PACKAGE = xlib
PKG_TYPE = regular
Index: package-info.in
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/package-info.in,v
retrieving revision 1.2
diff -u -u -r1.2 package-info.in
--- package-info.in 11 Mar 2004 12:45:29 -0000 1.2
+++ package-info.in 1 Jan 2005 04:35:22 -0000
@@ -13,7 +13,7 @@
filename FILENAME
md5sum MD5SUM
size SIZE
- provides (xlib-const xlib-math xlib-xc xlib-xr xlib-xwin xlib-xlib xlib-img
xlib-xpm xlib-tray xlib-hello)
+ provides (xlib-composer xlib-const xlib-hello xlib-img xlib-keysymdb
xlib-math xlib-testing xlib-tray xlib-version xlib-vidmode xlib-xc xlib-xdpms
xlib-xinerama xlib-xlib xlib-xpm xlib-xr xlib-xrecord xlib-xshape xlib-xtest
xlib-xwin)
requires (REQUIRES)
type regular
))
Index: lisp/xlib-composer.el
===================================================================
RCS file: lisp/xlib-composer.el
diff -N lisp/xlib-composer.el
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ lisp/xlib-composer.el 1 Jan 2005 04:35:22 -0000
@@ -0,0 +1,53 @@
+;;; xlib-composer.el ---
+
+;; Copyright (C) 2004 by Free Software Foundation, Inc.
+
+;; Author: Zajcev Evgeny <zevlg@xxxxxxxxx>
+;; Created: Fri Jun 4 18:46:04 MSD 2004
+;; Keywords: xlib
+;; X-CVS: $Id$
+
+;; This file is part of XWEM.
+
+;; XWEM is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XWEM is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+;; License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; Composer.
+
+;;; Code:
+
+(require 'xlib-xlib)
+
+(defstruct X-Composer
+ xwin
+ xpix)
+
+
+(defun X:cmr-create (xdpy)
+ "On display XDPY create new composer."
+ )
+
+(defun X:cmr-resize (xcmr width height)
+ "Resize composer XCMR to WIDTH and HEIGHT."
+ )
+
+
+(provide 'xlib-composer)
+
+;;; xlib-composer.el ends here
Index: lisp/xlib-const.el
===================================================================
RCS file:
/pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-const.el,v
retrieving revision 1.6
diff -u -u -r1.6 xlib-const.el
--- lisp/xlib-const.el 16 Dec 2004 07:49:09 -0000 1.6
+++ lisp/xlib-const.el 1 Jan 2005 04:35:22 -0000
@@ -5,7 +5,7 @@
;; Author: Eric M. Ludlam <zappo@xxxxxxxxxxxxxx>
;; Modified: Zajcev Evgeny <zevlg@xxxxxxxxx>
;; Keywords: xlib, xwem
-;; X-RCS: $Id: xlib-const.el,v 1.6 2004/12/16 07:49:09 youngs Exp $
+;; X-RCS: $Id: xlib-const.el,v 1.5 2004/11/29 19:48:18 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
@@ -35,1093 +35,543 @@
;;; Code:
-;;;###autoload
-(defconst xlib-version "xlib(xemacs-package): $Revision: 1.6 $")
+(require 'xlib-version)
-;;;###autoload
(defconst X-False 0 "False")
-;;;###autoload
(defconst X-True 1 "True")
-;;;###autoload
(defconst X-CopyFromParent 0 "CopyFromParent opcode.")
-;;;###autoload
(defconst X-InputOutput 1 "InputOutput opcode.")
-;;;###autoload
(defconst X-InputOnly 2 "InputOnly opcode.")
;;; Gravity
-;;;###autoload
-(defconst X-Unmap 0 "Unmap gravity.")
-;;;###autoload
-(defconst X-NorthWest 1 "NorthWest gravity.")
-;;;###autoload
-(defconst X-North 2 "North gravity.")
-;;;###autoload
-(defconst X-NorthEast 3 "NorthEast gravity.")
-;;;###autoload
-(defconst X-West 4 "West gravity.")
-;;;###autoload
-(defconst X-Center 5 "Center gravity.")
-;;;###autoload
-(defconst X-East 6 "East gravity.")
-;;;###autoload
-(defconst X-SouthWest 7 "SouthWest gravity.")
-;;;###autoload
-(defconst X-South 8 "South gravity.")
-;;;###autoload
-(defconst X-SouthEast 9 "SouthEast gravity.")
-;;;###autoload
-(defconst X-Static 10 "Static gravity.")
+(defconst X-ForgetGravity 0 "Forget about bit gravity.")
+(defconst X-NorthWestGravity 1 "NorthWest gravity.")
+(defconst X-NorthGravity 2 "North gravity.")
+(defconst X-NorthEastGravity 3 "NorthEast gravity.")
+(defconst X-WestGravity 4 "West gravity.")
+(defconst X-CenterGravity 5 "Center gravity.")
+(defconst X-EastGravity 6 "East gravity.")
+(defconst X-SouthWestGravity 7 "SouthWest gravity.")
+(defconst X-SouthGravity 8 "South gravity.")
+(defconst X-SouthEastGravity 9 "SouthEast gravity.")
+(defconst X-StaticGravity 10 "Static gravity.")
+
+;; Window gravity + bit gravity above
+
+(defconst X-UnmapGravity 0 "Unmap gravity.")
;; backing store
-;;;###autoload
(defconst X-NotUseful 0 "NotUseful backing store.")
-;;;###autoload
(defconst X-WhenMapped 1 "WhenMapped backing store.")
-;;;###autoload
(defconst X-Always 2 "Always backing store.")
;;; Event Masks
-;;;###autoload
(defconst XM-NoEvent #x0 "No Event mask.")
-;;;###autoload
(defconst XM-KeyPress #x1 "KeyPr
;; XSetClipRectangles ordering
-;;;###autoload
(defconst X-UnSorted 0 "Unsorted list.")
-;;;###autoload
(defconst X-YSorted 1 "Sorted by Y.")
-;;;###autoload
(defconst X-YXSorted 2 "Sorted by X and Y.")
-;;;###autoload
(defconst X-YXBanded 3)
;; Imaging
-;;;###autoload
(defconst X-XYBitmap 0) ; depth 1, XYFormat
-;;;###autoload
(defconst X-XYPixmap 1) ; depth == drawable depth
-;;;###autoload
(defconst X-ZPixmap 2) ; depth == drawable depth
;;; Some color type stuff
;;
-;;;###autoload
(defconst X-AllocNone 0 "No color entries writable.")
-;;;###autoload
(defconst X-AllocAll 1 "All color entries writable.")
-;;;###autoload
(defconst X-DoRed 1 "Do Red mask.")
-;;;###autoload
(defconst X-DoGreen 2 "Do Green mask.")
-;;;###autoload
(defconst X-DoBlue 4 "Do blue mask.")
-;;;###autoload
(defconst X-DoRedGreenBlue 7 "All Color Dos ored together.")
;;; Poling coordinate mode
-;;;###autoload
(defconst X-Origin 0 "Specifies point drawn with relation to origin.")
-;;;###autoload
(defconst X-Previous 1 "Specifies points draw with relation to previous
point.")
;;; Filling shapes
-;;;###autoload
(defconst X-Complex 0)
-;;;###autoload
(defconst X-Nonconvex 1)
-;;;###autoload
(defconst X-Convex 2)
;; Misc
-;;;###autoload
(defconst X-None 0 "universal null resource or null atom")
-;;;###autoload
(defconst X-RevertToNone 0 "for XSetInputFocus")
-;;;###autoload
(defconst X-RevertToPointerRoot 1 "for XSetInputFocus")
-;;;###autoload
(defconst X-RevertToParent 2 "for XSetInputFocus")
-;;;###autoload
(defconst X-ParentRelative 1
"Background pixmap in CreateWindow and ChangeWindowAttributes.")
-;;;###autoload
(defconst X-CopyFromParent 0
"Border pixmap in CreateWindow and ChangeWindowAttributes special
VisualID and special window class passed to CreateWindow.")
-;;;###autoload
(defconst X-PointerWindow 0 "destination window in SendEvent")
-;;;###autoload
(defconst X-InputFocus 1 "destination window in SendEvent")
-;;;###autoload
(defconst X-PointerRoot 1 "focus window in SetInputFocus")
-;;;###autoload
(defconst X-AnyPropertyType 0 "special Atom, passed to GetProperty")
-;;;###autoload
(defconst X-AnyKey 0 "special Key Code, passed to GrabKey")
-;;;###autoload
(defconst X-AnyButton 0 "special Button Code, passed to GrabButton")
-;;;###autoload
(defconst X-AllTemporary 0 "special Resource ID passed to KillClient")
-;;;###autoload
(defconst X-CurrentTime 0 "special Time")
-;;;###autoload
(defconst X-NoSymbol 0 "special KeySym")
-;;;###autoload
(defconst X-GrabModeSync 0 "specific mode")
-;;;###autoload
(defconst X-GrabModeAsync 1 "specific mode")
-;;;###autoload
(defconst X-AllPlanes -1 "Mask for all planes in XGetImage.")
;; AllowEvents modes
-;;;###autoload
(defconst X-AsyncPointer 0)
-;;;###autoload
(defconst X-SyncPointer 1)
-;;;###autoload
(defconst X-ReplayPointer 2)
-;;;###autoload
(defconst X-AsyncKeyboard 3)
-;;;###autoload
(defconst X-SyncKeyboard 4)
-;;;###autoload
(defconst X-ReplayKeyboard 5)
-;;;###autoload
(defconst X-AsyncBoth 6)
-;;;###autoload
(defconst X-SyncBoth 7)
;; For window Attributes
-;;;###autoload
(defconst X-CWBackPixmap #x1)
-;;;###autoload
(defconst X-CWBackPixel #x2)
-;;;###autoload
(defconst X-CWBorderPixmap #x4)
-;;;###autoload
(defconst X-CWBorderPixel #x8)
-;;;###autoload
(defconst X-CWBitGravity #x10)
-;;;###autoload
(defconst X-CWWinGravity #x20)
-;;;###autoload
(defconst X-CWBackingStore #x40)
-;;;###autoload
(defconst X-CWBackingPlanes #x80)
-;;;###autoload
(defconst X-CWBackingPixel #x100)
-;;;###autoload
(defconst X-CWOverrideRedirect #x200)
-;;;###autoload
(defconst X-CWSaveUnder #x400)
-;;;###autoload
(defconst X-CWEventMask #x800)
-;;;###autoload
(defconst X-CWDontPropagate #x1000)
-;;;###autoload
(defconst X-CWColormap #x2000)
-;;;###autoload
(defconst X-CWCursor #x4000)
;; used in ChangeSaveSet
-;;;###autoload
(defconst X-SetModeInsert 0)
-;;;###autoload
(defconst X-SetModeDelete 1)
;; used in ConfigureWindow
-;;;###autoload
(defconst X-CWX #x1)
-;;;###autoload
(defconst X-CWY #x2)
-;;;###autoload
(defconst X-CWWidth #x4)
-;;;###autoload
(defconst X-CWHeight #x8)
-;;;###autoload
(defconst X-CWBorderWidth #x10)
-;;;###autoload
(defconst X-CWSibling #x20)
-;;;###autoload
(defconst X-CWStackMode #x40)
;;; Cursors
-;;;###autoload
(defconst X-XC-num_glyphs 154)
-;;;###autoload
(defconst X-XC-X_cursor 0)
-;;;###autoload
(defconst X-XC-arrow 2)
-;;;###autoload
(defconst X-XC-based_arrow_down 4)
-;;;###autoload
(defconst X-XC-based_arrow_up 6)
-;;;###autoload
(defconst X-XC-boat 8)
-;;;###autoload
(defconst X-XC-bogosity 10)
-;;;###autoload
(defconst X-XC-bottom_left_corner 12)
-;;;###autoload
(defconst X-XC-bottom_right_corner 14)
-;;;###autoload
(defconst X-XC-bottom_side 16)
-;;;###autoload
(defconst X-XC-bottom_tee 18)
-;;;###autoload
(defconst X-XC-box_spiral 20)
-;;;###autoload
(defconst X-XC-center_ptr 22)
-;;;###autoload
(defconst X-XC-circle 24)
-;;;###autoload
(defconst X-XC-clock 26)
-;;;###autoload
(defconst X-XC-coffee_mug 28)
-;;;###autoload
(defconst X-XC-cross 30)
-;;;###autoload
(defconst X-XC-cross_reverse 32)
-;;;###autoload
(defconst X-XC-crosshair 34)
-;;;###autoload
(defconst X-XC-diamond_cross 36)
-;;;###autoload
(defconst X-XC-dot 38)
-;;;###autoload
(defconst X-XC-dotbox 40)
-;;;###autoload
(defconst X-XC-double_arrow 42)
-;;;###autoload
(defconst X-XC-draft_large 44)
-;;;###autoload
(defconst X-XC-draft_small 46)
-;;;###autoload
(defconst X-XC-draped_box 48)
-;;;###autoload
(defconst X-XC-exchange 50)
-;;;###autoload
(defconst X-XC-fleur 52)
-;;;###autoload
(defconst X-XC-gobbler 54)
-;;;###autoload
(defconst X-XC-gumby 56)
-;;;###autoload
(defconst X-XC-hand1 58)
-;;;###autoload
(defconst X-XC-hand2 60)
-;;;###autoload
(defconst X-XC-heart 62)
-;;;###autoload
(defconst X-XC-icon 64)
-;;;###autoload
(defconst X-XC-iron_cross 66)
-;;;###autoload
(defconst X-XC-left_ptr 68)
-;;;###autoload
(defconst X-XC-left_side 70)
-;;;###autoload
(defconst X-XC-left_tee 72)
-;;;###autoload
(defconst X-XC-leftbutton 74)
-;;;###autoload
(defconst X-XC-ll_angle 76)
-;;;###autoload
(defconst X-XC-lr_angle 78)
-;;;###autoload
(defconst X-XC-man 80)
-;;;###autoload
(defconst X-XC-middlebutton 82)
-;;;###autoload
(defconst X-XC-mouse 84)
-;;;###autoload
(defconst X-XC-pencil 86)
-;;;###autoload
(defconst X-XC-pirate 88)
-;;;###autoload
(defconst X-XC-plus 90)
-;;;###autoload
(defconst X-XC-question_arrow 92)
-;;;###autoload
(defconst X-XC-right_ptr 94)
-;;;###autoload
(defconst X-XC-right_side 96)
-;;;###autoload
(defconst X-XC-right_tee 98)
-;;;###autoload
(defconst X-XC-rightbutton 100)
-;;;###autoload
(defconst X-XC-rtl_logo 102)
-;;;###autoload
(defconst X-XC-sailboat 104)
-;;;###autoload
(defconst X-XC-sb_down_arrow 106)
-;;;###autoload
(defconst X-XC-sb_h_double_arrow 108)
-;;;###autoload
(defconst X-XC-sb_left_arrow 110)
-;;;###autoload
(defconst X-XC-sb_right_arrow 112)
-;;;###autoload
(defconst X-XC-sb_up_arrow 114)
-;;;###autoload
(defconst X-XC-sb_v_double_arrow 116)
-;;;###autoload
(defconst X-XC-shuttle 118)
-;;;###autoload
(defconst X-XC-sizing 120)
-;;;###autoload
(defconst X-XC-spider 122)
-;;;###autoload
(defconst X-XC-spraycan 124)
-;;;###autoload
(defconst X-XC-star 126)
-;;;###autoload
(defconst X-XC-target 128)
-;;;###autoload
(defconst X-XC-tcross 130)
-;;;###autoload
(defconst X-XC-top_left_arrow 132)
-;;;###autoload
(defconst X-XC-top_left_corner 134)
-;;;###autoload
(defconst X-XC-top_right_corner 136)
-;;;###autoload
(defconst X-XC-top_side 138)
-;;;###autoload
(defconst X-XC-top_tee 140)
-;;;###autoload
(defconst X-XC-trek 142)
-;;;###autoload
(defconst X-XC-ul_angle 144)
-;;;###autoload
(defconst X-XC-umbrella 146)
-;;;###autoload
(defconst X-XC-ur_angle 148)
-;;;###autoload
(defconst X-XC-watch 150)
-;;;###autoload
(defconst X-XC-xterm 152)
;; Some keys
-;;;###autoload
(defconst XK-Shift-L 65505)
-;;;###autoload
(defconst XK-Shift-R 65506)
-;;;###autoload
(defconst XK-Control-L 65507)
-;;;###autoload
(defconst XK-Control-R 65508)
-;;;###autoload
(defconst XK-Caps-Lock 65509)
-;;;###autoload
(defconst XK-Shift-Lock 65510)
-;;;###autoload
(defconst XK-Meta-L 65511)
-;;;###autoload
(defconst XK-Meta-R 65512)
-;;;###autoload
(defconst XK-Alt-L 65513)
-;;;###autoload
(defconst XK-Alt-R 65514)
-;;;###autoload
(defconst XK-Super-L 65515)
-;;;###autoload
(defconst XK-Super-R 65516)
-;;;###autoload
(defconst XK-Hyper-L 65517)
-;;;###autoload
(defconst XK-Hyper-R 65518)
-;;;###autoload
(defconst XK-BackSpace 65288)
-;;;###autoload
(defconst XK-Tab 65289)
-;;;###autoload
(defconst XK-Linefeed 65290)
-;;;###autoload
(defconst XK-Clear 65291)
-;;;###autoload
(defconst XK-Return 65293)
-;;;###autoload
(defconst XK-Pause 65299)
-;;;###autoload
(defconst XK-Scroll-Lock 65300)
-;;;###autoload
(defconst XK-Sys-Req 65301)
-;;;###autoload
(defconst XK-Escape 65307)
-;;;###autoload
(defconst XK-Delete 65535)
-;;;###autoload
(defconst XK-Select #xFF60 "Select, mark")
-;;;###autoload
(defconst XK-Print #xFF61)
-;;;###autoload
(defconst XK-Execute #xFF62 "Execute, run, do")
-;;;###autoload
(defconst XK-Insert #xFF63 "Insert, insert here")
-;;;###autoload
(defconst XK-Undo #xFF65 "Undo, oops")
-;;;###autoload
(defconst XK-Redo #xFF66 "redo, again")
-;;;###autoload
(defconst XK-Menu #xFF67)
-;;;###autoload
(defconst XK-Find #xFF68 "Find, search")
-;;;###autoload
(defconst XK-Cancel #xFF69 "Cancel, stop, abort, exit")
-;;;###autoload
(defconst XK-Help #xFF6A "Help")
-;;;###autoload
(defconst XK-Break #xFF6B)
-;;;###autoload
(defconst XK-ModeSwitch #xFF7E "Character set switch")
-;;;###autoload
(defconst XK-ScriptSwitch #xFF7E "Alias for mode_switch")
-;;;###autoload
(defconst XK-NumLock #xFF7F)
-;;;###autoload
(defconst XK-F1 #xFFBE)
-;;;###autoload
(defconst XK-F2 #xFFBF)
-;;;###autoload
(defconst XK-F3 #xFFC0)
-;;;###autoload
(defconst XK-F4 #xFFC1)
-;;;###autoload
(defconst XK-F5 #xFFC2)
-;;;###autoload
(defconst XK-F6 #xFFC3)
-;;;###autoload
(defconst XK-F7 #xFFC4)
-;;;###autoload
(defconst XK-F8 #xFFC5)
-;;;###autoload
(defconst XK-F9 #xFFC6)
-;;;###autoload
(defconst XK-F10 #xFFC7)
-;;;###autoload
(defconst XK-F11 #xFFC8)
-;;;###autoload
(defconst XK-L1 #xFFC8)
-;;;###autoload
(defconst XK-F12 #xFFC9)
-;;;###autoload
(defconst XK-L2 #xFFC9)
-;;;###autoload
(defconst XK-F13 #xFFCA)
-;;;###autoload
(defconst XK-L3 #xFFCA)
-;;;###autoload
(defconst XK-F14 #xFFCB)
-;;;###autoload
(defconst XK-L4 #xFFCB)
-;;;###autoload
(defconst XK-F15 #xFFCC)
-;;;###autoload
(defconst XK-L5 #xFFCC)
-;;;###autoload
(defconst XK-F16 #xFFCD)
-;;;###autoload
(defconst XK-L6 #xFFCD)
-;;;###autoload
(defconst XK-F17 #xFFCE)
-;;;###autoload
(defconst XK-L7 #xFFCE)
-;;;###autoload
(defconst XK-F18 #xFFCF)
-;;;###autoload
(defconst XK-L8 #xFFCF)
-;;;###autoload
(defconst XK-F19 #xFFD0)
-;;;###autoload
(defconst XK-L9 #xFFD0)
-;;;###autoload
(defconst XK-F20 #xFFD1)
-;;;###autoload
(defconst XK-L10 #xFFD1)
-;;;###autoload
(defconst XK-F21 #xFFD2)
-;;;###autoload
(defconst XK-R1 #xFFD2)
-;;;###autoload
(defconst XK-F22 #xFFD3)
-;;;###autoload
(defconst XK-R2 #xFFD3)
-;;;###autoload
(defconst XK-F23 #xFFD4)
-;;;###autoload
(defconst XK-R3 #xFFD4)
-;;;###autoload
(defconst XK-F24 #xFFD5)
-;;;###autoload
(defconst XK-R4 #xFFD5)
-;;;###autoload
(defconst XK-F25 #xFFD6)
-;;;###autoload
(defconst XK-R5 #xFFD6)
-;;;###autoload
(defconst XK-F26 #xFFD7)
-;;;###autoload
(defconst XK-R6 #xFFD7)
-;;;###autoload
(defconst XK-F27 #xFFD8)
-;;;###autoload
(defconst XK-R7 #xFFD8)
-;;;###autoload
(defconst XK-F28 #xFFD9)
-;;;###autoload
(defconst XK-R8 #xFFD9)
-;;;###autoload
(defconst XK-F29 #xFFDA)
-;;;###autoload
(defconst XK-R9 #xFFDA)
-;;;###autoload
(defconst XK-F30 #xFFDB)
-;;;###autoload
(defconst XK-R10 #xFFDB)
-;;;###autoload
(defconst XK-F31 #xFFDC)
-;;;###autoload
(defconst XK-R11 #xFFDC)
-;;;###autoload
(defconst XK-F32 #xFFDD)
-;;;###autoload
(defconst XK-R12 #xFFDD)
-;;;###autoload
(defconst XK-F33 #xFFDE)
-;;;###autoload
(defconst XK-R13 #xFFDE)
-;;;###autoload
(defconst XK-F34 #xFFDF)
-;;;###autoload
(defconst XK-R14 #xFFDF)
-;;;###autoload
(defconst XK-F35 #xFFE0)
-;;;###autoload
(defconst XK-R15 #xFFE0)
-;;;###autoload
(defconst XK-Space #x0020)
;; Cursors
-;;;###autoload
(defconst XK-Home #xFF50)
-;;;###autoload
(defconst XK-Left #xFF51) ; Move left, left arrow
-;;;###autoload
(defconst XK-Up #xFF52) ; Move up, up arrow
-;;;###autoload
(defconst XK-Right #xFF53) ; Move right, right arrow
-;;;###autoload
(defconst XK-Down #xFF54) ; Move down, down arrow
-;;;###autoload
(defconst XK-Prior #xFF55) ; Prior, previous
-;;;###autoload
(defconst XK-PageUp #xFF55)
-;;;###autoload
(defconst XK-Next #xFF56) ; Next
-;;;###autoload
(defconst XK-PageDown #xFF56) ;
-;;;###autoload
(defconst XK-End #xFF57) ; EOL
-;;;###autoload
(defconst XK-Begin #xFF58) ; BOL
;; Window states
-;;;###autoload
(defconst X-WithdrawnState 0.0)
-;;;###autoload
(defconst X-NormalState 1.0)
-;;;###autoload
(defconst X-IconicState 3.0)
;; Notify mode
-;;;###autoload
(defconst X-NotifyNormal 0)
-;;;###autoload
(defconst X-NotifyGrab 1)
-;;;###autoload
(defconst X-NotifyUngrab 2)
-;;;###autoload
(defconst X-NotifyWhileGrabbed 3)
-;;;###autoload
(defconst X-NotifyHint 1) ; for MotionNotify
;; Notify detail
-;;;###autoload
(defconst X-NotifyAncestor 0)
-;;;###autoload
(defconst X-NotifyVirtual 1)
-;;;###autoload
(defconst X-NotifyInferior 2)
-;;;###autoload
(defconst X-NotifyNonlinear 3)
-;;;###autoload
(defconst X-NotifyNonlinearVirtual 4)
-;;;###autoload
(defconst X-NotifyPointer 5)
-;;;###autoload
(defconst X-NotifyPointerRoot 6)
-;;;###autoload
(defconst X-NotifyDetailNone 7)
;; Used in GetWindowAttributes reply
-;;;###autoload
(defconst X-Unmapped 0)
-;;;###autoload
(defconst X-Unviewable 1)
-;;;###autoload
(defconst X-Viewable 2)
+;; Visibility notify
+(defconst X-VisibilityUnobscured 0)
+(defconst X-VisibilityPartiallyObscured 1)
+(defconst X-VisibilityFullyObscured 2)
+
+;; Circulation request
+(defconst X-PlaceOnTop 0)
+(defconst X-PlaceOnBottom 1)
+
+;; Protocol families
+(defconst X-FamilyInternet 0)
+(defconst X-FamilyDECnet 1)
+(defconst X-FamilyChaos 2)
+
;; Byte order
-;;;###autoload
(defconst X-LSBFirst 0)
-;;;###autoload
(defconst X-MSBFirst 1)
Index: lisp/xlib-hello.el
===================================================================
RCS file:
/pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-hello.el,v
retrieving revision 1.6
diff -u -u -r1.6 xlib-hello.el
--- lisp/xlib-hello.el 16 Dec 2004 07:49:09 -0000 1.6
+++ lisp/xlib-hello.el 1 Jan 2005 04:35:22 -0000
@@ -5,7 +5,7 @@
;; Author: Eric M. Ludlam <zappo@xxxxxxxxxxxxxx>
;; Modified: Zajcev Evgeny <zevlg@xxxxxxxxx>
;; Keywords: xlib
-;; X-CVS: $Id: xlib-hello.el,v 1.6 2004/12/16 07:49:09 youngs Exp $
+;; X-CVS: $Id: xlib-hello.el,v 1.5 2004/11/29 19:48:18 lg Exp $
;; This file is part of XWEM.
@@ -38,9 +38,7 @@
;;; Code:
-(eval-when-compile
- (require 'xlib-xlib))
-(require 'xpm-button)
+(require 'xlib-xpm)
(defconst XH-event-mask
(Xmask-or XM-Exposure XM-StructureNotify XM-KeyPress XM-KeyRelease
@@ -173,6 +171,7 @@
"Show 'Press Me' button."
(unless XH-buttons
;; Fill
+ (require 'xpm-button)
(let ((buts (xpm-button-create "Press Me" 2 "green4" "#a0d0a0")))
(setq XH-buttons
(mapcar (lambda (but)
@@ -187,6 +186,7 @@
(defun XH-show-close-button (dpy win x y &optional state)
"Show 'Dismiss' button."
(unless XH-close-buttons
+ (require 'xpm-button)
(let ((buts (xpm-button-create "Dismiss" 4 "Red4" "gray80")))
(setq XH-close-buttons
(mapcar (lambda (but)
Index: lisp/xlib-img.el
===================================================================
RCS file:
/pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-img.el,v
retrieving revision 1.3
diff -u -u -r1.3 xlib-img.el
--- lisp/xlib-img.el 16 Dec 2004 07:49:09 -0000 1.3
+++ lisp/xlib-img.el 1 Jan 2005 04:35:22 -0000
@@ -5,7 +5,7 @@
;; Author: Zajcev Evgeny <zevlg@xxxxxxxxx>
;; Created: Fri Dec 12 11:22:19 MSK 2003
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-img.el,v 1.3 2004/12/16 07:49:09 youngs Exp $
+;; X-CVS: $Id: xlib-img.el,v 1.2 2004/11/29 19:48:18 lg Exp $
;; This file is part of XWEM.
@@ -32,8 +32,8 @@
;;; Code:
+(require 'xlib-xlib)
-;;;###autoload
(defstruct (X-Image (:predicate X-Image-isimage-p))
width
height
@@ -56,7 +56,20 @@
get-pixel
put-pixel
add-pixel
- destroy-image)
+ destroy-image
+
+ plist) ; user defined plist
+
+;; Plist ops
+(defsubst X-Image-put-prop (ximg prop val)
+ (setf (X-Image-plist ximg)
+ (plist-put (X-Image-plist ximg) prop val)))
+(put 'X-Image-put-prop 'lisp-indent-function 2)
+(defsubst X-Image-get-prop (ximg prop)
+ (plist-get (X-Image-plist ximg) prop))
+(defsubst X-Image-rem-prop (ximg prop)
+ (setf (X-Image-plist ximg)
+ (plist-remprop (X-Image-plist ximg) prop)))
(defconst X:X-low-bits-table
(vconcat (mapcar (lambda (el)
@@ -157,15 +170,14 @@
(setf (X-Image-put-pixel img) 'X:XPutPixel)))
img))
-;;;###autoload
(defun XCreateImage (xdpy visual depth format offset data width height xpad
image-bytes-per-line)
"Create new image."
(let (img)
(if (or (= depth 0)
(> depth 32)
- (not (member format (list X-XYBitmap X-XYPixmap X-ZPixmap)))
+ (not (memq format (list X-XYBitmap X-XYPixmap X-ZPixmap)))
(and (= format X-XYBitmap) (not (= depth 1)))
- (not (member xpad (list 8 16 32)))
+ (not (memq xpad '(8 16 32)))
(< offset 0)
(< image-bytes-per-line 0))
nil ; invalid parameter
@@ -203,16 +215,45 @@
(X:XInitImageFuncs img)
img)))
-;;;###autoload
(defun XDestroyImage (img)
"Destroy image IMG."
(X-invalidate-cl-struct img))
-;;;###autoload
+(defun XImageGet (xdpy d x y width height)
+ "On display XDPY and drawable D get image with geom +X+Y+WIDTHxHEIGHT."
+ (let* ((xdata-1 (XGetImage xdpy d x y width height X-AllPlanes X-ZPixmap))
+ (xdata (and (car xdata-1) (nth 4 xdata-1)))
+ (tlen (length xdata))
+ (coff 0)
+ tline ex-mcc ximg)
+
+ ;; Create data for XIMG
+ (while (< coff tlen)
+ (setq tline (cons (string2->number (substring xdata coff (+ coff 2)))
tline))
+ (setq coff (+ coff 2))
+ (when (= (length tline) width)
+ (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) ""))
+ ex-mcc))
+
+ (setq ximg (XCreateImage xdpy nil (XDefaultDepth xdpy)
+ X-ZPixmap 0 xdata width height
+ (X-Dpy-bitmap-scanline-pad xdpy) 1))
+ ;; Save pixels layout
+ (X-Image-put-prop ximg 'px-layout ex-mcc)
+ ximg))
+
+;; Testing (XImageGet (xwem-dpy) (xwem-cl-xwin (xwem-cl-selected)) 40 10 100
100)
+;; (XImagePut (xwem-dpy) (XDefaultGC (xwem-dpy)) (xwem-frame-xwin (nth
1 xwem-frames-list)) 30 40 ximg)
+
(defun XImagePut (xdpy gc d x y ximg)
"On display XDPY and drawable D at X Y put an XIMG."
(let (data left-pad)
- (setq data (mapconcat 'identity (X-Image-data ximg) ""))
+ (unless (stringp (X-Image-data ximg))
+ (setq data (mapconcat 'identity (X-Image-data ximg) "")))
(if (or (= (X-Image-bits-per-pixel ximg) 1)
(not (= (X-Image-format ximg) X-ZPixmap)))
Index: lisp/xlib-keysymdb.el
===================================================================
RCS file: lisp/xlib-keysymdb.el
diff -N lisp/xlib-keysymdb.el
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ lisp/xlib-keysymdb.el 1 Jan 2005 04:35:22 -0000
@@ -0,0 +1,321 @@
+;;; xlib-keysymdb.el --- XKeysymDB for xlib.
+
+;; Copyright (C) 2004 by Free Software Foundation, Inc.
+
+;; Author: Zajcev Evgeny <zevlg@xxxxxxxxx>
+;; Created: Tue Dec 7 20:23:10 MSK 2004
+;; Keywords: xlib
+;; X-CVS: $Id: xlib-keysymdb.el,v 1.1 2004/12/08 04:39:36 youngs Exp $
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or mo
+ (XF86Mail . #x1008FF19)
+ (XF86Start . #x1008FF1A)
+ (XF86Search . #x1008FF1B)
+ (XF86AudioRecord . #x1008FF1C)
+ (XF86Calculator . #x1008FF1D)
+ (XF86Memo . #x1008FF1E)
+ (XF86ToDoList . #x1008FF1F)
+ (XF86Calendar . #x1008FF20)
+ (XF86PowerDown . #x1008FF21)
+ (XF86ContrastAdjust . #x1008FF22)
+ (XF86RockerUp . #x1008FF23)
+ (XF86RockerDown . #x1008FF24)
+ (XF86RockerEnter . #x1008FF25)
+ (XF86Back . #x1008FF26)
+ (XF86Forward . #x1008FF27)
+ (XF86Stop . #x1008FF28)
+ (XF86Refresh . #x1008FF29)
+ (XF86PowerOff . #x1008FF2A)
+ (XF86WakeUp . #x1008FF2B)
+ (XF86Eject . #x1008FF2C)
+ (XF86ScreenSaver . #x1008FF2D)
+ (XF86WWW . #x1008FF2E)
+ (XF86Sleep . #x1008FF2F)
+ (XF86Favorites . #x1008FF30)
+ (XF86AudioPause . #x1008FF31)
+ (XF86AudioMedia . #x1008FF32)
+ (XF86MyComputer . #x1008FF33)
+ (XF86VendorHome . #x1008FF34)
+ (XF86LightBulb . #x1008FF35)
+ (XF86Shop . #x1008FF36)
+ (XF86History . #x1008FF37)
+ (XF86OpenURL . #x1008FF38)
+ (XF86AddFavorite . #x1008FF39)
+ (XF86HotLinks . #x1008FF3A)
+ (XF86BrightnessAdjust . #x1008FF3B)
+ (XF86Finance . #x1008FF3C)
+ (XF86Community . #x1008FF3D)
+;;! Allocate 1008FF3E-F next
+
+ (XF86Launch0 . #x1008FF40)
+ (XF86Launch1 . #x1008FF41)
+ (XF86Launch2 . #x1008FF42)
+ (XF86Launch3 . #x1008FF43)
+ (XF86Launch4 . #x1008FF44)
+ (XF86Launch5 . #x1008FF45)
+ (XF86Launch6 . #x1008FF46)
+ (XF86Launch7 . #x1008FF47)
+ (XF86Launch8 . #x1008FF48)
+ (XF86Launch9 . #x1008FF49)
+ (XF86LaunchA . #x1008FF4A)
+ (XF86LaunchB . #x1008FF4B)
+ (XF86LaunchC . #x1008FF4C)
+ (XF86LaunchD . #x1008FF4D)
+ (XF86LaunchE . #x1008FF4E)
+ (XF86LaunchF . #x1008FF4F)
+
+ (usldead_acute . #x100000A8)
+ (usldead_grave . #x100000A9)
+ (usldead_diaeresis . #x100000AB)
+ (usldead_asciicircum . #x100000AA)
+ (usldead_asciitilde . #x100000AC)
+ (usldead_cedilla . #x1000FE2C)
+ (usldead_ring . #x1000FEB0)])
+
+(defconst x-XKeysymDB-length 245)
+
+(defun X-XKeysymDB-sym->keysym (sym)
+ "Lookup SYM in keysym db."
+ (let ((i 0)
+ (ret nil))
+ (while (< i x-XKeysymDB-length)
+ (when (eq (car (aref x-XKeysymDB i)) sym)
+ (setq ret (aref x-XKeysymDB i)
+ i x-XKeysymDB-length))
+ (incf i))
+ (cdr ret)))
+
+(defun X-XKeysymDB-keysym->sym (keysym)
+ "Lookup KEYSIM in keysym db."
+ (let ((i 0)
+ (ret nil))
+ (while (< i x-XKeysymDB-length)
+ (when (= (cdr (aref x-XKeysymDB i)) keysym)
+ (setq ret (aref x-XKeysymDB i)
+ i x-XKeysymDB-length))
+ (incf i))
+ (car ret)))
+
+(provide 'xlib-keysymdb)
+
+;;; xlib-keysymdb.el ends here
Index: lisp/xlib-math.el
===================================================================
RCS file:
/pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-math.el,v
retrieving revision 1.6
diff -u -u -r1.6 xlib-math.el
--- lisp/xlib-math.el 16 Dec 2004 07:49:09 -0000 1.6
+++ lisp/xlib-math.el 1 Jan 2005 04:35:22 -0000
@@ -5,7 +5,7 @@
;; Author: Eric M. Ludlam <zappo@xxxxxxxxxxxxxx>
;; Modified: Zajcev Evgeny <zevlg@xxxxxxxxx>
;; Keywords: xlib, xwem
-;; X-RCS: $Id: xlib-math.el,v 1.6 2004/12/16 07:49:09 youngs Exp $
+;; X-RCS: $Id: xlib-math.el,v 1.5 2004/11/29 19:48:19 lg Exp $
;; This file is part of XWEM.
@@ -34,12 +34,12 @@
;;
;;; Code:
-;;;###autoload
+
+
(defmacro Xtruncate (val)
"Do a safe truncate of VAL that might be larger than MAXINT."
`(truncate (if ,val (mod ,val 65536) 0)))
-;;;###autoload
(defmacro XCharacter (val)
"Convert VAL (a float) into a truncated character value."
(if (fboundp 'int-to-char)
@@ -49,7 +49,6 @@
(list 'logand (list 'truncate (list 'mod val 65536)) 255)
(list 'truncate (list 'mod val 65536)))))
-;;;###autoload
(defmacro Xforcenum (val)
"Force VAL (a character) to be a number.
This macro forces XEmacs 20.3 to behave."
@@ -65,7 +64,6 @@
"Convert STRING characters into an integer and return."
(string->int string))
-;;;###autoload
(defun int->string (num)
"Convert NUM into a 2 byte string in network order and return."
(setq num (truncate num))
@@ -73,17 +71,14 @@
(h (ash (mod num 65536) -8))) ;upper byte
(concat (char-to-string l) (char-to-string h))))
-;;;###autoload
(defalias 'int->string2 'int->string)
-;;;###autoload
(defun string->int (string)
"Convert STRING 1st two characters into an integer and return."
(let ((l (aref string 0))
(h (if (> (length string) 1) (aref string 1) 0)))
(+ l (ash h 8))))
-;;;###autoload
(defun int->string4 (num)
"Convert NUM (a float or int) into a 4 byte network order string."
(if (integerp num)
@@ -104,7 +99,6 @@
(setq tmp (/ tmp (float 256)))
(setq ts (concat ts (char-to-string (XCharacter tmp)))))))
-;;;###autoload
(defun string4->int (string)
"Convert STRING 1st four characters into a float and return."
;; do nothing yet until we know what we need to do.
@@ -113,12 +107,10 @@
(* (float (Xforcenum (aref string 2))) 256 256)
(* (float (Xforcenum (aref string 3))) 256 256 256)))
-;;;###autoload
(defun string2->number (string)
"Convert 2 first bytes in STRING to number."
(string->int string))
-;;;###autoload
(defun string4->number (string)
"Convert 4 first bytes in STRING to number.
NOTE: Use `string4->int' when overflow may occur."
@@ -127,7 +119,6 @@
(lsh (Xforcenum (aref string 2)) 16)
(lsh (Xforcenum (aref string 3)) 24)))
-;;;###autoload
(defun int->string3 (num)
"Convert 3 first bytes in STRING to integer."
(string (logand num 255)
@@ -186,8 +177,6 @@
(defun int32->string (int32)
)
-
-;;;###autoload
(defun X-pad (number)
"Return a number which is the padding for an X message of length NUMBER."
(% (- 4 (% number 4)) 4))
@@ -205,7 +194,6 @@
;; We won't implement the whole set, just the functionality we need
;; to make the checks we want.
;;
-;;;###autoload
(defun Xmask (pos)
"Create a mask with a bit set in position POS.
This routine will not work for position 32 and up because we sim
@@ -216,7 +204,6 @@
(* (float (lsh 1 pos)) (float 65536)) ;push into high byte
))
-;;;###autoload
(defun Xmask-and (val &rest args)
"Logically `and' VAL and MASK together.
They are floats to be broken down into two two byte ints.
@@ -232,7 +219,6 @@
(* (float (logand hv hm)) 65536))))))
val)
-;;;###autoload
(defun Xmask-or (val &rest args)
"Logically or VAL and MASK together.
They are floats to be broken down into two two byte ints.
@@ -248,7 +234,6 @@
(* (float (logior hv hm)) 65536))))))
val)
-;;;###autoload
(defun Xtest (val flag)
"Test value of bytes VAL for presence of FLAG.
Return t if it exists, nil otherwise."
@@ -284,7 +269,6 @@
(setq cnt (1- cnt)))
s))
-;;;###autoload
(defun Xmask-string (mask)
"Convert MASK into a string of 0s and 1s."
(let ((lv (Xtruncate mask))
@@ -297,7 +281,6 @@
(let ((s (format "%x" mask)))
(if fill (substring (concat "0000" s) (length s)) s)))
-;;;###autoload
(defun Xmask-hex-string (mask)
"Convert MASK into a hexidecimal string."
(let ((lv (Xtruncate mask))
@@ -306,6 +289,7 @@
(Xmask-int-hex-string hv)
(Xmask-int-hex-string lv (/= hv 0)))))
+
(provide 'xlib-math)
;;; xmath.el ends here
Index: lisp/xlib-testing.el
===================================================================
RCS file: lisp/xlib-testing.el
diff -N lisp/xlib-testing.el
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ lisp/xlib-testing.el 1 Jan 2005 04:35:22 -0000
@@ -0,0 +1,177 @@
+;;; xlib-testing.el --- Testing suite for xlib.
+
+;; Copyright (C) 2004 by Free Software Foundation, Inc.
+
+
+ (XDrawSegments xt-dpy (XDefaultRootWindow xt-dpy) xt-tmp-res (list (cons
'(100 . 0) '(50 . 10))
+ (cons '(100 . 100) '(50 . 90))))
+ (XDrawArc xt-dpy (XDefaultRootWindow xt-dpy) xt-tmp-res 50 50 20 20 0 360)
+ (XFillArc xt-dpy (XDefaultRootWindow xt-dpy) xt-tmp-res 55 55 10 10 0 360)
+ (XFlush xt-dpy)
+ 'ok)
+
+(defun xt-XErrorHandling ()
+ (XGetWMName xt-dpy (make-X-Win :id 77777.0))
+ (XFlush xt-dpy)
+ 'ok)
+
+;;;###autoload
+(defun xt-check-xlib ()
+ "Interactively check xlib."
+ (interactive)
+
+ (setq xt-dpy-host
+ (read-string "XT Host [127.0.0.1:0]: "))
+ (when (string= xt-dpy-host "")
+ (setq xt-dpy-host "127.0.0.1:0"))
+
+ (with-current-buffer (get-buffer-create "*xt-check-xlib*")
+ (erase-buffer)
+ (display-buffer (current-buffer))
+
+ (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")))
+ xt-test-routines))
+ (insert "<=== DONE at " (format-time-string "%R %S")
+ "\n")))
+
+
+(provide 'xlib-testing)
+
+;;; xlib-testing.el ends here
Index: lisp/xlib-tray.el
===================================================================
RCS file:
/pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-tray.el,v
retrieving revision 1.6
diff -u -u -r1.6 xlib-tray.el
--- lisp/xlib-tray.el 16 Dec 2004 07:49:09 -0000 1.6
+++ lisp/xlib-tray.el 1 Jan 2005 04:35:22 -0000
@@ -5,7 +5,7 @@
;; Author: Zajcev Evgeny <zevlg@xxxxxxxxx>
;; Created: Tue Dec 9 14:14:07 MSK 2003
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-tray.el,v 1.6 2004/12/16 07:49:09 youngs Exp $
+;; X-CVS: $Id: xlib-tray.el,v 1.5 2004/11/29 19:48:19 lg Exp $
;; This file is part of XWEM.
@@ -32,8 +32,7 @@
;;; Code:
-(eval-when-compile
- (require 'xlib-xlib))
+(require 'xlib-xlib)
;;; Constants
(defconst X-Tray-dock-req 0 "Dock place request.")
@@ -51,7 +50,6 @@
;;; Functions
-;;;###autoload
(defun XTrayInit (xdpy win)
"Initialize atoms for interaction with system tray."
(let ((atoms (make-vector 10 nil)))
@@ -132,10 +130,10 @@
(defun XTrayHandleEvent (xdpy win xev)
(X-Event-CASE xev
(:X-ClientMessage
- (X-Dpy-log xdpy "TRAY!!!!!!!! client message\n"))
+ (X-Dpy-log xdpy 'x-tray "got client message"))
(:X-PropertyNotify
- (X-Dpy-log xdpy "TRAY!!!!!!!! property notify\n"))))
+ (X-Dpy-log xdpy 'x-tray "got property notify"))))
(defun XTraySendMessage (xdpy dock win opcode msg)
(let ((id 1234)) ; TODO: should be unique
Index: lisp/xlib-version.el
===================================================================
RCS file: lisp/xlib-version.el
diff -N lisp/xlib-version.el
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ lisp/xlib-version.el 1 Jan 2005 04:35:22 -0000
@@ -0,0 +1,5 @@
+;;; Automatically generated file -- DO NOT EDIT OR DELETE
+;;;###autoload
+(defconst xlib-version
+ "lg@xxxxxxxxxxxxxx/xlib--main--2.0--version-0")
+(provide 'xlib-version)
Index: lisp/xlib-vidmode.el
===================================================================
RCS file:
/pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-vidmode.el,v
retrieving revision 1.3
diff -u -u -r1.3 xlib-vidmode.el
--- lisp/xlib-vidmode.el 16 Dec 2004 07:49:10 -0000 1.3
+++ lisp/xlib-vidmode.el 1 Jan 2005 04:35:22 -0000
@@ -5,7 +5,7 @@
;; Author: Zajcev Evgeny <zevlg@xxxxxxxxx>
;; Created: Fri Jan 16 18:39:44 MSK 2004
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-vidmode.el,v 1.3 2004/12/16 07:49:10 youngs Exp $
+;; X-CVS: $Id: xlib-vidmode.el,v 1.2 2004/11/29 19:48:19 lg Exp $
;; This file is part of XWEM.
@@ -29,8 +29,10 @@
;;; Commentary:
;;
-
;;; Code:
+
+(require 'xlib-xlib)
+
(defconst X-XF86VidMode-major 2 "Major version of VidMode extension.")
(defconst X-XF86VidMode-minor 1 "Minor version of VidMode extension.")
Index: lisp/xlib-xc.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xc.el,v
retrieving revision 1.5
diff -u -u -r1.5 xlib-xc.el
--- lisp/xlib-xc.el 16 Dec 2004 07:49:10 -0000 1.5
+++ lisp/xlib-xc.el 1 Jan 2005 04:35:23 -0000
@@ -5,7 +5,7 @@
;; Author: Zajcev Evgeny <zevlg@xxxxxxxxx>
;; Created: 18 October 2003
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-xc.el,v 1.5 2004/12/16 07:49:10 youngs Exp $
+;; X-CVS: $Id: xlib-xc.el,v 1.4 2004/11/29 19:48:19 lg Exp $
;; X-URL: http://lgarc.narod.ru/xwem/index.html
;; This file is part of XWEM.
@@ -35,13 +35,19 @@
(eval-when-compile
(require 'cl)
- (require 'xlib-math)
- (require 'xlib-xwin))
+
+ (mapc (lambda (el)
+ (autoload el "xlib-xwin"))
+ '(X-Win-event-handlers X-Win-EventHandler-runall make-X-Rect
+ X-Win-find-or-make X-Atom-find-or-make X-Win-p))
+ )
+
+(require 'xlib-math)
+(require 'xlib-const)
(defvar X-Dpy-dpys-list nil
"List of all opened displays.")
-;;;###autoload
(defstruct X-Visual
id
class
@@ -51,12 +57,10 @@
green-mask
blue-mask)
-;;;###autoload
(defstruct X-Depth
depth
visuals) ; List of X-Visual
-;;;###autoload
(defstruct X-Screen
dpy ; display
root ; Root window
@@ -75,13 +79,11 @@
depths ; List of X-Depth
)
-;;;###autoload
(defstruct X-ScreenFormat
depth
bits-per-pixel
scanline-pad)
-
-;;;###autoload
+
(defstruct (X-Dpy (:predicate X-Dpy-isxdpy-p))
proc ; process, which holds X connection
log-buffer ; buffer for logs, when debugging is
non-nil
@@ -89,8 +91,11 @@
;; Protecting section
(readings 0) ; non-zero mean we are in reading mode
- (evq nil) (evq-protects 0) ; eventing, events queue and queue
protects counter
- (snd-buf "") (snd-protects 0) ; for `X-Dpy-send-excursion'
+ evq ; saved events queue, normally should
be nil
+
+ snd-queue ; Send queue, each call to
+ ; `X-Dpy-send' adds data to
+ ; this queue
(parse-guess-dispatcher 'X-Dpy-parse-message-guess)
(events-dispatcher 'X-Dpy-default-events-dispatcher)
@@ -128,23 +133,17 @@
extensions ; list of extensions
)
-;;;###autoload
-(defmacro X-Dpy-reqseq (xdpy)
- "Extract least significant 16bit from request sequenc id in XDPY."
- `(logand (X-Dpy-rseq-id ,xdpy) 65535))
-
-;;;###autoload
(defmacro X-Dpy-put-property (xdpy prop val)
"Put property PROP with value VAL in XDPY's properties list."
`(setf (X-Dpy-properties ,xdpy)
(plist-put (X-Dpy-properties ,xdpy) ,prop ,val)))
-;;;###autoload
(defmacro X-Dpy-get-property (xdpy prop)
"Get property PROP from XDPY's properties list."
`(plist-get (X-Dpy-properties ,xdpy) ,prop))
-;;;###autoload
+(defsetf X-Dpy-get-property X-Dpy-put-property)
+
(defmacro X-Dpy-rem-property (xdpy prop)
"Remove property PROP from XDPY's properties list."
`(setf (X-Dpy-properties ,xdpy) (plist-remprop (X-Dpy-properties ,xdpy)
,prop)))
@@ -177,7 +176,6 @@
(X-EventHandler-runall (X-Dpy-event-handlers dpy) xev))
;; Formats operations
-;;;###autoload
(defun X-formatfind (xdpy depth)
"On display XDPY find proper X-ScreenFormat for gived DEPTH."
(let ((formats (X-Dpy-formats xdpy)))
@@ -186,7 +184,6 @@
(car formats)))
-;;;###autoload
(defun X-formatint (xdpy depth num)
"On display XDPY convert NUM to string."
(let ((fmt (X-formatfind xdpy depth))
@@ -198,7 +195,6 @@
(setq cfun (intern (format "int->string%d" bpp)))
(funcall cfun num))))
-;;;###autoload
(defun X-formatpad (xdpy depth str)
"Return padded STR."
(let ((fmt (X-formatfind xdpy depth))
@@ -213,7 +209,6 @@
(concat str
(make-string (% (- bp (% (length str) bp)) bp) ?\x00)))))
-;;;###autoload
(defun X-Dpy-p (xdpy &optional sig)
"Return non-nil if XDPY is X display.
If SIG is given and XDPY is not X display, SIG will be signaled."
@@ -222,7 +217,6 @@
(signal 'wrong-type-argument (list sig 'X-Dpy-p xdpy))
isdpy)))
-;;;###autoload
(defun X-Dpy-get-id (xdpy)
"Get id to be used on X display XDPY."
(X-Dpy-p xdpy 'X-Dpy-get-id)
@@ -247,7 +241,6 @@
(Xmask-or newword servbase))) ;return the id with base attached
;;; Process functions
-;;;###autoload
(defun X-Dpy-create-connection (dname dnum)
"Create X connection to display with name DNAME and number DNUM."
@@ -291,26 +284,47 @@
(setq X-Dpy-dpys-list (delq xdpy X-Dpy-dpys-list))))
-;;;###autoload
(defun X-Dpy-close (xdpy)
"Close connection associated with XDPY."
(X-Dpy-p xdpy 'X-Dpy-close)
+ (X-Dpy-send-flush xdpy)
(X-Dpy-sentinel (X-Dpy-proc xdpy)))
;; Logging
-;;;###autoload
-(defun X-Dpy-log (xdpy &rest args)
- "Put a message in the in the log buffer specified by XDPY.
+;; Supported routines are:
+;; x-display - display related
+;; x-error - X Errors related
+;; x-event - X Event related
+;; x-tray - X tray related
+;; x-misc - Misc stuff
+;; x-record - RECORD extension
+
+(defun X-Dpy-set-log-routines (xdpy routines)
+ "Set XDPY's log routines to ROUTINES."
+ (X-Dpy-put-property xdpy 'log-routines routines))
+
+(defun X-Dpy-get-log-routines (xdpy)
+ "Return XDPY's log routines."
+ (X-Dpy-get-property xdpy 'log-routines))
+
+(defun X-Dpy-has-log-routine-p (xdpy routine)
+ "Return non-nil if XDPY has log ROUTINE."
+ (memq routine (X-Dpy-get-log-routines xdpy)))
+
+(defun X-Dpy-log (xdpy routine &rest args)
+ "Put a ROUTINE's message in the in the log buffer specified by XDPY.
If XDPY is nil, then put into current buffer. Log additional ARGS as well."
(X-Dpy-p xdpy 'X-Dpy-log)
(when (and (X-Dpy-log-buffer xdpy)
+ (X-Dpy-has-log-routine-p xdpy routine)
(bufferp (get-buffer-create (X-Dpy-log-buffer xdpy))))
(with-current-buffer (get-buffer-create (X-Dpy-log-buffer xdpy))
- (goto-char (point-min))
- (insert (format "%d: " (nth 1 (current-time))))
- (insert (apply 'format (mapcar (lambda (arg) (eval arg)) args))))
- ))
+ (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 "\n")))))
(defun X-Dpy-log-verbatim (xdpy arg)
(X-Dpy-p xdpy 'X-Dpy-log-verbatim)
@@ -322,78 +336,51 @@
))
;;; Sending/receiving functions
-;;;###autoload
-(defun X-Dpy-send-flush (xdpy s)
- "Just send S to display XDPY. Do not increase rseq-id."
- (X-Dpy-p xdpy 'X-Dpy-send-flush)
-
- (when (not (stringp s))
- (signal 'wrong-type-argument '(X-Dpy-send-flush stringp s)))
-
- (process-send-string (X-Dpy-proc xdpy) s))
+(defun X-Dpy-send-flush (xdpy)
+ "Send XDPY's send buffer to X server."
+ (process-send-string (X-Dpy-proc xdpy)
+ (mapconcat 'identity (nreverse (X-Dpy-snd-queue xdpy))
""))
+ (setf (X-Dpy-snd-queue xdpy) nil))
-;;;###autoload
(defun X-Dpy-send (xdpy s)
"Send the X server DPY the string S. Increase request id rseq-id.
There is special mode when we are collecting X output to send it all at once."
- (X-Dpy-p xdpy 'X-Dpy-send)
-
- (when (not (stringp s))
- (signal 'wrong-type-argument '(X-Dpy-send stringp s)))
-
- (unwind-protect
- (if (> (X-Dpy-snd-protects xdpy) 0)
- (setf (X-Dpy-snd-buf xdpy) (concat (X-Dpy-snd-buf xdpy) s))
-
- (process-send-string (X-Dpy-proc xdpy) s))
-
- ;; increase request sequence number
- (incf (X-Dpy-rseq-id xdpy))))
-
-;;;###autoload
-(defun X-Dpy-send-read (xdpy s rf)
- "Send S to display XDPY and receive answer according to receive fields RF."
- (X-Dpy-p xdpy 'X-Dpy-send-read)
-
- (when (not (stringp s))
- (signal 'wrong-type-argument '(X-Dpy-send-read stringp s)))
-
- (let (rval)
- (X-Dpy-read-excursion xdpy
- ;; Flush output buffer
- (X-Dpy-send-flush xdpy (X-Dpy-snd-buf xdpy))
- (setf (X-Dpy-snd-buf xdpy) "")
-
- (process-send-string (X-Dpy-proc xdpy) s)
- (unwind-protect
- (setq rval (X-Dpy-parse-message rf nil xdpy))
-
- ;; increase request sequence number
- (incf (X-Dpy-rseq-id xdpy))))
- rval))
+ (setf (X-Dpy-snd-queue xdpy)
+ (cons s (X-Dpy-snd-queue xdpy)))
+ (enqueue-eval-event 'X-Dpy-send-flush xdpy)
+ ;; 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 "Get event: %S, for win: %S\n" '(X-Event-name xev)
+ (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)
- (if (X-Win-event-handlers win)
- ;; WIN has its own event handlers
- (X-Win-EventHandler-runall win xev)
-
- ;; Otherwise try common handlers
- (when (X-Dpy-event-handlers xdpy)
- (X-Dpy-EventHandler-runall xdpy xev)
- ))))
+ ;; 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."
+ ;; This is an annoying XEmacs problem To bad it slows down
+ ;; Emacs too.
+ (if (fboundp 'characterp)
+ (list 'if (list 'characterp maybechar)
+ (list 'setq maybechar (list 'char-to-int maybechar)))))
+
(defconst X-byte-order ?l "Byte order used by emacs X. B MSB, l LSB.")
(defconst X-protocol-minor-version 0 "Minor version of client.")
(defconst X-protocol-major-version 11 "Major version of client.")
-;;;###autoload
(defconst X-client-to-open
(list [1 X-byte-order]
[1 0] ;unused
@@ -406,15 +393,6 @@
)
"XStruct list of sizes when opening a connection.")
-(defmacro X-Force-char-num (maybechar)
- "Force MAYBECHAR to be a number for XEmacs platform."
- ;; This is an annoying XEmacs problem To bad it slows down
- ;; Emacs too.
- (if (fboundp 'characterp)
- (list 'if (list 'characterp maybechar)
- (list 'setq maybechar (list 'char-to-int maybechar)))))
-
-;;;###autoload
(defun X-Create-message (message-s &optional pad-notneed)
"Takes the MESSAGE-S structure and builds a net string.
MESSAGE-S is a list of vectors and symbols which formulate the message
@@ -497,6 +475,284 @@
(setq news (concat news (substring s 0 (- 4 (% (length news) 4)))))))
news))
+;;;; NEW stuff, X types declarations
+
+;; Not yet workable.
+
+;; Why is this needed? Gives flexibility in implementing and
+;; accessing X server and its resources.
+
+;; Autogenerator can be written, which will generate types according
+;; to proto.TXT or other papers.
+
+(defmacro define-X-type (type type-description)
+ "Define new X value type.
+TYPE-DESCRIPTION is list where car of it is one of:
+
+ `type' - Specifies static type, next values are - LENGTH
+ VALUE-PACKER VALUE-EXTRACTOR.
+
+ `resource' - Specifies some resource which has PREDICATE and
+ ID-EXTRACTOR functions.
+
+ `alias' - Alias to some already defined type.
+
+ `enum' - for use by SETofXXXX types.
+
+ `struct' - Define stucture.
+
+ `or' - One of other type.
+"
+ `(put (quote ,type) 'X-type-description ,type-description))
+
+(defun X-type-pack (dpy type val)
+ (let* ((xtd (or (and (listp type) type)
+ (get type 'X-type-description)))
+ (xt (car xtd)))
+ (cond ((and (eq xt 'resource) (funcall (cadr xtd) val))
+ (int32->string (funcall (caddr xtd) val)))
+
+ ((eq xt 'type)
+ (funcall (caddr xtd) val))
+
+ ((and (eq xt 'enum) (memq val (cddr xtd)))
+ (int->string val))
+
+ ((eq xt 'alias)
+ (X-type-pack dpy (cadr xtd) val))
+
+ ((eq xt 'listof)
+ (mapconcat (lambda (el)
+ (X-type-pack dpy (cadr xtd) el))
+ val ""))
+
+ ((eq xt 'setof)
+ (funcall (cond ((= (cadr xtd) 1) 'int->string1)
+ ((= (cadr xtd) 2) 'int->string2)
+ ((= (cadr xtd) 4) 'int->string4))
+ (apply 'Xmask-or val)))
+
+ ((eq xt 'struct)
+ (mapconcat (lambda (tt)
+ (X-type-pack dpy (cdr tt) (funcall (car tt) val)))
+ (cddr xt) ""))
+
+ ((eq xt 'or)
+ (setq xt (cdr xt))
+ (let (orval)
+ (while (and xt (not orval))
+ (setq orval (X-type-pack dpy (car xt) val)
+ xt (cdr xt)))
+ orval)))))
+
+(defun X-type-extract (dpy type &optional llen)
+ (let* ((xtd (or (and (listp type) type)
+ (get type 'X-type-description)))
+ (xt (car xtd)))
+ (cond ((eq xt 'resource)
+ (funcall (cadddr xtd) dpy (string->int32 (X-Dpy-grab-bytes dpy 4))))
+
+ ((eq xt 'type)
+ (funcall (cadddr xtd) (X-Dpy-grab-bytes dpy (cadr xtd))))
+
+ ((eq xt 'enum)
+ (string->int (X-Dpy-grab-bytes dpy (cadr xtd))))
+
+ ((eq xt 'alias)
+ (X-type-extract dpy (cadr xtd)))
+
+ ((eq xt 'listof)
+ (when (numberp llen)
+ (let (rval)
+ (while (> llen 0)
+ (setq rval (X-type-extract dpy (cadr xtd)))
+ (decf llen))
+ rval)))
+
+ ((eq xt 'setof)
+ (let ((smask (funcall (cond ((= (cadr xtd) 1) 'string1->int)
+ ((= (cadr xtd) 2) 'string->int)
+ ((= (cadr xtd) 4) 'string4->int))
+ (X-Dpy-grab-bytes dpy (cadr xtd))))
+ (dd (get (caddr xtd) 'X-type-description))
+ (cmask 1)
+ rval)
+ (when (eq (car dd) 'enum)
+ (setq dd (cddr dd))
+ (while dd
+ (when (Xtest smask cmask)
+ (setq rval (cons (car dd) rval)))
+ (setq cmask (lsh cmask 1)
+ dd (cdr dd))))
+ rval))
+
+ ((eq xt 'struct)
+ (let ((rval (funcall (cadr xtd))))
+ (mapc (lambda (tt)
+ (eval `(setf (,(car tt) rval) (X-type-extract dpy ,(cdr
tt)))))
+ (cdr xtd))
+ rval)))))
+
+;; Add some built-in types
+(define-X-type WINDOW '(resource X-Win-p X-Win-id X-Win-find-or-make))
+(define-X-type PIXMAP '(resource X-Pixmap-p X-Pixmap-id X-Pixmap-find-or-make))
+(define-X-type CURSOR '(resource X-Cursor-p X-Cursor-id X-Cursor-find-or-make))
+(define-X-type FONT '(resource X-Font-p X-Font-id X-Font-find))
+(define-X-type GCONTEXT '(resource X-Gc-p X-Gc-id ignore))
+(define-X-type COLORMAP '(resource X-Colormap-p X-Colormap-id))
+(define-X-type DRAWABLE '(or WINDOW PIXMAP))
+(define-X-type FONTABLE '(or FONT GCONTEXT))
+(define-X-type ATOM '(resource X-Atom-p X-Atom-id X-Atom-find-or-make))
+(define-X-type VISUALID '(resource X-Visual-p X-Visual-id ignore))
+(define-X-type BYTE '(type 1 char-to-string string-to-char))
+(define-X-type INT8 '(type 1 x-int8->string x-string->int8))
+(define-X-type INT16 '(type 2 x-int16->string x-string->int16))
+(define-X-type INT32 '(type 4 x-int32->string x-string->int32))
+(define-X-type CARD8 '(type 1 x-card8->string x-string->card8))
+(define-X-type CARD16 '(type 2 x-card16->string x-string->card16))
+(define-X-type CARD32 '(type 4 x-card32->string x-string->card32))
+(define-X-type TIMESTAMP '(alias CARD32))
+(define-X-type BITGRAVITY (list 'enum 1
+ X-ForgetGravity X-StaticGravity
X-NorthWestGravity
+ X-NorthGravity X-NorthEastGravity
X-WestGravity
+ X-CenterGravity X-EastGravity
X-SouthWestGravity
+ X-SouthGravity X-SouthEastGravity))
+(define-X-type WINGRAVITY (list 'enum 1
+ X-UnmapGravity X-StaticGravity
X-NorthWestGravity
+ X-NorthGravity X-NorthEastGravity
X-WestGravity
+ X-CenterGravity X-EastGravity
X-SouthWestGravity
+ X-SouthGravity X-SouthEastGravity))
+(define-X-type BOOL (list 'enum 1 X-True X-False))
+(define-X-type EVENT (list 'enum 4
+ XM-KeyPress XM-KeyRelease XM-OwnerGrabButton
XM-ButtonPress
+ XM-ButtonRelease XM-EnterWindow XM-LeaveWindow
XM-PointerMotion
+ XM-PointerMotionHint XM-Button1Motion
XM-Button2Motion
+ XM-Button3Motion XM-Button4Motion XM-Button5Motion
+ XM-ButtonMotion XM-Exposure XM-VisibilityChange
XM-StructureNotify
+ XM-ResizeRedirect XM-SubstructureNotify
XM-SubstructureRedirect
+ XM-FocusChange XM-PropertyChange XM-ColormapChange
XM-KeymapState))
+(define-X-type POINTEREVENT (list 'enum 4
+ XM-ButtonPress XM-ButtonRelease
XM-EnterWindow
+ XM-LeaveWindow XM-PointerMotion
XM-PointerMotionHint
+ XM-Button1Motion XM-Button2Motion
XM-Button3Motion
+ XM-Button4Motion XM-Button5Motion
XM-ButtonMotion XM-KeymapState))
+(define-X-type DEVICEEVENT (list 'enum 4
+ XM-KeyPress XM-KeyRelease XM-ButtonPress
XM-ButtonRelease
+ XM-PointerMotion XM-Button1Motion
XM-Button2Motion
+ XM-Button3Motion XM-Button4Motion
XM-Button5Motion
+ XM-ButtonMotion))
+(define-X-type KEYSYM '(alias INT32))
+(define-X-type KEYCODE '(alias CARD8))
+(define-X-type BUTTON '(alias CARD8))
+(define-X-type KEYMASK (list 'enum 2 X-Shift X-Lock X-Control X-Mod1 X-Mod2
X-Mod3 X-Mod4 X-Mod5))
+(define-X-type BUTMASK (list 'enum 2 X-Button1 X-Button2 X-Button3 X-Button4
X-Button5))
+(define-X-type KEYBUTMASK '(or KEYMASK BUTMASK))
+
+(defun make-X-Char2B ()
+ (make-string 2 ?\x00))
+(defun X-Char2B-byte0 (c2b)
+ (aref c2b 0))
+(defsetf X-Char2B-byte0 (c2b) (b)
+ `(aset ,c2b 0 ,b))
+(defun X-Char2B-byte1 (c2b)
+ (aref c2b 1))
+(defsetf X-Char2B-byte1 (c2b) (b)
+ `(aset ,c2b 1 ,b))
+
+(define-X-type CHAR2B '(struct X-Char2B
+ (X-Char2B-byte0 . BYTE)
+ (X-Char2B-byte1 . BYTE)))
+(define-X-type STRING8 '(listof BYTE))
+(define-X-type STRING16 '(listof CHAR2B))
+
+(define-X-type POINT '(struct X-Point
+ (X-Point-x . INT16)
+ (X-Point-y . INT16)))
+(define-X-type RECTANGLE '(struct X-Rect
+ (X-Rect-x . INT16)
+ (X-Rect-y . INT16)
+ (X-Rect-width . CARD16)
+ (X-Rect-height . CARD16)))
+(define-X-type ARC '(struct X-Arc
+ (X-Arc-x . INT16)
+ (X-Arc-y . INT16)
+ (X-Arc-width . CARD16)
+ (X-Arc-height . CARD16)
+ (X-Arc-angle1 . INT16)
+ (X-Arc-angle2 . INT16)))
+(defun make-X-Host ()
+ (vector nil nil))
+(defun X-Host-family (h)
+ (aref h 0))
+(defsetf X-Host-family (h) (f)
+ `(aset ,h 0 ,f))
+(defun X-Host-address (h)
+ (aref h 1))
+(defsetf X-Host-address (h) (a)
+ `(aset ,h 1 ,a))
+
+(define-X-type HOST `(struct X-Host
+ (X-Host-family . (enum 1 ,X-FamilyInternet
,X-FamilyDECnet ,X-FamilyChaos))
+ (X-Host-address . STRING8)))
+
+(defun X-Create-Message (message-s &optional pad-notneed)
+ "Takes the MESSAGE-S structure and builds a net string.
+MESSAGE-S is a list of vectors and symbols which formulate the message
+to be sent to the XServer. Each vector is of this form:
+ [ SIZE VALUE ]
+ SIZE is the number of BYTES used by the message.
+ VALUE is the lisp object whose value is to take up SIZE bytes.
+ If VALUE or SIZE is a symbol or list, extract that elements value.
+ If the resulting value is still a list or symbol, extract it's value
+ until it is no longer a symbol or a list.
+ If VALUE is a number, massage it to the correct size.
+ If VALUE is a string, append that string verbatum.
+ If VALUE is nil, fill it with that many NULL characters.
+
+When PAD-NOTNEED is non-nil, then do not pad to 4 bytes."
+
+ (let ((gc-cons-threshold most-positive-fixnum) ;inhibit gc'ing
+ (news "") ; resulting message
+ (padlen 0) ; resulting message padlen (if needed)
+ (tlen nil)
+ (ttype nil)
+ (tval nil))
+ (while message-s
+ (if (= (length (car message-s)) 2)
+ (setq tlen 1
+ ttype (aref (car message-s) 0)
+ tval (aref (car message-s) 1))
+ (setq tlen (aref (car message-s) 0)
+ ttype (aref (car message-s) 1)
+ tval (aref (car message-s) 2)))
+
+ ;; Check for symbols, or symbols containing symbols.
+ (while (and (not (null tval)) ; nil symbol allowed
+ (not (eq tval t)) ; t symbol allowed
+ (or (listp tval) (symbolp tval)))
+ (setq tval (eval tval)))
+
+ (while (> tlen 0)
+ (cond ((eq tval nil)
+ (setq tval (make-string tlen ?\x00)))
+ ((eq tval t)
+ (setq tval (concat (make-string (- tlen 1) ?\x00) (make-string
1 ?\x01))))
+ (t (setq tval (X-type-pack nil ttype tval))))
+ (setq news (concat news tval))
+ (decf tlen))
+ (setq message-s (cdr message-s)))
+
+ ;; pad the message
+ (if (and (not pad-notneed)
+ (/= (setq padlen (% (length news) 4)) 0))
+ (concat news (make-string (- 4 padlen) ?\x00))
+ news)))
+
+(defun X-Parse-Message (dpy message-s)
+ ;; TODO: write me using `X-type-extract'
+ )
+
+
(provide 'xlib-xc)
;;; xlib-xc.el ends here
Index: lisp/xlib-xinerama.el
===================================================================
RCS file:
/pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xinerama.el,v
retrieving revision 1.5
diff -u -u -r1.5 xlib-xinerama.el
--- lisp/xlib-xinerama.el 16 Dec 2004 07:49:10 -0000 1.5
+++ lisp/xlib-xinerama.el 1 Jan 2005 04:35:23 -0000
@@ -5,7 +5,7 @@
;; Author: Zajcev Evgeny <zevlg@xxxxxxxxx>
;; Created: Mon Nov 17 19:23:03 MSK 2003
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-xinerama.el,v 1.5 2004/12/16 07:49:10 youngs Exp $
+;; X-CVS: $Id: xlib-xinerama.el,v 1.4 2004/11/29 19:48:19 lg Exp $
;; This file is part of XWEM.
@@ -31,7 +31,8 @@
;; XInerama support.
;;; Code:
-
+
+(require 'xlib-xlib)
(defconst X-XInerama-major 1)
(defconst X-XInerama-minor 1)
Index: lisp/xlib-xlib.el
===================================================================
RCS file:
/pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xlib.el,v
retrieving revision 1.7
diff -u -u -r1.7 xlib-xlib.el
--- lisp/xlib-xlib.el 16 Dec 2004 07:49:10 -0000 1.7
+++ lisp/xlib-xlib.el 1 Jan 2005 04:35:23 -0000
@@ -5,7 +5,7 @@
;; Author: Eric M. Ludlam <zappo@xxxxxxxxxxxxxx>
;; Zajcev Evgeny <zevlg@xxxxxxxxx>
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-xlib.el,v 1.7 2004/12/16 07:49:10 youngs Exp $
+;; X-CVS: $Id: xlib-xlib.el,v 1.6 2004/11/29 19:48:19 lg Exp $
;; This file is part of XWEM.
@@ -28,26 +28,96 @@
;;; Commentary:
-;;
-
;;; Code:
+
+(require 'xlib-xr)
-(eval-when-compile
- (require 'xlib-math))
-(require 'xlib-xwin)
-
-;;;###autoload
-(defun X-invalidate-cl-struct (cl-x)
- "Invalidate CL-X, after `X-invalidate-cl-struct' it won't be cl struct
anymore.
-NOTE: works only if CL-X is vector."
- (if (vectorp
- (let ((i (length cl-x)))
- (while (>= (setq i (1
+ [ 4 (X-Atom-id atom)])) ;atom id
(ReceiveFields
(list
[1 success ] ;status message
@@ -559,7 +611,6 @@
(nth 2 r))
nil)))))
-;;;###autoload
(defun XChangeProperty (xdpy win property type format mode data)
"On display XDPY for window WIN, change PROPERTY.
PROPERTY is changed based on a TYPE, FORMAT, and MODE with DATA.
@@ -596,26 +647,22 @@
;; These are Xlib convenience routines
;;
-;;;###autoload
(defun XSetWMProtocols (xdpy win protocol_atoms)
"On display XDPY, set window's WIN protocols to PROTOCOL_ATOMS.
Convenience routine which calls `XChangeProperty'"
(XChangeProperty xdpy win (XInternAtom xdpy "WM_PROTOCOLS" nil)
XA-atom X-format-32 X-PropModeReplace protocol_atoms))
-;;;###autoload
(defun XSetWMClass (xdpy win wm-class)
"On displayX DPY, set window's WIN Class to WM-CLASS.
WM-CLASS should be in form '(class-name class-intance)."
(XChangeProperty xdpy win XA-wm-class XA-string X-format-8 X-PropModeReplace
(concat (car wm-class) (string 0) (cadr wm-class) (string
0))))
-;;;###autoload
(defun XSetWMName (xdpy win wm-name)
(XChangeProperty xdpy win XA-wm-name XA-string X-format-8 X-PropModeReplace
(concat wm-name)))
-;;;###autoload
(defun XSetWMNormalHints (xdpy win wmnh)
"On display XDPY, set window's WIN normal hints to HINTS.
HINTS is list in format (x1 x2 ... x18)."
@@ -642,21 +689,18 @@
(XChangeProperty xdpy win XA-wm-normal-hints XA-wm-size-hints X-format-32
X-PropModeReplace pplist)))
-;;;###autoload
(defun XSetWMState (xdpy win wm-state &optional icon-id)
"On display XDPY, set window's WIN state to WM-STATE.
WM-STATE is one of `X-WithdrawnState', `X-NormalState' or `X-IconicState'."
(let ((wmsa (XInternAtom xdpy "WM_STATE" nil)))
(XChangeProperty xdpy win wmsa wmsa X-format-32 X-PropModeReplace (list
wm-state (or icon-id 0.0)))))
-;;;###autoload
(defun XSetWMCommand (xdpy win cmd)
"On display XDPY set window's WIN WM_COMMAND property to CMD."
(XChangeProperty xdpy win (XInternAtom xdpy "WM_COMMAND" nil) XA-string
X-format-8 X-PropModeReplace cmd))
-;;;###autoload
(defun XGetWindowProperty (xdpy win property &optional offset length delete
required-type)
"On display XDPY, get window's WIN PROPERTY atom value.
Get the data from optional OFFSET, and a maximum of LENGTH bytes.
@@ -697,7 +741,7 @@
nil ;generic bad response
(list
[ 1 length-1 ] ;format of returned data
- [ 2 integerp ] ;sequence number
+ [ 2 nil ] ;sequence number
[ 4 length-3 ] ;length of this request
[ 4 integerp ] ;atom representing return type
[ 4 integerp ] ;bytes left on server
@@ -705,23 +749,15 @@
[ 12 nil ] ;unused
[ (if (= length-1 0)
0
- (if (member required-type (list XA-atom XA-window
XA-rectangle))
+ (if (memq required-type (list XA-atom XA-window
XA-rectangle))
;; known type
(* length-2 (/ length-1 8))
length-2))
- (cond ((or (= length-1 8) (eq required-type XA-string))
- 'stringp)
-
- ((eq required-type XA-atom)
- :X-Atom)
-
- ((eq required-type XA-window)
- :X-Win)
-
- ((eq required-type XA-rectangle)
- :X-Rect)
-
+ (cond ((or (= length-1 8) (eq required-type XA-string))
'stringp)
+ ((eq required-type XA-atom) :X-Atom)
+ ((eq required-type XA-window) :X-Win)
+ ((eq required-type XA-rectangle) :X-Rect)
(t '([(/ length-1 8) integerp])))]
[ (X-pad (* length-2 (/ length-1 8))) nil ]
)))
@@ -733,9 +769,9 @@
nil ;oops
(setq proplist (list (nth 2 r) (nth 1 r))) ; start backwards
- (if (listp (nth 4 r))
- (setq r (nth 4 r))
- (setq r (nthcdr 4 r)))
+ (if (listp (nth 3 r))
+ (setq r (nth 3 r))
+ (setq r (nthcdr 3 r)))
(if (stringp r)
(setq proplist (cons r proplist))
@@ -750,153 +786,127 @@
(nreverse proplist))))
;; A few functions based on GetProperty
-;;;###autoload
-(defun XGetWMName (xdpy win)
- "On display XDPY, get window's WIN name."
- (let ((propdata
- (XGetWindowProperty xdpy win XA-wm-name 0 1024
+
+ (let* ((ListOfFields
+ (list [1 81] ; opcode
+ [1 nil]
+ [2 2] ; length
+ [4 (X-Colormap-id cmap)])) ; id to use
+ (msg (X-Create-message ListOfFields)))
+ (X-Dpy-send xdpy msg)))
+
+(defun XUninstallColormap (xdpy cmap)
+ "Uninstall colormap on xdpy."
+ (X-Dpy-p xdpy 'XUninstallColormap)
+ (X-Colormap-p cmap 'XUninstallColormap)
+
+ (let* ((ListOfFields
+ (list [1 82] ; opcode
+ [1 nil]
+ [2 2] ; length
+ [4 (X-Colormap-id cmap)])) ; id to use
+ (msg (X-Create-message ListOfFields)))
+ (X-Dpy-send xdpy msg)))
+
+(defun XListInstalledColormaps (xdpy xwin)
+ "Return list of color maps installed on XWIN."
+ (X-Dpy-p xdpy 'XListInstalledColormaps)
+ (X-Win-p xwin 'XListInstalledColormaps)
-;;;###autoload
+ (let ((ListOfFields
+ (list [1 83] ; opcode
+ [1 nil]
+ [2 2] ; length
+ [4 (X-Win-id xwin)])) ; x window
+ (ReceiveFields
+ (list [1 success] ; status message
+ nil ; generic bad response
+ (list [1 nil] ; unused
+ [2 integerp] ; sequence
+ [4 length-1] ; reply length
+ [2 length-2] ; number of Colormaps
+ [22 nil] ; unused
+ [(* 4 length-2) integerp])))) ; cmaps
+ (X-Dpy-send-read xdpy (X-Create-message ListOfFields) ReceiveFields)))
+
(defun XAllocColor (xdpy cmap color)
"On display XDPY allocate in CMAP the color struct COLOR.
Use `X-Color' to create.
@@ -965,7 +1020,6 @@
color)
nil)))))
-;;;###autoload
(defun XAllocNamedColor (xdpy cmap name &optional color-exact)
"Allocate a color based on the color struct COLOR-VISUAL and COLOR-EXACT.
If COLOR-EXACT is nil or absent, ignore.
@@ -1030,14 +1084,13 @@
nil))
)))
-;;;###autoload
(defun XAllocColorCells (xdpy cmap ncolors nplanes &optional contiguous)
"On display XDPY allocate NCOLORS in colormap CMAP."
(X-Dpy-p xdpy 'XAllocColorCells)
(X-Colormap-p cmap 'XAllocColorCells)
(let* ((ListOfFields
- (list [1 86]
+ (list [1 86] ; opcode
[1 contiguous]
[2 3] ; length
[4 (X-Colormap-id cmap)]
@@ -1057,7 +1110,6 @@
[length-2 ([4 integerp])]))))
(X-Dpy-send-read xdpy msg ReceiveFields)))
-;;;###autoload
(defun XStoreColors (xdpy cmap colors)
"On display XDPY in CMAP, store COLORS. (A list of 'X-Color)
These colors are X-Color lists containing the PIXEL, RGB values and
@@ -1078,7 +1130,6 @@
colors (cdr colors)))
(X-Dpy-send xdpy msg)))
-;;;###autoload
(defun XStoreColor (xdpy cmap color &optional R G B)
"On display XDPY in CMAP, store COLORS.
These colors are X-Color lists containing the PIXEL, RGB values and
@@ -1098,7 +1149,6 @@
(if G X-DoGreen 0)
(if B X-DoBlue 0))))))
-;;;###autoload
(defun XFreeColors (xdpy cmap colors planes)
"On display XDPY in CMAP, free COLORS from the server.
The colors are deallocated on PLANES, which is a mask. Use 0 for
@@ -1108,7 +1158,7 @@
(when (not (listp colors))
(signal 'wrong-type-argument (list 'signal 'listp colors)))
- (mapcar (lambda (c) (X-Color-p c 'XFreeColors)) colors)
+ (mapc 'X-Colormap-p colors)
(let* ((ListOfFields
(list [1 88] ;opcode
@@ -1117,17 +1167,18 @@
[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)
-
- ;; Invalidate each color.
- (while colors
- (X-invalidate-cl-struct (car colors))
- (setq colors (cdr colors)))
+
+ ;; NOTE:
+ ;; - We should'nt invalidate colors, because they may be still
+ ;; used, FreeColors actually frees colors when there no any
+ ;; references to them.
+; ;; Invalidate each color.
+; (mapc 'X-i
@@ -1824,7 +1850,6 @@
(msg (X-Create-message ListOfFields)))
(X-Dpy-send xdpy msg)))
-;;;###autoload
(defun XGrabButton (xdpy button mods grab-win ev-mask &optional cursor owe
pmode kmode conf-to)
"On display XDPY in window GRAB-WIN, start grabbing for BUTTON with MODS.
TODO: Describe optional arguments."
@@ -1832,7 +1857,7 @@
(X-Win-p grab-win 'XGrabButton)
(let* ((ListOfFields
- (list [1 28]
+ (list [1 28] ; opcode
[1 (if owe owe nil)]
[2 6]
[4 (X-Win-id grab-win)]
@@ -1847,7 +1872,6 @@
(msg (X-Create-message ListOfFields)))
(X-Dpy-send xdpy msg)))
-;;;###autoload
(defun XUngrabButton (xdpy button mods grab-win)
"On display XDPY in window GRAB-WIN stop grabbing for BUTTON with MODS."
(X-Dpy-p xdpy 'XUngrabButton)
@@ -1863,34 +1887,30 @@
(msg (X-Create-message ListOfFields)))
(X-Dpy-send xdpy msg)))
-;;;###autoload
(defun XGrabKey (xdpy keycode mods grab-win &optional owe pmode kmode)
"On display XDPY in window GRAB-WIN start grabbing for KEYCODE with MODS.
TODO: Description for OWE, PMODE and KMODE."
(X-Dpy-p xdpy 'XGrabKey)
(X-Win-p grab-win 'XGrabKey)
- (let* ((ListOfFields
- (list [1 33] ; request value
- [1 owe] ; owner_events
- [2 4] ; length
- [4 (X-Win-id grab-win)] ; grab window
- [2 mods] ; modifiers
- [1 keycode] ; key
- [1 (or pmode X-GrabModeAsync)] ; pointer mode
- [1 (or kmode X-GrabModeAsync)] ; keyboard mode
- [3 nil])) ; pad
- (msg (X-Create-message ListOfFields)))
- (X-Dpy-send xdpy msg)))
+ (let ((ListOfFields `([1 33] ; opcode
+ [1 ,owe] ; owner_events
+ [2 4] ; length
+ [4 ,(X-Win-id grab-win)] ; grab window
+ [2 ,mods] ; modifiers
+ [1 ,keycode] ; key
+ [1 ,(or pmode X-GrabModeAsync)] ; pointer mode
+ [1 ,(or kmode X-GrabModeAsync)] ; keyboard mode
+ [3 nil]))) ; pad
+ (X-Dpy-send xdpy (X-Create-message ListOfFields))))
-;;;###autoload
(defun XUngrabKey (xdpy keycode mods grab-win)
"On display XDPY in window GRAB-WIN stop grabbing KEYCODE with MODS."
(X-Dpy-p xdpy 'XUngrabKey)
(X-Win-p grab-win 'XUngrabKey)
(let* ((ListOfFields
- (list [1 34] ; request value
+ (list [1 34] ; opcode
[1 keycode] ; keycode
[2 3] ; length
[4 (X-Win-id grab-win)] ; grab window
@@ -1899,7 +1919,6 @@
(msg (X-Create-message ListOfFields)))
(X-Dpy-send xdpy msg)))
-;;;###autoload
(defun XAllowEvents (xdpy mode &optional time)
"On display XDPY allow events in MODE."
(X-Dpy-p xdpy 'XAllowEvents)
@@ -1914,7 +1933,6 @@
;;; Focusing
-;;;###autoload
(defun XGetInputFocus (xdpy)
"On display XDPY get curret input focus."
(X-Dpy-p xdpy 'XGetInputFocus)
@@ -1941,7 +1959,6 @@
(setq thing (X-Win-find xdpy (nth 3 r)))))
thing))
-;;;###autoload
(defun XSetInputFocus (xdpy win-or-val rev-to &optional time)
"On display XDPY set input focus to window WIN-OR-VAL.
REV-TO - Focus revert to when WIN-OR-VAL will lost input focus.
@@ -1949,7 +1966,7 @@
(X-Dpy-p xdpy 'XSetInputFocus)
(let* ((ListOfFields
- (list [1 42] ; request value
+ (list [1 42] ; opcode
[1 rev-to] ; Revert to
[2 3] ; length
[4 (cond ((integerp win-or-val) win-or-val) ;X-PointerRoot,
X-None, etc
@@ -1960,7 +1977,6 @@
(X-Dpy-send xdpy msg)))
;;; Misc requests
-;;;###autoload
(defun XReparentWindow (xdpy win parwin x y)
"On display XDPY reparent window WIN to PARWIN at X Y."
(X-Dpy-p xdpy 'XReparentWindow)
@@ -1978,17 +1994,18 @@
(msg (X-Create-message ListOfFields)))
(X-Dpy-send xdpy msg)))
-;;;###autoload
-(defun XGetGeometry (xdpy win)
- "On display XDPY get geomtry of WIN."
+(defun XGetGeometry (xdpy d)
+ "On display XDPY return geomtry for drawable D.
+Side effect of this function is to set 'xdepth property in drawable
+D."
(X-Dpy-p xdpy 'XGetGeometry)
- (X-Win-p win 'XGetGeometry)
+ (X-Drawable-
+ obj)
+ (t (dispatch-event nev) nil)))))
+
+ (when timo
+ (disable-timeout timo))
+ ret))
+
+(defun XIfEvent (xdpy predict)
+ "Return next X event on XDPY, who match PREDICT."
+ (XNextEvent xdpy nil predict))
-;;;###autoload
-(defun XPeekIfEvent (xdpy predic)
- "Block until PREDIC return t.
-Event does not removed from events queue."
- (XIfEvent xdpy predic t))
-
-;;;###autoload
(defun XSyncEvents (xdpy)
"Syncronize events ready for XDPY."
(funcall (X-Dpy-parse-guess-dispatcher xdpy) xdpy))
-;;;###autoload
(defun XSync (xdpy &optional discard)
"Sync with server.
When DISCARD is non nil, remove all events in events queue, even these
who was before entering `XSync'."
+ (XGetInputFocus xdpy))
- (incf (X-Dpy-evq-protects xdpy))
- (XGetInputFocus xdpy)
- (decf (X-Dpy-evq-protects xdpy))
-
- (if (not discard)
- (XSyncEvents xdpy)
-
- (setf (X-Dpy-evq xdpy) nil)
- (setf (X-Dpy-evq-protects xdpy) 0)))
-
-;;;###autoload
(defun XSetFont (xdpy gc font)
"On display XDPY for GC set FONT."
(X-Dpy-p xdpy 'XSetFont)
@@ -2576,6 +2589,8 @@
(setf (X-Gc-font gc) font)
(XChangeGC xdpy gc))
+
+(defalias 'XFlush 'X-Dpy-send-flush)
(provide 'xlib-xlib)
Index: lisp/xlib-xpm.el
===================================================================
RCS file:
/pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xpm.el,v
retrieving revision 1.5
diff -u -u -r1.5 xlib-xpm.el
--- lisp/xlib-xpm.el 16 Dec 2004 07:49:10 -0000 1.5
+++ lisp/xlib-xpm.el 1 Jan 2005 04:35:24 -0000
@@ -5,7 +5,7 @@
;; Author: Zajcev Evgeny <zevlg@xxxxxxxxx>
;; Created: Fri Nov 28 01:28:18 MSK 2003
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-xpm.el,v 1.5 2004/12/16 07:49:10 youngs Exp $
+;; X-CVS: $Id: xlib-xpm.el,v 1.4 2004/11/29 19:48:20 lg Exp $
;; This file is part of XWEM.
@@ -32,16 +32,15 @@
;;; TODO:
;;
-;; * Make working on GNU Emacs.
;; * Rewrite.
;;; Code:
-
-(eval-when-compile
- (require 'xlib-xlib))
(require 'xlib-img)
+(defvar X:xpm-color-symbols nil
+ "Same as `xpm-color-symbols', but for xlib.")
+
(defun X:xpm-num-colors ()
"Return number of colors in xpm."
@@ -56,17 +55,15 @@
(defun X:xpm-goto-color-def (def)
"Move to color DEF in the xpm header."
(goto-char (point-min))
- (while (not (looking-at "\\s-*\""))
- (next-line 1))
- (next-line 1)
- (while (not (looking-at "\\s-*\""))
- (next-line 1))
- (next-line def))
+ (re-search-forward "[ \t]*\"")
+ (forward-line 1)
+ (re-search-forward "[ \t]*\"")
+ (forward-line def))
(defun X:xpm-goto-body-line (line &optional num-colors)
"Move to LINE lines down from the start of the body of an xpm."
(X:xpm-goto-color-def (or num-colors (X:xpm-num-colors)))
- (next-line line))
+ (forward-line line))
(defun X:xpm-chars-per-pixel ()
"Return number of chars per pixel."
@@ -78,25 +75,40 @@
(string-to-int (match-string 4))
(error "Unable to parse xpm."))))
-(defun X:xpm-parse-color (chars-per-pixel)
- "Parse xpm color string from current line and set the color"
- (let (end)
- (save-excursion
- (end-of-line)
- (setq end (point))
- (beginning-of-line)
- (if (re-search-forward
- ;; Generate a regexp on the fly
- (concat "\"\\(" (make-string chars-per-pixel ?.) "\\)" ; chars
- "\\(\\s-+[sm]\\s-+\\S-*\\)*" ; s and m classes
- "\\s-+\\([c]\\)" ; c class
- "\\s-+\\([^ \t\"]+\\)")
- end t)
- (list (match-string 1) (match-string 4))
- (error "Unable to parse color")))))
+(defun X:xpm-get-symcolor (symc-name &optional tag-set)
+ "Get SYMC-NAME color from `X:xpm-color-symbols' list.
+TAGS-SET is a list of tags, directly passed to `specifier-spec-list'."
+ (let ((xcs X:xpm-color-symbols))
+ (while (and xcs (not (string= (caar xcs) symc-name)))
+ (setq xcs (cdr xcs)))
+ (when xcs
+ (setq xcs (cadr xcs))
+ (cond ((stringp xcs) xcs)
+ ((specifierp xcs)
+ (let ((sspec (specifier-spec-list xcs nil tag-set t)))
+
(defun X:xpm-make-pixmap-from-ximg (xdpy d ximg)
- "On display XDPY and drawable D, create X-Pixmap using OBTAINER to get img
data."
+ "On display XDPY and drawable D, create X-Pixmap using X-Image XIMG."
(let (pixmap gc)
(setq pixmap (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id
(X-Dpy-get-id xdpy))
d (X-Image-depth ximg) (X-Image-width ximg)
(X-Image-height ximg)))
@@ -316,15 +322,13 @@
(X-Pixmap-put-prop pixmap 'ximg ximg)
pixmap))
-;;;###autoload
-(defun X:xpm-pixmap-from-data (xdpy d data &optional shape)
+(defun X:xpm-pixmap-from-data (xdpy d data &optional shape tag-set)
"On display XDPY and drawable D create X-Pixmap from DATA."
- (X:xpm-make-pixmap-from-ximg xdpy d (X:xpm-img-from-data xdpy data shape)))
+ (X:xpm-make-pixmap-from-ximg xdpy d (X:xpm-img-from-data xdpy data shape
tag-set)))
-;;;###autoload
-(defun X:xpm-pixmap-from-file (xdpy d file &optional shape)
+(defun X:xpm-pixmap-from-file (xdpy d file &optional shape tag-set)
"On display XDPY and drawable D create X-Pixmap from FILE."
- (X:xpm-make-pixmap-from-ximg xdpy d (X:xpm-img-from-file xdpy file shape)))
+ (X:xpm-make-pixmap-from-ximg xdpy d (X:xpm-img-from-file xdpy file shape
tag-set)))
;;; Scaling:
Index: lisp/xlib-xr.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xr.el,v
retrieving revision 1.8
diff -u -u -r1.8 xlib-xr.el
--- lisp/xlib-xr.el 16 Dec 2004 07:49:10 -0000 1.8
+++ lisp/xlib-xr.el 1 Jan 2005 04:35:24 -0000
@@ -5,7 +5,7 @@
;; Author: Eric M. Ludlam <zappo@xxxxxxxxxxxxxx>
;; Zajcev Evgeny <zevlg@xxxxxxxxx>
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-xr.el,v 1.8 2004/12/16 07:49:10 youngs Exp $
+;; X-CVS: $Id: xlib-xr.el,v 1.7 2004/11/29 19:48:20 lg Exp $
;; This file is part of XWEM.
@@ -31,10 +31,11 @@
;;
;;; Code:
-(eval-when-compile
- (require 'xlib-xwin))
-
+(require 'xlib-math)
+(require 'xlib-const)
+(require 'xlib-xwin)
+
;; GNU Emacs compatibility
(unless (fboundp 'define-error)
(defun define-error (err-sym doc-string &optional inherits-from)
@@ -74,11 +75,10 @@
(defvar X-EventsList (make-vector X-Event-LASTEvent nil)
"List of event descriptions.")
-;;;###autoload
(defstruct (X-Event (:predicate X-Event-isevent-p))
dpy ; display
type ; type of event
- send-event ; non-nil if event came from SendEvent
request
+ synth-p ; non-nil if event came from SendEvent
request
evdata ; binary event represetation
evinfo ; parsed variant of evdata
@@ -99,7 +99,6 @@
"Remove property PROP from XEV's properties list."
(setf (X-Event-properties xev) (plist-remprop (X-Event-properties xev)
prop)))
-;;;###autoload
(defun X-Event-p (ev &optional sig)
"Return non-nil if EV is X-Event."
(let ((isev (X-Event-isevent-p ev)))
@@ -115,16 +114,13 @@
"Return sequence number of XEvent XEV."
(nth 1 (X-Event-evinfo xev)))
-;;;###autoload
-(defun X-Event-win (xev)
- "Return window for which EV generated."
- (let* ((evt (X-Event-type xev))
- (evd (aref X-EventsList evt))
- (win (nth (aref evd 2) (X-Event-evinfo xev))))
- win))
+(defsubst X-Event-win (xev)
+ "Return window for which EV generated.
+Return nil if there no window for which event XEV is generated."
+ (let ((evd (aref (aref X-EventsList (X-Event-type xev)) 2)))
+ (and (numberp evd) (nth evd (X-Event-evinfo xev)))))
-;;;###autoload
-(defun X-Event-name (xev)
+(defsubst X-Event-name (xev)
"Return symbolic XEV name."
(aref (aref X-EventsList (X-Event-type xev)) 0))
@@ -135,7 +131,6 @@
;; TODO: write me ..
))
-
(defmacro X-Event-declare (type descr)
"Only declare event of TYPE with DESCR in `X-EventsList'."
`(aset X-EventsList ,type ,descr))
@@ -143,19 +138,16 @@
(defmacro X-Event-define (type name dnames descr)
"Define new event of TYPE, NAME and description of event DESCR."
(let ((offs 0)
- fsym
- forms)
-
+ fsym forms)
(push `(aset X-EventsList ,type ,descr) forms)
(while dnames
(when (car dnames)
(set
+ (while (>= (setq i (1- i)) 0)
+ (aset cl-x i nil))
+ t)))
+
;;; Protecting macros
-;;;###autoload
(defmacro X-Dpy-read-excursion (xdpy &rest forms)
"Execute FORMS in reading mode."
`(let ((gc-cons-threshold most-positive-fixnum)) ; inhibit GC'ing
- (progn
- (incf (X-Dpy-readings ,xdpy))
- (unwind-protect
- (progn ,@forms)
- (decf (X-Dpy-readings ,xdpy))))))
+ (incf (X-Dpy-readings ,xdpy))
+ (prog1
+ (condition-case err
+ (progn ,@forms)
+ (t (decf (X-Dpy-readings ,xdpy))
+ (apply 'error (car err) (cdr err))))
+ (decf (X-Dpy-readings ,xdpy)))))
+(put 'X-Dpy-read-excursion 'lisp-indent-function 1)
-;;;###autoload
-(defmacro X-Dpy-events-excursion (xdpy &rest forms)
- "Execute FORMS in safe manner."
- `(let ((gc-cons-threshold most-positive-fixnum)) ; inhibit GC'ing
- (progn
- (incf (X-Dpy-evq-protects ,xdpy))
- (unwind-protect
- (progn ,@forms)
-
- (unwind-protect
- (when (zerop (1- (X-Dpy-evq-protects ,xdpy)))
- (XSyncEvents ,xdpy))
- (decf (X-Dpy-evq-protects ,xdpy)))))))
+(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)
-;;;###autoload
-(defmacro X-Dpy-send-excursion (xdpy &rest forms)
- "Send all requests that appears in FORMS at once to X server.
-Returns what FORMS returns.
-Useful for drawing purposes."
- `(let ((gc-cons-threshold most-positive-fixnum)) ; inhibit GC'ing
- (incf (X-Dpy-snd-protects ,xdpy))
- (unwind-protect
- (progn ,@forms)
-
- (when (zerop (1- (X-Dpy-snd-protects ,xdpy)))
- (when (> (length (X-Dpy-snd-buf ,xdpy)) 0)
- (X-Dpy-send-flush ,xdpy (X-Dpy-snd-buf ,xdpy))
- (setf (X-Dpy-snd-buf ,xdpy) "")))
- (decf (X-Dpy-snd-protects ,xdpy)))))
-
-(put 'X-Dpy-read-excursion 'lisp-indent-function 1)
-(put 'X-Dpy-events-excursion 'lisp-indent-function 1)
-(put 'X-Dpy-send-excursion 'lisp-indent-function 1)
+ (X-Dpy-read-excursion xdpy
+ (X-Dpy-parse-message rf reqid xdpy)
+ )))
+;;;###autoload
(defvar X-default-timeout 60
"This should be big enought, larger than any XEmacs blocking.")
-;;; Events queue support
-;;;###autoload
-(defmacro X-Generic-enqueue (obj queue)
- "Enqueue object QBJ into setf'able QUEUE."
- `(if (null ,queue)
- (setf ,queue (list ,obj))
- (setcdr (last ,queue) (list ,obj))))
-
-(defmacro X-Generic-prequeue (obj queue)
- "Prepend object OBJ into setf'able QUEUE."
- `(setf ,queue (cons ,obj ,queue)))
-
-(defmacro X-Generic-dequeue (queue)
- "Dequeue first object from setf'able QUEUE."
- `(let ((obj (car ,queue)))
- (setf ,queue (cdr ,queue))
- obj))
-
-(defsubst X-Dpy-event-enqueue (xdpy event)
- "Enqueue EVENT in XDPY's events queue."
- (X-Generic-enqueue event (X-Dpy-evq xdpy)))
-
-(defsubst X-Dpy-event-prequeue (xdpy event)
- "Prqueuue EVENT in XDPY's events queue."
- (X-Generic-prequeue event (X-Dpy-evq xdpy)))
-
-(defsubst X-Dpy-event-dequeue (xdpy)
- "Dequeue event from XDPY's events queue and return."
- (X-Generic-dequeue (X-Dpy-evq xdpy)))
-
;;; Reading and parsing
(defun X-Dpy-grab-bytes (xdpy num &optional to-secs to-msecs)
"On display XDPY, wait for at least NUM bytes and return string."
@@ -1046,8 +820,7 @@
(defvar length-3 nil)
(defvar length-4 nil)
-;;;###autoload
-(defun X-Dpy-parse-message (message-s may-guess xdpy &rest arglist)
+(defun X-Dpy-parse-message (message-s req-id xdpy &rest arglist)
"Receive (via filter and waiting) a response from the X server.
Parses MESSAGE-S structure. When MAY-GUESS is t then if 1st el is not 1 or 0,
we must process as an event instead. Then keep looping on guess until we get
@@ -1125,7 +898,7 @@
(cond ((= (aref result 0) 1)
;; success condition
(setq result t)
- (X-Dpy-parse-message (car (cdr (cdr message-s))) nil
xdpy arglist))
+ (X-Dpy-pars
- (X-Dpy-eval-error-or-event xdpy))
-
- ;; Execute events
- (when (zerop (X-Dpy-evq-protects xdpy))
- (incf (X-Dpy-evq-protects xdpy))
- (unwind-protect
- (X-Dpy-process-events xdpy)
- (decf (X-Dpy-evq-protects xdpy))))
- ))
+ (X-Dpy-eval-error-or-event xdpy))))
(provide 'xlib-xr)
Index: lisp/xlib-xrecord.el
===================================================================
RCS file:
/pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xrecord.el,v
retrieving revision 1.6
diff -u -u -r1.6 xlib-xrecord.el
--- lisp/xlib-xrecord.el 16 Dec 2004 07:49:11 -0000 1.6
+++ lisp/xlib-xrecord.el 1 Jan 2005 04:35:24 -0000
@@ -5,7 +5,7 @@
;; Author: Zajcev Evgeny <zevlg@xxxxxxxxx>
;; Created: 18 October 2003
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-xrecord.el,v 1.6 2004/12/16 07:49:11 youngs Exp $
+;; X-CVS: $Id: xlib-xrecord.el,v 1.5 2004/11/29 19:48:20 lg Exp $
;; This file is part of XWEM.
@@ -37,13 +37,11 @@
;; ExtRange is cons cell in form (MAJOR-Range8 . MINOR-Range16)
;;; Code:
-
(eval-when-compile
- (require 'cl)
- (require 'xlib-math)
- (require 'xlib-xr)
- (require 'xlib-xwin))
+ (require 'cl))
+
+(require 'xlib-xlib)
(defconst X-XRecord-major 1)
(defconst X-XRecord-minor 13)
@@ -354,14 +352,12 @@
[(* length-1 4) stringp])))
(rep (X-Dpy-send-read xdpy msg ReceiveFields)))
- (X-Dpy-log xdpy "X-XRecordEnableContext: rep=%S\n" 'rep)
+ (X-Dpy-log xdpy 'x-record "X-XRecordEnableContext: rep=%S" 'rep)
(when (and (car rep)
(= (nth 1 rep) X-XRecordStartOfData))
-
- ;; Mark xdpy to be always in events-excursion mode, there no
- ;; need to process events in data connection.
- (setf (X-Dpy-evq-protects xdpy) 100)
- (setf (X-Dpy-parse-guess-dispatcher xdpy) 'X-XRecord-parse-guess))
+ ;; 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))
rep))
(defun X-XRecordDisableContext (xdpy rc)
@@ -393,6 +389,11 @@
(X-Dpy-send xdpy msg)))
+(defun X-XRecord-event-dispatcher (xdpy win xev)
+ "Dispatch XEvent received fro XRECORD data connection."
+ (setf (X-Dpy-evq xdpy)
+ (append (X-Dpy-evq xdpy) (list xev))))
+
(defun X-XRecord-parse-guess (xdpy)
"Parse message received in data connection."
(X-Dpy-p xdpy 'X-XRecord-parse-guess)
@@ -412,7 +413,7 @@
[4 integerp] ;server-time
[4 integerp] ;recorded sequence
number
[8 nil]) ;not used
- nil xdpy))
+ 0 xdpy))
(mcategory (nth 1 msg)) ; message categery
(len (nth 3 msg))
(elh (nth 4 msg))
@@ -445,7 +446,6 @@
(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))
@@ -456,14 +456,14 @@
(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) "XRECORD EXTENSION: Get
Event: %S, win=%S\n"
+ (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)))))
- )
+ (setq len (- len 31))))))
- (t (error "Not supported category: %d" (nth 1 msg)))))
- )))
+ ;; TODO: what about other categeries?
+ ))
+ )))
))
Index: lisp/xlib-xshape.el
===================================================================
RCS file:
/pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xshape.el,v
retrieving revision 1.4
diff -u -u -r1.4 xlib-xshape.el
--- lisp/xlib-xshape.el 16 Dec 2004 07:49:11 -0000 1.4
+++ lisp/xlib-xshape.el 1 Jan 2005 04:35:24 -0000
@@ -5,7 +5,7 @@
;; Author: Zajcev Evgeny <zevlg@xxxxxxxxx>
;; Created: Mon Nov 17 19:23:03 MSK 2003
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-xshape.el,v 1.4 2004/12/16 07:49:11 youngs Exp $
+;; X-CVS: $Id: xlib-xshape.el,v 1.3 2004/11/29 19:48:21 lg Exp $
;; This file is part of XWEM.
@@ -31,8 +31,8 @@
;;
;;; Code:
-(eval-when-compile
- (require 'xlib-xwin))
+
+(require 'xlib-xlib)
(defconst X-XShape-op-QueryVersion 0)
(defconst X-XShape-op-Rectangles 1)
Index: lisp/xlib-xtest.el
===================================================================
RCS file:
/pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xtest.el,v
retrieving revision 1.3
diff -u -u -r1.3 xlib-xtest.el
--- lisp/xlib-xtest.el 16 Dec 2004 07:49:11 -0000 1.3
+++ lisp/xlib-xtest.el 1 Jan 2005 04:35:24 -0000
@@ -5,7 +5,7 @@
;; Author: Zajcev Evgeny <zevlg@xxxxxxxxx>
;; Created: 18 October 2003
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-xtest.el,v 1.3 2004/12/16 07:49:11 youngs Exp $
+;; X-CVS: $Id: xlib-xtest.el,v 1.2 2004/11/29 19:48:21 lg Exp $
;; X-URL: http://lgarc.narod.ru/xwem/index.html
;; This file is part of XWEM.
@@ -36,8 +36,8 @@
;; * add X-XTestGetVersion, X-XTestCompareCursor, X-XTestGrabControl
;;; Code:
-
-(require 'xlib-xc)
+
+(require 'xlib-xlib)
(defconst X-XTest-op-GetVersion 0)
(defconst X-XTest-op-CompareCursor 1)
Index: lisp/xlib-xwin.el
===================================================================
RCS file:
/pack/xemacscvs/XEmacs/packages/xemacs-packages/xlib/lisp/xlib-xwin.el,v
retrieving revision 1.7
diff -u -u -r1.7 xlib-xwin.el
--- lisp/xlib-xwin.el 16 Dec 2004 07:49:11 -0000 1.7
+++ lisp/xlib-xwin.el 1 Jan 2005 04:35:25 -0000
@@ -5,7 +5,7 @@
;; Author: Zajcev Evgeny <zevlg@xxxxxxxxx>
;; Created: 18 October 2003
;; Keywords: xlib, xwem
-;; X-CVS: $Id: xlib-xwin.el,v 1.7 2004/12/16 07:49:11 youngs Exp $
+;; X-CVS: $Id: xlib-xwin.el,v 1.6 2004/11/29 19:48:21 lg Exp $
;; X-URL: http://lgarc.narod.ru/xwem/index.html
;; This file is part of XWEM.
@@ -29,21 +29,19 @@
;;; Commentary:
-;;
+;;
;;; Code:
-
+
(eval-when-compile
- (require 'cl))
+ (require 'cl)
-(defsubst X-Generate-simple-message (type struct)
- "Same as `X-Generate-message', but does not put value_mask."
- (X-Generate-message type struct 0))
+ (mapc (lambda (el)
+ (autoload el "xlib-xlib"))
+ '(X-invalidate-cl-struct XOpenFont XQueryFont XQueryTextExtents))
+ )
-(defsubst X-Generate-message-for-list (structs-list genfun)
- "For given list of structures STRUCTS-LIST, generate message using function
GENFUNC.
-Each element in STRUCTS-LIST is of STRUCT-TYPE."
- (mapconcat genfun structs-list ""))
+(require 'xlib-xc)
;; Point is either a cons cell in form (x . y) or X-Point structure
(defstruct (X-Point (:predicate X-Point-ispoint-p))
@@ -56,13 +54,11 @@
(signal 'wrong-type-argument (list sig 'X-Point-p xpnt))
ispnt)))
-;;;###autoload
(defmacro X-Point-x (xpnt)
`(if (consp ,xpnt)
(car ,xpnt)
(X-Point-xx ,xpnt)))
-;;;###autoload
(defmacro X-Point-y (xpnt)
`(if (consp ,xpnt)
(cdr ,xpnt)
@@ -78,21 +74,18 @@
(setcdr ,xpnt ,val)
(setf (X-Point-yy ,xpnt) ,val)))
-;;;###autoload
(defun X-Point-message (xpnt)
"Return string representing x point XPNT."
(concat (int->string2 (X-Point-x xpnt))
(int->string2 (X-Point-y xpnt))))
;; Segment is a pair of points
-;;;###autoload
(defun X-Segment-message (xseg)
"Return string representing x segment XSEG."
(concat (X-Point-message (car xseg))
(X-Point-message (cdr xseg))))
;; Rectangle
-;;;###autoload
(defstruct (X-Rect (:predicate X-Rect-isrect-p))
x y width height)
@@ -100,7 +93,6 @@
"Return non-nil if XRECT is X-Rect structure."
(X-Generic-p 'X-Rect 'X-Rect-isrect-p xrect sig))
-;;;###autoload
(defun X-Rect-internal-intersect-p (xrect1 xrect2)
"Return non-nil if two rectangles XRECT1 and XRECT2 have common part."
(let ((minx (min (X-Rect-x xrect1) (X-Rect-x xrect2)))
@@ -109,14 +101,13 @@
(miny (min (X-Rect-y xrect1) (X-Rect-y xrect2)))
(maxy (max (+ (X-Rect-y xrect1) (X-Rect-height xrect1))
(+ (X-Re
+(defconst XA-strikeout-descent (make-X-Atom :id 54.0 :name
"STRIKEOUT_DESCENT") "Atom strikeout-descent eoncoding.")
+(defconst XA-italic-angle (make-X-Atom :id 55.0 :name "ITALIC_ANGLE") "Atom
italic-angle eoncoding.")
+(defconst XA-x-height (make-X-Atom :id 56.0 :name "X_HEIGHT") "Atom x-height
eoncoding.")
+(defconst XA-quad-width (make-X-Atom :id 57.0 :name "QUAD_WIDTH") "Atom
quad-width eoncoding.")
+(defconst XA-weight (make-X-Atom :id 58.0 :name "WEIGHT") "Atom weight
eoncoding.")
+(defconst XA-point-size (make-X-Atom :id 59.0 :name "POINT_SIZE") "Atom
point-size eoncoding.")
+(defconst XA-resolution (make-X-Atom :id 60.0 :name "RESOLUTION") "Atom
resolution eoncoding.")
+(defconst XA-copyright (make-X-Atom :id 61.0 :name "COPYRIGHT") "Atom
copyright eoncoding.")
+(defconst XA-notice (make-X-Atom :id 62.0 :name "NOTICE") "Atom notice
eoncoding.")
+(defconst XA-font-name (make-X-Atom :id 63.0 :name "FONT_NAME") "Atom
font-name eoncoding.")
+(defconst XA-family-name (make-X-Atom :id 64.0 :name "FAMILY_NAME") "Atom
family-name eoncoding.")
+(defconst XA-full-name (make-X-Atom :id 65.0 :name "FULL_NAME") "Atom
full-name eoncoding.")
+(defconst XA-cap-height (make-X-Atom :id 66.0 :name "CAP_HEIGHT") "Atom
cap-height eoncoding.")
+(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
-;;;###autoload
(defstruct (X-Attr (:predicate X-Attr-isattr-p))
;; any *-pixel is X-Color structure
dpy id
@@ -307,7 +367,6 @@
(X-Attr-cursor attr))) . 4)
)))
-;;;###autoload
(defun X-Attr-p (attr &optional sig)
"Return non-nil if ATTR is attributes structure.
If SIG is given and ATTR is not attributes structure, SIG will be signaled."
@@ -316,7 +375,6 @@
(signal 'wrong-type-argument (list sig 'X-Attr-p attr))
isattr)))
-;;;###autoload
(defun X-Attr-message (attr)
"Return a string representing the attributes ATTR."
(X-Generate-message 'X-Attr attr))
@@ -324,7 +382,6 @@
;;;Configure window structure
;;
-;;;###autoload
(defstruct (X-Conf (:predicate X-Conf-isconf-p))
dpy id
x y width height
@@ -347,13 +404,11 @@
If SIG is given and CONF is not X-Conf structure, SIG will be signaled."
(X-Generic-p 'X-Conf 'X-Conf-isconf-p conf sig))
-;;;###autoload
(defun X-Conf-message (conf)
"Return a string representing the configuration CONF."
(X-Generate-message 'X-Conf conf 2))
;;; Window allocation/testing/setting routines.
-;;;###autoload
(defstruct (X-Win (:predicate X-Win-iswin-p))
dpy id
@@ -361,17 +416,14 @@
plist) ; user defined plist
-;;;###autoload
-(defun X-Win-invalidate (win)
+(defun X-Win-invalidate (xdpy win)
"Remove WIN from dpy list and invalidate cl struct."
- (let* ((xdpy (X-Win-dpy win))
- (wins (X-Dpy-windows xdpy)))
- (while wins
- (when (= (X-Win-id (car wins))
- (X-Win-id win))
- (setf (X-Dpy-windows xdpy) (delete (car wins) (X-Dpy-windows xdpy)))
- (X-invalidate-cl-struct (car wins))
- (setq wins nil)))))
+ (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)))
+ (cons xdpy win)))
;; Properties list operations
(defsubst X-Win-put-prop (win prop val)
@@ -442,7 +494,6 @@
be signaled."
(X-Generic-p 'X-Win 'X-Win-iswin-p win sig))
-;;;###autoload
(defun X-Win-find (xdpy wid)
"Find X-Win with id WID on XDPY."
(X-Dpy-p xdpy 'X-Win-find)
@@ -452,19 +503,20 @@
(setq wl (cdr wl)))
(car wl)))
-;;;###autoload
(defun X-Win-find-or-make (xdpy wid)
"Find X-Win with id WID on display XDPY, or make new one if not found."
(X-Dpy-p xdpy 'X-Win-find-or-make)
(or (X-Win-find xdpy wid)
- (car (pushnew (make-X-Win :dpy xdpy :id wid) (X-Dpy-windows xdpy)))))
+ (let ((xwin (make-X-Win :dpy xdpy :id wid)))
+ (X-Dpy-log xdpy 'x-event "XDPY Adding new window: %S" 'wid)
+ (push xwin (X-Dpy-windows xdpy))
+ xwin)))
;;;
-;;;###autoload
(defstruct (X-Pixmap (:predicate X-Pixmap-ispixmap-p))
- dpy id
-
+ dpy id d
+
plist) ; User defined plist
(defsubst X-Pixmap-p (pixmap &optional sig)
@@ -472,6 +524,9 @@
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))
+
;; Properties list operations
(defsubst X-Pixmap-put-prop (pixmap prop val)
(setf (X-Pixmap-plist pixmap) (plist-put (X-Pixmap-plist pixmap) prop val)))
@@ -482,6 +537,24 @@
(defsubst X-Pixmap-rem-prop (pixmap prop)
(setf (X-Pixmap-plist pixmap) (plist-remprop (X-Pixmap-plist pixmap) prop)))
+(defsubst X-Pixmap-width (pixmap)
+ "Return PIXMAP's width."
+ (X-Pixmap-get-prop pixmap 'width))
+(defsetf X-Pixmap-width (pixmap) (nw)
+ `(X-Pixmap-put-prop ,pixmap 'width ,nw))
+
+(defsubst X-Pixmap-height (pixmap)
+ "Return PIXMAP's height."
+ (X-Pixmap-get-prop pixmap 'height))
+(defsetf X-Pixmap-height (pixmap) (nh)
+ `(X-Pixmap-put-prop ,pixmap 'height ,nh))
+
+(defsubst X-Pixmap-depth (pixmap)
+ "Return PIXMAP's depth."
+ (X-Pixmap-get-prop pixmap 'depth))
+(defsetf X-Pixmap-depth (pixmap) (nd)
+ `(X-Pixmap-put-prop ,pixmap 'depth ,nd))
+
;;;
;; DRAWABLE stuff. A drawable is something you can draw to,
;; therefore, the only fn we need, is a drawable-p function.
@@ -489,7 +562,6 @@
;; Each time we make a new drawable surface, add that to the list
;; of checks here!
;;
-;;;###autoload
(defun X-Drawable-p (d &optional sig)
"Return non-nil if D is drawable.
If SIG, then signal on error."
@@ -498,16 +570,14 @@
(signal 'wrong-type-argument (list sig 'X-Drawable-p d))
isdp)))
-;;;###autoload
(defun X-Drawable-id (d)
"Return id of drawable D."
(X-Drawable-p d 'X-Drawable-id)
-
+
(if (X-Win-p d)
(X-Win-id d)
(X-Pixmap-id d)))
-;;;###autoload
(defun X-Drawable-dpy (d)
"Return dpy of drawable D."
(X-Drawable-p d 'X-Drawable-dpy)
@@ -517,7 +587,6 @@
(X-Pixmap-dpy d)))
;;; Colormaps
-;;;###autoload
(defstruct (X-Colormap (:predicate X-Colormap-iscmap-p))
dpy id
colors) ; list of X-Color [unused]
@@ -527,7 +596,6 @@
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))
-;;;###autoload
(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)))
@@ -539,10 +607,9 @@
(= (X-Color-blue col)
(X-Color-blue (car cols))))))
(setq cols (cdr cols)))
-
+
(car cols)))
-;;;###autoload
(defun X-Colormap-lookup-by-name (cmap color-name)
"Lookup in CMAP color cache color named by COLOR-NAME."
(let ((cols (X-Colormap-colors cmap)))
@@ -552,7 +619,6 @@
(setq cols (cdr cols)))
(car cols)))
-;;;###autoload
(defun X-Colormap-lookup-by-id (cmap id)
"Lookup color in colormap CMAP by ID."
(let ((cols (X-Colormap-colors cmap)))
@@ -561,7 +627,6 @@
(car cols)))
;;; Color structure
-;;;###autoload
(defstruct (X-Color (:predicate X-Color-iscolor-p))
dpy id
cmap ; back reference to X-Colormap
@@ -569,11 +634,9 @@
name ; non-nil if allocated using
`XAllocNamedColor'
flags)
-;;;###autoload
(defun X-Color-p (col &optional sig)
(X-Generic-p 'X-Color 'X-Color-iscolor-p col sig))
-;;;###autoload
(defun X-Color-message (col)
"Convert COL into X request message."
(X-Create-message (list [4 (X-Color-id col)]
@@ -585,7 +648,6 @@
;;; Graphical context structure
;;
-;;;###autoload
(defstruct (X-Gc (:predicate X-Gc-isgc-p))
dpy id
style
@@ -641,21 +703,24 @@
(X-Gc-dashes . 1)
(X-Gc-arc-mode . 1))))
-;;;###autoload
(defun X-Gc-p (gc &optional sig)
(X-Generic-p 'X-Gc 'X-Gc-isgc-p gc sig))
-;;;###autoload
+(defun X-Gc-real-line-width (gc)
+ "Return real GC's line width.
+The thing is that 0 line width is actually 1, but uses hardware
+assistance to draw such lines."
+ (let ((lw (X-Gc-line-width gc)))
+ (if (zerop lw) 1 lw)))
+
(defun X-Gc-message (gc)
"Convert GC into message string."
(X-Generate-message 'X-Gc gc))
;;; Font structure
-;;;###autoload
(defstruct (X-CharInfo (:predicate X-CharInfo-ischarinfo-p))
)
-;;;###autoload
(defstruct (X-Font (:predicate X-Font-isfont-p))
dpy id
name
@@ -669,11 +734,9 @@
fontascent fontdescent
ncinfo props chinfo)
-;;;###autoload
(defun X-Font-p (font &optional sig)
(X-Generic-p 'X-Font 'X-Font-isfont-p font sig))
-;;;###autoload
(defun X-Font-find (xdpy fid)
"Find font with id FID on X display XDPY."
(X-Dpy-p xdpy 'X-Font-find)
@@ -685,7 +748,6 @@
(defcustom X-use-queryfont t "*Non-nil mean use QueryFont.")
-;;;###autoload
(defun X-Font-get (xdpy fname)
"Get font by its name FNAME on display XDPY."
(X-Dpy-p xdpy 'X-Font-get)
@@ -699,7 +761,7 @@
(setq rfn (car fl))
(if (X-Font-p rfn)
rfn
-
+
;; Else query X server for font
(setq rfn (make-X-Font :dpy xdpy :id (X-Dpy-get-id xdpy) :name fname))
(XOpenFont xdpy rfn)
@@ -712,13 +774,12 @@
rfn)))
;; TODO: X-Font-height, X-Font-width, etc
-;;;###autoload
(defun X-Font-heigth (font)
"Return FONT height."
(+ (X-Font-fontascent font)
(X-Font-fontdescent font)))
-;;;###autoload
+;; NOTE: what if chr is '\n', '\t' or such?
(defun X-Font-char-width (chr font)
"Return CHR width for FONT."
(let* ((idx (- (Xforcenum chr) (X-Font-micob font)))
@@ -728,7 +789,6 @@
(X-Font-maxb font)) 2)))
wi))
-;;;###autoload
(defun X-Text-ascent (dpy font text &optional font-asc)
"Return overall TEXT's ascent.
If FONT-ASC is non-nil, return FONT's ascent."
@@ -737,7 +797,6 @@
(nth (if font-asc 3 5) qtex))
(X-Font-fontascent font)))
-;;;###autoload
(defun X-Text-descent (dpy font text &optional font-desc)
"Return overall TEXT's descent.
If FONT-DESC is non-nil, return FONT's descent."
@@ -746,7 +805,6 @@
(nth (if font-desc 4 6) qtex))
(X-Font-fontdescent font)))
-;;;###autoload
(defun X-Text-height (dpy font text)
"Return TEXT height for FONT."
(if (not X-use-queryfont)
@@ -754,23 +812,41 @@
(+ (nth 3 qtex) (nth 4 qtex)))
(X-Font-heigth font)))
-;;;###autoload
(defun X-Text-width (dpy font text)
"Return width of TEXT when it will be displayed in FONT."
-; (X-Dpy-log dpy "X-Text-width issued with font=%S\n" 'font)
(if (not X-use-queryfont)
(nth 7 (XQueryTextExtents dpy font text))
-; (let ((chl (string-to-list text))
-; (defchr (X-Font-defchar font)))
+ (apply '+ (mapcar (lambda (chr)
+ (X-Font-char-width chr font))
+ text))))
+
+;;; Fontable stuff
+(defun X-Fontable-p (fa &optional sig)
+ "Return non-nil if FA is fontable object.
+If SIG, then signal on error."
+ (let ((isdp (or (X-Font-p fa) (X-Gc-p fa))))
+ (if (and sig (not isdp))
+ (signal 'wrong-type-argument (list sig 'X-Fontable-p fa))
+ isdp)))
- (apply '+ (mapcar (lambda (chr)
- (X-Font-char-width chr font))
- text))))
-;)
+(defun X-Fontable-id (fa)
+ "Return id of fontable object FA."
+ (X-Fontable-p fa 'X-Fontable-p)
+
+ (if (X-Font-p fa)
+ (X-Font-id fa)
+ (X-Gc-id fa)))
+
+(defun X-Fontable-dpy (fa)
+ "Return dpy of fontable object FA."
+ (X-Fontable-p fa 'X-Fontable-dpy)
+
+ (if (X-Font-p fa)
+ (X-Font-dpy fa)
+ (X-Gc-dpy fa)))
;;; Cursors structure
-;;;###autoload
(defstruct (X-Cursor (:predicate X-Cursor-iscursor-p))
dpy id
source
@@ -799,12 +875,14 @@
(defsubst X-Cursor-p (cursor &optional sig)
(X-Generic-p 'X-Cursor 'X-Cursor-iscursor-p cursor sig))
+(defun X-Cursor-find-or-make (dpy id)
+ (make-X-Cursor :dpy dpy :id id))
+
(defsubst X-Cursor-message (cursor)
"Turn CURSOR into the text of a message."
(X-Generate-simple-message 'X-Cursor cursor))
;; Hints
-;;;###autoload
(defstruct (X-WMSize (:predicate X-WMSize-issize-p))
flags
x y width height
@@ -816,52 +894,49 @@
base-width base-height ; added by ICCCM v1
gravity)
-;;;###autoload
-(defun X-WMSize-p (wms &optional sig)
+(defsubst X-WMSize-p (wms &optional sig)
(X-Generic-p 'X-WMSize 'X-WMSize-issize-p wms sig))
(defsubst X-WMSize-uspos-p (wms)
"Return non-nil if WMS have user specified x, y."
- (not (= 0 (logand (X-WMSize-flags wms) (lsh 1 0)))))
+ (Xtest (X-WMSize-flags wms) 1))
(defsubst X-WMSize-ussize-p (wms)
"Return non-nil if WMS have user specified width, height."
- (not (= 0 (logand (X-WMSize-flags wms) (lsh 1 1)))))
+ (Xtest (X-WMSize-flags wms) 2))
(defsubst X-WMSize-ppos-p (wms)
"Return non-nil if WMS have program specified position."
- (not (= 0 (logand (X-WMSize-flags wms) (lsh 1 2)))))
+ (Xtest (X-WMSize-flags wms) 4))
(defsubst X-WMSize-psize-p (wms)
"Return non-nil if WMS have program specified size."
- (not (= 0 (logand (X-WMSize-flags wms) (lsh 1 3)))))
+ (Xtest (X-WMSize-flags wms) 8))
(defsubst X-WMSize-pminsize-p (wms)
"Return non-nil if WMS have program specified minimum size."
- (not (= 0 (logand (X-WMSize-flags wms) (lsh 1 4)))))
+ (Xtest (X-WMSize-flags wms) 16))
(defsubst X-WMSize-pmaxsize-p (wms)
"Return non-nil if WMS have program specified maximum size."
- (not (= 0 (logand (X-WMSize-flags wms) (lsh 1 5)))))
+ (Xtest (X-WMSize-flags wms) 32))
(defsubst X-WMSize-presizeinc-p (wms)
"Return non-nil if WMS have program specified resize increments."
- (not (= 0 (logand (X-WMSize-flags wms) (lsh 1 6)))))
+ (Xtest (X-WMSize-flags wms) 64))
(defsubst X-WMSize-paspect-p (wms)
"Return non-nil if WMS have program specified |