opml-to-elfeed-feeds.el (11119B)
1 ;;; opml-to-elfeed-feeds.el --- Deals with OPMLs and their conversion to the Elfeed elfeed-feeds datatype. -*- 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: TODO 8 ;; URL: https://codeberg.org/kakafarm/emacs-opml-to-elfeed-feeds/ 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 ;; Usage: 26 ;; 27 ;; TODO: Remains to be decided! 28 29 ;;; Code: 30 31 (require 'elfeed) 32 33 (defcustom o2e-opml-list 34 '(("https://craftering.systemcrafters.net/Craftering.opml" blog craftering opml-to-elfeed-feeds) 35 ("https://planet.debian.org/opml.xml" blog debian opml-to-elfeed-feeds planet)) 36 "A list holding the OPML URLs. 37 38 Each member is either a string or the URL, or a list with the URL 39 as the first member and optional tags. 40 41 The tags would be attached to each feed in the OPML file." 42 43 :type 44 '(repeat (choice string 45 (cons string (repeat symbol))))) 46 47 (defcustom o2e-elfeed-feeds 48 '() 49 "`o2e-elfeeds' is the `o2e'-specific `elfeed-feeds' of all OPMLs after running the function `o2e--update-o2e-efleed-feeds'." 50 51 :type 52 '(repeat (choice string 53 (cons string (repeat symbol))))) 54 55 (defun o2e--text-element-value-to-tag (text-element-value) 56 "Convert TEXT-ELEMENT-VALUE of an OPML's \"outline\" into a symbol. 57 58 It is used as an elfeed-feeds tag. 59 60 In the Craftering OPML it represents the author of the blog's name." 61 62 (intern (downcase (replace-regexp-in-string "[ .()]+" 63 "-" 64 text-element-value)))) 65 66 (defun o2e--response-body-position (response-buffer) 67 "Return the starting position of the body within the HTTP RESPONSE-BUFFER." 68 69 (with-current-buffer response-buffer 70 (named-let loop ((position 1)) 71 (cond 72 ((>= (1+ position) 73 (buffer-end 1)) 74 nil) 75 ((string= (buffer-substring-no-properties position 76 (+ position 2)) 77 "\n\n") 78 (+ position 2)) 79 (t 80 (loop (1+ position))))))) 81 82 (defun o2e--parse-response-buffer-to-xml (response-buffer) 83 "Return the parsed XML contents of the HTTP RESPONSE-BUFFER." 84 85 (with-current-buffer response-buffer 86 (let ((start (o2e--response-body-position response-buffer)) 87 (end (buffer-end 1))) 88 ;; XXX: Last time I've tried using it, the builtin 89 ;; `xml-parse-regin' function returned some weird crap: 90 ;; 91 ;; (xml-parse-region beg 92 ;; end 93 ;; response-buffer) 94 ;; 95 ;; So I'm using the libxml library instead: 96 (libxml-parse-xml-region start 97 end)))) 98 99 (defun o2e--xml-to-opml-outlines (opml) 100 "Return the outlines of the parsed OPML." 101 102 (pcase (assq 'body opml) 103 ;; TODO: What the hell is this? Does anybody know? 104 (`(body ,TODO-WHAT-THE-HELL-IS-THIS? . ,outlines) 105 outlines))) 106 107 (cl-defun o2e--response-buffer-to-elfeed-feed (response-buffer 108 &key 109 (tags '()) 110 (text-element-value-to-tag '())) 111 "Convert the raw OPML data within RESPONSE-BUFFER to an `elfeed-feeds' and return it. 112 113 The optional named arguments: 114 115 - TAGS - A list of symbols that would be added to every 116 resulting feed. 117 118 - TEXT-ELEMENT-VALUE-TO-TAG - When non-nil, would append the 119 munged \"text\" entry of each \"outline\" within the OPML." 120 121 (let* ((xml (o2e--parse-response-buffer-to-xml response-buffer)) 122 (outlines (o2e--xml-to-opml-outlines xml))) 123 (named-let loop ((outlines outlines) 124 (accumulator '())) 125 (pcase (assq 'outline outlines) 126 ('() 127 accumulator) 128 (`(outline . (,outline-values)) 129 (let* (;; XXX: In Craftering OPML uses to represent the name 130 ;; of the author. 131 (text (cdr (assq 'text outline-values))) 132 (xml-url (cdr (assq 'xmlUrl outline-values))) 133 (all-tags (elfeed-normalize-tags 134 ;; If user provided a "text" munging 135 ;; function, use it to create a tag. 136 (when (and text-element-value-to-tag text) 137 (list (funcall text-element-value-to-tag 138 text))) 139 tags)) 140 (elfeed-feed-entry (append (list xml-url) 141 all-tags))) 142 (cond 143 ((string-empty-p xml-url) 144 (loop (cdr outlines) 145 accumulator)) 146 (t 147 (loop (cdr outlines) 148 (cons elfeed-feed-entry 149 accumulator)))))) 150 ;; XXX: I've only added this clause because when using 151 ;; xml-parse-region it would return big chunks of whitespaces 152 ;; between the outlines when parsing the Debian planet OPML. 153 ;; Let's see if it still works without it? 154 ;; 155 ;; ((pred (lambda (x) (stringp (car x)))) 156 ;; (loop (cdr outlines) 157 ;; accumulator)) 158 )))) 159 160 (defun o2e--elfeed-feeds-entry-url (elfeed-feeds-entry) 161 "Return the URL of ELFEED-FEEDS-ENTRY. 162 163 ELFEED-FEEDS-ENTRY is of the `elfeed-feeds' type." 164 165 (pcase elfeed-feeds-entry 166 (`(,url . ,tags) 167 url) 168 (url 169 url))) 170 171 (defun o2e--elfeed-feeds-entry-tags (elfeed-feeds-entry) 172 "Return the tags of ELFEED-FEEDS-ENTRY. 173 174 ELFEED-FEEDS-ENTRY is of the `elfeed-feeds' type." 175 176 (pcase elfeed-feeds-entry 177 (`(,url . ,tags) 178 tags) 179 (url 180 '()))) 181 182 (cl-defun o2e--hash-table-to-alist (hash-table &key (ordp 'string<)) 183 "Return HASH-TABLE represented as a list. 184 185 The optional named argument ORDP decides how to order the 186 returned list. Its default value is the symbol `string<'. 187 188 TODO: There MUST be a standard function for that, right? Send a 189 patch if you know." 190 191 '(unless ordp 192 (setq ordp 'string<)) 193 194 (mapcar (lambda (key) 195 (cons key 196 (gethash key 197 hash-table))) 198 (sort (hash-table-keys hash-table) 199 ordp))) 200 201 (cl-defun o2e--normalise-elfeed-feeds (elfeed-feeds &key (ordp 'string<)) 202 "Return ELFEED-FEEDS with duplicate entries merged. 203 204 \"Merged\", in this case, means that calling the function with an 205 ELFEED-FEEDS with the value of: 206 207 '((\"https://example.com/blog.xml\" a b c) 208 (\"https://example.com/blog.xml\" b c d)) 209 210 would result with: 211 212 '((\"https://example.com/blog.xml\" a b c d)) 213 214 The order of the original elfeed-feeds is destroyed but it is 215 ordered according to the optional named argument ORDP." 216 217 '(unless ordp 218 (setq ordp 'string<)) 219 220 (let (;; XXX: Pass ":test 'equal" into make-hash-table so that 221 ;; string comparisons work, otherwise it'll put many of the 222 ;; same string as keys, each with its own values, like: 223 ;; 224 ;;'(("moo" a) ("moo" b)). 225 (hash (make-hash-table :test 'equal))) 226 (named-let loop ((entries elfeed-feeds)) 227 (pcase entries 228 ('() 229 '()) 230 (`(,entry . ,rest-of-entries) 231 (let* ((url (o2e--elfeed-feeds-entry-url entry)) 232 (entry-tags (o2e--elfeed-feeds-entry-tags entry)) 233 (hash-tags (gethash url 234 hash 235 '())) 236 (merged-tags (elfeed-normalize-tags (append hash-tags 237 entry-tags)))) 238 (puthash url 239 merged-tags 240 hash) 241 (loop rest-of-entries))))) 242 (o2e--hash-table-to-alist hash))) 243 244 (defun o2e--update-o2e-efleed-feeds () 245 "Retrieve the feed list for each of the OPML lists in `o2e-opml-list' and merge them into `o2e-elfeed-feeds'." 246 247 (let ((new-elfeed-feeds 248 (apply 'append 249 (mapcar (lambda (opml-list-entry) 250 (let* ((url+tags (cond 251 ;; If we have a simple string entry, 252 ((stringp opml-list-entry) 253 ;; convert to a tagged entry with empty tag 254 ;; list. 255 (list opml-list-entry)) 256 ;; If we have a tagged entry, 257 ((and (consp opml-list-entry) 258 (stringp (car opml-list-entry))) 259 ;; just evaluate to the entry. 260 opml-list-entry))) 261 (url (car url+tags)) 262 (tags (cdr url+tags)) 263 (response-buffer (url-retrieve-synchronously url))) 264 (o2e--response-buffer-to-elfeed-feed response-buffer 265 :tags tags))) 266 o2e-opml-list)))) 267 (customize-save-variable 'o2e-elfeed-feeds 268 (o2e--normalise-elfeed-feeds 269 (append new-elfeed-feeds 270 o2e-elfeed-feeds))))) 271 272 (defun o2e--merge-o2e-elfeed-feeds-with-elfeed-elfeed-feeds () 273 "Merge the two variables `elfeed-feeds' and `o2e-elfeed-feeds' and 274 save the result in `elfeed-feeds' as the default value. 275 276 TODO: Do you really call the saved customization \"default value\"?" 277 278 (customize-save-variable 'elfeed-feeds 279 (o2e--normalise-elfeed-feeds (append elfeed-feeds 280 o2e-elfeed-feeds)))) 281 282 ;;; XXX: Manual testing AHOY! 283 ;; (customize-save-variable 'o2e-elfeed-feeds '()) 284 ;; o2e-elfeed-feeds 285 ;; (o2e--update-o2e-efleed-feeds) 286 ;; (setq craftering (url-retrieve-synchronously (caar o2e-opml-list))) 287 ;; (o2e--response-buffer-to-elfeed-feed craftering :tags (cdar o2e-opml-list)) 288 ;; (setq debian-planet (url-retrieve-synchronously (caadr o2e-opml-list))) 289 ;; (o2e--response-buffer-to-elfeed-feed debian-planet :tags (cdadr o2e-opml-list)) 290 291 (provide 'opml-to-elfeed-feeds) 292 293 ;; Local Variables: 294 ;; read-symbol-shorthands: (("o2e-" . "opml-to-elfeed-feeds-")) 295 ;; End: 296 ;;; opml-to-elfeed-feeds.el ends here