[clfswm-cvs] r428 - in clfswm: . contrib src
Philippe Brochard
pbrochard at common-lisp.net
Wed Mar 9 22:16:51 UTC 2011
Author: pbrochard
Date: Wed Mar 9 17:16:51 2011
New Revision: 428
Log:
src/clfswm-layout.lisp: Add a variable border size for frames and windows. contrib/volume-mode.lisp (set-default-volume-keys): Add more keybindings (up/down, right/left) to raise/lower the volume.
Modified:
clfswm/ChangeLog
clfswm/TODO
clfswm/contrib/volume-mode.lisp
clfswm/src/clfswm-circulate-mode.lisp
clfswm/src/clfswm-expose-mode.lisp
clfswm/src/clfswm-info.lisp
clfswm/src/clfswm-internal.lisp
clfswm/src/clfswm-layout.lisp
clfswm/src/clfswm-placement.lisp
clfswm/src/clfswm-query.lisp
clfswm/src/clfswm-second-mode.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/config.lisp
clfswm/src/package.lisp
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Wed Mar 9 17:16:51 2011
@@ -1,3 +1,11 @@
+2011-03-09 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * contrib/volume-mode.lisp (set-default-volume-keys): Add more
+ keybindings (up/down, right/left) to raise/lower the volume.
+
+ * src/clfswm-layout.lisp: Add a variable border size for frames
+ and windows.
+
2011-03-08 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm-util.lisp (cut-current-child, remove-current-child)
Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO (original)
+++ clfswm/TODO Wed Mar 9 17:16:51 2011
@@ -17,6 +17,10 @@
see if there is a need for a rectangular optimization:
Result: map-window: 1.2E-5 sec. change stack order: 3.14E-4 sec.
=> It maybe useful to optimize this part.
+ + Do not redisplay a child already displayed
+ Implementation note: build a list with all displayed children and there sizes
+ -> display a child only if it is not already displayed and it's not behind
+ a child already displayed (-> search in child list and return as soon as one is found)
MAYBE
Modified: clfswm/contrib/volume-mode.lisp
==============================================================================
--- clfswm/contrib/volume-mode.lisp (original)
+++ clfswm/contrib/volume-mode.lisp Wed Mar 9 17:16:51 2011
@@ -116,6 +116,12 @@
(define-volume-key ("m") 'volume-mute)
(define-volume-key ("l") 'volume-lower)
(define-volume-key ("r") 'volume-raise)
+ (define-volume-key ("Down") 'volume-lower)
+ (define-volume-key ("Up") 'volume-raise)
+ (define-volume-key ("Left") 'volume-lower)
+ (define-volume-key ("Right") 'volume-raise)
+ (define-volume-key ("PageUp") 'volume-lower)
+ (define-volume-key ("PageDown") 'volume-raise)
(define-volume-key ("Return") 'leave-volume-mode)
(define-volume-key ("Escape") 'leave-volume-mode)
(define-volume-key ("g" :control) 'leave-volume-mode)
Modified: clfswm/src/clfswm-circulate-mode.lisp
==============================================================================
--- clfswm/src/clfswm-circulate-mode.lisp (original)
+++ clfswm/src/clfswm-circulate-mode.lisp Wed Mar 9 17:16:51 2011
@@ -204,7 +204,7 @@
:width *circulate-width*
:height *circulate-height*
:background (get-color *circulate-background*)
- :border-width 1
+ :border-width *border-size*
:border (get-color *circulate-border*)
:colormap (xlib:screen-default-colormap *screen*)
:event-mask '(:exposure :key-press))
Modified: clfswm/src/clfswm-expose-mode.lisp
==============================================================================
--- clfswm/src/clfswm-expose-mode.lisp (original)
+++ clfswm/src/clfswm-expose-mode.lisp Wed Mar 9 17:16:51 2011
@@ -121,7 +121,7 @@
:x x :y y
:width width :height height
:background (get-color *expose-background*)
- :border-width 1
+ :border-width *border-size*
:border (get-color *expose-border*)
:colormap (xlib:screen-default-colormap *screen*)
:event-mask '(:exposure :key-press)))
Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp (original)
+++ clfswm/src/clfswm-info.lisp Wed Mar 9 17:16:51 2011
@@ -326,7 +326,7 @@
:height height
:background (get-color *info-background*)
:colormap (xlib:screen-default-colormap *screen*)
- :border-width 1
+ :border-width *border-size*
:border (get-color *info-border*)
:event-mask '(:exposure)))
(gc (xlib:create-gcontext :drawable window
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Wed Mar 9 17:16:51 2011
@@ -371,7 +371,7 @@
:height 200
:background (get-color *frame-background*)
:colormap (xlib:screen-default-colormap *screen*)
- :border-width 1
+ :border-width *border-size*
:border (get-color *color-selected*)
:event-mask '(:exposure :button-press :button-release :pointer-motion :enter-window)))
(gc (xlib:create-gcontext :drawable window
@@ -1034,10 +1034,10 @@
(setf (xlib:window-event-mask window) *window-events*)
(set-window-state window +normal-state+)
(setf (xlib:drawable-border-width window) (case (window-type window)
- (:normal 1)
- (:maxsize 1)
- (:transient 1)
- (t 1)))
+ (:normal *border-size*)
+ (:maxsize *border-size*)
+ (:transient *border-size*)
+ (t *border-size*)))
(grab-all-buttons window)
(unless (never-managed-window-p window)
(unless (do-all-frames-nw-hook window)
Modified: clfswm/src/clfswm-layout.lisp
==============================================================================
--- clfswm/src/clfswm-layout.lisp (original)
+++ clfswm/src/clfswm-layout.lisp Wed Mar 9 17:16:51 2011
@@ -30,9 +30,9 @@
;;;
;;; To add a new layout:
;;; 1- define your own layout: a method returning the real size of the
-;;; child in screen size (integer) as 5 values (rx, ry, rw, rh).
+;;; child in screen size (integer) as 4 values (rx, ry, rw, rh).
;;; This method can use the float size of the child (x, y ,w , h).
-;;; It can be specialised for xlib:window or frame
+;;; It can be specialized for xlib:window or frame
;;; 2- Define a setter function for your layout
;;; 3- Register your new layout with register-layout or create
;;; a sub menu for it with register-layout-sub-menu.
@@ -126,6 +126,21 @@
'(("s" fast-layout-switch)
("p" push-in-fast-layout-list)))
+(declaim (inline adj-border-xy adj-border-wh))
+(defgeneric adj-border-xy (value child))
+(defgeneric adj-border-wh (value child))
+
+(defmethod adj-border-xy (v (child xlib:window))
+ (+ v (xlib:drawable-border-width child)))
+
+(defmethod adj-border-xy (v (child frame))
+ (+ v (xlib:drawable-border-width (frame-window child))))
+
+(defmethod adj-border-wh (v (child xlib:window))
+ (- v (* (xlib:drawable-border-width child) 2)))
+
+(defmethod adj-border-wh (v (child frame))
+ (- v (* (xlib:drawable-border-width (frame-window child)) 2)))
;;; No layout
@@ -134,16 +149,16 @@
(defmethod no-layout ((child xlib:window) parent)
(with-slots (rx ry rw rh) parent
- (values (1+ rx)
- (1+ ry)
- (- rw 2)
- (- rh 2))))
+ (values (adj-border-xy rx child)
+ (adj-border-xy ry child)
+ (adj-border-wh rw child)
+ (adj-border-wh rh child))))
(defmethod no-layout ((child frame) parent)
- (values (x-fl->px (frame-x child) parent)
- (y-fl->px (frame-y child) parent)
- (w-fl->px (frame-w child) parent)
- (h-fl->px (frame-h child) parent)))
+ (values (adj-border-xy (x-fl->px (frame-x child) parent) child)
+ (adj-border-xy (y-fl->px (frame-y child) parent) child)
+ (adj-border-wh (w-fl->px (frame-w child) parent) child)
+ (adj-border-wh (h-fl->px (frame-h child) parent) child)))
@@ -168,12 +183,11 @@
(:documentation "Maximize layout: Maximize windows and frames in there parent frame"))
(defmethod maximize-layout (child parent)
- (declare (ignore child))
(with-slots (rx ry rw rh) parent
- (values (1+ rx)
- (1+ ry)
- (- rw 2)
- (- rh 2))))
+ (values (adj-border-xy rx child)
+ (adj-border-xy ry child)
+ (adj-border-wh rw child)
+ (adj-border-wh rh child))))
(defun set-maximize-layout ()
@@ -235,10 +249,10 @@
(if (zerop pos)
(setf width (* dx (1+ dpos)))
(incf pos dpos)))
- (values (round (+ (frame-rx parent) (truncate (* (mod pos nx) dx)) 1))
- (round (+ (frame-ry parent) (truncate (* (truncate (/ pos nx)) dy)) 1))
- (round (- width 2))
- (round (- dy 2)))))
+ (values (round (adj-border-xy (+ (frame-rx parent) (truncate (* (mod pos nx) dx))) child))
+ (round (adj-border-xy (+ (frame-ry parent) (truncate (* (truncate (/ pos nx)) dy))) child))
+ (round (adj-border-wh width child))
+ (round (adj-border-wh dy child)))))
(defun set-tile-layout ()
"Tile child in its frame (vertical)"
@@ -265,10 +279,10 @@
(if (zerop pos)
(setf height (* dy (1+ dpos)))
(incf pos dpos)))
- (values (round (+ (frame-rx parent) (truncate (* (truncate (/ pos ny)) dx)) 1))
- (round (+ (frame-ry parent) (truncate (* (mod pos ny) dy)) 1))
- (round (- dx 2))
- (round (- height 2)))))
+ (values (round (adj-border-xy (+ (frame-rx parent) (truncate (* (truncate (/ pos ny)) dx))) child))
+ (round (adj-border-xy (+ (frame-ry parent) (truncate (* (mod pos ny) dy))) child))
+ (round (adj-border-wh dx child))
+ (round (adj-border-wh height child)))))
(defun set-tile-horizontal-layout ()
"Tile child in its frame (horizontal)"
@@ -286,10 +300,10 @@
(pos (child-position child managed-children))
(len (length managed-children))
(dy (/ (frame-rh parent) len)))
- (values (round (+ (frame-rx parent) 1))
- (round (+ (frame-ry parent) (* pos dy) 1))
- (round (- (frame-rw parent) 2))
- (round (- dy 2)))))
+ (values (round (adj-border-xy (frame-rx parent) child))
+ (round (adj-border-xy (+ (frame-ry parent) (* pos dy)) child))
+ (round (adj-border-wh (frame-rw parent) child))
+ (round (adj-border-wh dy child)))))
(defun set-one-column-layout ()
"One column layout"
@@ -306,10 +320,10 @@
(pos (child-position child managed-children))
(len (length managed-children))
(dx (/ (frame-rw parent) len)))
- (values (round (+ (frame-rx parent) (* pos dx) 1))
- (round (+ (frame-ry parent) 1))
- (round (- dx 2))
- (round (- (frame-rh parent) 2)))))
+ (values (round (adj-border-xy (+ (frame-rx parent) (* pos dx)) child))
+ (round (adj-border-xy (frame-ry parent) child))
+ (round (adj-border-wh dx child))
+ (round (adj-border-wh (frame-rh parent) child)))))
(defun set-one-line-layout ()
"One line layout"
@@ -332,10 +346,10 @@
(dy (/ rh (ceiling (/ len n))))
(size (or (frame-data-slot parent :tile-space-size) 0.1)))
(when (> size 0.5) (setf size 0.45))
- (values (round (+ rx (truncate (* (mod pos n) dx)) (* dx size) 1))
- (round (+ ry (truncate (* (truncate (/ pos n)) dy)) (* dy size) 1))
- (round (- dx (* dx size 2) 2))
- (round (- dy (* dy size 2) 2))))))
+ (values (round (adj-border-xy (+ rx (truncate (* (mod pos n) dx)) (* dx size)) child))
+ (round (adj-border-xy (+ ry (truncate (* (truncate (/ pos n)) dy)) (* dy size)) child))
+ (round (adj-border-wh (- dx (* dx size 2)) child))
+ (round (adj-border-wh (- dy (* dy size 2)) child))))))
@@ -368,14 +382,14 @@
(size (or (frame-data-slot parent :tile-size) 0.8)))
(if (> (length managed-children) 1)
(if (= pos 0)
- (values (1+ rx)
- (1+ ry)
- (- (round (* rw size)) 2)
- (- rh 2))
- (values (1+ (round (+ rx (* rw size))))
- (1+ (round (+ ry (* dy (1- pos)))))
- (- (round (* rw (- 1 size))) 2)
- (- (round dy) 2)))
+ (values (adj-border-xy rx child)
+ (adj-border-xy ry child)
+ (adj-border-wh (round (* rw size)) child)
+ (adj-border-wh rh child))
+ (values (adj-border-xy (round (+ rx (* rw size))) child)
+ (adj-border-xy (round (+ ry (* dy (1- pos)))) child)
+ (adj-border-wh (round (* rw (- 1 size))) child)
+ (adj-border-wh (round dy) child)))
(no-layout child parent)))))
@@ -397,14 +411,14 @@
(size (or (frame-data-slot parent :tile-size) 0.8)))
(if (> (length managed-children) 1)
(if (= pos 0)
- (values (1+ (round (+ rx (* rw (- 1 size)))))
- (1+ ry)
- (- (round (* rw size)) 2)
- (- rh 2))
- (values (1+ rx)
- (1+ (round (+ ry (* dy (1- pos)))))
- (- (round (* rw (- 1 size))) 2)
- (- (round dy) 2)))
+ (values (adj-border-xy (round (+ rx (* rw (- 1 size)))) child)
+ (adj-border-xy ry child)
+ (adj-border-wh (round (* rw size)) child)
+ (adj-border-wh rh child))
+ (values (adj-border-xy rx child)
+ (adj-border-xy (round (+ ry (* dy (1- pos)))) child)
+ (adj-border-wh (round (* rw (- 1 size))) child)
+ (adj-border-wh (round dy) child)))
(no-layout child parent)))))
@@ -429,14 +443,14 @@
(size (or (frame-data-slot parent :tile-size) 0.8)))
(if (> (length managed-children) 1)
(if (= pos 0)
- (values (1+ rx)
- (1+ ry)
- (- rw 2)
- (- (round (* rh size)) 2))
- (values (1+ (round (+ rx (* dx (1- pos)))))
- (1+ (round (+ ry (* rh size))))
- (- (round dx) 2)
- (- (round (* rh (- 1 size))) 2)))
+ (values (adj-border-xy rx child)
+ (adj-border-xy ry child)
+ (adj-border-wh rw child)
+ (adj-border-wh (round (* rh size)) child))
+ (values (adj-border-xy (round (+ rx (* dx (1- pos)))) child)
+ (adj-border-xy (round (+ ry (* rh size))) child)
+ (adj-border-wh (round dx) child)
+ (adj-border-wh (round (* rh (- 1 size))) child)))
(no-layout child parent)))))
@@ -459,14 +473,14 @@
(size (or (frame-data-slot parent :tile-size) 0.8)))
(if (> (length managed-children) 1)
(if (= pos 0)
- (values (1+ rx)
- (1+ (round (+ ry (* rh (- 1 size)))))
- (- rw 2)
- (- (round (* rh size)) 2))
- (values (1+ (round (+ rx (* dx (1- pos)))))
- (1+ ry)
- (- (round dx) 2)
- (- (round (* rh (- 1 size))) 2)))
+ (values (adj-border-xy rx child)
+ (adj-border-xy (round (+ ry (* rh (- 1 size)))) child)
+ (adj-border-wh rw child)
+ (adj-border-wh (round (* rh size)) child))
+ (values (adj-border-xy (round (+ rx (* dx (1- pos)))) child)
+ (adj-border-xy ry child)
+ (adj-border-wh (round dx) child)
+ (adj-border-wh (round (* rh (- 1 size))) child)))
(no-layout child parent)))))
@@ -496,7 +510,7 @@
(defun tile-left-space-layout (child parent)
- "Tile Left Space: main child on left and others on right. Leave some space on the left."
+ "Tile Left Space: main child on left and others on right. Leave some space (in pixels) on the left."
(with-slots (rx ry rw rh) parent
(let* ((managed-children (get-managed-child parent))
(pos (child-position child managed-children))
@@ -506,14 +520,14 @@
(space (or (frame-data-slot parent :tile-left-space) 100)))
(if (> (length managed-children) 1)
(if (= pos 0)
- (values (+ rx space 1)
- (1+ ry)
- (- (round (* rw size)) 2 space)
- (- rh 2))
- (values (1+ (round (+ rx (* rw size))))
- (1+ (round (+ ry (* dy (1- pos)))))
- (- (round (* rw (- 1 size))) 2)
- (- (round dy) 2)))
+ (values (adj-border-xy (+ rx space) child)
+ (adj-border-xy ry child)
+ (adj-border-wh (- (round (* rw size)) space) child)
+ (adj-border-wh rh child))
+ (values (adj-border-xy (round (+ rx (* rw size))) child)
+ (adj-border-xy (round (+ ry (* dy (1- pos)))) child)
+ (adj-border-wh (round (* rw (- 1 size))) child)
+ (adj-border-wh (round dy) child)))
(multiple-value-bind (rnx rny rnw rnh)
(no-layout child parent)
(values (+ rnx space)
@@ -525,7 +539,7 @@
(defun set-tile-left-space-layout ()
"Tile Left Space: main child on left and others on right. Leave some space on the left."
(layout-ask-size "Tile size in percent (%)" :tile-size)
- (layout-ask-space "Tile space" :tile-left-space)
+ (layout-ask-space "Tile space (in pixels)" :tile-left-space)
(set-layout #'tile-left-space-layout))
(register-layout-sub-menu 'frame-tile-space-layout-menu "Tile with some space on one side menu"
@@ -548,14 +562,14 @@
(if (child-member child main-windows)
(let* ((dy (/ rh len))
(pos (child-position child main-windows)))
- (values (1+ (round (+ rx (* rw (- 1 size)))))
- (1+ (round (+ ry (* dy pos))))
- (- (round (* rw size)) 2)
- (- (round dy) 2)))
- (values (1+ rx)
- (1+ ry)
- (- (round (* rw (- 1 size))) 2)
- (- rh 2)))))))
+ (values (adj-border-xy (round (+ rx (* rw (- 1 size)))) child)
+ (adj-border-xy (round (+ ry (* dy pos))) child)
+ (adj-border-wh (round (* rw size)) child)
+ (adj-border-wh (round dy) child)))
+ (values (adj-border-xy rx child)
+ (adj-border-xy ry child)
+ (adj-border-wh (round (* rw (- 1 size))) child)
+ (adj-border-wh rh child)))))))
(defun set-main-window-right-layout ()
"Main window right: Main windows on the right. Others on the left."
@@ -576,14 +590,14 @@
(if (child-member child main-windows)
(let* ((dy (/ rh len))
(pos (child-position child main-windows)))
- (values (1+ rx)
- (1+ (round (+ ry (* dy pos))))
- (- (round (* rw size)) 2)
- (- (round dy) 2)))
- (values (1+ (round (+ rx (* rw size))))
- (1+ ry)
- (- (round (* rw (- 1 size))) 2)
- (- rh 2)))))))
+ (values (adj-border-xy rx child)
+ (adj-border-xy (round (+ ry (* dy pos))) child)
+ (adj-border-wh (round (* rw size)) child)
+ (adj-border-wh (round dy) child)))
+ (values (adj-border-xy (round (+ rx (* rw size))) child)
+ (adj-border-xy ry child)
+ (adj-border-wh (round (* rw (- 1 size))) child)
+ (adj-border-wh rh child)))))))
(defun set-main-window-left-layout ()
"Main window left: Main windows on the left. Others on the right."
@@ -603,14 +617,14 @@
(if (child-member child main-windows)
(let* ((dx (/ rw len))
(pos (child-position child main-windows)))
- (values (1+ (round (+ rx (* dx pos))))
- (1+ ry)
- (- (round dx) 2)
- (- (round (* rh size)) 2)))
- (values (1+ rx)
- (1+ (round (+ ry (* rh size))))
- (- rw 2)
- (- (round (* rh (- 1 size))) 2)))))))
+ (values (adj-border-xy (round (+ rx (* dx pos))) child)
+ (adj-border-xy ry child)
+ (adj-border-wh (round dx) child)
+ (adj-border-wh (round (* rh size)) child)))
+ (values (adj-border-xy rx child)
+ (adj-border-xy (round (+ ry (* rh size))) child)
+ (adj-border-wh rw child)
+ (adj-border-wh (round (* rh (- 1 size))) child)))))))
(defun set-main-window-top-layout ()
"Main window top: Main windows on the top. Others on the bottom."
@@ -630,14 +644,14 @@
(if (child-member child main-windows)
(let* ((dx (/ rw len))
(pos (child-position child main-windows)))
- (values (1+ (round (+ rx (* dx pos))))
- (1+ (round (+ ry (* rh (- 1 size)))))
- (- (round dx) 2)
- (- (round (* rh size)) 2)))
- (values (1+ rx)
- (1+ ry)
- (- rw 2)
- (- (round (* rh (- 1 size))) 2)))))))
+ (values (adj-border-xy (round (+ rx (* dx pos))) child)
+ (adj-border-xy (round (+ ry (* rh (- 1 size)))) child)
+ (adj-border-wh (round dx) child)
+ (adj-border-wh (round (* rh size)) child)))
+ (values (adj-border-xy rx child)
+ (adj-border-xy ry child)
+ (adj-border-wh rw child)
+ (adj-border-wh (round (* rh (- 1 size))) child)))))))
(defun set-main-window-bottom-layout ()
"Main window bottom: Main windows on the bottom. Others on the top."
Modified: clfswm/src/clfswm-placement.lisp
==============================================================================
--- clfswm/src/clfswm-placement.lisp (original)
+++ clfswm/src/clfswm-placement.lisp Wed Mar 9 17:16:51 2011
@@ -69,7 +69,7 @@
(defun top-right-placement (&optional (width 0) (height 0))
(declare (ignore height))
- (values (- (xlib:screen-width *screen*) width 1)
+ (values (- (xlib:screen-width *screen*) width (* *border-size* 2))
0))
@@ -84,22 +84,22 @@
(truncate (/ (- (xlib:screen-height *screen*) height) 2))))
(defun middle-right-placement (&optional (width 0) (height 0))
- (values (- (xlib:screen-width *screen*) width 1)
+ (values (- (xlib:screen-width *screen*) width (* *border-size* 2))
(truncate (/ (- (xlib:screen-height *screen*) height) 2))))
(defun bottom-left-placement (&optional (width 0) (height 0))
(declare (ignore width))
(values 0
- (- (xlib:screen-height *screen*) height 1)))
+ (- (xlib:screen-height *screen*) height (* *border-size* 2))))
(defun bottom-middle-placement (&optional (width 0) (height 0))
(values (truncate (/ (- (xlib:screen-width *screen*) width) 2))
- (- (xlib:screen-height *screen*) height 1)))
+ (- (xlib:screen-height *screen*) height (* *border-size* 2))))
(defun bottom-right-placement (&optional (width 0) (height 0))
- (values (- (xlib:screen-width *screen*) width 1)
- (- (xlib:screen-height *screen*) height 1)))
+ (values (- (xlib:screen-width *screen*) width (* *border-size* 2))
+ (- (xlib:screen-height *screen*) height (* *border-size* 2))))
;;;
Modified: clfswm/src/clfswm-query.lisp
==============================================================================
--- clfswm/src/clfswm-query.lisp (original)
+++ clfswm/src/clfswm-query.lisp Wed Mar 9 17:16:51 2011
@@ -139,7 +139,7 @@
:width width
:height height
:background (get-color *query-background*)
- :border-width 1
+ :border-width *border-size*
:border (get-color *query-border*)
:colormap (xlib:screen-default-colormap *screen*)
:event-mask '(:exposure :key-press))
Modified: clfswm/src/clfswm-second-mode.lisp
==============================================================================
--- clfswm/src/clfswm-second-mode.lisp (original)
+++ clfswm/src/clfswm-second-mode.lisp Wed Mar 9 17:16:51 2011
@@ -104,7 +104,7 @@
:x x :y y
:width *sm-width* :height *sm-height*
:background (get-color *sm-background-color*)
- :border-width 1
+ :border-width *border-size*
:border (get-color *sm-border-color*)
:colormap (xlib:screen-default-colormap *screen*)
:event-mask '(:exposure))
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Wed Mar 9 17:16:51 2011
@@ -106,8 +106,8 @@
(let ((name (query-string "Frame name"))
(x (/ (query-number "Frame x in percent (%)") 100))
(y (/ (query-number "Frame y in percent (%)") 100))
- (w (/ (query-number "Frame width in percent (%)") 100))
- (h (/ (query-number "Frame height in percent (%)") 100)))
+ (w (/ (query-number "Frame width in percent (%)" 100) 100))
+ (h (/ (query-number "Frame height in percent (%)" 100) 100)))
(push (create-frame :name name :x x :y y :w w :h h)
(frame-child *current-child*))))
(leave-second-mode))
@@ -293,10 +293,10 @@
(font (xlib:open-font *display* *identify-font-string*))
(window (xlib:create-window :parent *root*
:x 0 :y 0
- :width (- (xlib:screen-width *screen*) 2)
+ :width (- (xlib:screen-width *screen*) (* *border-size* 2))
:height (* 5 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font)))
:background (get-color *identify-background*)
- :border-width 1
+ :border-width *border-size*
:border (get-color *identify-border*)
:colormap (xlib:screen-default-colormap *screen*)
:event-mask '(:exposure)))
@@ -1527,7 +1527,7 @@
:width width
:height height
:background (get-color *notify-window-background*)
- :border-width 1
+ :border-width *border-size*
:border (get-color *notify-window-border*)
:colormap (xlib:screen-default-colormap *screen*)
:event-mask '(:exposure :key-press))
Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp (original)
+++ clfswm/src/config.lisp Wed Mar 9 17:16:51 2011
@@ -37,7 +37,6 @@
Example: :mod-2 for num_lock, :lock for Caps_lock...")
-
(defun-equal-wm-class equal-wm-class-rox-pinboard "ROX-Pinboard")
(defun-equal-wm-class equal-wm-class-xvkbd "xvkbd")
@@ -58,7 +57,9 @@
(defun get-fullscreen-size ()
"Return the size of root child (values rx ry rw rh)
You can tweak this to what you want"
- (values -2 -2 (+ (xlib:screen-width *screen*) 2) (+ (xlib:screen-height *screen*) 2)))
+ (values (- *border-size*) (- *border-size*)
+ (xlib:screen-width *screen*)
+ (xlib:screen-height *screen*)))
;;(values -1 -1 (xlib:screen-width *screen*) (xlib:screen-height *screen*)))
;; (values -1 -1 1024 768))
;; (values 100 100 800 600))
Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp (original)
+++ clfswm/src/package.lisp Wed Mar 9 17:16:51 2011
@@ -45,6 +45,12 @@
This variable may be useful to speed up some slow version of CLX.
It is particulary useful with CLISP/MIT-CLX.")
+
+(defconfig *border-size* 1 nil
+ "Windows and frames border size")
+
+
+
(defparameter *modifier-alias* '((:alt :mod-1) (:alt-l :mod-1)
(:numlock :mod-2)
(:super_l :mod-4)
More information about the clfswm-cvs
mailing list