cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-02-16 08:00:35 +01:00
Code Issues

- added the possibility to search inside a widows that contains a collection of links.

Browse Source
This commit is contained in:
cage 2020-10-03 16:58:02 +02:00
parent d5f0121923
commit a54e05a05f
7 changed files with 112 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
etc/init.lisp
View File

@ -369,6 +369,8 @@
(define-key "e" #'open-message-link-open-enqueue *open-message-link-keymap*)
(define-key "/" #'search-link-window *open-message-link-keymap*)
;; chats list window
(define-key "r" #'refresh-chat-messages *chats-list-keymap*)

4
src/complete.lisp
View File

@ -161,3 +161,7 @@ list af all possible candidtae for completion."
(defun complete-chat-message (hint)
(append (username-complete hint)
(directory-complete hint)))
(defun complete-always-empty (hint)
(declare (ignore hint))
nil)

30
src/line-oriented-window.lisp
View File

@ -136,6 +136,8 @@
(defgeneric selected-row-delete (object))
(defgeneric search-row (object regex &key redraw))
(defgeneric row-move (object amount)
(:documentation "Move selected line of 'amount'. 'Amount' can be
an integer number, if positive increase the position of the selected
@ -237,6 +239,24 @@ this exact quantity wold go beyond the length or rows or zero."
actual-amount)
0)))
(defmethod search-row ((object row-oriented-widget) regex &key (redraw t))
(handler-case
(with-accessors ((row-selected-index row-selected-index)) object
(when-let* ((scanner (create-scanner regex :case-insensitive-mode t))
(position-found (position-if (lambda (a)
(if (selectedp a)
(scan scanner (selected-text a))
(scan scanner (normal-text a))))
(safe-subseq (rows object)
row-selected-index))))
(unselect-all object)
(select-row object (+ row-selected-index position-found))
(when redraw
(draw object))
position-found))
(error ()
(ui:error-message (_ "Invalid regular expression")))))
(defclass simple-line-navigation-window (wrapper-window row-oriented-widget border-window)
((selected-line-bg
:initform :blue
@ -248,11 +268,11 @@ this exact quantity wold go beyond the length or rows or zero."
:initarg :selected-line-fg
:accessor selected-line-fg
:documentation "The foreground color for a selected line")
(line
:initform :red
:initarg :selected-line-fg
:accessor selected-line-fg
:documentation "The foreground color for a selected line")
;; (line
;; :initform :red
;; :initarg :selected-line-fg
;; :accessor selected-line-fg
;; :documentation "The foreground color for a selected line")
(top-horizontal-padding
:initform 0
:initarg :top-horizontal-padding

60
src/open-message-link-window.lisp
View File

@ -76,15 +76,36 @@
(gemini-viewer:request url :enqueue enqueue))
(os-utils:xdg-open url)))
(defclass open-gemini-document-link-window (focus-marked-window
simple-line-navigation-window
title-window
border-window)
(defclass open-links-window ()
((links
:initform ()
:initarg :links
:accessor links)))
(defmethod search-row ((object open-links-window) regex &key (redraw t))
(handler-case
(with-accessors ((row-selected-index row-selected-index)) object
(when-let* ((scanner (create-scanner regex :case-insensitive-mode t))
(position-found (position-if (lambda (a)
(if (selectedp a)
(scan scanner (selected-text a))
(scan scanner (normal-text a))))
(safe-subseq (rows object)
row-selected-index))))
(unselect-all object)
(select-row object position-found)
(when redraw
(draw object))))
(error ()
(ui:error-message (_ "Invalid regular expression")))))
(defclass open-gemini-document-link-window (focus-marked-window
simple-line-navigation-window
title-window
border-window
open-links-window)
())
(defmethod refresh-config :after ((object open-gemini-document-link-window))
(open-attach-window:refresh-view-links-window-config object
swconf:+key-open-message-link-window+))
@ -139,6 +160,25 @@
:bgcolor (bgcolor croatoan-window)
:fgcolor (fgcolor croatoan-window)))))))
(defmethod search-row ((object open-gemini-document-link-window) regex &key (redraw t))
(handler-case
(with-accessors ((row-selected-index row-selected-index)) object
(let* ((saved-selected-index row-selected-index)
(scanner (create-scanner regex :case-insensitive-mode t))
(position-header (position-if (lambda (a)
(scan scanner
(gemini-parser:name a)))
(safe-subseq (links object)
row-selected-index))))
(call-next-method) ; seatch in urls
(when position-header ;; but if han header has been found, it wins
(unselect-all object)
(select-row object (+ saved-selected-index position-header))
(when redraw
(draw object)))))
(error ()
(ui:error-message (_ "Invalid regular expression")))))
(defun init-gemini-links (links)
(let* ((low-level-window (make-croatoan-window :enable-function-keys t)))
(setf *open-message-link-window*
@ -163,13 +203,11 @@
keybindings:*message-keymap*))
(defclass open-chat-document-link-window (focus-marked-window
simple-line-navigation-window
title-window
border-window)
((links
:initform ()
:initarg :links
:accessor links)))
simple-line-navigation-window
title-window
border-window
open-links-window)
())
(defmethod refresh-config :after ((object open-chat-document-link-window))
(open-attach-window:refresh-view-links-window-config object

6
src/package.lisp
View File

@ -1155,7 +1155,8 @@
:tags-complete
:conversation-folder
:make-complete-gemini-uri-fn
:complete-chat-message))
:complete-chat-message
:complete-always-empty))
(defpackage :program-events
(:use
@ -1258,6 +1259,7 @@
:chat-post-message-event
:chat-change-label-event
:chat-create-event
:search-link-event
:function-event
:dispatch-program-events
:add-pagination-status-event
@ -1675,6 +1677,7 @@
:ignore-selecting-action
:selected-row-fields
:selected-row-delete
:search-row
:row-move
:simple-line-navigation-window
:selected-line-bg
@ -2155,6 +2158,7 @@
:open-message-attach-go-down
:open-message-attach-perform-opening
:close-open-attach-window
:search-link-window
:open-message-link
:open-message-link-go-up
:open-message-link-go-down

15
src/program-events.lisp
View File

@ -1151,6 +1151,21 @@
:chat-id (api-pleroma:chat-id chat)
:label chat-label)))))
(defclass search-link-event (program-event)
((window
:initform nil
:initarg :window
:accessor window)
(regex
:initform nil
:initarg :regex
:accessor regex)))
(defmethod process-event ((object search-link-event))
(with-accessors ((window window)
(regex regex)) object
(line-oriented-window:search-row window regex)))
;;;; general usage
(defclass function-event (program-event) ())

12
src/ui-goodies.lisp
View File

@ -1032,6 +1032,18 @@ Force the checking for new message in the thread the selected message belong."
(defun close-open-attach-window ()
(close-window-and-return-to-threads *open-attach-window*))
(defun search-link-window ()
"Search a link window with a text matching a regular expression"
(flet ((on-input-complete (regex)
(when-let* ((window (main-window:focused-window *main-window*)))
(let ((event (make-instance 'search-link-event
:window window
:regex regex)))
(push-event event)))))
(ask-string-input #'on-input-complete
:prompt (_ "Search key: ")
:complete-fn #'complete:complete-always-empty)))
(defun open-gemini-message-link-window ()
(let* ((window *message-window*)
(metadata (message-window:metadata window))