mirror of https://codeberg.org/cage/tinmop/
- [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 ()
|
(defun make-poll ()
|
||||||
(query-low-level (strcat (prepare-table +table-poll+ :autogenerated-id-p t)
|
(query-low-level (strcat (prepare-table +table-poll+ :autogenerated-id-p t)
|
||||||
" \"status-id\" TEXT NOT NULL "
|
" \"status-id\" TEXT NOT NULL "
|
||||||
;(make-foreign +table-status+ "status-id" +cascade+ +cascade+)
|
;;(make-foreign +table-status+ "status-id" +cascade+ +cascade+)
|
||||||
+col-sep+
|
+col-sep+
|
||||||
;; date
|
;; date
|
||||||
" \"expire-date\" TEXT NOT NULL,"
|
" \"expire-date\" TEXT NOT NULL,"
|
||||||
|
@ -1912,11 +1912,10 @@ the message identified by the tuple."
|
||||||
(let* ((query (select :acct
|
(let* ((query (select :acct
|
||||||
(from +table-mention+)
|
(from +table-mention+)
|
||||||
(where (:= :username username))))
|
(where (:= :username username))))
|
||||||
(rows (mapcar #'second
|
(acct (second (fetch-single query))))
|
||||||
(fetch-all-rows query))))
|
|
||||||
(if add-mention-prefix
|
(if add-mention-prefix
|
||||||
(mapcar #'msg-utils:add-mention-prefix rows)
|
(msg-utils:add-mention-prefix acct)
|
||||||
rows)))
|
acct)))
|
||||||
|
|
||||||
(defmacro gen-access-message-row (name column
|
(defmacro gen-access-message-row (name column
|
||||||
&key
|
&key
|
||||||
|
|
|
@ -68,10 +68,20 @@
|
||||||
is found as key in the alist `usernames-table'"
|
is found as key in the alist `usernames-table'"
|
||||||
(let ((results text-line))
|
(let ((results text-line))
|
||||||
(loop for (local-mention . actual-mention) in usernames-table do
|
(loop for (local-mention . actual-mention) in usernames-table do
|
||||||
(let ((local-mention-re (strcat " " local-mention)))
|
(let ((local-mention-re (strcat "(\\s|^)" local-mention)))
|
||||||
(setf results (regex-replace-all local-mention-re results actual-mention))))
|
(setf results (regex-replace-all local-mention-re
|
||||||
|
results
|
||||||
|
(strcat " " actual-mention)))))
|
||||||
results))
|
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)
|
(defun crypto-message-destination-user (message-data)
|
||||||
(with-accessors ((body sending-message:body)
|
(with-accessors ((body sending-message:body)
|
||||||
(subject sending-message:subject)
|
(subject sending-message:subject)
|
||||||
|
@ -207,8 +217,11 @@
|
||||||
|
|
||||||
(defgeneric message-original->text-body (object &key &allow-other-keys))
|
(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
|
(let* ((raw-body (html-utils:html->text object
|
||||||
|
:add-link-footnotes add-link-footnotes
|
||||||
:quote-prefix (swconf:message-window-quote-prefix)
|
:quote-prefix (swconf:message-window-quote-prefix)
|
||||||
:list-item-prefix (swconf:message-window-bullet-prefix))))
|
:list-item-prefix (swconf:message-window-bullet-prefix))))
|
||||||
(emoji-shortcodes:emojify raw-body)))
|
(emoji-shortcodes:emojify raw-body)))
|
||||||
|
|
|
@ -2430,6 +2430,7 @@
|
||||||
:usernames->usernames-table
|
:usernames->usernames-table
|
||||||
:strip-mention-prefix
|
:strip-mention-prefix
|
||||||
:local-mention->acct
|
:local-mention->acct
|
||||||
|
:expand-mention
|
||||||
:crypto-message-destination-user
|
:crypto-message-destination-user
|
||||||
:maybe-crypt-message
|
:maybe-crypt-message
|
||||||
:attachment-type->description
|
:attachment-type->description
|
||||||
|
|
|
@ -2092,7 +2092,8 @@
|
||||||
(defmethod process-event ((object edit-status-event))
|
(defmethod process-event ((object edit-status-event))
|
||||||
(with-accessors ((status-id payload)) object
|
(with-accessors ((status-id payload)) object
|
||||||
(when-let* ((status (db:find-status-id status-id))
|
(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))
|
(status-id (db:row-message-status-id status))
|
||||||
(folder (db:row-message-folder status))
|
(folder (db:row-message-folder status))
|
||||||
(timeline (db:row-message-timeline status))
|
(timeline (db:row-message-timeline status))
|
||||||
|
@ -2102,7 +2103,8 @@
|
||||||
:direction :output
|
:direction :output
|
||||||
:if-exists :supersede
|
:if-exists :supersede
|
||||||
:if-does-not-exist :create)
|
: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)
|
(croatoan:end-screen)
|
||||||
(tui:with-notify-errors
|
(tui:with-notify-errors
|
||||||
(os-utils:open-with-editor temp-file))
|
(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))
|
(quote-mark (swconf:quote-char))
|
||||||
(quoted-lines (mapcar (lambda (a) (strcat quote-mark a))
|
(quoted-lines (mapcar (lambda (a) (strcat quote-mark a))
|
||||||
lines)))
|
lines)))
|
||||||
(let ((mentioned-users-table
|
(with-open-file (stream
|
||||||
(message-rendering-utils:usernames->usernames-table quoted-text)))
|
file
|
||||||
(with-open-file (stream file
|
|
||||||
:if-exists :append
|
:if-exists :append
|
||||||
:direction :output
|
:direction :output
|
||||||
:element-type 'character)
|
:element-type 'character)
|
||||||
(format stream "~a~%" (msg-utils:add-mention-prefix reply-username))
|
(format stream "~a~%" (msg-utils:add-mention-prefix reply-username))
|
||||||
(loop for line in quoted-lines do
|
(let ((mentioned-users-text (msg-utils:expand-mention quoted-text)))
|
||||||
(let ((line-fixed-mentions
|
(write-sequence mentioned-users-text stream))))))
|
||||||
(message-rendering-utils:local-mention->acct line
|
|
||||||
mentioned-users-table)))
|
|
||||||
(format stream "~a~%" line-fixed-mentions))))))))
|
|
||||||
(add-signature (file)
|
(add-signature (file)
|
||||||
(when-let ((signature (message-rendering-utils:signature)))
|
(when-let ((signature (message-rendering-utils:signature)))
|
||||||
(with-open-file (stream
|
(with-open-file (stream
|
||||||
|
|
Loading…
Reference in New Issue