🚀 go-pugleaf

Following is a patch to implement 2 additions to gnus-3.14 kill files:
easy kills and aging kills.

WARNING: THIS PATCH IS EXPERIMENTAL.  Please don't use it until you've
backed up your .newsrc* files and your kill files, and your gnus.el
file.  Hopefully a few people will be willing to try this for a while,
make suggestions, and eventually I'll release a non-beta version.

You will need timezone.el to use this; I think it comes with gnus-3.14.

Explanation.  I use C-k (and sometimes k) a lot in subject buffers to
zip through uninteresting articles.  But when I exit gnus and start it
up the next day, the same articles (threads) appear again, of course.
Firing up kill files all the time is too cumbersome for me.  So I
wanted an easy way to place subject lines killed with C-k and k in
kill files.

However, that brings up another problem: huge kill files.  You need
some way of deleting the old kill lines automatically after they've
served their purpose.

This patch implements both of the above ideas.

After installing the patch, the first concept (easy kill files), is
activated with the variable gnus-save-kills.  If non-nil (default), it
will place the subject line of every C-k or k in the proper kill file,
and also put the line '(gnus-expunge "X")' at the end of the file if
it's not there already.  That way when you look at that group the next
day, the old subjects will be automatically killed for you.

The second concept, aging kill lines, is implemented with two
variables, gnus-max-creation-intrvl and gnus-max-hit-intrvl.  These
two variables control how many days to allow before deleting kill
lines in kill files, after creation of the line and its last 'hit',
that is, when that kill line last killed anything.  Default values are
30 days and 10 days respectively.  You can use both of these, or
either one; set them to nil to turn them off.  If these are some
integer value, gnus will put the current date for each one after a
comment on each line in your kill files.  The creation date will then
never change; the hit date will be updated every time that line gets a
hit.  If, when initially going through a kill file, gnus sees that
either interval is exceeded, it will delete that line, thus preventing
your kill files from growing forever with obsolete kills.

Kill files are now automatically saved when you exit gnus.

You can still hand edit your kill files in the usual way, they will
just have dates in them.  Aging kill lines works with both subject and
author kill lines.  Also, new style kill files can still be read by an
original gnus-3.14.

There's one other new variable: gnus-kill-header-length.  Set this to
some int (default is 20) to specify the length of a center subsection
of a subject line to use in kill files.  This prevents missing kills
because of Re: stuck on the front, or some other often subtle change
in a subject line.

Please send comments and bug reports to rfinch@water.ca.gov.

*** gnus.el~	1992/12/02 01:28:34
--- gnus.el	1992/12/16 00:49:36
***************
*** 109,114 ****
--- 110,116 ----
  (provide 'gnus)
  (require 'nntp)
  (require 'mail-utils)
+ (require 'timezone)
  
  (defvar gnus-nntp-server (getenv "NNTPSERVER")
    "*The name of the host running NNTP server.
***************
*** 558,563 ****
--- 560,578 ----
  (defvar gnus-Info-directory Info-directory
    "*A directory placing an Info file of GNUS.")
  
+ (defvar gnus-max-creation-intrvl 30
+   "*Maximum days to allow a kill item to exist since creation;
+ nil if no limit.")
+ (defvar gnus-max-hit-intrvl 10
+   "*Maximum days to allow a kill item to exist since last hit;
+ nil if no limit.")
+ (defvar gnus-save-kills t
+   "*If non-nil, when \\[gnus-Subject-kill-same-subject] is done,
+ save in kill file also.")
+ (defvar gnus-kill-header-length 20
+   "*If int, the length of a center substring to save from the
+ subject line when used in kill files.")
+ 
  
  ;; Internal variables.
  
***************
*** 709,714 ****
--- 724,732 ----
  (defvar rmail-last-file (expand-file-name "~/XMBOX"))
  (defvar rmail-last-rmail-file (expand-file-name "~/XNEWS"))
  
+ (defvar gnus-successful-kill nil
+   "t if gnus-kill was successful.")
+ 
  ;; Define GNUS Subsystems.
  (autoload 'gnus-Group-post-news "gnuspost"
  	  "Post an article." t)
***************
*** 1537,1542 ****
--- 1555,1561 ----
        (progn
  	(message "")			;Erase "Yes or No" question.
  	(run-hooks 'gnus-Exit-gnus-hook)
+ 	(gnus-exit-kill-files)
  	(gnus-save-newsrc-file)
  	(gnus-clear-system)
  	(gnus-close-server))
***************
*** 1749,1756 ****
  \\[gnus-Subject-catch-up-all-and-exit]
  	Catch up all articles, and then exit the current newsgroup.
  C-t	Toggle truncations of subject lines.
- x	Delete subject lines marked as read.
- X	Delete subject lines with the specific marks.
  C-c C-s C-n	Sort subjects by article number.
  C-c C-s C-a	Sort subjects by article author.
  C-c C-s C-s	Sort subjects alphabetically.
--- 1768,1773 ----
***************
*** 2977,2982 ****
--- 2994,3016 ----
    (let ((count
  	 (gnus-Subject-mark-same-subject
  	  (gnus-Subject-subject-string) unmark)))
+     ;; save in kill file if desired
+     (if gnus-save-kills
+ 	(progn
+ 	  (setq gnus-current-kill-article (gnus-Subject-article-number))
+ 	  (save-excursion
+ 	    (find-file (gnus-newsgroup-kill-file gnus-newsgroup-name))
+ 	    (save-excursion
+ 	      (beginning-of-buffer)
+ 	      (gnus-Kill-file-kill-by-subject)
+ 	      ;; add gnus-expunge at end of buffer, if needed
+ 	      (if (not (re-search-forward "^ *\(gnus-expunge" nil t))
+ 		  (progn
+ 		    (end-of-buffer)
+ 		    (if (not (bolp))
+ 			(insert "\n"))
+ 		    (insert "(gnus-expunge \"X\")\n"))))
+ 	    (bury-buffer))))
      ;; Select next unread article. If auto-select-same mode, should
      ;; select the first unread article.
      (gnus-Subject-next-article t (and gnus-auto-select-same
***************
*** 2995,3000 ****
--- 3029,3051 ----
    (let ((count
  	 (gnus-Subject-mark-same-subject
  	  (gnus-Subject-subject-string) unmark)))
+     ;; save in kill file if desired
+     (if gnus-save-kills
+ 	(progn
+ 	  (setq gnus-current-kill-article (gnus-Subject-article-number))
+ 	  (save-excursion
+ 	    (find-file (gnus-newsgroup-kill-file gnus-newsgroup-name))
+ 	    (save-excursion
+ 	      (beginning-of-buffer)
+ 	      (gnus-Kill-file-kill-by-subject)
+ 	      ;; add gnus-expunge at end of buffer, if needed
+ 	      (if (not (re-search-forward "^ *\(gnus-expunge" nil t))
+ 		  (progn
+ 		    (end-of-buffer)
+ 		    (if (not (bolp))
+ 			(insert "\n"))
+ 		    (insert "(gnus-expunge \"X\")\n"))))
+ 	    (bury-buffer))))
      ;; If marked as read, go to next unread subject.
      (if (null unmark)
  	;; Go to next unread subject.
***************
*** 3149,3164 ****
  (defun gnus-Subject-delete-marked-with (marks)
    "Delete lines which are marked with MARKS (e.g. \"DK\")."
    (interactive "sMarks: ")
!   (let ((buffer-read-only nil))
!     (save-excursion
!       (goto-char (point-min))
!       (delete-matching-lines (concat "^[" marks "]")))
!     ;; Adjust point.
!     (or (zerop (buffer-size))
! 	(if (eobp)
! 	    (gnus-Subject-prev-subject 1)
! 	  (beginning-of-line)
! 	  (search-forward ":" nil t)))
      ))
  
  ;; Thread-based commands.
--- 3200,3217 ----
  (defun gnus-Subject-delete-marked-with (marks)
    "Delete lines which are marked with MARKS (e.g. \"DK\")."
    (interactive "sMarks: ")
!   (save-excursion
!     (set-buffer gnus-Subject-buffer)
!     (let ((buffer-read-only nil))
!       (save-excursion
! 	(goto-char (point-min))
! 	(delete-matching-lines (concat "^[" marks "]")))
!       ;; Adjust point.
!       (or (zerop (buffer-size))
! 	  (if (eobp)
! 	      (gnus-Subject-prev-subject 1)
! 	    (beginning-of-line)
! 	    (search-forward ":" nil t))))
      ))
  
  ;; Thread-based commands.
***************
*** 4310,4331 ****
    "Insert KILL command for current subject."
    (interactive)
    (insert
!    (format "(gnus-kill \"Subject\" %s)\n"
  	   (prin1-to-string
  	    (if gnus-current-kill-article
  		(regexp-quote
! 		 (nntp-header-subject
! 		  ;; No need to speed up this command.
! 		  ;;(gnus-get-header-by-number gnus-current-kill-article)
! 		  (gnus-find-header-by-number gnus-newsgroup-headers
! 					      gnus-current-kill-article)))
! 	      "")))))
  
  (defun gnus-Kill-file-kill-by-author ()
    "Insert KILL command for current author."
    (interactive)
    (insert
!    (format "(gnus-kill \"From\" %s)\n"
  	   (prin1-to-string
  	    (if gnus-current-kill-article
  		(regexp-quote
--- 4363,4397 ----
    "Insert KILL command for current subject."
    (interactive)
    (insert
!    (format "(gnus-kill \"Subject\" %s)%s%s\n"
  	   (prin1-to-string
  	    (if gnus-current-kill-article
  		(regexp-quote
! 		 (let ((lendiff nil)
! 		       (str (nntp-header-subject
! 			     ;; No need to speed up this command.
! 			     ;;(gnus-get-header-by-number gnus-current-kill-article)
! 			     (gnus-find-header-by-number gnus-newsgroup-headers
! 							 gnus-current-kill-article))))
! 		   (if (and gnus-kill-header-length
! 			    (> (setq lendiff2 (/ (- (length str)
! 						    gnus-kill-header-length)
! 						 2)) 0))
! 		       (substring str lendiff2 (- lendiff2))
! 		     str)))
! 	      ""))
! 	   (if gnus-max-creation-intrvl
! 	       (concat "; creation-date #" (current-time-string) "#")
! 	     "")
! 	   (if gnus-max-hit-intrvl
! 	       (concat "; hit-date #" (current-time-string) "#")
! 	     ""))))
  
  (defun gnus-Kill-file-kill-by-author ()
    "Insert KILL command for current author."
    (interactive)
    (insert
!    (format "(gnus-kill \"From\" %s)%s%s\n"
  	   (prin1-to-string
  	    (if gnus-current-kill-article
  		(regexp-quote
***************
*** 4334,4340 ****
  		  ;;(gnus-get-header-by-number gnus-current-kill-article)
  		  (gnus-find-header-by-number gnus-newsgroup-headers
  					      gnus-current-kill-article)))
! 	      "")))))
  
  (defun gnus-Kill-file-apply-buffer ()
    "Apply current buffer to current newsgroup."
--- 4400,4413 ----
  		  ;;(gnus-get-header-by-number gnus-current-kill-article)
  		  (gnus-find-header-by-number gnus-newsgroup-headers
  					      gnus-current-kill-article)))
! 	      ""))
! 	   (if gnus-max-creation-intrvl
! 	       (concat "; creation-date #" (current-time-string) "#")
! 	     "")
! 	   (if gnus-max-hit-intrvl
! 	       (concat "; hit-date #" (current-time-string) "#")
! 	     ""))))
! 
  
  (defun gnus-Kill-file-apply-buffer ()
    "Apply current buffer to current newsgroup."
***************
*** 4367,4373 ****
  (defun gnus-Kill-file-exit ()
    "Save a KILL file, then return to the previous buffer."
    (interactive)
!   (save-buffer)
    (let ((killbuf (current-buffer)))
      ;; We don't want to return to Article buffer.
      (and (get-buffer gnus-Article-buffer)
--- 4440,4446 ----
  (defun gnus-Kill-file-exit ()
    "Save a KILL file, then return to the previous buffer."
    (interactive)
!   (if (buffer-modified-p) (save-buffer))
    (let ((killbuf (current-buffer)))
      ;; We don't want to return to Article buffer.
      (and (get-buffer gnus-Article-buffer)
***************
*** 4519,4527 ****
  (defun gnus-apply-kill-file ()
    "Apply KILL file to the current newsgroup."
    ;; Apply the global KILL file.
!   (load (gnus-newsgroup-kill-file nil) t nil t)
    ;; And then apply the local KILL file.
!   (load (gnus-newsgroup-kill-file gnus-newsgroup-name) t nil t))
  
  (defun gnus-Newsgroup-kill-file (newsgroup)
    "Return the name of a KILL file of NEWSGROUP.
--- 4592,4726 ----
  (defun gnus-apply-kill-file ()
    "Apply KILL file to the current newsgroup."
    ;; Apply the global KILL file.
!   (gnus-load (gnus-newsgroup-kill-file nil))
    ;; And then apply the local KILL file.
!   (gnus-load (gnus-newsgroup-kill-file gnus-newsgroup-name)))
! 
! (defun gnus-load (fn)
!   "Load FILENAME (containing lisp code) and execute commands, if
! either the creation or hit date are ok or if they don't exist; if
! command returns non-nil, update hit-date, which if exists is in a
! comment after each command.  No error if filename does not exist; do
! not add .el and .elc suffixes."
!   (if (not (file-readable-p fn))
!       nil
!     (let ((creation-date nil)
! 	  (hit-date nil)
! 	  (hit-date-start nil)
! 	  (hit-date-end nil)
! 	  (kill-line nil)
! 	  (bol nil)
! 	  (eol nil)
! 	  (writable (file-writable-p fn)))
!       (save-excursion
! 	(find-file fn)
! 	(goto-char (point-min))
! 	(while (not (eobp))
! 	  (beginning-of-line)
! 	  (setq bol (point)
! 		kill-line (looking-at "(gnus-kill")
! 		gnus-successful-kill nil)
! 	  (save-excursion
! 	    (end-of-line)
! 	    (setq eol (point)))
! 	  (setq creation-date (if (re-search-forward
! 				   "; *creation-date *#\\([^#]+\\) *#" eol t)
! 				  (buffer-substring (match-beginning 1) (match-end 1))
! 				nil)
! 		hit-date (if (re-search-forward
! 			      "; *hit-date *#\\([^#]+\\) *#" eol t)
! 			     (buffer-substring (match-beginning 1) (match-end 1))
! 			   nil)
! 		hit-date-start (if hit-date
! 				   (match-beginning 1) nil)
! 		hit-date-end (if hit-date
! 				 (match-end 1) nil))
! 	  (if (and (or (and creation-date
! 			    (> (gnus-date-diff (current-time-string) creation-date)
! 			       gnus-max-creation-intrvl))
! 		       (and hit-date
! 			    (> (gnus-date-diff (current-time-string) hit-date)
! 			       gnus-max-hit-intrvl)))
! 		   writable)
! 	      ;; delete the line, it's old
! 	      (progn
! 		(setq del-line t)
! 		(goto-char bol)
! 		(kill-line 1))
! 	    (eval-region bol eol)
! 	    (if kill-line
! 		(progn
! 		  (if (and hit-date
! 			   gnus-successful-kill
! 			   writable)
! 		      (progn
! 			(goto-char hit-date-start)
! 			(delete-region (point) hit-date-end)
! 			(insert (current-time-string))))
! 		  (if writable
! 		      (progn
! 			(if (and gnus-max-creation-intrvl
! 				 (not creation-date))
! 			    (progn
! 			      (end-of-line)
! 			      (insert (concat "; creation-date #" (current-time-string) "#"))))
! 			(if (and gnus-max-hit-intrvl
! 				 (not hit-date))
! 			    (progn
! 			      (end-of-line)
! 			      (insert (concat "; hit-date #" (current-time-string) "#"))))))))
! 	    (forward-line 1))))
!       )))
!      
! (defun gnus-julday (date)
!   "Returns the Julian day for DATE."
!   (let* ((date   (timezone-parse-date date))
! 	 (year   (string-to-int (aref date 0)))
! 	 (month  (string-to-int (aref date 1)))
! 	 (day    (string-to-int (aref date 2)))
! 	 (m 1)
! 	 (juldays 0))
!     (while (< m month)
!       (setq juldays (+ juldays (timezone-last-day-of-month m year))
! 	    m (+ m 1)))
!     (+ juldays day)))
! 
! (defun gnus-date-diff (date1 date2)
!   "Calculate the difference in days between DATE1 and DATE2."
!   (let* (
! 	 (date1-orig date1)
! 	 (date1   (timezone-parse-date date1))
! 	 (year1   (string-to-int (aref date1 0)))
! 	 (month1  (string-to-int (aref date1 1)))
! 	 (day1    (string-to-int (aref date1 2)))
! 	 (julday1 (gnus-julday date1-orig))
! 
! 	 (date2-orig date2)
! 	 (date2   (timezone-parse-date date2))
! 	 (year2   (string-to-int (aref date2 0)))
! 	 (month2  (string-to-int (aref date2 1)))
! 	 (day2    (string-to-int (aref date2 2)))
! 	 (julday2 (gnus-julday date2-orig))
! 	 
! 	 (year-diff (- year1 year2))
! 	 (day-diff (- julday1 julday2))
! 	 (tot-days-diff (+ (* year-diff 365) day-diff)))
!     tot-days-diff))
! 
! (defun gnus-exit-kill-files ()
!   "Exit all kill files."
!   (save-excursion
!     (let ((list (buffer-list)))
!       (while list
! 	(let* ((buf (car list))
! 	       (fn (buffer-file-name buf)))
! 	  (if (and fn
! 		   (string-equal (substring fn (- (length gnus-kill-file-name)))
! 				 gnus-kill-file-name))
! 	      (progn
! 		(switch-to-buffer buf)
! 		(gnus-Kill-file-exit))))
! 	(setq list (cdr list))))))
  
  (defun gnus-Newsgroup-kill-file (newsgroup)
    "Return the name of a KILL file of NEWSGROUP.
***************
*** 4832,4837 ****
--- 5031,5037 ----
  		     (or (stringp value)
  			 (setq value (prin1-to-string value)))
  		     (string-match regexp value))
+ 		   (setq gnus-successful-kill t)
  		   (if (stringp form)	;Keyboard macro.
  		       (execute-kbd-macro form)
  		     (funcall form))))
***************
*** 4847,4852 ****
--- 5047,5053 ----
  		  (set-buffer gnus-Article-buffer)
  		  (goto-char (point-min))
  		  (re-search-forward regexp nil t))
+ 		(setq gnus-successful-kill t)
  		(if (stringp form)	;Keyboard macro.
  		    (execute-kbd-macro form)
  		  (funcall form))))
-- 
Ralph Finch			916-653-8268
rfinch@water.ca.gov		...ucbvax!ucdavis!caldwr!rfinch
Any opinions expressed are my own; they do not represent the DWR