dotfiles/config/stumpwm/config.lisp

567 lines
23 KiB
Common Lisp

(in-package :stumpwm)
(set-prefix-key (kbd "C-t"))
;; prompt the user for an interactive command. The first arg is an
;; optional initial contents.
(defcommand colon1 (&optional (initial "")) (:rest)
(let ((cmd (read-one-line (current-screen) ": " :initial-input initial)))
(when cmd
(eval-command cmd t))))
;; Read some doc
(define-key *root-map* (kbd "d") "exec gv")
;; Browse somewhere
(define-key *root-map* (kbd "b") "colon1 exec firefox http://www.")
;; Ssh somewhere
(define-key *root-map* (kbd "C-s") "colon1 exec xterm -e ssh ")
;; Lock screen
(define-key *root-map* (kbd "C-l") "exec xlock")
;; Web jump (works for DuckDuckGo and Imdb)
(defmacro make-web-jump (name prefix)
`(defcommand ,(intern name) (search) ((:rest ,(concatenate 'string name " search: ")))
(nsubstitute #\+ #\Space search)
(run-shell-command (concatenate 'string ,prefix search))))
;;; Appearance
(set-fg-color "#d8dee9")
(set-bg-color "#1b2b34")
(set-border-color "#6699cc")
(setf *normal-border-width* 2)
(setf *window-border-style* :thin)
(setf *ignore-wm-inc-hints* t)
(set-font "-b&h-luxi mono-medium-r-normal--20-*-*-*-m-0-iso10646-1")
(setf *message-window-padding* 16)
(setf *message-window-margin* 20)
(setf *message-window-y-margin* 20)
(setf *message-window-gravity* :center)
(setf *input-window-gravity* :center)
;;; Modules
(set-module-dir "~/.stumpwm.d/modules/util")
(load-module "swm-gaps")
(setf swm-gaps:*inner-gaps-size* 8)
(setf swm-gaps:*outer-gaps-size* 16)
;;; Frame behaviour
;; Prevent new frames from sucking windows from other frames on creation
(setf *new-frame-action* :empty)
(setf *suppress-frame-indicator* t)
;;; Groups — must be set up before define-frame-preference so names match
(grename "1")
(run-commands "gnewbg 2" "gnewbg 3" "gnewbg 4")
;;; Window placement policy
;; "Default" is the initial group name before grename runs at the bottom.
;; These float rules must use "Default" — StumpWM evaluates frame preferences
;; at window-open time against the group name, and the first group starts as
;; "Default" until grename changes it at startup (but the rule is registered
;; at load time when the name is still being matched by content, not snapshot).
;; In practice (:float t t) with target-group matching works correctly here.
(define-frame-preference nil
(:float t nil :class "alsamixer-scratch")
(:float t nil :class "ncmpcpp-scratch"))
(define-frame-preference "scratch-emacs-1"
(0 t t :title "scratch-emacs-1"))
(define-frame-preference "scratch-emacs-2"
(0 t t :title "scratch-emacs-2"))
(define-frame-preference "Emacs"
(1 t t :restore "emacs-editing-dump" :title "...xdvi")
(0 t t :create "emacs-dump" :class "Emacs"))
;;; Commands
(defcommand kill-window-or-frame () ()
"Kill the current window, or remove the frame if empty."
(if (current-window)
(delete-window)
(remove-split)))
(defcommand toggle-fullscreen () ()
"Toggle fullscreen for the current window."
(fullscreen))
(defcommand focus-left () ()
"Focus the frame to the left."
(move-focus :left))
(defcommand focus-right () ()
"Focus the frame to the right."
(move-focus :right))
(defcommand focus-up () ()
"Focus the frame above."
(move-focus :up))
(defcommand focus-down () ()
"Focus the frame below."
(move-focus :down))
(defcommand split-horizontal () ()
"Split the current frame horizontally."
(split-frame-in-dir :column))
(defcommand split-vertical () ()
"Split the current frame vertically."
(split-frame-in-dir :row))
(defcommand cycle-next () ()
"Cycle to the next window in the current frame."
(next-in-frame))
(defcommand cycle-prev () ()
"Cycle to the previous window in the current frame."
(prev-in-frame))
(defcommand rofi-run () ()
"Open rofi run launcher."
(run-shell-command "rofi -show run"))
(defcommand rofi-pull-window () ()
"Pull a window from the group into the current frame using rofi."
(let* ((windows (remove (current-window) (group-windows (current-group))))
(names (format nil "~{~a~%~}" (mapcar #'window-name windows)))
(selection (run-prog-collect-output
"/bin/sh" "-c"
(format nil "echo '~a' | rofi -i -dmenu -p 'window'" names))))
(when (and selection (not (string= selection "")))
(let ((win (find (string-trim '(#\Newline) selection)
windows :key #'window-name :test #'string=)))
(when win (pull-window win))))))
(defcommand gaps-off () ()
"Disable gaps."
(swm-gaps:toggle-gaps-off))
(defcommand gaps-small () ()
"Set small gaps."
(setf swm-gaps:*inner-gaps-size* 8
swm-gaps:*outer-gaps-size* 8)
(swm-gaps:toggle-gaps-on))
(defcommand gaps-medium () ()
"Set medium gaps."
(setf swm-gaps:*inner-gaps-size* 16
swm-gaps:*outer-gaps-size* 16)
(swm-gaps:toggle-gaps-on))
(defcommand gaps-large () ()
"Set large gaps."
(setf swm-gaps:*inner-gaps-size* 32
swm-gaps:*outer-gaps-size* 32)
(swm-gaps:toggle-gaps-on))
(defcommand mpv-pick () ()
"Pick a video from ~/Videos and play it in mpv."
(run-shell-command "mpv-pick.sh"))
(defcommand mpv-url () ()
"Play the URL in the clipboard with mpv."
(run-shell-command "mpv-url.sh"))
(defcommand yt-download () ()
"Download the URL in the clipboard to a chosen subdirectory of ~/Videos with yt-dlp."
(let* ((url (run-prog-collect-output "/usr/bin/xclip" "-o" "-selection" "clipboard"))
(url (string-trim '(#\Newline) url)))
(if (string= url "")
(message "Clipboard is empty!")
(let* ((dir (run-prog-collect-output
"/bin/sh" "-c"
"{ echo '.'; find $HOME/Videos -maxdepth 1 -mindepth 1 -type d -exec basename {} \\; | sort; } | rofi -i -dmenu -p 'download to'" ))
(dir (string-trim '(#\Newline) dir)))
(when (not (string= dir ""))
(let ((dest (format nil "~a/Videos/~a" (getenv "HOME") dir)))
(run-shell-command (format nil "cd ~s && yt-dlp ~s" dest url))
(message "Downloading to ~a..." dest)))))))
;;; Brightness commands
(defcommand brightness-10 () ()
"Set brightness to 10%."
(run-shell-command "brightnessctl set 10%"))
(defcommand brightness-20 () ()
"Set brightness to 20%."
(run-shell-command "brightnessctl set 20%"))
(defcommand brightness-30 () ()
"Set brightness to 30%."
(run-shell-command "brightnessctl set 30%"))
(defcommand brightness-40 () ()
"Set brightness to 40%."
(run-shell-command "brightnessctl set 40%"))
(defcommand brightness-50 () ()
"Set brightness to 50%."
(run-shell-command "brightnessctl set 50%"))
(defcommand brightness-60 () ()
"Set brightness to 60%."
(run-shell-command "brightnessctl set 60%"))
(defcommand brightness-70 () ()
"Set brightness to 70%."
(run-shell-command "brightnessctl set 70%"))
(defcommand brightness-80 () ()
"Set brightness to 80%."
(run-shell-command "brightnessctl set 80%"))
(defcommand brightness-90 () ()
"Set brightness to 90%."
(run-shell-command "brightnessctl set 90%"))
(defcommand brightness-100 () ()
"Set brightness to 100%."
(run-shell-command "brightnessctl set 100%"))
;;; Float terminal scratchpad system
;;
;; StumpWM's define-frame-preference supports :float as the frame number, which
;; causes the window to be floated *during* group-add-window, before tiling
;; logic runs. This is the only reliable way to float a window from config —
;; attempting to call float-window from *new-window-hook* is too late, as
;; StumpWM has already tiled it. The hook IS still useful for positioning
;; after the float is established.
;;
;; float-window and float-window-move-resize are internal (stumpwm::), not
;; exported from the stumpwm package.
;;
;; To add a new float terminal:
;; 1. Add (:float t t :class "my-class") to the "Default" define-frame-preference
;; 2. Call (register-float-term "my-class" "command" x y width height)
;; Pass :persistent t if the window should hide on s-q instead of closing
;; 3. Define a command that calls (spawn-or-focus "my-class" "command")
(defvar *float-term-rules* '())
(defun register-float-term (class command x y width height &key persistent)
"Register a floating terminal. Add a matching define-frame-preference rule too.
If PERSISTENT is t, smart-kill will hide the window instead of killing it."
(setf *float-term-rules*
(cons (list class command x y width height :persistent persistent)
(remove class *float-term-rules* :key #'car :test #'string=))))
(add-hook *new-window-hook*
(lambda (win)
(let ((rule (assoc (window-class win) *float-term-rules* :test #'string=)))
(when rule
(let ((x (nth 2 rule))
(y (nth 3 rule))
(width (nth 4 rule))
(height (nth 5 rule)))
(stumpwm::float-window-move-resize win :x x :y y :width width :height height))))))
;; StumpWM keeps non-focused windows within the same frame mapped (stacked
;; behind the current one) rather than unmapping them like most tiling WMs.
;; This causes other windows to bleed through when transparency is used.
;; This hook hides all frame siblings when focus changes so only the
;; focused window and the wallpaper are visible through any transparency.
;; Named function (not lambda) so loadrc replaces it instead of accumulating copies.
(defun hide-unfocused-frame-siblings (new old)
(declare (ignore old))
(when (and new (typep new 'stumpwm::tile-window))
(let* ((group (window-group new))
(frame (window-frame new))
(siblings (remove new (frame-windows group frame))))
(mapc #'hide-window siblings)
(unhide-window new))))
(remove-hook *focus-window-hook* 'hide-unfocused-frame-siblings)
(add-hook *focus-window-hook* 'hide-unfocused-frame-siblings)
(defun float-window-to-current-group (win)
"Move a float window to the current group by directly manipulating group membership,
bypassing group-add-window (which would retrigger frame preferences and group switches)."
(let ((current (current-group))
(old (window-group win)))
(unless (eq old current)
(setf (group-windows old) (remove win (group-windows old)))
(setf (window-group win) current)
(push win (group-windows current)))))
(defun spawn-or-focus (class command)
"Unhide or focus existing window with CLASS, or spawn COMMAND if none exists.
Float windows are moved to the current group directly to avoid group switches."
(let ((win (find-if (lambda (w) (string= (window-class w) class))
(screen-windows (current-screen)))))
(cond ((null win) (run-shell-command command))
((eq win (current-window)) nil)
(t
(when (typep win 'stumpwm::float-window)
(float-window-to-current-group win))
(focus-window win)))))
(defcommand smart-kill () ()
"Kill window normally, unless it's a persistent float — then hide it instead."
(let* ((win (current-window))
(class (when win (window-class win)))
(rule (when class (assoc class *float-term-rules* :test #'string=))))
(if (and rule (getf (nthcdr 6 rule) :persistent))
(hide-window win)
(kill-window-or-frame))))
;; Registrations — add new float terminals here
(register-float-term "alsamixer-scratch"
"wezterm start --class alsamixer-scratch -- alsamixer"
628 450 800 400)
(defcommand alsamixer-float () ()
"Open alsamixer in a floating wezterm window."
(spawn-or-focus "alsamixer-scratch" "wezterm start --class alsamixer-scratch -- alsamixer"))
(register-float-term "ncmpcpp-scratch"
"wezterm start --class ncmpcpp-scratch -- ncmpcpp"
628 300 900 500 :persistent t)
(defcommand ncmpcpp-float () ()
"Open ncmpcpp in a persistent floating wezterm window."
(spawn-or-focus "ncmpcpp-scratch" "wezterm start --class ncmpcpp-scratch -- ncmpcpp" :persistent t))
;;; Keymaps
;;
;; All named keymaps are defined here. Add a keymap to *hint-keymaps* to make
;; it auto-display its bindings in the top-left corner when its prefix key is
;; pressed, instead of requiring '?'. Remove from the list to disable hints.
(defvar *config-map* (make-sparse-keymap))
(defvar *brightness-map* (make-sparse-keymap))
(defvar *gaps-map* (make-sparse-keymap))
(defvar *window-map* (make-sparse-keymap))
(defvar *media-map* (make-sparse-keymap))
(defvar *appearance-map* (make-sparse-keymap))
(defvar *appearance-all-map* (make-sparse-keymap))
;; Global opacity — stored so new windows can inherit it via *new-window-hook*
(defvar *global-opacity* nil)
;; Per-window opacity via picom-trans -c (current focused window)
(defmacro make-opacity-command (name opacity)
`(defcommand ,name () ()
,(format nil "Set current window opacity to ~a%." opacity)
(run-shell-command (format nil "picom-trans -c ~a" ,opacity))))
;; Global opacity — sets all existing windows and stores value for new ones
(defmacro make-global-opacity-command (name opacity)
`(defcommand ,name () ()
,(format nil "Set ALL windows opacity to ~a%." opacity)
(setf *global-opacity* ,opacity)
(dolist (w (screen-windows (current-screen)))
(run-shell-command
(format nil "picom-trans -w ~a ~a"
(xlib:window-id (window-xwin w)) ,opacity)))))
;; Apply global opacity to new windows as they appear
(add-hook *new-window-hook*
(lambda (win)
(when *global-opacity*
(run-shell-command
(format nil "picom-trans -w ~a ~a"
(xlib:window-id (window-xwin win)) *global-opacity*)))))
(make-opacity-command opacity-10 10)
(make-opacity-command opacity-20 20)
(make-opacity-command opacity-30 30)
(make-opacity-command opacity-40 40)
(make-opacity-command opacity-50 50)
(make-opacity-command opacity-60 60)
(make-opacity-command opacity-70 70)
(make-opacity-command opacity-80 80)
(make-opacity-command opacity-90 90)
(make-opacity-command opacity-100 100)
(make-global-opacity-command global-opacity-10 10)
(make-global-opacity-command global-opacity-20 20)
(make-global-opacity-command global-opacity-30 30)
(make-global-opacity-command global-opacity-40 40)
(make-global-opacity-command global-opacity-50 50)
(make-global-opacity-command global-opacity-60 60)
(make-global-opacity-command global-opacity-70 70)
(make-global-opacity-command global-opacity-80 80)
(make-global-opacity-command global-opacity-90 90)
(make-global-opacity-command global-opacity-100 100)
(define-key *appearance-map* (kbd "1") "opacity-10")
(define-key *appearance-map* (kbd "2") "opacity-20")
(define-key *appearance-map* (kbd "3") "opacity-30")
(define-key *appearance-map* (kbd "4") "opacity-40")
(define-key *appearance-map* (kbd "5") "opacity-50")
(define-key *appearance-map* (kbd "6") "opacity-60")
(define-key *appearance-map* (kbd "7") "opacity-70")
(define-key *appearance-map* (kbd "8") "opacity-80")
(define-key *appearance-map* (kbd "9") "opacity-90")
(define-key *appearance-map* (kbd "0") "opacity-100")
(define-key *appearance-all-map* (kbd "1") "global-opacity-10")
(define-key *appearance-all-map* (kbd "2") "global-opacity-20")
(define-key *appearance-all-map* (kbd "3") "global-opacity-30")
(define-key *appearance-all-map* (kbd "4") "global-opacity-40")
(define-key *appearance-all-map* (kbd "5") "global-opacity-50")
(define-key *appearance-all-map* (kbd "6") "global-opacity-60")
(define-key *appearance-all-map* (kbd "7") "global-opacity-70")
(define-key *appearance-all-map* (kbd "8") "global-opacity-80")
(define-key *appearance-all-map* (kbd "9") "global-opacity-90")
(define-key *appearance-all-map* (kbd "0") "global-opacity-100")
(defvar *brightness-map* (make-sparse-keymap))
(defvar *gaps-map* (make-sparse-keymap))
(defvar *window-map* (make-sparse-keymap))
(defvar *media-map* (make-sparse-keymap))
;; Keymaps that automatically show their bindings when activated.
;; Add or remove keymaps here to control which ones show hints.
(defvar *hint-keymaps*
(list *config-map*
*window-map*
*media-map*
*brightness-map*
*gaps-map*
*appearance-map*
*appearance-all-map*))
;; Show bindings in top-left for any keymap in *hint-keymaps*.
(add-hook *key-press-hook*
(lambda (key key-seq cmd)
(declare (ignore key cmd))
(let* ((oriented (reverse key-seq))
(maps (get-kmaps-at-key-seq (dereference-kmaps (top-maps)) oriented)))
(when-let ((hint-maps (remove-if-not
(lambda (m) (member m *hint-keymaps*))
maps)))
(let ((*message-window-gravity* :top-left))
(apply #'display-bindings-for-keymaps oriented hint-maps))))))
;;; Config map bindings
(define-key *config-map* (kbd "a") "alsamixer-float")
(define-key *config-map* (kbd "b") *brightness-map*)
;;; Brightness map bindings
(define-key *brightness-map* (kbd "1") "brightness-10")
(define-key *brightness-map* (kbd "2") "brightness-20")
(define-key *brightness-map* (kbd "3") "brightness-30")
(define-key *brightness-map* (kbd "4") "brightness-40")
(define-key *brightness-map* (kbd "5") "brightness-50")
(define-key *brightness-map* (kbd "6") "brightness-60")
(define-key *brightness-map* (kbd "7") "brightness-70")
(define-key *brightness-map* (kbd "8") "brightness-80")
(define-key *brightness-map* (kbd "9") "brightness-90")
(define-key *brightness-map* (kbd "0") "brightness-100")
;;; Gaps map bindings
(define-key *gaps-map* (kbd "0") "gaps-off")
(define-key *gaps-map* (kbd "1") "gaps-small")
(define-key *gaps-map* (kbd "2") "gaps-medium")
(define-key *gaps-map* (kbd "3") "gaps-large")
;;; Window map bindings
(define-key *window-map* (kbd "r") "iresize")
(define-key *window-map* (kbd "g") *gaps-map*)
(define-key *window-map* (kbd "t") *appearance-map*)
(define-key *window-map* (kbd "T") *appearance-all-map*)
;;; Media map bindings
(define-key *media-map* (kbd "v") "mpv-pick")
(define-key *media-map* (kbd "m") "mpv-url")
(define-key *media-map* (kbd "d") "yt-download")
(define-key *media-map* (kbd "p") "ncmpcpp-float")
;;; Top-level bindings
(define-key *top-map* (kbd "s-d") "rofi-run")
(define-key *top-map* (kbd "s-w") "rofi-pull-window")
(defun emacs-window-p (win)
(and win (string= (window-class win) "Emacs")))
(defcommand smart-move-focus (direction) ((:direction "Direction: "))
"If the focused window is Emacs and it has a window in DIRECTION, move
focus there via windmove. Otherwise move focus to the next StumpWM frame."
(if (and (emacs-window-p (current-window))
(search "t" (run-shell-command
(format nil "emacsclient -e '(if (ignore-errors (windmove-~(~a~) nil) t) t nil)'" direction)
t)))
nil
(move-focus direction)))
(define-key *top-map* (kbd "s-h") "smart-move-focus left")
(define-key *top-map* (kbd "s-j") "smart-move-focus down")
(define-key *top-map* (kbd "s-k") "smart-move-focus up")
(define-key *top-map* (kbd "s-l") "smart-move-focus right")
(define-key *top-map* (kbd "s-p") "next-in-frame")
(define-key *top-map* (kbd "s-n") "prev-in-frame")
(define-key *top-map* (kbd "s-q") "smart-kill")
(define-key *top-map* (kbd "s-F") "select-floating-window")
(define-key *top-map* (kbd "s-f") "toggle-fullscreen")
(define-key *top-map* (kbd "s-c") *config-map*)
(define-key *top-map* (kbd "s--") "vsplit")
(define-key *top-map* (kbd "s-\\") "hsplit")
(define-key *top-map* (kbd "s-W") *window-map*)
(define-key *top-map* (kbd "s-m") *media-map*)
;;; Group switching
(define-key *top-map* (kbd "s-1") "gselect 1")
(define-key *top-map* (kbd "s-2") "gselect 2")
(define-key *top-map* (kbd "s-3") "gselect 3")
(define-key *top-map* (kbd "s-4") "gselect 4")
;;; Fullscreen scratchpad groups
;;
;; Each scratchpad lives in its own hidden group. Pressing the binding
;; switches to it (spawning the window on first visit). Pressing again
;; returns to wherever you came from. We track the previous group ourselves
;; rather than relying on gother, which is unreliable when windows spawn async.
(defun toggle-scratchpad-group (group-name command &key window-class window-title)
(let* ((screen (current-screen))
(current (current-group))
(target (find-group screen group-name))
;; Once a scratchpad window has been created, it stays resident in
;; its own dedicated group even after we switch away from it. So the
;; most reliable "does it already exist" check is simply: does the
;; target group already have a window in it? This avoids relying on
;; window title, which for programs like Emacs changes constantly
;; based on the current buffer and would otherwise cause a fresh
;; instance to be spawned every time.
(existing (or (first (group-windows target))
(when window-class
(find-if (lambda (w) (string= (window-class w) window-class))
(screen-windows screen)))
(when window-title
(find-if (lambda (w) (string= (window-name w) window-title))
(screen-windows screen))))))
(if (eq current target)
(when *scratchpad-previous-group*
(switch-to-group *scratchpad-previous-group*))
(progn
(setf *scratchpad-previous-group* current)
(when (and existing (not (eq (window-group existing) target)))
(move-window-to-group existing target))
(switch-to-group target)
(unless existing
(run-shell-command command))))))
(run-commands "gnewbg scratch-term-1"
"gnewbg scratch-term-2"
"gnewbg scratch-emacs-1"
"gnewbg scratch-emacs-2")
(defcommand scratch-term-1 () ()
"Toggle fullscreen persistent terminal (wezterm)."
(toggle-scratchpad-group "scratch-term-1"
"wezterm start --class scratch-term-1"
:window-class "scratch-term-1"))
(defcommand scratch-term-2 () ()
"Toggle second fullscreen persistent terminal (wezterm)."
(toggle-scratchpad-group "scratch-term-2"
"wezterm start --class scratch-term-2"
:window-class "scratch-term-2"))
(defcommand scratch-emacs-1 () ()
"Toggle fullscreen persistent emacsclient frame."
(toggle-scratchpad-group "scratch-emacs-1"
"emacsclient -c --frame-parameters '((name . \"scratch-emacs-1\"))'"
:window-title "scratch-emacs-1"))
(defcommand scratch-emacs-2 () ()
"Toggle second fullscreen persistent emacsclient frame (leetcode)."
(toggle-scratchpad-group "scratch-emacs-2"
"emacsclient -c --frame-parameters '((name . \"scratch-emacs-2\"))'"
:window-title "scratch-emacs-2"))
(define-key *top-map* (kbd "C-Return") "scratch-term-1")
(define-key *top-map* (kbd "C-\\") "scratch-term-2")
(define-key *top-map* (kbd "s-e") "scratch-emacs-1")
(define-key *top-map* (kbd "s-L") "scratch-emacs-2")