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

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