lisp/net/newst-reader.el

   1 ;;; newst-reader.el --- Generic RSS reader functions.
   2
   3 ;; Copyright (C) 2003-2017 Free Software Foundation, Inc.
   4
   5 ;; Author:      Ulf Jasper <ulf.jasper@web.de>
   6 ;; Filename:    newst-reader.el
   7 ;; URL:         http://www.nongnu.org/newsticker
   8 ;; Package:     newsticker
   9
  10 ;; ======================================================================
  11
  12 ;; This file is part of GNU Emacs.
  13
  14 ;; GNU Emacs is free software: you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation, either version 3 of the License, or
  17 ;; (at your option) any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  26
  27 ;; ======================================================================
  28 ;;; Commentary:
  29
  30 ;; See newsticker.el
  31
  32 ;; ======================================================================
  33 ;;; Code:
  34
  35 (require 'newst-backend)
  36
  37 ;; ======================================================================
  38 ;;; Customization
  39 ;; ======================================================================
  40 (defun newsticker--set-customvar-formatting (symbol value)
  41   "Set newsticker-variable SYMBOL value to VALUE.
  42 Calls all actions which are necessary in order to make the new
  43 value effective."
  44   (if (or (not (boundp symbol))
  45           (equal (symbol-value symbol) value))
  46       (set symbol value)
  47     ;; something must have changed
  48     (set symbol value)
  49     (when (fboundp 'newsticker--forget-preformatted)
  50       (newsticker--forget-preformatted))))
  51
  52 ;; ======================================================================
  53 ;; reader
  54 (defgroup newsticker-reader nil
  55   "Settings for the feed reader."
  56   :group 'newsticker)
  57
  58 (defcustom newsticker-frontend
  59   'newsticker-treeview
  60   "Newsticker frontend for reading news.
  61 This must be one of the functions `newsticker-plainview' or
  62 `newsticker-treeview'."
  63   :type '(choice :tag "Frontend"
  64                  (const :tag "Single buffer (plainview)" newsticker-plainview)
  65                  (const :tag "Tree view (treeview)" newsticker-treeview))
  66   :group 'newsticker-reader)
  67
  68 ;; image related things
  69 (defcustom newsticker-download-logos
  70   t
  71   "If non-nil newsticker downloads logo images of subscribed feeds."
  72   :version "25.1"
  73   :type 'boolean
  74   :group 'newsticker-reader)
  75
  76 (defcustom newsticker-enable-logo-manipulations
  77   t
  78   "If non-nil newsticker manipulates logo images.
  79 This enables the following image properties: heuristic mask for all
  80 logos, and laplace-conversion for images without new items."
  81   :type 'boolean
  82   :group 'newsticker-reader)
  83
  84 (defcustom newsticker-justification
  85   'left
  86   "How to fill item descriptions.
  87 If non-nil newsticker calls `fill-region' to wrap long lines in
  88 item descriptions.  However, if an item description contains HTML
  89 text and `newsticker-html-renderer' is non-nil, filling is not
  90 done."
  91   :type '(choice :tag "Justification"
  92                  (const :tag "No filling" nil)
  93                  (const :tag "Left"       left)
  94                  (const :tag "Right"      right)
  95                  (const :tag "Center"     center)
  96                  (const :tag "Full"       full))
  97   :set 'newsticker--set-customvar-formatting
  98   :group 'newsticker-reader)
  99
 100 (defcustom newsticker-use-full-width
 101   t
 102   "Decides whether to use the full window width when filling.
 103 If non-nil newsticker sets `fill-column' so that the whole
 104 window is used when filling.  See also `newsticker-justification'."
 105   :type 'boolean
 106   :set 'newsticker--set-customvar-formatting
 107   :group 'newsticker-reader)
 108
 109 (defcustom newsticker-html-renderer
 110   (if (fboundp 'libxml-parse-html-region)
 111       #'shr-render-region)
 112   "Function for rendering HTML contents.
 113 If non-nil, newsticker.el will call this function whenever it
 114 finds HTML-like tags in item descriptions.
 115 Possible functions include `shr-render-region', `w3m-region', `w3-region', and
 116 `newsticker-htmlr-render'.
 117 Newsticker automatically loads the respective package w3m, w3, or
 118 htmlr if this option is set."
 119   :type '(choice :tag "Function"
 120                  (const :tag "None" nil)
 121                  (const :tag "SHR" shr-render-region)
 122                  (const :tag "w3" w3-region)
 123                  (const :tag "w3m" w3m-region)
 124                  (const :tag "htmlr" newsticker-htmlr-render))
 125   :set 'newsticker--set-customvar-formatting
 126   :group 'newsticker-reader)
 127
 128 (defcustom newsticker-date-format
 129   "(%A, %H:%M)"
 130   "Format for the date part in item and feed lines.
 131 See `format-time-string' for a list of valid specifiers."
 132   :type 'string
 133   :set 'newsticker--set-customvar-formatting
 134   :group 'newsticker-reader)
 135
 136 (defgroup newsticker-faces nil
 137   "Settings for the faces of the feed reader."
 138   :group 'newsticker-reader)
 139
 140 (defface newsticker-feed-face
 141   '((default :weight bold :height 1.2)
 142     (((class color) (background dark))  :foreground "white")
 143     (((class color) (background light)) :foreground "black"))
 144   "Face for news feeds."
 145   :group 'newsticker-faces)
 146
 147 (defface newsticker-extra-face
 148   '((default :slant italic :height 0.8)
 149     (((class color) (background dark))  :foreground "gray50")
 150     (((class color) (background light)) :foreground "gray50"))
 151   "Face for newsticker dates."
 152   :group 'newsticker-faces)
 153
 154 (defface newsticker-enclosure-face
 155   '((default :weight bold)
 156     (((class color) (background dark))  :background "orange")
 157     (((class color) (background light)) :background "orange"))
 158   "Face for enclosed elements."
 159   :group 'newsticker-faces)
 160
 161 ;; ======================================================================
 162 ;;; Utility functions
 163 ;; ======================================================================
 164 (defun newsticker--insert-enclosure (item keymap)
 165   "Insert enclosure element of a news ITEM into the current buffer.
 166 KEYMAP will be applied."
 167   (let ((enclosure (newsticker--enclosure item))
 168         (beg (point)))
 169     (when enclosure
 170       (let ((url (cdr (assoc 'url enclosure)))
 171             (length (string-to-number (or (cdr (assoc 'length enclosure))
 172                                           "-1")))
 173             (type (cdr (assoc 'type enclosure))))
 174         (cond ((> length 1048576)
 175                (insert (format "Enclosed file (%s, %1.2f MBytes)" type
 176                                (/ length 1048576))))
 177               ((> length 1024)
 178                (insert (format "Enclosed file (%s, %1.2f KBytes)" type
 179                                (/ length 1024))))
 180               ((> length 0)
 181                (insert (format "Enclosed file (%s, %1.2f Bytes)" type
 182                                length)))
 183               (t
 184                (insert (format "Enclosed file (%s, unknown size)" type))))
 185         (add-text-properties beg (point)
 186                              (list 'mouse-face 'highlight
 187                                    'nt-link url
 188                                    'help-echo (format
 189                                                "mouse-2: visit (%s)" url)
 190                                    'keymap keymap
 191                                    'nt-face 'enclosure
 192                                    'nt-type 'desc))
 193         (insert "\n")))))
 194
 195 (defun newsticker--print-extra-elements (item keymap &optional htmlish)
 196   "Insert extra-elements of ITEM in a pretty form into the current buffer.
 197 KEYMAP is applied.  If HTMLISH is non-nil then HTML-markup is used
 198 for formatting."
 199   (let ((ignored-elements '(items link title description content
 200                                   content:encoded encoded
 201                                   dc:subject subject
 202                                   dc:date date entry item guid pubDate
 203                                   published updated
 204                                   enclosure))
 205         (left-column-width 1))
 206     (if htmlish (insert "<ul>"))
 207     (mapc (lambda (extra-element)
 208             (when (listp extra-element) ;; take care of broken xml
 209                                         ;; data, 2007-05-25
 210               (unless (memq (car extra-element) ignored-elements)
 211                 (setq left-column-width (max left-column-width
 212                                              (length (symbol-name
 213                                                       (car extra-element))))))))
 214           (newsticker--extra item))
 215     (mapc (lambda (extra-element)
 216             (when (listp extra-element) ;; take care of broken xml
 217                                         ;; data, 2007-05-25
 218               (unless (memq (car extra-element) ignored-elements)
 219                 (newsticker--do-print-extra-element extra-element
 220                                                     left-column-width
 221                                                     keymap
 222                                                     htmlish))))
 223           (newsticker--extra item))
 224     (if htmlish (insert "</ul>"))))
 225
 226 (defun newsticker--do-print-extra-element (extra-element width keymap htmlish)
 227   "Actually print an EXTRA-ELEMENT using the given WIDTH.
 228 KEYMAP is applied.  If HTMLISH is non-nil then HTML-markup is used
 229 for formatting."
 230   (let ((name (symbol-name (car extra-element))))
 231     (if htmlish
 232         (insert (format "<li>%s: " name))
 233       (insert (format "%s: " name))
 234       (insert (make-string (- width (length name)) ? ))))
 235   (let (;;(attributes (cadr extra-element)) ;FIXME!!!!
 236         (contents (cddr extra-element)))
 237     (cond ((listp contents)
 238            (mapc (lambda (i)
 239                    (if (and (stringp i)
 240                             (string-match "^http://.*" i))
 241                        (let ((pos (point)))
 242                          (insert i " ") ; avoid self-reference from the
 243                                         ; nt-link thing
 244                          (add-text-properties
 245                           pos (point)
 246                           (list 'mouse-face 'highlight
 247                                 'nt-link i
 248                                 'help-echo
 249                                 (format "mouse-2: visit (%s)" i)
 250                                 'keymap keymap)))
 251                          (insert (format "%s" i))))
 252                  contents))
 253           (t
 254            (insert (format "%s" contents))))
 255     (if htmlish
 256         (insert "</li>")
 257       (insert "\n"))))
 258
 259 (defun newsticker--image-read (feed-name-symbol disabled &optional max-height)
 260   "Read the cached image for FEED-NAME-SYMBOL from disk.
 261 If DISABLED is non-nil the image will be converted to a disabled look
 262 \(unless `newsticker-enable-logo-manipulations' is not t).
 263 Optional argument MAX-HEIGHT specifies the maximal image height.
 264 Return the image."
 265   (let ((image-name (concat (newsticker--images-dir)
 266                             (symbol-name feed-name-symbol))))
 267     (when (file-exists-p image-name)
 268       (condition-case error-data
 269           (create-image
 270            image-name
 271            (and (fboundp 'imagemagick-types)
 272                 (imagemagick-types)
 273                 'imagemagick)
 274            nil
 275            :conversion (and newsticker-enable-logo-manipulations
 276                             disabled
 277                             'disabled)
 278            :mask (and newsticker-enable-logo-manipulations
 279                       'heuristic)
 280            :ascent 100
 281            :max-height max-height)
 282         (error
 283          (message "Error: cannot create image for %s: %s"
 284                   feed-name-symbol error-data))))))
 285
 286 (defun newsticker--icon-read (feed-name-symbol)
 287   "Read the cached icon for FEED-NAME-SYMBOL from disk.
 288 Return the image."
 289   (catch 'icon
 290     (when (file-exists-p (newsticker--icons-dir))
 291       (dolist (file (directory-files (newsticker--icons-dir) t
 292                              (concat (symbol-name feed-name-symbol) "\\..*")))
 293         (condition-case error-data
 294             (throw 'icon (create-image
 295                           file (and (fboundp 'imagemagick-types)
 296                                     (imagemagick-types)
 297                                     'imagemagick)
 298                           nil
 299                           :ascent 'center
 300                           :max-width 16
 301                           :max-height 16))
 302           (error
 303            (message "Error: cannot create icon for %s: %s"
 304                     feed-name-symbol error-data)))))
 305     ;; Fallback: default icon.
 306     (find-image '((:type png :file "newsticker/rss-feed.png" :ascent center)))))
 307
 308 ;; the functions we need for retrieval and display
 309 ;;;###autoload
 310 (defun newsticker-show-news ()
 311   "Start reading news.  You may want to bind this to a key."
 312   (interactive)
 313   (newsticker-start t) ;; will start only if not running
 314   ;; Load the html rendering packages
 315   (if newsticker-html-renderer
 316       (cond ((eq newsticker-html-renderer 'w3m-region)
 317              (require 'w3m))
 318             ((eq newsticker-html-renderer 'w3-region)
 319              (require 'w3-auto))
 320             ((eq newsticker-html-renderer 'newsticker-htmlr-render)
 321              (require 'htmlr))))
 322   (funcall newsticker-frontend))
 323
 324 ;; ======================================================================
 325 ;;; Toolbar
 326 ;; ======================================================================
 327
 328 (defun newsticker-browse-url-item (feed item)
 329   "Convert FEED ITEM to html and call `browse-url' on result."
 330   (interactive)
 331   (let ((t-file (make-temp-file "newsticker")))
 332     (with-temp-file t-file
 333       (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>
 334                <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
 335                \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
 336                <html xmlns=\"http://www.w3.org/1999/xhtml\">
 337                <body>")
 338       (insert "<h1>" feed ": " (newsticker--title item) "</h1>")
 339       (insert (format-time-string newsticker-date-format
 340                                   (newsticker--time item)))
 341       (insert "<br/>")
 342       (insert (or (newsticker--desc item) "[No Description]"))
 343       (when (newsticker--enclosure item)
 344         (insert "<br/><hr/><i>")
 345         (newsticker--insert-enclosure item nil)
 346         (insert "</i>"))
 347       (when (newsticker--extra item)
 348         (insert "<br/><hr/><tt>")
 349         (newsticker--print-extra-elements item nil)
 350         (insert "</tt>"))
 351       (insert "</body></html>"))
 352     (browse-url t-file)))
 353
 354 (provide 'newst-reader)
 355
 356 ;;; newst-reader.el ends here