;;; newst-treeview.el --- Treeview frontend for newsticker. ;; Copyright (C) 2008 Free Software Foundation, Inc. ;; Author: Ulf Jasper ;; Filename: newst-treeview.el ;; URL: http://www.nongnu.org/newsticker ;; Created: 2007 ;; Keywords: News, RSS, Atom ;; Time-stamp: "18. Dezember 2008, 11:26:54 (ulf)" ;; ====================================================================== ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . ;; ====================================================================== ;;; Commentary: ;; See newsticker.el ;; ====================================================================== ;;; History: ;; ;; ====================================================================== ;;; Code: (require 'newsticker-reader "newst-reader") (require 'widget) (require 'tree-widget) (require 'wid-edit) ;; ====================================================================== ;;; Customization ;; ====================================================================== (defgroup newsticker-treeview nil "Settings for the tree view reader." :group 'newsticker-reader) (defface newsticker-treeview-face '((((class color) (background dark)) (:family "helvetica" :foreground "misty rose" :bold nil)) (((class color) (background light)) (:family "helvetica" :foreground "black" :bold nil))) "Face for newsticker tree." :group 'newsticker-treeview) (defface newsticker-treeview-new-face '((((class color) (background dark)) (:inherit newsticker-treeview-face :bold t)) (((class color) (background light)) (:inherit newsticker-treeview-face :bold t))) "Face for newsticker tree." :group 'newsticker-treeview) (defface newsticker-treeview-old-face '((((class color) (background dark)) (:inherit newsticker-treeview-face)) (((class color) (background light)) (:inherit newsticker-treeview-face))) "Face for newsticker tree." :group 'newsticker-treeview) (defface newsticker-treeview-immortal-face '((((class color) (background dark)) (:inherit newsticker-treeview-face :foreground "orange" :italic t)) (((class color) (background light)) (:inherit newsticker-treeview-face :foreground "blue" :italic t))) "Face for newsticker tree." :group 'newsticker-treeview) (defface newsticker-treeview-obsolete-face '((((class color) (background dark)) (:inherit newsticker-treeview-face :strike-through t)) (((class color) (background light)) (:inherit newsticker-treeview-face :strike-through t))) "Face for newsticker tree." :group 'newsticker-treeview) (defface newsticker-treeview-selection-face '((((class color) (background dark)) (:background "#bbbbff")) (((class color) (background light)) (:background "#bbbbff"))) "Face for newsticker selection." :group 'newsticker-treeview) (defcustom newsticker-treeview-own-frame nil "Decides whether newsticker treeview creates and uses its own frame." :type 'boolean :group 'newsticker-treeview) (defcustom newsticker-treeview-treewindow-width 30 "Width of tree window in treeview layout. See also `newsticker-treeview-listwindow-height'." :type 'int :group 'newsticker-treeview) (defcustom newsticker-treeview-listwindow-height 10 "Height of list window in treeview layout. See also `newsticker-treeview-treewindow-width'." :type 'int :group 'newsticker-treeview) (defcustom newsticker-treeview-automatically-mark-displayed-items-as-old t "Decides whether to automatically mark displayed items as old. If t an item is marked as old as soon as it is displayed. This applies to newsticker only." :type 'boolean :group 'newsticker-treeview) (defvar newsticker-groups '("Feeds") "List of feed groups, used in the treeview frontend. First element is a string giving the group name. Remaining elements are either strings giving a feed name or lists having the same structure as `newsticker-groups'. (newsticker-groups := groupdefinition, groupdefinition := groupname groupcontent*, groupcontent := feedname | groupdefinition) Example: (\"Topmost group\" \"feed1\" (\"subgroup1\" \"feed 2\") \"feed3\")") (defcustom newsticker-groups-filename "~/.newsticker-groups" "Name of the newsticker groups settings file." :type 'string :group 'newsticker-treeview) (make-obsolete 'newsticker-groups-filename 'newsticker-dir) ;; ====================================================================== ;;; internal variables ;; ====================================================================== (defvar newsticker--treeview-windows nil) (defvar newsticker--treeview-buffers nil) (defvar newsticker--treeview-current-feed nil "Feed name of currently shown item.") (defvar newsticker--treeview-current-vfeed nil) (defvar newsticker--treeview-list-show-feed nil) (defvar newsticker--saved-window-config nil) (defvar newsticker--selection-overlay nil "Highlight the selected tree node.") (defvar newsticker--tree-selection-overlay nil "Highlight the selected list item.") (defvar newsticker--frame nil "Special frame for newsticker windows.") (defvar newsticker--treeview-list-sort-order 'sort-by-time) (defvar newsticker--treeview-current-node-id nil) (defvar newsticker--treeview-current-tree nil) (defvar newsticker--treeview-feed-tree nil) (defvar newsticker--treeview-vfeed-tree nil) ;; maps for the clickable portions (defvar newsticker--treeview-url-keymap (let ((map (make-sparse-keymap 'newsticker--treeview-url-keymap))) (define-key map [mouse-1] 'newsticker-treeview-mouse-browse-url) (define-key map [mouse-2] 'newsticker-treeview-mouse-browse-url) (define-key map "\n" 'newsticker-treeview-browse-url) (define-key map "\C-m" 'newsticker-treeview-browse-url) (define-key map [(control return)] 'newsticker-handle-url) map) "Key map for click-able headings in the newsticker treeview buffers.") ;; ====================================================================== ;;; short cuts ;; ====================================================================== (defsubst newsticker--treeview-tree-buffer () "Return the tree buffer of the newsticker treeview." (nth 0 newsticker--treeview-buffers)) (defsubst newsticker--treeview-list-buffer () "Return the list buffer of the newsticker treeview." (nth 1 newsticker--treeview-buffers)) (defsubst newsticker--treeview-item-buffer () "Return the item buffer of the newsticker treeview." (nth 2 newsticker--treeview-buffers)) (defsubst newsticker--treeview-tree-window () "Return the tree window of the newsticker treeview." (nth 0 newsticker--treeview-windows)) (defsubst newsticker--treeview-list-window () "Return the list window of the newsticker treeview." (nth 1 newsticker--treeview-windows)) (defsubst newsticker--treeview-item-window () "Return the item window of the newsticker treeview." (nth 2 newsticker--treeview-windows)) ;; ====================================================================== ;;; utility functions ;; ====================================================================== (defun newsticker--treeview-get-id (parent i) "Create an id for a newsticker treeview node. PARENT is the node's parent, I is an integer." ;;(message "newsticker--treeview-get-id %s" ;; (format "%s-%d" (widget-get parent :nt-id) i)) (format "%s-%d" (widget-get parent :nt-id) i)) (defun newsticker--treeview-ids-eq (id1 id2) "Return non-nil if ids ID1 and ID2 are equal." ;;(message "%s/%s" (or id1 -1) (or id2 -1)) (and id1 id2 (string= id1 id2))) (defun newsticker--treeview-nodes-eq (node1 node2) "Compare treeview nodes NODE1 and NODE2 for equality. Nodes are equal if the have the same newsticker-id. Note that during re-tagging and collapsing/expanding nodes change, while their id stays constant." (let ((id1 (widget-get node1 :nt-id)) (id2 (widget-get node2 :nt-id))) ;;(message "%s/%s %s/%s" (widget-get node1 :tag) (widget-get node2 :tag) ;; (or id1 -1) (or id2 -1)) (or (newsticker--treeview-ids-eq id1 id2) (string= (widget-get node1 :tag) (widget-get node2 :tag))))) (defun newsticker--treeview-do-get-node-of-feed (feed-name startnode) "Recursivly search node for feed FEED-NAME starting from STARTNODE." ;;(message "%s/%s" feed-name (widget-get startnode :nt-feed)) (if (string= feed-name (or (widget-get startnode :nt-feed) (widget-get startnode :nt-vfeed))) (throw 'found startnode) (let ((children (widget-get startnode :children))) (dolist (w children) (newsticker--treeview-do-get-node-of-feed feed-name w))))) (defun newsticker--treeview-get-node-of-feed (feed-name) "Return node for feed FEED-NAME in newsticker treeview tree." (catch 'found (newsticker--treeview-do-get-node-of-feed feed-name newsticker--treeview-feed-tree) (newsticker--treeview-do-get-node-of-feed feed-name newsticker--treeview-vfeed-tree))) (defun newsticker--treeview-do-get-node (id startnode) "Recursivly search node with ID starting from STARTNODE." (if (newsticker--treeview-ids-eq id (widget-get startnode :nt-id)) (throw 'found startnode) (let ((children (widget-get startnode :children))) (dolist (w children) (newsticker--treeview-do-get-node id w))))) (defun newsticker--treeview-get-node (id) "Return node with ID in newsticker treeview tree." (catch 'found (newsticker--treeview-do-get-node id newsticker--treeview-feed-tree) (newsticker--treeview-do-get-node id newsticker--treeview-vfeed-tree))) (defun newsticker--treeview-get-current-node () "Return current node in newsticker treeview tree." (newsticker--treeview-get-node newsticker--treeview-current-node-id)) ;; ====================================================================== (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))) (declare-function w3m-toggle-inline-images "ext:w3m" (&optional force no-cache)) (defun newsticker--treeview-render-text (start end) "Render text between markers START and END." (if newsticker-html-renderer (condition-case error-data (save-excursion (set-marker-insertion-type end t) ;; check whether it is necessary to call html renderer ;; (regexp inspired by htmlr.el) (goto-char start) (when (re-search-forward " num-new 0)) (setq face 'newsticker-treeview-new-face)) (define-key map [mouse-1] 'newsticker-treeview-tree-click) (define-key map "\n" 'newsticker-treeview-tree-do-click) (define-key map "\C-m" 'newsticker-treeview-tree-do-click) (propertize tag 'face face 'keymap map :nt-id nt-id :nt-feed feed :nt-vfeed vfeed 'help-echo tag 'mouse-face 'highlight))) (defun newsticker--treeview-tree-get-tag (feed-name vfeed-name &optional nt-id) "Return a tag string for either FEED-NAME or, if it is nil, for VFEED-NAME. Optional argument NT-ID is added to the tag's properties." (let (tag (num-new 0)) (cond (vfeed-name (cond ((string= vfeed-name "new") (setq num-new (newsticker--stat-num-items-total 'new)) (setq tag (format "New items (%d)" num-new))) ((string= vfeed-name "immortal") (setq num-new (newsticker--stat-num-items-total 'immortal)) (setq tag (format "Immortal items (%d)" num-new))) ((string= vfeed-name "obsolete") (setq num-new (newsticker--stat-num-items-total 'obsolete)) (setq tag (format "Obsolete items (%d)" num-new))) ((string= vfeed-name "all") (setq num-new (newsticker--stat-num-items-total)) (setq tag (format "All items (%d)" num-new))))) (feed-name (setq num-new (newsticker--stat-num-items-for-group (intern feed-name) 'new 'immortal)) (setq tag (format "%s (%d)" (newsticker--real-feed-name (intern feed-name)) num-new)))) (if tag (newsticker--treeview-propertize-tag tag num-new nt-id feed-name vfeed-name)))) (defun newsticker--stat-num-items-for-group (feed-name-symbol &rest ages) "Count number of items in feed FEED-NAME-SYMBOL that have an age matching AGES." ;;(message "newsticker--stat-num-items-for-group %s %s" feed-name-symbol ages) (let ((result (apply 'newsticker--stat-num-items feed-name-symbol ages))) (mapc (lambda (f-n) (setq result (+ result (apply 'newsticker--stat-num-items (intern f-n) ages)))) (newsticker--group-get-feeds (newsticker--group-get-group (symbol-name feed-name-symbol)) t)) result)) (defun newsticker--treeview-count-node-items (feed &optional isvirtual) "Count number of relevant items for a treeview node. FEED gives the name of the feed or group. If ISVIRTUAL is non-nil the feed is a virtual feed." (let* ((num-new 0)) (if feed (if isvirtual (cond ((string= feed "new") (setq num-new (newsticker--stat-num-items-total 'new))) ((string= feed "immortal") (setq num-new (newsticker--stat-num-items-total 'immortal))) ((string= feed "obsolete") (setq num-new (newsticker--stat-num-items-total 'obsolete))) ((string= feed "all") (setq num-new (newsticker--stat-num-items-total)))) (setq num-new (newsticker--stat-num-items-for-group (intern feed) 'new 'immortal)))) num-new)) (defun newsticker--treeview-tree-update-tag (w &optional recursive &rest ignore) "Update tag for tree widget W. If RECURSIVE is non-nil recursively update parent widgets as well. Argument IGNORE is ignored. Note that this function, if called recursively, makes w invalid. You should keep w's nt-id in that case." (let* ((parent (widget-get w :parent)) (feed (or (widget-get w :nt-feed) (widget-get parent :nt-feed))) (vfeed (or (widget-get w :nt-vfeed) (widget-get parent :nt-vfeed))) (nt-id (or (widget-get w :nt-id) (widget-get parent :nt-id))) (num-new (newsticker--treeview-count-node-items (or feed vfeed) vfeed)) (tag (newsticker--treeview-tree-get-tag feed vfeed nt-id)) (n (widget-get w :node))) (if parent (if recursive (newsticker--treeview-tree-update-tag parent))) (when tag (when n (widget-put n :tag tag)) (widget-put w :num-new num-new) (widget-put w :tag tag) (when (marker-position (widget-get w :from)) (let ((p (point)) (notify (widget-get w :notify))) ;; FIXME: This moves point!!!! (save-excursion (set-buffer (newsticker--treeview-tree-buffer)) (widget-value-set w (widget-value w))) (goto-char p)))))) (defun newsticker--treeview-tree-do-update-tags (widget) "Actually recursively update tags for WIDGET." (save-excursion (let ((children (widget-get widget :children))) (dolist (w children) (newsticker--treeview-tree-do-update-tags w)) (newsticker--treeview-tree-update-tag widget)))) (defun newsticker--treeview-tree-update-tags (&rest ignore) "Update all tags of all trees. Arguments IGNORE are ignored." (save-current-buffer (set-buffer (newsticker--treeview-tree-buffer)) (let ((inhibit-read-only t)) (newsticker--treeview-tree-do-update-tags newsticker--treeview-feed-tree) (newsticker--treeview-tree-do-update-tags newsticker--treeview-vfeed-tree)) (tree-widget-set-theme "folder"))) (defun newsticker--treeview-tree-update-highlight () "Update highlight in tree buffer." (let ((pos (widget-get (newsticker--treeview-get-current-node) :from))) (unless (or (integerp pos) (and (markerp pos) (marker-position pos))) (setq pos (widget-get (widget-get (newsticker--treeview-get-current-node) :parent) :from))) (when (or (integerp pos) (and (markerp pos) (marker-position pos))) (save-excursion (set-buffer (newsticker--treeview-tree-buffer)) (goto-char pos) (move-overlay newsticker--tree-selection-overlay (save-excursion (beginning-of-line) (point)) (save-excursion (end-of-line) (1+ (point))) (current-buffer))) (if (window-live-p (newsticker--treeview-tree-window)) (set-window-point (newsticker--treeview-tree-window) pos))))) ;; ====================================================================== ;;; Toolbar ;; ====================================================================== ;;(makunbound 'newsticker-treeview-tool-bar-map) (defvar newsticker-treeview-tool-bar-map (if (featurep 'xemacs) nil (if (boundp 'tool-bar-map) (let ((tool-bar-map (make-sparse-keymap))) (define-key tool-bar-map [newsticker-sep-1] (list 'menu-item "--double-line")) (define-key tool-bar-map [newsticker-browse-url] (list 'menu-item "newsticker-browse-url" 'newsticker-browse-url :visible t :help "Browse URL for item at point" :image newsticker--browse-image)) (define-key tool-bar-map [newsticker-buffer-force-update] (list 'menu-item "newsticker-treeview-update" 'newsticker-treeview-update :visible t :help "Update newsticker buffer" :image newsticker--update-image :enable t)) (define-key tool-bar-map [newsticker-get-all-news] (list 'menu-item "newsticker-get-all-news" 'newsticker-get-all-news :visible t :help "Get news for all feeds" :image newsticker--get-all-image)) (define-key tool-bar-map [newsticker-mark-item-at-point-as-read] (list 'menu-item "newsticker-treeview-mark-item-old" 'newsticker-treeview-mark-item-old :visible t :image newsticker--mark-read-image :help "Mark current item as read" ;;:enable '(newsticker-item-not-old-p) FIXME )) (define-key tool-bar-map [newsticker-mark-item-at-point-as-immortal] (list 'menu-item "newsticker-treeview-toggle-item-immortal" 'newsticker-treeview-toggle-item-immortal :visible t :image newsticker--mark-immortal-image :help "Toggle current item as immortal" :enable t ;;'(newsticker-item-not-immortal-p) FIXME )) (define-key tool-bar-map [newsticker-next-feed] (list 'menu-item "newsticker-treeview-next-feed" 'newsticker-treeview-next-feed :visible t :help "Go to next feed" :image newsticker--next-feed-image :enable t ;;'(newsticker-next-feed-available-p) FIXME )) (define-key tool-bar-map [newsticker-treeview-next-item] (list 'menu-item "newsticker-treeview-next-item" 'newsticker-treeview-next-item :visible t :help "Go to next item" :image newsticker--next-item-image :enable t ;;'(newsticker-next-item-available-p) FIXME )) (define-key tool-bar-map [newsticker-treeview-prev-item] (list 'menu-item "newsticker-treeview-prev-item" 'newsticker-treeview-prev-item :visible t :help "Go to previous item" :image newsticker--previous-item-image :enable t ;;'(newsticker-previous-item-available-p) FIXME )) (define-key tool-bar-map [newsticker-treeview-prev-feed] (list 'menu-item "newsticker-treeview-prev-feed" 'newsticker-treeview-prev-feed :visible t :help "Go to previous feed" :image newsticker--previous-feed-image :enable t ;;'(newsticker-previous-feed-available-p) FIXME )) ;; standard icons / actions (tool-bar-add-item "close" 'newsticker-treeview-quit 'newsticker-treeview-quit :help "Close newsticker") (tool-bar-add-item "preferences" 'newsticker-customize 'newsticker-customize :help "Customize newsticker") tool-bar-map)))) ;; ====================================================================== ;;; actions ;; ====================================================================== (defun newsticker-treeview-mouse-browse-url (event) "Call `browse-url' for the link of the item at which the EVENT occurred." (interactive "e") (save-excursion (switch-to-buffer (window-buffer (posn-window (event-end event)))) (let ((url (get-text-property (posn-point (event-end event)) :nt-link))) (when url (browse-url url) (if newsticker-automatically-mark-visited-items-as-old (newsticker-treeview-mark-item-old)))))) (defun newsticker-treeview-browse-url () "Call `browse-url' for the link of the item at point." (interactive) (save-excursion (set-buffer (newsticker--treeview-list-buffer)) (let ((url (get-text-property (point) :nt-link))) (when url (browse-url url) (if newsticker-automatically-mark-visited-items-as-old (newsticker-treeview-mark-item-old)))))) (defun newsticker--treeview-buffer-init () "Initialize all treeview buffers." (setq newsticker--treeview-buffers nil) (add-to-list 'newsticker--treeview-buffers (get-buffer-create "*Newsticker Tree*") t) (add-to-list 'newsticker--treeview-buffers (get-buffer-create "*Newsticker List*") t) (add-to-list 'newsticker--treeview-buffers (get-buffer-create "*Newsticker Item*") t) (unless newsticker--selection-overlay (save-excursion (set-buffer (newsticker--treeview-list-buffer)) (setq newsticker--selection-overlay (make-overlay (point-min) (point-max))) (overlay-put newsticker--selection-overlay 'face 'newsticker-treeview-selection-face))) (unless newsticker--tree-selection-overlay (save-excursion (set-buffer (newsticker--treeview-tree-buffer)) (setq newsticker--tree-selection-overlay (make-overlay (point-min) (point-max))) (overlay-put newsticker--tree-selection-overlay 'face 'newsticker-treeview-selection-face))) (newsticker--treeview-tree-update) (newsticker--treeview-list-update t) (newsticker--treeview-item-update)) (defun newsticker-treeview-update () "Update all treeview buffers and windows. Note: does not update the layout." (interactive) (newsticker--group-manage-orphan-feeds) (newsticker--treeview-list-update t) (newsticker--treeview-item-update) (newsticker--treeview-tree-update-tags) (cond (newsticker--treeview-current-feed (newsticker--treeview-list-items newsticker--treeview-current-feed)) (newsticker--treeview-current-vfeed (newsticker--treeview-list-items-with-age (intern newsticker--treeview-current-vfeed)))) (newsticker--treeview-tree-update-highlight) (newsticker--treeview-list-update-highlight)) (defun newsticker-treeview-quit () "Quit newsticker treeview." (interactive) (setq newsticker--sentinel-callback nil) (bury-buffer "*Newsticker Tree*") (bury-buffer "*Newsticker List*") (bury-buffer "*Newsticker Item*") (set-window-configuration newsticker--saved-window-config) (when newsticker--frame (if (frame-live-p newsticker--frame) (delete-frame newsticker--frame)) (setq newsticker--frame nil)) (newsticker-treeview-save)) (defun newsticker-treeview-save () "Save newsticker data including treeview settings." (interactive) (save-excursion (let ((coding-system-for-write 'utf-8) (buf (find-file-noselect (concat newsticker-dir "/groups")))) (when buf (set-buffer buf) (setq buffer-undo-list t) (erase-buffer) (insert ";; -*- coding: utf-8 -*-\n") (insert (prin1-to-string newsticker-groups)) (save-buffer))))) (defun newsticker--treeview-load () "Load treeview settings." (let* ((coding-system-for-read 'utf-8) (filename (or (and (file-exists-p newsticker-groups-filename) (y-or-n-p (format "Old newsticker groups (%s) file exists. Read it? " newsticker-groups-filename)) newsticker-groups-filename) (concat newsticker-dir "/groups"))) (buf (and (file-exists-p filename) (find-file-noselect filename)))) (when buf (set-buffer buf) (goto-char (point-min)) (condition-case nil (setq newsticker-groups (read buf)) (error (message "Error while reading newsticker groups file!") (setq newsticker-groups nil)))))) (defun newsticker-treeview-scroll-item () "Scroll current item." (interactive) (save-selected-window (select-window (newsticker--treeview-item-window) t) (scroll-up 1))) (defun newsticker-treeview-show-item () "Show current item." (interactive) (newsticker--treeview-restore-layout) (newsticker--treeview-list-update-highlight) (save-excursion (set-buffer (newsticker--treeview-list-buffer)) (beginning-of-line) (let ((item (get-text-property (point) :nt-item)) (feed (get-text-property (point) :nt-feed))) (newsticker--treeview-item-show item feed))) (newsticker--treeview-tree-update-tag (newsticker--treeview-get-current-node) t) (newsticker--treeview-tree-update-highlight)) (defun newsticker-treeview-next-item () "Move to next item." (interactive) (newsticker--treeview-restore-layout) (save-current-buffer (set-buffer (newsticker--treeview-list-buffer)) (if (newsticker--treeview-list-highlight-start) (forward-line 1)) (if (eobp) (forward-line -1))) (newsticker-treeview-show-item)) (defun newsticker-treeview-prev-item () "Move to previous item." (interactive) (newsticker--treeview-restore-layout) (save-current-buffer (set-buffer (newsticker--treeview-list-buffer)) (forward-line -1)) (newsticker-treeview-show-item)) (defun newsticker-treeview-next-new-or-immortal-item () "Move to next new or immortal item." (interactive) (newsticker--treeview-restore-layout) (newsticker--treeview-list-clear-highlight) (catch 'found (let ((index (newsticker-treeview-next-item))) (while t (save-current-buffer (set-buffer (newsticker--treeview-list-buffer)) (forward-line 1) (when (eobp) (forward-line -1) (throw 'found nil))) (when (memq (newsticker--age (newsticker--treeview-get-selected-item)) '(new immortal)) (newsticker-treeview-show-item) (throw 'found t)))))) (defun newsticker-treeview-prev-new-or-immortal-item () "Move to previous new or immortal item." (interactive) (newsticker--treeview-restore-layout) (newsticker--treeview-list-clear-highlight) (catch 'found (let ((index (newsticker-treeview-next-item))) (while t (save-current-buffer (set-buffer (newsticker--treeview-list-buffer)) (forward-line -1) (when (bobp) (throw 'found nil))) (when (memq (newsticker--age (newsticker--treeview-get-selected-item)) '(new immortal)) (newsticker-treeview-show-item) (throw 'found t)))))) (defun newsticker--treeview-get-selected-item () "Return item that is currently selected in list buffer." (save-excursion (set-buffer (newsticker--treeview-list-buffer)) (beginning-of-line) (get-text-property (point) :nt-item))) (defun newsticker-treeview-mark-item-old (&optional dont-proceed) "Mark current item as old unless it is obsolete. Move to next item unless DONT-PROCEED is non-nil." (interactive) (let ((item (newsticker--treeview-get-selected-item))) (unless (eq (newsticker--age item) 'obsolete) (newsticker--treeview-mark-item item 'old))) (unless dont-proceed (newsticker-treeview-next-item))) (defun newsticker-treeview-toggle-item-immortal () "Toggle immortality of current item." (interactive) (let* ((item (newsticker--treeview-get-selected-item)) (new-age (if (eq (newsticker--age item) 'immortal) 'old 'immortal))) (newsticker--treeview-mark-item item new-age) (newsticker-treeview-next-item))) (defun newsticker--treeview-mark-item (item new-age) "Mark ITEM with NEW-AGE." (when item (setcar (nthcdr 4 item) new-age) ;; clean up ticker FIXME ) (newsticker--cache-save-feed (newsticker--cache-get-feed (intern newsticker--treeview-current-feed))) (newsticker--treeview-tree-do-update-tags newsticker--treeview-vfeed-tree)) (defun newsticker-treeview-mark-list-items-old () "Mark all listed items as old." (interactive) (let ((current-feed (or newsticker--treeview-current-feed newsticker--treeview-current-vfeed))) (save-excursion (set-buffer (newsticker--treeview-list-buffer)) (goto-char (point-min)) (while (not (eobp)) (let ((item (get-text-property (point) :nt-item))) (unless (memq (newsticker--age item) '(immortal obsolete)) (newsticker--treeview-mark-item item 'old))) (forward-line 1))) (newsticker--treeview-tree-update-tags) (if current-feed (newsticker-treeview-jump current-feed)))) (defun newsticker-treeview-save-item () "Save current item." (interactive) (newsticker-save-item (or newsticker--treeview-current-feed newsticker--treeview-current-vfeed) (newsticker--treeview-get-selected-item))) (defun newsticker-treeview-browse-url-item () "Convert current item to HTML and call `browse-url' on result." (interactive) (newsticker-browse-url-item (or newsticker--treeview-current-feed newsticker--treeview-current-vfeed) (newsticker--treeview-get-selected-item))) (defun newsticker--treeview-set-current-node (node) "Make NODE the current node." (save-excursion (set-buffer (newsticker--treeview-tree-buffer)) (setq newsticker--treeview-current-node-id (widget-get node :nt-id)) (setq newsticker--treeview-current-feed (widget-get node :nt-feed)) (setq newsticker--treeview-current-vfeed (widget-get node :nt-vfeed)) (newsticker--treeview-tree-update-highlight))) (defun newsticker--treeview-get-first-child (node) "Get first child of NODE." (let ((children (widget-get node :children))) (if children (car children) nil))) (defun newsticker--treeview-get-second-child (node) "Get scond child of NODE." (let ((children (widget-get node :children))) (if children (car (cdr children)) nil))) (defun newsticker--treeview-get-last-child (node) "Get last child of NODE." ;;(message "newsticker--treeview-get-last-child %s" (widget-get node :tag)) (let ((children (widget-get node :children))) (if children (car (reverse children)) nil))) (defun newsticker--treeview-get-feed-vfeed (node) "Get (virtual) feed of NODE." (or (widget-get node :nt-feed) (widget-get node :nt-vfeed))) (defun newsticker--treeview-get-next-sibling (node) "Get next sibling of NODE." (let ((parent (widget-get node :parent))) (catch 'found (let ((children (widget-get parent :children))) (while children (if (newsticker--treeview-nodes-eq (car children) node) (throw 'found (car (cdr children)))) (setq children (cdr children))))))) (defun newsticker--treeview-get-prev-sibling (node) "Get previous sibling of NODE." (let ((parent (widget-get node :parent))) (catch 'found (let ((children (widget-get parent :children)) (prev nil)) (while children (if (and (newsticker--treeview-nodes-eq (car children) node) (widget-get prev :nt-id)) (throw 'found prev)) (setq prev (car children)) (setq children (cdr children))))))) (defun newsticker--treeview-get-next-uncle (node) "Get next uncle of NODE, i.e. parent's next sibling." (let* ((parent (widget-get node :parent)) (grand-parent (widget-get parent :parent))) (catch 'found (let ((uncles (widget-get grand-parent :children))) (while uncles (if (newsticker--treeview-nodes-eq (car uncles) parent) (throw 'found (car (cdr uncles)))) (setq uncles (cdr uncles))))))) (defun newsticker--treeview-get-prev-uncle (node) "Get previous uncle of NODE, i.e. parent's previous sibling." (let* ((parent (widget-get node :parent)) (grand-parent (widget-get parent :parent))) (catch 'found (let ((uncles (widget-get grand-parent :children)) (prev nil)) (while uncles (if (newsticker--treeview-nodes-eq (car uncles) parent) (throw 'found prev)) (setq prev (car uncles)) (setq uncles (cdr uncles))))))) (defun newsticker--treeview-get-other-tree () "Get other tree." (if (and (newsticker--treeview-get-current-node) (widget-get (newsticker--treeview-get-current-node) :nt-feed)) newsticker--treeview-vfeed-tree newsticker--treeview-feed-tree)) (defun newsticker--treeview-activate-node (node &optional backward) "Activate NODE. If NODE is a tree widget the node's first subnode is activated. If BACKWARD is non-nil the last subnode of the previous sibling is activated." (newsticker--treeview-set-current-node node) (save-current-buffer (set-buffer (newsticker--treeview-tree-buffer)) (cond ((eq (widget-type node) 'tree-widget) (unless (widget-get node :open) (widget-put node :open nil) (widget-apply-action node)) (newsticker--treeview-activate-node (if backward (newsticker--treeview-get-last-child node) (newsticker--treeview-get-second-child node)))) (node (widget-apply-action node))))) (defun newsticker-treeview-next-feed () "Move to next feed." (interactive) (newsticker--treeview-restore-layout) (let ((cur (newsticker--treeview-get-current-node))) ;;(message "newsticker-treeview-next-feed from %s" ;; (widget-get cur :tag)) (if cur (let ((new (or (newsticker--treeview-get-next-sibling cur) (newsticker--treeview-get-next-uncle cur) (newsticker--treeview-get-other-tree)))) (newsticker--treeview-activate-node new)) (newsticker--treeview-activate-node (car (widget-get newsticker--treeview-feed-tree :children))))) (newsticker--treeview-tree-update-highlight)) (defun newsticker-treeview-prev-feed () "Move to previous feed." (interactive) (newsticker--treeview-restore-layout) (let ((cur (newsticker--treeview-get-current-node))) (message "newsticker-treeview-prev-feed from %s" (widget-get cur :tag)) (if cur (let ((new (or (newsticker--treeview-get-prev-sibling cur) (newsticker--treeview-get-prev-uncle cur) (newsticker--treeview-get-other-tree)))) (newsticker--treeview-activate-node new t)) (newsticker--treeview-activate-node (car (widget-get newsticker--treeview-feed-tree :children)) t))) (newsticker--treeview-tree-update-highlight)) (defun newsticker-treeview-next-page () "Scroll item buffer." (interactive) (save-selected-window (select-window (newsticker--treeview-item-window) t) (condition-case nil (scroll-up nil) (error (goto-char (point-min)))))) (defun newsticker--treeview-unfold-node (feed-name) "Recursively show subtree above the node that represents FEED-NAME." (let ((node (newsticker--treeview-get-node-of-feed feed-name))) (unless node (let* ((group-name (or (car (newsticker--group-find-group-for-feed feed-name)) (newsticker--group-get-parent-group feed-name)))) (newsticker--treeview-unfold-node group-name)) (setq node (newsticker--treeview-get-node-of-feed feed-name))) (when node (save-excursion (set-buffer (newsticker--treeview-tree-buffer)) (widget-put node :nt-selected t) (widget-apply-action node) (newsticker--treeview-set-current-node node))))) (defun newsticker-treeview-jump (feed-name) "Jump to feed FEED-NAME in newsticker treeview." (interactive (list (let ((completion-ignore-case t)) (completing-read "Jump to feed: " (mapcar 'car (append newsticker-url-list newsticker-url-list-defaults)) nil t)))) (newsticker--treeview-unfold-node feed-name)) ;; ====================================================================== ;;; Groups ;; ====================================================================== (defun newsticker--group-do-find-group-for-feed (feed-name node) "Recursively find FEED-NAME in NODE." (if (member feed-name (cdr node)) (throw 'found node) (mapc (lambda (n) (if (listp n) (newsticker--group-do-find-group-for-feed feed-name n))) (cdr node)))) (defun newsticker--group-find-group-for-feed (feed-name) "Find group containing FEED-NAME." (catch 'found (newsticker--group-do-find-group-for-feed feed-name newsticker-groups) nil)) (defun newsticker--group-do-get-group (name node) "Recursively find group with NAME below NODE." (if (string= name (car node)) (throw 'found node) (mapc (lambda (n) (if (listp n) (newsticker--group-do-get-group name n))) (cdr node)))) (defun newsticker--group-get-group (name) "Find group with NAME." (catch 'found (mapc (lambda (n) (if (listp n) (newsticker--group-do-get-group name n))) newsticker-groups) nil)) (defun newsticker--group-do-get-parent-group (name node parent) "Recursively find parent group for NAME from NODE which is a child of PARENT." (if (string= name (car node)) (throw 'found parent) (mapc (lambda (n) (if (listp n) (newsticker--group-do-get-parent-group name n (car node)))) (cdr node)))) (defun newsticker--group-get-parent-group (name) "Find parent group for group named NAME." (catch 'found (mapc (lambda (n) (if (listp n) (newsticker--group-do-get-parent-group name n (car newsticker-groups)))) newsticker-groups) nil)) (defun newsticker--group-get-subgroups (group &optional recursive) "Return list of subgroups for GROUP. If RECURSIVE is non-nil recursively get subgroups and return a nested list." (let ((result nil)) (mapc (lambda (n) (when (listp n) (setq result (cons (car n) result)) (let ((subgroups (newsticker--group-get-subgroups n recursive))) (when subgroups (setq result (append subgroups result)))))) group) result)) (defun newsticker--group-all-groups () "Return nested list of all groups." (newsticker--group-get-subgroups newsticker-groups t)) (defun newsticker--group-get-feeds (group &optional recursive) "Return list of all feeds in GROUP. If RECURSIVE is non-nil recursively get feeds of subgroups and return a nested list." (let ((result nil)) (mapc (lambda (n) (if (not (listp n)) (setq result (cons n result)) (if recursive (let ((subfeeds (newsticker--group-get-feeds n t))) (when subfeeds (setq result (append subfeeds result))))))) group) result)) (defun newsticker-group-add-group (name parent) "Add group NAME to group PARENT." (interactive (list (read-string "Group Name: ") (let ((completion-ignore-case t)) (completing-read "Parent Group: " (newsticker--group-all-groups) nil t)))) (if (newsticker--group-get-group name) (error "Group %s exists already" name)) (let ((p (if (and parent (not (string= parent ""))) (newsticker--group-get-group parent) newsticker-groups))) (unless p (error "Parent %s does not exist" parent)) (setcdr p (cons (list name) (cdr p)))) (newsticker--treeview-tree-update)) (defun newsticker-group-move-feed (name group-name &optional no-update) "Move feed NAME to group GROUP-NAME. Update teeview afterwards unless NO-UPDATE is non-nil." (interactive (let ((completion-ignore-case t)) (list (completing-read "Feed Name: " (mapcar 'car newsticker-url-list) nil t newsticker--treeview-current-feed) (completing-read "Group Name: " (newsticker--group-all-groups) nil t)))) (let ((group (if (and group-name (not (string= group-name ""))) (newsticker--group-get-group group-name) newsticker-groups))) (unless group (error "Group %s does not exist" group-name)) (while (let ((old-group (newsticker--group-find-group-for-feed name))) (when old-group (delete name old-group)) old-group)) (setcdr group (cons name (cdr group))) (unless no-update (newsticker--treeview-tree-update) (newsticker-treeview-update)))) (defun newsticker-group-delete-group (name) "Remove group NAME." (interactive (let ((completion-ignore-case t)) (list (completing-read "Group Name: " (newsticker--group-all-groups) nil t)))) (let* ((g (newsticker--group-get-group name)) (p (or (newsticker--group-get-parent-group name) newsticker-groups))) (unless g (error "Group %s does not exist" name)) (delete g p)) (newsticker--treeview-tree-update)) (defun newsticker--count-groups (group) "Recursively count number of subgroups of GROUP." (let ((result 1)) (mapc (lambda (g) (if (listp g) (setq result (+ result (newsticker--count-groups g))))) (cdr group)) result)) (defun newsticker--count-grouped-feeds (group) "Recursively count number of feeds in GROUP and its subgroups." (let ((result 0)) (mapc (lambda (g) (if (listp g) (setq result (+ result (newsticker--count-grouped-feeds g))) (setq result (1+ result)))) (cdr group)) result)) (defun newsticker--group-remove-obsolete-feeds (group) "Recursively remove obselete feeds from GROUP." (let ((result nil) (urls (append newsticker-url-list newsticker-url-list-defaults))) (mapc (lambda (g) (if (listp g) (let ((sub-groups (newsticker--group-remove-obsolete-feeds g))) (if sub-groups (setq result (cons sub-groups result)))) (if (assoc g urls) (setq result (cons g result))))) (cdr group)) (if result (cons (car group) (reverse result)) result))) (defun newsticker--group-manage-orphan-feeds () "Put unmanaged feeds into `newsticker-groups'. Remove obsolete feeds as well." (unless newsticker-groups (setq newsticker-groups '("Feeds"))) (let ((new-feed nil) (grouped-feeds (newsticker--count-grouped-feeds newsticker-groups))) (mapc (lambda (f) (unless (newsticker--group-find-group-for-feed (car f)) (setq new-feed t) (newsticker-group-move-feed (car f) nil t))) (append newsticker-url-list-defaults newsticker-url-list)) (setq newsticker-groups (newsticker--group-remove-obsolete-feeds newsticker-groups)) (if (or new-feed (not (= grouped-feeds (newsticker--count-grouped-feeds newsticker-groups)))) (newsticker--treeview-tree-update)))) ;; ====================================================================== ;;; Modes ;; ====================================================================== (defun newsticker--treeview-create-groups-menu (group-list excluded-group) "Create menu for GROUP-LIST omitting EXCLUDED-GROUP." (let ((menu (make-sparse-keymap (if (stringp (car group-list)) (car group-list) "Move to group...")))) (mapc (lambda (g) (when (listp g) (let ((title (if (stringp (car g)) (car g) "Move to group..."))) (unless (eq g excluded-group) (define-key menu (vector (intern title)) (list 'menu-item title (newsticker--treeview-create-groups-menu (cdr g) excluded-group))))))) (reverse group-list)) menu)) (defun newsticker--treeview-create-tree-menu (feed-name) "Create tree menu for FEED-NAME." (let ((menu (make-sparse-keymap feed-name))) (define-key menu [newsticker-treeview-mark-list-items-old] (list 'menu-item "Mark all items old" 'newsticker-treeview-mark-list-items-old)) (define-key menu [move] (list 'menu-item "Move to group..." (newsticker--treeview-create-groups-menu newsticker-groups (newsticker--group-get-group feed-name)))) menu)) (defvar newsticker-treeview-list-menu (let ((menu (make-sparse-keymap "Newsticker List"))) (define-key menu [newsticker-treeview-mark-list-items-old] (list 'menu-item "Mark all items old" 'newsticker-treeview-mark-list-items-old)) menu) "Map for newsticker tree menu.") (defvar newsticker-treeview-mode-map (let ((map (make-sparse-keymap 'newsticker-treeview-mode-map))) (define-key map " " 'newsticker-treeview-next-page) (define-key map "a" 'newsticker-add-url) (define-key map "b" 'newsticker-treeview-browse-url-item) (define-key map "F" 'newsticker-treeview-prev-feed) (define-key map "f" 'newsticker-treeview-next-feed) (define-key map "g" 'newsticker-treeview-get-news) (define-key map "G" 'newsticker-get-all-news) (define-key map "i" 'newsticker-treeview-toggle-item-immortal) (define-key map "j" 'newsticker-treeview-jump) (define-key map "n" 'newsticker-treeview-next-item) (define-key map "N" 'newsticker-treeview-next-new-or-immortal-item) (define-key map "O" 'newsticker-treeview-mark-list-items-old) (define-key map "o" 'newsticker-treeview-mark-item-old) (define-key map "p" 'newsticker-treeview-prev-item) (define-key map "P" 'newsticker-treeview-prev-new-or-immortal-item) (define-key map "q" 'newsticker-treeview-quit) (define-key map "S" 'newsticker-treeview-save-item) (define-key map "s" 'newsticker-treeview-save) (define-key map "u" 'newsticker-treeview-update) (define-key map "v" 'newsticker-treeview-browse-url) ;;(define-key map "\n" 'newsticker-treeview-scroll-item) ;;(define-key map "\C-m" 'newsticker-treeview-scroll-item) (define-key map "\M-m" 'newsticker-group-move-feed) (define-key map "\M-a" 'newsticker-group-add-group) map) "Mode map for newsticker treeview.") (defun newsticker-treeview-mode () "Major mode for Newsticker Treeview. \\{newsticker-treeview-mode-map}" (kill-all-local-variables) (use-local-map newsticker-treeview-mode-map) (setq major-mode 'newsticker-treeview-mode) (setq mode-name "Newsticker TV") (if (boundp 'tool-bar-map) (set (make-local-variable 'tool-bar-map) newsticker-treeview-tool-bar-map)) (setq buffer-read-only t truncate-lines t)) (define-derived-mode newsticker-treeview-list-mode newsticker-treeview-mode "Item List" (let ((header (concat (propertize " " 'display '(space :align-to 0)) (newsticker-treeview-list-make-sort-button "*" 'sort-by-age) (propertize " " 'display '(space :align-to 2)) (if newsticker--treeview-list-show-feed (concat "Feed" (propertize " " 'display '(space :align-to 12))) "") (newsticker-treeview-list-make-sort-button "Date" 'sort-by-time) (if newsticker--treeview-list-show-feed (propertize " " 'display '(space :align-to 28)) (propertize " " 'display '(space :align-to 18))) (newsticker-treeview-list-make-sort-button "Title" 'sort-by-title)))) (setq header-line-format header)) (define-key newsticker-treeview-list-mode-map [down-mouse-3] newsticker-treeview-list-menu)) (defun newsticker-treeview-tree-click (event) "Handle click EVENT on a tag in the newsticker tree." (interactive "e") (newsticker--treeview-restore-layout) (save-excursion (switch-to-buffer (window-buffer (posn-window (event-end event)))) (newsticker-treeview-tree-do-click (posn-point (event-end event))))) (defun newsticker-treeview-tree-do-click (&optional pos event) "Actually handle click event. POS gives the position where EVENT occurred." (interactive) (let* ((pos (or pos (point))) (nt-id (get-text-property pos :nt-id)) (item (get-text-property pos :nt-item))) (cond (item ;; click in list buffer (newsticker-treeview-show-item)) (t ;; click in tree buffer (let ((w (newsticker--treeview-get-node nt-id))) (when w (newsticker--treeview-tree-update-tag w t t) (setq w (newsticker--treeview-get-node nt-id)) (widget-put w :nt-selected t) (widget-apply w :action event) (newsticker--treeview-set-current-node w)))))) (newsticker--treeview-tree-update-highlight)) (defun newsticker--treeview-restore-layout () "Restore treeview buffers." (catch 'error (dotimes (i 3) (let ((win (nth i newsticker--treeview-windows)) (buf (nth i newsticker--treeview-buffers))) (unless (window-live-p win) (newsticker--treeview-window-init) (newsticker--treeview-buffer-init) (throw 'error t)) (unless (eq (window-buffer win) buf) (set-window-buffer win buf t)))))) (defun newsticker--treeview-frame-init () "Initialize treeview frame." (when newsticker-treeview-own-frame (unless (and newsticker--frame (frame-live-p newsticker--frame)) (setq newsticker--frame (make-frame '((name . "Newsticker"))))) (select-frame-set-input-focus newsticker--frame) (raise-frame newsticker--frame))) (defun newsticker--treeview-window-init () "Initialize treeview windows." (setq newsticker--saved-window-config (current-window-configuration)) (setq newsticker--treeview-windows nil) (setq newsticker--treeview-buffers nil) (delete-other-windows) (split-window-horizontally newsticker-treeview-treewindow-width) (add-to-list 'newsticker--treeview-windows (selected-window) t) (other-window 1) (split-window-vertically newsticker-treeview-listwindow-height) (add-to-list 'newsticker--treeview-windows (selected-window) t) (other-window 1) (add-to-list 'newsticker--treeview-windows (selected-window) t) (other-window 1)) ;;;###autoload (defun newsticker-treeview () "Start newsticker treeview." (interactive) (newsticker--treeview-load) (setq newsticker--sentinel-callback 'newsticker-treeview-update) (newsticker--treeview-frame-init) (newsticker--treeview-window-init) (newsticker--treeview-buffer-init) (newsticker--group-manage-orphan-feeds) (newsticker--treeview-set-current-node newsticker--treeview-feed-tree) (newsticker-start t) ;; will start only if not running (newsticker-treeview-update) (newsticker--treeview-item-show-text "Newsticker" "Welcome to newsticker!")) (defun newsticker-treeview-get-news () "Get news for current feed." (interactive) (when newsticker--treeview-current-feed (newsticker-get-news newsticker--treeview-current-feed))) (provide 'newsticker-treeview) ;; arch-tag: 5dbaff48-1f3e-4fc6-8ebd-e966fc90d2d4 ;;; newst-treeview.el ends here