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