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

- [gemini] added commands: 'go-to-previous-link' and 'go-to-next-link'.

Browse Source
This commit is contained in:
cage 2021-11-26 14:10:11 +01:00
parent ab91432e2e
commit 1fbdab1443
5 changed files with 49 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
etc/init.lisp
View File

@ -429,6 +429,10 @@
(define-key "C-l n" #'open-next-visible-link *gemini-message-keymap*)
(define-key "]" #'go-to-next-link *gemini-message-keymap*)
(define-key "[" #'go-to-previous-link *gemini-message-keymap*)
;; gemini page table of contents keymap
(define-key "up" #'gemini-toc-scroll-up *gemini-toc-keymap*)

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

@ -371,7 +371,7 @@ this exact quantity would go beyond the length or rows or zero."
(first-elt (rows object)))
(defmethod rows-position-if ((object row-oriented-widget) (predicate function)
&key from-end start end key &allow-other-keys)
&key from-end (start 0) end key &allow-other-keys)
(position-if predicate
(rows object)
:from-end from-end

22
src/message-window.lisp
View File

@ -233,6 +233,8 @@
(defgeneric row-find-original-object (object thing))
(defgeneric row-position-original-object (object thing &key start from-end end))
(defmethod row-add-original-object ((lines line) original-object)
(push original-object
(fields lines))
@ -255,6 +257,26 @@
(find-if (lambda (a) (typep (extract-original-object a) thing))
object))
(defmethod row-position-original-object ((object message-window) (thing symbol)
&key (start 0) (from-end nil) (end nil))
(when (and (>= start 0)
(< start (rows-length object))
(or (null end)
(and (< end (rows-length object))
(>= end start))))
(rows-position-if object (lambda (a) (typep (extract-original-object a) thing))
:start start
:end end
:from-end from-end)))
(defmethod row-position-original-object ((object list) (thing symbol)
&key (start 0) (from-end nil) (end nil))
(position-if (lambda (a) (typep (extract-original-object a) thing))
object
:start start
:end end
:from-end from-end))
(defun row-get-original-object (line)
(getf (fields line) :original-object))

3
src/package.lisp
View File

@ -2112,6 +2112,7 @@
:toggle-preformatted-block
:text->rendered-lines-rows
:row-find-original-object
:row-position-original-object
:extract-original-object
:prepare-for-display-status-mode
:prepare-for-rendering
@ -2618,6 +2619,8 @@
:open-message-link-perform-opening
:open-message-link-open-enqueue
:open-next-visible-link
:go-to-next-link
:go-to-previous-link
:close-open-message-link-window
:attach-go-up
:attach-go-down

19
src/ui-goodies.lisp
View File

@ -1223,6 +1223,25 @@ Browse and optionally open the links the text of the message window contains."
(uri (gemini-parser::link-value link-object)))
(open-message-link-window:open-message-link uri nil)))
(defun go-to-next-link ()
(when-let* ((win *message-window*)
(1+selected-row-pos (1+ (line-oriented-window:row-selected-index win)))
(link-line-pos (message-window:row-position-original-object win
'gemini-parser:link-line
:start 1+selected-row-pos)))
(line-oriented-window:row-move win (- link-line-pos (1- 1+selected-row-pos)))
(windows:draw win)))
(defun go-to-previous-link ()
(when-let* ((win *message-window*)
(selected-row-pos (line-oriented-window:row-selected-index win))
(link-line-pos (message-window:row-position-original-object win
'gemini-parser:link-line
:end selected-row-pos
:from-end t)))
(line-oriented-window:row-move win (- link-line-pos selected-row-pos))
(windows:draw win)))
(defun line-window-move (win amount)
(ignore-errors
(line-oriented-window:unselect-all win)