0

I have some Org entry user properties which I want to keep in a specific order (not necessarily alphabetical) at the top of the properties drawer: (defconst my-properties-in-order '("A" "B" "C")).

Given an Org entry like:

* Heading
  :PROPERTIES:
  :B:             valB
  :C:             valC
  :X:             valX
  :A:             valA
  :Y:             valY
  :END:

I'm looking for a function which orders the properties according to my-properties-in-order while placing other properties below (preserving their relative rank), so that the transformed entry looks like this:

* Heading
  :PROPERTIES:
  :A:             valA
  :B:             valB
  :C:             valC
  :X:             valX
  :Y:             valY
  :END:

I know I can use (org-entry-properties nil 'standard) to get all an entries standard properties and org-entry-put to write properties, but the sorting and safe deletion of the properties drawer with the old order remains. Also, there might be a better way to achieve what I want.

1 Answer 1

0

This does the job but doesn't preserve the case of property names and removes +'s:

(defconst my-properties-in-order '("A" "B" "C"))

(defun my-org-entry-sort-properties ()
  "Sorts entry properties according to `my-properties-in-order`.
Properties not in that list are but at the end, in their orginal order."
  (interactive)
  (let ((order my-properties-in-order)
        (inprops (org-entry-properties nil 'standard))
        outprops)
    (setq inprops (delq (assoc "CATEGORY" inprops) inprops))
    (setq inprops (nreverse inprops))
    (setq outprops
          (sort inprops
                (lambda (x y)
                  (let* ((posx (cl-position (car x) order :test 'string=))
                         (posy (cl-position (car y) order :test 'string=)))
                    (cond ((and posx posy)
                           (< posx posy))
                          ((and posx (not posy))
                           t)
                          ((and (not posx) posy)
                           nil)
                          (t
                           nil))))))
    (mapc (lambda (x) (org-entry-delete nil (car x))) outprops)
    (mapc (lambda (x) (org-entry-put nil (car x) (cdr x))) outprops)))

Below is a version which retains case and +'s:

(defun my-org-entry-sort-properties ()
  "Sorts entry properties according to `my-properties-in-order`.
Properties not in that list are but at the end, in their orginal order."
  (interactive)
  (let ((order my-properties-in-order)
        (inprops (org-entry-properties-preserve-case))
        outprops)
    (setq inprops (nreverse inprops))
    (setq outprops
          (sort inprops
                (lambda (x y)
                  (let* ((xp (string-match-p "\\+\\'" (car x)))
                         (yp (string-match-p "\\+\\'" (car y)))
                         (xbase (if xp (substring (car x) 0 -1) (car x)))
                         (ybase (if yp (substring (car y) 0 -1) (car y)))
                         (posx (cl-position xbase order :test 'string=))
                         (posy (cl-position ybase order :test 'string=)))
                    (cond ((and posx posy)
                           (< posx posy))
                          ((and posx (not posy))
                           t)
                          ((and (not posx) posy)
                           nil)
                          (t
                           nil))))))
    (mapc (lambda (x) (org-entry-delete nil (car x))) outprops)
    (mapc (lambda (x) (org-entry-put nil (car x) (cdr x))) outprops)))


(defun org-entry-properties-preserve-case ()
  "Get standard properties of current entry.
Extracted from `org-entry-properties' and modified to retain case,
retain + (if suitable but still concat values), and account for empty
property values."
  (org-with-point-at nil
    (org-back-to-heading-or-point-min t)
    (let ((range (org-get-property-block (point)))
          props)
      (when range
        (let ((end (cdr range)) seen-base)
          (goto-char (car range))
          (while (re-search-forward org-property-re end t)
        (let* ((key (match-string-no-properties 2))
               (extendp (string-match-p "\\+\\'" key))
               (key-base (if extendp (substring key 0 -1) key))
               (value (match-string-no-properties 3)))
          (cond
           ((member-ignore-case key-base org-special-properties))
           (extendp
                (let ((old-ext (assoc-string key props t))
                      (old-base (assoc-string key-base props t)))
                  (cond
                   ((and (not old-ext)
                         (not old-base))
                    (setq props (cons (cons key value) props)))
                   (old-ext
                    (setcdr old-ext
                            (concat
                             (cdr old-ext)
                             (unless (string-empty-p (cdr old-ext)) " ")
                             value)))
                   (old-base
                    (setcdr old-base
                            (concat
                             (cdr old-base)
                             (unless (string-empty-p (cdr old-base)) " ")
                             value))))))
           ((member-ignore-case key seen-base))
           (t (push key seen-base)
              (let ((p (assoc-string (concat key "+") props t)))
            (if (not p)                        
                (push (cons key value) props)
                      (setcar p key)
                      (setcdr p
                              (concat
                               value
                               (unless (string-empty-p value) " ")
                               (cdr p)))))))))))
      props)))

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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