1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
|
;;; circe-lagmon.el --- Lag Monitor for Circe
;; Copyright (C) 2011-2012 Jorgen Schaefer
;; Author: John J Foerch <jjfoerch@earthlink.net>,
;; Jorgen Schaefer
;; This file is part of Circe.
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 3
;; of the License, or (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;; 02110-1301, USA.
;;; Commentary:
;;;
;;; Circe-lagmon-mode monitors the amount of lag on your connection to
;;; each server, and displays the lag time in seconds in the mode-line.
;;; It works by managing two timers. Timer1 sends CTCP LAGMON to yourself
;;; on each server every 60 seconds. Each time around, timer1 starts
;;; timer2 to monitor for timeouts of these messages. Timer2 cancels
;;; itself when all of the pings in the round have been answered.
;;;
;;; Code:
(require 'circe)
;;; User variables
(defgroup circe-lagmon nil
"Lag Monitor for Circe"
:prefix "circe-lagmon-"
:group 'circe)
(defcustom circe-lagmon-timer-tick 5
"How often to check for lag.
Increase this to improve performance at the cost of accuracy."
:type 'number
:group 'circe-lagmon)
(defcustom circe-lagmon-check-interval 60
"Interval in seconds at which to send the CTCP message."
:type 'number
:group 'circe-lagmon)
(defcustom circe-lagmon-reconnect-interval 120
"Seconds after which to automatically reconnect upon a timeout
of a lag monitor message. A value of nil disables the feature."
:type '(choice (const :tag "Disable auto-reconnect" nil)
number)
:group 'circe-lagmon)
(defcustom circe-lagmon-mode-line-format-string "lag:%.1f "
"Format string for displaying the lag in the mode-line."
:type 'string
:group 'circe-lagmon)
(defcustom circe-lagmon-mode-line-unknown-lag-string "lag:? "
"Indicator string for displaying unknown lag in the mode-line."
:type 'string
:group 'circe-lagmon)
(defvar circe-lagmon-disabled nil
"A boolean value if lagmon should be disabled on this network.
Don't set this by hand, use `circe-network-options'.")
(make-variable-buffer-local 'circe-lagmon-disabled)
;;; Internal variables
;;;
(defvar circe-lagmon-timer nil)
(defvar circe-lagmon-server-lag nil)
(make-variable-buffer-local 'circe-lagmon-server-lag)
(defvar circe-lagmon-last-send-time nil)
(make-variable-buffer-local 'circe-lagmon-last-send-time)
(defvar circe-lagmon-last-receive-time nil)
(make-variable-buffer-local 'circe-lagmon-last-receive-time)
(defun circe-lagmon-timer-tick ()
"Function run periodically to check lag.
This will call `circe-lagmon-server-check' in every active server
buffer. You can call it yourself if you like to force an update,
there is no harm in running it too often, but it really should be
run sufficiently often with the timer."
(dolist (buffer (circe-server-buffers))
(with-current-buffer buffer
(when (and (eq major-mode 'circe-server-mode)
circe-server-process
(eq (irc-connection-state circe-server-process)
'registered)
(not circe-lagmon-disabled))
(circe-lagmon-server-check)))))
(defun circe-lagmon-server-check ()
"Check the current server for lag.
This will reconnect if we haven't heard back for too long, or
send a request if it's time for that. See
`circe-lagmon-reconnect-interval' and
`circe-lagmon-check-interval' to configure the behavior.."
(let ((now (float-time)))
(cond
;; No answer so far...
((and circe-lagmon-last-send-time
(not circe-lagmon-last-receive-time))
;; Count up until the answer comes.
(let ((lag (/ (- now circe-lagmon-last-send-time) 2)))
(when (or (not circe-lagmon-server-lag)
(> lag circe-lagmon-server-lag))
(setq circe-lagmon-server-lag lag)
(circe-lagmon-force-mode-line-update)))
;; Check for timeout.
(when (and circe-lagmon-reconnect-interval
(> now
(+ circe-lagmon-last-send-time
circe-lagmon-reconnect-interval)))
(setq circe-lagmon-last-send-time nil
circe-lagmon-last-receive-time nil)
(circe-reconnect)))
;; Nothing sent so far, or last send was too long ago.
((or (not circe-lagmon-last-send-time)
(> now
(+ circe-lagmon-last-send-time
circe-lagmon-check-interval)))
(irc-send-raw (circe-server-process)
(format "PRIVMSG %s :\C-aLAGMON %s\C-a"
(circe-nick) now)
:nowait)
(setq circe-lagmon-last-send-time now
circe-lagmon-last-receive-time nil))
)))
(defun circe-lagmon-force-mode-line-update ()
"Call force-mode-line-update on a circe server buffer and all
of its chat buffers."
(force-mode-line-update)
(dolist (b (circe-server-chat-buffers))
(with-current-buffer b
(force-mode-line-update))))
(defun circe-lagmon-format-mode-line-entry ()
"Format the mode-line entry for displaying the lag."
(let ((buf (cond
((eq major-mode 'circe-server-mode)
(current-buffer))
(circe-server-buffer
circe-server-buffer)
(t
nil))))
(when buf
(with-current-buffer buf
(cond
(circe-lagmon-disabled
nil)
(circe-lagmon-server-lag
(format circe-lagmon-mode-line-format-string
circe-lagmon-server-lag))
(t
circe-lagmon-mode-line-unknown-lag-string))))))
(defun circe-lagmon-init ()
"Initialize the values of the lag monitor for one server, and
start the lag monitor if it has not been started."
(setq circe-lagmon-server-lag nil
circe-lagmon-last-send-time nil
circe-lagmon-last-receive-time nil)
(circe-lagmon-force-mode-line-update)
(unless circe-lagmon-timer
(setq circe-lagmon-timer
(run-at-time nil circe-lagmon-timer-tick
'circe-lagmon-timer-tick))))
(defun circe-lagmon--rpl-welcome-handler (conn &rest ignored)
(with-current-buffer (irc-connection-get conn :server-buffer)
(circe-lagmon-init)))
(defun circe-lagmon--ctcp-lagmon-handler (conn event sender target argument)
(when (irc-current-nick-p conn (irc-userstring-nick sender))
(with-current-buffer (irc-connection-get conn :server-buffer)
(let* ((now (float-time))
(lag (/ (- now (string-to-number argument))
2)))
(setq circe-lagmon-server-lag lag
circe-lagmon-last-receive-time now)
(circe-lagmon-force-mode-line-update)))))
(defun circe-lagmon--nick-handler (conn event sender new-nick)
(when (irc-current-nick-p conn (irc-userstring-nick sender))
(with-current-buffer (irc-connection-get conn :server-buffer)
(setq circe-lagmon-last-send-time nil))))
;;;###autoload
(define-minor-mode circe-lagmon-mode
"Circe-lagmon-mode monitors the amount of lag on your
connection to each server, and displays the lag time in seconds
in the mode-line."
:global t
(let ((mode-line-entry '(:eval (circe-lagmon-format-mode-line-entry))))
(remove-hook 'mode-line-modes mode-line-entry)
(let ((table (circe-irc-handler-table)))
(irc-handler-remove table "001" 'circe-lagmon--rpl-welcome-handler)
(irc-handler-remove table "irc.ctcp.LAGMON"
'circe-lagmon--ctcp-lagmon-handler)
(irc-handler-remove table "NICK" 'circe-lagmon--nick-handler))
(circe-set-display-handler "irc.ctcp.LAGMON" nil)
(when circe-lagmon-timer
(cancel-timer circe-lagmon-timer)
(setq circe-lagmon-timer nil))
(when circe-lagmon-mode
(add-hook 'mode-line-modes mode-line-entry)
(let ((table (circe-irc-handler-table)))
(irc-handler-add table "001" 'circe-lagmon--rpl-welcome-handler)
(irc-handler-add table "irc.ctcp.LAGMON"
'circe-lagmon--ctcp-lagmon-handler)
(irc-handler-add table "NICK" 'circe-lagmon--nick-handler))
(circe-set-display-handler "irc.ctcp.LAGMON" 'circe-display-ignore)
(dolist (buffer (circe-server-buffers))
(with-current-buffer buffer
(setq circe-lagmon-server-lag nil)
(when (and circe-server-process
(eq (irc-connection-state circe-server-process)
'registered))
(circe-lagmon-init)))))))
(provide 'circe-lagmon)
;;; circe-lagmon.el ends here
|
