Commit | Line | Data |
---|---|---|
597993cf MB |
1 | ;;; erc-netsplit.el --- Reduce JOIN/QUIT messages on netsplits |
2 | ||
f0fa15c5 | 3 | ;; Copyright (C) 2002, 2003, 2004, 2006, 2007 Free Software Foundation, Inc. |
597993cf MB |
4 | |
5 | ;; Author: Mario Lang <mlang@delysid.org> | |
6 | ;; Keywords: comm | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
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 | |
e0085d62 | 12 | ;; the Free Software Foundation; either version 3, or (at your option) |
597993cf MB |
13 | ;; any later version. |
14 | ||
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. | |
19 | ||
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. | |
24 | ||
25 | ;;; Commentary: | |
26 | ||
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) | |
31 | ||
32 | ;;; Code: | |
33 | ||
34 | (require 'erc) | |
35 | (eval-when-compile (require 'cl)) | |
36 | ||
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." | |
41 | :group 'erc) | |
42 | ||
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))) | |
55 | ||
56 | (defcustom erc-netsplit-show-server-mode-changes-flag nil | |
57 | "Set to t to enable display of server mode changes." | |
58 | :group 'erc-netsplit | |
59 | :type 'boolean) | |
60 | ||
61 | (defcustom erc-netsplit-debug nil | |
62 | "If non-nil, debug messages will be shown in the | |
63 | sever buffer." | |
64 | :group 'erc-netsplit | |
65 | :type 'boolean) | |
66 | ||
21bc768b MB |
67 | (defcustom erc-netsplit-regexp |
68 | "^[^ @!\"\n]+\\.[^ @!\n]+ [^ @!\n]+\\.[^ @!\"\n]+$" | |
597993cf MB |
69 | "This regular expression should match quit reasons produced |
70 | by netsplits." | |
71 | :group 'erc-netsplit | |
72 | :type 'regexp) | |
73 | ||
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\")." | |
78 | :group 'erc-hooks | |
79 | :type 'hook) | |
80 | ||
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\")." | |
85 | :group 'erc-hooks | |
86 | :type 'hook) | |
87 | ||
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) | |
94 | ||
95 | (defun erc-netsplit-install-message-catalogs () | |
96 | (erc-define-catalog | |
97 | 'english | |
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")))) | |
103 | ||
104 | (defun erc-netsplit-JOIN (proc parsed) | |
105 | "Show/don't show rejoins." | |
106 | (let ((nick (erc-response.sender parsed)) | |
107 | (no-next-hook nil)) | |
108 | (dolist (elt erc-netsplit-list) | |
109 | (if (member nick (nthcdr 3 elt)) | |
110 | (progn | |
111 | (if (not (caddr elt)) | |
112 | (progn | |
113 | (erc-display-message | |
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 | |
121 | ;; suppressed. | |
122 | (if (null (nthcdr 4 elt)) | |
123 | (progn | |
124 | (erc-display-message | |
125 | parsed 'notice (process-buffer proc) | |
126 | 'netjoin-done ?s (car elt)) | |
127 | (setq erc-netsplit-list (delq elt erc-netsplit-list))) | |
128 | (delete nick elt)) | |
129 | (setq no-next-hook t)))) | |
130 | no-next-hook)) | |
131 | ||
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. | |
21bc768b | 135 | (when (string-match "^[^@!\n]+\\.[^@!\n]+$" (erc-response.sender parsed)) |
597993cf MB |
136 | (and erc-netsplit-debug |
137 | (erc-display-message | |
138 | parsed 'notice (process-buffer proc) | |
139 | "[debug] server mode change.")) | |
140 | (not erc-netsplit-show-server-mode-changes-flag))) | |
141 | ||
142 | (defun erc-netsplit-QUIT (proc parsed) | |
143 | "Detect netsplits." | |
144 | (let ((split (erc-response.contents parsed)) | |
145 | (nick (erc-response.sender parsed)) | |
146 | ass) | |
147 | (when (string-match erc-netsplit-regexp split) | |
148 | (setq ass (assoc split erc-netsplit-list)) | |
149 | (if ass | |
150 | ;; element for this netsplit exists already | |
151 | (progn | |
152 | (setcdr (nthcdr 2 ass) (cons nick (nthcdr 3 ass))) | |
153 | (when (caddr ass) | |
154 | ;; There was already a netjoin for this netsplit, it | |
155 | ;; seems like the old one didn't get finished... | |
156 | (erc-display-message | |
157 | parsed 'notice (process-buffer proc) | |
158 | 'netsplit ?s split) | |
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 | |
163 | (cons (list split | |
164 | (erc-current-time) | |
165 | nil | |
166 | nick) | |
167 | erc-netsplit-list)) | |
168 | (erc-display-message | |
169 | parsed 'notice (process-buffer proc) | |
170 | 'netsplit ?s split) | |
171 | (run-hook-with-args 'erc-netsplit-hook proc split)) | |
172 | t))) | |
173 | ||
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 | |
179 | (erc-display-message | |
180 | nil 'notice (current-buffer) | |
181 | (concat "Netsplit: Removing " (car elt)))) | |
182 | (setq erc-netsplit-list (delq elt erc-netsplit-list))))) | |
183 | ||
184 | ;;;###autoload | |
185 | (defun erc-cmd-WHOLEFT () | |
186 | "Show who's gone." | |
ff59d266 | 187 | (erc-with-server-buffer |
597993cf MB |
188 | (if (null erc-netsplit-list) |
189 | (erc-display-message | |
190 | nil 'notice 'active | |
191 | 'netsplit-none) | |
192 | (dolist (elt erc-netsplit-list) | |
193 | (erc-display-message | |
194 | nil 'notice 'active | |
195 | 'netsplit-wholeft ?s (car elt) | |
196 | ?n (mapconcat 'erc-extract-nick (nthcdr 3 elt) " ") | |
197 | ?t (if (caddr elt) | |
198 | "(joining)" | |
199 | ""))))) | |
200 | t) | |
201 | ||
202 | (defalias 'erc-cmd-WL 'erc-cmd-WHOLEFT) | |
203 | ||
204 | (provide 'erc-netsplit) | |
205 | ||
206 | ;;; erc-netsplit.el ends here | |
207 | ;; | |
208 | ;; Local Variables: | |
209 | ;; indent-tabs-mode: t | |
210 | ;; tab-width: 8 | |
211 | ;; End: | |
212 | ||
213 | ;; arch-tag: 61a85cb0-7e7b-4312-a4f6-313c7a25a6e8 |