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