[clfswm-cvs] r239 - clfswm/src
Philippe Brochard
pbrochard at common-lisp.net
Tue Jun 16 21:05:10 UTC 2009
Author: pbrochard
Date: Tue Jun 16 17:05:07 2009
New Revision: 239
Log:
clfswm-circulate-mode: Adjust circulate-mode-placement
Modified:
clfswm/src/clfswm-circulate-mode.lisp
clfswm/src/clfswm-internal.lisp
clfswm/src/config.lisp
clfswm/src/package.lisp
clfswm/src/tools.lisp
Modified: clfswm/src/clfswm-circulate-mode.lisp
==============================================================================
--- clfswm/src/clfswm-circulate-mode.lisp (original)
+++ clfswm/src/clfswm-circulate-mode.lisp Tue Jun 16 17:05:07 2009
@@ -38,9 +38,11 @@
(defun draw-circulate-mode-window ()
(raise-window *circulate-window*)
(clear-pixmap-buffer *circulate-window* *circulate-gc*)
- (let* ((text (format nil "Current: ~A Focus: ~A"
- (ensure-printable (child-fullname *current-child*))
- (ensure-printable (child-fullname (xlib:input-focus *display*)))))
+ (let* ((text (format nil "~A [~A]"
+ (limit-length (ensure-printable (child-name (xlib:input-focus *display*)))
+ *circulate-text-limite*)
+ (limit-length (ensure-printable (child-name *current-child*))
+ *circulate-text-limite*)))
(len (length text)))
(xlib:draw-glyphs *pixmap-buffer* *circulate-gc*
(truncate (/ (- *circulate-width* (* (xlib:max-char-width *circulate-font*) len)) 2))
@@ -140,13 +142,14 @@
(defun set-default-circulate-keys ()
(define-circulate-key ("Escape") 'leave-circulate-mode)
+ (define-circulate-key ("g" :control) 'leave-circulate-mode)
+ (define-circulate-key ("Escape" :alt) 'leave-circulate-mode)
+ (define-circulate-key ("g" :control :alt) 'leave-circulate-mode)
(define-circulate-key ("Tab" :mod-1) 'circulate-select-next-child)
(define-circulate-key ("Tab" :mod-1 :shift) 'circulate-select-previous-child)
(define-circulate-key ("Iso_Left_Tab" :mod-1 :shift) 'circulate-select-previous-child)
(define-circulate-key ("Right" :mod-1) 'circulate-select-next-brother)
(define-circulate-key ("Left" :mod-1) 'circulate-select-previous-brother)
-
-
(define-circulate-release-key ("Alt_L" :alt) 'leave-circulate-mode))
@@ -201,45 +204,46 @@
(defun circulate-mode (&key child-direction brother-direction)
(setf *circulate-hit* 0)
(set-circulate-leave-key)
- (setf *circulate-font* (xlib:open-font *display* *circulate-font-string*)
- *circulate-window* (xlib:create-window :parent *root*
- :x (truncate (/ (- (xlib:screen-width *screen*) *circulate-width*) 2))
- :y (- (xlib:screen-height *screen*) *circulate-height* 2)
- :width *circulate-width*
- :height *circulate-height*
+ (with-placement (*circulate-mode-placement* x y *circulate-width* *circulate-height*)
+ (setf *circulate-font* (xlib:open-font *display* *circulate-font-string*)
+ *circulate-window* (xlib:create-window :parent *root*
+ :x x
+ :y y
+ :width *circulate-width*
+ :height *circulate-height*
+ :background (get-color *circulate-background*)
+ :border-width 1
+ :border (get-color *circulate-border*)
+ :colormap (xlib:screen-default-colormap *screen*)
+ :event-mask '(:exposure :key-press))
+ *circulate-gc* (xlib:create-gcontext :drawable *circulate-window*
+ :foreground (get-color *circulate-foreground*)
:background (get-color *circulate-background*)
- :border-width 1
- :border (get-color *circulate-border*)
- :colormap (xlib:screen-default-colormap *screen*)
- :event-mask '(:exposure :key-press))
- *circulate-gc* (xlib:create-gcontext :drawable *circulate-window*
- :foreground (get-color *circulate-foreground*)
- :background (get-color *circulate-background*)
- :font *circulate-font*
- :line-style :solid))
- (map-window *circulate-window*)
- (draw-circulate-mode-window)
- (when child-direction
- (reorder-child child-direction))
- (when brother-direction
- (reorder-brother brother-direction))
- (let ((grab-keyboard-p (xgrab-keyboard-p))
- (grab-pointer-p (xgrab-pointer-p)))
- (xgrab-pointer *root* 92 93)
- (unless grab-keyboard-p
- (ungrab-main-keys)
- (xgrab-keyboard *root*))
- (generic-mode 'exit-circulate-loop
- :loop-function #'circulate-loop-function
- :leave-function #'circulate-leave-function
- :key-press-hook #'circulate-handle-key-press
- :key-release-hook #'circulate-handle-key-release)
- (unless grab-keyboard-p
- (xungrab-keyboard)
- (grab-main-keys))
- (if grab-pointer-p
- (xgrab-pointer *root* 66 67)
- (xungrab-pointer))))
+ :font *circulate-font*
+ :line-style :solid))
+ (map-window *circulate-window*)
+ (draw-circulate-mode-window)
+ (when child-direction
+ (reorder-child child-direction))
+ (when brother-direction
+ (reorder-brother brother-direction))
+ (let ((grab-keyboard-p (xgrab-keyboard-p))
+ (grab-pointer-p (xgrab-pointer-p)))
+ (xgrab-pointer *root* 92 93)
+ (unless grab-keyboard-p
+ (ungrab-main-keys)
+ (xgrab-keyboard *root*))
+ (generic-mode 'exit-circulate-loop
+ :loop-function #'circulate-loop-function
+ :leave-function #'circulate-leave-function
+ :key-press-hook #'circulate-handle-key-press
+ :key-release-hook #'circulate-handle-key-release)
+ (unless grab-keyboard-p
+ (xungrab-keyboard)
+ (grab-main-keys))
+ (if grab-pointer-p
+ (xgrab-pointer *root* 66 67)
+ (xungrab-pointer)))))
(defun select-next-child ()
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Tue Jun 16 17:05:07 2009
@@ -469,6 +469,7 @@
(xlib:drawable-y window) ny
(xlib:drawable-width window) nw
(xlib:drawable-height window) nh)
+ (xlib:display-finish-output *display*)
change)))))
@@ -488,6 +489,7 @@
(xlib:drawable-y window) ry
(xlib:drawable-width window) rw
(xlib:drawable-height window) rh)
+ (xlib:display-finish-output *display*)
change)))))
(defmethod adapt-child-to-parent (child parent)
Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp (original)
+++ clfswm/src/config.lisp Tue Jun 16 17:05:07 2009
@@ -252,6 +252,10 @@
"Config(Circulate mode group): Circulate mode window height")
+(defparameter *circulate-text-limite* 30
+ "Config(Circulate mode group): Maximum text limite in the circulate window")
+
+
;;; CONFIG - Show key binding colors
(defparameter *info-color-title* "Magenta"
Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp (original)
+++ clfswm/src/package.lisp Tue Jun 16 17:05:07 2009
@@ -256,6 +256,7 @@
(defparameter *second-mode-placement* 'top-middle-child-placement)
(defparameter *info-mode-placement* 'top-left-child-placement)
(defparameter *query-mode-placement* 'top-left-child-placement)
+(defparameter *circulate-mode-placement* 'bottom-middle-child-placement)
Modified: clfswm/src/tools.lisp
==============================================================================
--- clfswm/src/tools.lisp (original)
+++ clfswm/src/tools.lisp Tue Jun 16 17:05:07 2009
@@ -52,6 +52,7 @@
:expand-newline
:ensure-list
:ensure-printable
+ :limit-length
:ensure-n-elems
:begin-with-2-spaces
:string-equal-p
@@ -327,6 +328,9 @@
"Ensure a string is printable in ascii"
(or (substitute-if-not new #'standard-char-p (or string "")) ""))
+(defun limit-length (string &optional (length 10))
+ (subseq string 0 (min (length string) length)))
+
(defun ensure-n-elems (list n)
"Ensure that list has exactly n elements"
More information about the clfswm-cvs
mailing list