kakafarm-utils.el (12996B)
1 ;;; -*- lexical-binding:t -*- 2 3 (require 'cl-lib) 4 5 (defun kakafarm/advice-remove-all (function) 6 "Remove every advice function from FUNCTION." 7 (advice-mapc 8 (lambda (advice-function properties-alist) 9 (advice-remove function 10 advice-function)) 11 function)) 12 13 (defun kakafarm/call-process-with-string-as-input (program &optional input-string &rest args) 14 (with-temp-buffer 15 (let ((our-output-buffer (current-buffer))) 16 (if input-string 17 (with-temp-buffer 18 (let ((our-input-buffer (current-buffer))) 19 (progn 20 (erase-buffer) 21 (insert input-string) 22 (apply 'call-process-region 23 (buffer-end -1) 24 (buffer-end 1) 25 program 26 nil 27 our-output-buffer 28 nil 29 args)))) 30 (apply 'call-process 31 program 32 nil 33 our-output-buffer 34 nil 35 args))) 36 (buffer-string))) 37 38 (list (kakafarm/call-process-with-string-as-input "cat" 39 "cat says moo") 40 (kakafarm/call-process-with-string-as-input "echo" 41 nil 42 "-n" 43 "echo echo echo")) 44 45 (defun kakafarm/drop-while (lst predp) 46 (named-let loop ((lst lst)) 47 (cond 48 (() 49 lst) 50 ((predp (car lst)) 51 (cdr lst)) 52 (t 53 (loop (cdr lst)))))) 54 55 (defun kakafarm/easy-underscore (arg) 56 "Convert all inputs of semicolon to an underscore 57 If given ARG, then it will insert an actual semicolon. 58 59 from https://www.youtube.com/watch?v=6R-73hsL5wk" 60 (interactive "P") 61 (message (format "%s" arg)) 62 (if arg 63 (insert ";") 64 (insert "_"))) 65 66 (defun kakafarm/elfeed-sort-feed-tags (a-feed) 67 (cond 68 ((stringp a-feed) 69 a-feed) 70 (t 71 (let* ((feed-url (car a-feed)) 72 (tags (cdr a-feed)) 73 (tags-as-strings (mapcar #'symbol-name 74 tags)) 75 (sorted-tags (sort tags-as-strings 76 #'string-lessp)) 77 (tags-as-symbols (mapcar #'intern sorted-tags))) 78 (cons feed-url tags-as-symbols))))) 79 80 (defun kakafarm/elfeed-compare-feeds-urls (feed-a feed-b) 81 (string-lessp (car feed-a) 82 (car feed-b))) 83 84 (defun kakafarm/elfeed-sort-feeds (feeds) 85 "Sort A-FEED, an `elfeed-feeds' list." 86 (sort (mapcar #'kakafarm/elfeed-sort-feed-tags 87 feeds) 88 #'kakafarm/elfeed-compare-feeds-urls)) 89 90 (defun kakafarm/ffap-browse-urls () 91 "Open all visible URLs." 92 (interactive) 93 94 (let* ((urls (mapcar 'car (ffap-menu-rescan))) 95 (urls-newlined (mapcar (lambda (url) (concat url "\n")) 96 urls)) 97 (prompt (format "Open URLs? [y/n] 98 99 %s" 100 (apply 'concat 101 urls-newlined)))) 102 (when (y-or-n-p prompt) 103 (dolist (url urls) 104 (browse-url url))))) 105 106 (defun kakafarm/kill-ring-save-unlines () 107 "Like `kill-ring-save', but also unlines and trims the newly killed stuff." 108 (interactive) 109 110 (kill-ring-save (point) (mark)) 111 112 (with-temp-buffer 113 (yank-pop) 114 (goto-char 1) 115 (replace-regexp "\n+" " ") 116 (let ((trimmed (string-trim (buffer-string)))) 117 (with-temp-buffer 118 (insert trimmed) 119 (kill-region (point-min) (point-max)))))) 120 121 (defun kakafarm/list-all-http-or-https () 122 (interactive) 123 (dolist (url (let* ((list-of-lines 124 (split-string (substring-no-properties (buffer-string)) 125 "[ \n]"))) 126 (cl-reduce (lambda (accumulator line) 127 (if (string-match-p "https?://.+" 128 line) 129 (cons line accumulator) 130 accumulator)) 131 list-of-lines 132 :initial-value '()))) 133 (message "%s" url))) 134 135 (defun kakafarm/org-roam-keyword-is-filetags-p (keyword-node) 136 (equal (org-element-property :key 137 keyword-node) 138 "FILETAGS")) 139 140 (defun kakafarm/org-roam-filetags-keyword-is-publishable-p (filestags-keyword-node) 141 (seq-contains-p (split-string (org-element-property :value 142 filestags-keyword-node) 143 ":") 144 "publish")) 145 146 (defun kakafarm/org-roam-publishable-node-p (org-filename) 147 (with-temp-buffer 148 (insert-file-contents org-filename) 149 (org-element-map (org-element-parse-buffer) 'keyword 150 (lambda (keyword) 151 (and (kakafarm/org-roam-keyword-is-filetags-p keyword) 152 (kakafarm/org-roam-filetags-keyword-is-publishable-p keyword))) 153 nil 154 t))) 155 156 (defun kakafarm/org-roam-sitemap (title list-of-org-links) 157 (message (format "kakafarm/org-roam-sitemap title: %S; list-of-links: %S\n" 158 title 159 list-of-org-links)) 160 ;; (let ((a-publishable-org-roam-node 161 ;; (seq-filter (lambda (org-link-list) 162 ;; (pcase org-link-list 163 ;; (`(,org-link) 164 ;; (with-temp-buffer 165 ;; (insert org-link) 166 ;; (org-element-map (org-element-parse-buffer) 'link 167 ;; (lambda (link) 168 ;; ;; Check if file linked is publishable. 169 ;; (kakafarm/org-roam-publishable-node-p 170 ;; (concat "~/mine/roam/" 171 ;; (org-element-property :path 172 ;; link)))) 173 ;; nil 174 ;; t))))) 175 ;; list-of-org-links))) 176 ;; (message "poop %S" a-publishable-org-roam-node)) 177 178 (concat 179 "# -*- encoding: utf-8 -*-\n" 180 "#+OPTIONS: ^:nil author:nil html-postamble:nil\n" 181 ;;"#SETUPFILE: ./simple_inline.theme\n" ; No theme yet. 182 "#+FILETAGS: publish\n" 183 "#+TITLE: " title "\n\n" 184 (org-list-to-org list-of-org-links) "\n" 185 186 ;; TODO: No sitemap SVG yet because it shows all the fucking 187 ;; files in the org-roam database. 188 ;; 189 ;;"file:sitemap.svg\n" 190 )) 191 192 (defun kakafarm/org-roam-publication-wrapper (plist filename pubdir) 193 ;; (when (kakafarm/org-roam-publishable-node-p filename) 194 ;; nil) 195 ;;(org-roam-graph) ; How the fuck do I make this one not show every fucking node in the org-roam database?! 196 (org-html-publish-to-html plist 197 filename 198 pubdir) 199 (setq kakafarm/org-roam-project-publish-time 200 (cadr (current-time)))) 201 202 (defun kakafarm/org-roam-custom-link-builder (node) 203 (let ((node-file (org-roam-node-file node))) 204 ;; (when (kakafarm/org-roam-publishable-node-p node-file) 205 ;; nil) 206 (message (format "kakafarm/org-roam-custom-link-builder: %S" node)) 207 (concat (file-name-base node-file) 208 ".html"))) 209 210 (defun kakafarm/percent-read () 211 "Display percent read by current cursor location vs. total characters in file." 212 (interactive) 213 (message "%.2f%%" 214 (* 100 215 (/ (float (- (point) 1)) 216 (+ 1 (buffer-size)))))) 217 218 (defun kakafarm/recenter-top-bottom (original-function &rest arguments) 219 "Move view such that point is 4 lines from the top of the frame when function is `recenter-top-bottom'." 220 221 (cond 222 ((null (car arguments)) 223 (apply original-function '(4))) 224 (t 225 (apply original-function arguments)))) 226 227 (defun kakafarm/pulse-current-region (&rest _) 228 "Pulse the selected bit, either the marked region or if there's no 229 mark, the bit between mark and point... or something like 230 that... I don't even work here. 231 232 From Goparism (https://www.youtube.com/@goparism) 233 https://www.youtube.com/watch?v=oQ9JE9kRwG8 which is from the 234 user 0xMii on R***** which copied it from 235 who-knows-where-and-who." 236 (if mark-active 237 (pulse-momentary-highlight-region (region-beginning) 238 (region-end)) 239 (pulse-momentary-highlight-region (mark) 240 (point)))) 241 242 (defun kakafarm/multi-vterm-weechat () 243 "Either start a weechat vterm buffer, or switch to it if it already exists." 244 245 (interactive) 246 247 (let* ((vterm-shell (expand-file-name "~/bin/w")) 248 (weechat-buffer-name "weechat") 249 (maybe-weechat-buffer (get-buffer "weechat"))) 250 (cond 251 ((multi-vterm-buffer-exist-p maybe-weechat-buffer) 252 (switch-to-buffer maybe-weechat-buffer)) 253 (t 254 (multi-vterm) 255 (rename-buffer weechat-buffer-name))))) 256 257 (defun kakafarm/sentence-end-double-nilify-for-read-only-buffers () 258 "Set `sentence-end-double-space' in read-only buffer to `nil'." 259 (when buffer-read-only 260 (setq-local sentence-end-double-space 261 nil))) 262 263 ;; Uploading README.html from README.org stuff. 264 (defun kakafarm/srht-repo-id (repository-name) 265 "Returns the unique numerical I Dentification associated with 266 every sourcehut repository. 267 268 https://www.tomsdiner.org/blog/post_0003_sourcehut_readme_org_export.html" 269 270 (interactive "sRepo name: ") 271 (let* ((srht (netrc-machine (netrc-parse "~/.netrc.gpg") 272 "repo.git.sr.ht")) 273 (srht-token (netrc-get srht 274 "password")) 275 (our-response (with-temp-buffer 276 (call-process "curl" 277 nil 278 (list (current-buffer) nil) 279 nil 280 "--oauth2-bearer" srht-token 281 "-G" 282 "--data-urlencode" 283 (concat "query=query { me { repository(name: \"" 284 repository-name 285 "\") { id } } }") 286 "https://git.sr.ht/query") 287 (buffer-string))) 288 (repository-id (string-trim (kakafarm/call-process-with-string-as-input "jq" 289 our-response 290 ".data.me.repository.id")))) 291 (if (called-interactively-p) 292 (message "Repository ID: %S" repository-id) 293 repository-id))) 294 295 (defun kakafarm/srht-set-readme (repository-id) 296 "Export the current file to HTML and set the result as README for 297 the sourcehut repo identified by ID. 298 299 https://www.tomsdiner.org/blog/post_0003_sourcehut_readme_org_export.html" 300 301 (interactive "sRepository ID: ") 302 (let* ((srht (netrc-machine (netrc-parse "~/.netrc.gpg") 303 "repo.git.sr.ht")) 304 (srht-token (netrc-get srht 305 "password")) 306 (readme.html (org-export-as (org-export-get-backend 'html) 307 nil 308 nil 309 t)) 310 (our-json-query (kakafarm/call-process-with-string-as-input 311 "jq" 312 readme.html 313 "-sR" 314 (concat " 315 { \"query\": \"mutation UpdateRepo($id: Int!, $readme: String!) { updateRepository(id: $id, input: { readme: $readme }) { id } }\", 316 \"variables\": { 317 \"id\": " repository-id ", 318 \"readme\": . 319 } 320 }")))) 321 (kakafarm/call-process-with-string-as-input "curl" 322 our-json-query 323 "--oauth2-bearer" srht-token 324 "-H" "Content-Type: application/json" 325 "-d@-" 326 "https://git.sr.ht/query"))) 327 328 (defun kakafarm/take-while (lst predp) 329 (named-let loop ((lst lst) 330 (accumulator '())) 331 (cond 332 ((null lst) 333 (reverse accumulator)) 334 ((predp (car lst)) 335 (reverse accumulator)) 336 (t 337 (loop (cdr lst) 338 accumulator))))) 339 340 (defun kakafarm/url-response-to-body (response) 341 (cdr (kakafarm/drop-while 342 (string-split response 343 "\n") 344 (lambda (line) 345 (not (string-blank-p line)))))) 346 347 (defun kakafarm/yank-unlines () 348 "`yank' with each consecutive newlines converted to a single space, and trim both ends." 349 (interactive) 350 351 (insert 352 (string-trim 353 (with-temp-buffer 354 (yank) 355 (goto-char 1) 356 (replace-regexp "\n+" " ") 357 (buffer-string)))))