diff --git a/lisp/local-projects/sextant/models/actions.lisp b/lisp/local-projects/sextant/models/actions.lisp index 5a72a99..4f3efbc 100644 --- a/lisp/local-projects/sextant/models/actions.lisp +++ b/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) diff --git a/lisp/local-projects/sextant/models/all.lisp b/lisp/local-projects/sextant/models/all.lisp index fe7b66f..68b1c48 100644 --- a/lisp/local-projects/sextant/models/all.lisp +++ b/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)) diff --git a/lisp/local-projects/sextant/models/commands.lisp b/lisp/local-projects/sextant/models/commands.lisp index 1611960..0a7eab6 100644 --- a/lisp/local-projects/sextant/models/commands.lisp +++ b/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)) - (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) +(defun do-modify-text (index new-text update-ui-p) (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) - (do-modify-text (index-of command) (after-text-of command) update-ui)) +(defmethod apply-command ((command command-modify-text) update-ui-p) + (do-modify-text (index-of command) (after-text-of command) update-ui-p)) -(defmethod apply-command ((command command-join-node) update-ui) - (do-join-node command update-ui)) +(defmethod apply-command ((command command-join-node) update-ui-p) + (do-join-node command update-ui-p)) -(defmethod apply-command ((command command-split-node) update-ui) - (do-split-node command update-ui)) +(defmethod apply-command ((command command-split-node) update-ui-p) + (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) - (do-modify-text (index-of command) (before-text-of command) update-ui)) +(defmethod unapply-command ((command command-modify-text) update-ui-p) + (do-modify-text (index-of command) (before-text-of command) update-ui-p)) -(defmethod unapply-command ((command command-join-node) update-ui) - (do-split-node command update-ui)) +(defmethod unapply-command ((command command-join-node) update-ui-p) + (do-split-node command update-ui-p)) -(defmethod unapply-command ((command command-split-node) update-ui) - (do-join-node command update-ui)) +(defmethod unapply-command ((command command-split-node) update-ui-p) + (do-join-node command update-ui-p)) @@ -200,81 +193,80 @@ -(defun push-command-modify-text (command index before-text after-text update-ui) - (let ((next-command (make-instance 'command-modify-text :previous command - :index index - :before-text before-text - :after-text after-text))) - (apply-command next-command update-ui) - (setf (next-of command) next-command))) +(defun make-command-modify-text (command index before-text after-text) + (make-instance 'command-modify-text :previous command + :index index + :before-text before-text + :after-text after-text)) -(defun push-command-join-node (command index previous-text previous-eol next-text next-eol update-ui) - (let ((next-command (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))) - (apply-command next-command update-ui) - (setf (next-of command) next-command))) +(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 push-command-split-node (command index previous-text previous-eol next-text next-eol update-ui) - (let ((next-command (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))) - (apply-command next-command update-ui) - (setf (next-of command) next-command))) +(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 modify-text (index text &optional update-ui) - (let ((node (goto-index index))) - (setf *current-state* (push-command-modify-text *current-state* index - (raw-text-of node) text update-ui)) - (when update-ui - (refresh-toolbar)))) - -(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 +(defun modify-text (visual-index text &optional update-ui-p) + (multiple-value-bind (node index) (goto-visual-index visual-index) + (let ((next-command (make-command-modify-text *current-state* index + (raw-text-of node) text))) + (apply-command next-command update-ui-p) + (setf (next-of *current-state*) next-command))) + (when update-ui-p (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 () - (let ((previous-state (previous-of *current-state*))) - (unless (null previous-state) - (prog1 - (index-of *current-state*) - (unapply-command *current-state* t) - (setf *current-state* previous-state) - (refresh-toolbar))))) + (defun undo () + (let ((previous-state (previous-of *current-state*))) + (unless (null previous-state) + (prog1 + (index-of *current-state*) + (unapply-command *current-state* t) + (setf *current-state* previous-state) + (refresh-toolbar))))) -(defun can-undo-p () - (not (null (and *current-state* (previous-of *current-state*))))) + (defun can-undo-p () + (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 - :package :sextant/models/commands)) - (sha (hash-base64 (load-binary-file pathname)))) + (let* ((commands (uiop:safe-read-file-form commands-pathname + :package :sextant/models/commands)) + (sha (hash-base64 (load-binary-file pathname)))) (cond ((= (getf commands :version) 1) - (when (string= sha (getf commands :sha1)) - (let ((command-count (loop with state = *initial-state* - for c in (getf commands :commands) - count c - while c - do (let ((command (apply #'make-instance c))) - (setf (next-of state) command - (previous-of command) state) - (setf state command))))) - (let ((saved-index (getf commands :saved-state))) - (if (or (< saved-index 0) (> saved-index command-count)) - (setf (next-of *initial-state*) nil) - (progn - (dotimes (i saved-index) - (setf *saved-state* (next-of *saved-state*))) - (setf *current-state* *saved-state*) - (let ((current-index (getf commands :current-state))) - (when (and (>= current-index 0) (<= current-index command-count)) - (let ((c *current-state*)) - (cond - ((> current-index saved-index) - (dotimes (i (- current-index saved-index)) - (setf *current-state* (next-of *current-state*)) - (apply-command *current-state* nil))) - ((< current-index saved-index) - (dotimes (i (- saved-index current-index)) - (unapply-command *current-state* nil) - (setf *current-state* (previous-of *current-state*))))))))))))))))))) + (let ((saved-index (getf commands :saved-state)) + (current-index (getf commands :current-state))) + (when (string= sha (getf commands :sha1)) + (let ((command-count (loop with state = *initial-state* + for c in (getf commands :commands) + count c + while c + do (let ((command (apply #'make-instance c))) + (setf (next-of state) command + (previous-of command) state) + (setf state command))))) + (when (and (>= saved-index 0) (< saved-index command-count)) + (dotimes (i saved-index) + (setf *saved-state* (next-of *saved-state*))) + (setf *current-state* *saved-state*) + (when (and (>= current-index 0) (<= current-index command-count)) + (let ((c *current-state*)) + (cond + ((> current-index saved-index) + (dotimes (i (- current-index saved-index)) + (setf *current-state* (next-of *current-state*)) + (apply-command *current-state* nil))) + ((< current-index saved-index) + (dotimes (i (- saved-index current-index)) + (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) - (setf *saved-hash* (hash-base64 (load-binary-file pathname))) +(defun initialize-commands (&optional 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)) diff --git a/lisp/local-projects/sextant/models/cursor.lisp b/lisp/local-projects/sextant/models/cursor.lisp new file mode 100644 index 0000000..aad568f --- /dev/null +++ b/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)) diff --git a/lisp/local-projects/sextant/models/org-model.lisp b/lisp/local-projects/sextant/models/org-model.lisp index 2b11cd6..3e8d609 100644 --- a/lisp/local-projects/sextant/models/org-model.lisp +++ b/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) - (:export #:org-document - #:inc-nodes-count - #:dec-nodes-count - #:replace-data + :sextant/models/utils + :sextant/models/cursor) + (:export #:inc-visual-nodes-count + #:dec-visual-nodes-count #: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 *nodes-count* 0) +(defvar *visual-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)) - (incf *nodes-count* count)) +(defun inc-visual-nodes-count (&optional (count 1)) + (incf *visual-nodes-count* count)) -(defun dec-nodes-count (&optional (count 1)) - (decf *nodes-count* count)) +(defun dec-visual-nodes-count (&optional (count 1)) + (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) - (once-only (start end) - `(progn - (|beginRemoveRows| sextant/models/org-model::*org-model* - sextant/models/org-model::*empty-model-index* ,start ,end) - ,@body - (decf sextant/models/org-model::*nodes-count* (1+ (- ,end ,start))) - (|endRemoveRows| sextant/models/org-model::*org-model*)))) +(defun reparse-node (index) + (let* ((node (goto-index index)) + (new-node (parse-node node))) + (assert (node-visible-p node)) + (case (compare-nodes node new-node) + (:depth-> + (expand-headline) + (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) - (once-only (start end) - `(progn - (|beginInsertRows| sextant/models/org-model::*org-model* - sextant/models/org-model::*empty-model-index* ,start ,end) - ,@body - (incf sextant/models/org-model::*nodes-count* (1+ (- ,end ,start))) - (|endInsertRows| sextant/models/org-model::*org-model*)))) +(defmacro removing-rows ((start &optional (count 1)) &body body) + `(sextant/models/org-model::remove-rows + ,start ,count + (lambda () + ,(sextant/models/cursor::adjust-saved-cursors-before-remove start count) + ,@body))) -(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)) - -(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*))) +(defmacro showing-rows ((start &optional (count 1)) &body body) + `(sextant/models/org-model::insert-rows ,start ,count (lambda () ,@body))) -(defun ensure-visible (node) - (unless (node-visible-p node) - (let* ((parent-node (current-node))) - (assert (eq parent-node (current-headline))) - (expand-headline (node-path node parent-node))))) +(defun ensure-visible (index) + (let ((node (goto-index index))) + (unless (node-visible-p node) + (expand-headline (node-path node (current-headline)))))) (defun expand-headline (&optional recurse) - (let* ((node (current-node)) - (depth (node-depth node))) - (if (null recurse) - (when (eq (property-of node :visibility) :collapsed) - (save-excursion - (loop with index = (1+ (current-index)) - for (n h i) = (next-node) then (next-node) - until (or (null n) (<= (node-depth n) depth)) - count n into count - finally (insert-rows index count)))) - (let ((depth/visibility (list (cons depth (property-of node :visibility))))) - (setf (property-of node :visibility) :expanded) - (flet ((parent-depth () (assert (not (null depth/visibility))) (car (first depth/visibility))) - (parent-collapsed () (assert (not (null depth/visibility))) (eq (cdr (first depth/visibility)) :collapsed))) - (save-excursion - (loop with index = -1 - for (n h i) = (next-node) then (next-node) - until (or (null n) (<= (node-depth n) depth)) - when (and (parent-collapsed) (= index -1)) + (assert (eq (current-visual-node) (current-node))) + (let* ((node (current-visual-node)) + (depth (node-depth))) + (assert (eq node (current-visual-headline))) + (save-excursion + (if (null recurse) + (when (eq (property-of node :visibility) :collapsed) + (let ((count (save-excursion + (loop with index = (1+ (current-index)) + and sub-headline-depth = nil + for n = (next-node) then (next-node) + until (or (null n) (<= (node-depth) depth)) + when (eq (current-node) (current-headline)) + do (setf sub-headline-depth (node-depth)) + count (or (null sub-headline-depth) (= (node-depth) sub-headline-depth)))))) + (showing-rows ((1+ (current-index)) count) + (setf (property-of node :visibility) :expanded)))) + (let ((depth/visibility (list (cons depth (property-of node :visibility))))) + (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 - while (<= (node-depth n) (parent-depth)) - do (pop depth/visibility)) - (when (and (/= index -1) (not (parent-collapsed))) - (insert-rows index count) - (setf index -1 count 0)) - (assert (> (node-depth n) (parent-depth))) - (push (cons (node-depth n) (property-of n :visibility)) depth/visibility) - (cond - ((eq recurse t) - (setf (property-of n :visibility) :expanded)) - ((and (listp recurse) (eq n (first recurse))) - (pop recurse) - (setf (property-of n :visibility) :expanded)))) + (loop while (<= (node-depth) (parent-depth)) + do (pop depth/visibility)) + (when (and (/= index -1) (not (parent-collapsed-p))) + (expand-those-headlines index count headlines-to-expand) + (setf index -1 + count 0 + headlines-to-expand nil) + (push-depth/visibility (node-depth) (property-of n :visibility)) + (cond + ((eq recurse t) + (push n headlines-to-expand)) + ((and (listp recurse) (eq n (first recurse))) + (pop recurse) + (push n headlines-to-expand))))) count (/= index -1) into count finally (when (/= index -1) - (assert (> count 0)) - (insert-rows index count))))))))) + (expand-those-headlines index count headlines-to-expand))))))))) (defun collapse-headline () - (let* ((node (current-node)) - (depth (node-depth node))) - (assert (subtypep (type-of node) 'org-headline)) - (destructuring-bind (count . headlines) - (save-excursion - (loop for (n h i) = (next-node) then (next-node) - until (or (null n) (<= (node-depth n) depth)) + (assert (eq (current-visual-node) (current-node))) + (let* ((node (current-visual-node)) + (depth (node-depth))) + (assert (eq node (current-visual-headline))) + (save-excursion + (destructuring-bind (count . headlines) + (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) - (removing-rows ((1+ (current-index)) (+ (current-index) count)) - (loop for n in headlines - do (progn - (assert (subtypep (type-of n) 'org-headline)) - (setf (property-of n :visibility) :collapsed))) - (setf (property-of node :visibility) :collapsed)))))) + (when (> count 0) + (hiding-rows ((1+ (current-visual-index)) count) + (loop for n in headlines + do (progn + (assert (subtypep (type-of n) 'org-headline)) + (setf (property-of n :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*)) - (let ((item (goto-index row))) + (when (and (> row -1) (< row *visual-nodes-count*)) + (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 - *nodes-count* (loop for node = (next-of org-document) then (next-of node) - while node count node)) - (let* ((node (next-of org-document)) - (headline (and (subtypep (type-of node) 'org-headline) node))) - (setf *cursor* (list node headline 0))) + (init-cursor org-document) + (setf *visual-nodes-count* (save-excursion + (loop for node = (current-visual-node) then (next-visual-node) + while node count node))) (|endResetModel| *org-model*)) diff --git a/lisp/local-projects/sextant/org/all.lisp b/lisp/local-projects/sextant/org/all.lisp index dfef7ca..3a0daf5 100644 --- a/lisp/local-projects/sextant/org/all.lisp +++ b/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)) diff --git a/lisp/local-projects/sextant/org/commands.lisp b/lisp/local-projects/sextant/org/commands.lisp new file mode 100644 index 0000000..c7430ab --- /dev/null +++ b/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))) diff --git a/lisp/local-projects/sextant/org/cursor.lisp b/lisp/local-projects/sextant/org/cursor.lisp index d356216..9244dcf 100644 --- a/lisp/local-projects/sextant/org/cursor.lisp +++ b/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))) - (node nil) +(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)) @@ -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)))))) diff --git a/lisp/local-projects/sextant/sextant.asd b/lisp/local-projects/sextant/sextant.asd index 6400c24..3e15cae 100644 --- a/lisp/local-projects/sextant/sextant.asd +++ b/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") diff --git a/qml/components/OrgDelegate.qml b/qml/components/OrgDelegate.qml index 64e02ba..e0ee843 100644 --- a/qml/components/OrgDelegate.qml +++ b/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() } } diff --git a/qml/components/OrgEdit.qml b/qml/components/OrgEdit.qml index d404752..785a0ee 100644 --- a/qml/components/OrgEdit.qml +++ b/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 - var focusedItem = document.focusedItem - focusedItem.setCursorPositionAtEnd(!textEmpty) - Lisp.call("models:join-node", index - 1, true) - focusedItem.editRawText() + /* document.focusedIndex = index - 1 */ + /* var focusedItem = document.focusedItem */ + /* focusedItem.setCursorPositionAtEnd(!textEmpty) */ + Lisp.call("models:join-node", index, true) + /* 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.focusedItem.editRawText() + /* document.focusedIndex = index + 1 */ + /* 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) } diff --git a/qml/components/OrgText.qml b/qml/components/OrgText.qml index 8042cb1..ab9602a 100644 --- a/qml/components/OrgText.qml +++ b/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) } } diff --git a/qml/pages/Org.qml b/qml/pages/Org.qml index 9815207..6ad0ca5 100644 --- a/qml/pages/Org.qml +++ b/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 diff --git a/sextant.pro b/sextant.pro index 87bf8ca..b4d6f85 100644 --- a/sextant.pro +++ b/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 diff --git a/tests.lisp b/tests.lisp index 586609a..b2a01fb 100644 --- a/tests.lisp +++ b/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)