--- a/lisp/org.el +++ b/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 @@ -8743,72 +8743,80 @@ buffer. It will also recognize item context in multiline items." (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") - ("" . "RET") - ("" . "ESC") - ("" . "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") + ("" . "RET") + ("" . "ESC") + ("" . "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 @@ -8826,14 +8834,22 @@ should be checked in for a command to execute outside of tables." `(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))) + (when (and ,@(when disable-when-heading-prefix + '((or (not orgstruct-heading-prefix-regexp) + (string= orgstruct-heading-prefix-regexp "")))) + (org-context-p 'headline 'item + ,(when (memq fun '(org-insert-heading)) + '(when orgstruct-is-++ + 'item-body)))) (org-run-like-in-org-mode (lambda () (interactive)