(defvar-local erc-network nil
"The name of the network you are connected to (a symbol).")
+
+;;;; Identifying session context
+
+;; This section is concerned with identifying and managing the
+;; relationship between an IRC connection and its unique identity on a
+;; given network (as seen by that network's nick-granting system).
+;; This relationship is quasi-permanent and transcends IRC connections
+;; and Emacs sessions. As of mid 2022, only nicknames matter, and
+;; whether a user is authenticated does not directly impact network
+;; identity from a client's perspective. However, ERC must be
+;; equipped to adapt should this ever change. And while a connection
+;; is normally associated with exactly one nick, some networks (or
+;; intermediaries) may allow multiple clients to control the same nick
+;; by combining instance activity into a single logical client. ERC
+;; must be limber enough to handle such situations.
+
+(defvar-local erc-networks--id nil
+ "Server-local instance of its namesake struct.
+Also shared among all target buffers for a given connection. See
+\\[describe-symbol] `erc-networks--id' for more.")
+
+(cl-defstruct erc-networks--id
+ "Persistent identifying info for a network presence.
+
+Here, \"presence\" refers to some local state representing a
+client's existence on a network. Some clients refer to this as a
+\"context\" or a \"net-id\". The management of this state
+involves tracking associated buffers and what they're displaying.
+Since a presence can outlast physical connections and survive
+changes in back-end transports (and even outlive Emacs sessions),
+its identity must be resilient.
+
+Essential to this notion of an enduring existence on a network is
+ensuring recovery from the loss of a server buffer. Thus, any
+useful identifier must be shared among server and target buffers
+to allow for reassociation. Beyond that, it must ideally be
+derivable from the same set of connection parameters. See the
+constructor `erc-networks--id-create' for more info."
+ (ts nil :type float :read-only t :documentation "Creation timestamp.")
+ (symbol nil :type symbol :documentation "ID as a symbol."))
+
+(cl-defstruct (erc-networks--id-fixed
+ (:include erc-networks--id)
+ (:constructor erc-networks--id-fixed-create
+ (given &aux (ts (float-time)) (symbol given)))))
+
+(cl-defstruct (erc-networks--id-qualifying
+ (:include erc-networks--id)
+ (:constructor erc-networks--id-qualifying-create
+ (&aux
+ (ts (float-time))
+ (parts (erc-networks--id-qualifying-init-parts))
+ (symbol (erc-networks--id-qualifying-init-symbol
+ parts))
+ (len 1))))
+ "A session context composed of hierarchical connection parameters.
+Two identifiers are considered equivalent when their non-empty
+`parts' slots compare equal. Related identifiers share a common
+prefix of `parts' taken from connection parameters (given or
+discovered). An identifier's unique `symbol', intended for
+display purposes, is created by concatenating the shortest common
+prefix among its relatives. For example, related presences [b a
+r d o] and [b a z a r] would have symbols b/a/r and b/a/z
+respectively. The separator is given by `erc-networks--id-sep'."
+ (parts nil :type sequence ; a vector of atoms
+ :documentation "Sequence of identifying components.")
+ (len 0 :type integer
+ :documentation "Length of active `parts' interval."))
+
+;; For now, please use this instead of `erc-networks--id-fixed-p'.
+(cl-defgeneric erc-networks--id-given (net-id)
+ "Return the preassigned identifier for a network presence, if any.
+This may have originated from an `:id' arg to entry-point commands
+`erc-tls' or `erc'.")
+
+(cl-defmethod erc-networks--id-given ((_ erc-networks--id))
+ nil)
+
+(cl-defmethod erc-networks--id-given ((nid erc-networks--id-fixed))
+ (erc-networks--id-symbol nid))
+
+(cl-generic-define-context-rewriter erc-obsolete-var (var spec)
+ `((with-suppressed-warnings ((obsolete ,var)) ,var) ,spec))
+
+;; As a catch-all, derive the symbol from the unquoted printed repr.
+(cl-defgeneric erc-networks--id-create (id)
+ "Invoke an appropriate constructor for an `erc-networks--id' object."
+ (erc-networks--id-fixed-create (intern (format "%s" id))))
+
+;; When a given ID is a symbol, trust it unequivocally.
+(cl-defmethod erc-networks--id-create ((id symbol))
+ (erc-networks--id-fixed-create id))
+
+;; Otherwise, use an adaptive name derived from network params.
+(cl-defmethod erc-networks--id-create ((_ null))
+ (erc-networks--id-qualifying-create))
+
+;; But honor an explicitly set `erc-rename-buffers' (compat).
+(cl-defmethod erc-networks--id-create
+ ((_ null) &context (erc-obsolete-var erc-rename-buffers null))
+ (erc-networks--id-fixed-create (intern (buffer-name))))
+
+;; But honor an explicitly set `erc-reuse-buffers' (compat).
+(cl-defmethod erc-networks--id-create
+ ((_ null) &context (erc-obsolete-var erc-reuse-buffers null))
+ (erc-networks--id-fixed-create (intern (buffer-name))))
+
+(cl-defmethod erc-networks--id-create
+ ((_ symbol) &context (erc-obsolete-var erc-reuse-buffers null))
+ (erc-networks--id-fixed-create (intern (buffer-name))))
+
+(cl-defgeneric erc-networks--id-on-connect (net-id)
+ "Update NET-ID `erc-networks--id' after connection params known.
+This is typically during or just after MOTD.")
+
+(cl-defmethod erc-networks--id-on-connect ((_ erc-networks--id))
+ nil)
+
+(cl-defmethod erc-networks--id-on-connect ((id erc-networks--id-qualifying))
+ (erc-networks--id-qualifying-update id (erc-networks--id-qualifying-create)))
+
+(cl-defgeneric erc-networks--id-equal-p (self other)
+ "Return non-nil when two network identities exhibit underlying equality.
+SELF and OTHER are `erc-networks--id' struct instances. This
+should normally be used only for ID recovery or merging, after
+which no two identities should be `equal' (timestamps aside) that
+aren't also `eq'.")
+
+(cl-defmethod erc-networks--id-equal-p ((self erc-networks--id)
+ (other erc-networks--id))
+ (eq self other))
+
+(cl-defmethod erc-networks--id-equal-p ((a erc-networks--id-fixed)
+ (b erc-networks--id-fixed))
+ (or (eq a b) (eq (erc-networks--id-symbol a) (erc-networks--id-symbol b))))
+
+(cl-defmethod erc-networks--id-equal-p ((a erc-networks--id-qualifying)
+ (b erc-networks--id-qualifying))
+ (or (eq a b) (equal (erc-networks--id-qualifying-parts a)
+ (erc-networks--id-qualifying-parts b))))
+
+;; ERASE-ME: if some future extension were to come along offering
+;; additional members, e.g., [Libera.Chat "bob" laptop], it'd likely
+;; be cleaner to create a new struct type descending from
+;; `erc-networks--id-qualifying' than to convert this function into a
+;; generic. However, the latter would be simpler because it'd just
+;; require something like &context (erc-v3-device erc-v3--device-t).
+
+(defun erc-networks--id-qualifying-init-parts ()
+ "Return opaque list of atoms to serve as canonical identifier."
+ (when-let ((network (erc-network))
+ (nick (erc-current-nick)))
+ (vector network (erc-downcase nick))))
+
+(defvar erc-networks--id-sep "/"
+ "Separator for joining `erc-networks--id-qualifying-parts' into a net ID.")
+
+(defun erc-networks--id-qualifying-init-symbol (elts &optional len)
+ "Return symbol appropriate for network context identified by ELTS.
+Use leading interval of length LEN as contributing components.
+Combine them with string separator `erc-networks--id-sep'."
+ (when elts
+ (unless len
+ (setq len 1))
+ (intern (mapconcat (lambda (s) (prin1-to-string s t))
+ (seq-subseq elts 0 len)
+ erc-networks--id-sep))))
+
+(defun erc-networks--id-qualifying-grow-id (nid)
+ "Grow NID by one component or return nil when at capacity."
+ (unless (= (length (erc-networks--id-qualifying-parts nid))
+ (erc-networks--id-qualifying-len nid))
+ (setf (erc-networks--id-symbol nid)
+ (erc-networks--id-qualifying-init-symbol
+ (erc-networks--id-qualifying-parts nid)
+ (cl-incf (erc-networks--id-qualifying-len nid))))))
+
+(defun erc-networks--id-qualifying-reset-id (nid)
+ "Restore NID to its initial state."
+ (setf (erc-networks--id-qualifying-len nid) 1
+ (erc-networks--id-symbol nid)
+ (erc-networks--id-qualifying-init-symbol
+ (erc-networks--id-qualifying-parts nid))))
+
+(defun erc-networks--id-qualifying-prefix-length (nid-a nid-b)
+ "Return length of common initial prefix of NID-A and NID-B.
+Return nil when no such sequence exists (instead of zero)."
+ (when-let* ((a (erc-networks--id-qualifying-parts nid-a))
+ (b (erc-networks--id-qualifying-parts nid-b))
+ (n (min (length a) (length b)))
+ ((> n 0))
+ ((equal (elt a 0) (elt b 0)))
+ (i 1))
+ (while (and (< i n)
+ (equal (elt a i)
+ (elt b i)))
+ (cl-incf i))
+ i))
+
+(defun erc-networks--id-qualifying-update (dest source &rest overrides)
+ "Update DEST from SOURCE in place.
+Copy slots into DEST from SOURCE and recompute ID. Both SOURCE
+and DEST must be `erc-networks--id' objects. OVERRIDES is an
+optional plist of SLOT VAL pairs."
+ (setf (erc-networks--id-qualifying-parts dest)
+ (or (plist-get overrides :parts)
+ (erc-networks--id-qualifying-parts source))
+ (erc-networks--id-qualifying-len dest)
+ (or (plist-get overrides :len)
+ (erc-networks--id-qualifying-len source))
+ (erc-networks--id-symbol dest)
+ (or (plist-get overrides :symbol)
+ (erc-networks--id-qualifying-init-symbol
+ (erc-networks--id-qualifying-parts dest)
+ (erc-networks--id-qualifying-len dest)))))
+
+(cl-defgeneric erc-networks--id-reload (_nid &optional _proc _parsed)
+ "Handle an update to the current network identity.
+If provided, PROC should be the current `erc-server-process' and
+PARSED the current `erc-response'. NID is an `erc-networks--id'
+object."
+ nil)
+
+(cl-defmethod erc-networks--id-reload ((nid erc-networks--id-qualifying)
+ &optional proc parsed)
+ "Refresh identity after an `erc-networks--id-qualifying-parts'update."
+ (erc-networks--id-qualifying-update nid (erc-networks--id-qualifying-create)
+ :len
+ (erc-networks--id-qualifying-len nid))
+ (erc-networks--rename-server-buffer (or proc erc-server-process) parsed)
+ (erc-networks--shrink-ids-and-buffer-names-any)
+ (erc-with-all-buffers-of-server
+ erc-server-process #'erc--default-target
+ (when-let* ((new-name (erc-networks--reconcile-buffer-names erc--target
+ nid))
+ ((not (equal (buffer-name) new-name))))
+ (rename-buffer new-name 'unique))))
+
+(cl-defgeneric erc-networks--id-ensure-comparable (self other)
+ "Take measures to ensure two net identities are in comparable states.")
+
+(cl-defmethod erc-networks--id-ensure-comparable ((_ erc-networks--id)
+ (_ erc-networks--id))
+ nil)
+
+(cl-defmethod erc-networks--id-ensure-comparable
+ ((nid erc-networks--id-qualifying) (other erc-networks--id-qualifying))
+ "Grow NID along with that of the current buffer.
+Rename the current buffer if its NID has grown."
+ (when-let ((n (erc-networks--id-qualifying-prefix-length other nid)))
+ (while (and (<= (erc-networks--id-qualifying-len nid) n)
+ (erc-networks--id-qualifying-grow-id nid)))
+ ;; Grow and rename a visited buffer and all its targets
+ (when (and (> (erc-networks--id-qualifying-len nid)
+ (erc-networks--id-qualifying-len other))
+ (erc-networks--id-qualifying-grow-id other))
+ ;; Rename NID's buffers using current ID
+ (erc-buffer-filter (lambda ()
+ (when (eq erc-networks--id other)
+ (erc-networks--maybe-update-buffer-name)))))))
+
+(defun erc-networks--id-sort-buffers (buffers)
+ "Return a list of target BUFFERS, newest to oldest."
+ (sort buffers
+ (lambda (a b)
+ (> (with-current-buffer a (erc-networks--id-ts erc-networks--id))
+ (with-current-buffer b (erc-networks--id-ts erc-networks--id))))))
+
+
+;;;; Buffer association
+
+(cl-defgeneric erc-networks--shrink-ids-and-buffer-names ()
+ nil) ; concrete default implementation for non-eliding IDs
+
+(defun erc-networks--refresh-buffer-names (identity &optional omit)
+ "Ensure all colliding buffers for network IDENTITY have suffixes.
+Then rename current buffer appropriately. Don't consider buffer OMIT
+when determining collisions."
+ (if (erc-networks--examine-targets identity erc--target
+ #'ignore
+ (lambda ()
+ (unless (or (not omit) (eq (current-buffer) omit))
+ (erc-networks--ensure-unique-target-buffer-name)
+ t)))
+ (erc-networks--ensure-unique-target-buffer-name)
+ (rename-buffer (erc--target-string erc--target) 'unique)))
+
+;; This currently doesn't equalize related identities that may have
+;; become mismatched because that shouldn't happen after a connection
+;; is up (other than for a brief moment while renicking or similar,
+;; when states are inconsistent).
+(defun erc-networks--shrink-ids-and-buffer-names-any (&rest omit)
+ (let (grown)
+ ;; Gather all grown identities.
+ (erc-buffer-filter
+ (lambda ()
+ (when (and erc-networks--id
+ (erc-networks--id-qualifying-p erc-networks--id)
+ (not (memq (current-buffer) omit))
+ (not (memq erc-networks--id grown))
+ (> (erc-networks--id-qualifying-len erc-networks--id) 1))
+ (push erc-networks--id grown))))
+ ;; Check for other identities with shared prefix. If none exists,
+ ;; and an identity is overlong, shrink it.
+ (dolist (nid grown)
+ (let ((skip (not (null omit))))
+ (catch 'found
+ (if (cdr grown)
+ (dolist (other grown)
+ (unless (eq nid other)
+ (setq skip nil)
+ (when (erc-networks--id-qualifying-prefix-length nid other)
+ (throw 'found (setq skip t)))))
+ (setq skip nil)))
+ (unless (or skip (< (erc-networks--id-qualifying-len nid) 2))
+ (erc-networks--id-qualifying-reset-id nid)
+ (erc-buffer-filter
+ (lambda ()
+ (when (and (eq erc-networks--id nid)
+ (not (memq (current-buffer) omit)))
+ (if erc--target
+ (erc-networks--refresh-buffer-names nid omit)
+ (erc-networks--maybe-update-buffer-name))))))))))
+
+(cl-defmethod erc-networks--shrink-ids-and-buffer-names
+ (&context (erc-networks--id erc-networks--id-qualifying))
+ (erc-networks--shrink-ids-and-buffer-names-any (current-buffer)))
+
+(defun erc-networks-rename-surviving-target-buffer ()
+ "Maybe drop qualifying suffix from fellow target-buffer's name.
+But only do so when there's a single survivor with a target
+matching that of the dying buffer."
+ (when-let*
+ (((with-suppressed-warnings ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers))
+ (target erc--target)
+ ;; Buffer name includes ID suffix
+ ((not (string= (erc--target-symbol target) ; string= t "t" -> t
+ (erc-downcase (buffer-name)))))
+ (buf (current-buffer))
+ ;; All buffers, not just those belonging to same process
+ (others (erc-buffer-filter
+ (lambda ()
+ (and-let* ((erc--target)
+ ((not (eq buf (current-buffer))))
+ ((eq (erc--target-symbol target)
+ (erc--target-symbol erc--target))))))))
+ ((not (cdr others))))
+ (with-current-buffer (car others)
+ (rename-buffer (erc--target-string target)))))
+
+(defun erc-networks-shrink-ids-and-buffer-names ()
+ "Recompute network IDs and buffer names, ignoring the current buffer.
+Only do so when an IRC connection's context supports qualified
+naming. Do not discriminate based on whether a buffer's
+connection is active."
+ (erc-networks--shrink-ids-and-buffer-names))
+
+(defun erc-networks--examine-targets (identity target on-dupe on-collision)
+ "Visit all ERC target buffers with the same TARGET.
+Call ON-DUPE when a buffer's identity belongs to a network
+IDENTITY or \"should\" after reconciliation. Call ON-COLLISION
+otherwise. Neither function should accept any args. Expect
+TARGET to be an `erc--target' object."
+ (declare (indent 2))
+ (let ((announced erc-server-announced-name))
+ (erc-buffer-filter
+ (lambda ()
+ (when (and erc--target (eq (erc--target-symbol erc--target)
+ (erc--target-symbol target)))
+ (let ((oursp (if (erc--target-channel-local-p target)
+ (equal announced erc-server-announced-name)
+ (erc-networks--id-equal-p identity erc-networks--id))))
+ (funcall (if oursp on-dupe on-collision))))))))
+
+(defconst erc-networks--qualified-sep "@"
+ "Separator used for naming a target buffer.")
+
+(defun erc-networks--construct-target-buffer-name (target)
+ "Return TARGET@suffix."
+ (concat (erc--target-string target)
+ (if (with-suppressed-warnings ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers)
+ erc-networks--qualified-sep "/")
+ (cond
+ ((not (with-suppressed-warnings ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers))
+ (cadr (split-string
+ (symbol-name (erc-networks--id-symbol erc-networks--id))
+ "/")))
+ ((erc--target-channel-local-p target) erc-server-announced-name)
+ (t (symbol-name (erc-networks--id-symbol erc-networks--id))))))
+
+(defun erc-networks--ensure-unique-target-buffer-name ()
+ (when-let* ((new-name (erc-networks--construct-target-buffer-name
+ erc--target))
+ ((not (equal (buffer-name) new-name))))
+ (rename-buffer new-name 'unique)))
+
+(defun erc-networks--ensure-unique-server-buffer-name ()
+ (when-let* ((new-name (symbol-name (erc-networks--id-symbol
+ erc-networks--id)))
+ ((not (equal (buffer-name) new-name))))
+ (rename-buffer new-name 'unique)))
+
+(defun erc-networks--maybe-update-buffer-name ()
+ "Update current buffer name to reflect display ID if necessary."
+ (if erc--target
+ (erc-networks--ensure-unique-target-buffer-name)
+ (erc-networks--ensure-unique-server-buffer-name)))
+
+(defun erc-networks--reconcile-buffer-names (target nid)
+ "Reserve preferred buffer name for TARGET and network identifier.
+Expect TARGET to be an `erc--target' instance. Guarantee that at
+most one existing buffer has the same `erc-networks--id' and a
+case-mapped target, i.e., `erc--target-symbol'. If other buffers
+with equivalent targets exist, rename them to TARGET@their-NID
+and return TARGET@our-NID. Otherwise return TARGET as a string.
+When multiple buffers for TARGET exist for the current NID,
+rename them with <n> suffixes going from newest to oldest."
+ (let* (existing ; Former selves or unexpected dupes (for now allow > 1)
+ ;; Renamed ERC buffers on other networks matching target
+ (namesakes (erc-networks--examine-targets nid target
+ (lambda () (push (current-buffer) existing) nil)
+ ;; Append network ID as TARGET@NID,
+ ;; possibly qualifying to achieve uniqueness.
+ (lambda ()
+ (unless (erc--target-channel-local-p erc--target)
+ (erc-networks--id-ensure-comparable
+ nid erc-networks--id))
+ (erc-networks--ensure-unique-target-buffer-name)
+ t)))
+ ;; Must follow ^ because NID may have been modified
+ (name (if (or namesakes (not (with-suppressed-warnings
+ ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers)))
+ (erc-networks--construct-target-buffer-name target)
+ (erc--target-string target)))
+ placeholder)
+ ;; If we don't exist, claim name temporarily while renaming others
+ (when-let* (namesakes
+ (ex (get-buffer name))
+ ((not (memq ex existing)))
+ (temp-name (generate-new-buffer-name (format "*%s*" name))))
+ (setq existing (remq ex existing))
+ (with-current-buffer ex
+ (rename-buffer temp-name)
+ (setq placeholder (get-buffer-create name))
+ (rename-buffer name 'unique)))
+ (unless (with-suppressed-warnings ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers)
+ (when (string-suffix-p ">" name)
+ (setq name (substring name 0 -3))))
+ (dolist (ex (erc-networks--id-sort-buffers existing))
+ (with-current-buffer ex
+ (rename-buffer name 'unique)))
+ (when placeholder (kill-buffer placeholder))
+ name))
+
+
;; Functions:
;;;###autoload
Use the server parameter NETWORK if provided, otherwise parse the
server name and search for a match in `erc-networks-alist'."
;; The server made it easy for us and told us the name of the NETWORK
+ (declare (obsolete "maybe see `erc-networks--determine'" "29.1"))
(let ((network-name (cdr (assoc "NETWORK" erc-server-parameters))))
(if network-name
(intern network-name)
(defun erc-set-network-name (_proc _parsed)
"Set `erc-network' to the value returned by `erc-determine-network'."
+ (declare (obsolete "maybe see `erc-networks--set-name'" "29.1"))
(unless erc-server-connected
- (setq erc-network (erc-determine-network)))
+ (setq erc-network (with-suppressed-warnings
+ ((obsolete erc-determine-network))
+ (erc-determine-network))))
+ nil)
+
+(defconst erc-networks--name-missing-sentinel (gensym "Unknown ")
+ "Value to cover rare case of a literal NETWORK=nil.")
+
+(defun erc-networks--determine ()
+ "Return the name of the network as a symbol.
+Search `erc-networks-alist' for a known entity matching
+`erc-server-announced-name'. If that fails, use the display name
+given by the `RPL_ISUPPORT' NETWORK parameter."
+ (or (cl-loop for (name matcher) in erc-networks-alist
+ when (and matcher (string-match (concat matcher "\\'")
+ erc-server-announced-name))
+ return name)
+ (and-let* ((vanity (erc--get-isupport-entry 'NETWORK 'single))
+ ((intern vanity))))
+ erc-networks--name-missing-sentinel))
+
+(defun erc-networks--set-name (_proc parsed)
+ "Set `erc-network' to the value returned by `erc-networks--determine'.
+Signal an error when the network cannot be determined."
+ ;; Always update (possibly clobber) current value, if any.
+ (let ((name (erc-networks--determine)))
+ (when (eq name erc-networks--name-missing-sentinel)
+ ;; This can happen theoretically, e.g., if you're editing some
+ ;; settings interactively on a proxy service that impersonates IRC
+ ;; but aren't being proxied through to a real network. The
+ ;; service may send a 422 but no NETWORK param (or *any* 005s).
+ (let ((m (concat "Failed to determine network. Please set entry for "
+ erc-server-announced-name " in `erc-network-alist'.")))
+ (erc-display-error-notice parsed m)
+ (erc-error "Failed to determine network"))) ; beep
+ (setq erc-network name))
+ nil)
+
+;; This lives here in this file because all the other "on connect"
+;; MOTD stuff ended up here (but perhaps that needs to change).
+
+(defun erc-networks--ensure-announced (_ parsed)
+ "Set a fallback `erc-server-announced-name' if still unset.
+Copy source (prefix) from MOTD-ish message as a last resort."
+ ;; The 004 handler never ran; see 2004-03-10 Diane Murray in change log
+ (unless erc-server-announced-name
+ (erc-display-error-notice parsed "Failed to determine server name.")
+ (erc-display-error-notice
+ parsed (concat "If this was unexpected, consider reporting it via "
+ (substitute-command-keys "\\[erc-bug]") "."))
+ (setq erc-server-announced-name (erc-response.sender parsed)))
nil)
(defun erc-unset-network-name (_nick _ip _reason)
"Set `erc-network' to nil."
+ (declare (obsolete "`erc-network' is now effectively read-only" "29.1"))
(setq erc-network nil)
nil)
+;; TODO add note in Commentary saying that this module is considered a
+;; core module and that it's as much about buffer naming and network
+;; identity as anything else.
+
+(defun erc-networks--insert-transplanted-content (content)
+ (let ((inhibit-read-only t)
+ (buffer-undo-list t))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (insert-before-markers content)))))
+
+;; This should run whenever a network identity is updated.
+
+(defun erc-networks--reclaim-orphaned-target-buffers (new-proc nid announced)
+ "Visit disowned buffers for same NID and associate with NEW-PROC.
+ANNOUNCED is the server's reported host name."
+ (erc-buffer-filter
+ (lambda ()
+ (when (and erc--target
+ (not erc-server-connected)
+ (erc-networks--id-equal-p erc-networks--id nid)
+ (or (not (erc--target-channel-local-p erc--target))
+ (string= erc-server-announced-name announced)))
+ ;; If a target buffer exists for the current process, kill this
+ ;; stale one after transplanting its content; else reinstate.
+ (if-let ((existing (erc-get-buffer
+ (erc--target-string erc--target) new-proc)))
+ (progn
+ (widen)
+ (let ((content (buffer-substring (point-min)
+ erc-insert-marker)))
+ (kill-buffer) ; allow target-buf renaming hook to run
+ (with-current-buffer existing
+ (erc-networks--ensure-unique-target-buffer-name)
+ (erc-networks--insert-transplanted-content content))))
+ (setq erc-server-process new-proc
+ erc-server-connected t
+ erc-networks--id nid))))))
+
+(defun erc-networks--copy-over-server-buffer-contents (existing name)
+ "Kill off existing server buffer after copying its contents.
+Must be called from the replacement buffer."
+ ;; ERC expects `erc-open' to be idempotent when setting up local
+ ;; vars and other context properties for a new identity. Thus, it's
+ ;; unlikely we'll have to copy anything else over besides text. And
+ ;; no reconciling of user tables, etc. happens during a normal
+ ;; reconnect, so we should be fine just sticking to text. (Right?)
+ (let ((text (with-current-buffer existing
+ ;; This `erc-networks--id' should be
+ ;; `erc-networks--id-equal-p' to caller's network
+ ;; identity and older if not eq.
+ ;;
+ ;; `erc-server-process' should be set but dead
+ ;; and eq `get-buffer-process' unless latter nil
+ (delete-process erc-server-process)
+ (buffer-substring (point-min) erc-insert-marker)))
+ erc-kill-server-hook
+ erc-kill-buffer-hook)
+ (erc-networks--insert-transplanted-content text)
+ (kill-buffer name)))
+
+;; This stands alone for testing purposes
+
+(defun erc-networks--update-server-identity ()
+ "Maybe grow or replace the current network identity.
+If a dupe is found, adopt its identity by overwriting ours.
+Otherwise, take steps to ensure it can effectively be compared to
+ours, now and into the future. Note that target buffers are
+considered as well because server buffers are often killed."
+ (let* ((identity erc-networks--id)
+ (buffer (current-buffer))
+ (f (lambda ()
+ (unless (or (eq (current-buffer) buffer)
+ (eq erc-networks--id identity))
+ (if (erc-networks--id-equal-p identity erc-networks--id)
+ (throw 'buffer erc-networks--id)
+ (erc-networks--id-ensure-comparable identity
+ erc-networks--id)
+ nil))))
+ (found (catch 'buffer (erc-buffer-filter f))))
+ (when found
+ (setq erc-networks--id found))))
+
+;; These steps should only run when initializing a newly connected
+;; server buffer, whereas `erc-networks--rename-server-buffer' can run
+;; mid-session, after an identity's core components have changed.
+
+(defun erc-networks--init-identity (_proc _parsed)
+ "Update identity with real network name."
+ ;; Initialize identity for real now that we know the network
+ (cl-assert erc-network)
+ (unless (erc-networks--id-symbol erc-networks--id) ; unless just reconnected
+ (erc-networks--id-on-connect erc-networks--id))
+ ;; Find duplicate identities or other conflicting ones and act
+ ;; accordingly.
+ (erc-networks--update-server-identity)
+ ;;
+ nil)
+
+(defun erc-networks--rename-server-buffer (new-proc &optional _parsed)
+ "Rename a server buffer based on its network identity.
+Assume that the current buffer is a server buffer, either one
+with a newly established connection whose identity has just been
+fully fleshed out, or an existing one whose identity has just
+been updated. Either way, assume the current identity is ready
+to serve as a canonical identifier.
+
+When a server buffer already exists with the chosen name, copy
+over its contents and kill it. However, when its process is
+still alive, kill off the current buffer. This can happen, for
+example, after a perceived loss in network connectivity turns out
+to be a false alarm. If `erc-reuse-buffers' is nil, let
+`generate-new-buffer-name' do the actual renaming."
+ (cl-assert (eq new-proc erc-server-process))
+ (cl-assert (erc-networks--id-symbol erc-networks--id))
+ ;; Always look for targets to reassociate because original server
+ ;; buffer may have been deleted.
+ (erc-networks--reclaim-orphaned-target-buffers new-proc erc-networks--id
+ erc-server-announced-name)
+ (let* ((name (symbol-name (erc-networks--id-symbol erc-networks--id)))
+ ;; When this ends up being the current buffer, either we have
+ ;; a "given" ID or the buffer was reused on reconnecting.
+ (existing (get-buffer name)))
+ (cond ((or (not existing)
+ (erc-networks--id-given erc-networks--id)
+ (eq existing (current-buffer)))
+ (rename-buffer name))
+ ;; Abort on accidental reconnect or failure to pass :id param for
+ ;; avoidable collisions.
+ ((erc-server-process-alive existing)
+ (kill-local-variable 'erc-network)
+ (delete-process new-proc)
+ (erc-display-error-notice nil (format "Buffer %s still connected"
+ name))
+ (erc-set-active-buffer existing))
+ ;; Copy over old buffer's contents and kill it
+ ((with-suppressed-warnings ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers)
+ (erc-networks--copy-over-server-buffer-contents existing name)
+ (rename-buffer name))
+ (t (rename-buffer (generate-new-buffer-name name)))))
+ nil)
+
+;; Soju v0.4.0 only sends ISUPPORT on upstream reconnect, so this
+;; doesn't apply. ZNC 1.8.2, however, still sends the entire burst.
+(defconst erc-networks--bouncer-targets '(*status bouncerserv)
+ "Case-mapped symbols matching known bouncer service-bot targets.")
+
+(defun erc-networks-on-MOTD-end (proc parsed)
+ "Call on-connect functions with server PROC and PARSED message.
+This must run before `erc-server-connected' is set."
+ (when erc-server-connected
+ (unless (erc-buffer-filter (lambda ()
+ (and erc--target
+ (memq (erc--target-symbol erc--target)
+ erc-networks--bouncer-targets)))
+ proc)
+ (let ((m (concat "Unexpected state detected. Please report via "
+ (substitute-command-keys "\\[erc-bug]") ".")))
+ (erc-display-error-notice parsed m))))
+
+ ;; For now, retain compatibility with erc-server-NNN-functions.
+ (or (erc-networks--ensure-announced proc parsed)
+ (erc-networks--set-name proc parsed)
+ (erc-networks--init-identity proc parsed)
+ (erc-networks--rename-server-buffer proc parsed)))
+
(define-erc-module networks nil
"Provide data about IRC networks."
- ((add-hook 'erc-server-375-functions #'erc-set-network-name)
- (add-hook 'erc-server-422-functions #'erc-set-network-name)
- (add-hook 'erc-disconnected-hook #'erc-unset-network-name))
- ((remove-hook 'erc-server-375-functions #'erc-set-network-name)
- (remove-hook 'erc-server-422-functions #'erc-set-network-name)
- (remove-hook 'erc-disconnected-hook #'erc-unset-network-name)))
+ ((add-hook 'erc-server-376-functions #'erc-networks-on-MOTD-end)
+ (add-hook 'erc-server-422-functions #'erc-networks-on-MOTD-end))
+ ((remove-hook 'erc-server-376-functions #'erc-networks-on-MOTD-end)
+ (remove-hook 'erc-server-422-functions #'erc-networks-on-MOTD-end)))
(defun erc-ports-list (ports)
"Return a list of PORTS.
(defvar erc--server-last-reconnect-count)
(defvar erc--server-reconnecting)
(defvar erc-channel-members-changed-hook)
+(defvar erc-network)
+(defvar erc-networks--id)
(defvar erc-server-367-functions)
(defvar erc-server-announced-name)
(defvar erc-server-connect-function)
:set (lambda (sym val)
(set sym (if (functionp val) (funcall val) val))))
-(defcustom erc-rename-buffers nil
+(defcustom erc-rename-buffers t
"Non-nil means rename buffers with network name, if available."
:version "24.5"
:group 'erc
:type 'boolean)
+;; For the sake of compatibility, an ID will be created on the user's
+;; behalf when `erc-rename-buffers' is nil and one wasn't provided.
+;; The name will simply be that of the buffer, usually SERVER:PORT.
+;; This violates the policy of treating provided IDs as gospel, but
+;; it'll have to do for now.
+
+(make-obsolete-variable 'erc-rename-buffers
+ "old behavior when t now permanent" "29.1")
+
(defvar erc-password nil
"Password to use when authenticating to an IRC server.
It is not strictly necessary to provide this, since ERC will
(erc-channel-p (erc-default-target))))
(t nil)))
+;; For the sake of compatibility, a historical quirk concerning this
+;; option, when nil, has been preserved: all buffers are suffixed with
+;; the original dialed host name, which is usually something like
+;; irc.libera.chat. Collisions are handled by adding a uniquifying
+;; numeric suffix of the form <N>. Note that channel reassociation
+;; behavior involving this option (when nil) was inverted in 28.1 (ERC
+;; 5.4 and 5.4.1). This was regrettable and has since been undone.
+
(defcustom erc-reuse-buffers t
"If nil, create new buffers on joining a channel/query.
If non-nil, a new buffer will only be created when you join
:group 'erc-buffers
:type 'boolean)
+(make-obsolete-variable 'erc-reuse-buffers
+ "old behavior when t now permanent" "29.1")
+
(defun erc-normalize-port (port)
"Normalize the port specification PORT to integer form.
PORT may be an integer, a string or a symbol. If it is a string or a
"Check whether ports A and B are equal."
(= (erc-normalize-port a) (erc-normalize-port b)))
-(defun erc-generate-new-buffer-name (server port target)
- "Create a new buffer name based on the arguments."
- (when (numberp port) (setq port (number-to-string port)))
- (let* ((buf-name (or target
- (let ((name (concat server ":" port)))
- (when (> (length name) 1)
- name))
- ;; This fallback should in fact never happen.
- "*erc-server-buffer*"))
- (full-buf-name (concat buf-name "/" server))
- (dup-buf-name (buffer-name (car (erc-channel-list nil))))
- buffer-name)
- ;; Reuse existing buffers, but not if the buffer is a connected server
- ;; buffer and not if its associated with a different server than the
- ;; current ERC buffer.
- ;; If buf-name is taken by a different connection (or by something !erc)
- ;; then see if "buf-name/server" meets the same criteria.
- (if (and dup-buf-name (string-match-p (concat buf-name "/") dup-buf-name))
- (setq buffer-name full-buf-name) ; ERC buffer with full name already exists.
- (dolist (candidate (list buf-name full-buf-name))
- (if (and (not buffer-name)
- erc-reuse-buffers
- (or (not (get-buffer candidate))
- ;; Looking for a server buffer, so there's no target.
- (and (not target)
- (with-current-buffer (get-buffer candidate)
- (and (erc-server-buffer-p)
- (not (erc-server-process-alive)))))
- ;; Channel buffer; check that it's from the right server.
- (and target
- (with-current-buffer (get-buffer candidate)
- (and (string= erc-session-server server)
- (erc-port-equal erc-session-port port))))))
- (setq buffer-name candidate)
- (when (and (not buffer-name) (get-buffer buf-name) erc-reuse-buffers)
- ;; A new buffer will be created with the name buf-name/server, rename
- ;; the existing name-duplicated buffer with the same format as well.
- (with-current-buffer (get-buffer buf-name)
- (when (derived-mode-p 'erc-mode) ; ensure it's an erc buffer
- (rename-buffer
- (concat buf-name "/" (or erc-session-server erc-server-announced-name)))))))))
- ;; If buffer-name is unset, neither candidate worked out for us,
- ;; fallback to the old <N> uniquification method:
- (or buffer-name (generate-new-buffer-name full-buf-name))))
-
-(defun erc-get-buffer-create (server port target)
+(defun erc-generate-new-buffer-name (server port target &optional tgt-info id)
+ "Determine the name of an ERC buffer.
+When TGT-INFO is nil, assume this is a server buffer. If ID is non-nil,
+return ID as a string unless a buffer already exists with a live server
+process, in which case signal an error. When ID is nil, return a
+temporary name based on SERVER and PORT to be replaced with the network
+name when discovered (see `erc-networks--rename-server-buffer'). Allow
+either SERVER or PORT (but not both) to be nil to accommodate oddball
+`erc-server-connect-function's.
+
+When TGT-INFO is non-nil, expect its string field to match the redundant
+param TARGET (retained for compatibility). Whenever possibly, prefer
+returning TGT-INFO's string unmodified. But when a case-insensitive
+collision prevents that, return target@ID when ID is non-nil or
+target@network otherwise after renaming the conflicting buffer in the
+same manner."
+ (when target ; compat
+ (setq tgt-info (erc--target-from-string target)))
+ (if tgt-info
+ (let* ((esid (erc-networks--id-symbol erc-networks--id))
+ (name (if esid
+ (erc-networks--reconcile-buffer-names tgt-info
+ erc-networks--id)
+ (erc--target-string tgt-info))))
+ (if (and esid (with-suppressed-warnings ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers))
+ name
+ (generate-new-buffer-name name)))
+ (if (and (with-suppressed-warnings ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers)
+ id)
+ (progn
+ (when-let* ((buf (get-buffer (symbol-name id)))
+ ((erc-server-process-alive buf)))
+ (user-error "Session with ID %S already exists" id))
+ (symbol-name id))
+ (generate-new-buffer-name (if (and server port)
+ (if (with-suppressed-warnings
+ ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers)
+ (format "%s:%s" server port)
+ (format "%s:%s/%s" server port server))
+ (or server port))))))
+
+(defun erc-get-buffer-create (server port target &optional tgt-info id)
"Create a new buffer based on the arguments."
- (get-buffer-create (erc-generate-new-buffer-name server port target)))
-
+ (when target ; compat
+ (setq tgt-info (erc--target-from-string target)))
+ (if (and erc--server-reconnecting
+ (not tgt-info)
+ (with-suppressed-warnings ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers))
+ (current-buffer)
+ (get-buffer-create
+ (erc-generate-new-buffer-name server port nil tgt-info id))))
(defun erc-member-ignore-case (string list)
"Return non-nil if STRING is a member of LIST.
(defun erc-open (&optional server port nick full-name
connect passwd tgt-list channel process
- client-certificate user)
+ client-certificate user id)
"Connect to SERVER on PORT as NICK with USER and FULL-NAME.
If CONNECT is non-nil, connect to the server. Otherwise assume
or t, which means that `auth-source' will be queried for the
private key and the certificate.
+When non-nil, ID should be a symbol for identifying the connection.
+
Returns the buffer for the given server or channel."
- (let ((buffer (erc-get-buffer-create server port channel))
- (old-buffer (current-buffer))
- old-point
- (continued-session (and erc-reuse-buffers erc--server-reconnecting)))
+ (let* ((target (and channel (erc--target-from-string channel)))
+ (buffer (erc-get-buffer-create server port nil target id))
+ (old-buffer (current-buffer))
+ old-point
+ (continued-session (and erc--server-reconnecting
+ (with-suppressed-warnings
+ ((obsolete erc-reuse-buffers))
+ erc-reuse-buffers))))
(when connect (run-hook-with-args 'erc-before-connect server port nick))
(erc-update-modules)
(set-buffer buffer)
(set-marker erc-insert-marker (point))
;; stack of default recipients
(setq erc-default-recipients tgt-list)
- (setq erc--target (and channel (erc--target-from-string channel)))
+ (when target
+ (setq erc--target target
+ erc-network (erc-network)))
(setq erc-server-current-nick nil)
;; Initialize erc-server-users and erc-channel-users
(if connect
:require '(:secret))))
;; client certificate (only useful if connecting over TLS)
(setq erc-session-client-certificate client-certificate)
+ (setq erc-networks--id (if connect
+ (erc-networks--id-create id)
+ (buffer-local-value 'erc-networks--id
+ old-buffer)))
;; debug output buffer
(setq erc-dbuf
(when erc-log-p
(nick (erc-compute-nick))
(user (erc-compute-user))
password
- (full-name (erc-compute-full-name)))
+ (full-name (erc-compute-full-name))
+ id)
"ERC is a powerful, modular, and extensible IRC client.
This function is the main entry point for ERC.
(user (erc-compute-user))
password
(full-name (erc-compute-full-name))
+ id
That is, if called with
then the server and full-name will be set to those values,
whereas `erc-compute-port' and `erc-compute-nick' will be invoked
-for the values of the other parameters."
+for the values of the other parameters.
+
+When present, ID should be an opaque object used to identify the
+connection unequivocally. This is rarely needed and not available
+interactively."
(interactive (erc-select-read-args))
- (erc-open server port nick full-name t password nil nil nil nil user))
+ (erc-open server port nick full-name t password nil nil nil nil user id))
;;;###autoload
(defalias 'erc-select #'erc)
(user (erc-compute-user))
password
(full-name (erc-compute-full-name))
- client-certificate)
+ client-certificate
+ id)
"ERC is a powerful, modular, and extensible IRC client.
This function is the main entry point for ERC over TLS.
password
(full-name (erc-compute-full-name))
client-certificate
+ id
That is, if called with
(erc-tls :server \"irc.libera.chat\" :port 6697
:client-certificate
\\='(\"/home/bandali/my-cert.key\"
- \"/home/bandali/my-cert.crt\"))"
+ \"/home/bandali/my-cert.crt\"))
+
+When present, ID should be an opaque object for identifying the
+connection unequivocally. (In most cases, this would be a string or a
+symbol composed of letters from the Latin alphabet.) This option is
+generally unneeded, however. See info node `(erc) Connecting' for use
+cases. Not available interactively."
(interactive (let ((erc-default-port erc-default-port-tls))
(erc-select-read-args)))
(let ((erc-server-connect-function 'erc-open-tls-stream))
(erc-open server port nick full-name t password
- nil nil nil client-certificate user)))
+ nil nil nil client-certificate user id)))
(defun erc-open-tls-stream (name buffer host port &rest parameters)
"Open an TLS stream to an IRC server.
If OUTBOUND is non-nil, STRING is being sent to the IRC server and
appears in face `erc-input-face' in the buffer. Lines must already
-contain CRLF endings. Peer is identified by the most precise label
-available at run time, starting with the network name, followed by the
-announced host name, and falling back to the dialed <server>:<port>."
+contain CRLF endings. A peer is identified by the most precise label
+available, starting with the session ID followed by the server-reported
+hostname, and falling back to the dialed <server>:<port> pair.
+
+When capturing logs for multiple peers and sorting them into buckets,
+such inconsistent labeling may pose a problem until the MOTD is
+received. Setting a fixed `erc-networks--id' can serve as a
+workaround."
(when erc-debug-irc-protocol
- (let ((esid (or (and (erc-network) (erc-network-name))
- erc-server-announced-name
- (format "%s:%s" erc-session-server erc-session-port)))
+ (let ((esid (if-let ((erc-networks--id)
+ (esid (erc-networks--id-symbol erc-networks--id)))
+ (symbol-name esid)
+ (or erc-server-announced-name
+ (format "%s:%s" erc-session-server erc-session-port))))
(ts (when erc-debug-irc-protocol-time-format
(format-time-string erc-debug-irc-protocol-time-format))))
(with-current-buffer (get-buffer-create "*erc-protocol*")
(when process
(delete-process process))
(erc-server-reconnect)
- (with-suppressed-warnings ((obsolete erc-server-reconnecting))
+ (with-suppressed-warnings ((obsolete erc-server-reconnecting)
+ ((obsolete erc-reuse-buffers)))
(if erc-reuse-buffers
(progn (cl-assert (not erc--server-reconnecting))
(cl-assert (not erc-server-reconnecting)))
"Return the network or the current target and network combined.
If the name of the network is not available, then use the
shortened server name instead."
- (let ((network-name (or (and (fboundp 'erc-network-name) (erc-network-name))
- (erc-shorten-server-name
- (or erc-server-announced-name
- erc-session-server)))))
- (when (and network-name (symbolp network-name))
- (setq network-name (symbol-name network-name)))
- (cond ((erc-default-target)
- (concat (erc-string-no-properties (erc-default-target))
- "@" network-name))
- ((and network-name
- (not (get-buffer network-name)))
- (when erc-rename-buffers
- (rename-buffer network-name))
- network-name)
- (t (buffer-name (current-buffer))))))
+ (if-let ((erc--target)
+ (name (if-let ((esid (erc-networks--id-symbol erc-networks--id)))
+ (symbol-name esid)
+ (erc-shorten-server-name (or erc-server-announced-name
+ erc-session-server)))))
+ (concat (erc--target-string erc--target) "@" name)
+ (buffer-name)))
(defun erc-format-away-status ()
"Return a formatted `erc-mode-line-away-status-format' if `erc-away' is non-nil."
;; FIXME: Don't set the hook globally!
(add-hook 'kill-buffer-hook #'erc-kill-buffer-function)
-(defcustom erc-kill-server-hook '(erc-kill-server)
- "Invoked whenever a server buffer is killed via `kill-buffer'."
+(defcustom erc-kill-server-hook '(erc-kill-server
+ erc-networks-shrink-ids-and-buffer-names)
+ "Invoked whenever a live server buffer is killed via `kill-buffer'."
+ :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA
:group 'erc-hooks
:type 'hook)
-(defcustom erc-kill-channel-hook '(erc-kill-channel)
+(defcustom erc-kill-channel-hook
+ '(erc-kill-channel
+ erc-networks-shrink-ids-and-buffer-names
+ erc-networks-rename-surviving-target-buffer)
"Invoked whenever a channel-buffer is killed via `kill-buffer'."
+ :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA
:group 'erc-hooks
:type 'hook)
-(defcustom erc-kill-buffer-hook nil
- "Hook run whenever a non-server or channel buffer is killed.
+(defcustom erc-kill-buffer-hook
+ '(erc-networks-shrink-ids-and-buffer-names
+ erc-networks-rename-surviving-target-buffer)
+ "Hook run whenever a query buffer is killed.
See also `kill-buffer'."
+ :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA
:group 'erc-hooks
:type 'hook)
--- /dev/null
+;;; erc-networks-tests.el --- Tests for erc-networks. -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert-x) ; cl-lib
+(require 'erc-networks)
+
+(defun erc-networks-tests--create-dead-proc (&optional buf)
+ (let ((p (start-process "true" (or buf (current-buffer)) "true")))
+ (while (process-live-p p) (sit-for 0.1))
+ p))
+
+(defun erc-networks-tests--create-live-proc (&optional buf)
+ (let ((proc (start-process "sleep" (or buf (current-buffer)) "sleep" "1")))
+ (set-process-query-on-exit-flag proc nil)
+ proc))
+
+;; When we drop 27, call `get-buffer-create with INHIBIT-BUFFER-HOOKS.
+(defun erc-networks-tests--clean-bufs ()
+ (let (erc-kill-channel-hook
+ erc-kill-server-hook
+ erc-kill-buffer-hook)
+ (dolist (buf (erc-buffer-list))
+ (kill-buffer buf))))
+
+(defun erc-networks-tests--bufnames (prefix)
+ (let* ((case-fold-search)
+ (pred (lambda (b) (string-prefix-p prefix (buffer-name b))))
+ (prefixed (seq-filter pred (buffer-list))))
+ (sort (mapcar #'buffer-name prefixed) #'string<)))
+
+(ert-deftest erc-networks--id ()
+ (cl-letf (((symbol-function 'float-time)
+ (lambda () 0.0)))
+
+ ;; Fixed
+ (should (equal (erc-networks--id-fixed-create 'foo)
+ (make-erc-networks--id-fixed :ts (float-time)
+ :symbol 'foo)))
+
+ ;; Eliding
+ (let* ((erc-network 'FooNet)
+ (erc-server-current-nick "Joe")
+ (identity (erc-networks--id-create nil)))
+
+ (should (equal identity #s(erc-networks--id-qualifying
+ 0.0 FooNet [FooNet "joe"] 1)))
+ (should (equal (erc-networks--id-qualifying-grow-id identity)
+ 'FooNet/joe))
+ (should (equal identity #s(erc-networks--id-qualifying
+ 0.0 FooNet/joe [FooNet "joe"] 2)))
+ (should-not (erc-networks--id-qualifying-grow-id identity))
+ (should (equal identity #s(erc-networks--id-qualifying
+ 0.0 FooNet/joe [FooNet "joe"] 2))))
+
+ ;; Compat
+ (with-current-buffer (get-buffer-create "fake.chat")
+ (with-suppressed-warnings ((obsolete erc-rename-buffers))
+ (let (erc-rename-buffers)
+ (should (equal (erc-networks--id-create nil)
+ (make-erc-networks--id-fixed :ts (float-time)
+ :symbol 'fake.chat)))))
+ (kill-buffer))))
+
+(ert-deftest erc-networks--id-create ()
+ (cl-letf (((symbol-function 'float-time)
+ (lambda () 0.0)))
+
+ (should (equal (erc-networks--id-create 'foo)
+ (make-erc-networks--id-fixed :ts (float-time)
+ :symbol 'foo)))
+ (should (equal (erc-networks--id-create "foo")
+ (make-erc-networks--id-fixed :ts (float-time)
+ :symbol 'foo)))
+ (should (equal (erc-networks--id-create [h i])
+ (make-erc-networks--id-fixed :ts (float-time)
+ :symbol (quote \[h\ \i\]))))
+
+ (with-current-buffer (get-buffer-create "foo")
+ (let ((expected (make-erc-networks--id-fixed :ts (float-time)
+ :symbol 'foo)))
+ (with-suppressed-warnings ((obsolete erc-rename-buffers))
+ (let (erc-rename-buffers)
+ (should (equal (erc-networks--id-create nil) expected))))
+ (with-suppressed-warnings ((obsolete erc-reuse-buffers))
+ (let (erc-reuse-buffers)
+ (should (equal (erc-networks--id-create nil) expected))
+ (should (equal (erc-networks--id-create 'bar) expected)))))
+ (kill-buffer))))
+
+(ert-deftest erc-networks--id-qualifying-prefix-length ()
+ (should-not (erc-networks--id-qualifying-prefix-length
+ (make-erc-networks--id-qualifying)
+ (make-erc-networks--id-qualifying)))
+
+ (should-not (erc-networks--id-qualifying-prefix-length
+ (make-erc-networks--id-qualifying :parts [1 2])
+ (make-erc-networks--id-qualifying :parts [2 3])))
+
+ (should (= 1 (erc-networks--id-qualifying-prefix-length
+ (make-erc-networks--id-qualifying :parts [1])
+ (make-erc-networks--id-qualifying :parts [1 2]))))
+
+ (should (= 1 (erc-networks--id-qualifying-prefix-length
+ (make-erc-networks--id-qualifying :parts [1 2])
+ (make-erc-networks--id-qualifying :parts [1 3]))))
+
+ (should (= 2 (erc-networks--id-qualifying-prefix-length
+ (make-erc-networks--id-qualifying :parts [1 2])
+ (make-erc-networks--id-qualifying :parts [1 2]))))
+
+ (should (= 1 (erc-networks--id-qualifying-prefix-length
+ (make-erc-networks--id-qualifying :parts ["1"])
+ (make-erc-networks--id-qualifying :parts ["1"])))))
+
+(ert-deftest erc-networks--id-sort-buffers ()
+ (let (oldest middle newest)
+
+ (with-temp-buffer
+ (setq erc-networks--id (erc-networks--id-fixed-create 'oldest)
+ oldest (current-buffer))
+
+ (with-temp-buffer
+ (setq erc-networks--id (erc-networks--id-fixed-create 'middle)
+ middle (current-buffer))
+
+ (with-temp-buffer
+ (setq erc-networks--id (erc-networks--id-fixed-create 'newest)
+ newest (current-buffer))
+
+ (should (equal (erc-networks--id-sort-buffers
+ (list oldest newest middle))
+ (list newest middle oldest))))))))
+
+(ert-deftest erc-networks-rename-surviving-target-buffer--channel ()
+ (should (memq #'erc-networks-rename-surviving-target-buffer
+ erc-kill-channel-hook))
+
+ (let ((chan-foonet-buffer (get-buffer-create "#chan@foonet")))
+
+ (with-current-buffer chan-foonet-buffer
+ (erc-mode)
+ (setq erc-networks--id (make-erc-networks--id-qualifying
+ :parts [foonet "bob"] :len 1)
+ erc--target (erc--target-from-string "#chan")))
+
+ (with-current-buffer (get-buffer-create "#chan@barnet")
+ (erc-mode)
+ (setq erc-networks--id (make-erc-networks--id-qualifying
+ :parts [barnet "bob"] :len 1)
+ erc--target (erc--target-from-string "#chan")))
+
+ (kill-buffer "#chan@barnet")
+ (should (equal (erc-networks-tests--bufnames "#chan") '("#chan")))
+ (should (eq chan-foonet-buffer (get-buffer "#chan"))))
+
+ (erc-networks-tests--clean-bufs))
+
+(ert-deftest erc-networks-rename-surviving-target-buffer--query ()
+ (should (memq #'erc-networks-rename-surviving-target-buffer
+ erc-kill-buffer-hook))
+
+ (let ((bob-foonet (get-buffer-create "bob@foonet")))
+
+ (with-current-buffer bob-foonet
+ (erc-mode)
+ (setq erc-networks--id (make-erc-networks--id-qualifying
+ :parts [foonet "bob"] :len 1)
+ erc--target (erc--target-from-string "bob")))
+
+ (with-current-buffer (get-buffer-create "bob@barnet")
+ (erc-mode)
+ (setq erc-networks--id (make-erc-networks--id-qualifying
+ :parts [barnet "bob"] :len 1)
+ erc--target (erc--target-from-string "bob")))
+
+ (kill-buffer "bob@barnet")
+ (should (equal (erc-networks-tests--bufnames "bob") '("bob")))
+ (should (eq bob-foonet (get-buffer "bob"))))
+
+ (erc-networks-tests--clean-bufs))
+
+(ert-deftest erc-networks-rename-surviving-target-buffer--multi ()
+
+ (ert-info ("Multiple leftover channels untouched")
+ (with-current-buffer (get-buffer-create "#chan@foonet")
+ (erc-mode)
+ (setq erc--target (erc--target-from-string "#chan")))
+ (with-current-buffer (get-buffer-create "#chan@barnet")
+ (erc-mode)
+ (setq erc--target (erc--target-from-string "#chan")))
+ (with-current-buffer (get-buffer-create "#chan@baznet")
+ (erc-mode)
+ (setq erc--target (erc--target-from-string "#chan")))
+ (kill-buffer "#chan@baznet")
+ (should (equal (erc-networks-tests--bufnames "#chan")
+ '("#chan@barnet" "#chan@foonet")))
+ (erc-networks-tests--clean-bufs))
+
+ (ert-info ("Multiple leftover queries untouched")
+ (with-current-buffer (get-buffer-create "bob@foonet")
+ (erc-mode)
+ (setq erc--target (erc--target-from-string "bob")))
+ (with-current-buffer (get-buffer-create "bob@barnet")
+ (erc-mode)
+ (setq erc--target (erc--target-from-string "bob")))
+ (with-current-buffer (get-buffer-create "bob@baznet")
+ (erc-mode)
+ (setq erc--target (erc--target-from-string "bob")))
+ (kill-buffer "bob@baznet")
+ (should (equal (erc-networks-tests--bufnames "bob")
+ '("bob@barnet" "bob@foonet")))
+ (erc-networks-tests--clean-bufs)))
+
+;; As of May 2022, this "shrink" stuff runs whenever an ERC buffer is
+;; killed because `erc-networks-shrink-ids-and-buffer-names' is a
+;; default member of all three erc-kill-* functions.
+
+;; Note: this overlaps a fair bit with the "hook" variants, i.e.,
+;; `erc-networks--shrink-ids-and-buffer-names--hook-outstanding-*' If
+;; this ever fails, just delete this and fix those. But please copy
+;; over and adapt the comments first.
+
+(ert-deftest erc-networks--shrink-ids-and-buffer-names--perform-outstanding ()
+ ;; While some buffer #a@barnet/dummy is being killed, its display ID
+ ;; is not collapsed because collisions still exist.
+ ;;
+ ;; Note that we don't have to set `erc-server-connected' because
+ ;; this function is intentionally connectivity agnostic.
+ (with-current-buffer (get-buffer-create "foonet/tester")
+ (erc-mode)
+ (setq erc-server-current-nick "tester" ; Always set (`erc-open')
+ ;; Set when transport connected
+ erc-server-process (erc-networks-tests--create-live-proc)
+ ;; Both set just before IRC (logically) connected (post MOTD)
+ erc-network 'foonet
+ erc-networks--id (make-erc-networks--id-qualifying
+ :symbol 'foonet/tester
+ :parts [foonet "tester"]
+ :len 2))) ; is/was a plain foonet collision
+
+ ;; Presumably, some server buffer named foonet/dummy was just
+ ;; killed, hence the length 2 display ID.
+
+ ;; A target buffer for chan #a exists for foonet/tester. The
+ ;; precise form of its name should not affect shrinking.
+ (with-current-buffer (get-buffer-create
+ (elt ["#a" "#a@foonet" "#a@foonet/tester"] (random 3)))
+ (erc-mode)
+ (setq erc-server-process (buffer-local-value 'erc-server-process
+ (get-buffer "foonet/tester"))
+ erc-network 'foonet
+ erc-server-current-nick "tester"
+ erc-networks--id (buffer-local-value 'erc-networks--id
+ (get-buffer "foonet/tester"))
+ erc--target (erc--target-from-string "#a")))
+
+ ;; Another network context exists (so we have buffers to iterate
+ ;; over), and it's also part of a collision group.
+ (with-current-buffer (get-buffer-create "barnet/tester")
+ (erc-mode)
+ (setq erc-network 'barnet
+ erc-server-current-nick "tester"
+ erc-networks--id (make-erc-networks--id-qualifying
+ :symbol 'barnet/tester
+ :parts [barnet "tester"]
+ :len 2)
+ erc-server-process (erc-networks-tests--create-live-proc)))
+
+ (with-current-buffer (get-buffer-create "barnet/dummy")
+ (erc-mode)
+ (setq erc-network 'barnet
+ erc-server-current-nick "dummy"
+ erc-networks--id (make-erc-networks--id-qualifying
+ :symbol 'barnet/dummy
+ :parts [barnet "dummy"]
+ :len 2)
+ erc-server-process (erc-networks-tests--create-live-proc)))
+
+ ;; The buffer being killed is not part of the foonet collision
+ ;; group, which contains one display ID eligible for shrinkage.
+ (with-current-buffer (get-buffer-create
+ (elt ["#a@barnet" "#a@barnet/tester"] (random 2)))
+ (erc-mode)
+ (setq erc-network 'barnet
+ erc-server-current-nick "tester"
+ erc-server-process (buffer-local-value 'erc-server-process
+ (get-buffer "barnet/tester"))
+ erc-networks--id (buffer-local-value 'erc-networks--id
+ (get-buffer "barnet/tester"))
+ erc--target (erc--target-from-string "#a")))
+
+ (with-temp-buffer ; doesn't matter what the current buffer is
+ (setq erc-networks--id (make-erc-networks--id-qualifying)) ; mock
+ (erc-networks--shrink-ids-and-buffer-names))
+
+ (should (equal (mapcar #'buffer-name (erc-buffer-list))
+ '("foonet" ; shrunk
+ "#a@foonet" ; shrunk
+ "barnet/tester"
+ "barnet/dummy"
+ "#a@barnet/tester")))
+
+ (erc-networks-tests--clean-bufs))
+
+;; This likewise overlaps with the "hook" variants below. If this
+;; should ever fail, just delete it and optionally fix those.
+
+(ert-deftest erc-networks--shrink-ids-and-buffer-names--perform-collapse ()
+ ;; This is similar to the "outstanding" variant above, but both
+ ;; groups are eligible for renaming, which is abnormal but possible
+ ;; when recovering from some mishap.
+ (with-current-buffer (get-buffer-create "foonet/tester")
+ (erc-mode)
+ (setq erc-network 'foonet
+ erc-server-current-nick "tester"
+ erc-networks--id (make-erc-networks--id-qualifying
+ :symbol 'foonet/tester
+ :parts [foonet "tester"]
+ :len 2)
+ erc-server-process (erc-networks-tests--create-live-proc)))
+
+ (with-current-buffer
+ (get-buffer-create (elt ["#a" "#a@foonet/tester"] (random 2)))
+ (erc-mode)
+ (setq erc-server-process (buffer-local-value 'erc-server-process
+ (get-buffer "foonet/tester"))
+ erc-network 'foonet
+ erc-server-current-nick "tester"
+ erc-networks--id (buffer-local-value 'erc-networks--id
+ (get-buffer "foonet/tester"))
+ erc--target (erc--target-from-string "#a")))
+
+ (with-current-buffer (get-buffer-create "barnet/tester")
+ (erc-mode)
+ (setq erc-network 'barnet
+ erc-server-current-nick "tester"
+ erc-networks--id (make-erc-networks--id-qualifying
+ :symbol 'barnet/tester
+ :parts [barnet "tester"]
+ :len 2)
+ erc-server-process (erc-networks-tests--create-live-proc)))
+
+ (with-current-buffer
+ (get-buffer-create (elt ["#b" "#b@foonet/tester"] (random 2)))
+ (erc-mode)
+ (setq erc-network 'barnet
+ erc-server-current-nick "tester"
+ erc-server-process (buffer-local-value 'erc-server-process
+ (get-buffer "barnet/tester"))
+ erc-networks--id (buffer-local-value 'erc-networks--id
+ (get-buffer "barnet/tester"))
+ erc--target (erc--target-from-string "#b")))
+
+ (with-temp-buffer
+ (setq erc-networks--id (make-erc-networks--id-qualifying))
+ (erc-networks--shrink-ids-and-buffer-names))
+
+ (should (equal (mapcar #'buffer-name (erc-buffer-list))
+ '("foonet" "#a" "barnet" "#b")))
+
+ (erc-networks-tests--clean-bufs))
+
+(defun erc-networks--shrink-ids-and-buffer-names--hook-outstanding-common ()
+
+ (with-current-buffer (get-buffer-create "foonet/tester")
+ (erc-mode)
+ (setq erc-network 'foonet
+ erc-server-current-nick "tester"
+ erc-networks--id (make-erc-networks--id-qualifying
+ :symbol 'foonet/tester
+ :parts [foonet "tester"]
+ :len 2)
+ erc-server-process (erc-networks-tests--create-live-proc)))
+
+ (with-current-buffer (get-buffer-create "#a@foonet/tester")
+ (erc-mode)
+ (setq erc-server-process (buffer-local-value 'erc-server-process
+ (get-buffer "foonet/tester"))
+ erc-network 'foonet
+ erc-server-current-nick "tester"
+ erc-networks--id (buffer-local-value 'erc-networks--id
+ (get-buffer "foonet/tester"))
+ erc--target (erc--target-from-string "#a")))
+
+ (with-current-buffer (get-buffer-create "barnet/tester")
+ (erc-mode)
+ (setq erc-network 'barnet
+ erc-server-current-nick "tester"
+ erc-networks--id (make-erc-networks--id-qualifying
+ :symbol 'barnet/tester
+ :parts [barnet "tester"]
+ :len 2)
+ erc-server-process (erc-networks-tests--create-live-proc)))
+
+ (with-current-buffer (get-buffer-create "barnet/dummy")
+ (erc-mode)
+ (setq erc-network 'barnet
+ erc-server-current-nick "dummy"
+ erc-networks--id (make-erc-networks--id-qualifying
+ :symbol 'barnet/dummy
+ :parts [barnet "dummy"]
+ :len 2)
+ erc-server-process (erc-networks-tests--create-live-proc)))
+
+ (with-current-buffer (get-buffer-create "#a@barnet/tester")
+ (erc-mode)
+ (setq erc-network 'barnet
+ erc-server-current-nick "tester"
+ erc-server-process (buffer-local-value 'erc-server-process
+ (get-buffer "barnet/tester"))
+ erc-networks--id (buffer-local-value 'erc-networks--id
+ (get-buffer "barnet/tester"))
+ erc--target (erc--target-from-string "#a"))))
+
+(ert-deftest erc-networks--shrink-ids-and-buffer-names--hook-outstanding-srv ()
+ (erc-networks--shrink-ids-and-buffer-names--hook-outstanding-common)
+ (with-current-buffer (get-buffer-create "foonet/dummy")
+ (erc-mode)
+ (setq erc-network 'foonet
+ erc-server-current-nick "dummy"
+ erc-networks--id (make-erc-networks--id-qualifying
+ :symbol 'foonet/dummy
+ :parts [foonet "dummy"]
+ :len 2)
+ erc-server-process (erc-networks-tests--create-live-proc))
+ (kill-buffer))
+
+ (should (equal (mapcar #'buffer-name (erc-buffer-list))
+ '("foonet"
+ "#a@foonet"
+ "barnet/tester"
+ "barnet/dummy"
+ "#a@barnet/tester")))
+ (erc-networks-tests--clean-bufs))
+
+(ert-deftest erc-networks--shrink-ids-and-buffer-names--hook-outstanding-tgt ()
+ (erc-networks--shrink-ids-and-buffer-names--hook-outstanding-common)
+ (with-current-buffer (get-buffer-create "#a@foonet/dummy")
+ (erc-mode)
+ (setq erc-network 'foonet
+ erc-server-current-nick "dummy"
+ erc-networks--id (make-erc-networks--id-qualifying
+ :symbol 'foonet/dummy
+ :parts [foonet "dummy"]
+ :len 2)
+ erc--target (erc--target-from-string "#a")
+ erc-server-process (with-temp-buffer
+ (erc-networks-tests--create-dead-proc))))
+
+ (with-current-buffer "#a@foonet/dummy" (kill-buffer))
+
+ ;; Identical to *-server variant above
+ (should (equal (mapcar #'buffer-name (erc-buffer-list))
+ '("foonet"
+ "#a@foonet"
+ "barnet/tester"
+ "barnet/dummy"
+ "#a@barnet/tester")))
+ (erc-networks-tests--clean-bufs))
+
+(ert-deftest erc-networks-rename-surviving-target-buffer--shrink ()
+ (erc-networks--shrink-ids-and-buffer-names--hook-outstanding-common)
+
+ ;; This buffer isn't "#a@foonet" (yet) because the shrink-ids hook
+ ;; hasn't run. However, when it's the rename hook runs, its network
+ ;; id *is* "foonet", not "foonet/tester".
+ (with-current-buffer "#a@foonet/tester" (kill-buffer))
+
+ (should (equal (mapcar #'buffer-name (erc-buffer-list))
+ '("foonet"
+ "barnet/tester"
+ "barnet/dummy"
+ "#a")))
+
+ (erc-networks-tests--clean-bufs))
+
+(ert-deftest erc-networks--shrink-ids-and-buffer-names--server ()
+
+ (with-current-buffer (get-buffer-create "foonet/tester")
+ (erc-mode)
+ (setq erc-network 'foonet
+ erc-server-current-nick "tester"
+ erc-networks--id (make-erc-networks--id-qualifying
+ :symbol 'foonet/tester
+ :parts [foonet "tester"]
+ :len 2)
+ erc-server-process (erc-networks-tests--create-live-proc)))
+
+ (with-current-buffer (get-buffer-create "foonet/dummy")
+ (erc-mode)
+ (setq erc-network 'foonet
+ erc-server-current-nick "dummy"
+ erc-networks--id (make-erc-networks--id-qualifying
+ :symbol 'foonet/dummy
+ :parts [foonet "dummy"]
+ :len 2)
+ erc-server-process (erc-networks-tests--create-dead-proc))
+ (kill-buffer))
+
+ (should (equal (mapcar #'buffer-name (erc-buffer-list)) '("foonet")))
+
+ (erc-networks-tests--clean-bufs))
+
+(defun erc-networks--shrink-ids-and-buffer-names--hook-collapse (check)
+
+ (with-current-buffer (get-buffer-create "foonet/tester")
+ (erc-mode)
+ (setq erc-network 'foonet
+ erc-server-current-nick "tester"
+ erc-networks--id (make-erc-networks--id-qualifying
+ :symbol 'foonet/tester
+ :parts [foonet "tester"]
+ :len 2)
+ erc-server-process (erc-networks-tests--create-live-proc)))
+
+ (with-current-buffer (get-buffer-create "#a@foonet/tester")
+ (erc-mode)
+ (setq erc-server-process (buffer-local-value 'erc-server-process
+ (get-buffer "foonet/tester"))
+ erc-network 'foonet
+ erc-server-current-nick "tester"
+ erc-networks--id (buffer-local-value 'erc-networks--id
+ (get-buffer "foonet/tester"))
+ erc--target (erc--target-from-string "#a")))
+
+ (with-current-buffer (get-buffer-create "barnet/tester")
+ (erc-mode)
+ (setq erc-network 'barnet
+ erc-server-current-nick "tester"
+ erc-networks--id (make-erc-networks--id-qualifying
+ :symbol 'barnet/tester
+ :parts [barnet "tester"]
+ :len 2)
+ erc-server-process (erc-networks-tests--create-live-proc)))
+
+ (with-current-buffer (get-buffer-create "#b@foonet/tester")
+ (erc-mode)
+ (setq erc-network 'barnet
+ erc-server-current-nick "tester"
+ erc-server-process (buffer-local-value 'erc-server-process
+ (get-buffer "barnet/tester"))
+ erc-networks--id (buffer-local-value 'erc-networks--id
+ (get-buffer "barnet/tester"))
+ erc--target (erc--target-from-string "#b")))
+
+ (funcall check)
+
+ (should (equal (mapcar #'buffer-name (erc-buffer-list))
+ '("foonet" "#a" "barnet" "#b")))
+
+ (erc-networks-tests--clean-bufs))
+
+(ert-deftest erc-networks--shrink-ids-and-buffer-names--hook-collapse-server ()
+ (erc-networks--shrink-ids-and-buffer-names--hook-collapse
+ (lambda ()
+ (with-current-buffer (get-buffer-create "foonet/dummy")
+ (erc-mode)
+ (setq erc-network 'foonet
+ erc-server-current-nick "dummy"
+ erc-networks--id (make-erc-networks--id-qualifying
+ :symbol 'foonet/dummy
+ :parts [foonet "dummy"]
+ :len 2)
+ erc-server-process (erc-networks-tests--create-live-proc))
+ (kill-buffer)))))
+
+(ert-deftest erc-networks--shrink-ids-and-buffer-names--hook-collapse-target ()
+ (erc-networks--shrink-ids-and-buffer-names--hook-collapse
+ (lambda ()
+ (with-current-buffer (get-buffer-create "#a@foonet/dummy")
+ (erc-mode)
+ (setq erc-network 'foonet
+ erc-server-current-nick "dummy"
+ erc-networks--id (make-erc-networks--id-qualifying
+ :symbol 'foonet/dummy
+ :parts [foonet "dummy"]
+ :len 2)
+ ;; `erc-kill-buffer-function' uses legacy target detection
+ ;; but falls back on buffer name, so no need for:
+ ;;
+ ;; erc-default-recipients '("#a")
+ ;;
+ erc--target (erc--target-from-string "#a")
+ erc-server-process (with-temp-buffer
+ (erc-networks-tests--create-dead-proc)))
+ (kill-buffer)))))
+
+;; FIXME this test is old and may describe impossible states:
+;; leftover identities being qual-equal but not eq (implies
+;; `erc-networks--reclaim-orphaned-target-buffers' is somehow broken).
+;;
+;; Otherwise, the point of this test is to show that server process
+;; identity does not impact the hunt for duplicates.
+
+(defun erc-tests--prep-erc-networks--reconcile-buffer-names--duplicates (start)
+
+ (with-current-buffer (get-buffer-create "foonet")
+ (erc-mode)
+ (setq erc-network 'foonet
+ erc-server-current-nick "tester"
+ erc-networks--id (erc-networks--id-create nil)
+ erc-server-process (funcall start)))
+
+ (with-current-buffer (get-buffer-create "#chan") ; prior session
+ (erc-mode)
+ (setq erc-server-process (buffer-local-value 'erc-server-process
+ (get-buffer "foonet"))
+ erc--target (erc--target-from-string "#chan")
+ erc-networks--id (erc-networks--id-create nil)))
+
+ (ert-info ("Conflicts not recognized as ERC buffers and not renamed")
+ (get-buffer-create "#chan@foonet")
+ (should (equal (erc-networks-tests--bufnames "#chan")
+ '("#chan" "#chan@foonet"))))
+
+ ;; These are dupes (not "collisions")
+
+ (with-current-buffer "#chan@foonet" ; same proc
+ (erc-mode)
+ (setq erc--target (erc--target-from-string "#chan")
+ erc-network 'foonet
+ erc-server-current-nick "tester"
+ erc-server-process (buffer-local-value 'erc-server-process
+ (get-buffer "foonet"))
+ erc-networks--id (erc-networks--id-create nil)))
+
+ (with-current-buffer (get-buffer-create "#chan@foonet<dead>")
+ (erc-mode)
+ (setq erc--target (erc--target-from-string "#chan")
+ erc-server-process (erc-networks-tests--create-dead-proc)
+ erc-network 'foonet
+ erc-server-current-nick "tester"
+ erc-networks--id (erc-networks--id-create nil)))
+
+ (with-current-buffer (get-buffer-create "#chan@foonet<live>")
+ (erc-mode)
+ (setq erc--target (erc--target-from-string "#chan")
+ erc-server-process (erc-networks-tests--create-live-proc)
+ erc-network 'foonet
+ erc-server-current-nick "tester"
+ erc-networks--id (erc-networks--id-create nil)))
+
+ (let ((created (list (get-buffer "#chan@foonet<live>")
+ (get-buffer "#chan@foonet<dead>")
+ (get-buffer "#chan@foonet"))))
+
+ (with-current-buffer "foonet"
+ (should (string= (erc-networks--reconcile-buffer-names
+ (erc--target-from-string "#chan") erc-networks--id)
+ "#chan")))
+
+ (ert-info ("All buffers considered dupes renamed")
+ (should (equal (erc-networks-tests--bufnames "#chan")
+ '("#chan" "#chan<2>" "#chan<3>" "#chan<4>"))))
+
+ (ert-info ("All buffers renamed from newest to oldest")
+ (should (equal created (list (get-buffer "#chan<2>")
+ (get-buffer "#chan<3>")
+ (get-buffer "#chan<4>"))))))
+
+ (erc-networks-tests--clean-bufs))
+
+(defun erc-tests--prep-erc-networks--reconcile-buffer-names--dupes-given (go)
+
+ ;; The connection's network is discovered before target buffers are
+ ;; created. This shows that the network doesn't matter when only
+ ;; "given" IDs are present.
+ (with-current-buffer (get-buffer-create "oofnet")
+ (erc-mode)
+ (setq erc-networks--id (erc-networks--id-create 'oofnet)
+ erc-network 'foonet
+ erc-server-current-nick "tester"
+ erc-server-process (funcall go)))
+
+ (with-current-buffer (get-buffer-create "#chan") ; prior session
+ (erc-mode)
+ (setq erc-networks--id (erc-networks--id-create 'oofnet)
+ erc-server-process (buffer-local-value 'erc-server-process
+ (get-buffer "oofnet"))
+ erc--target (erc--target-from-string "#chan")))
+
+ (with-current-buffer (get-buffer-create "#chan@oofnet") ;dupe/not collision
+ (erc-mode)
+ (setq erc-networks--id (erc-networks--id-create 'oofnet)
+ erc-server-process (buffer-local-value 'erc-server-process
+ (get-buffer "oofnet"))
+ erc--target (erc--target-from-string "#chan")))
+
+ (with-current-buffer "oofnet"
+ (should (string= (erc-networks--reconcile-buffer-names
+ (erc--target-from-string "#chan") erc-networks--id)
+ "#chan")))
+
+ (ert-info ("All buffers matching target and network renamed")
+ (should (equal (erc-networks-tests--bufnames "#chan")
+ '("#chan" "#chan<2>"))))
+
+ (erc-networks-tests--clean-bufs))
+
+(ert-deftest erc-networks--reconcile-buffer-names--duplicates ()
+ (ert-info ("Process live, no error")
+ (erc-tests--prep-erc-networks--reconcile-buffer-names--duplicates
+ #'erc-networks-tests--create-live-proc))
+
+ (ert-info ("Process live, no error, given ID")
+ (erc-tests--prep-erc-networks--reconcile-buffer-names--dupes-given
+ #'erc-networks-tests--create-live-proc))
+
+ (ert-info ("Process dead")
+ (erc-tests--prep-erc-networks--reconcile-buffer-names--duplicates
+ #'erc-networks-tests--create-dead-proc))
+
+ (ert-info ("Process dead, given ID")
+ (erc-tests--prep-erc-networks--reconcile-buffer-names--dupes-given
+ #'erc-networks-tests--create-dead-proc)))
+
+(defun erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf (check)
+ (let ((foonet-proc (with-temp-buffer
+ (erc-networks-tests--create-dead-proc))))
+ (with-current-buffer (get-buffer-create "barnet")
+ (erc-mode)
+ (setq erc-network 'barnet
+ erc-server-current-nick "tester"
+ erc-networks--id (erc-networks--id-create nil)
+ erc-server-process (erc-networks-tests--create-dead-proc)))
+
+ ;; Different proc and not "qual-equal" (different elts)
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (setq erc-network 'foonet
+ erc-server-current-nick "tester"
+ erc-networks--id (erc-networks--id-create nil)
+ erc--target (erc--target-from-string "#chan")
+ erc-server-process foonet-proc))
+ (funcall check)
+ (erc-networks-tests--clean-bufs)))
+
+(ert-deftest erc-networks--reconcile-buffer-names--no-server-buf ()
+ (ert-info ("Existing #chan buffer respected")
+ (erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf
+ (lambda ()
+ (with-current-buffer "barnet"
+ (should (string= (erc-networks--reconcile-buffer-names
+ (erc--target-from-string "#chan") erc-networks--id)
+ "#chan@barnet")))
+ (ert-info ("Existing #chan buffer found and renamed")
+ (should (equal (erc-networks-tests--bufnames "#chan")
+ '("#chan@foonet")))))))
+
+ (ert-info ("Existing #chan buffer")
+ (erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf
+ (lambda ()
+ (with-current-buffer (get-buffer-create "foonet")
+ (erc-mode)
+ (setq erc-network 'foonet
+ erc-server-current-nick "tester"
+ erc-networks--id (erc-networks--id-create nil)
+ erc-server-process (erc-networks-tests--create-dead-proc))
+ (should (string= (erc-networks--reconcile-buffer-names
+ (erc--target-from-string "#chan") erc-networks--id)
+ "#chan")))
+ (ert-info ("Nothing renamed")
+ (should (equal (erc-networks-tests--bufnames "#chan") '("#chan")))))))
+
+ (ert-info ("Existing #chan@foonet and #chan@barnet buffers")
+ (erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf
+ (lambda ()
+ (with-current-buffer "#chan"
+ (rename-buffer "#chan@foonet"))
+ (should-not (get-buffer "#chan@barnet"))
+ (with-current-buffer (get-buffer-create "#chan@barnet")
+ (erc-mode)
+ (setq erc--target (erc--target-from-string "#chan")
+ erc-server-process (buffer-local-value 'erc-server-process
+ (get-buffer "barnet"))
+ erc-networks--id (erc-networks--id-create nil)))
+ (with-current-buffer (get-buffer-create "foonet")
+ (erc-mode)
+ (setq erc-network 'foonet
+ erc-server-current-nick "tester"
+ erc-server-process (erc-networks-tests--create-live-proc)
+ erc-networks--id (erc-networks--id-create nil))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (should (string= (erc-networks--reconcile-buffer-names
+ (erc--target-from-string "#chan") erc-networks--id)
+ "#chan@foonet")))
+ (ert-info ("Nothing renamed")
+ (should (equal (erc-networks-tests--bufnames "#chan")
+ '("#chan@barnet" "#chan@foonet"))))))))
+
+(defun erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf-given
+ (check)
+ (let ((oofnet-proc (with-temp-buffer
+ (erc-networks-tests--create-dead-proc))))
+
+ (with-current-buffer (get-buffer-create "rabnet")
+ (erc-mode)
+ ;; Again, given name preempts network lookup (unrealistic but
+ ;; highlights priorities)
+ (setq erc-networks--id (erc-networks--id-create 'rabnet)
+ erc-network 'barnet
+ erc-server-current-nick "tester"
+ erc-server-process (erc-networks-tests--create-dead-proc)))
+
+ ;; Identity is not "qual-equal" to above
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (setq erc-networks--id (erc-networks--id-create 'oofnet)
+ erc-network 'foonet
+ erc--target (erc--target-from-string "#chan")
+ erc-server-process oofnet-proc))
+ (funcall check)
+ (erc-networks-tests--clean-bufs)))
+
+(ert-deftest erc-networks--reconcile-buffer-names--no-server-buf-given ()
+
+ (ert-info ("Existing #chan buffer respected")
+ (erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf-given
+ (lambda ()
+ (with-current-buffer "rabnet"
+ (should (string= (erc-networks--reconcile-buffer-names
+ (erc--target-from-string "#chan") erc-networks--id)
+ "#chan@rabnet")))
+
+ (ert-info ("Existing #chan buffer found and renamed")
+ (should (equal (erc-networks-tests--bufnames "#chan")
+ '("#chan@oofnet")))))))
+
+ (ert-info ("Existing #chan@oofnet and #chan@rabnet buffers")
+ (erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf-given
+ (lambda ()
+ ;; #chan has already been uniquified (but not grown)
+ (with-current-buffer "#chan" (rename-buffer "#chan@oofnet"))
+ (should-not (get-buffer "#chan@rabnet"))
+
+ (with-current-buffer (get-buffer-create "#chan@rabnet")
+ (erc-mode)
+ (setq erc--target (erc--target-from-string "#chan")
+ erc-server-process (buffer-local-value 'erc-server-process
+ (get-buffer "rabnet"))
+ erc-networks--id (buffer-local-value 'erc-networks--id
+ (get-buffer "rabnet"))))
+
+ (with-current-buffer (get-buffer-create "oofnet")
+ (erc-mode)
+ (setq erc-network 'oofnet
+ erc-server-current-nick "tester"
+ erc-server-process (erc-networks-tests--create-live-proc)
+ erc-networks--id (erc-networks--id-create 'oofnet)) ; given
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (should (string= (erc-networks--reconcile-buffer-names
+ (erc--target-from-string "#chan") erc-networks--id)
+ "#chan@oofnet")))
+
+ (ert-info ("Nothing renamed")
+ (should (equal (erc-networks-tests--bufnames "#chan")
+ '("#chan@oofnet" "#chan@rabnet"))))))))
+
+;; This shows a corner case where a user explicitly assigns a "given"
+;; ID via `erc-tls' but later connects again without one. It would
+;; actually probably be better if the given identity were to win and
+;; the derived one got an <n>-suffix.
+;;
+;; If we just compared net identities, the two would match, but they
+;; don't here because one has a given name and the other a
+;; discovered/assembled one; so they are *not* qual-equal.
+(ert-deftest erc-networks--reconcile-buffer-names--no-srv-buf-given-mismatch ()
+ ;; Existing #chan buffer *not* respected
+ (erc-tests--prep-erc-networks--reconcile-buffer-names--no-srv-buf-given
+ (lambda ()
+ (with-current-buffer (get-buffer-create "oofnet")
+ (erc-mode)
+ (setq erc-network 'oofnet
+ erc-server-current-nick "tester"
+ erc-server-process (erc-networks-tests--create-dead-proc)
+ erc-networks--id (erc-networks--id-create nil)) ; derived
+ (should (string= (erc-networks--reconcile-buffer-names
+ (erc--target-from-string "#chan") erc-networks--id)
+ "#chan@oofnet")))
+
+ (ert-info ("Collision renamed but not grown (because it's a given)")
+ ;; Original chan uniquified and moved out of the way
+ (should (equal (erc-networks-tests--bufnames "#chan")
+ '("#chan@oofnet<2>")))))))
+
+(defun erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net (check)
+
+ (with-current-buffer (get-buffer-create "foonet")
+ (erc-mode)
+ (setq erc-network 'foonet
+ erc-server-current-nick "tester"
+ erc-server-process (erc-networks-tests--create-dead-proc)
+ erc-networks--id (erc-networks--id-create nil))) ; derived
+
+ (with-current-buffer (get-buffer-create "barnet")
+ (erc-mode)
+ (setq erc-network 'barnet
+ erc-server-current-nick "tester"
+ erc-server-process (erc-networks-tests--create-dead-proc)
+ erc-networks--id (erc-networks--id-create nil))) ; derived
+
+ (with-current-buffer
+ (get-buffer-create (elt ["#chan" "#chan@foonet"] (random 2)))
+ (erc-mode)
+ (setq erc--target (erc--target-from-string "#chan"))
+ (cl-multiple-value-setq (erc-server-process erc-networks--id)
+ (with-current-buffer "foonet"
+ (list erc-server-process erc-networks--id))))
+
+ (with-current-buffer (get-buffer-create "#chan@barnet")
+ (erc-mode)
+ (setq erc--target (erc--target-from-string "#chan"))
+ (cl-multiple-value-setq (erc-server-process erc-networks--id)
+ (with-current-buffer "barnet"
+ (list erc-server-process erc-networks--id))))
+
+ (funcall check)
+ (erc-networks-tests--clean-bufs))
+
+(ert-deftest erc-networks--reconcile-buffer-names--multi-net ()
+ (ert-info ("Same network rename")
+ (erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net
+ (lambda ()
+ (with-current-buffer "foonet"
+ (let ((result (erc-networks--reconcile-buffer-names
+ (erc--target-from-string "#chan") erc-networks--id)))
+ (should (string= result "#chan@foonet"))))
+
+ (should (equal (erc-networks-tests--bufnames "#chan")
+ '("#chan@barnet" "#chan@foonet"))))))
+
+ (ert-info ("Same network keep name")
+ (erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net
+ (lambda ()
+ (with-current-buffer "barnet"
+ (let ((result (erc-networks--reconcile-buffer-names
+ (erc--target-from-string "#chan") erc-networks--id)))
+ (should (string= result "#chan@barnet"))))
+
+ (should (equal (erc-networks-tests--bufnames "#chan")
+ '("#chan@barnet" "#chan@foonet")))))))
+
+(defun erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net-given
+ (check)
+
+ (with-current-buffer (get-buffer-create "oofnet")
+ (erc-mode)
+ (setq erc-network 'foonet
+ erc-server-current-nick "tester"
+ erc-networks--id (erc-networks--id-create 'oofnet) ; one given
+ erc-server-process (erc-networks-tests--create-dead-proc)))
+
+ (with-current-buffer (get-buffer-create "rabnet")
+ (erc-mode)
+ (setq erc-network 'barnet
+ erc-server-current-nick "tester"
+ erc-networks--id (erc-networks--id-create 'rabnet) ; another given
+ erc-server-process (erc-networks-tests--create-dead-proc)))
+
+ (with-current-buffer (get-buffer-create (elt ["chan" "#chan@oofnet"]
+ (random 2)))
+ (erc-mode)
+ (setq erc--target (erc--target-from-string "#chan"))
+ (cl-multiple-value-setq (erc-server-process erc-networks--id)
+ (with-current-buffer "oofnet"
+ (list erc-server-process erc-networks--id))))
+
+ (with-current-buffer (get-buffer-create "#chan@barnet")
+ (erc-mode)
+ (setq erc--target (erc--target-from-string "#chan"))
+ (cl-multiple-value-setq (erc-server-process erc-networks--id)
+ (with-current-buffer "rabnet"
+ (list erc-server-process erc-networks--id))))
+
+ (funcall check)
+ (erc-networks-tests--clean-bufs))
+
+(ert-deftest erc-networks--reconcile-buffer-names--multi-net-given ()
+ (ert-info ("Same network rename")
+ (erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net-given
+ (lambda ()
+ (with-current-buffer "oofnet"
+ (let ((result (erc-networks--reconcile-buffer-names
+ (erc--target-from-string "#chan") erc-networks--id)))
+ (should (string= result "#chan@oofnet"))))
+
+ (should (equal (erc-networks-tests--bufnames "#chan")
+ '("#chan@oofnet" "#chan@rabnet"))))))
+
+ (ert-info ("Same network keep name")
+ (erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net-given
+ (lambda ()
+ (with-current-buffer "rabnet"
+ (let ((result (erc-networks--reconcile-buffer-names
+ (erc--target-from-string "#chan") erc-networks--id)))
+ (should (string= result "#chan@rabnet"))))
+
+ (should (equal (erc-networks-tests--bufnames "#chan")
+ '("#chan@oofnet" "#chan@rabnet")))))))
+
+(defun erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net-mixed
+ (check)
+
+ (with-current-buffer (get-buffer-create "foonet")
+ (erc-mode)
+ (setq erc-network 'foonet
+ erc-server-current-nick "tester"
+ erc-networks--id (erc-networks--id-create nil) ; one derived
+ erc-server-process (erc-networks-tests--create-dead-proc)))
+
+ (with-current-buffer (get-buffer-create "my-conn")
+ (erc-mode)
+ (setq erc-network 'barnet
+ erc-server-current-nick "tester"
+ erc-networks--id (erc-networks--id-create 'my-conn) ; one given
+ erc-server-process (erc-networks-tests--create-dead-proc)))
+
+ (with-current-buffer (get-buffer-create (elt ["#chan" "#chan@foonet"]
+ (random 2)))
+ (erc-mode)
+ (setq erc--target (erc--target-from-string "#chan"))
+ (cl-multiple-value-setq (erc-server-process erc-networks--id)
+ (with-current-buffer "foonet"
+ (list erc-server-process erc-networks--id))))
+
+ (with-current-buffer (get-buffer-create "#chan@my-conn")
+ (erc-mode)
+ (setq erc--target (erc--target-from-string "#chan"))
+ (cl-multiple-value-setq (erc-server-process erc-networks--id)
+ (with-current-buffer "my-conn"
+ (list erc-server-process erc-networks--id))))
+
+ (funcall check)
+ (erc-networks-tests--clean-bufs))
+
+(ert-deftest erc-networks--reconcile-buffer-names--multi-net-existing ()
+
+ (ert-info ("Buf name derived from network")
+ (erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net-mixed
+ (lambda ()
+ (with-current-buffer "foonet"
+ (let ((result (erc-networks--reconcile-buffer-names
+ (erc--target-from-string "#chan") erc-networks--id)))
+ (should (string= result "#chan@foonet"))))
+
+ (should (equal (erc-networks-tests--bufnames "#chan")
+ '("#chan@foonet" "#chan@my-conn"))))))
+
+ (ert-info ("Buf name given")
+ (erc-tests--prep-erc-networks--reconcile-buffer-names--multi-net-mixed
+ (lambda ()
+ (with-current-buffer "my-conn"
+ (let ((result (erc-networks--reconcile-buffer-names
+ (erc--target-from-string "#chan") erc-networks--id)))
+ (should (string= result "#chan@my-conn"))))
+
+ (should (equal (erc-networks-tests--bufnames "#chan")
+ '("#chan@foonet" "#chan@my-conn")))))))
+
+(ert-deftest erc-networks--reconcile-buffer-names--multi-net-suffixed ()
+ ;; Two networks, same channel. One network has two connections.
+ ;; When the same channel is joined on the latter under a different
+ ;; nick, all buffer names involving that network are suffixed with
+ ;; the network identity.
+
+ (with-current-buffer (get-buffer-create "foonet/bob")
+ (erc-mode)
+ (setq erc-network 'foonet
+ erc-server-current-nick "bob"
+ erc-networks--id (make-erc-networks--id-qualifying
+ :symbol 'foonet/bob
+ :parts [foonet "bob"]
+ :len 2)
+ erc-server-process (erc-networks-tests--create-live-proc)))
+
+ (with-current-buffer (get-buffer-create
+ (elt ["#chan@foonet" "#chan@foonet/bob"] (random 2)))
+ (erc-mode)
+ (setq erc--target (erc--target-from-string "#chan")
+ erc-server-process (buffer-local-value 'erc-server-process
+ (get-buffer "foonet/bob"))
+ erc-networks--id (buffer-local-value 'erc-networks--id
+ (get-buffer "foonet/bob"))))
+
+ (with-current-buffer (get-buffer-create "barnet")
+ (erc-mode)
+ (setq erc-network 'barnet
+ erc-server-current-nick (elt ["alice" "bob"] (random 2))
+ erc-networks--id (erc-networks--id-create 'barnet)
+ erc-server-process (erc-networks-tests--create-live-proc)))
+
+ (with-current-buffer (get-buffer-create "#chan@barnet")
+ (erc-mode)
+ (setq erc--target (erc--target-from-string "#chan")
+ erc-server-process (buffer-local-value 'erc-server-process
+ (get-buffer "barnet"))
+ erc-networks--id (buffer-local-value 'erc-networks--id
+ (get-buffer "barnet"))))
+
+ (with-current-buffer (get-buffer-create "foonet/alice")
+ (erc-mode)
+ (setq erc-network 'foonet
+ erc-server-current-nick "alice"
+ erc-networks--id (make-erc-networks--id-qualifying
+ :symbol 'foonet/alice
+ :parts [foonet "alice"]
+ :len 2)
+ erc-server-process (erc-networks-tests--create-live-proc)))
+
+ (with-current-buffer "foonet/alice"
+ (let ((result (erc-networks--reconcile-buffer-names
+ (erc--target-from-string "#chan") erc-networks--id)))
+ (should (string= result "#chan@foonet/alice"))))
+
+ (should (equal (erc-networks-tests--bufnames "#chan")
+ '("#chan@barnet" "#chan@foonet/bob")))
+
+ (erc-networks-tests--clean-bufs))
+
+(ert-deftest erc-networks--reconcile-buffer-names--local ()
+ (with-current-buffer (get-buffer-create "DALnet")
+ (erc-mode)
+ (setq erc-network 'DALnet
+ erc-server-announced-name "elysium.ga.us.dal.net"
+ erc-server-process (erc-networks-tests--create-dead-proc)
+ erc--isupport-params (make-hash-table)
+ erc-networks--id (erc-networks--id-create nil))
+ (puthash 'CHANTYPES '("&#") erc--isupport-params))
+
+ (ert-info ("Local chan buffer from older, disconnected identity")
+ (with-current-buffer (get-buffer-create "&chan")
+ (erc-mode)
+ ;; Cheat here because localp is determined on identity init
+ (setq erc--target (with-current-buffer "DALnet"
+ (erc--target-from-string "&chan"))
+ erc-network 'DALnet
+ erc-server-announced-name "twisted.ma.us.dal.net"
+ erc-server-process (erc-networks-tests--create-dead-proc)
+ erc-networks--id (erc-networks--id-create nil))))
+
+ (ert-info ("Local channels renamed using network server names")
+ (with-current-buffer "DALnet"
+ (let ((result (erc-networks--reconcile-buffer-names
+ (erc--target-from-string "&chan") erc-networks--id)))
+ (should (string= result "&chan@elysium.ga.us.dal.net")))))
+
+ (should (get-buffer "&chan@twisted.ma.us.dal.net"))
+ (should-not (get-buffer "&chan"))
+ (erc-networks-tests--clean-bufs))
+
+(ert-deftest erc-networks--set-name ()
+ (with-current-buffer (get-buffer-create "localhost:6667")
+ (let (erc-server-announced-name
+ (erc--isupport-params (make-hash-table))
+ erc-network
+ calls)
+ (erc-mode)
+
+ (cl-letf (((symbol-function 'erc-display-line)
+ (lambda (&rest r) (push r calls))))
+
+ (ert-info ("Signals when `erc-server-announced-name' unset")
+ (should-error (erc-networks--set-name nil (make-erc-response)))
+ (should-not calls))
+
+ (ert-info ("Signals when table empty and NETWORK param unset")
+ (setq erc-server-announced-name "irc.fake.gnu.org")
+ (let ((err (should-error (erc-networks--set-name
+ nil (make-erc-response)))))
+ (should (string-match-p "failed" (cadr err)))
+ (should (eq (car err) 'error)))
+ (should (string-match-p "*** Failed" (car (pop calls)))))))
+
+ (erc-networks-tests--clean-bufs)))
+
+(ert-deftest erc-networks--ensure-announced ()
+ (with-current-buffer (get-buffer-create "localhost:6667")
+ (should (local-variable-if-set-p 'erc-server-announced-name))
+ (let (erc-insert-modify-hook
+ (erc-server-process (erc-networks-tests--create-live-proc))
+ (parsed (make-erc-response
+ :unparsed ":irc.barnet.org 422 tester :MOTD File is missing"
+ :sender "irc.barnet.org"
+ :command "422"
+ :command-args '("tester" "MOTD File is missing")
+ :contents "MOTD File is missing")))
+
+ (erc-mode) ; boilerplate displayable start (needs `erc-server-process')
+ (insert "\n\n")
+ (setq erc-input-marker (make-marker) erc-insert-marker (make-marker))
+ (set-marker erc-insert-marker (point-max))
+ (erc-display-prompt) ; boilerplate displayable end
+
+ (erc-networks--ensure-announced erc-server-process parsed)
+ (goto-char (point-min))
+ (search-forward "Failed")
+ (should (string= erc-server-announced-name "irc.barnet.org")))
+ (when noninteractive (kill-buffer))))
+
+(ert-deftest erc-networks--rename-server-buffer--no-existing--orphan ()
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (setq erc-network 'FooNet
+ erc-server-current-nick "tester"
+ erc--target (erc--target-from-string "#chan")
+ erc-networks--id (erc-networks--id-create nil)))
+
+ (with-current-buffer (get-buffer-create "irc.foonet.org")
+ (erc-mode)
+ (setq erc-network 'FooNet
+ erc-server-current-nick "tester"
+ erc-server-process (erc-networks-tests--create-live-proc)
+ erc-networks--id (erc-networks--id-create nil))
+ (should-not (erc-networks--rename-server-buffer erc-server-process))
+ (should (string= (buffer-name) "FooNet")))
+
+ (ert-info ("Channel buffer reassociated")
+ (erc-server-process-alive "#chan")
+ (with-current-buffer "#chan"
+ (should erc-server-connected)
+ (erc-with-server-buffer
+ (should (string= (buffer-name) "FooNet")))))
+
+ (erc-networks-tests--clean-bufs))
+
+(ert-deftest erc-networks--rename-server-buffer--existing--reuse ()
+ (let* ((old-buf (get-buffer-create "FooNet"))
+ (old-proc (erc-networks-tests--create-dead-proc old-buf)))
+
+ (with-current-buffer old-buf
+ (erc-mode)
+ (insert "*** Old buf")
+ (setq erc-network 'FooNet
+ erc-server-current-nick "tester"
+ erc-insert-marker (set-marker (make-marker) (point-max))
+ erc-server-process old-proc
+ erc-networks--id (erc-networks--id-create nil)))
+
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (setq erc-network 'FooNet
+ erc-server-process old-proc
+ erc-networks--id (erc-networks--id-create nil)
+ erc--target (erc--target-from-string "#chan")))
+
+ (ert-info ("New buffer steals name, content")
+ (with-current-buffer (get-buffer-create "irc.foonet.org")
+ (erc-mode)
+ (setq erc-network 'FooNet
+ erc-server-current-nick "tester"
+ erc-server-process (erc-networks-tests--create-live-proc)
+ erc-networks--id (erc-networks--id-create nil))
+ (should-not (erc-networks--rename-server-buffer erc-server-process))
+ (should (string= (buffer-name) "FooNet"))
+ (goto-char (point-min))
+ (should (search-forward "Old buf"))))
+
+ (ert-info ("Channel buffer reassociated")
+ (erc-server-process-alive "#chan")
+ (with-current-buffer "#chan"
+ (should erc-server-connected)
+ (should-not (eq erc-server-process old-proc))
+ (erc-with-server-buffer
+ (should (string= (buffer-name) "FooNet")))))
+
+ (ert-info ("Original buffer killed off")
+ (should-not (buffer-live-p old-buf))))
+
+ (erc-networks-tests--clean-bufs))
+
+;; This is for compatibility with pre-28.1 behavior. Basically, we're
+;; trying to match the behavior bug for bug. All buffers were always
+;; suffixed and never reassociated. 28.1 introduced a regression that
+;; reversed the latter, but we've reverted that.
+
+(ert-deftest erc-networks--rename-server-buffer--existing--noreuse ()
+ (with-suppressed-warnings ((obsolete erc-reuse-buffers))
+ (should erc-reuse-buffers) ; default
+ (let* ((old-buf (get-buffer-create "irc.foonet.org:6697/irc.foonet.org"))
+ (old-proc (erc-networks-tests--create-dead-proc old-buf))
+ erc-reuse-buffers)
+ (with-current-buffer old-buf
+ (erc-mode)
+ (insert "*** Old buf")
+ (setq erc-network 'FooNet
+ erc-server-current-nick "tester"
+ erc-insert-marker (set-marker (make-marker) (point-max))
+ erc-server-process old-proc
+ erc-networks--id (erc-networks--id-create nil)))
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (setq erc-network 'FooNet
+ erc-server-process old-proc
+ erc-networks--id (buffer-local-value 'erc-networks--id old-buf)
+ erc--target (erc--target-from-string "#chan"))
+ (rename-buffer (erc-networks--construct-target-buffer-name erc--target)))
+
+ (ert-info ("Server buffer uniquely renamed")
+ (with-current-buffer
+ (get-buffer-create "irc.foonet.org:6697/irc.foonet.org<2>")
+ (erc-mode)
+ (setq erc-network 'FooNet
+ erc-server-current-nick "tester"
+ erc-server-process (erc-networks-tests--create-live-proc)
+ erc-networks--id (erc-networks--id-create nil))
+ (should-not (erc-networks--rename-server-buffer erc-server-process))
+ (should (string= (buffer-name)
+ "irc.foonet.org:6697/irc.foonet.org<2>"))
+ (goto-char (point-min))
+ (should-not (search-forward "Old buf" nil t))))
+
+ (ert-info ("Channel buffer not reassociated")
+ (should-not
+ (erc-server-process-alive
+ (should (get-buffer "#chan/irc.foonet.org"))))
+ (with-current-buffer (get-buffer "#chan/irc.foonet.org")
+ (should-not erc-server-connected)
+ (should (eq erc-server-process old-proc))
+ (erc-with-server-buffer
+ (should (string= (buffer-name)
+ "irc.foonet.org:6697/irc.foonet.org")))))
+
+ (ert-info ("Old buffer still around")
+ (should (buffer-live-p old-buf)))))
+ (erc-networks-tests--clean-bufs))
+
+(ert-deftest erc-networks--rename-server-buffer--reconnecting ()
+ (let* ((old-buf (get-buffer-create "FooNet"))
+ (old-proc (erc-networks-tests--create-dead-proc old-buf)))
+
+ (with-current-buffer old-buf
+ (erc-mode)
+ (insert "*** Old buf")
+ (setq erc-network 'FooNet
+ erc-server-current-nick "tester"
+ erc-insert-marker (set-marker (make-marker) (point-max))
+ erc-server-process old-proc
+ erc-networks--id (erc-networks--id-create nil)))
+
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (setq erc-network 'FooNet
+ erc-server-process old-proc
+ erc--target (erc--target-from-string "#chan")
+ erc-networks--id (erc-networks--id-create nil)))
+
+ (ert-info ("No new buffer")
+ (with-current-buffer old-buf
+ (setq erc-server-process (erc-networks-tests--create-live-proc))
+ (should-not (erc-networks--rename-server-buffer erc-server-process))
+ (should (string= (buffer-name) "FooNet"))
+ (goto-char (point-min))
+ (should (search-forward "Old buf"))))
+
+ (ert-info ("Channel buffer updated with live proc")
+ (erc-server-process-alive "#chan")
+ (with-current-buffer "#chan"
+ (should erc-server-connected)
+ (should-not (eq erc-server-process old-proc))
+ (erc-with-server-buffer
+ (should (string= (buffer-name) "FooNet"))))))
+
+ (erc-networks-tests--clean-bufs))
+
+(ert-deftest erc-networks--rename-server-buffer--id ()
+ (let* ((old-buf (get-buffer-create "MySession"))
+ (old-proc (erc-networks-tests--create-dead-proc old-buf)))
+
+ (with-current-buffer old-buf
+ (erc-mode)
+ (insert "*** Old buf")
+ (setq erc-network 'FooNet
+ erc-networks--id (erc-networks--id-create 'MySession)
+ erc-insert-marker (set-marker (make-marker) (point-max))
+ erc-server-process old-proc))
+
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (setq erc-network 'FooNet
+ erc-networks--id (erc-networks--id-create 'MySession)
+ erc-server-process old-proc
+ erc--target (erc--target-from-string "#chan")))
+
+ (ert-info ("No new buffer")
+ (with-current-buffer old-buf
+ (setq erc-server-process (erc-networks-tests--create-live-proc))
+ (should-not (erc-networks--rename-server-buffer erc-server-process))
+ (should (string= (buffer-name) "MySession"))
+ (goto-char (point-min))
+ (should (search-forward "Old buf"))))
+
+ (ert-info ("Channel buffer updated with live proc")
+ (erc-server-process-alive "#chan")
+ (with-current-buffer "#chan"
+ (should erc-server-connected)
+ (should-not (eq erc-server-process old-proc))
+ (erc-with-server-buffer
+ (should (string= (buffer-name) "MySession"))))))
+
+ (erc-networks-tests--clean-bufs))
+
+(ert-deftest erc-networks--rename-server-buffer--existing--live ()
+ (let* (erc-kill-server-hook
+ erc-insert-modify-hook
+ (old-buf (get-buffer-create "FooNet"))
+ (old-proc (erc-networks-tests--create-live-proc old-buf))) ; live
+
+ (with-current-buffer old-buf
+ (erc-mode)
+ (insert "*** Old buf")
+ (setq erc-network 'FooNet
+ erc-server-current-nick "tester"
+ erc-insert-marker (set-marker (make-marker) (point-max))
+ erc-server-process old-proc
+ erc-networks--id (erc-networks--id-create nil))
+ (should (erc-server-process-alive)))
+
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (setq erc-network 'FooNet
+ erc-server-process old-proc
+ erc-networks--id (erc-networks--id-create nil)
+ erc-server-connected t
+ erc--target (erc--target-from-string "#chan")))
+
+ (ert-info ("New buffer rejected, abandoned, not killed")
+ (with-current-buffer (get-buffer-create "irc.foonet.org")
+ (erc-mode)
+ (setq erc-network 'FooNet
+ erc-server-current-nick "tester"
+ erc-insert-marker (set-marker (make-marker) (point-max))
+ erc-server-process (erc-networks-tests--create-live-proc)
+ erc-networks--id (erc-networks--id-create nil))
+ (should-not (erc-networks--rename-server-buffer erc-server-process))
+ (should (eq erc-active-buffer old-buf))
+ (should-not (erc-server-process-alive))
+ (should (string= (buffer-name) "irc.foonet.org"))
+ (goto-char (point-min))
+ (search-forward "still connected")))
+
+ (ert-info ("Channel buffer updated with live proc")
+ (should (erc-server-process-alive "#chan"))
+ (with-current-buffer "#chan"
+ (should erc-server-connected)
+ (should (erc-server-buffer-live-p))
+ (should (eq erc-server-process old-proc))
+ (should (buffer-live-p (process-buffer erc-server-process)))
+ (with-current-buffer (process-buffer erc-server-process)
+ (should (eq (current-buffer) (get-buffer "FooNet")))
+ (should (eq (current-buffer) old-buf))))))
+
+ (should (get-buffer "FooNet"))
+ (should (get-buffer "irc.foonet.org"))
+
+ (erc-networks-tests--clean-bufs))
+
+(ert-deftest erc-networks--rename-server-buffer--local-match ()
+ (let* ((old-buf (get-buffer-create "FooNet"))
+ (old-proc (erc-networks-tests--create-dead-proc old-buf)))
+
+ (with-current-buffer old-buf
+ (erc-mode)
+ (insert "*** Old buf")
+ (setq erc-network 'FooNet
+ erc-server-current-nick "tester"
+ erc-server-announced-name "us-east.foonet.org"
+ erc-insert-marker (set-marker (make-marker) (point-max))
+ erc-server-process old-proc
+ erc--isupport-params (make-hash-table)
+ erc-networks--id (erc-networks--id-create nil))
+ (puthash 'CHANTYPES '("&#") erc--isupport-params))
+
+ (with-current-buffer (get-buffer-create "&chan")
+ (erc-mode)
+ (setq erc-network 'FooNet
+ erc-server-process old-proc
+ erc-server-announced-name "us-east.foonet.org"
+ erc--target (erc--target-from-string "&chan")
+ erc-networks--id (erc-networks--id-create nil)))
+
+ (ert-info ("New server buffer steals name, content")
+ (with-current-buffer (get-buffer-create "irc.foonet.org")
+ (erc-mode)
+ (setq erc-network 'FooNet
+ erc-server-current-nick "tester"
+ erc-server-announced-name "us-east.foonet.org"
+ erc-server-process (erc-networks-tests--create-live-proc)
+ erc--isupport-params (make-hash-table)
+ erc-networks--id (erc-networks--id-create nil))
+ (puthash 'CHANTYPES '("&#") erc--isupport-params)
+ (should-not (erc-networks--rename-server-buffer erc-server-process))
+ (should (string= (buffer-name) "FooNet"))
+ (goto-char (point-min))
+ (should (search-forward "Old buf"))))
+
+ (ert-info ("Channel buffer reassociated when &local server matches")
+ (should (erc-server-process-alive "&chan"))
+ (with-current-buffer "&chan"
+ (should erc-server-connected)
+ (should-not (eq erc-server-process old-proc))
+ (erc-with-server-buffer
+ (should (string= (buffer-name) "FooNet")))))
+
+ (ert-info ("Original buffer killed off")
+ (should-not (buffer-live-p old-buf)))
+
+ (erc-networks-tests--clean-bufs)))
+
+(ert-deftest erc-networks--rename-server-buffer--local-nomatch ()
+ (let* ((old-buf (get-buffer-create "FooNet"))
+ (old-proc (erc-networks-tests--create-dead-proc old-buf)))
+
+ (with-current-buffer old-buf
+ (erc-mode)
+ (insert "*** Old buf")
+ (setq erc-network 'FooNet
+ erc-server-current-nick "tester"
+ erc-server-announced-name "us-west.foonet.org"
+ erc-insert-marker (set-marker (make-marker) (point-max))
+ erc-server-process old-proc
+ erc--isupport-params (make-hash-table)
+ erc-networks--id (erc-networks--id-create nil))
+ (puthash 'CHANTYPES '("&#") erc--isupport-params))
+
+ (with-current-buffer (get-buffer-create "&chan")
+ (erc-mode)
+ (setq erc-network 'FooNet
+ erc-server-process old-proc
+ erc-server-announced-name "us-west.foonet.org" ; west
+ erc--target (erc--target-from-string "&chan")
+ erc-networks--id (erc-networks--id-create nil)))
+
+ (ert-info ("New server buffer steals name, content")
+ (with-current-buffer (get-buffer-create "irc.foonet.org")
+ (erc-mode)
+ (setq erc-network 'FooNet
+ erc-server-current-nick "tester"
+ erc-server-announced-name "us-east.foonet.org" ; east
+ erc-server-process (erc-networks-tests--create-live-proc)
+ erc--isupport-params (make-hash-table)
+ erc-networks--id (erc-networks--id-create nil))
+
+ (puthash 'CHANTYPES '("&#") erc--isupport-params)
+ (should-not (erc-networks--rename-server-buffer erc-server-process))
+ (should (string= (buffer-name) "FooNet"))
+ (goto-char (point-min))
+ (should (search-forward "Old buf"))))
+
+ (ert-info ("Channel buffer now orphaned even though network matches")
+ (should-not (erc-server-process-alive "&chan"))
+ (with-current-buffer "&chan"
+ (should-not erc-server-connected)
+ (should (eq erc-server-process old-proc))
+ (erc-with-server-buffer
+ (should (string= (buffer-name) "FooNet")))))
+
+ (ert-info ("Original buffer killed off")
+ (should-not (buffer-live-p old-buf)))
+
+ (erc-networks-tests--clean-bufs)))
+
+(ert-deftest erc-networks--update-server-identity--double-existing ()
+ (with-temp-buffer
+ (erc-mode)
+ (setq erc-networks--id (make-erc-networks--id-qualifying
+ :parts [foonet "bob"] :len 1))
+
+ (with-current-buffer (get-buffer-create "#chan@foonet/bob")
+ (erc-mode)
+ (setq erc-networks--id (make-erc-networks--id-qualifying
+ :parts [foonet "bob"] :len 2)))
+ (with-current-buffer (get-buffer-create "foonet/alice")
+ (erc-mode)
+ (setq erc-networks--id
+ (make-erc-networks--id-qualifying :parts [foonet "alice"] :len 2)))
+
+ (ert-info ("Adopt equivalent identity")
+ (should (eq (erc-networks--update-server-identity)
+ (buffer-local-value 'erc-networks--id
+ (get-buffer "#chan@foonet/bob")))))
+
+ (ert-info ("Ignore non-matches")
+ (should-not (erc-networks--update-server-identity))
+ (should (eq erc-networks--id
+ (buffer-local-value 'erc-networks--id
+ (get-buffer "#chan@foonet/bob"))))))
+
+ (erc-networks-tests--clean-bufs))
+
+(ert-deftest erc-networks--update-server-identity--double-new ()
+ (with-temp-buffer
+ (erc-mode)
+ (setq erc-networks--id (make-erc-networks--id-qualifying
+ :parts [foonet "bob"] :len 1))
+
+ (with-current-buffer (get-buffer-create "foonet/alice")
+ (erc-mode)
+ (setq erc-networks--id
+ (make-erc-networks--id-qualifying :parts [foonet "alice"] :len 2)))
+ (with-current-buffer (get-buffer-create "#chan@foonet/alice")
+ (erc-mode)
+ (setq erc-networks--id (buffer-local-value 'erc-networks--id
+ (get-buffer "foonet/alice"))))
+
+ (ert-info ("Evolve identity to prevent ambiguity")
+ (should-not (erc-networks--update-server-identity))
+ (should (= (erc-networks--id-qualifying-len erc-networks--id) 2))
+ (should (eq (erc-networks--id-symbol erc-networks--id) 'foonet/bob))))
+
+ (erc-networks-tests--clean-bufs))
+
+(ert-deftest erc-networks--update-server-identity--double-bounded ()
+ (with-temp-buffer
+ (erc-mode)
+ (setq erc-networks--id (make-erc-networks--id-qualifying
+ :parts [foonet "bob"] :len 1))
+
+ (with-current-buffer (get-buffer-create "foonet/alice/home")
+ (erc-mode)
+ (setq erc-networks--id (make-erc-networks--id-qualifying
+ :parts [foonet "alice" home] :len 3)))
+ (with-current-buffer (get-buffer-create "#chan@foonet/alice/home")
+ (erc-mode)
+ (setq erc-networks--id
+ (buffer-local-value 'erc-networks--id
+ (get-buffer "foonet/alice/home"))))
+
+ (ert-info ("Evolve identity to prevent ambiguity")
+ (should-not (erc-networks--update-server-identity))
+ (should (= (erc-networks--id-qualifying-len erc-networks--id) 2))
+ (should (eq (erc-networks--id-symbol erc-networks--id) 'foonet/bob))))
+
+ (erc-networks-tests--clean-bufs))
+
+(ert-deftest erc-networks--update-server-identity--double-even ()
+ (with-temp-buffer
+ (erc-mode)
+ (setq erc-networks--id
+ (make-erc-networks--id-qualifying :parts [foonet "bob"] :len 1))
+
+ (with-current-buffer (get-buffer-create "foonet")
+ (erc-mode)
+ (setq erc-networks--id
+ (make-erc-networks--id-qualifying :parts [foonet "alice"] :len 1)))
+ (with-current-buffer (get-buffer-create "#chan")
+ (erc-mode)
+ (setq erc--target (erc--target-from-string "#chan")
+ erc-networks--id (buffer-local-value 'erc-networks--id
+ (get-buffer "foonet"))))
+
+ (ert-info ("Evolve identity to prevent ambiguity")
+ (should-not (erc-networks--update-server-identity))
+ (should (= (erc-networks--id-qualifying-len erc-networks--id) 2))
+ (should (eq (erc-networks--id-symbol erc-networks--id) 'foonet/bob)))
+
+ (ert-info ("Collision renamed")
+ (with-current-buffer "foonet/alice"
+ (should (eq (erc-networks--id-symbol erc-networks--id) 'foonet/alice)))
+
+ (with-current-buffer "#chan@foonet/alice"
+ (should (eq (erc-networks--id-symbol erc-networks--id)
+ 'foonet/alice)))))
+
+ (erc-networks-tests--clean-bufs))
+
+(ert-deftest erc-networks--update-server-identity--triple-new ()
+ (with-temp-buffer
+ (erc-mode)
+ (setq erc-networks--id
+ (make-erc-networks--id-qualifying :parts [foonet "bob" home] :len 1))
+
+ (with-current-buffer (get-buffer-create "foonet/bob/office")
+ (erc-mode)
+ (setq erc-networks--id
+ (make-erc-networks--id-qualifying :parts [foonet "bob" office]
+ :len 3)))
+ (with-current-buffer (get-buffer-create "#chan@foonet/bob/office")
+ (erc-mode)
+ (setq erc-networks--id
+ (buffer-local-value 'erc-networks--id
+ (get-buffer "foonet/bob/office"))))
+
+ (ert-info ("Extend our identity's canonical ID so that it's unique")
+ (should-not (erc-networks--update-server-identity))
+ (should (= (erc-networks--id-qualifying-len erc-networks--id) 3))))
+
+ (erc-networks-tests--clean-bufs))
+
+;;; erc-networks-tests.el ends here
projects / emacs.git / commitdiff