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

Make `step-to-node' more generic

Browse source
This commit is contained in:
Renaud Casenave-Péré 2022-12-11 00:02:52 +01:00
parent 0b2e063eaf
commit 84530ee837
2 changed files with 46 additions and 37 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -86,7 +86,7 @@
(defun do-join-node (command)
(let* ((node (goto-node (index-of 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))
@ -98,7 +98,7 @@
(setf (previous-of next-next) node)))))
(defun do-split-node (command)
(let* ((node (goto-node (index-of command)))
(let* ((node (goto-index (index-of command)))
(next (next-of node))
(new-node (make-org-line (next-text-of command) (next-eol-of command))))
(inserting-rows ((1+ (index-of command)))
@ -116,7 +116,7 @@
(defgeneric apply-command (command))
(defmethod apply-command ((command command-modify-text))
(let ((node (goto-node (index-of command))))
(let ((node (goto-index (index-of command))))
(setf (raw-text-of node) (after-text-of command))
(refresh-data (index-of command))))
@ -131,7 +131,7 @@
(defgeneric unapply-command (command))
(defmethod unapply-command ((command command-modify-text))
(let ((node (goto-node (index-of command))))
(let ((node (goto-index (index-of command))))
(setf (raw-text-of node) (before-text-of command))
(refresh-data (index-of command))))
@ -207,13 +207,13 @@
(defun modify-text (index text)
(let ((node (goto-node index)))
(let ((node (goto-index index)))
(setf *current-state* (push-command-modify-text *current-state* index
(raw-text-of node) text))
(refresh-toolbar)))
(defun join-node (index)
(let* ((node (goto-node index))
(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)
@ -221,7 +221,7 @@
(refresh-toolbar)))
(defun split-node (index previous-text next-text)
(let* ((node (goto-node index))
(let* ((node (goto-index index))
(next-eol (line-ending-of node))
(previous-eol (if (/= (length next-eol) 0)
next-eol

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

@ -7,7 +7,7 @@
#:removing-rows
#:inserting-rows
#:step-to-node
#:goto-node
#:goto-index
#:make-org-model))
(in-package :sextant/models/org-model)
@ -64,19 +64,8 @@
(defgeneric step-previous-node (node))
(defmethod step-previous-node ((node org-line))
(previous-of node))
(defmethod step-previous-node :before ((node org-headline))
(setf *current-headline* (previous-headline-of node)))
(defgeneric step-next-node (node))
(defmethod step-next-node ((node org-line))
(next-of node))
(defmethod step-next-node :before ((node org-headline))
(setf *current-headline* node))
(defgeneric node-depth (node))
(defmethod node-depth ((node org-line))
(if *current-headline*
(1+ (depth-of *current-headline*))
@ -84,20 +73,40 @@
(defmethod node-depth ((node org-headline))
(depth-of node))
(defun step-to-node (from step)
(assert from)
(let* ((index (+ *current-index* step))
(node (if (< step 0)
(dotimes (i (- step) from)
(setf from (step-previous-node from)))
(dotimes (i step from)
(setf from (step-next-node from))))))
(setf *current-node* node
*current-index* index)
*current-node*))
(defun previous-node (node)
(let ((prev (previous-of node)))
(assert prev)
(when (eq (type-of node) 'org-headline)
(setf *current-headline* (previous-headline-of node)))
prev))
(defun goto-node (index)
(step-to-node *current-node* (- index *current-index*)))
(defun next-node (node)
(let ((next (next-of node)))
(assert next)
(when (eq (type-of next) 'org-headline)
(setf *current-headline* next))
next))
(defun step-to-node (from pred stepper)
(assert from)
(loop until (funcall pred from)
do (setf from (funcall stepper from))
finally (return from)))
(defun goto-index (index)
(unless (= index *current-index*)
(let* ((step (- index *current-index*))
(stepper (if (< step 0) #'previous-node #'next-node))
(count (abs step)))
(setf *current-node* (step-to-node *current-node*
(lambda (node)
(declare (ignore node))
(prog1
(= count 0)
(decf count)))
stepper)
*current-index* index)))
(values *current-node* *current-index* *current-headline*))
(defun construct-org-model ()
(let ((model (qnew "QAbstractListModel")))
@ -109,7 +118,7 @@
(lambda (index role)
(let ((row (|row| index)))
(when (and (> row -1) (< row *nodes-count*))
(let ((item (goto-node row)))
(let ((item (goto-index row)))
(case role
(#.+nodetype-role+
(qvariant-from-value (string-downcase (symbol-name (type-of item)))
@ -137,9 +146,9 @@
(setf *current-pathname* pathname)
(|beginResetModel| *org-model*)
(setf *org-document* org-document
*current-headline* nil
*current-node* (next-of org-document)
*current-index* 0
*nodes-count* (loop for c = (next-of org-document) then (next-of c)
while c count c))
*nodes-count* (loop for node = (next-of org-document) then (next-of node)
while node count node))
(setf *current-headline* (and (eq (type-of *current-node*) 'org-headline) *current-node*))
(|endResetModel| *org-model*))