From: <cli...@li...> - 2008-06-26 19:06:19
|
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.6308,1.6309 (Sam Steingold) 2. clisp/modules/clx/new-clx/demos sokoban.lisp,1.14,1.15 (Sam Steingold) 3. clisp/src ChangeLog,1.6309,1.6310 (Sam Steingold) 4. clisp/modules/clx/new-clx clx.lisp,1.33,1.34 (Sam Steingold) 5. clisp/src ChangeLog,1.6310,1.6311 (Sam Steingold) 6. clisp/modules/clx/new-clx test.tst,1.34,1.35 (Sam Steingold) ---------------------------------------------------------------------- Message: 1 Date: Thu, 26 Jun 2008 14:39:34 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog,1.6308,1.6309 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv10321/src Modified Files: ChangeLog Log Message: (init-sokoban): do not set *display* (sokoban): use xlib:with-open-display Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6308 retrieving revision 1.6309 diff -u -d -r1.6308 -r1.6309 --- ChangeLog 26 Jun 2008 03:19:25 -0000 1.6308 +++ ChangeLog 26 Jun 2008 14:39:30 -0000 1.6309 @@ -1,3 +1,9 @@ +2008-06-26 Sam Steingold <sd...@gn...> + + * modules/clx/new-clx/demos/sokoban.lisp (init-sokoban): + do not set *display* + (sokoban): use xlib:with-open-display + 2008-06-25 Sam Steingold <sd...@gn...> * modules/clx/new-clx/clx.f (change_property): remove ------------------------------ Message: 2 Date: Thu, 26 Jun 2008 14:45:51 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/modules/clx/new-clx/demos sokoban.lisp,1.14,1.15 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/modules/clx/new-clx/demos In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv12597/modules/clx/new-clx/demos Modified Files: sokoban.lisp Log Message: (sokoban): handle numeric keypad Index: sokoban.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/modules/clx/new-clx/demos/sokoban.lisp,v retrieving revision 1.14 retrieving revision 1.15 diff -u -d -r1.14 -r1.15 --- sokoban.lisp 26 Jun 2008 14:39:30 -0000 1.14 +++ sokoban.lisp 26 Jun 2008 14:45:49 -0000 1.15 @@ -400,10 +400,14 @@ :button-press code window x y))))) (:key-press (code window) (case (xlib:keycode->keysym *display* code 0) - (65361 #|LEFT|# (move -1 0)) - (65362 #|UP|# (move 0 -1)) - (65363 #|RIGHT|# (move 1 0)) - (65364 #|DOWN|# (move 0 1)) + ((65361 65430) #|LEFT|# (move -1 0)) + ((65362 65431) #|UP|# (move 0 -1)) + ((65363 65432) #|RIGHT|# (move 1 0)) + ((65364 65433) #|DOWN|# (move 0 1)) + ((65429) #|Home|# (move -1 -1)) + ((65434) #|PgUp|# (move 1 -1)) + ((65436) #|End|# (move -1 1)) + ((65435) #|PgDn|# (move 1 1)) (#o165 #|u|# (undo)) (#o166 #|v|# (undo-til-push)) (#o162 #|r|# (restart-sokoban)) ------------------------------ Message: 3 Date: Thu, 26 Jun 2008 14:45:53 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog,1.6309,1.6310 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv12597/src Modified Files: ChangeLog Log Message: (sokoban): handle numeric keypad Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6309 retrieving revision 1.6310 diff -u -d -r1.6309 -r1.6310 --- ChangeLog 26 Jun 2008 14:39:30 -0000 1.6309 +++ ChangeLog 26 Jun 2008 14:45:49 -0000 1.6310 @@ -2,7 +2,8 @@ * modules/clx/new-clx/demos/sokoban.lisp (init-sokoban): do not set *display* - (sokoban): use xlib:with-open-display + (sokoban): use xlib:with-open-display; + handle numeric keypad 2008-06-25 Sam Steingold <sd...@gn...> ------------------------------ Message: 4 Date: Thu, 26 Jun 2008 18:53:18 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/modules/clx/new-clx clx.lisp,1.33,1.34 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/modules/clx/new-clx In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv7758/modules/clx/new-clx Modified Files: clx.lisp Log Message: (WITH-GCONTEXT, set-wm-class): STRING-CONCAT requires package prefix Index: clx.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/modules/clx/new-clx/clx.lisp,v retrieving revision 1.33 retrieving revision 1.34 diff -u -d -r1.33 -r1.34 --- clx.lisp 25 Jun 2008 23:05:28 -0000 1.33 +++ clx.lisp 26 Jun 2008 18:53:15 -0000 1.34 @@ -544,25 +544,25 @@ dashes? clip-mask?) (do ((q options (cddr q))) ((null q)) - (cond ((eq (car q) :dashes) (setf dashes? t)) - ((eq (car q) :clip-mask) (setf clip-mask? t))) - (setf comps (logior comps (%gcontext-key->mask (car q))) - setf-forms (nconc setf-forms - (list (list (find-symbol (string-concat "GCONTEXT-" (symbol-name (car q))) :xlib) - gcon) - (cadr q)))) ) + (cond ((eq (car q) :dashes) (setf dashes? t)) + ((eq (car q) :clip-mask) (setf clip-mask? t))) + (setf comps (logior comps (%gcontext-key->mask (car q))) + setf-forms (nconc setf-forms + (list (list (find-symbol (ext:string-concat "GCONTEXT-" (symbol-name (car q))) :xlib) + gcon) + (cadr q))))) `(LET* ((,gcon ,gcontext) (,saved (%SAVE-GCONTEXT-COMPONENTS ,gcon ,comps)) ,@(if dashes? (list `(,g0 (GCONTEXT-DASHES ,gcon)))) - ,@(if clip-mask? (list `(,g1 (GCONTEXT-CLIP-MASK ,gcon)))) ) + ,@(if clip-mask? (list `(,g1 (GCONTEXT-CLIP-MASK ,gcon))))) (UNWIND-PROTECT - (PROGN - (SETF ,@setf-forms) - ,@body) + (PROGN + (SETF ,@setf-forms) + ,@body) (PROGN (%RESTORE-GCONTEXT-COMPONENTS ,gcon ,saved) - ,@(if dashes? (list `(SETF (GCONTEXT-DASHES ,gcon) ,g0)) ) - ,@(if clip-mask? (list `(SETF (GCONTEXT-CLIP-MASK ,gcon) ,g1)) )))) )) + ,@(if dashes? (list `(SETF (GCONTEXT-DASHES ,gcon) ,g0))) + ,@(if clip-mask? (list `(SETF (GCONTEXT-CLIP-MASK ,gcon) ,g1)))))))) (defmacro WITH-SERVER-GRABBED ((display) &body body) ;; The body is not surrounded by a with-display. @@ -614,7 +614,7 @@ (defun set-wm-class (window resource-name resource-class) (set-string-property window :WM_CLASS - (string-concat + (ext:string-concat (string (or resource-name "")) (load-time-value (make-string 1 :initial-element (card8->char 0))) ------------------------------ Message: 5 Date: Thu, 26 Jun 2008 18:53:19 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog,1.6310,1.6311 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv7758/src Modified Files: ChangeLog Log Message: (WITH-GCONTEXT, set-wm-class): STRING-CONCAT requires package prefix Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6310 retrieving revision 1.6311 diff -u -d -r1.6310 -r1.6311 --- ChangeLog 26 Jun 2008 14:45:49 -0000 1.6310 +++ ChangeLog 26 Jun 2008 18:53:16 -0000 1.6311 @@ -1,5 +1,10 @@ 2008-06-26 Sam Steingold <sd...@gn...> + * modules/clx/new-clx/clx.lisp (WITH-GCONTEXT, set-wm-class): + STRING-CONCAT requires package prefix + +2008-06-26 Sam Steingold <sd...@gn...> + * modules/clx/new-clx/demos/sokoban.lisp (init-sokoban): do not set *display* (sokoban): use xlib:with-open-display; ------------------------------ Message: 6 Date: Thu, 26 Jun 2008 18:53:17 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/modules/clx/new-clx test.tst,1.34,1.35 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/modules/clx/new-clx In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv7760 Modified Files: test.tst Log Message: (MAP-WINDOWS): new function Index: test.tst =================================================================== RCS file: /cvsroot/clisp/clisp/modules/clx/new-clx/test.tst,v retrieving revision 1.34 retrieving revision 1.35 diff -u -d -r1.34 -r1.35 --- test.tst 26 Jun 2008 14:27:16 -0000 1.34 +++ test.tst 26 Jun 2008 18:53:15 -0000 1.35 @@ -273,18 +273,47 @@ (xlib:display-finish-output *dpy*) NIL (xlib:display-p (show (xlib:close-display *dpy*))) T -(xlib:with-open-display (dpy) - (ext:appease-cerrors - (let ((window-count 0) (hint-count 0)) +(defun map-windows (f) + (xlib:with-open-display (dpy) + (ext:appease-cerrors (dolist (screen (xlib:display-roots dpy)) (dolist (window (xlib:query-tree (xlib:screen-root screen))) - (let ((wmh (xlib:wm-hints window))) - (incf window-count) - (when wmh - (incf hint-count) - (show (list window-count hint-count screen window wmh) :pretty t) - (setf (xlib:wm-hints window) wmh))))) - (length (show (list 'window-count window-count 'hint-count hint-count)))))) + (funcall f window)))))) +MAP-WINDOWS + +(let ((window-count 0) (hint-count 0)) + (map-windows (lambda (window) + (let ((wmh (xlib:wm-hints window))) + (incf window-count) + (when wmh + (incf hint-count) + (show (list window-count hint-count window wmh) + :pretty t) + (setf (xlib:wm-hints window) wmh))))) + (length (show (list 'window-count window-count 'hint-count hint-count)))) +4 + +(let ((window-count 0) (wmc-count 0)) + (map-windows (lambda (window) + (multiple-value-bind (name class) (xlib:get-wm-class window) + (incf window-count) + (when name + (incf wmc-count) + (show (list window-count wmc-count window name class) + :pretty t) + (xlib:set-wm-class window name class))))) + (length (show (list 'window-count window-count 'wmc-count wmc-count)))) +4 + +(let ((window-count 0) (cmd-count 0)) + (map-windows (lambda (window) + (let ((cmd (xlib:wm-command window))) + (incf window-count) + (when cmd + (incf cmd-count) + (show (list window-count cmd-count window cmd) + :pretty t))))) + (length (show (list 'window-count window-count 'cmd-count cmd-count)))) 4 (xlib:with-open-display (dpy) ------------------------------ ------------------------------------------------------------------------- Check out the new SourceForge.net Marketplace. It's the best place to buy or sell services for just about anything Open Source. http://sourceforge.net/services/buy/index.php ------------------------------ _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 26, Issue 31 ***************************************** |