[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch test updated. R-1106-57-g4519205
Philippe Brochard
pbrochard at common-lisp.net
Sun Jun 3 13:06:47 UTC 2012
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager".
The branch, test has been updated
via 45192056686a6053098c861562b757f944db5fd0 (commit)
from 0ff435ca00f6ab1f2e434087dfa38048a1527808 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 45192056686a6053098c861562b757f944db5fd0
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Sun Jun 3 15:06:40 2012 +0200
src/clfswm-placement.lisp: Add an optional border size in all placement functions.
diff --git a/ChangeLog b/ChangeLog
index 1cf1374..af5e2df 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2012-06-03 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-placement.lisp: Add an optional border size in all
+ placement functions.
+
2012-05-30 Philippe Brochard <pbrochard at common-lisp.net>
* 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))
, at 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 @@
, at 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 @@
, at 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))))
-----------------------------------------------------------------------
Summary of changes:
ChangeLog | 5 ++
contrib/toolbar.lisp | 44 ++++++++++-------
contrib/volume-mode.lisp | 17 ++++---
src/clfswm-placement.lisp | 114 +++++++++++++++++++++++++--------------------
4 files changed, 105 insertions(+), 75 deletions(-)
hooks/post-receive
--
CLFSWM - A(nother) Common Lisp FullScreen Window Manager
More information about the clfswm-cvs
mailing list