Merge from origin/emacs-24
[emacs.git] / lisp / erc / erc-netsplit.el
blob35fa84f41768ac178a07bedbfedde52a1c25de20
1 ;;; erc-netsplit.el --- Reduce JOIN/QUIT messages on netsplits
3 ;; Copyright (C) 2002-2004, 2006-2015 Free Software Foundation, Inc.
5 ;; Author: Mario Lang <mlang@delysid.org>
6 ;; Maintainer: emacs-devel@gnu.org
7 ;; Keywords: comm
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 ;;; Commentary:
26 ;; This module hides quit/join messages if a netsplit occurs.
27 ;; To enable, add the following to your init file:
28 ;; (require 'erc-netsplit)
29 ;; (erc-netsplit-mode 1)
31 ;;; Code:
33 (require 'erc)
35 (defgroup erc-netsplit nil
36 "Netsplit detection tries to automatically figure when a
37 netsplit happens, and filters the QUIT messages. It also keeps
38 track of netsplits, so that it can filter the JOIN messages on a netjoin too."
39 :group 'erc)
41 ;;;###autoload (autoload 'erc-netsplit-mode "erc-netsplit")
42 (define-erc-module netsplit nil
43 "This mode hides quit/join messages if a netsplit occurs."
44 ((erc-netsplit-install-message-catalogs)
45 (add-hook 'erc-server-JOIN-functions 'erc-netsplit-JOIN)
46 (add-hook 'erc-server-MODE-functions 'erc-netsplit-MODE)
47 (add-hook 'erc-server-QUIT-functions 'erc-netsplit-QUIT)
48 (add-hook 'erc-timer-hook 'erc-netsplit-timer))
49 ((remove-hook 'erc-server-JOIN-functions 'erc-netsplit-JOIN)
50 (remove-hook 'erc-server-MODE-functions 'erc-netsplit-MODE)
51 (remove-hook 'erc-server-QUIT-functions 'erc-netsplit-QUIT)
52 (remove-hook 'erc-timer-hook 'erc-netsplit-timer)))
54 (defcustom erc-netsplit-show-server-mode-changes-flag nil
55 "Set to t to enable display of server mode changes."
56 :group 'erc-netsplit
57 :type 'boolean)
59 (defcustom erc-netsplit-debug nil
60 "If non-nil, debug messages will be shown in the
61 sever buffer."
62 :group 'erc-netsplit
63 :type 'boolean)
65 (defcustom erc-netsplit-regexp
66 "^[^ @!\"\n]+\\.[^ @!\n]+ [^ @!\n]+\\.[^ @!\"\n]+$"
67 "This regular expression should match quit reasons produced
68 by netsplits."
69 :group 'erc-netsplit
70 :type 'regexp)
72 (defcustom erc-netsplit-hook nil
73 "Run whenever a netsplit is detected the first time.
74 Args: PROC is the process the netsplit originated from and
75 SPLIT is the netsplit (e.g. \"server.name.1 server.name.2\")."
76 :group 'erc-hooks
77 :type 'hook)
79 (defcustom erc-netjoin-hook nil
80 "Run whenever a netjoin is detected the first time.
81 Args: PROC is the process the netjoin originated from and
82 SPLIT is the netsplit (e.g. \"server.name.1 server.name.2\")."
83 :group 'erc-hooks
84 :type 'hook)
86 (defvar erc-netsplit-list nil
87 "This is a list of the form
88 \((\"a.b.c.d e.f.g\" TIMESTAMP FIRST-JOIN \"nick1\" ... \"nickn\") ...)
89 where FIRST-JOIN is t or nil, depending on whether or not the first
90 join from that split has been detected or not.")
91 (make-variable-buffer-local 'erc-netsplit-list)
93 (defun erc-netsplit-install-message-catalogs ()
94 (erc-define-catalog
95 'english
96 '((netsplit . "netsplit: %s")
97 (netjoin . "netjoin: %s, %N were split")
98 (netjoin-done . "netjoin: All lost souls are back!")
99 (netsplit-none . "No netsplits in progress")
100 (netsplit-wholeft . "split: %s missing: %n %t"))))
102 (defun erc-netsplit-JOIN (proc parsed)
103 "Show/don't show rejoins."
104 (let ((nick (erc-response.sender parsed))
105 (no-next-hook nil))
106 (dolist (elt erc-netsplit-list)
107 (if (member nick (nthcdr 3 elt))
108 (progn
109 (if (not (nth 2 elt))
110 (progn
111 (erc-display-message
112 parsed 'notice (process-buffer proc)
113 'netjoin ?s (car elt) ?N (length (nthcdr 3 elt)))
114 (setcar (nthcdr 2 elt) t)
115 (run-hook-with-args 'erc-netjoin-hook proc (car elt))))
116 ;; need to remove this nick, perhaps the whole entry here.
117 ;; Note that by removing the nick now, we can't tell if further
118 ;; join messages (for other channels) should also be
119 ;; suppressed.
120 (if (null (nthcdr 4 elt))
121 (progn
122 (erc-display-message
123 parsed 'notice (process-buffer proc)
124 'netjoin-done ?s (car elt))
125 (setq erc-netsplit-list (delq elt erc-netsplit-list)))
126 (delete nick elt))
127 (setq no-next-hook t))))
128 no-next-hook))
130 (defun erc-netsplit-MODE (proc parsed)
131 "Hide mode changes from servers."
132 ;; regexp matches things with a . in them, and no ! or @ in them.
133 (when (string-match "^[^@!\n]+\\.[^@!\n]+$" (erc-response.sender parsed))
134 (and erc-netsplit-debug
135 (erc-display-message
136 parsed 'notice (process-buffer proc)
137 "[debug] server mode change."))
138 (not erc-netsplit-show-server-mode-changes-flag)))
140 (defun erc-netsplit-QUIT (proc parsed)
141 "Detect netsplits."
142 (let ((split (erc-response.contents parsed))
143 (nick (erc-response.sender parsed))
144 ass)
145 (when (string-match erc-netsplit-regexp split)
146 (setq ass (assoc split erc-netsplit-list))
147 (if ass
148 ;; element for this netsplit exists already
149 (progn
150 (setcdr (nthcdr 2 ass) (cons nick (nthcdr 3 ass)))
151 (when (nth 2 ass)
152 ;; There was already a netjoin for this netsplit, it
153 ;; seems like the old one didn't get finished...
154 (erc-display-message
155 parsed 'notice (process-buffer proc)
156 'netsplit ?s split)
157 (setcar (nthcdr 2 ass) t)
158 (run-hook-with-args 'erc-netsplit-hook proc split)))
159 ;; element for this netsplit does not yet exist
160 (setq erc-netsplit-list
161 (cons (list split
162 (erc-current-time)
164 nick)
165 erc-netsplit-list))
166 (erc-display-message
167 parsed 'notice (process-buffer proc)
168 'netsplit ?s split)
169 (run-hook-with-args 'erc-netsplit-hook proc split))
170 t)))
172 (defun erc-netsplit-timer (now)
173 "Clean cruft from `erc-netsplit-list' older than 10 minutes."
174 (when erc-server-connected
175 (dolist (elt erc-netsplit-list)
176 (when (> (erc-time-diff (cadr elt) now) 600)
177 (when erc-netsplit-debug
178 (erc-display-message
179 nil 'notice (current-buffer)
180 (concat "Netsplit: Removing " (car elt))))
181 (setq erc-netsplit-list (delq elt erc-netsplit-list))))))
183 ;;;###autoload
184 (defun erc-cmd-WHOLEFT ()
185 "Show who's gone."
186 (erc-with-server-buffer
187 (if (null erc-netsplit-list)
188 (erc-display-message
189 nil 'notice 'active
190 'netsplit-none)
191 (dolist (elt erc-netsplit-list)
192 (erc-display-message
193 nil 'notice 'active
194 'netsplit-wholeft ?s (car elt)
195 ?n (mapconcat 'erc-extract-nick (nthcdr 3 elt) " ")
196 ?t (if (nth 2 elt)
197 "(joining)"
198 "")))))
201 (defalias 'erc-cmd-WL 'erc-cmd-WHOLEFT)
203 (provide 'erc-netsplit)
205 ;;; erc-netsplit.el ends here
207 ;; Local Variables:
208 ;; indent-tabs-mode: t
209 ;; tab-width: 8
210 ;; End: