lisp/emacs-lisp/timer-list.el

   1 ;;; timer-list.el --- list active timers in a buffer
   2
   3 ;; Copyright (C) 2016-2017 Free Software Foundation, Inc.
   4
   5 ;; Maintainer: emacs-devel@gnu.org
   6 ;; Package: emacs
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 ;;;###autoload
  28 (defun timer-list (&optional _ignore-auto _nonconfirm)
  29   "List all timers in a buffer."
  30   (interactive)
  31   (pop-to-buffer-same-window (get-buffer-create "*timer-list*"))
  32   (let ((inhibit-read-only t))
  33     (erase-buffer)
  34     (timer-list-mode)
  35     (dolist (timer (append timer-list timer-idle-list))
  36       (insert (format "%4s %10s %8s %s"
  37                       ;; Idle.
  38                       (if (aref timer 7)
  39                           "*"
  40                         " ")
  41                       ;; Next time.
  42                       (let ((time (float-time (list (aref timer 1)
  43                                                     (aref timer 2)
  44                                                     (aref timer 3)))))
  45                         (format "%.2f"
  46                                 (if (aref timer 7)
  47                                     time
  48                                   (- (float-time (list (aref timer 1)
  49                                                        (aref timer 2)
  50                                                        (aref timer 3)))
  51                                      (float-time)))))
  52                       ;; Repeat.
  53                       (let ((repeat (aref timer 4)))
  54                         (cond
  55                          ((numberp repeat)
  56                           (format "%.2f" (/ repeat 60)))
  57                          ((null repeat)
  58                           "-")
  59                          (t
  60                           (format "%s" repeat))))
  61                       ;; Function.
  62                       (let ((function (aref timer 5)))
  63                         (replace-regexp-in-string
  64                          "\n" " "
  65                          (cond
  66                           ((byte-code-function-p function)
  67                            (replace-regexp-in-string
  68                             "[^-A-Za-z0-9 ]" ""
  69                             (format "%s" function)))
  70                           (t
  71                            (format "%s" function)))))))
  72       (put-text-property (line-beginning-position)
  73                          (1+ (line-beginning-position))
  74                          'timer timer)
  75       (insert "\n")))
  76   (goto-char (point-min)))
  77 ;; This command can be destructive if they don't know what they are
  78 ;; doing.  Kids, don't try this at home!
  79 ;;;###autoload (put 'timer-list 'disabled "Beware: manually canceling timers can ruin your Emacs session.")
  80
  81 (defvar timer-list-mode-map
  82   (let ((map (make-sparse-keymap)))
  83     (define-key map "c" 'timer-list-cancel)
  84     (easy-menu-define nil map ""
  85       '("Timers"
  86         ["Cancel" timer-list-cancel t]))
  87     map))
  88
  89 (define-derived-mode timer-list-mode special-mode "timer-list"
  90   "Mode for listing and controlling timers."
  91   (setq truncate-lines t)
  92   (buffer-disable-undo)
  93   (setq-local revert-buffer-function 'timer-list)
  94   (setq buffer-read-only t)
  95   (setq header-line-format
  96         (format "%4s %10s %8s %s"
  97                 "Idle" "Next" "Repeat" "Function")))
  98
  99 (defun timer-list-cancel ()
 100   "Cancel the timer on the line under point."
 101   (interactive)
 102   (let ((timer (get-text-property (line-beginning-position) 'timer))
 103         (inhibit-read-only t))
 104     (unless timer
 105       (error "No timer on the current line"))
 106     (cancel-timer timer)
 107     (delete-region (line-beginning-position)
 108                    (line-beginning-position 2))))
 109
 110 (provide 'timer-list)
 111
 112 ;;; timer-list.el ends here