cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- do not mentions people that do not appears in the current thread.

This commit is contained in:
cage 2020-07-19 13:27:40 +02:00
parent 7b48939deb
commit f5d4d878ec
4 changed files with 33 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/db.lisp
View File

@ -1461,11 +1461,10 @@ forms a messages thread"
(defun message->thread-users (timeline folder status-id
&key
(names-as-mention t))
(local-name-prefix "")
(acct-prefix ""))
"Given a tuple that identify a message (`timeline' `folder' `status-id'),
returns an alist of (local-username . acct).
if `names-as-mention' is non nil prepends '@' to the names."
returns an alist of (local-username . acct)."
(let ((all-messages (mtree:collect-nodes-data (message-id->tree timeline folder status-id)))
(results ()))
(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))
(local-name (db-getf account :username))
(username (user-id->username user-id))
(pair (if names-as-mention
(cons (msg-utils:add-mention-prefix local-name)
(msg-utils:add-mention-prefix username))
(cons local-name username))))
(pair (cons (strcat local-name-prefix local-name)
(strcat acct-prefix username))))
(pushnew pair results :test (lambda (a b) (and (string= (car a)
(car b))
(string= (cdr a)
(cdr b)))))))
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)
"Convenience macro to generate function to access a value of a table
row."

16
src/message-rendering-utils.lisp
View File

@ -16,6 +16,8 @@
(in-package :message-rendering-utils)
(define-constant +temp-mention-prefix+ "/at/" :test #'string=)
(defun mention-p (maybe-mention)
(scan (strcat "^" +mention-prefix+)
maybe-mention))
@ -47,11 +49,17 @@
(remove-if-not (lambda (a) (string= (car a) key))
usernames-table))))
(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
(when-let* ((local-mention (car pair))
(local-mention-re (strcat " " local-mention))
(actual-mention (find-all-username local-mention)))
(when-let* ((local-mention (car pair))
(local-mention-re (strcat " " local-mention))
(actual-mention (strcat " "
(find-all-username local-mention))))
(setf results (regex-replace-all local-mention-re results actual-mention))))
results)))

1
src/package.lisp
View File

@ -1620,6 +1620,7 @@
(:nicknames :msg-utils)
(:shadowing-import-from :misc :random-elt :shuffle)
(:export
:+temp-mention-prefix+
:add-mention-prefix
:strip-mention-prefix
:local-mention->acct

6
src/ui-goodies.lisp
View File

@ -844,7 +844,11 @@ Force the checking for new message in the thread the selected message belong."
lines))
(thread-users (db:message->thread-users timeline
folder
reply-id)))
reply-id
:local-name-prefix
message-rendering-utils:+temp-mention-prefix+
:acct-prefix
+mention-prefix+)))
(with-open-file (stream file
:if-exists :append
:direction :output