stumpwm/miscellaneous.lisp @ 7cb0e1e6a217

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

(defcached (weather :seconds 120) ()
  (losh:sh '("/home/sjl/src/dotfiles/lisp/bin/weather" "48105" "-H" "36") :result-type 'list))

(defcommand rain () ()
  (_ (weather)
    (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"))


(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)
    (message "Killed meeting")))


(defcommand ggo () ()
  (let* ((current-screen (current-screen))
         (current-group (stumpwm::screen-current-group current-screen))
         (all-groups (sort (copy-seq (screen-groups current-screen)) #'< :key #'group-number))
         (groups (mapcar (lambda (group)
                           (list (format nil "~2D~A~A"
                                         (group-number group)
                                         (if (eql current-group group) #\* #\space)
                                         (group-name group))
                                 group))
                         all-groups))
         (selected (select-from-menu current-screen groups)))
    (when selected (stumpwm::switch-to-group (second selected)))))

(defcommand grename-cwd () ()
  (when-let ((cwd (dwim-cwd)))
    (grename (pathname-name (pathname cwd)))))

(defcommand grenumber (new-number &optional (screen (current-screen))) ((:number "Number: "))
  "Change the current group's number to the specified number.

   If another group is using the number, then the groups swap numbers. Defaults
   to current screen.

  "
  ;; from https://pastebin.com/nSpqbjef
  (let* ((this-group (current-group screen))
         (current-number (group-number this-group))
         (other-group (find-if (lambda (grp) (= (group-number grp) new-number))
                               (screen-groups screen))))
    ;; If another group has the new number, change it to the number of the
    ;; current group.
    (when other-group
      (setf (group-number other-group) current-number))
    ;; Now, set the current group to the new number.
    (setf (group-number this-group) new-number)))

(defcommand repack-group-numbers () ()
  "Ensure that used group numbers do not have gaps."
  (loop :for i :from 1
        :for group in (sort (copy-seq (screen-groups (current-screen)))
                            #'<
                            :key #'group-number)
        :when (/= i (group-number group))
        :do (setf (group-number group) i)))

(defcommand gkill-and-repack () ()
  (gkill)
  (repack-group-numbers))

#; Scratch --------------------------------------------------------------------

(eq (screen-groups (current-screen))
    (screen-groups (current-screen)))

(sort (copy-seq (screen-groups (current-screen)))
                            #'<
                            :key #'group-number)