Mercurial > emacs
comparison lisp/org/org-archive.el @ 94414:d86cb59eea9f
2008-04-27 Carsten Dominik <dominik@science.uva.nl>
* org/org.el (org-html-level-start): Always have id's in HTML
(org-export-as-html): Use `org-link-protocols' to
retrieve the export form of the link.
(org-add-link-type): Final parameter renamed from PUBLISH. Better
documentation of how it is to be used. Avoid double entries for
the same link type.
(org-add-link-props): New function.
(org-modules-loaded): New variable.
(org-load-modules-maybe, org-set-modules): New function.
(org-modules): New option.
(org-mode, org-cycle, orgstruct-mode, org-run-like-in-org-mode)
(orgtbl-mode, org-store-link, org-insert-link-global)
(org-open-at-point): Call `org-load-modules-maybe'.
(org-search-view): Add more text properties.
(org-agenda-schedule, org-agenda-deadline): Allow also in
search-type agendas.
(org-search-view): Order of arguments has been changed.
Interpret prefix-arg as TODO-ONLY.
(org-agenda, org-run-agenda-series, org-agenda-manipulate-query):
Take new argument order of `org-search-view' into account.
(org-todo-only): New variable.
(org-search-syntax-table): New variable and function.
(org-search-view): Do the search with the special syntax table.
(define-obsolete-function-alias): Make work with XEmacs.
(org-add-planning-info): Use old date as default when modifying an
existing deadline or scheduled item.
(org-agenda-compute-time-span): Make argument N optional.
(org-agenda-format-date-aligned): Require `cal-iso'.
(org-agenda-list): Include week into into agenda heading, don't
list it at each date (only on Mondays).
(org-read-date-analyze): Define local variable `iso-date'.
(org-agenda-format-date-aligned): Remove dependency on
`calendar-time-from-absolute'.
(org-remember-apply-template, org-go-to-remember-target):
Interpret filenames relative to `org-directory'.
(org-complete): Silently fail when trying to complete
keywords that don't have a default value.
(org-get-current-options): Added a #+DATE: option.
(org-additional-option-like-keywords): Removed "DATE:" from the
list of additional keywords.
(org-export-as-html): Removed (current-time) as unnecessary second
argument of `format-time-string'.
(org-clock-find-position): Handle special case at end of
buffer.
(org-agenda-day-view): New argument DAY-OF-YEAR, pass it on to
`org-agenda-change-time-span'.
(org-agenda-week-view): New argument ISO-WEEK, pass it on to
`org-agenda-change-time-span'.
(org-agenda-month-view): New argument MONTH, pass it on to
`org-agenda-change-time-span'.
(org-agenda-year-view): New argument YEAR, pass it on to
`org-agenda-change-time-span'.
(org-agenda-change-time-span): New optional argument N, pass it on
to `org-agenda-compute-time-span'.
(org-agenda-compute-time-span): New argument N, interpret it by
changing the starting day.
(org-small-year-to-year): New function.
(org-scheduled-past-days): Respect
`org-scheduled-past-days'.
(org-auto-repeat-maybe): Make sure that repeating
dates are pushed into the future, and that the shift is at least
one interval, never 0.
(org-update-checkbox-count): Fix bug with checkbox
counting.
(org-add-note): New command.
(org-add-log-setup): Renamed from `org-add-log-maybe'.
(org-log-note-headings): New entry for plain notes (i.e. notes not
related to state changes or clocking).
(org-get-org-file): Check for availability of
`remember-data-file'.
(org-cached-entry-get): Allow a regexp value for
`org-use-property-inheritance'.
(org-use-property-inheritance): Allow regexp value. Fix bug in
customization type.
(org-use-tag-inheritance): Allow a list and a regexp value for
this variable.
(org-scan-tags, org-get-tags-at): Implement selective tag
inheritance.
(org-entry-get): Respect value `selective' for the INHERIT
argument.
(org-tag-inherit-p, org-property-inherit-p): New functions.
(org-agenda-format-date-aligned): Allow 10 characters for
weekday, to acomodate German locale.
(org-add-archive-files): New function.
(org-agenda-files): New argument `ext', to
get archive files as well.
(org-tbl-menu): Protect the use of variables that
are only available when org-table.el gets loaded.
(org-read-agenda-file-list): Error if `org-agenda-files' is a
single directory.
(org-open-file): Allow a batch process to trigger
waiting after executing a system command.
(org-store-link): Link to headline when there is not
target and no region in an org-mode buffer when creating a link.
(org-link-types-re): New variable.
(org-make-link-regexps): Compute `org-link-types-re'.
(org-make-link-description-function): New option.
(org-agenda-date, org-agenda-date-weekend): New faces.
(org-archive-sibling-heading): New option.
(org-archive-to-archive-sibling): New function.
(org-iswitchb): New command.
(org-buffer-list): New function.
(org-agenda-columns): Also try the #+COLUMNS line in
the buffer associated with the entry at point (or with the first
entry in the agenda view).
(org-modules): Add entry for org-bibtex.el.
(org-completion-fallback-command): Moved into `org-completion'
group.
(org-clock-heading-function): Moved to `org-progress' group.
(org-auto-repeat-maybe): Make sure that a note can
be enforces if `org-log-repeat' is `note'.
(org-modules): Allow additional symbols for external
packages.
(org-ctrl-c-ctrl-c): Allow for `org-clock-overlays' to be
undefined.
(org-clock-goto): Hide drawers after showing an
entry with `org-clock-goto.'
(org-shiftup, org-shiftdown, org-shiftright, org-shiftleft): Try
also a clocktable block shift.
(org-clocktable-try-shift): New function.
(org-columns-hscoll-title): New function.
(org-columns-previous-hscroll): New variable.
(org-columns-full-header-line-format): New variable.
(org-columns-display-here-title, org-columns-remove-overlays):
Install `org-columns-hscoll-title' in post-command-hook.
* org/org.el: Split into many small files.
* org/org-agenda.el: New file, split off from org.el.
* org/org-archive.el: New file, split off from org.el.
* org/org-bbdb.el: New file.
* org/org-bibtex.el: New file, split off from org.el.
* org/org-clock.el: New file, split off from org.el.
* org/org-colview.el: New file, split off from org.el.
* org/org-compat.el: New file, split off from org.el.
* org/org-exp.el: New file, split off from org.el.
* org/org-faces.el: New file, split off from org.el.
* org/org-gnus.el: New file, split off from org.el.
* org/org-info.el: New file, split off from org.el.
* org/org-infojs.el: New file.
* org/org-irc.el: New file.
* org/org-macs.el: New file, split off from org.el.
* org/org-mew.el: New file.
* org/org-mhe.el: New file, split off from org.el.
* org/org-publish.el: New file, split off from org.el.
* org/org-remember.el: New file, split off from org.el.
* org/org-rmail.el: New file, split off from org.el.
* org/org-table.el: New file, split off from org.el.
* org/org-vm.el: New file, split off from org.el.
* org/org-wl.el: New file, split off from org.el.
2008-04-27 Jason Riedy <jason@acm.org>
* lisp/org-table.el (orgtbl-to-generic): Add a :remove-nil-lines
parameter that supresses lines that evaluate to NIL.
(orgtbl-get-fmt): New inline function for
picking apart formats that may be lists.
(orgtbl-apply-fmt): New inline function for applying formats that
may be functions.
(orgtbl-eval-str): New inline function for strings that may be
functions.
(orgtbl-format-line, orgtbl-to-generic): Use and document.
(orgtbl-to-latex, orgtbl-to-texinfo): Document.
(*orgtbl-llfmt*, *orgtbl-llstart*)
(*orgtbl-llend*): Dynamic variables for last-line formatting.
(orgtbl-format-section): Shift formatting to support detecting the
last line and formatting it specially.
(orgtbl-to-generic): Document :ll* formats. Set to the non-ll
formats unless overridden.
(orgtbl-to-latex): Suggest using :llend to suppress the final \\.
(*orgtbl-table*, *orgtbl-rtn*): Dynamically
bound variables to hold the input collection of lines and output
formatted text.
(*orgtbl-hline*, *orgtbl-sep*, *orgtbl-fmt*, *orgtbl-efmt*,
(*orgtbl-lfmt*, *orgtbl-lstart*, *orgtbl-lend*): Dynamically bound
format parameters.
(orgtbl-format-line): New function encapsulating formatting for a
single line.
(orgtbl-format-section): Similar for each section. Rebinding the
dynamic vars customizes the formatting for each section.
(orgtbl-to-generic): Use orgtbl-format-line and
orgtbl-format-section.
(org-get-param): Now unused, so delete.
(orgtbl-gather-send-defs): New function to
gather all the SEND definitions before a table.
(orgtbl-send-replace-tbl): New function to find the RECEIVE
corresponding to the current name.
(orgtbl-send-table): Use the previous two functions and implement
multiple destinations for each table.
* doc/org.texi (A LaTeX example): Note that fmt may be a
one-argument function, and efmt may be a two-argument function.
(Radio tables): Document multiple destinations.
2008-04-27 Carsten Dominik <dominik@science.uva.nl>
* org/org-agenda.el (org-add-to-diary-list): New function.
(org-prefix-has-effort): New variable.
(org-sort-agenda-noeffort-is-high): New option.
(org-agenda-columns-show-summaries)
(org-agenda-columns-compute-summary-properties): New options.
(org-format-agenda-item): Compute the duration of the item.
(org-agenda-weekend-days): New variable.
(org-agenda-list, org-timeline): Use the proper faces for dates in
the agenda and timeline buffers.
(org-agenda-archive-to-archive-sibling): New command.
(org-agenda-start-with-clockreport-mode): New option.
(org-agenda-clockreport-parameter-plist): New option.
(org-agenda-clocktable-mode): New variable.
(org-agenda-deadline-leaders): Allow a function value for the
deadline leader.
(org-agenda-get-deadlines): Deal with new function value.
* lisp/org-clock.el (org-clock): New customization group.
(org-clock-into-drawer, org-clock-out-when-done)
(org-clock-in-switch-to-state, org-clock-heading-function): Moved
into the new group.
(org-clock-out-remove-zero-time-clocks): New option.
(org-clock-out): Use `org-clock-out-remove-zero-time-clocks'.
(org-dblock-write:clocktable): Allow a Lisp form for the scope
parameter.
(org-dblock-write:clocktable): Fixed bug with total time
calculation.
(org-dblock-write:clocktable): Request the unrestricted list of
files.
(org-get-clocktable): New function.
(org-dblock-write:clocktable): Make sure :tstart and :tend can not
only be strings but also integers (an absolute day number) and
lists (m d y).
* org/org-colview.el (org-columns-next-allowed-value)
(org-columns-edit-value): Limit the effort for updatig in the
agenda to recomputing a single file.
(org-columns-compute): Only write property value if it has
changed. This avoids raising the buffer-change-flag
unnecessarily.
(org-agenda-colview-summarize)
(org-agenda-colview-compute): New functions.
(org-agenda-columns): Call `org-agenda-colview-summarize'.
* org/org-exp.el (org-export-run-in-background): New option.
(org-export-icalendar): Allow a batch process to trigger waiting
after executing a system command.
(org-export-preprocess-string): Renamed-from
`org-cleaned-string-for-export'.
(org-export-html-style): Made target class look like normal text.
(org-export-as-html): Make use of the better proprocessing in
`org-cleaned-string-for-export'.
(org-cleaned-string-for-export): Better treatment of heuristic
targets, many more internal links will now work in HTML export.
(org-get-current-options): Incorporate LINK_UP, LINK_HOME, and
INFOJS.
(org-export-inbuffer-options-extra): New variable.
(org-export-options-filters): New hook.
(org-infile-export-plist): Find also the settings keywords in
`org-export-inbuffer-options-extra'.
(org-infile-export-plist): Allow multiple #+OPTIONS lines and
multiple #+INFOJS_OPT lines.
(org-export-html-handle-js-options): New function.
(org-export-html-infojs-setup): New option.
(org-export-as-html): Call `org-export-html-handle-js-options'.
Add autoload to all entry points.
(org-skip-comments): Function removed.
* org/org-table.el (org-table-make-reference): Extra parenthesis
around single fields, to make sure that algebraic formulas get
correctly interpreted by calc.
(org-table-current-column): No longer interactive.
* org/org-export-latex.el (org-export-latex-preprocess): Renamed
from `org-export-latex-cleaned-string'.
2008-04-27 Bastien Guerry <bzg@altern.org>
* org/org-publish.el (org-publish-get-base-files-1): New function.
(org-publish-get-base-files): Use it.
(org-publish-temp-files): New variable.
Don't require 'dired-aux anymore.
(org-publish-initial-buffer): New variable.
(org-publish-org-to, org-publish): Use it.
(org-publish-get-base-files-1): Bug fix: get
the proper list of files when recursing thru a directory.
(org-publish-get-base-files): Use the :exclude property to skip
both files and directories.
author | Carsten Dominik <dominik@science.uva.nl> |
---|---|
date | Sun, 27 Apr 2008 18:33:39 +0000 |
parents | |
children | da5141d2e8fc |
comparison
equal
deleted
inserted
replaced
94413:90289baecd6a | 94414:d86cb59eea9f |
---|---|
1 ;;; org-archive.el --- Archiving for Org-mode | |
2 | |
3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Carsten Dominik <carsten at orgmode dot org> | |
6 ;; Keywords: outlines, hypermedia, calendar, wp | |
7 ;; Homepage: http://orgmode.org | |
8 ;; Version: 6.02b | |
9 ;; | |
10 ;; This file is part of GNU Emacs. | |
11 ;; | |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 ;; it under the terms of the GNU General Public License as published by | |
14 ;; the Free Software Foundation; either version 3, or (at your option) | |
15 ;; any later version. | |
16 | |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
25 ;; Boston, MA 02110-1301, USA. | |
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
27 ;; | |
28 ;;; Commentary: | |
29 | |
30 ;; This file contains the face definitons for Org. | |
31 | |
32 ;;; Code: | |
33 | |
34 (require 'org) | |
35 | |
36 (defcustom org-archive-sibling-heading "Archive" | |
37 "Name of the local archive sibling that is used to archive entries locally. | |
38 Locally means: in the tree, under a sibling. | |
39 See `org-archive-to-archive-sibling' for more information." | |
40 :group 'org-archive | |
41 :type 'string) | |
42 | |
43 (defcustom org-archive-mark-done t | |
44 "Non-nil means, mark entries as DONE when they are moved to the archive file. | |
45 This can be a string to set the keyword to use. When t, Org-mode will | |
46 use the first keyword in its list that means done." | |
47 :group 'org-archive | |
48 :type '(choice | |
49 (const :tag "No" nil) | |
50 (const :tag "Yes" t) | |
51 (string :tag "Use this keyword"))) | |
52 | |
53 (defcustom org-archive-stamp-time t | |
54 "Non-nil means, add a time stamp to entries moved to an archive file. | |
55 This variable is obsolete and has no effect anymore, instead add ot remove | |
56 `time' from the variablle `org-archive-save-context-info'." | |
57 :group 'org-archive | |
58 :type 'boolean) | |
59 | |
60 (defcustom org-archive-save-context-info '(time file olpath category todo itags) | |
61 "Parts of context info that should be stored as properties when archiving. | |
62 When a subtree is moved to an archive file, it looses information given by | |
63 context, like inherited tags, the category, and possibly also the TODO | |
64 state (depending on the variable `org-archive-mark-done'). | |
65 This variable can be a list of any of the following symbols: | |
66 | |
67 time The time of archiving. | |
68 file The file where the entry originates. | |
69 itags The local tags, in the headline of the subtree. | |
70 ltags The tags the subtree inherits from further up the hierarchy. | |
71 todo The pre-archive TODO state. | |
72 category The category, taken from file name or #+CATEGORY lines. | |
73 olpath The outline path to the item. These are all headlines above | |
74 the current item, separated by /, like a file path. | |
75 | |
76 For each symbol present in the list, a property will be created in | |
77 the archived entry, with a prefix \"PRE_ARCHIVE_\", to remember this | |
78 information." | |
79 :group 'org-archive | |
80 :type '(set :greedy t | |
81 (const :tag "Time" time) | |
82 (const :tag "File" file) | |
83 (const :tag "Category" category) | |
84 (const :tag "TODO state" todo) | |
85 (const :tag "TODO state" priority) | |
86 (const :tag "Inherited tags" itags) | |
87 (const :tag "Outline path" olpath) | |
88 (const :tag "Local tags" ltags))) | |
89 | |
90 (defun org-get-local-archive-location () | |
91 "Get the archive location applicable at point." | |
92 (let ((re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$") | |
93 prop) | |
94 (save-excursion | |
95 (save-restriction | |
96 (widen) | |
97 (setq prop (org-entry-get nil "ARCHIVE" 'inherit)) | |
98 (cond | |
99 ((and prop (string-match "\\S-" prop)) | |
100 prop) | |
101 ((or (re-search-backward re nil t) | |
102 (re-search-forward re nil t)) | |
103 (match-string 1)) | |
104 (t org-archive-location (match-string 1))))))) | |
105 | |
106 (defun org-add-archive-files (files) | |
107 "Splice the archive files into the list f files. | |
108 This implies visiting all these files and finding out what the | |
109 archive file is." | |
110 (apply | |
111 'append | |
112 (mapcar | |
113 (lambda (f) | |
114 (if (not (file-exists-p f)) | |
115 nil | |
116 (with-current-buffer (org-get-agenda-file-buffer f) | |
117 (cons f (org-all-archive-files))))) | |
118 files))) | |
119 | |
120 (defun org-all-archive-files () | |
121 "Get a list of all archive files used in the current buffer." | |
122 (let (file files) | |
123 (save-excursion | |
124 (save-restriction | |
125 (goto-char (point-min)) | |
126 (while (re-search-forward | |
127 "^\\(#\\+\\|[ \t]*:\\)ARCHIVE:[ \t]+\\(.*\\)" | |
128 nil t) | |
129 (setq file (org-extract-archive-file | |
130 (org-match-string-no-properties 2))) | |
131 (and file (> (length file) 0) (file-exists-p file) | |
132 (add-to-list 'files file))))) | |
133 (setq files (nreverse files)) | |
134 (setq file (org-extract-archive-file)) | |
135 (and file (> (length file) 0) (file-exists-p file) | |
136 (add-to-list 'files file)) | |
137 files)) | |
138 | |
139 (defun org-extract-archive-file (&optional location) | |
140 (setq location (or location org-archive-location)) | |
141 (if (string-match "\\(.*\\)::\\(.*\\)" location) | |
142 (if (= (match-beginning 1) (match-end 1)) | |
143 (buffer-file-name) | |
144 (expand-file-name | |
145 (format (match-string 1 location) buffer-file-name))))) | |
146 | |
147 (defun org-extract-archive-heading (&optional location) | |
148 (setq location (or location org-archive-location)) | |
149 (if (string-match "\\(.*\\)::\\(.*\\)" location) | |
150 (match-string 2 location))) | |
151 | |
152 (defun org-archive-subtree (&optional find-done) | |
153 "Move the current subtree to the archive. | |
154 The archive can be a certain top-level heading in the current file, or in | |
155 a different file. The tree will be moved to that location, the subtree | |
156 heading be marked DONE, and the current time will be added. | |
157 | |
158 When called with prefix argument FIND-DONE, find whole trees without any | |
159 open TODO items and archive them (after getting confirmation from the user). | |
160 If the cursor is not at a headline when this comand is called, try all level | |
161 1 trees. If the cursor is on a headline, only try the direct children of | |
162 this heading." | |
163 (interactive "P") | |
164 (if find-done | |
165 (org-archive-all-done) | |
166 ;; Save all relevant TODO keyword-relatex variables | |
167 | |
168 (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler | |
169 (tr-org-todo-keywords-1 org-todo-keywords-1) | |
170 (tr-org-todo-kwd-alist org-todo-kwd-alist) | |
171 (tr-org-done-keywords org-done-keywords) | |
172 (tr-org-todo-regexp org-todo-regexp) | |
173 (tr-org-todo-line-regexp org-todo-line-regexp) | |
174 (tr-org-odd-levels-only org-odd-levels-only) | |
175 (this-buffer (current-buffer)) | |
176 ;; start of variables that will be used for saving context | |
177 ;; The compiler complains about them - keep them anyway! | |
178 (file (abbreviate-file-name (buffer-file-name))) | |
179 (olpath (mapconcat 'identity (org-get-outline-path) "/")) | |
180 (time (format-time-string | |
181 (substring (cdr org-time-stamp-formats) 1 -1) | |
182 (current-time))) | |
183 category todo priority ltags itags | |
184 ;; end of variables that will be used for saving context | |
185 location afile heading buffer level newfile-p) | |
186 | |
187 ;; Find the local archive location | |
188 (setq location (org-get-local-archive-location) | |
189 afile (org-extract-archive-file location) | |
190 heading (org-extract-archive-heading location)) | |
191 (unless afile | |
192 (error "Invalid `org-archive-location'")) | |
193 | |
194 (if (> (length afile) 0) | |
195 (setq newfile-p (not (file-exists-p afile)) | |
196 buffer (find-file-noselect afile)) | |
197 (setq buffer (current-buffer))) | |
198 (unless buffer | |
199 (error "Cannot access file \"%s\"" afile)) | |
200 (if (and (> (length heading) 0) | |
201 (string-match "^\\*+" heading)) | |
202 (setq level (match-end 0)) | |
203 (setq heading nil level 0)) | |
204 (save-excursion | |
205 (org-back-to-heading t) | |
206 ;; Get context information that will be lost by moving the tree | |
207 (org-refresh-category-properties) | |
208 (setq category (org-get-category) | |
209 todo (and (looking-at org-todo-line-regexp) | |
210 (match-string 2)) | |
211 priority (org-get-priority | |
212 (if (match-end 3) (match-string 3) "")) | |
213 ltags (org-get-tags) | |
214 itags (org-delete-all ltags (org-get-tags-at))) | |
215 (setq ltags (mapconcat 'identity ltags " ") | |
216 itags (mapconcat 'identity itags " ")) | |
217 ;; We first only copy, in case something goes wrong | |
218 ;; we need to protect this-command, to avoid kill-region sets it, | |
219 ;; which would lead to duplication of subtrees | |
220 (let (this-command) (org-copy-subtree)) | |
221 (set-buffer buffer) | |
222 ;; Enforce org-mode for the archive buffer | |
223 (if (not (org-mode-p)) | |
224 ;; Force the mode for future visits. | |
225 (let ((org-insert-mode-line-in-empty-file t) | |
226 (org-inhibit-startup t)) | |
227 (call-interactively 'org-mode))) | |
228 (when newfile-p | |
229 (goto-char (point-max)) | |
230 (insert (format "\nArchived entries from file %s\n\n" | |
231 (buffer-file-name this-buffer)))) | |
232 ;; Force the TODO keywords of the original buffer | |
233 (let ((org-todo-line-regexp tr-org-todo-line-regexp) | |
234 (org-todo-keywords-1 tr-org-todo-keywords-1) | |
235 (org-todo-kwd-alist tr-org-todo-kwd-alist) | |
236 (org-done-keywords tr-org-done-keywords) | |
237 (org-todo-regexp tr-org-todo-regexp) | |
238 (org-todo-line-regexp tr-org-todo-line-regexp) | |
239 (org-odd-levels-only | |
240 (if (local-variable-p 'org-odd-levels-only (current-buffer)) | |
241 org-odd-levels-only | |
242 tr-org-odd-levels-only))) | |
243 (goto-char (point-min)) | |
244 (show-all) | |
245 (if heading | |
246 (progn | |
247 (if (re-search-forward | |
248 (concat "^" (regexp-quote heading) | |
249 (org-re "[ \t]*\\(:[[:alnum:]_@:]+:\\)?[ \t]*\\($\\|\r\\)")) | |
250 nil t) | |
251 (goto-char (match-end 0)) | |
252 ;; Heading not found, just insert it at the end | |
253 (goto-char (point-max)) | |
254 (or (bolp) (insert "\n")) | |
255 (insert "\n" heading "\n") | |
256 (end-of-line 0)) | |
257 ;; Make the subtree visible | |
258 (show-subtree) | |
259 (org-end-of-subtree t) | |
260 (skip-chars-backward " \t\r\n") | |
261 (and (looking-at "[ \t\r\n]*") | |
262 (replace-match "\n\n"))) | |
263 ;; No specific heading, just go to end of file. | |
264 (goto-char (point-max)) (insert "\n")) | |
265 ;; Paste | |
266 (org-paste-subtree (org-get-valid-level level 1)) | |
267 | |
268 ;; Mark the entry as done | |
269 (when (and org-archive-mark-done | |
270 (looking-at org-todo-line-regexp) | |
271 (or (not (match-end 2)) | |
272 (not (member (match-string 2) org-done-keywords)))) | |
273 (let (org-log-done org-todo-log-states) | |
274 (org-todo | |
275 (car (or (member org-archive-mark-done org-done-keywords) | |
276 org-done-keywords))))) | |
277 | |
278 ;; Add the context info | |
279 (when org-archive-save-context-info | |
280 (let ((l org-archive-save-context-info) e n v) | |
281 (while (setq e (pop l)) | |
282 (when (and (setq v (symbol-value e)) | |
283 (stringp v) (string-match "\\S-" v)) | |
284 (setq n (concat "ARCHIVE_" (upcase (symbol-name e)))) | |
285 (org-entry-put (point) n v))))) | |
286 | |
287 ;; Save and kill the buffer, if it is not the same buffer. | |
288 (if (not (eq this-buffer buffer)) | |
289 (progn (save-buffer) (kill-buffer buffer))))) | |
290 ;; Here we are back in the original buffer. Everything seems to have | |
291 ;; worked. So now cut the tree and finish up. | |
292 (let (this-command) (org-cut-subtree)) | |
293 (if (and (not (eobp)) (looking-at "[ \t]*$")) (kill-line)) | |
294 (message "Subtree archived %s" | |
295 (if (eq this-buffer buffer) | |
296 (concat "under heading: " heading) | |
297 (concat "in file: " (abbreviate-file-name afile))))))) | |
298 | |
299 (defun org-archive-to-archive-sibling () | |
300 "Archive the current heading by moving it under the archive sibling. | |
301 The archive sibling is a sibling of the heading with the heading name | |
302 `org-archive-sibling-heading' and an `org-archive-tag' tag. If this | |
303 sibling does not exist, it will be created at the end of the subtree." | |
304 (interactive) | |
305 (save-restriction | |
306 (widen) | |
307 (let (b e pos leader level) | |
308 (org-back-to-heading t) | |
309 (looking-at outline-regexp) | |
310 (setq leader (match-string 0) | |
311 level (funcall outline-level)) | |
312 (setq pos (point)) | |
313 (condition-case nil | |
314 (outline-up-heading 1 t) | |
315 (error (goto-char (point-min)))) | |
316 (setq b (point)) | |
317 (condition-case nil | |
318 (org-end-of-subtree t t) | |
319 (error (goto-char (point-max)))) | |
320 (setq e (point)) | |
321 (goto-char b) | |
322 (unless (re-search-forward | |
323 (concat "^" (regexp-quote leader) | |
324 "[ \t]*" | |
325 org-archive-sibling-heading | |
326 "[ \t]*:" | |
327 org-archive-tag ":") e t) | |
328 (goto-char e) | |
329 (or (bolp) (newline)) | |
330 (insert leader org-archive-sibling-heading "\n") | |
331 (beginning-of-line 0) | |
332 (org-toggle-tag org-archive-tag 'on)) | |
333 (beginning-of-line 1) | |
334 (org-end-of-subtree t t) | |
335 (save-excursion | |
336 (goto-char pos) | |
337 (org-cut-subtree)) | |
338 (org-paste-subtree (org-get-valid-level level 1)) | |
339 (org-set-property | |
340 "ARCHIVE_TIME" | |
341 (format-time-string | |
342 (substring (cdr org-time-stamp-formats) 1 -1) | |
343 (current-time))) | |
344 (outline-up-heading 1 t) | |
345 (hide-subtree) | |
346 (goto-char pos)))) | |
347 | |
348 (defun org-archive-all-done (&optional tag) | |
349 "Archive sublevels of the current tree without open TODO items. | |
350 If the cursor is not on a headline, try all level 1 trees. If | |
351 it is on a headline, try all direct children. | |
352 When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." | |
353 (let ((re (concat "^\\*+ +" org-not-done-regexp)) re1 | |
354 (rea (concat ".*:" org-archive-tag ":")) | |
355 (begm (make-marker)) | |
356 (endm (make-marker)) | |
357 (question (if tag "Set ARCHIVE tag (no open TODO items)? " | |
358 "Move subtree to archive (no open TODO items)? ")) | |
359 beg end (cntarch 0)) | |
360 (if (org-on-heading-p) | |
361 (progn | |
362 (setq re1 (concat "^" (regexp-quote | |
363 (make-string | |
364 (1+ (- (match-end 0) (match-beginning 0) 1)) | |
365 ?*)) | |
366 " ")) | |
367 (move-marker begm (point)) | |
368 (move-marker endm (org-end-of-subtree t))) | |
369 (setq re1 "^* ") | |
370 (move-marker begm (point-min)) | |
371 (move-marker endm (point-max))) | |
372 (save-excursion | |
373 (goto-char begm) | |
374 (while (re-search-forward re1 endm t) | |
375 (setq beg (match-beginning 0) | |
376 end (save-excursion (org-end-of-subtree t) (point))) | |
377 (goto-char beg) | |
378 (if (re-search-forward re end t) | |
379 (goto-char end) | |
380 (goto-char beg) | |
381 (if (and (or (not tag) (not (looking-at rea))) | |
382 (y-or-n-p question)) | |
383 (progn | |
384 (if tag | |
385 (org-toggle-tag org-archive-tag 'on) | |
386 (org-archive-subtree)) | |
387 (setq cntarch (1+ cntarch))) | |
388 (goto-char end))))) | |
389 (message "%d trees archived" cntarch))) | |
390 | |
391 (defun org-toggle-archive-tag (&optional find-done) | |
392 "Toggle the archive tag for the current headline. | |
393 With prefix ARG, check all children of current headline and offer tagging | |
394 the children that do not contain any open TODO items." | |
395 (interactive "P") | |
396 (if find-done | |
397 (org-archive-all-done 'tag) | |
398 (let (set) | |
399 (save-excursion | |
400 (org-back-to-heading t) | |
401 (setq set (org-toggle-tag org-archive-tag)) | |
402 (when set (hide-subtree))) | |
403 (and set (beginning-of-line 1)) | |
404 (message "Subtree %s" (if set "archived" "unarchived"))))) | |
405 | |
406 (provide 'org-archive) | |
407 | |
408 ;;; org-archive.el ends here |