From 8259e90ecdd4fd4d85d81fa410f676e8c245f3f4 Mon Sep 17 00:00:00 2001 From: Ulf Jasper Date: Sun, 19 Oct 2014 18:50:15 +0200 Subject: [PATCH] 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. --- etc/ChangeLog | 8 ++ etc/images/newsticker/README | 2 +- etc/images/newsticker/rss-feed.png | Bin 0 -> 639 bytes etc/images/newsticker/rss-feed.svg | 121 +++++++++++++++++++++ lisp/ChangeLog | 37 +++++++ lisp/net/newst-backend.el | 212 ++++++++++++++++++++++++++----------- lisp/net/newst-reader.el | 44 ++++++-- lisp/net/newst-treeview.el | 21 +++- 8 files changed, 378 insertions(+), 67 deletions(-) create mode 100644 etc/images/newsticker/rss-feed.png create mode 100644 etc/images/newsticker/rss-feed.svg diff --git a/etc/ChangeLog b/etc/ChangeLog index 5b70ee83c8a..4968084b7ec 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,11 @@ +2014-10-19 Ulf Jasper + + * 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 * NEWS: Mention new whitespace-mode option: big-indent. diff --git a/etc/images/newsticker/README b/etc/images/newsticker/README index 237b7f08e66..31ca46c8aff 100644 --- a/etc/images/newsticker/README +++ b/etc/images/newsticker/README @@ -2,7 +2,7 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES 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) diff --git a/etc/images/newsticker/rss-feed.png b/etc/images/newsticker/rss-feed.png new file mode 100644 index 0000000000000000000000000000000000000000..41a3263390a958ce4cbf907345327f0fb6a0328a GIT binary patch literal 639 zcwPa20)YLAP)A zd*E=+`<`>2_dL&gl{`09f6zmPF-y5(|X7`7b)mlu*T=&OTg=RsSt*E&#C2f#or zBpWV4`vW+gfE{g8ZS)olG=Vt-HJ#9SrHH^0IXE8%t*BT64kxVG0{-LR^TX$1NWGJ; z?COM#hh=ShQo@7U6VTKvQf9}YZ!i4#2KDFQ$W56308xLwI~k+sO>ghO?VT__0`4kk zj!J&C7pCH{d=u1l{oz3#>+0d;D>xMg-*&jy4rW^X$a@kC$=L&;5(I&3uy#LG)4a literal 0 HcwPel00001 diff --git a/etc/images/newsticker/rss-feed.svg b/etc/images/newsticker/rss-feed.svg new file mode 100644 index 00000000000..a4abd6cc19f --- /dev/null +++ b/etc/images/newsticker/rss-feed.svg @@ -0,0 +1,121 @@ + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + + + + diff --git a/lisp/ChangeLog b/lisp/ChangeLog index af4d5e0e055..3f75bbdc355 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,40 @@ +2014-10-19 Ulf Jasper + + * 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 * emacs-lisp/eieio-opt.el (eieio-lambda-arglist): Remove. diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index b7bd3d0933e..4052116074d 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -36,6 +36,7 @@ (require 'derived) (require 'xml) +(require 'url-parse) ;; Silence warnings (defvar w3-mode-map) @@ -776,6 +777,7 @@ See `newsticker-get-news'." 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 PROCESS is the process which has just changed its state. 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 @@ Argument BUFFER is the buffer of the retrieval process." "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 @@ Argument BUFFER is the buffer of the retrieval process." (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 @@ Argument BUFFER is the buffer of the retrieval process." (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 @@ Argument BUFFER is the buffer of the retrieval process." ;; 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 @@ Argument BUFFER is the buffer of the retrieval process." ;; (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 @@ Argument BUFFER is the buffer of the retrieval process." ;; 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 @@ Argument BUFFER is the buffer of the retrieval process." (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 @@ same as in `newsticker--parse-atom-1.0'." (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 @@ Restore an xml-string from a an xml-node that was returned by xml-parse..." ">" (mapconcat 'newsticker--unxml children "") ""))) -(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 @@ Checks list of active processes against list of newsticker processes." "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 @@ If the image has been downloaded in the last 24h do nothing." (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 @@ If the image has been downloaded in the last 24h do nothing." 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 @@ If the image has been downloaded in the last 24h do nothing." (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 @@ If AGE is nil, the total number of items is returned." (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 @@ Export subscriptions to a buffer in OPML Format." (insert " \n")) (append newsticker-url-list newsticker-url-list-defaults)) (insert " \n\n")) diff --git a/lisp/net/newst-reader.el b/lisp/net/newst-reader.el index 8232e4bd9bd..fcf4d19503e 100644 --- a/lisp/net/newst-reader.el +++ b/lisp/net/newst-reader.el @@ -110,7 +110,7 @@ window is used when filling. See also `newsticker-justification'." #'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 @@ KEYMAP will be applied." (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 @@ KEYMAP is applied." (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 "
  • %s: " name)) @@ -253,10 +255,11 @@ KEYMAP is applied." (insert "
    • ") (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 @@ Return the image." (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 () diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el index 097a2a58805..6d0720d074e 100644 --- a/lisp/net/newst-treeview.el +++ b/lisp/net/newst-treeview.el @@ -735,7 +735,7 @@ for the button." (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 @@ Callback function for tree widget that adds nodes for feeds and subgroups." :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 @@ Callback function for tree widget that adds nodes for feeds and subgroups." :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 @@ Optional arguments CHANGED-WIDGET and EVENT are ignored." "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 () -- 2.11.4.GIT