;; 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'.")
: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
<http://rcs.userland.com/>.
(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)
(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"
;; 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
(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
;; 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
(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."
(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."
"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."
(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)
(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."
(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))
;; FIXME: use newsticker-groups
(interactive)
(with-current-buffer (get-buffer-create "*OPML Export*")
+ (erase-buffer)
(set-buffer-file-coding-system 'utf-8)
(insert (concat
"<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
"<!-- OPML generated by Emacs newsticker.el -->\n"
"<opml version=\"1.0\">\n"
" <head>\n"
- " <title>mySubscriptions</title>\n"
+ " <title>Emacs newsticker subscriptions</title>\n"
" <dateCreated>" (format-time-string "%a, %d %b %Y %T %z")
"</dateCreated>\n"
" <ownerEmail>" user-mail-address "</ownerEmail>\n"
" <ownerName>" (user-full-name) "</ownerName>\n"
" </head>\n"
" <body>\n"))
- (dolist (sub (append newsticker-url-list newsticker-url-list-defaults))
- (insert " <outline text=\"")
- (insert (newsticker--title sub))
- (insert "\" xmlUrl=\"")
- (insert (xml-escape-string (let ((url (cadr sub)))
- (if (stringp url) url (prin1-to-string url)))))
- (insert "\"/>\n"))
- (insert " </body>\n</opml>\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 " </body>\n</opml>\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 ? ) "<outline type=\"folder\" text=\"" (car group) "\">\n")
+ (setq saved-feeds (mapcar (lambda (e)
+ (newsticker--opml-insert-elt e depth))
+ (cdr group)))
+ (insert (make-string depth ? ) "</outline>\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 ? ) "<outline text=\"" feed-name
+ "\" xmlUrl=\"" url-string
+ "\"/>\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)))
(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))
;; ======================================================================
projects / emacs.git / commitdiff