[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch test updated. R-1106-51-g97e0c35
Philippe Brochard
pbrochard at common-lisp.net
Tue May 22 19:49:50 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 97e0c3565f478114d3d59634dae227859df7d209 (commit)
via 7cb5d87eaf9bf65d816dc7b3a543bc7dcbc94aad (commit)
from c974943e1b30bd2a931354bbc16491464b19d3a5 (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 97e0c3565f478114d3d59634dae227859df7d209
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Tue May 22 21:49:42 2012 +0200
src/clfswm-internal.lisp (place-frames-from-xinerama-infos): Reset root list before calculating new sizes
diff --git a/contrib/toolbar.lisp b/contrib/toolbar.lisp
index 02129a4..0fe87ac 100644
--- a/contrib/toolbar.lisp
+++ b/contrib/toolbar.lisp
@@ -32,6 +32,10 @@
(format t "Loading Toolbar code... ")
+(defstruct toolbar root-x root-y direction size thickness placement autohide modules font window gc)
+
+(defparameter *toolbar-list* nil)
+
;;; CONFIG - Toolbar window string colors
(defconfig *toolbar-window-font-string* *default-font-string*
'Toolbar-Window "Toolbar window font string")
@@ -39,102 +43,114 @@
'Toolbar-Window "Toolbar Window background color")
(defconfig *toolbar-window-foreground* "green"
'Toolbar-Window "Toolbar Window foreground color")
-(defconfig *toolbar-window-border* "red"
+(defconfig *toolbar-window-border* "grey70"
'Toolbar-Window "Toolbar Window border color")
-(defconfig *toolbar-window-delay* 10
- 'Toolbar-Window "Toolbar Window display delay")
(defconfig *toolbar-window-transparency* *default-transparency*
'Toolbar-window "Toolbar window background transparency")
+(defconfig *toolbar-default-thickness* 10
+ 'toolbar-window "Toolbar default thickness")
(defconfig *toolbar-window-placement* 'top-left-placement
'Placement "Toolbar window placement")
-(let (font
- window
- gc
- width height
- text
- current-child)
- (labels ((text-string (tx)
- (typecase tx
- (cons (first tx))
- (t tx)))
- (text-color (tx)
- (get-color (typecase tx
- (cons (second tx))
- (t *toolbar-window-foreground*)))))
- (defun is-toolbar-window-p (win)
- (when (and (xlib:window-p win) (xlib:window-p window))
- (xlib:window-equal win window)))
-
- (defun refresh-toolbar-window ()
- (add-timer 0.1 #'refresh-toolbar-window :refresh-toolbar-window)
- (raise-window window)
- (let ((text-height (- (xlib:font-ascent font) (xlib:font-descent font))))
- (loop for tx in text
- for i from 1 do
- (setf (xlib:gcontext-foreground gc) (text-color tx))
- (xlib:draw-glyphs window gc
- (truncate (/ (- width (* (xlib:max-char-width font) (length (text-string tx)))) 2))
- (* text-height i 2)
- (text-string tx)))))
-
-;; (defun close-toolbar-window ()
-;; (erase-timer :refresh-toolbar-window)
-;; (setf *never-managed-window-list*
-;; (remove (list #'is-toolbar-window-p 'raise-window)
-;; *never-managed-window-list* :test #'equal))
-;; (when gc
-;; (xlib:free-gcontext gc))
-;; (when window
-;; (xlib:destroy-window window))
-;; (when font
-;; (xlib:close-font font))
-;; (xlib:display-finish-output *display*)
-;; (setf window nil
-;; gc nil
-;; font nil))
-
- (defun open-toolbar-window (text-list)
-;; (close-toolbar-window)
- (setf font (xlib:open-font *display* *toolbar-window-font-string*))
- (let ((text-height (- (xlib:font-ascent font) (xlib:font-descent font))))
- (setf text text-list)
- (setf width (* (xlib:max-char-width font) (+ (loop for tx in text-list
- maximize (length (text-string tx))) 2))
- height (+ (* text-height (length text-list) 2) text-height))
- (with-placement (*toolbar-window-placement* x y width height)
- (setf window (xlib:create-window :parent *root*
- :x x
- :y y
- :width width
- :height height
- :background (get-color *toolbar-window-background*)
- :border-width *border-size*
- :border (get-color *toolbar-window-border*)
- :colormap (xlib:screen-default-colormap *screen*)
- :event-mask '(:exposure :key-press))
- gc (xlib:create-gcontext :drawable window
- :foreground (get-color *toolbar-window-foreground*)
- :background (get-color *toolbar-window-background*)
- :font font
- :line-style :solid))
- (setf (window-transparency window) *toolbar-window-transparency*)
- (when (frame-p (current-child))
- (setf current-child (current-child)))
- (push (list #'is-toolbar-window-p 'raise-window) *never-managed-window-list*)
- (map-window window)
- (refresh-toolbar-window)
- (xlib:display-finish-output *display*))))))
-
-
-(defun open-toolbar ()
- "Open the toolbar mode"
- (open-toolbar-window '("toto plop")))
-
-
-(add-hook *init-hook* 'open-toolbar)
+(let ((windows-list nil))
+ (defun is-toolbar-window-p (win)
+ (and (xlib:window-p win) (member win windows-list :test 'xlib:window-equal)))
+
+ ;; (defun refresh-toolbar-window ()
+ ;; (add-timer 0.1 #'refresh-toolbar-window :refresh-toolbar-window)
+ ;; (raise-window window)
+ ;; (let ((text-height (- (xlib:font-ascent font) (xlib:font-descent font))))
+ ;; (loop for tx in text
+ ;; for i from 1 do
+ ;; (setf (xlib:gcontext-foreground gc) (text-color tx))
+ ;; (xlib:draw-glyphs window gc
+ ;; (truncate (/ (- width (* (xlib:max-char-width font) (length (text-string tx)))) 2))
+ ;; (* text-height i 2)
+ ;; (text-string tx)))))
+ ;;
+ ;; (defun close-toolbar-window ()
+ ;; (erase-timer :refresh-toolbar-window)
+ ;; (setf *never-managed-window-list*
+ ;; (remove (list #'is-toolbar-window-p 'raise-window)
+ ;; *never-managed-window-list* :test #'equal))
+ ;; (when gc
+ ;; (xlib:free-gcontext gc))
+ ;; (when window
+ ;; (xlib:destroy-window window))
+ ;; (when font
+ ;; (xlib:close-font font))
+ ;; (xlib:display-finish-output *display*)
+ ;; (setf window nil
+ ;; gc nil
+ ;; font nil))
+
+ (defun open-toolbar (toolbar)
+ (dbg toolbar)
+ (let ((root (find-root-by-coordinates (toolbar-root-x toolbar) (toolbar-root-y toolbar))))
+ (when (root-p root)
+ (let ((*get-current-root-fun* (lambda () root)))
+ (setf (toolbar-font toolbar) (xlib:open-font *display* *toolbar-window-font-string*))
+ (let* ((width (if (equal (toolbar-direction toolbar) :horiz)
+ (round (/ (* (root-w root) (toolbar-size toolbar)) 100))
+ (toolbar-thickness toolbar)))
+ (height (if (equal (toolbar-direction toolbar) :horiz)
+ (toolbar-thickness toolbar)
+ (round (/ (* (root-h root) (toolbar-size toolbar)) 100)))))
+ (dbg width height)
+ (with-placement ((toolbar-placement toolbar) x y width height)
+ (dbg x y width height)
+ (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 *border-size*
+ :border (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)
+ :foreground (get-color *toolbar-window-foreground*)
+ :background (get-color *toolbar-window-background*)
+ :font (toolbar-font toolbar)
+ :line-style :solid))
+ (push (toolbar-window toolbar) windows-list)
+ (setf (window-transparency (toolbar-window toolbar)) *toolbar-window-transparency*)
+ (push (list #'is-toolbar-window-p 'raise-window) *never-managed-window-list*)
+ (map-window (toolbar-window toolbar))
+ (raise-window (toolbar-window toolbar))
+ ;;(refresh-toolbar-window)
+ (xlib:display-finish-output *display*))))))))
+
+
+;;(defun open-toolbar (toolbar)
+;; ;;(open-toolbar-window '("toto plop")))
+;; (dbg toolbar)
+;; )
+
+(defun open-all-toolbars ()
+ "Open all toolbars"
+ (dolist (toolbar *toolbar-list*)
+ (open-toolbar toolbar)))
+
+(defun add-toolbar (root-x root-y direction size placement autohide &rest modules)
+ "Add a new toolbar.
+ root-x, root-y: root coordinates
+ direction: one of :horiz or :vert
+ size: toolbar size in percent of root size"
+ (let ((toolbar (make-toolbar :root-x root-x :root-y root-y
+ :direction direction :size size
+ :thickness *toolbar-default-thickness*
+ :placement placement
+ :autohide autohide
+ :modules modules)))
+ (push toolbar *toolbar-list*)
+ toolbar))
+
+
+(add-hook *init-hook* 'open-all-toolbars)
(format t "done~%")
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 93b3067..b03faf7 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -595,6 +595,10 @@
;;; Multiple roots support (replace the old *current-root* variable)
(let ((root-list nil)
(current-child nil))
+ (defun reset-root-list ()
+ (setf root-list nil
+ current-child nil))
+
(defun define-as-root (child x y width height)
(push (make-root :child child :original child :current-child nil :x x :y y :w width :h height) root-list))
@@ -758,6 +762,7 @@ XINERAMA version 1.1 opcode: 150
(let ((sizes (get-connected-heads-size))
(width (xlib:screen-width *screen*))
(height (xlib:screen-height *screen*)))
+ (reset-root-list)
;;(add-placed-frame-tmp (first (frame-child *root-frame*)) 2)
(if (<= (length sizes) 1)
(define-as-root *root-frame* (- *border-size*) (- *border-size*) width height)
diff --git a/src/clfswm-placement.lisp b/src/clfswm-placement.lisp
index 611cf0b..dacf006 100644
--- a/src/clfswm-placement.lisp
+++ b/src/clfswm-placement.lisp
@@ -205,8 +205,11 @@
;;;
;;; Current root placement
;;;
+(defparameter *get-current-root-fun* (lambda ()
+ (find-root (current-child))))
+
(defun current-root-coord ()
- (let ((root (find-root (current-child))))
+ (let ((root (funcall *get-current-root-fun*)))
(values (root-x root) (root-y root)
(root-w root) (root-h root))))
commit 7cb5d87eaf9bf65d816dc7b3a543bc7dcbc94aad
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Sun May 20 14:32:40 2012 +0200
Adding a toolbar file
diff --git a/contrib/toolbar.lisp b/contrib/toolbar.lisp
new file mode 100644
index 0000000..02129a4
--- /dev/null
+++ b/contrib/toolbar.lisp
@@ -0,0 +1,140 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Toolbar
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2011 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; Documentation: If you want to use this file, just add this line in
+;;; your configuration file:
+;;;
+;;; (load-contrib "toolbar.lisp")
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+(format t "Loading Toolbar code... ")
+
+;;; CONFIG - Toolbar window string colors
+(defconfig *toolbar-window-font-string* *default-font-string*
+ 'Toolbar-Window "Toolbar window font string")
+(defconfig *toolbar-window-background* "black"
+ 'Toolbar-Window "Toolbar Window background color")
+(defconfig *toolbar-window-foreground* "green"
+ 'Toolbar-Window "Toolbar Window foreground color")
+(defconfig *toolbar-window-border* "red"
+ 'Toolbar-Window "Toolbar Window border color")
+(defconfig *toolbar-window-delay* 10
+ 'Toolbar-Window "Toolbar Window display delay")
+(defconfig *toolbar-window-transparency* *default-transparency*
+ 'Toolbar-window "Toolbar window background transparency")
+
+(defconfig *toolbar-window-placement* 'top-left-placement
+ 'Placement "Toolbar window placement")
+
+
+(let (font
+ window
+ gc
+ width height
+ text
+ current-child)
+ (labels ((text-string (tx)
+ (typecase tx
+ (cons (first tx))
+ (t tx)))
+ (text-color (tx)
+ (get-color (typecase tx
+ (cons (second tx))
+ (t *toolbar-window-foreground*)))))
+ (defun is-toolbar-window-p (win)
+ (when (and (xlib:window-p win) (xlib:window-p window))
+ (xlib:window-equal win window)))
+
+ (defun refresh-toolbar-window ()
+ (add-timer 0.1 #'refresh-toolbar-window :refresh-toolbar-window)
+ (raise-window window)
+ (let ((text-height (- (xlib:font-ascent font) (xlib:font-descent font))))
+ (loop for tx in text
+ for i from 1 do
+ (setf (xlib:gcontext-foreground gc) (text-color tx))
+ (xlib:draw-glyphs window gc
+ (truncate (/ (- width (* (xlib:max-char-width font) (length (text-string tx)))) 2))
+ (* text-height i 2)
+ (text-string tx)))))
+
+;; (defun close-toolbar-window ()
+;; (erase-timer :refresh-toolbar-window)
+;; (setf *never-managed-window-list*
+;; (remove (list #'is-toolbar-window-p 'raise-window)
+;; *never-managed-window-list* :test #'equal))
+;; (when gc
+;; (xlib:free-gcontext gc))
+;; (when window
+;; (xlib:destroy-window window))
+;; (when font
+;; (xlib:close-font font))
+;; (xlib:display-finish-output *display*)
+;; (setf window nil
+;; gc nil
+;; font nil))
+
+ (defun open-toolbar-window (text-list)
+;; (close-toolbar-window)
+ (setf font (xlib:open-font *display* *toolbar-window-font-string*))
+ (let ((text-height (- (xlib:font-ascent font) (xlib:font-descent font))))
+ (setf text text-list)
+ (setf width (* (xlib:max-char-width font) (+ (loop for tx in text-list
+ maximize (length (text-string tx))) 2))
+ height (+ (* text-height (length text-list) 2) text-height))
+ (with-placement (*toolbar-window-placement* x y width height)
+ (setf window (xlib:create-window :parent *root*
+ :x x
+ :y y
+ :width width
+ :height height
+ :background (get-color *toolbar-window-background*)
+ :border-width *border-size*
+ :border (get-color *toolbar-window-border*)
+ :colormap (xlib:screen-default-colormap *screen*)
+ :event-mask '(:exposure :key-press))
+ gc (xlib:create-gcontext :drawable window
+ :foreground (get-color *toolbar-window-foreground*)
+ :background (get-color *toolbar-window-background*)
+ :font font
+ :line-style :solid))
+ (setf (window-transparency window) *toolbar-window-transparency*)
+ (when (frame-p (current-child))
+ (setf current-child (current-child)))
+ (push (list #'is-toolbar-window-p 'raise-window) *never-managed-window-list*)
+ (map-window window)
+ (refresh-toolbar-window)
+ (xlib:display-finish-output *display*))))))
+
+
+(defun open-toolbar ()
+ "Open the toolbar mode"
+ (open-toolbar-window '("toto plop")))
+
+
+(add-hook *init-hook* 'open-toolbar)
+
+
+(format t "done~%")
-----------------------------------------------------------------------
Summary of changes:
contrib/toolbar.lisp | 156 +++++++++++++++++++++++++++++++++++++++++++++
src/clfswm-internal.lisp | 5 ++
src/clfswm-placement.lisp | 5 +-
3 files changed, 165 insertions(+), 1 deletions(-)
create mode 100644 contrib/toolbar.lisp
hooks/post-receive
--
CLFSWM - A(nother) Common Lisp FullScreen Window Manager
More information about the clfswm-cvs
mailing list