Function: org-export--dispatch-ui
org-export--dispatch-ui is a byte-compiled function defined in
ox.el.gz.
Signature
(org-export--dispatch-ui OPTIONS FIRST-KEY EXPERTP)
Documentation
Handle interface for org-export-dispatch.
OPTIONS is a list containing current interactive options set for
export. It can contain any of the following symbols:
body toggles a body-only export
subtree restricts export to current subtree
visible restricts export to visible part of buffer.
force force publishing files.
async use asynchronous export process
FIRST-KEY is the key pressed to select the first level menu. It is nil when this menu hasn't been selected yet.
EXPERTP, when non-nil, triggers expert UI. In that case, no help buffer is provided, but indications about currently active options are given in the prompt. Moreover, [?] allows switching back to standard interface.
Source Code
;; Defined in /usr/src/emacs/lisp/org/ox.el.gz
(defun org-export--dispatch-ui (options first-key expertp)
"Handle interface for `org-export-dispatch'.
OPTIONS is a list containing current interactive options set for
export. It can contain any of the following symbols:
`body' toggles a body-only export
`subtree' restricts export to current subtree
`visible' restricts export to visible part of buffer.
`force' force publishing files.
`async' use asynchronous export process
FIRST-KEY is the key pressed to select the first level menu. It
is nil when this menu hasn't been selected yet.
EXPERTP, when non-nil, triggers expert UI. In that case, no help
buffer is provided, but indications about currently active
options are given in the prompt. Moreover, [?] allows switching
back to standard interface."
(let* ((fontify-key
(lambda (key &optional access-key)
;; Fontify KEY string. Optional argument ACCESS-KEY, when
;; non-nil is the required first-level key to activate
;; KEY. When its value is t, activate KEY independently
;; on the first key, if any. A nil value means KEY will
;; only be activated at first level.
(if (or (eq access-key t) (eq access-key first-key))
(propertize key 'face 'org-dispatcher-highlight)
key)))
(fontify-value
(lambda (value)
;; Fontify VALUE string.
(propertize value 'face 'font-lock-variable-name-face)))
;; Prepare menu entries by extracting them from registered
;; backends and sorting them by access key and by ordinal,
;; if any.
(entries
(sort (sort (delq nil
(mapcar #'org-export-backend-menu
org-export-registered-backends))
(lambda (a b)
(let ((key-a (nth 1 a))
(key-b (nth 1 b)))
(cond ((and (numberp key-a) (numberp key-b))
(< key-a key-b))
((numberp key-b) t)))))
#'car-less-than-car))
;; 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.
(allowed-keys
(nconc (list 2 22 19 6 1)
(if (not first-key) (org-uniquify (mapcar #'car entries))
(let (sub-menu)
(dolist (entry entries (sort (mapcar #'car sub-menu) #'<))
(when (eq (car entry) first-key)
(setq sub-menu (append (nth 2 entry) sub-menu))))))
(cond ((eq first-key ?P) (list ?f ?p ?x ?a))
((not first-key) (list ?P)))
(list ?& ?#)
(when expertp (list ??))
(list ?q)))
;; Build the help menu for standard UI.
(help
(unless expertp
(concat
;; Options are hard-coded.
(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"))
(funcall fontify-key "C-v" t)
(funcall fontify-value
(if (memq 'visible options) "On " "Off"))
(funcall fontify-key "C-s" t)
(funcall fontify-value
(if (memq 'subtree options) "Subtree" "Buffer "))
(funcall fontify-key "C-f" t)
(funcall fontify-value
(if (memq 'force options) "On " "Off"))
(funcall fontify-key "C-a" t)
(funcall fontify-value
(if (memq 'async options) "On " "Off")))
;; Display registered backend entries. When a key
;; appears for the second time, do not create another
;; entry, but append its sub-menu to existing menu.
(let (last-key)
(mapconcat
(lambda (entry)
(let ((top-key (car entry)))
(concat
(unless (eq top-key last-key)
(setq last-key top-key)
(format "\n[%s] %s\n"
(funcall fontify-key (char-to-string top-key))
(nth 1 entry)))
(let ((sub-menu (nth 2 entry)))
(unless (functionp sub-menu)
;; Split sub-menu into two columns.
(let ((index -1))
(concat
(mapconcat
(lambda (sub-entry)
(cl-incf index)
(format
(if (zerop (mod index 2)) " [%s] %-26s"
"[%s] %s\n")
(funcall fontify-key
(char-to-string (car sub-entry))
top-key)
(nth 1 sub-entry)))
sub-menu "")
(when (zerop (mod index 2)) "\n"))))))))
entries ""))
;; Publishing menu is hard-coded.
(format "\n[%s] Publish
[%s] Current file [%s] Current project
[%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 [%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.
(standard-prompt (unless expertp "Export command: "))
(expert-prompt
(when expertp
(format
"Export command (C-%s%s%s%s%s) [%s]: "
(if (memq 'body options) (funcall fontify-key "b" t) "b")
(if (memq 'visible options) (funcall fontify-key "v" t) "v")
(if (memq 'subtree options) (funcall fontify-key "s" t) "s")
(if (memq 'force options) (funcall fontify-key "f" t) "f")
(if (memq 'async options) (funcall fontify-key "a" t) "a")
(mapconcat (lambda (k)
;; Strip control characters.
(unless (< k 27) (char-to-string k)))
allowed-keys "")))))
;; With expert UI, just read key with a fancy prompt. In standard
;; UI, display an intrusive help buffer.
(if expertp
(org-export--dispatch-action
expert-prompt allowed-keys entries options first-key expertp)
(save-window-excursion
;; At first call, create frame layout in order to display menu.
(unless (get-buffer "*Org Export Dispatcher*")
(pop-to-buffer "*Org Export Dispatcher*" '(org-display-buffer-split))
(setq cursor-type nil)
(setq header-line-format
(let ((propertize-help-key
(lambda (key)
;; Add `face' *and* `font-lock-face' to "work
;; reliably in any buffer", per a comment in
;; `help--key-description-fontified'.
(propertize key
'font-lock-face 'help-key-binding
'face 'help-key-binding))))
(apply 'format
(cons "Use %s, %s, %s, or %s to navigate."
(mapcar propertize-help-key
(list "SPC" "DEL" "C-n" "C-p"))))))
;; Make sure that invisible cursor will not highlight square
;; brackets.
(set-syntax-table (copy-syntax-table))
(modify-syntax-entry ?\[ "w"))
;; At this point, the buffer containing the menu exists and is
;; visible in the current window. So, refresh it.
(with-current-buffer "*Org Export Dispatcher*"
;; Refresh help. Maintain display continuity by re-visiting
;; previous window position.
(let ((pt (point))
(wstart (window-start)))
(erase-buffer)
(insert help)
(goto-char pt)
(set-window-start nil wstart)))
(org-fit-window-to-buffer)
(org-export--dispatch-action
standard-prompt allowed-keys entries options first-key expertp)))))