The Lambda Lab
/
projects
/
lurk.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
2402ca2
)
Extracted users from contexts.
author
plugd
<plugd@thelambdalab.xyz>
Sun, 26 May 2024 14:35:15 +0000
(16:35 +0200)
committer
plugd
<plugd@thelambdalab.xyz>
Sun, 26 May 2024 19:14:05 +0000
(21:14 +0200)
murk.el
patch
|
blob
|
history
diff --git
a/murk.el
b/murk.el
index
4e35c1a
..
20d8b06
100644
(file)
--- 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
;;
;;; 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.
;;
;; 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-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)))
(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))))
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
(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
(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)
(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))))
(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)
(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)))))
(murk-del-context-user ctx old-nick)
(murk-add-context-users ctx (list new-nick)))))
+
;;; Buffer
;;
;;; Buffer
;;
@@
-485,7
+502,7
@@
The head of this list is always the current context.")
(murk-context-channel ctx)
" ("
(number-to-string
(murk-context-channel ctx)
" ("
(number-to-string
- (length (murk-context-users ctx)))
+ (length (murk-
get-
context-users ctx)))
")"))))
"No connection")))))))
")"))))
"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)
"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))
(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)
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 " ") ""))
(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))
nil))
- (context-face (murk-get-context-facelist
short-ctx
)))
+ (context-face (murk-get-context-facelist
context
)))
(insert-before-markers
(murk--fill-strings
80
(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
(propertize padded-timestamp
'face 'murk-timestamp
'read-only t
- 'context
short-ctx
+ 'context
context
'invisible context-atom)
(propertize padded-prefix
'read-only t
'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
'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))
'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)
(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))
(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))))
(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)
(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
(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."))))
" 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))))
((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)
(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))))
((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)))
(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))
(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."))))
(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))
(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)))
(users-no@ (mapcar
(lambda (u) (car (split-string u "@" t)))
users)))