Mercurial > hg > xemacs
view shared/alarm.el @ 60:77aefd805030
consume pwd on encryption
author | Henry S Thompson <ht@inf.ed.ac.uk> |
---|---|
date | Fri, 05 Apr 2024 09:11:09 +0100 |
parents | 107d592c5f4a |
children |
line wrap: on
line source
;;; 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)))