From 075a68ab59c557bc8ba6eccd4e64fcb02a74e1fc Mon Sep 17 00:00:00 2001 From: plugd Date: Sat, 18 May 2024 19:34:08 +0200 Subject: [PATCH 01/16] Included repl. Can start testing network code now. --- murk.el | 216 +++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 214 insertions(+), 2 deletions(-) diff --git a/murk.el b/murk.el index 1cab898..6ae7519 100644 --- a/murk.el +++ b/murk.el @@ -55,6 +55,34 @@ ;;; Faces ;; +(defface murk-text + '((t :inherit default)) + "Face used for murk text.") + +(defface murk-prompt + '((t :inherit font-lock-keyword-face)) + "Face used for the prompt.") + +(defface murk-context + '((t :inherit murk-context)) + "Face used for the context name in the prompt.") + +(defface murk-faded + '((t :inherit shadow)) + "Face used for faded murk text.") + +(defface murk-timestamp + '((t :inherit shadow)) + "Face used for timestamps.") + +(defface murk-error + '((t :inherit error)) + "Face used for murk error text.") + +(defface murk-notice + '((t :inherit warning)) + "Face used for murk notice text.") + ;;; Global variables ;; @@ -66,6 +94,9 @@ (defvar murk-error-prefix "!!!") (defvar murk-prompt-string ">") +(defvar murk-debug nil + "If non-nil, enable debug mode.") + ;;; Utility procedures ;; @@ -332,7 +363,6 @@ The head of this list is always the current context.") (concat (murk-context-name) "@" (murk-context-server context)) nil)) - (defun murk-display-string (context prefix &rest strings) (with-current-buffer "*murk*" (save-excursion @@ -356,9 +386,25 @@ The head of this list is always the current context.") 'read-only t 'context context 'invisible context-atom) - (concat (apply #'murk-buttonify-urls strings) "\n")))))) + (murk-add-formatting + (propertize (concat (apply #'murk-buttonify-urls strings) "\n") + 'read-only t + 'context context + 'invisible context-atom))))))) (murk-scroll-windows-to-last-line)) +(defun murk-display-notice (context &rest notices) + (murk-display-string + context + (propertize murk-notice-prefix 'face 'murk-notice) + (apply #'concat notices))) + +(defun murk-display-error (&rest messages) + (murk-display-string + nil + (propertize murk-error-prefix 'face 'murk-error) + (apply #'concat messages))) + (defun murk--start-of-final-line () (with-current-buffer "*murk*" (save-excursion @@ -372,6 +418,8 @@ The head of this list is always the current context.") (with-selected-window window (recenter -1)))))) + + (defconst murk-url-regex (rx (: (group (+ alpha)) @@ -404,6 +452,170 @@ The head of this list is always the current context.") 'help-echo "Open URL in browser."))) (buffer-string))) +(defun murk-add-formatting (string) + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (let ((bold nil) + (italics nil) + (underline nil) + (strikethrough nil) + (prev-point (point))) + (while (re-search-forward (rx (or (any "\x02\x1D\x1F\x1E\x0F") + (: "\x03" (+ digit) (opt "," (* digit))))) + nil t) + (let ((beg (+ (match-beginning 0) 1))) + (if bold + (add-face-text-property prev-point beg '(:weight bold))) + (if italics + (add-face-text-property prev-point beg '(:slant italic))) + (if underline + (add-face-text-property prev-point beg '(:underline t))) + (if strikethrough + (add-face-text-property prev-point beg '(:strike-through t))) + (pcase (match-string 0) + ("\x02" (setq bold (not bold))) + ("\x1D" (setq italics (not italics))) + ("\x1F" (setq underline (not underline))) + ("\x1E" (setq strikethrough (not strikethrough))) + ("\x0F" ; Reset + (setq bold nil) + (setq italics nil) + (setq underline nil) + (setq strikethrough nil)) + (_)) + (delete-region (match-beginning 0) (match-end 0)) + (setq prev-point (point))))) + (buffer-string))) + + +;;; Message evaluation +;; + +(defun murk-eval-msg-string (server string) + (if murk-debug + (murk-display-string nil nil string)) + (let* ((msg (murk-string->msg string))) + (pcase (murk-msg-cmd msg) + ("PING" + (murk-send-msg server + (murk-msg nil nil "PONG" (murk-msg-params msg)))) + + ("PONG") + + (_ + (murk-display-notice nil (murk-msg->string msg)))))) + +;;; Commands +;; + +(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) + ("QUIT" "Disconnect from current network." murk-command-quit) + ("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) + ("HELP" "Display help on client commands." murk-command-help murk-help-completions)) + "Table of commands explicitly supported by murk.") + +(defun murk-command-help (params) + (if params + (let* ((cmd-str (upcase (car params))) + (row (assoc cmd-str murk-command-table #'equal))) + (if row + (progn + (murk-display-notice nil "Help for \x02" cmd-str "\x02:") + (murk-display-notice nil " " (elt row 1))) + (murk-display-notice nil "No such (client-interpreted) command."))) + (murk-display-notice nil "Client-interpreted commands:") + (dolist (row murk-command-table) + (murk-display-notice nil " \x02" (elt row 0) "\x02: " (elt row 1))) + (murk-display-notice nil "Use /HELP COMMAND to display information about a specific command."))) + +(defun murk-command-debug (params) + (setq murk-debug + (if params + (if (equal (upcase (car params)) "ON") + t + nil) + (not murk-debug))) + (murk-display-notice nil "Debug mode now " (if murk-debug "on" "off") ".")) + +(defun murk-command-clear (params) + (if (not params) + (murk-clear-buffer) + (dolist (context params) + (murk-clear-context context)))) + + +;;; Command entering +;; + +(defun murk-enter-string (string) + (if (string-prefix-p "/" string) + (pcase string + ((rx (: "/" (let cmd-str (+ (not whitespace))) + (opt (+ whitespace) + (let params-str (+ anychar)) + string-end))) + (let ((command-row (assoc (upcase cmd-str) murk-command-table #'equal)) + (params (if params-str + (split-string params-str nil t) + nil))) + (if (and command-row (elt command-row 2)) + (funcall (elt command-row 2) params) + (murk-send-msg (murk-msg nil nil (upcase cmd-str) params))))) + (_ + (murk-display-error "Badly formed command."))) + (unless (string-empty-p string) + (if (murk-current-context) + (progn + (murk-send-msg server + (murk-msg nil nil "PRIVMSG" + (murk-context-name murk-current-context) + string)) + (murk-display-message murk-nick (murk-context->string (murk-current-context)) string)) + (murk-display-error "No current context."))))) + + +;;; Command history +;; + +(defvar murk-history nil + "Commands and messages sent in current session.") + +(defvar murk-history-index nil) + +(defun murk-history-cycle (delta) + (when murk-history + (with-current-buffer "*murk*" + (if murk-history-index + (setq murk-history-index + (max 0 + (min (- (length murk-history) 1) + (+ delta murk-history-index)))) + (setq murk-history-index 0)) + (delete-region murk-input-marker (point-max)) + (insert (elt murk-history murk-history-index))))) + + +;;; Interactive commands +;; + +(defun murk-enter () + "Enter current contents of line after prompt." + (interactive) + (with-current-buffer "*murk*" + (let ((line (buffer-substring murk-input-marker (point-max)))) + (push line murk-history) + (setq murk-history-index nil) + (let ((inhibit-read-only t)) + (delete-region murk-input-marker (point-max))) + (murk-enter-string line)))) + ;;; Mode ;; -- 2.20.1 From 30495c6848dbe16c24aceaef5db425295bdc63ae Mon Sep 17 00:00:00 2001 From: plugd Date: Sat, 18 May 2024 22:39:57 +0200 Subject: [PATCH 02/16] First connection. --- murk.el | 59 ++++++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 56 insertions(+), 3 deletions(-) diff --git a/murk.el b/murk.el index 6ae7519..649350a 100644 --- a/murk.el +++ b/murk.el @@ -44,7 +44,8 @@ "Default quit message when none supplied.") (defcustom murk-networks - '(("libera" "irc.libera.chat" 6697) + '(("debug" "localhost" 6667 :notls) + ("libera" "irc.libera.chat" 6697) ("tilde" "tilde.chat" 6697)) "IRC networks.") @@ -133,7 +134,7 @@ This includes the process and the response string.") "\n")) (if (string-suffix-p "\r" line) (murk-eval-msg-string server (string-trim line)) - (murk-set-connection-response line))))) + (murk-set-connection-response server line))))) (defun murk-make-server-sentinel (server) (lambda (proc string) @@ -173,7 +174,7 @@ 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 + (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))))) @@ -521,6 +522,12 @@ The head of this list is always the current context.") ("HELP" "Display help on client commands." murk-command-help murk-help-completions)) "Table of commands explicitly supported by murk.") +(defun murk-boolean-completions () + '("on" "off")) + +(defun murk-network-completions () + (mapcar (lambda (row) (car row)) murk-networks)) + (defun murk-command-help (params) (if params (let* ((cmd-str (upcase (car params))) @@ -550,6 +557,23 @@ The head of this list is always the current context.") (dolist (context params) (murk-clear-context context)))) +(defun murk-command-connect (params) + (if params + (let ((network (car params))) + (murk-display-notice nil "Attempting to connect to " network "...") + (murk-connect network)) + (murk-display-notice nil "Usage: /connect "))) + +(defun murk-command-networks (params) + (murk-display-notice nil "Currently-known networks:") + (dolist (row murk-networks) + (seq-let (network server port &rest others) row + (murk-display-notice nil "\t" network + " [" server + " " (number-to-string port) "]"))) + (murk-display-notice nil "(Modify the `murk-networks' variable to add more.)")) + + ;;; Command entering ;; @@ -616,6 +640,35 @@ The head of this list is always the current context.") (delete-region murk-input-marker (point-max))) (murk-enter-string line)))) +(defun murk-complete-input () + (interactive) + (let ((completion-ignore-case t)) + (when (>= (point) murk-input-marker) + (pcase (buffer-substring murk-input-marker (point)) + ((rx (: "/" (let cmd-str (+ (not whitespace))) (+ " ") (* (not whitespace)) string-end)) + (let ((space-idx (save-excursion + (re-search-backward " " murk-input-marker t))) + (table-row (assoc (upcase cmd-str) murk-command-table #'equal))) + (if (and table-row (elt table-row 3)) + (let* ((completions-nospace (funcall (elt table-row 3))) + (completions (mapcar (lambda (el) (concat el " ")) completions-nospace))) + (completion-in-region (+ 1 space-idx) (point) completions))))) + ((rx (: "/" (* (not whitespace)) string-end)) + (message (buffer-substring murk-input-marker (point))) + (completion-in-region murk-input-marker (point) + (mapcar (lambda (row) (concat "/" (car row) " ")) + murk-command-table))) + (_ + (let* ((end (max murk-input-marker (point))) + (space-idx (save-excursion + (re-search-backward " " murk-input-marker t))) + (start (if space-idx (+ 1 space-idx) murk-input-marker))) + (unless (string-prefix-p "/" (buffer-substring start end)) + (let* ((users (murk-get-context-users murk-current-context)) + (users-no@ (mapcar + (lambda (u) (car (split-string u "@" t))) + users))) + (completion-in-region start end users-no@))))))))) ;;; Mode ;; -- 2.20.1 From c89c5c26b8b189dee352847671e6701368350717 Mon Sep 17 00:00:00 2001 From: plugd Date: Sat, 18 May 2024 23:35:11 +0200 Subject: [PATCH 03/16] Context creation/deletion --- murk.el | 39 +++++++++++++++++++++++++++++++++------ 1 file changed, 33 insertions(+), 6 deletions(-) diff --git a/murk.el b/murk.el index 649350a..59f7606 100644 --- a/murk.el +++ b/murk.el @@ -140,7 +140,7 @@ This includes the process and the response string.") (lambda (proc string) (unless (equal "open" (string-trim string)) (murk-display-error "Disconnected from server.") - (murk-remove-contexts-for-server server) + (murk-remove-server-contexts server) (murk-render-prompt) (murk-connection-close server)))) @@ -177,7 +177,8 @@ This includes the process and the response string.") (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-send-msg server (murk-msg nil nil "NICK" murk-nick)) + (murk-add-context (list server))))) (defun murk-send-msg (server msg) (if murk-debug @@ -279,6 +280,13 @@ The head of this list is always the current context.") (defun murk-context-server (ctx) (elt ctx 0)) (defun murk-context-name (ctx) (elt ctx 1)) +(defun murk-add-context (ctx) + (add-to-list 'murk-contexts ctx)) + +(defun murk-remove-server-contexts (server) + (setq murk-contexts + (assoc-delete-all server murk-contexts))) + ;;; Buffer ;; @@ -298,8 +306,8 @@ 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)) - "")) + (concat (murk-context-name) "@" (murk-context-server ctx)) + "")) 'face 'murk-context 'read-only t) (propertize murk-prompt-string @@ -573,7 +581,14 @@ The head of this list is always the current context.") " " (number-to-string port) "]"))) (murk-display-notice nil "(Modify the `murk-networks' variable to add more.)")) - +(defun murk-command-quit (params) + (let ((ctx (murk-current-context))) + (if (not ctx) + (murk-display-error "No 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)))))) ;;; Command entering ;; @@ -591,7 +606,9 @@ The head of this list is always the current context.") nil))) (if (and command-row (elt command-row 2)) (funcall (elt command-row 2) params) - (murk-send-msg (murk-msg nil nil (upcase cmd-str) params))))) + (murk-send-msg + (murk-context-server (murk-current-context)) + (murk-msg nil nil (upcase cmd-str) params))))) (_ (murk-display-error "Badly formed command."))) (unless (string-empty-p string) @@ -640,6 +657,14 @@ The head of this list is always the current context.") (delete-region murk-input-marker (point-max))) (murk-enter-string line)))) +(defun murk-history-next () + (interactive) + (murk-history-cycle -1)) + +(defun murk-history-prev () + (interactive) + (murk-history-cycle +1)) + (defun murk-complete-input () (interactive) (let ((completion-ignore-case t)) @@ -677,6 +702,8 @@ The head of this list is always the current context.") (let ((map (make-sparse-keymap))) (define-key map (kbd "RET") 'murk-enter) (define-key map (kbd "TAB") 'murk-complete-input) + (define-key map (kbd "") 'murk-history-prev) + (define-key map (kbd "") 'murk-history-next) (when (fboundp 'evil-define-key*) (evil-define-key* 'motion map (kbd "TAB") 'murk-complete-input)) -- 2.20.1 From 266f254c2ea3dc544bf5d13dbc5e30f2f6d361b5 Mon Sep 17 00:00:00 2001 From: plugd Date: Sun, 19 May 2024 15:31:09 +0200 Subject: [PATCH 04/16] Joining and parting channels. --- murk.el | 128 ++++++++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 106 insertions(+), 22 deletions(-) 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 ;; -- 2.20.1 From 14e7306e9457469d704d364ccc753189244adff4 Mon Sep 17 00:00:00 2001 From: plugd Date: Sun, 19 May 2024 16:11:54 +0200 Subject: [PATCH 05/16] Added header. --- murk.el | 32 ++++++++++++++++++++++++++++++-- 1 file changed, 30 insertions(+), 2 deletions(-) diff --git a/murk.el b/murk.el index 652b3c2..fb79061 100644 --- a/murk.el +++ b/murk.el @@ -300,6 +300,7 @@ The head of this list is always the current context.") (defun murk-context-server (ctx) (elt ctx 0)) (defun murk-context-name (ctx) (elt ctx 1)) +(defun murk-context-users (ctx) (seq-drop ctx 2)) (defun murk-server-context-p (ctx) (not (cdr ctx))) (defun murk-add-context (ctx) @@ -366,8 +367,24 @@ The head of this list is always the current context.") "Marker for prompt position in murk buffer.") (defun murk-setup-header () - ;; To do - ) + (with-current-buffer "*murk*" + (setq-local header-line-format + '((:eval + (let* ((ctx (murk-current-context))) + (if ctx + (let ((server (murk-context-server ctx))) + (concat + "Network: " server ", " + (if (murk-server-context-p ctx) + "Server" + (concat + "Channel: " + (murk-context-name ctx) + " (" + (number-to-string + (length (murk-context-users ctx))) + ")")))) + "No connection"))))))) (defun murk-setup-buffer () (with-current-buffer (get-buffer-create "*murk*") @@ -626,6 +643,17 @@ The head of this list is always the current context.") (not murk-debug))) (murk-display-notice nil "Debug mode now " (if murk-debug "on" "off") ".")) +(defun murk-command-header (params) + (if + (if params + (equal (upcase (car params)) "ON") + (not header-line-format)) + (progn + (murk-setup-header) + (murk-display-notice nil "Header enabled.")) + (setq-local header-line-format nil) + (murk-display-notice nil "Header disabled."))) + (defun murk-command-clear (params) (if (not params) (murk-clear-buffer) -- 2.20.1 From b91c95a6e7a26c70e794ea0acd862cc43e5b8a52 Mon Sep 17 00:00:00 2001 From: plugd Date: Sun, 19 May 2024 21:10:39 +0200 Subject: [PATCH 06/16] Messages kinda working. --- murk.el | 71 ++++++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 68 insertions(+), 3 deletions(-) diff --git a/murk.el b/murk.el index fb79061..e89df65 100644 --- a/murk.el +++ b/murk.el @@ -323,6 +323,13 @@ The head of this list is always the current context.") (concat (murk-context-name ctx) "@" (murk-context-server ctx)))) +(defun murk-get-context (server &optional name) + (if name + (assoc server murk-contexts) + (let ((test-ctx (list server name))) + (seq-find (lambda (ctx) + (equal (seq-take ctx 2) test-ctx)) + murk-contexts)))) ;;; Buffer ;; @@ -450,6 +457,17 @@ The head of this list is always the current context.") 'invisible context-atom))))))) (murk-scroll-windows-to-last-line)) +(defun murk-display-message (server from to text) + (let ((context (if (string-prefix-p "#" to) + (murk-get-context server to) + (murk-get-context server)))) + (murk-display-string + context + (if (murk-server-context-p context) + (concat "[" from " -> " to "]") + (concat (murk-context->string context) " <" from ">")) + text))) + (defun murk-display-notice (context &rest notices) (murk-display-string context @@ -594,6 +612,40 @@ The head of this list is always the current context.") (if murk-show-joins (murk-display-notice nil nick " quit: " reason)))) + ("PRIVMSG" + (let* ((from (murk-msg-src msg)) + (params (murk-msg-params msg)) + (to (car params)) + (text (cadr params))) + (pcase text + ("\01VERSION\01" + (let ((version-string (concat murk-version " - running on GNU Emacs " emacs-version))) + (murk-send-msg server + (murk-msg nil nil "NOTICE" + (list from (concat "\01VERSION " + version-string + "\01"))))) + (murk-display-notice nil "CTCP version request received from " + from " on " server)) + + ((rx (let ping (: "\01PING " (* (not "\01")) "\01"))) + (murk-send-msg server (lurk-msg nil nil "NOTICE" (list from ping))) + (murk-display-notice nil "CTCP ping received from " from " on " server)) + + ("\01USERINFO\01" + (murk-display-notice nil "CTCP userinfo request from " from + " on " server " (no response sent)")) + + ("\01CLIENTINFO\01" + (murk-display-notice nil "CTCP clientinfo request from " from + " on " server " (no response sent)")) + + ((rx (: "\01ACTION " (let action-text (* (not "\01"))) "\01")) + (murk-display-action from to action-text)) + + (_ + (murk-display-message server from to text))))) + (_ (murk-display-notice nil (murk-msg->string msg)))))) @@ -701,6 +753,16 @@ The head of this list is always the current context.") (murk-send-msg server (murk-msg nil nil "PART" channel)) (murk-display-error "No current channel to leave.")))) +(defun murk-command-msg (params) + (let ((server (murk-context-server (murk-current-context)))) + (if (and params (>= (length params) 2)) + (let ((to (car params)) + (text (string-join (cdr params) " "))) + (murk-send-msg server (lurk-msg nil nil "PRIVMSG" to text)) + (murk-display-message server + (murk-connection-nick server) + to text)) + (murk-display-notice nil "Usage: /msg ")))) ;;; Command entering ;; @@ -725,12 +787,15 @@ The head of this list is always the current context.") (murk-display-error "Badly formed command."))) (unless (string-empty-p string) (if (murk-current-context) - (progn + (let ((server (murk-context-server (murk-current-context)))) (murk-send-msg server (murk-msg nil nil "PRIVMSG" - (murk-context-name murk-current-context) + (murk-context-name (murk-current-context)) string)) - (murk-display-message murk-nick (murk-context->string (murk-current-context)) string)) + (murk-display-message server + murk-nick + (murk-context->string (murk-current-context)) + string)) (murk-display-error "No current context."))))) -- 2.20.1 From 9688a3bb91381e49434bc238b7ecbd2396142c85 Mon Sep 17 00:00:00 2001 From: plugd Date: Sun, 19 May 2024 21:47:01 +0200 Subject: [PATCH 07/16] Lots of tiny fixes. Thanks flycheck! --- murk.el | 67 ++++++++++++++++++++++++++++++++++----------------------- 1 file changed, 40 insertions(+), 27 deletions(-) diff --git a/murk.el b/murk.el index e89df65..a10fb2f 100644 --- a/murk.el +++ b/murk.el @@ -38,19 +38,23 @@ :group 'network) (defcustom murk-default-nick "plugd" - "Default nick.") + "Default nick." + :type '(string)) (defcustom murk-default-quit-msg "Bye" - "Default quit message when none supplied.") + "Default quit message when none supplied." + :type '(string)) (defcustom murk-networks '(("debug" "localhost" 6667 :notls) ("libera" "irc.libera.chat" 6697) ("tilde" "tilde.chat" 6697)) - "IRC networks.") + "IRC networks." + :type '(alist :key-type string)) (defcustom murk-display-header t - "If non-nil, use buffer header to display information on current host and channel.") + "If non-nil, use buffer header to display current host and channel." + :type '(boolean)) ;;; Faces @@ -141,7 +145,7 @@ This includes the process and the response string.") (setq murk-connection-table (assoc-delete-all server murk-connection-table))) (defun murk-make-server-filter (server) - (lambda (proc string) + (lambda (_proc string) (dolist (line (split-string (concat (murk-connection-response server) string) "\n")) (if (string-suffix-p "\r" line) @@ -149,7 +153,7 @@ This includes the process and the response string.") (murk-set-connection-response server line))))) (defun murk-make-server-sentinel (server) - (lambda (proc string) + (lambda (_proc string) (unless (equal "open" (string-trim string)) (murk-display-error "Disconnected from server.") (murk-connection-remove server) @@ -182,7 +186,7 @@ This includes the process and the response string.") (defun murk-connect (server) (if (assoc server murk-connection-table) - (murk-display-error "Already connected to this network.") + (murk-display-error "Already connected to this network") (if (not (assoc server murk-networks)) (murk-display-error "Network '" server "' is unknown.") (let ((proc (murk-start-process server))) @@ -198,7 +202,7 @@ 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.")))) + (murk-display-error "No server connection established")))) ;;; Server messages @@ -250,7 +254,7 @@ portion of the source component of the message, as mURK doesn't use this.") (append l r)) nil))) (apply #'murk-msg (append (list tags src cmd) params))) - (error "Failed to parse string " string))) + (error "Failed to parse string %s" string))) (defun murk-msg->string (msg) (let ((tags (murk-msg-tags msg)) @@ -331,9 +335,24 @@ The head of this list is always the current context.") (equal (seq-take ctx 2) test-ctx)) murk-contexts)))) +(defun murk-cycle-contexts (&optional reverse) + (setq murk-contexts + (if reverse + (let ((nminus1 (- (length murk-contexts) 1))) + (cons + (elt murk-contexts nminus1) + (seq-take murk-contexts nminus1))) + (append (cdr murk-contexts) (list (car murk-contexts)))))) + ;;; Buffer ;; +(defvar murk-prompt-marker nil + "Marker for prompt position in murk buffer.") + +(defvar murk-input-marker nil + "Marker for prompt position in murk buffer.") + (defun murk-render-prompt () (with-current-buffer "*murk*" (let ((update-point (= murk-input-marker (point))) @@ -367,12 +386,6 @@ The head of this list is always the current context.") (if (car v) (set-window-point (cadr v) murk-input-marker)))))) -(defvar murk-prompt-marker nil - "Marker for prompt position in murk buffer.") - -(defvar murk-input-marker nil - "Marker for prompt position in murk buffer.") - (defun murk-setup-header () (with-current-buffer "*murk*" (setq-local header-line-format @@ -493,8 +506,6 @@ The head of this list is always the current context.") (with-selected-window window (recenter -1)))))) - - (defconst murk-url-regex (rx (: (group (+ alpha)) @@ -629,7 +640,7 @@ The head of this list is always the current context.") from " on " server)) ((rx (let ping (: "\01PING " (* (not "\01")) "\01"))) - (murk-send-msg server (lurk-msg nil nil "NOTICE" (list from ping))) + (murk-send-msg server (murk-msg nil nil "NOTICE" (list from ping))) (murk-display-notice nil "CTCP ping received from " from " on " server)) ("\01USERINFO\01" @@ -719,10 +730,10 @@ The head of this list is always the current context.") (murk-connect network)) (murk-display-notice nil "Usage: /connect "))) -(defun murk-command-networks (params) +(defun murk-command-networks (_params) (murk-display-notice nil "Currently-known networks:") (dolist (row murk-networks) - (seq-let (network server port &rest others) row + (seq-let (network server port &rest _others) row (murk-display-notice nil "\t" network " [" server " " (number-to-string port) "]"))) @@ -731,7 +742,7 @@ The head of this list is always the current context.") (defun murk-command-quit (params) (let ((ctx (murk-current-context))) (if (not ctx) - (murk-display-error "No current context.") + (murk-display-error "No current context") (let ((quit-msg (if params (string-join params " ") murk-default-quit-msg))) (murk-send-msg (murk-context-server ctx) @@ -751,14 +762,14 @@ The head of this list is always the current context.") (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.")))) + (murk-display-error "No current channel to leave")))) (defun murk-command-msg (params) (let ((server (murk-context-server (murk-current-context)))) (if (and params (>= (length params) 2)) (let ((to (car params)) (text (string-join (cdr params) " "))) - (murk-send-msg server (lurk-msg nil nil "PRIVMSG" to text)) + (murk-send-msg server (murk-msg nil nil "PRIVMSG" to text)) (murk-display-message server (murk-connection-nick server) to text)) @@ -784,7 +795,7 @@ The head of this list is always the current context.") (murk-context-server (murk-current-context)) (murk-msg nil nil (upcase cmd-str) params))))) (_ - (murk-display-error "Badly formed command."))) + (murk-display-error "Badly formed command"))) (unless (string-empty-p string) (if (murk-current-context) (let ((server (murk-context-server (murk-current-context)))) @@ -793,10 +804,10 @@ The head of this list is always the current context.") (murk-context-name (murk-current-context)) string)) (murk-display-message server - murk-nick + (murk-connection-nick server) (murk-context->string (murk-current-context)) string)) - (murk-display-error "No current context."))))) + (murk-display-error "No current context"))))) ;;; Command history @@ -866,7 +877,7 @@ The head of this list is always the current context.") (re-search-backward " " murk-input-marker t))) (start (if space-idx (+ 1 space-idx) murk-input-marker))) (unless (string-prefix-p "/" (buffer-substring start end)) - (let* ((users (murk-get-context-users murk-current-context)) + (let* ((users (murk-get-context-users (murk-current-context))) (users-no@ (mapcar (lambda (u) (car (split-string u "@" t))) users))) @@ -881,6 +892,8 @@ The head of this list is always the current context.") (define-key map (kbd "TAB") 'murk-complete-input) (define-key map (kbd "") 'murk-history-prev) (define-key map (kbd "") 'murk-history-next) + (define-key map (kbd "") 'murk-cycle-contexts-forward) + (define-key map (kbd "") 'murk-cycle-contexts-reverse) (when (fboundp 'evil-define-key*) (evil-define-key* 'motion map (kbd "TAB") 'murk-complete-input)) -- 2.20.1 From f804b7fc5edcfd10f9d930c73d78de87c625d195 Mon Sep 17 00:00:00 2001 From: plugd Date: Sun, 19 May 2024 22:23:15 +0200 Subject: [PATCH 08/16] Sticking with 26.1 compatibility --- murk.el | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/murk.el b/murk.el index a10fb2f..6f6fdc0 100644 --- a/murk.el +++ b/murk.el @@ -1,13 +1,13 @@ -;;; MURK --- Multiserver Unibuffer iRc Klient -*- lexical-binding:t -*- +;;; murk.el --- Multiserver Unibuffer iRc Klient -*- lexical-binding:t -*- ;; Copyright (C) 2024 plugd ;; Author: plugd ;; Created: 11 May 2024 ;; Version: 0.0 -;; Keywords: network ;; Homepage: http://thelambdalab.xyz/murk -;; Package-Requires: ((emacs "26")) +;; Keywords: comm +;; Package-Requires: ((emacs "26.1")) ;; This file is not part of GNU Emacs. @@ -26,6 +26,8 @@ ;;; Commentary: +;; A very simple IRC server which uses only a single buffer. + ;;; Code: (provide 'murk) @@ -142,7 +144,9 @@ This includes the process and the response string.") (list server process nick ""))) (defun murk-connection-remove (server) - (setq murk-connection-table (assoc-delete-all server murk-connection-table))) + (setq murk-connection-table + (seq-remove (lambda (row) (equal (car row) server)) + murk-connection-table))) (defun murk-make-server-filter (server) (lambda (_proc string) @@ -248,7 +252,7 @@ portion of the source component of the message, as mURK doesn't use this.") (params-str (match-string 4 string)) (params (if params-str - (let* ((idx (cl-search ":" params-str)) + (let* ((idx (seq-position params-str ?:)) (l (split-string (string-trim (substring params-str 0 idx)))) (r (if idx (list (substring params-str (+ 1 idx))) nil))) (append l r)) @@ -319,7 +323,8 @@ The head of this list is always the current context.") (defun murk-remove-server-contexts (server) (setq murk-contexts - (assoc-delete-all server murk-contexts))) + (seq-remove (lambda (row) (equal (car row) server)) + murk-contexts))) (defun murk-context->string (ctx) (if (murk-server-context-p ctx) @@ -918,5 +923,4 @@ The head of this list is always the current context.") (murk-setup-buffer)) "Started murk.") - ;;; murk.el ends here -- 2.20.1 From 606ea58e42a37ccf3c5c35c5613ee7e175e20083 Mon Sep 17 00:00:00 2001 From: plugd Date: Mon, 20 May 2024 00:13:11 +0200 Subject: [PATCH 09/16] Added channel user name handling. --- murk.el | 104 ++++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 74 insertions(+), 30 deletions(-) diff --git a/murk.el b/murk.el index 6f6fdc0..035c358 100644 --- a/murk.el +++ b/murk.el @@ -32,6 +32,8 @@ (provide 'murk) +(require 'cl-lib) + ;;; Customizations @@ -50,7 +52,8 @@ (defcustom murk-networks '(("debug" "localhost" 6667 :notls) ("libera" "irc.libera.chat" 6697) - ("tilde" "tilde.chat" 6697)) + ("tilde" "tilde.chat" 6697) + ("freenode" "chat.freenode.net" 6697)) "IRC networks." :type '(alist :key-type string)) @@ -277,14 +280,14 @@ portion of the source component of the message, as mURK doesn't use this.") nil)))) -;;; Contexts and Servers +;;; Contexts ;; -;; A context is a list (server name ...) where name is a string -;; representing either a channel name or nick, and server is a symbol -;; identifying the server. +;; A context is a list (server channel users) identifying the server +;; and channel. The tail of the list contains the nicks of users +;; present in the channel. ;; -;; Each server has a special context (server nil) used for messages +;; Each server has a special context (server) used for messages ;; to/from the server itself. (defvar murk-contexts nil @@ -292,7 +295,7 @@ portion of the source component of the message, as mURK doesn't use this.") The head of this list is always the current context.") (defun murk-current-context () - "Returns the current context." + "Return the current context." (if murk-contexts (car murk-contexts) nil)) @@ -307,8 +310,10 @@ The head of this list is always the current context.") (seq-take c2 2))))) (defun murk-context-server (ctx) (elt ctx 0)) -(defun murk-context-name (ctx) (elt ctx 1)) -(defun murk-context-users (ctx) (seq-drop ctx 2)) +(defun murk-context-channel (ctx) (elt ctx 1)) +(defun murk-context-users (ctx) (elt ctx 2)) +(defun murk-set-context-users (ctx users) + (setcar (cddr ctx) users)) (defun murk-server-context-p (ctx) (not (cdr ctx))) (defun murk-add-context (ctx) @@ -329,16 +334,16 @@ The head of this list is always the current context.") (defun murk-context->string (ctx) (if (murk-server-context-p ctx) (concat "[" (murk-context-server ctx) "]") - (concat (murk-context-name ctx) "@" + (concat (murk-context-channel ctx) "@" (murk-context-server ctx)))) (defun murk-get-context (server &optional name) (if name - (assoc server murk-contexts) - (let ((test-ctx (list server name))) - (seq-find (lambda (ctx) - (equal (seq-take ctx 2) test-ctx)) - murk-contexts)))) + (let ((test-ctx (list server name))) + (seq-find (lambda (ctx) + (equal (seq-take ctx 2) test-ctx)) + murk-contexts)) + (assoc server murk-contexts))) (defun murk-cycle-contexts (&optional reverse) (setq murk-contexts @@ -349,6 +354,11 @@ The head of this list is always the current context.") (seq-take murk-contexts nminus1))) (append (cdr murk-contexts) (list (car murk-contexts)))))) +(defun murk-add-context-users (ctx users) + (murk-set-context-users + ctx + (cl-union users (murk-context-users ctx)))) + ;;; Buffer ;; @@ -404,7 +414,7 @@ The head of this list is always the current context.") "Server" (concat "Channel: " - (murk-context-name ctx) + (murk-context-channel ctx) " (" (number-to-string (length (murk-context-users ctx))) @@ -601,6 +611,28 @@ The head of this list is always the current context.") (murk-set-connection-nick server nick) (murk-display-notice nil text))) + ("353" ; NAMEREPLY + (let* ((params (murk-msg-params msg)) + (channel (elt params 2)) + (names (split-string (elt params 3))) + (ctx (murk-get-context server channel))) + (if ctx + (murk-add-context-users ctx names) + (murk-display-notice nil "Users in " channel + ": " (string-join names " "))))) + + ("366" ; ENDOFNAMES + (let* ((params (murk-msg-params msg)) + (channel (elt params 1)) + (ctx (murk-get-context server channel))) + (if ctx + (murk-display-notice + ctx + (murk--as-string (length (murk-context-users ctx))) + " users in " channel) + (murk-display-notice nil "End of " channel " names list.")))) + + ((rx (= 3 (any digit))) (murk-display-notice nil (mapconcat 'identity (cdr (murk-msg-params msg)) " "))) @@ -608,7 +640,7 @@ The head of this list is always the current context.") (guard (equal (murk-connection-nick server) (murk-msg-src msg)))) (let ((channel (car (murk-msg-params msg)))) - (murk-add-context (list server channel)) + (murk-add-context (list server channel nil)) (murk-display-notice (murk-current-context) "Joining channel " channel " on " server) (murk-render-prompt))) @@ -764,7 +796,7 @@ The head of this list is always the current context.") (let* ((server (murk-context-server (murk-current-context))) (channel (if params (car params) - (murk-context-name (murk-current-context))))) + (murk-context-channel (murk-current-context))))) (if channel (murk-send-msg server (murk-msg nil nil "PART" channel)) (murk-display-error "No current channel to leave")))) @@ -802,17 +834,18 @@ The head of this list is always the current context.") (_ (murk-display-error "Badly formed command"))) (unless (string-empty-p string) - (if (murk-current-context) - (let ((server (murk-context-server (murk-current-context)))) - (murk-send-msg server - (murk-msg nil nil "PRIVMSG" - (murk-context-name (murk-current-context)) - string)) - (murk-display-message server - (murk-connection-nick server) - (murk-context->string (murk-current-context)) - string)) - (murk-display-error "No current context"))))) + (let ((ctx (murk-current-context))) + (if ctx + (if (not (murk-server-context-p ctx)) + (let ((server (murk-context-server ctx)) + (channel (murk-context-channel ctx))) + (murk-send-msg server + (murk-msg nil nil "PRIVMSG" channel string)) + (murk-display-message server + (murk-connection-nick server) + channel string)) + (murk-display-error "No current channel")) + (murk-display-error "No current context")))))) ;;; Command history @@ -858,6 +891,16 @@ The head of this list is always the current context.") (interactive) (murk-history-cycle +1)) +(defun murk-cycle-contexts-forward () + (interactive) + (murk-cycle-contexts) + (murk-render-prompt)) + +(defun murk-cycle-contexts-reverse () + (interactive) + (murk-cycle-contexts t) + (murk-render-prompt)) + (defun murk-complete-input () (interactive) (let ((completion-ignore-case t)) @@ -882,7 +925,7 @@ The head of this list is always the current context.") (re-search-backward " " murk-input-marker t))) (start (if space-idx (+ 1 space-idx) murk-input-marker))) (unless (string-prefix-p "/" (buffer-substring start end)) - (let* ((users (murk-get-context-users (murk-current-context))) + (let* ((users (murk-context-users (murk-current-context))) (users-no@ (mapcar (lambda (u) (car (split-string u "@" t))) users))) @@ -898,6 +941,7 @@ The head of this list is always the current context.") (define-key map (kbd "") 'murk-history-prev) (define-key map (kbd "") 'murk-history-next) (define-key map (kbd "") 'murk-cycle-contexts-forward) + (define-key map (kbd "") 'murk-cycle-contexts-reverse) (define-key map (kbd "") 'murk-cycle-contexts-reverse) (when (fboundp 'evil-define-key*) (evil-define-key* 'motion map -- 2.20.1 From af0002ab9d15c31a8286dcbd8335e0637eae5d9c Mon Sep 17 00:00:00 2001 From: plugd Date: Mon, 20 May 2024 00:19:49 +0200 Subject: [PATCH 10/16] Reinstated topic messages. --- murk.el | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/murk.el b/murk.el index 035c358..ffe10e6 100644 --- a/murk.el +++ b/murk.el @@ -632,6 +632,18 @@ The head of this list is always the current context.") " users in " channel) (murk-display-notice nil "End of " channel " names list.")))) + ("331" + (let* ((params (murk-msg-params msg)) + (channel (elt params 1)) + (ctx (murk-get-context server channel))) + (murk-display-notice ctx "No topic set."))) + + ("332" + (let* ((params (murk-msg-params msg)) + (channel (elt params 1)) + (topic (elt params 2)) + (ctx (murk-get-context server channel))) + (murk-display-notice ctx "Topic: " topic))) ((rx (= 3 (any digit))) (murk-display-notice nil (mapconcat 'identity (cdr (murk-msg-params msg)) " "))) -- 2.20.1 From 191b189b97915566a5fee5fcde4dd3f88e67bf61 Mon Sep 17 00:00:00 2001 From: plugd Date: Mon, 20 May 2024 00:38:05 +0200 Subject: [PATCH 11/16] Joins/parts update context users. --- murk.el | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) diff --git a/murk.el b/murk.el index ffe10e6..2e89982 100644 --- a/murk.el +++ b/murk.el @@ -57,6 +57,9 @@ "IRC networks." :type '(alist :key-type string)) +(defcustom murk-show-joins nil + "Set to non-nil to be notified of joins, parts and quits.") + (defcustom murk-display-header t "If non-nil, use buffer header to display current host and channel." :type '(boolean)) @@ -359,6 +362,11 @@ The head of this list is always the current context.") ctx (cl-union users (murk-context-users ctx)))) +(defun murk-del-context-user (ctx user) + (murk-set-context-users + ctx + (delete user (murk-context-users ctx)))) + ;;; Buffer ;; @@ -657,6 +665,15 @@ The head of this list is always the current context.") "Joining channel " channel " on " server) (murk-render-prompt))) + ("JOIN" + (let* ((channel (car (murk-msg-params msg))) + (nick (murk-msg-src msg)) + (ctx (murk-get-context server channel))) + (murk-add-context-users ctx (list nick)) + (if murk-show-joins + (murk-display-notice ctx nick " joined channel " channel + " on " server)))) + ((and "PART" (guard (equal (murk-connection-nick server) (murk-msg-src msg)))) @@ -665,6 +682,15 @@ The head of this list is always the current context.") (murk-remove-context (list server channel)) (murk-render-prompt))) + ("PART" + (let* ((channel (car (lurk-msg-params msg))) + (nick (lurk-msg-src msg)) + (ctx (murk-get-context server channel))) + (murk-del-context-user ctx nick) + (if murk-show-joins + (murk-display-notice ctx nick " left channel " channel + " on " server)))) + ("QUIT" (let ((nick (murk-msg-src msg)) (reason (mapconcat 'identity (murk-msg-params msg) " "))) @@ -715,6 +741,7 @@ 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) + ("SHOWJOINS" "Toggles display of joins/parts." murk-command-showjoins murk-boolean-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) @@ -766,6 +793,16 @@ The head of this list is always the current context.") (setq-local header-line-format nil) (murk-display-notice nil "Header disabled."))) +(defun murk-command-showjoins (params) + (setq murk-show-joins + (if params + (if (equal (upcase (car params)) "ON") + t + nil) + (not murk-show-joins))) + (murk-display-notice nil "Joins/parts will now be " + (if murk-show-joins "shown" "hidden") ".")) + (defun murk-command-clear (params) (if (not params) (murk-clear-buffer) -- 2.20.1 From 495ea20a42124357ac700844baaa720dd612c56e Mon Sep 17 00:00:00 2001 From: plugd Date: Mon, 20 May 2024 12:49:21 +0200 Subject: [PATCH 12/16] Added /nick, /topic and /list --- murk.el | 102 ++++++++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 89 insertions(+), 13 deletions(-) diff --git a/murk.el b/murk.el index 2e89982..9ca5e2a 100644 --- a/murk.el +++ b/murk.el @@ -50,7 +50,7 @@ :type '(string)) (defcustom murk-networks - '(("debug" "localhost" 6667 :notls) + '(("debug" "localhost" 6697) ("libera" "irc.libera.chat" 6697) ("tilde" "tilde.chat" 6697) ("freenode" "chat.freenode.net" 6697)) @@ -367,6 +367,18 @@ The head of this list is always the current context.") ctx (delete user (murk-context-users ctx)))) +(defun murk-del-server-user (server user) + (dolist (ctx murk-contexts) + (if (equal (murk-context-server ctx) server) + (murk-del-context-user ctx user)))) + +(defun murk-rename-server-user (server old-nick new-nick) + (dolist (ctx murk-contexts) + (when (and (equal (murk-context-server ctx) server) + (member old-nick (murk-context-users ctx))) + (murk-del-context-user ctx old-nick) + (murk-add-context-users ctx (list new-nick))))) + ;;; Buffer ;; @@ -612,7 +624,7 @@ The head of this list is always the current context.") ("PONG") - ("001" + ("001" ; RPL_WELCOME (let* ((params (murk-msg-params msg)) (nick (elt params 0)) (text (string-join (seq-drop params 1) " "))) @@ -640,13 +652,13 @@ The head of this list is always the current context.") " users in " channel) (murk-display-notice nil "End of " channel " names list.")))) - ("331" + ("331" ; RPL_NOTOPIC (let* ((params (murk-msg-params msg)) (channel (elt params 1)) (ctx (murk-get-context server channel))) (murk-display-notice ctx "No topic set."))) - ("332" + ("332" ; RPL_TOPIC (let* ((params (murk-msg-params msg)) (channel (elt params 1)) (topic (elt params 2)) @@ -683,18 +695,39 @@ The head of this list is always the current context.") (murk-render-prompt))) ("PART" - (let* ((channel (car (lurk-msg-params msg))) - (nick (lurk-msg-src msg)) + (let* ((channel (car (murk-msg-params msg))) + (nick (murk-msg-src msg)) (ctx (murk-get-context server channel))) (murk-del-context-user ctx nick) (if murk-show-joins (murk-display-notice ctx nick " left channel " channel " on " server)))) + ((and "NICK" + (guard (equal (murk-connection-nick server) + (murk-msg-src msg)))) + (let ((new-nick (car (murk-msg-params msg)))) + (murk-set-connection-nick server new-nick) + (murk-display-notice nil "Nick set to " new-nick " on " server))) + + ("NICK" + (let ((old-nick (murk-msg-src msg)) + (new-nick (car (murk-msg-params msg)))) + (murk-display-notice nil old-nick " is now known as " new-nick + " on " server) + (murk-rename-server-user server old-nick new-nick))) + + ("TOPIC" + (let ((channel (car (murk-msg-params msg))) + (nick (murk-msg-src msg)) + (topic (cadr (murk-msg-params msg)))) + (murk-display-notice (murk-get-context server channel) + nick " set the topic: " topic))) + ("QUIT" (let ((nick (murk-msg-src msg)) (reason (mapconcat 'identity (murk-msg-params msg) " "))) - (murk-del-user nick) + (murk-del-server-user server nick) (if murk-show-joins (murk-display-notice nil nick " quit: " reason)))) @@ -748,6 +781,9 @@ The head of this list is always the current context.") ("JOIN" "Join one or more channels." murk-command-join) ("PART" "Leave channel." murk-command-part murk-context-completions) ("NICK" "Change nick." murk-command-nick) + ("LIST" "Display details of one or more channels." murk-command-list) + ("TOPIC" "Set/query topic for current channel." murk-command-topic) + ("USERS" "List nicks of users in current context." murk-command-users) ("MSG" "Send private message to user." murk-command-msg murk-nick-completions) ("CLEAR" "Clear buffer text." murk-command-clear murk-context-completions) ("HELP" "Display help on client commands." murk-command-help murk-help-completions)) @@ -803,12 +839,6 @@ The head of this list is always the current context.") (murk-display-notice nil "Joins/parts will now be " (if murk-show-joins "shown" "hidden") ".")) -(defun murk-command-clear (params) - (if (not params) - (murk-clear-buffer) - (dolist (context params) - (murk-clear-context context)))) - (defun murk-command-connect (params) (if params (let ((network (car params))) @@ -850,6 +880,41 @@ The head of this list is always the current context.") (murk-send-msg server (murk-msg nil nil "PART" channel)) (murk-display-error "No current channel to leave")))) +(defun murk-command-nick (params) + (if params + (let ((new-nick (string-join params " ")) + (ctx (murk-current-context))) + (if ctx + (murk-send-msg (murk-context-server ctx) + (murk-msg nil nil "NICK" new-nick)) + (murk-display-error "No current connection"))) + (murk-display-notice nil "Usage: /nick "))) + +(defun murk-command-list (params) + (let ((ctx (murk-current-context))) + (if ctx + (if (not params) + (murk-display-notice nil "This command can generate lots of output. Use `/LIST -yes' if you really want this, or `/LIST ' to reduce the output.") + (let ((server (murk-context-server ctx))) + (if (equal (upcase (car params)) "-YES") + (murk-send-msg server (murk-msg nil nil "LIST")) + (murk-send-msg server (murk-msg nil nil "LIST" + (car params)))))) + (murk-display-error "No current connection")))) + +(defun murk-command-topic (params) + (let ((ctx (murk-current-context))) + (if (and ctx (not (murk-server-context-p ctx))) + (let ((server (murk-context-server ctx)) + (channel (murk-context-channel ctx))) + (if params + (murk-send-msg server + (murk-msg nil nil "TOPIC" channel + (string-join params " "))) + (murk-send-msg server + (murk-msg nil nil "TOPIC" channel)))) + (murk-display-notice nil "No current channel.")))) + (defun murk-command-msg (params) (let ((server (murk-context-server (murk-current-context)))) (if (and params (>= (length params) 2)) @@ -861,6 +926,17 @@ The head of this list is always the current context.") to text)) (murk-display-notice nil "Usage: /msg ")))) +(defun murk-command-users (_params) + (let ((ctx (murk-current-context))) + (if (and ctx (not (murk-server-context-p ctx))) + (let ((channel (murk-context-channel ctx)) + (server (murk-context-server ctx)) + (users (murk-context-users ctx))) + (murk-display-notice ctx "Users in " channel " on " server ":") + (murk-display-notice ctx (string-join users " "))) + (murk-display-notice nil "No current channel.")))) + + ;;; Command entering ;; -- 2.20.1 From 050c1fe2eeffe1d815c5c84db4e783711b3298ee Mon Sep 17 00:00:00 2001 From: plugd Date: Mon, 20 May 2024 12:52:09 +0200 Subject: [PATCH 13/16] Changing own nick now also updates server users. --- murk.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/murk.el b/murk.el index 9ca5e2a..1903a33 100644 --- a/murk.el +++ b/murk.el @@ -706,8 +706,10 @@ The head of this list is always the current context.") ((and "NICK" (guard (equal (murk-connection-nick server) (murk-msg-src msg)))) - (let ((new-nick (car (murk-msg-params msg)))) + (let ((new-nick (car (murk-msg-params msg))) + (old-nick (murk-connection-nick server))) (murk-set-connection-nick server new-nick) + (murk-rename-server-user server old-nick new-nick) (murk-display-notice nil "Nick set to " new-nick " on " server))) ("NICK" -- 2.20.1 From 5d44f825451c39c26e010eb5bd889469005117d7 Mon Sep 17 00:00:00 2001 From: plugd Date: Mon, 20 May 2024 14:10:05 +0200 Subject: [PATCH 14/16] Implemented actions. --- murk.el | 30 ++++++++++++++++++++++++++++-- 1 file changed, 28 insertions(+), 2 deletions(-) diff --git a/murk.el b/murk.el index 1903a33..e15bc84 100644 --- a/murk.el +++ b/murk.el @@ -346,7 +346,7 @@ The head of this list is always the current context.") (seq-find (lambda (ctx) (equal (seq-take ctx 2) test-ctx)) murk-contexts)) - (assoc server murk-contexts))) + (car (member (list server) murk-contexts)))) (defun murk-cycle-contexts (&optional reverse) (setq murk-contexts @@ -516,6 +516,15 @@ The head of this list is always the current context.") (concat (murk-context->string context) " <" from ">")) text))) +(defun murk-display-action (server from to action-text) + (let ((context (if (string-prefix-p "#" to) + (murk-get-context server to) + (murk-get-context server)))) + (murk-display-string + context + (concat (murk-context->string context) " *") + from " " action-text))) + (defun murk-display-notice (context &rest notices) (murk-display-string context @@ -762,7 +771,7 @@ The head of this list is always the current context.") " on " server " (no response sent)")) ((rx (: "\01ACTION " (let action-text (* (not "\01"))) "\01")) - (murk-display-action from to action-text)) + (murk-display-action server from to action-text)) (_ (murk-display-message server from to text))))) @@ -787,6 +796,7 @@ The head of this list is always the current context.") ("TOPIC" "Set/query topic for current channel." murk-command-topic) ("USERS" "List nicks of users in current context." murk-command-users) ("MSG" "Send private message to user." murk-command-msg murk-nick-completions) + ("ME" "Display action." murk-command-me) ("CLEAR" "Clear buffer text." murk-command-clear murk-context-completions) ("HELP" "Display help on client commands." murk-command-help murk-help-completions)) "Table of commands explicitly supported by murk.") @@ -928,6 +938,22 @@ The head of this list is always the current context.") to text)) (murk-display-notice nil "Usage: /msg ")))) +(defun murk-command-me (params) + (let* ((ctx (murk-current-context)) + (server (murk-context-server ctx))) + (if (and ctx (not (murk-server-context-p ctx))) + (if params + (let* ((channel (murk-context-channel ctx)) + (my-nick (murk-connection-nick server)) + (action (string-join params " ")) + (ctcp-text (concat "\01ACTION " action "\01"))) + (murk-send-msg server + (murk-msg nil nil "PRIVMSG" + (list channel ctcp-text))) + (murk-display-action server my-nick channel action)) + (murk-display-notice nil "Usage: /me ")) + (murk-display-notice nil "No current channel.")))) + (defun murk-command-users (_params) (let ((ctx (murk-current-context))) (if (and ctx (not (murk-server-context-p ctx))) -- 2.20.1 From 9bef2f474186f9fbbcd1a2ad2c3e1f30e0328d3c Mon Sep 17 00:00:00 2001 From: plugd Date: Mon, 20 May 2024 14:35:33 +0200 Subject: [PATCH 15/16] Added context switching primitives. --- murk.el | 40 ++++++++++++++++++++++++++++++++-------- 1 file changed, 32 insertions(+), 8 deletions(-) diff --git a/murk.el b/murk.el index e15bc84..64bc81d 100644 --- a/murk.el +++ b/murk.el @@ -53,7 +53,8 @@ '(("debug" "localhost" 6697) ("libera" "irc.libera.chat" 6697) ("tilde" "tilde.chat" 6697) - ("freenode" "chat.freenode.net" 6697)) + ("freenode" "chat.freenode.net" 6697) + ("mbr" "mbrserver.com" 6667 :notls)) "IRC networks." :type '(alist :key-type string)) @@ -312,12 +313,20 @@ The head of this list is always the current context.") (equal (seq-take c1 2) (seq-take c2 2))))) -(defun murk-context-server (ctx) (elt ctx 0)) -(defun murk-context-channel (ctx) (elt ctx 1)) -(defun murk-context-users (ctx) (elt ctx 2)) +(defun murk-context-server (ctx) + (elt ctx 0)) + +(defun murk-context-channel (ctx) + (elt ctx 1)) + +(defun murk-context-users (ctx) + (elt ctx 2)) + (defun murk-set-context-users (ctx users) (setcar (cddr ctx) users)) -(defun murk-server-context-p (ctx) (not (cdr ctx))) + +(defun murk-server-context-p (ctx) + (not (cdr ctx))) (defun murk-add-context (ctx) (add-to-list 'murk-contexts ctx)) @@ -340,9 +349,17 @@ The head of this list is always the current context.") (concat (murk-context-channel ctx) "@" (murk-context-server ctx)))) -(defun murk-get-context (server &optional name) - (if name - (let ((test-ctx (list server name))) +(defun murk-string->context (string) + (if (not (string-prefix-p "#" string)) + (murk-get-context string) + (let* ((parts (string-split string "@")) + (channel (elt parts 0)) + (server (elt parts 1))) + (murk-get-context server channel)))) + +(defun murk-get-context (server &optional channel) + (if channel + (let ((test-ctx (list server channel))) (seq-find (lambda (ctx) (equal (seq-take ctx 2) test-ctx)) murk-contexts)) @@ -357,6 +374,13 @@ The head of this list is always the current context.") (seq-take murk-contexts nminus1))) (append (cdr murk-contexts) (list (car murk-contexts)))))) +(defun murk-switch-to-context (ctx) + (setq murk-contexts + (let* ((new-head (memq ctx murk-contexts)) + (new-tail (take (- (length murk-contexts) + (length new-head))))) + (append new-head new-tail)))) + (defun murk-add-context-users (ctx users) (murk-set-context-users ctx -- 2.20.1 From 8f9509d726d0d86aae9ab72a7d49f5b9a29d18c4 Mon Sep 17 00:00:00 2001 From: plugd Date: Mon, 20 May 2024 18:17:00 +0200 Subject: [PATCH 16/16] Added ctcp version commands. --- murk.el | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/murk.el b/murk.el index 64bc81d..1014c1e 100644 --- a/murk.el +++ b/murk.el @@ -53,6 +53,7 @@ '(("debug" "localhost" 6697) ("libera" "irc.libera.chat" 6697) ("tilde" "tilde.chat" 6697) + ("sdf" "irc.sdf.org" 6697) ("freenode" "chat.freenode.net" 6697) ("mbr" "mbrserver.com" 6667 :notls)) "IRC networks." @@ -766,6 +767,19 @@ The head of this list is always the current context.") (if murk-show-joins (murk-display-notice nil nick " quit: " reason)))) + ("NOTICE" + (let ((nick (murk-msg-src msg)) + (channel (car (murk-msg-params msg))) + (text (cadr (murk-msg-params msg)))) + (pcase text + ((rx (: "\01VERSION " + (let version (* (not "\01"))) + "\01")) + (murk-display-notice (murk-get-context server) + "CTCP version reply from " nick ": " version)) + (_ + (murk-display-notice nil text))))) + ("PRIVMSG" (let* ((from (murk-msg-src msg)) (params (murk-msg-params msg)) @@ -821,6 +835,7 @@ The head of this list is always the current context.") ("USERS" "List nicks of users in current context." murk-command-users) ("MSG" "Send private message to user." murk-command-msg murk-nick-completions) ("ME" "Display action." murk-command-me) + ("VERSION" "Request version of another user's client via CTCP." murk-command-version murk-nick-completions) ("CLEAR" "Clear buffer text." murk-command-clear murk-context-completions) ("HELP" "Display help on client commands." murk-command-help murk-help-completions)) "Table of commands explicitly supported by murk.") @@ -978,6 +993,20 @@ The head of this list is always the current context.") (murk-display-notice nil "Usage: /me ")) (murk-display-notice nil "No current channel.")))) +(defun murk-command-version (params) + (let ((ctx (murk-current-context))) + (if ctx + (if params + (let ((server (murk-context-server ctx)) + (nick (car params))) + (murk-send-msg server + (lurk-msg nil nil "PRIVMSG" + (list nick "\01VERSION\01"))) + (murk-display-notice ctx "CTCP version request sent to " + nick " on " server)) + (murk-display-notice ctx "Usage: /version ")) + (murk-display-notice nil "No current channel.")))) + (defun murk-command-users (_params) (let ((ctx (murk-current-context))) (if (and ctx (not (murk-server-context-p ctx))) -- 2.20.1