home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / gnus-topic.el < prev    next >
Encoding:
Text File  |  1991-07-03  |  13.7 KB  |  510 lines
  1. ; Path: dg-rtp!rock!mcnc!stanford.edu!agate!ucbvax!cis.ohio-state.edu!zaphod.mps.ohio-state.edu!swrinde!cs.utexas.edu!uunet!lll-winken!aunro!alberta!cpsc.ucalgary.ca!krawchuk
  2. ; From: krawchuk@cpsc.UCalgary.ca (Bj Krawchuk)
  3. ; Newsgroups: gnu.emacs.sources,gnu.emacs.gnus,news.software.readers
  4. ; Subject: gnus-topic.el 1.0 : A Topic Mode for GNUS
  5. ; Date: 29 Jun 91 06:18:03 GMT
  6. ; Organization: The University of Calgary
  7. ; 
  8. ; 
  9. ; 
  10. ; gnus-topic 1.0 provides another mode to GNUS, in addition to 
  11. ; The idea of it is to organize the selection and maintenance
  12. ; of groups of newsgroups, which I call Topics.
  13. ; 
  14. ; This is not yet a finished product. I am posting it in the hope
  15. ; that people will help me work on it. I am low on time and would
  16. ; like the emergence of an excellent product sooner than I could
  17. ; provide it working on it alone.
  18. ; Anyone wishing to do enhancements, bug fixes and changes should 
  19. ; contact me, and I will coordinate the development. 
  20. ; Or we could do the development via posting. 
  21. ; Any volunteers?
  22. ; 
  23. ; Since this is not nearly finished, expect bugs, and annoyances.
  24. ; Nevertheless, I have been using this current version for several
  25. ; days now, and still would rather not do without it.
  26. ; Number one on the priority list for enhancements is to speed up 
  27. ; article counting. Right now it takes me about 3 seconds to update 
  28. ; the topic listing. (But I have a huge .newsrc ...). Also,
  29. ; maintence of the newsgroup regexps has not been written yet.
  30. ; They currently have to be edited in the ~/.topics file. 
  31. ; (And I have a bunch of other beefs...)
  32.  
  33. ; I have posted this news.software.readers since there has recently
  34. ; been some talk there about newsgroup organization. 
  35. ; This may provide a starting point for further GNUS development
  36. ; on group handling. For example, group melding could be done using
  37. ; this as its user interface. 
  38. ;
  39. ; Enjoy, and please help me out, if you can and want to.
  40. ;
  41. ; Cheers
  42. ;    Bj  <krawchuk@cpsc.ucalgary.ca>
  43. ;
  44.  
  45. ;;;-------------------------------------------------------------------
  46. ;;;
  47. ;;; gnus-topic.el 1.0
  48. ;;; Organize newsgroups by topic   
  49. ;;; Jun 91
  50. ;;; Bj Krawchuk <krawchuk@cpsc.ucalgary.ca>
  51. ;;; [Awefold Compatible]
  52. ;;;
  53. ;;; LCD Archive Entry:
  54. ;;; gnus-topic|Bj Krawchuk|krawchuk@cpsc.UCalgary.ca
  55. ;;; |Topics mode for GNUS for organizing newsgroups
  56. ;;; |91-06-29|1.0|~/packages/gnus-topic.el.Z
  57. ;;;
  58. ;;; See mode description for keybindings 
  59. ;;; (type ? in topic mode eg.)
  60. ;;;
  61. ;;; ------------------------
  62. ;:: .topics file
  63. ;;; ------------------------
  64. ;;;
  65. ;;; in this version a .topics file must be included in your home directory
  66. ;;; Here is my .topics file
  67. ;;;
  68. ;;; (setq gnus-topic-alist 
  69. ;;; '( 
  70. ;;;  ("Health"     "sci.med" "alt.psychoactives" "sci.psychology")
  71. ;;;  ("Drugs"      "alt.drugs" "talk.politics.drugs")  
  72. ;;;  ("Politics"   "alt.individualism")
  73. ;;;  ("Misc"    "misc.misc" "comp.archives" "comp.risks")
  74. ;;;  ("PC"    "comp.binaries" "comp.sys.ibm.pc")
  75. ;;;  ("Emacs"      "emacs")
  76. ;;;  ("Gnu"        "gnu")
  77. ;;;  ("Vm"    "gnu.emacs.vm")
  78. ;;;  ("News"       "alt.config" "news")
  79. ;;;  ("Sources"    "source")
  80. ;;;  ("Skepticism" "sci.skeptic" "talk.origins" "alt.paranormal" "alt.atheism")
  81. ;;;  ("Religion"   "alt.atheism" "religion"  "alt.magick" "alt.pagan" 
  82. ;;;        "newage" "talk.origins")
  83. ;;;  ("Research" "sci.logic" "comp.theory")
  84. ;;;  ("Radio"    "radio")
  85. ;;;  ("Calgary"    "calgary")
  86. ;;;  ("Cpsc"    "cpsc")
  87. ;;;  ("Comp"    "comp")
  88. ;;;  ("Sci"    "sci")
  89. ;;;  ("Can"    "can")
  90. ;;;  ("Music"    "music")
  91. ;;;  ("Ai"    "ai")
  92. ;;;  ("All"    "")
  93. ;;;  ))
  94. ;;;
  95. ;:|
  96. ;;; ------------------------
  97. ;:: .emacs startup additions
  98. ;;; ------------------------
  99. ;;;
  100. ;;; (setq gnus-Startup-hook 
  101. ;;;  (function (lambda () (gnus-create-topic-buffer))))
  102. ;;;
  103. ;;; (setq gnus-Group-prepare-hook
  104. ;;;  (function (lambda () (gnus-topic-Group-prepare-hook-fn))))
  105. ;;;    
  106. ;;;
  107. ;;; (setq gnus-Group-mode-hook 
  108. ;;;  (function (lambda () (require 'gnus-topic) 
  109. ;;;              (gnus-topic-Group-mode-hook-fn))))
  110. ;;;
  111. ;:|
  112. ;;;-------------------------------------------------------------------
  113.  
  114. (require 'cl)
  115.  
  116. ;:: Variables
  117.  
  118. (defvar gnus-Topic-buffer "*Topic*") ; gnus-buffer-list should have this
  119.  
  120. (defvar gnus-topic-alist 
  121.  '(     ("Health" "sci.med" "alt.psychoactives")
  122.     ("Emacs"  "comp.emacs" "gnu.emacs.sources" "gnu.emacs.help")
  123.   ) ; just a sample
  124.  "Association List")
  125.  
  126. (defvar gnus-topic-newsgroups 
  127.     '("")     ; startup Group buffer with all newsgroups
  128.     "Currently chosen newsgroups")
  129.  
  130. ;:|
  131.  
  132. ;:: Topic Mode
  133.  
  134. ;:: Topic Mode Keymap
  135. (defvar gnus-Topic-mode-map nil)
  136.  
  137. (if gnus-Topic-mode-map 
  138.     nil
  139.   (setq gnus-Topic-mode-map (make-keymap))
  140.   (suppress-keymap gnus-Topic-mode-map)
  141.   (define-key gnus-Topic-mode-map " " 'gnus-Topic-select-topic)
  142.   (define-key gnus-Topic-mode-map "=" 'gnus-Topic-select-all-topic)
  143.   (define-key gnus-Topic-mode-map "n" 'gnus-Topic-next-topic)
  144.   (define-key gnus-Topic-mode-map "p" 'gnus-Topic-prev-topic)
  145.   (define-key gnus-Topic-mode-map "l" 'gnus-Topic-list-topics)
  146.   (define-key gnus-Topic-mode-map "L" 'gnus-Topic-list-topics-verbose)
  147.   (define-key gnus-Topic-mode-map "r" 'gnus-Topic-read-topic-file)
  148.   (define-key gnus-Topic-mode-map "x" 'gnus-Group-force-update)
  149.   (define-key gnus-Topic-mode-map "s" 'gnus-Group-force-update)
  150.   (define-key gnus-Topic-mode-map "t" 'gnus-Topic-toggle-regexp-display) 
  151.   (define-key gnus-Topic-mode-map "g" 'gnus-Topic-select-group-buffer)
  152.   (define-key gnus-Topic-mode-map "q" 'gnus-Group-exit)
  153.   (define-key gnus-Topic-mode-map "Q" 'gnus-Group-quit)
  154.   (define-key gnus-Topic-mode-map "?" 'describe-mode)
  155. )
  156.  
  157.  
  158. ;:|
  159.  
  160. ;:: Gnus Topic Mode
  161.  
  162. (defun gnus-Topic-mode ()
  163.  "Major mode for organizing, selecting topics in GNUS.
  164. A Topic enables grouping of newsgroups together.
  165.  
  166. SPC    Select this topic
  167. =    Select this topic including unread groups
  168. n    Move to the next topic
  169. p    Move to the previous topic
  170. l    List (update) current topic list
  171. L    List all topics, even those with no unread articles
  172. r    Read topic file (~/.topics)
  173. s,x    Force update of .newsrc
  174. t    Toggle newsgroup regexp display
  175. g    Jump to Group buffer (last selected)
  176. q    exit news (gnus-Group-exit)
  177. Q    quit news (gnus-Group-quit)
  178.  
  179. In the Group mode:
  180.  
  181. q    return to Topic mode
  182. Q    return to Topic mode without recomputing article totals."
  183.  
  184.  
  185.  (interactive)
  186.   (cond ((boundp 'mode-line-modified)
  187.      (setq mode-line-modified "--- "))
  188.     ((listp (default-value 'mode-line-format))
  189.      (setq mode-line-format
  190.            (cons "--- " (cdr (default-value 'mode-line-format)))))
  191.     (t
  192.      (setq mode-line-format
  193.            "--- GNUS: List of Topics  %[(%m)%]----%3p-%-")))
  194.   (setq major-mode 'gnus-Topic-mode)
  195.   (setq mode-name "Topic")
  196.   (setq mode-line-buffer-identification    "GNUS: List of Topics")
  197.   (setq mode-line-process nil)
  198.   (use-local-map gnus-Topic-mode-map)
  199.   (buffer-flush-undo (current-buffer))
  200.   (gnus-Topic-read-topic-file)
  201.   (gnus-Topic-list-topics)
  202.   (goto-char (point-min))
  203.   (if (not (eobp))
  204.    (progn (search-forward ":" nil t)
  205.         (forward-char -1)))
  206.   (setq buffer-read-only t)        ;Disable modification
  207.   (run-hooks 'gnus-Topic-mode-hook) 
  208. )
  209.  
  210.  
  211.  
  212. ;:|
  213.  
  214. ;:: Startup stuff
  215.  
  216. (defvar gnus-topic-startup-in-topic-buffer t
  217.   "Should the topic buffer be the first thing you see?")
  218.  
  219. (defun gnus-create-topic-buffer ()
  220.  "For use in gnus-Startup-hook."
  221.   (set-buffer (get-buffer-create gnus-Topic-buffer))
  222.   (setq gnus-topic-starting t)
  223.   (gnus-Topic-mode)
  224.   (setq gnus-buffer-list (cons gnus-Topic-buffer gnus-buffer-list))
  225.   (set-buffer gnus-Group-buffer))
  226.  
  227.  
  228.  
  229. ;:|
  230.  
  231.  
  232. ;:|
  233.  
  234. ;:: Interactive Functions
  235.  
  236. ;:: Topic Listing
  237.  
  238.  
  239. (defun gnus-Topic-list-topics (&optional show-all)
  240.   "List topics in the Topic buffer."
  241.   (interactive nil)
  242.   (setq gnus-Topic-current-topic 1)
  243.   (gnus-topic-list-topics-aux show-all))
  244.  
  245. (defun gnus-topic-list-topics-aux (&optional show-all)
  246.   "List topics in the Topic buffer."
  247.   (interactive nil)
  248.   (let ((topics gnus-topic-alist)
  249.         (buffer-read-only nil))
  250.   (erase-buffer)
  251.   (while topics
  252.    (let ((topic (car topics)))
  253.     (let ((num-arts (gnus-topic-calc-number-of-articles (cdr topic))))
  254.      (if (or show-all (not (zerop num-arts)))
  255.        (progn
  256.          (insert (format "[%3d] : %s\n" num-arts (car topic)))
  257.      (if gnus-Topic-regexp-display
  258.         (progn (setq topic (cdr topic))    
  259.             (while topic
  260.               (insert (format "\t  %s\n" (car topic))) 
  261.               (setq topic (cdr topic)))))))))
  262.    (setq topics (cdr topics)))
  263.   (set-buffer-modified-p nil)
  264.   (gnus-Topic-jump-to-topic gnus-Topic-current-topic)))
  265.  
  266. (defun gnus-Topic-list-topics-verbose ()
  267.   "List topics in the Topic buffer with newsgroups."
  268.   (interactive)
  269.   (gnus-Topic-list-topics t))
  270.  
  271. ;:|
  272.  
  273. ;:: Topic Navigation
  274.  
  275. (defun gnus-Topic-first-topic ()
  276.  "Move to first topic."
  277.  (interactive)
  278.  (goto-char (point-min))
  279.  (gnus-Topic-find-topic-marker))
  280.  
  281. (defun gnus-Topic-find-topic-marker ()
  282.  "Find the colon on current line."
  283.  (beginning-of-line)
  284.  (if (not (= (point-min) (point-max)))
  285.   (progn (search-forward ":" nil t)
  286.      (forward-char -1))))
  287.  
  288.  
  289. (defun gnus-Topic-next-topic ()
  290.  "Move to next topic."
  291.  (interactive)
  292.  (forward-char 1)
  293.  (if (not (re-search-forward ":" nil t))
  294.     (gnus-Topic-first-topic)
  295.     (forward-char -1)))
  296.  
  297. (defun gnus-Topic-prev-topic ()
  298.  "Move to next topic."
  299.  (interactive)
  300.  (beginning-of-line)
  301.  (if (not (re-search-backward ":" nil t))
  302.     (progn (goto-char (point-max))
  303.         (re-search-backward ":" nil t))))
  304.  
  305. ;:|
  306.  
  307. ;:: Topic Selection
  308. (defvar gnus-Topic-current-topic 1
  309.     "The currently selected topic's line-number. Just a hack for now.")
  310.  
  311. (defun gnus-Topic-jump-to-topic (line-no)
  312.  "Move to topic on line-no."
  313.  (interactive "p")
  314.  (goto-line line-no)
  315.  (gnus-Topic-find-topic-marker)
  316.  (setq gnus-Topic-current-topic line-no))
  317.  
  318.  
  319. (defun gnus-Topic-select-topic (&optional select-all)
  320.  "Choose to read newsgroups for this topic."
  321.   (interactive nil)
  322.   (setq gnus-Topic-current-topic (count-lines (point-min) (point)))
  323.   (setq gnus-topic-newsgroups
  324.     (gnus-topic-lookup gnus-topic-alist
  325.                (gnus-topic-get-topic-name)))
  326.   (set-buffer gnus-Group-buffer)
  327.   (let ((buffer-read-only nil))
  328.       (gnus-Group-prepare select-all)
  329.       (set-buffer-modified-p nil))
  330.   (gnus-Topic-select-group-buffer))
  331.  
  332.  
  333. (defun gnus-Topic-select-all-topic ()
  334.  "Select newsgroups, even empty or unsubscribed groups"
  335.   (interactive)
  336.   (gnus-Topic-select-topic t))
  337.  
  338. (defun gnus-Group-select-topic-buffer (&optional no-update)
  339.  "Move back to topic buffer."
  340.  (interactive nil)
  341.  (switch-to-buffer gnus-Topic-buffer)
  342.  (if (not no-update)
  343.      (gnus-topic-list-topics-aux)))
  344.  
  345. (defun gnus-Group-select-topic-buffer-no-update ()
  346.  "Move back to topic buffer without updating totals"
  347.  (interactive)
  348.  (gnus-Group-select-topic-buffer t)
  349. )  
  350.  
  351. (defun gnus-Topic-select-group-buffer ()
  352.  "Move back to group buffer."
  353.  (interactive)
  354.  (switch-to-buffer gnus-Group-buffer))
  355.  
  356.  
  357. ;:|
  358.  
  359. ;:: Topic file
  360. (defun gnus-Topic-read-topic-file ()
  361.  "bleck"
  362.  (interactive)
  363.  (load "~/.topics")
  364. )
  365.  
  366. (defun gnus-Topic-save-topic-file ()
  367.  "bleck"
  368.  (interactive)
  369.  (message "Not implemented yet.")
  370. )
  371.  
  372.  
  373. ;:|
  374.  
  375. ;:: Regexp display handling
  376. (defvar gnus-Topic-regexp-display nil 
  377.  "Variable to control if the newsgroup regexps should be 
  378. shown beside the topic names.")
  379.  
  380. (defun gnus-Topic-toggle-regexp-display ()
  381.  "Toggle gnus-Topic-regexp-display."
  382.  (interactive)
  383.  (setq gnus-Topic-regexp-display (not gnus-Topic-regexp-display))
  384.  (setq gnus-Topic-current-topic 1)
  385.  (gnus-Topic-list-topics)
  386.  (message "Newsgroup regular expression display %s" 
  387.     (if gnus-Topic-regexp-display "on." "off."))
  388. )
  389.  
  390. ;:|
  391.  
  392.  
  393.  
  394. ;:|
  395.  
  396. ;:: Support Functions
  397. ;:: Topic select stuff
  398.  
  399. (defun gnus-topic-lookup (topic-alist topic)
  400.  "Lookup the regexps for a topic."
  401.     (cond   ((null topic-alist) nil)
  402.         ((string-equal (caar topic-alist) topic)
  403.             (cdar topic-alist))
  404.         (t (gnus-topic-lookup (cdr topic-alist) topic))))
  405.  
  406.  
  407.  
  408. (defun gnus-topic-get-topic-name ()
  409.  "Find the topic name of the currently pointed at topic"
  410.  (save-excursion
  411.  (beginning-of-line)
  412.  (if (not (looking-at "\\[[ 0-9]+\\] :"))
  413.     (re-search-backward ":" nil t))
  414.  (search-forward ":" nil t)
  415.  (forward-char 1)
  416.  (buffer-substring (point) (progn (end-of-line) (point)))))
  417.  
  418.  
  419.  
  420. ;:|
  421.  
  422. ;:: Group Buffer stuff
  423.  
  424. (defun gnus-Group-topic-format-group-buffer ()
  425.  "*Format group buffer, restricting it to currently chosen topic."
  426.  (interactive)  
  427.  (set-buffer gnus-Group-buffer)
  428.   (let ((buffer-read-only nil))
  429.    (goto-char (point-min))
  430.    (while (not (eobp))
  431.      (if (not (string-match-member (gnus-Group-group-name) 
  432.                       gnus-topic-newsgroups))
  433.     (gnus-topic-delete-newsgroup)
  434.     (next-line 1)))
  435.    (goto-char (point-min))
  436.    (if (not (search-forward ":" nil t))
  437.     (message "No newsgroups with messages for this topic"))
  438.    (set-buffer-modified-p nil)))
  439.  
  440.  
  441. (defun gnus-topic-delete-newsgroup ()
  442.  "*Remove current line from newsgroup buffer"
  443.  (beginning-of-line)
  444.  (kill-line 1)
  445. )
  446.  
  447.  
  448.  
  449.  
  450. ;:|
  451.  
  452. ;:: Hook function stuff
  453.  
  454. (defun gnus-topic-Group-prepare-hook-fn ()
  455.  "Topic mode handling hook function for gnus-Group-prepare-hook."
  456.    (if (and gnus-topic-startup-in-topic-buffer
  457.         gnus-topic-starting)
  458.     (gnus-Group-select-topic-buffer))
  459.    (gnus-Group-topic-format-group-buffer)
  460.    (setq gnus-topic-starting nil))
  461.  
  462.  
  463. (defun gnus-topic-Group-mode-hook-fn ()
  464.  "Topic mode handling hook function for gnus-Group-mode-hook."
  465.  (define-key gnus-Group-mode-map "q" 'gnus-Group-select-topic-buffer)
  466.  (define-key gnus-Group-mode-map "Q" 'gnus-Group-select-topic-buffer-no-update)
  467. ) 
  468.  
  469. ;:|
  470.  
  471. ;:: Misc support
  472.  
  473. ;:: Counting stuff
  474. (defun gnus-topic-calc-number-of-articles (nglist)
  475.  "Count the number of unread articles covered by the newgroup list"
  476.   (let ((unread-count 0)
  477.     (group-info nil)
  478.     (group-name nil)
  479.         (newsrc gnus-newsrc-assoc))
  480.     (while newsrc
  481.       (if (nth 1 (car newsrc)) ; if subscribed
  482.       (progn
  483.        (setq group-name (caar newsrc))
  484.       (if (string-match-member group-name nglist)
  485.         (setq unread-count 
  486.           (+ unread-count
  487.         (nth 1 (gnus-gethash group-name gnus-unread-hashtb)))))))
  488.       (setq newsrc (cdr newsrc)))
  489.   unread-count))
  490.  
  491.  
  492. ;:|
  493. ;:|
  494. ;:|
  495.  
  496. ;:: Misc Functions
  497.  
  498. (defun string-match-member (str slist)
  499.  "*Check list for string"
  500.  (cond  ((null slist) '())
  501.       ((string-match (car slist) str))
  502.     (t (string-match-member str (cdr slist)))))
  503.  
  504.  
  505. ;:|
  506.  
  507. (provide 'gnus-topic)
  508.  
  509. ;:|
  510.