[nongnu] elpa/org-tree-slide 25a0936d0c 009/144: Version 2.0.1

[ELPA Syncer]

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

    Version 2.0.1
---
 ChangeLog         |   7 +
 org-tree-slide.el | 445 ++++++++++++++++++++++++++++++++++++------------------
 2 files changed, 306 insertions(+), 146 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index af39c68e8d..c801ed8161 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+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):
diff --git a/org-tree-slide.el b/org-tree-slide.el
index cffb04d583..ec818aac5e 100644
--- a/org-tree-slide.el
+++ b/org-tree-slide.el
@@ -5,7 +5,6 @@
 ;; Author: Takaaki ISHIKAWA <takaxp at ieee dot org>
 ;; Maintainer: Takaaki ISHIKAWA <takaxp at ieee dot org>
 ;; Twitter: @takaxp
-;; Website: http://takaxp.com/
 ;; Repository: https://github.com/takaxp/org-tree-slide
 ;; Keywords: org-mode, presentation, narrowing
 ;;
@@ -23,7 +22,14 @@
 ;; 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.
+;;
+;;; Requirement:
+;;    org-mode 6.33x or higher version
+;;    The latest version of the org-mode at http://orgmode.org/ is recommended.
+;;
 ;;; History:
+;;    v2.0.1 (2011-12-02@18:29) # Change function names, ots- is introduced.
+;;    v2.0.0 (2011-12-01@17:41) # Add profiles and support org 6.33x
 ;;    v1.2.5 (2011-10-31@18:34) # Add CONTENT view to see all the subtrees.
 ;;    v1.2.3 (2011-10-30@20:42) # Add a variable to control slide-in duration
 ;;    v1.2.1 (2011-10-30@16:10) # Add slide-in visual effect
@@ -34,241 +40,388 @@
 ;;    1. Put this elisp into your load-path
 ;;    2. Add (requre 'org-tree-slide) in your .emacs
 ;;    3. Open an org-mode file 
-;;    4. M-x tree-slide-play, now you in slide view
+;;    4. M-x org-tree-slide-play, now you in slide view
 ;;    5. <right>/<left> will move slides, mode line will be changed
-;;    6. M-x tree-slide-stop, return to normal view
+;;    6. M-x org-tree-slide-stop, return to normal view
 ;;
 ;;; Note:
 ;;    - Make sure key maps below when you introduce this elisp.
+;;    - Customize variables, M-x customize-group ENT org-tree-slide ENT
 
+(require 'org)
 (require 'org-timer)
 
-(defconst org-tree-slide "1.2.5"
+(defconst org-tree-slide "2.0.1"
   "The version number of the org-tree-slide.el")
 
-(defcustom tree-slide-title nil
+(defgroup org-tree-slide nil
+  "User variables for org-tree-slide."
+  :group 'org-structure)
+
+(defcustom org-tree-slide-title nil
   "Specify the title of presentation. The title is shown in a header area. 
    If this variable is nil, the name of current buffer will be displayed
    as a slide title."
   :type 'string
   :group 'org-tree-slide)
 
-(defcustom tree-slide-auto-play-period 0
+(defcustom org-tree-slide-auto-play-period 0
   "If this variable is greater than 0, the slide show move to the next tree
    automatically, and the value specify an interval."
   :type 'float
   :group 'org-tree-slide)
 
-(defcustom tree-slide-slide-in-effect t
+(defcustom org-tree-slide-header t
+  "The status of displaying the slide header"
+  :type 'boolean
+  :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 tree-slide-slide-in-brank-lines 10
+(defcustom org-tree-slide-slide-in-brank-lines 10
   "Specify the number of brank lines, the slide will move from this line."
   :type 'integer
   :group 'org-tree-slide)
 
-(defcustom tree-slide-slide-in-waiting 0.02
+(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 tree-slide-header-background-color "#FFFFFF"
-;  "Specify the color of header background."
-;  :type 'string
-;  :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 tree-slide-header-foreground-color "#666699"
-;  "Specify the color of header background."
-;  :type 'string
-;  :group 'org-tree-slide)
+(defcustom org-tree-slide-previous-key (kbd "<left>")
+  "Specify the key for moving to the next slide."
+  :type 'string
+  :group 'org-tree-slide)
+
+(defcustom org-tree-slide-next-key (kbd "<right>")
+  "Specify the key for moving to the next slide."
+  :type 'string
+  :group 'org-tree-slide)
+
+(defface org-tree-slide-heading-level-2-init
+  '((t (:inherit outline-2)))
+  "Level 2."
+  :group 'org-tree-slide)
+
+(defface org-tree-slide-heading-level-3-init
+  '((t (:inherit outline-3)))
+  "Level 3."
+  :group 'org-tree-slide)
+
+(defface org-tree-slide-heading-level-2
+  '((t (:inherit outline-2 :height 1.4 :bold t)))
+  "Level 2."
+  :group 'org-tree-slide)
 
-(define-key org-mode-map (kbd "C-x s p") 'tree-slide-play)
-(define-key org-mode-map (kbd "C-x s s") 'tree-slide-stop)
-(define-key org-mode-map (kbd "C-x s c") 'tree-slide-content)
-(define-key org-mode-map (kbd "C-x s a") 'tree-slide-auto-play-start)
+(defface org-tree-slide-heading-level-3
+  '((t (:inherit outline-3 :height 1.3 :bold t)))
+  "Level 3."
+  :group 'org-tree-slide)
+
+;;; The default key bindings for org-tree-slide.
+(define-key org-mode-map (kbd "C-x s p") 'org-tree-slide-play)
+(define-key org-mode-map (kbd "C-x s s") 'org-tree-slide-stop)
+(define-key org-mode-map (kbd "C-x s c") 'org-tree-slide-content)
+(define-key org-mode-map (kbd "C-x s a") 'org-tree-slide-auto-play-start)
 ;(define-key org-mode-map (kbd "<f5>") 'org-narrow-to-subtree)
 ;(define-key org-mode-map (kbd "<S-f5>") 'widen)
 
-(defun tree-slide-play (&optional arg)
+(defvar ots-active nil
+  "A flag to check if the slideshow is ACTIVE or not.")
+
+(defun org-tree-slide-play (&optional arg)
   "Start slide view with the first tree of the org-mode buffer.
    If you all this function with a prefix (C-u), you can set 
    a countdown timer to control your presentation."
   (interactive "P")
-  (unless tree-slide-active
+  (if (ots-active-p) (message "org-tree-slide is ACTIVE.")
+    (setq ots-active t)
     (when arg
       (org-timer-set-timer))
-    (setq tree-slide-active t)
-    (apply-control-keybindings)
-    (move-to-the-first-heading)
-    (tree-slide-display-tree-with-narrow)
-    (message "Hello! Org-tree slideshow is starting now.")))
-
-(defun tree-slide-stop ()
+    (when org-tree-slide-heading-emphasis
+      (ots-apply-custom-heading-face t))
+    (ots-apply-control-keybindings)
+    (ots-move-to-the-first-heading)
+    (ots-display-tree-with-narrow)
+    (message "Hello! This is org-tree-slide :-)")))
+
+(defun org-tree-slide-stop ()
   "Stop the slide view, and redraw the org-mode buffer with OVERVIEW."
   (interactive)
-  (when tree-slide-active
-    (setq tree-slide-active nil)
+  (when (ots-active-p)
+    (setq ots-active nil)
     (widen)
     (org-overview)
-    (move-to-the-first-heading)
-    (hide-slide-header)
-    (remove-control-keybindings)
+    (ots-move-to-the-first-heading)
+    (ots-hide-slide-header)
+    (ots-remove-control-keybindings)
     (org-timer-pause-or-continue 'stop)
+    (ots-apply-custom-heading-face nil)
     (message "Quit, Bye!")))
 
-(defun tree-slide-content ()
+(defun org-tree-slide-content ()
   "Change the display for viewing content of the org file during
    the slide view mode is active."
   (interactive)
-  (when tree-slide-active
-    (hide-slide-header)
-    (unless (org-before-first-heading-p)
-      (hide-subtree))
-    (widen)
-    (move-to-the-first-heading)
+  (when (ots-active-p)
+    (ots-hide-slide-header)
+    (ots-move-to-the-first-heading)
     (org-overview)
     (org-content)
-    (message "CONTENT")))
+    (message "<<  CONTENT  >>")))
+
+(defun org-tree-slide-simple-profile ()
+  "Set variables for simple use."
+  (interactive)
+  (setq org-tree-slide-header nil)
+  (setq org-tree-slide-slide-in-effect nil)
+  (setq org-tree-slide-heading-emphasis nil)
+  (message "simple profile: ON"))
+
+(defun org-tree-slide-presentation-profile ()
+  "Set variables for presentation use."
+  (interactive)
+  (setq org-tree-slide-header t)
+  (setq org-tree-slide-slide-in-effect t)
+  (setq org-tree-slide-heading-emphasis nil)
+  (message "presentation profile: ON"))
+
+(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
+    (ots-hide-slide-header))
+  (ots-display-tree-with-narrow))
 
-(defvar tree-slide-active nil
-  "Flag to check if the mode is ON or OFF.")
-(defvar tree-slide-right-key-assigned nil
+(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))
+  (ots-display-tree-with-narrow))
+
+(defun org-tree-slide-heading-emphasis-toggle ()
+  (interactive)
+  (setq org-tree-slide-heading-emphasis (not org-tree-slide-heading-emphasis))
+  (ots-apply-custom-heading-face org-tree-slide-heading-emphasis))
+
+(defun org-tree-slide-move-next-tree ()
+  "Display the next slide"
+  (interactive)
+  (when (ots-active-p)
+    (message "   Next >>")
+    (cond ((or (and (ots-before-first-heading-p) (not (org-on-heading-p)))
+             (= (point-at-bol) 1)) ; support single top level tree
+          (outline-next-heading))
+         ((or (ots-first-heading-with-narrow-p) (not (org-on-heading-p)))
+          (hide-subtree)
+          (widen)
+          ;; (if (> 7.3 (string-to-number org-version)) ; for 6.33x
+          ;;     (ots-hide-slide-header)              
+          ;;     (org-content))
+          (outline-next-heading))
+         (t nil))
+    (ots-display-tree-with-narrow)))
+
+(defun org-tree-slide-move-previous-tree ()
+  "Display the previous slide"
+  (interactive)
+  (when (ots-active-p)
+    (message "<< Previous")
+    (hide-subtree)
+    (widen)
+    (ots-hide-slide-header)            ; for at the first heading
+    (cond ((ots-before-first-heading-p)
+          (message "The first slide!"))
+         ((not (org-on-heading-p))
+          (outline-previous-heading)
+          (outline-previous-heading))
+         (t (outline-previous-heading)))
+    (ots-display-tree-with-narrow)
+    ;; To avoid error of missing header in Emacs24
+    (if (= emacs-major-version 24)
+       (goto-char (point-min)))))
+
+;;; Internal functions
+(defvar ots-right-key-assigned nil
   "Store the previous command assigned to <right>.")
-(defvar tree-slide-left-key-assigned nil
+(defvar ots-left-key-assigned nil
   "Store the previous command assigned to <left>.")
-(defvar tree-slide-mode-line-format-assigned nil
+(defvar ots-modeline-assigned nil
   "Store the previous mode-line-format.")
-(defvar tree-slide-footer-overlay nil
+(defvar ots-header-overlay nil
   "Flag to check the status of overlay for a slide header.")
 
-(defun narrowing-p ()
-  (if (and (= (point-min) 1) (= (point-max) (1+ (buffer-size)))) nil t))
-
-(defun tree-slide-display-tree-with-narrow ()
+(defun ots-display-tree-with-narrow ()
   "Show a tree with narrowing and also set a header at the head of slide."
-  (hide-slide-header)
-  (hide-subtree)
-  (show-entry)
+  (goto-char (point-at-bol))
+  (org-show-entry)
   (show-children)
   (org-cycle-hide-drawers 'all)
   (org-narrow-to-subtree)
-  (when tree-slide-slide-in-effect
-    (tree-slide-slide-in tree-slide-slide-in-brank-lines))
-  (show-slide-header))
-
-(defun set-slide-header (brank-lines)
-  (save-excursion
-    (setq tree-slide-footer-overlay
-         (make-overlay (point-min) (+ 1 (point-min))))
-    (overlay-put tree-slide-footer-overlay 'after-string " ")
-    (overlay-put tree-slide-footer-overlay
-                'face
-                '((foreground-color . "#696969")
-                  (background-color . "#FFFFFF") bold))
-    (overlay-put tree-slide-footer-overlay 'display
-                (concat "  [ " 
-                        (unless tree-slide-title
-                          (buffer-name))
-                        " ] (" (format-time-string "%Y-%m-%d") ")"
-                        (get-brank-lines brank-lines)))))
-
-
-(defun tree-slide-slide-in (brank-lines)
+  (when org-tree-slide-slide-in-effect
+    (ots-slide-in org-tree-slide-slide-in-brank-lines))
+  (when org-tree-slide-header
+    (ots-show-slide-header)))
+
+(defun ots-slide-in (brank-lines)
   (while (< 2 brank-lines)
-    (set-slide-header brank-lines)
-    (sit-for tree-slide-slide-in-waiting)
-    (hide-slide-header)
+    (ots-set-slide-header brank-lines)
+    (sit-for org-tree-slide-slide-in-waiting)
+    (ots-hide-slide-header)
     (setq brank-lines (1- brank-lines))))
 
-(defun get-brank-lines (lines)
+(defun ots-set-slide-header (brank-lines)
+  (ots-hide-slide-header)
+  (setq ots-header-overlay
+       (make-overlay (point-min) (+ 1 (point-min))))
+  (overlay-put ots-header-overlay 'after-string " ")
+  (overlay-put ots-header-overlay
+              'face
+              '((foreground-color . "#696969")
+                (background-color . "#FFFFFF") bold))
+  (if org-tree-slide-header
+      (overlay-put ots-header-overlay 'display
+                  (concat "  [ " 
+                          (unless org-tree-slide-title
+                            (buffer-name))
+                          " ] (" (format-time-string "%Y-%m-%d") ")"
+                          (ots-get-brank-lines brank-lines)))
+    (overlay-put ots-header-overlay 'display
+                (ots-get-brank-lines brank-lines))))
+
+(defun ots-get-brank-lines (lines)
   (let ((breaks ""))
     (while (< 0 lines)
       (setq lines (1- lines))
       (setq breaks (concat breaks "\n")))
     breaks))
 
-(defun show-slide-header ()
-  (set-slide-header 2)
+(defun ots-show-slide-header ()
+  (ots-set-slide-header 2)
   (forward-char 1))
 
-(defun hide-slide-header ()
-  (save-excursion
-    (when tree-slide-footer-overlay
-      (delete-overlay tree-slide-footer-overlay))))
+(defun ots-hide-slide-header ()
+  (when ots-header-overlay
+    (delete-overlay ots-header-overlay)))
 
-(defun move-to-the-first-heading ()
+(defun ots-move-to-the-first-heading ()
   (widen)
   (goto-char (point-min))
-  (when (org-before-first-heading-p)
+  (when (ots-before-first-heading-p)
     (outline-next-heading)))
 
-(defun tree-slide-move-next-tree ()
-  "Show the next slide"
-  (interactive)
-  (when tree-slide-active
-    (if (org-before-first-heading-p) (outline-next-heading)
-      (hide-subtree)
-      ;; Display a slide with the current entry for CONTENT view, not next one.
-      (when (narrowing-p)
-       (widen)
-       (outline-next-heading)))
-    (tree-slide-display-tree-with-narrow)))
-
-(defun tree-slide-move-previous-tree ()
-  "Show the previous slide"
-  (interactive)
-  (when tree-slide-active
-    (unless (org-before-first-heading-p)
-      (hide-subtree)
-      (widen)
-      (unless (org-on-heading-p) 
-       (outline-previous-heading))
-      (outline-previous-heading)
-      (tree-slide-display-tree-with-narrow))))
-
-(defun save-previous-propaties ()
-  (setq tree-slide-right-key-assigned (lookup-key org-mode-map (kbd 
"<right>")))
-  (setq tree-slide-left-key-assigned (lookup-key org-mode-map (kbd "<left>")))
-  (setq tree-slide-mode-line-format-assigned mode-line-format))
-
-(defun remove-control-keybindings ()
-  (define-key org-mode-map (kbd "<right>") tree-slide-right-key-assigned)
-  (define-key org-mode-map (kbd "<left>")  tree-slide-left-key-assigned)
-  (setq mode-line-format tree-slide-mode-line-format-assigned))
-
-(defun apply-control-keybindings ()
-  (save-previous-propaties)
-  (define-key org-mode-map (kbd "<right>") 'tree-slide-move-next-tree)
-  (define-key org-mode-map (kbd "<left>")  'tree-slide-move-previous-tree)
+(defun ots-save-previous-propaties ()
+  (setq ots-right-key-assigned
+       (lookup-key org-mode-map org-tree-slide-next-key))
+  (setq ots-left-key-assigned
+       (lookup-key org-mode-map org-tree-slide-previous-key))
+  (setq ots-modeline-assigned mode-line-format))
+
+(defun ots-remove-control-keybindings ()
+  (define-key org-mode-map org-tree-slide-next-key ots-right-key-assigned)
+  (define-key org-mode-map org-tree-slide-previous-key ots-left-key-assigned)
+  (setq mode-line-format ots-modeline-assigned))
+
+(defun ots-apply-control-keybindings ()
+  (ots-save-previous-propaties)
+  (define-key org-mode-map
+    org-tree-slide-next-key 'org-tree-slide-move-next-tree)
+  (define-key org-mode-map
+    org-tree-slide-previous-key 'org-tree-slide-move-previous-tree)
   (setq mode-line-format
-       '("-"
+       '(" -"
          mode-line-mule-info
          mode-line-modified
+         " "
 ;        mode-line-frame-identification
          mode-line-buffer-identification
-         " [slide playing] / Stop: M-x tree-slide-stop / "
+         " [playing] / Stop: C-x s s / "
          global-mode-string
          "-%-")))
 
-(defun tree-slide-auto-play-start ()
-;; ループも実装するべき
-  (interactive)
-  (let
-      ((stop-count 10)
-       (count 0))
-    (while (< count stop-count)
-      (tree-slide-move-next-tree)
-      (sleep-for 1)
-      (message "auto play %s" count)
-      (setq count (1+ count)))))
-
-;(defun tree-slide-auto-play-stop ()
-;  (interactive)
-;)
+(defun ots-apply-custom-heading-face (status)
+  "Change status of heading face."
+  (cond (status
+        (custom-set-faces
+         '(org-level-2 ((t (:inherit org-tree-slide-heading-level-2))))
+         '(org-level-3 ((t (:inherit org-tree-slide-heading-level-3)))))
+        (message "Face: ON"))
+       (t
+        (custom-set-faces
+         '(org-level-2 ((t (:inherit org-tree-slide-heading-level-2-init))))
+         '(org-level-3 ((t (:inherit org-tree-slide-heading-level-3-init)))))
+        (message "Face: OFF"))))
+
+(defun ots-active-p ()
+  (and ots-active (equal 'org-mode major-mode)))
+
+(defun ots-narrowing-p ()
+  "Check the current status if narrowing or not"
+  (not (and (= (point-min) 1) (= (point-max) (1+ (buffer-size))))))
+
+(defun ots-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 (ots-narrowing-p))))
+  
+(defun ots-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 (ots-narrowing-p) (= (point-at-bol) (point-min))))
+
+
+;;; Test....
+;(defcustom org-tree-slide-header-background-color "#FFFFFF"
+;  "Specify the color of header background."
+;  :type 'string
+;  :group 'org-tree-slide)
+
+;(defcustom org-tree-slide-header-foreground-color "#666699"
+;  "Specify the color of header background."
+;  :type 'string
+;  :group 'org-tree-slide)
+
+(defun org-tree-slide-auto-play-start (skip-slides)
+  "Start auto play, type `C-g' to stop it"
+  (interactive "nHow many slide play auto? ")
+  (message "Skip %d slides ..." skip-slides)
+  (sit-for 1)
+  (cond 
+   ((not org-tree-slide-slide-in-effect)
+    (message "Please M-x org-tree-slide-slide-in-effect-toggle"))
+   (ots-active
+    (let((stop-count skip-slides)
+        (count 0))
+      (while (< count stop-count)
+       (org-tree-slide-move-next-tree)
+       (message "auto play %s" count)
+       (sleep-for 0.5)
+       (setq count (1+ count)))
+      (org-tree-slide-content)))
+   (t
+    (message "Start slide show first with C-x s p :-)"))))
 
 (provide 'org-tree-slide)
 
 ;;; org-tree-slide.el ends here
-