sfos/harbour-sextant
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Reparse node upon changes and promote/demote it if required

Browse source
This commit is contained in:
Renaud Casenave-Péré 2022-12-11 22:38:16 +01:00
parent 84530ee837
commit 2f4a641874
6 changed files with 141 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
lisp/local-projects/sextant/models/commands.lisp
View file

@ -85,17 +85,31 @@
(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
(nth-value 1 (goto-end-section)))
(refresh-data index))
new-node))
(defun do-modify-text (index new-text)
(let ((node (goto-index index)))
(setf (raw-text-of node) new-text)
(reparse-node index)))
(defun do-join-node (command)
(let* ((node (goto-index (index-of command)))
(next (next-of node))
(next-next (next-of next)))
(setf (raw-text-of node) (concatenate 'string (previous-text-of command) (next-text-of command))
(line-ending-of node) (next-eol-of command))
(refresh-data (index-of command))
(removing-rows ((1+ (index-of command)))
(setf (next-of node) next-next)
(when next-next
(setf (previous-of next-next) node)))))
(setf (previous-of next-next) node)))
(reparse-node (index-of command) (eq (type-of next) 'org-headline))))
(defun do-split-node (command)
(let* ((node (goto-index (index-of command)))
@ -109,16 +123,15 @@
(next-of new-node) next)))
(setf (raw-text-of node) (previous-text-of command)
(line-ending-of node) (previous-eol-of command))
(refresh-data (index-of command))))
(reparse-node (index-of command))
(reparse-node (1+ (index-of command)))))
(defgeneric apply-command (command))
(defmethod apply-command ((command command-modify-text))
(let ((node (goto-index (index-of command))))
(setf (raw-text-of node) (after-text-of command))
(refresh-data (index-of command))))
(do-modify-text (index-of command) (after-text-of command)))
(defmethod apply-command ((command command-join-node))
(do-join-node command))
@ -131,9 +144,7 @@
(defgeneric unapply-command (command))
(defmethod unapply-command ((command command-modify-text))
(let ((node (goto-index (index-of command))))
(setf (raw-text-of node) (before-text-of command))
(refresh-data (index-of command))))
(do-modify-text (index-of command) (before-text-of command)))
(defmethod unapply-command ((command command-join-node))
(do-split-node command))

31
lisp/local-projects/sextant/models/org-model.lisp
View file

@ -3,11 +3,13 @@
:sextant/models/utils)
(:export #:current-pathname
#:org-document
#:replace-data
#:refresh-data
#:removing-rows
#:inserting-rows
#:step-to-node
#:goto-index
#:goto-end-section
#:make-org-model))
(in-package :sextant/models/org-model)
@ -39,6 +41,18 @@
(defun replace-data (node new-node)
(prog1
(replace-node node new-node)
(when (eq *current-node* node)
(setf *current-node* new-node))
(when (eq (type-of new-node) 'org-headline)
(setf *current-headline* new-node))
(when (eq *current-headline* node)
(setf *current-headline* (if (eq (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))))
@ -70,6 +84,7 @@
(if *current-headline*
(1+ (depth-of *current-headline*))
0))
(defmethod node-depth ((node org-headline))
(depth-of node))
@ -108,6 +123,22 @@
*current-index* index)))
(values *current-node* *current-index* *current-headline*))
(defun goto-end-section ()
(let ((depth (and *current-headline* (depth-of *current-headline*)))
(step 0))
(setf *current-node* (step-to-node *current-node*
(lambda (node)
(or (let ((next (next-of node)))
(or (null next)
(and (eq (type-of next) 'org-headline)
(or (null depth) (<= (depth-of next) depth)))))
(not (incf step))))
#'next-node))
(incf *current-index* step)
(values *current-node* *current-index* *current-headline*)))
(defun construct-org-model ()
(let ((model (qnew "QAbstractListModel")))
(qoverride model "rowCount(QModelIndex)"

76
lisp/local-projects/sextant/org/nodes.lisp
View file

@ -15,9 +15,11 @@
#:make-org-document
#:make-org-line
#:make-org-headline
#:headline-of
#:append-node
#:process-last-node
#:collect-nodes))
#:collect-nodes
#:replace-node))
(in-package :sextant/org/nodes)
(defclass org-node ()
@ -81,6 +83,78 @@
(defgeneric headline-of (node))
(defmethod headline-of ((node org-line))
(loop for prev = (previous-of node) then (previous-of prev)
while (and prev (not (eq (type-of prev) 'org-headline)))
finally (return prev)))
(defmethod headline-of ((node org-headline))
(loop for prev = (previous-headline-of node) then (previous-headline-of prev)
while (and prev (>= (depth-of prev) (depth-of node)))
finally (return prev)))
(defmethod next-headline-of ((node org-line))
(loop for next = (next-of node) then (next-of next)
while (and next (not (eq (type-of next) 'org-headline)))
finally (return next)))
(defmethod title-of ((node org-line))
"")
(defgeneric replace-node (old new))
(defun replace-simple-node (old new)
(when (previous-of old)
(setf (previous-of new) (previous-of old)
(next-of (previous-of old)) new))
(when (next-of old)
(setf (next-of new) (next-of old)
(previous-of (next-of old)) new))
nil)
(defmethod replace-node ((old org-line) (new org-line))
(replace-simple-node old new))
(defmethod replace-node ((old org-headline) (new org-headline))
(replace-simple-node old new)
(when (previous-headline-of old)
(setf (previous-headline-of new) (previous-headline-of old)
(next-headline-of (previous-headline-of old)) new))
(when (next-headline-of old)
(setf (next-headline-of new) (next-headline-of old)
(previous-headline-of (next-headline-of old)) new))
t)
(defmethod replace-node ((old org-headline) (new org-line))
(replace-simple-node old new)
(when (previous-headline-of old)
(setf (next-headline-of (previous-headline-of old)) (next-headline-of old)))
(when (next-headline-of old)
(setf (previous-headline-of (next-headline-of old)) (previous-headline-of old)))
t)
(defmethod replace-node ((old org-line) (new org-headline))
(replace-simple-node old new)
(let ((headline (headline-of old)))
(if headline
(progn
(when (next-headline-of headline)
(setf (next-headline-of new) (next-headline-of headline)
(previous-headline-of (next-headline-of headline)) new))
(setf (next-headline-of headline) new
(previous-headline-of new) headline))
(let ((headline (next-headline-of old)))
(when headline
(setf (previous-headline-of headline) new
(next-headline-of new) headline))))
t))
(defgeneric append-node (node next))
(defgeneric process-last-node (node))

4
lisp/local-projects/sextant/org/parser.lisp
View file

@ -1,5 +1,7 @@
(uiop:define-package :sextant/org/parser
(:use :cl :alexandria :sextant/org/nodes)
(:use :cl :alexandria
:sextant/org/nodes
:sextant/org/printer)
(:export #:parse-document
#:parse-node))
(in-package :sextant/org/parser)

15
qml/components/OrgDelegate.qml
View file

@ -18,11 +18,16 @@ ListItem {
id: loader
anchors.fill: parent
source: {
if (nodeType == "org-line")
return "OrgLine.qml";
else if (nodeType == "org-headline")
return "OrgHeadline.qml";
property string type: nodeType
onTypeChanged: {
var url
if (type == "org-line")
url = "OrgLine.qml"
else if (type == "org-headline")
url = "OrgHeadline.qml"
setSource(url)
}
}

4
qml/pages/Org.qml
View file

@ -68,7 +68,7 @@ Page {
onClicked: {
if (document.focusedItem != null) {
document.focusedItem.forceCommit();
document.focusedItem.forceCommit(true);
document.focusedIndex = -1
}
@ -102,7 +102,7 @@ Page {
onClicked: {
if (document.focusedItem != null) {
document.focusedItem.forceCommit()
document.focusedItem.forceCommit(true)
document.focusedIndex = -1
}