Re: [O] S-M-right problem in orgstruct-mode

[Christopher Schmidt]

Bastien <address@hidden> writes:
> Christopher Schmidt <address@hidden> writes:
>> ( In the long term this should be fixed properly.  Considering that
>>   point is already on an actual headline, Org just needs to add or
>>   remove a star.  This should not be too hard with
>>   org-heading-regexp. )
>
> Beware that there are *many* commands conditionally called by
> org-metaright, org-metaleft, etc.: org-do-demote, org-do-promote and
> the like.
>
> It would be too much to make all these commands take the value of
> `orgstruct-heading-prefix-regexp' into account, even if we end up
> using a macro `org-with-heading-prefix-regexp' and calling these
> commands from within the macro.  Perhaps accepting some limitations
> will be the right thing, not sure.

That is not necessary.  The hijacking command already makes sure
org-heading-regexp takes orgstruct-heading-prefix-regexp into account.
Nonetheless It is still a lot of work.

Alan, here is patch for master that should solve the issue.  It disables
org-{pr,de}mote and org-{,shift}meta{left,right} in orgstruct-mode iff
orgstruct-heading-prefix-regexp is non-nil.  Could you please give it a
try and tell us what you think?

diff --cc lisp/org.el
index 811506a,a7670dc..0000000
--- a/lisp/org.el
+++ b/lisp/org.el
@@@ -8743,72 -8695,78 +8743,80 @@@ buffer.  It will also recognize item co
  
  (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
@@@ -8830,10 -8793,13 +8843,13 @@@
          (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 
""))
++                                   (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)

Thank you very much.

        Christopher