Function: org-list-struct-apply-struct
org-list-struct-apply-struct is a byte-compiled function defined in
org-list.el.gz.
Signature
(org-list-struct-apply-struct STRUCT OLD-STRUCT)
Documentation
Apply set difference between STRUCT and OLD-STRUCT to the buffer.
OLD-STRUCT is the structure before any modifications, and STRUCT the structure to be applied. The function will only modify parts of the list which have changed.
Initial position of cursor is restored after the changes.
Source Code
;; Defined in /usr/src/emacs/lisp/org/org-list.el.gz
(defun org-list-struct-apply-struct (struct old-struct)
"Apply set difference between STRUCT and OLD-STRUCT to the buffer.
OLD-STRUCT is the structure before any modifications, and STRUCT
the structure to be applied. The function will only modify parts
of the list which have changed.
Initial position of cursor is restored after the changes."
(let* ((origin (point-marker))
(inlinetask-re (and (featurep 'org-inlinetask)
(org-inlinetask-outline-regexp)))
(item-re (org-item-re))
(shift-body-ind
;; Shift the indentation between END and BEG by DELTA.
;; Start from the line before END.
(lambda (end beg delta)
(goto-char end)
(skip-chars-backward " \r\t\n")
(beginning-of-line)
(while (or (> (point) beg)
(and (= (point) beg)
(not (looking-at item-re))))
(cond
;; Skip inline tasks.
((and inlinetask-re (looking-at inlinetask-re))
(org-inlinetask-goto-beginning))
;; Shift only non-empty lines.
((looking-at-p "^[ \t]*\\S-")
(indent-line-to (+ (org-current-text-indentation) delta))))
(forward-line -1))))
(modify-item
;; Replace ITEM first line elements with new elements from
;; STRUCT, if appropriate.
(lambda (item)
(goto-char item)
(let* ((new-ind (org-list-get-ind item struct))
(old-ind (org-current-text-indentation))
(new-bul (org-list-bullet-string
(org-list-get-bullet item struct)))
(old-bul (org-list-get-bullet item old-struct))
(new-box (org-list-get-checkbox item struct)))
(looking-at org-list-full-item-re)
;; a. Replace bullet
(unless (equal old-bul new-bul)
(let ((keep-space ""))
(save-excursion
;; If origin is inside the bullet, preserve the
;; spaces after origin.
(when (<= (match-beginning 1) origin (match-end 1))
(org-with-point-at origin
(save-match-data
(when (looking-at "[ \t]+")
(setq keep-space (match-string 0))))))
(replace-match "" nil nil nil 1)
(goto-char (match-end 1))
(insert-before-markers new-bul)
(insert keep-space))))
;; Refresh potentially shifted match markers.
(goto-char item)
(looking-at org-list-full-item-re)
;; b. Replace checkbox.
(cond
((equal (match-string 3) new-box))
((and (match-string 3) new-box)
(replace-match new-box nil nil nil 3))
((match-string 3)
(looking-at ".*?\\([ \t]*\\[[ X-]\\]\\)")
(replace-match "" nil nil nil 1))
(t (let ((counterp (match-end 2)))
(goto-char (if counterp (1+ counterp) (match-end 1)))
(insert (concat new-box (unless counterp " "))))))
;; c. Indent item to appropriate column.
(unless (= new-ind old-ind)
(delete-region (goto-char (line-beginning-position))
(progn (skip-chars-forward " \t") (point)))
(indent-to new-ind))))))
;; 1. First get list of items and position endings. We maintain
;; two alists: ITM-SHIFT, determining indentation shift needed
;; at item, and END-LIST, a pseudo-alist where key is ending
;; position and value point.
(let (end-list acc-end itm-shift all-ends sliced-struct)
(dolist (e old-struct)
(let* ((pos (car e))
(ind-pos (org-list-get-ind pos struct))
(ind-old (org-list-get-ind pos old-struct))
(bul-pos (org-list-get-bullet pos struct))
(bul-old (org-list-get-bullet pos old-struct))
(ind-shift (- (+ ind-pos (length bul-pos))
(+ ind-old (length bul-old))))
(end-pos (org-list-get-item-end pos old-struct)))
(push (cons pos ind-shift) itm-shift)
(unless (assq end-pos old-struct)
;; To determine real ind of an ending position that
;; is not at an item, we have to find the item it
;; belongs to: it is the last item (ITEM-UP), whose
;; ending is further than the position we're
;; interested in.
(let ((item-up (assoc-default end-pos acc-end #'>)))
(push (cons end-pos item-up) end-list)))
(push (cons end-pos pos) acc-end)))
;; 2. Slice the items into parts that should be shifted by the
;; same amount of indentation. Each slice follow the pattern
;; (END BEG DELTA). Slices are returned in reverse order.
(setq all-ends (sort (append (mapcar #'car itm-shift)
(org-uniquify (mapcar #'car end-list)))
#'<)
acc-end (nreverse acc-end))
(while (cdr all-ends)
(let* ((up (pop all-ends))
(down (car all-ends))
(itemp (assq up struct))
(delta
(if itemp (cdr (assq up itm-shift))
;; If we're not at an item, there's a child of the
;; item point belongs to above. Make sure the less
;; indented line in this slice has the same column
;; as that child.
(let* ((child (cdr (assq up acc-end)))
(ind (org-list-get-ind child struct))
(min-ind most-positive-fixnum))
(save-excursion
(goto-char up)
(while (< (point) down)
;; Ignore empty lines. Also ignore blocks and
;; drawers contents.
(unless (looking-at-p "[ \t]*$")
(setq min-ind (min (org-current-text-indentation) min-ind))
(cond
((and (looking-at "#\\+BEGIN\\(:\\|_\\S-+\\)")
(re-search-forward
(format "^[ \t]*#\\+END%s[ \t]*$"
(match-string 1))
down t)))
((and (looking-at org-drawer-regexp)
(re-search-forward "^[ \t]*:END:[ \t]*$"
down t)))))
(forward-line)))
(- ind min-ind)))))
(push (list down up delta) sliced-struct)))
;; 3. Shift each slice in buffer, provided delta isn't 0, from
;; end to beginning. Take a special action when beginning is
;; at item bullet.
(dolist (e sliced-struct)
(unless (zerop (nth 2 e)) (apply shift-body-ind e))
(let* ((beg (nth 1 e))
(cell (assq beg struct)))
(unless (or (not cell) (equal cell (assq beg old-struct)))
(funcall modify-item beg)))))
;; 4. Go back to initial position and clean marker.
(goto-char origin)
(move-marker origin nil)))