From 7b48939deb37a61a49f9d3ffaca70e4e8584e8c8 Mon Sep 17 00:00:00 2001
From: cage <cage-invalid@invalid>
Date: Sat, 18 Jul 2020 13:03:58 +0200
Subject: [PATCH] - tried to fix mentioning of non local user in reply.

---
 src/db.lisp                      | 24 ++++++++++++++++++++++++
 src/message-rendering-utils.lisp | 16 ++++++++++++++++
 src/mtree-utils.lisp             |  8 ++++++++
 src/package.lisp                 |  3 +++
 src/ui-goodies.lisp              | 16 ++++++++++++----
 5 files changed, 63 insertions(+), 4 deletions(-)

diff --git a/src/db.lisp b/src/db.lisp
index 42756aa..6d7d6d0 100644
--- a/src/db.lisp
+++ b/src/db.lisp
@@ -1459,6 +1459,30 @@ forms a messages thread"
                  node)))
       (add-children results))))
 
+(defun message->thread-users (timeline folder status-id
+                              &key
+                                (names-as-mention t))
+  "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."
+  (let ((all-messages (mtree:collect-nodes-data (message-id->tree timeline folder status-id)))
+        (results      ()))
+    (loop for message in all-messages do
+         (let* ((user-id    (db-getf message :account-id))
+                (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))))
+           (pushnew pair results :test (lambda (a b) (and (string= (car a)
+                                                                   (car b))
+                                                          (string= (cdr a)
+                                                                   (cdr b)))))))
+    results))
+
 (defmacro gen-access-message-row (name column)
   "Convenience macro to generate function to access a value of a table
 row."
diff --git a/src/message-rendering-utils.lisp b/src/message-rendering-utils.lisp
index 10df7f6..3a49ed8 100644
--- a/src/message-rendering-utils.lisp
+++ b/src/message-rendering-utils.lisp
@@ -39,6 +39,22 @@
         (when (mention-p first-mention)
           first-mention)))))
 
+(defun local-mention->acct (text-line usernames-table)
+  "Substitute in  `text-line' '@user' with '@user@server',  if '@user'
+  is found as key in the alist `usernames-table'"
+  (flet ((find-all-username (key)
+           (let ((found (mapcar #'cdr
+                                (remove-if-not (lambda (a) (string= (car a) key))
+                                               usernames-table))))
+             (join-with-strings found ", "))))
+    (let ((results text-line))
+      (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)))
+             (setf results (regex-replace-all local-mention-re results actual-mention))))
+      results)))
+
 (defun crypto-message-destination-user (message-data)
   (with-accessors ((body       sending-message:body)
                    (subject    sending-message:subject)
diff --git a/src/mtree-utils.lisp b/src/mtree-utils.lisp
index ea8a310..6fd63e3 100644
--- a/src/mtree-utils.lisp
+++ b/src/mtree-utils.lisp
@@ -154,6 +154,8 @@
 
 (defgeneric count-nodes (object))
 
+(defgeneric collect-nodes-data (object))
+
 (defgeneric mtree-equal (tree-1 tree-2 &key key-fn compare-fn))
 
 (defgeneric root-node (object))
@@ -429,6 +431,12 @@
                                (incf results)))
     results))
 
+(defmethod collect-nodes-data ((object m-tree))
+  (let ((results ()))
+    (top-down-visit object #'(lambda (n)
+                               (push (data n) results)))
+    results))
+
 (defmethod mtree-equal ((tree-1 m-tree) (tree-2 m-tree)
                         &key
                           (key-fn      #'identity)
diff --git a/src/package.lisp b/src/package.lisp
index 8c5430e..54c0950 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -465,6 +465,7 @@
    :find-child-if
    :count-leaves
    :count-nodes
+   :collect-nodes-data
    :mtree-equal
    :root-node
    :sorted-m-tree
@@ -721,6 +722,7 @@
    :message-root
    :message-children
    :message-root->tree
+   :message->thread-users
    :message-id->tree
    :message-from-timeline-folder-message-index
    :message-index->tree
@@ -1620,6 +1622,7 @@
   (:export
    :add-mention-prefix
    :strip-mention-prefix
+   :local-mention->acct
    :crypto-message-destination-user
    :maybe-crypt-message
    :attachment-type->description
diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp
index 63fe71c..37c8f24 100644
--- a/src/ui-goodies.lisp
+++ b/src/ui-goodies.lisp
@@ -806,7 +806,7 @@ Force the checking for new message in the thread the selected message belong."
                              exceeding)
                          exceeding)))
 
-(defun compose-message (&optional reply-id subject (visibility +status-public-visibility+))
+(defun compose-message (&optional timeline folder reply-id subject (visibility +status-public-visibility+))
   "Compose a new message"
   (setf *message-to-send* (make-instance 'sending-message:message-ready-to-send
                                          :visibility visibility
@@ -841,14 +841,20 @@ Force the checking for new message in the thread the selected message belong."
                            (lines          (split-lines quoted-text))
                            (quote-mark     (swconf:quote-char))
                            (quoted-lines   (mapcar (lambda (a) (strcat quote-mark a))
-                                                   lines)))
+                                                   lines))
+                           (thread-users   (db:message->thread-users timeline
+                                                                     folder
+                                                                     reply-id)))
                  (with-open-file (stream file
                                          :if-exists    :append
                                          :direction    :output
                                          :element-type 'character)
                    (format stream "~a~%" (msg-utils:add-mention-prefix reply-username))
                    (loop for line in quoted-lines do
-                        (format stream "~a~%" line))))))
+                        (let ((line-fixed-mentions
+                               (message-rendering-utils:local-mention->acct line
+                                                                            thread-users)))
+                          (format stream "~a~%" line-fixed-mentions)))))))
            (add-signature (file)
              (when-let ((signature (message-rendering-utils:signature)))
                (with-open-file (stream
@@ -877,11 +883,13 @@ Force the checking for new message in the thread the selected message belong."
   "Reply to message"
   (when-let* ((win              specials:*thread-window*)
               (selected-message (line-oriented-window:selected-row-fields win))
+              (timeline         (thread-window:timeline-type   win))
+              (folder           (thread-window:timeline-folder win))
               (username         (db:row-message-username   selected-message))
               (visibility       (db:row-message-visibility selected-message))
               (reply-id         (db:row-message-status-id  selected-message)))
     (let ((subject (db:row-message-subject selected-message)))
-      (compose-message reply-id subject visibility))))
+      (compose-message timeline folder reply-id subject visibility))))
 
 (defun send-message ()
   "Send message"