mirror of
https://github.com/Gavinok/stump-conf.git
synced 2026-09-10 07:26:30 -04:00
577 lines
18 KiB
Common Lisp
577 lines
18 KiB
Common Lisp
;;; -*- mode: lisp; -*-
|
|
(in-package :stumpwm)
|
|
;;; Setup Modules and Quicklisp
|
|
;; path to modules
|
|
;; git clone git@github.com:stumpwm/stumpwm-contrib.git ~/.config/stumpwm/modules
|
|
(init-load-path #p"~/.config/stumpwm/modules/")
|
|
(let ((quicklisp-init (merge-pathnames ".cache/quicklisp/setup.lisp"
|
|
(user-homedir-pathname))))
|
|
(when (probe-file quicklisp-init)
|
|
(load quicklisp-init)))
|
|
|
|
;; (setq *debug-level* 5)
|
|
;; (redirect-all-output (data-dir-file "debug-output" "txt"))
|
|
|
|
;;; Helpers
|
|
(defun tr-define-key (key command)
|
|
(define-key *top-map* (kbd (concat "s-" key )) command)
|
|
(define-key *root-map* (kbd key) command))
|
|
|
|
(defun file-readable-p (file)
|
|
"Return t, if FILE is available for reading."
|
|
(handler-case
|
|
(with-open-file (f file)
|
|
(read-line f))
|
|
(stream-error () nil)))
|
|
|
|
(defun executable-p (name)
|
|
"Tell if given executable is present in PATH."
|
|
(let ((which-out (string-trim '(#\ #\linefeed)
|
|
(run-shell-command (concat "which " name) t))))
|
|
(unless (string-equal "" which-out) which-out)))
|
|
|
|
(defun window-menu-format (w)
|
|
(list (format-expand *window-formatters* *window-format* w) w))
|
|
|
|
(defun window-from-menu (windows)
|
|
(when windows
|
|
(second (select-from-menu
|
|
(group-screen (window-group (car windows)))
|
|
(mapcar 'window-menu-format windows)
|
|
"Select Window: "))))
|
|
|
|
(defun windows-in-group (group)
|
|
(group-windows (find group (the list (screen-groups (current-screen)))
|
|
:key 'group-name :test 'equal)))
|
|
|
|
(defun floatingp (window)
|
|
"Return T if WINDOW is floating and NIL otherwise"
|
|
(typep window 'stumpwm::float-window))
|
|
|
|
(defun always-on-top-off (window) ()
|
|
"Stop the given WINDOW from always being on top of other windows"
|
|
(let ((ontop-wins (group-on-top-windows (current-group))))
|
|
(setf (group-on-top-windows (current-group))
|
|
(remove window ontop-wins))))
|
|
|
|
(defun always-on-top-on (window) ()
|
|
"Set the given WINDOW to always be on top of other windows"
|
|
(let ((w window)
|
|
(windows (the list (group-on-top-windows (current-group)))))
|
|
(when w
|
|
(unless (find w windows)
|
|
(push window (group-on-top-windows (current-group)))))))
|
|
|
|
(defmacro with-on-top (win &body body)
|
|
"Make sure WIN is on the top level while the body is running and
|
|
restore it's always-on-top state afterwords"
|
|
(let ((cw (gensym))
|
|
(ontop (gensym)))
|
|
`(let* ((,cw ,win)
|
|
(,ontop (find ,cw (group-on-top-windows (current-group)))))
|
|
(unwind-protect
|
|
(progn (unless ,ontop (always-on-top-on ,cw))
|
|
,@body))
|
|
(unless ,ontop (always-on-top-off ,cw)))))
|
|
(defun slop-get-pos ()
|
|
(mapcar #'parse-integer (ppcre:split "[^0-9]" (run-shell-command
|
|
"slop -f \"%x %y %w %h\"" t))))
|
|
|
|
(defun slop ()
|
|
"Slop the current window or just float if slop cli not present."
|
|
(when (executable-p "slop")
|
|
(let ((win (current-window))
|
|
(group (current-group))
|
|
(pos (slop-get-pos)))
|
|
(stumpwm::float-window win group)
|
|
(stumpwm::float-window-move-resize win
|
|
:x (nth 0 pos)
|
|
:y (nth 1 pos)
|
|
:width (nth 2 pos)
|
|
:height (nth 3 pos))
|
|
(always-on-top-on win))))
|
|
|
|
;;; Moving the mouse for me
|
|
;; Used for warping the cursor
|
|
(load-module "beckon")
|
|
(defmacro with-focus-lost (&body body)
|
|
"Make sure WIN is on the top level while the body is running and
|
|
restore it's always-on-top state afterwords"
|
|
`(progn (banish)
|
|
,@body
|
|
(when (current-window)
|
|
(beckon:beckon))))
|
|
|
|
(defcommand remove-lose-focus () ()
|
|
"Remove the window without feaking out because of :sloppy *mouse-focus-policy*"
|
|
(with-focus-lost (remove-split)))
|
|
|
|
(defcommand fullscreen-and-raise () ()
|
|
"Fullscreen window and make sure it's on top of all other windows"
|
|
(with-on-top (stumpwm:current-window) (fullscreen)))
|
|
|
|
;;; Theme
|
|
(setf *colors*
|
|
'("#000000" ;black
|
|
"#BF6262" ;red
|
|
"#a1bf78" ;green
|
|
"#dbb774" ;yellow
|
|
"#7D8FA3" ;blue
|
|
"#ff99ff" ;magenta
|
|
"#53cdbd" ;cyan
|
|
"#ffffff")) ;white
|
|
|
|
(update-color-map (current-screen))
|
|
|
|
;;; Font
|
|
(ql:quickload :clx-truetype)
|
|
|
|
;; Make sure my local fonts are avaliable
|
|
(pushnew (concat (getenv "HOME")
|
|
"/.local/share/fonts/")
|
|
xft:*font-dirs* :test #'string=)
|
|
(xft:cache-fonts)
|
|
|
|
(let ((parent-font "PragmataPro Liga"))
|
|
(when (find parent-font (the list (clx-truetype:get-font-families))
|
|
:test #'string=)
|
|
(load-module "ttf-fonts")
|
|
(set-font `(,(make-instance 'xft:font
|
|
:family "PragmataPro Liga"
|
|
:subfamily "Regular"
|
|
:size 11
|
|
:antialias t)))))
|
|
|
|
;;; Basic Settings
|
|
(setf *window-format* "%m%s%50t")
|
|
(setf *mode-line-background-color* (car *colors*)
|
|
*mode-line-foreground-color* (car (last *colors*))
|
|
*mode-line-timeout* 1)
|
|
|
|
(setf *message-window-gravity* :center
|
|
*window-border-style* :thin
|
|
*message-window-padding* 3
|
|
*maxsize-border-width* 2
|
|
*normal-border-width* 2
|
|
*transient-border-width* 2
|
|
stumpwm::*float-window-border* 1
|
|
stumpwm::*float-window-title-height* 1)
|
|
|
|
;; Focus Follow Mouse
|
|
(setf *mouse-focus-policy* :sloppy)
|
|
|
|
;;; Completion
|
|
;; ;; Show all completions from start
|
|
;; (setf *input-completion-show-empty* nil)
|
|
;; ;; keep completions open even when one is selected
|
|
;; (setf *input-completion-style* (make-input-completion-style-unambiguous))
|
|
(setf *input-window-gravity* :center
|
|
;; TODO determin why this appears above
|
|
*message-window-input-gravity* :left)
|
|
|
|
(setf *input-completion-show-empty* t)
|
|
|
|
;; Remember commands and offers orderless completion
|
|
;; https://github.com/landakram/stumpwm-prescient
|
|
(ql:quickload :stumpwm-prescient)
|
|
(setf *input-refine-candidates-fn* 'stumpwm-prescient:refine-input)
|
|
|
|
;;; Startup Commands
|
|
(run-shell-command "xsetroot -cursor_name left_ptr")
|
|
|
|
;;; Bindings
|
|
(set-prefix-key (kbd "XF86Tools"))
|
|
|
|
;; General Top Level Bindings
|
|
(define-key *top-map* (kbd "s-n") "pull-hidden-next")
|
|
(define-key *top-map* (kbd "s-p") "pull-hidden-previous")
|
|
;; Tab like cycling
|
|
(define-key *top-map* (kbd "s-C-n") "next-in-frame")
|
|
(define-key *top-map* (kbd "s-C-p") "prev-in-frame")
|
|
;; Frame cycling
|
|
(define-key *top-map* (kbd "s-TAB") "fnext")
|
|
(define-key *top-map* (kbd "s-ISO_Left_Tab") "fprev")
|
|
|
|
(setf *resize-increment* 25)
|
|
(tr-define-key "f" "fullscreen")
|
|
(tr-define-key "q" "only")
|
|
(tr-define-key "=" "exec menu_connection_manager.sh")
|
|
(tr-define-key "X" "exec power_menu.sh")
|
|
(tr-define-key "P" "exec clipmenu")
|
|
(tr-define-key "d" "exec dmenu_run")
|
|
(tr-define-key "RET" "exec emacsclient -c -a 'emacs'")
|
|
(tr-define-key "D" "exec discord")
|
|
|
|
;; Window Movement
|
|
(dyn-blacklist-command "move-window")
|
|
(dyn-blacklist-command "remove-lose-focus")
|
|
(define-key *top-map* (kbd "s-H") "move-window left")
|
|
(define-key *top-map* (kbd "s-J") "move-window down")
|
|
(define-key *top-map* (kbd "s-K") "move-window up")
|
|
(define-key *top-map* (kbd "s-L") "move-window right")
|
|
|
|
;;; Volume Stuff
|
|
(let ((vdown "exec cm down 5")
|
|
(vup "exec cm up 5")
|
|
(m *top-map*))
|
|
(define-key m (kbd "s-C-a") vdown)
|
|
(define-key m (kbd "XF86AudioLowerVolume") vdown)
|
|
(define-key m (kbd "s-C-f") vup)
|
|
(define-key m (kbd "XF86AudioRaiseVolume") vup))
|
|
|
|
;;; Brightness
|
|
(when *initializing*
|
|
(defconstant backlightfile "/sys/class/backlight/intel_backlight/brightness"))
|
|
|
|
(let ((bdown "exec xbacklight -dec 10")
|
|
(bup "exec xbacklight -inc 10")
|
|
(m *top-map*))
|
|
(define-key m (kbd "s-C-s") bdown)
|
|
(define-key m (kbd "XF86MonBrightnessDown") bdown)
|
|
(define-key m (kbd "s-C-d") bup)
|
|
(define-key m (kbd "XF86MonBrightnessUp") bup))
|
|
|
|
;;; General Root Level Bindings
|
|
(defcommand term (&optional prg) ()
|
|
(run-shell-command (if prg
|
|
(format nil "st -e ~A" prg)
|
|
"st")))
|
|
(define-key *root-map* (kbd "c") "term")
|
|
(define-key *root-map* (kbd "C-c") "term")
|
|
(define-key *root-map* (kbd "y") "eval (term \"cm\")")
|
|
(define-key *root-map* (kbd "w") "exec ducksearch")
|
|
(define-key *root-map* (kbd "b") "pull-from-windowlist")
|
|
(define-key *root-map* (kbd "R") "iresize")
|
|
(define-key *root-map* (kbd "B") "beckon")
|
|
(define-key *root-map* (kbd "r") "remove-lose-focus")
|
|
(define-key *root-map* (kbd "f") "fullscreen-and-raise")
|
|
(define-key *root-map* (kbd "Q") "quit-confirm")
|
|
|
|
(define-key *root-map* (kbd "SPC") "exec cabl -c")
|
|
;; more usful alternatives to i and I
|
|
(define-key *root-map* (kbd "i") "show-window-properties")
|
|
(define-key *root-map* (kbd "I") "list-window-properties")
|
|
|
|
;;; Groups
|
|
(grename "main")
|
|
(gnewbg ".trash") ; hidden group
|
|
(gnewbg "distractions") ; for discord and stuff
|
|
(gnew-dynamic "dy")
|
|
|
|
;; Don't jump between groups when switching apps
|
|
(setf *run-or-raise-all-groups* nil)
|
|
(define-key *groups-map* (kbd "l") "change-default-layout")
|
|
(define-key *groups-map* (kbd "d") "gnew-dynamic")
|
|
(define-key *groups-map* (kbd "s") "gselect")
|
|
|
|
(load-module "globalwindows")
|
|
(define-key *groups-map* (kbd "b") "global-pull-windowlist")
|
|
|
|
;;;; Hide and Show Windows
|
|
(defcommand pull-from-trash () ()
|
|
(let* ((windows (windows-in-group ".trash"))
|
|
(window (window-from-menu windows)))
|
|
(when window
|
|
(move-window-to-group window (current-group))
|
|
(stumpwm::pull-window window))))
|
|
|
|
(defcommand move-to-trash () ()
|
|
(stumpwm:run-commands "gmove .trash"))
|
|
|
|
(tr-define-key "]" "move-to-trash")
|
|
(tr-define-key "[" "pull-from-trash")
|
|
|
|
|
|
;;; Floating Windows
|
|
(defcommand toggle-slop-this () ()
|
|
(let ((win (current-window))
|
|
(group (current-group)))
|
|
(cond
|
|
((floatingp win)
|
|
(always-on-top-off win)
|
|
(stumpwm::unfloat-window win group))
|
|
(t (slop)))))
|
|
|
|
(tr-define-key "z" "toggle-slop-this")
|
|
|
|
;;; Splits
|
|
(defcommand hsplit-and-focus () ()
|
|
"create a new frame on the right and focus it."
|
|
(with-focus-lost
|
|
(hsplit)
|
|
(move-focus :right)))
|
|
|
|
(defcommand vsplit-and-focus () ()
|
|
"create a new frame below and focus it."
|
|
(with-focus-lost
|
|
(vsplit)
|
|
(move-focus :down)))
|
|
(define-key *root-map* (kbd "v") "hsplit-and-focus")
|
|
(define-key *root-map* (kbd "s") "vsplit-and-focus")
|
|
|
|
;; Extra mappings for dynamic windows
|
|
(define-minor-mode my/tile-mode () ()
|
|
(:interactive t)
|
|
(:scope :dynamic-group)
|
|
(:top-map '(("s-v" . "exchange-with-master")
|
|
("s-=" . "change-default-split-ratio 1/2")))
|
|
(:lighter-make-clickable nil)
|
|
(:lighter "MY/TILE"))
|
|
;; (my/tile-mode)
|
|
(loop :for i :in '("hsplit-and-focus"
|
|
"vsplit-and-focus")
|
|
:do (dyn-blacklist-command i))
|
|
|
|
;;; Mode-Line
|
|
(load-module "battery-portable")
|
|
|
|
;;;; Get Fit
|
|
(declaim (type fixnum *reps*))
|
|
(defvar *reps* 0
|
|
"Variable for keeping track of reps")
|
|
|
|
(defcommand add-reps (reps) ((:number "Enter reps: "))
|
|
(declare (type fixnum reps))
|
|
(when reps
|
|
(setq *reps* (+ *reps* reps))))
|
|
|
|
(defcommand reset-reps () ()
|
|
(setq *reps* 0))
|
|
|
|
(defvar *gym-map*
|
|
(let ((m (make-sparse-keymap)))
|
|
(define-key m (kbd "a") "add-reps")
|
|
(define-key m (kbd "r") "reset-reps")
|
|
m))
|
|
(define-key *root-map* (kbd "ESC") '*gym-map*)
|
|
|
|
;;;; Actual Modeline
|
|
(setf *time-modeline-string* "%a, %b %d %I:%M%p")
|
|
(setf *screen-mode-line-format*
|
|
(list
|
|
;; Groups
|
|
" ^7[^B^4%n^7^b] "
|
|
;; Pad to right
|
|
"^>"
|
|
'(:eval (when (> *reps* 0)
|
|
(format nil "^1^B(Reps ~A)^n " *reps*)))
|
|
;; Date
|
|
"^7"
|
|
"%d"
|
|
;; Battery
|
|
" ^7[^n%B^7]^n "))
|
|
|
|
(defun enable-mode-line-everywhere ()
|
|
(loop for screen in *screen-list* do
|
|
(loop for head in (screen-heads screen) do
|
|
(enable-mode-line screen head t))))
|
|
(enable-mode-line-everywhere)
|
|
;; turn on/off the mode line for the current head only.
|
|
(define-key *top-map* (kbd "s-B") "mode-line")
|
|
|
|
;;; Gaps
|
|
(load-module "swm-gaps")
|
|
(setf swm-gaps:*inner-gaps-size* 13
|
|
swm-gaps:*outer-gaps-size* 7
|
|
swm-gaps:*head-gaps-size* 0)
|
|
(when *initializing*
|
|
(swm-gaps:toggle-gaps))
|
|
(define-key *groups-map* (kbd "g") "toggle-gaps")
|
|
|
|
;;; Remaps
|
|
(define-remapped-keys
|
|
'(("(acme)"
|
|
("C-b" . "Left")
|
|
("C-n" . "Down")
|
|
("C-p" . "Up")
|
|
("C-d" . ("Right" "C-h")))
|
|
("(discord|Element|Google-chrome)"
|
|
("C-a" . "Home")
|
|
("C-e" . "End")
|
|
("C-E" . "C-e")
|
|
("C-n" . "Down")
|
|
("C-p" . "Up")
|
|
("C-f" . "Right")
|
|
("C-b" . "Left")
|
|
("C-N" . "S-Down")
|
|
("C-P" . "S-Up")
|
|
("C-F" . "S-Right")
|
|
("C-B" . "S-Left")
|
|
("C-v" . "Next")
|
|
("M-v" . "Prior")
|
|
("M-w" . "C-c")
|
|
("C-w" . ("C-S-Left" "C-x"))
|
|
("C-y" . "C-v")
|
|
("M-<" . "Home")
|
|
("M->" . "End")
|
|
("C-M-b" . "M-Left")
|
|
("C-M-f" . "M-Right")
|
|
("M-f" . "C-Right")
|
|
("M-b" . "C-Left")
|
|
("C-s" . "C-f")
|
|
("C-j" . "C-k")
|
|
("C-/" . "C-z")
|
|
("C-k" . ("C-S-End" "C-x"))
|
|
("C-d" . "Delete")
|
|
("M-d" . "C-Delete"))))
|
|
|
|
;;; Undo And Redo Functionality
|
|
(load-module "winner-mode")
|
|
(define-key *root-map* (kbd "u") "winner-undo")
|
|
(define-key *root-map* (kbd "C-r") "winner-redo")
|
|
(add-hook *post-command-hook* (lambda (command)
|
|
(when (member command winner-mode:*default-commands*)
|
|
(winner-mode:dump-group-to-file))))
|
|
|
|
;;; Emacs integration
|
|
(defcommand emacs () () ; override default emacs command
|
|
"Start emacs if emacsclient is not running and focus emacs if it is
|
|
running in the current group"
|
|
(run-or-raise "oemacsclient -c -a 'emacs'" '(:class "Emacs")))
|
|
;; Treat emacs splits like Xorg windows
|
|
(defun is-emacs-p (win)
|
|
"nil if the WIN"
|
|
(when win
|
|
(string-equal (window-class win) "Emacs")))
|
|
|
|
(defmacro exec-el (expression)
|
|
"execute emacs lisp do not collect it's output"
|
|
`(eval-string-as-el (write-to-string ',expression)))
|
|
|
|
(defun eval-string-as-el (elisp &optional collect-output-p)
|
|
"evaluate a string as emacs lisp"
|
|
(let ((result (run-shell-command
|
|
(format nil "timeout --signal=9 1m emacsclient --eval \"~a\""
|
|
elisp)
|
|
collect-output-p)))
|
|
(handler-case (read-from-string result)
|
|
;; Pass back a string when we can't read from the string
|
|
(error () result))))
|
|
|
|
(defmacro eval-el (expression)
|
|
"evaluate emacs lisp and collect it's output"
|
|
`(eval-string-as-el ,(write-to-string expression :case :downcase) t))
|
|
|
|
(declaim (ftype
|
|
(function (string) (values string &optional))
|
|
emacs-winmove))
|
|
(defun emacs-winmove (direction)
|
|
"executes the emacs function winmove-DIRECTION where DIRECTION is a string"
|
|
(eval-string-as-el (concat "(windmove-" direction ")") t))
|
|
|
|
;;; Set up for recording
|
|
(defun setup-recording-environment (group-name)
|
|
"Sets up a recording environment and returns a function to start the
|
|
necessary programs for recording a new YouTube video"
|
|
(let* ((obs-window (find-matching-windows
|
|
(list :class "obs")
|
|
t t))
|
|
(clip-browser-name "Recording-Clips")
|
|
(clip-directory "~/Videos/clips/")
|
|
(clip-browser-window (find-matching-windows
|
|
(list :title clip-browser-name)
|
|
t t)))
|
|
;; Create the recording group
|
|
(define-frame-preference group-name
|
|
(0 t t :class "obs")
|
|
(0 t t :title "Recording-Clips"))
|
|
(gnew group-name)
|
|
|
|
;; Setup obs
|
|
(unless obs-window
|
|
(run-shell-command "obs"))
|
|
|
|
;; Create a window for previewing and managing clips
|
|
(unless clip-browser-window
|
|
(run-shell-command
|
|
(format nil
|
|
"emacsclient -c -F '((name . \"~a\"))' -e '(dired \"~a\")'"
|
|
clip-browser-name
|
|
clip-directory))
|
|
;; Set recording font
|
|
(exec-el (fontaine-set-preset 'large)))))
|
|
|
|
(defcommand recording () ()
|
|
(setup-recording-environment "recording"))
|
|
|
|
|
|
;;; Window focusing
|
|
(defun switched-emacs-window (dir)
|
|
(declare (type Keyword dir)
|
|
(optimize (speed 3) (safety 1)))
|
|
|
|
(if (is-emacs-p (current-window))
|
|
;; There is not emacs window in that direction
|
|
(not
|
|
(length=
|
|
(emacs-winmove (string-downcase (string dir)))
|
|
1))
|
|
nil))
|
|
|
|
(defun maybe-beckon ()
|
|
(if (current-window)
|
|
(beckon:beckon)
|
|
nil))
|
|
|
|
(defun better-move-focus (ogdir)
|
|
"Similar to move-focus but also treats emacs windows as Xorg windows"
|
|
(declare (type (member :up :down :left :right) ogdir)
|
|
(optimize (speed 3) (safety 3)))
|
|
|
|
(let ((cw (current-window)))
|
|
(cond
|
|
((not cw) (progn (move-focus ogdir)
|
|
(maybe-beckon)))
|
|
((switched-emacs-window ogdir))
|
|
;; If fullscreen don't change focus
|
|
((stumpwm:window-fullscreen cw))
|
|
(t (progn (move-focus ogdir)
|
|
(maybe-beckon))))))
|
|
|
|
|
|
(defcommand my-mv (dir) ((:direction "Enter direction: "))
|
|
(when dir (better-move-focus dir)))
|
|
|
|
(define-key *top-map* (kbd "s-h") "my-mv left")
|
|
(define-key *top-map* (kbd "s-j") "my-mv down")
|
|
(define-key *top-map* (kbd "s-k") "my-mv up")
|
|
(define-key *top-map* (kbd "s-l") "my-mv right")
|
|
|
|
;;; SLY setup
|
|
(ql:quickload :slynk)
|
|
(defvar *slynk-port* slynk::default-server-port)
|
|
(defparameter *stumpwm-slynk-session* nil)
|
|
|
|
(defcommand start-slynk (&optional (port *slynk-port*)) ()
|
|
(handler-case
|
|
(defparameter *stumpwm-slynk-session*
|
|
(slynk:create-server
|
|
:dont-close t
|
|
:port port))
|
|
(error (c)
|
|
(format *error-output* "Error starting slynk: ~a~%" c)
|
|
)))
|
|
|
|
(defcommand restart-slynk () ()
|
|
"Restart Slynk and reload source.
|
|
This is needed if Sly updates while StumpWM is running"
|
|
(stop-slynk)
|
|
(start-slynk))
|
|
|
|
(defcommand stop-slynk () ()
|
|
"Restart Slynk and reload source.
|
|
This is needed if Sly updates while StumpWM is running"
|
|
(slynk:stop-server *slynk-port*))
|
|
|
|
(defcommand connect-to-sly () ()
|
|
(unless *stumpwm-slynk-session*
|
|
(start-slynk))
|
|
(exec-el (sly-connect "localhost" *slynk-port*))
|
|
(emacs))
|
|
|
|
(define-stumpwm-type :dunstctl (input prompt)
|
|
(completing-read (current-screen) prompt '("context" "action" "close" "history")))
|
|
|
|
(defcommand dunst () ()
|
|
(run-shell-command "dunstctl context"))
|