3

How could one write a function to move an org subtree to the top or bottom of its parent?

I thought of repeating org-move-subtree-up/down until it reaches an extreme, but unfortunately it doesn't return any indication of whether it succeeded in moving anything.

3

I think this does what you want. The function you mentioned raises a user error, which will stop itself. That specific error condition is caught selectively with condition-case.

(defun JK-org-move-to-extreme (up)
  "Move current org subtree to the end of its parent.
With prefix arg move subtree to the start of its parent."
  (interactive "P")
  (condition-case err
      (while t
        (funcall (if up
                     'org-move-subtree-up
                   'org-move-subtree-down)))
    (user-error
     (let ((err-msg (cadr err)))
       (unless (string-match "Cannot move past superior level or buffer limit" err-msg)
         (signal 'user-error (list err-msg)))))))

Tested with:

  • emacs 25.1.50.2
  • org-mode 9.1.6
3
  • You should use condition-case to avoid the anticipated error condition on user level.
    – Tobias
    Jul 18 '18 at 5:35
  • 1
    I tried that, but I was unable to suppress the error. It works fine without it. I would be happy to see how to use condition-case, in case you know how. Jul 18 '18 at 20:09
  • I've added the condition-case' stuff. It works for me. Test conditions are added to the answer. Could you try in your environment? One could also just test against error` instead of user-error and replace the (unless ... (signal...)) stuff with nil. That would make the condition-case wrapper robust w.r.t. changes of the error message in the org source code.
    – Tobias
    Jul 19 '18 at 12:27
1

John Kitchin's solution is certainly the method of choice.

Nevertheless I want to present here an alternative solution exploiting org-element.

Usage: Evaluate the elisp source code below. For an instance the code could be part of the Emacs init file. Put point on the subheading to be moved. Call M-x org+-element-move-subtree. Input the target insertion position of the subheading. Position 0 stands for the first subheading and position -1 stands for the last subheading position.

All defined functions except org+-element-move-subtree are quite general and can be used in other context as well.

(defun org+-element-at (tree &optional elements pos)
  "Given an org element TREE return a list of ELEMENTS containing POS.
ELEMENTS defaults to org-element-all-elements and POS
defaults to `point'."
  (unless elements (setq elements org-element-all-elements))
  (unless pos (setq pos (point)))
  (org-element-map tree elements
    (lambda (el)
      (when (and (<= (org-element-property :begin el) pos)
         (< pos (org-element-property :end el)))
    el))))

(require 'subr-x)

(defun org+-element-smallest (list)
  "Determine the smallest element in LIST."
  (let ((ret (car list)))
    (setq list (cdr list))
    (while list
      (when
      (> (org-element-property :begin (car list))
         (org-element-property :begin ret))
    (cl-assert
     (< (org-element-property :end (car list))
        (org-element-property :end ret))
     nil
     "Elements not ordered w.r.t enclosure")
    (setq ret (car list)))
      (setq list (cdr list)))
    ret))

(defun lispTZA-insert (list el pos)
  "Insert into LIST element EL at position POS.
LIST is modified by side effects.
Returns the modified list.
If POS is negative it counts from the end of LIST.
POS equal to -1 corresponds to appending EL to LIST."
  (let ((n (length list)))
    (when (< pos 0)
      (setq pos (max (+ n 1 pos) 0)))
    (if (eq pos 0)
    (cons el list)
      (let ((link (nthcdr (1- (min pos n)) list)))
    (setcdr link (cons el (cdr link)))
    list))))
;; Tests:
;; (lispTZA-insert '(0 1 2 3 4) 21 2)
;; (lispTZA-insert '(0 1 2 3 4) 5 -1)
;; (lispTZA-insert '(0 1 2 3 4) 6 6)
;; (lispTZA-insert nil 1 0)
;; (lispTZA-insert nil 1 -1)

(defun lispTZA-move (list pred pos)
  "Move first element in LIST satisfying PRED to position POS.
LIST can be modified by side effect.
Note that POS is the insertion position after removal of
the first match for PRED.
Returns the unmodified list if there is no match for PRED
and the modified list otherwise."
  (let (el found)
    (if (funcall pred (car list))
    (setq el (car list)
          list (cdr list)
          found t)
      (let ((tail list))
    (while tail
      (if (funcall pred (cadr tail))
          (progn
        (setq el (cadr tail))
        (setcdr tail (cddr tail))
        (setq tail nil
              found t))
        (setq tail (cdr tail))))))
    (if found
    (lispTZA-insert list el pos)
      list)))
;; Tests:
;; (lispTZA-move '(0 1 2 3 4) (lambda (el) (eq el 2)) -1)
;; (lispTZA-move '(0 1 2 3 4) (lambda (el) (eq el 1)) -1)
;; (lispTZA-move '(0 1 2 3 4) (lambda (el) (eq el 1)) -2)
;; (lispTZA-move '(0 1 2 3 4) (lambda (el) (eq el 1)) 2)
;; (lispTZA-move '(0 1 2 3 4) (lambda (el) (eq el 1)) 0)

(defun org+-element-move-subtree (targetpos)
  "Move current subtree to TARGETPOS in parent.
TARGETPOS is the insertion position in the parent after removal of the current subtree.
If the parent has n elements it has n insertion positions after removing the current subtree."
  (interactive "nWhere to move the subtree (negative numbers count from the back):")
  (when-let ((pt (point))
         (tree (org-element-parse-buffer))
         (subtree (org+-element-smallest (org+-element-at tree 'headline)))
         (parent (org-element-property :parent subtree))
         (contents (org-element-contents parent)))
    (let (non-headers headers)
      (while contents
    (if (eq (org-element-type (car contents)) 'headline)
        (setq headers contents
          contents nil)
      (setq non-headers (cons (car contents) non-headers)
        contents (cdr contents))))
      (setq headers (lispTZA-move
             headers
             (lambda (header) (eq header subtree))
             targetpos))
      (apply #'org-element-set-contents parent (append (nreverse non-headers) headers)))
    (delete-region (point-min) (point-max))
    (insert (org-element-interpret-data tree))
    (goto-char pt)))

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.