Hello,
"D. C. Toedt" <d...@toedt.com> writes:
> The local keyword would be great.
The following patch implements local tocs for ascii, html and odt export
back-ends. I skipped latex because using minitoc looks too tricky to
automate.
Feedback welcome.
Regards,
--
Nicolas Goaziou
>From 56e720f11c172b16a72fb1ddb9ad78405361646d Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <m...@nicolasgoaziou.fr>
Date: Sat, 25 Oct 2014 17:14:34 +0200
Subject: [PATCH] ox: Implement local table of contents
* lisp/ox.el (org-export-collect-headlines): Allow to collect
headlines locally.
* testing/lisp/test-ox.el (test-org-export/collect-headlines): Add
tests.
* lisp/ox-ascii.el (org-ascii--build-toc):
(org-ascii-keyword):
* lisp/ox-html.el (org-html-toc):
(org-html-keyword):
* lisp/ox-latex.el (org-latex-keyword):
* lisp/ox-odt.el (org-odt-toc): Allow local table of contents.
---
lisp/ox-ascii.el | 33 +++++++++++++++++----------------
lisp/ox-html.el | 21 +++++++++++----------
lisp/ox-latex.el | 16 +++++++---------
lisp/ox-odt.el | 35 ++++++++++++++++++-----------------
lisp/ox.el | 31 ++++++++++++++++++++++---------
testing/lisp/test-ox.el | 14 +++++++++++++-
6 files changed, 88 insertions(+), 62 deletions(-)
diff --git a/lisp/ox-ascii.el b/lisp/ox-ascii.el
index daad00f..ff0a5f4 100644
--- a/lisp/ox-ascii.el
+++ b/lisp/ox-ascii.el
@@ -744,7 +744,7 @@ caption keyword."
(org-export-data caption info))
(org-ascii--current-text-width element info) info)))))
-(defun org-ascii--build-toc (info &optional n keyword)
+(defun org-ascii--build-toc (info &optional n keyword local)
"Return a table of contents.
INFO is a plist used as a communication channel.
@@ -753,7 +753,10 @@ Optional argument N, when non-nil, is an integer specifying the
depth of the table.
Optional argument KEYWORD specifies the TOC keyword, if any, from
-which the table of contents generation has been initiated."
+which the table of contents generation has been initiated.
+
+When optional argument LOCAL is non-nil, build a table of
+contents according to the current headline."
(let ((title (org-ascii--translate "Table of Contents" info)))
(concat
title "\n"
@@ -775,7 +778,7 @@ which the table of contents generation has been initiated."
(or (not (plist-get info :with-tags))
(eq (plist-get info :with-tags) 'not-in-toc))
'toc))))
- (org-export-collect-headlines info n) "\n")))))
+ (org-export-collect-headlines info n keyword) "\n")))))
(defun org-ascii--list-listings (keyword info)
"Return a list of listings.
@@ -1452,24 +1455,22 @@ contextual information."
"Transcode a KEYWORD element from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (let ((key (org-element-property :key keyword)))
+ (let ((key (org-element-property :key keyword))
+ (value (org-element-property :value keyword)))
(cond
- ((string= key "ASCII")
- (org-ascii--justify-element
- (org-element-property :value keyword) keyword info))
+ ((string= key "ASCII") (org-ascii--justify-element value keyword info))
((string= key "TOC")
(org-ascii--justify-element
- (let ((value (downcase (org-element-property :value keyword))))
+ (let ((case-fold-search t))
(cond
- ((string-match "\\<headlines\\>" value)
- (let ((depth (or (and (string-match "[0-9]+" value)
- (string-to-number (match-string 0 value)))
- (plist-get info :with-toc))))
- (org-ascii--build-toc
- info (and (wholenump depth) depth) keyword)))
- ((string= "tables" value)
+ ((org-string-match-p "\\<headlines\\>" value)
+ (let ((depth (and (string-match "\\<[0-9]+\\>" value)
+ (string-to-number (match-string 0 value))))
+ (localp (org-string-match-p "\\<local\\>" value)))
+ (org-ascii--build-toc info depth keyword localp)))
+ ((org-string-match-p "\\<tables\\>" value)
(org-ascii--list-tables keyword info))
- ((string= "listings" value)
+ ((org-string-match-p "\\<listings\\>" value)
(org-ascii--list-listings keyword info))))
keyword info)))))
diff --git a/lisp/ox-html.el b/lisp/ox-html.el
index c2152d9..276cb67 100644
--- a/lisp/ox-html.el
+++ b/lisp/ox-html.el
@@ -2017,16 +2017,17 @@ a plist used as a communication channel."
;;; Tables of Contents
-(defun org-html-toc (depth info)
+(defun org-html-toc (depth info &optional scope)
"Build a table of contents.
-DEPTH is an integer specifying the depth of the table. INFO is a
-plist used as a communication channel. Return the table of
-contents as a string, or nil if it is empty."
+DEPTH is an integer specifying the depth of the table. INFO is
+a plist used as a communication channel. Optional argument SCOPE
+is an element defining the scope of the table. Return the table
+of contents as a string, or nil if it is empty."
(let ((toc-entries
(mapcar (lambda (headline)
(cons (org-html--format-toc-headline headline info)
(org-export-get-relative-level headline info)))
- (org-export-collect-headlines info depth)))
+ (org-export-collect-headlines info depth scope)))
(outer-tag (if (and (org-html-html5-p info)
(plist-get info :html-html5-fancy))
"nav"
@@ -2539,13 +2540,13 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(cond
((string= key "HTML") value)
((string= key "TOC")
- (let ((value (downcase value)))
+ (let ((case-fold-search t))
(cond
((string-match "\\<headlines\\>" value)
- (let ((depth (or (and (string-match "[0-9]+" value)
- (string-to-number (match-string 0 value)))
- (plist-get info :with-toc))))
- (org-html-toc depth info)))
+ (let ((depth (and (string-match "\\<[0-9]+\\>" value)
+ (string-to-number (match-string 0 value))))
+ (localp (org-string-match-p "\\<local\\>" value)))
+ (org-html-toc depth info (and localp keyword))))
((string= "listings" value) (org-html-list-of-listings info))
((string= "tables" value) (org-html-list-of-tables info))))))))
diff --git a/lisp/ox-latex.el b/lisp/ox-latex.el
index 501648d..2010cc1 100644
--- a/lisp/ox-latex.el
+++ b/lisp/ox-latex.el
@@ -1755,18 +1755,16 @@ CONTENTS is nil. INFO is a plist holding contextual information."
((string= key "LATEX") value)
((string= key "INDEX") (format "\\index{%s}" value))
((string= key "TOC")
- (let ((value (downcase value)))
+ (let ((case-fold-search t))
(cond
- ((string-match "\\<headlines\\>" value)
- (let ((depth (or (and (string-match "[0-9]+" value)
- (string-to-number (match-string 0 value)))
- (plist-get info :with-toc))))
+ ((org-string-match-p "\\<headlines\\>" value)
+ (let ((depth (and (string-match "\\<[0-9]+\\>" value)
+ (string-to-number (match-string 0 value)))))
(concat
- (when (wholenump depth)
- (format "\\setcounter{tocdepth}{%s}\n" depth))
+ (when depth (format "\\setcounter{tocdepth}{%s}\n" depth))
"\\tableofcontents")))
- ((string= "tables" value) "\\listoftables")
- ((string= "listings" value)
+ ((org-string-match-p "\\<tables\\>" value) "\\listoftables")
+ ((org-string-match-p "\\<listings\\>" value)
(case (plist-get info :latex-listings)
((nil) "\\listoffigures")
(minted "\\listoflistings")
diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el
index cc156ff..fb7be31 100644
--- a/lisp/ox-odt.el
+++ b/lisp/ox-odt.el
@@ -1149,7 +1149,12 @@ See `org-odt--build-date-styles' for implementation details."
(format "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
headline-label text))
-(defun org-odt-toc (depth info)
+(defun org-odt-toc (depth info &optional scope)
+ "Build a table of contents.
+DEPTH is an integer specifying the depth of the table. INFO is
+a plist containing current export properties. Optional argument
+SCOPE, when non-nil, defines the scope of the table. Return the
+table of contents as a string, or nil."
(assert (wholenump depth))
;; When a headline is marked as a radio target, as in the example below:
;;
@@ -1161,18 +1166,12 @@ See `org-odt--build-date-styles' for implementation details."
;; /TOC/, as otherwise there will be duplicated anchors one in TOC
;; and one in the document body.
;;
- ;; FIXME-1: Currently exported headings are memoized. `org-export.el'
- ;; doesn't provide a way to disable memoization. So this doesn't
- ;; work.
- ;;
- ;; FIXME-2: Are there any other objects that need to be suppressed
+ ;; FIXME: Are there any other objects that need to be suppressed
;; within TOC?
(let* ((title (org-export-translate "Table of Contents" :utf-8 info))
- (headlines (org-export-collect-headlines
- info (and (wholenump depth) depth)))
+ (headlines (org-export-collect-headlines info depth local))
(backend (org-export-create-backend
- :parent (org-export-backend-name
- (plist-get info :back-end))
+ :parent (org-export-backend-name (plist-get info :back-end))
:transcoders (mapcar
(lambda (type) (cons type (lambda (d c i) c)))
(list 'radio-target)))))
@@ -2013,7 +2012,8 @@ contextual information."
(defun org-odt-keyword (keyword contents info)
"Transcode a KEYWORD element from Org to ODT.
-CONTENTS is nil. INFO is a plist holding contextual information."
+CONTENTS is nil. INFO is a plist holding contextual
+information."
(let ((key (org-element-property :key keyword))
(value (org-element-property :value keyword)))
(cond
@@ -2022,14 +2022,15 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;; FIXME
(ignore))
((string= key "TOC")
- (let ((value (downcase value)))
+ (let ((case-fold-search t))
(cond
- ((string-match "\\<headlines\\>" value)
- (let ((depth (or (and (string-match "[0-9]+" value)
+ ((org-string-match-p "\\<headlines\\>" value)
+ (let ((depth (or (and (string-match "\\<[0-9]+\\>" value)
(string-to-number (match-string 0 value)))
- (plist-get info :with-toc))))
- (when (wholenump depth) (org-odt-toc depth info))))
- ((member value '("tables" "figures" "listings"))
+ (plist-get info :headline-levels)))
+ (localp (org-string-match-p "\\<local\\>" value)))
+ (org-odt-toc depth info (and localp keyword))))
+ ((org-string-match-p "tables\\|figures\\|listings" value)
;; FIXME
(ignore))))))))
diff --git a/lisp/ox.el b/lisp/ox.el
index f018497..317a0ad 100644
--- a/lisp/ox.el
+++ b/lisp/ox.el
@@ -4774,7 +4774,7 @@ return nil."
;; `org-export-collect-tables', `org-export-collect-figures' and
;; `org-export-collect-listings' can be derived from it.
-(defun org-export-collect-headlines (info &optional n)
+(defun org-export-collect-headlines (info &optional n scope)
"Collect headlines in order to build a table of contents.
INFO is a plist used as a communication channel.
@@ -4784,15 +4784,28 @@ the table of contents. Otherwise, it is set to the value of the
last headline level. See `org-export-headline-levels' for more
information.
+Optional argument SCOPE, when non-nil, is an element. If it is
+a headline, only children of SCOPE are collected. Otherwise,
+collect children of the headline containing provided element. If
+there is no such headline, collect all headlines. In any case,
+argument N becomes relative to the level of that headline.
+
Return a list of all exportable headlines as parsed elements.
-Footnote sections, if any, will be ignored."
- (let ((limit (plist-get info :headline-levels)))
- (setq n (if (wholenump n) (min n limit) limit))
- (org-element-map (plist-get info :parse-tree) 'headline
- #'(lambda (headline)
- (unless (org-element-property :footnote-section-p headline)
- (let ((level (org-export-get-relative-level headline info)))
- (and (<= level n) headline))))
+Footnote sections are ignored."
+ (let* ((scope (cond ((not scope) (plist-get info :parse-tree))
+ ((eq (org-element-type scope) 'headline) scope)
+ ((org-export-get-parent-headline scope))
+ (t (plist-get info :parse-tree))))
+ (limit (plist-get info :headline-levels))
+ (n (if (not (wholenump n)) limit
+ (min (if (eq (org-element-type scope) 'org-data) n
+ (+ (org-export-get-relative-level scope info) n))
+ limit))))
+ (org-element-map (org-element-contents scope) 'headline
+ (lambda (headline)
+ (unless (org-element-property :footnote-section-p headline)
+ (let ((level (org-export-get-relative-level headline info)))
+ (and (<= level n) headline))))
info)))
(defun org-export-collect-elements (type info &optional predicate)
diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el
index 9a0e787..e74220c 100644
--- a/testing/lisp/test-ox.el
+++ b/testing/lisp/test-ox.el
@@ -3075,7 +3075,19 @@ Another text. (ref:text)
(= 1
(length
(org-test-with-parsed-data "#+OPTIONS: H:1\n* H1\n** H2"
- (org-export-collect-headlines info 2))))))
+ (org-export-collect-headlines info 2)))))
+ ;; Collect headlines locally.
+ (should
+ (= 2
+ (org-test-with-parsed-data "* H1\n** H2\n** H3"
+ (let ((scope (org-element-map tree 'headline #'identity info t)))
+ (length (org-export-collect-headlines info nil scope))))))
+ ;; When collecting locally, optional level is relative.
+ (should
+ (= 1
+ (org-test-with-parsed-data "* H1\n** H2\n*** H3"
+ (let ((scope (org-element-map tree 'headline #'identity info t)))
+ (length (org-export-collect-headlines info 1 scope)))))))
--
2.1.2
