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