code.delx.au - gnu-emacs/blob - lisp/net/newst-reader.el

   1 ;;; newst-reader.el --- Generic RSS reader functions.
   2
   3 ;; Copyright (C) 2003-2014 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."
 197   (let ((ignored-elements '(items link title description content
 198                                   content:encoded encoded
 199                                   dc:subject subject
 200                                   dc:date date entry item guid pubDate
 201                                   published updated
 202                                   enclosure))
 203         (left-column-width 1))
 204     (if htmlish (insert "<ul>"))
 205     (mapc (lambda (extra-element)
 206             (when (listp extra-element) ;; take care of broken xml
 207                                         ;; data, 2007-05-25
 208               (unless (memq (car extra-element) ignored-elements)
 209                 (setq left-column-width (max left-column-width
 210                                              (length (symbol-name
 211                                                       (car extra-element))))))))
 212           (newsticker--extra item))
 213     (mapc (lambda (extra-element)
 214             (when (listp extra-element) ;; take care of broken xml
 215                                         ;; data, 2007-05-25
 216               (unless (memq (car extra-element) ignored-elements)
 217                 (newsticker--do-print-extra-element extra-element
 218                                                     left-column-width
 219                                                     keymap
 220                                                     htmlish))))
 221           (newsticker--extra item))
 222     (if htmlish (insert "</ul>"))))
 223
 224 (defun newsticker--do-print-extra-element (extra-element width keymap htmlish)
 225   "Actually print an EXTRA-ELEMENT using the given WIDTH.
 226 KEYMAP is applied."
 227   (let ((name (symbol-name (car extra-element))))
 228     (if htmlish
 229         (insert (format "<li>%s: " name))
 230       (insert (format "%s: " name))
 231       (insert (make-string (- width (length name)) ? ))))
 232   (let (;;(attributes (cadr extra-element)) ;FIXME!!!!
 233         (contents (cddr extra-element)))
 234     (cond ((listp contents)
 235            (mapc (lambda (i)
 236                    (if (and (stringp i)
 237                             (string-match "^http://.*" i))
 238                        (let ((pos (point)))
 239                          (insert i " ") ; avoid self-reference from the
 240                                         ; nt-link thing
 241                          (add-text-properties
 242                           pos (point)
 243                           (list 'mouse-face 'highlight
 244                                 'nt-link i
 245                                 'help-echo
 246                                 (format "mouse-2: visit (%s)" i)
 247                                 'keymap keymap)))
 248                          (insert (format "%s" i))))
 249                  contents))
 250           (t
 251            (insert (format "%s" contents))))
 252     (if htmlish
 253         (insert "</li>")
 254       (insert "\n"))))
 255
 256 (defun newsticker--image-read (feed-name-symbol disabled)
 257   "Read the cached image for FEED-NAME-SYMBOL from disk.
 258 If DISABLED is non-nil the image will be converted to a disabled look
 259 \(unless `newsticker-enable-logo-manipulations' is not t\).
 260 Return the image."
 261   (let ((image-name (concat (newsticker--images-dir)
 262                             (symbol-name feed-name-symbol)))
 263         (img nil))
 264     (when (file-exists-p image-name)
 265       (condition-case error-data
 266           (setq img (create-image
 267                      image-name nil nil
 268                      :conversion (and newsticker-enable-logo-manipulations
 269                                       disabled
 270                                       'disabled)
 271                      :mask (and newsticker-enable-logo-manipulations
 272                                 'heuristic)
 273                      :ascent 70))
 274         (error
 275          (message "Error: cannot create image for %s: %s"
 276                   feed-name-symbol error-data))))
 277     img))
 278
 279 ;; the functions we need for retrieval and display
 280 ;;;###autoload
 281 (defun newsticker-show-news ()
 282   "Start reading news.  You may want to bind this to a key."
 283   (interactive)
 284   (newsticker-start t) ;; will start only if not running
 285   ;; Load the html rendering packages
 286   (if newsticker-html-renderer
 287       (cond ((eq newsticker-html-renderer 'w3m-region)
 288              (require 'w3m))
 289             ((eq newsticker-html-renderer 'w3-region)
 290              (require 'w3-auto))
 291             ((eq newsticker-html-renderer 'newsticker-htmlr-render)
 292              (require 'htmlr))))
 293   (funcall newsticker-frontend))
 294
 295 ;; ======================================================================
 296 ;;; Toolbar
 297 ;; ======================================================================
 298
 299 (defun newsticker-browse-url-item (feed item)
 300   "Convert FEED ITEM to html and call `browse-url' on result."
 301   (interactive)
 302   (let ((t-file (make-temp-file "newsticker")))
 303     (with-temp-file t-file
 304       (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>
 305                <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
 306                \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
 307                <html xmlns=\"http://www.w3.org/1999/xhtml\">
 308                <body>")
 309       (insert "<h1>" feed ": " (newsticker--title item) "</h1>")
 310       (insert (format-time-string newsticker-date-format
 311                                   (newsticker--time item)))
 312       (insert "<br/>")
 313       (insert (or (newsticker--desc item) "[No Description]"))
 314       (when (newsticker--enclosure item)
 315         (insert "<br/><hr/><i>")
 316         (newsticker--insert-enclosure item nil)
 317         (insert "</i>"))
 318       (when (newsticker--extra item)
 319         (insert "<br/><hr/><tt>")
 320         (newsticker--print-extra-elements item nil)
 321         (insert "</tt>"))
 322       (insert "</body></html>"))
 323     (browse-url t-file)))
 324
 325 (provide 'newst-reader)
 326
 327 ;;; newst-reader.el ends here