;;; newsticker.el --- A Newsticker for Emacs. ;; ;; Copyright (C) 2003 by Ulf Jasper ;; ;; This file is NOT part of GNU Emacs. ;; ;; Author: Ulf Jasper ;; Filename: newsticker.el ;; Created: 17. June 2003 ;; Keywords: News ;; Time-stamp: "26. Juli 2003, 14:42:29 (ulf)" ;; CVS-Version: $Id: newsticker.el,v 1.1 2003/08/24 09:12:29 u11 Exp $ (defconst newsticker-version 0.99 "Version number of newsticker.el.") ;; ====================================================================== ;; ;; This program 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 2 of the ;; License, or (at your option) any later version. ;; ;; This program 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 this program; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 ;; USA ;; ;; ====================================================================== ;;; Commentary: ;; ;; This package provides a newsticker. A newsticker is a thing that ;; asynchronously retrieves a list of headlines (which are contained in ;; RDF Site Summary (RSS) files) from a list of news sites, displays ;; these headlines, and allows for loading the corresponding articles ;; in a web browser. ;; ;; This package should work with all RSS files that follow the "RDF ;; Rich Site Summary (RSS) 1.0" specification (see ;; http://purl.org/rss/1.0/spec). ;; It may also work with other/older/alternative rss formats (like ;; 0.9 or such). ;; ;; This package requires wget for retrieving headlines asynchronously. ;; ;; Headlines can be displayed in the echo area, but they will show only ;; if no other program is using the echo area (and minibuffer). ;; Besides, headlines and their descriptions are collected in a buffer ;; called *newsticker*. ;; ;; ====================================================================== ;;; Usage: ;; ;; Add the following line to your Emacs startup file (`~/.emacs'): ;; (require 'newsticker) ;; or ;; (autoload 'newsticker-start "newsticker" "Emacs Newsticker" t) ;; ;; Then say M-x `newsticker-start'. This will retrieve headlines from ;; each url in `newsticker-url-list' every ;; `newsticker-retrieval-interval' seconds. All headlines are placed ;; in the buffer `*newsticker*'. Clicking mouse-button 2 or pressing ;; RET in that buffer on a headline will call `browse-url' to load the ;; corresponding news story in your favourite web browser. ;; ;; Every `newsticker-display-interval' a headline is shown in the ;; echo area (if `newsticker-display-interval' is positive). ;; ;; In order to stop the newsticker say M-x `newsticker-stop'. This ;; will stop all timers. ;; ;; The function `newsticker-show-news' will update the *newsticker* ;; buffer, if necessary, and recreate it if you accidentally deleted ;; it. The modeline will indicate whether the *newsticker* buffer is ;; up to date with the newsticker-cache. ;; ;; Newsticker-mode extends `outline-mode' so that you can easily hide ;; and show descriptions of feeds and news items. ;; ;; Newsticker-mode supports imenu. It allows for navigating with the ;; help of a menu. In order to use this feature you should add the ;; following to you .emacs file: ;; ;; (add-hook 'newsticker-mode-hook 'imenu-add-menubar-index) ;; ;; All newsticker-options are customizable. Say M-x customize-group RET ;; newsticker RET in order to customize the newsticker settings. ;; ;; Enjoy! ;; ;; PS: This newsticker is designed do its job silently in the ;; background without disturbing you. However, it is probably ;; impossible to prevent such a tool from slightly attenuating your ;; Editor's responsiveness every once in a while. ;; ;; Byte-compiling newsticker.el is recommended. ;; ;; ;; ====================================================================== ;;; History: ;; ;; 0.99 Minor tweaks. ;; Tested with Emacs 21.3.2 ;; ;; 0.98 Check exit status of wget processes. Keep cache data if ;; something went wrong. Throw error when old wget-processes are ;; hanging around. ;; Introduced newsticker-specific faces. ;; Added `newsticker-show-descriptions-of-new-items'. ;; Added `newsticker-hide-old-items-in-newsticker-buffer'. ;; Added `newsticker-(hide|show)-old-items'. ;; ;; 0.97 Minor tweaks. ;; ;; 0.96 Added caching. ;; newsticker-mode inherits outline-mode. ;; newsticker-mode supports imenu. ;; Easy buffer-navigation with newsticker-mode's keymap. ;; Some bugs fixed. ;; Thanks to Moritz Epple for documentation tips. ;; ;; 0.95 Added newsticker-mode -- Thanks to T.V. Raman. ;; Catch xml-parser errors -- Thanks to T.V. Raman. ;; Remove stupid newlines in titles (headlines) -- Thanks to Jeff ;; Rancier. ;; ;; 0.94 Added clickerability and description for channel headings. ;; Made it work for (at least some) rss 0.9 feeds. ;; ;; 0.93 Added some more sites. ;; Do not flood the *Messages* buffer. ;; First attempt at handling coding systems. ;; ;; 0.92 Added `newsticker-wget-name'. ;; Try to display message only if minibuffer and echo area are not ;; in use already. ;; Dirty workaround for newer versions of xml.el: Remove whitespace ;; in rdf. ;; Tested with Emacs 21.3.2 and CVS-snapshot of 2003-06-21. ;; ;; 0.91 First bugfix: *newsticker* is read-only. ;; ;; 0.9 First release. ;; Tested with Emacs 21.3.2 and wget 1.8.2. ;; ;; ====================================================================== ;;; To Do: ;; ;; * Make it faster! ;; * Keep news items in original order. ;; * Scramble news items for the ticker? ;; * There are news feeds which send HTML-ized titles and descriptions...?! ;; ;; ====================================================================== ;;; Code: (require 'derived) (require 'outline) (require 'xml) ;; ====================================================================== ;;; Customizables (defgroup newsticker nil "Newsticker settings. Some of these changes do not have an immediate effect. Therefore it is recommended to `newsticker-stop' and then `newsticker-start' again after you have changed any of these settings.") (defcustom newsticker-url-list '(("heise" "http://www.heise.de/newsticker/heise.rdf") ("qotd" "http://www.quotationspage.com/data/qotd.rss") ("slashdot" "http://slashdot.org/slashdot.rdf") ("tagesschau" "http://www.tagesschau.de/newsticker.rdf") ("telepolis" "http://www.heise.de/tp/news.rdf") ("wiki" "http://www.emacswiki.org/cgi-bin/wiki.pl?action=rss")) "The news feeds which you like to watch. This is a list of alists. Each alist consists of a label and a url. The label gives the name of the news feed and the url the location of the newsfeed. The url must point to a valid rss file. It is retrieved by calling wget, or whatever you specify as `newsticker-wget-name'. Any changes you make here, will take effect at next regular news-retrieval." :type '(alist :key-type (string :tag "Label") :value-type (group (string :tag "URL"))) :group 'newsticker) (defcustom newsticker-scroll-smoothly t "Decides wether to flash or scroll news items. If t the news headlines are scrolled (more-or-less) smoothly in the echo area. If nil one headline after another is displayed in the echo area. The variable `newsticker-display-interval' determines how fast this display moves/changes and whether headlines are shown in the echo area at all. If you change `newsticker-scroll-smoothly' you should also change `newsticker-display-interval'." :type 'boolean :group 'newsticker) (defcustom newsticker-display-interval 0.3 "Time interval for displaying news items (seconds). If equal or less than 0 no messages are shown in the echo area. For smooth display (see `newsticker-scroll-smoothly') a value of 0.3 seems reasonable. For non-smooth display a value of 10 is a good starting point. You have to re-start the newsticker in order to make a new value effective." :type 'number :group 'newsticker) (defcustom newsticker-retrieval-interval 3600 "Time interval for retrieving new news items (seconds). Slashdot will ban you if you make it less than 1800 seconds (30 minutes)! You have to re-start the newsticker in order to make a new value effective." :type 'integer :group 'newsticker) (defcustom newsticker-wget-name "wget" "Name of the program which is called to retrieve news from the web. The canonical choice is wget but you may take any other program which is able to return the contents of a news feed file on stdout." :type 'string :group 'newsticker) (defcustom newsticker-wget-arguments '("-q" "-O" "-") "Arguments which are passed to wget. There is probably no reason to change the default settings, unless you are living behind a firewall." :type '(repeat (string :tag "Argument")) :group 'newsticker) (defcustom newsticker-automatically-mark-items-as-old t "Decides whether to automatically mark items as old. If t a new item is considered as new only after its first retrieval. As soon as it is retrieved a second time, it becomes old. If not t all items stay new until you mark them as old. This is done in the *newsticker* buffer." :type 'boolean :group 'newsticker) (defcustom newsticker-hide-old-items-in-echo-area t "Decides whether to show only the newest news items in the ticker. If t the echo area will show only new items, i.e. only items which have been added between the last two retrievals." :type 'boolean :group 'newsticker) (defcustom newsticker-hide-old-items-in-newsticker-buffer nil "Decides whether to automatically hide old items in the *newsticker* buffer. If set to t old items will be completely folded and only new items will show up in the *newsticker* buffer. Otherwise old as well as new items will be visible." :type 'boolean :group 'newsticker) (defcustom newsticker-show-descriptions-of-new-items t "Decides whether to automatically show descriptions of new items in the *newsticker* buffer. If set to t old items will be folded and new items will be unfolded. Otherwise old as well as new items will be folded." :type 'boolean :group 'newsticker) (defcustom newsticker-cache-filename "~/.newsticker-cache" "Name of the newsticker cache file." :type 'string :group 'newsticker) (defface newsticker-feed-face '((((class color) (background dark)) (:family "helvetica" :height 160 :bold t :italic nil :foreground "misty rose")) (((class color) (background light)) (:family "helvetica" :height 160 :bold t :italic nil :foreground "black"))) "Face for news feeds." :group 'newsticker) (defface newsticker-new-item-face '((((class color) (background dark)) (:inherit default :bold t :foreground "orange")) (((class color) (background light)) (:inherit default :bold t :foreground "blue"))) "Face for old news items." :group 'newsticker) (defface newsticker-old-item-face '((((class color) (background dark)) (:inherit default :bold t)) (((class color) (background light)) (:inherit default :bold t))) "Face for old news items." :group 'newsticker) (defface newsticker-default-face '((((class color) (background dark)) (:inherit default)) (((class color) (background light)) (:inherit default))) "Face for the description of news items." :group 'newsticker) ;; ====================================================================== ;;; Internal stuff ;; ====================================================================== ;;; some variables we need later (defvar newsticker--display-timer nil "Timer for newsticker display.") (defvar newsticker--retrieval-timer nil "Timer for newsticker news retrieval.") (defvar newsticker--item-list nil "List of newsticker items.") (defvar newsticker--item-position 0 "Actual position in list of newsticker items.") (defvar newsticker--prev-message "There was no previous message yet!" "Last message that the newsticker displayed.") (defvar newsticker--scrollable-text "" "The text which is scrolled smoothly in the echo area.") (defvar newsticker--buffer-uptodate-p nil "Tells whether the newsticker buffer is up to date.") (defvar newsticker--last-update-time (current-time) "Time when the newsticker retrieved data.") (defvar newsticker--cache nil "Cached newsticker data. This is a list of the form ((label1 (item-title item-description item-link item-time item-marker) ...) (label2 (item-title item-description item-link item-time item-marker) ...) ...) where label is a symbol. title, description, and link are strings. Time is a time value as returned by `current-time'. Marker is a symbol: 'new, 'old, and 'obsolete denote ordinary news items, whereas 'feed denotes an item which is not a headline but describes the feed itself.") ;;(makunbound 'newsticker--font-lock-keywords) (defvar newsticker--font-lock-keywords '(("^\\* \\(.*\\)$" 1 'newsticker-feed-face) ("^\\*\\* \\(.*\\) ([^)]+)$" 1 'newsticker-new-item-face) ("^\\*\\*\\* \\(.*\\) ([^)]+)$" 1 'newsticker-old-item-face) ("^ \\(.*\\)$" 1 'newsticker-default-face))) ;; set up the newsticker-mode (define-derived-mode newsticker-mode outline-mode "NewsTicker" "Viewing RSS news feeds in Emacs." (set (make-local-variable 'imenu-sort-function) nil) (setq imenu-create-index-function 'newsticker--imenu-create-index) (setq buffer-read-only t) (setq newsticker--buffer-uptodate-p nil) (auto-fill-mode -1) ;; Turn auto-fill off! (set (make-local-variable 'font-lock-defaults) '(newsticker--font-lock-keywords t nil nil )) ;; we want the default outline-regexp (set (make-local-variable 'outline-regexp) "[*\f]+") (setq mode-name "Newsticker -- NEED UPDATE -- ")) ;; refine its mode-map (define-key newsticker-mode-map "\n" 'newsticker-browse-url) (define-key newsticker-mode-map "\C-m" 'newsticker-browse-url) (define-key newsticker-mode-map "sO" 'newsticker-show-old-items) (define-key newsticker-mode-map "hO" 'newsticker-hide-old-items) (define-key newsticker-mode-map "sa" 'newsticker-show-all-desc) (define-key newsticker-mode-map "ha" 'newsticker-hide-all-desc) (define-key newsticker-mode-map "sf" 'newsticker-show-feed-desc) (define-key newsticker-mode-map "hf" 'newsticker-hide-feed-desc) (define-key newsticker-mode-map "so" 'newsticker-show-old-item-desc) (define-key newsticker-mode-map "ho" 'newsticker-hide-old-item-desc) (define-key newsticker-mode-map "sn" 'newsticker-show-new-item-desc) (define-key newsticker-mode-map "hn" 'newsticker-hide-new-item-desc) (define-key newsticker-mode-map "se" 'show-entry) (define-key newsticker-mode-map "he" 'hide-entry) (define-key newsticker-mode-map " " 'scroll-up) (define-key newsticker-mode-map "q" 'bury-buffer) (define-key newsticker-mode-map "p" 'newsticker-previous-item) (define-key newsticker-mode-map "\t" 'newsticker-next-item) (define-key newsticker-mode-map "n" 'newsticker-next-item) (define-key newsticker-mode-map "m" 'newsticker-mark-all-items-as-read) (define-key newsticker-mode-map "P" 'newsticker-previous-new-item) (define-key newsticker-mode-map "N" 'newsticker-next-new-item) (define-key newsticker-mode-map "g" 'newsticker-get-all-news) (define-key newsticker-mode-map "u" 'newsticker-buffer-update) ;; map for the clickable portions (defvar newsticker-click-map (make-sparse-keymap) "Keymap for clickable portions of the newsticker buffer.") (define-key newsticker-click-map [mouse-2] 'newsticker-mouse-browse-url) ;; ====================================================================== ;;; User fun ;; ====================================================================== (defun newsticker-start () "Start the newsticker. Start the timers for display and retrieval." (interactive) (if newsticker--retrieval-timer (message "Ooops! Another newsticker is running!") ;; read old cache if it exists (let ((b (find-file-noselect newsticker-cache-filename))) (when b (set-buffer b) (goto-char (point-min)) (condition-case nil (setq newsticker--cache (read b)) (error (setq newsticker--cache nil))) (kill-buffer b))) ;; get news (newsticker-get-all-news) ;; start timers (if (> newsticker-display-interval 0) (setq newsticker--display-timer (run-at-time newsticker-display-interval newsticker-display-interval 'newsticker--display-tick))) (setq newsticker--retrieval-timer (run-at-time newsticker-retrieval-interval newsticker-retrieval-interval 'newsticker--retrieval-tick)) (message "Newsticker started!"))) (defun newsticker-stop () "Stop the newsticker. Cancel the timers for display and retrieval." (interactive) (when newsticker--display-timer (cancel-timer newsticker--display-timer) (setq newsticker--display-timer nil)) (when newsticker--retrieval-timer (cancel-timer newsticker--retrieval-timer) (setq newsticker--retrieval-timer nil) (message "Newsticker stopped!"))) ;; the functions we need for retrieval and display (defun newsticker-show-news () "Switch to newsticker buffer. You may want to bind this to a key." (interactive) (newsticker-buffer-update) (switch-to-buffer "*newsticker*") (if newsticker--buffer-uptodate-p (setq mode-name "Newsticker -- up to date -- ") (setq mode-name "Newsticker -- NEED UPDATE -- "))) (defun newsticker-buffer-update () "Update the newsticker buffer, if necessary." (interactive) (save-current-buffer (let ((b (get-buffer "*newsticker*"))) (if b (set-buffer b) (set-buffer (get-buffer-create "*newsticker*")) (setq newsticker--buffer-uptodate-p nil))) (unless newsticker--buffer-uptodate-p (message "Preparing newsticker buffer...") (let ((inhibit-read-only t)) (set-buffer-modified-p nil) (erase-buffer) (newsticker-mode) (newsticker--buffer-insert-all-items) (set-buffer-modified-p nil) (newsticker-hide-all-desc) (if newsticker-hide-old-items-in-newsticker-buffer (newsticker-hide-old-items)) (if newsticker-show-descriptions-of-new-items (newsticker-show-new-item-desc))) (message "")) (setq newsticker--buffer-uptodate-p t) (setq mode-name "Newsticker -- up to date -- "))) (defun newsticker-get-all-news () "Launch retrieval of news from all configured newsticker sites." (interactive) ;; reset global vars and the newsticker buffer (setq newsticker--item-list nil) (setq newsticker--item-position 0) (setq newsticker--last-update-time (current-time)) (setq newsticker--scrollable-text "") ;; launch retrieval of news (mapcar 'newsticker--get-news newsticker-url-list)) ;; ====================================================================== ;;; keymap stuff ;; ====================================================================== (defun newsticker-next-new-item () "Go to next new news item." (interactive) (unless (newsticker--buffer-goto-mark 'new) (message "No more new items!"))) (defun newsticker-previous-new-item () "Go to previous new news item." (interactive) (unless (newsticker--buffer-goto-mark 'new t) (message "No more new items!"))) (defun newsticker-next-item () "Go to next news item or feed." (interactive) (while (and (re-search-forward "^\\*\\*+ +" nil t) (newsticker--text-at-pos-is-invisible)))) (defun newsticker-previous-item () "Go to previous news item or feed." (interactive) (beginning-of-line) (while (and (re-search-backward "^\\*\\*+ +" nil t) (newsticker--text-at-pos-is-invisible))) (goto-char (match-end 0))) (defun newsticker-mark-all-items-as-read () "Mark all items as read and clear ticker contents." (interactive) (newsticker--cache-replace-mark newsticker--cache 'any 'new 'old) (setq newsticker--buffer-uptodate-p nil) (setq newsticker--item-list nil) (setq newsticker--scrollable-text "") (newsticker--cache-save) (newsticker-buffer-update)) (defun newsticker-hide-old-item-desc () "Hide the description of old items." (interactive) (newsticker--buffer-hideshow-mark 'old nil)) (defun newsticker-show-old-item-desc () "Show the description of old items." (interactive) (newsticker--buffer-hideshow-mark 'old t)) (defun newsticker-hide-new-item-desc () "Hide the description of new items." (interactive) (newsticker--buffer-hideshow-mark 'new nil)) (defun newsticker-show-new-item-desc () "Show the description of new items." (interactive) (newsticker--buffer-hideshow-mark 'new t)) (defun newsticker-hide-feed-desc () "Hide the description of feeds." (interactive) (newsticker--buffer-hideshow-mark 'feed nil)) (defun newsticker-show-feed-desc () "Show the description of old items." (interactive) (newsticker--buffer-hideshow-mark 'feed t)) (defun newsticker-hide-all-desc () "Hide the descriptions of feeds and all items." (interactive) (newsticker--buffer-hideshow-mark 'feed nil) (newsticker--buffer-hideshow-mark 'new nil) (newsticker--buffer-hideshow-mark 'old nil)) (defun newsticker-show-all-desc () "Show the descriptions of feeds and all items." (interactive) (newsticker--buffer-hideshow-mark 'feed t) (newsticker--buffer-hideshow-mark 'new t) (newsticker--buffer-hideshow-mark 'old t)) (defun newsticker-hide-old-items () "Hide old items." (interactive) (hide-sublevels 2)) (defun newsticker-show-old-items () "Show old items." (interactive) (hide-sublevels 3)) ;; ====================================================================== ;;; helper ;; ====================================================================== (defun newsticker--text-at-pos-is-invisible () "Return t if the text at point has an overlay with property 'invisible." (let ((invisible nil)) (mapcar (lambda (o) (if (overlay-get o 'invisible) (setq invisible t))) (overlays-in (point) (point))) invisible)) ;; ====================================================================== ;;; local stuff ;; ====================================================================== (defun newsticker--get-news (name-and-url) "Get news from a news site. Argument NAME-AND-URL must be a list of the form (name . url)." (let ((buffername (concat "*wget-newsticker-" (car name-and-url) "*"))) (save-current-buffer (set-buffer (get-buffer-create buffername)) (erase-buffer) (let ((proc-name (car name-and-url))) ;; kill other wget procs if they are still there (if (get-process proc-name) ;;(kill-process proc-name) (error "Another wget-process is running for %s" proc-name)) (let* ((args (append newsticker-wget-arguments (list (cadr name-and-url)))) (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--sentinel)))))) (defun newsticker-mouse-browse-url (event) "Call `browse-url' for the link of the item at which the EVENT occured." (interactive "e") (save-current-buffer (set-buffer (window-buffer (posn-window (event-end event)))) (let ((url (get-text-property (posn-point (event-end event)) 'link))) (when url (browse-url url))))) (defun newsticker-browse-url () "Call `browse-url' for the link of the item at point." (interactive) (let ((url (get-text-property (point) 'link))) (when url (browse-url url)))) (defun newsticker--sentinel (process event) "Sentinel for extracting news titles from an RDF buffer. 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))) (if (not (and (eq p-status 'exit) (= exit-status 0))) (message "%s: error while retrieving news from %s" (format-time-string "%A, %H:%M" (current-time)) (process-name process)) (let* ((coding-system nil) (node-list (save-current-buffer (set-buffer (process-buffer process)) ;; a very very dirty workaround to overcome the ;; problems with the newest (20030621) xml.el: ;; remove all unnecessary whitespace (goto-char (point-min)) (while (re-search-forward ">\\s-+<" nil t) (replace-match "><" nil t)) (goto-char (point-min)) (if (re-search-forward "encoding=\"\\([^\"]+\\)\"" nil t) (setq coding-system (intern (downcase(match-string 1))))) (condition-case nil ;; The xml parser might fail ;; or the xml might be bugged (xml-parse-region (point-min) (point-max)) (error nil)))) (topnode (car node-list)) (channelnode (car (xml-get-children topnode 'channel))) (name (process-name process)) (name-symbol (intern name)) (pos 0)) ;; mark all items as obsolete (setq newsticker--cache (newsticker--cache-replace-mark newsticker--cache name-symbol 'new 'obsolete-new)) (setq newsticker--cache (newsticker--cache-replace-mark newsticker--cache name-symbol 'old 'obsolete-old)) ;; gather the news (if (eq (xml-node-name topnode) 'rss) ;; this is rss 0.91 or something similar ;; all items are inside the channel node (setq topnode channelnode)) (let ((title (or (car (xml-node-children (car (xml-get-children channelnode 'title)))) "[untitled]")) (link (or (car (xml-node-children (car (xml-get-children channelnode 'link)))) "")) (desc (or (car (xml-node-children (car (xml-get-children channelnode 'description)))) "[No description available]")) (pos 0) (old-item nil)) ;; handle the feed itself (setq newsticker--cache (newsticker--cache-add newsticker--cache name-symbol title desc link newsticker--last-update-time 'feed 'feed)) ;; gather all items (mapcar (lambda (node) (when (eq (xml-node-name node) 'item) (setq title (or (car (xml-node-children (car (xml-get-children node 'title)))) "[untitled]")) (setq link (or (car (xml-node-children (car (xml-get-children node 'link)))) "")) (setq desc (car (xml-node-children (car (xml-get-children node 'description))))) ;; It happened that the title or description ;; contained evil html code that confused the ;; xml parser. Therefore: (unless (stringp title) (setq title (prin1-to-string title))) (unless (or (stringp desc) (not desc)) (setq title (prin1-to-string desc))) ;; apply coding system (when coding-system (setq title (decode-coding-string title coding-system t)) (if desc (setq desc (decode-coding-string desc coding-system t))) (setq link (decode-coding-string link coding-system t))) ;; remove stupid superfluous silly newlines from title (setq title (replace-regexp-in-string "\n" " " title)) ;; add data to cache ;; do we have this item already? (setq old-item (newsticker--cache-contains newsticker--cache name-symbol title)) ;; add this item, or mark it as old, or do nothing (let ((mark1 'new) (mark2 'old)) (if old-item (let ((prev-mark (nth 4 old-item))) (unless newsticker-automatically-mark-items-as-old (if (eq prev-mark 'obsolete-old) (setq mark2 'old) (setq mark2 'new))))) (setq newsticker--cache (newsticker--cache-add newsticker--cache name-symbol title desc link newsticker--last-update-time mark1 mark2))) ;; build the scroll text and flash list (unless (and newsticker-hide-old-items-in-echo-area old-item) ;; build flash list (add-to-list 'newsticker--item-list (concat name ": " title) t) ;; and build the scrollable text (setq newsticker--scrollable-text (concat newsticker--scrollable-text " " name ": " title " +++"))))) (xml-get-children topnode 'item))) ;; remove old items from cache (newsticker--cache-replace-mark newsticker--cache name-symbol 'obsolete-old 'obsolete) (newsticker--cache-replace-mark newsticker--cache name-symbol 'obsolete-new 'obsolete) ;; bring cache data into proper order.... (setq newsticker--cache (newsticker--cache-remove newsticker--cache name-symbol 'obsolete)) (newsticker--cache-sort)) (newsticker--cache-save) (setq newsticker--buffer-uptodate-p nil) (save-current-buffer (when (get-buffer "*newsticker*") (set-buffer "*newsticker*") (setq mode-name "Newsticker -- NEED UPDATE -- ")))))) (defun newsticker--display-tick () "Called from the display timer. This function calls a display function, according to the variable `newsticker-scroll-smoothly'." (if newsticker-scroll-smoothly (newsticker--display-scroll) (newsticker--display-jump))) (defsubst newsticker--echo-area-clean-p () "Check whether somebody is using the echo area / minibuffer. Return t if echo area and minibuffer are unused." (not (or (active-minibuffer-window) (and (current-message) (not (string= (current-message) newsticker--prev-message)))))) (defun newsticker--display-jump () "Called from the display timer. This function displays the next ticker item in the echo area, unless there is another message displayed or the minibuffer is active." (let ((message-log-max nil));; prevents message text from being logged (when (newsticker--echo-area-clean-p) (setq newsticker--item-position (1+ newsticker--item-position)) (when (>= newsticker--item-position (length newsticker--item-list)) (setq newsticker--item-position 0)) (setq newsticker--prev-message (nth newsticker--item-position newsticker--item-list)) (message newsticker--prev-message)))) (defun newsticker--display-scroll () "Called from the display timer. This function scrolls the ticker items in the echo area, unless there is another message displayed or the minibuffer is active." (when (newsticker--echo-area-clean-p) (let* ((width (- (frame-width) 1)) (message-log-max nil);; prevents message text from being logged (i newsticker--item-position) subtext (s-text newsticker--scrollable-text) (l (length s-text))) ;; don't show anything if there is nothing to show (unless (< (length s-text) 1) (setq s-text (concat "+++ " (format-time-string "%A, %H:%M" newsticker--last-update-time) " ++++++" s-text)) (while (< (length s-text) width) (setq s-text (concat s-text s-text))) (setq l (length s-text)) (cond ((< i (- l width)) (setq subtext (substring s-text i (+ i width)))) (t (setq subtext (concat (substring s-text i l) (substring s-text 0 (- width (- l i))))))) (message subtext) (setq newsticker--prev-message subtext) (setq newsticker--item-position (1+ i)) (when (>= newsticker--item-position l) (setq newsticker--item-position 0)))))) (defun newsticker--retrieval-tick () "Called from the retrieval timer. This function retrieves new news." (newsticker-get-all-news)) ;; ====================================================================== ;;; imenu stuff ;; ====================================================================== (defun newsticker--imenu-create-index () "Scan newsticker buffer and return an index for imenu." ;;(interactive) (save-excursion (goto-char (point-min)) (let ((index-alist nil)) (while (re-search-forward "^\\* \\(.*\\)" nil t) (let ((result (list (match-string-no-properties 1))) (max (save-excursion (re-search-forward "^* " nil t)))) (while (re-search-forward "\\*\\*+ \\(.*\\) ([^)]+)" max t) (add-to-list 'result (cons (match-string-no-properties 1) (match-beginning 0)) t)) (add-to-list 'index-alist result t))) index-alist))) ;; ====================================================================== ;;; buffer stuff ;; ====================================================================== (defun newsticker--buffer-insert-all-items () "Insert all cached newsticker items into the current buffer." (goto-char (point-min)) (mapcar (lambda (feed) (let ((items (cdr feed)) (marker nil) (old-item-line-printed nil)) ;; insert the feed description (mapcar (lambda (item) (when (eq (nth 4 item) 'feed) (newsticker--buffer-insert-item "* " item t))) items) ;;insert the new items (mapcar (lambda (item) (if (eq (nth 4 item) 'new) (newsticker--buffer-insert-item "** " item))) items) ;;insert the old items (mapcar (lambda (item) (unless (or (eq (nth 4 item) 'feed) (eq (nth 4 item) 'new) (eq (nth 4 item) 'obsolete-old) (eq (nth 4 item) 'obsolete-new)) ;;(unless old-item-line-printed ;;(insert "** Old items:\n") ;;(setq old-item-line-printed t)) (newsticker--buffer-insert-item "*** " item))) items) (insert "\n"))) newsticker--cache) (insert "\n\n* Last update: " (format-time-string "%A, %H:%M" newsticker--last-update-time) "\n") (goto-char (point-min))) (defun newsticker--buffer-insert-item (prefix item &optional is-feed) "Insert a news item in the current buffer. Insert the string PREFIX and a formatted representation of the ITEM. The optional parameter IS-FEED determines how the item is formatted and whether the item-retrieval time is added as well." (let ((pos (point)) (map newsticker-click-map) (mark (nth 4 item))) (insert prefix) (setq pos (point)) (insert (car item)) (set-left-margin pos (point) 3) (add-text-properties pos (point) '(mouse-face highlight)) (add-text-properties pos (point) (list 'link (nth 2 item))) (add-text-properties pos (point) (list 'help-echo (nth 2 item))) (add-text-properties pos (point) (list 'keymap map)) (add-text-properties pos (point) (list 'mark mark)) (unless is-feed (insert " (" (format-time-string "%A, %H:%M" (nth 3 item)) ")")) ;;(fill-region pos (point) 'left nil t) ;; insert the description (insert "\n") (setq pos (point)) (let ((desc (nth 1 item))) (when desc (insert desc) (set-left-margin pos (point) 4) (insert "\n") (fill-region pos (point) 'left nil t) (add-text-properties pos (point) '(face newsticker-description-face)))))) (defun newsticker--buffer-goto-mark (mark &optional backwards) "Search next occurence of MARK in current buffer. If MARK is found point is moved, if not point is left unchanged. If optional parameter BACKWARDS is t, search backwards." (interactive) (let ((pos (save-excursion (catch 'found (let (next-pos) (while (setq next-pos (if backwards (previous-single-property-change (point) 'mark) (next-single-property-change (point) 'mark))) (goto-char next-pos) (if (eq (get-text-property (point) 'mark) mark) (throw 'found (point))))))))) (if pos (goto-char pos)))) (defun newsticker--buffer-hideshow-mark (hide-mark onoff) "Hide or show items with mark HIDE-MARK. If ONOFF is nil the item is hidden, otherwise it is shown." (interactive) (save-excursion (goto-char (point-min)) (while (newsticker--buffer-goto-mark hide-mark) (if onoff (show-entry) (hide-entry))))) ;; ====================================================================== ;;; manipulation of cached data ;; ====================================================================== (defun newsticker--cache-replace-mark (data feed old-mark new-mark) "Mark all items in DATA in FEED which carry mark OLD-MARK with NEW-MARK. If FEED is 'any it applies to all feeds. If OLD-MARK is 'any, all marks are replaced by new-mark." (mapcar (lambda (a-feed) (when (or (eq feed 'any) (eq (car a-feed) feed)) (let ((items (cdr a-feed))) (mapcar (lambda (item) (if (or (eq old-mark 'any) (eq (nth 4 item) old-mark)) (setcar (cddddr item) new-mark))) items)))) data) data) (defun newsticker--cache-contains (data feed-symbol title) "Check DATA whether the feed FEED-SYMBOL contains an item with TITLE. Return the item" (condition-case nil (catch 'found (mapcar (lambda (this-feed-symbol) (when (eq (car this-feed-symbol) feed-symbol) (mapcar (lambda (anitem) (when (string= (car anitem) title) (throw 'found anitem))) (cdr this-feed-symbol)))) data) nil) (error nil))) (defun newsticker--cache-add (data feed title desc link time &optional mark old-mark) "Add another item to cache data. Add to DATA in the FEED an item with TITLE, DESC, LINK, and TIME and an optional MARK. If this item is contained already, its mark is set to OLD-MARK. Returns the mark which the item got." (let ((item (newsticker--cache-contains data feed title))) (if item ;; does exist already -- change mark (progn ;;(message "%s became %s" title old-mark) (setcar (cddddr item) old-mark)) ;; did not exist (catch 'found (mapcar (lambda (this-feed) (when (eq (car this-feed) feed) ;;(setcdr afeed (cons (list title desc link time mark) ;; (cdr afeed))) ;;(message title) (setcdr this-feed (nconc (cdr this-feed) (list (list title desc link time mark)))) (throw 'found this-feed))) data) ;; the feed is not contained (add-to-list 'data (list feed (list title desc link time mark)) t)))) data) (defun newsticker--cache-remove (data feed-symbol mark) "Remove all entries from DATA in the feed FEED-SYMBOL with MARK. FEED-SYMBOL may be 'any." ;; does not really remove but creates a new list and copies only the ;; requested items (let ((newdata nil)) (mapcar (lambda (this-feed) (let ((name (car this-feed))) ;;(message name) (mapcar (lambda (anitem) (unless (and (or (eq feed-symbol 'any) (eq feed-symbol name)) (eq mark (nth 4 anitem))) (setq newdata (newsticker--cache-add newdata name (nth 0 anitem);title (nth 1 anitem);desc (nth 2 anitem);link (nth 3 anitem);time (nth 4 anitem);mark (nth 4 anitem);mark )))) (cdr this-feed)))) data) newdata)) (defun newsticker--cache-item-compare (item1 item2) "Compare two news items ITEM1 and ITEM2 by comparing their time values." (let* ((time1 (nth 3 item1)) (time2 (nth 3 item2)) (result (cond ((< (nth 0 time1) (nth 0 time2)) nil) ((> (nth 0 time1) (nth 0 time2)) t) ((< (nth 1 time1) (nth 1 time2)) nil) ((> (nth 1 time1) (nth 1 time2)) t) ((< (nth 2 time1) (nth 2 time2)) nil) ((> (nth 2 time1) (nth 2 time2)) t) (t nil)))) result)) (defun newsticker--cache-sort () "Sort the newsticker cache data." (mapcar (lambda (feed-list) (setcdr feed-list (sort (cdr feed-list) 'newsticker--cache-item-compare))) newsticker--cache)) (defun newsticker--cache-save () "Save cache data." ;; FIXME: prevent from printing "Wrote ..." message?! (write-region (prin1-to-string newsticker--cache) nil newsticker-cache-filename) ;; clear echo area from write-region's output (message "")) (provide 'newsticker) ;;; newsticker.el ends here