From: Mark Edgington <edgimar@gmail.com>
To: Ken Mankoff <mankoff@gmail.com>
Cc: emacs-orgmode <emacs-orgmode@gnu.org>
Subject: Re: Smart archiving of subtrees with parent headlines
Date: Mon, 12 Feb 2018 16:06:00 -0500 [thread overview]
Message-ID: <20180212210600.GB6756@waldo4> (raw)
In-Reply-To: <m2vaf2k8a4.fsf@gmail.com>
On Mon, Feb 12, 2018 at 1:54 AM, Ken Mankoff <mankoff@gmail.com> wrote:
>
> Does the attached file here work for you? I use it and it seems to do what you describe.
>
> https://lists.gnu.org/archive/html/emacs-orgmode/2014-08/msg00109.html
>
Ken, I tried the code you included from your config file, and while it does
satisfy my requirement 2 (the subtree will be merged into an existing path
under the target if an appropriate path already exists), the first requirement
of it being moved to be "beneath" a specified target location seems not to be
working correctly.
I've modified your code so that it can at least handle archiving subtrees
beneath a specified target headline. The new code assumes that the specified
target headline is at level 1 (has a single asterisk), but it would be nice if
this could be made to work with a target headline having a larger depth. Note
that I changed the behavior from what you had so that hierarchical archiving is
used whether or not the target is in the current buffer.
Although archiving is a bit less painful for me now with this new code, there
are still a few things it would be nice to have:
- arbitrary-depth target-headline
- option to prefix target-headline with source filename (this probably won't take too much work)
- option to add archival properties to each archived item (e.g. date archived)
Here's a diff from the code you posted:
--- old 2018-02-12 10:14:07.646226775 -0500
+++ new 2018-02-12 14:51:20.676703024 -0500
@@ -1,18 +1,11 @@
-(setq org-archive-location (concat org-directory "/archive/%s_archive::"))
+; (setq org-archive-location (concat org-directory "/archive/%s_archive::"))
+(setq org-archive-location "archive/archived_%s::")
+; unmap org-archive-subtree
(define-key org-mode-map (kbd "C-c C-x C-s") nil)
-(setq org-archive-default-command 'kdm/org-archive-local-or-hierarchical) ;; C-c C-x C-a
-;; only do hierarchical archiving if default var used. If archiving into
-;; local file, then just use default org-archive-subtree command
-(defun kdm/org-archive-local-or-hierarchical ()
- "Archive locally if location set to local file; Otherwise use org-archive-subtree-hierarchical"
- (interactive)
- (if (let ((arch-file (org-extract-archive-file))
- (this-file (buffer-file-name)))
- (equal arch-file this-file))
- (org-archive-subtree)
- (org-archive-subtree-hierarchical)))
+; select command to execute via org-archive-subtree-default (C-c C-x C-a)
+(setq org-archive-default-command 'org-archive-subtree-hierarchical)
(require 'org-archive)
@@ -23,16 +16,17 @@
(buffer-substring-no-properties
(line-beginning-position) (line-end-position))))
-(defun org-child-list ()
+(defun org-child-list (&optional top-level)
"This function returns all children of a heading as a list. "
(interactive)
(save-excursion
;; this only works with org-version > 8.0, since in previous
;; org-mode versions the function (org-outline-level) returns
;; gargabe when the point is not on a heading.
- (if (= (org-outline-level) 0)
- (outline-next-visible-heading 1)
- (org-goto-first-child))
+ (unless top-level
+ (if (= (org-outline-level) 0)
+ (outline-next-visible-heading 1)
+ (org-goto-first-child)))
(let ((child-list (list (line-content-as-string))))
(while (org-goto-sibling)
(setq child-list (cons (line-content-as-string) child-list)))
@@ -68,6 +62,11 @@
infile-p (equal file (abbreviate-file-name (or afile ""))))
(unless afile
(error "Invalid `org-archive-location'"))
+ (if (not (equal heading ""))
+ (progn
+ (setq org-tree (cons heading
+ (mapcar (lambda (s) (concat "*" s)) org-tree)))
+ (org-demote-subtree)))
(if (> (length afile) 0)
(setq newfile-p (not (file-exists-p afile))
visiting (find-buffer-visiting afile)
@@ -79,16 +78,18 @@
(set-buffer buffer)
(org-mode)
(goto-char (point-min))
+ (setq top-level-p t)
(while (not (equal org-tree nil))
- (let ((child-list (org-child-list)))
+ (let ((child-list (org-child-list top-level-p)))
(if (member (car org-tree) child-list)
(progn
- (search-forward (car org-tree) nil t)
+ (re-search-forward (concat "^" (regexp-quote (car org-tree))) nil t)
(setq org-tree (cdr org-tree)))
(progn
- (newline)
+ (if (not top-level-p) (newline))
(org-insert-struct org-tree)
- (setq org-tree nil)))))
+ (setq org-tree nil))))
+ (setq top-level-p nil))
(newline)
(org-yank)
;; Save and kill the buffer, if it is not the same buffer.
@@ -103,5 +104,6 @@
(interactive)
(when struct
(insert (car struct))
- (newline)
+ (if (not (equal (length struct) 1))
+ (newline))
(org-insert-struct (cdr struct))))
next prev parent reply other threads:[~2018-02-12 21:06 UTC|newest]
Thread overview: 13+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-02-09 16:42 Smart archiving of subtrees with parent headlines Mark Edgington
2018-02-10 4:27 ` numbchild
2018-02-10 14:04 ` Eric S Fraga
2018-02-12 6:54 ` Ken Mankoff
2018-02-12 21:06 ` Mark Edgington [this message]
2018-02-12 22:44 ` Mark Edgington
2018-04-26 23:34 ` Bastien
2018-05-01 0:35 ` Mark Edgington
2018-05-01 9:01 ` Bastien
2019-03-28 18:13 ` Ken Mankoff
2019-03-29 2:23 ` Mark Edgington
2019-03-29 7:18 ` Ken Mankoff
2019-04-02 7:32 ` Ken Mankoff
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20180212210600.GB6756@waldo4 \
--to=edgimar@gmail.com \
--cc=emacs-orgmode@gnu.org \
--cc=mankoff@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).