crepu.dev Git - config.git/blob - djavu-asus/emacs/elpa/jabber-20230715.456/jabber-autoaway.el

1 ;;; jabber-autoaway.el --- change status to away after idleness -*- lexical-binding: t; -*-

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

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.

52 Set to 0 to disable."

53 :group 'jabber-autoaway

54 :type 'number)

56 (defcustom jabber-autoaway-status "Idle"

57 "Status string for autoaway."

58 :group 'jabber-autoaway

59 :type 'string)

61 (defcustom jabber-autoaway-xa-status "Extended away"

62 "Status string for autoaway in xa state."

63 :group 'jabber-autoaway

64 :type 'string)

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

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

84 (defcustom jabber-xprintidle-program (executable-find "xprintidle")

85 "Name of the xprintidle program."

86 :group 'jabber-autoaway

87 :type 'string)

89 (defcustom jabber-autoaway-verbose nil

90 "If nil, don't print autoaway status messages."

91 :group 'jabber-autoaway

92 :type 'boolean)

94 (defvar jabber-autoaway-timer nil)

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

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