[nongnu] elpa/org-tree-slide 16007b48c6 108/144: Refine skipping slide algorithm

[ELPA Syncer]

branch: elpa/org-tree-slide
commit 16007b48c636c9c84361e3f3e8d6b3c62d61fe6a
Author: Takaaki ISHIKAWA <takaxp@ieee.org>
Commit: Takaaki ISHIKAWA <takaxp@ieee.org>

    Refine skipping slide algorithm
    
    If the buffer doesn't contain any slide to show, just terminate the
    slide show.
    
    - introduce `org-tree-slide--all-skip-p'
    - refine `org-tree-slide--move-to-the-first-heading'
---
 org-tree-slide.el | 189 +++++++++++++++++++++++++++++++-----------------------
 1 file changed, 108 insertions(+), 81 deletions(-)

diff --git a/org-tree-slide.el b/org-tree-slide.el
index 85063413a2..b261580597 100644
--- a/org-tree-slide.el
+++ b/org-tree-slide.el
@@ -322,6 +322,7 @@ Profiles:
   (interactive)
   (when (org-tree-slide--active-p)
     (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)
@@ -331,6 +332,53 @@ Profiles:
            (org-content (1- org-tree-slide-skip-outline-level))))
     (message "<<  CONTENT  >>")))
 
+;;;###autoload
+(defun org-tree-slide-move-next-tree ()
+  "Display the next slide."
+  (interactive)
+  (when (org-tree-slide--active-p)
+    (unless (equal org-tree-slide-modeline-display 'outside)
+      (message "   Next >>"))
+    (cond
+     ;; displaying a slide, not the contents
+     ((and (org-tree-slide--narrowing-p)
+           (org-tree-slide--last-tree-p (point)))
+      (org-tree-slide-content))
+     ((or
+       (or (and (org-tree-slide--before-first-heading-p)
+                (not (org-at-heading-p)))
+           (and (= (point-at-bol) 1) (not (org-tree-slide--narrowing-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)
+  (when (org-tree-slide--active-p)
+    (unless (equal org-tree-slide-modeline-display 'outside)
+      (message "<< Previous"))
+    (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.
@@ -437,51 +485,6 @@ Profiles:
   (if org-tree-slide-skip-comments
       (message "COMMENT: HIDE") (message "COMMENT: SHOW")))
 
-(defun org-tree-slide-move-next-tree ()
-  "Display the next slide."
-  (interactive)
-  (when (org-tree-slide--active-p)
-    (unless (equal org-tree-slide-modeline-display 'outside)
-      (message "   Next >>"))
-    (cond
-     ((and (org-tree-slide--narrowing-p) ;displaying a slide, not the contents
-           (org-tree-slide--last-tree-p
-            (progn (beginning-of-line) (point)))) ;the last subtree
-      (org-tree-slide-content))
-     ((or
-       (or (and (org-tree-slide--before-first-heading-p)
-                (not (org-at-heading-p)))
-           (and (= (point-at-bol) 1) (not (org-tree-slide--narrowing-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 nil (org-tree-slide--display-tree-with-narrow)))))
-
-(defun org-tree-slide-move-previous-tree ()
-  "Display the previous slide."
-  (interactive)
-  (when (org-tree-slide--active-p)
-    (unless (equal org-tree-slide-modeline-display 'outside)
-      (message "<< Previous"))
-    (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)))))
-
 ;;; Internal functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defvar org-tree-slide--slide-number nil)
 (make-variable-buffer-local 'org-tree-slide--slide-number)
@@ -509,7 +512,8 @@ This is displayed by default if 
`org-tree-slide-modeline-display' is nil.")
      ;; 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))))
+     (t
+      org-tree-slide--lighter))))
 
 (defvar org-tree-slide--header-overlay nil
   "Flag to check the status of overlay for a slide header.")
@@ -525,20 +529,25 @@ This is displayed by default if 
`org-tree-slide-modeline-display' is nil.")
     (org-tree-slide--stop)))
 
 (defun org-tree-slide--play ()
-  "Start slide view with the first tree of the orgmode buffer."
+  "Start slide view with the first tree of the org mode buffer."
   (run-hooks 'org-tree-slide-mode-play-hook)
   (run-hooks 'org-tree-slide-play-hook)
-  (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)))
+  (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 org-tree-slide-startup "overview"
   "If you have \"#+startup:\" line in your org buffer, the org buffer will be 
shown with corresponding status (content, showall, overview:default).")
@@ -610,32 +619,39 @@ This is displayed by default if 
`org-tree-slide-modeline-display' is nil.")
 (defun org-tree-slide--outline-next-heading ()
   "Go to the next heading."
   (org-tree-slide--outline-select-method
-   (if (outline-next-heading) nil 'last)
+   (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) nil 'first)
+   (if (outline-previous-heading)
+       (if (org-tree-slide--heading-skip-p)
+           'skip
+         nil)
+     'first)
    'previous))
 
-(defvar org-tree-slide--all-skipped t
-  "A flag to know if all trees are skipped.")
-
 (defun org-tree-slide--outline-select-method (action direction)
   "Control heading selection with ACTION and DIRECTION."
-  (cond ((and (equal action 'last) (equal direction 'next))
-         (unless org-tree-slide--all-skipped
-           (org-tree-slide--outline-previous-heading)))  ; Return back.
-        ((and (equal action 'first) (equal direction 'previous))
-         (unless org-tree-slide--all-skipped
-           (org-tree-slide--move-to-the-first-heading))) ; Stay first heading
-        ((and (equal action 'skip) (equal direction 'next))
-         (org-tree-slide--outline-next-heading))      ; recursive call
-        ((and (equal action 'skip) (equal direction 'previous))
-         (org-tree-slide--outline-previous-heading))  ; recursive call
+  (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--move-to-the-first-heading))
+        ((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
-         (setq org-tree-slide--all-skipped nil)
          nil)))
 
 (defun org-tree-slide--heading-skip-p ()
@@ -787,15 +803,16 @@ Some number of BLANK-LINES will be shown below the 
header."
     (delete-overlay org-tree-slide--header-overlay)))
 
 (defun org-tree-slide--move-to-the-first-heading ()
-  "Go to the first heading."
-  (setq org-tree-slide--all-skipped t)
+  "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)
-  (unless (looking-at "^\\*+ ")
-    (outline-next-heading))
-  (when (org-tree-slide--heading-skip-p)
-    (setq org-tree-slide--all-skipped t)
-    (org-tree-slide--outline-next-heading)))
+  (if (looking-at "^\\*+ ")
+      (progn
+        (beginning-of-line)
+        (point))
+    (outline-next-heading)))
 
 (defun org-tree-slide--apply-custom-heading-face (status)
   "Change status of heading face.  If STATUS is nil, apply the default values."
@@ -887,8 +904,18 @@ If the cursor exist before first heading, do nothing."
 *** third          ; nil"
   (and (org-tree-slide--narrowing-p) (= (point-at-bol) (point-min))))
 
+(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--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"