stumpwmrc @ 93292b5dede0

More
author Steve Losh <steve@stevelosh.com>
date Sat, 08 Jun 2019 12:07:02 -0400
parents 0b7bb860082f
children 25592561dd6f
(in-package :stumpwm-user)

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


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

(redirect-all-output (data-dir-file "debug" "text"))

(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
      *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 (&rest args)
  (with-open-file (s "/home/sjl/stumpwm.debug.log"
                     :direction :output
                     :if-exists :append
                     :if-does-not-exist :create)
    (apply #'format s 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))


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


;;;; 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-area () ()
  ;; todo why the hell do these not pick up my fuckin path?
  (run-shell-command "/home/sjl/src/dotfiles/bin/screenshot-area"))

(defcommand screenshot-screen () ()
  (run-shell-command "/home/sjl/src/dotfiles/bin/screenshot-screen"))


;;;; 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-single () ()
  (loop with laptop = "eDP1"
        with extern = "DP1"
        for (output commands) in `((,extern ("--off"))
                                   (,laptop ("--off"))

                                   (,laptop ("--auto"))
                                   (,extern ("--primary")))
        do (uiop:run-program `("xrandr" "--output" ,output ,@commands))))

(defcommand screen-multi () ()
  (loop with laptop = "eDP1"
        with extern = "DP1"
        for (output commands) in `((,extern ("--off"))
                                   (,laptop ("--off"))

                                   (,extern ("--auto"))
                                   (,extern ("--primary"))

                                   (,laptop ("--auto"))
                                   (,laptop ("--left-of" ,extern)))
        do (pr (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) ((:number "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 pass-personal () ()
  (let ((pass:*password-store* "/home/sjl/.password-store/")
        (pass:*pass-notification-message* t))
    (pass:pass-copy)))

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


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


;;;; EQ 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)
    ((:number "Minutes: ")
     (:number "Seconds: "))
  (setf *pop-timer-minutes* minutes
        *pop-timer-seconds* 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" "exec st")
  ("H-SunPageUp" "st-font-up")
  ("H-SunPageDown" "st-font-down")
  ("H-Home" "st-font-reset")
  ("H-\\" "pass-personal")
  ("H-b" "browser")
  ("H-B" "exec firefox")
  ("H-o" "spotify")
  ("H-q" "exec slock")
  ("H-y" "screenshot-area")
  ("H-Y" "screenshot-screen")
  ("H-r" "loadrc")
  ("H-V" "vlime"))

(define-top-keys ;; clipboard
  ("H-u" "generate-random-uuid"))

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

  ("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-single")
  ("H-F8" "screen-multi"))

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

(define-top-keys ;; timers
  ("s-F9"  "run-pop-timer")
  ("s-F10" "set-pop-timer"))

(define-top-keys ;; stump
  ("Pause" "exec st") ; jesus christ
  ("H-F10" "sleep-machine")
  ("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"))
    ("(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"))