Re: [O] Table of contents for just one section?

[Nicolas Goaziou]

Hello,

"D. C. Toedt" <address@hidden> 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 <address@hidden>
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