From: plugd Date: Sun, 26 May 2024 14:35:15 +0000 (+0200) Subject: Extracted users from contexts. X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=0a49a839c3407146f869af552dfdce60f31a4519;p=lurk.git Extracted users from contexts. --- diff --git a/murk.el b/murk.el index 4e35c1a..20d8b06 100644 --- a/murk.el +++ b/murk.el @@ -308,7 +308,7 @@ portion of the source component of the message, as mURK doesn't use this.") ;;; Contexts ;; -;; A context is a list (network channel users) identifying the network +;; A context is a list (network channel) identifying the network ;; and channel. The tail of the list contains the nicks of users ;; present in the channel. ;; @@ -340,12 +340,6 @@ The head of this list is always the current context.") (defun murk-context-channel (ctx) (elt ctx 1)) -(defun murk-context-users (ctx) - (elt ctx 2)) - -(defun murk-set-context-users (ctx users) - (setcar (cddr ctx) users)) - (defun murk-network-context-p (ctx) (not (cdr ctx))) @@ -404,15 +398,31 @@ The head of this list is always the current context.") murk-contexts))) (append new-head new-tail)))) +;;; Context users +;; + +(defvar murk-context-users nil + "Association list between channel contexts and users.") + +(defun murk-get-context-users (ctx) + (cdr (assoc ctx murk-context-users))) + +(defun murk-set-context-users (ctx users) + (setq murk-context-users + (cons (cons ctx users) (assoc-delete-all ctx murk-context-users)))) + (defun murk-add-context-users (ctx users) (murk-set-context-users ctx - (cl-union users (murk-context-users ctx)))) + (cl-union users (murk-get-context-users ctx)))) (defun murk-del-context-user (ctx user) (murk-set-context-users ctx - (delete user (murk-context-users ctx)))) + (delete user (murk-get-context-users ctx)))) + +(defun murk-del-all-context-users (ctx) + (murk-set-context-users ctx nil)) (defun murk-del-network-user (network user) (dolist (ctx murk-contexts) @@ -420,13 +430,20 @@ The head of this list is always the current context.") (not (murk-network-context-p ctx))) (murk-del-context-user ctx user)))) +(defun murk-del-all-network-users (network) + (dolist (ctx murk-contexts) + (if (and (equal (murk-context-network ctx) network) + (not (murk-network-context-p ctx))) + (murk-del-all-context-users ctx)))) + (defun murk-rename-network-user (network old-nick new-nick) (dolist (ctx murk-contexts) (when (and (equal (murk-context-network ctx) network) - (member old-nick (murk-context-users ctx))) + (member old-nick (murk-get-context-users ctx))) (murk-del-context-user ctx old-nick) (murk-add-context-users ctx (list new-nick))))) + ;;; Buffer ;; @@ -485,7 +502,7 @@ The head of this list is always the current context.") (murk-context-channel ctx) " (" (number-to-string - (length (murk-context-users ctx))) + (length (murk-get-context-users ctx))) ")")))) "No connection"))))))) @@ -533,11 +550,10 @@ The head of this list is always the current context.") "List of seen contexts and associated face lists.") (defun murk-get-context-facelist (context) - (let* ((short-ctx (take 2 context)) - (facelist (gethash short-ctx murk-context-facelists))) + (let* ((facelist (gethash context murk-context-facelists))) (unless facelist (setq facelist (list 'murk-text)) - (puthash short-ctx facelist murk-context-facelists)) + (puthash context facelist murk-context-facelists)) facelist)) (defun murk--fill-strings (col indent &rest strings) @@ -557,11 +573,10 @@ The head of this list is always the current context.") (old-pos (marker-position murk-prompt-marker)) (padded-timestamp (concat (format-time-string "%H:%M "))) (padded-prefix (if prefix (concat prefix " ") "")) - (short-ctx (take 2 context)) - (context-atom (if short-ctx - (intern (murk-context->string short-ctx)) + (context-atom (if context + (intern (murk-context->string context)) nil)) - (context-face (murk-get-context-facelist short-ctx))) + (context-face (murk-get-context-facelist context))) (insert-before-markers (murk--fill-strings 80 @@ -570,17 +585,17 @@ The head of this list is always the current context.") (propertize padded-timestamp 'face 'murk-timestamp 'read-only t - 'context short-ctx + 'context context 'invisible context-atom) (propertize padded-prefix 'read-only t - 'context short-ctx + 'context context 'invisible context-atom) (murk-add-formatting (propertize (concat (apply #'murk-buttonify-urls strings) "\n") 'face context-face 'read-only t - 'context short-ctx + 'context context 'invisible context-atom))))))) (murk-scroll-windows-to-last-line)) @@ -624,7 +639,7 @@ The head of this list is always the current context.") (with-current-buffer "*murk*" (maphash (lambda (this-context facelist) - (if (equal (take 2 this-context) (take 2 (murk-current-context))) + (if (equal this-context (murk-current-context)) (setcar facelist 'murk-text) (setcar facelist 'murk-faded))) murk-context-facelists)) @@ -637,7 +652,7 @@ The head of this list is always the current context.") (when this-context (let ((this-context-atom (intern (murk-context->string this-context)))) - (if (equal this-context (take 2 context)) + (if (equal this-context context) (remove-from-invisibility-spec this-context-atom) (add-to-invisibility-spec this-context-atom))))) murk-context-facelists) @@ -784,7 +799,7 @@ The head of this list is always the current context.") (if ctx (murk-display-notice ctx - (murk--as-string (length (murk-context-users ctx))) + (murk--as-string (length (murk-get-context-users ctx))) " users in " channel) (murk-display-notice (murk-get-context network) "End of " channel " names list.")))) @@ -809,8 +824,10 @@ The head of this list is always the current context.") ((and "JOIN" (guard (equal (murk-connection-nick network) (murk-msg-src msg)))) - (let ((channel (car (murk-msg-params msg)))) - (murk-add-context (list network channel nil)) + (let* ((channel (car (murk-msg-params msg))) + (context (list network channel))) + (murk-add-context context) + (murk-del-all-context-users context) (murk-display-notice (murk-current-context) "Joining channel " channel " on " network) (murk-highlight-current-context) @@ -828,9 +845,11 @@ The head of this list is always the current context.") ((and "PART" (guard (equal (murk-connection-nick network) (murk-msg-src msg)))) - (let ((channel (car (murk-msg-params msg)))) - (murk-display-notice (murk-current-context) "Left channel " channel) - (murk-remove-context (list network channel)) + (let* ((channel (car (murk-msg-params msg))) + (context (list network channel))) + (murk-display-notice context "Left channel " channel) + (murk-remove-context context) + (murk-del-all-context-users context) (murk-highlight-current-context) (murk-render-prompt))) @@ -1186,7 +1205,7 @@ The head of this list is always the current context.") (if (and ctx (not (murk-network-context-p ctx))) (let ((channel (murk-context-channel ctx)) (network (murk-context-network ctx)) - (users (murk-context-users ctx))) + (users (murk-get-context-users ctx))) (murk-display-notice ctx "Users in " channel " on " network ":") (murk-display-notice ctx (string-join users " "))) (murk-display-notice nil "No current channel.")))) @@ -1322,7 +1341,7 @@ The head of this list is always the current context.") (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-context-users (murk-current-context))) + (let* ((users (murk-get-context-users (murk-current-context))) (users-no@ (mapcar (lambda (u) (car (split-string u "@" t))) users)))