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