From 6898816b7d3fce001f37be6a95b5d287a76c9757 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Wed, 9 Jun 2021 16:08:36 +0200 Subject: [PATCH 01/38] Default to libera instead of freenode * rcirc.el (rcirc-server-alist): Update default value --- lisp/net/rcirc.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 4fdb63e2eb6..90b61badf0e 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -56,10 +56,10 @@ :group 'applications) (defcustom rcirc-server-alist - '(("chat.freenode.net" :channels ("#rcirc") - ;; Don't use the TLS port by default, in case gnutls is not available. - ;; :port 7000 :encryption tls - )) + (if (gnutls-available-p) + '(("irc.libera.chat" :channels ("#rcirc") + :port 6697 :encryption tls)) + '(("irc.libera.chat" :channels ("#rcirc")))) "An alist of IRC connections to establish when running `rcirc'. Each element looks like (SERVER-NAME PARAMETERS). @@ -120,7 +120,8 @@ display purposes. If absent, the real server name will be displayed instead." (:channels (repeat string)) (:encryption (choice (const tls) (const plain))) - (:server-alias string))))) + (:server-alias string)))) + :version "28.1") (defcustom rcirc-default-port 6667 "The default port to connect to." From c6b6c2d59626e3849691eb1ce747b33e43927ef2 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Wed, 9 Jun 2021 16:09:55 +0200 Subject: [PATCH 02/38] Use auth-source for user-passwords * (rcirc): Use auth-source is no password was specifed --- lisp/net/rcirc.el | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 90b61badf0e..67dcf3e4eaa 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -44,6 +44,7 @@ (require 'cl-lib) (require 'ring) (require 'time-date) +(require 'auth-source) (eval-when-compile (require 'subr-x)) (defconst rcirc-id-string (concat "rcirc on GNU Emacs " emacs-version)) @@ -500,6 +501,12 @@ If ARG is non-nil, instead prompt for connection parameters." (encryption (plist-get (cdr c) :encryption)) (server-alias (plist-get (cdr c) :server-alias)) contact) + (when-let (((not password)) + (auth (auth-source-search :host server + :user user-name + :port port)) + (fn (plist-get (car auth) :secret))) + (setq password (funcall fn))) (when server (let (connected) (dolist (p (rcirc-process-list)) From fb158754c466e7118f5e3ac158fec4aedb9c76b3 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Fri, 4 Jun 2021 14:14:35 +0200 Subject: [PATCH 03/38] Fix checkdoc complaints and related issues --- lisp/net/rcirc.el | 445 +++++++++++++++++++++++++++++++++++----------- 1 file changed, 339 insertions(+), 106 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 67dcf3e4eaa..5a21bd81a89 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -25,7 +25,7 @@ ;;; Commentary: ;; Internet Relay Chat (IRC) is a form of instant communication over -;; the Internet. It is mainly designed for group (many-to-many) +;; the Internet. It is mainly designed for group (many-to-many) ;; communication in discussion forums called channels, but also allows ;; one-to-one communication. @@ -46,6 +46,7 @@ (require 'time-date) (require 'auth-source) (eval-when-compile (require 'subr-x)) +(eval-when-compile (require 'rx)) (defconst rcirc-id-string (concat "rcirc on GNU Emacs " emacs-version)) @@ -109,8 +110,9 @@ for connections using SSL/TLS. `:server-alias' -VALUE must be a string that will be used instead of the server name for -display purposes. If absent, the real server name will be displayed instead." +VALUE must be a string that will be used instead of the server +name for display purposes. If absent, the real server name will +be displayed instead." :type '(alist :key-type string :value-type (plist :options ((:nick string) @@ -181,17 +183,18 @@ If nil, no maximum is applied." (integer :tag "Number of characters"))) (defvar-local rcirc-ignore-buffer-activity-flag nil - "If non-nil, ignore activity in this buffer.") + "Non-nil means ignore activity in this buffer.") (defvar-local rcirc-low-priority-flag nil - "If non-nil, activity in this buffer is considered low priority.") + "Non-nil means activity in this buffer is considered low priority.") (defcustom rcirc-omit-responses '("JOIN" "PART" "QUIT" "NICK") "Responses which will be hidden when `rcirc-omit-mode' is enabled." :type '(repeat string)) -(defvar rcirc-prompt-start-marker nil) +(defvar rcirc-prompt-start-marker nil + "Marker indicating the beginning of the message prompt.") (define-minor-mode rcirc-omit-mode "Toggle the hiding of \"uninteresting\" lines. @@ -230,8 +233,7 @@ number. If zero or nil, no truncating is done." (integer :tag "Number of lines"))) (defcustom rcirc-scroll-show-maximum-output t - "If non-nil, scroll buffer to keep the point at the bottom of -the window." + "Non-nil means scroll to keep the point at the bottom of the window." :type 'boolean) (defcustom rcirc-authinfo nil @@ -292,8 +294,9 @@ The following replacements are made: %s is the server. %t is the buffer target, a channel or a user. -Setting this alone will not affect the prompt; -use either M-x customize or also call `rcirc-update-prompt'." +Setting this alone will not affect the prompt; use either +\\[execute-extended-command] customize or also call +`rcirc-update-prompt'." :type 'string :set #'rcirc-set-changed :initialize 'custom-initialize-default) @@ -387,11 +390,14 @@ will be killed." :version "24.3" :type 'boolean) -(defvar rcirc-nick nil) +(defvar rcirc-nick nil + "The nickname used for the current connection.") -(defvar rcirc-prompt-end-marker nil) +(defvar rcirc-prompt-end-marker nil + "Marker indicating the end of the message prompt.") -(defvar rcirc-nick-table nil) +(defvar rcirc-nick-table nil + "Hash table mapping nicks to channels.") (defvar rcirc-recent-quit-alist nil "Alist of nicks that have recently quit or parted the channel.") @@ -404,8 +410,8 @@ will be killed." table) "Syntax table which includes all nick characters as word constituents.") -;; each process has an alist of (target . buffer) pairs -(defvar rcirc-buffer-alist nil) +(defvar rcirc-buffer-alist nil + "Alist of (TARGET . BUFFER) pairs.") (defvar rcirc-activity nil "List of buffers with unviewed activity.") @@ -431,7 +437,8 @@ will be killed." "Kill connection after this many seconds if there is no activity.") -(defvar rcirc-startup-channels nil) +(defvar rcirc-startup-channels nil + "List of channel names to join after authenticating.") (defvar rcirc-server-name-history nil "History variable for \\[rcirc] call.") @@ -538,23 +545,43 @@ If ARG is non-nil, instead prompt for connection parameters." (defalias 'irc 'rcirc) -(defvar rcirc-process-output nil) -(defvar rcirc-topic nil) -(defvar rcirc-keepalive-timer nil) -(defvar rcirc-last-server-message-time nil) -(defvar rcirc-server nil) ; server provided by server -(defvar rcirc-server-name nil) ; server name given by 001 response -(defvar rcirc-timeout-timer nil) -(defvar rcirc-user-authenticated nil) -(defvar rcirc-user-disconnect nil) -(defvar rcirc-connecting nil) -(defvar rcirc-connection-info nil) -(defvar rcirc-process nil) +(defvar rcirc-process-output nil + "Partial message response.") +(defvar rcirc-topic nil + "Topic of the current channel.") +(defvar rcirc-keepalive-timer nil + "Timer for sending KEEPALIVE message.") +(defvar rcirc-last-server-message-time nil + "Timestamp for the last server response.") +(defvar rcirc-server nil + "Server provided by server.") +(defvar rcirc-server-name nil + "Server name given by 001 response.") +(defvar rcirc-timeout-timer nil + "Timer for determining a network timeout.") +(defvar rcirc-user-authenticated nil + "Flag indicating if the user is authenticated.") +(defvar rcirc-user-disconnect nil + "Flag indicating if the connection was broken.") +(defvar rcirc-connecting nil + "Flag indicating if the connection is being established.") +(defvar rcirc-connection-info nil + "Information about the current connection. +If defined, it is a list of this form (SERVER PORT NICK USER-NAME +FULL-NAME STARTUP-CHANNELS PASSWORD ENCRYPTION SERVER-ALIAS). +See `rcirc-connect' for more details on these variables.") +(defvar rcirc-process nil + "Network process for the current connection.") ;;;###autoload (defun rcirc-connect (server &optional port nick user-name full-name startup-channels password encryption server-alias) + "Connect to SERVER. +The arguments PORT, NICK, USER-NAME, FULL-NAME, PASSWORD, +ENCRYPTION, SERVER-ALIAS are interpreted as in +`rcirc-server-alist'. STARTUP-CHANNELS is a list of channels +that are joined after authentication." (save-excursion (message "Connecting to %s..." (or server-alias server)) (let* ((inhibit-eol-conversion) @@ -618,11 +645,13 @@ If ARG is non-nil, instead prompt for connection parameters." process))) (defmacro with-rcirc-process-buffer (process &rest body) + "Evaluate BODY in the buffer of PROCESS." (declare (indent 1) (debug t)) `(with-current-buffer (process-buffer ,process) ,@body)) (defmacro with-rcirc-server-buffer (&rest body) + "Evaluate BODY in the server buffer of the current channel." (declare (indent 0) (debug t)) `(with-current-buffer rcirc-server-buffer ,@body)) @@ -658,14 +687,18 @@ last ping." (setq rcirc-keepalive-timer nil))) (defun rcirc-handler-ctcp-KEEPALIVE (process _target _sender message) + "Uptime header in PROCESS buffer. +MESSAGE should contain a timestamp, indicating when the KEEPALIVE +message was generated." (with-rcirc-process-buffer process (setq header-line-format (format "%f" (float-time (time-since (string-to-number message))))))) -(defvar rcirc-debug-buffer "*rcirc debug*") +(defvar rcirc-debug-buffer "*rcirc debug*" + "Buffer name for debugging messages.") (defvar rcirc-debug-flag nil - "If non-nil, write information to `rcirc-debug-buffer'.") + "Non-nil means write information to `rcirc-debug-buffer'.") (defun rcirc-debug (process text) "Add an entry to the debug log including PROCESS and TEXT. Debug text is appended to `rcirc-debug-buffer' if `rcirc-debug-flag' @@ -727,6 +760,8 @@ When 0, do not auto-reconnect." (run-hook-with-args 'rcirc-sentinel-functions process sentinel)))) (defun rcirc-disconnect-buffer (&optional buffer) + "Disconnect BUFFER. +If BUFFER is nil, default to the current buffer." (with-current-buffer (or buffer (current-buffer)) ;; set rcirc-target to nil for each channel so cleanup ;; doesn't happen when we reconnect @@ -764,19 +799,19 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (rcirc-process-server-response process line)))))) (defun rcirc-reschedule-timeout (process) + "Update timeout indicator for PROCESS." (with-rcirc-process-buffer process (when (not rcirc-connecting) (with-rcirc-process-buffer process (when rcirc-timeout-timer (cancel-timer rcirc-timeout-timer)) (setq rcirc-timeout-timer (run-at-time rcirc-timeout-seconds nil - 'rcirc-delete-process + 'delete-process process)))))) -(defun rcirc-delete-process (process) - (delete-process process)) - -(defvar rcirc-trap-errors-flag t) +(defvar rcirc-trap-errors-flag t + "Non-nil means Lisp errors are degraded to error messages.") (defun rcirc-process-server-response (process text) + "Parse TEXT as received from PROCESS." (if rcirc-trap-errors-flag (condition-case err (rcirc-process-server-response-1 process text) @@ -785,13 +820,21 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (format "\"%s\" %s" text err) t))) (rcirc-process-server-response-1 process text))) -(defun rcirc-process-server-response-1 (process text) +(defconst rcirc-process-regexp ;; See https://tools.ietf.org/html/rfc2812#section-2.3.1. We're a ;; bit more accepting than the RFC: We allow any non-space ;; characters in the command name, multiple spaces between ;; arguments, and allow the last argument to omit the leading ":", ;; even if there are less than 15 arguments. - (if (string-match "^\\(:\\([^ ]+\\) \\)?\\([^ ]+\\)" text) + (rx line-start + (optional + (group ":" (group (one-or-more (not (any " ")))) " ")) + (group (one-or-more (not (any " "))))) + "Regular expression used for parsing server response.") + +(defun rcirc-process-server-response-1 (process text) + "Parse TEXT as received from PROCESS." + (if (string-match rcirc-process-regexp text) (let* ((user (match-string 2 text)) (sender (rcirc-user-nick user)) (cmd (match-string 3 text)) @@ -819,12 +862,17 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") "Responses that don't trigger activity in the mode-line indicator.") (defun rcirc-handler-generic (process response sender args _text) - "Generic server response handler." + "Generic server response handler. +This handler is called, when no more specific handler could be +found. PROCESS, SENDER and RESPONSE are passed on to +`rcirc-print'. ARGS are concatenated into a single string and +used as the message body." (rcirc-print process sender response nil (mapconcat 'identity (cdr args) " ") (not (member response rcirc-responses-no-activity)))) (defun rcirc--connection-open-p (process) + "Check if PROCESS is open or running." (memq (process-status process) '(run open))) (defun rcirc-send-string (process string) @@ -838,10 +886,12 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (process-send-string process string))) (defun rcirc-send-privmsg (process target string) + "Send TARGET the message in STRING via PROCESS." (cl-check-type target string) (rcirc-send-string process (format "PRIVMSG %s :%s" target string))) (defun rcirc-send-ctcp (process target request &optional args) + "Send TARGET a REQUEST via PROCESS." (let ((args (if args (concat " " args) ""))) (rcirc-send-privmsg process target (format "\C-a%s%s\C-a" request args)))) @@ -907,13 +957,18 @@ If SILENT is non-nil, do not print the message in any irc buffer." (unless silent (rcirc-print process (rcirc-nick process) response target msg))))) -(defvar rcirc-input-ring nil) -(defvar rcirc-input-ring-index 0) +(defvar rcirc-input-ring nil + "Ring object for input.") + +(defvar rcirc-input-ring-index 0 + "Current position in the input ring.") (defun rcirc-prev-input-string (arg) + "Move ARG elements ahead in the input ring." (ring-ref rcirc-input-ring (+ rcirc-input-ring-index arg))) (defun rcirc-insert-prev-input () + "Insert previous element in input ring." (interactive) (when (<= rcirc-prompt-end-marker (point)) (delete-region rcirc-prompt-end-marker (point-max)) @@ -921,6 +976,7 @@ If SILENT is non-nil, do not print the message in any irc buffer." (setq rcirc-input-ring-index (1+ rcirc-input-ring-index)))) (defun rcirc-insert-next-input () + "Insert next element in input ring." (interactive) (when (<= rcirc-prompt-end-marker (point)) (delete-region rcirc-prompt-end-marker (point-max)) @@ -965,8 +1021,11 @@ The list is updated automatically by `defun-rcirc-command'.") rcirc-target)))) (list beg (point) table)))) -(defvar rcirc-completions nil) -(defvar rcirc-completion-start nil) +(defvar rcirc-completions nil + "List of possible completions to cycle through.") + +(defvar rcirc-completion-start nil + "Point indicating where completion starts.") (defun rcirc-complete () "Cycle through completions from list of nicks in channel or IRC commands. @@ -996,12 +1055,12 @@ IRC command completion is performed only if `/' is the first input char." (t completion)))))) (defun set-rcirc-decode-coding-system (coding-system) - "Set the decode coding system used in this channel." + "Set the decode CODING-SYSTEM used in this channel." (interactive "zCoding system for incoming messages: ") (setq-local rcirc-decode-coding-system coding-system)) (defun set-rcirc-encode-coding-system (coding-system) - "Set the encode coding system used in this channel." + "Set the encode CODING-SYSTEM used in this channel." (interactive "zCoding system for outgoing messages: ") (setq-local rcirc-encode-coding-system coding-system)) @@ -1039,7 +1098,8 @@ IRC command completion is performed only if `/' is the first input char." (defvar rcirc-mode-hook nil "Hook run when setting up rcirc buffer.") -(defvar rcirc-last-post-time nil) +(defvar rcirc-last-post-time nil + "Timestamp indicating last user action.") (defvar rcirc-log-alist nil "Alist of lines to log to disk when `rcirc-log-flag' is non-nil. @@ -1050,10 +1110,10 @@ Each element looks like (FILENAME . TEXT).") This number is independent of the number of lines in the buffer.") (defun rcirc-mode (process target) - ;; FIXME: Use define-derived-mode. "Major mode for IRC channel buffers. \\{rcirc-mode-map}" + ;; FIXME: Use define-derived-mode. (kill-all-local-variables) (use-local-map rcirc-mode-map) (setq mode-name "rcirc") @@ -1160,7 +1220,7 @@ If ALL is non-nil, update prompts in all IRC buffers." 'front-sticky t 'rear-nonsticky t)))))))) (defun rcirc-set-changed (option value) - "Set OPTION to VALUE and do updates after a customization change." + "Set OPTION to VALUE and update after a customization change." (set-default option value) (cond ((eq option 'rcirc-prompt) (rcirc-update-prompt 'all)) @@ -1203,10 +1263,11 @@ with it." (kill-buffer (cdr channel)))))) (defun rcirc-change-major-mode-hook () - "Part the channel when changing the major-mode." + "Part the channel when changing the major mode." (rcirc-clean-up-buffer "Changed major mode")) (defun rcirc-clean-up-buffer (reason) + "Clean up current buffer and part with REASON." (let ((buffer (current-buffer))) (rcirc-clear-activity buffer) (when (and (rcirc-buffer-process) @@ -1295,6 +1356,8 @@ Create the buffer if it doesn't exist." (setq rcirc-input-ring-index 0)))))) (defun rcirc-fill-paragraph (&optional justify) + "Implementation for `fill-paragraph-function'. +The argument JUSTIFY is passed on to `fill-region'." (interactive "P") (when (> (point) rcirc-prompt-end-marker) (save-restriction @@ -1303,6 +1366,7 @@ Create the buffer if it doesn't exist." (fill-region (point-min) (point-max) justify))))) (defun rcirc-process-input-line (line) + "Process LINE as a message or a command." (if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" line) (rcirc-process-command (match-string 1 line) (match-string 2 line) @@ -1310,6 +1374,7 @@ Create the buffer if it doesn't exist." (rcirc-process-message line))) (defun rcirc-process-message (line) + "Process LINE as a message to be sent." (if (not rcirc-target) (message "Not joined (no target)") (delete-region rcirc-prompt-end-marker (point)) @@ -1317,6 +1382,9 @@ Create the buffer if it doesn't exist." (setq rcirc-last-post-time (current-time)))) (defun rcirc-process-command (command args line) + "Process COMMAND with arguments ARGS. +LINE is the raw input, from which COMMAND and ARGS was +extracted." (if (eq (aref command 0) ?/) ;; "//text" will send "/text" as a message (rcirc-process-message (substring line 1)) @@ -1336,9 +1404,14 @@ Create the buffer if it doesn't exist." (rcirc-send-string process (concat command " :" args))))))) -(defvar-local rcirc-parent-buffer nil) + +(defvar-local rcirc-parent-buffer nil + "Message buffer that requested a multiline buffer.") (put 'rcirc-parent-buffer 'permanent-local t) -(defvar rcirc-window-configuration nil) + +(defvar rcirc-window-configuration nil + "Window configuration before creating multiline buffer.") + (defun rcirc-edit-multiline () "Move current edit to a dedicated buffer." (interactive) @@ -1434,9 +1507,10 @@ the of the following escape sequences replaced by the described values: :value-type string)) (defun rcirc-format-response-string (process sender response target text) - "Return a nicely-formatted response string, incorporating TEXT -\(and perhaps other arguments). The specific formatting used -is found by looking up RESPONSE in `rcirc-response-formats'." + "Return a formatted response string from SENDER, incorporating TEXT. +The specific formatting used is found by looking up RESPONSE in +`rcirc-response-formats'. PROCESS is the process object used for +communication." (with-temp-buffer (insert (or (cdr (assoc response rcirc-response-formats)) (cdr (assq t rcirc-response-formats)))) @@ -1490,7 +1564,8 @@ is found by looking up RESPONSE in `rcirc-response-formats'." (buffer-substring (point-min) (point-max)))) (defun rcirc-target-buffer (process sender response target _text) - "Return a buffer to print the server response." + "Return a buffer to print the server response from SENDER. +PROCESS is the process object for the current connection." (cl-assert (not (bufferp target))) (with-rcirc-process-buffer process (cond ((not target) @@ -1506,8 +1581,9 @@ is found by looking up RESPONSE in `rcirc-response-formats'." ((or (rcirc-get-buffer process target) (rcirc-any-buffer process)))))) -(defvar-local rcirc-activity-types nil) (defvar-local rcirc-last-sender nil) +(defvar-local rcirc-activity-types nil + "List of symbols designating kinds of activities in a buffer.") (defcustom rcirc-omit-threshold 100 "Lines since last activity from a nick before `rcirc-omit-responses' are omitted." @@ -1520,14 +1596,16 @@ is found by looking up RESPONSE in `rcirc-response-formats'." (defun rcirc-last-quit-line (process nick target) "Return the line number where NICK left TARGET. -Returns nil if the information is not recorded." +Returns nil if the information is not recorded. +PROCESS is the process object for the current connection." (let ((chanbuf (rcirc-get-buffer process target))) (when chanbuf (cdr (assoc-string nick (with-current-buffer chanbuf rcirc-recent-quit-alist)))))) (defun rcirc-last-line (process nick target) - "Return the line from the last activity from NICK in TARGET." + "Return the line from the last activity from NICK in TARGET. +PROCESS is the process object for the current connection." (let ((line (or (cdr (assoc-string target (gethash nick (with-rcirc-server-buffer rcirc-nick-table)) t)) @@ -1538,7 +1616,8 @@ Returns nil if the information is not recorded." nil))) (defun rcirc-elapsed-lines (process nick target) - "Return the number of lines since activity from NICK in TARGET." + "Return the number of lines since activity from NICK in TARGET. +PROCESS is the process object for the current connection." (let ((last-activity-line (rcirc-last-line process nick target))) (when (and last-activity-line (> last-activity-line 0)) @@ -1550,7 +1629,6 @@ Returns nil if the information is not recorded." rcirc-markup-urls rcirc-markup-keywords rcirc-markup-bright-nicks) - "List of functions used to manipulate text before it is printed. Each function takes two arguments, SENDER, and RESPONSE. The @@ -1560,7 +1638,8 @@ at the beginning of the `rcirc-text' propertized text.") (defun rcirc-print (process sender response target text &optional activity) "Print TEXT in the buffer associated with TARGET. Format based on SENDER and RESPONSE. If ACTIVITY is non-nil, -record activity." +record activity. PROCESS is the process object for the current +connection." (or text (setq text "")) (unless (and (or (member sender rcirc-ignore-list) (member (with-syntax-table rcirc-nick-syntax-table @@ -1689,6 +1768,7 @@ record activity." process sender response target text))))) (defun rcirc-generate-log-filename (process target) + "Return filename for log file based on PROCESS and TARGET." (if target (rcirc-generate-new-buffer-name process target) (process-name process))) @@ -1710,7 +1790,9 @@ guarantee valid filenames for the current OS." :type 'function) (defun rcirc-log (process sender response target text) - "Record line in `rcirc-log', to be later written to disk." + "Record TEXT from SENDER to TARGET to be logged. +The message is logged in `rcirc-log', and is later written to +disk. PROCESS is the process object for the current connection." (let ((filename (funcall rcirc-log-filename-function process target))) (unless (null filename) (let ((cell (assoc-string filename rcirc-log-alist)) @@ -1749,14 +1831,17 @@ log-files with absolute names (see `rcirc-log-filename-function')." rcirc-log-directory))) (defun rcirc-join-channels (process channels) - "Join CHANNELS." + "Join CHANNELS. +PROCESS is the process object for the current connection." (save-window-excursion (dolist (channel channels) (with-rcirc-process-buffer process (rcirc-cmd-join channel process))))) ;;; nick management -(defvar rcirc-nick-prefix-chars "~&@%+") +(defvar rcirc-nick-prefix-chars '(?~ ?& ?@ ?% ?+) + "List of junk characters to strip from nick prefixes.") + (defun rcirc-user-nick (user) "Return the nick from USER. Remove any non-nick junk." (save-match-data @@ -1766,7 +1851,8 @@ log-files with absolute names (see `rcirc-log-filename-function')." user))) (defun rcirc-nick-channels (process nick) - "Return list of channels for NICK." + "Return list of channels for NICK. +PROCESS is the process object for the current connection." (with-rcirc-process-buffer process (mapcar (lambda (x) (car x)) (gethash nick rcirc-nick-table)))) @@ -1776,7 +1862,7 @@ log-files with absolute names (see `rcirc-log-filename-function')." Update the associated linestamp if LINE is non-nil. If the record doesn't exist, and LINE is nil, set the linestamp -to zero." +to zero. PROCESS is the process object for the current connection." (let ((nick (rcirc-user-nick nick))) (with-rcirc-process-buffer process (let* ((chans (gethash nick rcirc-nick-table)) @@ -1788,12 +1874,14 @@ to zero." rcirc-nick-table)))))) (defun rcirc-nick-remove (process nick) - "Remove NICK from table." + "Remove NICK from table. +PROCESS is the process object for the current connection." (with-rcirc-process-buffer process (remhash nick rcirc-nick-table))) (defun rcirc-remove-nick-channel (process nick channel) - "Remove the CHANNEL from list associated with NICK." + "Remove the CHANNEL from list associated with NICK. +PROCESS is the process object for the current connection." (with-rcirc-process-buffer process (let* ((chans (gethash nick rcirc-nick-table)) (newchans @@ -1807,7 +1895,8 @@ to zero." (remhash nick rcirc-nick-table))))) (defun rcirc-channel-nicks (process target) - "Return the list of nicks associated with TARGET sorted by last activity." + "Return the list of nicks associated with TARGET sorted by last activity. +PROCESS is the process object for the current connection." (when target (if (rcirc-channel-p target) (with-rcirc-process-buffer process @@ -1826,8 +1915,9 @@ to zero." (list target)))) (defun rcirc-ignore-update-automatic (nick) - "Remove NICK from `rcirc-ignore-list' -if NICK is also on `rcirc-ignore-list-automatic'." + "Check if NICK is in `rcirc-ignore-list-automatic'. +If so, remove from `rcirc-ignore-list'. PROCESS is the process +object for the current connection." (when (member nick rcirc-ignore-list-automatic) (setq rcirc-ignore-list-automatic (delete nick rcirc-ignore-list-automatic) @@ -1835,7 +1925,7 @@ if NICK is also on `rcirc-ignore-list-automatic'." (delete nick rcirc-ignore-list)))) (defun rcirc-nickname< (s1 s2) - "Return t if IRC nickname S1 is less than S2, and nil otherwise. + "Return non-nil if IRC nickname S1 is less than S2, and nil otherwise. Operator nicknames (@) are considered less than voiced nicknames (+). Any other nicknames are greater than voiced nicknames. The comparison is case-insensitive." @@ -2031,6 +2121,7 @@ activity. Only run if the buffer is not visible and (run-hooks 'rcirc-update-activity-string-hook))) (defun rcirc-activity-string (buffers) + "Generate activity string for all BUFFERS." (mapconcat (lambda (b) (let ((s (substring-no-properties (rcirc-short-buffer-name b)))) (with-current-buffer b @@ -2049,7 +2140,7 @@ activity. Only run if the buffer is not visible and (or rcirc-short-buffer-name (buffer-name)))) (defun rcirc-visible-buffers () - "Return a list of the visible buffers that are in rcirc-mode." + "Return a list of the visible buffers that are in `rcirc-mode'." (let (acc) (walk-windows (lambda (w) (with-current-buffer (window-buffer w) @@ -2057,13 +2148,16 @@ activity. Only run if the buffer is not visible and (push (current-buffer) acc))))) acc)) -(defvar rcirc-visible-buffers nil) +(defvar rcirc-visible-buffers nil + "List of visible IRC buffers.") + (defun rcirc-window-configuration-change () + "Clear activity and overlay arrows, unless minibuffer is active." (unless (minibuffer-window-active-p (minibuffer-window)) (rcirc-window-configuration-change-1))) (defun rcirc-window-configuration-change-1 () - ;; clear activity and overlay arrows + "Clear activity and overlay arrows." (let* ((old-activity rcirc-activity) (hidden-buffers rcirc-visible-buffers)) @@ -2089,6 +2183,7 @@ activity. Only run if the buffer is not visible and ;;; buffer name abbreviation (defun rcirc-update-short-buffer-names () + "Update variable `rcirc-short-buffer-name' for IRC buffers." (let ((bufalist (apply 'append (mapcar (lambda (process) (with-rcirc-process-buffer process @@ -2100,10 +2195,15 @@ activity. Only run if the buffer is not visible and (setq rcirc-short-buffer-name (car i))))))) (defun rcirc-abbreviate (pairs) + "Generate alist of abbreviated buffer names to buffers. +PAIRS is the concatenated value of all `rcirc-buffer-alist' +values, from each process." (apply 'append (mapcar 'rcirc-rebuild-tree (rcirc-make-trees pairs)))) -(defun rcirc-rebuild-tree (tree &optional acc) - (let ((ch (char-to-string (car tree)))) +(defun rcirc-rebuild-tree (tree) + "Merge prefix TREE into alist of unique prefixes to buffers." + (let ((ch (char-to-string (car tree))) + acc) (dolist (x (cdr tree)) (if (listp x) (setq acc (append acc @@ -2115,6 +2215,12 @@ activity. Only run if the buffer is not visible and acc)) (defun rcirc-make-trees (pairs) + "Generate tree prefix tree of buffer names. +PAIRS is a list of (TARGET . BUFFER) entries. The resulting tree +is a list of (CHAR . CHILDREN) cons-cells, where CHAR is the +leading character and CHILDREN is either BUFFER when a unique +prefix could be found or another tree if it shares the same +prefix with another element in PAIRS." (let (alist) (mapc (lambda (pair) (if (consp pair) @@ -2147,9 +2253,13 @@ activity. Only run if the buffer is not visible and ;; the current buffer/channel/user, and ARGS, which is a string ;; containing the text following the /cmd. -(defmacro defun-rcirc-command (command argument docstring interactive-form - &rest body) - "Define a command." +(defmacro defun-rcirc-command (command argument + docstring interactive-form + &rest body) + "Define COMMAND that operates on ARGUMENT. +This macro internally defines an interactive function, prefixing +COMMAND with `rcirc-cmd-'. DOCSTRING, INTERACTIVE-FORM and BODY +are passed directly to `defun'." `(progn (add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name command))) (defun ,(intern (concat "rcirc-cmd-" (symbol-name command))) @@ -2322,6 +2432,8 @@ With a prefix arg, prompt for new topic." (rcirc-send-string process (concat "KICK " target " " argstring)))) (defun rcirc-cmd-ctcp (args &optional process _target) + "Handle ARGS as a CTCP command. +PROCESS is the process object for the current connection." (if (string-match "^\\([^ ]+\\)\\s-+\\(.+\\)$" args) (let* ((target (match-string 1 args)) (request (upcase (match-string 2 args))) @@ -2333,14 +2445,18 @@ With a prefix arg, prompt for new topic." "usage: /ctcp NICK REQUEST"))) (defun rcirc-ctcp-sender-PING (process target _request) - "Send a CTCP PING message to TARGET." + "Send a CTCP PING message to TARGET. +PROCESS is the process object for the current connection." (let ((timestamp (format-time-string "%s"))) (rcirc-send-ctcp process target "PING" timestamp))) (defun rcirc-cmd-me (args process target) + "Send an action message ARGS to TARGET. +PROCESS is the process object for the current connection." (when target (rcirc-send-ctcp process target "ACTION" args))) (defun rcirc-add-or-remove (set &rest elements) + "Toggle membership of ELEMENTS in SET." (dolist (elt elements) (if (and elt (not (string= "" elt))) (setq set (if (member-ignore-case elt set) @@ -2348,6 +2464,7 @@ With a prefix arg, prompt for new topic." (cons elt set))))) set) + (defun-rcirc-command ignore (nick) "Manage the ignore list. Ignore NICK, unignore NICK if already ignored, or list ignored @@ -2458,11 +2575,13 @@ If ARG is given, opens the URL in a new browser window." arg))) (defun rcirc-markup-timestamp (_sender _response) + "Insert a timestamp." (goto-char (point-min)) (insert (rcirc-facify (format-time-string rcirc-time-format) 'rcirc-timestamp))) (defun rcirc-markup-attributes (_sender _response) + "Highlight IRC markup, indicated by ASCII control codes." (while (re-search-forward "\\([\C-b\C-_\C-v]\\).*?\\(\\1\\|\C-o\\)" nil t) (rcirc-add-face (match-beginning 0) (match-end 0) (cl-case (char-after (match-beginning 1)) @@ -2480,6 +2599,9 @@ If ARG is given, opens the URL in a new browser window." (delete-region (match-beginning 0) (match-end 0)))) (defun rcirc-markup-my-nick (_sender response) + "Highlight the users nick. +If RESPONSE indicates that the nick was mentioned in a message, +highlight the entire line and record the activity." (with-syntax-table rcirc-nick-syntax-table (while (re-search-forward (concat "\\b" (regexp-quote (rcirc-nick @@ -2494,6 +2616,7 @@ If ARG is given, opens the URL in a new browser window." (rcirc-record-activity (current-buffer) 'nick))))) (defun rcirc-markup-urls (_sender _response) + "Highlight and activate URLs." (while (and rcirc-url-regexp ; nil means disable URL catching. (re-search-forward rcirc-url-regexp nil t)) (let* ((start (match-beginning 0)) @@ -2517,6 +2640,10 @@ If ARG is given, opens the URL in a new browser window." (push (cons url start) rcirc-urls))))) (defun rcirc-markup-keywords (sender response) + "Highlight keywords as specified by `rcirc-keywords'. +Keywords are only highlighted in messages (as indicated by +RESPONSE) when they were not written by the user (as indicated by +SENDER)." (when (and (string= response "PRIVMSG") (not (string= sender (rcirc-nick (rcirc-buffer-process))))) (let* ((target (or rcirc-target "")) @@ -2531,6 +2658,9 @@ If ARG is given, opens the URL in a new browser window." (rcirc-record-activity (current-buffer) 'keyword)))))) (defun rcirc-markup-bright-nicks (_sender response) + "Highlight nicks brightly as specified by `rcirc-bright-nicks'. +This highlighting only takes place in name lists (as indicated by +RESPONSE)." (when (and rcirc-bright-nicks (string= response "NAMES")) (with-syntax-table rcirc-nick-syntax-table @@ -2539,6 +2669,8 @@ If ARG is given, opens the URL in a new browser window." 'rcirc-bright-nick))))) (defun rcirc-markup-fill (_sender response) + "Fill messages as configured by `rcirc-fill-column'. +MOTD messages are not filled (as indicated by RESPONSE)." (when (not (string= response "372")) ; /motd (let ((fill-prefix (or rcirc-fill-prefix @@ -2556,8 +2688,11 @@ If ARG is given, opens the URL in a new browser window." ;; server or a user, depending on the command, the ARGS, which is a ;; list of strings, and the TEXT, which is the original server text, ;; verbatim -(defun rcirc-handler-001 (process sender args text) - (rcirc-handler-generic process "001" sender args text) +(defun rcirc-handler-001 (process sender args _text) + "Handle welcome message. +SENDER and ARGS are used to initialize the current connection. +PROCESS is the process object for the current connection." + (rcirc-handler-generic process "001" sender args nil) (with-rcirc-process-buffer process (setq rcirc-connecting nil) (rcirc-reschedule-timeout process) @@ -2581,11 +2716,16 @@ If ARG is given, opens the URL in a new browser window." (rcirc-join-channels process rcirc-startup-channels)))) (defun rcirc-join-channels-post-auth (process) - "Join `rcirc-startup-channels' after authenticating." + "Join `rcirc-startup-channels' after authenticating. +PROCESS is the process object for the current connection." (with-rcirc-process-buffer process (rcirc-join-channels process rcirc-startup-channels))) (defun rcirc-handler-PRIVMSG (process sender args text) + "Handle a (private) message from SENDER. +ARGS should have the form (TARGET MESSAGE). TEXT is the verbatim +message as received from the server. PROCESS is the process +object for the current connection." (rcirc-check-auth-status process sender args text) (let ((target (if (rcirc-channel-p (car args)) (car args) @@ -2599,6 +2739,10 @@ If ARG is given, opens the URL in a new browser window." (rcirc-put-nick-channel process sender target rcirc-current-line)))) (defun rcirc-handler-NOTICE (process sender args text) + "Handle a notice message from SENDER. +ARGS should have the form (TARGET MESSAGE). +TEXT is the verbatim message as received from the server. +PROCESS is the process object for the current connection." (rcirc-check-auth-status process sender args text) (let ((target (car args)) (message (cadr args))) @@ -2608,7 +2752,7 @@ If ARG is given, opens the URL in a new browser window." (rcirc-print process sender "NOTICE" (cond ((rcirc-channel-p target) target) - ;;; -ChanServ- [#gnu] Welcome... + ;; -ChanServ- [#gnu] Welcome... ((string-match "\\[\\(#[^] ]+\\)\\]" message) (match-string 1 message)) (sender @@ -2620,7 +2764,9 @@ If ARG is given, opens the URL in a new browser window." (defun rcirc-check-auth-status (process sender args _text) "Check if the user just authenticated. If authenticated, runs `rcirc-authenticated-hook' with PROCESS as -the only argument." +the only argument. ARGS should have the form (TARGET MESSAGE). +SENDER is used the determine the authentication method. PROCESS +is the process object for the current connection." (with-rcirc-process-buffer process (when (and (not rcirc-user-authenticated) rcirc-authenticate-before-join @@ -2650,9 +2796,17 @@ the only argument." (remove-hook 'rcirc-authenticated-hook 'rcirc-join-channels-post-auth t)))))) (defun rcirc-handler-WALLOPS (process sender args _text) + "Handle WALLOPS message from SENDER. +ARGS should have the form (MESSAGE). +PROCESS is the process object for the current +connection." (rcirc-print process sender "WALLOPS" sender (car args) t)) (defun rcirc-handler-JOIN (process sender args _text) + "Handle JOIN message from SENDER. +ARGS should have the form (CHANNEL). +PROCESS is the process object for the current +connection." (let ((channel (car args))) (with-current-buffer (rcirc-get-buffer-create process channel) ;; when recently rejoining, restore the linestamp @@ -2674,6 +2828,8 @@ the only argument." ;; PART and KICK are handled the same way (defun rcirc-handler-PART-or-KICK (process _response channel _sender nick _args) + "Remove NICK from CHANNEL. +PROCESS is the process object for the current connection." (rcirc-ignore-update-automatic nick) (if (not (string= nick (rcirc-nick process))) ;; this is someone else leaving @@ -2691,6 +2847,9 @@ the only argument." (rcirc-disconnect-buffer buffer))))) (defun rcirc-handler-PART (process sender args _text) + "Handle PART message from SENDER. +ARGS should have the form (CHANNEL REASON). +PROCESS is the process object for the current connection." (let* ((channel (car args)) (reason (cadr args)) (message (concat channel " " reason))) @@ -2702,6 +2861,9 @@ the only argument." (rcirc-handler-PART-or-KICK process "PART" channel sender sender reason))) (defun rcirc-handler-KICK (process sender args _text) + "Handle PART message from SENDER. +ARGS should have the form (CHANNEL NICK REASON). +PROCESS is the process object for the current connection." (let* ((channel (car args)) (nick (cadr args)) (reason (nth 2 args)) @@ -2714,7 +2876,8 @@ the only argument." (rcirc-handler-PART-or-KICK process "KICK" channel sender nick reason))) (defun rcirc-maybe-remember-nick-quit (process nick channel) - "Remember NICK as leaving CHANNEL if they recently spoke." + "Remember NICK as leaving CHANNEL if they recently spoke. +PROCESS is the process object for the current connection." (let ((elapsed-lines (rcirc-elapsed-lines process nick channel))) (when (and elapsed-lines (< elapsed-lines rcirc-omit-threshold)) @@ -2730,6 +2893,8 @@ the only argument." rcirc-recent-quit-alist)))))))))) (defun rcirc-handler-QUIT (process sender args _text) + "Handle QUIT message from SENDER. +PROCESS is the process object for the current connection." (rcirc-ignore-update-automatic sender) (mapc (lambda (channel) ;; broadcast quit message each channel @@ -2740,6 +2905,9 @@ the only argument." (rcirc-nick-remove process sender)) (defun rcirc-handler-NICK (process sender args _text) + "Handle NICK message from SENDER. +ARGS should have the form (NEW-NICK). +PROCESS is the process object for the current connection." (let* ((old-nick sender) (new-nick (car args)) (channels (rcirc-nick-channels process old-nick))) @@ -2771,21 +2939,31 @@ the only argument." (when rcirc-auto-authenticate-flag (rcirc-authenticate)))))) (defun rcirc-handler-PING (process _sender args _text) + "Respond to a PING with a PONG. +ARGS should have the form (MESSAGE). MESSAGE is relayed back to +the server. PROCESS is the process object for the current +connection." (rcirc-send-string process (concat "PONG :" (car args)))) + (defun rcirc-handler-PONG (_process _sender _args _text) - ;; do nothing - ) + "Ignore all incoming PONG messages.") (defun rcirc-handler-TOPIC (process sender args _text) + "Note the topic change from SENDER. +PROCESS is the process object for the current connection." (let ((topic (cadr args))) (rcirc-print process sender "TOPIC" (car args) topic) (with-current-buffer (rcirc-get-buffer process (car args)) (setq rcirc-topic topic)))) -(defvar rcirc-nick-away-alist nil) +(defvar rcirc-nick-away-alist nil + "Alist from nicks to away messages.") + (defun rcirc-handler-301 (process _sender args text) - "RPL_AWAY" + "Handle away messages (RPL_AWAY). +ARGS should have the form (NICK AWAY-MESSAGE). +PROCESS is the process object for the current connection." (let* ((nick (cadr args)) (rec (assoc-string nick rcirc-nick-away-alist)) (away-message (nth 2 args))) @@ -2799,7 +2977,9 @@ the only argument." rcirc-nick-away-alist)))))) (defun rcirc-handler-317 (process sender args _text) - "RPL_WHOISIDLE" + "Handle idle messages from SENDER (RPL_WHOISIDLE). +ARGS should have the form (NICK IDLE-SECS SIGNON-TIME). +PROCESS is the process object for the current connection." (let* ((nick (nth 1 args)) (idle-secs (string-to-number (nth 2 args))) (idle-string (format-seconds "%yy %dd %hh %mm %z%ss" idle-secs)) @@ -2810,15 +2990,20 @@ the only argument." (rcirc-print process sender "317" nil message t))) (defun rcirc-handler-332 (process _sender args _text) - "RPL_TOPIC" + "Update topic when notified by server (RPL_TOPIC). +ARGS should have the form (CHANNEL TOPIC). +PROCESS is the process object for the current connection." (let ((buffer (or (rcirc-get-buffer process (cadr args)) (rcirc-get-temp-buffer-create process (cadr args))))) (with-current-buffer buffer (setq rcirc-topic (nth 2 args))))) (defun rcirc-handler-333 (process sender args _text) - "333 says who set the topic and when. -Not in rfc1459.txt" + "Update when and who set the current topic. +ARGS has the form (CHANNEL SETTER TIME). SENDER is passed on to +`rcirc-print'. PROCESS is the process object for the current +connection. This is a non-standard extension, not specified in +RFC1459." (let ((buffer (or (rcirc-get-buffer process (cadr args)) (rcirc-get-temp-buffer-create process (cadr args))))) (with-current-buffer buffer @@ -2829,10 +3014,17 @@ Not in rfc1459.txt" (format "%s (%s on %s)" rcirc-topic setter time)))))) (defun rcirc-handler-477 (process sender args _text) - "ERR_NOCHANMODES" + "Notify user that CHANNEL does not support modes (ERR_NOCHANMODES). +ARGS has the form (CHANNEL MESSAGE). SENDER is passed on to +`rcirc-print'. PROCESS is the process object for the current +connection." (rcirc-print process sender "477" (cadr args) (nth 2 args))) (defun rcirc-handler-MODE (process sender args _text) + "Handle MODE messages. +ARGS should have the form (TARGET . MESSAGE-LIST). +SENDER is passed on to `rcirc-print'. +PROCESS is the process object for the current connection." (let ((target (car args)) (msg (mapconcat 'identity (cdr args) " "))) (rcirc-print process sender "MODE" @@ -2853,7 +3045,9 @@ Not in rfc1459.txt" (get-buffer-create tmpnam))) (defun rcirc-handler-353 (process _sender args _text) - "RPL_NAMREPLY" + "Start handling list of users (RPL_NAMREPLY). +ARGS should have the form (TYPE CHANNEL . NICK-LIST). +PROCESS is the process object for the current connection." (let ((channel (nth 2 args)) (names (or (nth 3 args) ""))) (mapc (lambda (nick) @@ -2866,7 +3060,9 @@ Not in rfc1459.txt" (insert (car (last args)) " ")))) (defun rcirc-handler-366 (process sender args _text) - "RPL_ENDOFNAMES" + "Handle end of user list (RPL_ENDOFNAMES). +SENDER is passed on to `rcirc-print'. +PROCESS is the process object for the current connection." (let* ((channel (cadr args)) (buffer (rcirc-get-temp-buffer-create process channel))) (with-current-buffer buffer @@ -2876,7 +3072,10 @@ Not in rfc1459.txt" (kill-buffer buffer))) (defun rcirc-handler-433 (process sender args text) - "ERR_NICKNAMEINUSE" + "Warn user that nick is used (ERR_NICKNAMEINUSE). +ARGS should have the form (NICK CHANNEL WARNING). +SENDER is passed on to `rcirc-handler-generic'. +PROCESS is the process object for the current connection." (rcirc-handler-generic process "433" sender args text) (with-rcirc-process-buffer process (let* ((length (string-to-number @@ -2885,8 +3084,10 @@ Not in rfc1459.txt" (rcirc-cmd-nick (rcirc--make-new-nick (cadr args) length) nil process)))) (defun rcirc--make-new-nick (nick length) - ;; If we already have some ` chars at the end, then shorten the - ;; non-` bit of the name. + "Attempt to create a unused nickname out of NICK. +A new nick may at most be LENGTH characters long. If we already +have some ` chars at the end, then shorten the non-` bit of the +name." (when (= (length nick) length) (setq nick (replace-regexp-in-string "[^`]\\(`+\\)\\'" "\\1" nick))) (concat @@ -2896,7 +3097,14 @@ Not in rfc1459.txt" "`")) (defun rcirc-handler-005 (process sender args text) - "ERR_NICKNAMEINUSE" + "Register supported server features (RPL_ISUPPORT). +ARGS should be a list of string feature parameters, either of the +form \"PARAMETER\" to enable a feature, \"PARAMETER=VALUE\" to +configure a specific option or \"-PARAMETER\" to disable a +previously specified feature. SENDER is passed on to +`rcirc-handler-generic'. PROCESS is the process object for the +current connection. Note that this is not the behaviour as +specified in RFC2812, where 005 stood for RPL_BOUNCE." (rcirc-handler-generic process "005" sender args text) (with-rcirc-process-buffer process (setq rcirc-server-parameters (append rcirc-server-parameters args)))) @@ -2941,12 +3149,27 @@ Passwords are stored in `rcirc-authinfo' (which see)." (format "AUTH %s %s" nick (car args)))))))))) (defun rcirc-handler-INVITE (process sender args _text) + "Notify user of an invitation. +SENDER and ARGS (in concatenated form) are passed on to +`rcirc-print'. PROCESS is the process object for the current +connection." (rcirc-print process sender "INVITE" nil (mapconcat 'identity args " ") t)) (defun rcirc-handler-ERROR (process sender args _text) + "Print a error message. +SENDER and ARGS (in concatenated form) are passed on to +`rcirc-print'. PROCESS is the process object for the current +connection." (rcirc-print process sender "ERROR" nil (mapconcat 'identity args " "))) (defun rcirc-handler-CTCP (process target sender text) + "Handle Client-To-Client-Protocol message TEXT. +The message is addressed from SENDER to TARGET. Attempt to find +an appropriate handler, by invoicing the function +`rcirc-handler-ctcp-REQUEST', where REQUEST is the message type +as extracted from TEXT. If no handler was found, an error +message will be printed. PROCESS is the process object for the +current connection." (if (string-match "^\\([^ ]+\\) *\\(.*\\)$" text) (let* ((request (upcase (match-string 1 text))) (args (match-string 2 text)) @@ -2961,22 +3184,31 @@ Passwords are stored in `rcirc-authinfo' (which see)." (rcirc-print process sender "CTCP" target (format "%s" text) t)))))) -(defun rcirc-handler-ctcp-VERSION (process _target sender _args) +(defun rcirc-handler-ctcp-VERSION (process _target sender _message) + "Handle a CTCP VERSION message from SENDER. +PROCESS is the process object for the current connection." (rcirc-send-string process (concat "NOTICE " sender " :\C-aVERSION " rcirc-id-string "\C-a"))) -(defun rcirc-handler-ctcp-ACTION (process target sender args) - (rcirc-print process sender "ACTION" target args t)) +(defun rcirc-handler-ctcp-ACTION (process target sender message) + "Handle a CTCP ACTION MESSAGE from SENDER to TARGET. +PROCESS is the process object for the current connection." + (rcirc-print process sender "ACTION" target message t)) -(defun rcirc-handler-ctcp-TIME (process _target sender _args) +(defun rcirc-handler-ctcp-TIME (process _target sender _message) + "Respond to CTCP TIME message from SENDER. +PROCESS is the process object for the current connection." (rcirc-send-string process (concat "NOTICE " sender " :\C-aTIME " (current-time-string) "\C-a"))) (defun rcirc-handler-CTCP-response (process _target sender message) + "Handle CTCP response MESSAGE from SENDER. +PROCESS is the process object for the current connection." (rcirc-print process sender "CTCP" nil message t)) + (defgroup rcirc-faces nil "Faces for rcirc." @@ -3092,11 +3324,12 @@ Passwords are stored in `rcirc-authinfo' (which see)." ;; When using M-x flyspell-mode, only check words after the prompt (put 'rcirc-mode 'flyspell-mode-predicate 'rcirc-looking-at-input) (defun rcirc-looking-at-input () - "Return true if point is past the input marker." + "Return non-nil if point is past the input marker." (>= (point) rcirc-prompt-end-marker)) (defun rcirc-server-parameter-value (parameter) + "Traverse `rcirc-server-parameters' for PARAMETER." (cl-loop for elem in rcirc-server-parameters for setting = (split-string elem "=") when (and (= (length setting) 2) From e6c99a761d1603ef9f065292a853a32d6a0ffd34 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Wed, 9 Jun 2021 16:14:29 +0200 Subject: [PATCH 04/38] Integrate formatting into rcirc-send-string * rcirc.el (rcirc-connect): Use new syntax (rcirc-send-string): Allow for more arguments (rcirc-send-privmsg): Use new syntax (rcirc-send-ctcp): Use new syntax (rcirc-send-message): Use new syntax (rcirc-clean-up-buffer): Use new syntax (join): Use new syntax (invite): Use new syntax (part): Use new syntax (quit): Use new syntax (nick): Use new syntax (names): Use new syntax (topic): Use new syntax (whois): Use new syntax (mode): Use new syntax (list): Use new syntax (oper): Use new syntax (kick): Use new syntax (rcirc-handler-PING): Use new syntax (rcirc-handler-ctcp-VERSION): Use new syntax (rcirc-handler-ctcp-ACTION): Use new syntax (rcirc-handler-ctcp-TIME): Use new syntax --- lisp/net/rcirc.el | 88 +++++++++++++++++++++++++---------------------- 1 file changed, 47 insertions(+), 41 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 5a21bd81a89..bc7d89c78f9 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -629,10 +629,9 @@ that are joined after authentication." ;; identify (unless (zerop (length password)) - (rcirc-send-string process (concat "PASS " password))) - (rcirc-send-string process (concat "NICK " nick)) - (rcirc-send-string process (concat "USER " user-name - " 0 * :" full-name)) + (rcirc-send-string process "PASS" password)) + (rcirc-send-string process "NICK" nick) + (rcirc-send-string process "USER" user-name "0" "*" : full-name) ;; setup ping timer if necessary (unless rcirc-keepalive-timer @@ -875,9 +874,21 @@ used as the message body." "Check if PROCESS is open or running." (memq (process-status process) '(run open))) -(defun rcirc-send-string (process string) - "Send PROCESS a STRING plus a newline." - (let ((string (concat (encode-coding-string string rcirc-encode-coding-system) +(defun rcirc-send-string (process &rest parts) + "Send PROCESS a PARTS plus a newline. +PARTS may contain a `:' symbol, to designate that the next string +is the message, that should be prefixed by a colon. If the last +element in PARTS is a list, append it to PARTS." + (let ((last (car (last parts)))) + (when (listp last) + (setf parts (append (butlast parts) last)))) + (when-let (message (memq : parts)) + (cl-check-type (cadr message) string) + (setf (cadr message) (concat ":" (cadr message)) + parts (remq : parts))) + (let ((string (concat (encode-coding-string + (mapconcat #'identity parts " ") + rcirc-encode-coding-system) "\n"))) (unless (rcirc--connection-open-p process) (error "Network connection to %s is not open" @@ -888,13 +899,15 @@ used as the message body." (defun rcirc-send-privmsg (process target string) "Send TARGET the message in STRING via PROCESS." (cl-check-type target string) - (rcirc-send-string process (format "PRIVMSG %s :%s" target string))) + (rcirc-send-string process "PRIVMSG" target : string)) + +(defun rcirc-ctcp-wrap (&rest args) + "Join ARGS into a string wrapped by ASCII 1 charterers." + (concat "\C-a" (string-join (delq nil args) " ") "\C-a")) (defun rcirc-send-ctcp (process target request &optional args) "Send TARGET a REQUEST via PROCESS." - (let ((args (if args (concat " " args) ""))) - (rcirc-send-privmsg process target - (format "\C-a%s%s\C-a" request args)))) + (rcirc-send-privmsg process target (rcirc-ctcp-wrap request args))) (defun rcirc-buffer-process (&optional buffer) "Return the process associated with channel BUFFER. @@ -953,7 +966,7 @@ If SILENT is non-nil, do not print the message in any irc buffer." (let ((response (if noticep "NOTICE" "PRIVMSG"))) (rcirc-get-buffer-create process target) (dolist (msg (rcirc-split-message message)) - (rcirc-send-string process (concat response " " target " :" msg)) + (rcirc-send-string process response target : msg) (unless silent (rcirc-print process (rcirc-nick process) response target msg))))) @@ -1278,7 +1291,7 @@ with it." (rcirc-update-short-buffer-names) (if (rcirc-channel-p rcirc-target) (rcirc-send-string (rcirc-buffer-process) - (concat "PART " rcirc-target " :" reason)) + "PART" rcirc-target : reason) (when rcirc-target (rcirc-remove-nick-channel (rcirc-buffer-process) (rcirc-buffer-nick) @@ -2309,7 +2322,7 @@ CHANNELS is a comma- or space-separated string of channel names." (rcirc-get-buffer-create process ch)) split-channels)) (channels (mapconcat 'identity split-channels ","))) - (rcirc-send-string process (concat "JOIN " channels)) + (rcirc-send-string process "JOIN" channels) (when (not (eq (selected-window) (minibuffer-window))) (dolist (b buffers) ;; order the new channel buffers in the buffer list (switch-to-buffer b))))) @@ -2322,7 +2335,7 @@ CHANNELS is a comma- or space-separated string of channel names." (with-rcirc-server-buffer rcirc-nick-table)) " " (read-string "Channel: ")))) - (rcirc-send-string process (concat "INVITE " nick-channel))) + (rcirc-send-string process "INVITE" nick-channel)) (defun-rcirc-command part (channel) "Part CHANNEL. @@ -2338,15 +2351,14 @@ to `rcirc-default-part-reason'." (setq channel (if (match-beginning 1) (match-string 1 channel) target))) - (rcirc-send-string process (concat "PART " channel " :" msg)))) + (rcirc-send-string process "PART" channel : msg))) (defun-rcirc-command quit (reason) "Send a quit message to server with REASON." (interactive "sQuit reason: ") - (rcirc-send-string process (concat "QUIT :" - (if (not (zerop (length reason))) + (rcirc-send-string process "QUIT" : (if (not (zerop (length reason))) reason - rcirc-default-quit-reason)))) + rcirc-default-quit-reason))) (defun-rcirc-command reconnect (_) "Reconnect to current server." @@ -2366,7 +2378,7 @@ to `rcirc-default-part-reason'." (interactive "i") (when (null nick) (setq nick (read-string "New nick: " (rcirc-nick process)))) - (rcirc-send-string process (concat "NICK " nick))) + (rcirc-send-string process "NICK" nick)) (defun-rcirc-command names (channel) "Display list of names in CHANNEL or in current channel if CHANNEL is nil. @@ -2378,7 +2390,7 @@ If called interactively, prompt for a channel when prefix arg is supplied." (let ((channel (if (> (length channel) 0) channel target))) - (rcirc-send-string process (concat "NAMES " channel)))) + (rcirc-send-string process "NAMES" channel))) (defun-rcirc-command topic (topic) "List TOPIC for the TARGET channel. @@ -2386,32 +2398,32 @@ With a prefix arg, prompt for new topic." (interactive "P") (if (and (called-interactively-p 'interactive) topic) (setq topic (read-string "New Topic: " rcirc-topic))) - (rcirc-send-string process (concat "TOPIC " target - (when (> (length topic) 0) - (concat " :" topic))))) + (if (> (length topic) 0) + (rcirc-send-string process "TOPIC" : topic) + (rcirc-send-string process "TOPIC"))) (defun-rcirc-command whois (nick) "Request information from server about NICK." (interactive (list (completing-read "Whois: " (with-rcirc-server-buffer rcirc-nick-table)))) - (rcirc-send-string process (concat "WHOIS " nick))) + (rcirc-send-string process "WHOIS" nick)) (defun-rcirc-command mode (args) "Set mode with ARGS." (interactive (list (concat (read-string "Mode nick or channel: ") " " (read-string "Mode: ")))) - (rcirc-send-string process (concat "MODE " args))) + (rcirc-send-string process "MODE" args)) (defun-rcirc-command list (channels) "Request information on CHANNELS from server." (interactive "sList Channels: ") - (rcirc-send-string process (concat "LIST " channels))) + (rcirc-send-string process "LIST" channels)) (defun-rcirc-command oper (args) "Send operator command to server." (interactive "sOper args: ") - (rcirc-send-string process (concat "OPER " args))) + (rcirc-send-string process "OPER" args)) (defun-rcirc-command quote (message) "Send MESSAGE literally to server." @@ -2426,10 +2438,8 @@ With a prefix arg, prompt for new topic." (rcirc-buffer-process) rcirc-target)) (read-from-minibuffer "Kick reason: ")))) - (let* ((arglist (split-string arg)) - (argstring (concat (car arglist) " :" - (mapconcat 'identity (cdr arglist) " ")))) - (rcirc-send-string process (concat "KICK " target " " argstring)))) + (let ((args (split-string arg))) + (rcirc-send-string process "KICK" target (car args) : (cdr args)))) (defun rcirc-cmd-ctcp (args &optional process _target) "Handle ARGS as a CTCP command. @@ -2943,8 +2953,7 @@ PROCESS is the process object for the current connection." ARGS should have the form (MESSAGE). MESSAGE is relayed back to the server. PROCESS is the process object for the current connection." - (rcirc-send-string process (concat "PONG :" (car args)))) - + (rcirc-send-string process "PONG" : (car args))) (defun rcirc-handler-PONG (_process _sender _args _text) "Ignore all incoming PONG messages.") @@ -3187,10 +3196,8 @@ current connection." (defun rcirc-handler-ctcp-VERSION (process _target sender _message) "Handle a CTCP VERSION message from SENDER. PROCESS is the process object for the current connection." - (rcirc-send-string process - (concat "NOTICE " sender - " :\C-aVERSION " rcirc-id-string - "\C-a"))) + (rcirc-send-string process "NOTICE" sender : + (rcirc-ctcp-wrap "VERSION" rcirc-id-string))) (defun rcirc-handler-ctcp-ACTION (process target sender message) "Handle a CTCP ACTION MESSAGE from SENDER to TARGET. @@ -3200,9 +3207,8 @@ PROCESS is the process object for the current connection." (defun rcirc-handler-ctcp-TIME (process _target sender _message) "Respond to CTCP TIME message from SENDER. PROCESS is the process object for the current connection." - (rcirc-send-string process - (concat "NOTICE " sender - " :\C-aTIME " (current-time-string) "\C-a"))) + (rcirc-send-string process "NOTICE" sender : + (rcirc-ctcp-wrap "TIME" (current-time-string)))) (defun rcirc-handler-CTCP-response (process _target sender message) "Handle CTCP response MESSAGE from SENDER. From 8ea5766050a2bc27ad1166daca3ab2b4707d5728 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Wed, 9 Jun 2021 16:17:48 +0200 Subject: [PATCH 05/38] Recognize quoted commands in rcirc-process-input-line * rcirc.el (rcirc-process-input-line): Check for quoted commands (rcirc-process-command): Don't check for quoted commands --- lisp/net/rcirc.el | 33 ++++++++++++++------------------- 1 file changed, 14 insertions(+), 19 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index bc7d89c78f9..b919e03dce6 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1380,7 +1380,7 @@ The argument JUSTIFY is passed on to `fill-region'." (defun rcirc-process-input-line (line) "Process LINE as a message or a command." - (if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" line) + (if (string-match "^/\\([^/ ][^ ]*\\) ?\\(.*\\)$" line) (rcirc-process-command (match-string 1 line) (match-string 2 line) line) @@ -1398,25 +1398,20 @@ The argument JUSTIFY is passed on to `fill-region'." "Process COMMAND with arguments ARGS. LINE is the raw input, from which COMMAND and ARGS was extracted." - (if (eq (aref command 0) ?/) - ;; "//text" will send "/text" as a message - (rcirc-process-message (substring line 1)) - (let ((fun (intern-soft (concat "rcirc-cmd-" command))) - (process (rcirc-buffer-process))) - (newline) - (with-current-buffer (current-buffer) - (delete-region rcirc-prompt-end-marker (point)) - (if (string= command "me") - (rcirc-print process (rcirc-buffer-nick) - "ACTION" rcirc-target args) + (let ((fun (intern-soft (concat "rcirc-cmd-" command))) + (process (rcirc-buffer-process))) + (newline) + (with-current-buffer (current-buffer) + (delete-region rcirc-prompt-end-marker (point)) + (if (string= command "me") (rcirc-print process (rcirc-buffer-nick) - "COMMAND" rcirc-target line)) - (set-marker rcirc-prompt-end-marker (point)) - (if (fboundp fun) - (funcall fun args process rcirc-target) - (rcirc-send-string process - (concat command " :" args))))))) - + "ACTION" rcirc-target args) + (rcirc-print process (rcirc-buffer-nick) + "COMMAND" rcirc-target line)) + (set-marker rcirc-prompt-end-marker (point)) + (if (fboundp fun) + (funcall fun args process rcirc-target) + (rcirc-send-string process command : args))))) (defvar-local rcirc-parent-buffer nil "Message buffer that requested a multiline buffer.") From 0b367ec39f41825f3eb2ce6acc4d2dd764ecc898 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Wed, 9 Jun 2021 18:05:35 +0200 Subject: [PATCH 06/38] Remove custom rcirc-completion implementation * rcirc.el (rcirc-completion-at-point): Improve completion suggestions (rcirc-completions): Remove variable (rcirc-completion-start): Remove variable (rcirc-complete): Remove function (rcirc-mode-map): Bind TAB to completion-at-point (rcirc-mode): Use cycling for completion --- lisp/net/rcirc.el | 67 +++++++++++++++++------------------------------ 1 file changed, 24 insertions(+), 43 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index b919e03dce6..d463a14548b 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1023,50 +1023,30 @@ The list is updated automatically by `defun-rcirc-command'.") (if (re-search-backward "[[:space:]@]" rcirc-prompt-end-marker t) (1+ (point)) rcirc-prompt-end-marker))) - (table (if (and (= beg rcirc-prompt-end-marker) - (eq (char-after beg) ?/)) - (delete-dups - (nconc (sort (copy-sequence rcirc-client-commands) - 'string-lessp) - (sort (copy-sequence rcirc-server-commands) - 'string-lessp))) - (rcirc-channel-nicks (rcirc-buffer-process) - rcirc-target)))) + (table (cond + ;; No completion before the prompt + ((< beg rcirc-prompt-end-marker) nil) + ;; Only complete nicks mid-message + ((> beg rcirc-prompt-end-marker) + (rcirc-channel-nicks (rcirc-buffer-process) + rcirc-target)) + ;; Complete commands at the beginning of the + ;; message, when the first character is a dash + ((eq (char-after beg) ?/) + (mapcar + (lambda (cmd) (concat cmd " ")) + (nconc (sort (copy-sequence rcirc-client-commands) + 'string-lessp) + (sort (copy-sequence rcirc-server-commands) + 'string-lessp)))) + ;; Complete usernames right after the prompt by + ;; appending a colon after the name + ((mapcar + (lambda (str) (concat str ": ")) + (rcirc-channel-nicks (rcirc-buffer-process) + rcirc-target)))))) (list beg (point) table)))) -(defvar rcirc-completions nil - "List of possible completions to cycle through.") - -(defvar rcirc-completion-start nil - "Point indicating where completion starts.") - -(defun rcirc-complete () - "Cycle through completions from list of nicks in channel or IRC commands. -IRC command completion is performed only if `/' is the first input char." - (interactive) - (unless (rcirc-looking-at-input) - (error "Point not located after rcirc prompt")) - (if (eq last-command this-command) - (setq rcirc-completions - (append (cdr rcirc-completions) (list (car rcirc-completions)))) - (let ((completion-ignore-case t) - (table (rcirc-completion-at-point))) - (setq rcirc-completion-start (car table)) - (setq rcirc-completions - (and rcirc-completion-start - (all-completions (buffer-substring rcirc-completion-start - (cadr table)) - (nth 2 table)))))) - (let ((completion (car rcirc-completions))) - (when completion - (delete-region rcirc-completion-start (point)) - (insert - (cond - ((= (aref completion 0) ?/) (concat completion " ")) - ((= rcirc-completion-start rcirc-prompt-end-marker) - (format rcirc-nick-completion-format completion)) - (t completion)))))) - (defun set-rcirc-decode-coding-system (coding-system) "Set the decode CODING-SYSTEM used in this channel." (interactive "zCoding system for incoming messages: ") @@ -1082,7 +1062,7 @@ IRC command completion is performed only if `/' is the first input char." (define-key map (kbd "RET") 'rcirc-send-input) (define-key map (kbd "M-p") 'rcirc-insert-prev-input) (define-key map (kbd "M-n") 'rcirc-insert-next-input) - (define-key map (kbd "TAB") 'rcirc-complete) + (define-key map (kbd "TAB") 'completion-at-point) (define-key map (kbd "C-c C-b") 'rcirc-browse-url) (define-key map (kbd "C-c C-c") 'rcirc-edit-multiline) (define-key map (kbd "C-c C-j") 'rcirc-cmd-join) @@ -1195,6 +1175,7 @@ This number is independent of the number of lines in the buffer.") (add-hook 'completion-at-point-functions 'rcirc-completion-at-point nil 'local) + (setq-local completion-cycle-threshold t) (run-mode-hooks 'rcirc-mode-hook)) From 4ff1f66b12359fbb91821da5b87580b98ac49af3 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Wed, 9 Jun 2021 18:16:47 +0200 Subject: [PATCH 07/38] Replace defun-rcirc-command with rcirc-define-command * rcirc.el (defun-rcirc-command): Remove old macro (rcirc-define-command): Create new macro --- lisp/net/rcirc.el | 188 +++++++++++++++++++++++----------------------- 1 file changed, 96 insertions(+), 92 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index d463a14548b..1b3601771bb 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2242,54 +2242,66 @@ prefix with another element in PAIRS." ;; the current buffer/channel/user, and ARGS, which is a string ;; containing the text following the /cmd. -(defmacro defun-rcirc-command (command argument - docstring interactive-form - &rest body) - "Define COMMAND that operates on ARGUMENT. -This macro internally defines an interactive function, prefixing -COMMAND with `rcirc-cmd-'. DOCSTRING, INTERACTIVE-FORM and BODY -are passed directly to `defun'." - `(progn - (add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name command))) - (defun ,(intern (concat "rcirc-cmd-" (symbol-name command))) - (,@argument &optional process target) - ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values given" - "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") - ,interactive-form - (let ((process (or process (rcirc-buffer-process))) - (target (or target rcirc-target))) - (ignore target) ; mark `target' variable as ignorable - ,@body)))) +(defmacro rcirc-define-command (command arguments &rest body) + "Define a new client COMMAND in BODY that takes ARGUMENTS. +Just like `defun', a string at the beginning of BODY is +interpreted as the documentation string. Following that, an +interactive form can specified." + (declare (debug (symbolp (&rest symbolp) def-body)) + (indent defun)) + (cl-check-type command symbol) + (cl-check-type arguments list) + (let ((fn-name (intern (concat "rcirc-cmd-" (symbol-name command))) ) + (regexp (with-temp-buffer + (insert "\\`") + (when arguments + (dotimes (_ (1- (length arguments))) + (insert "\\(.+?\\)[[:space:]]*")) + (insert "\\(.*\\)")) + (insert "[[:space:]]*\\'") + (buffer-string))) + (argument (gensym)) + documentation + interactive-spec) + (when (stringp (car body)) + (setq documentation (pop body))) + (when (eq (car-safe (car-safe body)) 'interactive) + (setq interactive-spec (cdr (pop body)))) + `(progn + (defun ,fn-name (,argument &optional process target) + ,(concat documentation + "\n\nNote: If PROCESS or TARGET are nil, the values given" + "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") + (interactive ,@interactive-spec) + (unless (if (listp ,argument) + (= (length ,argument) ,(length arguments)) + (string-match ,regexp ,argument)) + (user-error "Malformed input: %S" ',arguments)) + (let ((process (or process (rcirc-buffer-process))) + (target (or target rcirc-target))) + (ignore target process) + (let (,@(cl-loop + for i from 0 for arg in arguments + collect `(,arg (if (listp ,argument) + (nth ,i ,argument) + (match-string ,(1+ i) ,argument))))) + ,@body))) + (add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name command)))))) -(defun-rcirc-command msg (message) - "Send private MESSAGE to TARGET." - (interactive "i") - (if (null message) - (progn - (setq target (completing-read "Message nick: " +(define-obsolete-function-alias + 'defun-rcirc-command + 'rcirc-define-command + "28.1") + +(rcirc-define-command msg (chan-or-nick message) + "Send MESSAGE to CHAN-OR-NICK." + (interactive (list (completing-read "Message nick: " (with-rcirc-server-buffer - rcirc-nick-table))) - (when (> (length target) 0) - (setq message (read-string (format "Message %s: " target))) - (when (> (length message) 0) - (rcirc-send-message process target message)))) - (if (not (string-match "\\([^ ]+\\) \\(.+\\)" message)) - (message "Not enough args, or something.") - (setq target (match-string 1 message) - message (match-string 2 message)) - (rcirc-send-message process target message)))) + rcirc-nick-table)) + (read-string "Message: "))) + (rcirc-send-message process chan-or-nick message)) -(defun-rcirc-command query (nick) - "Open a private chat buffer to NICK." - (interactive (list (completing-read "Query nick: " - (with-rcirc-server-buffer rcirc-nick-table)))) - (let ((existing-buffer (rcirc-get-buffer process nick))) - (switch-to-buffer (or existing-buffer - (rcirc-get-buffer-create process nick))) - (when (not existing-buffer) - (rcirc-cmd-whois nick)))) - -(defun-rcirc-command join (channels) +(rcirc-define-command join (channels) "Join CHANNELS. CHANNELS is a comma- or space-separated string of channel names." (interactive "sJoin channels: ") @@ -2303,17 +2315,15 @@ CHANNELS is a comma- or space-separated string of channel names." (dolist (b buffers) ;; order the new channel buffers in the buffer list (switch-to-buffer b))))) -(defun-rcirc-command invite (nick-channel) +(rcirc-define-command invite (nick channel) "Invite NICK to CHANNEL." (interactive (list - (concat - (completing-read "Invite nick: " - (with-rcirc-server-buffer rcirc-nick-table)) - " " - (read-string "Channel: ")))) - (rcirc-send-string process "INVITE" nick-channel)) + (completing-read "Invite nick: " + (with-rcirc-server-buffer rcirc-nick-table)) + (read-string "Channel: "))) + (rcirc-send-string process "INVITE" nick channel)) -(defun-rcirc-command part (channel) +(rcirc-define-command part (channel) "Part CHANNEL. CHANNEL should be a string of the form \"#CHANNEL-NAME REASON\". If omitted, CHANNEL-NAME defaults to TARGET, and REASON defaults @@ -2329,14 +2339,14 @@ to `rcirc-default-part-reason'." target))) (rcirc-send-string process "PART" channel : msg))) -(defun-rcirc-command quit (reason) +(rcirc-define-command quit (reason) "Send a quit message to server with REASON." (interactive "sQuit reason: ") (rcirc-send-string process "QUIT" : (if (not (zerop (length reason))) reason rcirc-default-quit-reason))) -(defun-rcirc-command reconnect (_) +(rcirc-define-command reconnect (_) "Reconnect to current server." (interactive "i") (with-rcirc-server-buffer @@ -2349,73 +2359,67 @@ to `rcirc-default-part-reason'." (mapcar #'car rcirc-buffer-alist))) (apply #'rcirc-connect conn-info)))))) -(defun-rcirc-command nick (nick) +(rcirc-define-command nick (nick) "Change nick to NICK." - (interactive "i") - (when (null nick) - (setq nick (read-string "New nick: " (rcirc-nick process)))) + (interactive (list (read-string "New nick: "))) (rcirc-send-string process "NICK" nick)) -(defun-rcirc-command names (channel) +(rcirc-define-command names (channel) "Display list of names in CHANNEL or in current channel if CHANNEL is nil. If called interactively, prompt for a channel when prefix arg is supplied." - (interactive "P") - (if (called-interactively-p 'interactive) - (if channel - (setq channel (read-string "List names in channel: " target)))) + (interactive (list (and current-prefix-arg + (read-string "List names in channel: ")))) (let ((channel (if (> (length channel) 0) channel target))) (rcirc-send-string process "NAMES" channel))) -(defun-rcirc-command topic (topic) +(rcirc-define-command topic (topic) "List TOPIC for the TARGET channel. With a prefix arg, prompt for new topic." - (interactive "P") - (if (and (called-interactively-p 'interactive) topic) - (setq topic (read-string "New Topic: " rcirc-topic))) + (interactive (list (and current-prefix-arg + (read-string "List names in channel: ")))) (if (> (length topic) 0) (rcirc-send-string process "TOPIC" : topic) (rcirc-send-string process "TOPIC"))) -(defun-rcirc-command whois (nick) +(rcirc-define-command whois (nick) "Request information from server about NICK." - (interactive (list - (completing-read "Whois: " - (with-rcirc-server-buffer rcirc-nick-table)))) + (interactive (list (completing-read + "Whois: " + (with-rcirc-server-buffer rcirc-nick-table)))) (rcirc-send-string process "WHOIS" nick)) -(defun-rcirc-command mode (args) - "Set mode with ARGS." - (interactive (list (concat (read-string "Mode nick or channel: ") - " " (read-string "Mode: ")))) - (rcirc-send-string process "MODE" args)) +(rcirc-define-command mode (nick-or-chan mode) + "Set NICK-OR-CHAN mode to MODE." + (interactive (list (read-string "Mode nick or channel: ") + (read-string "Mode: "))) + (rcirc-send-string process "MODE" nick-or-chan mode)) -(defun-rcirc-command list (channels) +(rcirc-define-command list (channels) "Request information on CHANNELS from server." (interactive "sList Channels: ") (rcirc-send-string process "LIST" channels)) -(defun-rcirc-command oper (args) +(rcirc-define-command oper (args) "Send operator command to server." (interactive "sOper args: ") (rcirc-send-string process "OPER" args)) -(defun-rcirc-command quote (message) +(rcirc-define-command quote (message) "Send MESSAGE literally to server." (interactive "sServer message: ") (rcirc-send-string process message)) -(defun-rcirc-command kick (arg) +(rcirc-define-command kick (nick reason) "Kick NICK from current channel." (interactive (list - (concat (completing-read "Kick nick: " - (rcirc-channel-nicks - (rcirc-buffer-process) - rcirc-target)) - (read-from-minibuffer "Kick reason: ")))) - (let ((args (split-string arg))) - (rcirc-send-string process "KICK" target (car args) : (cdr args)))) + (completing-read "Kick nick: " + (rcirc-channel-nicks + (rcirc-buffer-process) + rcirc-target)) + (read-from-minibuffer "Kick reason: "))) + (rcirc-send-string process "KICK" target nick : reason)) (defun rcirc-cmd-ctcp (args &optional process _target) "Handle ARGS as a CTCP command. @@ -2451,7 +2455,7 @@ PROCESS is the process object for the current connection." set) -(defun-rcirc-command ignore (nick) +(rcirc-define-command ignore (nick) "Manage the ignore list. Ignore NICK, unignore NICK if already ignored, or list ignored nicks when no NICK is given. When listing ignored nicks, the @@ -2468,7 +2472,7 @@ ones added to the list automatically are marked with an asterisk." "*" ""))) rcirc-ignore-list " "))) -(defun-rcirc-command bright (nick) +(rcirc-define-command bright (nick) "Manage the bright nick list." (interactive "sToggle emphasis of nick: ") (setq rcirc-bright-nicks @@ -2477,7 +2481,7 @@ ones added to the list automatically are marked with an asterisk." (rcirc-print process nil "BRIGHT" target (mapconcat 'identity rcirc-bright-nicks " "))) -(defun-rcirc-command dim (nick) +(rcirc-define-command dim (nick) "Manage the dim nick list." (interactive "sToggle deemphasis of nick: ") (setq rcirc-dim-nicks @@ -2486,7 +2490,7 @@ ones added to the list automatically are marked with an asterisk." (rcirc-print process nil "DIM" target (mapconcat 'identity rcirc-dim-nicks " "))) -(defun-rcirc-command keyword (keyword) +(rcirc-define-command keyword (keyword) "Manage the keyword list. Mark KEYWORD, unmark KEYWORD if already marked, or list marked keywords when no KEYWORD is given." From 06af44e3e180aa6ecbfc51d9e977757a6fabbc23 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Wed, 9 Jun 2021 17:37:24 +0200 Subject: [PATCH 08/38] Create framework for IRCv3 support * rcirc.el (rcirc-implemented-capabilities): Add new variable (rcirc-requested-capabilities): Add new variable (rcirc-acked-capabilities): Add new variable (rcirc-connect): Request capabilities from rcirc-implemented-capabilities (rcirc-process-regexp): Extend rcirc-process-regexp with tag support (rcirc-tag-regexp): Add new tokenizer for tags (rcirc-message-tags): Add new variable (rcirc-get-tag): Add new function (rcirc-process-server-response-1): Parse message-tags (rcirc-handler-CAP): Add new handler for capability requests --- lisp/net/rcirc.el | 106 ++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 94 insertions(+), 12 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 1b3601771bb..f86b2b9ac91 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -45,6 +45,7 @@ (require 'ring) (require 'time-date) (require 'auth-source) +(require 'parse-time) (eval-when-compile (require 'subr-x)) (eval-when-compile (require 'rx)) @@ -573,6 +574,16 @@ See `rcirc-connect' for more details on these variables.") (defvar rcirc-process nil "Network process for the current connection.") +;;; IRCv3 capability negotiation (https://ircv3.net/specs/extensions/capability-negotiation) +(defvar rcirc-implemented-capabilities + '("message-tags" ;https://ircv3.net/specs/extensions/message-tags + ) + "A list of capabilities that rcirc supports.") +(defvar-local rcirc-requested-capabilities nil + "A list of capabilities that client has requested.") +(defvar-local rcirc-acked-capabilities nil + "A list of capabilities that the server supports.") + ;;;###autoload (defun rcirc-connect (server &optional port nick user-name full-name startup-channels password encryption @@ -628,6 +639,9 @@ that are joined after authentication." (add-hook 'auto-save-hook 'rcirc-log-write) ;; identify + (dolist (cap rcirc-implemented-capabilities) + (rcirc-send-string process "CAP" "REQ" : cap) + (push cap rcirc-requested-capabilities)) (unless (zerop (length password)) (rcirc-send-string process "PASS" password)) (rcirc-send-string process "NICK" nick) @@ -820,24 +834,74 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (rcirc-process-server-response-1 process text))) (defconst rcirc-process-regexp - ;; See https://tools.ietf.org/html/rfc2812#section-2.3.1. We're a - ;; bit more accepting than the RFC: We allow any non-space - ;; characters in the command name, multiple spaces between - ;; arguments, and allow the last argument to omit the leading ":", - ;; even if there are less than 15 arguments. - (rx line-start - (optional - (group ":" (group (one-or-more (not (any " ")))) " ")) - (group (one-or-more (not (any " "))))) + (rx-let ((message-tag ; message tags as specified in + ; https://ircv3.net/specs/extensions/message-tags + (: (? "+") + (? (+ (or alnum "-")) (+ "." (+ (or alnum "-"))) "/") + (+ (any alnum "-")) + (? "=" + (* (not (any 0 ?\n ?\r ?\; ?\s))))))) + (rx line-start + (optional "@" (group message-tag (* ";" message-tag)) (+ space)) + ;; See https://tools.ietf.org/html/rfc2812#section-2.3.1. + ;; We're a bit more accepting than the RFC: We allow any non-space + ;; characters in the command name, multiple spaces between + ;; arguments, and allow the last argument to omit the leading ":", + ;; even if there are less than 15 arguments. + (optional + (group ":" (group (one-or-more (not (any " ")))) " ")) + (group (one-or-more (not (any " ")))))) "Regular expression used for parsing server response.") +(defconst rcirc-tag-regexp + (rx bos + (group + (? "+") + (? (+ (or alnum "-")) (+ "." (+ (or alnum "-"))) "/") + (+ (any alnum "-"))) + (? "=" (group (* (not (any 0 ?\n ?\r ?\; ?\s))))) + eos) + "Regular expression used for destructing a tag.") + +(defvar rcirc-message-tags nil + "Alist of parsed message tags.") + +(defsubst rcirc-get-tag (key &optional default) + "Return tag value for KEY or DEFAULT." + (alist-get key rcirc-message-tags default nil #'string=)) + (defun rcirc-process-server-response-1 (process text) "Parse TEXT as received from PROCESS." (if (string-match rcirc-process-regexp text) - (let* ((user (match-string 2 text)) + (let* ((rcirc-message-tags + (append + (and-let* ((tag-data (match-string 1 text))) + (save-match-data + (mapcar + (lambda (tag) + (unless (string-match rcirc-tag-regexp tag) + ;; This should not happen, unless there is + ;; a mismatch between this regular + ;; expression and `rcirc-process-regexp'. + (error "Malformed tag %S" tag)) + (cons (match-string 1 tag) + (replace-regexp-in-string + (rx (* ?\\ ?\\) ?\\ (any ?: ?s ?\\ ?r ?n)) + (lambda (rep) + (concat (substring rep 0 -2) + (cl-case (aref rep (1- (length rep))) + (?: ";") + (?s " ") + (?\\ "\\\\") + (?r "\r") + (?n "\n")))) + (match-string 2 tag)))) + (split-string tag-data ";")))) + rcirc-message-tags)) + (user (match-string 3 text)) (sender (rcirc-user-nick user)) - (cmd (match-string 3 text)) - (cmd-end (match-end 3)) + (cmd (match-string 4 text)) + (cmd-end (match-end 4)) (args nil) (handler (intern-soft (concat "rcirc-handler-" cmd)))) (cl-loop with i = cmd-end @@ -3195,6 +3259,24 @@ PROCESS is the process object for the current connection." PROCESS is the process object for the current connection." (rcirc-print process sender "CTCP" nil message t)) +(defun rcirc-handler-CAP (process _sender args _text) + "Handle capability negotiation messages. +ARGS should have the form (USER SUBCOMMAND . ARGUMENTS). PROCESS +is the process object for the current connection." + (with-rcirc-process-buffer process + (let ((subcmd (cadr args))) + (dolist (cap (cddr args)) + (cond ((string= subcmd "ACK") + (push cap rcirc-acked-capabilities) + (setq rcirc-requested-capabilities + (delete cap rcirc-requested-capabilities))) + ((string= subcmd "NAK") + (setq rcirc-requested-capabilities + (delete cap rcirc-requested-capabilities)))))) + (when (null rcirc-requested-capabilities) + ;; All requested capabilities have been responded to + (rcirc-send-string process "CAP" "END")))) + (defgroup rcirc-faces nil "Faces for rcirc." From 849e71fd83fa8796198035464897bf2f28f6226c Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Wed, 9 Jun 2021 17:55:55 +0200 Subject: [PATCH 09/38] Implement server-time extension * rcirc.el (rcirc-implemented-capabilities): Add new capability (rcirc-print): Insert messages in the right position (rcirc-log): Use right time value (rcirc-markup-timestamp): Use right time value --- lisp/net/rcirc.el | 101 +++++++++++++++++++++++++++------------------- 1 file changed, 59 insertions(+), 42 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index f86b2b9ac91..68cc7a08a65 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -577,6 +577,7 @@ See `rcirc-connect' for more details on these variables.") ;;; IRCv3 capability negotiation (https://ircv3.net/specs/extensions/capability-negotiation) (defvar rcirc-implemented-capabilities '("message-tags" ;https://ircv3.net/specs/extensions/message-tags + "server-time" ;https://ircv3.net/specs/extensions/server-time ) "A list of capabilities that rcirc supports.") (defvar-local rcirc-requested-capabilities nil @@ -1702,11 +1703,13 @@ connection." ;; do not ignore if we sent the message (not (string= sender (rcirc-nick process)))) (let* ((buffer (rcirc-target-buffer process sender response target text)) + (time (if-let ((time (rcirc-get-tag "time"))) + (parse-iso8601-time-string time) + (current-time))) (inhibit-read-only t)) (with-current-buffer buffer (let ((moving (= (point) rcirc-prompt-end-marker)) - (old-point (point-marker)) - (fill-start (marker-position rcirc-prompt-start-marker))) + (old-point (point-marker))) (setq text (decode-coding-string text rcirc-decode-coding-system)) (unless (string= sender (rcirc-nick process)) @@ -1720,25 +1723,31 @@ connection." ;; temporarily set the marker insertion-type because ;; insert-before-markers results in hidden text in new buffers (goto-char rcirc-prompt-start-marker) + (catch 'exit + (while (not (bobp)) + (goto-char (or (previous-single-property-change (point) 'hard) + (point-min))) + (when (let ((then (get-text-property (point) 'rcirc-time))) + (and then (time-less-p then time))) + (next-single-property-change (point) 'hard) + (forward-char 1) + (throw 'exit nil)))) (set-marker-insertion-type rcirc-prompt-start-marker t) (set-marker-insertion-type rcirc-prompt-end-marker t) - (let ((start (point))) - (insert (rcirc-format-response-string process sender response nil - text) - (propertize "\n" 'hard t)) + ;; run markup functions + (cl-assert (bolp)) + (save-excursion + (save-restriction + (narrow-to-region (point) (point)) + (insert (rcirc-format-response-string process sender response + nil text) + (propertize "\n" 'hard t)) - ;; squeeze spaces out of text before rcirc-text - (fill-region fill-start - (1- (or (next-single-property-change fill-start - 'rcirc-text) - rcirc-prompt-end-marker))) + ;; squeeze spaces out of text before rcirc-text + (fill-region (point-min) (point-max)) - ;; run markup functions - (save-excursion - (save-restriction - (narrow-to-region start rcirc-prompt-start-marker) - (goto-char (or (next-single-property-change start 'rcirc-text) + (goto-char (or (next-single-property-change (point-min) 'rcirc-text) (point))) (when (rcirc-buffer-process) (save-excursion (rcirc-markup-timestamp sender response)) @@ -1749,14 +1758,18 @@ connection." (when rcirc-read-only-flag (add-text-properties (point-min) (point-max) - '(read-only t front-sticky t)))) - ;; make text omittable + '(read-only t front-sticky t))) + + (add-text-properties (point-min) (point-max) + (list 'rcirc-time time)) + + ;; make text omittable (let ((last-activity-lines (rcirc-elapsed-lines process sender target))) (if (and (not (string= (rcirc-nick process) sender)) (member response rcirc-omit-responses) (or (not last-activity-lines) (< rcirc-omit-threshold last-activity-lines))) - (put-text-property (1- start) (1- rcirc-prompt-start-marker) + (put-text-property (point-min) (point-max) 'invisible 'rcirc-omit) ;; otherwise increment the line count (setq rcirc-current-line (1+ rcirc-current-line)))))) @@ -1778,11 +1791,11 @@ connection." (window-buffer w)) (>= (window-point w) rcirc-prompt-end-marker)) - (set-window-point w (point-max)))) + (set-window-point w (point-max)))) nil t) ;; restore the point - (goto-char (if moving rcirc-prompt-end-marker old-point)) + (goto-char (if moving rcirc-prompt-end-marker old-point))) ;; keep window on bottom line if it was already there (when rcirc-scroll-show-maximum-output @@ -1799,26 +1812,26 @@ connection." ;; flush undo (can we do something smarter here?) (buffer-disable-undo) - (buffer-enable-undo)) + (buffer-enable-undo) - ;; record mode line activity - (when (and activity - (not rcirc-ignore-buffer-activity-flag) - (not (and rcirc-dim-nicks sender - (string-match (regexp-opt rcirc-dim-nicks) sender) - (rcirc-channel-p target)))) - (rcirc-record-activity (current-buffer) - (when (not (rcirc-channel-p rcirc-target)) - 'nick))) + ;; record mode line activity + (when (and activity + (not rcirc-ignore-buffer-activity-flag) + (not (and rcirc-dim-nicks sender + (string-match (regexp-opt rcirc-dim-nicks) sender) + (rcirc-channel-p target)))) + (rcirc-record-activity (current-buffer) + (when (not (rcirc-channel-p rcirc-target)) + 'nick))) - (when (and rcirc-log-flag - (or target - rcirc-log-process-buffers)) - (rcirc-log process sender response target text)) + (when (and rcirc-log-flag + (or target + rcirc-log-process-buffers)) + (rcirc-log process sender response target text)) - (sit-for 0) ; displayed text before hook - (run-hook-with-args 'rcirc-print-functions - process sender response target text))))) + (sit-for 0) ; displayed text before hook + (run-hook-with-args 'rcirc-print-functions + process sender response target text))))) (defun rcirc-generate-log-filename (process target) "Return filename for log file based on PROCESS and TARGET." @@ -1846,10 +1859,12 @@ guarantee valid filenames for the current OS." "Record TEXT from SENDER to TARGET to be logged. The message is logged in `rcirc-log', and is later written to disk. PROCESS is the process object for the current connection." - (let ((filename (funcall rcirc-log-filename-function process target))) + (let ((filename (funcall rcirc-log-filename-function process target)) + (time (and-let* ((time (rcirc-get-tag "time"))) + (parse-iso8601-time-string time)))) (unless (null filename) (let ((cell (assoc-string filename rcirc-log-alist)) - (line (concat (format-time-string rcirc-time-format) + (line (concat (format-time-string rcirc-time-format time) (substring-no-properties (rcirc-format-response-string process sender response target text)) @@ -2631,8 +2646,10 @@ If ARG is given, opens the URL in a new browser window." (defun rcirc-markup-timestamp (_sender _response) "Insert a timestamp." (goto-char (point-min)) - (insert (rcirc-facify (format-time-string rcirc-time-format) - 'rcirc-timestamp))) + (let ((time (and-let* ((time (rcirc-get-tag "time"))) + (parse-iso8601-time-string time)))) + (insert (rcirc-facify (format-time-string rcirc-time-format time) + 'rcirc-timestamp)))) (defun rcirc-markup-attributes (_sender _response) "Highlight IRC markup, indicated by ASCII control codes." From ab49a9a6342eb6a4a1c0032a5848dd8538c6ccea Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Wed, 9 Jun 2021 17:57:21 +0200 Subject: [PATCH 10/38] Implement batch extension * rcirc.el (rcirc-implemented-capabilities): Add batch extension (rcirc-supported-batch-types): Add new variable (rcirc-batch-attributes): Add new variable (rcirc-batched-messages): Add new variable (rcirc-process-server-response-1): Handle messages with batch tag (rcirc-handler-BATCH): Add batch dispatcher --- lisp/net/rcirc.el | 76 +++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 73 insertions(+), 3 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 68cc7a08a65..918b716bc78 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -578,6 +578,7 @@ See `rcirc-connect' for more details on these variables.") (defvar rcirc-implemented-capabilities '("message-tags" ;https://ircv3.net/specs/extensions/message-tags "server-time" ;https://ircv3.net/specs/extensions/server-time + "batch" ;https://ircv3.net/specs/extensions/batch ) "A list of capabilities that rcirc supports.") (defvar-local rcirc-requested-capabilities nil @@ -867,6 +868,22 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (defvar rcirc-message-tags nil "Alist of parsed message tags.") +(defvar rcirc-supported-batch-types + '() + "List of recognized batch types. +Each element has the form (TYPE HANDLE), where TYPE is a string +and HANDLE is either the symbol `immediate' or `deferred'. +Messages in an immediate batch are handled just like regular +messages, while deferred messages are stored in +`rcirc-batch-messages'.") + +(defvar-local rcirc-batch-attributes nil + "Alist mapping batch IDs to parameters.") + +(defvar-local rcirc-batched-messages nil + "Alist mapping batch IDs to deferred messages. +Note that the messages are stored in reverse order.") + (defsubst rcirc-get-tag (key &optional default) "Return tag value for KEY or DEFAULT." (alist-get key rcirc-message-tags default nil #'string=)) @@ -915,9 +932,18 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (push (substring text (match-end 0)) args) (cl-assert (= i (length text)))) (cl-callf nreverse args))) - (if (not (fboundp handler)) - (rcirc-handler-generic process cmd sender args text) - (funcall handler process sender args text)) + (cond ((and-let* ((batch-id (rcirc-get-tag "batch")) + (type (cadr (assoc batch-id rcirc-batch-attributes))) + (attr (assoc type rcirc-supported-batch-types)) + ((eq (cadr attr) 'deferred))) + ;; handle deferred batch messages later + (push (list cmd process sender args text rcirc-message-tags) + (alist-get batch-id rcirc-batched-messages + nil nil #'string=)) + t)) + ((not (fboundp handler)) + (rcirc-handler-generic process cmd sender args text)) + ((funcall handler process sender args text))) (run-hook-with-args 'rcirc-receive-message-functions process cmd sender args text)) (message "UNHANDLED: %s" text))) @@ -3294,6 +3320,50 @@ is the process object for the current connection." ;; All requested capabilities have been responded to (rcirc-send-string process "CAP" "END")))) +(defun rcirc-handler-BATCH (process _sender args _text) + "Open or close a batch. +ARGS should have the form (tag type . parameters) when starting a +batch, or (tag) when closing a batch. PROCESS is the process +object for the current connection." + (with-rcirc-process-buffer process + (let ((type (cadr args)) + (id (substring (car args) 1))) + (cond + ((= (aref (car args) 0) ?+) ;start a new batch + (when (assoc id rcirc-batch-attributes) + (error "Starting batch with already used ID")) + (setf (alist-get id rcirc-batch-attributes nil nil #'string=) + (cons type (cddr args)))) + ((= (aref (car args) 0) ?-) ;close a batch + (unless (assoc id rcirc-batch-attributes) + (error "Closing a unknown batch")) + (let ((type (car (alist-get id rcirc-batch-attributes + nil nil #'string=)))) + (when (eq (car (alist-get type rcirc-supported-batch-types + nil nil #'string=)) + 'deferred) + (let ((messages (alist-get id rcirc-batched-messages + nil nil #'string=)) + (bhandler (intern-soft (concat "rcirc-batch-handler-" type)))) + (if (fboundp bhandler) + (funcall bhandler process id (nreverse messages)) + (dolist (message (nreverse messages)) + (let ((cmd (nth 0 message)) + (process (nth 1 message)) + (sender (nth 2 message)) + (args (nth 3 message)) + (text (nth 4 message)) + (rcirc-message-tags (nth 5 message))) + (if-let (handler (intern-soft (concat "rcirc-handler-" cmd))) + (funcall handler process sender args text) + (rcirc-handler-generic process cmd sender args text)))))))) + (setq rcirc-batch-attributes + (delq (assoc id rcirc-batch-attributes) + rcirc-batch-attributes) + rcirc-batched-messages + (delq (assoc id rcirc-batched-messages) + rcirc-batched-messages))))))) + (defgroup rcirc-faces nil "Faces for rcirc." From 567e288eb9e89c768ff7ed6de256319007432ef7 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Wed, 9 Jun 2021 17:58:52 +0200 Subject: [PATCH 11/38] Implement message-ids extension * rcirc.el (rcirc-implemented-capabilities): Add to list of implemented extensions (rcirc-print): Insert property denoting message ID --- lisp/net/rcirc.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 918b716bc78..12e1fc3b2e4 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -579,6 +579,7 @@ See `rcirc-connect' for more details on these variables.") '("message-tags" ;https://ircv3.net/specs/extensions/message-tags "server-time" ;https://ircv3.net/specs/extensions/server-time "batch" ;https://ircv3.net/specs/extensions/batch + "message-ids" ;https://ircv3.net/specs/extensions/message-ids ) "A list of capabilities that rcirc supports.") (defvar-local rcirc-requested-capabilities nil @@ -1766,9 +1767,10 @@ connection." (save-excursion (save-restriction (narrow-to-region (point) (point)) - (insert (rcirc-format-response-string process sender response - nil text) - (propertize "\n" 'hard t)) + (insert (propertize (rcirc-format-response-string process sender response + nil text) + 'rcirc-msgid (rcirc-get-tag "msgid")) + (propertize "\n" 'hard t)) ;; squeeze spaces out of text before rcirc-text (fill-region (point-min) (point-max)) From c300326fa01cb9532e0399047a1ebdede5e2f65d Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Wed, 9 Jun 2021 18:44:55 +0200 Subject: [PATCH 12/38] Add TAGMSG handler * rcirc.el (rcirc-handler-TAGMSG): Add new message handler --- lisp/net/rcirc.el | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 12e1fc3b2e4..60cafd4dada 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -3322,6 +3322,14 @@ is the process object for the current connection." ;; All requested capabilities have been responded to (rcirc-send-string process "CAP" "END")))) +(defun rcirc-handler-TAGMSG (process sender _args _text) + "Handle a empty tag message from SENDER. +PROCESS is the process object for the current connection." + (dolist (tag rcirc-message-tags) + (when-let ((handler (intern-soft (concat "rcirc-tag-handler-" (car tag)))) + ((fboundp handler))) + (funcall handler process sender (cdr tag))))) + (defun rcirc-handler-BATCH (process _sender args _text) "Open or close a batch. ARGS should have the form (tag type . parameters) when starting a From f6e18c63a63fdac0d6abc6a6f68d670ab2923269 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Wed, 9 Jun 2021 20:27:10 +0200 Subject: [PATCH 13/38] Implement invite-notify capability * rcirc.el (rcirc-implemented-capabilities): Add invite-notify (rcirc-handler-INVITE): Handle invite notifications --- lisp/net/rcirc.el | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 60cafd4dada..b3b70a6816b 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -580,6 +580,7 @@ See `rcirc-connect' for more details on these variables.") "server-time" ;https://ircv3.net/specs/extensions/server-time "batch" ;https://ircv3.net/specs/extensions/batch "message-ids" ;https://ircv3.net/specs/extensions/message-ids + "invite-notify" ;https://ircv3.net/specs/extensions/invite-notify ) "A list of capabilities that rcirc supports.") (defvar-local rcirc-requested-capabilities nil @@ -3247,11 +3248,21 @@ Passwords are stored in `rcirc-authinfo' (which see)." (format "AUTH %s %s" nick (car args)))))))))) (defun rcirc-handler-INVITE (process sender args _text) - "Notify user of an invitation. -SENDER and ARGS (in concatenated form) are passed on to -`rcirc-print'. PROCESS is the process object for the current -connection." - (rcirc-print process sender "INVITE" nil (mapconcat 'identity args " ") t)) + "Notify user of an invitation from SENDER. +ARGS should have the form (TARGET CHANNEL). PROCESS is the +process object for the current connection." + (let ((self (buffer-local-value 'rcirc-nick rcirc-process)) + (target (car args)) + (chan (cadr args))) + (if (string= target self) + (rcirc-print process sender "INVITE" nil + (format "%s invited you to %s" + sender chan) + t) + (rcirc-print process sender "INVITE" chan + (format "%s invited %s" + sender target) + t)))) (defun rcirc-handler-ERROR (process sender args _text) "Print a error message. From 95fdd4b99bccc11f373c3b9d6cacee8269728344 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Thu, 10 Jun 2021 00:22:36 +0200 Subject: [PATCH 14/38] Allow filtering how nicks are presented * rcirc.el (rcirc-nick-filter): Add new option (rcirc-completion-at-point): Use rcirc-nick-filter (rcirc-format-response-string): Use rcirc-nick-filter (rcirc-sort-nicknames-join): Use rcirc-nick-filter --- lisp/net/rcirc.el | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index b3b70a6816b..ad5a4d64178 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -391,6 +391,11 @@ will be killed." :version "24.3" :type 'boolean) +(defcustom rcirc-nick-filter #'identity + "Function applied to nicknames before displaying." + :version "28.1" + :type 'function) + (defvar rcirc-nick nil "The nickname used for the current connection.") @@ -1118,11 +1123,13 @@ The list is updated automatically by `defun-rcirc-command'.") rcirc-prompt-end-marker))) (table (cond ;; No completion before the prompt - ((< beg rcirc-prompt-end-marker) nil) + ((< beg rcirc-prompt-end-marker) nil) ;; Only complete nicks mid-message ((> beg rcirc-prompt-end-marker) - (rcirc-channel-nicks (rcirc-buffer-process) - rcirc-target)) + (mapcar rcirc-nick-filter + (rcirc-channel-nicks + (rcirc-buffer-process) + rcirc-target))) ;; Complete commands at the beginning of the ;; message, when the first character is a dash ((eq (char-after beg) ?/) @@ -1135,7 +1142,7 @@ The list is updated automatically by `defun-rcirc-command'.") ;; Complete usernames right after the prompt by ;; appending a colon after the name ((mapcar - (lambda (str) (concat str ": ")) + (lambda (str) (concat (funcall rcirc-nick-filter str) ": ")) (rcirc-channel-nicks (rcirc-buffer-process) rcirc-target)))))) (list beg (point) table)))) @@ -1601,7 +1608,7 @@ communication." (sender (if (or (not sender) (string= (rcirc-server-name process) sender)) "" - sender)) + (funcall rcirc-nick-filter sender))) face) (while (re-search-forward "%\\(\\(f\\(.\\)\\)\\|\\(.\\)\\)" nil t) (rcirc-add-face start (match-beginning 0) face) @@ -2044,7 +2051,7 @@ INPUT is a string containing nicknames separated by SEP. This function does not alter the INPUT string." (let* ((parts (split-string input sep t)) (sorted (sort parts 'rcirc-nickname<))) - (mapconcat 'identity sorted sep))) + (mapconcat rcirc-nick-filter sorted sep))) ;;; activity tracking (defvar rcirc-track-minor-mode-map From b67b1eea256e05cc65039f207d0f16a16e2dac4e Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Thu, 10 Jun 2021 11:40:19 +0200 Subject: [PATCH 15/38] Fix prompt doubling when reconnecting * rcirc.el (rcirc-connect): Check if rcirc-mode is already active (rcirc-get-buffer-create): Check if rcirc-mode is already active --- lisp/net/rcirc.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index ad5a4d64178..edd5b87e7d1 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -621,7 +621,8 @@ that are joined after authentication." (set-process-coding-system process 'raw-text 'raw-text) (switch-to-buffer (rcirc-generate-new-buffer-name process nil)) (set-process-buffer process (current-buffer)) - (rcirc-mode process nil) + (unless (eq major-mode 'rcirc-mode) + (rcirc-mode process nil)) (set-process-sentinel process 'rcirc-sentinel) (set-process-filter process 'rcirc-filter) @@ -662,6 +663,7 @@ that are joined after authentication." (run-at-time 0 (/ rcirc-timeout-seconds 2) 'rcirc-keepalive))) (message "Connecting to %s...done" (or server-alias server)) + (setq mode-line-process nil) ;; return process object process))) @@ -1412,9 +1414,11 @@ Create the buffer if it doesn't exist." (let ((new-buffer (get-buffer-create (rcirc-generate-new-buffer-name process target)))) (with-current-buffer new-buffer - (rcirc-mode process target) + (unless (eq major-mode 'rcirc-mode) + (rcirc-mode process target))) + (setq mode-line-process nil) (rcirc-put-nick-channel process (rcirc-nick process) target - rcirc-current-line)) + rcirc-current-line) new-buffer))))) (defun rcirc-send-input () From 13f6f78473436ee5e0127f5ae993710cd7cddd4b Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Thu, 10 Jun 2021 11:42:09 +0200 Subject: [PATCH 16/38] Allow for optional arguments using rcirc-define-command * rcirc.el (rcirc-define-command): Handle &optional arguments --- lisp/net/rcirc.el | 77 +++++++++++++++++++++++------------------------ 1 file changed, 37 insertions(+), 40 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index edd5b87e7d1..c1f5643ec43 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2363,25 +2363,33 @@ prefix with another element in PAIRS." (defmacro rcirc-define-command (command arguments &rest body) "Define a new client COMMAND in BODY that takes ARGUMENTS. -Just like `defun', a string at the beginning of BODY is -interpreted as the documentation string. Following that, an -interactive form can specified." +ARGUMENTS may designate optional arguments using a single +`&optional' symbol. Just like `defun', a string at the beginning +of BODY is interpreted as the documentation string. Following +that, an interactive form can specified." (declare (debug (symbolp (&rest symbolp) def-body)) (indent defun)) (cl-check-type command symbol) (cl-check-type arguments list) - (let ((fn-name (intern (concat "rcirc-cmd-" (symbol-name command))) ) - (regexp (with-temp-buffer - (insert "\\`") - (when arguments - (dotimes (_ (1- (length arguments))) - (insert "\\(.+?\\)[[:space:]]*")) - (insert "\\(.*\\)")) - (insert "[[:space:]]*\\'") - (buffer-string))) - (argument (gensym)) - documentation - interactive-spec) + (let* ((fn-name (intern (concat "rcirc-cmd-" (symbol-name command)))) + (total (length (remq '&optional arguments))) + (required (- (length arguments) (length (memq '&optional arguments)))) + (optional (- total required)) + (regexp (with-temp-buffer + (insert "\\`") + (when arguments + (dotimes (_ (1- (length arguments))) + (insert "\\(?:\\(.+?\\)[[:space:]]*")) + (insert "\\(.*\\)") + (dotimes (i (1- (length arguments))) + (when (< i optional) + (insert "?")) + (insert "\\)"))) + (insert "[[:space:]]*\\'") + (buffer-string))) + (argument (gensym)) + documentation + interactive-spec) (when (stringp (car body)) (setq documentation (pop body))) (when (eq (car-safe (car-safe body)) 'interactive) @@ -2393,17 +2401,17 @@ interactive form can specified." "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") (interactive ,@interactive-spec) (unless (if (listp ,argument) - (= (length ,argument) ,(length arguments)) + (not (<= ,required (length ,argument) ,total)) (string-match ,regexp ,argument)) (user-error "Malformed input: %S" ',arguments)) (let ((process (or process (rcirc-buffer-process))) (target (or target rcirc-target))) (ignore target process) (let (,@(cl-loop - for i from 0 for arg in arguments + for i from 0 for arg in (delq '&optional arguments) collect `(,arg (if (listp ,argument) - (nth ,i ,argument) - (match-string ,(1+ i) ,argument))))) + (nth ,i ,argument) + (match-string ,(1+ i) ,argument))))) ,@body))) (add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name command)))))) @@ -2442,30 +2450,22 @@ CHANNELS is a comma- or space-separated string of channel names." (read-string "Channel: "))) (rcirc-send-string process "INVITE" nick channel)) -(rcirc-define-command part (channel) +(rcirc-define-command part (&optional channel reason) "Part CHANNEL. CHANNEL should be a string of the form \"#CHANNEL-NAME REASON\". If omitted, CHANNEL-NAME defaults to TARGET, and REASON defaults to `rcirc-default-part-reason'." - (interactive "sPart channel: ") - (let ((channel (if (> (length channel) 0) channel target)) - (msg rcirc-default-part-reason)) - (when (string-match "\\`\\([&#+!]\\S-+\\)?\\s-*\\(.+\\)?\\'" channel) - (when (match-beginning 2) - (setq msg (match-string 2 channel))) - (setq channel (if (match-beginning 1) - (match-string 1 channel) - target))) - (rcirc-send-string process "PART" channel : msg))) + (interactive "sPart channel: \nsReason: ") + (rcirc-send-string process "PART" (or channel target) + : (or reason rcirc-default-part-reason))) -(rcirc-define-command quit (reason) +(rcirc-define-command quit (&optional reason) "Send a quit message to server with REASON." (interactive "sQuit reason: ") - (rcirc-send-string process "QUIT" : (if (not (zerop (length reason))) - reason - rcirc-default-quit-reason))) + (rcirc-send-string process "QUIT" + : (or reason rcirc-default-quit-reason))) -(rcirc-define-command reconnect (_) +(rcirc-define-command reconnect () "Reconnect to current server." (interactive "i") (with-rcirc-server-buffer @@ -2483,15 +2483,12 @@ to `rcirc-default-part-reason'." (interactive (list (read-string "New nick: "))) (rcirc-send-string process "NICK" nick)) -(rcirc-define-command names (channel) +(rcirc-define-command names (&optional channel) "Display list of names in CHANNEL or in current channel if CHANNEL is nil. If called interactively, prompt for a channel when prefix arg is supplied." (interactive (list (and current-prefix-arg (read-string "List names in channel: ")))) - (let ((channel (if (> (length channel) 0) - channel - target))) - (rcirc-send-string process "NAMES" channel))) + (rcirc-send-string process "NAMES" (or channel target))) (rcirc-define-command topic (topic) "List TOPIC for the TARGET channel. From 3a61e7bca16fff559978ad9e2a4243250fde1835 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Thu, 10 Jun 2021 17:15:17 +0200 Subject: [PATCH 17/38] Use defvar-local instead of setq-local where applicable --- lisp/net/rcirc.el | 105 +++++++++++++++++++++------------------------- 1 file changed, 47 insertions(+), 58 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index c1f5643ec43..4144a28278b 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -194,7 +194,7 @@ If nil, no maximum is applied." "Responses which will be hidden when `rcirc-omit-mode' is enabled." :type '(repeat string)) -(defvar rcirc-prompt-start-marker nil +(defvar-local rcirc-prompt-start-marker nil "Marker indicating the beginning of the message prompt.") (define-minor-mode rcirc-omit-mode @@ -396,16 +396,16 @@ will be killed." :version "28.1" :type 'function) -(defvar rcirc-nick nil +(defvar-local rcirc-nick nil "The nickname used for the current connection.") -(defvar rcirc-prompt-end-marker nil +(defvar-local rcirc-prompt-end-marker nil "Marker indicating the end of the message prompt.") -(defvar rcirc-nick-table nil +(defvar-local rcirc-nick-table nil "Hash table mapping nicks to channels.") -(defvar rcirc-recent-quit-alist nil +(defvar-local rcirc-recent-quit-alist nil "Alist of nicks that have recently quit or parted the channel.") (defvar rcirc-nick-syntax-table @@ -416,7 +416,7 @@ will be killed." table) "Syntax table which includes all nick characters as word constituents.") -(defvar rcirc-buffer-alist nil +(defvar-local rcirc-buffer-alist nil "Alist of (TARGET . BUFFER) pairs.") (defvar rcirc-activity nil @@ -426,16 +426,16 @@ will be killed." "String displayed in mode line representing `rcirc-activity'.") (put 'rcirc-activity-string 'risky-local-variable t) -(defvar rcirc-server-buffer nil +(defvar-local rcirc-server-buffer nil "The server buffer associated with this channel buffer.") -(defvar rcirc-server-parameters nil +(defvar-local rcirc-server-parameters nil "List of parameters received from the server.") -(defvar rcirc-target nil +(defvar-local rcirc-target nil "The channel or user associated with this buffer.") -(defvar rcirc-urls nil +(defvar-local rcirc-urls nil "List of URLs seen in the current buffer and their start positions.") (put 'rcirc-urls 'permanent-local t) @@ -443,7 +443,7 @@ will be killed." "Kill connection after this many seconds if there is no activity.") -(defvar rcirc-startup-channels nil +(defvar-local rcirc-startup-channels nil "List of channel names to join after authenticating.") (defvar rcirc-server-name-history nil @@ -551,32 +551,32 @@ If ARG is non-nil, instead prompt for connection parameters." (defalias 'irc 'rcirc) -(defvar rcirc-process-output nil +(defvar-local rcirc-process-output nil "Partial message response.") -(defvar rcirc-topic nil +(defvar-local rcirc-topic nil "Topic of the current channel.") (defvar rcirc-keepalive-timer nil "Timer for sending KEEPALIVE message.") -(defvar rcirc-last-server-message-time nil +(defvar-local rcirc-last-server-message-time nil "Timestamp for the last server response.") -(defvar rcirc-server nil +(defvar-local rcirc-server nil "Server provided by server.") -(defvar rcirc-server-name nil +(defvar-local rcirc-server-name nil "Server name given by 001 response.") -(defvar rcirc-timeout-timer nil +(defvar-local rcirc-timeout-timer nil "Timer for determining a network timeout.") -(defvar rcirc-user-authenticated nil +(defvar-local rcirc-user-authenticated nil "Flag indicating if the user is authenticated.") -(defvar rcirc-user-disconnect nil +(defvar-local rcirc-user-disconnect nil "Flag indicating if the connection was broken.") -(defvar rcirc-connecting nil +(defvar-local rcirc-connecting nil "Flag indicating if the connection is being established.") -(defvar rcirc-connection-info nil +(defvar-local rcirc-connection-info nil "Information about the current connection. If defined, it is a list of this form (SERVER PORT NICK USER-NAME FULL-NAME STARTUP-CHANNELS PASSWORD ENCRYPTION SERVER-ALIAS). See `rcirc-connect' for more details on these variables.") -(defvar rcirc-process nil +(defvar-local rcirc-process nil "Network process for the current connection.") ;;; IRCv3 capability negotiation (https://ircv3.net/specs/extensions/capability-negotiation) @@ -626,25 +626,18 @@ that are joined after authentication." (set-process-sentinel process 'rcirc-sentinel) (set-process-filter process 'rcirc-filter) - (setq-local rcirc-connection-info - (list server port nick user-name full-name startup-channels - password encryption server-alias)) - (setq-local rcirc-process process) - (setq-local rcirc-server server) - (setq-local rcirc-server-name - (or server-alias server)) ; Update when we get 001 response. - (setq-local rcirc-buffer-alist nil) - (setq-local rcirc-nick-table (make-hash-table :test 'equal)) - (setq-local rcirc-nick nick) - (setq-local rcirc-process-output nil) - (setq-local rcirc-startup-channels startup-channels) - (setq-local rcirc-last-server-message-time (current-time)) + (setq rcirc-connection-info + (list server port nick user-name full-name startup-channels + password encryption server-alias)) + (setq rcirc-process process) + (setq rcirc-server server) + (setq rcirc-server-name (or server-alias server)) ; Update when we get 001 response. + (setq rcirc-nick-table (make-hash-table :test 'equal)) + (setq rcirc-nick nick) + (setq rcirc-startup-channels startup-channels) + (setq rcirc-last-server-message-time (current-time)) - (setq-local rcirc-timeout-timer nil) - (setq-local rcirc-user-disconnect nil) - (setq-local rcirc-user-authenticated nil) - (setq-local rcirc-connecting t) - (setq-local rcirc-server-parameters nil) + (setq rcirc-connecting t) (add-hook 'auto-save-hook 'rcirc-log-write) @@ -756,7 +749,7 @@ When 0, do not auto-reconnect." :version "25.1" :type 'integer) -(defvar rcirc-last-connect-time nil +(defvar-local rcirc-last-connect-time nil "The last time the buffer was connected.") (defun rcirc-sentinel (process sentinel) @@ -1070,10 +1063,10 @@ If SILENT is non-nil, do not print the message in any irc buffer." (unless silent (rcirc-print process (rcirc-nick process) response target msg))))) -(defvar rcirc-input-ring nil +(defvar-local rcirc-input-ring nil "Ring object for input.") -(defvar rcirc-input-ring-index 0 +(defvar-local rcirc-input-ring-index 0 "Current position in the input ring.") (defun rcirc-prev-input-string (arg) @@ -1187,20 +1180,20 @@ The list is updated automatically by `defun-rcirc-command'.") map) "Keymap for rcirc mode.") -(defvar rcirc-short-buffer-name nil +(defvar-local rcirc-short-buffer-name nil "Generated abbreviation to use to indicate buffer activity.") (defvar rcirc-mode-hook nil "Hook run when setting up rcirc buffer.") -(defvar rcirc-last-post-time nil +(defvar-local rcirc-last-post-time nil "Timestamp indicating last user action.") (defvar rcirc-log-alist nil "Alist of lines to log to disk when `rcirc-log-flag' is non-nil. Each element looks like (FILENAME . TEXT).") -(defvar rcirc-current-line 0 +(defvar-local rcirc-current-line 0 "The current number of responses printed in this channel. This number is independent of the number of lines in the buffer.") @@ -1215,7 +1208,7 @@ This number is independent of the number of lines in the buffer.") (setq major-mode 'rcirc-mode) (setq mode-line-process nil) - (setq-local rcirc-input-ring + (setq rcirc-input-ring ;; If rcirc-input-ring is already a ring with desired ;; size do not re-initialize. (if (and (ring-p rcirc-input-ring) @@ -1223,18 +1216,14 @@ This number is independent of the number of lines in the buffer.") rcirc-input-ring-size)) rcirc-input-ring (make-ring rcirc-input-ring-size))) - (setq-local rcirc-server-buffer (process-buffer process)) - (setq-local rcirc-target target) - (setq-local rcirc-topic nil) - (setq-local rcirc-last-post-time (current-time)) + (setq rcirc-server-buffer (process-buffer process)) + (setq rcirc-target target) + (setq rcirc-last-post-time (current-time)) (setq-local fill-paragraph-function 'rcirc-fill-paragraph) - (setq-local rcirc-recent-quit-alist nil) - (setq-local rcirc-current-line 0) - (setq-local rcirc-last-connect-time (current-time)) + (setq rcirc-current-line 0) + (setq rcirc-last-connect-time (current-time)) (use-hard-newlines t) - (setq-local rcirc-short-buffer-name nil) - (setq-local rcirc-urls nil) ;; setup for omitting responses (setq buffer-invisibility-spec '()) @@ -1255,8 +1244,8 @@ This number is independent of the number of lines in the buffer.") (if (consp (cdr i)) (cddr i) (cdr i)))))) ;; setup the prompt and markers - (setq-local rcirc-prompt-start-marker (point-max-marker)) - (setq-local rcirc-prompt-end-marker (point-max-marker)) + (setq rcirc-prompt-start-marker (point-max-marker)) + (setq rcirc-prompt-end-marker (point-max-marker)) (rcirc-update-prompt) (goto-char rcirc-prompt-end-marker) From fd96e3a0d9f8180ed4ef4829c7a738d10a4b858e Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Thu, 10 Jun 2021 17:38:44 +0200 Subject: [PATCH 18/38] Allow hiding certain message types after reconnecting * rcirc.el (rcirc-omit-after-reconnect): Add new user option (rcirc-reconncting): Add new variable (rcirc-print): Check if message should be omitted (reconnect): Mark buffers as freshly reconnected --- lisp/net/rcirc.el | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 4144a28278b..abe4cfb0b30 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -194,6 +194,17 @@ If nil, no maximum is applied." "Responses which will be hidden when `rcirc-omit-mode' is enabled." :type '(repeat string)) +(defcustom rcirc-omit-after-reconnect + '("JOIN" "TOPIC" "NAMES") + "Types of messages to hide right after reconnecting." + :type '(repeat string) + :version "28.1") + +(defvar-local rcirc-reconncting nil + "Non-nil means we have just reconnected. +This is used to hide the message types enumerated in +`rcirc-supress-after-reconnect'.") + (defvar-local rcirc-prompt-start-marker nil "Marker indicating the beginning of the message prompt.") @@ -1795,7 +1806,10 @@ connection." ;; make text omittable (let ((last-activity-lines (rcirc-elapsed-lines process sender target))) (if (and (not (string= (rcirc-nick process) sender)) - (member response rcirc-omit-responses) + (or (member response rcirc-omit-responses) + (if (member response rcirc-omit-after-reconnect) + rcirc-reconncting + (setq rcirc-reconncting nil))) (or (not last-activity-lines) (< rcirc-omit-threshold last-activity-lines))) (put-text-property (point-min) (point-max) @@ -2465,6 +2479,9 @@ to `rcirc-default-part-reason'." (setf (nth 5 conn-info) (cl-remove-if-not #'rcirc-channel-p (mapcar #'car rcirc-buffer-alist))) + (dolist (buf (nth 5 conn-info)) + (with-current-buffer (cdr (assoc buf rcirc-buffer-alist)) + (setq rcirc-reconncting t))) (apply #'rcirc-connect conn-info)))))) (rcirc-define-command nick (nick) From a44e402b69b5d44afe1dfdd38fec7fcb57d8af38 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Thu, 10 Jun 2021 19:44:00 +0200 Subject: [PATCH 19/38] Preserve incoming order of messages with same timestamp * rcirc.el (rcirc-print): Emulate time-less-or-equal-p --- lisp/net/rcirc.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index abe4cfb0b30..50ddb6ca050 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1767,7 +1767,7 @@ connection." (goto-char (or (previous-single-property-change (point) 'hard) (point-min))) (when (let ((then (get-text-property (point) 'rcirc-time))) - (and then (time-less-p then time))) + (and then (not (time-less-p time then)))) (next-single-property-change (point) 'hard) (forward-char 1) (throw 'exit nil)))) From e61bdd5a96c2961dbbbdfc75a51ce573eaf71d1f Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sun, 13 Jun 2021 20:00:59 +0200 Subject: [PATCH 20/38] Update activity string after switching to next active buffer * rcirc.el (rcirc-next-active-buffer): Call rcirc-update-activity-string --- lisp/net/rcirc.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 50ddb6ca050..400facf3440 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2154,7 +2154,8 @@ With prefix ARG, go to the next low priority buffer with activity." (concat " Type C-u " (key-description (this-command-keys)) " for low priority activity.") - ""))))) + "")))) + (rcirc-update-activity-string)) (define-obsolete-variable-alias 'rcirc-activity-hooks 'rcirc-activity-functions "24.3") From e17cc751baa17f142fbc41710bf645f6fdc64a80 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sun, 13 Jun 2021 21:10:25 +0200 Subject: [PATCH 21/38] Add mouse properties to activity string * rcirc.el (rcirc-activity-string): Allow clicking on string --- lisp/net/rcirc.el | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 400facf3440..9fdbf12cd89 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2211,7 +2211,6 @@ activity. Only run if the buffer is not visible and (defvar rcirc-update-activity-string-hook nil "Hook run whenever the activity string is updated.") -;; TODO: add mouse properties (defun rcirc-update-activity-string () "Update mode-line string." (let* ((pair (rcirc-split-activity rcirc-activity)) @@ -2238,12 +2237,17 @@ activity. Only run if the buffer is not visible and (let ((s (substring-no-properties (rcirc-short-buffer-name b)))) (with-current-buffer b (dolist (type rcirc-activity-types) - (rcirc-add-face 0 (length s) - (cl-case type + (rcirc-facify s (cl-case type (nick 'rcirc-track-nick) - (keyword 'rcirc-track-keyword)) - s))) - s)) + (keyword 'rcirc-track-keyword))))) + (let ((map (make-mode-line-mouse-map + 'mouse-1 + (lambda () + (interactive) + (pop-to-buffer b))))) + (propertize s + 'mouse-face 'mode-line-highlight + 'local-map map)))) buffers ",")) (defun rcirc-short-buffer-name (buffer) From 88e07af18cddbb0639b55ab21012eca1cd630b49 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Mon, 14 Jun 2021 09:31:01 +0200 Subject: [PATCH 22/38] Preserve order of completion during cycling * rcirc.el (rcirc-completion-at-point): Specify cycle-sort-function --- lisp/net/rcirc.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 9fdbf12cd89..de42220f96f 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1151,7 +1151,11 @@ The list is updated automatically by `defun-rcirc-command'.") (lambda (str) (concat (funcall rcirc-nick-filter str) ": ")) (rcirc-channel-nicks (rcirc-buffer-process) rcirc-target)))))) - (list beg (point) table)))) + (list beg (point) + (lambda (str pred action) + (if (eq action 'metadata) + '(metadata (cycle-sort-function . identity)) + (complete-with-action action table str pred))))))) (defun set-rcirc-decode-coding-system (coding-system) "Set the decode CODING-SYSTEM used in this channel." From f1e79a33b5c453ee7185822a4673e930033e9640 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Mon, 14 Jun 2021 13:25:57 +0200 Subject: [PATCH 23/38] Rename set-rcirc-{encode,decode}-coding-system * rcirc.el (set-rcirc-decode-coding-system): Deprecate command (rcirc-set-decode-coding-system): New command (set-rcirc-encode-coding-system): Deprecate command (rcirc-set-encode-coding-system): New command --- lisp/net/rcirc.el | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index de42220f96f..86f9ff048db 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1157,16 +1157,26 @@ The list is updated automatically by `defun-rcirc-command'.") '(metadata (cycle-sort-function . identity)) (complete-with-action action table str pred))))))) -(defun set-rcirc-decode-coding-system (coding-system) +(defun rcirc-set-decode-coding-system (coding-system) "Set the decode CODING-SYSTEM used in this channel." (interactive "zCoding system for incoming messages: ") (setq-local rcirc-decode-coding-system coding-system)) -(defun set-rcirc-encode-coding-system (coding-system) +(define-obsolete-function-alias + 'rcirc-set-decode-coding-system + 'set-rcirc-decode-coding-system + "28.1") + +(defun rcirc-set-encode-coding-system (coding-system) "Set the encode CODING-SYSTEM used in this channel." (interactive "zCoding system for outgoing messages: ") (setq-local rcirc-encode-coding-system coding-system)) +(define-obsolete-function-alias + 'rcirc-set-encode-coding-system + 'set-rcirc-encode-coding-system + "28.1") + (defvar rcirc-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "RET") 'rcirc-send-input) From 3e318464680c4c24e10004155122ac7db7b9c123 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Mon, 14 Jun 2021 18:02:24 +0200 Subject: [PATCH 24/38] Fix construction of interactive specification in rcirc-define-command * rcirc.el (rcirc-define-command): Ensure that only one argument is passed. --- lisp/net/rcirc.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 86f9ff048db..af054ece772 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2421,7 +2421,7 @@ that, an interactive form can specified." ,(concat documentation "\n\nNote: If PROCESS or TARGET are nil, the values given" "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") - (interactive ,@interactive-spec) + (interactive (list ,@interactive-spec)) (unless (if (listp ,argument) (not (<= ,required (length ,argument) ,total)) (string-match ,regexp ,argument)) From 946ceca26f55c33fdeb63759639c59c69e4af43e Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 15 Jun 2021 09:37:17 +0200 Subject: [PATCH 25/38] Improve message markup * rcirc.el (rcirc-markup-text-functions): Add rcirc-color-attributes, rcirc-remove-markup-codes (rcirc-markup-attributes): Recognize strike-through and monospace, don't remove control codes (rcirc-color-attributes): Recognize mIRC color codes (rcirc-remove-markup-codes): Add function (rcirc-monospace-text): Add face --- lisp/net/rcirc.el | 82 +++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 69 insertions(+), 13 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index af054ece772..36a46dd208a 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1732,6 +1732,8 @@ PROCESS is the process object for the current connection." (defvar rcirc-markup-text-functions '(rcirc-markup-attributes + rcirc-color-attributes + rcirc-remove-markup-codes rcirc-markup-my-nick rcirc-markup-urls rcirc-markup-keywords @@ -2715,20 +2717,70 @@ If ARG is given, opens the URL in a new browser window." (defun rcirc-markup-attributes (_sender _response) "Highlight IRC markup, indicated by ASCII control codes." - (while (re-search-forward "\\([\C-b\C-_\C-v]\\).*?\\(\\1\\|\C-o\\)" nil t) + (while (re-search-forward + (rx (group (or #x02 #x1d #x1f #x1e #x11)) + (*? nonl) + (group (or (backref 1) (+ #x0f) eol))) + nil t) (rcirc-add-face (match-beginning 0) (match-end 0) - (cl-case (char-after (match-beginning 1)) - (?\C-b 'bold) - (?\C-v 'italic) - (?\C-_ 'underline))) - ;; keep the ^O since it could terminate other attributes - (when (not (eq ?\C-o (char-before (match-end 2)))) - (delete-region (match-beginning 2) (match-end 2))) - (delete-region (match-beginning 1) (match-end 1)) - (goto-char (match-beginning 1))) - ;; remove the ^O characters now - (goto-char (point-min)) - (while (re-search-forward "\C-o+" nil t) + (cl-case (char-after (match-beginning 0)) + (#x02 'bold) + (#x1d 'italic) + (#x1f 'underline) + (#x1e '(:strike-through t)) + (#x11 'rcirc-monospace-text))) + (goto-char (1+ (match-beginning 0))))) + +(defconst rcirc-color-codes + ;; Taken from https://modern.ircdocs.horse/formatting.html + ["white" "black" "blue" "green" "red" "brown" "magenta" + "orange" "yellow" "light green" "cyan" "light cyan" + "light blue" "pink" "grey" "light grey" + "#470000" "#472100" "#474700" "#324700" "#004700" "#00472c" + "#004747" "#002747" "#000047" "#2e0047" "#470047" "#47002a" + "#740000" "#743a00" "#747400" "#517400" "#007400" "#007449" + "#007474" "#004074" "#000074" "#4b0074" "#740074" "#740045" + "#b50000" "#b56300" "#b5b500" "#7db500" "#00b500" "#00b571" + "#00b5b5" "#0063b5" "#0000b5" "#7500b5" "#b500b5" "#b5006b" + "#ff0000" "#ff8c00" "#ffff00" "#b2ff00" "#00ff00" "#00ffa0" + "#00ffff" "#008cff" "#0000ff" "#a500ff" "#ff00ff" "#ff0098" + "#ff5959" "#ffb459" "#ffff71" "#cfff60" "#6fff6f" "#65ffc9" + "#6dffff" "#59b4ff" "#5959ff" "#c459ff" "#ff66ff" "#ff59bc" + "#ff9c9c" "#ffd39c" "#ffff9c" "#e2ff9c" "#9cff9c" "#9cffdb" + "#9cffff" "#9cd3ff" "#9c9cff" "#dc9cff" "#ff9cff" "#ff94d3" + "#000000" "#131313" "#282828" "#363636" "#4d4d4d" "#656565" + "#818181" "#9f9f9f" "#bcbcbc" "#e2e2e2" "#ffffff"] + "Vector of colors for each IRC color code.") + +(defun rcirc-color-attributes (_sender _response) + "Highlight IRC color-codes, indicated by ASCII control codes." + (while (re-search-forward + (rx #x03 + (? (group (= 2 digit)) (? "," (group (= 2 digit)))) + (*? nonl) + (or #x03 #x0f eol)) + nil t) + (let (foreground background) + (when-let ((fg-raw (match-string 1)) + (fg (string-to-number fg-raw)) + ((<= 0 fg (1- (length rcirc-color-codes))))) + (setq foreground (aref rcirc-color-codes fg))) + (when-let ((bg-raw (match-string 2)) + (bg (string-to-number bg-raw)) + ((<= 0 bg (1- (length rcirc-color-codes))))) + (setq background (aref rcirc-color-codes bg))) + (rcirc-add-face (match-beginning 0) (match-end 0) + `(face (:foreground + ,foreground + :background + ,background)))))) + +(defun rcirc-remove-markup-codes (_sender _response) + "Remove ASCII control codes used to designate markup." + (while (re-search-forward + (rx (or #x02 #x1d #x1f #x1e #x11 #x0f + (: #x03 (? (= 2 digit) (? "," (= 2 digit)))))) + nil t) (delete-region (match-beginning 0) (match-end 0)))) (defun rcirc-markup-my-nick (_sender response) @@ -3424,6 +3476,10 @@ object for the current connection." :group 'rcirc :group 'faces) +(defface rcirc-monospace-text + '((t :family "Monospace")) + "Face used for monospace text in messages.") + (defface rcirc-my-nick ; font-lock-function-name-face '((((class color) (min-colors 88) (background light)) :foreground "Blue1") (((class color) (min-colors 88) (background dark)) :foreground "LightSkyBlue") From 1181c606b3ff76488c068ce057cd7596e6c49cea Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 15 Jun 2021 18:16:58 +0200 Subject: [PATCH 26/38] Check if server buffer is live * rcirc.el (with-rcirc-server-buffer): Use live-buffer-p (rcirc-buffer-nick): Use with-rcirc-server-buffer (rcirc-switch-to-server-buffer): Use with-rcirc-server-buffer --- lisp/net/rcirc.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 36a46dd208a..dfa80bb4089 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -681,8 +681,10 @@ that are joined after authentication." (defmacro with-rcirc-server-buffer (&rest body) "Evaluate BODY in the server buffer of the current channel." (declare (indent 0) (debug t)) - `(with-current-buffer rcirc-server-buffer - ,@body)) + `(if (buffer-live-p rcirc-server-buffer) + (with-current-buffer rcirc-server-buffer + ,@body) + (user-error "Server buffer was killed"))) (define-obsolete-function-alias 'rcirc-float-time 'float-time "26.1") @@ -1037,7 +1039,7 @@ With no argument or nil as argument, use the current buffer." "Return the nick associated with BUFFER. With no argument or nil as argument, use the current buffer." (with-current-buffer (or buffer (current-buffer)) - (with-current-buffer rcirc-server-buffer + (with-rcirc-server-buffer (or rcirc-nick rcirc-default-nick)))) (defvar rcirc-max-message-length 420 @@ -2132,9 +2134,7 @@ This function does not alter the INPUT string." (defun rcirc-switch-to-server-buffer () "Switch to the server buffer associated with current channel buffer." (interactive) - (unless (buffer-live-p rcirc-server-buffer) - (error "No such buffer")) - (switch-to-buffer rcirc-server-buffer)) + (switch-to-buffer (with-rcirc-server-buffer (current-buffer)))) (defun rcirc-jump-to-first-unread-line () "Move the point to the first unread line in this buffer." From 7e5360f32203ad7536dafd000938abd621bd0a2e Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 15 Jun 2021 23:12:02 +0200 Subject: [PATCH 27/38] Fix argument parser for rcirc-define-command with string input * rcirc.el (rcirc-define-command): Require at least one space between arguments --- lisp/net/rcirc.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index dfa80bb4089..4d98d65d58a 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2403,8 +2403,8 @@ that, an interactive form can specified." (insert "\\`") (when arguments (dotimes (_ (1- (length arguments))) - (insert "\\(?:\\(.+?\\)[[:space:]]*")) - (insert "\\(.*\\)") + (insert "\\(?:\\(.+?\\)")) + (insert "\\(?:[[:space:]]+\\(.*\\)\\)") (dotimes (i (1- (length arguments))) (when (< i optional) (insert "?")) From b5d935bb7f5a37ddeba5bf9971d5aaec9a0698c2 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 15 Jun 2021 23:44:56 +0200 Subject: [PATCH 28/38] Fix edge case with single argument for rcirc-define-command * rcirc.el (rcirc-define-command): Update regular expression generator --- lisp/net/rcirc.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 4d98d65d58a..d4f0ccd47cd 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2403,12 +2403,12 @@ that, an interactive form can specified." (insert "\\`") (when arguments (dotimes (_ (1- (length arguments))) - (insert "\\(?:\\(.+?\\)")) - (insert "\\(?:[[:space:]]+\\(.*\\)\\)") + (insert "\\(?:\\(.+?\\)[[:space:]]+")) (dotimes (i (1- (length arguments))) - (when (< i optional) - (insert "?")) - (insert "\\)"))) + (if (< i optional) + (insert "\\)?") + (insert "\\)")))) + (insert "\\(.*?\\)") (insert "[[:space:]]*\\'") (buffer-string))) (argument (gensym)) From 21148f67f1f99581fe6fc96afd80f33ae3365ede Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Wed, 16 Jun 2021 09:43:05 +0200 Subject: [PATCH 29/38] Force mode line update after modifying activity string * rcirc.el (rcirc-update-activity-string): Call force-mode-line-update --- lisp/net/rcirc.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index d4f0ccd47cd..561589c4580 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2245,7 +2245,8 @@ activity. Only run if the buffer is not visible and ((not (null (rcirc-process-list))) "[]") (t "[]"))) - (run-hooks 'rcirc-update-activity-string-hook))) + (run-hooks 'rcirc-update-activity-string-hook) + (force-mode-line-update t))) (defun rcirc-activity-string (buffers) "Generate activity string for all BUFFERS." From 869db473cbd510270faec2ba43dd4a5ba10b0020 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sat, 19 Jun 2021 10:43:26 +0200 Subject: [PATCH 30/38] Use add-to-list instead of manually modifying minor-mode-alist --- lisp/net/rcirc.el | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 561589c4580..9e14d1b12ac 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2104,12 +2104,8 @@ This function does not alter the INPUT string." (remove-hook 'window-configuration-change-hook 'rcirc-window-configuration-change))) -(or (assq 'rcirc-ignore-buffer-activity-flag minor-mode-alist) - (setq minor-mode-alist - (cons '(rcirc-ignore-buffer-activity-flag " Ignore") minor-mode-alist))) -(or (assq 'rcirc-low-priority-flag minor-mode-alist) - (setq minor-mode-alist - (cons '(rcirc-low-priority-flag " LowPri") minor-mode-alist))) +(add-to-list 'minor-mode-alist '(rcirc-ignore-buffer-activity-flag " Ignore")) +(add-to-list 'minor-mode-alist '(rcirc-low-priority-flag " LowPri")) (defun rcirc-toggle-ignore-buffer-activity () "Toggle the value of `rcirc-ignore-buffer-activity-flag'." From b81c97779909275b8b9d36c00d789dceba6f28e5 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Mon, 21 Jun 2021 09:12:25 +0200 Subject: [PATCH 31/38] Query encryption using yes-or-no-p * rcirc.el (rcirc-prompt-for-encryption): Replace completing-read prompt with yes-or-no-p --- lisp/net/rcirc.el | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 9e14d1b12ac..6c27acfadf7 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -691,12 +691,9 @@ that are joined after authentication." (defun rcirc-prompt-for-encryption (server-plist) "Prompt the user for the encryption method to use. SERVER-PLIST is the property list for the server." - (let ((choices '("plain" "tls")) - (default (or (plist-get server-plist :encryption) - "plain"))) - (intern - (completing-read (format-prompt "Encryption" default) - choices nil t nil nil default)))) + (if (or (eq (plist-get server-plist :encryption) 'plain) + (yes-or-no-p "Encrypt connection?")) + 'tls 'plain)) (defun rcirc-keepalive () "Send keep alive pings to active rcirc processes. From 6122e4c1f07a59196832f95a64a45517e7c5cce8 Mon Sep 17 00:00:00 2001 From: Alex McGrath Date: Thu, 24 Jun 2021 18:45:08 +0200 Subject: [PATCH 32/38] Add SASL authentication to rcirc * lisp/net/rcirc.el (rcirc-handler-AUTHENTICATE): New function (bug#48601). (rcirc-authenticate): (rcirc-connect): Support sasl. (rcirc-get-server-password, rcirc-get-server-method): New functions. (rcirc-authinfo): Document it. --- doc/misc/rcirc.texi | 6 ++++++ lisp/net/rcirc.el | 42 ++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 46 insertions(+), 2 deletions(-) diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi index ff8133b2a1f..e187bbbfe5f 100644 --- a/doc/misc/rcirc.texi +++ b/doc/misc/rcirc.texi @@ -590,6 +590,12 @@ Use this symbol if you need to identify yourself in the Bitlbee channel as follows: @code{identify secret}. The necessary arguments are the nickname you want to use this for, and the password to use. +@item sasl +@cindex sasl authentication +Use this symbol if you want to use @acronym{SASL} authentication. The +necessary arguments are the nickname you want to use this for, and the +password to use. + @cindex gateway to other IM services @cindex instant messaging, other services @cindex Jabber diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 6c27acfadf7..37c31be58ff 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -261,13 +261,15 @@ The ARGUMENTS for each METHOD symbol are: `chanserv': NICK CHANNEL PASSWORD `bitlbee': NICK PASSWORD `quakenet': ACCOUNT PASSWORD + `sasl': NICK PASSWORD Examples: ((\"freenode\" nickserv \"bob\" \"p455w0rd\") (\"freenode\" chanserv \"bob\" \"#bobland\" \"passwd99\") (\"bitlbee\" bitlbee \"robert\" \"sekrit\") (\"dal.net\" nickserv \"bob\" \"sekrit\" \"NickServ@services.dal.net\") - (\"quakenet.org\" quakenet \"bobby\" \"sekrit\"))" + (\"quakenet.org\" quakenet \"bobby\" \"sekrit\") + (\"oftc\" sasl \"bob\" \"hunter2\"))" :type '(alist :key-type (regexp :tag "Server") :value-type (choice (list :tag "NickServ" (const nickserv) @@ -285,6 +287,10 @@ Examples: (list :tag "QuakeNet" (const quakenet) (string :tag "Account") + (string :tag "Password")) + (list :tag "SASL" + (const sasl) + (string :tag "Nick") (string :tag "Password"))))) (defcustom rcirc-auto-authenticate-flag t @@ -597,6 +603,7 @@ See `rcirc-connect' for more details on these variables.") "batch" ;https://ircv3.net/specs/extensions/batch "message-ids" ;https://ircv3.net/specs/extensions/message-ids "invite-notify" ;https://ircv3.net/specs/extensions/invite-notify + "sasl" ;https://ircv3.net/specs/extensions/sasl-3.1 ) "A list of capabilities that rcirc supports.") (defvar-local rcirc-requested-capabilities nil @@ -604,6 +611,24 @@ See `rcirc-connect' for more details on these variables.") (defvar-local rcirc-acked-capabilities nil "A list of capabilities that the server supports.") +(defun rcirc-get-server-method (server) + "Return authentication method for SERVER." + (catch 'method + (dolist (i rcirc-authinfo) + (let ((server-i (car i)) + (method (cadr i))) + (when (string-match server-i server) + (throw 'method method)))))) + +(defun rcirc-get-server-password (server) + "Return password for SERVER." + (catch 'pass + (dolist (i rcirc-authinfo) + (let ((server-i (car i)) + (args (cdddr i))) + (when (string-match server-i server) + (throw 'pass (car args))))))) + ;;;###autoload (defun rcirc-connect (server &optional port nick user-name full-name startup-channels password encryption @@ -3317,7 +3342,8 @@ Passwords are stored in `rcirc-authinfo' (which see)." (rcirc-send-privmsg process "&bitlbee" - (concat "IDENTIFY " (car args))))) + (concat "IDENTIFY " (car args)))) + (sasl nil)) ;; quakenet authentication doesn't rely on the user's nickname. ;; the variable `nick' here represents the Q account name. (when (eq method 'quakenet) @@ -3394,6 +3420,7 @@ PROCESS is the process object for the current connection." PROCESS is the process object for the current connection." (rcirc-print process sender "CTCP" nil message t)) + (defun rcirc-handler-CAP (process _sender args _text) "Handle capability negotiation messages. ARGS should have the form (USER SUBCOMMAND . ARGUMENTS). PROCESS @@ -3464,6 +3491,17 @@ object for the current connection." (delq (assoc id rcirc-batched-messages) rcirc-batched-messages))))))) +(defun rcirc-handler-AUTHENTICATE (process _cmd _args _text) + "Respond to authentication request. +PROCESS is the process object for the current connection." + (rcirc-send-string + process + "AUTHENTICATE" + (base64-encode-string + ;; use connection user-name + (concat "\0" (nth 3 rcirc-connection-info) + "\0" (rcirc-get-server-password rcirc-server))))) + (defgroup rcirc-faces nil "Faces for rcirc." From df6efb1c8b0b1c64d183f966da00401593b5e96b Mon Sep 17 00:00:00 2001 From: Alex McGrath Date: Mon, 28 Jun 2021 13:41:31 +0100 Subject: [PATCH 33/38] Fix SASL on rcirc-update --- lisp/net/rcirc.el | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 37c31be58ff..0feafd708ab 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -610,6 +610,8 @@ See `rcirc-connect' for more details on these variables.") "A list of capabilities that client has requested.") (defvar-local rcirc-acked-capabilities nil "A list of capabilities that the server supports.") +(defvar-local rcirc-finished-sasl t + "Check whether SASL authentication has completed") (defun rcirc-get-server-method (server) "Return authentication method for SERVER." @@ -650,10 +652,13 @@ that are joined after authentication." (user-name (or user-name rcirc-default-user-name)) (full-name (or full-name rcirc-default-full-name)) (startup-channels startup-channels) + (use-sasl (eq (rcirc-get-server-method server) 'sasl)) (process (open-network-stream (or server-alias server) nil server port-number :type (or encryption 'plain)))) ;; set up process + (when use-sasl + (setq-local rcirc-finished-sasl nil)) (set-process-coding-system process 'raw-text 'raw-text) (switch-to-buffer (rcirc-generate-new-buffer-name process nil)) (set-process-buffer process (current-buffer)) @@ -685,6 +690,10 @@ that are joined after authentication." (rcirc-send-string process "PASS" password)) (rcirc-send-string process "NICK" nick) (rcirc-send-string process "USER" user-name "0" "*" : full-name) + ;; Setup sasl, and initiate authentication. + (when (and rcirc-auto-authenticate-flag + use-sasl) + (rcirc-send-string process "AUTHENTICATE" "PLAIN")) ;; setup ping timer if necessary (unless rcirc-keepalive-timer @@ -3435,7 +3444,7 @@ is the process object for the current connection." ((string= subcmd "NAK") (setq rcirc-requested-capabilities (delete cap rcirc-requested-capabilities)))))) - (when (null rcirc-requested-capabilities) + (when (and (null rcirc-requested-capabilities) rcirc-finished-sasl) ;; All requested capabilities have been responded to (rcirc-send-string process "CAP" "END")))) @@ -3500,7 +3509,9 @@ PROCESS is the process object for the current connection." (base64-encode-string ;; use connection user-name (concat "\0" (nth 3 rcirc-connection-info) - "\0" (rcirc-get-server-password rcirc-server))))) + "\0" (rcirc-get-server-password rcirc-server)))) + (setq-local rcirc-finished-sasl t) + (rcirc-send-string process "CAP" "END")) (defgroup rcirc-faces nil From a85d27278eaf0214cdb2f6c4f3b764f2392f068b Mon Sep 17 00:00:00 2001 From: Alex McGrath Date: Tue, 29 Jun 2021 12:06:22 +0100 Subject: [PATCH 34/38] Send CAP END after authentication has been successful --- lisp/net/rcirc.el | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 0feafd708ab..d1b87abb62b 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -657,8 +657,6 @@ that are joined after authentication." (or server-alias server) nil server port-number :type (or encryption 'plain)))) ;; set up process - (when use-sasl - (setq-local rcirc-finished-sasl nil)) (set-process-coding-system process 'raw-text 'raw-text) (switch-to-buffer (rcirc-generate-new-buffer-name process nil)) (set-process-buffer process (current-buffer)) @@ -682,6 +680,8 @@ that are joined after authentication." (add-hook 'auto-save-hook 'rcirc-log-write) + (when use-sasl + (setq-local rcirc-finished-sasl nil)) ;; identify (dolist (cap rcirc-implemented-capabilities) (rcirc-send-string process "CAP" "REQ" : cap) @@ -3509,9 +3509,14 @@ PROCESS is the process object for the current connection." (base64-encode-string ;; use connection user-name (concat "\0" (nth 3 rcirc-connection-info) - "\0" (rcirc-get-server-password rcirc-server)))) - (setq-local rcirc-finished-sasl t) - (rcirc-send-string process "CAP" "END")) + "\0" (rcirc-get-server-password rcirc-server))))) + +(defun rcirc-handler-900 (process sender args _text) + "Respond to a successful authentication response" + (rcirc-handler-generic process "900" sender args nil) + (when (not rcirc-finished-sasl) + (setq-local rcirc-finished-sasl t) + (rcirc-send-string process "CAP" "END"))) (defgroup rcirc-faces nil From e3f456255bb26ca7e3c8350a62aa724a56e60059 Mon Sep 17 00:00:00 2001 From: Alex McGrath Date: Tue, 29 Jun 2021 13:04:33 +0100 Subject: [PATCH 35/38] Fix SASL joining channels after auth --- lisp/net/rcirc.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index d1b87abb62b..154413871c7 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -3516,7 +3516,8 @@ PROCESS is the process object for the current connection." (rcirc-handler-generic process "900" sender args nil) (when (not rcirc-finished-sasl) (setq-local rcirc-finished-sasl t) - (rcirc-send-string process "CAP" "END"))) + (rcirc-send-string process "CAP" "END")) + (rcirc-join-channels-post-auth process)) (defgroup rcirc-faces nil From f222fe6163c63966c9f0128dd5ea6b06ff428628 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Fri, 2 Jul 2021 20:11:08 +0200 Subject: [PATCH 36/38] * rcirc.el (rcirc-define-command): Mention name of malformed command Author: --- lisp/net/rcirc.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 154413871c7..4f8d9612c6a 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2455,7 +2455,7 @@ that, an interactive form can specified." (unless (if (listp ,argument) (not (<= ,required (length ,argument) ,total)) (string-match ,regexp ,argument)) - (user-error "Malformed input: %S" ',arguments)) + (user-error "Malformed input (%s): %S" ,command ',arguments)) (let ((process (or process (rcirc-buffer-process))) (target (or target rcirc-target))) (ignore target process) From 1d735756818fcd558722ee1cdc47ad44bcde5fb0 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 6 Jul 2021 08:50:21 +0200 Subject: [PATCH 37/38] Fix issues with argument parsing in rcirc-define-command * rcirc.el (rcirc-define-command): Fix issues --- lisp/net/rcirc.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 4f8d9612c6a..caec1508489 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2453,9 +2453,9 @@ that, an interactive form can specified." "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") (interactive (list ,@interactive-spec)) (unless (if (listp ,argument) - (not (<= ,required (length ,argument) ,total)) + (<= ,required (length ,argument) ,total) (string-match ,regexp ,argument)) - (user-error "Malformed input (%s): %S" ,command ',arguments)) + (user-error "Malformed input (%s): %S" ',command ',argument)) (let ((process (or process (rcirc-buffer-process))) (target (or target rcirc-target))) (ignore target process) From 77631c2a7704f78e6b85846d2c23a2ffc22368cf Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 6 Jul 2021 08:52:50 +0200 Subject: [PATCH 38/38] Add query command removed in 4ff1f66b12 * rcirc.el (query): Readd accidentally removed command --- lisp/net/rcirc.el | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index caec1508489..af0def8e474 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2480,6 +2480,17 @@ that, an interactive form can specified." (read-string "Message: "))) (rcirc-send-message process chan-or-nick message)) +(rcirc-define-command query (nick) + "Open a private chat buffer to NICK." + (interactive (list (completing-read "Query nick: " + (with-rcirc-server-buffer + rcirc-nick-table)))) + (let ((existing-buffer (rcirc-get-buffer process nick))) + (switch-to-buffer (or existing-buffer + (rcirc-get-buffer-create process nick))) + (when (not existing-buffer) + (rcirc-cmd-whois nick)))) + (rcirc-define-command join (channels) "Join CHANNELS. CHANNELS is a comma- or space-separated string of channel names."