Mercurial > hg > xemacs

comparison shared/alarm.el @ 0:107d592c5f4a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
-1:000000000000 0:107d592c5f4a
1 ;;; Last edited: Thu Jun 11 10:49:18 1992
2 ;;; alarm facility for emacs
3
4 (provide 'alarm)
5
6 (defvar alarm-process nil)
7
8 (defvar alarm-callback nil)
9
10 (defun alarm (seconds function)
11 "After SECONDS, funcall FUNCTION"
12 (if (and alarm-process
13 (not (eq (process-status alarm-process) 'exit)))
14 (error "already waiting")
15 (setq alarm-callback function)
16 (setq alarm-process
17 (start-process "alarm-clock" nil
18 "/bin/sleep" (format "%d" seconds)))
19 (set-process-sentinel alarm-process (function alarm-sentinel)))
20 )
21
22 (defun alarm-sentinel (process reason)
23 (setq asm reason)
24 (if (equal reason "finished\n")
25 (funcall alarm-callback)
26 (error "Bogus alarm message: %s" reason)))
27
28 (defun alarm-stop () "turn off alarm"
29 (interactive)
30 (set-process-sentinel alarm-process nil)
31 (kill-process alarm-process)
32 (setq alarm-process nil))
33
34 (defvar idle-last-command nil)
35 (defvar idle-last-input-char nil)
36 (defvar idle-time nil)
37 (defvar idle-interval nil)
38 (defvar idle-function nil)
39 (defvar idle-count nil)
40
41 (defun idle-timeout (seconds function &optional check-interval)
42 "If idle for SECONDS, call FUNCTION. Check every CHECK-INTERVAL, or 60 secs"
43 (setq idle-last-command last-command)
44 (setq idle-last-input-char last-input-char)
45 (setq idle-time seconds)
46 (setq idle-start-time (current-msec-time))
47 (setq idle-interval (or check-interval 60))
48 (setq idle-count (/ (+ seconds (1- idle-interval)) idle-interval))
49 (setq idle-function function)
50 (alarm idle-interval (function idle-check)))
51
52 (defun idle-check ()
53 (setq idle-count (max (1- idle-count) 0))
54 ; (message "trying")
55 (if (and
56 (eq idle-last-command last-command)
57 ; (message "tic")
58 (= idle-last-input-char last-input-char)
59 ; (message "toc")
60 )
61 (if (and (= idle-count 0)
62 ; (message "torum")
63 (or
64 (let ((last-field-3 (last-event-time)))
65 ;; allow for wrap
66 (or (not last-field-3)
67 ; (progn (message "tarum") nil)
68 (let ((last (logand 8388607
69 last-field-3))
70 (time (current-msec-time)))
71 ; (message "%d %d %d" last time idle-time)
72 (> (/ (if (< time last)
73 (+ (- time last) 8388607)
74 (- time last))
75 1000)
76 idle-time))))))
77 (save-excursion
78 (set-buffer (get-buffer-create "*Idle*"))
79 (insert-string "Idle at " (current-time-string)
80 (format " :\n %s -> "
81 idle-function))
82 (insert-string (format "%s\n"
83 (save-excursion (funcall idle-function)))))
84 (alarm idle-interval (function idle-check)))
85 (setq idle-last-command last-command)
86 (setq idle-last-input-char last-input-char)
87 (setq idle-count (/ (+ idle-time (1- idle-interval)) idle-interval))
88 (alarm idle-interval (function idle-check))))
89
90 (defvar idle-save-timeout nil)
91
92 (defun idle-save (&optional minutes)
93 "If idle for more MINUTES (defaults to 5), save all changed buffers"
94 (interactive "nIdle after minutes: ")
95 (idle-timeout (setq idle-save-timeout (* 60 (or minutes 5)))
96 (quote idle-save-doit)))
97
98 (defun idle-save-doit ()
99 (let ((bufs (buffer-list))
100 result)
101 (while bufs
102 (let ((buf (car bufs)) file-name)
103 (if (and (buffer-modified-p buf)
104 (setq file-name (buffer-file-name buf))
105 (string-match "\\.babyl$" file-name))
106 (progn (set-buffer buf)
107 (let ((require-final-newline nil))
108 (save-buffer)
109 (setq result (cons file-name result))))))
110 (setq bufs (cdr bufs)))
111 (idle-timeout idle-save-timeout (quote idle-save-doit))
112 (if result
113 (mapconcat (function identity)
114 result
115 " ")
116 "nil")))
117
118 ;; defaults
119 (defun current-msec-time () (the-time))
120 (defun last-event-time ()
121 (and (boundp '*last-event*)
122 (> (length *last-event*) 3)
123 (elt *last-event* 3)))