From 67cf80ae9a1ad01ff7964958bc1739d3fc43482d Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 6 Apr 2013 00:10:08 +0200 Subject: [PATCH] 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. --- lisp/ox.el | 158 ++++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 132 insertions(+), 26 deletions(-) diff --git a/lisp/ox.el b/lisp/ox.el index 32b2ac93e..e2c1b5b7a 100644 --- a/lisp/ox.el +++ b/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)