1 ;;; murk.el --- Multinetwork Unibuffer iRc Klient -*- lexical-binding:t -*-
3 ;; Copyright (C) 2024 plugd
5 ;; Author: plugd <plugd@thelambdalab.xyz>
6 ;; Created: 11 May 2024
8 ;; Homepage: http://thelambdalab.xyz/murk
10 ;; Package-Requires: ((emacs "26.1"))
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/>.
29 ;; A very simple IRC client which uses only a single buffer.
41 "Multinetwork Unibuffer iRc Klient"
44 (defcustom murk-default-nick "plugd"
48 (defcustom murk-default-quit-msg "Bye"
49 "Default quit message when none supplied."
52 (defcustom murk-networks
53 '(("debug" "localhost" 6697)
54 ("libera" "irc.libera.chat" 6697)
55 ("tilde" "tilde.chat" 6697)
56 ("sdf" "irc.sdf.org" 6697)
57 ("freenode" "chat.freenode.net" 6697)
58 ("mbr" "mbrserver.com" 6667 :notls))
60 :type '(alist :key-type string))
62 (defcustom murk-show-joins nil
63 "Set to non-nil to be notified of joins, parts and quits.")
65 (defcustom murk-display-header t
66 "If non-nil, use buffer header to display current host and channel."
69 (defcustom murk-autoreply-table nil
70 "Table of autoreply messages.
72 Each autoreply is a list of two elements: (matcher reply)
74 Here matcher is a list:
76 (network src cmd params ...)
78 and reply is another list:
82 Each entry in the matcher list is a regular expression tested against the
83 corresponding values in the incomming message. Entries can be nil,
84 in which case they match anything."
85 :type '(list (list) (list)))
92 '((t :inherit default))
93 "Face used for murk text.")
96 '((t :inherit font-lock-keyword-face))
97 "Face used for the prompt.")
100 '((t :inherit murk-context))
101 "Face used for the context name in the prompt.")
104 '((t :inherit shadow))
105 "Face used for faded murk text.")
107 (defface murk-timestamp
108 '((t :inherit shadow))
109 "Face used for timestamps.")
112 '((t :inherit error))
113 "Face used for murk error text.")
116 '((t :inherit warning))
117 "Face used for murk notice text.")
123 (defvar murk-version "Murk v0.0"
124 "Value of this string is used in response to CTCP version queries.")
126 (defvar murk-notice-prefix "-!-")
127 (defvar murk-error-prefix "!!!")
128 (defvar murk-prompt-string ">")
130 (defvar murk-debug nil
131 "If non-nil, enable debug mode.")
134 ;;; Utility procedures
137 (defun murk--filtered-join (&rest args)
138 (string-join (seq-filter (lambda (el) el) args) " "))
140 (defun murk--as-string (obj)
142 (with-output-to-string (princ obj))
146 ;;; Network processes
149 (defvar murk-connection-table nil
150 "An alist associating networks to connection information.
151 This includes the process and the response string.")
153 (defun murk-connection-process (network)
154 (elt (assoc network murk-connection-table) 1))
156 (defun murk-connection-nick (network)
157 (elt (assoc network murk-connection-table) 2))
159 (defun murk-set-connection-nick (network nick)
160 (setf (elt (assoc network murk-connection-table) 2) nick))
162 (defun murk-connection-response (network)
163 (elt (assoc network murk-connection-table) 3))
165 (defun murk-set-connection-response (network string)
166 (setf (elt (assoc network murk-connection-table) 3) string))
168 (defun murk-connection-new (network process nick)
169 (add-to-list 'murk-connection-table
170 (list network process nick "")))
172 (defun murk-connection-remove (network)
173 (setq murk-connection-table
174 (seq-remove (lambda (row) (equal (car row) network))
175 murk-connection-table)))
177 (defun murk-make-network-filter (network)
178 (lambda (_proc string)
179 (dolist (line (split-string (concat (murk-connection-response network) string)
181 (if (string-suffix-p "\r" line)
182 (murk-eval-msg-string network (string-trim line))
183 (murk-set-connection-response network line)))))
185 (defun murk-make-network-sentinel (network)
186 (lambda (_proc string)
187 (unless (equal "open" (string-trim string))
188 (murk-display-error "Disconnected from network.")
189 (murk-connection-remove network)
190 (murk-remove-network-contexts network)
191 (murk-highlight-current-context)
192 (murk-render-prompt))))
194 (defun murk-start-process (network)
195 (let* ((row (assoc network murk-networks))
198 (flags (seq-drop row 3)))
199 (make-network-process :name (concat "murk-" network)
203 :filter (murk-make-network-filter network)
204 :sentinel (murk-make-network-sentinel network)
206 :tls-parameters (if (memq :notls flags)
208 (cons 'gnutls-x509pki
209 (gnutls-boot-parameters
210 :type 'gnutls-x509pki
214 (defvar murk-ping-period 60)
216 ;; IDEA: Have a single ping timer which pings all connected hosts
218 (defun murk-connect (network)
219 (if (assoc network murk-connection-table)
220 (murk-display-error "Already connected to this network")
221 (if (not (assoc network murk-networks))
222 (murk-display-error "Network '" network "' is unknown.")
223 (let ((proc (murk-start-process network)))
224 (murk-connection-new network proc murk-default-nick))
225 (murk-send-msg network (murk-msg nil nil "USER" murk-default-nick 0 "*" murk-default-nick))
226 (murk-send-msg network (murk-msg nil nil "NICK" murk-default-nick))
227 (murk-add-context (list network))
228 (murk-highlight-current-context)
229 (murk-render-prompt))))
231 (defun murk-send-msg (network msg)
233 (murk-display-string nil nil (murk-msg->string msg)))
234 (let ((proc (murk-connection-process network)))
235 (if (and proc (eq (process-status proc) 'open))
236 (process-send-string proc (concat (murk-msg->string msg) "\r\n"))
237 (murk-display-error "No network connection established"))))
243 (defun murk-msg (tags src cmd &rest params)
244 (list (murk--as-string tags)
245 (murk--as-string src)
246 (upcase (murk--as-string cmd))
247 (mapcar #'murk--as-string
248 (if (and params (listp (elt params 0)))
252 (defun murk-msg-tags (msg) (elt msg 0))
253 (defun murk-msg-src (msg) (elt msg 1))
254 (defun murk-msg-cmd (msg) (elt msg 2))
255 (defun murk-msg-params (msg) (elt msg 3))
256 (defun murk-msg-trail (msg)
257 (let ((params (murk-msg-params msg)))
259 (elt params (- (length params) 1)))))
261 (defvar murk-msg-regex
263 (opt (: "@" (group (* (not (or "\n" "\r" ";" " ")))))
265 (opt (: ":" (: (group (* (not (any space "!" "@"))))
266 (* (not (any space)))))
268 (group (: (* (not whitespace))))
270 (opt (group (+ not-newline))))
271 "Regex used to parse IRC messages.
272 Note that this regex is incomplete. Noteably, we discard the non-nick
273 portion of the source component of the message, as mURK doesn't use this.")
275 (defun murk-string->msg (string)
276 (if (string-match murk-msg-regex string)
277 (let* ((tags (match-string 1 string))
278 (src (match-string 2 string))
279 (cmd (upcase (match-string 3 string)))
280 (params-str (match-string 4 string))
283 (let* ((idx (seq-position params-str ?:))
284 (l (split-string (string-trim (substring params-str 0 idx))))
285 (r (if idx (list (substring params-str (+ 1 idx))) nil)))
288 (apply #'murk-msg (append (list tags src cmd) params)))
289 (error "Failed to parse string %s" string)))
291 (defun murk-msg->string (msg)
292 (let ((tags (murk-msg-tags msg))
293 (src (murk-msg-src msg))
294 (cmd (murk-msg-cmd msg))
295 (params (murk-msg-params msg)))
297 (if tags (concat "@" tags) nil)
298 (if src (concat ":" src) nil)
300 (if (> (length params) 1)
301 (string-join (seq-take params (- (length params) 1)) " ")
303 (if (> (length params) 0)
304 (concat ":" (elt params (- (length params) 1)))
311 ;; A context is a list (network channel) identifying the network
312 ;; and channel. The tail of the list contains the nicks of users
313 ;; present in the channel.
315 ;; Each network has a special context (network) used for messages
316 ;; to/from the network itself.
318 (defvar murk-contexts nil
319 "List of currently-available contexts.
320 The head of this list is always the current context.")
322 (defun murk-current-context ()
323 "Return the current context."
328 (defun murk-contexts-equal (c1 c2)
329 (if (murk-network-context-p c1)
330 (and (murk-network-context-p c2)
331 (equal (murk-context-network c1)
332 (murk-context-network c2)))
333 (and (not (murk-network-context-p c2))
334 (equal (seq-take c1 2)
337 (defun murk-context-network (ctx)
340 (defun murk-context-channel (ctx)
343 (defun murk-network-context-p (ctx)
346 (defun murk-add-context (ctx)
347 (add-to-list 'murk-contexts ctx))
349 (defun murk-remove-context (ctx)
353 (murk-contexts-equal this-ctx ctx))
356 (defun murk-remove-network-contexts (network)
358 (seq-remove (lambda (row) (equal (car row) network))
361 (defun murk-context->string (ctx)
363 (if (murk-network-context-p ctx)
365 (concat (murk-context-channel ctx) "@"))
366 (murk-context-network ctx)))
368 (defun murk-string->context (string)
369 (if (not (string-prefix-p "#" string))
370 (murk-get-context string)
371 (let* ((parts (string-split string "@"))
372 (channel (elt parts 0))
373 (network (elt parts 1)))
374 (murk-get-context network channel))))
376 (defun murk-get-context (network &optional channel)
377 (if (and channel (string-prefix-p "#" channel))
378 (let ((test-ctx (list network channel)))
379 (seq-find (lambda (ctx)
380 (equal (seq-take ctx 2) test-ctx))
382 (car (member (list network) murk-contexts))))
384 (defun murk-cycle-contexts (&optional reverse)
387 (let ((nminus1 (- (length murk-contexts) 1)))
389 (elt murk-contexts nminus1)
390 (seq-take murk-contexts nminus1)))
391 (append (cdr murk-contexts) (list (car murk-contexts))))))
393 (defun murk-switch-to-context (ctx)
395 (let* ((new-head (memq ctx murk-contexts))
396 (new-tail (take (- (length murk-contexts)
399 (append new-head new-tail))))
404 (defvar murk-context-users nil
405 "Association list between channel contexts and users.")
407 (defun murk-get-context-users (ctx)
408 (cdr (assoc ctx murk-context-users)))
410 (defun murk-set-context-users (ctx users)
411 (setq murk-context-users
412 (cons (cons ctx users) (assoc-delete-all ctx murk-context-users))))
414 (defun murk-add-context-users (ctx users)
415 (murk-set-context-users
417 (cl-union users (murk-get-context-users ctx))))
419 (defun murk-del-context-user (ctx user)
420 (murk-set-context-users
422 (delete user (murk-get-context-users ctx))))
424 (defun murk-del-all-context-users (ctx)
425 (murk-set-context-users ctx nil))
427 (defun murk-del-network-user (network user)
428 (dolist (ctx murk-contexts)
429 (if (and (equal (murk-context-network ctx) network)
430 (not (murk-network-context-p ctx)))
431 (murk-del-context-user ctx user))))
433 (defun murk-del-all-network-users (network)
434 (dolist (ctx murk-contexts)
435 (if (and (equal (murk-context-network ctx) network)
436 (not (murk-network-context-p ctx)))
437 (murk-del-all-context-users ctx))))
439 (defun murk-rename-network-user (network old-nick new-nick)
440 (dolist (ctx murk-contexts)
441 (when (and (equal (murk-context-network ctx) network)
442 (member old-nick (murk-get-context-users ctx)))
443 (murk-del-context-user ctx old-nick)
444 (murk-add-context-users ctx (list new-nick)))))
450 (defvar murk-prompt-marker nil
451 "Marker for prompt position in murk buffer.")
453 (defvar murk-input-marker nil
454 "Marker for prompt position in murk buffer.")
456 (defun murk-render-prompt ()
457 (with-current-buffer "*murk*"
458 (let ((update-point (= murk-input-marker (point)))
459 (update-window-points (mapcar (lambda (w)
460 (list (= (window-point w) murk-input-marker)
462 (get-buffer-window-list nil nil t))))
464 (set-marker-insertion-type murk-prompt-marker nil)
465 (set-marker-insertion-type murk-input-marker t)
466 (let ((inhibit-read-only t))
467 (delete-region murk-prompt-marker murk-input-marker)
468 (goto-char murk-prompt-marker)
470 (propertize (let ((ctx (murk-current-context)))
472 (murk-context->string ctx)
476 (propertize murk-prompt-string
479 (propertize " " ; Need this to be separate to mark it as rear-nonsticky
482 (set-marker-insertion-type murk-input-marker nil))
484 (goto-char murk-input-marker))
485 (dolist (v update-window-points)
487 (set-window-point (cadr v) murk-input-marker))))))
489 (defun murk-setup-header ()
490 (with-current-buffer "*murk*"
491 (setq-local header-line-format
493 (let* ((ctx (murk-current-context)))
495 (let ((network (murk-context-network ctx)))
497 "Network: " network ", "
498 (if (murk-network-context-p ctx)
502 (murk-context-channel ctx)
505 (length (murk-get-context-users ctx)))
507 "No connection")))))))
509 (defun murk-setup-buffer ()
510 (with-current-buffer (get-buffer-create "*murk*")
511 (setq-local scroll-conservatively 1)
512 (setq-local buffer-invisibility-spec nil)
513 (if (markerp murk-prompt-marker)
514 (set-marker murk-prompt-marker (point-max))
515 (setq murk-prompt-marker (point-max-marker)))
516 (if (markerp murk-input-marker)
517 (set-marker murk-input-marker (point-max))
518 (setq murk-input-marker (point-max-marker)))
519 (goto-char (point-max))
520 (murk-highlight-current-context)
522 (if murk-display-header
523 (murk-setup-header))))
525 (defun murk-clear-buffer ()
526 "Completely erase all non-prompt and non-input text from murk buffer."
527 (with-current-buffer "*murk*"
528 (let ((inhibit-read-only t))
529 (delete-region (point-min) murk-prompt-marker))))
532 ;;; Output formatting and highlighting
535 ;; Idea: the face text property can be a list of faces, applied in
536 ;; order. By assigning each context a unique list and keeping track
537 ;; of these in a hash table, we can easily switch the face
538 ;; corresponding to a particular context by modifying the elements of
541 ;; More subtly, we make only the cdrs of this list shared among
542 ;; all text of a given context, allowing the cars to be different
543 ;; and for different elements of the context-specific text to have
544 ;; different styling.
546 ;; Additionally, we allow selective hiding of contexts via
547 ;; the buffer-invisibility-spec.
549 (defvar murk-context-facelists (make-hash-table :test 'equal)
550 "List of seen contexts and associated face lists.")
552 (defun murk-get-context-facelist (context)
553 (let* ((facelist (gethash context murk-context-facelists)))
555 (setq facelist (list 'murk-text))
556 (puthash context facelist murk-context-facelists))
559 (defun murk--fill-strings (col indent &rest strings)
561 (setq buffer-invisibility-spec nil)
562 (let ((fill-column col)
563 (adaptive-fill-regexp (rx-to-string `(= ,indent anychar))))
564 (apply #'insert strings)
565 (fill-region (point-min) (point-max) nil t)
568 (defun murk-display-string (context prefix &rest strings)
569 (with-current-buffer "*murk*"
571 (goto-char murk-prompt-marker)
572 (let* ((inhibit-read-only t)
573 (old-pos (marker-position murk-prompt-marker))
574 (padded-timestamp (concat (format-time-string "%H:%M ")))
575 (padded-prefix (if prefix (concat prefix " ") ""))
576 (context-atom (if context
577 (intern (murk-context->string context))
579 (context-face (murk-get-context-facelist context)))
580 (insert-before-markers
583 (+ (length padded-timestamp)
584 (length padded-prefix))
585 (propertize padded-timestamp
586 'face 'murk-timestamp
589 'invisible context-atom)
590 (propertize padded-prefix
593 'invisible context-atom)
595 (propertize (concat (apply #'murk-buttonify-urls strings) "\n")
599 'invisible context-atom)))))))
600 (murk-scroll-windows-to-last-line))
602 (defun murk-click-context (button)
603 (murk-switch-to-context (button-get button 'context))
604 (murk-highlight-current-context)
607 (murk-zoom-in (murk-current-context))))
609 (defun murk-make-context-button (context &optional string)
611 (let ((label (or string (murk-context->string context))))
612 (insert-text-button label
613 'action #'murk-click-context
616 'help-echo "Switch context"))
619 (defun murk-display-message (network from to text)
620 (let ((context (if (string-prefix-p "#" to)
621 (murk-get-context network to)
622 (murk-get-context network))))
626 (if (murk-network-context-p context)
627 (concat "[" from "->" to "]")
629 (murk-make-context-button context)
631 'face (murk-get-context-facelist context))
634 (defun murk-display-action (network from to action-text)
635 (let ((context (if (string-prefix-p "#" to)
636 (murk-get-context network to)
637 (murk-get-context network))))
641 (concat (murk-context->string context) " *")
642 'face (murk-get-context-facelist context))
643 from " " action-text)))
645 (defun murk-display-notice (context &rest notices)
648 (propertize murk-notice-prefix 'face 'murk-notice)
649 (apply #'concat notices)))
651 (defun murk-display-error (&rest messages)
654 (propertize murk-error-prefix 'face 'murk-error)
655 (apply #'concat messages)))
657 (defun murk-highlight-current-context ()
658 (with-current-buffer "*murk*"
660 (lambda (this-context facelist)
661 (if (equal this-context (murk-current-context))
662 (setcar facelist 'murk-text)
663 (setcar facelist 'murk-faded)))
664 murk-context-facelists))
665 (force-window-update "*murk*"))
667 (defun murk-zoom-in (context)
668 (with-current-buffer "*murk*"
670 (lambda (this-context _)
672 (let ((this-context-atom
673 (intern (murk-context->string this-context))))
674 (if (equal this-context context)
675 (remove-from-invisibility-spec this-context-atom)
676 (add-to-invisibility-spec this-context-atom)))))
677 murk-context-facelists)
678 (force-window-update "*murk*"))
679 (murk-scroll-windows-to-last-line))
681 (defun murk-zoom-out ()
682 (with-current-buffer "*murk*"
684 (lambda (this-context _)
685 (let ((this-context-atom
687 (intern (murk-context->string this-context))
689 (remove-from-invisibility-spec this-context-atom)))
690 murk-context-facelists)
691 (force-window-update "*murk*"))
692 (murk-scroll-windows-to-last-line))
694 (defun murk--start-of-final-line ()
695 (with-current-buffer "*murk*"
697 (goto-char (point-max))
698 (line-beginning-position))))
700 (defun murk-scroll-windows-to-last-line ()
701 (with-current-buffer "*murk*"
702 (dolist (window (get-buffer-window-list))
703 (if (>= (window-point window) (murk--start-of-final-line))
704 (with-selected-window window
707 (defconst murk-url-regex
711 (group (or (+ (any alnum "." "-"))
712 (+ (any alnum ":"))))
713 (opt (group (: ":" (+ digit))))
716 (* (any alnum "-/.,#:%=&_?~@+"))
717 (any alnum "-/#:%=&_~@+")))))))
718 "Imperfect regex used to find URLs in plain text.")
720 (defun murk-click-url (button)
721 (browse-url (button-get button 'url)))
723 (defun murk-buttonify-urls (&rest strings)
724 "Turn substrings which look like urls in STRING into clickable buttons."
726 (apply #'insert strings)
727 (goto-char (point-min))
728 (while (re-search-forward murk-url-regex nil t)
729 (let ((url (match-string 0)))
730 (make-text-button (match-beginning 0)
732 'action #'murk-click-url
736 'help-echo "Open URL in browser.")))
739 (defun murk-add-formatting (string)
742 (goto-char (point-min))
747 (prev-point (point)))
748 (while (re-search-forward (rx (or (any "\x02\x1D\x1F\x1E\x0F")
749 (: "\x03" (* digit) (opt "," (* digit)))))
751 (let ((beg (+ (match-beginning 0) 1)))
753 (add-face-text-property prev-point beg '(:weight bold)))
755 (add-face-text-property prev-point beg '(:slant italic)))
757 (add-face-text-property prev-point beg '(:underline t)))
759 (add-face-text-property prev-point beg '(:strike-through t)))
760 (pcase (match-string 0)
761 ("\x02" (setq bold (not bold)))
762 ("\x1D" (setq italics (not italics)))
763 ("\x1F" (setq underline (not underline)))
764 ("\x1E" (setq strikethrough (not strikethrough)))
769 (setq strikethrough nil))
771 (delete-region (match-beginning 0) (match-end 0))
772 (setq prev-point (point)))))
776 ;;; Message evaluation
779 (defun murk-eval-msg-string (network string)
781 (murk-display-string nil nil string))
782 (let* ((msg (murk-string->msg string)))
783 (murk-process-autoreplies network msg)
784 (pcase (murk-msg-cmd msg)
786 (murk-send-msg network
787 (murk-msg nil nil "PONG" (murk-msg-params msg))))
792 (let* ((params (murk-msg-params msg))
793 (nick (elt params 0))
794 (text (string-join (seq-drop params 1) " ")))
795 (murk-set-connection-nick network nick)
796 (murk-display-notice (murk-get-context network) text))
797 (let* ((row (assoc network murk-networks))
798 (channels (if (memq :channels row)
799 (cdr (memq :channels row))
801 (dolist (channel channels)
802 (murk-command-join (list channel)))))
805 (let* ((params (murk-msg-params msg))
806 (channel (elt params 2))
807 (names (split-string (elt params 3)))
808 (ctx (murk-get-context network channel)))
810 (murk-add-context-users ctx names)
811 (murk-display-notice ctx "Users in " channel
812 ": " (string-join names " ")))))
815 (let* ((params (murk-msg-params msg))
816 (channel (elt params 1))
817 (ctx (murk-get-context network channel)))
821 (murk--as-string (length (murk-get-context-users ctx)))
822 " users in " channel)
823 (murk-display-notice (murk-get-context network)
824 "End of " channel " names list."))))
827 (let* ((params (murk-msg-params msg))
828 (channel (elt params 1))
829 (ctx (murk-get-context network channel)))
830 (murk-display-notice ctx "No topic set.")))
833 (let* ((params (murk-msg-params msg))
834 (channel (elt params 1))
835 (topic (elt params 2))
836 (ctx (murk-get-context network channel)))
837 (murk-display-notice ctx "Topic: " topic)))
839 ((rx (= 3 (any digit)))
840 (murk-display-notice (murk-get-context network)
841 (mapconcat 'identity (cdr (murk-msg-params msg)) " ")))
844 (guard (equal (murk-connection-nick network)
845 (murk-msg-src msg))))
846 (let* ((channel (car (murk-msg-params msg)))
847 (context (list network channel)))
848 (murk-add-context context)
849 (murk-del-all-context-users context)
850 (murk-display-notice (murk-current-context)
851 "Joining channel " channel " on " network)
852 (murk-highlight-current-context)
853 (murk-render-prompt)))
856 (let* ((channel (car (murk-msg-params msg)))
857 (nick (murk-msg-src msg))
858 (ctx (murk-get-context network channel)))
859 (murk-add-context-users ctx (list nick))
861 (murk-display-notice ctx nick " joined channel " channel
865 (guard (equal (murk-connection-nick network)
866 (murk-msg-src msg))))
867 (let* ((channel (car (murk-msg-params msg)))
868 (context (list network channel)))
869 (murk-display-notice context "Left channel " channel)
870 (murk-remove-context context)
871 (murk-del-all-context-users context)
872 (murk-highlight-current-context)
873 (murk-render-prompt)))
876 (let* ((channel (car (murk-msg-params msg)))
877 (nick (murk-msg-src msg))
878 (ctx (murk-get-context network channel)))
879 (murk-del-context-user ctx nick)
881 (murk-display-notice ctx nick " left channel " channel
885 (guard (equal (murk-connection-nick network)
886 (murk-msg-src msg))))
887 (let ((new-nick (car (murk-msg-params msg)))
888 (old-nick (murk-connection-nick network)))
889 (murk-set-connection-nick network new-nick)
890 (murk-rename-network-user network old-nick new-nick)
891 (murk-display-notice (murk-get-context network)
892 "Nick set to " new-nick " on " network)))
895 (let ((old-nick (murk-msg-src msg))
896 (new-nick (car (murk-msg-params msg))))
897 (murk-display-notice (murk-get-context network)
898 old-nick " is now known as " new-nick
900 (murk-rename-network-user network old-nick new-nick)))
903 (let ((channel (car (murk-msg-params msg)))
904 (nick (murk-msg-src msg))
905 (topic (cadr (murk-msg-params msg))))
906 (murk-display-notice (murk-get-context network channel)
907 nick " set the topic: " topic)))
910 (let ((nick (murk-msg-src msg))
911 (reason (mapconcat 'identity (murk-msg-params msg) " ")))
912 (murk-del-network-user network nick)
914 (murk-display-notice (murk-get-context network)
915 nick " on " network " has quit: " reason))))
918 (let ((nick (murk-msg-src msg))
919 (channel (car (murk-msg-params msg)))
920 (text (cadr (murk-msg-params msg))))
922 ((rx (: "\01VERSION "
923 (let version (* (not "\01")))
925 (murk-display-notice (murk-get-context network)
926 "CTCP version reply from " nick ": " version))
928 (murk-display-notice (murk-get-context network channel) text)))))
931 (let* ((from (murk-msg-src msg))
932 (params (murk-msg-params msg))
934 (text (cadr params)))
937 (let ((version-string (concat murk-version " - running on GNU Emacs " emacs-version)))
938 (murk-send-msg network
939 (murk-msg nil nil "NOTICE"
940 (list from (concat "\01VERSION "
943 (murk-display-notice (murk-get-context network)
944 "CTCP version request received from "
945 from " on " network))
947 ((rx (let ping (: "\01PING " (* (not "\01")) "\01")))
948 (murk-send-msg network (murk-msg nil nil "NOTICE" (list from ping)))
949 (murk-display-notice (murk-get-context network)
950 "CTCP ping received from " from " on " network))
953 (murk-display-notice (murk-get-context network)
954 "CTCP userinfo request from " from
955 " on " network " (no response sent)"))
958 (murk-display-notice (murk-get-context network)
959 "CTCP clientinfo request from " from
960 " on " network " (no response sent)"))
962 ((rx (: "\01ACTION " (let action-text (* (not "\01"))) "\01"))
963 (murk-display-action network from to action-text))
966 (murk-display-message network from to text)))))
969 (murk-display-notice (murk-get-context network)
970 (murk-msg->string msg))))))
973 ;;; User-defined responses
976 (defun murk--lists-equal (l1 l2)
978 (if (or (not (and (car l1) (car l2)))
979 (string-match (car l1) (car l2)))
980 (murk--lists-equal (cdr l1) (cdr l2))
984 (defun murk-process-autoreply (network msg autoreply)
985 (let ((matcher (car autoreply))
986 (reply (cadr autoreply)))
987 (let ((target-network (car matcher)))
988 (when (and (or (not target-network)
989 (and (equal network target-network)))
990 (murk--lists-equal (cdr matcher)
991 (append (list (murk-msg-src msg)
993 (murk-msg-params msg))))
994 (murk-send-msg network
995 (murk-msg nil nil (car reply) (cdr reply)))))))
997 (defun murk-process-autoreplies (network msg)
1000 (murk-process-autoreply network msg autoreply))
1001 murk-autoreply-table))
1007 (defvar murk-command-table
1008 '(("DEBUG" "Toggle debug mode on/off." murk-command-debug murk-boolean-completions)
1009 ("HEADER" "Toggle display of header." murk-command-header murk-boolean-completions)
1010 ("SHOWJOINS" "Toggles display of joins/parts." murk-command-showjoins murk-boolean-completions)
1011 ("NETWORKS" "List known IRC networks." murk-command-networks)
1012 ("CONNECT" "Connect to an IRC network." murk-command-connect murk-network-completions)
1013 ("QUIT" "Disconnect from current network." murk-command-quit)
1014 ("JOIN" "Join one or more channels." murk-command-join)
1015 ("PART" "Leave channel." murk-command-part murk-channel-completions)
1016 ("SWITCHCONTEXT" "Switch current context" murk-command-switch-context murk-context-completions)
1017 ("NICK" "Change nick." murk-command-nick)
1018 ("LIST" "Display details of one or more channels." murk-command-list)
1019 ("TOPIC" "Set/query topic for current channel." murk-command-topic)
1020 ("USERS" "List nicks of users in current channel." murk-command-users)
1021 ("MSG" "Send private message to user." murk-command-msg murk-nick-completions)
1022 ("ME" "Display action." murk-command-me)
1023 ("VERSION" "Request version of another user's client via CTCP." murk-command-version murk-nick-completions)
1024 ("CLEAR" "Clear buffer text." murk-command-clear murk-context-completions)
1025 ("HELP" "Display help on client commands." murk-command-help murk-help-completions))
1026 "Table of commands explicitly supported by murk.")
1028 (defun murk-boolean-completions ()
1031 (defun murk-network-completions ()
1032 (mapcar (lambda (row) (car row)) murk-networks))
1034 (defun murk-help-completions ()
1035 (mapcar (lambda (row) (car row)) murk-command-table))
1037 (defun murk-channel-completions ()
1038 (mapcar (lambda (ctx)
1039 (murk-context->string ctx))
1040 (seq-filter (lambda (ctx)
1041 (not (murk-network-context-p ctx)))
1044 (defun murk-context-completions ()
1045 (mapcar (lambda (ctx) (murk-context->string ctx)) murk-contexts))
1047 (defun murk-command-help (params)
1049 (let* ((cmd-str (upcase (car params)))
1050 (row (assoc cmd-str murk-command-table #'equal)))
1053 (murk-display-notice nil "Help for \x02" cmd-str "\x02:")
1054 (murk-display-notice nil " " (elt row 1)))
1055 (murk-display-notice nil "No such (client-interpreted) command.")))
1056 (murk-display-notice nil "Client-interpreted commands:")
1057 (dolist (row murk-command-table)
1058 (murk-display-notice nil " \x02" (elt row 0) "\x02: " (elt row 1)))
1059 (murk-display-notice nil "Use /HELP COMMAND to display information about a specific command.")))
1061 (defun murk-command-debug (params)
1064 (if (equal (upcase (car params)) "ON")
1068 (murk-display-notice nil "Debug mode now " (if murk-debug "on" "off") "."))
1070 (defun murk-command-header (params)
1073 (equal (upcase (car params)) "ON")
1074 (not header-line-format))
1077 (murk-display-notice nil "Header enabled."))
1078 (setq-local header-line-format nil)
1079 (murk-display-notice nil "Header disabled.")))
1081 (defun murk-command-showjoins (params)
1082 (setq murk-show-joins
1084 (if (equal (upcase (car params)) "ON")
1087 (not murk-show-joins)))
1088 (murk-display-notice nil "Joins/parts will now be "
1089 (if murk-show-joins "shown" "hidden") "."))
1091 (defun murk-command-connect (params)
1093 (let ((network (car params)))
1094 (murk-display-notice nil "Attempting to connect to " network "...")
1095 (murk-connect network))
1096 (murk-display-notice nil "Usage: /connect <network>")))
1098 (defun murk-command-networks (_params)
1099 (murk-display-notice nil "Currently-known networks:")
1100 (dolist (row murk-networks)
1101 (seq-let (network network port &rest _others) row
1102 (murk-display-notice nil "\t" network
1104 " " (number-to-string port) "]")))
1105 (murk-display-notice nil "(Modify the `murk-networks' variable to add more.)"))
1107 (defun murk-command-quit (params)
1108 (let ((ctx (murk-current-context)))
1110 (murk-display-error "No current network")
1111 (let ((quit-msg (if params (string-join params " ") murk-default-quit-msg)))
1113 (murk-context-network ctx)
1114 (murk-msg nil nil "QUIT" quit-msg))))))
1116 (defun murk-command-join (params)
1118 (let ((network (murk-context-network (murk-current-context))))
1119 (dolist (channel params)
1120 (murk-send-msg network (murk-msg nil nil "JOIN" channel))))
1121 (murk-display-notice nil "Usage: /join channel [channel2 ...]")))
1123 (defun murk-command-part (params)
1125 ((not params) (murk-current-context))
1126 ((seq-contains (car params) "@") (murk-string->context (car params)))
1127 (t (list (murk-context-network (murk-current-context)) (car params))))))
1128 (let ((network (murk-context-network ctx))
1129 (channel (murk-context-channel ctx)))
1131 (murk-send-msg network (murk-msg nil nil "PART" channel))
1132 (murk-display-error "Specify which channel to leave")))))
1134 (defun murk-command-switch-context (params)
1136 (murk-display-notice nil "Usage: /switchcontext #channel@network")
1137 (let ((ctx (murk-string->context (car params))))
1138 (murk-switch-to-context ctx)
1139 (murk-highlight-current-context)
1140 (murk-render-prompt)
1142 (murk-zoom-in (murk-current-context))))))
1144 (defun murk-command-nick (params)
1146 (let ((new-nick (string-join params " "))
1147 (ctx (murk-current-context)))
1149 (murk-send-msg (murk-context-network ctx)
1150 (murk-msg nil nil "NICK" new-nick))
1151 (murk-display-error "No current connection")))
1152 (murk-display-notice nil "Usage: /nick <new-nick>")))
1154 (defun murk-command-list (params)
1155 (let ((ctx (murk-current-context)))
1158 (murk-display-notice nil "This command can generate lots of output."
1159 " Use `/LIST -yes' if you really want this,"
1160 " or `/LIST <channel_regexp>' to reduce the output.")
1161 (let ((network (murk-context-network ctx)))
1162 (if (equal (upcase (car params)) "-YES")
1163 (murk-send-msg network (murk-msg nil nil "LIST"))
1164 (murk-send-msg network (murk-msg nil nil "LIST"
1166 (murk-display-error "No current connection"))))
1168 (defun murk-command-topic (params)
1169 (let ((ctx (murk-current-context)))
1170 (if (and ctx (not (murk-network-context-p ctx)))
1171 (let ((network (murk-context-network ctx))
1172 (channel (murk-context-channel ctx)))
1174 (murk-send-msg network
1175 (murk-msg nil nil "TOPIC" channel
1176 (string-join params " ")))
1177 (murk-send-msg network
1178 (murk-msg nil nil "TOPIC" channel))))
1179 (murk-display-notice nil "No current channel."))))
1181 (defun murk-command-msg (params)
1182 (let ((network (murk-context-network (murk-current-context))))
1183 (if (and params (>= (length params) 2))
1184 (let ((to (car params))
1185 (text (string-join (cdr params) " ")))
1186 (murk-send-msg network (murk-msg nil nil "PRIVMSG" to text))
1187 (murk-display-message network
1188 (murk-connection-nick network)
1190 (murk-display-notice nil "Usage: /msg <nick> <message>"))))
1192 (defun murk-command-me (params)
1193 (let* ((ctx (murk-current-context))
1194 (network (murk-context-network ctx)))
1195 (if (and ctx (not (murk-network-context-p ctx)))
1197 (let* ((channel (murk-context-channel ctx))
1198 (my-nick (murk-connection-nick network))
1199 (action (string-join params " "))
1200 (ctcp-text (concat "\01ACTION " action "\01")))
1201 (murk-send-msg network
1202 (murk-msg nil nil "PRIVMSG"
1203 (list channel ctcp-text)))
1204 (murk-display-action network my-nick channel action))
1205 (murk-display-notice nil "Usage: /me <action>"))
1206 (murk-display-notice nil "No current channel."))))
1208 (defun murk-command-version (params)
1209 (let ((ctx (murk-current-context)))
1212 (let ((network (murk-context-network ctx))
1213 (nick (car params)))
1214 (murk-send-msg network
1215 (murk-msg nil nil "PRIVMSG"
1216 (list nick "\01VERSION\01")))
1217 (murk-display-notice ctx "CTCP version request sent to "
1218 nick " on " network))
1219 (murk-display-notice ctx "Usage: /version <nick>"))
1220 (murk-display-notice nil "No current channel."))))
1222 (defun murk-command-users (_params)
1223 (let ((ctx (murk-current-context)))
1224 (if (and ctx (not (murk-network-context-p ctx)))
1225 (let ((channel (murk-context-channel ctx))
1226 (network (murk-context-network ctx))
1227 (users (murk-get-context-users ctx)))
1228 (murk-display-notice ctx "Users in " channel " on " network ":")
1229 (murk-display-notice ctx (string-join users " ")))
1230 (murk-display-notice nil "No current channel."))))
1233 ;;; Command entering
1236 (defun murk-enter-string (string)
1237 (if (string-prefix-p "/" string)
1239 ((rx (: "/" (let cmd-str (+ (not whitespace)))
1241 (let params-str (+ anychar))
1243 (let ((command-row (assoc (upcase cmd-str) murk-command-table #'equal))
1244 (params (if params-str
1245 (split-string params-str nil t)
1247 (if (and command-row (elt command-row 2))
1248 (funcall (elt command-row 2) params)
1250 (murk-context-network (murk-current-context))
1251 (murk-msg nil nil (upcase cmd-str) params)))))
1253 (murk-display-error "Badly formed command")))
1254 (unless (string-empty-p string)
1255 (let ((ctx (murk-current-context)))
1257 (if (not (murk-network-context-p ctx))
1258 (let ((network (murk-context-network ctx))
1259 (channel (murk-context-channel ctx)))
1260 (murk-send-msg network
1261 (murk-msg nil nil "PRIVMSG" channel string))
1262 (murk-display-message network
1263 (murk-connection-nick network)
1265 (murk-display-error "No current channel"))
1266 (murk-display-error "No current context"))))))
1272 (defvar murk-history nil
1273 "Commands and messages sent in current session.")
1275 (defvar murk-history-index nil)
1277 (defun murk-history-cycle (delta)
1279 (with-current-buffer "*murk*"
1280 (if murk-history-index
1281 (setq murk-history-index
1283 (min (- (length murk-history) 1)
1284 (+ delta murk-history-index))))
1285 (setq murk-history-index 0))
1286 (delete-region murk-input-marker (point-max))
1287 (insert (elt murk-history murk-history-index)))))
1290 ;;; Interactive commands
1293 (defun murk-enter ()
1294 "Enter current contents of line after prompt."
1296 (with-current-buffer "*murk*"
1297 (let ((line (buffer-substring murk-input-marker (point-max))))
1298 (push line murk-history)
1299 (setq murk-history-index nil)
1300 (let ((inhibit-read-only t))
1301 (delete-region murk-input-marker (point-max)))
1302 (murk-enter-string line))))
1304 (defun murk-history-next ()
1306 (murk-history-cycle -1))
1308 (defun murk-history-prev ()
1310 (murk-history-cycle +1))
1312 (defun murk-cycle-contexts-forward ()
1314 (murk-cycle-contexts)
1315 (murk-highlight-current-context)
1316 (murk-render-prompt)
1318 (murk-zoom-in (murk-current-context))))
1320 (defun murk-cycle-contexts-reverse ()
1322 (murk-cycle-contexts t)
1323 (murk-highlight-current-context)
1324 (murk-render-prompt)
1326 (murk-zoom-in (murk-current-context))))
1328 (defvar murk-zoomed nil
1329 "Keeps track of zoom status.")
1331 (defun murk-toggle-zoom ()
1335 (murk-zoom-in (murk-current-context)))
1336 (setq murk-zoomed (not murk-zoomed)))
1339 (defun murk-complete-input ()
1341 (let ((completion-ignore-case t))
1342 (when (>= (point) murk-input-marker)
1343 (pcase (buffer-substring murk-input-marker (point))
1344 ((rx (: "/" (let cmd-str (+ (not whitespace))) (+ " ") (* (not whitespace)) string-end))
1345 (let ((space-idx (save-excursion
1346 (re-search-backward " " murk-input-marker t)))
1347 (table-row (assoc (upcase cmd-str) murk-command-table #'equal)))
1348 (if (and table-row (elt table-row 3))
1349 (let* ((completions-nospace (funcall (elt table-row 3)))
1350 (completions (mapcar (lambda (el) (concat el " ")) completions-nospace)))
1351 (completion-in-region (+ 1 space-idx) (point) completions)))))
1352 ((rx (: "/" (* (not whitespace)) string-end))
1353 (message (buffer-substring murk-input-marker (point)))
1354 (completion-in-region murk-input-marker (point)
1355 (mapcar (lambda (row) (concat "/" (car row) " "))
1356 murk-command-table)))
1358 (let* ((end (max murk-input-marker (point)))
1359 (space-idx (save-excursion
1360 (re-search-backward " " murk-input-marker t)))
1361 (start (if space-idx (+ 1 space-idx) murk-input-marker)))
1362 (unless (string-prefix-p "/" (buffer-substring start end))
1363 (let* ((users (murk-get-context-users (murk-current-context)))
1365 (lambda (u) (car (split-string u "@" t)))
1367 (completion-in-region start end users-no@)))))))))
1372 (defvar murk-mode-map
1373 (let ((map (make-sparse-keymap)))
1374 (define-key map (kbd "RET") 'murk-enter)
1375 (define-key map (kbd "TAB") 'murk-complete-input)
1376 (define-key map (kbd "C-c C-z") 'murk-toggle-zoom)
1377 (define-key map (kbd "<C-up>") 'murk-history-prev)
1378 (define-key map (kbd "<C-down>") 'murk-history-next)
1379 (define-key map (kbd "<C-tab>") 'murk-cycle-contexts-forward)
1380 (define-key map (kbd "<C-S-iso-lefttab>") 'murk-cycle-contexts-reverse)
1381 (define-key map (kbd "<C-S-tab>") 'murk-cycle-contexts-reverse)
1382 (when (fboundp 'evil-define-key*)
1383 (evil-define-key* 'motion map
1384 (kbd "TAB") 'murk-complete-input))
1387 (define-derived-mode murk-mode text-mode "murk"
1388 "Major mode for murk.")
1390 (when (fboundp 'evil-set-initial-state)
1391 (evil-set-initial-state 'murk-mode 'insert))
1393 ;;; Main start procedure
1398 "Start murk or just switch to the murk buffer if one already exists."
1400 (if (get-buffer "*murk*")
1401 (switch-to-buffer "*murk*")
1402 (switch-to-buffer "*murk*")
1404 (murk-setup-buffer))
1407 ;;; murk.el ends here