Function: org-archive-to-archive-sibling

org-archive-to-archive-sibling is an autoloaded, interactive and byte-compiled function defined in org-archive.el.gz.

Signature

(org-archive-to-archive-sibling)

Documentation

Archive the current heading by moving it under the archive sibling.

The archive sibling is a sibling of the heading with the heading name org-archive-sibling-heading and an org-archive-tag tag. If this sibling does not exist, it will be created at the end of the subtree.

Archiving time is retained in the ARCHIVE_TIME node property.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/org/org-archive.el.gz
;;;###autoload
(defun org-archive-to-archive-sibling ()
  "Archive the current heading by moving it under the archive sibling.

The archive sibling is a sibling of the heading with the heading name
`org-archive-sibling-heading' and an `org-archive-tag' tag.  If this
sibling does not exist, it will be created at the end of the subtree.

Archiving time is retained in the ARCHIVE_TIME node property."
  (interactive)
  (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
      (let ((cl (when (eq org-loop-over-headlines-in-active-region 'start-level)
		  'region-start-level 'region))
	    org-loop-over-headlines-in-active-region)
	(org-map-entries
	 '(progn (setq org-map-continue-from
		       (progn (org-back-to-heading)
			      (if (looking-at (concat "^.*:" org-archive-tag ":.*$"))
				  (org-end-of-subtree t)
				(point))))
		 (when (org-at-heading-p)
		   (org-archive-to-archive-sibling)))
	 org-loop-over-headlines-in-active-region
	 cl (if (org-invisible-p) (org-end-of-subtree nil t))))
    (save-restriction
      (widen)
      (let (b e pos leader level)
	(org-back-to-heading t)
	(looking-at org-outline-regexp)
	(setq leader (match-string 0)
	      level (funcall outline-level))
	(setq pos (point-marker))
        ;; Advance POS upon insertion in front of it.
        (set-marker-insertion-type pos t)
	(condition-case nil
	    (outline-up-heading 1 t)
	  (error (setq e (point-max)) (goto-char (point-min))))
	(setq b (point))
	(unless e
	  (condition-case nil
	      (org-end-of-subtree t t)
	    (error (goto-char (point-max))))
	  (setq e (point)))
	(goto-char b)
	(unless (re-search-forward
		 (concat "^" (regexp-quote leader)
			 "[ \t]*"
			 org-archive-sibling-heading
			 "[ \t]*:"
			 org-archive-tag ":") e t)
	  (goto-char e)
	  (or (bolp) (newline))
	  (insert leader org-archive-sibling-heading "\n")
	  (beginning-of-line 0)
	  (org-toggle-tag org-archive-tag 'on))
	(beginning-of-line 1)
	(if org-archive-reversed-order
	    (outline-next-heading)
	  (org-end-of-subtree t t))
	(save-excursion
	  (goto-char pos)
	  (let ((this-command this-command)) (org-cut-subtree)))
	(org-paste-subtree (org-get-valid-level level 1))
	(org-set-property
	 "ARCHIVE_TIME"
	 (format-time-string
          (org-time-stamp-format 'with-time 'no-brackets)))
	(outline-up-heading 1 t)
	(org-fold-subtree t)
	(org-cycle-show-empty-lines 'folded)
	(when org-provide-todo-statistics
	  ;; Update TODO statistics of parent.
	  (org-update-parent-todo-statistics))
	(goto-char pos)))
    (org-fold-reveal)
    (if (looking-at "^[ \t]*$")
	(outline-next-visible-heading 1))))