dotfiles/stumpwmrc

#-quicklisp
(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
                                       (user-homedir-pathname))))
  (when (probe-file quicklisp-init)
    (load quicklisp-init)))

(in-package :stumpwm)
(setf *default-package* :stumpwm)

(when *initializing*
  (defvar *env*
     (let* ((os-string (string-trim
                         '(#\newline)
                         (run-shell-command "uname" t)))
            (os (intern os-string :keyword)))
       (case os
         (:|Linux| :linux)
         (:|NetBSD| :netbsd)
         (t :other)))))

(set-module-dir "/home/kev/personal/src/stumpwm-contrib/")

(setf *startup-message* nil)

(defvar *start-up-cmds*
  (case *env*
    (:linux '("exec pipewire"
              "exec setxkbmap -option \"ctrl:nocaps\""
              "exec xrdb -merge ~/.Xresources"
              "exec xsetroot -cursor_name left_ptr"
              "exec sh ~/.screenlayout/three-monitor-setup.sh"))
    (:netbsd '("exec setxkbmap -option \"ctrl:nocaps\""
               "exec xrdb -merge ~/.Xresources"))
    (t '())))

(when *initializing*
  (dolist (cmd *start-up-cmds*)
    (run-shell-command cmd)))

(ql:quickload :clx-truetype)
(when (eq *env* :linux)
  (progn
    (load-module "ttf-fonts")

    ;; FantasqueSansMono Nerd Font Mono
    (set-font `(,(make-instance
                  'xft:font
                  :family "LiterationMono Nerd Font Mono"
                  :subfamily "Regular"
                  :size 20
                  :antialias t)))))

(setf *mode-line-timeout* 2)
(setf *time-modeline-string* "%F %I:%M%p")
(setf *group-format* "%t")
(setf *window-format* "%n: %30t")

(defvar kev-green "#39623d")
(defvar kev-cream "#f1e9d2")
(defvar kev-gray "#4c566a")
(defvar kev-red "#cd4f34")

(when (eq *env* :linux)
  (load-module "battery-portable")
  ;; requires `wireless_tools` to be installed
  (load-module "wifi"))

(setf *mode-line-background-color* kev-green
      *mode-line-foreground-color* kev-cream)

(setf *mode-line-border-color* kev-cream
      *mode-line-border-width* 0)

(set-border-color        kev-cream)
(set-focus-color         kev-red)
(set-unfocus-color       kev-gray)
(set-float-focus-color   kev-cream)
(set-float-unfocus-color kev-gray)

;;(set-fg-color kev-gray)
;;(set-bg-color kev-cream)

(setf *normal-border-width*       5
      *float-window-border*       10
      *float-window-title-height* 15
;;      *window-border-style*       :none
      *window-format*             "%n:(%t)")

(setf *input-window-gravity*     :top
      *message-window-padding*   10
      *message-window-y-padding* 10
      *message-window-gravity*   :top)

(setf *mode-line-highlight-template* "(~A)")

;; TODO: add a module for NetBSD WIFI and battery :)
(defvar *mode-line-format*
  (case *env*
    (:linux (format nil "^(:bg \"~A\")^(:fg \"~A\")%g^(:fg \"~A\")^(:bg \"~A\")^(:bg \"~A\")^(:fg \"~A\") %W^>^(:fg \"~A\")^(:fg \"~A\")^(:bg \"~A\")%I ^(:bg \"~A\")^(:bg \"~A\")^(:fg \"~A\")%B ^(:fg \"~A\")^(:bg \"~A\")^(:fg \"~A\")%d"
             kev-cream kev-green kev-cream kev-green kev-green kev-cream kev-cream kev-green kev-cream kev-cream kev-green kev-cream kev-cream kev-cream kev-green))
    (t (format nil "^(:bg \"~A\")^(:fg \"~A\")%g^(:fg \"~A\")^(:bg \"~A\")^(:bg \"~A\")^(:fg \"~A\") %W^>^(:fg \"~A\")^(:bg \"~A\")^(:fg \"~A\")%d^(:bg \"~A\")"
             kev-cream kev-green kev-cream kev-green kev-green kev-cream kev-cream)))
  "List of formatters for the modeline.")

(defcommand reload-modeline () ()
  "Reload modeline."
  (sb-thread:make-thread
   (lambda ()
     (setf *screen-mode-line-format* *mode-line-format*))))


(reload-modeline)

(when *initializing*
  (mode-line))

(setf *mouse-focus-policy*    :click
      *float-window-modifier* :SUPER)

(load-module "beckon")
(load-module "end-session")
(load-module "globalwindows")
(load-module "stump-backlight")
(load-module "urgentwindows")
(load-module "pass")

(ql:quickload "zpng")
(load-module "screenshot")
(load-module "swm-gaps")

(setf swm-gaps:*head-gaps-size*  0
      swm-gaps:*inner-gaps-size* 5
      swm-gaps:*outer-gaps-size* 0)

(when *initializing*
  (swm-gaps:toggle-gaps))

(defparameter *output-dir* "~/Pictures")

(set-prefix-key (kbd "C-h"))

;;; Keybindings
(define-key *root-map* (kbd "B") "beckon")
(define-key *root-map* (kbd "C-b") "banish")

(define-key *root-map* (kbd "c") "exec kitty")

(define-key *root-map* (kbd "d") "exec dmenu_run")

(define-key *root-map* (kbd "C-c") "exec chromium")

(define-key *root-map* (kbd "C-C") "exec dbeaver")

(define-key *root-map* (kbd "l") "move-focus right")

(define-key *root-map* (kbd "H") *help-map*)

(define-key *root-map* (kbd "k") "move-focus up")

(define-key *root-map* (kbd "j") "move-focus down")

(define-key *root-map* (kbd "L") "exec xlock -mode star -trek 1000")

(define-key *root-map* (kbd "F") "fullscreen")

(define-key *root-map* (kbd "h") "move-focus left")

;; audio
(define-key *top-map* (kbd "XF86AudioRaiseVolume") "exec wpctl set-volume @DEFAULT_SINK@ 5%+")
(define-key *top-map* (kbd "XF86AudioLowerVolume") "exec wpctl set-volume @DEFAULT_SINK@ 5%-")
(define-key *top-map* (kbd "XF86AudioMute") "exec wpctl set-mute @DEFAULT_SINK@ toggle")

;; brightness
(define-key *top-map* (kbd "XF86MonBrightnessDown") "exec brillo -U 5")
(define-key *top-map* (kbd "XF86MonBrightnessUp") "exec brillo -A 5")

;;; --- bluetooth ---------------------------------------------------

(defvar *bluetooth-command* "bluetoothctl"
  "Base command for interacting with bluetooth.")

(defun bluetooth-message (&rest message)
  (message (format nil
                   "^2Bluetooth:^7 ~{~A~^ ~}"
                   message)))

(defun bluetooth-make-command (&rest args)
  (format nil
          "~a ~{~A~^ ~}"
          *bluetooth-command*
          args))

(defmacro bluetooth-command (&rest args)E  `(run-shell-command (bluetooth-make-command ,@args) t))

(defmacro bluetooth-message-command (&rest args)
  `(bluetooth-message (bluetooth-command ,@args)))

(defcommand bluetooth-turn-on () ()
  "Turn on bluetooth."
  (bluetooth-message-command "power" "on"))

(defcommand bluetooth-turn-off () ()
  "Turn off bluetooth."
  (bluetooth-message-command "power" "off"))

(defstruct (bluetooth-device
             (:constructor
              make-bluetooth-device (&key (address "")
                                          (name nil)))
             (:constructor
              make-bluetooth-device-from-command
              (&key (raw-name "")
               &aux (address (cadr (cl-ppcre:split " " raw-name)))
                    (full-name (format nil "~{~A~^ ~}" (cddr (cl-ppcre:split " " raw-name)))))))
  address
  (full-name (progn
                 (format nil "~{~A~^ ~}" name))))

(defun bluetooth-get-devices ()
  (let ((literal-devices (bluetooth-command "devices")))
    (mapcar (lambda (device)
              (make-bluetooth-device-from-command :raw-name device))
     (cl-ppcre:split "\\n" literal-devices))))

(defun bluetooth-connect-device (device)
  (progn
    (bluetooth-turn-on)
    (cond ((bluetooth-device-p device) ;; it is a bluetooth-device structure
           (bluetooth-message-command "connect"
                                      (bluetooth-device-address device)))
          ((stringp device)            ;; assume it is a MAC address
           (bluetooth-message-command "connect" device))
          ((null device)
           (message "Abort."))
          (t (message (format nil "Cannot work with device ~a" device))))))

(defun bluetooth-disconnect-device (device)
  (progn
    (cond ((bluetooth-device-p device) ;; it is a bluetooth-device structure
           (bluetooth-message-command "disconnect"
                                      (bluetooth-device-address device)))
          ((stringp device)            ;; assume it is a MAC address
           (bluetooth-message-command "disconnect" device))
          ((null device)
           (message "Abort."))
          (t (message (format nil "Cannot work with device ~a" device))))))

(defcommand bluetooth-info () ()
  (bluetooth-message-command "info"))

(defcommand bluetooth-connect () ()
  (sb-thread:make-thread
   (lambda ()
    (let* ((devices (bluetooth-get-devices))
           (choice  (cadr (select-from-menu
                           (current-screen)
                           (mapcar (lambda (device)
                                     `(,(bluetooth-device-full-name device) ,device))
                                   devices)))))
      (bluetooth-connect-device choice)))))

(defcommand bluetooth-disconnect () ()
  (sb-thread:make-thread
   (lambda ()
    (let* ((devices (bluetooth-get-devices))
           (choice  (cadr (select-from-menu
                           (current-screen)
                           (mapcar (lambda (device)
                                     `(,(bluetooth-device-full-name device) ,device))
                                   devices)))))
      (bluetooth-disconnect-device choice)))))

(defcommand flatpak-run () ()
  (let* ((pak-list (run-shell-command "flatpak list | awk -F'\\t' 'NR > 0 { print $2 }'" t))
         (paks (cl-ppcre:split "\\n" pak-list))
         (pak (select-from-menu
               (current-screen)
               paks)))
    (run-shell-command (format nil "dbus-run-session flatpak run ~a" (car pak)))))

;; TODO:
;;; Audio Issues:
;;; If no mic:
;;; $ pacmd list-cards
;;; then find the card name (the stuff between the <>)
;;; $ pacmd set-card-profile <name> handsfree_head_unit