Merge remote-tracking branch 'sourceforge/master'
[emacs-jabber.git] / jabber-autoaway.el
blob9e4cbdc6cf3aeebae8c527d0fa9a672808f4f839
1 ;;; jabber-autoaway.el --- change status to away after idleness
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
7 ;; Author: Magnus Henoch <mange@freemail.hu>
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.
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.
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.
24 (eval-when-compile (require 'cl))
25 (require 'time-date)
27 (defgroup jabber-autoaway nil
28 "Change status to away after idleness"
29 :group 'jabber)
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))
45 (defcustom jabber-autoaway-timeout 5
46 "Minutes of inactivity before changing status to away"
47 :group 'jabber-autoaway
48 :type 'number)
50 (defcustom jabber-autoaway-xa-timeout 10
51 "Minutes of inactivity before changing status to xa. Set to 0 to disable."
52 :group 'jabber-autoaway
53 :type 'number)
55 (defcustom jabber-autoaway-status "Idle"
56 "Status string for autoaway"
57 :group 'jabber-autoaway
58 :type 'string)
60 (defcustom jabber-autoaway-xa-status "Extended away"
61 "Status string for autoaway in xa state"
62 :group 'jabber-autoaway
63 :type 'string)
65 (defcustom jabber-autoaway-priority nil
66 "Priority for autoaway.
67 If nil, don't change priority. See the manual for more
68 information about priority."
69 :group 'jabber-autoaway
70 :type '(choice (const :tag "Don't change")
71 (integer :tag "Priority"))
72 :link '(info-link "(jabber)Presence"))
74 (defcustom jabber-autoaway-xa-priority nil
75 "Priority for autoaway in xa state.
76 If nil, don't change priority. See the manual for more
77 information about priority."
78 :group 'jabber-autoaway
79 :type '(choice (const :tag "Don't change")
80 (integer :tag "Priority"))
81 :link '(info-link "(jabber)Presence"))
83 (defcustom jabber-xprintidle-program (executable-find "xprintidle")
84 "Name of the xprintidle program"
85 :group 'jabber-autoaway
86 :type 'string)
88 (defcustom jabber-autoaway-verbose nil
89 "If nil, don't print autoaway status messages."
90 :group 'jabber-autoaway
91 :type 'boolean)
93 (defvar jabber-autoaway-timer nil)
95 (defvar jabber-autoaway-last-idle-time nil
96 "Seconds of idle time the last time we checked.
97 This is used to detect whether the user has become unidle.")
99 (defun jabber-autoaway-message (&rest args)
100 (when jabber-autoaway-verbose
101 (apply #'message args)))
103 ;;;###autoload
104 (defun jabber-autoaway-start (&optional ignored)
105 "Start autoaway timer.
106 The IGNORED argument is there so you can put this function in
107 `jabber-post-connect-hooks'."
108 (interactive)
109 (unless jabber-autoaway-timer
110 (setq jabber-autoaway-timer
111 (run-with-timer (* jabber-autoaway-timeout 60) nil #'jabber-autoaway-timer))
112 (jabber-autoaway-message "Autoaway timer started")))
114 (defun jabber-autoaway-stop ()
115 "Stop autoaway timer."
116 (interactive)
117 (when jabber-autoaway-timer
118 (jabber-cancel-timer jabber-autoaway-timer)
119 (setq jabber-autoaway-timer nil)
120 (jabber-autoaway-message "Autoaway timer stopped")))
122 (defun jabber-autoaway-get-idle-time ()
123 "Get idle time in seconds according to jabber-autoaway-methods.
124 Return nil on error."
125 (car (sort (mapcar 'funcall jabber-autoaway-methods) (lambda (a b) (if a (if b (< a b) t) nil)))))
127 (defun jabber-autoaway-timer ()
128 ;; We use one-time timers, so reset the variable.
129 (setq jabber-autoaway-timer nil)
130 (let ((idle-time (jabber-autoaway-get-idle-time)))
131 (when (numberp idle-time)
132 ;; Has "idle timeout" passed?
133 (if (> idle-time (* 60 jabber-autoaway-timeout))
134 ;; If so, mark ourselves idle.
135 (jabber-autoaway-set-idle)
136 ;; Else, start a timer for the remaining amount.
137 (setq jabber-autoaway-timer
138 (run-with-timer (- (* 60 jabber-autoaway-timeout) idle-time)
139 nil #'jabber-autoaway-timer))))))
141 (defun jabber-autoaway-set-idle (&optional xa)
142 (jabber-autoaway-message "Autoaway triggered")
143 ;; Send presence, unless the user has set a custom presence
144 (unless (member *jabber-current-show* '("xa" "dnd"))
145 (jabber-send-presence
146 (if xa "xa" "away")
147 (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*)
148 (or (if xa jabber-autoaway-priority jabber-autoaway-xa-priority) *jabber-current-priority*)))
150 (setq jabber-autoaway-last-idle-time (jabber-autoaway-get-idle-time))
151 ;; Run unidle timer every 10 seconds (if xa specified, timer already running)
152 (unless xa
153 (setq jabber-autoaway-timer (run-with-timer 10 10
154 #'jabber-autoaway-maybe-unidle))))
156 (defun jabber-autoaway-maybe-unidle ()
157 (let ((idle-time (jabber-autoaway-get-idle-time)))
158 (jabber-autoaway-message "Idle for %d seconds" idle-time)
159 ;; As long as idle time increases monotonically, stay idle.
160 (if (> idle-time jabber-autoaway-last-idle-time)
161 (progn
162 ;; Has "Xa timeout" passed?
163 (if (and (> jabber-autoaway-xa-timeout 0) (> idle-time (* 60 jabber-autoaway-xa-timeout)))
164 ;; iIf so, mark ourselves xa.
165 (jabber-autoaway-set-idle t))
166 (setq jabber-autoaway-last-idle-time idle-time))
167 ;; But if it doesn't, go back to unidle state.
168 (jabber-autoaway-message "Back to unidle")
169 ;; But don't mess with the user's custom presence.
170 (if (or (string= *jabber-current-status* jabber-autoaway-status) (string= *jabber-current-status* jabber-autoaway-xa-status))
171 (jabber-send-default-presence)
172 (progn
173 (jabber-send-presence jabber-default-show *jabber-current-status* jabber-default-priority)
174 (jabber-autoaway-message "%S /= %S - not resetting presence" *jabber-current-status* jabber-autoaway-status)))
175 (jabber-autoaway-stop)
176 (jabber-autoaway-start))))
178 (defun jabber-xprintidle-get-idle-time ()
179 "Get idle time through the xprintidle program."
180 (when jabber-xprintidle-program
181 (with-temp-buffer
182 (when (zerop (call-process jabber-xprintidle-program
183 nil t))
184 (/ (string-to-number (buffer-string)) 1000.0)))))
186 (defun jabber-termatime-get-idle-time ()
187 "Get idle time through atime of terminal.
188 The method for finding the terminal only works on GNU/Linux."
189 (let ((terminal (cond
190 ((file-exists-p "/proc/self/fd/0")
191 "/proc/self/fd/0")
193 nil))))
194 (when terminal
195 (let* ((atime-of-tty (nth 4 (file-attributes terminal)))
196 (diff (time-to-seconds (time-since atime-of-tty))))
197 (when (> diff 0)
198 diff)))))
200 (defun jabber-current-idle-time ()
201 "Get idle time through `current-idle-time'.
202 `current-idle-time' was introduced in Emacs 22."
203 (if (fboundp 'current-idle-time)
204 (let ((idle-time (current-idle-time)))
205 (if (null idle-time)
207 (float-time idle-time)))))
209 (provide 'jabber-autoaway)
210 ;; arch-tag: 5bcea14c-842d-11da-a120-000a95c2fcd0