mirror of https://codeberg.org/cage/tinmop/
- do not mentions people that do not appears in the current thread.
This commit is contained in:
parent
7b48939deb
commit
f5d4d878ec
23
src/db.lisp
23
src/db.lisp
|
@ -1461,11 +1461,10 @@ forms a messages thread"
|
||||||
|
|
||||||
(defun message->thread-users (timeline folder status-id
|
(defun message->thread-users (timeline folder status-id
|
||||||
&key
|
&key
|
||||||
(names-as-mention t))
|
(local-name-prefix "")
|
||||||
|
(acct-prefix ""))
|
||||||
"Given a tuple that identify a message (`timeline' `folder' `status-id'),
|
"Given a tuple that identify a message (`timeline' `folder' `status-id'),
|
||||||
returns an alist of (local-username . acct).
|
returns an alist of (local-username . acct)."
|
||||||
|
|
||||||
if `names-as-mention' is non nil prepends '@' to the names."
|
|
||||||
(let ((all-messages (mtree:collect-nodes-data (message-id->tree timeline folder status-id)))
|
(let ((all-messages (mtree:collect-nodes-data (message-id->tree timeline folder status-id)))
|
||||||
(results ()))
|
(results ()))
|
||||||
(loop for message in all-messages do
|
(loop for message in all-messages do
|
||||||
|
@ -1473,16 +1472,24 @@ if `names-as-mention' is non nil prepends '@' to the names."
|
||||||
(account (user-id->user user-id))
|
(account (user-id->user user-id))
|
||||||
(local-name (db-getf account :username))
|
(local-name (db-getf account :username))
|
||||||
(username (user-id->username user-id))
|
(username (user-id->username user-id))
|
||||||
(pair (if names-as-mention
|
(pair (cons (strcat local-name-prefix local-name)
|
||||||
(cons (msg-utils:add-mention-prefix local-name)
|
(strcat acct-prefix username))))
|
||||||
(msg-utils:add-mention-prefix username))
|
|
||||||
(cons local-name username))))
|
|
||||||
(pushnew pair results :test (lambda (a b) (and (string= (car a)
|
(pushnew pair results :test (lambda (a b) (and (string= (car a)
|
||||||
(car b))
|
(car b))
|
||||||
(string= (cdr a)
|
(string= (cdr a)
|
||||||
(cdr b)))))))
|
(cdr b)))))))
|
||||||
results))
|
results))
|
||||||
|
|
||||||
|
(defun mention-local->global-alist ()
|
||||||
|
"Returns an alist of all known acoounts as ('@'local-username . '@'acct)."
|
||||||
|
(let* ((query (select (:username :acct) (from +table-account+)))
|
||||||
|
(rows (fetch-all-rows query)))
|
||||||
|
(loop for row in rows collect
|
||||||
|
(let ((local-name (db-getf row :username))
|
||||||
|
(username (db-getf row :acct)))
|
||||||
|
(cons (msg-utils:add-mention-prefix local-name)
|
||||||
|
(msg-utils:add-mention-prefix username))))))
|
||||||
|
|
||||||
(defmacro gen-access-message-row (name column)
|
(defmacro gen-access-message-row (name column)
|
||||||
"Convenience macro to generate function to access a value of a table
|
"Convenience macro to generate function to access a value of a table
|
||||||
row."
|
row."
|
||||||
|
|
|
@ -16,6 +16,8 @@
|
||||||
|
|
||||||
(in-package :message-rendering-utils)
|
(in-package :message-rendering-utils)
|
||||||
|
|
||||||
|
(define-constant +temp-mention-prefix+ "/at/" :test #'string=)
|
||||||
|
|
||||||
(defun mention-p (maybe-mention)
|
(defun mention-p (maybe-mention)
|
||||||
(scan (strcat "^" +mention-prefix+)
|
(scan (strcat "^" +mention-prefix+)
|
||||||
maybe-mention))
|
maybe-mention))
|
||||||
|
@ -47,11 +49,17 @@
|
||||||
(remove-if-not (lambda (a) (string= (car a) key))
|
(remove-if-not (lambda (a) (string= (car a) key))
|
||||||
usernames-table))))
|
usernames-table))))
|
||||||
(join-with-strings found ", "))))
|
(join-with-strings found ", "))))
|
||||||
(let ((results text-line))
|
(let ((results text-line)
|
||||||
|
(local-mention-prefix (strcat " " +mention-prefix+))
|
||||||
|
(local-mention-temp-prefix (strcat " " +temp-mention-prefix+)))
|
||||||
|
(setf results (regex-replace-all local-mention-prefix
|
||||||
|
results
|
||||||
|
local-mention-temp-prefix))
|
||||||
(loop for pair in usernames-table do
|
(loop for pair in usernames-table do
|
||||||
(when-let* ((local-mention (car pair))
|
(when-let* ((local-mention (car pair))
|
||||||
(local-mention-re (strcat " " local-mention))
|
(local-mention-re (strcat " " local-mention))
|
||||||
(actual-mention (find-all-username local-mention)))
|
(actual-mention (strcat " "
|
||||||
|
(find-all-username local-mention))))
|
||||||
(setf results (regex-replace-all local-mention-re results actual-mention))))
|
(setf results (regex-replace-all local-mention-re results actual-mention))))
|
||||||
results)))
|
results)))
|
||||||
|
|
||||||
|
|
|
@ -1620,6 +1620,7 @@
|
||||||
(:nicknames :msg-utils)
|
(:nicknames :msg-utils)
|
||||||
(:shadowing-import-from :misc :random-elt :shuffle)
|
(:shadowing-import-from :misc :random-elt :shuffle)
|
||||||
(:export
|
(:export
|
||||||
|
:+temp-mention-prefix+
|
||||||
:add-mention-prefix
|
:add-mention-prefix
|
||||||
:strip-mention-prefix
|
:strip-mention-prefix
|
||||||
:local-mention->acct
|
:local-mention->acct
|
||||||
|
|
|
@ -844,7 +844,11 @@ Force the checking for new message in the thread the selected message belong."
|
||||||
lines))
|
lines))
|
||||||
(thread-users (db:message->thread-users timeline
|
(thread-users (db:message->thread-users timeline
|
||||||
folder
|
folder
|
||||||
reply-id)))
|
reply-id
|
||||||
|
:local-name-prefix
|
||||||
|
message-rendering-utils:+temp-mention-prefix+
|
||||||
|
:acct-prefix
|
||||||
|
+mention-prefix+)))
|
||||||
(with-open-file (stream file
|
(with-open-file (stream file
|
||||||
:if-exists :append
|
:if-exists :append
|
||||||
:direction :output
|
:direction :output
|
||||||
|
|
Loading…
Reference in New Issue