forked from mirrors/org-mode
org.el: Disable {pro,de}motion commands in orgstruct-mode if orgstruct-heading-prefix-regexp is non-nil
* org.el (orgstruct-heading-prefix-regexp): Change default
value to nil.
(orgstruct-error): Use user-error if available.
(orgstruct-setup): Disable bindings of {pro,de}motion commands
if orgstruct-heading-prefix-regexp is non-nil. Always use
org-outline-level.
(orgstruct-make-binding): New argument
DISABLE-WHEN-HEADING-PREFIX.
This commit is contained in:
Christopher Schmidt
parent
ccee7e4885
commit
03b1edf3c1
187
lisp/org.el
187
lisp/org.el
|
|
@ -8658,7 +8658,7 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive."
|
|||
;; command. There might be problems if any of the keys is otherwise
|
||||
;; used as a prefix key.
|
||||
|
||||
(defcustom orgstruct-heading-prefix-regexp ""
|
||||
(defcustom orgstruct-heading-prefix-regexp nil
|
||||
"Regexp that matches the custom prefix of Org headlines in
|
||||
orgstruct(++)-mode."
|
||||
:group 'org
|
||||
|
|
@ -8739,76 +8739,87 @@ buffer. It will also recognize item context in multiline items."
|
|||
(defun orgstruct-error ()
|
||||
"Error when there is no default binding for a structure key."
|
||||
(interactive)
|
||||
(error "This key has no function outside structure elements"))
|
||||
(funcall (if (fboundp 'user-error)
|
||||
'user-error
|
||||
'error)
|
||||
"This key has no function outside structure elements"))
|
||||
|
||||
(defun orgstruct-setup ()
|
||||
"Setup orgstruct keymap."
|
||||
(dolist (f
|
||||
'("org-meta"
|
||||
"org-shift"
|
||||
"org-shiftmeta"
|
||||
org-shifttab
|
||||
org-backward-element
|
||||
org-backward-heading-same-level
|
||||
org-ctrl-c-ret
|
||||
org-ctrl-c-minus
|
||||
org-ctrl-c-star
|
||||
org-cycle
|
||||
org-forward-heading-same-level
|
||||
org-insert-heading
|
||||
org-insert-heading-respect-content
|
||||
org-kill-note-or-show-branches
|
||||
org-mark-subtree
|
||||
org-narrow-to-subtree
|
||||
org-promote-subtree
|
||||
org-reveal
|
||||
org-show-subtree
|
||||
org-sort
|
||||
org-up-element
|
||||
outline-demote
|
||||
outline-next-visible-heading
|
||||
outline-previous-visible-heading
|
||||
outline-promote
|
||||
outline-up-heading
|
||||
show-children))
|
||||
(dolist (f (if (stringp f)
|
||||
(let ((flist))
|
||||
(dolist (postfix
|
||||
'("-return" "tab" "left" "right" "up" "down")
|
||||
flist)
|
||||
(let ((f (intern (concat f postfix))))
|
||||
(when (fboundp f)
|
||||
(push f flist)))))
|
||||
(list f)))
|
||||
(dolist (binding (nconc (where-is-internal f org-mode-map)
|
||||
(where-is-internal f outline-mode-map)))
|
||||
;; TODO use local-function-key-map
|
||||
(dolist (rep '(("<tab>" . "TAB")
|
||||
("<return>" . "RET")
|
||||
("<escape>" . "ESC")
|
||||
("<delete>" . "DEL")))
|
||||
(setq binding (read-kbd-macro (replace-regexp-in-string
|
||||
(regexp-quote (car rep))
|
||||
(cdr rep)
|
||||
(key-description binding)))))
|
||||
(let ((key (lookup-key orgstruct-mode-map binding)))
|
||||
(when (or (not key) (numberp key))
|
||||
(condition-case nil
|
||||
(org-defkey orgstruct-mode-map
|
||||
binding
|
||||
(orgstruct-make-binding f binding))
|
||||
(error nil)))))))
|
||||
(dolist (cell '((org-demote . t)
|
||||
(org-metaleft . t)
|
||||
(org-metaright . t)
|
||||
(org-promote . t)
|
||||
(org-shiftmetaleft . t)
|
||||
(org-shiftmetaright . t)
|
||||
org-backward-element
|
||||
org-backward-heading-same-level
|
||||
org-ctrl-c-ret
|
||||
org-ctrl-c-minus
|
||||
org-ctrl-c-star
|
||||
org-cycle
|
||||
org-forward-heading-same-level
|
||||
org-insert-heading
|
||||
org-insert-heading-respect-content
|
||||
org-kill-note-or-show-branches
|
||||
org-mark-subtree
|
||||
org-meta-return
|
||||
org-metadown
|
||||
org-metaup
|
||||
org-narrow-to-subtree
|
||||
org-promote-subtree
|
||||
org-reveal
|
||||
org-shiftdown
|
||||
org-shiftleft
|
||||
org-shiftmetadown
|
||||
org-shiftmetaup
|
||||
org-shiftright
|
||||
org-shifttab
|
||||
org-shifttab
|
||||
org-shiftup
|
||||
org-show-subtree
|
||||
org-sort
|
||||
org-up-element
|
||||
outline-demote
|
||||
outline-next-visible-heading
|
||||
outline-previous-visible-heading
|
||||
outline-promote
|
||||
outline-up-heading
|
||||
show-children))
|
||||
(let ((f (or (car-safe cell) cell))
|
||||
(disable-when-heading-prefix (cdr-safe cell)))
|
||||
(when (fboundp f)
|
||||
(dolist (binding (nconc (where-is-internal f org-mode-map)
|
||||
(where-is-internal f outline-mode-map)))
|
||||
;; TODO use local-function-key-map
|
||||
(dolist (rep '(("<tab>" . "TAB")
|
||||
("<return>" . "RET")
|
||||
("<escape>" . "ESC")
|
||||
("<delete>" . "DEL")))
|
||||
(setq binding (read-kbd-macro (replace-regexp-in-string
|
||||
(regexp-quote (car rep))
|
||||
(cdr rep)
|
||||
(key-description binding)))))
|
||||
(let ((key (lookup-key orgstruct-mode-map binding)))
|
||||
(when (or (not key) (numberp key))
|
||||
(condition-case nil
|
||||
(org-defkey orgstruct-mode-map
|
||||
binding
|
||||
(orgstruct-make-binding f binding disable-when-heading-prefix))
|
||||
(error nil))))))))
|
||||
(run-hooks 'orgstruct-setup-hook))
|
||||
|
||||
(defun orgstruct-make-binding (fun key)
|
||||
(defun orgstruct-make-binding (fun key disable-when-heading-prefix)
|
||||
"Create a function for binding in the structure minor mode.
|
||||
FUN is the command to call inside a table. KEY is the key that
|
||||
should be checked in for a command to execute outside of tables."
|
||||
should be checked in for a command to execute outside of tables.
|
||||
Non-nil DISABLE-WHEN-HEADING-PREFIX means to disable the command
|
||||
if `orgstruct-heading-prefix-regexp' is non-nil."
|
||||
(let ((name (concat "orgstruct-hijacker-" (symbol-name fun))))
|
||||
(let ((nname name)
|
||||
(i 0))
|
||||
(i 0))
|
||||
(while (fboundp (intern nname))
|
||||
(setq nname (format "%s-%d" name (setq i (1+ i)))))
|
||||
(setq nname (format "%s-%d" name (setq i (1+ i)))))
|
||||
(setq name (intern nname)))
|
||||
(eval
|
||||
(let ((bindings '((org-heading-regexp
|
||||
|
|
@ -8821,31 +8832,45 @@ should be checked in for a command to execute outside of tables."
|
|||
(concat "^" org-outline-regexp))
|
||||
(outline-regexp org-outline-regexp)
|
||||
(outline-heading-end-regexp "\n")
|
||||
(outline-level 'outline-level)
|
||||
(outline-level 'org-outline-level)
|
||||
(outline-heading-alist))))
|
||||
`(defun ,name (arg)
|
||||
,(concat "In Structure, run `" (symbol-name fun) "'.\n"
|
||||
"Outside of structure, run the binding of `"
|
||||
(key-description key) "'.")
|
||||
(key-description key) "'."
|
||||
(when disable-when-heading-prefix
|
||||
(concat
|
||||
"\nIf `orgstruct-heading-prefix-regexp' is non-nil, this command will always fall\n"
|
||||
"back to the default binding due to limitations of Org's implementation of\n"
|
||||
"`" (symbol-name fun) "'.")))
|
||||
(interactive "p")
|
||||
(unless
|
||||
(let* ,bindings
|
||||
(when (org-context-p 'headline 'item
|
||||
,(when (memq fun '(org-insert-heading))
|
||||
'(when orgstruct-is-++
|
||||
'item-body)))
|
||||
(org-run-like-in-org-mode
|
||||
(lambda ()
|
||||
(interactive)
|
||||
(let* ,bindings
|
||||
(call-interactively ',fun))))
|
||||
t))
|
||||
(let* ((orgstruct-mode)
|
||||
(binding (key-binding ,key)))
|
||||
(if (keymapp binding)
|
||||
(set-temporary-overlay-map binding)
|
||||
(call-interactively
|
||||
(or binding 'orgstruct-error))))))))
|
||||
(let* ((disable
|
||||
,(when disable-when-heading-prefix
|
||||
'(and orgstruct-heading-prefix-regexp
|
||||
(not (string= orgstruct-heading-prefix-regexp "")))))
|
||||
(fallback
|
||||
(or disable
|
||||
(not
|
||||
(let* ,bindings
|
||||
(org-context-p 'headline 'item
|
||||
,(when (memq fun '(org-insert-heading))
|
||||
'(when orgstruct-is-++
|
||||
'item-body))))))))
|
||||
(if fallback
|
||||
(let* ((orgstruct-mode)
|
||||
(binding (key-binding ,key)))
|
||||
(if (keymapp binding)
|
||||
(set-temporary-overlay-map binding)
|
||||
(let ((func (or binding
|
||||
(unless disable
|
||||
'orgstruct-error))))
|
||||
(when func
|
||||
(call-interactively func)))))
|
||||
(org-run-like-in-org-mode
|
||||
(lambda ()
|
||||
(interactive)
|
||||
(let* ,bindings
|
||||
(call-interactively ',fun)))))))))
|
||||
name))
|
||||
|
||||
(defun org-contextualize-keys (alist contexts)
|
||||
|
|
|
|||
Loading…
Reference in a new issue