stumpwm/miscellaneous.lisp @ 4f28fbfd7d63

More
author Steve Losh <steve@stevelosh.com>
date Tue, 09 Apr 2024 09:20:04 -0400
parents 4673e928c08e
children 4e1d6d6873fe
(in-package :stumpwm-user)

(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 toggle-current-mode-line () ()
  (toggle-mode-line (current-screen) (current-head)))

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

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

(defcommand sleep-machine ()
    ()
  (hostcase
    ((:gro :juss)
     (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" "48105" "-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"))

(defcommand start-vm () ()
  (echo "Starting VM.")
  (run-shell-command "/home/sjl/vms/run"))