emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] trunk r118157: Newsticker: Show feedicons in treeview. Sma


From: Ulf Jasper
Subject: [Emacs-diffs] trunk r118157: Newsticker: Show feedicons in treeview. Small fix in opml export.
Date: Sun, 19 Oct 2014 16:50:22 +0000
User-agent: Bazaar (2.6b2)

------------------------------------------------------------
revno: 118157
revision-id: address@hidden
parent: address@hidden
committer: Ulf Jasper <address@hidden>
branch nick: trunk
timestamp: Sun 2014-10-19 18:50:15 +0200
message:
  Newsticker: Show feedicons in treeview.  Small fix in opml export.
  
  * etc/images/newsticker/README: Add rss-feed.png, rss-feed.svg.
  
  * etc/images/newsticker/rss-feed.png: New.
  
  * etc/images/newsticker/rss-feed.svg: New.
  
  * lisp/net/newst-backend.el: Require url-parse.
  (newsticker--get-news-by-wget): Store feed name as process property.
  (newsticker--sentinel): Read feed name from process property.
  (newsticker--sentinel-work): Rename argument name to feed-name.
  Rename variable imageurl to image-url.  Pick icon url from Atom
  1.0 data.  Launch download of feed icon.
  (newsticker--get-icon-url-atom-1.0): New.
  (newsticker--unxml)
  (newsticker--unxml-node)
  (newsticker--unxml-attribute): Documentation.
  (newsticker--icons-dir): New.
  (newsticker--image-get): New arguments FILENAME and DIRECTORY.
  Use `url-retrieve' if `newsticker-retrieval-method' is 'intern.
  (newsticker--image-download-by-wget): New.  Use process properties
  for storing informations.
  (newsticker--image-sentinel): Read informations from process properties.
  (newsticker--image-save)
  (newsticker--image-remove)
  (newsticker--image-download-by-url)
  (newsticker--image-download-by-url-callback): New.
  (newsticker-opml-export): Handle url list entries containing a
  function instead of an url string.
  
  * lisp/net/newst-reader.el (newsticker-html-renderer): Whitespace.
  (newsticker--print-extra-elements)
  (newsticker--do-print-extra-element): Documentation
  (newsticker--image-read): Optionally limit image height.  Use
  imagemagick if possible.
  (newsticker--icon-read): New.
  
  * lisp/net/newst-treeview.el (newsticker--treeview-item-show): Limit height 
of feed logo.
  (newsticker--treeview-tree-expand): Use feed icons in treeview.
  (newsticker--tree-widget-icon-create): New.  Set the tree widget icon.
  (newsticker--tree-widget-leaf-icon): Use feed icon.
added:
  etc/images/newsticker/rss-feed.png 
rssfeed.png-20141019143613-hwe8p805ix0fkbkc-1
  etc/images/newsticker/rss-feed.svg 
rssfeed.svg-20141019143615-uqog85wubj428fal-1
modified:
  etc/ChangeLog                  changelog-20091113204419-o5vbwnq5f7feedwu-1485
  etc/images/newsticker/README   readme-20110514183902-s99tdr0uebkmju0j-1
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/net/newst-backend.el      
newstbackend.el-20091113204419-o5vbwnq5f7feedwu-8682
  lisp/net/newst-reader.el       
newstreader.el-20091113204419-o5vbwnq5f7feedwu-8684
  lisp/net/newst-treeview.el     
newsttreeview.el-20091113204419-o5vbwnq5f7feedwu-8686
=== modified file 'etc/ChangeLog'
--- a/etc/ChangeLog     2014-10-18 00:22:13 +0000
+++ b/etc/ChangeLog     2014-10-19 16:50:15 +0000
@@ -1,3 +1,11 @@
+2014-10-19  Ulf Jasper  <address@hidden>
+
+       * images/newsticker/rss-feed.png: New.
+
+       * images/newsticker/rss-feed.svg: New.
+
+       * images/newsticker/README: Add rss-feed.png, rss-feed.svg.
+
 2014-10-18  Michal Nazarewicz  <address@hidden>
 
        * NEWS: Mention new whitespace-mode option: big-indent.

=== modified file 'etc/images/newsticker/README'
--- a/etc/images/newsticker/README      2014-01-01 07:43:34 +0000
+++ b/etc/images/newsticker/README      2014-10-19 16:50:15 +0000
@@ -2,7 +2,7 @@
 
 Files: browse-url.xpm get-all.xpm mark-immortal.xpm mark-read.xpm
        narrow.xpm next-feed.xpm next-item.xpm prev-feed.xpm
-       prev-item.xpm update.xpm
+       prev-item.xpm rss-feed.png rss-feed.svg update.xpm
 Author: Ulf Jasper
 Copyright (C) 2011-2014 Free Software Foundation, Inc.
 License: GNU General Public License version 3 or later (see COPYING)

=== added file 'etc/images/newsticker/rss-feed.png'
Binary files a/etc/images/newsticker/rss-feed.png       1970-01-01 00:00:00 
+0000 and b/etc/images/newsticker/rss-feed.png      2014-10-19 16:50:15 +0000 
differ
=== added file 'etc/images/newsticker/rss-feed.svg'
--- a/etc/images/newsticker/rss-feed.svg        1970-01-01 00:00:00 +0000
+++ b/etc/images/newsticker/rss-feed.svg        2014-10-19 16:50:15 +0000
@@ -0,0 +1,121 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<!-- Created with Inkscape (http://www.inkscape.org/) -->
+
+<svg
+   xmlns:dc="http://purl.org/dc/elements/1.1/";
+   xmlns:cc="http://creativecommons.org/ns#";
+   xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#";
+   xmlns:svg="http://www.w3.org/2000/svg";
+   xmlns="http://www.w3.org/2000/svg";
+   xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd";
+   xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape";
+   width="16px"
+   height="16px"
+   id="svg3028"
+   version="1.1"
+   inkscape:version="0.48.5 r10040"
+   sodipodi:docname="newst-rss.svg">
+  <defs
+     id="defs3030" />
+  <sodipodi:namedview
+     id="base"
+     pagecolor="#ffffff"
+     bordercolor="#666666"
+     borderopacity="1.0"
+     inkscape:pageopacity="0.0"
+     inkscape:pageshadow="2"
+     inkscape:zoom="22.197802"
+     inkscape:cx="-0.87475255"
+     inkscape:cy="-1.0099011"
+     inkscape:current-layer="layer1"
+     showgrid="true"
+     inkscape:grid-bbox="true"
+     inkscape:document-units="px"
+     inkscape:snap-global="true"
+     inkscape:snap-object-midpoints="false"
+     inkscape:window-width="1680"
+     inkscape:window-height="1026"
+     inkscape:window-x="0"
+     inkscape:window-y="24"
+     inkscape:window-maximized="0">
+    <inkscape:grid
+       type="xygrid"
+       id="grid3036" />
+  </sodipodi:namedview>
+  <metadata
+     id="metadata3033">
+    <rdf:RDF>
+      <cc:Work
+         rdf:about="">
+        <dc:format>image/svg+xml</dc:format>
+        <dc:type
+           rdf:resource="http://purl.org/dc/dcmitype/StillImage"; />
+      </cc:Work>
+    </rdf:RDF>
+  </metadata>
+  <g
+     id="layer1"
+     inkscape:label="Layer 1"
+     inkscape:groupmode="layer">
+    <rect
+       
style="fill:#ff8000;fill-opacity:1;stroke:#0000ff;stroke-width:0;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+       id="rect3038"
+       width="16"
+       height="16"
+       x="0"
+       y="0"
+       ry="2"
+       rx="2" />
+    <path
+       sodipodi:type="arc"
+       
style="fill:#ffffff;fill-opacity:1;stroke:#ffffff;stroke-width:0;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+       id="path3814"
+       sodipodi:cx="-4.5"
+       sodipodi:cy="7.5"
+       sodipodi:rx="2"
+       sodipodi:ry="2"
+       d="m -2.5,7.5 a 2,2 0 1 1 -4,0 2,2 0 1 1 4,0 z"
+       transform="matrix(0,1,-1,0,11.5,16.5)" />
+    <path
+       sodipodi:type="arc"
+       
style="fill:none;stroke:#ffffff;stroke-width:1.89999996;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+       id="path3847"
+       sodipodi:cx="8.5"
+       sodipodi:cy="7.5"
+       sodipodi:rx="9.5"
+       sodipodi:ry="9.5"
+       d="m 18,7.5 a 9.5,9.5 0 1 1 -19,0 9.5,9.5 0 1 1 19,0 z"
+       transform="matrix(1.0526316,0,0,1.0526316,-8.9473684,8.1052632)" />
+    <path
+       sodipodi:type="arc"
+       
style="fill:none;stroke:#ffffff;stroke-width:0.96362412;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+       id="path3849"
+       sodipodi:cx="2"
+       sodipodi:cy="14.5"
+       sodipodi:rx="7"
+       sodipodi:ry="6.5"
+       d="m 9,14.5 a 7,6.5 0 1 1 -14,0 7,6.5 0 1 1 14,0 z"
+       transform="matrix(2,0,0,2.1538461,-3.9999999,-15.230768)" />
+    <rect
+       
style="fill:none;fill-opacity:1;stroke:#ff8000;stroke-width:0;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+       id="rect3869"
+       width="15"
+       height="15"
+       x="2"
+       y="-1"
+       rx="0"
+       ry="0" />
+    <path
+       style="fill:#ff8000;fill-opacity:1;stroke:none"
+       d="M 2 0 C 0.892 0 0 0.892 0 2 L 0 14 C 0 15.108 0.892 16 2 16 L 2 0 z "
+       id="rect3891" />
+    <path
+       style="fill:#ff8000;fill-opacity:1;stroke:none"
+       d="M 0 14 C 0 15.108 0.892 16 2 16 L 14 16 C 15.108 16 16 15.108 16 14 
L 0 14 z "
+       id="rect3913" />
+  </g>
+  <g
+     inkscape:groupmode="layer"
+     id="layer2"
+     inkscape:label="Ebene" />
+</svg>

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2014-10-19 02:14:58 +0000
+++ b/lisp/ChangeLog    2014-10-19 16:50:15 +0000
@@ -1,3 +1,40 @@
+2014-10-19  Ulf Jasper  <address@hidden>
+
+       * net/newst-backend.el: Require url-parse.
+       (newsticker--get-news-by-wget): Store feed name as process property.
+       (newsticker--sentinel): Read feed name from process property.
+       (newsticker--sentinel-work): Rename argument name to feed-name.
+       Rename variable imageurl to image-url.  Pick icon url from Atom
+       1.0 data.  Launch download of feed icon.
+       (newsticker--get-icon-url-atom-1.0): New.
+       (newsticker--unxml)
+       (newsticker--unxml-node)
+       (newsticker--unxml-attribute): Documentation.
+       (newsticker--icons-dir): New.
+       (newsticker--image-get): New arguments FILENAME and DIRECTORY.
+       Use `url-retrieve' if `newsticker-retrieval-method' is 'intern.
+       (newsticker--image-download-by-wget): New.  Use process properties
+       for storing informations.
+       (newsticker--image-sentinel): Read informations from process properties.
+       (newsticker--image-save)
+       (newsticker--image-remove)
+       (newsticker--image-download-by-url)
+       (newsticker--image-download-by-url-callback): New.
+       (newsticker-opml-export): Handle url list entries containing a
+       function instead of an url string.
+
+       * net/newst-reader.el (newsticker-html-renderer): Whitespace.
+       (newsticker--print-extra-elements)
+       (newsticker--do-print-extra-element): Documentation
+       (newsticker--image-read): Optionally limit image height.  Use
+       imagemagick if possible.
+       (newsticker--icon-read): New.
+
+       * net/newst-treeview.el (newsticker--treeview-item-show): Limit height 
of feed logo.
+       (newsticker--treeview-tree-expand): Use feed icons in treeview.
+       (newsticker--tree-widget-icon-create): New.  Set the tree widget icon.
+       (newsticker--tree-widget-leaf-icon): Use feed icon.
+
 2014-10-19  Stefan Monnier  <address@hidden>
 
        * emacs-lisp/eieio-opt.el (eieio-lambda-arglist): Remove.

=== modified file 'lisp/net/newst-backend.el'
--- a/lisp/net/newst-backend.el 2014-10-01 17:20:00 +0000
+++ b/lisp/net/newst-backend.el 2014-10-19 16:50:15 +0000
@@ -36,6 +36,7 @@
 
 (require 'derived)
 (require 'xml)
+(require 'url-parse)
 
 ;; Silence warnings
 (defvar w3-mode-map)
@@ -776,6 +777,7 @@
                           newsticker-wget-name args)))
         (set-process-coding-system proc 'no-conversion 'no-conversion)
         (set-process-sentinel proc 'newsticker--sentinel)
+        (process-put proc 'nt-feed-name feed-name)
         (setq newsticker--process-ids (cons (process-id proc)
                                             newsticker--process-ids))
         (force-mode-line-update)))))
@@ -811,24 +813,24 @@
 Argument EVENT tells what has happened to the process."
   (let ((p-status (process-status process))
         (exit-status (process-exit-status process))
-        (name (process-name process))
+        (feed-name (process-get  process 'nt-feed-name))
         (command (process-command process))
         (buffer (process-buffer process)))
     (newsticker--sentinel-work event
                                (and (eq p-status 'exit)
                                     (= exit-status 0))
-                               name command buffer)))
+                               feed-name command buffer)))
 
-(defun newsticker--sentinel-work (event status-ok name command buffer)
+(defun newsticker--sentinel-work (event status-ok feed-name command buffer)
   "Actually do the sentinel work.
 Argument EVENT tells what has happened to the retrieval process.
 Argument STATUS-OK is the final status of the retrieval process,
 non-nil meaning retrieval was successful.
-Argument NAME is the name of the retrieval process.
+Argument FEED-NAME is the name of the retrieved feed.
 Argument COMMAND is the command of the retrieval process.
 Argument BUFFER is the buffer of the retrieval process."
   (let ((time (current-time))
-        (name-symbol (intern name))
+        (name-symbol (intern feed-name))
         (something-was-added nil))
     ;; catch known errors (zombie processes, rubbish-xml etc.
     ;; if an error occurs the news feed is not updated!
@@ -844,14 +846,14 @@
                         "Return status: `%s'\n"
                         "Command was `%s'")
                 (format-time-string "%A, %H:%M" (current-time))
-                name event command)
+                feed-name event command)
                ""
                (current-time)
                'new
                0 nil))
         (message "%s: Error while retrieving news from %s"
                  (format-time-string "%A, %H:%M" (current-time))
-                 name)
+                 feed-name)
         (throw 'oops nil))
       (let* ((coding-system 'utf-8)
              (node-list
@@ -870,7 +872,7 @@
                           (coding-system-error
                            (message
                             "newsticker.el: ignoring coding system %s for %s"
-                            coding-system name)
+                            coding-system feed-name)
                            nil))))
                 ;; Decode if possible
                 (when coding-system
@@ -886,7 +888,8 @@
                                   (buffer-name) (cadr errordata))
                          (throw 'oops nil)))))
              (topnode (car node-list))
-             (imageurl nil))
+             (image-url nil)
+             (icon-url nil))
         ;; mark all items as obsolete
         (newsticker--cache-replace-age newsticker--cache
                                        name-symbol
@@ -904,29 +907,29 @@
                  ;; RSS 0.91
                  ((and (eq 'rss (xml-node-name topnode))
                        (string= "0.91" (xml-get-attribute topnode 'version)))
-                  (setq imageurl (newsticker--get-logo-url-rss-0.91 topnode))
-                  (newsticker--parse-rss-0.91 name time topnode))
+                  (setq image-url (newsticker--get-logo-url-rss-0.91 topnode))
+                  (newsticker--parse-rss-0.91 feed-name time topnode))
                  ;; RSS 0.92
                  ((and (eq 'rss (xml-node-name topnode))
                        (string= "0.92" (xml-get-attribute topnode 'version)))
-                  (setq imageurl (newsticker--get-logo-url-rss-0.92 topnode))
-                  (newsticker--parse-rss-0.92 name time topnode))
+                  (setq image-url (newsticker--get-logo-url-rss-0.92 topnode))
+                  (newsticker--parse-rss-0.92 feed-name time topnode))
                  ;; RSS 1.0
                  ((or (eq 'RDF (xml-node-name topnode))
                       (eq 'rdf:RDF (xml-node-name topnode)))
-                  (setq imageurl (newsticker--get-logo-url-rss-1.0 topnode))
-                  (newsticker--parse-rss-1.0 name time topnode))
+                  (setq image-url (newsticker--get-logo-url-rss-1.0 topnode))
+                  (newsticker--parse-rss-1.0 feed-name time topnode))
                  ;; RSS 2.0
                  ((and (eq 'rss (xml-node-name topnode))
                        (string= "2.0" (xml-get-attribute topnode 'version)))
-                  (setq imageurl (newsticker--get-logo-url-rss-2.0 topnode))
-                  (newsticker--parse-rss-2.0 name time topnode))
+                  (setq image-url (newsticker--get-logo-url-rss-2.0 topnode))
+                  (newsticker--parse-rss-2.0 feed-name time topnode))
                  ;; Atom 0.3
                  ((and (eq 'feed (xml-node-name topnode))
                        (string= "http://purl.org/atom/ns#";
                                 (xml-get-attribute topnode 'xmlns)))
-                  (setq imageurl (newsticker--get-logo-url-atom-0.3 topnode))
-                  (newsticker--parse-atom-0.3 name time topnode))
+                  (setq image-url (newsticker--get-logo-url-atom-0.3 topnode))
+                  (newsticker--parse-atom-0.3 feed-name time topnode))
                  ;; Atom 1.0
                  (t
                   ;; The test for Atom 1.0 does not work when using
@@ -938,16 +941,17 @@
                   ;; (and (eq 'feed (xml-node-name topnode))
                   ;;      (string= "http://www.w3.org/2005/Atom";
                   ;;               (xml-get-attribute topnode 'xmlns)))
-                  (setq imageurl (newsticker--get-logo-url-atom-1.0 topnode))
-                  (newsticker--parse-atom-1.0 name time topnode))
+                  (setq image-url (newsticker--get-logo-url-atom-1.0 topnode))
+                  (setq icon-url (newsticker--get-icon-url-atom-1.0 topnode))
+                  (newsticker--parse-atom-1.0 feed-name time topnode))
                  ;; unknown feed type
                  ;; (t
                  ;;  (newsticker--debug-msg "Feed type unknown: %s: %s"
-                 ;;                         (xml-node-name topnode) name)
+                 ;;                         (xml-node-name topnode) feed-name)
                  ;;  nil)
                  )
                 (setq something-was-added t))
-          (error (message "sentinelerror in %s: %s" name error-data)))
+          (error (message "sentinelerror in %s: %s" feed-name error-data)))
 
         ;; Remove those old items from cache which have been removed from
         ;; the feed
@@ -988,10 +992,29 @@
         ;; kill the process buffer if wanted
         (unless newsticker-debug
           (kill-buffer buffer))
-        ;; launch retrieval of image
-        (when (and imageurl (boundp 'newsticker-download-logos)
+        ;; launch retrieval of images
+        (when (and (boundp 'newsticker-download-logos)
                    newsticker-download-logos)
-          (newsticker--image-get name imageurl)))))
+          ;; feed logo
+          (when image-url
+            (newsticker--image-get feed-name feed-name (newsticker--images-dir)
+                                   image-url))
+          ;; icon / favicon
+          (setq icon-url
+                (or icon-url
+                    (let* ((feed-url (newsticker--link (cadr 
(newsticker--cache-get-feed
+                                                              (intern 
feed-name)))))
+                           (uri (url-generic-parse-url feed-url)))
+                      (when (and feed-url uri)
+                        (setf (url-filename uri) nil)
+                        (setf (url-target uri) nil)
+                        (concat (url-recreate-url uri) "favicon.ico")))))
+          (when icon-url
+            (newsticker--image-get feed-name
+                                   (concat feed-name "."
+                                           (file-name-extension icon-url))
+                                   (newsticker--icons-dir)
+                                   icon-url))))))
   (when newsticker--sentinel-callback
     (funcall newsticker--sentinel-callback)))
 
@@ -1055,6 +1078,11 @@
   (car (xml-node-children
         (car (xml-get-children node 'logo)))))
 
+(defun newsticker--get-icon-url-atom-1.0 (node)
+  "Return icon URL from atom 1.0 data in NODE."
+  (car (xml-node-children
+        (car (xml-get-children node 'icon)))))
+
 (defun newsticker--get-logo-url-atom-0.3 (node)
   "Return logo URL from atom 0.3 data in NODE."
   (car (xml-node-children
@@ -1133,13 +1161,13 @@
 
 (defun newsticker--unxml (node)
   "Reverse parsing of an xml string.
-Restore an xml-string from a an xml-node that was returned by xml-parse..."
+Restore an xml-string from a an xml NODE that was returned by xml-parse..."
   (if (or (not node) (stringp node))
       node
     (newsticker--unxml-node node)))
 
 (defun newsticker--unxml-node (node)
-  "Actually restore xml-string of an xml node."
+  "Actually restore xml-string of an xml NODE."
   (let ((qname (symbol-name (car node)))
         (att-list (cadr node))
         (children (cddr node)))
@@ -1149,10 +1177,10 @@
             ">"
             (mapconcat 'newsticker--unxml children "") "</" qname ">")))
 
-(defun newsticker--unxml-attribute (att)
-  "Actually restore xml-string of an attribute of an xml node."
-  (let ((name (symbol-name (car att)))
-        (value (cdr att)))
+(defun newsticker--unxml-attribute (attribute)
+  "Actually restore xml-string of an ATTRIBUTE of an xml node."
+  (let ((name (symbol-name (car attribute)))
+        (value (cdr attribute)))
     (concat name "=\"" value "\"")))
 
 (defun newsticker--parse-atom-1.0 (name time topnode)
@@ -1766,14 +1794,19 @@
   "Return directory where feed images are saved."
   (concat newsticker-dir "/images/"))
 
-(defun newsticker--image-get (feed-name url)
-  "Get image of the news site FEED-NAME from URL.
-If the image has been downloaded in the last 24h do nothing."
-  (let ((image-name (concat (newsticker--images-dir) feed-name)))
+(defun newsticker--icons-dir ()
+  "Return directory where feed icons are saved."
+  (concat newsticker-dir "/icons/"))
+
+(defun newsticker--image-get (feed-name filename directory url)
+  "Get image for FEED-NAME by returning FILENAME from DIRECTORY.
+If the file does no exist or if it is older than 24 hours
+download it from URL first."
+  (let ((image-name (concat directory feed-name)))
     (if (and (file-exists-p image-name)
              (time-less-p (current-time)
                           (time-add (nth 5 (file-attributes image-name))
-                                    (seconds-to-time 86400))))
+                                     (seconds-to-time 86400))))
         (newsticker--debug-msg "%s: Getting image for %s skipped"
                                (format-time-string "%A, %H:%M" (current-time))
                                feed-name)
@@ -1781,14 +1814,22 @@
       (newsticker--debug-msg "%s: Getting image for %s"
                              (format-time-string "%A, %H:%M" (current-time))
                              feed-name)
-      (let* ((buffername (concat " *newsticker-wget-image-" feed-name "*"))
-             (item (or (assoc feed-name newsticker-url-list)
+      (if (eq newsticker-retrieval-method 'intern)
+          (newsticker--image-download-by-url feed-name filename directory url)
+        (newsticker--image-download-by-wget feed-name filename directory 
url)))))
+
+(defun newsticker--image-download-by-wget (feed-name filename directory url)
+  "Download image for FEED-NAME using external program.
+Save image as FILENAME in DIRECTORY, download it from URL."
+  (let* ((proc-name (concat feed-name "-" filename))
+         (buffername (concat " *newsticker-wget-image-" proc-name "*"))
+         (item (or (assoc feed-name newsticker-url-list)
                        (assoc feed-name newsticker-url-list-defaults)
                        (error
                         "Cannot get image for %s: Check newsticker-url-list"
                         feed-name)))
-             (wget-arguments (or (car (cdr (cdr (cdr (cdr item)))))
-                                 newsticker-wget-arguments)))
+         (wget-arguments (or (car (cdr (cdr (cdr (cdr item)))))
+                             newsticker-wget-arguments)))
         (with-current-buffer (get-buffer-create buffername)
           (erase-buffer)
           ;; throw an error if there is an old wget-process around
@@ -1797,16 +1838,21 @@
                      feed-name))
           ;; start wget
           (let* ((args (append wget-arguments (list url)))
-                 (proc (apply 'start-process feed-name buffername
+                 (proc (apply 'start-process proc-name buffername
                               newsticker-wget-name args)))
             (set-process-coding-system proc 'no-conversion 'no-conversion)
-            (set-process-sentinel proc 'newsticker--image-sentinel)))))))
+            (set-process-sentinel proc 'newsticker--image-sentinel)
+            (process-put proc 'nt-directory directory)
+            (process-put proc 'nt-feed-name feed-name)
+            (process-put proc 'nt-filename filename)))))
 
 (defun newsticker--image-sentinel (process event)
   "Sentinel for image-retrieving PROCESS caused by EVENT."
   (let* ((p-status (process-status process))
          (exit-status (process-exit-status process))
-         (feed-name (process-name process)))
+         (feed-name (process-get process 'nt-feed-name))
+         (directory (process-get process 'nt-directory))
+         (filename (process-get process 'nt-filename)))
     ;; catch known errors (zombie processes, rubbish-xml, etc.)
     ;; if an error occurs the news feed is not updated!
     (catch 'oops
@@ -1815,21 +1861,67 @@
         (message "%s: Error while retrieving image from %s"
                  (format-time-string "%A, %H:%M" (current-time))
                  feed-name)
+        (newsticker--image-remove directory feed-name)
         (throw 'oops nil))
-      (let (image-name)
-        (with-current-buffer (process-buffer process)
-          (setq image-name (concat (newsticker--images-dir) feed-name))
-          (set-buffer-file-coding-system 'no-conversion)
-          ;; make sure the cache dir exists
-          (unless (file-directory-p (newsticker--images-dir))
-            (make-directory (newsticker--images-dir)))
-          ;; write and close buffer
-          (let ((require-final-newline nil)
-                (backup-inhibited t)
-                (coding-system-for-write 'no-conversion))
-            (write-region nil nil image-name nil 'quiet))
-          (set-buffer-modified-p nil)
-          (kill-buffer (current-buffer)))))))
+      (newsticker--image-save (process-buffer process) directory filename))))
+
+(defun newsticker--image-save (buffer directory file-name)
+  "Save contents of BUFFER in DIRECTORY as FILE-NAME.
+Finally kill buffer."
+  (with-current-buffer buffer
+      (let ((image-name (concat directory file-name)))
+        (set-buffer-file-coding-system 'no-conversion)
+        ;; make sure the cache dir exists
+        (unless (file-directory-p directory)
+          (make-directory directory))
+        ;; write and close buffer
+        (let ((require-final-newline nil)
+              (backup-inhibited t)
+              (coding-system-for-write 'no-conversion))
+          (write-region nil nil image-name nil 'quiet))
+        (set-buffer-modified-p nil)
+        (kill-buffer buffer))))
+
+(defun newsticker--image-remove (directory file-name)
+  "In DIRECTORY remove FILE-NAME."
+  (let ((image-name (concat directory file-name)))
+    (when (file-exists-p file-name)
+      (delete-file image-name))))
+
+(defun newsticker--image-download-by-url (feed-name filename directory url)
+  "Download image for FEED-NAME using `url-retrieve'.
+Save image as FILENAME in DIRECTORY, download it from URL."
+  (let ((coding-system-for-read 'no-conversion))
+    (condition-case error-data
+        (url-retrieve url 'newsticker--image-download-by-url-callback
+                      (list feed-name directory filename))
+          (error (message "Error retrieving image from %s: %s" feed-name
+                          error-data))))
+  (force-mode-line-update))
+
+(defun newsticker--image-download-by-url-callback (status feed-name directory 
filename)
+  "Callback function for `newsticker--image-download-by-url'.
+STATUS is the return status as delivered by `url-retrieve'.
+FEED-NAME is the name of the feed that the news were retrieved
+from.
+The image is saved in DIRECTORY as FILENAME."
+  (when status
+    (let ((status-type (car status))
+          (status-details (cdr status)))
+      (cond ((eq status-type :error)
+             (newsticker--image-remove directory feed-name))
+            (t
+             (let ((buf (get-buffer-create (concat " *newsticker-url-image-" 
feed-name "-" directory "*")))
+                   (result (string-to-multibyte (buffer-string))))
+               (set-buffer buf)
+               (erase-buffer)
+               (insert result)
+               ;; remove MIME header
+               (goto-char (point-min))
+               (search-forward "\n\n")
+               (delete-region (point-min) (point))
+               ;; save
+               (newsticker--image-save buf directory filename)))))))
 
 (defun newsticker--insert-image (img string)
   "Insert IMG with STRING at point."
@@ -2244,6 +2336,7 @@
 (defun newsticker-opml-export ()
   "OPML subscription export.
 Export subscriptions to a buffer in OPML Format."
+  ;; FIXME: use newsticker-groups
   (interactive)
   (with-current-buffer (get-buffer-create "*OPML Export*")
     (set-buffer-file-coding-system 'utf-8)
@@ -2263,7 +2356,8 @@
             (insert "    <outline text=\"")
             (insert (newsticker--title sub))
             (insert "\" xmlUrl=\"")
-            (insert (cadr sub))
+            (insert (xml-escape-string (let ((url (cadr sub)))
+                                      (if (stringp url) url (prin1-to-string 
url)))))
             (insert "\"/>\n"))
           (append newsticker-url-list newsticker-url-list-defaults))
     (insert "  </body>\n</opml>\n"))

=== modified file 'lisp/net/newst-reader.el'
--- a/lisp/net/newst-reader.el  2014-10-01 17:20:00 +0000
+++ b/lisp/net/newst-reader.el  2014-10-19 16:50:15 +0000
@@ -110,7 +110,7 @@
       #'shr-render-region)
   "Function for rendering HTML contents.
 If non-nil, newsticker.el will call this function whenever it
-finds HTML-like tags in item descriptions.  
+finds HTML-like tags in item descriptions.
 Possible functions include `shr-render-region', `w3m-region', `w3-region', and
 `newsticker-htmlr-render'.
 Newsticker automatically loads the respective package w3m, w3, or
@@ -193,7 +193,8 @@
 
 (defun newsticker--print-extra-elements (item keymap &optional htmlish)
   "Insert extra-elements of ITEM in a pretty form into the current buffer.
-KEYMAP is applied."
+KEYMAP is applied.  If HTMLISH is non-nil then HTML-markup is used
+for formatting."
   (let ((ignored-elements '(items link title description content
                                   content:encoded encoded
                                   dc:subject subject
@@ -223,7 +224,8 @@
 
 (defun newsticker--do-print-extra-element (extra-element width keymap htmlish)
   "Actually print an EXTRA-ELEMENT using the given WIDTH.
-KEYMAP is applied."
+KEYMAP is applied.  If HTMLISH is non-nil then HTML-markup is used
+for formatting."
   (let ((name (symbol-name (car extra-element))))
     (if htmlish
         (insert (format "<li>%s: " name))
@@ -253,10 +255,11 @@
         (insert "</li>")
       (insert "\n"))))
 
-(defun newsticker--image-read (feed-name-symbol disabled)
+(defun newsticker--image-read (feed-name-symbol disabled &optional max-height)
   "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\).
+Optional argument MAX-HEIGHT specifies the maximal image height.
 Return the image."
   (let ((image-name (concat (newsticker--images-dir)
                             (symbol-name feed-name-symbol)))
@@ -264,18 +267,47 @@
     (when (file-exists-p image-name)
       (condition-case error-data
           (setq img (create-image
-                     image-name nil nil
+                     image-name
+                     (and (fboundp 'imagemagick-types)
+                          (imagemagick-types)
+                          'imagemagick)
+                     nil
                      :conversion (and newsticker-enable-logo-manipulations
                                       disabled
                                       'disabled)
                      :mask (and newsticker-enable-logo-manipulations
                                 'heuristic)
-                     :ascent 70))
+                     :ascent 100
+                     :max-height max-height))
         (error
          (message "Error: cannot create image for %s: %s"
                   feed-name-symbol error-data))))
     img))
 
+(defun newsticker--icon-read (feed-name-symbol)
+  "Read the cached icon for FEED-NAME-SYMBOL from disk.
+Return the image."
+  (catch 'icon
+    (when (file-exists-p (newsticker--icons-dir))
+      (mapc (lambda (file)
+              (condition-case error-data
+                  (progn (setq img (create-image
+                                    file (and (fboundp 'imagemagick-types)
+                                              (imagemagick-types)
+                                              'imagemagick)
+                                    nil
+                                    :ascent 'center
+                                    :max-width 16
+                                    :max-height 16))
+                         (throw 'icon img))
+                (error
+                 (message "Error: cannot create icon for %s: %s"
+                          feed-name-symbol error-data))))
+            (directory-files (newsticker--icons-dir) t
+                             (concat (symbol-name feed-name-symbol) "\\..*"))))
+    ;; fallback: default icon
+    (find-image '((:type png :file "newsticker/rss-feed.png" :ascent 
center)))))
+
 ;; the functions we need for retrieval and display
 ;;;###autoload
 (defun newsticker-show-news ()

=== modified file 'lisp/net/newst-treeview.el'
--- a/lisp/net/newst-treeview.el        2014-10-01 17:20:00 +0000
+++ b/lisp/net/newst-treeview.el        2014-10-19 16:50:15 +0000
@@ -735,7 +735,7 @@
         (goto-char (point-min))
         ;; insert logo at top
         (let* ((newsticker-enable-logo-manipulations nil)
-               (img (newsticker--image-read feed-name-symbol nil)))
+               (img (newsticker--image-read feed-name-symbol nil 40)))
           (if (and (display-images-p) img)
               (newsticker--insert-image img (car item))
             (insert (newsticker--real-feed-name feed-name-symbol))))
@@ -829,6 +829,7 @@
                       :nt-group ,(cdr g)
                       :nt-feed ,g-name
                       :nt-id ,nt-id
+                      :leaf-icon newsticker--tree-widget-leaf-icon
                       :keep (:nt-feed :num-new :nt-id :open);;  :nt-group
                       :open nil))
                 (let ((tag (newsticker--treeview-tree-get-tag g nil nt-id)))
@@ -841,6 +842,23 @@
                        :open t))))
             group)))
 
+(defun newsticker--tree-widget-icon-create (icon)
+  "Create the ICON widget."
+  (let* ((g (widget-get (widget-get icon :node) :nt-feed))
+         (ico (and g (newsticker--icon-read (intern g)))))
+    (if ico
+        (progn
+          (widget-put icon :tag-glyph ico)
+          (widget-default-create icon)
+          ;; Insert space between the icon and the node widget.
+          (insert-char ?  1)
+          (put-text-property
+           (1- (point)) (point)
+           'display (list 'space :width tree-widget-space-width)))
+      ;; fallback: default icon
+      (widget-put icon :leaf-icon 'tree-widget-leaf-icon)
+      (tree-widget-icon-create icon))))
+
 (defun newsticker--treeview-tree-expand-status (tree &optional changed-widget
                                                      event)
   "Expand the vfeed TREE.
@@ -875,6 +893,7 @@
   "Icon for a tree-widget leaf node."
   :tag        "O"
   :glyph-name "leaf"
+  :create 'newsticker--tree-widget-icon-create
   :button-face 'default)
 
 (defun newsticker--treeview-tree-update ()


reply via email to

[Prev in Thread] Current Thread [Next in Thread]