code.delx.au - gnu-emacs/blob - lisp/net/newst-treeview.el

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