From ec58a1a3cd3fb60bb5f0d14bde535cb1d5c0a457 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Fri, 4 Jun 2021 16:29:27 +0200 Subject: [PATCH 05/11] Improve formatting of rcirc-send-string --- lisp/net/rcirc.el | 91 ++++++++++++++++++++++++++--------------------- 1 file changed, 50 insertions(+), 41 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 1f925b00b1..ab5634d75d 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -630,10 +630,9 @@ rcirc-connect ;; 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 @@ -879,9 +878,23 @@ rcirc--connection-open-p "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 + (apply-partially #'format "%s") + parts " ") + rcirc-encode-coding-system) "\n"))) (unless (rcirc--connection-open-p process) (error "Network connection to %s is not open" @@ -892,13 +905,15 @@ rcirc-send-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))) + (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) - (let ((args (if args (concat " " args) ""))) - (rcirc-send-privmsg process target - (format "\C-a%s%s\C-a" request args)))) "Send TARGET a REQUEST via PROCESS." + (rcirc-send-privmsg process target (rcirc-ctcp-wrap request args))) (defun rcirc-buffer-process (&optional buffer) "Return the process associated with channel BUFFER. @@ -957,7 +972,7 @@ rcirc-send-message (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))))) @@ -1282,7 +1297,7 @@ rcirc-clean-up-buffer (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) @@ -2313,7 +2328,7 @@ join (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))))) @@ -2326,7 +2341,7 @@ invite (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. @@ -2342,15 +2357,14 @@ part (setq channel (if (match-beginning 1) (match-string 1 channel) target))) - (rcirc-send-string process (concat "PART " channel " :" msg)))) + (rcirc-send-string process "PART" : 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." @@ -2370,7 +2384,7 @@ nick (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. @@ -2382,7 +2396,7 @@ names (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. @@ -2390,32 +2404,32 @@ 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." @@ -2430,10 +2444,8 @@ kick (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. @@ -2924,11 +2936,11 @@ rcirc-handler-NICK (when rcirc-auto-authenticate-flag (rcirc-authenticate)))))) (defun rcirc-handler-PING (process _sender args _text) - (rcirc-send-string process (concat "PONG :" (car args)))) "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 "PONG" : (car args))) (defun rcirc-handler-PONG (_process _sender _args _text) "Ignore all incoming PONG messages.") @@ -3171,22 +3183,19 @@ rcirc-handler-CTCP (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. PROCESS is the process object for the current connection." - (rcirc-print process sender "ACTION" target args t)) + (rcirc-print process sender "ACTION" target message t)) (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. -- 2.30.2