newst-treeview.el 85 KB

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