forked from mirrors/org-mode
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.
This commit is contained in:
Nicolas Goaziou
parent
d1c940fe5c
commit
67cf80ae9a
158
lisp/ox.el
158
lisp/ox.el
|
|
@ -65,7 +65,7 @@
|
|||
;; customizable should belong to the `org-export-BACKEND' group.
|
||||
;;
|
||||
;; 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,
|
||||
;; `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
|
||||
;; why file inclusion should be done before any structure can be
|
||||
;; 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 ()
|
||||
"Return a copy of the current buffer.
|
||||
|
|
@ -3052,6 +3056,104 @@ Return code as a string."
|
|||
(org-mode)
|
||||
(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)
|
||||
"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))
|
||||
(case action
|
||||
;; First handle special hard-coded actions.
|
||||
(template (org-export-insert-default-template nil optns))
|
||||
(stack (org-export-stack))
|
||||
(publish-current-file
|
||||
(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
|
||||
(save-excursion
|
||||
(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)
|
||||
(org-base-buffer (current-buffer)))
|
||||
(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)))
|
||||
(funcall action
|
||||
;; Return a symbol instead of a list to ease
|
||||
|
|
@ -5563,8 +5666,9 @@ back to standard interface."
|
|||
((numberp key-b) t)))))
|
||||
(lambda (a b) (< (car a) (car b)))))
|
||||
;; 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
|
||||
(nconc (list 2 22 19 6 1)
|
||||
(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))))))
|
||||
(cond ((eq first-key ?P) (list ?f ?p ?x ?a))
|
||||
((not first-key) (list ?P)))
|
||||
(list ?&)
|
||||
(list ?& ?#)
|
||||
(when expertp (list ??))
|
||||
(list ?q)))
|
||||
;; Build the help menu for standard UI.
|
||||
|
|
@ -5582,10 +5686,9 @@ back to standard interface."
|
|||
(unless expertp
|
||||
(concat
|
||||
;; 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-value
|
||||
(if (memq 'body options) "On " "Off"))
|
||||
|
|
@ -5635,14 +5738,16 @@ back to standard interface."
|
|||
;; Publishing menu is hard-coded.
|
||||
(format "\n[%s] Publish
|
||||
[%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 "f" ?P)
|
||||
(funcall fontify-key "p" ?P)
|
||||
(funcall fontify-key "x" ?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)
|
||||
(if first-key "Main menu" "Exit")))))
|
||||
;; Build prompts for both standard and expert UI.
|
||||
|
|
@ -5710,13 +5815,13 @@ options as CDR."
|
|||
(memq key '(14 16 ?\s ?\d)))
|
||||
(case key
|
||||
(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)))
|
||||
(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)))
|
||||
(scroll-up nil)
|
||||
(message "End of buffer")
|
||||
|
|
@ -5731,17 +5836,18 @@ options as CDR."
|
|||
(ding)
|
||||
(unless expertp (message "Invalid key") (sit-for 1))
|
||||
(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")
|
||||
(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))
|
||||
;; Send request for template insertion along with export scope.
|
||||
((eq key ?#) (cons 'template (memq 'subtree options)))
|
||||
;; Switch to asynchronous export 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))
|
||||
(org-export--dispatch-ui
|
||||
(let ((option (case key (2 'body) (22 'visible) (19 'subtree)
|
||||
|
|
|
|||
Loading…
Reference in New Issue