-;;; newst-backend.el --- Retrieval backend for newsticker.
+;;; newst-backend.el --- Retrieval backend for newsticker -*- lexical-binding:t -*-
;; Copyright (C) 2003-2017 Free Software Foundation, Inc.
(cons feed-name timer))))))
;;;###autoload
-(defun newsticker-start (&optional do-not-complain-if-running)
+(defun newsticker-start (&optional _do-not-complain-if-running)
"Start the newsticker.
Start the timers for display and retrieval. If the newsticker, i.e. the
timers, are running already a warning message is printed unless
(when (fboundp 'newsticker-stop-ticker) ; silence compiler warnings
(newsticker-stop-ticker))
(when (newsticker-running-p)
- (mapc (lambda (name-and-timer)
- (newsticker--stop-feed (car name-and-timer)))
- newsticker--retrieval-timer-list)
+ (dolist (name-and-timer newsticker--retrieval-timer-list)
+ (newsticker--stop-feed (car name-and-timer)))
(setq newsticker--retrieval-timer-list nil)
(run-hooks 'newsticker-stop-hook)
(message "Newsticker stopped!")))
This does NOT start the retrieval timers."
(interactive)
;; launch retrieval of news
- (mapc (lambda (item)
- (newsticker-get-news (car item)))
- (append newsticker-url-list-defaults newsticker-url-list)))
+ (dolist (item (append newsticker-url-list-defaults newsticker-url-list))
+ (newsticker-get-news (car item))))
(defun newsticker-save-item (feed item)
"Save FEED ITEM."
(let ((buffername (concat " *newsticker-funcall-" feed-name "*")))
(with-current-buffer (get-buffer-create buffername)
(erase-buffer)
- (insert (string-to-multibyte (funcall function feed-name)))
+ (newsticker--insert-bytes (funcall function feed-name))
(newsticker--sentinel-work nil t feed-name function
(current-buffer)))))
FEED-NAME is the name of the feed that the news were retrieved
from."
(let ((buf (get-buffer-create (concat " *newsticker-url-" feed-name "*")))
- (result (string-to-multibyte (buffer-string))))
+ (result (buffer-string)))
(set-buffer buf)
(erase-buffer)
- (insert result)
+ (newsticker--insert-bytes result)
;; remove MIME header
(goto-char (point-min))
(search-forward "\n\n" nil t)
or URL `http://my.netscape.com/publish/formats/rss-spec-0.91.html'."
(newsticker--debug-msg "Parsing RSS 0.91 feed %s" name)
(let* ((channelnode (car (xml-get-children topnode 'channel)))
- (pub-date (newsticker--decode-rfc822-date
- (car (xml-node-children
- (car (xml-get-children channelnode 'pubDate))))))
is-new-feed has-new-items)
(setq is-new-feed (newsticker--parse-generic-feed
name time
(car (xml-node-children
(car (xml-get-children node 'pubDate))))))
;; guid-fn
- (lambda (node)
+ (lambda (_node)
nil)
;; extra-fn
(lambda (node)
For the RSS 0.92 specification see URL `http://backend.userland.com/rss092'."
(newsticker--debug-msg "Parsing RSS 0.92 feed %s" name)
(let* ((channelnode (car (xml-get-children topnode 'channel)))
- (pub-date (newsticker--decode-rfc822-date
- (car (xml-node-children
- (car (xml-get-children channelnode 'pubDate))))))
is-new-feed has-new-items)
(setq is-new-feed (newsticker--parse-generic-feed
name time
(car (xml-node-children
(car (xml-get-children node 'pubDate))))))
;; guid-fn
- (lambda (node)
+ (lambda (_node)
nil)
;; extra-fn
(lambda (node)
(car (xml-node-children
(car (xml-get-children node 'date)))))))
;; guid-fn
- (lambda (node)
+ (lambda (_node)
nil)
;; extra-fn
(lambda (node)
description, link, and extra elements resp."
(let ((title (or title "[untitled]"))
(link (or link ""))
- (old-item nil)
(position 0)
(something-was-added nil))
;; decode numeric entities
EXTRA-FN give functions for extracting title, description, link,
time, guid, and extra-elements resp. They are called with one
argument, which is one of the items in ITEMLIST."
- (let (title desc link
- (old-item nil)
- (position 0)
+ (let ((position 0)
(something-was-added nil))
;; gather all items for this feed
- (mapc (lambda (node)
- (setq position (1+ position))
- (setq title (or (funcall title-fn node) "[untitled]"))
- (setq desc (funcall desc-fn node))
- (setq link (or (funcall link-fn node) ""))
- (setq time (or (funcall time-fn node) time))
- ;; It happened that the title or description
- ;; contained evil HTML code that confused the
- ;; xml parser. Therefore:
- (unless (stringp title)
- (setq title (prin1-to-string title)))
- (unless (or (stringp desc) (not desc))
- (setq desc (prin1-to-string desc)))
- ;; ignore items with empty title AND empty desc
- (when (or (> (length title) 0)
- (> (length desc) 0))
- ;; decode numeric entities
- (setq title (xml-substitute-numeric-entities title))
- (when desc
- (setq desc (xml-substitute-numeric-entities desc)))
- (setq link (xml-substitute-numeric-entities link))
- ;; remove whitespace from title, desc, and link
- (setq title (newsticker--remove-whitespace title))
- (setq desc (newsticker--remove-whitespace desc))
- (setq link (newsticker--remove-whitespace link))
- ;; add data to cache
- ;; do we have this item already?
- (let* ((guid (funcall guid-fn node)))
- ;;(message "guid=%s" guid)
- (setq old-item
- (newsticker--cache-contains newsticker--cache
- (intern name) title
- desc link nil guid)))
- ;; add this item, or mark it as old, or do nothing
- (let ((age1 'new)
- (age2 'old)
- (item-new-p nil))
- (if old-item
- (let ((prev-age (newsticker--age old-item)))
- (unless newsticker-automatically-mark-items-as-old
- ;; Some feeds deliver items multiply, the
- ;; first time we find an 'obsolete-old one in
- ;; the cache, the following times we find an
- ;; 'old one
- (if (memq prev-age '(obsolete-old old))
- (setq age2 'old)
- (setq age2 'new)))
- (if (eq prev-age 'immortal)
- (setq age2 'immortal))
- (setq time (newsticker--time old-item)))
- ;; item was not there
- (setq item-new-p t)
- (setq something-was-added t))
- (let ((extra-elements-with-guid (funcall extra-fn node)))
- (unless (assoc 'guid extra-elements-with-guid)
- (setq extra-elements-with-guid
- (cons `(guid nil ,(funcall guid-fn node))
- extra-elements-with-guid)))
- (setq newsticker--cache
- (newsticker--cache-add
- newsticker--cache (intern name) title desc link
- time age1 position extra-elements-with-guid
- time age2)))
- (when item-new-p
- (let ((item (newsticker--cache-contains
- newsticker--cache (intern name) title
- desc link nil)))
- (if newsticker-auto-mark-filter-list
- (newsticker--run-auto-mark-filter name item))
- (run-hook-with-args
- 'newsticker-new-item-functions name item))))))
- itemlist)
+ (dolist (node itemlist)
+ (setq position (1+ position))
+ (let ((title (or (funcall title-fn node) "[untitled]"))
+ (desc (funcall desc-fn node))
+ (link (or (funcall link-fn node) "")))
+ (setq time (or (funcall time-fn node) time))
+ ;; It happened that the title or description
+ ;; contained evil HTML code that confused the
+ ;; xml parser. Therefore:
+ (unless (stringp title)
+ (setq title (prin1-to-string title)))
+ (unless (or (stringp desc) (not desc))
+ (setq desc (prin1-to-string desc)))
+ ;; ignore items with empty title AND empty desc
+ (when (or (> (length title) 0)
+ (> (length desc) 0))
+ ;; decode numeric entities
+ (setq title (xml-substitute-numeric-entities title))
+ (when desc
+ (setq desc (xml-substitute-numeric-entities desc)))
+ (setq link (xml-substitute-numeric-entities link))
+ ;; remove whitespace from title, desc, and link
+ (setq title (newsticker--remove-whitespace title))
+ (setq desc (newsticker--remove-whitespace desc))
+ (setq link (newsticker--remove-whitespace link))
+ ;; add data to cache
+ ;; do we have this item already?
+ (let ((old-item
+ (let* ((guid (funcall guid-fn node)))
+ ;;(message "guid=%s" guid)
+ (newsticker--cache-contains newsticker--cache
+ (intern name) title
+ desc link nil guid)))
+ (age1 'new)
+ (age2 'old)
+ (item-new-p nil))
+ ;; Add this item, or mark it as old, or do nothing
+ (if old-item
+ (let ((prev-age (newsticker--age old-item)))
+ (unless newsticker-automatically-mark-items-as-old
+ ;; Some feeds deliver items multiply, the
+ ;; first time we find an 'obsolete-old one in
+ ;; the cache, the following times we find an
+ ;; 'old one
+ (if (memq prev-age '(obsolete-old old))
+ (setq age2 'old)
+ (setq age2 'new)))
+ (if (eq prev-age 'immortal)
+ (setq age2 'immortal))
+ (setq time (newsticker--time old-item)))
+ ;; item was not there
+ (setq item-new-p t)
+ (setq something-was-added t))
+ (let ((extra-elements-with-guid (funcall extra-fn node)))
+ (unless (assoc 'guid extra-elements-with-guid)
+ (setq extra-elements-with-guid
+ (cons `(guid nil ,(funcall guid-fn node))
+ extra-elements-with-guid)))
+ (setq newsticker--cache
+ (newsticker--cache-add
+ newsticker--cache (intern name) title desc link
+ time age1 position extra-elements-with-guid
+ time age2)))
+ (when item-new-p
+ (let ((item (newsticker--cache-contains
+ newsticker--cache (intern name) title
+ desc link nil)))
+ (if newsticker-auto-mark-filter-list
+ (newsticker--run-auto-mark-filter name item))
+ (run-hook-with-args
+ 'newsticker-new-item-functions name item)))))))
something-was-added))
;; ======================================================================
;;; Misc
;; ======================================================================
+(defun newsticker--insert-bytes (bytes)
+ (insert (decode-coding-string bytes 'binary)))
+
(defun newsticker--remove-whitespace (string)
"Remove leading and trailing whitespace from STRING."
;; we must have ...+ but not ...* in the regexps otherwise xemacs loops
(setq minute (+ minute offset-minute)))))
(condition-case error-data
(let ((i 1))
- (mapc (lambda (m)
- (if (string= month-name m)
- (setq month i))
- (setq i (1+ i)))
- '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug"
- "Sep" "Oct" "Nov" "Dec"))
+ (dolist (m '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug"
+ "Sep" "Oct" "Nov" "Dec"))
+ (if (string= month-name m)
+ (setq month i))
+ (setq i (1+ i)))
(encode-time second minute hour day month year t))
(error
(message "Cannot decode \"%s\": %s %s" rfc822-string
(defun newsticker--lists-intersect-p (list1 list2)
"Return t if LIST1 and LIST2 share elements."
(let ((result nil))
- (mapc (lambda (elt)
- (if (memq elt list2)
- (setq result t)))
- list1)
+ (dolist (elt list1)
+ (if (memq elt list2)
+ (setq result t)))
result))
(defun newsticker--update-process-ids ()
"Update list of ids of active newsticker processes.
Checks list of active processes against list of newsticker processes."
- (let ((active-procs (process-list))
- (new-list nil))
- (mapc (lambda (proc)
- (let ((id (process-id proc)))
- (if (memq id newsticker--process-ids)
- (setq new-list (cons id new-list)))))
- active-procs)
+ (let ((new-list nil))
+ (dolist (proc (process-list))
+ (let ((id (process-id proc)))
+ (if (memq id newsticker--process-ids)
+ (setq new-list (cons id new-list)))))
(setq newsticker--process-ids new-list))
(force-mode-line-update))
(process-put proc 'nt-feed-name feed-name)
(process-put proc 'nt-filename filename)))))
-(defun newsticker--image-sentinel (process event)
+(defun newsticker--image-sentinel (process _event)
"Sentinel for image-retrieving PROCESS caused by EVENT."
(let* ((p-status (process-status process))
(exit-status (process-exit-status process))
The image is saved in DIRECTORY as FILENAME."
(let ((do-save
(or (not status)
- (let ((status-type (car status))
- (status-details (cdr status)))
- (cond ((eq status-type :redirect)
- ;; don't care about redirects
- t)
- ((eq status-type :error)
- ;; silently ignore errors
- nil))))))
+ ;; (let ((status-type (car status)))
+ ;; (cond ((eq status-type :redirect)
+ ;; ;; don't care about redirects
+ ;; t)
+ ;; ((eq status-type :error)
+ ;; ;; silently ignore errors
+ ;; nil)))
+ (eq (car status) :redirect))))
(when do-save
(let ((buf (get-buffer-create (concat " *newsticker-url-image-" feed-name "-"
directory "*")))
- (result (string-to-multibyte (buffer-string))))
+ (result (buffer-string)))
(set-buffer buf)
(erase-buffer)
- (insert result)
+ (newsticker--insert-bytes result)
;; remove MIME header
(goto-char (point-min))
(search-forward "\n\n")
data)
data)
-(defun newsticker--cache-contains (data feed title desc link age
+(defun newsticker--cache-contains (data feed title desc link _age
&optional guid)
"Check DATA whether FEED contains an item with the given properties.
This function returns the contained item or nil if it is not
(newsticker--cache-read-version1))
(when (y-or-n-p (format "Delete old newsticker cache file? "))
(delete-file newsticker-cache-filename)))
- (mapc (lambda (f)
- (newsticker--cache-read-feed (car f)))
- (append newsticker-url-list-defaults newsticker-url-list))))
+ (dolist (f (append newsticker-url-list-defaults newsticker-url-list))
+ (newsticker--cache-read-feed (car f)))))
(defun newsticker--cache-read-feed (feed-name)
"Read cache data for feed named FEED-NAME."
" <ownerName>" (user-full-name) "</ownerName>\n"
" </head>\n"
" <body>\n"))
- (mapc (lambda (sub)
- (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"))
- (append newsticker-url-list newsticker-url-list-defaults))
+ (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"))
(pop-to-buffer "*OPML Export*")
(when (fboundp 'sgml-mode)
This function checks the variable `newsticker-auto-mark-filter-list'
for an entry that matches FEED and ITEM."
(let ((case-fold-search t))
- (mapc (lambda (filter)
- (let ((filter-feed (car filter))
- (pattern-list (cadr filter)))
- (when (string-match filter-feed feed)
- (newsticker--do-run-auto-mark-filter item pattern-list))))
- newsticker-auto-mark-filter-list)))
+ (dolist (filter newsticker-auto-mark-filter-list)
+ (let ((filter-feed (car filter))
+ (pattern-list (cadr filter)))
+ (when (string-match filter-feed feed)
+ (newsticker--do-run-auto-mark-filter item pattern-list))))))
(defun newsticker--do-run-auto-mark-filter (item list)
"Actually compare ITEM against the pattern-LIST.
LIST must be an element of `newsticker-auto-mark-filter-list'."
- (mapc (lambda (pattern)
- (let ((place (nth 1 pattern))
- (regexp (nth 2 pattern))
- (title (newsticker--title item))
- (desc (newsticker--desc item)))
- (when (or (eq place 'title) (eq place 'all))
- (when (and title (string-match regexp title))
- (newsticker--process-auto-mark-filter-match item pattern)))
- (when (or (eq place 'description) (eq place 'all))
- (when (and desc (string-match regexp desc))
- (newsticker--process-auto-mark-filter-match item pattern)))))
- list))
+ (dolist (pattern list)
+ (let ((place (nth 1 pattern))
+ (regexp (nth 2 pattern))
+ (title (newsticker--title item))
+ (desc (newsticker--desc item)))
+ (when (or (eq place 'title) (eq place 'all))
+ (when (and title (string-match regexp title))
+ (newsticker--process-auto-mark-filter-match item pattern)))
+ (when (or (eq place 'description) (eq place 'all))
+ (when (and desc (string-match regexp desc))
+ (newsticker--process-auto-mark-filter-match item pattern))))))
(defun newsticker--process-auto-mark-filter-match (item pattern)
"Process ITEM that matches an auto-mark-filter PATTERN."
;; ======================================================================
;;; Retrieve samples
;; ======================================================================
-(defun newsticker-retrieve-random-message (feed-name)
+(defun newsticker-retrieve-random-message (_feed-name)
"Return an artificial RSS string under the name FEED-NAME."
(concat "<?xml version=\"1.0\" encoding=\"iso-8859-1\" ?><rss version=\"0.91\">"
"<channel>"
projects / emacs.git / commitdiff