1 ;;; erc-netsplit.el --- Reduce JOIN/QUIT messages on netsplits
3 ;; Copyright (C) 2002, 2003, 2004, 2006, 2007 Free Software Foundation, Inc.
5 ;; Author: Mario Lang <mlang@delysid.org>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 3, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
27 ;; This module hides quit/join messages if a netsplit occurs.
28 ;; To enable, add the following to your ~/.emacs:
29 ;; (require 'erc-netsplit)
30 ;; (erc-netsplit-mode 1)
35 (eval-when-compile (require 'cl
))
37 (defgroup erc-netsplit nil
38 "Netsplit detection tries to automatically figure when a
39 netsplit happens, and filters the QUIT messages. It also keeps
40 track of netsplits, so that it can filter the JOIN messages on a netjoin too."
43 ;;;###autoload (autoload 'erc-netsplit-mode "erc-netsplit")
44 (define-erc-module netsplit nil
45 "This mode hides quit/join messages if a netsplit occurs."
46 ((erc-netsplit-install-message-catalogs)
47 (add-hook 'erc-server-JOIN-functions
'erc-netsplit-JOIN
)
48 (add-hook 'erc-server-MODE-functions
'erc-netsplit-MODE
)
49 (add-hook 'erc-server-QUIT-functions
'erc-netsplit-QUIT
)
50 (add-hook 'erc-timer-hook
'erc-netsplit-timer
))
51 ((remove-hook 'erc-server-JOIN-functions
'erc-netsplit-JOIN
)
52 (remove-hook 'erc-server-MODE-functions
'erc-netsplit-MODE
)
53 (remove-hook 'erc-server-QUIT-functions
'erc-netsplit-QUIT
)
54 (remove-hook 'erc-timer-hook
'erc-netsplit-timer
)))
56 (defcustom erc-netsplit-show-server-mode-changes-flag nil
57 "Set to t to enable display of server mode changes."
61 (defcustom erc-netsplit-debug nil
62 "If non-nil, debug messages will be shown in the
67 (defcustom erc-netsplit-regexp
68 "^[^ @!\"\n]+\\.[^ @!\n]+ [^ @!\n]+\\.[^ @!\"\n]+$"
69 "This regular expression should match quit reasons produced
74 (defcustom erc-netsplit-hook nil
75 "Run whenever a netsplit is detected the first time.
76 Args: PROC is the process the netsplit originated from and
77 SPLIT is the netsplit (e.g. \"server.name.1 server.name.2\")."
81 (defcustom erc-netjoin-hook nil
82 "Run whenever a netjoin is detected the first time.
83 Args: PROC is the process the netjoin originated from and
84 SPLIT is the netsplit (e.g. \"server.name.1 server.name.2\")."
88 (defvar erc-netsplit-list nil
89 "This is a list of the form
90 \((\"a.b.c.d e.f.g\" TIMESTAMP FIRST-JOIN \"nick1\" ... \"nickn\") ...)
91 where FIRST-JOIN is t or nil, depending on whether or not the first
92 join from that split has been detected or not.")
93 (make-variable-buffer-local 'erc-netsplit-list
)
95 (defun erc-netsplit-install-message-catalogs ()
98 '((netsplit .
"netsplit: %s")
99 (netjoin .
"netjoin: %s, %N were split")
100 (netjoin-done .
"netjoin: All lost souls are back!")
101 (netsplit-none .
"No netsplits in progress")
102 (netsplit-wholeft .
"split: %s missing: %n %t"))))
104 (defun erc-netsplit-JOIN (proc parsed
)
105 "Show/don't show rejoins."
106 (let ((nick (erc-response.sender parsed
))
108 (dolist (elt erc-netsplit-list
)
109 (if (member nick
(nthcdr 3 elt
))
111 (if (not (caddr elt
))
114 parsed
'notice
(process-buffer proc
)
115 'netjoin ?s
(car elt
) ?N
(length (nthcdr 3 elt
)))
116 (setcar (nthcdr 2 elt
) t
)
117 (run-hook-with-args 'erc-netjoin-hook proc
(car elt
))))
118 ;; need to remove this nick, perhaps the whole entry here.
119 ;; Note that by removing the nick now, we can't tell if further
120 ;; join messages (for other channels) should also be
122 (if (null (nthcdr 4 elt
))
125 parsed
'notice
(process-buffer proc
)
126 'netjoin-done ?s
(car elt
))
127 (setq erc-netsplit-list
(delq elt erc-netsplit-list
)))
129 (setq no-next-hook t
))))
132 (defun erc-netsplit-MODE (proc parsed
)
133 "Hide mode changes from servers."
134 ;; regexp matches things with a . in them, and no ! or @ in them.
135 (when (string-match "^[^@!\n]+\\.[^@!\n]+$" (erc-response.sender parsed
))
136 (and erc-netsplit-debug
138 parsed
'notice
(process-buffer proc
)
139 "[debug] server mode change."))
140 (not erc-netsplit-show-server-mode-changes-flag
)))
142 (defun erc-netsplit-QUIT (proc parsed
)
144 (let ((split (erc-response.contents parsed
))
145 (nick (erc-response.sender parsed
))
147 (when (string-match erc-netsplit-regexp split
)
148 (setq ass
(assoc split erc-netsplit-list
))
150 ;; element for this netsplit exists already
152 (setcdr (nthcdr 2 ass
) (cons nick
(nthcdr 3 ass
)))
154 ;; There was already a netjoin for this netsplit, it
155 ;; seems like the old one didn't get finished...
157 parsed
'notice
(process-buffer proc
)
159 (setcar (nthcdr 2 ass
) t
)
160 (run-hook-with-args 'erc-netsplit-hook proc split
)))
161 ;; element for this netsplit does not yet exist
162 (setq erc-netsplit-list
169 parsed
'notice
(process-buffer proc
)
171 (run-hook-with-args 'erc-netsplit-hook proc split
))
174 (defun erc-netsplit-timer (now)
175 "Clean cruft from `erc-netsplit-list' older than 10 minutes."
176 (dolist (elt erc-netsplit-list
)
177 (when (> (erc-time-diff (cadr elt
) now
) 600)
178 (when erc-netsplit-debug
180 nil
'notice
(current-buffer)
181 (concat "Netsplit: Removing " (car elt
))))
182 (setq erc-netsplit-list
(delq elt erc-netsplit-list
)))))
185 (defun erc-cmd-WHOLEFT ()
187 (erc-with-server-buffer
188 (if (null erc-netsplit-list
)
192 (dolist (elt erc-netsplit-list
)
195 'netsplit-wholeft ?s
(car elt
)
196 ?n
(mapconcat 'erc-extract-nick
(nthcdr 3 elt
) " ")
202 (defalias 'erc-cmd-WL
'erc-cmd-WHOLEFT
)
204 (provide 'erc-netsplit
)
206 ;;; erc-netsplit.el ends here
209 ;; indent-tabs-mode: t
213 ;; arch-tag: 61a85cb0-7e7b-4312-a4f6-313c7a25a6e8