org-export: Change dispatcher keys and improve UI

* contrib/lisp/org-export.el (org-export-dispatch-ui,
org-export-dispatch-action): Set export options via control keys.  UI
changes.
This commit is contained in:
Jambunathan K 2013-01-14 00:23:22 +05:30 committed by Nicolas Goaziou
parent 655ba9f939
commit 35204a83dd
1 changed files with 39 additions and 31 deletions

View File

@ -5244,8 +5244,12 @@ back to standard interface."
;; on the first key, if any. A nil value means KEY will ;; on the first key, if any. A nil value means KEY will
;; only be activated at first level. ;; only be activated at first level.
(if (or (eq access-key t) (eq access-key first-key)) (if (or (eq access-key t) (eq access-key first-key))
(org-add-props key nil 'face 'org-warning) (org-propertize key 'face 'org-warning)
(org-no-properties key)))) key)))
(fontify-value
(lambda (value)
;; Fontify VALUE string.
(org-propertize value 'face 'font-lock-variable-name-face)))
;; Prepare menu entries by extracting them from ;; Prepare menu entries by extracting them from
;; `org-export-registered-backends', and sorting them by ;; `org-export-registered-backends', and sorting them by
;; access key and by ordinal, if any. ;; access key and by ordinal, if any.
@ -5263,10 +5267,10 @@ 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 (?1, ?2, ?3, ?4, ?5 and ?q) ;; pressed, if any. Some keys (?^B, ?^V, ?^S, ?^F, ?^A
;; are always available. ;; and ?q) are always available.
(allowed-keys (allowed-keys
(nconc (list ?1 ?2 ?3 ?4 ?5) (nconc (list ? ? ? ? ?)
(if (not first-key) (org-uniquify (mapcar 'car backends)) (if (not first-key) (org-uniquify (mapcar 'car backends))
(let (sub-menu) (let (sub-menu)
(dolist (backend backends (sort (mapcar 'car sub-menu) '<)) (dolist (backend backends (sort (mapcar 'car sub-menu) '<))
@ -5285,17 +5289,22 @@ back to standard interface."
(format "Options (format "Options
[%s] Body only: %s [%s] Visible only: %s [%s] Body only: %s [%s] Visible only: %s
[%s] Export scope: %s [%s] Force publishing: %s [%s] Export scope: %s [%s] Force publishing: %s
[%s] Asynchronous export: %s\n" [%s] Async export: %s\n"
(funcall fontify-key "1" t) (funcall fontify-key "C-b" t)
(if (memq 'body options) "On " "Off") (funcall fontify-value
(funcall fontify-key "2" t) (if (memq 'body options) "On " "Off"))
(if (memq 'visible options) "On " "Off") (funcall fontify-key "C-v" t)
(funcall fontify-key "3" t) (funcall fontify-value
(if (memq 'subtree options) "Subtree" "Buffer ") (if (memq 'visible options) "On " "Off"))
(funcall fontify-key "4" t) (funcall fontify-key "C-s" t)
(if (memq 'force options) "On " "Off") (funcall fontify-value
(funcall fontify-key "5" t) (if (memq 'subtree options) "Subtree" "Buffer "))
(if (memq 'async options) "On " "Off")) (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 back-end entries. When a key ;; Display registered back-end entries. When a key
;; appears for the second time, do not create another ;; appears for the second time, do not create another
;; entry, but append its sub-menu to existing menu. ;; entry, but append its sub-menu to existing menu.
@ -5346,12 +5355,15 @@ back to standard interface."
(when expertp (when expertp
(format (format
"Export command (Options: %s%s%s%s%s) [%s]: " "Export command (Options: %s%s%s%s%s) [%s]: "
(if (memq 'body options) (funcall fontify-key "b" t) "-") (if (memq 'body options) (funcall fontify-key "b" t) "b")
(if (memq 'visible options) (funcall fontify-key "v" t) "-") (if (memq 'visible options) (funcall fontify-key "v" t) "v")
(if (memq 'subtree options) (funcall fontify-key "s" t) "-") (if (memq 'subtree options) (funcall fontify-key "s" t) "s")
(if (memq 'force options) (funcall fontify-key "f" t) "-") (if (memq 'force options) (funcall fontify-key "f" t) "f")
(if (memq 'async options) (funcall fontify-key "a" t) "-") (if (memq 'async options) (funcall fontify-key "a" t) "a")
(concat allowed-keys))))) (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 ;; With expert UI, just read key with a fancy prompt. In standard
;; UI, display an intrusive help buffer. ;; UI, display an intrusive help buffer.
(if expertp (if expertp
@ -5385,13 +5397,9 @@ which see.
Toggle export options when required. Otherwise, return value is Toggle export options when required. Otherwise, return value is
a list with action as CAR and a list of interactive export a list with action as CAR and a list of interactive export
options as CDR." options as CDR."
(let ((key (let ((k (read-char-exclusive prompt))) (let ((key (read-char-exclusive prompt)))
;; Translate "C-a", "C-b"... into "a", "b"... Then take action
;; depending on user's key pressed.
(if (< k 27) (+ k 96) k))))
(cond (cond
;; Ignore non-standard characters (i.e. "M-a") and ;; Ignore undefined associations.
;; undefined associations.
((not (memq key allowed-keys)) ((not (memq key allowed-keys))
(ding) (ding)
(unless expertp (message "Invalid key") (sit-for 1)) (unless expertp (message "Invalid key") (sit-for 1))
@ -5406,10 +5414,10 @@ options as CDR."
;; Switch to asynchronous export stack. ;; Switch to asynchronous export stack.
((eq key ?&) '(stack)) ((eq key ?&) '(stack))
;; Toggle export options. ;; Toggle export options.
((memq key '(?1 ?2 ?3 ?4 ?5)) ((memq key '(? ? ? ? ?))
(org-export-dispatch-ui (org-export-dispatch-ui
(let ((option (case key (?1 'body) (?2 'visible) (?3 'subtree) (let ((option (case key (? 'body) (? 'visible) (? 'subtree)
(?4 'force) (?5 'async)))) (? 'force) (? 'async))))
(if (memq option options) (remq option options) (if (memq option options) (remq option options)
(cons option options))) (cons option options)))
first-key expertp)) first-key expertp))