Gnus development mailing list
 help / color / mirror / Atom feed
From: Tassilo Horn <tsdh@gnu.org>
To: ding@gnus.org
Subject: Expiring old low-score threads
Date: Wed, 17 Apr 2013 13:16:59 +0200	[thread overview]
Message-ID: <87r4i9iez8.fsf@thinkpad.tsdh.de> (raw)

Hi all,

I'm reading quite a few high-traffic mailing lists, and my mailbox is
shortly before running out of space.  So I want to do some expiry.
Basically, I could use total-expire, say, after 365 days, but I'd prefer
if I could expire threads I'm not interested in much earlier than
threads that are interesting to me.

So now I'm trying to write a command that walks over all threads in the
current summary and marks all threads that have a score lower than -30
and whose most recent article is older than 60 days as expirable.
That's what I came up with so far.

--8<---------------cut here---------------start------------->8---
(defun th-gnus-summary-exprire-old-lowscore-articles ()
  (interactive)
  (goto-char (point-min))
  (dolist (thread gnus-newsgroup-threads)
    (let ((score (gnus-thread-total-score thread))
	  (age   (/ (- (gnus-float-time (current-time))
		       (gnus-thread-latest-date thread))
		    60    ;; minutes
		    60    ;; hours
		    24    ;; days
		    )))
      (message "Thread %s has score %s and is %s days old."
	       (aref (car thread) 1)
	       score age)
      ;; (when (and (> age 60)
      ;; 		 (< score -30))
      ;; 	(dolist (article thread)
      ;; 	  (gnus-summary-mark-article (aref article 0) gnus-expirable-mark)))
      )))
--8<---------------cut here---------------end--------------->8---

The problem is that in some summary buffers, I get an error when I run it:

--8<---------------cut here---------------start------------->8---
Debugger entered--Lisp error: (wrong-type-argument buffer-or-string-p 32)
  get-text-property(0 gnus-time 32)
  #[(header) "\303\b\304H\211.\305\232\203.\0\306\202%.\307\310\311	#\206%.\312	!.\313\310\314\311\n	%\210\n))!\207" [header d time gnus-float-time 3 "" (0 0) get-text-property 0 gnus-time safe-date-to-time put-text-property 1] 8]("Re: nREPL instance started by lein repl cannot be instrumented by jvisualvm")
  mapcar(#[(header) "\303\b\304H\211.\305\232\203.\0\306\202%.\307\310\311	#\206%.\312	!.\313\310\314\311\n	%\210\n))!\207" [header d time gnus-float-time 3 "" (0 0) get-text-property 0 gnus-time safe-date-to-time put-text-property 1] 8] ("Re: nREPL instance started by lein repl cannot be instrumented by jvisualvm" [578 "Re: nREPL instance started by lein repl cannot be instrumented by jvisualvm" "Marko Topolnik <marko.topolnik@gmail.com>" #("Fri, 15 Feb 2013 01:21:32 -0800 (PST)" 0 1 (gnus-time (20765 65052))) "<f0551001-48af-4b7c-b2ef-fc6232c63c17@googlegroups.com>" "<9d494812-a424-459d-a282-16393688e661@googlegroups.com> <CA+d+gT4BhSoN5m+4BNGCKwN=ihDyb9Gqc98i-HQthUuqtDFZJQ@mail.gmail.com> <a5a38707-2b95-48b1-ba2b-813d72da1781@googlegroups.com> <7906BEE6-8D27-444B-B82D-87919AD1D5CD@zentrope.com> <86ed2273-3de5-4c69-a467-ed7c02656579@googlegroups.com> <1A308C8B-00EF-4696-BAB9-F395FB0ABE21@zentrope.com>" 11184 50 nil ((Cc . "\"leiningen@librelist.com\" <leiningen@librelist.com>") (To . "leiningen@googlegroups.com"))] [579 "Re: nREPL instance started by lein repl cannot be instrumented by jvisualvm" "Marko Topolnik <marko.topolnik@gmail.com>" #("Fri, 15 Feb 2013 05:23:26 -0800 (PST)" 0 1 (gnus-time (20766 14030))) "<02cc50a1-40dd-4f15-b30b-11be1beff8dd@googlegroups.com>" "<9d494812-a424-459d-a282-16393688e661@googlegroups.com> <CA+d+gT4BhSoN5m+4BNGCKwN=ihDyb9Gqc98i-HQthUuqtDFZJQ@mail.gmail.com> <a5a38707-2b95-48b1-ba2b-813d72da1781@googlegroups.com> <7906BEE6-8D27-444B-B82D-87919AD1D5CD@zentrope.com> <86ed2273-3de5-4c69-a467-ed7c02656579@googlegroups.com> <1A308C8B-00EF-4696-BAB9-F395FB0ABE21@zentrope.com>" 9416 27 nil ((Cc . "\"leiningen@librelist.com\" <leiningen@librelist.com>") (To . "leiningen@googlegroups.com"))]))
  gnus-thread-latest-date(("Re: nREPL instance started by lein repl cannot be instrumented by jvisualvm" ([578 "Re: nREPL instance started by lein repl cannot be instrumented by jvisualvm" "Marko Topolnik <marko.topolnik@gmail.com>" #("Fri, 15 Feb 2013 01:21:32 -0800 (PST)" 0 1 (gnus-time (20765 65052))) "<f0551001-48af-4b7c-b2ef-fc6232c63c17@googlegroups.com>" "<9d494812-a424-459d-a282-16393688e661@googlegroups.com> <CA+d+gT4BhSoN5m+4BNGCKwN=ihDyb9Gqc98i-HQthUuqtDFZJQ@mail.gmail.com> <a5a38707-2b95-48b1-ba2b-813d72da1781@googlegroups.com> <7906BEE6-8D27-444B-B82D-87919AD1D5CD@zentrope.com> <86ed2273-3de5-4c69-a467-ed7c02656579@googlegroups.com> <1A308C8B-00EF-4696-BAB9-F395FB0ABE21@zentrope.com>" 11184 50 nil ((Cc . "\"leiningen@librelist.com\" <leiningen@librelist.com>") (To . "leiningen@googlegroups.com"))]) ([579 "Re: nREPL instance started by lein repl cannot be instrumented by jvisualvm" "Marko Topolnik <marko.topolnik@gmail.com>" #("Fri, 15 Feb 2013 05:23:26 -0800 (PST)" 0 1 (gnus-time (20766 14030))) "<02cc50a1-40dd-4f15-b30b-11be1beff8dd@googlegroups.com>" "<9d494812-a424-459d-a282-16393688e661@googlegroups.com> <CA+d+gT4BhSoN5m+4BNGCKwN=ihDyb9Gqc98i-HQthUuqtDFZJQ@mail.gmail.com> <a5a38707-2b95-48b1-ba2b-813d72da1781@googlegroups.com> <7906BEE6-8D27-444B-B82D-87919AD1D5CD@zentrope.com> <86ed2273-3de5-4c69-a467-ed7c02656579@googlegroups.com> <1A308C8B-00EF-4696-BAB9-F395FB0ABE21@zentrope.com>" 9416 27 nil ((Cc . "\"leiningen@librelist.com\" <leiningen@librelist.com>") (To . "leiningen@googlegroups.com"))])))
  (- (gnus-float-time (current-time)) (gnus-thread-latest-date thread))
  (/ (- (gnus-float-time (current-time)) (gnus-thread-latest-date thread)) 60 60 24)
  (let ((score (gnus-thread-total-score thread)) (age (/ (- (gnus-float-time (current-time)) (gnus-thread-latest-date thread)) 60 60 24))) (message "Thread %s has score %s and is %s days old." (aref (car thread) 1) score age))
  (while --dolist-tail-- (setq thread (car --dolist-tail--)) (let ((score (gnus-thread-total-score thread)) (age (/ (- (gnus-float-time (current-time)) (gnus-thread-latest-date thread)) 60 60 24))) (message "Thread %s has score %s and is %s days old." (aref (car thread) 1) score age)) (setq --dolist-tail-- (cdr --dolist-tail--)))
  (let ((--dolist-tail-- gnus-newsgroup-threads) thread) (while --dolist-tail-- (setq thread (car --dolist-tail--)) (let ((score (gnus-thread-total-score thread)) (age (/ (- (gnus-float-time ...) (gnus-thread-latest-date thread)) 60 60 24))) (message "Thread %s has score %s and is %s days old." (aref (car thread) 1) score age)) (setq --dolist-tail-- (cdr --dolist-tail--))))
  (catch (quote --cl-block-nil--) (let ((--dolist-tail-- gnus-newsgroup-threads) thread) (while --dolist-tail-- (setq thread (car --dolist-tail--)) (let ((score (gnus-thread-total-score thread)) (age (/ (- ... ...) 60 60 24))) (message "Thread %s has score %s and is %s days old." (aref (car thread) 1) score age)) (setq --dolist-tail-- (cdr --dolist-tail--)))))
  (cl--block-wrapper (catch (quote --cl-block-nil--) (let ((--dolist-tail-- gnus-newsgroup-threads) thread) (while --dolist-tail-- (setq thread (car --dolist-tail--)) (let ((score (gnus-thread-total-score thread)) (age (/ ... 60 60 24))) (message "Thread %s has score %s and is %s days old." (aref (car thread) 1) score age)) (setq --dolist-tail-- (cdr --dolist-tail--))))))
  (cl-block nil (let ((--dolist-tail-- gnus-newsgroup-threads) thread) (while --dolist-tail-- (setq thread (car --dolist-tail--)) (let ((score (gnus-thread-total-score thread)) (age (/ (- ... ...) 60 60 24))) (message "Thread %s has score %s and is %s days old." (aref (car thread) 1) score age)) (setq --dolist-tail-- (cdr --dolist-tail--)))))
  (dolist (thread gnus-newsgroup-threads) (let ((score (gnus-thread-total-score thread)) (age (/ (- (gnus-float-time (current-time)) (gnus-thread-latest-date thread)) 60 60 24))) (message "Thread %s has score %s and is %s days old." (aref (car thread) 1) score age)))
  th-gnus-summary-exprire-old-lowscore-articles()
  call-interactively(th-gnus-summary-exprire-old-lowscore-articles record nil)
  command-execute(th-gnus-summary-exprire-old-lowscore-articles record)
  execute-extended-command(nil "th-gnus-summary-exprire-old-lowscore-articles")
  call-interactively(execute-extended-command nil nil)
  command-execute(execute-extended-command)
--8<---------------cut here---------------end--------------->8---

This seems to happen when there's an incomplete thread.  At least the
command doesn't error after I've referred the complete thread using A T.
On the other hand, when I open a summary of another group where also
incomplete threads are shown, I don't get that error.

Hm, it seems that it's caused by the thread having a false root.  That
is, the error appears when the thread looks like

--8<---------------cut here---------------start------------->8---
O ┃ +┃Marko Topolnik         ┃ ○ Re: nREPL instance started...
O ┃ +┃Marko Topolnik         ┃  ╰─❯  <February 15>
--8<---------------cut here---------------end--------------->8---

but when I hit ^ and it becomes

--8<---------------cut here---------------start------------->8---
R ┃  ┃Keith Irwin            ┃ ● Re: nREPL instance started...
R ┃ +┃Marko Topolnik         ┃ ├─❯  <February 15>
O ┃ +┃Marko Topolnik         ┃ ╰─❯  <February 15>
--8<---------------cut here---------------end--------------->8---

my command works without any error.

How can I fix this?  I mean, I obviously want to run my command in
complete summary containing all articles I've ever received in that
group.  Of course, chances are high that the group contains incomplete
threads with false roots where ^ (gnus-summary-refer-parent-article)
won't cure the symptoms.

Bye,
Tassilo



             reply	other threads:[~2013-04-17 11:16 UTC|newest]

Thread overview: 6+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2013-04-17 11:16 Tassilo Horn [this message]
2013-04-17 14:17 ` Eric Abrahamsen
2013-04-17 14:31   ` Tassilo Horn
2013-04-18  0:10     ` Eric Abrahamsen
2013-04-18  6:51       ` Tassilo Horn
2013-04-18  7:08         ` Eric Abrahamsen

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87r4i9iez8.fsf@thinkpad.tsdh.de \
    --to=tsdh@gnu.org \
    --cc=ding@gnus.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).