└── config /config: -------------------------------------------------------------------------------- 1 | ;;; -*- mode: lisp; -*- 2 | (in-package :stumpwm) 3 | ;;; Setup Modules and Quicklisp 4 | ;; path to modules 5 | ;; git clone git@github.com:stumpwm/stumpwm-contrib.git ~/.config/stumpwm/modules 6 | (init-load-path #p"~/.config/stumpwm/modules/") 7 | (let ((quicklisp-init (merge-pathnames ".cache/quicklisp/setup.lisp" 8 | (user-homedir-pathname)))) 9 | (when (probe-file quicklisp-init) 10 | (load quicklisp-init))) 11 | 12 | ;; (setq *debug-level* 5) 13 | ;; (redirect-all-output (data-dir-file "debug-output" "txt")) 14 | 15 | ;;; Helpers 16 | (defun tr-define-key (key command) 17 | (define-key *top-map* (kbd (concat "s-" key )) command) 18 | (define-key *root-map* (kbd key) command)) 19 | 20 | (defun file-readable-p (file) 21 | "Return t, if FILE is available for reading." 22 | (handler-case 23 | (with-open-file (f file) 24 | (read-line f)) 25 | (stream-error () nil))) 26 | 27 | (defun executable-p (name) 28 | "Tell if given executable is present in PATH." 29 | (let ((which-out (string-trim '(#\ #\linefeed) 30 | (run-shell-command (concat "which " name) t)))) 31 | (unless (string-equal "" which-out) which-out))) 32 | 33 | (defun window-menu-format (w) 34 | (list (format-expand *window-formatters* *window-format* w) w)) 35 | 36 | (defun window-from-menu (windows) 37 | (when windows 38 | (second (select-from-menu 39 | (group-screen (window-group (car windows))) 40 | (mapcar 'window-menu-format windows) 41 | "Select Window: ")))) 42 | 43 | (defun windows-in-group (group) 44 | (group-windows (find group (the list (screen-groups (current-screen))) 45 | :key 'group-name :test 'equal))) 46 | 47 | (defun floatingp (window) 48 | "Return T if WINDOW is floating and NIL otherwise" 49 | (typep window 'stumpwm::float-window)) 50 | 51 | (defun always-on-top-off (window) () 52 | "Stop the given WINDOW from always being on top of other windows" 53 | (let ((ontop-wins (group-on-top-windows (current-group)))) 54 | (setf (group-on-top-windows (current-group)) 55 | (remove window ontop-wins)))) 56 | 57 | (defun always-on-top-on (window) () 58 | "Set the given WINDOW to always be on top of other windows" 59 | (let ((w window) 60 | (windows (the list (group-on-top-windows (current-group))))) 61 | (when w 62 | (unless (find w windows) 63 | (push window (group-on-top-windows (current-group))))))) 64 | 65 | (defmacro with-on-top (win &body body) 66 | "Make sure WIN is on the top level while the body is running and 67 | restore it's always-on-top state afterwords" 68 | (let ((cw (gensym)) 69 | (ontop (gensym))) 70 | `(let* ((,cw ,win) 71 | (,ontop (find ,cw (group-on-top-windows (current-group))))) 72 | (unwind-protect 73 | (progn (unless ,ontop (always-on-top-on ,cw)) 74 | ,@body)) 75 | (unless ,ontop (always-on-top-off ,cw))))) 76 | (defun slop-get-pos () 77 | (mapcar #'parse-integer (ppcre:split "[^0-9]" (run-shell-command 78 | "slop -f \"%x %y %w %h\"" t)))) 79 | 80 | (defun slop () 81 | "Slop the current window or just float if slop cli not present." 82 | (when (executable-p "slop") 83 | (let ((win (current-window)) 84 | (group (current-group)) 85 | (pos (slop-get-pos))) 86 | (stumpwm::float-window win group) 87 | (stumpwm::float-window-move-resize win 88 | :x (nth 0 pos) 89 | :y (nth 1 pos) 90 | :width (nth 2 pos) 91 | :height (nth 3 pos)) 92 | (always-on-top-on win)))) 93 | 94 | ;;; Moving the mouse for me 95 | ;; Used for warping the cursor 96 | (load-module "beckon") 97 | (defmacro with-focus-lost (&body body) 98 | "Make sure WIN is on the top level while the body is running and 99 | restore it's always-on-top state afterwords" 100 | `(progn (banish) 101 | ,@body 102 | (when (current-window) 103 | (beckon:beckon)))) 104 | 105 | (defcommand remove-lose-focus () () 106 | "Remove the window without feaking out because of :sloppy *mouse-focus-policy*" 107 | (with-focus-lost (remove-split))) 108 | 109 | (defcommand fullscreen-and-raise () () 110 | "Fullscreen window and make sure it's on top of all other windows" 111 | (with-on-top (stumpwm:current-window) (fullscreen))) 112 | 113 | ;;; Theme 114 | (setf *colors* 115 | '("#000000" ;black 116 | "#BF6262" ;red 117 | "#a1bf78" ;green 118 | "#dbb774" ;yellow 119 | "#7D8FA3" ;blue 120 | "#ff99ff" ;magenta 121 | "#53cdbd" ;cyan 122 | "#ffffff")) ;white 123 | 124 | (update-color-map (current-screen)) 125 | 126 | ;;; Font 127 | (ql:quickload :clx-truetype) 128 | 129 | ;; Make sure my local fonts are avaliable 130 | (pushnew (concat (getenv "HOME") 131 | "/.local/share/fonts/") 132 | xft:*font-dirs* :test #'string=) 133 | (xft:cache-fonts) 134 | 135 | (let ((parent-font "PragmataPro Liga")) 136 | (when (find parent-font (the list (clx-truetype:get-font-families)) 137 | :test #'string=) 138 | (load-module "ttf-fonts") 139 | (set-font `(,(make-instance 'xft:font 140 | :family "PragmataPro Liga" 141 | :subfamily "Regular" 142 | :size 11 143 | :antialias t))))) 144 | 145 | ;;; Basic Settings 146 | (setf *window-format* "%m%s%50t") 147 | (setf *mode-line-background-color* (car *colors*) 148 | *mode-line-foreground-color* (car (last *colors*)) 149 | *mode-line-timeout* 1) 150 | 151 | (setf *message-window-gravity* :center 152 | *window-border-style* :thin 153 | *message-window-padding* 3 154 | *maxsize-border-width* 2 155 | *normal-border-width* 2 156 | *transient-border-width* 2 157 | stumpwm::*float-window-border* 1 158 | stumpwm::*float-window-title-height* 1) 159 | 160 | ;; Focus Follow Mouse 161 | (setf *mouse-focus-policy* :sloppy) 162 | 163 | ;;; Completion 164 | ;; ;; Show all completions from start 165 | ;; (setf *input-completion-show-empty* nil) 166 | ;; ;; keep completions open even when one is selected 167 | ;; (setf *input-completion-style* (make-input-completion-style-unambiguous)) 168 | (setf *input-window-gravity* :center 169 | ;; TODO determin why this appears above 170 | *message-window-input-gravity* :left) 171 | 172 | (setf *input-completion-show-empty* t) 173 | 174 | ;; Remember commands and offers orderless completion 175 | ;; https://github.com/landakram/stumpwm-prescient 176 | (ql:quickload :stumpwm-prescient) 177 | (setf *input-refine-candidates-fn* 'stumpwm-prescient:refine-input) 178 | 179 | ;;; Startup Commands 180 | (run-shell-command "xsetroot -cursor_name left_ptr") 181 | 182 | ;;; Bindings 183 | (set-prefix-key (kbd "XF86Tools")) 184 | 185 | ;; General Top Level Bindings 186 | (define-key *top-map* (kbd "s-n") "pull-hidden-next") 187 | (define-key *top-map* (kbd "s-p") "pull-hidden-previous") 188 | ;; Tab like cycling 189 | (define-key *top-map* (kbd "s-C-n") "next-in-frame") 190 | (define-key *top-map* (kbd "s-C-p") "prev-in-frame") 191 | ;; Frame cycling 192 | (define-key *top-map* (kbd "s-TAB") "fnext") 193 | (define-key *top-map* (kbd "s-ISO_Left_Tab") "fprev") 194 | 195 | (setf *resize-increment* 25) 196 | (tr-define-key "f" "fullscreen") 197 | (tr-define-key "q" "only") 198 | (tr-define-key "=" "exec menu_connection_manager.sh") 199 | (tr-define-key "X" "exec power_menu.sh") 200 | (tr-define-key "P" "exec clipmenu") 201 | (tr-define-key "d" "exec dmenu_run") 202 | (tr-define-key "RET" "exec emacsclient -c -a 'emacs'") 203 | (tr-define-key "D" "exec discord") 204 | 205 | ;; Window Movement 206 | (dyn-blacklist-command "move-window") 207 | (dyn-blacklist-command "remove-lose-focus") 208 | (define-key *top-map* (kbd "s-H") "move-window left") 209 | (define-key *top-map* (kbd "s-J") "move-window down") 210 | (define-key *top-map* (kbd "s-K") "move-window up") 211 | (define-key *top-map* (kbd "s-L") "move-window right") 212 | 213 | ;;; Volume Stuff 214 | (let ((vdown "exec cm down 5") 215 | (vup "exec cm up 5") 216 | (m *top-map*)) 217 | (define-key m (kbd "s-C-a") vdown) 218 | (define-key m (kbd "XF86AudioLowerVolume") vdown) 219 | (define-key m (kbd "s-C-f") vup) 220 | (define-key m (kbd "XF86AudioRaiseVolume") vup)) 221 | 222 | ;;; Brightness 223 | (when *initializing* 224 | (defconstant backlightfile "/sys/class/backlight/intel_backlight/brightness")) 225 | 226 | (let ((bdown "exec xbacklight -dec 10") 227 | (bup "exec xbacklight -inc 10") 228 | (m *top-map*)) 229 | (define-key m (kbd "s-C-s") bdown) 230 | (define-key m (kbd "XF86MonBrightnessDown") bdown) 231 | (define-key m (kbd "s-C-d") bup) 232 | (define-key m (kbd "XF86MonBrightnessUp") bup)) 233 | 234 | ;;; General Root Level Bindings 235 | (defcommand term (&optional prg) () 236 | (run-shell-command (if prg 237 | (format nil "st -e ~A" prg) 238 | "st"))) 239 | (define-key *root-map* (kbd "c") "term") 240 | (define-key *root-map* (kbd "C-c") "term") 241 | (define-key *root-map* (kbd "y") "eval (term \"cm\")") 242 | (define-key *root-map* (kbd "w") "exec ducksearch") 243 | (define-key *root-map* (kbd "b") "pull-from-windowlist") 244 | (define-key *root-map* (kbd "R") "iresize") 245 | (define-key *root-map* (kbd "B") "beckon") 246 | (define-key *root-map* (kbd "r") "remove-lose-focus") 247 | (define-key *root-map* (kbd "f") "fullscreen-and-raise") 248 | (define-key *root-map* (kbd "Q") "quit-confirm") 249 | 250 | (define-key *root-map* (kbd "SPC") "exec cabl -c") 251 | ;; more usful alternatives to i and I 252 | (define-key *root-map* (kbd "i") "show-window-properties") 253 | (define-key *root-map* (kbd "I") "list-window-properties") 254 | 255 | ;;; Groups 256 | (grename "main") 257 | (gnewbg ".trash") ; hidden group 258 | (gnewbg "distractions") ; for discord and stuff 259 | (gnew-dynamic "dy") 260 | 261 | ;; Don't jump between groups when switching apps 262 | (setf *run-or-raise-all-groups* nil) 263 | (define-key *groups-map* (kbd "l") "change-default-layout") 264 | (define-key *groups-map* (kbd "d") "gnew-dynamic") 265 | (define-key *groups-map* (kbd "s") "gselect") 266 | 267 | (load-module "globalwindows") 268 | (define-key *groups-map* (kbd "b") "global-pull-windowlist") 269 | 270 | ;;;; Hide and Show Windows 271 | (defcommand pull-from-trash () () 272 | (let* ((windows (windows-in-group ".trash")) 273 | (window (window-from-menu windows))) 274 | (when window 275 | (move-window-to-group window (current-group)) 276 | (stumpwm::pull-window window)))) 277 | 278 | (defcommand move-to-trash () () 279 | (stumpwm:run-commands "gmove .trash")) 280 | 281 | (tr-define-key "]" "move-to-trash") 282 | (tr-define-key "[" "pull-from-trash") 283 | 284 | 285 | ;;; Floating Windows 286 | (defcommand toggle-slop-this () () 287 | (let ((win (current-window)) 288 | (group (current-group))) 289 | (cond 290 | ((floatingp win) 291 | (always-on-top-off win) 292 | (stumpwm::unfloat-window win group)) 293 | (t (slop))))) 294 | 295 | (tr-define-key "z" "toggle-slop-this") 296 | 297 | ;;; Splits 298 | (defcommand hsplit-and-focus () () 299 | "create a new frame on the right and focus it." 300 | (with-focus-lost 301 | (hsplit) 302 | (move-focus :right))) 303 | 304 | (defcommand vsplit-and-focus () () 305 | "create a new frame below and focus it." 306 | (with-focus-lost 307 | (vsplit) 308 | (move-focus :down))) 309 | (define-key *root-map* (kbd "v") "hsplit-and-focus") 310 | (define-key *root-map* (kbd "s") "vsplit-and-focus") 311 | 312 | ;; Extra mappings for dynamic windows 313 | (define-minor-mode my/tile-mode () () 314 | (:interactive t) 315 | (:scope :dynamic-group) 316 | (:top-map '(("s-v" . "exchange-with-master") 317 | ("s-=" . "change-default-split-ratio 1/2"))) 318 | (:lighter-make-clickable nil) 319 | (:lighter "MY/TILE")) 320 | ;; (my/tile-mode) 321 | (loop :for i :in '("hsplit-and-focus" 322 | "vsplit-and-focus") 323 | :do (dyn-blacklist-command i)) 324 | 325 | ;;; Mode-Line 326 | (load-module "battery-portable") 327 | 328 | ;;;; Get Fit 329 | (declaim (type fixnum *reps*)) 330 | (defvar *reps* 0 331 | "Variable for keeping track of reps") 332 | 333 | (defcommand add-reps (reps) ((:number "Enter reps: ")) 334 | (declare (type fixnum reps)) 335 | (when reps 336 | (setq *reps* (+ *reps* reps)))) 337 | 338 | (defcommand reset-reps () () 339 | (setq *reps* 0)) 340 | 341 | (defvar *gym-map* 342 | (let ((m (make-sparse-keymap))) 343 | (define-key m (kbd "a") "add-reps") 344 | (define-key m (kbd "r") "reset-reps") 345 | m)) 346 | (define-key *root-map* (kbd "ESC") '*gym-map*) 347 | 348 | ;;;; Actual Modeline 349 | (setf *time-modeline-string* "%a, %b %d %I:%M%p") 350 | (setf *screen-mode-line-format* 351 | (list 352 | ;; Groups 353 | " ^7[^B^4%n^7^b] " 354 | ;; Pad to right 355 | "^>" 356 | '(:eval (when (> *reps* 0) 357 | (format nil "^1^B(Reps ~A)^n " *reps*))) 358 | ;; Date 359 | "^7" 360 | "%d" 361 | ;; Battery 362 | " ^7[^n%B^7]^n ")) 363 | 364 | (defun enable-mode-line-everywhere () 365 | (loop for screen in *screen-list* do 366 | (loop for head in (screen-heads screen) do 367 | (enable-mode-line screen head t)))) 368 | (enable-mode-line-everywhere) 369 | ;; turn on/off the mode line for the current head only. 370 | (define-key *top-map* (kbd "s-B") "mode-line") 371 | 372 | ;;; Gaps 373 | (load-module "swm-gaps") 374 | (setf swm-gaps:*inner-gaps-size* 13 375 | swm-gaps:*outer-gaps-size* 7 376 | swm-gaps:*head-gaps-size* 0) 377 | (when *initializing* 378 | (swm-gaps:toggle-gaps)) 379 | (define-key *groups-map* (kbd "g") "toggle-gaps") 380 | 381 | ;;; Remaps 382 | (define-remapped-keys 383 | '(("(acme)" 384 | ("C-b" . "Left") 385 | ("C-n" . "Down") 386 | ("C-p" . "Up") 387 | ("C-d" . ("Right" "C-h"))) 388 | ("(discord|Element|Google-chrome)" 389 | ("C-a" . "Home") 390 | ("C-e" . "End") 391 | ("C-E" . "C-e") 392 | ("C-n" . "Down") 393 | ("C-p" . "Up") 394 | ("C-f" . "Right") 395 | ("C-b" . "Left") 396 | ("C-N" . "S-Down") 397 | ("C-P" . "S-Up") 398 | ("C-F" . "S-Right") 399 | ("C-B" . "S-Left") 400 | ("C-v" . "Next") 401 | ("M-v" . "Prior") 402 | ("M-w" . "C-c") 403 | ("C-w" . ("C-S-Left" "C-x")) 404 | ("C-y" . "C-v") 405 | ("M-<" . "Home") 406 | ("M->" . "End") 407 | ("C-M-b" . "M-Left") 408 | ("C-M-f" . "M-Right") 409 | ("M-f" . "C-Right") 410 | ("M-b" . "C-Left") 411 | ("C-s" . "C-f") 412 | ("C-j" . "C-k") 413 | ("C-/" . "C-z") 414 | ("C-k" . ("C-S-End" "C-x")) 415 | ("C-d" . "Delete") 416 | ("M-d" . "C-Delete")))) 417 | 418 | ;;; Undo And Redo Functionality 419 | (load-module "winner-mode") 420 | (define-key *root-map* (kbd "u") "winner-undo") 421 | (define-key *root-map* (kbd "C-r") "winner-redo") 422 | (add-hook *post-command-hook* (lambda (command) 423 | (when (member command winner-mode:*default-commands*) 424 | (winner-mode:dump-group-to-file)))) 425 | 426 | ;;; Emacs integration 427 | (defcommand emacs () () ; override default emacs command 428 | "Start emacs if emacsclient is not running and focus emacs if it is 429 | running in the current group" 430 | (run-or-raise "oemacsclient -c -a 'emacs'" '(:class "Emacs"))) 431 | ;; Treat emacs splits like Xorg windows 432 | (defun is-emacs-p (win) 433 | "nil if the WIN" 434 | (when win 435 | (string-equal (window-class win) "Emacs"))) 436 | 437 | (defmacro exec-el (expression) 438 | "execute emacs lisp do not collect it's output" 439 | `(eval-string-as-el (write-to-string ',expression))) 440 | 441 | (defun eval-string-as-el (elisp &optional collect-output-p) 442 | "evaluate a string as emacs lisp" 443 | (let ((result (run-shell-command 444 | (format nil "timeout --signal=9 1m emacsclient --eval \"~a\"" 445 | elisp) 446 | collect-output-p))) 447 | (handler-case (read-from-string result) 448 | ;; Pass back a string when we can't read from the string 449 | (error () result)))) 450 | 451 | (defmacro eval-el (expression) 452 | "evaluate emacs lisp and collect it's output" 453 | `(eval-string-as-el ,(write-to-string expression :case :downcase) t)) 454 | 455 | (declaim (ftype 456 | (function (string) (values string &optional)) 457 | emacs-winmove)) 458 | (defun emacs-winmove (direction) 459 | "executes the emacs function winmove-DIRECTION where DIRECTION is a string" 460 | (eval-string-as-el (concat "(windmove-" direction ")") t)) 461 | 462 | ;;; Set up for recording 463 | (defun setup-recording-environment (group-name) 464 | "Sets up a recording environment and returns a function to start the 465 | necessary programs for recording a new YouTube video" 466 | (let* ((obs-window (find-matching-windows 467 | (list :class "obs") 468 | t t)) 469 | (clip-browser-name "Recording-Clips") 470 | (clip-directory "~/Videos/clips/") 471 | (clip-browser-window (find-matching-windows 472 | (list :title clip-browser-name) 473 | t t))) 474 | ;; Create the recording group 475 | (define-frame-preference group-name 476 | (0 t t :class "obs") 477 | (0 t t :title "Recording-Clips")) 478 | (gnew group-name) 479 | 480 | ;; Setup obs 481 | (unless obs-window 482 | (run-shell-command "obs")) 483 | 484 | ;; Create a window for previewing and managing clips 485 | (unless clip-browser-window 486 | (run-shell-command 487 | (format nil 488 | "emacsclient -c -F '((name . \"~a\"))' -e '(dired \"~a\")'" 489 | clip-browser-name 490 | clip-directory)) 491 | ;; Set recording font 492 | (exec-el (fontaine-set-preset 'large))))) 493 | 494 | (defcommand recording () () 495 | (setup-recording-environment "recording")) 496 | 497 | 498 | ;;; Window focusing 499 | (defun switched-emacs-window (dir) 500 | (declare (type Keyword dir) 501 | (optimize (speed 3) (safety 1))) 502 | 503 | (if (is-emacs-p (current-window)) 504 | ;; There is not emacs window in that direction 505 | (not 506 | (length= 507 | (emacs-winmove (string-downcase (string dir))) 508 | 1)) 509 | nil)) 510 | 511 | (defun maybe-beckon () 512 | (if (current-window) 513 | (beckon:beckon) 514 | nil)) 515 | 516 | (defun better-move-focus (ogdir) 517 | "Similar to move-focus but also treats emacs windows as Xorg windows" 518 | (declare (type (member :up :down :left :right) ogdir) 519 | (optimize (speed 3) (safety 3))) 520 | 521 | (let ((cw (current-window))) 522 | (cond 523 | ((not cw) (progn (move-focus ogdir) 524 | (maybe-beckon))) 525 | ((switched-emacs-window ogdir)) 526 | ;; If fullscreen don't change focus 527 | ((stumpwm:window-fullscreen cw)) 528 | (t (progn (move-focus ogdir) 529 | (maybe-beckon)))))) 530 | 531 | 532 | (defcommand my-mv (dir) ((:direction "Enter direction: ")) 533 | (when dir (better-move-focus dir))) 534 | 535 | (define-key *top-map* (kbd "s-h") "my-mv left") 536 | (define-key *top-map* (kbd "s-j") "my-mv down") 537 | (define-key *top-map* (kbd "s-k") "my-mv up") 538 | (define-key *top-map* (kbd "s-l") "my-mv right") 539 | 540 | ;;; SLY setup 541 | (ql:quickload :slynk) 542 | (defvar *slynk-port* slynk::default-server-port) 543 | (defparameter *stumpwm-slynk-session* nil) 544 | 545 | (defcommand start-slynk (&optional (port *slynk-port*)) () 546 | (handler-case 547 | (defparameter *stumpwm-slynk-session* 548 | (slynk:create-server 549 | :dont-close t 550 | :port port)) 551 | (error (c) 552 | (format *error-output* "Error starting slynk: ~a~%" c) 553 | ))) 554 | 555 | (defcommand restart-slynk () () 556 | "Restart Slynk and reload source. 557 | This is needed if Sly updates while StumpWM is running" 558 | (stop-slynk) 559 | (start-slynk)) 560 | 561 | (defcommand stop-slynk () () 562 | "Restart Slynk and reload source. 563 | This is needed if Sly updates while StumpWM is running" 564 | (slynk:stop-server *slynk-port*)) 565 | 566 | (defcommand connect-to-sly () () 567 | (unless *stumpwm-slynk-session* 568 | (start-slynk)) 569 | (exec-el (sly-connect "localhost" *slynk-port*)) 570 | (emacs)) 571 | 572 | (define-stumpwm-type :dunstctl (input prompt) 573 | (completing-read (current-screen) prompt '("context" "action" "close" "history"))) 574 | 575 | (defcommand dunst () () 576 | (run-shell-command "dunstctl context")) 577 | --------------------------------------------------------------------------------