ox: Implement vertical scrolling in non-expert UI

* lisp/ox.el (org-export--dispatch-ui): Renamed from
  `org-export-dispatch-ui'.  Handle scrolling.
(org-export--dispatch-action): Renamed from
`org-export-dispatch-action'.  Implement scrolling.
(org-export-dispatch): Apply renaming.

Heavily based on a patch from Jambunathan K.
This commit is contained in:
Nicolas Goaziou 2013-02-15 17:22:24 +01:00
parent 1298b6468a
commit 5a1d46b990
1 changed files with 40 additions and 17 deletions

View File

@ -5242,9 +5242,9 @@ files or buffers, only the display.
;;; The Dispatcher ;;; The Dispatcher
;; ;;
;; `org-export-dispatch' is the standard interactive way to start an ;; `org-export-dispatch' is the standard interactive way to start an
;; export process. It uses `org-export-dispatch-ui' as a subroutine ;; export process. It uses `org-export--dispatch-ui' as a subroutine
;; for its interface, which, in turn, delegates response to key ;; for its interface, which, in turn, delegates response to key
;; pressed to `org-export-dispatch-action'. ;; pressed to `org-export--dispatch-action'.
;;;###autoload ;;;###autoload
(defun org-export-dispatch (&optional arg) (defun org-export-dispatch (&optional arg)
@ -5269,7 +5269,7 @@ When ARG is \\[universal-argument] \\[universal-argument], display the asynchron
(unwind-protect (unwind-protect
;; Store this export command. ;; Store this export command.
(setq org-export-dispatch-last-action (setq org-export-dispatch-last-action
(org-export-dispatch-ui (org-export--dispatch-ui
(list org-export-initial-scope (list org-export-initial-scope
(and org-export-in-background 'async)) (and org-export-in-background 'async))
nil nil
@ -5301,7 +5301,7 @@ When ARG is \\[universal-argument] \\[universal-argument], display the asynchron
(and (memq 'visible optns) t) (and (memq 'visible optns) t)
(and (memq 'body optns) t)))))) (and (memq 'body optns) t))))))
(defun org-export-dispatch-ui (options first-key expertp) (defun org-export--dispatch-ui (options first-key expertp)
"Handle interface for `org-export-dispatch'. "Handle interface for `org-export-dispatch'.
OPTIONS is a list containing current interactive options set for OPTIONS is a list containing current interactive options set for
@ -5460,55 +5460,78 @@ back to standard interface."
;; 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
(org-export-dispatch-action (org-export--dispatch-action
expert-prompt allowed-keys backends options first-key expertp) expert-prompt allowed-keys backends options first-key expertp)
;; At first call, create frame layout in order to display menu. ;; At first call, create frame layout in order to display menu.
(unless (get-buffer "*Org Export Dispatcher*") (unless (get-buffer "*Org Export Dispatcher*")
(delete-other-windows) (delete-other-windows)
(org-switch-to-buffer-other-window (org-switch-to-buffer-other-window
(get-buffer-create "*Org Export Dispatcher*")) (get-buffer-create "*Org Export Dispatcher*"))
(setq cursor-type nil)) (setq cursor-type nil)
;; Prevent square brackets from being highlighted when point
;; moves onto them.
(modify-syntax-entry ?\[ "w"))
;; At this point, the buffer containing the menu exists and is ;; At this point, the buffer containing the menu exists and is
;; visible in the current window. So, refresh it. ;; visible in the current window. So, refresh it.
(with-current-buffer "*Org Export Dispatcher*" (with-current-buffer "*Org Export Dispatcher*"
(erase-buffer) ;; Refresh help. Maintain display continuity by re-visiting
(insert help)) ;; previous window position.
(let ((pos (window-start)))
(erase-buffer)
(insert help)
(set-window-start nil pos)))
(org-fit-window-to-buffer) (org-fit-window-to-buffer)
(org-export-dispatch-action (org-export--dispatch-action
standard-prompt allowed-keys backends options first-key expertp)))) standard-prompt allowed-keys backends options first-key expertp))))
(defun org-export-dispatch-action (defun org-export--dispatch-action
(prompt allowed-keys backends options first-key expertp) (prompt allowed-keys backends options first-key expertp)
"Read a character from command input and act accordingly. "Read a character from command input and act accordingly.
PROMPT is the displayed prompt, as a string. ALLOWED-KEYS is PROMPT is the displayed prompt, as a string. ALLOWED-KEYS is
a list of characters available at a given step in the process. a list of characters available at a given step in the process.
BACKENDS is a list of menu entries. OPTIONS, FIRST-KEY and BACKENDS is a list of menu entries. OPTIONS, FIRST-KEY and
EXPERTP are the same as defined in `org-export-dispatch-ui', EXPERTP are the same as defined in `org-export--dispatch-ui',
which see. 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 (read-char-exclusive prompt))) (let (key)
;; Scrolling: when in non-expert mode, act on motion keys (C-n,
;; C-p, SPC, DEL).
(while (and (setq key (read-char-exclusive prompt))
(not expertp)
(memq key '(? ? ?\s ?\d)))
(case key
(? (ignore-errors (scroll-up-line)))
(? (ignore-errors (scroll-down-line)))
(?\s (if (not (pos-visible-in-window-p (point-max)))
(scroll-up nil)
(message "End of buffer")
(sit-for 1)))
(?\d (if (not (pos-visible-in-window-p (point-min)))
(scroll-down nil)
(message "Beginning of buffer")
(sit-for 1)))))
(cond (cond
;; Ignore undefined associations. ;; Ignore 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))
(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 ;; q key at first level aborts export. At second
;; level, cancel first key instead. ;; 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 ;; Help key: Switch back to standard interface if
;; expert UI was active. ;; expert UI was active.
((eq key ??) (org-export-dispatch-ui options first-key nil)) ((eq key ??) (org-export--dispatch-ui options first-key nil))
;; Switch to asynchronous export stack. ;; Switch to asynchronous export stack.
((eq key ?&) '(stack)) ((eq key ?&) '(stack))
;; Toggle export options. ;; Toggle export options.
((memq key '(? ? ? ? ?)) ((memq key '(? ? ? ? ?))
(org-export-dispatch-ui (org-export--dispatch-ui
(let ((option (case key (? 'body) (? 'visible) (? 'subtree) (let ((option (case key (? 'body) (? 'visible) (? 'subtree)
(? 'force) (? 'async)))) (? 'force) (? 'async))))
(if (memq option options) (remq option options) (if (memq option options) (remq option options)
@ -5537,7 +5560,7 @@ options as CDR."
(member (assq first-key backends) backends))))) (member (assq first-key backends) backends)))))
options)) options))
;; Otherwise, enter sub-menu. ;; Otherwise, enter sub-menu.
(t (org-export-dispatch-ui options key expertp))))) (t (org-export--dispatch-ui options key expertp)))))