X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=murk.el;h=6f6fdc054e494336785a00f5fc8b88ef418a0e6f;hb=f804b7fc5edcfd10f9d930c73d78de87c625d195;hp=fb790617ae3c9abb3011a93c8165f8c5e5789e0d;hpb=14e7306e9457469d704d364ccc753189244adff4;p=lurk.git diff --git a/murk.el b/murk.el index fb79061..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) @@ -38,19 +40,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 @@ -138,10 +144,12 @@ 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) + (lambda (_proc string) (dolist (line (split-string (concat (murk-connection-response server) string) "\n")) (if (string-suffix-p "\r" line) @@ -149,7 +157,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 +190,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 +206,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 @@ -244,13 +252,13 @@ 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)) 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)) @@ -315,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) @@ -323,10 +332,32 @@ 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)))) + +(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))) @@ -360,12 +391,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 @@ -450,6 +475,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 @@ -475,8 +511,6 @@ The head of this list is always the current context.") (with-selected-window window (recenter -1)))))) - - (defconst murk-url-regex (rx (: (group (+ alpha)) @@ -594,6 +628,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 (murk-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)))))) @@ -667,10 +735,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) "]"))) @@ -679,7 +747,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) @@ -699,8 +767,18 @@ 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 (murk-msg nil nil "PRIVMSG" to text)) + (murk-display-message server + (murk-connection-nick server) + to text)) + (murk-display-notice nil "Usage: /msg ")))) ;;; Command entering ;; @@ -722,16 +800,19 @@ 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) - (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-error "No current context."))))) + (murk-display-message server + (murk-connection-nick server) + (murk-context->string (murk-current-context)) + string)) + (murk-display-error "No current context"))))) ;;; Command history @@ -801,7 +882,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))) @@ -816,6 +897,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)) @@ -840,5 +923,4 @@ The head of this list is always the current context.") (murk-setup-buffer)) "Started murk.") - ;;; murk.el ends here