[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/dslide dddbc58e20 020/230: The repackaging. org-tree-slide
|
From: |
ELPA Syncer |
|
Subject: |
[nongnu] elpa/dslide dddbc58e20 020/230: The repackaging. org-tree-slide -> macro-slides |
|
Date: |
Sun, 7 Jul 2024 19:00:08 -0400 (EDT) |
branch: elpa/dslide
commit dddbc58e201d55f3c084846a124aedef1967d762
Author: Psionik K <73710933+psionic-k@users.noreply.github.com>
Commit: Psionik K <73710933+psionic-k@users.noreply.github.com>
The repackaging. org-tree-slide -> macro-slides
Signed-off-by: Psionik K <73710933+psionic-k@users.noreply.github.com>
---
.gitignore | 1 +
ChangeLog | 277 ------
README.org | 503 ++++------
macro-slides.el | 2523 +++++++++++++++++++++++++++++++++++++++++++++++
org-tree-slide-compt.el | 50 -
org-tree-slide.el | 1080 --------------------
6 files changed, 2715 insertions(+), 1719 deletions(-)
diff --git a/.gitignore b/.gitignore
index ed45a5dc79..d94b62df30 100644
--- a/.gitignore
+++ b/.gitignore
@@ -2,3 +2,4 @@ README.html
index.html
*.elc
.DS_Store
+trash
\ No newline at end of file
diff --git a/ChangeLog b/ChangeLog
deleted file mode 100644
index 091864215e..0000000000
--- a/ChangeLog
+++ /dev/null
@@ -1,277 +0,0 @@
-2023-03-05 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el: This package requires Emacs 25.2 or later
- - outline-hide-subtree, outlineshow-children, and outline-show-subtree
are NOT defined in outline.el contained in Emacs 25.1 or earlier
- - Users of Emacs 25.1 or earlier can still use org-tree-slide.el by
loading org-tree-slide-compt.el before activating org-tree-slide.el.
-
-2023-02-23 Lukas Zumvorde <lukaszumvorde@web.de>
-
- * org-tree-slide.el: Prevent warning messages during native compilation
- Add line breaks to docstrings to shorten them to <80 characters per line
- Replace deprecated function calls with their new equivalents
- - hide-subtree -> outline-hide-subtree
- - show-children -> outline-show-children
- - show-subtree -> outline-show-subtree
- require face-remap file explicitly to ensure face-remap-remove-relative
is loaded
- Add missing type definition to defcustom of
org-subtree-slide-heading-level-{1,2,3,4}
-
-2020-06-11 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el: Depends on emacs 24.3
- Replace org-tree-slide--narrowing-p with buffer-narrowed-p.
-
-2020-06-05 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el (org-tree-slide-indicator): New plist to control
showing messages in mini buffer
-
-2020-01-14 Norman Walsh <ndw@nwalsh.com>
-
- * org-tree-slide.el: Add support for date header (#31)
-
-2019-07-30 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el (org-tree-slide-content--pos): Rename
-
-2019-06-30 Boruch Baum <boruch_baum@gmx.com>
-
- * org-tree-slide.el (org-tree-slide-content): Toggle back to slide
- presentation, to exact position where you left off.
- (org-tree-slide-content--pos): New variable to support this feature.
-
-2018-11-26 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el: Extract header colors from default face of frame
- - the implementation of `org-tree-slide-header-overlay-face' is updated
so that user don't need to set the variable explicitly. In case user customized
theme is updated after loading this package, an appropriate function for
updating the face spec should be run in `org-tree-slide-play-hook'. For
instance,
- (defun my-reload-header-face ()
- (face-spec-set 'org-tree-slide-header-overlay-face
- `((t (:bold t :foreground ,(face-foreground 'default)
- :background ,(face-background 'default))))))
- (add-hook 'org-tree-slide-play-hook #'my-reload-header-face)
-
-2018-09-06 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el: Support additional heading faces (#28)
- - outline-1 and outline-4 can be also emphasized.
-
-2017-11-30 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el: Added a hook for CONTENT viewing mode
-
-2016-05-14 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el: Merged breadcrumbs feature (#23) (by Matus)
- - org-tree-slide-breadcrumbs is added to show breadcrumbs in the header
-
-2015-12-23 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el: Added Version header
-
- * org-tree-slide.el: Added a tag for Melpa Stable
-
-2015-08-14 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el: 'COMMENT'-subtree will be hidden (by Stefano)
- - org-tree-slide--show-subtree is added
- - Subtrees that start with 'COMMENT' will be hidden during presentation
even though org-tree-slide-fold-subtrees-skipped is nil
- Thanks to Stefano BENNATI
-
-2015-08-09 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el: Added a flag to reveal subtrees to be skipped
- - org-tree-slide-fold-subtrees-skipped is added
- - The original idea was proposed by bennati (https://github.com/bennati)
- - org-tree-slide--heading-level-skip-p was revised so that the status
can be checked by providing an arbitrary level number.
-
-2015-02-27 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el: Hide org-clock related code
- - To reduce loading time, org-clock related code was hidden.
-
-2015-02-20 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el: Default keymap was changed
- - Due to many reports on conflicting key binding, `<left>' and
`<right>', these keymap changed to `C->' and `C-<'.
-
- * org-tree-slide.el: Add new hooks and rename old hooks
- - Added `org-tree-slide-before-move-next-hook' and
`org-tree-slide-before-move-previous-hook'
- - Renamed hooks. `org-tree-slide-mode-play-hook',
`org-tree-slide-mode-stop-hook', `org-tree-slide-mode-before-narrow-hook',
`org-tree-slide-mode-after-narrow-hook' will be obsoleted soon.
-
-2015-02-15 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el (org-tree-slide): Replace ots- with org-tree-slide--
- - According to the Coding Conventions provided from gnu.org, the prefix
for internal functions should be described with two hyphens to avoid name
conflicts with other packages.
-
-2015-02-14 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide: Refine displaying slide number in modeline
- - If 'lighter is specified, the slide number will be updated
aggressively, then it's slow. On the other hand, 'outside is specified which
will be shown quickly in the same position of 'lighter because it changes the
number only if a slide is moved to the next/previous slide.
-
- * org-tree-slide: Added two hooks
- - org-tree-slide-mode-before-narrow-hook
- - org-tree-slide-mode-after-narrow-hook
-
-2015-01-12 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el (ots-stop): Suppress an error message from org-timer
- - When the presentation start without any timer setting, `org-timer-stop'
reports an error "No timer running". Updated code supresses the report.
-
- * org-tree-slide.el (org-tree-slide-content): Hide skipped slides when
CONTENT mode
- - Use `ots-skip-outline-level' in `ots-slide-content' (#8)
- Thanks to Eike Kettner
- Headlines that are skipped in presentation don't need to show up when
- displaying contents.
-
-2013-07-21 Takaaki ISHIKAWA <takax@ieee.org>
-
- * org-tree-slide.el (ots-count-slide): Revised to distinguish status
- [-/-] ... before first heading and no headings in the buffer
- [-/%d] ... before first heading
- [%d/%d] ... slides
-
- * org-tree-slide.el: Support no headings
- - org-tree-slide-move-next-tree and org-tree-slide-move-previous-tree
- - Removed hide-subtree to avoid an error
- - ots-display-tree-with-narrow
- - ots-before-first-heading-p is used to wrap hide-subtree
- - (org-cycle-hide-drawers 'all) is disabled to speed up
-
-2013-02-19 Takaaki ISHIKAWA <takax@ieee.org>
-
- * org-tree-slide.el (org-tree-slide-never-touch-face): Added a flag
- If this flag is `t', face settings wil NOT be touched.
-
- * org-tree-slide.el: support all trees are skipped
- - ots-move-to-the-first-heading
- - ots-all-skipped, as a flag
- - ots-heading-skip-p
- - ots-heading-level-skip-p
- - ots-heading-done-skip-p
- - ots-heading-skip-comment-p
- - ots-outline-select-method: [-/-] will be shown in mode line
-
- * org-tree-slide.el (ots-count-slide): remove unused code
-
-2013-02-17 Takaaki ISHIKAWA <takax@ieee.org>
-
- * org-tree-slide.el (org-tree-slide-skip-comments-toggle): Added a
toggle
-
-2013-02-12 Takaaki ISHIKAWA <takax@ieee.org>
-
- * org-tree-slide.el: Issues #2, #5, #7
- - Added org-tree-slide-skip-comments to skip a tree with COMMENT (#5)
- Thanks to Eric S Fraga
- - Remove brackets from title (#7)
- - Added org-tree-slide-activate-message and
- org-tree-slide-deactivate-message to specify messages in mini-buffer
(#2)
-
-2013-01-27 Takaaki ISHIKAWA <takax@ieee.org>
-
- * org-tree-slide.el: Added hooks for start and stop presentation
-
-2012-11-21 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el: Support dark color theme (by @uk-ar)
- Thanks to ARISAWA-san.
-
-2012-01-11 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el: Add autoload magic comments
-
-2011-12-18 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el (org-tree-slide-move-next-tree): Fix a bug
- Support an org buffer without any header
-
-2011-12-17 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el: org-tree-slide-skip-done set nil as default
-
-2011-12-12 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el: Remove auto-play function (TBD)
- Auo-play function is under consideration as a future work.
-
-2011-12-09 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el: Add an option to control modeline display
-
-2011-12-08 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el (ots-update-modeline): Reduce redundant processing
-
-2011-12-07 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el: Add a new profile to control narrowing status
- - You can control a status of narrowing or not by this profile.
- Assigned a single key to `org-tree-slide-mode' is recommended, like
- (global-set-key (kbd "<f8>") 'org-tree-slide-mode)
- - Modify the way to display the current slide number.
- Replace " TSlide" by slide number in mode-line, like [1/10].
-
- * org-tree-slide.el: Support displaying a slide number in a mode-line.
-
- * org-tree-slide.el: Adopt minor mode
- org-tree-slide adopt a minor mode!
- org-tree-slide-play and org-tree-slide-stop are replaced
- by org-tree-slide-mode.
- When you make org-tree-slide-mode active, org-tree-slide-play is called.
- Deactive it, org-tree-slide-stop will be called automatically.
-
-2011-12-06 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el: Support TITLE/AUTHOR/EMAIL in a header
- If #+TITLE:, #+AUTHOR:, or #+EMAIL: has a description in your org
buffer,
- it will be used in the slide header.
-
-2011-12-05 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el: Fix an issue of title display
-
- * org-tree-slide.el: Fix the end of slide for skip ccontrol
-
- * org-tree-slide.el (org-tree-slide-skip-outline-level):
- Add skip control by heading level. Skip the current slide if the level
- is higher than or equal to this variable.
-
-2011-12-02 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el: Change function names, ots- is introduced.
- Two profiles were defined:
- org-tree-slide-simple-profile (no effect, no header)
- org-tree-slide-presentation-profile (slide-in effect, title header)
-
-2011-11-02 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el (tree-slide-content):
- Add CONTENT view to see all the subtrees.
- You can show the index of your slide using CONTENT view during
slideshow.
- Find a tree that you want to restart your slideshow, and just type
<right>.
-
-2011-10-30 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el (tree-slide-slide-in): Add slide-in visual effect
- If you don't like this effect, use (setq tree-slide-slide-in-effect
nil).
- You can also control the distance of moving slide-in trees, use
- `tree-slide-slide-in-brank-lines'.
-
- * org-tree-slide.el (tree-slide-slide-in-waiting):
- Add a variable to control slide-in duration.
- If you feel the slide-in speed so fast, then set this value bigger like
- `(setq tree-slide-slide-in-waiting 0.05)'
-
-2011-10-28 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el (tree-slide-play): Add timer to count down
presentation
- By default, timer will NOT be activated. If you use a count down timer,
- please use prefix (C-u) when starting up slide view. Which means
- `C-u C-x sp ' is the right command.
-
- * org-tree-slide.el: Add play and stop function, and show slide header
- To play the slide, type `C-x s p'.
- To stop the slide, type `C-x s s'.
-
- * org-tree-slide.el: Add a function to change mode-line during
presentation
-
-2011-09-28 Takaaki ISHIKAWA <takaxp@ieee.org>
-
- * org-tree-slide.el: Initial release
diff --git a/README.org b/README.org
index a4593ee0d9..4fb04a53a3 100644
--- a/README.org
+++ b/README.org
@@ -1,315 +1,194 @@
-#+title: README for Org Tree Slide
-#+author: Takaaki Ishikawa
-#+email: takaxp@ieee.org
-#+date: [2023-08-26 Sat 22:20]
-#+startup: content
-
-[[http://melpa.org/#/org-tree-slide][http://melpa.org/packages/org-tree-slide-badge.svg]]
-[[http://stable.melpa.org/#/org-tree-slide][http://stable.melpa.org/packages/org-tree-slide-badge.svg]]
-
-#+caption: An example demo of org-tree-slide
-[[https://github.com/takaxp/contents/blob/master/org-tree-slide/demo1.gif]]
-
-* 1. What's this?
-
-The main purpose of this elisp is to handle each tree in an org buffer as a
slide by simple narrowing. This emacs lisp is a minor mode for Emacs Org-mode.
-
-Main features:
-
- - Live editable presentation
- - Fast switching of narrowing/widen
- - TODO pursuit with narrowing
- - Displaying the current number of slides in mode line
- - CONTENT view during a presentation
- - Slide-in effect
- - Slide header from org file's header
- - Countdown timer
-
-** 1-1. Related packages
-
-There are various packages to make a presentation with org-mode. See
[[http://orgmode.org/worg/org-tutorials/non-beamer-presentations.html]]. For
more simple use,
[[https://github.com/zonuexe/emacs-presentation-mode][presentation.el]] may
suitable.
-
-* 2. Install
-
-1. Put this elisp into your load-path
-2. Add =(require 'org-tree-slide)= in your =.emacs=
-
-OR
-
-1. Eval: =(auto-install-from-url
"https://raw.github.com/takaxp/org-tree-slide/master/org-tree-slide.el";)= (for
auto-install users)
-2. Add =(require 'org-tree-slide)= in your =.emacs=
-
-Then open an org file, just type =C-<= and =C->=, which means =C-M-,= and
=C-M-.=, you can see a presentation will begin with a header, slide-in effect,
and slide number in mode line.
-
-It is recommended to change the keybindings to make your presentation
smoothly. Here is an example.
-
-#+begin_src emacs-lisp
-(with-eval-after-load "org-tree-slide"
- (define-key org-tree-slide-mode-map (kbd "<f9>")
'org-tree-slide-move-previous-tree)
- (define-key org-tree-slide-mode-map (kbd "<f10>")
'org-tree-slide-move-next-tree)
- )
-#+end_src
-
-** 2.1 el-get recipe
-
-If you are an [[https://github.com/dimitri/el-get][el-get]] user, just do
-
-: M-x el-get-install RET org-tree-slide
-
-** 2.2 MELPA
-
-Now, you can install `org-tree-slide' via
[[http://melpa.org/#/org-tree-slide][MELPA]].
-
-** 2.2 Requirements
- - Org-mode 6.33x or higher version is required.
- - This elisp doesn't require any additional packages.
- - Emacs 25.2 or later is required. But users of Emacs 25.1 or earlier (at
least 24.4) can still use this package. Please load =org-tree-slide-compt.el=
before activating org-tree-slide.el.
-
-** 2.3 additional package (moom.el)
-
-Normally, presentations will appear in full screen or frame maximized.
[[https://github.com/takaxp/moom#org-mode-org-tree-slide][moom]] is useful in
such cases since the package can change frame position and size by keyboard and
the font size will be increased suitably for your presentation.
-
-* 3. Recommended settings
-
-Assigning a single key to =org-tree-slide-mode= is recommended.
-
-#+begin_src emacs-lisp
-(global-set-key (kbd "<f8>") 'org-tree-slide-mode)
-(global-set-key (kbd "S-<f8>") 'org-tree-slide-skip-done-toggle)
-#+end_src
-
-OR
-
-#+begin_src emacs-lisp
-(define-key org-mode-map (kbd "<f8>") 'org-tree-slide-mode)
-(define-key org-mode-map (kbd "S-<f8>") 'org-tree-slide-skip-done-toggle)
-#+end_src
-
-* 4. Profiles
-
-Three useful profiles are available. Please select a profile that is the most
suitable for your using scenario.
-
-If you select =simple= profile, call the following command while
=org-tree-slide-mode= is ON.
-
-#+begin_src emacs-lisp
-M-x org-tree-slide-simple-profile
+#+title: Macro Slides
+#+author: Positron
+#+email: contact@positron.solutions
+
+* Installation
+This isn't on a package archive yet. Subscribe to Positron's
[[https://www.youtube.com/@Positron-gv7do][YouTube]] for updates.
+ #+begin_src elisp
+ ;; package-vc
+ (package-vc-install
+ '(macro-slides
+ :url "https://github.com/positron-solutions/macro-slides.git";))
+
+ ;; using elpaca's with explicit recipe
+ (use-package macro-slides
+ :elpaca (macro-slides :host github
+ :repo "positron-solutions/macro-slides"))
+
+ ;; straight with explicit recipe
+ (use-package macro-slides
+ :straight (macro-slides :type git :host github
+ :repo "positron-solutions/macro-slides"))
+
+ ;; or use manual load-path & require, you brave yak shaver
+ #+end_src
+** Try It Out
+With just defaults, run ~ms-start~ on your existing documents. You can load
the examples in the =/test= directory to see a showcase of configuration
behavior.
+* Overview
+- A presentation framework that can incorporate *anything* Emacs does
+- Any buffer can be part of a presentation sequence
+- Present Org documents with babel integration
+- Extensible presentation sequences and display options
+** Simple User Interface
+Fully programmable sequences behind a two-button interface:
+- ~ms-forward~
+- ~ms-backward~
+** Present Org Documents
+- Document header generated from keywords
+- Breadcrumbs
+- Every heading and child heading is a slide
+** Fully Programmable
+- Configurable slide behavior using pre-built actions
+- Convenient API for quickly writing reliable custom actions
+- Integration with Elisp programs, arbitrary Emacs buffers, and scripting with
Org Babel
+- Custom class support for extending the framework
+** Status
+👷🛠️ Version 0.1.0 to begin receiving API feedback and feature requests etc.
Please check the issues and weigh in on other users proposals and PR's.
+* Features
+** Contents Navigation
+Call ~ms-contents~ to show a contents overview. Calling ~ms-forward~ and
~ms-backward~ in the contents can quickly move through headings. Call
~ms-start~ again to resume the presentation from that point.
+** Clean Buffer State
+The actual display is done in an indirect buffer. Your hooks and
customizations for presentation will not pollute your editing buffer. Dirty
state will not pile up in your presentation buffer, greatly increasing
reliability even if your custom Elisp scripting is sloppy.
+** Follow Along
+If you display the slideshow in one window or frame, you can configure the
point to follow the slide in the base buffer, enabling you to see the full
markup and even edit the presentation while developing your customizations.
+* Glossary
+- *Deck*: an object that is used to relate the display and base buffer and is
the root of all sequences
+- *Slide*: an object that interprets an org heading to hydrate its actions
+- *Action*: an object that responds to ~ms-forward~ and ~ms-backward~ calls
and implements lifecycle methods to initialize and clean up state
+- *Step*: a single call to ~ms-foward~ or ~ms-backward~, usually delegated
down to ~ms-step-forward~ and ~ms-step-backward~ methods
+
+- *Contents*: use org folding to create a view of folded headings to quickly
navigate slides
+- *Display Buffer*: the slides are shown in an indirect buffer that is cloned
from your org document buffer. The source is called the *base buffer*. Check
for the =deck: my-presentation.org= buffer name
+- *Buffer-Slide*: When integrating a buffer into the presentation,
~ms-buffer-slide-mode~ sets up the keybindings and links the buffers via the
deck object, enabling the presentation to control the buffer.
+* Configuring
+Be sure to check =M-x= ~customize-group~ =macro-slides= to see all declared
custom variables.
+
+Many settings can be configured at the global level through customize
variables, the document level through keywords, and the slide level through the
property drawer.
+
+There's a lot of hooks and variables. All of the variables are configured to
recommended defaults except hooks, which would depend on other packages usually.
+** Recommended MOC Settings
+The out-of-the-box experience can be a bit messy due to property drawers,
keywords, and babel blocks that you might include. You probably want to hide
these elements. Master of Ceremonies contains some flexible hiding that can be
updated with each slide and turned on and off only when the slideshow is active.
+*** TODO Hooks
+** Heading Properties
+Headings are treated as slides. Slides have actions. Actions are configured
in the property drawer.
+
+- =SLIDE_ACTION=: Usually narrows to the slide. Lifecycle encloses the
section.
+- =SECTION_ACTIONS:= Most commonly customized. You can list multiple actions.
Each one will step through its forward and backward steps.
+- =CHILD_ACTION=: Used to customize if and how child headings become slides
+
+Some actions must be fully enclosed by the lifecycle of a surrounding action,
such as narrowing to the headline and section before displaying a contained
list item-by-item.
+
+🚧 Likely in the future, actions will be composable and accept arguments, using
Lisp s-expressions. This API should be forward compatible by wrapping section
actions in the slide action and running the child after the slide action.
+*** Example
+Regular Org Mode markup is used to add actions to headings. See more examples
in the [[../test]] directory.
+#+begin_src org
+ ,* Full Screen Images
+ :PROPERTIES:
+ :SLIDE_ACTIONS: ms-action-images
+ :END:
+ ,#+attr_html: :width 50%
+ [[./images/emacsen4.jpeg]] [[./images/before-google3.jpeg]]
#+end_src
-
-If you want to use this setting as the default, put the following
configuration including recommended settings into your =.emacs=.
-
-#+begin_src emacs-lisp
-(when (require 'org-tree-slide nil t)
- (global-set-key (kbd "<f8>") 'org-tree-slide-mode)
- (global-set-key (kbd "S-<f8>") 'org-tree-slide-skip-done-toggle)
- (org-tree-slide-simple-profile))
-#+end_src
-
-=org-tree-slide-presentation-profile= and
=org-tree-slide-narrowing-control-profile= are also available.
-
-** 4-1. `Simple'
-
-This profile will display trees in your org buffer by simple narrowing. You
can change trees without =widen= command. Most of the visual effect is disabled.
-
-Type =M-x org-tree-slide-simple-profile= while =org-tree-slide-mode= is ON.
-
- 1. No header display
- 2. No slide-in effect
- 3. The cursor will move to the head of the buffer when exit
- 4. No slide number display in mode line
- 5. Display every type of tree except =org-comment-string= (e.g. COMMENT)
-
-** 4-2. `Presentation'
-
-This profile is the default setting of org-tree-slide. If an org buffer
includes =#+title:=, =#+email:=, and =#+author:=, org-tree-slide attempts to
use those variables in the slide header. A date in the header will be set with
the presentation of the day. You can enjoy a slide-in effect, the current slide
number in mode line.
-
-# A presentation with a count down timer is started by =M-x
org-tree-slide-play-with-timer=.
-
-If you want to show the content of your presentation, type =C-x s c= or =M-x
org-tree-slide-content=. All of the headings will be shown in a buffer like a
Table Of Content except some headings configured as skipping by
=org-tree-slide-skip-outline-level=. Find a heading that you want to show, and
type =C->=, the presentation will be resumed.
-
-It is possible to skip slides when a heading level is higher than or equal to
a value of =org-tree-slide-skip-outline-level=. see User variables.
-
-To exit a presentation, set =org-tree-slide-mode= OFF. The cursor move to the
head of the buffer and the trees will be rendered according to the value of
=#+startup:= if possible.
-
-=M-x org-tree-slide-presentation-profile=
-
- 1. Display header
- 2. Enable slide-in effect
- 3. The cursor will move to the head of buffer when exit
- 4. Display slide number in mode line
- 5. Display every type of tree except =org-comment-string= (e.g. COMMENT)
-
-** 4-3. `TODO Pursuit with narrowing'
-
-This profile will display trees restricted to =TODO status= without a header
and slide-in effect. It is very useful to concentrate your focus on the current
TODO item that is not done, and go to the next task by typing of =C->=. This is
"TODO Pursuit with narrowing". If you want to track every kind of tree
including finished items, toggle =M-x org-tree-slide-skip-done-toggle= OFF.
-
-When you exit =org-tree-slide-mode=, the cursor will keep the same position,
it is therefore possible to focus again by toggle =M-x org-tree-slide-mode=.
-
-If you feel the cursor moving is very slow, please change a value of
=org-tree-slide-modeline-display= to ='outside= or =nil=.
-
-=M-x org-tree-slide-narrowing-control-profile=
-
- 1. No header display
- 2. No slide-in effect
- 3. The cursor will keep the same position when exit
- 4. Display slide number in mode line
- 5. Display TODO trees only except =org-comment-string= (e.g. COMMENT)
-
-* 5. User variables
-
-#+caption: User variables
-|----+--------------------------------------------+---------------+---------|
-| | Variable | Default value | Select |
-|----+--------------------------------------------+---------------+---------|
-| 1 | org-tree-slide-skip-outline-level | 0 | Numeric |
-| 2 | org-tree-slide-header | t | Boolean |
-| 3 | org-tree-slide-slide-in-effect | t | Boolean |
-| 4 | org-tree-slide-cursor-init | t | Boolean |
-| 5 | org-tree-slide-slide-in-blank-lines | 10 | Numeric |
-| 6 | org-tree-slide-slide-in-waiting | 0.02 | Float |
-| 7 | org-tree-slide-heading-emphasis | nil | Boolean |
-| 8 | org-tree-slide-never-touch-face | nil | Boolean |
-| 9 | org-tree-slide-skip-done | nil | Boolean |
-| 10 | org-tree-slide-skip-comments | t | [*1] |
-| 11 | org-tree-slide-activate-message | Hello... | String |
-| 12 | org-tree-slide-deactivate-message | Quit, Bye! | String |
-| 13 | org-tree-slide-modeline-display | 'outside | [*2] |
-| 14 | org-tree-slide-fold-subtrees-skipped | t | Boolean |
-| 15 | org-tree-slide-breadcrumbs | " > " | String |
-| 16 | org-tree-slide-breadcrumbs-hide-todo-state | t | Boolean |
-| 17 | org-tree-slide-indicator | plist | [*3] |
-
-#+begin_quote
-[*1] { nil | t | 'inherit }
- t: skip only the current heading with COMMENT, child headings without
COMMENT will be shown,
- 'inherit: skip headings with COMMENT and its child headings,
- nil: show even if it has COMMENT.
-(note) =org-tree-slide-skip-comments-toggle= will switch between ~t~ and ~nil~
normally, but if =org-tree-slide-skip-comments= is specified as ~'inherit~,
then the toggle will switch between ~'inherit~ and ~t~.
-
-[*2] { nil | 'lighter | 'outside }
- 'outside: shown in the mode line outside of lighter,
- 'lighter: shown in lighter (slow),
- nil: nothing to be shown.
-
-[*3] '(:next " Next >>" :previous "<< Previous" :content "<< CONTENT >>")
- If you prefer to show nothing for entering content mode, then specify as
- '(:next " Next >>" :previous "<< Previous" :content nil)
-#+end_quote
-
-** 5-1. Useful settings for experts
-
-If you like this elisp, the following setting is more useful. Try it!
-
-In this case, =<f8>= / =<f9>= / =<f10>= / =<f11>= are assigned in order to
control org-tree-slide.
-
-#+begin_src emacs-lisp
-(when (require 'org-tree-slide nil t)
- (global-set-key (kbd "<f8>") 'org-tree-slide-mode)
- (global-set-key (kbd "S-<f8>") 'org-tree-slide-skip-done-toggle)
- (define-key org-tree-slide-mode-map (kbd "<f9>")
- 'org-tree-slide-move-previous-tree)
- (define-key org-tree-slide-mode-map (kbd "<f10>")
- 'org-tree-slide-move-next-tree)
- (define-key org-tree-slide-mode-map (kbd "<f11>")
- 'org-tree-slide-content)
- (setq org-tree-slide-skip-outline-level 4)
- (org-tree-slide-narrowing-control-profile)
- (setq org-tree-slide-skip-comments 'inherit)
- (setq org-tree-slide-skip-done nil))
+* Customizing
+** Sub-classing
+The deck and slide class as well as actions can all be sub-classed. Use the
existing sub-classes of actions as example code for writing other classes.
+** Babel Scripting
+You can write custom scripts into your presentation as Org Babel blocks.
These can be executed with the ~ms-action-babel~ action. You just need to
label your blocks with lifecycle methods if you want to be able to go forwards
and backwards. See the ~ms-action-babel~ class
+** Buffer Slides
+Use ~ms-buffer-slide-mode~ to integrate any buffer into your presentation.
Script your buffer-slide steps with regular babel blocks.
+** ~ms-start-function~
+Typically the mode is entered via commands that are to be bound outside of the
minor mode keymap. If these commands want to start the mode a specific way,
but they need to start the mode first, they just bind ~ms-start-function~ to
override the last step of starting the mode.
+* Package Pairings
+This package is focused on creating a linear presentation sequence. For
functionality not related to integrations into the ~ms-forward~ ~ms-backward~
interface, it is better to maintain separate packages and use hooks and babel
scripting.
+** Master of Ceremonies
+The [[https://github.com/positron-solutions/master-of-ceremonies][moc]]
package contains utilities for display & presentation frame setup that are not
specific to using Macro Slides.
+- *hide markup*
+- display a region full-screen
+- silence messages during presentation
+- hide the cursor or make it very subtle
+- extract notes and display them in a separate frame
+** Open Broadcaster Software
+Sacha Chua has written an OBS plugin integration helpful for video integration
[[https://github.com/sachac/obs-websocket-el][obs-websocket-el]].
+** Orgit
+~orgit~ can be used to show commits as links, which open with =ms-action-links=
+** moom.el
+The [[https://github.com/takaxp/moom#org-mode-org-tree-slide][moom]] package
contains some commands for resizing text and repositioning frames.
+* Domain Model
+This is a description of how the pieces of the program *must* fit together.
For any deep customization or hacking, the section is essential reading. At
the least, it will *greatly improve your success*.
+
+⚠️ Even if the current implementation differs, trust this domain model and
expect the implementation to approach it.
+
+- The user interface ~ms-forward~ and ~ms-backward~ is a concrete requirement
that drives most of the rest of the implementation and feature design.
+- There are several ways to linearize the tree structure of org headings and
to compose their presentation. Sequences of forward and backward actions must
be nested to accomplish many desirable goals.
+- Supporting nested sequences can be made to implement just about anything
while still keeping the user interface simple.
+** Stateful Sequence Class
+This class is the heart of providing the common user interface and convenient
implementation interface for extending the package.
+*** Command Pattern
+The basis of all undo systems is to implement reverse actions that decide
their behavior from the updated state or to save mementos that allow undoing
forward actions. This is the
[[https://en.wikipedia.org/wiki/Command_pattern][command pattern]].
+
+Navigating the linear sequence of a presentation is very similar to an undo
system. Log-backed architectures such as git or event-sourcing can similarly
be viewed as navigating to any point in a sequence by applying or rolling back
a sequence of changes.
+*** Setup & Teardown
+At the boundaries of a sequence of forward and reverse actions, it may be
necessary to build up or tear down some state. The stateful sequence adds
~ms-init~, ~ms-final~, and a variation of ~ms-init~, ~ms-end~.
+
+The role of ~ms-end~ is to perform initialization at the end. It is optional
as the default implementation is to call ~ms-int~ and then ~ms-step-forward~
until no more progress can be made. However, this may be costly or undesirable
due to side-effects.
+*** Indexing Via Point
+In order to support contents based navigation, we need to be able to play a
slide forward up to the current point. This may require instantiating some
parent slides and playing them forward to a child. To avoid the need for
parents to know about children, the ~goto~ method was introduced.
+*** Stateful Sequence Interface
+The conclusion of the command pattern, setup & teardown, and indexing via
point is the ~ms-stateful-sequence~ class. Anything that implements its
interface can be controlled by ~ms-forward~ and ~ms-backward~. The full
interface:
+
+- ~ms-init~ & ~ms-end~
+- ~ms-final~
+- ~ms-step-forward~ & ~ms-step-backward~
+- ~ms-goto~
+
+**** Re-Using Implementations
++ The default implementation of ~ms-end~ is achieved by just walking forward
from ~ms-init~, calling ~ms-step-forward~ until it returns =nil=.
+
++ Implementing ~ms-goto~ is optional as long as ~ms-init~ and
~ms-step-forward~ can implement ~ms-end~ and report their furthest extent of
progress accurately.
+
++ Ideally ~ms-forward~ & ~ms-backward~ along with ~ms-init~ & ~ms-end~ form a
closed system, but for the convenience of the implementer, it's fine to use an
idempotent ~ms-init~ as the ~ms-backward~ step if granular backward is
difficult or not valuable to implement.
+** Sequence Composition
+Navigating a tree involves depth. Descendants may care about what happened in
ancestors. Ancestors may care about what descendants leave behind. There may
be conventions about what happens when descending into a child or returning
from one.
+*** Call Stack Execution
+Like the command pattern is a helpful model for designing forward and
backwards presentation navigation, the
[[https://en.wikipedia.org/wiki/Call_stack][call stack]] is a helpful model for
understanding composition of our stateful sequences.
+
+In the model call stack, the caller & callee only cooperate at the call site
or by side-effects, aka globals. If callee is pure, the call site is the only
way that they communicate.
+
+A slide action can be seen as an impure function. Actions to display the
section might look at the buffer restriction state to determine if they need to
add themselves to the buffer restriction or completely take over display.
+*** Child, Section, and Slide
+It is extremely natural that a slide action will fill one of three roles:
+- Narrow to the contents its actions work on
+- Perform some steps on the region that has been narrowed to
+- Switch to child slides or orchestrate children in a shared buffer restriction
+**** Multiple Slide Property Keys
+These natural roles are why there are more than one heading property for
configuring actions. Each action is easier to implement if they only fill one
role. It is easier for the user to configure a slide if they only have to
declare one action. By breaking up the slide's typical actions, we can
configure with enough granularity to usually only touch one heading property.
+*** Trees & Stacks
+If something depends on something else existing or having been set up, its
lifetime must be fully encompassed by that other thing. Especially since we
are going forward & backward, cleanups must happen on both ends of a sequence.
+
+It is natural that a parent heading out-lives its child. User can take
advantage of this by using the document or higher level headings to store state
that needs to be shared by children. The ~final~ calls for those things can
call cleanup.
+*** Slides & Action Lifetime
+Actions live, for the most part, as long as the slide. Their ~ms-init~ method
is called at the very beginning. An action that reveals items must hide them
before the user first sees them.
+
+A consequence of this is that there are usually multiple actions alive at
once. Something has to hold onto them. Right now, it's the slide. There is
only one slide usually in play, and it holds a reference to its parent so that
it can "return". 🚧 In the future, the actions may hold onto child actions and
only one action might be alive at a time. This would be desirable. It just
takes some mild rework of the implementation.
+* Work In Progress 🚧
+Open issues and give feedback on feature requests. Contributions welcome.
+** Non-Graphic Display
+For terminals, the line-height based slide-in effect is not supported.
+** Descendant and Fallback Actions
+Cooperative child action configuration by looking up through parents, calling
through to the deck if there is no other default.
+** Composable Actions With Arguments
+We want to configure actions with lisp expressions:
+#+begin_src elisp :eval never
+ (ms-action-narrow :children t)
#+end_src
-
-* 6. Functions
-** Control functions
-
- - org-tree-slide-move-next-tree (=C->=)
- - org-tree-slide-move-previous-tree (=C-<=)
- - org-tree-slide-content (=C-x s c=)
-
-** Startup options
-
-These functions will toggle =org-tree-slide-mode= ON, automatically.
-
- - org-tree-slide-without-init-play
- - org-tree-slide-play-with-timer
-
-** Toggle variables
-
- - org-tree-slide-display-header-toggle
- - org-tree-slide-slide-in-effect-toggle
- - org-tree-slide-skip-done-toggle
- - org-tree-slide-skip-comments-toggle
- - org-tree-slide-heading-emphasis-toggle
-
-** Batch setting of user variables
-
- - org-tree-slide-simple-profile
- - org-tree-slide-presentation-profile
- - org-tree-slide-narrowing-control-profile
-
-** Hooks
-
- - org-tree-slide-play-hook
- - org-tree-slide-stop-hook
- - org-tree-slide-before-narrow-hook
- - org-tree-slide-after-narrow-hook
- - org-tree-slide-before-move-next-hook
- - org-tree-slide-before-move-previous-hook
-
-NOTE: For senior user, some hook were renamed, please update your
configurations
-
-* 7. Additional settings
-** Hide org-meta-line
-
-The following code could be useful if you want to make =#+= lines invisible
during presentation.
-
-#+begin_src emacs-lisp
-(with-eval-after-load "org-tree-slide"
- (defvar my-hide-org-meta-line-p nil)
- (defun my-hide-org-meta-line ()
- (interactive)
- (setq my-hide-org-meta-line-p t)
- (set-face-attribute 'org-meta-line nil
- :foreground (face-attribute 'default
:background)))
- (defun my-show-org-meta-line ()
- (interactive)
- (setq my-hide-org-meta-line-p nil)
- (set-face-attribute 'org-meta-line nil :foreground nil))
-
- (defun my-toggle-org-meta-line ()
- (interactive)
- (if my-hide-org-meta-line-p
- (my-show-org-meta-line) (my-hide-org-meta-line)))
-
- (add-hook 'org-tree-slide-play-hook #'my-hide-org-meta-line)
- (add-hook 'org-tree-slide-stop-hook #'my-show-org-meta-line))
+#+begin_src elisp :eval never
+ (ms-action-narrow (ms-action-items :animate nil))
#+end_src
-
-
-* 8. History
-
-see also
[[https://github.com/takaxp/org-tree-slide/blob/master/ChangeLog][ChangeLog]]
for details
-
-|---------+------------------+-----------------------------------------|
-| Version | Date | Description |
-|---------+------------------+-----------------------------------------|
-| v2.8.0 | 2015-02-20@21:27 | Changed Keymap, and renamed/added hooks |
-| v2.7.0 | 2013-07-21@05:21 | Support buffers without headings |
-| v2.6.0 | 2012-11-21@02:14 | Support dark color theme |
-| v2.5.0 | 2011-12-12@18:16 | Remove auto-play function (TBD) |
-| v2.4.0 | 2011-12-08@10:51 | Support TODO pursuit in a slideshow |
-| v2.3.0 | 2011-12-07@16:17 | Support displaying a slide number |
-| v2.2.0 | 2011-12-07@02:15 | Support minor mode |
-| v2.0.0 | 2011-12-01@17:41 | Add profiles and support org 6.33x |
-| v1.0.0 | 2011-09-28@20:59 | Release the initial version |
-
-* 9. Contact
-
-The author is Takaaki ISHIKAWA (takaxp@ieee.org).
-Feel free to email me or use a mention of twitter
([[https://twitter.com/#!/takaxp][@takaxp]])
-
-* 10. Videos
-
-We can watch some videos that kindly introduce =org-tree-slide.el=:
-- [[https://www.youtube.com/watch?v=vz9aLmxYJB0][Emacs Tips - How to Give
Presentations with Org Mode]] (presented by
[[https://www.youtube.com/channel/UCAiiOTio8Yu69c3XnR7nQBQ][System Crafters]])
-- [[https://www.youtube.com/watch?v=uSwJQIGMyPk][Show presentation using Org
Mode]] (presented by
[[https://www.youtube.com/channel/UC0ds7DW6IIl7mXcyz5vMEHQ][Blackberry Boy]])
-
-Thank you!
+** Sub-Sequence Call & Restore
+Sequences are often enclosed within other sequences, but there is currently no
support for pushing or popping states when entering or exiting sequences. It's
just not clear yet what cooperation might be necessary at sub-sequence
boundaries. Slide display looking at the restriction state is one such
boundary.
+** Non-Org Sequences
+There's no concrete reason why presentations need to start with Org mode
buffers. The deck object could have its org-specific functionality pushed down
to an org-mode class. The only requirement is to be able to hydrate some
stateful sequences, which may hydrate and call into sub-sequences, meaning
anything is pretty trivially possible.
+** Heading Filtering
+This was not implemented yet, but evidently some had been filtering their
headlines to only show TODO's in ~org-tree-slide~. Perhaps it is convenient to
filter some tags and prevent them from being instantiated, especially if they
will fail.
+* Thanks & Acknowledgments
+This package is a direct descendant of Takaaki ISHIKAWA's
[[https://github.com/takaxp/org-tree-slide][org-tree-slide]] package. Many of
the ideas and some of the implementations were either inherited or inspired by
ideas from that package. This package would not exist without the inspiration.
Thanks to everyone who contributed on org-tree-slide.
diff --git a/macro-slides.el b/macro-slides.el
new file mode 100644
index 0000000000..0ae961c685
--- /dev/null
+++ b/macro-slides.el
@@ -0,0 +1,2523 @@
+;;; macro-slides.el --- A presentation framework -*- lexical-binding: t; -*-
+;;
+;; Copyright (C) 2011-2023 Takaaki ISHIKAWA
+;; Copyright (C) 2024 Positron
+;;
+;; Author: Positron <contact@positron.solutions>
+;; Version: 0.1.0
+;; Package-Requires: ((emacs "29.2"))
+;; Maintainer: Positron <contact@positron.solutions>
+;; URL: https://github.com/positron-solutions/macro-slides
+;; Keywords: convenience, org-mode, presentation, narrowing
+;;
+;; Committers: Takaaki ISHIKAWA <takaxp at ieee dot org>
+;; Yuuki ARISAWA (@uk-ar)
+;; Eric S Fraga
+;; Eike Kettner
+;; Stefano BENNATI
+;; Matus Goljer
+;; Boruch Baum
+;;
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; Macro Slides is a highly programmable presentation framework that first
+;; displays Org files as presentations but also can integrate your presentation
+;; with any Emacs buffer and also with Org Babel. By integrating arbitrary
+;; Emacs Lisp into the simple forward-backward user interface, you can make
+;; anything Emacs does easy to present.
+;;
+;; See the README and manual M-x info-display-manual RET macro-slides RET.
+;;
+;; There are examples of using the features within the test directory.
+;;
+;; Requirement:
+;; org-mode 9.6.x or higher version
+;; The latest version of the org-mode is recommended.
+;; (see https://orgmode.org/)
+;;
+;; Usage:
+;; 1. Open an org-mode file
+;; 2. Run `ms-start'
+;;
+;; Note:
+;; - Customize variables, M-x customize-group RET macro-slides RET
+;;
+;; This package is a fork and mostly complete re-write of org-tree-slide by
+;; Takaaki ISHIKAWA. Thanks to everyone who worked on org-tree-slide over the
+;; years. The implementation ideas and features of org-tree-slide were a great
+;; inpsiration for this package.
+
+;;; Code:
+
+(require 'org)
+(require 'org-fold)
+(require 'face-remap)
+
+(eval-when-compile (require 'cl-lib))
+
+(defgroup macro-slides nil
+ "User variables for `macro-slides'."
+ :group 'outlines)
+
+(defcustom ms-base-follows-slide t
+ "Non-nil moves the base buffer point to the current slide.
+This happens whether the buffer is visible or not."
+ :type 'boolean
+ :group 'macro-slides)
+
+(defcustom ms-start-from 'first
+ "When starting, begin at `point' `first' slide.
+Any other value is equivalent to `first'.
+
+If the contents are shown first, the point will be on the
+configured slide.
+
+This only has effect when starting the mode or commands that
+implicitly start the mode.
+
+- `first': Always begin the slideshow from the very first slide.
+
+- `point': the slideshow always begins at the slide under point.
+
+You can achieve `first' behavior by calling `ms-first-slide'. If
+you want to navigate slides with the point, you should use the
+contents mode with `ms-contents'. To avoid losing your place,
+use `ms-slides' to toggle between the base buffer and slides
+buffer."
+ :type '(choice (const :tag "First slide" first)
+ (const :tag "Slide at point" point))
+ :group 'macro-slides)
+
+(defcustom ms-start-function #'ms-display-slides
+ "When starting the mode, this is the default starting function.
+It should usually call `ms-display-slides' or
+`ms-display-contents'. You can build commands that
+use `let' binding to temporarily set this variable in order to
+start with a specific starting function."
+ :type 'function
+ :group 'macro-slides)
+
+(defcustom ms-header t
+ "The status of displaying the slide header."
+ :type 'boolean
+ :group 'macro-slides)
+
+(defcustom ms-contents-header t
+ "Display header in contents buffer.
+When this is disabled, the keywords for title etc will remain
+visible, albeit scrolled away because of how `org-overview'
+works."
+ :type 'boolean
+ :group 'macro-slides)
+
+(defcustom ms-header-author t
+ "Show the email in the header.
+If there is a #+author: header, it will be used."
+ :type 'boolean
+ :group 'macro-slides)
+
+(defcustom ms-header-email t
+ "Show the email in the header.
+If there is a #+email: header, it will be used."
+ :type 'boolean
+ :group 'macro-slides)
+
+(defcustom ms-header-date t
+ "Show the date in the header.
+If there is a #+date: header, it will be used.
+The current time will be used as a fallback."
+ :type 'boolean
+ :group 'macro-slides)
+
+;; TODO make this number and support partial lines
+(defcustom ms-content-margin-top 2
+ "Specify the margin between the slide header and its content."
+ :type 'integer
+ :group 'macro-slides)
+
+(defcustom ms-slide-in-effect t
+ "Using a visual effect of slide-in for displaying trees."
+ :type 'boolean
+ :group 'macro-slides)
+
+;; TODO support partial lines
+(defcustom ms-slide-in-blank-lines 10
+ "Line height of the slide-in effect."
+ :type 'integer
+ :group 'macro-slides)
+
+(defcustom ms-feedback-messages
+ '(:start "Start! ▶"
+ :forward "Forward ➡"
+ :backward "⬅ Backward"
+ :contents "Contents ☰"
+ :stop "Finished! ■"
+ :after-last-slide "No more slides")
+ "Feedback messages for slide controls.
+Turn off by setting to nil. Plist keys:
+- :start `ms-start'
+- :forward `ms-forward'
+- :backward `ms-backward'
+- :contents `ms-contents'
+- :stop `ms-stop'"
+ :type 'plist
+ :group 'macro-slides)
+
+(defcustom ms-breadcrumb-face nil
+ "Face added to the list of faces for breadcrumbs.
+This can be a face name symbol or an anonymous font spec. It
+will be added to the face list, meaning it the original face's
+properties remain unless shadowed."
+ :type 'face
+ :group 'macro-slides)
+
+(defface ms-heading-level-1 '((t :inherit 'org-level-1))
+ "Org heading override."
+ :group 'macro-slides)
+
+(defface ms-heading-level-2 '((t :inherit 'org-level-2))
+ "Org heading override."
+ :group 'macro-slides)
+
+(defface ms-heading-level-3 '((t :inherit 'org-level-3))
+ "Org heading override."
+ :group 'macro-slides)
+
+(defface ms-heading-level-4 '((t :inherit 'org-level-4))
+ "Org heading override."
+ :group 'macro-slides)
+
+(defface ms-heading-level-5 '((t :inherit 'org-level-5))
+ "Org heading override."
+ :group 'macro-slides)
+
+(defface ms-heading-level-6 '((t :inherit 'org-level-6))
+ "Org heading override."
+ :group 'macro-slides)
+
+(defface ms-heading-level-7 '((t :inherit 'org-level-7))
+ "Org heading override."
+ :group 'macro-slides)
+
+(defface ms-heading-level-8 '((t :inherit 'org-level-8))
+ "Org heading override."
+ :group 'macro-slides)
+
+(defface ms-document-title '((t :inherit 'org-document-title))
+ "Org document title override."
+ :group 'macro-slides)
+
+(defface ms-document-info '((t :inherit 'org-document-info))
+ "Org document info override."
+ :group 'macro-slides)
+
+(defface ms-header-overlay-face '((t :inherit default))
+ "Face for `ms--header-overlay'."
+ :group 'macro-slides)
+
+(defcustom ms-breadcrumb-separator " 🢒 "
+ "Delimiter for breadcrumbs or nil to turn off breadcrumbs."
+ :type '(choice (const :tag "Don't display breadcrumbs" nil)
+ (string :tag "Delimiter"))
+ :group 'macro-slides)
+
+(defcustom ms-breadcrumbs-hide-todo-state t
+ "If non-nil, hide TODO states in the breadcrumbs."
+ :type 'boolean
+ :group 'macro-slides)
+
+(defcustom ms-start-hook nil
+ "Runs after the slide buffer is created but before first slide.
+Buffer is widened and fully visible."
+ :group 'macro-slides
+ :type 'hook)
+
+(defcustom ms-stop-hook nil
+ "Runs in the base buffer after stopping."
+ :group 'macro-slides
+ :type 'hook)
+
+(defcustom ms-slide-hook nil
+ "Runs after a slide has been switched to.
+This includes the first slide of start, when switching back from
+contents. It is run after any slide actions."
+ :group 'macro-slides
+ :type 'hook)
+
+(defcustom ms-contents-hook nil
+ "Runs last after switching to contents."
+ :group 'macro-slides
+ :type 'hook)
+
+(defcustom ms-after-last-slide-hook '(ms-stop)
+ "Run when forward is called at last slide."
+ :group 'macro-slides
+ :type 'hook)
+
+(defcustom ms-default-slide-action
+ #'ms-action-section
+ "Action class with lifecycle around the section actions.
+When stepping forward or backward, it is called before any
+section action. It's normal purpose is to update the buffer
+restriction before section-actions are run.
+
+You can configure this per-heading by setting the
+SLIDE_ACTION keyword. You can configure it for
+the document default by adding an SLIDE_ACTION
+keyword."
+ :type 'function
+ :group 'macro-slides)
+
+(defcustom ms-default-section-actions
+ '()
+ "Actions that run within the section display action lifecycle.
+It's value is a list of `ms-action' subclasses. Each
+subclass will be instantiated into an action object. See the
+`ms-action' class and its methods to learn about
+writing custom actions.
+
+Many section actions are no-op whenever the content doesn't
+contain any elements they act on. You can add classes to this
+list in order to have default behaviors for some org elements.
+
+You can configure this per-heading by setting the
+SLIDE_SECTION_ACTIONS keyword. You can configure it for the
+document default by adding an SLIDE_SECTION_ACTIONS keyword."
+ :type '(list function)
+ :group 'macro-slides)
+
+(defcustom ms-default-child-action
+ #'ms-child-action-slide
+ "Action run after section lifecycle.
+Value is an action class, usually extending
+`ms-child-action'. The usual purpose is to manage
+the child headings, which come after the section element.
+
+You can configure this per-heading by setting the
+SLIDE_CHILD_ACTION keyword. You can configure it for the
+document default by adding an SLIDE_CHILD_ACTION keyword."
+ :type 'function
+ :group 'macro-slides)
+
+(defcustom ms-default-class 'ms-slide
+ "A class to more deeply modify slide behavior.
+Value should be a custom class extending `ms'. You
+can override methods if the built-in implementation is
+insufficient. Consider upstreaming changes.
+
+You can configure this per heading by setting the SLIDE_CLASS
+property. You can configure it for the document default by
+adding an SLIDE_CLASS keyword."
+ :type 'symbol
+ :group 'macro-slides)
+
+(defcustom ms-default-deck-class 'ms-deck
+ "A class to more deeply modify overall deck behavior.
+Value should be a custom class extending `ms-deck'.
+Use this to modify the root-level behaviors, including switching
+to children and finding siblings. You can configure this for the
+document by adding the SLIDE_ROOT_CLASS keyword."
+ :type 'symbol
+ :group 'macro-slides)
+
+(defcustom ms-default-filter
+ #'ms-built-in-filter
+ "A function used to call next on children.
+The function used as actions should accept an org element, a
+`headline' type element and return it if it is a valid heading or
+return nil if it should be skipped.
+
+You can configure this per heading by setting the SLIDE_FILTER
+keyword. You can configure it for the document default by adding
+an SLIDE_FILTER keyword."
+ :type 'function
+ :group 'macro-slides)
+
+(defvar ms--debug nil
+ "Set to t for logging slides and actions.")
+
+;; Tell the compiler that these variables exist
+(defvar ms-mode)
+(defvar ms-buffer-slide-mode)
+
+(defvar-local ms-heading-level-1-cookie nil)
+(defvar-local ms-heading-level-2-cookie nil)
+(defvar-local ms-heading-level-3-cookie nil)
+(defvar-local ms-heading-level-4-cookie nil)
+(defvar-local ms-heading-level-5-cookie nil)
+(defvar-local ms-heading-level-6-cookie nil)
+(defvar-local ms-heading-level-7-cookie nil)
+(defvar-local ms-heading-level-8-cookie nil)
+(defvar-local ms-document-title-cookie nil)
+(defvar-local ms-document-info-cookie nil)
+
+(defvar-local ms--deck nil
+ "Active deck object.")
+
+(defvar-local ms--overlays nil
+ "Overlays used to hide or change contents display.")
+
+(defvar-local ms--header-overlay nil
+ "Flag to check the status of overlay for a slide header.")
+
+;; * Lifecycle
+
+(defvar-keymap ms-mode-map
+ :doc "The keymap for `ms' mode."
+ "<left>" #'ms-backward
+ "<right>" #'ms-forward
+ "<up>" #'ms-contents
+ "<down>" #'ms-start) ; TODO start is really toggle
+
+;;;###autoload
+(define-minor-mode ms-mode
+ "A presentation tool for Org Mode."
+ :init-value nil
+ :keymap ms-mode-map
+ :group 'macro-slides
+ (unless (eq 'org-mode (buffer-local-value
+ 'major-mode (current-buffer)))
+ (user-error "Not an org buffer")
+ (ms-mode -1))
+ (cond (ms-mode
+ ;; Create the indirect buffer and link it via the deck object.
+ (ms--ensure-deck)
+ (funcall (or ms-start-function
+ #'ms-display-slides)))
+ (t
+ (ms-stop))))
+
+(defun ms-live-p ()
+ "Check if a deck is associated so that commands can complete."
+ (and (or ms-mode
+ ms-buffer-slide-mode)
+ (bound-and-true-p ms--deck)
+ (ms-deck-live-p ms--deck)))
+
+;; TODO rename these functions to `switch-to'?
+(defun ms-display-slides ()
+ (ms--ensure-slide-buffer)
+ (ms--clean-up-state)
+ (oset ms--deck display-state 'slides)
+ (widen)
+ (org-fold-show-all)
+ (ms-init ms--deck)
+ ;; TODO rename this hook?
+ (run-hooks 'ms-play-hook))
+
+(defun ms-display-contents ()
+ "Switch to showing contents in the slide buffer.
+This is a valid `ms-start-function' and will start
+each slide show from the contents view."
+ (ms--ensure-slide-buffer)
+ (ms--clean-up-state)
+ (oset ms--deck display-state 'contents)
+
+ (widen)
+ (org-overview)
+
+ (when ms-contents-header
+ (if-let ((first (ms--document-first-heading)))
+ (narrow-to-region (org-element-begin first)
+ (point-max))
+ ;; No first heading. Just header. Empty contents.
+ (narrow-to-region (point-max)
+ (point-max)))
+ (ms--make-header t))
+
+ ;; TODO walk all headings with the filter and add overlays on the hidden
stuff
+ ;; TODO filter slides that don't have a display action?
+
+ (ms--feedback :contents)
+ (run-hooks 'ms-before-contents-view-hook))
+
+(defun ms-display-base ()
+ "Switch to the base buffer for the slide show."
+ (unless ms--deck
+ (error "No deck exists"))
+ (oset ms--deck display-state 'base)
+ (switch-to-buffer (oref ms--deck base-buffer)))
+
+(defun ms-stop ()
+ "Stop the presentation entirely.
+Kills the indirect buffer, forgets the deck, and return to the
+source buffer."
+ (interactive)
+ (when-let* ((deck ms--deck)
+ (slide-buffer (oref deck slide-buffer))
+ (base-buffer (oref deck base-buffer)))
+
+ ;; Animation timers especially should be stopped
+ (ms--clean-up-state)
+
+ ;; TODO possibly finalize in state cleanup. Slides <-> contents switching
+ ;; may require attention.
+ (ms-final ms--deck)
+
+ ;; TODO `display-buffer'?
+ ;; TODO restore window configuration?
+ (switch-to-buffer base-buffer)
+
+ (when slide-buffer
+ (kill-buffer slide-buffer))
+
+ (when ms-mode
+ (ms-mode -1))
+
+ (setq-local ms--deck nil)
+
+ (run-hooks 'ms-stop-hook)
+ (ms--feedback :stop)))
+
+;; ** Buffer Slide
+
+(defvar-keymap ms-buffer-slide-mode-map
+ :doc "Keymap for buffers displayed as slides in a deck.
+It uses the `ms-mode' as its parent so that your
+controls for slides are the same, but if this causes shadowing
+problems in buffers being used as slides, you can change the
+controls."
+ :parent ms-mode-map)
+
+(define-minor-mode ms-buffer-slide-mode
+ "A minor mode for buffers being used as slides.
+This ensures that when we delegate out to another buffer, the
+presentation bindings are still useable and various calls can
+find the presentation."
+ :keymap ms-buffer-slide-mode-map
+ :group 'macro-slides
+ (cond (ms-buffer-slide-mode
+ (unless (and (boundp 'ms--deck)
+ ms--deck)
+ (error "Mode started directly without a deck")))
+ (t
+ ;; Completely wipe out the variable.
+ (when (boundp 'ms--deck)
+ (makunbound 'ms--deck)))))
+
+;; * User Commands
+
+;;;###autoload
+(defun ms-contents ()
+ "Toggle between slides and contents.
+This command will activate the mode if it is inactive and show
+the contents. When the contents is shown, it will toggle back to
+the slides.
+
+This generic command should always toggle to some higher level
+view where the user can move around a presentation sequence more
+quickly."
+ (interactive)
+ (if (ms-live-p)
+ (if (ms--showing-slides-p)
+ (ms-display-contents)
+ (ms-display-slides))
+ (let ((ms-start-function
+ #'ms-contents))
+ (ms-mode 1))))
+
+;;;###autoload
+(defun ms-start ()
+ "Go back to the slides or base buffer.
+This command goes from the overview to the slides, from the
+slides to the base buffer, or if no mode is active, will start
+the mode and go to slides."
+ (interactive)
+ (if (ms-live-p)
+ (if (ms--showing-slides-p)
+ (ms-display-base)
+ (ms-display-slides))
+ (let ((ms-start-function
+ #'ms-display-slides))
+ (ms-mode 1))))
+
+;;;###autoload
+(defun ms-forward ()
+ "Advance slideshow forward."
+ (interactive)
+ (unless (ms-live-p)
+ (user-error "No deck is active"))
+ (if (ms--showing-contents-p)
+ (org-next-visible-heading 1)
+ (ms--ensure-slide-buffer)
+ (ms-step-forward ms--deck)))
+
+;;;###autoload
+(defun ms-backward ()
+ "Advance slideshow backward."
+ (interactive)
+ (unless (ms-live-p)
+ (user-error "No deck is active"))
+ (if (ms--showing-contents-p)
+ (org-previous-visible-heading 1)
+ (ms--ensure-slide-buffer)
+ (ms-step-backward ms--deck)))
+
+;; * Classes
+
+(defclass ms-progress-tracking ()
+ ((marker :initform nil :initarg :marker))
+ "A utility class for other classes that need a marker.")
+
+(cl-defgeneric ms-marker (obj))
+
+(cl-defmethod ms-marker ((obj ms-progress-tracking)
+ &optional pom)
+ "Set internal marker to POM or return marker position if set.
+Errors when asked for a marker before one has been set."
+ (let ((marker (or (oref obj marker)
+ (pcase (type-of pom)
+ ('marker pom)
+ ('integer (set-marker (make-marker) pom))
+ ('symbol nil)))))
+ (when (and marker pom)
+ (set-marker marker pom))
+ (if (and marker (marker-buffer marker))
+ (marker-position (oset obj marker marker))
+ (error "No marker was initialized"))))
+
+;; This is one of the most important interfaces for all hacking. The domain
+;; model is that of a linear sequence of steps that the user traverses both
+;; forward and backward.
+;;
+;; There are some states that may need to be set up or torn down at the
+;; boundaries of the sequence. These are handled by three methods, init, end,
+;; and final.
+;;
+;; Sub-sequences currently don't have any special support for setup or teardown
+;; when entering or exiting the sub-sequence, but such cooperation is
consistent
+;; with the rest of the implementation / usage.
+;;
+;; End is essentially init for going in reverse. While using init and going
+;; forward to reach the end is theoretically viable, it does extra work and
+;; leads to headaches for implements.
+;;
+;; Goto essentially is just a careful use of step-forward. If every forward
+;; step properly reports its maximum extent of progress, we can use forward and
+;; init to implement every goto.
+;;
+;; Finally, step-forward and step-backward should navigate the states between
+;; init / end and final.
+;;
+;; A lazy implementer can forego methods by delegating them to simpler
+;; idempotent methods, such as using an idempotent init for step-backward.
With
+;; a maximum of six methods and a minimum of two, just init and forward, you
+;; have enough behavior to properly fit the user interface.
+
+;; Generics. TODO check on the use of generics.
+(cl-defgeneric ms-init (obj))
+n
+(cl-defgeneric ms-end (obj))
+
+(cl-defgeneric ms-final (obj))
+
+(cl-defgeneric ms-step-forward (obj))
+
+(cl-defgeneric ms-step-backward (obj))
+
+(cl-defgeneric ms-goto (obj point))
+
+;; ** Stateful Sequence
+(defclass ms-stateful-sequence ()
+ ((parent :initval nil :initarg :parent
+ "Parent or root sequence.
+Usually a deck or slide."))
+ "An interface definition for linear sequences of steps.
+The sequence can be traversed forwards and backward and also
+indexed into from higher level navigation commands. Sequences
+can run as sub-sequences, where one sequence calls into another.
+
+Because the steps may rely on some setup and teardown, the
+stateful sequence provides methods to call these functions at the
+appropriate times.
+
+Classes that wish to implement the stateful sequence interface
+just need to support a few methods and then rely on the generic
+implementations for the rest, unless they want to optimize or
+simplify their implementation.")
+
+(cl-defmethod ms-init
+ ((obj ms-stateful-sequence))
+ "Called when entering a sequence.
+Any state that must be set up for this sequence can run during
+the init method. Init does not count as a step. The guarantee
+from callers is that if init is called, `ms-final'
+will also be called.
+
+TODO Return is currently ignored, mainly because most init
+implementations are expected to produce side-effects rather than
+meaningful return values.
+
+Rather than implement this function in an idempotent way, work
+together with `ms-final' to make guarantees about
+initial conditions and tidyingup a sequence that has completely
+run its course.
+
+PARENT exists when the sequence is a sub-sequence. Sub-sequences
+can rely on the parent state to exist for their entire lifetime.
+The parent sequence will not call its own `ms-final'
+until after it calls the sub-sequence's `ms-final'."
+ nil)
+
+(cl-defmethod ms-end
+ ((obj ms-stateful-sequence))
+ "Init when going backwards.
+This method should be implemented so that the state is equivalent
+to having gone forward to the end of the slide. The default
+implementation calls init and then advances to the end. This can
+be inappropriate in a number of cases, and should be overridden.
+Re-using init is appropriate when a proper backward
+implementation is not valued.
+
+Just as init anticipates having forward called at least once, end
+should anticipate backward being called at least once. This
+allows initial narrowing and slide behavior to be signaled
+properly to children and section actions."
+ (ms-init obj)
+ (let (extent (advanced t))
+ (while advanced
+ (when-let ((progress (ms-step-forward obj)))
+ (setq extent progress)))
+ extent))
+
+(cl-defmethod ms-final
+ ((obj ms-stateful-sequence))
+ "Called when exiting a sequence.
+Implement this method to clean up any state that would interfere
+with the sequence succeeding when run again. All side-effects
+and states created by steps in the sequence or the `ms-init'
+method must be cleaned up or otherwise managed or else
+`ms-step-backward' and other sequences of running a presentation
+will be brittle and likely fail when re-run."
+ nil)
+
+(cl-defmethod ms-step-forward
+ ((obj ms-stateful-sequence))
+ "Make on step and return the point of farthest advance.
+When no progress can be made, return nil. For steps that don't
+need to advance the point, if they make progress, they should
+return t or the point. Every sequenece of `ms-step-forward'
+should return nil at some point."
+ nil)
+
+(cl-defmethod ms-step-backward
+ ((obj ms-stateful-sequence))
+ "Make one step backwards and return earliest point.
+Backwards steps are considered to advance to be beginning of the
+extent they affect. This enables forward and backward
+implementations to act as conjugates."
+ nil)
+
+(cl-defmethod ms-goto
+ ((obj ms-stateful-sequence) point)
+ "Step forward until advancing beyond POINT.
+This method can usually be implemented on top of
+`ms-step-forward' by advancing until POINT is exceeded.
+`ms-init' is guaranteed to have been called."
+ (let (exceeded (advanced t))
+ (while (and advanced (not exceeded))
+ (let ((progress (ms-step-forward obj)))
+ (if (and (numberp progress)
+ (>= progress point))
+ (setq exceeded progress)
+ (setq advanced progress))))))
+
+;; ** Parent
+;; TODO this class is kind of half-baked. It was intended to wrap up the
+;; filtering functionality and needing to find next and previous children.
+;; Needs actual usage to become mature.
+(defclass ms-parent ()
+ ((filter :initform nil
+ :initarg :filter
+ :documentation "Function to filter child headings."))
+ "The parent class implements methods that need to filter
+children. Decks and slides have children.")
+
+;; TODO highly indirect and delegates down to a really crappy implementation
+;; that nobody else should ever want to use
+(cl-defmethod ms-next-child ((obj ms-parent) child)
+ "Get the next unfiltered CHILD of OBJ."
+ (ms-next-sibling
+ child (oref obj filter)))
+
+(cl-defmethod ms-previous-child ((obj ms-parent) child)
+ "Get the previous unfiltered CHILD of OBJ."
+ (ms-previous-sibling
+ child (oref obj filter)))
+
+;; ** Deck
+(defclass ms-deck (ms-progress-tracking
+ ms-parent)
+ ((slide :initform nil
+ "The active sequence or slide.
+This is probably a `ms-slide' object, but anything
+that implements `ms-stateful-sequence' will probably
+work as well.")
+ (base-buffer :initform nil :initarg :base-buffer
+ "Source of the slide deck.")
+ (slide-buffer :initform nil :initarg :slide-buffer
+ "Indirect buffer used to display slides in.")
+ (window-config :initform nil :initarg :window-config
+ "Window configuration for restoring after stop.")
+ ;; TODO this implementation doesn't work if more indirect buffers are used.
+ (display-state :initform nil
+ "Initiated by display actions to `contents' or `slides'.")
+ (step-callbacks :initform nil
+ "Steps to run before next steps.
+When these return non-nil, they are considered to have made
+progress and will count as a step on their own. When they return
+nil, they merely run and then allow the next stop to make
+progress. See `ms-run-as-next-step'."))
+ "The Deck is responsible for selecting the parent node and
+maintaining state between mode activations or when switching
+between slides and contents. It also acts as a central control
+point that can be stored in a single buffer-local variable in
+other buffers. Class can be overridden to affect root behaviors.
+See `ms-default-deck-class'")
+
+;; ... TODO something about buffer slides and optional actions before next
slide.
+;; (cl-defmethod ms-before-next-slide ((obj ms-deck)
+;; momento)
+;; "Store a callback with context p")
+
+(cl-defmethod ms-init ((obj ms-deck))
+ "For the deck class, init needs to call init on slides until one succeeds.
+This could result in skipping slides that do not report any readiness during
+their init."
+ (unless (oref obj slide)
+ ;; 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))
+ (narrow-to-region (point) (point)) ; signal to slide to draw itself
+ (let ((result (ms-init (oref obj slide))))
+ ;; Might bug when init returns nil. Most actions never return nil.
+ (if result
+ (setq initialized (ms-step-forward (oref obj slide)))
+ (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"))))
+
+(cl-defmethod ms-end ((obj ms-deck))
+ (error "Deck has no valid concept of starting at the end."))
+
+(cl-defmethod ms-final ((obj ms-deck))
+ (when-let ((slide (oref obj slide)))
+ (ms-final slide)))
+
+(cl-defmethod ms-step-forward ((obj ms-deck))
+ ;; TODO Check for forward callbacks
+ (unless (oref obj slide)
+ ;; Calls implied from other commands should have started the lifecycle
+ ;; already
+ (error "No slide selected"))
+
+ (let (progress reached-end)
+ ;; Burn up a step callback until one returns non-nil
+ (when-let ((steps (and (slot-boundp obj 'step-callbacks)
+ (oref obj step-callbacks))))
+ (while (and (not progress)
+ steps)
+ (setq progress (funcall (pop steps) 'forward)))
+ (oset obj step-callbacks steps))
+
+ (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))
+
+ (unless result
+ ;; First check if there is a parent slide, which is true unless the
+ ;; parent is the deck. Then check if there is a next child.
+ (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)))))
+
+ (ms--debug current-slide)
+ (when ms--debug
+ (message "switching-to-parent: %s" switching-to-parent))
+ (when next-slide
+ (ms--debug 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.
+ (when next-slide
+
+ (oset obj slide next-slide)
+ (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))))
+
+ ;; zero-width region tells slide it's in control of display. For
+ ;; slides the control their own children, they both create and
+ ;; manage the children, so we never see them at the root.
+ (narrow-to-region (point) (point))
+ ;; We just run the init and then let the next loop call the first
+ ;; forward, handling the result of progress appopriately.
+ (ms-init next-slide))))))
+
+ ;; A lot of progress may have happened, but there will be only one feedback
+ ;; message.
+ (when progress
+ (ms--feedback :forward))
+
+ (when reached-end
+ ;; TODO exhaust any remaining next slide callbacks
+ (run-hooks 'ms-after-last-slide-hook))))
+
+(cl-defmethod ms-step-backward ((obj ms-deck))
+ (unless (oref obj slide)
+ ;; Calls implied from other commands should have started the lifecycle
+ ;; already
+ (error "No slide selected"))
+
+ ;; Going backward is almost the same as going forward. The big difference is
+ ;; that when a slide is instantiated, it needs to be sent to its end.
Usually
+ ;; the default implementation, which calls step-forward until progress is
+ ;; exhausted, is fine. Certain actions with side-effects may not like this,
+ ;; and they should implement an actual `ms-end' method as well as idempotent
+ ;; `ms-init' and `ms-final' if any support for going backwards is disireable.
+
+ (let (progress reached-beginning)
+ ;; Burn up a step callback until one returns non-nil
+ (when-let ((steps (and (slot-boundp obj 'step-callbacks)
+ (oref obj step-callbacks))))
+ (while (and (not progress)
+ steps)
+ (setq progress (funcall (pop steps) 'backward)))
+ (oset obj step-callbacks steps))
+
+ (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))
+
+ (unless result
+ ;; First check if there is a parent slide, which is true unless the
+ ;; parent is the deck. Then check if there is a previous child.
+ (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)))))
+
+ (ms--debug current-slide)
+ (when ms--debug
+ (message "switching-to-parent: %s" switching-to-parent))
+ (when previous-slide
+ (ms--debug 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.
+ (when previous-slide
+ ;; TODO exhaust next slide callbacks
+ (oset obj slide previous-slide)
+ (cond
+ (switching-to-parent
+ ;; TODO slide re-entry when parent can still make progress?
+ (ms-final current-slide)
+
+ ;; TODO This burns one backward step because the child we are
+ ;; leaving is the valid backwards step. Possibly there is another
+ ;; correct way.
+ ;; (ms-step-backward previous-slide)
+
+ (narrow-to-region (point) (point)))
+ (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))))
+
+ ;; zero-width region tells slide it's in control of display. For
+ ;; slides the control their own children, they both create and
+ ;; manage the children, so we never see them at the root.
+ (narrow-to-region (point) (point))
+ ;; We just send the slide to its end (reverse init) and allow the
+ ;; next loop to call step-backward, obtaining progress and properly
+ ;; handling the result.
+ (ms-end previous-slide))))))
+
+ ;; A lot of progress may have happened, but there will be only one feedback
+ ;; message.
+ (cond (progress
+ (ms--feedback :backward))
+ (reached-beginning
+ (user-error "No more previous slides!")))))
+
+;; TODO handle no-slides condition by skipping to the end
+(cl-defmethod ms--choose-slide ((obj ms-deck) how
+ &optional point)
+ "Set the current slide, according to HOW.
+Optional POINT allows resolving a slide by walking the tree to
+find the slide that displays that POINT."
+ (cond ((eq how 'first)
+ (oset obj slide (ms--make-slide
+ (ms--document-first-heading) obj)))
+ ((eq how 'point)
+ ;; TODO implement looking inside the slides using `goto' and recover
+ ;; the child with POINT
+ (oset obj slide
+ (ms--make-slide
+ (ms--root-heading-at-point) obj)))))
+
+(cl-defmethod ms-deck-live-p ((obj ms-deck))
+ "Check if all the buffers are alive or can be recovered."
+ ;; TODO in some circumstances, an indirect buffer might exist, but we should
+ ;; probably kill it if it was created outside the current instance's
lifecycle
+ (and (buffer-live-p (oref obj base-buffer))
+ (buffer-live-p (oref obj slide-buffer))
+ (eq (oref obj base-buffer) (buffer-base-buffer
+ (oref obj slide-buffer)))))
+
+(cl-defmethod ms-run-as-next-step
+ ((obj ms-deck) step-fun)
+
+ "Run STEP-FUN at the next step with a single argument, DIRECTION.
+DIRECTION is either `forward' or `backward'."
+ (oset obj step-callbacks
+ (cons step-fun (oref obj step-callbacks))))
+
+;; TODO run at next slide
+;; TODO run at next tree
+
+;; * Slide
+(defclass ms-slide (ms-parent ms-stateful-sequence)
+ ((slide-action :initform nil :initarg :slide-action
+ :description "Action run after section.
+See `ms-default-child-action'.")
+ (section-actions :initform nil :initarg :section-actions
+ :description "Actions run within the section display
+lifecycle. See `ms-default-section-actions'.")
+ (child-action :initform nil :initarg :child-action
+ :description "Action run after section.
+See `ms-default-child-action'.")
+ (begin :initform nil :initarg :begin
+ :description "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.")
+
+(cl-defmethod ms-init ((obj ms-slide))
+ (when-let ((display-action (oref obj slide-action)))
+ (ms-init display-action))
+ (mapc (lambda (action)
+ (ms-init action))
+ (oref obj section-actions))
+ (when-let ((child-action (oref obj child-action)))
+ (ms-init child-action))
+ ;; TODO this t is just a hack. The implementation of reacting to return
+ ;; values from init has been in flux.
+ t)
+
+(cl-defmethod ms-end ((obj ms-slide))
+ (when-let ((child-action (oref obj child-action)))
+ (ms-end child-action))
+ (mapc (lambda (action)
+ (ms-end action))
+ (reverse (oref obj section-actions)))
+ (when-let ((display-action (oref obj slide-action)))
+ (ms-end display-action)))
+
+(cl-defmethod ms-final ((obj ms-slide))
+ (when-let ((display-action (oref obj slide-action)))
+ (ms-final display-action))
+ (mapc (lambda (action)
+ (ms-final action))
+ (oref obj section-actions))
+ (when-let ((child-action (oref obj child-action)))
+ (ms-final child-action)))
+
+(cl-defmethod ms-step-forward ((obj ms-slide))
+ (let ((section-actions (oref obj section-actions))
+ 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)))))
+
+(cl-defmethod ms-step-backward ((obj ms-slide))
+ (let ((section-actions (reverse (oref obj section-actions)))
+ progress)
+ ;; section display action happens before any section-actions
+ (setq progress (or (when-let ((child-action (oref obj child-action)))
+ (ms-step-backward child-action))
+ (when-let ((display-action
+ (oref obj slide-action)))
+ (ms-step-backward display-action))))
+ (while (and (not progress)
+ section-actions)
+ (let ((action (pop section-actions)))
+ (when-let ((result (ms-step-backward action)))
+ (setq progress result))))
+ progress))
+
+(defun ms--make-slide (heading parent)
+ "Hydrate a slide object from a HEADING element."
+ ;; Hydration always begins within a tree that has been fully revealed and
+ ;; widened, so we don't need to widen or unfold anything.
+
+ ;; TODO access to parent can be used to inherit different default actions,
+ ;; allowing parents to configure children implicitly.
+ (let* ((beg (org-element-begin heading))
+ (keywords (org-collect-keywords
+ '("SLIDE_ACTION"
+ "SLIDE_SECTION_ACTIONS"
+ "SLIDE_CHILD_ACTION"
+ "SLIDE_FILTER"
+ "SLIDE_CLASS")))
+
+ (slide-action-class
+ (ms--class
+ (or (org-element-property :SLIDE_ACTION heading)
+ (cdr (assoc-string "SLIDE_ACTION"
+ keywords))
+ ms-default-slide-action)))
+ (slide-action (when slide-action-class
+ (make-instance
+ slide-action-class)))
+
+ (section-action-classes
+ (ms--classes
+ (or (org-element-property :SLIDE_SECTION_ACTIONS heading)
+ (cdr (assoc-string "SLIDE_SECTION_ACTIONS" keywords))
+ ms-default-section-actions)))
+ (section-actions (mapcar (lambda (c) (when c (make-instance c)))
+ section-action-classes))
+
+ (child-action-class
+ (ms--class
+ (or (org-element-property :SLIDE_CHILD_ACTION heading)
+ (cdr (assoc-string "SLIDE_CHILD_ACTION"
+ keywords))
+ ms-default-child-action)))
+ (child-action (when child-action-class
+ (make-instance child-action-class)))
+
+ (filter
+ (or (ms--filter
+ (or (org-element-property :SLIDE_FILTER heading)
+ (cdr (assoc-string "SLIDE_FILTER" keywords))))
+ ms-default-filter))
+
+ (class
+ (or (ms--class
+ (or (org-element-property :SLIDE_CLASS heading)
+ (cdr (assoc-string "SLIDE_CLASS"
+ keywords))))
+ ms-default-class))
+
+ (beg-marker (make-marker)))
+ (set-marker beg-marker beg (current-buffer))
+
+ (let ((slide (make-instance class
+ :slide-action slide-action
+ :section-actions section-actions
+ :child-action child-action
+ :filter filter
+ :begin beg-marker
+ :parent parent)))
+
+ ;; TODO circular reference between slide and actions. Actions are either
+ ;; sequential or nested, but their lifecycle structure is driven by
+ ;; headings and their slides, causing some lifecycle overlap. Actions
+ ;; might want to know about the current slide. The current slide is
+ ;; accessible via the deck, but that is kind of obtuse for a child. The
+ ;; inversion of control that allows the deck to only track one child
slide
+ ;; is not possible when several children share a concurrent lifecycle
+ ;; unless children track siblings in a List.
+ ;;
+ ;; Composable actions, where an action can have child actions, using the
+ ;; `ms-stateful-sequence' model, are the eventual correct way
+ ;; to do this, but it does require the slide to do what the deck does,
+ ;; inverting control to the children. Minor refactor. The way it is
done
+ ;; now should be okay for the design point, presentations.
+ (mapc (lambda (c) (when c (oset c parent slide)))
+ `(,slide-action
+ ,@section-actions
+ ,child-action))
+ slide)))
+
+(cl-defmethod ms-next-sibling ((obj ms-slide) filter)
+ (when-let* ((heading (ms-heading obj))
+ (next-heading (ms--next-sibling
+ heading filter)))
+ (ms--make-slide next-heading (oref obj parent))))
+
+(cl-defmethod ms-previous-sibling ((obj ms-slide) filter)
+ (when-let* ((heading (ms-heading obj))
+ (previous-heading (ms--previous-sibling
+ heading filter)))
+ (ms--make-slide previous-heading (oref obj parent))))
+
+;; ** Slide Methods for Writing Actions
+;; TODO A lot of the slide methods belong on actions. Actions should just
store
+;; a marker to the heading and work with the heading directly. They rarely
need
+;; to look into the actual slide object to see what other sequences might be in
+;; flight.
+
+(cl-defmethod ms-first-child ((obj ms-slide))
+ "Return first child heading element."
+ (ms--last-child
+ (ms-heading obj)))
+
+(cl-defmethod ms-last-child ((obj ms-slide))
+ "Return last child heading element."
+ (ms--last-child
+ (ms-heading obj)))
+
+(cl-defmethod ms-heading ((obj ms-slide))
+ "Return the slide's heading element."
+ (org-element-at-point (oref obj begin)))
+
+(cl-defmethod ms-goto-section ((obj ms-slide))
+ "Move point to the beginning of the slide's heading."
+ (when-let ((beg (ms-section-begin obj)))
+ (goto-char beg)))
+
+(cl-defmethod ms-section-begin ((obj ms-slide))
+ "Return the beginning location of the slide's section.
+Always return a point, even for empty headings."
+ (let ((heading (ms-heading obj)))
+ (ms--section-begin heading)))
+
+(cl-defmethod ms-section-end ((obj ms-slide))
+ "Return the end location of the slide's section.
+Always return a point, even for empty headings."
+ (let ((heading (ms-heading obj)))
+ (ms--section-end heading)))
+
+(cl-defmethod ms-in-section-p ((obj ms-slide) point)
+ "Check if POINT is within the section before child headings."
+ (let ((heading (ms-heading obj)))
+ (and (>= point (ms--section-begin heading))
+ (< point (ms--section-end heading)))))
+
+(cl-defmethod ms-section-map
+ ((obj ms-slide) type fun &optional info first-match no-recursion)
+ "Map FUN over TYPE elements in SLIDE section.
+FIRST-MATCH only finds the first non-nil returned from FUN.
+NO-RECURSION will avoid descending into children."
+ (ms--section-map
+ (ms-heading obj)
+ type fun info first-match no-recursion))
+
+(cl-defmethod ms-section-next
+ ((obj ms-slide) type &optional pred info no-recursion)
+ "Move forward by one org element of TYPE and return element."
+ (ms--section-next (ms-heading obj)
+ type pred info no-recursion))
+
+(cl-defmethod ms-section-previous
+ ((obj ms-slide) type &optional pred info no-recursion)
+ "Move backward by one org element of TYPE and return element."
+ (ms--section-previous (ms-heading obj)
+ type pred info no-recursion))
+
+(cl-defmethod ms-narrow ((obj ms-slide) &optional
+ with-children)
+ "Switch to the slide buffer. Narrow to this slide's headline
+and its contents. With optional WITH-CHILDREN non-nil, narrow to
+include the child headings as well.
+
+This function cooperates with child actions. If the child action
+wants the child to completely take over the buffer, it will
+widen. If the child wants to include th slide, it will remain
+restricted. This can be ambiguous when the entire buffer is just
+one heading, a degenerate case because there are no child or
+sibling slides."
+ (let* ((progress)
+ (length (buffer-size))
+ (begin (oref obj begin))
+ (end (if with-children
+ (org-element-end (ms-heading obj))
+ (ms-section-end obj)))
+ ;; the following condition can only be true when narrowed to
+ ;; zero-length unless the buffer is actually empty, a degenerate
+ ;; condition as there are no headings from which to create slides.
+ (full-control (= (- (point-max) (point-min)) 0)))
+
+ (cond (full-control
+ (narrow-to-region begin end)
+ (ms--make-header)
+ (goto-char begin)
+ (when ms-slide-in-effect
+ (ms-animation-setup begin end))
+ (setq progress t))
+ (t
+ ;; When not in full control, just expand the restriction to include
+ ;; contents
+ (unless (and (<= (point-min) begin)
+ (>= (point-max) end))
+ (narrow-to-region (min (point-min) begin)
+ (max (point-max) end))
+ (when ms-slide-in-effect
+ (ms-animation-setup begin end))
+ (setq progress t))))
+ progress))
+
+;; * Actions
+;;; Pre-built Actions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Actions are stateful sequences. They live on a slide. They usually work on
+;; either the section or the children, but there is no requirement that they
are
+;; exclusive to either. Child actions should compose with section actions,
such
+;; as round-robin children cycling through each child's action's forward and
+;; backward methods.
+
+;; ** Base Action
+(defclass ms-action (ms-stateful-sequence
+ ms-progress-tracking)
+ ()
+ "Base class for most slide actions that work on a heading's contents.")
+
+;; Most methods will ensure the narrowing in their init and then return t if
+;; narrowing was performed.
+(cl-defmethod ms-narrow
+ ((obj ms-action) &optional with-children)
+ "Narrow to the slide.
+Optional WITH-CHILDREN will include child headings."
+ (ms-narrow (oref obj parent) with-children))
+
+(cl-defmethod ms-init ((obj ms-action))
+ (ms-marker obj (org-element-begin (ms-heading
+ (oref obj parent)))))
+
+(cl-defmethod ms-end ((obj ms-action))
+ (ms-marker obj (org-element-end (ms-heading
+ (oref obj parent)))))
+
+(cl-defmethod ms-final ((obj ms-action))
+ (when-let ((marker (oref obj marker)))
+ (set-marker marker nil)))
+
+(cl-defmethod ms-narrow-forward ((obj ms-action)
+ &optional with-children)
+ "Make the buffer restiction include the slide's bounds.
+Optional WITH-CHILDREN will include child headings. The return
+value is a valid step return value, indicating if progress was
+made, so you can combine this with `or' when deriving new actions."
+ ;; This method implements once-per-direction behavior. When switching from
+ ;; forward to backward, it is possible to trigger this action again.
However,
+ ;; it will only return t when it actually updates the region.
+ (let* ((heading (ms-heading (oref obj parent)))
+ (position (ms-marker obj)))
+ (when (< position (org-element-end heading))
+ (ms-marker obj (org-element-end heading))
+ (ms-narrow obj with-children))))
+
+(cl-defmethod ms-narrow-backward ((obj ms-action)
+ &optional with-children)
+ "Make the buffer restiction include the slide's bounds.
+Optional WITH-CHILDREN will include child headings. The return
+value is a valid step return value, indicating if progress was
+made, so you can combine this with `or' when deriving new actions."
+ ;; This method implements once-per-direction behavior. When switching from
+ ;; forward to backward, it is possible to trigger this action again.
However,
+ ;; it will only return t when it actually updates the region.
+ (let* ((heading (ms-heading (oref obj parent)))
+ (position (ms-marker obj)))
+ (when (> position (org-element-begin heading))
+ (ms-marker obj (org-element-begin heading))
+ (ms-narrow obj with-children))))
+
+(cl-defmethod ms-forward-child ((obj ms-action))
+ "Go forward one child heading and return the org 'headline element.
+The returned element is the child you want to either display or call further
+methods on."
+ ;; The slide tracks progress using a marker. This marker is advanced to the
+ ;; end of a child it returns.
+ (let* ((heading (ms-heading (oref obj parent)))
+ (position (ms-marker obj))
+ (pred (lambda (c) (> (org-element-begin c)
+ position)))
+ (next-child (ms--first-child heading pred)))
+ (ms-marker obj (if next-child
+ (org-element-begin next-child)
+ ;; The marker is moved to the end if there was
+ ;; no next child.
+ (org-element-end heading)))
+ next-child))
+
+(cl-defmethod ms-backward-child ((obj ms-action))
+ "Back up one child heading and return the org 'headline element.
+The returned element is the child you want to either display or call further
+methods on."
+ ;; The slide tracks progress using a marker. This marker is moved to the
+ ;; beginning of the child it returns.
+ (let* ((heading (ms-heading (oref obj parent)))
+ (position (ms-marker obj))
+ (pred (lambda (c) (< (org-element-begin c)
+ position)))
+ (previous-child (ms--last-child heading pred)))
+ (ms-marker obj (if previous-child
+ (org-element-begin previous-child)
+ ;; The merker is moved to the beginning when
+ ;; there was no previous child.
+ (org-element-begin heading)))
+ previous-child))
+
+;; ** Default Section Action
+(defclass ms-action-section (ms-action) ()
+ "Default action. Just displays the section.")
+
+(cl-defmethod ms-step-forward ((obj ms-action-section))
+ (ms-narrow-forward obj))
+
+(cl-defmethod ms-step-backward ((obj ms-action-section))
+ (ms-narrow-backward obj))
+
+;; ** Contents Action
+;; TODO We really just need argument-based configuration
+;; TODO Default action cooperation. Sections and children unavoidably coupled.
+(defclass ms-action-contents (ms-action) ()
+ "Display the entire contents.
+This action should normally be paired with no child action. Slides will not be
+instantiated from children, so their configuration is meaningless.")
+
+(cl-defmethod ms-step-forward ((obj ms-action-contents))
+ (ms-narrow-forward obj 'with-children))
+
+(cl-defmethod ms-step-backward ((obj ms-action-contents))
+ (ms-narrow-backward obj 'with-children))
+
+;; ** Reveal items section action
+(defclass ms-action-item-reveal (ms-action)
+ (overlays :initform nil)
+ "Hide all items and then reveal them one by one.")
+
+(cl-defmethod ms-init :after
+ ((obj ms-action-item-reveal))
+ (oset obj overlays (ms-section-map
+ (oref obj parent)
+ 'item #'ms-hide-element)))
+
+;; The default `ms-end' method is sufficient since this action will
+;; just add overlays starting from the end of items.
+
+(cl-defmethod ms-final :after
+ ((obj ms-action-item-reveal))
+ (when-let ((overlays (oref obj overlays)))
+ (mapc #'delete-overlay overlays)))
+
+(cl-defmethod ms-step-forward
+ ((obj ms-action-item-reveal))
+ (when-let* ((overlays (when (slot-boundp obj 'overlays)
+ (oref obj overlays)))
+ (first (car overlays))
+ (end (overlay-end first)))
+ ;; TODO We can let-bind animations false for child slides.
+ (when ms-slide-in-effect
+ (ms-animation-setup
+ (overlay-start first) (overlay-end first)))
+ (delete-overlay first)
+ (oset obj overlays (cdr overlays))
+ (ms-marker obj end)))
+
+(cl-defmethod ms-step-backward
+ ((obj ms-action-item-reveal))
+ (save-excursion
+ (goto-char (ms-marker obj))
+ (when-let ((previous-item (ms-section-previous
+ (oref obj parent) 'item )))
+ (oset obj overlays (cons (ms-hide-element
+ previous-item)
+ (when (slot-boundp obj 'overlays)
+ (oref obj overlays))))
+ (ms-marker obj (org-element-begin previous-item)))))
+
+;; ** Babel Action
+
+;; TODO automatically map the blocks during init and remove results... this is
+;; kind of implemented but seems to inconsistently work.
+;; TODO configure results removal behavior with an argument
+;; TODO any display jank concerns due to results?
+(defclass ms-action-babel (ms-action)
+ () "Execute source blocks as steps.
+By default blocks execute one by one with step-forward. You can mark a block
to
+be special with the keyword:
+
+- #+attr_method: init
+
+- #+attr_method: step-forward
+
+- #+attr_method: step-backward
+
+- #+attr_method: end
+
+- #+attr_method: final
+
+These keywords correspond to the normal methods of the stateful
+sequence class. For blocks that should not occur more than once,
+only the first block found will actually be executed.")
+
+(cl-defmethod ms--clear-results ((obj ms-action-babel))
+ (without-restriction
+ (ms-section-map
+ (oref obj parent) 'src-block
+ (lambda (e)
+ (save-excursion
+ (goto-char (org-element-begin e))
+ (org-babel-remove-result-one-or-many nil))))))
+
+(defun ms--method-block-pred
+ (method-name &optional unnamed)
+ "Return a predicate to match the METHOD-NAME.
+Optional UNNAMED will return unnamed blocks as well."
+ (lambda (block)
+ (if-let ((names (org-element-property :attr_method block)))
+ (when (member method-name names)
+ block)
+ (when unnamed
+ block))))
+
+(defun ms--block-execute (block-element)
+ (without-restriction
+ (save-excursion
+ (goto-char (org-element-begin block-element))
+ (org-babel-execute-src-block))))
+
+(cl-defmethod ms--get-block
+ ((obj ms-action) &optional method-name)
+ "Execute the block with keyword value METHOD-NAME.
+The keywords look like:
+
+#+attr_method: METHOD-NAME
+
+The possible values for METHOD-NAME correspond to the
+stateful-sequence class methods. METHOD-NAME is a string."
+ (let ((predicate (ms--method-block-pred method-name)))
+ (ms-section-map
+ (oref obj parent) 'src-block predicate nil t)))
+
+(cl-defmethod ms-step-forward ((obj ms-action-babel))
+ (save-excursion
+ (goto-char (ms-marker obj))
+ (if-let* ((predicate (ms--method-block-pred
+ "step-forward" t))
+ (next (ms-section-next
+ (oref obj parent) 'src-block predicate)))
+ (progn (ms-marker obj (org-element-begin next))
+ (or (ms--block-execute next)
+ ;; If we found a next block, we made progress regardless
of the block's
+ ;; return value
+ t))
+ (ms-marker obj (org-element-begin
+ (ms-heading
+ (oref obj parent))))
+ nil)))
+
+(cl-defmethod ms-step-backward ((obj ms-action-babel))
+ (save-excursion
+ (goto-char (ms-marker obj))
+
+ (if-let* ((predicate (ms--method-block-pred
+ "step-backward"))
+ (prev (ms-section-previous
+ (oref obj parent) 'src-block predicate)))
+ (progn (ms-marker obj (org-element-begin prev))
+ (or (ms--block-execute prev)
+ ;; If we found a prev block, we made progress regardless of
the
+ ;; block's return value
+ t))
+ (ms-marker obj (org-element-begin
+ (ms-heading
+ (oref obj parent))))
+ nil)))
+
+(cl-defmethod ms-init :after ((obj ms-action-babel))
+ (when-let ((block-element (ms--get-block obj "init")))
+ (ms--clear-results obj)
+ (ms--block-execute block-element))
+ ;; TODO pesky return values for init methods
+ ;; These should probably need to be some explicit symbol to do anything other
+ ;; than proceed in a care-free manner.
+ t)
+
+(cl-defmethod ms-end :after ((obj ms-action-babel))
+ (when-let ((block-element (ms--get-block obj "end")))
+ (ms--clear-results obj)
+ (ms--block-execute block-element)))
+
+(cl-defmethod ms-final :after ((obj ms-action-babel))
+ (when-let ((block-element (ms--get-block obj "final")))
+ (ms--block-execute block-element)
+ (ms--clear-results obj)))
+
+;; ** Image Action
+
+(defclass ms-action-image (ms-action)
+ () "Show images fullscreen in a buffer.")
+
+;; TODO implementation relies on org link opening. Does not check for file or
+;; check that image mode displays the link correctly.
+;; TODO extract buffer-slide setup logic a bit to make writing these easier.
+(cl-defmethod ms-step-forward
+ ((obj ms-action-image))
+ (save-excursion
+ (goto-char (ms-marker obj))
+ (if-let ((link (ms-section-next
+ (oref obj parent) 'link)))
+ (progn (let ((deck ms--deck)
+ (window-config (current-window-configuration)))
+ ;; changes buffer, hopefully to image-mode
+ (let ((org-link-frame-setup '((file . find-file)))
+ (display-buffer-overriding-action
'(display-buffer-full-frame)))
+ (org-link-open link))
+ ;; TODO success detection
+ (when (eq (buffer-local-value 'major-mode (current-buffer))
+ 'image-mode)
+ (image-transform-fit-to-window))
+ (let* ((image-buffer (current-buffer))
+ (callback (lambda (_)
+ (with-current-buffer image-buffer
+ (ms-buffer-slide-mode -1))
+ (when (buffer-live-p image-buffer)
+ ;; TODO optional kill ☠️🔪🩸
+ (bury-buffer image-buffer))
+ (set-window-configuration window-config)
+ ;; When callback returns nil, next forward
+ ;; step can proceed
+ nil)))
+ (ms-run-as-next-step deck callback)
+ (setq-local ms--deck deck)
+ (ms-buffer-slide-mode 1)))
+ (ms-marker obj (org-element-begin link)))
+ (ms-marker obj (org-element-end
+ (ms-heading
+ (oref obj parent))))
+ nil)))
+
+;; TODO this won't show the images going backward
+(cl-defmethod ms-step-backward
+ ((obj ms-action-image))
+ (save-excursion
+ (goto-char (ms-marker obj))
+ (if-let ((link (ms-section-previous
+ (oref obj parent) 'link)))
+ (progn
+ (ms-marker obj (org-element-begin link)))
+ (ms-marker obj (org-element-begin
+ (ms-heading
+ (oref obj parent))))
+ nil)))
+;; ** Default Child Action
+(defclass ms-child-action-slide (ms-action) ()
+ "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)))
+ (ms--make-slide child (oref obj parent))))
+
+(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
+ (when-let ((child (ms-backward-child obj)))
+ (ms--make-slide child (oref obj parent))))
+
+;; ** Inline Child Action
+;; While the basics of making a child out of the next heading are the same, an
+;; action that controls children on its own does not return them. It needs to
+;; update the buffer restriction as necessary, call lifecycle functions, and
+;; pass through calls to step forward.
+
+;; TODO round-robin child action
+;; TODO every-child action
+;; TODO inherited child actions
+;; TODO generalize
+(defclass ms-child-action-inline (ms-action)
+ ((children :initform nil "Children that have been instantiated.")
+ (backward-hack :initform nil "Extra backward step from end."))
+ "Display children inline with the parent.")
+
+(cl-defmethod ms-step-forward
+ ((obj ms-child-action-inline))
+
+ (let (progress
+ exhausted
+ (children (when (slot-boundp obj 'children)
+ (oref obj children))))
+ ;; Loop exists in case the next child is no-op. Same as in the deck.
+ (while (not (or progress exhausted))
+ ;; First try the most recently added child
+ (setq progress (and children
+ (ms-step-forward (car children))))
+
+ ;; TODO The likely way we want to handle this is to override the child's
+ ;; child-action so that it handles its own children.
+ (when (eieio-object-p progress)
+ (warn "Deep inline not yet supported yet!"))
+
+ ;; If the child didn't make progress, try to load up the next child
+ (unless progress
+ (if-let ((child-heading (ms-forward-child obj))
+ (child (ms--make-slide child-heading
+ (oref obj parent))))
+ (progn
+ (push child children)
+ (oset obj children children)
+ (ms-init child))
+ (ms-marker obj (org-element-end
+ (ms-heading
+ (oref obj parent))))
+ (setq exhausted t))))
+ ;; Don't return any child objects to the deck or it will treat them like
+ ;; slides
+ (not (null progress))))
+
+(cl-defmethod ms-step-backward
+ ((obj ms-child-action-inline))
+ ;; TODO If a child can't go backwards, it should be discarded, so the
backward
+ ;; implementation actually should be easy. However, at the moment, the
+ ;; implementation is a bit of a lucky shotgun, and I'm going to make a second
+ ;; pass after building some more child actions.
+
+ ;; Called for side-effect, moving the marker backwards. What a hack.
+ (or (ms-backward-child obj)
+ (ms-marker obj (org-element-begin
+ (ms-heading
+ (oref obj parent)))))
+
+ (when-let* ((children (when (slot-boundp obj 'children)
+ (oref obj children)))
+ (last-child (car children)))
+
+ ;; TODO this is dumb, but I need to figure out how to get the display
action
+ ;; for children and the section to play nice with inline children.
+ (if (oref obj backward-hack) (progn (oset obj backward-hack nil) t)
+ (let ((progress (ms-step-backward last-child)))
+
+ (unless progress
+ (ms-final last-child)
+ (oset obj children (cdr children))
+ (narrow-to-region (point-min) (org-element-begin
+ (ms-heading last-child)))
+
+ (setq progress t))
+
+ ;; TODO same as in forward, this needs to be handled by overriding the
+ ;; child's child-action
+ (if (eieio-object-p progress)
+ (warn "Deep inline not supported yet!"))
+
+ ;; Don't return any child objects to the deck or it will treat them
like
+ ;; slides
+ (not (null progress))))))
+
+(cl-defmethod ms-end :after
+ ((obj ms-child-action-inline))
+ ;; TODO yeah, these are some state hacks. Let's try to de-couple this
better.
+ (oset obj backward-hack t)
+ (ms-marker obj (org-element-begin
+ (ms-heading
+ (oref obj parent))))
+ (ms-narrow obj t)
+ (while (ms-step-forward obj)
+ t))
+
+(cl-defmethod ms-final :after
+ ((obj ms-child-action-inline))
+ (mapc #'ms-final (oref obj children)))
+
+;; * Filters
+
+(defun ms-built-in-filter (heading)
+ "HEADING is an org element.
+Return the heading unless it's filtered."
+ ;; TODO implement. This is not particularly hard. The filtering must be
done
+ ;; according to the parent's predicate. Slides and decks implement parent.
+ ;; Actions should use their parent's predicate.
+ heading)
+
+;; * Hiding Elements
+
+;; Use of the hide-* functions assumes the tree is within the buffer narrowing
+;; restriction and also not folded. Try `org-fold-show-subtree' and
+;; `org-cycle-tree' before calling if strange behavior is observed.
+
+;; TODO keep-lines seems kind of slow
+(defun ms-hide-region (beg end &optional keep-lines)
+ "Return overlay hiding region between BEG and END.
+Optional KEEP-LINES will replace region with as many newlines as
+the region contains, preserving vertical size."
+ (let ((ov (make-overlay beg end))
+ (lines (if keep-lines
+ (let ((found 0))
+ (save-excursion
+ (goto-char beg)
+ (while (re-search-forward "\n" end t)
+ (setq found (1+ found))))
+ found)
+ 0)))
+ (overlay-put ov 'display (make-string lines ?\n))
+ ov))
+
+(defun ms-hide-element (element &optional keep-lines)
+ "Return an overlay that will hide ELEMENT.
+Element is an org element. Optional KEEP-LINES will replace
+region with as many newlines as the region contains, preserving
+vertical size."
+ (ms-hide-region (org-element-begin element)
+ (org-element-end element)
+ keep-lines))
+
+(defun ms-hide-item (item &optional keep-lines)
+ "Return an overlay that hides ITEM.
+See `org-item-struct' for structure of ITEM. Note, this hides
+the entire item, which may contain sub-items, but revealing
+children of a hidden parent doesn't really make sense.
+
+Optional KEEP-LINES will replace region with as many newlines as
+the region contains, preserving vertical size."
+ (ms-hide-region
+ (car item) (car (last item)) keep-lines))
+
+(defun ms-hide-contents (element &optional keep-lines)
+ "Return an overlay that hides the contents of ELEMENT.
+Element is an org element. You should probably not use this on
+headings because their contents includes the sections and the
+children.
+
+Optional KEEP-LINES will replace region with as many newlines as
+the region contains, preserving vertical size."
+ (ms-hide-region (org-element-contents-begin element)
+ (org-element-end element)
+ keep-lines))
+
+(defun ms-hide-section (heading &optional keep-lines)
+ "Return an overlay that hides the section of ELEMENT.
+Element is an org element. You should probably not use this on
+headings because their section includes the sections and the
+children.
+
+Optional KEEP-LINES will replace region with as many newlines as
+the region contains, preserving vertical size."
+ (save-excursion
+ (goto-char (org-element-begin heading))
+ (ms-hide-region
+ (ms--section-begin heading)
+ (ms--section-end heading)
+ keep-lines)))
+
+;; * Element Mapping
+
+;; Functions of headings are private so that corresponding slide methods can be
+;; public. Private methods with public counterparts are at least as stable as
+;; the public method.
+
+(defun ms--map
+ (element type fun &optional info first-match no-recursion)
+ "Map over the contents of the ELEMENT.
+TYPE and FUNCTION are described in `org-element-map'."
+ (let ((type (if (listp type) type (list type))))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (org-element-begin element)
+ (org-element-end element))
+ (let ((data (org-element-parse-buffer)))
+ (org-element-map data type fun info
+ first-match no-recursion))))))
+
+(defun ms--contents-map
+ (element type fun &optional info first-match no-recursion)
+ "Map over the contents of the ELEMENT.
+TYPE and FUNCTION are described in `org-element-map'."
+ (let ((type (if (listp type) type (list type))))
+ (save-excursion
+ (save-restriction
+ (when-let ((begin (org-element-contents-begin element))
+ (end (org-element-contents-end element)))
+ (narrow-to-region begin end)
+ (let ((data (org-element-parse-buffer)))
+ (org-element-map data type fun info
+ first-match no-recursion)))))))
+
+(defun ms--section-map
+ (heading type fun &optional info first-match no-recursion)
+ "Map the SECTION of HEADING.
+This includes all text up to the rist child."
+ (when-let ((section (ms--section heading)))
+ (ms--map section type fun info
+ first-match no-recursion)))
+
+(defun ms--section-next
+ (heading type &optional pred info no-recursion)
+ "Return next element of TYPE that begins after point.
+Optional PRED should accept ELEMENT and return non-nil if
+matched."
+ (let* ((current-point (point))
+ (combined-pred (ms-and
+ pred (lambda (e)
+ (> (org-element-begin e)
+ current-point)))))
+ (ms--section-map
+ heading type combined-pred info t no-recursion)))
+
+(defun ms--section-previous
+ (heading type &optional pred info no-recursion)
+ "Return previous element of TYPE that begins before point.
+Optional PRED should accept ELEMENT and return non-nil if
+matched."
+ (let* ((current-point (point))
+ (combined-pred (ms-and
+ pred (lambda (e)
+ (< (org-element-begin e)
+ current-point)))))
+ ;; We can't map in reverse, so just retrievel all matched elements and
+ ;; return the last one.
+ (car (last (ms--section-map
+ heading type combined-pred info nil no-recursion)))))
+
+(defun ms--section (heading)
+ "Get the section of a HEADING."
+ (ms--map
+ heading 'section #'identity nil t t))
+
+(defun ms--section-begin (heading)
+ "Always returns a point, even for empty headings."
+ (if-let ((section (ms--map
+ heading 'section #'identity nil t t)))
+ (org-element-begin section)
+ (or (org-element-contents-begin heading)
+ (org-element-end heading))))
+
+(defun ms--section-end (heading)
+ "Always returns a point, even for empty headings."
+ (let ((not-self (lambda (e) (unless (equal (org-element-begin e)
+ (org-element-begin heading))
+ e))))
+ (if-let ((section-or-heading (ms--map
+ heading '(headline section)
+ not-self nil t t)))
+ (if (eq (org-element-type section-or-heading)
+ 'headline)
+ (org-element-begin section-or-heading)
+ (org-element-end section-or-heading))
+ (or
+ (org-element-contents-begin heading)
+ (org-element-end heading)))))
+
+(defun ms--first-child (heading &optional predicate)
+ "Get the first direct child of HEADING matched by PREDICATE."
+ (save-restriction
+ (widen)
+ (seq-find #'identity
+ ;; TODO does children return nils? Collect it without nils if
so.
+ (ms--children heading predicate))))
+
+(defun ms--last-child (heading &optional predicate)
+ "Get the last direct child of HEADING matched by PREDICATE."
+ (save-restriction
+ (widen)
+ (seq-find #'identity
+ (reverse (ms--children heading predicate)))))
+
+(defun ms--children (heading &optional predicate)
+ "Get the direct children of HEADING."
+ (ms--contents-map
+ heading 'headline
+ (ms--child-predicate heading predicate)
+ nil nil t))
+
+;; TODO these two functions behaved badly and rely on non-element methods of
+;; unknown behavior
+(defun ms--previous-sibling (heading &optional predicate)
+ "Return the previous sibling HEADING if it exists.
+PREDICATE should accept an ELEMENT argument and return non-nil."
+ (without-restriction
+ (save-excursion
+ (goto-char (org-element-begin heading))
+ (let* ((predicate (or predicate #'identity))
+ found)
+ (while (and (> (point) (point-min))
+ (not found)
+ (org-get-previous-sibling))
+ (let ((element (org-element-at-point)))
+ (when (and (eq (org-element-type element) 'headline)
+ (funcall predicate element))
+ (setq found element))))
+ found))))
+
+(defun ms--next-sibling (heading &optional predicate)
+ "Return the next sibling HEADING if it exists.
+PREDICATE should accept an ELEMENT argument and return non-nil."
+ (without-restriction
+ (save-excursion
+ (goto-char (org-element-begin heading))
+ (let* ((predicate (or predicate #'identity))
+ found)
+ (while (and (< (point) (point-max))
+ (not found)
+ (org-get-next-sibling))
+ (let ((element (org-element-at-point)))
+ (when (and (eq (org-element-type element) 'headline)
+ (funcall predicate element))
+ (setq found element))))
+ found))))
+
+(defun ms--list-item-contains (item loc)
+ (when item
+ (let ((beg (car item))
+ (end (car (last item))))
+ (and (>= loc beg)
+ (< loc end)))))
+
+(defun ms-type-p (element-or-type type)
+ "Check element TYPE.
+ELEMENT-OR-TYPE can be a type symbol or an org element. TYPE can
+be a list of types or a type from `org-element-all-elements.'"
+ (when-let ((element-type (or (when (symbolp element-or-type)
+ element-or-type)
+ (and element-or-type
+ (org-element-type
+ element-or-type)))))
+ (if (listp type)
+ (member element-type type)
+ (eq element-type type))))
+
+(defun ms-and (&rest predicates)
+ "Combine PREDICATES for filtering elements.
+Each predicate should take one argument, an org element."
+ (lambda (element)
+ (seq-reduce
+ (lambda (init pred)
+ (when (or (not pred)
+ (and init (funcall pred init)))
+ init))
+ predicates element)))
+
+(defun ms--child-predicate (heading &optional predicate)
+ "Returns a predicate to filter direct children matching PREDICATE.
+PREDICATE should return matching children."
+ (let ((level (org-element-property :level heading))
+ (predicate (or predicate #'identity)))
+ (lambda (child)
+ (and (= (1+ level) (org-element-property :level child))
+ (funcall predicate child)
+ child))))
+
+(defun ms--heading-p (element)
+ "Really wish they would just normalize headline and heading."
+ (ms-type-p element 'headline))
+
+(defun ms--element-root (element &optional type)
+ "Get the root parent of ELEMENT of TYPE.
+TYPE is a list or type symbol."
+ (let ((parent (org-element-parent element)))
+ (while parent
+ (if (or (not type)
+ (ms-type-p parent type))
+ (setq element parent
+ parent (org-element-parent parent))
+ (setq parent nil)))
+ element))
+
+(defun ms--document-first-heading ()
+ "Return the first heading element"
+ (save-restriction
+ (widen)
+ (save-excursion
+ (let ((buffer-invisibility-spec nil))
+ (goto-char (point-min))
+ (let ((first-element (org-element-at-point)))
+ (if (and first-element
+ (eq (org-element-type first-element 'headline)
+ 'headline))
+ (org-element-at-point)
+ (when (re-search-forward org-outline-regexp-bol nil t)
+ (goto-char (match-beginning 0))
+ (org-element-at-point))))))))
+
+(defun ms--root-heading-at-point ()
+ "Return the root heading if the point is contained by one.
+Does not modify the point."
+ (let* ((element (org-element-at-point))
+ (parent (ms--element-root
+ element 'headline)))
+ (if (eq 'headline (org-element-type element))
+ element
+ (ms--any-heading))))
+
+(defun ms--any-heading ()
+ "Return any heading that can be found.
+Does not modifiy the point."
+ (save-excursion
+ (if (not (numberp (org-back-to-heading-or-point-min)))
+ (org-element-at-point)
+ (when (re-search-forward org-heading-regexp)
+ (org-back-to-heading)
+ (org-element-at-point)))))
+
+;; * Slide Header
+
+;; These variables were brought forward from `ms'. There's not
+;; sufficient reason to upgrade them to customize variables nor remove them as
+;; it's easy to customize them in cases where it's necessary although this is
+;; not expected to become useful.
+
+;; TODO these can be used across buffers when set before cloning indirect
+;; buffers, but that's a coincidence, not necessarilly a design choice.
+(defvar-local ms-title nil
+ "Presentation title.
+If you have \"#+title:\" line in your org buffer, it wil be used
+as a title of the slide. If the buffer has no \"#+title:\" line,
+the name of current buffer will be displayed.")
+
+(defvar-local ms-email nil
+ "Email address.
+If you have \"#+email:\" line in your org buffer, it will be used
+as an address of the slide.")
+
+(defvar-local ms-author nil
+ "Author name.
+If you have \"#+author:\" line in your org buffer, it will be
+used as a name of the slide author.")
+
+(defvar-local ms-date nil
+ "Date.
+If you have \"#+date:\" line in your org buffer, it will be used
+as the date.")
+
+;; TODO make public
+(defun ms--make-header (&optional no-breadcrumbs)
+ "Draw a header for the first tree in the restriction.
+Set optional NO-BREADCRUMBS to non-nil to skip breadcrumbs. The implementation
+assumes the buffer is restricted and that there is a first tree."
+ (ms--delete-header)
+
+ ;; Use of point-min is an implementation assumption, that the header is
always
+ ;; at the very top of the narrowed region and never wanted anywhere else.
+ (setq ms--header-overlay
+ (make-overlay (point-min) (+ 1 (point-min))))
+
+ (let* ((blank-lines ms-content-margin-top)
+ (keywords (org-collect-keywords
+ '("TITLE" "EMAIL" "AUTHOR" "DATE")))
+ (title (or ms-title
+ (cadr (assoc-string "TITLE" keywords))
+ (buffer-name)))
+ (author (or ms-author
+ (cadr (assoc "AUTHOR" keywords))))
+ (date (or ms-date
+ (cadr (assoc-string "DATE" keywords))
+ (format-time-string "%Y-%m-%d")))
+ (email (when-let ((email (or ms-email
+ (cadr (assoc-string "EMAIL" keywords)))))
+ (concat "<" email ">"))))
+
+ ;; The calls to `propertize' make up for the fact that these values may be
+ ;; strings, set from elsewhere, but we want to display these strings as if
+ ;; they were fontified within the buffer.
+ (if ms-header
+ (overlay-put
+ ms--header-overlay 'before-string
+ (concat (propertize title 'face 'org-document-title)
+ (ms--info-face "\n")
+ (when (and ms-header-date date)
+ (ms--info-face (concat date " ")))
+ (when (and ms-header-author author)
+ (ms--info-face (concat author " ")))
+ (when (and ms-header-email email)
+ (ms--info-face (concat email " ")))
+ (when (and (not no-breadcrumbs)
+ ms-breadcrumb-separator)
+ (concat (ms--info-face "\n")
+ (ms--get-parents
+ ms-breadcrumb-separator)))
+ (ms--get-blank-lines blank-lines)))
+
+ (overlay-put ms--header-overlay 'before-string
+ (ms--get-blank-lines blank-lines)))))
+
+(defun ms--info-face (s)
+ (propertize s 'face 'org-document-info))
+
+(defun ms--get-blank-lines (lines)
+ "Return breaks by LINES."
+ (ms--info-face (make-string lines ?\12))) ; ?\12 is newline char
+
+(defun ms--breadcrumbs-reducer (delim)
+ (lambda (previous next)
+ (if (not previous) next
+ (let ((props (text-properties-at (1- (length previous)) previous)))
+ (concat previous (apply #'propertize delim props)
+ next)))))
+
+;; TODO element API
+(defun ms--get-parents (delim)
+ "Get parent headings and concat them with DELIM."
+
+ ;; The implementation here uses the regex & point-based techniques so that
+ ;; we're extracting buffer strings, which saves us from having to re-style
+ ;; them to match whatever is in the buffer.
+ (save-excursion
+ (goto-char (point-min))
+ (save-restriction
+ (widen)
+ (let ((parents nil)
+ (reducer (ms--breadcrumbs-reducer delim)))
+ (while (org-up-heading-safe)
+ (push (org-get-heading
+ 'no-tags
+ ms-breadcrumbs-hide-todo-state)
+ parents))
+ (let ((breadcrumbs (seq-reduce reducer parents nil)))
+ (when ms-breadcrumb-face
+ (add-face-text-property 0 (length breadcrumbs)
+ ms-breadcrumb-face
+ nil
+ breadcrumbs))
+ breadcrumbs)))))
+
+(defun ms--delete-header ()
+ "Delete header."
+ (when ms--header-overlay
+ (delete-overlay ms--header-overlay)))
+
+;; ** ANIMATION
+
+(defvar-local ms--animation-timer nil)
+(defvar-local ms--animation-overlay nil)
+
+(defcustom ms-animation-duration 1.0
+ "How long slide in takes."
+ :type 'number
+ :group 'macro-slides)
+
+(defcustom ms-animation-frame-duration (/ 1.0 60.0)
+ "Length between updates.
+Increase if your so-called machine has trouble drawing."
+ :type 'number
+ :group 'macro-slides)
+
+;; TODO move respect for animation variables into this function
+;; TODO END is a redundant argument unless a virtual newline is introduced.
+;; Test if an overlay can can work via after-string.
+;; TODO Support non-graphical
+(defun ms-animation-setup (beg end)
+ "Slide in the region from BEG to END.
+Everything after BEG will be animated. The region between BEG
+and the value of `point-max' should contain a newline somewhere."
+ (unless (ms-live-p)
+ (error "Slide animation attempted without active deck"))
+ (unless (buffer-base-buffer (current-buffer))
+ (error "Slide animation attempted in wrong buffer"))
+ (ms--animation-cleanup)
+ (let* ((timer (setq ms--animation-timer (timer-create)))
+ (goal-time (time-add (current-time)
+ ms-animation-duration))
+ (newline-region (save-match-data
+ (save-excursion
+ (goto-char beg)
+ (if (re-search-forward "\n" end t)
+ (list (match-beginning 0)
+ (match-end 0))
+ (error "No newline in region")))))
+ (overlay (setq ms--animation-overlay
+ (apply #'make-overlay newline-region)))
+ (initial-line-height
+ (or (plist-get
+ (text-properties-at (car newline-region))
+ 'line-height)
+ 1.0)))
+ (timer-set-time timer (current-time)
+ ms-animation-frame-duration)
+ (timer-set-function timer #'ms--animate
+ (list goal-time overlay initial-line-height))
+ (timer-activate timer)))
+
+;; * Assorted Implementation Details
+
+;; TODO Watching actions, results, and slides is way too opaque
+(defun ms--debug (slide)
+ (when ms--debug
+ (let* ((heading (ms-heading slide))
+ (headline-begin (org-element-begin heading))
+ (headline-end (or (org-element-contents-begin heading)
+ (org-element-end heading))))
+ (message "begin: %s heading: %s"
+ (marker-position (oref slide begin))
+ (save-restriction
+ (widen)
+ (buffer-substring headline-begin (1- headline-end)))))))
+
+(defun ms--clean-up-state ()
+ "Clean up states between contents and slides."
+ (ms--delete-header)
+ (ms--delete-overlays)
+ (ms--animation-cleanup))
+
+(defun ms--ensure-deck ()
+ "Prepare for starting the minor mode.
+Call this when writing commands that could be called before or
+after a deck exists but should create a deck if it does not exist.
+
+In functions that should only be called when a deck is alive and
+associated with the current buffer, use `ms-live-p'
+and throw an error if it's not live.
+
+This function sets up the deck and links the buffers together via
+the deck object. Many operations such as calling hooks must
+occur in the display buffer."
+ (cond
+ ((ms-live-p)) ; TODO maybe display something?
+ (t
+ ;; Prevent starting within indirect buffers
+ (when (buffer-base-buffer (current-buffer))
+ (error "Buffer is indirect but deck is already live"))
+
+ ;; TODO check assumed initial conditions
+ (let* ((base-buffer (current-buffer))
+ (slide-buffer-name (format "*deck: %s*" (buffer-name
+ base-buffer))))
+ (ms--feedback :start)
+
+ ;; stale buffers likely indicate an issue
+ (when-let ((stale-buffer (get-buffer slide-buffer-name)))
+ (display-warning '(ms ms--ensure-deck)
+ "Stale deck buffer was killed")
+ (kill-buffer slide-buffer-name))
+
+ (let* ((class (or (intern-soft (ms--keyword-value
+ "DECK_CLASS"))
+ ms-default-deck-class
+ 'ms-deck))
+ (window-config (current-window-configuration))
+
+ (slide-buffer (clone-indirect-buffer
+ slide-buffer-name
+ nil))
+
+ ;; TODO no initial marker
+ (deck (make-instance class
+ :base-buffer base-buffer
+ :slide-buffer slide-buffer
+ :window-config window-config)))
+ ;; Set the deck in both base and slide buffer
+ (setq ms--deck deck)
+ (switch-to-buffer slide-buffer) ;; TODO display options?
+ (setq ms--deck deck)
+
+ (widen)
+ (org-fold-show-all)
+ ;; Enter the state model
+ (ms--choose-slide ms--deck
+ ms-start-from)
+ (ms--remap-faces t))))))
+
+(defun ms--showing-contents-p ()
+ "Return t if current buffer is displaying contents."
+ (and ms--deck
+ (eq (current-buffer) (oref ms--deck slide-buffer))
+ (eq 'contents (oref ms--deck display-state))))
+
+(defun ms--showing-slides-p ()
+ "Return t if current buffer is displaying contents."
+ (and ms--deck
+ (eq (current-buffer) (oref ms--deck slide-buffer))
+ (eq 'slides (oref ms--deck display-state))))
+
+(defun ms--delete-overlays ()
+ "Delete content overlays."
+ (while ms--overlays
+ (delete-overlay (pop ms--overlays))))
+
+(defun ms--animate (goal-time overlay initial-line-height)
+ (if (time-less-p goal-time (current-time))
+ (ms--animation-cleanup)
+ (let* ((diff (time-to-seconds (time-subtract goal-time (current-time))))
+ (fraction (expt (/ diff ms-animation-duration) 5.0))
+ (lines ms-slide-in-blank-lines)
+ (line-height (* (+ initial-line-height lines)
+ fraction)))
+ (overlay-put overlay 'line-height line-height))))
+
+(defun ms--animation-cleanup ()
+ (when ms--animation-timer
+ (cancel-timer ms--animation-timer))
+ (when ms--animation-overlay
+ (delete-overlay ms--animation-overlay))
+ (setq ms--animation-overlay nil
+ ms--animation-timer nil))
+
+(defun ms--assert-slide-buffer ()
+ (unless (ms-live-p)
+ (error "Live deck not found within buffer"))
+ (unless (eq (current-buffer)
+ (oref ms--deck slide-buffer))
+ (error "Not in slide buffer")))
+
+;; TODO check usages
+(defun ms--ensure-slide-buffer ()
+ (unless (ms-live-p)
+ (error "Live deck not found within buffer"))
+ ;; TODO display?
+ (switch-to-buffer (oref ms--deck slide-buffer)))
+
+(defun ms--keyword-value (key)
+ "Get values like #+KEY from document keywords."
+ (cadr (assoc-string key (org-collect-keywords `(,key)))))
+
+(defun ms--feedback (key)
+ "Explicit feedback for commands without visible side effects."
+ (when-let ((feedback (plist-get ms-feedback-messages
+ key)))
+ (message "%s" feedback)))
+
+;; TODO these could check for inheritance from some base class, which would
save
+;; people who write action names in the class property etc.
+(defun ms--classes (class-names)
+ "CLASS-NAMES is a string that might contain class names."
+ (when class-names
+ (let ((class-names (if (stringp class-names)
+ (string-split class-names)
+ class-names)))
+ (cl-loop for name in class-names
+ for symbol = (or (when (symbolp name) name)
+ (intern-soft name))
+ if (get symbol 'cl--class)
+ collect symbol
+ else
+ do (display-warning
+ '(ms
+ ms-class
+ ms-filter)
+ (format "Class name not a class: %s" name))))))
+
+(defun ms--filter (filter-name)
+ "FILTER-NAME is a string that might contain a filter name."
+ (when-let ((symbol (or (when (symbolp filter-name)
+ filter-name)
+ (intern-soft filter-name))))
+ (if (functionp symbol)
+ symbol
+ (display-warning
+ '(ms
+ ms-class
+ ms-filter)
+ (format "Filter name not a function: %s" filter-name)))))
+
+(defun ms--class (class-name)
+ "CLASS-NAME is a string or symbol that should be a class name."
+ (when-let ((symbol (or (when (symbolp class-name)
+ class-name)
+ (intern-soft class-name))))
+ (if (get symbol 'cl--class)
+ symbol
+ (display-warning
+ '(ms
+ ms-class
+ ms-class)
+ (format "Class name not a class: %s" class-name)))))
+
+;; TODO let's just move face remapping to MOC
+(defun ms--remap-faces (status)
+ "Change status of heading face. If STATUS is nil, apply the default values."
+ (cond
+ (status
+ (setq
+ ms-heading-level-1-cookie
+ (face-remap-add-relative 'org-level-1 'ms-heading-level-1)
+ ms-heading-level-2-cookie
+ (face-remap-add-relative 'org-level-2 'ms-heading-level-2)
+ ms-heading-level-3-cookie
+ (face-remap-add-relative 'org-level-3 'ms-heading-level-3)
+ ms-heading-level-4-cookie
+ (face-remap-add-relative 'org-level-4 'ms-heading-level-4)
+ ms-heading-level-5-cookie
+ (face-remap-add-relative 'org-level-5 'ms-heading-level-5)
+ ms-heading-level-6-cookie
+ (face-remap-add-relative 'org-level-6 'ms-heading-level-6)
+ ms-heading-level-7-cookie
+ (face-remap-add-relative 'org-level-7 'ms-heading-level-7)
+ ms-heading-level-8-cookie
+ (face-remap-add-relative 'org-level-8 'ms-heading-level-8)
+ ms-document-title-cookie
+ (face-remap-add-relative 'org-document-title
+ 'ms-document-title)
+ ms-document-info-cookie
+ (face-remap-add-relative 'org-document-info
+ 'ms-document-info)))
+ (t
+ (face-remap-remove-relative ms-heading-level-1-cookie)
+ (face-remap-remove-relative ms-heading-level-2-cookie)
+ (face-remap-remove-relative ms-heading-level-3-cookie)
+ (face-remap-remove-relative ms-heading-level-4-cookie)
+ (face-remap-remove-relative ms-heading-level-5-cookie)
+ (face-remap-remove-relative ms-heading-level-6-cookie)
+ (face-remap-remove-relative ms-heading-level-7-cookie)
+ (face-remap-remove-relative ms-heading-level-8-cookie)
+ (face-remap-remove-relative ms-document-title-cookie)
+ (face-remap-remove-relative ms-document-info-cookie))))
+
+(provide 'macro-slides)
diff --git a/org-tree-slide-compt.el b/org-tree-slide-compt.el
deleted file mode 100644
index a7d6534050..0000000000
--- a/org-tree-slide-compt.el
+++ /dev/null
@@ -1,50 +0,0 @@
-;; These functions shall be loaded for Emacs 25.1 or earlier.
-;; outline-show-children <- show-children
-;; outline-show-subtree <- show-subtree
-;; outline-hide-subtree <- hide-subtree
-
-(defun outline-show-children (&optional level)
- "Show all direct subheadings of this heading.
-Prefix arg LEVEL is how many levels below the current level should be shown.
-Default is enough to cause the following heading to appear."
- (interactive "P")
- (setq level
- (if level (prefix-numeric-value level)
- (save-excursion
- (outline-back-to-heading)
- (let ((start-level (funcall outline-level)))
- (outline-next-heading)
- (if (eobp)
- 1
- (max 1 (- (funcall outline-level) start-level)))))))
- (let (outline-view-change-hook)
- (save-excursion
- (outline-back-to-heading)
- (setq level (+ level (funcall outline-level)))
- (outline-map-region
- (lambda ()
- (if (<= (funcall outline-level) level)
- (outline-show-heading)))
- (point)
- (progn (outline-end-of-subtree)
- (if (eobp) (point-max) (1+ (point)))))))
- (run-hooks 'outline-view-change-hook))
-
-
-(defun outline-show-subtree (&optional event)
- "Show everything after this heading at deeper levels.
-If non-nil, EVENT should be a mouse event."
- (interactive (list last-nonmenu-event))
- (save-excursion
- (when (mouse-event-p event)
- (mouse-set-point event))
- (outline-flag-subtree nil)))
-
-(defun outline-hide-subtree (&optional event)
- "Hide everything after this heading at deeper levels.
-If non-nil, EVENT should be a mouse event."
- (interactive (list last-nonmenu-event))
- (save-excursion
- (when (mouse-event-p event)
- (mouse-set-point event))
- (outline-flag-subtree t)))
diff --git a/org-tree-slide.el b/org-tree-slide.el
deleted file mode 100644
index 23f981fd1b..0000000000
--- a/org-tree-slide.el
+++ /dev/null
@@ -1,1080 +0,0 @@
-;;; org-tree-slide.el --- A presentation tool for org-mode -*-
lexical-binding: t; -*-
-;;
-;; Copyright (C) 2011-2023 Takaaki ISHIKAWA
-;;
-;; Author: Takaaki ISHIKAWA <takaxp at ieee dot org>
-;; Version: 2.8.22
-;; Package-Requires: ((emacs "25.2"))
-;; Maintainer: Takaaki ISHIKAWA <takaxp at ieee dot org>
-;; Twitter: @takaxp
-;; URL: https://github.com/takaxp/org-tree-slide
-;; Keywords: convenience, org-mode, presentation, narrowing
-;;
-;; Committers: Yuuki ARISAWA (@uk-ar)
-;; Eric S Fraga
-;; Eike Kettner
-;; Stefano BENNATI
-;; Matus Goljer
-;; Boruch Baum
-;;
-;; This program is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3 of the License, or
-;; (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-;;
-
-;;; Commentary:
-
-;; Requirement:
-;; org-mode 6.33x or higher version
-;; The latest version of the org-mode is recommended.
-;; (see https://orgmode.org/)
-;;
-;; Usage:
-;; 1. Put this elisp into your load-path
-;; 2. Add (require 'org-tree-slide) in your .emacs
-;; 3. Open an org-mode file
-;; 4. Toggle org-tree-slide-mode (M-x org-tree-slide-mode)
-;; then Slideshow will start and you can find "TSlide" in mode line.
-;; 5. `C-<'/`C->' will move between slides
-;; 6. `C-x s c' will show CONTENT of the org buffer
-;; Select a heading and type `C-<', then Slideshow will start again.
-;; 7. Toggle org-tree-slide-mode again to exit this minor mode
-;;
-;; Recommended minimum settings:
-;; (global-set-key (kbd "<f8>") 'org-tree-slide-mode)
-;; (global-set-key (kbd "S-<f8>") 'org-tree-slide-skip-done-toggle)
-;;
-;; and three useful profiles are available.
-;;
-;; 1. Simple use
-;; M-x org-tree-slide-simple-profile
-;;
-;; 2. Presentation use
-;; M-x org-tree-slide-presentation-profile
-;;
-;; 3. TODO Pursuit with narrowing
-;; M-x org-tree-slide-narrowing-control-profile
-;;
-;; Type `C-h f org-tree-slide-mode', you can find more detail.
-;;
-;; Note:
-;; - Make sure key maps below when you introduce this elisp.
-;; - Customize variables, M-x customize-group ENT org-tree-slide ENT
-;; - see also moom.el (https://github.com/takaxp/moom) to control Emacs
frame
-
-;;; Code:
-
-(require 'org)
-(require 'org-timer)
-(require 'face-remap)
-
-(defconst org-tree-slide "2.8.22"
- "The version number of the org-tree-slide.el.")
-
-(defgroup org-tree-slide nil
- "User variables for `org-tree-slide'."
- :group 'org-structure)
-
-(defcustom org-tree-slide-skip-outline-level 0
- "Skip slides if a heading level is higher than or equal to this variable.
-
- `0': never skip at any heading
- `1': will skip all slides and be terminated automatically.
- Not recommended to use this number.
- e.g. set `4',
- *** heading A ; display as a slide
- entry
- **** heading B ; skip! do not display as the next slide
- **** heading C ; skip!
- *** heading D ; display as the next slide"
- :type 'integer
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-fold-subtrees-skipped t
- "If this flag is true, the subtrees in a slide will be displayed in fold.
-
-When nil, the body of the subtrees will be revealed."
- :type 'boolean
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-header t
- "The status of displaying the slide header."
- :type 'boolean
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-header-author t
- "Show the email in the header.
-If there is a #+author: header, it will be used."
- :type 'boolean
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-header-email t
- "Show the email in the header.
-If there is a #+email: header, it will be used."
- :type 'boolean
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-header-date t
- "Show the date in the header.
-If there is a #+date: header, it will be used.
-The current time will be used as a fallback."
- :type 'boolean
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-content-margin-top 2
- "Specify the margin between the slide header and its content."
- :type 'integer
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-slide-in-effect t
- "Using a visual effect of slide-in for displaying trees."
- :type 'boolean
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-cursor-init t
- "Specify a cursor position at start and exit of the slideshow.
-
-Non-nil: the cursor will move automatically to the head of buffer.
-nil: keep the same position. The slideshow will start from the heading
- that has the cursor."
- :type 'boolean
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-slide-in-blank-lines 10
- "Specify the number of blank lines, the slide will move from this line."
- :type 'integer
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-slide-in-waiting 0.02
- "Specify the duration waiting the next update of overlay."
- :type 'float
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-heading-emphasis nil
- "Specify to use a custom face heading, or not."
- :type 'boolean
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-never-touch-face nil
- "If t, do NOT touch any face setting."
- :type 'boolean
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-breadcrumb-face nil
- "Face added to the list of faces for breadcrumbs.
-This can be a face name symbol or an anonymous font spec. It
-will be added to the face list, meaning it the original face's
-properties remain unless shadowed."
- :type 'face
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-skip-done nil
- "Specify to show TODO item only or not."
- :type 'boolean
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-skip-comments t
- "Specify to skip COMMENT item or not.
-t: skip only the current heading with COMMENT,
- child headings without COMMENT will be shown
-inherit: skip headings with COMMENT and its child headings
-nil: show even if it has COMMENT."
- :type '(choice
- (const :tag "Skip only headings with COMMENT" t)
- (const :tag "Skip headings with COMMENT and its child headings"
- inherit)
- (const :tag "Show headings even if it has COMMENT" nil))
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-activate-message
- "Hello! This is org-tree-slide :-)"
- "Message in mini buffer when \"org-tree-slide\" is activated."
- :type 'string
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-deactivate-message
- "Quit, Bye!"
- "Message in mini buffer when \"org-tree-slide\" is deactivated."
- :type 'string
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-modeline-display 'outside
- "Specify how to display the slide number in mode line.
-
- \='lighter: shown in lighter (update info actively, then it's slow)
- \='outside: update infomation when moving to the next/previous slide
- nil: nothing to be shown"
- :type 'symbol
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-indicator
- '(:next " Next >>" :previous "<< Previous" :content "<< CONTENT >>")
- "Specify the indication messages for changing slides.
-The specified string for NEXT will be used in `org-tree-slide-move-next-tree',
-PREVIOUS will be used in `org-tree-slide-move-previous-tree'.
-CONTENT will be used in `org-tree-slide-content'.
-If you want to show anything, just specify nil."
- :type 'plist
- :group 'org-tree-slide)
-
-(defvar org-tree-slide-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-x s c") 'org-tree-slide-content)
- ;; (define-key map (kbd "C-x s r") 'org-tree-slide-resume) ;; TODO
- (define-key map (kbd "C-<") 'org-tree-slide-move-previous-tree)
- (define-key map (kbd "C->") 'org-tree-slide-move-next-tree)
- map)
- "The keymap for `org-tree-slide'.")
-
-(defcustom org-tree-slide-heading-level-1
- '(outline-1 :height 1.5 bold)
- "Level 1."
- :type 'list
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-heading-level-2
- '(outline-2 :height 1.4 bold)
- "Level 2."
- :type 'list
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-heading-level-3
- '(outline-3 :height 1.3 bold)
- "Level 3."
- :type 'list
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-heading-level-4
- '(outline-4 :height 1.2 bold)
- "Level 4."
- :type 'list
- :group 'org-tree-slide)
-
-(defvar-local org-tree-slide-heading-level-1-cookie nil)
-(defvar-local org-tree-slide-heading-level-2-cookie nil)
-(defvar-local org-tree-slide-heading-level-3-cookie nil)
-(defvar-local org-tree-slide-heading-level-4-cookie nil)
-
-(defvar org-tree-slide-mode nil)
-(defvar org-tree-slide-play-hook nil
- "A hook run when `org-tree-slide--play' is evaluated to start the
slideshow.")
-(defvar org-tree-slide-stop-hook nil
- "A hook run when `org-tree-slide--stop' is evaluated to stop the slideshow.")
-(defvar org-tree-slide-before-narrow-hook nil
- "A hook run before evaluating `org-tree-slide--display-tree-with-narrow'.")
-(defvar org-tree-slide-after-narrow-hook nil
- "A hook run after evaluating `org-tree-slide--display-tree-with-narrow'.")
-(defvar org-tree-slide-before-move-next-hook nil
- "A hook run before moving to the next slide.")
-(defvar org-tree-slide-before-move-previous-hook nil
- "A hook run before moving to the previous slide.")
-(defvar org-tree-slide-before-content-view-hook nil
- "A hook run before showing the content.")
-
-;;;###autoload
-(define-minor-mode org-tree-slide-mode
- "A presentation tool for Org Mode.
-
-Usage:
- - Set minimal recommendation settings in .emacs
- (global-set-key (kbd \"<f8>\") \='org-tree-slide-mode)
- (global-set-key (kbd \"S-<f8>\") \='org-tree-slide-skip-done-toggle)
- - Open an org file
- - Type <f8> to start org-tree-slide-mode
- - Type C-< / C-> to move between trees
- - To exit this minor mode, just type <f8> again.
-
-Profiles:
-
- - [ Simple ]
- => \\[command] `org-tree-slide-simple-profile'
-
- 1. No header display
- 2. No slide-in effect
- 3. The cursor will move to the head of buffer when exit
- 4. No slide number display in mode line
- 5. Display every type of tree
-
- - [ Presentation ]
- => \\[command] `org-tree-slide-presentation-profile'
-
- 1. Display header
- 2. Enable slide-in effect
- 3. The cursor will move to the head of buffer when exit
- 4. Display slide number in mode line
- 5. Display every type of tree
-
- - [ TODO Pursuit with narrowing ]
- => \\[command] `org-tree-slide-narrowing-control-profile'
-
- 1. No header display
- 2. No slide-in effect
- 3. The cursor will keep the same position when exit
- 4. Display slide number in mode line
- 5. Display TODO trees only"
- :init-value nil
- :lighter (:eval (org-tree-slide--update-modeline))
- :keymap org-tree-slide-mode-map
- :group 'org-tree-slide
- :require 'org
- (if org-tree-slide-mode
- (org-tree-slide--setup)
- (org-tree-slide--abort)))
-
-;;;###autoload
-(defun org-tree-slide-play-with-timer ()
- "Start slideshow with setting a count down timer."
- (interactive)
- (org-timer-set-timer)
- (unless (org-tree-slide--active-p)
- (org-tree-slide-mode)))
-
-;;;###autoload
-(defun org-tree-slide-without-init-play ()
- "Start slideshow without the init play. Just enter \"org-tree-slide-mode\"."
- (interactive)
- (org-tree-slide-mode)
- (widen)
- (org-overview)
- (goto-char 1))
-
-(defvar org-tree-slide-content--pos nil
- "Where to return when toggling function `org-tree-slide-content'.")
-
-;;;###autoload
-(defun org-tree-slide-content ()
- "Change the display for viewing content of the org file."
- (interactive)
- (when (org-tree-slide--active-p)
- (cond
- (org-tree-slide-content--pos
- ;; (widen)
- (goto-char org-tree-slide-content--pos)
- (org-tree-slide--display-tree-with-narrow)
- (goto-char org-tree-slide-content--pos)
- (setq org-tree-slide-content--pos nil))
- (t
- (setq org-tree-slide-content--pos
- (max (1+ (point-min)) (point)))
- (run-hooks 'org-tree-slide-before-content-view-hook)
- (widen)
- (org-tree-slide--hide-slide-header)
- (org-tree-slide--move-to-the-first-heading)
- (org-overview)
- (cond ((eq 0 org-tree-slide-skip-outline-level)
- (org-content))
- ((< 2 org-tree-slide-skip-outline-level)
- (org-content (1- org-tree-slide-skip-outline-level))))
- ;; (goto-char (point-min))
- (redisplay)
- (goto-char org-tree-slide-content--pos)
- (let ((msg (plist-get org-tree-slide-indicator :content))
- (message-log-max nil))
- (when msg
- (message "%s" msg)))))))
-
-;;;###autoload
-(defun org-tree-slide-move-next-tree ()
- "Display the next slide."
- (interactive)
- (unless (org-tree-slide--active-p)
- (user-error "org-tree-slide-mode inactive"))
- (let ((msg (plist-get org-tree-slide-indicator :next))
- (message-log-max nil))
- (when msg
- (message "%s" msg)))
- (cond
- ((and (buffer-narrowed-p)
- (org-tree-slide--last-tree-p (point)))
- (org-tree-slide-content))
- ;; displaying a slide, not the contents
- ((or
- (or (and (org-tree-slide--before-first-heading-p)
- (not (org-at-heading-p)))
- ;; TODO when does this happen?
- (and (= (line-beginning-position) 1)
- (not (buffer-narrowed-p))))
- (or (org-tree-slide--first-heading-with-narrow-p)
- (not (org-at-heading-p))))
- (run-hooks 'org-tree-slide-before-move-next-hook)
- (widen)
- (org-tree-slide--outline-next-heading)
- (org-tree-slide--display-tree-with-narrow))
- ;; stay the same slide (for CONTENT MODE, on the subtrees)
- (t (org-tree-slide--display-tree-with-narrow))))
-
-;;;###autoload
-(defun org-tree-slide-move-previous-tree ()
- "Display the previous slide."
- (interactive)
- (unless (org-tree-slide--active-p)
- (user-error "org-tree-slide-mode inactive"))
- (let ((msg (plist-get org-tree-slide-indicator :previous))
- (message-log-max nil))
- (when msg
- (message "%s" msg)))
- (org-tree-slide--hide-slide-header) ; for at the first heading
- (run-hooks 'org-tree-slide-before-move-previous-hook)
- (widen)
- (cond
- ((org-tree-slide--before-first-heading-p)
- (message "before first heading (org-tree-slide)" ))
- ((not (org-at-heading-p))
- (org-tree-slide--outline-previous-heading)
- (org-tree-slide--outline-previous-heading))
- (t (org-tree-slide--outline-previous-heading)))
- (org-tree-slide--display-tree-with-narrow)
- ;; To avoid error of missing header in Emacs24
- (if (= emacs-major-version 24)
- (goto-char (point-min))))
-
-;;;###autoload
-(defun org-tree-slide-simple-profile ()
- "Set variables for simple use.
-
- `org-tree-slide-header' => nil
- `org-tree-slide-slide-in-effect' => nil
- `org-tree-slide-heading-emphasis' => nil
- `org-tree-slide-cursor-init' => t
- `org-tree-slide-modeline-display' => nil
- `org-tree-slide-skip-done' => nil
- `org-tree-slide-skip-comments' => t"
- (interactive)
- (setq org-tree-slide-header nil)
- (setq org-tree-slide-slide-in-effect nil)
- (setq org-tree-slide-heading-emphasis nil)
- (setq org-tree-slide-cursor-init t)
- (setq org-tree-slide-modeline-display nil)
- (setq org-tree-slide-skip-done nil)
- (setq org-tree-slide-skip-comments t)
- (message "simple profile: ON"))
-
-;;;###autoload
-(defun org-tree-slide-presentation-profile ()
- "Set variables for presentation use.
-
- `org-tree-slide-header' => t
- `org-tree-slide-slide-in-effect' => t
- `org-tree-slide-heading-emphasis' => nil
- `org-tree-slide-cursor-init' => t
- `org-tree-slide-modeline-display' => \='outside
- `org-tree-slide-skip-done' => nil
- `org-tree-slide-skip-comments' => t"
- (interactive)
- (setq org-tree-slide-header t)
- (setq org-tree-slide-slide-in-effect t)
- (setq org-tree-slide-heading-emphasis nil)
- (setq org-tree-slide-cursor-init t)
- (setq org-tree-slide-modeline-display 'outside)
- (setq org-tree-slide-skip-done nil)
- (setq org-tree-slide-skip-comments t)
- (message "presentation profile: ON"))
-
-;;;###autoload
-(defun org-tree-slide-narrowing-control-profile ()
- "Set variables for TODO pursuit with narrowing.
-
- `org-tree-slide-header' => nil
- `org-tree-slide-slide-in-effect' => nil
- `org-tree-slide-heading-emphasis' => nil
- `org-tree-slide-cursor-init' => nil
- `org-tree-slide-modeline-display' => \='lighter
- `org-tree-slide-skip-done' => t
- `org-tree-slide-skip-comments' => t"
- (interactive)
- (setq org-tree-slide-header nil)
- (setq org-tree-slide-slide-in-effect nil)
- (setq org-tree-slide-heading-emphasis nil)
- (setq org-tree-slide-cursor-init nil)
- (setq org-tree-slide-modeline-display 'lighter)
- (setq org-tree-slide-skip-done t)
- (setq org-tree-slide-skip-comments t)
- (message "narrowing control profile: ON"))
-
-;;;###autoload
-(defun org-tree-slide-display-header-toggle ()
- "Toggle displaying the slide header."
- (interactive)
- (setq org-tree-slide-header (not org-tree-slide-header))
- (unless org-tree-slide-header
- (org-tree-slide--hide-slide-header))
- (org-tree-slide--display-tree-with-narrow))
-
-;;;###autoload
-(defun org-tree-slide-slide-in-effect-toggle ()
- "Toggle using slide-in effect."
- (interactive)
- (setq org-tree-slide-slide-in-effect (not org-tree-slide-slide-in-effect))
- (org-tree-slide--display-tree-with-narrow))
-
-;;;###autoload
-(defun org-tree-slide-heading-emphasis-toggle ()
- "Toggle applying emphasis to heading."
- (interactive)
- (setq org-tree-slide-heading-emphasis (not org-tree-slide-heading-emphasis))
- (org-tree-slide--apply-custom-heading-face org-tree-slide-heading-emphasis))
-
-(defvar org-tree-slide--previous-line 0)
-
-;;;###autoload
-(defun org-tree-slide-skip-done-toggle ()
- "Toggle show TODO item only or not."
- (interactive)
- (setq org-tree-slide-skip-done (not org-tree-slide-skip-done))
- (setq org-tree-slide--previous-line -1) ; to update modeline intentionally
- (when org-tree-slide-header
- (org-tree-slide--show-slide-header))
- (if org-tree-slide-skip-done
- (message "TODO Pursuit: ON") (message "TODO Pursuit: OFF")))
-
-(defvar org-tree-slide--skip-comments-mode nil)
-
-;;;###autoload
-(defun org-tree-slide-skip-comments-toggle ()
- "Toggle show COMMENT item or not.
-If `org-tree-slide-skip-comments' is specified as `inherit',
-then toggle between `inherit' and nil. Otherwise, between t and nil.
-See also `org-tree-slide-skip-comments'."
- (interactive)
- ;; Sync
- (if (eq org-tree-slide-skip-comments 'inherit)
- (setq org-tree-slide--skip-comments-mode 'inherit)
- (when (eq org-tree-slide-skip-comments t)
- (setq org-tree-slide--skip-comments-mode t)))
- ;; Toggle
- (if (eq org-tree-slide--skip-comments-mode 'inherit)
- (if (eq org-tree-slide-skip-comments 'inherit)
- (setq org-tree-slide-skip-comments nil)
- (setq org-tree-slide-skip-comments 'inherit))
- (setq org-tree-slide-skip-comments (not org-tree-slide-skip-comments)))
- ;; Feedback
- (cond ((eq org-tree-slide-skip-comments nil)
- (message "COMMENT: Show headings even if it has COMMENT"))
- ((eq org-tree-slide-skip-comments t)
- (message "COMMENT: Skip only headings with COMMENT"))
- ((eq org-tree-slide-skip-comments 'inherit)
- (message
- "COMMENT: Skip headings with COMMENT and its child headings")))
- (when (org-tree-slide--active-p)
- (setq org-tree-slide--slide-number
- (format " %s" (org-tree-slide--count-slide (point))))))
-
-;;; Internal functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun org-tree-slide--last-tree-p (target)
- "Check if the TARGET point is in the last heading or it's body.
-If every heading is specified as skip, return nil.
-** n-1 ; nil
-** n ; t
- hoge ; t"
- (save-excursion
- (save-restriction
- (widen)
- (goto-char target)
- (org-tree-slide--beginning-of-tree)
- (let ((p (point))
- (_ (goto-char (1+ (buffer-size))))
- (l (org-tree-slide--last-point-at-bot)))
- (if l
- (= p l)
- nil)))))
-
-(defun org-tree-slide--first-heading-with-narrow-p ()
- "Check the current point is on the first heading with narrowing.
-** first ; t
- hoge ; nil
- hoge ; nil
-*** second ; nil
- hoge ; nil
-*** third ; nil"
- (and (buffer-narrowed-p) (= (line-beginning-position)
- (point-min))))
-
-(defvar org-tree-slide--slide-number nil)
-(make-variable-buffer-local 'org-tree-slide--slide-number)
-
-(defvar org-tree-slide--lighter " TSlide"
- "Lighter for `org-tree-slide'.
-This is displayed by default if `org-tree-slide-modeline-display' is nil.")
-
-(defun org-tree-slide--line-number-at-pos ()
- "Return the line number when widen."
- (save-excursion
- (save-restriction
- (widen)
- (line-number-at-pos))))
-
-(defun org-tree-slide--update-modeline ()
- "Update mode line."
- (when (org-tree-slide--active-p)
- (cond
- ((equal org-tree-slide-modeline-display 'lighter)
- (setq org-tree-slide--slide-number
- (format " %s" (org-tree-slide--count-slide (point))))
- (setq org-tree-slide--previous-line (org-tree-slide--line-number-at-pos))
- org-tree-slide--slide-number)
- ;; just return the current org-tree-slide--slide-number quickly.
- ((equal org-tree-slide-modeline-display 'outside)
- org-tree-slide--slide-number)
- (t
- org-tree-slide--lighter))))
-
-(defun org-tree-slide--apply-custom-heading-face (status)
- "Change status of heading face. If STATUS is nil, apply the default values."
- (unless org-tree-slide-never-touch-face
- (cond
- (status
- (setq
- org-tree-slide-heading-level-1-cookie
- (face-remap-add-relative 'org-level-1 org-tree-slide-heading-level-1)
- org-tree-slide-heading-level-2-cookie
- (face-remap-add-relative 'org-level-2 org-tree-slide-heading-level-2)
- org-tree-slide-heading-level-3-cookie
- (face-remap-add-relative 'org-level-3 org-tree-slide-heading-level-3)
- org-tree-slide-heading-level-4-cookie
- (face-remap-add-relative 'org-level-4 org-tree-slide-heading-level-4)))
- (t
- (face-remap-remove-relative org-tree-slide-heading-level-1-cookie)
- (face-remap-remove-relative org-tree-slide-heading-level-2-cookie)
- (face-remap-remove-relative org-tree-slide-heading-level-3-cookie)
- (face-remap-remove-relative org-tree-slide-heading-level-4-cookie)))))
-
-(defvar org-tree-slide--header-face-autoconfig nil)
-(defun org-tree-slide--all-skip-p ()
- "Check the buffer has at least one slide to be shown."
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (1+ (buffer-size)))
- (unless (org-tree-slide--last-point-at-bot)
- t))))
-
-(defun org-tree-slide--setup ()
- "Setup."
- (when (org-tree-slide--active-p)
- (org-tree-slide--play)))
-
-(defun org-tree-slide--abort ()
- "Abort."
- (unless (equal major-mode 'org-mode)
- (user-error "Not an org mode buffer"))
- (org-tree-slide--stop))
-
-(defun org-tree-slide--play ()
- "Start slide view with the first tree of the org mode buffer."
- (run-hooks 'org-tree-slide-play-hook)
- (if (org-tree-slide--all-skip-p)
- (let ((org-tree-slide-deactivate-message
- "[notice] Terminated. Skipped all slides."))
- (org-tree-slide--stop))
- (org-tree-slide--apply-local-header-to-slide-header)
- (when org-tree-slide-heading-emphasis
- (org-tree-slide--apply-custom-heading-face t))
- (when (or org-tree-slide-cursor-init
- (org-tree-slide--before-first-heading-p))
- (org-tree-slide--move-to-the-first-heading))
- (org-tree-slide--beginning-of-tree)
- (when (org-tree-slide--heading-skip-p)
- (org-tree-slide--outline-next-heading))
- (org-tree-slide--display-tree-with-narrow)
- (when org-tree-slide-activate-message
- (message "%s" org-tree-slide-activate-message))))
-
-(defvar-local org-tree-slide-startup "overview"
- "Set your #+startup: line to \"content\" \"overview\" or \"outline\".")
-
-(defvar-local org-tree-slide--content-overlays nil
- "Overlays used to hide or change contents display.")
-
-(defun org-tree-slide--delete-content-overlays ()
- "Delete content overlays."
- (while org-tree-slide--content-overlays
- (delete-overlay (pop org-tree-slide--content-overlays))))
-
-(defun org-tree-slide--stop ()
- "Stop the slide view, and redraw the orgmode buffer with #+STARTUP:."
- (widen)
- (org-fold-show-siblings)
- (when (or org-tree-slide-cursor-init
(org-tree-slide--before-first-heading-p))
- (goto-char (point-min))
- (org-overview)
- (cond ((equal "content" org-tree-slide-startup)
- (message "CONTENT: %s" org-tree-slide-startup)
- (org-content))
- ((equal "showall" org-tree-slide-startup)
- (message "SHOW ALL: %s" org-tree-slide-startup)
- (org-cycle '(64)))
- (t nil)))
- (org-tree-slide--hide-slide-header)
- (org-tree-slide--delete-content-overlays)
- (when org-timer-start-time
- (org-timer-stop))
- (when org-tree-slide-heading-emphasis
- (org-tree-slide--apply-custom-heading-face nil))
- (run-hooks 'org-tree-slide-stop-hook)
- (when org-tree-slide-deactivate-message
- (message "%s" org-tree-slide-deactivate-message)))
-
-(defun org-tree-slide--display-tree-with-narrow ()
- "Show a tree with narrowing and also set a header at the head of slide."
- (run-hooks 'org-tree-slide-before-narrow-hook)
- (when (equal org-tree-slide-modeline-display 'outside)
- (setq org-tree-slide--slide-number
- (format " %s" (org-tree-slide--count-slide (point))))
- (setq org-tree-slide--previous-line (org-tree-slide--line-number-at-pos)))
- (goto-char (line-beginning-position))
- (org-tree-slide--delete-content-overlays)
- (unless (org-tree-slide--before-first-heading-p)
- (outline-hide-subtree) ; support CONTENT (subtrees are shown)
- (org-fold-show-entry)
- ;; If this is the last level to be displayed, show the full content
- (if (and (not org-tree-slide-fold-subtrees-skipped)
- (org-tree-slide--heading-level-skip-p (1+ (org-outline-level))))
- (org-tree-slide--show-subtree)
- (outline-show-children))
- ;; (org-cycle-hide-drawers 'all) ; disabled due to performance reduction
- (org-narrow-to-subtree)
- (when-let* ((elem (org-element-at-point-no-context))
- (beg (save-excursion
- (when (org-goto-first-child)
- (let ((buffer-invisibility-spec nil))
- (1- (line-beginning-position))))))
- (end (org-element-contents-end elem))
- (ov (make-overlay beg end)))
- (overlay-put ov 'invisible t)
- (push ov org-tree-slide--content-overlays)))
- (when org-tree-slide-slide-in-effect
- (org-tree-slide--slide-in org-tree-slide-slide-in-blank-lines))
- (when org-tree-slide-header
- (org-tree-slide--show-slide-header))
- (run-hooks 'org-tree-slide-after-narrow-hook))
-
-(defun org-tree-slide--show-subtree ()
- "Show everything after this heading at deeper levels except COMMENT items."
- (save-excursion
- (outline-back-to-heading)
- (outline-map-region
- (lambda ()
- (if (org-tree-slide--heading-skip-comment-p)
- (outline-hide-subtree)
- (outline-show-subtree)
- (org-cycle-hide-drawers 'all)))
- (point)
- (progn (outline-end-of-subtree)
- (if (eobp) (point-max) (1+ (point)))))))
-
-(defun org-tree-slide--outline-next-heading ()
- "Go to the next heading."
- (org-tree-slide--outline-select-method
- (if (outline-next-heading)
- (if (org-tree-slide--heading-skip-p)
- 'skip
- nil)
- 'last)
- 'next))
-
-(defun org-tree-slide--outline-previous-heading ()
- "Go to the previous heading."
- (org-tree-slide--outline-select-method
- (if (outline-previous-heading)
- (if (org-tree-slide--heading-skip-p)
- 'skip
- nil)
- 'first)
- 'previous))
-
-(defun org-tree-slide--outline-select-method (action direction)
- "Control heading selection with ACTION and DIRECTION."
- (cond ((and (equal action 'last)
- (equal direction 'next))
- (when (org-tree-slide--heading-skip-p)
- (org-tree-slide-content))) ;; would be not reached here.
- ((and (equal action 'first)
- (equal direction 'previous))
- (org-tree-slide--outline-next-heading)) ;; find the first non-skip
- ((and (equal action 'skip)
- (equal direction 'next))
- (org-tree-slide--outline-next-heading)) ;; find next again
- ((and (equal action 'skip)
- (equal direction 'previous))
- (org-tree-slide--outline-previous-heading)) ;; find previous again
- (t
- nil)))
-
-(defun org-tree-slide--heading-skip-p ()
- "This method assume the cursor exist at the heading.
-** COMMENT ; t
- hoge ; nil
- hoge ; nil
-*** hoge ; nil"
- (or (org-tree-slide--heading-done-skip-p)
- (org-tree-slide--heading-level-skip-p)
- (org-tree-slide--heading-skip-comment-p)))
-
-(defun org-tree-slide--heading-level-skip-p (&optional heading-level)
- "Check the current heading should be skipped or not based on outline level.
-If HEADING-LEVEL is non-nil, the provided outline level is checked."
- (and (> org-tree-slide-skip-outline-level 0)
- (<= org-tree-slide-skip-outline-level
- (or heading-level (org-outline-level)))))
-
-(defun org-tree-slide--heading-done-skip-p ()
- "Return t, if the current heading is already done."
- (and org-tree-slide-skip-done
- (not
- (looking-at
- ;; 6.33x does NOT support org-outline-regexp-bol
- (concat "^\\*+ " org-not-done-regexp)))))
-
-(defun org-tree-slide--heading-skip-comment-p ()
- "Return t, if the current heading is commented.
-If `org-tree-slide-skip-comments' is specified as `inherit' and
-parent heading is commented, then also return t. Otherwise, return nil."
- (cond ((eq org-tree-slide-skip-comments 'inherit)
- (when (org-tree-slide--parent-commented-p) t))
- (t (and org-tree-slide-skip-comments
- (looking-at (concat "^\\*+ " org-comment-string))))))
-
-(defun org-tree-slide--parent-commented-p ()
- "Return nil, when no parent heading is commented."
- (memq 0 (mapcar
- (lambda (x)
- (string-match (concat "^" org-comment-string) x))
- (org-get-outline-path t))))
-
-(defun org-tree-slide--slide-in (blank-lines)
- "Apply slide in. The slide will be moved from BLANK-LINES below to top."
- (let ((min-line -1))
- (when org-tree-slide-header
- (setq min-line org-tree-slide-content-margin-top))
- (while (< min-line blank-lines)
- (org-tree-slide--set-slide-header blank-lines)
- (sit-for org-tree-slide-slide-in-waiting)
- (setq blank-lines (1- blank-lines)))))
-
-(defvar org-tree-slide-title nil
- "Presentation title.
-If you have \"#+title:\" line in your org buffer, it wil be used as a title
-of the slide. If the buffer has no \"#+title:\" line, the name of
-current buffer will be displayed.")
-
-(defvar org-tree-slide-email nil
- "Email address.
-If you have \"#+email:\" line in your org buffer,
-it will be used as an address of the slide.")
-
-(defvar org-tree-slide-author nil
- "Author name.
-If you have \"#+author:\" line in your org buffer,
-it will be used as a name of the slide author.")
-
-(defvar org-tree-slide-date nil
- "Date.
-If you have \"#+date:\" line in your org buffer, it will be used as the date.")
-
-(defcustom org-tree-slide-breadcrumbs " > "
- "Display breadcrumbs in the slide header.
-
-If non-nil, it should be a string used as a delimiter used to
-concat the headers."
- :type '(choice (const :tag "Don't display breadcrumbs" nil)
- (string :tag "Delimiter"))
- :group 'org-tree-slide)
-
-(defcustom org-tree-slide-breadcrumbs-hide-todo-state t
- "If non-nil, hide TODO states in the breadcrumbs."
- :type 'boolean
- :group 'org-tree-slide)
-
-(defun org-tree-slide--apply-local-header-to-slide-header ()
- "Form the header."
- (save-excursion
- (org-tree-slide--move-to-the-first-heading)
- (let ((limit (point)))
- (org-tree-slide--set-header-var-by-regxep
- 'org-tree-slide-title "#\\+TITLE:[ \t]*\\(.*\\)$" limit)
- (org-tree-slide--set-header-var-by-regxep
- 'org-tree-slide-author "#\\+AUTHOR:[ \t]*\\(.*\\)$" limit)
- (org-tree-slide--set-header-var-by-regxep
- 'org-tree-slide-email "#\\+EMAIL:[ \t]*\\(.*\\)$" limit)
-
- ; Use the date header or the current
date if there isn't one
- (setq org-tree-slide-date nil)
- (org-tree-slide--set-header-var-by-regxep
- 'org-tree-slide-date "#\\+DATE:[ \t]*\\(.*\\)$" limit)
- (if (not org-tree-slide-date)
- (setq org-tree-slide-date
- (format-time-string "%Y-%m-%d")))
-
- (org-tree-slide--set-header-var-by-regxep
- 'org-tree-slide-startup "#\\+STARTUP:[ \t]*\\(.*\\)$" limit))))
-
-(defun org-tree-slide--set-header-var-by-regxep (header-variable regexp limit)
- "Set HEADER-VARIABLE using REGEXP. LIMIT is used to change searching bound."
- (goto-char 1)
- (set header-variable
- (if (re-search-forward regexp limit t) (match-string 1) nil)))
-
-(defface org-tree-slide-header-overlay-face '((t :inherit default))
- "Face for `org-tree-slide--header-overlay'."
- :group 'org-tree-slide)
-
-(defun org-tree-slide--breadcrumbs-reducer (delim)
- (lambda (prev next)
- (if (not prev) next
- (let ((props (text-properties-at (1- (length prev)) prev)))
- (concat prev
- (apply #'propertize delim props)
- next)))))
-
-(defun org-tree-slide--get-parents (&optional delim)
- "Get parent headings and concat them with DELIM."
- (setq delim (or delim " > "))
- (save-excursion
- (save-restriction
- (widen)
- (let ((parents nil)
- (reducer (org-tree-slide--breadcrumbs-reducer delim)))
- (while (org-up-heading-safe)
- (push (org-get-heading
- 'no-tags
- org-tree-slide-breadcrumbs-hide-todo-state)
- parents))
- (let ((breadcrumbs (seq-reduce reducer parents nil)))
- (when org-tree-slide-breadcrumb-face
- (add-face-text-property 0 (length breadcrumbs)
- org-tree-slide-breadcrumb-face
- nil
- breadcrumbs))
- breadcrumbs)))))
-
-
-(defvar-local org-tree-slide--header-overlay nil
- "Flag to check the status of overlay for a slide header.")
-
-(defun org-tree-slide--set-slide-header (blank-lines)
- "Set the header with overlay.
-Some number of BLANK-LINES will be shown below the header."
- (org-tree-slide--hide-slide-header)
- (setq org-tree-slide--header-overlay
- (make-overlay (point-min) (+ 1 (point-min))))
- (if org-tree-slide-header
- (overlay-put org-tree-slide--header-overlay 'before-string
- (concat (if org-tree-slide-title org-tree-slide-title
- (buffer-name))
- "\n"
- (when (and org-tree-slide-header-date
- org-tree-slide-date)
- (concat org-tree-slide-date " "))
- (when (and org-tree-slide-header-author
- org-tree-slide-author)
- (concat org-tree-slide-author " "))
- (when (and org-tree-slide-header-email
- org-tree-slide-email)
- (concat "<" org-tree-slide-email ">"))
- (when org-tree-slide-breadcrumbs
- (concat "\n" (org-tree-slide--get-parents
- org-tree-slide-breadcrumbs)))
- (org-tree-slide--get-blank-lines blank-lines)))
- (overlay-put org-tree-slide--header-overlay 'before-string
- (org-tree-slide--get-blank-lines blank-lines))))
-
-(defun org-tree-slide--get-blank-lines (lines)
- "Return breaks by LINES."
- (propertize (make-string lines 10) ; 10 is \n
- 'face 'default))
-
-(defun org-tree-slide--show-slide-header (&optional lines)
- "Show header. When LINES is nil, the default value is 2."
- (org-tree-slide--set-slide-header
- (or lines org-tree-slide-content-margin-top)))
-
-(defun org-tree-slide--hide-slide-header ()
- "Hide header."
- (when org-tree-slide--header-overlay
- (delete-overlay org-tree-slide--header-overlay)))
-
-(defun org-tree-slide--move-to-the-first-heading ()
- "Go to the first heading. Narrowing will be canceled.
-If no heading in the buffer, return nil and stay top of the buffer.
-Otherwise, return the point. This doesn't check whether skipping or not."
- (widen)
- (goto-char 1)
- (if (looking-at "^\\*+ ")
- (progn
- (beginning-of-line)
- (point))
- (outline-next-heading)))
-
-(defun org-tree-slide--count-slide (&optional pos)
- "Return formatted the slide number. If POS is nil, `point' will be used."
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (let ((count 0)
- (current-slide 0)
- (current-point (or pos (point))))
- (when (and (looking-at "^\\*+ ") (not
(org-tree-slide--heading-skip-p)))
- (setq count 1)
- (setq current-slide 1))
- (while (outline-next-heading)
- (when (not (org-tree-slide--heading-skip-p))
- (setq count (1+ count))
- (when (>= current-point (point))
- (setq current-slide (1+ current-slide)))))
- (cond
- ((= count 0) "[-/-]") ; no headings
- ((= current-slide 0) (format "[-/%d]" count)) ; before first heading
- (t
- (format "[%d/%d]" current-slide count)))))))
-
-(defun org-tree-slide--last-point-at-bot ()
- "Return nil, if no heading is the last tree. Otherwise, return the point.
-Searching the last point will start from the current cursor position.
-Move point to an appropriate position before searching by call this function."
- (save-excursion
- (save-restriction
- (widen)
- (unless (org-tree-slide--before-first-heading-p)
- (org-tree-slide--beginning-of-tree)
- (if (org-tree-slide--heading-skip-p)
- (when (outline-previous-heading)
- (org-tree-slide--last-point-at-bot))
- (point))))))
-
-(defun org-tree-slide--beginning-of-tree ()
- "Move point to beginning of tree.
-If the cursor exist before first heading, do nothing."
- (unless (org-tree-slide--before-first-heading-p)
- (beginning-of-line)
- (unless (org-at-heading-p)
- (org-tree-slide--outline-previous-heading))))
-
-(defun org-tree-slide--active-p ()
- "Return nil, if the current `major-mode' is not `org-mode'."
- (and org-tree-slide-mode (equal major-mode 'org-mode)))
-
-(defun org-tree-slide--before-first-heading-p ()
- "Extension of `org-before-first-heading-p' to support org 6.33x.
-#+TITLE: title ; t
-#+STARTUP: content ; t
-* first ; t
- hoge ; nil
-** second ; nil
-** third ; nil"
- (and (org-before-first-heading-p) (not (buffer-narrowed-p))))
-
-(provide 'org-tree-slide)
-
-;;; org-tree-slide.el ends here
- [nongnu] elpa/dslide 4e2086e49e 034/230: rename display-state -> slide-buffer-state, (continued)
- [nongnu] elpa/dslide 4e2086e49e 034/230: rename display-state -> slide-buffer-state, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 30196efe70 010/230: The header overlay should be buffer local, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide e75488d7ac 018/230: rearrange, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide cf56e034ff 008/230: Overlays for selective display of contents, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 39a9045682 011/230: Simplify blank-lines expression using make-string, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 0316764255 006/230: moving a comment, automatic formatting, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 3969814eb4 015/230: rearrangement, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide a0460d4070 012/230: Return early by user-error when not in org-tree-slide-mode, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 0732479ac8 019/230: rearrange, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 393985506a 021/230: After-narrow-hook, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide dddbc58e20 020/230: The repackaging. org-tree-slide -> macro-slides,
ELPA Syncer <=
- [nongnu] elpa/dslide 10ee601187 007/230: enable lexical binding, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide b9219d205c 023/230: typos, comments, line-noise, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 1dbbed70f8 025/230: missing custom group & type, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 63d93ec6bf 028/230: Dead code on slide, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 9a67bc2f3e 026/230: line noise, compiler warnings, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 3e7ceb0845 024/230: missing deps, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 1d8041aba1 027/230: Sequence (slide) callbacks, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide da4e8dd412 016/230: user error instead of silent failure, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide 018b39cfa5 030/230: Remove some coupling between actions and slides, ELPA Syncer, 2024/07/07
- [nongnu] elpa/dslide b26e0155d8 043/230: base action is abstract, ELPA Syncer, 2024/07/07