home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #31 / NN_1992_31.iso / spool / gnu / emacs / sources / 914 < prev    next >
Encoding:
Text File  |  1992-12-31  |  16.7 KB  |  501 lines
  1. Xref: sparky gnu.emacs.sources:914 gnu.emacs.gnus:1443
  2. Path: sparky!uunet!spool.mu.edu!wupost!csus.edu!ucdavis!caldwr!rfinch
  3. From: rfinch@caldwr.water.ca.gov (Ralph Finch)
  4. Newsgroups: gnu.emacs.sources,gnu.emacs.gnus
  5. Subject: gnus-3.14: aging kill lines
  6. Keywords: kill files
  7. Message-ID: <949@caldwr.water.ca.gov>
  8. Date: 1 Jan 93 03:54:54 GMT
  9. Followup-To: gnu.emacs.gnus
  10. Organization: Calif. Dept. of Water Resources, Sac.
  11. Lines: 488
  12.  
  13.  
  14. Following is a patch to implement 2 additions to gnus-3.14 kill files:
  15. easy kills and aging kills.
  16.  
  17. WARNING: THIS PATCH IS EXPERIMENTAL.  Please don't use it until you've
  18. backed up your .newsrc* files and your kill files, and your gnus.el
  19. file.  Hopefully a few people will be willing to try this for a while,
  20. make suggestions, and eventually I'll release a non-beta version.
  21.  
  22. You will need timezone.el to use this; I think it comes with gnus-3.14.
  23.  
  24. Explanation.  I use C-k (and sometimes k) a lot in subject buffers to
  25. zip through uninteresting articles.  But when I exit gnus and start it
  26. up the next day, the same articles (threads) appear again, of course.
  27. Firing up kill files all the time is too cumbersome for me.  So I
  28. wanted an easy way to place subject lines killed with C-k and k in
  29. kill files.
  30.  
  31. However, that brings up another problem: huge kill files.  You need
  32. some way of deleting the old kill lines automatically after they've
  33. served their purpose.
  34.  
  35. This patch implements both of the above ideas.
  36.  
  37. After installing the patch, the first concept (easy kill files), is
  38. activated with the variable gnus-save-kills.  If non-nil (default), it
  39. will place the subject line of every C-k or k in the proper kill file,
  40. and also put the line '(gnus-expunge "X")' at the end of the file if
  41. it's not there already.  That way when you look at that group the next
  42. day, the old subjects will be automatically killed for you.
  43.  
  44. The second concept, aging kill lines, is implemented with two
  45. variables, gnus-max-creation-intrvl and gnus-max-hit-intrvl.  These
  46. two variables control how many days to allow before deleting kill
  47. lines in kill files, after creation of the line and its last 'hit',
  48. that is, when that kill line last killed anything.  Default values are
  49. 30 days and 10 days respectively.  You can use both of these, or
  50. either one; set them to nil to turn them off.  If these are some
  51. integer value, gnus will put the current date for each one after a
  52. comment on each line in your kill files.  The creation date will then
  53. never change; the hit date will be updated every time that line gets a
  54. hit.  If, when initially going through a kill file, gnus sees that
  55. either interval is exceeded, it will delete that line, thus preventing
  56. your kill files from growing forever with obsolete kills.
  57.  
  58. Kill files are now automatically saved when you exit gnus.
  59.  
  60. You can still hand edit your kill files in the usual way, they will
  61. just have dates in them.  Aging kill lines works with both subject and
  62. author kill lines.  Also, new style kill files can still be read by an
  63. original gnus-3.14.
  64.  
  65. There's one other new variable: gnus-kill-header-length.  Set this to
  66. some int (default is 20) to specify the length of a center subsection
  67. of a subject line to use in kill files.  This prevents missing kills
  68. because of Re: stuck on the front, or some other often subtle change
  69. in a subject line.
  70.  
  71. Please send comments and bug reports to rfinch@water.ca.gov.
  72.  
  73. *** gnus.el~    1992/12/02 01:28:34
  74. --- gnus.el    1992/12/16 00:49:36
  75. ***************
  76. *** 109,114 ****
  77. --- 110,116 ----
  78.   (provide 'gnus)
  79.   (require 'nntp)
  80.   (require 'mail-utils)
  81. + (require 'timezone)
  82.   
  83.   (defvar gnus-nntp-server (getenv "NNTPSERVER")
  84.     "*The name of the host running NNTP server.
  85. ***************
  86. *** 558,563 ****
  87. --- 560,578 ----
  88.   (defvar gnus-Info-directory Info-directory
  89.     "*A directory placing an Info file of GNUS.")
  90.   
  91. + (defvar gnus-max-creation-intrvl 30
  92. +   "*Maximum days to allow a kill item to exist since creation;
  93. + nil if no limit.")
  94. + (defvar gnus-max-hit-intrvl 10
  95. +   "*Maximum days to allow a kill item to exist since last hit;
  96. + nil if no limit.")
  97. + (defvar gnus-save-kills t
  98. +   "*If non-nil, when \\[gnus-Subject-kill-same-subject] is done,
  99. + save in kill file also.")
  100. + (defvar gnus-kill-header-length 20
  101. +   "*If int, the length of a center substring to save from the
  102. + subject line when used in kill files.")
  103. + 
  104.   
  105.   ;; Internal variables.
  106.   
  107. ***************
  108. *** 709,714 ****
  109. --- 724,732 ----
  110.   (defvar rmail-last-file (expand-file-name "~/XMBOX"))
  111.   (defvar rmail-last-rmail-file (expand-file-name "~/XNEWS"))
  112.   
  113. + (defvar gnus-successful-kill nil
  114. +   "t if gnus-kill was successful.")
  115. + 
  116.   ;; Define GNUS Subsystems.
  117.   (autoload 'gnus-Group-post-news "gnuspost"
  118.         "Post an article." t)
  119. ***************
  120. *** 1537,1542 ****
  121. --- 1555,1561 ----
  122.         (progn
  123.       (message "")            ;Erase "Yes or No" question.
  124.       (run-hooks 'gnus-Exit-gnus-hook)
  125. +     (gnus-exit-kill-files)
  126.       (gnus-save-newsrc-file)
  127.       (gnus-clear-system)
  128.       (gnus-close-server))
  129. ***************
  130. *** 1749,1756 ****
  131.   \\[gnus-Subject-catch-up-all-and-exit]
  132.       Catch up all articles, and then exit the current newsgroup.
  133.   C-t    Toggle truncations of subject lines.
  134. - x    Delete subject lines marked as read.
  135. - X    Delete subject lines with the specific marks.
  136.   C-c C-s C-n    Sort subjects by article number.
  137.   C-c C-s C-a    Sort subjects by article author.
  138.   C-c C-s C-s    Sort subjects alphabetically.
  139. --- 1768,1773 ----
  140. ***************
  141. *** 2977,2982 ****
  142. --- 2994,3016 ----
  143.     (let ((count
  144.        (gnus-Subject-mark-same-subject
  145.         (gnus-Subject-subject-string) unmark)))
  146. +     ;; save in kill file if desired
  147. +     (if gnus-save-kills
  148. +     (progn
  149. +       (setq gnus-current-kill-article (gnus-Subject-article-number))
  150. +       (save-excursion
  151. +         (find-file (gnus-newsgroup-kill-file gnus-newsgroup-name))
  152. +         (save-excursion
  153. +           (beginning-of-buffer)
  154. +           (gnus-Kill-file-kill-by-subject)
  155. +           ;; add gnus-expunge at end of buffer, if needed
  156. +           (if (not (re-search-forward "^ *\(gnus-expunge" nil t))
  157. +           (progn
  158. +             (end-of-buffer)
  159. +             (if (not (bolp))
  160. +             (insert "\n"))
  161. +             (insert "(gnus-expunge \"X\")\n"))))
  162. +         (bury-buffer))))
  163.       ;; Select next unread article. If auto-select-same mode, should
  164.       ;; select the first unread article.
  165.       (gnus-Subject-next-article t (and gnus-auto-select-same
  166. ***************
  167. *** 2995,3000 ****
  168. --- 3029,3051 ----
  169.     (let ((count
  170.        (gnus-Subject-mark-same-subject
  171.         (gnus-Subject-subject-string) unmark)))
  172. +     ;; save in kill file if desired
  173. +     (if gnus-save-kills
  174. +     (progn
  175. +       (setq gnus-current-kill-article (gnus-Subject-article-number))
  176. +       (save-excursion
  177. +         (find-file (gnus-newsgroup-kill-file gnus-newsgroup-name))
  178. +         (save-excursion
  179. +           (beginning-of-buffer)
  180. +           (gnus-Kill-file-kill-by-subject)
  181. +           ;; add gnus-expunge at end of buffer, if needed
  182. +           (if (not (re-search-forward "^ *\(gnus-expunge" nil t))
  183. +           (progn
  184. +             (end-of-buffer)
  185. +             (if (not (bolp))
  186. +             (insert "\n"))
  187. +             (insert "(gnus-expunge \"X\")\n"))))
  188. +         (bury-buffer))))
  189.       ;; If marked as read, go to next unread subject.
  190.       (if (null unmark)
  191.       ;; Go to next unread subject.
  192. ***************
  193. *** 3149,3164 ****
  194.   (defun gnus-Subject-delete-marked-with (marks)
  195.     "Delete lines which are marked with MARKS (e.g. \"DK\")."
  196.     (interactive "sMarks: ")
  197. !   (let ((buffer-read-only nil))
  198. !     (save-excursion
  199. !       (goto-char (point-min))
  200. !       (delete-matching-lines (concat "^[" marks "]")))
  201. !     ;; Adjust point.
  202. !     (or (zerop (buffer-size))
  203. !     (if (eobp)
  204. !         (gnus-Subject-prev-subject 1)
  205. !       (beginning-of-line)
  206. !       (search-forward ":" nil t)))
  207.       ))
  208.   
  209.   ;; Thread-based commands.
  210. --- 3200,3217 ----
  211.   (defun gnus-Subject-delete-marked-with (marks)
  212.     "Delete lines which are marked with MARKS (e.g. \"DK\")."
  213.     (interactive "sMarks: ")
  214. !   (save-excursion
  215. !     (set-buffer gnus-Subject-buffer)
  216. !     (let ((buffer-read-only nil))
  217. !       (save-excursion
  218. !     (goto-char (point-min))
  219. !     (delete-matching-lines (concat "^[" marks "]")))
  220. !       ;; Adjust point.
  221. !       (or (zerop (buffer-size))
  222. !       (if (eobp)
  223. !           (gnus-Subject-prev-subject 1)
  224. !         (beginning-of-line)
  225. !         (search-forward ":" nil t))))
  226.       ))
  227.   
  228.   ;; Thread-based commands.
  229. ***************
  230. *** 4310,4331 ****
  231.     "Insert KILL command for current subject."
  232.     (interactive)
  233.     (insert
  234. !    (format "(gnus-kill \"Subject\" %s)\n"
  235.          (prin1-to-string
  236.           (if gnus-current-kill-article
  237.           (regexp-quote
  238. !          (nntp-header-subject
  239. !           ;; No need to speed up this command.
  240. !           ;;(gnus-get-header-by-number gnus-current-kill-article)
  241. !           (gnus-find-header-by-number gnus-newsgroup-headers
  242. !                           gnus-current-kill-article)))
  243. !           "")))))
  244.   
  245.   (defun gnus-Kill-file-kill-by-author ()
  246.     "Insert KILL command for current author."
  247.     (interactive)
  248.     (insert
  249. !    (format "(gnus-kill \"From\" %s)\n"
  250.          (prin1-to-string
  251.           (if gnus-current-kill-article
  252.           (regexp-quote
  253. --- 4363,4397 ----
  254.     "Insert KILL command for current subject."
  255.     (interactive)
  256.     (insert
  257. !    (format "(gnus-kill \"Subject\" %s)%s%s\n"
  258.          (prin1-to-string
  259.           (if gnus-current-kill-article
  260.           (regexp-quote
  261. !          (let ((lendiff nil)
  262. !                (str (nntp-header-subject
  263. !                  ;; No need to speed up this command.
  264. !                  ;;(gnus-get-header-by-number gnus-current-kill-article)
  265. !                  (gnus-find-header-by-number gnus-newsgroup-headers
  266. !                              gnus-current-kill-article))))
  267. !            (if (and gnus-kill-header-length
  268. !                 (> (setq lendiff2 (/ (- (length str)
  269. !                             gnus-kill-header-length)
  270. !                          2)) 0))
  271. !                (substring str lendiff2 (- lendiff2))
  272. !              str)))
  273. !           ""))
  274. !        (if gnus-max-creation-intrvl
  275. !            (concat "; creation-date #" (current-time-string) "#")
  276. !          "")
  277. !        (if gnus-max-hit-intrvl
  278. !            (concat "; hit-date #" (current-time-string) "#")
  279. !          ""))))
  280.   
  281.   (defun gnus-Kill-file-kill-by-author ()
  282.     "Insert KILL command for current author."
  283.     (interactive)
  284.     (insert
  285. !    (format "(gnus-kill \"From\" %s)%s%s\n"
  286.          (prin1-to-string
  287.           (if gnus-current-kill-article
  288.           (regexp-quote
  289. ***************
  290. *** 4334,4340 ****
  291.             ;;(gnus-get-header-by-number gnus-current-kill-article)
  292.             (gnus-find-header-by-number gnus-newsgroup-headers
  293.                             gnus-current-kill-article)))
  294. !           "")))))
  295.   
  296.   (defun gnus-Kill-file-apply-buffer ()
  297.     "Apply current buffer to current newsgroup."
  298. --- 4400,4413 ----
  299.             ;;(gnus-get-header-by-number gnus-current-kill-article)
  300.             (gnus-find-header-by-number gnus-newsgroup-headers
  301.                             gnus-current-kill-article)))
  302. !           ""))
  303. !        (if gnus-max-creation-intrvl
  304. !            (concat "; creation-date #" (current-time-string) "#")
  305. !          "")
  306. !        (if gnus-max-hit-intrvl
  307. !            (concat "; hit-date #" (current-time-string) "#")
  308. !          ""))))
  309. ! 
  310.   
  311.   (defun gnus-Kill-file-apply-buffer ()
  312.     "Apply current buffer to current newsgroup."
  313. ***************
  314. *** 4367,4373 ****
  315.   (defun gnus-Kill-file-exit ()
  316.     "Save a KILL file, then return to the previous buffer."
  317.     (interactive)
  318. !   (save-buffer)
  319.     (let ((killbuf (current-buffer)))
  320.       ;; We don't want to return to Article buffer.
  321.       (and (get-buffer gnus-Article-buffer)
  322. --- 4440,4446 ----
  323.   (defun gnus-Kill-file-exit ()
  324.     "Save a KILL file, then return to the previous buffer."
  325.     (interactive)
  326. !   (if (buffer-modified-p) (save-buffer))
  327.     (let ((killbuf (current-buffer)))
  328.       ;; We don't want to return to Article buffer.
  329.       (and (get-buffer gnus-Article-buffer)
  330. ***************
  331. *** 4519,4527 ****
  332.   (defun gnus-apply-kill-file ()
  333.     "Apply KILL file to the current newsgroup."
  334.     ;; Apply the global KILL file.
  335. !   (load (gnus-newsgroup-kill-file nil) t nil t)
  336.     ;; And then apply the local KILL file.
  337. !   (load (gnus-newsgroup-kill-file gnus-newsgroup-name) t nil t))
  338.   
  339.   (defun gnus-Newsgroup-kill-file (newsgroup)
  340.     "Return the name of a KILL file of NEWSGROUP.
  341. --- 4592,4726 ----
  342.   (defun gnus-apply-kill-file ()
  343.     "Apply KILL file to the current newsgroup."
  344.     ;; Apply the global KILL file.
  345. !   (gnus-load (gnus-newsgroup-kill-file nil))
  346.     ;; And then apply the local KILL file.
  347. !   (gnus-load (gnus-newsgroup-kill-file gnus-newsgroup-name)))
  348. ! 
  349. ! (defun gnus-load (fn)
  350. !   "Load FILENAME (containing lisp code) and execute commands, if
  351. ! either the creation or hit date are ok or if they don't exist; if
  352. ! command returns non-nil, update hit-date, which if exists is in a
  353. ! comment after each command.  No error if filename does not exist; do
  354. ! not add .el and .elc suffixes."
  355. !   (if (not (file-readable-p fn))
  356. !       nil
  357. !     (let ((creation-date nil)
  358. !       (hit-date nil)
  359. !       (hit-date-start nil)
  360. !       (hit-date-end nil)
  361. !       (kill-line nil)
  362. !       (bol nil)
  363. !       (eol nil)
  364. !       (writable (file-writable-p fn)))
  365. !       (save-excursion
  366. !     (find-file fn)
  367. !     (goto-char (point-min))
  368. !     (while (not (eobp))
  369. !       (beginning-of-line)
  370. !       (setq bol (point)
  371. !         kill-line (looking-at "(gnus-kill")
  372. !         gnus-successful-kill nil)
  373. !       (save-excursion
  374. !         (end-of-line)
  375. !         (setq eol (point)))
  376. !       (setq creation-date (if (re-search-forward
  377. !                    "; *creation-date *#\\([^#]+\\) *#" eol t)
  378. !                   (buffer-substring (match-beginning 1) (match-end 1))
  379. !                 nil)
  380. !         hit-date (if (re-search-forward
  381. !                   "; *hit-date *#\\([^#]+\\) *#" eol t)
  382. !                  (buffer-substring (match-beginning 1) (match-end 1))
  383. !                nil)
  384. !         hit-date-start (if hit-date
  385. !                    (match-beginning 1) nil)
  386. !         hit-date-end (if hit-date
  387. !                  (match-end 1) nil))
  388. !       (if (and (or (and creation-date
  389. !                 (> (gnus-date-diff (current-time-string) creation-date)
  390. !                    gnus-max-creation-intrvl))
  391. !                (and hit-date
  392. !                 (> (gnus-date-diff (current-time-string) hit-date)
  393. !                    gnus-max-hit-intrvl)))
  394. !            writable)
  395. !           ;; delete the line, it's old
  396. !           (progn
  397. !         (setq del-line t)
  398. !         (goto-char bol)
  399. !         (kill-line 1))
  400. !         (eval-region bol eol)
  401. !         (if kill-line
  402. !         (progn
  403. !           (if (and hit-date
  404. !                gnus-successful-kill
  405. !                writable)
  406. !               (progn
  407. !             (goto-char hit-date-start)
  408. !             (delete-region (point) hit-date-end)
  409. !             (insert (current-time-string))))
  410. !           (if writable
  411. !               (progn
  412. !             (if (and gnus-max-creation-intrvl
  413. !                  (not creation-date))
  414. !                 (progn
  415. !                   (end-of-line)
  416. !                   (insert (concat "; creation-date #" (current-time-string) "#"))))
  417. !             (if (and gnus-max-hit-intrvl
  418. !                  (not hit-date))
  419. !                 (progn
  420. !                   (end-of-line)
  421. !                   (insert (concat "; hit-date #" (current-time-string) "#"))))))))
  422. !         (forward-line 1))))
  423. !       )))
  424. !      
  425. ! (defun gnus-julday (date)
  426. !   "Returns the Julian day for DATE."
  427. !   (let* ((date   (timezone-parse-date date))
  428. !      (year   (string-to-int (aref date 0)))
  429. !      (month  (string-to-int (aref date 1)))
  430. !      (day    (string-to-int (aref date 2)))
  431. !      (m 1)
  432. !      (juldays 0))
  433. !     (while (< m month)
  434. !       (setq juldays (+ juldays (timezone-last-day-of-month m year))
  435. !         m (+ m 1)))
  436. !     (+ juldays day)))
  437. ! 
  438. ! (defun gnus-date-diff (date1 date2)
  439. !   "Calculate the difference in days between DATE1 and DATE2."
  440. !   (let* (
  441. !      (date1-orig date1)
  442. !      (date1   (timezone-parse-date date1))
  443. !      (year1   (string-to-int (aref date1 0)))
  444. !      (month1  (string-to-int (aref date1 1)))
  445. !      (day1    (string-to-int (aref date1 2)))
  446. !      (julday1 (gnus-julday date1-orig))
  447. ! 
  448. !      (date2-orig date2)
  449. !      (date2   (timezone-parse-date date2))
  450. !      (year2   (string-to-int (aref date2 0)))
  451. !      (month2  (string-to-int (aref date2 1)))
  452. !      (day2    (string-to-int (aref date2 2)))
  453. !      (julday2 (gnus-julday date2-orig))
  454. !      
  455. !      (year-diff (- year1 year2))
  456. !      (day-diff (- julday1 julday2))
  457. !      (tot-days-diff (+ (* year-diff 365) day-diff)))
  458. !     tot-days-diff))
  459. ! 
  460. ! (defun gnus-exit-kill-files ()
  461. !   "Exit all kill files."
  462. !   (save-excursion
  463. !     (let ((list (buffer-list)))
  464. !       (while list
  465. !     (let* ((buf (car list))
  466. !            (fn (buffer-file-name buf)))
  467. !       (if (and fn
  468. !            (string-equal (substring fn (- (length gnus-kill-file-name)))
  469. !                  gnus-kill-file-name))
  470. !           (progn
  471. !         (switch-to-buffer buf)
  472. !         (gnus-Kill-file-exit))))
  473. !     (setq list (cdr list))))))
  474.   
  475.   (defun gnus-Newsgroup-kill-file (newsgroup)
  476.     "Return the name of a KILL file of NEWSGROUP.
  477. ***************
  478. *** 4832,4837 ****
  479. --- 5031,5037 ----
  480.                (or (stringp value)
  481.                (setq value (prin1-to-string value)))
  482.                (string-match regexp value))
  483. +            (setq gnus-successful-kill t)
  484.              (if (stringp form)    ;Keyboard macro.
  485.                  (execute-kbd-macro form)
  486.                (funcall form))))
  487. ***************
  488. *** 4847,4852 ****
  489. --- 5047,5053 ----
  490.             (set-buffer gnus-Article-buffer)
  491.             (goto-char (point-min))
  492.             (re-search-forward regexp nil t))
  493. +         (setq gnus-successful-kill t)
  494.           (if (stringp form)    ;Keyboard macro.
  495.               (execute-kbd-macro form)
  496.             (funcall form))))
  497. -- 
  498. Ralph Finch            916-653-8268
  499. rfinch@water.ca.gov        ...ucbvax!ucdavis!caldwr!rfinch
  500. Any opinions expressed are my own; they do not represent the DWR
  501.