Browse Source

org-export: Add a subtree property for each export option

* contrib/lisp/org-export.el (org-export-get-subtree-options): Add
  a subtree property for each export option.
* testing/lisp/test-org-export.el: Add tests.

Properties names are obtained by adding "EXPORT_" prefix to buffer
keywords.
Nicolas Goaziou 13 years ago
parent
commit
73951db845
2 changed files with 95 additions and 43 deletions
  1. 39 6
      contrib/lisp/org-export.el
  2. 56 37
      testing/lisp/test-org-export.el

+ 39 - 6
contrib/lisp/org-export.el

@@ -176,11 +176,15 @@
 The CAR of the alist is the property name, and the CDR is a list
 The CAR of the alist is the property name, and the CDR is a list
 like (KEYWORD OPTION DEFAULT BEHAVIOUR) where:
 like (KEYWORD OPTION DEFAULT BEHAVIOUR) where:
 
 
-KEYWORD is a string representing a buffer keyword, or nil.
+KEYWORD is a string representing a buffer keyword, or nil.  Each
+  property defined this way can also be set, during subtree
+  export, through an headline property named after the keyword
+  with the \"EXPORT_\" prefix (i.e. DATE keyword and EXPORT_DATE
+  property).
 OPTION is a string that could be found in an #+OPTIONS: line.
 OPTION is a string that could be found in an #+OPTIONS: line.
 DEFAULT is the default value for the property.
 DEFAULT is the default value for the property.
 BEHAVIOUR determine how Org should handle multiple keywords for
 BEHAVIOUR determine how Org should handle multiple keywords for
-the same property.  It is a symbol among:
+  the same property.  It is a symbol among:
   nil       Keep old value and discard the new one.
   nil       Keep old value and discard the new one.
   t         Replace old value with the new one.
   t         Replace old value with the new one.
   `space'   Concatenate the values, separating them with a space.
   `space'   Concatenate the values, separating them with a space.
@@ -1134,10 +1138,15 @@ specific items to read, if any."
   "Get export options in subtree at point.
   "Get export options in subtree at point.
 Optional argument BACKEND is a symbol specifying back-end used
 Optional argument BACKEND is a symbol specifying back-end used
 for export.  Return options as a plist."
 for export.  Return options as a plist."
+  ;; For each buffer keyword, create an headline property setting the
+  ;; same property in communication channel. The name for the property
+  ;; is the keyword with "EXPORT_" appended to it.
   (org-with-wide-buffer
   (org-with-wide-buffer
    (let (prop plist)
    (let (prop plist)
      ;; Make sure point is at an heading.
      ;; Make sure point is at an heading.
      (unless (org-at-heading-p) (org-back-to-heading t))
      (unless (org-at-heading-p) (org-back-to-heading t))
+     ;; Take care of EXPORT_TITLE. If it isn't defined, use headline's
+     ;; title as its fallback value.
      (when (setq prop (progn (looking-at org-todo-line-regexp)
      (when (setq prop (progn (looking-at org-todo-line-regexp)
 			     (or (save-match-data
 			     (or (save-match-data
 				   (org-entry-get (point) "EXPORT_TITLE"))
 				   (org-entry-get (point) "EXPORT_TITLE"))
@@ -1147,13 +1156,37 @@ for export.  Return options as a plist."
 	      plist :title
 	      plist :title
 	      (org-element-parse-secondary-string
 	      (org-element-parse-secondary-string
 	       prop (org-element-restriction 'keyword)))))
 	       prop (org-element-restriction 'keyword)))))
-     (when (setq prop (org-entry-get (point) "EXPORT_AUTHOR"))
-       (setq plist (plist-put plist :author prop)))
-     (when (setq prop (org-entry-get (point) "EXPORT_DATE"))
-       (setq plist (plist-put plist :date prop)))
+     ;; EXPORT_OPTIONS are parsed in a non-standard way.
      (when (setq prop (org-entry-get (point) "EXPORT_OPTIONS"))
      (when (setq prop (org-entry-get (point) "EXPORT_OPTIONS"))
        (setq plist
        (setq plist
 	     (nconc plist (org-export-parse-option-keyword prop backend))))
 	     (nconc plist (org-export-parse-option-keyword prop backend))))
+     ;; Handle other keywords.
+     (let ((seen '("TITLE")))
+       (mapc
+	(lambda (option)
+	  (let ((property (nth 1 option)))
+	    (when (and property (not (member property seen)))
+	      (let* ((subtree-prop (concat "EXPORT_" property))
+		     (value (org-entry-get (point) subtree-prop)))
+		(push property seen)
+		(when value
+		  (setq plist
+			(plist-put
+			 plist
+			 (car option)
+			 ;; Parse VALUE if required.
+			 (if (member property org-element-parsed-keywords)
+			     (org-element-parse-secondary-string
+			      value (org-element-restriction 'keyword))
+			   value))))))))
+	;; Also look for both general keywords and back-end specific
+	;; options if BACKEND is provided.
+	(append (and backend
+		     (let ((var (intern
+				 (format "org-%s-options-alist" backend))))
+		       (and (boundp var) (symbol-value var))))
+		org-export-options-alist)))
+     ;; Return value.
      plist)))
      plist)))
 
 
 (defun org-export-get-inbuffer-options (&optional backend files)
 (defun org-export-get-inbuffer-options (&optional backend files)

+ 56 - 37
testing/lisp/test-org-export.el

@@ -99,10 +99,10 @@ already filled in `info'."
 #+DESCRIPTION: Testing
 #+DESCRIPTION: Testing
 #+DESCRIPTION: with two lines
 #+DESCRIPTION: with two lines
 #+EMAIL: some@email.org
 #+EMAIL: some@email.org
-#+EXPORT_EXCLUDE_TAGS: noexport invisible
+#+EXCLUDE_TAGS: noexport invisible
 #+KEYWORDS: test
 #+KEYWORDS: test
 #+LANGUAGE: en
 #+LANGUAGE: en
-#+EXPORT_SELECT_TAGS: export
+#+SELECT_TAGS: export
 #+TITLE: Some title
 #+TITLE: Some title
 #+TITLE: with spaces"
 #+TITLE: with spaces"
       (org-export-get-inbuffer-options))
       (org-export-get-inbuffer-options))
@@ -112,6 +112,41 @@ already filled in `info'."
       :exclude-tags ("noexport" "invisible") :keywords "test" :language "en"
       :exclude-tags ("noexport" "invisible") :keywords "test" :language "en"
       :select-tags ("export") :title ("Some title with spaces")))))
       :select-tags ("export") :title ("Some title with spaces")))))
 
 
+(ert-deftest test-org-export/get-subtree-options ()
+  "Test setting options from headline's properties."
+  ;; EXPORT_TITLE.
+  (org-test-with-temp-text "#+TITLE: Title
+* Headline
+  :PROPERTIES:
+  :EXPORT_TITLE: Subtree Title
+  :END:
+Paragraph"
+    (forward-line)
+    (should (equal (plist-get (org-export-get-environment nil t) :title)
+		   '("Subtree Title"))))
+  :title
+  '("subtree-title")
+  ;; EXPORT_OPTIONS.
+  (org-test-with-temp-text "#+OPTIONS: H:1
+* Headline
+  :PROPERTIES:
+  :EXPORT_OPTIONS: H:2
+  :END:
+Paragraph"
+    (forward-line)
+    (should
+     (= 2 (plist-get (org-export-get-environment nil t) :headline-levels))))
+  ;; EXPORT DATE.
+  (org-test-with-temp-text "#+DATE: today
+* Headline
+  :PROPERTIES:
+  :EXPORT_DATE: 29-03-2012
+  :END:
+Paragraph"
+    (forward-line)
+    (should (equal (plist-get (org-export-get-environment nil t) :date)
+		   '("29-03-2012")))))
+
 (ert-deftest test-org-export/handle-options ()
 (ert-deftest test-org-export/handle-options ()
   "Test if export options have an impact on output."
   "Test if export options have an impact on output."
   ;; Test exclude tags.
   ;; Test exclude tags.
@@ -278,41 +313,7 @@ text
 #+END_SRC"
 #+END_SRC"
     (org-test-with-backend test
     (org-test-with-backend test
       (forward-line 1)
       (forward-line 1)
-      (should (equal (org-export-as 'test 'subtree) ": 3\n"))))
-  ;; Subtree's EXPORT_TITLE property.
-  (should
-   (equal
-    (plist-get (org-test-with-temp-text "* Headline
-  :PROPERTIES:
-  :EXPORT_TITLE: subtree-title
-  :END:
-Paragraph"
-		 (org-export-get-environment nil t))
-	       :title)
-    '("subtree-title")))
-  ;; Subtree's EXPORT_TITLE property.
-  (org-test-with-temp-text "#+OPTIONS: H:1
-* Headline
-  :PROPERTIES:
-  :EXPORT_OPTIONS: H:2
-  :END:
-Paragraph"
-    (forward-line)
-    (should
-     (= 2 (plist-get (org-export-get-environment nil t) :headline-levels)))))
-
-(ert-deftest test-org-export/export-snippet ()
-  "Test export snippets transcoding."
-  (org-test-with-temp-text "@@test:A@@@@t:B@@"
-    (org-test-with-backend test
-      (flet ((org-test-export-snippet
-	      (snippet contents info)
-	      (when (eq (org-export-snippet-backend snippet) 'test)
-		(org-element-property :value snippet))))
-	(let ((org-export-snippet-translation-alist nil))
-	  (should (equal (org-export-as 'test) "A\n")))
-	(let ((org-export-snippet-translation-alist '(("t" . "test"))))
-	  (should (equal (org-export-as 'test) "AB\n")))))))
+      (should (equal (org-export-as 'test 'subtree) ": 3\n")))))
 
 
 (ert-deftest test-org-export/expand-include ()
 (ert-deftest test-org-export/expand-include ()
   "Test file inclusion in an Org buffer."
   "Test file inclusion in an Org buffer."
@@ -427,6 +428,24 @@ body\n")))
     :attr_html
     :attr_html
     (org-test-with-temp-text "Paragraph" (org-element-current-element)))))
     (org-test-with-temp-text "Paragraph" (org-element-current-element)))))
 
 
+
+
+;;; Export Snippets
+
+(ert-deftest test-org-export/export-snippet ()
+  "Test export snippets transcoding."
+  (org-test-with-temp-text "@@test:A@@@@t:B@@"
+    (org-test-with-backend test
+      (flet ((org-test-export-snippet
+	      (snippet contents info)
+	      (when (eq (org-export-snippet-backend snippet) 'test)
+		(org-element-property :value snippet))))
+	(let ((org-export-snippet-translation-alist nil))
+	  (should (equal (org-export-as 'test) "A\n")))
+	(let ((org-export-snippet-translation-alist '(("t" . "test"))))
+	  (should (equal (org-export-as 'test) "AB\n")))))))
+
+
 
 
 ;;; Footnotes
 ;;; Footnotes