dotfiles/stumpwm/.stumpwm.d/init.lisp

(in-package :stumpwm)

;; Set path to contrib modules
(set-module-dir "~/.stumpwm.d/contrib")

;; Start up a swank server for happy SLIME hacking
(require :swank)
(swank-loader:init)
(swank:create-server :port 4004
                     :style swank:*communication-style*
                     :dont-close t)

;; Colors
(defvar wal-colors-path "~/.cache/wal/colors")

;; Solarized Light
(defvar default-colors
  '("#002b36"
    "#073642"
    "#586e75"
    "#657b83"
    "#839496"
    "#93a1a1"
    "#eee8d5"
    "#fdf6e3"
    "#b58900"
    "#cb4b16"
    "#dc322f"
    "#d33682"
    "#6c71c4"
    "#268bd2"
    "#2aa198"
    "#859900"))

(defun get-color-palette ()
  (let ((wal-colors (when (probe-file wal-colors-path)
		      (uiop:read-file-lines wal-colors-path))))
    (or wal-colors default-colors)))

(defun get-color (name)
  (let ((colors (mapcar 'cons
			'("base03"
			  "base02"
			  "base01"
			  "base00"
			  "base0"
			  "base1"
			  "base2"
			  "base3"
			  "yellow"
			  "orange"
			  "red"
			  "magenta"
			  "violet"
			  "blue"
			  "cyan"
			  "green")
			(get-color-palette))))
    (cdr (assoc name colors :test 'equal))))

(defun set-colors ()
  (setq *colors* (list (get-color "base02")
		       (get-color "red")
		       (get-color "green")
		       (get-color "yellow")
		       (get-color "blue")
		       (get-color "magenta")
		       (get-color "cyan")
		       (get-color "base2")))
  (update-color-map (current-screen))
  (set-fg-color (get-color "base3"))
  (set-bg-color (get-color "base03"))
  (set-border-color (get-color "base02"))
  (set-focus-color (get-color "base03"))
  (set-unfocus-color (get-color "base03"))
  (set-float-focus-color (get-color "base03"))
  (set-float-unfocus-color (get-color "base03")))

(set-colors)

;; StumpWM configs
(setq *message-window-gravity* :center
      *input-window-gravity* :center
      *window-border-style* :thin
      *message-window-padding* 10
      *message-window-y-padding* 5
      *maxsize-border-width* 0
      *normal-border-width* 0
      *transient-border-width* 0
      *float-window-border* 2
      *float-window-title-height* 2
      *mouse-focus-policy* :click)

;; Input/message bar
(set-msg-border-width 2)

;; Sudo
(defcommand stumpwm-password (prompt) ((:string "prompt: "))
  "Prompts the user for a password"
  (read-one-line (current-screen) prompt :password t))

(defmacro run-sudo-command (cmd &optional collect-output-p)
  `(run-shell-command
    (format nil "SUDO_ASKPASS=~~/bin/stumpwm-sudo.sh sudo -A ~S" ,cmd)
    ,collect-output-p))

;; Input utilities
(defun rofi-completing-read (prompt completions)
  (string-trim '(#\newline)
   (run-shell-command
    (concatenate 'string
		 "echo -e "
		 "'" (format nil "~{~A~^\\n~}" completions) "' "
		 "| rofi -dmenu -p "
		 "'" (string-right-trim ": " prompt) "'")
    t)))

;; Commands
(defvar desktop-images-dir
  (uiop:native-namestring "~/Sync/pictures/desktop/"))

(define-stumpwm-type :desktop-image (input prompt)
  (or (argument-pop-rest input)
      (concatenate 'string desktop-images-dir
		   (rofi-completing-read
		    prompt
		    (mapcar 'file-namestring
			    (uiop:directory-files desktop-images-dir))))))

(defun run-wal (image &optional light?)
  (run-shell-command
   (concatenate 'string
		"wal -n "
		(when light? "-l ")
		"-i " (uiop:native-namestring image) " "
		"-o "
		"\"" (uiop:native-namestring "~/bin/run-wal-hooks.sh") "\"")))

(defcommand wal-dark (image) ((:desktop-image "Set desktop background: "))
  (run-wal image))

(defcommand wal-light (image) ((:desktop-image "Set desktop background: "))
  (run-wal image t))

(define-interactive-keymap wal nil
  ((kbd "l") "wal-light" t)
  ((kbd "d") "wal-dark" t))

(defcommand shutdown () ()
  (when (y-or-n-p (format nil "~@{~a~^~%~}"
                          "You are about to shut down the computer."
                          "Really ^1^Bshutdown^b^n?"
                          "^B^6Confirm?^n "))
      (run-shell-command "shutdown now")))

(defcommand firefox () ()
  (run-or-raise "firefox" '(:class "firefox")))

(defcommand lock () ()
  (run-shell-command
   (concatenate 'string
    "i3lockmore "
    "--image-fill ~/Sync/pictures/space-background.jpg "
    "-n "
    "--lock-icon ~/Sync/pictures/lock.png")))

(defcommand battery () ()
  (let ((capacity
	 (string-trim
	  '(#\newline)
	  (run-shell-command
	   "cat /sys/class/power_supply/BAT0/capacity"
	   t))))
    (echo-string (current-screen)
		 (format nil "Battery: ~A%" capacity))))

(defcommand caps->escape () ()
  (run-shell-command "setxkbmap -option caps:escape"))

(defcommand org-capture () ()
  (run-shell-command "emacsclient -a '' -e '(make-orgcapture-frame)'"))

(defcommand background-random () ()
  (run-shell-command (concatenate 'string
				  "feh --bg-scale "
				  "\"/home/jdormit/Sync/pictures/desktop/"
				  "$(ls /home/jdormit/Sync/pictures/desktop | shuf -n 1)\"")))

;; Keybindings
(define-key stumpwm:*root-map* (kbd "C-f") "firefox")
(define-key stumpwm:*root-map* (kbd "d") "exec rofi -show drun")
(define-key stumpwm:*root-map* (kbd "w") "exec rofi -show window")
(define-key stumpwm:*root-map* (kbd "P") "exec passmenu")
(define-key stumpwm:*root-map* (kbd "N") "exec networkmanager_dmenu")
(define-key stumpwm:*root-map* (kbd "M") "exec ~/bin/monitor_layout.sh")
(define-key stumpwm:*root-map* (kbd "L") "lock")
(define-key stumpwm:*root-map* (kbd "b") "battery")
(define-key stumpwm:*root-map* (kbd "C-o") "org-capture")
(define-key stumpwm:*root-map* (kbd "C-q") "quit-confirm")
(define-key stumpwm:*root-map* (kbd "T") "wal")
(define-key *top-map* (kbd "M-TAB") "pull-hidden-next")
(define-key *top-map* (kbd "XF86MonBrightnessDown") "exec xbacklight -dec 10")
(define-key *top-map* (kbd "XF86MonBrightnessUp") "exec xbacklight -inc 10")
(define-key *top-map* (kbd "XF86AudioRaiseVolume") "exec pavolume volup")
(define-key *top-map* (kbd "XF86AudioLowerVolume") "exec pavolume voldown")
(define-key *top-map* (kbd "XF86AudioMute") "exec pavolume mutetoggle")

;; X Windows config
(run-shell-command "xsetroot -cursor_name left_ptr")
(run-shell-command "setxkbmap -option caps:escape")

;; GPG
(ql:quickload "cffi")
(ql:quickload "usocket")
(ql:quickload "percent-encoding")
(load-module "pinentry")

;; UI
(ql:quickload "clx-truetype")
(load-module "ttf-fonts")
(xft:cache-fonts)
(set-font
 (make-instance 'xft:font :family "Fira Mono" :subfamily "Regular" :size 12))
(set '*message-window-padding* 4)

;; Desktop background
(if (probe-file "~/.cache/wal")
    (run-shell-command (format nil "wal -R -o \"~A\""
			       (uiop:native-namestring "~/bin/run-wal-hooks.sh"))))

;; Notifications via Dunst
(run-shell-command "/usr/bin/dunst")

;; Picom compositor
(run-shell-command "picom -b")

;; Polybar
(run-shell-command "polybar top --reload >> /tmp/polybar.top.log 2>&1")

;; Hack to get polybar to appear on startup
(defcommand poke-modeline () ()
  (mode-line)
  (mode-line))
(define-key *root-map* (kbd "C-m") "poke-modeline")

;; Sleep to allow polybar to start before starting tray apps
(sleep 1)

;; Syncthing Tray
(run-shell-command "syncthingtray --wait")

;; NetworkManager applet
(run-shell-command "nm-applet")

;; Blueman applet
(run-shell-command "blueman-applet")