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)))