home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / patches / gnus-hier.el < prev    next >
Encoding:
Text File  |  1992-11-25  |  25.8 KB  |  788 lines
  1. ; Path: hal.com!olivea!uunet!cis.ohio-state.edu!east-wind.ORG!kingdon
  2. ; From: kingdon@east-wind.ORG (Jim Kingdon)
  3. ; Newsgroups: gnu.emacs.sources
  4. ; Subject: Hierarchical patches for GNUS 3.14.1
  5. ; Date: 23 Nov 92 06:33:59 GMT
  6. ; Organization: Source only  Discussion and requests in gnu.emacs.help.
  7. ; 
  8. ; Enclosed are patches to make GNUS a hierarchical newsreader.  What I
  9. ; mean by that is that when you start up GNUS for the first time, rather
  10. ; than showing you all the newsgroups, it will just show one line for
  11. ; each top-level hierarchy ("soc", "rec", "alt", etc.).  You can then
  12. ; unsubscribe to the whole hierarchy with one keystroke, or you can type
  13. ; space to "explode" the hierarchy into all the second-level groups and
  14. ; hierarchies (e.g. "comp" will explode into "comp.sys", "comp.os",
  15. ; "comp.compilers", etc.).
  16. ; 
  17. ; These patches should be considered experimental, both in the sense
  18. ; that some features probably should be added (but I didn't get around
  19. ; to it, or wasn't sure just how they should work), and that it has not
  20. ; been extensively tested for bugs.
  21.  
  22. ; LCD Archive Entry:
  23. ; gnus-hier|Jim Kingdon|kingdon@east-wind.ORG|
  24. ; Patches to make GNUS a hierarchical newsreader.|
  25. ; 92-11-21||~/patches/gnus-hier.el.Z|
  26.  
  27. ; 
  28. ; *** gnus.el    Sat Nov 21 14:23:58 1992
  29. ; --- gnus-hier.el    Sat Nov 21 18:43:30 1992
  30. ; ***************
  31. ; *** 224,229 ****
  32. ; --- 224,250 ----
  33.   (defvar gnus-show-threads t
  34.     "*Show conversation threads in Subject Mode if non-nil.")
  35.   
  36. + ;;; Notes on hierarchy support:
  37. + ;;; * Right now, a hierarchy can be "exploded" into groups, but once
  38. + ;;; this is done, there is no way to "implode" a bunch of groups back
  39. + ;;; into a hierarchy.  One way to implement this would be to have gnus,
  40. + ;;; every time it starts up, look for a bunch of groups in .newsrc all of
  41. + ;;; which are in the same hierarchy, all of which have the same
  42. + ;;; subscribed/unsubscribed status, and all of which show no articles
  43. + ;;; that have been read (excluding articles no longer on the system),
  44. + ;;; and then automatically implode.
  45. + ;;; * The .newsrc written is not really compatible with non-hierarchical
  46. + ;;; newsreaders.  It might be better to rename it, or redesign things
  47. + ;;; somehow to make it easy for people to switch back and forth between
  48. + ;;; hierarchical and non-hierarchical newsreaders.  
  49. + ;;; Note that hierarchical GNUS can read a non-hierarchical .newsrc;
  50. + ;;; this feature should be preserved.
  51. + ;;; * Probably hierarchies should only be shown if some group in them
  52. + ;;; has unread news.  This is not currently the way it works.
  53. + (defvar gnus-show-hierarchies t
  54. +   "*Instead of subscribing users to new newsgroups, subscribe them to
  55. + the hierarchies which contain those groups.")
  56. + 
  57.   (defvar gnus-thread-hide-subject t
  58.     "*Non-nil means hide subjects for thread subtrees.")
  59.   
  60. ***************
  61. *** 330,335 ****
  62. --- 351,357 ----
  63.   (defvar gnus-subscribe-newsgroup-method
  64.     (function gnus-subscribe-alphabetically)
  65.     "*A function called with a newsgroup name when new newsgroup is found.
  66. + The argument is ('hierarchy name) or ('group name).
  67.   The function gnus-subscribe-randomly inserts a new newsgroup a the
  68.   beginning of newsgroups.  The function gnus-subscribe-alphabetically
  69.   inserts it in strict alphabetic order.  The function
  70. ***************
  71. *** 561,567 ****
  72.   
  73.   ;; Internal variables.
  74.   
  75. ! (defconst gnus-version "GNUS 3.14.1"
  76.     "Version numbers of this version of GNUS.")
  77.   
  78.   (defvar gnus-Info-nodes
  79. --- 583,589 ----
  80.   
  81.   ;; Internal variables.
  82.   
  83. ! (defconst gnus-version "GNUS 3.14.1 with hierarchy patches"
  84.     "Version numbers of this version of GNUS.")
  85.   
  86.   (defvar gnus-Info-nodes
  87. ***************
  88. *** 1133,1138 ****
  89. --- 1155,1161 ----
  90.     ;; Insert the message.
  91.     (insert "
  92.                      GNUS Version 3.14.1
  93. +                   with hierarchy patches
  94.   
  95.            NNTP-based News Reader for GNU Emacs
  96.   
  97. ***************
  98. *** 1193,1201 ****
  99.       (newsrc gnus-newsrc-assoc)
  100.       (group-info nil)
  101.       (group-name nil)
  102. !     (unread-count 0)
  103. !     ;; This specifies the format of Group buffer.
  104. !     (cntl "%s%s%5d: %s\n"))
  105.       (erase-buffer)
  106.       ;; List newsgroups.
  107.       (while newsrc
  108. --- 1216,1222 ----
  109.       (newsrc gnus-newsrc-assoc)
  110.       (group-info nil)
  111.       (group-name nil)
  112. !     (unread-count 0))
  113.       (erase-buffer)
  114.       ;; List newsgroups.
  115.       (while newsrc
  116. ***************
  117. *** 1204,1228 ****
  118.         (setq unread-count (nth 1 (gnus-gethash group-name gnus-unread-hashtb)))
  119.         (if (or all
  120.             (and (nth 1 group-info)    ;Subscribed.
  121. !            (> unread-count 0)))    ;There are unread articles.
  122.         ;; Yes, I can use gnus-Group-prepare-line, but this is faster.
  123. !       (insert
  124. !        (format cntl
  125. !            ;; Subscribed or not.
  126. !            (if (nth 1 group-info) " " "U")
  127. !            ;; Has new news?
  128. !            (if (and (> unread-count 0)
  129. !                 (>= 0
  130. !                 (- unread-count
  131. !                    (length
  132. !                     (cdr (assoc group-name
  133. !                         gnus-marked-assoc))))))
  134. !                "*" " ")
  135. !            ;; Number of unread articles.
  136. !            unread-count
  137. !            ;; Newsgroup name.
  138. !            group-name))
  139. !     )
  140.         (setq newsrc (cdr newsrc))
  141.         )
  142.       (setq gnus-have-all-newsgroups all)
  143. --- 1225,1257 ----
  144.         (setq unread-count (nth 1 (gnus-gethash group-name gnus-unread-hashtb)))
  145.         (if (or all
  146.             (and (nth 1 group-info)    ;Subscribed.
  147. !            (or (eq (nth 2 group-info) 'hierarchy)
  148. !                (> unread-count 0))))    ;There are unread articles.
  149.         ;; Yes, I can use gnus-Group-prepare-line, but this is faster.
  150. !       (progn
  151. !         ;; Subscribed or not.
  152. !         (insert (if (nth 1 group-info) " " "U"))
  153. !         ;; Has new news?
  154. !         (if (eq (nth 2 group-info) 'hierarchy)
  155. !         (insert "     H")
  156. !           (insert
  157. !            (if (and (> unread-count 0)
  158. !             (>= 0
  159. !                 (- unread-count
  160. !                    (length
  161. !                 (cdr (assoc group-name
  162. !                         gnus-marked-assoc))))))
  163. !            "*" " ")
  164. !            (format "%5d" unread-count))
  165. !           )
  166. ! 
  167. !         (insert
  168. !          ": "
  169. ! 
  170. !          ;; Newsgroup name.
  171. !          group-name
  172. ! 
  173. !          "\n")))
  174.         (setq newsrc (cdr newsrc))
  175.         )
  176.       (setq gnus-have-all-newsgroups all)
  177. ***************
  178. *** 1235,1262 ****
  179.   INFO is an element of gnus-newsrc-assoc or gnus-killed-assoc."
  180.     (let* ((group-name (car info))
  181.        (unread-count
  182. !       (or (nth 1 (gnus-gethash group-name gnus-unread-hashtb))
  183. !           ;; Not in hash table, so compute it now.
  184. !           (gnus-number-of-articles
  185. !            (gnus-difference-of-range
  186. !         (nth 2 (gnus-gethash group-name gnus-active-hashtb))
  187. !         (nthcdr 2 info)))))
  188. !      ;; This specifies the format of Group buffer.
  189. !      (cntl "%s%s%5d: %s\n"))
  190. !     (format cntl
  191. !         ;; Subscribed or not.
  192. !         (if (nth 1 info) " " "U")
  193. !         ;; Has new news?
  194. !         (if (and (> unread-count 0)
  195. !              (>= 0
  196. !              (- unread-count
  197. !                 (length
  198. !                  (cdr (assoc group-name gnus-marked-assoc))))))
  199. !         "*" " ")
  200. !         ;; Number of unread articles.
  201. !         unread-count
  202.           ;; Newsgroup name.
  203.           group-name
  204.           )))
  205.   
  206.   (defun gnus-Group-update-group (group &optional visible-only)
  207. --- 1264,1298 ----
  208.   INFO is an element of gnus-newsrc-assoc or gnus-killed-assoc."
  209.     (let* ((group-name (car info))
  210.        (unread-count
  211. !       (if (eq (nth 2 info) 'hierarchy)
  212. !           0
  213. !         (or (nth 1 (gnus-gethash group-name gnus-unread-hashtb))
  214. !         ;; Not in hash table, so compute it now.
  215. !         (gnus-number-of-articles
  216. !          (gnus-difference-of-range
  217. !           (nth 2 (gnus-gethash group-name gnus-active-hashtb))
  218. !           (nthcdr 2 info)))))))
  219. !     (concat
  220. !      ;; Subscribed or not.
  221. !      (if (nth 1 info) " " "U")
  222. !      ;; Has new news?
  223. !      (if (and (> unread-count 0)
  224. !           (>= 0
  225. !           (- unread-count
  226. !              (length
  227. !               (cdr (assoc group-name gnus-marked-assoc))))))
  228. !      "*" " ")
  229. !         ;; Number of unread articles or H for hierarchy
  230. !         (if (eq (nth 2 info) 'hierarchy)
  231. !                "    H"
  232. !           (format "%5d" unread-count))
  233. ! 
  234. !         ": "
  235. ! 
  236.           ;; Newsgroup name.
  237.           group-name
  238. + 
  239. +         "\n"
  240.           )))
  241.   
  242.   (defun gnus-Group-update-group (group &optional visible-only)
  243. ***************
  244. *** 1289,1295 ****
  245.     "Get newsgroup name around point."
  246.     (save-excursion
  247.       (beginning-of-line)
  248. !     (if (looking-at ".[* \t]*[0-9]+:[ \t]+\\([^ \t\n]+\\)$")
  249.       (buffer-substring (match-beginning 1) (match-end 1))
  250.         )))
  251.   
  252. --- 1325,1331 ----
  253.     "Get newsgroup name around point."
  254.     (save-excursion
  255.       (beginning-of-line)
  256. !     (if (looking-at ".[* \t]*[0-9H]+:[ \t]+\\([^ \t\n]+\\)$")
  257.       (buffer-substring (match-beginning 1) (match-end 1))
  258.         )))
  259.   
  260. ***************
  261. *** 1298,1313 ****
  262.   If argument ALL is non-nil, already read articles become readable.
  263.   If optional argument NO-ARTICLE is non-nil, no article body is displayed."
  264.     (interactive "P")
  265. !   (let ((group (gnus-Group-group-name))) ;Newsgroup name to read.
  266.       (if group
  267. !     (gnus-Subject-read-group
  268. !      group
  269. !      (or all
  270. !          ;;(not (nth 1 (assoc group gnus-newsrc-assoc)))    ;Unsubscribed
  271. !          (zerop
  272. !           (nth 1 (gnus-gethash group gnus-unread-hashtb))))    ;No unread
  273. !      no-article
  274. !      ))
  275.       ))
  276.   
  277.   (defun gnus-Group-select-group (all)
  278. --- 1334,1383 ----
  279.   If argument ALL is non-nil, already read articles become readable.
  280.   If optional argument NO-ARTICLE is non-nil, no article body is displayed."
  281.     (interactive "P")
  282. !   (let ((group (gnus-Group-group-name)) ;Newsgroup name to read.
  283. !     (tail gnus-newsrc-assoc)
  284. !     (prev nil))
  285.       (if group
  286. !     (progn
  287. !       ;; First, find the group in gnus-newsrc-assoc so we know
  288. !       ;; whether it is a hierarchy.
  289. !       (catch 'exit-loop
  290. !         (while tail
  291. !           (if (string= (car (car tail)) group)
  292. !           (throw 'exit-loop nil))
  293. !           (setq prev tail)
  294. !           (setq tail (cdr tail))))
  295. !       (if (eq (nth 2 (car tail)) 'hierarchy)
  296. !           (progn
  297. !         (message "Exploding hierarchy %s..." group)
  298. !         ;; Delete group from gnus-newsrc-assoc
  299. !         (if prev
  300. !             (setcdr prev (cdr tail))
  301. !           (setq gnus-newsrc-assoc (cdr tail)))
  302. !         (gnus-update-newsrc-buffer group 'delete)
  303. !         ;; Subscribe to groups and hierarchies
  304. !         ;; one level down from group
  305. !         (let ((new-newsgroups (gnus-find-new-newsgroups group)))
  306. !           (while new-newsgroups
  307. !             (funcall gnus-subscribe-newsgroup-method
  308. !                  (car new-newsgroups))
  309. !             (setq new-newsgroups (cdr new-newsgroups))
  310. !             ))
  311. !         (message "Exploding hierarchy %s...done" group)
  312. !         ;; This is not necessarily the cleanest way to show them;
  313. !         ;; i.e. does it cause unpleasant changes to the display?
  314. !         (gnus-Group-list-groups gnus-have-all-newsgroups)
  315. !         )
  316. !         ;; It's a group.  Read it.
  317. !         (gnus-Subject-read-group
  318. !          group
  319. !          (or all
  320. !          ;;(not (nth 1 (assoc group gnus-newsrc-assoc)))    ;Unsubscribed
  321. !          (zerop
  322. !           (nth 1 (gnus-gethash group gnus-unread-hashtb))))    ;No unread
  323. !          no-article
  324. !          )
  325. !         )))
  326.       ))
  327.   
  328.   (defun gnus-Group-select-group (all)
  329. ***************
  330. *** 1339,1345 ****
  331.       (regexp 
  332.        (format "^%s[ \t]*\\(%s\\):"
  333.            (if any-group ".." " [ \t]")
  334. !          (if any-group "[0-9]+" "[1-9][0-9]*")))
  335.       (found nil))
  336.       (if backward
  337.       (beginning-of-line)
  338. --- 1409,1415 ----
  339.       (regexp 
  340.        (format "^%s[ \t]*\\(%s\\):"
  341.            (if any-group ".." " [ \t]")
  342. !          (if any-group "[0-9H]+" "[1-9][0-9]*")))
  343.       (found nil))
  344.       (if backward
  345.       (beginning-of-line)
  346. ***************
  347. *** 4575,4581 ****
  348.     (let ((groups gnus-newsrc-assoc)
  349.       (before nil))
  350.       (while (and (not before) groups)
  351. !       (if (string< newgroup (car (car groups)))
  352.         (setq before (car (car groups)))
  353.       (setq groups (cdr groups))))
  354.       (gnus-subscribe-newsgroup newgroup before)
  355. --- 4645,4651 ----
  356.     (let ((groups gnus-newsrc-assoc)
  357.       (before nil))
  358.       (while (and (not before) groups)
  359. !       (if (string< (car (cdr newgroup)) (car (car groups)))
  360.         (setq before (car (car groups)))
  361.       (setq groups (cdr groups))))
  362.       (gnus-subscribe-newsgroup newgroup before)
  363. ***************
  364. *** 4586,4592 ****
  365.     ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
  366.     (save-excursion
  367.       (set-buffer (find-file-noselect gnus-current-startup-file))
  368. !     (let ((groupkey newgroup)
  369.         (before nil))
  370.         (while (and (not before) groupkey)
  371.       (goto-char (point-min))
  372. --- 4656,4662 ----
  373.     ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
  374.     (save-excursion
  375.       (set-buffer (find-file-noselect gnus-current-startup-file))
  376. !     (let ((groupkey (car (cdr newgroup)))
  377.         (before nil))
  378.         (while (and (not before) groupkey)
  379.       (goto-char (point-min))
  380. ***************
  381. *** 4596,4602 ****
  382.                 (progn
  383.               (setq before (buffer-substring
  384.                         (match-beginning 1) (match-end 1)))
  385. !             (string< before newgroup)))
  386.           ))
  387.       ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
  388.       (setq groupkey
  389. --- 4666,4672 ----
  390.                 (progn
  391.               (setq before (buffer-substring
  392.                         (match-beginning 1) (match-end 1)))
  393. !             (string< before (car (cdr newgroup)))))
  394.           ))
  395.       ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
  396.       (setq groupkey
  397. ***************
  398. *** 4606,4615 ****
  399.         )))
  400.   
  401.   (defun gnus-subscribe-newsgroup (newsgroup &optional next)
  402. !   "Subscribe new NEWSGROUP.
  403.   If optional argument NEXT is non-nil, it is inserted before NEXT."
  404. !   (gnus-insert-newsgroup (list newsgroup t) next)
  405. !   (message "Newsgroup %s is subscribed" newsgroup))
  406.   
  407.   ;; For directories
  408.   
  409. --- 4676,4691 ----
  410.         )))
  411.   
  412.   (defun gnus-subscribe-newsgroup (newsgroup &optional next)
  413. !   "Subscribe new NEWSGROUP, which is a list ('group name) or ('hierarchy name).
  414.   If optional argument NEXT is non-nil, it is inserted before NEXT."
  415. !   (gnus-insert-newsgroup
  416. !    (if (eq (car newsgroup) 'hierarchy)
  417. !        (list (car (cdr newsgroup)) t 'hierarchy)
  418. !      (list (car (cdr newsgroup)) t))
  419. !    next)
  420. !   (message "%s %s is subscribed"
  421. !        (if (eq (car newsgroup) 'hierarchy) "Hierarchy" "Newsgroup")
  422. !        (car (cdr newsgroup))))
  423.   
  424.   ;; For directories
  425.   
  426. ***************
  427. *** 5671,5678 ****
  428.   
  429.   ;; GNUS internal format of gnus-newsrc-assoc and gnus-killed-assoc:
  430.   ;; (("general" t (1 . 1))
  431. ! ;;  ("misc"    t (1 . 10) (12 . 15))
  432. ! ;;  ("test"  nil (1 . 99)) ...)
  433.   ;; GNUS internal format of gnus-marked-assoc:
  434.   ;; (("general" 1 2 3)
  435.   ;;  ("misc" 2) ...)
  436. --- 5747,5755 ----
  437.   
  438.   ;; GNUS internal format of gnus-newsrc-assoc and gnus-killed-assoc:
  439.   ;; (("general" t (1 . 1))
  440. ! ;;  ("misc.foo"    t (1 . 10) (12 . 15))
  441. ! ;;  ("test"  nil (1 . 99))
  442. ! ;;  ("talk"  nil 'hierarchy) ...)
  443.   ;; GNUS internal format of gnus-marked-assoc:
  444.   ;; (("general" 1 2 3)
  445.   ;;  ("misc" 2) ...)
  446. ***************
  447. *** 5720,5744 ****
  448.                     (list newsgroup t))
  449.                     (car (car gnus-newsrc-assoc)))))
  450.   
  451. ! (defun gnus-find-new-newsgroups ()
  452. !   "Looking for new newsgroups and return names.
  453. ! `-n' option of options line in .newsrc file is recognized."
  454.     (let ((group nil)
  455.       (new-newsgroups nil))
  456.       (mapatoms
  457.        (function
  458.         (lambda (sym)
  459.       (setq group (symbol-name sym))
  460.       ;; Taking account of `-n' option.
  461.       (and (or (null gnus-newsrc-options-n-no)
  462.            (not (string-match gnus-newsrc-options-n-no group))
  463.            (and gnus-newsrc-options-n-yes
  464.                 (string-match gnus-newsrc-options-n-yes group)))
  465. !          (null (assoc group gnus-killed-assoc)) ;Ignore killed.
  466. !          (null (assoc group gnus-newsrc-assoc)) ;Really new.
  467. !          ;; Find new newsgroup.
  468. !          (setq new-newsgroups
  469. !            (cons group new-newsgroups)))
  470.       ))
  471.        gnus-active-hashtb)
  472.       ;; Return new newsgroups.
  473. --- 5797,5960 ----
  474.                     (list newsgroup t))
  475.                     (car (car gnus-newsrc-assoc)))))
  476.   
  477. ! (defun gnus-group-is-new (group)
  478. !   "Return true if GROUP is not found in gnus-newsrc-assoc or
  479. ! gnus-killed-assoc, either as itself or as a hierarchy which includes
  480. ! GROUP."
  481. !   (catch 'return
  482. !     (let ((group-okay t) ;if nil, need a hierarchy
  483. !       (group-found nil))
  484. !       (while t
  485. !     (setq group-found (or (assoc group gnus-killed-assoc)
  486. !                   (assoc group gnus-newsrc-assoc)))
  487. !     (if (and group-found
  488. !          (or group-okay (eq (nth 2 group-found) 'hierarchy))
  489. !          )
  490. !         (throw 'return nil))
  491. !     (if (not (string-match "\\.[^.]*$" group)) (throw 'return t))
  492. !     (setq group (substring group 0 (match-beginning 0)))
  493. !     (setq group-okay nil)
  494. !     ))))
  495. ! 
  496. ! (defun gnus-find-new-newsgroups (&optional prefix)
  497. !   "Look for new newsgroups and return names.
  498. ! `-n' option of options line in .newsrc file is recognized.
  499. ! Return value is a list each element of which is 
  500. !   ('group name) or ('hierarchy name).
  501. ! If PREFIX is specified, it is the name of a hierarchy.  Don't return
  502. ! that hierarchy, instead return an entry for each group or hierarchy
  503. ! underneath that hierarchy.  New groups not under the PREFIX hierarchy
  504. ! are not included in the return value."
  505. !   (if (null prefix)
  506. !       (setq prefix ""))
  507.     (let ((group nil)
  508. +     (group-length 0)
  509.       (new-newsgroups nil))
  510.       (mapatoms
  511.        (function
  512.         (lambda (sym)
  513.       (setq group (symbol-name sym))
  514. +     (setq group-length (length group))
  515.       ;; Taking account of `-n' option.
  516.       (and (or (null gnus-newsrc-options-n-no)
  517.            (not (string-match gnus-newsrc-options-n-no group))
  518.            (and gnus-newsrc-options-n-yes
  519.                 (string-match gnus-newsrc-options-n-yes group)))
  520. !          (>= group-length (length prefix))
  521. !          (string= (substring group 0 (length prefix)) prefix)
  522. !          (gnus-group-is-new group)
  523. !          ;; OK, we got a group which is new.
  524. !          ;; Find what newsgroup or hierarchy we want to add.
  525. !          (let ((new-entry
  526. !             (if (not gnus-show-hierarchies)
  527. !             (list 'group group)
  528. !               ;; Find the most general hierarchy which applies
  529. !               (let ((newsrc gnus-newsrc-assoc)
  530. !                 (spare-assoc gnus-killed-assoc)
  531. !                 (longest-match prefix)
  532. !                 (longest-match-length 0)
  533. !                 (test-string nil)
  534. !                 (test-string-length 0))
  535. !             (setq longest-match-length (length longest-match))
  536. !             (while newsrc
  537. !               (setq test-string (car (car newsrc)))
  538. !               (setq test-string-length (length test-string))
  539. !               (while (> test-string-length longest-match-length)
  540. !                 ;; Would the following be faster? Does it matter?
  541. !                 ;; (and (< test-string-length group-length)
  542. !                 ;;      (string= 
  543. !                 ;;       test-string
  544. !                 ;;       (substring group test-string-length)))
  545. !                 (if (string-match
  546. !                  (concat "^" (regexp-quote test-string))
  547. !                  group)
  548. !                 (progn
  549. !                   (setq longest-match test-string)
  550. !                   (setq longest-match-length
  551. !                     test-string-length))
  552. !                   (if (not (string-match "\\.[^.]*$" test-string))
  553. !                   ;; OK, we've tested everything
  554. !                   (setq test-string-length 0)
  555. !                 (progn
  556. !                   (setq test-string-length (match-beginning 0))
  557. !                   (setq test-string
  558. !                     (substring
  559. !                      test-string 0 test-string-length))
  560. !                   )
  561. !                   )))
  562. !               (setq newsrc (cdr newsrc))
  563. !               (if (null newsrc)
  564. !                   (progn
  565. !                 (setq newsrc spare-assoc)
  566. !                 (setq spare-assoc nil)))
  567. !               )
  568. !             ;; OK, take one more level beyond longest-match.
  569. !             ;; skip the period
  570. !             (if (< longest-match-length group-length)
  571. !                 (setq longest-match-length
  572. !                   (1+ longest-match-length))
  573. !               )
  574. !             (while (and
  575. !                 (< longest-match-length group-length)
  576. !                 (not (string-equal
  577. !                       (substring
  578. !                        group
  579. !                        longest-match-length
  580. !                        (1+ longest-match-length))
  581. !                       ".")))
  582. !               (setq longest-match-length
  583. !                 (1+ longest-match-length)))
  584. !             (if (= longest-match-length group-length)
  585. !                 (list 'group group)
  586. !               (list 'hierarchy
  587. !                 (substring group 0 longest-match-length))
  588. !               )))
  589. !             ))
  590. !            (catch 'got-it
  591. !          (let ((tail new-newsgroups)
  592. !                (group-name (car (cdr new-entry))))
  593. !            (while tail
  594. !              (if (string= (car (cdr (car tail))) group-name)
  595. !              (if (and (eq (car (car tail)) 'group)
  596. !                   (eq (car new-entry) 'hierarchy))
  597. !                  ;; If we are trying to add, for
  598. !                  ;; example, ('hierarchy "misc.consumers")
  599. !                  ;; and ('group "misc.consumers") is
  600. !                  ;; already in there, nuke the 'group
  601. !                  ;; entry and put in the hierarchy.  This
  602. !                  ;; is because logically speaking the
  603. !                  ;; group "misc.consumers" is part of the
  604. !                  ;; "misc.consumers" hierarchy, yet we
  605. !                  ;; don't know there is such a hierarchy
  606. !                  ;; until we find the group
  607. !                  ;; "misc.consumers.house".
  608. !                  (progn
  609. !                    (setcar (car tail) 'hierarchy)
  610. !                    (throw 'got-it nil)
  611. !                    )
  612. !                ;; They are both the same hierarchy, which we see
  613. !                ;; twice, for example, if newgroups are sent out
  614. !                ;; for comp.sys.mac.lawsuits and
  615. !                ;; comp.sys.mac.user-interface
  616. !                ;; at the same time.  Since it's already there,
  617. !                ;; don't need to do anything else
  618. ! 
  619. !                ;; The one from new-entry being a hierarchy
  620. !                ;; and the other a group we already checked for.
  621. !                ;; The one from new-entry being a group and
  622. !                ;; the other a hierarchy, or both being groups,
  623. !                ;; "can't happen".
  624. !                (throw 'got-it nil)
  625. !                )
  626. !                (setq tail (cdr tail))
  627. !                ))
  628. !            ;; It is genuinely new.  Add it.
  629. !            (setq new-newsgroups
  630. !              (cons new-entry
  631. !                    new-newsgroups))
  632. !            ))
  633. !          )
  634. !          )
  635.       ))
  636.        gnus-active-hashtb)
  637.       ;; Return new newsgroups.
  638. ***************
  639. *** 5772,5779 ****
  640.         (error "Invalid argument: %s" info))
  641.     (let* ((group (car info))        ;Newsgroup name.
  642.        (range
  643. !       (gnus-difference-of-range
  644. !        (nth 2 (gnus-gethash group gnus-active-hashtb)) (nthcdr 2 info))))
  645.       ;; Check duplication.
  646.       (if (assoc group gnus-newsrc-assoc)
  647.       (error "Duplicated: %s" group))
  648. --- 5988,5997 ----
  649.         (error "Invalid argument: %s" info))
  650.     (let* ((group (car info))        ;Newsgroup name.
  651.        (range
  652. !       (or (eq 'hierarchy (nth 2 info))
  653. !           (gnus-difference-of-range
  654. !            (nth 2 (gnus-gethash group gnus-active-hashtb))
  655. !            (nthcdr 2 info)))))
  656.       ;; Check duplication.
  657.       (if (assoc group gnus-newsrc-assoc)
  658.       (error "Duplicated: %s" group))
  659. ***************
  660. *** 5802,5812 ****
  661.       ;; Then insert to .newsrc.
  662.       (gnus-update-newsrc-buffer group nil next)
  663.       ;; Add to gnus-unread-hashtb.
  664. !     (gnus-sethash group
  665. !           (cons group        ;Newsgroup name.
  666. !             (cons (gnus-number-of-articles range) range))
  667. !           gnus-unread-hashtb)
  668. !     ))
  669.   
  670.   (defun gnus-check-killed-newsgroups ()
  671.     "Check consistency between gnus-newsrc-assoc and gnus-killed-assoc."
  672. --- 6020,6032 ----
  673.       ;; Then insert to .newsrc.
  674.       (gnus-update-newsrc-buffer group nil next)
  675.       ;; Add to gnus-unread-hashtb.
  676. !     (or (eq 'hierarchy (nth 2 info))
  677. !     (gnus-sethash group
  678. !               (cons group        ;Newsgroup name.
  679. !                 (cons (gnus-number-of-articles range) range))
  680. !               gnus-unread-hashtb)
  681. !     ))
  682. !     )
  683.   
  684.   (defun gnus-check-killed-newsgroups ()
  685.     "Check consistency between gnus-newsrc-assoc and gnus-killed-assoc."
  686. ***************
  687. *** 5893,5914 ****
  688.       (while read
  689.         (setq group-info (car read))    ;About one newsgroup
  690.         (setq group-name (car group-info))
  691. !       (setq active (nth 2 (gnus-gethash group-name gnus-active-hashtb)))
  692. !       (if (and gnus-octive-hashtb
  693. !            ;; Is nothing changed?
  694. !            (equal active
  695. !               (nth 2 (gnus-gethash group-name gnus-octive-hashtb)))
  696. !            ;; Is this newsgroup in the unread hash table?
  697. !            (gnus-gethash group-name gnus-unread-hashtb)
  698. !            )
  699. !       nil                ;Nothing to do.
  700. !     (setq range (gnus-difference-of-range active (nthcdr 2 group-info)))
  701. !     (gnus-sethash group-name
  702. !               (cons group-name    ;Group name
  703. !                 (cons (gnus-number-of-articles range)
  704. !                   range)) ;Range of unread articles
  705. !               gnus-unread-hashtb)
  706. !     )
  707.         (setq read (cdr read))
  708.         )
  709.       (message "Checking new news... done")
  710. --- 6113,6140 ----
  711.       (while read
  712.         (setq group-info (car read))    ;About one newsgroup
  713.         (setq group-name (car group-info))
  714. !       (if (not (eq (nth 2 group-info) 'hierarchy))
  715. !       (progn
  716. !         (setq active
  717. !           (nth 2 (gnus-gethash group-name gnus-active-hashtb)))
  718. !         (if (and gnus-octive-hashtb
  719. !              ;; Is nothing changed?
  720. !              (equal active
  721. !                 (nth 2
  722. !                  (gnus-gethash group-name gnus-octive-hashtb)))
  723. !              ;; Is this newsgroup in the unread hash table?
  724. !              (gnus-gethash group-name gnus-unread-hashtb)
  725. !              )
  726. !         nil                ;Nothing to do.
  727. !           (setq range
  728. !             (gnus-difference-of-range active (nthcdr 2 group-info)))
  729. !           (gnus-sethash group-name
  730. !                 (cons group-name    ;Group name
  731. !                   (cons (gnus-number-of-articles range)
  732. !                     range)) ;Range of unread articles
  733. !                 gnus-unread-hashtb)
  734. !           )
  735. !         ))
  736.         (setq read (cdr read))
  737.         )
  738.       (message "Checking new news... done")
  739. ***************
  740. *** 6211,6217 ****
  741.              ":" (buffer-substring (match-beginning 2) (match-end 2))))
  742.       (setq ranges (buffer-substring (match-beginning 3) (match-end 3)))
  743.       (setq read-list nil)
  744. !     (while (string-match "^[, \t]*\\([0-9-]+\\)" ranges)
  745.         (setq subrange (substring ranges (match-beginning 1) (match-end 1)))
  746.         (setq ranges (substring ranges (match-end 1)))
  747.         (cond ((string-match "^\\([0-9]+\\)-\\([0-9]+\\)$" subrange)
  748. --- 6437,6443 ----
  749.              ":" (buffer-substring (match-beginning 2) (match-end 2))))
  750.       (setq ranges (buffer-substring (match-beginning 3) (match-end 3)))
  751.       (setq read-list nil)
  752. !     (while (string-match "^[, \t]*\\([0-9-h]+\\)" ranges)
  753.         (setq subrange (substring ranges (match-beginning 1) (match-end 1)))
  754.         (setq ranges (substring ranges (match-end 1)))
  755.         (cond ((string-match "^\\([0-9]+\\)-\\([0-9]+\\)$" subrange)
  756. ***************
  757. *** 6229,6234 ****
  758. --- 6455,6462 ----
  759.                  (cons (cons (string-to-int subrange)
  760.                      (string-to-int subrange))
  761.                    read-list)))
  762. +         ((string-match "^h$" subrange)
  763. +          (setq read-list (cons 'hierarchy nil)))
  764.           (t
  765.            (ding) (message "Ignoring bogus lines of %s" newsgroup)
  766.            (sit-for 0))
  767. ***************
  768. *** 6404,6409 ****
  769. --- 6632,6639 ----
  770.   
  771.   (defun gnus-ranges-to-newsrc-format (ranges)
  772.     "Insert ranges of read articles."
  773. +   (if (eq (car ranges) 'hierarchy)
  774. +       (insert "h")
  775.     (let ((range nil))            ;Range is a pair of BEGIN and END.
  776.       (while ranges
  777.         (setq range (car ranges))
  778. ***************
  779. *** 6421,6426 ****
  780. --- 6651,6657 ----
  781.            (if ranges (insert ","))
  782.            ))
  783.         )))
  784. +   )
  785.   
  786.   (defun gnus-compress-sequence (numbers)
  787.     "Convert list of sorted numbers to ranges."
  788.