Hackers,
I have created a mode-line group switching widget which shows open
groups as a set of tabs or cubes on the mode-line and also allows one
to switch groups by clicking. It integrates well with the mode-line,
and starts drawing next to the mode-line string as soon as the
mode-line is toggled. It is also possible to render only numbers
instead of names (much like in Awesome) by setting the global
*cube-display-number* variable to true.
Please find the patch attached, I've thoroughly revised and tested the
code, optimizing it and reusing existing code as much as possible, and
at the same time keeping changes to the core of stumpwm a minimum.
I've also made sure that the patch applies cleanly to stumpwm's git
repo without any warnings, and that it builds without any problem.
It would be great to have this made a part of stumpwm. I am open to
any feedback and am excited about people using it.
Thanks!
Joel
diff --git a/Makefile.in b/Makefile.in
index eab7a9f..6db0e63 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -23,8 +23,8 @@ keytrans.lisp kmap.lisp input.lisp core.lisp command.lisp menu.lisp \
screen.lisp group.lisp window.lisp floating-group.lisp \
tile-window.lisp window-placement.lisp message-window.lisp \
selection.lisp user.lisp iresize.lisp bindings.lisp events.lisp \
-help.lisp fdump.lisp mode-line.lisp time.lisp color.lisp module.lisp \
-stumpwm.lisp version.lisp
+help.lisp fdump.lisp mode-line.lisp mode-line-cubes.lisp time.lisp \
+color.lisp module.lisp stumpwm.lisp version.lisp
all: stumpwm stumpwm.info
diff --git a/events.lisp b/events.lisp
index 6f36c5b..57c5199 100644
--- a/events.lisp
+++ b/events.lisp
@@ -589,12 +589,14 @@ the window in it's frame."
(define-stump-event-handler :button-press (window code x y child time)
;; Pass click to client
(xlib:allow-events *display* :replay-pointer time)
- (let (screen ml win)
+ (let (screen ml win cube)
(cond
((and (setf screen (find-screen window)) (not child))
(group-button-press (screen-current-group screen) x y :root))
((setf ml (find-mode-line-window window))
(run-hook-with-args *mode-line-click-hook* ml code x y))
+ ((setf cube (find-cube-window window))
+ (cube-clicked cube))
((setf win (find-window-by-parent window (top-windows)))
(group-button-press (window-group win) x y win)))))
diff --git a/group.lisp b/group.lisp
index 26f1a4b..f66527c 100644
--- a/group.lisp
+++ b/group.lisp
@@ -444,8 +444,8 @@ to the next group."
The windows will be moved to group \"^B^2*~a^n\"
^B^6*Confirm?^n " (group-name dead-group) (group-name to-group))))
(progn
- (switch-to-group to-group)
(kill-group dead-group to-group)
+ (switch-to-group to-group)
(message "Deleted"))
(message "Canceled")))))
diff --git a/mode-line-cubes.lisp b/mode-line-cubes.lisp
new file mode 100644
index 0000000..c873dd3
--- /dev/null
+++ b/mode-line-cubes.lisp
@@ -0,0 +1,200 @@
+;;; Modeline cubes - A group switcher widget for the mode-line
+
+(in-package :stumpwm)
+(export '(create-cube create-cubes destroy-cubes find-cube-window cube-clicked))
+
+(defparameter *cubes* '())
+
+;; Show Group numbers or Group formatted names?
+(defparameter *cube-display-number* nil)
+
+;; border
+(defparameter *cube-border-width* 1)
+(defparameter *cube-border-color* "Black")
+;; colors
+(defparameter *cube-background* "Gray")
+(defparameter *cube-background-toggled* "Orange")
+(defparameter *cube-foreground* "Black")
+(defparameter *cube-foreground-toggled* "Black")
+
+(defstruct cube
+ state
+ number
+ group
+ window
+ gcontext-normal
+ gcontext-toggled)
+
+(defun create-cube (ml group &optional (x 0))
+ "Create cube numer num at position x on mode-line ml"
+ (let* ((screen (mode-line-screen ml))
+ (font (screen-font screen))
+ (parent (mode-line-window ml))
+ (win (xlib:create-window
+ :parent parent
+ :x x
+ :y 0
+ :width (* (xlib:char-width (screen-font screen) 0) 2)
+ :height (mode-line-height ml)
+ :border (alloc-color screen *cube-border-color*)
+ :border-width *cube-border-width*
+ :event-mask (xlib:make-event-mask :exposure :button-press)))
+ (fg (alloc-color screen *cube-foreground*))
+ (bg (alloc-color screen *cube-background*))
+ (fg-toggled (alloc-color screen *cube-foreground-toggled*))
+ (bg-toggled (alloc-color screen *cube-background-toggled*))
+ (gcontext-normal (xlib:create-gcontext :drawable win
+ :font font
+ :foreground fg
+ :background bg))
+ (gcontext-toggled (xlib:create-gcontext :drawable win
+ :font font
+ :foreground fg-toggled
+ :background bg-toggled))
+ (cube (make-cube :state :normal
+ :number (group-number group)
+ :group group
+ :window win
+ ; :mode-line ml
+ :gcontext-normal gcontext-normal
+ :gcontext-toggled gcontext-toggled)))
+ (setf (xlib:window-plist win) (list 'cube cube))
+ cube))
+
+(defun toggle-cube (cube)
+ (cond ((eq (cube-state cube) :normal)
+ (setf (cube-state cube) :toggled))
+ ((eq (cube-state cube) :toggled)
+ (setf (cube-state cube) :normal))))
+
+(defun add-cube-group (ml group)
+ (setf (mode-line-cubes ml)
+ (sort (append (mode-line-cubes ml) (list (create-cube ml group)))
+ #'< :key 'cube-number)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; cube events ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; click
+(defun cube-clicked (cube)
+ (let ((new-group (find (cube-number cube) (screen-groups (current-screen)) :key 'group-number)))
+ (and new-group (switch-to-group new-group))))
+
+;; exposure
+(defun draw-cube (cube)
+ (let* ((win (cube-window cube))
+ (gc (or (and (eq (cube-state cube) :toggled) (cube-gcontext-toggled cube))
+ (cube-gcontext-normal cube)))
+ (font (xlib:gcontext-font gc))
+ ;(xlib:char-width font 0))
+ (string (cube-string cube))
+ (char-width (xlib:char-width font 0))
+ (text-width (xlib:text-width font string))
+ (window-width (+ text-width
+ char-width)))
+ ;; change window width if different
+ (unless (eq (xlib:drawable-width win) window-width)
+ (setf (xlib:drawable-width win) window-width))
+ ;; sync window background with gc background
+ (setf (xlib:window-background win) (xlib:gcontext-background gc))
+ (xlib:map-window win)
+ ;; draw text
+ (xlib:clear-area win)
+ (xlib:draw-image-glyphs win gc (round (/ char-width 2)) ;; char-width / 2 draws at center
+ (xlib:font-ascent font)
+ string
+ :translate #'translate-id
+ :size 16)
+ (xlib:display-finish-output *display*)))
+
+(defun cube-string (cube)
+ (if *cube-display-number*
+ (write-to-string (group-number (cube-group cube)))
+ (format-expand *group-formatters* *group-format* (cube-group cube))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; cube management ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun destroy-cubes (ml)
+ (setf (mode-line-cubes ml) (remove-if (lambda (cube)
+ (xlib:destroy-window (cube-window cube)) t)
+ (mode-line-cubes ml)))
+ (xlib:display-finish-output *display*))
+
+(defun find-cube-window (win)
+ (second (xlib:window-plist win)))
+
+(defun find-cube-number (ml num)
+ (find-if (lambda (cube)
+ (eq (cube-number cube) num))
+ (mode-line-cubes ml)))
+
+;; Delete a cube window and remove it from *cubes*
+;; Apply key on each cube and delete if = arg
+(defun delete-cube (ml arg key)
+ (setf (mode-line-cubes ml) (remove-if (lambda (cube)
+ (if (eq (funcall (symbol-function key) cube) arg)
+ (progn (xlib:destroy-window (cube-window cube)) t)))
+ (mode-line-cubes ml)))
+ ;; (unless (zerop (length (mode-line-cubes ml))) (rearrange-cubes ml))
+ (xlib:display-finish-output *display*))
+
+(defun rearrange-cubes (ml &optional (x 0))
+ (and
+ (mode-line-cubes ml)
+ (progn (setf (xlib:drawable-x (cube-window (first (mode-line-cubes ml))))
+ x)
+ (reduce (lambda (cube1 cube2)
+ (let* ((cube1-win (cube-window cube1))
+ (cube1-width (xlib:drawable-width cube1-win))
+ (cube2-x (+ (xlib:drawable-x cube1-win) cube1-width)))
+ (setf (xlib:drawable-x (cube-window cube2)) cube2-x))
+ cube2)
+ (mode-line-cubes ml))
+ (redraw-cubes ml)
+ (xlib:display-finish-output *display*))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Stumpwm environment ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun group-mode-lines (group)
+ (mapcar (lambda (head) (head-mode-line head))
+ (screen-heads (group-screen group))))
+
+(defun group-exists-p (group)
+ (and (find group (screen-groups (group-screen group))) t))
+
+(defun create-mode-line-cubes (ml)
+ (destroy-cubes ml)
+ (dolist (w (sort-groups (group-screen (mode-line-current-group ml))))
+ (add-cube-group ml w)))
+
+;; redraw cube windows
+(defun redraw-cubes (ml)
+ (mapcar (lambda (cube)
+ (setf (cube-state cube)
+ (if (eq (cube-number cube) (group-number (current-group)))
+ :toggled
+ :normal))
+ (draw-cube cube))
+ (mode-line-cubes ml)))
+
+(defun cube-switch (new old)
+ (let ((old-group-exists (group-exists-p old)))
+ (mapcar (lambda (ml)
+ ;; FIXME: cache group number
+ (if (not (find-cube-number ml (group-number new)))
+ (add-cube-group ml new)
+ (redraw-cubes ml))
+ (if (not old-group-exists)
+ (delete-cube ml old 'cube-group)))
+ (group-mode-lines new))))
+
+(defun add-cube-switch-hook ()
+ ;; Group Switch hook
+ ;; To be moved to switch-to-group in group.lisp or update-mode-line
+ (add-hook *focus-group-hook* (lambda (new old) (cube-switch new old))))
+
diff --git a/mode-line.lisp b/mode-line.lisp
index d6a30ee..f0a40a5 100644
--- a/mode-line.lisp
+++ b/mode-line.lisp
@@ -45,6 +45,7 @@
cc
height
factor
+ cubes
(mode :stump))
(defun mode-line-gc (ml)
@@ -373,13 +374,15 @@ critical."
(when (eq (mode-line-mode ml) :stump)
(let* ((*current-mode-line-formatters* *screen-mode-line-formatters*)
(*current-mode-line-formatter-args* (list ml))
- (string (mode-line-format-string ml)))
+ (string (mode-line-format-string ml))
+ width)
(when (or force (not (string= (mode-line-contents ml) string)))
(setf (mode-line-contents ml) string)
(resize-mode-line ml)
- (render-strings (mode-line-screen ml) (mode-line-cc ml)
- *mode-line-pad-x* *mode-line-pad-y*
- (split-string string (string #\Newline)) '())))))
+ (setf width (render-strings (mode-line-screen ml) (mode-line-cc ml)
+ *mode-line-pad-x* *mode-line-pad-y*
+ (split-string string (string #\Newline)) '()))
+ (rearrange-cubes ml (+ width 10))))))
(defun find-mode-line-window (xwin)
(dolist (s *screen-list*)
@@ -502,6 +505,8 @@ critical."
(update-mode-line-color-context (head-mode-line head))
(resize-mode-line (head-mode-line head))
(xlib:map-window (mode-line-window (head-mode-line head)))
+ (add-cube-switch-hook)
+ (create-mode-line-cubes (head-mode-line head))
(redraw-mode-line (head-mode-line head))
(dformat 3 "modeline: ~s~%" (head-mode-line head))
;; setup the timer
diff --git a/stumpwm.asd b/stumpwm.asd
index a1c095a..709f4ba 100644
--- a/stumpwm.asd
+++ b/stumpwm.asd
@@ -48,6 +48,7 @@
(:file "fdump")
(:file "time")
(:file "mode-line")
+ (:file "mode-line-cubes")
(:file "color")
(:file "module")
(:file "stumpwm")
_______________________________________________
Stumpwm-devel mailing list
Stumpwm-devel@nongnu.org
http://lists.nongnu.org/mailman/listinfo/stumpwm-devel
