dotfiles/oni/home/services/stumpwm/config

;; -*- mode: lisp; -*-
(in-package :stumpwm-user)

(require 'swank)
(require 'swm-gaps)

(set-prefix-key (kbd "s-x"))

(defvar *screen-locking-hook* nil
  "Hook that gets called right before the screen gets locked.")

(defvar *screen-unlocked-hook* nil
  "Hook that gets called right after the screen is unlocked.")

(defun run-screen-unlocked-hook (process)
  "Run `*screen-unlocked-hook* if PROCESS' status is `:exited'."
  (when (eq (sb-ext:process-status process) :exited)
    (run-hook *screen-unlocked-hook*)))

(defun vpn-connected-p ()
  (probe-file "/sys/class/net/vpn"))

(defcommand lock-screen () ()
  "Lock the screen using i3lock.
Run `*screen-locking-hook*' before locking it and run `*screen-unlocked-hook*'
after it has been unlocked."
  (run-hook *screen-locking-hook*)
  (sb-ext:run-program
   *shell-program* '("-c" "i3lock --nofork --color=000000")
   :wait nil
   :status-hook #'run-screen-unlocked-hook))

(defcommand raise-browser () ()
  "Open or show my browser"
  (run-or-raise "firefox" '(:class "firefox")))

(defcommand raise-emacs () ()
  "Open or show Emacs"
  (run-or-raise "emacsclient -c" '(:class "Emacs")))

(defcommand raise-terminal () ()
  "Open or show my terminal"
  (run-or-raise "kitty" '(:class "kitty")))

(define-key *top-map* (kbd "C-M-l") "lock-screen")
(define-key *top-map* (kbd "s-b") "raise-browser")
(define-key *top-map* (kbd "s-e") "raise-emacs")
(define-key *top-map* (kbd "s-t") "raise-terminal")
(define-key *top-map* (kbd "s-!") "exec rofi -show drun")
(define-key *top-map* (kbd "s-w") "exec rofi -show window")

(define-remapped-keys
    '(("teams-for-linux"
       ("C-M-Break" . "C-S-m"))))

(set-bg-color "#222424")
(set-border-color "#3f4242")
(set-fg-color "#bfbfbf")
(set-float-focus-color "#5b6161")
(set-float-unfocus-color "#3f4242")
(set-focus-color "#ff9800")
(set-unfocus-color "#3f4242")

(setf *mode-line-background-color* "#5b6161"
      *mode-line-foreground-color* "#bfbfbf")
(setf *screen-mode-line-format*
      (list " [^B%n^b] "
            "^[^(:bg \"#f17272\")^(:fg \"#222424\") "
            '(:eval
              (or (ignore-errors (window-title (current-window)))
               "Unknown"))
            " ^]^>"
            '(:eval
              (if (vpn-connected-p)
                  "^*5^B[VPN]^b^n "
                  ""))
            "%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*
  (let ((m (make-sparse-keymap)))
    (define-key m (kbd "s") "exec flameshot gui")
    (define-key m (kbd "c") "exec flameshot screen")
    (define-key m (kbd "f") "exec flameshot full")
    m))

(defvar *user-bindings*
  (let ((m (make-sparse-keymap)))
    (define-key m (kbd "s") '*screenshot-bindings*)))

(define-key *top-map* (kbd "s-c") '*user-bindings*)

(restore-from-file "default")

(define-frame-preference "Default"
  (0 t nil :class "kitty")
  (1 t nil :class "Emacs")
  (3 t nil :class "firefox"))

(define-frame-preference "teams"
  (0 t t :class "teams-for-linux" :create t))

(swank:create-server :dont-close t)