Browse Source

ox: Add a command to insert a default export template

* lisp/ox.el (org-export-insert-default-template): New function.
(org-export--dispatch-ui, org-export--dispatch-action): Access to the
function through the dispatcher.

From the dispatcher, if subtree export is selected, options will be
installed as node properties in current subtree.
Nicolas Goaziou 12 years ago
parent
commit
67cf80ae9a
1 changed files with 132 additions and 26 deletions
  1. 132 26
      lisp/ox.el

+ 132 - 26
lisp/ox.el

@@ -65,7 +65,7 @@
 ;; customizable should belong to the `org-export-BACKEND' group.
 ;; customizable should belong to the `org-export-BACKEND' group.
 ;;
 ;;
 ;; Tools for common tasks across back-ends are implemented in the
 ;; Tools for common tasks across back-ends are implemented in the
-;; following part of then file.
+;; following part of the file.
 ;;
 ;;
 ;; Then, a wrapper macro for asynchronous export,
 ;; Then, a wrapper macro for asynchronous export,
 ;; `org-export-async-start', along with tools to display results. are
 ;; `org-export-async-start', along with tools to display results. are
@@ -2761,6 +2761,10 @@ Return the updated communication channel."
 ;; was within an item, the item should contain the headline.  That's
 ;; was within an item, the item should contain the headline.  That's
 ;; why file inclusion should be done before any structure can be
 ;; why file inclusion should be done before any structure can be
 ;; associated to the file, that is before parsing.
 ;; associated to the file, that is before parsing.
+;;
+;; `org-export-insert-default-template' is a command to insert
+;; a default template (or a back-end specific template) at point or in
+;; current subtree.
 
 
 (defun org-export-copy-buffer ()
 (defun org-export-copy-buffer ()
   "Return a copy of the current buffer.
   "Return a copy of the current buffer.
@@ -3052,6 +3056,104 @@ Return code as a string."
     (org-mode)
     (org-mode)
     (org-export-as backend nil nil body-only ext-plist)))
     (org-export-as backend nil nil body-only ext-plist)))
 
 
+;;;###autoload
+(defun org-export-insert-default-template (&optional backend subtreep)
+  "Insert all export keywords with default values at beginning of line.
+
+BACKEND is a symbol representing the export back-end for which
+specific export options should be added to the template, or
+`default' for default template.  When it is nil, the user will be
+prompted for a category.
+
+If SUBTREEP is non-nil, export configuration will be set up
+locally for the subtree through node properties."
+  (interactive)
+  (unless (derived-mode-p 'org-mode) (user-error "Not in an Org mode buffer"))
+  (when (and subtreep (org-before-first-heading-p))
+    (user-error "No subtree to set export options for"))
+  (let ((node (and subtreep (save-excursion (org-back-to-heading t) (point))))
+	(backend (or backend
+                     (intern
+                      (org-completing-read
+                       "Options category: "
+                       (cons "default"
+                             (mapcar (lambda (b) (symbol-name (car b)))
+                                     org-export-registered-backends))))))
+	options keywords)
+    ;; Populate OPTIONS and KEYWORDS.
+    (dolist (entry (if (eq backend 'default) org-export-options-alist
+		     (org-export-backend-options backend)))
+      (let ((keyword (nth 1 entry))
+            (option (nth 2 entry)))
+        (cond
+         (keyword (unless (assoc keyword keywords)
+                    (let ((value
+                           (if (eq (nth 4 entry) 'split)
+                               (mapconcat 'identity (eval (nth 3 entry)) " ")
+                             (eval (nth 3 entry)))))
+                      (push (cons keyword value) keywords))))
+         (option (unless (assoc option options)
+                   (push (cons option (eval (nth 3 entry))) options))))))
+    ;; Move to an appropriate location in order to insert options.
+    (unless subtreep (beginning-of-line))
+    ;; First get TITLE, DATE, AUTHOR and EMAIL if they belong to the
+    ;; list of available keywords.
+    (when (assoc "TITLE" keywords)
+      (let ((title
+	     (or (let ((visited-file (buffer-file-name (buffer-base-buffer))))
+		   (and visited-file
+			(file-name-sans-extension
+			 (file-name-nondirectory visited-file))))
+		 (buffer-name (buffer-base-buffer)))))
+	(if (not subtreep) (insert (format "#+TITLE: %s\n" title))
+	  (org-entry-put node "EXPORT_TITLE" title))))
+    (when (assoc "DATE" keywords)
+      (let ((date (with-temp-buffer (org-insert-time-stamp (current-time)))))
+	(if (not subtreep) (insert "#+DATE: " date "\n")
+	  (org-entry-put node "EXPORT_DATE" date))))
+    (when (assoc "AUTHOR" keywords)
+      (let ((author (cdr (assoc "AUTHOR" keywords))))
+	(if subtreep (org-entry-put node "EXPORT_AUTHOR" author)
+	  (insert
+	   (format "#+AUTHOR:%s\n"
+		   (if (not (org-string-nw-p author)) ""
+		     (concat " " author)))))))
+    (when (assoc "EMAIL" keywords)
+      (let ((email (cdr (assoc "EMAIL" keywords))))
+	(if subtreep (org-entry-put node "EXPORT_EMAIL" email)
+	  (insert
+	   (format "#+EMAIL:%s\n"
+		   (if (not (org-string-nw-p email)) ""
+		     (concat " " email)))))))
+    ;; Then (multiple) OPTIONS lines.  Never go past fill-column.
+    (when options
+      (let ((items
+	     (mapcar
+	      (lambda (opt)
+		(format "%s:%s" (car opt) (format "%s" (cdr opt))))
+	      (sort options (lambda (k1 k2) (string< (car k1) (car k2)))))))
+	(if subtreep
+	    (org-entry-put
+	     node "EXPORT_OPTIONS" (mapconcat 'identity items " "))
+	  (while items
+	    (insert "#+OPTIONS:")
+	    (let ((width 10))
+	      (while (and items
+			  (< (+ width (length (car items)) 1) fill-column))
+		(let ((item (pop items)))
+		  (insert " " item)
+		  (incf width (1+ (length item))))))
+	    (insert "\n")))))
+    ;; And the rest of keywords.
+    (dolist (key (sort keywords (lambda (k1 k2) (string< (car k1) (car k2)))))
+      (unless (member (car key) '("TITLE" "DATE" "AUTHOR" "EMAIL"))
+        (let ((val (cdr key)))
+          (if subtreep (org-entry-put node (concat "EXPORT_" (car key)) val)
+            (insert
+             (format "#+%s:%s\n"
+                     (car key)
+                     (if (org-string-nw-p val) (format " %s" val) "")))))))))
+
 (defun org-export-output-file-name (extension &optional subtreep pub-dir)
 (defun org-export-output-file-name (extension &optional subtreep pub-dir)
   "Return output file's name according to buffer specifications.
   "Return output file's name according to buffer specifications.
 
 
@@ -5473,6 +5575,7 @@ When ARG is \\[universal-argument] \\[universal-argument], display the asynchron
       (move-marker org-export-dispatch-last-position nil))
       (move-marker org-export-dispatch-last-position nil))
     (case action
     (case action
       ;; First handle special hard-coded actions.
       ;; First handle special hard-coded actions.
+      (template (org-export-insert-default-template nil optns))
       (stack (org-export-stack))
       (stack (org-export-stack))
       (publish-current-file
       (publish-current-file
        (org-publish-current-file (memq 'force optns) (memq 'async optns)))
        (org-publish-current-file (memq 'force optns) (memq 'async optns)))
@@ -5489,12 +5592,12 @@ When ARG is \\[universal-argument] \\[universal-argument], display the asynchron
       (otherwise
       (otherwise
        (save-excursion
        (save-excursion
 	 (when arg
 	 (when arg
-	   ;; Repeating command, maybe move cursor
-	   ;; to restore subtree context
+	   ;; Repeating command, maybe move cursor to restore subtree
+	   ;; context.
 	   (if (eq (marker-buffer org-export-dispatch-last-position)
 	   (if (eq (marker-buffer org-export-dispatch-last-position)
 		   (org-base-buffer (current-buffer)))
 		   (org-base-buffer (current-buffer)))
 	       (goto-char org-export-dispatch-last-position)
 	       (goto-char org-export-dispatch-last-position)
-	     ;; We are in a differnet buffer, forget position
+	     ;; We are in a different buffer, forget position.
 	     (move-marker org-export-dispatch-last-position nil)))
 	     (move-marker org-export-dispatch-last-position nil)))
 	 (funcall action
 	 (funcall action
 		  ;; Return a symbol instead of a list to ease
 		  ;; Return a symbol instead of a list to ease
@@ -5563,8 +5666,9 @@ back to standard interface."
 		      ((numberp key-b) t)))))
 		      ((numberp key-b) t)))))
 	   (lambda (a b) (< (car a) (car b)))))
 	   (lambda (a b) (< (car a) (car b)))))
 	 ;; Compute a list of allowed keys based on the first key
 	 ;; Compute a list of allowed keys based on the first key
-	 ;; pressed, if any.  Some keys (?^B, ?^V, ?^S, ?^F, ?^A
-	 ;; and ?q) are always available.
+	 ;; pressed, if any.  Some keys
+	 ;; (?^B, ?^V, ?^S, ?^F, ?^A, ?&, ?# and ?q) are always
+	 ;; available.
 	 (allowed-keys
 	 (allowed-keys
 	  (nconc (list 2 22 19 6 1)
 	  (nconc (list 2 22 19 6 1)
 		 (if (not first-key) (org-uniquify (mapcar 'car backends))
 		 (if (not first-key) (org-uniquify (mapcar 'car backends))
@@ -5574,7 +5678,7 @@ back to standard interface."
 			 (setq sub-menu (append (nth 2 backend) sub-menu))))))
 			 (setq sub-menu (append (nth 2 backend) sub-menu))))))
 		 (cond ((eq first-key ?P) (list ?f ?p ?x ?a))
 		 (cond ((eq first-key ?P) (list ?f ?p ?x ?a))
 		       ((not first-key) (list ?P)))
 		       ((not first-key) (list ?P)))
-		 (list ?&)
+		 (list ?& ?#)
 		 (when expertp (list ??))
 		 (when expertp (list ??))
 		 (list ?q)))
 		 (list ?q)))
 	 ;; Build the help menu for standard UI.
 	 ;; Build the help menu for standard UI.
@@ -5582,10 +5686,9 @@ back to standard interface."
 	  (unless expertp
 	  (unless expertp
 	    (concat
 	    (concat
 	     ;; Options are hard-coded.
 	     ;; Options are hard-coded.
-	     (format "Options
-    [%s] Body only:    %s       [%s] Visible only:     %s
-    [%s] Export scope: %s   [%s] Force publishing: %s
-    [%s] Async export: %s\n"
+	     (format "[%s] Body only:    %s           [%s] Visible only:     %s
+\[%s] Export scope: %s       [%s] Force publishing: %s
+\[%s] Async export: %s\n\n"
 		     (funcall fontify-key "C-b" t)
 		     (funcall fontify-key "C-b" t)
 		     (funcall fontify-value
 		     (funcall fontify-value
 			      (if (memq 'body options) "On " "Off"))
 			      (if (memq 'body options) "On " "Off"))
@@ -5635,14 +5738,16 @@ back to standard interface."
 	     ;; Publishing menu is hard-coded.
 	     ;; Publishing menu is hard-coded.
 	     (format "\n[%s] Publish
 	     (format "\n[%s] Publish
     [%s] Current file              [%s] Current project
     [%s] Current file              [%s] Current project
-    [%s] Choose project            [%s] All projects\n\n"
+    [%s] Choose project            [%s] All projects\n\n\n"
 		     (funcall fontify-key "P")
 		     (funcall fontify-key "P")
 		     (funcall fontify-key "f" ?P)
 		     (funcall fontify-key "f" ?P)
 		     (funcall fontify-key "p" ?P)
 		     (funcall fontify-key "p" ?P)
 		     (funcall fontify-key "x" ?P)
 		     (funcall fontify-key "x" ?P)
 		     (funcall fontify-key "a" ?P))
 		     (funcall fontify-key "a" ?P))
-	     (format "\[%s] Export stack\n" (funcall fontify-key "&" t))
-	     (format "\[%s] %s"
+	     (format "[%s] Export stack                  [%s] Insert template\n"
+		     (funcall fontify-key "&" t)
+		     (funcall fontify-key "#" t))
+	     (format "[%s] %s"
 		     (funcall fontify-key "q" t)
 		     (funcall fontify-key "q" t)
 		     (if first-key "Main menu" "Exit")))))
 		     (if first-key "Main menu" "Exit")))))
 	 ;; Build prompts for both standard and expert UI.
 	 ;; Build prompts for both standard and expert UI.
@@ -5710,13 +5815,13 @@ options as CDR."
 		(memq key '(14 16 ?\s ?\d)))
 		(memq key '(14 16 ?\s ?\d)))
       (case key
       (case key
 	(14 (if (not (pos-visible-in-window-p (point-max)))
 	(14 (if (not (pos-visible-in-window-p (point-max)))
-		 (ignore-errors (scroll-up-line))
-	       (message "End of buffer")
-	       (sit-for 1)))
+		(ignore-errors (scroll-up-line))
+	      (message "End of buffer")
+	      (sit-for 1)))
 	(16 (if (not (pos-visible-in-window-p (point-min)))
 	(16 (if (not (pos-visible-in-window-p (point-min)))
-		 (ignore-errors (scroll-down-line))
-	       (message "Beginning of buffer")
-	       (sit-for 1)))
+		(ignore-errors (scroll-down-line))
+	      (message "Beginning of buffer")
+	      (sit-for 1)))
 	(?\s (if (not (pos-visible-in-window-p (point-max)))
 	(?\s (if (not (pos-visible-in-window-p (point-max)))
 		 (scroll-up nil)
 		 (scroll-up nil)
 	       (message "End of buffer")
 	       (message "End of buffer")
@@ -5731,17 +5836,18 @@ options as CDR."
       (ding)
       (ding)
       (unless expertp (message "Invalid key") (sit-for 1))
       (unless expertp (message "Invalid key") (sit-for 1))
       (org-export--dispatch-ui options first-key expertp))
       (org-export--dispatch-ui options first-key expertp))
-     ;; q key at first level aborts export.  At second
-     ;; level, cancel first key instead.
+     ;; q key at first level aborts export.  At second level, cancel
+     ;; first key instead.
      ((eq key ?q) (if (not first-key) (error "Export aborted")
      ((eq key ?q) (if (not first-key) (error "Export aborted")
 		    (org-export--dispatch-ui options nil expertp)))
 		    (org-export--dispatch-ui options nil expertp)))
-     ;; Help key: Switch back to standard interface if
-     ;; expert UI was active.
+     ;; Help key: Switch back to standard interface if expert UI was
+     ;; active.
      ((eq key ??) (org-export--dispatch-ui options first-key nil))
      ((eq key ??) (org-export--dispatch-ui options first-key nil))
+     ;; Send request for template insertion along with export scope.
+     ((eq key ?#) (cons 'template (memq 'subtree options)))
      ;; Switch to asynchronous export stack.
      ;; Switch to asynchronous export stack.
      ((eq key ?&) '(stack))
      ((eq key ?&) '(stack))
-     ;; Toggle export options
-     ;; C-b (2) C-v (22) C-s (19) C-f (6) C-a (1)
+     ;; Toggle options: C-b (2) C-v (22) C-s (19) C-f (6) C-a (1).
      ((memq key '(2 22 19 6 1))
      ((memq key '(2 22 19 6 1))
       (org-export--dispatch-ui
       (org-export--dispatch-ui
        (let ((option (case key (2 'body) (22 'visible) (19 'subtree)
        (let ((option (case key (2 'body) (22 'visible) (19 'subtree)