From f504a8be088ef7fd65f3cfdc3980164e53dd03fc Mon Sep 17 00:00:00 2001 From: cage Date: Tue, 24 Sep 2024 20:01:34 +0200 Subject: [PATCH] - [fediverse] removed spurious text added when editing a post; - [fediverse] fixed mention expanding. --- src/db.lisp | 9 ++++----- src/message-rendering-utils.lisp | 19 ++++++++++++++++--- src/package.lisp | 1 + src/program-events.lisp | 6 ++++-- src/ui-goodies.lisp | 20 ++++++++------------ 5 files changed, 33 insertions(+), 22 deletions(-) diff --git a/src/db.lisp b/src/db.lisp index bf744a8..2b38302 100644 --- a/src/db.lisp +++ b/src/db.lisp @@ -442,7 +442,7 @@ (defun make-poll () (query-low-level (strcat (prepare-table +table-poll+ :autogenerated-id-p t) " \"status-id\" TEXT NOT NULL " - ;(make-foreign +table-status+ "status-id" +cascade+ +cascade+) + ;;(make-foreign +table-status+ "status-id" +cascade+ +cascade+) +col-sep+ ;; date " \"expire-date\" TEXT NOT NULL," @@ -1912,11 +1912,10 @@ the message identified by the tuple." (let* ((query (select :acct (from +table-mention+) (where (:= :username username)))) - (rows (mapcar #'second - (fetch-all-rows query)))) + (acct (second (fetch-single query)))) (if add-mention-prefix - (mapcar #'msg-utils:add-mention-prefix rows) - rows))) + (msg-utils:add-mention-prefix acct) + acct))) (defmacro gen-access-message-row (name column &key diff --git a/src/message-rendering-utils.lisp b/src/message-rendering-utils.lisp index 93360f4..59bd7dc 100644 --- a/src/message-rendering-utils.lisp +++ b/src/message-rendering-utils.lisp @@ -68,10 +68,20 @@ is found as key in the alist `usernames-table'" (let ((results text-line)) (loop for (local-mention . actual-mention) in usernames-table do - (let ((local-mention-re (strcat " " local-mention))) - (setf results (regex-replace-all local-mention-re results actual-mention)))) + (let ((local-mention-re (strcat "(\\s|^)" local-mention))) + (setf results (regex-replace-all local-mention-re + results + (strcat " " actual-mention))))) results)) +(defun expand-mention (text) + (let ((mentioned-users-table (usernames->usernames-table text))) + (with-output-to-string (stream) + (loop for line in (text-utils:split-lines text) do + (let ((line-fixed-mentions (local-mention->acct line mentioned-users-table))) + (write-sequence line-fixed-mentions stream) + (format stream "~%")))))) + (defun crypto-message-destination-user (message-data) (with-accessors ((body sending-message:body) (subject sending-message:subject) @@ -207,8 +217,11 @@ (defgeneric message-original->text-body (object &key &allow-other-keys)) -(defmethod message-original->text-body ((object string) &key &allow-other-keys) +(defmethod message-original->text-body ((object string) + &key (add-link-footnotes t) + &allow-other-keys) (let* ((raw-body (html-utils:html->text object + :add-link-footnotes add-link-footnotes :quote-prefix (swconf:message-window-quote-prefix) :list-item-prefix (swconf:message-window-bullet-prefix)))) (emoji-shortcodes:emojify raw-body))) diff --git a/src/package.lisp b/src/package.lisp index 0929f14..2b28ed0 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -2430,6 +2430,7 @@ :usernames->usernames-table :strip-mention-prefix :local-mention->acct + :expand-mention :crypto-message-destination-user :maybe-crypt-message :attachment-type->description diff --git a/src/program-events.lisp b/src/program-events.lisp index 01a23a8..1ac1aaa 100644 --- a/src/program-events.lisp +++ b/src/program-events.lisp @@ -2092,7 +2092,8 @@ (defmethod process-event ((object edit-status-event)) (with-accessors ((status-id payload)) object (when-let* ((status (db:find-status-id status-id)) - (text (db:row-message-rendered-text status)) + (text (msg-utils:message-original->text-body (db:row-message-content status) + :add-link-footnotes nil)) (status-id (db:row-message-status-id status)) (folder (db:row-message-folder status)) (timeline (db:row-message-timeline status)) @@ -2102,7 +2103,8 @@ :direction :output :if-exists :supersede :if-does-not-exist :create) - (write-sequence text stream)) + (let ((mentioned-users-text (msg-utils:expand-mention text))) + (write-sequence mentioned-users-text stream))) (croatoan:end-screen) (tui:with-notify-errors (os-utils:open-with-editor temp-file)) diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index eaf468c..23b4ed9 100644 --- a/src/ui-goodies.lisp +++ b/src/ui-goodies.lisp @@ -1386,18 +1386,14 @@ It an existing file path is provided the command will refuse to run." (quote-mark (swconf:quote-char)) (quoted-lines (mapcar (lambda (a) (strcat quote-mark a)) lines))) - (let ((mentioned-users-table - (message-rendering-utils:usernames->usernames-table quoted-text))) - (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 - (let ((line-fixed-mentions - (message-rendering-utils:local-mention->acct line - mentioned-users-table))) - (format stream "~a~%" line-fixed-mentions)))))))) + (with-open-file (stream + file + :if-exists :append + :direction :output + :element-type 'character) + (format stream "~a~%" (msg-utils:add-mention-prefix reply-username)) + (let ((mentioned-users-text (msg-utils:expand-mention quoted-text))) + (write-sequence mentioned-users-text stream)))))) (add-signature (file) (when-let ((signature (message-rendering-utils:signature))) (with-open-file (stream