On Thu, Aug 29, 2002 at 10:38:04AM -0400, Raymond Toy wrote:
> >>>>> "Manuel" == Manuel Giraud <[EMAIL PROTECTED]> writes:
>
> Manuel> Raymond Toy <[EMAIL PROTECTED]> writes:
> >>
> >> Thanks for this update, but what is supposed to happen here? On my
> >> Sparc system, when running cmulisp inside XEmacs, I don't get a
> >> sigsegv anymore. That's good. But now it returns #<XLIB:WINDOW
> >> unix:0 213910036>. In fact
> >>
> >> (let ((dpy (ext:open-clx-display)))
> >> (xlib:input-focus dpy))
> >>
> >> returns
> >>
> >> #<XLIB:WINDOW unix:0 213910036>
> >> :PARENT
> >>
> >> Is this right?
> >>
>
> Manuel> Compare the string returned by:
>
> Manuel> (let ((dpy (ext:open-clx-display)))
> Manuel> (format nil "0x~X" (xlib:drawable-id (xlib:input-focus dpy))))
>
> I guess I wasn't clear enough. The first value from xlib:input-focus
> is XLIB:WINDOW object. However, in the original question, we were
> returning (nth-value 0 (xlib:input-focus dpy)) and people were getting
> things like :POINTER-ROOT. With Peter's change, I get the xlib:window
> object. The second value is :PARENT. Without his change, I was
> getting a segfault.
>
> So why does (nth-value 0 ...) give my the window instead of some
> keyword?
Ready for a long story?
In /usr/share/doc/xspecs/proto.txt.gz (debian box) we see:
(appendix A):
GetInputFocus
1 43 opcode
1 unused
2 1 request length
->
1 1 Reply
1 revert-to
0 None
1 PointerRoot
2 Parent
2 CARD16 sequence number
4 0 reply length
4 WINDOW focus
0 None
1 PointerRoot
20 unused
So at offset 8 (1+1+2+4) we will either find a window or 0 or 1.
$ lisp
CMU Common Lisp release x86-linux 3.1.2 18d+ 29 August 2002 build 4186, running on
mustyr-host
For support see http://www.cons.org/cmucl/support.html Send bug reports to the debian
BTS.
or to [EMAIL PROTECTED]
type (help) for help, (quit) to exit, and (demo) to see the demos
Loaded subsystems:
Python 1.0, target Intel x86
CLOS based on PCL version: September 16 92 PCL (f)
* (require :cmucl-clx)
; Loading #p"/usr/share/common-lisp/systems/cmucl-clx.system".
(#<FILE: hemlock;keysym-defs> #<FILE: hemlock;key-event>
#<FILE: hemlock;charmacs> #<FILE: code;clx-ext>)
* (in-package :xlib)
#<The XLIB package, 1515/2372 internal, 560/590 external>
The original source was:
(defun input-focus (display)
(declare (type display display))
(declare (clx-values focus revert-to))
(with-buffer-request-and-reply (display *x-getinputfocus* 16 :sizes (8 32))
()
(values
(or-get 8 (member :none :pointer-root) window)
(member8-get 1 :none :pointer-root :parent))))
The important part is the
(or-get 8 (member :none :pointer-root) window)
stuff. It says that there is either a set of 2 that gives :none or :pointer-root or a
window at
the offset 8. (look how at offset 1 we find the :none :pointer-root :parent set).
What does it do?
* (macroexpand '(or-get 8 (member :none :pointer-root) window))
(LET ((#:G1271 (READ-CARD32 8)))
(MACROLET ((READ-CARD32 (INDEX)
INDEX
'#:G1271)
(READ-CARD29 (INDEX)
INDEX
'#:G1271))
(LET ((#:G1273
(LET ((#:G1272 (READ-CARD29 8)))
(DECLARE (TYPE (INTEGER 0 (2)) #:G1272))
(TYPE-CHECK #:G1272 '(INTEGER 0 (2)))
(SVREF '#(:NONE :POINTER-ROOT) #:G1272))))
(IF #:G1273 #:G1273 (COND ((LOOKUP-WINDOW %BUFFER (READ-CARD29 8))))))))
Notice that it first tries to get the [01] case. Notice the type-check. Then
notice the svref without checking first if this could be a window.
So what does it read?
* (macroexpand '(with-buffer-request-and-reply (display *x-getinputfocus* 16 :sizes (8
32))
()
(values
(or-get 8 (member :none :pointer-root) window)
(member8-get 1 :none :pointer-root :parent))))
(LET ((.DISPLAY. DISPLAY) (.PENDING-COMMAND. NIL) (.REPLY-BUFFER. NIL))
(DECLARE (TYPE DISPLAY .DISPLAY.)
(TYPE (OR NULL PENDING-COMMAND) .PENDING-COMMAND.)
(TYPE (OR NULL REPLY-BUFFER) .REPLY-BUFFER.))
(UNWIND-PROTECT
(PROGN
(WITH-BUFFER (.DISPLAY.)
(SETQ .PENDING-COMMAND. (START-PENDING-COMMAND .DISPLAY.))
(WITHOUT-ABORTS
(WITH-BUFFER-REQUEST-INTERNAL
(.DISPLAY. *X-GETINPUTFOCUS*)))
(BUFFER-FORCE-OUTPUT .DISPLAY.)
(DISPLAY-INVOKE-AFTER-FUNCTION .DISPLAY.))
(SETQ .REPLY-BUFFER. (READ-REPLY .DISPLAY. .PENDING-COMMAND.))
(WITH-BUFFER-INPUT (.REPLY-BUFFER. :DISPLAY .DISPLAY. :SIZES (8 32))
NIL
(VALUES
(OR-GET 8 (MEMBER :NONE :POINTER-ROOT) WINDOW)
(MEMBER8-GET 1 :NONE :POINTER-ROOT :PARENT))))
(WHEN .REPLY-BUFFER. (DEALLOCATE-REPLY-BUFFER .REPLY-BUFFER.))
(WHEN .PENDING-COMMAND.
(STOP-PENDING-COMMAND .DISPLAY. .PENDING-COMMAND.))))
T
* (defun testo (display)
(LET ((.DISPLAY. DISPLAY) (.PENDING-COMMAND. NIL) (.REPLY-BUFFER. NIL))
(DECLARE (TYPE DISPLAY .DISPLAY.)
(TYPE (OR NULL PENDING-COMMAND) .PENDING-COMMAND.)
(TYPE (OR NULL REPLY-BUFFER) .REPLY-BUFFER.))
(UNWIND-PROTECT
(PROGN
(WITH-BUFFER (.DISPLAY.)
(SETQ .PENDING-COMMAND. (START-PENDING-COMMAND .DISPLAY.))
(WITHOUT-ABORTS
(WITH-BUFFER-REQUEST-INTERNAL
(.DISPLAY. *X-GETINPUTFOCUS*)))
(BUFFER-FORCE-OUTPUT .DISPLAY.)
(DISPLAY-INVOKE-AFTER-FUNCTION .DISPLAY.))
(SETQ .REPLY-BUFFER. (READ-REPLY .DISPLAY. .PENDING-COMMAND.))
(WITH-BUFFER-INPUT (.REPLY-BUFFER. :DISPLAY .DISPLAY. :SIZES (8 32))
NIL
(VALUES
(LET ((G1271 (READ-CARD32 8)))
(MACROLET ((READ-CARD32 (INDEX)
INDEX
'G1271)
(READ-CARD29 (INDEX)
INDEX
'G1271))
(LET ((G1273
(LET ((G1272 (READ-CARD29 8)))
(DECLARE (TYPE (INTEGER 0 (2)) G1272))
(format t "read got ~S~&" G1271)
(TYPE-CHECK G1272 '(INTEGER 0 (2)))
(SVREF '#(:NONE :POINTER-ROOT) G1272))))
(format t "let returned: ~S~&" G1273)
(IF G1273 G1273 (COND ((LOOKUP-WINDOW %BUFFER (READ-CARD29 8))))))))
(MEMBER8-GET 1 :NONE :POINTER-ROOT :PARENT))))
(WHEN .REPLY-BUFFER. (DEALLOCATE-REPLY-BUFFER .REPLY-BUFFER.))
(WHEN .PENDING-COMMAND.
(STOP-PENDING-COMMAND .DISPLAY. .PENDING-COMMAND.)))))
TESTO
* (defvar *disp* (ext:open-clx-display))
*DISP*
* (testo *disp*)
read got 31457282
31457282 isn't a (INTEGER 0 (2))
Before this would still work, not it just gives me an error. :-)
So the hack seems to be to check for a window first. The 'correct' thing seems
to be to check if the value is plausible for the datatype we want. But that
requires a lot of macro-hacking...
Groetjes, Peter
--
It's logic Jim, but not as we know it. | [EMAIL PROTECTED]
"God, root, what is difference?" - Pitr| http://people.debian.org/~pvaneynd/
"God is more forgiving." - Dave Aronson| http://users.belgacom.net/bn110523/
-- Attached file included as plaintext by Listar --
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.0.7 (GNU/Linux)
iD8DBQE9bkvT11ldN0tyliURApJjAJ9HfvLpwRWcyRUNjquUctoBiW5lkgCgqn/X
fb0K0CUm07onUrLOjqBG+eo=
=G62R
-----END PGP SIGNATURE-----
