1;;; midnight.el --- run something every midnight, e.g., kill old buffers 2 3;; Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, 4;; 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Sam Steingold <sds@usa.net> 7;; Maintainer: Sam Steingold <sds@usa.net> 8;; Created: 1998-05-18 9;; Keywords: utilities 10 11;; This file is part of GNU Emacs. 12 13;; GNU Emacs is free software; you can redistribute it and/or modify 14;; it under the terms of the GNU General Public License as published by 15;; the Free Software Foundation; either version 2, or (at your option) 16;; any later version. 17 18;; GNU Emacs is distributed in the hope that it will be useful, 19;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21;; GNU General Public License for more details. 22 23;; You should have received a copy of the GNU General Public License 24;; along with GNU Emacs; see the file COPYING. If not, write to the 25;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 26;; Boston, MA 02110-1301, USA. 27 28;;; Commentary: 29 30;; To use the file, put (require 'midnight) into your .emacs. Then, at 31;; midnight, Emacs will run the normal hook `midnight-hook'. You can 32;; put whatever you like there, say, `calendar'; by default there is 33;; only one function there - `clean-buffer-list'. It will kill the 34;; buffers matching `clean-buffer-list-kill-buffer-names' and 35;; `clean-buffer-list-kill-regexps' and the buffers which where last 36;; displayed more than `clean-buffer-list-delay-general' days ago, 37;; keeping `clean-buffer-list-kill-never-buffer-names' and 38;; `clean-buffer-list-kill-never-regexps'. 39 40;;; Code: 41 42(eval-when-compile 43 (require 'cl)) 44 45(require 'timer) 46 47(defgroup midnight nil 48 "Run something every day at midnight." 49 :group 'calendar 50 :version "20.3") 51 52(defvar midnight-timer nil 53 "Timer running the `midnight-hook' `midnight-delay' seconds after midnight. 54Use `cancel-timer' to stop it and `midnight-delay-set' to change 55the time when it is run.") 56 57(defcustom midnight-mode nil 58 "*Non-nil means run `midnight-hook' at midnight. 59Setting this variable outside customize has no effect; 60call `cancel-timer' or `timer-activate' on `midnight-timer' instead." 61 :type 'boolean 62 :group 'midnight 63 :require 'midnight 64 :initialize 'custom-initialize-default 65 :set (lambda (symb val) 66 (set symb val) (require 'midnight) 67 (if val (timer-activate midnight-timer) 68 (cancel-timer midnight-timer)))) 69 70;;; time conversion 71 72(defun midnight-time-float (num) 73 "Convert the float number of seconds since epoch to the list of 3 integers." 74 (let* ((div (ash 1 16)) (1st (floor num div))) 75 (list 1st (floor (- num (* (float div) 1st))) 76 (round (* 10000000 (mod num 1)))))) 77 78(defun midnight-buffer-display-time (&optional buffer) 79 "Return the time-stamp of BUFFER, or current buffer, as float." 80 (with-current-buffer (or buffer (current-buffer)) 81 (when buffer-display-time (float-time buffer-display-time)))) 82 83;;; clean-buffer-list stuff 84 85(defcustom clean-buffer-list-delay-general 3 86 "*The number of days before any buffer becomes eligible for autokilling. 87The autokilling is done by `clean-buffer-list' when is it in `midnight-hook'. 88Currently displayed and/or modified (unsaved) buffers, as well as buffers 89matching `clean-buffer-list-kill-never-buffer-names' and 90`clean-buffer-list-kill-never-regexps' are excluded." 91 :type 'integer 92 :group 'midnight) 93 94(defcustom clean-buffer-list-delay-special 3600 95 "*The number of seconds before some buffers become eligible for autokilling. 96Buffers matched by `clean-buffer-list-kill-regexps' and 97`clean-buffer-list-kill-buffer-names' are killed if they were last 98displayed more than this many seconds ago." 99 :type 'integer 100 :group 'midnight) 101 102(defcustom clean-buffer-list-kill-regexps nil 103 "*List of regexps saying which buffers will be killed at midnight. 104If buffer name matches a regexp in the list and the buffer was not displayed 105in the last `clean-buffer-list-delay-special' seconds, it is killed by 106`clean-buffer-list' when is it in `midnight-hook'. 107If a member of the list is a cons, its `car' is the regexp and its `cdr' is 108the number of seconds to use instead of `clean-buffer-list-delay-special'. 109See also `clean-buffer-list-kill-buffer-names', 110`clean-buffer-list-kill-never-regexps' and 111`clean-buffer-list-kill-never-buffer-names'." 112 :type '(repeat (regexp :tag "Regexp matching Buffer Name")) 113 :group 'midnight) 114 115(defcustom clean-buffer-list-kill-buffer-names 116 '("*Help*" "*Apropos*" "*Man " "*Buffer List*" "*Compile-Log*" "*info*" 117 "*vc*" "*vc-diff*" "*diff*") 118 "*List of strings saying which buffers will be killed at midnight. 119Buffers with names in this list, which were not displayed in the last 120`clean-buffer-list-delay-special' seconds, are killed by `clean-buffer-list' 121when is it in `midnight-hook'. 122If a member of the list is a cons, its `car' is the name and its `cdr' is 123the number of seconds to use instead of `clean-buffer-list-delay-special'. 124See also `clean-buffer-list-kill-regexps', 125`clean-buffer-list-kill-never-regexps' and 126`clean-buffer-list-kill-never-buffer-names'." 127 :type '(repeat (string :tag "Buffer Name")) 128 :group 'midnight) 129 130(defcustom clean-buffer-list-kill-never-buffer-names 131 '("*scratch*" "*Messages*" "*server*") 132 "*List of buffer names which will never be killed by `clean-buffer-list'. 133See also `clean-buffer-list-kill-never-regexps'. 134Note that this does override `clean-buffer-list-kill-regexps' and 135`clean-buffer-list-kill-buffer-names' so a buffer matching any of these 136two lists will NOT be killed if it is also present in this list." 137 :type '(repeat (string :tag "Buffer Name")) 138 :group 'midnight) 139 140(defcustom clean-buffer-list-kill-never-regexps '("^ \\*Minibuf-.*\\*$") 141 "*List of regexp saying which buffers will never be killed at midnight. 142See also `clean-buffer-list-kill-never-buffer-names'. 143Killing is done by `clean-buffer-list'. 144Note that this does override `clean-buffer-list-kill-regexps' and 145`clean-buffer-list-kill-buffer-names' so a buffer matching any of these 146two lists will NOT be killed if it also matches anything in this list." 147 :type '(repeat (regexp :tag "Regexp matching Buffer Name")) 148 :group 'midnight) 149 150(defun midnight-find (el ls test &optional key) 151 "A stopgap solution to the absence of `find' in ELisp." 152 (dolist (rr ls) 153 (when (funcall test (if key (funcall key rr) rr) el) 154 (return rr)))) 155 156(defun clean-buffer-list-delay (name) 157 "Return the delay, in seconds, before killing a buffer named NAME. 158Uses `clean-buffer-list-kill-buffer-names', `clean-buffer-list-kill-regexps' 159`clean-buffer-list-delay-general' and `clean-buffer-list-delay-special'. 160Autokilling is done by `clean-buffer-list'." 161 (or (assoc-default name clean-buffer-list-kill-buffer-names 'string= 162 clean-buffer-list-delay-special) 163 (assoc-default name clean-buffer-list-kill-regexps 'string-match 164 clean-buffer-list-delay-special) 165 (* clean-buffer-list-delay-general 24 60 60))) 166 167;;;###autoload 168(defun clean-buffer-list () 169 "Kill old buffers that have not been displayed recently. 170The relevant variables are `clean-buffer-list-delay-general', 171`clean-buffer-list-delay-special', `clean-buffer-list-kill-buffer-names', 172`clean-buffer-list-kill-never-buffer-names', 173`clean-buffer-list-kill-regexps' and 174`clean-buffer-list-kill-never-regexps'. 175While processing buffers, this procedure displays messages containing 176the current date/time, buffer name, how many seconds ago it was 177displayed (can be nil if the buffer was never displayed) and its 178lifetime, i.e., its \"age\" when it will be purged." 179 (interactive) 180 (let ((tm (float-time)) bts (ts (format-time-string "%Y-%m-%d %T")) 181 delay cbld bn) 182 (dolist (buf (buffer-list)) 183 (when (buffer-live-p buf) 184 (setq bts (midnight-buffer-display-time buf) bn (buffer-name buf) 185 delay (if bts (- tm bts) 0) cbld (clean-buffer-list-delay bn)) 186 (message "[%s] `%s' [%s %d]" ts bn (if bts (round delay)) cbld) 187 (unless (or (midnight-find bn clean-buffer-list-kill-never-regexps 188 'string-match) 189 (midnight-find bn clean-buffer-list-kill-never-buffer-names 190 'string-equal) 191 (get-buffer-process buf) 192 (and (buffer-file-name buf) (buffer-modified-p buf)) 193 (get-buffer-window buf 'visible) (< delay cbld)) 194 (message "[%s] killing `%s'" ts bn) 195 (kill-buffer buf)))))) 196 197;;; midnight hook 198 199(defvar midnight-period (* 24 60 60) 200 "The number of seconds in a day--the delta for `midnight-timer'.") 201 202(defcustom midnight-hook '(clean-buffer-list) 203 "The hook run `midnight-delay' seconds after midnight every day. 204The default value is `clean-buffer-list'." 205 :type 'hook 206 :group 'midnight) 207 208(defun midnight-next () 209 "Return the number of seconds till the next midnight." 210 (multiple-value-bind (sec min hrs) (decode-time) 211 (- (* 24 60 60) (* 60 60 hrs) (* 60 min) sec))) 212 213;;;###autoload 214(defun midnight-delay-set (symb tm) 215 "Modify `midnight-timer' according to `midnight-delay'. 216Sets the first argument SYMB (which must be symbol `midnight-delay') 217to its second argument TM." 218 (assert (eq symb 'midnight-delay) t 219 "Invalid argument to `midnight-delay-set': `%s'") 220 (set symb tm) 221 (when (timerp midnight-timer) (cancel-timer midnight-timer)) 222 (setq midnight-timer 223 (run-at-time (if (numberp tm) (+ (midnight-next) tm) tm) 224 midnight-period 'run-hooks 'midnight-hook))) 225 226(defcustom midnight-delay 3600 227 "*The number of seconds after the midnight when the `midnight-timer' is run. 228You should set this variable before loading midnight.el, or 229set it by calling `midnight-delay-set', or use `custom'. 230If you wish, you can use a string instead, it will be passed as the 231first argument to `run-at-time'." 232 :type 'sexp 233 :set 'midnight-delay-set 234 :group 'midnight) 235 236(provide 'midnight) 237 238;;; arch-tag: a5979be9-2890-46a3-ba84-791f0a4a6e80 239;;; midnight.el ends here 240