From 075a68ab59c557bc8ba6eccd4e64fcb02a74e1fc Mon Sep 17 00:00:00 2001 From: plugd Date: Sat, 18 May 2024 19:34:08 +0200 Subject: [PATCH] Included repl. Can start testing network code now. --- murk.el | 216 +++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 214 insertions(+), 2 deletions(-) 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 ;; -- 2.20.1