[bpt/emacs.git] / lisp / net / newst-reader.el

;;; newst-reader.el --- Generic RSS reader functions.

;; Copyright (C) 2003-2013 Free Software Foundation, Inc.

;; Author:      Ulf Jasper <ulf.jasper@web.de>
;; Filename:    newst-reader.el
;; URL:         http://www.nongnu.org/newsticker
;; Time-stamp:  "24. September 2011, 15:47:49 (ulf)"
;; Package:     newsticker

;; ======================================================================

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;; ======================================================================
;;; Commentary:

;; See newsticker.el

;; ======================================================================
;;; Code:

(require 'newst-backend)

;; ======================================================================
;;; Customization
;; ======================================================================
(defun newsticker--set-customvar-formatting (symbol value)
  "Set newsticker-variable SYMBOL value to VALUE.
Calls all actions which are necessary in order to make the new
value effective."
  (if (or (not (boundp symbol))
          (equal (symbol-value symbol) value))
      (set symbol value)
    ;; something must have changed
    (set symbol value)
    (when (fboundp 'newsticker--forget-preformatted)
      (newsticker--forget-preformatted))))

;; ======================================================================
;; reader
(defgroup newsticker-reader nil
  "Settings for the feed reader."
  :group 'newsticker)

(defcustom newsticker-frontend
  'newsticker-treeview
  "Newsticker frontend for reading news.
This must be one of the functions `newsticker-plainview' or
`newsticker-treeview'."
  :type '(choice :tag "Frontend"
                 (const :tag "Single buffer (plainview)" newsticker-plainview)
                 (const :tag "Tree view (treeview)" newsticker-treeview))
  :group 'newsticker-reader)

;; image related things
(defcustom newsticker-enable-logo-manipulations
  t
  "If non-nil newsticker manipulates logo images.
This enables the following image properties: heuristic mask for all
logos, and laplace-conversion for images without new items."
  :type 'boolean
  :group 'newsticker-reader)

(defcustom newsticker-justification
  'left
  "How to fill item descriptions.
If non-nil newsticker calls `fill-region' to wrap long lines in
item descriptions.  However, if an item description contains HTML
text and `newsticker-html-renderer' is non-nil, filling is not
done."
  :type '(choice :tag "Justification"
                 (const :tag "No filling" nil)
                 (const :tag "Left"       left)
                 (const :tag "Right"      right)
                 (const :tag "Center"     center)
                 (const :tag "Full"       full))
  :set 'newsticker--set-customvar-formatting
  :group 'newsticker-reader)

(defcustom newsticker-use-full-width
  t
  "Decides whether to use the full window width when filling.
If non-nil newsticker sets `fill-column' so that the whole
window is used when filling.  See also `newsticker-justification'."
  :type 'boolean
  :set 'newsticker--set-customvar-formatting
  :group 'newsticker-reader)

(defcustom newsticker-html-renderer
  nil
  "Function for rendering HTML contents.
If non-nil, newsticker.el will call this function whenever it
finds HTML-like tags in item descriptions.  Possible functions
are `w3m-region', `w3-region', and `newsticker-htmlr-render'.
Newsticker automatically loads the respective package w3m, w3, or
htmlr if this option is set."
  :type '(choice :tag "Function"
                 (const :tag "None" nil)
                 (const :tag "w3" w3-region)
                 (const :tag "w3m" w3m-region)
                 (const :tag "htmlr" newsticker-htmlr-render))
  :set 'newsticker--set-customvar-formatting
  :group 'newsticker-reader)

(defcustom newsticker-date-format
  "(%A, %H:%M)"
  "Format for the date part in item and feed lines.
See `format-time-string' for a list of valid specifiers."
  :type 'string
  :set 'newsticker--set-customvar-formatting
  :group 'newsticker-reader)

(defgroup newsticker-faces nil
  "Settings for the faces of the feed reader."
  :group 'newsticker-reader)

(defface newsticker-feed-face
  '((default :weight bold :height 1.2)
    (((class color) (background dark))  :foreground "white")
    (((class color) (background light)) :foreground "black"))
  "Face for news feeds."
  :group 'newsticker-faces)

(defface newsticker-extra-face
  '((default :slant italic :height 0.8)
    (((class color) (background dark))  :foreground "gray50")
    (((class color) (background light)) :foreground "gray50"))
  "Face for newsticker dates."
  :group 'newsticker-faces)

(defface newsticker-enclosure-face
  '((default :weight bold)
    (((class color) (background dark))  :background "orange")
    (((class color) (background light)) :background "orange"))
  "Face for enclosed elements."
  :group 'newsticker-faces)

;; ======================================================================
;;; Utility functions
;; ======================================================================
(defun newsticker--insert-enclosure (item keymap)
  "Insert enclosure element of a news ITEM into the current buffer.
KEYMAP will be applied."
  (let ((enclosure (newsticker--enclosure item))
        (beg (point)))
    (when enclosure
      (let ((url (cdr (assoc 'url enclosure)))
            (length (string-to-number (or (cdr (assoc 'length enclosure))
                                          "-1")))
            (type (cdr (assoc 'type enclosure))))
        (cond ((> length 1048576)
               (insert (format "Enclosed file (%s, %1.2f MBytes)" type
                               (/ length 1048576))))
              ((> length 1024)
               (insert (format "Enclosed file (%s, %1.2f KBytes)" type
                               (/ length 1024))))
              ((> length 0)
               (insert (format "Enclosed file (%s, %1.2f Bytes)" type
                               length)))
              (t
               (insert (format "Enclosed file (%s, unknown size)" type))))
        (add-text-properties beg (point)
                             (list 'mouse-face 'highlight
                                   'nt-link url
                                   'help-echo (format
                                               "mouse-2: visit (%s)" url)
                                   'keymap keymap
                                   'nt-face 'enclosure
                                   'nt-type 'desc))
        (insert "\n")))))

(defun newsticker--print-extra-elements (item keymap)
  "Insert extra-elements of ITEM in a pretty form into the current buffer.
KEYMAP is applied."
  (let ((ignored-elements '(items link title description content
                                  content:encoded dc:subject
                                  dc:date entry item guid pubDate
                                  published updated
                                  enclosure))
        (left-column-width 1))
    (mapc (lambda (extra-element)
            (when (listp extra-element) ;; take care of broken xml
                                        ;; data, 2007-05-25
              (unless (memq (car extra-element) ignored-elements)
                (setq left-column-width (max left-column-width
                                             (length (symbol-name
                                                      (car extra-element))))))))
          (newsticker--extra item))
    (mapc (lambda (extra-element)
            (when (listp extra-element) ;; take care of broken xml
                                        ;; data, 2007-05-25
              (unless (memq (car extra-element) ignored-elements)
                (newsticker--do-print-extra-element extra-element
                                                    left-column-width
                                                    keymap))))
          (newsticker--extra item))))

(defun newsticker--do-print-extra-element (extra-element width keymap)
  "Actually print an EXTRA-ELEMENT using the given WIDTH.
KEYMAP is applied."
  (let ((name (symbol-name (car extra-element))))
    (insert (format "%s: " name))
    (insert (make-string (- width (length name)) ? )))
  (let (;;(attributes (cadr extra-element)) ;FIXME!!!!
        (contents (cddr extra-element)))
    (cond ((listp contents)
           (mapc (lambda (i)
                   (if (and (stringp i)
                            (string-match "^http://.*" i))
                       (let ((pos (point)))
                         (insert i " ") ; avoid self-reference from the
                                        ; nt-link thing
                         (add-text-properties
                          pos (point)
                          (list 'mouse-face 'highlight
                                'nt-link i
                                'help-echo
                                (format "mouse-2: visit (%s)" i)
                                'keymap keymap)))
                         (insert (format "%s" i))))
                 contents))
          (t
           (insert (format "%s" contents))))
    (insert "\n")))

(defun newsticker--image-read (feed-name-symbol disabled)
  "Read the cached image for FEED-NAME-SYMBOL from disk.
If DISABLED is non-nil the image will be converted to a disabled look
\(unless `newsticker-enable-logo-manipulations' is not t\).
Return the image."
  (let ((image-name (concat (newsticker--images-dir)
                            (symbol-name feed-name-symbol)))
        (img nil))
    (when (file-exists-p image-name)
      (condition-case error-data
          (setq img (create-image
                     image-name nil nil
                     :conversion (and newsticker-enable-logo-manipulations
                                      disabled
                                      'disabled)
                     :mask (and newsticker-enable-logo-manipulations
                                'heuristic)
                     :ascent 70))
        (error
         (message "Error: cannot create image for %s: %s"
                  feed-name-symbol error-data))))
    img))

;; the functions we need for retrieval and display
;;;###autoload
(defun newsticker-show-news ()
  "Start reading news.  You may want to bind this to a key."
  (interactive)
  (newsticker-start t) ;; will start only if not running
  ;; Load the html rendering packages
  (if newsticker-html-renderer
      (cond ((eq newsticker-html-renderer 'w3m-region)
             (require 'w3m))
            ((eq newsticker-html-renderer 'w3-region)
             (require 'w3-auto))
            ((eq newsticker-html-renderer 'newsticker-htmlr-render)
             (require 'htmlr))))
  (funcall newsticker-frontend))

;; ======================================================================
;;; Toolbar
;; ======================================================================

(defun newsticker-browse-url-item (feed item)
  "Convert FEED ITEM to html and call `browse-url' on result."
  (interactive)
  (let ((t-file (make-temp-file "newsticker")))
    (with-temp-file t-file
      (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>
               <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
               \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
               <html xmlns=\"http://www.w3.org/1999/xhtml\">
               <body>")
      (insert "<h1>" feed ": " (newsticker--title item) "</h1>")
      (insert (format-time-string newsticker-date-format
                                  (newsticker--time item)))
      (insert "<br/>")
      (insert (or (newsticker--desc item) "[No Description]"))
      (when (newsticker--enclosure item)
        (insert "<br/><hr/><i>")
        (newsticker--insert-enclosure item nil)
        (insert "</i>"))
      (when (newsticker--extra item)
        (insert "<br/><hr/><tt>")
        (newsticker--print-extra-elements item nil)
        (insert "</tt>"))
      (insert "</body></html>"))
    (browse-url t-file)))

(provide 'newst-reader)

;;; newst-reader.el ends here
Commit	Line	Data
2900b2d8	1	;;; newst-reader.el --- Generic RSS reader functions.
2415d4c6	2
ab422c4d	3	;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
2415d4c6	4
2415d4c6	5	;; Author: Ulf Jasper <ulf.jasper@web.de>
2900b2d8	6	;; Filename: newst-reader.el
2415d4c6	7	;; URL: http://www.nongnu.org/newsticker
2ac2721a	8	;; Time-stamp: "24. September 2011, 15:47:49 (ulf)"
bd78fa1d	9	;; Package: newsticker
2415d4c6 UJ	10
	11	;; ======================================================================
	12
faeb9c70 GM	13	;; This file is part of GNU Emacs.
faeb9c70 GM	14
2415d4c6 UJ	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
8e39154d	36	(require 'newst-backend)
2415d4c6 UJ	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.
2ac2721a UJ	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."
2415d4c6 UJ	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
0d00764a UJ	127	(defgroup newsticker-faces nil
	128	"Settings for the faces of the feed reader."
	129	:group 'newsticker-reader)
	130
	131	(defface newsticker-feed-face
4b56d0fe CY	132	'((default :weight bold :height 1.2)
	133	(((class color) (background dark)) :foreground "white")
	134	(((class color) (background light)) :foreground "black"))
0d00764a UJ	135	"Face for news feeds."
	136	:group 'newsticker-faces)
	137
	138	(defface newsticker-extra-face
4b56d0fe CY	139	'((default :slant italic :height 0.8)
	140	(((class color) (background dark)) :foreground "gray50")
	141	(((class color) (background light)) :foreground "gray50"))
0d00764a UJ	142	"Face for newsticker dates."
	143	:group 'newsticker-faces)
	144
	145	(defface newsticker-enclosure-face
4b56d0fe CY	146	'((default :weight bold)
	147	(((class color) (background dark)) :background "orange")
	148	(((class color) (background light)) :background "orange"))
0d00764a UJ	149	"Face for enclosed elements."
	150	:group 'newsticker-faces)
	151
2415d4c6 UJ	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."
a59c6c51	245	(let ((image-name (concat (newsticker--images-dir)
2415d4c6 UJ	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
2ac2721a UJ	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))))
2415d4c6 UJ	277	(funcall newsticker-frontend))
	278
	279	;; ======================================================================
	280	;;; Toolbar
	281	;; ======================================================================
2415d4c6	282
62c4fff6 UJ	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
8e39154d	309	(provide 'newst-reader)
041fa0d4	310
2900b2d8	311	;;; newst-reader.el ends here