[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/dslide 618b803f95 067/230: !refactor Telescopio, the paren
From: |
ELPA Syncer |
Subject: |
[nongnu] elpa/dslide 618b803f95 067/230: !refactor Telescopio, the parents now call through their children |
Date: |
Sun, 7 Jul 2024 19:00:16 -0400 (EDT) |
branch: elpa/dslide
commit 618b803f9593f42edee1b1a6c8c54314022d6596
Author: Psionik K <73710933+psionic-k@users.noreply.github.com>
Commit: Psionik K <73710933+psionic-k@users.noreply.github.com>
!refactor Telescopio, the parents now call through their children
- A lot of the fiddly complexity has gone away.
- The notion that children will push a sequence up to the deck has gone away
- As has the notion of a sequence callback (thought here is some cruft)
- Deck no longer knows what the depth is
- Bad for counting slides, good for less complex deck
- Children do more work, but it is actually pretty easy for them to do
Biggest benefit, the configuration lost all the annoying quirks. The hidden
babel slide is pretty.
Signed-off-by: Psionik K <73710933+psionic-k@users.noreply.github.com>
---
macro-slides.el | 592 +++++++++++++++++++++++---------------------------------
test/demo.org | 112 ++++++-----
2 files changed, 295 insertions(+), 409 deletions(-)
diff --git a/macro-slides.el b/macro-slides.el
index cb672a9042..057a70528c 100644
--- a/macro-slides.el
+++ b/macro-slides.el
@@ -641,16 +641,8 @@ the mode and go to slides."
Set up the state required for this sequence when going forward,
entering the sequence from the beginning.
-Two explicit return values are understood:
-
-- `skip': This sequence has rejected being run. `ms-final' will
- not be called.
-
-- `step': Init was successful and should count as a step
-
-Any other return value, including nil, is considered implicit
-success but will not count as a step, meaning `ms-step-forward'
-will immediately be called.
+Return values are ignored. `ms-init' always counts as a step because it's a
+result of a nil return from `ms-forward'.
This method should work together with `ms-end' and `ms-final' to ensure
consistently valid state for `ms-forward' and `ms-backward'.")
@@ -660,17 +652,8 @@ consistently valid state for `ms-forward' and
`ms-backward'.")
Set up the state required for this sequence when going backward,
entering the sequence from the end.
-Two explicit return values are understood:
-
-- `skip': This sequence has rejected being run. `ms-final' will
- not be called.
-
-- `step': Init was successful and should count as a step
-
-Any other return value, including nil, is considered implicit
-success but will not count as a step, meaning `ms-step-forward'
-will immediately be called.
-
+Return values are ignored. `ms-end' always counts as a step because it's a
+result of a nil return from `ms-backward'.
The first job of this method is to perform setup, possibly by
just calling init since they likely have similar side-effects.
@@ -684,10 +667,11 @@ inappropriate, it should be overridden.
In cases where you don't need a real backward implementation or
progressing backwards would have no sensible behavior, you can
-delegate this to init and possibly delegate backward to forward,
-resulting in a sequence that always starts at the beginning and
-always proceeds to the end. For a single step sequence that has
-identical effect in both directions, this is appropriate.
+delegate this to `ms-init' and possibly delegate `ms-backward' to
+`ms-forward', resulting in a sequence that always starts at the
+beginning and always proceeds to the end. For a single step
+sequence that has identical effect in both directions, this is
+appropriate.
This method should work together with `ms-end' and `ms-final' to
ensure consistently valid state for `ms-forward' and
@@ -790,8 +774,6 @@ simplify their implementation."
(cl-defmethod ms-final ((_ ms-stateful-sequence)))
(cl-defmethod ms-goto ((obj ms-stateful-sequence) point)
-
-
(unless (eq 'skip (ms-init obj))
(let (exceeded (advanced t))
(while (and advanced (not exceeded))
@@ -899,30 +881,10 @@ their init."
;; Calls implied from other commands should have started the lifecycle
already
(error "No slide selected"))
- (let (initialized reached-end)
- (while (and (not initialized)
- (not reached-end))
- ;; TODO This line is critical to starting up the state machine. Slides
- ;; are still inferring their need to narrow.
- (narrow-to-region (point) (point)) ; signal to slide to draw itself
- (let ((result (ms-init (oref obj slide))))
- ;; TODO this loop is horrible. Rewrite it.
- (if (eq result 'skip)
- (if-let ((next (ms-next-child obj (oref obj slide))))
- (oset obj slide next)
- (setq reached-end t))
- (if (eq result 'step)
- (setq initialized t)
- (let ((forward (ms-step-forward (oref obj slide))))
- (if forward
- (setq initialized t)
- (if-let ((next (ms-next-child obj (oref obj slide))))
- (oset obj slide next)
- (setq reached-end t))))))))
- (when reached-end
- ;; TODO probably the resulting state just needs to act like there is no
- ;; next slide and call the `ms-after-last-slide-hook'
- (error "No slides could initialize"))))
+ ;; TODO This line is critical to starting up the state machine. Slides
+ ;; are still inferring their need to narrow.
+ (narrow-to-region (point) (point)) ; signal to slide to draw itself
+ (ms-init (oref obj slide)))
(cl-defmethod ms-end ((_ ms-deck))
(error "Deck has no valid concept of starting at the end."))
@@ -931,14 +893,13 @@ their init."
(when-let ((slide (oref obj slide)))
(ms-final slide)))
-;; Deck forward & backward methods implement a lot of the capability. In the
-;; function-stack analogy, the deck's forward & backward are similar to a
-;; runtime, handling call and return behavior, advancing to the next slide /
-;; function in our presentation / procedure etc. Support for calling into a
-;; sub-sequence or doing something upon return are baked in. It make require
-;; several trips through the behavior to consume callbacks that are run for
-;; effect or are no-op, things that don't count as steps or are slides that
-;; decide at runtime to be skipped.
+;; Deck forward & backward methods are the entry point for user forward and
+;; backward commands. They delegate out to slides, which may telescope into
+;; their children in order to make progress.
+;;
+;; It make require several trips through the behavior to consume callbacks that
+;; are run for effect or are no-op, things that don't count as steps or are
+;; slides that decide at runtime to be skipped.
;;
;; There are many little user-facing behaviors, such as following the slide in
;; the base buffer with the point. These are best done from the sequence root.
@@ -948,10 +909,6 @@ their init."
;; next steps and callbacks were pushed onto the stack. When one of them makes
;; progress, we're done.
-;; TODO When slides are converted so that they push new sequences on their own,
-;; we no longer need to handle the case where a child slide is returned. I
-;; think this is where the implementation is going because it's very elegant.
-
(cl-defmethod ms-step-forward ((obj ms-deck))
;; TODO Check for forward callbacks
(unless (oref obj slide)
@@ -963,9 +920,7 @@ their init."
(restriction-max (point-max))
progress reached-end)
;; Burn up a step callback until one returns non-nil
- ;; TODO do I need this `slot-boundp' check?
- (when-let ((steps (and (slot-boundp obj 'step-callbacks)
- (oref obj step-callbacks))))
+ (when-let ((steps (oref obj step-callbacks)))
(while (and (not progress)
steps)
(setq progress (funcall (pop steps) 'forward)))
@@ -974,79 +929,38 @@ their init."
(while (not (or progress reached-end))
(let* ((current-slide (oref obj slide))
(result (ms-step-forward current-slide))
- next-slide switching-to-parent switching-to-sibling)
-
- (if (eieio-object-p result)
- (setq next-slide result)
- (setq progress result))
-
- ;; Before we might check for a parent or next tree, check for a slide
- ;; callback and see if it can make progress.
- (unless result
- ;; Burn up a step callback until one returns non-nil
- (when-let* ((sequence-callbacks (oref obj sequence-callbacks))
- (steps (car sequence-callbacks)))
- (while (and (not progress) steps)
- (setq progress (funcall (pop steps) 'forward)))
- ;; If all the steps for this sequence were consumed, pop a layer.
- (unless steps
- (oset obj sequence-callbacks (cdr sequence-callbacks)))))
-
- (unless (or progress result)
- ;; Next check if there is a parent slide, which is true unless the
- ;; parent is the deck. Then check if there is a next sibling.
- (let* ((parent (oref current-slide parent)))
- (if (not (eq obj parent))
- (setq next-slide parent
- switching-to-parent t)
- (if-let ((next-child (ms-next-child obj current-slide)))
- (setq next-slide next-child
- switching-to-sibling t)
- (setq reached-end t)))))
+ next-slide)
+
+ (if result
+ (setq progress result)
+ ;; Check if there is a next sibling.
+ (if-let ((next-child (ms-next-child obj current-slide)))
+ (setq next-slide next-child)
+ (setq reached-end t)))
(unless next-slide
(ms--debug current-slide (format "forward: %s" progress)))
(when next-slide
- (ms--debug next-slide
- (cond (switching-to-parent "switching to parent")
- (switching-to-sibling "switching to sibling")
- (t "switching to child")))
-
- (unless switching-to-parent
- ;; Push a new sequence-callbacks level
- (push nil (oref obj sequence-callbacks)))
-
+ (ms--debug next-slide "switching to sibling")
(oset obj slide next-slide)
-
- ;; When switching to a parent slide, we will finalize the old slide.
- ;; When switching to a child, we will not finalize the parent.
- (cond
- (switching-to-parent
- ;; TODO slide re-entry when parent can still make progress
- (ms-final current-slide))
- (t
- (when switching-to-sibling
- (ms-final current-slide))
-
- ;; TODO extract behavior and add to other navigation actions
- (when ms-base-follows-slide
- (let ((pos (marker-position (oref next-slide begin))))
- (set-buffer (oref obj base-buffer))
- (unless (and (>= pos (point-min))
- (<= pos (point-max)))
- (widen))
- (when-let ((windows (get-buffer-window-list (current-buffer))))
- (mapc (lambda (w) (set-window-point w pos)) windows))
- (set-buffer (oref obj slide-buffer))))
-
- ;; Call init. Unless an init call requests to be considered a
step,
- ;; the loop will proceed to call `step-forward' on `next-slide'
- (pcase (ms-init next-slide)
- ('step (setq progress t))
- ;; TODO skipping here looks fiddly to implement. The loop needs
- ;; to immediately skip to checking for another sibling
- ('skip (warn "Skip is not supported yet"))))))))
+ (ms-final current-slide)
+
+ ;; TODO extract behavior and add to other navigation actions
+ (when ms-base-follows-slide
+ (let ((pos (marker-position (oref next-slide begin))))
+ (set-buffer (oref obj base-buffer))
+ (unless (and (>= pos (point-min))
+ (<= pos (point-max)))
+ (widen))
+ (when-let ((windows (get-buffer-window-list (current-buffer))))
+ (mapc (lambda (w) (set-window-point w pos)) windows))
+ (set-buffer (oref obj slide-buffer))))
+
+
+ (ms-init next-slide)
+ ;; Init counts as a step
+ (setq progress t))))
;; A lot of progress may have happened, but there will be only one feedback
;; message.
@@ -1088,77 +1002,37 @@ their init."
(while (not (or progress reached-beginning))
(let* ((current-slide (oref obj slide))
(result (ms-step-backward current-slide))
- previous-slide switching-to-parent switching-to-sibling)
-
- (if (eieio-object-p result)
- (setq previous-slide result)
- (setq progress result))
-
- ;; Before we might check for a parent or next tree, check for a slide
- ;; callback and see if it can make progress.
- (unless result
- ;; Burn up a step callback until one returns non-nil
- (when-let* ((sequence-callbacks (oref obj sequence-callbacks))
- (steps (car sequence-callbacks)))
- (while (and (not progress) steps)
- (setq progress (funcall (pop steps) 'backward)))
- ;; If all the steps for this sequence were consumed, pop a layer.
- (unless steps
- (oset obj sequence-callbacks (cdr sequence-callbacks)))))
-
- (unless (or progress result)
- ;; Next check if there is a parent slide, which is true unless the
- ;; parent is the deck. Then check if there is a previous sibling.
- (let* ((parent (oref current-slide parent)))
- (if (not (eq obj parent))
- (setq previous-slide parent
- switching-to-parent t)
- (if-let ((previous-child (ms-previous-child
- obj current-slide)))
- (setq previous-slide previous-child
- switching-to-sibling t)
- (setq reached-beginning t)))))
+ previous-slide)
+
+ (if result
+ (setq progress result)
+ ;; Check if there is a previous sibling.
+ (if-let ((previous-child (ms-previous-child
+ obj current-slide)))
+ (setq previous-slide previous-child)
+ (setq reached-beginning t)))
(unless previous-slide
(ms--debug current-slide (format "forward: %s" progress)))
(when previous-slide
- (ms--debug previous-slide
- (cond (switching-to-parent "switching to parent")
- (switching-to-sibling "switching to sibling")
- (t "switching to child")))
-
- (unless switching-to-parent
- ;; Push a new sequence-callbacks level
- (push nil (oref obj sequence-callbacks)))
-
+ (ms--debug previous-slide "switching to sibling")
(oset obj slide previous-slide)
-
- ;; When switching to a parent slide, we will finalize the old slide.
- ;; When switching to a child, we will not finalize the parent.
- (cond
- (switching-to-parent
- ;; TODO slide re-entry when parent can still make progress?
- (ms-final current-slide))
- (t
- (when switching-to-sibling
- (ms-final current-slide))
- ;; TODO extract behavior and add to other navigation commands
- (when ms-base-follows-slide
- (let ((pos (marker-position (oref previous-slide begin))))
- (set-buffer (oref obj base-buffer))
- (unless (and (>= pos (point-min))
- (<= pos (point-max)))
- (widen))
- (when-let ((windows (get-buffer-window-list (current-buffer))))
- (mapc (lambda (w) (set-window-point w pos)) windows))
- (set-buffer (oref obj slide-buffer))))
- ;; We just send the slide to its end (reverse init). Unless one
end
- ;; call requests to be considered a step, the loop will proceed to
- ;; call `step-backward' on `previous-slide'
- (pcase (ms-end previous-slide)
- ('step (setq progress t))
- ('skip (warn "Skip not implemented yet"))))))))
+ (ms-final current-slide)
+
+ ;; TODO extract behavior and add to other navigation commands
+ (when ms-base-follows-slide
+ (let ((pos (marker-position (oref previous-slide begin))))
+ (set-buffer (oref obj base-buffer))
+ (unless (and (>= pos (point-min))
+ (<= pos (point-max)))
+ (widen))
+ (when-let ((windows (get-buffer-window-list (current-buffer))))
+ (mapc (lambda (w) (set-window-point w pos)) windows))
+ (set-buffer (oref obj slide-buffer))))
+ ;; end counts as a step.
+ (ms-end previous-slide)
+ (setq progress t))))
;; A lot of progress may have happened, but there will be only one feedback
;; message.
@@ -1278,119 +1152,94 @@ once, which requires the functions to be removed or
return nil."
(defclass ms-slide (ms-parent ms-stateful-sequence)
((slide-action
:initform nil :initarg :slide-action
- :documentation "Action run after section.
-See `ms-default-child-action'.")
+ :documentation "Action run around both section and child actions.
+See `ms-default-slide-action'.")
(section-actions
:initform nil :initarg :section-actions
- :documentation "Actions run within the section display
-lifecycle. See `ms-default-section-actions'.")
+ :documentation "Typical actions that work on the section.
+Live within slide action lifecycle. See
+`ms-default-section-actions'.")
(child-action
:initform nil :initarg :child-action
:documentation "Action run after section.
-See `ms-default-child-action'.")
+Live within slide action lifecycle. See
+`ms-default-child-action'.")
(begin
:initform nil :initarg :begin
- :documentation "Marker for retrieving this heading's org element.")
- (compose
- :initform nil :initarg :compose
- :documentation "Run child actions within the slide action.
-This is a temporary solution to support a basic form of action
-composition, Running actions as sequences within other actions."))
+ :documentation "Marker for retrieving this heading's org element."))
"Slides store some local state and delegate behavior to several
functions. The Slide is a stateful node that hydrates around a
heading and stores actions and their states.")
-;; These methods are starting to get a little bit fiddly with this hacky
-;; compositions style. After a few more actions illuminate the common
patterns,
-;; some refactoring need will be well decided. It's there, I just don't know
-;; what we need.
-
(cl-defmethod ms-init ((obj ms-slide))
- (let (step)
- (when-let ((display-action (oref obj slide-action)))
- (setq step (ms-init display-action)))
- (mapc (lambda (action)
- (let ((result (ms-init action)))
- (when (eq result 'step)
- (setq step 'step))))
- (oref obj section-actions))
- (when-let ((child-action (oref obj child-action)))
- (ms-init child-action))
- step))
+ (when-let ((slide-action (oref obj slide-action)))
+ (ms-init slide-action))
+ (when-let ((section-actions (oref obj section-actions)))
+ (mapc #'ms-init section-actions))
+ (when-let ((child-action (oref obj child-action)))
+ (ms-init child-action)))
(cl-defmethod ms-end ((obj ms-slide))
- (let (step)
- (when (oref obj compose)
- (when-let ((display-action (oref obj slide-action)))
- (setq step (ms-end display-action))))
- (when-let ((child-action (oref obj child-action)))
- (let ((result (ms-end child-action)))
- (when (eq result 'step)
- (setq step 'step))))
- (unless (oref obj compose)
- (when-let ((display-action (oref obj slide-action)))
- (when (eq 'step (ms-end display-action))
- (setq step 'step))))
- (mapc (lambda (action)
- (when (eq 'step (ms-end action))
- (message "An action indeed has returned `step' during the end
method.")
- (setq step 'step)))
- (reverse (oref obj section-actions)))
- step))
+ (when-let ((slide-action (oref obj slide-action)))
+ (ms-end slide-action))
+ ;; Fairly certain the ordering of child and section actions doesn't actually
+ ;; matter for `ms-end', but this ordering matches the situation that would
+ ;; occur if the user just called `ms-step-forward' repeatedly, and we want
the
+ ;; end state to be as close to "normal" as possible.
+ (when-let ((section-actions (oref obj section-actions)))
+ (mapc #'ms-end (reverse section-actions)))
+ (when-let ((child-action (oref obj child-action)))
+ (ms-end child-action)))
(cl-defmethod ms-final ((obj ms-slide))
;; The order that these are called shouldn't matter. No use case for
coupling
- ;; different finals.
- (when-let ((display-action (oref obj slide-action)))
- (ms-final display-action))
+ ;; different finals, but the guarantee is that the lifecycle of the slide
+ ;; actions encompass the contents actions (child and section)
(mapc (lambda (action)
(ms-final action))
(oref obj section-actions))
(when-let ((child-action (oref obj child-action)))
(ms-final child-action))
- ;; Clean up marker
+ (when-let ((display-action (oref obj slide-action)))
+ (ms-final display-action))
+ ;; Clean up heading marker, which is shared by children
(set-marker (oref obj begin) nil))
(cl-defmethod ms-step-forward ((obj ms-slide))
(let ((section-actions (oref obj section-actions))
+ (child-action (oref obj child-action))
+ (slide-action (oref obj slide-action))
progress)
- (setq progress (when-let ((display-action (oref obj slide-action)))
- (ms-step-forward display-action)))
- (while (and (not progress)
- section-actions)
- (let ((action (pop section-actions)))
- (when-let ((result (ms-step-forward action)))
- (setq progress result))))
- (or progress
- (when-let ((child-action (oref obj child-action)))
- (ms-step-forward child-action)))))
+ (while (and (not progress) section-actions)
+ (setq progress (ms-step-forward (pop section-actions))))
+ (unless (or progress (null child-action))
+ (setq progress (ms-step-forward child-action)))
+ (unless (or progress (null slide-action))
+ (setq progress (ms-step-forward slide-action)))
+ progress))
(cl-defmethod ms-step-backward ((obj ms-slide))
- (let ((section-actions (reverse (oref obj section-actions)))
+ (let ((section-actions (oref obj section-actions))
(child-action (oref obj child-action))
(slide-action (oref obj slide-action))
progress)
- (setq progress
- (if (oref obj compose)
- (or (when slide-action (ms-step-backward slide-action))
- (when child-action (ms-step-backward child-action)))
- (or (when child-action (ms-step-backward child-action))
- (when slide-action (ms-step-backward slide-action)))))
- (while (and (not progress)
- section-actions)
- (let ((action (pop section-actions)))
- (when-let ((result (ms-step-backward action)))
- (setq progress result))))
+ (unless (null child-action)
+ (setq progress (ms-step-backward child-action)))
+ (while (and (not progress) section-actions)
+ (setq progress (ms-step-backward (pop section-actions))))
+ (unless (or progress (null slide-action))
+ (setq progress (ms-step-backward slide-action)))
progress))
;; `ms--make-slide' is very critical to the user-facing configuration and
;; hacker-facing capabilities and API. Slides are hydrated from org mode
;; headings. We can pretty much divide the likely user needs into either what
-;; to do with the section and what to do with the child headings. Because the
-;; section needs to be narrowed to, and this narrowing must be performed both
-;; forwards and backwards, we also have a slide action that might (see
-;; `:compose') be run around the section and child actions.
+;; to do with the section and what to do with the child headings.
+
+;; Because the section needs to be narrowed to, and this narrowing must be
+;; performed both forwards and backwards, we also have a slide action that runs
+;; in very particularly ordered points to keep its operation simple and
reliable.
;;
;; There is a chance that it will make sense to support nested s-expressions in
;; the property configuration. For now, there is only an observed need for
@@ -1623,48 +1472,6 @@ NO-RECURSION will avoid descending into children."
(when-let ((marker (oref obj marker)))
(set-marker marker nil)))
-;; TODO make a child base class. Section actions don't really need this.
-(cl-defmethod ms-forward-child ((obj ms-action))
- "Return the next direct child heading and advance the marker.
-Marker is moved to the end of the heading if no matching child is
-found."
- (if-let* ((marker (ms-marker obj))
- (heading (ms-heading obj))
- (target-level (1+ (org-element-property :level heading)))
- (next (ms--contents-map
- heading 'headline
- (lambda (child)
- (and (= target-level (org-element-property :level child))
- (> (org-element-begin child) marker)
- child))
- nil t)))
- (prog1 next
- (ms-marker obj (org-element-begin next)))
- (ms-marker obj (org-element-end (ms-heading obj)))
- nil))
-
-
-(cl-defmethod ms-backward-child ((obj ms-action))
- "Return previous direct child heading and advance the marker backward.
-Marker is moved to the beginning of the heading if no matching
-child is found."
- (if-let* ((marker (ms-marker obj))
- (heading (ms-heading obj))
- (target-level (1+ (org-element-property :level heading)))
- ;; We have to get all the children and find the last match
- (next (car
- (last
- (ms--contents-map
- heading 'headline
- (lambda (child)
- (and (= target-level (org-element-property :level
child))
- (< (org-element-begin child) marker)
- child)))))))
- (prog1 next
- (ms-marker obj (org-element-begin next)))
- (ms-marker obj (org-element-begin (ms-heading obj)))
- nil))
-
;; ** Default Slide Action
(defclass ms-action-narrow (ms-action)
((include-restriction
@@ -1673,11 +1480,7 @@ child is found."
(with-children
:initform nil :initarg :with-children
:documentation "Narrow should include children.
-The default, nil, narrows to the section only.")
- (last-progress
- :initform nil
- :documentation "A helpful hack to prevent unintended repeat
-narrowing in the lifecycle. This is a latch variable."))
+The default, nil, narrows to the section only."))
"Default slide action.
Most actions need the current slide to be narrowed to. This
@@ -1711,19 +1514,25 @@ deck of progress was made.")
(not (oref obj inline)))
(ms-animation-setup begin end))
(setq progress t)))
- ;; This progress is important because it's how we show a slide and count as
- ;; a first step
- (when progress 'step)))
+ ;; Return progress to count as step when re-narrowing after a child.
+ progress))
+
+;; This code makes little sense. See the slide's current ordering of calling
+;; the slide action, and the reason will make sense. A re-write will probably
+;; get it right. The key thing to note is that a parent can't re-display
itself
+;; unless it's going backwards. It needs to display itself during end even
+;; though the end of its children may clobber it. This works, just awkwardly.
+(cl-defmethod ms-init :after ((obj ms-action-narrow))
+ (ms-narrow obj))
-(cl-defmethod ms-step-forward ((obj ms-action-narrow))
- (prog1 (unless (eq 'forward (oref obj last-progress))
- (ms-narrow obj))
- (oset obj last-progress 'forward)))
+(cl-defmethod ms-step-forward ((_ ms-action-narrow))
+ nil)
(cl-defmethod ms-step-backward ((obj ms-action-narrow))
- (prog1 (unless (eq 'backward (oref obj last-progress))
- (ms-narrow obj))
- (oset obj last-progress 'backward)))
+ (ms-narrow obj))
+
+(cl-defmethod ms-end :after ((obj ms-action-narrow))
+ (ms-narrow obj))
;; ** Reveal items section action
(defclass ms-action-item-reveal (ms-action)
@@ -1940,23 +1749,103 @@ stateful-sequence class methods. METHOD-NAME is a
string."
;; If we found a next image, progress was made
t))
+;; * Child Actions
+(defclass ms-child-action (ms-action) ()
+ "Base class for child actions."
+ :abstract t)
+
+(cl-defmethod ms-forward-child ((obj ms-action))
+ "Return the next direct child heading and advance the marker.
+Marker is moved to the end of the heading if no matching child is
+found."
+ (if-let* ((marker (ms-marker obj))
+ (heading (ms-heading obj))
+ (target-level (1+ (org-element-property :level heading)))
+ (next (ms--contents-map
+ heading 'headline
+ (lambda (child)
+ (and (= target-level (org-element-property :level child))
+ (> (org-element-begin child) marker)
+ child))
+ nil t)))
+ (prog1 next
+ (ms-marker obj (org-element-begin next)))
+ (ms-marker obj (org-element-end (ms-heading obj)))
+ nil))
+
+(cl-defmethod ms-backward-child ((obj ms-action))
+ "Return previous direct child heading and advance the marker backward.
+Marker is moved to the beginning of the heading if no matching
+child is found."
+ (if-let* ((marker (ms-marker obj))
+ (heading (ms-heading obj))
+ (target-level (1+ (org-element-property :level heading)))
+ ;; We have to get all the children and find the last match
+ (next (car
+ (last
+ (ms--contents-map
+ heading 'headline
+ (lambda (child)
+ (and (= target-level (org-element-property :level
child))
+ (< (org-element-begin child) marker)
+ child)))))))
+ (prog1 next
+ (ms-marker obj (org-element-begin next)))
+ (ms-marker obj (org-element-begin (ms-heading obj)))
+ nil))
+
;; ** Default Child Action
-(defclass ms-child-action-slide (ms-action) ()
+(defclass ms-child-action-slide (ms-child-action)
+ ((child
+ :initform nil
+ :documentation "Current child."))
"Default child action. Children are independent slides.")
(cl-defmethod ms-step-forward ((obj ms-child-action-slide))
;; For child slides, we make a slide out of the next child heading and
advance
;; our progress forward to the end of that child
- (when-let ((child (ms-forward-child obj)))
- ;; TODO convert this to a push-sequence call
- (ms--make-slide child (oref ms--deck slide))))
+ (let (progress)
+ (when-let ((child (oref obj child)))
+ (setq progress (ms-step-forward child))
+ (unless progress
+ (ms-final child)
+ (oset obj child nil)))
+ (unless progress
+ (when-let ((child (ms-forward-child obj)))
+ ;; TODO transitive action customization
+ (let ((child (ms--make-slide child (oref ms--deck slide))))
+ (ms-init child)
+ (oset obj child child))
+ (setq progress (org-element-begin child))))
+ progress))
(cl-defmethod ms-step-backward ((obj ms-child-action-slide))
;; For child slides, we make a slide out of the previous child heading and
;; advance our progress backward to the beginning of that child
+ (let (progress)
+ (when-let ((child (oref obj child)))
+ (setq progress (ms-step-backward child))
+ (unless progress
+ (ms-final child)
+ (oset obj child nil)))
+ (unless progress
+ (when-let ((child (ms-backward-child obj)))
+ ;; TODO transitive action customization
+ (let ((child (ms--make-slide child (oref ms--deck slide))))
+ (ms-end child)
+ (oset obj child child))
+ (setq progress (org-element-begin child))))
+ progress))
+
+(cl-defmethod ms-end :after ((obj ms-child-action-slide))
(when-let ((child (ms-backward-child obj)))
- ;; TODO convert this to a push-sequence call
- (ms--make-slide child (oref ms--deck slide))))
+ (let ((child (ms--make-slide child (oref ms--deck slide))))
+ (ms-end child)
+ (oset obj child child))))
+
+(cl-defmethod ms-final :after ((obj ms-child-action-slide))
+ (when-let ((child (oref obj child)))
+ (ms-final child)))
;; ** Inline Child Action
;; While the basics of making a child out of the next heading are the same, an
@@ -1968,7 +1857,7 @@ stateful-sequence class methods. METHOD-NAME is a
string."
;; TODO every-child action
;; TODO override the child's own child action
-(defclass ms-child-action-inline (ms-action)
+(defclass ms-child-action-inline (ms-child-action)
((children
:initform nil
:documentation "Children that have been instantiated."))
@@ -1991,9 +1880,10 @@ stateful-sequence class methods. METHOD-NAME is a
string."
:inline t
;; TODO this won't compose at all
:slide-action-args '(:include-restriction t
:with-children t)
- :child-action 'none))
- (success (ms-init child)))
- (push child (oref obj children))
+ :child-action 'none)))
+ (progn (ms-init child)
+ (setq progress t)
+ (push child (oref obj children)))
(setq exhausted t))))
;; Don't return any child objects to the deck or it will treat them like
;; slides
@@ -2008,10 +1898,11 @@ stateful-sequence class methods. METHOD-NAME is a
string."
;; If the child didn't make progress, narrow it away
(unless progress
- (let ((finished (pop (oref obj children)))
- (heading (ms-backward-child obj))) ; for marker effects 💡
+ (let* ((finished (pop (oref obj children)))
+ (heading (ms-heading finished)))
+ (ms-backward-child obj) ; for marker effects 💡
+ ;; TODO do this with overlays in a nested child ☢️
(when heading
- ;; TODO narrow's final method can handle this 😼
(narrow-to-region (point-min)
(org-element-begin heading)))
(ms-final finished)
@@ -2021,24 +1912,21 @@ stateful-sequence class methods. METHOD-NAME is a
string."
(not (null progress))))
(cl-defmethod ms-end :after ((obj ms-child-action-inline))
- (let (step exhausted)
+ (let (exhausted)
(while (not exhausted)
;; If the child didn't make progress, try to load up the next child
(if-let* ((child-heading (ms-forward-child obj)))
(let* ((child (ms--make-slide
child-heading
(oref ms--deck slide)
- :slide-action #'ms-action-narrow
:inline t
;; TODO this won't compose at all
+ :slide-action #'ms-action-narrow
:slide-action-args '(:include-restriction t
:with-children t)
- :child-action 'none))
- (result (ms-end child)))
- (push child (oref obj children))
- (when (eq result 'step)
- (setq step 'step)))
- (setq exhausted t)))
- step))
+ :child-action 'none)))
+ (ms-end child)
+ (push child (oref obj children)))
+ (setq exhausted t)))))
(cl-defmethod ms-final :after ((obj ms-child-action-inline))
(mapc #'ms-final (oref obj children)))
diff --git a/test/demo.org b/test/demo.org
index 77e6a84c34..97b6e76b6b 100644
--- a/test/demo.org
+++ b/test/demo.org
@@ -2,17 +2,66 @@
#+author: Positron
#+email: contact@positron.solutions
-* Test End
+* Breadcrumbs
+This information goes deep
+** Deep
+And it will go deeper still yet
+*** Deeper
+The rabbit hole has only the bounds of your imagination
+**** Deepest?
+Wow, these breadcrumbs are very high-carb
+***** Okay Deep Enough!
+How many levels of headings could there be?
+* Hidden Babel Slide
+
+This slide has a child, but it will not be displayed. It will only run the
babel block within, which finds and updates the text below:
+
+Can has display?
+** No Display! Only Execute!
:PROPERTIES:
+:SLIDE_ACTION: nil
:SLIDE_SECTION_ACTIONS: ms-action-babel
:END:
-#+attr_methods: foo end
+These three org blocks will not be displayed since this slide has no slide
action. They will however execute when navigating forward and backward. Note
these features:
+
+- Blocks can have methods
+- Multiple blocks can have the init, end, and final method. They are always
executed top to bottom. This allows better code re-use.
+
+#+attr_methods: end init
#+begin_src elisp :results none
- (message "okay")
+ ;; No need to deal with restriction or restore point.
+ (org-up-heading-safe)
+ (if (re-search-forward "\?" nil t)
+ (setq-local ms-can-has-overlay
+ (make-overlay (match-end 0) (match-end 0)))
+ (message "Ouchie, the document changed!"))
+#+end_src
+
+Some extra init can also be returned to with step backwards
+#+attr_methods: init step-backward
+#+begin_src elisp :results none
+ (overlay-put ms-can-has-overlay 'after-string
+ (propertize " No display! Only execute!"
+ 'face 'error))
+#+end_src
+
+When going backwards, we begin at the end, which can also be stepped forwards
to
+#+attr_methods: step-forward end
+#+begin_src elisp :results none
+ (overlay-put ms-can-has-overlay 'after-string
+ (propertize " No display! Only execute!"
+ 'face 'success))
+#+end_src
+
+Our cleanup is always run
+#+attr_methods: final
+#+begin_src elisp :results none
+ (when (bound-and-true-p ms-can-has-overlay)
+ (delete-overlay ms-can-has-overlay)
+ (makunbound 'ms-can-has-overlay))
#+end_src
* Inline Children
:PROPERTIES:
-:SLIDE_CLASS: ms-slide :compose t
:SLIDE_CHILD_ACTION: ms-child-action-inline
:END:
- You won't believe these animations
@@ -35,16 +84,6 @@ Positron is deeply committed to bringing you the finest in:
- Pineapple 🍍
- Apple 🍎
- Pen 🖊️
-* Breadcrumbs
-This information goes deep
-** Deep
-And it will go deeper still yet
-*** Deeper
-The rabbit hole has only the bounds of your imagination
-**** Deepest?
-Wow, these breadcrumbs are very high-carb
-***** Okay Deep Enough!
-How many levels of headings could there be?
* Flat Slide
:PROPERTIES:
:SLIDE_ACTION: ms-action-narrow :with-children t
@@ -59,43 +98,12 @@ This slide shows its child headings inline.
** Red Team
- Uses some metasploit and calls it a day
- Failure is an option
-* Hidden Babel Slide
-:PROPERTIES:
-:SLIDE_CLASS: ms-slide :compose t
-:END:
-This slide has a child, but it will not be displayed. It will only run the
babel block within, which finds and updates the text below:
-
-Can has display?
-** No Display! Only Execute!
-:PROPERTIES:
-:SLIDE_ACTION: nil
-:SLIDE_SECTION_ACTIONS: ms-action-babel
-:END:
-#+attr_methods: step-backward final
-#+begin_src elisp :results none
- (when ms-can-has-overlay
- (delete-overlay ms-can-has-overlay))
-#+end_src
-#+attr_methods: step-forward end
-#+begin_src elisp :results none
- ;; No need to deal with restriction or restore point.
- (org-up-heading-safe)
- (when (re-search-forward "\?" nil t)
- (setq-local ms-can-has-overlay
- (make-overlay (match-end 0) (match-end 0)))
- (overlay-put ms-can-has-overlay 'after-string
- (propertize " No display! Only execute!"
- 'face 'error))
- (message "Ouchie, the document changed!"))
-#+end_src
* Image Slides
:PROPERTIES:
:SLIDE_SECTION_ACTIONS: ms-action-image
:END:
This is an image slide. You can view the images inline using
~org-toggle-inline-images~. Each image will be opened in a full-screen buffer,
which is configured to act as a slide, so it still responds to the keybindings.
-TODO display images inline when this action is initializing, which is after
narrow.
-
#+ATTR_HTML: :width 45%
[[./images/emacsen4.jpeg]] [[./images/self-care5.jpeg]]
#+ATTR_HTML: :width 45%
@@ -107,7 +115,7 @@ TODO display images inline when this action is
initializing, which is after narr
Both backwards and forward are supported on this slide.
-#+attr_methods: init
+#+attr_methods: init end
#+begin_src elisp :results none
(setq-local overlays nil)
(goto-char (point-min))
@@ -132,21 +140,11 @@ Both backwards and forward are supported on this slide.
(mapc (lambda (o) (overlay-put o 'display "🥞🥞")) overlays)
#+end_src
+#+attr_methods: step-forward end
#+begin_src elisp :results none
(mapc (lambda (o) (overlay-put o 'display "🥞🥞🥞")) overlays)
#+end_src
-#+attr_methods: end
-#+begin_src elisp :results none
- (setq-local overlays nil)
- (goto-char (point-min))
- (while (re-search-forward "overlay" nil t)
- (let ((overlay (make-overlay (match-beginning 0)
- (match-end 0))))
- (overlay-put overlay 'display "🥞🥞🥞")
- (push overlay overlays)))
-#+end_src
-
#+attr_methods: final
#+begin_src elisp :results none
(mapc #'delete-overlay overlays)
- [nongnu] elpa/dslide 5c4728025e 111/230: dslide-backward -> dslide-presentation-backward, (continued)
- [nongnu] elpa/dslide 5c4728025e 111/230: dslide-backward -> dslide-presentation-backward, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide e38a7ff5ac 125/230: Introduction in demo, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 4a85855383 133/230: remove redundant :after, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide d6f732a080 145/230: collect animation code, use the centralized error indication, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 9cc2872b4b 050/230: update readme to reflect reality, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide b8a70b893d 052/230: options for image action, include-linked, refresh, kill-buffer, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide af7169b85b 044/230: helpful package high-level comments, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 0d9518c64e 049/230: Include demo org for feedback on configuration markup, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 0016bc71aa 058/230: pushing some changes to the demo reflecting config API updates, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide d0a0678463 070/230: Removed face remapping (it was sent to master-of-ceremonies), ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 618b803f95 067/230: !refactor Telescopio, the parents now call through their children,
ELPA Syncer <=
- [nongnu] elpa/dslide bdd5fff8d6 064/230: moving some code for packaging, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide a462b0a4ba 062/230: babel blocks should only clear results when configured to do so, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide aed4afd84a 063/230: implement hiding children, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 199bb5b68b 079/230: Properties standardized to MS_ prefix, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide ada6553434 080/230: missed a few updates to property names, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide fca6e33a6c 060/230: Properly declare generic methods, reconcile documentation, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 4af0c6b990 084/230: Remove vestigal push-* code, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 0cbd0b7bab 081/230: Remove vestigal ms-slide-hook, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 1d61b6ffc1 083/230: Codify the hooks and lifecycle feedback messages, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 31fc027f52 057/230: !temporary basic composition support, ELPA Syncer, 2024/07/07