x11-wm/stumpwm.stumpwm-contrib
1
0
Fork 0
mirror of https://github.com/stumpwm/stumpwm-contrib.git synced 2026-09-10 07:26:25 -04:00
Code Issues Actions Packages Projects Releases Wiki Activity

Merge pull request #1 from stumpwm/master

Browse source 
update
This commit is contained in:
szos 2025-01-01 10:25:15 -08:00 committed by GitHub
parent 3a785c9757 c4f077b1fe
commit 36253e2ec5
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
51 changed files with 1173 additions and 329 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
README.org
View file

@ -68,9 +68,10 @@ Please see =README.org= files for each module for further details. Missing modul
* Third Party Modules
Advertise your module here, open a PR and include a org-mode link!
- [[https://github.com/njkli/stumpwm-weather/blob/master/readme.org][stumpwm-weather]] :: Displays weather in the modeline
- [[https://gitlab.com/sasanidas/stumpwm-dmenu][stumpwm-dmenu]] :: StumpWM [[https://tools.suckless.org/dmenu/][dmenu]] integration
- [[https://codeberg.org/sasanidas/stumpwm-dmenu][stumpwm-dmenu]] :: StumpWM [[https://tools.suckless.org/dmenu/][dmenu]] integration
- [[https://github.com/Junker/stumpwm-pamixer][stumpwm-pamixer]] :: Pulseaudio volume and microphone control module
- [[https://github.com/Junker/stumpwm-acpi-backlight][stumpwm-acpi-backlight]] :: ACPI backlight control module for StumpWM
- [[https://codeberg.org/sasanidas/stumpwm-mullvad][stumpwm-mullvad]] :: StumpWM [[https://mullvad.net/en/][mullvad]] cli integration
* Current Modules
(click for its respective README/docs)
@ -81,6 +82,7 @@ Advertise your module here, open a PR and include a org-mode link!
- [[./media/amixer/README.org][amixer]] :: Manipulate the volume using amixer
- [[./media/stump-radio/README][stump-radio]] :: Minimalistic mplayer-based radio for StumpWM.
- [[./media/stump-volume-control/README][stump-volume-control]] :: Minimalistic amixer-based volume control for StumpWM.
- [[./media/stumpwm-mixer/README.md][stumpwm-mixer]] :: Interface to FreeBSD's built-in sound mixer
- [[./media/stumpwm-sndioctl/README.md][stumpwm-sndioctl]] :: Interface to OpenBSD's sndioctl from StumpWM.
** Minor Modes
- [[./minor-mode/mpd/README.org][mpd]] :: Displays information about the music player daemon (MPD).
@ -96,7 +98,9 @@ Advertise your module here, open a PR and include a org-mode link!
- [[./modeline/maildir/README.org][maildir]] :: Display maildir information in the modeline (%M conflicts with mem).
- [[./modeline/mem/README.org][mem]] :: Display memory in the modeline, %M conflicts with maildir.
- [[./modeline/net/README.org][net]] :: Displays information about the current network connection.
- [[./modeline/pianobar/README.org][pianobar]] :: Display Pianobar's now playing info in modeline
- [[./modeline/stumptray/README.org][stumptray]] :: System Tray for stumpwm.
- [[./modeline/ticker/README.org][ticker]] :: Display ticker price on StumpWM modeline.
- [[./modeline/wifi/README.org][wifi]] :: Display information about your wifi.
** Utilities
- [[./util/alert-me/README.org][alert-me]] :: Alert me that an event is coming

2
media/stump-volume-control/volume-control.lisp
View file

@ -27,7 +27,7 @@
(defcommand volume-up () ()
(run-shell-command (format nil "amixer ~asset Master playback 2db+"
(translate-device-to-option *sound-card*)))
(message "Audio bit lowder."))
(message "Audio bit louder."))
(defcommand volume-down () ()
(run-shell-command (format nil "amixer ~asset Master playback 2db-"

15
media/stumpwm-mixer/README.md Normal file
View file

@ -0,0 +1,15 @@
# stumpwm-mixer
This is a StumpWM interface to FreeBSD's built-in `mixer` command so
that you can control the volume from StumpWM and get some visual
feedback when the volume changes. It's deliberately designed to have a
similar interface to the `stumpwm-sndioctl` module.
Add something like this to your config to bind its commands to the
media buttons:
```
(define-key *top-map* (kbd "XF86AudioMute") "toggle-mute")
(define-key *top-map* (kbd "XF86AudioLowerVolume") "volume-down")
(define-key *top-map* (kbd "XF86AudioRaiseVolume") "volume-up")
```

51
media/stumpwm-mixer/mixer.lisp Normal file
View file

@ -0,0 +1,51 @@
(in-package #:stumpwm-mixer)
(defun mixer-output ()
(let ((output (run-shell-command "mixer" t)))
(loop for line in (uiop:split-string output :separator '(#\newline))
collect (uiop:split-string line :separator '(#\space)))))
(defun parse-mixer ()
(let ((output (mixer-output))
(rem '("" "Mixer" "is" "currently" "set" "to")))
(loop for line in output
collect (remove-if
(lambda (x)
(member x rem :test #'equalp))
line))))
(defun print-audio ()
(let* ((output (parse-mixer))
(volume (car (cdr (assoc "pcm" output :test #'equalp))))
(muted (car (cdr (assoc "vol" output :test #'equalp)))))
(message
(format nil "Volume: ~a~:[~; (muted)~]" volume
(string= "0:0" muted)))))
(defcommand volume-up () ()
(run-shell-command
"mixer pcm +5")
(print-audio))
(defcommand volume-down () ()
(run-shell-command
"mixer pcm -5")
(print-audio))
(defcommand toggle-mute () ()
(let ((vol (assoc "vol" (parse-mixer)
:test #'equalp)))
(if (equalp (cadr vol) "0:0")
(run-shell-command
"mixer vol 100")
(run-shell-command
"mixer vol 0"))
(print-audio)))
(defcommand set-mute () ()
(run-shell-command
"mixer vol 0"))
(defcommand unset-mute () ()
(run-shell-command
"mixer vol 100"))

7
media/stumpwm-mixer/package.lisp Normal file
View file

@ -0,0 +1,7 @@
(defpackage #:stumpwm-mixer
(:use :cl :stumpwm)
(:export :volume-up
:volume-down
:toggle-mute
:set-mute
:unset-mute))

8
media/stumpwm-mixer/stumpwm-mixer.asd Normal file
View file

@ -0,0 +1,8 @@
(defsystem "stumpwm-mixer"
:description "Interface to FreeBSD's built-in sound mixer"
:author "Nyx <n1x@riseup.net>"
:license "ISC"
:serial t
:depends-on ("stumpwm")
:components ((:file "package")
(:file "mixer")))

1
media/stumpwm-sndioctl/package.lisp
View file

@ -20,6 +20,7 @@
(:use #:cl #:stumpwm)
(:export #:*terse*
#:*step*
#:*doas*
#:volume-up
#:volume-down
#:toggle-mute

2
media/stumpwm-sndioctl/stumpwm-sndioctl.asd
View file

@ -19,7 +19,7 @@
(asdf:defsystem #:stumpwm-sndioctl
:description "Interface to OpenBSD's sndioctl from StumpWM."
:author "Dr Ashton Fagg <ashton@fagg.id.au>"
:license "ISC""
:license "ISC"
:version "0.0.1"
:homepage "https://github.com/fagg/stumpwm-sndioctl"
:serial t

70
media/stumpwm-sndioctl/stumpwm-sndioctl.lisp
View file

@ -22,36 +22,47 @@
(defvar *step* 0.05)
(defvar *terse* nil "If t, this will supress messages that get shown on changes to volume.")
(defvar *doas* nil "If t, this will use doas to run sndioctl.")
(defun call-sndioctl (args captive)
(defun call-sndioctl (args)
"Calls sndioctl with the required arguments."
(run-shell-command (format nil "sndioctl ~a" args) captive))
(defun make-step-cmd (direction)
"Helpful wrapper for generating command strings for incrementing/decrementing volume."
(cond
((string= "+" direction)
(format nil "-q output.level=+~a" *step*))
((string= "-" direction)
(format nil "-q output.level=-~a" *step*))
(t (error "Not a valid step direction!"))))
(run-shell-command
(format nil "~asndioctl ~a" (if *doas* "doas " "") args)
t))
(defun get-mute-state-string ()
"Returns a nicely formatted string containing the current mute state."
(let ((state (aref (call-sndioctl "-n output.mute" t) 0)))
(cond
((string= "0" state)
(format nil "Muted: No"))
((string= "1" state)
(format nil "Muted: Yes"))
(t (error "Unknown output from sndioctl -n output.mute")))))
(let* ((code-to-str
(lambda (c)
(cond
((string= "0" c) "No")
((string= "1" c) "Yes")
(t "Err"))))
(get-state
(lambda (key)
(handler-case
(funcall code-to-str
(aref (call-sndioctl (format nil "-n ~a" key)) 0))
(error (c) (declare (ignore c)) "N/A"))
))
(in-state (funcall get-state "input.mute"))
(out-state (funcall get-state "output.mute")))
(format nil "Muted in: ~a Muted out: ~a" in-state out-state)))
(defun get-volume-level-string ()
"Returns a nicely formatted string containing the current volume level."
(let ((level
(with-input-from-string (vol-str (call-sndioctl "-n output.level" t))
(read vol-str))))
(format nil "Volume: ~2$%" (* 100.0 level))))
(let* ((get-volume
(lambda (key)
(handler-case
(format nil "~2$%"
(* 100
(with-input-from-string
(vol-str (call-sndioctl (format nil "-n ~a" key)))
(read vol-str))))
(error (c) (declare (ignore c)) "N/A"))))
(in-volume (funcall get-volume "input.level"))
(out-volume (funcall get-volume "output.level")))
(format nil "Volume in: ~a Volume out: ~a" in-volume out-volume)))
(defun sndioctl-status-message ()
"Returns a string indicating currrent sndioctl state."
@ -59,30 +70,35 @@
(defcommand volume-up () ()
"Volume goes up"
(call-sndioctl (make-step-cmd "+") nil)
(call-sndioctl (format nil "-q input.level=+~a" *step*))
(call-sndioctl (format nil "-q output.level=+~a" *step*))
(if (not *terse*)
(message (sndioctl-status-message))))
(defcommand volume-down () ()
"Volume goes down"
(call-sndioctl (make-step-cmd "-") nil)
(call-sndioctl (format nil "-q input.level=-~a" *step*))
(call-sndioctl (format nil "-q output.level=-~a" *step*))
(if (not *terse*)
(message (sndioctl-status-message))))
(defcommand toggle-mute () ()
"Toggles mute"
(call-sndioctl "-q output.mute=!" nil)
(call-sndioctl "-n input.mute=!")
(call-sndioctl "-n output.mute=!")
(if (not *terse*)
(message (sndioctl-status-message))))
(defcommand set-mute () ()
"Force sets mute to ON"
(call-sndioctl "-q output.mute=1" nil)
(call-sndioctl "-q input.mute=1")
(call-sndioctl "-q output.mute=1")
(if (not *terse*)
(message (sndioctl-status-message))))
(defcommand unset-mute () ()
"Force sets mute to OFF"
(call-sndioctl "-q output.mute=0" nil)
(call-sndioctl "-q inout.mute=0")
(call-sndioctl "-q output.mute=0")
(if (not *terse*)
(message (sndioctl-status-message))))

29
minor-mode/mpd/mpd.lisp
View file

@ -116,7 +116,8 @@
(message "Error with mpd connection: ~a" c)
(setf *mpd-socket* nil)
(when *mpd-timer*
(cancel-timer *mpd-timer*)))))
(cancel-timer *mpd-timer*)
(setf *mpd-timer* nil)))))
(message "Error: not connected to mpd")))
(defun mpd-send (command)
@ -204,7 +205,13 @@
(when *mpd-socket*
(when *mpd-timeout*
(setf *mpd-timer*
(run-with-timer *mpd-timeout* *mpd-timeout* 'mpd-ping)))
(run-with-timer *mpd-timeout* *mpd-timeout*
(lambda ()
(if *mpd-socket*
(mpd-ping)
(when *mpd-timer*
(cancel-timer *mpd-timer*)
(setf *mpd-timer* nil)))))))
(mpd-receive t)
(when *mpd-password*
(mpd-format-command "password \"~a\"" *mpd-password*))))
@ -681,10 +688,12 @@ Volume
(defcommand mpd-disconnect () ()
"Disconnect from mpd server"
(when *mpd-timer*
(cancel-timer *mpd-timer*)
(setf *mpd-timer* nil))
(with-mpd-connection
(close *mpd-socket*)
(setf *mpd-socket* nil)
(when *mpd-timer* (cancel-timer *mpd-timer*))))
(setf *mpd-socket* nil)))
(defcommand mpd-kill () ()
(mpd-send-command "kill"))
@ -763,13 +772,17 @@ Passed an argument of zero and if crossfade is on, toggles crossfade off."
(defcommand mpd-volume-up () ()
(let* ((status (mpd-send-command "status"))
(vol (read-from-string (assoc-value :volume status))))
(mpd-send-command (format nil "setvol ~a" (+ vol *mpd-volume-step*)))))
(vol (read-from-string (assoc-value :volume status)))
(new-vol (+ vol *mpd-volume-step*)))
(mpd-send-command (format nil "setvol ~a" new-vol))
(message "~a" new-vol)))
(defcommand mpd-volume-down () ()
(let* ((status (mpd-send-command "status"))
(vol (read-from-string (assoc-value :volume status))))
(mpd-send-command (format nil "setvol ~a" (- vol *mpd-volume-step*)))))
(vol (read-from-string (assoc-value :volume status)))
(new-vol (- vol *mpd-volume-step*)))
(mpd-send-command (format nil "setvol ~a" new-vol))
(message "~a" new-vol)))
(defcommand mpd-clear () ()
(mpd-send-command "clear"))

51
modeline/battery-portable/battery-portable.lisp
View file

@ -63,13 +63,13 @@
(:documentation "Returns all recognized batteries."))
(defun preferred-battery-method (&optional (sysfs t))
#- (or linux openbsd)
#- (or linux bsd)
nil
#+ linux
(if sysfs
(make-instance 'sysfs-method)
(make-instance 'procfs-method))
#+ openbsd
#+ bsd
(make-instance 'usr-sbin-apm-method))
;;; Battery class
@ -228,7 +228,9 @@
(state (or (and (stringp state)
(cond ((string= state "Charging") :charging)
((string= state "Discharging") :discharging)
((string= state "Full") :charged)
((or (string= state "Full")
(string= state "Not charging"))
:charged)
(t :unknown)))
:unknown)))
(values state
@ -251,19 +253,48 @@
;;; OpenBSD /usr/sbin/apm implementation
#+ openbsd
#+ bsd
(progn
(defclass usr-sbin-apm-method (battery-method) ()
(:documentation "Collect battery information through OpenBSD' /usr/sbin/apm program."))
(:documentation "Collect battery information through BSD's /usr/sbin/apm
program."))
(defclass usr-sbin-apm-battery (battery) ())
(defun parse-apm (apm)
"This wrapper is needed because FreeBSD's APM output is in a different
order from OpenBSD and NetBSD's"
(flet ((parser ()
(ignore-errors (parse-integer (read-line apm)))))
#+ (or openbsd netbsd)
(list :state (parser)
:percent (parser)
:minutes (parser)
:ac (parser))
#+ freebsd
(list :ac (parser)
:state (parser)
;; FreeBSD outputs in seconds rather than minutes, so we need
;; to convert it. Cautiously rounds down to display slightly
;; less time than is actually remaining. It also outputs -1
;; if it's charging.
:percent (parser)
:minutes (let ((sec (parser)))
(if (= -1 sec)
nil
(floor (/ sec 60)))))))
(defun read-usr-sbin-apm-info ()
(with-input-from-string (apm (run-shell-command "/usr/sbin/apm -ablm" t))
(let* ((state (ignore-errors (parse-integer (read-line apm))))
(percent (ignore-errors (parse-integer (read-line apm))))
(minutes (ignore-errors (parse-integer (read-line apm))))
(ac (ignore-errors (parse-integer (read-line apm)))))
(with-input-from-string (apm (run-shell-command
#+ (or openbsd netbsd)
"/usr/sbin/apm -ablm"
#+ freebsd
"/usr/sbin/apm -ablt" t))
(let* ((parsed (parse-apm apm))
(state (getf parsed :state))
(percent (getf parsed :percent))
(minutes (getf parsed :minutes))
(ac (getf parsed :ac)))
(unless (and (or (null state) (eql state 4))
(or (null ac) (eql ac 255)))
(values (case state

80
modeline/bitcoin/README.org
View file

@ -1,3 +1,9 @@
* Bitcoin
*THIS MODULE IS DEPRECATED, AND SUPERSEDED BY THE* =ticker= *MODULE*.
Show Bitcoin (₿) value in the modeline.
** Usage
Place the following in your =~/.stumpwmrc= file:
@ -6,15 +12,34 @@ Place the following in your =~/.stumpwmrc= file:
(load-module "bitcoin")
#+END_SRC
Then you can use =%b= in your mode line format:
Then you can use =%b= in your mode line
format:
#+BEGIN_SRC lisp
(setf *screen-mode-line-format*
(list "[%n]" ; Groups
"%v" ; Windows
"^>" ; Push right
" | %b" ; Bitcoin
" | %d")) ; Clock
(setf *screen-mode-line-format*
(list "[%n]" ; Groups
"%v" ; Windows
"^>" ; Push right
" | %b" ; Bitcoin
" | %d")) ; Clock
#+END_SRC
And define some parameters:
#+BEGIN_SRC lisp
(setf bitcoin:*modeline-use-colors* t ; use colors
bitcoin:*threshold* 0.001 ; 0.001 is a 0.1% deviation from average
bitcoin:*time-delay* 30 ; seconds
bitcoin:*decimals* 2 ; number of decimal digits
bitcoin:*local-code* 2 ; formatting code to use
bitcoin:*modeline-gauge* t ; show gauge bar
bitcoin:*gauge-width* 9) ; width of the gauge bar in characters
#+END_SRC
It gets actual price through API, so needs =dexador= and =yason=. Also, the price getter is asynchronous with the =lparallel= machinery.
#+BEGIN_SRC lisp
(ql:quickload '("dexador" "yason" "lparallel"))
#+END_SRC
** Notes
@ -23,11 +48,11 @@ Price format is colorized depending on =*modeline-use-colors*=
flag. You can customize setting =t= or =nil= in =~/.stumpwmrc=:
#+BEGIN_SRC lisp
(setf bitcoin:*modeline-use-colors* t)
(setf bitcoin:*modeline-use-colors* t) ; use colors
#+END_SRC
Colors depends on a comparison between actual value and last values
average:
Colors depends on a comparison between actual value and the last
values average:
| Color | Code | Description |
|---------------+---------+-----------------------------------|
@ -47,13 +72,6 @@ Last values average is calculated over a 3 hours values list
=*values*=, where values are stored on every modeline refresh in a
FIFO fashion.
Get actual price through Coinbase(TM) API, so needs =dexador=, =babel=
and =yason=.
#+BEGIN_SRC lisp
(ql:quickload '("dexador" "babel" "yason"))
#+END_SRC
Connection to =*url*= price server is limited by a =*time-delay*=
interval, in seconds. So connection attempts between interval time
are blocked. Interval can be customized too:
@ -62,17 +80,37 @@ are blocked. Interval can be customized too:
(setf bitcoin:*time-delay* 30) ; seconds
#+END_SRC
The number of decimal places is set by =*decimals*=, when =0= there is
no decimals.
#+BEGIN_SRC lisp
(setf bitcoin:*decimals* 2) ; number of decimal digits
#+END_SRC
The localization format is set by =*local-code*=, when =0= there is no
thousand separator and gives =1234.56=, when =1= the thousand separator
is =#\,= and gives =1,234.56=, when =2= the thousand separator is =#\.=
and gives =1.234,56=, and when =3= the thousand separator is =#\Space=
and gives =1 234,56=. Can be customized too:
thousand separator, gives =1234.56= and the =*decimals*= parameter
does not work, when =1= the thousand separator is =comma= and gives
=1,234.56=, when =2= the thousand separator is =period= and gives
=1.234,56=, and when =3= the thousand separator is =space= and gives
=1 234,56=. Can be customized too:
#+BEGIN_SRC lisp
(setf bitcoin:*local-code* 2) ; formatting code to use
#+END_SRC
It is possible to add a gauge bar with the tendency of the actual value
between the low and high in the last 24 hours with =*modeline-gauge*=.
The gauge bar width is set by =*gauge-width*=.
#+BEGIN_SRC lisp
(setf bitcoin:*modeline-gauge* t) ; show gauge bar
(setf bitcoin:*gauge-width* 9) ; width of the gauge bar in characters
#+END_SRC
** Issues
Try to use conditions' =handler-case= machinery to avoid the internet
timeouts or the computer sleeping process, to stuck the modeline.
The =truncate= function is used when formatting the values, so some
precission loss is expected.

2
modeline/bitcoin/bitcoin.asd
View file

@ -6,8 +6,8 @@
:license "GPLv3"
:homepage "https://github.com/stumpwm/stumpwm-contrib/"
:depends-on ("stumpwm" ; Use add-screen-mode-line-formatter
"lparallel" ; Connect to API with concurrency
"dexador" ; Get data from url
"babel" ; Translate data to string
"yason") ; Parse json
:components ((:file "package")
(:file "bitcoin" :depends-on ("package"))))

299
modeline/bitcoin/bitcoin.lisp
View file

@ -26,29 +26,16 @@ positive because `*values-size*'.")
"Localization code, `0' gives 1234.56, `1' gives 1,234.56, `2' gives
1.234,56, and `3' gives 1 234,56.")
;;; Get price
(defparameter *decimals* 2
"Number of decimals, set to `0' for no decimals.")
(defparameter *url* "https://api.coindesk.com/v1/bpi/currentprice.json"
"Location of price provider.")
(defparameter *modeline-gauge* t
"Show the tendency graphical gauge.")
(defvar *prev-time* 0
"Store previous time when got price.")
(defparameter *gauge-width* 9
"Width of the graphical gauge in characters. Must be greater than 1.")
(defun get-value-from-url ()
"Get the actual USD-BTC value."
;; Just in case internet drops
(handler-case
(gethash "rate_float"
(gethash "USD"
(gethash "bpi"
(yason:parse
(babel:octets-to-string
(dexador:get *url* :keep-alive t)
:encoding :utf-8)))))
;; Return NIL in case some condition is triggered
(condition () nil)))
;;; Store prices
;;; Global variables
(defvar *values*
(make-list (truncate (/ (* 3 60 60) *time-delay*)) ; 3 hours
@ -58,168 +45,142 @@ hours getting values: a new coin value is appended in `*values*' every
`*time-delay*', so it is divided the desired n time in seconds by the
time-delay in seconds.")
(defvar *value* 0.0
"Last value got from `*url*'.")
(defvar *values-low* 0.0
"The low value in `*values*'.")
(defvar *values-high* 0.0
"The high value in `*values*'.")
(defvar *values-average* 0.0
"Average of values in `*values*'.")
(defvar *initialized* nil
"When not nil the lparallel kernel has been initialized.")
;;; Get price
(defparameter *url* "https://api.kraken.com/0/public/Ticker?pair=xbtusd"
"Location of price provider.")
(defun get-values-from-url ()
"Get the USD-BTC, 24h LOW and 24h HIGH values."
(let ((response (handler-case
(gethash "XXBTZUSD"
(gethash "result"
(yason:parse
(dexador:get *url*
:keep-alive nil))))
;; Return NIL in case some condition is triggered
(condition () nil))))
(unless (null response)
(list (read-from-string (first (gethash "c" response)))
(read-from-string (second (gethash "l" response)))
(read-from-string (second (gethash "h" response)))))))
(defun refresh-values ()
"Refresh values from `*url*' if the `*time-delay*' has been reached.
Get the actual USD-BTC value, store value in list, preserve list size
popping first value, calculate average and set formatting depending on
value vs average."
(do ()
(nil)
(let ((values (get-values-from-url)))
(setf *value* (first values)
*values-low* (second values)
*values-high* (third values)))
;; Add value to values list, pushing to front
(push *value* *values*)
;; Preserve values list size, popping from end
(setf *values* (nreverse *values*))
(pop *values*)
(setf *values* (nreverse *values*))
;; Calculate average of values, excluding NIL values
;; that could exist because network issues.
(let ((values-clean (remove-if-not #'numberp *values*)))
(setf *values-average* (/ (reduce #'+ values-clean)
(max 1 (length values-clean)))))
(sleep *time-delay*)))
;;; Write on modeline
(defun comma-point (stream arg &rest args)
(declare (ignore args))
(format stream
"~,,',,:D.~A"
(truncate arg)
(let ((float-string (format nil "~,2F" arg)))
(subseq float-string (1+ (position #\. float-string))))))
;;; Simple format positive numbers, using directive D for thousand
;;; separator and direct value displacement in the decimal part. Uses
;;; truncate, so there is some precission loss, e.g. (truncate
;;; 1231231.0999) gives 1231231 and 0.125. Does NOT work with negative
;;; numbers.
;;; More in https://stackoverflow.com/questions/35012859
(defun format-decimal (n sep int com)
"Return Number formated in groups of INTerval length every and
separated by SEParator, with COMma character as decimal separator. The
number of digits in the decimal part is defined by the global
parameter `*decimals*'. All parameters but N are strings. COMma
character should not be the tilde `~'."
(let* ((num-string (concatenate 'string "~,,'" sep "," int ":D"))
(decimals (format nil "~D" *decimals*))
(dec-string (concatenate 'string com "~" decimals ",'0D")))
(multiple-value-bind (i r) (truncate n)
(concatenate
'string
(format nil num-string i)
(when (< 0 *decimals*)
(format nil dec-string (truncate (* (expt 10 *decimals*) r))))))))
(defun point-comma (stream arg &rest args)
(declare (ignore args))
(format stream
"~,,'.,:D,~A"
(truncate arg)
(let ((float-string (format nil "~,2F" arg)))
(subseq float-string (1+ (position #\. float-string))))))
(defun space-comma (stream arg &rest args)
(declare (ignore args))
(format stream
"~,,' ,:D,~A"
(truncate arg)
(let ((float-string (format nil "~,2F" arg)))
(subseq float-string (1+ (position #\. float-string))))))
(defun gauge (v l h n)
"Draw a gauge control with Value at the point between Low and High in
an N length control."
(if (and (< l h) (<= l v) (<= v h) (> n 1))
(let* ((line (make-sequence 'string n :initial-element #\-))
(segment (floor (* n (/ (- v l) (- h l)))))
(segment (if (= v h) (1- segment) segment)))
(replace line "*" :start1 segment))
"-*-*-"))
(defun bitcoin-modeline (ml)
"Get the actual USD-BTC value, store value in list, preserve list size
popping first value, calculate average and set formatting depending on
value vs average. This function is evaluated on every modeline refresh."
"This function is evaluated on every modeline refresh and defines
the modeline string, so the values exist as global variables and are
updated with the `refresh-values' function."
(declare (ignore ml))
(let ((now (/ (get-internal-real-time) internal-time-units-per-second)))
(when (> (- now *prev-time*) *time-delay*)
(progn (setf *prev-time* now)
;; Add value to values list, pushing to front
(push (get-value-from-url) *values*)
;; Preserve values list size, popping from end
(setf *values* (nreverse *values*))
(pop *values*)
(setf *values* (nreverse *values*))
;; Calculate average of values, excluding NIL values
;; that could exist because network issues.
(let ((clean (remove-if-not #'numberp *values*)))
(setf *values-average* (/ (reduce #'+ clean)
(if (zerop (length clean))
1
(length clean))))))))
;; Launch asynchronous process to capture values
(unless *initialized*
(setf *initialized* t)
(let ((lparallel:*kernel*
(lparallel:make-kernel 1 :name "bitcoin-kernel")))
(lparallel:submit-task (lparallel:make-channel)
(lambda ()
(refresh-values)))))
;; Actual value must be positive number
(if (and (numberp (car *values*)) (plusp (car *values*)))
(if (and (numberp *value*) (plusp *value*))
;; Apply desired format to value
(let ((value-string
(case *local-code*
(0 (format nil "~,2F" (car *values*)))
(1 (format nil "~/bitcoin::comma-point/" (car *values*)))
(2 (format nil "~/bitcoin::point-comma/" (car *values*)))
(3 (format nil "~/bitcoin::space-comma/" (car *values*)))
(otherwise (format nil "~,2F" (car *values*))))))
(concatenate
'string
(case *local-code*
(0 (format nil "~,2F" *value*))
(1 (format-decimal *value* "," "3" "."))
(2 (format-decimal *value* "." "3" ","))
(3 (format-decimal *value* " " "3" ","))
(otherwise (format nil "~,2F" *value*)))
(when *modeline-gauge*
(concatenate
'string
" "
(gauge *value* *values-low* *values-high* *gauge-width*))))))
;; Return with color if desired
(if *modeline-use-colors*
(let* ((diff (- (car *values*) *values-average*))
(pdiff (/ diff (if (zerop (car *values*))
1
(car *values*)))))
(cond ((> pdiff *threshold*)
(format nil "^[^B^3*~A^]" value-string))
((< pdiff (- *threshold*))
(format nil "^[^1*~A^]" value-string))
(t (format nil "^[^7*~A^]" value-string))))
(format nil "^[^**~A^]" value-string)))
(concatenate
'string
(if *modeline-use-colors*
(let* ((diff (- *value* *values-average*))
(pdiff (/ diff (max 1 *value*))))
(cond ((> pdiff *threshold*)
(format nil "^[^B^3*~A^]" value-string))
((< pdiff (- *threshold*))
(format nil "^[^1*~A^]" value-string))
(t (format nil "^[^7*~A^]" value-string))))
(format nil "^[^**~A^]" value-string))))
;; The value is not a positive number
(format nil "-BTC-")))
(stumpwm:add-screen-mode-line-formatter #\b 'bitcoin-modeline)
;;; Debugging ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CL-USER > (declaim (optimize (speed 0) (debug 3) (safety 0)))
;; CL-USER > (asdf:load-system :bitcoin)
;; CL-USER > (in-package "BITCOIN")
;;; Wile executing, swap to code buffers, and any re-compile-load-ed
;;; changes will be visible. Recall `C-c C-b' stops loop in Sly REPL.
;; (do () (nil)
;; (let* ((price (get-value-from-url))
;; (clean (remove-if-not #'numberp *values*))
;; (average (/ (reduce #'+ clean)
;; (length clean)))
;; (diff (- price average)))
;; (format t "~&~2$ ~2$ ~2@$ ~4@$% ~a"
;; price
;; average
;; diff
;; (* 100 (/ diff price))
;; (bitcoin-modeline t)))
;; (force-output)
;; (sleep 3))
;; (do () (nil)
;; (format t "~&~a" (bitcoin-modeline t))
;; (force-output)
;; (sleep 1))
;;; Search optimized code to push/append/pop list. See time and conses.
;; (time
;; (do ((i 1 (1+ i))
;; (l (make-list 10 :initial-element 0)))
;; ((> i 10))
;; (push i l)
;; (pop l)
;; (format t "~&~A" l)))
;; (time
;; (do ((i 1 (1+ i))
;; (l (make-list 10 :initial-element 0)))
;; ((> i 1000000) (format t "~&~A" l))
;; (setf l (append l (list i)))
;; (pop l)))
;;; Best option and the car is the last pushed element
;; (time
;; (do ((i 1 (1+ i))
;; (l (make-list 10 :initial-element 0)))
;; ((> i 1000000) (format t "~&~A" l))
;; (push i l)
;; (setf l (nreverse l))
;; (pop l)
;; (setf l (nreverse l))))
;;; Seek for optimal number formatting function
;;; From https://stackoverflow.com/questions/35012859
;; (defun comma-point (stream arg &rest args)
;; (declare (ignore args))
;; (format stream
;; "~,,',,:D.~A"
;; (truncate arg)
;; (let ((float-string (format nil "~,2F" arg)))
;; (subseq float-string (1+ (position #\. float-string))))))
;; (defun point-comma (stream arg &rest args)
;; (declare (ignore args))
;; (format stream
;; "~,,'.,:D,~A"
;; (truncate arg)
;; (let ((float-string (format nil "~,2F" arg)))
;; (subseq float-string (1+ (position #\. float-string))))))
;; (defun space-comma (stream arg &rest args)
;; (declare (ignore args))
;; (format stream
;; "~,,' ,:D,~A"
;; (truncate arg)
;; (let ((float-string (format nil "~,2F" arg)))
;; (subseq float-string (1+ (position #\. float-string))))))
;; (defun custom (stream arg &rest args)
;; (declare (ignore args))
;; (multiple-value-bind (quotient remainder) (truncate arg)
;; (format stream
;; "~,,'.,:D,~D"
;; quotient
;; (truncate (* 100 remainder)))))

5
modeline/bitcoin/package.lisp
View file

@ -5,4 +5,7 @@
(:export #:*modeline-use-colors*
#:*threshold*
#:*time-delay*
#:*local-code*))
#:*local-code*
#:*decimals*
#:*modeline-gauge*
#:*gauge-width*))

33
modeline/cpu/README.org
View file

@ -5,14 +5,35 @@ Put:
#+END_SRC
In your =~/.stumpwmrc=
Then you can use:
Then you can use ~%C~ in your mode line format:
%c (CPU usage as %)
%C (CPU usage as bar graph)
%t (CPU temperature)
%f (CPU frequency)
#+BEGIN_SRC lisp
(setf *screen-mode-line-format*
(list "[%n]" ; Groups
"%v" ; Windows
"^>" ; Push right
" | %C" ; CPU module
" | %d")) ; Clock
#+END_SRC
in your mode line format.
You can customize what's displayed in CPU module by changing the ~cpu::*cpu-modeline-fmt*~ variable in your =init.lisp=:
#+BEGIN_SRC lisp
(setf cpu::*cpu-modeline-fmt* "%c %t") ; default is "%c (%f) %t"
#+END_SRC
|------+---------------------|
| Code | Result |
|------+---------------------|
| %% | A literal '%' |
| %c | CPU usage |
| %C | CPU usage graph |
| %f | CPU frequency |
| %r | CPU frequency range |
| %t | CPU temperature |
|------+---------------------|
You can see the rest of the variables in the =cpu.lisp= file.
** Notes

55
modeline/pianobar/README.org Normal file
View file

@ -0,0 +1,55 @@
** Setup
Add to your .config/pianobar/config this line:
#+BEGIN_SRC conf
event_command = ~/.config/pianobar/event_command.py
#+END_SRC
event_command.py should be executable and look like this:
#+BEGIN_SRC python
#!/usr/bin/python
import os
import sys
from os.path import expanduser, join
path = os.environ.get('XDG_CONFIG_HOME')
if not path:
path = expanduser("~/.config")
else:
path = expanduser(path)
fn = join(path, 'pianobar', 'nowplaying')
lines = sys.stdin.readlines()
cmd = sys.argv[1]
if cmd == 'songstart':
with open(fn, 'w') as f:
title = None
artist = None
for line in lines:
if "title" in line:
split = line.split("=")
title = split[1]
elif "artist" in line:
split = line.split("=")
artist = split[1]
if title and artist:
nowplaying = "{} - {}".format(artist, title).replace("\n", "")
f.write(nowplaying)
#+END_SRC
** Usage
Put:
#+BEGIN_SRC lisp
(load-module "pianobar")
#+END_SRC
In your =~/.stumpwmrc=
Then you can use "%P" in your modeline format for now playing info.
You can customize the path to the nowplaying file with *pianobar-now-playing-path*

4
modeline/pianobar/package.lisp Normal file
View file

@ -0,0 +1,4 @@
;;;; package.lisp
(defpackage #:pianobar
(:use #:cl :common-lisp :stumpwm :cl-ppcre))

10
modeline/pianobar/pianobar.asd Normal file
View file

@ -0,0 +1,10 @@
;;;; pianobar.asd
(asdf:defsystem #:pianobar
:serial t
:description "Display Pianobar's now playing info in modeline"
:author "Ahmed Khanzada"
:license "GPLv3"
:depends-on (#:stumpwm)
:components ((:file "package")
(:file "pianobar")))

57
modeline/pianobar/pianobar.lisp Normal file
View file

@ -0,0 +1,57 @@
;;;; pianobar.lisp
(in-package #:pianobar)
;;; "pianobar" goes here. Hacks and glory await!
;;; Pianobar now playing info
;;;
;;; Copyright 2023 Ahmed Khanzada
;;;
;;; Maintainer:
;;;
;; Install formatters.
(add-screen-mode-line-formatter #\P 'pianobar-modeline)
;; Variables
(defvar *pianobar-formatters-alist*
'((#\p fmt-pianobar-now-playing)))
(defvar *pianobar-now-playing-path*
"~/.config/pianobar/nowplaying")
(defvar *pianobar-modeline-fmt* "%p"
"The default value for displaying pianobar usage information on the modeline.
@table @asis
@item %%
A literal '%'
@item %p
Now playing
@end table
")
;; Functions
(defun pianobar-read-file-as-string (file-path)
(with-open-file (stream file-path :direction :input)
(let ((contents (make-string (file-length stream))))
(read-sequence contents stream)
contents)))
(defun pianobar-now-playing ()
(let ((file-path *pianobar-now-playing-path*))
(pianobar-read-file-as-string file-path)))
(defun fmt-pianobar-now-playing (now-playing)
;; May eventually do something more advanced than return its arg unscathed
"Returns Pianobar now playing info" now-playing)
(defun pianobar-modeline (ml)
(declare (ignore ml))
(format-expand *pianobar-formatters-alist*
*pianobar-modeline-fmt*
(pianobar-now-playing)))

10
modeline/stumptray/stumptray.lisp
View file

@ -103,13 +103,19 @@ The tray is aligned right."
window coordinates.")
;; Colors
(defparameter *tray-win-background* (nth 7 stumpwm:*colors*)
(defun nth-color (n)
(let ((c (nth n stumpwm:*colors*)))
(typecase c
(cons (cadr c))
(t c))))
(defparameter *tray-win-background* (nth-color 7)
"Tray main container window background color.")
(defparameter *tray-viwin-background* stumpwm:*mode-line-background-color*
"Tray visible icons container window color.")
(defparameter *tray-hiwin-background* stumpwm:*mode-line-border-color*
"Tray hidden icons container window color.")
(defparameter *tray-cursor-color* (nth 2 stumpwm:*colors*)
(defparameter *tray-cursor-color* (nth-color 2)
"Tray icon selection cursor color.")
;;; Sorting and hiding

142
modeline/ticker/README.org Normal file
View file

@ -0,0 +1,142 @@
* Ticker
This module prints off values from stocks. It is developed with
cryptocurrencies in mind, so the default API target is the [[https://kraken.com/][Kraken]]
servers.
[[./screenshot.png]]
** Dependencies
It gets actual price through API, so needs =dexador= and =yason=.
Also, the price getter is asynchronous with the =bordeaux-threads= machinery.
#+begin_src lisp
(ql:quickload '("dexador" "yason" "bordeaux-threads"))
#+end_src
** Usage
Place the following in your =~/.stumpwmrc= file:
#+begin_src lisp
(load-module "ticker")
#+end_src
Use =%T= in your mode line format, for example:
#+begin_src lisp
(setf *screen-mode-line-format*
(list "[%n]" ; Groups
"%v" ; Windows
"^>" ; Push right
" | %T" ; Ticker <<<--- this module
" | %d")) ; Clock
#+end_src
And define some tickers with its parameters. This line defines one
ticker that defaults to the Bitcoin/USD pair:
#+begin_src lisp
(ticker:define-ticker) ; Bitcoin as default
#+end_src
You can define more tickers and parameterize as desired, see the [[Notes]]:
#+begin_src lisp
(ticker:define-ticker
:symbol "XBT" ;;"₿" ; Bitcoin
:threshold 0.01)
(ticker:define-ticker
:pair "XETHZUSD" ; Ethereum
:symbol "ETH")
(ticker:define-ticker
:pair "ADAUSD" ; Cardano
:symbol "ADA" ;;"₳"
:threshold 0.0001
:delay 60
:decimals 3
:gauge-width 9)
#+end_src
** Notes
The parameters that can be customized when defining a ticker and its
default values are:
#+begin_src lisp
:pair "XXBTZUSD" ; pair to get from API
:symbol "BTC" ; label the ticker
:colors t ; use colors
:threshold 0.001 ; 0.1% deviation from average to colorize
:delay 30 ; seconds between updates
:decimals 0 ; number of decimal digits
:localization 2 ; formatting number
:gauge-width 7 ; width of the gauge bar in characters
#+end_src
The minimum parameters to define are the =:pair= to get the value from
the API, and the =:symbol= to label the ticker in the modeline. The
=:pair= is one of the listed at:
+ [[https://api.kraken.com/0/public/Ticker]]
The =:symbol= is a string and can be blank.
Price format is colorized depending on the =:colors= flag. You can
customize setting it to =t= or =nil= when defining the ticker.
Colors depends on a comparison between actual value and the last
values average:
| Color | Code | Description |
|---------------+---------+-----------------------------------|
| Bright yellow | =^B^3*= | Price is higher than average |
| Red | =^1*= | Price is below average |
| White | =^7*= | Price is similar to average |
| Default color | =^**= | When *modeline-use-colors* is nil |
There is a threshold around average, so the increasing or decreasing
color is only applied if =:threshold= is passed.
Last values average is calculated over a 3 hours values list, where
values are stored on every modeline refresh in a FIFO fashion.
Connection to the API price server is limited by a =:delay= interval,
in seconds. So connection attempts between interval time are blocked.
The number of decimal places is set by =:decimals=, when =0= there is
no decimals.
The localization format is set by =:localization= code, when =0= there
is no thousand separator, gives =1234.56= and the =:decimals=
parameter does not work, when =1= the thousand separator is =comma=
and gives =1,234.56=, when =2= the thousand separator is =period= and
gives =1.234,56=, and when =3= the thousand separator is =space= and
gives =1 234,56=.
It is possible to add a gauge bar with the tendency of the actual
value between the low and high in the last 24 hours with
=:gauge-width=. Value must be greater than =1= to be shown.
There is an exported parameter =*tickers-separator*= that defines the
string to put between tickers, as a separator. Can be customized, but
be aware not to use tilde "~" or other combinations because it is
interpreted by the =format= function:
#+begin_src lisp
(setf ticker:*tickers-separator* " | ")
#+end_src
** Issues
Try to use conditions' =handler-case= machinery to avoid the internet
timeouts or the computer sleeping process, to stuck the modeline.
The =truncate= function is used when formatting the values, so some
precission loss is expected.
There is an internal function =ticker::reset-all-tickers= that closes
all threads tasks and resets the =*tickers*= list. Also the
=ticker::purge-all-tickers= function that closes all threads tasks and
purges the =*tickers*= list.

6
modeline/ticker/package.lisp Normal file
View file

@ -0,0 +1,6 @@
;;;; package.lisp
(defpackage :ticker
(:use :cl)
(:export #:define-ticker
#:*tickers-separator*))

BIN
modeline/ticker/screenshot.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 121 KiB

13
modeline/ticker/ticker.asd Normal file
View file

@ -0,0 +1,13 @@
;;;; bitcoin.asd
(asdf:defsystem "ticker"
:description "Display ticker price on StumpWM modeline."
:author "Santiago Payà Miralta @santiagopim"
:license "MIT"
:homepage "https://github.com/stumpwm/stumpwm-contrib/"
:depends-on ("stumpwm" ; Use add-screen-mode-line-formatter
"bordeaux-threads" ; Use a thread per ticker
"dexador" ; Get data from url
"yason") ; Parse json
:components ((:file "package")
(:file "ticker" :depends-on ("package"))))

309
modeline/ticker/ticker.lisp Normal file
View file

@ -0,0 +1,309 @@
;;;; ticker.lisp
;;; Ticker formatter for the Stumpwm mode-line. There is no timestamp,
;;; so let's store up to some historical serie size values got from
;;; url and calculate its average. Comparing actual value with this
;;; average, set a color format. Adds a gauge control that draws
;;; tendency between low and high in 24 hours values.
;;; When creating a new ticker, it launches an asynchronous process
;;; that reads values every delay time from the API and stores them in
;;; the structure. The mode-line uses those structures to print the
;;; values on every refresh.
;;; CODE:
(in-package :ticker)
(defstruct ticker
"Parameters of the ticker and state variables."
pair ; get from API url
symbol ; to show in modeline
colors ; show colors
threshold ; color change interval
delay ; update interval
decimals ; digits in decimal part
localization ; thousands/comma format
gauge-width ; width of gauge in characters
;; Internal state variables
(values ()) ; store the last values
(value 0.0) ; last value got from url
(values-low 0.0) ; low value last 24h
(values-high 0.0) ; high value last 24h
(values-average 0.0) ; average last 3 hours values
(timestamp 0.0) ; got value timestamp
(thread nil)) ; thread where this ticker runs
;;; Global variables
(defparameter *tickers* ()
"List of tickers to show.")
(defparameter *url* "https://api.kraken.com/0/public/Ticker?pair="
"Location of price provider, the ticker pair will be concatenated.")
(defparameter *stop-ticker-threads* nil
"When `t' stop and close all asynchronous loops that get the tickers
values, and the sentinel thread.")
(defparameter *ticker-sentinel* nil
"A control thread to re-launch stuck threads.")
;;; Internal
(defun reset-ticker-values (delay)
"Fullfill the values list with DELAY depending length of nil values."
(make-list (truncate (/ (* 3 60 60) ; 3 hours
delay))
:initial-element NIL))
(defun purge-all-tickers ()
"Stop the threads and reset the list of tickers."
;; Stop the sentinel thread
(when (and *ticker-sentinel*
(bt2:thread-alive-p *ticker-sentinel*))
(bt2:destroy-thread *ticker-sentinel*))
(setf *ticker-sentinel* nil)
;; Stop all ticker threads hard way
(mapcar (lambda (tick)
(when (and (ticker-thread tick)
(bt2:thread-alive-p (ticker-thread tick)))
(bt2:destroy-thread (ticker-thread tick))))
*tickers*)
;; Reset the *tickers* list
(setf *tickers* ()))
(defun reset-all-tickers ()
"Reset the tickers, purging and restoring the list of tickers."
(let ((tickers-backup (reverse *tickers*)))
;; Remove getters and *tickers* list
(purge-all-tickers)
;; Restore the *tickers* list from its copy
(mapcar (lambda (tick)
(define-ticker
:pair (ticker-pair tick)
:symbol (ticker-symbol tick)
:colors (ticker-colors tick)
:threshold (ticker-threshold tick)
:delay (ticker-delay tick)
:decimals (ticker-decimals tick)
:localization (ticker-localization tick)
:gauge-width (ticker-gauge-width tick)))
tickers-backup)))
(defun start-ticker (tick)
"Starts thread getting TICK ticker values."
(setf (ticker-thread tick)
(bt2:make-thread
(lambda ()
(parallel-getter tick))
:name (ticker-pair tick))))
(defun reset-ticker (tick)
"Reset the ticker TICK values."
(setf (ticker-values tick) (reset-ticker-values (ticker-delay tick)))
(setf (ticker-value tick) 0.0)
(setf (ticker-values-low tick) 0.0)
(setf (ticker-values-high tick) 0.0)
(setf (ticker-values-average tick) 0.0)
(setf (ticker-timestamp tick) 0.0))
(defun ticker-sentinel ()
"Check periodically if any thread is stuck, and restart it."
(setf *ticker-sentinel*
(bt2:make-thread
(lambda ()
(do ()
(*stop-ticker-threads*
(setf *ticker-sentinel* nil))
;; Wait some time to check threads
(sleep (* 5 60)) ; 5 minutes
;; Just check if last thread update is so old
(mapcar (lambda (tick)
(when (< (* 2 (ticker-delay tick))
(floor (- (get-internal-real-time)
(ticker-timestamp tick))
internal-time-units-per-second))
(reset-ticker tick)
(when (and (ticker-thread tick)
(bt2:thread-alive-p (ticker-thread tick)))
(bt2:destroy-thread (ticker-thread tick)))
(start-ticker tick)))
*tickers*)))
:name "TICKER-SENTINEL")))
;; (defun test-timestamp ()
;; (mapcar (lambda (tick)
;; (format t "~&~A: ~A ~A"
;; (ticker-pair tick)
;; (floor (ticker-timestamp tick)
;; internal-time-units-per-second)
;; (ticker-values tick)))
;; *tickers*)
;; (format nil "~&~A" (floor (get-internal-real-time)
;; internal-time-units-per-second)))
;;; Exported
(defun define-ticker (&key (pair "XXBTZUSD") (symbol "BTC") (colors t)
(threshold 0.001) (delay 30) (decimals 0)
(localization 2) (gauge-width 7))
"Ticker constructor which defaults to Bitcoin."
(let ((tick (make-ticker
:pair pair
:symbol symbol
:colors colors
:threshold threshold
:delay delay
:decimals decimals
:localization localization
:gauge-width gauge-width
;; Internal state variable
:values (reset-ticker-values delay))))
;; Push the `ticker' into the `*tickers*' list, and launch the
;; asynchronous process that will update the values from the API
;; every `delay' seconds.
(push tick *tickers*)
(start-ticker tick))
;; Launch control process for stuck threads.
(unless *ticker-sentinel* (ticker-sentinel)))
(defparameter *tickers-separator* " | "
"String to separate between tickers in de modeline.")
;;; Get the values
(defun parallel-getter (tick)
"The values are stored in the `*tickers*' structure, from where can be
read by the `ticker-modeline' function."
(do ()
(*stop-ticker-threads*
(reset-ticker tick))
;; Store actual, 24h low, and 24h high values from the `*url*' API.
;; If there is no response, store just `nil' values.
(let ((values
(let* ((url (concatenate 'string *url* (ticker-pair tick)))
(response (handler-case
(gethash (ticker-pair tick)
(gethash "result"
(yason:parse
(dexador:get url
:keep-alive nil))))
;; Return NIL in case some condition is triggered
(condition () nil))))
(if response
(list (read-from-string (first (gethash "c" response)))
(read-from-string (second (gethash "l" response)))
(read-from-string (second (gethash "h" response))))
(list nil nil nil)))))
;; From actual, 24 low, and 24h high, calculate average and
;; store all in the `*tickers*' ticker.
(setf (ticker-value tick) (first values)
(ticker-values-low tick) (second values)
(ticker-values-high tick) (third values)
(ticker-timestamp tick) (get-internal-real-time))
;; Add value to values list, pushing to front
(push (ticker-value tick) (ticker-values tick))
;; Preserve values list size, popping from end
(setf (ticker-values tick) (nreverse (ticker-values tick)))
(pop (ticker-values tick))
(setf (ticker-values tick) (nreverse (ticker-values tick)))
;; Calculate average of values, excluding NIL values
;; that could exist because network issues.
(let ((values-clean (remove-if-not #'numberp (ticker-values tick))))
(setf (ticker-values-average tick) (/ (reduce #'+ values-clean)
(max 1 (length values-clean))))))
;; And again
(sleep (ticker-delay tick))))
;;; Write on modeline
(defun format-decimal (n sep int com dec)
"Return Number formated in groups of INTerval length every, and
separated by SEParator, with COMma character as decimal separator.
DECimals is the number of digits in the decimal part. All parameters
but N are strings. COMma character should not be the tilde `~'.
Works as a simple formatting positive numbers using directive `~D',
for thousand separator and direct value displacement in the decimal
part. Uses `truncate' so there is some precission loss. Does NOT work
with negative numbers.
Based on https://stackoverflow.com/questions/35012859"
(let* ((num-string (concatenate 'string "~,,'" sep "," int ":D"))
(decimals (format nil "~D" dec))
(dec-string (concatenate 'string com "~" decimals ",'0D")))
(multiple-value-bind (i r) (truncate n)
(concatenate
'string
(format nil num-string i)
(when (< 0 dec)
(format nil dec-string (truncate (* (expt 10 dec) r))))))))
(defun gauge (v l h n)
"Draw a gauge control with Value at the point between Low and High in
an N length control."
(if (and (< l h) (<= l v) (<= v h) (> n 1))
(let* ((line (make-sequence 'string n :initial-element #\-))
(segment (floor (* n (/ (- v l) (- h l)))))
(segment (if (= v h) (1- segment) segment)))
(replace line "*" :start1 segment))
"-*-*-"))
(defun get-value-string (tick)
"Generate the ticker string to show in modeline."
(let ((results ()))
(when (< 0 (length (ticker-symbol tick)))
(push (ticker-symbol tick) results))
(push (case (ticker-localization tick)
(0 (format nil "~,2F" (ticker-value tick)))
(1 (format-decimal (ticker-value tick) "," "3" "."
(ticker-decimals tick)))
(2 (format-decimal (ticker-value tick) "." "3" ","
(ticker-decimals tick)))
(3 (format-decimal (ticker-value tick) " " "3" ","
(ticker-decimals tick)))
(otherwise (format nil "~,2F" (ticker-value tick))))
results)
(when (< 1 (ticker-gauge-width tick))
(push (gauge (ticker-value tick)
(ticker-values-low tick)
(ticker-values-high tick)
(ticker-gauge-width tick))
results))
(format nil "~{~A~^ ~}" (nreverse results))))
(defun ticker-modeline (ml)
"This function is evaluated on every modeline refresh and returns the
modeline string. The values are always printed off, but only updated
by the `parallel-getter' function when the `delay' interval has been
reached. If there are not returned values from the API (nil), then the
ticker name is printed."
(declare (ignore ml))
(if *tickers*
(let ((results ()))
(dolist (tick *tickers*)
(if (and (numberp (ticker-value tick)) (plusp (ticker-value tick)))
;; Actual value is a positive number, so print off
(let ((value-string (get-value-string tick)))
;; Return with color if desired
(push (if (ticker-colors tick)
(let* ((diff (- (ticker-value tick) (ticker-values-average tick)))
(pdiff (/ diff (max 1 (ticker-value tick)))))
(cond ((> pdiff (ticker-threshold tick))
(format nil "^[^B^3*~A^]" value-string))
((< pdiff (- (ticker-threshold tick)))
(format nil "^[^1*~A^]" value-string))
(t (format nil "^[^7*~A^]" value-string))))
(format nil "^[^**~A^]" value-string))
results))
;; The value is not a positive number, set the tick name as response
(push (format nil "-~A-" (ticker-pair tick)) results)))
;; Return aggregated ticks results with proper separator
(let ((s (concatenate 'string "~{~A~^" *tickers-separator* "~}")))
(format nil s results)))
;; There are no tickers defined
"-Ticker-"))
;; Bind modeline formatter character to the drawer function
(stumpwm:add-screen-mode-line-formatter #\T 'ticker-modeline)

3
modeline/wifi/package.lisp
View file

@ -5,5 +5,6 @@
(:export #:*iwconfig-path*
#:*wireless-device*
#:*wifi-modeline-fmt*
#:*wifi-signal-quality-fmt*
#:*wifi-signal-quality-fmt-pc*
#:*use-colors*))

10
modeline/wifi/wifi.lisp
View file

@ -33,6 +33,12 @@ Signal quality (without percentage sign)
@end table
")
(defvar *wifi-signal-quality-fmt* "^[~A~D^]"
"The default formatting of the signal quality")
(defvar *wifi-signal-quality-fmt-pc* "^[~A~D%^]"
"The default formatting of the signal quality as percentage")
(defvar *use-colors* t
"Use colors to indicate signal quality.")
@ -47,11 +53,11 @@ Signal quality (without percentage sign)
(defun wifi-get-signal-quality-pc (pair)
(let ((qual (cdr pair)))
(format nil "^[~A~D%^]" (sig-quality-fmt qual) qual)))
(format nil *wifi-signal-quality-fmt-pc* (sig-quality-fmt qual) qual)))
(defun wifi-get-signal-quality (pair)
(let ((qual (cdr pair)))
(format nil "^[~A~D^]" (sig-quality-fmt qual) qual)))
(format nil *wifi-signal-quality-fmt* (sig-quality-fmt qual) qual)))
(defvar *wifi-formatters-alist*
'((#\e wifi-get-essid)

2
util/beckon/package.lisp
View file

@ -1,4 +1,4 @@
(defpackage #:beckon
(:use #:cl)
(:import-from #:stumpwm #:defcommand #:window-frame #:ratwarp #:current-window #:frame-x #:frame-y #:frame-height #:frame-width)
(:export #:beckon #:*window-height-fraction* #:*window-width-fractionn*))
(:export #:beckon #:*window-height-fraction* #:*window-width-fraction*))

2
util/binwarp/README.org
View file

@ -16,7 +16,7 @@ configuring some non-lispy external tool.
To start using Binwarp, just load it into your StumpWM setup by adding either
#+BEGIN_SRC lisp
(load-module "binwarp)
(load-module "binwarp")
#+END_SRC
or
#+BEGIN_SRC lisp

BIN
util/clipboard-history/clipboard-history.fasl
View file

Binary file not shown.

BIN
util/clipboard-history/package.fasl
View file

Binary file not shown.

8
util/end-session/README.org
View file

@ -3,8 +3,8 @@
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.
This module requires the use of =logind= (or elogind), and requires the =polkit=
package to be installed, as well as the =wmctrl= command.
** Usage
Add these lines to your =.stumprc= file:
#+BEGIN_SRC lisp
@ -12,10 +12,12 @@
(add-to-load-path #p"path-to-contrib/util/end-session")
;; actually load the module
(load-module "end-session")
;; Use loginctl instead of the default systemctl
(setf end-session:*end-session-command* "loginctl")
#+END_SRC
*** Commands Provided:
- =end-session= Prompts for shutdown, restart, or logoff. You can
customize what this shows with =*end-session-menu*=. See [[file:session-ending.lisp::77]]
customize what this shows with =*end-session-menu*=. See [[file:end-session.lisp::86]]
- shutdown-computer
- restart-computer
- logout

7
util/end-session/end-session.lisp
View file

@ -28,6 +28,7 @@
;;; DEALINGS IN THE SOFTWARE.
;;;
(defvar *end-session-command* "systemctl")
(defun yes-no-diag (query-string)
"Presents a yes-no dialog to the user asking query-string.
@ -42,7 +43,7 @@ Returns true when yes is selected"
(let ((choice (yes-no-diag "Really suspend?")))
(when choice
(echo-string (current-screen) "Suspending...")
(run-shell-command "systemctl suspend"))))
(run-shell-command (concat *end-session-command* " suspend")))))
(defun close-all-apps ()
"Closes all windows managed by stumpwm gracefully"
@ -57,7 +58,7 @@ Returns true when yes is selected"
(echo-string (current-screen) "Shutting down...")
(close-all-apps)
(run-hook *quit-hook*)
(run-shell-command "systemctl poweroff"))))
(run-shell-command (concat *end-session-command* " poweroff")))))
;; can't name the function "restart"
(defcommand restart-computer () ()
@ -66,7 +67,7 @@ Returns true when yes is selected"
(echo-string (current-screen) "Restarting...")
(close-all-apps)
(run-hook *quit-hook*)
(run-shell-command "systemctl reboot"))))
(run-shell-command (concat *end-session-command* " reboot")))))
(defcommand logout () ()
(let ((choice (yes-no-diag "Close all programs and quit stumpwm?")))

3
util/end-session/package.lisp
View file

@ -1,4 +1,5 @@
;;;; package.lisp
(defpackage #:end-session
(:use #:cl :stumpwm))
(:use #:cl :stumpwm)
(:export #:*end-session-command*))

4
util/pinentry/README.org
View file

@ -1,7 +1,6 @@
* Requirements
- netcat
- port 22222 available.
- stumpish in =PATH=
* Usage
@ -23,4 +22,3 @@ GnuPG Agent will now use StumpWM to ask for your password.
- Better error management (pinentry protocol has a SETERROR command,
cancelling the prompt has undefined behavior)
- Randomized port (or configurable)

26
util/pinentry/pinentry.lisp
View file

@ -1,19 +1,15 @@
(defpackage #:pinentry
(:use #:cl))
(:use #:cl)
(:export #:getpin))
(in-package #:pinentry)
(defun main (stream)
(let ((description (percent:decode (read-line stream)))
(prompt (read-line stream)))
(format stream (or (stumpwm:read-one-line (stumpwm:current-screen)
(format nil "~a~%~a " description prompt)
:password t)
""))))
(handler-case (usocket:socket-server "127.0.0.1" 22222 #'main nil
:in-new-thread t
:multi-threading t)
;; Probably already running:
(usocket:address-in-use-error ())
(usocket:address-not-available-error ()))
(defun getpin (description prompt)
(ignore-errors
(let ((description (percent:decode description))
(prompt (percent:decode prompt)))
(percent:encode
(or (stumpwm:read-one-line (stumpwm:current-screen)
(format nil "~a~%~a " description prompt)
:password t)
"")))))

5
util/pinentry/stumpwm-pinentry
View file

@ -12,7 +12,10 @@ while IFS="\n" read -r command; do
elif [[ "$command" == SETPROMPT* ]]; then
prompt=${command:10}
elif [ "$command" == GETPIN ]; then
password=$(printf "%s\n%s\n" "$description" "$prompt" | nc 127.0.0.1 22222)
password=$(stumpish eval "(pinentry:getpin \"$description\" \"$prompt\")" | cut -d '""' -f 2)
if [ -z "$password" ]; then
echo S close_button
fi
echo D "$password"
elif [ "$command" == BYE ]; then
exit 0

2
util/productivity/README.org
View file

@ -44,7 +44,7 @@ the code.
=*top-map*= and their associated commands.
ex:
#+BEGIN_SRC lisp
(setf *productivity-keys*
(setf productivity::*productivity-keys*
'(("H-t" *root-map*)
("C-;" *rat-map*)
("Print" "screenshot")))

25
util/stump-backlight/backlight.lisp
View file

@ -1,31 +1,50 @@
(in-package #:stump-backlight)
(defvar *scale* 10
"The backlight scale. Increase if you want more granularity.")
(defvar *default-percent* 50
"Default value for an output's percentage.")
(defvar *use-clx-randr* t
"Use CLX's randr extension. If not, call shell command set by `*cli-format-str*'")
(defvar *cli-format-str* "brightnessctl s ~a%"
"Format string that when passed an output percentage, sets the brightness.")
(defvar *current-percent* (make-hash-table)
"CLX does not let us query the existing backlight, so we need to keep track of
it manually.")
;; This just returns a random slot to hold in the hash table... It
;; doesn't return the actual output percentage.
(defun current-output ()
(xlib:rr-get-output-primary (stumpwm:window-xwin (stumpwm:current-window))))
(xlib:rr-get-output-primary (stumpwm:screen-root (stumpwm:current-screen))))
(defun cli-update (output)
(stumpwm:dformat 5 (format nil *cli-format-str* output))
(stumpwm:run-shell-command (format nil *cli-format-str* output)))
(stumpwm:defcommand backlight-increase () ()
(let* ((output (current-output))
(current-percent (or (gethash output *current-percent*) *default-percent*)))
(when (< current-percent 100)
(setf (gethash output *current-percent*) (* (1+ (/ current-percent *scale*)) *scale*))
(update output))))
(if *use-clx-randr*
(update output)
(cli-update (gethash output *current-percent*))))))
(stumpwm:defcommand backlight-decrease () ()
(let* ((output (current-output))
(current-percent (or (gethash output *current-percent*) *default-percent*)))
(when (> current-percent 0)
(setf (gethash output *current-percent*) (* (1- (/ current-percent *scale*)) *scale*))
(update output))))
(if *use-clx-randr*
(update output)
(cli-update (gethash output *current-percent*))))))
(defun update (output)
(let ((backlight-limits

39
util/stumpish/stumpish
View file

@ -20,6 +20,7 @@
### STUMPwm Interactive SHell.
# use a busy-waiting delay of 1 second if floats are not supported by sleep
DELAY=0.01
if ! sleep $DELAY 2>/dev/null >&2
@ -37,11 +38,34 @@ if [ "$(echo -e foo)" = foo ]; then
echo() { builtin echo -e "$@"; }
fi
stumpwm_pid ()
{
local pid=$$
while :
do
if [ $pid -eq 1 ]
then
echo "StumpWM not found in the process tree, are you sure a graphical " 1>&2
echo "session is running and StumpWM is your WM? If you think this is " 1>&2
echo "a bug in stumpish, please report it." 1>&2
echo 1>&2
exit 1
elif [ "$(cat /proc/${pid}/comm)" = "stumpwm" ]
then
STUMPWM_PID=$pid
break
else
pid=$(cut -f 4 -d " " < /proc/$pid/stat)
fi
done
}
wait_result ()
{
while true
do
RESULT=$(xprop -root -f STUMPWM_COMMAND_RESULT 8s \
RESULT=$(xprop -root -f STUMPWM_COMMAND_RESULT 8u \
STUMPWM_COMMAND_RESULT 2>/dev/null |
sed -E 's/\\([[:digit:]]+)/\\0\1/g')
if echo "$RESULT" | grep -v -q 'not found.$'
@ -70,6 +94,9 @@ wait_result ()
send_cmd ()
{
(
flock -n 3 || fail "Cannot obtain a file lock to exclusively talk to StumpWM."
local cmd="$1"
if [ "$cmd" = "stumpwm-quit" ]
@ -80,9 +107,10 @@ send_cmd ()
exit
fi
xprop -root -f STUMPWM_COMMAND 8s -set STUMPWM_COMMAND "$cmd"
xprop -root -f STUMPWM_COMMAND 8u -set STUMPWM_COMMAND "$cmd"
wait_result
) 3>"${TMPDIR:-/tmp}/.stumpish.lock.$STUMPWM_PID"
}
usage ()
@ -138,6 +166,9 @@ fi
if [ $# -gt 0 ]
then
[ "$1" = "--help" ] && usage
stumpwm_pid
if [ "$1" = "-e" ]
then
if [ $# -ne 2 ]
@ -154,6 +185,8 @@ then
send_cmd "$*"
fi
else
stumpwm_pid
if [ -t 0 ]
then
if ! type rlwrap 2>/dev/null >&2
@ -180,7 +213,7 @@ else
tput me sgr0
echo \ for a list of commands.
while read -p '> ' REPLY
while { echo -n '> '; read -r REPLY; }
do
tput md bold
tput AF setaf 2

6
util/surfraw/macros.lisp → util/surfraw/auto-commands.lisp
View file

@ -5,12 +5,14 @@
(dolist (elvi (surfraw-elvis-list))
(let ((key (first elvi))
(description (second elvi)))
(push `(defcommand ,(intern (concat "sr-" key)) (search)
(push `(defcommand ,(format-symbol t "~@:(sr-~a~)" key) (search)
((:string ,(concat description ": ")))
,description
(surfraw ,key search))
commands)
(push `(defcommand ,(intern (concat "sr-sel-" key)) () ()
(push `(defcommand ,(format-symbol t "~@:(sr-sel-~a~)" key) () ()
(surfraw ,key (get-x-selection)))
commands)))
(cons 'progn (reverse commands))))
(auto-define-surfraw-commands-from-elvis-list)

10
util/surfraw/package.lisp
View file

@ -1,5 +1,11 @@
;;;; package.lisp
(defpackage #:surfraw
(:use #:cl :stumpwm))
(:use #:cl #:stumpwm)
(:import-from #:uiop
#:run-program
#:file-exists-p
#:read-file-string)
(:import-from #:alexandria
#:if-let
#:format-symbol))

6
util/surfraw/surfraw.asd
View file

@ -5,7 +5,7 @@
:description "Integrates surfraw with stumpwm."
:author "Ivy Foster"
:license "GPLv3"
:depends-on (#:stumpwm)
:depends-on (#:stumpwm #:alexandria #:uiop)
:components ((:file "package")
(:file "macros" :depends-on ("package"))
(:file "surfraw" :depends-on ("macros"))))
(:file "surfraw")
(:file "auto-commands")))

41
util/surfraw/surfraw.lisp
View file

@ -14,24 +14,27 @@
;;; Code:
(defun split-by-- (str)
(let ((pos (position #\- str :start (1+ (position #\- str)))))
(list (subseq str 0 (1- pos))
(subseq str (1+ pos)))))
(defun surfraw-elvis-list ()
(mapcar (lambda (x)
(mapcar (lambda (x) (string-trim '(#\Space #\Tab #\Newline) x))
(split-by-- x)))
(remove-if-not #'(lambda (string) (search "--" string))
(split-string (run-shell-command "surfraw -elvi" :collect-output-p)
'(#\Newline)))))
(macrolet ((trim (str) `(string-trim '(#\Space #\Tab) ,str)))
(loop :for line :in (run-program '("surfraw" "-elvi") :output :lines)
:for pos = (search "--" line)
:when pos
:collect (list (trim (subseq line 0 pos))
(trim (subseq line (+ pos 2)))))))
(auto-define-surfraw-commands-from-elvis-list)
;;; Regular surfraw commands
(define-stumpwm-type :surfraw-elvi (input prompt)
(let ((elvis (mapcar 'car (surfraw-elvis-list))))
(or (find (or (argument-pop input)
(completing-read (current-screen) prompt elvis :require-match t)
(throw 'error "Abort"))
elvis :test 'string=)
(throw 'error "Such elvi doesn't exist"))))
(defcommand surfraw (engine search)
((:string "What engine? ") (:string "Search for what? "))
((:surfraw-elvi "What engine? ")
(:string "Search for what? "))
"Use SURFRAW to surf the net; reclaim heathen lands."
(check-type engine string)
(check-type search string)
@ -39,19 +42,15 @@
;;; Bookmarks
(defun display-file (file)
"Display a file in the message area."
(if (probe-file file)
(run-shell-command (concat "cat " file) t)
(message "The file ~a does not exist." file)))
(defvar *surfraw-bookmark-file* nil
"The surfraw bookmark file")
(defcommand sr-bookmark (bmk) ((:string "Bookmark: "))
(surfraw "" bmk))
(run-shell-command (concat "exec surfraw -g " bmk)))
(defcommand sr-bookmark-file-display () ()
(display-file *surfraw-bookmark-file*))
(if-let ((path (file-exists-p *surfraw-bookmark-file*)))
(read-file-string path)
(message "The file ~a does not exist." file)))
;;; surfraw.lisp ends here

2
util/swm-gaps/swm-gaps.lisp
View file

@ -64,7 +64,7 @@ HEIGHT are subtracted."
(>= width (- (frame-width frame) ow)))
(setf width (- width ow)))
(when (and (< oh height)
(>= height (- (frame-height frame) oh)))
(>= height (- (stumpwm::frame-display-height (window-group win) frame) oh)))
(setf height (- height oh)))
(setf x (+ x ox)

7
util/swm-ssh/README.org
View file

@ -31,8 +31,9 @@ Default terminal to open an ssh connection is ~urxvtc~. To change it, use
(setq swm-ssh:*swm-ssh-default-term* "xterm")
#+END_SRC
** *swm-ssh-config-path*
Ssh config file path. Defaults to =~/.ssh/config=. Change it with
** *swm-ssh-known-host-path*
Path to thee list of know host bz SSH client. Defaults to =~/.ssh/known_hosts=.
Change it with
#+BEGIN_SRC lisp
(setq swm-ssh:*swm-ssh-config-path* "/path/to/ssh/config")
(setq swm-ssh:*swm-ssh-known-hosts-path* "/path/to/ssh/known_hosts")
#+END_SRC

16
util/swm-ssh/swm-ssh.lisp
View file

@ -3,29 +3,31 @@
(defpackage #:swm-ssh
(:use #:cl #:stumpwm)
(:export #:*swm-ssh-default-term*
#:*swm-ssh-config-path*)
#:*swm-ssh-known-hosts-path*)
(:import-from #:cl-ppcre))
(in-package #:swm-ssh)
(defvar *swm-ssh-config-path* #p"~/.ssh/config")
(defvar *swm-ssh-known-hosts-path* #p"~/.ssh/known_hosts")
(defvar *host-regex* "^Host[ \t]+")
(defvar *host-regex* "^([^ :]+)( |\\t).+")
(defvar *swm-ssh-default-term* "urxvtc")
(defun collect-hosts (&optional (ssh-config *swm-ssh-config-path*))
(with-open-file (stream ssh-config :direction :input)
(defun collect-hosts (&optional (ssh-known-hosts *swm-ssh-known-hosts-path*))
(with-open-file (stream ssh-known-hosts :direction :input)
(loop for line = (read-line stream nil)
while line
when (cl-ppcre:scan *host-regex* line)
collect (cl-ppcre:regex-replace-all *host-regex* line ""))))
collect (cl-ppcre:regex-replace-all *host-regex* line "\\1"))))
(stumpwm:defcommand swm-ssh-menu () ()
"Select a host to ssh to"
(let ((entry (stumpwm:select-from-menu
(stumpwm:current-screen)
(mapcar 'list (collect-hosts))
(mapcar 'list
(delete-duplicates (collect-hosts)
:test #'equal))
"Open ssh connection to: ")))
(when entry
(stumpwm:run-shell-command (format nil "~A -e ssh ~A" *swm-ssh-default-term* (car entry))))))

2
util/urgentwindows/urgentwindows.lisp
View file

@ -20,7 +20,7 @@
(defun raise-urgent-window ()
(let ((last-urgent (pop *urgent-windows-stack*)))
(when last-urgent
(gselect (window-group last-urgent))
(gselect (group-name (window-group last-urgent)))
(really-raise-window last-urgent))))
(defcommand raise-urgent () ()

7
util/windowtags/windowtags.lisp
View file

@ -182,8 +182,11 @@
((window (car (select-by-tags tag))))
(if window
(progn
(move-windows-to-group (list window))
(really-raise-window window)
(if (groups)
(progn
(move-windows-to-group (list window))
(really-raise-window window))
(raise-window window))
window)
nil)))

2
util/winner-mode/dumper.lisp
View file

@ -12,7 +12,7 @@
(declare (ignore args))
(let* ((group-number (current-group-number)))
(check-ids group-number *current-ids* *max-ids*)
(stumpwm:dump-group-to-file
(stumpwm::dump-to-file (stumpwm::dump-group (stumpwm:current-group))
(dump-name group-number (incf (gethash group-number *current-ids*))))
(when (> (gethash group-number *current-ids*)
(gethash group-number *max-ids*))