aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lisp/net/newsticker-backend.el2313
-rw-r--r--lisp/net/newsticker-plainview.el1823
-rw-r--r--lisp/net/newsticker-reader.el1118
-rw-r--r--lisp/net/newsticker-ticker.el291
-rw-r--r--lisp/net/newsticker-treeview.el1982
5 files changed, 7527 insertions, 0 deletions
diff --git a/lisp/net/newsticker-backend.el b/lisp/net/newsticker-backend.el
new file mode 100644
index 00000000000..e2c2c4a285c
--- /dev/null
+++ b/lisp/net/newsticker-backend.el
@@ -0,0 +1,2313 @@
1;;; newsticker-backend.el --- Retrieval backend for newsticker.
2
3;; Copyright (C) 2008 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; Author: Ulf Jasper <ulf.jasper@web.de>
8;; Filename: newsticker-backend.el
9;; URL: http://www.nongnu.org/newsticker
10;; Keywords: News, RSS, Atom
11;; Time-stamp: "8. Juni 2008, 17:18:04 (ulf)"
12;; CVS-Version: $Id: newsticker-backend.el,v 1.16 2008/05/09 17:42:22 u11 Exp $
13
14;; ======================================================================
15
16;; GNU Emacs is free software: you can redistribute it and/or modify
17;; it under the terms of the GNU General Public License as published by
18;; the Free Software Foundation, either version 3 of the License, or
19;; (at your option) any later version.
20
21;; GNU Emacs is distributed in the hope that it will be useful,
22;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24;; GNU General Public License for more details.
25
26;; You should have received a copy of the GNU General Public License
27;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28
29;; ======================================================================
30
31;;; Commentary:
32
33;; See newsticker.el
34
35;; ======================================================================
36;;; Code:
37
38(require 'derived)
39(require 'xml)
40
41;; Silence warnings
42(defvar tool-bar-map)
43(defvar w3-mode-map)
44(defvar w3m-minor-mode-map)
45
46
47(defvar newsticker--retrieval-timer-list nil
48 "List of timers for news retrieval.
49This is an alist, each element consisting of (feed-name . timer).")
50
51(defvar newsticker--download-logos nil
52 "If non-nil download feed logos if available.")
53
54(defvar newsticker--sentinel-callback nil
55 "Function called at end of `newsticker--sentinel'.")
56
57;;;###autoload
58(defun newsticker-running-p ()
59 "Check whether newsticker is running.
60Return t if newsticker is running, nil otherwise. Newsticker is
61considered to be running if the newsticker timer list is not empty."
62 (> (length newsticker--retrieval-timer-list) 0))
63
64;; ======================================================================
65;;; Customization
66;; ======================================================================
67(defgroup newsticker nil
68 "Aggregator for RSS and Atom feeds."
69 :group 'applications)
70
71(defconst newsticker--raw-url-list-defaults
72 '(("CNET News.com"
73 "http://export.cnet.com/export/feeds/news/rss/1,11176,,00.xml")
74 ("Debian Security Advisories"
75 "http://www.debian.org/security/dsa.en.rdf")
76 ("Debian Security Advisories - Long format"
77 "http://www.debian.org/security/dsa-long.en.rdf")
78 ("Emacs Wiki"
79 "http://www.emacswiki.org/cgi-bin/wiki.pl?action=rss"
80 nil
81 3600)
82 ("Freshmeat.net"
83 "http://freshmeat.net/backend/fm.rdf")
84 ("Kuro5hin.org"
85 "http://www.kuro5hin.org/backend.rdf")
86 ("LWN (Linux Weekly News)"
87 "http://lwn.net/headlines/rss")
88 ("NewsForge"
89 "http://newsforge.com/index.rss")
90 ("NY Times: Technology"
91 "http://partners.userland.com/nytRss/technology.xml")
92 ("NY Times"
93 "http://partners.userland.com/nytRss/nytHomepage.xml")
94 ("Quote of the day"
95 "http://www.quotationspage.com/data/qotd.rss"
96 "07:00"
97 86400)
98 ("The Register"
99 "http://www.theregister.co.uk/tonys/slashdot.rdf")
100 ("slashdot"
101 "http://slashdot.org/index.rss"
102 nil
103 3600) ;/. will ban you if under 3600 seconds!
104 ("Wired News"
105 "http://www.wired.com/news_drop/netcenter/netcenter.rdf")
106 ("Heise News (german)"
107 "http://www.heise.de/newsticker/heise.rdf")
108 ("Tagesschau (german)"
109 "http://www.tagesschau.de/newsticker.rdf"
110 nil
111 1800)
112 ("Telepolis (german)"
113 "http://www.heise.de/tp/news.rdf"))
114 "Default URL list in raw form.
115This list is fed into defcustom via `newsticker--splicer'.")
116
117(defun newsticker--splicer (item)
118 "Convert ITEM for splicing into `newsticker-url-list-defaults'."
119 (let ((result (list 'list :tag (nth 0 item) (list 'const (nth 0 item))))
120 (element (cdr item)))
121 (while element
122 (setq result (append result (list (list 'const (car element)))))
123 (setq element (cdr element)))
124 result))
125
126(defun newsticker--set-customvar-retrieval (symbol value)
127 "Set retrieval related newsticker-variable SYMBOL value to VALUE.
128Calls all actions which are necessary in order to make the new
129value effective."
130 (if (or (not (boundp symbol))
131 (equal (symbol-value symbol) value))
132 (set symbol value)
133 ;; something must have changed
134 (let ((need-restart nil)
135 (new-or-changed-feeds nil)
136 (removed-feeds))
137 (cond ((eq symbol 'newsticker-retrieval-interval)
138 (setq need-restart t))
139 ((memq symbol '(newsticker-url-list-defaults newsticker-url-list))
140 (dolist (elt value)
141 (unless (member elt (symbol-value symbol))
142 (setq new-or-changed-feeds (cons elt new-or-changed-feeds))))
143 (dolist (elt (symbol-value symbol))
144 (unless (member elt value)
145 (setq removed-feeds (cons elt removed-feeds))))))
146 (cond (need-restart
147 (set symbol value)
148 (when (newsticker-running-p)
149 (message "Restarting newsticker")
150 (newsticker-stop)
151 (newsticker-start)))
152 (t
153 (dolist (feed removed-feeds)
154 (message "Stopping feed `%s'" (car feed))
155 (newsticker--stop-feed (car feed)))
156 (dolist (feed new-or-changed-feeds)
157 (message "Starting feed `%s'" (car feed))
158 (newsticker--stop-feed (car feed))
159 (newsticker--start-feed feed))
160 (unless new-or-changed-feeds
161 (when newsticker--sentinel-callback
162 (funcall newsticker--sentinel-callback)))))
163 (set symbol value))))
164
165;; ======================================================================
166;; retrieval
167(defgroup newsticker-retrieval nil
168 "Settings for news retrieval."
169 :group 'newsticker)
170
171(defcustom newsticker-url-list-defaults
172 '(("Emacs Wiki"
173 "http://www.emacswiki.org/cgi-bin/wiki.pl?action=rss"
174 nil
175 3600))
176 "A customizable list of news feeds to select from.
177These were mostly extracted from the Radio Community Server at
178http://subhonker6.userland.com/rcsPublic/rssHotlist.
179
180You may add other entries in `newsticker-url-list'."
181 :type `(set ,@(mapcar `newsticker--splicer
182 newsticker--raw-url-list-defaults))
183 :set 'newsticker--set-customvar-retrieval
184 :group 'newsticker-retrieval)
185
186(defcustom newsticker-url-list nil
187 "The news feeds which you like to watch.
188
189This alist will be used in addition to selection made customizing
190`newsticker-url-list-defaults'.
191
192This is an alist. Each element consists of two items: a LABEL and a URL,
193optionally followed by a START-TIME, INTERVAL specifier and WGET-ARGUMENTS.
194
195The LABEL gives the name of the news feed. It can be an arbitrary string.
196
197The URL gives the location of the news feed. It must point to a valid
198RSS or Atom file. The file is retrieved by calling wget, or whatever you
199specify as `newsticker-wget-name'.
200
201URL may also be a function which returns news data. In this case
202`newsticker-retrieval-method' etc. are ignored for this feed.
203
204The START-TIME can be either a string, or nil. If it is a string it
205specifies a fixed time at which this feed shall be retrieved for the
206first time. (Examples: \"11:00pm\", \"23:00\".) If it is nil (or
207unspecified), this feed will be retrieved immediately after calling
208`newsticker-start'.
209
210The INTERVAL specifies the time between retrievals for this feed. If it
211is nil (or unspecified) the default interval value as set in
212`newsticker-retrieval-interval' is used.
213
214\(newsticker.el calls `run-at-time'. The newsticker-parameters START-TIME
215and INTERVAL correspond to the `run-at-time'-parameters TIME and REPEAT.)
216
217WGET-ARGUMENTS specifies arguments for wget (see `newsticker-wget-name')
218which apply for this feed only, overriding the value of
219`newsticker-wget-arguments'."
220 :type '(repeat (list :tag "News feed"
221 (string :tag "Label")
222 (choice :tag "URI"
223 (string :tag "String")
224 (function :tag "Function"))
225 (choice :tag "Start"
226 (const :tag "Default" nil)
227 (string :tag "Fixed Time"))
228 (choice :tag "Interval"
229 (const :tag "Default" nil)
230 (const :tag "Hourly" 3600)
231 (const :tag "Daily" 86400)
232 (const :tag "Weekly" 604800)
233 (integer :tag "Interval"))
234 (choice :tag "Wget Arguments"
235 (const :tag "Default arguments" nil)
236 (repeat :tag "Special arguments" string))))
237 :set 'newsticker--set-customvar-retrieval
238 :group 'newsticker-retrieval)
239
240(defcustom newsticker-retrieval-method
241 'intern
242 "Method for retrieving news from the web, either `intern' or `extern'.
243Default value `intern' uses Emacs' built-in asynchronous download
244capabilities ('url-retrieve'). If set to `extern' the external
245program wget is used, see `newsticker-wget-name'."
246 :type '(choice :tag "Method"
247 (const :tag "Intern" intern)
248 (const :tag "Extern" extern))
249 :group 'newsticker-retrieval)
250
251(defcustom newsticker-wget-name
252 "wget"
253 "Name of the program which is called to retrieve news from the web.
254The canonical choice is wget but you may take any other program which is
255able to return the contents of a news feed file on stdout."
256 :type 'string
257 :group 'newsticker-retrieval)
258
259(defcustom newsticker-wget-arguments
260 '("-q" "-O" "-")
261 "Arguments which are passed to wget.
262There is probably no reason to change the default settings, unless you
263are living behind a firewall."
264 :type '(repeat (string :tag "Argument"))
265 :group 'newsticker-retrieval)
266
267(defcustom newsticker-retrieval-interval
268 3600
269 "Time interval for retrieving new news items (seconds).
270If this value is not positive (i.e. less than or equal to 0)
271items are retrieved only once!
272Please note that some feeds, e.g. Slashdot, will ban you if you
273make it less than 1800 seconds (30 minutes)!"
274 :type '(choice :tag "Interval"
275 (const :tag "No automatic retrieval" 0)
276 (const :tag "Hourly" 3600)
277 (const :tag "Daily" 86400)
278 (const :tag "Weekly" 604800)
279 (integer :tag "Interval"))
280 :set 'newsticker--set-customvar-retrieval
281 :group 'newsticker-retrieval)
282
283(defcustom newsticker-desc-comp-max
284 100
285 "Relevant length of headline descriptions.
286This value gives the maximum number of characters which will be
287taken into account when newsticker compares two headline
288descriptions."
289 :type 'integer
290 :group 'newsticker-retrieval)
291
292;; ======================================================================
293;; headline processing
294(defgroup newsticker-headline-processing nil
295 "Settings for the automatic processing of headlines."
296 :group 'newsticker)
297
298(defcustom newsticker-automatically-mark-items-as-old
299 t
300 "Decides whether to automatically mark items as old.
301If t a new item is considered as new only after its first retrieval. As
302soon as it is retrieved a second time, it becomes old. If not t all
303items stay new until you mark them as old. This is done in the
304*newsticker* buffer."
305 :type 'boolean
306 :group 'newsticker-headline-processing)
307
308(defcustom newsticker-automatically-mark-visited-items-as-old
309 t
310 "Decides whether to automatically mark visited items as old.
311If t an item is marked as old as soon as the associated link is
312visited, i.e. after pressing RET or mouse2 on the item's
313headline."
314
315 :type 'boolean
316 :group 'newsticker-headline-processing)
317
318(defcustom newsticker-keep-obsolete-items
319 t
320 "Decides whether to keep unread items which have been removed from feed.
321If t a new item, which has been removed from the feed, is kept in
322the cache until it is marked as read."
323 :type 'boolean
324 :group 'newsticker-headline-processing)
325
326(defcustom newsticker-obsolete-item-max-age
327 (* 60 60 24)
328 "Maximal age of obsolete items, in seconds.
329Obsolete items which are older than this value will be silently
330deleted at the next retrieval."
331 :type 'integer
332 :group 'newsticker-headline-processing)
333
334(defcustom newsticker-auto-mark-filter-list
335 nil
336 "A list of filters for automatically marking headlines.
337
338This is an alist of the form (FEED-NAME PATTERN-LIST). I.e. each
339element consists of a FEED-NAME a PATTERN-LIST. Each element of
340the pattern-list has the form (AGE TITLE-OR-DESCRIPTION REGEXP).
341AGE must be one of the symbols 'old or 'immortal.
342TITLE-OR-DESCRIPTION must be on of the symbols 'title,
343'description, or 'all. REGEXP is a regular expression, i.e. a
344string.
345
346This filter is checked after a new headline has been retrieved.
347If FEED-NAME matches the name of the corresponding news feed, the
348pattern-list is checked: The new headline will be marked as AGE
349if REGEXP matches the headline's TITLE-OR-DESCRIPTION.
350
351If, for example, `newsticker-auto-mark-filter-list' looks like
352 \((slashdot ('old 'title \"^Forget me!$\") ('immortal 'title \"Read me\")
353 \('immortal 'all \"important\"))))
354
355then all articles from slashdot are marked as old if they have
356the title \"Forget me!\". All articles with a title containing
357the string \"Read me\" are marked as immortal. All articles which
358contain the string \"important\" in their title or their
359description are marked as immortal."
360 :type '(repeat (list :tag "Auto mark filter"
361 (string :tag "Feed name")
362 (repeat
363 (list :tag "Filter element"
364 (choice
365 :tag "Auto-assigned age"
366 (const :tag "Old" old)
367 (const :tag "Immortal" immortal))
368 (choice
369 :tag "Title/Description"
370 (const :tag "Title" title)
371 (const :tag "Description" description)
372 (const :tag "All" all))
373 (string :tag "Regexp")))))
374 :group 'newsticker-headline-processing)
375
376;; ======================================================================
377;; hooks
378(defgroup newsticker-hooks nil
379 "Settings for newsticker hooks."
380 :group 'newsticker)
381
382(defcustom newsticker-start-hook
383 nil
384 "Hook run when starting newsticker.
385This hook is run at the very end of `newsticker-start'."
386 :options '(newsticker-start-ticker)
387 :type 'hook
388 :group 'newsticker-hooks)
389
390(defcustom newsticker-stop-hook
391 nil
392 "Hook run when stopping newsticker.
393This hook is run at the very end of `newsticker-stop'."
394 :options nil
395 :type 'hook
396 :group 'newsticker-hooks)
397
398(defcustom newsticker-new-item-functions
399 nil
400 "List of functions run after a new headline has been retrieved.
401Each function is called with the following three arguments:
402FEED the name of the corresponding news feed,
403TITLE the title of the headline,
404DESC the decoded description of the headline.
405
406See `newsticker-download-images', and
407`newsticker-download-enclosures' for sample functions.
408
409Please note that these functions are called only once for a
410headline after it has been retrieved for the first time."
411 :type 'hook
412 :options '(newsticker-download-images
413 newsticker-download-enclosures)
414 :group 'newsticker-hooks)
415
416;; ======================================================================
417;; miscellaneous
418(defgroup newsticker-miscellaneous nil
419 "Miscellaneous newsticker settings."
420 :group 'newsticker)
421
422(defcustom newsticker-cache-filename
423 "~/.newsticker-cache"
424 "Name of the newsticker cache file."
425 :type 'string
426 :group 'newsticker-miscellaneous)
427
428(defcustom newsticker-imagecache-dirname
429 "~/.newsticker-images"
430 "Name of the directory where newsticker stores cached images."
431 :type 'string
432 :group 'newsticker-miscellaneous)
433
434;; debugging
435(defcustom newsticker-debug
436 nil
437 "Enables some features needed for debugging newsticker.el.
438
439If set to t newsticker.el will print lots of debugging messages, and the
440buffers *newsticker-wget-<feed>* will not be closed."
441 :type 'boolean
442 :group 'newsticker-miscellaneous)
443
444;; ======================================================================
445;;; Compatibility section, XEmacs, Emacs
446;; ======================================================================
447(unless (fboundp 'time-add)
448 (require 'time-date);;FIXME
449 (defun time-add (t1 t2)
450 (seconds-to-time (+ (time-to-seconds t1) (time-to-seconds t2)))))
451
452(unless (fboundp 'match-string-no-properties)
453 (defalias 'match-string-no-properties 'match-string))
454
455(when (featurep 'xemacs)
456 (unless (fboundp 'replace-regexp-in-string)
457 (defun replace-regexp-in-string (re rp st)
458 (save-match-data ;; apparently XEmacs needs save-match-data
459 (replace-in-string st re rp)))))
460
461;; copied from subr.el
462(unless (fboundp 'add-to-invisibility-spec)
463 (defun add-to-invisibility-spec (arg)
464 "Add elements to `buffer-invisibility-spec'.
465See documentation for `buffer-invisibility-spec' for the kind of elements
466that can be added."
467 (if (eq buffer-invisibility-spec t)
468 (setq buffer-invisibility-spec (list t)))
469 (setq buffer-invisibility-spec
470 (cons arg buffer-invisibility-spec))))
471
472;; copied from subr.el
473(unless (fboundp 'remove-from-invisibility-spec)
474 (defun remove-from-invisibility-spec (arg)
475 "Remove elements from `buffer-invisibility-spec'."
476 (if (consp buffer-invisibility-spec)
477 (setq buffer-invisibility-spec
478 (delete arg buffer-invisibility-spec)))))
479
480;; ======================================================================
481;;; Internal variables
482;; ======================================================================
483(defvar newsticker--item-list nil
484 "List of newsticker items.")
485(defvar newsticker--item-position 0
486 "Actual position in list of newsticker items.")
487(defvar newsticker--prev-message "There was no previous message yet!"
488 "Last message that the newsticker displayed.")
489(defvar newsticker--scrollable-text ""
490 "The text which is scrolled smoothly in the echo area.")
491(defvar newsticker--buffer-uptodate-p nil
492 "Tells whether the newsticker buffer is up to date.")
493(defvar newsticker--latest-update-time (current-time)
494 "The time at which the latest news arrived.")
495(defvar newsticker--process-ids nil
496 "List of PIDs of active newsticker processes.")
497
498(defvar newsticker--cache nil "Cached newsticker data.
499This is a list of the form
500
501 ((label1
502 (title description link time age index preformatted-contents
503 preformatted-title extra-elements)
504 ...)
505 (label2
506 (title description link time age index preformatted-contents
507 preformatted-title extra-elements)
508 ...)
509 ...)
510
511where LABEL is a symbol. TITLE, DESCRIPTION, and LINK are
512strings. TIME is a time value as returned by `current-time'.
513AGE is a symbol: 'new, 'old, 'immortal, and 'obsolete denote
514ordinary news items, whereas 'feed denotes an item which is not a
515headline but describes the feed itself. INDEX denotes the
516original position of the item -- used for restoring the original
517order. PREFORMATTED-CONTENTS and PREFORMATTED-TITLE hold the
518formatted contents of the item's description and title. This
519speeds things up if HTML rendering is used, which is rather
520slow. EXTRA-ELEMENTS is an alist containing additional elements.")
521
522(defvar newsticker--auto-narrow-to-feed nil
523 "Automatically narrow to current news feed.
524If non-nil only the items of the current news feed are visible.")
525
526(defvar newsticker--auto-narrow-to-item nil
527 "Automatically narrow to current news item.
528If non-nil only the current headline is visible.")
529
530(defconst newsticker--error-headline
531 "[COULD NOT DOWNLOAD HEADLINES!]"
532 "Title of error headline which will be inserted if news retrieval fails.")
533
534;; ======================================================================
535;;; Shortcuts
536;; ======================================================================
537(defsubst newsticker--title (item)
538 "Return title of ITEM."
539 (nth 0 item))
540(defsubst newsticker--desc (item)
541 "Return description of ITEM."
542 (nth 1 item))
543(defsubst newsticker--link (item)
544 "Return link of ITEM."
545 (nth 2 item))
546(defsubst newsticker--time (item)
547 "Return time of ITEM."
548 (nth 3 item))
549(defsubst newsticker--age (item)
550 "Return age of ITEM."
551 (nth 4 item))
552(defsubst newsticker--pos (item)
553 "Return position/index of ITEM."
554 (nth 5 item))
555(defsubst newsticker--preformatted-contents (item)
556 "Return pre-formatted text of ITEM."
557 (nth 6 item))
558(defsubst newsticker--preformatted-title (item)
559 "Return pre-formatted title of ITEM."
560 (nth 7 item))
561(defsubst newsticker--extra (item)
562 "Return extra attributes of ITEM."
563 (nth 8 item))
564(defsubst newsticker--guid-to-string (guid)
565 "Return string representation of GUID."
566 (if (stringp guid)
567 guid
568 (car (xml-node-children guid))))
569(defsubst newsticker--guid (item)
570 "Return guid of ITEM."
571 (newsticker--guid-to-string (assoc 'guid (newsticker--extra item))))
572(defsubst newsticker--enclosure (item)
573 "Return enclosure element of ITEM in the form \(...FIXME...\) or nil."
574 (let ((enclosure (assoc 'enclosure (newsticker--extra item))))
575 (if enclosure
576 (xml-node-attributes enclosure))))
577(defun newsticker--real-feed-name (feed)
578 "Return real name of FEED."
579 (catch 'name
580 (mapc (lambda (item)
581 (if (eq (newsticker--age item) 'feed)
582 (throw 'name (newsticker--title item))))
583 (cdr (newsticker--cache-get-feed feed)))
584 (symbol-name feed)))
585
586
587;; ======================================================================
588;;; User fun
589;; ======================================================================
590
591(defun newsticker--start-feed (feed &optional do-not-complain-if-running)
592 "Start retrieval timer for FEED.
593If timer is running already a warning message is printed unless
594DO-NOT-COMPLAIN-IF-RUNNING is not nil. Add the started
595name/timer pair to `newsticker--retrieval-timer-list'."
596 (let* ((feed-name (car feed))
597 (start-time (nth 2 feed))
598 (interval (or (nth 3 feed)
599 newsticker-retrieval-interval))
600 (timer (assoc (car feed)
601 newsticker--retrieval-timer-list)))
602 (if timer
603 (or do-not-complain-if-running
604 (message "Timer for %s is running already!"
605 feed-name))
606 (newsticker--debug-msg "Starting timer for %s: %s, %d"
607 feed-name start-time interval)
608 ;; do not repeat retrieval if interval not positive
609 (if (<= interval 0)
610 (setq interval nil))
611 ;; Suddenly XEmacs doesn't like start-time 0
612 (if (or (not start-time)
613 (and (numberp start-time) (= start-time 0)))
614 (setq start-time 1))
615 ;; (message "start-time %s" start-time)
616 (setq timer (run-at-time start-time interval
617 'newsticker-get-news feed-name))
618 (if interval
619 (add-to-list 'newsticker--retrieval-timer-list
620 (cons feed-name timer))))))
621
622;;;###autoload
623(defun newsticker-start (&optional do-not-complain-if-running)
624 "Start the newsticker.
625Start the timers for display and retrieval. If the newsticker, i.e. the
626timers, are running already a warning message is printed unless
627DO-NOT-COMPLAIN-IF-RUNNING is not nil.
628Run `newsticker-start-hook' if newsticker was not running already."
629 (interactive)
630 (let ((running (newsticker-running-p)))
631 ;; read old cache if it exists and newsticker is not running
632 (unless running
633 (let ((coding-system-for-read 'utf-8))
634 (when (file-exists-p newsticker-cache-filename)
635 (with-temp-buffer
636 (insert-file-contents newsticker-cache-filename)
637 (goto-char (point-min))
638 (condition-case nil
639 (setq newsticker--cache (read (current-buffer)))
640 (error
641 (message "Error while reading newsticker cache file!")
642 (setq newsticker--cache nil)))))))
643 ;; start retrieval timers -- one timer for each feed
644 (dolist (feed (append newsticker-url-list-defaults newsticker-url-list))
645 (newsticker--start-feed feed))
646 (unless running
647 (run-hooks 'newsticker-start-hook)
648 (message "Newsticker started!"))))
649
650(defun newsticker--stop-feed (feed-name)
651 "Stop retrieval for feed FEED-NAME.
652Delete the stopped name/timer pair from `newsticker--retrieval-timer-list'."
653 (let ((name-and-timer (assoc feed-name newsticker--retrieval-timer-list)))
654 (when name-and-timer
655 (cancel-timer (cdr name-and-timer))
656 (setq newsticker--retrieval-timer-list
657 (delete name-and-timer newsticker--retrieval-timer-list)))))
658
659(defun newsticker-stop ()
660 "Stop the newsticker and the newsticker-ticker.
661Cancel the timers for display and retrieval. Run `newsticker-stop-hook'
662if newsticker has been running."
663 (interactive)
664 (newsticker--cache-update t)
665 (when (fboundp 'newsticker-stop-ticker) ; silence compiler warnings
666 (newsticker-stop-ticker))
667 (when (newsticker-running-p)
668 (mapc (lambda (name-and-timer)
669 (newsticker--stop-feed (car name-and-timer)))
670 newsticker--retrieval-timer-list)
671 (setq newsticker--retrieval-timer-list nil)
672 (run-hooks 'newsticker-stop-hook)
673 (message "Newsticker stopped!")))
674
675(defun newsticker-get-all-news ()
676 "Launch retrieval of news from all configured newsticker sites.
677This does NOT start the retrieval timers."
678 (interactive)
679 ;; launch retrieval of news
680 (mapc (lambda (item)
681 (newsticker-get-news (car item)))
682 (append newsticker-url-list-defaults newsticker-url-list)))
683
684(defun newsticker-save-item (feed item)
685 "Save FEED ITEM."
686 (interactive)
687 (let ((filename (read-string "Filename: "
688 (concat feed ":_"
689 (replace-regexp-in-string
690 " " "_" (newsticker--title item))
691 ".html"))))
692 (with-temp-buffer
693 (insert (newsticker--desc item))
694 (write-file filename t))))
695
696(defun newsticker-add-url (url name)
697 "Add given URL under given NAME to `newsticker-url-list'.
698If URL is nil it is searched at point."
699 (interactive
700 (list
701 (read-string "URL: "
702 (save-excursion
703 (end-of-line)
704 (and
705 (re-search-backward
706 "http://"
707 (if (> (point) (+ (point-min) 100))
708 (- (point) 100)
709 (point-min))
710 t)
711 (re-search-forward
712 "http://[-a-zA-Z0-9&/_.]*"
713 (if (< (point) (- (point-max) 200))
714 (+ (point) 200)
715 (point-max))
716 t)
717 (buffer-substring-no-properties (match-beginning 0)
718 (match-end 0)))))
719 (read-string "Name: ")))
720 (add-to-list 'newsticker-url-list (list name url nil nil nil) t)
721 (customize-variable 'newsticker-url-list))
722
723(defun newsticker-customize ()
724 "Open the newsticker customization group."
725 (interactive)
726 (customize-group "newsticker"))
727
728;; ======================================================================
729;;; Local stuff
730;; ======================================================================
731(defun newsticker--get-news-by-funcall (feed-name function)
732 "Get news for the site FEED-NAME by calling FUNCTION.
733See `newsticker-get-news'."
734 (let ((buffername (concat " *newsticker-funcall-" feed-name "*")))
735 (save-excursion
736 (set-buffer (get-buffer-create buffername))
737 (erase-buffer)
738 (insert (string-to-multibyte (funcall function feed-name)))
739 (newsticker--sentinel-work nil t feed-name function
740 (current-buffer)))))
741
742(defun newsticker--get-news-by-url (feed-name url)
743 "Get news for the site FEED-NAME from address URL using `url-retrieve'.
744See `newsticker-get-news'."
745 (let ((coding-system-for-read 'no-conversion))
746 (url-retrieve url 'newsticker--get-news-by-url-callback (list feed-name)))
747 (force-mode-line-update))
748
749(defun newsticker--get-news-by-url-callback (status feed-name)
750 "Callback function for `newsticker--get-news-by-url'.
751STATUS is the return status as delivered by `url-retrieve', and
752FEED-NAME is the name of the feed that the news were retrieved
753from."
754 (let ((buf (get-buffer-create (concat " *newsticker-url-" feed-name "*")))
755 (result (string-to-multibyte (buffer-string))))
756 (set-buffer buf)
757 (erase-buffer)
758 (insert result)
759 ;; remove MIME header
760 (goto-char (point-min))
761 (search-forward "\n\n")
762 (delete-region (point-min) (point))
763 ;; read the rss/atom contents
764 (newsticker--sentinel-work nil t feed-name "url-retrieve" (current-buffer))
765 (when status
766 (let ((status-type (car status))
767 (status-details (cdr status)))
768 (cond ((eq status-type :redirect)
769 ;; don't care about redirects
770 )
771 ((eq status-type :error)
772 (message "%s: Error while retrieving news from %s: %s: \"%s\""
773 (format-time-string "%A, %H:%M" (current-time))
774 feed-name
775 (car status-details) (cdr status-details))))))))
776
777(defun newsticker--get-news-by-wget (feed-name url wget-arguments)
778 "Get news for the site FEED-NAME from address URL using wget.
779WGET-ARGUMENTS is a list of arguments for wget.
780See `newsticker-get-news'."
781 (let ((buffername (concat " *newsticker-wget-" feed-name "*")))
782 (save-excursion
783 (set-buffer (get-buffer-create buffername))
784 (erase-buffer)
785 ;; throw an error if there is an old wget-process around
786 (if (get-process feed-name)
787 (error "Another wget-process is running for %s" feed-name))
788 ;; start wget
789 (let* ((args (append wget-arguments (list url)))
790 (proc (apply 'start-process feed-name buffername
791 newsticker-wget-name args)))
792 (set-process-coding-system proc 'no-conversion 'no-conversion)
793 (set-process-sentinel proc 'newsticker--sentinel)
794 (setq newsticker--process-ids (cons (process-id proc)
795 newsticker--process-ids))
796 (force-mode-line-update)))))
797
798(defun newsticker-get-news (feed-name)
799 "Get news from the site FEED-NAME and load feed logo.
800FEED-NAME must be a string which occurs as the label (i.e. the first element)
801in an element of `newsticker-url-list' or `newsticker-url-list-defaults'."
802 (newsticker--debug-msg "%s: Getting news for %s"
803 (format-time-string "%A, %H:%M" (current-time))
804 feed-name)
805 (let* ((item (or (assoc feed-name newsticker-url-list)
806 (assoc feed-name newsticker-url-list-defaults)
807 (error
808 "Cannot get news for %s: Check newsticker-url-list"
809 feed-name)))
810 (url (cadr item))
811 (wget-arguments (or (car (cdr (cdr (cdr (cdr item)))))
812 newsticker-wget-arguments)))
813 (if (functionp url)
814 (newsticker--get-news-by-funcall feed-name url)
815 (if (eq newsticker-retrieval-method 'intern)
816 (newsticker--get-news-by-url feed-name url)
817 (newsticker--get-news-by-wget feed-name url wget-arguments)))))
818
819;; ======================================================================
820;; Parsing
821;; ======================================================================
822
823(defun newsticker--sentinel (process event)
824 "Sentinel for extracting news titles from an RDF buffer.
825Argument PROCESS is the process which has just changed its state.
826Argument EVENT tells what has happened to the process."
827 (let ((p-status (process-status process))
828 (exit-status (process-exit-status process))
829 (name (process-name process))
830 (command (process-command process))
831 (buffer (process-buffer process)))
832 (newsticker--sentinel-work event
833 (and (eq p-status 'exit)
834 (= exit-status 0))
835 name command buffer)))
836
837(defun newsticker--sentinel-work (event status-ok name command buffer)
838 "Actually do the sentinel work.
839Argument EVENT tells what has happened to the retrieval process.
840Argument STATUS-OK is the final status of the retrieval process,
841non-nil meaning retrieval was successful.
842Argument NAME is the name of the retrieval process.
843Argument COMMAND is the command of the retrieval process.
844Argument BUFFER is the buffer of the retrieval process."
845 (let ((time (current-time))
846 (name-symbol (intern name))
847 (something-was-added nil))
848 ;; catch known errors (zombie processes, rubbish-xml etc.
849 ;; if an error occurs the news feed is not updated!
850 (catch 'oops
851 (unless status-ok
852 (setq newsticker--cache
853 (newsticker--cache-add
854 newsticker--cache
855 name-symbol
856 newsticker--error-headline
857 (format
858 (concat "%s: Newsticker could not retrieve news from %s.\n"
859 "Return status: `%s'\n"
860 "Command was `%s'")
861 (format-time-string "%A, %H:%M" (current-time))
862 name event command)
863 ""
864 (current-time)
865 'new
866 0 nil))
867 (message "%s: Error while retrieving news from %s"
868 (format-time-string "%A, %H:%M" (current-time))
869 name)
870 (throw 'oops nil))
871 (let* ((coding-system 'utf-8)
872 (node-list
873 (save-current-buffer
874 (set-buffer buffer)
875 ;; a very very dirty workaround to overcome the
876 ;; problems with the newest (20030621) xml.el:
877 ;; remove all unnecessary whitespace
878 (goto-char (point-min))
879 (while (re-search-forward ">[ \t\r\n]+<" nil t)
880 (replace-match "><" nil t))
881 ;; and another brutal workaround (20031105)! For some
882 ;; reason the xml parser does not like the colon in the
883 ;; doctype name "rdf:RDF"
884 (goto-char (point-min))
885 (if (re-search-forward "<!DOCTYPE[ \t\n]+rdf:RDF" nil t)
886 (replace-match "<!DOCTYPE rdfColonRDF" nil t))
887 ;; finally.... ~##^°!!!!!
888 (goto-char (point-min))
889 (while (search-forward "\r\n" nil t)
890 (replace-match "\n" nil t))
891 ;; still more brutal workarounds (20040309)! The xml
892 ;; parser does not like doctype rss
893 (goto-char (point-min))
894 (if (re-search-forward "<!DOCTYPE[ \t\n]+rss[ \t\n]*>" nil t)
895 (replace-match "" nil t))
896 ;; And another one (20050618)! (Fixed in GNU Emacs 22.0.50.18)
897 ;; Remove comments to avoid this xml-parsing bug:
898 ;; "XML files can have only one toplevel tag"
899 (goto-char (point-min))
900 (while (search-forward "<!--" nil t)
901 (let ((start (match-beginning 0)))
902 (unless (search-forward "-->" nil t)
903 (error "Can't find end of comment"))
904 (delete-region start (point))))
905 ;; And another one (20050702)! If description is HTML
906 ;; encoded and starts with a `<', wrap the whole
907 ;; description in a CDATA expression. This happened for
908 ;; http://www.thefreedictionary.com/_/WoD/rss.aspx?type=quote
909 (goto-char (point-min))
910 (while (re-search-forward
911 "<description>\\(<img.*?\\)</description>" nil t)
912 (replace-match
913 "<description><![CDATA[ \\1 ]]></description>"))
914 ;; And another one (20051123)! XML parser does not
915 ;; like this: <yweather:location city="Frankfurt/Main"
916 ;; region="" country="GM" />
917 ;; try to "fix" empty attributes
918 ;; This happened for
919 ;; http://xml.weather.yahoo.com/forecastrss?p=GMXX0040&u=f
920 (goto-char (point-min))
921 (while (re-search-forward "\\(<[^>]*\\)=\"\"" nil t)
922 (replace-match "\\1=\" \""))
923 ;;
924 (set-buffer-modified-p nil)
925 ;; check coding system
926 (goto-char (point-min))
927 (if (re-search-forward "encoding=\"\\([^\"]+\\)\""
928 nil t)
929 (setq coding-system (intern (downcase (match-string 1))))
930 (setq coding-system
931 (condition-case nil
932 (check-coding-system coding-system)
933 (coding-system-error
934 (message
935 "newsticker.el: ignoring coding system %s for %s"
936 coding-system name)
937 nil))))
938 ;; Decode if possible
939 (when coding-system
940 (decode-coding-region (point-min) (point-max)
941 coding-system))
942 (condition-case errordata
943 ;; The xml parser might fail
944 ;; or the xml might be bugged
945 (xml-parse-region (point-min) (point-max))
946 (error (message "Could not parse %s: %s"
947 (buffer-name) (cadr errordata))
948 (throw 'oops nil)))))
949 (topnode (car node-list))
950 (channelnode (car (xml-get-children topnode 'channel)))
951 (imageurl nil))
952 ;; mark all items as obsolete
953 (newsticker--cache-replace-age newsticker--cache
954 name-symbol
955 'new 'obsolete-new)
956 (newsticker--cache-replace-age newsticker--cache
957 name-symbol
958 'old 'obsolete-old)
959 (newsticker--cache-replace-age newsticker--cache
960 name-symbol
961 'feed 'obsolete-old)
962
963 ;; check Atom/RSS version and call corresponding parser
964 (condition-case error-data
965 (if (cond
966 ;; RSS 0.91
967 ((and (eq 'rss (xml-node-name topnode))
968 (string= "0.91" (xml-get-attribute topnode 'version)))
969 (setq imageurl (newsticker--get-logo-url-rss-0.91 topnode))
970 (newsticker--parse-rss-0.91 name time topnode))
971 ;; RSS 0.92
972 ((and (eq 'rss (xml-node-name topnode))
973 (string= "0.92" (xml-get-attribute topnode 'version)))
974 (setq imageurl (newsticker--get-logo-url-rss-0.92 topnode))
975 (newsticker--parse-rss-0.92 name time topnode))
976 ;; RSS 1.0
977 ((eq 'rdf:RDF (xml-node-name topnode))
978 (setq imageurl (newsticker--get-logo-url-rss-1.0 topnode))
979 (newsticker--parse-rss-1.0 name time topnode))
980 ;; RSS 2.0
981 ((and (eq 'rss (xml-node-name topnode))
982 (string= "2.0" (xml-get-attribute topnode 'version)))
983 (setq imageurl (newsticker--get-logo-url-rss-2.0 topnode))
984 (newsticker--parse-rss-2.0 name time topnode))
985 ;; Atom 0.3
986 ((and (eq 'feed (xml-node-name topnode))
987 (string= "http://purl.org/atom/ns#"
988 (xml-get-attribute topnode 'xmlns)))
989 (setq imageurl (newsticker--get-logo-url-atom-0.3 topnode))
990 (newsticker--parse-atom-0.3 name time topnode))
991 ;; Atom 1.0
992 ((and (eq 'feed (xml-node-name topnode))
993 (string= "http://www.w3.org/2005/Atom"
994 (xml-get-attribute topnode 'xmlns)))
995 (setq imageurl (newsticker--get-logo-url-atom-1.0 topnode))
996 (newsticker--parse-atom-1.0 name time topnode))
997 ;; unknown feed type
998 (t
999 (newsticker--debug-msg "Feed type unknown: %s: %s"
1000 (xml-node-name topnode) name)
1001 nil))
1002 (setq something-was-added t))
1003 (xerror (message "sentinelerror in %s: %s" name error-data)))
1004
1005 ;; Remove those old items from cache which have been removed from
1006 ;; the feed
1007 (newsticker--cache-replace-age newsticker--cache
1008 name-symbol 'obsolete-old 'deleteme)
1009 (newsticker--cache-remove newsticker--cache name-symbol
1010 'deleteme)
1011 ;; Remove those new items from cache which have been removed from
1012 ;; the feed. Or keep them as `obsolete'
1013 (if (not newsticker-keep-obsolete-items)
1014 (newsticker--cache-remove newsticker--cache
1015 name-symbol 'obsolete-new)
1016 (setq newsticker--cache
1017 (newsticker--cache-mark-expired
1018 newsticker--cache name-symbol 'obsolete 'obsolete-expired
1019 newsticker-obsolete-item-max-age))
1020 (newsticker--cache-remove newsticker--cache
1021 name-symbol 'obsolete-expired)
1022 (newsticker--cache-replace-age newsticker--cache
1023 name-symbol 'obsolete-new
1024 'obsolete))
1025 (newsticker--update-process-ids)
1026 ;; setup scrollable text
1027 (when (= 0 (length newsticker--process-ids))
1028 (when (fboundp 'newsticker--ticker-text-setup) ;silence
1029 ;compiler
1030 ;warnings
1031 (newsticker--ticker-text-setup)))
1032 (setq newsticker--latest-update-time (current-time))
1033 (when something-was-added
1034 ;; FIXME: should we care about removed items as well?
1035 (newsticker--cache-update)
1036 (when (fboundp 'newsticker--buffer-set-uptodate) ;silence
1037 ;compiler
1038 ;warnings
1039 (newsticker--buffer-set-uptodate nil)))
1040 ;; kill the process buffer if wanted
1041 (unless newsticker-debug
1042 (kill-buffer buffer))
1043 ;; launch retrieval of image
1044 (when (and imageurl newsticker--download-logos)
1045 (newsticker--image-get name imageurl)))))
1046 (when newsticker--sentinel-callback
1047 (funcall newsticker--sentinel-callback)))
1048
1049(defun newsticker--get-logo-url-atom-1.0 (node)
1050 "Return logo URL from atom 1.0 data in NODE."
1051 (car (xml-node-children
1052 (car (xml-get-children node 'logo)))))
1053
1054(defun newsticker--get-logo-url-atom-0.3 (node)
1055 "Return logo URL from atom 0.3 data in NODE."
1056 (car (xml-node-children
1057 (car (xml-get-children (car (xml-get-children node 'image)) 'url)))))
1058
1059(defun newsticker--get-logo-url-rss-2.0 (node)
1060 "Return logo URL from RSS 2.0 data in NODE."
1061 (car (xml-node-children
1062 (car (xml-get-children
1063 (car (xml-get-children
1064 (car (xml-get-children node 'channel)) 'image)) 'url)))))
1065
1066(defun newsticker--get-logo-url-rss-1.0 (node)
1067 "Return logo URL from RSS 1.0 data in NODE."
1068 (car (xml-node-children
1069 (car (xml-get-children (car (xml-get-children node 'image)) 'url)))))
1070
1071(defun newsticker--get-logo-url-rss-0.92 (node)
1072 "Return logo URL from RSS 0.92 data in NODE."
1073 (car (xml-node-children
1074 (car (xml-get-children (car (xml-get-children node 'image)) 'url)))))
1075
1076(defun newsticker--get-logo-url-rss-0.91 (node)
1077 "Return logo URL from RSS 0.91 data in NODE."
1078 (car (xml-node-children
1079 (car (xml-get-children (car (xml-get-children node 'image)) 'url)))))
1080
1081(defun newsticker--parse-atom-0.3 (name time topnode)
1082 "Parse Atom 0.3 data.
1083Return value as well as arguments NAME, TIME, and TOPNODE are the
1084same as in `newsticker--parse-atom-1.0'."
1085 (newsticker--debug-msg "Parsing Atom 0.3 feed %s" name)
1086 (let (new-feed new-item)
1087 (setq new-feed (newsticker--parse-generic-feed
1088 name time
1089 ;; title
1090 (car (xml-node-children
1091 (car (xml-get-children topnode 'title))))
1092 ;; desc
1093 (car (xml-node-children
1094 (car (xml-get-children topnode 'content))))
1095 ;; link
1096 (xml-get-attribute
1097 (car (xml-get-children topnode 'link)) 'href)
1098 ;; extra-elements
1099 (xml-node-children topnode)))
1100 (setq new-item (newsticker--parse-generic-items
1101 name time (xml-get-children topnode 'entry)
1102 ;; title-fn
1103 (lambda (node)
1104 (car (xml-node-children
1105 (car (xml-get-children node 'title)))))
1106 ;; desc-fn
1107 (lambda (node)
1108 (or (car (xml-node-children
1109 (car (xml-get-children node 'content))))
1110 (car (xml-node-children
1111 (car (xml-get-children node 'summary))))))
1112 ;; link-fn
1113 (lambda (node)
1114 (xml-get-attribute
1115 (car (xml-get-children node 'link)) 'href))
1116 ;; time-fn
1117 (lambda (node)
1118 (newsticker--decode-rfc822-date
1119 (car (xml-node-children
1120 (car (xml-get-children node 'modified))))))
1121 ;; guid-fn
1122 (lambda (node)
1123 (newsticker--guid-to-string
1124 (assoc 'guid (xml-node-children node))))
1125 ;; extra-fn
1126 (lambda (node)
1127 (xml-node-children node))))
1128 (or new-item new-feed)))
1129
1130(defun newsticker--parse-atom-1.0 (name time topnode)
1131 "Parse Atom 1.0 data.
1132Argument NAME gives the name of a news feed. TIME gives the
1133system time at which the data have been retrieved. TOPNODE
1134contains the feed data as returned by the xml parser.
1135
1136For the Atom 1.0 specification see
1137http://www.atompub.org/2005/08/17/draft-ietf-atompub-format-11.html"
1138 (newsticker--debug-msg "Parsing Atom 1.0 feed %s" name)
1139 (let (new-feed new-item)
1140 (setq new-feed (newsticker--parse-generic-feed
1141 name time
1142 ;; title
1143 (car (xml-node-children
1144 (car (xml-get-children topnode 'title))))
1145 ;; desc
1146 (car (xml-node-children
1147 (car (xml-get-children topnode 'subtitle))))
1148 ;; link
1149 (lambda (node)
1150 (xml-get-attribute
1151 (car (xml-get-children node 'link)) 'href))
1152 ;; extra-elements
1153 (xml-node-children topnode)))
1154 (setq new-item (newsticker--parse-generic-items
1155 name time (xml-get-children topnode 'entry)
1156 ;; title-fn
1157 (lambda (node)
1158 (car (xml-node-children
1159 (car (xml-get-children node 'title)))))
1160 ;; desc-fn
1161 (lambda (node)
1162 (or (car (xml-node-children
1163 (car (xml-get-children node 'content))))
1164 (car (xml-node-children
1165 (car (xml-get-children node 'summary))))))
1166 ;; link-fn
1167 (lambda (node)
1168 (xml-get-attribute
1169 (car (xml-get-children node 'link)) 'href))
1170 ;; time-fn
1171 (lambda (node)
1172 (newsticker--decode-iso8601-date
1173 (or (car (xml-node-children
1174 (car (xml-get-children node 'updated))))
1175 (car (xml-node-children
1176 (car (xml-get-children node 'published)))))))
1177 ;; guid-fn
1178 (lambda (node)
1179 (car (xml-node-children
1180 (car (xml-get-children node 'id)))))
1181 ;; extra-fn
1182 (lambda (node)
1183 (xml-node-children node))))
1184 (or new-item new-feed)))
1185
1186(defun newsticker--parse-rss-0.91 (name time topnode)
1187 "Parse RSS 0.91 data.
1188Return value as well as arguments NAME, TIME, and TOPNODE are the
1189same as in `newsticker--parse-atom-1.0'.
1190
1191For the RSS 0.91 specification see http://backend.userland.com/rss091 or
1192http://my.netscape.com/publish/formats/rss-spec-0.91.html."
1193 (newsticker--debug-msg "Parsing RSS 0.91 feed %s" name)
1194 (let* ((channelnode (car (xml-get-children topnode 'channel)))
1195 (pub-date (newsticker--decode-rfc822-date
1196 (car (xml-node-children
1197 (car (xml-get-children channelnode 'pubDate))))))
1198 is-new-feed has-new-items)
1199 (setq is-new-feed (newsticker--parse-generic-feed
1200 name time
1201 ;; title
1202 (car (xml-node-children
1203 (car (xml-get-children channelnode 'title))))
1204 ;; desc
1205 (car (xml-node-children
1206 (car (xml-get-children channelnode
1207 'description))))
1208 ;; link
1209 (car (xml-node-children
1210 (car (xml-get-children channelnode 'link))))
1211 ;; extra-elements
1212 (xml-node-children channelnode)))
1213 (setq has-new-items (newsticker--parse-generic-items
1214 name time (xml-get-children channelnode 'item)
1215 ;; title-fn
1216 (lambda (node)
1217 (car (xml-node-children
1218 (car (xml-get-children node 'title)))))
1219 ;; desc-fn
1220 (lambda (node)
1221 (car (xml-node-children
1222 (car (xml-get-children node 'description)))))
1223 ;; link-fn
1224 (lambda (node)
1225 (car (xml-node-children
1226 (car (xml-get-children node 'link)))))
1227 ;; time-fn
1228 (lambda (node)
1229 (newsticker--decode-rfc822-date
1230 (car (xml-node-children
1231 (car (xml-get-children node 'pubDate))))))
1232 ;; guid-fn
1233 (lambda (node)
1234 nil)
1235 ;; extra-fn
1236 (lambda (node)
1237 (xml-node-children node))))
1238 (or has-new-items is-new-feed)))
1239
1240(defun newsticker--parse-rss-0.92 (name time topnode)
1241 "Parse RSS 0.92 data.
1242Return value as well as arguments NAME, TIME, and TOPNODE are the
1243same as in `newsticker--parse-atom-1.0'.
1244
1245For the RSS 0.92 specification see http://backend.userland.com/rss092."
1246 (newsticker--debug-msg "Parsing RSS 0.92 feed %s" name)
1247 (let* ((channelnode (car (xml-get-children topnode 'channel)))
1248 (pub-date (newsticker--decode-rfc822-date
1249 (car (xml-node-children
1250 (car (xml-get-children channelnode 'pubDate))))))
1251 is-new-feed has-new-items)
1252 (setq is-new-feed (newsticker--parse-generic-feed
1253 name time
1254 ;; title
1255 (car (xml-node-children
1256 (car (xml-get-children channelnode 'title))))
1257 ;; desc
1258 (car (xml-node-children
1259 (car (xml-get-children channelnode
1260 'description))))
1261 ;; link
1262 (car (xml-node-children
1263 (car (xml-get-children channelnode 'link))))
1264 ;; extra-elements
1265 (xml-node-children channelnode)))
1266 (setq has-new-items (newsticker--parse-generic-items
1267 name time (xml-get-children channelnode 'item)
1268 ;; title-fn
1269 (lambda (node)
1270 (car (xml-node-children
1271 (car (xml-get-children node 'title)))))
1272 ;; desc-fn
1273 (lambda (node)
1274 (car (xml-node-children
1275 (car (xml-get-children node 'description)))))
1276 ;; link-fn
1277 (lambda (node)
1278 (car (xml-node-children
1279 (car (xml-get-children node 'link)))))
1280 ;; time-fn
1281 (lambda (node)
1282 (newsticker--decode-rfc822-date
1283 (car (xml-node-children
1284 (car (xml-get-children node 'pubDate))))))
1285 ;; guid-fn
1286 (lambda (node)
1287 nil)
1288 ;; extra-fn
1289 (lambda (node)
1290 (xml-node-children node))))
1291 (or has-new-items is-new-feed)))
1292
1293(defun newsticker--parse-rss-1.0 (name time topnode)
1294 "Parse RSS 1.0 data.
1295Return value as well as arguments NAME, TIME, and TOPNODE are the
1296same as in `newsticker--parse-atom-1.0'.
1297
1298For the RSS 1.0 specification see http://web.resource.org/rss/1.0/spec."
1299 (newsticker--debug-msg "Parsing RSS 1.0 feed %s" name)
1300 (let* ((channelnode (car (xml-get-children topnode 'channel)))
1301 is-new-feed has-new-items)
1302 (setq is-new-feed (newsticker--parse-generic-feed
1303 name time
1304 ;; title
1305 (car (xml-node-children
1306 (car (xml-get-children channelnode 'title))))
1307 ;; desc
1308 (car (xml-node-children
1309 (car (xml-get-children channelnode
1310 'description))))
1311 ;; link
1312 (car (xml-node-children
1313 (car (xml-get-children channelnode 'link))))
1314 ;; extra-elements
1315 (xml-node-children channelnode)))
1316 (setq has-new-items (newsticker--parse-generic-items
1317 name time (xml-get-children topnode 'item)
1318 ;; title-fn
1319 (lambda (node)
1320 (car (xml-node-children
1321 (car (xml-get-children node 'title)))))
1322 ;; desc-fn
1323 (lambda (node)
1324 (car (xml-node-children
1325 (car (xml-get-children node
1326 'description)))))
1327 ;; link-fn
1328 (lambda (node)
1329 (car (xml-node-children
1330 (car (xml-get-children node 'link)))))
1331 ;; time-fn
1332 (lambda (node)
1333 (newsticker--decode-iso8601-date
1334 (car (xml-node-children
1335 (car (xml-get-children node 'dc:date))))))
1336 ;; guid-fn
1337 (lambda (node)
1338 nil)
1339 ;; extra-fn
1340 (lambda (node)
1341 (xml-node-children node))))
1342 (or has-new-items is-new-feed)))
1343
1344(defun newsticker--parse-rss-2.0 (name time topnode)
1345 "Parse RSS 2.0 data.
1346Return value as well as arguments NAME, TIME, and TOPNODE are the
1347same as in `newsticker--parse-atom-1.0'.
1348
1349For the RSS 2.0 specification see http://blogs.law.harvard.edu/tech/rss."
1350 (newsticker--debug-msg "Parsing RSS 2.0 feed %s" name)
1351 (let* ((channelnode (car (xml-get-children topnode 'channel)))
1352 is-new-feed has-new-items)
1353 (setq is-new-feed (newsticker--parse-generic-feed
1354 name time
1355 ;; title
1356 (car (xml-node-children
1357 (car (xml-get-children channelnode 'title))))
1358 ;; desc
1359 (car (xml-node-children
1360 (car (xml-get-children channelnode
1361 'description))))
1362 ;; link
1363 (car (xml-node-children
1364 (car (xml-get-children channelnode 'link))))
1365 ;; extra-elements
1366 (xml-node-children channelnode)))
1367 (setq has-new-items (newsticker--parse-generic-items
1368 name time (xml-get-children channelnode 'item)
1369 ;; title-fn
1370 (lambda (node)
1371 (car (xml-node-children
1372 (car (xml-get-children node 'title)))))
1373 ;; desc-fn
1374 (lambda (node)
1375 (or (car (xml-node-children
1376 (car (xml-get-children node
1377 'content:encoded))))
1378 (car (xml-node-children
1379 (car (xml-get-children node
1380 'description))))))
1381 ;; link-fn
1382 (lambda (node)
1383 (car (xml-node-children
1384 (car (xml-get-children node 'link)))))
1385 ;; time-fn
1386 (lambda (node)
1387 (newsticker--decode-rfc822-date
1388 (car (xml-node-children
1389 (car (xml-get-children node 'pubDate))))))
1390 ;; guid-fn
1391 (lambda (node)
1392 (newsticker--guid-to-string
1393 (assoc 'guid (xml-node-children node))))
1394 ;; extra-fn
1395 (lambda (node)
1396 (xml-node-children node))))
1397 (or has-new-items is-new-feed)))
1398
1399(defun newsticker--parse-generic-feed (name time title desc link
1400 extra-elements)
1401 "Parse generic news feed data.
1402Argument NAME gives the name of a news feed. TIME gives the
1403system time at which the data have been retrieved.
1404
1405The arguments TITLE, DESC, LINK, and EXTRA-ELEMENTS give the feed's title,
1406description, link, and extra elements resp."
1407 (let ((title (or title "[untitled]"))
1408 (link (or link ""))
1409 (old-item nil)
1410 (position 0)
1411 (something-was-added nil))
1412 ;; decode numeric entities
1413 (setq title (newsticker--decode-numeric-entities title))
1414 (setq desc (newsticker--decode-numeric-entities desc))
1415 (setq link (newsticker--decode-numeric-entities link))
1416 ;; remove whitespace from title, desc, and link
1417 (setq title (newsticker--remove-whitespace title))
1418 (setq desc (newsticker--remove-whitespace desc))
1419 (setq link (newsticker--remove-whitespace link))
1420
1421 ;; handle the feed itself
1422 (unless (newsticker--cache-contains newsticker--cache
1423 (intern name) title
1424 desc link 'feed)
1425 (setq something-was-added t))
1426 (setq newsticker--cache
1427 (newsticker--cache-add newsticker--cache (intern name)
1428 title desc link time 'feed position
1429 extra-elements time 'feed))
1430 something-was-added))
1431
1432(defun newsticker--parse-generic-items (name time itemlist
1433 title-fn desc-fn
1434 link-fn time-fn
1435 guid-fn extra-fn)
1436 "Parse generic news feed data.
1437Argument NAME gives the name of a news feed. TIME gives the
1438system time at which the data have been retrieved. ITEMLIST
1439contains the news items returned by the xml parser.
1440
1441The arguments TITLE-FN, DESC-FN, LINK-FN, TIME-FN, GUID-FN, and
1442EXTRA-FN give functions for extracting title, description, link,
1443time, guid, and extra-elements resp. They are called with one
1444argument, which is one of the items in ITEMLIST."
1445 (let (title desc link
1446 (old-item nil)
1447 (position 0)
1448 (something-was-added nil))
1449 ;; gather all items for this feed
1450 (mapc (lambda (node)
1451 (setq position (1+ position))
1452 (setq title (or (funcall title-fn node) "[untitled]"))
1453 (setq desc (funcall desc-fn node))
1454 (setq link (or (funcall link-fn node) ""))
1455 (setq time (or (funcall time-fn node) time))
1456 ;; It happened that the title or description
1457 ;; contained evil HTML code that confused the
1458 ;; xml parser. Therefore:
1459 (unless (stringp title)
1460 (setq title (prin1-to-string title)))
1461 (unless (or (stringp desc) (not desc))
1462 (setq desc (prin1-to-string desc)))
1463 ;; ignore items with empty title AND empty desc
1464 (when (or (> (length title) 0)
1465 (> (length desc) 0))
1466 ;; decode numeric entities
1467 (setq title (newsticker--decode-numeric-entities title))
1468 (when desc
1469 (setq desc (newsticker--decode-numeric-entities desc)))
1470 (setq link (newsticker--decode-numeric-entities link))
1471 ;; remove whitespace from title, desc, and link
1472 (setq title (newsticker--remove-whitespace title))
1473 (setq desc (newsticker--remove-whitespace desc))
1474 (setq link (newsticker--remove-whitespace link))
1475 ;; add data to cache
1476 ;; do we have this item already?
1477 (let* ((guid (funcall guid-fn node)))
1478 ;;(message "guid=%s" guid)
1479 (setq old-item
1480 (newsticker--cache-contains newsticker--cache
1481 (intern name) title
1482 desc link nil guid)))
1483 ;; add this item, or mark it as old, or do nothing
1484 (let ((age1 'new)
1485 (age2 'old)
1486 (item-new-p nil))
1487 (if old-item
1488 (let ((prev-age (newsticker--age old-item)))
1489 (unless newsticker-automatically-mark-items-as-old
1490 ;; Some feeds deliver items multiply, the
1491 ;; first time we find an 'obsolete-old one the
1492 ;; cache, the following times we find an 'old
1493 ;; one
1494 (if (memq prev-age '(obsolete-old old))
1495 (setq age2 'old)
1496 (setq age2 'new)))
1497 (if (eq prev-age 'immortal)
1498 (setq age2 'immortal))
1499 (setq time (newsticker--time old-item)))
1500 ;; item was not there
1501 (setq item-new-p t)
1502 (setq something-was-added t))
1503 (setq newsticker--cache
1504 (newsticker--cache-add
1505 newsticker--cache (intern name) title desc link
1506 time age1 position (funcall extra-fn node)
1507 time age2))
1508 (when item-new-p
1509 (let ((item (newsticker--cache-contains
1510 newsticker--cache (intern name) title
1511 desc link nil)))
1512 (if newsticker-auto-mark-filter-list
1513 (newsticker--run-auto-mark-filter name item))
1514 (run-hook-with-args
1515 'newsticker-new-item-functions name item))))))
1516 itemlist)
1517 something-was-added))
1518
1519;; ======================================================================
1520;;; Misc
1521;; ======================================================================
1522(defun newsticker--decode-numeric-entities (string)
1523 "Decode SGML numeric entities by their respective utf characters.
1524This function replaces numeric entities in the input STRING and
1525returns the modified string. For example \"&#42;\" gets replaced
1526by \"*\"."
1527 (if (and string (stringp string))
1528 (let ((start 0))
1529 (while (string-match "&#\\([0-9]+\\);" string start)
1530 (condition-case nil
1531 (setq string (replace-match
1532 (string (read (substring string
1533 (match-beginning 1)
1534 (match-end 1))))
1535 nil nil string))
1536 (error nil))
1537 (setq start (1+ (match-beginning 0))))
1538 string)
1539 nil))
1540
1541(defun newsticker--remove-whitespace (string)
1542 "Remove leading and trailing whitespace from STRING."
1543 ;; we must have ...+ but not ...* in the regexps otherwise xemacs loops
1544 ;; endlessly...
1545 (when (and string (stringp string))
1546 (replace-regexp-in-string
1547 "[ \t\r\n]+$" ""
1548 (replace-regexp-in-string "^[ \t\r\n]+" "" string))))
1549
1550(defun newsticker--do-forget-preformatted (item)
1551 "Forget pre-formatted data for ITEM.
1552Remove the pre-formatted from `newsticker--cache'."
1553 (if (nthcdr 7 item)
1554 (setcar (nthcdr 7 item) nil))
1555 (if (nthcdr 6 item)
1556 (setcar (nthcdr 6 item) nil)))
1557
1558(defun newsticker--forget-preformatted ()
1559 "Forget all cached pre-formatted data.
1560Remove the pre-formatted from `newsticker--cache'."
1561 (mapc (lambda (feed)
1562 (mapc 'newsticker--do-forget-preformatted
1563 (cdr feed)))
1564 newsticker--cache)
1565 (when (fboundp 'newsticker--buffer-set-uptodate)
1566 (newsticker--buffer-set-uptodate nil)))
1567
1568(defun newsticker--debug-msg (string &rest args)
1569 "Print newsticker debug messages.
1570This function calls `message' with arguments STRING and ARGS, if
1571`newsticker-debug' is non-nil."
1572 (and newsticker-debug
1573 ;;(not (active-minibuffer-window))
1574 ;;(not (current-message))
1575 (apply 'message string args)))
1576
1577(defun newsticker--decode-iso8601-date (iso8601-string)
1578 "Return ISO8601-STRING in format like `decode-time'.
1579Converts from ISO-8601 to Emacs representation.
1580Examples:
15812004-09-17T05:09:49.001+00:00
15822004-09-17T05:09:49+00:00
15832004-09-17T05:09+00:00
15842004-09-17T05:09:49
15852004-09-17T05:09
15862004-09-17
15872004-09
15882004"
1589 (if iso8601-string
1590 (when (string-match
1591 (concat
1592 "^ *\\([0-9]\\{4\\}\\)" ;year
1593 "\\(-\\([0-9]\\{2\\}\\)" ;month
1594 "\\(-\\([0-9]\\{2\\}\\)" ;day
1595 "\\(T"
1596 "\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)" ;hour:minute
1597 "\\(:\\([0-9]\\{2\\}\\)\\(\\.[0-9]+\\)?\\)?" ;second
1598 ;timezone
1599 "\\(\\([-+Z]\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)?"
1600 "\\)?\\)?\\)? *$")
1601 iso8601-string)
1602 (let ((year (read (match-string 1 iso8601-string)))
1603 (month (read (or (match-string 3 iso8601-string)
1604 "1")))
1605 (day (read (or (match-string 5 iso8601-string)
1606 "1")))
1607 (hour (read (or (match-string 7 iso8601-string)
1608 "0")))
1609 (minute (read (or (match-string 8 iso8601-string)
1610 "0")))
1611 (second (read (or (match-string 10 iso8601-string)
1612 "0")))
1613 (sign (match-string 13 iso8601-string))
1614 (offset-hour (read (or (match-string 15 iso8601-string)
1615 "0")))
1616 (offset-minute (read (or (match-string 16 iso8601-string)
1617 "0"))))
1618 (cond ((string= sign "+")
1619 (setq hour (- hour offset-hour))
1620 (setq minute (- minute offset-minute)))
1621 ((string= sign "-")
1622 (setq hour (+ hour offset-hour))
1623 (setq minute (+ minute offset-minute))))
1624 ;; if UTC subtract current-time-zone offset
1625 ;;(setq second (+ (car (current-time-zone)) second)))
1626
1627 (condition-case nil
1628 (encode-time second minute hour day month year t)
1629 (error
1630 (message "Cannot decode \"%s\"" iso8601-string)
1631 nil))))
1632 nil))
1633
1634(defun newsticker--decode-rfc822-date (rfc822-string)
1635 "Return RFC822-STRING in format like `decode-time'.
1636Converts from RFC822 to Emacs representation.
1637Examples:
1638Sat, 07 September 2002 00:00:01 +0100
1639Sat, 07 September 2002 00:00:01 MET
1640Sat, 07 Sep 2002 00:00:01 GMT
164107 Sep 2002 00:00:01 GMT
164207 Sep 2002"
1643 (if (and rfc822-string (stringp rfc822-string))
1644 (when (string-match
1645 (concat
1646 "\\s-*"
1647 ;; week day
1648 "\\(\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\)\\s-*,?\\)?\\s-*"
1649 ;; day
1650 "\\([0-9]\\{1,2\\}\\)\\s-+"
1651 ;; month
1652 "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|"
1653 "Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\).*?\\s-+"
1654 ;; year
1655 "\\([0-9]\\{2,4\\}\\)"
1656 ;; time may be missing
1657 "\\(\\s-+"
1658 ;; hour
1659 "\\([0-9]\\{2\\}\\)"
1660 ;; minute
1661 ":\\([0-9]\\{2\\}\\)"
1662 ;; second
1663 "\\(:\\([0-9]\\{2\\}\\)\\)?"
1664 ;; zone -- fixme
1665 "\\(\\s-+\\("
1666 "UT\\|GMT\\|EST\\|EDT\\|CST\\|CDT\\|MST\\|MDT\\|PST\\|PDT"
1667 "\\|\\([-+]\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)"
1668 "\\)\\)?"
1669 "\\)?")
1670 rfc822-string)
1671 (let ((day (read (match-string 3 rfc822-string)))
1672 (month-name (match-string 4 rfc822-string))
1673 (month 0)
1674 (year (read (match-string 5 rfc822-string)))
1675 (hour (read (or (match-string 7 rfc822-string) "0")))
1676 (minute (read (or (match-string 8 rfc822-string) "0")))
1677 (second (read (or (match-string 10 rfc822-string) "0")))
1678 (zone (match-string 12 rfc822-string))
1679 (sign (match-string 13 rfc822-string))
1680 (offset-hour (read (or (match-string 14 rfc822-string)
1681 "0")))
1682 (offset-minute (read (or (match-string 15 rfc822-string)
1683 "0")))
1684 ;;FIXME
1685 )
1686 (when zone
1687 (cond ((string= sign "+")
1688 (setq hour (- hour offset-hour))
1689 (setq minute (- minute offset-minute)))
1690 ((string= sign "-")
1691 (setq hour (+ hour offset-hour))
1692 (setq minute (+ minute offset-minute)))))
1693 (condition-case error-data
1694 (let ((i 1))
1695 (mapc (lambda (m)
1696 (if (string= month-name m)
1697 (setq month i))
1698 (setq i (1+ i)))
1699 '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug"
1700 "Sep" "Oct" "Nov" "Dec"))
1701 (encode-time second minute hour day month year t))
1702 (error
1703 (message "Cannot decode \"%s\": %s %s" rfc822-string
1704 (car error-data) (cdr error-data))
1705 nil))))
1706 nil))
1707
1708(defun newsticker--lists-intersect-p (list1 list2)
1709 "Return t if LIST1 and LIST2 share elements."
1710 (let ((result nil))
1711 (mapc (lambda (elt)
1712 (if (memq elt list2)
1713 (setq result t)))
1714 list1)
1715 result))
1716
1717(defun newsticker--update-process-ids ()
1718 "Update list of ids of active newsticker processes.
1719Checks list of active processes against list of newsticker processes."
1720 (let ((active-procs (process-list))
1721 (new-list nil))
1722 (mapc (lambda (proc)
1723 (let ((id (process-id proc)))
1724 (if (memq id newsticker--process-ids)
1725 (setq new-list (cons id new-list)))))
1726 active-procs)
1727 (setq newsticker--process-ids new-list))
1728 (force-mode-line-update))
1729
1730;; ======================================================================
1731;;; Images
1732;; ======================================================================
1733(defun newsticker--image-get (feed-name url)
1734 "Get image of the news site FEED-NAME from URL.
1735If the image has been downloaded in the last 24h do nothing."
1736 (let ((image-name (concat newsticker-imagecache-dirname "/"
1737 feed-name)))
1738 (if (and (file-exists-p image-name)
1739 (time-less-p (current-time)
1740 (time-add (nth 5 (file-attributes image-name))
1741 (seconds-to-time 86400))))
1742 (newsticker--debug-msg "%s: Getting image for %s skipped"
1743 (format-time-string "%A, %H:%M" (current-time))
1744 feed-name)
1745 ;; download
1746 (newsticker--debug-msg "%s: Getting image for %s"
1747 (format-time-string "%A, %H:%M" (current-time))
1748 feed-name)
1749 (let* ((buffername (concat " *newsticker-wget-image-" feed-name "*"))
1750 (item (or (assoc feed-name newsticker-url-list)
1751 (assoc feed-name newsticker-url-list-defaults)
1752 (error
1753 "Cannot get news for %s: Check newsticker-url-list"
1754 feed-name)))
1755 (wget-arguments (or (car (cdr (cdr (cdr (cdr item)))))
1756 newsticker-wget-arguments)))
1757 (save-excursion
1758 (set-buffer (get-buffer-create buffername))
1759 (erase-buffer)
1760 ;; throw an error if there is an old wget-process around
1761 (if (get-process feed-name)
1762 (error "Another wget-process is running for image %s"
1763 feed-name))
1764 ;; start wget
1765 (let* ((args (append wget-arguments (list url)))
1766 (proc (apply 'start-process feed-name buffername
1767 newsticker-wget-name args)))
1768 (set-process-coding-system proc 'no-conversion 'no-conversion)
1769 (set-process-sentinel proc 'newsticker--image-sentinel)))))))
1770
1771(defun newsticker--image-sentinel (process event)
1772 "Sentinel for image-retrieving PROCESS caused by EVENT."
1773 (let* ((p-status (process-status process))
1774 (exit-status (process-exit-status process))
1775 (feed-name (process-name process)))
1776 ;; catch known errors (zombie processes, rubbish-xml, etc.)
1777 ;; if an error occurs the news feed is not updated!
1778 (catch 'oops
1779 (unless (and (eq p-status 'exit)
1780 (= exit-status 0))
1781 (message "%s: Error while retrieving image from %s"
1782 (format-time-string "%A, %H:%M" (current-time))
1783 feed-name)
1784 (throw 'oops nil))
1785 (let (image-name)
1786 (save-excursion
1787 (set-buffer (process-buffer process))
1788 (setq image-name (concat newsticker-imagecache-dirname "/"
1789 feed-name))
1790 (set-buffer-file-coding-system 'no-conversion)
1791 ;; make sure the cache dir exists
1792 (unless (file-directory-p newsticker-imagecache-dirname)
1793 (make-directory newsticker-imagecache-dirname))
1794 ;; write and close buffer
1795 (let ((require-final-newline nil)
1796 (backup-inhibited t)
1797 (coding-system-for-write 'no-conversion))
1798 (write-region nil nil image-name nil 'quiet))
1799 (set-buffer-modified-p nil)
1800 (kill-buffer (current-buffer)))))))
1801
1802
1803
1804(defun newsticker--insert-image (img string)
1805 "Insert IMG with STRING at point."
1806 (insert-image img string))
1807
1808;; ======================================================================
1809;;; HTML rendering
1810;; ======================================================================
1811(defun newsticker-htmlr-render (pos1 pos2) ;
1812 "Replacement for `htmlr-render'.
1813Renders the HTML code in the region POS1 to POS2 using htmlr."
1814 (let ((str (buffer-substring-no-properties pos1 pos2)))
1815 (delete-region pos1 pos2)
1816 (insert
1817 (with-temp-buffer
1818 (insert str)
1819 (goto-char (point-min))
1820 ;; begin original htmlr-render
1821 (when (fboundp 'htmlr-reset) (htmlr-reset))
1822 ;; something omitted here...
1823 (when (fboundp 'htmlr-step)
1824 (while (< (point) (point-max))
1825 (htmlr-step)))
1826 ;; end original htmlr-render
1827 (newsticker--remove-whitespace (buffer-string))))))
1828
1829;; ======================================================================
1830;;; Manipulation of cached data
1831;; ======================================================================
1832(defun newsticker--cache-set-preformatted-contents (item contents)
1833 "Set preformatted contents of ITEM to CONTENTS."
1834 (if (nthcdr 6 item)
1835 (setcar (nthcdr 6 item) contents)
1836 (setcdr (nthcdr 5 item) (list contents))))
1837
1838(defun newsticker--cache-set-preformatted-title (item title)
1839 "Set preformatted title of ITEM to TITLE."
1840 (if (nthcdr 7 item)
1841 (setcar (nthcdr 7 item) title)
1842 (setcdr (nthcdr 6 item) title)))
1843
1844(defun newsticker--cache-replace-age (data feed old-age new-age)
1845 "Mark all items in DATA in FEED which carry age OLD-AGE with NEW-AGE.
1846If FEED is 'any it applies to all feeds. If OLD-AGE is 'any,
1847all marks are replaced by NEW-AGE. Removes all pre-formatted contents."
1848 (mapc (lambda (a-feed)
1849 (when (or (eq feed 'any)
1850 (eq (car a-feed) feed))
1851 (let ((items (cdr a-feed)))
1852 (mapc (lambda (item)
1853 (when (or (eq old-age 'any)
1854 (eq (newsticker--age item) old-age))
1855 (setcar (nthcdr 4 item) new-age)
1856 (newsticker--do-forget-preformatted item)))
1857 items))))
1858 data)
1859 data)
1860
1861(defun newsticker--cache-mark-expired (data feed old-age new-age time)
1862 "Mark all expired entries.
1863This function sets the age entries in DATA in the feed FEED. If
1864an item's age is OLD-AGE it is set to NEW-AGE if the item is
1865older than TIME."
1866 (mapc
1867 (lambda (a-feed)
1868 (when (or (eq feed 'any)
1869 (eq (car a-feed) feed))
1870 (let ((items (cdr a-feed)))
1871 (mapc
1872 (lambda (item)
1873 (when (eq (newsticker--age item) old-age)
1874 (let ((exp-time (time-add (newsticker--time item)
1875 (seconds-to-time time))))
1876 (when (time-less-p exp-time (current-time))
1877 (newsticker--debug-msg
1878 "Item `%s' from %s has expired on %s"
1879 (newsticker--title item)
1880 (format-time-string "%Y-%02m-%d, %H:%M"
1881 (newsticker--time item))
1882 (format-time-string "%Y-%02m-%d, %H:%M" exp-time))
1883 (setcar (nthcdr 4 item) new-age)))))
1884 items))))
1885 data)
1886 data)
1887
1888(defun newsticker--cache-contains (data feed title desc link age
1889 &optional guid)
1890 "Check DATA whether FEED contains an item with the given properties.
1891This function returns the contained item or nil if it is not
1892contained.
1893The properties which are checked are TITLE, DESC, LINK, AGE, and
1894GUID. In general all properties must match in order to return a
1895certain item, except for the following cases.
1896
1897If AGE equals 'feed the TITLE, DESCription and LINK do not
1898matter. If DESC is nil it is ignored as well. If
1899`newsticker-desc-comp-max' is non-nil, only the first
1900`newsticker-desc-comp-max' characters of DESC are taken into
1901account.
1902
1903If GUID is non-nil it is sufficient to match this value, and the
1904other properties are ignored."
1905 ;;(newsticker--debug-msg "Looking for %s guid=%s" title guid)
1906 (condition-case nil
1907 (catch 'found
1908 (when (and desc newsticker-desc-comp-max
1909 (> (length desc) newsticker-desc-comp-max))
1910 (setq desc (substring desc 0 newsticker-desc-comp-max)))
1911 (mapc
1912 (lambda (this-feed)
1913 (when (eq (car this-feed) feed)
1914 (mapc (lambda (anitem)
1915 (when (cond (guid
1916 ;; global unique id can match
1917 (string= guid (newsticker--guid anitem)))
1918 (t;;FIXME?
1919 (or
1920 ;; or title, desc, etc.
1921 (and
1922 ;;(or (not (eq age 'feed))
1923 ;; (eq (newsticker--age anitem) 'feed))
1924 (string= (newsticker--title anitem)
1925 title)
1926 (or (not link)
1927 (string= (newsticker--link anitem)
1928 link))
1929 (or (not desc)
1930 (if (and desc newsticker-desc-comp-max
1931 (> (length (newsticker--desc
1932 anitem))
1933 newsticker-desc-comp-max))
1934 (string= (substring
1935 (newsticker--desc anitem)
1936 0
1937 newsticker-desc-comp-max)
1938 desc)
1939 (string= (newsticker--desc anitem)
1940 desc)))))))
1941 ;;(newsticker--debug-msg "Found %s guid=%s"
1942 ;; (newsticker--title anitem)
1943 ;; (newsticker--guid anitem))
1944 (throw 'found anitem)))
1945 (cdr this-feed))))
1946 data)
1947 ;;(newsticker--debug-msg "Found nothing")
1948 nil)
1949 (error nil)))
1950
1951(defun newsticker--cache-add (data feed-name-symbol title desc link time age
1952 position extra-elements
1953 &optional updated-time updated-age
1954 preformatted-contents
1955 preformatted-title)
1956 "Add another item to cache data.
1957Add to DATA in the FEED-NAME-SYMBOL an item with TITLE, DESC,
1958LINK, TIME, AGE, POSITION, and EXTRA-ELEMENTS. If this item is
1959contained already, its time is set to UPDATED-TIME, its mark is
1960set to UPDATED-AGE, and its pre-formatted contents is set to
1961PREFORMATTED-CONTENTS and PREFORMATTED-TITLE. Returns the age
1962which the item got."
1963 (let* ((guid (newsticker--guid-to-string (assoc 'guid extra-elements)))
1964 (item (newsticker--cache-contains data feed-name-symbol title desc link
1965 age guid)))
1966 ;;(message "guid=%s" guid)
1967 (if item
1968 ;; does exist already -- change age, update time and position
1969 (progn
1970 ;;(newsticker--debug-msg "Updating item %s %s %s %s %s -> %s %s
1971 ;; (guid %s -> %s)"
1972 ;; feed-name-symbol title link time age
1973 ;; updated-time updated-age
1974 ;; guid (newsticker--guid item))
1975 (if (nthcdr 5 item)
1976 (setcar (nthcdr 5 item) position)
1977 (setcdr (nthcdr 4 item) (list position)))
1978 (setcar (nthcdr 4 item) updated-age)
1979 (if updated-time
1980 (setcar (nthcdr 3 item) updated-time))
1981 ;; replace cached pre-formatted contents
1982 (newsticker--cache-set-preformatted-contents
1983 item preformatted-contents)
1984 (newsticker--cache-set-preformatted-title
1985 item preformatted-title))
1986 ;; did not exist or age equals 'feed-name-symbol
1987 (setq item (list title desc link time age position preformatted-contents
1988 preformatted-title extra-elements))
1989 ;;(newsticker--debug-msg "Adding item %s" item)
1990 (catch 'found
1991 (mapc (lambda (this-feed)
1992 (when (eq (car this-feed) feed-name-symbol)
1993 (setcdr this-feed (nconc (cdr this-feed) (list item)))
1994 (throw 'found this-feed)))
1995 data)
1996 ;; the feed is not contained
1997 (add-to-list 'data (list feed-name-symbol item) t))))
1998 data)
1999
2000(defun newsticker--cache-remove (data feed-symbol age)
2001 "Remove all entries from DATA in the feed FEED-SYMBOL with AGE.
2002FEED-SYMBOL may be 'any. Entries from old feeds, which are no longer in
2003`newsticker-url-list' or `newsticker-url-list-defaults', are removed as
2004well."
2005 (let* ((pos data)
2006 (feed (car pos))
2007 (last-pos nil))
2008 (while feed
2009 (if (or (assoc (symbol-name (car feed)) newsticker-url-list)
2010 (assoc (symbol-name (car feed)) newsticker-url-list-defaults))
2011 ;; feed is still valid=active
2012 ;; (message "Keeping feed %s" (car feed))
2013 (if (or (eq feed-symbol 'any)
2014 (eq feed-symbol (car feed)))
2015 (let* ((item-pos (cdr feed))
2016 (item (car item-pos))
2017 (prev-pos nil))
2018 (while item
2019 ;;(message "%s" (car item))
2020 (if (eq age (newsticker--age item))
2021 ;; remove this item
2022 (progn
2023 ;;(message "Removing item %s" (car item))
2024 (if prev-pos
2025 (setcdr prev-pos (cdr item-pos))
2026 (setcdr feed (cdr item-pos))))
2027 ;;(message "Keeping item %s" (car item))
2028 (setq prev-pos item-pos))
2029 (setq item-pos (cdr item-pos))
2030 (setq item (car item-pos)))))
2031 ;; feed is not active anymore
2032 ;; (message "Removing feed %s" (car feed))
2033 (if last-pos
2034 (setcdr last-pos (cdr pos))
2035 (setq data (cdr pos))))
2036 (setq last-pos pos)
2037 (setq pos (cdr pos))
2038 (setq feed (car pos)))))
2039
2040;; ======================================================================
2041;;; Sorting
2042;; ======================================================================
2043(defun newsticker--cache-item-compare-by-time (item1 item2)
2044 "Compare two news items ITEM1 and ITEM2 by comparing their time values."
2045 (catch 'result
2046 (let ((age1 (newsticker--age item1))
2047 (age2 (newsticker--age item2)))
2048 (if (not (eq age1 age2))
2049 (cond ((eq age1 'obsolete)
2050 (throw 'result nil))
2051 ((eq age2 'obsolete)
2052 (throw 'result t)))))
2053 (let* ((time1 (newsticker--time item1))
2054 (time2 (newsticker--time item2)))
2055 (cond ((< (nth 0 time1) (nth 0 time2))
2056 nil)
2057 ((> (nth 0 time1) (nth 0 time2))
2058 t)
2059 ((< (nth 1 time1) (nth 1 time2))
2060 nil)
2061 ((> (nth 1 time1) (nth 1 time2))
2062 t)
2063 ((< (or (nth 2 time1) 0) (or (nth 2 time2) 0))
2064 nil)
2065 ((> (or (nth 2 time1) 0) (or (nth 2 time2) 0))
2066 t)
2067 (t
2068 nil)))))
2069
2070(defun newsticker--cache-item-compare-by-title (item1 item2)
2071 "Compare ITEM1 and ITEM2 by comparing their titles."
2072 (catch 'result
2073 (let ((age1 (newsticker--age item1))
2074 (age2 (newsticker--age item2)))
2075 (if (not (eq age1 age2))
2076 (cond ((eq age1 'obsolete)
2077 (throw 'result nil))
2078 ((eq age2 'obsolete)
2079 (throw 'result t)))))
2080 (string< (newsticker--title item1) (newsticker--title item2))))
2081
2082(defun newsticker--cache-item-compare-by-position (item1 item2)
2083 "Compare ITEM1 and ITEM2 by comparing their original positions."
2084 (catch 'result
2085 (let ((age1 (newsticker--age item1))
2086 (age2 (newsticker--age item2)))
2087 (if (not (eq age1 age2))
2088 (cond ((eq age1 'obsolete)
2089 (throw 'result nil))
2090 ((eq age2 'obsolete)
2091 (throw 'result t)))))
2092 (< (or (newsticker--pos item1) 0) (or (newsticker--pos item2) 0))))
2093
2094
2095
2096(defun newsticker--cache-save ()
2097 "Update and save newsticker cache file."
2098 (interactive)
2099 (newsticker--cache-update t))
2100
2101(defun newsticker--cache-update (&optional save)
2102 "Update newsticker cache file.
2103If optional argument SAVE is not nil the cache file is saved to disk."
2104 (save-excursion
2105 (let ((coding-system-for-write 'utf-8))
2106 (with-temp-buffer
2107 (setq buffer-undo-list t)
2108 (erase-buffer)
2109 (insert ";; -*- coding: utf-8 -*-\n")
2110 (insert (prin1-to-string newsticker--cache))
2111 (when save
2112 (set-visited-file-name newsticker-cache-filename)
2113 (save-buffer))))))
2114
2115(defun newsticker--cache-get-feed (feed)
2116 "Return the cached data for the feed FEED.
2117FEED is a symbol!"
2118 (assoc feed newsticker--cache))
2119
2120;; ======================================================================
2121;;; Statistics
2122;; ======================================================================
2123(defun newsticker--stat-num-items (feed &rest ages)
2124 "Return number of items in the given FEED which have one of the given AGES.
2125If AGES is nil, the total number of items is returned."
2126 (let ((items (cdr (newsticker--cache-get-feed feed)))
2127 (num 0))
2128 (while items
2129 (if ages
2130 (if (memq (newsticker--age (car items)) ages)
2131 (setq num (1+ num)))
2132 (if (memq (newsticker--age (car items)) '(new old immortal obsolete))
2133 (setq num (1+ num))))
2134 (setq items (cdr items)))
2135 num))
2136
2137(defun newsticker--stat-num-items-total (&optional age)
2138 "Return total number of items in all feeds which have the given AGE.
2139If AGE is nil, the total number of items is returned."
2140 (apply '+
2141 (mapcar (lambda (feed)
2142 (if age
2143 (newsticker--stat-num-items (intern (car feed)) age)
2144 (newsticker--stat-num-items (intern (car feed)))))
2145 (append newsticker-url-list-defaults newsticker-url-list))))
2146
2147;; ======================================================================
2148;;; OPML
2149;; ======================================================================
2150(defun newsticker-opml-export ()
2151 "OPML subscription export.
2152Export subscriptions to a buffer in OPML Format."
2153 (interactive)
2154 (with-current-buffer (get-buffer-create "*OPML Export*")
2155 (set-buffer-file-coding-system 'utf-8)
2156 (insert (concat
2157 "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
2158 "<!-- OPML generated by Emacs newsticker.el -->\n"
2159 "<opml version=\"1.0\">\n"
2160 " <head>\n"
2161 " <title>mySubscriptions</title>\n"
2162 " <dateCreated>" (format-time-string "%a, %d %b %Y %T %z")
2163 "</dateCreated>\n"
2164 " <ownerEmail>" user-mail-address "</ownerEmail>\n"
2165 " <ownerName>" (user-full-name) "</ownerName>\n"
2166 " </head>\n"
2167 " <body>\n"))
2168 (mapc (lambda (sub)
2169 (insert " <outline text=\"")
2170 (insert (newsticker--title sub))
2171 (insert "\" xmlUrl=\"")
2172 (insert (cadr sub))
2173 (insert "\"/>\n"))
2174 (append newsticker-url-list newsticker-url-list-defaults))
2175 (insert " </body>\n</opml>\n"))
2176 (pop-to-buffer "*OPML Export*")
2177 (when (fboundp 'sgml-mode)
2178 (sgml-mode)))
2179
2180(defun newsticker--opml-import-outlines (outlines)
2181 "Recursively import OUTLINES from OPML data.
2182Note that nested outlines are currently flattened -- i.e. grouping is
2183removed."
2184 (mapc (lambda (outline)
2185 (let ((name (xml-get-attribute outline 'text))
2186 (url (xml-get-attribute outline 'xmlUrl))
2187 (children (xml-get-children outline 'outline)))
2188 (unless (string= "" url)
2189 (add-to-list 'newsticker-url-list
2190 (list name url nil nil nil) t))
2191 (if children
2192 (newsticker--opml-import-outlines children))))
2193 outlines))
2194
2195(defun newsticker-opml-import (filename)
2196 "Import OPML data from FILENAME."
2197 (interactive "fOPML file: ")
2198 (set-buffer (find-file-noselect filename))
2199 (goto-char (point-min))
2200 (let* ((node-list (xml-parse-region (point-min) (point-max)))
2201 (body (car (xml-get-children (car node-list) 'body)))
2202 (outlines (xml-get-children body 'outline)))
2203 (newsticker--opml-import-outlines outlines))
2204 (customize-variable 'newsticker-url-list))
2205
2206;; ======================================================================
2207;;; Auto marking
2208;; ======================================================================
2209(defun newsticker--run-auto-mark-filter (feed item)
2210 "Automatically mark an item as old or immortal.
2211This function checks the variable `newsticker-auto-mark-filter-list'
2212for an entry that matches FEED and ITEM."
2213 (let ((case-fold-search t))
2214 (mapc (lambda (filter)
2215 (let ((filter-feed (car filter))
2216 (pattern-list (cadr filter)))
2217 (when (string-match filter-feed feed)
2218 (newsticker--do-run-auto-mark-filter item pattern-list))))
2219 newsticker-auto-mark-filter-list)))
2220
2221(defun newsticker--do-run-auto-mark-filter (item list)
2222 "Actually compare ITEM against the pattern-LIST.
2223LIST must be an element of `newsticker-auto-mark-filter-list'."
2224 (mapc (lambda (pattern)
2225 (let ((age (nth 0 pattern))
2226 (place (nth 1 pattern))
2227 (regexp (nth 2 pattern))
2228 (title (newsticker--title item))
2229 (desc (newsticker--desc item)))
2230 (when (or (eq place 'title) (eq place 'all))
2231 (when (and title (string-match regexp title))
2232 (newsticker--debug-msg "Auto-marking as %s: `%s'"
2233 age (newsticker--title item))
2234 (setcar (nthcdr 4 item) age)))
2235 (when (or (eq place 'description) (eq place 'all))
2236 (when (and desc (string-match regexp desc))
2237 (newsticker--debug-msg "Auto-marking as %s: `%s'"
2238 age (newsticker--title item))
2239 (setcar (nthcdr 4 item) age)))))
2240 list))
2241
2242
2243;; ======================================================================
2244;;; Hook samples
2245;; ======================================================================
2246(defun newsticker-new-item-functions-sample (feed item)
2247 "Demonstrate the use of the `newsticker-new-item-functions' hook.
2248This function just prints out the values of the FEED and title of the ITEM."
2249 (message (concat "newsticker-new-item-functions-sample: feed=`%s', "
2250 "title=`%s'")
2251 feed (newsticker--title item)))
2252
2253(defun newsticker-download-images (feed item)
2254 "Download the first image.
2255If FEED equals \"imagefeed\" download the first image URL found
2256in the description=contents of ITEM to the directory
2257\"~/tmp/newsticker/FEED/TITLE\" where TITLE is the title of the item."
2258 (when (string= feed "imagefeed")
2259 (let ((title (newsticker--title item))
2260 (desc (newsticker--desc item)))
2261 (when (string-match "<img src=\"\\(http://[^ \"]+\\)\"" desc)
2262 (let ((url (substring desc (match-beginning 1) (match-end 1)))
2263 (temp-dir (concat "~/tmp/newsticker/" feed "/" title))
2264 (org-dir default-directory))
2265 (unless (file-directory-p temp-dir)
2266 (make-directory temp-dir t))
2267 (cd temp-dir)
2268 (message "Getting image %s" url)
2269 (apply 'start-process "wget-image"
2270 " *newsticker-wget-download-images*"
2271 newsticker-wget-name
2272 (list url))
2273 (cd org-dir))))))
2274
2275(defun newsticker-download-enclosures (feed item)
2276 "In all FEEDs download the enclosed object of the news ITEM.
2277The object is saved to the directory \"~/tmp/newsticker/FEED/TITLE\", which
2278is created if it does not exist. TITLE is the title of the news
2279item. Argument FEED is ignored.
2280This function is suited for adding it to `newsticker-new-item-functions'."
2281 (let ((title (newsticker--title item))
2282 (enclosure (newsticker--enclosure item)))
2283 (when enclosure
2284 (let ((url (cdr (assoc 'url enclosure)))
2285 (temp-dir (concat "~/tmp/newsticker/" feed "/" title))
2286 (org-dir default-directory))
2287 (unless (file-directory-p temp-dir)
2288 (make-directory temp-dir t))
2289 (cd temp-dir)
2290 (message "Getting enclosure %s" url)
2291 (apply 'start-process "wget-enclosure"
2292 " *newsticker-wget-download-enclosures*"
2293 newsticker-wget-name
2294 (list url))
2295 (cd org-dir)))))
2296
2297;; ======================================================================
2298;;; Retrieve samples
2299;; ======================================================================
2300(defun newsticker-retrieve-random-message (feed-name)
2301 "Return an artificial RSS string under the name FEED-NAME."
2302 (concat "<?xml version=\"1.0\" encoding=\"iso-8859-1\" ?><rss version=\"0.91\">"
2303 "<channel>"
2304 "<title>newsticker-retrieve-random-message</title>"
2305 "<description>Sample retrieval function</description>"
2306 "<pubDate>FIXME Sat, 07 Sep 2005 00:00:01 GMT</pubDate>"
2307 "<item><title>" (format "Your lucky number is %d" (random 10000))
2308 "</title><description>" (format "Or maybe it is %d" (random 10000))
2309 "</description></item></channel></rss>"))
2310
2311(provide 'newsticker-backend)
2312
2313;;; newsticker-backend.el ends here
diff --git a/lisp/net/newsticker-plainview.el b/lisp/net/newsticker-plainview.el
new file mode 100644
index 00000000000..deccd4a0f5e
--- /dev/null
+++ b/lisp/net/newsticker-plainview.el
@@ -0,0 +1,1823 @@
1;;; newsticker-plainview.el --- Single buffer frontend for newsticker.
2
3;; Copyright (C) 2008 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; Author: Ulf Jasper <ulf.jasper@web.de>
8;; Filename: newsticker-plainview.el
9;; URL: http://www.nongnu.org/newsticker
10;; Time-stamp: "7. Juni 2008, 23:37:09 (ulf)"
11;; CVS-Version: $Id: newsticker-plainview.el,v 1.10 2008/05/04 15:04:34 u11 Exp $
12
13;; ======================================================================
14
15;; GNU Emacs is free software: you can redistribute it and/or modify
16;; it under the terms of the GNU General Public License as published by
17;; the Free Software Foundation, either version 3 of the License, or
18;; (at your option) any later version.
19
20;; GNU Emacs is distributed in the hope that it will be useful,
21;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23;; GNU General Public License for more details.
24
25;; You should have received a copy of the GNU General Public License
26;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27
28;; ======================================================================
29;;; Commentary:
30
31;; See newsticker.el
32
33;; ======================================================================
34;;; Code:
35
36(require 'newsticker-ticker)
37(require 'newsticker-reader)
38(require 'derived)
39(require 'xml)
40
41;; Silence warnings
42(defvar tool-bar-map)
43(defvar w3-mode-map)
44(defvar w3m-minor-mode-map)
45
46;; ======================================================================
47;;; Customization
48;; ======================================================================
49(defgroup newsticker-plainview nil
50 "Settings for the simple plain view reader.
51See also `newsticker-plainview-hooks'."
52 :group 'newsticker-reader)
53
54
55(defun newsticker--set-customvar-buffer (symbol value)
56 "Set newsticker-variable SYMBOL value to VALUE.
57Calls all actions which are necessary in order to make the new
58value effective."
59 (if (or (not (boundp symbol))
60 (equal (symbol-value symbol) value))
61 (set symbol value)
62 ;; something must have changed
63 (set symbol value)
64 (newsticker--buffer-set-uptodate nil)))
65
66(defun newsticker--set-customvar-sorting (symbol value)
67 "Set newsticker-variable SYMBOL value to VALUE.
68Calls all actions which are necessary in order to make the new
69value effective."
70 (if (or (not (boundp symbol))
71 (equal (symbol-value symbol) value))
72 (set symbol value)
73 ;; something must have changed
74 (set symbol value)
75 (message "Applying new sort method...")
76 (when (fboundp 'newsticker--cache-sort) (newsticker--cache-sort))
77 (when (fboundp 'newsticker--buffer-set-uptodate)
78 (newsticker--buffer-set-uptodate nil))
79 (message "Applying new sort method...done")))
80
81(defcustom newsticker-sort-method
82 'sort-by-original-order
83 "Sort method for news items.
84The following sort methods are available:
85* `sort-by-original-order' keeps the order in which the items
86 appear in the headline file (please note that for immortal items,
87 which have been removed from the news feed, there is no original
88 order),
89* `sort-by-time' looks at the time at which an item has been seen
90 the first time. The most recent item is put at top,
91* `sort-by-title' will put the items in an alphabetical order."
92 :type '(choice
93 (const :tag "Keep original order" sort-by-original-order)
94 (const :tag "Sort by time" sort-by-time)
95 (const :tag "Sort by title" sort-by-title))
96 :set 'newsticker--set-customvar-sorting
97 :group 'newsticker-plainview)
98
99(defcustom newsticker-heading-format
100 "%l
101%t %d %s"
102 "Format string for feed headings.
103The following printf-like specifiers can be used:
104%d The date the feed was retrieved. See `newsticker-date-format'.
105%l The logo (image) of the feed. Most news feeds provide a small
106 image as logo. Newsticker can display them, if Emacs can --
107 see `image-types' for a list of supported image types.
108%L The logo (image) of the feed. If the logo is not available
109 the title of the feed is used.
110%s The statistical data of the feed. See `newsticker-statistics-format'.
111%t The title of the feed, i.e. its name."
112 :type 'string
113 :set 'newsticker--set-customvar-formatting
114 :group 'newsticker-plainview)
115
116(defcustom newsticker-item-format
117 "%t %d"
118 "Format string for news item headlines.
119The following printf-like specifiers can be used:
120%d The date the item was (first) retrieved. See `newsticker-date-format'.
121%l The logo (image) of the feed. Most news feeds provide a small
122 image as logo. Newsticker can display them, if Emacs can --
123 see `image-types' for a list of supported image types.
124%L The logo (image) of the feed. If the logo is not available
125 the title of the feed is used.
126%t The title of the item."
127 :type 'string
128 :set 'newsticker--set-customvar-formatting
129 :group 'newsticker-plainview)
130
131(defcustom newsticker-desc-format
132 "%d %c"
133 "Format string for news descriptions (contents).
134The following printf-like specifiers can be used:
135%c The contents (description) of the item.
136%d The date the item was (first) retrieved. See
137 `newsticker-date-format'."
138 :type 'string
139 :set 'newsticker--set-customvar-formatting
140 :group 'newsticker-plainview)
141
142(defcustom newsticker-statistics-format
143 "[%n + %i + %o + %O = %a]"
144 "Format for the statistics part in feed lines.
145The following printf-like specifiers can be used:
146%a The number of all items in the feed.
147%i The number of immortal items in the feed.
148%n The number of new items in the feed.
149%o The number of old items in the feed.
150%O The number of obsolete items in the feed."
151 :type 'string
152 :set 'newsticker--set-customvar-formatting
153 :group 'newsticker-plainview)
154
155
156;; ======================================================================
157;; faces
158(defgroup newsticker-faces nil
159 "Settings for the faces of the feed reader."
160 :group 'newsticker-plainview)
161
162(defface newsticker-feed-face
163 '((((class color) (background dark))
164 (:family "helvetica" :bold t :height 1.2 :foreground "misty rose"))
165 (((class color) (background light))
166 (:family "helvetica" :bold t :height 1.2 :foreground "black")))
167 "Face for news feeds."
168 :group 'newsticker-faces)
169
170(defface newsticker-new-item-face
171 '((((class color) (background dark))
172 (:family "helvetica" :bold t))
173 (((class color) (background light))
174 (:family "helvetica" :bold t)))
175 "Face for new news items."
176 :group 'newsticker-faces)
177
178(defface newsticker-old-item-face
179 '((((class color) (background dark))
180 (:family "helvetica" :bold t :foreground "orange3"))
181 (((class color) (background light))
182 (:family "helvetica" :bold t :foreground "red4")))
183 "Face for old news items."
184 :group 'newsticker-faces)
185
186(defface newsticker-immortal-item-face
187 '((((class color) (background dark))
188 (:family "helvetica" :bold t :italic t :foreground "orange"))
189 (((class color) (background light))
190 (:family "helvetica" :bold t :italic t :foreground "blue")))
191 "Face for immortal news items."
192 :group 'newsticker-faces)
193
194(defface newsticker-obsolete-item-face
195 '((((class color) (background dark))
196 (:family "helvetica" :bold t :strike-through t))
197 (((class color) (background light))
198 (:family "helvetica" :bold t :strike-through t)))
199 "Face for old news items."
200 :group 'newsticker-faces)
201
202(defface newsticker-date-face
203 '((((class color) (background dark))
204 (:family "helvetica" :italic t :height 0.8))
205 (((class color) (background light))
206 (:family "helvetica" :italic t :height 0.8)))
207 "Face for newsticker dates."
208 :group 'newsticker-faces)
209
210(defface newsticker-statistics-face
211 '((((class color) (background dark))
212 (:family "helvetica" :italic t :height 0.8))
213 (((class color) (background light))
214 (:family "helvetica" :italic t :height 0.8)))
215 "Face for newsticker dates."
216 :group 'newsticker-faces)
217
218(defface newsticker-enclosure-face
219 '((((class color) (background dark))
220 (:bold t :background "orange"))
221 (((class color) (background light))
222 (:bold t :background "orange")))
223 "Face for enclosed elements."
224 :group 'newsticker-faces)
225
226(defface newsticker-extra-face
227 '((((class color) (background dark))
228 (:italic t :foreground "gray50" :height 0.8))
229 (((class color) (background light))
230 (:italic t :foreground "gray50" :height 0.8)))
231 "Face for newsticker dates."
232 :group 'newsticker-faces)
233
234(defface newsticker-default-face
235 '((((class color) (background dark))
236 (:inherit default))
237 (((class color) (background light))
238 (:inherit default)))
239 "Face for the description of news items."
240 ;;:set 'newsticker--set-customvar
241 :group 'newsticker-faces)
242
243(defcustom newsticker-hide-old-items-in-newsticker-buffer
244 nil
245 "Decides whether to automatically hide old items in the *newsticker* buffer.
246If set to t old items will be completely folded and only new
247items will show up in the *newsticker* buffer. Otherwise old as
248well as new items will be visible."
249 :type 'boolean
250 :set 'newsticker--set-customvar-buffer
251 :group 'newsticker-plainview)
252
253(defcustom newsticker-show-descriptions-of-new-items
254 t
255 "Whether to automatically show descriptions of new items in *newsticker*.
256If set to t old items will be folded and new items will be
257unfolded. Otherwise old as well as new items will be folded."
258 :type 'boolean
259 :set 'newsticker--set-customvar-buffer
260 :group 'newsticker-plainview)
261
262(defcustom newsticker-show-all-news-elements
263 nil
264 "Show all news elements."
265 :type 'boolean
266 ;;:set 'newsticker--set-customvar
267 :group 'newsticker-plainview)
268
269;; ======================================================================
270;; hooks
271(defgroup newsticker-plainview-hooks nil
272 "Settings for newsticker hooks which apply to plainview only."
273 :group 'newsticker-hooks)
274
275(defcustom newsticker-select-item-hook
276 'newsticker--buffer-make-item-completely-visible
277 "List of functions run after a headline has been selected.
278Each function is called after one of `newsticker-next-item',
279`newsticker-next-new-item', `newsticker-previous-item',
280`newsticker-previous-new-item' has been called.
281
282The default value 'newsticker--buffer-make-item-completely-visible
283assures that the current item is always completely visible."
284 :type 'hook
285 :options '(newsticker--buffer-make-item-completely-visible)
286 :group 'newsticker-plainview-hooks)
287
288(defcustom newsticker-select-feed-hook
289 'newsticker--buffer-make-item-completely-visible
290 "List of functions run after a feed has been selected.
291Each function is called after one of `newsticker-next-feed', and
292`newsticker-previous-feed' has been called.
293
294The default value 'newsticker--buffer-make-item-completely-visible
295assures that the current feed is completely visible."
296 :type 'hook
297 :options '(newsticker--buffer-make-item-completely-visible)
298 :group 'newsticker-plainview-hooks)
299
300(defcustom newsticker-buffer-change-hook
301 'newsticker-w3m-show-inline-images
302 "List of functions run after the newsticker buffer has been updated.
303Each function is called after `newsticker-buffer-update' has been called.
304
305The default value '`newsticker-w3m-show-inline-images' loads inline
306images."
307 :type 'hook
308 :group 'newsticker-plainview-hooks)
309
310(defcustom newsticker-narrow-hook
311 'newsticker-w3m-show-inline-images
312 "List of functions run after narrowing in newsticker buffer has changed.
313Each function is called after
314`newsticker-toggle-auto-narrow-to-feed' or
315`newsticker-toggle-auto-narrow-to-item' has been called.
316
317The default value '`newsticker-w3m-show-inline-images' loads inline
318images."
319 :type 'hook
320 :group 'newsticker-plainview-hooks)
321
322;; ======================================================================
323;;; Toolbar
324;; ======================================================================
325
326(defvar newsticker--plainview-tool-bar-map
327 (if (featurep 'xemacs)
328 nil
329 (let ((tool-bar-map (make-sparse-keymap)))
330 (define-key tool-bar-map [newsticker-sep-1]
331 (list 'menu-item "--double-line"))
332 (define-key tool-bar-map [newsticker-browse-url]
333 (list 'menu-item "newsticker-browse-url" 'newsticker-browse-url
334 :visible t
335 :help "Browse URL for item at point"
336 :image newsticker--browse-image))
337 (define-key tool-bar-map [newsticker-buffer-force-update]
338 (list 'menu-item "newsticker-buffer-force-update"
339 'newsticker-buffer-force-update
340 :visible t
341 :help "Update newsticker buffer"
342 :image newsticker--update-image
343 :enable '(not newsticker--buffer-uptodate-p)))
344 (define-key tool-bar-map [newsticker-get-all-news]
345 (list 'menu-item "newsticker-get-all-news" 'newsticker-get-all-news
346 :visible t
347 :help "Get news for all feeds"
348 :image newsticker--get-all-image))
349 (define-key tool-bar-map [newsticker-mark-item-at-point-as-read]
350 (list 'menu-item "newsticker-mark-item-at-point-as-read"
351 'newsticker-mark-item-at-point-as-read
352 :visible t
353 :image newsticker--mark-read-image
354 :help "Mark current item as read"
355 :enable '(newsticker-item-not-old-p)))
356 (define-key tool-bar-map [newsticker-mark-item-at-point-as-immortal]
357 (list 'menu-item "newsticker-mark-item-at-point-as-immortal"
358 'newsticker-mark-item-at-point-as-immortal
359 :visible t
360 :image newsticker--mark-immortal-image
361 :help "Mark current item as immortal"
362 :enable '(newsticker-item-not-immortal-p)))
363 (define-key tool-bar-map [newsticker-toggle-auto-narrow-to-feed]
364 (list 'menu-item "newsticker-toggle-auto-narrow-to-feed"
365 'newsticker-toggle-auto-narrow-to-feed
366 :visible t
367 :help "Toggle visibility of other feeds"
368 :image newsticker--narrow-image))
369 (define-key tool-bar-map [newsticker-next-feed]
370 (list 'menu-item "newsticker-next-feed" 'newsticker-next-feed
371 :visible t
372 :help "Go to next feed"
373 :image newsticker--next-feed-image
374 :enable '(newsticker-next-feed-available-p)))
375 (define-key tool-bar-map [newsticker-next-item]
376 (list 'menu-item "newsticker-next-item" 'newsticker-next-item
377 :visible t
378 :help "Go to next item"
379 :image newsticker--next-item-image
380 :enable '(newsticker-next-item-available-p)))
381 (define-key tool-bar-map [newsticker-previous-item]
382 (list 'menu-item "newsticker-previous-item" 'newsticker-previous-item
383 :visible t
384 :help "Go to previous item"
385 :image newsticker--previous-item-image
386 :enable '(newsticker-previous-item-available-p)))
387 (define-key tool-bar-map [newsticker-previous-feed]
388 (list 'menu-item "newsticker-previous-feed" 'newsticker-previous-feed
389 :visible t
390 :help "Go to previous feed"
391 :image newsticker--previous-feed-image
392 :enable '(newsticker-previous-feed-available-p)))
393 ;; standard icons / actions
394 (tool-bar-add-item "close"
395 'newsticker-close-buffer
396 'newsticker-close-buffer
397 :help "Close newsticker buffer")
398 (tool-bar-add-item "preferences"
399 'newsticker-customize
400 'newsticker-customize
401 :help "Customize newsticker")
402 tool-bar-map)))
403
404;; ======================================================================
405;;; Newsticker mode
406;; ======================================================================
407
408(define-derived-mode newsticker-mode fundamental-mode
409 "NewsTicker"
410 "Viewing news feeds in Emacs."
411 (set (make-local-variable 'tool-bar-map) newsticker--plainview-tool-bar-map)
412 (set (make-local-variable 'imenu-sort-function) nil)
413 (set (make-local-variable 'scroll-conservatively) 999)
414 (setq imenu-create-index-function 'newsticker--imenu-create-index)
415 (setq imenu-default-goto-function 'newsticker--imenu-goto)
416 (setq buffer-read-only t)
417 (auto-fill-mode -1) ;; turn auto-fill off!
418 (font-lock-mode -1) ;; turn off font-lock!!
419 (set (make-local-variable 'font-lock-defaults) nil)
420 (set (make-local-variable 'line-move-ignore-invisible) t)
421 (setq mode-line-format
422 (list "-"
423 'mode-line-mule-info
424 'mode-line-modified
425 'mode-line-frame-identification
426 " Newsticker ("
427 '(newsticker--buffer-uptodate-p
428 "up to date"
429 "NEED UPDATE")
430 ") "
431 '(:eval (format "[%d]" (length newsticker--process-ids)))
432 " -- "
433 '(:eval (newsticker--buffer-get-feed-title-at-point))
434 ": "
435 '(:eval (newsticker--buffer-get-item-title-at-point))
436 " %-"))
437 (add-to-invisibility-spec 't)
438 (unless newsticker-show-all-news-elements
439 (add-to-invisibility-spec 'extra))
440 (newsticker--buffer-set-uptodate nil))
441
442;; refine its mode-map
443(define-key newsticker-mode-map "sO" 'newsticker-show-old-items)
444(define-key newsticker-mode-map "hO" 'newsticker-hide-old-items)
445(define-key newsticker-mode-map "sa" 'newsticker-show-all-desc)
446(define-key newsticker-mode-map "ha" 'newsticker-hide-all-desc)
447(define-key newsticker-mode-map "sf" 'newsticker-show-feed-desc)
448(define-key newsticker-mode-map "hf" 'newsticker-hide-feed-desc)
449(define-key newsticker-mode-map "so" 'newsticker-show-old-item-desc)
450(define-key newsticker-mode-map "ho" 'newsticker-hide-old-item-desc)
451(define-key newsticker-mode-map "sn" 'newsticker-show-new-item-desc)
452(define-key newsticker-mode-map "hn" 'newsticker-hide-new-item-desc)
453(define-key newsticker-mode-map "se" 'newsticker-show-entry)
454(define-key newsticker-mode-map "he" 'newsticker-hide-entry)
455(define-key newsticker-mode-map "sx" 'newsticker-show-extra)
456(define-key newsticker-mode-map "hx" 'newsticker-hide-extra)
457
458(define-key newsticker-mode-map " " 'scroll-up)
459(define-key newsticker-mode-map "q" 'newsticker-close-buffer)
460(define-key newsticker-mode-map "p" 'newsticker-previous-item)
461(define-key newsticker-mode-map "P" 'newsticker-previous-new-item)
462(define-key newsticker-mode-map "F" 'newsticker-previous-feed)
463(define-key newsticker-mode-map "\t" 'newsticker-next-item)
464(define-key newsticker-mode-map "n" 'newsticker-next-item)
465(define-key newsticker-mode-map "N" 'newsticker-next-new-item)
466(define-key newsticker-mode-map "f" 'newsticker-next-feed)
467(define-key newsticker-mode-map "M" 'newsticker-mark-all-items-as-read)
468(define-key newsticker-mode-map "m"
469 'newsticker-mark-all-items-at-point-as-read-and-redraw)
470(define-key newsticker-mode-map "o"
471 'newsticker-mark-item-at-point-as-read)
472(define-key newsticker-mode-map "O"
473 'newsticker-mark-all-items-at-point-as-read)
474(define-key newsticker-mode-map "G" 'newsticker-get-all-news)
475(define-key newsticker-mode-map "g" 'newsticker-get-news-at-point)
476(define-key newsticker-mode-map "u" 'newsticker-buffer-update)
477(define-key newsticker-mode-map "U" 'newsticker-buffer-force-update)
478(define-key newsticker-mode-map "a" 'newsticker-add-url)
479
480(define-key newsticker-mode-map "i"
481 'newsticker-mark-item-at-point-as-immortal)
482
483(define-key newsticker-mode-map "xf"
484 'newsticker-toggle-auto-narrow-to-feed)
485(define-key newsticker-mode-map "xi"
486 'newsticker-toggle-auto-narrow-to-item)
487
488;; maps for the clickable portions
489(defvar newsticker--url-keymap (make-sparse-keymap)
490 "Key map for click-able headings in the newsticker buffer.")
491(define-key newsticker--url-keymap [mouse-1]
492 'newsticker-mouse-browse-url)
493(define-key newsticker--url-keymap [mouse-2]
494 'newsticker-mouse-browse-url)
495(define-key newsticker--url-keymap "\n"
496 'newsticker-browse-url)
497(define-key newsticker--url-keymap "\C-m"
498 'newsticker-browse-url)
499(define-key newsticker--url-keymap [(control return)]
500 'newsticker-handle-url)
501
502;; newsticker menu
503(defvar newsticker-menu (make-sparse-keymap "Newsticker"))
504
505(define-key newsticker-menu [newsticker-browse-url]
506 '("Browse URL for item at point" . newsticker-browse-url))
507(define-key newsticker-menu [newsticker-separator-1]
508 '("--"))
509(define-key newsticker-menu [newsticker-buffer-update]
510 '("Update buffer" . newsticker-buffer-update))
511(define-key newsticker-menu [newsticker-separator-2]
512 '("--"))
513(define-key newsticker-menu [newsticker-get-all-news]
514 '("Get news from all feeds" . newsticker-get-all-news))
515(define-key newsticker-menu [newsticker-get-news-at-point]
516 '("Get news from feed at point" . newsticker-get-news-at-point))
517(define-key newsticker-menu [newsticker-separator-3]
518 '("--"))
519(define-key newsticker-menu [newsticker-mark-all-items-as-read]
520 '("Mark all items as read" . newsticker-mark-all-items-as-read))
521(define-key newsticker-menu [newsticker-mark-all-items-at-point-as-read]
522 '("Mark all items in feed at point as read" .
523 newsticker-mark-all-items-at-point-as-read))
524(define-key newsticker-menu [newsticker-mark-item-at-point-as-read]
525 '("Mark item at point as read" .
526 newsticker-mark-item-at-point-as-read))
527(define-key newsticker-menu [newsticker-mark-item-at-point-as-immortal]
528 '("Toggle immortality for item at point" .
529 newsticker-mark-item-at-point-as-immortal))
530(define-key newsticker-menu [newsticker-separator-4]
531 '("--"))
532(define-key newsticker-menu [newsticker-toggle-auto-narrow-to-item]
533 '("Narrow to single item" . newsticker-toggle-auto-narrow-to-item))
534(define-key newsticker-menu [newsticker-toggle-auto-narrow-to-feed]
535 '("Narrow to single news feed" . newsticker-toggle-auto-narrow-to-feed))
536(define-key newsticker-menu [newsticker-hide-old-items]
537 '("Hide old items" . newsticker-hide-old-items))
538(define-key newsticker-menu [newsticker-show-old-items]
539 '("Show old items" . newsticker-show-old-items))
540(define-key newsticker-menu [newsticker-next-item]
541 '("Go to next item" . newsticker-next-item))
542(define-key newsticker-menu [newsticker-previous-item]
543 '("Go to previous item" . newsticker-previous-item))
544
545;; bind menu to mouse
546(define-key newsticker-mode-map [down-mouse-3] newsticker-menu)
547;; Put menu in menu-bar
548(define-key newsticker-mode-map [menu-bar Newsticker]
549 (cons "Newsticker" newsticker-menu))
550
551
552;; ======================================================================
553;;; User fun
554;; ======================================================================
555(defun newsticker-plainview ()
556 "Start newsticker plainview."
557 (interactive)
558 (newsticker-buffer-update t)
559 (switch-to-buffer "*newsticker*"))
560
561(defun newsticker-buffer-force-update ()
562 "Update the newsticker buffer, even if not necessary."
563 (interactive)
564 (newsticker-buffer-update t))
565
566(defun newsticker-buffer-update (&optional force)
567 "Update the *newsticker* buffer.
568Unless FORCE is t this is done only if necessary, i.e. when the
569*newsticker* buffer is not up-to-date."
570 (interactive)
571 ;; bring cache data into proper order....
572 (newsticker--cache-sort)
573 ;; fill buffer
574 (save-excursion
575 (let ((buf (get-buffer "*newsticker*")))
576 (if buf
577 (switch-to-buffer buf)
578 (switch-to-buffer (get-buffer-create "*newsticker*"))
579 (newsticker--buffer-set-uptodate nil)))
580 (when (or force
581 (not newsticker--buffer-uptodate-p))
582 (message "Preparing newsticker buffer...")
583 (setq buffer-undo-list t)
584 (let ((inhibit-read-only t))
585 (set-buffer-modified-p nil)
586 (erase-buffer)
587 (newsticker-mode)
588 ;; Emacs 21.3.50 does not care if we turn off auto-fill in the
589 ;; definition of newsticker-mode, so we do it here (again)
590 (auto-fill-mode -1)
591
592 (set-buffer-file-coding-system 'utf-8)
593
594 (if newsticker-use-full-width
595 (set (make-local-variable 'fill-column) (1- (window-width))))
596 (newsticker--buffer-insert-all-items)
597
598 ;; FIXME: needed for methods buffer in ecb
599 ;; (set-visited-file-name "*newsticker*")
600
601 (set-buffer-modified-p nil)
602 (newsticker-hide-all-desc)
603 (if newsticker-hide-old-items-in-newsticker-buffer
604 (newsticker-hide-old-items))
605 (if newsticker-show-descriptions-of-new-items
606 (newsticker-show-new-item-desc))
607 )
608 (message ""))
609 (newsticker--buffer-set-uptodate t)
610 (run-hooks 'newsticker-buffer-change-hook)))
611
612(defun newsticker-get-news-at-point ()
613 "Launch retrieval of news for the feed point is in.
614This does NOT start the retrieval timers."
615 (interactive)
616 ;; launch retrieval of news
617 (let ((feed (get-text-property (point) 'feed)))
618 (when feed
619 (newsticker--debug-msg "Getting news for %s" (symbol-name feed))
620 (newsticker-get-news (symbol-name feed)))))
621
622(defun newsticker-w3m-show-inline-images ()
623 "Show inline images in visible text ranges.
624In-line images in invisible text ranges are hidden. This function
625calls `w3m-toggle-inline-image'. It works only if
626`newsticker-html-renderer' is set to `w3m-region'."
627 (interactive)
628 (if (eq newsticker-html-renderer 'w3m-region)
629 (let ((inhibit-read-only t))
630 (save-excursion
631 (save-restriction
632 (widen)
633 (goto-char (point-min))
634 (let ((pos (point)))
635 (while pos
636 (setq pos (next-single-property-change pos 'w3m-image))
637 (when pos
638 (goto-char pos)
639 (when (get-text-property pos 'w3m-image)
640 (let ((invis (newsticker--lists-intersect-p
641 (get-text-property (1- (point))
642 'invisible)
643 buffer-invisibility-spec)))
644 (unless (car (get-text-property (1- (point))
645 'display))
646 (unless invis
647 (w3m-toggle-inline-image t)))))))))))))
648
649;; ======================================================================
650;;; Keymap stuff
651;; ======================================================================
652(defun newsticker-close-buffer ()
653 "Close the newsticker buffer."
654 (interactive)
655 (newsticker--cache-update t)
656 (bury-buffer))
657
658(defun newsticker-next-new-item (&optional do-not-wrap-at-eob)
659 "Go to next new news item.
660If no new item is found behind point, search is continued at
661beginning of buffer unless optional argument DO-NOT-WRAP-AT-EOB
662is non-nil."
663 (interactive)
664 (widen)
665 (let ((go-ahead t))
666 (while go-ahead
667 (unless (newsticker--buffer-goto '(item) 'new)
668 ;; found nothing -- wrap
669 (unless do-not-wrap-at-eob
670 (goto-char (point-min))
671 (newsticker-next-new-item t))
672 (setq go-ahead nil))
673 (unless (newsticker--lists-intersect-p
674 (get-text-property (point) 'invisible)
675 buffer-invisibility-spec)
676 ;; this item is invisible -- continue search
677 (setq go-ahead nil))))
678 (run-hooks 'newsticker-select-item-hook)
679 (point))
680
681(defun newsticker-previous-new-item (&optional do-not-wrap-at-bob)
682 "Go to previous new news item.
683If no new item is found before point, search is continued at
684beginning of buffer unless optional argument DO-NOT-WRAP-AT-BOB
685is non-nil."
686 (interactive)
687 (widen)
688 (let ((go-ahead t))
689 (while go-ahead
690 (unless (newsticker--buffer-goto '(item) 'new t)
691 (unless do-not-wrap-at-bob
692 (goto-char (point-max))
693 (newsticker--buffer-goto '(item) 'new t)))
694 (unless (newsticker--lists-intersect-p
695 (get-text-property (point) 'invisible)
696 buffer-invisibility-spec)
697 (setq go-ahead nil))))
698 (run-hooks 'newsticker-select-item-hook)
699 (point))
700
701(defun newsticker-next-item (&optional do-not-wrap-at-eob)
702 "Go to next news item.
703Return new buffer position.
704If no item is found below point, search is continued at beginning
705of buffer unless optional argument DO-NOT-WRAP-AT-EOB is
706non-nil."
707 (interactive)
708 (widen)
709 (let ((go-ahead t)
710 (search-list '(item)))
711 (if newsticker--auto-narrow-to-item
712 (setq search-list '(item feed)))
713 (while go-ahead
714 (unless (newsticker--buffer-goto search-list)
715 ;; found nothing -- wrap
716 (unless do-not-wrap-at-eob
717 (goto-char (point-min)))
718 (setq go-ahead nil))
719 (unless (newsticker--lists-intersect-p
720 (get-text-property (point) 'invisible)
721 buffer-invisibility-spec)
722 (setq go-ahead nil))))
723 (run-hooks 'newsticker-select-item-hook)
724 (force-mode-line-update)
725 (point))
726
727(defun newsticker-next-item-same-feed ()
728 "Go to next news item in the same feed.
729Return new buffer position. If no item is found below point or if
730auto-narrow-to-item is enabled, nil is returned."
731 (interactive)
732 (if newsticker--auto-narrow-to-item
733 nil
734 (let ((go-ahead t)
735 (current-pos (point))
736 (end-of-feed (save-excursion (newsticker--buffer-end-of-feed))))
737 (while go-ahead
738 (unless (newsticker--buffer-goto '(item))
739 (setq go-ahead nil))
740 (unless (newsticker--lists-intersect-p
741 (get-text-property (point) 'invisible)
742 buffer-invisibility-spec)
743 (setq go-ahead nil)))
744 (if (and (> (point) current-pos)
745 (< (point) end-of-feed))
746 (point)
747 (goto-char current-pos)
748 nil))))
749
750(defun newsticker-previous-item (&optional do-not-wrap-at-bob)
751 "Go to previous news item.
752Return new buffer position.
753If no item is found before point, search is continued at
754beginning of buffer unless optional argument DO-NOT-WRAP-AT-BOB
755is non-nil."
756 (interactive)
757 (widen)
758 (let ((go-ahead t)
759 (search-list '(item)))
760 (if newsticker--auto-narrow-to-item
761 (setq search-list '(item feed)))
762 (when (bobp)
763 (unless do-not-wrap-at-bob
764 (goto-char (point-max))))
765 (while go-ahead
766 (if (newsticker--buffer-goto search-list nil t)
767 (unless (newsticker--lists-intersect-p
768 (get-text-property (point) 'invisible)
769 buffer-invisibility-spec)
770 (setq go-ahead nil))
771 (goto-char (point-min))
772 (setq go-ahead nil))))
773 (run-hooks 'newsticker-select-item-hook)
774 (force-mode-line-update)
775 (point))
776
777(defun newsticker-next-feed ()
778 "Go to next news feed.
779Return new buffer position."
780 (interactive)
781 (widen)
782 (newsticker--buffer-goto '(feed))
783 (run-hooks 'newsticker-select-feed-hook)
784 (force-mode-line-update)
785 (point))
786
787(defun newsticker-previous-feed ()
788 "Go to previous news feed.
789Return new buffer position."
790 (interactive)
791 (widen)
792 (newsticker--buffer-goto '(feed) nil t)
793 (run-hooks 'newsticker-select-feed-hook)
794 (force-mode-line-update)
795 (point))
796
797(defun newsticker-mark-all-items-at-point-as-read-and-redraw ()
798 "Mark all items as read and clear ticker contents."
799 (interactive)
800 (when (or newsticker--buffer-uptodate-p
801 (y-or-n-p
802 "Buffer is not up to date -- really mark items as read? "))
803 (newsticker-mark-all-items-of-feed-as-read
804 (get-text-property (point) 'feed))))
805
806(defun newsticker-mark-all-items-of-feed-as-read (feed)
807 "Mark all items of FEED as read, clear ticker, and redraw buffer."
808 (when feed
809 (let ((pos (point)))
810 (message "Marking all items as read for %s" (symbol-name feed))
811 (newsticker--cache-replace-age newsticker--cache feed 'new 'old)
812 (newsticker--cache-replace-age newsticker--cache feed 'obsolete
813 'old)
814 (newsticker--cache-update)
815 (newsticker--buffer-set-uptodate nil)
816 (newsticker--ticker-text-setup)
817 (newsticker-buffer-update)
818 ;; go back to where we came frome
819 (goto-char pos)
820 (end-of-line)
821 (newsticker--buffer-goto '(feed) nil t))))
822
823(defun newsticker-mark-all-items-at-point-as-read ()
824 "Mark all items as read and clear ticker contents."
825 (interactive)
826 (when (or newsticker--buffer-uptodate-p
827 (y-or-n-p
828 "Buffer is not up to date -- really mark items as read? "))
829 (newsticker--do-mark-item-at-point-as-read t)
830 (while (newsticker-next-item-same-feed)
831 (newsticker--do-mark-item-at-point-as-read t))
832 (newsticker-next-item t)))
833
834(defun newsticker-mark-item-at-point-as-read (&optional respect-immortality)
835 "Mark item at point as read and move to next item.
836If optional argument RESPECT-IMMORTALITY is not nil immortal items do
837not get changed."
838 (interactive)
839 (when (or newsticker--buffer-uptodate-p
840 (y-or-n-p
841 "Buffer is not up to date -- really mark this item as read? "))
842 (newsticker--do-mark-item-at-point-as-read respect-immortality)
843 ;; move forward
844 (newsticker-next-item t)))
845
846(defun newsticker--do-mark-item-at-point-as-read (&optional respect-immortality)
847 "Mark item at point as read.
848If optional argument RESPECT-IMMORTALITY is not nil immortal items do
849not get changed."
850 (let ((feed (get-text-property (point) 'feed)))
851 (when feed
852 (save-excursion
853 (newsticker--buffer-beginning-of-item)
854 (let ((inhibit-read-only t)
855 (age (get-text-property (point) 'nt-age))
856 (title (get-text-property (point) 'nt-title))
857 (guid (get-text-property (point) 'nt-guid))
858 (nt-desc (get-text-property (point) 'nt-desc))
859 (pos (save-excursion (newsticker--buffer-end-of-item)))
860 item)
861 (when (or (eq age 'new)
862 (eq age 'obsolete)
863 (and (eq age 'immortal)
864 (not respect-immortality)))
865 ;; find item
866 (setq item (newsticker--cache-contains newsticker--cache
867 feed title nt-desc
868 nil nil guid))
869 ;; mark as old
870 (when item
871 (setcar (nthcdr 4 item) 'old)
872 (newsticker--do-forget-preformatted item))
873 ;; clean up ticker
874 (if (or (and (eq age 'new)
875 newsticker-hide-immortal-items-in-echo-area)
876 (and (memq age '(old immortal))
877 (not
878 (eq newsticker-hide-old-items-in-newsticker-buffer
879 newsticker-hide-immortal-items-in-echo-area))))
880 (newsticker--ticker-text-remove feed title))
881 ;; set faces etc.
882 (save-excursion
883 (save-restriction
884 (widen)
885 (put-text-property (point) pos 'nt-age 'old)
886 (newsticker--buffer-set-faces (point) pos)))
887 (set-buffer-modified-p nil)))))))
888
889(defun newsticker-mark-item-at-point-as-immortal ()
890 "Mark item at point as read."
891 (interactive)
892 (when (or newsticker--buffer-uptodate-p
893 (y-or-n-p
894 "Buffer is not up to date -- really mark this item as read? "))
895 (let ((feed (get-text-property (point) 'feed))
896 (item nil))
897 (when feed
898 (save-excursion
899 (newsticker--buffer-beginning-of-item)
900 (let ((inhibit-read-only t)
901 (oldage (get-text-property (point) 'nt-age))
902 (title (get-text-property (point) 'nt-title))
903 (guid (get-text-property (point) 'nt-guid))
904 (pos (save-excursion (newsticker--buffer-end-of-item))))
905 (let ((newage 'immortal))
906 (if (eq oldage 'immortal)
907 (setq newage 'old))
908 (setq item (newsticker--cache-contains newsticker--cache
909 feed title nil nil nil
910 guid))
911 ;; change age
912 (when item
913 (setcar (nthcdr 4 item) newage)
914 (newsticker--do-forget-preformatted item))
915 (if (or (and (eq newage 'immortal)
916 newsticker-hide-immortal-items-in-echo-area)
917 (and (eq newage 'obsolete)
918 newsticker-hide-obsolete-items-in-echo-area)
919 (and (eq oldage 'immortal)
920 (not
921 (eq newsticker-hide-old-items-in-newsticker-buffer
922 newsticker-hide-immortal-items-in-echo-area))))
923 (newsticker--ticker-text-remove feed title)
924 (newsticker--ticker-text-setup))
925 (save-excursion
926 (save-restriction
927 (widen)
928 (put-text-property (point) pos 'nt-age newage)
929 (if (eq newage 'immortal)
930 (put-text-property (point) pos 'nt-age 'immortal)
931 (put-text-property (point) pos 'nt-age 'old))
932 (newsticker--buffer-set-faces (point) pos))))))
933 (if item
934 (newsticker-next-item t))))))
935
936(defun newsticker-mark-all-items-as-read ()
937 "Mark all items as read and clear ticker contents."
938 (interactive)
939 (when (or newsticker--buffer-uptodate-p
940 (y-or-n-p
941 "Buffer is not up to date -- really mark items as read? "))
942 (newsticker--cache-replace-age newsticker--cache 'any 'new 'old)
943 (newsticker--buffer-set-uptodate nil)
944 (newsticker--ticker-text-setup)
945 (newsticker--cache-update)
946 (newsticker-buffer-update)))
947
948(defun newsticker-hide-extra ()
949 "Hide the extra elements of items."
950 (interactive)
951 (newsticker--buffer-hideshow 'extra nil)
952 (newsticker--buffer-redraw))
953
954(defun newsticker-show-extra ()
955 "Show the extra elements of items."
956 (interactive)
957 (newsticker--buffer-hideshow 'extra t)
958 (newsticker--buffer-redraw))
959
960(defun newsticker-hide-old-item-desc ()
961 "Hide the description of old items."
962 (interactive)
963 (newsticker--buffer-hideshow 'desc-old nil)
964 (newsticker--buffer-redraw))
965
966(defun newsticker-show-old-item-desc ()
967 "Show the description of old items."
968 (interactive)
969 (newsticker--buffer-hideshow 'item-old t)
970 (newsticker--buffer-hideshow 'desc-old t)
971 (newsticker--buffer-redraw))
972
973(defun newsticker-hide-new-item-desc ()
974 "Hide the description of new items."
975 (interactive)
976 (newsticker--buffer-hideshow 'desc-new nil)
977 (newsticker--buffer-hideshow 'desc-immortal nil)
978 (newsticker--buffer-hideshow 'desc-obsolete nil)
979 (newsticker--buffer-redraw))
980
981(defun newsticker-show-new-item-desc ()
982 "Show the description of new items."
983 (interactive)
984 (newsticker--buffer-hideshow 'desc-new t)
985 (newsticker--buffer-hideshow 'desc-immortal t)
986 (newsticker--buffer-hideshow 'desc-obsolete t)
987 (newsticker--buffer-redraw))
988
989(defun newsticker-hide-feed-desc ()
990 "Hide the description of feeds."
991 (interactive)
992 (newsticker--buffer-hideshow 'desc-feed nil)
993 (newsticker--buffer-redraw))
994
995(defun newsticker-show-feed-desc ()
996 "Show the description of old items."
997 (interactive)
998 (newsticker--buffer-hideshow 'desc-feed t)
999 (newsticker--buffer-redraw))
1000
1001(defun newsticker-hide-all-desc ()
1002 "Hide the descriptions of feeds and all items."
1003 (interactive)
1004 (newsticker--buffer-hideshow 'desc-feed nil)
1005 (newsticker--buffer-hideshow 'desc-immortal nil)
1006 (newsticker--buffer-hideshow 'desc-obsolete nil)
1007 (newsticker--buffer-hideshow 'desc-new nil)
1008 (newsticker--buffer-hideshow 'desc-old nil)
1009 (newsticker--buffer-redraw))
1010
1011(defun newsticker-show-all-desc ()
1012 "Show the descriptions of feeds and all items."
1013 (interactive)
1014 (newsticker--buffer-hideshow 'desc-feed t)
1015 (newsticker--buffer-hideshow 'desc-immortal t)
1016 (newsticker--buffer-hideshow 'desc-obsolete t)
1017 (newsticker--buffer-hideshow 'desc-new t)
1018 (newsticker--buffer-hideshow 'desc-old t)
1019 (newsticker--buffer-redraw))
1020
1021(defun newsticker-hide-old-items ()
1022 "Hide old items."
1023 (interactive)
1024 (newsticker--buffer-hideshow 'desc-old nil)
1025 (newsticker--buffer-hideshow 'item-old nil)
1026 (newsticker--buffer-redraw))
1027
1028(defun newsticker-show-old-items ()
1029 "Show old items."
1030 (interactive)
1031 (newsticker--buffer-hideshow 'item-old t)
1032 (newsticker--buffer-redraw))
1033
1034(defun newsticker-hide-entry ()
1035 "Hide description of entry at point."
1036 (interactive)
1037 (save-excursion
1038 (let* (pos1 pos2
1039 (inhibit-read-only t)
1040 inv-prop org-inv-prop
1041 is-invisible)
1042 (newsticker--buffer-beginning-of-item)
1043 (newsticker--buffer-goto '(desc))
1044 (setq pos1 (max (point-min) (1- (point))))
1045 (newsticker--buffer-goto '(extra feed item nil))
1046 (setq pos2 (max (point-min) (1- (point))))
1047 (setq inv-prop (get-text-property pos1 'invisible))
1048 (setq org-inv-prop (get-text-property pos1 'org-invisible))
1049 (cond ((eq inv-prop t)
1050 ;; do nothing
1051 )
1052 ((eq org-inv-prop nil)
1053 (add-text-properties pos1 pos2
1054 (list 'invisible (list t)
1055 'org-invisible inv-prop)))
1056 (t
1057 ;; toggle
1058 (add-text-properties pos1 pos2
1059 (list 'invisible org-inv-prop))
1060 (remove-text-properties pos1 pos2 '(org-invisible))))))
1061 (newsticker--buffer-redraw))
1062
1063(defun newsticker-show-entry ()
1064 "Show description of entry at point."
1065 (interactive)
1066 (save-excursion
1067 (let* (pos1 pos2
1068 (inhibit-read-only t)
1069 inv-prop org-inv-prop
1070 is-invisible)
1071 (newsticker--buffer-beginning-of-item)
1072 (newsticker--buffer-goto '(desc))
1073 (setq pos1 (max (point-min) (1- (point))))
1074 (newsticker--buffer-goto '(extra feed item))
1075 (setq pos2 (max (point-min) (1- (point))))
1076 (setq inv-prop (get-text-property pos1 'invisible))
1077 (setq org-inv-prop (get-text-property pos1 'org-invisible))
1078 (cond ((eq org-inv-prop nil)
1079 (add-text-properties pos1 pos2
1080 (list 'invisible nil
1081 'org-invisible inv-prop)))
1082 (t
1083 ;; toggle
1084 (add-text-properties pos1 pos2
1085 (list 'invisible org-inv-prop))
1086 (remove-text-properties pos1 pos2 '(org-invisible))))))
1087 (newsticker--buffer-redraw))
1088
1089(defun newsticker-toggle-auto-narrow-to-feed ()
1090 "Toggle narrowing to current news feed.
1091If auto-narrowing is active, only news item of the current feed
1092are visible."
1093 (interactive)
1094 (newsticker-set-auto-narrow-to-feed
1095 (not newsticker--auto-narrow-to-feed)))
1096
1097(defun newsticker-set-auto-narrow-to-feed (value)
1098 "Turn narrowing to current news feed on or off.
1099If VALUE is nil, auto-narrowing is turned off, otherwise it is turned on."
1100 (interactive)
1101 (setq newsticker--auto-narrow-to-item nil)
1102 (setq newsticker--auto-narrow-to-feed value)
1103 (widen)
1104 (newsticker--buffer-make-item-completely-visible)
1105 (run-hooks 'newsticker-narrow-hook))
1106
1107(defun newsticker-toggle-auto-narrow-to-item ()
1108 "Toggle narrowing to current news item.
1109If auto-narrowing is active, only one item of the current feed
1110is visible."
1111 (interactive)
1112 (newsticker-set-auto-narrow-to-item
1113 (not newsticker--auto-narrow-to-item)))
1114
1115(defun newsticker-set-auto-narrow-to-item (value)
1116 "Turn narrowing to current news item on or off.
1117If VALUE is nil, auto-narrowing is turned off, otherwise it is turned on."
1118 (interactive)
1119 (setq newsticker--auto-narrow-to-feed nil)
1120 (setq newsticker--auto-narrow-to-item value)
1121 (widen)
1122 (newsticker--buffer-make-item-completely-visible)
1123 (run-hooks 'newsticker-narrow-hook))
1124
1125(defun newsticker-next-feed-available-p ()
1126 "Return t if position is before last feed, nil otherwise."
1127 (save-excursion
1128 (let ((p (point)))
1129 (newsticker--buffer-goto '(feed))
1130 (not (= p (point))))))
1131
1132(defun newsticker-previous-feed-available-p ()
1133 "Return t if position is behind first feed, nil otherwise."
1134 (save-excursion
1135 (let ((p (point)))
1136 (newsticker--buffer-goto '(feed) nil t)
1137 (not (= p (point))))))
1138
1139(defun newsticker-next-item-available-p ()
1140 "Return t if position is before last feed, nil otherwise."
1141 (save-excursion
1142 (catch 'result
1143 (while (< (point) (point-max))
1144 (unless (newsticker--buffer-goto '(item))
1145 (throw 'result nil))
1146 (unless (newsticker--lists-intersect-p
1147 (get-text-property (point) 'invisible)
1148 buffer-invisibility-spec)
1149 (throw 'result t))))))
1150
1151(defun newsticker-previous-item-available-p ()
1152 "Return t if position is behind first item, nil otherwise."
1153 (save-excursion
1154 (catch 'result
1155 (while (> (point) (point-min))
1156 (unless (newsticker--buffer-goto '(item) nil t)
1157 (throw 'result nil))
1158 (unless (newsticker--lists-intersect-p
1159 (get-text-property (point) 'invisible)
1160 buffer-invisibility-spec)
1161 (throw 'result t))))))
1162
1163(defun newsticker-item-not-old-p ()
1164 "Return t if there is an item at point which is not old, nil otherwise."
1165 (when (get-text-property (point) 'feed)
1166 (save-excursion
1167 (newsticker--buffer-beginning-of-item)
1168 (let ((age (get-text-property (point) 'nt-age)))
1169 (and (memq age '(new immortal obsolete)) t)))))
1170
1171(defun newsticker-item-not-immortal-p ()
1172 "Return t if there is an item at point which is not immortal, nil otherwise."
1173 (when (get-text-property (point) 'feed)
1174 (save-excursion
1175 (newsticker--buffer-beginning-of-item)
1176 (let ((age (get-text-property (point) 'nt-age)))
1177 (and (memq age '(new old obsolete)) t)))))
1178
1179;; ======================================================================
1180;;; Imenu stuff
1181;; ======================================================================
1182(defun newsticker--imenu-create-index ()
1183 "Scan newsticker buffer and return an index for imenu."
1184 (save-excursion
1185 (goto-char (point-min))
1186 (let ((index-alist nil)
1187 (feed-list nil)
1188 (go-ahead t))
1189 (while go-ahead
1190 (let ((type (get-text-property (point) 'nt-type))
1191 (title (get-text-property (point) 'nt-title)))
1192 (cond ((eq type 'feed)
1193 ;; we're on a feed heading
1194 (when feed-list
1195 (if index-alist
1196 (nconc index-alist (list feed-list))
1197 (setq index-alist (list feed-list))))
1198 (setq feed-list (list title)))
1199 (t
1200 (nconc feed-list
1201 (list (cons title (point)))))))
1202 (setq go-ahead (newsticker--buffer-goto '(item feed))))
1203 (if index-alist
1204 (nconc index-alist (list feed-list))
1205 (setq index-alist (list feed-list)))
1206 index-alist)))
1207
1208(defun newsticker--imenu-goto (name pos &rest args)
1209 "Go to item NAME at position POS and show item.
1210ARGS are ignored."
1211 (goto-char pos)
1212 ;; show headline
1213 (newsticker--buffer-goto '(desc extra feed item))
1214 (let* ((inhibit-read-only t)
1215 (pos1 (max (point-min) (1- pos)))
1216 (pos2 (max pos1 (1- (point))))
1217 (inv-prop (get-text-property pos 'invisible))
1218 (org-inv-prop (get-text-property pos 'org-invisible)))
1219 (when (eq org-inv-prop nil)
1220 (add-text-properties pos1 pos2 (list 'invisible nil
1221 'org-invisible inv-prop))))
1222 ;; show desc
1223 (newsticker-show-entry))
1224
1225;; ======================================================================
1226;;; Buffer stuff
1227;; ======================================================================
1228(defun newsticker--buffer-set-uptodate (value)
1229 "Set the uptodate-status of the newsticker buffer to VALUE.
1230The mode-line is changed accordingly."
1231 (setq newsticker--buffer-uptodate-p value)
1232 (let ((b (get-buffer "*newsticker*")))
1233 (when b
1234 (save-excursion
1235 (set-buffer b)
1236 (if value
1237 (setq mode-name "Newsticker -- up to date -- ")
1238 (setq mode-name "Newsticker -- NEED UPDATE -- ")))
1239 (force-mode-line-update 0))))
1240
1241(defun newsticker--buffer-redraw ()
1242 "Redraw the newsticker window."
1243 (if (fboundp 'force-window-update)
1244 (force-window-update (current-buffer))
1245 (redraw-frame (selected-frame)))
1246 (run-hooks 'newsticker-buffer-change-hook)
1247 (sit-for 0))
1248
1249(defun newsticker--buffer-insert-all-items ()
1250 "Insert all cached newsticker items into the current buffer.
1251Keeps order of feeds as given in `newsticker-url-list' and
1252`newsticker-url-list-defaults'."
1253 (goto-char (point-min))
1254 (mapc (lambda (url-item)
1255 (let* ((feed-name (car url-item))
1256 (feed-name-symbol (intern feed-name))
1257 (feed (assoc feed-name-symbol newsticker--cache))
1258 (items (cdr feed))
1259 (pos (point)))
1260 (when feed
1261 ;; insert the feed description
1262 (mapc (lambda (item)
1263 (when (eq (newsticker--age item) 'feed)
1264 (newsticker--buffer-insert-item item
1265 feed-name-symbol)))
1266 items)
1267 ;;insert the items
1268 (mapc (lambda (item)
1269 (if (memq (newsticker--age item) '(new immortal old
1270 obsolete))
1271 (newsticker--buffer-insert-item item
1272 feed-name-symbol)))
1273 items)
1274 (put-text-property pos (point) 'feed (car feed))
1275
1276 ;; insert empty line between feeds
1277 (let ((p (point)))
1278 (insert "\n")
1279 (put-text-property p (point) 'hard t)))))
1280 (append newsticker-url-list newsticker-url-list-defaults))
1281
1282 (newsticker--buffer-set-faces (point-min) (point-max))
1283 (newsticker--buffer-set-invisibility (point-min) (point-max))
1284 (goto-char (point-min)))
1285
1286(defun newsticker--buffer-insert-item (item &optional feed-name-symbol)
1287 "Insert a news item in the current buffer.
1288Insert a formatted representation of the ITEM. The optional parameter
1289FEED-NAME-SYMBOL determines how the item is formatted and whether the
1290item-retrieval time is added as well."
1291 ;; insert headline
1292 (if (eq (newsticker--age item) 'feed)
1293 (newsticker--buffer-do-insert-text item 'feed feed-name-symbol)
1294 (newsticker--buffer-do-insert-text item 'item feed-name-symbol))
1295 ;; insert the description
1296 (newsticker--buffer-do-insert-text item 'desc feed-name-symbol))
1297
1298(defun newsticker--buffer-do-insert-text (item type feed-name-symbol)
1299 "Actually insert contents of news item, format it, render it and all that.
1300ITEM is a news item, TYPE tells which part of the item shall be inserted,
1301FEED-NAME-SYMBOL tells to which feed this item belongs."
1302 (let* ((pos (point))
1303 (format newsticker-desc-format)
1304 (pos-date-start nil)
1305 (pos-date-end nil)
1306 (pos-stat-start nil)
1307 (pos-stat-end nil)
1308 (pos-text-start nil)
1309 (pos-text-end nil)
1310 (pos-extra-start nil)
1311 (pos-extra-end nil)
1312 (pos-enclosure-start nil)
1313 (pos-enclosure-end nil)
1314 (age (newsticker--age item))
1315 (preformatted-contents (newsticker--preformatted-contents item))
1316 (preformatted-title (newsticker--preformatted-title item)))
1317 (cond ((and preformatted-contents
1318 (not (eq (aref preformatted-contents 0) ?\n));; we must
1319 ;; NOT have a line
1320 ;; break!
1321 (eq type 'desc))
1322 (insert preformatted-contents))
1323 ((and preformatted-title
1324 (not (eq (aref preformatted-title 0) ?\n));; we must NOT have a
1325 ;; line break!
1326 (eq type 'item))
1327 (insert preformatted-title))
1328 (t
1329 ;; item was not formatted before.
1330 ;; Let's go.
1331 (if (eq type 'item)
1332 (setq format newsticker-item-format)
1333 (if (eq type 'feed)
1334 (setq format newsticker-heading-format)))
1335
1336 (while (> (length format) 0)
1337 (let ((prefix (if (> (length format) 1)
1338 (substring format 0 2)
1339 "")))
1340 (cond ((string= "%c" prefix)
1341 ;; contents
1342 (when (newsticker--desc item)
1343 (setq pos-text-start (point-marker))
1344 (insert (newsticker--desc item))
1345 (setq pos-text-end (point-marker)))
1346 (setq format (substring format 2)))
1347 ((string= "%d" prefix)
1348 ;; date
1349 (setq pos-date-start (point-marker))
1350 (if (newsticker--time item)
1351 (insert (format-time-string newsticker-date-format
1352 (newsticker--time item))))
1353 (setq pos-date-end (point-marker))
1354 (setq format (substring format 2)))
1355 ((string= "%l" prefix)
1356 ;; logo
1357 (let ((disabled (cond ((eq (newsticker--age item) 'feed)
1358 (= (newsticker--stat-num-items
1359 feed-name-symbol 'new) 0))
1360 (t
1361 (not (eq (newsticker--age item)
1362 'new))))))
1363 (let ((img (newsticker--image-read feed-name-symbol
1364 disabled)))
1365 (when img
1366 (newsticker--insert-image img (car item)))))
1367 (setq format (substring format 2)))
1368 ((string= "%L" prefix)
1369 ;; logo or title
1370 (let ((disabled (cond ((eq (newsticker--age item) 'feed)
1371 (= (newsticker--stat-num-items
1372 feed-name-symbol 'new) 0))
1373 (t
1374 (not (eq (newsticker--age item)
1375 'new))))))
1376 (let ((img (newsticker--image-read feed-name-symbol
1377 disabled)))
1378 (if img
1379 (newsticker--insert-image img (car item))
1380 (when (car item)
1381 (setq pos-text-start (point-marker))
1382 (if (eq (newsticker--age item) 'feed)
1383 (insert (newsticker--title item))
1384 ;; FIXME: This is not the "real" title!
1385 (insert (format "%s"
1386 (car (newsticker--cache-get-feed
1387 feed-name-symbol)))))
1388 (setq pos-text-end (point-marker))))))
1389 (setq format (substring format 2)))
1390 ((string= "%s" prefix)
1391 ;; statistics
1392 (setq pos-stat-start (point-marker))
1393 (if (eq (newsticker--age item) 'feed)
1394 (insert (newsticker--buffer-statistics
1395 feed-name-symbol)))
1396 (setq pos-stat-end (point-marker))
1397 (setq format (substring format 2)))
1398 ((string= "%t" prefix)
1399 ;; title
1400 (when (car item)
1401 (setq pos-text-start (point-marker))
1402 (insert (car item))
1403 (setq pos-text-end (point-marker)))
1404 (setq format (substring format 2)))
1405 ((string-match "%." prefix)
1406 ;; unknown specifier!
1407 (insert prefix)
1408 (setq format (substring format 2)))
1409 ((string-match "^\\([^%]*\\)\\(.*\\)" format) ;; FIXME!
1410 ;; everything else
1411 (let ((p (point)))
1412 (insert (substring format
1413 (match-beginning 1) (match-end 1)))
1414 ;; in case that the format string contained newlines
1415 (put-text-property p (point) 'hard t))
1416 (setq format (substring format (match-beginning 2)))))))
1417
1418 ;; decode HTML if possible...
1419 (let ((is-rendered-HTML nil))
1420 (when (and newsticker-html-renderer pos-text-start pos-text-end)
1421 (condition-case error-data
1422 (save-excursion
1423 ;; check whether it is necessary to call html renderer
1424 ;; (regexp inspired by htmlr.el)
1425 (goto-char pos-text-start)
1426 (when (re-search-forward
1427 "</?[A-Za-z1-6]*\\|&#?[A-Za-z0-9]+;" pos-text-end t)
1428 ;; (message "%s" (newsticker--title item))
1429 (let ((w3m-fill-column (if newsticker-use-full-width
1430 -1 fill-column))
1431 (w3-maximum-line-length
1432 (if newsticker-use-full-width nil fill-column)))
1433 (save-excursion
1434 (funcall newsticker-html-renderer pos-text-start
1435 pos-text-end)))
1436 (cond ((eq newsticker-html-renderer 'w3m-region)
1437 (add-text-properties pos (point-max)
1438 (list 'keymap
1439 w3m-minor-mode-map)))
1440 ((eq newsticker-html-renderer 'w3-region)
1441 (add-text-properties pos (point-max)
1442 (list 'keymap w3-mode-map))))
1443 (setq is-rendered-HTML t)))
1444 (error
1445 (message "Error: HTML rendering failed: %s, %s"
1446 (car error-data) (cdr error-data)))))
1447 ;; After html rendering there might be chunks of blank
1448 ;; characters between rendered text and date, statistics or
1449 ;; whatever. Remove it
1450 (when (and (eq type 'item) is-rendered-HTML)
1451 (goto-char pos)
1452 (while (re-search-forward "[ \t]*\n[ \t]*" nil t)
1453 (replace-match " " nil nil))
1454 (goto-char (point-max)))
1455 (when (and newsticker-justification
1456 (memq type '(item desc))
1457 (not is-rendered-HTML))
1458 (condition-case nil
1459 (let ((use-hard-newlines t))
1460 (fill-region pos (point-max) newsticker-justification))
1461 (error nil))))
1462
1463 ;; remove leading and trailing newlines
1464 (goto-char pos)
1465 (unless (= 0 (skip-chars-forward " \t\r\n"))
1466 (delete-region pos (point)))
1467 (goto-char (point-max))
1468 (let ((end (point)))
1469 (unless (= 0 (skip-chars-backward " \t\r\n" (1+ pos)))
1470 (delete-region (point) end)))
1471 (goto-char (point-max))
1472 ;; closing newline
1473 (unless nil ;;(eq pos (point))
1474 (insert "\n")
1475 (put-text-property (1- (point)) (point) 'hard t))
1476
1477 ;; insert enclosure element
1478 (when (eq type 'desc)
1479 (setq pos-enclosure-start (point))
1480 (newsticker--insert-enclosure item newsticker--url-keymap)
1481 (setq pos-enclosure-end (point)))
1482
1483 ;; show extra elements
1484 (when (eq type 'desc)
1485 (goto-char (point-max))
1486 (setq pos-extra-start (point))
1487 (newsticker--print-extra-elements item newsticker--url-keymap)
1488 (setq pos-extra-end (point)))
1489
1490 ;; text properties
1491 (when (memq type '(feed item))
1492 (add-text-properties pos (1- (point))
1493 (list 'mouse-face 'highlight
1494 'nt-link (newsticker--link item)
1495 'help-echo
1496 (format "mouse-2: visit item (%s)"
1497 (newsticker--link item))
1498 'keymap newsticker--url-keymap))
1499 (add-text-properties pos (point)
1500 (list 'nt-title (newsticker--title item)
1501 'nt-desc (newsticker--desc item))))
1502
1503 (add-text-properties pos (point)
1504 (list 'nt-type type
1505 'nt-face type
1506 'nt-age age
1507 'nt-guid (newsticker--guid item)))
1508 (when (and pos-date-start pos-date-end)
1509 (put-text-property pos-date-start pos-date-end 'nt-face 'date))
1510 (when (and pos-stat-start pos-stat-end)
1511 (put-text-property pos-stat-start pos-stat-end 'nt-face 'stat))
1512 (when (and pos-extra-start pos-extra-end)
1513 (put-text-property pos-extra-start pos-extra-end
1514 'nt-face 'extra)
1515 (put-text-property pos-extra-start pos-extra-end
1516 'nt-type 'extra))
1517 (when (and pos-enclosure-start pos-enclosure-end
1518 (> pos-enclosure-end pos-enclosure-start))
1519 (put-text-property pos-enclosure-start (1- pos-enclosure-end)
1520 'nt-face 'enclosure))
1521
1522 ;; left margin
1523 ;;(unless (memq type '(feed item))
1524 ;;(set-left-margin pos (1- (point)) 1))
1525
1526 ;; save rendered stuff
1527 (cond ((eq type 'desc)
1528 ;; preformatted contents
1529 (newsticker--cache-set-preformatted-contents
1530 item (buffer-substring pos (point))))
1531 ((eq type 'item)
1532 ;; preformatted title
1533 (newsticker--cache-set-preformatted-title
1534 item (buffer-substring pos (point)))))))))
1535
1536(defun newsticker--buffer-statistics (feed-name-symbol)
1537 "Return a statistic string for the feed given by FEED-NAME-SYMBOL.
1538See `newsticker-statistics-format'."
1539 (let ((case-fold-search nil))
1540 (replace-regexp-in-string
1541 "%a"
1542 (format "%d" (newsticker--stat-num-items feed-name-symbol))
1543 (replace-regexp-in-string
1544 "%i"
1545 (format "%d" (newsticker--stat-num-items feed-name-symbol 'immortal))
1546 (replace-regexp-in-string
1547 "%n"
1548 (format "%d" (newsticker--stat-num-items feed-name-symbol 'new))
1549 (replace-regexp-in-string
1550 "%o"
1551 (format "%d" (newsticker--stat-num-items feed-name-symbol 'old))
1552 (replace-regexp-in-string
1553 "%O"
1554 (format "%d" (newsticker--stat-num-items feed-name-symbol 'obsolete))
1555 newsticker-statistics-format)))))))
1556
1557(defun newsticker--buffer-set-faces (start end)
1558 "Add face properties according to mark property.
1559Scans the buffer between START and END."
1560 (save-excursion
1561 (put-text-property start end 'face 'newsticker-default-face)
1562 (goto-char start)
1563 (let ((pos1 start)
1564 (pos2 1)
1565 (nt-face (get-text-property start 'nt-face))
1566 (nt-age (get-text-property start 'nt-age)))
1567 (when nt-face
1568 (setq pos2 (next-single-property-change (point) 'nt-face))
1569 (newsticker--set-face-properties pos1 pos2 nt-face nt-age)
1570 (setq nt-face (get-text-property pos2 'nt-face))
1571 (setq pos1 pos2))
1572 (while (and (setq pos2 (next-single-property-change pos1 'nt-face))
1573 (<= pos2 end)
1574 (> pos2 pos1))
1575 (newsticker--set-face-properties pos1 pos2 nt-face nt-age)
1576 (setq nt-face (get-text-property pos2 'nt-face))
1577 (setq nt-age (get-text-property pos2 'nt-age))
1578 (setq pos1 pos2)))))
1579
1580(defun newsticker--buffer-set-invisibility (start end)
1581 "Add invisibility properties according to nt-type property.
1582Scans the buffer between START and END. Sets the 'invisible
1583property to '(<nt-type>-<nt-age> <nt-type> <nt-age>)."
1584 (save-excursion
1585 ;; reset invisibility settings
1586 (put-text-property start end 'invisible nil)
1587 ;; let's go
1588 (goto-char start)
1589 (let ((pos1 start)
1590 (pos2 1)
1591 (nt-type (get-text-property start 'nt-type))
1592 (nt-age (get-text-property start 'nt-age)))
1593 (when nt-type
1594 (setq pos2 (next-single-property-change (point) 'nt-type))
1595 (put-text-property (max (point-min) pos1) (1- pos2)
1596 'invisible
1597 (list (intern
1598 (concat
1599 (symbol-name
1600 (if (eq nt-type 'extra) 'desc nt-type))
1601 "-"
1602 (symbol-name nt-age)))
1603 nt-type
1604 nt-age))
1605 (setq nt-type (get-text-property pos2 'nt-type))
1606 (setq pos1 pos2))
1607 (while (and (setq pos2 (next-single-property-change pos1 'nt-type))
1608 (<= pos2 end)
1609 (> pos2 pos1))
1610 ;; must shift one char to the left in order to handle inivisible
1611 ;; newlines, motion in invisible text areas and all that correctly
1612 (put-text-property (1- pos1) (1- pos2)
1613 'invisible
1614 (list (intern
1615 (concat
1616 (symbol-name
1617 (if (eq nt-type 'extra) 'desc nt-type))
1618 "-"
1619 (symbol-name nt-age)))
1620 nt-type
1621 nt-age))
1622 (setq nt-type (get-text-property pos2 'nt-type))
1623 (setq nt-age (get-text-property pos2 'nt-age))
1624 (setq pos1 pos2)))))
1625
1626(defun newsticker--set-face-properties (pos1 pos2 nt-face age)
1627 "Set the face for the text between the positions POS1 and POS2.
1628The face is chosen according the values of NT-FACE and AGE."
1629 (let ((face (cond ((eq nt-face 'feed)
1630 'newsticker-feed-face)
1631 ((eq nt-face 'item)
1632 (cond ((eq age 'new)
1633 'newsticker-new-item-face)
1634 ((eq age 'old)
1635 'newsticker-old-item-face)
1636 ((eq age 'immortal)
1637 'newsticker-immortal-item-face)
1638 ((eq age 'obsolete)
1639 'newsticker-obsolete-item-face)))
1640 ((eq nt-face 'date)
1641 'newsticker-date-face)
1642 ((eq nt-face 'stat)
1643 'newsticker-statistics-face)
1644 ((eq nt-face 'extra)
1645 'newsticker-extra-face)
1646 ((eq nt-face 'enclosure)
1647 'newsticker-enclosure-face))))
1648 (when face
1649 (put-text-property pos1 (max pos1 pos2) 'face face))))
1650
1651;; ======================================================================
1652;;; Functions working on the *newsticker* buffer
1653;; ======================================================================
1654(defun newsticker--buffer-make-item-completely-visible ()
1655 "Scroll buffer until current item is completely visible."
1656 (when newsticker--auto-narrow-to-feed
1657 (let* ((min (or (save-excursion (newsticker--buffer-beginning-of-feed))
1658 (point-min)))
1659 (max (or (save-excursion (newsticker--buffer-end-of-feed))
1660 (point-max))))
1661 (narrow-to-region min max)))
1662 (when newsticker--auto-narrow-to-item
1663 (let* ((min (or (save-excursion (newsticker--buffer-beginning-of-item))
1664 (point-min)))
1665 (max (or (save-excursion (newsticker--buffer-end-of-item))
1666 (point-max))))
1667 (narrow-to-region min max)))
1668 (sit-for 0)
1669 ;; do not count lines and stuff because that does not work when images
1670 ;; are displayed. Do it the simple way:
1671 (save-excursion
1672 (newsticker--buffer-end-of-item)
1673 (unless (pos-visible-in-window-p)
1674 (recenter -1)))
1675 (unless (pos-visible-in-window-p)
1676 (recenter 0)))
1677
1678(defun newsticker--buffer-get-feed-title-at-point ()
1679 "Return feed symbol of headline at point."
1680 (format "%s" (or (get-text-property (point) 'feed) " ")))
1681
1682(defun newsticker--buffer-get-item-title-at-point ()
1683 "Return feed symbol of headline at point."
1684 (format "%s" (or (get-text-property (point) 'nt-title) " ")))
1685
1686(defun newsticker--buffer-goto (types &optional age backwards)
1687 "Search next occurrence of TYPES in current buffer.
1688TYPES is a list of symbols. If TYPES is found point is moved, if
1689not point is left unchanged. If optional parameter AGE is not
1690nil, the type AND the age must match. If BACKWARDS is t, search
1691backwards."
1692 (let ((pos (save-excursion
1693 (save-restriction
1694 (widen)
1695 (catch 'found
1696 (let ((tpos (point)))
1697 (while (setq tpos
1698 (if backwards
1699 (if (eq tpos (point-min))
1700 nil
1701 (or (previous-single-property-change
1702 tpos 'nt-type)
1703 (point-min)))
1704 (next-single-property-change
1705 tpos 'nt-type)))
1706 (and (memq (get-text-property tpos 'nt-type) types)
1707 (or (not age)
1708 (eq (get-text-property tpos 'nt-age) age))
1709 (throw 'found tpos)))))))))
1710 (when pos
1711 (goto-char pos))
1712 pos))
1713
1714(defun newsticker--buffer-hideshow (mark-age onoff)
1715 "Hide or show items of type MARK-AGE.
1716If ONOFF is nil the item is hidden, otherwise it is shown."
1717 (if onoff
1718 (remove-from-invisibility-spec mark-age)
1719 (add-to-invisibility-spec mark-age)))
1720
1721(defun newsticker--buffer-beginning-of-item ()
1722 "Move point to the beginning of the item at point.
1723Return new position."
1724 (if (bobp)
1725 (point)
1726 (let ((type (get-text-property (point) 'nt-type))
1727 (typebefore (get-text-property (1- (point)) 'nt-type)))
1728 (if (and (memq type '(item feed))
1729 (not (eq type typebefore)))
1730 (point)
1731 (newsticker--buffer-goto '(item feed) nil t)
1732 (point)))))
1733
1734(defun newsticker--buffer-beginning-of-feed ()
1735 "Move point to the beginning of the feed at point.
1736Return new position."
1737 (if (bobp)
1738 (point)
1739 (let ((type (get-text-property (point) 'nt-type))
1740 (typebefore (get-text-property (1- (point)) 'nt-type)))
1741 (if (and (memq type '(feed))
1742 (not (eq type typebefore)))
1743 (point)
1744 (newsticker--buffer-goto '(feed) nil t)
1745 (point)))))
1746
1747(defun newsticker--buffer-end-of-item ()
1748 "Move point to the end of the item at point.
1749Take care: end of item is at the end of its last line!"
1750 (when (newsticker--buffer-goto '(item feed nil))
1751 (point)))
1752
1753(defun newsticker--buffer-end-of-feed ()
1754 "Move point to the end of the last item of the feed at point.
1755Take care: end of item is at the end of its last line!"
1756 (when (newsticker--buffer-goto '(feed nil))
1757 (backward-char 1)
1758 (point)))
1759
1760;; ======================================================================
1761;;; misc
1762;; ======================================================================
1763
1764(defun newsticker-mouse-browse-url (event)
1765 "Call `browse-url' for the link of the item at which the EVENT occurred."
1766 (interactive "e")
1767 (save-excursion
1768 (switch-to-buffer (window-buffer (posn-window (event-end event))))
1769 (let ((url (get-text-property (posn-point (event-end event))
1770 'nt-link)))
1771 (when url
1772 (browse-url url)
1773 (save-excursion
1774 (goto-char (posn-point (event-end event)))
1775 (if newsticker-automatically-mark-visited-items-as-old
1776 (newsticker-mark-item-at-point-as-read t)))))))
1777
1778(defun newsticker-browse-url ()
1779 "Call `browse-url' for the link of the item at point."
1780 (interactive)
1781 (let ((url (get-text-property (point) 'nt-link)))
1782 (when url
1783 (browse-url url)
1784 (if newsticker-automatically-mark-visited-items-as-old
1785 (newsticker-mark-item-at-point-as-read t)))))
1786
1787(defvar newsticker-open-url-history
1788 '("wget" "xmms" "realplay")
1789 "...")
1790
1791(defun newsticker-handle-url ()
1792 "Ask for a program to open the link of the item at point."
1793 (interactive)
1794 (let ((url (get-text-property (point) 'nt-link)))
1795 (when url
1796 (let ((prog (read-string "Open url with: " nil
1797 'newsticker-open-url-history)))
1798 (when prog
1799 (message "%s %s" prog url)
1800 (start-process prog prog prog url)
1801 (if newsticker-automatically-mark-visited-items-as-old
1802 (newsticker-mark-item-at-point-as-read t)))))))
1803
1804
1805;; ======================================================================
1806;;; Misc
1807;; ======================================================================
1808
1809(defun newsticker--cache-sort ()
1810 "Sort the newsticker cache data."
1811 (let ((sort-fun (cond ((eq newsticker-sort-method 'sort-by-time)
1812 'newsticker--cache-item-compare-by-time)
1813 ((eq newsticker-sort-method 'sort-by-title)
1814 'newsticker--cache-item-compare-by-title)
1815 ((eq newsticker-sort-method 'sort-by-original-order)
1816 'newsticker--cache-item-compare-by-position))))
1817 (mapc (lambda (feed-list)
1818 (setcdr feed-list (sort (cdr feed-list)
1819 sort-fun)))
1820 newsticker--cache)))
1821
1822(provide 'newsticker-plainview)
1823;;; newsticker-plainview.el ends here
diff --git a/lisp/net/newsticker-reader.el b/lisp/net/newsticker-reader.el
new file mode 100644
index 00000000000..641ab91bbfb
--- /dev/null
+++ b/lisp/net/newsticker-reader.el
@@ -0,0 +1,1118 @@
1;;; newsticker-reader.el --- Generic RSS reader functions.
2
3;; Copyright (C) 2008 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; Author: Ulf Jasper <ulf.jasper@web.de>
8;; Filename: newsticker-reader.el
9;; URL: http://www.nongnu.org/newsticker
10;; Time-stamp: "7. Juni 2008, 15:34:08 (ulf)"
11;; CVS-Version: $Id: newsticker-reader.el,v 1.5 2008/05/04 18:21:08 u11 Exp $
12
13;; ======================================================================
14
15;; GNU Emacs is free software: you can redistribute it and/or modify
16;; it under the terms of the GNU General Public License as published by
17;; the Free Software Foundation, either version 3 of the License, or
18;; (at your option) any later version.
19
20;; GNU Emacs is distributed in the hope that it will be useful,
21;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23;; GNU General Public License for more details.
24
25;; You should have received a copy of the GNU General Public License
26;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27
28;; ======================================================================
29;;; Commentary:
30
31;; See newsticker.el
32
33;; ======================================================================
34;;; Code:
35
36(require 'newsticker-backend)
37
38;; ======================================================================
39;;; Customization
40;; ======================================================================
41(defun newsticker--set-customvar-formatting (symbol value)
42 "Set newsticker-variable SYMBOL value to VALUE.
43Calls all actions which are necessary in order to make the new
44value effective."
45 (if (or (not (boundp symbol))
46 (equal (symbol-value symbol) value))
47 (set symbol value)
48 ;; something must have changed
49 (set symbol value)
50 (when (fboundp 'newsticker--forget-preformatted)
51 (newsticker--forget-preformatted))))
52
53;; ======================================================================
54;; reader
55(defgroup newsticker-reader nil
56 "Settings for the feed reader."
57 :group 'newsticker)
58
59(defcustom newsticker-frontend
60 'newsticker-treeview
61 "Newsticker frontend for reading news.
62This must be one of the functions `newsticker-plainview' or
63`newsticker-treeview'."
64 :type '(choice :tag "Frontend"
65 (const :tag "Single buffer (plainview)" newsticker-plainview)
66 (const :tag "Tree view (treeview)" newsticker-treeview))
67 :group 'newsticker-reader)
68
69;; image related things
70(defcustom newsticker-enable-logo-manipulations
71 t
72 "If non-nil newsticker manipulates logo images.
73This enables the following image properties: heuristic mask for all
74logos, and laplace-conversion for images without new items."
75 :type 'boolean
76 :group 'newsticker-reader)
77
78(defcustom newsticker-justification
79 'left
80 "How to fill item descriptions.
81If non-nil newsticker calls `fill-region' to wrap long lines in
82item descriptions. However, if an item description contains HTML
83text and `newsticker-html-renderer' is non-nil, filling is not
84done."
85 :type '(choice :tag "Justification"
86 (const :tag "No filling" nil)
87 (const :tag "Left" left)
88 (const :tag "Right" right)
89 (const :tag "Center" center)
90 (const :tag "Full" full))
91 :set 'newsticker--set-customvar-formatting
92 :group 'newsticker-reader)
93
94(defcustom newsticker-use-full-width
95 t
96 "Decides whether to use the full window width when filling.
97If non-nil newsticker sets `fill-column' so that the whole
98window is used when filling. See also `newsticker-justification'."
99 :type 'boolean
100 :set 'newsticker--set-customvar-formatting
101 :group 'newsticker-reader)
102
103(defcustom newsticker-html-renderer
104 nil
105 "Function for rendering HTML contents.
106If non-nil, newsticker.el will call this function whenever it finds
107HTML-like tags in item descriptions. Possible functions are, for
108example, `w3m-region', `w3-region', and (if you have htmlr.el installed)
109`newsticker-htmlr-render'.
110
111In order to make sure that the HTML renderer is loaded when you
112run newsticker, you should add one of the following statements to
113your .emacs. If you use w3m,
114
115 (autoload 'w3m-region \"w3m\"
116 \"Render region in current buffer and replace with result.\" t)
117
118 (autoload 'w3m-toggle-inline-image \"w3m\"
119 \"Toggle the visibility of an image under point.\" t)
120
121or, if you use w3,
122
123 (require 'w3-auto)
124
125or, if you use htmlr
126
127 (require 'htmlr)"
128 :type '(choice :tag "Function"
129 (const :tag "None" nil)
130 (const :tag "w3" w3-region)
131 (const :tag "w3m" w3m-region)
132 (const :tag "htmlr" newsticker-htmlr-render))
133 :set 'newsticker--set-customvar-formatting
134 :group 'newsticker-reader)
135
136(defcustom newsticker-date-format
137 "(%A, %H:%M)"
138 "Format for the date part in item and feed lines.
139See `format-time-string' for a list of valid specifiers."
140 :type 'string
141 :set 'newsticker--set-customvar-formatting
142 :group 'newsticker-reader)
143
144;; ======================================================================
145;;; Utility functions
146;; ======================================================================
147(defun newsticker--insert-enclosure (item keymap)
148 "Insert enclosure element of a news ITEM into the current buffer.
149KEYMAP will be applied."
150 (let ((enclosure (newsticker--enclosure item))
151 (beg (point)))
152 (when enclosure
153 (let ((url (cdr (assoc 'url enclosure)))
154 (length (string-to-number (or (cdr (assoc 'length enclosure))
155 "-1")))
156 (type (cdr (assoc 'type enclosure))))
157 (cond ((> length 1048576)
158 (insert (format "Enclosed file (%s, %1.2f MBytes)" type
159 (/ length 1048576))))
160 ((> length 1024)
161 (insert (format "Enclosed file (%s, %1.2f KBytes)" type
162 (/ length 1024))))
163 ((> length 0)
164 (insert (format "Enclosed file (%s, %1.2f Bytes)" type
165 length)))
166 (t
167 (insert (format "Enclosed file (%s, unknown size)" type))))
168 (add-text-properties beg (point)
169 (list 'mouse-face 'highlight
170 'nt-link url
171 'help-echo (format
172 "mouse-2: visit (%s)" url)
173 'keymap keymap
174 'nt-face 'enclosure
175 'nt-type 'desc))
176 (insert "\n")))))
177
178(defun newsticker--print-extra-elements (item keymap)
179 "Insert extra-elements of ITEM in a pretty form into the current buffer.
180KEYMAP is applied."
181 (let ((ignored-elements '(items link title description content
182 content:encoded dc:subject
183 dc:date entry item guid pubDate
184 published updated
185 enclosure))
186 (left-column-width 1))
187 (mapc (lambda (extra-element)
188 (when (listp extra-element) ;; take care of broken xml
189 ;; data, 2007-05-25
190 (unless (memq (car extra-element) ignored-elements)
191 (setq left-column-width (max left-column-width
192 (length (symbol-name
193 (car extra-element))))))))
194 (newsticker--extra item))
195 (mapc (lambda (extra-element)
196 (when (listp extra-element) ;; take care of broken xml
197 ;; data, 2007-05-25
198 (unless (memq (car extra-element) ignored-elements)
199 (newsticker--do-print-extra-element extra-element
200 left-column-width
201 keymap))))
202 (newsticker--extra item))))
203
204(defun newsticker--do-print-extra-element (extra-element width keymap)
205 "Actually print an EXTRA-ELEMENT using the given WIDTH.
206KEYMAP is applied."
207 (let ((name (symbol-name (car extra-element))))
208 (insert (format "%s: " name))
209 (insert (make-string (- width (length name)) ? )))
210 (let (;;(attributes (cadr extra-element)) ;FIXME!!!!
211 (contents (cddr extra-element)))
212 (cond ((listp contents)
213 (mapc (lambda (i)
214 (if (and (stringp i)
215 (string-match "^http://.*" i))
216 (let ((pos (point)))
217 (insert i " ") ; avoid self-reference from the
218 ; nt-link thing
219 (add-text-properties
220 pos (point)
221 (list 'mouse-face 'highlight
222 'nt-link i
223 'help-echo
224 (format "mouse-2: visit (%s)" i)
225 'keymap keymap)))
226 (insert (format "%s" i))))
227 contents))
228 (t
229 (insert (format "%s" contents))))
230 (insert "\n")))
231
232(defun newsticker--image-read (feed-name-symbol disabled)
233 "Read the cached image for FEED-NAME-SYMBOL from disk.
234If DISABLED is non-nil the image will be converted to a disabled look
235\(unless `newsticker-enable-logo-manipulations' is not t\).
236Return the image."
237 (let ((image-name (concat newsticker-imagecache-dirname "/"
238 (symbol-name feed-name-symbol)))
239 (img nil))
240 (when (file-exists-p image-name)
241 (condition-case error-data
242 (setq img (create-image
243 image-name nil nil
244 :conversion (and newsticker-enable-logo-manipulations
245 disabled
246 'disabled)
247 :mask (and newsticker-enable-logo-manipulations
248 'heuristic)
249 :ascent 70))
250 (error
251 (message "Error: cannot create image for %s: %s"
252 feed-name-symbol error-data))))
253 img))
254
255;; the functions we need for retrieval and display
256;;;###autoload
257(defun newsticker-show-news ()
258 "Start reading news. You may want to bind this to a key."
259 (interactive)
260 (newsticker-start t) ;; will start only if not running
261 (funcall newsticker-frontend))
262
263;; ======================================================================
264;;; Toolbar
265;; ======================================================================
266(defconst newsticker--next-item-image
267 (if (fboundp 'create-image)
268 (create-image "/* XPM */
269static char * next_xpm[] = {
270\"24 24 42 1\",
271\" c None\",
272\". c #000000\",
273\"+ c #7EB6DE\",
274\"@ c #82BBE2\",
275\"# c #85BEE4\",
276\"$ c #88C1E7\",
277\"% c #8AC3E8\",
278\"& c #87C1E6\",
279\"* c #8AC4E9\",
280\"= c #8CC6EA\",
281\"- c #8CC6EB\",
282\"; c #88C2E7\",
283\"> c #8BC5E9\",
284\", c #8DC7EB\",
285\"' c #87C0E6\",
286\") c #8AC4E8\",
287\"! c #8BC5EA\",
288\"~ c #8BC4E9\",
289\"{ c #88C1E6\",
290\"] c #89C3E8\",
291\"^ c #86BFE5\",
292\"/ c #83BBE2\",
293\"( c #82BBE1\",
294\"_ c #86C0E5\",
295\": c #87C0E5\",
296\"< c #83BCE2\",
297\"[ c #81B9E0\",
298\"} c #81BAE1\",
299\"| c #78B0D9\",
300\"1 c #7BB3DB\",
301\"2 c #7DB5DD\",
302\"3 c #7DB6DD\",
303\"4 c #72A9D4\",
304\"5 c #75ACD6\",
305\"6 c #76AED7\",
306\"7 c #77AFD8\",
307\"8 c #6BA1CD\",
308\"9 c #6EA4CF\",
309\"0 c #6FA6D1\",
310\"a c #6298C6\",
311\"b c #659BC8\",
312\"c c #5C91C0\",
313\" \",
314\" \",
315\" . \",
316\" .. \",
317\" .+. \",
318\" .@#. \",
319\" .#$%. \",
320\" .&*=-. \",
321\" .;>,,,. \",
322\" .;>,,,=. \",
323\" .')!==~;. \",
324\" .#{]*%;^/. \",
325\" .(#_':#<. \",
326\" .+[@</}. \",
327\" .|1232. \",
328\" .4567. \",
329\" .890. \",
330\" .ab. \",
331\" .c. \",
332\" .. \",
333\" . \",
334\" \",
335\" \",
336\" \"};
337"
338 'xpm t)
339 "Image for the next item button."))
340
341(defconst newsticker--previous-item-image
342 (if (fboundp 'create-image)
343 (create-image "/* XPM */
344static char * previous_xpm[] = {
345\"24 24 39 1\",
346\" c None\",
347\". c #000000\",
348\"+ c #7BB3DB\",
349\"@ c #83BCE2\",
350\"# c #7FB8DF\",
351\"$ c #89C2E7\",
352\"% c #86BFE5\",
353\"& c #83BBE2\",
354\"* c #8CC6EA\",
355\"= c #8BC4E9\",
356\"- c #88C2E7\",
357\"; c #85BEE4\",
358\"> c #8DC7EB\",
359\", c #89C3E8\",
360\"' c #8AC4E8\",
361\") c #8BC5EA\",
362\"! c #88C1E6\",
363\"~ c #8AC4E9\",
364\"{ c #8AC3E8\",
365\"] c #86C0E5\",
366\"^ c #87C0E6\",
367\"/ c #87C0E5\",
368\"( c #82BBE2\",
369\"_ c #81BAE1\",
370\": c #7FB7DF\",
371\"< c #7DB6DD\",
372\"[ c #7DB5DD\",
373\"} c #7CB4DC\",
374\"| c #79B1DA\",
375\"1 c #76ADD7\",
376\"2 c #77AFD8\",
377\"3 c #73AAD4\",
378\"4 c #70A7D1\",
379\"5 c #6EA5D0\",
380\"6 c #6CA2CE\",
381\"7 c #689ECB\",
382\"8 c #6399C7\",
383\"9 c #6095C4\",
384\"0 c #5C90C0\",
385\" \",
386\" \",
387\" . \",
388\" .. \",
389\" .+. \",
390\" .@#. \",
391\" .$%&. \",
392\" .*=-;. \",
393\" .>>*,%. \",
394\" .>>>*,%. \",
395\" .')**=-;. \",
396\" .;!,~{-%&. \",
397\" .;]^/;@#. \",
398\" .(@&_:+. \",
399\" .<[}|1. \",
400\" .2134. \",
401\" .567. \",
402\" .89. \",
403\" .0. \",
404\" .. \",
405\" . \",
406\" \",
407\" \",
408\" \"};
409"
410 'xpm t)
411 "Image for the previous item button."))
412
413(defconst newsticker--previous-feed-image
414 (if (fboundp 'create-image)
415 (create-image "/* XPM */
416static char * prev_feed_xpm[] = {
417\"24 24 52 1\",
418\" c None\",
419\". c #000000\",
420\"+ c #70A7D2\",
421\"@ c #75ADD6\",
422\"# c #71A8D3\",
423\"$ c #79B1DA\",
424\"% c #7BB3DB\",
425\"& c #7DB5DD\",
426\"* c #83BBE2\",
427\"= c #7EB6DE\",
428\"- c #78B0D9\",
429\"; c #7FB7DE\",
430\"> c #88C2E7\",
431\", c #85BEE4\",
432\"' c #80B9E0\",
433\") c #80B8DF\",
434\"! c #8CC6EA\",
435\"~ c #89C3E8\",
436\"{ c #86BFE5\",
437\"] c #81BAE1\",
438\"^ c #7CB4DC\",
439\"/ c #7FB8DF\",
440\"( c #8DC7EB\",
441\"_ c #7BB3DC\",
442\": c #7EB7DE\",
443\"< c #8BC4E9\",
444\"[ c #8AC4E9\",
445\"} c #8AC3E8\",
446\"| c #87C0E6\",
447\"1 c #87C0E5\",
448\"2 c #83BCE2\",
449\"3 c #75ACD6\",
450\"4 c #7FB7DF\",
451\"5 c #77AED8\",
452\"6 c #71A8D2\",
453\"7 c #70A7D1\",
454\"8 c #76ADD7\",
455\"9 c #6CA2CE\",
456\"0 c #699FCC\",
457\"a c #73AAD4\",
458\"b c #6BA1CD\",
459\"c c #669CC9\",
460\"d c #6298C5\",
461\"e c #689ECB\",
462\"f c #6499C7\",
463\"g c #6095C3\",
464\"h c #5C91C0\",
465\"i c #5E93C2\",
466\"j c #5B90C0\",
467\"k c #588CBC\",
468\"l c #578CBC\",
469\"m c #5589BA\",
470\" \",
471\" \",
472\" ... . \",
473\" .+. .. \",
474\" .@. .#. \",
475\" .$. .%@. \",
476\" .&. .*=-. \",
477\" .;. .>,'%. \",
478\" .). .!~{]^. \",
479\" ./. .(!~{]_. \",
480\" .:. .!!<>,'%. \",
481\" .&. .~[}>{*=-. \",
482\" .$. .|1,2/%@. \",
483\" .3. .*]4%56. \",
484\" .7. .^$8#9. \",
485\" .0. .a7bc. \",
486\" .d. .efg. \",
487\" .h. .ij. \",
488\" .k. .l. \",
489\" .m. .. \",
490\" ... . \",
491\" \",
492\" \",
493\" \"};
494"
495 'xpm t)
496 "Image for the previous feed button."))
497
498(defconst newsticker--next-feed-image
499 (if (fboundp 'create-image)
500 (create-image "/* XPM */
501static char * next_feed_xpm[] = {
502\"24 24 57 1\",
503\" c None\",
504\". c #000000\",
505\"+ c #6CA2CE\",
506\"@ c #75ADD6\",
507\"# c #71A8D3\",
508\"$ c #79B1DA\",
509\"% c #7EB7DE\",
510\"& c #7DB5DD\",
511\"* c #81BAE1\",
512\"= c #85BEE4\",
513\"- c #78B0D9\",
514\"; c #7FB7DE\",
515\"> c #83BCE3\",
516\", c #87C1E6\",
517\"' c #8AC4E9\",
518\") c #7BB3DB\",
519\"! c #80B8DF\",
520\"~ c #88C2E7\",
521\"{ c #8BC5E9\",
522\"] c #8DC7EB\",
523\"^ c #7CB4DC\",
524\"/ c #7FB8DF\",
525\"( c #84BDE3\",
526\"_ c #7BB3DC\",
527\": c #83BCE2\",
528\"< c #87C0E6\",
529\"[ c #8AC4E8\",
530\"} c #8BC5EA\",
531\"| c #8CC6EA\",
532\"1 c #88C1E6\",
533\"2 c #89C3E8\",
534\"3 c #8AC3E8\",
535\"4 c #7EB6DE\",
536\"5 c #82BBE1\",
537\"6 c #86C0E5\",
538\"7 c #87C0E5\",
539\"8 c #75ACD6\",
540\"9 c #7AB2DA\",
541\"0 c #81B9E0\",
542\"a c #82BBE2\",
543\"b c #71A8D2\",
544\"c c #70A7D1\",
545\"d c #74ACD6\",
546\"e c #699FCC\",
547\"f c #6EA5D0\",
548\"g c #72A9D4\",
549\"h c #669CC9\",
550\"i c #6298C5\",
551\"j c #679DCA\",
552\"k c #6BA1CD\",
553\"l c #6095C3\",
554\"m c #5C91C0\",
555\"n c #5F94C2\",
556\"o c #5B90C0\",
557\"p c #588CBC\",
558\"q c #578CBC\",
559\"r c #5589BA\",
560\" \",
561\" \",
562\" . ... \",
563\" .. .+. \",
564\" .@. .#. \",
565\" .$%. .@. \",
566\" .&*=. .-. \",
567\" .;>,'. .). \",
568\" .!=~{]. .^. \",
569\" ./(~{]]. ._. \",
570\" .%:<[}||. .). \",
571\" .&*=12'3~. .-. \",
572\" .$45=6<7. .@. \",
573\" .8940a:. .b. \",
574\" .cd-)&. .+. \",
575\" .efg8. .h. \",
576\" .ijk. .l. \",
577\" .mn. .o. \",
578\" .p. .q. \",
579\" .. .r. \",
580\" . ... \",
581\" \",
582\" \",
583\" \"};
584"
585 'xpm t)
586 "Image for the next feed button."))
587
588(defconst newsticker--mark-read-image
589 (if (fboundp 'create-image)
590 (create-image "/* XPM */
591static char * mark_read_xpm[] = {
592\"24 24 44 1\",
593\" c None\",
594\". c #C20000\",
595\"+ c #BE0000\",
596\"@ c #C70000\",
597\"# c #CE0000\",
598\"$ c #C90000\",
599\"% c #BD0000\",
600\"& c #CB0000\",
601\"* c #D10000\",
602\"= c #D70000\",
603\"- c #D30000\",
604\"; c #CD0000\",
605\"> c #C60000\",
606\", c #D40000\",
607\"' c #DA0000\",
608\") c #DE0000\",
609\"! c #DB0000\",
610\"~ c #D60000\",
611\"{ c #D00000\",
612\"] c #DC0000\",
613\"^ c #E00000\",
614\"/ c #E40000\",
615\"( c #E10000\",
616\"_ c #DD0000\",
617\": c #D80000\",
618\"< c #E50000\",
619\"[ c #E70000\",
620\"} c #E60000\",
621\"| c #E20000\",
622\"1 c #E90000\",
623\"2 c #E80000\",
624\"3 c #E30000\",
625\"4 c #DF0000\",
626\"5 c #D90000\",
627\"6 c #CC0000\",
628\"7 c #C10000\",
629\"8 c #C30000\",
630\"9 c #BF0000\",
631\"0 c #B90000\",
632\"a c #BC0000\",
633\"b c #BB0000\",
634\"c c #B80000\",
635\"d c #B50000\",
636\"e c #B70000\",
637\" \",
638\" \",
639\" \",
640\" . + \",
641\" +@# $.% \",
642\" &*= -;> \",
643\" ,') !~{ \",
644\" ]^/ (_: \",
645\" (<[ }|) \",
646\" <[1 2<| \",
647\" }222[< \",
648\" }}}< \",
649\" 333| \",
650\" _4^4)] \",
651\" ~:' 5=- \",
652\" 6{- *#$ \",
653\" 7>$ @89 \",
654\" 0a+ %bc \",
655\" ddc edd \",
656\" ddd ddd \",
657\" d d \",
658\" \",
659\" \",
660\" \"};
661"
662 'xpm t)
663 "Image for the next feed button."))
664
665(defconst newsticker--mark-immortal-image
666 (if (fboundp 'create-image)
667 (create-image "/* XPM */
668static char * mark_immortal_xpm[] = {
669\"24 24 93 2\",
670\" c None\",
671\". c #171717\",
672\"+ c #030303\",
673\"@ c #000000\",
674\"# c #181818\",
675\"$ c #090909\",
676\"% c #FFC960\",
677\"& c #FFCB61\",
678\"* c #FFCB62\",
679\"= c #FFC961\",
680\"- c #FFC75F\",
681\"; c #FFC65E\",
682\"> c #FFCA61\",
683\", c #FFCD63\",
684\"' c #FFCF65\",
685\") c #FFD065\",
686\"! c #FFCE64\",
687\"~ c #FFC35C\",
688\"{ c #FFC45D\",
689\"] c #FFD166\",
690\"^ c #FFD267\",
691\"/ c #FFD368\",
692\"( c #FFD167\",
693\"_ c #FFC05A\",
694\": c #010101\",
695\"< c #040404\",
696\"[ c #FFCC62\",
697\"} c #FFD569\",
698\"| c #FFD56A\",
699\"1 c #FFC860\",
700\"2 c #FFC25B\",
701\"3 c #FFBB56\",
702\"4 c #020202\",
703\"5 c #060606\",
704\"6 c #FFC15B\",
705\"7 c #FFC85F\",
706\"8 c #FFD469\",
707\"9 c #FFD66A\",
708\"0 c #FFBC57\",
709\"a c #1B1B1B\",
710\"b c #070707\",
711\"c c #FFBA55\",
712\"d c #FFB451\",
713\"e c #FFB954\",
714\"f c #FFB350\",
715\"g c #FFB652\",
716\"h c #FFBE58\",
717\"i c #FFCD64\",
718\"j c #FFD066\",
719\"k c #FFC059\",
720\"l c #FFB14E\",
721\"m c #0B0B0B\",
722\"n c #FFBB55\",
723\"o c #FFC15A\",
724\"p c #FFB552\",
725\"q c #FFAD4B\",
726\"r c #080808\",
727\"s c #FFAF4C\",
728\"t c #FFB853\",
729\"u c #FFA948\",
730\"v c #050505\",
731\"w c #FFB04E\",
732\"x c #FFB753\",
733\"y c #FFBC56\",
734\"z c #FFC55D\",
735\"A c #FFC55E\",
736\"B c #FFC45C\",
737\"C c #FFBD57\",
738\"D c #FFB854\",
739\"E c #FFB34F\",
740\"F c #FFAB4A\",
741\"G c #FFA545\",
742\"H c #FFAA49\",
743\"I c #FFB04D\",
744\"J c #FFB551\",
745\"K c #FFBF58\",
746\"L c #FFB24F\",
747\"M c #FFAC4A\",
748\"N c #FFA646\",
749\"O c #FFA344\",
750\"P c #FFA848\",
751\"Q c #FFB14F\",
752\"R c #FFAF4D\",
753\"S c #FFA546\",
754\"T c #FFA243\",
755\"U c #FFA445\",
756\"V c #FFAE4C\",
757\"W c #FFA444\",
758\"X c #FFA142\",
759\"Y c #FF9F41\",
760\"Z c #0A0A0A\",
761\"` c #FF9E40\",
762\" . c #FF9F40\",
763\" \",
764\" \",
765\" \",
766\" . + @ @ + # \",
767\" $ @ % & * * = - + + \",
768\" @ ; > , ' ) ' ! * - ~ @ \",
769\" @ { > ! ] ^ / / ( ' * ; _ : \",
770\" < _ ; [ ) / } | } / ] , 1 2 3 4 \",
771\" 5 6 7 , ] 8 9 9 9 } ^ ! = ~ 0 a \",
772\" b c 6 - , ] 8 9 9 9 } ^ ! % ~ 0 d 5 \",
773\" : e _ ; * ) / 8 } } / ] , 1 2 3 f 5 \",
774\" : g h { = i j ^ / ^ ] ! * ; k e l m \",
775\" : f n o ; > , ' ) ' ! * - 2 0 p q r \",
776\" : s g 0 6 ; % > * * = - ~ h t l u r \",
777\" v u w x y k ~ z A z B o C D E F G b \",
778\" 5 H I J e 0 h K h C c x L M N . \",
779\" 4 O P q Q d g x g J L R H S T < \",
780\" @ T U P F q V q M H N W X + \",
781\" @ Y T O W G G W O X Y @ \",
782\" 4 Z ` Y Y Y .` 4 4 \",
783\" 5 : : @ @ Z \",
784\" \",
785\" \",
786\" \"};
787"
788 'xpm t)
789 "Image for the next feed button."))
790
791(defconst newsticker--narrow-image
792 (if (fboundp 'create-image)
793 (create-image "/* XPM */
794static char * narrow_xpm[] = {
795\"24 24 48 1\",
796\" c None\",
797\". c #000000\",
798\"+ c #969696\",
799\"@ c #9E9E9E\",
800\"# c #A4A4A4\",
801\"$ c #AAAAAA\",
802\"% c #AEAEAE\",
803\"& c #B1B1B1\",
804\"* c #B3B3B3\",
805\"= c #B4B4B4\",
806\"- c #B2B2B2\",
807\"; c #AFAFAF\",
808\"> c #ABABAB\",
809\", c #A6A6A6\",
810\"' c #A0A0A0\",
811\") c #989898\",
812\"! c #909090\",
813\"~ c #73AAD4\",
814\"{ c #7AB2DA\",
815\"] c #7FB8DF\",
816\"^ c #84BDE3\",
817\"/ c #88C2E7\",
818\"( c #8BC5E9\",
819\"_ c #8DC7EB\",
820\": c #8CC6EA\",
821\"< c #89C3E8\",
822\"[ c #86BFE5\",
823\"} c #81BAE1\",
824\"| c #7BB3DC\",
825\"1 c #75ACD6\",
826\"2 c #6DA4CF\",
827\"3 c #979797\",
828\"4 c #A3A3A3\",
829\"5 c #A8A8A8\",
830\"6 c #ADADAD\",
831\"7 c #ACACAC\",
832\"8 c #A9A9A9\",
833\"9 c #A5A5A5\",
834\"0 c #9A9A9A\",
835\"a c #929292\",
836\"b c #8C8C8C\",
837\"c c #808080\",
838\"d c #818181\",
839\"e c #838383\",
840\"f c #848484\",
841\"g c #858585\",
842\"h c #868686\",
843\"i c #828282\",
844\" \",
845\" \",
846\" \",
847\" .................. \",
848\" .+@#$%&*=*-;>,')!. \",
849\" .................. \",
850\" \",
851\" \",
852\" .................. \",
853\" .~{]^/(___:<[}|12. \",
854\" .................. \",
855\" \",
856\" \",
857\" .................. \",
858\" .!3@45>666789'0ab. \",
859\" .................. \",
860\" \",
861\" \",
862\" .................. \",
863\" .cccdefghhgficccc. \",
864\" .................. \",
865\" \",
866\" \",
867\" \"};
868"
869 'xpm t)
870 "Image for the next feed button."))
871
872(defconst newsticker--get-all-image
873 (if (fboundp 'create-image)
874 (create-image "/* XPM */
875static char * get_all_xpm[] = {
876\"24 24 70 1\",
877\" c None\",
878\". c #000000\",
879\"+ c #F3DA00\",
880\"@ c #F5DF00\",
881\"# c #F7E300\",
882\"$ c #F9E700\",
883\"% c #FAEA00\",
884\"& c #FBEC00\",
885\"* c #FBED00\",
886\"= c #FCEE00\",
887\"- c #FAEB00\",
888\"; c #F9E800\",
889\"> c #F8E500\",
890\", c #F6E000\",
891\"' c #F4DB00\",
892\") c #F1D500\",
893\"! c #EFD000\",
894\"~ c #B7CA00\",
895\"{ c #BFD100\",
896\"] c #C5D700\",
897\"^ c #CBDB00\",
898\"/ c #CFDF00\",
899\"( c #D2E200\",
900\"_ c #D4E400\",
901\": c #D3E300\",
902\"< c #D0E000\",
903\"[ c #CCDD00\",
904\"} c #C7D800\",
905\"| c #C1D300\",
906\"1 c #BACC00\",
907\"2 c #B1C500\",
908\"3 c #A8BC00\",
909\"4 c #20A900\",
910\"5 c #22AF00\",
911\"6 c #24B500\",
912\"7 c #26B900\",
913\"8 c #27BC00\",
914\"9 c #27BE00\",
915\"0 c #28BF00\",
916\"a c #27BD00\",
917\"b c #26BA00\",
918\"c c #25B600\",
919\"d c #23B100\",
920\"e c #21AB00\",
921\"f c #1FA400\",
922\"g c #1C9B00\",
923\"h c #21AA00\",
924\"i c #24B300\",
925\"j c #25B800\",
926\"k c #25B700\",
927\"l c #24B400\",
928\"m c #23B000\",
929\"n c #1FA500\",
930\"o c #1D9E00\",
931\"p c #20A800\",
932\"q c #21AC00\",
933\"r c #23B200\",
934\"s c #22AD00\",
935\"t c #1D9F00\",
936\"u c #20A700\",
937\"v c #1EA100\",
938\"w c #1C9C00\",
939\"x c #1DA000\",
940\"y c #1B9800\",
941\"z c #1A9600\",
942\"A c #1A9700\",
943\"B c #1A9500\",
944\"C c #199200\",
945\"D c #189100\",
946\"E c #178C00\",
947\" \",
948\" \",
949\" \",
950\" \",
951\" ................... \",
952\" .+@#$%&*=*&-;>,')!. \",
953\" ................... \",
954\" \",
955\" ................... \",
956\" .~{]^/(___:<[}|123. \",
957\" ................... \",
958\" \",
959\" ................... \",
960\" .45678909abcdefg. \",
961\" .h5icj7jklmeno. \",
962\" .pq5drrmshft. \",
963\" .fu4h4pnvw. \",
964\" .oxvxtwy. \",
965\" .zAAzB. \",
966\" .CCD. \",
967\" .E. \",
968\" . \",
969\" \",
970\" \"};
971"
972 'xpm t)
973 "Image for the next feed button."))
974
975(defconst newsticker--update-image
976 (if (fboundp 'create-image)
977 (create-image "/* XPM */
978static char * update_xpm[] = {
979\"24 24 37 1\",
980\" c None\",
981\". c #076D00\",
982\"+ c #0A8600\",
983\"@ c #0A8800\",
984\"# c #098400\",
985\"$ c #087200\",
986\"% c #087900\",
987\"& c #098500\",
988\"* c #098100\",
989\"= c #087600\",
990\"- c #097E00\",
991\"; c #097F00\",
992\"> c #0A8700\",
993\", c #0A8C00\",
994\"' c #097C00\",
995\") c #098300\",
996\"! c #0A8900\",
997\"~ c #0A8E00\",
998\"{ c #0B9200\",
999\"] c #087700\",
1000\"^ c #076E00\",
1001\"/ c #076C00\",
1002\"( c #076B00\",
1003\"_ c #076A00\",
1004\": c #076900\",
1005\"< c #076800\",
1006\"[ c #066700\",
1007\"} c #066500\",
1008\"| c #066400\",
1009\"1 c #066300\",
1010\"2 c #066600\",
1011\"3 c #066200\",
1012\"4 c #076700\",
1013\"5 c #065E00\",
1014\"6 c #066100\",
1015\"7 c #065F00\",
1016\"8 c #066000\",
1017\" \",
1018\" \",
1019\" \",
1020\" . +@@@+# \",
1021\" $% &@ +* \",
1022\" =-# ; \",
1023\" %*>, ' \",
1024\" ')!~{ = \",
1025\" ]$ \",
1026\" ^ ^ \",
1027\" . . \",
1028\" / ( \",
1029\" _ : \",
1030\" < [ \",
1031\" } | \",
1032\" [[ \",
1033\" 1 $.:23 \",
1034\" 3 4}35 \",
1035\" 6 655 \",
1036\" 76 85 55 \",
1037\" 5555555 5 \",
1038\" \",
1039\" \",
1040\" \"};
1041"
1042 'xpm t)
1043 "Image for the update button."))
1044
1045(defconst newsticker--browse-image
1046 (if (fboundp 'create-image)
1047 (create-image "/* XPM */
1048static char * visit_xpm[] = {
1049\"24 24 39 1\",
1050\" c None\",
1051\". c #000000\",
1052\"+ c #FFFFFF\",
1053\"@ c #00E63D\",
1054\"# c #00E83E\",
1055\"$ c #00E73D\",
1056\"% c #00E93E\",
1057\"& c #00E63C\",
1058\"* c #00E53C\",
1059\"= c #00E23B\",
1060\"- c #00E33B\",
1061\"; c #00E83D\",
1062\"> c #00E13A\",
1063\", c #00DD38\",
1064\"' c #00DE38\",
1065\") c #00E23A\",
1066\"! c #00E43C\",
1067\"~ c #00DF39\",
1068\"{ c #00DB37\",
1069\"] c #00D634\",
1070\"^ c #00D734\",
1071\"/ c #00E039\",
1072\"( c #00DC37\",
1073\"_ c #00D835\",
1074\": c #00D332\",
1075\"< c #00CD2F\",
1076\"[ c #00DB36\",
1077\"} c #00D433\",
1078\"| c #00CF30\",
1079\"1 c #00DA36\",
1080\"2 c #00D936\",
1081\"3 c #00D533\",
1082\"4 c #00D131\",
1083\"5 c #00CE2F\",
1084\"6 c #00CC2F\",
1085\"7 c #00CA2D\",
1086\"8 c #00C62B\",
1087\"9 c #00C52A\",
1088\"0 c #00BE27\",
1089\" \",
1090\" \",
1091\" . \",
1092\" .+. \",
1093\" .+++. \",
1094\" .++.++. \",
1095\" .++.@.++. \",
1096\" .++.##$.++. \",
1097\" .++.%%%#&.++. \",
1098\" .++.$%%%#*=.++. \",
1099\" .++.-@;##$*>,.++. \",
1100\" .++.')!&@@*=~{].++. \",
1101\" .++.^{~>---)/(_:<.++. \",
1102\" .++.^[,~/~'(_}|.++. \",
1103\" .++.]_1[12^:|.++. \",
1104\" .++.:}33:45.++. \",
1105\" .++.<5567.++. \",
1106\" .++.889.++. \",
1107\" .++.0.++. \",
1108\" .++.++. \",
1109\" .+++. \",
1110\" .+. \",
1111\" . \",
1112\" \"};
1113"
1114 'xpm t)
1115 "Image for the browse button."))
1116
1117(provide 'newsticker-reader)
1118;;; newsticker-reader.el ends here
diff --git a/lisp/net/newsticker-ticker.el b/lisp/net/newsticker-ticker.el
new file mode 100644
index 00000000000..5b498aa2dd3
--- /dev/null
+++ b/lisp/net/newsticker-ticker.el
@@ -0,0 +1,291 @@
1;; newsticker-ticker.el --- modeline ticker for newsticker.
2
3;; Copyright (C) 2008 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; Author: Ulf Jasper <ulf.jasper@web.de>
8;; Filename: newsticker-ticker.el
9;; URL: http://www.nongnu.org/newsticker
10;; Keywords: News, RSS, Atom
11;; Time-stamp: "7. Juni 2008, 15:12:27 (ulf)"
12;; CVS-Version: $Id: newsticker-ticker.el,v 1.6 2008/05/04 15:05:35 u11 Exp $
13
14;; ======================================================================
15
16;; GNU Emacs is free software: you can redistribute it and/or modify
17;; it under the terms of the GNU General Public License as published by
18;; the Free Software Foundation, either version 3 of the License, or
19;; (at your option) any later version.
20
21;; GNU Emacs is distributed in the hope that it will be useful,
22;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24;; GNU General Public License for more details.
25
26;; You should have received a copy of the GNU General Public License
27;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28
29;; ======================================================================
30
31;;; Commentary:
32
33;; See newsticker.el
34
35;; ======================================================================
36;;; Code:
37
38(require 'newsticker-backend)
39
40(defvar newsticker--ticker-timer nil
41 "Timer for newsticker ticker.")
42
43;;;###autoload
44(defun newsticker-ticker-running-p ()
45 "Check whether newsticker's actual ticker is running.
46Return t if ticker is running, nil otherwise. Newsticker is
47considered to be running if the newsticker timer list is not
48empty."
49 (timerp newsticker--ticker-timer))
50
51;; customization group ticker
52(defgroup newsticker-ticker nil
53 "Settings for the headline ticker."
54 :group 'newsticker)
55
56(defun newsticker--set-customvar-ticker (symbol value)
57 "Set newsticker-variable SYMBOL value to VALUE.
58Calls all actions which are necessary in order to make the new
59value effective."
60 (if (or (not (boundp symbol))
61 (equal (symbol-value symbol) value))
62 (set symbol value)
63 ;; something must have changed -- restart ticker
64 (when (newsticker-running-p)
65 (message "Restarting ticker")
66 (newsticker-stop-ticker)
67 (newsticker--ticker-text-setup)
68 (newsticker-start-ticker)
69 (message ""))))
70
71(defcustom newsticker-ticker-interval
72 0.3
73 "Time interval for displaying news items in the echo area (seconds).
74If equal or less than 0 no messages are shown in the echo area. For
75smooth display (see `newsticker-scroll-smoothly') a value of 0.3 seems
76reasonable. For non-smooth display a value of 10 is a good starting
77point."
78 :type 'number
79 :set 'newsticker--set-customvar-ticker
80 :group 'newsticker-ticker)
81
82(defcustom newsticker-scroll-smoothly
83 t
84 "Decides whether to flash or scroll news items.
85If t the news headlines are scrolled (more-or-less) smoothly in the echo
86area. If nil one headline after another is displayed in the echo area.
87The variable `newsticker-ticker-interval' determines how fast this
88display moves/changes and whether headlines are shown in the echo area
89at all. If you change `newsticker-scroll-smoothly' you should also change
90`newsticker-ticker-interval'."
91 :type 'boolean
92 :group 'newsticker-ticker)
93
94(defcustom newsticker-hide-immortal-items-in-echo-area
95 t
96 "Decides whether to show immortal/non-expiring news items in the ticker.
97If t the echo area will not show immortal items. See also
98`newsticker-hide-old-items-in-echo-area'."
99 :type 'boolean
100 :set 'newsticker--set-customvar-ticker
101 :group 'newsticker-ticker)
102
103(defcustom newsticker-hide-old-items-in-echo-area
104 t
105 "Decides whether to show only the newest news items in the ticker.
106If t the echo area will show only new items, i.e. only items which have
107been added between the last two retrievals."
108 :type 'boolean
109 :set 'newsticker--set-customvar-ticker
110 :group 'newsticker-ticker)
111
112(defcustom newsticker-hide-obsolete-items-in-echo-area
113 t
114 "Decides whether to show obsolete items items in the ticker.
115If t the echo area will not show obsolete items. See also
116`newsticker-hide-old-items-in-echo-area'."
117 :type 'boolean
118 :set 'newsticker--set-customvar-ticker
119 :group 'newsticker-ticker)
120
121(defun newsticker--display-tick ()
122 "Called from the display timer.
123This function calls a display function, according to the variable
124`newsticker-scroll-smoothly'."
125 (if newsticker-scroll-smoothly
126 (newsticker--display-scroll)
127 (newsticker--display-jump)))
128
129(defsubst newsticker--echo-area-clean-p ()
130 "Check whether somebody is using the echo area / minibuffer.
131Return t if echo area and minibuffer are unused."
132 (not (or (active-minibuffer-window)
133 (and (current-message)
134 (not (string= (current-message)
135 newsticker--prev-message))))))
136
137(defun newsticker--display-jump ()
138 "Called from the display timer.
139This function displays the next ticker item in the echo area, unless
140there is another message displayed or the minibuffer is active."
141 (let ((message-log-max nil));; prevents message text from being logged
142 (when (newsticker--echo-area-clean-p)
143 (setq newsticker--item-position (1+ newsticker--item-position))
144 (when (>= newsticker--item-position (length newsticker--item-list))
145 (setq newsticker--item-position 0))
146 (setq newsticker--prev-message
147 (nth newsticker--item-position newsticker--item-list))
148 (message "%s" newsticker--prev-message))))
149
150(defun newsticker--display-scroll ()
151 "Called from the display timer.
152This function scrolls the ticker items in the echo area, unless
153there is another message displayed or the minibuffer is active."
154 (when (newsticker--echo-area-clean-p)
155 (let* ((width (- (frame-width) 1))
156 (message-log-max nil);; prevents message text from being logged
157 (i newsticker--item-position)
158 subtext
159 (s-text newsticker--scrollable-text)
160 (l (length s-text)))
161 ;; don't show anything if there is nothing to show
162 (unless (< (length s-text) 1)
163 ;; repeat the ticker string if it is shorter than frame width
164 (while (< (length s-text) width)
165 (setq s-text (concat s-text s-text)))
166 ;; get the width of the printed string
167 (setq l (length s-text))
168 (cond ((< i (- l width))
169 (setq subtext (substring s-text i (+ i width))))
170 (t
171 (setq subtext (concat
172 (substring s-text i l)
173 (substring s-text 0 (- width (- l i)))))))
174 ;; Take care of multibyte strings, for which (string-width) is
175 ;; larger than (length).
176 ;; Actually, such strings may be smaller than (frame-width)
177 ;; because return values of (string-width) are too large:
178 ;; (string-width "<japanese character>") => 2
179 (let ((t-width (1- (length subtext))))
180 (while (> (string-width subtext) width)
181 (setq subtext (substring subtext 0 t-width))
182 (setq t-width (1- t-width))))
183 ;; show the ticker text and save current position
184 (message "%s" subtext)
185 (setq newsticker--prev-message subtext)
186 (setq newsticker--item-position (1+ i))
187 (when (>= newsticker--item-position l)
188 (setq newsticker--item-position 0))))))
189
190;;;###autoload
191(defun newsticker-start-ticker ()
192 "Start newsticker's ticker (but not the news retrieval).
193Start display timer for the actual ticker if wanted and not
194running already."
195 (interactive)
196 (if (and (> newsticker-ticker-interval 0)
197 (not newsticker--ticker-timer))
198 (setq newsticker--ticker-timer
199 (run-at-time newsticker-ticker-interval
200 newsticker-ticker-interval
201 'newsticker--display-tick))))
202
203(defun newsticker-stop-ticker ()
204 "Stop newsticker's ticker (but not the news retrieval)."
205 (interactive)
206 (when newsticker--ticker-timer
207 (cancel-timer newsticker--ticker-timer)
208 (setq newsticker--ticker-timer nil)))
209
210;; ======================================================================
211;;; Manipulation of ticker text
212;; ======================================================================
213(defun newsticker--ticker-text-setup ()
214 "Build the ticker text which is scrolled or flashed in the echo area."
215 ;; reset scrollable text
216 (setq newsticker--scrollable-text "")
217 (setq newsticker--item-list nil)
218 (setq newsticker--item-position 0)
219 ;; build scrollable text from cache data
220 (let ((have-something nil))
221 (mapc
222 (lambda (feed)
223 (let ((feed-name (symbol-name (car feed))))
224 (let ((num-new (newsticker--stat-num-items (car feed) 'new))
225 (num-old (newsticker--stat-num-items (car feed) 'old))
226 (num-imm (newsticker--stat-num-items (car feed) 'immortal))
227 (num-obs (newsticker--stat-num-items (car feed) 'obsolete)))
228 (when (or (> num-new 0)
229 (and (> num-old 0)
230 (not newsticker-hide-old-items-in-echo-area))
231 (and (> num-imm 0)
232 (not newsticker-hide-immortal-items-in-echo-area))
233 (and (> num-obs 0)
234 (not newsticker-hide-obsolete-items-in-echo-area)))
235 (setq have-something t)
236 (mapc
237 (lambda (item)
238 (let ((title (replace-regexp-in-string
239 "[\r\n]+" " "
240 (newsticker--title item)))
241 (age (newsticker--age item)))
242 (unless (string= title newsticker--error-headline)
243 (when
244 (or (eq age 'new)
245 (and (eq age 'old)
246 (not newsticker-hide-old-items-in-echo-area))
247 (and (eq age 'obsolete)
248 (not
249 newsticker-hide-obsolete-items-in-echo-area))
250 (and (eq age 'immortal)
251 (not
252 newsticker-hide-immortal-items-in-echo-area)))
253 (setq title (newsticker--remove-whitespace title))
254 ;; add to flash list
255 (add-to-list 'newsticker--item-list
256 (concat feed-name ": " title) t)
257 ;; and to the scrollable text
258 (setq newsticker--scrollable-text
259 (concat newsticker--scrollable-text
260 " " feed-name ": " title " +++"))))))
261 (cdr feed))))))
262 newsticker--cache)
263 (when have-something
264 (setq newsticker--scrollable-text
265 (concat "+++ "
266 (format-time-string "%A, %H:%M"
267 newsticker--latest-update-time)
268 " ++++++" newsticker--scrollable-text)))))
269
270(defun newsticker--ticker-text-remove (feed title)
271 "Remove the item of FEED with TITLE from the ticker text."
272 ;; reset scrollable text
273 (setq newsticker--item-position 0)
274 (let ((feed-name (symbol-name feed))
275 (t-title (replace-regexp-in-string "[\r\n]+" " " title)))
276 ;; remove from flash list
277 (setq newsticker--item-list (remove (concat feed-name ": " t-title)
278 newsticker--item-list))
279 ;; and from the scrollable text
280 (setq newsticker--scrollable-text
281 (replace-regexp-in-string
282 (regexp-quote (concat " " feed-name ": " t-title " +++"))
283 ""
284 newsticker--scrollable-text))
285 (if (string-match (concat "^\\+\\+\\+ [A-Z][a-z]+, "
286 "[012]?[0-9]:[0-9][0-9] \\+\\+\\+\\+\\+\\+$")
287 newsticker--scrollable-text)
288 (setq newsticker--scrollable-text ""))))
289
290(provide 'newsticker-ticker)
291;;; newsticker-ticker.el ends here
diff --git a/lisp/net/newsticker-treeview.el b/lisp/net/newsticker-treeview.el
new file mode 100644
index 00000000000..24fbf0436dd
--- /dev/null
+++ b/lisp/net/newsticker-treeview.el
@@ -0,0 +1,1982 @@
1;;; newsticker-treeview.el --- Treeview frontend for newsticker.
2
3;; Copyright (C) 2008 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; Author: Ulf Jasper <ulf.jasper@web.de>
8;; Filename: newsticker-treeview.el
9;; URL: http://www.nongnu.org/newsticker
10;; Created: 2007
11;; Keywords: News, RSS, Atom
12;; Time-stamp: "7. Juni 2008, 15:10:44 (ulf)"
13;; CVS-Version: $Id: newsticker-treeview.el,v 1.17 2008/06/05 19:57:09 u11 Exp $
14
15;; ======================================================================
16
17;; GNU Emacs is free software: you can redistribute it and/or modify
18;; it under the terms of the GNU General Public License as published by
19;; the Free Software Foundation, either version 3 of the License, or
20;; (at your option) any later version.
21
22;; GNU Emacs is distributed in the hope that it will be useful,
23;; but WITHOUT ANY WARRANTY; without even the implied warranty of
24;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25;; GNU General Public License for more details.
26
27;; You should have received a copy of the GNU General Public License
28;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
29
30;; ======================================================================
31;;; Commentary:
32
33;; See newsticker.el
34
35;; ======================================================================
36;;; History:
37;;
38
39
40;; ======================================================================
41;;; Code:
42(require 'newsticker-reader)
43(require 'widget)
44(require 'tree-widget)
45(require 'wid-edit)
46
47;; ======================================================================
48;;; Customization
49;; ======================================================================
50(defgroup newsticker-treeview nil
51 "Settings for the tree view reader."
52 :group 'newsticker-reader)
53
54(defface newsticker-treeview-face
55 '((((class color) (background dark))
56 (:family "helvetica" :foreground "misty rose" :bold nil))
57 (((class color) (background light))
58 (:family "helvetica" :foreground "black" :bold nil)))
59 "Face for newsticker tree."
60 :group 'newsticker-treeview)
61
62(defface newsticker-treeview-new-face
63 '((((class color) (background dark))
64 (:inherit newsticker-treeview-face :bold t))
65 (((class color) (background light))
66 (:inherit newsticker-treeview-face :bold t)))
67 "Face for newsticker tree."
68 :group 'newsticker-treeview)
69
70(defface newsticker-treeview-old-face
71 '((((class color) (background dark))
72 (:inherit newsticker-treeview-face))
73 (((class color) (background light))
74 (:inherit newsticker-treeview-face)))
75 "Face for newsticker tree."
76 :group 'newsticker-treeview)
77
78(defface newsticker-treeview-immortal-face
79 '((((class color) (background dark))
80 (:inherit newsticker-treeview-face :foreground "orange" :italic t))
81 (((class color) (background light))
82 (:inherit newsticker-treeview-face :foreground "blue" :italic t)))
83 "Face for newsticker tree."
84 :group 'newsticker-treeview)
85
86(defface newsticker-treeview-obsolete-face
87 '((((class color) (background dark))
88 (:inherit newsticker-treeview-face :strike-through t))
89 (((class color) (background light))
90 (:inherit newsticker-treeview-face :strike-through t)))
91 "Face for newsticker tree."
92 :group 'newsticker-treeview)
93
94(defface newsticker-treeview-selection-face
95 '((((class color) (background dark))
96 (:background "#bbbbff"))
97 (((class color) (background light))
98 (:background "#bbbbff")))
99 "Face for newsticker selection."
100 :group 'newsticker-treeview)
101
102(defcustom newsticker-treeview-own-frame
103 t
104 "Decides whether newsticker creates and uses its own frame."
105 :type 'boolean
106 :group 'newsticker-treeview)
107
108(defcustom newsticker-treeview-automatically-mark-displayed-items-as-old
109 t
110 "Decides whether to automatically mark displayed items as old.
111If t an item is marked as old as soon as it is displayed. This
112applies to newsticker only."
113 :type 'boolean
114 :group 'newsticker-treeview)
115
116(defvar newsticker-groups
117 '("Feeds")
118 "List of feed groups, used in the treeview frontend.
119Each element must be a list consisting of strings. The first
120element gives the title of the group, the following elements the
121names of feeds that belong to the group.
122FIXME")
123
124(defcustom newsticker-groups-filename
125 "~/.newsticker-groups"
126 "Name of the newsticker groups settings file."
127 :type 'string
128 :group 'newsticker-treeview)
129
130;; ======================================================================
131;;; internal variables
132;; ======================================================================
133(defvar newsticker--treeview-windows nil)
134(defvar newsticker--treeview-buffers nil)
135(defvar newsticker--treeview-current-feed nil)
136(defvar newsticker--treeview-current-vfeed nil)
137(defvar newsticker--treeview-list-show-feed nil)
138(defvar newsticker--saved-window-config nil)
139(defvar newsticker--window-config nil)
140;; (makunbound 'newsticker--selection-overlay) ;; FIXME
141(defvar newsticker--selection-overlay nil
142 "Highlight the selected tree node.")
143;;(makunbound 'newsticker--tree-selection-overlay) ;; FIXME
144(defvar newsticker--tree-selection-overlay nil
145 "Highlight the selected list item.")
146;;(makunbound 'newsticker--frame);; FIXME
147(defvar newsticker--frame nil "Special frame for newsticker windows.")
148(defvar newsticker--treeview-list-sort-order 'sort-by-time)
149(defvar newsticker--treeview-current-node-id nil)
150(defvar newsticker--treeview-current-tree nil)
151(defvar newsticker--treeview-feed-tree nil)
152(defvar newsticker--treeview-vfeed-tree nil)
153
154;; maps for the clickable portions
155(defvar newsticker--treeview-url-keymap
156 (let ((map (make-sparse-keymap 'newsticker--treeview-url-keymap)))
157 (define-key map [mouse-1] 'newsticker-treeview-mouse-browse-url)
158 (define-key map [mouse-2] 'newsticker-treeview-mouse-browse-url)
159 (define-key map "\n" 'newsticker-treeview-browse-url)
160 (define-key map "\C-m" 'newsticker-treeview-browse-url)
161 (define-key map [(control return)] 'newsticker-handle-url)
162 map)
163 "Key map for click-able headings in the newsticker treeview buffers.")
164
165
166;; ======================================================================
167;;; short cuts
168;; ======================================================================
169(defsubst newsticker--treeview-tree-buffer ()
170 "Return the tree buffer of the newsticker treeview."
171 (nth 0 newsticker--treeview-buffers))
172(defsubst newsticker--treeview-list-buffer ()
173 "Return the list buffer of the newsticker treeview."
174 (nth 1 newsticker--treeview-buffers))
175(defsubst newsticker--treeview-item-buffer ()
176 "Return the item buffer of the newsticker treeview."
177 (nth 2 newsticker--treeview-buffers))
178(defsubst newsticker--treeview-tree-window ()
179 "Return the tree window of the newsticker treeview."
180 (nth 0 newsticker--treeview-windows))
181(defsubst newsticker--treeview-list-window ()
182 "Return the list window of the newsticker treeview."
183 (nth 1 newsticker--treeview-windows))
184(defsubst newsticker--treeview-item-window ()
185 "Return the item window of the newsticker treeview."
186 (nth 2 newsticker--treeview-windows))
187
188;; ======================================================================
189;;; utility functions
190;; ======================================================================
191(defun newsticker--treeview-get-id (parent i)
192 "Create an id for a newsticker treeview node.
193PARENT is the node's parent, I is an integer."
194 ;;(message "newsticker--treeview-get-id %s"
195 ;; (format "%s-%d" (widget-get parent :nt-id) i))
196 (format "%s-%d" (widget-get parent :nt-id) i))
197
198(defun newsticker--treeview-ids-eq (id1 id2)
199 "Return non-nil if ids ID1 and ID2 are equal."
200 ;;(message "%s/%s" (or id1 -1) (or id2 -1))
201 (and id1 id2 (string= id1 id2)))
202
203(defun newsticker--treeview-nodes-eq (node1 node2)
204 "Compare treeview nodes NODE1 and NODE2 for equality.
205Nodes are equal if the have the same newsticker-id. Note that
206during re-tagging and collapsing/expanding nodes change, while
207their id stays constant."
208 (let ((id1 (widget-get node1 :nt-id))
209 (id2 (widget-get node2 :nt-id)))
210 ;;(message "%s/%s %s/%s" (widget-get node1 :tag) (widget-get node2 :tag)
211 ;; (or id1 -1) (or id2 -1))
212 (or (newsticker--treeview-ids-eq id1 id2)
213 (string= (widget-get node1 :tag) (widget-get node2 :tag)))))
214
215(defun newsticker--treeview-do-get-node-of-feed (feed-name startnode)
216 "Recursivly search node for feed FEED-NAME starting from STARTNODE."
217 ;;(message "%s/%s" feed-name (widget-get startnode :nt-feed))
218 (if (string= feed-name (or (widget-get startnode :nt-feed)
219 (widget-get startnode :nt-vfeed)))
220 (throw 'found startnode)
221 (let ((children (widget-get startnode :children)))
222 (dolist (w children)
223 (newsticker--treeview-do-get-node-of-feed feed-name w)))))
224
225(defun newsticker--treeview-get-node-of-feed (feed-name)
226 "Return node for feed FEED-NAME in newsticker treeview tree."
227 (catch 'found
228 (newsticker--treeview-do-get-node-of-feed feed-name
229 newsticker--treeview-feed-tree)
230 (newsticker--treeview-do-get-node-of-feed feed-name
231 newsticker--treeview-vfeed-tree)))
232
233(defun newsticker--treeview-do-get-node (id startnode)
234 "Recursivly search node with ID starting from STARTNODE."
235 (if (newsticker--treeview-ids-eq id (widget-get startnode :nt-id))
236 (throw 'found startnode)
237 (let ((children (widget-get startnode :children)))
238 (dolist (w children)
239 (newsticker--treeview-do-get-node id w)))))
240
241(defun newsticker--treeview-get-node (id)
242 "Return node with ID in newsticker treeview tree."
243 (catch 'found
244 (newsticker--treeview-do-get-node id newsticker--treeview-feed-tree)
245 (newsticker--treeview-do-get-node id newsticker--treeview-vfeed-tree)))
246
247(defun newsticker--treeview-get-current-node ()
248 "Return current node in newsticker treeview tree."
249 (newsticker--treeview-get-node newsticker--treeview-current-node-id))
250
251;; ======================================================================
252
253(defun newsticker--treeview-render-text (start end)
254 "Render text between markers START and END."
255 (if newsticker-html-renderer
256 (condition-case error-data
257 (save-excursion
258 (set-marker-insertion-type end t)
259 ;; check whether it is necessary to call html renderer
260 ;; (regexp inspired by htmlr.el)
261 (goto-char start)
262 (when (re-search-forward
263 "</?[A-Za-z1-6]*\\|&#?[A-Za-z0-9]+;" end t)
264 ;; (message "%s" (newsticker--title item))
265 (let ((w3m-fill-column (if newsticker-use-full-width
266 -1 fill-column))
267 (w3-maximum-line-length
268 (if newsticker-use-full-width nil fill-column)))
269 (save-excursion
270 (funcall newsticker-html-renderer start end)))
271 ;;(cond ((eq newsticker-html-renderer 'w3m-region)
272 ;; (add-text-properties start end (list 'keymap
273 ;; w3m-minor-mode-map)))
274 ;;((eq newsticker-html-renderer 'w3-region)
275 ;;(add-text-properties start end (list 'keymap w3-mode-map))))
276 (if (eq newsticker-html-renderer 'w3m-region)
277 (w3m-toggle-inline-images t))
278 t))
279 (error
280 (message "Error: HTML rendering failed: %s, %s"
281 (car error-data) (cdr error-data))
282 nil))
283 nil))
284
285;; ======================================================================
286;;; List window
287;; ======================================================================
288(defun newsticker--treeview-list-add-item (item feed &optional show-feed)
289 "Add news ITEM for FEED to newsticker treeview list window.
290If string SHOW-FEED is non-nil it is shown in the item string."
291 (setq newsticker--treeview-list-show-feed show-feed)
292 (save-excursion
293 (set-buffer (newsticker--treeview-list-buffer))
294 (let* ((inhibit-read-only t)
295 pos1 pos2)
296 (goto-char (point-max))
297 (setq pos1 (point-marker))
298 (insert " ")
299 (insert (propertize " " 'display '(space :align-to 2)))
300 (insert (if show-feed
301 (concat
302 (substring
303 (format "%-10s" (newsticker--real-feed-name
304 feed))
305 0 10)
306 (propertize " " 'display '(space :align-to 12)))
307 ""))
308 (insert (format-time-string "%d.%m.%y, %H:%M"
309 (newsticker--time item)))
310 (insert (propertize " " 'display
311 (list 'space :align-to (if show-feed 28 18))))
312 (setq pos2 (point-marker))
313 (insert (newsticker--title item))
314 (insert "\n")
315 (newsticker--treeview-render-text pos2 (point-marker))
316 (goto-char pos2)
317 (while (search-forward "\n" nil t)
318 (replace-match " "))
319 (let ((map (make-sparse-keymap)))
320 (define-key map [mouse-1] 'newsticker-treeview-tree-click)
321 (define-key map "\n" 'newsticker-treeview-show-item)
322 (define-key map "\C-m" 'newsticker-treeview-show-item)
323 (add-text-properties pos1 (point-max)
324 (list :nt-item item
325 :nt-feed feed
326 :nt-link (newsticker--link item)
327 'mouse-face 'highlight
328 'keymap map
329 'help-echo "Show item")))
330 (insert "\n"))))
331
332(defun newsticker--treeview-list-clear ()
333 "Clear the newsticker treeview list window."
334 (save-excursion
335 (set-buffer (newsticker--treeview-list-buffer))
336 (let ((inhibit-read-only t))
337 (erase-buffer)
338 (kill-all-local-variables)
339 (remove-overlays))))
340
341(defun newsticker--treeview-list-items-with-age-callback (widget
342 changed-widget
343 &rest ages)
344 "Fill newsticker treeview list window with items of certain age.
345This is a callback function for the treeview nodes.
346Argument WIDGET is the calling treeview widget.
347Argument CHANGED-WIDGET is the widget that actually has changed.
348Optional argument AGES is the list of ages that are to be shown."
349 (newsticker--treeview-list-clear)
350 (widget-put widget :nt-selected t)
351 (apply 'newsticker--treeview-list-items-with-age ages))
352
353(defun newsticker--treeview-list-items-with-age (&rest ages)
354 "Actually fill newsticker treeview list window with items of certain age.
355AGES is the list of ages that are to be shown."
356 (mapc (lambda (feed)
357 (let ((feed-name-symbol (intern (car feed))))
358 (mapc (lambda (item)
359 (when (memq (newsticker--age item) ages)
360 (newsticker--treeview-list-add-item
361 item feed-name-symbol t)))
362 (newsticker--treeview-list-sort-items
363 (cdr (newsticker--cache-get-feed feed-name-symbol))))))
364 (append newsticker-url-list-defaults newsticker-url-list))
365 (newsticker--treeview-list-update nil))
366
367(defun newsticker--treeview-list-new-items (widget changed-widget
368 &optional event)
369 "Fill newsticker treeview list window with new items.
370This is a callback function for the treeview nodes.
371Argument WIDGET FIXME.
372Argument CHANGED-WIDGET FIXME.
373Optional argument EVENT FIXME."
374 (newsticker--treeview-list-items-with-age-callback widget changed-widget
375 'new)
376 (newsticker--treeview-item-show-text
377 "New items"
378 "This is a virtual feed containing all new items"))
379
380(defun newsticker--treeview-list-immortal-items (widget changed-widget
381 &optional event)
382 "Fill newsticker treeview list window with immortal items.
383This is a callback function for the treeview nodes.
384Argument WIDGET FIXME.
385Argument CHANGED-WIDGET FIXME.
386Optional argument EVENT FIXME."
387 (newsticker--treeview-list-items-with-age-callback widget changed-widget
388 'immortal)
389 (newsticker--treeview-item-show-text
390 "Immortal items"
391 "This is a virtual feed containing all immortal items."))
392
393(defun newsticker--treeview-list-obsolete-items (widget changed-widget
394 &optional event)
395 "Fill newsticker treeview list window with obsolete items.
396This is a callback function for the treeview nodes.
397Argument WIDGET FIXME.
398Argument CHANGED-WIDGET FIXME.
399Optional argument EVENT FIXME."
400 (newsticker--treeview-list-items-with-age-callback widget changed-widget
401 'obsolete)
402 (newsticker--treeview-item-show-text
403 "Obsolete items"
404 "This is a virtual feed containing all obsolete items."))
405
406(defun newsticker--treeview-list-all-items (widget changed-widget
407 &optional event)
408 "Fill newsticker treeview list window with all items.
409This is a callback function for the treeview nodes.
410Argument WIDGET FIXME.
411Argument CHANGED-WIDGET FIXME.
412Optional argument EVENT FIXME."
413 (newsticker--treeview-list-items-with-age-callback widget changed-widget
414 event 'new 'old
415 'obsolete 'immortal)
416 (newsticker--treeview-item-show-text
417 "All items"
418 "This is a virtual feed containing all items."))
419
420(defun newsticker--treeview-list-items-v (vfeed-name)
421 "List items for virtual feed VFEED-NAME."
422 (when vfeed-name
423 (cond ((string-match "\\*new\\*" vfeed-name)
424 (newsticker--treeview-list-items-with-age 'new))
425 ((string-match "\\*immortal\\*" vfeed-name)
426 (newsticker--treeview-list-items-with-age 'immortal))
427 ((string-match "\\*old\\*" vfeed-name)
428 (newsticker--treeview-list-items-with-age 'old nil)))
429 (newsticker--treeview-list-update nil)
430 ))
431
432(defun newsticker--treeview-list-items (feed-name)
433 "List items for feed FEED-NAME."
434 (when feed-name
435 (if (newsticker--treeview-virtual-feed-p feed-name)
436 (newsticker--treeview-list-items-v feed-name)
437 (mapc (lambda (item)
438 (if (eq (newsticker--age item) 'feed)
439 (newsticker--treeview-item-show item (intern feed-name))
440 (newsticker--treeview-list-add-item item
441 (intern feed-name))))
442 (newsticker--treeview-list-sort-items
443 (cdr (newsticker--cache-get-feed (intern feed-name)))))
444 (newsticker--treeview-list-update nil))))
445
446(defun newsticker--treeview-list-feed-items (widget changed-widget
447 &optional event)
448 "Callback function for listing feed items.
449Argument WIDGET FIXME.
450Argument CHANGED-WIDGET FIXME.
451Optional argument EVENT FIXME."
452 (newsticker--treeview-list-clear)
453 (widget-put widget :nt-selected t)
454 (let ((feed-name (widget-get widget :nt-feed))
455 (vfeed-name (widget-get widget :nt-vfeed)))
456 (if feed-name
457 (newsticker--treeview-list-items feed-name)
458 (newsticker--treeview-list-items-v vfeed-name))))
459
460(defun newsticker--treeview-list-compare-item-by-age (item1 item2)
461 "Compare two news items ITEM1 and ITEM2 wrt age."
462 (catch 'result
463 (let ((age1 (newsticker--age item1))
464 (age2 (newsticker--age item2)))
465 (cond ((eq age1 'new)
466 t)
467 ((eq age1 'immortal)
468 (cond ((eq age2 'new)
469 t)
470 ((eq age2 'immortal)
471 t)
472 (t
473 nil)))
474 ((eq age1 'old)
475 (cond ((eq age2 'new)
476 nil)
477 ((eq age2 'immortal)
478 nil)
479 ((eq age2 'old)
480 nil)
481 (t
482 t)))
483 (t
484 nil)))))
485
486(defun newsticker--treeview-list-compare-item-by-age-reverse (item1 item2)
487 "Compare two news items ITEM1 and ITEM2 wrt age in reverse order."
488 (newsticker--treeview-list-compare-item-by-age item2 item1))
489
490(defun newsticker--treeview-list-compare-item-by-time (item1 item2)
491 "Compare two news items ITEM1 and ITEM2 wrt time values."
492 (newsticker--cache-item-compare-by-time item1 item2))
493
494(defun newsticker--treeview-list-compare-item-by-time-reverse (item1 item2)
495 "Compare two news items ITEM1 and ITEM2 wrt time values in reverse order."
496 (newsticker--cache-item-compare-by-time item2 item1))
497
498(defun newsticker--treeview-list-compare-item-by-title (item1 item2)
499 "Compare two news items ITEM1 and ITEM2 wrt title."
500 (newsticker--cache-item-compare-by-title item1 item2))
501
502(defun newsticker--treeview-list-compare-item-by-title-reverse (item1 item2)
503 "Compare two news items ITEM1 and ITEM2 wrt title in reverse order."
504 (newsticker--cache-item-compare-by-title item2 item1))
505
506(defun newsticker--treeview-list-sort-items (items)
507 "Return sorted copy of list ITEMS.
508The sort function is chosen according to the value of
509`newsticker--treeview-list-sort-order'."
510 (let ((sort-fun
511 (cond ((eq newsticker--treeview-list-sort-order 'sort-by-age)
512 'newsticker--treeview-list-compare-item-by-age)
513 ((eq newsticker--treeview-list-sort-order
514 'sort-by-age-reverse)
515 'newsticker--treeview-list-compare-item-by-age-reverse)
516 ((eq newsticker--treeview-list-sort-order 'sort-by-time)
517 'newsticker--treeview-list-compare-item-by-time)
518 ((eq newsticker--treeview-list-sort-order
519 'sort-by-time-reverse)
520 'newsticker--treeview-list-compare-item-by-time-reverse)
521 ((eq newsticker--treeview-list-sort-order 'sort-by-title)
522 'newsticker--treeview-list-compare-item-by-title)
523 ((eq newsticker--treeview-list-sort-order
524 'sort-by-title-reverse)
525 'newsticker--treeview-list-compare-item-by-title-reverse)
526 (t
527 'newsticker--treeview-list-compare-item-by-title))))
528 (sort (copy-sequence items) sort-fun)))
529
530(defun newsticker--treeview-list-update-faces ()
531 "Update faces in the treeview list buffer."
532 (let (pos-sel)
533 (save-excursion
534 (set-buffer (newsticker--treeview-list-buffer))
535 (let ((inhibit-read-only t))
536 (goto-char (point-min))
537 (while (not (eobp))
538 (let* ((pos (save-excursion (end-of-line) (point)))
539 (item (get-text-property (point) :nt-item))
540 (age (newsticker--age item))
541 (selected (get-text-property (point) :nt-selected))
542 (face (cond ((eq age 'new)
543 'newsticker-treeview-new-face)
544 ((eq age 'old)
545 'newsticker-treeview-old-face)
546 ((eq age 'immortal)
547 'newsticker-treeview-immortal-face)
548 ((eq age 'obsolete)
549 'newsticker-treeview-obsolete-face)
550 (t
551 'bold))))
552 (put-text-property (point) pos 'face face)
553 (if selected
554 (move-overlay newsticker--selection-overlay (point)
555 (1+ pos) ;include newline
556 (current-buffer)))
557 (if selected (setq pos-sel (point)))
558 (forward-line 1)
559 (beginning-of-line))))) ;; FIXME!?
560 (when pos-sel
561 (set-window-point (newsticker--treeview-list-window) pos-sel))))
562
563(defun newsticker--treeview-list-clear-highlight ()
564 "Clear the highlight in the treeview list buffer."
565 (save-excursion
566 (set-buffer (newsticker--treeview-list-buffer))
567 (let ((inhibit-read-only t))
568 (put-text-property (point-min) (point-max) :nt-selected nil))
569 (newsticker--treeview-list-update-faces)))
570
571(defun newsticker--treeview-list-update-highlight ()
572 "Update the highlight in the treeview list buffer."
573 (newsticker--treeview-list-clear-highlight)
574 (let (pos num-lines)
575 (save-excursion
576 (set-buffer (newsticker--treeview-list-buffer))
577 (let ((inhibit-read-only t))
578 (put-text-property (save-excursion (beginning-of-line) (point))
579 (save-excursion (end-of-line) (point))
580 :nt-selected t))
581 (newsticker--treeview-list-update-faces))))
582
583(defun newsticker--treeview-list-highlight-start ()
584 "Return position of selection in treeview list buffer."
585 (save-excursion
586 (set-buffer (newsticker--treeview-list-buffer))
587 (goto-char (point-min))
588 (next-single-property-change (point) :nt-selected)))
589
590(defun newsticker--treeview-list-update (clear-buffer)
591 "Update the faces and highlight in the treeview list buffer.
592If CLEAR-BUFFER is non-nil the list buffer is completely erased."
593 (save-excursion
594 (set-window-buffer (newsticker--treeview-list-window)
595 (newsticker--treeview-list-buffer))
596 (if newsticker-treeview-own-frame
597 (set-window-dedicated-p (newsticker--treeview-list-window) t))
598 (set-buffer (newsticker--treeview-list-buffer))
599 (if clear-buffer
600 (let ((inhibit-read-only t))
601 (erase-buffer)))
602 (newsticker-treeview-list-mode)
603 (newsticker--treeview-list-update-faces)
604 (goto-char (point-min))))
605
606;;(makunbound 'newsticker-treeview-list-sort-button-map);; FIXME
607(defvar newsticker-treeview-list-sort-button-map
608 (let ((map (make-sparse-keymap)))
609 (define-key map [header-line mouse-1]
610 'newsticker--treeview-list-sort-by-column)
611 (define-key map [header-line mouse-2]
612 'newsticker--treeview-list-sort-by-column)
613 map)
614 "Local keymap for newsticker treeview list window sort buttons.")
615
616(defun newsticker--treeview-list-sort-by-column (&optional e)
617 "Sort the newsticker list window buffer by the column clicked on.
618Optional argument E FIXME."
619 (interactive (list last-input-event))
620 (if e (mouse-select-window e))
621 (let* ((pos (event-start e))
622 (obj (posn-object pos))
623 (sort-order (if obj
624 (get-text-property (cdr obj) 'sort-order (car obj))
625 (get-text-property (posn-point pos) 'sort-order))))
626 (setq newsticker--treeview-list-sort-order
627 (cond ((eq sort-order 'sort-by-age)
628 (if (eq newsticker--treeview-list-sort-order 'sort-by-age)
629 'sort-by-age-reverse
630 'sort-by-age))
631 ((eq sort-order 'sort-by-time)
632 (if (eq newsticker--treeview-list-sort-order 'sort-by-time)
633 'sort-by-time-reverse
634 'sort-by-time))
635 ((eq sort-order 'sort-by-title)
636 (if (eq newsticker--treeview-list-sort-order 'sort-by-title)
637 'sort-by-title-reverse
638 'sort-by-title))))
639 (newsticker-treeview-update)))
640
641(defun newsticker-treeview-list-make-sort-button (name sort-order)
642 "Create propertized string for headerline button.
643NAME is the button text, SORT-ORDER is the associated sort order
644for the button."
645 (let ((face (if (string-match (symbol-name sort-order)
646 (symbol-name
647 newsticker--treeview-list-sort-order))
648 'bold
649 'header-line)))
650 (propertize name
651 'sort-order sort-order
652 'help-echo (concat "Sort by " name)
653 'mouse-face 'highlight
654 'face face
655 'keymap newsticker-treeview-list-sort-button-map)))
656
657;; ======================================================================
658;;; item window
659;; ======================================================================
660(defun newsticker--treeview-item-show-text (title description)
661 "Show text in treeview item buffer consisting of TITLE and DESCRIPTION."
662 (save-excursion
663 (set-buffer (newsticker--treeview-item-buffer))
664 (when (fboundp 'w3m-process-stop)
665 (w3m-process-stop (current-buffer)))
666 (let ((inhibit-read-only t))
667 (erase-buffer)
668 (kill-all-local-variables)
669 (remove-overlays)
670 (insert title)
671 (put-text-property (point-min) (point) 'face 'newsticker-feed-face)
672 (insert "\n\n" description)
673 (when newsticker-justification
674 (fill-region (point-min) (point-max) newsticker-justification))
675 (newsticker-treeview-mode)
676 (goto-char (point-min)))))
677
678(defun newsticker--treeview-item-show (item feed)
679 "Show news ITEM coming from FEED in treeview item buffer."
680 (save-excursion
681 (set-buffer (newsticker--treeview-item-buffer))
682 (when (fboundp 'w3m-process-stop)
683 (w3m-process-stop (current-buffer)))
684 (let ((inhibit-read-only t)
685 (is-rendered-HTML nil)
686 pos
687 (marker1 (make-marker))
688 (marker2 (make-marker)))
689 (erase-buffer)
690 (kill-all-local-variables)
691 (remove-overlays)
692
693 (when (and item feed)
694 (let ((wwidth (1- (window-width (newsticker--treeview-item-window)))))
695 (if newsticker-use-full-width
696 (set (make-local-variable 'fill-column) wwidth))
697 (set (make-local-variable 'fill-column) (min fill-column
698 wwidth)))
699 (let ((desc (newsticker--desc item)))
700 (insert "\n" (or desc "[No Description]")))
701 (set-marker marker1 (1+ (point-min)))
702 (set-marker marker2 (point-max))
703 (setq is-rendered-HTML (newsticker--treeview-render-text marker1
704 marker2))
705 (when (and newsticker-justification
706 (not is-rendered-HTML))
707 (fill-region marker1 marker2 newsticker-justification))
708
709 (newsticker-treeview-mode)
710 (goto-char (point-min))
711 ;; insert logo at top
712 (let* ((newsticker-enable-logo-manipulations nil)
713 (img (newsticker--image-read feed nil)))
714 (if (and (display-images-p) img)
715 (newsticker--insert-image img (car item))
716 (insert (newsticker--real-feed-name feed))))
717 (add-text-properties (point-min) (point)
718 (list 'face 'newsticker-feed-face
719 'mouse-face 'highlight
720 'help-echo "Visit in web browser."
721 :nt-link (newsticker--link item)
722 'keymap newsticker--treeview-url-keymap))
723 (setq pos (point))
724
725 (insert "\n\n")
726 ;; insert title
727 (setq pos (point))
728 (insert (newsticker--title item) "\n")
729 (set-marker marker1 pos)
730 (set-marker marker2 (point))
731 (newsticker--treeview-render-text marker1 marker2)
732 (put-text-property pos (point) 'face 'newsticker-treeview-new-face)
733 (goto-char marker2)
734 (delete-char -1)
735 (insert "\n")
736 (put-text-property marker2 (point) 'face 'newsticker-treeview-face)
737 (set-marker marker2 (point))
738 (when newsticker-justification
739 (fill-region marker1 marker2 newsticker-justification))
740 (goto-char marker2)
741 (add-text-properties marker1 (1- (point))
742 (list 'mouse-face 'highlight
743 'help-echo "Visit in web browser."
744 :nt-link (newsticker--link item)
745 'keymap newsticker--treeview-url-keymap))
746 (insert (format-time-string newsticker-date-format
747 (newsticker--time item)))
748 (insert "\n")
749 (setq pos (point))
750 (insert "\n")
751 ;; insert enclosures and rest at bottom
752 (goto-char (point-max))
753 (insert "\n\n")
754 (setq pos (point))
755 (newsticker--insert-enclosure item newsticker--treeview-url-keymap)
756 (put-text-property pos (point) 'face 'newsticker-enclosure-face)
757 (setq pos (point))
758 (insert "\n")
759 (newsticker--print-extra-elements item newsticker--treeview-url-keymap)
760 (put-text-property pos (point) 'face 'newsticker-extra-face)
761 (goto-char (point-min)))))
762 (if (and newsticker-treeview-automatically-mark-displayed-items-as-old
763 item
764 (memq (newsticker--age item) '(new obsolete)))
765 (let ((newsticker-treeview-automatically-mark-displayed-items-as-old nil))
766 (newsticker-treeview-mark-item-old t)
767 (newsticker--treeview-list-update-faces)))
768 (set-window-point (newsticker--treeview-item-window) 1))
769
770(defun newsticker--treeview-item-update ()
771 "Update the treeview item buffer and window."
772 (save-excursion
773 (set-window-buffer (newsticker--treeview-item-window)
774 (newsticker--treeview-item-buffer))
775 (if newsticker-treeview-own-frame
776 (set-window-dedicated-p (newsticker--treeview-item-window) t))
777 (set-buffer (newsticker--treeview-item-buffer))
778 (let ((inhibit-read-only t))
779 (erase-buffer))
780 (newsticker-treeview-mode)))
781
782;; ======================================================================
783;;; Tree window
784;; ======================================================================
785(defun newsticker--treeview-tree-expand (tree)
786 "Expand TREE.
787Callback function for tree widget that adds nodes for feeds and subgroups."
788 (newsticker--group-manage-orphan-feeds)
789 (tree-widget-set-theme "folder")
790 (let ((group (widget-get tree :nt-group))
791 (i 0)
792 (nt-id ""))
793 (mapcar (lambda (g)
794 (setq nt-id (newsticker--treeview-get-id tree i))
795 (setq i (1+ i))
796 (if (listp g)
797 (let* ((g-name (car g)))
798 `(tree-widget
799 :tag ,(newsticker--treeview-tree-get-tag g-name nil nt-id)
800 :expander newsticker--treeview-tree-expand
801 :expander-p (lambda (&rest ignore) t)
802 :nt-group ,(cdr g)
803 :nt-feed ,g-name
804 :nt-id ,nt-id
805 :keep (:nt-feed :num-new :nt-id :open);; :nt-group
806 :open nil))
807 (let ((tag (newsticker--treeview-tree-get-tag g nil nt-id)))
808 `(item :tag ,tag
809 :leaf-icon newsticker--tree-widget-leaf-icon
810 :nt-feed ,g
811 :action newsticker--treeview-list-feed-items
812 :nt-id ,nt-id
813 :keep (:nt-id)
814 :open t))))
815 group)))
816
817(defun newsticker--treeview-tree-expand-status (tree &optional changed-widget
818 event)
819 "Expand the vfeed TREE.
820Optional arguments CHANGED-WIDGET and EVENT are ignored."
821 (tree-widget-set-theme "folder")
822 (list `(item :tag ,(newsticker--treeview-tree-get-tag nil "new")
823 :nt-vfeed "new"
824 :action newsticker--treeview-list-new-items
825 :nt-id ,(newsticker--treeview-get-id tree 0)
826 :keep (:nt-id))
827 `(item :tag ,(newsticker--treeview-tree-get-tag nil "immortal")
828 :nt-vfeed "immortal"
829 :action newsticker--treeview-list-immortal-items
830 :nt-id ,(newsticker--treeview-get-id tree 1)
831 :keep (:nt-id))
832 `(item :tag ,(newsticker--treeview-tree-get-tag nil "obsolete")
833 :nt-vfeed "obsolete"
834 :action newsticker--treeview-list-obsolete-items
835 :nt-id ,(newsticker--treeview-get-id tree 2)
836 :keep (:nt-id))
837 `(item :tag ,(newsticker--treeview-tree-get-tag nil "all")
838 :nt-vfeed "all"
839 :action newsticker--treeview-list-all-items
840 :nt-id ,(newsticker--treeview-get-id tree 3)
841 :keep (:nt-id))))
842
843(defun newsticker--treeview-virtual-feed-p (feed-name)
844 "Return non-nil if FEED-NAME is a virtual feed."
845 (string-match "\\*.*\\*" feed-name))
846
847(define-widget 'newsticker--tree-widget-leaf-icon 'tree-widget-icon
848 "Icon for a tree-widget leaf node."
849 :tag "O"
850 :glyph-name "leaf"
851 :button-face 'default)
852
853(defun newsticker--treeview-tree-update ()
854 "Update treeview tree buffer and window."
855 (save-excursion
856 (set-window-buffer (newsticker--treeview-tree-window)
857 (newsticker--treeview-tree-buffer))
858 (if newsticker-treeview-own-frame
859 (set-window-dedicated-p (newsticker--treeview-tree-window) t))
860 (set-buffer (newsticker--treeview-tree-buffer))
861 (kill-all-local-variables)
862 (let ((inhibit-read-only t))
863 (erase-buffer)
864 (tree-widget-set-theme "folder")
865 (setq newsticker--treeview-feed-tree
866 (widget-create 'tree-widget
867 :tag (newsticker--treeview-propertize-tag
868 "Feeds" 0 "feeds")
869 :expander 'newsticker--treeview-tree-expand
870 :expander-p (lambda (&rest ignore) t)
871 :leaf-icon 'newsticker--tree-widget-leaf-icon
872 :nt-group (cdr newsticker-groups)
873 :nt-id "feeds"
874 :keep '(:nt-id)
875 :open t))
876 (setq newsticker--treeview-vfeed-tree
877 (widget-create 'tree-widget
878 :tag (newsticker--treeview-propertize-tag
879 "Virtual Feeds" 0 "vfeeds")
880 :expander 'newsticker--treeview-tree-expand-status
881 :expander-p (lambda (&rest ignore) t)
882 :leaf-icon 'newsticker--tree-widget-leaf-icon
883 :nt-id "vfeeds"
884 :keep '(:nt-id)
885 :open t))
886 (use-local-map widget-keymap)
887 (widget-setup))
888 (newsticker-treeview-mode)))
889
890(defun newsticker--treeview-propertize-tag (tag &optional num-new nt-id feed
891 vfeed)
892 "Return propertized copy of string TAG.
893Optional argument NUM-NEW is used for choosing face, other
894arguments NT-ID, FEED, and VFEED are added as properties."
895 ;;(message "newsticker--treeview-propertize-tag '%s' %s" feed nt-id)
896 (let ((face 'newsticker-treeview-face)
897 (map (make-sparse-keymap)))
898 (if (and num-new (> num-new 0))
899 (setq face 'newsticker-treeview-new-face))
900 (define-key map [mouse-1] 'newsticker-treeview-tree-click)
901 (define-key map "\n" 'newsticker-treeview-tree-do-click)
902 (define-key map "\C-m" 'newsticker-treeview-tree-do-click)
903 (propertize tag 'face face 'keymap map
904 :nt-id nt-id
905 :nt-feed feed
906 :nt-vfeed vfeed
907 'help-echo "Clickme!"
908 'mouse-face 'highlight)))
909
910(defun newsticker--treeview-tree-get-tag (feed-name vfeed-name
911 &optional nt-id)
912 "Return a tag string for either FEED-NAME or, if it is nil, for VFEED-NAME.
913Optional argument NT-ID is added to the tag's properties."
914 (let (tag (num-new 0))
915 (cond (vfeed-name
916 (cond ((string= vfeed-name "new")
917 (setq num-new (newsticker--stat-num-items-total 'new))
918 (setq tag (format "New items (%d)" num-new)))
919 ((string= vfeed-name "immortal")
920 (setq num-new (newsticker--stat-num-items-total 'immortal))
921 (setq tag (format "Immortal items (%d)" num-new)))
922 ((string= vfeed-name "obsolete")
923 (setq num-new (newsticker--stat-num-items-total 'obsolete))
924 (setq tag (format "Obsolete items (%d)" num-new)))
925 ((string= vfeed-name "all")
926 (setq num-new (newsticker--stat-num-items-total))
927 (setq tag (format "All items (%d)" num-new)))))
928 (feed-name
929 (setq num-new (newsticker--stat-num-items-for-group
930 (intern feed-name) 'new 'immortal))
931 (setq tag
932 (format "%s (%d)"
933 (newsticker--real-feed-name (intern feed-name))
934 num-new))))
935 (if tag
936 (newsticker--treeview-propertize-tag tag num-new
937 nt-id
938 feed-name vfeed-name))))
939
940(defun newsticker--stat-num-items-for-group (feed-name-symbol &rest ages)
941 "Count number of items in feed FEED-NAME-SYMBOL that have an age matching AGES."
942 ;;(message "newsticker--stat-num-items-for-group %s %s" feed-name-symbol ages)
943 (let ((result (apply 'newsticker--stat-num-items feed-name-symbol ages)))
944 (mapc (lambda (f-n)
945 (setq result (+ result
946 (apply 'newsticker--stat-num-items (intern f-n)
947 ages))))
948 (newsticker--group-get-feeds
949 (newsticker--group-get-group (symbol-name feed-name-symbol)) t))
950 result))
951
952(defun newsticker--treeview-count-node-items (feed &optional isvirtual)
953 "Count number of relevant items for a treeview node.
954FEED gives the name of the feed or group. If ISVIRTUAL is non-nil
955the feed is a virtual feed."
956 (let* ((num-new 0))
957 (if feed
958 (if isvirtual
959 (cond ((string= feed "new")
960 (setq num-new (newsticker--stat-num-items-total 'new)))
961 ((string= feed "immortal")
962 (setq num-new (newsticker--stat-num-items-total 'immortal)))
963 ((string= feed "obsolete")
964 (setq num-new (newsticker--stat-num-items-total 'obsolete)))
965 ((string= feed "all")
966 (setq num-new (newsticker--stat-num-items-total))))
967 (setq num-new (newsticker--stat-num-items-for-group
968 (intern feed) 'new 'immortal))))
969 num-new))
970
971(defun newsticker--treeview-tree-update-tag (w &optional recursive
972 &rest ignore)
973 "Update tag for tree widget W.
974If RECURSIVE is non-nil recursively update parent widgets as
975well. Argument IGNORE is ignored. Note that this function, if
976called recursively, makes w invalid. You should keep w's nt-id in
977that case."
978 ;;(message "newsticker--treeview-tree-update-tag %s, %s" (widget-get w :tag)
979 ;; (widget-type w))
980 (let* ((parent (widget-get w :parent))
981 (feed (or (widget-get w :nt-feed) (widget-get parent :nt-feed)))
982 (vfeed (or (widget-get w :nt-vfeed) (widget-get parent :nt-vfeed)))
983 (nt-id (or (widget-get w :nt-id) (widget-get parent :nt-id)))
984 (num-new (newsticker--treeview-count-node-items (or feed vfeed)
985 vfeed))
986 (tag (newsticker--treeview-tree-get-tag feed vfeed nt-id))
987 (n (widget-get w :node)))
988 (if parent
989 (if recursive
990 (newsticker--treeview-tree-update-tag parent)))
991 (when tag
992 (when n
993 (widget-put n :tag tag))
994 (widget-put w :num-new num-new)
995 (widget-put w :tag tag)
996 (when (marker-position (widget-get w :from))
997 (let ((p (point))
998 (notify (widget-get w :notify)))
999 ;; FIXME: This moves point!!!!
1000 (save-excursion
1001 (set-buffer (newsticker--treeview-tree-buffer))
1002 (widget-value-set w (widget-value w)))
1003 (goto-char p))))))
1004
1005(defun newsticker--treeview-tree-do-update-tags (widget)
1006 "Actually recursively update tags for WIDGET."
1007 (save-excursion
1008 (let ((children (widget-get widget :children)))
1009 (dolist (w children)
1010 (newsticker--treeview-tree-do-update-tags w))
1011 (newsticker--treeview-tree-update-tag widget))))
1012
1013(defun newsticker--treeview-tree-update-tags (&rest ignore)
1014 "Update all tags of all trees.
1015Arguments IGNORE are ignored."
1016 (save-current-buffer
1017 (set-buffer (newsticker--treeview-tree-buffer))
1018 (let ((inhibit-read-only t))
1019 (newsticker--treeview-tree-do-update-tags
1020 newsticker--treeview-feed-tree)
1021 (newsticker--treeview-tree-do-update-tags
1022 newsticker--treeview-vfeed-tree))
1023 (tree-widget-set-theme "folder")))
1024
1025(defun newsticker--treeview-tree-update-highlight ()
1026 "Update highlight in tree buffer."
1027 (let ((pos (widget-get (newsticker--treeview-get-current-node) :from)))
1028 (unless (or (integerp pos) (and (markerp pos) (marker-position pos)))
1029 (setq pos (widget-get (widget-get
1030 (newsticker--treeview-get-current-node)
1031 :parent) :from)))
1032 (when (or (integerp pos) (and (markerp pos) (marker-position pos)))
1033 (save-excursion
1034 (set-buffer (newsticker--treeview-tree-buffer))
1035 (goto-char pos)
1036 (move-overlay newsticker--tree-selection-overlay
1037 (save-excursion (beginning-of-line) (point))
1038 (save-excursion (end-of-line) (1+ (point)))
1039 (current-buffer)))
1040 (set-window-point (newsticker--treeview-tree-window) pos))))
1041
1042;; ======================================================================
1043;;; Toolbar
1044;; ======================================================================
1045;;(makunbound 'newsticker-treeview-tool-bar-map)
1046(defvar newsticker-treeview-tool-bar-map
1047 (if (featurep 'xemacs)
1048 nil
1049 (let ((tool-bar-map (make-sparse-keymap)))
1050 (define-key tool-bar-map [newsticker-sep-1]
1051 (list 'menu-item "--double-line"))
1052 (define-key tool-bar-map [newsticker-browse-url]
1053 (list 'menu-item "newsticker-browse-url"
1054 'newsticker-browse-url
1055 :visible t
1056 :help "Browse URL for item at point"
1057 :image newsticker--browse-image))
1058 (define-key tool-bar-map [newsticker-buffer-force-update]
1059 (list 'menu-item "newsticker-treeview-update"
1060 'newsticker-treeview-update
1061 :visible t
1062 :help "Update newsticker buffer"
1063 :image newsticker--update-image
1064 :enable t))
1065 (define-key tool-bar-map [newsticker-get-all-news]
1066 (list 'menu-item "newsticker-get-all-news" 'newsticker-get-all-news
1067 :visible t
1068 :help "Get news for all feeds"
1069 :image newsticker--get-all-image))
1070 (define-key tool-bar-map [newsticker-mark-item-at-point-as-read]
1071 (list 'menu-item "newsticker-treeview-mark-item-old"
1072 'newsticker-treeview-mark-item-old
1073 :visible t
1074 :image newsticker--mark-read-image
1075 :help "Mark current item as read"
1076 ;;:enable '(newsticker-item-not-old-p) FIXME
1077 ))
1078 (define-key tool-bar-map [newsticker-mark-item-at-point-as-immortal]
1079 (list 'menu-item "newsticker-treeview-toggle-item-immortal"
1080 'newsticker-treeview-toggle-item-immortal
1081 :visible t
1082 :image newsticker--mark-immortal-image
1083 :help "Toggle current item as immortal"
1084 :enable t
1085 ;;'(newsticker-item-not-immortal-p) FIXME
1086 ))
1087 (define-key tool-bar-map [newsticker-next-feed]
1088 (list 'menu-item "newsticker-treeview-next-feed"
1089 'newsticker-treeview-next-feed
1090 :visible t
1091 :help "Go to next feed"
1092 :image newsticker--next-feed-image
1093 :enable t
1094 ;;'(newsticker-next-feed-available-p) FIXME
1095 ))
1096 (define-key tool-bar-map [newsticker-treeview-next-item]
1097 (list 'menu-item "newsticker-treeview-next-item"
1098 'newsticker-treeview-next-item
1099 :visible t
1100 :help "Go to next item"
1101 :image newsticker--next-item-image
1102 :enable t
1103 ;;'(newsticker-next-item-available-p) FIXME
1104 ))
1105 (define-key tool-bar-map [newsticker-treeview-prev-item]
1106 (list 'menu-item "newsticker-treeview-prev-item"
1107 'newsticker-treeview-prev-item
1108 :visible t
1109 :help "Go to previous item"
1110 :image newsticker--previous-item-image
1111 :enable t
1112 ;;'(newsticker-previous-item-available-p) FIXME
1113 ))
1114 (define-key tool-bar-map [newsticker-treeview-prev-feed]
1115 (list 'menu-item "newsticker-treeview-prev-feed"
1116 'newsticker-treeview-prev-feed
1117 :visible t
1118 :help "Go to previous feed"
1119 :image newsticker--previous-feed-image
1120 :enable t
1121 ;;'(newsticker-previous-feed-available-p) FIXME
1122 ))
1123 ;; standard icons / actions
1124 (tool-bar-add-item "close"
1125 'newsticker-treeview-quit
1126 'newsticker-treeview-quit
1127 :help "Close newsticker")
1128 (tool-bar-add-item "preferences"
1129 'newsticker-customize
1130 'newsticker-customize
1131 :help "Customize newsticker")
1132 tool-bar-map)))
1133
1134;; ======================================================================
1135;;; actions
1136;; ======================================================================
1137
1138(defun newsticker-treeview-mouse-browse-url (event)
1139 "Call `browse-url' for the link of the item at which the EVENT occurred."
1140 (interactive "e")
1141 (save-excursion
1142 (switch-to-buffer (window-buffer (posn-window (event-end event))))
1143 (let ((url (get-text-property (posn-point (event-end event))
1144 :nt-link)))
1145 (when url
1146 (browse-url url)
1147 (if newsticker-automatically-mark-visited-items-as-old
1148 (newsticker-treeview-mark-item-old))))))
1149
1150(defun newsticker-treeview-browse-url ()
1151 "Call `browse-url' for the link of the item at point."
1152 (interactive)
1153 (save-excursion
1154 (set-buffer (newsticker--treeview-list-buffer))
1155 (let ((url (get-text-property (point) :nt-link)))
1156 (when url
1157 (browse-url url)
1158 (if newsticker-automatically-mark-visited-items-as-old
1159 (newsticker-treeview-mark-item-old))))))
1160
1161(defun newsticker--treeview-buffer-init ()
1162 "Initialize all treeview buffers."
1163 (setq newsticker--treeview-buffers nil)
1164 (add-to-list 'newsticker--treeview-buffers
1165 (get-buffer-create "*Newsticker Tree*") t)
1166 (add-to-list 'newsticker--treeview-buffers
1167 (get-buffer-create "*Newsticker List*") t)
1168 (add-to-list 'newsticker--treeview-buffers
1169 (get-buffer-create "*Newsticker Item*") t)
1170
1171 (unless newsticker--selection-overlay
1172 (save-excursion
1173 (set-buffer (newsticker--treeview-list-buffer))
1174 (setq newsticker--selection-overlay (make-overlay (point-min)
1175 (point-max)))
1176 (overlay-put newsticker--selection-overlay 'face
1177 'newsticker-treeview-selection-face)))
1178 (unless newsticker--tree-selection-overlay
1179 (save-excursion
1180 (set-buffer (newsticker--treeview-tree-buffer))
1181 (setq newsticker--tree-selection-overlay (make-overlay (point-min)
1182 (point-max)))
1183 (overlay-put newsticker--tree-selection-overlay 'face
1184 'newsticker-treeview-selection-face)))
1185
1186 (newsticker--treeview-tree-update)
1187 (newsticker--treeview-list-update t)
1188 (newsticker--treeview-item-update))
1189
1190(defun newsticker-treeview-update ()
1191 "Update all treeview buffers and windows."
1192 (interactive)
1193 (newsticker--cache-update)
1194 (newsticker--group-manage-orphan-feeds)
1195 (newsticker--treeview-list-update t)
1196 (newsticker--treeview-item-update)
1197 (newsticker--treeview-tree-update-tags)
1198 (cond (newsticker--treeview-current-feed
1199 (newsticker--treeview-list-items newsticker--treeview-current-feed))
1200 (newsticker--treeview-current-vfeed
1201 (newsticker--treeview-list-items-with-age
1202 (intern newsticker--treeview-current-vfeed))))
1203 (newsticker--treeview-tree-update-highlight)
1204 (newsticker--treeview-list-update-highlight))
1205
1206(defun newsticker-treeview-quit ()
1207 "Quit newsticker treeview."
1208 (interactive)
1209 (newsticker-treeview-save)
1210 (setq newsticker--sentinel-callback nil)
1211 (setq newsticker--window-config (current-window-configuration))
1212 (bury-buffer "*Newsticker Tree*")
1213 (bury-buffer "*Newsticker List*")
1214 (bury-buffer "*Newsticker Item*")
1215 (set-window-configuration newsticker--saved-window-config)
1216 (when newsticker--frame
1217 (if (frame-live-p newsticker--frame)
1218 (delete-frame newsticker--frame))
1219 (setq newsticker--frame nil)))
1220
1221(defun newsticker-treeview-save ()
1222 "Save newsticker data including treeview settings."
1223 (interactive)
1224 (newsticker--cache-save)
1225 (save-excursion
1226 (let ((coding-system-for-write 'utf-8)
1227 (buf (find-file-noselect newsticker-groups-filename)))
1228 (when buf
1229 (set-buffer buf)
1230 (setq buffer-undo-list t)
1231 (erase-buffer)
1232 (insert ";; -*- coding: utf-8 -*-\n")
1233 (insert (prin1-to-string newsticker-groups))
1234 (save-buffer)))))
1235
1236(defun newsticker--treeview-load ()
1237 "Load treeview settings."
1238 (let* ((coding-system-for-read 'utf-8)
1239 (buf (and (file-exists-p newsticker-groups-filename)
1240 (find-file-noselect newsticker-groups-filename))))
1241 (when buf
1242 (set-buffer buf)
1243 (goto-char (point-min))
1244 (condition-case nil
1245 (setq newsticker-groups (read buf))
1246 (error
1247 (message "Error while reading newsticker groups file!")
1248 (setq newsticker-groups nil))))))
1249
1250
1251(defun newsticker-treeview-scroll-item ()
1252 "Scroll current item."
1253 (interactive)
1254 (save-selected-window
1255 (select-window (newsticker--treeview-item-window) t)
1256 (scroll-up 1)))
1257
1258(defun newsticker-treeview-show-item ()
1259 "Show current item."
1260 (interactive)
1261 (newsticker--treeview-list-update-highlight)
1262 (save-excursion
1263 (set-buffer (newsticker--treeview-list-buffer))
1264 (beginning-of-line)
1265 (let ((item (get-text-property (point) :nt-item))
1266 (feed (get-text-property (point) :nt-feed)))
1267 (newsticker--treeview-item-show item feed)))
1268 (newsticker--treeview-tree-update-tag
1269 (newsticker--treeview-get-current-node) t)
1270 (newsticker--treeview-tree-update-highlight))
1271
1272(defun newsticker-treeview-next-item ()
1273 "Move to next item."
1274 (interactive)
1275 (newsticker--treeview-restore-buffers)
1276 (save-current-buffer
1277 (set-buffer (newsticker--treeview-list-buffer))
1278 (if (newsticker--treeview-list-highlight-start)
1279 (forward-line 1))
1280 (if (eobp)
1281 (forward-line -1)))
1282 (newsticker-treeview-show-item))
1283
1284(defun newsticker-treeview-prev-item ()
1285 "Move to previous item."
1286 (interactive)
1287 (newsticker--treeview-restore-buffers)
1288 (save-current-buffer
1289 (set-buffer (newsticker--treeview-list-buffer))
1290 (forward-line -1))
1291 (newsticker-treeview-show-item))
1292
1293(defun newsticker-treeview-next-new-or-immortal-item ()
1294 "Move to next new or immortal item."
1295 (interactive)
1296 (newsticker--treeview-restore-buffers)
1297 (newsticker--treeview-list-clear-highlight)
1298 (catch 'found
1299 (let ((index (newsticker-treeview-next-item)))
1300 (while t
1301 (save-current-buffer
1302 (set-buffer (newsticker--treeview-list-buffer))
1303 (forward-line 1)
1304 (when (eobp)
1305 (forward-line -1)
1306 (throw 'found nil)))
1307 (when (memq (newsticker--age
1308 (newsticker--treeview-get-selected-item)) '(new immortal))
1309 (newsticker-treeview-show-item)
1310 (throw 'found t))))))
1311
1312(defun newsticker-treeview-prev-new-or-immortal-item ()
1313 "Move to previous new or immortal item."
1314 (interactive)
1315 (newsticker--treeview-restore-buffers)
1316 (newsticker--treeview-list-clear-highlight)
1317 (catch 'found
1318 (let ((index (newsticker-treeview-next-item)))
1319 (while t
1320 (save-current-buffer
1321 (set-buffer (newsticker--treeview-list-buffer))
1322 (forward-line -1)
1323 (when (bobp)
1324 (throw 'found nil)))
1325 (when (memq (newsticker--age
1326 (newsticker--treeview-get-selected-item)) '(new immortal))
1327 (newsticker-treeview-show-item)
1328 (throw 'found t))))))
1329
1330(defun newsticker--treeview-get-selected-item ()
1331 "Return item that is currently selected in list buffer."
1332 (save-excursion
1333 (set-buffer (newsticker--treeview-list-buffer))
1334 (beginning-of-line)
1335 (get-text-property (point) :nt-item)))
1336
1337(defun newsticker-treeview-mark-item-old (&optional dont-proceed)
1338 "Mark current item as old unless it is obsolete.
1339Move to next item unless DONT-PROCEED is non-nil."
1340 (interactive)
1341 (let ((item (newsticker--treeview-get-selected-item)))
1342 (unless (eq (newsticker--age item) 'obsolete)
1343 (newsticker--treeview-mark-item item 'old)))
1344 (unless dont-proceed
1345 (newsticker-treeview-next-item)))
1346
1347(defun newsticker-treeview-toggle-item-immortal ()
1348 "Toggle immortality of current item."
1349 (interactive)
1350 (let* ((item (newsticker--treeview-get-selected-item))
1351 (new-age (if (eq (newsticker--age item) 'immortal)
1352 'old
1353 'immortal)))
1354 (newsticker--treeview-mark-item item new-age)
1355 (newsticker-treeview-next-item)))
1356
1357(defun newsticker--treeview-mark-item (item new-age)
1358 "Mark ITEM with NEW-AGE."
1359 (when item
1360 (setcar (nthcdr 4 item) new-age)
1361 ;; clean up ticker FIXME
1362 ))
1363
1364(defun newsticker-treeview-mark-list-items-old ()
1365 "Mark all listed items as old."
1366 (interactive)
1367 (let ((current-feed (or newsticker--treeview-current-feed
1368 newsticker--treeview-current-vfeed)))
1369 (save-excursion
1370 (set-buffer (newsticker--treeview-list-buffer))
1371 (goto-char (point-min))
1372 (while (not (eobp))
1373 (let ((item (get-text-property (point) :nt-item)))
1374 (unless (memq (newsticker--age item) '(immortal obsolete))
1375 (newsticker--treeview-mark-item item 'old)))
1376 (forward-line 1)))
1377 (newsticker--treeview-tree-update-tags)
1378 (if current-feed
1379 (newsticker-treeview-jump current-feed))))
1380
1381(defun newsticker-treeview-save-item ()
1382 "Save current item."
1383 (interactive)
1384 (newsticker-save-item (or newsticker--treeview-current-feed
1385 newsticker--treeview-current-vfeed)
1386 (newsticker--treeview-get-selected-item)))
1387
1388(defun newsticker--treeview-set-current-node (node)
1389 "Make NODE the current node."
1390 (save-excursion
1391 (set-buffer (newsticker--treeview-tree-buffer))
1392 (setq newsticker--treeview-current-node-id
1393 (widget-get node :nt-id))
1394 (setq newsticker--treeview-current-feed (widget-get node :nt-feed))
1395 (setq newsticker--treeview-current-vfeed (widget-get node :nt-vfeed))
1396 ;;(message "newsticker--treeview-set-current-node %s/%s" (widget-get node :tag)
1397 ;; (widget-get node :nt-id))
1398 ;; node)
1399 (newsticker--treeview-tree-update-highlight)))
1400
1401(defun newsticker--treeview-get-first-child (node)
1402 "Get first child of NODE."
1403 (let ((children (widget-get node :children)))
1404 (if children
1405 (car children)
1406 nil)))
1407
1408(defun newsticker--treeview-get-second-child (node)
1409 "Get scond child of NODE."
1410 (let ((children (widget-get node :children)))
1411 (if children
1412 (car (cdr children))
1413 nil)))
1414
1415(defun newsticker--treeview-get-last-child (node)
1416 "Get last child of NODE."
1417 ;;(message "newsticker--treeview-get-last-child %s" (widget-get node :tag))
1418 (let ((children (widget-get node :children)))
1419 (if children
1420 (car (reverse children))
1421 nil)))
1422
1423(defun newsticker--treeview-get-feed-vfeed (node)
1424 "Get (virtual) feed of NODE."
1425 (or (widget-get node :nt-feed) (widget-get node :nt-vfeed)))
1426
1427(defun newsticker--treeview-get-next-sibling (node)
1428 "Get next sibling of NODE."
1429 (let ((parent (widget-get node :parent)))
1430 (catch 'found
1431 (let ((children (widget-get parent :children)))
1432 (while children
1433 (if (newsticker--treeview-nodes-eq (car children) node)
1434 (throw 'found (car (cdr children))))
1435 (setq children (cdr children)))))))
1436
1437(defun newsticker--treeview-get-prev-sibling (node)
1438 "Get previous sibling of NODE."
1439 (let ((parent (widget-get node :parent)))
1440 (catch 'found
1441 (let ((children (widget-get parent :children))
1442 (prev nil))
1443 (while children
1444 (if (and (newsticker--treeview-nodes-eq (car children) node)
1445 (widget-get prev :nt-id))
1446 (throw 'found prev))
1447 (setq prev (car children))
1448 (setq children (cdr children)))))))
1449
1450(defun newsticker--treeview-get-next-uncle (node)
1451 "Get next uncle of NODE, i.e. parent's next sibling."
1452 (let* ((parent (widget-get node :parent))
1453 (grand-parent (widget-get parent :parent)))
1454 (catch 'found
1455 (let ((uncles (widget-get grand-parent :children)))
1456 (while uncles
1457 (if (newsticker--treeview-nodes-eq (car uncles) parent)
1458 (throw 'found (car (cdr uncles))))
1459 (setq uncles (cdr uncles)))))))
1460
1461(defun newsticker--treeview-get-prev-uncle (node)
1462 "Get previous uncle of NODE, i.e. parent's previous sibling."
1463 (let* ((parent (widget-get node :parent))
1464 (grand-parent (widget-get parent :parent)))
1465 (catch 'found
1466 (let ((uncles (widget-get grand-parent :children))
1467 (prev nil))
1468 (while uncles
1469 (if (newsticker--treeview-nodes-eq (car uncles) parent)
1470 (throw 'found prev))
1471 (setq prev (car uncles))
1472 (setq uncles (cdr uncles)))))))
1473
1474(defun newsticker--treeview-get-other-tree ()
1475 "Get other tree."
1476 (if (and (newsticker--treeview-get-current-node)
1477 (widget-get (newsticker--treeview-get-current-node) :nt-feed))
1478 newsticker--treeview-vfeed-tree
1479 newsticker--treeview-feed-tree))
1480
1481(defun newsticker--treeview-activate-node (node &optional backward)
1482 "Activate NODE.
1483If NODE is a tree widget the node's first subnode is activated.
1484If BACKWARD is non-nil the last subnode of the previous sibling
1485is activated."
1486 (newsticker--treeview-set-current-node node)
1487 (save-current-buffer
1488 (set-buffer (newsticker--treeview-tree-buffer))
1489 (cond ((eq (widget-type node) 'tree-widget)
1490 (unless (widget-get node :open)
1491 (widget-put node :open nil)
1492 (widget-apply-action node))
1493 (newsticker--treeview-activate-node
1494 (if backward
1495 (newsticker--treeview-get-last-child node)
1496 (newsticker--treeview-get-second-child node))))
1497 (node
1498 (widget-apply-action node)))))
1499
1500(defun newsticker-treeview-next-feed ()
1501 "Move to next feed."
1502 (interactive)
1503 (newsticker--treeview-restore-buffers)
1504 (let ((cur (newsticker--treeview-get-current-node)))
1505 ;;(message "newsticker-treeview-next-feed from %s"
1506 ;; (widget-get cur :tag))
1507 (if cur
1508 (let ((new (or (newsticker--treeview-get-next-sibling cur)
1509 (newsticker--treeview-get-next-uncle cur)
1510 (newsticker--treeview-get-other-tree))))
1511 (newsticker--treeview-activate-node new))
1512 (newsticker--treeview-activate-node
1513 (car (widget-get newsticker--treeview-feed-tree :children)))))
1514 (newsticker--treeview-tree-update-highlight))
1515
1516(defun newsticker-treeview-prev-feed ()
1517 "Move to previous feed."
1518 (interactive)
1519 (newsticker--treeview-restore-buffers)
1520 (let ((cur (newsticker--treeview-get-current-node)))
1521 (message "newsticker-treeview-prev-feed from %s"
1522 (widget-get cur :tag))
1523 (if cur
1524 (let ((new (or (newsticker--treeview-get-prev-sibling cur)
1525 (newsticker--treeview-get-prev-uncle cur)
1526 (newsticker--treeview-get-other-tree))))
1527 (newsticker--treeview-activate-node new t))
1528 (newsticker--treeview-activate-node
1529 (car (widget-get newsticker--treeview-feed-tree :children)) t)))
1530 (newsticker--treeview-tree-update-highlight))
1531
1532(defun newsticker-treeview-next-page ()
1533 "Scroll item buffer."
1534 (interactive)
1535 (save-selected-window
1536 (select-window (newsticker--treeview-item-window) t)
1537 (condition-case nil
1538 (scroll-up nil)
1539 (error
1540 (goto-char (point-min))))))
1541
1542
1543(defun newsticker--treeview-unfold-node (feed-name)
1544 "Recursively show subtree above the node that represents FEED-NAME."
1545 (let ((node (newsticker--treeview-get-node-of-feed feed-name)))
1546 (unless node
1547 (let* ((group-name (or (car (newsticker--group-find-group-for-feed
1548 feed-name))
1549 (newsticker--group-get-parent-group
1550 feed-name))))
1551 (newsticker--treeview-unfold-node group-name))
1552 (setq node (newsticker--treeview-get-node-of-feed feed-name)))
1553 (when node
1554 (save-excursion
1555 (set-buffer (newsticker--treeview-tree-buffer))
1556 (widget-put node :nt-selected t)
1557 (widget-apply-action node)
1558 (newsticker--treeview-set-current-node node)))))
1559
1560(defun newsticker-treeview-jump (feed-name)
1561 "Jump to feed FEED-NAME in newsticker treeview."
1562 (interactive
1563 (list (let ((completion-ignore-case t))
1564 (if newsticker-treeview-own-frame
1565 (set-window-dedicated-p (newsticker--treeview-item-window) nil))
1566 (completing-read
1567 "Jump to feed: "
1568 (mapcar 'car (append newsticker-url-list
1569 newsticker-url-list-defaults))
1570 nil t))))
1571 (if newsticker-treeview-own-frame
1572 (set-window-dedicated-p (newsticker--treeview-item-window) t))
1573 (newsticker--treeview-unfold-node feed-name))
1574
1575;; ======================================================================
1576;;; Groups
1577;; ======================================================================
1578(defun newsticker--group-do-find-group-for-feed (feed-name node)
1579 "Recursively find FEED-NAME in NODE."
1580 (if (member feed-name (cdr node))
1581 (throw 'found node)
1582 (mapc (lambda (n)
1583 (if (listp n)
1584 (newsticker--group-do-find-group-for-feed feed-name n)))
1585 (cdr node))))
1586
1587(defun newsticker--group-find-group-for-feed (feed-name)
1588 "Find group containing FEED-NAME."
1589 (catch 'found
1590 (newsticker--group-do-find-group-for-feed feed-name
1591 newsticker-groups)
1592 nil))
1593
1594(defun newsticker--group-do-get-group (name node)
1595 "Recursively find group with NAME below NODE."
1596 (if (string= name (car node))
1597 (throw 'found node)
1598 (mapc (lambda (n)
1599 (if (listp n)
1600 (newsticker--group-do-get-group name n)))
1601 (cdr node))))
1602
1603(defun newsticker--group-get-group (name)
1604 "Find group with NAME."
1605 (catch 'found
1606 (mapc (lambda (n)
1607 (if (listp n)
1608 (newsticker--group-do-get-group name n)))
1609 newsticker-groups)
1610 nil))
1611
1612(defun newsticker--group-do-get-parent-group (name node parent)
1613 "Recursively find parent group for NAME from NODE which is a child of PARENT."
1614 (if (string= name (car node))
1615 (throw 'found parent)
1616 (mapc (lambda (n)
1617 (if (listp n)
1618 (newsticker--group-do-get-parent-group name n (car node))))
1619 (cdr node))))
1620
1621(defun newsticker--group-get-parent-group (name)
1622 "Find parent group for group named NAME."
1623 (catch 'found
1624 (mapc (lambda (n)
1625 (if (listp n)
1626 (newsticker--group-do-get-parent-group
1627 name n (car newsticker-groups))))
1628 newsticker-groups)
1629 nil))
1630
1631
1632(defun newsticker--group-get-subgroups (group &optional recursive)
1633 "Return list of subgroups for GROUP.
1634If RECURSIVE is non-nil recursively get subgroups and return a nested list."
1635 (let ((result nil))
1636 (mapc (lambda (n)
1637 (when (listp n)
1638 (setq result (cons (car n) result))
1639 (let ((subgroups (newsticker--group-get-subgroups n recursive)))
1640 (when subgroups
1641 (setq result (append subgroups result))))))
1642 group)
1643 result))
1644
1645(defun newsticker--group-all-groups ()
1646 "Return nested list of all groups."
1647 (newsticker--group-get-subgroups newsticker-groups t))
1648
1649(defun newsticker--group-get-feeds (group &optional recursive)
1650 "Return list of all feeds in GROUP.
1651If RECURSIVE is non-nil recursively get feeds of subgroups and
1652return a nested list."
1653 (let ((result nil))
1654 (mapc (lambda (n)
1655 (if (not (listp n))
1656 (setq result (cons n result))
1657 (if recursive
1658 (let ((subfeeds (newsticker--group-get-feeds n t)))
1659 (when subfeeds
1660 (setq result (append subfeeds result)))))))
1661 group)
1662 result))
1663
1664(defun newsticker-group-add-group (name parent)
1665 "Add group NAME to group PARENT."
1666 (interactive
1667 (list (read-string "Group Name: ")
1668 (let ((completion-ignore-case t))
1669 (if newsticker-treeview-own-frame
1670 (set-window-dedicated-p (newsticker--treeview-item-window) nil))
1671 (completing-read "Parent Group: " (newsticker--group-all-groups)
1672 nil t))))
1673 (if newsticker-treeview-own-frame
1674 (set-window-dedicated-p (newsticker--treeview-item-window) t))
1675 (if (newsticker--group-get-group name)
1676 (error "Group %s exists already" name))
1677 (let ((p (if (and parent (not (string= parent "")))
1678 (newsticker--group-get-group parent)
1679 newsticker-groups)))
1680 (unless p
1681 (error "Parent %s does not exist" parent))
1682 (setcdr p (cons (list name) (cdr p))))
1683 (newsticker--treeview-tree-update))
1684
1685(defun newsticker-group-move-feed (name group-name &optional no-update)
1686 "Move feed NAME to group GROUP-NAME.
1687Update teeview afterwards unless NO-UPDATE is non-nil."
1688 (interactive
1689 (let ((completion-ignore-case t))
1690 (if newsticker-treeview-own-frame
1691 (set-window-dedicated-p (newsticker--treeview-item-window) nil))
1692 (list (completing-read "Feed Name: "
1693 (mapcar 'car newsticker-url-list)
1694 nil t newsticker--treeview-current-feed)
1695 (completing-read "Group Name: " (newsticker--group-all-groups)
1696 nil t))))
1697 (if newsticker-treeview-own-frame
1698 (set-window-dedicated-p (newsticker--treeview-item-window) t))
1699 (let ((group (if (and group-name (not (string= group-name "")))
1700 (newsticker--group-get-group group-name)
1701 newsticker-groups)))
1702 (unless group
1703 (error "Group %s does not exist" group-name))
1704 (while (let ((old-group
1705 (newsticker--group-find-group-for-feed name)))
1706 (when old-group
1707 (delete name old-group))
1708 old-group))
1709 (setcdr group (cons name (cdr group)))
1710 (unless no-update
1711 (newsticker--treeview-tree-update)
1712 (newsticker-treeview-update))))
1713
1714(defun newsticker-group-delete-group (name)
1715 "Remove group NAME."
1716 (interactive
1717 (let ((completion-ignore-case t))
1718 (if newsticker-treeview-own-frame
1719 (set-window-dedicated-p (newsticker--treeview-item-window) nil))
1720 (list (completing-read "Group Name: " (newsticker--group-all-groups)
1721 nil t))))
1722 (if newsticker-treeview-own-frame
1723 (set-window-dedicated-p (newsticker--treeview-item-window) t))
1724 (let* ((g (newsticker--group-get-group name))
1725 (p (or (newsticker--group-get-parent-group name)
1726 newsticker-groups)))
1727 (unless g
1728 (error "Group %s does not exist" name))
1729 (delete g p))
1730 (newsticker--treeview-tree-update))
1731
1732(defun newsticker--count-groups (group)
1733 "Recursively count number of subgroups of GROUP."
1734 (let ((result 1))
1735 (mapc (lambda (g)
1736 (if (listp g)
1737 (setq result (+ result (newsticker--count-groups g)))))
1738 (cdr group))
1739 result))
1740
1741(defun newsticker--count-grouped-feeds (group)
1742 "Recursively count number of feeds in GROUP and its subgroups."
1743 (let ((result 0))
1744 (mapc (lambda (g)
1745 (if (listp g)
1746 (setq result (+ result (newsticker--count-grouped-feeds g)))
1747 (setq result (1+ result))))
1748 (cdr group))
1749 result))
1750
1751(defun newsticker--group-remove-obsolete-feeds (group)
1752 "Recursively remove obselete feeds from GROUP."
1753 (let ((result nil)
1754 (urls (append newsticker-url-list newsticker-url-list-defaults)))
1755 (mapc (lambda (g)
1756 (if (listp g)
1757 (let ((sub-groups
1758 (newsticker--group-remove-obsolete-feeds g)))
1759 (if sub-groups
1760 (setq result (cons sub-groups result))))
1761 (if (assoc g urls)
1762 (setq result (cons g result)))))
1763 (cdr group))
1764 (if result
1765 (cons (car group) (reverse result))
1766 result)))
1767
1768(defun newsticker--group-manage-orphan-feeds ()
1769 "Put unmanaged feeds into `newsticker-groups'.
1770Remove obsolete feeds as well."
1771 (let ((new-feed nil)
1772 (grouped-feeds (newsticker--count-grouped-feeds newsticker-groups)))
1773 (mapc (lambda (f)
1774 (unless (newsticker--group-find-group-for-feed (car f))
1775 (setq new-feed t)
1776 (newsticker-group-move-feed (car f) nil t)))
1777 (append newsticker-url-list-defaults newsticker-url-list))
1778 (setq newsticker-groups
1779 (newsticker--group-remove-obsolete-feeds newsticker-groups))
1780 (if (or new-feed
1781 (not (= grouped-feeds
1782 (newsticker--count-grouped-feeds newsticker-groups))))
1783 (newsticker--treeview-tree-update))))
1784
1785;; ======================================================================
1786;;; Modes
1787;; ======================================================================
1788(defun newsticker--treeview-create-groups-menu (group-list
1789 excluded-group)
1790 "Create menu for GROUP-LIST omitting EXCLUDED-GROUP."
1791 (let ((menu (make-sparse-keymap (if (stringp (car group-list))
1792 (car group-list)
1793 "Move to group..."))))
1794 (mapc (lambda (g)
1795 (when (listp g)
1796 (let ((title (if (stringp (car g))
1797 (car g)
1798 "Move to group...")))
1799 (unless (eq g excluded-group)
1800 (define-key menu (vector (intern title))
1801 (list 'menu-item title
1802 (newsticker--treeview-create-groups-menu
1803 (cdr g) excluded-group)))))))
1804 (reverse group-list))
1805 menu))
1806
1807(defun newsticker--treeview-create-tree-menu (feed-name)
1808 "Create tree menu for FEED-NAME."
1809 (let ((menu (make-sparse-keymap feed-name)))
1810 (define-key menu [newsticker-treeview-mark-list-items-old]
1811 (list 'menu-item "Mark all items old"
1812 'newsticker-treeview-mark-list-items-old))
1813 (define-key menu [move]
1814 (list 'menu-item "Move to group..."
1815 (newsticker--treeview-create-groups-menu
1816 newsticker-groups
1817 (newsticker--group-get-group feed-name))))
1818 menu))
1819
1820;;(makunbound 'newsticker-treeview-list-menu) ;FIXME
1821(defvar newsticker-treeview-list-menu
1822 (let ((menu (make-sparse-keymap "Newsticker List")))
1823 (define-key menu [newsticker-treeview-mark-list-items-old]
1824 (list 'menu-item "Mark all items old"
1825 'newsticker-treeview-mark-list-items-old))
1826 menu)
1827 "Map for newsticker tree menu.")
1828
1829;;(makunbound 'newsticker-treeview-mode-map) ;FIXME
1830(defvar newsticker-treeview-mode-map
1831 (let ((map (make-sparse-keymap 'newsticker-treeview-mode-map)))
1832 (define-key map " " 'newsticker-treeview-next-page)
1833 (define-key map "a" 'newsticker-add-url)
1834 (define-key map "F" 'newsticker-treeview-prev-feed)
1835 (define-key map "f" 'newsticker-treeview-next-feed)
1836 (define-key map "g" 'newsticker-treeview-get-news)
1837 (define-key map "G" 'newsticker-get-all-news)
1838 (define-key map "i" 'newsticker-treeview-toggle-item-immortal)
1839 (define-key map "j" 'newsticker-treeview-jump)
1840 (define-key map "n" 'newsticker-treeview-next-item)
1841 (define-key map "N" 'newsticker-treeview-next-new-or-immortal-item)
1842 (define-key map "O" 'newsticker-treeview-mark-list-items-old)
1843 (define-key map "o" 'newsticker-treeview-mark-item-old)
1844 (define-key map "p" 'newsticker-treeview-prev-item)
1845 (define-key map "P" 'newsticker-treeview-prev-new-or-immortal-item)
1846 (define-key map "q" 'newsticker-treeview-quit)
1847 (define-key map "S" 'newsticker-treeview-save-item)
1848 (define-key map "s" 'newsticker-treeview-save)
1849 (define-key map "u" 'newsticker-treeview-update)
1850 (define-key map "v" 'newsticker-treeview-browse-url)
1851 ;;(define-key map "\n" 'newsticker-treeview-scroll-item)
1852 ;;(define-key map "\C-m" 'newsticker-treeview-scroll-item)
1853 (define-key map "\M-m" 'newsticker-group-move-feed)
1854 (define-key map "\M-a" 'newsticker-group-add-group)
1855 map)
1856 "Mode map for newsticker treeview.")
1857
1858(defun newsticker-treeview-mode ()
1859 "Major mode for Newsticker Treeview.
1860\\{newsticker-treeview-mode-map}"
1861 (kill-all-local-variables)
1862 (use-local-map newsticker-treeview-mode-map)
1863 (setq major-mode 'newsticker-treeview-mode)
1864 (setq mode-name "Newsticker TV")
1865 (set (make-local-variable 'tool-bar-map) newsticker-treeview-tool-bar-map)
1866 (setq buffer-read-only t
1867 truncate-lines t))
1868
1869;;(makunbound 'newsticker-treeview-list-mode-map);FIXME
1870(define-derived-mode newsticker-treeview-list-mode newsticker-treeview-mode
1871 "Item List"
1872 (let ((header (concat
1873 (propertize " " 'display '(space :align-to 0))
1874 (newsticker-treeview-list-make-sort-button "*" 'sort-by-age)
1875 (propertize " " 'display '(space :align-to 2))
1876 (if newsticker--treeview-list-show-feed
1877 (concat "Feed"
1878 (propertize " " 'display '(space :align-to 12)))
1879 "")
1880 (newsticker-treeview-list-make-sort-button "Date"
1881 'sort-by-time)
1882 (if newsticker--treeview-list-show-feed
1883 (propertize " " 'display '(space :align-to 28))
1884 (propertize " " 'display '(space :align-to 18)))
1885 (newsticker-treeview-list-make-sort-button "Title"
1886 'sort-by-title))))
1887 (setq header-line-format header))
1888 (define-key newsticker-treeview-list-mode-map [down-mouse-3]
1889 newsticker-treeview-list-menu))
1890
1891(defun newsticker-treeview-tree-click (event)
1892 "Handle click EVENT on a tag in the newsticker tree."
1893 (interactive "e")
1894 (save-excursion
1895 (switch-to-buffer (window-buffer (posn-window (event-end event))))
1896 (newsticker-treeview-tree-do-click (posn-point (event-end event)))))
1897
1898(defun newsticker-treeview-tree-do-click (&optional pos event)
1899 "Actually handle click event.
1900POS gives the position where EVENT occurred."
1901 (interactive)
1902 (unless pos (setq pos (point)))
1903 (let ((pos (or pos (point)))
1904 (nt-id (get-text-property pos :nt-id))
1905 (item (get-text-property pos :nt-item)))
1906 (cond (item
1907 ;; click in list buffer
1908 (newsticker-treeview-show-item))
1909 (t
1910 ;; click in tree buffer
1911 (let ((w (newsticker--treeview-get-node nt-id)))
1912 (when w
1913 (newsticker--treeview-tree-update-tag w t t)
1914 (setq w (newsticker--treeview-get-node nt-id))
1915 (widget-put w :nt-selected t)
1916 (widget-apply w :action event)
1917 (newsticker--treeview-set-current-node w))))))
1918 (newsticker--treeview-tree-update-highlight))
1919
1920(defun newsticker--treeview-restore-buffers ()
1921 "Restore treeview buffers."
1922 (catch 'error
1923 (dotimes (i 3)
1924 (let ((win (nth i newsticker--treeview-windows))
1925 (buf (nth i newsticker--treeview-buffers)))
1926 (unless (window-live-p win)
1927 (newsticker--treeview-window-init)
1928 (newsticker--treeview-buffer-init)
1929 (throw 'error t))
1930 (unless (eq (window-buffer win) buf)
1931 (set-window-buffer win buf t))))))
1932
1933(defun newsticker--treeview-frame-init ()
1934 "Initialize treeview frame."
1935 (when newsticker-treeview-own-frame
1936 (unless (and newsticker--frame (frame-live-p newsticker--frame))
1937 (setq newsticker--frame (make-frame '((name . "Newsticker")))))
1938 (select-frame-set-input-focus newsticker--frame)
1939 (raise-frame newsticker--frame)))
1940
1941(defun newsticker--treeview-window-init ()
1942 "Initialize treeview windows."
1943 (setq newsticker--saved-window-config (current-window-configuration))
1944 (setq newsticker--treeview-windows nil)
1945 (setq newsticker--treeview-buffers nil)
1946 (delete-other-windows)
1947 (split-window-horizontally 25)
1948 (add-to-list 'newsticker--treeview-windows (selected-window) t)
1949 (other-window 1)
1950 (split-window-vertically 10)
1951 (add-to-list 'newsticker--treeview-windows (selected-window) t)
1952 (other-window 1)
1953 (add-to-list 'newsticker--treeview-windows (selected-window) t)
1954 (other-window 1))
1955
1956(defun newsticker-treeview ()
1957 "Start newsticker treeview."
1958 (interactive)
1959 (newsticker--treeview-load)
1960 (setq newsticker--sentinel-callback 'newsticker-treeview-update)
1961 (newsticker--treeview-frame-init)
1962 (newsticker--treeview-window-init)
1963 (newsticker--treeview-buffer-init)
1964 (newsticker--group-manage-orphan-feeds)
1965 (if newsticker--window-config
1966 (set-window-configuration newsticker--window-config))
1967 (newsticker--treeview-set-current-node newsticker--treeview-feed-tree)
1968 (newsticker-start t) ;; will start only if not running
1969 (newsticker-treeview-update)
1970 (newsticker--treeview-item-show-text
1971 "Newsticker"
1972 "Welcome to newsticker!"))
1973
1974(defun newsticker-treeview-get-news ()
1975 "Get news for current feed."
1976 (interactive)
1977 (when newsticker--treeview-current-feed
1978 (newsticker-get-news newsticker--treeview-current-feed)))
1979
1980(provide 'newsticker-treeview)
1981
1982;;; newsticker-treeview.el ends here
generated by cgit v1.2.1 (git 2.18.0) at 2026-02-15 01:26:02 +0000