stumpwm
This commit is contained in:
parent
ffe09e4db0
commit
aee99b1c2b
|
|
@ -0,0 +1,89 @@
|
|||
;; ----- Colors -----
|
||||
;;
|
||||
;;
|
||||
;; #361f24 black (background)
|
||||
;; #832f01 red
|
||||
;; #fb9756 orange
|
||||
;; #ffde6e yellow
|
||||
;; #6b789b blue
|
||||
;; #7c6a8e purple
|
||||
;; #94b5ea light blue
|
||||
;; #fef9cd white (foreground)
|
||||
;;
|
||||
;; #ffffff white (comment)
|
||||
;; #270e05 (current line)
|
||||
;; fffffff (selection)
|
||||
;; #bd4307 (orange)
|
||||
|
||||
(set-fg-color "#fef9cd")
|
||||
(set-bg-color "#361f24")
|
||||
|
||||
;;----- Boarder -----
|
||||
|
||||
;; Set focus and unfocus colors
|
||||
(stumpwm:set-focus-color "#ffffff")
|
||||
(stumpwm:set-unfocus-color "#270e05")
|
||||
(stumpwm:set-float-focus-color "#ffffff")
|
||||
(stumpwm:set-float-unfocus-color "#270e05")
|
||||
|
||||
;;--- gaps ---
|
||||
|
||||
(load-module "swm-gaps")
|
||||
(setf swm-gaps:*head-gaps-size* 0
|
||||
swm-gaps:*inner-gaps-size* 5
|
||||
swm-gaps:*outer-gaps-size* 40)
|
||||
(when *initializing*
|
||||
(swm-gaps:toggle-gaps))
|
||||
|
||||
;;--- Font ---
|
||||
|
||||
(load-module "ttf-fonts")
|
||||
(setq clx-truetype::*font-dirs*
|
||||
(append (list (namestring "~/.local/share/fonts"
|
||||
))
|
||||
clx-truetype::*font-dirs*))
|
||||
(set-font (make-instance 'xft:font
|
||||
:family "DejaVuSansM Nerd Font"
|
||||
:subfamily "Bold"
|
||||
:size 11))
|
||||
|
||||
;;---------- Mode Line ----------
|
||||
|
||||
;; Run a shell command and format the output
|
||||
(defun run-shell-command-and-format (command)
|
||||
(substitute #\Space #\Newline (run-shell-command command t)))
|
||||
|
||||
;; Show the kernel version
|
||||
(defun show-kernel ()
|
||||
(run-shell-command-and-format "uname -r"))
|
||||
|
||||
;; Show the hostname
|
||||
(defun show-hostname ()
|
||||
(run-shell-command-and-format "hostname"))
|
||||
|
||||
;; Show the window title
|
||||
(defun show-window-title ()
|
||||
(substitute #\Space #\Newline (window-title (current-window))))
|
||||
|
||||
;; Mode Line Appearance
|
||||
(setf stumpwm:*mode-line-background-color* "#270e05"
|
||||
stumpwm:*mode-line-foreground-color* "#fef9cd"
|
||||
stumpwm:*mode-line-border-color* "#ffffff"
|
||||
stumpwm:*mode-line-border-width* 0
|
||||
stumpwm:*mode-line-pad-x* 0
|
||||
stumpwm:*mode-line-pad-y* 0
|
||||
stumpwm:*mode-line-timeout* 5)
|
||||
|
||||
(when *initializing*
|
||||
(update-color-map (current-screen)))
|
||||
|
||||
;; Define the screen mode line format
|
||||
(setf stumpwm:*screen-mode-line-format*
|
||||
(list "%g : %v ^>^7 : "
|
||||
'(:eval (show-hostname))
|
||||
": " '(:eval (show-kernel))
|
||||
": %d"))
|
||||
|
||||
;; Enable mode line
|
||||
(dolist (X11-Head (screen-heads (current-screen)))
|
||||
(enable-mode-line (current-screen) X11-Head t))
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
;; Set wallpaper
|
||||
(run-shell-command "hsetroot -fill ~/.local/share/wallpapers/P1020304.JPG")
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
;; Start Kitty
|
||||
(stumpwm:define-key stumpwm:*root-map* (stumpwm:kbd "c") "exec kitty")
|
||||
(stumpwm:define-key stumpwm:*root-map* (stumpwm:kbd "C-c") "exec kitty")
|
||||
|
||||
;; Start Qutebrowser
|
||||
(stumpwm:define-key stumpwm:*root-map* (stumpwm:kbd "w") "exec qutebrowser")
|
||||
(stumpwm:define-key stumpwm:*root-map* (stumpwm:kbd "C-w") "exec qutebrowser")
|
||||
|
||||
;; ;; Move window and focus
|
||||
;; (define-interactive-keymap move-window nil
|
||||
;; ((kbd "h") "move-focus left")
|
||||
;; ((kbd "j") "move-focus down")
|
||||
;; ((kbd "k") "move-focus up")
|
||||
;; ((kbd "l") "move-focus right")
|
||||
;; ((kbd "H") "move-window left")
|
||||
;; ((kbd "J") "move-window down")
|
||||
;; ((kbd "K") "move-window up")
|
||||
;; ((kbd "L") "move-window right"))
|
||||
|
||||
;; Restart StumpWM
|
||||
(define-key *root-map* (kbd "O") "restart-soft")
|
||||
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
(when *initializing*
|
||||
(grename "[EMACS]")
|
||||
(gnewbg "[TERM]")
|
||||
(gnewbg "[WWW]")
|
||||
(gnewbg "[PRIV]")
|
||||
(gnewbg "[FILES]"))
|
||||
|
||||
(clear-window-placement-rules)
|
||||
|
|
@ -0,0 +1,33 @@
|
|||
#-quicklisp
|
||||
(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
|
||||
(user-homedir-pathname))))
|
||||
(when (probe-file quicklisp-init)
|
||||
(load quicklisp-init)))
|
||||
|
||||
(in-package :stumpwm)
|
||||
|
||||
;; add ~/.stumpwm-contrib as effectively and additional *module-dir*
|
||||
(mapcar #'add-to-load-path (build-load-path
|
||||
(concat (getenv "HOME") "/.stumpwm-contrib")))
|
||||
|
||||
;;--- Log ---
|
||||
|
||||
;; log everything to ~/.stumpwm.d/stumpwm.log
|
||||
(redirect-all-output (merge-pathnames *data-dir* "stumpwm.log"))
|
||||
|
||||
;;--------- Autostart --------
|
||||
|
||||
(load "~/.stumpwm.d/autostart.lisp")
|
||||
|
||||
;;----- Binds -----
|
||||
|
||||
(load "~/.stumpwm.d/binds.lisp")
|
||||
|
||||
;;----- Theme -----
|
||||
|
||||
(load "~/.stumpwm.d/Daybreak.lisp")
|
||||
|
||||
;;------ Groups ------
|
||||
|
||||
(load "~/.stumpwm.d/groups.lisp")
|
||||
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
* ACPI
|
||||
|
||||
Add basic battery information to the modeline. Depends on Linux's ~acpi~
|
||||
package.
|
||||
|
||||
Use ~%B~ to add to the modeline.
|
||||
|
||||
Exports the following variables:
|
||||
|
||||
#+BEGIN_SRC common-lisp
|
||||
(defvar *battery-refresh-time* 30
|
||||
"Time in seconds between updates of battery information.")
|
||||
|
||||
(defvar *red* 25
|
||||
"Percentage at which the battery information turns red.")
|
||||
|
||||
(defvar *yellow* 50
|
||||
"Percentage at which the battery information turns yellow.")
|
||||
|
||||
(defvar *green* 75
|
||||
"Percentage at which the battery information turns green.")
|
||||
|
||||
(defvar *disappear* 96
|
||||
"Percentage at which the battery information disappears from the modeline.")
|
||||
#+END_SRC
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
;;;; acpi.asd
|
||||
|
||||
(asdf:defsystem #:acpi
|
||||
:description "View the output of acpi in the modeline."
|
||||
:author "Toby Slight <tslight@pm.me>"
|
||||
:license "GPLv3"
|
||||
:version "0.0.1"
|
||||
:serial t
|
||||
:depends-on (#:stumpwm #:cl-ppcre)
|
||||
:components ((:file "package")
|
||||
(:file "acpi")))
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
;;;; acpi.lisp
|
||||
|
||||
(in-package #:acpi)
|
||||
|
||||
(defvar *acpi-refresh-time* 30
|
||||
"Time in seconds between updates of acpi information.")
|
||||
|
||||
(defvar *red* 25
|
||||
"Percentage at which the acpi information turns red.")
|
||||
|
||||
(defvar *yellow* 50
|
||||
"Percentage at which the acpi information turns yellow.")
|
||||
|
||||
(defvar *green* 75
|
||||
"Percentage at which the acpi information turns green.")
|
||||
|
||||
(defvar *disappear* 96
|
||||
"Percentage at which the acpi information disappears from the modeline.")
|
||||
|
||||
(defun acpi ()
|
||||
"Return the percentages returned from the acpi command as a concatenated string"
|
||||
(let* ((bat (run-shell-command "acpi" t))
|
||||
(bats (ppcre:all-matches-as-strings "[0-9]+%" bat))
|
||||
(ints (mapcar (lambda (b) (parse-integer b :junk-allowed t)) bats)))
|
||||
(format nil "~{~A~}"
|
||||
(mapcar (lambda (int bat)
|
||||
(cond
|
||||
((and (> *disappear* int) (<= *green* int)) bat)
|
||||
((and (> *green* int) (<= *yellow* int)) (concat "^2*" bat))
|
||||
((and (> *yellow* int) (<= *red* int)) (concat "^3*" bat))
|
||||
((and (> *red* int)) (concat "^1*" bat))
|
||||
(t "")))
|
||||
ints bats))))
|
||||
|
||||
(defcommand acpi-message () ()
|
||||
(let ((bat (acpi)))
|
||||
(if (string= bat "")
|
||||
(message "Charged")
|
||||
(message bat))))
|
||||
|
||||
;; pinched from battery portable code
|
||||
(let ((next 0)
|
||||
(last-value ""))
|
||||
(defun get-acpi (ml)
|
||||
(declare (ignore ml))
|
||||
(let ((now (get-universal-time)))
|
||||
(when (< now next)
|
||||
(return-from get-acpi last-value))
|
||||
(setf next (+ now *acpi-refresh-time*)))
|
||||
(setf last-value (acpi))))
|
||||
|
||||
(add-screen-mode-line-formatter #\B #'get-acpi)
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
;;;; package.lisp
|
||||
|
||||
(defpackage #:acpi
|
||||
(:use #:cl #:stumpwm #:cl-ppcre)
|
||||
(:export #:*acpi-refresh-time*
|
||||
#:*red*
|
||||
#:*yellow*
|
||||
#:*green*
|
||||
#:*disappear*))
|
||||
|
|
@ -0,0 +1,50 @@
|
|||
* Bind Key
|
||||
|
||||
Slightly less clunky that the standard method for key binding. Influenced by
|
||||
Emacs' [[https://github.com/jwiegley/use-package/blob/master/bind-key.el][bind-key]], but not nearly as powerful or feature rich. This is just a
|
||||
couple of pretty basic macros..
|
||||
|
||||
** Usage
|
||||
|
||||
#+begin_src common-lisp
|
||||
(load-module "bind")
|
||||
#+end_src
|
||||
|
||||
The syntax is as follows:
|
||||
|
||||
#+begin_src common-lisp
|
||||
(bind:key
|
||||
,*key-map*
|
||||
("C-M-z" "some-amazing-stumpwm-command")
|
||||
("C-M-y" "some-other-amazing-stumpwm-command"))
|
||||
#+end_src
|
||||
|
||||
** Examples
|
||||
|
||||
To bind Emacs to =<Super> + e= & XTerm to =<Super> + t= in the =*top-map*=,
|
||||
would look like this:
|
||||
|
||||
#+begin_src common-lisp
|
||||
(bind:key
|
||||
,*top-map*
|
||||
("s-e" "exec emacs")
|
||||
("s-t" "exec xterm"))
|
||||
#+end_src
|
||||
|
||||
To do something similar in the =*root-map*=:
|
||||
|
||||
#+begin_src common-lisp
|
||||
(bind:key
|
||||
,*root-map*
|
||||
("e" "exec emacs")
|
||||
("t" "exec xterm"))
|
||||
#+end_src
|
||||
|
||||
=<Tab>= and =<Shift+Tab>= to go down and up menus.
|
||||
|
||||
#+begin_src common-lisp
|
||||
(bind:key
|
||||
,*menu-map*
|
||||
("TAB" 'menu-down)
|
||||
("ISO_Left_Tab" 'menu-up))
|
||||
#+end_src
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
;;;; bind.asd
|
||||
|
||||
(asdf:defsystem #:bind
|
||||
:description "Simpler keybinding syntax"
|
||||
:author "Toby Slight <tslight@pm.me>"
|
||||
:license "GPLv3"
|
||||
:version "0.0.1"
|
||||
:serial t
|
||||
:depends-on (#:stumpwm)
|
||||
:components ((:file "package")
|
||||
(:file "bind")))
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
;;;; bind.lisp
|
||||
|
||||
(in-package #:bind)
|
||||
|
||||
(defmacro defkey (map key cmd)
|
||||
`(define-key ,map (kbd ,key) ,cmd))
|
||||
|
||||
(defmacro key (map &rest keys)
|
||||
(let ((ks (mapcar #'(lambda (k) (cons 'defkey (cons map k))) keys)))
|
||||
`(progn ,@ks)))
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
;;;; package.lisp
|
||||
|
||||
(defpackage #:bind
|
||||
(:use #:cl #:stumpwm)
|
||||
(:import-from #:stumpwm
|
||||
*exchange-window-map*
|
||||
*groups-map*
|
||||
*menu-map*
|
||||
*root-map*
|
||||
*top-map*)
|
||||
(:export #:key))
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
* BRIGHTNESS CONTROL
|
||||
|
||||
This module depends on the brightnessctl Linux command line utility for
|
||||
changing monitor backlighting.
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
;;;; brightness.asd
|
||||
|
||||
(asdf:defsystem #:brightness
|
||||
:description "Use brightnessctl from StumpWM"
|
||||
:author "Toby Slight <tslight@pm.me>"
|
||||
:license "GPLv3"
|
||||
:version "0.0.1"
|
||||
:serial t
|
||||
:depends-on (#:stumpwm)
|
||||
:components ((:file "package")
|
||||
(:file "brightness")))
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
;;;; brightness.lisp
|
||||
|
||||
(in-package #:brightness)
|
||||
|
||||
(defun get-brightness (action)
|
||||
"Depends on the brightnessctl command line utility."
|
||||
(let* ((output (run-shell-command (concat "brightnessctl s " action) t))
|
||||
(start (search "(" output))
|
||||
(end (search ")" output))
|
||||
(out (subseq output (+ start 1) end)))
|
||||
out))
|
||||
|
||||
(defcommand brightness (action) ((:string "Enter Action: "))
|
||||
"Wrap brightnessctl and print a message containing current brightness."
|
||||
(let ((brightness (get-brightness action)))
|
||||
(message "^B^5BRIGHTNESS: ^n~a~%" brightness)))
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
;;;; package.lisp
|
||||
|
||||
(defpackage #:brightness
|
||||
(:use #:cl #:stumpwm))
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
* Cycle MRU
|
||||
|
||||
Cycle windows in most recently used order.
|
||||
|
||||
** Description
|
||||
|
||||
Flip through a group's windows, in a fashion similar to Window's Alt-Tab or
|
||||
macOS' Command-Tab. A.K.A. Most Recently Used order.
|
||||
|
||||
This code was lifted from [[http://nongnu.13855.n7.nabble.com/Alt-Tab-td127943.html][this thread]] on the stumpwm-devel mailing list from way
|
||||
back in 2012.
|
||||
|
||||
I have made some minor aesthetic and semantic changes to it (ie - changing the
|
||||
name from alt-tab to cycle-mru), but full credit goes to Ruthard Baudach for the
|
||||
code.
|
||||
|
||||
I am a complete noob when it comes to lisp, so any improvements would be greatly
|
||||
appreciated, as would any tips on how to implement the stuff on the todo list
|
||||
below.
|
||||
|
||||
** Usage
|
||||
|
||||
#+BEGIN_SRC common-lisp
|
||||
(load-module "cycle-mru")
|
||||
(define-key *top-map* (kbd "M-Tab") "cycle-mru")
|
||||
#+END_SRC
|
||||
|
||||
** Todo
|
||||
|
||||
- Use windowlist to choose, and only select on release.
|
||||
- Implement reverse cycle.
|
||||
- Preserve tab list during group change.
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
;;;; cycle-mru.asd
|
||||
|
||||
(asdf:defsystem #:cycle-mru
|
||||
:description "Cycle windows in most recently used order."
|
||||
:author "Toby Slight"
|
||||
:license "GPLv3"
|
||||
:version "0.0.1"
|
||||
:serial t
|
||||
:depends-on (#:stumpwm)
|
||||
:components ((:file "package")
|
||||
(:file "cycle-mru")))
|
||||
|
|
@ -0,0 +1,53 @@
|
|||
;;;; cycle-mru.lisp
|
||||
|
||||
(in-package #:cycle-mru)
|
||||
|
||||
(defun get-milliseconds () ()
|
||||
"Get timestamp in milliseconds."
|
||||
(floor
|
||||
(* 1000
|
||||
(/ (get-internal-real-time)
|
||||
internal-time-units-per-second))))
|
||||
|
||||
(defvar *mru-last-call* (get-milliseconds))
|
||||
(defvar *mru-list* (make-list 0))
|
||||
(defvar *mru-cycle* (make-list 0))
|
||||
(defvar *mru-timeout* 500) ; in milliseconds
|
||||
(defvar *mru-index* 0) ; in milliseconds
|
||||
|
||||
(defun mru-new-window (win) ()
|
||||
"Function called by new-window-hook. Updates mru-list."
|
||||
(push (window-number win) *mru-list*))
|
||||
|
||||
(defun mru-destroy-window (win) ()
|
||||
"Function called by destroy-window-hook. Deletes window number from
|
||||
mru-list."
|
||||
(setf *mru-list* (delete (window-number win) *mru-list*)))
|
||||
|
||||
(defun mru-focus-window (new-win old-win) ()
|
||||
"Function called by focus-window-hook. Updates mru-list."
|
||||
(when new-win
|
||||
(setf *mru-list* (delete (window-number new-win) *mru-list*)))
|
||||
(when old-win
|
||||
(push (window-number old-win) *mru-list*)))
|
||||
|
||||
(setf *new-window-hook* (list 'mru-new-window))
|
||||
(setf *destroy-window-hook* (list 'mru-destroy-window))
|
||||
(setf *focus-window-hook* (list 'mru-focus-window))
|
||||
|
||||
(defcommand cycle-mru () ()
|
||||
"Focus next windows according to most recently used order."
|
||||
(cond ((< (- (get-milliseconds) *mru-last-call*) *mru-timeout*)
|
||||
;; cycle through windows
|
||||
(setf *mru-index* (mod (1+ *mru-index*) (list-length *mru-cycle*)))
|
||||
(select-window-by-number (nth *mru-index* *mru-cycle*)))
|
||||
;; else start anew
|
||||
((setf *mru-index* 1) (setf *mru-cycle* (copy-list *mru-list*))
|
||||
;; if we've focussed a frame without window, current-window will
|
||||
;; return nil => select last used
|
||||
(cond ((not (current-window))
|
||||
(select-window-by-number (first *mru-cycle*)))
|
||||
((push (window-number (current-window)) *mru-cycle*)
|
||||
(select-window-by-number (second *mru-cycle*))))))
|
||||
;; update timestamp
|
||||
(setf *mru-last-call* (get-milliseconds)))
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
;;;; package.lisp
|
||||
|
||||
(defpackage #:cycle-mru
|
||||
(:use #:cl #:stumpwm)
|
||||
(:export #:*mru-last-call*
|
||||
#:*mru-list*
|
||||
#:*mru-cycle*
|
||||
#:*mru-timeout*
|
||||
#:*mru-index*))
|
||||
|
|
@ -0,0 +1,34 @@
|
|||
* ENCOURAGEMENT
|
||||
|
||||
/Scientifically-proven optimal words of hackerish encouragement./
|
||||
|
||||
Inspired by the messages printed when starting Emacs' slime mode.
|
||||
|
||||
Strings lifted from [[https://github.com/kovisoft/slimv/blob/master/slime/slime.el#L1360][here]].
|
||||
|
||||
** USAGE
|
||||
|
||||
Fire this sucker up with:
|
||||
|
||||
#+BEGIN_SRC common-lisp
|
||||
(load-module "encouragement")
|
||||
#+END_SRC
|
||||
|
||||
Then, run ~stump-encouragement~ from the StumpWM prompt to get an encouraging
|
||||
message. Or better yet - bind it to a key.
|
||||
|
||||
#+BEGIN_SRC common-lisp
|
||||
(define-key *root-map* (kbd "E") "encouragement")
|
||||
#+END_SRC
|
||||
|
||||
I recommend adding the snippet below to your ~.stumpwmrc~ to get encouraged
|
||||
every time you start StumpWM :-)
|
||||
|
||||
#+BEGIN_SRC common-lisp
|
||||
(setf *startup-message* (concat
|
||||
"^B^5Welcome to StumpWM~%^n"
|
||||
(encouragement:random-encouragement)))
|
||||
#+END_SRC
|
||||
|
||||
Exposes ~*words-of-encouragement*~ as a list that you can add your own
|
||||
encouraging messages to.
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
;;;; encouragement.asd
|
||||
|
||||
(asdf:defsystem #:encouragement
|
||||
:description "Scientifically-proven optimal words of hackerish encouragement."
|
||||
:author "Toby Slight <tslight@pm.me>"
|
||||
:license "GPLv3"
|
||||
:version "0.0.1"
|
||||
:serial t
|
||||
:depends-on (#:stumpwm)
|
||||
:components ((:file "package")
|
||||
(:file "encouragement")))
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
;;;; encouragement.lisp
|
||||
|
||||
(in-package #:encouragement)
|
||||
|
||||
(defvar *words-of-encouragement*
|
||||
(list "Let the hacking commence!"
|
||||
"Hacks and glory await!"
|
||||
"Hack and be merry!"
|
||||
"Your hacking starts... NOW!"
|
||||
"May the source be with you!"
|
||||
"Take this REPL, brother, and may it serve you well."
|
||||
"Lemonodor-fame is but a hack away!"
|
||||
"Are we consing yet?"
|
||||
(concat ", this could be the start of a beautiful program..")
|
||||
"Scientifically-proven optimal words of hackerish encouragement."))
|
||||
|
||||
(defun random-elt (list)
|
||||
"Return a random element from a list."
|
||||
(elt list (random (length list))))
|
||||
|
||||
(defun random-encouragement ()
|
||||
"Return a random string of hackerish encouragement."
|
||||
(random-elt *words-of-encouragement*))
|
||||
|
||||
(defcommand encouragement () ()
|
||||
"Print a random string of hackerish encouragement."
|
||||
(message "~a" (random-encouragement)))
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
;;;; package.lisp
|
||||
|
||||
(defpackage #:encouragement
|
||||
(:use #:cl #:stumpwm)
|
||||
(:export #:*words-of-encouragement*
|
||||
#:random-encouragement
|
||||
#:encouragement))
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
* Global Windows
|
||||
|
||||
Out of the box StumpWM provides tools to navigate windows only within
|
||||
group bounds - "windowlist" function seems to be the main, and maybe
|
||||
only useful here.
|
||||
|
||||
Sometimes the user wants to manage or even simply overview *all* application
|
||||
windows present in X session.
|
||||
|
||||
So, this contrib extension was written with purpose of providing the
|
||||
way to manage global windows list in rather straightforward manner.
|
||||
|
||||
** Usage
|
||||
|
||||
Add this to your =.stumpwm.d/init.lisp=:
|
||||
|
||||
Load contrib module:
|
||||
|
||||
#+BEGIN_SRC lisp
|
||||
(load-module "global-windows")
|
||||
#+END_SRC
|
||||
|
||||
And then use functions for global windows navigation:
|
||||
|
||||
#+BEGIN_SRC lisp
|
||||
(define-key *root-map* (kbd "C-t") "global-other")
|
||||
(define-key *root-map* (kbd "w") "global-windowlist")
|
||||
(define-key *root-map* (kbd "C-w") "global-pull-windowlist")
|
||||
#+END_SRC
|
||||
|
||||
Moreover there is a couple of util functions exported for the aim of
|
||||
user-defined extensions - see source code.
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
;;;; global-windows.asd
|
||||
|
||||
(asdf:defsystem #:global-windows
|
||||
:description "Operate on windows from all groups."
|
||||
:author "Toby Slight <tslight@pm.me>"
|
||||
:license "GPLv3"
|
||||
:version "0.0.1"
|
||||
:serial t
|
||||
:depends-on (#:stumpwm)
|
||||
:components ((:file "package")
|
||||
(:file "global-windows")))
|
||||
|
|
@ -0,0 +1,95 @@
|
|||
;;;; global-windows.lisp
|
||||
|
||||
(in-package #:global-windows)
|
||||
|
||||
(defvar *global-earlier-focussed-window* 'nil)
|
||||
(defvar *global-prev-focussed-window* 'nil)
|
||||
(defvar *global-cur-focussed-window* 'nil)
|
||||
|
||||
(defun global-windows ()
|
||||
"Returns a list of the names of all the windows in the current screen."
|
||||
(let ((groups (sort-groups (current-screen)))
|
||||
(windows nil))
|
||||
(dolist (group groups)
|
||||
(dolist (window (group-windows group))
|
||||
;; Don't include the current window in the list
|
||||
(when (not (eq window (current-window)))
|
||||
(push window windows))))
|
||||
windows))
|
||||
|
||||
(defun global-update-windows (currwin lastwin)
|
||||
"Record last visited windows and their group."
|
||||
(unless (equal (cons (current-window) (current-group)) *global-cur-focussed-window*)
|
||||
(when (global-find-window
|
||||
(car *global-prev-focussed-window*) (screen-groups (current-screen)))
|
||||
(setf *global-earlier-focussed-window* *global-prev-focussed-window*))
|
||||
(when (global-find-window
|
||||
(car *global-cur-focussed-window*) (screen-groups (current-screen)))
|
||||
(setf *global-prev-focussed-window* *global-cur-focussed-window*))
|
||||
(setf *global-cur-focussed-window* (cons currwin (current-group)))))
|
||||
|
||||
(defun global-find-window (window group-list)
|
||||
"Check for presence of window in all groups."
|
||||
(if (equal (car group-list) 'nil)
|
||||
'nil
|
||||
(if (member window (group-windows (car group-list)))
|
||||
window
|
||||
(global-find-window window (cdr group-list)))))
|
||||
|
||||
(defun goto-window (window)
|
||||
"Raise the window win and select its frame. For now, it does not
|
||||
select the screen."
|
||||
(let* ((group (window-group window))
|
||||
(frame (window-frame window))
|
||||
(old-frame (tile-group-current-frame group)))
|
||||
(frame-raise-window group frame window)
|
||||
(focus-all window)
|
||||
(unless (eq frame old-frame)
|
||||
(show-frame-indicator group))))
|
||||
|
||||
(define-stumpwm-type :global-window-names (input prompt)
|
||||
(labels
|
||||
((global-window-names ()
|
||||
(mapcar (lambda (window) (window-name window)) (global-windows))))
|
||||
(or (argument-pop input)
|
||||
(completing-read (current-screen) prompt (global-window-names)))))
|
||||
|
||||
(defmacro with-global-windowlist (name docstring &rest args)
|
||||
`(defcommand ,name (&optional (fmt *window-format*)) (:rest)
|
||||
,docstring
|
||||
(let ((global-windows-list (global-windows)))
|
||||
(labels
|
||||
((sort-windows (windowlist)
|
||||
(sort1 windowlist 'string-lessp :key 'window-name)))
|
||||
(if (null global-windows-list)
|
||||
(message "No other windows on screen ;)")
|
||||
(let ((window (select-window-from-menu (sort-windows global-windows-list) fmt)))
|
||||
(when window
|
||||
(progn ,@args))))))))
|
||||
|
||||
(with-global-windowlist global-windowlist
|
||||
"Like windowlist, but for all groups not just the current one."
|
||||
(goto-window window))
|
||||
|
||||
(with-global-windowlist global-pull-windowlist
|
||||
"Global windowlist for pulling windows to the current frame."
|
||||
(when (not (equalp (window-group window)
|
||||
(current-group)))
|
||||
(move-window-to-group window (current-group)))
|
||||
(pull-window window))
|
||||
|
||||
(defcommand global-other () ()
|
||||
"Switch to the last used window from any group."
|
||||
(let ((switch-to-win
|
||||
(or
|
||||
(global-find-window
|
||||
(car *global-prev-focussed-window*) (screen-groups (current-screen)))
|
||||
(global-find-window
|
||||
(car *global-earlier-focussed-window*) (screen-groups (current-screen))))))
|
||||
(if switch-to-win
|
||||
(progn
|
||||
(switch-to-group (cdr *global-prev-focussed-window*))
|
||||
(focus-window (car *global-prev-focussed-window*) t))
|
||||
(message "No window to switch to."))))
|
||||
|
||||
(add-hook *focus-window-hook* 'global-update-windows)
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
;;;; package.lisp
|
||||
|
||||
(defpackage #:global-windows
|
||||
(:use #:cl #:stumpwm)
|
||||
(:import-from #:stumpwm
|
||||
*focus-window-hook*
|
||||
*window-format*
|
||||
add-hook
|
||||
completing-read
|
||||
current-group
|
||||
current-screen
|
||||
current-window
|
||||
focus-all
|
||||
frame-raise-window
|
||||
group-windows
|
||||
move-window-to-group
|
||||
pull-window
|
||||
select-window-from-menu
|
||||
show-frame-indicator
|
||||
sort-groups
|
||||
sort-windows
|
||||
sort1
|
||||
switch-to-group
|
||||
tile-group-current-frame
|
||||
window-frame
|
||||
window-group
|
||||
window-name)
|
||||
(:export #:global-pull-windowlist
|
||||
#:global-windowlist
|
||||
#:global-windows
|
||||
#:goto-window
|
||||
#:with-global-windowlist))
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
* Miscellaneous StumpWM Commands
|
||||
** _Toby Slight <tslight@pm.me>_
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
;;;; misc.asd
|
||||
|
||||
(asdf:defsystem #:misc
|
||||
:description "Miscellaneous StumpWM commands."
|
||||
:author "Toby Slight <tslight@pm.me>"
|
||||
:license "GPlv3"
|
||||
:version "0.0.1"
|
||||
:serial t
|
||||
:depends-on (#:stumpwm #:swank)
|
||||
:components ((:file "package")
|
||||
(:file "misc")))
|
||||
|
|
@ -0,0 +1,59 @@
|
|||
;;;; misc.lisp
|
||||
|
||||
(in-package #:misc)
|
||||
|
||||
(defcommand prompt (&optional (initial "")) (:rest)
|
||||
"Prompt the user for an interactive command. The first arg is an optional
|
||||
initial contents."
|
||||
(let ((cmd (read-one-line (current-screen) ": " :initial-input initial)))
|
||||
(when cmd
|
||||
(eval-command cmd t))))
|
||||
|
||||
(defcommand reload++ () ()
|
||||
"Reload StumpWM Configuration."
|
||||
(run-commands "reload" "loadrc" "redisplay" "refresh" "refresh-heads"))
|
||||
|
||||
(defcommand swank () ()
|
||||
"Creates a swank server in the stumpwm lisp process."
|
||||
(swank-loader:init)
|
||||
(setf *top-level-error-action* :break)
|
||||
(swank:create-server :port 4004
|
||||
:style swank:*communication-style*
|
||||
:dont-close t)
|
||||
(message (concat "^B^5Getting swanky...~%^n" (random-encouragement))))
|
||||
|
||||
(defcommand toggle-split () ()
|
||||
(let* ((group (current-group))
|
||||
(cur-frame (tile-group-current-frame group))
|
||||
(frames (group-frames group)))
|
||||
(if (eq (length frames) 2)
|
||||
(progn (if (or (neighbour :left cur-frame frames)
|
||||
(neighbour :right cur-frame frames))
|
||||
(progn
|
||||
(only)
|
||||
(vsplit))
|
||||
(progn
|
||||
(only)
|
||||
(hsplit))))
|
||||
(message "Works only with 2 frames"))))
|
||||
|
||||
(defcommand toggle-only () ()
|
||||
"Toggle only one frame & restore old frame layout."
|
||||
(let ((group-file (format nil "/tmp/stumpwm-group-~a" (group-name (current-group)))))
|
||||
(if (null (cdr (head-frames (current-group) (current-head))))
|
||||
(restore-from-file group-file)
|
||||
(progn
|
||||
(dump-group-to-file group-file)
|
||||
(only)))))
|
||||
|
||||
(defmacro web-jump (name prefix)
|
||||
`(defcommand ,(intern name) (search)
|
||||
((:rest ,(concatenate 'string name ": ")))
|
||||
(substitute #\+ #\Space search)
|
||||
(run-shell-command (concatenate 'string ,prefix "\"" search "\""))))
|
||||
|
||||
(web-jump "ddg" "x-www-browser https://duckduckgo.com/?q=")
|
||||
(web-jump "google" "x-www-browser http://www.google.co.uk/search?q=")
|
||||
(web-jump "imdb" "x-www-browser http://www.imdb.com/find?q=")
|
||||
(web-jump "wikipedia" "x-www-browser http://en.wikipedia.org/wiki/")
|
||||
(web-jump "youtube" "x-www-browser http://youtube.com/results?search_query=")
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
;;;; package.lisp
|
||||
|
||||
(defpackage #:misc
|
||||
(:use #:cl #:stumpwm #:encouragement)
|
||||
(:shadow #:swank)
|
||||
(:import-from #:encouragement random-encouragement)
|
||||
(:import-from #:stumpwm head-frames)
|
||||
(:export #:ddg
|
||||
#:google
|
||||
#:imdb
|
||||
#:wikipedia
|
||||
#:youtube))
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
# modeline-click
|
||||
### Toby Slight <tslight@pm.me>
|
||||
|
||||
Do things when we click on the modeline.
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
;;;; modeline-click.asd
|
||||
|
||||
(asdf:defsystem #:modeline-click
|
||||
:description "Do stuff when we click on the modeline."
|
||||
:author "Toby Slight <tslight@pm.me>"
|
||||
:license "GPLv3"
|
||||
:version "0.0.1"
|
||||
:serial t
|
||||
:depends-on (#:stumpwm)
|
||||
:components ((:file "package")
|
||||
(:file "modeline-click")))
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
;;;; modeline-click.lisp
|
||||
|
||||
(in-package #:modeline-click)
|
||||
|
||||
(defun modeline-click (modeline button x y)
|
||||
"Cycle windows by scrolling and clicking on the modeline."
|
||||
(let* ((screen (parse-integer
|
||||
(ppcre:scan-to-strings
|
||||
"[0-9]+(?=x[0-9]+x[0-9]+)"
|
||||
(write-to-string (current-screen)))))
|
||||
(min 50) ;; pixels
|
||||
(mid (floor screen 2))
|
||||
(max (- screen min)))
|
||||
(cond
|
||||
;; left corner of screen
|
||||
((and (eq button 1) (<= x min))
|
||||
(run-commands "gprev"))
|
||||
((and (eq button 3) (<= x min))
|
||||
(run-commands "gnext"))
|
||||
((and (eq button 5) (<= x min))
|
||||
(run-commands "gnext"))
|
||||
((and (eq button 4) (<= x min))
|
||||
(run-commands "gprev"))
|
||||
;; left side of screen
|
||||
((and (eq button 1) (> x min) (< x mid))
|
||||
(run-commands "prev"))
|
||||
((and (eq button 3) (> x min) (< x mid))
|
||||
(run-commands "next"))
|
||||
((and (eq button 4) (> x min) (< x mid))
|
||||
(run-commands "prev"))
|
||||
((and (eq button 5) (> x min) (< x mid))
|
||||
(run-commands "next"))
|
||||
;; right side of screen
|
||||
((and (eq button 1) (> x mid) (< x max))
|
||||
(run-commands "next"))
|
||||
((and (eq button 3) (> x mid) (< x max))
|
||||
(run-commands "prev"))
|
||||
((and (eq button 4) (> x mid) (< x max))
|
||||
(run-commands "prev"))
|
||||
((and (eq button 5) (> x mid) (< x max))
|
||||
(run-commands "next"))
|
||||
;; right corner of screen
|
||||
((and (eq button 1) (>= x max))
|
||||
(run-commands "gnext"))
|
||||
((and (eq button 3) (<= x min))
|
||||
(run-commands "gprev"))
|
||||
((and (eq button 5) (>= x max))
|
||||
(run-commands "gnext"))
|
||||
((and (eq button 4) (>= x max))
|
||||
(run-commands "gprev")))))
|
||||
|
||||
(add-hook *mode-line-click-hook* 'modeline-click)
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
;;;; package.lisp
|
||||
|
||||
(defpackage #:modeline-click
|
||||
(:use #:cl :stumpwm))
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
# move-group
|
||||
### _Toby Slight <tslight@pm.me>_
|
||||
|
||||
Move groups forwards and backwards
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
;;;; move-group.asd
|
||||
|
||||
(asdf:defsystem #:move-group
|
||||
:description "Describe move-group here"
|
||||
:author "Your Name <your.name@example.com>"
|
||||
:license "Specify license here"
|
||||
:version "0.0.1"
|
||||
:serial t
|
||||
:depends-on (#:stumpwm)
|
||||
:components ((:file "package")
|
||||
(:file "move-group")))
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
;;;; move-group.lisp
|
||||
|
||||
(in-package #:move-group)
|
||||
|
||||
(defun swap-groups (group1 group2)
|
||||
(rotatef (slot-value group1 'number) (slot-value group2 'number)))
|
||||
|
||||
(defun move-group-forward (&optional (group (current-group)))
|
||||
(swap-groups group (next-group group (sort-groups (current-screen)))))
|
||||
|
||||
(defun move-group-backward (&optional (group (current-group)))
|
||||
(swap-groups group (next-group group (reverse (sort-groups (current-screen))))))
|
||||
|
||||
(defcommand gforward () ()
|
||||
(move-group-forward)
|
||||
(echo-groups (current-screen) *group-format*))
|
||||
|
||||
(defcommand gbackward () ()
|
||||
(move-group-backward)
|
||||
(echo-groups (current-screen) *group-format*))
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
;;;; package.lisp
|
||||
|
||||
(defpackage #:move-group
|
||||
(:use #:cl #:stumpwm)
|
||||
(:import-from #:stumpwm
|
||||
echo-groups
|
||||
next-group
|
||||
sort-groups))
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
** Quit Menu
|
||||
|
||||
This module provides commands and a menu to gracefully close all open
|
||||
programs and shutdown or reboot the computer. A logout command is also
|
||||
provided.
|
||||
|
||||
This module requires the use of =systemd=, and requires the =polkit= package
|
||||
to be installed, as well as the =wmctl= command.
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
;;;; package.lisp
|
||||
|
||||
(defpackage #:quitmenu
|
||||
(:use #:cl :stumpwm)
|
||||
(:export #:re-init
|
||||
#:logout
|
||||
#:suspend-computer
|
||||
#:restart-computer
|
||||
#:shutdown-computer
|
||||
#:quitmenu
|
||||
#:*quitmenu-menu*))
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
;;;; quitmenu.asd
|
||||
|
||||
(asdf:defsystem #:quitmenu
|
||||
:description "Logout menu"
|
||||
:author "Stuart Dilts"
|
||||
:license "GPLv3"
|
||||
:depends-on (#:stumpwm)
|
||||
:serial t
|
||||
:components ((:file "package")
|
||||
(:file "quitmenu")))
|
||||
|
|
@ -0,0 +1,74 @@
|
|||
;;;; session-ending.lisp
|
||||
(in-package #:quitmenu)
|
||||
|
||||
(defun yes-no-diag (query-string)
|
||||
"Presents a yes-no dialog to the user asking query-string.
|
||||
Returns true when yes is selected"
|
||||
(equal :yes (cadr (select-from-menu (current-screen)
|
||||
'(("Yes" :yes) ("No" :no))
|
||||
query-string))))
|
||||
|
||||
(defun close-all-apps ()
|
||||
"Closes all windows managed by stumpwm gracefully"
|
||||
;; yes, this uses an external tool instead of stumpwm internals
|
||||
(let ((win-index-text (run-shell-command "wmctrl -l | awk '{print $1}'" t)))
|
||||
(dolist (window (cl-ppcre:split "\\\n" win-index-text))
|
||||
(run-shell-command (format nil "wmctrl -i -c ~A" window)))))
|
||||
|
||||
(defcommand re-init () ()
|
||||
"Reload StumpWM configuration"
|
||||
(let ((choice (yes-no-diag "Really re-initialise??")))
|
||||
(when choice
|
||||
(echo-string (current-screen) "Re-initialising...")
|
||||
(run-commands
|
||||
"reload"
|
||||
"loadrc"
|
||||
"redisplay"
|
||||
"refresh"
|
||||
"refresh-heads"))))
|
||||
|
||||
(defcommand logout () ()
|
||||
(let ((choice (yes-no-diag "Really logout?")))
|
||||
(when choice
|
||||
(echo-string (current-screen) "Logging out...")
|
||||
(close-all-apps)
|
||||
(run-hook *quit-hook*)
|
||||
(quit))))
|
||||
|
||||
(defcommand suspend-computer () ()
|
||||
"Suspends the computer"
|
||||
(let ((choice (yes-no-diag "Really suspend?")))
|
||||
(when choice
|
||||
(echo-string (current-screen) "Suspending...")
|
||||
(run-shell-command "systemctl suspend"))))
|
||||
|
||||
;; can't name the function "restart"
|
||||
(defcommand restart-computer () ()
|
||||
(let ((choice (yes-no-diag "Really Restart?")))
|
||||
(when choice
|
||||
(echo-string (current-screen) "Restarting...")
|
||||
(close-all-apps)
|
||||
(run-hook *quit-hook*)
|
||||
(run-shell-command "systemctl reboot"))))
|
||||
|
||||
(defcommand shutdown-computer () ()
|
||||
(let ((choice (yes-no-diag "Really Shutdown?")))
|
||||
(when choice
|
||||
(echo-string (current-screen) "Shutting down...")
|
||||
(close-all-apps)
|
||||
(run-hook *quit-hook*)
|
||||
(run-shell-command "systemctl poweroff"))))
|
||||
|
||||
(defcommand quitmenu () ()
|
||||
(let ((choice (select-from-menu (current-screen) *quitmenu-menu* "Quit?")))
|
||||
(when choice
|
||||
(apply (second choice) nil))))
|
||||
|
||||
(defvar *quitmenu-menu*
|
||||
(list (list "Restart" #'re-init)
|
||||
(list "Logout" #'logout)
|
||||
(list "Suspend" #'suspend-computer)
|
||||
(list "Reboot" #'restart-computer)
|
||||
(list "Shutdown" #'shutdown-computer))
|
||||
"The options that are available to quit a stumpwm session.
|
||||
Entries in the list has the format of (\"item in menu\" #'function-to-call)")
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
* Run or Raise Collection
|
||||
|
||||
** _Toby Slight <tslight@pm.me>_
|
||||
|
||||
Run or raise collection
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
;;;; package.lisp
|
||||
|
||||
(defpackage #:ror-collection
|
||||
(:use #:cl #:stumpwm))
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
;;;; ror-collection.asd
|
||||
|
||||
(asdf:defsystem #:ror-collection
|
||||
:description "Collection of run or raise commands."
|
||||
:author "Toby Slight <tslight@pm.me>"
|
||||
:license "GPLv3"
|
||||
:version "0.0.1"
|
||||
:serial t
|
||||
:depends-on (#:stumpwm)
|
||||
:components ((:file "package")
|
||||
(:file "ror-collection")))
|
||||
|
|
@ -0,0 +1,41 @@
|
|||
;;;; ror-collection.lisp
|
||||
|
||||
(in-package #:ror-collection)
|
||||
|
||||
(defcommand ror-emacs () ()
|
||||
"run-or-raise emacs"
|
||||
(run-or-raise "emacsclient -c -a ''" '(:class "Emacs")))
|
||||
|
||||
(defcommand ror-lilyterm-with-tmux () ()
|
||||
"run-or-raise lilyterm with tmux"
|
||||
(run-or-raise
|
||||
"lilyterm -x bash -c 'tmux -q has-session && tmux attach -d || tmux -u'"
|
||||
'(:class "LilyTerm")))
|
||||
|
||||
(defcommand ror-kitty-with-tmux () ()
|
||||
"run-or-raise kitty with tmux"
|
||||
(run-or-raise
|
||||
"kitty -e bash -c 'tmux -q has-session && tmux attach -d || tmux -u'"
|
||||
'(:class "kitty")))
|
||||
|
||||
(defcommand ror-urxvt-with-tmux () ()
|
||||
"run-or-raise urxvt with tmux"
|
||||
(run-or-raise
|
||||
"urxvt -e bash -c 'tmux -q has-session && tmux attach -d || tmux -u'"
|
||||
'(:class "URxvt")))
|
||||
|
||||
(defcommand ror-tabbed-st () ()
|
||||
"run-or-raise a tabbed suckless terminal"
|
||||
(run-or-raise "tabbed -c -r 2 st -w ''" '(:class "tabbed")))
|
||||
|
||||
(defcommand ror-st () ()
|
||||
"run-or-raise suckless terminal"
|
||||
(run-or-raise "st" '(:class "st-256color")))
|
||||
|
||||
(defcommand ror-web-browser () ()
|
||||
"run-or-raise a web browser"
|
||||
(run-or-raise "x-www-browser" '(:role "browser")))
|
||||
|
||||
(defcommand ror-file-manager () ()
|
||||
"run-or-raise a graphical file manager"
|
||||
(run-or-raise "spacefm" '(:role "file_manager")))
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
* Rotate Windows
|
||||
** _Toby Slight <tslight@pm.me>_
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
;;;; package.lisp
|
||||
|
||||
(defpackage #:rotate-windows
|
||||
(:use #:cl #:stumpwm)
|
||||
(:import-from #:stumpwm
|
||||
frame-window
|
||||
group-frames
|
||||
pull-window))
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
;;;; rotate-windows.asd
|
||||
|
||||
(asdf:defsystem #:rotate-windows
|
||||
:description "Rotate windows in frames."
|
||||
:author "Toby Slight <tslight@pm.me>"
|
||||
:license "GPLv3"
|
||||
:version "0.0.1"
|
||||
:serial t
|
||||
:depends-on (#:stumpwm)
|
||||
:components ((:file "package")
|
||||
(:file "rotate-windows")))
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
;;;; rotate-windows.lisp
|
||||
|
||||
(in-package #:rotate-windows)
|
||||
|
||||
(defun shift-windows-forward (frames win)
|
||||
"Rotate Windows"
|
||||
(when frames
|
||||
(let ((frame (car frames)))
|
||||
(shift-windows-forward (cdr frames) (frame-window frame))
|
||||
(when win (pull-window win frame)))))
|
||||
|
||||
(defcommand rotate-windows () ()
|
||||
(let* ((frames (group-frames (current-group)))
|
||||
(win (frame-window (car (last frames)))))
|
||||
(shift-windows-forward frames win)))
|
||||
|
|
@ -0,0 +1,66 @@
|
|||
* MODELINE SENSORS DISPLAY
|
||||
|
||||
View average and maximum ~sensors~ temperatures and fan RPM in the modeline.
|
||||
|
||||
** PRE-REQUISITES
|
||||
|
||||
Running Linux with ~lm-sensors~ installed.
|
||||
|
||||
** USAGE
|
||||
|
||||
To load this module, place ~(load-module sensors)~ in your ~.stumpwmrc~.
|
||||
|
||||
Sensors information is then available to display in the modeline using ~%S~ in
|
||||
your modeline config.
|
||||
|
||||
As an example, here is my modeline config:
|
||||
|
||||
#+BEGIN_SRC common-lisp
|
||||
(setf *screen-mode-line-format*
|
||||
(list "^3^B%d ^2[%n] ^7%v ^n ^> %S %T"))
|
||||
#+END_SRC
|
||||
|
||||
The following variables are exported
|
||||
|
||||
#+BEGIN_SRC common-lisp
|
||||
(defvar *sensors-refresh-time* 30
|
||||
"Time in seconds between updates of sensors information.")
|
||||
|
||||
(defvar *red-above-temp* 60
|
||||
"Temperature to turn red at.")
|
||||
|
||||
(defvar *yellow-above-temp* 50
|
||||
"Temperature to turn yellow at.")
|
||||
|
||||
(defvar *display-above-temp* 40
|
||||
"Temperature to start displaying at.")
|
||||
|
||||
(defvar *red-above-rpm* 4000
|
||||
"Fan RPM to turn red at.")
|
||||
|
||||
(defvar *yellow-above-rpm* 3000
|
||||
"Fan RPM to turn yellow at.")
|
||||
|
||||
(defvar *display-above-rpm* 2000
|
||||
"Fan RPM to start displaying at.")
|
||||
|
||||
(defvar *ignore-below* 20
|
||||
"Ignore temperatures below this temperature when calculating average.")
|
||||
#+END_SRC
|
||||
|
||||
** CAVEATS
|
||||
|
||||
This module only displays average (and maximum for temperature) temperature and
|
||||
fan RPM, not all sensors. It would be good to make it more configurable in this
|
||||
respect.
|
||||
|
||||
Also, I'm very new to Common Lisp, so the code is pretty hacky. I'd welcome any
|
||||
advice on how to make it better.
|
||||
|
||||
Also credit must go to the author of [[https://github.com/tslight/stumpwm-contrib/tree/master/modeline/battery-portable][Battery Portable]] for the ~*refresh-time*~
|
||||
logic.
|
||||
|
||||
** EXTRA
|
||||
|
||||
As an extra bonus this module contains the stumpwm command ~sensors~ for viewing
|
||||
the same information in a message window.
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
;;;; package.lisp
|
||||
|
||||
(defpackage #:sensors
|
||||
(:use #:cl #:stumpwm #:cl-ppcre)
|
||||
(:export #:*sensors-refresh-time*
|
||||
#:*red-above-temp*
|
||||
#:*yellow-above-temp*
|
||||
#:*display-above-temp*
|
||||
#:*red-above-rpm*
|
||||
#:*yellow-above-rpm*
|
||||
#:*display-above-rpm*
|
||||
#:*ignore-below*
|
||||
#:sensors))
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
;;;; sensors.asd
|
||||
|
||||
(asdf:defsystem #:sensors
|
||||
:description "View CPU temperature and fan RPM in modeline"
|
||||
:author "Toby Slight <tslight@pm.me>"
|
||||
:license "GPLv3"
|
||||
:version "0.0.1"
|
||||
:serial t
|
||||
:depends-on (#:stumpwm)
|
||||
:components ((:file "package")
|
||||
(:file "sensors")))
|
||||
|
|
@ -0,0 +1,94 @@
|
|||
;;;; sensors.lisp
|
||||
|
||||
(in-package #:sensors)
|
||||
|
||||
(defvar *sensors-refresh-time* 30
|
||||
"Time in seconds between updates of sensors information.")
|
||||
|
||||
(defvar *red-above-temp* 60
|
||||
"Temperature to turn red at.")
|
||||
|
||||
(defvar *yellow-above-temp* 50
|
||||
"Temperature to turn yellow at.")
|
||||
|
||||
(defvar *display-above-temp* 40
|
||||
"Temperature to start displaying at.")
|
||||
|
||||
(defvar *red-above-rpm* 4000
|
||||
"Fan RPM to turn red at.")
|
||||
|
||||
(defvar *yellow-above-rpm* 3000
|
||||
"Fan RPM to turn yellow at.")
|
||||
|
||||
(defvar *display-above-rpm* 2000
|
||||
"Fan RPM to start displaying at.")
|
||||
|
||||
(defvar *ignore-below* 20
|
||||
"Ignore temperatures below this temperature when calculating average.")
|
||||
|
||||
(defvar *temp-regex* "(?<=\\+).*[0-9]+(?=\\..*)"
|
||||
"A regex that captures all temperatures.")
|
||||
|
||||
(defvar *fan-regex* "(?<=\\:).*?(?=RPM)"
|
||||
"A regex that captures all fans.")
|
||||
|
||||
(defun sensors-as-ints (output regex)
|
||||
"Use REGEX to extract sensor values from OUTPUT, and then cast them to a list
|
||||
of integers if they are greater than *IGNORE-BELOW*."
|
||||
(let ((strings (ppcre:all-matches-as-strings regex output)))
|
||||
(mapcan ;; https://stackoverflow.com/a/13269952
|
||||
(lambda (s)
|
||||
(let ((i (parse-integer (remove-if #'alpha-char-p s) :junk-allowed t)))
|
||||
;; low readings can skew the average too much
|
||||
(if (< *ignore-below* i)
|
||||
(list i))))
|
||||
strings)))
|
||||
|
||||
(defun fmt-sensor (value &optional
|
||||
(high *red-above-temp*)
|
||||
(mid *yellow-above-temp*)
|
||||
(low *display-above-temp*))
|
||||
"If VALUE is greater than HIGH, MID or LOW, return it as a red, yellow or
|
||||
normal coloured string, respectively. If value is lower than LOW, don't
|
||||
return anything."
|
||||
(cond ((< high value) (concat "^1*" (write-to-string value)))
|
||||
((< mid value) (concat "^3*" (write-to-string value)))
|
||||
((< low value) (write-to-string value))
|
||||
(t nil)))
|
||||
|
||||
(defun sensors ()
|
||||
"Transforms the output of the sensors command into two lists of integers. One
|
||||
for temperatures and one for fan speeds. Calculate the average values of the
|
||||
lists (and the maximum for temperatures), then cast those values back to
|
||||
strings with appropriate color formatting. Finally concatenate those strings
|
||||
into one line."
|
||||
(let* ((output (run-shell-command "sensors" t))
|
||||
(temps (sensors-as-ints output *temp-regex*))
|
||||
(fans (sensors-as-ints output *fan-regex*))
|
||||
(max-temp (fmt-sensor (reduce #'max temps)))
|
||||
(avg-temp (fmt-sensor
|
||||
(handler-case
|
||||
(floor (apply #'+ temps) (length temps))
|
||||
(division-by-zero () 0))))
|
||||
(avg-rpm (fmt-sensor
|
||||
(handler-case
|
||||
(floor (apply #'+ fans) (length fans))
|
||||
(division-by-zero () 0))
|
||||
*red-above-rpm* *yellow-above-rpm* *display-above-rpm*)))
|
||||
(concat
|
||||
(if max-temp (concat max-temp (string (code-char 176)) "C^n"))
|
||||
(if avg-temp (concat " " avg-temp (string (code-char 176)) "C^n"))
|
||||
(if avg-rpm (concat " " avg-rpm " RPM^n")))))
|
||||
|
||||
;; pinched from battery portable code
|
||||
(let ((next 0)
|
||||
(last-value ""))
|
||||
(defun get-sensors (ml)
|
||||
(declare (ignore ml))
|
||||
(let ((now (get-universal-time)))
|
||||
(when (< now next)
|
||||
(return-from get-sensors last-value))
|
||||
(setf next (+ now *sensors-refresh-time*)))
|
||||
(setf last-value (sensors))))
|
||||
|
||||
(add-screen-mode-line-formatter #\S #'get-sensors)
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
* THEO
|
||||
|
||||
/If people keep adding such huge stuff, soon stumpwm will be bigger than
|
||||
emacs./
|
||||
|
||||
[[https://openbsd.org][OpenBSD]]'s [[https://www.theos.com/deraadt/][Theo]] insults lifted from the [[https://cvsweb.openbsd.org/src/usr.bin/mg/Attic/theo.c?rev=1.152&content-type=text/x-cvsweb-markup][mg source tree]].
|
||||
|
||||
** USAGE
|
||||
|
||||
Fire this sucker up with:
|
||||
|
||||
#+BEGIN_SRC common-lisp
|
||||
(load-module "theo")
|
||||
#+END_SRC
|
||||
|
||||
Then, run ~theo~ from the StumpWM prompt to get a semi insulting message. Or
|
||||
better yet - bind it to a key.
|
||||
|
||||
#+BEGIN_SRC common-lisp
|
||||
(define-key *root-map* (kbd "T") "theo")
|
||||
#+END_SRC
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
;;;; package.lisp
|
||||
|
||||
(defpackage #:theo
|
||||
(:use #:cl #:stumpwm)
|
||||
(:export #:*quotes*
|
||||
#:random-quote
|
||||
#:theo))
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
;;;; theo.asd
|
||||
|
||||
(asdf:defsystem #:theo
|
||||
:description "Invoke Theo's wrath..."
|
||||
:author "Toby Slight <tslight@pm.me>"
|
||||
:license "GPLv3"
|
||||
:version "0.0.1"
|
||||
:serial t
|
||||
:depends-on (#:stumpwm)
|
||||
:components ((:file "package")
|
||||
(:file "theo")))
|
||||
|
|
@ -0,0 +1,130 @@
|
|||
;;;; theo.lisp
|
||||
|
||||
(in-package #:theo)
|
||||
|
||||
(defvar *quotes*
|
||||
'("Write more code."
|
||||
"Make more commits."
|
||||
"That's because you have been slacking."
|
||||
"slacker!"
|
||||
"That's what happens when you're lazy."
|
||||
"idler!"
|
||||
"slackass!"
|
||||
"lazy bum!"
|
||||
"Stop slacking you lazy bum!"
|
||||
"slacker slacker lazy bum bum bum slacker!"
|
||||
"I could search... but I'm a lazy bum ;)"
|
||||
"sshutup sshithead, ssharpsshooting susshi sshplats ssharking assholes."
|
||||
"Lazy bums slacking on your asses."
|
||||
"35 commits an hour? That's pathetic!"
|
||||
"Fine software takes time to prepare. Give a little slack."
|
||||
"I am just stating a fact"
|
||||
"you bring new meaning to the terms slackass. I will have to invent a new term."
|
||||
"if they cut you out, muddy their back yards"
|
||||
"Make them want to start over, and play nice the next time."
|
||||
"It is clear that this has not been thought through."
|
||||
"avoid using abort(). it is not nice."
|
||||
"That's the most ridiculous thing I've heard in the last two or three minutes!"
|
||||
"I'm not just doing this for crowd response. I need to be right."
|
||||
"I'd put a fan on my bomb.. And blinking lights..."
|
||||
"I love to fight"
|
||||
"No sane people allowed here. Go home."
|
||||
"you have to stop peeing on your breakfast"
|
||||
"feature requests come from idiots"
|
||||
"henning and darren / sitting in a tree / t o k i n g / a joint or three"
|
||||
"KICK ASS. TIME FOR A JASON LOVE IN! WE CAN ALL GET LOST IN HIS HAIR!"
|
||||
"shame on you for following my rules."
|
||||
"altq's parser sucks dead whale farts through the finest chemistry pipette's"
|
||||
"screw this operating system shit, i just want to drive!"
|
||||
"Search for fuck. Anytime you see that word, you have a paragraph to write."
|
||||
"Yes, but the ports people are into S&M."
|
||||
"Buttons are for idiots."
|
||||
"We are not hackers. We are turd polishing craftsmen."
|
||||
"who cares. style(9) can bite my ass"
|
||||
"It'd be one fucking happy planet if it wasn't for what's under this fucking sticker."
|
||||
"I would explain, but I am too drunk."
|
||||
"you slackers don't deserve pictures yet"
|
||||
"Vegetarian my ass"
|
||||
"Wait a minute, that's a McNally's!"
|
||||
"don't they recognize their moral responsibility to entertain me?"
|
||||
"#ifdef is for emacs developers."
|
||||
"Many well known people become net-kooks in their later life, because they lose touch with reality."
|
||||
"You're not allowed to have an opinion."
|
||||
"tweep tweep tweep"
|
||||
"Quite frankly, SSE's alignment requirement is the most utterly retarded idea since eating your own shit."
|
||||
"Holy verbose prom startup Batman."
|
||||
"Any day now, when we sell out."
|
||||
"optimism in man kind does not belong here"
|
||||
"First user who tries to push this button, he pounds into the ground with a rant of death."
|
||||
"we did farts. now we do sperm. we are cutting edge."
|
||||
"the default configuration is a mixture of piss, puke, shit, and bloody entrails."
|
||||
"Stop wasting your time reading people's licenses."
|
||||
"doing it with environment variables is OH SO SYSTEM FIVE LIKE OH MY GOD PASS ME THE SPOON"
|
||||
"Linux is fucking POO, not just bad, bad REALLY REALLY BAD"
|
||||
"penguins are not much more than chickens that swim."
|
||||
"i am a packet sniffing fool, let me wipe my face with my own poo"
|
||||
"Whiners. They scale really well."
|
||||
"in your world, you would have a checklist of 50 fucking workarounds just to make a coffee."
|
||||
"for once, I have nothing to say."
|
||||
"You have no idea how fucked we are"
|
||||
"You can call it fart if you want to."
|
||||
"wavelan is a battle field"
|
||||
"You are in a maze of gpio pins, all alike, all undocumented, and a few are wired to bombs."
|
||||
"And that is why humppa sucks... cause it has no cause."
|
||||
"cache aliasing is a problem that would have stopped in 1992 if someone had killed about 5 people who worked at Sun."
|
||||
"Don't spread rumours about me being gentle."
|
||||
"If municipal water filtering equipment was built by the gcc developers, the western world would be dead by now."
|
||||
"kettenis supported a new machine in my basement and all I got to do was fix a 1 character typo in his html page commit."
|
||||
"industry told us a lesson: when you're an asshole, they mail you hardware"
|
||||
"I was joking, really. I think I am funny :-)"
|
||||
"the kernel is a harsh mistress"
|
||||
"Have I ever been subtle? If my approach ever becomes subtle, shoot me."
|
||||
"the acpi stabs you in the back. the acpi stabs you in the back. you die ..."
|
||||
"My cats are more observant than you."
|
||||
"our kernels have no bugs"
|
||||
"style(9) has all these fascist rules, and i have a problem with some of them because i didn't come up with them"
|
||||
"I'm not very reliable"
|
||||
"I don't like control"
|
||||
"You aren't being conservative -- you are trying to be a caveman."
|
||||
"nfs loves everyone"
|
||||
"basically, dung beetles fucking. that's what kerberosV + openssl is like"
|
||||
"I would rather run Windows than use vi."
|
||||
"if you assign that responsibility to non-hikers I will walk over and cripple you now."
|
||||
"i ojbect two yoru splelng of achlhlocis."
|
||||
"We have two kinds of developers - those that deal with their own shit and those that deal with other people's shit."
|
||||
"If people keep adding such huge stuff, soon mg will be bigger than emacs."
|
||||
"this change comes down to: This year, next year, 5 years from now, 10 years from now, or Oh fuck."
|
||||
"backwards compatibility is king, and will remain king, until 2038."
|
||||
"I don't know if the Internet's safe yet."
|
||||
"Those who don't understand Unix are condemned to reinvent Multics in a browser"
|
||||
"Don't tell anybody I said that."
|
||||
"Complaint forms are handled in another department."
|
||||
"You'd be safer using Windows than the code which was just deleted."
|
||||
"Shit should not be shared."
|
||||
"the randomization in this entire codebase is a grand experiment in stupid"
|
||||
"My mailbox is full of shock."
|
||||
"my integer overflow spidey senses are tingling."
|
||||
"I'm just trying to improve the code..."
|
||||
"It's a pleasure to work on code you can't make worse."
|
||||
"It's largely bad style to do (int)sizeof"
|
||||
"When I see Makefile.in, I know that \"in\" is short for \"insane\"."
|
||||
"This is the beer. And that's why we need a hackathon."
|
||||
"Kill the past with fire, and declare Duran Duran is less cool today. Await remixes of the same thing performed by new talent."
|
||||
"Where did my \"fuck backwards compat\" compatriots go?"
|
||||
"I want a new vax, one that's not so slow."
|
||||
"This sausage is made from unsound meat."
|
||||
"The people who wrote this code are not on your side."
|
||||
"Well finally everyone can see that the shit is really shitty."
|
||||
"All that complexity stopped us from getting flying cars by today."))
|
||||
|
||||
(defun random-elt (list)
|
||||
"Return a random element from a list."
|
||||
(elt list (random (length list))))
|
||||
|
||||
(defun random-quote ()
|
||||
"Return a random Theo insult."
|
||||
(random-elt *quotes*))
|
||||
|
||||
(defcommand theo () ()
|
||||
"Print a random Theo insult."
|
||||
(message "~a" (random-theo-quote)))
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
* VOLUME
|
||||
|
||||
Display volume changes in a stumpwm message.
|
||||
|
||||
#+BEGIN_SRC common-lisp
|
||||
(load-module "volume")
|
||||
#+END_SRC
|
||||
|
||||
My setup:
|
||||
|
||||
#+BEGIN_SRC common-lisp
|
||||
(define-key *top-map* (kbd "XF86AudioLowerVolume") "volume Master 5%-")
|
||||
(define-key *top-map* (kbd "XF86AudioRaiseVolume") "volume Master 5%+")
|
||||
(define-key *top-map* (kbd "XF86AudioMute") "volume Master toggle")
|
||||
#+END_SRC
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
;;;; package.lisp
|
||||
|
||||
(defpackage #:volume
|
||||
(:use #:cl #:stumpwm)
|
||||
(:export #:volume))
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
;;;; volume.asd
|
||||
|
||||
(asdf:defsystem #:volume
|
||||
:description "Display volume changes as a message."
|
||||
:author "Toby Slight <tslight@pm.me>"
|
||||
:license "GPLv3"
|
||||
:version "0.0.1"
|
||||
:serial t
|
||||
:depends-on (#:stumpwm)
|
||||
:components ((:file "package")
|
||||
(:file "volume")))
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
;;;; volume.lisp
|
||||
|
||||
(in-package #:volume)
|
||||
|
||||
(defun get-volume (device action)
|
||||
"Return a cleaned up version of the output of the amixer command with a given
|
||||
ACTION. Simply return the volume percentage and the status of the device."
|
||||
(let* ((output (run-shell-command (concat "amixer set " device " " action) t))
|
||||
(start (search "[" output))
|
||||
(end (search (concat "]" (string #\linefeed)) output))
|
||||
(out (subseq output start end)))
|
||||
(split-string out "] [")))
|
||||
|
||||
(defcommand volume (device action)
|
||||
((:string "Enter Device: ")
|
||||
(:string "Enter Action: "))
|
||||
"Wrap volume commands and print a message containing current volume."
|
||||
(let* ((output (get-volume device action))
|
||||
(volume (nth 0 output))
|
||||
(status (string-upcase (nth 1 output))))
|
||||
(message "^B^5VOLUME: ^n~a~%^5STATUS: ^n~a" volume status)))
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
* XDGMENU
|
||||
|
||||
Generate a menu using [[https://freedesktop.org/wiki/Howto_desktop_files/][freedesktop.org]] .desktop files.
|
||||
|
||||
** USAGE
|
||||
|
||||
If run with an argument, the menu will be categorised, otherwise just a
|
||||
searchable list of all desktop files in XDG applications directories will be
|
||||
displayed.
|
||||
|
||||
#+BEGIN_SRC common-lisp
|
||||
(load-module "xdgmenu")
|
||||
#+END_SRC
|
||||
|
||||
My configuration:
|
||||
|
||||
#+BEGIN_SRC common-lisp
|
||||
(define-key *top-map* (kbd "s-SPC") "xdgmenu")
|
||||
(define-key *top-map* (kbd "s-.") "xdgmenu categories")
|
||||
(define-key *root-map* (kbd "r") "xdgmenu")
|
||||
(define-key *root-map* (kbd ".") "xdgmenu categories")
|
||||
#+END_SRC
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
;;;; package.lisp
|
||||
|
||||
(defpackage #:xdgmenu
|
||||
(:use #:cl #:stumpwm #:cl-ppcre)
|
||||
(:export #:*main-categories*
|
||||
#:*applications-directories*
|
||||
#:xdgmenu))
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
;;;; xdgmenu.asd
|
||||
|
||||
(asdf:defsystem #:xdgmenu
|
||||
:description "Generate menus using freedesktop.org .desktop files."
|
||||
:author "Toby Slight <tslight@pm.me>"
|
||||
:license "GPLv3"
|
||||
:version "0.0.1"
|
||||
:serial t
|
||||
:depends-on (#:stumpwm #:cl-ppcre)
|
||||
:components ((:file "package")
|
||||
(:file "xdgmenu")))
|
||||
|
|
@ -0,0 +1,150 @@
|
|||
;;;; xdgmenu.lisp
|
||||
|
||||
(in-package #:xdgmenu)
|
||||
|
||||
(defvar *applications-directories*
|
||||
(list (pathname (concat
|
||||
(getenv "HOME")
|
||||
"/.local/share/flatpak/exports/share/applications/"))
|
||||
(pathname (concat (getenv "HOME") "/.local/share/applications/"))
|
||||
#P"/var/lib/flatpak/exports/share/applications/"
|
||||
#P"/var/lib/snapd/desktop/applications/"
|
||||
#P"/usr/local/share/applications/"
|
||||
#P"/usr/share/applications/")
|
||||
"uiop:xdg-data-pathnames or getenv doesn't always seem to catch all of my
|
||||
environment's XDG data directories. Add them manually instead.")
|
||||
|
||||
(defvar *main-categories*
|
||||
(list "AudioVideo"
|
||||
"Audio"
|
||||
"Video"
|
||||
"Development"
|
||||
"Education"
|
||||
"Game"
|
||||
"Graphics"
|
||||
"Multimedia"
|
||||
"Network"
|
||||
"Office"
|
||||
"Other"
|
||||
"Science"
|
||||
"Settings"
|
||||
"System"
|
||||
"Utility")
|
||||
"Use https://standards.freedesktop.org/menu-spec/latest/apa.html as base, but
|
||||
add Multimedia and other, as I don't want 3 categories for media, and I want
|
||||
to catch any applications that don't have a category with other.")
|
||||
|
||||
(defun desktop-files ()
|
||||
"Get all the dot desktop files in all XDG applications directories."
|
||||
(mapcan (lambda (d) (directory (uiop:merge-pathnames* "*.desktop" d)))
|
||||
*applications-directories*))
|
||||
|
||||
(defun remove-keys (exec file)
|
||||
"Some KDE apps have this -caption %c in a few variations. %c is The
|
||||
translated name of the application as listed in the appropriate Name key in
|
||||
the desktop entry.
|
||||
|
||||
%k is the location of the desktop file as either a URI (if for example
|
||||
gotten from the vfolder system) or a local filename or empty if no location
|
||||
is known.
|
||||
|
||||
Remove any remaining keys and trailing options from the command."
|
||||
(let* ((c (ppcre:regex-replace-all " -caption.*\%c(\'|\"|)" exec ""))
|
||||
(k (ppcre:regex-replace-all "(\"|\'|)\%k(\"|\'|)" c file)))
|
||||
(first (split-string k "%"))))
|
||||
|
||||
(defun terminalp (cmd contents)
|
||||
"If the Terminal attribute is set to true append a terminal emulater to the
|
||||
command."
|
||||
(let ((is-terminal (string-downcase
|
||||
(ppcre:scan-to-strings "(?<=\\nTerminal\\=).*" contents))))
|
||||
(if (string= is-terminal "true")
|
||||
(concat "x-terminal-emulator -e " cmd)
|
||||
cmd)))
|
||||
|
||||
(defun get-category (contents)
|
||||
"Get the first value from the Categories field that matches one of the main
|
||||
freedesktop.org categories."
|
||||
(let ((category (first (intersection
|
||||
*main-categories*
|
||||
(split-string
|
||||
(ppcre:scan-to-strings
|
||||
"(?<=\\Categories\\=).*"
|
||||
contents)
|
||||
";")
|
||||
:test 'equalp))))
|
||||
(cond ((ppcre:scan "Audio|Video" category) "Multimedia")
|
||||
(nil "Other")
|
||||
(t category))))
|
||||
|
||||
(defun do-show (contents)
|
||||
"Return true so long as the NoDisplay or Hidden field is not set to true or
|
||||
the OnlyShowIn field doesn't contain anything. If OnlyShowIn has a value,
|
||||
it's likely this is a desktop specific application."
|
||||
(let* ((nodisplay (string-downcase
|
||||
(ppcre:scan-to-strings "(?<=\\nNoDisplay\\=).*" contents)))
|
||||
(hidden (string-downcase
|
||||
(ppcre:scan-to-strings "(?<=\\nHidden\\=).*" contents)))
|
||||
(only (ppcre:scan-to-strings "(?<=\\nOnlyShowIn\\=).*" contents)))
|
||||
(if (not (or (string= hidden "true")
|
||||
(string= nodisplay "true")
|
||||
(> (length only) 0)))
|
||||
t)))
|
||||
|
||||
(defun parse-desktop-file (file)
|
||||
(let ((contents (uiop:read-file-string (pathname file))))
|
||||
(if (do-show contents)
|
||||
(let* ((name (ppcre:scan-to-strings "(?<=\\nName\\=).*" contents))
|
||||
(exec (ppcre:scan-to-strings "(?<=\\nExec\\=).*" contents))
|
||||
(category (get-category contents))
|
||||
(cmd (remove-keys exec file))
|
||||
(cmd (terminalp cmd contents)))
|
||||
(list name cmd category)))))
|
||||
|
||||
(defun make-categories (applications)
|
||||
(mapcar
|
||||
(lambda (c)
|
||||
(cons c
|
||||
(remove nil
|
||||
(mapcar
|
||||
(lambda (a)
|
||||
(if (equal c (third a))
|
||||
a))
|
||||
applications))))
|
||||
*main-categories*))
|
||||
|
||||
(defun menu (&optional (categorise nil))
|
||||
(let ((apps (sort (remove nil (mapcar #'parse-desktop-file (desktop-files)))
|
||||
#'string-lessp :key #'first)))
|
||||
(if categorise
|
||||
(remove-if (lambda (c) (<= (length c) 1)) (make-categories apps))
|
||||
apps)))
|
||||
|
||||
(defun commandp (command-name)
|
||||
(loop
|
||||
:for command :being :the :hash-keys :of *command-hash*
|
||||
:when (string= (symbol-name command-name)
|
||||
(symbol-name command))
|
||||
:return command))
|
||||
|
||||
(defun category-menu ()
|
||||
(labels
|
||||
((pick (options)
|
||||
(let ((selection (select-from-menu (current-screen) options nil)))
|
||||
(cond
|
||||
((null selection) nil)
|
||||
((stringp (second selection))
|
||||
(run-shell-command (second selection)))
|
||||
((and (symbolp (second selection))
|
||||
(commandp (second selection)))
|
||||
(funcall (second selection)))
|
||||
(t (if (equalp ".." (first selection))
|
||||
(pick (second selection))
|
||||
(pick (append (list (list ".." options))
|
||||
(cdr selection)))))))))
|
||||
(pick (menu t))))
|
||||
|
||||
(defcommand xdgmenu (&optional (categorise nil)) ((:string))
|
||||
(if categorise
|
||||
(category-menu)
|
||||
(run-shell-command (second (select-from-menu (current-screen) (menu))))))
|
||||
Loading…
Reference in New Issue