From: plugd Date: Sun, 19 May 2024 13:31:09 +0000 (+0200) Subject: Joining and parting channels. X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=266f254c2ea3dc544bf5d13dbc5e30f2f6d361b5;p=lurk.git Joining and parting channels. --- diff --git a/murk.el b/murk.el index 59f7606..652b3c2 100644 --- a/murk.el +++ b/murk.el @@ -37,7 +37,7 @@ "Multiserver Unibuffer iRc Klient" :group 'network) -(defcustom murk-nick "plugd" +(defcustom murk-default-nick "plugd" "Default nick.") (defcustom murk-default-quit-msg "Bye" @@ -98,6 +98,7 @@ (defvar murk-debug nil "If non-nil, enable debug mode.") + ;;; Utility procedures ;; @@ -109,6 +110,7 @@ (with-output-to-string (princ obj)) nil)) + ;;; Network processes ;; @@ -119,13 +121,23 @@ This includes the process and the response string.") (defun murk-connection-process (server) (elt (assoc server murk-connection-table) 1)) -(defun murk-connection-response (server) +(defun murk-connection-nick (server) (elt (assoc server murk-connection-table) 2)) +(defun murk-set-connection-nick (server nick) + (setf (elt (assoc server murk-connection-table) 2) nick)) + +(defun murk-connection-response (server) + (elt (assoc server murk-connection-table) 3)) + (defun murk-set-connection-response (server string) - (setf (elt (assoc server murk-connection-table) 2) string)) + (setf (elt (assoc server murk-connection-table) 3) string)) -(defun murk-connection-close (server) +(defun murk-connection-new (server process nick) + (add-to-list 'murk-connection-table + (list server process nick ""))) + +(defun murk-connection-remove (server) (setq murk-connection-table (assoc-delete-all server murk-connection-table))) (defun murk-make-server-filter (server) @@ -140,9 +152,9 @@ This includes the process and the response string.") (lambda (proc string) (unless (equal "open" (string-trim string)) (murk-display-error "Disconnected from server.") + (murk-connection-remove server) (murk-remove-server-contexts server) - (murk-render-prompt) - (murk-connection-close server)))) + (murk-render-prompt)))) (defun murk-start-process (server) (let* ((row (assoc server murk-networks)) @@ -174,11 +186,11 @@ This includes the process and the response string.") (if (not (assoc server murk-networks)) (murk-display-error "Network '" server "' is unknown.") (let ((proc (murk-start-process server))) - (add-to-list 'murk-connection-table - (list server proc ""))) - (murk-send-msg server (murk-msg nil nil "USER" murk-nick 0 "*" murk-nick)) - (murk-send-msg server (murk-msg nil nil "NICK" murk-nick)) - (murk-add-context (list server))))) + (murk-connection-new server proc murk-default-nick)) + (murk-send-msg server (murk-msg nil nil "USER" murk-default-nick 0 "*" murk-default-nick)) + (murk-send-msg server (murk-msg nil nil "NICK" murk-default-nick)) + (murk-add-context (list server)) + (murk-render-prompt)))) (defun murk-send-msg (server msg) (if murk-debug @@ -186,8 +198,8 @@ This includes the process and the response string.") (let ((proc (murk-connection-process server))) (if (and proc (eq (process-status proc) 'open)) (process-send-string proc (concat (murk-msg->string msg) "\r\n")) - (murk-display-error "No server connection established.") - (error "No server connection established")))) + (murk-display-error "No server connection established.")))) + ;;; Server messages ;; @@ -264,7 +276,7 @@ portion of the source component of the message, as mURK doesn't use this.") ;; representing either a channel name or nick, and server is a symbol ;; identifying the server. ;; -;; Each server has a special context (server) used for messages +;; Each server has a special context (server nil) used for messages ;; to/from the server itself. (defvar murk-contexts nil @@ -277,16 +289,40 @@ The head of this list is always the current context.") (car murk-contexts) nil)) +(defun murk-contexts-equal (c1 c2) + (if (murk-server-context-p c1) + (and (murk-server-context-p c2) + (equal (murk-context-server c1) + (murk-context-server c2))) + (and (not (murk-server-context-p c2)) + (equal (seq-take c1 2) + (seq-take c2 2))))) + (defun murk-context-server (ctx) (elt ctx 0)) (defun murk-context-name (ctx) (elt ctx 1)) +(defun murk-server-context-p (ctx) (not (cdr ctx))) (defun murk-add-context (ctx) (add-to-list 'murk-contexts ctx)) +(defun murk-remove-context (ctx) + (setq murk-contexts + (seq-remove + (lambda (this-ctx) + (murk-contexts-equal this-ctx ctx)) + murk-contexts))) + (defun murk-remove-server-contexts (server) (setq murk-contexts (assoc-delete-all server murk-contexts))) +(defun murk-context->string (ctx) + (if (murk-server-context-p ctx) + (concat "[" (murk-context-server ctx) "]") + (concat (murk-context-name ctx) "@" + (murk-context-server ctx)))) + + ;;; Buffer ;; @@ -306,7 +342,7 @@ The head of this list is always the current context.") (insert (propertize (let ((ctx (murk-current-context))) (if ctx - (concat (murk-context-name) "@" (murk-context-server ctx)) + (murk-context->string ctx) "")) 'face 'murk-context 'read-only t) @@ -367,11 +403,6 @@ The head of this list is always the current context.") (fill-region (point-min) (point-max) nil t) (buffer-string)))) -(defun murk-context->string (context) - (if context - (concat (murk-context-name) "@" (murk-context-server context)) - nil)) - (defun murk-display-string (context prefix &rest strings) (with-current-buffer "*murk*" (save-excursion @@ -512,6 +543,40 @@ The head of this list is always the current context.") ("PONG") + ("001" + (let* ((params (murk-msg-params msg)) + (nick (elt params 0)) + (text (string-join (seq-drop params 1) " "))) + (murk-set-connection-nick server nick) + (murk-display-notice nil text))) + + ((rx (= 3 (any digit))) + (murk-display-notice nil (mapconcat 'identity (cdr (murk-msg-params msg)) " "))) + + ((and "JOIN" + (guard (equal (murk-connection-nick server) + (murk-msg-src msg)))) + (let ((channel (car (murk-msg-params msg)))) + (murk-add-context (list server channel)) + (murk-display-notice (murk-current-context) + "Joining channel " channel " on " server) + (murk-render-prompt))) + + ((and "PART" + (guard (equal (murk-connection-nick server) + (murk-msg-src msg)))) + (let ((channel (car (murk-msg-params msg)))) + (murk-display-notice (murk-current-context) "Left channel " channel) + (murk-remove-context (list server channel)) + (murk-render-prompt))) + + ("QUIT" + (let ((nick (murk-msg-src msg)) + (reason (mapconcat 'identity (murk-msg-params msg) " "))) + (murk-del-user nick) + (if murk-show-joins + (murk-display-notice nil nick " quit: " reason)))) + (_ (murk-display-notice nil (murk-msg->string msg)))))) @@ -521,9 +586,11 @@ The head of this list is always the current context.") (defvar murk-command-table '(("DEBUG" "Toggle debug mode on/off." murk-command-debug murk-boolean-completions) ("HEADER" "Toggle display of header." murk-command-header murk-boolean-completions) - ("CONNECT" "Connect to an IRC network." murk-command-connect murk-network-completions) ("NETWORKS" "List known IRC networks." murk-command-networks) + ("CONNECT" "Connect to an IRC network." murk-command-connect murk-network-completions) ("QUIT" "Disconnect from current network." murk-command-quit) + ("JOIN" "Join one or more channels." murk-command-join) + ("PART" "Leave channel." murk-command-part murk-context-completions) ("NICK" "Change nick." murk-command-nick) ("MSG" "Send private message to user." murk-command-msg murk-nick-completions) ("CLEAR" "Clear buffer text." murk-command-clear murk-context-completions) @@ -588,7 +655,24 @@ The head of this list is always the current context.") (let ((quit-msg (if params (string-join params " ") murk-default-quit-msg))) (murk-send-msg (murk-context-server ctx) - (lurk-msg nil nil "QUIT" quit-msg)))))) + (murk-msg nil nil "QUIT" quit-msg)))))) + +(defun murk-command-join (params) + (if params + (let ((server (murk-context-server (murk-current-context)))) + (dolist (channel params) + (murk-send-msg server (murk-msg nil nil "JOIN" channel)))) + (murk-display-notice nil "Usage: /join channel [channel2 ...]"))) + +(defun murk-command-part (params) + (let* ((server (murk-context-server (murk-current-context))) + (channel (if params + (car params) + (murk-context-name (murk-current-context))))) + (if channel + (murk-send-msg server (murk-msg nil nil "PART" channel)) + (murk-display-error "No current channel to leave.")))) + ;;; Command entering ;;