cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- fixed searching in reblogged statuses body, previously the search procedure skipped the reblogged statuses.

This commit is contained in:
cage 2024-02-18 14:25:48 +01:00
parent 8ba4d4ace2
commit 5c8237a192
3 changed files with 19 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
etc/init.lisp
View File

@ -345,6 +345,8 @@
(define-key "\\\\ \\\\" #'repeat-search *thread-keymap*)
(define-key "/ /" #'repeat-search *thread-keymap*)
(define-key "\\\\ b" #'thread-search-previous-message-body *thread-keymap*)
(define-key "\\\\ m" #'thread-search-previous-message-meta *thread-keymap*)

26
src/db.lisp
View File

@ -2239,6 +2239,18 @@ reblogged (if exists)."
(order-by= query :message-index)
(fetch-all-rows query)))
(defun find-matching-search-message-body (text-looking-for messages)
(let ((scanner (cl-ppcre:create-scanner text-looking-for
:case-insensitive-mode t)))
(loop for message in messages when (row-message-reblog-id message) do
(let* ((reblogged-status (find-status-id (row-message-reblog-id message)))
(reblogged-text (row-message-rendered-text reblogged-status)))
(setf (getf message :rendered-text)
reblogged-text)))
(find-if (lambda (a) (cl-ppcre:scan scanner
(row-message-rendered-text a)))
messages)))
(defun search-next-message-body (timeline
folder
text-looking-for
@ -2247,17 +2259,14 @@ reblogged (if exists)."
"Search for `text-looking-for' inside the body of messages belonging
to `timeline' , `folder' and possibly `account-id', newer than
`start-status-message-index'"
(let* ((actual-text-looking-for (prepare-for-sql-like text-looking-for))
(query (make-filtered-message-select nil
(let* ((query (make-filtered-message-select nil
timeline
folder
account-id
`(:and :like :rendered-text
,actual-text-looking-for)
`(:and :> :status.message-index
,start-status-message-index))))
(order-by= query :message-index)
(fetch-single query)))
(find-matching-search-message-body text-looking-for (fetch-all-rows query))))
(defun search-previous-message-body (timeline
folder
@ -2267,17 +2276,14 @@ to `timeline' , `folder' and possibly `account-id', newer than
"Search for `text-looking-for' inside the body of messages belonging
to `timeline' , `folder' and possibly `account-id', older than
`start-status-message-index'"
(let* ((actual-text-looking-for (prepare-for-sql-like text-looking-for))
(query (make-filtered-message-select nil
(let* ((query (make-filtered-message-select nil
timeline
folder
account-id
`(:and :like :rendered-text
,actual-text-looking-for)
`(:and :< :status.message-index
,start-status-message-index))))
(order-by= query '(:desc :message-index))
(fetch-single query)))
(find-matching-search-message-body text-looking-for (fetch-all-rows query))))
(defun search-next-message-meta (timeline
folder

2
src/thread-window.lisp
View File

@ -979,7 +979,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-body timeline-type
timeline-folder