More
| author |
Steve Losh <steve@stevelosh.com> |
| date |
Thu, 11 Nov 2021 14:12:49 -0500 |
| parents |
2d5474ce49c7 |
| children |
b7239c572353 |
(in-package :stumpwm-user)
(ql:quickload '(:losh :split-sequence :alexandria :parse-number :str :cl-ppcre :bordeaux-threads) :silent t)
(shadow 'window)
(use-package :losh)
;;;; Config -------------------------------------------------------------------
(set-prefix-key (kbd "C-space"))
(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 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"))))
;;;; 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 set-brightness (value)
(run-shell-command
(hostcase
((:mobius :alephnull) (format nil "xbacklight -set ~D" value))
((:papyrifera) (format nil "xrandr --output eDP --brightness ~D" (/ 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 = "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 ("--right-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
((:alephnull :mobius :papyrifera)
(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 unfuck-zoom-link () ()
(let ((url (pbpaste)))
(ppcre:register-groups-bind
(meeting-id meeting-pass)
("^https://[a-zA-Z0-9]+[.]zoom[.]us/j/(\\d+)[?]pwd=([A-Za-z0-9]+)$" url)
(pbcopy meeting-id)
(message "Zoom meeting ID copied.")
(bt:make-thread (lambda ()
(sleep 3)
(pbcopy meeting-pass)
(message "Zoom meeting password copied.")
(sleep 5)
(pbcopy ""))
:name "Zoom Link Defuckulator")
(return-from unfuck-zoom-link))
(message "Clipboard doesn't seem to be a Zoom link.")))
(defcommand rain () ()
(message (run-shell-command "weather -H 36" t)))
(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)))
;;;; 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)))
;;;; 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-B" "exec firefox")
("H-O" "spotify")
("H-o" "files")
("H-z" "zoom")
("XF86Launch8" "toggle-zoom-mute")
("H-XF86Launch8" "end-zoom")
("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"))
(define-top-keys ;; clipboard
("H-c" "show-clipboard-history")
("H-C" "clear-clipboard-history")
("H-u" "generate-random-uuid")
("H-U" "bee-movie-script")
("M-H-u" "urlize-jira-issue")
("H-Z" "unfuck-zoom-link"))
(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")
("H-5" "gmove 5")
("H-6" "gmove 6")
("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 ;; 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")
("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 -----------------------------------------------------------------
(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] [%t] [%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
((:mobius :alephnull :papyrifera)
'("(B %B)"
" (BR "
(:eval (princ-to-string (brightness)))
"%)")))
;; cpu, time, tray
(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 *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"))
(when (probe-file "/home/sjl/.stumpwmrc.local")
(load "/home/sjl/.stumpwmrc.local"))
#;;; Scratch ------------------------------------------------------------------
(message (format nil "~S" (remove #\newline (run-shell-command "acpi" t))))