cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-02-25 09:17:45 +01:00
Code Issues

- added new command: 'delete-shown-post'.

Browse Source
This commit is contained in:
cage 2023-11-11 19:49:46 +01:00
parent c16e88ad99
commit 9f6a26e0c8
4 changed files with 44 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
etc/init.lisp
View File

@ -397,6 +397,8 @@
(define-key "b" #'net-address-history-back *message-keymap*)
(define-key "d" #'delete-shown-post *message-keymap*)
(define-key "down" #'message-scroll-down *message-keymap*)
(define-key "end" #'message-scroll-end *message-keymap*)

2
src/package.lisp
View File

@ -2388,6 +2388,7 @@
:mentions-count
:add-announcements-notification
:remove-announcements-notification
:select-messages-corresponding-to-shown
:grow-tree-to-fit-window
:fit-timeline-to-window
:go-message-down
@ -3076,6 +3077,7 @@
:open-net-address
:open-gemini-address
:net-address-history-back
:delete-shown-post
:address-go-back-in-path
:address-go-root-path
:gemini-view-source

35
src/thread-window.lisp
View File

@ -868,6 +868,34 @@ db:renumber-timeline-message-index."
db:+mentions-status-folder+)))
(remove-mention window status-id)))
(defun maybe-initialize-metadata (window)
(setf (message-window:metadata window) '())
(message-window:metadata window))
(defun set-status-tuple-shown-status (window status-id timeline folder)
(with-accessors ((metadata misc:metadata)) window
(setf metadata (acons :status-id status-id metadata))
(setf metadata (acons :timeline timeline metadata))
(setf metadata (acons :folder folder metadata))
window))
(defun get-status-tuple-shown-status (window)
(with-accessors ((metadata misc:metadata)) window
(values (cdr (assoc :status-id metadata))
(cdr (assoc :timeline metadata))
(cdr (assoc :folder metadata)))))
(defun select-messages-corresponding-to-shown ()
(multiple-value-bind (status-id timeline folder)
(get-status-tuple-shown-status *message-window*)
(let ((matching-status (db::find-status-id-folder-timeline status-id
folder
timeline)))
(if matching-status
(let ((new-message-index (db:row-message-index matching-status)))
(rebuild-lines *thread-window* new-message-index))
(ui:info-message (format nil (_ "No matching post in thread window")))))))
(defmethod open-message ((object thread-window))
(with-accessors ((row-selected-index row-selected-index)
(rows rows)
@ -894,6 +922,11 @@ db:renumber-timeline-message-index."
attachments
(strcat reblogged-status-attachments attachments))))
(maybe-remove-mentions object status-id)
(maybe-initialize-metadata *message-window*)
(set-status-tuple-shown-status *message-window*
status-id
timeline-type
timeline-folder)
(message-window:prepare-for-rendering *message-window*
(strcat header
actual-body
@ -980,7 +1013,7 @@ db:renumber-timeline-message-index."
(timeline-folder timeline-folder)
(timeline-type timeline-type)) window
(a:when-let* ((selected-fields (selected-row-fields window))
(starting-index (db-utils:db-getf selected-fields :message-index)))
(starting-index (db-utils:db-getf selected-fields :message-index)))
(let ((matching-status (if (eq direction :next)
(db:search-next-message-meta timeline-type
timeline-folder

6
src/ui-goodies.lisp
View File

@ -3515,3 +3515,9 @@ gemini client certificates!)."
(nreverse actual-lines)
bg
fg))))
(defun delete-shown-post ()
"Marks as deleted the post shown in the main window, also move focus to threads window."
(thread-window:select-messages-corresponding-to-shown)
(thread-window:mark-selected-message-to-delete *thread-window*
:move-down-selected-message nil)
(focus-to-thread-window))