hamacs/pud.org
2025-03-03 13:17:47 -08:00

523 lines
19 KiB
Org Mode
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

#+title: Moss and Puddles
#+author: Howard X. Abrams
#+date: 2025-01-18
#+filetags: emacs hamacs
#+lastmod: [2025-03-03 Mon]
A literate programming file for a Comint-based MUD client.
#+begin_src emacs-lisp :exports none
;;; pud --- a MUD client -*- lexical-binding: t; -*-
;;
;; © 2025 Howard X. Abrams
;; Licensed under a Creative Commons Attribution 4.0 International License.
;; See http://creativecommons.org/licenses/by/4.0/
;;
;; Author: Howard X. Abrams <http://gitlab.com/howardabrams>
;; Maintainer: Howard X. Abrams
;; Created: January 18, 2025
;;
;; While obvious, GNU Emacs does not include this file or project.
;;
;; *NB:* Do not edit this file. Instead, edit the original literate file at:
;; /Users/howard/src/hamacs/pud.org
;; And tangle the file to recreate this one.
;;
;;; Code:
#+end_src
* Introduction
This project is a simple MUD client for Emacs, based on COM-INT MUD client I learn about on Mickey Petersens [[https://www.masteringemacs.org/article/comint-writing-command-interpreter][essay on Comint]].
This uses =telnet= (at the moment) for the connection, so you will need to install that first. On Mac, this would be:
#+BEGIN_SRC sh
brew install telent
#+END_SRC
And use a similar command on Linux.
** Customization
You may want to customize your connections to more worlds.
The default connects to *Moss n Puddles*, my own MUD which I invite you to join.
#+BEGIN_SRC emacs-lisp
(defgroup pud nil
"An overly simplistic MUD client that works with Evennia."
:group 'processes)
(defcustom pud-worlds
'(["Moss-n-Puddles" telnet "howardabrams.com" 4000])
"List of worlds you play in.
You need to define the worlds you play in before you can get
started. In most worlds, you can start playing using a guest account.
Each element WORLD of the list has the following form:
\[CONN-TYPE NAME HOST PORT CHARACTER PASSWORD LOGIN-STR]
NAME identifies the connection, HOST and PORT specify the network
connection, CHARACTER and PASSWORD are used to connect automatically.
The CONN-TYPE can be either 'telnet or 'ssh.
The LOGIN-STR is a string with two `%s' where this substitutes
the username and password respectively. Sends this to the server after
establishing a connection. This can be blank for the default.
If given, make sure to have a trailing `\n' to automatically send.
Note that this will be saved in your `custom-file' -- including your
passwords! If you don't want that, specify nil as your password."
:type '(repeat
(vector :tag "Server World"
(string :tag "Name")
(radio :tag "Type"
(const :tag "Telnet" :value telnet)
(const :tag "SSH" :value ssh))
(string :tag "Hostname")
(integer :tag "Port num")
(string :tag "Username" :value "guest")
(string :tag "Password")
(string :tag "Login String"
:format "%t: %v%h"
:doc "The login string to send after connection.
This should probably have a \`\\n' at the end to submit it.
If blank or nil, use the \`pud-default-connection-string'.
For example: connect %s %s\\n")))
:group 'pud)
#+END_SRC
For instance:
#+BEGIN_SRC emacs-lisp :tangle no :eval no
(use-package pud
:custom
(pud-worlds
'(["Remote Moss-n-Puddles" 'ssh "howardabrams.com" 4000 "bobby"]
; ↑ No password? Should be in .authinfo.gpg
["Local Root" 'telnet "localhost" 4000 "suzy" "some-pass"]
; ↑ This has the password in your custom settings.
; ↓ Password from authinfo, special connection string:
["Local User" 'telnet "localhost" 4000 "rick" nil "login %s %s"])))
#+END_SRC
Hidden:
#+BEGIN_SRC emacs-lisp :tangle no :eval no
(setq pud-worlds
'(["Moss-n-Puddles" ssh "howardabrams.com" 4004 "howard" "" "\\nconnect %s %s\\n"]
["Moss-n-Puddles" ssh "howardabrams.com" 4004 "rick" "" "\\nconnect %s %s\\n"]
["Local-Moss" telnet "localhost" 4000 "howard" "" ""]
["Local-Moss" telnet "localhost" 4000 "rick" "" ""]))
#+END_SRC
Seems like MUDs have a standard login sequence, but they dont have to. Here is the default that a user can override in their =pud-worlds= listing:
#+BEGIN_SRC emacs-lisp
(defcustom pud-default-connection-string "connect %s %s\n"
"The standard connection string to substitute the username and password."
:type '(string)
:group 'pud)
#+END_SRC
** User Credentials
Next, open [[file:~/.authinfo.gpg][your authinfo file]], and insert the following line, substituting =[user]= and =[pass]= with your credentials as well as the first entry to match each host name in your =pud-worlds= entries:
#+BEGIN_SRC conf :tangle no :eval no
machine howardabrams.com login [name] port 4000 password [pass]
#+END_SRC
Now, lets play! Type =run-pud=, and optionally select a world. If you get disconnected, re-run it, or even =pud-reconnect=.
The rest of this file describes the code implementing this project.
* Code
Choosing a world… er, connection using a =completing-read= allowing you to choose a world. If =pud-worlds= contains a single value, might as well just return that.
#+BEGIN_SRC emacs-lisp
(defvar pud-world-history nil
"History for `pud-get-world'.")
(defun pud-get-world ()
"Let the user choose a world from `pud-worlds'.
The return value is a cons cell, the car is the name of the connection,
the cdr holds the connection defails from `pud-worlds'."
(if (length= pud-worlds 1)
(seq-first pud-worlds))
(let ((world-completions
(mapcar (lambda (w)
(cons (pud-world-name w) w))
pud-worlds)))
(cond
((and world-completions (length= world-completions 1))
(thread-first world-completions
(first)
(cdr)))
(world-completions
(thread-first
(completing-read "World: " world-completions nil t nil pud-world-history)
(assoc world-completions)
(cdr)))
(t (customize-option 'pud-worlds)))))
#+END_SRC
The following functions are accessibility functions to the world entry.
#+BEGIN_SRC emacs-lisp
(defun pud-world-name (world)
"Return the name for WORLD as a string."
(if (vectorp world)
(if (or (length< world 5) (null (aref world 4)) (string-blank-p (aref world 4)))
(aref world 0)
(concat (aref world 4) "@" (aref world 0)))
world))
(defun pud-world-network (world)
"Return the network details for WORLD as a cons cell (HOST . PORT)."
(list (aref world 2) (format "%s" (aref world 3))))
(defun pud-world-creds (world)
"Return the username and password from WORLD.
Multiple search queries for the .authinfo file."
(seq-let (label host port user) world
(if-let ((auth-results (first (auth-source-search
:host host
:port port
:user user
:max 1))))
(list (plist-get auth-results :user)
(funcall (plist-get auth-results :secret)))
;; No match? Just return values from world:
(list (aref world 4) (aref world 5)))))
#+END_SRC
And some basic functions I should expand.
#+BEGIN_SRC emacs-lisp :tangle no
(ert-deftest pud-world-name-test ()
(should (string-equal (pud-world-name "foobar") "foobar"))
(should (string-equal (pud-world-name ["foobar" "localhost" "4000"]) "foobar"))
(should (string-equal (pud-world-name ["foobar" "localhost" "4000" nil]) "foobar"))
(should (string-equal (pud-world-name ["foobar" "localhost" "4000" ""]) "foobar"))
(should (string-equal (pud-world-name ["foobar" "localhost" "4000" "guest" "guest"]) "guest@foobar")))
(ert-deftest pud-world-network-test ()
(should (equal (pud-world-network ["foobar" telnet "overthere" "4000" "guest" "guest"]) '("overthere" "4000")))
(should (equal (pud-world-network ["foobar" ssh "overthere" 4000 "guest" "guest"]) '("overthere" "4000"))))
(ert-deftest pud-world-creds-test ()
;; Test with no match in authinfo!
(should (equal
(pud-world-creds ["some-place" telnet "some-home" 4000 "a-user" "a-pass"])
'("a-user" "a-pass")))
;; This test works if the following line is in .authinfo:
;; machine localhost port 4000 login george password testpass
(should (equal
(pud-world-creds ["nudder-place" ssh "localhost" 4000 "george"])
'("george" "testpass"))))
#+END_SRC
* Basics
:LOGBOOK:
CLOCK: [2025-03-03 Mon 11:57]--[2025-03-03 Mon 12:10] => 0:13
:END:
Using Comint, and hoping to have the ANSI colors displayed.
#+BEGIN_SRC emacs-lisp
(require 'comint)
(load "ansi-color" t)
#+END_SRC
Im going to use good ol fashion =telnet= for the connection:
#+BEGIN_SRC emacs-lisp
(defcustom pud-telnet-path "telnet"
"Path to the program used by `run-pud' to connect using telnet."
:type '(string)
:group 'pud)
(defcustom pud-ssh-path "ssh"
"Path to the program used by `run-pud' to connect using ssh."
:type '(string)
:group 'pud)
#+END_SRC
The pud-cli-arguments, holds a list of commandline arguments: the port.
#+BEGIN_SRC emacs-lisp
(defvar pud-cli-arguments nil
"A list of arguments to use before the connection.")
#+END_SRC
Command string to use, given a =world= with a connection type:
#+BEGIN_SRC emacs-lisp
(defun pud-cli-command (world)
"Return a command string to pass to the shell.
The WORLD is a vector with the hostname, see `pud-worlds'."
(seq-let (host port) (pud-world-network world)
(message "Dealing with: %s %s %s" host port (aref world 1))
(cl-case (aref world 1)
(telnet (append (cons pud-telnet-path pud-cli-arguments)
(list host port)))
(ssh (append (cons pud-cli-filepath-ssh pud-cli-arguments)
(list "-p" port host)))
(t (error "Unsupported connection type")))))
#+END_SRC
Some tests:
#+BEGIN_SRC emacs-lisp :tangle no
(ert-deftest pud-cli-command-test ()
(should (equal (pud-cli-command ["some-world" telnet "world.r.us" 4000])
'("telnet" "world.r.us" "4000")))
(should (equal (pud-cli-command ["nudder-world" ssh "world.r.us" 4004])
'("ssh" "-p" "4004" "world.r.us"))))
#+END_SRC
The empty and currently disused mode map for storing our custom keybindings inherits from =comint-mode-map=, so we get the same keys exposed in =comint-mode=.
#+BEGIN_SRC emacs-lisp
(defvar pud-mode-map
(let ((map (nconc (make-sparse-keymap) comint-mode-map)))
(define-key map "\t" 'completion-at-point)
map)
"Basic mode map for `run-pud'.")
#+END_SRC
This holds a regular expression that matches the prompt style for the MUD. Not sure if this is going to work, since MUDs typically dont have prompts.
#+BEGIN_SRC emacs-lisp
(defvar pud-prompt-regexp "" ; "^\\(?:\\[[^@]+@[^@]+\\]\\)"
"Prompt for `run-pud'.")
#+END_SRC
The name of the buffer:
#+BEGIN_SRC emacs-lisp
(defun pud-buffer-name (world)
"Return the buffer name associated with WORLD."
(format "*%s*" (pud-world-name world)))
#+END_SRC
** Run and Connect
The main entry point to the program is the =run-pud= function:
#+BEGIN_SRC emacs-lisp
(defun run-pud (world)
"Run an inferior instance of `pud-cli' inside Emacs.
The WORLD should be vector containing the following:
- label for the world
- server hostname
- server port
- username (can be overridden)
- password (should be overridden)"
(interactive (list (pud-get-world)))
(let* ((pud-cli (pud-cli-command world))
(buffer (get-buffer-create (pud-buffer-name world)))
(proc-alive (comint-check-proc buffer))
(process (get-buffer-process buffer)))
;; if the process is dead then re-create the process and reset the
;; mode.
(unless proc-alive
(with-current-buffer buffer
(apply 'make-comint-in-buffer "Pud" buffer (car pud-cli) nil (cdr pud-cli))
(pud-mode)
(visual-line-mode 1)
(pud-reconnect world)))
;; Regardless, provided we have a valid buffer, we pop to it.
(when buffer
(pop-to-buffer buffer))))
#+END_SRC
Connection and/or re-connection:
#+BEGIN_SRC emacs-lisp
(defun pud-reconnect (world)
"Collect and send a `connect' sequence to WORLD.
Where WORLD is a vector of world information. NOP if the buffer has no
connection or no password could be found."
(interactive (list (pud-get-world)))
(when (called-interactively-p)
(pop-to-buffer (pud-buffer-name world)))
(sit-for 1)
(message "Attempting to log in...")
(seq-let (username password) (pud-world-creds world)
(let* ((conn-str (if (length> world 5)
(aref world 5)
pud-default-connection-string))
(conn-full (format conn-str username password))
(process (get-buffer-process (current-buffer))))
(message "proc: %s str: '%s'" process conn-full)
(goto-char (point-max))
(if process
(comint-send-string process conn-full)
(insert conn-full)))))
#+END_SRC
* Pud Mode
Note that =comint-process-echoes=, depending on the mode and the circumstances, may result in prompts appearing twice. Setting =comint-process-echoes= to =t= helps with that.
#+BEGIN_SRC emacs-lisp
(defun pud--initialize ()
"Helper function to initialize Pud."
(setq comint-process-echoes t)
(setq comint-use-prompt-regexp nil))
(define-derived-mode pud-mode comint-mode "Pud"
"Major mode for `run-pud'.
\\<pud-mode-map>"
;; this sets up the prompt so it matches things like: [foo@bar]
;; (setq comint-prompt-regexp pud-prompt-regexp)
;; this makes it read only; a contentious subject as some prefer the
;; buffer to be overwritable.
(setq comint-prompt-read-only t)
;; this makes it so commands like M-{ and M-} work.
;; (set (make-local-variable 'paragraph-separate) "\\'")
;; (set (make-local-variable 'font-lock-defaults) '(pud-font-lock-keywords t))
;; (set (make-local-variable 'paragraph-start) pud-prompt-regexp)
)
(add-hook 'pud-mode-hook 'pud--initialize)
(defconst pud-keywords
'("connect" "get" "look" "use")
"List of keywords to highlight in `pud-font-lock-keywords'.")
(defvar pud-font-lock-keywords
(list
;; highlight all the reserved commands.
`(,(concat (rx bol (optional "@")) (regexp-opt pud-keywords)) . font-lock-keyword-face)
`(,(rx bol "@" (one-or-more)))
)
"Additional expressions to highlight in `pud-mode'.")
#+END_SRC
* Org Babel
Wouldnt it be nice to be able to write commands in an Org file, and send the command to the connected Mud?
Since Im connected to more than one MUD, or at least, I often log in with two different characters as two different characters. Lets have a function that can return all PUD buffers:
#+BEGIN_SRC emacs-lisp
(defun pud-get-all-buffers ()
"Return a list of all buffers with a live PUD connection."
(save-window-excursion
(seq-filter (lambda (buf)
(switch-to-buffer buf)
(and
(eq major-mode 'pud-mode)
(get-buffer-process (current-buffer))))
(buffer-list))))
#+END_SRC
And a wrapper around =completing-read= for choosing one of the buffers:
#+BEGIN_SRC emacs-lisp
(defun pud-current-world ()
"Return buffer based on user choice of current PUD connections."
(let ((pud-buffers (pud-get-all-buffers)))
(cond
((null pud-buffers) nil)
((length= pud-buffers 1) (car pud-buffers))
(t
(completing-read "Choose connection: "
(seq-map (lambda (buf) (buffer-name buf))
pud-buffers))))))
#+END_SRC
Given a buffer and a string, use the =comint-send-string=:
#+BEGIN_SRC emacs-lisp
(defun pud-send-string (buf-name text)
"Send TEXT to a comint buffer, BUF-NAME."
(save-window-excursion
(save-excursion
(pop-to-buffer buf-name)
(goto-char (point-max))
(comint-send-string (get-buffer-process (current-buffer))
(format "%s\n" text)))))
#+END_SRC
Lets send the current line or region.
#+BEGIN_SRC emacs-lisp :results silent
(defun pud-send-line (world)
"Send the current line or region to WORLD."
(interactive (list (pud-current-world)))
(unless world
(error "No current MUD connection."))
(let ((text (buffer-substring-no-properties
(if (region-active-p) (region-beginning)
(beginning-of-line-text) (point))
(if (region-active-p) (region-end)
(end-of-line) (point)))))
(pud-send-string world text)))
(global-set-key (kbd "<f6>") 'pud-send-line)
#+END_SRC
Lets be able to send the current Org block, where all lines in the block are smooshed together to create a single line:
#+BEGIN_SRC emacs-lisp
(defun pud-send-block (world)
"Send the current Org block to WORLD."
(interactive (list (pud-current-world)))
(unless world
(error "No current MUD connection."))
(let ((text (thread-last (org-element-at-point)
(org-src--contents-area)
(nth 2))))
(pud-send-string world
(replace-regexp-in-string
(rx (one-or-more space)) " " text))))
#+END_SRC
* Evennia Mode
Make a simple mode for basic highlighting of =ev= code.
#+BEGIN_SRC emacs-lisp :tangle no
(define-derived-mode evennia-mode nil "Evennia"
"Major mode for editing evennia batch command files.
\\{evennia-mode-map}
Turning on Evennia mode runs the normal hook `evennia-mode-hook'."
(setq-local comment-start "# ")
(setq-local comment-start-skip "#+\\s-*")
(setq-local require-final-newline mode-require-final-newline)
(add-hook 'conevennia-menu-functions 'evennia-mode-conevennia-menu 10 t))
(defvar evennia-mode-font-lock-keywords
`(,(rx line-start "@" (one-or-more alnum))
)
"Additional things to highlight in evennia output.")
#+END_SRC
* Technical Artifacts :noexport:
Let's =provide= a name so we can =require= this file:
#+begin_src emacs-lisp :exports none
(provide 'pud)
;;; pud.el ends here
#+end_src
#+DESCRIPTION: a MUD client
#+PROPERTY: header-args:sh :tangle no
#+PROPERTY: header-args:emacs-lisp :tangle yes
#+PROPERTY: header-args :results none :eval no-export :comments no mkdirp yes
#+OPTIONS: num:nil toc:nil todo:nil tasks:nil tags:nil date:nil
#+OPTIONS: skip:nil author:nil email:nil creator:nil timestamp:nil
#+INFOJS_OPT: view:nil toc:nil ltoc:t mouse:underline buttons:0 path:http://orgmode.org/org-info.js