stumpwmrc @ b0b362f528d5

More
author Steve Losh <steve@stevelosh.com>
date Thu, 31 Aug 2023 09:55:26 -0400
parents ebaf215e5d89
children 4ceaf6bc4210
(in-package :stumpwm-user)
(shadow :window)

(ql:quickload '(:losh :split-sequence :alexandria :parse-number :str :cl-ppcre :bordeaux-threads :jarl :local-time)
              :silent t)

(use-package :losh)

;;;; Config -------------------------------------------------------------------
(set-prefix-key (kbd "C-space"))
(local-time:reread-timezone-repository)

(defvar *redirected* (redirect-all-output (data-dir-file "debug" "log")))

(setf *mouse-focus-policy* :click
      *message-window-gravity* :center
      *input-window-gravity* :center
      *debug-level* 0
      *resize-increment* 75
      *new-frame-action* :empty
      *window-format* "(%n%m%20t)"
      *window-name-source* :title
      *maximum-completions* 20
      *shell-program* "/home/sjl/src/dotfiles/bin/bash-dammit"
      losh:*pbcopy-command* "/home/sjl/src/dotfiles/bin/pbcopy"
      losh:*pbpaste-command* "/home/sjl/src/dotfiles/bin/pbpaste")


;;;; Utils --------------------------------------------------------------------
(defun string-contains (needle string)
  (and (search needle string :test #'char=) t))

(defun string-grep (needle text &key first-only)
  (_ text
    (split-sequence:split-sequence #\newline _)
    (if first-only
      (find needle _ :test #'string-contains)
      (remove-if-not (alexandria:curry #'string-contains needle) _))))

(defun string-split (delimiters string)
  (split-sequence:split-sequence delimiters string
                                 :test (lambda (bag ch)
                                         (find ch bag :test #'char=))))

(defun run-and-echo-shell-command (command &rest args)
  (message command)
  (apply #'run-shell-command command args))


(defun mod+ (n increment modulo)
  (mod (+ n increment) modulo))


(defun volume ()
  (_ (run-shell-command "amixer sget Master" t)
    (string-grep "Front Left:" _ :first-only t)
    (string-split "[]" _)
    second
    (string-trim "%" _)
    parse-integer))


(defun current-frame ()
  (stumpwm::tile-group-current-frame (current-group)))


(defun keywordize (string)
  (_ string
    (string-trim (string #\newline) _)
    string-upcase
    (intern _ (find-package :keyword))))

(defparameter *host* (keywordize (machine-instance)))


(defmacro ehostcase (&body clauses)
  `(ecase *host* ,@clauses))

(defmacro hostcase (&body clauses)
  `(case *host* ,@clauses))


(defcommand speak (text)
    ((:string "Text: "))
  (message text)
  (run-shell-command (format nil "~~/src/dotfiles/bin/say '~A'" text)))


(defun seconds->hours (seconds)
  (/ seconds 60 60))

(defun hours->seconds (hours)
  (* hours 60 60))


(define-stumpwm-type :integer (input prompt)
  ;; Annoyingly, StumpWM's built-in :number type isn't actually number, but is
  ;; actually just integers.  Define a better-named type here.
  (when-let ((n (or (argument-pop input)
                    (read-one-line (current-screen) prompt))))
    (handler-case
        (parse-integer n)
      (parse-error (c)
        (declare (ignore c))
        (throw 'error "Integer required.")))))

(define-stumpwm-type :real (input prompt)
  (when-let ((n (or (argument-pop input)
                    (read-one-line (current-screen) prompt))))
    (handler-case
        (let ((result (parse-number:parse-number n)))
          (assert (typep result 'real))
          result)
      (error (c)
        (declare (ignore c))
        (throw 'error "Real required.")))))


(defun window-match-p (query window)
  "Return whether `window` matches `query`.

  `query` must be of the form `(query-type query-value)`.

  `query-type` must be one of `:title` or `:class`.

  `query-value` must either be a string (which must be matched exactly) or
  a PPCRE scanner.

  "
  (destructuring-bind (query-type query) query
    (let ((value (ecase query-type
                   (:title (window-title window))
                   (:class (window-class window)))))
      (etypecase query
        (string (string= query value))
        (function (ppcre:scan query value))))))

(defun all-windows ()
  "Return a fresh list of all windows on all screens.  Yes, all of them."
  (mapcan #'screen-windows *screen-list*))

(defun find-window (query)
  "Find and return the first window that matches `query` under `window-match-p`."
  (find-if (lambda (w) (window-match-p query w)) (all-windows)))

(defun find-windows (query)
  "Find and return a fresh list of all windows that match `query` under `window-match-p`."
  (remove-if-not (lambda (w) (window-match-p query w)) (all-windows)))

(defmacro when-let-window ((symbol title-query) &body body)
  `(when-let ((,symbol (find-window `(:title ,(ppcre:create-scanner ,title-query)))))
     ,@body))


;;;; Posture ------------------------------------------------------------------
(defparameter *posture-thread* nil)
(defparameter *posture-should-stop* nil)
(defparameter *posture-paused* nil)
(defparameter *posture-snooze* nil)
(defparameter *posture-current* 30)
(defparameter *posture-min* 5)
(defparameter *posture-max* (hours->seconds 2))

(defun posture-paused-p ()
  ;; this is the dumbest shit ever, but I can't figure out how to call into
  ;; stumpish from the setguid slock process
  (or *posture-paused* (probe-file "/tmp/.posture-pause")))

(defun posture-snoozed-p ()
  (and *posture-snooze*
       (< (get-universal-time) *posture-snooze*)))

(defcommand posture-pause () ()
  (message "Pausing posture.")
  (setf *posture-paused* t))

(defcommand posture-unpause () ()
  (message "Unpausing posture.")
  (setf *posture-paused* nil))

(defcommand posture-toggle-pause () ()
  (if (setf *posture-paused* (not *posture-paused*))
    (message "Posture is now paused.")
    (message "Posture is now unpaused.")))

(defcommand posture-snooze (hours)
    ((:real "Snooze for how many hours? "))
  (setf *posture-snooze* (+ (hours->seconds hours) (get-universal-time))))

(defun posture-update (delta)
  (setf *posture-current*
        (clamp *posture-min* *posture-max* (* *posture-current* delta))))

(defun posture-query ()
  (speak "Is your posture okay?"))

(defcommand posture-answer-yes () ()
  (message "Good work.")
  (run-shell-command "echo $(epochseconds) 1.0 >> ~/.posture.log")
  (posture-update 11/10))

(defcommand posture-answer-meh () ()
  (message "Better than nothing.")
  (run-shell-command "echo $(epochseconds) 0.5 >> ~/.posture.log"))

(defcommand posture-answer-no () ()
  (message "Try harder.")
  (run-shell-command "echo $(epochseconds) 0.0 >> ~/.posture.log")
  (posture-update 8/10))

(defun posture% ()
  (if *posture-should-stop*
    nil
    (progn (unless (or (posture-paused-p) (posture-snoozed-p))
             (posture-query)
             (sleep 10))
           *posture-current*)))

(defun posture-running-p ()
  (and *posture-thread* (sb-thread:thread-alive-p *posture-thread*)))

(defcommand posture-stop () ()
  (setf *posture-should-stop* t))

(defcommand posture-start () ()
  (setf *posture-should-stop* nil)
  (if (posture-running-p)
    (message "Posture loop was already running.")
    (setf *posture-thread*
          (sb-thread:make-thread
            (lambda ()
              (loop :for seconds = (posture%)
                    :while seconds
                    :do (sleep seconds))
              (message "Posture loop exiting."))
            :name "Posture thread"))))


;;;; Budget ------------------------------------------------------------------
(defparameter *tz/eastern*
  (local-time:find-timezone-by-location-name "US/Eastern"))

(defparameter *budget/start*
  (local-time:encode-timestamp 0 0 0 0 29 8 2023 :timezone *tz/eastern*))

(defun budget/per-day ()
  (first (losh:read-all-from-file "/home/sjl/Sync/budget/per-day")))

(defun budget/elapsed ()
  (local-time:timestamp-difference (local-time:now) *budget/start*))

(defun budget/days-elapsed ()
  (floor (/ (budget/elapsed) (* 60 60 24))))

(defun budget/in ()
  (* (budget/days-elapsed) (budget/per-day)))

(defun budget/out ()
  (loop :for path :in (directory "/home/sjl/Sync/budget/hosts/*/total")
        :summing (print (first (read-all-from-file (print path))))))

(defun budget/current ()
  (- (budget/in) (budget/out)))

(defcommand budget-dump () ()
  (message
    (sh '("sh" "-c" "tail -n 5 /home/sjl/Sync/budget/hosts/*/records")
        :result-type 'string)))

(defcommand budget () ()
  (message "$~D" (budget/current)))

(defmacro with-budget-file ((f file &rest open-args) &body body)
  `(with-open-file
     (,f (format nil "/home/sjl/Sync/budget/hosts/~(~A~)/~A" *host* ,file)
      ,@open-args)
     ,@body))

(defcommand spend (amount what) ((:integer "Amount: $") (:string "For: "))
  (let ((current (with-budget-file (total "total")
                   (first (read-all-from-file total))))
        (timestamp (local-time:to-rfc3339-timestring (local-time:now))))
    (with-budget-file (total "total" :direction :output :if-exists :supersede)
      (print (+ current amount) total))
    (with-budget-file (records "records" :direction :output :if-exists :append :if-does-not-exist :create)
      (print (list timestamp amount what) records))
    (message "Spent $~D for ~A at ~A" amount what timestamp)))


;;;; Load ---------------------------------------------------------------------
(load-module "pass")

;;;; Screenshotting -----------------------------------------------------------
(defcommand screenshot () ()
  (run-shell-command "screenshot"))

(defcommand save-fucked-screenshot () ()
  (run-shell-command "broken-screenshot"))

(defcommand delete-fucked-screenshot () ()
  (run-shell-command "delete-broken-screenshot"))


;;;; Brightness ---------------------------------------------------------------
(defparameter *brightness-values* #(0 1 5 10 20 30 40 55 70 85 100))
(defvar *brightness-index* 5)

(defun brightness ()
  (aref *brightness-values* *brightness-index*))

(defun set-brightness (value)
  (run-and-echo-shell-command
    (hostcase
      ((:gro) (format nil "xrandr --output ~A --brightness ~D"
                      (hostcase (:gro "eDP"))
                      (/ value 100.0)))
      (t (message "Not sure how to set brightness on this machine.")))))

(defun rotate-brightness (delta)
  (setf *brightness-index*
        (mod+ *brightness-index* delta (length *brightness-values*)))
  (set-brightness (brightness)))


(defcommand rotate-brightness-up () ()
  (rotate-brightness 1))

(defcommand rotate-brightness-down () ()
  (rotate-brightness -1))


;;;; Miscellaneous ------------------------------------------------------------
(defcommand sane-hsplit () ()
  (hsplit)
  (move-focus :right))

(defcommand sane-vsplit () ()
  (vsplit)
  (move-focus :down))


(defcommand move-focus* (direction)
    ((:direction "Enter a direction: "))
  (labels ((in-float-p ()
             (typep (current-group) 'stumpwm::float-group))
           (focus-first-frame ()
             (unless (in-float-p)
               ;; After moving to a new group we don't know which frame is
               ;; focused, and unfortunately Stump doesn't give us a nice way to
               ;; say "focus the leftmost frame" so we'll just move the focus
               ;; a bunch of times and hope it's enough.  Sigh.
               (loop :repeat 15
                     :until (eql (current-frame)
                                 (progn (move-focus (ecase direction
                                                      (:left :right)
                                                      (:right :left)))
                                        (current-frame))))))
           (next-group ()
             (ecase direction
               (:right (gnext))
               (:left (gprev)))
             (focus-first-frame)))
    (unless (in-float-p)
      (banish))
    (if (in-float-p)
      (next-group)
      (let ((frame (current-frame)))
        (move-focus direction)
        (when (eql frame (current-frame))
          (next-group))))))

(defcommand screen-laptop () ()
  (only)
  (loop :with laptop = "eDP-1"
        :with extern = "DP-1"
        :for (output commands) :in `((,laptop ("--auto"))
                                   (,laptop ("--primary"))
                                   (,extern ("--off")))
        :do (progn (uiop:run-program `("xrandr" "--output" ,output ,@commands)))))

(defcommand screen-external () ()
  (only)
  (loop :with laptop = "eDP-1"
        :with extern = "DP-1"
        :for (output commands) :in `(
                                     ;; (,laptop ("--off"))
                                     (,extern ("--auto"))
                                     (,extern ("--primary"))
                                     (,laptop ("--auto"))
                                     (,laptop ("--left-of" ,extern))
                                     )
        :do (uiop:run-program `("xrandr" "--output" ,output ,@commands))))

(defcommand vlime () ()
  (load "~/src/dotfiles/vim/bundle/vlime/lisp/start-vlime.lisp")
  (message "Started VLIME"))

(defcommand vlime-port (port) ((:integer "Port: "))
  "Start VLIME on the given port.

  Good for bootstrapping a VLIME connection when you accidentally started a
  VLIME instance on another port that you don't want to mess with.

  "
  (funcall (read-from-string "vlime-loader::run") port)
  (message "Started VLIME"))

(defcommand toggle-current-mode-line () ()
  (toggle-mode-line (current-screen) (current-head)))

(defcommand toggle-stumptray () ()
  (run-commands "stumptray"))

(defcommand pass-personal () ()
  (let ((pass:*password-store* "/home/sjl/.password-store/")
        (pass:*pass-notification-message* t))
    (pass:pass-copy)))

(defcommand generate-password () ()
  (run-shell-command "genpass | pbc")
  (message "Generated a fresh password and copied it to the clipboard."))

(defcommand kill-and-remove () ()
  (run-commands "kill" "remove"))

(defcommand sleep-machine ()
    ()
  (hostcase
    ((:gro)
     (run-shell-command "exec lock-screen")
     (run-shell-command "systemctl suspend"))
    (t (message "Not sleeping this machine for safety."))))

(defcommand copy-clhs-url (s)
    ((:string "Symbol: "))
  (run-shell-command (format nil "clhs --url 'http://www.lispworks.com/documentation/HyperSpec/' --quiet --open echon '~A' | pbcopy" s)))

(defcommand describe-window () ()
  (show-window-properties))

(defcommand rain () ()
  (_ '("/home/sjl/src/dotfiles/lisp/bin/weather" "-H" "36")
    (losh:sh _ :result-type 'list)
    (mapcar (lambda (line) (ppcre:regex-replace " 1[0-9]:00 " line "^6\\&^*")) _)
    (message "~{~A~^~%~}" _)))

(defcommand mark (thing) ((:string "Mark: "))
  (run-shell-command (format nil "mark ~A" thing)))

(defcommand toggle-zoom-mute () ()
  (when-let-window (win "^Zoom Meeting.*")
    ;; Zoom stupidly won't accept the shortcut unless it's in focus
    (unless (eql (window-group win) (current-group))
      ;;        jesus            christ        stump just export switch-to-group come on
      (gselect (princ-to-string (group-number (window-group win)))))
    (focus-window win t)
    (meta (kbd "M-a"))))

(defcommand end-zoom () ()
  (when-let-window (win "^Zoom Meeting.*")
    (kill-window win))
  (sleep 2)
  (when-let-window (win "^Zoom -.*")
    (kill-window win)))

(defcommand clear-notifications () ()
  (run-shell-command "dunstctl close-all"))



;;;; Terminal Fonts -----------------------------------------------------------
(defcommand reload-terminal-font-size ()
    ()
  (setf *terminal-font-size*
        (if (probe-file "/home/sjl/.terminal-font")
          (with-open-file (f "/home/sjl/.terminal-font")
            (read f))
          11)))

(defparameter *terminal-font-size* (if (probe-file "/home/sjl/.terminal-font")
                                     (with-open-file (f "/home/sjl/.terminal-font")
                                       (read f))
                                     11))

(defcommand st-font-up ()
    ()
  (loop :repeat 7 :do (meta (kbd "C-S-SunPageUp"))))

(defcommand st-font-down ()
    ()
  (loop :repeat 7 :do (meta (kbd "C-S-SunPageDown"))))

(defcommand st-font-reset ()
    ()
  (meta (kbd "C-S-Home")))


;;;; Clipboard/Data Generation ------------------------------------------------
(load-module "clipboard-history")
(clipboard-history:start-clipboard-manager)

(defcommand generate-random-uuid () ()
  (run-shell-command "uuidgen | tr -d '\\n' | ~/src/dotfiles/bin/pbcopy")
  (message "Copied random UUID to clipboard."))

(defcommand bee-movie-script () ()
  (run-shell-command "pbeecopy")
  (message "Copied the entire Bee Movie script to clipboard."))

(defcommand urlize-jira-issue () ()
  (let ((issue (str:trim (pbpaste))))
    (if (ppcre:scan "^[A-Z0-9]+-\\d+$" issue)
      (let* ((endpoint (str:trim (run-shell-command "grep endpoint .jira.d/config.yml | sed -e 's/.*: //'" t)))
             (url (format nil "~A/browse/~A" endpoint issue)))
        (pbcopy url)
        (message "Copied ~A to the clipboard." url))
      (message "Clipboard does not look like a JIRA issue."))))


;;;; Applications -------------------------------------------------------------
(defcommand spotify () ()
  (run-or-raise "spotify" '(:class "Spotify")))

(defcommand files () ()
  (run-shell-command "open $HOME"))

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

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

(defcommand terminal () ()
  (run-shell-command (format nil "st -f 'Ubuntu Mono:size=~D'" *terminal-font-size*)))

(defcommand gcontrol () ()
  (run-or-raise "gcontrol" '(:class "Gnome-control-center")))

(defcommand zoom () ()
  (when-let-window (w "^Zoom Meeting.*")
    (focus-window w t)))


;;;; Timers -------------------------------------------------------------------
(defparameter *pop-timer-minutes* nil)
(defparameter *pop-timer-seconds* nil)

(defun pop-timer ()
  (if (or (null *pop-timer-minutes*)
          (null *pop-timer-seconds*))
    (message "Pop timer is not configured.")
    (progn
      (message "Setting pop timer for ~D:~2,'0D."
               *pop-timer-minutes* *pop-timer-seconds*)
      (let* ((warning-time 30)
             (total-time (+ (* *pop-timer-minutes* 60) *pop-timer-seconds*))
             (initial-time (- total-time warning-time)))
        (sb-thread:make-thread
          (lambda ()
            (if (plusp initial-time)
              (progn (sleep initial-time)
                     (speak "Pop soon.")
                     (sleep warning-time))
              (sleep total-time))
            (speak "Pop!"))
          :name "Pop Timer")))))

(defcommand run-pop-timer () ()
  (pop-timer))

(defcommand set-pop-timer (minutes seconds)
    ((:integer "Minutes: ")
     (:integer "Seconds: "))
  (setf *pop-timer-minutes* minutes
        *pop-timer-seconds* seconds))

(defcommand tea-timer (seconds)
    ((:integer "Seconds: "))
  (run-shell-command (format nil "tea ~D" seconds)))


;;;; Isk ----------------------------------------------------------------------
(defcommand send-key (key &optional (win (current-window))) (:key)
  "Send key press and key release events for KEY to window WIN."
  ;; from https://github.com/alezost/stumpwm-config/blob/master/utils.lisp
  (let ((xwin (window-xwin win)))
    (multiple-value-bind (code state) (stumpwm::key-to-keycode+state key)
      (flet ((send (event)
               (xlib:send-event xwin event (xlib:make-event-mask event)
                                :display *display*
                                :root (screen-root (window-screen win))
                                :x 0 :y 0 :root-x 0 :root-y 0
                                :window xwin :event-window xwin
                                :code code
                                :state state)))
        (send :key-press)
        (send :key-release)
        (xlib:display-finish-output *display*)))))

(defun send-keys (keys &key (win (current-window)) (sleep 0))
  (dolist (k keys)
    (send-key (kbd k) win)
    (sleep sleep)))

(defmacro defmultikey (name key compose-keys)
  ;; Unfortunately we can't reliably autogen the name with something like
  ;; (symb 'mk- compose-key) here because things like đ (th) and Đ (TH) would
  ;; case fold to the same name.
  `(progn
     (defcommand ,name () ()
       (send-keys '("Multi_key" ,@(map 'list #'string compose-keys))))
     (define-key *top-map*
       (kbd ,key) ,(string name))))

(defmacro defmultikeys (&rest bindings)
  `(progn ,@(loop for binding :in bindings :collect `(defmultikey ,@binding))))

(defmultikeys
  (isk-l-á "M-a" "'a")
  (isk-u-Á "M-A" "'A")
  (isk-l-é "M-e" "'e")
  (isk-u-É "M-E" "'E")
  (isk-l-í "M-i" "'i")
  (isk-u-Í "M-I" "'I")
  (isk-l-ó "M-o" "'o")
  (isk-u-Ó "M-O" "'O")
  (isk-l-ö "M-m" "\"o")
  (isk-u-Ö "M-M" "\"O")
  (isk-l-ú "M-u" "'u")
  (isk-u-Ú "M-U" "'U")
  (isk-l-ý "M-y" "'y")
  (isk-u-Ý "M-Y" "'Y")
  (isk-l-þ "M-t" "th")
  (isk-u-Þ "M-T" "TH")
  (isk-l-đ "M-d" "dh")
  (isk-u-Đ "M-D" "DH")
  (isk-l-æ "M-h" "ae")
  (isk-u-Æ "M-H" "AE"))


;;;; Key Mapping --------------------------------------------------------------
;;; Conventions:
;;;
;;; * Hyper-dir: move focus
;;; * Hyper-Shift-dir: move window
;;; * Hyper-Shift-Control-dir: swap window
;;; * Hyper-F*: hardware
;;; * Shift-F*: timers
;;; * Hyper-Super-*: layout
;;; * Hyper-*: miscellaneous

(defmacro define-top-keys (&body keyforms)
  `(progn ,@(loop :for form :in keyforms
                  :collect `(define-key *top-map*
                              (kbd ,(first form))
                              ,(second form)))))


(define-top-keys ;; miscellaneous
  ("H-m" "terminal")
  ("H-M" "mark")
  ("H-SunPageUp" "st-font-up")
  ("H-SunPageDown" "st-font-down")
  ("H-Home" "st-font-reset")
  ("H-\\" "pass-personal")
  ("H-|" "generate-password")
  ("H-b" "browser")
  ("H-O" "spotify")
  ("H-o" "files")
  ("H-z" "zoom")
  ("H-Z" "toggle-zoom-mute")
  ("C-H-Z" "end-zoom")
  ("F26"   "prev")
  ("S-F26" "next")
  ("H-q" "exec lock-screen")
  ("H-y" "screenshot")
  ("H-g" "gcontrol")
  ("H-f" "save-fucked-screenshot")
  ("H-F" "delete-fucked-screenshot")
  ("H-R" "loadrc")
  ("H-r" "rain")
  ("H-V" "vlc")
  ("H-4" "budget")
  ("H-$" "spend")
  ("C-BackSpace" "clear-notifications")
  )

(define-top-keys ;; clipboard
  ("H-c" "show-clipboard-history")
  ("H-C" "clear-clipboard-history")
  ("H-u" "generate-random-uuid")
  ("H-B" "bee-movie-script")
  ("M-H-u" "urlize-jira-issue"))

(define-top-keys ;; movement
  ("H-h" "move-focus* left")
  ("H-j" "move-focus down")
  ("H-k" "move-focus up")
  ("H-l" "move-focus* right")

  ("H-H" "move-window left")
  ("H-J" "move-window down")
  ("H-K" "move-window up")
  ("H-L" "move-window right")

  ("H-1" "gselect 1")
  ("H-2" "gselect 2")
  ("H-3" "gselect 3")

  ("H-!" "gmove 1")
  ("H-@" "gmove 2")
  ("H-#" "gmove 3")

  ("C-H-H" "exchange-direction left")
  ("C-H-J" "exchange-direction down")
  ("C-H-K" "exchange-direction up")
  ("C-H-L" "exchange-direction right")

  ("H-`" "next")
  ("H-~" "prev") ;; "
  ("H-n" "next-in-frame")
  ("H-p" "prev-in-frame")
  ("H-N" "pull-hidden-next")
  ("H-P" "prev-in-frame")

  ("H-," "pull-from-windowlist"))

(define-top-keys ;; splitting
  ("H-s" "sane-vsplit")
  ("H-v" "sane-hsplit")
  ("H-=" "balance-frames"))

(define-top-keys ;; killing
  ("H-w" "delete")
  ("H-W" "kill")
  ("H-BackSpace" "remove")
  ("S-H-BackSpace" "kill-and-remove"))

(define-top-keys ;; naming
  ("H-'" "title"))

(define-top-keys ;; sound
  ("H-F1" "mute")
  ("H-F2" "exec amixer -q sset Master 5%-")
  ("H-F3" "exec amixer -q sset Master 5%+"))

(define-top-keys ;; screen
  ("H-F5" "rotate-brightness-down")
  ("H-F6" "rotate-brightness-up")
  ("H-F7" "screen-laptop")
  ("H-F8" "screen-external"))

(define-top-keys ;; layout
  ("s-H-t" "restore-from-file thirds")
  ("s-H-m" "restore-from-file dev")
  ("s-H-s" "restore-from-file streaming")
  ("s-H-w" "restore-from-file work")
  ("s-H-z" "restore-from-file zoom"))

(define-top-keys ;; timers
  ("s-F7"  "tea-timer")
  ("s-F9"  "run-pop-timer")
  ("s-F8"  "set-pop-timer")
  ("s-p"   "posture-start")
  ("s-P"   "posture-stop")
  ("s-y"   "posture-answer-yes")
  ("s-h"   "posture-answer-meh")
  ("s-n"   "posture-answer-no")
  ("s-\\"  "posture-toggle-pause")
  ("s-o"   "posture-snooze"))

(define-top-keys ;; stump
  ("Pause" "terminal") ; jesus christ
  ("H-F9"  "sleep-machine")
  ("H-F10" "toggle-stumptray")
  ("H-F11" "toggle-current-mode-line")
  ("H-F12" "refresh-heads"))


;; (stumpwm::unbind-remapped-keys)
(define-remapped-keys
  '(("st-256color"
     ("s-c" . "C-C")
     ("s-v" . "C-V")
     ("C-=" . "S-C-SunPageUp")
     ("C--" . "S-C-SunPageDown")
     ("C-0" . "S-C-Home"))
    ("(firefox|Google-chrome|Chromium-browser)"
     ("s-1" . "C-S-Tab")
     ("s-2" . "C-Tab")
     ("C-a" . "Home")
     ("C-e" . "End")
     ;; I always try to hit ctrl-d to kill a browser window because I'm so used
     ;; to terminal windows, and it ends up bookmarking the damn page.  In the
     ;; interest of not having a random collection of bookmarks grow over time,
     ;; I'll just add a mapping to compensate for my stupid brain.
     ("C-d" . "C-w")
     ;; todo debug why this breaks a really fast C-a-k roll
     ;; ("C-a" . "Home")
     ;; ("C-e" . "End")
     ("s-a" . "C-a")
     ("s-d" . "C-d")
     ("s-l" . "C-l")
     ("s-t" . "C-t")
     ("s-w" . "C-w")
     ("s-r" . "C-r")
     ("s-f" . "C-f")
     ("s-z" . "C-z")
     ("s-x" . "C-x")
     ("s-c" . "C-c")
     ("s-v" . "C-v"))
    (""
     ("s-z" . "C-z")
     ("s-x" . "C-x")
     ("s-c" . "C-c")
     ("s-v" . "C-v"))))


;;;; Sensors ------------------------------------------------------------------
(defun ? (obj &rest keys)
  (if (null keys)
      obj
      (apply #'? (etypecase obj
                   (hash-table (gethash (first keys) obj)))
             (rest keys))))

(defun parse-sensors ()
  ;; sensors -j is stupid and will output errors before the actual output on
  ;; standard out, instead of putting them on standard err like a reasonable
  ;; program, e.g.:
  ;;
  ;;     ERROR: Can't get value of subfeature temp1_input: Can't read
  ;;     {
  ;;        "iwlwifi_1-virtual-0":{ … },
  ;;        …
  ;;
  ;; So we'll have to drop the `ERROR` lines before we can get to the actual
  ;; goddamn JSON.  UNIX programs are so great.
  (let ((s (losh:sh '("sensors" "-j") :result-type 'stream)))
    (loop :while (char= #\E (peek-char nil s)) :do (read-line s))
    (jarl:read t s)))

(defparameter *sensors-refresh-delay* 5.0 "How long between sensor refreshes (in seconds).")
(defparameter *sensors-next-refresh* nil)
(defparameter *sensors-cache* nil)

(defun sensors% (&aux (sensors (parse-sensors)))
  (hostcase
    (:ouroboros (format nil "[CPU ~D°C] [GPU ~D°C ~D°C ~D°C]"
                        (round (? sensors "nct6779-isa-0290" "CPUTIN" "temp2_input"))
                        (round (? sensors "amdgpu-pci-4500"  "edge"     "temp1_input"))
                        (round (? sensors "amdgpu-pci-4500"  "junction" "temp2_input"))
                        (round (? sensors "amdgpu-pci-4500"  "mem"      "temp3_input"))))
    (:gro (format nil "[CPU ~D°C] [GPU ~D°C]"
                        (round (? sensors "thinkpad-isa-0000" "CPU"  "temp1_input"))
                        (round (? sensors "amdgpu-pci-0600"   "edge" "temp1_input"))))
    (t "?")))

(defun sensors (&aux (now (get-internal-real-time)))
  (if (or (null *sensors-next-refresh*)
          (>= now *sensors-next-refresh*))
      (setf *sensors-next-refresh* (+ now (* internal-time-units-per-second *sensors-refresh-delay*))
            *sensors-cache* (sensors%))
      *sensors-cache*))

(defun sensors-modeline (ml)
  (declare (ignore ml))
  (sensors))

(add-screen-mode-line-formatter #\S #'sensors-modeline)


;;;; Modeline -----------------------------------------------------------------
(load-module "battery-portable")
(load-module "cpu")
(load-module "hostname")
(load-module "mem")

(defun ensure-mode-line ()
  (when (not (stumpwm::head-mode-line (current-head)))
    (toggle-mode-line (current-screen) (current-head))))


(defun configure-modeline ()
  (setf
    *time-modeline-string*
    "%a %b %e %H:%M"

    cpu::*cpu-usage-modeline-fmt*
    "^[~A~3D%^]"

    cpu::*cpu-modeline-fmt*
    "[%c] [%f]"

    mem::*mem-modeline-fmt*
    "%b"

    *screen-mode-line-format*
    (append
      (list "[^B%n^b@%h] %W^>")

      #+todo-some-day (list ;; "(V "
                            ;; ;; '(:eval (volume))
                            ;; ")"
                            " ")

      ;; battery and brightness for laptops
      (hostcase
        ((:gro)
         '("(B %B)"
           " (BR "
           (:eval (princ-to-string (brightness)))
           "%)")))

      ;; temp, cpu, mem, time, tray
      #+no (list "(TEMP %S) (CPU %C) (MEM %M) %d %T")
      (list "(CPU %C) (MEM %M) %d %T")
      ))

  (setf *mode-line-timeout* 10)
  (setf *mode-line-background-color* "#111111")

  (ensure-mode-line)
  )

(configure-modeline)


;;;; System Tray --------------------------------------------------------------
(load-module "stumptray")
(defvar *tray-loaded* (run-commands "stumptray"))


;;;; Unbreak Typing -----------------------------------------------------------
(defun stumpwm::input-insert-hyphen-or-space (input key)
  (declare (ignore key))
  (input-insert-char input #\space))


;;;; Startup ------------------------------------------------------------------
;; (defvar *dropbox*
  ;; (run-shell-command "~/.dropbox-dist/dropboxd"))

#+no(defvar *dunst*
  (run-shell-command "/usr/bin/dunst -conf ~/.dunstrc"))

(when (probe-file "/home/sjl/.stumpwmrc.local")
  (load "/home/sjl/.stumpwmrc.local"))


#;;; Scratch ------------------------------------------------------------------