stumpwmrc @ b67a34a9c6b0

(in-package :stumpwm-user)

(ql:quickload '(:losh :split-sequence :alexandria :parse-number) :silent t)
(use-package :losh)


;;;; Config -------------------------------------------------------------------
(set-prefix-key (kbd "C-space"))

(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")



;;;; 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 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 battery ()
  (run-shell-command
    "acpi -b | tail -n1 | awk -F '[ ,]' '{printf \"%s%s\", $3, $5}' | sed s/Discharging// | sed s/Unknown// | sed s/Full// | sed s/Charging/+/"
    t))


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


(defun debug-log (string &rest args)
  (with-open-file (s "/home/sjl/stumpwm.debug.log"
                     :direction :output
                     :if-exists :append
                     :if-does-not-exist :create)
    (apply #'format s string args)
    (fresh-line s))
  (first args))


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

(defparameter *host* (keywordize (run-shell-command "hostname" t)))

(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.")))))


;;;; 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"))))


;;;; Regroup ------------------------------------------------------------------
(defparameter *class-groups*
  '(("jetbrains-idea-ce" . "ij"))
  "An alist of window classes to be regrouped and their targets")

(defun regroup (win)
  "Regroup window by class."
  (let* ((class (window-class win))
         (target (cdr (assoc class *class-groups* :test #'string=))))
    (when target
      (let ((group (stumpwm::find-group (current-screen) target)))
        (when group
          (debug-log "Regrouping ~A window to ~A group.~%" class group)
          (move-window-to-group win group)
          (stumpwm::update-all-mode-lines))))))

(add-hook *new-window-hook* 'regroup)


;;;; 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 25 50 75 100))
(defvar *brightness-index* 5)

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

(defun rotate-brightness (delta)
  (setf *brightness-index*
        (mod+ *brightness-index* delta (length *brightness-values*)))
  (run-shell-command (format nil "xbacklight -set ~D" (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)
               (dotimes (i 10)
                 (move-focus (ecase direction
                               (:left :right)
                               (:right :left))))))
           (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 = "eDP1"
        with extern = "DP1"
        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 = "eDP1"
        with extern = "DP1"
        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 pass-work () ()
;;   (let ((pass:*password-store* "/home/sjl/.password-store-work/")
;;         (pass:*pass* "/home/sjl/src/dotfiles/bin/pass-work"))
;;     (pass:pass-copy)))

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

(defcommand sleep-machine ()
    ()
  (hostcase
    ((:alephnull :mobius)
     (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))


;;;; 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 "~/.terminal-font")
                                     (with-open-file (f "~/.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 ------------------------------------------------
(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."))


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

(defcommand intellij () ()
  (run-or-raise "~/intellij/bin/idea.sh" '(:class "jetbrains-idea-ce")))

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

(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")))


;;;; 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)))


;;;; 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 ;; application shortcuts
  ("H-m" "terminal")
  ("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-B" "exec firefox")
  ("H-o" "spotify")
  ("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-V" "vlime"))

(define-top-keys ;; clipboard
  ("H-u" "generate-random-uuid")
  ("H-U" "bee-movie-script")
  )

(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" "gmove 1")
  ("H-2" "gmove 2")
  ("H-3" "gmove 3")
  ("H-4" "gmove 4")

  ("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-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 ;; screen
  ("H-F5" "rotate-brightness-down")
  ("H-F6" "rotate-brightness-up")
  ("H-F7" "screen-laptop")
  ("H-F8" "screen-external"))

(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 ;; layout
  ("s-H-m" "restore-from-file ~/src/dotfiles/stumpwm/dev.lisp")
  ("s-H-s" "restore-from-file ~/src/dotfiles/stumpwm/streaming.lisp")
  ("s-H-w" "restore-from-file ~/src/dotfiles/stumpwm/work.lisp")
  ("s-H-z" "restore-from-file ~/src/dotfiles/stumpwm/zoom.lisp"))

(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"))

(define-top-keys ;; mouse
  ("F35" "next-in-frame")
  ("F34" "prev-in-frame"))



;; (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")
     ("C-w" . "C-BackSpace")
     ;; 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"))))


;;;; Modeline -----------------------------------------------------------------
(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"

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

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

      (hostcase
        ((:mobius :alephnull)
         '("(B "
           (:eval (princ-to-string (battery)))
           ")"
           " (BR "
           (:eval (princ-to-string (brightness)))
           "%)")))

      ;; time and tray
      (list " %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"))


;;;; Startup ------------------------------------------------------------------
(defvar *network-manager*
  (run-shell-command "nm-applet --sm-disable"))

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

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