X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=murk.el;h=b438aa3d93260d34b4ba67abc27875bf2e1dbc45;hb=85e71a387dc514bc7de3e497408ff211b458a657;hp=a10fb2f2ed2da658698b8f3d8a4ccc045cced02a;hpb=9688a3bb91381e49434bc238b7ecbd2396142c85;p=lurk.git diff --git a/murk.el b/murk.el index a10fb2f..b438aa3 100644 --- a/murk.el +++ b/murk.el @@ -1,13 +1,13 @@ -;;; MURK --- Multiserver Unibuffer iRc Klient -*- lexical-binding:t -*- +;;; murk.el --- Multinetwork 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,15 +26,19 @@ ;;; Commentary: +;; A very simple IRC client which uses only a single buffer. + ;;; Code: (provide 'murk) +(require 'cl-lib) + ;;; Customizations (defgroup murk nil - "Multiserver Unibuffer iRc Klient" + "Multinetwork Unibuffer iRc Klient" :group 'network) (defcustom murk-default-nick "plugd" @@ -46,16 +50,40 @@ :type '(string)) (defcustom murk-networks - '(("debug" "localhost" 6667 :notls) + '(("debug" "localhost" 6697) ("libera" "irc.libera.chat" 6697) - ("tilde" "tilde.chat" 6697)) + ("tilde" "tilde.chat" 6697) + ("sdf" "irc.sdf.org" 6697) + ("freenode" "chat.freenode.net" 6697) + ("mbr" "mbrserver.com" 6667 :notls)) "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)) +(defcustom murk-autoreply-table nil + "Table of autoreply messages. + +Each autoreply is a list of two elements: (matcher reply) + +Here matcher is a list: + +(network src cmd params ...) + +and reply is another list: + + (cmd params ...) + +Each entry in the matcher list is a regular expression tested against the +corresponding values in the incomming message. Entries can be nil, +in which case they match anything." + :type '(list (list) (list))) + ;;; Faces ;; @@ -119,58 +147,61 @@ ;; (defvar murk-connection-table nil - "An alist associating servers to connection information. + "An alist associating networks to connection information. This includes the process and the response string.") -(defun murk-connection-process (server) - (elt (assoc server murk-connection-table) 1)) +(defun murk-connection-process (network) + (elt (assoc network murk-connection-table) 1)) -(defun murk-connection-nick (server) - (elt (assoc server murk-connection-table) 2)) +(defun murk-connection-nick (network) + (elt (assoc network murk-connection-table) 2)) -(defun murk-set-connection-nick (server nick) - (setf (elt (assoc server murk-connection-table) 2) nick)) +(defun murk-set-connection-nick (network nick) + (setf (elt (assoc network murk-connection-table) 2) nick)) -(defun murk-connection-response (server) - (elt (assoc server murk-connection-table) 3)) +(defun murk-connection-response (network) + (elt (assoc network murk-connection-table) 3)) -(defun murk-set-connection-response (server string) - (setf (elt (assoc server murk-connection-table) 3) string)) +(defun murk-set-connection-response (network string) + (setf (elt (assoc network murk-connection-table) 3) string)) -(defun murk-connection-new (server process nick) +(defun murk-connection-new (network process nick) (add-to-list 'murk-connection-table - (list server process nick ""))) + (list network process nick ""))) -(defun murk-connection-remove (server) - (setq murk-connection-table (assoc-delete-all server murk-connection-table))) +(defun murk-connection-remove (network) + (setq murk-connection-table + (seq-remove (lambda (row) (equal (car row) network)) + murk-connection-table))) -(defun murk-make-server-filter (server) +(defun murk-make-network-filter (network) (lambda (_proc string) - (dolist (line (split-string (concat (murk-connection-response server) string) + (dolist (line (split-string (concat (murk-connection-response network) string) "\n")) (if (string-suffix-p "\r" line) - (murk-eval-msg-string server (string-trim line)) - (murk-set-connection-response server line))))) + (murk-eval-msg-string network (string-trim line)) + (murk-set-connection-response network line))))) -(defun murk-make-server-sentinel (server) +(defun murk-make-network-sentinel (network) (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-display-error "Disconnected from network.") + (murk-connection-remove network) + (murk-remove-network-contexts network) + (murk-highlight-current-context) (murk-render-prompt)))) -(defun murk-start-process (server) - (let* ((row (assoc server murk-networks)) +(defun murk-start-process (network) + (let* ((row (assoc network murk-networks)) (host (elt row 1)) (port (elt row 2)) (flags (seq-drop row 3))) - (make-network-process :name (concat "murk-" server) + (make-network-process :name (concat "murk-" network) :host host :service port :family nil - :filter (murk-make-server-filter server) - :sentinel (murk-make-server-sentinel server) + :filter (murk-make-network-filter network) + :sentinel (murk-make-network-sentinel network) :nowait nil :tls-parameters (if (memq :notls flags) nil @@ -184,28 +215,29 @@ This includes the process and the response string.") ;; IDEA: Have a single ping timer which pings all connected hosts -(defun murk-connect (server) - (if (assoc server murk-connection-table) +(defun murk-connect (network) + (if (assoc network murk-connection-table) (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))) - (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)) + (if (not (assoc network murk-networks)) + (murk-display-error "Network '" network "' is unknown.") + (let ((proc (murk-start-process network))) + (murk-connection-new network proc murk-default-nick)) + (murk-send-msg network (murk-msg nil nil "USER" murk-default-nick 0 "*" murk-default-nick)) + (murk-send-msg network (murk-msg nil nil "NICK" murk-default-nick)) + (murk-add-context (list network)) + (murk-highlight-current-context) (murk-render-prompt)))) -(defun murk-send-msg (server msg) +(defun murk-send-msg (network msg) (if murk-debug (murk-display-string nil nil (murk-msg->string msg))) - (let ((proc (murk-connection-process server))) + (let ((proc (murk-connection-process network))) (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 network connection established")))) -;;; Server messages +;;; network messages ;; (defun murk-msg (tags src cmd &rest params) @@ -248,7 +280,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)) @@ -273,39 +305,43 @@ 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 (network channel) identifying the network +;; 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 -;; to/from the server itself. +;; Each network has a special context (network) used for messages +;; to/from the network itself. (defvar murk-contexts nil "List of currently-available contexts. 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)) (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)) + (if (murk-network-context-p c1) + (and (murk-network-context-p c2) + (equal (murk-context-network c1) + (murk-context-network c2))) + (and (not (murk-network-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-context-users (ctx) (seq-drop ctx 2)) -(defun murk-server-context-p (ctx) (not (cdr ctx))) +(defun murk-context-network (ctx) + (elt ctx 0)) + +(defun murk-context-channel (ctx) + (elt ctx 1)) + +(defun murk-network-context-p (ctx) + (not (cdr ctx))) (defun murk-add-context (ctx) (add-to-list 'murk-contexts ctx)) @@ -317,23 +353,33 @@ The head of this list is always the current context.") (murk-contexts-equal this-ctx ctx)) murk-contexts))) -(defun murk-remove-server-contexts (server) +(defun murk-remove-network-contexts (network) (setq murk-contexts - (assoc-delete-all server murk-contexts))) + (seq-remove (lambda (row) (equal (car row) network)) + 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)))) - -(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)))) + (concat + (if (murk-network-context-p ctx) + "" + (concat (murk-context-channel ctx) "@")) + (murk-context-network ctx))) + +(defun murk-string->context (string) + (if (not (string-prefix-p "#" string)) + (murk-get-context string) + (let* ((parts (string-split string "@")) + (channel (elt parts 0)) + (network (elt parts 1))) + (murk-get-context network channel)))) + +(defun murk-get-context (network &optional channel) + (if (and channel (string-prefix-p "#" channel)) + (let ((test-ctx (list network channel))) + (seq-find (lambda (ctx) + (equal (seq-take ctx 2) test-ctx)) + murk-contexts)) + (car (member (list network) murk-contexts)))) (defun murk-cycle-contexts (&optional reverse) (setq murk-contexts @@ -344,6 +390,60 @@ 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)) + murk-contexts))) + (append new-head new-tail)))) + +;;; Context users +;; + +(defvar murk-context-users nil + "Association list between channel contexts and users.") + +(defun murk-get-context-users (ctx) + (cdr (assoc ctx murk-context-users))) + +(defun murk-set-context-users (ctx users) + (setq murk-context-users + (cons (cons ctx users) (assoc-delete-all ctx murk-context-users)))) + +(defun murk-add-context-users (ctx users) + (murk-set-context-users + ctx + (cl-union users (murk-get-context-users ctx)))) + +(defun murk-del-context-user (ctx user) + (murk-set-context-users + ctx + (delete user (murk-get-context-users ctx)))) + +(defun murk-del-all-context-users (ctx) + (murk-set-context-users ctx nil)) + +(defun murk-del-network-user (network user) + (dolist (ctx murk-contexts) + (if (and (equal (murk-context-network ctx) network) + (not (murk-network-context-p ctx))) + (murk-del-context-user ctx user)))) + +(defun murk-del-all-network-users (network) + (dolist (ctx murk-contexts) + (if (and (equal (murk-context-network ctx) network) + (not (murk-network-context-p ctx))) + (murk-del-all-context-users ctx)))) + +(defun murk-rename-network-user (network old-nick new-nick) + (dolist (ctx murk-contexts) + (when (and (equal (murk-context-network ctx) network) + (member old-nick (murk-get-context-users ctx))) + (murk-del-context-user ctx old-nick) + (murk-add-context-users ctx (list new-nick))))) + + ;;; Buffer ;; @@ -392,17 +492,17 @@ The head of this list is always the current context.") '((:eval (let* ((ctx (murk-current-context))) (if ctx - (let ((server (murk-context-server ctx))) + (let ((network (murk-context-network ctx))) (concat - "Network: " server ", " - (if (murk-server-context-p ctx) - "Server" + "Network: " network ", " + (if (murk-network-context-p ctx) + "network" (concat "Channel: " - (murk-context-name ctx) + (murk-context-channel ctx) " (" (number-to-string - (length (murk-context-users ctx))) + (length (murk-get-context-users ctx))) ")")))) "No connection"))))))) @@ -417,6 +517,7 @@ The head of this list is always the current context.") (set-marker murk-input-marker (point-max)) (setq murk-input-marker (point-max-marker))) (goto-char (point-max)) + (murk-highlight-current-context) (murk-render-prompt) (if murk-display-header (murk-setup-header)))) @@ -431,6 +532,30 @@ The head of this list is always the current context.") ;;; Output formatting and highlighting ;; +;; Idea: the face text property can be a list of faces, applied in +;; order. By assigning each context a unique list and keeping track +;; of these in a hash table, we can easily switch the face +;; corresponding to a particular context by modifying the elements of +;; this list. +;; +;; More subtly, we make only the cdrs of this list shared among +;; all text of a given context, allowing the cars to be different +;; and for different elements of the context-specific text to have +;; different styling. + +;; Additionally, we allow selective hiding of contexts via +;; the buffer-invisibility-spec. + +(defvar murk-context-facelists (make-hash-table :test 'equal) + "List of seen contexts and associated face lists.") + +(defun murk-get-context-facelist (context) + (let* ((facelist (gethash context murk-context-facelists))) + (unless facelist + (setq facelist (list 'murk-text)) + (puthash context facelist murk-context-facelists)) + facelist)) + (defun murk--fill-strings (col indent &rest strings) (with-temp-buffer (setq buffer-invisibility-spec nil) @@ -448,7 +573,10 @@ The head of this list is always the current context.") (old-pos (marker-position murk-prompt-marker)) (padded-timestamp (concat (format-time-string "%H:%M "))) (padded-prefix (if prefix (concat prefix " ") "")) - (context-atom (if context (intern (murk-context->string context)) nil))) + (context-atom (if context + (intern (murk-context->string context)) + nil)) + (context-face (murk-get-context-facelist context))) (insert-before-markers (murk--fill-strings 80 @@ -465,22 +593,55 @@ The head of this list is always the current context.") 'invisible context-atom) (murk-add-formatting (propertize (concat (apply #'murk-buttonify-urls strings) "\n") + 'face context-face 'read-only t 'context context 'invisible context-atom))))))) (murk-scroll-windows-to-last-line)) -(defun murk-display-message (server from to text) +(defun murk-click-context (button) + (murk-switch-to-context (button-get button 'context)) + (murk-highlight-current-context) + (murk-render-prompt) + (if murk-zoomed + (murk-zoom-in (murk-current-context)))) + +(defun murk-make-context-button (context &optional string) + (with-temp-buffer + (let ((label (or string (murk-context->string context)))) + (insert-text-button label + 'action #'murk-click-context + 'context context + 'follow-link t + 'help-echo "Switch context")) + (buffer-string))) + +(defun murk-display-message (network from to text) (let ((context (if (string-prefix-p "#" to) - (murk-get-context server to) - (murk-get-context server)))) + (murk-get-context network to) + (murk-get-context network)))) (murk-display-string context - (if (murk-server-context-p context) - (concat "[" from " -> " to "]") - (concat (murk-context->string context) " <" from ">")) + (propertize + (if (murk-network-context-p context) + (concat "[" from "->" to "]") + (concat + (murk-make-context-button context) + " <" from ">")) + 'face (murk-get-context-facelist context)) text))) +(defun murk-display-action (network from to action-text) + (let ((context (if (string-prefix-p "#" to) + (murk-get-context network to) + (murk-get-context network)))) + (murk-display-string + context + (propertize + (concat (murk-context->string context) " *") + 'face (murk-get-context-facelist context)) + from " " action-text))) + (defun murk-display-notice (context &rest notices) (murk-display-string context @@ -493,6 +654,43 @@ The head of this list is always the current context.") (propertize murk-error-prefix 'face 'murk-error) (apply #'concat messages))) +(defun murk-highlight-current-context () + (with-current-buffer "*murk*" + (maphash + (lambda (this-context facelist) + (if (equal this-context (murk-current-context)) + (setcar facelist 'murk-text) + (setcar facelist 'murk-faded))) + murk-context-facelists)) + (force-window-update "*murk*")) + +(defun murk-zoom-in (context) + (with-current-buffer "*murk*" + (maphash + (lambda (this-context _) + (when this-context + (let ((this-context-atom + (intern (murk-context->string this-context)))) + (if (equal this-context context) + (remove-from-invisibility-spec this-context-atom) + (add-to-invisibility-spec this-context-atom))))) + murk-context-facelists) + (force-window-update "*murk*")) + (murk-scroll-windows-to-last-line)) + +(defun murk-zoom-out () + (with-current-buffer "*murk*" + (maphash + (lambda (this-context _) + (let ((this-context-atom + (if this-context + (intern (murk-context->string this-context)) + nil))) + (remove-from-invisibility-spec this-context-atom))) + murk-context-facelists) + (force-window-update "*murk*")) + (murk-scroll-windows-to-last-line)) + (defun murk--start-of-final-line () (with-current-buffer "*murk*" (save-excursion @@ -548,7 +746,7 @@ The head of this list is always the current context.") (strikethrough nil) (prev-point (point))) (while (re-search-forward (rx (or (any "\x02\x1D\x1F\x1E\x0F") - (: "\x03" (+ digit) (opt "," (* digit))))) + (: "\x03" (* digit) (opt "," (* digit))))) nil t) (let ((beg (+ (match-beginning 0) 1))) (if bold @@ -578,50 +776,156 @@ The head of this list is always the current context.") ;;; Message evaluation ;; -(defun murk-eval-msg-string (server string) +(defun murk-eval-msg-string (network string) (if murk-debug (murk-display-string nil nil string)) (let* ((msg (murk-string->msg string))) + (murk-process-autoreplies network msg) (pcase (murk-msg-cmd msg) ("PING" - (murk-send-msg server + (murk-send-msg network (murk-msg nil nil "PONG" (murk-msg-params msg)))) ("PONG") - ("001" + ("001" ; RPL_WELCOME (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))) + (murk-set-connection-nick network nick) + (murk-display-notice (murk-get-context network) text)) + (let* ((row (assoc network murk-networks)) + (channels (if (memq :channels row) + (cdr (memq :channels row)) + nil))) + (dolist (channel channels) + (murk-command-join (list channel))))) + + ("353" ; NAMEREPLY + (let* ((params (murk-msg-params msg)) + (channel (elt params 2)) + (names (split-string (elt params 3))) + (ctx (murk-get-context network channel))) + (if ctx + (murk-add-context-users ctx names) + (murk-display-notice ctx "Users in " channel + ": " (string-join names " "))))) + + ("366" ; ENDOFNAMES + (let* ((params (murk-msg-params msg)) + (channel (elt params 1)) + (ctx (murk-get-context network channel))) + (if ctx + (murk-display-notice + ctx + (murk--as-string (length (murk-get-context-users ctx))) + " users in " channel) + (murk-display-notice (murk-get-context network) + "End of " channel " names list.")))) + + ("331" ; RPL_NOTOPIC + (let* ((params (murk-msg-params msg)) + (channel (elt params 1)) + (ctx (murk-get-context network channel))) + (murk-display-notice ctx "No topic set."))) + + ("332" ; RPL_TOPIC + (let* ((params (murk-msg-params msg)) + (channel (elt params 1)) + (topic (elt params 2)) + (ctx (murk-get-context network channel))) + (murk-display-notice ctx "Topic: " topic))) ((rx (= 3 (any digit))) - (murk-display-notice nil (mapconcat 'identity (cdr (murk-msg-params msg)) " "))) + (murk-display-notice (murk-get-context network) + (mapconcat 'identity (cdr (murk-msg-params msg)) " "))) ((and "JOIN" - (guard (equal (murk-connection-nick server) + (guard (equal (murk-connection-nick network) (murk-msg-src msg)))) - (let ((channel (car (murk-msg-params msg)))) - (murk-add-context (list server channel)) + (let* ((channel (car (murk-msg-params msg))) + (context (list network channel))) + (murk-add-context context) + (murk-del-all-context-users context) (murk-display-notice (murk-current-context) - "Joining channel " channel " on " server) + "Joining channel " channel " on " network) + (murk-highlight-current-context) (murk-render-prompt))) + ("JOIN" + (let* ((channel (car (murk-msg-params msg))) + (nick (murk-msg-src msg)) + (ctx (murk-get-context network channel))) + (murk-add-context-users ctx (list nick)) + (if murk-show-joins + (murk-display-notice ctx nick " joined channel " channel + " on " network)))) + ((and "PART" - (guard (equal (murk-connection-nick server) + (guard (equal (murk-connection-nick network) (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)) + (let* ((channel (car (murk-msg-params msg))) + (context (list network channel))) + (murk-display-notice context "Left channel " channel) + (murk-remove-context context) + (murk-del-all-context-users context) + (murk-highlight-current-context) (murk-render-prompt))) + ("PART" + (let* ((channel (car (murk-msg-params msg))) + (nick (murk-msg-src msg)) + (ctx (murk-get-context network channel))) + (murk-del-context-user ctx nick) + (if murk-show-joins + (murk-display-notice ctx nick " left channel " channel + " on " network)))) + + ((and "NICK" + (guard (equal (murk-connection-nick network) + (murk-msg-src msg)))) + (let ((new-nick (car (murk-msg-params msg))) + (old-nick (murk-connection-nick network))) + (murk-set-connection-nick network new-nick) + (murk-rename-network-user network old-nick new-nick) + (murk-display-notice (murk-get-context network) + "Nick set to " new-nick " on " network))) + + ("NICK" + (let ((old-nick (murk-msg-src msg)) + (new-nick (car (murk-msg-params msg)))) + (murk-display-notice (murk-get-context network) + old-nick " is now known as " new-nick + " on " network) + (murk-rename-network-user network 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 network 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-network-user network nick) (if murk-show-joins - (murk-display-notice nil nick " quit: " reason)))) + (murk-display-notice (murk-get-context network) + nick " on " network " has 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 network) + "CTCP version reply from " nick ": " version)) + (_ + (murk-display-notice (murk-get-context network channel) text))))) ("PRIVMSG" (let* ((from (murk-msg-src msg)) @@ -631,34 +935,71 @@ The head of this list is always the current context.") (pcase text ("\01VERSION\01" (let ((version-string (concat murk-version " - running on GNU Emacs " emacs-version))) - (murk-send-msg server + (murk-send-msg network (murk-msg nil nil "NOTICE" (list from (concat "\01VERSION " version-string "\01"))))) - (murk-display-notice nil "CTCP version request received from " - from " on " server)) + (murk-display-notice (murk-get-context network) + "CTCP version request received from " + from " on " network)) ((rx (let ping (: "\01PING " (* (not "\01")) "\01"))) - (murk-send-msg server (murk-msg nil nil "NOTICE" (list from ping))) - (murk-display-notice nil "CTCP ping received from " from " on " server)) + (murk-send-msg network (murk-msg nil nil "NOTICE" (list from ping))) + (murk-display-notice (murk-get-context network) + "CTCP ping received from " from " on " network)) ("\01USERINFO\01" - (murk-display-notice nil "CTCP userinfo request from " from - " on " server " (no response sent)")) + (murk-display-notice (murk-get-context network) + "CTCP userinfo request from " from + " on " network " (no response sent)")) ("\01CLIENTINFO\01" - (murk-display-notice nil "CTCP clientinfo request from " from - " on " server " (no response sent)")) + (murk-display-notice (murk-get-context network) + "CTCP clientinfo request from " from + " on " network " (no response sent)")) ((rx (: "\01ACTION " (let action-text (* (not "\01"))) "\01")) - (murk-display-action from to action-text)) + (murk-display-action network from to action-text)) (_ - (murk-display-message server from to text))))) + (murk-display-message network from to text))))) (_ - (murk-display-notice nil (murk-msg->string msg)))))) + (murk-display-notice (murk-get-context network) + (murk-msg->string msg)))))) + + +;;; User-defined responses +;; + +(defun murk--lists-equal (l1 l2) + (if (and l1 l2) + (if (or (not (and (car l1) (car l2))) + (string-match (car l1) (car l2))) + (murk--lists-equal (cdr l1) (cdr l2)) + nil) + t)) + +(defun murk-process-autoreply (network msg autoreply) + (let ((matcher (car autoreply)) + (reply (cadr autoreply))) + (let ((target-network (car matcher))) + (when (and (or (not target-network) + (and (equal network target-network))) + (murk--lists-equal (cdr matcher) + (append (list (murk-msg-src msg) + (murk-msg-cmd msg)) + (murk-msg-params msg)))) + (murk-send-msg network + (murk-msg nil nil (car reply) (cdr reply))))))) + +(defun murk-process-autoreplies (network msg) + (mapc + (lambda (autoreply) + (murk-process-autoreply network msg autoreply)) + murk-autoreply-table)) + ;;; Commands ;; @@ -666,13 +1007,20 @@ 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) ("JOIN" "Join one or more channels." murk-command-join) - ("PART" "Leave channel." murk-command-part murk-context-completions) + ("PART" "Leave channel." murk-command-part murk-channel-completions) + ("SWITCHCONTEXT" "Switch current context" murk-command-switch-context 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 channel." 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.") @@ -683,6 +1031,19 @@ The head of this list is always the current context.") (defun murk-network-completions () (mapcar (lambda (row) (car row)) murk-networks)) +(defun murk-help-completions () + (mapcar (lambda (row) (car row)) murk-command-table)) + +(defun murk-channel-completions () + (mapcar (lambda (ctx) + (murk-context->string ctx)) + (seq-filter (lambda (ctx) + (not (murk-network-context-p ctx))) + murk-contexts))) + +(defun murk-context-completions () + (mapcar (lambda (ctx) (murk-context->string ctx)) murk-contexts)) + (defun murk-command-help (params) (if params (let* ((cmd-str (upcase (car params))) @@ -717,11 +1078,15 @@ 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-clear (params) - (if (not params) - (murk-clear-buffer) - (dolist (context params) - (murk-clear-context context)))) +(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-connect (params) (if params @@ -733,48 +1098,138 @@ The head of this list is always the current context.") (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 network port &rest _others) row (murk-display-notice nil "\t" network - " [" server + " [" network " " (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") + (murk-display-error "No current network") (let ((quit-msg (if params (string-join params " ") murk-default-quit-msg))) (murk-send-msg - (murk-context-server ctx) + (murk-context-network ctx) (murk-msg nil nil "QUIT" quit-msg)))))) (defun murk-command-join (params) (if params - (let ((server (murk-context-server (murk-current-context)))) + (let ((network (murk-context-network (murk-current-context)))) (dolist (channel params) - (murk-send-msg server (murk-msg nil nil "JOIN" channel)))) + (murk-send-msg network (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")))) + (let ((ctx (cond + ((not params) (murk-current-context)) + ((seq-contains (car params) "@") (murk-string->context (car params))) + (t (list (murk-context-network (murk-current-context)) (car params)))))) + (let ((network (murk-context-network ctx)) + (channel (murk-context-channel ctx))) + (if channel + (murk-send-msg network (murk-msg nil nil "PART" channel)) + (murk-display-error "Specify which channel to leave"))))) + +(defun murk-command-switch-context (params) + (if (not params) + (murk-display-notice nil "Usage: /switchcontext #channel@network") + (let ((ctx (murk-string->context (car params)))) + (murk-switch-to-context ctx) + (murk-highlight-current-context) + (murk-render-prompt) + (if murk-zoomed + (murk-zoom-in (murk-current-context)))))) + +(defun murk-command-nick (params) + (if params + (let ((new-nick (string-join params " ")) + (ctx (murk-current-context))) + (if ctx + (murk-send-msg (murk-context-network 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 ((network (murk-context-network ctx))) + (if (equal (upcase (car params)) "-YES") + (murk-send-msg network (murk-msg nil nil "LIST")) + (murk-send-msg network (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-network-context-p ctx))) + (let ((network (murk-context-network ctx)) + (channel (murk-context-channel ctx))) + (if params + (murk-send-msg network + (murk-msg nil nil "TOPIC" channel + (string-join params " "))) + (murk-send-msg network + (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)))) + (let ((network (murk-context-network (murk-current-context)))) (if (and params (>= (length params) 2)) (let ((to (car params)) (text (string-join (cdr params) " "))) - (murk-send-msg server (murk-msg nil nil "PRIVMSG" to text)) - (murk-display-message server - (murk-connection-nick server) + (murk-send-msg network (murk-msg nil nil "PRIVMSG" to text)) + (murk-display-message network + (murk-connection-nick network) to text)) (murk-display-notice nil "Usage: /msg ")))) +(defun murk-command-me (params) + (let* ((ctx (murk-current-context)) + (network (murk-context-network ctx))) + (if (and ctx (not (murk-network-context-p ctx))) + (if params + (let* ((channel (murk-context-channel ctx)) + (my-nick (murk-connection-nick network)) + (action (string-join params " ")) + (ctcp-text (concat "\01ACTION " action "\01"))) + (murk-send-msg network + (murk-msg nil nil "PRIVMSG" + (list channel ctcp-text))) + (murk-display-action network my-nick channel action)) + (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 ((network (murk-context-network ctx)) + (nick (car params))) + (murk-send-msg network + (murk-msg nil nil "PRIVMSG" + (list nick "\01VERSION\01"))) + (murk-display-notice ctx "CTCP version request sent to " + nick " on " network)) + (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-network-context-p ctx))) + (let ((channel (murk-context-channel ctx)) + (network (murk-context-network ctx)) + (users (murk-get-context-users ctx))) + (murk-display-notice ctx "Users in " channel " on " network ":") + (murk-display-notice ctx (string-join users " "))) + (murk-display-notice nil "No current channel.")))) + + ;;; Command entering ;; @@ -792,22 +1247,23 @@ The head of this list is always the current context.") (if (and command-row (elt command-row 2)) (funcall (elt command-row 2) params) (murk-send-msg - (murk-context-server (murk-current-context)) + (murk-context-network (murk-current-context)) (murk-msg nil nil (upcase cmd-str) params))))) (_ (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-network-context-p ctx)) + (let ((network (murk-context-network ctx)) + (channel (murk-context-channel ctx))) + (murk-send-msg network + (murk-msg nil nil "PRIVMSG" channel string)) + (murk-display-message network + (murk-connection-nick network) + channel string)) + (murk-display-error "No current channel")) + (murk-display-error "No current context")))))) ;;; Command history @@ -853,6 +1309,33 @@ 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-highlight-current-context) + (murk-render-prompt) + (if murk-zoomed + (murk-zoom-in (murk-current-context)))) + +(defun murk-cycle-contexts-reverse () + (interactive) + (murk-cycle-contexts t) + (murk-highlight-current-context) + (murk-render-prompt) + (if murk-zoomed + (murk-zoom-in (murk-current-context)))) + +(defvar murk-zoomed nil + "Keeps track of zoom status.") + +(defun murk-toggle-zoom () + (interactive) + (if murk-zoomed + (murk-zoom-out) + (murk-zoom-in (murk-current-context))) + (setq murk-zoomed (not murk-zoomed))) + + (defun murk-complete-input () (interactive) (let ((completion-ignore-case t)) @@ -890,9 +1373,11 @@ 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 "C-c C-z") 'murk-toggle-zoom) (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 @@ -908,6 +1393,7 @@ The head of this list is always the current context.") ;;; Main start procedure ;; +;;;###autoload (defun murk () "Start murk or just switch to the murk buffer if one already exists." (interactive) @@ -918,5 +1404,4 @@ The head of this list is always the current context.") (murk-setup-buffer)) "Started murk.") - ;;; murk.el ends here