]> crepu.dev Git - config.git/blame - djavu-asus/emacs/elpa/jabber-20230715.456/jabber-autoaway.el
Reorganización de directorios
[config.git] / djavu-asus / emacs / elpa / jabber-20230715.456 / jabber-autoaway.el
CommitLineData
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.
38This is a list of functions that takes no arguments, and returns the
39number 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.
52Set 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.
68If nil, don't change priority. See the manual for more
69information 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.
77If nil, don't change priority. See the manual for more
78information 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.
98This 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.
107The 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'.
125Return 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.
190The 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