From 45192056686a6053098c861562b757f944db5fd0 Mon Sep 17 00:00:00 2001 From: Philippe Brochard Date: Sun, 3 Jun 2012 15:06:40 +0200 Subject: [PATCH] src/clfswm-placement.lisp: Add an optional border size in all placement functions. --- ChangeLog | 5 ++ contrib/toolbar.lisp | 44 ++++++++++-------- contrib/volume-mode.lisp | 17 ++++--- src/clfswm-placement.lisp | 114 ++++++++++++++++++++++++++-------------------- 4 files changed, 105 insertions(+), 75 deletions(-) diff --git a/ChangeLog b/ChangeLog index 1cf1374..af5e2df 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-06-03 Philippe Brochard + + * src/clfswm-placement.lisp: Add an optional border size in all + placement functions. + 2012-05-30 Philippe Brochard * contrib/toolbar.lisp (clock): Add a clock module. diff --git a/contrib/toolbar.lisp b/contrib/toolbar.lisp index 17205b3..22b9464 100644 --- a/contrib/toolbar.lisp +++ b/contrib/toolbar.lisp @@ -32,24 +32,31 @@ (format t "Loading Toolbar code... ") -(defstruct toolbar root-x root-y root direction size thickness placement autohide modules font window gc) +(defstruct toolbar root-x root-y root direction size thickness placement refresh-delay + autohide modules font window gc border-size) (defparameter *toolbar-list* nil) (defparameter *toolbar-module-list* nil) ;;; CONFIG - Toolbar window string colors (defconfig *toolbar-window-font-string* *default-font-string* - 'Toolbar-Window "Toolbar window font string") + 'Toolbar "Toolbar window font string") (defconfig *toolbar-window-background* "black" - 'Toolbar-Window "Toolbar Window background color") + 'Toolbar "Toolbar Window background color") (defconfig *toolbar-window-foreground* "green" - 'Toolbar-Window "Toolbar Window foreground color") + 'Toolbar "Toolbar Window foreground color") (defconfig *toolbar-window-border* "red" - 'Toolbar-Window "Toolbar Window border color") + 'Toolbar "Toolbar Window border color") +(defconfig *toolbar-default-border-size* 0 + 'Toolbar "Toolbar Window border size") (defconfig *toolbar-window-transparency* *default-transparency* - 'Toolbar-window "Toolbar window background transparency") + 'Toolbar "Toolbar window background transparency") (defconfig *toolbar-default-thickness* 20 - 'toolbar-window "Toolbar default thickness") + 'Toolbar "Toolbar default thickness") +(defconfig *toolbar-default-refresh-delay* 30 + 'Toolbar "Toolbar default refresh delay") +(defconfig *toolbar-default-autohide* nil + 'Toolbar "Toolbar default autohide value") (defconfig *toolbar-window-placement* 'top-left-placement 'Placement "Toolbar window placement") @@ -61,7 +68,7 @@ (unless (toolbar-autohide toolbar) (let ((root (toolbar-root toolbar)) (placement-name (symbol-name (toolbar-placement toolbar))) - (thickness (+ (toolbar-thickness toolbar) (* 2 *border-size*)))) + (thickness (+ (toolbar-thickness toolbar) (* 2 (toolbar-border-size toolbar))))) (when (root-p root) (case (toolbar-direction toolbar) (:horiz (cond ((search "TOP" placement-name) @@ -106,13 +113,11 @@ (and (xlib:window-p win) (member win windows-list :test 'xlib:window-equal))) (defun refresh-toolbar (toolbar) - (add-timer 1 (lambda () - (refresh-toolbar toolbar)) + (add-timer (toolbar-refresh-delay toolbar) + (lambda () + (refresh-toolbar toolbar)) :refresh-toolbar) (clear-pixmap-buffer (toolbar-window toolbar) (toolbar-gc toolbar)) -;; (toolbar-draw-text toolbar 0 (/ *toolbar-default-thickness* 2) "This is a test!!! abcpdj") -;; (toolbar-draw-text toolbar 100 (/ *toolbar-default-thickness* 2) "This ijTjjs a test!!! abcpdj") - ;; (dbg (toolbar-modules toolbar)) (dolist (module (toolbar-modules toolbar)) (let ((fun (toolbar-symbol-fun (first module)))) (when (fboundp fun) @@ -147,15 +152,16 @@ (height (if (equal (toolbar-direction toolbar) :horiz) (toolbar-thickness toolbar) (round (/ (* (root-h root) (toolbar-size toolbar)) 100))))) - (with-placement ((toolbar-placement toolbar) x y width height) + (with-placement ((toolbar-placement toolbar) x y width height (toolbar-border-size toolbar)) (setf (toolbar-window toolbar) (xlib:create-window :parent *root* :x x :y y :width width :height height :background (get-color *toolbar-window-background*) - :border-width 0 - :border (get-color *toolbar-window-border*) + :border-width (toolbar-border-size toolbar) + :border (when (plusp (toolbar-border-size toolbar)) + (get-color *toolbar-window-border*)) :colormap (xlib:screen-default-colormap *screen*) :event-mask '(:exposure :key-press)) (toolbar-gc toolbar) (xlib:create-gcontext :drawable (toolbar-window toolbar) @@ -183,7 +189,7 @@ (close-toolbar toolbar))) -(defun add-toolbar (root-x root-y direction size placement autohide &rest modules) +(defun add-toolbar (root-x root-y direction size placement &rest modules) "Add a new toolbar. root-x, root-y: root coordinates direction: one of :horiz or :vert @@ -192,7 +198,9 @@ :direction direction :size size :thickness *toolbar-default-thickness* :placement placement - :autohide autohide + :autohide *toolbar-default-autohide* + :refresh-delay *toolbar-default-refresh-delay* + :border-size *toolbar-default-border-size* :modules modules))) (push toolbar *toolbar-list*) toolbar)) diff --git a/contrib/volume-mode.lisp b/contrib/volume-mode.lisp index 752663c..5809f26 100644 --- a/contrib/volume-mode.lisp +++ b/contrib/volume-mode.lisp @@ -85,13 +85,15 @@ ;;; CONFIG - Volume mode (defconfig *volume-font-string* *default-font-string* - 'Volume-mode "Volume string window font string") + 'Volume-mode "Volume window font string") (defconfig *volume-background* "black" - 'Volume-mode "Volume string window background color") + 'Volume-mode "Volume window background color") (defconfig *volume-foreground* "green" - 'Volume-mode "Volume string window foreground color") + 'Volume-mode "Volume window foreground color") (defconfig *volume-border* "red" - 'Volume-mode "Volume string window border color") + 'Volume-mode "Volume window border color") +(defconfig *volume-border-size* 1 + 'Volume-mode "Volume window border size") (defconfig *volume-width* 400 'Volume-mode "Volume mode window width") (defconfig *volume-height* 15 @@ -174,7 +176,7 @@ (erase-timer :volume-mode-timer)))) (defun volume-enter-function () - (with-placement (*volume-mode-placement* x y *volume-width* *volume-height*) + (with-placement (*volume-mode-placement* x y *volume-width* *volume-height* *volume-border-size*) (setf *volume-font* (xlib:open-font *display* *volume-font-string*) *volume-window* (xlib:create-window :parent *root* :x x @@ -182,8 +184,9 @@ :width *volume-width* :height *volume-height* :background (get-color *volume-background*) - :border-width 1 - :border (get-color *volume-border*) + :border-width *volume-border-size* + :border (when (plusp *volume-border-size*) + (get-color *volume-border*)) :colormap (xlib:screen-default-colormap *screen*) :event-mask '(:exposure :key-press)) *volume-gc* (xlib:create-gcontext :drawable *volume-window* diff --git a/src/clfswm-placement.lisp b/src/clfswm-placement.lisp index e04ac20..d7e3d01 100644 --- a/src/clfswm-placement.lisp +++ b/src/clfswm-placement.lisp @@ -25,19 +25,19 @@ (in-package :clfswm) -(defun get-placement-values (placement &optional (width 0) (height 0)) +(defun get-placement-values (placement &optional (width 0) (height 0) (border-size *border-size*)) (typecase placement (list (values-list placement)) - (function (funcall placement width height)) + (function (funcall placement width height border-size)) (symbol (if (fboundp placement) - (funcall placement width height) + (funcall placement width height border-size) (values 0 0 width height))) (t (values 0 0 width height)))) -(defmacro with-placement ((placement x y &optional (width 0) (height 0)) &body body) +(defmacro with-placement ((placement x y &optional (width 0) (height 0) (border-size *border-size*)) &body body) `(multiple-value-bind (,x ,y width height) - (get-placement-values ,placement ,width ,height) + (get-placement-values ,placement ,width ,height ,border-size) (declare (ignorable width height)) ,@body)) @@ -58,50 +58,54 @@ ;;; ;;; Absolute placement ;;; -(defun top-left-placement (&optional (width 0) (height 0)) +(defun top-left-placement (&optional (width 0) (height 0) (border-size *border-size*)) + (declare (ignore border-size)) (values 0 0 width height)) -(defun top-middle-placement (&optional (width 0) (height 0)) +(defun top-middle-placement (&optional (width 0) (height 0) (border-size *border-size*)) + (declare (ignore border-size)) (values (truncate (/ (- (xlib:screen-width *screen*) width) 2)) 0 width height)) -(defun top-right-placement (&optional (width 0) (height 0)) - (values (- (xlib:screen-width *screen*) width (* *border-size* 2)) +(defun top-right-placement (&optional (width 0) (height 0) (border-size *border-size*)) + (values (- (xlib:screen-width *screen*) width (* border-size 2)) 0 width height)) -(defun middle-left-placement (&optional (width 0) (height 0)) +(defun middle-left-placement (&optional (width 0) (height 0) (border-size *border-size*)) + (declare (ignore border-size)) (values 0 (truncate (/ (- (xlib:screen-height *screen*) height) 2)) width height)) -(defun middle-middle-placement (&optional (width 0) (height 0)) +(defun middle-middle-placement (&optional (width 0) (height 0) (border-size *border-size*)) + (declare (ignore border-size)) (values (truncate (/ (- (xlib:screen-width *screen*) width) 2)) (truncate (/ (- (xlib:screen-height *screen*) height) 2)) width height)) -(defun middle-right-placement (&optional (width 0) (height 0)) - (values (- (xlib:screen-width *screen*) width (* *border-size* 2)) +(defun middle-right-placement (&optional (width 0) (height 0) (border-size *border-size*)) + (values (- (xlib:screen-width *screen*) width (* border-size 2)) (truncate (/ (- (xlib:screen-height *screen*) height) 2)) width height)) -(defun bottom-left-placement (&optional (width 0) (height 0)) +(defun bottom-left-placement (&optional (width 0) (height 0) (border-size *border-size*)) (values 0 - (- (xlib:screen-height *screen*) height (* *border-size* 2)) + (- (xlib:screen-height *screen*) height (* border-size 2)) width height)) -(defun bottom-middle-placement (&optional (width 0) (height 0)) +(defun bottom-middle-placement (&optional (width 0) (height 0) (border-size *border-size*)) (values (truncate (/ (- (xlib:screen-width *screen*) width) 2)) - (- (xlib:screen-height *screen*) height (* *border-size* 2)) + (- (xlib:screen-height *screen*) height (* border-size 2)) width height)) -(defun bottom-right-placement (&optional (width 0) (height 0)) - (values (- (xlib:screen-width *screen*) width (* *border-size* 2)) - (- (xlib:screen-height *screen*) height (* *border-size* 2)) +(defun bottom-right-placement (&optional (width 0) (height 0) (border-size *border-size*)) + (values (- (xlib:screen-width *screen*) width (* border-size 2)) + (- (xlib:screen-height *screen*) height (* border-size 2)) width height)) @@ -126,7 +130,8 @@ ,@body)) -(defun top-left-child-placement (&optional (width 0) (height 0)) +(defun top-left-child-placement (&optional (width 0) (height 0) (border-size *border-size*)) + (declare (ignore border-size)) (with-current-child-coord (x y w h) (let ((width (min (- w 4) width)) (height (min (- h 4) height))) @@ -134,7 +139,8 @@ (+ y 2) width height)))) -(defun top-middle-child-placement (&optional (width 0) (height 0)) +(defun top-middle-child-placement (&optional (width 0) (height 0) (border-size *border-size*)) + (declare (ignore border-size)) (with-current-child-coord (x y w h) (let ((width (min (- w 4) width)) (height (min (- h 4) height))) @@ -142,7 +148,8 @@ (+ y 2) width height)))) -(defun top-right-child-placement (&optional (width 0) (height 0)) +(defun top-right-child-placement (&optional (width 0) (height 0) (border-size *border-size*)) + (declare (ignore border-size)) (with-current-child-coord (x y w h) (let ((width (min (- w 4) width)) (height (min (- h 4) height))) @@ -152,7 +159,8 @@ -(defun middle-left-child-placement (&optional (width 0) (height 0)) +(defun middle-left-child-placement (&optional (width 0) (height 0) (border-size *border-size*)) + (declare (ignore border-size)) (with-current-child-coord (x y w h) (let ((width (min (- w 4) width)) (height (min (- h 4) height))) @@ -160,7 +168,8 @@ (+ y (truncate (/ (- h height) 2))) width height)))) -(defun middle-middle-child-placement (&optional (width 0) (height 0)) +(defun middle-middle-child-placement (&optional (width 0) (height 0) (border-size *border-size*)) + (declare (ignore border-size)) (with-current-child-coord (x y w h) (let ((width (min (- w 4) width)) (height (min (- h 4) height))) @@ -168,7 +177,8 @@ (+ y (truncate (/ (- h height) 2))) width height)))) -(defun middle-right-child-placement (&optional (width 0) (height 0)) +(defun middle-right-child-placement (&optional (width 0) (height 0) (border-size *border-size*)) + (declare (ignore border-size)) (with-current-child-coord (x y w h) (let ((width (min (- w 4) width)) (height (min (- h 4) height))) @@ -177,7 +187,8 @@ width height)))) -(defun bottom-left-child-placement (&optional (width 0) (height 0)) +(defun bottom-left-child-placement (&optional (width 0) (height 0) (border-size *border-size*)) + (declare (ignore border-size)) (with-current-child-coord (x y w h) (let ((width (min (- w 4) width)) (height (min (- h 4) height))) @@ -185,7 +196,8 @@ (+ y (- h height 2)) width height)))) -(defun bottom-middle-child-placement (&optional (width 0) (height 0)) +(defun bottom-middle-child-placement (&optional (width 0) (height 0) (border-size *border-size*)) + (declare (ignore border-size)) (with-current-child-coord (x y w h) (let ((width (min (- w 4) width)) (height (min (- h 4) height))) @@ -193,7 +205,8 @@ (+ y (- h height 2)) width height)))) -(defun bottom-right-child-placement (&optional (width 0) (height 0)) +(defun bottom-right-child-placement (&optional (width 0) (height 0) (border-size *border-size*)) + (declare (ignore border-size)) (with-current-child-coord (x y w h) (let ((width (min (- w 4) width)) (height (min (- h 4) height))) @@ -222,41 +235,42 @@ ,@body)) -(defun top-left-root-placement (&optional (width 0) (height 0)) +(defun top-left-root-placement (&optional (width 0) (height 0) (border-size *border-size*)) (with-current-root-coord (x y w h) (let ((width (min (- w 4) width)) (height (min (- h 4) height))) - (values (+ x 2) - (+ y 2) + (values (+ x border-size 1) + (+ y border-size 1) width height)))) -(defun top-middle-root-placement (&optional (width 0) (height 0)) +(defun top-middle-root-placement (&optional (width 0) (height 0) (border-size *border-size*)) (with-current-root-coord (x y w h) (let ((width (min (- w 4) width)) (height (min (- h 4) height))) (values (+ x (truncate (/ (- w width) 2))) - (+ y 2) + (+ y border-size 1) width height)))) -(defun top-right-root-placement (&optional (width 0) (height 0)) +(defun top-right-root-placement (&optional (width 0) (height 0) (border-size *border-size*)) (with-current-root-coord (x y w h) (let ((width (min (- w 4) width)) (height (min (- h 4) height))) - (values (+ x (- w width 2)) - (+ y 2) + (values (+ x (- w width border-size 1)) + (+ y border-size 1) width height)))) -(defun middle-left-root-placement (&optional (width 0) (height 0)) +(defun middle-left-root-placement (&optional (width 0) (height 0) (border-size *border-size*)) (with-current-root-coord (x y w h) (let ((width (min (- w 4) width)) (height (min (- h 4) height))) - (values (+ x 2) + (values (+ x border-size 1) (+ y (truncate (/ (- h height) 2))) width height)))) -(defun middle-middle-root-placement (&optional (width 0) (height 0)) +(defun middle-middle-root-placement (&optional (width 0) (height 0) (border-size *border-size*)) + (declare (ignore border-size)) (with-current-root-coord (x y w h) (let ((width (min (- w 4) width)) (height (min (- h 4) height))) @@ -264,36 +278,36 @@ (+ y (truncate (/ (- h height) 2))) width height)))) -(defun middle-right-root-placement (&optional (width 0) (height 0)) +(defun middle-right-root-placement (&optional (width 0) (height 0) (border-size *border-size*)) (with-current-root-coord (x y w h) (let ((width (min (- w 4) width)) (height (min (- h 4) height))) - (values (+ x (- w width 2)) + (values (+ x (- w width border-size 1)) (+ y (truncate (/ (- h height) 2))) width height)))) -(defun bottom-left-root-placement (&optional (width 0) (height 0)) +(defun bottom-left-root-placement (&optional (width 0) (height 0) (border-size *border-size*)) (with-current-root-coord (x y w h) (let ((width (min (- w 4) width)) (height (min (- h 4) height))) - (values (+ x 2) - (+ y (- h height 2)) + (values (+ x border-size 1) + (+ y (- h height border-size 1)) width height)))) -(defun bottom-middle-root-placement (&optional (width 0) (height 0)) +(defun bottom-middle-root-placement (&optional (width 0) (height 0) (border-size *border-size*)) (with-current-root-coord (x y w h) (let ((width (min (- w 4) width)) (height (min (- h 4) height))) (values (+ x (truncate (/ (- w width) 2))) - (+ y (- h height 2)) + (+ y (- h height border-size 1)) width height)))) -(defun bottom-right-root-placement (&optional (width 0) (height 0)) +(defun bottom-right-root-placement (&optional (width 0) (height 0) (border-size *border-size*)) (with-current-root-coord (x y w h) (let ((width (min (- w 4) width)) (height (min (- h 4) height))) - (values (+ x (- w width 2)) - (+ y (- h height 2)) + (values (+ x (- w width border-size 1)) + (+ y (- h height border-size 1)) width height)))) -- 2.11.4.GIT