diff --git a/oni/home/config/rincewind.scm b/oni/home/config/rincewind.scm index e89708b..08a92e6 100644 --- a/oni/home/config/rincewind.scm +++ b/oni/home/config/rincewind.scm @@ -94,7 +94,9 @@ #:select (home-rofi-default-service)) #:use-module ((oni home services stumpwm) #:select (home-stumpwm-service-type - home-stumpwm-configuration)) + home-stumpwm-configuration + home-stumpwm-gaps-service-type + home-stumpwm-gaps-configuration)) #:use-module ((oni home services syncthing) #:select (home-syncthing-service-type)) #:use-module ((oni home services utilities) @@ -335,7 +337,13 @@ (service home-stumpwm-service-type (home-stumpwm-configuration - (package stumpwm+swank))) + (package stumpwm+swank) + (configurations + (list (local-file "../services/stumpwm/config"))))) + (service home-stumpwm-gaps-service-type + (home-stumpwm-gaps-configuration + (configurations + (list (local-file "../services/stumpwm/config-gaps"))))) (service home-inkplate-display-service-type) (service home-notmuch-service-type diff --git a/oni/home/services/stumpwm.scm b/oni/home/services/stumpwm.scm index 13e948e..66db596 100644 --- a/oni/home/services/stumpwm.scm +++ b/oni/home/services/stumpwm.scm @@ -1,7 +1,11 @@ (define-module (oni home services stumpwm) + #:use-module ((srfi srfi-1) #:select (every)) #:use-module ((gnu services configuration) #:select (serialize-package - define-configuration)) + define-configuration + define-configuration/no-serialization + text-config? + serialize-text-config)) #:use-module ((gnu packages lisp) #:select (sbcl)) #:use-module ((gnu packages wm) @@ -17,33 +21,52 @@ #:use-module ((guix gexp) #:select (local-file gexp - file-append)) + file-append + mixed-text-file)) #:use-module ((guix packages) #:select (package?)) #:export (home-stumpwm-service-type - home-stumpwm-configuration)) + home-stumpwm-configuration + home-stumpwm-extension + + home-stumpwm-gaps-service-type + home-stumpwm-gaps-configuration)) + +(define-configuration/no-serialization home-stumpwm-extension + (configurations + (text-config '()) + "The configuration for the extension.")) (define-configuration home-stumpwm-configuration (package (package stumpwm) "Package to use for setting Stumpwm") - (gaps-package - (package sbcl-stumpwm-swm-gaps) - "Package to use for setting Stumpwm Gaps") + (configurations + (text-config '()) + "The configuration to apply.") (stumpish-package (package stumpish) "Package to use for setting Stumpish")) (define (add-stumpwm-packages config) - (list sbcl - (home-stumpwm-configuration-package config) - (list stumpwm "lib") - (home-stumpwm-configuration-stumpish-package config) - (home-stumpwm-configuration-gaps-package config))) + (append (list sbcl + (home-stumpwm-configuration-package config) + (list stumpwm "lib") + (home-stumpwm-configuration-stumpish-package config)))) + +(define (home-stumpwm-extensions original-config extension-configs) + (home-stumpwm-configuration + (inherit original-config) + (configurations + (apply append (home-stumpwm-configuration-configurations original-config) + (map home-stumpwm-extension-configurations extension-configs))))) (define (home-stumpwm-config-files config) - `(("stumpwm/config" ,(local-file "stumpwm/config")))) + `(("stumpwm/config" + ,(mixed-text-file + "config" + (serialize-text-config config (home-stumpwm-configuration-configurations config)))))) (define (reload-stumpwm-config-gexp _) `(("files/.config/stumpwm/config" @@ -63,5 +86,35 @@ home-run-on-change-service-type reload-stumpwm-config-gexp))) (compose identity) + (extend home-stumpwm-extensions) (default-value (home-stumpwm-configuration)) (description "Install and configure stumpwm."))) + +(define-configuration/no-serialization home-stumpwm-gaps-configuration + (package + (package sbcl-stumpwm-swm-gaps) + "Package to use for setting stumpwm-gaps.") + (configurations + (text-config '()) + "Configuration for stumpwm gaps")) + +(define (add-stumpwm-gaps config) + (home-stumpwm-extension + (configurations (home-stumpwm-gaps-configuration-configurations config)))) + +(define (add-stumpwm-gaps-packages config) + (list (home-stumpwm-gaps-configuration-package config))) + +(define home-stumpwm-gaps-service-type + (service-type + (name 'home-stumpwm-gaps) + (extensions + (list (service-extension + home-stumpwm-service-type + add-stumpwm-gaps) + (service-extension + home-profile-service-type + add-stumpwm-gaps-packages))) + (compose identity) + (default-value (home-stumpwm-gaps-configuration)) + (description "Install and configure stumpwm-gaps."))) diff --git a/oni/home/services/stumpwm/config b/oni/home/services/stumpwm/config index fed4dd2..9350ee9 100644 --- a/oni/home/services/stumpwm/config +++ b/oni/home/services/stumpwm/config @@ -2,7 +2,6 @@ (in-package :stumpwm-user) (require 'swank) -(require 'swm-gaps) (set-prefix-key (kbd "s-x")) @@ -77,70 +76,6 @@ after it has been unlocked." "%d ")) (mode-line) -;;; Redefine this function again because for some reason on my system -;;; `(frame-width ...)' returns a ratio, not an integer, which is not accepted -;;; by `xlib:drawable-width'. -(defun stumpwm::maximize-window (win) - "Redefined gaps aware maximize function." - (multiple-value-bind (x y wx wy width height border stick) - (stumpwm::geometry-hints win) - - (let ((ox 0) (oy 0) (ow 0) (oh 0) - (frame (stumpwm::window-frame win))) - (if (swm-gaps::apply-gaps-p win) - (multiple-value-setq (ox oy ow oh) (swm-gaps::gaps-offsets win))) - - ;; Only do width or height subtraction if result will be positive, - ;; otherwise stumpwm will crash. Also, only modify window dimensions - ;; if needed (i.e. window at least fills frame minus gap). - (when (and (< ow width) - (>= width (- (frame-width frame) ow))) - (setf width (- width ow))) - (when (and (< oh height) - (>= height (- (frame-height frame) oh))) - (setf height (- height oh))) - - (setf x (+ x ox) - y (+ y oy)) - - ;; This is the only place a window's geometry should change - (set-window-geometry win :x wx :y wy :width width :height height :border-width 0) - (xlib:with-state ((window-parent win)) - ;; FIXME: updating the border doesn't need to be run everytime - ;; the window is maximized, but only when the border style or - ;; window type changes. The overhead is probably minimal, - ;; though. - (setf (xlib:drawable-x (window-parent win)) x - (xlib:drawable-y (window-parent win)) y - (xlib:drawable-border-width (window-parent win)) border) - ;; the parent window should stick to the size of the window - ;; unless it isn't being maximized to fill the frame. - (if (or stick - (find *window-border-style* '(:tight :none))) - (setf (xlib:drawable-width (window-parent win)) (window-width win) - (xlib:drawable-height (window-parent win)) (window-height win)) - (let ((frame (stumpwm::window-frame win))) - (setf (xlib:drawable-width (window-parent win)) (- (round (frame-width frame)) - (* 2 (xlib:drawable-border-width (window-parent win))) - ow) - (xlib:drawable-height (window-parent win)) (- (stumpwm::frame-display-height (window-group win) frame) - (* 2 (xlib:drawable-border-width (window-parent win))) - oh)))) - ;; update the "extents" - (xlib:change-property (window-xwin win) :_NET_FRAME_EXTENTS - (list wx - (- (xlib:drawable-width (window-parent win)) width wx) - wy - (- (xlib:drawable-height (window-parent win)) height wy)) - :cardinal 32)) - (update-configuration win)))) - -(setf swm-gaps:*head-gaps-size* 0) -(setf swm-gaps:*inner-gaps-size* 15) -(setf swm-gaps:*outer-gaps-size* 15) - -(swm-gaps:toggle-gaps-on) - ;;; Screenshots (defvar *screenshot-bindings* diff --git a/oni/home/services/stumpwm/config-gaps b/oni/home/services/stumpwm/config-gaps new file mode 100644 index 0000000..fa865d6 --- /dev/null +++ b/oni/home/services/stumpwm/config-gaps @@ -0,0 +1,68 @@ +;; -*- mode: lisp; -*- +(in-package :stumpwm-user) + +(require 'swm-gaps) + +;;; Redefine this function again because for some reason on my system +;;; `(frame-width ...)' returns a ratio, not an integer, which is not accepted +;;; by `xlib:drawable-width'. +(defun stumpwm::maximize-window (win) + "Redefined gaps aware maximize function." + (multiple-value-bind (x y wx wy width height border stick) + (stumpwm::geometry-hints win) + + (let ((ox 0) (oy 0) (ow 0) (oh 0) + (frame (stumpwm::window-frame win))) + (if (swm-gaps::apply-gaps-p win) + (multiple-value-setq (ox oy ow oh) (swm-gaps::gaps-offsets win))) + + ;; Only do width or height subtraction if result will be positive, + ;; otherwise stumpwm will crash. Also, only modify window dimensions + ;; if needed (i.e. window at least fills frame minus gap). + (when (and (< ow width) + (>= width (- (frame-width frame) ow))) + (setf width (- width ow))) + (when (and (< oh height) + (>= height (- (frame-height frame) oh))) + (setf height (- height oh))) + + (setf x (+ x ox) + y (+ y oy)) + + ;; This is the only place a window's geometry should change + (set-window-geometry win :x wx :y wy :width width :height height :border-width 0) + (xlib:with-state ((window-parent win)) + ;; FIXME: updating the border doesn't need to be run everytime + ;; the window is maximized, but only when the border style or + ;; window type changes. The overhead is probably minimal, + ;; though. + (setf (xlib:drawable-x (window-parent win)) x + (xlib:drawable-y (window-parent win)) y + (xlib:drawable-border-width (window-parent win)) border) + ;; the parent window should stick to the size of the window + ;; unless it isn't being maximized to fill the frame. + (if (or stick + (find *window-border-style* '(:tight :none))) + (setf (xlib:drawable-width (window-parent win)) (window-width win) + (xlib:drawable-height (window-parent win)) (window-height win)) + (let ((frame (stumpwm::window-frame win))) + (setf (xlib:drawable-width (window-parent win)) (- (round (frame-width frame)) + (* 2 (xlib:drawable-border-width (window-parent win))) + ow) + (xlib:drawable-height (window-parent win)) (- (stumpwm::frame-display-height (window-group win) frame) + (* 2 (xlib:drawable-border-width (window-parent win))) + oh)))) + ;; update the "extents" + (xlib:change-property (window-xwin win) :_NET_FRAME_EXTENTS + (list wx + (- (xlib:drawable-width (window-parent win)) width wx) + wy + (- (xlib:drawable-height (window-parent win)) height wy)) + :cardinal 32)) + (update-configuration win)))) + +(setf swm-gaps:*head-gaps-size* 0) +(setf swm-gaps:*inner-gaps-size* 15) +(setf swm-gaps:*outer-gaps-size* 15) + +(swm-gaps:toggle-gaps-on)