mirror of
https://codeberg.org/cage/tinmop/
synced 2025-02-09 07:18:39 +01:00
- [fediverse] removed spurious text added when editing a post;
- [fediverse] fixed mention expanding.
This commit is contained in:
parent
c182ed743e
commit
f504a8be08
@ -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
|
||||
|
@ -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)))
|
||||
|
@ -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
|
||||
|
@ -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))
|
||||
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user