(require 'erc)
(eval-when-compile (require 'cl))
(defgroup erc-netsplit nil
"Netsplit detection tries to automatically figure when a
netsplit happens, and filters the QUIT messages. It also keeps
track of netsplits, so that it can filter the JOIN messages on a netjoin too."
:group 'erc)
(define-erc-module netsplit nil
"This mode hides quit/join messages if a netsplit occurs."
((erc-netsplit-install-message-catalogs)
(add-hook 'erc-server-JOIN-functions 'erc-netsplit-JOIN)
(add-hook 'erc-server-MODE-functions 'erc-netsplit-MODE)
(add-hook 'erc-server-QUIT-functions 'erc-netsplit-QUIT)
(add-hook 'erc-timer-hook 'erc-netsplit-timer))
((remove-hook 'erc-server-JOIN-functions 'erc-netsplit-JOIN)
(remove-hook 'erc-server-MODE-functions 'erc-netsplit-MODE)
(remove-hook 'erc-server-QUIT-functions 'erc-netsplit-QUIT)
(remove-hook 'erc-timer-hook 'erc-netsplit-timer)))
(defcustom erc-netsplit-show-server-mode-changes-flag nil
"Set to t to enable display of server mode changes."
:group 'erc-netsplit
:type 'boolean)
(defcustom erc-netsplit-debug nil
"If non-nil, debug messages will be shown in the
sever buffer."
:group 'erc-netsplit
:type 'boolean)
(defcustom erc-netsplit-regexp
"^[^ @!\"\n]+\\.[^ @!\n]+ [^ @!\n]+\\.[^ @!\"\n]+$"
"This regular expression should match quit reasons produced
by netsplits."
:group 'erc-netsplit
:type 'regexp)
(defcustom erc-netsplit-hook nil
"Run whenever a netsplit is detected the first time.
Args: PROC is the process the netsplit originated from and
SPLIT is the netsplit (e.g. \"server.name.1 server.name.2\")."
:group 'erc-hooks
:type 'hook)
(defcustom erc-netjoin-hook nil
"Run whenever a netjoin is detected the first time.
Args: PROC is the process the netjoin originated from and
SPLIT is the netsplit (e.g. \"server.name.1 server.name.2\")."
:group 'erc-hooks
:type 'hook)
(defvar erc-netsplit-list nil
"This is a list of the form
\((\"a.b.c.d e.f.g\" TIMESTAMP FIRST-JOIN \"nick1\" ... \"nickn\") ...)
where FIRST-JOIN is t or nil, depending on whether or not the first
join from that split has been detected or not.")
(make-variable-buffer-local 'erc-netsplit-list)
(defun erc-netsplit-install-message-catalogs ()
(erc-define-catalog
'english
'((netsplit . "netsplit: %s")
(netjoin . "netjoin: %s, %N were split")
(netjoin-done . "netjoin: All lost souls are back!")
(netsplit-none . "No netsplits in progress")
(netsplit-wholeft . "split: %s missing: %n %t"))))
(defun erc-netsplit-JOIN (proc parsed)
"Show/don't show rejoins."
(let ((nick (erc-response.sender parsed))
(no-next-hook nil))
(dolist (elt erc-netsplit-list)
(if (member nick (nthcdr 3 elt))
(progn
(if (not (caddr elt))
(progn
(erc-display-message
parsed 'notice (process-buffer proc)
'netjoin ?s (car elt) ?N (length (nthcdr 3 elt)))
(setcar (nthcdr 2 elt) t)
(run-hook-with-args 'erc-netjoin-hook proc (car elt))))
(if (null (nthcdr 4 elt))
(progn
(erc-display-message
parsed 'notice (process-buffer proc)
'netjoin-done ?s (car elt))
(setq erc-netsplit-list (delq elt erc-netsplit-list)))
(delete nick elt))
(setq no-next-hook t))))
no-next-hook))
(defun erc-netsplit-MODE (proc parsed)
"Hide mode changes from servers."
(when (string-match "^[^@!\n]+\\.[^@!\n]+$" (erc-response.sender parsed))
(and erc-netsplit-debug
(erc-display-message
parsed 'notice (process-buffer proc)
"[debug] server mode change."))
(not erc-netsplit-show-server-mode-changes-flag)))
(defun erc-netsplit-QUIT (proc parsed)
"Detect netsplits."
(let ((split (erc-response.contents parsed))
(nick (erc-response.sender parsed))
ass)
(when (string-match erc-netsplit-regexp split)
(setq ass (assoc split erc-netsplit-list))
(if ass
(progn
(setcdr (nthcdr 2 ass) (cons nick (nthcdr 3 ass)))
(when (caddr ass)
(erc-display-message
parsed 'notice (process-buffer proc)
'netsplit ?s split)
(setcar (nthcdr 2 ass) t)
(run-hook-with-args 'erc-netsplit-hook proc split)))
(setq erc-netsplit-list
(cons (list split
(erc-current-time)
nil
nick)
erc-netsplit-list))
(erc-display-message
parsed 'notice (process-buffer proc)
'netsplit ?s split)
(run-hook-with-args 'erc-netsplit-hook proc split))
t)))
(defun erc-netsplit-timer (now)
"Clean cruft from `erc-netsplit-list' older than 10 minutes."
(dolist (elt erc-netsplit-list)
(when (> (erc-time-diff (cadr elt) now) 600)
(when erc-netsplit-debug
(erc-display-message
nil 'notice (current-buffer)
(concat "Netsplit: Removing " (car elt))))
(setq erc-netsplit-list (delq elt erc-netsplit-list)))))
(defun erc-cmd-WHOLEFT ()
"Show who's gone."
(erc-with-server-buffer
(if (null erc-netsplit-list)
(erc-display-message
nil 'notice 'active
'netsplit-none)
(dolist (elt erc-netsplit-list)
(erc-display-message
nil 'notice 'active
'netsplit-wholeft ?s (car elt)
?n (mapconcat 'erc-extract-nick (nthcdr 3 elt) " ")
?t (if (caddr elt)
"(joining)"
"")))))
t)
(defalias 'erc-cmd-WL 'erc-cmd-WHOLEFT)
(provide 'erc-netsplit)