branch: elpa/org-tree-slide
commit 25a0936d0cdaecde7bd286b6215ebf8e123bebdd
Author: Takaaki ISHIKAWA <tak...@ieee.org>
Commit: Takaaki ISHIKAWA <tak...@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 <tak...@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 <tak...@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
-
