130 lines
4.2 KiB
Common Lisp
130 lines
4.2 KiB
Common Lisp
(uiop:define-package :sextant/org/cursor
|
||
(:use :cl :alexandria :sextant/org/nodes)
|
||
(:export #:make-cursor
|
||
#:cursor-node
|
||
#:cursor-index
|
||
#:visual-index
|
||
#:visible-node
|
||
#:visible-index
|
||
#:document-commands
|
||
#:move-cursor
|
||
#:previous-visible-node
|
||
#:previous-visible-headline
|
||
#:previous-node
|
||
#:previous-headline
|
||
#:next-visible-node
|
||
#:next-visible-headline
|
||
#:next-node
|
||
#:next-headline
|
||
#:goto-index))
|
||
(in-package :sextant/org/cursor)
|
||
|
||
(defstruct (cursor (:constructor make-cursor (document node index visual-index)))
|
||
(document nil :type org-document)
|
||
(node nil :type org-node)
|
||
(index 0 :type number)
|
||
(visual-index 0 :type number))
|
||
|
||
(defun visual-index (cursor) (cursor-visual-index cursor))
|
||
|
||
(defun visible-node (cursor)
|
||
(let ((node (cursor-node cursor)))
|
||
(if (node-visible-p node)
|
||
node
|
||
(visible-headline-of node))))
|
||
|
||
(defun visible-index (cursor)
|
||
(let ((node (cursor-node cursor)))
|
||
(if (node-visible-p node)
|
||
(cursor-index cursor)
|
||
(- (cursor-index cursor) (count-nodes (visible-headline-of node) node)))))
|
||
|
||
(defun document-commands (cursor)
|
||
(property-of (cursor-document cursor) :commands))
|
||
|
||
|
||
|
||
(defgeneric node-index (prev next))
|
||
|
||
(defmethod node-index ((prev cursor) (next org-node))
|
||
(+ (cursor-index prev) (count-nodes (cursor-node prev) next)))
|
||
|
||
(defmethod node-index ((prev org-node) (next cursor))
|
||
(- (cursor-index next) (count-nodes prev (cursor-node next))))
|
||
|
||
(defgeneric node-visual-index (prev next))
|
||
|
||
(defmethod node-visual-index ((prev cursor) (next org-node))
|
||
(+ (visual-index prev) (count-visible-nodes (visible-node prev) (if (node-visible-p next) next (visible-headline-of next)))))
|
||
|
||
(defmethod node-visual-index ((prev org-node) (next cursor))
|
||
(- (visual-index next) (count-visible-nodes (if (node-visible-p prev) prev (visible-headline-of prev)) (visible-node next))))
|
||
|
||
(defun move-cursor-< (cursor target)
|
||
(make-cursor (cursor-document cursor) target (node-index target cursor) (node-visual-index target cursor)))
|
||
|
||
(defun move-cursor-> (cursor target)
|
||
(make-cursor (cursor-document cursor) target (node-index cursor target) (node-visual-index cursor target)))
|
||
|
||
(defun move-cursor (cursor target direction)
|
||
(if (plusp direction)
|
||
(move-cursor-> cursor target)
|
||
(move-cursor-< cursor target)))
|
||
|
||
|
||
|
||
(defun previous-visible-node (cursor)
|
||
(when-let ((target (previous-visible-of (visible-node cursor))))
|
||
(move-cursor-< cursor target)))
|
||
|
||
(defun previous-node (cursor)
|
||
(when-let ((target (previous-of (cursor-node cursor))))
|
||
(move-cursor-< cursor target)))
|
||
|
||
(defun previous-visible-headline (cursor)
|
||
(when-let ((target (previous-visible-headline-of cursor (visible-node cursor))))
|
||
(move-cursor-< cursor target)))
|
||
|
||
(defgeneric %previous-headline (cursor node))
|
||
|
||
(defmethod %previous-headline (cursor (node org-line))
|
||
(when-let ((target (headline-of node)))
|
||
(move-cursor-< cursor target)))
|
||
|
||
(defmethod %previous-headline (cursor (node org-headline))
|
||
(when-let ((target (previous-headline-of node)))
|
||
(move-cursor-< cursor target)))
|
||
|
||
(defun previous-headline (cursor)
|
||
(%previous-headline cursor (cursor-node cursor)))
|
||
|
||
|
||
|
||
(defun next-visible-node (cursor)
|
||
(when-let ((target (next-visible-of (visible-node cursor))))
|
||
(move-cursor-> cursor target)))
|
||
|
||
(defun next-node (cursor)
|
||
(when-let ((target (next-of (cursor-node cursor))))
|
||
(move-cursor-> cursor target)))
|
||
|
||
(defun next-visible-headline (cursor)
|
||
(when-let ((target (next-visible-headline-of (visible-node cursor))))
|
||
(move-cursor-> cursor target)))
|
||
|
||
(defun next-headline (cursor)
|
||
(when-let ((target (next-headline-of (cursor-node cursor))))
|
||
(move-cursor-> cursor target)))
|
||
|
||
|
||
|
||
(defun goto-index (cursor index)
|
||
(if (< index (cursor-index cursor))
|
||
(loop for step below (- (cursor-index cursor) index)
|
||
and n = (cursor-node cursor) then (previous-of n)
|
||
until (null n)
|
||
finally (return (and n (move-cursor-< cursor n))))
|
||
(loop for step below (- index (cursor-index cursor))
|
||
and n = (cursor-node cursor) then (next-of n)
|
||
until (null n)
|
||
finally (return (and n (move-cursor-> cursor n))))))
|