kakafarm.el (16861B)
1 ;;; kakafarm.el --- Various functions for my GNU Emacs configuration. -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2024 Yuval Langer 4 5 ;; Author: Yuval Langer <yuval.langer@gmail.com> 6 ;; Version: 0.0.0 7 ;; Keywords: Personal, Auxiliary 8 ;; URL: https://codeberg.org/kakafarm/dotfiles/ 9 10 ;; This program is free software; you can redistribute it and/or modify 11 ;; it under the terms of the GNU General Public License as published by 12 ;; the Free Software Foundation, either version 3 of the License, or 13 ;; (at your option) any later version. 14 15 ;; This program is distributed in the hope that it will be useful, 16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; GNU General Public License for more details. 19 20 ;; You should have received a copy of the GNU General Public License 21 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 22 23 ;;; Commentary: 24 25 ;; Do not expect any of these functions to remain stable. 26 ;; 27 ;; The functions are ordered in an alphabetic order. I do not know 28 ;; if it makes much sense, but so be it. 29 30 ;;; Code: 31 32 (require 'cl-lib) 33 34 ;;;###autoload 35 (defun kakafarm/advice-remove-all (function) 36 "Remove every advice function from FUNCTION." 37 (advice-mapc 38 (lambda (advice-function properties-alist) 39 (advice-remove function 40 advice-function)) 41 function)) 42 43 ;;;###autoload 44 (defun kakafarm/call-process-with-string-as-input (program &optional input-string &rest args) 45 (with-temp-buffer 46 (let ((our-output-buffer (current-buffer))) 47 (if input-string 48 (with-temp-buffer 49 (let ((our-input-buffer (current-buffer))) 50 (progn 51 (erase-buffer) 52 (insert input-string) 53 (apply 'call-process-region 54 (buffer-end -1) 55 (buffer-end 1) 56 program 57 nil 58 our-output-buffer 59 nil 60 args)))) 61 (apply 'call-process 62 program 63 nil 64 our-output-buffer 65 nil 66 args))) 67 (buffer-string))) 68 69 ;; (list (kakafarm/call-process-with-string-as-input "cat" 70 ;; "cat says moo") 71 ;; (kakafarm/call-process-with-string-as-input "echo" 72 ;; nil 73 ;; "-n" 74 ;; "echo echo echo")) 75 76 ;;;###autoload 77 (defun kakafarm/colorize-compilation () 78 "Colorize from `compilation-filter-start' to `point'. 79 80 Used to convert raw ANSI color codes into visually (sometimes dis-)pleasing colors. 81 82 From: 83 84 https://endlessparentheses.com/ansi-colors-in-the-compilation-buffer-output.html" 85 (let ((inhibit-read-only t)) 86 (ansi-color-apply-on-region compilation-filter-start 87 (point)))) 88 89 ;;;###autoload 90 (defun kakafarm/copy-elfeed-links () 91 (interactive) 92 93 (cl-letf* ((elfeed-entry-to-url-nl (lambda (entry) 94 (concat (elfeed-entry-link entry) "\n"))) 95 (all-urls-string (apply 'concat 96 (mapcar elfeed-entry-to-url-nl 97 (elfeed-search-selected))))) 98 (with-temp-buffer 99 (insert all-urls-string) 100 (kill-region (point-min) 101 (point-max))))) 102 103 ;;;###autoload 104 (defun kakafarm/drop-while (lst predp) 105 (named-let loop ((lst lst)) 106 (cond 107 (() 108 lst) 109 ((predp (car lst)) 110 (cdr lst)) 111 (t 112 (loop (cdr lst)))))) 113 114 ;;;###autoload 115 (defun kakafarm/easy-underscore (arg) 116 "Convert all inputs of semicolon to an underscore 117 If given ARG, then it will insert an actual semicolon. 118 119 from https://www.youtube.com/watch?v=6R-73hsL5wk" 120 (interactive "P") 121 (message (format "%s" arg)) 122 (if arg 123 (insert ";") 124 (insert "_"))) 125 126 ;;;###autoload 127 (defun kakafarm/elfeed-sort-feed-tags (a-feed) 128 (cond 129 ((stringp a-feed) 130 a-feed) 131 (t 132 (let* ((feed-url (car a-feed)) 133 (tags (cdr a-feed)) 134 (tags-as-strings (mapcar #'symbol-name 135 tags)) 136 (sorted-tags (sort tags-as-strings 137 #'string-lessp)) 138 (tags-as-symbols (mapcar #'intern sorted-tags))) 139 (cons feed-url tags-as-symbols))))) 140 141 ;;;###autoload 142 (defun kakafarm/elfeed-compare-feeds-urls (feed-a feed-b) 143 (string-lessp (car feed-a) 144 (car feed-b))) 145 146 ;;;###autoload 147 (defun kakafarm/elfeed-sort-feeds (feeds) 148 "Sort A-FEED, an `elfeed-feeds' list." 149 (sort (mapcar #'kakafarm/elfeed-sort-feed-tags 150 feeds) 151 #'kakafarm/elfeed-compare-feeds-urls)) 152 153 ;;;###autoload 154 (defun kakafarm//ffap-browse-urls () 155 "Open all visible URLs." 156 (interactive) 157 158 (let* ((urls (mapcar 'car (ffap-menu-rescan))) 159 (urls-newlined (mapcar (lambda (url) (concat url "\n")) 160 urls)) 161 (prompt (format "Open URLs? [y/n] 162 163 %s" 164 (apply 'concat 165 urls-newlined)))) 166 (when (y-or-n-p prompt) 167 (dolist (url urls) 168 (browse-url url))))) 169 170 ;;;###autoload 171 (defun kakafarm/ffap-browse-urls () 172 "Open wanted visible URLs. Ya gotta type a bit of em and then ta tab complete and separate by commas ta actually select em." 173 (interactive) 174 175 (let ((urls (mapcar 'car (ffap-menu-rescan))) 176 (crm-separator "\n")) 177 (let ((urls-to-open (completing-read-multiple "Which URLs should I open? 178 " 179 urls))) 180 (dolist (url urls-to-open) 181 (browse-url url))))) 182 183 ;;;###autoload 184 (defun kakafarm/greader-estimate-reading-time (&optional start end) 185 (interactive "r") 186 (let ((wpm greader-espeak-rate) 187 (number-of-words (count-words (if start start (point-min)) 188 (if end end (point-max))))) 189 (message "%s" (/ (float number-of-words) wpm)))) 190 191 ;;;###autoload 192 (defun kakafarm/kill-ring-save-unlines () 193 "Like `kill-ring-save', but also unlines and trims the newly killed stuff." 194 (interactive) 195 196 (kill-ring-save (point) (mark)) 197 198 (with-temp-buffer 199 (yank-pop) 200 (goto-char 1) 201 (replace-regexp "\n+" " ") 202 (let ((trimmed (string-trim (buffer-string)))) 203 (with-temp-buffer 204 (insert trimmed) 205 (kill-region (point-min) (point-max)))))) 206 207 ;;;###autoload 208 (defun kakafarm/list-all-http-or-https () 209 (interactive) 210 (dolist (url (let* ((list-of-lines 211 (split-string (substring-no-properties (buffer-string)) 212 "[ \n]"))) 213 (cl-reduce (lambda (accumulator line) 214 (if (string-match-p "https?://.+" 215 line) 216 (cons line accumulator) 217 accumulator)) 218 list-of-lines 219 :initial-value '()))) 220 (message "%s" url))) 221 222 ;;;###autoload 223 (defun kakafarm/org-roam-keyword-is-filetags-p (keyword-node) 224 (equal (org-element-property :key 225 keyword-node) 226 "FILETAGS")) 227 228 ;;;###autoload 229 (defun kakafarm/org-roam-filetags-keyword-is-publishable-p (filestags-keyword-node) 230 (seq-contains-p (split-string (org-element-property :value 231 filestags-keyword-node) 232 ":") 233 "publish")) 234 235 ;;;###autoload 236 (defun kakafarm/org-roam-publishable-node-p (org-filename) 237 (with-temp-buffer 238 (insert-file-contents org-filename) 239 (org-element-map 240 (org-element-parse-buffer) 241 'keyword 242 (lambda (keyword) 243 (and (kakafarm/org-roam-keyword-is-filetags-p keyword) 244 (kakafarm/org-roam-filetags-keyword-is-publishable-p keyword))) 245 nil 246 t))) 247 248 ;;;###autoload 249 (defun kakafarm/org-roam-sitemap (title list-of-org-links) 250 (message (format "kakafarm/org-roam-sitemap title: %S; list-of-links: %S\n" 251 title 252 list-of-org-links)) 253 ;; (let ((a-publishable-org-roam-node 254 ;; (seq-filter (lambda (org-link-list) 255 ;; (pcase org-link-list 256 ;; (`(,org-link) 257 ;; (with-temp-buffer 258 ;; (insert org-link) 259 ;; (org-element-map (org-element-parse-buffer) 'link 260 ;; (lambda (link) 261 ;; ;; Check if file linked is publishable. 262 ;; (kakafarm/org-roam-publishable-node-p 263 ;; (concat "~/mine/roam/" 264 ;; (org-element-property :path 265 ;; link)))) 266 ;; nil 267 ;; t))))) 268 ;; list-of-org-links))) 269 ;; (message "poop %S" a-publishable-org-roam-node)) 270 271 (concat 272 "# -*- encoding: utf-8 -*-\n" 273 "#+OPTIONS: ^:nil author:nil html-postamble:nil\n" 274 ;;"#SETUPFILE: ./simple_inline.theme\n" ; No theme yet. 275 "#+FILETAGS: publish\n" 276 "#+TITLE: " title "\n\n" 277 (org-list-to-org list-of-org-links) "\n" 278 279 ;; TODO: No sitemap SVG yet because it shows all the fucking 280 ;; files in the org-roam database. 281 ;; 282 ;;"file:sitemap.svg\n" 283 )) 284 285 ;;;###autoload 286 (defun kakafarm/org-roam-publication-wrapper (plist filename pubdir) 287 ;; (when (kakafarm/org-roam-publishable-node-p filename) 288 ;; nil) 289 ;;(org-roam-graph) ; How the fuck do I make this one not show every fucking node in the org-roam database?! 290 (org-html-publish-to-html plist 291 filename 292 pubdir) 293 (setq kakafarm/org-roam-project-publish-time 294 (cadr (current-time)))) 295 296 ;;;###autoload 297 (defun kakafarm/org-roam-custom-link-builder (node) 298 (let ((node-file (org-roam-node-file node))) 299 ;; (when (kakafarm/org-roam-publishable-node-p node-file) 300 ;; nil) 301 (message (format "kakafarm/org-roam-custom-link-builder: %S" node)) 302 (concat (file-name-base node-file) 303 ".html"))) 304 305 ;;;###autoload 306 (defun kakafarm/percent-read () 307 "Display percent read by current cursor location vs. total characters in file." 308 309 (interactive) 310 311 (message "%.2f%%" 312 (* 100 313 (/ (float (- (point) 1)) 314 (+ 1 (buffer-size)))))) 315 316 ;;;###autoload 317 (defun kakafarm/percent-read-point-min-max () 318 "Display percent read by current cursor location vs. place within (point-min) and (point-max)." 319 320 (interactive) 321 322 (let* ((our-location (point)) 323 (our-location-0-indexed (- our-location 1))) 324 (message "%.2f%%" 325 (* 100 326 (/ (float (- our-location-0-indexed 327 (point-min))) 328 (- (point-max) 329 (point-min))))))) 330 331 ;;;###autoload 332 (defun kakafarm/recenter-top-bottom (original-function &rest arguments) 333 "Move view such that point is 4 lines from the top of the frame when function is `recenter-top-bottom'." 334 335 (cond 336 ((null (car arguments)) 337 (apply original-function '(4))) 338 (t 339 (apply original-function arguments)))) 340 341 ;;;###autoload 342 (defun kakafarm/pulse-current-region (&rest _) 343 "Pulse the selected bit, either the marked region or if there's no 344 mark, the bit between mark and point... or something like 345 that... I don't even work here. 346 347 From Goparism (https://www.youtube.com/@goparism) 348 https://www.youtube.com/watch?v=oQ9JE9kRwG8 which is from the 349 user 0xMii on R***** which copied it from 350 who-knows-where-and-who." 351 (if mark-active 352 (pulse-momentary-highlight-region (region-beginning) 353 (region-end)) 354 (pulse-momentary-highlight-region (mark) 355 (point)))) 356 357 ;;;###autoload 358 (defun kakafarm/multi-vterm-weechat () 359 "Either start a weechat vterm buffer, or switch to it if it already exists." 360 361 (interactive) 362 363 (let* ((weechat-buffer-name "weechat") 364 (maybe-weechat-buffer (get-buffer weechat-buffer-name))) 365 (cond 366 ((multi-vterm-buffer-exist-p maybe-weechat-buffer) 367 (switch-to-buffer maybe-weechat-buffer)) 368 (t 369 (let ((vterm-shell (expand-file-name "~/bin/w"))) 370 (multi-vterm) 371 (rename-buffer weechat-buffer-name)))))) 372 373 ;;;###autoload 374 (defun kakafarm/sentence-end-double-nilify-for-read-only-buffers () 375 "Set `sentence-end-double-space' in read-only buffer to `nil'." 376 (when buffer-read-only 377 (setq-local sentence-end-double-space 378 nil))) 379 380 ;; Uploading README.html from README.org stuff. 381 ;;;###autoload 382 (defun kakafarm/srht-repo-id (repository-name) 383 "Returns the unique numerical I Dentification associated with 384 every sourcehut repository. 385 386 https://www.tomsdiner.org/blog/post_0003_sourcehut_readme_org_export.html" 387 388 (interactive "sRepo name: ") 389 (let* ((srht (netrc-machine (netrc-parse "~/.netrc.gpg") 390 "repo.git.sr.ht")) 391 (srht-token (netrc-get srht 392 "password")) 393 (our-response (with-temp-buffer 394 (call-process "curl" 395 nil 396 (list (current-buffer) nil) 397 nil 398 "--oauth2-bearer" srht-token 399 "-G" 400 "--data-urlencode" 401 (concat "query=query { me { repository(name: \"" 402 repository-name 403 "\") { id } } }") 404 "https://git.sr.ht/query") 405 (buffer-string))) 406 (repository-id (string-trim (kakafarm/call-process-with-string-as-input "jq" 407 our-response 408 ".data.me.repository.id")))) 409 (if (called-interactively-p) 410 (message "Repository ID: %S" repository-id) 411 repository-id))) 412 413 ;;;###autoload 414 (defun kakafarm/srht-set-readme (repository-id) 415 "Export the current file to HTML and set the result as README for 416 the sourcehut repo identified by ID. 417 418 https://www.tomsdiner.org/blog/post_0003_sourcehut_readme_org_export.html" 419 420 (interactive "sRepository ID: ") 421 (let* ((srht (netrc-machine (netrc-parse "~/.netrc.gpg") 422 "repo.git.sr.ht")) 423 (srht-token (netrc-get srht 424 "password")) 425 (readme.html (org-export-as (org-export-get-backend 'html) 426 nil 427 nil 428 t)) 429 (our-json-query (kakafarm/call-process-with-string-as-input 430 "jq" 431 readme.html 432 "-sR" 433 (concat " 434 { \"query\": \"mutation UpdateRepo($id: Int!, $readme: String!) { updateRepository(id: $id, input: { readme: $readme }) { id } }\", 435 \"variables\": { 436 \"id\": " repository-id ", 437 \"readme\": . 438 } 439 }")))) 440 (kakafarm/call-process-with-string-as-input "curl" 441 our-json-query 442 "--oauth2-bearer" srht-token 443 "-H" "Content-Type: application/json" 444 "-d@-" 445 "https://git.sr.ht/query"))) 446 447 ;;;###autoload 448 (defun kakafarm/take-while (lst predp) 449 (named-let loop ((lst lst) 450 (accumulator '())) 451 (cond 452 ((null lst) 453 (reverse accumulator)) 454 ((predp (car lst)) 455 (reverse accumulator)) 456 (t 457 (loop (cdr lst) 458 accumulator))))) 459 460 ;;;###autoload 461 (defun kakafarm/url-response-to-body (response) 462 (cdr (kakafarm/drop-while 463 (string-split response 464 "\n") 465 (lambda (line) 466 (not (string-blank-p line)))))) 467 468 ;;;###autoload 469 (defun kakafarm/yank-unlines () 470 "`yank' with each consecutive newlines converted to a single space, and trim both ends." 471 (interactive) 472 473 (insert 474 (string-trim 475 (with-temp-buffer 476 (yank) 477 (goto-char 1) 478 (replace-regexp "\n+" " ") 479 (buffer-string))))) 480 481 (provide 'kakafarm) 482 483 ;;; Local Variables: 484 ;;; read-symbol-shorthands: (("kf/" . "kakafarm/")) 485 ;;; End: 486 ;;; kakafarm.el ends here.