A collection of useful elisp definitions, sort of a personal lisp
library.
Locally for me those are tangled into various .el-module source files
(a prefix hints where, since in elisp we are free from packages burden, haha!).
Each section/module therefore includes a "footer" with #'provide form and
sometimes a header with lexical binding instruction and includes. Those are
omitted from the literate export for readability.
What was included can be guessed from the context.
§ Miscellaneous
General elisp stuff, potentially useful everywhere.
(defun my-misc/my-current-dir ()
"Get the absolute path of the current directory."
(expand-file-name
(if load-file-name
(file-name-directory load-file-name)
default-directory)))
(cl-defun my-misc/change-default-face-height-globally
(&optional (increment 10))
"Change font scale simultaneously in all buffers."
(interactive "nIncrease default face by: ")
(let ((current (face-attribute 'default :height)))
(set-face-attribute 'default nil :height
(+ current increment))))
Open link at point in eww instead of default browser. Works in
Telega and Org, where it makes sense and where I spend most of the
time.
(defun my-misc/open-link-in-eww ()
"Open link at point in the eww browser. Works in `org-mode' and `telega-chat-mode'."
(interactive)
(let ((url
(pcase major-mode
('telega-chat-mode (telega-url-at-point))
('org-mode (let* ((context (org-element-context))
(type (org-element-property :type context))
(path (org-element-property :path context)))
(when (and type path (member type '("http" "https")))
(concat type ":" path))))
('mu4e-view-mode (get-text-property (point) 'shr-url)))))
(if url
(eww url)
(message "No valid URL at point"))))
§ Math
§ Rands
;; -*- lexical-binding: t -*-
(defun my-math/rand ()
"Normalized random number within (0.0..1.0)"
(/ (float (random most-positive-fixnum))
most-positive-fixnum))
(defun my-math/random-angle ()
"Random angle from 0 to 2*Pi"
(* 2.0 pi (my-math/rand)))
§ Sampling unique integers in a range
As shared by @akater from the friendly Slav Lisp community:
(defun my-math/take-sample (length min max)
"Return a sequence of LENGTH unique random numbers in range [MIN, MAX]."
(declare (type integer min max)
(type (integer 0) length))
(let ((left-totally (1+ (- max min))))
(declare (type integer left-totally))
(if (> length left-totally) (error "Can't take %s integers from [%s,%s]"
length min max)
(let ((left-to-take length)
(result (make-vector length 0))
(done (make-vector length nil)))
(declare (type (vector boolean) done)
(type (vector integer) result)
(type (integer 0) left-to-take))
(flet ((put ()
(symbol-macrolet ((filled (aref done i)))
(loop
for i from 0 below length
with seen-filled = 0
do (if filled (incf seen-filled)
(let ((left-unfilled (- left-to-take (- i seen-filled))))
(when (zerop (random left-unfilled))
(psetf (aref result i) (+ min (1- left-totally))
filled t)
(return))))))))
(loop until (zerop left-to-take)
do (when (or (= left-to-take left-totally)
(> left-to-take (random left-totally)))
(put)
(decf left-to-take))
(decf left-totally))
result)))))
§ Units Conversion
Utility macro that I'll be using for reporting conversions between various decadic metric prefixes for numbers read from selected region.
Reminded myself of how to write macro with that one. Doing so once in
a while... Also, where the heck is my #'with-gensyms ?!
(defmacro my-math/convert-metric-prefix-for (number from to prec)
"Outputs a string containing representation of NUMBER converted
from the decadic metric prefix FROM to the decadic metric prefix TO
(in letter symbolic notation, 10^0 is '_) with float precision PREC.
The step between two adjacent prefixes used is three digits."
(let ((prefixes (gensym)) (distance (gensym)) (converted (gensym)))
`(let* ((,prefixes '(y z a f p n u m _ k M G T P E Z Y))
(,distance (- (seq-position ,prefixes (quote ,to))
(seq-position ,prefixes (quote ,from))))
(,converted (/ (float ,number) (expt 10 (* 3 ,distance)))))
(format (format "%%.%df" ,prec) ,converted (quote ,to)))))
§ Bits
(defun my-math/int-to-binary-string (i)
"Convert an integer into it's binary representation in string format."
(let ((res ""))
(while (not (= i 0))
(setq res (concat (if (= 1 (logand i 1)) "1" "0") res))
(setq i (lsh i -1)))
(if (string= res "")
(setq res "0"))
res))
§ Org
§ Date & Time
Org datestamps parser to calendar formatted date list.
NOTE: the results must be wrapped in 'list in order to become
comparable with #'calendar-date-compare! That's some sort of old and
ugly convention.
(defsubst my-org/to-calendar-date (string)
"Constructs a valid date list for Calendar from Org's datestring STRING."
(let ((dt (org-parse-time-string string)))
(list (nth 4 dt) ; month
(nth 3 dt) ; day
(nth 5 dt)))) ; year
§ Extending Org-Roam
To quick register header at point in org-roam:
(defsubst my-org/roamify-header ()
"Populate (if empty) or change the ID of the current header.
Followed with buffer save + db refresh, in order to register changes."
(interactive)
(unless (eq major-mode 'org-mode)
(error "Should be called from `org-mode', not `%s' you fool!"
major-mode))
(let ((id (read-string "Roam Id: " (org-id-get-create))))
(org-entry-put (point) "ID" id)
(when (buffer-modified-p)
(save-buffer)
(org-roam-db-update-file))))
§ Decide-Mode Tables
This allows me to register data in Org-mode tables for decide.el.
The table either is one-column (equal odds for all choices) or has a separate first column with odds specified.
Then rolls are available with decide-from-table and
decide-choose-from-table.
(defsubst my-org/decide-push-org-table (name data)
"Push DATA from Org table to the `decide-tables' under NAME."
(let ((formatted
(mapcar (lambda (rec)
(if (second rec)
(cons (second rec) (first rec))
(first rec)))
data)))
(push `(,name ,@formatted) decide-tables)))
§ SVG Canvas
Emacs SVG canvas definitions for occasional diagrams outlining, procedural painting etc. For when I want to make inline 2D graphics.
Some chunks are borrowed from svg-lib package that provides nice
inline SVG controls within emacs buffers. Why borrowing? Because I
want those labels to appear on an SVG image canvas.
§ Canvas definitions
Preview function that shows svg-img in a split window.
What's interesting about that buffer is that changes made in
svg-image using emacs svg library are visible at once, in a sense of
interactive editing.
(defun my-svg/preview (svg-img)
"Preview selected SVG image, live updating in emacs."
(let ((cbuff (current-buffer)))
(unless (one-window-p) (delete-other-windows))
(split-window-right)
(other-window 1)
(switch-to-buffer (get-buffer-create "*svg-preview*"))
(erase-buffer)
(svg-insert-image svg-img)
(switch-to-buffer-other-window cbuff)))
Usually there will be just one SVG canvas in my focus, and here it is
defined. The definitions so far are quite trivial since I don't want
to mess with DOM processing the way it is done within 'svg package.
(defvar my-svg/-canvas-width 600)
(defvar my-svg/-canvas-height 400)
(defvar my-svg/-background "transparent")
(defvar my-svg/-stroke-width 1)
(defvar my-svg/-stroke nil)
(defvar my-svg/canvas nil
"The canvas SVG image object for interactive editing.")
(defun my-svg/reset-canvas (&optional width height background stroke-width stroke)
"Reset the SVG canvas object: create a new one (optionally changing global params from KWS).
Then open a preview."
(when width (setf my-svg/-canvas-width width))
(when height (setf my-svg/-canvas-height height))
(when background (setf my-svg/-background background))
(when stroke-width (setf my-svg/-stroke-width stroke-width))
(when stroke (setf my-svg/-stroke stroke))
(setf my-svg/canvas
(svg-create
my-svg/-canvas-width
my-svg/-canvas-height
:background my-svg/-background
:stroke-width my-svg/-stroke-width
:stroke my-svg/-stroke))
(my-svg/preview my-svg/canvas))
§ Nice SVG Label Tags
There goes a definition ported from svg-lib-tag of the svg-lib.
(defun my-svg/tag-embed (svg x y label &optional style &rest args)
"Embed label tag that is similar to what `svg-lib-tag' outputs.
But this time put it on SVG at (X Y) position."
(let* ((default svg-lib-style-default)
(style (if style (apply #'svg-lib-style nil style) default))
(style (if args (apply #'svg-lib-style style args) style))
(foreground (plist-get style :foreground))
(background (plist-get style :background))
(crop-left (plist-get style :crop-left))
(crop-right (plist-get style :crop-right))
(alignment (plist-get style :alignment))
(stroke (plist-get style :stroke))
;; (width (plist-get style :width))
(height (plist-get style :height))
(radius (plist-get style :radius))
;; (scale (plist-get style :scale))
(margin (plist-get style :margin))
(padding (plist-get style :padding))
(font-size (plist-get style :font-size))
(font-family (plist-get style :font-family))
(font-weight (plist-get style :font-weight))
(txt-char-width (window-font-width))
(txt-char-height (window-font-height))
(txt-char-height (if line-spacing
(+ txt-char-height line-spacing)
txt-char-height))
(font-info (font-info (format "%s-%d" font-family font-size)))
(font-size (aref font-info 2)) ;; redefine font-size
(ascent (aref font-info 8))
(tag-char-width (aref font-info 11))
;; (tag-char-height (aref font-info 3))
(tag-width (* (+ (length label) padding) txt-char-width))
(tag-height (* txt-char-height height))
(svg-width (+ tag-width (* margin txt-char-width)))
(svg-height tag-height)
(tag-x (- x (* svg-width 0.5)))
;; (tag-x (* (- svg-width tag-width) alignment))
(text-x (+ tag-x (/ (- tag-width (* (length label) tag-char-width)) 2)))
(tag-y (- y (* svg-height 0.5)))
(text-y (+ tag-y ascent))
;; (text-y ascent)
(tag-x (if crop-left (- tag-x txt-char-width) tag-x))
(tag-width (if crop-left (+ tag-width txt-char-width) tag-width))
(text-x (if crop-left (- text-x (/ stroke 2)) text-x))
(tag-width (if crop-right (+ tag-width txt-char-width) tag-width))
(text-x (if crop-right (+ text-x (/ stroke 2)) text-x)))
(if (>= stroke 0.25)
(svg-rectangle svg tag-x tag-y tag-width tag-height
:fill foreground :rx radius))
(svg-rectangle svg (+ tag-x (/ stroke 2.0)) (+ tag-y (/ stroke 2.0))
(- tag-width stroke) (- tag-height stroke)
:fill background :rx (- radius (/ stroke 2.0)))
(svg-text svg label
:font-family font-family :font-weight font-weight :font-size font-size
:fill foreground :x text-x :y text-y)))
§ Quick test of the SVG Tags
Also an example how to preview generated SVG in Org:
(my-svg/reset-canvas 200 100 nil 1 nil)
(my-svg/tag-embed my-svg/canvas
100
50
"Test Label"
nil
:font-size 10
:font-weight "Condensed"
:background "blue"
:foreground "magenta"
:padding 0
:height 1.0
:stroke 2.2)
(with-temp-buffer (svg-print my-svg/canvas) (buffer-string))
