Location: lg@xxxxxxxxxxxxxx http://arch.xwem.org/2005/
Revision: xlib-ffi--main--1.0--patch-1
Archive: lg@xxxxxxxxxxxxxx
Creator: Zajcev Evgeny <lg@xxxxxxxx>
Date: Tue Mar 7 02:26:42 MSK 2006
Standard-date: 2006-03-06 23:26:42 GMT
Removed-files: lisp/.arch-ids/xlib-version.el.id
lisp/xlib-version.el
Modified-files: Makefile lisp/ffi-xlib.el
lisp/xlib-keysymdb.el lisp/xlib-xlib.el
New-patches: lg@xxxxxxxxxxxxxx/xlib-ffi--main--1.0--patch-5
lg@xxxxxxxxxxxxxx/xlib-ffi--main--1.0--patch-1
Summary: Bug fixes
Keywords: keysyms, XGetWMProtocols
* Makefile: sxemacs as default XEMACS
* xlib-version.el: Removed
* xlib-keysymdb.el: Rewrote, ApplicationLeft and ApplicationRight keys
added.
* xlib-xlib.el (XGetWMProtocols): [fix] Avoid looping if X:GetWMProtocols
fails, i.e. returns zero status.
* xlib-xlib.el: Fixes some memory leaks
* removed files
lisp/.arch-ids/xlib-version.el.id
lisp/xlib-version.el
* added files
{arch}/xlib-ffi/xlib-ffi--main/xlib-ffi--main--1.0/lg@xxxxxxxxxxxxxx/patch-log/patch-5
{arch}/xlib-ffi/xlib-ffi--main/xlib-ffi--main--1.0/lg@xxxxxxxxxxxxxx/patch-log/patch-1
* modified files
--- orig/Makefile
+++ mod/Makefile
@@ -54,7 +54,9 @@
LISP_STAGING = $(STAGING)/lisp/$(PACKAGE)
# Programs and their flags.
+ifndef XEMACS
XEMACS = sxemacs
+endif
XEMACS_FLAGS = -batch -no-autoloads
INSTALL = install
--- orig/lisp/ffi-xlib.el
+++ mod/lisp/ffi-xlib.el
@@ -1,6 +1,6 @@
;;; ffi-xlib.el --- Emacs interface to Xlib.
-;; Copyright (C) 2005 by Zajcev Evgeny.
+;; Copyright (C) 2005,2006 by Zajcev Evgeny.
;; Author: Zajcev Evgeny <zevlg@xxxxxxxxx>
;; Created: Sun Aug 28 02:21:02 MSD 2005
@@ -888,7 +888,8 @@
(vmask unsigned-long) (attrs (pointer XSetWindowAttributes)))
(define-xlib-function X:ChangeWindowAttributes int
- (xdpy (pointer Display)) (win Window) (vmask unsigned-long) (pointer
XSetWindowAttributes))
+ (xdpy (pointer Display)) (win Window) (vmask unsigned-long)
+ (pointer XSetWindowAttributes))
(define-xlib-function X:SetWindowBackground int
(dpy (pointer Display)) (win Window) (pixel unsigned-long))
@@ -970,7 +971,7 @@
(define-xlib-function X:InternAtom Atom
(dpy (pointer Display)) (name c-string) (only-if-exists Bool))
-(define-xlib-function X:GetAtomName c-string
+(define-xlib-function X:GetAtomName (pointer char)
(dpy (pointer Display)) (atom Atom))
(define-xlib-function X:GetWindowProperty int
@@ -1389,6 +1390,9 @@
(plane_mask unsigned-long)
(format int))
+(define-xlib-function X:DestroyImage int
+ (pointer XImage))
+
(define-xlib-function X:Free int
(data (pointer void)))
@@ -1572,6 +1576,9 @@
(define-xlib-function X:GetModifierMapping (pointer XModifierKeymap)
(dpy (pointer Display)))
+(define-xlib-function X:FreeModifiermap void
+ (modmap (pointer XModifierKeymap)))
+
(define-xlib-function X:GetKeyboardMapping (pointer KeySym)
(dpy (pointer Display))
(first_keycode KeyCode)
--- orig/lisp/xlib-keysymdb.el
+++ mod/lisp/xlib-keysymdb.el
@@ -31,9 +31,12 @@
;;
;;; Code:
+
+(eval-when-compile
+ (require 'cl))
-(defconst x-XKeysymDB
- [(hpmute_acute . #x100000A8)
+(defconst X-XKeysymDB
+ '((hpmute_acute . #x100000A8)
(hpmute_grave . #x100000A9)
(hpmute_asciicircum . #x100000AA)
(hpmute_diaeresis . #x100000AB)
@@ -290,31 +293,21 @@
(usldead_asciicircum . #x100000AA)
(usldead_asciitilde . #x100000AC)
(usldead_cedilla . #x1000FE2C)
- (usldead_ring . #x1000FEB0)])
+ (usldead_ring . #x1000FEB0)
-(defconst x-XKeysymDB-length 245)
+ (XF86ApplicationLeft . #x1008FF50)
+ (XF86ApplicationRight . #x1008FF51)
+ )
+ "Keysyms database.
+List of conses in form \(SYM-NAME . KEY-SYM\)")
(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)))
+ (cdr (assq sym X-XKeysymDB)))
(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)))
+ (car (find keysym X-XKeysymDB :test #'= :key #'cdr)))
(provide 'xlib-keysymdb)
--- orig/lisp/xlib-xlib.el
+++ mod/lisp/xlib-xlib.el
@@ -1,6 +1,6 @@
;;; xlib-xlib.el --- Xlib next generation.
-;; Copyright (C) 2005 by Zajcev Evgeny.
+;; Copyright (C) 2005,2006 by Zajcev Evgeny.
;; Author: Zajcev Evgeny <zevlg@xxxxxxxxx>
;; Created: Sun Aug 28 02:20:07 MSD 2005
@@ -114,12 +114,13 @@
(defvar X:Dpy-list nil)
(defun X:Dpy-find (proc)
+ "Find X display by its PROC."
(find proc X:Dpy-list
:test #'(lambda (i1 i2)
(eq i1 (get i2 'emacs-proccess)))))
(defun X:Dpy-setup (dpy &rest properties)
- ;; Set display PROPERTIES
+ "For display DPY setup its PROPERTIES."
(while properties
(put dpy (car properties) (cadr properties))
(setq properties (cddr properties)))
@@ -155,7 +156,7 @@
`(memq ,routine (get ,xdpy :log-routines)))
(defun X-Dpy-log (xdpy routine &rest args)
- "Put a ROUTINE's message in the in the log buffer specified by XDPY.
+ "To the XDPY's log buffer put a ROUTINE's message.
If XDPY is nil, then put into current buffer. Log additional ARGS as well."
(when (and (X:Dpy-log-buffer xdpy)
(X:Dpy-has-log-routine-p xdpy routine)
@@ -168,6 +169,7 @@
(insert "\n")))))
(defun X-Dpy-log-verbatim (xdpy arg)
+ "To XDPY's log buffer output ARG without formatting."
(when (bufferp (X:Dpy-log-buffer xdpy))
(with-current-buffer (X:Dpy-log-buffer xdpy)
(goto-char (point-min))
@@ -191,26 +193,35 @@
`(put ,xdpy :error-hooks ,hooks))
(defsubst X-Dpy-EventHandler-add (dpy handler &optional priority evtypes-list)
- "To DPY's event handlers list add HANDLER."
+ "To DPY's event handlers list add HANDLER.
+PRIORITY specifies handler's priority.
+EVTYPES-LIST specifies list of event types to handle."
(setf (X-Dpy-event-handlers dpy)
- (X-EventHandler-add (X-Dpy-event-handlers dpy) handler priority
evtypes-list)))
+ (X-EventHandler-add (X-Dpy-event-handlers dpy)
+ handler priority evtypes-list)))
(defsubst X-Dpy-EventHandler-isset (dpy handler &optional priority
evtypes-list)
"Return non-nil if on DPY event HANDLER is set."
- (X-EventHandler-isset (X-Dpy-event-handlers dpy) handler priority
evtypes-list))
+ (X-EventHandler-isset
+ (X-Dpy-event-handlers dpy) handler priority evtypes-list))
(defsubst X-Dpy-EventHandler-rem (dpy handler &optional priority evtypes-list)
"From DPY's event handlers list, remove HANDLER."
(setf (X-Dpy-event-handlers dpy)
- (X-EventHandler-rem (X-Dpy-event-handlers dpy) handler priority
evtypes-list)))
+ (X-EventHandler-rem
+ (X-Dpy-event-handlers dpy) handler priority evtypes-list)))
-(defsubst X-Dpy-EventHandler-enable (dpy handler &optional priority
evtypes-list)
+(defsubst X-Dpy-EventHandler-enable (dpy handler
+ &optional priority evtypes-list)
"In DPY's list of event handlers activate HANDLER."
- (X-EventHandler-enable (X-Dpy-event-handlers dpy) handler priority
evtypes-list))
+ (X-EventHandler-enable
+ (X-Dpy-event-handlers dpy) handler priority evtypes-list))
-(defsubst X-Dpy-EventHandler-disable (dpy handler &optional priority
evtypes-list)
+(defsubst X-Dpy-EventHandler-disable (dpy handler
+ &optional priority evtypes-list)
"In DPY's list of event handlers disable HANDLER."
- (X-EventHandler-disable (X-Dpy-event-handlers dpy) handler priority
evtypes-list))
+ (X-EventHandler-disable
+ (X-Dpy-event-handlers dpy) handler priority evtypes-list))
(defsubst X-Dpy-EventHandler-runall (dpy xev)
"Run all DPY's event handlers on XEV.
@@ -218,6 +229,8 @@
(X-EventHandler-runall (X-Dpy-event-handlers dpy) xev))
(defun X-Dpy-p (xdpy &optional sig)
+ "Return non-nil if XDPY is actually X display.
+SIG is not used."
(and (ffi-object-p xdpy)
(equal (ffi-object-type xdpy) '(pointer Display))))
@@ -234,7 +247,7 @@
(defconst X-default-timeout 60)
(defun X-invalidate-cl-struct (cl-x)
- "Invalidate CL-X, after `X-invalidate-cl-struct' it won't be cl struct
anymore.
+ "Invalidate CL-X, after `X-invalidate-cl-struct' it won't be struct anymore.
NOTE: works only if CL-X is vector."
(if (vectorp cl-x)
(let ((i (length cl-x)))
@@ -243,7 +256,7 @@
t)))
(defun X-Win-invalidate (xdpy win)
- "Remove WIN from dpy list and invalidate cl struct."
+ "For XDPY display remove WIN from its window list and invalidate WIN."
(add-timeout X-default-timeout
#'(lambda (xdpy-win)
(setf (X-Dpy-windows (car xdpy-win))
@@ -252,14 +265,14 @@
(cons xdpy win)))
(defun X-Win-find (xdpy wid)
- "Find X-Win with id WID on XDPY."
+ "On XDPY find window by WID."
(let ((wl (X-Dpy-windows xdpy)))
(while (and wl (not (= (X-Win-id (car wl)) wid)))
(setq wl (cdr wl)))
(car wl)))
(defun X-Win-find-or-make (xdpy wid)
- "Find X-Win with id WID on display XDPY, or make new one if not found."
+ "On XDPY find X-Win with id WID, or make new one if not found."
(or (X-Win-find xdpy wid)
(let ((xwin (make-X-Win :dpy xdpy :id wid)))
(X-Dpy-log xdpy 'x-event "XDPY Adding new window: %S" 'wid)
@@ -279,7 +292,8 @@
(let* ((dpy (X-Event-dpy xev))
(wev (X-Event-win-event xev)))
(X-Dpy-log dpy 'x-event "XEvent %S/%S: win=0x%x/0x%x"
- '(XAnyEvent->type xev) '(X-Event-name xev) '(X-Win-id wev)
'(X-Win-id (X-Event-win xev)))
+ '(XAnyEvent->type xev) '(X-Event-name xev) '(X-Win-id wev)
+ '(X-Win-id (X-Event-win xev)))
;; First run display handlers
(when (X-Dpy-event-handlers dpy)
@@ -376,6 +390,7 @@
(put 'X-Event-CASE 'lisp-indent-function 1)
(defun X-Event-p (xev)
+ "Return non-nil if XEV is X-Event."
(and (ffi-object-p xev)
(member (ffi-object-type xev)
'(XEvent (pointer XEvent)))))
@@ -583,13 +598,12 @@
(defalias-xev-win X-Event-xclient-window XClientMessageEvent->window)
(defalias 'X-Event-xclient-atom 'XClientMessageEvent->message_type)
(defun X-Event-xclient-msg (xev)
- "Pretty hackish, just to make it compatible with X-Event-xclient-msg from
xlib."
- (let (ret)
- (dotimes (i 5)
- (setq ret (cons (list (ffi-fetch xev (+ (ffi-slot-offset
'XClientMessageEvent 'data)
- (* i 4)) 'long))
- ret)))
- (nreverse ret)))
+ "Make it compatible with `X-Event-xclient-msg' from xlib."
+ (mapcar #'(lambda (i)
+ (list (ffi-fetch
+ xev (+ (ffi-slot-offset 'XClientMessageEvent 'data)
+ (* i 4)) 'long)))
+ '(0 1 2 3 4)))
(defalias 'X-Event-xmapping-request 'XMappingEvent->request)
(defalias 'X-Event-xmapping-first-keycode 'XMappingEvent->first_keycode)
@@ -772,8 +786,8 @@
(if (X-Win-p d)
(X-Win-put-prop d 'xdepth (ffi-get r-depth))
(X-Pixmap-put-prop d 'xdepth (ffi-get r-depth)))
- (make-X-Geom :x (ffi-get r-x) :y (ffi-get r-y) :width (ffi-get r-w)
:height (ffi-get r-h)
- :border-width (ffi-get r-bw))))
+ (make-X-Geom :x (ffi-get r-x) :y (ffi-get r-y) :width (ffi-get r-w)
+ :height (ffi-get r-h) :border-width (ffi-get r-bw))))
(defun XGetDepth (xdpy d)
"On display xdpy return drawable's D depth."
@@ -866,7 +880,10 @@
(defalias 'X-Atom-find-by-name 'XInternAtom)
(defun XGetAtomName (xdpy atom)
- (X:GetAtomName xdpy atom))
+ (let ((name (X:GetAtomName xdpy atom)))
+ (prog1
+ (ffi-fetch name 0 'c-string)
+ (X:Free name))))
(defalias 'X-Atom-name 'XGetAtomName)
(defun-x11 XChangeProperty (xdpy win property type format mode data)
@@ -876,25 +893,29 @@
(ecase format
(8 (setq fod (make-ffi-object '(pointer byte) (length data))))
(16 (setq fod (make-ffi-object
- '(pointer short) (* (ffi-size-of-type 'short) (length
data)))))
+ '(pointer short) (* (ffi-size-of-type 'short)
+ (length data)))))
(32 (setq fod (make-ffi-object
- '(pointer int) (* (ffi-size-of-type 'int) (length
data))))))
+ '(pointer int) (* (ffi-size-of-type 'int)
+ (length data))))))
(dotimes (idx (length data))
(setq vd (nth idx data))
(when (X-Drawable-p vd)
(setq vd (X-Drawable-id vd)))
(ffi-aset fod idx vd)))
- (X:ChangeProperty xdpy (X-Win-id win) property type format mode fod
(length data))))
+ (X:ChangeProperty xdpy (X-Win-id win) property type format mode
+ fod (length data))))
(defun-x11 XDeleteProperty (xdpy win prop)
(X:DeleteProperty xdpy (X-Win-id win) prop))
(defun XSetPropertyString (xdpy win atom string &optional mode)
"On display XDPY and window WIN set ATOM property to STRING."
- (XChangeProperty xdpy win atom XA-string X-format-8 (or mode
X-PropModeReplace)
- string))
+ (XChangeProperty xdpy win atom XA-string X-format-8
+ (or mode X-PropModeReplace) string))
-(defun XGetWindowProperty (xdpy win property &optional offset length delete
required-type)
+(defun XGetWindowProperty (xdpy win property
+ &optional offset length delete required-type)
(unless offset (setq offset 0))
(unless length (setq length 1024))
(unless required-type (setq required-type XA-AnyPropertyType))
@@ -903,38 +924,47 @@
(ni-ret (make-ffi-object 'unsigned-long))
(ba-ret (make-ffi-object 'unsigned-long))
(pv-ret (make-ffi-object 'c-string (1+ length))))
- (X:GetWindowProperty xdpy (X-Win-id win) property offset length (if delete
1 0) required-type
- (ffi-address-of aa-ret) (ffi-address-of af-ret)
(ffi-address-of ni-ret)
- (ffi-address-of ba-ret) (ffi-address-of pv-ret))
- (list (ffi-get aa-ret) (ffi-get ba-ret)
- (cond ((or (= (ffi-get af-ret) 8)
- (eq required-type XA-string))
- (if (ffi-null-p pv-ret) "" (ffi-get pv-ret)))
- ((eq required-type XA-atom) )
- ((eq required-type XA-window) )
- ((eq required-type XA-rectangle) )
- ((= (ffi-get af-ret) 0) "")
- (t (let (ntype rt)
- (ecase (ffi-get af-ret)
- (16 (setq ntype 'short))
- (32 (setq ntype 'int)))
- (dotimes (idx (ffi-get ni-ret))
- (push (ffi-fetch pv-ret (* (ffi-size-of-type ntype)
idx) ntype) rt))
- (nreverse rt)))))))
+ (when (zerop (X:GetWindowProperty
+ xdpy (X-Win-id win) property offset length
+ (if delete 1 0) required-type (ffi-address-of aa-ret)
+ (ffi-address-of af-ret) (ffi-address-of ni-ret)
+ (ffi-address-of ba-ret) (ffi-address-of pv-ret)))
+ (prog1
+ (list (ffi-get aa-ret) (ffi-get ba-ret)
+ (cond ((or (= (ffi-get af-ret) 8)
+ (eq required-type XA-string))
+ (if (ffi-null-p pv-ret) "" (ffi-get pv-ret)))
+ ((eq required-type XA-atom) )
+ ((eq required-type XA-window) )
+ ((eq required-type XA-rectangle) )
+ ((= (ffi-get af-ret) 0) "")
+ (t (let (ntype rt)
+ (ecase (ffi-get af-ret)
+ (16 (setq ntype 'short))
+ (32 (setq ntype 'int)))
+ (dotimes (idx (ffi-get ni-ret))
+ (push (ffi-fetch
+ pv-ret (* (ffi-size-of-type ntype) idx)
+ ntype) rt))
+ (nreverse rt)))))
+ (X:Free pv-ret)))))
(defun XDecodeCompoundText (text)
"Decode compound TEXT, to native string.
Evil hack, invent something better."
(if (string-match "\x1b\x25\x2f\x31\\(.\\)\\(.\\)\\(.*?\\)\x02" text)
- (let ((len (+ (* (- (char-to-int (string-to-char (match-string 1 text)))
128) 128)
- (- (char-to-int (string-to-char (match-string 2 text)))
128))))
+ (let ((len (+ (* (- (char-to-int (string-to-char (match-string 1 text)))
+ 128) 128)
+ (- (char-to-int (string-to-char (match-string 2 text)))
+ 128))))
(let ((seq-beg (match-beginning 0))
(data-beg (match-end 0))
(data-end (+ len (match-beginning 3)))
(cs (intern (match-string 3 text))))
(concat (substring text 0 seq-beg)
(if (fboundp 'decode-coding-string)
- (decode-coding-string (substring text data-beg data-end)
cs)
+ (decode-coding-string
+ (substring text data-beg data-end) cs)
(substring text data-beg data-end))
(XDecodeCompoundText (substring text data-end)))))
text))
@@ -1129,7 +1159,8 @@
(defun-x11 XDrawPoints (dpy d gc points &optional mode)
(unless mode
(setq mode X-Origin))
- (X:DrawPoints dpy (X-Drawable-id d) gc (X:make-points points) (length
points) mode))
+ (X:DrawPoints dpy (X-Drawable-id d) gc (X:make-points points)
+ (length points) mode))
(defun X:make-rectangles (rects)
(let* ((frects (make-ffi-object `(array XRectangle ,(length rects))))
@@ -1292,22 +1323,27 @@
(defalias 'X-Image-height 'XImage->height)
(defun-x11 XImagePut (dpy gc d x y img &optional src_x src_y width height)
- (X:PutImage dpy (X-Drawable-id d) gc img 0 0 x y (XImage->width img)
(XImage->height img)))
+ (X:PutImage dpy (X-Drawable-id d) gc img 0 0 x y (XImage->width img)
+ (XImage->height img)))
(defun-x11 XImageGet (dpy d x y width height)
(X:GetImage dpy (X-Drawable-id d) x y width height X-AllPlanes X-ZPixmap))
+(defalias 'XDestroyImage 'X:DestroyImage)
+
(defun-x11 XSetDashes (dpy gc dash-offset dashes)
(let ((fd (make-ffi-object `(array char ,(length dashes)))))
(dotimes (idx (length dashes))
(ffi-aset fd idx (int-to-char (nth idx dashes))))
(X:SetDashes dpy gc dash-offset fd (length dashes))))
-(defun-x11 XSetClipRectangles (dpy gc clip-x-origin clip-y-origin rectangels
&optional order)
+(defun-x11 XSetClipRectangles (dpy gc clip-x-origin clip-y-origin rectangels
+ &optional order)
(unless order
(setq order X-UnSorted))
- (X:SetClipRectangles dpy gc clip-x-origin clip-y-origin (X:make-rectangles
rectangels)
- (length rectangels) order))
+ (X:SetClipRectangles
+ dpy gc clip-x-origin clip-y-origin
+ (X:make-rectangles rectangels) (length rectangels) order))
(defun-x11 XGrabKeyboard (dpy grab-win &optional owe pmode kmode time)
(X:GrabKeyboard dpy (X-Win-id grab-win) (if owe 1 0)
@@ -1317,7 +1353,8 @@
(defun-x11 XUngrabKeyboard (dpy &optional time)
(X:UngrabKeyboard dpy (or time X-CurrentTime)))
-(defun-x11 XGrabPointer (dpy grab-win ev-mask &optional cursor owe pmode kmode
confto-win time)
+(defun-x11 XGrabPointer (dpy grab-win ev-mask
+ &optional cursor owe pmode kmode confto-win time)
(X:GrabPointer dpy (X-Win-id grab-win) (if owe 1 0)
ev-mask (or pmode X-GrabModeAsync) (or kmode X-GrabModeAsync)
(if confto-win (X-Win-id confto-win) X-None)
@@ -1328,7 +1365,8 @@
(X:UngrabPointer dpy (or time X-CurrentTime)))
(defun-x11 XChangeActivePointerGrab (xdpy cursor ev-mask &optional time)
- (X:ChangeActivePointerGrab xdpy (or cursor X-None) ev-mask (or time
X-CurrentTime)))
+ (X:ChangeActivePointerGrab
+ xdpy (or cursor X-None) ev-mask (or time X-CurrentTime)))
(defun-x11 XQueryPointer (dpy win)
(let ((r-root (make-ffi-object 'Window))
@@ -1338,17 +1376,18 @@
(r-wx (make-ffi-object 'int))
(r-wy (make-ffi-object 'int))
(r-m (make-ffi-object 'unsigned-int)))
- (X:QueryPointer dpy (X-Win-id win) (ffi-address-of r-root) (ffi-address-of
r-child)
- (ffi-address-of r-rx) (ffi-address-of r-ry)
- (ffi-address-of r-wx) (ffi-address-of r-wy)
- (ffi-address-of r-m))
+ (X:QueryPointer dpy (X-Win-id win) (ffi-address-of r-root)
+ (ffi-address-of r-child) (ffi-address-of r-rx)
+ (ffi-address-of r-ry) (ffi-address-of r-wx)
+ (ffi-address-of r-wy) (ffi-address-of r-m))
(list t 1 nil (X-Win-find-or-make dpy (ffi-get r-root))
(X-Win-find-or-make dpy (ffi-get r-child))
(ffi-get r-rx) (ffi-get r-ry)
(ffi-get r-wx) (ffi-get r-wy)
(ffi-get r-m))))
-(defun-x11 XWarpPointer (dpy src-win dst-win src-x src-y src-width src-height
dest-x dest-y)
+(defun-x11 XWarpPointer (dpy src-win dst-win src-x src-y
+ src-width src-height dest-x dest-y)
(X:WarpPointer dpy (X-Win-id src-win) (X-Win-id dst-win)
src-x src-y src-width src-height dest-x dest-y))
@@ -1356,9 +1395,10 @@
(let ((dest-x-ret (make-ffi-object 'int))
(dest-y-ret (make-ffi-object 'int))
(child-ret (make-ffi-object 'Window)))
- (X:TranslateCoordinates dpy (X-Win-id src-win) (X-Win-id dst-win) src-x
src-y
- (ffi-address-of dest-x-ret) (ffi-address-of
dest-y-ret)
- (ffi-address-of child-ret))
+ (X:TranslateCoordinates
+ dpy (X-Win-id src-win) (X-Win-id dst-win) src-x src-y
+ (ffi-address-of dest-x-ret) (ffi-address-of dest-y-ret)
+ (ffi-address-of child-ret))
(cons (cons (ffi-get dest-x-ret) (ffi-get dest-y-ret))
(X-Win-find-or-make dpy (ffi-get child-ret)))))
@@ -1378,7 +1418,8 @@
:blue (plist-get cursor-attrs :bgblue))))
(X:CreateGlyphCursor xdpy src mask src-chr msk-chr fg bg)))
-(defun-x11 XRecolorCursor (dpy cursor fore-red fore-green fore-blue &optional
back-red back-green back-blue)
+(defun-x11 XRecolorCursor (dpy cursor fore-red fore-green fore-blue
+ &optional back-red back-green back-blue)
(let ((fg (make-X-Color :red fore-red :green fore-green :blue fore-blue))
(bg (make-X-Color :red back-red :green back-green :blue back-blue)))
(X:RecolorCursor dpy cursor fg bg)))
@@ -1470,14 +1511,15 @@
(defun XGetWMNormalHints (dpy w)
(let ((nh (make-ffi-object 'XSizeHints))
(rl (make-ffi-object 'long)))
- (X:GetWMNormalHints dpy (X-Win-id w) (ffi-address-of nh) (ffi-address-of
rl))
+ (X:GetWMNormalHints
+ dpy (X-Win-id w) (ffi-address-of nh) (ffi-address-of rl))
nh))
(defun X:make-XSizeHints (&rest hints)
(let ((nh (make-ffi-object 'XSizeHints)))
(while hints
(case (car hints)
- (:flags (setf (XSizeHints->flags (cadr hints))))
+ (:flags (setf (XSizeHints->flags nh) (cadr hints)))
(:x (setf (XSizeHints->x nh) (cadr hints)))
(:y (setf (XSizeHints->y nh) (cadr hints)))
(:width (setf (XSizeHints->width nh) (cadr hints)))
@@ -1569,16 +1611,24 @@
(defalias 'make-X-WMHints 'X:make-XWMHints)
(defun-x11 XSetWMHints (dpy w &rest params)
- (X:SetWMHints dpy (X-Win-id w) (ffi-address-of (apply #'X:make-XWMHints
params))))
+ (X:SetWMHints
+ dpy (X-Win-id w) (ffi-address-of (apply #'X:make-XWMHints params))))
(defun XGetWMProtocols (dpy win)
(let ((rp (make-ffi-object '(pointer Atom)))
(rc (make-ffi-object 'int))
ret-list)
- (X:GetWMProtocols dpy (X-Win-id win) (ffi-address-of rp) (ffi-address-of
rc))
- (dotimes (idx (ffi-get rc))
- (push (ffi-aref rp idx) ret-list))
- (nreverse ret-list)))
+ ;; From XGetWMProtocols(3)
+ ;; XGetWMProtocols sets the
+ ;; protocols_return argument to a list of atoms, sets the count_return
+ ;; argument to the number of elements in the list, and returns a nonzero
+ ;; status. Otherwise, it sets neither of the return arguments and returns
+ ;; a zero status. To release the list of atoms, use XFree.
+ (unless (zerop (X:GetWMProtocols
+ dpy (X-Win-id win) (ffi-address-of rp) (ffi-address-of
rc)))
+ (dotimes (idx (ffi-get rc))
+ (push (ffi-aref rp idx) ret-list))
+ (nreverse ret-list))))
(defun XWMProtocol-set-p (xdpy wmprotos name)
"Return non-nil when atom with NAME is in WM_PROTOCOLS WMPROTO."
@@ -1623,18 +1673,8 @@
""))))
(defun XGetWMCommand (dpy win)
- "")
-; (let* ((av (make-ffi-object '(pointer (pointer char))))
-; (ac (make-ffi-object 'int))
-; (wcmd ""))
-; (X:GetCommand dpy (X-Win-id win) (ffi-address-of av) (ffi-address-of ac))
-; (dotimes (idx (ffi-get ac))
-; (setq wcmd (concat wcmd (or (and (not (ffi-null-p (ffi-aref av idx)))
-; (ffi-get (ffi-aref av idx) :type
'c-string))
-; "") " ")))
-; (if (string= wcmd "")
-; ""
-; (substring wcmd 0 (1- (length wcmd))))))
+ "On display XDPY, get window's WIN WM_COMMAND."
+ (XGetPropertyString dpy win XA-wm-command))
(defun XSetWMCommand (dpy win cmd)
(error "not implemented yet"))
@@ -1673,10 +1713,12 @@
(X:AllowEvents dpy mode (or time X-CurrentTime)))
(defun-x11 XSetInputFocus (dpy win-or-val rev-to &optional time)
- (X:SetInputFocus dpy (if (X-Win-p win-or-val) (X-Win-id win-or-val)
win-or-val) rev-to
- (or time X-CurrentTime)))
+ (X:SetInputFocus dpy (if (X-Win-p win-or-val)
+ (X-Win-id win-or-val)
+ win-or-val) rev-to (or time X-CurrentTime)))
-(defun-x11 XGrabButton (dpy button mods grab-win ev-mask &optional cursor owe
pmode kmode conf-to)
+(defun-x11 XGrabButton
+ (dpy button mods grab-win ev-mask &optional cursor owe pmode kmode conf-to)
(X:GrabButton dpy button mods (X-Win-id grab-win) (if owe 1 0) ev-mask
(or pmode X-GrabModeAsync) (or kmode X-GrabModeAsync)
(if conf-to (X-Win-id conf-to) X-None) (or cursor X-None)))
@@ -1685,7 +1727,8 @@
(X:UngrabButton dpy button mods (X-Win-id grab-win)))
(defun-x11 XGrabKey (dpy keycode mods grab-win &optional owe pmode kmode)
- (X:GrabKey dpy keycode mods (X-Win-id grab-win) (if owe 1 0) (or pmode
X-GrabModeAsync) (or kmode X-GrabModeAsync)))
+ (X:GrabKey dpy keycode mods (X-Win-id grab-win) (if owe 1 0)
+ (or pmode X-GrabModeAsync) (or kmode X-GrabModeAsync)))
(defun-x11 XUngrabKey (dpy key mods grab-win)
(X:UngrabKey dpy key mods (X-Win-id grab-win)))
@@ -1700,14 +1743,18 @@
(push
(let ((kmlist nil))
(dotimes (mk max-kpm (nreverse kmlist))
- (push (char-to-int (ffi-fetch modmap (+ (* mi max-kpm) mk)
'KeyCode))
+ (push (char-to-int
+ (ffi-fetch modmap (+ (* mi max-kpm) mk) 'KeyCode))
kmlist)))
retval))
- (nconc '(t 0 0 0 0 0 0 0) (list (nreverse retval))))))
+ (prog1
+ (nconc '(t 0 0 0 0 0 0 0) (list (nreverse retval)))
+ (X:FreeModifiermap mkm)))))
(defun XGetKeyboardMapping (dpy keycode count)
(let* ((kpkr (make-ffi-object 'int))
- (ksyms (X:GetKeyboardMapping dpy (int-to-char keycode) count
(ffi-address-of kpkr)))
+ (ksyms (X:GetKeyboardMapping
+ dpy (int-to-char keycode) count (ffi-address-of kpkr)))
(ksyms-per-kcode (ffi-get kpkr))
kcsyms kclist)
(while (> count 0)
@@ -1717,7 +1764,9 @@
(push (nreverse kcsyms) kclist)
(setq kcsyms nil)
(decf count))
- (list t 0 (cons '(0 0 0 0) (butlast kclist)))))
+ (prog1
+ (list t 0 (cons '(0 0 0 0) (butlast kclist)))
+ (X:Free ksyms))))
(defun XGetInputFocus (dpy)
(let ((rw (make-ffi-object 'Window))
@@ -1726,15 +1775,16 @@
(X-Win-find-or-make dpy (ffi-get rw))))
(defun-x11 XCopyArea (dpy src-d dst-d gc src-x src-y width height dst-x dst-y)
- (X:CopyArea dpy (X-Drawable-id src-d) (X-Drawable-id dst-d) gc src-x src-y
width height dst-x dst-y))
+ (X:CopyArea dpy (X-Drawable-id src-d) (X-Drawable-id dst-d)
+ gc src-x src-y width height dst-x dst-y))
(defun XQueryExtension (dpy name)
(let* ((mop (make-ffi-object 'int))
(fev (make-ffi-object 'int))
(fer (make-ffi-object 'int)))
- (unless (zerop (X:QueryExtension dpy (ffi-create-fo 'c-string name)
- (ffi-address-of mop) (ffi-address-of fev)
- (ffi-address-of fer)))
+ (unless (zerop (X:QueryExtension
+ dpy (ffi-create-fo 'c-string name) (ffi-address-of mop)
+ (ffi-address-of fev) (ffi-address-of fer)))
(list t nil nil nil (ffi-get mop)))))
(defun X-Dpy-get-extension (xdpy extname &optional sig)
@@ -1776,14 +1826,6 @@
(defsetf X-Dpy-snd-queue (dpy) (q))
(defsetf X-Dpy-message-buffer (dpy) (mb))
-
-;;(progn
-;; (setq dpy (X:OpenDisplay ":0"))
-;; (X:Dpy-setup dpy :log-buffer "*X-debug*" :log-routines '(x-event))
-;; (setq sw (X:CreateSimpleWindow dpy (Screen->root (Display->screens dpy)) 0
0 100 100 0 0 0))
-;; (X:MapRaised dpy sw)
-;; (X:Flush dpy))
-
(provide 'xlib-xlib)
;;; xlib-xlib.el ends here
|