From: <cli...@li...> - 2007-09-26 15:25:26
|
Send clisp-cvs mailing list submissions to cli...@li... To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to cli...@li... You can reach the person managing the list at cli...@li... When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/src ChangeLog,1.5569,1.5570 (Sam Steingold) 2. clisp/modules/clx/new-clx test.tst,1.4,1.5 clx.f,2.70,2.71 (Sam Steingold) 3. clisp/src ChangeLog,1.5570,1.5571 (Sam Steingold) 4. clisp/modules/clx/new-clx test.tst, 1.5, 1.6 clx.lisp, 1.18, 1.19 clx.f, 2.71, 2.72 (Sam Steingold) 5. clisp/modules/clx/new-clx test.tst,1.6,1.7 (Sam Steingold) 6. clisp/src ChangeLog,1.5571,1.5572 (Sam Steingold) ---------------------------------------------------------------------- Message: 1 Date: Tue, 25 Sep 2007 19:51:25 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog,1.5569,1.5570 To: cli...@li... Message-ID: <E1I...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv15275/src Modified Files: ChangeLog Log Message: (make_key_vector): do not clobber value1 (check_bitvec_256): new macro (get_key_vector): implemented (XLIB:OPEN-DISPLAY): call disable_sigpipe() not here, but ... (module__clx__init_function_2): ... here (XLIB::SET-GCONTEXT-DASHES, handle_image_z, XLIB:PUT-IMAGE) (XLIB:CHANGE-PROPERTY, XLIB:GLOBAL-POINTER-POSITION) (XLIB:KEYBOARD-MAPPING, XLIB:OPEN-DISPLAY): remove unused variable (font_char_info): simplify to avoid a gcc warning (XLIB:INPUT-FOCUS): fix STACK handling (XLIB:GRAB-KEY): fix XGrabKey call (XLIB:QUERY-KEYMAP): use check_bitvec_256 (XLIB:KEYCODE->CHARACTER): fix KEYSYM-INDEX-FUNCTION handling Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.5569 retrieving revision 1.5570 diff -u -d -r1.5569 -r1.5570 --- ChangeLog 24 Sep 2007 02:01:26 -0000 1.5569 +++ ChangeLog 25 Sep 2007 19:51:22 -0000 1.5570 @@ -1,7 +1,23 @@ +2007-09-25 Sam Steingold <sd...@gn...> + + * modules/clx/new-clx/clx.f (make_key_vector): do not clobber value1 + (check_bitvec_256): new macro + (get_key_vector): implemented + (XLIB:OPEN-DISPLAY): call disable_sigpipe() not here, but ... + (module__clx__init_function_2): ... here + (XLIB::SET-GCONTEXT-DASHES, handle_image_z, XLIB:PUT-IMAGE) + (XLIB:CHANGE-PROPERTY, XLIB:GLOBAL-POINTER-POSITION) + (XLIB:KEYBOARD-MAPPING, XLIB:OPEN-DISPLAY): remove unused variable + (font_char_info): simplify to avoid a gcc warning + (XLIB:INPUT-FOCUS): fix STACK handling + (XLIB:GRAB-KEY): fix XGrabKey call + (XLIB:QUERY-KEYMAP): use check_bitvec_256 + (XLIB:KEYCODE->CHARACTER): fix KEYSYM-INDEX-FUNCTION handling + 2007-09-23 Sam Steingold <sd...@gn...> * modules/gdbm/gdbm.c (with_datum): replacement for with_gdbm_key - * modules/gdbm/gdbm.lisp (define-condition): + * modules/gdbm/gdbm.lisp (define-condition): do not terminate the message with "." 2007-09-23 Masayuki Onjo <mas...@gm...> ------------------------------ Message: 2 Date: Tue, 25 Sep 2007 19:51:25 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/modules/clx/new-clx test.tst,1.4,1.5 clx.f,2.70,2.71 To: cli...@li... Message-ID: <E1I...@ma...> Update of /cvsroot/clisp/clisp/modules/clx/new-clx In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv15275/modules/clx/new-clx Modified Files: test.tst clx.f Log Message: (make_key_vector): do not clobber value1 (check_bitvec_256): new macro (get_key_vector): implemented (XLIB:OPEN-DISPLAY): call disable_sigpipe() not here, but ... (module__clx__init_function_2): ... here (XLIB::SET-GCONTEXT-DASHES, handle_image_z, XLIB:PUT-IMAGE) (XLIB:CHANGE-PROPERTY, XLIB:GLOBAL-POINTER-POSITION) (XLIB:KEYBOARD-MAPPING, XLIB:OPEN-DISPLAY): remove unused variable (font_char_info): simplify to avoid a gcc warning (XLIB:INPUT-FOCUS): fix STACK handling (XLIB:GRAB-KEY): fix XGrabKey call (XLIB:QUERY-KEYMAP): use check_bitvec_256 (XLIB:KEYCODE->CHARACTER): fix KEYSYM-INDEX-FUNCTION handling Index: clx.f =================================================================== RCS file: /cvsroot/clisp/clisp/modules/clx/new-clx/clx.f,v retrieving revision 2.70 retrieving revision 2.71 diff -u -d -r2.70 -r2.71 --- clx.f 23 Sep 2007 19:45:59 -0000 2.70 +++ clx.f 25 Sep 2007 19:51:23 -0000 2.71 @@ -1,7 +1,7 @@ /* -*- C -*- vim:filetype=c Copyright (c) 1996-1999 by Gilbert Baumann, distributed under GPL Bruno Haible 1998-2000 -Sam Steingold 2001-2005 +Sam Steingold 2001-2005, 2007 ---------------------------------------------------------------------------- Title: C implementation of CLX utilizing the Xlib @@ -1446,14 +1446,20 @@ static object make_key_vector (char key_vector[32]) { - value1= allocate_bit_vector (Atype_Bit, 256); - X_CALL(memcpy (TheSbvector(value1)->data, key_vector, 32)); - return value1; + object ret = allocate_bit_vector (Atype_Bit, 256); + X_CALL(memcpy (TheSbvector(ret)->data, key_vector, 32)); + return ret; } +#define check_bitvec_256(obj) \ + if (!(simple_bit_vector_p (Atype_Bit, obj) \ + && Sbvector_length (obj) == 256)) \ + my_type_error(`(SIMPLE-BIT-VECTOR 256)`,STACK_0) + static void get_key_vector (object obj, char key_vector [32]) { - NOTIMPLEMENTED; + check_bitvec_256(obj); + X_CALL(memcpy (key_vector, TheSbvector(obj)->data, 32)); } static object make_client_message_format (int format) @@ -1758,7 +1764,6 @@ DEFUN(XLIB:OPEN-DISPLAY, &rest args) { /* (XLIB:OPEN-DISPLAY host &key :display &allow-other-keys) */ - char *display_name = NULL; /* the host to connect to */ int display_number = 0; /* the display number */ Display *dpy; gcv_object_t *display_arg = NULL; @@ -1788,10 +1793,6 @@ { dpy = x_open_display(displayz,display_number); }); } else dpy = x_open_display(NULL,display_number); -# if !defined(RELY_ON_WRITING_TO_SUBPROCESS) - disable_sigpipe(); -# endif - VALUES1(make_display(dpy, display_number)); skipSTACK(argcount); } @@ -3105,33 +3106,30 @@ pushSTACK(TheSubr(subr_self)->name); fehler (error, "~S: The dash list should be non-empty."); } - { /* FIXME: For efficiency reasons, we should look + /* FIXME: For efficiency reasons, we should look if user gave already a byte vector. [probably via with-gcontext]. */ - uintC i; - - /* Allocate a simple vector of uint8's: */ - pushSTACK(allocate_bit_vector (/* eltype: */ Atype_8Bit, /* len: */ n)); + /* Allocate a simple vector of uint8's: */ + pushSTACK(allocate_bit_vector (/* eltype: */ Atype_8Bit, /* len: */ n)); - /* Copy the values from the dash-list argument into the + /* Copy the values from the dash-list argument into the newly created byte-vector representation */ - pushSTACK(STACK_0); pushSTACK(STACK_2); funcall(L(replace),2); + pushSTACK(STACK_0); pushSTACK(STACK_2); funcall(L(replace),2); - /* The XSetDashes routine requires also the dash_offset, + /* The XSetDashes routine requires also the dash_offset, so retrieve it first. */ - begin_x_call(); - XGetGCValues (dpy, gcon, GCDashOffset, &values); - XSetDashes (dpy, gcon, values.dash_offset, - (char*)(TheSbvector(STACK_1)->data), n); - end_x_call(); + begin_x_call(); + XGetGCValues (dpy, gcon, GCDashOffset, &values); + XSetDashes (dpy, gcon, values.dash_offset, + (char*)(TheSbvector(STACK_1)->data), n); + end_x_call(); - /* Now install the byte-vector into the %dashes slot: */ - pushSTACK(STACK_2); /* The instance, hence the gcontext */ - pushSTACK(`XLIB::%DASHES`); /* slot */ - pushSTACK(STACK_2); /* value, the byte-vector */ - funcall (L(set_slot_value), 3); - skipSTACK(1); /* clean up; pop the byte-vector */ - } + /* Now install the byte-vector into the %dashes slot: */ + pushSTACK(STACK_2); /* The instance, hence the gcontext */ + pushSTACK(`XLIB::%DASHES`); /* slot */ + pushSTACK(STACK_2); /* value, the byte-vector */ + funcall (L(set_slot_value), 3); + skipSTACK(1); /* clean up; pop the byte-vector */ } VALUES1(STACK_0); @@ -3782,10 +3780,9 @@ static void general_draw_text (int image_p) { /* General text drawing routine to not to have to duplicate code for DRAW-GLYPHS and DRAW-IMAGE-GLYPHS. */ - int size = 0; /* 8 or 16, 0="have to look into the font" */ - /* First of all fetch the arguments */ #if 0 + int size = 0; /* 8 or 16, 0="have to look into the font" */ STACK_9= drawable; STACK_8= gcontext; @@ -4073,7 +4070,6 @@ int width; int height; int depth; - char *data; int bytes_per_line; int ix, iy; unsigned long v; @@ -4180,10 +4176,8 @@ handle_image_x (src_x, src_y, x, y, w, h, gcontext, drawable, bitmap_p, dpy); # endif /* image-x stuff - It seems that images of type image-x are already in the format - needed by XPutImage. */ - int bytes_per_line, bitmap_pad; - char *data; + It seems that images of type image-x are already in the format + needed by XPutImage. */ XImage im; /* Now fill in the XImage structure from the slots */ @@ -4226,7 +4220,7 @@ /* handle_image_z (src_x, src_y, x, y, w, h, gcontext, drawable, bitmap_p, dpy); image-z or image-xy stuff */ XImage *im; - int width, height, depth, format; + int width, height, depth; unsigned long fg,bg; width = get_sint32(funcall1(`XLIB::IMAGE-WIDTH`,STACK_7)); @@ -4244,7 +4238,6 @@ } { - char *data; int bytes_per_line; int ix, iy; unsigned long v; @@ -4571,10 +4564,8 @@ if (fs->min_byte1 == 0 && fs->max_byte1 == 0) { /* Linear indexing ... */ if (index >= fs->min_char_or_byte2 && index <= fs->max_char_or_byte2) - if (fs->per_char) - return fs->per_char+(index-fs->min_char_or_byte2); - else - return &(fs->min_bounds); + return fs->per_char ? fs->per_char+(index-fs->min_char_or_byte2) + : &(fs->min_bounds); } else { /* Nonlinear indexing .. */ unsigned char byte1 = (index >> 8) &0xFF; /* Is this right?! */ unsigned char byte2 = index & 0xFF; @@ -4583,11 +4574,7 @@ if (byte1 >= fs->min_byte1 && byte1 <= fs->max_byte1 && byte2 >= fs->min_char_or_byte2 && byte2 <= fs->max_char_or_byte2) { index = (byte1 - fs->min_byte1)*d + (byte2 - fs->min_char_or_byte2); - - if (fs->per_char) - return fs->per_char+index; - else - return &(fs->min_bounds); + return fs->per_char ? fs->per_char+index : &(fs->min_bounds); } } /* BTW these two cases could be handled in one, but I leave it here @@ -4715,7 +4702,7 @@ int end = missingp(STACK_1) ? vector_length (STACK_3) : get_uint16 (STACK_1); VALUES2(make_sint32(0),NIL); } else - my_type_error(`SEQUENCE`,STACK_3); + my_type_error(S(sequence),STACK_3); skipSTACK(5); } @@ -5328,7 +5315,6 @@ int start = get_uint32_0 (STACK_2); int end; int len; - unsigned char *data; if (format != 8 && format != 16 && format != 32) my_type_error(`(MEMBER 8 16 32)`,STACK_4); @@ -6227,7 +6213,6 @@ DEFUN(XLIB:GLOBAL-POINTER-POSITION, display) { Display *dpy = (pushSTACK(STACK_0), pop_display()); - Window win; Window root, child; int root_x, root_y; @@ -6383,12 +6368,10 @@ default: pushSTACK(make_window (STACK_0, focus)); } - /* value2 (= revert) */ - pushSTACK(check_revert_focus_reverse(revert)); - - value2 = popSTACK(); + value2 = check_revert_focus_reverse(revert); value1 = popSTACK(); mv_count = 2; + skipSTACK(1); /* drop dpy */ } static void ungrab_X (int (*X)(Display *dpy, Time time)) @@ -6519,7 +6502,7 @@ Bool sync_keyboard_p = missingp(STACK_0) ? GrabModeAsync : GrabModeSync; X_CALL(XGrabKey (dpy, keycode, modifiers, win, owner_p, - sync_keyboard_p, sync_keyboard_p)); + sync_pointer_p, sync_keyboard_p)); VALUES1(NIL); skipSTACK(6); @@ -6868,9 +6851,7 @@ Display *dpy = (pushSTACK(STACK_1), pop_display()); if (boundp(STACK_0)) { - if (!(simple_bit_vector_p (Atype_Bit, STACK_0) - && Sbvector_length (STACK_0) == 256)) - my_type_error(`(SIMPLE-BIT-VECTOR 256)`,STACK_0); + check_bitvec_256(STACK_0); } else STACK_0 = allocate_bit_vector (Atype_Bit, 256); @@ -6947,7 +6928,7 @@ { /* http://www.linuxmanpages.com/man3/XGetKeyboardMapping.3x.php */ Display *dpy = (pushSTACK(STACK_4), pop_display()); int first_keycode, min_keycode, max_keycode, keysyms_per_keycode; - KeySym *map, *map1; + KeySym *map; int start, end, num_codes; object data_vector; void * data_ptr; @@ -7126,7 +7107,7 @@ object func = missingp(STACK_0) ? ``XLIB::DEFAULT-KEYSYM-INDEX`` : (object)STACK_0; skipSTACK(2); - funcall(STACK_0,3); + funcall(func,3); index = get_sint32(value1); } else { index = get_sint32(STACK_1); @@ -8018,7 +7999,7 @@ void module__clx__init_function_2 (module_t *module); void module__clx__init_function_2 (module_t *module) { /* setze doch `XLIB::*DISPLAYS*` auf NIL ! */ -#if 0 +# if 0 uintC i; for (i = 0 ; i < module__clx__object_tab_size; i++) { @@ -8027,5 +8008,8 @@ pushSTACK(((gcv_object_t *)( & module__clx__object_tab))[i]); funcall (L(princ),1); } -#endif +# endif +# if !defined(RELY_ON_WRITING_TO_SUBPROCESS) + disable_sigpipe(); +# endif } Index: test.tst =================================================================== RCS file: /cvsroot/clisp/clisp/modules/clx/new-clx/test.tst,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- test.tst 9 Nov 2005 14:29:26 -0000 1.4 +++ test.tst 25 Sep 2007 19:51:23 -0000 1.5 @@ -5,12 +5,16 @@ (defparameter *dpy* (show (xlib:open-display ""))) *dpy* (xlib:closed-display-p *dpy*) NIL - +(integerp (show (xlib:display-protocol-major-version *dpy*))) T +(integerp (show (xlib:display-protocol-minor-version *dpy*))) T +(listp (show (multiple-value-list (xlib:display-protocol-version *dpy*)))) T +(listp (show (xlib:display-roots *dpy*))) T +(listp (show (multiple-value-list (xlib:display-vendor *dpy*)))) T +(stringp (show (xlib:display-vendor-name *dpy*))) T +(integerp (show (xlib:display-release-number *dpy*))) T (listp (show (xlib:display-plist *dpy*))) T - (stringp (show (xlib:display-host *dpy*))) T - -;(listp (show (multiple-value-list (xlib:pointer-control *dpy*)))) T +(listp (show (multiple-value-list (xlib:pointer-control *dpy*)))) T (listp (show (xlib:pointer-mapping *dpy*))) T (multiple-value-bind (kc% b% bp bd lm gar arm) (xlib:keyboard-control *dpy*) @@ -21,36 +25,98 @@ :KEY 80 :AUTO-REPEAT-MODE (if (plusp (aref arm 80)) :on :off))) NIL +(vectorp (show (xlib:query-keymap *dpy*))) T (listp (show (multiple-value-list (xlib:display-keycode-range *dpy*)))) T - (integerp (show (xlib:display-max-request-length *dpy*))) T - (integerp (show (xlib:display-motion-buffer-size *dpy*))) T - (listp (show (xlib:display-pixmap-formats *dpy*) :pretty t)) T - (symbolp (show (xlib:display-byte-order *dpy*))) T - (listp (show (multiple-value-list (xlib:display-protocol-version *dpy*)))) T - (listp (show (multiple-value-list (xlib:display-vendor *dpy*)))) T +(listp (show (multiple-value-list (xlib:global-pointer-position *dpy*)))) T +(integerp (show (xlib:display-nscreens *dpy*))) T -(let ((map (show (xlib:keyboard-mapping *dpy*) :pretty t))) - (show (array-dimensions map)) - (list (eq map (xlib:keyboard-mapping *dpy* :data map)) - (xlib:change-keyboard-mapping - *dpy* map :first-keycode (xlib:display-min-keycode *dpy*)))) -(T NIL) +(defparameter *screen* (show (xlib:display-default-screen *dpy*))) *SCREEN* -(let ((modifiers (show (multiple-value-list (xlib:modifier-mapping *dpy*))))) - (apply #'xlib:set-modifier-mapping *dpy* - (mapcan #'list '(:SHIFT :LOCK :CONTROL :MOD1 :MOD2 :MOD3 :MOD4 :MOD5) - modifiers))) -:SUCCESS +(integerp (show (xlib:screen-black-pixel *screen*))) T +(integerp (show (xlib:screen-white-pixel *screen*))) T +(integerp (show (xlib:screen-event-mask-at-open *screen*))) T +(integerp (show (xlib:screen-height *screen*))) T +(integerp (show (xlib:screen-height-in-millimeters *screen*))) T +(integerp (show (xlib:screen-width *screen*))) T +(integerp (show (xlib:screen-width-in-millimeters *screen*))) T +(integerp (show (xlib:screen-max-installed-maps *screen*))) T +(integerp (show (xlib:screen-min-installed-maps *screen*))) T +(integerp (show (xlib:screen-root-depth *screen*))) T +(xlib:visual-info-p (show (xlib:screen-root-visual-info *screen*) :pretty t)) T +(typep (show (xlib:screen-save-unders-p *screen*)) 'boolean) T +(symbolp (show (xlib:screen-backing-stores *screen*))) T +(listp (show (xlib:screen-depths *screen*) :pretty t)) T -(show (multiple-value-list (xlib:keysym->keycodes *dpy* 65))) (38) -(show (multiple-value-list (xlib:keysym->keycodes *dpy* #xFF52))) (98) ; Up -(show (xlib:keysym "Up")) #xFF52 +(defparameter *visual* (show (xlib:screen-root-visual *screen*))) *VISUAL* + +(listp (show (xlib:screen-plist *screen*))) T +(xlib:visual-info-p (show (xlib:visual-info *dpy* *visual*) :pretty t)) T + +(defparameter *root* (show (xlib:screen-root *screen*))) *ROOT* + +(defparameter *colormap* (show (xlib:screen-default-colormap *screen*))) +*COLORMAP* + +(defparameter *window* + (multiple-value-bind (window revert) (xlib:input-focus *dpy*) + (show (list :window window :revert revert) :pretty t) + window)) +*WINDOW* + +(xlib:window-p (show (xlib:drawable-root *window*))) T +(listp (show (multiple-value-list (xlib:query-tree *window*)) :pretty t)) T +(listp (show (multiple-value-list (xlib:query-pointer *window*)) :pretty t)) T +(listp (show (multiple-value-list (xlib:motion-events *window*)))) T +(xlib:warp-pointer *window* 10 10) NIL +(xlib:warp-pointer-relative *dpy* 10 10) NIL + +;; (let ((map (show (xlib:keyboard-mapping *dpy*) :pretty t))) +;; (show (array-dimensions map)) +;; (list (eq map (xlib:keyboard-mapping *dpy* :data map)) +;; (xlib:change-keyboard-mapping +;; *dpy* map :first-keycode (xlib:display-min-keycode *dpy*)))) +;; (T NIL) + +;; (let ((modifiers (show (multiple-value-list (xlib:modifier-mapping *dpy*))))) +;; (apply #'xlib:set-modifier-mapping *dpy* +;; (mapcan #'list '(:SHIFT :LOCK :CONTROL :MOD1 :MOD2 :MOD3 :MOD4 :MOD5) +;; modifiers))) +;; :SUCCESS + +(multiple-value-list (xlib:keysym->keycodes *dpy* 65)) (38) +(multiple-value-list (xlib:keysym->keycodes *dpy* #xFF52)) (98) ; Up +(xlib:keysym "Up") #xFF52 + +(xlib:keysym->character *dpy* 97) #\a +(xlib:keysym->character *dpy* 97 4) #\a ; 4 is <ctrl> +(xlib:keysym->character *dpy* 97 8) #\a ; 8 is <meta> +(xlib:keysym->character *dpy* 65) #\A +(xlib:keysym->character *dpy* 65 4) #\A +(xlib:keysym->character *dpy* 65 8) #\A +(xlib:keysym->character *dpy* #xFF52) ; #xFF52 is <up> +#+unicode #\FULLWIDTH_LATIN_SMALL_LETTER_R #-unicode NIL + +(listp (show (loop :for i :from 0 :to 255 + :collect (xlib:keycode->character *dpy* i 0)) + :pretty t)) +T + +(defun c2s (index) + (loop :for keycode :from 0 :to 255 + :collect (xlib:keycode->keysym *dpy* keycode index))) +C2S + +(let ((l-255 (show (c2s 255) :pretty t))) + (loop :for index :from 0 :to 254 :for l = (c2s index) + :unless (equal l-255 l) + :do (show (list index (diff-seq l-255 l)) :pretty t))) +NIL (show (xlib:keysym-name (show (xlib:keysym "Down")))) "Down" ------------------------------ Message: 3 Date: Tue, 25 Sep 2007 21:17:39 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog,1.5570,1.5571 To: cli...@li... Message-ID: <E1I...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv16341/src Modified Files: ChangeLog Log Message: (X11/Xauth.h): #include (my_xau_get_auth_by_name): add (fixme?) (XLIB:DISPLAY-AUTHORIZATION-DATA, XLIB:DISPLAY-AUTHORIZATION-NAME): use it or return constant "" (XLIB:DISPLAY-AUTHORIZATION): add Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.5570 retrieving revision 1.5571 diff -u -d -r1.5570 -r1.5571 --- ChangeLog 25 Sep 2007 19:51:22 -0000 1.5570 +++ ChangeLog 25 Sep 2007 21:17:36 -0000 1.5571 @@ -13,6 +13,12 @@ (XLIB:GRAB-KEY): fix XGrabKey call (XLIB:QUERY-KEYMAP): use check_bitvec_256 (XLIB:KEYCODE->CHARACTER): fix KEYSYM-INDEX-FUNCTION handling + (X11/Xauth.h): #include + (my_xau_get_auth_by_name): add (fixme?) + (XLIB:DISPLAY-AUTHORIZATION-DATA, XLIB:DISPLAY-AUTHORIZATION-NAME): + use it or return constant "" + (XLIB:DISPLAY-AUTHORIZATION): add + * modules/clx/new-clx/clx.lisp (XLIB:DISPLAY-AUTHORIZATION): export 2007-09-23 Sam Steingold <sd...@gn...> ------------------------------ Message: 4 Date: Tue, 25 Sep 2007 21:17:39 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/modules/clx/new-clx test.tst, 1.5, 1.6 clx.lisp, 1.18, 1.19 clx.f, 2.71, 2.72 To: cli...@li... Message-ID: <E1I...@ma...> Update of /cvsroot/clisp/clisp/modules/clx/new-clx In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv16341/modules/clx/new-clx Modified Files: test.tst clx.lisp clx.f Log Message: (X11/Xauth.h): #include (my_xau_get_auth_by_name): add (fixme?) (XLIB:DISPLAY-AUTHORIZATION-DATA, XLIB:DISPLAY-AUTHORIZATION-NAME): use it or return constant "" (XLIB:DISPLAY-AUTHORIZATION): add Index: clx.f =================================================================== RCS file: /cvsroot/clisp/clisp/modules/clx/new-clx/clx.f,v retrieving revision 2.71 retrieving revision 2.72 diff -u -d -r2.71 -r2.72 --- clx.f 25 Sep 2007 19:51:23 -0000 2.71 +++ clx.f 25 Sep 2007 21:17:37 -0000 2.72 @@ -405,6 +405,7 @@ #include <X11/Xlib.h> #include <X11/Xutil.h> /* XGetVisualInfo */ #include <X11/Xcms.h> /* forXcmsCCCOfColormap() & XcmsVisualOfCCC() */ +#include <X11/Xauth.h> #include <stdio.h> /* sprintf() */ #include <string.h> /* memcpy(), strchr(), strcpy() */ #include "config.h" @@ -1797,16 +1798,53 @@ skipSTACK(argcount); } +static Xauth * my_xau_get_auth_by_name (char *dpy_name) { + char *s = dpy_name; + int len = strlen(dpy_name); + while (*s && *s != ':') s++; + if (*s == ':') { + int addr_len = s-dpy_name; + return XauGetAuthByAddr(AF_INET,addr_len,dpy_name, + len-addr_len-1,s+1,len,dpy_name); + } else return XauGetAuthByAddr(AF_INET,0,"",len,dpy_name,len,dpy_name); +} + +DEFUN(XLIB:DISPLAY-AUTHORIZATION, display) /* OK */ +{ + Display *dpy = pop_display (); + Xauth *auth; + X_CALL(auth = my_xau_get_auth_by_name(DisplayString(dpy))); + if (auth) { + pushSTACK(fixnum(auth->family)); +# define PUSH(n) pushSTACK(n_char_to_string(auth->n,auth->n##_length, \ + GLO(misc_encoding))) + PUSH(address); PUSH(number); PUSH(name); PUSH(data); +# undef PUSH + STACK_to_mv(5); + X_CALL(XauDisposeAuth(auth)); + } else VALUES0; +} + DEFUN(XLIB:DISPLAY-AUTHORIZATION-DATA, display) /* OK */ { - skipSTACK(1); - VALUES1(allocate_string(0)); + Display *dpy = pop_display (); + Xauth *auth; + X_CALL(auth = my_xau_get_auth_by_name(DisplayString(dpy))); + if (auth) { + VALUES1(n_char_to_string(auth->data,auth->data_length,GLO(misc_encoding))); + X_CALL(XauDisposeAuth(auth)); + } else VALUES1(`""`); } DEFUN(XLIB:DISPLAY-AUTHORIZATION-NAME, display) /* OK */ { - skipSTACK(1); - VALUES1(allocate_string(0)); + Display *dpy = pop_display (); + Xauth *auth; + X_CALL(auth = my_xau_get_auth_by_name(DisplayString(dpy))); + if (auth) { + VALUES1(n_char_to_string(auth->name,auth->name_length,GLO(misc_encoding))); + X_CALL(XauDisposeAuth(auth)); + } else VALUES1(`""`); } DEFUN(XLIB:DISPLAY-BITMAP-FORMAT, display) /* OK */ Index: clx.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/modules/clx/new-clx/clx.lisp,v retrieving revision 1.18 retrieving revision 1.19 diff -u -d -r1.18 -r1.19 --- clx.lisp 28 Feb 2007 02:48:33 -0000 1.18 +++ clx.lisp 25 Sep 2007 21:17:37 -0000 1.19 @@ -48,6 +48,7 @@ define-keysym-set delete-property delete-resource destroy-subwindows destroy-window device-busy device-event-mask device-event-mask-class discard-current-event discard-font-info display display-after-function + display-authorization ; extension display-authorization-data display-authorization-name display-bitmap-format display-byte-order display-default-screen display-display display-error-handler display-finish-output Index: test.tst =================================================================== RCS file: /cvsroot/clisp/clisp/modules/clx/new-clx/test.tst,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- test.tst 25 Sep 2007 19:51:23 -0000 1.5 +++ test.tst 25 Sep 2007 21:17:37 -0000 1.6 @@ -5,6 +5,9 @@ (defparameter *dpy* (show (xlib:open-display ""))) *dpy* (xlib:closed-display-p *dpy*) NIL +(stringp (show (xlib:display-authorization-data *dpy*))) T +(stringp (show (xlib:display-authorization-name *dpy*))) T +(listp (show (multiple-value-list (xlib:display-authorization *dpy*)))) T (integerp (show (xlib:display-protocol-major-version *dpy*))) T (integerp (show (xlib:display-protocol-minor-version *dpy*))) T (listp (show (multiple-value-list (xlib:display-protocol-version *dpy*)))) T @@ -30,6 +33,7 @@ (integerp (show (xlib:display-max-request-length *dpy*))) T (integerp (show (xlib:display-motion-buffer-size *dpy*))) T (listp (show (xlib:display-pixmap-formats *dpy*) :pretty t)) T +(xlib:bitmap-format-p (show (xlib:display-bitmap-format *dpy*))) T (symbolp (show (xlib:display-byte-order *dpy*))) T (listp (show (multiple-value-list (xlib:display-protocol-version *dpy*)))) T (listp (show (multiple-value-list (xlib:display-vendor *dpy*)))) T ------------------------------ Message: 5 Date: Wed, 26 Sep 2007 14:27:27 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/modules/clx/new-clx test.tst,1.6,1.7 To: cli...@li... Message-ID: <E1I...@ma...> Update of /cvsroot/clisp/clisp/modules/clx/new-clx In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv28860/modules/clx/new-clx Modified Files: test.tst Log Message: add cleanup code Index: test.tst =================================================================== RCS file: /cvsroot/clisp/clisp/modules/clx/new-clx/test.tst,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- test.tst 25 Sep 2007 21:17:37 -0000 1.6 +++ test.tst 26 Sep 2007 14:27:25 -0000 1.7 @@ -122,20 +122,33 @@ :do (show (list index (diff-seq l-255 l)) :pretty t))) NIL -(show (xlib:keysym-name (show (xlib:keysym "Down")))) "Down" +(xlib:keysym-name (show (xlib:keysym "Down"))) "Down" (let ((access (show (xlib:access-control *dpy*)))) (assert (eq access (setf (xlib:access-control *dpy*) access))) t) T -(listp (show (xlib:access-hosts *dpy*) :pretty t)) T +(defparameter *access-hosts* (show (xlib:access-hosts *dpy*) :pretty t)) +*ACCESS-HOSTS* (xlib:add-access-host *dpy* "localhost") NIL -(listp (show (xlib:access-hosts *dpy*) :pretty t)) T +(every #'posix:hostent-p (show (xlib:access-hosts *dpy*) :pretty t)) T (xlib:remove-access-host *dpy* "localhost") NIL -(listp (show (xlib:access-hosts *dpy*) :pretty t)) T +(equalp *access-hosts* (show (xlib:access-hosts *dpy*) :pretty t)) T (xlib:bell *dpy* 50) NIL ; signal that we are almost done (xlib:display-force-output *dpy*) NIL (xlib:display-finish-output *dpy*) NIL (xlib:display-p (show (xlib:close-display *dpy*))) T + +;; cleanup +(flet ((del (s) (makunbound s) (fmakunbound s) (unintern s))) + (del '*dpy*) + (del '*screen*) + (del '*visual*) + (del '*root*) + (del '*colormap*) + (del '*window*) + (del 'c2s) + (del '*access-hosts*)) +T ------------------------------ Message: 6 Date: Wed, 26 Sep 2007 15:24:26 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog,1.5571,1.5572 To: cli...@li... Message-ID: <E1I...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv21415/src Modified Files: ChangeLog Log Message: (xlib_a_cons): use allocate_cons() instead of `(NIL . NIL)` for initialization Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.5571 retrieving revision 1.5572 diff -u -d -r1.5571 -r1.5572 --- ChangeLog 25 Sep 2007 21:17:36 -0000 1.5571 +++ ChangeLog 26 Sep 2007 15:24:23 -0000 1.5572 @@ -1,3 +1,8 @@ +2007-09-26 Sam Steingold <sd...@gn...> + + * modules/clx/new-clx/clx.f (xlib_a_cons): use allocate_cons() + instead of `(NIL . NIL)` for initialization + 2007-09-25 Sam Steingold <sd...@gn...> * modules/clx/new-clx/clx.f (make_key_vector): do not clobber value1 ------------------------------ ------------------------------------------------------------------------- This SF.net email is sponsored by: Microsoft Defy all challenges. Microsoft(R) Visual Studio 2005. http://clk.atdmt.com/MRT/go/vse0120000070mrt/direct/01/ ------------------------------ _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 17, Issue 16 ***************************************** |