forked from mirrors/org-mode
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:
parent
1298b6468a
commit
5a1d46b990
57
lisp/ox.el
57
lisp/ox.el
|
@ -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)))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue