lisp/net/newst-reader.el

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