X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=murk.el;h=59f76064d87f886e34be3ab71742aa8dd1731d3e;hb=c89c5c26b8b189dee352847671e6701368350717;hp=6ae751999f0c3589350c62d25803bd6b229568ea;hpb=075a68ab59c557bc8ba6eccd4e64fcb02a74e1fc;p=lurk.git diff --git a/murk.el b/murk.el index 6ae7519..59f7606 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,13 +134,13 @@ 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) (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)))) @@ -173,10 +174,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 + (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 @@ -278,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 ;; @@ -297,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 @@ -521,6 +530,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 +565,30 @@ 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.)")) + +(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 ;; @@ -567,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) @@ -616,6 +657,43 @@ 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)) + (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 ;; @@ -624,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))