diff options
Diffstat (limited to 'lisp/erc')
36 files changed, 1954 insertions, 730 deletions
diff --git a/lisp/erc/erc-autoaway.el b/lisp/erc/erc-autoaway.el index 979f93f693c..8d970bd6b96 100644 --- a/lisp/erc/erc-autoaway.el +++ b/lisp/erc/erc-autoaway.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002-2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Jorgen Schaefer <forcer@forcix.cx> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; URL: https://www.emacswiki.org/emacs/ErcAutoAway ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 9e85d285d5c..df9efe4b0c3 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -4,7 +4,7 @@ ;; Filename: erc-backend.el ;; Author: Lawrence Mitchell <wence@gmx.li> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Created: 2004-05-7 ;; Keywords: comm, IRC, chat, client, internet @@ -102,7 +102,6 @@ ;; There's a fairly strong mutual dependency between erc.el and erc-backend.el. ;; Luckily, erc.el does not need erc-backend.el for macroexpansion whereas the ;; reverse is true: -(provide 'erc-backend) (require 'erc) ;;;; Variables and options @@ -124,6 +123,14 @@ "Nickname on the current server. Use `erc-current-nick' to access this.") +(defvar-local erc-session-user-full-name nil + "Real name used for the current session. +Sent as the last argument to the USER command.") + +(defvar-local erc-session-username nil + "Username used for the current session. +Sent as the first argument of the USER command.") + ;;; Server attributes (defvar-local erc-server-process nil @@ -178,27 +185,38 @@ SILENCE=10 - supports the SILENCE command, maximum allowed number of entries TOPICLEN=160 - maximum allowed topic length WALLCHOPS - supports sending messages to all operators in a channel") +(defvar-local erc--isupport-params nil + "Hash map of \"ISUPPORT\" params. +Keys are symbols. Values are lists of zero or more strings with hex +escapes removed.") + ;;; Server and connection state (defvar erc-server-ping-timer-alist nil "Mapping of server buffers to their specific ping timer.") (defvar-local erc-server-connected nil - "Non-nil if the current buffer has been used by ERC to establish -an IRC connection. - -If you wish to determine whether an IRC connection is currently -active, use the `erc-server-process-alive' function instead.") + "Non-nil if the current buffer belongs to an active IRC connection. +To determine whether an underlying transport is connected, use the +function `erc-server-process-alive' instead.") (defvar-local erc-server-reconnect-count 0 "Number of times we have failed to reconnect to the current server.") +(defvar-local erc--server-last-reconnect-count 0 + "Snapshot of reconnect count when the connection was established.") + (defvar-local erc-server-quitting nil "Non-nil if the user requests a quit.") (defvar-local erc-server-reconnecting nil "Non-nil if the user requests an explicit reconnect, and the current IRC process is still alive.") +(make-obsolete-variable 'erc-server-reconnecting + "see `erc--server-reconnecting'" "29.1") + +(defvar-local erc--server-reconnecting nil + "Non-nil when reconnecting.") (defvar-local erc-server-timed-out nil "Non-nil if the IRC server failed to respond to a ping.") @@ -212,7 +230,7 @@ current IRC process is still alive.") (defvar-local erc-server-lines-sent nil "Line counter.") -(defvar-local erc-server-last-peers '(nil . nil) +(defvar-local erc-server-last-peers nil "Last peers used, both sender and receiver. Those are used for /MSG destination shortcuts.") @@ -310,8 +328,7 @@ This will only be consulted if the coding system in :version "24.1" :type '(repeat coding-system)) -(defcustom erc-server-coding-system (if (and (fboundp 'coding-system-p) - (coding-system-p 'undecided) +(defcustom erc-server-coding-system (if (and (coding-system-p 'undecided) (coding-system-p 'utf-8)) '(utf-8 . undecided) nil) @@ -459,7 +476,7 @@ If POS is out of range, the value is nil." (defun erc-bounds-of-word-at-point () "Return the bounds of word at point, or nil if we're not at a word. If no `subword-mode' is active, then this is -\(bounds-of-thing-at-point 'word)." +\(bounds-of-thing-at-point \\='word)." (if (or (erc-word-at-arg-p (point)) (erc-word-at-arg-p (1- (point)))) (save-excursion @@ -531,9 +548,11 @@ TLS (see `erc-session-client-certificate' for more details)." (error "Connection attempt failed")) ;; Misc server variables (with-current-buffer buffer + (setq erc-server-filter-data nil) (setq erc-server-process process) (setq erc-server-quitting nil) - (setq erc-server-reconnecting nil) + (setq erc-server-reconnecting nil + erc--server-reconnecting nil) (setq erc-server-timed-out nil) (setq erc-server-banned nil) (setq erc-server-error-occurred nil) @@ -543,7 +562,7 @@ TLS (see `erc-session-client-certificate' for more details)." (setq erc-server-last-received-time time)) (setq erc-server-lines-sent 0) ;; last peers (sender and receiver) - (setq erc-server-last-peers '(nil . nil))) + (setq erc-server-last-peers (cons nil nil))) ;; we do our own encoding and decoding (when (fboundp 'set-process-coding-system) (set-process-coding-system process 'raw-text)) @@ -579,7 +598,13 @@ Make sure you are in an ERC buffer when running this." (let ((erc-server-connect-function (or erc-session-connector #'erc-open-network-stream))) (erc-open erc-session-server erc-session-port erc-server-current-nick - erc-session-user-full-name t erc-session-password))))) + erc-session-user-full-name t erc-session-password + nil nil nil erc-session-client-certificate + erc-session-username + (erc-networks--id-given erc-networks--id)) + (unless (with-suppressed-warnings ((obsolete erc-reuse-buffers)) + erc-reuse-buffers) + (cl-assert (not (eq buffer (current-buffer))))))))) (defun erc-server-delayed-reconnect (buffer) (if (buffer-live-p buffer) @@ -616,36 +641,42 @@ Make sure you are in an ERC buffer when running this." (erc-log-irc-protocol line nil) (erc-parse-server-response process line))))))) -(define-inline erc-server-reconnect-p (event) +(defun erc--server-reconnect-p (event) + "Return non-nil when ERC should attempt to reconnect. +EVENT is the message received from the closed connection process." + (and erc-server-auto-reconnect + (not erc-server-banned) + ;; make sure we don't infinitely try to reconnect, unless the + ;; user wants that + (or (eq erc-server-reconnect-attempts t) + (and (integerp erc-server-reconnect-attempts) + (< erc-server-reconnect-count + erc-server-reconnect-attempts))) + (or erc-server-timed-out + (not (string-match "^deleted" event))) + ;; open-network-stream-nowait error for connection refused + (if (string-match "^failed with code 111" event) 'nonblocking t))) + +(defun erc-server-reconnect-p (event) "Return non-nil if ERC should attempt to reconnect automatically. EVENT is the message received from the closed connection process." - (inline-letevals (event) - (inline-quote - (or erc-server-reconnecting - (and erc-server-auto-reconnect - (not erc-server-banned) - ;; make sure we don't infinitely try to reconnect, unless the - ;; user wants that - (or (eq erc-server-reconnect-attempts t) - (and (integerp erc-server-reconnect-attempts) - (< erc-server-reconnect-count - erc-server-reconnect-attempts))) - (or erc-server-timed-out - (not (string-match "^deleted" ,event))) - ;; open-network-stream-nowait error for connection refused - (if (string-match "^failed with code 111" ,event) 'nonblocking t)))))) + (declare (obsolete "see `erc--server-reconnect-p'" "29.1")) + (or (with-suppressed-warnings ((obsolete erc-server-reconnecting)) + erc-server-reconnecting) + (erc--server-reconnect-p event))) (defun erc-process-sentinel-2 (event buffer) "Called when `erc-process-sentinel-1' has detected an unexpected disconnect." (if (not (buffer-live-p buffer)) (erc-update-mode-line) (with-current-buffer buffer - (let ((reconnect-p (erc-server-reconnect-p event)) message delay) + (let ((reconnect-p (erc--server-reconnect-p event)) message delay) (setq message (if reconnect-p 'disconnected 'disconnected-noreconnect)) (erc-display-message nil 'error (current-buffer) message) (if (not reconnect-p) ;; terminate, do not reconnect (progn + (setq erc--server-reconnecting nil) (erc-display-message nil 'error (current-buffer) 'terminated ?e event) ;; Update mode line indicators @@ -654,7 +685,8 @@ EVENT is the message received from the closed connection process." ;; reconnect (condition-case nil (progn - (setq erc-server-reconnecting nil + (setq erc-server-reconnecting nil + erc--server-reconnecting t erc-server-reconnect-count (1+ erc-server-reconnect-count)) (setq delay erc-server-reconnect-timeout) (run-at-time delay nil @@ -683,6 +715,39 @@ Conditionally try to reconnect and take appropriate action." ;; unexpected disconnect (erc-process-sentinel-2 event buffer)))) +(defun erc--unhide-prompt () + (remove-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert t) + (when (and (marker-position erc-insert-marker) + (marker-position erc-input-marker)) + (with-silent-modifications + (remove-text-properties erc-insert-marker erc-input-marker + '(display nil))))) + +(defun erc--unhide-prompt-on-self-insert () + (when (and (eq this-command #'self-insert-command) + (or (eobp) (= (point) erc-input-marker))) + (erc--unhide-prompt))) + +(defun erc--hide-prompt (proc) + (erc-with-all-buffers-of-server + proc nil ; sorta wish this was indent 2 + (when (and erc-hide-prompt + (or (eq erc-hide-prompt t) + ;; FIXME use `erc--target' after bug#48598 + (memq (if (erc-default-target) + (if (erc-channel-p (car erc-default-recipients)) + 'channel + 'query) + 'server) + erc-hide-prompt)) + (marker-position erc-insert-marker) + (marker-position erc-input-marker) + (get-text-property erc-insert-marker 'erc-prompt)) + (with-silent-modifications + (add-text-properties erc-insert-marker (1- erc-input-marker) + `(display ,erc-prompt-hidden))) + (add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 0 t)))) + (defun erc-process-sentinel (cproc event) "Sentinel function for ERC process." (let ((buf (process-buffer cproc))) @@ -705,11 +770,8 @@ Conditionally try to reconnect and take appropriate action." (dolist (buf (erc-buffer-filter (lambda () (boundp 'erc-channel-users)) cproc)) (with-current-buffer buf (setq erc-channel-users (make-hash-table :test 'equal)))) - ;; Remove the prompt - (goto-char (or (marker-position erc-input-marker) (point-max))) - (forward-line 0) - (erc-remove-text-properties-region (point) (point-max)) - (delete-region (point) (point-max)) + ;; Hide the prompt + (erc--hide-prompt cproc) ;; Decide what to do with the buffer ;; Restart if disconnected (erc-process-sentinel-1 event buf)))))) @@ -760,11 +822,12 @@ Use DISPLAY-FN to show the results." (erc-split-line text))) ;; From Circe, with modifications -(defun erc-server-send (string &optional forcep target) +(defun erc-server-send (string &optional force target) "Send STRING to the current server. -If FORCEP is non-nil, no flood protection is done - the string is -sent directly. This might cause the messages to arrive in a wrong -order. +When FORCE is non-nil, bypass flood protection so that STRING is +sent directly without modifying the queue. When FORCE is the +symbol `no-penalty', exempt this round from accumulating a +timeout penalty. If TARGET is specified, look up encoding information for that channel in `erc-encoding-coding-alist' or @@ -780,11 +843,11 @@ protection algorithm." (if (erc-server-process-alive) (erc-with-server-buffer (let ((str (concat string "\r\n"))) - (if forcep + (if force (progn - (setq erc-server-flood-last-message - (+ erc-server-flood-penalty - erc-server-flood-last-message)) + (unless (eq force 'no-penalty) + (cl-incf erc-server-flood-last-message + erc-server-flood-penalty)) (erc-log-irc-protocol str 'outbound) (condition-case nil (progn @@ -876,21 +939,20 @@ be used. If the target is \".\", the last person you've sent a message to will be used." (cond ((string-match "^\\s-*\\(\\S-+\\) ?\\(.*\\)" line) - (let ((tgt (match-string 1 line)) - (s (match-string 2 line))) + (let* ((tgt (match-string 1 line)) + (s (match-string 2 line)) + (server-buffer (erc-server-buffer)) + (peers (buffer-local-value 'erc-server-last-peers server-buffer))) (erc-log (format "cmd: MSG(%s): [%s] %s" message-command tgt s)) (cond ((string= tgt ",") - (if (car erc-server-last-peers) - (setq tgt (car erc-server-last-peers)) - (setq tgt nil))) + (setq tgt (car peers))) ((string= tgt ".") - (if (cdr erc-server-last-peers) - (setq tgt (cdr erc-server-last-peers)) - (setq tgt nil)))) + (setq tgt (cdr peers)))) (cond (tgt - (setcdr erc-server-last-peers tgt) + (with-current-buffer server-buffer + (setq erc-server-last-peers (cons (car peers) tgt))) (erc-server-send (format "%s %s :%s" message-command tgt s) force)) (t @@ -949,21 +1011,15 @@ PROCs `process-buffer' is `current-buffer' when this function is called." (save-match-data (let* ((tag-list (when (eq (aref string 0) ?@) (substring string 1 - (if (>= emacs-major-version 28) - (string-search " " string) - (string-match " " string))))) + (string-search " " string)))) (msg (make-erc-response :unparsed string :tags (when tag-list (erc-parse-tags tag-list)))) (string (if tag-list - (substring string (+ 1 (if (>= emacs-major-version 28) - (string-search " " string) - (string-match " " string)))) + (substring string (+ 1 (string-search " " string))) string)) (posn (if (eq (aref string 0) ?:) - (if (>= emacs-major-version 28) - (string-search " " string) - (string-match " " string)) + (string-search " " string) 0))) (setf (erc-response.sender msg) @@ -973,9 +1029,7 @@ PROCs `process-buffer' is `current-buffer' when this function is called." (setf (erc-response.command msg) (let* ((bposn (string-match "[^ \n]" string posn)) - (eposn (if (>= emacs-major-version 28) - (string-search " " string bposn) - (string-match " " string bposn)))) + (eposn (string-search " " string bposn))) (setq posn (and eposn (string-match "[^ \n]" string eposn))) (substring string bposn eposn))) @@ -983,9 +1037,7 @@ PROCs `process-buffer' is `current-buffer' when this function is called." (while (and posn (not (eq (aref string posn) ?:))) (push (let* ((bposn posn) - (eposn (if (>= emacs-major-version 28) - (string-search " " string bposn) - (string-match " " string bposn)))) + (eposn (string-search " " string bposn))) (setq posn (and eposn (string-match "[^ \n]" string eposn))) (substring string bposn eposn)) @@ -1169,7 +1221,8 @@ Would expand to: \(fn (NAME &rest ALIASES) &optional EXTRA-FN-DOC EXTRA-VAR-DOC &rest FN-BODY)" (declare (debug (&define [&name "erc-response-handler@" (symbolp &rest symbolp)] - &optional sexp sexp def-body))) + &optional sexp sexp def-body)) + (indent defun)) (if (numberp name) (setq name (intern (format "%03i" name)))) (setq aliases (mapcar (lambda (a) (if (numberp a) @@ -1178,7 +1231,7 @@ Would expand to: aliases)) (let* ((hook-name (intern (format "erc-server-%s-functions" name))) (fn-name (intern (format "erc-server-%s" name))) - (hook-doc (format-message "\ + (hook-doc (format "\ %sHook called upon receiving a %%s server response. Each function is called with two arguments, the process associated with the response and the parsed response. If the function returns @@ -1189,7 +1242,7 @@ See also `%s'." (concat extra-var-doc "\n\n") "") fn-name)) - (fn-doc (format-message "\ + (fn-doc (format "\ %sHandler for a %s server response. PROC is the server process which returned the response. PARSED is the actual response as an `erc-response' struct. @@ -1270,14 +1323,11 @@ add things to `%s' instead." (let* ((str (cond ;; If I have joined a channel ((erc-current-nick-p nick) - (setq buffer (erc-open erc-session-server erc-session-port - nick erc-session-user-full-name - nil nil - (list chnl) chnl - erc-server-process)) - (when buffer + (when (setq buffer (erc--open-target chnl)) (set-buffer buffer) - (erc-add-default-channel chnl) + (with-suppressed-warnings + ((obsolete erc-add-default-channel)) + (erc-add-default-channel chnl)) (erc-server-send (format "MODE %s" chnl))) (erc-with-buffer (chnl proc) (erc-channel-begin-receiving-names)) @@ -1314,7 +1364,8 @@ add things to `%s' instead." (erc-with-buffer (buffer) (erc-remove-channel-users)) - (erc-delete-default-channel ch buffer) + (with-suppressed-warnings ((obsolete erc-delete-default-channel)) + (erc-delete-default-channel ch buffer)) (erc-update-mode-line buffer)) ((string= nick (erc-current-nick)) (erc-display-message @@ -1362,19 +1413,27 @@ add things to `%s' instead." ;; sent to the correct nick. also add to bufs, since the user will want ;; to see the nick change in the query, and if it's a newly begun query, ;; erc-channel-users won't contain it - (erc-buffer-filter - (lambda () - (when (equal (erc-default-target) nick) - (setq erc-default-recipients - (cons nn (cdr erc-default-recipients))) - (rename-buffer nn t) ; bug#12002 - (erc-update-mode-line) - (cl-pushnew (current-buffer) bufs)))) + ;; + ;; Possibly still relevant: bug#12002 + (when-let ((buf (erc-get-buffer nick erc-server-process)) + (tgt (erc--target-from-string nn))) + (with-current-buffer buf + (setq erc-default-recipients (cons nn (cdr erc-default-recipients)) + erc--target tgt)) + (with-current-buffer (erc-get-buffer-create erc-session-server + erc-session-port nil tgt + (erc-networks--id-given + erc-networks--id)) + ;; Current buffer is among bufs + (erc-update-mode-line))) (erc-update-user-nick nick nn host nil nil login) (cond ((string= nick (erc-current-nick)) (cl-pushnew (erc-server-buffer) bufs) (erc-set-current-nick nn) + ;; Rename session, possibly rename server buf and all targets + (when (erc-network) + (erc-networks--id-reload erc-networks--id proc parsed)) (erc-update-mode-line) (setq erc-nick-change-attempt-count 0) (setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick))) @@ -1403,7 +1462,8 @@ add things to `%s' instead." (erc-with-buffer (buffer) (erc-remove-channel-users)) - (erc-delete-default-channel chnl buffer) + (with-suppressed-warnings ((obsolete erc-delete-default-channel)) + (erc-delete-default-channel chnl buffer)) (erc-update-mode-line buffer) (when erc-kill-buffer-on-part (kill-buffer buffer)))))) @@ -1413,7 +1473,7 @@ add things to `%s' instead." (let ((pinger (car (erc-response.command-args parsed)))) (erc-log (format "PING: %s" pinger)) ;; ping response to the server MUST be forced, or you can lose big - (erc-server-send (format "PONG :%s" pinger) t) + (erc-server-send (format "PONG :%s" pinger) 'no-penalty) (when erc-verbose-server-ping (erc-display-message parsed 'error proc @@ -1454,8 +1514,18 @@ add things to `%s' instead." fnick) (setf (erc-response.contents parsed) msg) (setq buffer (erc-get-buffer (if privp nick tgt) proc)) + ;; Even worth checking for empty target here? (invalid anyway) + (unless (or buffer noticep (string-empty-p tgt) (eq ?$ (aref tgt 0)) + (erc-is-message-ctcp-and-not-action-p msg)) + (if privp + (when erc-auto-query + (let ((erc-join-buffer erc-auto-query)) + (setq buffer (erc--open-target nick)))) + ;; A channel buffer has been killed but is still joined + (setq buffer (erc--open-target tgt)))) (when buffer (with-current-buffer buffer + (when privp (erc--unhide-prompt)) ;; update the chat partner info. Add to the list if private ;; message. We will accumulate private identities indefinitely ;; at this point. @@ -1471,7 +1541,7 @@ add things to `%s' instead." (erc-process-ctcp-reply proc parsed nick login host (match-string 1 msg))))) (t - (setcar erc-server-last-peers nick) + (setq erc-server-last-peers (cons nick (cdr erc-server-last-peers))) (setq s (erc-format-privmessage (or fnick nick) msg ;; If buffer is a query buffer, @@ -1488,13 +1558,7 @@ add things to `%s' instead." s parsed buffer nick) (run-hook-with-args-until-success 'erc-echo-notice-hook s parsed buffer nick)) - (erc-display-message parsed nil buffer s))) - (when (string= cmd "PRIVMSG") - (erc-auto-query proc parsed)))))) - -;; FIXME: need clean way of specifying extra hooks in -;; define-erc-response-handler. -(add-hook 'erc-server-PRIVMSG-functions #'erc-auto-query) + (erc-display-message parsed nil buffer s))))))) (define-erc-response-handler (QUIT) "Another user has quit IRC." nil @@ -1567,6 +1631,68 @@ Then display the welcome message." ?U (nth 3 (erc-response.command-args parsed)) ?C (nth 4 (erc-response.command-args parsed))))) +(defun erc--parse-isupport-value (value) + "Return list of unescaped components from an \"ISUPPORT\" VALUE." + ;; https://tools.ietf.org/html/draft-brocklesby-irc-isupport-03#section-2 + ;; + ;; > The server SHOULD send "X", not "X="; this is the normalized form. + ;; + ;; Note: for now, assume the server will only send non-empty values, + ;; possibly with printable ASCII escapes. Though in practice, the + ;; only two escapes we're likely to see are backslash and space, + ;; meaning the pattern is too liberal. + (let (case-fold-search) + (mapcar + (lambda (v) + (let ((start 0) + m + c) + (while (and (< start (length v)) + (string-match "[\\]x[0-9A-F][0-9A-F]" v start)) + (setq m (substring v (+ 2 (match-beginning 0)) (match-end 0)) + c (string-to-number m 16)) + (if (<= ?\ c ?~) + (setq v (concat (substring v 0 (match-beginning 0)) + (string c) + (substring v (match-end 0))) + start (- (match-end 0) 3)) + (setq start (match-end 0)))) + v)) + (if (string-search "," value) + (split-string value ",") + (list value))))) + +(defmacro erc--with-memoization (table &rest forms) + "Adapter to be migrated to erc-compat." + (declare (indent defun)) + `(cond + ((fboundp 'with-memoization) + (with-memoization ,table ,@forms)) ; 29.1 + ((fboundp 'cl--generic-with-memoization) + (cl--generic-with-memoization ,table ,@forms)) + (t ,@forms))) + +(defun erc--get-isupport-entry (key &optional single) + "Return an item for \"ISUPPORT\" token KEY, a symbol. +When a lookup fails return nil. Otherwise return a list whose +CAR is KEY and whose CDR is zero or more strings. With SINGLE, +just return the first value, if any. The latter is potentially +ambiguous and only useful for tokens supporting a single +primitive value." + (if-let* ((table (or erc--isupport-params + (erc-with-server-buffer erc--isupport-params))) + (value (erc--with-memoization (gethash key table) + (when-let ((v (assoc (symbol-name key) + erc-server-parameters))) + (if (cdr v) + (erc--parse-isupport-value (cdr v)) + '--empty--))))) + (pcase value + ('--empty-- (unless single (list key))) + (`(,head . ,_) (if single head (cons key value)))) + (when table + (remhash key table)))) + (define-erc-response-handler (005) "Set the variable `erc-server-parameters' and display the received message. @@ -1578,21 +1704,25 @@ certain commands are accepted and more. See documentation for A server may send more than one 005 message." nil - (let ((line (mapconcat #'identity - (setf (erc-response.command-args parsed) - (cdr (erc-response.command-args parsed))) - " "))) - (while (erc-response.command-args parsed) - (let ((section (pop (erc-response.command-args parsed)))) - ;; fill erc-server-parameters - (when (string-match "^\\([A-Z]+\\)=\\(.*\\)$\\|^\\([A-Z]+\\)$" + (unless erc--isupport-params + (setq erc--isupport-params (make-hash-table))) + (let* ((args (cdr (erc-response.command-args parsed))) + (line (string-join args " "))) + (while args + (let ((section (pop args)) + key + value + negated) + (when (string-match "^\\([A-Z]+\\)=\\(.*\\)$\\|^\\(-\\)?\\([A-Z]+\\)$" section) - (add-to-list 'erc-server-parameters - `(,(or (match-string 1 section) - (match-string 3 section)) - . - ,(match-string 2 section)))))) - (erc-display-message parsed 'notice proc line))) + (setq key (or (match-string 1 section) (match-string 4 section)) + value (match-string 2 section) + negated (and (match-string 3 section) '-)) + (setf (alist-get key erc-server-parameters '- 'remove #'equal) + (or value negated)) + (remhash (intern key) erc--isupport-params)))) + (erc-display-message parsed 'notice proc line) + nil)) (define-erc-response-handler (221) "Display the current user modes." nil diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 680de6d5aab..bccf0e6f1f5 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1996-2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Mario Lang <mlang@delysid.org> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Keywords: comm, irc, button, url, regexp ;; URL: https://www.emacswiki.org/emacs/ErcButton @@ -71,7 +71,7 @@ "Face used for highlighting buttons in ERC buffers. A button is a piece of text that you can activate by pressing -`RET' or `mouse-2' above it. See also `erc-button-keymap'." +\\`RET' or `mouse-2' above it. See also `erc-button-keymap'." :type 'face :group 'erc-faces) @@ -125,7 +125,7 @@ longer than `erc-fill-column'." ;; a button, it makes no sense to optimize performance by ;; bytecompiling lambdas in this alist. On the other hand, it makes ;; things hard to maintain. - '(('nicknames 0 erc-button-buttonize-nicks erc-nick-popup 0) + '((nicknames 0 erc-button-buttonize-nicks erc-nick-popup 0) (erc-button-url-regexp 0 t browse-url-button-open-url 0) ("<URL: *\\([^<> ]+\\) *>" 0 t browse-url-button-open-url 1) ;;; ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3) @@ -158,12 +158,12 @@ REGEXP is the string matching text around the button or a symbol strings, or an alist with the strings in the car. Note that entries in lists or alists are considered to be nicks or other complete words. Therefore they are enclosed in \\< and \\> - while searching. REGEXP can also be the quoted symbol - \\='nicknames, which matches the nickname of any user on the + while searching. REGEXP can also be the symbol + `nicknames', which matches the nickname of any user on the current server. BUTTON is the number of the regexp grouping actually matching the - button. This is ignored if REGEXP is \\='nicknames. + button. This is ignored if REGEXP is `nicknames'. FORM is a Lisp expression which must eval to true for the button to be added. @@ -174,17 +174,15 @@ CALLBACK is the function to call when the user push this button. PAR is a number of a regexp grouping whose text will be passed to CALLBACK. There can be several PAR arguments. If REGEXP is - \\='nicknames, these are ignored, and CALLBACK will be called with + `nicknames', these are ignored, and CALLBACK will be called with the nickname matched as the argument." - :version "24.1" ; remove finger (bug#4443) + :version "29.1" :type '(repeat (list :tag "Button" (choice :tag "Matches" regexp (variable :tag "Variable containing regexp") - ;; FIXME It really does mean 'nicknames - ;; rather than just nicknames. - (const :tag "Nicknames" 'nicknames)) + (const :tag "Nicknames" nicknames)) (integer :tag "Number of the regexp section that matches") (choice :tag "When to buttonize" (const :tag "Always" t) @@ -256,7 +254,9 @@ specified by `erc-button-alist'." regexp) (erc-button-remove-old-buttons) (dolist (entry alist) - (if (equal (car entry) (quote (quote nicknames))) + (if (or (eq (car entry) 'nicknames) + ;; Old form retained for backward compatibility. + (equal (car entry) (quote 'nicknames))) (erc-button-add-nickname-buttons entry) (progn (setq regexp (or (and (stringp (car entry)) (car entry)) diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el index 7b7773d5e13..c590b45fd21 100644 --- a/lisp/erc/erc-capab.el +++ b/lisp/erc/erc-capab.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2006-2022 Free Software Foundation, Inc. -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> -; This file is part of GNU Emacs. +;; 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 @@ -137,7 +137,7 @@ These arguments are sent to this function when called as a hook in ;; could possibly check for '("IRCD" . "dancer") in ;; `erc-server-parameters' instead of looking for a specific name ;; in `erc-server-version' - (assoc "CAPAB" erc-server-parameters)) + (erc--get-isupport-entry 'CAPAB)) (erc-log "Sending CAPAB IDENTIFY-MSG and IDENTIFY-CTCP") (erc-server-send "CAPAB IDENTIFY-MSG") (erc-server-send "CAPAB IDENTIFY-CTCP") diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 0541d1604cb..8a00e711acd 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002-2003, 2005-2022 Free Software Foundation, Inc. ;; Author: Alex Schroeder <alex@gnu.org> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; URL: https://www.emacswiki.org/emacs/ERC ;; This file is part of GNU Emacs. @@ -25,9 +25,13 @@ ;; This mostly defines stuff that cannot be worked around easily. +;; ERC depends on the `compat' library from GNU ELPA for supporting +;; older versions of Emacs. See this discussion for additional info: +;; https://lists.gnu.org/archive/html/emacs-devel/2022-07/msg00512.html + ;;; Code: -(require 'format-spec) +(require 'compat nil 'noerror) ;;;###autoload(autoload 'erc-define-minor-mode "erc-compat") (define-obsolete-function-alias 'erc-define-minor-mode diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 399e5fb114c..977080a4de1 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -1,12 +1,11 @@ ;;; erc-dcc.el --- CTCP DCC module for ERC -*- lexical-binding: t; -*- -;; Copyright (C) 1993-1995, 1998, 2002-2004, 2006-2022 Free Software -;; Foundation, Inc. +;; Copyright (C) 1993-2022 Free Software Foundation, Inc. ;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu> ;; Noah Friedman <friedman@prep.ai.mit.edu> ;; Per Persson <pp@sno.pp.se> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Keywords: comm ;; Created: 1994-01-23 @@ -44,7 +43,7 @@ ;; /dcc chat nick - Either accept pending chat offer from nick, or offer ;; DCC chat to nick ;; /dcc close type [nick] - Close DCC connection (SEND/GET/CHAT) with nick -;; /dcc get nick [file] - Accept DCC offer from nick +;; /dcc get [-t][-s] nick [file] - Accept DCC offer from nick ;; /dcc list - List all DCC offers/connections ;; /dcc send nick file - Offer DCC SEND to nick @@ -106,7 +105,11 @@ Looks like: :file - for outgoing sends, the full path to the file. For incoming sends, the suggested filename or vetted filename - :size - size of the file, may be nil on incoming DCCs") + :size - size of the file, may be nil on incoming DCCs + + :secure - optional item indicating sender support for TLS + + :turbo - optional item indicating sender support for TSEND") (defun erc-dcc-list-add (type nick peer parent &rest args) "Add a new entry of type TYPE to `erc-dcc-list' and return it." @@ -120,12 +123,13 @@ Looks like: ;; more: the entry data from erc-dcc-list for this particular process. (defvar erc-dcc-connect-function 'erc-dcc-open-network-stream) -(defun erc-dcc-open-network-stream (procname buffer addr port _entry) +(defun erc-dcc-open-network-stream (procname buffer addr port entry) ;; FIXME: Time to try activating this again!? (if nil; (fboundp 'open-network-stream-nowait) ;; this currently crashes ;; cvs emacs (open-network-stream-nowait procname buffer addr port) - (open-network-stream procname buffer addr port))) + (open-network-stream procname buffer addr port + :type (and (plist-get entry :secure) 'tls)))) (erc-define-catalog 'english @@ -145,13 +149,14 @@ Looks like: (dcc-get-bytes-received . "DCC: %f: %b bytes received") (dcc-get-complete . "DCC: file %f transfer complete (%s bytes in %t seconds)") + (dcc-get-failed . "DCC: file %f transfer failed at %s of %v in %t seconds") (dcc-get-cmd-aborted . "DCC: Aborted getting %f from %n") (dcc-get-file-too-long . "DCC: %f: File longer than sender claimed; aborting transfer") (dcc-get-notfound . "DCC: %n hasn't offered %f for DCC transfer") - (dcc-list-head . "DCC: From Type Active Size Filename") - (dcc-list-line . "DCC: -------- ---- ------ -------------- --------") - (dcc-list-item . "DCC: %-8n %-4t %-6a %-14s %f") + (dcc-list-head . "DCC: From Type Active Size Filename") + (dcc-list-line . "DCC: -------- ---- ------ ----------------- --------") + (dcc-list-item . "DCC: %-8n %-4t %-6a %-17s %f%u") (dcc-list-end . "DCC: End of list.") (dcc-malformed . "DCC: error: %n (%u@%h) sent malformed request: %q") (dcc-privileged-port @@ -183,14 +188,10 @@ compared with `erc-nick-equal-p' which is IRC case-insensitive." (let ((prop (car prem)) (val (cadr prem))) (setq prem (cddr prem) - ;; plist-member is a predicate in xemacs - test (and (plist-member elt prop) - (plist-get elt prop))) + test (cadr (plist-member elt prop))) ;; if the property exists and is equal, we continue, else, try the ;; next element of the list - (or (and (eq prop :nick) (if (>= emacs-major-version 28) - (string-search "!" val) - (string-match "!" val)) + (or (and (eq prop :nick) (string-search "!" val) test (string-equal test val)) (and (eq prop :nick) test val @@ -198,7 +199,7 @@ compared with `erc-nick-equal-p' which is IRC case-insensitive." (erc-extract-nick test) (erc-extract-nick val))) ;; not a nick - (eq test val) + (equal test val) (setq cont nil)))) (if cont (setq result elt) @@ -388,7 +389,7 @@ the accepted connection." (defcustom erc-dcc-get-default-directory nil "Default directory for incoming DCC file transfers. If this is nil, then the current value of `default-directory' is used." - :type '(choice (const nil :tag "Default directory") directory)) + :type '(choice (const :value nil :tag "Default directory") directory)) ;;;###autoload (defun erc-cmd-DCC (cmd &rest args) @@ -508,8 +509,12 @@ At least one of TYPE and NICK must be provided." FILE is the filename. If FILE is split into multiple arguments, re-join the arguments, separated by a space. PROC is the server process." - (setq file (and file (mapconcat #'identity file " "))) - (let* ((elt (erc-dcc-member :nick nick :type 'GET)) + (let* ((args (seq-group-by (lambda (s) (eq ?- (aref s 0))) (cons nick file))) + (flags (prog1 (cdr (assq t args)) + (setq args (cdr (assq nil args)) + nick (pop args) + file (and args (mapconcat #'identity args " "))))) + (elt (erc-dcc-member :nick nick :type 'GET :file file)) (filename (or file (plist-get elt :file) "unknown"))) (if elt (let* ((file (read-file-name @@ -529,7 +534,13 @@ PROC is the server process." 'dcc-get-cmd-aborted ?n nick ?f filename))) (t - (erc-dcc-get-file elt file proc)))) + (erc-dcc-get-file elt file proc))) + (when (member "-s" flags) + (setq erc-dcc-list (cons (plist-put elt :secure t) + (delq elt erc-dcc-list)))) + (when (member "-t" flags) + (setq erc-dcc-list (cons (plist-put elt :turbo t) + (delq elt erc-dcc-list))))) (erc-display-message nil '(notice error) 'active 'dcc-get-notfound ?n nick ?f filename)))) @@ -567,6 +578,7 @@ It lists the current state of `erc-dcc-list' in an easy to read manner." (process-status (plist-get elt :peer)) "no") ?s (concat size + ;; FIXME consider uniquified names, e.g., foo.bin<2> (if (and (eq 'GET (plist-get elt :type)) (plist-member elt :file) (buffer-live-p (get-buffer (plist-get elt :file))) @@ -578,7 +590,12 @@ It lists the current state of `erc-dcc-list' in an easy to read manner." (format " (%d%%)" (floor (* 100.0 byte-count) (plist-get elt :size)))))) - ?f (or (and (plist-member elt :file) (plist-get elt :file)) ""))) + ?f (or (and (plist-member elt :file) (plist-get elt :file)) "") + ?u (if-let* ((flags (concat (and (plist-get elt :turbo) "t") + (and (plist-get elt :secure) "s"))) + ((not (string-empty-p flags)))) + (concat " (" flags ")") + ""))) (erc-display-message nil 'notice 'active 'dcc-list-end) @@ -605,6 +622,10 @@ separated by a space." (defvar erc-dcc-query-handler-alist '(("SEND" . erc-dcc-handle-ctcp-send) + ("TSEND" . erc-dcc-handle-ctcp-send) + ("SSEND" . erc-dcc-handle-ctcp-send) + ("TSSEND" . erc-dcc-handle-ctcp-send) + ("STSEND" . erc-dcc-handle-ctcp-send) ("CHAT" . erc-dcc-handle-ctcp-chat))) ;;;###autoload @@ -623,22 +644,20 @@ that subcommand." ?q query ?n nick ?u login ?h host)))) (defconst erc-dcc-ctcp-query-send-regexp - (concat "^DCC SEND \\(?:" + (rx bot "DCC " (group-n 6 (: (** 0 2 (any "TS")) "SEND")) " " ;; Following part matches either filename without spaces ;; or filename enclosed in double quotes with any number ;; of escaped double quotes inside. - "\"\\(\\(?:\\\\\"\\|[^\"\\]\\)+\\)\"\\|\\([^ ]+\\)" - "\\) \\([0-9]+\\) \\([0-9]+\\) *\\([0-9]*\\)")) + (: (or (: ?\" (group-n 1 (+ (or (: ?\\ ?\") (not (any ?\" ?\\))))) ?\") + (group-n 2 (+ (not " "))))) + (: " " (group-n 3 (+ digit)) + " " (group-n 4 (+ digit)) + (* " ") (group-n 5 (* digit))) + eot)) (define-inline erc-dcc-unquote-filename (filename) (inline-quote - (if (>= emacs-major-version 28) - (string-replace - "\\\\" "\\" - (string-replace "\\\"" "\"" ,filename)) - (replace-regexp-in-string - "\\\\\\\\" "\\" - (replace-regexp-in-string "\\\\\"" "\"" ,filename t t) t t)))) + (string-replace "\\\\" "\\" (string-replace "\\\"" "\"" ,filename)))) (defun erc-dcc-handle-ctcp-send (proc query nick login host to) "This is called if a CTCP DCC SEND subcommand is sent to the client. @@ -653,12 +672,14 @@ It extracts the information about the dcc request and adds it to 'dcc-request-bogus ?r "SEND" ?n nick ?u login ?h host)) ((string-match erc-dcc-ctcp-query-send-regexp query) - (let ((filename - (or (match-string 2 query) - (erc-dcc-unquote-filename (match-string 1 query)))) - (ip (erc-decimal-to-ip (match-string 3 query))) - (port (match-string 4 query)) - (size (match-string 5 query))) + (let* ((filename (or (match-string 2 query) + (erc-dcc-unquote-filename (match-string 1 query)))) + (ip (erc-decimal-to-ip (match-string 3 query))) + (port (match-string 4 query)) + (size (match-string 5 query)) + (sub (substring (match-string 6 query) 0 -4)) + (secure (seq-contains-p sub ?S #'eq)) + (turbo (seq-contains-p sub ?T #'eq))) ;; FIXME: a warning really should also be sent ;; if the ip address != the host the dcc sender is on. (erc-display-message @@ -675,7 +696,9 @@ It extracts the information about the dcc request and adds it to 'GET (format "%s!%s@%s" nick login host) nil proc :ip ip :port port :file filename - :size (string-to-number size)) + :size (string-to-number size) + :turbo (and turbo t) + :secure (and secure t)) (if (and (eq erc-dcc-send-request 'auto) (erc-dcc-auto-mask-p (format "\"%s!%s@%s\"" nick login host))) (erc-dcc-get-file (car erc-dcc-list) filename proc)))) @@ -771,7 +794,7 @@ the matching regexp, or nil if none found." PROC is the process-object of the DCC connection. Returns the number of bytes sent." (let* ((elt (erc-dcc-member :peer proc)) - (confirmed-marker (plist-get elt :sent)) + (confirmed-marker (plist-get elt :confirmed)) (sent-marker (plist-get elt :sent))) (with-current-buffer (process-buffer proc) (when erc-dcc-verbose @@ -923,8 +946,7 @@ and making the connection." (inhibit-file-name-operation 'write-region)) (write-region (point) (point) erc-dcc-file-name nil 'nomessage)) - (setq erc-server-process parent-proc - erc-dcc-entry-data entry) + (setq erc-server-process parent-proc) (setq erc-dcc-byte-count 0) (setq proc (funcall erc-dcc-connect-function @@ -938,8 +960,8 @@ and making the connection." (set-process-filter proc #'erc-dcc-get-filter) (set-process-sentinel proc #'erc-dcc-get-sentinel) - (setq entry (plist-put entry :start-time (erc-current-time))) - (setq entry (plist-put entry :peer proc))))) + (setq erc-dcc-entry-data (plist-put (plist-put entry :peer proc) + :start-time (erc-current-time)))))) (defun erc-dcc-append-contents (buffer _file) "Append the contents of BUFFER to FILE. @@ -955,6 +977,16 @@ The contents of the BUFFER will then be erased." (setq erc-dcc-byte-count (+ (buffer-size) erc-dcc-byte-count)) (erase-buffer)))) +;; If people really need this, we can convert it into a proper option. + +(defvar erc-dcc--send-final-turbo-ack nil + "Workaround for maverick turbo senders that only require a final ACK. +The only known culprit is WeeChat, with its xfer.network.fast_send +option, which is on by default. Leaving this set to nil and calling +/DCC GET -t works just fine, but WeeChat sees it as a failure even +though the file arrives in its entirety. Setting this to t may +alleviate such problems.") + (defun erc-dcc-get-filter (proc str) "This is the process filter for transfers from other clients to this one. It reads incoming bytes from the network and stores them in the DCC @@ -989,31 +1021,43 @@ rather than every 1024 byte block, but nobody seems to care." 'dcc-get-file-too-long ?f (file-name-nondirectory (buffer-name))) (delete-process proc)) - (t - (process-send-string - proc (erc-pack-int received-bytes))))))) - + ;; Some senders want us to hang up. Only observed w. TSEND. + ((and (plist-get erc-dcc-entry-data :turbo) + (= received-bytes (plist-get erc-dcc-entry-data :size))) + (when erc-dcc--send-final-turbo-ack + (process-send-string proc (erc-pack-int received-bytes))) + (delete-process proc)) + ((not (or (plist-get erc-dcc-entry-data :turbo) + (process-get proc :reportingp))) + (process-put proc :reportingp t) + (process-send-string proc (erc-pack-int received-bytes)) + (process-put proc :reportingp nil)))))) -(defun erc-dcc-get-sentinel (proc _event) +(defun erc-dcc-get-sentinel (proc event) "This is the process sentinel for CTCP DCC SEND connections. It shuts down the connection and notifies the user that the transfer is complete." ;; FIXME, we should look at EVENT, and also check size. + (unless (member event '("connection broken by remote peer\n" + "deleted\n")) + (lwarn 'erc :warning "Unexpected sentinel event %S for %s" + (string-trim-right event) proc)) (with-current-buffer (process-buffer proc) (delete-process proc) (setq erc-dcc-list (delete erc-dcc-entry-data erc-dcc-list)) (unless (= (point-min) (point-max)) (erc-dcc-append-contents (current-buffer) erc-dcc-file-name)) - (erc-display-message - nil 'notice erc-server-process - 'dcc-get-complete - ?f erc-dcc-file-name - ?s (number-to-string erc-dcc-byte-count) - ?t (format "%.0f" - (erc-time-diff (plist-get erc-dcc-entry-data :start-time) - nil)))) - (kill-buffer (process-buffer proc)) - (delete-process proc)) + (let ((done (= erc-dcc-byte-count (plist-get erc-dcc-entry-data :size)))) + (erc-display-message + nil (if done 'notice '(notice error)) erc-server-process + (if done 'dcc-get-complete 'dcc-get-failed) + ?v (plist-get erc-dcc-entry-data :size) + ?f erc-dcc-file-name + ?s (number-to-string erc-dcc-byte-count) + ?t (format "%.0f" + (erc-time-diff (plist-get erc-dcc-entry-data :start-time) + nil)))) + (kill-buffer))) ;;; CHAT handling @@ -1130,18 +1174,18 @@ other client." (proc (plist-get entry :peer)) (parent-proc (plist-get entry :parent))) (erc-setup-buffer buffer) - ;; buffer is now the current buffer. - (erc-dcc-chat-mode) - (setq erc-server-process parent-proc) - (setq erc-dcc-from nick) - (setq erc-dcc-entry-data entry) - (setq erc-dcc-unprocessed-output "") - (setq erc-insert-marker (point-max-marker)) - (setq erc-input-marker (make-marker)) - (erc-display-prompt buffer (point-max)) - (set-process-buffer proc buffer) - (add-hook 'kill-buffer-hook #'erc-dcc-chat-buffer-killed nil t) - (run-hook-with-args 'erc-dcc-chat-connect-hook proc) + (with-current-buffer buffer + (erc-dcc-chat-mode) + (setq erc-server-process parent-proc + erc-dcc-from nick + erc-dcc-entry-data entry + erc-dcc-unprocessed-output "" + erc-insert-marker (point-max-marker) + erc-input-marker (make-marker)) + (erc-display-prompt buffer (point-max)) + (set-process-buffer proc buffer) + (add-hook 'kill-buffer-hook #'erc-dcc-chat-buffer-killed nil t) + (run-hook-with-args 'erc-dcc-chat-connect-hook proc)) buffer)) (defun erc-dcc-chat-accept (entry parent-proc) diff --git a/lisp/erc/erc-desktop-notifications.el b/lisp/erc/erc-desktop-notifications.el index 8ece765ef0d..1897f53dc16 100644 --- a/lisp/erc/erc-desktop-notifications.el +++ b/lisp/erc/erc-desktop-notifications.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2012-2022 Free Software Foundation, Inc. ;; Author: Julien Danjou <julien@danjou.info> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Keywords: comm ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-ezbounce.el b/lisp/erc/erc-ezbounce.el index 8f46a1c8dd1..958783f2394 100644 --- a/lisp/erc/erc-ezbounce.el +++ b/lisp/erc/erc-ezbounce.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002, 2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Andreas Fuchs <asf@void.at> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Keywords: comm ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 492830c3e13..140e7fdfc61 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -4,7 +4,7 @@ ;; Author: Andreas Fuchs <asf@void.at> ;; Mario Lang <mlang@delysid.org> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; URL: https://www.emacswiki.org/emacs/ErcFilling ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 677f077c2ee..8fef23945d4 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2001-2022 Free Software Foundation, Inc. ;; Author: Jorgen Schaefer <forcer@forcix.cx> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Most code is taken verbatim from erc.el, see there for the original ;; authors. @@ -137,7 +137,7 @@ Put this function on `erc-insert-post-hook' and/or `erc-send-post-hook'." (goto-char (point-max)))) (defun erc-move-to-prompt-setup () - "Initialize the move-to-prompt module for XEmacs." + "Initialize the move-to-prompt module." (add-hook 'pre-command-hook #'erc-move-to-prompt nil t)) ;;; Keep place in unvisited channels diff --git a/lisp/erc/erc-ibuffer.el b/lisp/erc/erc-ibuffer.el index f1184ff5eb2..417c0b898a7 100644 --- a/lisp/erc/erc-ibuffer.el +++ b/lisp/erc/erc-ibuffer.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002, 2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Mario Lang <mlang@delysid.org> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Keywords: comm ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-identd.el b/lisp/erc/erc-identd.el index eab219f4c1e..5c0a2c1a481 100644 --- a/lisp/erc/erc-identd.el +++ b/lisp/erc/erc-identd.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2003, 2006-2022 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw@gnu.org> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Keywords: comm ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-imenu.el b/lisp/erc/erc-imenu.el index f9713032e92..64a8f82b2a9 100644 --- a/lisp/erc/erc-imenu.el +++ b/lisp/erc/erc-imenu.el @@ -1,10 +1,9 @@ ;;; erc-imenu.el --- Imenu support for ERC -*- lexical-binding: t; -*- -;; Copyright (C) 2001-2002, 2004, 2006-2022 Free Software Foundation, -;; Inc. +;; Copyright (C) 2001-2022 Free Software Foundation, Inc. ;; Author: Mario Lang <mlang@delysid.org> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Keywords: comm ;; URL: https://www.emacswiki.org/emacs/ErcImenu diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el index 175e83f3c90..b4044548e84 100644 --- a/lisp/erc/erc-join.el +++ b/lisp/erc/erc-join.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002-2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Alex Schroeder <alex@gnu.org> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Keywords: comm, irc ;; URL: https://www.emacswiki.org/emacs/ErcAutoJoin @@ -33,8 +33,6 @@ ;;; Code: (require 'erc) -(require 'auth-source) -(require 'erc-networks) (defgroup erc-autojoin nil "Enable autojoining." @@ -57,11 +55,16 @@ Every element in the alist has the form (SERVER . CHANNELS). SERVER is a regexp matching the server, and channels is the list of channels to join. SERVER can also be a symbol, in which case -it is matched against the value of `erc-network' instead of +it's matched against a non-nil `:id' passed to `erc' or `erc-tls' +when connecting or the value of the current `erc-network' instead of `erc-server-announced-name' or `erc-session-server' (this can be useful when connecting to an IRC proxy that relays several networks under the same server). +Note that for historical reasons, this option is mutated at runtime, +which is regrettable but here to stay. Please double check the value +before saving it to a `custom-file'. + If the channel(s) require channel keys for joining, the passwords are found via auth-source. For instance, if you use ~/.authinfo as your auth-source backend, then put something like the @@ -123,33 +126,32 @@ This is called from a timer set up by `erc-autojoin-channels'." (erc-autojoin-channels server nick)))) (defun erc-autojoin-server-match (candidate) - "Match the current network or server against CANDIDATE. -This should be a key from `erc-autojoin-channels-alist'." - (or (eq candidate (erc-network)) - (and (stringp candidate) - (string-match-p candidate - (or erc-server-announced-name - erc-session-server))))) + "Match the current network ID or server against CANDIDATE. +CANDIDATE is a key from `erc-autojoin-channels-alist'. Return the +matching entity, either a string or a non-nil symbol (in the case of a +network or a network ID). Return nil on failure." + (if (symbolp candidate) + (eq (or (erc-networks--id-given erc-networks--id) (erc-network)) + candidate) + (when (stringp candidate) + (string-match-p candidate (or erc-server-announced-name + erc-session-server))))) + +(defun erc-autojoin--join () + ;; This is called in the server buffer + (pcase-dolist (`(,name . ,channels) erc-autojoin-channels-alist) + (when-let ((match (erc-autojoin-server-match name))) + (dolist (chan channels) + (let ((buf (erc-get-buffer chan erc-server-process))) + (unless (and buf (with-current-buffer buf + (erc--current-buffer-joined-p))) + (erc-server-join-channel nil chan))))))) (defun erc-autojoin-after-ident (_network _nick) "Autojoin channels in `erc-autojoin-channels-alist'. This function is run from `erc-nickserv-identified-hook'." - (if erc--autojoin-timer - (setq erc--autojoin-timer - (cancel-timer erc--autojoin-timer))) (when (eq erc-autojoin-timing 'ident) - (let ((server (or erc-session-server erc-server-announced-name)) - (joined (mapcar (lambda (buf) - (with-current-buffer buf (erc-default-target))) - (erc-channel-list erc-server-process)))) - ;; We may already be in these channels, e.g. because the - ;; autojoin timer went off. - (dolist (l erc-autojoin-channels-alist) - (when (erc-autojoin-server-match (car l)) - (dolist (chan (cdr l)) - (unless (erc-member-ignore-case chan joined) - (erc-server-join-channel server chan))))))) - nil) + (erc-autojoin--join))) (defun erc-autojoin-channels (server nick) "Autojoin channels in `erc-autojoin-channels-alist'." @@ -162,24 +164,7 @@ This function is run from `erc-nickserv-identified-hook'." #'erc-autojoin-channels-delayed server nick (current-buffer)))) ;; `erc-autojoin-timing' is `connect': - (let ((server (or erc-session-server erc-server-announced-name))) - (dolist (l erc-autojoin-channels-alist) - (when (erc-autojoin-server-match (car l)) - (dolist (chan (cdr l)) - (let ((buffer - (car (erc-buffer-filter - (lambda () - (let ((current (erc-default-target))) - (and (stringp current) - (erc-autojoin-server-match (car l)) - (string-equal (erc-downcase chan) - (erc-downcase current))))))))) - (when (or (not buffer) - (not (with-current-buffer buffer - (erc-server-process-alive)))) - (erc-server-join-channel server chan)))))))) - ;; Return nil to avoid stomping on any other hook funcs. - nil) + (erc-autojoin--join))) (defun erc-autojoin-current-server () "Compute the current server for lookup in `erc-autojoin-channels-alist'. @@ -190,24 +175,29 @@ Respects `erc-autojoin-domain-only'." (match-string 1 server) server))) +(defun erc-autojoin--mutate (proc parsed remove) + (when-let* ((nick (car (erc-parse-user (erc-response.sender parsed)))) + ((erc-current-nick-p nick)) + (chnl (car (erc-response.command-args parsed))) + (elem (or (and (erc--valid-local-channel-p chnl) + (regexp-quote erc-server-announced-name)) + (erc-networks--id-given erc-networks--id) + (erc-network) + (with-current-buffer (process-buffer proc) + (erc-autojoin-current-server)))) + (test (if (symbolp elem) #'eq #'equal))) + (if remove + (let ((cs (delete chnl (assoc-default elem erc-autojoin-channels-alist + test)))) + (setf (alist-get elem erc-autojoin-channels-alist nil (null cs) test) + cs)) + (cl-pushnew chnl + (alist-get elem erc-autojoin-channels-alist nil nil test) + :test #'equal)))) + (defun erc-autojoin-add (proc parsed) "Add the channel being joined to `erc-autojoin-channels-alist'." - (let* ((chnl (erc-response.contents parsed)) - (nick (car (erc-parse-user (erc-response.sender parsed)))) - (server (with-current-buffer (process-buffer proc) - (erc-autojoin-current-server)))) - (when (erc-current-nick-p nick) - (let ((elem (or (assoc (erc-network) erc-autojoin-channels-alist) - (assoc server erc-autojoin-channels-alist)))) - (if elem - (unless (member chnl (cdr elem)) - (setcdr elem (cons chnl (cdr elem)))) - ;; This always keys on server, not network -- user can - ;; override by simply adding a network to - ;; `erc-autojoin-channels-alist' - (setq erc-autojoin-channels-alist - (cons (list server chnl) - erc-autojoin-channels-alist)))))) + (erc-autojoin--mutate proc parsed nil) ;; We must return nil to tell ERC to continue running the other ;; functions. nil) @@ -216,18 +206,7 @@ Respects `erc-autojoin-domain-only'." (defun erc-autojoin-remove (proc parsed) "Remove the channel being left from `erc-autojoin-channels-alist'." - (let* ((chnl (car (erc-response.command-args parsed))) - (nick (car (erc-parse-user (erc-response.sender parsed)))) - (server (with-current-buffer (process-buffer proc) - (erc-autojoin-current-server)))) - (when (erc-current-nick-p nick) - (let ((elem (or (assoc (erc-network) erc-autojoin-channels-alist) - (assoc server erc-autojoin-channels-alist)))) - (when elem - (setcdr elem (delete chnl (cdr elem))) - (unless (cdr elem) - (setq erc-autojoin-channels-alist - (delete elem erc-autojoin-channels-alist))))))) + (erc-autojoin--mutate proc parsed 'remove) ;; We must return nil to tell ERC to continue running the other ;; functions. nil) diff --git a/lisp/erc/erc-lang.el b/lisp/erc/erc-lang.el index 354203aa090..d059caf5a32 100644 --- a/lisp/erc/erc-lang.el +++ b/lisp/erc/erc-lang.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002, 2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Alex Schroeder <alex@gnu.org> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Old-Version: 1.0.0 ;; URL: https://www.emacswiki.org/emacs/ErcLang ;; Keywords: comm @@ -32,10 +32,8 @@ (require 'erc) -;; FIXME: It's ISO 639-1, not ISO 638. ISO 638 is for paper, board and pulps. -;; The Lisp variable should be renamed. - -(defvar iso-638-languages +(define-obsolete-variable-alias 'iso-638-languages 'iso-639-1-languages "29.1") +(defvar iso-639-1-languages '(("aa" . "Afar") ("ab" . "Abkhazian") ("af" . "Afrikaans") @@ -197,12 +195,12 @@ Normungsinstitut (ON), Postfach 130, A-1021 Vienna, Austria.") (defun language (code) "Return the language name for the ISO CODE." (interactive (list (completing-read "ISO language code: " - iso-638-languages))) - (message "%s" (cdr (assoc code iso-638-languages)))) + iso-639-1-languages))) + (message "%s" (cdr (assoc code iso-639-1-languages)))) (defun erc-cmd-LANG (language) "Display the language name for the language code given by LANGUAGE." - (let ((lang (cdr (assoc language iso-638-languages)))) + (let ((lang (cdr (assoc language iso-639-1-languages)))) (erc-display-message nil 'notice 'active (or lang (concat language ": No such domain")))) diff --git a/lisp/erc/erc-list.el b/lisp/erc/erc-list.el index c7cd0ceba83..5266b680c38 100644 --- a/lisp/erc/erc-list.el +++ b/lisp/erc/erc-list.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2008-2022 Free Software Foundation, Inc. ;; Author: Tom Tromey <tromey@redhat.com> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Old-Version: 0.1 ;; URL: https://www.emacswiki.org/emacs/ErcList ;; Keywords: comm diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index 056701d6200..57093d3fc6c 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2003-2022 Free Software Foundation, Inc. ;; Author: Lawrence Mitchell <wence@gmx.li> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; URL: https://www.emacswiki.org/emacs/ErcLogging ;; Keywords: comm, IRC, chat, client, Internet, logging diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index aa78590539b..7c9174ff66a 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002-2022 Free Software Foundation, Inc. ;; Author: Andreas Fuchs <asf@void.at> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Keywords: comm ;; URL: https://www.emacswiki.org/emacs/ErcMatch diff --git a/lisp/erc/erc-menu.el b/lisp/erc/erc-menu.el index fd14d8b0ad8..455a7c3cd2f 100644 --- a/lisp/erc/erc-menu.el +++ b/lisp/erc/erc-menu.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2001-2002, 2004-2022 Free Software Foundation, Inc. ;; Author: Mario Lang <mlang@delysid.org> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Keywords: comm, menu ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-netsplit.el b/lisp/erc/erc-netsplit.el index 30bb18344d7..17ed881b12b 100644 --- a/lisp/erc/erc-netsplit.el +++ b/lisp/erc/erc-netsplit.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002-2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Mario Lang <mlang@delysid.org> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Keywords: comm ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 9377e701c39..091b8aa92d7 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002, 2004-2022 Free Software Foundation, Inc. ;; Author: Mario Lang <mlang@lexx.delysid.org> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Keywords: comm ;; This file is part of GNU Emacs. @@ -731,6 +731,466 @@ MATCHER is used to find a corresponding network to a server while (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 @@ -739,6 +1199,7 @@ MATCHER is used to find a corresponding network to a server while 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) @@ -753,7 +1214,7 @@ server name and search for a match in `erc-networks-alist'." (defun erc-network () "Return the value of `erc-network' for the current server." - (erc-with-server-buffer erc-network)) + (or erc-network (erc-with-server-buffer erc-network))) (defun erc-network-name () "Return the name of the current network as a string." @@ -761,23 +1222,242 @@ server name and search for a match in `erc-networks-alist'." (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. diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el index a3fe04d392c..911a574b17e 100644 --- a/lisp/erc/erc-notify.el +++ b/lisp/erc/erc-notify.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002-2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Mario Lang <mlang@lexx.delysid.org> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; URL: https://www.emacswiki.org/emacs/ErcNotify ;; Keywords: comm diff --git a/lisp/erc/erc-page.el b/lisp/erc/erc-page.el index e53178ce63a..087e5a67d07 100644 --- a/lisp/erc/erc-page.el +++ b/lisp/erc/erc-page.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2002, 2004, 2006-2022 Free Software Foundation, Inc. -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el index 384be500ad7..af8528dbc38 100644 --- a/lisp/erc/erc-pcomplete.el +++ b/lisp/erc/erc-pcomplete.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002-2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Sacha Chua <sacha@free.net.ph> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Keywords: comm ;; URL: https://www.emacswiki.org/emacs/ErcCompletion diff --git a/lisp/erc/erc-replace.el b/lisp/erc/erc-replace.el index 03153c69988..e46862d6a64 100644 --- a/lisp/erc/erc-replace.el +++ b/lisp/erc/erc-replace.el @@ -1,10 +1,9 @@ ;;; erc-replace.el --- wash and massage messages inserted into the buffer -*- lexical-binding: t; -*- -;; Copyright (C) 2001-2002, 2004, 2006-2022 Free Software Foundation, -;; Inc. +;; Copyright (C) 2001-2022 Free Software Foundation, Inc. ;; Author: Andreas Fuchs <asf@void.at> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; URL: https://www.emacswiki.org/emacs/ErcReplace ;; Keywords: comm, IRC, client, Internet diff --git a/lisp/erc/erc-ring.el b/lisp/erc/erc-ring.el index 0f6851a98a3..9dd1fab6403 100644 --- a/lisp/erc/erc-ring.el +++ b/lisp/erc/erc-ring.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2001-2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Alex Schroeder <alex@gnu.org> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Keywords: comm ;; URL: https://www.emacswiki.org/emacs/ErcHistory diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el index dcd786411f2..fe9cb5b5f17 100644 --- a/lisp/erc/erc-services.el +++ b/lisp/erc/erc-services.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2002-2004, 2006-2022 Free Software Foundation, Inc. -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; URL: https://www.emacswiki.org/emacs/ErcNickserv ;; This file is part of GNU Emacs. @@ -174,6 +174,18 @@ function `erc-nickserv-get-password'." :version "28.1" :type 'boolean) +(defcustom erc-auth-source-services-function #'erc-auth-source-search + "Function to retrieve NickServ password from auth-source. +Called with a subset of keyword parameters known to +`auth-source-search' and relevant to authenticating to nickname +services. In return, ERC expects a string to send as the +password, or nil, to fall through to the next method, such as +prompting. See info node `(erc) Connecting' for details." + :package-version '(ERC . "5.4.1") ; FIXME update when publishing to ELPA + :type '(choice (const erc-auth-source-search) + (const nil) + function)) + (defcustom erc-nickserv-passwords nil "Passwords used when identifying to NickServ automatically. `erc-prompt-for-nickserv-password' must be nil for these @@ -202,7 +214,7 @@ Example of use: (const QuakeNet) (const Rizon) (const SlashNET) - (symbol :tag "Network name")) + (symbol :tag "Network name or session ID")) (repeat :tag "Nickname and password" (cons :tag "Identity" (string :tag "Nick") @@ -431,34 +443,20 @@ As soon as some source returns a password, the sequence of lookups stops and this function returns it (or returns nil if it is empty). Otherwise, no corresponding password was found, and it returns nil." - (let (network server port) - ;; Fill in local vars, switching to the server buffer once only - (erc-with-server-buffer - (setq network erc-network - server erc-session-server - port erc-session-port)) - (let ((ret - (or - (when erc-nickserv-passwords - (cdr (assoc nick - (cl-second (assoc network - erc-nickserv-passwords))))) - (when erc-use-auth-source-for-nickserv-password - (let ((secret (cl-first (auth-source-search - :max 1 :require '(:secret) - :host server - ;; Ensure a string for :port - :port (format "%s" port) - :user nick)))) - (when secret - (let ((passwd (plist-get secret :secret))) - (if (functionp passwd) (funcall passwd) passwd))))) - (when erc-prompt-for-nickserv-password - (read-passwd - (format "NickServ password for %s on %s (RET to cancel): " - nick network)))))) - (when (and ret (not (string= ret ""))) - ret)))) + (when-let* + ((nid (erc-networks--id-symbol erc-networks--id)) + (ret (or (when erc-nickserv-passwords + (assoc-default nick + (cadr (assq nid erc-nickserv-passwords)))) + (when (and erc-use-auth-source-for-nickserv-password + erc-auth-source-services-function) + (funcall erc-auth-source-services-function :user nick)) + (when erc-prompt-for-nickserv-password + (read-passwd + (format "NickServ password for %s on %s (RET to cancel): " + nick nid))))) + ((not (string-empty-p ret)))) + ret)) (defvar erc-auto-discard-away) diff --git a/lisp/erc/erc-sound.el b/lisp/erc/erc-sound.el index 86978f9d794..5cae64572f0 100644 --- a/lisp/erc/erc-sound.el +++ b/lisp/erc/erc-sound.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2002-2003, 2006-2022 Free Software Foundation, Inc. -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; URL: https://www.emacswiki.org/emacs/ErcSound ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index ead0d374b18..19113c5aad0 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -4,7 +4,7 @@ ;; Author: Mario Lang <mlang@delysid.org> ;; Contributor: Eric M. Ludlam <zappo@gnu.org> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; URL: https://www.emacswiki.org/emacs/ErcSpeedbar ;; This file is part of GNU Emacs. @@ -139,9 +139,7 @@ This will add a speedbar major display mode." t)))) (defun erc-speedbar-expand-server (text server indent) - (cond ((if (>= emacs-major-version 28) - (string-search "+" text) - (string-match "\\+" text)) + (cond ((string-search "+" text) (speedbar-change-expand-button-char ?-) (if (speedbar-with-writable (save-excursion @@ -150,9 +148,7 @@ This will add a speedbar major display mode." (speedbar-change-expand-button-char ?-) (speedbar-change-expand-button-char ??))) (;; we have to contract this node - (if (>= emacs-major-version 28) - (string-search "-" text) - (string-match "-" text)) + (string-search "-" text) (speedbar-change-expand-button-char ?+) (speedbar-delete-subblock indent)) (t (error "Ooops... not sure what to do"))) @@ -189,9 +185,7 @@ This will add a speedbar major display mode." "For the line matching TEXT, in CHANNEL, expand or contract a line. INDENT is the current indentation level." (cond - ((if (>= emacs-major-version 28) - (string-search "+" text) - (string-match "\\+" text)) + ((string-search "+" text) (speedbar-change-expand-button-char ?-) (speedbar-with-writable (save-excursion @@ -240,9 +234,7 @@ INDENT is the current indentation level." (speedbar-with-writable (dolist (entry names) (erc-speedbar-insert-user entry ?+ (1+ indent)))))))))) - ((if (>= emacs-major-version 28) - (string-search "-" text) - (string-match "-" text)) + ((string-search "-" text) (speedbar-change-expand-button-char ?+) (speedbar-delete-subblock indent)) (t (error "Ooops... not sure what to do"))) @@ -293,9 +285,7 @@ The update is only done when the channel is actually expanded already." (erc-speedbar-expand-channel "+" buffer 1))))) (defun erc-speedbar-expand-user (text token indent) - (cond ((if (>= emacs-major-version 28) - (string-search "+" text) - (string-match "\\+" text)) + (cond ((string-search "+" text) (speedbar-change-expand-button-char ?-) (speedbar-with-writable (save-excursion @@ -318,9 +308,7 @@ The update is only done when the channel is actually expanded already." nil nil nil nil info nil nil nil (1+ indent))))))) - ((if (>= emacs-major-version 28) - (string-search "-" text) - (string-match "-" text)) + ((string-search "-" text) (speedbar-change-expand-button-char ?+) (speedbar-delete-subblock indent)) (t (error "Ooops... not sure what to do"))) diff --git a/lisp/erc/erc-spelling.el b/lisp/erc/erc-spelling.el index d9cfc9bc985..91e6777b7c0 100644 --- a/lisp/erc/erc-spelling.el +++ b/lisp/erc/erc-spelling.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2005-2022 Free Software Foundation, Inc. ;; Author: Jorgen Schaefer <forcer@forcix.cx> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Keywords: comm, irc ;; URL: https://www.emacswiki.org/emacs/ErcSpelling diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index d74a53bc71e..cdab3241c12 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002-2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Mario Lang <mlang@delysid.org> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Keywords: comm, timestamp ;; URL: https://www.emacswiki.org/emacs/ErcStamp diff --git a/lisp/erc/erc-status-sidebar.el b/lisp/erc/erc-status-sidebar.el index 39430ee6598..8997be00ae0 100644 --- a/lisp/erc/erc-status-sidebar.el +++ b/lisp/erc/erc-status-sidebar.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2017, 2020-2022 Free Software Foundation, Inc. ;; Author: Andrew Barbarello -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; URL: https://github.com/drewbarbs/erc-status-sidebar ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 2196c5411eb..ef9a8c243e9 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2002-2022 Free Software Foundation, Inc. ;; Author: Mario Lang <mlang@delysid.org> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Keywords: comm ;; URL: https://www.emacswiki.org/emacs/ErcChannelTracking @@ -46,7 +46,7 @@ (defcustom erc-track-enable-keybindings 'ask "Whether to enable the ERC track keybindings, namely: -`C-c C-SPC' and `C-c C-@', which both do the same thing. +\\`C-c C-SPC' and \\`C-c C-@', which both do the same thing. The default is to check to see whether these keys are used already: if not, then enable the ERC track minor mode, which @@ -353,8 +353,6 @@ of `erc-track-shorten-start' characters." (> (length s) erc-track-shorten-cutoff)) erc-track-shorten-start)) -(defvar erc-default-recipients) - (defun erc-all-buffer-names () "Return all channel or query buffer names. Note that we cannot use `erc-channel-list' with a nil argument, @@ -455,12 +453,12 @@ START is the minimum length of the name used." ;; Play nice with other IRC clients (and Emacs development rules) by ;; making this a minor mode -(defvar erc-track-minor-mode-map (make-sparse-keymap) - "Keymap for rcirc track minor mode.") - -(define-key erc-track-minor-mode-map (kbd "C-c C-@") #'erc-track-switch-buffer) -(define-key erc-track-minor-mode-map (kbd "C-c C-SPC") - #'erc-track-switch-buffer) +(defvar erc-track-minor-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-@") #'erc-track-switch-buffer) + (define-key map (kbd "C-c C-SPC") #'erc-track-switch-buffer) + map) + "Keymap for ERC track minor mode.") ;;;###autoload (define-minor-mode erc-track-minor-mode diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el index 8a8842bc484..d998718a8fc 100644 --- a/lisp/erc/erc-truncate.el +++ b/lisp/erc/erc-truncate.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2003-2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Andreas Fuchs <asf@void.at> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; URL: https://www.emacswiki.org/emacs/ErcTruncation ;; Keywords: IRC, chat, client, Internet, logging diff --git a/lisp/erc/erc-xdcc.el b/lisp/erc/erc-xdcc.el index ee2a8c936f7..ca8ff6c080b 100644 --- a/lisp/erc/erc-xdcc.el +++ b/lisp/erc/erc-xdcc.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2003-2004, 2006-2022 Free Software Foundation, Inc. ;; Author: Mario Lang <mlang@delysid.org> -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Keywords: comm ;; This file is part of GNU Emacs. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 635228e7f55..151d75e7ce1 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2,8 +2,8 @@ ;; Copyright (C) 1997-2022 Free Software Foundation, Inc. -;; Author: Alexander L. Belikoff (alexander@belikoff.net) -;; Maintainer: Amin Bandali <bandali@gnu.org> +;; Author: Alexander L. Belikoff <alexander@belikoff.net> +;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me> ;; Contributors: Sergey Berezin (sergey.berezin@cs.cmu.edu), ;; Mario Lang (mlang@delysid.org), ;; Alex Schroeder (alex@gnu.org) @@ -12,8 +12,8 @@ ;; David Edmondson (dme@dme.org) ;; Michael Olson (mwolson@gnu.org) ;; Kelvin White (kwhite@gnu.org) -;; Version: 5.4 -;; Package-Requires: ((emacs "27.1")) +;; Version: 5.4.1 +;; Package-Requires: ((emacs "27.1") (compat "28.1.2.0")) ;; Keywords: IRC, chat, client, Internet ;; URL: https://www.gnu.org/software/emacs/erc.html @@ -69,7 +69,9 @@ (require 'iso8601) (eval-when-compile (require 'subr-x)) -(defconst erc-version "5.4" +(require 'erc-compat) + +(defconst erc-version "5.4.1" "This version of ERC.") (defvar erc-official-location @@ -83,7 +85,8 @@ 'customize-package-emacs-version-alist '(ERC ("5.2" . "22.1") ("5.3" . "23.1") - ("5.4" . "28.1"))) + ("5.4" . "28.1") + ("5.4.1" . "29.1"))) (defgroup erc nil "Emacs Internet Relay Chat client." @@ -129,7 +132,29 @@ "Running scripts at startup and with /LOAD." :group 'erc) -(require 'erc-backend) +;; Defined in erc-backend +(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) +(defvar erc-server-connected) +(defvar erc-server-current-nick) +(defvar erc-server-lag) +(defvar erc-server-last-sent-time) +(defvar erc-server-process) +(defvar erc-server-quitting) +(defvar erc-server-reconnect-count) +(defvar erc-server-reconnecting) +(defvar erc-session-client-certificate) +(defvar erc-session-connector) +(defvar erc-session-port) +(defvar erc-session-server) +(defvar erc-session-user-full-name) +(defvar erc-session-username) ;; tunable connection and authentication parameters @@ -189,16 +214,30 @@ parameters and authentication." :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 -prompt you for it.") + "Password to use when authenticating to an IRC server interactively. + +This variable only exists for legacy reasons. It's not customizable and +is limited to a single server password. Users looking for similar +functionality should consider auth-source instead. See info +node `(auth) Top' and info node `(erc) Connecting'.") + +(make-obsolete-variable 'erc-password "use auth-source instead" "29.1") (defcustom erc-user-mode "+i" ;; +i "Invisible". Hides user from global /who and /names. @@ -209,7 +248,7 @@ prompt you for it.") (defcustom erc-prompt-for-password t - "Asks before using the default password, or whether to enter a new one." + "Ask for a server password when invoking `erc-tls' interactively." :group 'erc :type 'boolean) @@ -223,13 +262,49 @@ prompt you for it.") :group 'erc :type 'boolean) -(defcustom erc-hide-prompt nil - "If non-nil, do not display the prompt for commands. +(defcustom erc-inhibit-multiline-input nil + "When non-nil, conditionally disallow input consisting of multiple lines. +Issue an error when the number of input lines submitted for +sending exceeds this value. The value t means disallow more +than 1 line of input." + :package-version '(ERC . "5.4.1") ; FIXME match to next release + :group 'erc + :type '(choice integer boolean)) + +(defcustom erc-ask-about-multiline-input nil + "Whether to ask to ignore `erc-inhibit-multiline-input' when tripped." + :package-version '(ERC . "5.4.1") ; FIXME match to next release + :group 'erc + :type 'boolean) -\(A command is any input starting with a `/'). +(defcustom erc-prompt-hidden ">" + "Text to show in lieu of the prompt when hidden." + :package-version '(ERC . "5.4.1") ; FIXME increment on next ELPA release + :group 'erc-display + :type 'string) -See also the variables `erc-prompt' and `erc-command-indicator'." +(defcustom erc-hide-prompt t + "If non-nil, hide input prompt upon disconnecting. +To unhide, type something in the input area. Once revealed, a +prompt remains unhidden until the next disconnection. Channel +prompts are unhidden upon rejoining. See +`erc-unhide-query-prompt' for behavior concerning query prompts." + :package-version '(ERC . "5.4.1") ; FIXME increment on next ELPA release + :group 'erc-display + :type '(choice (const :tag "Always hide prompt" t) + (set (const server) + (const query) + (const channel)))) + +(defcustom erc-unhide-query-prompt nil + "When non-nil, always reveal query prompts upon reconnecting. +Otherwise, prompts in a connection's query buffers remain hidden +until the user types in the input area or a new message arrives +from the target." + :package-version '(ERC . "5.4.1") ; FIXME increment on next ELPA release :group 'erc-display + ;; Extensions may one day offer a way to discover whether a target + ;; is online. When that happens, this can be expanded accordingly. :type 'boolean) ;; tunable GUI stuff @@ -351,18 +426,30 @@ erc-channel-user struct.") "Hash table of users on the current server. It associates nicknames with `erc-server-user' struct instances.") +(defconst erc--casemapping-rfc1459 + (make-translation-table + '((?\[ . ?\{) (?\] . ?\}) (?\\ . ?\|) (?~ . ?^)) + (mapcar (lambda (c) (cons c (+ c 32))) "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))) + +(defconst erc--casemapping-rfc1459-strict + (make-translation-table + '((?\[ . ?\{) (?\] . ?\}) (?\\ . ?\|)) + (mapcar (lambda (c) (cons c (+ c 32))) "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))) + (defun erc-downcase (string) - "Convert STRING to IRC standard conforming downcase." - (let ((s (downcase string)) - (c '((?\[ . ?\{) - (?\] . ?\}) - (?\\ . ?\|) - (?~ . ?^)))) - (save-match-data - (while (string-match "[]\\[~]" s) - (aset s (match-beginning 0) - (cdr (assq (aref s (match-beginning 0)) c))))) - s)) + "Return a downcased copy of STRING with properties. +Use the CASEMAPPING ISUPPORT parameter to determine the style." + (let* ((mapping (erc--get-isupport-entry 'CASEMAPPING 'single)) + (inhibit-read-only t)) + (if (equal mapping "ascii") + (downcase string) + (with-temp-buffer + (insert string) + (translate-region (point-min) (point-max) + (if (equal mapping "rfc1459-strict") + erc--casemapping-rfc1459-strict + erc--casemapping-rfc1459)) + (buffer-string))))) (defmacro erc-with-server-buffer (&rest body) "Execute BODY in the current ERC server buffer. @@ -871,8 +958,8 @@ See `erc-server-flood-margin' for other flood-related parameters.") ;; Script parameters (defcustom erc-startup-file-list - (list (concat user-emacs-directory ".ercrc.el") - (concat user-emacs-directory ".ercrc") + (list (locate-user-emacs-file ".ercrc.el") + (locate-user-emacs-file ".ercrc") "~/.ercrc.el" "~/.ercrc" ".ercrc.el" ".ercrc") "List of files to try for a startup script. The first existent and readable one will get executed. @@ -1053,6 +1140,29 @@ The struct has three slots: :type 'hook :version "27.1") +;; This is being auditioned for possible exporting (as a custom hook +;; option). Likewise for (public versions of) `erc--input-split' and +;; `erc--discard-trailing-multiline-nulls'. If unneeded, we'll just +;; run the latter on the input after `erc-pre-send-functions', and +;; remove this hook and the struct completely. IOW, if you need this, +;; please say so. + +(defvar erc--pre-send-split-functions '(erc--discard-trailing-multiline-nulls) + "Special hook for modifying individual lines in multiline prompt input. +The functions are called with one argument, an `erc--input-split' +struct, which they can optionally modify. + +The struct has five slots: + + `string': the input string delivered by `erc-pre-send-functions' + `insertp': whether to insert the lines into the buffer + `sendp': whether the lines should be sent to the IRC server + `lines': a list of lines to be sent, each one a `string' + `cmdp': whether to interpret input as a command, like /ignore + +The `string' field is effectively read-only. When `cmdp' is +non-nil, all but the first line will be discarded.") + (defvar erc-insert-this t "Insert the text into the target buffer or not. Functions on `erc-insert-pre-hook' can set this variable to nil @@ -1291,7 +1401,7 @@ Example: #\\='erc-replace-insert)) ((remove-hook \\='erc-insert-modify-hook #\\='erc-replace-insert)))" - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) (let* ((sn (symbol-name name)) (mode (intern (format "erc-%s-mode" (downcase sn)))) (group (intern (format "erc-%s" (downcase sn)))) @@ -1337,6 +1447,45 @@ if ARG is omitted or nil. (put ',enable 'definition-name ',name) (put ',disable 'definition-name ',name)))) +;; The rationale for favoring inheritance here (nicer dispatch) is +;; kinda flimsy since there aren't yet any actual methods. + +(cl-defstruct erc--target + (string "" :type string :documentation "Received name of target.") + (symbol nil :type symbol :documentation "Case-mapped name as symbol.")) + +;; These should probably take on a `joined' field to track joinedness, +;; which should be toggled by `erc-server-JOIN', `erc-server-PART', +;; etc. Functions like `erc--current-buffer-joined-p' (bug#48598) may +;; find it useful. + +(cl-defstruct (erc--target-channel (:include erc--target))) + +(cl-defstruct (erc--target-channel-local (:include erc--target-channel))) + +;; At some point, it may make sense to add a query type with an +;; account field, which may help support reassociation across +;; reconnects and nick changes (likely requires v3 extensions). + +(defun erc--target-from-string (string) + "Construct an `erc--target' variant from STRING." + (funcall (if (erc-channel-p string) + (if (erc--valid-local-channel-p string) + #'make-erc--target-channel-local + #'make-erc--target-channel) + #'make-erc--target) + :string string :symbol (intern (erc-downcase string)))) + +(defvar-local erc--target nil + "Info about a buffer's target, if any.") + +;; Temporary internal getter to ease transition to `erc--target' +;; everywhere. Will be replaced by updated `erc-default-target'. +(defun erc--default-target () + "Return target string or nil." + (when erc--target + (erc--target-string erc--target))) + (defun erc-once-with-server-event (event f) "Run function F the next time EVENT occurs in the `current-buffer'. @@ -1478,6 +1627,7 @@ Defaults to the server buffer." (define-derived-mode erc-mode fundamental-mode "ERC" "Major mode for Emacs IRC." + :interactive nil (setq local-abbrev-table erc-mode-abbrev-table) (setq-local next-line-add-newlines nil) (setq line-move-ignore-invisible t) @@ -1486,6 +1636,7 @@ Defaults to the server buffer." (setq-local paragraph-start (concat "\\(" (regexp-quote (erc-prompt)) "\\)")) (setq-local completion-ignore-case t) + (add-hook 'kill-buffer-hook #'erc-kill-buffer-function nil t) (add-hook 'completion-at-point-functions #'erc-complete-word-at-point nil t)) ;; activation @@ -1519,6 +1670,22 @@ The available choices are: (const :tag "Use current buffer" buffer) (const :tag "Use current buffer" t))) +(defcustom erc-reconnect-display nil + "How (and whether) to display a channel buffer upon reconnecting. + +This only affects automatic reconnections and is ignored when +issuing a /reconnect command or reinvoking `erc-tls' with the +same args (assuming success, of course). See `erc-join-buffer' +for a description of possible values." + :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA + :group 'erc-buffers + :type '(choice (const :tag "Use value of `erc-join-buffer'" nil) + (const :tag "Split window and select" window) + (const :tag "Split window, don't select" window-noselect) + (const :tag "New frame" frame) + (const :tag "Bury in new buffer" bury) + (const :tag "Use current buffer" buffer))) + (defcustom erc-frame-alist nil "Alist of frame parameters for creating erc frames. A value of nil means to use `default-frame-alist'." @@ -1550,6 +1717,14 @@ effect when `erc-join-buffer' is set to `frame'." (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 @@ -1559,6 +1734,9 @@ the existing buffers will be reused." :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 @@ -1594,55 +1772,61 @@ symbol, it may have these values: "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. @@ -1759,12 +1943,7 @@ nil." (lambda (bufname) (let ((buf (if (consp bufname) (cdr bufname) (get-buffer bufname)))) - (when buf - (erc--buffer-p buf (lambda () t) proc) - (with-current-buffer buf - (and (derived-mode-p 'erc-mode) - (or (null proc) - (eq proc erc-server-process)))))))))) + (and buf (erc--buffer-p buf (lambda () t) proc))))))) (defun erc-switch-to-buffer (&optional arg) "Prompt for an ERC buffer to switch to. When invoked with prefix argument, use all ERC buffers. Without @@ -1802,12 +1981,24 @@ all channel buffers on all servers." ;; Some local variables +;; TODO eventually deprecate this variable +;; +;; In the ancient, pre-CVS days (prior to June 2001), this list may +;; have been used for supporting the changing of a buffer's target on +;; the fly (mid-session). Such usage, which allowed cons cells like +;; (QUERY . bob) to serve as the list's head, was either never fully +;; integrated or was partially clobbered prior to the introduction of +;; version control. But vestiges remain (see `erc-dcc-chat-mode'). +;; And despite appearances, no evidence has emerged that ERC ever +;; supported one-to-many target buffers. If such a thing was aspired +;; to, it was never realized. +;; +;; New library code should use the `erc--target' struct instead. +;; Third-party code can continue to use this until a getter for +;; `erc--target' (or whatever replaces it) is exported. (defvar-local erc-default-recipients nil "List of default recipients of the current buffer.") -(defvar-local erc-session-user-full-name nil - "Full name of the user on the current server.") - (defvar-local erc-channel-user-limit nil "Limit of users per channel.") @@ -1948,7 +2139,10 @@ removed from the list will be disabled." (defun erc-setup-buffer (buffer) "Consults `erc-join-buffer' to find out how to display `BUFFER'." - (pcase erc-join-buffer + (pcase (if (zerop (erc-with-server-buffer + erc--server-last-reconnect-count)) + erc-join-buffer + (or erc-reconnect-display erc-join-buffer)) ('window (if (active-minibuffer-window) (display-buffer buffer) @@ -1974,8 +2168,8 @@ removed from the list will be disabled." (defun erc-open (&optional server port nick full-name connect passwd tgt-list channel process - client-certificate) - "Connect to SERVER on PORT as NICK with FULL-NAME. + 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 already connected and just create a separate buffer for the new @@ -1991,15 +2185,17 @@ of the client certificate itself to use when connecting over TLS, 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 ((server-announced-name (when (and (boundp 'erc-session-server) - (string= server erc-session-server)) - erc-server-announced-name)) - (connected-p (unless connect erc-server-connected)) - (buffer (erc-get-buffer-create server port channel)) - (old-buffer (current-buffer)) - old-point - continued-session) + (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) @@ -2007,8 +2203,9 @@ Returns the buffer for the given server or channel." (let ((old-recon-count erc-server-reconnect-count)) (erc-mode) (setq erc-server-reconnect-count old-recon-count)) - (setq erc-server-announced-name server-announced-name) - (setq erc-server-connected connected-p) + (when (setq erc-server-connected (not connect)) + (setq erc-server-announced-name + (buffer-local-value 'erc-server-announced-name old-buffer))) ;; connection parameters (setq erc-server-process process) (setq erc-insert-marker (make-marker)) @@ -2017,7 +2214,7 @@ Returns the buffer for the given server or channel." ;; (the buffer may have existed) (goto-char (point-max)) (forward-line 0) - (when (get-text-property (point) 'erc-prompt) + (when (or continued-session (get-text-property (point) 'erc-prompt)) (setq continued-session t) (set-marker erc-input-marker (or (next-single-property-change (point) 'erc-prompt) @@ -2028,6 +2225,9 @@ Returns the buffer for the given server or channel." (set-marker erc-insert-marker (point)) ;; stack of default recipients (setq erc-default-recipients tgt-list) + (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 @@ -2039,8 +2239,6 @@ Returns the buffer for the given server or channel." (setq erc-server-users nil) (setq erc-channel-users (make-hash-table :test 'equal)))) - ;; clear last incomplete line read - (setq erc-server-filter-data nil) (setq erc-channel-topic "") ;; limit on the number of users on the channel (mode +l) (setq erc-channel-user-limit nil) @@ -2057,24 +2255,12 @@ Returns the buffer for the given server or channel." (setq erc-logged-in nil) ;; The local copy of `erc-nick' - the list of nicks to choose (setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick))) - ;; password stuff - (setq erc-session-password - (or passwd - (let ((secret - (plist-get - (nth 0 - (auth-source-search :host server - :max 1 - :user nick - ;; secrets.el wouldn’t accept a number - :port (if (numberp port) (number-to-string port) port) - :require '(:secret))) - :secret))) - (if (functionp secret) - (funcall secret) - 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 @@ -2084,12 +2270,13 @@ Returns the buffer for the given server or channel." (goto-char (point-max)) (insert "\n")) (if continued-session - (goto-char old-point) + (progn (goto-char old-point) + (erc--unhide-prompt)) (set-marker erc-insert-marker (point)) (erc-display-prompt) (goto-char (point-max))) - (erc-determine-parameters server port nick full-name) + (erc-determine-parameters server port nick full-name user passwd) ;; Saving log file on exit (run-hook-with-args 'erc-connect-pre-hook buffer) @@ -2187,11 +2374,9 @@ parameters SERVER and NICK." (setq server user-input) (setq passwd (if erc-prompt-for-password - (if (and erc-password - (y-or-n-p "Use the default password? ")) - erc-password - (read-passwd "Password: ")) - erc-password)) + (read-passwd "Server password: ") + (with-suppressed-warnings ((obsolete erc-password)) + erc-password))) (when (and passwd (string= "" passwd)) (setq passwd nil)) @@ -2210,8 +2395,10 @@ parameters SERVER and NICK." (cl-defun erc (&key (server (erc-compute-server)) (port (erc-compute-port)) (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. @@ -2221,8 +2408,10 @@ Non-interactively, it takes the keyword arguments (server (erc-compute-server)) (port (erc-compute-port)) (nick (erc-compute-nick)) + (user (erc-compute-user)) password (full-name (erc-compute-full-name)) + id That is, if called with @@ -2230,9 +2419,13 @@ 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)) + (erc-open server port nick full-name t password nil nil nil nil user id)) ;;;###autoload (defalias 'erc-select #'erc) @@ -2242,9 +2435,11 @@ for the values of the other parameters." (cl-defun erc-tls (&key (server (erc-compute-server)) (port (erc-compute-port)) (nick (erc-compute-nick)) + (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. @@ -2258,6 +2453,7 @@ Non-interactively, it takes the keyword arguments password (full-name (erc-compute-full-name)) client-certificate + id That is, if called with @@ -2279,13 +2475,19 @@ Example usage: (erc-tls :server \"irc.libera.chat\" :port 6697 :client-certificate - '(\"/home/bandali/my-cert.key\" - \"/home/bandali/my-cert.crt\"))" + \\='(\"/home/bandali/my-cert.key\" + \"/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))) + 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. @@ -2341,8 +2543,6 @@ but you won't see it. WARNING: Do not set this variable directly! Instead, use the function `erc-toggle-debug-irc-protocol' to toggle its value.") -(declare-function erc-network-name "erc-networks" ()) - (defun erc-log-irc-protocol (string &optional outbound) "Append STRING to the buffer *erc-protocol*. @@ -2352,15 +2552,20 @@ The buffer is created if it doesn't exist. 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 (fboundp 'erc-network) - (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*") @@ -2403,7 +2608,8 @@ If ARG is non-nil, show the *erc-protocol* buffer." (concat "This buffer displays all IRC protocol " "traffic exchanged with servers.")) (erc-make-notice "Kill it to disable logging.") - (erc-make-notice "Press `t' to toggle.")))) + (erc-make-notice (substitute-command-keys + "Press \\`t' to toggle."))))) (insert (string-join msg "\r\n"))) (use-local-map (make-sparse-keymap)) (local-set-key (kbd "t") 'erc-toggle-debug-irc-protocol)) @@ -2760,7 +2966,7 @@ returns non-nil." (let* ((command (erc-response.command parsed)) (sender (car (erc-parse-user (erc-response.sender parsed)))) (channel (car (erc-response.command-args parsed))) - (network (or (and (fboundp 'erc-network-name) (erc-network-name)) + (network (or (and (erc-network) (erc-network-name)) (erc-shorten-server-name (or erc-server-announced-name erc-session-server)))) @@ -2816,20 +3022,19 @@ present." (let ((prop-val (erc-get-parsed-vector position))) (and prop-val (member (erc-response.command prop-val) list)))) -(defvar-local erc-send-input-line-function 'erc-send-input-line) +(defvar-local erc-send-input-line-function 'erc-send-input-line + "Function for sending lines lacking a leading user command. +When a line typed into a buffer contains an explicit command, like /msg, +a corresponding handler (here, erc-cmd-MSG) is called. But lines typed +into a channel or query buffer already have an implicit target and +command (PRIVMSG). This function is called on such occasions and also +for special purposes (see erc-dcc.el).") (defun erc-send-input-line (target line &optional force) - "Send LINE to TARGET. - -See also `erc-server-send'." - (setq line (format "PRIVMSG %s :%s" - target - ;; If the line is empty, we still want to - ;; send it - i.e. an empty pasted line. - (if (string= line "\n") - " \n" - line))) - (erc-server-send line force target)) + "Send LINE to TARGET." + (when (string= line "\n") + (setq line " \n")) + (erc-message "PRIVMSG" (concat target " " line) force)) (defun erc-get-arglist (fun) "Return the argument list of a function without the parens." @@ -2967,7 +3172,7 @@ Commands for which no erc-cmd-xxx exists, are tunneled through this function. LINE is sent to the server verbatim, and therefore has to contain the command itself as well." (erc-log (format "cmd: DEFAULT: %s" line)) - (erc-server-send (substring line 1)) + (erc-server-send (string-trim-right (substring line 1) "[\r\n]")) t) (defvar erc--read-time-period-history nil) @@ -3186,22 +3391,137 @@ For a list of user commands (/join /part, ...): (defalias 'erc-cmd-H #'erc-cmd-HELP) (put 'erc-cmd-HELP 'process-not-needed t) +(defcustom erc-auth-source-server-function #'erc-auth-source-search + "Function to query auth-source for a server password. +Called with a subset of keyword parameters known to +`auth-source-search' and relevant to an opening \"PASS\" command, +if any. In return, ERC expects a string to send as the server +password, or nil, to skip the \"PASS\" command completely. An +explicit `:password' argument to entry-point commands `erc' and +`erc-tls' also inhibits lookup, as does setting this option to +nil. See info node `(erc) Connecting' for details." + :package-version '(ERC . "5.4.1") ; FIXME update when publishing to ELPA + :group 'erc + :type '(choice (const erc-auth-source-search) + (const nil) + function)) + +(defcustom erc-auth-source-join-function #'erc-auth-source-search + "Function to query auth-source on joining a channel. +Called with a subset of keyword arguments known to +`auth-source-search' and relevant to joining a password-protected +channel. In return, ERC expects a string to use as the channel +\"key\", or nil to just join the channel normally. Setting the +option itself to nil tells ERC to always forgo consulting +auth-source for channel keys. For more information, see info +node `(erc) Connecting'." + :package-version '(ERC . "5.4.1") ; FIXME update when publishing to ELPA + :group 'erc + :type '(choice (const erc-auth-source-search) + (const nil) + function)) + +(defun erc--auth-source-determine-params-defaults () + (let* ((net (and-let* ((esid (erc-networks--id-symbol erc-networks--id)) + ((symbol-name esid))))) + (localp (and erc--target (erc--target-channel-local-p erc--target))) + (hosts (if localp + (list erc-server-announced-name erc-session-server net) + (list net erc-server-announced-name erc-session-server))) + (ports (list (cl-typecase erc-session-port + (integer (number-to-string erc-session-port)) + (string (and (string= erc-session-port "irc") + erc-session-port)) ; or nil + (t erc-session-port)) + "irc"))) + (list (cons :host (delq nil hosts)) + (cons :port (delq nil ports)) + (cons :require '(:secret))))) + +(defun erc--auth-source-determine-params-merge (&rest plist) + "Return a plist of merged keyword args to pass to `auth-source-search'. +Combine items in PLIST with others derived from the current connection +context, but prioritize the former. For keys not present in PLIST, +favor a network ID over an announced server unless `erc--target' is a +local channel. And treat the dialed server address as a fallback for +the announced name in both cases." + (let ((defaults (erc--auth-source-determine-params-defaults))) + `(,@(cl-loop for (key value) on plist by #'cddr + for default = (assq key defaults) + do (when default (setq defaults (delq default defaults))) + append `(,key ,(delete-dups + `(,@(if (consp value) value (list value)) + ,@(cdr default))))) + ,@(cl-loop for (k . v) in defaults append (list k v))))) + +(defun erc--auth-source-search (&rest defaults) + "Ask auth-source for a secret and return it if found. +Use DEFAULTS as keyword arguments for querying auth-source and as a +guide for narrowing results. Return a string if found or nil otherwise. +The ordering of DEFAULTS influences how results are filtered, as does +the ordering of the members of any individual composite values. If +necessary, the former takes priority. For example, if DEFAULTS were to +contain + + :host (\"foo\" \"bar\") :port (\"123\" \"456\") + +the secret from an auth-source entry of host foo and port 456 would be +chosen over another of host bar and port 123. However, if DEFAULTS +looked like + + :port (\"123\" \"456\") :host (\"foo\" \"bar\") + +the opposite would be true. In both cases, two entries with the same +host but different ports would result in the one with port 123 getting +the nod. Much the same would happen for entries sharing only a port: +the one with host foo would win." + (when-let* + ((priority (map-keys defaults)) + (test (lambda (a b) + (catch 'done + (dolist (key priority) + (let* ((d (plist-get defaults key)) + (defval (if (listp d) d (list d))) + ;; featurep 'seq via auth-source > json > map + (p (seq-position defval (plist-get a key))) + (q (seq-position defval (plist-get b key)))) + (unless (eql p q) + (throw 'done (when p (or (not q) (< p q)))))))))) + (plist (copy-sequence defaults))) + (unless (plist-get plist :max) + (setq plist (plist-put plist :max 5000))) ; `auth-source-netrc-parse' + (unless (plist-get defaults :require) + (setq plist (plist-put plist :require '(:secret)))) + (when-let* ((sorted (sort (apply #'auth-source-search plist) test)) + (secret (plist-get (car sorted) :secret))) + (if (functionp secret) (funcall secret) secret)))) + +(defun erc-auth-source-search (&rest plist) + "Call `auth-source-search', possibly with keyword params in PLIST." + ;; These exist as separate helpers in case folks should find them + ;; useful. If that's you, please request that they be exported. + (apply #'erc--auth-source-search + (apply #'erc--auth-source-determine-params-merge plist))) + (defun erc-server-join-channel (server channel &optional secret) - (let* ((secret (or secret - (plist-get (nth 0 (auth-source-search - :max 1 - :host server - :port "irc" - :user channel)) - :secret))) - (password (if (functionp secret) - (funcall secret) - secret))) - (erc-log (format "cmd: JOIN: %s" channel)) - (erc-server-send (concat "JOIN " channel - (if password - (concat " " password) - ""))))) + "Join CHANNEL, optionally with SECRET. +Without SECRET, consult auth-source, possibly passing SERVER as the +`:host' query parameter." + (unless (or secret (not erc-auth-source-join-function)) + (unless server + (when (and erc-server-announced-name + (erc--valid-local-channel-p channel)) + (setq server erc-server-announced-name))) + (setq secret (apply erc-auth-source-join-function + `(,@(and server (list :host server)) :user ,channel)))) + (erc-log (format "cmd: JOIN: %s" channel)) + (erc-server-send (concat "JOIN " channel (and secret (concat " " secret))))) + +(defun erc--valid-local-channel-p (channel) + "Non-nil when channel is server-local on a network that allows them." + (and-let* (((eq ?& (aref channel 0))) + (chan-types (erc--get-isupport-entry 'CHANTYPES 'single)) + ((string-search "&" chan-types))))) (defun erc-cmd-JOIN (channel &optional key) "Join the channel given in CHANNEL, optionally with KEY. @@ -3215,18 +3535,12 @@ were most recently invited. See also `invitation'." (setq chnl (erc-ensure-channel-name channel))) (when chnl ;; Prevent double joining of same channel on same server. - (let* ((joined-channels - (mapcar (lambda (chanbuf) - (with-current-buffer chanbuf (erc-default-target))) - (erc-channel-list erc-server-process))) - (server (with-current-buffer (process-buffer erc-server-process) - (or erc-session-server erc-server-announced-name))) - (chnl-name (car (erc-member-ignore-case chnl joined-channels)))) - (if chnl-name - (switch-to-buffer (if (get-buffer chnl-name) - chnl-name - (concat chnl-name "/" server))) - (erc-server-join-channel server chnl key))))) + (if-let* ((existing (erc-get-buffer chnl erc-server-process)) + ((with-current-buffer existing + (erc-get-channel-user (erc-current-nick))))) + (switch-to-buffer existing) + (setq erc--server-last-reconnect-count 0) + (erc-server-join-channel nil chnl key)))) t) (defalias 'erc-cmd-CHANNEL #'erc-cmd-JOIN) @@ -3528,8 +3842,8 @@ The rest of LINE is the message to send." (defun erc-cmd-NICK (nick) "Change current nickname to NICK." (erc-log (format "cmd: NICK: %s (erc-bad-nick: %S)" nick erc-bad-nick)) - (let ((nicklen (cdr (assoc "NICKLEN" (erc-with-server-buffer - erc-server-parameters))))) + (let ((nicklen (erc-with-server-buffer + (erc--get-isupport-entry 'NICKLEN 'single)))) (and nicklen (> (length nick) (string-to-number nicklen)) (erc-display-message nil 'notice 'active 'nick-too-long @@ -3608,20 +3922,23 @@ other people should be displayed." (defun erc-cmd-QUERY (&optional user) "Open a query with USER. -The type of query window/frame/etc will depend on the value of -`erc-query-display'. - -If USER is omitted, close the current query buffer if one exists -- except this is broken now ;-)" +How the query is displayed (in a new window, frame, etc.) depends +on the value of `erc-query-display'." + ;; FIXME: The doc string used to say at the end: + ;; "If USER is omitted, close the current query buffer if one exists + ;; - except this is broken now ;-)" + ;; Does it make sense to have that functionality? What's wrong with + ;; `kill-buffer'? If it makes sense, re-add it. -- SK @ 2021-11-11 (interactive (list (read-string "Start a query with: "))) - (let ((session-buffer (erc-server-buffer)) - (erc-join-buffer erc-query-display)) - (if user - (erc-query user session-buffer) + (unless user ;; currently broken, evil hack to display help anyway ;(erc-delete-query)))) - (signal 'wrong-number-of-arguments "")))) + (signal 'wrong-number-of-arguments "")) + (let ((erc-join-buffer erc-query-display)) + (erc-with-server-buffer + (erc--open-target user)))) + (defalias 'erc-cmd-Q #'erc-cmd-QUERY) (defun erc-quit/part-reason-default () @@ -3639,12 +3956,7 @@ If S is non-nil, it will be used as the quit reason." "Zippy quit message. If S is non-nil, it will be used as the quit reason." - (or s - (if (fboundp 'yow) - (if (>= emacs-major-version 28) - (string-replace "\n" "" (yow)) - (replace-regexp-in-string "\n" "" (yow))) - (erc-quit/part-reason-default)))) + (or s (erc-quit/part-reason-default))) (make-obsolete 'erc-quit-reason-zippy "it will be removed." "24.4") @@ -3668,12 +3980,7 @@ If S is non-nil, it will be used as the part reason." "Zippy part message. If S is non-nil, it will be used as the quit reason." - (or s - (if (fboundp 'yow) - (if (>= emacs-major-version 28) - (string-replace "\n" "" (yow)) - (replace-regexp-in-string "\n" "" (yow))) - (erc-quit/part-reason-default)))) + (or s (erc-quit/part-reason-default))) (make-obsolete 'erc-part-reason-zippy "it will be removed." "24.4") @@ -3754,13 +4061,21 @@ the message given by REASON." (setq buffer (current-buffer))) (with-current-buffer buffer (setq erc-server-quitting nil) - (setq erc-server-reconnecting t) + (with-suppressed-warnings ((obsolete erc-server-reconnecting)) + (setq erc-server-reconnecting t)) + (setq erc--server-reconnecting t) (setq erc-server-reconnect-count 0) (setq process (get-buffer-process (erc-server-buffer))) - (if process - (delete-process process) - (erc-server-reconnect)) - (setq erc-server-reconnecting nil))) + (when process + (delete-process process)) + (erc-server-reconnect) + (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))) + (setq erc--server-reconnecting nil + erc-server-reconnecting nil))))) t) (put 'erc-cmd-RECONNECT 'process-not-needed t) @@ -4251,8 +4566,6 @@ This places `point' just after the prompt, or at the beginning of the line." (defun erc-complete-word-at-point () (run-hook-with-args-until-success 'erc-complete-functions)) -(define-obsolete-function-alias 'erc-complete-word #'completion-at-point "24.1") - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; IRC SERVER INPUT HANDLING @@ -4299,27 +4612,30 @@ See `erc-default-server-hook'." (nconc erc-server-vectors (list parsed)) nil) -(defun erc-query (target server) - "Open a query buffer on TARGET, using SERVER. +(defun erc--open-target (target) + "Open an ERC buffer on TARGET." + (erc-open erc-session-server + erc-session-port + (erc-current-nick) + erc-session-user-full-name + nil + nil + (list target) + target + erc-server-process + nil + erc-session-username + (erc-networks--id-given erc-networks--id))) + +(defun erc-query (target server-buffer) + "Open a query buffer on TARGET using SERVER-BUFFER. To change how this query window is displayed, use `let' to bind `erc-join-buffer' before calling this." - (unless (and server - (buffer-live-p server) - (set-buffer server)) + (declare (obsolete "bind `erc-cmd-query' and call `erc-cmd-QUERY'" "29.1")) + (unless (buffer-live-p server-buffer) (error "Couldn't switch to server buffer")) - (let ((buf (erc-open erc-session-server - erc-session-port - (erc-current-nick) - erc-session-user-full-name - nil - nil - (list target) - target - erc-server-process))) - (unless buf - (error "Couldn't open query window")) - (erc-update-mode-line) - buf)) + (with-current-buffer server-buffer + (erc--open-target target))) (defcustom erc-auto-query 'window-noselect "If non-nil, create a query buffer each time you receive a private message. @@ -4338,6 +4654,10 @@ a new window, but not to select it. See the documentation for (const :tag "Use current buffer" buffer) (const :tag "Use current buffer" t))) +;; FIXME either retire this or put it to use after determining how +;; it's meant to work. Clearly, the doc string does not describe +;; current behavior. It's currently only used by the obsolete +;; function `erc-auto-query'. (defcustom erc-query-on-unjoined-chan-privmsg t "If non-nil create query buffer on receiving any PRIVMSG at all. This includes PRIVMSGs directed to channels. If you are using an IRC @@ -4398,9 +4718,8 @@ See also `erc-display-error-notice'." (format "Nickname %s is %s, try another." nick reason)) (setq erc-nick-change-attempt-count (+ erc-nick-change-attempt-count 1)) (let ((newnick (nth 1 erc-default-nicks)) - (nicklen (cdr (assoc "NICKLEN" - (erc-with-server-buffer - erc-server-parameters))))) + (nicklen (erc-with-server-buffer + (erc--get-isupport-entry 'NICKLEN 'single)))) (setq erc-bad-nick t) ;; try to use a different nick (if erc-default-nicks @@ -4461,6 +4780,8 @@ and as second argument the event parsed as a vector." (erc-cmd-QUERY query)) nil)))) +(make-obsolete 'erc-auto-query "try erc-cmd-QUERY instead" "29.1") + (defun erc-is-message-ctcp-p (message) "Check if MESSAGE is a CTCP message or not." (string-match "^\C-a\\([^\C-a]*\\)\C-a?$" message)) @@ -4717,11 +5038,19 @@ Set user modes and run `erc-after-connect' hook." (nick (car (erc-response.command-args parsed))) (buffer (process-buffer proc))) (setq erc-server-connected t) - (setq erc-server-reconnect-count 0) + (setq erc--server-last-reconnect-count erc-server-reconnect-count + erc-server-reconnect-count 0) (erc-update-mode-line) (erc-set-initial-user-mode nick buffer) (erc-server-setup-periodical-ping buffer) - (run-hook-with-args 'erc-after-connect server nick))))) + (run-hook-with-args 'erc-after-connect server nick)))) + + (when erc-unhide-query-prompt + (erc-with-all-buffers-of-server proc + nil ; FIXME use `erc--target' after bug#48598 + (when (and (erc-default-target) + (not (erc-channel-p (car erc-default-recipients)))) + (erc--unhide-prompt))))) (defun erc-set-initial-user-mode (nick buffer) "If `erc-user-mode' is non-nil for NICK, set the user modes. @@ -5003,8 +5332,7 @@ See also `erc-channel-begin-receiving-names'." (defun erc-parse-prefix () "Return an alist of valid prefix character types and their representations. Example: (operator) o => @, (voiced) v => +." - (let ((str (or (cdr (assoc "PREFIX" (erc-with-server-buffer - erc-server-parameters))) + (let ((str (or (erc-with-server-buffer (erc--get-isupport-entry 'PREFIX t)) ;; provide a sane default "(qaohv)~&@%+")) types chars) @@ -5544,7 +5872,7 @@ Specifically, return the position of `erc-insert-marker'." (point-max)) (defvar erc-last-input-time 0 - "Time of last call to `erc-send-current-line'. + "Time of last successful call to `erc-send-current-line'. If that function has never been called, the value is 0.") (defcustom erc-accidental-paste-threshold-seconds 0.2 @@ -5560,6 +5888,68 @@ submitted line to be intentional." :version "26.1" :type '(choice number (other :tag "disabled" nil))) +(defvar erc--input-line-delim-regexp (rx (| (: (? ?\r) ?\n) ?\r))) + +(defun erc--blank-in-multiline-input-p (lines) + "Detect whether LINES contains a blank line. +When `erc-send-whitespace-lines' is in effect, return nil if +LINES is multiline or the first line is non-empty. When +`erc-send-whitespace-lines' is nil, return non-nil when any line +is empty or consists of one or more spaces, tabs, or form-feeds." + (catch 'return + (let ((multilinep (cdr lines))) + (dolist (line lines) + (when (if erc-send-whitespace-lines + (and (string-empty-p line) (not multilinep)) + (string-match (rx bot (* (in " \t\f")) eot) line)) + (throw 'return t)))))) + +(defun erc--check-prompt-input-for-excess-lines (_ lines) + "Return non-nil when trying to send too many LINES." + (when erc-inhibit-multiline-input + ;; Assume `erc--discard-trailing-multiline-nulls' is set to run + (let ((reversed (seq-drop-while #'string-empty-p (reverse lines))) + (max (if (eq erc-inhibit-multiline-input t) + 2 + erc-inhibit-multiline-input)) + (seen 0) + msg) + (while (and (pop reversed) (< (cl-incf seen) max))) + (when (= seen max) + (setq msg (format "(exceeded by %d)" (1+ (length reversed)))) + (unless (and erc-ask-about-multiline-input + (y-or-n-p (concat "Send input " msg "?"))) + (concat "Too many lines " msg)))))) + +(defun erc--check-prompt-input-for-multiline-blanks (_ lines) + "Return non-nil when multiline prompt input has blank LINES." + (when (erc--blank-in-multiline-input-p lines) + (if erc-warn-about-blank-lines + "Blank line - ignoring..." + 'invalid))) + +(defun erc--check-prompt-input-for-point-in-bounds (_ _) + "Return non-nil when point is before prompt." + (when (< (point) (erc-beg-of-input-line)) + "Point is not in the input area")) + +(defun erc--check-prompt-input-for-running-process (string _) + "Return non-nil unless in an active ERC server buffer." + (unless (or (erc-server-buffer-live-p) + (erc-command-no-process-p string)) + "ERC: No process running")) + +(defvar erc--check-prompt-input-functions + '(erc--check-prompt-input-for-point-in-bounds + erc--check-prompt-input-for-multiline-blanks + erc--check-prompt-input-for-running-process + erc--check-prompt-input-for-excess-lines) + "Validators for user input typed at prompt. +Called with latest input string submitted by user and the list of +lines produced by splitting it. If any member function returns +non-nil, processing is abandoned and input is left untouched. +When the returned value is a string, pass it to `erc-error'.") + (defun erc-send-current-line () "Parse current line and send it to IRC." (interactive) @@ -5573,20 +5963,21 @@ submitted line to be intentional." (eolp)) (expand-abbrev)) (widen) - (if (< (point) (erc-beg-of-input-line)) - (erc-error "Point is not in the input area") + (if-let* ((str (erc-user-input)) + (msg (run-hook-with-args-until-success + 'erc--check-prompt-input-functions str + (split-string str erc--input-line-delim-regexp)))) + (when (stringp msg) + (erc-error msg)) (let ((inhibit-read-only t) - (str (erc-user-input)) (old-buf (current-buffer))) - (if (and (not (erc-server-buffer-live-p)) - (not (erc-command-no-process-p str))) - (erc-error "ERC: No process running") + (progn ; unprogn this during next major surgery (erc-set-active-buffer (current-buffer)) ;; Kill the input and the prompt (delete-region (erc-beg-of-input-line) (erc-end-of-input-line)) (unwind-protect - (erc-send-input str) + (erc-send-input str 'skip-ws-chk) ;; Fix the buffer if the command didn't kill it (when (buffer-live-p old-buf) (with-current-buffer old-buf @@ -5601,8 +5992,8 @@ submitted line to be intentional." (set-buffer-modified-p buffer-modified)))))) ;; Only when last hook has been run... - (run-hook-with-args 'erc-send-completed-hook str)))) - (setq erc-last-input-time now)) + (run-hook-with-args 'erc-send-completed-hook str))) + (setq erc-last-input-time now))) (switch-to-buffer "*ERC Accidental Paste Overflow*") (lwarn 'erc :warning "You seem to have accidentally pasted some text!")))) @@ -5619,21 +6010,31 @@ submitted line to be intentional." (cl-defstruct erc-input string insertp sendp) -(defun erc-send-input (input) +(cl-defstruct (erc--input-split (:include erc-input)) + lines cmdp) + +(defun erc--discard-trailing-multiline-nulls (state) + "Ensure last line of STATE's string is non-null. +But only when `erc-send-whitespace-lines' is non-nil. STATE is +an `erc--input-split' object." + (when (and erc-send-whitespace-lines (erc--input-split-lines state)) + (let ((reversed (nreverse (erc--input-split-lines state)))) + (when (string-empty-p (car reversed)) + (pop reversed) + (setf (erc--input-split-cmdp state) nil)) + (nreverse (seq-drop-while #'string-empty-p reversed))))) + +(defun erc-send-input (input &optional skip-ws-chk) "Treat INPUT as typed in by the user. It is assumed that the input and the prompt is already deleted. Return non-nil only if we actually send anything." ;; Handle different kinds of inputs - (cond - ;; Ignore empty input - ((if erc-send-whitespace-lines - (string= input "") - (string-match "\\`[ \t\r\f\n]*\\'" input)) - (when erc-warn-about-blank-lines - (message "Blank line - ignoring...") - (beep)) - nil) - (t + (if (and (not skip-ws-chk) + (erc--check-prompt-input-for-multiline-blanks + input (split-string input erc--input-line-delim-regexp))) + (when erc-warn-about-blank-lines + (message "Blank line - ignoring...") ; compat + (beep)) ;; This dynamic variable is used by `erc-send-pre-hook'. It's ;; obsolete, and when it's finally removed, this binding should ;; also be removed. @@ -5653,48 +6054,28 @@ Return non-nil only if we actually send anything." :insertp erc-insert-this :sendp erc-send-this)) (run-hook-with-args 'erc-pre-send-functions state) + (setq state (make-erc--input-split + :string (erc-input-string state) + :insertp (erc-input-insertp state) + :sendp (erc-input-sendp state) + :lines (split-string (erc-input-string state) + erc--input-line-delim-regexp) + :cmdp (string-match erc-command-regexp + (erc-input-string state)))) + (run-hook-with-args 'erc--pre-send-split-functions state) (when (and (erc-input-sendp state) - erc-send-this) - (let ((string (erc-input-string state))) - (if (or (if (>= emacs-major-version 28) - (string-search "\n" string) - (string-match "\n" string)) - (not (string-match erc-command-regexp string))) - (mapc - (lambda (line) - (mapc - (lambda (line) - ;; Insert what has to be inserted for this. - (when (erc-input-insertp state) - (erc-display-msg line)) - (erc-process-input-line (concat line "\n") - (null erc-flood-protect) t)) - (or (and erc-flood-protect (erc-split-line line)) - (list line)))) - (split-string string "\n")) - (erc-process-input-line (concat string "\n") t nil)) - t)))))) - -;; (defun erc-display-command (line) -;; (when erc-insert-this -;; (let ((insert-position (point))) -;; (unless erc-hide-prompt -;; (erc-display-prompt nil nil (erc-command-indicator) -;; (and (erc-command-indicator) -;; 'erc-command-indicator-face))) -;; (let ((beg (point))) -;; (insert line) -;; (erc-put-text-property beg (point) -;; 'font-lock-face 'erc-command-indicator-face) -;; (insert "\n")) -;; (when (processp erc-server-process) -;; (set-marker (process-mark erc-server-process) (point))) -;; (set-marker erc-insert-marker (point)) -;; (save-excursion -;; (save-restriction -;; (narrow-to-region insert-position (point)) -;; (run-hooks 'erc-send-modify-hook) -;; (run-hooks 'erc-send-post-hook)))))) + erc-send-this) + (let ((lines (erc--input-split-lines state))) + (if (and (erc--input-split-cmdp state) (not (cdr lines))) + (erc-process-input-line (concat (car lines) "\n") t nil) + (dolist (line lines) + (dolist (line (or (and erc-flood-protect (erc-split-line line)) + (list line))) + (when (erc-input-insertp state) + (erc-display-msg line)) + (erc-process-input-line (concat line "\n") + (null erc-flood-protect) t)))) + t))))) (defun erc-display-msg (line) "Display LINE as a message of the user to the current target at point." @@ -5786,6 +6167,27 @@ See also `erc-downcase'." ;; default target handling +(defun erc--current-buffer-joined-p () + "Return whether the current target buffer is joined." + ;; This may be a reliable means of detecting subscription status, + ;; but it's also roundabout and awkward. Perhaps it's worth + ;; discussing adding a joined slot to `erc--target' for this. + (cl-assert erc--target) + (and (erc--target-channel-p erc--target) + (erc-get-channel-user (erc-current-nick)) t)) + +;; This function happens to return nil in channel buffers previously +;; parted or those from which a user had been kicked. While this +;; "works" for detecting whether a channel is currently subscribed to, +;; new code should consider using +;; +;; (erc-get-channel-user (erc-current-nick)) +;; +;; instead. For retrieving a target regardless of subscription or +;; connection status, use replacements based on `erc--target'. +;; (Coming soon.) +;; +;; TODO deprecate this (defun erc-default-target () "Return the current default target (as a character string) or nil if none." (let ((tgt (car erc-default-recipients))) @@ -5796,12 +6198,14 @@ See also `erc-downcase'." (defun erc-add-default-channel (channel) "Add CHANNEL to the default channel list." + (declare (obsolete "use `erc-cmd-JOIN' or similar instead" "29.1")) (let ((chl (downcase channel))) (setq erc-default-recipients (cons chl erc-default-recipients)))) (defun erc-delete-default-channel (channel &optional buffer) "Delete CHANNEL from the default channel list." + (declare (obsolete "use `erc-cmd-PART' or similar instead" "29.1")) (with-current-buffer (if (and buffer (bufferp buffer)) buffer @@ -5813,6 +6217,7 @@ See also `erc-downcase'." "Add QUERY'd NICKNAME to the default channel list. The previous default target of QUERY type gets removed." + (declare (obsolete "use `erc-cmd-QUERY' or similar instead" "29.1")) (let ((d1 (car erc-default-recipients)) (d2 (cdr erc-default-recipients)) (qt (cons 'QUERY (downcase nickname)))) @@ -5823,7 +6228,7 @@ The previous default target of QUERY type gets removed." (defun erc-delete-query () "Delete the topmost target if it is a QUERY." - + (declare (obsolete "use one query buffer per target instead" "29.1")) (let ((d1 (car erc-default-recipients)) (d2 (cdr erc-default-recipients))) (if (and (listp d1) @@ -6151,20 +6556,20 @@ user input." erc-session-server erc-session-user-full-name)) (if erc-session-password - (erc-server-send (format "PASS %s" erc-session-password)) + (erc-server-send (concat "PASS :" erc-session-password)) (message "Logging in without password")) (erc-server-send (format "NICK %s" (erc-current-nick))) (erc-server-send (format "USER %s %s %s :%s" ;; hacked - S.B. - (if erc-anonymous-login erc-email-userid (user-login-name)) + erc-session-username "0" "*" erc-session-user-full-name)) (erc-update-mode-line)) ;; connection properties' heuristics -(defun erc-determine-parameters (&optional server port nick name) +(defun erc-determine-parameters (&optional server port nick name user passwd) "Determine the connection and authentication parameters. Sets the buffer local variables: @@ -6172,11 +6577,15 @@ Sets the buffer local variables: - `erc-session-server' - `erc-session-port' - `erc-session-user-full-name' +- `erc-session-username' +- `erc-session-password' - `erc-server-current-nick'" (setq erc-session-connector erc-server-connect-function erc-session-server (erc-compute-server server) erc-session-port (or port erc-default-port) - erc-session-user-full-name (erc-compute-full-name name)) + erc-session-user-full-name (erc-compute-full-name name) + erc-session-username (erc-compute-user user) + erc-session-password (erc--compute-server-password passwd nick)) (erc-set-current-nick (erc-compute-nick nick))) (defun erc-compute-server (&optional server) @@ -6194,6 +6603,10 @@ non-nil value is found. (getenv "IRCSERVER") erc-default-server)) +(defun erc-compute-user (&optional user) + "Return a suitable value for the session user name." + (or user (if erc-anonymous-login erc-email-userid (user-login-name)))) + (defun erc-compute-nick (&optional nick) "Return user's IRC nick. @@ -6209,6 +6622,12 @@ non-nil value is found. (getenv "IRCNICK") (user-login-name))) +(defun erc--compute-server-password (password nick) + "Maybe provide a PASSWORD argument for the IRC \"PASS\" command. +When `erc-auth-source-server-function' is non-nil, call it with NICK for +the user field and use whatever it returns as the server password." + (or password (and erc-auth-source-server-function + (funcall erc-auth-source-server-function :user nick)))) (defun erc-compute-full-name (&optional full-name) "Return user's full name. @@ -6493,30 +6912,19 @@ This should be a string with substitution variables recognized by (defun erc-format-network () "Return the name of the network we are currently on." - (let ((network (and (fboundp 'erc-network-name) (erc-network-name)))) - (if (and network (symbolp network)) - (symbol-name network) - ""))) + (erc-network-name)) (defun erc-format-target-and/or-network () "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." @@ -6597,21 +7005,12 @@ shortened server name instead." (fill-region (point-min) (point-max)) (buffer-string)))) (setq header-line-format - (if (>= emacs-major-version 28) - (string-replace - "%" - "%%" - (if face - (propertize header 'help-echo help-echo - 'face face) - (propertize header 'help-echo help-echo))) - (replace-regexp-in-string - "%" - "%%" - (if face - (propertize header 'help-echo help-echo - 'face face) - (propertize header 'help-echo help-echo))))))) + (string-replace + "%" + "%%" + (if face + (propertize header 'help-echo help-echo 'face face) + (propertize header 'help-echo help-echo)))))) (t (setq header-line-format (if face (propertize header 'face face) @@ -6896,9 +7295,7 @@ functions." nick user host channel (if (not (string= reason "")) (format ": %s" - (if (>= emacs-major-version 28) - (string-replace "%" "%%" reason) - (replace-regexp-in-string "%" "%%" reason))) + (string-replace "%" "%%" reason)) ""))))) @@ -6933,23 +7330,29 @@ See also `format-spec'." ;;; Various hook functions -;; 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) @@ -7022,6 +7425,7 @@ This function should be on `erc-kill-channel-hook'." ;; Teach url.el how to open irc:// URLs with ERC. ;; To activate, customize `url-irc-function' to `url-irc-erc'. +;; FIXME change user to nick, and use API to find server buffer ;;;###autoload (defun erc-handle-irc-url (host port channel user password) "Use ERC to IRC on HOST:PORT in CHANNEL as USER with PASSWORD. @@ -7043,9 +7447,12 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL." (provide 'erc) +(require 'erc-backend) + ;; Deprecated. We might eventually stop requiring the goodies automatically. ;; IMPORTANT: This require must appear _after_ the above (provide 'erc) to ;; avoid a recursive require error when byte-compiling the entire package. (require 'erc-goodies) +(require 'erc-networks) ;;; erc.el ends here |