From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/50185 Path: main.gmane.org!not-for-mail From: Reiner Steib <4.uce.03.r.s@nurfuerspam.de> Newsgroups: gmane.emacs.gnus.general Subject: Re: Limiting number of Incomingxxxx mails Date: Wed, 19 Feb 2003 22:12:05 +0100 Sender: owner-ding@hpc.uh.edu Message-ID: References: Reply-To: reiner.steib@gmx.de NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: main.gmane.org 1045689238 24112 80.91.224.249 (19 Feb 2003 21:13:58 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Wed, 19 Feb 2003 21:13:58 +0000 (UTC) Return-path: Original-Received: from malifon.math.uh.edu ([129.7.128.13]) by main.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 18lbXQ-0006Ga-00 for ; Wed, 19 Feb 2003 22:13:56 +0100 Original-Received: from sina.hpc.uh.edu ([129.7.128.10] ident=lists) by malifon.math.uh.edu with esmtp (Exim 3.20 #1) id 18lbVy-0005f3-00; Wed, 19 Feb 2003 15:12:26 -0600 Original-Received: by sina.hpc.uh.edu (TLB v0.09a (1.20 tibbs 1996/10/09 22:03:07)); Wed, 19 Feb 2003 15:13:25 -0600 (CST) Original-Received: from sclp3.sclp.com (sclp3.sclp.com [66.230.238.2]) by sina.hpc.uh.edu (8.9.3/8.9.3) with SMTP id PAA21225 for ; Wed, 19 Feb 2003 15:13:10 -0600 (CST) Original-Received: (qmail 63818 invoked by alias); 19 Feb 2003 21:12:07 -0000 Original-Received: (qmail 63813 invoked from network); 19 Feb 2003 21:12:07 -0000 Original-Received: from theotp5.physik.uni-ulm.de (134.60.10.145) by 66.230.238.6 with SMTP; 19 Feb 2003 21:12:07 -0000 Original-Received: (from ste@localhost) by theotp5.physik.uni-ulm.de (8.11.2/8.11.2) id h1JLC5C14512; Wed, 19 Feb 2003 22:12:05 +0100 X-Authentication-Warning: theotp5.physik.uni-ulm.de: ste set sender to reiner.steib@physik.uni-ulm.de using -f Original-To: ding@gnus.org X-Face: mtjf/D:es1T0wHO:&CJ'ZXe"l;3C--rw\z!{`eFwL){|]RpI+4{u25L=5C /0>KuGeTsk<~<&NE-AKV1560e!+RJeyWmSskkrJm?[vUV#66{T_m|Ae<||Ku#Mk5`y&O`n~z2;n8eP J5#2h@2eQgV@E70IY_0WlEx!"&giy{+\%h1LJox$zv@/l%ZmU4^tZA>xQpnkUBVC5.jpg#0'(+2?Rs )NAr:>3<=WxHE$ktbLysDIM5TbmHu*3 We have been talking in gnu.emacs.gnus about possibilities of reducing > the amount of diskspace the Incoming* files need. Perhaps there's > somebody who thinks our ideas are cool and wants to implement them? > > Reiner Steib <4.uce.03.r.s@nurfuerspam.de> writes: [...] >> (defcustom mail-source-delete-incoming nil >> "*If t, delete incoming files after handling. >> If a positive number, delete files, older than number days. If set to the >> symbol `compress', compress the files. If it is a negative number, compress >> the files and delete compressed files older than that number of >> days. If nil, never delete." I have write `mail-source-delete-old-incoming' but the function *needs review* and testing. I haven't worked with elisp times and file-attributes before, so my approach might be too complicated or complete nonsense. ;-) *Feedback welcome*! With the attached patch, old (>= 3 days) incoming files will be deleted (after confirmation!). You may also test the function without applying the patch[1]: ,----[ C-h f mail-source-delete-old-incoming RET ] | mail-source-delete-old-incoming is an interactive Lisp function in `...'. | (mail-source-delete-old-incoming &optional AGE CONFIRM) | | Remove incoming files older than AGE days. | If CONFIRM is non-nil, ask for confirmation before removing a file. `---- `M-: (mail-source-delete-old-incoming 7 t) RET' If you set gnus-verbose to 10 you'll get lots of debugging output. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=mail-source.delete-old-incoming.01.patch Content-Description: mail-source.delete-old-incoming.01.patch --- mail-source.el.~6.29.~ Mon Feb 17 11:37:23 2003 +++ mail-source.el Wed Feb 19 20:45:23 2003 @@ -262,8 +262,20 @@ :group 'mail-source :type 'integer) -(defcustom mail-source-delete-incoming nil - "*If non-nil, delete incoming files after handling." +(defcustom mail-source-delete-incoming 3; nil + "*If non-nil, delete incoming files after handling. +If t, delete immediately, if nil, never delete. If a positive number, delete +files older than number of days." + ;; Note: The removing happens in `mail-source-callback', i.e. no old + ;; incoming files will be deleted, unless you receive new mail. + ;; + ;; You may also set this to `t' and call `mail-source-delete-old-incoming' + ;; from a hook or interactively. + :group 'mail-source + :type 'integer) + +(defcustom mail-source-delete-old-incoming-confirm t; nil + "*If non-nil, ask for for confirmation before deleting old incoming files." :group 'mail-source :type 'boolean) @@ -506,6 +518,44 @@ (setq newname (make-temp-name newprefix))) newname)))) +(defun mail-source-delete-old-incoming (&optional age confirm) + "Remove incoming files older than AGE days. +If CONFIRM is non-nil, ask for confirmation before removing a file." + (interactive "P") + (let ((ddays 30) ;; fallback, if no valid AGE given + (high2days (/ 65536.0 60 60 24));; convert high bits to days + (low2days (/ 1.0 65536.0)) ;; convert low bits to days + diff + files ffile bfile filetime fileday currday) + (setq diff (if (and (numberp age) (>= age 0)) + age + ddays)) + ;; (gnus-message 1 "Setting `confirm' to `t' (testing!)") ;; To be removed + ;; (setq confirm t) (sit-for 1) ;; To be removed + (setq + files (directory-files + mail-source-directory t + (concat mail-source-incoming-file-prefix "*")) + currday (* (car (current-time)) high2days) + currday (+ currday (* low2days (nth 1 (current-time))))) + (gnus-message 8 "diff=`%s', currday=`%s'" diff currday);; To be removed + (while files + (setq + ffile (car files) + bfile (gnus-replace-in-string ffile "\\`.*/\\([^/]+\\)\\'" "\\1") + filetime (nth 5 (file-attributes ffile)) + fileday (* (car filetime) high2days) + fileday (+ fileday (* low2days (nth 1 filetime))) + files (cdr files)) + (gnus-message 9 "File `%s', fileday=`%s', `-c f'=`%s'";; To be removed + bfile fileday (- currday fileday));; To be removed + (when (and (> (- currday fileday) diff) + (gnus-message 8 "File `%s' is older than %s day(s)" + bfile diff) + (or (not confirm) + (y-or-n-p (concat "Remove file `" bfile "'? ")))) + (delete-file ffile))))) + (defun mail-source-callback (callback info) "Call CALLBACK on the mail file, and then remove the mail file. Pass INFO on to CALLBACK." @@ -519,7 +569,7 @@ (funcall callback mail-source-crash-box info) (when (file-exists-p mail-source-crash-box) ;; Delete or move the incoming mail out of the way. - (if mail-source-delete-incoming + (if (eq mail-source-delete-incoming t) (delete-file mail-source-crash-box) (let ((incoming (mail-source-make-complex-temp-name @@ -528,8 +578,14 @@ mail-source-directory)))) (unless (file-exists-p (file-name-directory incoming)) (make-directory (file-name-directory incoming) t)) - (rename-file mail-source-crash-box incoming t))))))) - + (rename-file mail-source-crash-box incoming t) + ;; remove old incoming files? + (when (and (numberp mail-source-delete-incoming) + (>= mail-source-delete-incoming 0)) + (mail-source-delete-old-incoming + mail-source-delete-incoming + mail-source-delete-old-incoming-confirm)))))))) + (defun mail-source-movemail (from to) "Move FROM to TO using movemail." (if (not (file-writable-p to)) --=-=-= Bye, Reiner. [1] Extract `(defun mail-source-delete-old-incoming ...)' from the patch, remove the leading "+"-sign and eval it. -- ,,, (o o) ---ooO-(_)-Ooo--- PGP key available via WWW http://rsteib.home.pages.de/ --=-=-=--