X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=murk.el;h=e89df657a7490aab9eadd6d5ce4c5a4042aef579;hb=b91c95a6e7a26c70e794ea0acd862cc43e5b8a52;hp=49adc3499985b14d138dec725391ef4d6e4741da;hpb=ff1085dfcaa29217a3d19ef27afceaed2d614cfb;p=lurk.git diff --git a/murk.el b/murk.el index 49adc34..e89df65 100644 --- a/murk.el +++ b/murk.el @@ -6,7 +6,7 @@ ;; Created: 11 May 2024 ;; Version: 0.0 ;; Keywords: network -;; Homepage: http://thelambdalab.xyz/metalurk +;; Homepage: http://thelambdalab.xyz/murk ;; Package-Requires: ((emacs "26")) ;; This file is not part of GNU Emacs. @@ -37,21 +37,53 @@ "Multiserver Unibuffer iRc Klient" :group 'network) -(defcustom murk-nick "plugd" +(defcustom murk-default-nick "plugd" "Default nick.") (defcustom murk-default-quit-msg "Bye" "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.") +(defcustom murk-display-header t + "If non-nil, use buffer header to display information on current host and channel.") + ;;; 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 ;; @@ -63,6 +95,10 @@ (defvar murk-error-prefix "!!!") (defvar murk-prompt-string ">") +(defvar murk-debug nil + "If non-nil, enable debug mode.") + + ;;; Utility procedures ;; @@ -74,6 +110,7 @@ (with-output-to-string (princ obj)) nil)) + ;;; Network processes ;; @@ -84,13 +121,23 @@ This includes the process and the response string.") (defun murk-connection-process (server) (elt (assoc server murk-connection-table) 1)) -(defun murk-connection-response (server) +(defun murk-connection-nick (server) (elt (assoc server murk-connection-table) 2)) +(defun murk-set-connection-nick (server nick) + (setf (elt (assoc server murk-connection-table) 2) nick)) + +(defun murk-connection-response (server) + (elt (assoc server murk-connection-table) 3)) + (defun murk-set-connection-response (server string) (setf (elt (assoc server murk-connection-table) 3) string)) -(defun murk-connection-close (server) +(defun murk-connection-new (server process nick) + (add-to-list 'murk-connection-table + (list server process nick ""))) + +(defun murk-connection-remove (server) (setq murk-connection-table (assoc-delete-all server murk-connection-table))) (defun murk-make-server-filter (server) @@ -99,22 +146,22 @@ 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-render-prompt) - (murk-connection-close server)))) + (murk-connection-remove server) + (murk-remove-server-contexts server) + (murk-render-prompt)))) (defun murk-start-process (server) (let* ((row (assoc server murk-networks)) (host (elt row 1)) (port (elt row 2)) (flags (seq-drop row 3))) - (make-network-process :name (concat "lurk" server) + (make-network-process :name (concat "murk-" server) :host host :service port :family nil @@ -127,7 +174,7 @@ This includes the process and the response string.") (gnutls-boot-parameters :type 'gnutls-x509pki :hostname host))) - :buffer "*lurk*"))) + :buffer "*murk*"))) (defvar murk-ping-period 60) @@ -138,9 +185,89 @@ This includes the process and the response string.") (murk-display-error "Already connected to this network.") (if (not (assoc server murk-networks)) (murk-display-error "Network '" server "' is unknown.") - (murk-start-process server) - (murk-send-msg (murk-msg nil nil "USER" murk-nick 0 "*" murk-nick)) - (murk-send-msg (murk-msg nil nil "NICK" murk-nick))))) + (let ((proc (murk-start-process server))) + (murk-connection-new server proc murk-default-nick)) + (murk-send-msg server (murk-msg nil nil "USER" murk-default-nick 0 "*" murk-default-nick)) + (murk-send-msg server (murk-msg nil nil "NICK" murk-default-nick)) + (murk-add-context (list server)) + (murk-render-prompt)))) + +(defun murk-send-msg (server msg) + (if murk-debug + (murk-display-string nil nil (murk-msg->string msg))) + (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.")))) + + +;;; Server messages +;; + +(defun murk-msg (tags src cmd &rest params) + (list (murk--as-string tags) + (murk--as-string src) + (upcase (murk--as-string cmd)) + (mapcar #'murk--as-string + (if (and params (listp (elt params 0))) + (elt params 0) + params)))) + +(defun murk-msg-tags (msg) (elt msg 0)) +(defun murk-msg-src (msg) (elt msg 1)) +(defun murk-msg-cmd (msg) (elt msg 2)) +(defun murk-msg-params (msg) (elt msg 3)) +(defun murk-msg-trail (msg) + (let ((params (murk-msg-params msg))) + (if params + (elt params (- (length params) 1))))) + +(defvar murk-msg-regex + (rx + (opt (: "@" (group (* (not (or "\n" "\r" ";" " "))))) + (* whitespace)) + (opt (: ":" (: (group (* (not (any space "!" "@")))) + (* (not (any space))))) + (* whitespace)) + (group (: (* (not whitespace)))) + (* whitespace) + (opt (group (+ not-newline)))) + "Regex used to parse IRC messages. +Note that this regex is incomplete. Noteably, we discard the non-nick +portion of the source component of the message, as mURK doesn't use this.") + +(defun murk-string->msg (string) + (if (string-match murk-msg-regex string) + (let* ((tags (match-string 1 string)) + (src (match-string 2 string)) + (cmd (upcase (match-string 3 string))) + (params-str (match-string 4 string)) + (params + (if params-str + (let* ((idx (cl-search ":" 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))) + +(defun murk-msg->string (msg) + (let ((tags (murk-msg-tags msg)) + (src (murk-msg-src msg)) + (cmd (murk-msg-cmd msg)) + (params (murk-msg-params msg))) + (murk--filtered-join + (if tags (concat "@" tags) nil) + (if src (concat ":" src) nil) + cmd + (if (> (length params) 1) + (string-join (seq-take params (- (length params) 1)) " ") + nil) + (if (> (length params) 0) + (concat ":" (elt params (- (length params) 1))) + nil)))) + ;;; Contexts and Servers ;; @@ -149,15 +276,634 @@ This includes the process and the response string.") ;; representing either a channel name or nick, and server is a symbol ;; identifying the server. ;; -;; Each server has a special context (server) used for messages +;; Each server has a special context (server nil) used for messages ;; to/from the server itself. -(defvar murk-current-context nil) -(defvar murk-context-members nil) +(defvar murk-contexts nil + "List of currently-available contexts. +The head of this list is always the current context.") + +(defun murk-current-context () + "Returns the current context." + (if murk-contexts + (car murk-contexts) + nil)) + +(defun murk-contexts-equal (c1 c2) + (if (murk-server-context-p c1) + (and (murk-server-context-p c2) + (equal (murk-context-server c1) + (murk-context-server c2))) + (and (not (murk-server-context-p c2)) + (equal (seq-take c1 2) + (seq-take c2 2))))) + +(defun murk-context-server (ctx) (elt ctx 0)) +(defun murk-context-name (ctx) (elt ctx 1)) +(defun murk-context-users (ctx) (seq-drop ctx 2)) +(defun murk-server-context-p (ctx) (not (cdr ctx))) + +(defun murk-add-context (ctx) + (add-to-list 'murk-contexts ctx)) + +(defun murk-remove-context (ctx) + (setq murk-contexts + (seq-remove + (lambda (this-ctx) + (murk-contexts-equal this-ctx ctx)) + murk-contexts))) + +(defun murk-remove-server-contexts (server) + (setq murk-contexts + (assoc-delete-all server murk-contexts))) + +(defun murk-context->string (ctx) + (if (murk-server-context-p ctx) + (concat "[" (murk-context-server ctx) "]") + (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)))) + +;;; Buffer +;; + +(defun murk-render-prompt () + (with-current-buffer "*murk*" + (let ((update-point (= murk-input-marker (point))) + (update-window-points (mapcar (lambda (w) + (list (= (window-point w) murk-input-marker) + w)) + (get-buffer-window-list nil nil t)))) + (save-excursion + (set-marker-insertion-type murk-prompt-marker nil) + (set-marker-insertion-type murk-input-marker t) + (let ((inhibit-read-only t)) + (delete-region murk-prompt-marker murk-input-marker) + (goto-char murk-prompt-marker) + (insert + (propertize (let ((ctx (murk-current-context))) + (if ctx + (murk-context->string ctx) + "")) + 'face 'murk-context + 'read-only t) + (propertize murk-prompt-string + 'face 'murk-prompt + 'read-only t) + (propertize " " ; Need this to be separate to mark it as rear-nonsticky + 'read-only t + 'rear-nonsticky t))) + (set-marker-insertion-type murk-input-marker nil)) + (if update-point + (goto-char murk-input-marker)) + (dolist (v update-window-points) + (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 + '((:eval + (let* ((ctx (murk-current-context))) + (if ctx + (let ((server (murk-context-server ctx))) + (concat + "Network: " server ", " + (if (murk-server-context-p ctx) + "Server" + (concat + "Channel: " + (murk-context-name ctx) + " (" + (number-to-string + (length (murk-context-users ctx))) + ")")))) + "No connection"))))))) + +(defun murk-setup-buffer () + (with-current-buffer (get-buffer-create "*murk*") + (setq-local scroll-conservatively 1) + (setq-local buffer-invisibility-spec nil) + (if (markerp murk-prompt-marker) + (set-marker murk-prompt-marker (point-max)) + (setq murk-prompt-marker (point-max-marker))) + (if (markerp murk-input-marker) + (set-marker murk-input-marker (point-max)) + (setq murk-input-marker (point-max-marker))) + (goto-char (point-max)) + (murk-render-prompt) + (if murk-display-header + (murk-setup-header)))) + +(defun murk-clear-buffer () + "Completely erase all non-prompt and non-input text from murk buffer." + (with-current-buffer "*murk*" + (let ((inhibit-read-only t)) + (delete-region (point-min) murk-prompt-marker)))) + + +;;; Output formatting and highlighting +;; + +(defun murk--fill-strings (col indent &rest strings) + (with-temp-buffer + (setq buffer-invisibility-spec nil) + (let ((fill-column col) + (adaptive-fill-regexp (rx-to-string `(= ,indent anychar)))) + (apply #'insert strings) + (fill-region (point-min) (point-max) nil t) + (buffer-string)))) + +(defun murk-display-string (context prefix &rest strings) + (with-current-buffer "*murk*" + (save-excursion + (goto-char murk-prompt-marker) + (let* ((inhibit-read-only t) + (old-pos (marker-position murk-prompt-marker)) + (padded-timestamp (concat (format-time-string "%H:%M "))) + (padded-prefix (if prefix (concat prefix " ") "")) + (context-atom (if context (intern (murk-context->string context)) nil))) + (insert-before-markers + (murk--fill-strings + 80 + (+ (length padded-timestamp) + (length padded-prefix)) + (propertize padded-timestamp + 'face 'murk-timestamp + 'read-only t + 'context context + 'invisible context-atom) + (propertize padded-prefix + 'read-only t + 'context context + 'invisible context-atom) + (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-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 + (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 + (goto-char (point-max)) + (line-beginning-position)))) + +(defun murk-scroll-windows-to-last-line () + (with-current-buffer "*murk*" + (dolist (window (get-buffer-window-list)) + (if (>= (window-point window) (murk--start-of-final-line)) + (with-selected-window window + (recenter -1)))))) + + + +(defconst murk-url-regex + (rx (: + (group (+ alpha)) + "://" + (group (or (+ (any alnum "." "-")) + (+ (any alnum ":")))) + (opt (group (: ":" (+ digit)))) + (opt (group (: "/" + (opt + (* (any alnum "-/.,#:%=&_?~@+")) + (any alnum "-/#:%=&_~@+"))))))) + "Imperfect regex used to find URLs in plain text.") + +(defun murk-click-url (button) + (browse-url (button-get button 'url))) + +(defun murk-buttonify-urls (&rest strings) + "Turn substrings which look like urls in STRING into clickable buttons." + (with-temp-buffer + (apply #'insert strings) + (goto-char (point-min)) + (while (re-search-forward murk-url-regex nil t) + (let ((url (match-string 0))) + (make-text-button (match-beginning 0) + (match-end 0) + 'action #'murk-click-url + 'url url + 'follow-link t + 'face 'button + '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") + + ("001" + (let* ((params (murk-msg-params msg)) + (nick (elt params 0)) + (text (string-join (seq-drop params 1) " "))) + (murk-set-connection-nick server nick) + (murk-display-notice nil text))) + + ((rx (= 3 (any digit))) + (murk-display-notice nil (mapconcat 'identity (cdr (murk-msg-params msg)) " "))) + + ((and "JOIN" + (guard (equal (murk-connection-nick server) + (murk-msg-src msg)))) + (let ((channel (car (murk-msg-params msg)))) + (murk-add-context (list server channel)) + (murk-display-notice (murk-current-context) + "Joining channel " channel " on " server) + (murk-render-prompt))) + + ((and "PART" + (guard (equal (murk-connection-nick server) + (murk-msg-src msg)))) + (let ((channel (car (murk-msg-params msg)))) + (murk-display-notice (murk-current-context) "Left channel " channel) + (murk-remove-context (list server channel)) + (murk-render-prompt))) + + ("QUIT" + (let ((nick (murk-msg-src msg)) + (reason (mapconcat 'identity (murk-msg-params msg) " "))) + (murk-del-user nick) + (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 (lurk-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)))))) + +;;; 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) + ("NETWORKS" "List known IRC networks." murk-command-networks) + ("CONNECT" "Connect to an IRC network." murk-command-connect murk-network-completions) + ("QUIT" "Disconnect from current network." murk-command-quit) + ("JOIN" "Join one or more channels." murk-command-join) + ("PART" "Leave channel." murk-command-part murk-context-completions) + ("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-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))) + (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-header (params) + (if + (if params + (equal (upcase (car params)) "ON") + (not header-line-format)) + (progn + (murk-setup-header) + (murk-display-notice nil "Header enabled.")) + (setq-local header-line-format nil) + (murk-display-notice nil "Header disabled."))) + +(defun murk-command-clear (params) + (if (not params) + (murk-clear-buffer) + (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) + (murk-msg nil nil "QUIT" quit-msg)))))) + +(defun murk-command-join (params) + (if params + (let ((server (murk-context-server (murk-current-context)))) + (dolist (channel params) + (murk-send-msg server (murk-msg nil nil "JOIN" channel)))) + (murk-display-notice nil "Usage: /join channel [channel2 ...]"))) + +(defun murk-command-part (params) + (let* ((server (murk-context-server (murk-current-context))) + (channel (if params + (car params) + (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.")))) + +(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 (lurk-msg nil nil "PRIVMSG" to text)) + (murk-display-message server + (murk-connection-nick server) + to text)) + (murk-display-notice nil "Usage: /msg ")))) + +;;; 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-context-server (murk-current-context)) + (murk-msg nil nil (upcase cmd-str) params))))) + (_ + (murk-display-error "Badly formed command."))) + (unless (string-empty-p string) + (if (murk-current-context) + (let ((server (murk-context-server (murk-current-context)))) + (murk-send-msg server + (murk-msg nil nil "PRIVMSG" + (murk-context-name (murk-current-context)) + string)) + (murk-display-message server + 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)))) + +(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 +;; + +(defvar murk-mode-map + (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)) + map)) + +(define-derived-mode murk-mode text-mode "murk" + "Major mode for murk.") + +(when (fboundp 'evil-set-initial-state) + (evil-set-initial-state 'murk-mode 'insert)) ;;; Main start procedure ;; -(defun metalurk) +(defun murk () + "Start murk or just switch to the murk buffer if one already exists." + (interactive) + (if (get-buffer "*murk*") + (switch-to-buffer "*murk*") + (switch-to-buffer "*murk*") + (murk-mode) + (murk-setup-buffer)) + "Started murk.") + -;;; metalurk.el ends here +;;; murk.el ends here