XEmacs-Patches January 2005

xemacs-patches@xemacs.org

33 participants
131 discussions

[PACKAGES (xlib)] Version 2.0 is released! 19 years, 11 months

Steve Youngs

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(a)youngs.au.com> + + * 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(a)xwem.org--2004/xlib--main--2.0 +# + +2005-01-01 02:21:03 GMT Zajcev Evgeny <lg(a)xwem.org> 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(a)xwem.org> 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(a)xwem.org> 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(a)xwem.org> 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(a)xwem.org> patch-6 + + Summary: + Merged with 2004-w + Revision: + xlib--main--2.0--patch-6 + + Patches applied: + + * dev(a)xwem.org--2004-w/xlib--dev--2.0--patch-9 + Merge with main, makefile change + + + modified files: + Makefile + + new patches: + dev(a)xwem.org--2004-w/xlib--dev--2.0--patch-9 + + +2004-12-19 23:01:09 GMT Zajcev Evgeny <lg(a)xwem.org> 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(a)xwem.org> patch-4 + + Summary: + merged with dev(a)xwem.org--2004-w/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(a)xwem.org--2004-w/xlib--dev--2.0--patch-5 + dev(a)xwem.org--2004-w/xlib--dev--2.0--patch-6 + dev(a)xwem.org--2004-w/xlib--dev--2.0--patch-7 + dev(a)xwem.org--2004-w/xlib--dev--2.0--patch-8 + + +2004-12-17 01:59:47 GMT Evgeny Zajcev <lg(a)xwem.org> 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(a)ext.by> + + + modified files: + lisp/xlib-xr.el + + +2004-12-17 00:46:40 GMT Evgeny Zajcev <lg(a)xwem.org> 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(a)xwem.org> patch-1 + + Summary: + merge from steve + Revision: + xlib--main--2.0--patch-1 + + Patches applied: + + * steve(a)eicq.org--2004/xlib--steve--2.0--base-0 + tag of lg(a)xwem.org--2004/xlib--main--2.0--base-0 + + * steve(a)eicq.org--2004/xlib--steve--2.0--patch-1 + Move to tla style version string + + * steve(a)eicq.org--2004/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(a)eicq.org--2004/xlib--steve--2.0--base-0 + steve(a)eicq.org--2004/xlib--steve--2.0--patch-1 + steve(a)eicq.org--2004/xlib--steve--2.0--patch-2 + + +2004-12-08 18:52:15 GMT Evgeny Zajcev <lg(a)xwem.org> 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(a)xwem.org--2004/xlib--main--2.0--version-0 MAINTAINER = Zajcev Evgeny <zevlg(a)yandex.ru> 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(a)yandex.ru> +;; 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(a)gnu.ai.mit.edu> ;; Modified: Zajcev Evgeny <zevlg(a)yandex.ru> ;; 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(a)gnu.ai.mit.edu> ;; Modified: Zajcev Evgeny <zevlg(a)yandex.ru> ;; 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(a)yandex.ru> ;; 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(a)yandex.ru> +;; 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(a)gnu.ai.mit.edu> ;; Modified: Zajcev Evgeny <zevlg(a)yandex.ru> ;; 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(a)yandex.ru> ;; 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(a)xwem.org--2004/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(a)yandex.ru> ;; 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(a)yandex.ru> ;; 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(a)yandex.ru> ;; 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(a)gnu.ai.mit.edu> ;; Zajcev Evgeny <zevlg(a)yandex.ru> ;; 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(a)yandex.ru> ;; 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(a)gnu.ai.mit.edu> ;; Zajcev Evgeny <zevlg(a)yandex.ru> ;; 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(a)yandex.ru> ;; 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(a)yandex.ru> ;; 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(a)yandex.ru> ;; 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(a)yandex.ru> ;; 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 min and max aspect ratios." - (not (= 0 (logand (X-WMSize-flags wms) (lsh 1 7))))) + (Xtest (X-WMSize-flags wms) 128)) (defsubst X-WMSize-pbasesize-p (wms) "Return non-nil if WMS have program specified base for incrementing." - (not (= 0 (logand (X-WMSize-flags wms) (lsh 1 8))))) + (Xtest (X-WMSize-flags wms) 256)) (defsubst X-WMSize-pgravity-p (wms) "Return non-nil if WMS have program specified window graivty." - (not (= 0 (logand (X-WMSize-flags wms) (lsh 1 9))))) - + (Xtest (X-WMSize-flags wms) 512)) -;;;###autoload (defstruct (X-WMHints (:predicate X-WMHints-ishints-p)) flags input ;does this app rely on the window manager to get keyboard input? ＠＠ -875,44 +950,42 ＠＠ (defsubst X-WMHints-input-p (wmh) "Return non-nil if WMH have InputHint." - (not (= 0 (logand (X-WMHints-flags wmh) (lsh 1 0))))) + (Xtest (X-WMHints-flags wmh) 1)) (defsubst X-WMHints-state-p (wmh) "Return non-nil if WMH have StateHint." - (not (= 0 (logand (X-WMHints-flags wmh) (lsh 1 1))))) + (Xtest (X-WMHints-flags wmh) 2)) (defsubst X-WMHints-iconpixmap-p (wmh) "Return non-nil if WMH have IconPixmapHint." - (not (= 0 (logand (X-WMHints-flags wmh) (lsh 1 2))))) + (Xtest (X-WMHints-flags wmh) 4)) (defsubst X-WMHints-iconwindow-p (wmh) "Return non-nil if WMH have IconWindowHint." - (not (= 0 (logand (X-WMHints-flags wmh) (lsh 1 3))))) + (Xtest (X-WMHints-flags wmh) 8)) (defsubst X-WMHints-iconpos-p (wmh) "Return non-nil if WMH have IconPositionHint." - (not (= 0 (logand (X-WMHints-flags wmh) (lsh 1 4))))) + (Xtest (X-WMHints-flags wmh) 16)) (defsubst X-WMHints-iconmask-p (wmh) "Return non-nil if WMH have IconMaskHint." - (not (= 0 (logand (X-WMHints-flags wmh) (lsh 1 5))))) + (Xtest (X-WMHints-flags wmh) 32)) (defsubst X-WMHints-wingroup-p (wmh) "Return non-nil if WMH have WindowGroupHint." - (not (= 0 (logand (X-WMHints-flags wmh) (lsh 1 6))))) + (Xtest (X-WMHints-flags wmh) 64)) (defsubst X-WMHints-urgency-p (wmh) "Return non-nil if WMH have UrgencyHint." - (not (= 0 (logand (X-WMHints-flags wmh) (lsh 1 8))))) + (Xtest (X-WMHints-flags wmh) 256)) ;; Generic functions -;;;###autoload (defun X-Generic-struct-p (gstruct) "Return non-nil if GSTRUCT is generic struct which have id field." ;; DO NOT USE THIS FUNCTION (and (vectorp gstruct) (intern (concat (substring (symbol-name (aref gstruct 0)) 10) "-id")))) -;;;###autoload (defun X-Generic-p (type pfunc thing &optional sig) "Returns non-nil if THING is of TYPE, using predicate PFUNC. If SIG is given, then signal if error." ＠＠ -922,7 +995,6 ＠＠ (signal 'wrong-type-argument (list sig type thing)) isit))) -;;;###autoload (defun X-Generate-message (type attr &optional bitmask-size) "Convert the attribute structure ATTR to a string. The string is the message starting with VALUE_MASK, needed for ＠＠ -974,12 +1046,22 ＠＠ (setq m (Xmask-or m (Xmask (- (length sal) (length xal)))))) (setq xal (cdr xal)))) - + (when (<= bitmask-size 2) (setq m (truncate m))) (X-Create-message (reverse l) (= bitmask-size 0)))) +(defun X-Generate-simple-message (type struct) + "Same as `X-Generate-message', but does not put value_mask." + (X-Generate-message type struct 0)) + +(defun 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 "")) + + (provide 'xlib-xwin) ;;; xlib-xwin.el ends here -- |---<Steve Youngs>---------------<GnuPG KeyID: A94B3003>---| | In space, | | No one can hear you rip a stinky | |---------------------------------------<steve(a)xwem.org>---|

1 participants
0 comments

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

XEmacs-Patches January 2005