lisp/net/newst-treeview.el

   1 ;;; newst-treeview.el --- Treeview frontend for newsticker.
   2
   3 ;; Copyright (C) 2008 Free Software Foundation, Inc.
   4
   5 ;; Author:      Ulf Jasper <ulf.jasper@web.de>
   6 ;; Filename:    newst-treeview.el
   7 ;; URL:         http://www.nongnu.org/newsticker
   8 ;; Created:     2007
   9 ;; Keywords:    News, RSS, Atom
  10 ;; Time-stamp:  "21. Juni 2008, 17:35:21 (ulf)"
  11
  12 ;; ======================================================================
  13
  14 ;; This file is part of GNU Emacs.
  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 ;;; Commentary:
  31
  32 ;; See newsticker.el
  33
  34 ;; ======================================================================
  35 ;;; History:
  36 ;;
  37
  38
  39 ;; ======================================================================
  40 ;;; Code:
  41 (require 'newsticker-reader "newst-reader")
  42 (require 'widget)
  43 (require 'tree-widget)
  44 (require 'wid-edit)
  45
  46 ;; ======================================================================
  47 ;;; Customization
  48 ;; ======================================================================
  49 (defgroup newsticker-treeview nil
  50   "Settings for the tree view reader."
  51   :group 'newsticker-reader)
  52
  53 (defface newsticker-treeview-face
  54   '((((class color) (background dark))
  55      (:family "helvetica" :foreground "misty rose" :bold nil))
  56     (((class color) (background light))
  57      (:family "helvetica" :foreground "black" :bold nil)))
  58   "Face for newsticker tree."
  59   :group 'newsticker-treeview)
  60
  61 (defface newsticker-treeview-new-face
  62   '((((class color) (background dark))
  63      (:inherit newsticker-treeview-face :bold t))
  64     (((class color) (background light))
  65      (:inherit newsticker-treeview-face :bold t)))
  66   "Face for newsticker tree."
  67   :group 'newsticker-treeview)
  68
  69 (defface newsticker-treeview-old-face
  70   '((((class color) (background dark))
  71      (:inherit newsticker-treeview-face))
  72     (((class color) (background light))
  73      (:inherit newsticker-treeview-face)))
  74   "Face for newsticker tree."
  75   :group 'newsticker-treeview)
  76
  77 (defface newsticker-treeview-immortal-face
  78   '((((class color) (background dark))
  79      (:inherit newsticker-treeview-face :foreground "orange" :italic t))
  80     (((class color) (background light))
  81      (:inherit newsticker-treeview-face :foreground "blue" :italic t)))
  82   "Face for newsticker tree."
  83   :group 'newsticker-treeview)
  84
  85 (defface newsticker-treeview-obsolete-face
  86   '((((class color) (background dark))
  87      (:inherit newsticker-treeview-face :strike-through t))
  88     (((class color) (background light))
  89      (:inherit newsticker-treeview-face :strike-through t)))
  90   "Face for newsticker tree."
  91   :group 'newsticker-treeview)
  92
  93 (defface newsticker-treeview-selection-face
  94   '((((class color) (background dark))
  95      (:background "#bbbbff"))
  96     (((class color) (background light))
  97      (:background "#bbbbff")))
  98   "Face for newsticker selection."
  99   :group 'newsticker-treeview)
 100
 101 (defcustom newsticker-treeview-own-frame
 102   nil
 103   "Decides whether newsticker creates and uses its own frame."
 104   :type 'boolean
 105   :group 'newsticker-treeview)
 106
 107 (defcustom newsticker-treeview-automatically-mark-displayed-items-as-old
 108   t
 109   "Decides whether to automatically mark displayed items as old.
 110 If t an item is marked as old as soon as it is displayed.  This
 111 applies to newsticker only."
 112   :type 'boolean
 113   :group 'newsticker-treeview)
 114
 115 (defvar newsticker-groups
 116   '("Feeds")
 117   "List of feed groups, used in the treeview frontend.
 118 First element is a string giving the group name.  Remaining
 119 elements are either strings giving a feed name or lists having
 120 the same structure as `newsticker-groups'. (newsticker-groups :=
 121 groupdefinition, groupdefinition := groupname groupcontent*,
 122 groupcontent := feedname | groupdefinition)
 123
 124 Example: (\"Topmost group\" \"feed1\" (\"subgroup1\" \"feed 2\")
 125 \"feed3\")")
 126
 127 (defcustom newsticker-groups-filename
 128   "~/.newsticker-groups"
 129   "Name of the newsticker groups settings file."
 130   :type 'string
 131   :group 'newsticker-treeview)
 132
 133 ;; ======================================================================
 134 ;;; internal variables
 135 ;; ======================================================================
 136 (defvar newsticker--treeview-windows nil)
 137 (defvar newsticker--treeview-buffers nil)
 138 (defvar newsticker--treeview-current-feed nil)
 139 (defvar newsticker--treeview-current-vfeed nil)
 140 (defvar newsticker--treeview-list-show-feed nil)
 141 (defvar newsticker--saved-window-config nil)
 142 (defvar newsticker--selection-overlay nil
 143   "Highlight the selected tree node.")
 144 (defvar newsticker--tree-selection-overlay nil
 145   "Highlight the selected list item.")
 146 (defvar newsticker--frame nil "Special frame for newsticker windows.")
 147 (defvar newsticker--treeview-list-sort-order 'sort-by-time)
 148 (defvar newsticker--treeview-current-node-id nil)
 149 (defvar newsticker--treeview-current-tree nil)
 150 (defvar newsticker--treeview-feed-tree nil)
 151 (defvar newsticker--treeview-vfeed-tree nil)
 152
 153 ;; maps for the clickable portions
 154 (defvar newsticker--treeview-url-keymap
 155   (let ((map (make-sparse-keymap 'newsticker--treeview-url-keymap)))
 156     (define-key map [mouse-1] 'newsticker-treeview-mouse-browse-url)
 157     (define-key map [mouse-2] 'newsticker-treeview-mouse-browse-url)
 158     (define-key map "\n" 'newsticker-treeview-browse-url)
 159     (define-key map "\C-m" 'newsticker-treeview-browse-url)
 160     (define-key map [(control return)] 'newsticker-handle-url)
 161     map)
 162   "Key map for click-able headings in the newsticker treeview buffers.")
 163
 164
 165 ;; ======================================================================
 166 ;;; short cuts
 167 ;; ======================================================================
 168 (defsubst newsticker--treeview-tree-buffer ()
 169   "Return the tree buffer of the newsticker treeview."
 170   (nth 0 newsticker--treeview-buffers))
 171 (defsubst newsticker--treeview-list-buffer ()
 172   "Return the list buffer of the newsticker treeview."
 173   (nth 1 newsticker--treeview-buffers))
 174 (defsubst newsticker--treeview-item-buffer ()
 175   "Return the item buffer of the newsticker treeview."
 176   (nth 2 newsticker--treeview-buffers))
 177 (defsubst newsticker--treeview-tree-window ()
 178   "Return the tree window of the newsticker treeview."
 179   (nth 0 newsticker--treeview-windows))
 180 (defsubst newsticker--treeview-list-window ()
 181   "Return the list window of the newsticker treeview."
 182   (nth 1 newsticker--treeview-windows))
 183 (defsubst newsticker--treeview-item-window ()
 184   "Return the item window of the newsticker treeview."
 185   (nth 2 newsticker--treeview-windows))
 186
 187 ;; ======================================================================
 188 ;;; utility functions
 189 ;; ======================================================================
 190 (defun newsticker--treeview-get-id (parent i)
 191   "Create an id for a newsticker treeview node.
 192 PARENT is the node's parent, I is an integer."
 193   ;;(message "newsticker--treeview-get-id %s"
 194   ;;       (format "%s-%d" (widget-get parent :nt-id) i))
 195   (format "%s-%d" (widget-get parent :nt-id) i))
 196
 197 (defun newsticker--treeview-ids-eq (id1 id2)
 198   "Return non-nil if ids ID1 and ID2 are equal."
 199   ;;(message "%s/%s" (or id1 -1) (or id2 -1))
 200   (and id1 id2 (string= id1 id2)))
 201
 202 (defun newsticker--treeview-nodes-eq (node1 node2)
 203   "Compare treeview nodes NODE1 and NODE2 for equality.
 204 Nodes are equal if the have the same newsticker-id.  Note that
 205 during re-tagging and collapsing/expanding nodes change, while
 206 their id stays constant."
 207   (let ((id1 (widget-get node1 :nt-id))
 208         (id2 (widget-get node2 :nt-id)))
 209     ;;(message "%s/%s %s/%s" (widget-get node1 :tag) (widget-get node2 :tag)
 210     ;;       (or id1 -1) (or id2 -1))
 211     (or (newsticker--treeview-ids-eq id1 id2)
 212         (string= (widget-get node1 :tag) (widget-get node2 :tag)))))
 213
 214 (defun newsticker--treeview-do-get-node-of-feed (feed-name startnode)
 215    "Recursivly search node for feed FEED-NAME starting from STARTNODE."
 216    ;;(message "%s/%s" feed-name (widget-get startnode :nt-feed))
 217    (if (string= feed-name (or (widget-get startnode :nt-feed)
 218                               (widget-get startnode :nt-vfeed)))
 219        (throw 'found startnode)
 220      (let ((children (widget-get startnode :children)))
 221        (dolist (w children)
 222          (newsticker--treeview-do-get-node-of-feed feed-name w)))))
 223
 224 (defun newsticker--treeview-get-node-of-feed (feed-name)
 225   "Return node for feed FEED-NAME in newsticker treeview tree."
 226   (catch 'found
 227     (newsticker--treeview-do-get-node-of-feed feed-name
 228                                               newsticker--treeview-feed-tree)
 229     (newsticker--treeview-do-get-node-of-feed feed-name
 230                                               newsticker--treeview-vfeed-tree)))
 231
 232 (defun newsticker--treeview-do-get-node (id startnode)
 233    "Recursivly search node with ID starting from STARTNODE."
 234    (if (newsticker--treeview-ids-eq id (widget-get startnode :nt-id))
 235        (throw 'found startnode)
 236      (let ((children (widget-get startnode :children)))
 237        (dolist (w children)
 238          (newsticker--treeview-do-get-node id w)))))
 239
 240 (defun newsticker--treeview-get-node (id)
 241   "Return node with ID in newsticker treeview tree."
 242   (catch 'found
 243     (newsticker--treeview-do-get-node id newsticker--treeview-feed-tree)
 244     (newsticker--treeview-do-get-node id newsticker--treeview-vfeed-tree)))
 245
 246 (defun newsticker--treeview-get-current-node ()
 247   "Return current node in newsticker treeview tree."
 248   (newsticker--treeview-get-node newsticker--treeview-current-node-id))
 249
 250 ;; ======================================================================
 251
 252 (declare-function w3m-toggle-inline-images "ext:w3m" (&optional force no-cache))
 253
 254 (defun newsticker--treeview-render-text (start end)
 255   "Render text between markers START and END."
 256   (if newsticker-html-renderer
 257       (condition-case error-data
 258           (save-excursion
 259             (set-marker-insertion-type end t)
 260             ;; check whether it is necessary to call html renderer
 261             ;; (regexp inspired by htmlr.el)
 262             (goto-char start)
 263             (when (re-search-forward
 264                    "</?[A-Za-z1-6]*\\|&#?[A-Za-z0-9]+;" end t)
 265               ;; (message "%s" (newsticker--title item))
 266               (let ((w3m-fill-column (if newsticker-use-full-width
 267                                          -1 fill-column))
 268                     (w3-maximum-line-length
 269                      (if newsticker-use-full-width nil fill-column)))
 270                 (save-excursion
 271                   (funcall newsticker-html-renderer start end)))
 272               ;;(cond ((eq newsticker-html-renderer 'w3m-region)
 273               ;;     (add-text-properties start end (list 'keymap
 274               ;;                                        w3m-minor-mode-map)))
 275               ;;((eq newsticker-html-renderer 'w3-region)
 276               ;;(add-text-properties start end (list 'keymap w3-mode-map))))
 277               (if (eq newsticker-html-renderer 'w3m-region)
 278                   (w3m-toggle-inline-images t))
 279               t))
 280         (error
 281          (message "Error: HTML rendering failed: %s, %s"
 282                   (car error-data) (cdr error-data))
 283          nil))
 284     nil))
 285
 286 ;; ======================================================================
 287 ;;; List window
 288 ;; ======================================================================
 289 (defun newsticker--treeview-list-add-item (item feed &optional show-feed)
 290   "Add news ITEM for FEED to newsticker treeview list window.
 291 If string SHOW-FEED is non-nil it is shown in the item string."
 292   (setq newsticker--treeview-list-show-feed show-feed)
 293   (save-excursion
 294     (set-buffer (newsticker--treeview-list-buffer))
 295     (let* ((inhibit-read-only t)
 296            pos1 pos2)
 297       (goto-char (point-max))
 298       (setq pos1 (point-marker))
 299       (insert " ")
 300       (insert (propertize " " 'display '(space :align-to 2)))
 301       (insert (if show-feed
 302                   (concat
 303                    (substring
 304                     (format "%-10s" (newsticker--real-feed-name
 305                                      feed))
 306                     0 10)
 307                    (propertize " " 'display '(space :align-to 12)))
 308                 ""))
 309       (insert (format-time-string "%d.%m.%y, %H:%M"
 310                                   (newsticker--time item)))
 311       (insert (propertize " " 'display
 312                           (list 'space :align-to (if show-feed 28 18))))
 313       (setq pos2 (point-marker))
 314       (insert (newsticker--title item))
 315       (insert "\n")
 316       (newsticker--treeview-render-text pos2 (point-marker))
 317       (goto-char pos2)
 318       (while (search-forward "\n" nil t)
 319         (replace-match " "))
 320       (let ((map (make-sparse-keymap)))
 321         (define-key map [mouse-1] 'newsticker-treeview-tree-click)
 322         (define-key map "\n" 'newsticker-treeview-show-item)
 323         (define-key map "\C-m" 'newsticker-treeview-show-item)
 324         (add-text-properties pos1 (point-max)
 325                              (list :nt-item item
 326                                    :nt-feed feed
 327                                    :nt-link (newsticker--link item)
 328                                    'mouse-face 'highlight
 329                                    'keymap map
 330                                    'help-echo (buffer-substring pos2
 331                                                                 (point-max)))))
 332       (insert "\n"))))
 333
 334 (defun newsticker--treeview-list-clear ()
 335   "Clear the newsticker treeview list window."
 336   (save-excursion
 337     (set-buffer (newsticker--treeview-list-buffer))
 338     (let ((inhibit-read-only t))
 339       (erase-buffer)
 340       (kill-all-local-variables)
 341       (remove-overlays))))
 342
 343 (defun newsticker--treeview-list-items-with-age-callback (widget
 344                                                           changed-widget
 345                                                           &rest ages)
 346   "Fill newsticker treeview list window with items of certain age.
 347 This is a callback function for the treeview nodes.
 348 Argument WIDGET is the calling treeview widget.
 349 Argument CHANGED-WIDGET is the widget that actually has changed.
 350 Optional argument AGES is the list of ages that are to be shown."
 351   (newsticker--treeview-list-clear)
 352   (widget-put widget :nt-selected t)
 353   (apply 'newsticker--treeview-list-items-with-age ages))
 354
 355 (defun newsticker--treeview-list-items-with-age (&rest ages)
 356   "Actually fill newsticker treeview list window with items of certain age.
 357 AGES is the list of ages that are to be shown."
 358   (mapc (lambda (feed)
 359           (let ((feed-name-symbol (intern (car feed))))
 360             (mapc (lambda (item)
 361                     (when (memq (newsticker--age item) ages)
 362                       (newsticker--treeview-list-add-item
 363                        item feed-name-symbol t)))
 364                   (newsticker--treeview-list-sort-items
 365                    (cdr (newsticker--cache-get-feed feed-name-symbol))))))
 366         (append newsticker-url-list-defaults newsticker-url-list))
 367   (newsticker--treeview-list-update nil))
 368
 369 (defun newsticker--treeview-list-new-items (widget changed-widget
 370                                                    &optional event)
 371   "Fill newsticker treeview list window with new items.
 372 This is a callback function for the treeview nodes.
 373 Argument WIDGET is the calling treeview widget.
 374 Argument CHANGED-WIDGET is the widget that actually has changed.
 375 Optional argument EVENT is the mouse event that triggered this action."
 376   (newsticker--treeview-list-items-with-age-callback widget changed-widget
 377                                                      'new)
 378   (newsticker--treeview-item-show-text
 379    "New items"
 380    "This is a virtual feed containing all new items"))
 381
 382 (defun newsticker--treeview-list-immortal-items (widget changed-widget
 383                                                         &optional event)
 384   "Fill newsticker treeview list window with immortal items.
 385 This is a callback function for the treeview nodes.
 386 Argument WIDGET is the calling treeview widget.
 387 Argument CHANGED-WIDGET is the widget that actually has changed.
 388 Optional argument EVENT is the mouse event that triggered this action."
 389   (newsticker--treeview-list-items-with-age-callback widget changed-widget
 390                                                      'immortal)
 391   (newsticker--treeview-item-show-text
 392    "Immortal items"
 393    "This is a virtual feed containing all immortal items."))
 394
 395 (defun newsticker--treeview-list-obsolete-items (widget changed-widget
 396                                                         &optional event)
 397   "Fill newsticker treeview list window with obsolete items.
 398 This is a callback function for the treeview nodes.
 399 Argument WIDGET is the calling treeview widget.
 400 Argument CHANGED-WIDGET is the widget that actually has changed.
 401 Optional argument EVENT is the mouse event that triggered this action."
 402   (newsticker--treeview-list-items-with-age-callback widget changed-widget
 403                                                      'obsolete)
 404   (newsticker--treeview-item-show-text
 405    "Obsolete items"
 406    "This is a virtual feed containing all obsolete items."))
 407
 408 (defun newsticker--treeview-list-all-items (widget changed-widget
 409                                                    &optional event)
 410   "Fill newsticker treeview list window with all items.
 411 This is a callback function for the treeview nodes.
 412 Argument WIDGET is the calling treeview widget.
 413 Argument CHANGED-WIDGET is the widget that actually has changed.
 414 Optional argument EVENT is the mouse event that triggered this action."
 415   (newsticker--treeview-list-items-with-age-callback widget changed-widget
 416                                                      event 'new 'old
 417                                                      'obsolete 'immortal)
 418   (newsticker--treeview-item-show-text
 419    "All items"
 420    "This is a virtual feed containing all items."))
 421
 422 (defun newsticker--treeview-list-items-v (vfeed-name)
 423   "List items for virtual feed VFEED-NAME."
 424   (when vfeed-name
 425     (cond ((string-match "\\*new\\*" vfeed-name)
 426            (newsticker--treeview-list-items-with-age 'new))
 427           ((string-match "\\*immortal\\*" vfeed-name)
 428            (newsticker--treeview-list-items-with-age 'immortal))
 429           ((string-match "\\*old\\*" vfeed-name)
 430            (newsticker--treeview-list-items-with-age 'old nil)))
 431     (newsticker--treeview-list-update nil)
 432     ))
 433
 434 (defun newsticker--treeview-list-items (feed-name)
 435   "List items for feed FEED-NAME."
 436   (when feed-name
 437     (if (newsticker--treeview-virtual-feed-p feed-name)
 438         (newsticker--treeview-list-items-v feed-name)
 439       (mapc (lambda (item)
 440               (if (eq (newsticker--age item) 'feed)
 441                   (newsticker--treeview-item-show item (intern feed-name))
 442                 (newsticker--treeview-list-add-item item
 443                                                     (intern feed-name))))
 444             (newsticker--treeview-list-sort-items
 445              (cdr (newsticker--cache-get-feed (intern feed-name)))))
 446       (newsticker--treeview-list-update nil))))
 447
 448 (defun newsticker--treeview-list-feed-items (widget changed-widget
 449                                                     &optional event)
 450   "Callback function for listing feed items.
 451 Argument WIDGET is the calling treeview widget.
 452 Argument CHANGED-WIDGET is the widget that actually has changed.
 453 Optional argument EVENT is the mouse event that triggered this action."
 454   (newsticker--treeview-list-clear)
 455   (widget-put widget :nt-selected t)
 456   (let ((feed-name (widget-get widget :nt-feed))
 457         (vfeed-name (widget-get widget :nt-vfeed)))
 458     (if feed-name
 459         (newsticker--treeview-list-items feed-name)
 460       (newsticker--treeview-list-items-v vfeed-name))))
 461
 462 (defun newsticker--treeview-list-compare-item-by-age (item1 item2)
 463   "Compare two news items ITEM1 and ITEM2 wrt age."
 464   (catch 'result
 465     (let ((age1 (newsticker--age item1))
 466           (age2 (newsticker--age item2)))
 467       (cond ((eq age1 'new)
 468              t)
 469             ((eq age1 'immortal)
 470              (cond ((eq age2 'new)
 471                     t)
 472                    ((eq age2 'immortal)
 473                     t)
 474                    (t
 475                     nil)))
 476             ((eq age1 'old)
 477              (cond ((eq age2 'new)
 478                     nil)
 479                    ((eq age2 'immortal)
 480                     nil)
 481                    ((eq age2 'old)
 482                     nil)
 483                    (t
 484                     t)))
 485             (t
 486              nil)))))
 487
 488 (defun newsticker--treeview-list-compare-item-by-age-reverse (item1 item2)
 489   "Compare two news items ITEM1 and ITEM2 wrt age in reverse order."
 490   (newsticker--treeview-list-compare-item-by-age item2 item1))
 491
 492 (defun newsticker--treeview-list-compare-item-by-time (item1 item2)
 493   "Compare two news items ITEM1 and ITEM2 wrt time values."
 494   (newsticker--cache-item-compare-by-time item1 item2))
 495
 496 (defun newsticker--treeview-list-compare-item-by-time-reverse (item1 item2)
 497   "Compare two news items ITEM1 and ITEM2 wrt time values in reverse order."
 498   (newsticker--cache-item-compare-by-time item2 item1))
 499
 500 (defun newsticker--treeview-list-compare-item-by-title (item1 item2)
 501   "Compare two news items ITEM1 and ITEM2 wrt title."
 502   (newsticker--cache-item-compare-by-title item1 item2))
 503
 504 (defun newsticker--treeview-list-compare-item-by-title-reverse (item1 item2)
 505   "Compare two news items ITEM1 and ITEM2 wrt title in reverse order."
 506   (newsticker--cache-item-compare-by-title item2 item1))
 507
 508 (defun newsticker--treeview-list-sort-items (items)
 509   "Return sorted copy of list ITEMS.
 510 The sort function is chosen according to the value of
 511 `newsticker--treeview-list-sort-order'."
 512   (let ((sort-fun
 513          (cond ((eq newsticker--treeview-list-sort-order 'sort-by-age)
 514                 'newsticker--treeview-list-compare-item-by-age)
 515                ((eq newsticker--treeview-list-sort-order
 516                     'sort-by-age-reverse)
 517                 'newsticker--treeview-list-compare-item-by-age-reverse)
 518                ((eq newsticker--treeview-list-sort-order 'sort-by-time)
 519                 'newsticker--treeview-list-compare-item-by-time)
 520                ((eq newsticker--treeview-list-sort-order
 521                     'sort-by-time-reverse)
 522                 'newsticker--treeview-list-compare-item-by-time-reverse)
 523                ((eq newsticker--treeview-list-sort-order 'sort-by-title)
 524                 'newsticker--treeview-list-compare-item-by-title)
 525                ((eq newsticker--treeview-list-sort-order
 526                     'sort-by-title-reverse)
 527                 'newsticker--treeview-list-compare-item-by-title-reverse)
 528                (t
 529                 'newsticker--treeview-list-compare-item-by-title))))
 530     (sort (copy-sequence items) sort-fun)))
 531
 532 (defun newsticker--treeview-list-update-faces ()
 533   "Update faces in the treeview list buffer."
 534   (let (pos-sel)
 535     (save-excursion
 536       (set-buffer (newsticker--treeview-list-buffer))
 537       (let ((inhibit-read-only t))
 538         (goto-char (point-min))
 539         (while (not (eobp))
 540           (let* ((pos (save-excursion (end-of-line) (point)))
 541                  (item (get-text-property (point) :nt-item))
 542                  (age (newsticker--age item))
 543                  (selected (get-text-property (point) :nt-selected))
 544                  (face (cond ((eq age 'new)
 545                               'newsticker-treeview-new-face)
 546                              ((eq age 'old)
 547                               'newsticker-treeview-old-face)
 548                              ((eq age 'immortal)
 549                               'newsticker-treeview-immortal-face)
 550                              ((eq age 'obsolete)
 551                               'newsticker-treeview-obsolete-face)
 552                              (t
 553                               'bold))))
 554             (put-text-property (point) pos 'face face)
 555             (if selected
 556                 (move-overlay newsticker--selection-overlay (point)
 557                               (1+ pos) ;include newline
 558                               (current-buffer)))
 559             (if selected (setq pos-sel (point)))
 560             (forward-line 1)
 561             (beginning-of-line))))) ;; FIXME!?
 562     (when pos-sel
 563       (set-window-point (newsticker--treeview-list-window) pos-sel))))
 564
 565 (defun newsticker--treeview-list-clear-highlight ()
 566   "Clear the highlight in the treeview list buffer."
 567   (save-excursion
 568     (set-buffer (newsticker--treeview-list-buffer))
 569     (let ((inhibit-read-only t))
 570       (put-text-property (point-min) (point-max) :nt-selected nil))
 571     (newsticker--treeview-list-update-faces)))
 572
 573 (defun newsticker--treeview-list-update-highlight ()
 574   "Update the highlight in the treeview list buffer."
 575   (newsticker--treeview-list-clear-highlight)
 576     (let (pos num-lines)
 577       (save-excursion
 578         (set-buffer (newsticker--treeview-list-buffer))
 579         (let ((inhibit-read-only t))
 580           (put-text-property (save-excursion (beginning-of-line) (point))
 581                              (save-excursion (end-of-line) (point))
 582                              :nt-selected t))
 583         (newsticker--treeview-list-update-faces))))
 584
 585 (defun newsticker--treeview-list-highlight-start ()
 586   "Return position of selection in treeview list buffer."
 587   (save-excursion
 588     (set-buffer (newsticker--treeview-list-buffer))
 589     (goto-char (point-min))
 590     (next-single-property-change (point) :nt-selected)))
 591
 592 (defun newsticker--treeview-list-update (clear-buffer)
 593   "Update the faces and highlight in the treeview list buffer.
 594 If CLEAR-BUFFER is non-nil the list buffer is completely erased."
 595   (save-excursion
 596     (set-window-buffer (newsticker--treeview-list-window)
 597                        (newsticker--treeview-list-buffer))
 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 (defvar newsticker-treeview-list-sort-button-map
 607   (let ((map (make-sparse-keymap)))
 608     (define-key map [header-line mouse-1]
 609       'newsticker--treeview-list-sort-by-column)
 610     (define-key map [header-line mouse-2]
 611       'newsticker--treeview-list-sort-by-column)
 612     map)
 613   "Local keymap for newsticker treeview list window sort buttons.")
 614
 615 (defun newsticker--treeview-list-sort-by-column (&optional event)
 616   "Sort the newsticker list window buffer by the column clicked on.
 617 Optional argument EVENT is the mouse event that triggered this action."
 618   (interactive (list last-input-event))
 619   (if e (mouse-select-window e))
 620   (let* ((pos (event-start e))
 621          (obj (posn-object pos))
 622          (sort-order (if obj
 623                       (get-text-property (cdr obj) 'sort-order (car obj))
 624                     (get-text-property (posn-point pos) 'sort-order))))
 625     (setq newsticker--treeview-list-sort-order
 626           (cond ((eq sort-order 'sort-by-age)
 627                  (if (eq newsticker--treeview-list-sort-order 'sort-by-age)
 628                      'sort-by-age-reverse
 629                    'sort-by-age))
 630                 ((eq sort-order 'sort-by-time)
 631                  (if (eq newsticker--treeview-list-sort-order 'sort-by-time)
 632                      'sort-by-time-reverse
 633                    'sort-by-time))
 634                 ((eq sort-order 'sort-by-title)
 635                  (if (eq newsticker--treeview-list-sort-order 'sort-by-title)
 636                      'sort-by-title-reverse
 637                    'sort-by-title))))
 638     (newsticker-treeview-update)))
 639
 640 (defun newsticker-treeview-list-make-sort-button (name sort-order)
 641   "Create propertized string for headerline button.
 642 NAME is the button text, SORT-ORDER is the associated sort order
 643 for the button."
 644   (let ((face (if (string-match (symbol-name sort-order)
 645                                 (symbol-name
 646                                  newsticker--treeview-list-sort-order))
 647                   'bold
 648                 'header-line)))
 649     (propertize name
 650                 'sort-order sort-order
 651                 'help-echo (concat "Sort by " name)
 652                 'mouse-face 'highlight
 653                 'face face
 654                 'keymap newsticker-treeview-list-sort-button-map)))
 655
 656 ;; ======================================================================
 657 ;;; item window
 658 ;; ======================================================================
 659 (defun newsticker--treeview-item-show-text (title description)
 660   "Show text in treeview item buffer consisting of TITLE and DESCRIPTION."
 661   (save-excursion
 662     (set-buffer (newsticker--treeview-item-buffer))
 663     (when (fboundp 'w3m-process-stop)
 664       (w3m-process-stop (current-buffer)))
 665     (let ((inhibit-read-only t))
 666       (erase-buffer)
 667       (kill-all-local-variables)
 668       (remove-overlays)
 669       (insert title)
 670       (put-text-property (point-min) (point) 'face 'newsticker-feed-face)
 671       (insert "\n\n" description)
 672       (when newsticker-justification
 673         (fill-region (point-min) (point-max) newsticker-justification))
 674       (newsticker-treeview-mode)
 675       (goto-char (point-min)))))
 676
 677 (defun newsticker--treeview-item-show (item feed)
 678   "Show news ITEM coming from FEED in treeview item buffer."
 679   (save-excursion
 680     (set-buffer (newsticker--treeview-item-buffer))
 681     (when (fboundp 'w3m-process-stop)
 682       (w3m-process-stop (current-buffer)))
 683     (let ((inhibit-read-only t)
 684           (is-rendered-HTML nil)
 685           pos
 686           (marker1 (make-marker))
 687           (marker2 (make-marker)))
 688       (erase-buffer)
 689       (kill-all-local-variables)
 690       (remove-overlays)
 691
 692       (when (and item feed)
 693         (let ((wwidth (1- (window-width (newsticker--treeview-item-window)))))
 694           (if newsticker-use-full-width
 695               (set (make-local-variable 'fill-column) wwidth))
 696           (set (make-local-variable 'fill-column) (min fill-column
 697                                                        wwidth)))
 698         (let ((desc (newsticker--desc item)))
 699           (insert "\n" (or desc "[No Description]")))
 700         (set-marker marker1 (1+ (point-min)))
 701         (set-marker marker2 (point-max))
 702         (setq is-rendered-HTML (newsticker--treeview-render-text marker1
 703                                                                  marker2))
 704         (when (and newsticker-justification
 705                    (not is-rendered-HTML))
 706           (fill-region marker1 marker2 newsticker-justification))
 707
 708         (newsticker-treeview-mode)
 709         (goto-char (point-min))
 710         ;; insert logo at top
 711         (let* ((newsticker-enable-logo-manipulations nil)
 712                (img (newsticker--image-read feed nil)))
 713           (if (and (display-images-p) img)
 714               (newsticker--insert-image img (car item))
 715             (insert (newsticker--real-feed-name feed))))
 716         (add-text-properties (point-min) (point)
 717                              (list 'face 'newsticker-feed-face
 718                                    'mouse-face 'highlight
 719                                    'help-echo "Visit in web browser."
 720                                    :nt-link (newsticker--link item)
 721                                    'keymap newsticker--treeview-url-keymap))
 722         (setq pos (point))
 723
 724         (insert "\n\n")
 725         ;; insert title
 726         (setq pos (point))
 727         (insert (newsticker--title item) "\n")
 728         (set-marker marker1 pos)
 729         (set-marker marker2 (point))
 730         (newsticker--treeview-render-text marker1 marker2)
 731         (put-text-property pos (point) 'face 'newsticker-treeview-new-face)
 732         (goto-char marker2)
 733         (delete-char -1)
 734         (insert "\n")
 735         (put-text-property marker2 (point) 'face 'newsticker-treeview-face)
 736         (set-marker marker2 (point))
 737         (when newsticker-justification
 738           (fill-region marker1 marker2 newsticker-justification))
 739         (goto-char marker2)
 740         (add-text-properties marker1 (1- (point))
 741                              (list 'mouse-face 'highlight
 742                                    'help-echo "Visit in web browser."
 743                                    :nt-link (newsticker--link item)
 744                                    'keymap newsticker--treeview-url-keymap))
 745         (insert (format-time-string newsticker-date-format
 746                                     (newsticker--time item)))
 747         (insert "\n")
 748         (setq pos (point))
 749         (insert "\n")
 750         ;; insert enclosures and rest at bottom
 751         (goto-char (point-max))
 752         (insert "\n\n")
 753         (setq pos (point))
 754         (newsticker--insert-enclosure item newsticker--treeview-url-keymap)
 755         (put-text-property pos (point) 'face 'newsticker-enclosure-face)
 756         (setq pos (point))
 757         (insert "\n")
 758         (newsticker--print-extra-elements item newsticker--treeview-url-keymap)
 759         (put-text-property pos (point) 'face 'newsticker-extra-face)
 760         (goto-char (point-min)))))
 761   (if (and newsticker-treeview-automatically-mark-displayed-items-as-old
 762            item
 763            (memq (newsticker--age item) '(new obsolete)))
 764       (let ((newsticker-treeview-automatically-mark-displayed-items-as-old nil))
 765         (newsticker-treeview-mark-item-old t)
 766         (newsticker--treeview-list-update-faces)))
 767   (set-window-point (newsticker--treeview-item-window) 1))
 768
 769 (defun newsticker--treeview-item-update ()
 770   "Update the treeview item buffer and window."
 771   (save-excursion
 772     (set-window-buffer (newsticker--treeview-item-window)
 773                        (newsticker--treeview-item-buffer))
 774     (set-buffer (newsticker--treeview-item-buffer))
 775     (let ((inhibit-read-only t))
 776       (erase-buffer))
 777     (newsticker-treeview-mode)))
 778
 779 ;; ======================================================================
 780 ;;; Tree window
 781 ;; ======================================================================
 782 (defun newsticker--treeview-tree-expand (tree)
 783   "Expand TREE.
 784 Callback function for tree widget that adds nodes for feeds and subgroups."
 785   (tree-widget-set-theme "folder")
 786   (let ((group (widget-get tree :nt-group))
 787         (i 0)
 788         (nt-id ""))
 789     (mapcar (lambda (g)
 790               (setq nt-id (newsticker--treeview-get-id tree i))
 791               (setq i (1+ i))
 792               (if (listp g)
 793                   (let* ((g-name (car g)))
 794                     `(tree-widget
 795                       :tag ,(newsticker--treeview-tree-get-tag g-name nil nt-id)
 796                       :expander newsticker--treeview-tree-expand
 797                       :expander-p (lambda (&rest ignore) t)
 798                       :nt-group ,(cdr g)
 799                       :nt-feed ,g-name
 800                       :nt-id ,nt-id
 801                       :keep (:nt-feed :num-new :nt-id :open);;  :nt-group
 802                       :open nil))
 803                 (let ((tag (newsticker--treeview-tree-get-tag g nil nt-id)))
 804                 `(item :tag ,tag
 805                        :leaf-icon newsticker--tree-widget-leaf-icon
 806                        :nt-feed ,g
 807                        :action newsticker--treeview-list-feed-items
 808                        :nt-id ,nt-id
 809                        :keep (:nt-id)
 810                        :open t))))
 811             group)))
 812
 813 (defun newsticker--treeview-tree-expand-status (tree &optional changed-widget
 814                                                      event)
 815   "Expand the vfeed TREE.
 816 Optional arguments CHANGED-WIDGET and EVENT are ignored."
 817   (tree-widget-set-theme "folder")
 818   (list `(item :tag ,(newsticker--treeview-tree-get-tag nil "new")
 819                :nt-vfeed "new"
 820                :action newsticker--treeview-list-new-items
 821                :nt-id ,(newsticker--treeview-get-id tree 0)
 822                :keep (:nt-id))
 823         `(item :tag ,(newsticker--treeview-tree-get-tag nil "immortal")
 824                :nt-vfeed "immortal"
 825                :action newsticker--treeview-list-immortal-items
 826                :nt-id ,(newsticker--treeview-get-id tree 1)
 827                :keep (:nt-id))
 828         `(item :tag  ,(newsticker--treeview-tree-get-tag nil "obsolete")
 829                :nt-vfeed "obsolete"
 830                :action newsticker--treeview-list-obsolete-items
 831                :nt-id ,(newsticker--treeview-get-id tree 2)
 832                :keep (:nt-id))
 833         `(item :tag ,(newsticker--treeview-tree-get-tag nil "all")
 834                :nt-vfeed "all"
 835                :action newsticker--treeview-list-all-items
 836                :nt-id ,(newsticker--treeview-get-id tree 3)
 837                :keep (:nt-id))))
 838
 839 (defun newsticker--treeview-virtual-feed-p (feed-name)
 840   "Return non-nil if FEED-NAME is a virtual feed."
 841   (string-match "\\*.*\\*" feed-name))
 842
 843 (define-widget 'newsticker--tree-widget-leaf-icon 'tree-widget-icon
 844   "Icon for a tree-widget leaf node."
 845   :tag        "O"
 846   :glyph-name "leaf"
 847   :button-face 'default)
 848
 849 (defun newsticker--treeview-tree-update ()
 850   "Update treeview tree buffer and window."
 851   (save-excursion
 852     (set-window-buffer (newsticker--treeview-tree-window)
 853                        (newsticker--treeview-tree-buffer))
 854     (set-buffer (newsticker--treeview-tree-buffer))
 855     (kill-all-local-variables)
 856     (let ((inhibit-read-only t))
 857       (erase-buffer)
 858       (tree-widget-set-theme "folder")
 859       (setq newsticker--treeview-feed-tree
 860             (widget-create 'tree-widget
 861                            :tag (newsticker--treeview-propertize-tag
 862                                  "Feeds" 0 "feeds")
 863                            :expander 'newsticker--treeview-tree-expand
 864                            :expander-p (lambda (&rest ignore) t)
 865                            :leaf-icon 'newsticker--tree-widget-leaf-icon
 866                            :nt-group (cdr newsticker-groups)
 867                            :nt-id "feeds"
 868                            :keep '(:nt-id)
 869                            :open t))
 870       (setq newsticker--treeview-vfeed-tree
 871             (widget-create 'tree-widget
 872                            :tag (newsticker--treeview-propertize-tag
 873                                  "Virtual Feeds" 0 "vfeeds")
 874                            :expander 'newsticker--treeview-tree-expand-status
 875                            :expander-p (lambda (&rest ignore) t)
 876                            :leaf-icon 'newsticker--tree-widget-leaf-icon
 877                            :nt-id "vfeeds"
 878                            :keep '(:nt-id)
 879                            :open t))
 880       (use-local-map widget-keymap)
 881       (widget-setup))
 882     (newsticker-treeview-mode)))
 883
 884 (defun newsticker--treeview-propertize-tag (tag &optional num-new nt-id feed
 885                                                 vfeed)
 886   "Return propertized copy of string TAG.
 887 Optional argument NUM-NEW is used for choosing face, other
 888 arguments NT-ID, FEED, and VFEED are added as properties."
 889   ;;(message "newsticker--treeview-propertize-tag '%s' %s" feed nt-id)
 890   (let ((face 'newsticker-treeview-face)
 891         (map (make-sparse-keymap)))
 892     (if (and num-new (> num-new 0))
 893         (setq face 'newsticker-treeview-new-face))
 894     (define-key map [mouse-1] 'newsticker-treeview-tree-click)
 895     (define-key map "\n" 'newsticker-treeview-tree-do-click)
 896     (define-key map "\C-m" 'newsticker-treeview-tree-do-click)
 897     (propertize tag 'face face 'keymap map
 898                 :nt-id nt-id
 899                 :nt-feed feed
 900                 :nt-vfeed vfeed
 901                 'help-echo tag
 902                 'mouse-face 'highlight)))
 903
 904 (defun newsticker--treeview-tree-get-tag (feed-name vfeed-name
 905                                                     &optional nt-id)
 906   "Return a tag string for either FEED-NAME or, if it is nil, for VFEED-NAME.
 907 Optional argument NT-ID is added to the tag's properties."
 908   (let (tag (num-new 0))
 909     (cond (vfeed-name
 910            (cond ((string= vfeed-name "new")
 911                   (setq num-new (newsticker--stat-num-items-total 'new))
 912                   (setq tag (format "New items (%d)" num-new)))
 913                  ((string= vfeed-name "immortal")
 914                   (setq num-new (newsticker--stat-num-items-total 'immortal))
 915                   (setq tag (format "Immortal items (%d)" num-new)))
 916                  ((string= vfeed-name "obsolete")
 917                   (setq num-new (newsticker--stat-num-items-total 'obsolete))
 918                   (setq tag (format "Obsolete items (%d)" num-new)))
 919                  ((string= vfeed-name "all")
 920                   (setq num-new (newsticker--stat-num-items-total))
 921                   (setq tag (format "All items (%d)" num-new)))))
 922           (feed-name
 923            (setq num-new (newsticker--stat-num-items-for-group
 924                           (intern feed-name) 'new 'immortal))
 925            (setq tag
 926                  (format "%s (%d)"
 927                          (newsticker--real-feed-name (intern feed-name))
 928                          num-new))))
 929     (if tag
 930         (newsticker--treeview-propertize-tag tag num-new
 931                                              nt-id
 932                                              feed-name vfeed-name))))
 933
 934 (defun newsticker--stat-num-items-for-group (feed-name-symbol &rest ages)
 935   "Count number of items in feed FEED-NAME-SYMBOL that have an age matching AGES."
 936   ;;(message "newsticker--stat-num-items-for-group %s %s" feed-name-symbol ages)
 937   (let ((result (apply 'newsticker--stat-num-items feed-name-symbol ages)))
 938     (mapc (lambda (f-n)
 939             (setq result (+ result
 940                             (apply 'newsticker--stat-num-items (intern f-n)
 941                                    ages))))
 942           (newsticker--group-get-feeds
 943            (newsticker--group-get-group (symbol-name feed-name-symbol)) t))
 944     result))
 945
 946 (defun newsticker--treeview-count-node-items (feed &optional isvirtual)
 947   "Count number of relevant items for a treeview node.
 948 FEED gives the name of the feed or group.  If ISVIRTUAL is non-nil
 949 the feed is a virtual feed."
 950   (let* ((num-new 0))
 951     (if feed
 952         (if isvirtual
 953             (cond ((string= feed "new")
 954                    (setq num-new (newsticker--stat-num-items-total 'new)))
 955                   ((string= feed "immortal")
 956                    (setq num-new (newsticker--stat-num-items-total 'immortal)))
 957                   ((string= feed "obsolete")
 958                    (setq num-new (newsticker--stat-num-items-total 'obsolete)))
 959                   ((string= feed "all")
 960                    (setq num-new (newsticker--stat-num-items-total))))
 961           (setq num-new (newsticker--stat-num-items-for-group
 962                          (intern feed) 'new 'immortal))))
 963     num-new))
 964
 965 (defun newsticker--treeview-tree-update-tag (w &optional recursive
 966                                                &rest ignore)
 967   "Update tag for tree widget W.
 968 If RECURSIVE is non-nil recursively update parent widgets as
 969 well.  Argument IGNORE is ignored.  Note that this function, if
 970 called recursively, makes w invalid.  You should keep w's nt-id in
 971 that case."
 972   ;;(message "newsticker--treeview-tree-update-tag %s, %s" (widget-get w :tag)
 973     ;;       (widget-type w))
 974   (let* ((parent (widget-get w :parent))
 975          (feed (or (widget-get w :nt-feed) (widget-get parent :nt-feed)))
 976          (vfeed (or (widget-get w :nt-vfeed) (widget-get parent :nt-vfeed)))
 977          (nt-id (or (widget-get w :nt-id) (widget-get parent :nt-id)))
 978          (num-new (newsticker--treeview-count-node-items (or feed vfeed)
 979                                                          vfeed))
 980          (tag (newsticker--treeview-tree-get-tag feed vfeed nt-id))
 981          (n (widget-get w :node)))
 982     (if parent
 983         (if recursive
 984             (newsticker--treeview-tree-update-tag parent)))
 985     (when tag
 986       (when n
 987         (widget-put n :tag tag))
 988       (widget-put w :num-new num-new)
 989       (widget-put w :tag tag)
 990       (when (marker-position (widget-get w :from))
 991         (let ((p (point))
 992               (notify (widget-get w :notify)))
 993           ;; FIXME: This moves point!!!!
 994           (save-excursion
 995             (set-buffer (newsticker--treeview-tree-buffer))
 996             (widget-value-set w (widget-value w)))
 997           (goto-char p))))))
 998
 999 (defun newsticker--treeview-tree-do-update-tags (widget)
1000   "Actually recursively update tags for WIDGET."
1001   (save-excursion
1002     (let ((children (widget-get widget :children)))
1003       (dolist (w children)
1004         (newsticker--treeview-tree-do-update-tags w))
1005       (newsticker--treeview-tree-update-tag widget))))
1006
1007 (defun newsticker--treeview-tree-update-tags (&rest ignore)
1008   "Update all tags of all trees.
1009 Arguments IGNORE are ignored."
1010   (save-current-buffer
1011     (set-buffer (newsticker--treeview-tree-buffer))
1012     (let ((inhibit-read-only t))
1013       (newsticker--treeview-tree-do-update-tags
1014        newsticker--treeview-feed-tree)
1015       (newsticker--treeview-tree-do-update-tags
1016        newsticker--treeview-vfeed-tree))
1017       (tree-widget-set-theme "folder")))
1018
1019 (defun newsticker--treeview-tree-update-highlight ()
1020   "Update highlight in tree buffer."
1021   (let ((pos (widget-get (newsticker--treeview-get-current-node) :from)))
1022     (unless (or (integerp pos) (and (markerp pos) (marker-position pos)))
1023       (setq pos (widget-get (widget-get
1024                              (newsticker--treeview-get-current-node)
1025                                         :parent) :from)))
1026     (when (or (integerp pos) (and (markerp pos) (marker-position pos)))
1027       (save-excursion
1028         (set-buffer (newsticker--treeview-tree-buffer))
1029         (goto-char pos)
1030         (move-overlay newsticker--tree-selection-overlay
1031                       (save-excursion (beginning-of-line) (point))
1032                       (save-excursion (end-of-line) (1+ (point)))
1033                       (current-buffer)))
1034       (set-window-point (newsticker--treeview-tree-window) pos))))
1035
1036 ;; ======================================================================
1037 ;;; Toolbar
1038 ;; ======================================================================
1039 ;;(makunbound 'newsticker-treeview-tool-bar-map)
1040 (defvar newsticker-treeview-tool-bar-map
1041   (if (featurep 'xemacs)
1042       nil
1043     (if (boundp 'tool-bar-map)
1044         (let ((tool-bar-map (make-sparse-keymap)))
1045           (define-key tool-bar-map [newsticker-sep-1]
1046             (list 'menu-item "--double-line"))
1047           (define-key tool-bar-map [newsticker-browse-url]
1048             (list 'menu-item "newsticker-browse-url"
1049                   'newsticker-browse-url
1050                   :visible t
1051                   :help "Browse URL for item at point"
1052                   :image newsticker--browse-image))
1053           (define-key tool-bar-map [newsticker-buffer-force-update]
1054             (list 'menu-item "newsticker-treeview-update"
1055                   'newsticker-treeview-update
1056                   :visible t
1057                   :help "Update newsticker buffer"
1058                   :image newsticker--update-image
1059                   :enable t))
1060           (define-key tool-bar-map [newsticker-get-all-news]
1061             (list 'menu-item "newsticker-get-all-news" 'newsticker-get-all-news
1062                   :visible t
1063                   :help "Get news for all feeds"
1064                   :image newsticker--get-all-image))
1065           (define-key tool-bar-map [newsticker-mark-item-at-point-as-read]
1066             (list 'menu-item "newsticker-treeview-mark-item-old"
1067                   'newsticker-treeview-mark-item-old
1068                   :visible t
1069                   :image newsticker--mark-read-image
1070                   :help "Mark current item as read"
1071                   ;;:enable '(newsticker-item-not-old-p) FIXME
1072                   ))
1073           (define-key tool-bar-map [newsticker-mark-item-at-point-as-immortal]
1074             (list 'menu-item "newsticker-treeview-toggle-item-immortal"
1075                   'newsticker-treeview-toggle-item-immortal
1076                   :visible t
1077                   :image newsticker--mark-immortal-image
1078                   :help "Toggle current item as immortal"
1079                   :enable t
1080                   ;;'(newsticker-item-not-immortal-p) FIXME
1081                   ))
1082           (define-key tool-bar-map [newsticker-next-feed]
1083             (list 'menu-item "newsticker-treeview-next-feed"
1084                   'newsticker-treeview-next-feed
1085                   :visible t
1086                   :help "Go to next feed"
1087                   :image newsticker--next-feed-image
1088                   :enable t
1089                   ;;'(newsticker-next-feed-available-p) FIXME
1090                   ))
1091           (define-key tool-bar-map [newsticker-treeview-next-item]
1092             (list 'menu-item "newsticker-treeview-next-item"
1093                   'newsticker-treeview-next-item
1094                   :visible t
1095                   :help "Go to next item"
1096                   :image newsticker--next-item-image
1097                   :enable t
1098                   ;;'(newsticker-next-item-available-p) FIXME
1099                   ))
1100           (define-key tool-bar-map [newsticker-treeview-prev-item]
1101             (list 'menu-item "newsticker-treeview-prev-item"
1102                   'newsticker-treeview-prev-item
1103                   :visible t
1104                   :help "Go to previous item"
1105                   :image newsticker--previous-item-image
1106                   :enable t
1107                   ;;'(newsticker-previous-item-available-p) FIXME
1108                   ))
1109           (define-key tool-bar-map [newsticker-treeview-prev-feed]
1110             (list 'menu-item "newsticker-treeview-prev-feed"
1111                   'newsticker-treeview-prev-feed
1112                   :visible t
1113                   :help "Go to previous feed"
1114                   :image newsticker--previous-feed-image
1115                   :enable t
1116                   ;;'(newsticker-previous-feed-available-p) FIXME
1117                   ))
1118           ;; standard icons / actions
1119           (tool-bar-add-item "close"
1120                              'newsticker-treeview-quit
1121                              'newsticker-treeview-quit
1122                              :help "Close newsticker")
1123           (tool-bar-add-item "preferences"
1124                              'newsticker-customize
1125                              'newsticker-customize
1126                              :help "Customize newsticker")
1127           tool-bar-map))))
1128
1129 ;; ======================================================================
1130 ;;; actions
1131 ;; ======================================================================
1132
1133 (defun newsticker-treeview-mouse-browse-url (event)
1134   "Call `browse-url' for the link of the item at which the EVENT occurred."
1135   (interactive "e")
1136   (save-excursion
1137     (switch-to-buffer (window-buffer (posn-window (event-end event))))
1138     (let ((url (get-text-property (posn-point (event-end event))
1139                                   :nt-link)))
1140       (when url
1141         (browse-url url)
1142         (if newsticker-automatically-mark-visited-items-as-old
1143             (newsticker-treeview-mark-item-old))))))
1144
1145 (defun newsticker-treeview-browse-url ()
1146   "Call `browse-url' for the link of the item at point."
1147   (interactive)
1148   (save-excursion
1149     (set-buffer (newsticker--treeview-list-buffer))
1150     (let ((url (get-text-property (point) :nt-link)))
1151       (when url
1152         (browse-url url)
1153         (if newsticker-automatically-mark-visited-items-as-old
1154             (newsticker-treeview-mark-item-old))))))
1155
1156 (defun newsticker--treeview-buffer-init ()
1157   "Initialize all treeview buffers."
1158   (setq newsticker--treeview-buffers nil)
1159   (add-to-list 'newsticker--treeview-buffers
1160                (get-buffer-create "*Newsticker Tree*") t)
1161   (add-to-list 'newsticker--treeview-buffers
1162                (get-buffer-create "*Newsticker List*") t)
1163   (add-to-list 'newsticker--treeview-buffers
1164                (get-buffer-create "*Newsticker Item*") t)
1165
1166   (unless newsticker--selection-overlay
1167     (save-excursion
1168       (set-buffer (newsticker--treeview-list-buffer))
1169       (setq newsticker--selection-overlay (make-overlay (point-min)
1170                                                         (point-max)))
1171       (overlay-put newsticker--selection-overlay 'face
1172                    'newsticker-treeview-selection-face)))
1173   (unless newsticker--tree-selection-overlay
1174     (save-excursion
1175       (set-buffer (newsticker--treeview-tree-buffer))
1176       (setq newsticker--tree-selection-overlay (make-overlay (point-min)
1177                                                              (point-max)))
1178       (overlay-put newsticker--tree-selection-overlay 'face
1179                    'newsticker-treeview-selection-face)))
1180
1181   (newsticker--treeview-tree-update)
1182   (newsticker--treeview-list-update t)
1183   (newsticker--treeview-item-update))
1184
1185 (defun newsticker-treeview-update ()
1186   "Update all treeview buffers and windows."
1187   (interactive)
1188   (newsticker--cache-update)
1189   (newsticker--group-manage-orphan-feeds)
1190   (newsticker--treeview-list-update t)
1191   (newsticker--treeview-item-update)
1192   (newsticker--treeview-tree-update-tags)
1193   (cond (newsticker--treeview-current-feed
1194          (newsticker--treeview-list-items newsticker--treeview-current-feed))
1195         (newsticker--treeview-current-vfeed
1196          (newsticker--treeview-list-items-with-age
1197           (intern newsticker--treeview-current-vfeed))))
1198   (newsticker--treeview-tree-update-highlight)
1199   (newsticker--treeview-list-update-highlight))
1200
1201 (defun newsticker-treeview-quit ()
1202   "Quit newsticker treeview."
1203   (interactive)
1204   (newsticker-treeview-save)
1205   (setq newsticker--sentinel-callback nil)
1206   (bury-buffer "*Newsticker Tree*")
1207   (bury-buffer "*Newsticker List*")
1208   (bury-buffer "*Newsticker Item*")
1209   (set-window-configuration newsticker--saved-window-config)
1210   (when newsticker--frame
1211     (if (frame-live-p newsticker--frame)
1212       (delete-frame newsticker--frame))
1213     (setq newsticker--frame nil)))
1214
1215 (defun newsticker-treeview-save ()
1216   "Save newsticker data including treeview settings."
1217   (interactive)
1218   (newsticker--cache-save)
1219   (save-excursion
1220     (let ((coding-system-for-write 'utf-8)
1221           (buf (find-file-noselect newsticker-groups-filename)))
1222       (when buf
1223         (set-buffer buf)
1224         (setq buffer-undo-list t)
1225         (erase-buffer)
1226         (insert ";; -*- coding: utf-8 -*-\n")
1227         (insert (prin1-to-string newsticker-groups))
1228         (save-buffer)))))
1229
1230 (defun newsticker--treeview-load ()
1231   "Load treeview settings."
1232   (let* ((coding-system-for-read 'utf-8)
1233          (buf (and (file-exists-p newsticker-groups-filename)
1234                    (find-file-noselect newsticker-groups-filename))))
1235     (when buf
1236       (set-buffer buf)
1237       (goto-char (point-min))
1238       (condition-case nil
1239           (setq newsticker-groups (read buf))
1240         (error
1241          (message "Error while reading newsticker groups file!")
1242          (setq newsticker-groups nil))))))
1243
1244
1245 (defun newsticker-treeview-scroll-item ()
1246   "Scroll current item."
1247   (interactive)
1248   (save-selected-window
1249     (select-window (newsticker--treeview-item-window) t)
1250     (scroll-up 1)))
1251
1252 (defun newsticker-treeview-show-item ()
1253   "Show current item."
1254   (interactive)
1255   (newsticker--treeview-list-update-highlight)
1256   (save-excursion
1257     (set-buffer (newsticker--treeview-list-buffer))
1258     (beginning-of-line)
1259     (let ((item (get-text-property (point) :nt-item))
1260           (feed (get-text-property (point) :nt-feed)))
1261       (newsticker--treeview-item-show item feed)))
1262   (newsticker--treeview-tree-update-tag
1263    (newsticker--treeview-get-current-node) t)
1264   (newsticker--treeview-tree-update-highlight))
1265
1266 (defun newsticker-treeview-next-item ()
1267   "Move to next item."
1268   (interactive)
1269   (newsticker--treeview-restore-buffers)
1270   (save-current-buffer
1271     (set-buffer (newsticker--treeview-list-buffer))
1272     (if (newsticker--treeview-list-highlight-start)
1273         (forward-line 1))
1274     (if (eobp)
1275         (forward-line -1)))
1276   (newsticker-treeview-show-item))
1277
1278 (defun newsticker-treeview-prev-item ()
1279   "Move to previous item."
1280   (interactive)
1281   (newsticker--treeview-restore-buffers)
1282   (save-current-buffer
1283     (set-buffer (newsticker--treeview-list-buffer))
1284     (forward-line -1))
1285   (newsticker-treeview-show-item))
1286
1287 (defun newsticker-treeview-next-new-or-immortal-item ()
1288   "Move to next new or immortal item."
1289   (interactive)
1290   (newsticker--treeview-restore-buffers)
1291   (newsticker--treeview-list-clear-highlight)
1292   (catch 'found
1293     (let ((index (newsticker-treeview-next-item)))
1294       (while t
1295         (save-current-buffer
1296           (set-buffer (newsticker--treeview-list-buffer))
1297           (forward-line 1)
1298           (when (eobp)
1299             (forward-line -1)
1300             (throw 'found nil)))
1301         (when (memq (newsticker--age
1302                      (newsticker--treeview-get-selected-item)) '(new immortal))
1303             (newsticker-treeview-show-item)
1304             (throw 'found t))))))
1305
1306 (defun newsticker-treeview-prev-new-or-immortal-item ()
1307   "Move to previous new or immortal item."
1308   (interactive)
1309   (newsticker--treeview-restore-buffers)
1310   (newsticker--treeview-list-clear-highlight)
1311   (catch 'found
1312     (let ((index (newsticker-treeview-next-item)))
1313       (while t
1314         (save-current-buffer
1315           (set-buffer (newsticker--treeview-list-buffer))
1316           (forward-line -1)
1317           (when (bobp)
1318             (throw 'found nil)))
1319         (when (memq (newsticker--age
1320                      (newsticker--treeview-get-selected-item)) '(new immortal))
1321             (newsticker-treeview-show-item)
1322             (throw 'found t))))))
1323
1324 (defun newsticker--treeview-get-selected-item ()
1325   "Return item that is currently selected in list buffer."
1326   (save-excursion
1327     (set-buffer (newsticker--treeview-list-buffer))
1328     (beginning-of-line)
1329     (get-text-property (point) :nt-item)))
1330
1331 (defun newsticker-treeview-mark-item-old (&optional dont-proceed)
1332   "Mark current item as old unless it is obsolete.
1333 Move to next item unless DONT-PROCEED is non-nil."
1334   (interactive)
1335   (let ((item (newsticker--treeview-get-selected-item)))
1336     (unless (eq (newsticker--age item) 'obsolete)
1337       (newsticker--treeview-mark-item item 'old)))
1338   (unless dont-proceed
1339     (newsticker-treeview-next-item)))
1340
1341 (defun newsticker-treeview-toggle-item-immortal ()
1342   "Toggle immortality of current item."
1343   (interactive)
1344   (let* ((item (newsticker--treeview-get-selected-item))
1345          (new-age (if (eq (newsticker--age item) 'immortal)
1346                       'old
1347                     'immortal)))
1348     (newsticker--treeview-mark-item item new-age)
1349     (newsticker-treeview-next-item)))
1350
1351 (defun newsticker--treeview-mark-item (item new-age)
1352   "Mark ITEM with NEW-AGE."
1353   (when item
1354     (setcar (nthcdr 4 item) new-age)
1355     ;; clean up ticker FIXME
1356     ))
1357
1358 (defun newsticker-treeview-mark-list-items-old ()
1359   "Mark all listed items as old."
1360   (interactive)
1361   (let ((current-feed (or newsticker--treeview-current-feed
1362                           newsticker--treeview-current-vfeed)))
1363     (save-excursion
1364       (set-buffer (newsticker--treeview-list-buffer))
1365       (goto-char (point-min))
1366       (while (not (eobp))
1367         (let ((item (get-text-property (point) :nt-item)))
1368           (unless (memq (newsticker--age item) '(immortal obsolete))
1369             (newsticker--treeview-mark-item item 'old)))
1370         (forward-line 1)))
1371     (newsticker--treeview-tree-update-tags)
1372     (if current-feed
1373         (newsticker-treeview-jump current-feed))))
1374
1375 (defun newsticker-treeview-save-item ()
1376   "Save current item."
1377   (interactive)
1378   (newsticker-save-item (or newsticker--treeview-current-feed
1379                             newsticker--treeview-current-vfeed)
1380                         (newsticker--treeview-get-selected-item)))
1381
1382 (defun newsticker--treeview-set-current-node (node)
1383   "Make NODE the current node."
1384   (save-excursion
1385     (set-buffer (newsticker--treeview-tree-buffer))
1386     (setq newsticker--treeview-current-node-id
1387           (widget-get node :nt-id))
1388     (setq newsticker--treeview-current-feed (widget-get node :nt-feed))
1389     (setq newsticker--treeview-current-vfeed (widget-get node :nt-vfeed))
1390     ;;(message "newsticker--treeview-set-current-node %s/%s" (widget-get node :tag)
1391     ;;       (widget-get node :nt-id))
1392     ;;       node)
1393     (newsticker--treeview-tree-update-highlight)))
1394
1395 (defun newsticker--treeview-get-first-child (node)
1396   "Get first child of NODE."
1397   (let ((children (widget-get node :children)))
1398     (if children
1399         (car children)
1400       nil)))
1401
1402 (defun newsticker--treeview-get-second-child (node)
1403   "Get scond child of NODE."
1404   (let ((children (widget-get node :children)))
1405     (if children
1406         (car (cdr children))
1407       nil)))
1408
1409 (defun newsticker--treeview-get-last-child (node)
1410   "Get last child of NODE."
1411   ;;(message "newsticker--treeview-get-last-child %s" (widget-get node :tag))
1412   (let ((children (widget-get node :children)))
1413     (if children
1414         (car (reverse children))
1415       nil)))
1416
1417 (defun newsticker--treeview-get-feed-vfeed (node)
1418   "Get (virtual) feed of NODE."
1419   (or (widget-get node :nt-feed) (widget-get node :nt-vfeed)))
1420
1421 (defun newsticker--treeview-get-next-sibling (node)
1422   "Get next sibling of NODE."
1423   (let ((parent (widget-get node :parent)))
1424     (catch 'found
1425       (let ((children (widget-get parent :children)))
1426         (while children
1427           (if (newsticker--treeview-nodes-eq (car children) node)
1428               (throw 'found (car (cdr children))))
1429           (setq children (cdr children)))))))
1430
1431 (defun newsticker--treeview-get-prev-sibling (node)
1432   "Get previous sibling of NODE."
1433   (let ((parent (widget-get node :parent)))
1434     (catch 'found
1435       (let ((children (widget-get parent :children))
1436             (prev nil))
1437         (while children
1438           (if (and (newsticker--treeview-nodes-eq (car children) node)
1439                    (widget-get prev :nt-id))
1440               (throw 'found prev))
1441           (setq prev (car children))
1442           (setq children (cdr children)))))))
1443
1444 (defun newsticker--treeview-get-next-uncle (node)
1445   "Get next uncle of NODE, i.e. parent's next sibling."
1446   (let* ((parent (widget-get node :parent))
1447          (grand-parent (widget-get parent :parent)))
1448     (catch 'found
1449       (let ((uncles (widget-get grand-parent :children)))
1450         (while uncles
1451           (if (newsticker--treeview-nodes-eq (car uncles) parent)
1452               (throw 'found (car (cdr uncles))))
1453           (setq uncles (cdr uncles)))))))
1454
1455 (defun newsticker--treeview-get-prev-uncle (node)
1456   "Get previous uncle of NODE, i.e. parent's previous sibling."
1457   (let* ((parent (widget-get node :parent))
1458          (grand-parent (widget-get parent :parent)))
1459     (catch 'found
1460       (let ((uncles (widget-get grand-parent :children))
1461             (prev nil))
1462         (while uncles
1463           (if (newsticker--treeview-nodes-eq (car uncles) parent)
1464               (throw 'found prev))
1465           (setq prev (car uncles))
1466           (setq uncles (cdr uncles)))))))
1467
1468 (defun newsticker--treeview-get-other-tree ()
1469   "Get other tree."
1470   (if (and (newsticker--treeview-get-current-node)
1471            (widget-get (newsticker--treeview-get-current-node) :nt-feed))
1472       newsticker--treeview-vfeed-tree
1473     newsticker--treeview-feed-tree))
1474
1475 (defun newsticker--treeview-activate-node (node &optional backward)
1476   "Activate NODE.
1477 If NODE is a tree widget the node's first subnode is activated.
1478 If BACKWARD is non-nil the last subnode of the previous sibling
1479 is activated."
1480   (newsticker--treeview-set-current-node node)
1481   (save-current-buffer
1482     (set-buffer (newsticker--treeview-tree-buffer))
1483     (cond ((eq (widget-type node) 'tree-widget)
1484            (unless (widget-get node :open)
1485              (widget-put node :open nil)
1486              (widget-apply-action node))
1487            (newsticker--treeview-activate-node
1488             (if backward
1489                 (newsticker--treeview-get-last-child node)
1490               (newsticker--treeview-get-second-child node))))
1491           (node
1492            (widget-apply-action node)))))
1493
1494 (defun newsticker-treeview-next-feed ()
1495   "Move to next feed."
1496   (interactive)
1497   (newsticker--treeview-restore-buffers)
1498   (let ((cur (newsticker--treeview-get-current-node)))
1499     ;;(message "newsticker-treeview-next-feed from %s"
1500     ;;       (widget-get cur :tag))
1501     (if cur
1502         (let ((new (or (newsticker--treeview-get-next-sibling cur)
1503                        (newsticker--treeview-get-next-uncle cur)
1504                        (newsticker--treeview-get-other-tree))))
1505           (newsticker--treeview-activate-node new))
1506       (newsticker--treeview-activate-node
1507        (car (widget-get newsticker--treeview-feed-tree :children)))))
1508   (newsticker--treeview-tree-update-highlight))
1509
1510 (defun newsticker-treeview-prev-feed ()
1511   "Move to previous feed."
1512   (interactive)
1513   (newsticker--treeview-restore-buffers)
1514   (let ((cur (newsticker--treeview-get-current-node)))
1515     (message "newsticker-treeview-prev-feed from %s"
1516              (widget-get cur :tag))
1517     (if cur
1518         (let ((new (or (newsticker--treeview-get-prev-sibling cur)
1519                        (newsticker--treeview-get-prev-uncle cur)
1520                        (newsticker--treeview-get-other-tree))))
1521           (newsticker--treeview-activate-node new t))
1522       (newsticker--treeview-activate-node
1523        (car (widget-get newsticker--treeview-feed-tree :children)) t)))
1524   (newsticker--treeview-tree-update-highlight))
1525
1526 (defun newsticker-treeview-next-page ()
1527   "Scroll item buffer."
1528   (interactive)
1529   (save-selected-window
1530     (select-window (newsticker--treeview-item-window) t)
1531     (condition-case nil
1532         (scroll-up nil)
1533       (error
1534        (goto-char (point-min))))))
1535
1536
1537 (defun newsticker--treeview-unfold-node (feed-name)
1538   "Recursively show subtree above the node that represents FEED-NAME."
1539   (let ((node (newsticker--treeview-get-node-of-feed feed-name)))
1540     (unless node
1541       (let* ((group-name (or (car (newsticker--group-find-group-for-feed
1542                                    feed-name))
1543                              (newsticker--group-get-parent-group
1544                               feed-name))))
1545         (newsticker--treeview-unfold-node group-name))
1546       (setq node (newsticker--treeview-get-node-of-feed feed-name)))
1547     (when node
1548       (save-excursion
1549         (set-buffer (newsticker--treeview-tree-buffer))
1550         (widget-put node :nt-selected t)
1551         (widget-apply-action node)
1552         (newsticker--treeview-set-current-node node)))))
1553
1554 (defun newsticker-treeview-jump (feed-name)
1555   "Jump to feed FEED-NAME in newsticker treeview."
1556   (interactive
1557    (list (let ((completion-ignore-case t))
1558            (completing-read
1559             "Jump to feed: "
1560             (mapcar 'car (append newsticker-url-list
1561                                  newsticker-url-list-defaults))
1562                             nil t))))
1563   (newsticker--treeview-unfold-node feed-name))
1564
1565 ;; ======================================================================
1566 ;;; Groups
1567 ;; ======================================================================
1568 (defun newsticker--group-do-find-group-for-feed (feed-name node)
1569   "Recursively find FEED-NAME in NODE."
1570   (if (member feed-name (cdr node))
1571       (throw 'found node)
1572     (mapc (lambda (n)
1573             (if (listp n)
1574                 (newsticker--group-do-find-group-for-feed feed-name n)))
1575           (cdr node))))
1576
1577 (defun newsticker--group-find-group-for-feed (feed-name)
1578   "Find group containing FEED-NAME."
1579   (catch 'found
1580     (newsticker--group-do-find-group-for-feed feed-name
1581                                               newsticker-groups)
1582     nil))
1583
1584 (defun newsticker--group-do-get-group (name node)
1585   "Recursively find group with NAME below NODE."
1586   (if (string= name (car node))
1587       (throw 'found node)
1588     (mapc (lambda (n)
1589             (if (listp n)
1590                 (newsticker--group-do-get-group name n)))
1591           (cdr node))))
1592
1593 (defun newsticker--group-get-group (name)
1594   "Find group with NAME."
1595   (catch 'found
1596     (mapc (lambda (n)
1597             (if (listp n)
1598                 (newsticker--group-do-get-group name n)))
1599           newsticker-groups)
1600     nil))
1601
1602 (defun newsticker--group-do-get-parent-group (name node parent)
1603   "Recursively find parent group for NAME from NODE which is a child of PARENT."
1604   (if (string= name (car node))
1605       (throw 'found parent)
1606     (mapc (lambda (n)
1607             (if (listp n)
1608                 (newsticker--group-do-get-parent-group name n (car node))))
1609           (cdr node))))
1610
1611 (defun newsticker--group-get-parent-group (name)
1612   "Find parent group for group named NAME."
1613   (catch 'found
1614     (mapc (lambda (n)
1615             (if (listp n)
1616                 (newsticker--group-do-get-parent-group
1617                  name n (car newsticker-groups))))
1618           newsticker-groups)
1619     nil))
1620
1621
1622 (defun newsticker--group-get-subgroups (group &optional recursive)
1623   "Return list of subgroups for GROUP.
1624 If RECURSIVE is non-nil recursively get subgroups and return a nested list."
1625   (let ((result nil))
1626     (mapc (lambda (n)
1627             (when (listp n)
1628               (setq result (cons (car n) result))
1629               (let ((subgroups (newsticker--group-get-subgroups n recursive)))
1630                 (when subgroups
1631                   (setq result (append subgroups result))))))
1632           group)
1633     result))
1634
1635 (defun newsticker--group-all-groups ()
1636   "Return nested list of all groups."
1637   (newsticker--group-get-subgroups newsticker-groups t))
1638
1639 (defun newsticker--group-get-feeds (group &optional recursive)
1640   "Return list of all feeds in GROUP.
1641 If RECURSIVE is non-nil recursively get feeds of subgroups and
1642 return a nested list."
1643   (let ((result nil))
1644     (mapc (lambda (n)
1645             (if (not (listp n))
1646                 (setq result (cons n result))
1647               (if recursive
1648                   (let ((subfeeds (newsticker--group-get-feeds n t)))
1649                     (when subfeeds
1650                       (setq result (append subfeeds result)))))))
1651           group)
1652     result))
1653
1654 (defun newsticker-group-add-group (name parent)
1655   "Add group NAME to group PARENT."
1656   (interactive
1657    (list (read-string "Group Name: ")
1658          (let ((completion-ignore-case t))
1659            (completing-read "Parent Group: " (newsticker--group-all-groups)
1660                             nil t))))
1661   (if (newsticker--group-get-group name)
1662       (error "Group %s exists already" name))
1663   (let ((p (if (and parent (not (string= parent "")))
1664                (newsticker--group-get-group parent)
1665              newsticker-groups)))
1666     (unless p
1667       (error "Parent %s does not exist" parent))
1668     (setcdr p (cons (list name) (cdr p))))
1669   (newsticker--treeview-tree-update))
1670
1671 (defun newsticker-group-move-feed (name group-name &optional no-update)
1672   "Move feed NAME to group GROUP-NAME.
1673 Update teeview afterwards unless NO-UPDATE is non-nil."
1674   (interactive
1675    (let ((completion-ignore-case t))
1676      (list (completing-read "Feed Name: "
1677                             (mapcar 'car newsticker-url-list)
1678                             nil t newsticker--treeview-current-feed)
1679            (completing-read "Group Name: " (newsticker--group-all-groups)
1680                             nil t))))
1681   (let ((group (if (and group-name (not (string= group-name "")))
1682                    (newsticker--group-get-group group-name)
1683                  newsticker-groups)))
1684     (unless group
1685       (error "Group %s does not exist" group-name))
1686     (while (let ((old-group
1687                   (newsticker--group-find-group-for-feed name)))
1688              (when old-group
1689                (delete name old-group))
1690              old-group))
1691     (setcdr group (cons name (cdr group)))
1692     (unless no-update
1693       (newsticker--treeview-tree-update)
1694       (newsticker-treeview-update))))
1695
1696 (defun newsticker-group-delete-group (name)
1697   "Remove group NAME."
1698   (interactive
1699    (let ((completion-ignore-case t))
1700      (list (completing-read "Group Name: " (newsticker--group-all-groups)
1701                             nil t))))
1702   (let* ((g (newsticker--group-get-group name))
1703          (p (or (newsticker--group-get-parent-group name)
1704                 newsticker-groups)))
1705     (unless g
1706       (error "Group %s does not exist" name))
1707     (delete g p))
1708   (newsticker--treeview-tree-update))
1709
1710 (defun newsticker--count-groups (group)
1711   "Recursively count number of subgroups of GROUP."
1712   (let ((result 1))
1713     (mapc (lambda (g)
1714             (if (listp g)
1715                 (setq result (+ result (newsticker--count-groups g)))))
1716           (cdr group))
1717     result))
1718
1719 (defun newsticker--count-grouped-feeds (group)
1720   "Recursively count number of feeds in GROUP and its subgroups."
1721   (let ((result 0))
1722     (mapc (lambda (g)
1723             (if (listp g)
1724                 (setq result (+ result (newsticker--count-grouped-feeds g)))
1725               (setq result (1+ result))))
1726           (cdr group))
1727     result))
1728
1729 (defun newsticker--group-remove-obsolete-feeds (group)
1730   "Recursively remove obselete feeds from GROUP."
1731   (let ((result nil)
1732         (urls (append newsticker-url-list newsticker-url-list-defaults)))
1733     (mapc (lambda (g)
1734             (if (listp g)
1735                 (let ((sub-groups
1736                        (newsticker--group-remove-obsolete-feeds g)))
1737                   (if sub-groups
1738                       (setq result (cons sub-groups result))))
1739               (if (assoc g urls)
1740                   (setq result (cons g result)))))
1741           (cdr group))
1742     (if result
1743         (cons (car group) (reverse result))
1744       result)))
1745
1746 (defun newsticker--group-manage-orphan-feeds ()
1747   "Put unmanaged feeds into `newsticker-groups'.
1748 Remove obsolete feeds as well."
1749   (unless newsticker-groups
1750     (setq newsticker-groups '("Feeds")))
1751   (let ((new-feed nil)
1752         (grouped-feeds (newsticker--count-grouped-feeds newsticker-groups)))
1753     (mapc (lambda (f)
1754             (unless (newsticker--group-find-group-for-feed (car f))
1755               (setq new-feed t)
1756               (newsticker-group-move-feed (car f) nil t)))
1757           (append newsticker-url-list-defaults newsticker-url-list))
1758     (setq newsticker-groups
1759           (newsticker--group-remove-obsolete-feeds newsticker-groups))
1760     (if (or new-feed
1761             (not (= grouped-feeds
1762                     (newsticker--count-grouped-feeds newsticker-groups))))
1763         (newsticker--treeview-tree-update))))
1764
1765 ;; ======================================================================
1766 ;;; Modes
1767 ;; ======================================================================
1768 (defun newsticker--treeview-create-groups-menu (group-list
1769                                                 excluded-group)
1770   "Create menu for GROUP-LIST omitting EXCLUDED-GROUP."
1771   (let ((menu (make-sparse-keymap (if (stringp (car group-list))
1772                                       (car group-list)
1773                                     "Move to group..."))))
1774     (mapc (lambda (g)
1775             (when (listp g)
1776               (let ((title (if (stringp (car g))
1777                                (car g)
1778                              "Move to group...")))
1779                 (unless (eq g excluded-group)
1780                   (define-key menu (vector (intern title))
1781                     (list 'menu-item title
1782                           (newsticker--treeview-create-groups-menu
1783                            (cdr g) excluded-group)))))))
1784           (reverse group-list))
1785     menu))
1786
1787 (defun newsticker--treeview-create-tree-menu (feed-name)
1788   "Create tree menu for FEED-NAME."
1789   (let ((menu (make-sparse-keymap feed-name)))
1790     (define-key menu [newsticker-treeview-mark-list-items-old]
1791       (list 'menu-item "Mark all items old"
1792             'newsticker-treeview-mark-list-items-old))
1793     (define-key menu [move]
1794       (list 'menu-item "Move to group..."
1795             (newsticker--treeview-create-groups-menu
1796              newsticker-groups
1797              (newsticker--group-get-group feed-name))))
1798     menu))
1799
1800 (defvar newsticker-treeview-list-menu
1801   (let ((menu (make-sparse-keymap "Newsticker List")))
1802     (define-key menu [newsticker-treeview-mark-list-items-old]
1803       (list 'menu-item "Mark all items old"
1804             'newsticker-treeview-mark-list-items-old))
1805     menu)
1806   "Map for newsticker tree menu.")
1807
1808 (defvar newsticker-treeview-mode-map
1809   (let ((map (make-sparse-keymap 'newsticker-treeview-mode-map)))
1810     (define-key map " " 'newsticker-treeview-next-page)
1811     (define-key map "a" 'newsticker-add-url)
1812     (define-key map "F" 'newsticker-treeview-prev-feed)
1813     (define-key map "f" 'newsticker-treeview-next-feed)
1814     (define-key map "g" 'newsticker-treeview-get-news)
1815     (define-key map "G" 'newsticker-get-all-news)
1816     (define-key map "i" 'newsticker-treeview-toggle-item-immortal)
1817     (define-key map "j" 'newsticker-treeview-jump)
1818     (define-key map "n" 'newsticker-treeview-next-item)
1819     (define-key map "N" 'newsticker-treeview-next-new-or-immortal-item)
1820     (define-key map "O" 'newsticker-treeview-mark-list-items-old)
1821     (define-key map "o" 'newsticker-treeview-mark-item-old)
1822     (define-key map "p" 'newsticker-treeview-prev-item)
1823     (define-key map "P" 'newsticker-treeview-prev-new-or-immortal-item)
1824     (define-key map "q" 'newsticker-treeview-quit)
1825     (define-key map "S" 'newsticker-treeview-save-item)
1826     (define-key map "s" 'newsticker-treeview-save)
1827     (define-key map "u" 'newsticker-treeview-update)
1828     (define-key map "v" 'newsticker-treeview-browse-url)
1829     ;;(define-key map "\n" 'newsticker-treeview-scroll-item)
1830     ;;(define-key map "\C-m" 'newsticker-treeview-scroll-item)
1831     (define-key map "\M-m" 'newsticker-group-move-feed)
1832     (define-key map "\M-a" 'newsticker-group-add-group)
1833     map)
1834   "Mode map for newsticker treeview.")
1835
1836 (defun newsticker-treeview-mode ()
1837   "Major mode for Newsticker Treeview.
1838 \\{newsticker-treeview-mode-map}"
1839   (kill-all-local-variables)
1840   (use-local-map newsticker-treeview-mode-map)
1841   (setq major-mode 'newsticker-treeview-mode)
1842   (setq mode-name "Newsticker TV")
1843   (if (boundp 'tool-bar-map)
1844       (set (make-local-variable 'tool-bar-map)
1845            newsticker-treeview-tool-bar-map))
1846   (setq buffer-read-only t
1847         truncate-lines t))
1848
1849 (define-derived-mode newsticker-treeview-list-mode newsticker-treeview-mode
1850   "Item List"
1851   (let ((header (concat
1852                  (propertize " " 'display '(space :align-to 0))
1853                  (newsticker-treeview-list-make-sort-button "*" 'sort-by-age)
1854                  (propertize " " 'display '(space :align-to 2))
1855                  (if newsticker--treeview-list-show-feed
1856                      (concat "Feed"
1857                              (propertize " " 'display '(space :align-to 12)))
1858                    "")
1859                  (newsticker-treeview-list-make-sort-button "Date"
1860                                                             'sort-by-time)
1861                  (if newsticker--treeview-list-show-feed
1862                      (propertize " " 'display '(space :align-to 28))
1863                    (propertize " " 'display '(space :align-to 18)))
1864                  (newsticker-treeview-list-make-sort-button "Title"
1865                                                             'sort-by-title))))
1866     (setq header-line-format header))
1867   (define-key newsticker-treeview-list-mode-map [down-mouse-3]
1868     newsticker-treeview-list-menu))
1869
1870 (defun newsticker-treeview-tree-click (event)
1871   "Handle click EVENT on a tag in the newsticker tree."
1872   (interactive "e")
1873   (save-excursion
1874     (switch-to-buffer (window-buffer (posn-window (event-end event))))
1875     (newsticker-treeview-tree-do-click (posn-point (event-end event)))))
1876
1877 (defun newsticker-treeview-tree-do-click (&optional pos event)
1878   "Actually handle click event.
1879 POS gives the position where EVENT occurred."
1880   (interactive)
1881   (unless pos (setq pos (point)))
1882   (let ((pos (or pos (point)))
1883         (nt-id (get-text-property pos :nt-id))
1884         (item (get-text-property pos :nt-item)))
1885     (cond (item
1886            ;; click in list buffer
1887            (newsticker-treeview-show-item))
1888           (t
1889            ;; click in tree buffer
1890            (let ((w (newsticker--treeview-get-node nt-id)))
1891              (when w
1892                (newsticker--treeview-tree-update-tag w t t)
1893                (setq w (newsticker--treeview-get-node nt-id))
1894                (widget-put w :nt-selected t)
1895                (widget-apply w :action event)
1896                (newsticker--treeview-set-current-node w))))))
1897   (newsticker--treeview-tree-update-highlight))
1898
1899 (defun newsticker--treeview-restore-buffers ()
1900   "Restore treeview buffers."
1901   (catch 'error
1902     (dotimes (i 3)
1903       (let ((win (nth i newsticker--treeview-windows))
1904             (buf (nth i newsticker--treeview-buffers)))
1905         (unless (window-live-p win)
1906           (newsticker--treeview-window-init)
1907           (newsticker--treeview-buffer-init)
1908           (throw 'error t))
1909         (unless (eq (window-buffer win) buf)
1910           (set-window-buffer win buf t))))))
1911
1912 (defun newsticker--treeview-frame-init ()
1913   "Initialize treeview frame."
1914   (when newsticker-treeview-own-frame
1915     (unless (and newsticker--frame (frame-live-p newsticker--frame))
1916       (setq newsticker--frame (make-frame '((name . "Newsticker")))))
1917     (select-frame-set-input-focus newsticker--frame)
1918     (raise-frame newsticker--frame)))
1919
1920 (defun newsticker--treeview-window-init ()
1921   "Initialize treeview windows."
1922   (setq newsticker--saved-window-config (current-window-configuration))
1923   (setq newsticker--treeview-windows nil)
1924   (setq newsticker--treeview-buffers nil)
1925   (delete-other-windows)
1926   (split-window-horizontally 25)
1927   (add-to-list 'newsticker--treeview-windows (selected-window) t)
1928   (other-window 1)
1929   (split-window-vertically 10)
1930   (add-to-list 'newsticker--treeview-windows (selected-window) t)
1931   (other-window 1)
1932   (add-to-list 'newsticker--treeview-windows (selected-window) t)
1933   (other-window 1))
1934
1935 ;;;###autoload
1936 (defun newsticker-treeview ()
1937   "Start newsticker treeview."
1938   (interactive)
1939   (newsticker--treeview-load)
1940   (setq newsticker--sentinel-callback 'newsticker-treeview-update)
1941   (newsticker--treeview-frame-init)
1942   (newsticker--treeview-window-init)
1943   (newsticker--treeview-buffer-init)
1944   (newsticker--group-manage-orphan-feeds)
1945   (newsticker--treeview-set-current-node newsticker--treeview-feed-tree)
1946   (newsticker-start t) ;; will start only if not running
1947   (newsticker-treeview-update)
1948   (newsticker--treeview-item-show-text
1949    "Newsticker"
1950    "Welcome to newsticker!"))
1951
1952 (defun newsticker-treeview-get-news ()
1953   "Get news for current feed."
1954   (interactive)
1955   (when newsticker--treeview-current-feed
1956     (newsticker-get-news newsticker--treeview-current-feed)))
1957
1958 (provide 'newsticker-treeview)
1959
1960 ;; arch-tag: 5dbaff48-1f3e-4fc6-8ebd-e966fc90d2d4
1961 ;;; newst-treeview.el ends here