diff options
Diffstat (limited to 'lisp/erc/erc.el')
| -rw-r--r-- | lisp/erc/erc.el | 4186 |
1 files changed, 3223 insertions, 963 deletions
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 88e41e96a82..0750463a4e7 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -12,11 +12,14 @@ ;; David Edmondson (dme@dme.org) ;; Michael Olson (mwolson@gnu.org) ;; Kelvin White (kwhite@gnu.org) -;; Version: 5.5.0.29.1 -;; Package-Requires: ((emacs "27.1") (compat "29.1.3.4")) +;; Version: 5.6-git +;; Package-Requires: ((emacs "27.1") (compat "29.1.4.4")) ;; Keywords: IRC, chat, client, Internet ;; URL: https://www.gnu.org/software/emacs/erc.html +;; This is a GNU ELPA :core package. Avoid functionality that is not +;; compatible with the version of Emacs recorded above. + ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify @@ -58,20 +61,16 @@ ;;; Code: -(load "erc-loaddefs" 'noerror 'nomessage) +(eval-and-compile (load "erc-loaddefs" 'noerror 'nomessage)) (require 'erc-networks) (require 'erc-backend) (require 'cl-lib) (require 'format-spec) -(require 'pp) -(require 'thingatpt) (require 'auth-source) -(require 'time-date) -(require 'iso8601) -(eval-when-compile (require 'subr-x) (require 'url-parse)) +(eval-when-compile (require 'subr-x)) -(defconst erc-version "5.5.0.29.1" +(defconst erc-version "5.6-git" "This version of ERC.") (defvar erc-official-location @@ -87,7 +86,8 @@ ("5.3" . "23.1") ("5.4" . "28.1") ("5.4.1" . "29.1") - ("5.5" . "29.1"))) + ("5.5" . "29.1") + ("5.6" . "30.1"))) (defgroup erc nil "Emacs Internet Relay Chat client." @@ -101,7 +101,9 @@ :group 'erc) (defgroup erc-display nil - "Settings for how various things are displayed." + "Settings controlling how various things are displayed. +See the customization group `erc-buffers' for display options +concerning buffers." :group 'erc) (defgroup erc-mode-line-and-header nil @@ -133,12 +135,82 @@ "Running scripts at startup and with /LOAD." :group 'erc) -;; Forward declarations -(defvar erc-message-parsed) +;; Add `custom-loads' features for group symbols missing from a +;; supported Emacs version, possibly because they belong to a new ERC +;; library. These groups all share their library's feature name. +;;;###autoload(dolist (symbol '( erc-sasl erc-spelling ; 29 +;;;###autoload erc-imenu erc-nicks)) ; 30 +;;;###autoload (custom-add-load symbol symbol)) + +(defvar erc-message-parsed) ; only known to this file + +(defvar erc--msg-props nil + "Hash table containing metadata properties for current message. +Provided by the insertion functions `erc-display-message' and +`erc-display-msg' while running their modification hooks. +Initialized when null for each visitation round from function +parameters and environmental factors, as well as the alist +`erc--msg-prop-overrides'. Keys are symbols. Values are opaque +objects, unless otherwise specified. Items present after running +`erc-insert-post-hook' or `erc-send-post-hook' become text +properties added to the first character of an inserted message. +A given message therefore spans the interval extending from one +set of such properties to the newline before the next (or +`erc-insert-marker'). As of ERC 5.6, this forms the basis for +visiting and editing inserted messages. Modules should align +their markers accordingly. The following properties have meaning +as of ERC 5.6: + + - `erc--msg': a symbol, guaranteed present; possible values + include `unknown', a fallback used by `erc-display-message'; a + catalog key, such as `s401' or `finished'; an + `erc-display-message' TYPE parameter, like `notice' + + - `erc--cmd': a message's associated IRC command, as read by + `erc--get-eq-comparable-cmd'; currently either a symbol, like + `PRIVMSG', or a number, like 5, which represents the numeric + \"005\"; absent on \"local\" messages, such as simple warnings + and help text, and on outgoing messages unless echoed back by + the server (assuming future support) + + - `erc--spkr': a string, the nick of the person speaking + + - `erc--ctcp': a CTCP command, like `ACTION' + + - `erc--ts': a timestamp, possibly provided by the server; as of + 5.6, a ticks/hertz pair on Emacs 29 and above, and a \"list\" + type otherwise; managed by the `stamp' module + + - `erc--ephemeral': a symbol prefixed by or matching a module + name; indicates to other modules and members of modification + hooks that the current message should not affect stateful + operations, such as recording a channel's most recent speaker + +This is an internal API, and the selection of related helper +utilities is fluid and provisional. As of ERC 5.6, see the +functions `erc--check-msg-prop' and `erc--get-inserted-msg-prop'.") + +(defvar erc--msg-prop-overrides nil + "Alist of \"message properties\" for populating `erc--msg-props'. +These override any defaults normally shown to modification hooks +by `erc-display-msg' and `erc-display-message'. Modules should +accommodate existing overrides when applicable. Items toward the +front shadow any that follow. Ignored when `erc--msg-props' is +already non-nil.") -(defvar tabbar--local-hlf) -(defvar motif-version-string) -(defvar gtk-version-string) +;; Forward declarations +(declare-function decoded-time-period "time-date" (time)) +(declare-function iso8601-parse-duration "iso8601" (string)) +(declare-function word-at-point "thingatpt" (&optional no-properties)) +(autoload 'word-at-point "thingatpt") ; for hl-nicks + +(declare-function gnutls-negotiate "gnutls" (&rest rest)) +(declare-function socks-open-network-stream "socks" (name buffer host service)) +(declare-function url-host "url-parse" (cl-x)) +(declare-function url-password "url-parse" (cl-x)) +(declare-function url-portspec "url-parse" (cl-x)) +(declare-function url-type "url-parse" (cl-x)) +(declare-function url-user "url-parse" (cl-x)) ;; tunable connection and authentication parameters @@ -237,7 +309,14 @@ node `(auth) Top' and Info node `(erc) auth-source'.") :type 'boolean) (defcustom erc-warn-about-blank-lines t - "Warn the user if they attempt to send a blank line." + "Warn the user if they attempt to send a blank line. +When non-nil, ERC signals a `user-error' upon encountering prompt +input containing empty or whitespace-only lines. When nil, ERC +still inhibits sending but does so silently. With the companion +option `erc-send-whitespace-lines' enabled, ERC sends pending +input and prints a message in the echo area indicating the amount +of padding and/or stripping applied, if any. Setting this option +to nil suppresses such reporting." :group 'erc :type 'boolean) @@ -249,8 +328,8 @@ node `(auth) Top' and Info node `(erc) auth-source'.") (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." +sending meets or exceeds this value. The value t is synonymous +with a value of 2 and means disallow more than 1 line of input." :package-version '(ERC . "5.5") :group 'erc :type '(choice integer boolean)) @@ -271,8 +350,13 @@ than 1 line of input." "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." +prompts are unhidden upon rejoining. For behavior concerning +query prompts, see `erc-unhide-query-prompt'. Longtime ERC users +should note that this option was repurposed in ERC 5.5 because it +had lain dormant for years after being sidelined in 5.3 when its +only use in the interactive client was removed. Before then, its +role was controlling whether `erc-command-indicator' would appear +alongside echoed slash-command lines." :package-version '(ERC . "5.5") :group 'erc-display :type '(choice (const :tag "Always hide prompt" t) @@ -309,6 +393,16 @@ If nil, only \"> \" will be shown." (const "PART") (const "QUIT") (const "MODE") + (const :tag "Away notices (RPL_AWAY 301)" "301") + (const :tag "Self back notice (REP_UNAWAY 305)" "305") + (const :tag "Self away notice (REP_NOWAWAY 306)" "306") + (const :tag "Channel modes on join (RPL_CHANNELMODEIS 324)" "324") + (const :tag "Channel creation time (RPL_CREATIONTIME 329)" "329") + (const :tag "Channel no-topic on join (RPL_NOTOPIC 331)" "331") + (const :tag "Channel topic on join (RPL_TOPIC 332)" "332") + (const :tag "Topic author and time on join (RPL_TOPICWHOTIME 333)" "333") + (const :tag "Invitation success notice (RPL_INVITING 341)" "341") + (const :tag "Channel member names (353 RPL_NAMEREPLY)" "353") (repeat :inline t :tag "Others" (string :tag "IRC Message Type")))) (defcustom erc-hide-list nil @@ -344,7 +438,7 @@ simply because we do not necessarily receive the QUIT event." :type 'hook) (defcustom erc-complete-functions nil - "These functions get called when the user hits TAB in ERC. + "These functions get called when the user hits \\`TAB' in ERC. Each function in turn is called until one returns non-nil to indicate it has handled the input." :group 'erc-hooks @@ -397,13 +491,14 @@ Functions are passed a buffer as the first argument." :group 'erc-hooks :type 'hook) - -(defvar-local erc-channel-users nil +(defvaralias 'erc-channel-users 'erc-channel-members) +(defvar-local erc-channel-members nil "Hash table of members in the current channel. -It associates nicknames with cons cells of the form: -\(USER . MEMBER-DATA) where USER is a pointer to an -erc-server-user struct, and MEMBER-DATA is a pointer to an -erc-channel-user struct.") +It associates nicknames with cons cells of the form +\(SERVER-USER . MEMBER-DATA), where SERVER-USER is a +`erc-server-user' object and MEMBER-DATA is a `erc-channel-user' +object. Convenient abbreviations for these two components are +`susr' and `cusr', along with `cmem' for the pair.") (defvar-local erc-server-users nil "Hash table of users on the current server. @@ -510,6 +605,8 @@ See also: `erc-remove-server-user' and Removes all users in the current channel. This is called by `erc-server-PART' and `erc-server-QUIT'." + (when (erc--target-channel-p erc--target) + (setf (erc--target-channel-joined-p erc--target) nil)) (when (and erc-server-connected (erc-server-process-alive) (hash-table-p erc-channel-users)) @@ -518,6 +615,53 @@ Removes all users in the current channel. This is called by erc-channel-users) (clrhash erc-channel-users))) +(defmacro erc--define-channel-user-status-compat-getter (name c d) + "Define a gv getter for historical `erc-channel-user' status slot NAME. +Expect NAME to be a string, C to be its traditionally associated +letter, and D to be its fallback power-of-2 integer for non-ERC +buffers." + `(defun ,(intern (concat "erc-channel-user-" name)) (u) + ,(format "Get equivalent of pre-5.6 `%s' slot for `erc-channel-user'." + name) + (declare (gv-setter (lambda (v) + (macroexp-let2 nil v v + (,'\`(let ((val (erc-channel-user-status ,',u)) + (n (or (erc--get-prefix-flag ,c) ,d))) + (setf (erc-channel-user-status ,',u) + (if ,',v + (logior val n) + (logand val (lognot n)))) + ,',v)))))) + (let ((n (or (erc--get-prefix-flag ,c) ,d))) + (= n (logand n (erc-channel-user-status u)))))) + +(erc--define-channel-user-status-compat-getter "voice" ?v 1) +(erc--define-channel-user-status-compat-getter "halfop" ?h 2) +(erc--define-channel-user-status-compat-getter "op" ?o 4) +(erc--define-channel-user-status-compat-getter "admin" ?a 8) +(erc--define-channel-user-status-compat-getter "owner" ?q 16) + +;; This is a generalized version of the compat-oriented getters above. +(defun erc--cusr-status-p (nick-or-cusr letter) + "Return non-nil if NICK-OR-CUSR has channel membership status LETTER." + (and-let* ((cusr (or (and (erc-channel-user-p nick-or-cusr) nick-or-cusr) + (cdr (erc-get-channel-member nick-or-cusr)))) + (n (erc--get-prefix-flag letter))) + (= n (logand n (erc-channel-user-status cusr))))) + +(defun erc--cusr-change-status (nick-or-cusr letter enablep &optional resetp) + "Add or remove membership status associated with LETTER for NICK-OR-CUSR. +With RESETP, clear the user's status info completely. If ENABLEP +is non-nil, add the status value associated with LETTER." + (when-let ((cusr (or (and (erc-channel-user-p nick-or-cusr) nick-or-cusr) + (cdr (erc-get-channel-member nick-or-cusr)))) + (n (erc--get-prefix-flag letter))) + (cl-callf (lambda (v) + (if resetp + (if enablep n 0) + (if enablep (logior v n) (logand v (lognot n))))) + (erc-channel-user-status cusr)))) + (defun erc-channel-user-owner-p (nick) "Return non-nil if NICK is an owner of the current channel." (and nick @@ -650,9 +794,9 @@ See also: `erc-get-channel-user-list'." "A topic string for the channel. Should only be used in channel-buffers.") (defvar-local erc-channel-modes nil - "List of strings representing channel modes. -E.g. (\"i\" \"m\" \"s\" \"b Quake!*@*\") -\(not sure the ban list will be here, but why not)") + "List of letters, as strings, representing channel modes. +For example, (\"i\" \"m\" \"s\"). Modes that take accompanying +parameters are not included.") (defvar-local erc-insert-marker nil "The place where insertion of new text in erc buffers should happen.") @@ -669,7 +813,74 @@ E.g. (\"i\" \"m\" \"s\" \"b Quake!*@*\") (defcustom erc-prompt "ERC>" "Prompt used by ERC. Trailing whitespace is not required." :group 'erc-display - :type '(choice string function)) + :type '(choice string + (function-item :tag "Interpret format specifiers" + erc-prompt-format) + function)) + +(defvar erc--prompt-format-face-example + #("%p%m%a\u00b7%b>" + 0 2 (font-lock-face erc-my-nick-prefix-face) + 2 4 (font-lock-face font-lock-keyword-face) + 4 6 (font-lock-face erc-error-face) + 6 7 (font-lock-face shadow) + 7 9 (font-lock-face font-lock-constant-face) + 9 10 (font-lock-face shadow)) + "An example value for option `erc-prompt-format' with faces.") + +(defcustom erc-prompt-format erc--prompt-format-face-example + "Format string when `erc-prompt' is `erc-prompt-format'. +ERC recognizes these substitution specifiers: + + %a - away indicator + %b - buffer name + %t - channel or query target, server domain, or dialed address + %S - target@network or buffer name + %s - target@server or server + %N - current network, like Libera.Chat + %p - channel membership prefix, like @ or + + %n - current nickname + %c - channel modes with args for select modes + %C - channel modes with all args + %u - user modes + %m - channel modes sans args in channels, user modes elsewhere + %M - like %m but show nothing in query buffers + +To pick your own colors, do something like: + + (setopt erc-prompt-format + (concat + (propertize \"%b\" \\='font-lock-face \\='erc-input-face) + (propertize \"%a\" \\='font-lock-face \\='erc-error-face))) + +Please remember that ERC ignores this option completely unless +the \"parent\" option `erc-prompt' is set to `erc-prompt-format'." + :package-version '(ERC . "5.6") + :group 'erc-display + :type `(choice (const :tag "{Prefix}{Mode}{Away}{MIDDLE DOT}{Buffer}>" + ,erc--prompt-format-face-example) + string)) + +(defun erc-prompt-format () + "Make predefined `format-spec' substitutions. + +See option `erc-prompt-format' and option `erc-prompt'." + (format-spec erc-prompt-format + (erc-compat--defer-format-spec-in-buffer + (?C erc--channel-modes 3 ",") + (?M erc--format-modes 'no-query-p) + (?N erc-format-network) + (?S erc-format-target-and/or-network) + (?a erc--format-away-indicator) + (?b buffer-name) + (?c erc-format-channel-modes) + (?m erc--format-modes) + (?n erc-current-nick) + (?p erc--format-channel-status-prefix) + (?s erc-format-target-and/or-server) + (?t erc-format-target) + (?u erc--format-user-modes)) + 'ignore-missing)) ; formerly `only-present' (defun erc-prompt () "Return the input prompt as a string. @@ -682,28 +893,6 @@ See also the variable `erc-prompt'." (concat prompt " ") prompt))) -(defcustom erc-command-indicator nil - "Indicator used by ERC for showing commands. - -If non-nil, this will be used in the ERC buffer to indicate -commands (i.e., input starting with a `/'). - -If nil, the prompt will be constructed from the variable `erc-prompt'." - :group 'erc-display - :type '(choice (const nil) string function)) - -(defun erc-command-indicator () - "Return the command indicator prompt as a string. - -This only has any meaning if the variable `erc-command-indicator' is non-nil." - (and erc-command-indicator - (let ((prompt (if (functionp erc-command-indicator) - (funcall erc-command-indicator) - erc-command-indicator))) - (if (> (length prompt) 0) - (concat prompt " ") - prompt)))) - (defcustom erc-notice-prefix "*** " "Prefix for all notices." :group 'erc-display @@ -881,6 +1070,9 @@ Flooding is sending too much information to the server in too short of an interval, which may cause the server to terminate the connection. +Note that older code conflated rate limiting and line splitting. +Starting in ERC 5.6, this option no longer influences the latter. + See `erc-server-flood-margin' for other flood-related parameters.") ;; Script parameters @@ -1008,7 +1200,13 @@ user after \"/PART\"." ;; Hooks (defgroup erc-hooks nil - "Hook variables for fancy customizations of ERC." + "Hooks for ERC. +Users of the interactive client should be aware that many of +these hooks have names predating the modern convention of +conveying abnormality via the \"-function\" suffix. Users should +likewise be aware that built-in and third-party modules use these +hooks as well, and some of their variables may be buffer-local in +particular sessions and/or `let'-bound for spells." :group 'erc) (defcustom erc-mode-hook nil @@ -1018,9 +1216,8 @@ user after \"/PART\"." :options '(erc-add-scroll-to-bottom)) (defcustom erc-timer-hook nil - "Put functions which should get called more or less periodically here. -The idea is that servers always play ping pong with the client, and so there -is no need for any idle-timer games with Emacs." + "Abnormal hook run after each response handler. +Called with a float returned from `erc-current-time'." :group 'erc-hooks :type 'hook) @@ -1055,41 +1252,54 @@ anyway." (make-obsolete-variable 'erc-send-pre-hook 'erc-pre-send-functions "27.1") (defcustom erc-pre-send-functions nil - "Special hook run to possibly alter the string that is sent. -The functions are called with one argument, an `erc-input' struct, -and should alter that struct. - -The struct has three slots: + "Special hook to possibly alter the string to send and insert. +ERC calls the member functions with one argument, an `erc-input' +struct instance to modify as needed. - `string': The current input string. - `insertp': Whether the string should be inserted into the erc buffer. - `sendp': Whether the string should be sent to the irc server." - :group 'erc - :type 'hook - :version "27.1") +The struct has five slots: -;; 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. + `string': String to send, originally from prompt input. + `insertp': Whether a string should be inserted in the buffer. + `sendp': Whether `string' should be sent to the IRC server. + `substxt': String to display (but not send) instead of `string'. + `refoldp': Whether to re-split `string' per protocol limits. + +This hook runs after protocol line splitting has taken place, so +the value of `string' comes \"pre-split\" according to the option +`erc-split-line-length'. If you need ERC to refill the entire +payload before sending it, set the `refoldp' slot to a non-nil +value. Note that this refilling is only a convenience, and +modules with special needs, such as preserving \"preformatted\" +text or encoding for subprotocol \"tunneling\", should handle +splitting manually and possibly also specify replacement text to +display via the `substxt' slot." + :package-version '(ERC . "5.3") + :group 'erc-hooks + :type 'hook) -(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. +(define-obsolete-variable-alias 'erc--pre-send-split-functions + 'erc--input-review-functions "30.1") +(defvar erc--input-review-functions '(erc--split-lines + erc--run-input-validation-checks + erc--discard-trailing-multiline-nulls + erc--inhibit-slash-cmd-insertion) + "Special hook for reviewing and modifying prompt input. +ERC runs this before clearing the prompt and before running any +send-related hooks, such as `erc-pre-send-functions'. Thus, it's +quite \"safe\" to bail out of this hook with a `user-error', if +necessary. The hook's members 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 + `string': the original input as a read-only reference + `insertp': same as in `erc-pre-send-functions' + `sendp': same as in `erc-pre-send-functions' + `refoldp': same as in `erc-pre-send-functions' `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.") +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. @@ -1106,9 +1316,13 @@ if they wish to avoid sending of a particular string.") "Insertion hook for functions that will change the text's appearance. This hook is called just after `erc-insert-pre-hook' when the value of `erc-insert-this' is t. -While this hook is run, narrowing is in effect and `current-buffer' is -the buffer where the text got inserted. One possible value to add here -is `erc-fill'." + +ERC runs this hook with the buffer narrowed to the bounds of the +inserted message plus a trailing newline. Built-in modules place +their hook members in two depth ranges: the first between -80 and +-20 and the second between 20 and 80. Use the functions +`erc-find-parsed-property' and `erc-get-parsed-vector' to locate +and extract the `erc-response' object for the inserted message." :group 'erc-hooks :type 'hook) @@ -1131,8 +1345,8 @@ preserve point if needed." (defcustom erc-send-modify-hook nil "Sending hook for functions that will change the text's appearance. -This hook is called just after `erc-send-pre-hook' when the values -of `erc-send-this' and `erc-insert-this' are both t. +ERC runs this just after `erc-pre-send-functions' if its shared +`erc-input' object's `sendp' and `insertp' slots remain non-nil. While this hook is run, narrowing is in effect and `current-buffer' is the buffer where the text got inserted. @@ -1189,7 +1403,6 @@ which the local user typed." (define-key map [home] #'erc-bol) (define-key map "\C-c\C-a" #'erc-bol) (define-key map "\C-c\C-b" #'erc-switch-to-buffer) - (define-key map "\C-c\C-c" #'erc-toggle-interpret-controls) (define-key map "\C-c\C-d" #'erc-input-action) (define-key map "\C-c\C-e" #'erc-toggle-ctcp-autoresponse) (define-key map "\C-c\C-f" #'erc-toggle-flood-control) @@ -1204,7 +1417,7 @@ which the local user typed." (define-key map "\C-c\C-u" #'erc-kill-input) (define-key map "\C-c\C-x" #'erc-quit-server) (define-key map "\M-\t" #'ispell-complete-word) - (define-key map "\t" #'completion-at-point) + (define-key map "\t" #'erc-tab) ;; Suppress `font-lock-fontify-block' key binding since it ;; destroys face properties. @@ -1213,6 +1426,19 @@ which the local user typed." map) "ERC keymap.") +(defun erc--modify-local-map (mode &rest bindings) + "Modify `erc-mode-map' on behalf of a global module. +Add or remove `key-valid-p' BINDINGS when toggling MODE." + (declare (indent 1)) + (while (pcase-let* ((`(,key ,def . ,rest) bindings) + (existing (keymap-lookup erc-mode-map key))) + (if mode + (when (or (not existing) (eq existing #'undefined)) + (keymap-set erc-mode-map key def)) + (when (eq existing def) + (keymap-unset erc-mode-map key t))) + (setq bindings rest)))) + ;; Faces ; Honestly, I have a horrible sense of color and the "defaults" below @@ -1260,21 +1486,20 @@ This will only be used if `erc-header-line-face-method' is non-nil." "ERC face for the prompt." :group 'erc-faces) -(defface erc-command-indicator-face - '((t :weight bold)) - "ERC face for the command indicator. -See the variable `erc-command-indicator'." - :group 'erc-faces) - (defface erc-notice-face '((default :weight bold) + (((class color) (min-colors 88) (supports :weight semi-bold)) + :weight semi-bold :foreground "SlateBlue") (((class color) (min-colors 88)) :foreground "SlateBlue") (t :foreground "blue")) "ERC face for notices." + :package-version '(ERC . "5.6") :group 'erc-faces) -(defface erc-action-face '((t :weight bold)) +(defface erc-action-face '((((supports :weight semi-bold)) :weight semi-bold) + (t :weight bold)) "ERC face for actions generated by /ME." + :package-version '(ERC . "5.6") :group 'erc-faces) (defface erc-error-face '((t :foreground "red")) @@ -1297,9 +1522,8 @@ See also `erc-show-my-nick'." ;; Debugging support -(defvar erc-log-p nil - "When set to t, generate debug messages in a separate debug buffer.") - +;; FIXME if this variable plays some role, indicate that here. +;; Otherwise, deprecate. (defvar erc-debug-log-file (expand-file-name "ERC.debug") "Debug log file name.") @@ -1313,6 +1537,21 @@ See also `erc-show-my-nick'." Bound to local variables from an existing (logical) session's buffer during local-module setup and `erc-mode-hook' activation.") +(defmacro erc--restore-initialize-priors (mode &rest vars) + "Restore local VARS for local minor MODE from a previous session." + (declare (indent 1)) + (let ((priors (make-symbol "priors")) + (initp (make-symbol "initp")) + ;; + forms) + (while-let ((k (pop vars))) + (push `(,k (if ,initp (alist-get ',k ,priors) ,(pop vars))) forms)) + `(let* ((,priors (or erc--server-reconnecting erc--target-priors)) + (,initp (and ,priors (alist-get ',mode ,priors)))) + (unless (local-variable-if-set-p ',mode) + (error "Not a local minor mode var: %s" ',mode)) + (setq ,@(mapcan #'identity (nreverse forms)))))) + (defun erc--target-from-string (string) "Construct an `erc--target' variant from STRING." (funcall (if (erc-channel-p string) @@ -1322,16 +1561,6 @@ buffer during local-module setup and `erc-mode-hook' activation.") #'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'. @@ -1348,7 +1577,7 @@ Please be sure to use this function in server-buffers. In channel-buffers it may not work at all, as it uses the LOCAL argument of `add-hook' and `remove-hook' to ensure multiserver capabilities." - (unless (erc-server-buffer-p) + (unless (erc--server-buffer-p) (error "You should only run `erc-once-with-server-event' in a server buffer")) (let ((fun (make-symbol "fun")) @@ -1362,6 +1591,37 @@ capabilities." (add-hook hook fun nil t) fun)) +(defun erc--warn-once-before-connect (mode-var &rest args) + "Display an \"error notice\" once. +Expect ARGS to be `erc-button--display-error-notice-with-keys' +compatible parameters, except without any leading buffers or +processes. If we're in an ERC buffer with a network process when +called, print the notice immediately. Otherwise, if we're in a +server buffer, arrange to do so after local modules have been set +up and mode hooks have run. Otherwise, if MODE-VAR is a global +module, try again at most once the next time `erc-mode-hook' +runs." + (declare (indent 1)) + (cl-assert (stringp (car args))) + (if (derived-mode-p 'erc-mode) + (unless (or (erc-with-server-buffer ; needs `erc-server-process' + (apply #'erc-button--display-error-notice-with-keys + (current-buffer) args) + t) + erc--target) ; unlikely + (let (hook) + (setq hook + (lambda (_) + (remove-hook 'erc-connect-pre-hook hook t) + (apply #'erc-button--display-error-notice-with-keys args))) + (add-hook 'erc-connect-pre-hook hook nil t))) + (when (custom-variable-p mode-var) + (let (hook) + (setq hook (lambda () + (remove-hook 'erc-mode-hook hook) + (apply #'erc--warn-once-before-connect 'erc-fake args))) + (add-hook 'erc-mode-hook hook))))) + (defun erc-server-buffer () "Return the server buffer for the current buffer's process. The buffer-local variable `erc-server-process' is used to find @@ -1374,29 +1634,36 @@ the process buffer." (and (processp erc-server-process) (buffer-live-p (process-buffer erc-server-process)))) -(defun erc-server-buffer-p (&optional buffer) +(define-obsolete-function-alias + 'erc-server-buffer-p 'erc-server-or-unjoined-channel-buffer-p "30.1") +(defun erc-server-or-unjoined-channel-buffer-p (&optional buffer) "Return non-nil if argument BUFFER is an ERC server buffer. - -If BUFFER is nil, the current buffer is used." +If BUFFER is nil, use the current buffer. For historical +reasons, also return non-nil for channel buffers the client has +parted or from which it's been kicked." (with-current-buffer (or buffer (current-buffer)) (and (eq major-mode 'erc-mode) (null (erc-default-target))))) +(defun erc--server-buffer-p (&optional buffer) + "Return non-nil if BUFFER is an ERC server buffer. +Without BUFFER, use the current buffer." + (if buffer + (with-current-buffer buffer + (and (eq major-mode 'erc-mode) (null erc--target))) + (and (eq major-mode 'erc-mode) (null erc--target)))) + (defun erc-open-server-buffer-p (&optional buffer) "Return non-nil if BUFFER is an ERC server buffer with an open IRC process. If BUFFER is nil, the current buffer is used." - (and (erc-server-buffer-p buffer) + (and (erc--server-buffer-p buffer) (erc-server-process-alive buffer))) (defun erc-query-buffer-p (&optional buffer) "Return non-nil if BUFFER is an ERC query buffer. If BUFFER is nil, the current buffer is used." - (with-current-buffer (or buffer (current-buffer)) - (let ((target (erc-default-target))) - (and (eq major-mode 'erc-mode) - target - (not (memq (aref target 0) '(?# ?& ?+ ?!))))))) + (not (erc-channel-p (or buffer (current-buffer))))) (defun erc-ison-p (nick) "Return non-nil if NICK is online." @@ -1454,6 +1721,7 @@ Defaults to the server buffer." (setq-local paragraph-start (concat "\\(" (regexp-quote (erc-prompt)) "\\)")) (setq-local completion-ignore-case t) + (add-hook 'post-command-hook #'erc-check-text-conversion nil 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)) @@ -1462,15 +1730,33 @@ Defaults to the server buffer." (defconst erc-default-server "irc.libera.chat" "IRC server to use if it cannot be detected otherwise.") -(defconst erc-default-port 6667 +(defvar erc-default-port 6667 "IRC port to use if it cannot be detected otherwise.") (defconst erc-default-port-tls 6697 "IRC port to use for encrypted connections if it cannot be \ detected otherwise.") -(defcustom erc-join-buffer 'bury - "Determines how to display a newly created IRC buffer. +(defconst erc--buffer-display-choices + `(choice (const :tag "Use value of `erc-buffer-display'" nil) + (const :tag "Split window and select" window) + (const :tag "Split window but don't select" window-noselect) + (const :tag "New frame" frame) + (const :tag "Don't display" bury) + (const :tag "Use current window" buffer) + (choice :tag "Defer to a display function" + (function-item display-buffer) + (function-item pop-to-buffer) + (function :tag "User-defined"))) + "Common choices for buffer-display options.") + +(defvaralias 'erc-join-buffer 'erc-buffer-display) +(defcustom erc-buffer-display 'bury + "How to display a newly created ERC buffer. +This determines ERC's baseline, \"catch-all\" buffer-display +behavior. It takes a backseat to more specific options, like +`erc-interactive-display', `erc-auto-reconnect-display', and +`erc-receive-query-display'. The available choices are: @@ -1479,41 +1765,93 @@ The available choices are: `frame' - in another frame, `bury' - bury it in a new buffer, `buffer' - in place of the current buffer, - any other value - in place of the current buffer." + DISPLAY-FUNCTION - a `display-buffer'-like function + +Here, DISPLAY-FUNCTION should accept a buffer and an ACTION of +the kind described by the Info node `(elisp) Choosing Window'. +At times, ERC may add hints about the calling context to the +ACTION's alist. Keys are symbols such as user options, like +`erc-buffer-display', or module minor modes, like +`erc-autojoin-mode'. Values are non-nil constants specific to +each. For this particular option, possible values include the +symbols + + `JOIN', `PRIVMSG', `NOTICE', `erc', and `erc-tls'. + +The first three signify IRC commands received from the server and +the rest entry-point commands responsible for the connection. +When dealing with the latter two, users may prefer to set this +option to `bury' and instead call DISPLAY-FUNCTION directly +on (server) buffers returned by these entry points because the +context leading to their creation is plainly obvious. For +additional details, see the Info node `(erc) display-buffer'. + +Note that when the selected window already shows the current +buffer, ERC pretends this option's value is `bury' unless the +variable `erc-skip-displaying-selected-window-buffer' is nil or +the value of this option is DISPLAY-FUNCTION." :package-version '(ERC . "5.5") :group 'erc-buffers - :type '(choice (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) - (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. - -WARNING: this option is bugged in ERC 5.5 (Emacs 29). Setting it -to anything other than nil results in the chosen value being -permanently adopted by all other buffer-display options for the -remainder of the ERC session. If you need this fixed -immediately, see Info node `(erc) Upgrading'." + :type (cons 'choice (nthcdr 2 erc--buffer-display-choices))) + +(defvaralias 'erc-query-display 'erc-interactive-display) +(defcustom erc-interactive-display 'window + "How to display buffers as a result of user interaction. +This affects commands like /QUERY and /JOIN when issued +interactively at the prompt. It does not apply when calling a +handler for such a command, like `erc-cmd-JOIN', from lisp code. +See `erc-buffer-display' for a full description of available +values. + +When the value is a user-provided function, ERC may inject a hint +about the invocation context as an extra item in the \"action +alist\" included as part of the second argument. The item's key +is the symbol `erc-interactive-display' and its value one of + + `/QUERY', `/JOIN', `/RECONNECT', `url', `erc', or `erc-tls'. + +All are symbols indicating an inciting user action, such as the +issuance of a slash command, the clicking of a URL hyperlink, or +the invocation of an entry-point command. See Info node `(erc) +display-buffer' for more." + :package-version '(ERC . "5.6") + :group 'erc-buffers + :type erc--buffer-display-choices) + +(defvaralias 'erc-reconnect-display 'erc-auto-reconnect-display) +(defcustom erc-auto-reconnect-display nil + "How to display a channel buffer when automatically reconnecting. +ERC ignores this option when a user issues a /RECONNECT or +successfully reinvokes `erc-tls' with similar arguments to those +from the prior connection. See `erc-buffer-display' for a +description of possible values. + +When the value is function, ERC may inject a hint about the +calling context as an extra item in the alist making up the tail +of the second, \"action\" argument. The item's key is the symbol +`erc-auto-reconnect-display' and its value something non-nil." :package-version '(ERC . "5.5") :group 'erc-buffers - :set (lambda (sym val) - (when (set sym val) - (lwarn 'erc :warning "Setting `%s' to `%s' is currently bugged; %s" - sym val "see doc string for more information."))) - :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))) + :type erc--buffer-display-choices) + +(defcustom erc-auto-reconnect-display-timeout 10 + "Duration `erc-auto-reconnect-display' remains active. +The countdown starts on MOTD and is canceled early by any +\"slash\" command." + :package-version '(ERC . "5.6") + :type 'integer + :group 'erc-buffers) + +(defcustom erc-reconnect-display-server-buffers nil + "Apply buffer-display options to server buffers when reconnecting. +By default, ERC does not consider `erc-auto-reconnect-display' +for server buffers when automatically reconnecting, nor does it +consider `erc-interactive-display' when users issue a /RECONNECT. +Enabling this tells ERC to always display server buffers +according to those options." + :package-version '(ERC . "5.6") + :type 'boolean + :group 'erc-buffers) (defcustom erc-frame-alist nil "Alist of frame parameters for creating erc frames. @@ -1531,20 +1869,29 @@ This only has effect when `erc-join-buffer' is set to `frame'." (defcustom erc-reuse-frames t "Determines whether new frames are always created. -Non-nil means that a new frame is not created to display an ERC -buffer if there is already a window displaying it. This only has -effect when `erc-join-buffer' is set to `frame'." +Non-nil means only create a frame for undisplayed buffers. Nil +means always create a new frame. Regardless of its value, ERC +ignores this option unless `erc-join-buffer' is `frame'. And +like most options in the `erc-buffer' customize group, this has +no effect on server buffers while reconnecting because ERC always +buries those." :group 'erc-buffers :type 'boolean) -(defun erc-channel-p (channel) - "Return non-nil if CHANNEL seems to be an IRC channel name." - (cond ((stringp channel) - (memq (aref channel 0) '(?# ?& ?+ ?!))) - ((and (bufferp channel) (buffer-live-p channel)) - (with-current-buffer channel - (erc-channel-p (erc-default-target)))) - (t nil))) +(defvar erc--fallback-channel-prefixes "#&" + "Prefix chars for distinguishing channel targets when CHANTYPES is unknown.") + +(defun erc-channel-p (target) + "Return non-nil if TARGET is a valid channel name or a channel buffer." + (cond ((stringp target) + (and-let* + (((not (string-empty-p target))) + (value (let ((entry (erc--get-isupport-entry 'CHANTYPES))) + (if entry (cadr entry) erc--fallback-channel-prefixes))) + ((erc--strpos (aref target 0) value))))) + ((and-let* (((buffer-live-p target)) + (target (buffer-local-value 'erc--target target)) + ((erc--target-channel-p target))))))) ;; For the sake of compatibility, a historical quirk concerning this ;; option, when nil, has been preserved: all buffers are suffixed with @@ -1680,7 +2027,10 @@ All strings are compared according to IRC protocol case rules, see (defun erc-get-buffer (target &optional proc) "Return the buffer matching TARGET in the process PROC. -If PROC is not supplied, all processes are searched." +Without PROC, search all ERC buffers. For historical reasons, +skip buffers for channels the client has \"PART\"ed or from which +it's been \"KICK\"ed. Expect users to use a different function +for finding targets independent of \"JOIN\"edness." (let ((downcased-target (erc-downcase target))) (catch 'buffer (erc-buffer-filter @@ -1701,8 +2051,9 @@ If PROC is not supplied, all processes are searched." (defun erc-buffer-filter (predicate &optional proc) "Return a list of `erc-mode' buffers matching certain criteria. -PREDICATE is a function executed with each buffer, if it returns t, that buffer -is considered a valid match. +Call PREDICATE without arguments in all ERC buffers or only those +belonging to a non-nil PROC. Expect it to return non-nil in +buffers that should be included in the returned list. PROC is either an `erc-server-process', identifying a certain server connection, or nil which means all open connections." @@ -1714,15 +2065,20 @@ server connection, or nil which means all open connections." (erc--buffer-p buf predicate proc))) (buffer-list))))) +(defalias 'erc-buffer-do 'erc-buffer-filter + "Call FUNCTION in all ERC buffers or only those for PROC. +Expect to be preferred over `erc-buffer-filter' in cases where +the return value goes unused. + +\(fn FUNCTION &optional PROC)") + (defun erc-buffer-list (&optional predicate proc) "Return a list of ERC buffers. PREDICATE is a function which executes with every buffer satisfying the predicate. If PREDICATE is passed as nil, return a list of all ERC buffers. If PROC is given, the buffers local variable `erc-server-process' needs to match PROC." - (unless predicate - (setq predicate (lambda () t))) - (erc-buffer-filter predicate proc)) + (erc-buffer-filter (or predicate #'always) proc)) (define-obsolete-function-alias 'erc-iswitchb #'erc-switch-to-buffer "25.1") (defun erc--switch-to-buffer (&optional arg) @@ -1826,51 +2182,77 @@ buffer rather than a server buffer.") ;; each item is in the format '(old . new) (delete-dups (mapcar #'erc--normalize-module-symbol mods))) -(defcustom erc-modules '(netsplit fill button match track completion readonly - networks ring autojoin noncommands irccontrols - move-to-prompt stamp menu list) - "A list of modules which ERC should enable. -If you set the value of this without using `customize' remember to call -\(erc-update-modules) after you change it. When using `customize', modules -removed from the list will be disabled." +(defun erc--sort-modules (modules) + "Return a copy of MODULES, deduped and led by sorted built-ins." + (let (built-in third-party) + (dolist (mod modules) + (setq mod (erc--normalize-module-symbol mod)) + (cl-pushnew mod (if (get mod 'erc--module) built-in third-party))) + `(,@(sort built-in #'string-lessp) ,@(nreverse third-party)))) + +;;;###autoload(custom-autoload 'erc-modules "erc") + +(defcustom erc-modules '( autojoin button completion fill imenu irccontrols + list match menu move-to-prompt netsplit + networks readonly ring stamp track) + "Modules to enable while connecting. +When modifying this option in lisp code, use a Custom-friendly +facilitator, like `setopt', or call `erc-update-modules' +afterward. This ensures a consistent ordering and disables +removed modules. It also gives packages access to the hook +`erc-before-connect'." :get (lambda (sym) ;; replace outdated names with their newer equivalents (erc-migrate-modules (symbol-value sym))) - :initialize #'custom-initialize-default + ;; Expect every built-in module to have the symbol property + ;; `erc--module' set to its canonical symbol (often itself). + :initialize (lambda (symbol exp) + ;; Use `cdddr' because (set :greedy t . ,entries) + (dolist (entry (cdddr (get 'erc-modules 'custom-type))) + (when-let* (((eq (car entry) 'const)) + (s (cadddr entry))) ; (const :tag "..." ,s) + (put s 'erc--module s))) + (custom-initialize-reset symbol exp)) :set (lambda (sym val) ;; disable modules which have just been removed (when (and (boundp 'erc-modules) erc-modules val) (dolist (module erc-modules) - (unless (member module val) + (unless (memq module val) (let ((f (intern-soft (format "erc-%s-mode" module)))) (when (and (fboundp f) (boundp f)) (when (symbol-value f) (message "Disabling `erc-%s'" module) (funcall f 0)) + ;; Disable local module in all ERC buffers. (unless (or (custom-variable-p f) (not (fboundp 'erc-buffer-filter))) (erc-buffer-filter (lambda () (when (symbol-value f) (funcall f 0)) (kill-local-variable f))))))))) - (set sym val) - ;; this test is for the case where erc hasn't been loaded yet + ;; Calling `set-default-toplevel-value' complicates testing. + (set sym (erc--sort-modules val)) + ;; Don't initialize modules on load, even though the rare + ;; third-party module may need it. (when (fboundp 'erc-update-modules) - (erc-update-modules))) + (unless erc--inside-mode-toggle-p + (erc-update-modules)))) :type '(set :greedy t (const :tag "autoaway: Set away status automatically" autoaway) (const :tag "autojoin: Join channels automatically" autojoin) + (const :tag "bufbar: Show ERC buffers in a side window" bufbar) (const :tag "button: Buttonize URLs, nicknames, and other text" button) (const :tag "capab: Mark unidentified users on servers supporting CAPAB" capab-identify) + (const :tag "command-indicator: Echo command lines." command-indicator) (const :tag "completion: Complete nicknames and commands (programmable)" completion) - (const :tag "hecomplete: Complete nicknames and commands (obsolete, use \"completion\")" hecomplete) (const :tag "dcc: Provide Direct Client-to-Client support" dcc) (const :tag "fill: Wrap long lines" fill) (const :tag "identd: Launch an identd server on port 8113" identd) + (const :tag "imenu: A simple Imenu integration" imenu) (const :tag "irccontrols: Highlight or remove IRC control characters" irccontrols) (const :tag "keep-place: Leave point above un-viewed text" keep-place) @@ -1882,13 +2264,15 @@ removed from the list will be disabled." move-to-prompt) (const :tag "netsplit: Detect netsplits" netsplit) (const :tag "networks: Provide data about IRC networks" networks) - (const :tag "noncommands: Don't display non-IRC commands after evaluation" + (const :tag "nickbar: Show nicknames in a dynamic side window" nickbar) + (const :tag "nicks: Uniquely colorize nicknames in target buffers" nicks) + (const :tag "noncommands: Deprecated. See module `command-indicator'." noncommands) + (const :tag "notifications: Desktop alerts on PRIVMSG or mentions" + notifications) (const :tag "notify: Notify when the online status of certain users changes" notify) - (const :tag "notifications: Send notifications on PRIVMSG or nickname mentions" - notifications) (const :tag "page: Process CTCP PAGE requests from IRC" page) (const :tag "readonly: Make displayed lines read-only" readonly) (const :tag "replace: Replace text in messages" replace) @@ -1901,40 +2285,130 @@ removed from the list will be disabled." (const :tag "smiley: Convert smileys to pretty icons" smiley) (const :tag "sound: Play sounds when you receive CTCP SOUND requests" sound) - (const :tag "stamp: Add timestamps to messages" stamp) (const :tag "spelling: Check spelling" spelling) + (const :tag "stamp: Add timestamps to messages" stamp) (const :tag "track: Track channel activity in the mode-line" track) (const :tag "truncate: Truncate buffers to a certain size" truncate) (const :tag "unmorse: Translate morse code in messages" unmorse) (const :tag "xdcc: Act as an XDCC file-server" xdcc) (repeat :tag "Others" :inline t symbol)) + :package-version '(ERC . "5.6") :group 'erc) (defun erc-update-modules () "Enable minor mode for every module in `erc-modules'. Except ignore all local modules, which were introduced in ERC 5.5." - (erc--update-modules) + (erc--update-modules erc-modules) nil) -(defun erc--update-modules () +(defvar erc--aberrant-modules nil + "Modules suspected of being improperly loaded.") + +(defun erc--warn-about-aberrant-modules () + (when (and erc--aberrant-modules (not erc--target)) + (erc-button--display-error-notice-with-keys-and-warn + "The following modules likely engage in unfavorable loading practices: " + (mapconcat (lambda (s) (format "`%s'" s)) erc--aberrant-modules ", ") + ". Please contact ERC with \\[erc-bug] if you believe this to be untrue." + " See Info:\"(erc) Module Loading\" for more.") + (setq erc--aberrant-modules nil))) + +(defvar erc--requiring-module-mode-p nil + "Non-nil while doing (require \\='erc-mymod) for `mymod' in `erc-modules'. +Used for inhibiting potentially recursive `erc-update-modules' +invocations by third-party packages.") + +(defun erc--find-mode (sym) + (setq sym (erc--normalize-module-symbol sym)) + (if-let ((mode (intern-soft (concat "erc-" (symbol-name sym) "-mode"))) + ((and (fboundp mode) + (autoload-do-load (symbol-function mode) mode))) + ((or (get sym 'erc--module) + (symbol-file mode) + (ignore (cl-pushnew sym erc--aberrant-modules))))) + mode + (and (or (and erc--requiring-module-mode-p + ;; Also likely non-nil: (eq sym (car features)) + (cl-pushnew sym erc--aberrant-modules)) + (let ((erc--requiring-module-mode-p t)) + (require (or (get sym 'erc--feature) + (intern (concat "erc-" (symbol-name sym)))) + nil 'noerror)) + (memq sym erc--aberrant-modules)) + (or mode (setq mode (intern-soft (concat "erc-" (symbol-name sym) + "-mode")))) + (fboundp mode) + mode))) + +(defun erc--update-modules (modules) (let (local-modes) - (dolist (module erc-modules local-modes) - (require (or (alist-get module erc--modules-to-features) - (intern (concat "erc-" (symbol-name module)))) - nil 'noerror) ; some modules don't have a corresponding feature - (let ((mode (intern-soft (concat "erc-" (symbol-name module) "-mode")))) - (unless (and mode (fboundp mode)) - (error "`%s' is not a known ERC module" module)) - (if (custom-variable-p mode) - (funcall mode 1) - (push mode local-modes)))))) + (dolist (module modules local-modes) + (if-let ((mode (erc--find-mode module))) + (if (custom-variable-p mode) + (funcall mode 1) + (push mode local-modes)) + (error "`%s' is not a known ERC module" module))))) + +(defvar erc--updating-modules-p nil + "Non-nil when running `erc--update-modules' in `erc-open'. +This allows global modules with known or likely dependents (or +some other reason for activating after session initialization) to +conditionally run setup code traditionally reserved for +`erc-mode-hook' in the setup portion of their mode toggle. Note +that being \"global\", they'll likely want to do so in all ERC +buffers and ensure the code is idempotent. For example: + + (add-hook \\='erc-mode-hook #\\='erc-foo-setup-fn) + (unless erc--updating-modules-p + (erc-with-all-buffers-of-server nil + (lambda () some-condition-p) + (erc-foo-setup-fn))) + +This means that when a dependent module is initializing and +realizes it's missing some required module \"foo\", it can +confidently call (erc-foo-mode 1) without having to learn +anything about the dependency's implementation.") + +(defvar erc--setup-buffer-hook '(erc--warn-about-aberrant-modules) + "Internal hook for module setup involving windows and frames.") + +(defvar erc--display-context nil + "Extra action alist items passed to `display-buffer'. +Non-nil when a user specifies a custom display action for certain +buffer-display options, like `erc-auto-reconnect-display'. ERC +pairs the option's symbol with a context-dependent value and adds +the entry to the user-provided alist when calling `pop-to-buffer' +or `display-buffer'.") + +(defvar erc-skip-displaying-selected-window-buffer t + "Whether to forgo showing a buffer that's already being displayed. +But only in the selected window. This is intended as a crutch +for non-user third-party code that might be slow to adopt the +`display-buffer' function variant available to all buffer-display +options starting in ERC 5.6. Users with rare requirements, like +wanting to change the window buffer to something other than the +one being processed, should see the Info node `(erc) +display-buffer'.") +(make-obsolete 'erc-show-already-displayed-buffer + "non-nil behavior to be made permanent" "30.1") + +(defvar-local erc--display-buffer-overriding-action nil + "The value of `display-buffer-overriding-action' when non-nil. +Influences the displaying of new or reassociated ERC buffers. +Reserved for use by built-in modules.") (defun erc-setup-buffer (buffer) "Consults `erc-join-buffer' to find out how to display `BUFFER'." (pcase (if (zerop (erc-with-server-buffer erc--server-last-reconnect-count)) erc-join-buffer - (or erc-reconnect-display erc-join-buffer)) + (or erc-auto-reconnect-display erc-join-buffer)) + ((and (pred functionp) disp-fn (let context erc--display-context)) + (unless (zerop erc--server-last-reconnect-count) + (push '(erc-auto-reconnect-display . t) context)) + (funcall disp-fn buffer (cons nil context))) + ((guard (and erc-skip-displaying-selected-window-buffer + (eq (window-buffer) buffer)))) ('window (if (active-minibuffer-window) (display-buffer buffer) @@ -1977,30 +2451,55 @@ nil." (cons (nreverse (car out)) (nreverse (cdr out)))) (list new-modes))) +;; This function doubles as a convenient helper for use in unit tests. +;; Prior to 5.6, its contents lived in `erc-open'. + +(defun erc--initialize-markers (old-point continued-session) + "Ensure prompt and its bounding markers have been initialized." + ;; FIXME erase assertions after code review and additional testing. + (setq erc-insert-marker (make-marker) + erc-input-marker (make-marker)) + (if continued-session + (progn + ;; Trust existing markers. + (set-marker erc-insert-marker + (alist-get 'erc-insert-marker continued-session)) + (set-marker erc-input-marker + (alist-get 'erc-input-marker continued-session)) + (set-marker-insertion-type erc-insert-marker t) + (cl-assert (= (field-end erc-insert-marker) erc-input-marker)) + (goto-char old-point) + (let ((erc--hidden-prompt-overlay + (alist-get 'erc--hidden-prompt-overlay continued-session))) + (erc--unhide-prompt))) + (cl-assert (not (get-text-property (point) 'erc-prompt))) + ;; In the original version from `erc-open', the snippet that + ;; handled these newline insertions appeared twice close in + ;; proximity, which was probably unintended. Nevertheless, we + ;; preserve the double newlines here for historical reasons. + (insert "\n\n") + (set-marker erc-insert-marker (point)) + (erc-display-prompt) + (set-marker-insertion-type erc-insert-marker t) + (cl-assert (= (point) (point-max))))) + (defun erc-open (&optional server port nick full-name - connect passwd tgt-list channel process + connect passwd _tgt-list channel process 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 -target given by CHANNEL, meaning these parameters are mutually -exclusive. Note that CHANNEL may also be a query; its name has -been retained for historical reasons. - -Use PASSWD as user password on the server. If TGT-LIST is -non-nil, use it to initialize `erc-default-recipients'. - -CLIENT-CERTIFICATE, if non-nil, should either be a list where the -first element is the file name of the private key corresponding -to a client certificate and the second element is the file name -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." + "Return a new or reinitialized server or target buffer. +If CONNECT is non-nil, connect to SERVER and return its new or +reassociated buffer. Otherwise, assume PROCESS is non-nil and belongs +to an active session, and return a new or refurbished target buffer for +CHANNEL, which may also be a query target (the parameter name remains +for historical reasons). Pass SERVER, PORT, NICK, USER, FULL-NAME, and +PASSWD to `erc-determine-parameters' for preserving as session-local +variables. Do something similar for CLIENT-CERTIFICATE and ID, which +should be as described by `erc-tls'. + +Note that ERC ignores TGT-LIST and initializes `erc-default-recipients' +with CHANNEL as its only member. Note also that this function has the +side effect of setting the current buffer to the one it returns. Use +`with-current-buffer' or `save-excursion' to nullify this effect." (let* ((target (and channel (erc--target-from-string channel))) (buffer (erc-get-buffer-create server port nil target id)) (old-buffer (current-buffer)) @@ -2010,15 +2509,20 @@ Returns the buffer for the given server or channel." (old-recon-count erc-server-reconnect-count) (old-point nil) (delayed-modules nil) - (continued-session (and erc--server-reconnecting - (with-suppressed-warnings - ((obsolete erc-reuse-buffers)) - erc-reuse-buffers)))) + (continued-session (or erc--server-reconnecting + erc--target-priors + (and-let* (((not target)) + (m (buffer-local-value + 'erc-input-marker buffer)) + ((marker-position m))) + (buffer-local-variables buffer))))) (when connect (run-hook-with-args 'erc-before-connect server port nick)) (set-buffer buffer) (setq old-point (point)) (setq delayed-modules - (erc--merge-local-modes (erc--update-modules) + (erc--merge-local-modes (let ((erc--updating-modules-p t)) + (erc--update-modules + (erc--sort-modules erc-modules))) (or erc--server-reconnecting erc--target-priors))) @@ -2031,23 +2535,8 @@ Returns the buffer for the given server or channel." (buffer-local-value 'erc-server-announced-name old-buffer))) ;; connection parameters (setq erc-server-process process) - (setq erc-insert-marker (make-marker)) - (setq erc-input-marker (make-marker)) - ;; go to the end of the buffer and open a new line - ;; (the buffer may have existed) - (goto-char (point-max)) - (forward-line 0) - (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) - (point-max)))) - (unless continued-session - (goto-char (point-max)) - (insert "\n")) - (set-marker erc-insert-marker (point)) ;; stack of default recipients - (setq erc-default-recipients tgt-list) + (when channel (setq erc-default-recipients (list channel))) (when target (setq erc--target target erc-network (erc-network))) @@ -2091,21 +2580,8 @@ Returns the buffer for the given server or channel." (when erc-log-p (get-buffer-create (concat "*ERC-DEBUG: " server "*")))) + (erc--initialize-markers old-point continued-session) (erc-determine-parameters server port nick full-name user passwd) - - ;; FIXME consolidate this prompt-setup logic with the pass above. - - ;; set up prompt - (unless continued-session - (goto-char (point-max)) - (insert "\n")) - (if continued-session - (progn (goto-char old-point) - (erc--unhide-prompt)) - (set-marker erc-insert-marker (point)) - (erc-display-prompt) - (goto-char (point-max))) - (save-excursion (run-mode-hooks) (dolist (mod (car delayed-modules)) (funcall mod +1)) (dolist (var (cdr delayed-modules)) (set var nil))) @@ -2121,12 +2597,18 @@ Returns the buffer for the given server or channel." (erc-update-mode-line)) ;; Now display the buffer in a window as per user wishes. - (unless (eq buffer old-buffer) + (when (eq buffer old-buffer) (cl-assert (and connect (not target)))) + (unless (and (not erc-reconnect-display-server-buffers) + (eq buffer old-buffer)) (when erc-log-p ;; we can't log to debug buffer, it may not exist yet (message "erc: old buffer %s, switching to %s" old-buffer buffer)) - (erc-setup-buffer buffer)) + (let ((display-buffer-overriding-action + (or erc--display-buffer-overriding-action + display-buffer-overriding-action))) + (erc-setup-buffer buffer) + (run-hooks 'erc--setup-buffer-hook))) buffer)) @@ -2168,18 +2650,20 @@ in here get called with three parameters, SERVER, PORT and NICK." :type '(repeat function)) (defcustom erc-after-connect nil - "Functions called after connecting to a server. -This functions in this variable gets executed when an end of MOTD -has been received. All functions in here get called with the -parameters SERVER and NICK." + "Abnormal hook run upon establishing a logical IRC connection. +Runs on MOTD's end when `erc-server-connected' becomes non-nil. +ERC calls members with `erc-server-announced-name', falling back +to the 376/422 message's \"sender\", as well as the current nick, +as given by the 376/422 message's \"target\" parameter, which is +typically the same as that reported by `erc-current-nick'." :group 'erc-hooks :type '(repeat function)) (defun erc--ensure-url (input) (unless (string-match (rx bot "irc" (? "6") (? "s") "://") input) - (when (and (string-match (rx (? (+ any) "@") - (or (group (* (not "[")) ":" (* any)) - (+ any)) + (when (and (string-match (rx (? (+ nonl) "@") + (or (group (* (not "[")) ":" (* nonl)) + (+ nonl)) ":" (+ (not (any ":]"))) eot) input) (match-beginning 1)) @@ -2187,30 +2671,20 @@ parameters SERVER and NICK." (setq input (concat "irc://" input))) input) -;; A temporary means of addressing the problem of ERC's namesake entry -;; point defaulting to a non-TLS connection with its default server -;; (bug#60428). -(defun erc--warn-unencrypted () - ;; Remove unconditionally to avoid wrong context due to races from - ;; simultaneous dialing or aborting (e.g., via `keyboard-quit'). - (remove-hook 'erc--server-post-connect-hook #'erc--warn-unencrypted) - (when (and (process-contact erc-server-process :nowait) - (equal erc-session-server erc-default-server) - (eql erc-session-port erc-default-port)) - ;; FIXME use the autoloaded `info' instead of `Info-goto-node' in - ;; `erc-button-alist'. - (require 'info nil t) - (erc-display-error-notice - nil (concat "This connection is unencrypted. Please use `erc-tls'" - " from now on. See Info:\"(erc) connecting\" for more.")))) +(defvar erc--prompt-for-server-function nil) ;;;###autoload (defun erc-select-read-args () - "Prompt the user for values of nick, server, port, and password." - (require 'url-parse) + "Prompt for connection parameters and return them in a plist. +By default, collect `:server', `:port', `:nickname', and +`:password'. With a non-nil prefix argument, also prompt for +`:user' and `:full-name'. Also return various environmental +properties needed by entry-point commands, like `erc-tls'." (let* ((input (let ((d (erc-compute-server))) - (read-string (format "Server (default is %S): " d) - nil 'erc-server-history-list d))) + (if erc--prompt-for-server-function + (funcall erc--prompt-for-server-function) + (read-string (format-prompt "Server or URL" d) + nil 'erc-server-history-list d)))) ;; For legacy reasons, also accept a URL without a scheme. (url (url-generic-parse-url (erc--ensure-url input))) (server (url-host url)) @@ -2218,29 +2692,66 @@ parameters SERVER and NICK." (port (or (url-portspec url) (erc-compute-port (let ((d (erc-compute-port sp))) ; may be a string - (read-string (format "Port (default is %s): " d) + (read-string (format-prompt "Port" d) nil nil d))))) ;; Trust the user not to connect twice accidentally. We ;; can't use `erc-already-logged-in' to check for an existing ;; connection without modifying it to consider USER and PASS. (nick (or (url-user url) (let ((d (erc-compute-nick))) - (read-string (format "Nickname (default is %S): " d) + (read-string (format-prompt "Nickname" d) nil 'erc-nick-history-list d)))) + (user (and current-prefix-arg + (let ((d (erc-compute-user (url-user url)))) + (read-string (format-prompt "User" d) + nil nil d)))) + (full (and current-prefix-arg + (let ((d (erc-compute-full-name (url-user url)))) + (read-string (format-prompt "Full name" d) + nil nil d)))) (passwd (let* ((p (with-suppressed-warnings ((obsolete erc-password)) (or (url-password url) erc-password))) (m (if p - (format "Server password (default is %S): " p) + (format-prompt "Server password" p) "Server password (optional): "))) - (if erc-prompt-for-password (read-passwd m nil p) p)))) + (if erc-prompt-for-password (read-passwd m nil p) p))) + (opener (and (or sp (eql port erc-default-port-tls) + (and (equal server erc-default-server) + (not (string-prefix-p "irc://" input)) + (eql port erc-default-port) + (y-or-n-p "Connect using TLS instead? ") + (setq port erc-default-port-tls))) + #'erc-open-tls-stream)) + env) + (when erc-interactive-display + (push `(erc-join-buffer . ,erc-interactive-display) env)) + (when erc--display-context + (push `(erc--display-context . ,erc--display-context) env)) + (when opener + (push `(erc-server-connect-function . ,opener) env)) (when (and passwd (string= "" passwd)) (setq passwd nil)) - (when (and (equal server erc-default-server) - (eql port erc-default-port) - (not (eql port erc-default-port-tls)) ; not `erc-tls' - (not (string-prefix-p "irc://" input))) ; not yanked URL - (add-hook 'erc--server-post-connect-hook #'erc--warn-unencrypted)) - (list :server server :port port :nick nick :password passwd))) + `( :server ,server :port ,port :nick ,nick ,@(and user `(:user ,user)) + ,@(and passwd `(:password ,passwd)) ,@(and full `(:full-name ,full)) + ,@(and env `(--interactive-env-- ,env))))) + +(defmacro erc--with-entrypoint-environment (env &rest body) + "Run BODY with bindings from ENV alist." + (declare (indent 1)) + (let ((syms (make-symbol "syms")) + (vals (make-symbol "vals"))) + `(let (,syms ,vals) + (pcase-dolist (`(,k . ,v) ,env) (push k ,syms) (push v ,vals)) + (cl-progv ,syms ,vals + ,@body)))) + +;;;###autoload +(defun erc-server-select () + "Interactively connect to a server from `erc-server-alist'." + (declare (obsolete erc-tls "30.1")) + (interactive) + (let ((erc--prompt-for-server-function #'erc-networks--server-select)) + (call-interactively #'erc))) ;;;###autoload (cl-defun erc (&key (server (erc-compute-server)) @@ -2249,32 +2760,53 @@ parameters SERVER and NICK." (user (erc-compute-user)) password (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. - -It allows selecting connection parameters, and then starts ERC. - -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 + id + ;; Used by interactive form + ((--interactive-env-- --interactive-env--))) + "Connect to an Internet Relay Chat SERVER on a non-TLS PORT. +Use NICK and USER, when non-nil, to inform the IRC commands of +the same name, possibly factoring in a non-nil FULL-NAME as well. +When PASSWORD is non-nil, also send an opening server password +via the \"PASS\" command. Interactively, prompt for SERVER, +PORT, NICK, and PASSWORD, along with USER and FULL-NAME when +given a prefix argument. Non-interactively, expect the rarely +needed ID parameter, when non-nil, to be a symbol or a string for +naming the server buffer and identifying the connection +unequivocally. Once connected, return the server buffer. (See +Info node `(erc) Connecting' for details about all mentioned +parameters.) + +Together with `erc-tls', this command serves as the main entry +point for ERC, the powerful, modular, and extensible IRC client. +Non-interactively, both commands accept the following keyword +arguments, with their defaults supplied by the indicated +\"compute\" functions: + + :server `erc-compute-server' + :port `erc-compute-port' + :nick `erc-compute-nick' + :user `erc-compute-user' + :password N/A + :full-name `erc-compute-full-name' + :id' N/A + +For example, when called in the following manner (erc :server \"irc.libera.chat\" :full-name \"J. Random Hacker\") -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. +ERC assigns SERVER and FULL-NAME the associated keyword values +and defers to `erc-compute-port', `erc-compute-user', and +`erc-compute-nick' for those respective parameters. -See `erc-tls' for the meaning of ID." - (interactive (erc-select-read-args)) - (erc-open server port nick full-name t password nil nil nil nil user id)) +\(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME ID)" + (interactive (let ((erc--display-context `((erc-interactive-display . erc) + ,@erc--display-context))) + (erc-select-read-args))) + (unless (assq 'erc--display-context --interactive-env--) + (push '(erc--display-context . ((erc-buffer-display . erc))) + --interactive-env--)) + (erc--with-entrypoint-environment --interactive-env-- + (erc-open server port nick full-name t password nil nil nil nil user id))) ;;;###autoload (defalias 'erc-select #'erc) @@ -2288,54 +2820,47 @@ See `erc-tls' for the meaning of ID." password (full-name (erc-compute-full-name)) client-certificate - id) - "ERC is a powerful, modular, and extensible IRC client. -This function is the main entry point for ERC over TLS. - -It allows selecting connection parameters, and then starts ERC -over TLS. - -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)) - client-certificate - id - -That is, if called with - - (erc-tls :server \"irc.libera.chat\" :full-name \"J. Random Hacker\") - -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 their respective parameters. - -CLIENT-CERTIFICATE, if non-nil, should either be a list where the -first element is the certificate key file name, and the second -element is the certificate file name itself, or t, which means -that `auth-source' will be queried for the key and the -certificate. Authenticating using a TLS client certificate is -also referred to as \"CertFP\" (Certificate Fingerprint) -authentication by various IRC networks. - -Example usage: + id + ;; Used by interactive form + ((--interactive-env-- --interactive-env--))) + "Connect to an IRC server over a TLS-encrypted connection. +Interactively, prompt for SERVER, PORT, NICK, and PASSWORD, along +with USER and FULL-NAME when given a prefix argument. +Non-interactively, also accept a CLIENT-CERTIFICATE, which should +be a list containing the file name of the certificate's key +followed by that of the certificate itself. Alternatively, +accept a value of t instead of a list, to tell ERC to query +`auth-source' for the certificate's details. + +Example client certificate (CertFP) usage: (erc-tls :server \"irc.libera.chat\" :port 6697 :client-certificate \\='(\"/home/bandali/my-cert.key\" \"/home/bandali/my-cert.crt\")) -When present, ID should be a symbol or a string to use for naming -the server buffer and identifying the connection unequivocally. -See Info node `(erc) Network Identifier' for details. Like USER -and CLIENT-CERTIFICATE, this parameter cannot be specified -interactively." - (interactive (let ((erc-default-port erc-default-port-tls)) - (erc-select-read-args))) - (let ((erc-server-connect-function 'erc-open-tls-stream)) +See the alternative entry-point command `erc' as well as Info +node `(erc) Connecting' for a fuller description of the various +parameters, like ID. + +\(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME CLIENT-CERTIFICATE ID)" + (interactive + (let ((erc-default-port erc-default-port-tls) + (erc--display-context `((erc-interactive-display . erc-tls) + ,@erc--display-context))) + (erc-select-read-args))) + ;; Bind `erc-server-connect-function' to `erc-open-tls-stream' + ;; around `erc-open' when a non-default value hasn't been specified + ;; by the user or the interactive form. And don't bother checking + ;; for advice, indirect functions, autoloads, etc. + (unless (or (assq 'erc-server-connect-function --interactive-env--) + (not (eq erc-server-connect-function #'erc-open-network-stream))) + (push '(erc-server-connect-function . erc-open-tls-stream) + --interactive-env--)) + (unless (assq 'erc--display-context --interactive-env--) + (push '(erc--display-context . ((erc-buffer-display . erc-tls))) + --interactive-env--)) + (erc--with-entrypoint-environment --interactive-env-- (erc-open server port nick full-name t password nil nil nil client-certificate user id))) @@ -2352,6 +2877,25 @@ PARAMETERS should be a sequence of keywords and values, per (setq args `(,name ,buffer ,host ,port ,@p)) (apply #'open-network-stream args))) +(defun erc-open-socks-tls-stream (name buffer host service &rest parameters) + "Connect to an IRC server via SOCKS proxy over TLS. +Defer to the `socks' and `gnutls' libraries to make the actual +connection and perform TLS negotiation. Expect SERVICE to be a +TLS port number and that the plist PARAMETERS contains a +`:client-certificate' pair when necessary. Otherwise, assume the +arguments NAME, BUFFER, and HOST to be acceptable to +`open-network-stream' and that users know to check out +`erc-server-connect-function' and Info node `(erc) SOCKS' for +more info, including an important example of how to \"wrap\" this +function with SOCKS credentials." + (require 'gnutls) + (require 'socks) + (let ((proc (socks-open-network-stream name buffer host service)) + (cert-info (plist-get parameters :client-certificate))) + (gnutls-negotiate :process proc + :hostname host + :keylist (and cert-info (list cert-info))))) + ;;; Displaying error messages (defun erc-error (&rest args) @@ -2363,6 +2907,15 @@ message instead, to make debugging easier." (apply #'message args) (beep))) +(defvar erc--warnings-buffer-name nil + "Name of possibly existing alternate warnings buffer for unit tests.") + +(defun erc--lwarn (type level format-string &rest args) + "Issue a warning of TYPE and LEVEL with FORMAT-STRING and ARGS." + (let ((message (substitute-command-keys + (apply #'format-message format-string args)))) + (display-warning type message level erc--warnings-buffer-name))) + ;;; Debugging the protocol (defvar erc-debug-irc-protocol-time-format "%FT%T.%6N%z " @@ -2508,15 +3061,75 @@ If ARG is non-nil, show the *erc-protocol* buffer." ;; send interface +(defvar erc--send-action-function #'erc--send-action + "Function to display and send an outgoing CTCP ACTION message. +Called with three arguments: the submitted input, the current +target, and an `erc-server-send' FORCE flag.") + (defun erc-send-action (tgt str &optional force) "Send CTCP ACTION information described by STR to TGT." - (erc-send-ctcp-message tgt (format "ACTION %s" str) force) - (erc-display-message - nil 'input (current-buffer) - 'ACTION ?n (erc-current-nick) ?a str ?u "" ?h "")) + (funcall erc--send-action-function tgt str force)) + +;; Sending and displaying are provided separately to afford modules +;; more flexibility, e.g., to forgo displaying on the way out when +;; expecting the server to echo messages back and/or to associate +;; outgoing messages with IDs generated for `erc--ephemeral' +;; placeholders. +(defun erc--send-action-perform-ctcp (target string force) + "Send STRING to TARGET, possibly immediately, with FORCE." + (erc-send-ctcp-message target (format "ACTION %s" string) force)) + +(defvar erc--use-language-catalog-for-ctcp-action-p nil + "When non-nil, use `ACTION' entry from language catalog for /ME's. +Otherwise, use `ctcp-action' or `ctcp-action-input' from the +internal `-speaker' catalog. This is an escape hatch to restore +pre-5.6 behavior for the `font-lock-face' property of incoming +and outgoing \"CTCP ACTION\" messages, whose pre-buttonized state +was a single interval of `erc-input-face' or `erc-action-face'. +Newer modules, like `fill-wrap' and `nicks', are incompatible with +this format style. If you use this, please ask ERC to expose it +as a public variable via \\[erc-bug] or similar.") + +(defun erc--send-action-display (string) + "Display STRING as an outgoing \"CTCP ACTION\" message. +Propertize the message according to the compatibility flag +`erc--use-language-catalog-for-ctcp-action-p'." + ;; Allow hooks acting on inserted PRIVMSG and NOTICES to process us. + (let ((erc--msg-prop-overrides `((erc--ctcp . ACTION) + ,@erc--msg-prop-overrides)) + (nick (erc-current-nick))) + (if erc--use-language-catalog-for-ctcp-action-p + (progn (erc--ensure-spkr-prop nick) + (erc-display-message nil 'input (current-buffer) 'ACTION + ?n (propertize nick 'erc--speaker nick) + ?a string ?u "" ?h "")) + (let ((erc-current-message-catalog erc--message-speaker-catalog)) + (erc-display-message nil nil (current-buffer) 'ctcp-action-input + ?p (erc-get-channel-membership-prefix nick) + ?n (erc--speakerize-nick nick) ?m string))))) + +(defun erc--send-action (target string force) + "Display STRING, then send to TARGET as a \"CTCP ACTION\" message." + (erc--send-action-display string) + (erc--send-action-perform-ctcp target string force)) ;; Display interface +(defun erc--ensure-spkr-prop (nick &optional overrides) + "Add NICK as `erc--spkr' to the current \"msg props\" environment. +Prefer `erc--msg-props' over `erc--msg-prop-overrides' when both +are available. Also include any members of the alist OVERRIDES, +when present. Assume NICK itself to be free of any text props, +and return it." + (cond (erc--msg-props + (puthash 'erc--spkr nick erc--msg-props) + (dolist (entry overrides) + (puthash (car entry) (cdr entry) erc--msg-props))) + (erc--msg-prop-overrides + (setq erc--msg-prop-overrides + `((erc--spkr . ,nick) ,@overrides ,@erc--msg-prop-overrides)))) + nick) + (defun erc-string-invisible-p (string) "Check whether STRING is invisible or not. I.e. any char in it has the `invisible' property set." @@ -2527,34 +3140,236 @@ I.e. any char in it has the `invisible' property set." The default is to remove it, since it causes ERC to take up extra memory. If you have code that relies on this property, then set -this option to nil." +this option to nil. + +Note that this option is deprecated because a value of nil is +impractical in prolonged sessions with more than a few channels. +Use `erc-insert-post-hook' or similar and the helper function +`erc-find-parsed-property' and friends to stash the current +`erc-response' object as needed. And instead of using this for +debugging purposes, try `erc-debug-irc-protocol'." :type 'boolean :group 'erc) - -(defun erc-display-line-1 (string buffer) - "Display STRING in `erc-mode' BUFFER. -Auxiliary function used in `erc-display-line'. The line gets filtered to -interpret the control characters. Then, `erc-insert-pre-hook' gets called. -If `erc-insert-this' is still t, STRING gets inserted into the buffer. -Afterwards, `erc-insert-modify' and `erc-insert-post-hook' get called. -If STRING is nil, the function does nothing." +(make-obsolete-variable 'erc-remove-parsed-property + "impractical when non-nil" "30.1") + +(define-inline erc--assert-input-bounds () + (inline-quote + (progn (when (and (processp erc-server-process) + (eq (current-buffer) (process-buffer erc-server-process))) + ;; It's believed that these only need syncing immediately + ;; following the first two insertions in a server buffer. + (set-marker (process-mark erc-server-process) erc-insert-marker)) + (cl-assert (< erc-insert-marker erc-input-marker)) + (cl-assert (= (field-end erc-insert-marker) erc-input-marker))))) + +(defvar erc--merge-prop-behind-p nil + "When non-nil, put merged prop(s) behind existing.") + +(defvar erc--refresh-prompt-hook nil + "Hook called after refreshing the prompt in the affected buffer.") + +(defvar-local erc--inhibit-prompt-display-property-p nil + "Tell `erc-prompt' related functions to avoid the `display' text prop. +Modules can enable this when needing to reserve the prompt's +display property for some other purpose, such as displaying it +elsewhere, abbreviating it, etc.") + +(defconst erc--prompt-properties '( rear-nonsticky t + erc-prompt t ; t or `hidden' + field erc-prompt + front-sticky t + read-only t) + "Mandatory text properties added to ERC's prompt.") + +(defvar erc--refresh-prompt-continue-request nil + "State flag for refreshing prompt in all buffers. +When the value is zero, functions assigned to the variable +`erc-prompt' can set this to run `erc--refresh-prompt-hook' (1) +or `erc--refresh-prompt' (2) in all buffers of the server.") + +(defun erc--refresh-prompt-continue (&optional hooks-only-p) + "Ask ERC to refresh the prompt in all buffers. +Functions assigned to `erc-prompt' can call this if needing to +recreate the prompt in other buffers as well. With HOOKS-ONLY-P, +run `erc--refresh-prompt-hook' in other buffers instead of doing +a full refresh." + (when (and erc--refresh-prompt-continue-request + (zerop erc--refresh-prompt-continue-request)) + (setq erc--refresh-prompt-continue-request (if hooks-only-p 1 2)))) + +(defun erc--refresh-prompt () + "Re-render ERC's prompt when the option `erc-prompt' is a function." + (erc--assert-input-bounds) + (unless (erc--prompt-hidden-p) + (let ((erc--refresh-prompt-continue-request + (or erc--refresh-prompt-continue-request 0))) + (when (functionp erc-prompt) + (save-excursion + (goto-char (1- erc-input-marker)) + ;; Avoid `erc-prompt' (the named function), which appends a + ;; space, and `erc-display-prompt', which propertizes all + ;; but that space. + (let ((s (funcall erc-prompt)) + (p (point)) + (erc--merge-prop-behind-p t)) + (erc--merge-prop 0 (length s) 'font-lock-face 'erc-prompt-face s) + (add-text-properties 0 (length s) erc--prompt-properties s) + (insert s) + (delete-region erc-insert-marker p)))) + (run-hooks 'erc--refresh-prompt-hook) + (when-let (((> erc--refresh-prompt-continue-request 0)) + (n erc--refresh-prompt-continue-request) + (erc--refresh-prompt-continue-request -1) + (b (current-buffer))) + (erc-with-all-buffers-of-server erc-server-process + (lambda () (not (eq b (current-buffer)))) + (if (= n 1) + (run-hooks 'erc--refresh-prompt-hook) + (erc--refresh-prompt))))))) + +(defun erc--check-msg-prop (prop &optional val) + "Return PROP's value in `erc--msg-props' when populated. +If VAL is a list, return non-nil if PROP appears in VAL. If VAL +is otherwise non-nil, return non-nil if VAL compares `eq' to the +stored value. Otherwise, return the stored value." + (and-let* ((erc--msg-props) + (v (gethash prop erc--msg-props))) + (if (consp val) (memq v val) (if val (eq v val) v)))) + +(defmacro erc--get-inserted-msg-beg-at (point at-start-p) + (macroexp-let2* nil ((point point) + (at-start-p at-start-p)) + `(or (and ,at-start-p ,point) + (and-let* ((p (previous-single-property-change ,point 'erc--msg))) + (if (and (= p (1- ,point)) (get-text-property p 'erc--msg)) + p + (1- p)))))) + +(defmacro erc--get-inserted-msg-end-at (point at-start-p) + (macroexp-let2 nil point point + `(1- (next-single-property-change (if ,at-start-p (1+ ,point) ,point) + 'erc--msg nil erc-insert-marker)))) + +(defun erc--get-inserted-msg-beg (&optional point) + "Maybe return the start of message in an ERC buffer." + (erc--get-inserted-msg-beg-at (or point (setq point (point))) + (get-text-property point 'erc--msg))) + +(defun erc--get-inserted-msg-end (&optional point) + "Return the end of message in an ERC buffer. +Include any trailing white space before final newline. Expect +POINT to be less than `erc-insert-marker', and don't bother +considering `erc--insert-marker', for now." + (erc--get-inserted-msg-end-at (or point (setq point (point))) + (get-text-property point 'erc--msg))) + +(defun erc--get-inserted-msg-bounds (&optional point) + "Return bounds of message at POINT in an ERC buffer when found. +Search from POINT, when non-nil, instead of `point'. Return nil +if not found." + (let ((at-start-p (get-text-property (or point (setq point (point))) + 'erc--msg))) + (and-let* ((b (erc--get-inserted-msg-beg-at point at-start-p))) + (cons b (erc--get-inserted-msg-end-at point at-start-p))))) + +(defun erc--get-inserted-msg-prop (prop) + "Return the value of text property PROP for some message at point." + (and-let* ((stack-pos (erc--get-inserted-msg-beg (point)))) + (get-text-property stack-pos prop))) + +(defmacro erc--with-inserted-msg (&rest body) + "Simulate narrowing performed for send and insert hooks, and run BODY. +Expect callers to know that this doesn't wrap BODY in +`with-silent-modifications' or bind a temporary `erc--msg-props'." + `(when-let ((bounds (erc--get-inserted-msg-bounds))) + (save-restriction + (narrow-to-region (car bounds) (1+ (cdr bounds))) + ,@body))) + +(defun erc--traverse-inserted (beg end fn) + "Visit messages between BEG and END and run FN in narrowed buffer. +If END is a marker, possibly update its position." + (unless (markerp end) + (setq end (set-marker (make-marker) (or end erc-insert-marker)))) + (unless (eq end erc-insert-marker) + (set-marker end (min erc-insert-marker end))) + (save-excursion + (goto-char beg) + (let ((b (if (get-text-property (point) 'erc--msg) + (point) + (next-single-property-change (point) 'erc--msg nil end)))) + (while-let ((b) + ((< b end)) + (e (next-single-property-change (1+ b) 'erc--msg nil end))) + (save-restriction + (narrow-to-region b e) + (funcall fn)) + (setq b e)))) + (unless (eq end erc-insert-marker) + (set-marker end nil))) + +(defvar erc--insert-invisible-as-intangible-p nil + "When non-nil, ensure certain invisible messages are also intangible. +That is, single out any message inserted via `erc-insert-line' +that lacks a trailing newline but has a t-valued `invisible' +property anywhere along its length, and ensure it's both +`invisible' t and `intangible' t throughout. Note that this is +merely an escape hatch for accessing aberrant pre-5.6 behavior +that ERC considers a bug because it applies a practice described +as obsolete in the manual, and it does so heavy-handedly. That +the old behavior only acted when the input lacked a trailing +newline was likely accidental but is ultimately incidental. See +info node `(elisp) Special Properties' for specifics. Beware +that this flag and the behavior it restores may disappear at any +time, so if you need them, please let ERC know with \\[erc-bug].") + +(defvar erc--insert-line-function nil + "When non-nil, an alterntive to `insert' for inserting messages.") + +(defvar erc--insert-marker nil + "Internal override for `erc-insert-marker'.") + +(define-obsolete-function-alias 'erc-display-line-1 'erc-insert-line "30.1") +(defun erc-insert-line (string buffer) + "Insert STRING in an `erc-mode' BUFFER. +When STRING is nil, do nothing. Otherwise, start off by running +`erc-insert-pre-hook' in BUFFER with `erc-insert-this' bound to +t. If the latter remains non-nil afterward, insert STRING into +BUFFER, ensuring a trailing newline. After that, narrow BUFFER +around STRING, along with its final line ending, and run +`erc-insert-modify' and `erc-insert-post-hook', respectively. In +all cases, run `erc-insert-done-hook' unnarrowed before exiting, +and update positions in `buffer-undo-list'. + +In general, expect to be called from a higher-level insertion +function, like `erc-display-message', especially when modules +should consider STRING as a candidate for formatting with +enhancements like indentation, fontification, timestamping, etc. +Otherwise, when called directly, allow built-in modules to ignore +STRING, which may make it appear incongruous in situ (unless +preformatted or anticipated by third-party members of the various +modification hooks)." (when string (with-current-buffer (or buffer (process-buffer erc-server-process)) - (let ((insert-position (or (marker-position erc-insert-marker) - (point-max)))) - (let ((string string) ;; FIXME! Can this be removed? - (buffer-undo-list t) + (let (insert-position) + ;; Initialize ^ below to thwart rogue `erc-insert-pre-hook' + ;; members that dare to modify the buffer's length. + (let ((buffer-undo-list t) (inhibit-read-only t)) - (unless (string-match "\n$" string) + (unless (string-suffix-p "\n" string) (setq string (concat string "\n")) - (when (erc-string-invisible-p string) + (when (and erc--insert-invisible-as-intangible-p + (erc-string-invisible-p string)) (erc-put-text-properties 0 (length string) '(invisible intangible) string))) - (erc-log (concat "erc-display-line: " string + (erc-log (concat "erc-display-message: " string (format "(%S)" string) " in buffer " (format "%s" buffer))) (setq erc-insert-this t) (run-hook-with-args 'erc-insert-pre-hook string) + (setq insert-position (marker-position (or erc--insert-marker + erc-insert-marker))) (if (null erc-insert-this) ;; Leave erc-insert-this set to t as much as possible. Fran ;; Litterio <franl> has seen erc-insert-this set to nil while @@ -2565,7 +3380,10 @@ If STRING is nil, the function does nothing." (save-restriction (widen) (goto-char insert-position) - (insert-before-markers string) + (if erc--insert-line-function + (funcall erc--insert-line-function string) + (insert string)) + (erc--assert-input-bounds) ;; run insertion hook, with point at restored location (save-restriction (narrow-to-region insert-position (point)) @@ -2573,9 +3391,17 @@ If STRING is nil, the function does nothing." (run-hooks 'erc-insert-post-hook) (when erc-remove-parsed-property (remove-text-properties (point-min) (point-max) - '(erc-parsed nil)))))))) + '(erc-parsed nil tags nil))) + (cl-assert (> (- (point-max) (point-min)) 1)) + (let ((props (if erc--msg-props + (erc--order-text-properties-from-hash + erc--msg-props) + '(erc--msg unknown)))) + (add-text-properties (point-min) (1+ (point-min)) props))) + (erc--refresh-prompt))))) (run-hooks 'erc-insert-done-hook) - (erc-update-undo-list (- (or (marker-position erc-insert-marker) + (erc-update-undo-list (- (or (marker-position (or erc--insert-marker + erc-insert-marker)) (point-max)) insert-position)))))) @@ -2609,37 +3435,211 @@ If STRING is nil, the function does nothing." "Check if NICK is a valid IRC nickname." (string-match (concat "\\`" erc-valid-nick-regexp "\\'") nick)) -(defun erc-display-line (string &optional buffer) - "Display STRING in the ERC BUFFER. -All screen output must be done through this function. If BUFFER is nil -or omitted, the default ERC buffer for the `erc-session-server' is used. -The BUFFER can be an actual buffer, a list of buffers, `all' or `active'. -If BUFFER = `all', the string is displayed in all the ERC buffers for the -current session. `active' means the current active buffer -\(`erc-active-buffer'). If the buffer can't be resolved, the current -buffer is used. `erc-display-line-1' is used to display STRING. - -If STRING is nil, the function does nothing." - (let (new-bufs) +(defun erc--route-insertion (string buffer) + "Insert STRING in BUFFER. +See `erc-display-message' for acceptable BUFFER types." + (let (seen msg-props) (dolist (buf (cond ((bufferp buffer) (list buffer)) - ((listp buffer) buffer) + ((consp buffer) + (setq msg-props erc--msg-props) + buffer) ((processp buffer) (list (process-buffer buffer))) ((eq 'all buffer) ;; Hmm, or all of the same session server? (erc-buffer-list nil erc-server-process)) - ((and (eq 'active buffer) (erc-active-buffer)) - (list (erc-active-buffer))) + ((and-let* (((eq 'active buffer)) + (b (erc-active-buffer))) + (list b))) ((erc-server-buffer-live-p) (list (process-buffer erc-server-process))) (t (list (current-buffer))))) (when (buffer-live-p buf) - (erc-display-line-1 string buf) - (push buf new-bufs))) - (when (null new-bufs) - (erc-display-line-1 string (if (erc-server-buffer-live-p) - (process-buffer erc-server-process) - (current-buffer)))))) + (when msg-props + (setq erc--msg-props (copy-hash-table msg-props))) + (erc-insert-line string buf) + (setq seen t))) + (unless (or seen (null buffer)) + (erc--route-insertion string nil)))) + +(defun erc-display-line (string &optional buffer) + "Insert STRING in BUFFER as a plain \"local\" message. +Take pains to ensure modification hooks see messages created by +the old pattern (erc-display-line (erc-make-notice) my-buffer) as +being equivalent to a `erc-display-message' TYPE of `notice'." + (let ((erc--msg-prop-overrides erc--msg-prop-overrides)) + (when (eq 'erc-notice-face (get-text-property 0 'font-lock-face string)) + (unless (assq 'erc--msg erc--msg-prop-overrides) + (push '(erc--msg . notice) erc--msg-prop-overrides))) + (erc-display-message nil nil buffer string))) + +(defvar erc--merge-text-properties-p nil + "Non-nil when `erc-put-text-property' defers to `erc--merge-prop'.") + +;; To save space, we could maintain a map of all readable property +;; values and optionally dispense archetypal constants in their place +;; in order to ensure all occurrences of some list (a b) across all +;; text-properties in all ERC buffers are actually the same object. +(defun erc--merge-prop (from to prop val &optional object cache-fn) + "Combine existing PROP values with VAL between FROM and TO in OBJECT. +For spans where PROP is non-nil, cons VAL onto the existing +value, ensuring a proper list. Otherwise, just set PROP to VAL. +When VAL is itself a list, prepend its members onto an existing +value. Call CACHE-FN, when given, with the new value for prop. +It must return a suitable replacement or the same value. See +also `erc-button-add-face'." + (let ((old (get-text-property from prop object)) + (pos from) + (end (next-single-property-change from prop object to)) + new) + (while (< pos to) + (setq new (if old + ;; Can't `nconc' without more info. + (if erc--merge-prop-behind-p + `(,@(ensure-list old) ,@(ensure-list val)) + (if (listp val) + (append val (ensure-list old)) + (cons val (ensure-list old)))) + val)) + (when cache-fn + (setq new (funcall cache-fn new))) + (put-text-property pos end prop new object) + (setq pos end + old (get-text-property pos prop object) + end (next-single-property-change pos prop object to))))) + +(defun erc--remove-from-prop-value-list (from to prop val &optional object) + "Remove VAL from text prop value between FROM and TO. +If current value is VAL itself, remove the property entirely. +When VAL is a list, act as if this function were called +repeatedly with VAL set to each of VAL's members." + (let ((old (get-text-property from prop object)) + (pos from) + (end (next-single-property-change from prop object to)) + new) + (while (< pos to) + (when old + (if (setq new (and (consp old) (if (consp val) + (seq-difference old val) + (remq val old)))) + (put-text-property pos end prop + (if (cdr new) new (car new)) object) + (when (pcase val + ((pred consp) (or (consp old) (memq old val))) + (_ (if (consp old) (memq val old) (eq old val)))) + (remove-text-properties pos end (list prop nil) object)))) + (setq pos end + old (get-text-property pos prop object) + end (next-single-property-change pos prop object to))))) + +(defun erc--reserve-important-text-props (beg end plist &optional object) + "Record text-property pairs in PLIST as important between BEG and END. +Also mark the message being inserted as containing these important props +so modules performing destructive modifications can later restore them. +Expect to run in a narrowed buffer at message-insertion time." + (when erc--msg-props + (let ((existing (erc--check-msg-prop 'erc--important-prop-names))) + (puthash 'erc--important-prop-names (cl-union existing (map-keys plist)) + erc--msg-props))) + (erc--merge-prop beg end 'erc--important-props plist object)) + +(defun erc--restore-important-text-props (props &optional beg end) + "Restore PROPS where recorded in the accessible portion of the buffer. +Expect to run in a narrowed buffer at message-insertion time. Limit the +effect to the region between buffer positions BEG and END, when non-nil. + +Callers should be aware that this function fails if the property +`erc--important-props' has an empty value almost anywhere along the +affected region. Use the function `erc--remove-from-prop-value-list' to +ensure that props with empty values are excised completely." + (when-let ((registered (erc--check-msg-prop 'erc--important-prop-names)) + (present (seq-intersection props registered)) + (b (or beg (point-min))) + (e (or end (point-max)))) + (while-let + (((setq b (text-property-not-all b e 'erc--important-props nil))) + (val (get-text-property b 'erc--important-props)) + (q (next-single-property-change b 'erc--important-props nil e))) + (while-let ((k (pop val)) + (v (pop val))) + (when (memq k present) + (put-text-property b q k v))) + (setq b q)))) + +(defvar erc-legacy-invisible-bounds-p nil + "Whether to hide trailing rather than preceding newlines. +Beginning in ERC 5.6, invisibility extends from a message's +preceding newline to its last non-newline character.") +(make-obsolete-variable 'erc-legacy-invisible-bounds-p + "decremented interval now permanent" "30.1") + +(defun erc--hide-message (value) + "Apply `invisible' text-property with VALUE to current message. +Expect to run in a narrowed buffer during message insertion. +Begin the invisible interval at the previous message's trailing +newline and end before the current message's. If the preceding +message ends in a double newline or there is no previous message, +don't bother including the preceding newline." + (if erc-legacy-invisible-bounds-p + ;; Before ERC 5.6, this also used to add an `intangible' + ;; property, but the docs say it's now obsolete. + (erc--merge-prop (point-min) (point-max) 'invisible value) + (let ((beg (point-min)) + (end (point-max))) + (save-restriction + (widen) + (when (or (<= beg 4) (= ?\n (char-before (- beg 2)))) + (cl-incf beg)) + (erc--merge-prop (1- beg) (1- end) 'invisible value))))) + +(defun erc--toggle-hidden (prop arg) + "Toggle invisibility for spec member PROP. +Treat ARG in a manner similar to mode toggles defined by +`define-minor-mode'." + (when arg + (setq arg (prefix-numeric-value arg))) + (if (memq prop (ensure-list buffer-invisibility-spec)) + (unless (natnump arg) + (remove-from-invisibility-spec prop)) + (when (or (not arg) (natnump arg)) + (add-to-invisibility-spec prop)))) + +(defun erc--delete-inserted-message (beg-or-point &optional end) + "Remove message between BEG and END. +Expect BEG and END to match bounds as returned by the macro +`erc--get-inserted-msg-bounds'. Ensure all markers residing at +the start of the deleted message end up at the beginning of the +subsequent message." + (let ((beg beg-or-point)) + (save-restriction + (widen) + (unless end + (setq end (erc--get-inserted-msg-bounds beg-or-point) + beg (pop end))) + (with-silent-modifications + (if erc-legacy-invisible-bounds-p + (delete-region beg (1+ end)) + (save-excursion + (goto-char beg) + (insert-before-markers + (substring (delete-and-extract-region (1- (point)) (1+ end)) + -1)))))))) + +(defvar erc--ranked-properties + '(erc--msg erc--spkr erc--ts erc--cmd erc--ctcp erc--ephemeral)) + +(defun erc--order-text-properties-from-hash (table) + "Return a plist of text props from items in TABLE. +Ensure props in `erc--ranked-properties' appear last and in +reverse order so they end up sorted in buffer interval plists for +retrieval by `text-properties-at' and friends." + (let (out) + (dolist (k erc--ranked-properties) + (when-let ((v (gethash k table))) + (remhash k table) + (setq out (nconc (list k v) out)))) + (maphash (lambda (k v) (setq out (nconc (list k v) out))) table) + out)) (defun erc-display-message-highlight (type string) "Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face. @@ -2652,7 +3652,7 @@ See also `erc-make-notice'." 0 (length string) 'font-lock-face (or (intern-soft (concat "erc-" (symbol-name type) "-face")) - "erc-default-face") + 'erc-default-face) string) string))) @@ -2854,35 +3854,87 @@ returns non-nil." (defun erc-display-message (parsed type buffer msg &rest args) "Display MSG in BUFFER. -ARGS, PARSED, and TYPE are used to format MSG sensibly. - -See also `erc-format-message' and `erc-display-line'." - (let ((string (if (symbolp msg) - (apply #'erc-format-message msg args) - msg)) - (erc-message-parsed parsed)) +Insert MSG or text derived from MSG into an ERC buffer, possibly +after applying formatting by way of either a `format-spec' known +to a message-catalog entry or a TYPE known to a specialized +string handler. Additionally, derive metadata, faces, and other +text properties from the various overloaded parameters, such as +PARSED, when it's an `erc-response' object, and MSG, when it's a +key (symbol) for a \"message catalog\" entry. Expect ARGS, when +applicable, to be `format-spec' args known to such an entry, and +TYPE, when non-nil, to be a symbol handled by +`erc-display-message-highlight' (necessarily accompanied by a +string MSG). Expect BUFFER to be among the sort accepted by the +function `erc-display-line'. + +When non-nil, expect BUFFER to be a live `erc-mode' buffer, a +list of such buffers, or the symbols `all' or `active'. If +`all', insert STRING in all buffers for the current session. If +`active', defer to the function `erc-active-buffer', which may +return the session's server buffer if the previously active +buffer has been killed. If BUFFER is nil or a network process, +pretend it's set to the appropriate server buffer. Otherwise, +use the current buffer. + +When TYPE is a list of symbols, call handlers from left to right +without influencing how they behave when encountering existing +faces. As of ERC 5.6, expect a TYPE of (notice error) to insert +MSG with `font-lock-face' as `erc-error-face' throughout. +However, when the list of symbols begins with t, tell compatible +handlers to compose rather than clobber faces. For example, +expect a TYPE of (t notice error) to result in `font-lock-face' +being (erc-error-face erc-notice-face) throughout MSG when +`erc-notice-highlight-type' is left at its default, `all'. + +As of ERC 5.6, assume third-party code will use this function +instead of lower-level ones, like `erc-insert-line', to insert +arbitrary informative messages as if sent by the server. That +is, tell modules to treat a \"local\" message for which PARSED is +nil like any other server-sent message." + (let* ((erc--msg-props + (or erc--msg-props + (let ((table (make-hash-table)) + (cmd (and parsed (erc--get-eq-comparable-cmd + (erc-response.command parsed))))) + (puthash 'erc--msg + (cond ((and msg (symbolp msg)) msg) + (type (pcase type + ((pred symbolp) type) + ((pred listp) + (intern (mapconcat #'prin1-to-string + type "-"))) + (_ 'unknown))) + (t 'unknown)) + table) + (when cmd + (puthash 'erc--cmd cmd table)) + (when erc--msg-prop-overrides + (pcase-dolist (`(,k . ,v) (reverse erc--msg-prop-overrides)) + (when v (puthash k v table)))) + table))) + (erc-message-parsed parsed) + (string (if (symbolp msg) (apply #'erc-format-message msg args) msg))) (setq string (cond ((null type) string) ((listp type) - (mapc (lambda (type) - (setq string - (erc-display-message-highlight type string))) - type) + (let ((erc--merge-text-properties-p + (and (eq (car type) t) (setq type (cdr type))))) + (dolist (type type) + (setq string (erc-display-message-highlight type string)))) string) ((symbolp type) (erc-display-message-highlight type string)))) (if (not (erc-response-p parsed)) - (erc-display-line string buffer) + (erc--route-insertion string buffer) (unless (erc-hide-current-message-p parsed) (erc-put-text-property 0 (length string) 'erc-parsed parsed string) - (erc-put-text-property 0 (length string) 'rear-sticky t string) (when (erc-response.tags parsed) (erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed) string)) - (erc-display-line string buffer))))) + (erc--route-insertion string buffer))))) (defun erc-message-type-member (position list) "Return non-nil if the erc-parsed text-property at POSITION is in LIST. @@ -2892,17 +3944,39 @@ 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 - "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).") +(defvar erc--called-as-input-p nil + "Non-nil when a user types a \"/slash\" command. +Remains bound until `erc-cmd-SLASH' returns.") + +(defvar erc--current-line-input-split nil + "Current `erc--input-split' instance when processing user input. +This is for special cases in which a \"slash\" command needs +details about the input it's handling or needs to detect whether +it's been dispatched by `erc-send-current-line'.") + +(defvar erc--allow-empty-outgoing-lines-p nil + "Flag to opt out of last-minute padding of empty lines. +Useful to extensions, like `multiline', and for interop with +IRC-adjacent protocols.") + +(defvar-local erc-send-input-line-function #'erc-send-input-line + "Function for sending lines lacking a leading \"slash\" command. +When prompt input starts with a \"slash\" command, like \"/MSG\", +ERC calls a corresponding handler, like `erc-cmd-MSG'. But +normal \"chat\" input also needs processing, for example, to +convert it into a proper IRC command. ERC calls this variable's +value to perform that task, which, by default, simply involves +constructing a \"PRIVMSG\" with the current channel or query +partner as the target. Some libraries, like `erc-dcc', use this +for other purposes.") (defun erc-send-input-line (target line &optional force) "Send LINE to TARGET." - (when (string= line "\n") + (when-let ((target) + (cmem (erc-get-channel-member (erc-current-nick)))) + (setf (erc-channel-user-last-message-time (cdr cmem)) + (erc-compat--current-lisp-time))) + (when (and (not erc--allow-empty-outgoing-lines-p) (string= line "\n")) (setq line " \n")) (erc-message "PRIVMSG" (concat target " " line) force)) @@ -2930,22 +4004,26 @@ erc-cmd-FOO, this returns a string /FOO." command-name))) (defun erc-process-input-line (line &optional force no-command) - "Translate LINE to an RFC1459 command and send it based. -Returns non-nil if the command is actually sent to the server, and nil -otherwise. - -If the command in the LINE is not bound as a function `erc-cmd-<COMMAND>', -it is passed to `erc-cmd-default'. If LINE is not a command (i.e. doesn't -start with /<COMMAND>) then it is sent as a message. - -An optional FORCE argument forces sending the line when flood -protection is in effect. The optional NO-COMMAND argument prohibits -this function from interpreting the line as a command." + "Dispatch a slash-command or chat-input handler from user-input LINE. +If simplistic validation fails, print an error and return nil. +Otherwise, defer to an appropriate handler. For \"slash\" commands, +like \"/JOIN\", expect a handler, like `erc-cmd-JOIN', to return non-nil +if LINE is fit for echoing as a command line when executing scripts. +For normal chat input, expect a handler to return non-nil if a message +was successfully processed as an outgoing \"PRIVMSG\". If LINE is a +slash command, and ERC can't find a corresponding handler of the form +`erc-cmd-<COMMAND>', pass LINE to `erc-cmd-default', treating it as a +catch-all handler. Otherwise, for normal chat input, pass LINE and the +boolean argument FORCE to `erc-send-input-line-function'. With a +non-nil NO-COMMAND, always treat LINE as normal chat input rather than a +slash command." (let ((command-list (erc-extract-command-from-line line))) (if (and command-list (not no-command)) (let* ((cmd (nth 0 command-list)) - (args (nth 1 command-list))) + (args (nth 1 command-list)) + (erc--called-as-input-p t)) + (erc--server-last-reconnect-display-reset (erc-server-buffer)) (condition-case nil (if (listp args) (apply cmd args) @@ -2961,23 +4039,85 @@ this function from interpreting the line as a command." (let ((r (erc-default-target))) (if r (funcall erc-send-input-line-function r line force) - (erc-display-message nil 'error (current-buffer) 'no-target) + (erc-display-message nil '(notice error) (current-buffer) 'no-target) nil))))) +(defconst erc--shell-parse-regexp + (rx (or (+ (not (any ?\s ?\t ?\n ?\\ ?\" ?' ?\;))) + (: ?' (group (* (not ?'))) (? ?')) + (: ?\" (group (* (or (not (any ?\" ?\\)) (: ?\\ nonl)))) (? ?\")) + (: ?\\ (group (? (or nonl ?\n))))))) + +(defun erc--split-string-shell-cmd (string) + "Parse whitespace-separated arguments in STRING." + ;; From `shell--parse-pcomplete-arguments' and friends. Quirk: + ;; backslash-escaped characters appearing within spans of double + ;; quotes are unescaped. + (with-temp-buffer + (insert string) + (let ((end (point)) + args) + (goto-char (point-min)) + (while (and (skip-chars-forward " \t") (< (point) end)) + (let (arg) + (while (looking-at erc--shell-parse-regexp) + (goto-char (match-end 0)) + (cond ((match-beginning 3) ; backslash escape + (push (if (= (match-beginning 3) (match-end 3)) + "\\" + (match-string 3)) + arg)) + ((match-beginning 2) ; double quote + (push (replace-regexp-in-string (rx ?\\ (group nonl)) + "\\1" (match-string 2)) + arg)) + ((match-beginning 1) ; single quote + (push (match-string 1) arg)) + (t (push (match-string 0) arg)))) + (push (string-join (nreverse arg)) args))) + (nreverse args)))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Input commands handlers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun erc-cmd-AMSG (line) - "Send LINE to all channels of the current server that you are on." - (interactive "sSend to all channels you're on: ") - (setq line (erc-trim-string line)) +(defun erc--connected-and-joined-p () + (and (erc--current-buffer-joined-p) + erc-server-connected)) + +(defun erc-cmd-GMSG (line) + "Send LINE to all channels on all networks you are on." + (setq line (string-remove-prefix " " line)) (erc-with-all-buffers-of-server nil - (lambda () - (erc-channel-p (erc-default-target))) + #'erc--connected-and-joined-p + (erc-send-message line))) +(put 'erc-cmd-GMSG 'do-not-parse-args t) + +(defun erc-cmd-AMSG (line) + "Send LINE to all channels of the current network. +Interactively, prompt for the line of text to send." + (interactive "sSend to all channels on this network: ") + (setq line (string-remove-prefix " " line)) + (erc-with-all-buffers-of-server erc-server-process + #'erc--connected-and-joined-p (erc-send-message line))) (put 'erc-cmd-AMSG 'do-not-parse-args t) +(defun erc-cmd-GME (line) + "Send LINE as an action to all channels on all networks you are on." + (erc-with-all-buffers-of-server nil + #'erc--connected-and-joined-p + (erc-cmd-ME line))) +(put 'erc-cmd-GME 'do-not-parse-args t) + +(defun erc-cmd-AME (line) + "Send LINE as an action to all channels on the current network." + (erc-with-all-buffers-of-server erc-server-process + #'erc--connected-and-joined-p + (erc-cmd-ME line))) +(put 'erc-cmd-AME 'do-not-parse-args t) + (defun erc-cmd-SAY (line) "Send LINE to the current query or channel as a message, not a command. @@ -2987,9 +4127,7 @@ need this when pasting multiple lines of text." (if (string-match "^\\s-*$" line) nil (string-match "^ ?\\(.*\\)" line) - (let ((msg (match-string 1 line))) - (erc-display-msg msg) - (erc-process-input-line msg nil t)))) + (erc-send-message (match-string 1 line) nil))) (put 'erc-cmd-SAY 'do-not-parse-args t) (defun erc-cmd-SET (line) @@ -3064,6 +4202,8 @@ returns the time spec converted to a number of seconds." (string-to-number period)) ;; Parse as a time spec. (t + (require 'time-date) + (require 'iso8601) (let ((time (condition-case nil (iso8601-parse-duration (concat (cond @@ -3100,16 +4240,14 @@ If no USER argument is specified, list the contents of `erc-ignore-list'." (run-at-time timeout nil (lambda () (erc--unignore-user user buffer)))) - (erc-display-line - (erc-make-notice (format "Now ignoring %s" user)) - 'active) + (erc-display-message nil 'notice 'active + (format "Now ignoring %s" user)) (erc-with-server-buffer (add-to-list 'erc-ignore-list user)))) (if (null (erc-with-server-buffer erc-ignore-list)) - (erc-display-line (erc-make-notice "Ignore list is empty") 'active) - (erc-display-line (erc-make-notice "Ignore list:") 'active) + (erc-display-message nil 'notice 'active "Ignore list is empty") + (erc-display-message nil 'notice 'active "Ignore list:") (mapc (lambda (item) - (erc-display-line (erc-make-notice item) - 'active)) + (erc-display-message nil 'notice 'active item)) (erc-with-server-buffer erc-ignore-list)))) t) @@ -3123,9 +4261,8 @@ If no USER argument is specified, list the contents of `erc-ignore-list'." (unless (y-or-n-p (format "Remove this regexp (%s)? " ignored-nick)) (setq ignored-nick nil)) - (erc-display-line - (erc-make-notice (format "%s is not currently ignored!" user)) - 'active))) + (erc-display-message nil 'notice 'active + (format "%s is not currently ignored!" user)))) (when ignored-nick (erc--unignore-user user (current-buffer)))) t) @@ -3133,16 +4270,26 @@ If no USER argument is specified, list the contents of `erc-ignore-list'." (defun erc--unignore-user (user buffer) (when (buffer-live-p buffer) (with-current-buffer buffer - (erc-display-line - (erc-make-notice (format "No longer ignoring %s" user)) - 'active) + (erc-display-message nil 'notice 'active + (format "No longer ignoring %s" user)) (erc-with-server-buffer (setq erc-ignore-list (delete user erc-ignore-list)))))) +(defvar erc--pre-clear-functions nil + "Abnormal hook run when truncating buffers. +Called with position indicating boundary of interval to be excised.") + (defun erc-cmd-CLEAR () - "Clear the window content." - (let ((inhibit-read-only t)) - (delete-region (point-min) (line-beginning-position))) + "Clear messages in current buffer after informing active modules. +Expect modules to perform housekeeping tasks to withstand the +disruption. When called from lisp code, only clear messages up +to but not including the one occupying the current line." + (with-silent-modifications + (let ((max (if (>= (point) erc-insert-marker) + (1- erc-insert-marker) + (or (erc--get-inserted-msg-beg (point)) (pos-bol))))) + (run-hook-with-args 'erc--pre-clear-functions max) + (delete-region (point-min) max))) t) (put 'erc-cmd-CLEAR 'process-not-needed t) @@ -3213,7 +4360,7 @@ VERSION and so on. It is called with ARGS." (erc-send-ctcp-message nick str) t)) -(defun erc-cmd-HELP (&optional func) +(defun erc-cmd-HELP (&optional func &rest rest) "Popup help information. If FUNC contains a valid function or variable, help about that @@ -3246,6 +4393,10 @@ For a list of user commands (/join /part, ...): nil))))) (if sym (cond + ((get sym 'erc--cmd-help) + (when (autoloadp (symbol-function sym)) + (autoload-do-load (symbol-function sym))) + (apply (get sym 'erc--cmd-help) rest)) ((boundp sym) (describe-variable sym)) ((fboundp sym) (describe-function sym)) (t nil)) @@ -3369,11 +4520,22 @@ the one with host foo would win." (plist-get (car sorted) :secret)))) (defun erc-auth-source-search (&rest plist) - "Call `auth-source-search', possibly with keyword params in PLIST." + "Call `auth-source-search', possibly with keyword params in PLIST. +If the search signals an error before returning, `warn' the user +and ask whether to continue connecting anyway." ;; 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))) + (condition-case err + (apply #'erc--auth-source-search + (apply #'erc--auth-source-determine-params-merge plist)) + (error + (erc--lwarn '(erc auth-source) :error + "Problem querying `auth-source': %S. See %S for more." + (error-message-string err) + '(info "(erc) auth-source Troubleshooting")) + (when (or noninteractive + (not (y-or-n-p "Ignore auth-source error and continue? "))) + (signal (car err) (cdr err)))))) (defun erc-server-join-channel (server channel &optional secret) "Join CHANNEL, optionally with SECRET. @@ -3412,7 +4574,24 @@ were most recently invited. See also `invitation'." ((with-current-buffer existing (erc-get-channel-user (erc-current-nick))))) (switch-to-buffer existing) - (setq erc--server-last-reconnect-count 0) + (when-let* ; bind `erc-join-buffer' when /JOIN issued + ((erc--called-as-input-p) + (fn (lambda (proc parsed) + (when-let* ; `fn' wrapper already removed from hook + (((equal (car (erc-response.command-args parsed)) + channel)) + (sn (erc-extract-nick (erc-response.sender parsed))) + ((erc-nick-equal-p sn (erc-current-nick))) + (erc-join-buffer (or erc-interactive-display + erc-join-buffer)) + (erc--display-context `((erc-interactive-display + . /JOIN) + ,@erc--display-context))) + (run-hook-with-args-until-success + 'erc-server-JOIN-functions proc parsed) + t)))) + (erc-with-server-buffer + (erc-once-with-server-event "JOIN" fn))) (erc-server-join-channel nil chnl key)))) t) @@ -3592,12 +4771,10 @@ See `erc-cmd-WHOIS' for more details." (string-to-number (cl-third (erc-response.command-args parsed))))) - (erc-display-line - (erc-make-notice + (erc-display-message nil 'notice origbuf (format "%s has been idle for %s." (erc-string-no-properties nick) (erc-seconds-to-string idleseconds))) - origbuf) t))) 'erc-server-317-functions) symlist) @@ -3661,17 +4838,68 @@ the matching is case-sensitive." (put 'erc-cmd-LASTLOG 'do-not-parse-args t) (put 'erc-cmd-LASTLOG 'process-not-needed t) +(defvar erc--send-message-nested-function #'erc--send-message-nested + "Function for inserting and sending slash-command generated text. +When a command like /SV or /SAY modifies or replaces command-line +input originally submitted at the prompt, `erc-send-message' +performs additional processing to ensure said input is fit for +inserting and sending given this \"nested\" meta context. This +interface variable exists because modules extending fundamental +insertion and sending operations need a say in this processing as +well.") + (defun erc-send-message (line &optional force) "Send LINE to the current channel or user and display it. See also `erc-message' and `erc-display-line'." - (erc-message "PRIVMSG" (concat (erc-default-target) " " line) force) - (erc-display-line - (concat (erc-format-my-nick) line) - (current-buffer)) + (if (erc--input-split-p erc--current-line-input-split) + (funcall erc--send-message-nested-function line force) + (erc--send-message-external line force))) + +(defun erc--send-message-external (line force) + "Send a \"PRIVMSG\" to the default target with optional FORCE. +Expect caller to bind `erc-default-recipients' if needing to +specify a status-prefixed target." + ;; Almost like an echoed message, but without the `erc--cmd'. + (let* ((erc-current-message-catalog erc--message-speaker-catalog) + (target (erc-default-target)) + (erc--msg-prop-overrides `((erc--tmp) ,@erc--msg-prop-overrides)) + ;; This util sets the `erc--spkr' property in ^. + (trimmed (erc--statusmsg-target target)) + (stmsgindc (and trimmed (substring target 0 1))) + (queryp (and erc--target (not (erc--target-channel-p erc--target)))) + (args (erc--determine-speaker-message-format-args + (erc-current-nick) line queryp 'privmsgp 'inputp + stmsgindc 'prefix))) + (erc-message "PRIVMSG" (concat target " " line) force) + (push (cons 'erc--msg (car args)) erc--msg-prop-overrides) + (apply #'erc-display-message nil nil (current-buffer) args)) ;; FIXME - treat multiline, run hooks, or remove me? + ;; FIXME explain this ^ in more detail or remove. + t) + +(defun erc--send-message-nested (input-line force) + "Process string INPUT-LINE almost as if it's normal chat input. +Expect INPUT-LINE to differ from the `string' slot of the calling +context's `erc--current-line-input-split' object because the +latter is likely a slash command invocation whose handler +generated INPUT-LINE. Before inserting INPUT-LINE, split it and +run `erc-send-modify-hook' and `erc-send-post-hook' on each +actual outgoing line. Forgo input validation because this isn't +interactive input, and skip `erc-send-completed-hook' because it +will run just before the outer `erc-send-current-line' call +returns." + (let* ((erc-flood-protect (not force)) + (lines-obj (erc--make-input-split input-line))) + (setf (erc--input-split-refoldp lines-obj) t + (erc--input-split-cmdp lines-obj) nil) + (erc--send-input-lines (erc--run-send-hooks lines-obj))) t) +;; FIXME if the user types /MODE<RET>, LINE becomes "\n", which +;; matches the pattern, so "\n" is sent to the server. Perhaps +;; instead of `do-not-parse-args', this should just join &rest +;; arguments. (defun erc-cmd-MODE (line) "Change or display the mode value of a channel or user. The first word specifies the target. The rest is the mode string @@ -3686,7 +4914,7 @@ A list of valid mode strings for Libera.Chat may be found at ((string-match "^\\s-\\(.*\\)$" line) (let ((s (match-string 1 line))) (erc-log (format "cmd: MODE: %s" s)) - (erc-server-send (concat "MODE " line))) + (erc-server-send (concat "MODE " s))) t) (t nil))) (put 'erc-cmd-MODE 'do-not-parse-args t) @@ -3711,6 +4939,7 @@ The rest of LINE is the message to send." The rest of LINE is the message to send." (erc-message "SQUERY" line)) +(put 'erc-cmd-SQUERY 'do-not-parse-args t) (defun erc-cmd-NICK (nick) "Change current nickname to NICK." @@ -3753,7 +4982,7 @@ Otherwise leave the channel indicated by LINE." (format "PART %s" ch) (format "PART %s :%s" ch reason)) nil ch)) - (erc-display-message nil 'error (current-buffer) 'no-target))) + (erc-display-message nil '(notice error) (current-buffer) 'no-target))) t) (t nil))) (put 'erc-cmd-PART 'do-not-parse-args t) @@ -3776,27 +5005,10 @@ just as you provided it. Use this command with care!" (t nil))) (put 'erc-cmd-QUOTE 'do-not-parse-args t) -(defcustom erc-query-display 'window - "How to display query buffers when using the /QUERY command to talk to someone. - -The default behavior is to display the message in a new window -and bring it to the front. See the documentation for -`erc-join-buffer' for a description of the available choices. - -See also `erc-auto-query' to decide how private messages from -other people should be displayed." - :group 'erc-query - :type '(choice (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) - (const :tag "Use current buffer" t))) - (defun erc-cmd-QUERY (&optional user) "Open a query with USER. How the query is displayed (in a new window, frame, etc.) depends -on the value of `erc-query-display'." +on the value of `erc-interactive-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 ;-)" @@ -3807,8 +5019,10 @@ on the value of `erc-query-display'." (unless user ;; currently broken, evil hack to display help anyway ;(erc-delete-query)))) - (signal 'wrong-number-of-arguments "")) - (let ((erc-join-buffer erc-query-display)) + (signal 'wrong-number-of-arguments '(erc-cmd-QUERY 0))) + (let ((erc-join-buffer erc-interactive-display) + (erc--display-context `((erc-interactive-display . /QUERY) + ,@erc--display-context))) (erc-with-server-buffer (erc--open-target user)))) @@ -3916,10 +5130,7 @@ the message given by REASON." ;; kill them (run-at-time 4 nil - (lambda () - (dolist (buffer (erc-buffer-list (lambda (buf) - (not (erc-server-buffer-p buf))))) - (kill-buffer buffer))))) + #'erc-buffer-do (lambda () (when erc--target (kill-buffer))))) t) (defalias 'erc-cmd-GQ #'erc-cmd-GQUIT) @@ -3928,6 +5139,9 @@ the message given by REASON." (defun erc--cmd-reconnect () (let ((buffer (erc-server-buffer)) + (erc-join-buffer erc-interactive-display) + (erc--display-context `((erc-interactive-display . /RECONNECT) + ,@erc--display-context)) (process nil)) (unless (buffer-live-p buffer) (setq buffer (current-buffer))) @@ -3962,6 +5176,8 @@ connection or, with -A, all applicable connections. (put 'erc-cmd-RECONNECT 'process-not-needed t) +;; FIXME use less speculative error message or lose `condition-case', +;; since most connection failures don't signal anything. (defun erc-cmd-SERVER (server) "Connect to SERVER, leaving existing connection intact." (erc-log (format "cmd: SERVER: %s" server)) @@ -3980,9 +5196,11 @@ connection or, with -A, all applicable connections. system-configuration (concat (cond ((featurep 'motif) + (defvar motif-version-string) (concat ", " (substring motif-version-string 4))) ((featurep 'gtk) + (defvar gtk-version-string) (concat ", GTK+ Version " gtk-version-string)) ((featurep 'x-toolkit) ", X toolkit") @@ -4056,6 +5274,22 @@ means that the user has a +o flag in the channel's access list)." (t (erc-server-send "TIME")))) (defalias 'erc-cmd-DATE #'erc-cmd-TIME) +(defun erc-cmd-MOTD (&optional target) + "Ask server to send the current MOTD. +Some IRCds simply ignore TARGET." + (letrec ((oneoff (lambda (proc parsed) + (with-current-buffer (erc-server-buffer) + (cl-assert (eq (current-buffer) (process-buffer proc))) + (remove-hook 'erc-server-402-functions h402 t) + (remove-hook 'erc-server-376-functions h376 t) + (remove-hook 'erc-server-422-functions h422 t)) + (erc-server-MOTD proc parsed) + t)) + (h402 (erc-once-with-server-event 402 oneoff)) + (h376 (erc-once-with-server-event 376 oneoff)) + (h422 (erc-once-with-server-event 422 oneoff))) + (erc-server-send (concat "MOTD" (and target " ") target)))) + (defun erc-cmd-TOPIC (topic) "Set or request the topic for a channel. LINE has the format: \"#CHANNEL TOPIC\", \"#CHANNEL\", \"TOPIC\" @@ -4092,7 +5326,7 @@ be displayed." (progn (erc-log (format "cmd: TOPIC [%s]: %s" ch topic)) (erc-server-send (format "TOPIC %s :%s" ch topic) nil ch)) - (erc-display-message nil 'error (current-buffer) 'no-target))) + (erc-display-message nil '(notice error) (current-buffer) 'no-target))) t) (t nil))) (defalias 'erc-cmd-T #'erc-cmd-TOPIC) @@ -4142,8 +5376,7 @@ The ban list is fetched from the server if necessary." (cond ((not (erc-channel-p chnl)) - (erc-display-line (erc-make-notice "You're not on a channel\n") - 'active)) + (erc-display-message nil 'notice 'active "You're not on a channel\n")) ((not (get 'erc-channel-banlist 'received-from-server)) (let ((old-367-hook erc-server-367-functions)) @@ -4162,9 +5395,8 @@ The ban list is fetched from the server if necessary." (erc-server-send (format "MODE %s b" chnl))))) ((null erc-channel-banlist) - (erc-display-line (erc-make-notice - (format "No bans for channel: %s\n" chnl)) - 'active) + (erc-display-message nil 'notice 'active + (format "No bans for channel: %s\n" chnl)) (put 'erc-channel-banlist 'received-from-server nil)) (t @@ -4178,10 +5410,9 @@ The ban list is fetched from the server if necessary." "%-" (number-to-string (/ erc-fill-column 2)) "s" "%" (number-to-string (/ erc-fill-column 2)) "s"))) - (erc-display-line - (erc-make-notice (format "Ban list for channel: %s\n" - (erc-default-target))) - 'active) + (erc-display-message + nil 'notice 'active + (format "Ban list for channel: %s\n" (erc-default-target))) (erc-display-line separator 'active) (erc-display-line (format fmt "Ban Mask" "Banned By") 'active) @@ -4198,8 +5429,7 @@ The ban list is fetched from the server if necessary." 'active)) erc-channel-banlist) - (erc-display-line (erc-make-notice "End of Ban list") - 'active) + (erc-display-message nil 'notice 'active "End of Ban list") (put 'erc-channel-banlist 'received-from-server nil))))) t) @@ -4213,9 +5443,7 @@ Unban all currently banned users in the current channel." (cond ((not (erc-channel-p chnl)) - (erc-display-line - (erc-make-notice "You're not on a channel\n") - 'active)) + (erc-display-message nil 'notice 'active "You're not on a channel\n")) ((not (get 'erc-channel-banlist 'received-from-server)) (let ((old-367-hook erc-server-367-functions)) @@ -4256,6 +5484,32 @@ Eventually add a # in front of it, if that turns it into a valid channel name." channel (concat "#" channel))) +(defvar erc--own-property-names + `( tags erc--speaker erc-parsed display ; core + ;; `erc--msg-props' + ,@erc--ranked-properties + ;; `erc-display-prompt' + rear-nonsticky erc-prompt field front-sticky read-only + ;; stamp + cursor-intangible cursor-sensor-functions isearch-open-invisible + ;; match + invisible intangible + ;; button + erc-callback erc-data mouse-face keymap + ;; fill-wrap + line-prefix wrap-prefix) + "Props added by ERC that should not survive killing. +Among those left behind by default are `font-lock-face' and +`erc-secret'.") + +(defun erc--remove-text-properties (string) + "Remove text properties in STRING added by ERC. +Specifically, remove any that aren't members of +`erc--own-property-names'." + (remove-list-of-text-properties 0 (length string) + erc--own-property-names string) + string) + (defun erc-grab-region (start end) "Copy the region between START and END in a recreatable format. @@ -4304,12 +5558,7 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil, ;; Do not extend the text properties when typing at the end ;; of the prompt, but stuff typed in front of the prompt ;; shall remain part of the prompt. - (setq prompt (propertize prompt - 'rear-nonsticky t - 'erc-prompt t - 'field t - 'front-sticky t - 'read-only t)) + (setq prompt (apply #'propertize prompt erc--prompt-properties)) (erc-put-text-property 0 (1- (length prompt)) 'font-lock-face (or face 'erc-prompt-face) prompt) @@ -4443,6 +5692,19 @@ This places `point' just after the prompt, or at the beginning of the line." (setq erc-input-ring-index nil)) (kill-line))) +(defvar erc--tab-functions nil + "Functions to try when user hits \\`TAB' outside of input area. +Called with a numeric prefix arg.") + +(defun erc-tab (arg) + "Call `completion-at-point' when typing in the input area. +Otherwise call members of `erc--tab-functions' with a numeric +prefix ARG until one of them returns non-nil." + (interactive "p") + (if (>= (point) erc-input-marker) + (completion-at-point) + (run-hook-with-args-until-success 'erc--tab-functions arg))) + (defun erc-complete-word-at-point () (run-hook-with-args-until-success 'erc-complete-functions)) @@ -4457,9 +5719,13 @@ This places `point' just after the prompt, or at the beginning of the line." ; Stolen from ZenIRC. I just wanna test this code, so here is ; experiment area. -(defcustom erc-default-server-hook '(erc-debug-missing-hooks - erc-default-server-handler) - "Default for server messages which aren't covered by `erc-server-hooks'." +;; This shouldn't be a user option but remains so for compatibility. +(define-obsolete-variable-alias + 'erc-default-server-hook 'erc-default-server-functions "30.1") +(defcustom erc-default-server-functions '(erc-handle-unknown-server-response) + "Abnormal hook for incoming messages without their own handlers. +See `define-erc-response-handler' for more." + :package-version '(ERC . "5.6") :group 'erc-server-hooks :type 'hook) @@ -4467,6 +5733,7 @@ This places `point' just after the prompt, or at the beginning of the line." "Default server handler. Displays PROC and PARSED appropriately using `erc-display-message'." + (declare (obsolete erc-handle-unknown-server-response "29.1")) (erc-display-message parsed 'notice proc (mapconcat @@ -4489,7 +5756,7 @@ See `erc-debug-missing-hooks'.") "Add PARSED server message ERC does not yet handle to `erc-server-vectors'. These vectors can be helpful when adding new server message handlers to ERC. See `erc-default-server-hook'." - (nconc erc-server-vectors (list parsed)) + (setq erc-server-vectors `(,@erc-server-vectors ,parsed)) nil) (defun erc--open-target (target) @@ -4517,47 +5784,60 @@ To change how this query window is displayed, use `let' to bind (with-current-buffer server-buffer (erc--open-target target))) -(defcustom erc-auto-query 'window-noselect +(defvaralias 'erc-auto-query 'erc-receive-query-display) +(defcustom erc-receive-query-display 'window-noselect "If non-nil, create a query buffer each time you receive a private message. If the buffer doesn't already exist, it is created. This can be set to a symbol, to control how the new query window should appear. The default behavior is to display the buffer in -a new window, but not to select it. See the documentation for -`erc-join-buffer' for a description of the available choices." +a new window but not to select it. See the documentation for +`erc-buffer-display' for a description of available values. + +Note that the legacy behavior of forgoing buffer creation +entirely when this option is nil requires setting the +compatibility flag `erc-receive-query-display-defer' to nil. Use +`erc-ensure-target-buffer-on-privmsg' to achieve the same effect." + :package-version '(ERC . "5.6") + :group 'erc-buffers :group 'erc-query - :type '(choice (const :tag "Don't create query window" 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) - (const :tag "Use current buffer" t))) - -(defcustom erc-query-on-unjoined-chan-privmsg t - "If non-nil create query buffer on receiving any PRIVMSG at all. + :type erc--buffer-display-choices) + +(defvar erc-receive-query-display-defer t + "How to interpret a null `erc-receive-query-display'. +When this variable is non-nil, ERC defers to `erc-buffer-display' +upon seeing a nil value for `erc-receive-query-display', much +like it does with other buffer-display options, like +`erc-interactive-display'. Otherwise, when this option is nil, +ERC retains the legacy behavior of not creating a new query +buffer.") + +(defvaralias 'erc-query-on-unjoined-chan-privmsg + 'erc-ensure-target-buffer-on-privmsg) +(defcustom erc-ensure-target-buffer-on-privmsg t + "When non-nil, create a target buffer upon receiving a PRIVMSG. This includes PRIVMSGs directed to channels. If you are using an IRC bouncer, such as dircproxy, to keep a log of channels when you are disconnected, you should set this option to t. -WARNING: this option was mistakenly removed from ERC 5.5's client -code, so setting it to nil is temporarily ineffective. That is, -ERC now always creates a buffer when receiving a PRIVMSG directed -at a channel for which none exists. And despite this option's -name and its doc string's use of \"query\" to refer to any -conversation with a target, it did not previously allow for -opting out of buffer creation for direct messages (at least not -in Emacs 27 and 28). However, such behavior has always been and -will continue to be available by setting `erc-auto-query' to nil. -If needing to restore pre-5.5 functionality immediately, see Info -node `(erc) Upgrading'." +For queries (direct messages), this option's non-nil meaning is +straightforward: if a buffer doesn't exist for the sender, create +one. For channels, the use case is more niche and usually +involves receiving playback (via commands like ZNC's +\"PLAYBUFFER\") for channels to which your bouncer is joined but +from which you've \"detached\". + +Note that this option was absent from ERC 5.5 because knowledge +of its intended role was \"unavailable\" during a major +refactoring involving buffer management. The option has since +been restored in ERC 5.6 but now also affects queries in the +manner implied above, which was lost sometime before ERC 5.4." + :package-version '(ERC . "5.6") ; revived + :group 'erc-buffers :group 'erc-query - :set (lambda (sym val) - (unless (set sym val) - (lwarn 'erc :warning - "Setting `%s' to nil is currently ineffective; %s" - sym "see doc string for details."))) - :type 'boolean) + :type '(choice boolean + (choice :tag "Create pseudo queries for STATUSMSGs" + status))) (defcustom erc-format-query-as-channel-p t "If non-nil, format text from others in a query buffer like in a channel. @@ -4596,6 +5876,10 @@ E.g. \"Read error to Nick [user@some.host]: 110\" would be shortened to (match-string 1 reason)) reason)) +(cl-defmethod erc--nickname-in-use-make-request (_nick temp) + "Request nickname TEMP in place of rejected NICK." + (erc-cmd-NICK temp)) + (defun erc-nickname-in-use (nick reason) "If NICK is unavailable, tell the user the REASON. @@ -4629,7 +5913,7 @@ See also `erc-display-error-notice'." ;; established a connection yet (- 9 (length erc-nick-uniquifier)))) erc-nick-uniquifier))) - (erc-cmd-NICK newnick) + (erc--nickname-in-use-make-request nick newnick) (erc-display-error-notice nil (format "Nickname %s is %s, trying %s" @@ -4637,6 +5921,9 @@ See also `erc-display-error-notice'." ;;; Server messages +;; FIXME remove on next major version release. This group is all but +;; unused because most `erc-server-FOO-functions' are plain variables +;; and not user options as implied by this doc string. (defgroup erc-server-hooks nil "Server event callbacks. Every server event - like numeric replies - has its own hook. @@ -4684,57 +5971,318 @@ and as second argument the event parsed as a vector." (and (erc-is-message-ctcp-p message) (not (string-match "^\C-aACTION.*\C-a$" message)))) +(defun erc--get-speaker-bounds () + "Return the bounds of `erc--speaker' text property when present. +Assume buffer is narrowed to the confines of an inserted message." + (and-let* (((erc--check-msg-prop 'erc--spkr)) + (beg (text-property-not-all (point-min) (point-max) + 'erc--speaker nil))) + (cons beg (next-single-property-change beg 'erc--speaker)))) + +(defvar erc--cmem-from-nick-function #'erc--cmem-get-existing + "Function maybe returning a \"channel member\" cons from a nick. +Must return either nil or a cons of an `erc-server-user' and an +`erc-channel-user' (see `erc-channel-users') for use in +formatting a user's nick prior to insertion. Called in the +appropriate target buffer with the downcased nick, the parsed +NUH, and the current `erc-response' object.") + +(defun erc--cmem-get-existing (downcased _nuh _parsed) + (and erc-channel-users (gethash downcased erc-channel-users))) + (defun erc-format-privmessage (nick msg privp msgp) "Format a PRIVMSG in an insertable fashion." (let* ((mark-s (if msgp (if privp "*" "<") "-")) (mark-e (if msgp (if privp "*" ">") "-")) (str (format "%s%s%s %s" mark-s nick mark-e msg)) (nick-face (if privp 'erc-nick-msg-face 'erc-nick-default-face)) + (nick-prefix-face (get-text-property 0 'font-lock-face nick)) + (prefix-len (or (and nick-prefix-face (text-property-not-all + 0 (length nick) 'font-lock-face + nick-prefix-face nick)) + 0)) (msg-face (if privp 'erc-direct-msg-face 'erc-default-face))) + (erc--ensure-spkr-prop nick) ;; add text properties to text before the nick, the nick and after the nick (erc-put-text-property 0 (length mark-s) 'font-lock-face msg-face str) - (erc-put-text-property (length mark-s) (+ (length mark-s) (length nick)) - 'font-lock-face nick-face str) + (erc-put-text-properties (+ (length mark-s) prefix-len) + (+ (length mark-s) (length nick)) + '(font-lock-face erc--speaker) str + (list nick-face + (substring-no-properties nick prefix-len))) (erc-put-text-property (+ (length mark-s) (length nick)) (length str) 'font-lock-face msg-face str) str)) -(defcustom erc-format-nick-function 'erc-format-nick - "Function to format a nickname for message display." +;; The format strings in the following `-speaker' catalog shouldn't +;; contain any non-protocol words, so they make sense in any language. + +(defvar erc--message-speaker-statusmsg + #("(%p%n%s) %m" + 0 1 (font-lock-face erc-default-face) + 1 3 (font-lock-face erc-nick-prefix-face) + 3 5 (font-lock-face erc-nick-default-face) + 5 7 (font-lock-face erc-notice-face) + 7 11 (font-lock-face erc-default-face)) + "Message template for in-channel status messages.") + +(defvar erc--message-speaker-statusmsg-input + #("(%p%n%s) %m" + 0 1 (font-lock-face erc-default-face) + 1 3 (font-lock-face erc-my-nick-prefix-face) + 3 5 (font-lock-face erc-my-nick-face) + 5 7 (font-lock-face erc-notice-face) + 7 8 (font-lock-face erc-default-face) + 8 11 (font-lock-face erc-input-face)) + "Message template for echoed status messages.") + +(defvar erc--message-speaker-input-chan-privmsg + #("<%p%n> %m" + 0 1 (font-lock-face erc-default-face) + 1 3 (font-lock-face erc-my-nick-prefix-face) + 3 5 (font-lock-face erc-my-nick-face) + 5 7 (font-lock-face erc-default-face) + 7 9 (font-lock-face erc-input-face)) + "Message template for prompt input or echoed PRIVMSG from own nick.") + +(defvar erc--message-speaker-input-query-privmsg + #("*%n* %m" + 0 1 (font-lock-face erc-direct-msg-face) + 1 3 (font-lock-face erc-my-nick-face) + 3 5 (font-lock-face erc-direct-msg-face) + 5 7 (font-lock-face erc-input-face)) + "Message template for prompt input or echoed PRIVMSG query from own nick.") + +(defvar erc--message-speaker-input-query-notice + #("-%n- %m" + 0 1 (font-lock-face erc-direct-msg-face) + 1 3 (font-lock-face erc-my-nick-face) + 3 5 (font-lock-face erc-direct-msg-face) + 5 7 (font-lock-face erc-input-face)) + "Message template for echoed or spoofed query NOTICE from own nick.") + +(defvar erc--message-speaker-input-chan-notice + #("-%p%n- %m" + 0 1 (font-lock-face erc-default-face) + 1 3 (font-lock-face erc-my-nick-prefix-face) + 3 5 (font-lock-face erc-my-nick-face) + 5 7 (font-lock-face erc-default-face) + 7 9 (font-lock-face erc-input-face)) + "Message template for prompt input or echoed NOTICE from own nick.") + +(defvar erc--message-speaker-chan-privmsg + #("<%p%n> %m" + 0 1 (font-lock-face erc-default-face) + 1 3 (font-lock-face erc-nick-prefix-face) + 3 5 (font-lock-face erc-nick-default-face) + 5 9 (font-lock-face erc-default-face)) + "Message template for a PRIVMSG in a channel.") + +(defvar erc--message-speaker-query-privmsg + #("*%n* %m" + 0 1 (font-lock-face erc-direct-msg-face) + 1 3 (font-lock-face erc-nick-msg-face) + 3 7 (font-lock-face erc-direct-msg-face)) + "Message template for a PRIVMSG in query buffer.") + +(defvar erc--message-speaker-chan-notice + #("-%p%n- %m" + 0 1 (font-lock-face erc-default-face) + 1 3 (font-lock-face erc-nick-prefix-face) + 3 5 (font-lock-face erc-nick-default-face) + 5 9 (font-lock-face erc-default-face)) + "Message template for a NOTICE in a channel.") + +(defvar erc--message-speaker-query-notice + #("-%n- %m" + 0 1 (font-lock-face erc-direct-msg-face) + 1 3 (font-lock-face erc-nick-msg-face) + 3 7 (font-lock-face erc-direct-msg-face)) + "Message template for a NOTICE in a query buffer.") + +(defvar erc--message-speaker-ctcp-action + #("* %p%n %m" + 0 2 (font-lock-face erc-action-face) + 2 4 (font-lock-face (erc-nick-prefix-face erc-action-face)) + 4 9 (font-lock-face erc-action-face)) + "Message template for a CTCP ACTION from another user.") + +(defvar erc--message-speaker-ctcp-action-input + #("* %p%n %m" + 0 2 (font-lock-face #1=(erc-input-face erc-action-face)) + 2 4 (font-lock-face (erc-my-nick-prefix-face . #1#)) + 4 6 (font-lock-face (erc-my-nick-face . #1#)) + 6 9 (font-lock-face #1#)) + "Message template for a CTCP ACTION from current client.") + +(defvar erc--message-speaker-ctcp-action-statusmsg + #("* (%p%n%s) %m" + 0 3 (font-lock-face erc-action-face) + 3 5 (font-lock-face (erc-nick-prefix-face erc-action-face)) + 5 7 (font-lock-face erc-action-face) + 7 9 (font-lock-face (erc-notice-face erc-action-face)) + 9 13 (font-lock-face erc-action-face)) + "Template for a CTCP ACTION status message from another chan op.") + +(defvar erc--message-speaker-ctcp-action-statusmsg-input + #("* (%p%n%s) %m" + 0 3 (font-lock-face #1=(erc-input-face erc-action-face)) + 3 5 (font-lock-face (erc-my-nick-prefix-face . #1#)) + 5 7 (font-lock-face (erc-my-nick-face . #1#)) + 7 9 (font-lock-face (erc-notice-face . #1#)) + 9 13 (font-lock-face #1#)) + "Template for a CTCP ACTION status message from current client.") + +(defun erc--speakerize-nick (nick &optional disp) + "Propertize NICK with `erc--speaker' if not already present. +Do so to DISP instead if it's non-nil. In either case, assign +NICK, sans properties, as the `erc--speaker' value. As a side +effect, pair the latter string (the same `eq'-able object) with +the symbol `erc--spkr' in the \"msg prop\" environment for any +imminent `erc-display-message' invocations. While doing so, +include any overrides defined in `erc--message-speaker-catalog'." + (let ((plain-nick (substring-no-properties nick))) + (erc--ensure-spkr-prop plain-nick (get erc--message-speaker-catalog + 'erc--msg-prop-overrides)) + (if (text-property-not-all 0 (length (or disp nick)) + 'erc--speaker nil (or disp nick)) + (or disp nick) + (propertize (or disp nick) 'erc--speaker plain-nick)))) + +(defun erc--determine-speaker-message-format-args + (nick message queryp privmsgp inputp &optional statusmsg prefix disp-nick) + "Return a list consisting of a \"speaker\"-template key and spec args. +Consider the three flags QUERYP, PRIVMSGP, and INPUTP, as well as +the possibly null STATUSMSG string. (Combined, these describe +the context of a newly arrived \"PRIVMSG\" or, when PRIVMSGP is +nil, a \"NOTICE\"). Interpret QUERYP to mean that MESSAGE is +directed at the ERC client itself (a direct message), and INPUTP +to mean MESSAGE is an outgoing or echoed message originating from +or meant to simulate prompt input. Interpret a non-nil STATUSMSG +to mean MESSAGE should be formatted as a special channel message +intended for privileged members of the same or greater status. + +After deciding on the template key for the current \"speaker\" +catalog, use the remaining arguments, possibly along with +STATUSMSG, to construct the appropriate spec-args plist forming +the returned list's tail. In this plist, pair the char ?n with +NICK, the nickname of the speaker and ?m with MESSAGE, the +message body. When non-nil, assume DISP-NICK to be a possibly +phony display name to take the place of NICK for ?n. When PREFIX +is non-nil, look up NICK's channel-membership status, possibly +using PREFIX itself if it's an `erc-channel-user' object, which +it must be when called outside of a channel buffer. Pair the +result with the ?p specifier. When STATUSMSG is non-nil, pair it +with the ?s specifier. Ensure unused spec values are the empty +string rather than nil." + (when prefix + (setq prefix (erc-get-channel-membership-prefix + (if (erc-channel-user-p prefix) prefix nick)))) + (when (and queryp erc--target erc-format-query-as-channel-p + (not (erc--target-channel-p erc--target))) + (setq queryp nil)) + (list (cond (statusmsg (if inputp 'statusmsg-input 'statusmsg)) + (privmsgp (if queryp + (if inputp 'input-query-privmsg 'query-privmsg) + (if inputp 'input-chan-privmsg 'chan-privmsg))) + (t (if queryp + (if inputp 'input-query-notice 'query-notice) + (if inputp 'input-chan-notice 'chan-notice)))) + ?p (or prefix "") ?n (erc--speakerize-nick nick disp-nick) + ?s (or statusmsg "") ?m message)) + +(defcustom erc-show-speaker-membership-status nil + "Whether to prefix speakers with their channel status. +For example, when this option is non-nil and some nick \"Alice\" +has operator status in the current channel, ERC displays their +leading \"speaker\" label as <@Alice> instead of <Alice>." + :package-version '(ERC . "5.6") :group 'erc-display - :type 'function) + :type 'boolean) -(defun erc-format-nick (&optional user _channel-data) - "Return the nickname of USER. -See also `erc-format-nick-function'." - (when user (erc-server-user-nickname user))) +(define-obsolete-variable-alias 'erc-format-nick-function + 'erc-speaker-from-channel-member-function "30.1") +(defcustom erc-speaker-from-channel-member-function + #'erc-determine-speaker-from-user + "Function to determine a message's displayed \"speaker\" label. +Called with an `erc-server-user' object and an `erc-channel-user' +object, both possibly nil. Use this option to do things like +provide localized display names. To ask ERC to prepend +channel-membership \"status\" prefixes, like \"@\", to the +returned name, see `erc-show-speaker-membership-status'." + :package-version '(ERC . "5.6") + :group 'erc-display + :type '(choice (function-item erc-determine-speaker-from-user) function)) -(defun erc-get-user-mode-prefix (user) - (when user - (cond ((erc-channel-user-owner-p user) - (propertize "~" 'help-echo "owner")) - ((erc-channel-user-admin-p user) - (propertize "&" 'help-echo "admin")) - ((erc-channel-user-op-p user) - (propertize "@" 'help-echo "operator")) - ((erc-channel-user-halfop-p user) - (propertize "%" 'help-echo "half-op")) - ((erc-channel-user-voice-p user) - (propertize "+" 'help-echo "voice")) - (t "")))) +(define-obsolete-function-alias 'erc-format-nick + #'erc-determine-speaker-from-user "30.1") +(defun erc-determine-speaker-from-user (&optional user _channel-data) + "Return nickname slot of `erc-server-user' USER, when non-nil." + (when user (erc-server-user-nickname user))) -(defun erc-format-@nick (&optional user _channel-data) +(define-obsolete-function-alias 'erc-get-user-mode-prefix + #'erc-get-channel-membership-prefix "30.1") +(defun erc-get-channel-membership-prefix (nick-or-cusr) + "Return channel membership prefix for NICK-OR-CUSR as a string. +Ensure returned string has a `help-echo' text property with the +corresponding verbose membership type, like \"voice\", as its +value. Expect NICK-OR-CUSR to be an `erc-channel-user' object or +a string nickname, not necessarily downcased. When called in a +logically connected ERC buffer, use advertised prefix mappings. +For compatibility reasons, don't error when NICK-OR-CUSR is null, +but return nil instead of the empty string. Otherwise, always +return a possibly empty string." + (when nick-or-cusr + (when (stringp nick-or-cusr) + (setq nick-or-cusr (and erc-channel-members + (cdr (erc-get-channel-member nick-or-cusr))))) + (cond + ((null nick-or-cusr) "") + ;; Special-case most common value. + ((zerop (erc-channel-user-status nick-or-cusr)) "") + ;; For compatibility, first check whether a parsed prefix exists. + ((and-let* ((pfx-obj (erc--parsed-prefix))) + (catch 'done + (pcase-dolist (`(,letter . ,pfx) + (erc--parsed-prefix-alist pfx-obj)) + (when (erc--cusr-status-p nick-or-cusr letter) + (throw 'done + (pcase letter + (?q (propertize (string pfx) 'help-echo "owner")) + (?a (propertize (string pfx) 'help-echo "admin")) + (?o (propertize (string pfx) 'help-echo "operator")) + (?h (propertize (string pfx) 'help-echo "half-op")) + (?v (propertize (string pfx) 'help-echo "voice")) + (_ (string pfx)))))) + ""))) + (t + (cond ((erc-channel-user-owner nick-or-cusr) + (propertize "~" 'help-echo "owner")) + ((erc-channel-user-admin nick-or-cusr) + (propertize "&" 'help-echo "admin")) + ((erc-channel-user-op nick-or-cusr) + (propertize "@" 'help-echo "operator")) + ((erc-channel-user-halfop nick-or-cusr) + (propertize "%" 'help-echo "half-op")) + ((erc-channel-user-voice nick-or-cusr) + (propertize "+" 'help-echo "voice")) + (t "")))))) + +(defun erc-format-@nick (&optional user channel-data) "Format the nickname of USER showing if USER has a voice, is an operator, half-op, admin or owner. Owners have \"~\", admins have \"&\", operators have \"@\" and users with voice have \"+\" as a -prefix. Use CHANNEL-DATA to determine op and voice status. See -also `erc-format-nick-function'." +prefix. Use CHANNEL-DATA to determine op and voice status." + (declare (obsolete "see option `erc-show-speaker-membership-status'" "30.1")) (when user (let ((nick (erc-server-user-nickname user))) - (concat (propertize - (erc-get-user-mode-prefix nick) - 'font-lock-face 'erc-nick-prefix-face) - nick)))) + (if (not erc--speaker-status-prefix-wanted-p) + (prog1 nick + (setq erc--speaker-status-prefix-wanted-p 'erc-format-@nick)) + (concat (propertize + (erc-get-channel-membership-prefix channel-data) + 'font-lock-face 'erc-nick-prefix-face) + nick))))) (defun erc-format-my-nick () "Return the beginning of this user's message, correctly propertized." @@ -4742,15 +6290,42 @@ also `erc-format-nick-function'." (let* ((open "<") (close "> ") (nick (erc-current-nick)) - (mode (erc-get-user-mode-prefix nick))) + (mode (erc-get-channel-membership-prefix nick))) + (erc--ensure-spkr-prop nick) (concat (propertize open 'font-lock-face 'erc-default-face) (propertize mode 'font-lock-face 'erc-my-nick-prefix-face) - (propertize nick 'font-lock-face 'erc-my-nick-face) + (propertize nick 'erc--speaker nick 'font-lock-face 'erc-my-nick-face) (propertize close 'font-lock-face 'erc-default-face))) (let ((prefix "> ")) (propertize prefix 'font-lock-face 'erc-default-face)))) +(defun erc--format-speaker-input-message (message) + "Assemble outgoing MESSAGE entered at the prompt for insertion. +Intend \"input\" to refer to interactive prompt input as well as +the group of associated message-format templates from the +\"speaker\" catalog. Format the speaker portion in a manner +similar to that performed by `erc-format-my-nick', but use either +`erc--message-speaker-input-chan-privmsg' or +`erc--message-speaker-input-query-privmsg' as a formatting +template, with MESSAGE being the actual message body. Return a +copy with possibly shared text-property values." + (if-let ((erc-show-my-nick) + (nick (erc-current-nick)) + (pfx (erc-get-channel-membership-prefix nick)) + (erc-current-message-catalog erc--message-speaker-catalog) + (key (if (or erc-format-query-as-channel-p + (erc--target-channel-p erc--target)) + 'input-chan-privmsg + 'input-query-privmsg))) + (progn + (cond (erc--msg-props (puthash 'erc--msg key erc--msg-props)) + (erc--msg-prop-overrides (push (cons 'erc--msg key) + erc--msg-prop-overrides))) + (erc-format-message key ?p pfx ?n (erc--speakerize-nick nick) + ?m message)) + (propertize (concat "> " message) 'font-lock-face 'erc-input-face))) + (defun erc-echo-notice-in-default-buffer (s parsed buffer _sender) "Echo a private notice in the default buffer, namely the target buffer specified by BUFFER, or there is no target buffer, @@ -4921,9 +6496,7 @@ See also: `erc-echo-notice-in-user-buffers', (erc-load-script f))))) (defun erc-connection-established (proc parsed) - "Run just after connection. - -Set user modes and run `erc-after-connect' hook." + "Set user mode and run `erc-after-connect' hook in server buffer." (with-current-buffer (process-buffer proc) (unless erc-server-connected ; only once per session (let ((server (or erc-server-announced-name @@ -4933,26 +6506,39 @@ Set user modes and run `erc-after-connect' hook." (setq erc-server-connected t) (setq erc--server-last-reconnect-count erc-server-reconnect-count erc-server-reconnect-count 0) + (setq erc--server-reconnect-display-timer + (run-at-time erc-auto-reconnect-display-timeout nil + #'erc--server-last-reconnect-display-reset + (current-buffer))) + (add-hook 'erc-disconnected-hook + #'erc--server-last-reconnect-on-disconnect nil t) (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)))) - - (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))))) + (when erc-unhide-query-prompt + (erc-with-all-buffers-of-server erc-server-process nil + (when (and erc--target (not (erc--target-channel-p erc--target))) + (erc--unhide-prompt)))) + (run-hook-with-args 'erc-after-connect server nick))))) (defun erc-set-initial-user-mode (nick buffer) "If `erc-user-mode' is non-nil for NICK, set the user modes. The server buffer is given by BUFFER." (with-current-buffer buffer (when erc-user-mode - (let ((mode (if (functionp erc-user-mode) - (funcall erc-user-mode) - erc-user-mode))) + (let* ((mode (if (functionp erc-user-mode) + (funcall erc-user-mode) + erc-user-mode)) + (groups (erc--parse-user-modes mode (erc--user-modes) t)) + (superfluous (last groups 2)) + (redundant-want (car superfluous)) + (redundant-drop (cadr superfluous))) + (when redundant-want + (erc-display-message nil 'notice buffer 'user-mode-redundant-add + ?m (apply #'string redundant-want))) + (when redundant-drop + (erc-display-message nil 'notice buffer 'user-mode-redundant-drop + ?m (apply #'string redundant-drop))) (when (stringp mode) (erc-log (format "changing mode for %s to %s" nick mode)) (erc-server-send (format "MODE %s %s" nick mode))))))) @@ -4978,7 +6564,9 @@ See also `erc-display-message'." 'ctcp-empty ?n nick) (while queries (let* ((type (upcase (car (split-string (car queries))))) - (hook (intern-soft (concat "erc-ctcp-query-" type "-hook")))) + (hook (intern-soft (concat "erc-ctcp-query-" type "-hook"))) + (erc--msg-prop-overrides `((erc--ctcp . ,(intern type)) + ,@erc--msg-prop-overrides))) (if (and hook (boundp hook)) (if (string-equal type "ACTION") (run-hook-with-args-until-success @@ -5012,10 +6600,31 @@ See also `erc-display-message'." (let ((s (match-string 1 msg)) (buf (or (erc-get-buffer to proc) (erc-get-buffer nick proc) - (process-buffer proc)))) - (erc-display-message - parsed 'action buf - 'ACTION ?n nick ?u login ?h host ?a s)))) + (process-buffer proc))) + (selfp (erc-current-nick-p nick))) + (if erc--use-language-catalog-for-ctcp-action-p + (progn + (erc--ensure-spkr-prop nick) + (setq nick (propertize nick 'erc--speaker nick)) + (erc-display-message parsed (if selfp 'input 'action) buf + 'ACTION ?n nick ?u login ?h host ?a s)) + (let* ((obj (and (erc--ctcp-response-p parsed) parsed)) + (buffer (and obj (erc--ctcp-response-buffer obj))) + (stsmsg (and obj (erc--ctcp-response-statusmsg obj))) + (prefix (and obj (erc--ctcp-response-prefix obj))) + (dispnm (and obj (erc--ctcp-response-dispname obj))) + (erc-current-message-catalog erc--message-speaker-catalog)) + (erc-display-message + parsed nil (or buffer buf) + (if selfp + (if stsmsg 'ctcp-action-statusmsg-input 'ctcp-action-input) + (if stsmsg 'ctcp-action-statusmsg 'ctcp-action)) + ?s (or stsmsg to) + ?p (or (and (erc-channel-user-p prefix) + (erc-get-channel-membership-prefix prefix)) + "") + ?n (erc--speakerize-nick nick dispnm) + ?m s)))))) (defvar erc-ctcp-query-CLIENTINFO-hook '(erc-ctcp-query-CLIENTINFO)) @@ -5089,8 +6698,14 @@ See also `erc-display-message'." (defun erc-process-ctcp-reply (proc parsed nick login host msg) "Process MSG as a CTCP reply." (let* ((type (car (split-string msg))) - (hook (intern (concat "erc-ctcp-reply-" type "-hook")))) - (if (boundp hook) + (hook (intern-soft (concat "erc-ctcp-reply-" type "-hook"))) + ;; Help `erc-display-message' by ensuring subsequent + ;; insertions retain the necessary props. + (cmd (erc--get-eq-comparable-cmd (erc-response.command parsed))) + (erc--msg-prop-overrides `((erc--ctcp . ,(and hook (intern type))) + (erc--cmd . ,cmd) + ,@erc--msg-prop-overrides))) + (if (and hook (boundp hook)) (run-hook-with-args-until-success hook proc nick login host (car (erc-response.command-args parsed)) msg) @@ -5224,22 +6839,78 @@ 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 (erc-with-server-buffer (erc--get-isupport-entry 'PREFIX t)) - ;; provide a sane default - "(qaohv)~&@%+")) - types chars) - (when (string-match "^(\\([^)]+\\))\\(.+\\)$" str) - (setq types (match-string 1 str) - chars (match-string 2 str)) - (let ((len (min (length types) (length chars))) - (i 0) - (alist nil)) - (while (< i len) - (setq alist (cons (cons (elt types i) (elt chars i)) - alist)) - (setq i (1+ i))) - alist)))) +For example, if the current ISUPPORT \"PREFIX\" is \"(ov)@+\", +return an alist `equal' to ((?v . ?+) (?o . ?@)). For historical +reasons, ensure the ordering of the returned alist is opposite +that of the advertised parameter." + (let* ((str (or (erc--get-isupport-entry 'PREFIX t) "(qaohv)~&@%+")) + (i 0) + (j (string-search ")" str)) + collected) + (when j + (while-let ((u (aref str (cl-incf i))) + ((not (= ?\) u)))) + (push (cons u (aref str (cl-incf j))) collected))) + collected)) + +(defvar-local erc--parsed-prefix nil + "Possibly stale `erc--parsed-prefix' struct instance for the server. +Use the \"getter\" function of the same name to obtain the current +value.") + +(defun erc--parsed-prefix () + "Return possibly cached `erc--parsed-prefix' object for the server. +Ensure the returned value describes the most recent \"PREFIX\" +parameter advertised by the current server, with the original +ordering intact. If no such parameter has yet arrived, return a +stand-in from the fallback value \"(qaohv)~&@%+\"." + (erc--with-isupport-data PREFIX erc--parsed-prefix + (let ((alist (erc-parse-prefix))) + (make-erc--parsed-prefix + :key key + :letters (apply #'string (map-keys alist)) + :statuses (apply #'string (map-values alist)) + :alist (nreverse alist))))) + +(defun erc--get-prefix-flag (char &optional parsed-prefix from-prefix-p) + "Return numeric rank for CHAR or nil if unknown. +For example, given letters \"qaohv\" return 1 for ?v, 2 for ?h, +and 4 for ?o, etc. If given, expect PARSED-PREFIX to be a +`erc--parsed-prefix' object. With FROM-PREFIX-P, expect CHAR to +be a prefix instead." + (and-let* ((obj (or parsed-prefix (erc--parsed-prefix))) + (pos (erc--strpos char (if from-prefix-p + (erc--parsed-prefix-statuses obj) + (erc--parsed-prefix-letters obj))))) + (ash 1 pos))) + +(defun erc--init-cusr-fallback-status (voice halfop op admin owner) + "Return channel-membership based on traditional status semantics. +Massage boolean switches VOICE, HALFOP, OP, ADMIN, and OWNER into +an internal numeric value suitable for the `status' slot of a new +`erc-channel-user' object." + (let ((pfx (erc--parsed-prefix))) + (+ (if voice (if pfx (or (erc--get-prefix-flag ?v pfx) 0) 1) 0) + (if halfop (if pfx (or (erc--get-prefix-flag ?h pfx) 0) 2) 0) + (if op (if pfx (or (erc--get-prefix-flag ?o pfx) 0) 4) 0) + (if admin (if pfx (or (erc--get-prefix-flag ?a pfx) 0) 8) 0) + (if owner (if pfx (or (erc--get-prefix-flag ?q pfx) 0) 16) 0)))) + +(defun erc--compute-cusr-fallback-status (current v h o a q) + "Return current channel membership after toggling V H O A Q as requested. +Assume `erc--parsed-prefix' is non-nil in the current buffer. +Expect status switches V, H, O, A, Q, when non-nil, to be the +symbol `on' or `off'. Return an internal numeric value suitable +for the `status' slot of an `erc-channel-user' object." + (let (on off) + (when v (push (or (erc--get-prefix-flag ?v) 0) (if (eq v 'on) on off))) + (when h (push (or (erc--get-prefix-flag ?h) 0) (if (eq h 'on) on off))) + (when o (push (or (erc--get-prefix-flag ?o) 0) (if (eq o 'on) on off))) + (when a (push (or (erc--get-prefix-flag ?a) 0) (if (eq a 'on) on off))) + (when q (push (or (erc--get-prefix-flag ?q) 0) (if (eq q 'on) on off))) + (when on (setq current (apply #'logior current on))) + (when off (setq current (apply #'logand current (mapcar #'lognot off))))) + current) (defcustom erc-channel-members-changed-hook nil "This hook is called every time the variable `channel-members' changes. @@ -5247,48 +6918,40 @@ The buffer where the change happened is current while this hook is called." :group 'erc-hooks :type 'hook) -(defun erc-channel-receive-names (names-string) - "This function is for internal use only. +(defun erc--partition-prefixed-names (name) + "From NAME, return a list of (STATUS NICK LOGIN HOST). +Expect NAME to be a prefixed name, like @bob." + (unless (string-empty-p name) + (let* ((status (erc--get-prefix-flag (aref name 0) nil 'from-prefix-p)) + (nick (if status (substring name 1) name))) + (unless (string-empty-p nick) + (list status nick nil nil))))) -Update `erc-channel-users' according to NAMES-STRING. -NAMES-STRING is a string listing some of the names on the -channel." - (let* ((prefix (erc-parse-prefix)) - (voice-ch (cdr (assq ?v prefix))) - (op-ch (cdr (assq ?o prefix))) - (hop-ch (cdr (assq ?h prefix))) - (adm-ch (cdr (assq ?a prefix))) - (own-ch (cdr (assq ?q prefix))) - (names (delete "" (split-string names-string))) - name op voice halfop admin owner) - (let ((erc-channel-members-changed-hook nil)) - (dolist (item names) - (let ((updatep t) - (ch (aref item 0))) - (setq name item op 'off voice 'off halfop 'off admin 'off owner 'off) - (if (rassq ch prefix) - (if (= (length item) 1) - (setq updatep nil) - (setq name (substring item 1)) - (setf (pcase ch - ((pred (eq voice-ch)) voice) - ((pred (eq hop-ch)) halfop) - ((pred (eq op-ch)) op) - ((pred (eq adm-ch)) admin) - ((pred (eq own-ch)) owner) - (_ (message "Unknown prefix char `%S'" ch) voice)) - 'on))) - (when updatep +(defun erc-channel-receive-names (names-string) + "Update `erc-channel-members' from NAMES-STRING. +Expect NAMES-STRING to resemble the trailing argument of a 353 +RPL_NAMREPLY. Call internal handlers for parsing individual +names, whose expected composition may differ depending on enabled +extensions." + (let ((names (delete "" (split-string names-string))) + (erc-channel-members-changed-hook nil)) + (dolist (name names) + (when-let ((args (erc--partition-prefixed-names name))) + (pcase-let* ((`(,status ,nick ,login ,host) args) + (cmem (erc-get-channel-user nick))) + (progn ;; If we didn't issue the NAMES request (consider two clients ;; talking to an IRC proxy), `erc-channel-begin-receiving-names' ;; will not have been called, so we have to do it here. (unless erc-channel-new-member-names (erc-channel-begin-receiving-names)) - (puthash (erc-downcase name) t - erc-channel-new-member-names) - (erc-update-current-channel-member - name name t voice halfop op admin owner))))) - (run-hooks 'erc-channel-members-changed-hook))) + (puthash (erc-downcase nick) t erc-channel-new-member-names) + (if cmem + (erc--update-current-channel-member cmem status nil + nick host login) + (erc--create-current-channel-member nick status nil + nick host login))))))) + (run-hooks 'erc-channel-members-changed-hook)) (defun erc-update-user-nick (nick &optional new-nick host login full-name info) @@ -5340,111 +7003,114 @@ which USER is a member, and t is returned." (run-hooks 'erc-channel-members-changed-hook)))))) changed)) -(defun erc-update-current-channel-member - (nick new-nick &optional add voice halfop op admin owner host login full-name info - update-message-time) - "Update the stored user information for the user with nickname NICK. -`erc-update-user' is called to handle changes to nickname, -HOST, LOGIN, FULL-NAME, and INFO. If VOICE HALFOP OP ADMIN or OWNER -are non-nil, they must be equal to either `on' or `off', in which -case the status of the user in the current channel is changed accordingly. -If UPDATE-MESSAGE-TIME is non-nil, the last-message-time of the user - in the current channel is set to (current-time). - -If ADD is non-nil, the user will be added with the specified -information if it is not already present in the user or channel -lists. - -If, and only if, changes are made, or the user is added, -`erc-channel-members-changed-hook' is run, and t is returned. - -See also: `erc-update-user' and `erc-update-channel-member'." - (let* (changed user-changed - (channel-data (erc-get-channel-user nick)) - (cuser (cdr channel-data)) - (user (if channel-data (car channel-data) - (erc-get-server-user nick)))) - (if cuser +(defun erc--create-current-channel-member + (nick status timep &optional new-nick host login full-name info) + "Add an `erc-channel-member' entry for NICK. +Create a new `erc-server-users' entry if necessary, and ensure +`erc-channel-members-changed-hook' runs exactly once, regardless. +Pass STATUS to the `erc-channel-user' constructor. With TIMEP, +assume NICK has just spoken, and initialize `last-message-time'. +Pass NEW-NICK, HOST, LOGIN, FULL-NAME, and INFO to +`erc-update-user' if a server user exists and otherwise to the +`erc-server-user' constructor." + (cl-assert (null (erc-get-channel-member nick))) + (let* ((user-changed-p nil) + (down (erc-downcase nick)) + (user (gethash down (erc-with-server-buffer erc-server-users)))) + (if user (progn - (erc-log (format "update-member: user = %S, cuser = %S" user cuser)) - (when (and voice - (not (eq (erc-channel-user-voice cuser) voice))) - (setq changed t) - (setf (erc-channel-user-voice cuser) - (cond ((eq voice 'on) t) - ((eq voice 'off) nil) - (t voice)))) - (when (and halfop - (not (eq (erc-channel-user-halfop cuser) halfop))) - (setq changed t) - (setf (erc-channel-user-halfop cuser) - (cond ((eq halfop 'on) t) - ((eq halfop 'off) nil) - (t halfop)))) - (when (and op - (not (eq (erc-channel-user-op cuser) op))) - (setq changed t) - (setf (erc-channel-user-op cuser) - (cond ((eq op 'on) t) - ((eq op 'off) nil) - (t op)))) - (when (and admin - (not (eq (erc-channel-user-admin cuser) admin))) - (setq changed t) - (setf (erc-channel-user-admin cuser) - (cond ((eq admin 'on) t) - ((eq admin 'off) nil) - (t admin)))) - (when (and owner - (not (eq (erc-channel-user-owner cuser) owner))) - (setq changed t) - (setf (erc-channel-user-owner cuser) - (cond ((eq owner 'on) t) - ((eq owner 'off) nil) - (t owner)))) - (when update-message-time - (setf (erc-channel-user-last-message-time cuser) (current-time))) - (setq user-changed - (erc-update-user user new-nick - host login full-name info))) - (when add - (if (null user) - (progn - (setq user (make-erc-server-user - :nickname nick - :host host - :full-name full-name - :login login - :info info - :buffers (list (current-buffer)))) - (erc-add-server-user nick user)) - (setf (erc-server-user-buffers user) - (cons (current-buffer) - (erc-server-user-buffers user)))) - (setq cuser (make-erc-channel-user - :voice (cond ((eq voice 'on) t) - ((eq voice 'off) nil) - (t voice)) - :halfop (cond ((eq halfop 'on) t) - ((eq halfop 'off) nil) - (t halfop)) - :op (cond ((eq op 'on) t) - ((eq op 'off) nil) - (t op)) - :admin (cond ((eq admin 'on) t) - ((eq admin 'off) nil) - (t admin)) - :owner (cond ((eq owner 'on) t) - ((eq owner 'off) nil) - (t owner)) - :last-message-time - (if update-message-time (current-time)))) - (puthash (erc-downcase nick) (cons user cuser) - erc-channel-users) - (setq changed t))) - (when (and changed (null user-changed)) + (cl-pushnew (current-buffer) (erc-server-user-buffers user)) + ;; Update *after* ^ so hook has chance to run. + (setf user-changed-p (erc-update-user user new-nick host login + full-name info))) + (erc-add-server-user nick + (setq user (make-erc-server-user + :nickname (or new-nick nick) + :host host + :full-name full-name + :login login + :info nil + :buffers (list (current-buffer)))))) + (let ((cusr (erc-channel-user--make + :status (or status 0) + :last-message-time (and timep + (erc-compat--current-lisp-time))))) + (puthash down (cons user cusr) erc-channel-users)) + ;; An existing `cusr' was changed or a new one was added, and + ;; `user' was not updated, though possibly just created (since + ;; `erc-update-user' runs this same hook in all a user's buffers). + (unless user-changed-p + (run-hooks 'erc-channel-members-changed-hook)) + t)) + +(defun erc--update-current-channel-member (cmem status timep &rest user-args) + "Update existing `erc-channel-member' entry. +Set the `status' slot of the entry's `erc-channel-user' side to +STATUS and, with TIMEP, update its `last-message-time'. When +actual changes are made, run `erc-channel-members-changed-hook', +and return non-nil." + (cl-assert cmem) + (let ((cusr (cdr cmem)) + (user (car cmem)) + cusr-changed-p user-changed-p) + (when (and status (/= status (erc-channel-user-status cusr))) + (setf (erc-channel-user-status cusr) status + cusr-changed-p t)) + (when timep + (setf (erc-channel-user-last-message-time cusr) + (erc-compat--current-lisp-time))) + ;; Ensure `erc-channel-members-changed-hook' runs on change. + (cl-assert (memq (current-buffer) (erc-server-user-buffers user))) + (setq user-changed-p (apply #'erc-update-user user user-args)) + ;; An existing `cusr' was changed or a new one was added, and + ;; `user' was not updated, though possibly just created (since + ;; `erc-update-user' runs this same hook in all a user's buffers). + (when (and cusr-changed-p (null user-changed-p)) (run-hooks 'erc-channel-members-changed-hook)) - (or changed user-changed add))) + (erc-log (format "update-member: user = %S, cusr = %S" user cusr)) + (or cusr-changed-p user-changed-p))) + +(defun erc-update-current-channel-member + (nick new-nick &optional addp voice halfop op admin owner host login + full-name info update-message-time) + "Update or create entry for NICK in current `erc-channel-members' table. +With ADDP, ensure an entry exists. When an entry does exist or +when ADDP is non-nil and an `erc-server-users' entry already +exists, call `erc-update-user' with NEW-NICK, HOST, LOGIN, +FULL-NAME, and INFO. Expect any non-nil membership +status switches among VOICE, HALFOP, OP, ADMIN, and OWNER to be +the symbol `on' or `off' when needing to influence a new or +existing `erc-channel-user' object's `status' slot. Likewise, +when UPDATE-MESSAGE-TIME is non-nil, update or initialize the +`last-message-time' slot to the current-time. If changes occur, +including creation, run `erc-channel-members-changed-hook'. +Return non-nil when meaningful changes, including creation, have +occurred. + +Without ADDP, do nothing unless a `erc-channel-members' entry +exists. When it doesn't, assume the sender is a non-joined +entity, like the server itself or a historical speaker, or assume +the prior buffer for the channel was killed without parting." +(let* ((cmem (erc-get-channel-member nick)) + (status (and (or voice halfop op admin owner) + (if cmem + (erc--compute-cusr-fallback-status + (erc-channel-user-status (cdr cmem)) + voice halfop op admin owner) + (erc--init-cusr-fallback-status + (and voice (eq voice 'on)) + (and halfop (eq halfop 'on)) + (and op (eq op 'on)) + (and admin (eq admin 'on)) + (and owner (eq owner 'on))))))) + (if cmem + (erc--update-current-channel-member cmem status update-message-time + new-nick host login + full-name info) + (when addp + (erc--create-current-channel-member nick status update-message-time + new-nick host login + full-name info))))) (defun erc-update-channel-member (channel nick new-nick &optional add voice halfop op admin owner host login @@ -5489,7 +7155,9 @@ TOPIC string to the current topic." (defun erc-set-modes (tgt mode-string) "Set the modes for the TGT provided as MODE-STRING." - (let* ((modes (erc-parse-modes mode-string)) + (declare (obsolete "see comment atop `erc--update-modes'" "30.1")) + (let* ((modes (with-suppressed-warnings ((obsolete erc-parse-modes)) + (erc-parse-modes mode-string))) (add-modes (nth 0 modes)) ;; list of triples: (mode-char 'on/'off argument) (arg-modes (nth 2 modes))) @@ -5535,6 +7203,7 @@ for modes without parameters to add and remove respectively. The arg-modes is a list of triples of the form: (MODE-CHAR ON/OFF ARGUMENT)." + (declare (obsolete "see comment atop `erc--update-modes'" "30.1")) (if (string-match "^\\s-*\\(\\S-+\\)\\(\\s-.*$\\|$\\)" mode-string) (let ((chars (mapcar #'char-to-string (match-string 1 mode-string))) ;; arguments in channel modes @@ -5579,8 +7248,10 @@ arg-modes is a list of triples of the form: "Update the mode information for TGT, provided as MODE-STRING. Optional arguments: NICK, HOST and LOGIN - the attributes of the person who changed the modes." + (declare (obsolete "see comment atop `erc--update-modes'" "30.1")) ;; FIXME: neither of nick, host, and login are used! - (let* ((modes (erc-parse-modes mode-string)) + (let* ((modes (with-suppressed-warnings ((obsolete erc-parse-modes)) + (erc-parse-modes mode-string))) (add-modes (nth 0 modes)) (remove-modes (nth 1 modes)) ;; list of triples: (mode-char 'on/'off argument) @@ -5629,9 +7300,255 @@ person who changed the modes." ;; nick modes - ignored at this point (t nil)))) +(defvar-local erc--channel-modes nil + "When non-nil, a hash table of current channel modes. +Keys are characters. Values are either a string, for types A-C, +or t, for type D.") + +(defvar-local erc--channel-mode-types nil + "Possibly stale `erc--channel-mode-types' instance for the server. +Use the getter of the same name to retrieve the current value.") + +(defvar-local erc--mode-line-mode-string nil + "Computed mode-line or header-line component for user/channel modes.") + +(defvar erc--mode-line-chanmodes-arg-len 10 + "Max length at which to truncate channel-mode args in header line.") + +(defun erc--channel-mode-types () + "Return variable `erc--channel-mode-types', possibly initializing it." + (erc--with-isupport-data CHANMODES erc--channel-mode-types + (let ((types (or key '(nil "Kk" "Ll" nil))) + (ct (make-char-table 'erc--channel-mode-types)) + (type ?a)) + (dolist (cs types) + (erc--doarray (c cs) + (aset ct c type)) + (cl-incf type)) + (make-erc--channel-mode-types :key key + :fallbackp (null key) + :table ct)))) + +(defun erc--process-channel-modes (string args &optional status-letters) + "Parse channel \"MODE\" changes and call unary letter handlers. +Update `erc-channel-modes' and `erc--channel-modes'. With +STATUS-LETTERS, also update channel membership prefixes. Expect +STRING to be the second argument from an incoming \"MODE\" +command and ARGS to be the remaining arguments, which should +complement relevant letters in STRING." + (cl-assert (erc--target-channel-p erc--target)) + (let* ((obj (erc--channel-mode-types)) + (table (erc--channel-mode-types-table obj)) + (fallbackp (erc--channel-mode-types-fallbackp obj)) + (+p t)) + (erc--doarray (c string) + (cond ((= ?+ c) (setq +p t)) + ((= ?- c) (setq +p nil)) + ((and status-letters (string-search (string c) status-letters)) + (erc--cusr-change-status (pop args) c +p)) + ((and-let* ((group (or (aref table c) (and fallbackp ?d)))) + (erc--handle-channel-mode group c +p + (and (/= group ?d) + (or (/= group ?c) +p) + (pop args))) + t)) + ((not fallbackp) + (erc-display-message nil '(notice error) (erc-server-buffer) + (format "Unknown channel mode: %S" c))))) + (setq erc-channel-modes (sort erc-channel-modes #'string<)) + (setq erc--mode-line-mode-string + (concat "+" (erc--channel-modes erc--mode-line-chanmodes-arg-len))) + (erc-update-mode-line (current-buffer)))) + +(defvar-local erc--user-modes nil + "Sorted list of current user \"MODE\" letters. +Analogous to `erc-channel-modes' but chars rather than strings.") + +(defun erc--user-modes (&optional as-type) + "Return user \"MODE\" letters in a form described by AS-TYPE. +When AS-TYPE is the symbol `strings' (plural), return a list of +strings. When it's `string' (singular), return the same list +concatenated into a single string. When AS-TYPE is nil, return a +list of chars." + (let ((modes (or erc--user-modes (erc-with-server-buffer erc--user-modes)))) + (pcase as-type + ('strings (mapcar #'char-to-string modes)) + ('string (apply #'string modes)) + (_ modes)))) + +(defun erc--channel-modes (&optional as-type sep) + "Return channel \"MODE\" settings in a form described by AS-TYPE. +When AS-TYPE is the symbol `strings' (plural), return letter keys +as a list of sorted string. When it's `string' (singular), +return keys as a single string. When it's a number N, return a +single string consisting of the concatenated and sorted keys +followed by a space and then their corresponding args, each +truncated to N chars max. ERC joins these args together with +SEP, which defaults to a single space. Otherwise, return a +sorted alist of letter and arg pairs. In all cases that include +values, respect `erc-show-channel-key-p' and optionally omit the +secret key associated with the letter k." + (and-let* ((modes erc--channel-modes) + (tobj (erc--channel-mode-types)) + (types (erc--channel-mode-types-table tobj))) + (let (out) + (maphash (lambda (k v) + (unless (eq ?a (aref types k)) + (push (cons k + (and (not (eq t v)) + (not (and (eq k ?k) + (not (bound-and-true-p + erc-show-channel-key-p)))) + v)) + out))) + modes) + (setq out (cl-sort out #'< :key #'car)) + (pcase as-type + ('strings (mapcar (lambda (o) (char-to-string (car o))) out)) + ('string (apply #'string (mapcar #'car out))) + ((and (pred natnump) c) + (let (keys vals) + (pcase-dolist (`(,k . ,v) out) + (when v + (push (if (> (length v) c) + (with-memoization + (gethash (list c k v) + (erc--channel-mode-types-shortargs tobj)) + (truncate-string-to-width v c 0 nil t)) + v) + vals)) + (push k keys)) + (concat (apply #'string (nreverse keys)) (and vals " ") + (string-join (nreverse vals) (or sep " "))))) + (_ out))))) + +(defun erc--parse-user-modes (string &optional current extrap) + "Return lists of chars from STRING to add to and drop from CURRENT. +Expect STRING to be a so-called \"modestring\", the second +parameter of a \"MODE\" command, here containing only valid +user-mode letters. Expect CURRENT to be a list of chars +resembling those found in `erc--user-modes'. With EXTRAP, return +two additional lists of chars: those that would be added were +they not already present in CURRENT and those that would be +dropped were they not already absent." + (let ((addp t) + ;; + redundant-add redundant-drop adding dropping) + (erc--doarray (c string) + (pcase c + (?+ (setq addp t)) + (?- (setq addp nil)) + (_ (push c (let ((hasp (and current (memq c current)))) + (if addp + (if hasp redundant-add adding) + (if hasp dropping redundant-drop))))))) + (if extrap + (list (nreverse adding) (nreverse dropping) + (nreverse redundant-add) (nreverse redundant-drop)) + (list (nreverse adding) (nreverse dropping))))) + +(defun erc--update-user-modes (string) + "Update `erc--user-modes' from \"MODE\" STRING. +Return its value, a list of characters sorted by character code." + (prog1 + (setq erc--user-modes + (pcase-let ((`(,adding ,dropping) + (erc--parse-user-modes string erc--user-modes))) + (sort (seq-difference (nconc erc--user-modes adding) dropping) + #'<))) + (setq erc--mode-line-mode-string + (concat "+" (erc--user-modes 'string))))) + +(defun erc--update-channel-modes (string &rest args) + "Update `erc-channel-modes' and call individual mode handlers. +Also update membership prefixes, as needed. Expect STRING to be +a \"modestring\" and ARGS to match mode-specific parameters." + (let ((status-letters (or (erc-with-server-buffer + (erc--parsed-prefix-letters + (erc--parsed-prefix))) + "qaovhbQAOVHB"))) + (erc--process-channel-modes string args status-letters))) + +;; XXX this comment is referenced elsewhere (grep before deleting). +;; +;; The function `erc-update-modes' was deprecated in ERC 5.6 with no +;; immediate public replacement. Third parties needing such a thing +;; are encouraged to write to emacs-erc@gnu.org with ideas for a +;; mode-handler API, possibly one incorporating letter-specific +;; handlers, like `erc--handle-channel-mode' (below), which only +;; handles mode types A-C. +(defun erc--update-modes (raw-args) + "Handle user or channel \"MODE\" update from server. +Expect RAW-ARGS be a list consisting of a \"modestring\" followed +by mode-specific arguments." + (if (and erc--target (erc--target-channel-p erc--target)) + (apply #'erc--update-channel-modes raw-args) + (erc--update-user-modes (car raw-args)))) + +(defun erc--init-channel-modes (channel raw-args) + "Set CHANNEL modes from RAW-ARGS. +Expect RAW-ARGS to be a \"modestring\" without any status-prefix +chars, followed by applicable arguments." + (erc-with-buffer (channel) + (erc--process-channel-modes (car raw-args) (cdr raw-args)))) + +(cl-defgeneric erc--handle-channel-mode (type letter state arg) + "Handle a STATE change for mode LETTER of TYPE with ARG. +Expect to be called in the affected target buffer. Expect TYPE +to be a character, like ?a, representing an advertised +\"CHANMODES\" group. Expect LETTER to also be a character, and +expect STATE to be a boolean and ARGUMENT either a string or nil." + (erc-log (format "Channel-mode %c (type %s, arg %S) %s" + letter type arg (if state 'enabled 'disabled)))) + +(cl-defmethod erc--handle-channel-mode :before (type c state arg) + "Record STATE change for mode letter C. +When STATE is non-nil, add or update C's mapping in +`erc--channel-modes', associating it with ARG if C takes a +parameter and t otherwise. When STATE is nil, forget the +mapping. For type A, add up update a permanent mapping for C, +associating it with an integer indicating a running total of +STATE changes since joining the channel. In most cases, this +won't match the number known to the server." + (unless erc--channel-modes + (cl-assert (erc--target-channel-p erc--target)) + (setq erc--channel-modes (make-hash-table))) + (if (= type ?a) + (cl-callf (lambda (s) (+ (or s 0) (if state +1 -1))) + (gethash c erc--channel-modes)) + (if state + (puthash c (or arg t) erc--channel-modes) + (remhash c erc--channel-modes)))) + +(cl-defmethod erc--handle-channel-mode :before ((_ (eql ?d)) c state _) + "Update `erc-channel-modes' for any character C of nullary type D. +Remember when STATE is non-nil and forget otherwise." + (setq erc-channel-modes + (if state + (cl-pushnew (char-to-string c) erc-channel-modes :test #'equal) + (delete (char-to-string c) erc-channel-modes)))) + +;; We could specialize on type C, but that may be too brittle. +(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?l)) state arg) + "Update channel user limit, remembering ARG when STATE is non-nil." + (erc-update-channel-limit (erc--target-string erc--target) + (if state 'on 'off) + arg)) + +;; We could specialize on type B, but that may be too brittle. +(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?k)) state arg) + "Update channel key, remembering ARG when state is non-nil." + ;; Mimic old parsing behavior in which an ARG of "*" was discarded + ;; even though `erc-update-channel-limit' checks STATE first. + (erc-update-channel-key (erc--target-string erc--target) + (if state 'on 'off) + (if (equal arg "*") nil arg))) + (defun erc-update-channel-limit (channel onoff n) - ;; FIXME: what does ONOFF actually do? -- Lawrence 2004-01-08 - "Update CHANNEL's user limit to N." + "Update CHANNEL's user limit to N. +Expect ONOFF to be `on' when the mode is being enabled and `off' +otherwise. And because this mode is of \"type C\", expect N to +be non-nil only when enabling." (if (or (not (eq onoff 'on)) (and (stringp n) (string-match "^[0-9]+$" n))) (erc-with-buffer @@ -5703,20 +7620,28 @@ OBJECT is modified without being copied first. You can redefine or `defadvice' this function in order to add EmacsSpeak support." - (put-text-property start end property value object)) + (if erc--merge-text-properties-p + (erc--merge-prop start end property value object) + (put-text-property start end property value object))) -(defun erc-list (thing) - "Return THING if THING is a list, or a list with THING as its element." - (if (listp thing) - thing - (list thing))) +(defalias 'erc-list 'ensure-list) + +(defconst erc--parse-user-regexp-pedantic + (rx bot (? (? (group (+ (not (any "!@\r\n"))))) "!") + (? (? (group (+ nonl))) "@") + (? (group (+ nonl))) eot)) + +(defconst erc--parse-user-regexp-legacy + "^\\([^!\n]*\\)!\\([^@\n]*\\)@\\(.*\\)$") + +(defvar erc--parse-user-regexp erc--parse-user-regexp-legacy) (defun erc-parse-user (string) "Parse STRING as a user specification (nick!login@host). Return a list of the three separate tokens." (cond - ((string-match "^\\([^!\n]*\\)!\\([^@\n]*\\)@\\(.*\\)$" string) + ((string-match erc--parse-user-regexp string) (list (match-string 1 string) (match-string 2 string) (match-string 3 string))) @@ -5728,6 +7653,26 @@ Return a list of the three separate tokens." (t (list string "" "")))) +(defun erc--parse-nuh (string) + "Match STRING against `erc--parse-user-regexp-pedantic'. +Return nil or matching groups representing nick, login, and host, +any of which may be nil. Expect STRING not to contain leading +prefix chars. Return an empty nick component to indicate further +processing is required based on context. Interpret a lone token +lacking delimiters or one with only a leading \"!\" as a host. + +See associated unit test for precise behavior." + (when (string-match erc--parse-user-regexp-pedantic string) + (list (match-string 1 string) + (match-string 2 string) + (match-string 3 string)))) + +(defun erc--shuffle-nuh-nickward (nick login host) + "Interpret results of `erc--parse-nuh', promoting loners to nicks." + (cond (nick (cl-assert (null login)) (list nick login host)) + ((and (null login) host) (list host nil nil)) + ((and login (null host)) (list login nil nil)))) + (defun erc-extract-nick (string) "Return the nick corresponding to a user specification STRING. @@ -5771,76 +7716,200 @@ If that function has never been called, the value is 0.") "Minimum time, in seconds, before sending new lines via IRC. If the value is a number, `erc-send-current-line' signals an error if its previous invocation was fewer than this many seconds ago. -This is useful so that if you accidentally enter large amounts of text -into the ERC buffer, that text is not sent to the IRC server. - If the value is nil, `erc-send-current-line' always considers any -submitted line to be intentional." +submitted line to be intentional. + +This option mainly prevents text accidentally entered into Emacs +from being sent to the server. Offending sources include +terminal multiplexers, desktop-automation scripts, and anything +capable of rapidly submitting successive lines of prompt input. +For example, if you could somehow manage to type \"one \\`RET' +two \\`RET' three \\`RET'\" at the prompt in less than +`erc-accidental-paste-threshold-seconds', ERC would send \"one\" +to the server, leave \"two\" at the prompt, and insert \"three\" +into an \"overflow\" buffer. See `erc-inhibit-multiline-input' +and `erc-warn-about-blank-lines' for suppression involving input +yanked from the clipboard or the kill ring, which is a related +but separate concern. + +Users of terminal multiplexers, in particular, should look into +support for \"bracketed pasting\", provided on the Emacs side by +libraries like `xterm' (and usually enabled by default). When +everything's working smoothly, Emacs transparently arranges for +pasted text to appear on the kill ring, regardless of any +read-only warnings you may encounter. And when point is in the +prompt area, ERC automatically yanks that text for previewing but +holds off on submitting it, for obvious reasons." :group 'erc :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)))))) +(defvar erc-command-regexp "^/\\([A-Za-z']+\\)\\(\\s-+.*\\|\\s-*\\)$" + "Regular expression used for matching commands in ERC.") (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) + (let ((max (if (eq erc-inhibit-multiline-input t) 2 erc-inhibit-multiline-input)) (seen 0) - msg) - (while (and (pop reversed) (< (cl-incf seen) max))) + last msg) + (while (and lines (setq last (pop lines)) (< (cl-incf seen) max))) (when (= seen max) - (setq msg (format "(exceeded by %d)" (1+ (length reversed)))) + (push last lines) + (setq msg + (format "-- exceeded by %d (%d chars)" + (length lines) + (apply #'+ (mapcar #'length lines)))) (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) +(defun erc--check-prompt-input-for-something (string _) + (when (string-empty-p string) (if erc-warn-about-blank-lines "Blank line - ignoring..." 'invalid))) +(defun erc--count-blank-lines (lines) + "Report on the number of whitespace-only and empty LINES. +Return a list of (BLANKS TO-PAD TO-STRIP). Expect caller to know +that BLANKS includes non-empty whitespace-only lines and that no +padding or stripping has yet occurred." + (let ((real 0) (total 0) (pad 0) (strip 0)) + (dolist (line lines) + (if (string-match (rx bot (* (in " \t\f")) eot) line) + (progn + (cl-incf total) + (if (zerop (match-end 0)) + (cl-incf strip) + (cl-incf pad strip) + (setq strip 0))) + (cl-incf real) + (unless (zerop strip) + (cl-incf pad strip) + (setq strip 0)))) + (when (and (zerop real) (not (zerop total)) (= total (+ pad strip))) + (cl-incf strip (1- pad)) + (setq pad 1)) + (list total pad strip))) + +(defvar erc--check-prompt-explanation nil + "List of strings to print if no validator returns non-nil.") + +(defun erc--check-prompt-input-for-multiline-blanks (_ lines) + "Return non-nil when multiline prompt input has blank LINES. +Consider newlines to be intervening delimiters, meaning the empty +\"logical\" line between a trailing newline and `eob' constitutes +a separate message." + (pcase-let ((`(,total ,pad ,strip)(erc--count-blank-lines lines))) + (cond ((zerop total) nil) + ((and erc-warn-about-blank-lines erc-send-whitespace-lines) + (let (msg args) + (unless (zerop strip) + (push "stripping (%d)" msg) + (push strip args)) + (unless (zerop pad) + (when msg + (push "and" msg)) + (push "padding (%d)" msg) + (push pad args)) + (when msg + (push "blank" msg) + (push (if (> (apply #'+ args) 1) "lines" "line") msg)) + (when msg + (setf msg (nreverse msg) + (car msg) (capitalize (car msg)))) + (when msg + (push (apply #'format (string-join msg " ") (nreverse args)) + erc--check-prompt-explanation) + nil))) + (erc-warn-about-blank-lines + (concat (if (= total 1) + (if (zerop strip) "Blank" "Trailing") + (if (= total strip) + (format "%d trailing" strip) + (format "%d blank" total))) + (and (> total 1) (/= total strip) (not (zerop strip)) + (format " (%d trailing)" strip)) + (if (= total 1) " line" " lines") + " detected (see `erc-send-whitespace-lines')")) + (erc-send-whitespace-lines nil) + (t '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")) +;; Originally, `erc-send-current-line' inhibited sends whenever a +;; server buffer was missing. In 2007, this was narrowed to +;; occurrences involving process-dependent commands. However, the +;; accompanying error message, which was identical to that emitted by +;; `erc-server-send', "ERC: No process running", was always inaccurate +;; because a server buffer can be alive and its process dead. (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")) + "Return non-nil if STRING is a slash command missing a process. +Also do so when the server buffer has been killed." + ;; Even if the server buffer has been killed, the user should still + ;; be able to /reconnect and recall previous commands. + (and (not (erc-command-no-process-p string)) + (or (and (not (erc-server-buffer-live-p)) "Server buffer missing") + (and (not (erc-server-process-alive)) "Process not running")))) + +(defun erc--check-prompt-input-for-multiline-command (line lines) + "Return non-nil when non-blank lines follow a command line." + (when (and (cdr lines) + (string-match erc-command-regexp line) + (seq-drop-while #'string-empty-p (reverse (cdr lines)))) + "Excess input after command line")) (defvar erc--check-prompt-input-functions '(erc--check-prompt-input-for-point-in-bounds + erc--check-prompt-input-for-something + erc--check-prompt-input-for-multiline-command 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'.") +Called with two arguments: the current input submitted by the +user, as a string, along with the same input as a list of +strings. If any member function returns non-nil, ERC abandons +processing and leaves pending input untouched in the prompt area. +When the returned value is a string, ERC passes it to +`user-error'. Any other non-nil value tells ERC to abort +silently. If all members return nil, and the variable +`erc--check-prompt-explanation' is a nonempty list of strings, +ERC prints them as a single message joined by newlines.") + +(defun erc--run-input-validation-checks (state) + "Run input checkers from STATE, an `erc--input-split' object." + (let* ((erc--check-prompt-explanation nil) + (msg (run-hook-with-args-until-success + 'erc--check-prompt-input-functions + (erc--input-split-string state) + (erc--input-split-lines state)))) + (cond ((stringp msg) (user-error msg)) + (msg (push msg (erc--input-split-abortp state))) + (erc--check-prompt-explanation + (message "%s" (string-join (nreverse erc--check-prompt-explanation) + "\n")))))) + +(defun erc--inhibit-slash-cmd-insertion (state) + "Don't insert STATE object's message if it's a \"slash\" command." + (when (erc--input-split-cmdp state) + (setf (erc--input-split-insertp state) nil))) + +(defun erc--make-input-split (string) + (make-erc--input-split + :string string + :insertp erc-insert-this + :sendp erc-send-this + :lines (split-string string erc--input-line-delim-regexp) + :cmdp (string-match erc-command-regexp string))) (defun erc-send-current-line () "Parse current line and send it to IRC." @@ -5855,32 +7924,25 @@ When the returned value is a string, pass it to `erc-error'.") (eolp)) (expand-abbrev)) (widen) - (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) - (old-buf (current-buffer))) + (let* ((str (erc-user-input)) + (state (erc--make-input-split str))) + (run-hook-with-args 'erc--input-review-functions state) + (when-let (((not (erc--input-split-abortp state))) + (inhibit-read-only t) + (erc--current-line-input-split state) + (old-buf (current-buffer))) (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)) + (delete-region erc-input-marker (erc-end-of-input-line)) (unwind-protect - (erc-send-input str 'skip-ws-chk) + (erc--send-input-lines (erc--run-send-hooks state)) ;; Fix the buffer if the command didn't kill it (when (buffer-live-p old-buf) (with-current-buffer old-buf (save-restriction (widen) - (goto-char (point-max)) - (when (processp erc-server-process) - (set-marker (process-mark erc-server-process) (point))) - (set-marker erc-insert-marker (point)) (let ((buffer-modified (buffer-modified-p))) - (erc-display-prompt) (set-buffer-modified-p buffer-modified)))))) ;; Only when last hook has been run... @@ -5896,19 +7958,81 @@ When the returned value is a string, pass it to `erc-error'.") erc-input-marker (erc-end-of-input-line))) -(defvar erc-command-regexp "^/\\([A-Za-z']+\\)\\(\\s-+.*\\|\\s-*\\)$" - "Regular expression used for matching commands in ERC.") - (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)) + "Remove trailing empty lines from STATE, an `erc--input-split' object. +When all lines are empty, remove all but the first." + (when (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))))) + (while (and (cdr reversed) (string-empty-p (car reversed))) + (setq reversed (cdr reversed))) + (setf (erc--input-split-lines state) (nreverse reversed))))) + +(defun erc--split-lines (state) + "Partition non-command input into lines of protocol-compliant length." + ;; Prior to ERC 5.6, line splitting used to be predicated on + ;; `erc-flood-protect' being non-nil. + (unless (or (zerop erc-split-line-length) (erc--input-split-cmdp state)) + (setf (erc--input-split-lines state) + (mapcan #'erc--split-line (erc--input-split-lines state))))) + +(defun erc--run-send-hooks (lines-obj) + "Run send-related hooks that operate on the entire prompt input. +Sequester some of the back and forth involved in honoring old +interfaces, such as the reconstituting and re-splitting of +multiline input. Optionally readjust lines to protocol length +limits and pad empty ones, knowing full well that additional +processing may still corrupt messages before they reach the send +queue. Expect LINES-OBJ to be an `erc--input-split' object." + (progn ; FIXME remove `progn' after code review. + (with-suppressed-warnings ((lexical str) (obsolete erc-send-this)) + (defvar str) ; see note in string `erc-send-input'. + (let* ((str (string-join (erc--input-split-lines lines-obj) "\n")) + (erc-send-this (erc--input-split-sendp lines-obj)) + (erc-insert-this (erc--input-split-insertp lines-obj)) + (state (progn + ;; This may change `str' and `erc-*-this'. + (run-hook-with-args 'erc-send-pre-hook str) + (make-erc-input + :string str + :insertp erc-insert-this + :sendp erc-send-this + :substxt (erc--input-split-substxt lines-obj) + :refoldp (erc--input-split-refoldp lines-obj))))) + (run-hook-with-args 'erc-pre-send-functions state) + (setf (erc--input-split-sendp lines-obj) (erc-input-sendp state) + (erc--input-split-insertp lines-obj) (erc-input-insertp state) + (erc--input-split-substxt lines-obj) (erc-input-substxt state) + (erc--input-split-refoldp lines-obj) (erc-input-refoldp state) + ;; See note in test of same name re trailing newlines. + (erc--input-split-lines lines-obj) + (let ((lines (split-string (erc-input-string state) + erc--input-line-delim-regexp))) + (if erc--allow-empty-outgoing-lines-p + lines + (cl-nsubst " " "" lines :test #'equal)))) + (when (erc--input-split-refoldp lines-obj) + (erc--split-lines lines-obj))))) + (when (and (erc--input-split-cmdp lines-obj) + (cdr (erc--input-split-lines lines-obj))) + (user-error "Multiline command detected" )) + lines-obj) + +(defun erc--send-input-lines (lines-obj) + "Send lines in `erc--input-split-lines' object LINES-OBJ." + (when (erc--input-split-sendp lines-obj) + (let ((insertp (erc--input-split-insertp lines-obj)) + (substxt (erc--input-split-substxt lines-obj))) + (when (and insertp substxt) + (setq insertp nil) + (if (functionp substxt) + (apply substxt (erc--input-split-lines lines-obj)) + (erc-display-msg substxt))) + (dolist (line (erc--input-split-lines lines-obj)) + (when insertp + (erc-display-msg line)) + (erc-process-input-line (concat line "\n") + (null erc-flood-protect) + (not (erc--input-split-cmdp lines-obj))))))) (defun erc-send-input (input &optional skip-ws-chk) "Treat INPUT as typed in by the user. @@ -5940,23 +8064,22 @@ 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 ((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) + (if-let* ((first (split-string (erc-input-string state) + erc--input-line-delim-regexp)) + (split (mapcan #'erc--split-line first)) + (lines (nreverse (seq-drop-while #'string-empty-p + (nreverse split)))) + ((string-match erc-command-regexp (car lines)))) + (progn + ;; Asking users what to do here might make more sense. + (cl-assert (not (cdr lines))) + ;; The `force' arg (here t) is ignored for command lines. + (erc-process-input-line (concat (car lines) "\n") t nil)) + (progn ; temporarily preserve indentation (dolist (line lines) - (dolist (line (or (and erc-flood-protect (erc-split-line line)) - (list line))) + (progn ; temporarily preserve indentation (when (erc-input-insertp state) (erc-display-msg line)) (erc-process-input-line (concat line "\n") @@ -5964,23 +8087,28 @@ Return non-nil only if we actually send anything." t))))) (defun erc-display-msg (line) - "Display LINE as a message of the user to the current target at point." + "Insert LINE into current buffer and run \"send\" hooks. +Treat LINE as input submitted interactively at the prompt, such +as outgoing chat messages and echoed slash commands." (when erc-insert-this - (let ((insert-position (point))) - (insert (erc-format-my-nick)) - (let ((beg (point))) - (insert line) - (erc-put-text-property beg (point) - 'font-lock-face 'erc-input-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-excursion + (erc--assert-input-bounds) + (let ((insert-position (marker-position (goto-char erc-insert-marker))) + (erc--msg-props (or erc--msg-props + (let ((ovs (seq-filter + #'cdr erc--msg-prop-overrides))) + (map-into `((erc--msg . msg) ,@(reverse ovs)) + 'hash-table))))) + (insert (erc--format-speaker-input-message line) "\n") (save-restriction (narrow-to-region insert-position (point)) (run-hooks 'erc-send-modify-hook) - (run-hooks 'erc-send-post-hook)))))) + (run-hooks 'erc-send-post-hook) + (cl-assert (> (- (point-max) (point-min)) 1)) + (add-text-properties (point-min) (1+ (point-min)) + (erc--order-text-properties-from-hash + erc--msg-props))) + (erc--refresh-prompt))))) (defun erc-command-symbol (command) "Return the ERC command symbol for COMMAND if it exists and is bound." @@ -5988,9 +8116,18 @@ Return non-nil only if we actually send anything." (when (fboundp cmd) cmd))) (defun erc-extract-command-from-line (line) - "Extract command and args from the input LINE. -If no command was given, return nil. If command matches, return a -list of the form: (command args) where both elements are strings." + "Extract a \"slash command\" and its args from a prompt-input LINE. +If LINE doesn't start with a slash command, return nil. If it +does, meaning the pattern `erc-command-regexp' matches, return a +list of the form (COMMAND ARGS), where COMMAND is either a symbol +for a known handler function or `erc-cmd-default' if unknown. +When COMMAND has the symbol property `do-not-parse-args', return +a string in place of ARGS: that is, either LINE itself, when LINE +consists of only whitespace, or LINE stripped of any trailing +whitespace, including a final newline. When COMMAND lacks the +symbol property `do-not-parse-args', return a possibly empty list +of non-whitespace tokens. Do not perform any shell-style parsing +of quoted or escaped substrings." (when (string-match erc-command-regexp line) (let* ((cmd (erc-command-symbol (match-string 1 line))) ;; note: return is nil, we apply this simply for side effects @@ -6060,28 +8197,15 @@ 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) + "Return non-nil if the current buffer is a channel and is joined." (and (erc--target-channel-p erc--target) - (erc-get-channel-user (erc-current-nick)) t)) - -;; While `erc-default-target' happens to return nil in channel buffers -;; you've parted or from which you've been kicked, using it to detect -;; whether a channel is currently joined may become unreliable in the -;; future. For now, third-party code can use -;; -;; (erc-get-channel-user (erc-current-nick)) -;; -;; A predicate may be provided eventually. For retrieving a target's -;; name regardless of subscription or connection status, new library -;; code should use `erc--default-target'. Third-party code should -;; continue to use `erc-default-target'. + (erc--target-channel-joined-p erc--target) + t)) (defun erc-default-target () - "Return the current default target (as a character string) or nil if none." + "Return the current channel or query target, if any. +For historical reasons, return nil in channel buffers if not +currently joined." (let ((tgt (car erc-default-recipients))) (cond ((not tgt) nil) @@ -6128,6 +8252,8 @@ The previous default target of QUERY type gets removed." (setq erc-default-recipients d2) (error "Current target is not a QUERY")))) +;; FIXME move all ignore-related functionality to its own module, +;; required and enabled by default (until some major version change). (defun erc-ignored-user-p (spec) "Return non-nil if SPEC matches something in `erc-ignore-list'. @@ -6388,7 +8514,8 @@ and so on." ((string-match "^%[Ss]$" esc) server) ((string-match "^%[Nn]$" esc) nick) ((string-match "^%\\(.\\)$" esc) (match-string 1 esc)) - (t (erc-log (format "BUG in erc-process-script-line: bad escape sequence: %S\n" esc)) + (t (erc-log (format "Bad escape sequence in %s: %S\n" + 'erc-process-script-line esc)) (message "BUG IN ERC: esc=%S" esc) ""))) (setq line tail) @@ -6407,34 +8534,6 @@ and so on." (buffer-string)))) (erc-load-irc-script-lines (erc-split-multiline-safe str) force))) -(defun erc-load-irc-script-lines (lines &optional force noexpand) - "Load IRC script LINES (a list of strings). - -If optional NOEXPAND is non-nil, do not expand script-specific -sequences, process the lines verbatim. Use this for multiline -user input." - (let* ((cb (current-buffer)) - (s "") - (sp (or (erc-command-indicator) (erc-prompt))) - (args (and (boundp 'erc-script-args) erc-script-args))) - (if (and args (string-match "^ " args)) - (setq args (substring args 1))) - ;; prepare the prompt string for echo - (erc-put-text-property 0 (length sp) - 'font-lock-face 'erc-command-indicator-face sp) - (while lines - (setq s (car lines)) - (erc-log (concat "erc-load-script: CMD: " s)) - (unless (string-match "^\\s-*$" s) - (let ((line (if noexpand s (erc-process-script-line s args)))) - (if (and (erc-process-input-line line force) - erc-script-echo) - (progn - (erc-put-text-property 0 (length line) - 'font-lock-face 'erc-input-face line) - (erc-display-line (concat sp line) cb))))) - (setq lines (cdr lines))))) - ;; authentication (defun erc--unfun (maybe-fn) @@ -6643,15 +8742,14 @@ If it doesn't exist, create it." (unless (file-attributes dir) (make-directory dir)) (or (file-accessible-directory-p dir) (error "Cannot access %s" dir))) +;; FIXME make function obsolete or alias to something less confusing. (defun erc-kill-query-buffers (process) - "Kill all buffers of PROCESS. -Does nothing if PROCESS is not a process object." + "Kill all target buffers of PROCESS, including channel buffers. +Do nothing if PROCESS is not a process object." ;; here, we only want to match the channel buffers, to avoid ;; "selecting killed buffers" b0rkage. (when (processp process) - (erc-with-all-buffers-of-server process - (lambda () - (not (erc-server-buffer-p))) + (erc-with-all-buffers-of-server process (lambda () erc--target) (kill-buffer (current-buffer))))) (defun erc-nick-at-point () @@ -6743,8 +8841,13 @@ See `erc-mode-line-format' for which characters are can be used." :type '(choice (const :tag "Disabled" nil) string)) +;; This should optionally support the built-in `tab-bar'. (defcustom erc-header-line-uses-tabbar-p nil - "Use tabbar mode instead of the header line to display the header." + "Use `tabbar-mode' integration instead of the header line. +This concerns a historical integration with the external library +`tabbar' <https://www.emacswiki.org/emacs/tabbar.el>, which +shouldn't be confused with the built-in `tab-bar' described in +Info node `(emacs) Tab Bars'." :group 'erc-mode-line-and-header :type 'boolean) @@ -6835,6 +8938,62 @@ shortened server name instead." (format-time-string erc-mode-line-away-status-format a) ""))) +(defvar-local erc--away-indicator nil + "Cons containing an away indicator for the connection.") + +(defvar erc-away-status-indicator "A" + "String shown by various formatting facilities to indicate away status. +Currently only used by the option `erc-prompt-format'.") + +(defun erc--format-away-indicator () + "Return char with `display' property of `erc--away-indicator'." + (and-let* ((indicator (erc-with-server-buffer + (or erc--away-indicator + (setq erc--away-indicator (list ""))))) + (newcar (if (erc-away-time) erc-away-status-indicator ""))) + ;; Inform other buffers of the change when necessary. + (let ((dispp (not erc--inhibit-prompt-display-property-p))) + (unless (eq newcar (car indicator)) + (erc--refresh-prompt-continue (and dispp 'hooks-only-p)) + (setcar indicator newcar)) + (if dispp + (propertize "(away?)" 'display indicator) + newcar)))) + +(defvar-local erc--user-modes-indicator nil + "Cons containing connection-wide indicator for user modes.") + +;; If adding more of these functions, should factor out commonalities. +;; As of ERC 5.6, this is identical to the away variant aside from +;; the var names and `eq', which isn't important. +(defun erc--format-user-modes () + "Return server's user modes as a string" + (and-let* ((indicator (erc-with-server-buffer + (or erc--user-modes-indicator + (setq erc--user-modes-indicator (list ""))))) + (newcar (erc--user-modes 'string))) + (let ((dispp (not erc--inhibit-prompt-display-property-p))) + (unless (string= newcar (car indicator)) + (erc--refresh-prompt-continue (and dispp 'hooks-only-p)) + (setcar indicator newcar)) + (if dispp + (propertize "(user-modes?)" 'display indicator) + newcar)))) + +(defun erc--format-channel-status-prefix () + "Return the current channel membership prefix." + (and (erc--target-channel-p erc--target) + (erc-get-channel-membership-prefix (erc-current-nick)))) + +(defun erc--format-modes (&optional no-query-p) + "Return a string of channel modes in channels and user modes elsewhere. +With NO-QUERY-P, return nil instead of user modes in query +buffers. Also return nil when mode information is unavailable." + (cond ((erc--target-channel-p erc--target) + (erc--channel-modes 'string)) + ((not (and erc--target no-query-p)) + (erc--format-user-modes)))) + (defun erc-format-channel-modes () "Return the current channel's modes." (concat (apply #'concat @@ -6859,8 +9018,6 @@ shortened server name instead." (cond (lag (format "lag:%.0f" lag)) (t "")))) -;; erc-goodies is required at end of this file. - ;; TODO when ERC drops Emacs 28, replace the expressions in the format ;; spec below with functions. (defun erc-update-mode-line-buffer (buffer) @@ -6868,7 +9025,7 @@ shortened server name instead." (with-current-buffer buffer (let ((spec `((?a . ,(erc-format-away-status)) (?l . ,(erc-format-lag-time)) - (?m . ,(erc-format-channel-modes)) + (?m . ,(or erc--mode-line-mode-string "")) (?n . ,(or (erc-current-nick) "")) (?N . ,(erc-format-network)) (?o . ,(or (erc-controls-strip erc-channel-topic) "")) @@ -6897,7 +9054,8 @@ shortened server name instead." (format-spec erc-header-line-format spec) nil))) (cond (erc-header-line-uses-tabbar-p - (setq-local tabbar--local-hlf header-line-format) + (when (boundp 'tabbar--local-hlf) + (setq-local tabbar--local-hlf header-line-format)) (kill-local-variable 'header-line-format)) ((null header) (setq header-line-format nil)) @@ -6940,6 +9098,54 @@ If BUFFER is nil, update the mode line in all ERC buffers." (goto-char (point-min)) (insert "X-Debbugs-CC: emacs-erc@gnu.org\n"))) +(defconst erc--news-url + "https://git.savannah.gnu.org/cgit/emacs.git/plain/etc/ERC-NEWS") + +(defvar erc--news-temp-file nil) + +(defun erc-news (arg) + "Show ERC news in a manner similar to `view-emacs-news'. +With ARG, download and display the latest revision, which may +contain more up-to-date information, even for older versions." + (interactive "P") + (find-file + (or (and erc--news-temp-file + (time-less-p (current-time) (car erc--news-temp-file)) + (not (and arg (y-or-n-p (format "Re-fetch? ")))) + (cdr erc--news-temp-file)) + (and arg + (with-current-buffer (url-retrieve-synchronously erc--news-url) + (goto-char (point-min)) + (search-forward "200 OK" (pos-eol)) + (search-forward "\n\n") + (delete-region (point-min) (point)) + ;; May warn about file having changed on disk (unless + ;; `query-about-changed-file' is nil on 28+). + (let ((tempfile (or (cdr erc--news-temp-file) + (make-temp-file "erc-news.")))) + (write-region (point-min) (point-max) tempfile) + (kill-buffer) + (cdr (setq erc--news-temp-file + (cons (time-add (current-time) (* 60 60 12)) + tempfile)))))) + (and-let* ((file (or (eval-when-compile (macroexp-file-name)) + (locate-library "erc"))) + (dir (file-name-directory file)) + (adjacent (expand-file-name "ERC-NEWS" dir)) + ((file-exists-p adjacent))) + adjacent) + (expand-file-name "ERC-NEWS" data-directory))) + (when (fboundp 'emacs-news-view-mode) + (emacs-news-view-mode)) + (goto-char (point-min)) + (let ((v (mapcar #'number-to-string + (seq-take-while #'natnump (version-to-list erc-version))))) + (while (and v (not (search-forward (concat "\014\n* Changes in ERC " + (string-join v ".")) + nil t))) + (setq v (butlast v)))) + (beginning-of-line)) + (defun erc-port-to-string (p) "Convert port P to a string. P may be an integer or a service name." @@ -6983,10 +9189,11 @@ If optional argument HERE is non-nil, insert version number at point." (let (modes (case-fold-search nil)) (dolist (var (apropos-internal "^erc-.*mode$")) (when (and (boundp var) + (get var 'erc-module) (symbol-value var)) - (setq modes (cons (symbol-name var) + (setq modes (cons (concat "`" (symbol-name var) "'") modes)))) - modes) + (sort modes #'string<)) ", "))) (if here (insert string) @@ -7042,24 +9249,38 @@ All windows are opened in the current frame." ;;; Message catalog +(define-inline erc--make-message-variable-name (catalog key softp) + "Return variable name conforming to ERC's message-catalog interface. +Given a CATALOG symbol `mycat' and format-string KEY `mykey', +also a symbol, return the symbol `erc-message-mycat-mykey'. With +SOFTP, only do so when defined as a variable." + (inline-quote + (let* ((catname (symbol-name ,catalog)) + (prefix (if (eq ?- (aref catname 0)) "erc--message" "erc-message-")) + (name (concat prefix catname "-" (symbol-name ,key)))) + (if ,softp + (and-let* ((s (intern-soft name)) ((boundp s))) s) + (intern name))))) + (defun erc-make-message-variable-name (catalog entry) "Create a variable name corresponding to CATALOG's ENTRY." - (intern (concat "erc-message-" - (symbol-name catalog) "-" (symbol-name entry)))) + (erc--make-message-variable-name catalog entry nil)) (defun erc-define-catalog-entry (catalog entry format-spec) "Set CATALOG's ENTRY to FORMAT-SPEC." + (declare (obsolete "define manually using `defvar' instead" "30.1")) (set (erc-make-message-variable-name catalog entry) format-spec)) (defun erc-define-catalog (catalog entries) "Define a CATALOG according to ENTRIES." - (dolist (entry entries) - (erc-define-catalog-entry catalog (car entry) (cdr entry)))) + (declare (obsolete erc-define-message-format-catalog "30.1")) + (with-suppressed-warnings ((obsolete erc-define-catalog-entry)) + (dolist (entry entries) + (erc-define-catalog-entry catalog (car entry) (cdr entry))))) -(erc-define-catalog - 'english - '((bad-ping-response . "Unexpected PING response from %n (time %t)") +(erc--define-catalog english + ((bad-ping-response . "Unexpected PING response from %n (time %t)") (bad-syntax . "Error occurred - incorrect usage?\n%c %u\n%d") (incorrect-args . "Incorrect arguments. Usage:\n%c %u\n%d") (cannot-find-file . "Cannot find file %f") @@ -7074,9 +9295,10 @@ All windows are opened in the current frame." (flood-ctcp-off . "FLOOD PROTECTION: Automatic CTCP responses turned off.") (flood-strict-mode . "FLOOD PROTECTION: Switched to Strict Flood Control mode.") - (disconnected . "\n\nConnection failed! Re-establishing connection...\n") + (disconnected + . "\n\n*** Connection failed! Re-establishing connection...\n") (disconnected-noreconnect - . "\n\nConnection failed! Not re-establishing connection.\n") + . "\n\n*** Connection failed! Not re-establishing connection.\n") (reconnecting . "Reconnecting in %ms: attempt %i/%n ...") (reconnect-canceled . "Canceled %u reconnect timer with %cs to go...") (finished . "\n\n*** ERC finished ***\n") @@ -7091,6 +9313,10 @@ All windows are opened in the current frame." (ops . "%i operator%s: %o") (ops-none . "No operators in this channel.") (undefined-ctcp . "Undefined CTCP query received. Silently ignored") + (user-mode-redundant-add + . "Already have user mode(s): %m. Requesting again anyway.") + (user-mode-redundant-drop + . "Already without user mode(s): %m. Requesting removal anyway.") (variable-not-bound . "Variable not bound!") (ACTION . "* %n %a") (CTCP-CLIENTINFO . "Client info for %n: %m") @@ -7111,7 +9337,7 @@ All windows are opened in the current frame." (MODE-nick . "%n has changed mode for %t to %m") (NICK . "%n (%u@%h) is now known as %N") (NICK-you . "Your new nickname is %N") - (PART . erc-message-english-PART) + (PART . #'erc-message-english-PART) (PING . "PING from server (last: %s sec. ago)") (PONG . "PONG from %h (%i second%s)") (QUIT . "%n (%u@%h) has quit: %r") @@ -7153,7 +9379,9 @@ All windows are opened in the current frame." (s368 . "Banlist of %c ends.") (s379 . "%c: Forwarded to %f") (s391 . "The time at %s is %t") + (s396 . "Your visible host has changed to %s") (s401 . "%n: No such nick/channel") + (s402 . "%c: No such server") (s403 . "%c: No such channel") (s404 . "%c: Cannot send to channel") (s405 . "%c: You have joined too many channels") @@ -7171,6 +9399,8 @@ All windows are opened in the current frame." (s463 . "Your host isn't among the privileged") (s464 . "Password incorrect") (s465 . "You are banned from this server") + (s471 . "Max occupancy for channel %c exceeded: %s") + (s473 . "Channel %c is invitation only") (s474 . "You can't join %c because you're banned (+b)") (s475 . "You must specify the correct channel key (+k) to join %c") (s481 . "Permission Denied - You're not an IRC operator") @@ -7202,22 +9432,26 @@ functions." (string-replace "%" "%%" reason)) ""))))) - -(defvar-local erc-current-message-catalog 'english) - -(defun erc-retrieve-catalog-entry (entry &optional catalog) - "Retrieve ENTRY from CATALOG. - -If CATALOG is nil, `erc-current-message-catalog' is used. - -If ENTRY is nil in CATALOG, it is retrieved from the fallback, -english, catalog." +(defun erc-retrieve-catalog-entry (key &optional catalog) + "Retrieve `format-spec' entry for symbol KEY in CATALOG. +Without symbol CATALOG, use `erc-current-message-catalog'. If +lookup fails, try the latter's `default-toplevel-value' if it's +not the same as CATALOG. Failing that, try the `english' catalog +if yet untried." (unless catalog (setq catalog erc-current-message-catalog)) - (let ((var (erc-make-message-variable-name catalog entry))) - (if (boundp var) - (symbol-value var) - (when (boundp (erc-make-message-variable-name 'english entry)) - (symbol-value (erc-make-message-variable-name 'english entry)))))) + (symbol-value + (or (erc--make-message-variable-name catalog key 'softp) + (let ((parent catalog) + last) + (while (and (setq parent (get parent 'erc--base-format-catalog)) + (not (setq last (erc--make-message-variable-name + parent key 'softp))))) + last) + (let ((default (default-toplevel-value 'erc-current-message-catalog))) + (or (and (not (eq default catalog)) + (erc--make-message-variable-name default key 'softp)) + (and (not (memq 'english (list default catalog))) + (erc--make-message-variable-name 'english key 'softp))))))) (defun erc-format-message (msg &rest args) "Format MSG according to ARGS. @@ -7260,6 +9494,7 @@ See also `kill-buffer'." :group 'erc-hooks :type 'hook) +;; FIXME alias and deprecate current *-function suffixed name. (defun erc-kill-buffer-function () "Function to call when an ERC buffer is killed. This function should be on `kill-buffer-hook'. @@ -7273,11 +9508,28 @@ or `erc-kill-buffer-hook' if any other buffer." (cond ((eq (erc-server-buffer) (current-buffer)) (run-hooks 'erc-kill-server-hook)) - ((erc-channel-p (or (erc-default-target) (buffer-name))) + ((erc--target-channel-p erc--target) (run-hooks 'erc-kill-channel-hook)) (t (run-hooks 'erc-kill-buffer-hook))))) +(declare-function set-text-conversion-style "textconv.c") + +(defun erc-check-text-conversion () + "Check if point is within the ERC prompt and toggle text conversion. +If `text-conversion-style' is not `action' if point is within the +prompt or `nil' otherwise, set it to such a value, so as to +guarantee that the input method functions properly for the +purpose of typing within the ERC prompt." + (when (and (eq major-mode 'erc-mode) + (fboundp 'set-text-conversion-style)) + (defvar text-conversion-style) ; avoid free variable warning on <=29 + (if (>= (point) (erc-beg-of-input-line)) + (unless (eq text-conversion-style 'action) + (set-text-conversion-style 'action)) + (unless (not text-conversion-style) + (set-text-conversion-style nil))))) + (defun erc-kill-server () "Sends a QUIT command to the server when the server buffer is killed. This function should be on `erc-kill-server-hook'." @@ -7302,11 +9554,12 @@ This function should be on `erc-kill-channel-hook'." (text-property-not-all (point-min) (point-max) 'erc-parsed nil)) (defun erc-restore-text-properties () - "Restore the property `erc-parsed' for the region." - (let ((parsed-posn (erc-find-parsed-property))) - (put-text-property - (point-min) (point-max) - 'erc-parsed (when parsed-posn (erc-get-parsed-vector parsed-posn))))) + "Ensure the `erc-parsed' and `tags' props cover the entire message." + (when-let ((parsed-posn (erc-find-parsed-property)) + (found (erc-get-parsed-vector parsed-posn))) + (put-text-property (point-min) (point-max) 'erc-parsed found) + (when-let ((tags (get-text-property parsed-posn 'tags))) + (put-text-property (point-min) (point-max) 'tags tags)))) (defun erc-get-parsed-vector (point) "Return the whole parsed vector on POINT." @@ -7326,6 +9579,13 @@ This function should be on `erc-kill-channel-hook'." (and vect (erc-response.command vect))) +(defun erc--get-eq-comparable-cmd (command) + "Return a symbol or a fixnum representing a message's COMMAND. +See also `erc-message-type'." + ;; IRC numerics are three-digit numbers, possibly with leading 0s. + ;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o)) + (if-let ((n (string-to-number command)) ((zerop n))) (intern command) n)) + ;; Teach url.el how to open irc:// URLs with ERC. ;; To activate, customize `url-irc-function' to `url-irc-erc'. @@ -7364,6 +9624,8 @@ Beginning with ERC 5.5, new connections require human intervention. Customize `erc-url-connect-function' to override this." (when (eql port 0) (setq port nil)) (let* ((net (erc-networks--determine host)) + (erc--display-context `((erc-interactive-display . url) + ,@erc--display-context)) (server-buffer ;; Viable matches may slip through the cracks for unknown ;; networks. Additional passes could likely improve things. @@ -7409,6 +9671,4 @@ Customize `erc-url-connect-function' to override this." (provide 'erc) -;; FIXME this is a temporary stopgap for Emacs 29. -(require 'erc-goodies) ;;; erc.el ends here |