From: plugd <plugd@thelambdalab.xyz>
Date: Sat, 18 May 2024 17:34:08 +0000 (+0200)
Subject: Included repl.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=075a68ab59c557bc8ba6eccd4e64fcb02a74e1fc;p=lurk.git

Included repl.

Can start testing network code now.
---

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
 ;;