Function: newsticker--sentinel-work

newsticker--sentinel-work is a byte-compiled function defined in newst-backend.el.gz.

Signature

(newsticker--sentinel-work EVENT STATUS-OK FEED-NAME COMMAND BUFFER)

Documentation

Actually do the sentinel work.

Argument EVENT tells what has happened to the retrieval process. Argument STATUS-OK is the final status of the retrieval process, non-nil meaning retrieval was successful. Argument FEED-NAME is the name of the retrieved feed. Argument COMMAND is the command of the retrieval process. Argument BUFFER is the buffer of the retrieval process.

Source Code

;; Defined in /usr/src/emacs/lisp/net/newst-backend.el.gz
(defun newsticker--sentinel-work (event status-ok feed-name command buffer)
  "Actually do the sentinel work.
Argument EVENT tells what has happened to the retrieval process.
Argument STATUS-OK is the final status of the retrieval process,
non-nil meaning retrieval was successful.
Argument FEED-NAME is the name of the retrieved feed.
Argument COMMAND is the command of the retrieval process.
Argument BUFFER is the buffer of the retrieval process."
  (let ((time (current-time))
        (name-symbol (intern feed-name))
        (something-was-added nil)
        (ct (current-time)))
    ;; catch known errors (zombie processes, rubbish-xml etc.
    ;; if an error occurs the news feed is not updated!
    (catch 'oops
      (unless status-ok
        (setq newsticker--cache
              (newsticker--cache-add
               newsticker--cache
               name-symbol
               newsticker--error-headline
               (format-message
                (concat "%s: Newsticker could not retrieve news from %s.\n"
                        "Return status: `%s'\n"
                        "Command was `%s'")
                (format-time-string "%A, %H:%M")
                feed-name event command)
               ""
               ct
               'new
               0 '((guid nil "newsticker--download-error"))
               ct))
        (message "%s: Error while retrieving news from %s"
                 (format-time-string "%A, %H:%M")
                 feed-name)
        (throw 'oops nil))
      (let* ((coding-system 'utf-8)
             (node-list
              (save-current-buffer
                (set-buffer buffer)
                (unless (fboundp 'libxml-parse-xml-region)
                  (newsticker--do-xml-workarounds))
                ;; check coding system
                (goto-char (point-min))
                (if (re-search-forward "encoding=['\"]\\([^\"]+?\\)['\"]"
                                       nil t)
                    (setq coding-system (intern (downcase (match-string 1))))
                  (setq coding-system
                        (condition-case nil
                            (check-coding-system coding-system)
                          (coding-system-error
                           (message
                            "newsticker.el: ignoring coding system %s for %s"
                            coding-system feed-name)
                           nil))))
                ;; Decode if possible
                (when coding-system
                  (decode-coding-region (point-min) (point-max)
                                        coding-system))
                (condition-case errordata
                    ;; The xml parser might fail or the xml might be bugged.
                    (if (fboundp 'libxml-parse-xml-region)
                        (progn
                          (xml-remove-comments (point-min) (point-max))
                          (list (libxml-parse-xml-region (point-min) (point-max)
                                                         nil)))
                      (xml-parse-region (point-min) (point-max)))
                  (error (message "Could not parse %s: %s"
                                  (buffer-name) (cadr errordata))
                         (throw 'oops nil)))))
             (topnode (car node-list))
             (image-url nil)
             (icon-url nil))
        ;; mark all items as obsolete
        (newsticker--cache-replace-age newsticker--cache
                                       name-symbol
                                       'new 'obsolete-new)
        (newsticker--cache-replace-age newsticker--cache
                                       name-symbol
                                       'old 'obsolete-old)
        (newsticker--cache-replace-age newsticker--cache
                                       name-symbol
                                       'feed 'obsolete-old)

        ;; check Atom/RSS version and call corresponding parser
        (condition-case error-data
            (if (cond
                 ;; RSS 0.91
                 ((and (eq 'rss (xml-node-name topnode))
                       (string= "0.91" (xml-get-attribute topnode 'version)))
                  (setq image-url (newsticker--get-logo-url-rss-0.91 topnode))
                  (newsticker--parse-rss-0.91 feed-name time topnode))
                 ;; RSS 0.92
                 ((and (eq 'rss (xml-node-name topnode))
                       (string= "0.92" (xml-get-attribute topnode 'version)))
                  (setq image-url (newsticker--get-logo-url-rss-0.92 topnode))
                  (newsticker--parse-rss-0.92 feed-name time topnode))
                 ;; RSS 1.0
                 ((or (eq 'RDF (xml-node-name topnode))
                      (eq 'rdf:RDF (xml-node-name topnode)))
                  (setq image-url (newsticker--get-logo-url-rss-1.0 topnode))
                  (newsticker--parse-rss-1.0 feed-name time topnode))
                 ;; RSS 2.0
                 ((and (eq 'rss (xml-node-name topnode))
                       (string= "2.0" (xml-get-attribute topnode 'version)))
                  (setq image-url (newsticker--get-logo-url-rss-2.0 topnode))
                  (newsticker--parse-rss-2.0 feed-name time topnode))
                 ;; Atom 0.3
                 ((and (eq 'feed (xml-node-name topnode))
                       (string= "http://purl.org/atom/ns#"
                                (xml-get-attribute topnode 'xmlns)))
                  (setq image-url (newsticker--get-logo-url-atom-0.3 topnode))
                  (newsticker--parse-atom-0.3 feed-name time topnode))
                 ;; Atom 1.0
                 (t
                  ;; The test for Atom 1.0 does not work when using
                  ;; libxml, as with libxml the namespace attribute is
                  ;; not in the xml tree.  For the time being we skip
                  ;; the check and assume that we are dealing with an
                  ;; Atom 1.0 feed.

                  ;; (and (eq 'feed (xml-node-name topnode))
                  ;;      (string= "https://www.w3.org/2005/Atom"
                  ;;               (xml-get-attribute topnode 'xmlns)))
                  (setq image-url (newsticker--get-logo-url-atom-1.0 topnode))
                  (setq icon-url (newsticker--get-icon-url-atom-1.0 topnode))
                  (newsticker--parse-atom-1.0 feed-name time topnode))
                 ;; unknown feed type
                 ;; (t
                 ;;  (newsticker--debug-msg "Feed type unknown: %s: %s"
                 ;;                         (xml-node-name topnode) feed-name)
                 ;;  nil)
                 )
                (setq something-was-added t))
          (error (message "sentinelerror in %s: %s" feed-name error-data)))

        ;; Remove those old items from cache which have been removed from
        ;; the feed
        (newsticker--cache-replace-age newsticker--cache
                                       name-symbol 'obsolete-old 'deleteme)
        (newsticker--cache-remove newsticker--cache name-symbol
                                  'deleteme)
        ;; Remove those new items from cache which have been removed from
        ;; the feed.  Or keep them as `obsolete'
        (if (not newsticker-keep-obsolete-items)
            (newsticker--cache-remove newsticker--cache
                                      name-symbol 'obsolete-new)
          (setq newsticker--cache
                (newsticker--cache-mark-expired
                 newsticker--cache name-symbol 'obsolete 'obsolete-expired
                 newsticker-obsolete-item-max-age))
          (newsticker--cache-remove newsticker--cache
                                    name-symbol 'obsolete-expired)
          (newsticker--cache-replace-age newsticker--cache
                                         name-symbol 'obsolete-new
                                         'obsolete))
        (newsticker--update-process-ids)
        ;; setup scrollable text
        (when (= 0 (length newsticker--process-ids))
          (when (fboundp 'newsticker--ticker-text-setup) ;silence
                                        ;compiler
                                        ;warnings
            (newsticker--ticker-text-setup)))
        (setq newsticker--latest-update-time (current-time))
        (when something-was-added
          ;; FIXME: should we care about removed items as well?
          (newsticker--cache-save-feed
           (newsticker--cache-get-feed name-symbol))
          (when (fboundp 'newsticker--buffer-set-uptodate) ;silence
                                        ;compiler
                                        ;warnings
            (newsticker--buffer-set-uptodate nil)))
        ;; kill the process buffer if wanted
        (unless newsticker-debug
          (kill-buffer buffer))
        ;; launch retrieval of images
        (when (and (boundp 'newsticker-download-logos)
                   newsticker-download-logos)
          ;; feed logo
          (when image-url
            (newsticker--image-get feed-name feed-name (newsticker--images-dir)
                                   image-url))
          ;; icon / favicon
          (setq icon-url
                (or icon-url
                    (let* ((feed-url (newsticker--link (cadr (newsticker--cache-get-feed
                                                              (intern feed-name)))))
                           (uri (url-generic-parse-url feed-url)))
                      (when (and feed-url uri)
                        (setf (url-filename uri) nil)
                        (setf (url-target uri) nil)
                        (concat (url-recreate-url uri) "favicon.ico")))))
          (when icon-url
            (newsticker--image-get feed-name
                                   (concat feed-name "."
                                           (file-name-extension icon-url))
                                   (newsticker--icons-dir)
                                   icon-url))))))
  (when newsticker--sentinel-callback
    (funcall newsticker--sentinel-callback)))