stumpwm/miscellaneous.lisp @ 46fd11ae3808

Merge
author Steve Losh <steve@stevelosh.com>
date Thu, 13 Jun 2024 12:30:10 -0400
parents cf74bfa5845a
children 8e22b36e5cba
(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 clear-notifications () ()
  (run-shell-command "dunstctl close-all"))

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


(defun send-igv-command (string)
  (usocket:with-client-socket (socket stream "127.0.0.1" 60151)
    (unwind-protect (progn (write-line string stream)
                           (force-output stream))
      (usocket:socket-close socket))))

(defvar *igv/supplementary-alignments* t)

(defcommand igv/toggle-supplementary-alignments () ()
  (callf *igv/supplementary-alignments* #'not)
  (send-igv-command
    (format nil "preference SAM.FILTER_SUPPLEMENTARY_ALIGNMENTS ~A"
            (if *igv/supplementary-alignments* "FALSE" "TRUE")))
  (echo (if *igv/supplementary-alignments*
            "Supplementary alignments now on."
            "Supplementary alignments now off.")))