stumpwm/utils.lisp @ a65fd2691c94 default tip

(in-package :stumpwm-user)

(defun send-key% (key &optional (win (current-window)))
  "Send key press and key release events for KEY to window WIN."
  ;; from https://github.com/alezost/stumpwm-config/blob/master/utils.lisp
  (let ((xwin (window-xwin win)))
    (multiple-value-bind (code state) (stumpwm::key-to-keycode+state key)
      (flet ((send (event)
               (xlib:send-event xwin event (xlib:make-event-mask event)
                                :display *display*
                                :root (screen-root (window-screen win))
                                :x 0 :y 0 :root-x 0 :root-y 0
                                :window xwin :event-window xwin
                                :code code
                                :state state)))
        (send :key-press)
        (send :key-release)
        (xlib:display-finish-output *display*)))))

(defcommand send-key (key &optional (win (current-window))) (:key)
  "Send key press and key release events for KEY to window WIN."
  (send-key% key win))


(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 run-and-echo-shell-command (command &rest args)
  (message command)
  (apply #'run-shell-command command args))


(defun mod+ (n increment modulo)
  (mod (+ n increment) modulo))


(defmacro defcached ((name &key seconds) &body body)
  (let ((seconds (coerce seconds 'double-float)))
    (with-gensyms (ttl next value)
      `(let ((,ttl ,seconds)
             (,next nil)
             (,value nil))
         (defun ,name ()
           (when (or (null ,next)
                     (>= (get-internal-real-time) ,next))
             (setf ,next (+ (get-internal-real-time)
                            (* internal-time-units-per-second ,ttl))
                   ,value (progn ,@body)))
           ,value)
         (defun ,(symb name '/uncache) ()
           (setf ,next nil ,value nil))))))


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


(defun dwim-cwd (&optional (window (current-window)))
  (recursively ((proc (process-info (window-pid window)))
                (depth 0))
    (or (first (mapcar (lambda (child)
                         (recur child (1+ depth)))
                       (children proc)))
        (cwd proc))))