WIP

lisp/local-projects/sextant/models/actions.lisp

@@ -53,7 +53,7 @@
                  (when funsym
                    (let ((fun (intern funsym #.*package*)))
                      (when (fboundp fun)
-                       (funcall fun *caller* (goto-index index) (cons x y)))))))
+                       (funcall fun *caller* (goto-visual-index index) (cons x y)))))))
            (export ',symbol)))
      ,(let ((symbol (intern (concatenate 'string (symbol-name type) "-DOUBLE-CLICKED")))
             (funsym (intern (concatenate 'string "DOUBLE-CLICK-ON-" (symbol-name type))
@@ -64,7 +64,7 @@
                  (when funsym
                    (let ((fun (intern funsym #.*package*)))
                      (when (fboundp fun)
-                       (funcall fun *caller* (goto-index index) (cons x y)))))))
+                       (funcall fun *caller* (goto-visual-index index) (cons x y)))))))
            (export ',symbol)))
      ,(let ((symbol (intern (concatenate 'string (symbol-name type) "-PRESS-AND-HOLD")))
             (funsym (intern (concatenate 'string "PRESS-AND-HOLD-ON-" (symbol-name type))
@@ -75,7 +75,7 @@
                  (when funsym
                    (let ((fun (intern funsym #.*package*)))
                      (when (fboundp fun)
-                       (funcall fun *caller* (goto-index index) (cons x y)))))))
+                       (funcall fun *caller* (goto-visual-index index) (cons x y)))))))
            (export ',symbol)))))
 
 (defaction-type org-line)

lisp/local-projects/sextant/models/all.lisp

@@ -3,6 +3,7 @@
   (:use-reexport
    :sextant/models/utils
    :sextant/models/files-model
+   :sextant/models/cursor
    :sextant/models/commands
    :sextant/models/actions
    :sextant/models/org-model))

lisp/local-projects/sextant/models/commands.lisp

@@ -1,6 +1,7 @@
 (uiop:define-package :sextant/models/commands
   (:use :cl :eql :org :options :qml-lisp :s-base64 :alexandria
-        :sextant/models/org-model)
+        :sextant/models/org-model
+        :sextant/models/cursor)
   (:import-from :inferior-shell #:run)
   (:export #:modify-text
            #:join-node
@@ -85,21 +86,12 @@
 
 
 
-(defun reparse-node (index &optional (force nil))
+(defun do-modify-text (index new-text update-ui-p)
-  (let* ((node (goto-index index))
-         (new-node (parse-node node)))
-    (if (or (replace-data node new-node) force)
-        (refresh-data index
-                      (progn (goto-end-section) (current-index)))
-        (refresh-data index))
-    new-node))
-
-(defun do-modify-text (index new-text update-ui)
   (setf (raw-text-of (goto-index index)) new-text)
-  (when update-ui
+  (when update-ui-p
     (reparse-node index)))
 
-(defun do-join-node (command update-ui)
+(defun do-join-node (command update-ui-p)
   (let* ((node (goto-index (index-of command)))
          (next (next-of node))
          (next-next (next-of next)))
@@ -108,16 +100,17 @@
     (flet ((relink-nodes (n nn)
              (setf (next-of n) nn)
              (when nn (setf (previous-of nn) n))))
-      (if update-ui
+      (if update-ui-p
           (progn
             (removing-rows ((1+ (index-of command)))
               (relink-nodes node next-next))
-            (reparse-node (index-of command) (subtypep (type-of next) 'org-headline)))
+            (reparse-node (index-of command))
+            (qjs |focusIndex| "orgDocument" (current-visual-index) t (length (previous-text-of command))))
           (progn
             (relink-nodes node next-next)
             (dec-nodes-count))))))
 
-(defun do-split-node (command update-ui)
+(defun do-split-node (command update-ui-p)
   (let* ((node (goto-index (index-of command)))
          (next (next-of node))
          (new-node (make-org-line (next-text-of command) (next-eol-of command))))
@@ -129,7 +122,7 @@
              (when nn
                (setf (previous-of nn) new
                      (next-of new) nn))))
-      (if update-ui
+      (if update-ui-p
           (progn
             (inserting-rows ((1+ (index-of command)))
               (relink-nodes node next new-node))
@@ -137,33 +130,33 @@
             (reparse-node (1+ (index-of command))))
           (progn
             (relink-nodes node next new-node)
-            (inc-nodes-count))))))
+            (inc-visual-nodes-count))))))
 
 
 
-(defgeneric apply-command (command update-ui))
+(defgeneric apply-command (command update-ui-p))
 
-(defmethod apply-command ((command command-modify-text) update-ui)
+(defmethod apply-command ((command command-modify-text) update-ui-p)
-  (do-modify-text (index-of command) (after-text-of command) update-ui))
+  (do-modify-text (index-of command) (after-text-of command) update-ui-p))
 
-(defmethod apply-command ((command command-join-node) update-ui)
+(defmethod apply-command ((command command-join-node) update-ui-p)
-  (do-join-node command update-ui))
+  (do-join-node command update-ui-p))
 
-(defmethod apply-command ((command command-split-node) update-ui)
+(defmethod apply-command ((command command-split-node) update-ui-p)
-  (do-split-node command update-ui))
+  (do-split-node command update-ui-p))
 
 
 
-(defgeneric unapply-command (command update-ui))
+(defgeneric unapply-command (command update-ui-p))
 
-(defmethod unapply-command ((command command-modify-text) update-ui)
+(defmethod unapply-command ((command command-modify-text) update-ui-p)
-  (do-modify-text (index-of command) (before-text-of command) update-ui))
+  (do-modify-text (index-of command) (before-text-of command) update-ui-p))
 
-(defmethod unapply-command ((command command-join-node) update-ui)
+(defmethod unapply-command ((command command-join-node) update-ui-p)
-  (do-split-node command update-ui))
+  (do-split-node command update-ui-p))
 
-(defmethod unapply-command ((command command-split-node) update-ui)
+(defmethod unapply-command ((command command-split-node) update-ui-p)
-  (do-join-node command update-ui))
+  (do-join-node command update-ui-p))
 
 
 
@@ -200,81 +193,80 @@
 
 
 
-(defun push-command-modify-text (command index before-text after-text update-ui)
+(defun make-command-modify-text (command index before-text after-text)
-  (let ((next-command (make-instance 'command-modify-text :previous command
+  (make-instance 'command-modify-text :previous command
-                                                          :index index
+                                      :index index
-                                                          :before-text before-text
+                                      :before-text before-text
-                                                          :after-text after-text)))
+                                      :after-text after-text))
-    (apply-command next-command update-ui)
-    (setf (next-of command) next-command)))
 
-(defun push-command-join-node (command index previous-text previous-eol next-text next-eol update-ui)
+(defun make-command-join-node (command index previous-text previous-eol next-text next-eol)
-  (let ((next-command (make-instance 'command-join-node :previous command
+  (make-instance 'command-join-node :previous command
-                                                        :index index
+                                    :index index
-                                                        :previous-text previous-text
+                                    :previous-text previous-text
-                                                        :previous-eol previous-eol
+                                    :previous-eol previous-eol
-                                                        :next-text next-text
+                                    :next-text next-text
-                                                        :next-eol next-eol)))
+                                    :next-eol next-eol))
-    (apply-command next-command update-ui)
-    (setf (next-of command) next-command)))
 
-(defun push-command-split-node (command index previous-text previous-eol next-text next-eol update-ui)
+(defun make-command-split-node (command index previous-text previous-eol next-text next-eol)
-  (let ((next-command (make-instance 'command-split-node :previous command
+  (make-instance 'command-split-node :previous command
-                                                         :index index
+                                     :index index
-                                                         :previous-text previous-text
+                                     :previous-text previous-text
-                                                         :previous-eol previous-eol
+                                     :previous-eol previous-eol
-                                                         :next-text next-text
+                                     :next-text next-text
-                                                         :next-eol next-eol)))
+                                     :next-eol next-eol))
-    (apply-command next-command update-ui)
-    (setf (next-of command) next-command)))
 
 
 
-(defun modify-text (index text &optional update-ui)
+(defun modify-text (visual-index text &optional update-ui-p)
-  (let ((node (goto-index index)))
+  (multiple-value-bind (node index) (goto-visual-index visual-index)
-    (setf *current-state* (push-command-modify-text *current-state* index
+    (let ((next-command (make-command-modify-text *current-state* index
-                                                    (raw-text-of node) text update-ui))
+                                                  (raw-text-of node) text)))
-    (when update-ui
+      (apply-command next-command update-ui-p)
-      (refresh-toolbar))))
+      (setf (next-of *current-state*) next-command)))
-
+  (when update-ui-p
-(defun join-node (index &optional update-ui)
-  (let* ((node (goto-index index))
-         (next (next-of node)))
-    (setf *current-state* (push-command-join-node *current-state* index
-                                                  (raw-text-of node) (line-ending-of node)
-                                                  (raw-text-of next) (line-ending-of next)
-                                                  update-ui))
-    (when update-ui
-      (refresh-toolbar))))
-
-(defun split-node (index previous-text next-text &optional update-ui)
-  (let* ((node (goto-index index))
-         (next-eol (line-ending-of node))
-         (previous-eol (if (/= (length next-eol) 0)
-                           next-eol
-                           (let ((prev (previous-of node)))
-                             (if prev
-                                 (line-ending-of prev)
-                                 (coerce #(#\Newline) 'string))))))
-    (setf *current-state* (push-command-split-node *current-state* index
-                                                   previous-text previous-eol
-                                                   next-text next-eol update-ui)))
-  (when update-ui
     (refresh-toolbar)))
 
+(defun join-node (visual-index &optional update-ui-p)
+  (multiple-value-bind (node index) (goto-visual-index visual-index)
+    (let* ((previous (previous-of node))
+           (next-command (make-command-join-node *current-state* (1- index)
+                                                 (raw-text-of previous) (line-ending-of previous)
+                                                 (raw-text-of node) (line-ending-of node))))
+      (apply-command next-command update-ui-p)
+      (setf (next-of *current-state*) next-command)))
+  (when update-ui-p
+    (refresh-toolbar)))
+
+(defun split-node (visual-index previous-text next-text &optional update-ui-p)
+  (multiple-value-bind (node index) (goto-visual-index visual-index)
+    (let* ((next-eol (line-ending-of node))
+           (previous-eol (if (/= (length next-eol) 0)
+                             next-eol
+                             (let ((prev (previous-of node)))
+                               (if prev
+                                   (line-ending-of prev)
+                                   (coerce #(#\Newline) 'string)))))
+           (next-command (make-command-split-node *current-state* index
+                                                  previous-text previous-eol
+                                                  next-text next-eol)))
+      (apply-command next-command update-ui-p)
+      (setf (next-of *current-state*) next-command)))
+  (when update-ui-p
+    (refresh-toolbar))
+
 
 
-(defun undo ()
+  (defun undo ()
-  (let ((previous-state (previous-of *current-state*)))
+    (let ((previous-state (previous-of *current-state*)))
-    (unless (null previous-state)
+      (unless (null previous-state)
-      (prog1
+        (prog1
-          (index-of *current-state*)
+            (index-of *current-state*)
-        (unapply-command *current-state* t)
+          (unapply-command *current-state* t)
-        (setf *current-state* previous-state)
+          (setf *current-state* previous-state)
-        (refresh-toolbar)))))
+          (refresh-toolbar)))))
 
-(defun can-undo-p ()
+  (defun can-undo-p ()
-  (not (null (and *current-state* (previous-of *current-state*)))))
+    (not (null (and *current-state* (previous-of *current-state*))))))
 
 (defun redo ()
   (let ((next-state (next-of *current-state*)))
@@ -320,6 +312,7 @@
   (not (eq *saved-state* *current-state*)))
 
 (defun refresh-toolbar ()
+  #+harbour-sextant
   (qjs |refreshToolbar| "orgDocument"
        (can-undo-p) (can-redo-p) (can-save-p)))
 
@@ -341,48 +334,47 @@
         buffer))))
 
 (defun hash-base64 (buffer)
-  (if (null buffer)
+  (if (or (null buffer) (= (length buffer) 0))
       ""
       (with-output-to-string (stream)
         (encode-base64-bytes (|hash.QCryptographicHash| buffer |QCryptographicHash.Sha1|)
                              stream))))
 
 (defun load-commands (pathname)
+  (init-commands)
   (let ((commands-pathname (commands-pathname pathname)))
     (when (probe-file commands-pathname)
-      (let ((commands (uiop:safe-read-file-form commands-pathname
+      (let* ((commands (uiop:safe-read-file-form commands-pathname
-                                                :package :sextant/models/commands))
+                                                 :package :sextant/models/commands))
-            (sha (hash-base64 (load-binary-file pathname))))
+             (sha (hash-base64 (load-binary-file pathname))))
         (cond
           ((= (getf commands :version) 1)
-           (when (string= sha (getf commands :sha1))
+           (let ((saved-index (getf commands :saved-state))
-             (let ((command-count (loop with state = *initial-state*
+                 (current-index (getf commands :current-state)))
-                                        for c in (getf commands :commands)
+             (when (string= sha (getf commands :sha1))
-                                        count c
+               (let ((command-count (loop with state = *initial-state*
-                                        while c
+                                          for c in (getf commands :commands)
-                                        do (let ((command (apply #'make-instance c)))
+                                          count c
-                                             (setf (next-of state) command
+                                          while c
-                                                   (previous-of command) state)
+                                          do (let ((command (apply #'make-instance c)))
-                                             (setf state command)))))
+                                               (setf (next-of state) command
-               (let ((saved-index (getf commands :saved-state)))
+                                                     (previous-of command) state)
-                 (if (or (< saved-index 0) (> saved-index command-count))
+                                               (setf state command)))))
-                     (setf (next-of *initial-state*) nil)
+                 (when (and (>= saved-index 0) (< saved-index command-count))
-                     (progn
+                   (dotimes (i saved-index)
-                       (dotimes (i saved-index)
+                     (setf *saved-state* (next-of *saved-state*)))
-                         (setf *saved-state* (next-of *saved-state*)))
+                   (setf *current-state* *saved-state*)
-                       (setf *current-state* *saved-state*)
+                   (when (and (>= current-index 0) (<= current-index command-count))
-                       (let ((current-index (getf commands :current-state)))
+                     (let ((c *current-state*))
-                         (when (and (>= current-index 0) (<= current-index command-count))
+                       (cond
-                           (let ((c *current-state*))
+                         ((> current-index saved-index)
-                             (cond
+                          (dotimes (i (- current-index saved-index))
-                               ((> current-index saved-index)
+                            (setf *current-state* (next-of *current-state*))
-                                (dotimes (i (- current-index saved-index))
+                            (apply-command *current-state* nil)))
-                                  (setf *current-state* (next-of *current-state*))
+                         ((< current-index saved-index)
-                                  (apply-command *current-state* nil)))
+                          (dotimes (i (- saved-index current-index))
-                               ((< current-index saved-index)
+                            (unapply-command *current-state* nil)
-                                (dotimes (i (- saved-index current-index))
+                            (setf *current-state* (previous-of *current-state*)))))))))))))))))
-                                  (unapply-command *current-state* nil)
-                                  (setf *current-state* (previous-of *current-state*)))))))))))))))))))
 
 (defun save-commands (pathname)
   (unless (or (null *initial-state*) (null (next-of *initial-state*)))
@@ -414,11 +406,12 @@
         (princ "))" stream)
         (terpri stream)))))
 
-(defun initialize-commands (pathname)
+(defun initialize-commands (&optional pathname)
-  (setf *saved-hash* (hash-base64 (load-binary-file pathname)))
   (setf *saved-state*
         (setf *current-state*
               (setf *initial-state*
                     (make-instance 'command-initial-state))))
-  (load-commands pathname)
+  (when pathname
+    (setf *saved-hash* (hash-base64 (load-binary-file pathname)))
+    (load-commands pathname))
   (qlater #'refresh-toolbar))

lisp/local-projects/sextant/models/cursor.lisp

@@ -0,0 +1,319 @@
+(uiop:define-package :sextant/models/cursor
+  (:use :cl :sextant/org/nodes)
+  (:export #:init-cursor
+           #:root
+           #:current-visual-node
+           #:current-visual-headline
+           #:current-visual-index
+           #:current-visual-only-index
+           #:set-visual-cursor
+           #:move-visual-cursor
+           #:current-node
+           #:current-headline
+           #:current-index
+           #:reset-cursor
+           #:move-cursor
+           #:replace-cursor
+           #:save-current-cursor
+           #:restore-last-cursor
+           #:save-excursion
+           #:adjust-saved-cursors-before-remove
+           #:adjust-saved-cursors-before-insert
+           #:visual-node-depth
+           #:node-depth
+           #:previous-visual-node
+           #:previous-visual-headline
+           #:previous-node
+           #:previous-headline
+           #:next-visual-node
+           #:next-visual-headline
+           #:next-node
+           #:next-headline
+           #:goto-end-visual-section
+           #:goto-end-section
+           #:goto-visual-index
+           #:goto-index))
+(in-package :sextant/models/cursor)
+
+(defvar *cursor* (make-cursor))
+(defvar *root* nil)
+
+(defun init-cursor (document)
+  (setq *root* document)
+  (let ((node (next-of document)))
+    (when node
+      (set-visual-cursor node (and (subtypep (type-of node) 'org-headline) node) 0))))
+
+(defun root () *root*)
+
+(defun current-visual-node () (%cursor-node (cursor-visual-cursor *cursor*)))
+(defun (setf current-visual-node) (node)
+  (setf (%cursor-node (cursor-visual-cursor *cursor*)) node
+        (%cursor-node (cursor-cursor *cursor*)) node))
+
+(defun current-visual-headline () (%cursor-headline (cursor-visual-cursor *cursor*)))
+(defun (setf current-visual-headline) (headline)
+  (setf (%cursor-headline (cursor-visual-cursor *cursor*)) headline
+        (%cursor-headline (cursor-cursor *cursor*)) headline))
+
+(defun current-visual-index () (%cursor-index (cursor-visual-cursor *cursor*)))
+(defun (setf current-visual-index) (index)
+  (setf (%cursor-index (cursor-visual-cursor *cursor*)) index
+        (%cursor-index (cursor-cursor *cursor*)) index))
+
+(defun current-visual-only-index () (cursor-visual-only-index *cursor*))
+(defun (setf current-visual-only-index) (index) (setf (cursor-visual-only-index *cursor*) index))
+
+(defun set-visual-cursor (node headline index &optional (visual-only-index index))
+  (setf (current-visual-node) node
+        (current-visual-headline) headline
+        (current-visual-index) index
+        (current-visual-only-index) visual-only-index))
+
+(defun move-visual-cursor (node headline step &optional (visual-step step))
+  (setf (current-visual-node) node
+        (current-visual-headline) headline)
+  (incf (current-visual-index) step)
+  (incf (current-visual-only-index) visual-step)
+  node)
+
+(defun current-node () (%cursor-node (cursor-cursor *cursor*)))
+(defun (setf current-node) (node) (setf (%cursor-node (cursor-cursor *cursor*)) node))
+
+(defun current-headline () (%cursor-headline (cursor-cursor *cursor*)))
+(defun (setf current-headline) (headline) (setf (%cursor-headline (cursor-cursor *cursor*)) headline))
+
+(defun current-index () (%cursor-index (cursor-cursor *cursor*)))
+(defun (setf current-index) (index) (setf (%cursor-index (cursor-cursor *cursor*)) index))
+
+(defun reset-cursor () (move-visual-cursor (current-visual-node) (current-visual-headline) 0))
+
+(defun move-cursor (node headline step)
+  (setf (current-node) node
+        (current-headline) headline)
+  (incf (current-index) step)
+  node)
+
+(defun replace-cursor (node index)
+  (when (= (current-index) index)
+    (if (= (current-index) (current-visual-index))
+        (setf (current-visual-node) node
+              (current-visual-headline) (if (subtypep (type-of node) 'org-headline)
+                                            node
+                                            (current-visual-headline)))
+        (setf (current-node) node
+              (current-headline) (if (subtypep (type-of node) 'org-headline)
+                                     node
+                                     (current-headline))))))
+
+
+
+(defvar *saved-cursor-indices* nil)
+
+(defun save-current-cursor ()
+  (push (%cursor-index (cursor-cursor *cursor*)) *saved-cursor-indices*))
+
+(defun restore-last-cursor ()
+  (goto-index (pop *saved-cursor-indices*)))
+
+(defmacro save-excursion (&body body)
+  `(prog2
+       (save-current-cursor)
+       (progn ,@body)
+     (restore-last-cursor)))
+
+(defun adjust-saved-cursors-before-remove (start count)
+  (loop for index in *saved-cursor-indices*
+        when (>= index start)
+          do (if (> index (+ start count))
+                 (decf index count)
+                 (setf index (1+ start)))))
+
+(defun adjust-saved-cursors-before-insert (start count)
+  (loop for index in *saved-cursor-indices*
+        when (>= index start)
+          do (incf index count)))
+
+
+
+(defgeneric %node-depth (node headline))
+
+(defmethod %node-depth ((node org-line) headline)
+  (if headline (1+ (depth-of headline)) 0))
+
+(defmethod %node-depth ((node org-headline) headline)
+  (assert (eq node headline))
+  (depth-of node))
+
+(defun visual-node-depth () (%node-depth (current-visual-node) (current-visual-headline)))
+
+(defun node-depth () (%node-depth (current-node) (current-headline)))
+
+
+
+(defun %%previous-node (node headline)
+  (when (previous-of node)
+    (move-visual-cursor (previous-of node)
+                        (if (eq node headline)
+                            (previous-headline-of headline)
+                            headline)
+                        -1)))
+
+(defgeneric %previous-visual-node (node headline))
+
+(defmethod %previous-visual-node ((node org-line) headline)
+  (%%previous-node node headline))
+
+(defmethod %previous-visual-node ((node org-headline) headline)
+  (assert (eq node headline))
+  (if (null (previous-headline-of node))
+      (%%previous-node node node)
+      (ecase (property-of (previous-headline-of node) :visibility)
+        (:expanded (%%previous-node node node))
+        (:collapsed
+         (loop with prev = (previous-visual-headline-of node)
+               for n = (previous-of node) then (previous-of n)
+               until (or (null n) (eq n prev))
+               count n into step
+               finally (progn
+                         (assert (not (null n)))
+                         (return (move-visual-cursor n prev (- step) -1))))))))
+
+(defun previous-visual-node ()
+  (%previous-visual-node (current-visual-node) (current-visual-headline)))
+
+(defun previous-visual-headline ()
+  (loop for n = (previous-visual-node) then (previous-visual-node)
+        until (or (null n) (eq n (current-visual-headline)))
+        finally (return n)))
+
+(defun previous-node ()
+  (let* (peek-cursor
+         (prev-index (save-excursion (previous-visual-node)
+                                     (setf peek-cursor *cursor*)
+                                     (current-visual-index))))
+    (if (= prev-index (1- (current-index)))
+        (progn
+          (setf *cursor* peek-cursor)
+          (current-visual-node))
+        (let* ((node (current-node))
+               (headline (current-headline))
+               (prev (previous-of node)))
+          (when prev
+            (move-cursor prev
+                         (if (eq node headline)
+                             (previous-headline-of headline)
+                             headline)
+                         -1))))))
+
+(defun previous-headline ()
+  (loop for n = (previous-node) then (previous-node)
+        until (or (null n) (eq n (current-headline)))
+        finally (return n)))
+
+
+
+(defun %%next-node (node headline)
+  (let ((next (next-of node)))
+    (when next
+      (move-visual-cursor next
+                          (if (subtypep (type-of next) 'org-headline)
+                              next
+                              headline)
+                          1))))
+
+(defgeneric %next-visual-node (node headline))
+
+(defmethod %next-visual-node ((node org-line) headline)
+  (%%next-node node headline))
+
+(defmethod %next-visual-node ((node org-headline) headline)
+  (assert (eq node headline))
+  (ecase (property-of node :visibility)
+    (:expanded (%%next-node node headline))
+    (:collapsed (let ((next (next-visual-headline-of node)))
+                  (when next
+                    (loop for n = (next-of node) then (next-of node)
+                          until (or (null n) (eq n next))
+                          count n into step
+                          finally (progn
+                                    (assert (not (null n)))
+                                    (return (move-visual-cursor n next step 1)))))))))
+
+(defun next-visual-node ()
+  (%next-visual-node (current-visual-node) (current-visual-headline)))
+
+(defun next-visual-headline ()
+  (loop for n = (next-visual-node) then (next-visual-node)
+        until (or (null n) (eq n (current-visual-headline)))
+        finally (return n)))
+
+(defun next-node ()
+  (let* (peek-cursor
+         (next-index (save-excursion
+                      (next-visual-node)
+                      (setf peek-cursor *cursor*)
+                      (current-visual-index))))
+    (if (= next-index (1+ (current-index)))
+        (progn
+          (setf *cursor* peek-cursor)
+          (current-visual-node))
+        (let ((next (next-of (current-node))))
+          (when next
+            (move-cursor next
+                         (if (subtypep (type-of next) 'org-headline)
+                             next
+                             (current-headline))
+                         1)
+            next)))))
+
+(defun next-headline ()
+  (loop for n = (next-node) then (next-node)
+        until (or (null n) (eq n (current-headline)))
+        finally (return n)))
+
+
+
+(defun goto-end-visual-section ()
+  (if (next-visual-headline)
+      (previous-visual-node)
+      (values (current-visual-node) (current-visual-index))))
+
+(defun goto-end-section ()
+  (if (next-headline)
+      (previous-node)
+      (values (current-node) (current-index))))
+
+
+
+(defun goto-visual-index (index)
+  (reset-cursor)
+  (unless (= index (current-visual-only-index))
+    (flet ((walk (stepper)
+             (loop for n = (funcall stepper) then (funcall stepper)
+                   until (or (null n) (= index (current-visual-only-index)))
+                   finally (return n))))
+      (walk (if (< index (current-visual-only-index)) #'previous-visual-node #'next-visual-node))))
+  (values (current-visual-node) (current-visual-index)))
+
+(defun goto-index (index)
+  (assert (>= index 0))
+  (unless (= index (current-index))
+    (reset-cursor)
+    (flet ((walk (stepper pred)
+             (loop for n = (funcall stepper) then (funcall stepper)
+                   until (or (null n) (apply pred (current-visual-index) index))
+                   finally (return n))))
+      (if (< index (current-visual-index))
+          (walk #'previous-node #'<=)
+          (when (walk #'next-node #'>)
+            (previous-node)))
+      (loop with headline = (current-visual-headline)
+            for internal-node = (current-visual-node) then (next-of internal-node)
+            and internal-index = (current-visual-index) then (1+ internal-index)
+            until (or (null internal-node) (= internal-index index))
+            when (eq internal-node (next-headline-of headline))
+              do (setf headline internal-node)
+            finally (move-cursor internal-node headline
+                                 (- internal-index (current-visual-index))))))
+  (current-node))

lisp/local-projects/sextant/models/org-model.lisp

@@ -1,16 +1,20 @@
 (uiop:define-package :sextant/models/org-model
   (:use :cl :eql :org :qml-lisp :s-base64 :alexandria
-        :sextant/models/utils)
+        :sextant/models/utils
-  (:export #:org-document
+        :sextant/models/cursor)
-           #:inc-nodes-count
+  (:export #:inc-visual-nodes-count
-           #:dec-nodes-count
+           #:dec-visual-nodes-count
-           #:replace-data
            #:refresh-data
+           #:hiding-rows
+           #:showing-rows
+           #:remove-rows
            #:removing-rows
+           #:insert-rows
            #:inserting-rows
-           #:step-to-node
+           #:reparse-node
+           #:goto-visual-index
+           #:goto-end-visible-section
            #:goto-index
-           #:goto-end-section
            #:ensure-visible
            #:expand-headline
            #:collapse-headline
@@ -26,270 +30,168 @@
   +last-item-role+)
 
 (defvar *current-pathname* nil)
-(defvar *org-document* nil)
+(defvar *visual-nodes-count* 0)
-(defvar *nodes-count* 0)
 
 (defvar *org-model* nil)
 (defvar *empty-model-index* (qnew "QModelIndex"))
 
 
 
-(defvar *cursor* (list nil nil 0))
-
-(defun current-node () (nth 0 *cursor*))
-(defun current-headline () (nth 1 *cursor*))
-(defun current-index () (nth 2 *cursor*))
-
-(defun move-cursor (node headline step)
-  (setf *cursor* (list node headline (+ (current-index) step))))
-
-(defun set-current-node (node) (setf (nth 0 *cursor*) node))
-(defun set-current-headline (node) (setf (nth 1 *cursor*) node))
-(defun set-current-index (index) (setf (nth 2 *cursor*) index))
-
-(defun inc-current-index (&optional (step 1)) (incf (nth 2 *cursor*) step))
-(defun dec-current-index (&optional (step 1)) (decf (nth 2 *cursor*) step))
-
-(defvar *saved-cursors* nil)
-
-(defmacro save-excursion (&body body)
-  `(prog2
-       (push (copy-seq *cursor*) *saved-cursors*)
-       (progn ,@body)
-     (pop *saved-cursors*)))
-
-
-
-(defun org-document () *org-document*)
-
 (defun model-index (index)
   (|index| *org-model* index))
 
-(defun inc-nodes-count (&optional (count 1))
+(defun inc-visual-nodes-count (&optional (count 1))
-  (incf *nodes-count* count))
+  (incf *visual-nodes-count* count))
 
-(defun dec-nodes-count (&optional (count 1))
+(defun dec-visual-nodes-count (&optional (count 1))
-  (decf *nodes-count* count))
+  (decf *visual-nodes-count* count))
 
 
 
-(defun replace-data (node new-node)
-  (prog1
-      (replace-node node new-node)
-    (when (eq (current-node) node)
-      (set-current-node new-node))
-    (when (subtypep (type-of new-node) 'org-headline)
-      (set-current-headline new-node))
-    (when (eq (current-headline) node)
-      (set-current-headline (if (subtypep (type-of new-node) 'org-headline)
-                                   new-node
-                                   (headline-of new-node))))))
-
 (defun refresh-data (start &optional (end start))
   (let* ((start-index (model-index start))
          (end-index (if (= end start) start-index (model-index end))))
     (|dataChanged| *org-model* start-index end-index)))
 
-(defmacro removing-rows ((start &optional (end start)) &body body)
+(defun reparse-node (index)
-  (once-only (start end)
+  (let* ((node (goto-index index))
-    `(progn
+         (new-node (parse-node node)))
-       (|beginRemoveRows| sextant/models/org-model::*org-model*
+    (assert (node-visible-p node))
-                          sextant/models/org-model::*empty-model-index* ,start ,end)
+    (case (compare-nodes node new-node)
-       ,@body
+      (:depth->
-       (decf sextant/models/org-model::*nodes-count* (1+ (- ,end ,start)))
+       (expand-headline)
-       (|endRemoveRows| sextant/models/org-model::*org-model*))))
+       (when (> index 0)
+         (ensure-visible (1- index)))
+       (swap-nodes node new-node)
+       (refresh-data index (save-excursion (nth-value 1 (goto-end-visual-section)))))
+      (:depth-<
+       (swap-nodes node new-node)
+       (refresh-data index (save-excursion (nth-value 1 (goto-end-visual-section))))))
+    (replace-cursor new-node index)
+    new-node))
 
-(defun remove-rows (start count)
+
+
+(defun remove-rows (start count fun)
   (let ((end (+ start (1- count))))
     (|beginRemoveRows| *org-model* *empty-model-index* start end)
-    (decf *nodes-count* count)
+    (funcall fun)
+    (decf *visual-nodes-count* count)
     (|endRemoveRows| *org-model*)))
 
-(defmacro inserting-rows ((start &optional (end start)) &body body)
+(defmacro removing-rows ((start &optional (count 1)) &body body)
-  (once-only (start end)
+  `(sextant/models/org-model::remove-rows
-    `(progn
+    ,start ,count
-       (|beginInsertRows| sextant/models/org-model::*org-model*
+    (lambda ()
-                          sextant/models/org-model::*empty-model-index* ,start ,end)
+      ,(sextant/models/cursor::adjust-saved-cursors-before-remove start count)
-       ,@body
+      ,@body)))
-       (incf sextant/models/org-model::*nodes-count* (1+ (- ,end ,start)))
-       (|endInsertRows| sextant/models/org-model::*org-model*))))
 
-(defun insert-rows (start count)
+(defmacro hiding-rows ((start &optional (count 1)) &body body)
+  `(sextant/models/org-model::remove-rows ,start ,count (lambda () ,@body)))
+
+(defun insert-rows (start count fun)
   (let ((end (+ start (1- count))))
     (|beginInsertRows| *org-model* *empty-model-index* start end)
-    (incf *nodes-count* count)
+    (funcall fun)
+    (incf *visual-nodes-count* count)
     (|endInsertRows| *org-model*)))
 
-
+(defmacro inserting-rows ((start &optional (count 1)) &body body)
+  `(sextant/models/org-model::insert-rows
+    ,start ,count
+    (lambda ()
+      ,(sextant/models/cursor::adjust-saved-cursors-before-insert start count)
+      ,@body)))
 
-(defgeneric node-depth (node))
+(defmacro showing-rows ((start &optional (count 1)) &body body)
-
+  `(sextant/models/org-model::insert-rows ,start ,count (lambda () ,@body)))
-(defmethod node-depth ((node org-line))
-  (if (current-headline)
-      (1+ (depth-of (current-headline)))
-      0))
-
-(defmethod node-depth ((node org-headline))
-  (depth-of node))
-
-(defun previous-visible-headline (headline)
-  (let ((prev (previous-headline-of headline)))
-    (if (or (null prev) (<= (depth-of prev) (depth-of headline)))
-        prev
-        (loop with depth = (depth-of prev)
-              for h = (previous-headline-of prev) then (previous-headline-of h)
-              until (or (null h)
-                       (and (< (depth-of h) depth)
-                          (eq (property-of h :visibility) :expanded)))
-              when (< (depth-of h) depth)
-                do (setf prev h
-                         depth (depth-of h))
-              finally (return prev)))))
-
-(defun %%previous-node (node headline)
-  (values (previous-of node)
-          (if (eq node headline)
-              (previous-headline-of headline)
-              headline)))
-
-(defgeneric %previous-node (node headline))
-
-(defmethod %previous-node ((node org-line) headline)
-  (%%previous-node node headline))
-
-(defmethod %previous-node ((node org-headline) headline)
-  (assert (eq node headline))
-  (if (null (previous-headline-of node))
-      (%%previous-node node node)
-      (ecase (property-of (previous-headline-of node) :visibility)
-        (:expanded (%%previous-node node node))
-        (:collapsed (let ((prev (previous-visible-headline node)))
-                      (values prev prev))))))
-
-(defun previous-node ()
-  (multiple-value-bind (node headline) (%previous-node (current-node) (current-headline))
-    (when node
-      (move-cursor node headline -1))))
-
-(defun %%next-node (node headline)
-  (let ((next (next-of node)))
-    (values next
-            (if (subtypep (type-of next) 'org-headline)
-                next
-                headline))))
-
-(defgeneric %next-node (node headline))
-
-(defmethod %next-node ((node org-line) headline)
-  (%%next-node node headline))
-
-(defmethod %next-node ((node org-headline) headline)
-  (assert (eq node headline))
-  (ecase (property-of node :visibility)
-    (:expanded (%%next-node node headline))
-    (:collapsed (let ((depth (depth-of node)))
-                  (loop for n = (next-headline-of node) then (next-headline-of n)
-                        until (or (null n) (<= (depth-of n) depth))
-                        finally (return (values n n)))))))
-
-(defun next-node ()
-  (multiple-value-bind (node headline) (%next-node (current-node) (current-headline))
-    (when node
-      (move-cursor node headline 1))))
-
-(defun goto-index (index)
-  (assert (>= index 0))
-  (assert (< index *nodes-count*))
-  (unless (= index (current-index))
-    (let* ((step (- index (current-index))))
-      (if (< step 0)
-          (loop do (progn
-                     (previous-node)
-                     (incf step))
-                until (= step 0))
-          (loop do (progn
-                     (next-node)
-                     (decf step))
-                until (= step 0)))))
-  (values-list *cursor*))
-
-(defun goto-end-section ()
-  (let ((depth (and (current-headline) (depth-of (current-headline)))))
-    (loop for (n h i) = (next-node) then (next-node)
-          until (or (null n) (<= (node-depth n) depth)))
-    (if (<= (node-depth (current-node)) depth)
-        (previous-node)
-        *cursor*)))
 
 
 
-(defun ensure-visible (node)
+(defun ensure-visible (index)
-  (unless (node-visible-p node)
+  (let ((node (goto-index index)))
-    (let* ((parent-node (current-node)))
+    (unless (node-visible-p node)
-      (assert (eq parent-node (current-headline)))
+      (expand-headline (node-path node (current-headline))))))
-      (expand-headline (node-path node parent-node)))))
 
 (defun expand-headline (&optional recurse)
-  (let* ((node (current-node))
+  (assert (eq (current-visual-node) (current-node)))
-         (depth (node-depth node)))
+  (let* ((node (current-visual-node))
-    (if (null recurse)
+         (depth (node-depth)))
-        (when (eq (property-of node :visibility) :collapsed)
+    (assert (eq node (current-visual-headline)))
-          (save-excursion
+    (save-excursion
-           (loop with index = (1+ (current-index))
+     (if (null recurse)
-                 for (n h i) = (next-node) then (next-node)
+         (when (eq (property-of node :visibility) :collapsed)
-                 until (or (null n) (<= (node-depth n) depth))
+           (let ((count (save-excursion
-                 count n into count
+                         (loop with index = (1+ (current-index))
-                 finally (insert-rows index count))))
+                               and sub-headline-depth = nil
-        (let ((depth/visibility (list (cons depth (property-of node :visibility)))))
+                               for n = (next-node) then (next-node)
-          (setf (property-of node :visibility) :expanded)
+                               until (or (null n) (<= (node-depth) depth))
-          (flet ((parent-depth () (assert (not (null depth/visibility))) (car (first depth/visibility)))
+                               when (eq (current-node) (current-headline))
-                 (parent-collapsed () (assert (not (null depth/visibility))) (eq (cdr (first depth/visibility)) :collapsed)))
+                                 do (setf sub-headline-depth (node-depth))
-            (save-excursion
+                               count (or (null sub-headline-depth) (= (node-depth) sub-headline-depth))))))
-             (loop with index = -1
+             (showing-rows ((1+ (current-index)) count)
-                   for (n h i) = (next-node) then (next-node)
+                           (setf (property-of node :visibility) :expanded))))
-                   until (or (null n) (<= (node-depth n) depth))
+         (let ((depth/visibility (list (cons depth (property-of node :visibility)))))
-                   when (and (parent-collapsed) (= index -1))
+           (flet ((parent-depth () (assert (not (null depth/visibility))) (car (first depth/visibility)))
+                  (parent-collapsed-p () (assert (not (null depth/visibility))) (eq (cdr (first depth/visibility)) :collapsed))
+                  (push-depth/visibility (depth visibility)
+                    (assert (> depth (parent-depth)))
+                    (push (cons depth visibility) depth/visibility))
+                  (expand-those-headlines (index count headlines)
+                    (assert (> count 0))
+                    (save-excursion
+                     (showing-rows (index count)
+                                   (loop for h in headlines
+                                         do (progn
+                                              (assert (subtypep (type-of h) 'org-headline))
+                                              (setf (property-of h :visibility) :expanded)))))))
+             (loop with headlines-to-expand = (if (parent-collapsed-p) node nil)
+                   and index = (if (parent-collapsed-p) (1+ (current-index)) -1)
+                   for n = (next-node) then (next-node)
+                   until (or (null n) (<= (node-depth) depth))
+                   when (and (parent-collapsed-p) (= index -1))
                      do (setf index (current-index))
-                   when (eq n h)
+                   when (eq n (current-headline))
                      do (progn
-                          (loop
+                          (loop while (<= (node-depth) (parent-depth))
-                            while (<= (node-depth n) (parent-depth))
+                                do (pop depth/visibility))
-                           do (pop depth/visibility))
+                          (when (and (/= index -1) (not (parent-collapsed-p)))
-                          (when (and (/= index -1) (not (parent-collapsed)))
+                            (expand-those-headlines index count headlines-to-expand)
-                            (insert-rows index count)
+                            (setf index -1
-                            (setf index -1 count 0))
+                                  count 0
-                          (assert (> (node-depth n) (parent-depth)))
+                                  headlines-to-expand nil)
-                          (push (cons (node-depth n) (property-of n :visibility)) depth/visibility)
+                            (push-depth/visibility (node-depth) (property-of n :visibility))
-                          (cond
+                            (cond
-                            ((eq recurse t)
+                              ((eq recurse t)
-                             (setf (property-of n :visibility) :expanded))
+                               (push n headlines-to-expand))
-                            ((and (listp recurse) (eq n (first recurse)))
+                              ((and (listp recurse) (eq n (first recurse)))
-                             (pop recurse)
+                               (pop recurse)
-                             (setf (property-of n :visibility) :expanded))))
+                               (push n headlines-to-expand)))))
                    count (/= index -1) into count
                    finally (when (/= index -1)
-                             (assert (> count 0))
+                             (expand-those-headlines index count headlines-to-expand)))))))))
-                             (insert-rows index count)))))))))
 
 (defun collapse-headline ()
-  (let* ((node (current-node))
+  (assert (eq (current-visual-node) (current-node)))
-         (depth (node-depth node)))
+  (let* ((node (current-visual-node))
-    (assert (subtypep (type-of node) 'org-headline))
+         (depth (node-depth)))
-    (destructuring-bind (count . headlines)
+    (assert (eq node (current-visual-headline)))
-        (save-excursion
+    (save-excursion
-          (loop for (n h i) = (next-node) then (next-node)
+     (destructuring-bind (count . headlines)
-                until (or (null n) (<= (node-depth n) depth))
+         (save-excursion
+          (loop for n = (next-visual-node) then (next-visual-node)
+                until (or (null n) (<= (visual-node-depth) depth))
                 count n into count
-                when (eq n h)
+                when (eq n (current-visual-headline))
                   collect n into headlines
                 finally (return (cons count headlines))))
-      (when (> count 0)
+       (when (> count 0)
-        (removing-rows ((1+ (current-index)) (+ (current-index) count))
+         (hiding-rows ((1+ (current-visual-index)) count)
-          (loop for n in headlines
+                      (loop for n in headlines
-                do (progn
+                            do (progn
-                    (assert (subtypep (type-of n) 'org-headline))
+                                 (assert (subtypep (type-of n) 'org-headline))
-                    (setf (property-of n :visibility) :collapsed)))
+                                 (setf (property-of n :visibility) :collapsed)))
-          (setf (property-of node :visibility) :collapsed))))))
+                      (setf (property-of node :visibility) :collapsed)))))))
 
 
 
@@ -298,12 +200,12 @@
     (qoverride model "rowCount(QModelIndex)"
                (lambda (index)
                  (declare (ignore index))
-                 *nodes-count*))
+                 *visual-nodes-count*))
     (qoverride model "data(QModelIndex,int)"
                (lambda (index role)
                  (let ((row (|row| index)))
-                   (when (and (> row -1) (< row *nodes-count*))
+                   (when (and (> row -1) (< row *visual-nodes-count*))
-                     (let ((item (goto-index row)))
+                     (let ((item (goto-visual-index row)))
                        (case role
                          (#.+nodetype-role+
                           (qvariant-from-value (string-downcase (symbol-name (type-of item)))
@@ -311,11 +213,11 @@
                          (#.+rawtext-role+
                           (qvariant-from-value (raw-text-of item) "QString"))
                          (#.+depth-role+
-                          (qvariant-from-value (node-depth item) "int"))
+                          (qvariant-from-value (node-depth) "int"))
                          (#.+title-role+
                           (qvariant-from-value (title-of item) "QString"))
                          (#.+last-item-role+
-                          (qvariant-from-value (= row (1- *nodes-count*)) "bool"))))))))
+                          (qvariant-from-value (= row (1- *visual-nodes-count*)) "bool"))))))))
     (qoverride model "roleNames()"
                (lambda ()
                  (list (cons +nodetype-role+ "nodeType")
@@ -326,6 +228,7 @@
     (when *org-model*
       (qdelete *org-model*))
     (setf *org-model* model)
+    #+harbour-sextant
     (|setContextProperty| (|rootContext| qml:*quick-view*) "orgModel" *org-model*)))
 
 (defun make-org-model (pathname org-document &optional force)
@@ -333,10 +236,8 @@
     (construct-org-model))
   (setf *current-pathname* pathname)
   (|beginResetModel| *org-model*)
-  (setf *org-document* org-document
+  (init-cursor org-document)
-        *nodes-count* (loop for node = (next-of org-document) then (next-of node)
+  (setf *visual-nodes-count* (save-excursion
-                            while node count node))
+                              (loop for node = (current-visual-node) then (next-visual-node)
-  (let* ((node (next-of org-document))
+                                    while node count node)))
-         (headline (and (subtypep (type-of node) 'org-headline) node)))
-   (setf *cursor* (list node headline 0)))
   (|endResetModel| *org-model*))

lisp/local-projects/sextant/org/all.lisp

@@ -3,5 +3,6 @@
   (:use-reexport
    :sextant/org/nodes
    :sextant/org/cursor
+   :sextant/org/commands
    :sextant/org/parser
    :sextant/org/printer))

lisp/local-projects/sextant/org/commands.lisp

@@ -0,0 +1,111 @@
+(uiop:define-package :sextant/org/commands
+  (:use :cl :s-base64 :alexandria
+        :sextant/org/cursor)
+  (:import-from :inferior-shell #:run))
+(in-package :sextant/org/commands)
+
+(defclass command ()
+  ((index :initarg :index
+          :type integer
+          :accessor index-of
+          :initform 0
+          :documentation "The index of the related node.")
+   (previous :initarg :previous
+             :type command
+             :accessor previous-of
+             :initform nil
+             :documentation "A link to the previous command in the list.")
+   (next :initarg :next
+             :type command
+             :accessor next-of
+             :initform nil
+             :documentation "A link to the next command in the list.")))
+
+(defclass command-initial-state (command)
+  ())
+
+(defclass command-edit-text (command)
+  ((before-text :initarg :before-text
+                :type string
+                :accessor before-text-of
+                :initform ""
+                :documentation "The text node had before this command.")
+   (after-text :initarg :after-text
+               :type string
+               :accessor after-text-of
+               :initform ""
+               :documentation "The text this command needs to apply.")))
+
+(defclass command-join/split-node (command)
+  ((previous-text :initarg :previous-text
+                :type string
+                :accessor previous-text-of
+                :initform ""
+                :documentation "The text of the previous node.")
+   (previous-eol :initarg :previous-eol
+               :type string
+               :accessor previous-eol-of
+               :initform ""
+               :documentation "The line ending of the previous node.")
+   (next-text :initarg :next-text
+               :type string
+               :accessor next-text-of
+               :initform ""
+               :documentation "The text of the next node.")
+   (next-eol :initarg :next-eol
+              :type string
+              :accessor next-eol-of
+              :initform ""
+              :documentation "The line ending of the next node.")))
+
+(defclass command-join-node (command-join/split-node)
+  ())
+
+(defclass command-split-node (command-join/split-node)
+  ())
+
+
+
+(defun make-command-edit-text (command index before-text after-text)
+  (make-instance 'command-edit-text :previous command
+                                      :index index
+                                      :before-text before-text
+                                      :after-text after-text))
+
+(defun make-command-join-node (command index previous-text previous-eol next-text next-eol)
+  (make-instance 'command-join-node :previous command
+                                    :index index
+                                    :previous-text previous-text
+                                    :previous-eol previous-eol
+                                    :next-text next-text
+                                    :next-eol next-eol))
+
+(defun make-command-split-node (command index previous-text previous-eol next-text next-eol)
+  (make-instance 'command-split-node :previous command
+                                     :index index
+                                     :previous-text previous-text
+                                     :previous-eol previous-eol
+                                     :next-text next-text
+                                     :next-eol next-eol))
+
+
+
+(defun do-edit-text (cursor target-index new-text)
+  )
+
+
+
+(defgeneric apply-command (cursor command))
+
+(defmethod apply-command (cursor (command command-edit-text))
+  (do-edit-text ()))
+
+
+
+(defun edit-text (cursor text)
+  (let ((command (make-command-edit-text (document-commands cursor)
+                                              (cursor-index cursor)
+                                              (raw-text-of (cursor-node cursor))
+                                              text)))
+    (setf (document-commands cursor) command)
+    (apply-command cursor command)))

lisp/local-projects/sextant/org/cursor.lisp

@@ -3,9 +3,10 @@
   (:export #:make-cursor
            #:cursor-node
            #:cursor-index
+           #:visual-index
            #:visible-node
            #:visible-index
-           #:visual-index
+           #:document-commands
            #:move-cursor
            #:previous-visible-node
            #:previous-visible-headline
@@ -14,11 +15,13 @@
            #:next-visible-node
            #:next-visible-headline
            #:next-node
-           #:next-headline))
+           #:next-headline
+           #:goto-index))
 (in-package :sextant/org/cursor)
 
-(defstruct (cursor (:constructor make-cursor (node index visual-index)))
+(defstruct (cursor (:constructor make-cursor (document node index visual-index)))
-  (node nil)
+  (document nil :type org-document)
+  (node nil :type org-node)
   (index 0 :type number)
   (visual-index 0 :type number))
 
@@ -36,6 +39,9 @@
         (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))
@@ -55,10 +61,10 @@
   (- (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 target (node-index target cursor) (node-visual-index target cursor)))
+  (make-cursor (cursor-document cursor) target (node-index target cursor) (node-visual-index target cursor)))
 
 (defun move-cursor-> (cursor target)
-  (make-cursor target (node-index cursor target) (node-visual-index 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)
@@ -109,3 +115,16 @@
 (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))))))

lisp/local-projects/sextant/sextant.asd

@@ -3,7 +3,7 @@
   :defsystem-depends-on (:asdf-package-system)
   :class :package-inferred-system
   :around-compile (lambda (thunk)
-                    (proclaim '(optimize (debug 0) (safety 1) (speed 3)))
+                    (proclaim '(optimize (debug 3) (safety 3) (speed 0)))
                     (funcall thunk))
   :depends-on #.(append (uiop:read-file-form (merge-pathnames #p"dependencies.sexp" (or *load-pathname* *compile-file-pathname*)))
                         '("sextant/org/all")

qml/components/OrgDelegate.qml

@@ -43,13 +43,13 @@ Item {
         cache: true
     }
 
-
     onFocusedChanged: {
         if (focused)
             document.focusedItem = orgItem
     }
 
     function forceCommit (update) { loader.item.forceCommit(update) }
+    function setCursorPosition(index) { loader.item.setCursorPosition(index) }
     function setCursorPositionAtEnd (fix) { loader.item.setCursorPositionAtEnd(fix) }
     function editRawText () { loader.item.editRawText() }
 }

qml/components/OrgEdit.qml

@@ -40,18 +40,18 @@ TextArea {
                 if (index > 0 && text[0] != sentinelChar) {
                     var textEmpty = text.length == 0
                     forceCommit(false)
-                    document.focusedIndex = index - 1
+                    /* document.focusedIndex = index - 1 */
-                    var focusedItem = document.focusedItem
+                    /* var focusedItem = document.focusedItem */
-                    focusedItem.setCursorPositionAtEnd(!textEmpty)
+                    /* focusedItem.setCursorPositionAtEnd(!textEmpty) */
-                    Lisp.call("models:join-node", index - 1, true)
+                    Lisp.call("models:join-node", index, true)
-                    focusedItem.editRawText()
+                    /* focusedItem.editRawText() */
                 } else {
                     var split = text.indexOf("\n")
                     if (split != -1) {
                         forceCommit(false)
                         Lisp.call("models:split-node", index, text.substring(index > 0 ? 1 : 0, split), text.substring(split + 1), true)
-                        document.focusedIndex = index + 1
+                        /* document.focusedIndex = index + 1 */
-                        document.focusedItem.editRawText()
+                        /* document.focusedItem.editRawText() */
                     } else {
                         lastText = getText()
                         textModified = lastText != rawtext
@@ -105,6 +105,10 @@ TextArea {
         }
     }
 
+    function setCursorPosition(index) {
+        cursorPosition = index
+    }
+
     function setCursorPositionAt(x, y) {
         cursorPosition = positionAt(x, y)
     }

qml/components/OrgText.qml

@@ -27,6 +27,7 @@ MouseArea {
     function editRawText() { editing = true }
 
     function forceCommit (update) { edit.forceCommit(update) }
+    function setCursorPosition(index) { edit.setCursorPosition(index) }
     function setCursorPositionAt (x, y) { edit.setCursorPositionAt(x, y) }
     function setCursorPositionAtEnd (fix) { edit.setCursorPositionAtEnd(fix) }
 }

qml/pages/Org.qml

@@ -39,6 +39,14 @@ Page {
             focusedItem = null
     }
 
+    function focusIndex(index, edit, cursorPos) {
+        focusedIndex = index
+        if (edit) {
+            focusedItem.setCursorPosition(cursorPos)
+            focusedItem.editRawText()
+        }
+    }
+
     function refreshToolbar(undoEnabled, redoEnabled, saveEnabled) {
         undo.enabled = undoEnabled
         redo.enabled = redoEnabled

sextant.pro

@@ -16,20 +16,21 @@ LISP_FILES = make.lisp \
     lisp/local-projects/sextant/options/config.lisp \
     lisp/local-projects/sextant/options/options.lisp \
     lisp/local-projects/sextant/options/all.lisp \
-    lisp/local-projects/sextant/dependencies.sexp \
-    lisp/local-projects/sextant/models/utils.lisp \
-    lisp/local-projects/sextant/models/org-model.lisp \
-    lisp/local-projects/sextant/models/files-model.lisp \
-    lisp/local-projects/sextant/models/commands.lisp \
     lisp/local-projects/sextant/org/nodes.lisp \
     lisp/local-projects/sextant/org/cursor.lisp \
     lisp/local-projects/sextant/org/parser.lisp \
     lisp/local-projects/sextant/org/printer.lisp \
     lisp/local-projects/sextant/org/all.lisp \
     lisp/local-projects/sextant/models/actions.lisp \
+    lisp/local-projects/sextant/models/commands.lisp \
+    lisp/local-projects/sextant/models/cursor.lisp \
+    lisp/local-projects/sextant/models/files-model.lisp \
+    lisp/local-projects/sextant/models/org-model.lisp \
+    lisp/local-projects/sextant/models/utils.lisp \
     lisp/local-projects/sextant/models/all.lisp \
     lisp/local-projects/sextant/sextant.lisp \
-    lisp/local-projects/sextant/sextant.asd \
+    lisp/local-projects/sextant/dependencies.sexp \
+    lisp/local-projects/sextant/sextant.asd
 
 lisp.output = libsextant.a
 lisp.commands = $$PWD/sextant-bootstrap -platform minimal -make

tests.lisp

@@ -307,4 +307,15 @@ line 4
         (check-visible-cursor cursor line-3 6 1)
         (check-cursor cursor line-3 6 1))))
 
+(test goto-index
+      (with-test-org-1
+        (let ((cursor (make-cursor test-org preamble-1 0 0)))
+          (setf cursor (goto-index cursor 4))
+          (check-cursor cursor line-2 4 4)
+          (setf cursor (goto-index cursor 9))
+          (check-cursor cursor line-5 9 9)
+          (setf cursor (goto-index cursor 0))
+          (check-cursor cursor preamble-1 0 0)
+          (is (null (goto-index cursor 10))))))
+
 (run! 'all-tests)