Add action to control headlines visibility
This commit is contained in:
Renaud Casenave-Péré
parent
5e567d0857
commit
df036192ea
4 changed files with 125 additions and 3 deletions
|
|
@ -1,17 +1,37 @@
|
|||
(uiop:define-package :sextant/models/actions
|
||||
(:use :cl :eql :qml :options
|
||||
:sextant/org/nodes
|
||||
:sextant/models/org-model))
|
||||
(in-package :sextant/models/actions)
|
||||
|
||||
(defvar *last-command* nil)
|
||||
|
||||
(defmacro defaction (action-name types &body body)
|
||||
(declare (ignore types))
|
||||
`(prog1
|
||||
(defun ,action-name (ui-item node coords)
|
||||
(declare (ignorable ui-item node coords))
|
||||
,@body
|
||||
(flet ((repeat-command-p ()
|
||||
(and (eq ',action-name (first *last-command*))
|
||||
(eq node (third *last-command*)))))
|
||||
,@body)
|
||||
(setf *last-command* (list ',action-name node))
|
||||
nil)
|
||||
(push-action (symbol-name ',action-name) ',types)))
|
||||
|
||||
(defaction collapse/expand (org-headline)
|
||||
(qjs |setFocus| ui-item)
|
||||
(ecase (property-of node :visibility)
|
||||
(:collapsed (expand-headline))
|
||||
(:expanded
|
||||
(if (and (repeat-command-p)
|
||||
(next-headline-of node)
|
||||
(> (depth-of (next-headline-of node)) (depth-of node)))
|
||||
(ecase (property-of (next-headline-of node) :visibility)
|
||||
(:collapsed (expand-headline t))
|
||||
(:expanded (collapse-headline)))
|
||||
(collapse-headline)))))
|
||||
|
||||
(defaction raw-edit (org-line org-headline)
|
||||
(qjs |setFocus| ui-item)
|
||||
(qjs |setCursorPositionAt| ui-item (car coords) (cdr coords))
|
||||
|
|
|
|||
|
|
@ -11,6 +11,9 @@
|
|||
#:step-to-node
|
||||
#:goto-index
|
||||
#:goto-end-section
|
||||
#:ensure-visible
|
||||
#:expand-headline
|
||||
#:collapse-headline
|
||||
#:make-org-model))
|
||||
(in-package :sextant/models/org-model)
|
||||
|
||||
|
|
@ -96,6 +99,12 @@
|
|||
(decf sextant/models/org-model::*nodes-count* (1+ (- ,end ,start)))
|
||||
(|endRemoveRows| sextant/models/org-model::*org-model*))))
|
||||
|
||||
(defun remove-rows (start count)
|
||||
(let ((end (+ start (1- count))))
|
||||
(|beginRemoveRows| *org-model* *empty-model-index* start end)
|
||||
(decf *nodes-count* count)
|
||||
(|endRemoveRows| *org-model*)))
|
||||
|
||||
(defmacro inserting-rows ((start &optional (end start)) &body body)
|
||||
(once-only (start end)
|
||||
`(progn
|
||||
|
|
@ -105,6 +114,12 @@
|
|||
(incf sextant/models/org-model::*nodes-count* (1+ (- ,end ,start)))
|
||||
(|endInsertRows| sextant/models/org-model::*org-model*))))
|
||||
|
||||
(defun insert-rows (start count)
|
||||
(let ((end (+ start (1- count))))
|
||||
(|beginInsertRows| *org-model* *empty-model-index* start end)
|
||||
(incf *nodes-count* count)
|
||||
(|endInsertRows| *org-model*)))
|
||||
|
||||
|
||||
|
||||
(defgeneric node-depth (node))
|
||||
|
|
@ -208,6 +223,76 @@
|
|||
|
||||
|
||||
|
||||
(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 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))
|
||||
do (setf index (current-index))
|
||||
when (eq n h)
|
||||
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))))
|
||||
count (/= index -1) into count
|
||||
finally (when (/= index -1)
|
||||
(assert (> count 0))
|
||||
(insert-rows index count)))))))))
|
||||
|
||||
(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))
|
||||
count n into count
|
||||
when (eq n h)
|
||||
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))))))
|
||||
|
||||
|
||||
|
||||
(defun construct-org-model ()
|
||||
(let ((model (qnew "QAbstractListModel")))
|
||||
(qoverride model "rowCount(QModelIndex)"
|
||||
|
|
|
|||
|
|
@ -46,8 +46,8 @@
|
|||
press-and-hold-on-org-line "NOTHING")
|
||||
|
||||
(defaction-config org-headline-actions
|
||||
click-on-org-headline "RAW-EDIT"
|
||||
click-on-org-headline "COLLAPSE/EXPAND"
|
||||
double-click-on-org-headline "NOTHING"
|
||||
press-and-hold-on-org-headline "NOTHING")
|
||||
press-and-hold-on-org-headline "RAW-EDIT")
|
||||
|
||||
(defconfig slynk-at-startup-p nil)
|
||||
|
|
|
|||
|
|
@ -17,6 +17,8 @@
|
|||
#:make-org-headline
|
||||
#:property-of
|
||||
#:headline-of
|
||||
#:node-path
|
||||
#:node-visible-p
|
||||
#:append-node
|
||||
#:process-last-node
|
||||
#:collect-nodes
|
||||
|
|
@ -124,6 +126,21 @@
|
|||
|
||||
|
||||
|
||||
(defun node-path (node &optional parent)
|
||||
(let (path (list node))
|
||||
(loop for h = (headline-of node) then (headline-of node)
|
||||
until (or (null h) (eq h parent))
|
||||
do (push h path)
|
||||
finally (progn
|
||||
(assert (eq h parent))
|
||||
path))))
|
||||
|
||||
(defun node-visible-p (node)
|
||||
(let ((headline (headline-of node)))
|
||||
(or (not headline) (eq (property-of headline :visibility) :expanded))))
|
||||
|
||||
|
||||
|
||||
(defgeneric replace-node (old new))
|
||||
|
||||
(defun replace-simple-node (old new)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue