From pbrochard at common-lisp.net Tue Dec 7 22:20:49 2010 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Tue, 07 Dec 2010 17:20:49 -0500 Subject: [clfswm-cvs] r391 - in clfswm: . src Message-ID: Author: pbrochard Date: Tue Dec 7 17:20:48 2010 New Revision: 391 Log: src/clfswm-second-mode.lisp (*second-mode-leave-function*): New variable bound to a function executed (when not null) on second mode leaving. Modified: clfswm/ChangeLog clfswm/src/clfswm-second-mode.lisp Modified: clfswm/ChangeLog ============================================================================== --- clfswm/ChangeLog (original) +++ clfswm/ChangeLog Tue Dec 7 17:20:48 2010 @@ -1,3 +1,9 @@ +2010-12-07 Philippe Brochard + + * src/clfswm-second-mode.lisp (*second-mode-leave-function*): New + variable bound to a function executed (when not null) on second + mode leaving. + 2010-11-14 Philippe Brochard * src/clfswm-util.lisp (find-child-under-mouse): Do not find Modified: clfswm/src/clfswm-second-mode.lisp ============================================================================== --- clfswm/src/clfswm-second-mode.lisp (original) +++ clfswm/src/clfswm-second-mode.lisp Tue Dec 7 17:20:48 2010 @@ -32,6 +32,9 @@ (defparameter *second-mode-program* nil "Execute the program string if not nil") +(defparameter *second-mode-leave-function* nil + "Execute the function if not nil") + (defun draw-second-mode-window () (raise-window *sm-window*) @@ -138,6 +141,9 @@ (when *second-mode-program* (do-shell *second-mode-program*) (setf *second-mode-program* nil)) + (when *second-mode-leave-function* + (funcall *second-mode-leave-function*) + (setf *second-mode-leave-function* nil)) (setf *in-second-mode* nil)) (defun second-key-mode () From pbrochard at common-lisp.net Wed Dec 8 21:27:03 2010 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Wed, 08 Dec 2010 16:27:03 -0500 Subject: [clfswm-cvs] r392 - in clfswm: . src Message-ID: Author: pbrochard Date: Wed Dec 8 16:27:03 2010 New Revision: 392 Log: src/clfswm-second-mode.lisp (sm-leave-function): Do not use *second-mode-program* anymore. Modified: clfswm/ChangeLog clfswm/src/bindings-second-mode.lisp clfswm/src/clfswm-second-mode.lisp clfswm/src/clfswm-util.lisp Modified: clfswm/ChangeLog ============================================================================== --- clfswm/ChangeLog (original) +++ clfswm/ChangeLog Wed Dec 8 16:27:03 2010 @@ -1,3 +1,8 @@ +2010-12-08 Philippe Brochard + + * src/clfswm-second-mode.lisp (sm-leave-function): Do not use + *second-mode-program* anymore. + 2010-12-07 Philippe Brochard * src/clfswm-second-mode.lisp (*second-mode-leave-function*): New Modified: clfswm/src/bindings-second-mode.lisp ============================================================================== --- clfswm/src/bindings-second-mode.lisp (original) +++ clfswm/src/bindings-second-mode.lisp Wed Dec 8 16:27:03 2010 @@ -74,7 +74,9 @@ `(define-second-key ,key (defun ,name () ,docstring - (setf *second-mode-program* ,cmd) + (setf *second-mode-leave-function* (let ((cmd ,cmd)) + (lambda () + (do-shell cmd)))) (leave-second-mode)))) Modified: clfswm/src/clfswm-second-mode.lisp ============================================================================== --- clfswm/src/clfswm-second-mode.lisp (original) +++ clfswm/src/clfswm-second-mode.lisp Wed Dec 8 16:27:03 2010 @@ -29,9 +29,6 @@ (defparameter *sm-font* nil) (defparameter *sm-gc* nil) -(defparameter *second-mode-program* nil - "Execute the program string if not nil") - (defparameter *second-mode-leave-function* nil "Execute the function if not nil") @@ -138,9 +135,6 @@ (show-all-children) (display-all-frame-info) (wait-no-key-or-button-press) - (when *second-mode-program* - (do-shell *second-mode-program*) - (setf *second-mode-program* nil)) (when *second-mode-leave-function* (funcall *second-mode-leave-function*) (setf *second-mode-leave-function* nil)) Modified: clfswm/src/clfswm-util.lisp ============================================================================== --- clfswm/src/clfswm-util.lisp (original) +++ clfswm/src/clfswm-util.lisp Wed Dec 8 16:27:03 2010 @@ -356,7 +356,9 @@ (multiple-value-bind (program return) (query-string "Run:") (when (and (equal return :return) program (not (equal program ""))) - (setf *second-mode-program* (concatenate 'string "cd $HOME && " program)) + (setf *second-mode-leave-function* (let ((cmd (concatenate 'string "cd $HOME && " program))) + (lambda () + (do-shell cmd)))) (leave-second-mode)))) From pbrochard at common-lisp.net Sat Dec 25 19:59:41 2010 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Sat, 25 Dec 2010 14:59:41 -0500 Subject: [clfswm-cvs] r393 - in clfswm: . src Message-ID: Author: pbrochard Date: Sat Dec 25 14:59:38 2010 New Revision: 393 Log: src/clfswm-second-mode.lisp (second-key-mode): Call the second mode leave function only when the generic mode was ended. Modified: clfswm/ChangeLog clfswm/src/clfswm-second-mode.lisp clfswm/src/xlib-util.lisp Modified: clfswm/ChangeLog ============================================================================== --- clfswm/ChangeLog (original) +++ clfswm/ChangeLog Sat Dec 25 14:59:38 2010 @@ -1,3 +1,8 @@ +2010-12-25 Philippe Brochard + + * src/clfswm-second-mode.lisp (second-key-mode): Call the second + mode leave function only when the generic mode was ended. + 2010-12-08 Philippe Brochard * src/clfswm-second-mode.lisp (sm-leave-function): Do not use Modified: clfswm/src/clfswm-second-mode.lisp ============================================================================== --- clfswm/src/clfswm-second-mode.lisp (original) +++ clfswm/src/clfswm-second-mode.lisp Sat Dec 25 14:59:38 2010 @@ -135,9 +135,6 @@ (show-all-children) (display-all-frame-info) (wait-no-key-or-button-press) - (when *second-mode-leave-function* - (funcall *second-mode-leave-function*) - (setf *second-mode-leave-function* nil)) (setf *in-second-mode* nil)) (defun second-key-mode () @@ -146,7 +143,10 @@ 'exit-second-loop :enter-function #'sm-enter-function :loop-function #'sm-loop-function - :leave-function #'sm-leave-function)) + :leave-function #'sm-leave-function) + (when *second-mode-leave-function* + (funcall *second-mode-leave-function*) + (setf *second-mode-leave-function* nil))) (defun leave-second-mode () "Leave second mode" Modified: clfswm/src/xlib-util.lisp ============================================================================== --- clfswm/src/xlib-util.lisp (original) +++ clfswm/src/xlib-util.lisp Sat Dec 25 14:59:38 2010 @@ -72,8 +72,6 @@ (dbg "Ignore Xlib Error" c ',body)))) - - (defmacro with-x-pointer (&body body) "Bind (x y) to mouse pointer positions" `(multiple-value-bind (x y) From pbrochard at common-lisp.net Mon Dec 27 13:18:47 2010 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Mon, 27 Dec 2010 08:18:47 -0500 Subject: [clfswm-cvs] r394 - in clfswm: . src Message-ID: Author: pbrochard Date: Mon Dec 27 08:18:45 2010 New Revision: 394 Log: src/xlib-util.lisp (with-xlib-protect): Force to revert to the main mode state. Modified: clfswm/ChangeLog clfswm/src/xlib-util.lisp Modified: clfswm/ChangeLog ============================================================================== --- clfswm/ChangeLog (original) +++ clfswm/ChangeLog Mon Dec 27 08:18:45 2010 @@ -1,3 +1,8 @@ +2010-12-27 Philippe Brochard + + * src/xlib-util.lisp (with-xlib-protect): Force to revert to the + main mode state. + 2010-12-25 Philippe Brochard * src/clfswm-second-mode.lisp (second-key-mode): Call the second Modified: clfswm/src/xlib-util.lisp ============================================================================== --- clfswm/src/xlib-util.lisp (original) +++ clfswm/src/xlib-util.lisp Mon Dec 27 08:18:45 2010 @@ -69,7 +69,11 @@ (with-simple-restart (top-level "Return to clfswm's top level") , at body) ((or xlib:match-error xlib:window-error xlib:drawable-error) (c) - (dbg "Ignore Xlib Error" c ',body)))) + (progn + (dbg "Ignore Xlib Error" c ',body) + (unassoc-keyword-handle-event) + (assoc-keyword-handle-event 'main-mode) + (setf *in-second-mode* nil))))) (defmacro with-x-pointer (&body body) From pbrochard at common-lisp.net Wed Dec 29 18:14:24 2010 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Wed, 29 Dec 2010 13:14:24 -0500 Subject: [clfswm-cvs] r395 - in clfswm: . contrib Message-ID: Author: pbrochard Date: Wed Dec 29 13:14:23 2010 New Revision: 395 Log: contrib/osd.lisp (display-doc): Add another method where a CLFSWM native window is used to display the key documentation. Modified: clfswm/ChangeLog clfswm/contrib/osd.lisp Modified: clfswm/ChangeLog ============================================================================== --- clfswm/ChangeLog (original) +++ clfswm/ChangeLog Wed Dec 29 13:14:23 2010 @@ -1,3 +1,8 @@ +2010-12-29 Philippe Brochard + + * contrib/osd.lisp (display-doc): Add another method where a + CLFSWM native window is used to display the key documentation. + 2010-12-27 Philippe Brochard * src/xlib-util.lisp (with-xlib-protect): Force to revert to the Modified: clfswm/contrib/osd.lisp ============================================================================== --- clfswm/contrib/osd.lisp (original) +++ clfswm/contrib/osd.lisp Wed Dec 29 13:14:23 2010 @@ -25,9 +25,20 @@ (in-package :clfswm) +;; Uncomment the line above if you want to use the old OSD method +;;(pushnew :DISPLAY-OSD *features*) + +#-DISPLAY-OSD +(progn + (defparameter *osd-window* nil) + (defparameter *osd-gc* nil) + (defparameter *osd-font* nil) + (defparameter *osd-font-string* "-*-fixed-*-*-*-*-14-*-*-*-*-*-*-1")) + ;;; A more complex example I use to record my desktop and show ;;; documentation associated to each key press. +#+DISPLAY-OSD (defun display-doc (function code state) (let* ((modifiers (state->modifiers state)) (keysym (keysym->keysym-name (xlib:keycode->keysym *display* code 0)))) @@ -39,6 +50,47 @@ (aif (documentation (first function) 'function) (format nil ": ~A" it) ""))))) +#-DISPLAY-OSD +(defun is-osd-window-p (win) + (xlib:window-equal win *osd-window*)) + +#-DISPLAY-OSD +(defun display-doc (function code state) + (unless *osd-window* + (setf *osd-window* (xlib:create-window :parent *root* + :x 0 :y (- (xlib:drawable-height *root*) 25) + :width (xlib:drawable-width *root*) :height 25 + :background (get-color "black") + :border-width 1 + :border (get-color "black") + :colormap (xlib:screen-default-colormap *screen*) + :event-mask '(:exposure)) + *osd-font* (xlib:open-font *display* *osd-font-string*) + *osd-gc* (xlib:create-gcontext :drawable *osd-window* + :foreground (get-color "white") + :background (get-color "black") + :font *osd-font* + :line-style :solid)) + (map-window *osd-window*)) + (let* ((modifiers (state->modifiers state)) + (keysym (keysym->keysym-name (xlib:keycode->keysym *display* code 0)))) + (when (frame-p *current-child*) + (push (list #'equal #'is-osd-window-p t) *never-managed-window-list*)) + (raise-window *osd-window*) + (rotatef (xlib:gcontext-foreground *osd-gc*) (xlib:gcontext-background *osd-gc*)) + (xlib:draw-rectangle *osd-window* *osd-gc* + 0 0 (xlib:drawable-width *osd-window*) (xlib:drawable-height *osd-window*) + t) + (rotatef (xlib:gcontext-foreground *osd-gc*) (xlib:gcontext-background *osd-gc*)) + (xlib:draw-glyphs *osd-window* *osd-gc* 20 15 + (format nil "~A~A" + (if keysym + (format nil "~:(~{~A+~}~A~)" modifiers keysym) + "Menu") + (aif (documentation (first function) 'function) + (format nil ": ~A" it) ""))) + (xlib:display-finish-output *display*))) + (defun funcall-key-from-code (hash-table-key code state &rest args) (let ((function (find-key-from-code hash-table-key code state)))