commit c66e7f3f1f8be03e8e0b5e6d2adc6d5ed613f255
parent c96e27f23406354be080776ce77a2ba8bf0c706d
Author: Yuval Langer <yuval.langer@gmail.com>
Date: Fri, 28 Jun 2024 07:26:39 +0300
Add function that updates the defcustom gco-elfeed-feeds variable with every OPML in gco-opml-list.
Diffstat:
1 file changed, 55 insertions(+), 33 deletions(-)
diff --git a/get-craftering-opml.el b/get-craftering-opml.el
@@ -49,14 +49,11 @@ The tags would be attached to each feed in the OPML file."
(cons string (repeat symbol)))))
(defun gco--blogger-name-to-symbol (blogger-name)
- (intern (downcase (replace-regexp-in-string "[ .]+"
+ (intern (downcase (replace-regexp-in-string "[ .()]+"
"-"
blogger-name))))
-(defun gco--get-response-buffer (opml-url)
- (url-retrieve-synchronously opml-url))
-
-(defun gco--url-response-body-position (response-buffer)
+(defun gco--response-body-position (response-buffer)
(with-current-buffer response-buffer
(named-let loop ((position 1))
(cond
@@ -72,22 +69,28 @@ The tags would be attached to each feed in the OPML file."
(defun gco--parse-response-buffer-to-xml (response-buffer)
(with-current-buffer response-buffer
- (let ((beg (gco--url-response-body-position response-buffer))
+ (let ((start (gco--response-body-position response-buffer))
(end (buffer-end 1)))
- (xml-parse-region beg
- end
- response-buffer))))
+ ;; (xml-parse-region beg
+ ;; end
+ ;; response-buffer)
+ (libxml-parse-xml-region start
+ end))))
(defun gco--xml-to-opml-outlines (xml)
(pcase xml
- (`((opml . ,rest-of-opml))
- (let ((body (assq 'body rest-of-opml)))
+ (`(opml . ,rest-of-opml)
+ (let ((body (assq 'body
+ rest-of-opml)))
(pcase body
;; TODO: What the hell is this?
(`(body ,TODO-WHAT-THE-HELL-IS-THIS? . ,outlines)
outlines))))))
-(cl-defun gco--response-buffer-to-elfeed-feed (response-buffer &key (tags '()))
+(cl-defun gco--response-buffer-to-elfeed-feed (response-buffer
+ &key
+ (tags '())
+ (tag-blogger-name? '()))
(let* ((xml (gco--parse-response-buffer-to-xml response-buffer))
(outlines (gco--xml-to-opml-outlines xml)))
(named-let loop ((outlines outlines)
@@ -105,10 +108,13 @@ The tags would be attached to each feed in the OPML file."
(xml-url (cdr (assq 'xmlUrl
outline-values)))
(blogger-name-tag (gco--blogger-name-to-symbol text))
+ (all-tags (elfeed-normalize-tags
+ (if tag-blogger-name?
+ (list blogger-name-tag)
+ '())
+ tags))
(elfeed-feed-entry (append (list xml-url)
- (elfeed-normalize-tags
- (list blogger-name-tag)
- tags))))
+ all-tags)))
(cond
((string-empty-p xml-url)
(loop rest-of-outlines
@@ -175,24 +181,40 @@ patch if you know."
(gco--hash-table-to-alist hash)))
(defun gco--update-gco-efleed-feeds ()
- (named-let loop ((opml-list (reverse gco-opml-list))
- (our-elfeed-feeds '()))
- (pcase opml-list
- ('()
- our-elfeed-feeds)
- (`(,opml-list-entry . ,rest-of-opml-list)
- (let* ((url+tags (cond
- ((stringp opml-list-entry)
- (list opml-list-entry))
- ((and (consp opml-list-entry)
- (stringp (car opml-list-entry)))
- opml-list-entry)))
- (url (car url+tags))
- (tags (cdr url+tags))
- (response-buffer (gco--get-response-buffer url)))
- (loop rest-of-opml-list
- (append (gco--response-buffer-to-elfeed-feed response-buffer :tags tags)
- our-elfeed-feeds)))))))
+ "TODO: This here supposed to take the opmls and add and dedup the GCO elfeed-feeds"
+ (let ((our-elfeed-feeds gco-elfeed-feeds))
+ (dolist (opml-list-entry
+ gco-opml-list
+ (setq gco-elfeed-feeds (gco--normalise-elfeed-feeds
+ (apply 'append
+ our-elfeed-feeds))))
+ (let* ((url+tags (cond
+ ;; If we have a simple string entry,
+ ((stringp opml-list-entry)
+ ;; convert to a tagged entry with empty tag
+ ;; list.
+ (list opml-list-entry))
+ ;; If we have a tagged entry,
+ ((and (consp opml-list-entry)
+ (stringp (car opml-list-entry)))
+ ;; just evaluate to the entry.
+ (message "%S" opml-list-entry)
+ opml-list-entry)))
+ (url (car url+tags))
+ (tags (cdr url+tags))
+ (response-buffer (url-retrieve-synchronously url)))
+ (setq our-elfeed-feeds
+ (cons (gco--response-buffer-to-elfeed-feed response-buffer
+ :tags tags)
+ our-elfeed-feeds))))))
+
+;;; XXX: Manual testing AHOY!
+;; gco-elfeed-feeds
+;; (gco--update-gco-efleed-feeds)
+;; (setq craftering (url-retrieve-synchronously (caar gco-opml-list)))
+;; (gco--response-buffer-to-elfeed-feed craftering :tags (cdar gco-opml-list))
+;; (setq debian-planet (url-retrieve-synchronously (caadr gco-opml-list)))
+;; (gco--response-buffer-to-elfeed-feed debian-planet :tags (cdadr gco-opml-list))
(provide 'get-craftering-opml)
