From: Ulf Jasper Date: Wed, 3 Mar 2021 20:10:34 +0000 (+0100) Subject: Preserve group structure on opml import and export. X-Git-Tag: emacs-28.0.90~3454 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b379420a5b005d0e12d12fc162aa34851d456c61;p=emacs.git Preserve group structure on opml import and export. * lisp/net/newst-backend.el (newsticker--raw-url-list-defaults), (newsticker-url-list-defaults), (newsticker--get-news-by-url), (newsticker--sentinel-work), (newsticker--parse-atom-0.3), (newsticker--decode-rfc822-date), (newsticker--image-download-by-wget), (newsticker--image-save), (newsticker--image-download-by-url), (newsticker--cache-save), (newsticker--stat-num-items): Fix indentation. (newsticker-opml-export): Preserve group structure on export. (newsticker--opml-insert-elt), (newsticker--opml-insert-group), (newsticker--opml-insert-feed): New. (newsticker--opml-import-outlines): (newsticker-opml-import): Preserve group structure on import. (Fixes fourth issue in Bug#41376.) --- diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index f5b47610787..9096d681a82 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -66,35 +66,34 @@ considered to be running if the newsticker timer list is not empty." ;; Hard-coding URLs like this is a recipe for propagating obsolete info. (defconst newsticker--raw-url-list-defaults - '( - ("Debian Security Advisories" - "http://www.debian.org/security/dsa.en.rdf") + '(("Debian Security Advisories" + "http://www.debian.org/security/dsa.en.rdf") ("Debian Security Advisories - Long format" - "http://www.debian.org/security/dsa-long.en.rdf") + "http://www.debian.org/security/dsa-long.en.rdf") ("Emacs Wiki" - "https://www.emacswiki.org/emacs?action=rss" - nil - 3600) + "https://www.emacswiki.org/emacs?action=rss" + nil + 3600) ("LWN (Linux Weekly News)" - "https://lwn.net/headlines/rss") + "https://lwn.net/headlines/rss") ("Quote of the day" - "http://feeds.feedburner.com/quotationspage/qotd" - "07:00" - 86400) + "http://feeds.feedburner.com/quotationspage/qotd" + "07:00" + 86400) ("The Register" - "https://www.theregister.co.uk/headlines.rss") + "https://www.theregister.co.uk/headlines.rss") ("slashdot" - "http://rss.slashdot.org/Slashdot/slashdot" - nil - 3600) ;/. will ban you if under 3600 seconds! + "http://rss.slashdot.org/Slashdot/slashdot" + nil + 3600) ;/. will ban you if under 3600 seconds! ("Wired News" - "https://www.wired.com/feed/rss") + "https://www.wired.com/feed/rss") ("Heise News (german)" - "http://www.heise.de/newsticker/heise.rdf") + "http://www.heise.de/newsticker/heise.rdf") ("Tagesschau (german)" - "http://www.tagesschau.de/newsticker.rdf" - nil - 1800)) + "http://www.tagesschau.de/newsticker.rdf" + nil + 1800)) "Default URL list in raw form. This list is fed into defcustom via `newsticker--splicer'.") @@ -153,10 +152,10 @@ value effective." :group 'newsticker) (defcustom newsticker-url-list-defaults - '(("Emacs Wiki" - "https://www.emacswiki.org/emacs?action=rss" - nil - 3600)) + '(("Emacs Wiki" + "https://www.emacswiki.org/emacs?action=rss" + nil + 3600)) "A customizable list of news feeds to select from. These were mostly extracted from the Radio Community Server . @@ -680,8 +679,8 @@ See `newsticker-get-news'." (condition-case error-data (url-retrieve url 'newsticker--get-news-by-url-callback (list feed-name)) - (error (message "Error retrieving news from %s: %s" feed-name - error-data)))) + (error (message "Error retrieving news from %s: %s" feed-name + error-data)))) (force-mode-line-update)) (defun newsticker--get-news-by-url-callback (status feed-name) @@ -825,7 +824,7 @@ Argument BUFFER is the buffer of the retrieval process." (setq coding-system (intern (downcase (match-string 1)))) (setq coding-system (condition-case nil - (check-coding-system coding-system) + (check-coding-system coding-system) (coding-system-error (message "newsticker.el: ignoring coding system %s for %s" @@ -936,8 +935,8 @@ Argument BUFFER is the buffer of the retrieval process." ;; setup scrollable text (when (= 0 (length newsticker--process-ids)) (when (fboundp 'newsticker--ticker-text-setup) ;silence - ;compiler - ;warnings + ;compiler + ;warnings (newsticker--ticker-text-setup))) (setq newsticker--latest-update-time (current-time)) (when something-was-added @@ -945,8 +944,8 @@ Argument BUFFER is the buffer of the retrieval process." (newsticker--cache-save-feed (newsticker--cache-get-feed name-symbol)) (when (fboundp 'newsticker--buffer-set-uptodate) ;silence - ;compiler - ;warnings + ;compiler + ;warnings (newsticker--buffer-set-uptodate nil))) ;; kill the process buffer if wanted (unless newsticker-debug @@ -1107,8 +1106,8 @@ same as in `newsticker--parse-atom-1.0'." ;; time-fn (lambda (node) (newsticker--decode-rfc822-date - (car (xml-node-children - (car (xml-get-children node 'modified)))))) + (car (xml-node-children + (car (xml-get-children node 'modified)))))) ;; guid-fn (lambda (node) (newsticker--guid-to-string @@ -1679,7 +1678,7 @@ Sat, 07 Sep 2002 00:00:01 GMT (message "Cannot decode \"%s\": %s %s" rfc822-string (car error-data) (cdr error-data)) nil)))) - nil)) + nil)) (defun newsticker--lists-intersect-p (list1 list2) "Return t if LIST1 and LIST2 share elements." @@ -1738,27 +1737,27 @@ Save image as FILENAME in DIRECTORY, download it from URL." (let* ((proc-name (concat feed-name "-" filename)) (buffername (concat " *newsticker-wget-image-" proc-name "*")) (item (or (assoc feed-name newsticker-url-list) - (assoc feed-name newsticker-url-list-defaults) - (error - "Cannot get image for %s: Check newsticker-url-list" - feed-name))) + (assoc feed-name newsticker-url-list-defaults) + (error + "Cannot get image for %s: Check newsticker-url-list" + feed-name))) (wget-arguments (or (car (cdr (cdr (cdr (cdr item))))) newsticker-wget-arguments))) - (with-current-buffer (get-buffer-create buffername) - (erase-buffer) - ;; throw an error if there is an old wget-process around - (if (get-process feed-name) - (error "Another wget-process is running for image %s" - feed-name)) - ;; start wget - (let* ((args (append wget-arguments (list url))) - (proc (apply 'start-process proc-name buffername - newsticker-wget-name args))) - (set-process-coding-system proc 'no-conversion 'no-conversion) - (set-process-sentinel proc 'newsticker--image-sentinel) - (process-put proc 'nt-directory directory) - (process-put proc 'nt-feed-name feed-name) - (process-put proc 'nt-filename filename))))) + (with-current-buffer (get-buffer-create buffername) + (erase-buffer) + ;; throw an error if there is an old wget-process around + (if (get-process feed-name) + (error "Another wget-process is running for image %s" + feed-name)) + ;; start wget + (let* ((args (append wget-arguments (list url))) + (proc (apply 'start-process proc-name buffername + newsticker-wget-name args))) + (set-process-coding-system proc 'no-conversion 'no-conversion) + (set-process-sentinel proc 'newsticker--image-sentinel) + (process-put proc 'nt-directory directory) + (process-put proc 'nt-feed-name feed-name) + (process-put proc 'nt-filename filename))))) (defun newsticker--image-sentinel (process _event) "Sentinel for image-retrieving PROCESS caused by EVENT." @@ -1783,18 +1782,18 @@ Save image as FILENAME in DIRECTORY, download it from URL." "Save contents of BUFFER in DIRECTORY as FILE-NAME. Finally kill buffer." (with-current-buffer buffer - (let ((image-name (concat directory file-name))) - (set-buffer-file-coding-system 'no-conversion) - ;; make sure the cache dir exists - (unless (file-directory-p directory) - (make-directory directory)) - ;; write and close buffer - (let ((require-final-newline nil) - (backup-inhibited t) - (coding-system-for-write 'no-conversion)) - (write-region nil nil image-name nil 'quiet)) - (set-buffer-modified-p nil) - (kill-buffer buffer)))) + (let ((image-name (concat directory file-name))) + (set-buffer-file-coding-system 'no-conversion) + ;; make sure the cache dir exists + (unless (file-directory-p directory) + (make-directory directory)) + ;; write and close buffer + (let ((require-final-newline nil) + (backup-inhibited t) + (coding-system-for-write 'no-conversion)) + (write-region nil nil image-name nil 'quiet)) + (set-buffer-modified-p nil) + (kill-buffer buffer)))) (defun newsticker--image-remove (directory file-name) "In DIRECTORY remove FILE-NAME." @@ -1809,8 +1808,8 @@ Save image as FILENAME in DIRECTORY, download it from URL." (condition-case error-data (url-retrieve url 'newsticker--image-download-by-url-callback (list feed-name directory filename)) - (error (message "Error retrieving image from %s: %s" feed-name - error-data)))) + (error (message "Error retrieving image from %s: %s" feed-name + error-data)))) (force-mode-line-update)) (defun newsticker--image-download-by-url-callback (status feed-name directory filename) @@ -2147,11 +2146,11 @@ FEED is a symbol!" (concat newsticker-dir "/feeds")) (defun newsticker--cache-save () - "Save cache data for all feeds." - (unless (file-directory-p newsticker-dir) - (make-directory newsticker-dir t)) - (mapc 'newsticker--cache-save-feed newsticker--cache) - nil) + "Save cache data for all feeds." + (unless (file-directory-p newsticker-dir) + (make-directory newsticker-dir t)) + (mapc 'newsticker--cache-save-feed newsticker--cache) + nil) (defun newsticker--cache-save-feed (feed) "Save cache data for FEED." @@ -2217,7 +2216,7 @@ If AGES is nil, the total number of items is returned." (if (memq (newsticker--age (car items)) ages) (setq num (1+ num))) (if (memq (newsticker--age (car items)) '(new old immortal obsolete)) - (setq num (1+ num)))) + (setq num (1+ num)))) (setq items (cdr items))) num)) @@ -2240,36 +2239,64 @@ Export subscriptions to a buffer in OPML Format." ;; FIXME: use newsticker-groups (interactive) (with-current-buffer (get-buffer-create "*OPML Export*") + (erase-buffer) (set-buffer-file-coding-system 'utf-8) (insert (concat "\n" "\n" "\n" " \n" - " mySubscriptions\n" + " Emacs newsticker subscriptions\n" " " (format-time-string "%a, %d %b %Y %T %z") "\n" " " user-mail-address "\n" " " (user-full-name) "\n" " \n" " \n")) - (dolist (sub (append newsticker-url-list newsticker-url-list-defaults)) - (insert " \n")) - (insert " \n\n")) + (let ((feeds (append newsticker-url-list newsticker-url-list-defaults)) + ;; insert the feed groups and all feeds that are contained + (saved-feed-names (newsticker--opml-insert-elt newsticker-groups 2))) + ;; to be safe: insert all feeds that are not contained in any group + (dolist (f feeds) + (unless (seq-find (lambda (sfn) (string= (car f) sfn)) saved-feed-names) + (newsticker--opml-insert-feed (car f) 4))) + (insert " \n\n"))) (pop-to-buffer "*OPML Export*") (when (fboundp 'sgml-mode) (sgml-mode))) +(defun newsticker--opml-insert-elt (elt depth) + "Insert an OPML ELT with indentation level DEPTH." + (if (listp elt) + (newsticker--opml-insert-group elt (+ 2 depth)) + (newsticker--opml-insert-feed elt (+ 2 depth)))) + +(defun newsticker--opml-insert-group (group depth) + "Insert an OPML GROUP with indentation level DEPTH." + (let (saved-feeds) + (insert (make-string depth ? ) "\n") + (setq saved-feeds (mapcar (lambda (e) + (newsticker--opml-insert-elt e depth)) + (cdr group))) + (insert (make-string depth ? ) "\n") + (flatten-tree saved-feeds))) + +(defun newsticker--opml-insert-feed (feed-name depth) + "Insert an OPML FEED-NAME with indentation level DEPTH." + (let* ((feed-definition (seq-find (lambda (f) + (string= feed-name (car f))) + (append newsticker-url-list newsticker-url-list-defaults))) + (url (nth 1 feed-definition)) + (url-string (if (functionp url) (prin1-to-string url) + (xml-escape-string url)))) + (insert (make-string depth ? ) "\n")) + feed-name) + (defun newsticker--opml-import-outlines (outlines) - "Recursively import OUTLINES from OPML data. -Note that nested outlines are currently flattened -- i.e. grouping is -removed." - (mapc (lambda (outline) + "Recursively import OUTLINES from OPML data." + (mapcar (lambda (outline) (let ((name (xml-get-attribute outline 'text)) (url (xml-get-attribute outline 'xmlUrl)) (children (xml-get-children outline 'outline))) @@ -2277,18 +2304,27 @@ removed." (add-to-list 'newsticker-url-list (list name url nil nil nil) t)) (if children - (newsticker--opml-import-outlines children)))) - outlines)) + (append (list name) + (newsticker--opml-import-outlines children)) + name))) + outlines)) (defun newsticker-opml-import (filename) - "Import OPML data from FILENAME." + "Import OPML data from FILENAME. +Feeds are added to 'newsticker-url-list and 'newsticker-groups +preserving the outline structure." (interactive "fOPML file: ") (set-buffer (find-file-noselect filename)) (goto-char (point-min)) (let* ((node-list (xml-parse-region (point-min) (point-max))) + (title (car (xml-node-children + (car (xml-get-children + (car (xml-get-children (car node-list) 'head)) + 'title))))) (body (car (xml-get-children (car node-list) 'body))) - (outlines (xml-get-children body 'outline))) - (newsticker--opml-import-outlines outlines)) + (outlines (xml-get-children body 'outline)) + (imported-groups-data (newsticker--opml-import-outlines outlines))) + (add-to-list 'newsticker-groups (cons title imported-groups-data) t)) (customize-variable 'newsticker-url-list)) ;; ======================================================================