X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b87c4ff2817e71ca71b028792200b1e069a95e04..9f2f14a0725211b13a744573344636b57b9c98b9:/lisp/erc/erc-backend.el diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 4e11f9548b..e07dc90fcd 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1,10 +1,10 @@ ;;; erc-backend.el --- Backend network communication for ERC -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. +;; Copyright (C) 2004-2015 Free Software Foundation, Inc. ;; Filename: erc-backend.el ;; Author: Lawrence Mitchell -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Created: 2004-05-7 ;; Keywords: IRC chat client internet @@ -370,13 +370,13 @@ This overrides `erc-server-coding-system' depending on the current target as returned by `erc-default-target'. Example: If you know that the channel #linux-ru uses the coding-system -`cyrillic-koi8', then add '(\"#linux-ru\" . cyrillic-koi8) to the +`cyrillic-koi8', then add (\"#linux-ru\" . cyrillic-koi8) to the alist." :group 'erc-server :type '(repeat (cons (string :tag "Target") coding-system))) -(defcustom erc-server-connect-function 'open-network-stream +(defcustom erc-server-connect-function 'erc-open-network-stream "Function used to initiate a connection. It should take same arguments as `open-network-stream' does." :group 'erc-server @@ -493,9 +493,19 @@ The current buffer is given by BUFFER." 4 erc-server-send-ping-interval #'erc-server-send-ping buffer)) - (setq erc-server-ping-timer-alist (cons (cons buffer - erc-server-ping-handler) - erc-server-ping-timer-alist))))) + + ;; I check the timer alist for an existing timer. If one exists, + ;; I get rid of it + (let ((timer-tuple (assq buffer erc-server-ping-timer-alist))) + (if timer-tuple + ;; this buffer already has a timer. Cancel it and set the new one + (progn + (erc-cancel-timer (cdr timer-tuple)) + (setf (cdr (assq buffer erc-server-ping-timer-alist)) erc-server-ping-handler)) + + ;; no existing timer for this buffer. Add new one + (add-to-list 'erc-server-ping-timer-alist + (cons buffer erc-server-ping-handler))))))) (defun erc-server-process-alive (&optional buffer) "Return non-nil when BUFFER has an `erc-server-process' open or running." @@ -505,51 +515,53 @@ The current buffer is given by BUFFER." (memq (process-status erc-server-process) '(run open))))) ;;;; Connecting to a server +(defun erc-open-network-stream (name buffer host service) + "As `open-network-stream', but does non-blocking IO" + (make-network-process :name name :buffer buffer + :host host :service service :nowait t)) (defun erc-server-connect (server port buffer) "Perform the connection and login using the specified SERVER and PORT. We will store server variables in the buffer given by BUFFER." - (let ((msg (erc-format-message 'connect ?S server ?p port))) + (let ((msg (erc-format-message 'connect ?S server ?p port)) process) (message "%s" msg) - (let ((process (funcall erc-server-connect-function - (format "erc-%s-%s" server port) - nil server port))) - (unless (processp process) - (error "Connection attempt failed")) + (setq process (funcall erc-server-connect-function + (format "erc-%s-%s" server port) nil server port)) + (unless (processp process) + (error "Connection attempt failed")) + ;; Misc server variables + (with-current-buffer buffer + (setq erc-server-process process) + (setq erc-server-quitting nil) + (setq erc-server-reconnecting nil) + (setq erc-server-timed-out nil) + (setq erc-server-banned nil) + (setq erc-server-error-occurred nil) + (let ((time (erc-current-time))) + (setq erc-server-last-sent-time time) + (setq erc-server-last-ping-time time) + (setq erc-server-last-received-time time)) + (setq erc-server-lines-sent 0) + ;; last peers (sender and receiver) + (setq erc-server-last-peers '(nil . nil))) + ;; we do our own encoding and decoding + (when (fboundp 'set-process-coding-system) + (set-process-coding-system process 'raw-text)) + ;; process handlers + (set-process-sentinel process 'erc-process-sentinel) + (set-process-filter process 'erc-server-filter-function) + (set-process-buffer process buffer) + (erc-log "\n\n\n********************************************\n") + (message "%s" (erc-format-message + 'login ?n + (with-current-buffer buffer (erc-current-nick)))) + ;; wait with script loading until we receive a confirmation (first + ;; MOTD line) + (if (eq (process-status process) 'connect) + ;; waiting for a non-blocking connect - keep the user informed + (erc-display-message nil nil buffer "Opening connection..\n") (message "%s...done" msg) - ;; Misc server variables - (with-current-buffer buffer - (setq erc-server-process process) - (setq erc-server-quitting nil) - (setq erc-server-reconnecting nil) - (setq erc-server-timed-out nil) - (setq erc-server-banned nil) - (setq erc-server-error-occurred nil) - (let ((time (erc-current-time))) - (setq erc-server-last-sent-time time) - (setq erc-server-last-ping-time time) - (setq erc-server-last-received-time time)) - (setq erc-server-lines-sent 0) - ;; last peers (sender and receiver) - (setq erc-server-last-peers '(nil . nil))) - ;; we do our own encoding and decoding - (when (fboundp 'set-process-coding-system) - (set-process-coding-system process 'raw-text)) - ;; process handlers - (set-process-sentinel process 'erc-process-sentinel) - (set-process-filter process 'erc-server-filter-function) - (set-process-buffer process buffer))) - (erc-log "\n\n\n********************************************\n") - (message "%s" (erc-format-message - 'login ?n - (with-current-buffer buffer (erc-current-nick)))) - ;; wait with script loading until we receive a confirmation (first - ;; MOTD line) - (if (eq erc-server-connect-function 'open-network-stream-nowait) - ;; it's a bit unclear otherwise that it's attempting to establish a - ;; connection - (erc-display-message nil nil buffer "Opening connection..\n") - (erc-login))) + (erc-login)) )) (defun erc-server-reconnect () "Reestablish the current IRC connection. @@ -565,10 +577,15 @@ Make sure you are in an ERC buffer when running this." (setq erc-server-last-sent-time 0) (setq erc-server-lines-sent 0) (let ((erc-server-connect-function (or erc-session-connector - 'open-network-stream))) + 'erc-open-network-stream))) (erc-open erc-session-server erc-session-port erc-server-current-nick erc-session-user-full-name t erc-session-password))))) +(defun erc-server-delayed-reconnect (event buffer) + (if (buffer-live-p buffer) + (with-current-buffer buffer + (erc-server-reconnect)))) + (defun erc-server-filter-function (process string) "The process filter for the ERC server." (with-current-buffer (process-buffer process) @@ -615,17 +632,16 @@ EVENT is the message received from the closed connection process." (or erc-server-timed-out (not (string-match "^deleted" event))) ;; open-network-stream-nowait error for connection refused - (not (string-match "^failed with code 111" event))))) + (if (string-match "^failed with code 111" event) 'nonblocking t)))) (defun erc-process-sentinel-2 (event buffer) "Called when `erc-process-sentinel-1' has detected an unexpected disconnect." (if (not (buffer-live-p buffer)) (erc-update-mode-line) (with-current-buffer buffer - (let ((reconnect-p (erc-server-reconnect-p event))) - (erc-display-message nil 'error (current-buffer) - (if reconnect-p 'disconnected - 'disconnected-noreconnect)) + (let ((reconnect-p (erc-server-reconnect-p event)) message delay) + (setq message (if reconnect-p 'disconnected 'disconnected-noreconnect)) + (erc-display-message nil 'error (current-buffer) message) (if (not reconnect-p) ;; terminate, do not reconnect (progn @@ -637,23 +653,16 @@ EVENT is the message received from the closed connection process." ;; reconnect (condition-case err (progn - (setq erc-server-reconnecting nil) - (erc-server-reconnect) - (setq erc-server-reconnect-count 0)) - (error (when (buffer-live-p buffer) - (set-buffer buffer) - (if (integerp erc-server-reconnect-attempts) - (setq erc-server-reconnect-count - (1+ erc-server-reconnect-count)) - (message "%s ... %s" - "Reconnecting until we succeed" - "kill the ERC server buffer to stop")) - (if (numberp erc-server-reconnect-timeout) - (run-at-time erc-server-reconnect-timeout nil - #'erc-process-sentinel-2 - event buffer) - (error (concat "`erc-server-reconnect-timeout`" - " must be a number"))))))))))) + (setq erc-server-reconnecting nil + erc-server-reconnect-count (1+ erc-server-reconnect-count)) + (setq delay erc-server-reconnect-timeout) + (run-at-time delay nil + #'erc-server-delayed-reconnect event buffer)) + (error (unless (integerp erc-server-reconnect-attempts) + (message "%s ... %s" + "Reconnecting until we succeed" + "kill the ERC server buffer to stop")) + (erc-server-delayed-reconnect event buffer)))))))) (defun erc-process-sentinel-1 (event buffer) "Called when `erc-process-sentinel' has decided that we're disconnecting. @@ -679,7 +688,7 @@ Conditionally try to reconnect and take appropriate action." (when (buffer-live-p buf) (with-current-buffer buf (erc-log (format - "SENTINEL: proc: %S status: %S event: %S (quitting: %S)" + "SENTINEL: proc: %S status: %S event: %S (quitting: %S)" cproc (process-status cproc) event erc-server-quitting)) (if (string-match "^open" event) ;; newly opened connection (no wait) @@ -692,6 +701,9 @@ Conditionally try to reconnect and take appropriate action." (setq erc-server-ping-handler nil))) (run-hook-with-args 'erc-disconnected-hook (erc-current-nick) (system-name) "") + (dolist (buf (erc-buffer-filter (lambda () (boundp 'erc-channel-users)) cproc)) + (with-current-buffer buf + (setq erc-channel-users (make-hash-table :test 'equal)))) ;; Remove the prompt (goto-char (or (marker-position erc-input-marker) (point-max))) (forward-line 0) @@ -794,7 +806,9 @@ protection algorithm." (defun erc-server-send-ping (buf) "Send a ping to the IRC server buffer in BUF. Additionally, detect whether the IRC process has hung." - (if (buffer-live-p buf) + (if (and (buffer-live-p buf) + (with-current-buffer buf + erc-server-last-received-time)) (with-current-buffer buf (if (and erc-server-send-ping-timeout (> @@ -1082,7 +1096,7 @@ As an example: Would expand to: (prog2 - (defvar erc-server-311-functions 'erc-server-311 + (defvar erc-server-311-functions \\='erc-server-311 \"Some non-generic variable documentation. Hook called upon receiving a 311 server response. @@ -1100,12 +1114,12 @@ Would expand to: add things to `erc-server-311-functions' instead.\" (do-stuff-with-whois proc parsed)) - (puthash \"311\" 'erc-server-311-functions erc-server-responses) - (puthash \"WHOIS\" 'erc-server-WHOIS-functions erc-server-responses) - (puthash \"WI\" 'erc-server-WI-functions erc-server-responses) + (puthash \"311\" \\='erc-server-311-functions erc-server-responses) + (puthash \"WHOIS\" \\='erc-server-WHOIS-functions erc-server-responses) + (puthash \"WI\" \\='erc-server-WI-functions erc-server-responses) - (defalias 'erc-server-WHOIS 'erc-server-311) - (defvar erc-server-WHOIS-functions 'erc-server-311 + (defalias \\='erc-server-WHOIS \\='erc-server-311) + (defvar erc-server-WHOIS-functions \\='erc-server-311 \"Some non-generic variable documentation. Hook called upon receiving a WHOIS server response. @@ -1116,8 +1130,8 @@ Would expand to: See also `erc-server-311'.\") - (defalias 'erc-server-WI 'erc-server-311) - (defvar erc-server-WI-functions 'erc-server-311 + (defalias \\='erc-server-WI \\='erc-server-311) + (defvar erc-server-WI-functions \\='erc-server-311 \"Some non-generic variable documentation. Hook called upon receiving a WI server response. @@ -1136,7 +1150,8 @@ Would expand to: aliases)) (let* ((hook-name (intern (format "erc-server-%s-functions" name))) (fn-name (intern (format "erc-server-%s" name))) - (hook-doc (format "%sHook called upon receiving a %%s server response. + (hook-doc (format-message "\ +%sHook called upon receiving a %%s server response. Each function is called with two arguments, the process associated with the response and the parsed response. If the function returns non-nil, stop processing the hook. Otherwise, continue. @@ -1146,7 +1161,8 @@ See also `%s'." (concat extra-var-doc "\n\n") "") fn-name)) - (fn-doc (format "%sHandler for a %s server response. + (fn-doc (format-message "\ +%sHandler for a %s server response. PROC is the server process which returned the response. PARSED is the actual response as an `erc-response' struct. If you want to add responses don't modify this function, but rather @@ -1162,8 +1178,11 @@ add things to `%s' instead." (cl-loop for alias in aliases collect (intern (format "erc-server-%s-functions" alias))))) `(prog2 - ;; Normal hook variable. - (defvar ,hook-name ',fn-name ,(format hook-doc name)) + ;; Normal hook variable. The variable may already have a + ;; value at this point, so I default to nil, and (add-hook) + ;; unconditionally + (defvar ,hook-name nil ,(format hook-doc name)) + (add-to-list ',hook-name ',fn-name) ;; Handler function (defun ,fn-name (proc parsed) ,fn-doc @@ -1208,7 +1227,6 @@ add things to `%s' instead." parsed 'notice 'active 'INVITE ?n nick ?u login ?h host ?c chnl))))) - (define-erc-response-handler (JOIN) "Handle join messages." nil @@ -1244,7 +1262,7 @@ add things to `%s' instead." (erc-format-message 'JOIN ?n nick ?u login ?h host ?c chnl)))))) (when buffer (set-buffer buffer)) - (erc-update-channel-member chnl nick nick t nil nil host login) + (erc-update-channel-member chnl nick nick t nil nil nil nil nil host login) ;; on join, we want to stay in the new channel buffer ;;(set-buffer ob) (erc-display-message parsed nil buffer str)))))) @@ -1413,7 +1431,7 @@ add things to `%s' instead." ;; message. We will accumulate private identities indefinitely ;; at this point. (erc-update-channel-member (if privp nick tgt) nick nick - privp nil nil host login nil nil t) + privp nil nil nil nil nil host login nil nil t) (let ((cdata (erc-get-channel-user nick))) (setq fnick (funcall erc-format-nick-function (car cdata) (cdr cdata)))))) @@ -1466,11 +1484,10 @@ add things to `%s' instead." "The channel topic has changed." nil (let* ((ch (car (erc-response.command-args parsed))) (topic (erc-trim-string (erc-response.contents parsed))) - (time (format-time-string erc-server-timestamp-format - (current-time)))) + (time (format-time-string erc-server-timestamp-format))) (pcase-let ((`(,nick ,login ,host) (erc-parse-user (erc-response.sender parsed)))) - (erc-update-channel-member ch nick nick nil nil nil host login) + (erc-update-channel-member ch nick nick nil nil nil nil nil nil host login) (erc-update-channel-topic ch (format "%s\C-o (%s, %s)" topic nick time)) (erc-display-message parsed 'notice (erc-get-buffer ch proc) 'TOPIC ?n nick ?u login ?h host @@ -1538,7 +1555,7 @@ A server may send more than one 005 message." (while (erc-response.command-args parsed) (let ((section (pop (erc-response.command-args parsed)))) ;; fill erc-server-parameters - (when (string-match "^\\([A-Z]+\\)\=\\(.*\\)$\\|^\\([A-Z]+\\)$" + (when (string-match "^\\([A-Z]+\\)=\\(.*\\)$\\|^\\([A-Z]+\\)$" section) (add-to-list 'erc-server-parameters `(,(or (match-string 1 section) @@ -1800,8 +1817,7 @@ See `erc-display-server-message'." nil (when (string-match "\\(^[0-9]+ \\)\\(.*\\)$" full-name) (setq hopcount (match-string 1 full-name)) (setq full-name (match-string 2 full-name))) - (erc-update-channel-member channel nick nick nil nil nil host - user full-name) + (erc-update-channel-member channel nick nick nil nil nil nil nil nil host user full-name) (erc-display-message parsed 'notice 'active 's352 ?c channel ?n nick ?a away-flag ?u user ?h host ?f full-name))))