]>
Commit | Line | Data |
---|---|---|
53e6db90 DC |
1 | ;;; jabber-autoaway.el --- change status to away after idleness -*- lexical-binding: t; -*- |
2 | ||
3 | ;; Copyright (C) 2010 - Kirill A. Korinskiy - catap@catap.ru | |
4 | ;; Copyright (C) 2010 - Terechkov Evgenii - evg@altlinux.org | |
5 | ;; Copyright (C) 2006, 2008 Magnus Henoch | |
6 | ||
7 | ;; Author: Magnus Henoch <mange@freemail.hu> | |
8 | ||
9 | ;; This file is free software; you can redistribute it and/or modify | |
10 | ;; it under the terms of the GNU General Public License as published by | |
11 | ;; the Free Software Foundation; either version 2, or (at your option) | |
12 | ;; any later version. | |
13 | ||
14 | ;; This file is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;; GNU General Public License for more details. | |
18 | ||
19 | ;; You should have received a copy of the GNU General Public License | |
20 | ;; along with GNU Emacs; see the file COPYING. If not, write to | |
21 | ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
22 | ;; Boston, MA 02110-1301, USA. | |
23 | ||
24 | (eval-when-compile (require 'cl-lib)) | |
25 | (require 'time-date) | |
26 | ||
27 | (defgroup jabber-autoaway nil | |
28 | "Change status to away after idleness." | |
29 | :group 'jabber) | |
30 | ||
31 | (defcustom jabber-autoaway-methods | |
32 | (if (fboundp 'jabber-autoaway-method) | |
33 | (list jabber-autoaway-method) | |
34 | (list 'jabber-current-idle-time | |
35 | 'jabber-xprintidle-get-idle-time | |
36 | 'jabber-termatime-get-idle-time)) | |
37 | "Methods used to keep track of idleness. | |
38 | This is a list of functions that takes no arguments, and returns the | |
39 | number of seconds since the user was active, or nil on error." | |
40 | :group 'jabber-autoaway | |
41 | :options '(jabber-current-idle-time | |
42 | jabber-xprintidle-get-idle-time | |
43 | jabber-termatime-get-idle-time)) | |
44 | ||
45 | (defcustom jabber-autoaway-timeout 5 | |
46 | "Minutes of inactivity before changing status to away." | |
47 | :group 'jabber-autoaway | |
48 | :type 'number) | |
49 | ||
50 | (defcustom jabber-autoaway-xa-timeout 10 | |
51 | "Minutes of inactivity before changing status to xa. | |
52 | Set to 0 to disable." | |
53 | :group 'jabber-autoaway | |
54 | :type 'number) | |
55 | ||
56 | (defcustom jabber-autoaway-status "Idle" | |
57 | "Status string for autoaway." | |
58 | :group 'jabber-autoaway | |
59 | :type 'string) | |
60 | ||
61 | (defcustom jabber-autoaway-xa-status "Extended away" | |
62 | "Status string for autoaway in xa state." | |
63 | :group 'jabber-autoaway | |
64 | :type 'string) | |
65 | ||
66 | (defcustom jabber-autoaway-priority nil | |
67 | "Priority for autoaway. | |
68 | If nil, don't change priority. See the manual for more | |
69 | information about priority." | |
70 | :group 'jabber-autoaway | |
71 | :type '(choice (const :tag "Don't change") | |
72 | (integer :tag "Priority")) | |
73 | :link '(info-link "(jabber)Presence")) | |
74 | ||
75 | (defcustom jabber-autoaway-xa-priority nil | |
76 | "Priority for autoaway in xa state. | |
77 | If nil, don't change priority. See the manual for more | |
78 | information about priority." | |
79 | :group 'jabber-autoaway | |
80 | :type '(choice (const :tag "Don't change") | |
81 | (integer :tag "Priority")) | |
82 | :link '(info-link "(jabber)Presence")) | |
83 | ||
84 | (defcustom jabber-xprintidle-program (executable-find "xprintidle") | |
85 | "Name of the xprintidle program." | |
86 | :group 'jabber-autoaway | |
87 | :type 'string) | |
88 | ||
89 | (defcustom jabber-autoaway-verbose nil | |
90 | "If nil, don't print autoaway status messages." | |
91 | :group 'jabber-autoaway | |
92 | :type 'boolean) | |
93 | ||
94 | (defvar jabber-autoaway-timer nil) | |
95 | ||
96 | (defvar jabber-autoaway-last-idle-time nil | |
97 | "Seconds of idle time the last time we checked. | |
98 | This is used to detect whether the user has become unidle.") | |
99 | ||
100 | (defun jabber-autoaway-message (&rest args) | |
101 | (when jabber-autoaway-verbose | |
102 | (apply #'message args))) | |
103 | ||
104 | ;;;###autoload | |
105 | (defun jabber-autoaway-start (&optional ignored) | |
106 | "Start autoaway timer. | |
107 | The IGNORED argument is there so you can put this function in | |
108 | `jabber-post-connect-hooks'." | |
109 | (interactive) | |
110 | (unless jabber-autoaway-timer | |
111 | (setq jabber-autoaway-timer | |
112 | (run-with-timer (* jabber-autoaway-timeout 60) nil #'jabber-autoaway-timer)) | |
113 | (jabber-autoaway-message "Autoaway timer started"))) | |
114 | ||
115 | (defun jabber-autoaway-stop () | |
116 | "Stop autoaway timer." | |
117 | (interactive) | |
118 | (when jabber-autoaway-timer | |
119 | (jabber-cancel-timer jabber-autoaway-timer) | |
120 | (setq jabber-autoaway-timer nil) | |
121 | (jabber-autoaway-message "Autoaway timer stopped"))) | |
122 | ||
123 | (defun jabber-autoaway-get-idle-time () | |
124 | "Get idle time in seconds according to `jabber-autoaway-methods'. | |
125 | Return nil on error." | |
126 | (car (sort (mapcar 'funcall jabber-autoaway-methods) (lambda (a b) (if a (if b (< a b) t) nil))))) | |
127 | ||
128 | (defun jabber-autoaway-timer () | |
129 | ;; We use one-time timers, so reset the variable. | |
130 | (setq jabber-autoaway-timer nil) | |
131 | (let ((idle-time (jabber-autoaway-get-idle-time))) | |
132 | (when (numberp idle-time) | |
133 | ;; Has "idle timeout" passed? | |
134 | (if (> idle-time (* 60 jabber-autoaway-timeout)) | |
135 | ;; If so, mark ourselves idle. | |
136 | (jabber-autoaway-set-idle) | |
137 | ;; Else, start a timer for the remaining amount. | |
138 | (setq jabber-autoaway-timer | |
139 | (run-with-timer (- (* 60 jabber-autoaway-timeout) idle-time) | |
140 | nil #'jabber-autoaway-timer)))))) | |
141 | ||
142 | (defun jabber-autoaway-set-idle (&optional xa) | |
143 | (jabber-autoaway-message "Autoaway triggered") | |
144 | ;; Send presence, unless the user has set a custom presence | |
145 | (unless (member *jabber-current-show* '("xa" "dnd")) | |
146 | (jabber-send-presence | |
147 | (if xa "xa" "away") | |
148 | (if (or (string= *jabber-current-status* jabber-default-status) (string= *jabber-current-status* jabber-autoaway-status)) (if xa jabber-autoaway-xa-status jabber-autoaway-status) *jabber-current-status*) | |
149 | (or (if xa jabber-autoaway-priority jabber-autoaway-xa-priority) *jabber-current-priority*))) | |
150 | ||
151 | (setq jabber-autoaway-last-idle-time (jabber-autoaway-get-idle-time)) | |
152 | ;; Run unidle timer every 10 seconds (if xa specified, timer already running) | |
153 | (unless xa | |
154 | (setq jabber-autoaway-timer (run-with-timer 10 10 | |
155 | #'jabber-autoaway-maybe-unidle)))) | |
156 | ||
157 | (defun jabber-autoaway-maybe-unidle () | |
158 | (let ((idle-time (jabber-autoaway-get-idle-time))) | |
159 | (jabber-autoaway-message "Idle for %d seconds" idle-time) | |
160 | (if (member *jabber-current-show* '("xa" "away")) | |
161 | ;; As long as idle time increases monotonically, stay idle. | |
162 | (if (> idle-time jabber-autoaway-last-idle-time) | |
163 | (progn | |
164 | ;; Has "Xa timeout" passed? | |
165 | (if (and (> jabber-autoaway-xa-timeout 0) (> idle-time (* 60 jabber-autoaway-xa-timeout))) | |
166 | ;; iIf so, mark ourselves xa. | |
167 | (jabber-autoaway-set-idle t)) | |
168 | (setq jabber-autoaway-last-idle-time idle-time)) | |
169 | ;; But if it doesn't, go back to unidle state. | |
170 | (jabber-autoaway-message "Back to unidle") | |
171 | ;; But don't mess with the user's custom presence. | |
172 | (if (or (string= *jabber-current-status* jabber-autoaway-status) (string= *jabber-current-status* jabber-autoaway-xa-status)) | |
173 | (jabber-send-default-presence) | |
174 | (progn | |
175 | (jabber-send-presence jabber-default-show *jabber-current-status* jabber-default-priority) | |
176 | (jabber-autoaway-message "%S /= %S - not resetting presence" *jabber-current-status* jabber-autoaway-status))) | |
177 | (jabber-autoaway-stop) | |
178 | (jabber-autoaway-start))))) | |
179 | ||
180 | (defun jabber-xprintidle-get-idle-time () | |
181 | "Get idle time through the xprintidle program." | |
182 | (when jabber-xprintidle-program | |
183 | (with-temp-buffer | |
184 | (when (zerop (call-process jabber-xprintidle-program | |
185 | nil t)) | |
186 | (/ (string-to-number (buffer-string)) 1000.0))))) | |
187 | ||
188 | (defun jabber-termatime-get-idle-time () | |
189 | "Get idle time through atime of terminal. | |
190 | The method for finding the terminal only works on GNU/Linux." | |
191 | (let ((terminal (cond | |
192 | ((file-exists-p "/proc/self/fd/0") | |
193 | "/proc/self/fd/0") | |
194 | (t | |
195 | nil)))) | |
196 | (when terminal | |
197 | (let* ((atime-of-tty (nth 4 (file-attributes terminal))) | |
198 | (diff (time-to-seconds (time-since atime-of-tty)))) | |
199 | (when (> diff 0) | |
200 | diff))))) | |
201 | ||
202 | (defun jabber-current-idle-time () | |
203 | "Get idle time through `current-idle-time'. | |
204 | `current-idle-time' was introduced in Emacs 22." | |
205 | (if (fboundp 'current-idle-time) | |
206 | (let ((idle-time (current-idle-time))) | |
207 | (if (null idle-time) | |
208 | 0 | |
209 | (float-time idle-time))))) | |
210 | ||
211 | (provide 'jabber-autoaway) | |
212 | ;; arch-tag: 5bcea14c-842d-11da-a120-000a95c2fcd0 |