Iz'S StumpWM Configuration

;; Load in handlers & commands
(load "~/.stumpwm.d/handlers.lisp")
(load "~/.stumpwm.d/commands.lisp")

;; String manipulation/sanitization
(defun sanitize-string (string)
 "Sanitize STRING input.
 - Returns \"^Rnil^r\" if STRING is empty after trimming.
 - Otherwise, trims leading/trailing whitespace and control characters.
 Arguments:
 STRING: A string to sanitize.
 Returns:
 A sanitized string or \"^Rnil^r\"."
 (let ((trimmed (string-trim
 '(#\Space #\Newline #\Backspace #\Tab #\Linefeed
 #\Page #\Return #\Rubout)
 string)))
 (if (string= trimmed "")
 "^Rnil^r"
 trimmed)))
;; Runners with different use-cases
(defun run-shell-command-and-format (command)
 "Execute a shell command and format its output.
 Runs the given COMMAND and sanitizes its output using sanitize-string
 Arguments:
 COMMAND: A string containing the shell command to execute.
 Returns:
 A string containing the sanitized output of the command"
 (let ((output (run-shell-command command t)))
 (sanitize-string output)))
(defun run-shell-command-async (command)
 "Run a shell command asynchronously using uiop:launch-program.
 HACK HACK HACK: This is a custom wrapper so we can run programs
 that don't cleanly exit without blocking the lisp process. it
 it NOT true async.
 Arguments:
 COMMAND: A string containing the shell command to execute."
 (uiop:launch-program command :output :interactive :error-output :interactive))
;; Sound handler
(defun safe-sndioctl (control)
 "Safely execute sndioctl command for the given control.
 Arguments:
 CONTROL: A string representing the sndioctl control to query.
 Returns:
 STRING: The output of the sndioctl command or an empty string on error.
 This function catches any errors that might occur when running sndioctl
 and returns an empty string in such cases."
 (handler-case
 (run-shell-command (format nil "sndioctl -n ~a" control) t)
 (error (c)
 (declare (ignore c))
 "")))
(defun find-executable (name)
 "Find an executable program from (uiop:getenv \"PATH\") and
 return it's full path in the filesystem.
 Arguments:
 NAME: A string representing the executable to query.
 Returns:
 STRING: if path of the executable is found, representing
 the path of the program
 NIL: if no path is found.
 "
 (loop
 for dir in (uiop:split-string
 (or (uiop:getenv "PATH") "")
 :separator ":")
 for path = (uiop:subpathname
 (uiop:ensure-directory-pathname dir)
 name)
 when (probe-file path)
 return (namestring path)))

(defun make-toggle-function (command-pair &optional (inverse nil))
 "Create a function that toggles between two shell commands.
 Arguments:
 COMMAND-PAIR: A list containing two shell commands as strings.
 INVERSE: Boolean, if T, the initial state is considered 'on' (default: NIL).
 Returns:
 A function that, when called, toggles between the two commands and returns the new state.
 Example usage:
 (make-toggle-function '(\"echo ON\" \"echo OFF\") t)
 Returns an object that is a CLOSURE named (LAMBDA () :IN MAKE-TOGGLE-FUNCTION).
 0. Lambda-list: NIL
 1. Ftype: (FUNCTION NIL (VALUES T &OPTIONAL))
 2. Closed over values: ((\"echo ON\" \"echo OFF\") #<value-cell T {1101F20ACF}>)
 HACK HACK HACK:
 We use RUN-SHELL-COMMAND-ASYNC here as we'd block the lisp process with
 STUMPWM:RUN-SHELL-COMMAND otherwise. This is important as many of the COMMAND-PAIRs we'd
 be using are daemons that run in the background and would hang our lisp process.
 Please see the (DESCRIBE 'RUN-SHELL-COMMAND-ASYNC) documentation."
 (let ((state inverse))
 (lambda ()
 (setf state (not state))
 (let ((command (if state (first command-pair) (second command-pair))))
 (run-shell-command-async command)
 state))))
(defmacro define-toggle-command (name commands inverse description)
 "Define a StumpWM command that toggles a set of commands and displays the current state.
 Arguments:
 NAME: Symbol, the name of the command to be defined.
 COMMANDS: List of command pairs to be toggled.
 INVERSE: Boolean, if T, the initial state is considered 'on'.
 DESCRIPTION: String, description of the command for documentation.
 Example usage:
 (define-toggle-command toggle-powersave
 ((\"xset s on\" \"xset s off\")
 (\"xset s blank\" \"xset s noblank\")
 (\"xset +dpms\" \"xset -dpms\"))
 t
 \"Toggle power-saving mode and display the current state.\")
 This defines a StumpWM toggle command that will run shell commands:
 \"xset s on\", \"xset s blank\", and \"xset +dpms\" when toggled ON.
 &
 \"xset s off\", \"xset s noblank\", and \"xset -dpms\" when toggled OFF.
 If we set INVERSE to t, we would default to an OFF state,
 otherwise, the assumption is the state of ON.
 "
 (let ((commands-var (gensym "COMMANDS-")))
 `(progn
 (defparameter ,commands-var ',commands)
 (let ((toggle-functions (mapcar (lambda (pair) (make-toggle-function pair ,inverse))
 ,commands-var)))
 (defcommand ,name () ()
 ,description
 (let ((new-states (mapcar #'funcall toggle-functions)))
 (message ,(format nil "~a mode: ~~a" (string-capitalize (symbol-name name)))
 (if (some #'identity new-states) "Enabled" "Disabled"))))))))
;;;
;; The commands
;;;
;; toggles
(define-toggle-command toggle-powersave
 (("xset s on" "xset s off")
 ("xset s blank" "xset s noblank")
 ("xset +dpms" "xset -dpms"))
 t
 "Toggle power-saving mode and display the current state.")
(define-toggle-command toggle-oneko
 (("oneko -tora -rv -tofocus -name 'neko'" "pkill -9 oneko"))
 nil
 "Toggle oneko mode and display the current state.")
(define-toggle-command toggle-picom
 (("picom -b" "pkill -9 picom"))
 t
 "Toggle picom mode and display the current state.")
(define-toggle-command toggle-dunst
 (("dunst --startup_notification true" "pkill -9 dunst"))
 t
 "Toggle dunst mode and display the current state.")
(define-toggle-command toggle-emacs-daemon
 (("emacs --daemon" "emacsclient -e '(kill-emacs)'"))
 t
 "Toggle emacs daemon mode and display the current state.")
;; Extra Special Case Toggles
(defcommand pushpop-float () ()
 "Toggle the floating state of the current window.
 If the current window is floating, make it non-floating.
 If the current window is non-floating, make it float."
 (if (float-window-p (current-window))
 (unfloat-this)
 (float-this)))

(defcommand rofi () ()
 (run-shell-command "rofi -i -show-icons -matching fuzzy -show drun"))
(defcommand claws-mail () ()
 (message "Opening Claws Mail")
 (run-or-raise "claws-mail" '(:class "Claws-mail")))
(defcommand deadbeef () ()
 (message "Opening DeadBeeF")
 (run-or-raise "deadbeef" '(:class "Deadbeef")))
(defcommand xfe () ()
 (message "Opening xfe")
 (run-or-raise "xfe" '(:class "Xfe")))
(defcommand browser () ()
 (message "Opening Browser")
 (let ((browser (or (find-executable "luakit")
 (find-executable "badwolf")
 (find-executable "librewolf")
 (find-executable "firefox")
 (find-executable "firefox-esr"))))
 (when browser
 (let ((name (file-namestring browser)))
 (run-or-raise browser `(:class ,name))))))
 
(defcommand surf () ()
 (message "Opening Surf")
 (run-or-raise "surf" '(:class "Surf")))
(defcommand emacs () ()
 (message "Opening Emacs")
 (run-shell-command "emacsclient -c -a 'emacs'"))
(defcommand gnome-keyring () ()
 (message "Starting GNOME keyring daemon")
 (run-shell-command "gnome-keyring-daemon -r -d -c secrets"))

;; modules
(load "~/.stumpwm.d/modules.lisp")

;;;
;; Modules & their config
;;;
;; Set Modules
(set-module-dir "~/.stumpwm.d/modules") ; (set-contrib-dir) is deprecated, this is the method now
;; Init modules
(add-to-load-path "~/.stumpwm.d/extras/scratchpad")
;; Load that module shizz in
(init-load-path *module-dir*)
(defvar *modulenames*
 (list
 "app-menu" ;; app-menu
 "stumptray" ;; System tray
 "scratchpad" ;; floating scratchterm
 "globalwindows" ;; global window management
 ;; "hostname" ;; native hostname
 "stumpwm-sndioctl" ;; sound
 "urgentwindows" ;; get urgent windows
 "swm-gaps" ;; gaps support
 ))
;; there a battery?
(defun battery-present-p ()
 "Check if a battery is present in the system.
 Returns:
 BOOLEAN: T if a battery is present, NIL otherwise.
 This function uses the 'apm -b' command to determine the battery status.
 A return value of '4' from apm indicates no battery is present."
 (let ((output (sanitize-string (run-shell-command "apm -b" t))))
 (not (string= output "4"))))
;; Conditionally add battery-portable module
(when (battery-present-p)
 (push "battery-portable" *modulenames*))
;; Load modules
(dolist (modulename *modulenames*)
 (load-module modulename))
;;
;; Module Settings
;;
;; urgent window
(setf urgentwindows:*urgent-window-message* "Application ~a wants your attention")
;; scratchpad
;; define default scratchpad term
(defcommand scratchpad-term () ()
 "Toggle a floating terminal scratchpad.
 This command creates or toggles a floating terminal window using the scratchpad module.
 The terminal is centered on the screen with a width of 720 pixels and a height of 480 pixels.
 Usage:
 (scratchpad-term)
 No arguments are required.
 Effects:
 - If the scratchpad is not visible, it will be created and shown.
 - If the scratchpad is already visible, it will be hidden.
 The scratchpad uses the following settings:
 - Initial gravity: center
 - Initial width: 720 pixels
 - Initial height: 480 pixels
 - Terminal command: \"st\""
 (scratchpad:toggle-floating-scratchpad "term" "xterm"
 :initial-gravity :center
 :initial-width 720
 :initial-height 480))
;; app menu
(setq app-menu:*app-menu*
 '(("Modeline" mode-line)
 ("Mute" stumpwm-sndioctl::toggle-mute)
 ("Powersave" toggle-powersave)
 ("Oneko" toggle-oneko)
 ("Picom" toggle-picom)
 ("Dunst" toggle-dunst)
 ("Emacs Daemon" toggle-emacs-daemon)
 ("Gaps" swm-gaps:toggle-gaps)))
;; Bind Scratchpad to Control+Meta+t
(define-key *top-map* (kbd "C-M-t") "scratchpad-term")

;; styles
(load "~/.stumpwm.d/style.lisp")

;;;
;; Colors
;;;
(defvar *color-map*
 '((iz-black . "#282828") ;; *color0
 (iz-red . "#cc241d") ;; *color1
 (iz-softred . "#fb4934") ;; *color9
 (iz-green . "#98971a") ;; *color2
 (iz-softgreen . "#b8bb26") ;; *color10
 (iz-yellow . "#d79921") ;; *color3
 (iz-softyellow . "#fabd2f") ;; *color11
 (iz-blue . "#458588") ;; *color4
 (iz-softblue . "#83a598") ;; *color12
 (iz-purple . "#b16286") ;; *color5
 (iz-softpurple . "#d3869b") ;; *color13
 (iz-aqua . "#689d6a") ;; *color6
 (iz-softaqua . "#8ec07c") ;; *color14
 (iz-orange . "#d65d0e") ;; Gruvbox doesn’t define an explicit orange,
 ;; but this is commonly used in community ports
 (iz-softorange . "#fe8019") ;; Alternative soft orange
 (iz-white . "#ebdbb2") ;; *color15 (lightest foreground)
 (iz-gray . "#928374")) ;; *color8 (light gray / dark white)
 "A mapping of color names to their corresponding hex codes.")
(setf *colors*
 (mapcar (lambda (color-name)
 (cdr (assoc color-name *color-map*)))
 '(iz-black ;; ^0
 iz-softred ;; ^1
 iz-softgreen ;; ^2
 iz-softyellow ;; ^3
 iz-softblue ;; ^4
 iz-softpurple ;; ^5
 iz-softaqua ;; ^6
 iz-white ;; ^7
 iz-softorange ;; ^8
 iz-gray) ;; ^9
 ))
(update-color-map (current-screen))

;;;
;; Styling
;;;
;; Set font and colors for the message window
(set-fg-color "#FBF1C7")
(set-bg-color "#1D2021")
(set-border-color "#EBDBB2")
(set-msg-border-width 1)
;; MouseKeys
(setf *mouse-focus-policy* :click
 ,*float-window-modifier* :super)
;; Welcome
(setq *startup-message* (format nil "^b^8Welcome Izzy!")) ;; Orange
;; Ignore Resize Hints
(setq *ignore-wm-inc-hints* t)
;; Set focus and unfocus colors
(set-focus-color "#FBF1C7")
(set-unfocus-color "#928374")
(set-float-focus-color "#8EC07C")
(set-float-unfocus-color "#689D6A")

;; Rename and create new groups
(when *initializing*
 (grename "Ness")
 (gnewbg "Jeff")
 (gnewbg "Paula")
 (gnewbg "Poo"))
;; Clear rules
(clear-window-placement-rules)
;; Group format
(setf *group-format* "%n")
;; New window formatter:
(defun first-two-words (s)
 (format nil "~{~A~^ ~}"
 (loop for w in (uiop:split-string s)
 repeat 2
 collect w)))
(defun window-short-name (window)
 (first-two-words (window-name window)))
(push (list #\T 'window-short-name) *window-formatters*)
;; Window format
(setf *window-format* "[%n] %T"
 ,*window-border-style* :tight
 ,*hidden-window-color* "^**")
;; Time format
(setf *time-modeline-string* "%I:%M%p")
;; Message window settings
(setf *message-window-gravity* :center)
;; Input window settings
(setf *input-window-gravity* :center)

(defun adjust-style-based-on-xrandr ()
 "Query xrandr to detect the display height and adjust styling."
 (let* ((output (string-trim '(#\Newline #\Space)
 (run-shell-command-and-format
 "xrandr | grep '*' | head -n1 | awk '{print 1ドル}'")))
 ;; output should look like "1920x1080"
 (parts (uiop:split-string output :separator "x"))
 (height (ignore-errors (parse-integer (second parts)))))
 (cond
 ;; anything below 1024p gets "720p" style
 ((and height (< height 1024))
 (set-font "-*-spleen-*-*-*-*-12-*-*-*-*-*-*-*")
 (setf *message-window-padding* 2
 ,*message-window-y-padding* 2
 ,*normal-border-width* 1
 ,*mode-line-border-width* 1
 swm-gaps:*head-gaps-size* 10
 swm-gaps:*inner-gaps-size* 5
 swm-gaps:*outer-gaps-size* 5))
 ;; 1024p up to but not 4K
 ((and height (< height 2160))
 (set-font "-*-spleen-*-*-*-*-17-*-*-*-*-*-*-*")
 (setf *message-window-padding* 3
 ,*message-window-y-padding* 3
 ,*normal-border-width* 2
 ,*mode-line-border-width* 2
 swm-gaps:*head-gaps-size* 12
 swm-gaps:*inner-gaps-size* 6
 swm-gaps:*outer-gaps-size* 6))
 ;; 4K and above
 ((and height (>= height 2160))
 (set-font "-*-spleen-*-*-*-*-24-*-*-*-*-*-*-*")
 (setf *message-window-padding* 5
 ,*message-window-y-padding* 5
 ,*normal-border-width* 3
 ,*mode-line-border-width* 3
 swm-gaps:*head-gaps-size* 14
 swm-gaps:*inner-gaps-size* 8
 swm-gaps:*outer-gaps-size* 8))
 ;; fallback
 (t
 (set-font "-*-spleen-*-*-*-*-12-*-*-*-*-*-*-*")
 (setf *message-window-padding* 3
 ,*message-window-y-padding* 3
 ,*normal-border-width* 1
 ,*mode-line-border-width* 1
 swm-gaps:*head-gaps-size* 15
 swm-gaps:*inner-gaps-size* 8
 swm-gaps:*outer-gaps-size* 8)))))
(when *initializing*
 (adjust-style-based-on-xrandr)
 (swm-gaps:toggle-gaps))

;; modeline
(load "~/.stumpwm.d/modeline.lisp")

;;;
;; Define Functions
;;;
(defun check-temp (sensor)
 "Check temperature for a given sensor.
 Arguments:
 SENSOR: The sensor to check (e.g., 'cpu0.temp0').
 Returns:
 The temperature string or nil if unavailable."
 (let ((temp (run-shell-command-and-format
 (format nil "sysctl -n hw.sensors.~A 2>/dev/null" sensor))))
 (unless (string= temp "^Rnil^r")
 temp)))
(defun show-temp (&optional custom-sensor)
 "Retrieve and format the CPU temperature.
 Arguments:
 CUSTOM-SENSOR: Optional. A string representing a custom sensor to check.
 Returns:
 STRING: Formatted CPU temperature or '^Rnil^r' if unavailable.
 This function attempts to get the CPU temperature using the hw.sensors tree of sysctl.
 If a custom sensor is provided, it tries that first. Otherwise, it tries
 .acpithinkpad0.temp0, then .cpu0.temp0, and finally .adt0.temp0.
 If all fail, it returns '^Rnil^r'."
 (or (and custom-sensor (check-temp custom-sensor))
 (check-temp "acpithinkpad0.temp0")
 (check-temp "km0.temp0")
 (check-temp "cpu0.temp0")
 (check-temp "adt0.temp0")
 "^Rnil^r"))
(defun show-volume (type)
 "Retrieve and format the current volume level for a given audio type.
 Arguments:
 TYPE: A string representing the audio type (e.g., 'output' or 'input').
 Returns:
 STRING: Formatted volume level as a percentage, or '^Rnil^r' if unavailable.
 This function uses safe-sndioctl to query the volume level of the specified type,
 formats it as a percentage, and handles error cases."
 (let* ((control (format nil "~a.level" type))
 (output (safe-sndioctl control)))
 (if (string-equal output "")
 "^Rnil^r"
 (format nil "~,1f%" (* 100 (read-from-string output))))))
;;;
;; Formatting
;;;
;; Constants
(defparameter pipe " | ")
(defparameter group-bracket-color "^7*") ;; White
(defparameter group-content-color "^6*") ;; Aqua
(defparameter audio-bracket-color "^8*") ;; Orange
(defparameter audio-content-color "^2*") ;; Green
(defparameter status-bracket-color "^5*") ;; Magenta
(defparameter status-content-color "^3*") ;; Yellow
(defparameter win-bracket-color "^1*") ;; Red
(defparameter win-content-color "^7*" ) ;; White
;; Components
(defvar group-fmt "%g") ;; Group ID's
(defvar win-fmt "%W") ;; Window Name
(defvar audio-fmt (list
 '(:eval (show-volume "output"))
 "/"
 '(:eval (show-volume "input"))))
(defvar status-fmt (list
 '(:eval (if (battery-present-p)
 (concatenate 'string "%B" pipe)
 "")) ;; Battery
 '(:eval (show-temp)) pipe ;; Cpu Temp
 "%d" ;; Date
 ))
;; Generate a Component of a given color
(defun generate-mode-line-component (out-color in-color component &optional right-alignment)
 "Generate a colored component for the mode line.
 Arguments:
 OUT-COLOR: String representing the color for brackets.
 IN-COLOR: String representing the color for the component content.
 COMPONENT: The content to be displayed in the component.
 RIGHT-ALIGNMENT: If non-nil, the component will be right-aligned.
 Returns:
 LIST: A list representing the formatted mode line component.
 This function creates a formatted component for the mode line with specified colors
 and optional right alignment.
 Example usage:
 (generate-mode-line-component \"^8\" \"^6\" \"%g\")
 This returns a LIST with:
 Outer bracket color: \"^8\"
 Content color: \"^6\"
 Format string: \"%g\"
 Returned list:
 (\"^8\" \"[\" \"^6\" \"%g\" \"^8\" \"]\")"
 (if right-alignment
 (list "^>" out-color "[" in-color component out-color "]")
 (list out-color "[" in-color component out-color "]")))
(defun generate-mode-line ()
 "Build and set the complete mode line format.
 This function constructs the mode line by combining various components
 with appropriate colors and formatting. It sets the *screen-mode-line-format*
 variable with the constructed mode line."
 (setf *screen-mode-line-format*
 (list
 (generate-mode-line-component group-bracket-color group-content-color group-fmt)
 (generate-mode-line-component audio-bracket-color audio-content-color audio-fmt)
 (generate-mode-line-component status-bracket-color status-content-color status-fmt)
 (generate-mode-line-component win-bracket-color win-content-color win-fmt)
 )))
;; Actually load my modeline
(generate-mode-line)
;; Format Modeline
(setf *mode-line-background-color* "#1D2021"
 ,*mode-line-border-color* "#EBDBB2"
 ,*mode-line-border-width* 1
 ,*mode-line-pad-x* 4
 ,*mode-line-pad-y* 6
 ,*mode-line-timeout* 15)
;; mode line on all heads
(dolist (h (screen-heads (current-screen)))
 (enable-mode-line (current-screen) h t))
;; Load in StumpTray
(stumptray::stumptray)

;;;
;; Load in other files
;;;
;; binds
(load "~/.stumpwm.d/bind.lisp")
;; jumps
(load "~/.stumpwm.d/jumps.lisp")

;;;
;; Pre-Bindings
;;;
;; Set prefix key
(set-prefix-key (kbd "C-t"))

;; gross binds
(defvar *gross-default-binds*
 (list "c" "C-c" "e" "C-e" "d" "C-d" "SPC"
 "i" "f" "C-k" "w" "C-w" "a" "C-a"
 "C-t" "o" "TAB" "F" "C-h" "v"
 "#" "m" "C-m" "l" "C-l" "G" "C-N"
 "A" "X" "C-SPC" "I" "r" "W" "+"
 "RET" "C-RET" "C-0" "C-1" "C-2"
 "C-3" "C-4" "C-5" "C-6" "C-7" "\""
 "C-8" "C-9" "0" "1" "2" "3" "4"
 "5" "6" "7" "8" "9")
 "List of default key bindings to be removed from the root map.
 This variable contains a list of key combinations (as strings) that I
 consider 'gross' or undesirable in the default StumpWM configuration.
 These bindings will be removed from the *root-map* to clean up the
 key binding space and prepare for custom key bindings.
 Usage:
 The bindings listed here will be unbound in the *root-map* using a loop
 that calls `define-key` with NIL as the command for each binding.")
;; yuck!
(dolist (bind *gross-default-binds*)
 (undefine-key *root-map* (kbd bind)))

;; pre-binds
(load "~/.stumpwm.d/pre-bind.lisp")

;;;
;; Make New Keymaps
;;;
(defmacro make-keymap (map-name key-binding &optional root top)
 "Create a new keymap and optionally bind it to root and/or top maps.
 Arguments:
 MAP-NAME: Symbol, the name of the new keymap variable to be created.
 KEY-BINDING: String, the key binding to associate with the new keymap.
 ROOT: Boolean, if true, bind the new keymap to *root-map*.
 TOP: Boolean, if true, bind the new keymap to *top-map*.
 This macro creates a new sparse keymap, assigns it to a variable with the given MAP-NAME,
 and optionally binds it to the root and/or top maps using the specified KEY-BINDING.
 Example usage:
 (make-keymap *example-map* \"M-e\" t t)
 This defines a keymap, named *example-map*, prefxed by M-e on both the root and top default keymaps."
 `(progn
 (defvar ,map-name
 (let ((map (make-sparse-keymap)))
 map))
 (when ,root
 (define-key *root-map* (kbd ,key-binding) ,map-name))
 (when ,top
 (define-key *top-map* (kbd ,key-binding) ,map-name))))
(make-keymap *search-map* "M-s" t t)
(make-keymap *media-map* "M-m" t t)
(make-keymap *app-map* "M-a" t t)

;;;
;; Bind Macro
;;;
(defmacro bind-shell-to-key (key command &optional (map *root-map*))
 "Bind a shell command to a key in a specified keymap.
 Arguments:
 KEY: String, the key combination to bind the command to.
 COMMAND: String, the shell command to be executed.
 MAP: Keymap, the keymap to add the binding to (default: *root-map*).
 This macro creates a key binding that, when pressed, will execute the given shell command."
 `(define-key ,map (kbd ,key) (concatenate 'string "run-shell-command " ,command)))
(defmacro bind-command-to-key (key command &optional (map *root-map*))
 "Bind a StumpWM command to a key in a specified keymap.
 Arguments:
 KEY: String, the key combination to bind the command to.
 COMMAND: String, the StumpWM command to be executed.
 MAP: Keymap, the keymap to add the binding to (default: *root-map*).
 This macro creates a key binding that, when pressed, will execute the given StumpWM command."
 `(define-key ,map (kbd ,key) ,command))
;;;
;; Loop & Bind Macro
;;;
;; Loop through keybind lists and bind them
(defmacro loop-and-bind (key-cmd-list bind-macro &optional (map *root-map*))
 "Create key bindings for a list of key-command pairs using a specified binding macro.
 Arguments:
 KEY-CMD-LIST: List of (key command) pairs to be bound.
 BIND-MACRO: The macro to use for binding (e.g., bind-shell-to-key or bind-command-to-key).
 MAP: Keymap, the keymap to add the bindings to (default: *root-map*).
 This macro loops through the KEY-CMD-LIST and creates key bindings using the specified BIND-MACRO."
 `(dolist (key-cmd ,key-cmd-list)
 (,bind-macro (first key-cmd) (second key-cmd) ,map)))

;;;
;; Bind Key Lists
;;;
;; Set Special keys
(defvar *my-special-key-commands*
 '(("Print" "scrot - | xclip -selection clipboard -target image/png")
 ("M-Print" "scrot -s -f - | xclip -selection clipboard -target image/png")
 ("C-M-Print" "scrot -u -b - | xclip -selection clipboard -target image/png")
 ("M-SPC" "rofi -i -show-icons -matching fuzzy -show drun")))
;; Set Shell Keys
(defvar *my-shell-key-commands*
 '(("c" "xterm")
 ("C-c" "xterm")
 ("l" "slock")
 ("M-b" "feh --bg-fill --randomize /usr/local/share/backgrounds")))
;; Set App Keys
(defvar *my-app-key-commands*
 '(("E" "claws-mail")
 ("d" "deadbeef")
 ("F" "xfe")
 ("f" "browser")
 ("s" "surf")
 ("e" "emacs")
 ("a" "show-menu")))
;; Set Runner Keys
(defvar *my-runner-key-commands*
 '(("SPC" "rofi")
 (";" "colon")
 (":" "eval")
 ("!" "exec")))
;; Set Playerctl Keys
(defvar *my-media-key-commands*
 '(("p" "playerctl play-pause")
 ("s" "playerctl stop")
 ("b" "playerctl previous")
 ("n" "playerctl next")
 ("z" "playerctl shuffle toggle")
 ("XF86AudioRaiseVolume" "playerctl volume 0.05+")
 ("XF86AudioLowerVolume" "playerctl volume 0.05-")))
;; Raw StumpWM Window-managing Commands
(defvar *my-wm-window-commands*
 '(("M-ESC" "mode-line")
 ("M-q" "quit")
 ("m" "mark")
 ("RET" "global-pull-windowlist")
 ("M" "gmove-marked")
 ("x" "run-shell-command xkill")
 ("C-Up" "move-window up")
 ("C-Down" "move-window down")
 ("C-Left" "move-window left")
 ("C-Right" "move-window right")
 ("p" "pushpop-float")
 ("M-p" "flatten-floats")))
;; Raw StumpWM Module Commands
(defvar *my-wm-module-commands*
 '(("q" "quit-confirm")))
;; Unprefixed Module Commands
(defvar *my-unprefixed-module-commands*
 '(("M-Tab" "prev")
 ("C-M-Tab" "windowlist-last")
 ("XF86AudioRaiseVolume" "volume-up")
 ("XF86AudioLowerVolume" "volume-down")))

;;;
;; Loop & Bind with Macros from earlier
;;;
;; List of binds
(defparameter *key-bindings*
 '((*my-shell-key-commands* bind-shell-to-key *app-map*)
 (*my-app-key-commands* bind-command-to-key *app-map*)
 (*my-runner-key-commands* bind-command-to-key *app-map*)
 (*my-runner-key-commands* bind-command-to-key *root-map*) ;; Add to root too
 (*my-wm-module-commands* bind-command-to-key *app-map*)
 (*my-unprefixed-module-commands* bind-command-to-key *top-map*)
 (*my-special-key-commands* bind-shell-to-key *top-map*)
 (*my-media-key-commands* bind-shell-to-key *media-map*)
 (*my-wm-window-commands* bind-command-to-key *root-map*)))
;; Loop over list
(dolist (binding *key-bindings*)
 (let ((commands (first binding))
 (binding-fn (second binding))
 (map (third binding)))
 (eval `(loop-and-bind ,commands ,binding-fn ,map))))

;;;
;; Jump Macros
;;;
;; Term Jump commands
(defmacro make-term-jump (name command term)
 "Create a StumpWM command for searching in a terminal.
 Arguments:
 NAME: String, the name of the command to be created.
 COMMAND: String, the shell command to be executed for searching.
 TERM: String, the terminal emulator to use.
 This macro defines a new StumpWM command that opens a terminal,
 executes a search command, and pipes the result to 'less -R'.
 The search term is prompted from the user and spaces are replaced with '+'.
 Example usage:
 (make-term-jump \"mansearch\" \"whatis\" \"xterm\")
 This creates a command 'mansearch' that opens xterm and runs 'whatis' with the given search term."
 `(defcommand ,(intern name) (search)
 ((:rest ,(concatenate 'string name " termsearch: ")))
 (nsubstitute #\+ #\Space search)
 (run-shell-command
 (format nil "~a -e sh -c '~a ~a | less -R'" ,term ,command search))))

;;;
;; Define Jumps
;;;
;; Define Terminal Jumps
(make-term-jump "mansearch" "whatis" "xterm")
(make-term-jump "manpage" "man" "xterm")
(make-term-jump "pkgname" "pkg_info -Q" "xterm")
(make-term-jump "pkgloc" "pkg_locate" "xterm")

;;;
;; Bind Jump Defines from Earlier
;;;
;; Keybindings for Terminal Jumps
(define-key *search-map* (kbd "m") "mansearch")
(define-key *search-map* (kbd "M") "manpage")
(define-key *search-map* (kbd "p") "pkgname")
(define-key *search-map* (kbd "P") "pkgloc")

;; cleanup/autostart
(load "~/.stumpwm.d/autostart.lisp")

;; Start
(when *initializing*
 ;; gnome keyring
 (gnome-keyring)
 (slynk:create-server :port 4005 :dont-close t))