newst-treeview.el 85 KB

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