X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/9949231fb06aa4a2dfa536e9d5125a81424db3a7..d259328fb87db8cc67d52771efcfa653e52c5b71:/lisp/erc/erc-backend.el diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 8751a194e3..1ef2fac162 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1,6 +1,6 @@ ;;; erc-backend.el --- Backend network communication for ERC -;; Copyright (C) 2004-2014 Free Software Foundation, Inc. +;; Copyright (C) 2004-2015 Free Software Foundation, Inc. ;; Filename: erc-backend.el ;; Author: Lawrence Mitchell @@ -376,7 +376,7 @@ alist." :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 @@ -505,51 +505,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,7 +567,7 @@ 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))))) @@ -602,20 +604,21 @@ Make sure you are in an ERC buffer when running this." (defsubst erc-server-reconnect-p (event) "Return non-nil if ERC should attempt to reconnect automatically. EVENT is the message received from the closed connection process." - (or erc-server-reconnecting - (and erc-server-auto-reconnect - (not erc-server-banned) - (not erc-server-error-occurred) - ;; make sure we don't infinitely try to reconnect, unless the - ;; user wants that - (or (eq erc-server-reconnect-attempts t) - (and (integerp erc-server-reconnect-attempts) - (< erc-server-reconnect-count - erc-server-reconnect-attempts))) - (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))))) + (and (not erc-server-quitting) ;; user issued an explicit quit, give up now + (or erc-server-reconnecting ;; user issued explicit reconnect + ;; otherwise go through the full spectrum of checks: + (and erc-server-auto-reconnect + (not erc-server-banned) + ;; make sure we don't infinitely try to reconnect, unless the + ;; user wants that + (or (eq erc-server-reconnect-attempts t) + (and (integerp erc-server-reconnect-attempts) + (< erc-server-reconnect-count + erc-server-reconnect-attempts))) + (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)))))) (defun erc-process-sentinel-2 (event buffer) "Called when `erc-process-sentinel-1' has detected an unexpected disconnect." @@ -638,13 +641,11 @@ EVENT is the message received from the closed connection process." (condition-case err (progn (setq erc-server-reconnecting nil) - (erc-server-reconnect) - (setq erc-server-reconnect-count 0)) + (setq erc-server-reconnect-count (1+ erc-server-reconnect-count)) + (erc-server-reconnect)) (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)) + (unless (integerp erc-server-reconnect-attempts) (message "%s ... %s" "Reconnecting until we succeed" "kill the ERC server buffer to stop")) @@ -652,7 +653,7 @@ EVENT is the message received from the closed connection process." (run-at-time erc-server-reconnect-timeout nil #'erc-process-sentinel-2 event buffer) - (error (concat "`erc-server-reconnect-timeout`" + (error (concat "`erc-server-reconnect-timeout'" " must be a number"))))))))))) (defun erc-process-sentinel-1 (event buffer) @@ -1082,7 +1083,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 +1101,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 +1117,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 +1137,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 +1148,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 +1165,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 @@ -1465,8 +1471,7 @@ 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 nil nil nil host login) @@ -1537,7 +1542,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)