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