lisp/net/newst-reader.el

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