- [fediverse] reworked mentions expansion's code to prevent missing mentions

(see c790da4407);

- changed function's name: 'mentioned-username->account' -> 'mentioned-username->acct'.

src/db.lisp

@@ -1336,7 +1336,7 @@ than (swconf:config-purge-history-days-offset) days in the past"
     (let ((actual-username (clean-chars username))
           (actual-acct     (clean-chars account-name))
           (now             (prepare-for-db (local-time-obj-now))))
-      (when (not (mentioned-username->account actual-username
+      (when (not (mentioned-username->acct actual-username
                                            status-id
                                            :add-mention-prefix nil))
         (query (make-insert +table-mention+
@@ -1928,12 +1928,21 @@ the message identified by the tuple."
             (cons (msg-utils:add-mention-prefix local-name)
                   (msg-utils:add-mention-prefix username))))))
 
-(defun mentioned-username->account (username status-id &key (add-mention-prefix t))
+(defun mentioned-username->acct (username status-id
+                                          &key
+                                          (add-mention-prefix t)
+                                          (ignored-acct-list '()))
   "Returns an alist of all known accounts as ('@'local-username . '@'acct)."
-  (let* ((query (select :acct
+  (let* ((query (if ignored-acct-list
+                    (select :acct
                       (from +table-mention+)
                       (where (:and (:= :username username)
-                               (:= :status-id status-id)))))
+                                   (:= :status-id status-id)
+                                   (:not (:in :acct ignored-acct-list)))))
+                    (select :acct
+                      (from +table-mention+)
+                      (where (:and (:= :username username)
+                                   (:= :status-id status-id))))))
          (acct  (second (fetch-single query))))
     (if add-mention-prefix
         (msg-utils:add-mention-prefix acct)

src/message-rendering-utils.lisp

@@ -47,7 +47,14 @@
                            words))))
 
 (defun usernames->usernames-table (message status-id)
-  "Returns a list of pairs ('@'username . '@'acct)."
+  "Returns a list of pairs (\"'@'username\" . \"'@'acct\").
+
+Please note that this  table is not a map as the  same username can be
+followed by different acct e.g.:
+
+((\"@foo\" . \"@foo@bar\")
+ (\"@foo\" . \"@foo@baz\"))
+"
   (let ((usernames '()))
     (loop for line in (split-lines message)
           do
@@ -56,23 +63,53 @@
                      (concatenate 'list
                                   usernames
                                   usernames-in-line))))
+    (let ((already-found-acct '()))
       (mapcar (lambda (username)
+                (let ((acct (db:mentioned-username->acct username
+                                                         status-id
+                                                         :add-mention-prefix nil
+                                                         :ignored-acct-list already-found-acct)))
+                  (prog1
                       (cons (add-mention-prefix username)
-                    (db:mentioned-username->account username status-id)))
-            usernames)))
+                            (add-mention-prefix acct))
+                    (push acct already-found-acct))))
+              usernames))))
 
-(defun local-mention->acct (text-line usernames-table)
+(defun local-mention->acct (text-line usernames-table
+                            &optional (replace-function #'cl-ppcre:regex-replace))
   "Substitute in `text-line' '@user' with '@user@server', if '@user'
-  is found as key in the alist `usernames-table'"
+  is found as key in the alist `usernames-table' note that `usernames-table' is not a map see: `usernames->usernames-table'."
   (let ((results text-line))
     (loop for (local-mention . actual-mention) in usernames-table do
       (let ((local-mention-re (strcat "(\\s|^)"
                                       local-mention
-                                      (html-utils:footnote-reference-re :enforce-end-string nil))))
-        (setf results (regex-replace-all local-mention-re
+                                      "(\\s|$)")))
+        (multiple-value-bind (replaced matched)
+            (funcall replace-function
+                     local-mention-re
                      results
-                                         (strcat " " actual-mention)))))
-    results))
+                     (strcat " " actual-mention))
+          (setf results replaced))))
+    ;; NOTE: as `usernames-table' is not a map some mention can not be
+    ;; replaced properly e.g.
+    ;;
+    ;; let 'usernames-table':
+    ;;
+    ;; ((\"@foo\" . \"@foo@bar\")
+    ;; (\"@foo\" . \"@foo@baz\"))
+    ;;
+    ;; and line 'line':
+    ;;
+    ;; "@foo @foo @foo @foo"
+    ;;
+    ;; the heuristic here  will replace the first  occurence of "@foo"
+    ;; with the cdr  of the first element of the  map, the second with
+    ;; the cdr  of the second and  so on; any other  occurence will be
+    ;; replaced with  the cdr  of the  first '@foo'  in the  map.  Not
+    ;; optimal but no mentions should be missed this way.
+    (if (eq replace-function #'cl-ppcre:regex-replace)
+        (local-mention->acct results usernames-table #'cl-ppcre:regex-replace-all)
+        results)))
 
 (defun expand-mention (text status-id)
   (let ((mentioned-users-table (usernames->usernames-table text status-id)))

src/package.lisp

@@ -997,7 +997,7 @@
    :message-root->tree
    :message->thread-users
    :all-mentioned-accounts
-   :mentioned-username->account
+   :mentioned-username->acct
    :message-id->tree
    :message-from-timeline-folder-message-index
    :message-index->tree