(defvar expire-maximum-age 7 "\ *Longest time a pattern can go unmatched before being removed. The units on this measure are in days, and its value should be an integer.") (defvar expire-flush-frequency (quote group) "\ *Determines how often modified kill file buffers are flushed. If set to the atom 'always, then flushing happens after every modification. If set to 'group, then flushing occurs when you exit the current newsgroup. If set to 'session, then modifications are flushed only when you exit GNUS itself. Otherwise, no automatic actions are taken. The variable expire-flush-action determines what it actually means to \"flush\" a modified kill file buffer.") (defvar expire-flush-action (quote kill) "\ *Determines what to do with buffers of modified kill files. If set to the atom 'kill, then the modified buffer is saved and killed. If set to 'save, then the modified buffer is saved, but is not killed. Otherwise, no actions are taken. The variable expire-flush-frequency determines how frequently the requested action is taken.") (defvar expire-Subject-kill-same-subject nil "\ *Key sequence to which to bind the function of the same name. If set to a string representing a key sequence, that sequence will evoke the same-named function in the *Subject* buffer. Otherwise, no binding will be made for this function.") (defvar expire-Subject-kill-same-subject-and-select " " "\ *Key sequence to which to bind the function of the same name. If set to a string representing a key sequence, that sequence will evoke the same-named function in the *Subject* buffer. Otherwise, no binding will be made for this function.") (defvar expire-Subject-kill-thread nil "\ *Key sequence to which to bind the function of the same name. If set to a string representing a key sequence, that sequence will evoke the same-named function in the *Subject* buffer. Otherwise, no binding will be made for this function.") (defvar expire-Subject-kill-thread-and-select "k" "\ *Key sequence to which to bind the function of the same name. If set to a string representing a key sequence, that sequence will evoke the same-named function in the *Subject* buffer. Otherwise, no binding will be made for this function.") (defvar expire-Kill-file-kill-by-subject "" "\ *Key sequence to which to bind the function of the same name. If set to a string representing a key sequence, that sequence will evoke the same-named function in the kill file buffers. Otherwise, no binding will be made for this function.") (defvar expire-Kill-file-kill-by-thread "" "\ *Key sequence to which to bind the function of the same name. If set to a string representing a key sequence, that sequence will evoke the same-named function in the kill file buffers. Otherwise, no binding will be made for this function.") (defvar expire-Kill-file-insert-time-stamp " " "\ *Key sequence to which to bind the function of the same name. If set to a string representing a key sequence, that sequence will evoke the same-named function in the kill file buffers. Otherwise, no binding will be made for this function.") (defvar expire-delete-empties (quote t) "\ *Determines whether or not empty kill files should be deleted. If set to the atom 'ask, then the user will be asked each time. If set to some other non-nil value, then empties will be deleted automatically the first time they are applied to a newsgroup. If nil, no deletions will be performed.") (defvar expire-kill-default-command (quote (gnus-Subject-mark-as-read nil "x")) "\ *Default command to be evaluated by expire-kill if none is given. This must be a lisp expression or a string representing a key sequence.") (defvar expire-after-apply-hook (function (lambda nil (gnus-expunge "Xx"))) "\ *A hook called after all kill files have been applied. This hook is called after the global and local kill files have been applied to the currently-selected newsgroup. If you used to finish off all of your kill files with a call to gnus-expunge, you can factor all of that out into this hook. This reduces kill file size, and makes it easy to delete empty ones.") (defvar expire-load-hook nil "\ *A hook called after expire-kill is loaded in. This can be a good place to put custom key bindings.") (defvar expire-date-package (quote calendar) "\ *The name of the package to use for date calculations. This should be set to an atom for which expire-date-package-profiles has an entry, and which may be loaded using (require ...). Currently supported packages include calc and calendar. Note that stamps may be read from either format, assuming both are available. New stamps, however, will always be generated using the selected package.") (defvar expire-date-package-profiles (quote ((calendar (calendar-absolute-from-gregorian (calendar-current-date)) (- (calendar-absolute-from-gregorian (calendar-current-date)) timestamp)) (calc (calc-eval "floor(now())") (calc-eval "floor(now() - $)" (quote raw) timestamp)))) "\ *A list of profiles of known date calculation packages. Each profile is, itself, a list of three values. - The first is the package name as an atom, which may be used in expire-date-package and which is used in (require ...) at load time. - The second is an s-expression that returns the current date. - The third is an s-expression that returns the (integral) difference between the date stored in the variable \"timestamp\" and the current date.") (defconst expire-version "$Revision: 1.1 $" "\ The current version, of revision number, of expire-kill. Be sure to include this in any bug reports.") (require (quote add-hook)) (require (quote backquote)) (and (boundp (quote expire-date-package)) (require expire-date-package)) (require (quote cl)) (require (quote gnus)) (defvar expire-current-kill-buffer nil "\ The buffer of the kill file currently (or recently) being applied.") (defvar expire-modified-buffers nil "\ A list of all kill file buffers that may have been modified recently.") (defun expire-current-date nil "\ Return some representation of today's date." (byte-code " \"8!" [expire-date-package expire-date-package-profiles eval 1 assq] 5)) (defun expire-days-since (timestamp) "\ Return the integral number of days between today and TIMESTAMP." (byte-code " \"8!" [expire-date-package expire-date-package-profiles eval 2 assq] 5)) (defun expire-kill (field pattern timestamp &optional command all) "\ If FIELD of an article matches REGEXP, update TIMESTAMP and execute COMMAND. If no COMMAND is given, the value of expire-kill-default-command is used. If optional 5th argument ALL is non-nil, articles marked are also applied to. If FIELD is an empty string (or nil), entire article body is searched for. COMMAND must be a lisp expression or a string representing a key sequence." (byte-code "   ; D E $)/ ! %5!!)" [successful command expire-kill-default-command field pattern all timestamp nil gnus-kill progn (setq successful t) execute-kbd-macro expire-restamp expire-convert-timestamp expire-filter] 8)) (defun expire-Kill-file-kill-by-subject (ask) "\ Insert expiring KILL command for current subject. Argument ASK non-nil (C-u if called interactively) allows the user to edit the pattern before it is inserted." (interactive "P") (byte-code "È \"H! #" [gnus-newsgroup-headers gnus-current-kill-article ask nil expire-insert-kill "Subject" regexp-quote gnus-find-header-by-number 1] 6)) (defun expire-Kill-file-kill-by-thread (ask) "\ Insert expiring KILL command for current thread. Argument ASK non-nil (C-u if called interactively) allows the user to edit the pattern before it is inserted." (interactive "P") (byte-code "È \"!! #" [gnus-newsgroup-headers gnus-current-kill-article ask nil expire-insert-kill "References" regexp-quote gnus-header-id gnus-find-header-by-number] 7)) (defun expire-Kill-file-insert-time-stamp nil "\ Insert a time stamp for the current date after point. Handy for finishing up hand written calls to expire-kill." (interactive) (byte-code " p\"" [nil prin1 expire-current-date] 4)) (defun expire-Subject-kill-same-subject (ask) "\ Add a local, expiring kill pattern for the current subject. Also, mark all articles with this subject in the current buffer as read, but do not select the next unread article. Argument ASK non-nil (C-u if called interactively) allows the user to edit the pattern before it is inserted." (interactive "P") (byte-code "\"!" [ask nil expire-Subject-kill-using expire-Kill-file-kill-by-subject gnus-Subject-kill-same-subject] 3)) (defun expire-Subject-kill-same-subject-and-select (ask) "\ Add a local, expiring kill pattern for the current subject. Also, mark all articles with this subject in the current buffer as read and select the next unread article. Argument ASK non-nil (C-u if called interactively) allows the user to edit the pattern before it is inserted." (interactive "P") (byte-code "\"!" [ask nil expire-Subject-kill-using expire-Kill-file-kill-by-subject gnus-Subject-kill-same-subject-and-select] 3)) (defun expire-Subject-kill-thread (ask) "\ Add a local, expiring kill pattern for the current thread. Also, mark all articles in the current thread as read. Argument ASK non-nil (C-u if called interactively) allows the user to edit the pattern before it is inserted." (interactive "P") (byte-code "\"!" [ask nil expire-Subject-kill-using expire-Kill-file-kill-by-thread gnus-Subject-kill-thread] 3)) (defun expire-Subject-kill-thread-and-select (ask) "\ Add a local, expiring kill pattern for the current thread. Also, mark all articles in the current thread as read and select the next unread article. Argument ASK non-nil (C-u if called interactively) allows the user to edit the pattern before it is inserted." (interactive "P") (byte-code "\"! >  " [ask nil gnus-newsgroup-unreads expire-Subject-kill-using expire-Kill-file-kill-by-thread gnus-Subject-kill-thread gnus-Subject-article-number gnus-Subject-select-article gnus-Subject-next-unread-article] 6)) (defun expire-apply-kill-file nil "\ Apply kill files to the current newsgroup. The global kill file, if it exists, is loaded in the standard manner. The local kill file, however, is read and evaluated one s-expression at a time. This allows calls to \"expire-kill\" to modify themselves. If the local kill file consists of nothing but whitespace, it may be deleted, depending upon the value of expire-delete-empties. The hook expire-after-apply-hook is executed after both the global and local kill files have been applied. If neither the global nor the local kill file actually existed, though, this hook is ignored." (byte-code "! !\" \"!$ \"ȉ) ! !1 ! \" !p Beb#neb֏ȉ \"!! !?= \"!ȃ \" !!! \"!!))!)" [kill-files-applied global-kill-file nil local-kill-file gnus-newsgroup-name expire-modified-buffers expire-current-kill-buffer expire-delete-empties t gnus-newsgroup-kill-file file-readable-p message "Loading %s..." load noerr nosufx "Loading %s...done" get-file-buffer find-file re-search-forward "[^ ]" (byte-code "!" [local-kill-file expire-eval-buffer] 2) ((end-of-file (byte-code "" [nil] 1))) bury-buffer expire-possibly-flush always file-symlink-p ask y-or-n-p format "Delete empty %s " "Deleting %s..." delete-file set-buffer-modified-p kill-buffer "Deleting %s...done" run-hooks expire-after-apply-hook] 27)) (defun expire-Exit-group nil "\ Possibly flush all modified buffers. Should be called from gnus-Exit-group-hook." (byte-code "!" [expire-possibly-flush group] 2)) (defun expire-Exit-gnus nil "\ Possibly flush all modified buffers. Should be called from gnus-Exit-gnus-hook." (byte-code "!" [expire-possibly-flush session] 2)) (defun expire-eval-buffer (name) "\ Evaluate the s-expressions following point in the current buffer, one at a time. NAME gives the buffer's displayed name." (byte-code "Åq !! q `\"d\"#" [gnus-Subject-buffer expire-current-kill-buffer name t eval read message "Loading %s...%d%%" / * 100] 10)) (defun expire-possibly-flush (frequency) "\ Possibly flush modified kill file buffers. Flushing actually happens only if argument FREQUENCY and the variable expire-flush-frequency are the same." (byte-code " = " [frequency expire-flush-frequency expire-flush] 2)) (defun expire-flush nil "\ Flush modified buffers as called for by expire-flush-action. Depending on the value of this variable, we either save and kill the buffers in expire-modified-buffers just save them, or don't do anything. Also, reset expire-modified-buffers to nil when we are done." (byte-code "8 @ A) !3  \"( ! !2 \"2 !))" [expire-modified-buffers buffer G$$_1 T$$_7 expire-flush-action buffer-name member (quote kill) expire-save-if-modified kill-buffer (quote save)] 8)) (defun expire-save-if-modified (buffer) "\ Save BUFFER, but only if it has been modified. This prevents unsightly \"(No changes need to be saved)\" messages." (byte-code "!q )" [buffer buffer-modified-p save-buffer bury-buffer] 4)) (defun expire-convert-timestamp (timestamp) "\ Convert a time stamp to the user's preferred format. If TIMESTAMP is a string, it is assumed to be in calc format; integers are assumed to belong to calendar. An equivalent string or integer is returned, depending upon the value of expire-date-package." (byte-code "!&  =\" =\"!T#)H;H  =7G =G!#S)" [timestamp T$$_9 expire-date-package nil T$$_10 integerp calendar calc require calc-eval "date($)" raw] 8)) (defun expire-restamp (field pattern timestamp &optional command all) "\ Replace a call to \"expire-kill\" with one having an updated time stamp. The s-expression before the point is deleted, and a new one is inserted that calls \"expire-kill\" with the given FIELD and REGEXP, and the current time as its time stamp. If the current time is not different from TIMESTAMP, however, the buffer is not modified. Optional arguments COMMAND and ALL correspond to those passed to the original expire-kill call, and if given will be reproduced in the new call." (byte-code "  \"% q ! &)" [now timestamp expire-current-kill-buffer field pattern nil command all expire-current-date equal backward-sexp kill-sexp 1 delete-blank-lines expire-insert-kill] 13)) (defun expire-insert-kill (field pattern ask &optional timestamp command all) "\ General purpose function to produce \"expire-kill\" calls. Inserts a call to \"expire-kill\" with the given FIELD and REGEXP. If third argument ASK is non-nil, the user will be allowed to edit the regexp. An optional fourth argument provides the TIMESTAMP; if none is given, a stamp for the current time is used. Fifth and sixth optional arguments COMMAND and ALL specify the corresponding optional arguments to the expire-kill call." (byte-code " P \"  F # D) ) C\"p\"l3c" [field ask pattern timestamp all command prin1 append expire-kill read-from-minibuffer ": " expire-current-date 10] 8)) (defun expire-filter (timestamp) "\ Delete outdated calls to \"expire-kill.\" If TIMESTAMP is older than the age limit given by expire-maximum-age, delete the s-expression before the point. Presumably, this corresponds to an outdated \"expire-kill\" call." (byte-code "! V q` ` \" )" [timestamp expire-maximum-age expire-current-kill-buffer end-of-sexp expire-days-since backward-sexp delete-region delete-blank-lines] 6)) (defun expire-Subject-kill-using (kill-mode-function ask) "\ In the *Subject* buffer, add a new expiring kill pattern. First argument FUNCTION should be the name of a function to be called, with no arguments, in the local kill file to actually insert the new pattern. If second argument ASK is non-nil, allow the user to edit the kill pattern before it is inserted." (byte-code " Ƌ)" [gnus-current-kill-article gnus-newsgroup-name kill-mode-function ask expire-modified-buffers gnus-Subject-article-number ((byte-code "!!eb \"p B !" [gnus-newsgroup-name kill-mode-function ask expire-modified-buffers find-file gnus-newsgroup-kill-file funcall bury-buffer expire-possibly-flush always] 6))] 2)) (mapcar (function (lambda (binding) (let ((function (car binding)) (keymap (cdr binding))) (if (stringp (symbol-value function)) (define-key (symbol-value keymap) (symbol-value function) function))))) (quote ((expire-Subject-kill-same-subject . gnus-Subject-mode-map) (expire-Subject-kill-same-subject-and-select . gnus-Subject-mode-map) (expire-Subject-kill-thread . gnus-Subject-mode-map) (expire-Subject-kill-thread-and-select . gnus-Subject-mode-map) (expire-Kill-file-kill-by-subject . gnus-Kill-file-mode-map) (expire-Kill-file-kill-by-thread . gnus-Kill-file-mode-map) (expire-Kill-file-insert-time-stamp . gnus-Kill-file-mode-map)))) (setq gnus-Apply-kill-hook (quote expire-apply-kill-file)) (add-hook (quote gnus-Exit-group-hook) (quote expire-Exit-group)) (add-hook (quote gnus-Exit-gnus-hook) (quote expire-Exit-gnus)) (provide (quote expire-kill)) (run-hooks (quote expire-load-hook))