1 ;;; MURK --- Multiserver Unibuffer iRc Klient -*- lexical-binding:t -*-
3 ;; Copyright (C) 2024 plugd
5 ;; Author: plugd <plugd@thelambdalab.xyz>
6 ;; Created: 11 May 2024
9 ;; Homepage: http://thelambdalab.xyz/murk
10 ;; Package-Requires: ((emacs "26"))
12 ;; This file is not part of GNU Emacs.
14 ;; This program is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
19 ;; This program is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with this file. If not, see <http://www.gnu.org/licenses/>.
37 "Multiserver Unibuffer iRc Klient"
40 (defcustom murk-nick "plugd"
43 (defcustom murk-default-quit-msg "Bye"
44 "Default quit message when none supplied.")
46 (defcustom murk-networks
47 '(("libera" "irc.libera.chat" 6697)
48 ("tilde" "tilde.chat" 6697))
51 (defcustom murk-display-header t
52 "If non-nil, use buffer header to display information on current host and channel.")
62 (defvar murk-version "Murk v0.0"
63 "Value of this string is used in response to CTCP version queries.")
65 (defvar murk-notice-prefix "-!-")
66 (defvar murk-error-prefix "!!!")
67 (defvar murk-prompt-string ">")
69 ;;; Utility procedures
72 (defun murk--filtered-join (&rest args)
73 (string-join (seq-filter (lambda (el) el) args) " "))
75 (defun murk--as-string (obj)
77 (with-output-to-string (princ obj))
83 (defvar murk-connection-table nil
84 "An alist associating servers to connection information.
85 This includes the process and the response string.")
87 (defun murk-connection-process (server)
88 (elt (assoc server murk-connection-table) 1))
90 (defun murk-connection-response (server)
91 (elt (assoc server murk-connection-table) 2))
93 (defun murk-set-connection-response (server string)
94 (setf (elt (assoc server murk-connection-table) 2) string))
96 (defun murk-connection-close (server)
97 (setq murk-connection-table (assoc-delete-all server murk-connection-table)))
99 (defun murk-make-server-filter (server)
100 (lambda (proc string)
101 (dolist (line (split-string (concat (murk-connection-response server) string)
103 (if (string-suffix-p "\r" line)
104 (murk-eval-msg-string server (string-trim line))
105 (murk-set-connection-response line)))))
107 (defun murk-make-server-sentinel (server)
108 (lambda (proc string)
109 (unless (equal "open" (string-trim string))
110 (murk-display-error "Disconnected from server.")
111 (murk-remove-contexts-for-server server)
113 (murk-connection-close server))))
115 (defun murk-start-process (server)
116 (let* ((row (assoc server murk-networks))
119 (flags (seq-drop row 3)))
120 (make-network-process :name (concat "murk-" server)
124 :filter (murk-make-server-filter server)
125 :sentinel (murk-make-server-sentinel server)
127 :tls-parameters (if (memq :notls flags)
129 (cons 'gnutls-x509pki
130 (gnutls-boot-parameters
131 :type 'gnutls-x509pki
135 (defvar murk-ping-period 60)
137 ;; IDEA: Have a single ping timer which pings all connected hosts
139 (defun murk-connect (server)
140 (if (assoc server murk-connection-table)
141 (murk-display-error "Already connected to this network.")
142 (if (not (assoc server murk-networks))
143 (murk-display-error "Network '" server "' is unknown.")
144 (let ((proc (murk-start-process server)))
145 (add-to-list murk-connection-table
146 (list server proc "")))
147 (murk-send-msg server (murk-msg nil nil "USER" murk-nick 0 "*" murk-nick))
148 (murk-send-msg server (murk-msg nil nil "NICK" murk-nick)))))
150 (defun murk-send-msg (server msg)
152 (murk-display-string nil nil (murk-msg->string msg)))
153 (let ((proc (murk-connection-process server)))
154 (if (and proc (eq (process-status proc) 'open))
155 (process-send-string proc (concat (murk-msg->string msg) "\r\n"))
156 (murk-display-error "No server connection established.")
157 (error "No server connection established"))))
162 (defun murk-msg (tags src cmd &rest params)
163 (list (murk--as-string tags)
164 (murk--as-string src)
165 (upcase (murk--as-string cmd))
166 (mapcar #'murk--as-string
167 (if (and params (listp (elt params 0)))
171 (defun murk-msg-tags (msg) (elt msg 0))
172 (defun murk-msg-src (msg) (elt msg 1))
173 (defun murk-msg-cmd (msg) (elt msg 2))
174 (defun murk-msg-params (msg) (elt msg 3))
175 (defun murk-msg-trail (msg)
176 (let ((params (murk-msg-params msg)))
178 (elt params (- (length params) 1)))))
180 (defvar murk-msg-regex
182 (opt (: "@" (group (* (not (or "\n" "\r" ";" " ")))))
184 (opt (: ":" (: (group (* (not (any space "!" "@"))))
185 (* (not (any space)))))
187 (group (: (* (not whitespace))))
189 (opt (group (+ not-newline))))
190 "Regex used to parse IRC messages.
191 Note that this regex is incomplete. Noteably, we discard the non-nick
192 portion of the source component of the message, as mURK doesn't use this.")
194 (defun murk-string->msg (string)
195 (if (string-match murk-msg-regex string)
196 (let* ((tags (match-string 1 string))
197 (src (match-string 2 string))
198 (cmd (upcase (match-string 3 string)))
199 (params-str (match-string 4 string))
202 (let* ((idx (cl-search ":" params-str))
203 (l (split-string (string-trim (substring params-str 0 idx))))
204 (r (if idx (list (substring params-str (+ 1 idx))) nil)))
207 (apply #'murk-msg (append (list tags src cmd) params)))
208 (error "Failed to parse string " string)))
210 (defun murk-msg->string (msg)
211 (let ((tags (murk-msg-tags msg))
212 (src (murk-msg-src msg))
213 (cmd (murk-msg-cmd msg))
214 (params (murk-msg-params msg)))
216 (if tags (concat "@" tags) nil)
217 (if src (concat ":" src) nil)
219 (if (> (length params) 1)
220 (string-join (seq-take params (- (length params) 1)) " ")
222 (if (> (length params) 0)
223 (concat ":" (elt params (- (length params) 1)))
227 ;;; Contexts and Servers
230 ;; A context is a list (server name ...) where name is a string
231 ;; representing either a channel name or nick, and server is a symbol
232 ;; identifying the server.
234 ;; Each server has a special context (server) used for messages
235 ;; to/from the server itself.
237 (defvar murk-contexts nil
238 "List of currently-available contexts.
239 The head of this list is always the current context.")
241 (defun murk-current-context ()
242 "Returns the current context."
247 (defun murk-context-server (ctx) (elt ctx 0))
248 (defun murk-context-name (ctx) (elt ctx 1))
253 (defun murk-render-prompt ()
254 (with-current-buffer "*murk*"
255 (let ((update-point (= murk-input-marker (point)))
256 (update-window-points (mapcar (lambda (w)
257 (list (= (window-point w) murk-input-marker)
259 (get-buffer-window-list nil nil t))))
261 (set-marker-insertion-type murk-prompt-marker nil)
262 (set-marker-insertion-type murk-input-marker t)
263 (let ((inhibit-read-only t))
264 (delete-region murk-prompt-marker murk-input-marker)
265 (goto-char murk-prompt-marker)
267 (propertize (let ((ctx (murk-current-context)))
269 (concat (murk-context-name) "@" (murk-context-server ctx))
273 (propertize murk-prompt-string
276 (propertize " " ; Need this to be separate to mark it as rear-nonsticky
279 (set-marker-insertion-type murk-input-marker nil))
281 (goto-char murk-input-marker))
282 (dolist (v update-window-points)
284 (set-window-point (cadr v) murk-input-marker))))))
286 (defvar murk-prompt-marker nil
287 "Marker for prompt position in murk buffer.")
289 (defvar murk-input-marker nil
290 "Marker for prompt position in murk buffer.")
292 (defun murk-setup-header ()
296 (defun murk-setup-buffer ()
297 (with-current-buffer (get-buffer-create "*murk*")
298 (setq-local scroll-conservatively 1)
299 (setq-local buffer-invisibility-spec nil)
300 (if (markerp murk-prompt-marker)
301 (set-marker murk-prompt-marker (point-max))
302 (setq murk-prompt-marker (point-max-marker)))
303 (if (markerp murk-input-marker)
304 (set-marker murk-input-marker (point-max))
305 (setq murk-input-marker (point-max-marker)))
306 (goto-char (point-max))
308 (if murk-display-header
309 (murk-setup-header))))
311 (defun murk-clear-buffer ()
312 "Completely erase all non-prompt and non-input text from murk buffer."
313 (with-current-buffer "*murk*"
314 (let ((inhibit-read-only t))
315 (delete-region (point-min) murk-prompt-marker))))
318 ;;; Output formatting and highlighting
321 (defun murk--fill-strings (col indent &rest strings)
323 (setq buffer-invisibility-spec nil)
324 (let ((fill-column col)
325 (adaptive-fill-regexp (rx-to-string `(= ,indent anychar))))
326 (apply #'insert strings)
327 (fill-region (point-min) (point-max) nil t)
330 (defun murk-context->string (context)
332 (concat (murk-context-name) "@" (murk-context-server context))
336 (defun murk-display-string (context prefix &rest strings)
337 (with-current-buffer "*murk*"
339 (goto-char murk-prompt-marker)
340 (let* ((inhibit-read-only t)
341 (old-pos (marker-position murk-prompt-marker))
342 (padded-timestamp (concat (format-time-string "%H:%M ")))
343 (padded-prefix (if prefix (concat prefix " ") ""))
344 (context-atom (if context (intern (murk-context->string context)) nil)))
345 (insert-before-markers
348 (+ (length padded-timestamp)
349 (length padded-prefix))
350 (propertize padded-timestamp
351 'face 'murk-timestamp
354 'invisible context-atom)
355 (propertize padded-prefix
358 'invisible context-atom)
359 (concat (apply #'murk-buttonify-urls strings) "\n"))))))
360 (murk-scroll-windows-to-last-line))
362 (defun murk--start-of-final-line ()
363 (with-current-buffer "*murk*"
365 (goto-char (point-max))
366 (line-beginning-position))))
368 (defun murk-scroll-windows-to-last-line ()
369 (with-current-buffer "*murk*"
370 (dolist (window (get-buffer-window-list))
371 (if (>= (window-point window) (murk--start-of-final-line))
372 (with-selected-window window
375 (defconst murk-url-regex
379 (group (or (+ (any alnum "." "-"))
380 (+ (any alnum ":"))))
381 (opt (group (: ":" (+ digit))))
384 (* (any alnum "-/.,#:%=&_?~@+"))
385 (any alnum "-/#:%=&_~@+")))))))
386 "Imperfect regex used to find URLs in plain text.")
388 (defun murk-click-url (button)
389 (browse-url (button-get button 'url)))
391 (defun murk-buttonify-urls (&rest strings)
392 "Turn substrings which look like urls in STRING into clickable buttons."
394 (apply #'insert strings)
395 (goto-char (point-min))
396 (while (re-search-forward murk-url-regex nil t)
397 (let ((url (match-string 0)))
398 (make-text-button (match-beginning 0)
400 'action #'murk-click-url
404 'help-echo "Open URL in browser.")))
411 (defvar murk-mode-map
412 (let ((map (make-sparse-keymap)))
413 (define-key map (kbd "RET") 'murk-enter)
414 (define-key map (kbd "TAB") 'murk-complete-input)
415 (when (fboundp 'evil-define-key*)
416 (evil-define-key* 'motion map
417 (kbd "TAB") 'murk-complete-input))
420 (define-derived-mode murk-mode text-mode "murk"
421 "Major mode for murk.")
423 (when (fboundp 'evil-set-initial-state)
424 (evil-set-initial-state 'murk-mode 'insert))
426 ;;; Main start procedure
430 "Start murk or just switch to the murk buffer if one already exists."
432 (if (get-buffer "*murk*")
433 (switch-to-buffer "*murk*")
434 (switch-to-buffer "*murk*")
440 ;;; murk.el ends here