Mercurial > hg > xemacs
diff shared/alarm.el @ 0:107d592c5f4a
DICE versions, used by pers/common, recursive, I think/hope
author | Henry S. Thompson <ht@inf.ed.ac.uk> |
---|---|
date | Mon, 08 Feb 2021 11:44:37 +0000 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/shared/alarm.el Mon Feb 08 11:44:37 2021 +0000 @@ -0,0 +1,123 @@ +;;; Last edited: Thu Jun 11 10:49:18 1992 +;;; alarm facility for emacs + +(provide 'alarm) + +(defvar alarm-process nil) + +(defvar alarm-callback nil) + +(defun alarm (seconds function) + "After SECONDS, funcall FUNCTION" + (if (and alarm-process + (not (eq (process-status alarm-process) 'exit))) + (error "already waiting") + (setq alarm-callback function) + (setq alarm-process + (start-process "alarm-clock" nil + "/bin/sleep" (format "%d" seconds))) + (set-process-sentinel alarm-process (function alarm-sentinel))) + ) + +(defun alarm-sentinel (process reason) + (setq asm reason) + (if (equal reason "finished\n") + (funcall alarm-callback) + (error "Bogus alarm message: %s" reason))) + +(defun alarm-stop () "turn off alarm" + (interactive) + (set-process-sentinel alarm-process nil) + (kill-process alarm-process) + (setq alarm-process nil)) + +(defvar idle-last-command nil) +(defvar idle-last-input-char nil) +(defvar idle-time nil) +(defvar idle-interval nil) +(defvar idle-function nil) +(defvar idle-count nil) + +(defun idle-timeout (seconds function &optional check-interval) + "If idle for SECONDS, call FUNCTION. Check every CHECK-INTERVAL, or 60 secs" + (setq idle-last-command last-command) + (setq idle-last-input-char last-input-char) + (setq idle-time seconds) + (setq idle-start-time (current-msec-time)) + (setq idle-interval (or check-interval 60)) + (setq idle-count (/ (+ seconds (1- idle-interval)) idle-interval)) + (setq idle-function function) + (alarm idle-interval (function idle-check))) + +(defun idle-check () + (setq idle-count (max (1- idle-count) 0)) +; (message "trying") + (if (and + (eq idle-last-command last-command) +; (message "tic") + (= idle-last-input-char last-input-char) +; (message "toc") + ) + (if (and (= idle-count 0) +; (message "torum") + (or + (let ((last-field-3 (last-event-time))) + ;; allow for wrap + (or (not last-field-3) +; (progn (message "tarum") nil) + (let ((last (logand 8388607 + last-field-3)) + (time (current-msec-time))) +; (message "%d %d %d" last time idle-time) + (> (/ (if (< time last) + (+ (- time last) 8388607) + (- time last)) + 1000) + idle-time)))))) + (save-excursion + (set-buffer (get-buffer-create "*Idle*")) + (insert-string "Idle at " (current-time-string) + (format " :\n %s -> " + idle-function)) + (insert-string (format "%s\n" + (save-excursion (funcall idle-function))))) + (alarm idle-interval (function idle-check))) + (setq idle-last-command last-command) + (setq idle-last-input-char last-input-char) + (setq idle-count (/ (+ idle-time (1- idle-interval)) idle-interval)) + (alarm idle-interval (function idle-check)))) + +(defvar idle-save-timeout nil) + +(defun idle-save (&optional minutes) + "If idle for more MINUTES (defaults to 5), save all changed buffers" + (interactive "nIdle after minutes: ") + (idle-timeout (setq idle-save-timeout (* 60 (or minutes 5))) + (quote idle-save-doit))) + +(defun idle-save-doit () + (let ((bufs (buffer-list)) + result) + (while bufs + (let ((buf (car bufs)) file-name) + (if (and (buffer-modified-p buf) + (setq file-name (buffer-file-name buf)) + (string-match "\\.babyl$" file-name)) + (progn (set-buffer buf) + (let ((require-final-newline nil)) + (save-buffer) + (setq result (cons file-name result)))))) + (setq bufs (cdr bufs))) + (idle-timeout idle-save-timeout (quote idle-save-doit)) + (if result + (mapconcat (function identity) + result + " ") + "nil"))) + +;; defaults +(defun current-msec-time () (the-time)) +(defun last-event-time () + (and (boundp '*last-event*) + (> (length *last-event*) 3) + (elt *last-event* 3)))