| blob | 5c0899b0913dd56003eabd8ff996f810e0f42698 |
1 ;;; org.el --- Outline-based notes management and organizer
2 ;; Carstens outline-mode for keeping track of everything.
3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
4 ;; Free Software Foundation, Inc.
5 ;;
6 ;; Author: Carsten Dominik <carsten at orgmode dot org>
7 ;; Keywords: outlines, hypermedia, calendar, wp
8 ;; Homepage: http://orgmode.org
9 ;; Version: 6.23trans
10 ;;
11 ;; This file is part of GNU Emacs.
12 ;;
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26 ;;
27 ;;; Commentary:
28 ;;
29 ;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing
30 ;; project planning with a fast and effective plain-text system.
31 ;;
32 ;; Org-mode develops organizational tasks around NOTES files that contain
33 ;; information about projects as plain text. Org-mode is implemented on
34 ;; top of outline-mode, which makes it possible to keep the content of
35 ;; large files well structured. Visibility cycling and structure editing
36 ;; help to work with the tree. Tables are easily created with a built-in
37 ;; table editor. Org-mode supports ToDo items, deadlines, time stamps,
38 ;; and scheduling. It dynamically compiles entries into an agenda that
39 ;; utilizes and smoothly integrates much of the Emacs calendar and diary.
40 ;; Plain text URL-like links connect to websites, emails, Usenet
41 ;; messages, BBDB entries, and any files related to the projects. For
42 ;; printing and sharing of notes, an Org-mode file can be exported as a
43 ;; structured ASCII file, as HTML, or (todo and agenda items only) as an
44 ;; iCalendar file. It can also serve as a publishing tool for a set of
45 ;; linked webpages.
46 ;;
47 ;; Installation and Activation
48 ;; ---------------------------
49 ;; See the corresponding sections in the manual at
50 ;;
51 ;; http://orgmode.org/org.html#Installation
52 ;;
53 ;; Documentation
54 ;; -------------
55 ;; The documentation of Org-mode can be found in the TeXInfo file. The
56 ;; distribution also contains a PDF version of it. At the homepage of
57 ;; Org-mode, you can read the same text online as HTML. There is also an
58 ;; excellent reference card made by Philip Rooke. This card can be found
59 ;; in the etc/ directory of Emacs 22.
60 ;;
61 ;; A list of recent changes can be found at
62 ;; http://orgmode.org/Changes.html
63 ;;
64 ;;; Code:
71 ;;;; Require other packages
77 ;; For XEmacs, noutline is not yet provided by outline.el, so arrange for
78 ;; the file noutline.el being loaded.
80 ;; We require noutline, which might be provided in outline.el
82 ;; Other stuff we need.
93 ;;;; Customization variables
95 ;;; Version
101 "Show the org-mode version in the echo area.
102 With prefix arg HERE, insert it at point."
109 ;;; Compatibility constants
111 ;;; The custom variables
114 "Outline-based notes management and organizer."
121 "Hook that is run after org.el has been loaded."
130 "Load all extensions listed in `org-modules'."
135 org-modules)
139 "Set VAR to VALUE and call `org-load-modules-maybe' with the force flag."
148 (defcustom org-modules '(org-bbdb org-bibtex org-gnus org-info org-jsinfo org-irc org-mew org-mhe org-rmail org-vm org-w3m org-wl)
149 "Modules that should always be loaded together with org.el.
150 If a description starts with <C>, the file is not part of Emacs
151 and loading it will require that you have downloaded and properly installed
152 the org-mode distribution.
154 You can also use this system to load external packages (i.e. neither Org
155 core modules, not modules from the CONTRIB directory). Just add symbols
156 to the end of the list. If the package is called org-xyz.el, then you need
157 to add the symbol `xyz', and the package must have a call to
159 (provide 'org-xyz)"
162 :type
192 (const :tag "C interactive-query: Interactive modification of tags query" org-interactive-query)
206 "Non-nil means, make shift-cursor commands select text when possible.
208 In Emacs 23, when `shift-select-mode' is on, shifted cursor keys start
209 selecting a region, or enlarge thusly regions started in this way.
210 In Org-mode, in special contexts, these same keys are used for other
211 purposes, important enough to compete with shift selection. Org tries
212 to balance these needs by supporting `shift-select-mode' outside these
213 special contexts, under control of this variable.
215 The default of this variable is nil, to avoid confusing behavior. Shifted
216 cursor keys will then execute Org commands in the following contexts:
217 - on a headline, changing TODO state (left/right) and priority (up/down)
218 - on a time stamp, changing the time
219 - in a plain list item, changing the bullet type
220 - in a property definition line, switching between allowed values
221 - in the BEGIN line of a clock table (changing the time block).
222 Outside these contexts, the commands will throw an error.
224 When this variable is t and the cursor is not in a special context,
225 Org-mode will support shift-selection for making and enlarging regions.
226 To make this more effective, the bullet cycling will no longer happen
227 anywhere in an item line, but only if the cursor is exactly on the bullet.
229 If you set this variable to the symbol `always', then the keys
230 will not be special in headlines, property lines, and item lines, to make
231 shift selection work there as well. If this is what you want, you can
232 use the following alternative commands: `C-c C-t' and `C-c ,' to
233 change TODO state and priority, `C-u C-u C-c C-t' can be used to switch
234 TODO sets, `C-c -' to cycle item bullet types, and properties can be
235 edited by hand or in column view.
237 However, when the cursor is on a timestamp, shift-cursor commands
238 will still edit the time stamp - this is just too good to give up.
240 XEmacs user should have this variable set to nil, because shift-select-mode
241 is Emacs 23 only."
249 "Options concerning startup of Org-mode."
254 "Non-nil means, entering Org-mode will switch to OVERVIEW.
255 This can also be configured on a per-file basis by adding one of
256 the following lines anywhere in the buffer:
258 #+STARTUP: fold
259 #+STARTUP: nofold
260 #+STARTUP: content"
268 "Non-nil means, entering Org-mode will set `truncate-lines'.
269 This is useful since some lines containing links can be very long and
270 uninteresting. Also tables look terrible when wrapped."
275 "Non-nil means, align all tables when visiting a file.
276 This is useful when the column width in tables is forced with <N> cookies
277 in table fields. Such tables will look correct only after the first re-align.
278 This can also be configured on a per-file basis by adding one of
279 the following lines anywhere in the buffer:
280 #+STARTUP: align
281 #+STARTUP: noalign"
286 "Non-nil means insert the first line setting Org-mode in empty files.
287 When the function `org-mode' is called interactively in an empty file, this
288 normally means that the file name does not automatically trigger Org-mode.
289 To ensure that the file will always be in Org-mode in the future, a
290 line enforcing Org-mode will be inserted into the buffer, if this option
291 has been set."
296 "Non-nil means use alternative key bindings for some keys.
297 Org-mode uses S-<cursor> keys for changing timestamps and priorities.
298 These keys are also used by other packages like `CUA-mode' or `windmove.el'.
299 If you want to use Org-mode together with one of these other modes,
300 or more generally if you would like to move some Org-mode commands to
301 other keys, set this variable and configure the keys with the variable
302 `org-disputed-keys'.
304 This option is only relevant at load-time of Org-mode, and must be set
305 *before* org.el is loaded. Changing it requires a restart of Emacs to
306 become effective."
311 "Non-nil means use extra key sequence definitions for certain
312 commands. This happens automatically if you run XEmacs or if
313 window-system is nil. This variable lets you do the same
314 manually. You must set it before loading org.
316 Example: on Carbon Emacs 22 running graphically, with an external
317 keyboard on a Powerbook, the default way of setting M-left might
318 not work for either Alt or ESC. Setting this variable will make
319 it work for ESC."
333 "Keys for which Org-mode and other modes compete.
334 This is an alist, cars are the default keys, second element specifies
335 the alternative to use when `org-replace-disputed-keys' is t.
337 Keys can be specified in any syntax supported by `define-key'.
338 The value of this option takes effect only at Org-mode's startup,
339 therefore you'll have to restart Emacs to apply it after changing."
344 "Select key according to `org-replace-disputed-keys' and `org-disputed-keys'.
345 Or return the original if not disputed."
350 org-disputed-keys)))
352 key))
362 "Define a key, possibly translated, as returned by `org-key'."
366 "The ellipsis to use in the Org-mode outline.
367 When nil, just use the standard three dots. When a string, use that instead,
368 When a face, use the standard 3 dots, but with the specified face.
369 The change affects only Org-mode (which will then use its own display table).
370 Changing this requires executing `M-x org-mode' in a buffer to become
371 effective."
381 "Keywords in Org-mode."
386 "String to mark deadline entries.
387 A deadline is this string, followed by a time stamp. Should be a word,
388 terminated by a colon. You can insert a schedule keyword and
390 Changes become only effective after restarting Emacs."
395 "String to mark scheduled TODO entries.
396 A schedule is this string, followed by a time stamp. Should be a word,
397 terminated by a colon. You can insert a schedule keyword and
399 Changes become only effective after restarting Emacs."
404 "String used as the prefix for timestamps logging closing a TODO entry."
409 "String used as prefix for timestamps clocking work hours on an item."
414 "Entries starting with this keyword will never be exported.
415 An entry can be toggled between COMMENT and normal with
417 Changes become only effective after restarting Emacs."
422 "Entries starting with this keyword will be exported in fixed-width font.
423 Quoting applies only to the text in the entry following the headline, and does
424 not extend beyond the next headline, even if that is lower level.
425 An entry can be toggled between QUOTE and normal with
432 "Regular expression for specifying repeated events.
436 "Options concerning the general structure of Org-mode files."
441 "Options about how to make context of a location visible."
465 "Non-nil means, show full hierarchy when revealing a location.
466 Org-mode often shows locations in an org-mode file which might have
467 been invisible before. When this is set, the hierarchy of headings
468 above the exposed location is shown.
469 Turning this off for example for sparse trees makes them very compact.
470 Instead of t, this can also be an alist specifying this option for different
471 contexts. Valid contexts are
472 agenda when exposing an entry from the agenda
473 org-goto when using the command `org-goto' on key C-c C-j
474 occur-tree when using the command `org-occur' on key C-c /
475 tags-tree when constructing a sparse tree based on tags matches
476 link-search when exposing search matches associated with a link
477 mark-goto when exposing the jump goal of a mark
478 bookmark-jump when exposing a bookmark location
479 isearch when exiting from an incremental search
480 default default for all contexts not set explicitly"
485 "Non-nil means, show following heading when revealing a location.
486 Org-mode often shows locations in an org-mode file which might have
487 been invisible before. When this is set, the heading following the
488 match is shown.
489 Turning this off for example for sparse trees makes them very compact,
490 but makes it harder to edit the location of the match. In such a case,
492 Instead of t, this can also be an alist specifying this option for different
493 contexts. See `org-show-hierarchy-above' for valid contexts."
498 "Non-nil means, show all sibling heading when revealing a location.
499 Org-mode often shows locations in an org-mode file which might have
500 been invisible before. When this is set, the sibling of the current entry
501 heading are all made visible. If `org-show-hierarchy-above' is t,
502 the same happens on each level of the hierarchy above the current entry.
504 By default this is on for the isearch context, off for all other contexts.
505 Turning this off for example for sparse trees makes them very compact,
506 but makes it harder to edit the location of the match. In such a case,
508 Instead of t, this can also be an alist specifying this option for different
509 contexts. See `org-show-hierarchy-above' for valid contexts."
514 "Non-nil means, show the entry below a headline when revealing a location.
515 Org-mode often shows locations in an org-mode file which might have
516 been invisible before. When this is set, the text below the headline that is
517 exposed is also shown.
519 By default this is off for all contexts.
520 Instead of t, this can also be an alist specifying this option for different
521 contexts. See `org-show-hierarchy-above' for valid contexts."
526 "How should indirect tree buffers be displayed?
527 This applies to indirect buffers created with the commands
529 Valid values are:
530 current-window Display in the current window
531 other-window Just display in another window.
532 dedicated-frame Create one new frame, and re-use it each time.
533 new-frame Make a new frame each time. Note that in this case
534 previously-made indirect buffers are kept, and you need to
535 kill these buffers yourself."
545 "Options concerning visibility cycling in Org-mode."
550 "Names of drawers. Drawers are not opened by cycling on the headline above.
551 Drawers only open with a TAB on the drawer line itself. A drawer looks like
552 this:
553 :DRAWERNAME:
554 .....
555 :END:
557 the property API.
559 Drawers can be defined on the per-file basis with a line like:
561 #+DRAWERS: HIDDEN STATE PROPERTIES"
566 "Cycle globally if cursor is at beginning of buffer and not at a headline.
567 This makes it possible to do global cycling without having to use S-TAB or
568 C-u TAB. For this special case to work, the first line of the buffer
569 must not be a headline - it may be empty or some other text. When used in
570 this way, `org-cycle-hook' is disables temporarily, to make sure the
571 cursor stays at the beginning of the buffer.
572 When this option is nil, don't do anything special at the beginning
573 of the buffer."
578 "Where should `org-cycle' emulate TAB.
579 nil Never
580 white Only in completely white lines
581 whitestart Only at the beginning of lines, before the first non-white char
582 t Everywhere except in headlines
583 exc-hl-bol Everywhere except at the start of a headline
584 If TAB is used in a place where it does not emulate TAB, the current subtree
585 visibility is cycled."
592 ))
595 "Number of empty lines needed to keep an empty line between collapsed trees.
596 If you leave an empty line between the end of a subtree and the following
597 headline, this empty line is hidden when the subtree is folded.
598 Org-mode will leave (exactly) one empty line visible if the number of
599 empty lines is equal or larger to the number given in this variable.
600 So the default 2 means, at least 2 empty lines after the end of a subtree
601 are needed to produce free space between a collapsed subtree and the
602 following headline.
604 Special case: when 0, never leave empty lines in collapsed view."
610 org-cycle-hide-drawers
611 org-cycle-show-empty-lines
612 org-optimize-window-after-visibility-change)
613 "Hook that is run after `org-cycle' has changed the buffer visibility.
614 The function(s) in this hook must accept a single argument which indicates
615 the new state that was set by the most recent `org-cycle' command. The
616 argument is a symbol. After a global state change, it can have the values
617 `overview', `content', or `all'. After a local state change, it can have
618 the values `folded', `children', or `subtree'."
623 "Options concerning structure editing in Org-mode."
628 "Non-nil means, skip even levels and only use odd levels for the outline.
629 This has the effect that two stars are being added/taken away in
630 promotion/demotion commands. It also influences how levels are
631 handled by the exporters.
632 Changing it requires restart of `font-lock-mode' to become effective
633 for fontification also in regions already fontified.
634 You may also set this on a per-file basis by adding one of the following
635 lines to the buffer:
637 #+STARTUP: odd
638 #+STARTUP: oddeven"
644 "Non-nil means, adapt indentation when promoting and demoting.
645 When this is set and the *entire* text in an entry is indented, the
646 indentation is increased by one space in a demotion command, and
647 decreased by one in a promotion command. If any line in the entry
648 body starts at column 0, indentation is not changed at all."
653 "Non-nil means `C-a' and `C-e' behave specially in headlines and items.
655 When t, `C-a' will bring back the cursor to the beginning of the
656 headline text, i.e. after the stars and after a possible TODO keyword.
657 In an item, this will be the position after the bullet.
658 When the cursor is already at that position, another `C-a' will bring
659 it to the beginning of the line.
661 `C-e' will jump to the end of the headline, ignoring the presence of tags
662 in the headline. A second `C-e' will then jump to the true end of the
663 line, after any tags.
665 When set to the symbol `reversed', the first `C-a' or `C-e' works normally,
666 and only a directly following, identical keypress will bring the cursor
667 to the special positions.
669 This may also be a cons cell where the behavior for `C-a' and `C-e' is
670 set separately."
689 "Non-nil means `C-k' will behave specially in headlines.
690 When nil, `C-k' will call the default `kill-line' command.
691 When t, the following will happen while the cursor is in the headline:
693 - When the cursor is at the beginning of a headline, kill the entire
694 line and possible the folded subtree below the line.
695 - When in the middle of the headline text, kill the headline up to the tags.
696 - When after the headline text, kill the tags."
701 "Non-nil means, when yanking subtrees, fold them.
702 If the kill is a single subtree, or a sequence of subtrees, i.e. if
703 it starts with a heading and all other headings in it are either children
704 or siblings, then fold all the subtrees. However, do this only if no
705 text after the yank would be swallowed into a folded tree by this action."
710 "Non-nil means, when yanking subtrees, adjust the level.
711 With this setting, `org-paste-subtree' is used to insert the subtree, see
712 this function for details."
717 "Non-nil means, M-RET will split the line at the cursor position.
718 When nil, it will go to the end of the line before making a
719 new line.
720 You may also set this option in a different way for different
721 contexts. Valid contexts are:
723 headline when creating a new headline
724 item when creating a new item
725 table in a table field
726 default the value to be used for all contexts not explicitly
727 customized"
744 "Non-nil means, insert new headings after the current subtree.
745 When nil, the new heading is created directly after the current line.
748 for the duration of the command."
754 "Should `org-insert-heading' leave a blank line before new heading/item?
755 The value is an alist, with `heading' and `plain-list-item' as car,
756 and a boolean flag as cdr. For plain lists, if the variable
757 `org-empty-line-terminates-plain-lists' is set, the setting here
758 is ignored and no empty line is inserted, to keep the list in tact."
771 "Hook being run after inserting a new heading."
777 This currently only means, they are never auto-wrapped.
778 When nil, such lines will be treated like ordinary lines.
779 See also the QUOTE keyword."
784 "Additional regexps to identify regions for editing with `org-edit-src-code'.
785 For examples see the function `org-edit-src-find-region-and-lang'.
786 The regular expression identifying the begin marker should end with a newline,
787 and the regexp marking the end line should start with a newline, to make sure
788 there are kept outside the narrowed region."
801 "The default coderef format.
802 This format string will be used to search for coderef labels in literal
803 examples (EXAMPLE and SRC blocks). The format can be overwritten
804 an individual literal example with the -f option, like
807 ...
808 #+END_SRC
810 If you want to use this for HTML export, make sure that the format does
811 not introduce special font-locking, and avoid the HTML special
812 characters `<', `>', and `&'. The reason for this restriction is that
813 the labels are searched for only after htmlize has done its job."
818 "The mode that should be used to edit fixed-width regions.
819 These are the regions where each line starts with a colon."
828 "Non-nil means, typing characters in org-goto starts incremental search."
833 "Options concerning sparse trees in Org-mode."
838 "Non-nil means, highlight all matches that define a sparse tree.
839 The highlights will automatically disappear the next time the buffer is
840 changed by an edit command."
845 "Non-nil means, any change to the buffer will remove temporary highlights.
846 Such highlights are created by `org-occur' and `org-clock-display'.
847 When nil, `C-c C-c needs to be used to get rid of the highlights.
848 The highlights created by `org-preview-latex-fragment' always need
849 `C-c C-c' to be removed."
856 "Hook that is run after `org-occur' has constructed a sparse tree.
857 This can be used to recenter the window to show as much of the structure
858 as possible."
863 "Options concerning imenu and speedbar in Org-mode."
868 "The maximum level for Imenu access to Org-mode headlines.
869 This also applied for speedbar access."
874 "Options concerning tables in Org-mode."
880 When nil, such lines will be treated like ordinary lines.
882 When equal to the symbol `optimized', the table editor will be optimized to
883 do the following:
884 - Automatic overwrite mode in front of whitespace in table fields.
885 This makes the structure of the table stay in tact as long as the edited
886 field does not exceed the column width.
887 - Minimize the number of realigns. Normally, the table is aligned each time
888 TAB or RET are pressed to move to another field. With optimization this
889 happens only if changes to a field might have changed the column width.
890 Optimization requires replacing the functions `self-insert-command',
891 `delete-char', and `backward-delete-char' in Org-mode buffers, with a
892 slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is
893 very good at guessing when a re-align will be necessary, but you can always
896 If you would like to use the optimized version in Org-mode, but the
897 un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'.
899 This variable can be used to turn on and off the table editor during a session,
900 but in order to toggle optimization, a restart is required.
902 See also the variable `org-table-auto-blank-field'."
910 "Non-nil means cluster self-insert commands for undo when possible.
911 If this is set, then, like in the Emacs command loop, 20 consequtive
912 characters will be undone together.
913 This is configurable, because there is some impact on typing performance."
918 "Non-nil means, TAB will automatically notice a table.el table.
919 When it sees such a table, it moves point into it and - if necessary -
920 calls `table-recognize-table'."
925 "Options concerning links in Org-mode."
930 "Buffer-local version of `org-link-abbrev-alist', which see.
935 "Alist of link abbreviations.
936 The car of each element is a string, to be replaced at the start of a link.
938 links in Org-mode buffers can have an optional tag after a double colon, e.g.
940 [[linkkey:tag][description]]
942 The 'linkkey' must be a word word, starting with a letter, followed
943 by letters, numbers, '-' or '_'.
945 If REPLACE is a string, the tag will simply be appended to create the link.
948 be inserted at that point (see the function `url-hexify-string').
950 REPLACE may also be a function that will be called with the tag as the
951 only argument to create the link, which should be returned as a string.
953 See the manual for examples."
963 "Non-nil means, hide link part and only show description of bracket links.
964 Bracket links are like [[link][description]]. This variable sets the initial
965 state in new org-mode buffers. The setting can then be toggled on a
966 per-buffer basis from the Org->Hyperlinks menu."
971 "How the path name in file links should be stored.
972 Valid values are:
974 relative Relative to the current directory, i.e. the directory of the file
975 into which the link is being inserted.
976 absolute Absolute path, if possible with ~ for home directory.
977 noabbrev Absolute path, no abbreviation of home directory.
978 adaptive Use relative path for files in the current directory and sub-
979 directories of it. For other files, use an absolute path."
988 "Types of links that should be activated in Org-mode files.
989 This is a list of symbols, each leading to the activation of a certain link
990 type. In principle, it does not hurt to turn on most link types - there may
991 be a small gain when turning off unused link types. The types are:
993 bracket The recommended [[link][description]] or [[link]] links with hiding.
994 angular Links in angular brackets that may contain whitespace like
995 <bbdb:Carsten Dominik>.
996 plain Plain links in normal text, no whitespace, like http://google.com.
997 radio Text that is matched by a radio target, see manual for details.
998 tag Tag settings in a headline (link to tag search).
999 date Time stamps (link to calendar).
1000 footnote Footnote labels.
1002 Changing this variable requires a restart of Emacs to become effective."
1014 "Function to use to generate link descriptions from links. If
1015 nil the link location will be used. This function must take two
1016 parameters; the first is the link and the second the description
1017 org-insert-link has generated, and should return the description
1018 to use."
1023 "Options concerning storing links in Org-mode."
1028 "Format of the description part of a link to an email or usenet message.
1029 The following %-escapes will be replaced by corresponding information:
1037 %s subject
1038 %m message-id.
1040 You may use normal field width specification between the % and the letter.
1041 This is for example useful to limit the length of the subject.
1055 It should match if the message is from the user him/herself."
1060 "Non-nil means, storing a link to an Org file will use entry IDs.
1062 Note that before this variable is even considered, org-id must be loaded,
1063 to please customize `org-modules' and turn it on.
1065 The variable can have the following values:
1067 t Create an ID if needed to make a link to the current entry.
1069 create-if-interactive
1070 If `org-store-link' is called directly (interactively, as a user
1071 command), do create an ID to support the link. But when doing the
1072 job for remember, only use the ID if it already exists. The
1073 purpose of this setting is to avoid proliferation of unwanted
1074 IDs, just because you happen to be in an Org file when you
1075 call `org-remember' that automatically and preemptively
1076 creates a link. If you do want to get an ID link in a remember
1077 template to an entry not having an ID, create it first by
1078 explicitly creating a link to it, using `C-c C-l' first.
1080 use-existing
1081 Use existing ID, do not create one.
1083 nil Never use an ID to make a link, instead link using a text search for
1084 the headline text."
1094 "Non-nil means, file links from `org-store-link' contain context.
1095 A search string will be added to the file name with :: as separator and
1096 used to find the context when the link is activated by the command
1097 `org-open-at-point'.
1099 negates this setting for the duration of the command."
1104 "Non-nil means, keep link in list for entire session.
1106 The command `org-store-link' adds a link pointing to the current
1107 location to an internal list. These links accumulate during a session.
1108 The command `org-insert-link' can be used to insert links into any
1109 Org-mode file (offering completion for all stored links). When this
1111 will be removed from the list, to make completing the unused links
1112 more efficient."
1117 "Options concerning following links in Org-mode."
1122 "Function to translate links with different syntax to Org syntax.
1123 This can be used to translate links created for example by the Planner
1124 or emacs-wiki packages to Org syntax.
1125 The function must accept two parameters, a TYPE containing the link
1127 which is everything after the link protocol. It should return a cons
1128 with possibly modified values of type and path.
1129 Org contains a function for this, so if you set this variable to
1130 `org-translate-link-from-planner', you should be able follow many
1131 links created by planner."
1136 "Hook that is run after a link has been followed."
1141 "Non-nil means, on links TAB will follow the link.
1142 Needs to be set before org.el is loaded.
1143 This really should not be used, it does not make sense, and the
1144 implementation is bad."
1149 "Non-nil means, on links RET will follow the link.
1150 Needs to be set before org.el is loaded."
1156 "Non-nil means, mouse-1 on a link will follow the link.
1157 A longer mouse click will still set point. Does not work on XEmacs.
1158 Needs to be set before org.el is loaded."
1163 "Number of different positions to be recorded in the ring
1164 Changing this requires a restart of Emacs to work correctly."
1172 "Setup the frame configuration for following links.
1173 When following a link with Emacs, it may often be useful to display
1174 this link in another window or frame. This variable can be used to
1175 set this up for the different types of links.
1176 For VM, use any of
1177 `vm-visit-folder'
1178 `vm-visit-folder-other-frame'
1179 For Gnus, use any of
1180 `gnus'
1181 `gnus-other-frame'
1182 `org-gnus-no-new-news'
1183 For FILE, use any of
1184 `find-file'
1185 `find-file-other-window'
1186 `find-file-other-frame'
1187 For the calendar, use the variable `calendar-setup'.
1188 For BBDB, it is currently only possible to display the matches in
1189 another window."
1209 "Non-nil means, use indirect buffer to display infile links.
1210 Activating internal links (from one location in a file to another location
1211 in the same file) normally just jumps to the location. When the link is
1212 activated with a C-u prefix (or with mouse-3), the link is displayed in
1213 another window. When this option is set, the other window actually displays
1214 an indirect buffer clone of the current buffer, to avoid any visibility
1215 changes to the current buffer."
1220 "Non-nil means, `org-open-file' will open non-existing files.
1221 When nil, an error will be generated."
1226 "Non-nil means, a link to a directory really means to index.org.
1227 When nil, following a directory link will run dired or open a finder/explorer
1228 window on that directory."
1233 "Function and arguments to call for following mailto links.
1234 This is a list with the first element being a lisp function, and the
1235 remaining elements being arguments to the function. In string arguments,
1236 %a will be replaced by the address, and %s will be replaced by the subject
1237 if one was given like in <mailto:arthur@galaxy.org::this subject>."
1246 "Non-nil means, ask for confirmation before executing shell links.
1247 Shell links can be dangerous: just think about a link
1249 [[shell:rm -rf ~/*][Google Search]]
1252 but really it would remove your entire home directory.
1253 Therefore we advise against setting this variable to nil.
1254 Just change it to `y-or-n-p' of you want to confirm with a
1263 "Non-nil means, ask for confirmation before executing Emacs Lisp links.
1264 Elisp links can be dangerous: just think about a link
1269 but really it would remove your entire home directory.
1270 Therefore we advise against setting this variable to nil.
1271 Just change it to `y-or-n-p' of you want to confirm with a
1283 "Default file applications on a UNIX or GNU/Linux system.
1294 "Default file applications on a MacOS X system.
1296 for some files for which the OS does not have a good default.
1304 'mswindows-shell-execute
1309 'mswindows-shell-execute
1312 "Default file applications on a Windows NT system.
1317 '(
1321 )
1322 "External applications for opening `file:path' items in a document.
1323 Org-mode uses system defaults for different file types, but
1324 you can use this variable to set the application for a given file
1325 extension. The entries in this list are cons cells where the car identifies
1326 files and the cdr the corresponding command. Possible values for the
1327 file identifier are
1329 compatibility, this can also be a string with only alphanumeric
1330 characters, which is then interpreted as an extension.
1331 `directory' Matches a directory
1332 `remote' Matches a remote file, accessible through tramp or efs.
1333 Remote files most likely should be visited through Emacs
1334 because external applications cannot handle such paths.
1335 `auto-mode' Matches files that are matched by any entry in `auto-mode-alist',
1336 so all files Emacs knows how to handle. Using this with
1337 command `emacs' will open most files in Emacs. Beware that this
1338 will also open html files inside Emacs, unless you add
1340 t Default for files not matched by any of the other options.
1341 `system' The system command to open files, like `open' on Windows
1342 and Mac OS X, and mailcap under GNU/Linux. This is the command
1343 that will be selected if you call `C-c C-o' with a double
1344 `C-u C-u' prefix.
1346 Possible values for the command are:
1347 `emacs' The file will be visited by the current Emacs process.
1348 `default' Use the default application for this file type, which is the
1349 association for t in the list, most likely in the system-specific
1350 part.
1351 This can be used to overrule an unwanted setting in the
1352 system-specific variable.
1354 This command is specified by the entry whose car is `system'.
1355 Most likely, the system-specific version of this variable
1356 does define this command, but you can overrule/replace it
1357 here.
1358 string A command to be executed by a shell; %s will be replaced
1359 by the path to the file.
1360 sexp A Lisp form which will be evaluated. The file path will
1361 be available in the Lisp variable `file'.
1362 For more examples, see the system specific constants
1363 `org-file-apps-defaults-macosx'
1364 `org-file-apps-defaults-windowsnt'
1365 `org-file-apps-defaults-gnu'."
1375 auto-mode))
1384 "Options concerning refiling entries in Org-mode."
1389 "Directory with org files.
1390 This is just a default location to look for Org files. There is no need
1391 at all to put your files into this directory. It is only used in the
1392 following situations:
1394 1. When a remember template specifies a target file that is not an
1395 absolute path. The path will then be interpreted relative to
1396 `org-directory'
1397 2. When a remember note is filed away in an interactive way (when exiting the
1398 note buffer with `C-1 C-c C-c'. The the user is prompted for an org file,
1399 with `org-directory' as the default path."
1405 "Default target for storing notes.
1406 Used by the hooks for remember.el. This can be a string, or nil to mean
1407 the value of `remember-data-file'.
1408 You can set this on a per-template basis with the variable
1409 `org-remember-templates'."
1414 file))
1417 "The default interface to be used for `org-goto'.
1418 Allowed values are:
1419 outline The interface shows an outline of the relevant file
1420 and the correct heading is found by moving through
1421 the outline or by searching with incremental search.
1422 outline-path-completion Headlines in the current buffer are offered via
1423 completion. This is the interface also used by
1424 the refile command."
1431 "Maximum level to be considered when running org-goto with refile interface."
1436 "Non-nil means, store new notes at the beginning of a file or entry.
1437 When nil, new notes will be filed to the end of a file or entry.
1438 This can also be a list with cons cells of regular expressions that
1439 are matched against file names, and values."
1450 This is list of cons cells. Each cell contains:
1451 - a specification of the files to be considered, either a list of files,
1452 or a symbol whose function or variable value will be used to retrieve
1453 a file name or a list of file names. If you use `org-agenda-files' for
1454 that, all agenda files will be scanned for targets. Nil means, consider
1455 headings in the current buffer.
1456 - A specification of how to find candidate refile targets. This may be
1457 any of:
1459 This tag has to be present in all target headlines, inheritance will
1460 not be considered.
1462 todo keyword.
1464 headlines that are refiling targets.
1465 - a cons cell (:level . N). Any headline of level N is considered a target.
1466 Note that, when `org-odd-levels-only' is set, level corresponds to
1467 order in hierarchy, not to the number of stars.
1468 - a cons cell (:maxlevel . N). Any headline with level <= N is a target.
1469 Note that, when `org-odd-levels-only' is set, level corresponds to
1470 order in hierarchy, not to the number of stars.
1472 When this variable is nil, all top-level headlines in the current buffer
1473 are used, equivalent to the value `((nil . (:level . 1))'."
1489 "Non-nil means, provide refile targets as paths.
1490 So a level 3 headline will be available as level1/level2/level3.
1491 When the value is `file', also include the file name (without directory)
1492 into the path. When `full-file-path', include the full file path."
1501 "Non-nil means, complete the outline path in hierarchical steps.
1502 When Org-mode uses the refile interface to select an outline path
1503 \(see variable `org-refile-use-outline-path'), the completion of
1504 the path can be done is a single go, or if can be done in steps down
1505 the headline hierarchy. Going in steps is probably the best if you
1506 do not use a special completion package like `ido' or `icicles'.
1507 However, when using these packages, going in one step can be very
1508 fast, while still showing the whole path to the entry."
1513 "Options concerning TODO items in Org-mode."
1518 "Options concerning Progress logging in Org-mode."
1523 '(
1526 "The available interpretation symbols for customizing
1527 `org-todo-keywords'.
1531 "List of TODO entry keyword sequences and their interpretation.
1534 Each sequence starts with a symbol, either `sequence' or `type',
1535 indicating if the keywords should be interpreted as a sequence of
1536 action steps, or as different types of TODO items. The first
1537 keywords are states requiring action - these states will select a headline
1538 for inclusion into the global TODO list Org-mode produces. If one of
1541 the last keyword is treated as the only DONE state of the sequence.
1544 additional state where no keyword is present. For details about this
1545 cycling, see the manual.
1547 TODO keywords and interpretation can also be set on a per-file basis with
1548 the special #+SEQ_TODO and #+TYP_TODO lines.
1550 Each keyword can optionally specify a character for fast state selection
1551 \(in combination with the variable `org-use-fast-todo-selection')
1552 and specifiers for state change logging, using the same syntax
1555 indicates to record a time stamp each time this state is selected.
1557 Each keyword may also specify if a timestamp or a note should be
1558 recorded when entering or leaving the state, by adding additional
1559 characters in the parenthesis after the keyword. This looks like this:
1561 record only the time of the state change. With X and Y being either
1563 Y when leaving the state if and only if the *target* state does not
1564 define X. You may omit any of the fast-selection key or X or /Y,
1565 so WAIT(w@), WAIT(w/@) and WAIT(@/@) are all valid.
1567 For backward compatibility, this variable may also be just a list
1568 of keywords - in this case the interpretation (sequence or type) will be
1569 taken from the (otherwise obsolete) variable `org-todo-interpretation'."
1579 ;;Quick and dirty way to see
1580 ;;`org-todo-interpretations'. This takes the
1581 ;;place of item arguments
1582 :convert-widget
1589 org-todo-interpretation-widgets))
1590 widget))
1620 "Controls how TODO keywords are interpreted.
1621 This variable is in principle obsolete and is only used for
1622 backward compatibility, if the interpretation of todo keywords is
1623 not given already in `org-todo-keywords'. See that variable for
1624 more information."
1631 "Non-nil means, use the fast todo selection scheme with C-c C-t.
1632 This variable describes if and under what circumstances the cycling
1633 mechanism for TODO keywords will be replaced by a single-key, direct
1634 selection scheme.
1636 When nil, fast selection is never used.
1638 When the symbol `prefix', it will be used when `org-todo' is called with
1639 a prefix argument, i.e. `C-u C-c C-t' in an Org-mode buffer, and `C-u t'
1640 in an agenda buffer.
1642 When t, fast selection is used by default. In this case, the prefix
1643 argument forces cycling instead.
1645 In all cases, the special interface is only used if access keys have actually
1646 been assigned by the user, i.e. if keywords in the configuration are followed
1647 by a letter in parenthesis, like TODO(t)."
1655 "Non-nil means, update todo statistics after insert and toggle.
1656 When this is set, todo statistics is updated in the parent of the current
1657 entry each time a todo state is changed."
1662 "Hook which is run after the state of a TODO item was changed.
1663 The new state (a string with a TODO keyword, or nil) is available in the
1664 Lisp variable `state'."
1669 "Hook for functions that are allowed to block a state change.
1671 Each function gets as its single argument a property list, see
1672 `org-trigger-hook' for more information about this list.
1674 If any of the functions in this hook returns nil, the state change
1678 "Hook for functions that are triggered by a state change.
1680 Each function gets as its single argument a property list with at least
1681 the following elements:
1683 (:type type-of-change :position pos-at-entry-start
1684 :from old-state :to new-state)
1686 Depending on the type, more properties may be present.
1688 This mechanism is currently implemented for:
1690 TODO state changes
1691 ------------------
1692 :type todo-state-change
1693 :from previous state (keyword as a string), or nil, or a symbol
1694 'todo' or 'done', to indicate the general type of state.
1698 "Non-nil means, undone TODO entries will block switching the parent to DONE.
1699 Also, if a parent has an :ORDERED: property, switching an entry to DONE will
1700 be blocked if any prior sibling is not yet done.
1701 This variable needs to be set before org.el is loaded, and you need to
1702 restart Emacs after a change to make the change effective. The only way
1703 to change is while Emacs is running is through the customize interface."
1715 "Non-nil means, unchecked boxes will block switching the parent to DONE.
1716 When this is nil, checkboxes have no influence on switching TODO states.
1717 When non-nil, you first need to check off all check boxes before the TODO
1718 entry can be switched to DONE.
1719 This variable needs to be set before org.el is loaded, and you need to
1720 restart Emacs after a change to make the change effective. The only way
1721 to change is while Emacs is running is through the customize interface."
1733 "Tag changes that should be triggered by TODO state changes.
1734 This is a list. Each entry is
1736 (state-change (tag . flag) .......)
1738 State-change can be a string with a state, and empty string to indicate the
1739 state that has no TODO keyword, or it can be one of the symbols `todo'
1740 or `done', meaning any not-done or done state, respectively."
1754 "Information to record when a task moves to the DONE state.
1756 Possible values are:
1758 nil Don't add anything, just change the keyword
1759 time Add a time stamp to the task
1760 note Prompt a closing note and add it with template `org-log-note-headings'
1762 This option can also be set with on a per-file-basis with
1764 #+STARTUP: nologdone
1765 #+STARTUP: logdone
1766 #+STARTUP: lognotedone
1768 You can have local logging settings for a subtree by setting the LOGGING
1769 property to one or more of these keywords."
1777 ;; Normalize old uses of org-log-done.
1784 "Non-nil means, record a note when clocking out of an item.
1785 This can also be configured on a per-file basis by adding one of
1786 the following lines anywhere in the buffer:
1788 #+STARTUP: lognoteclock-out
1789 #+STARTUP: nolognoteclock-out"
1795 "Non-nil means, the CLOSED time stamp will contain date and time.
1796 When nil, only the date will be recorded."
1805 "Headings for notes added to entries.
1806 The value is an alist, with the car being a symbol indicating the note
1807 context, and the cdr is the heading to be used. The heading may also be the
1808 empty string.
1809 %t in the heading will be replaced by a time stamp.
1810 %s will be replaced by the new TODO state, in double quotes.
1811 %S will be replaced by the old TODO state, in double quotes.
1812 %u will be replaced by the user name.
1813 %U will be replaced by the full user name."
1819 "Heading when changing todo state (todo sequence only)"
1828 "Non-nil means, insert state change notes and time stamps into a drawer.
1829 When nil, state changes notes will be inserted after the headline and
1830 any scheduling and clock lines, but not inside a drawer.
1832 The value of this variable should be the name of the drawer to use.
1833 LOGBOOK is proposed at the default drawer for this purpose, you can
1834 also set this to a string to define the drawer of your choice.
1838 If this variable is set, `org-log-state-notes-insert-after-drawers'
1839 will be ognored."
1851 "Non-nil means, insert state change notes after any drawers in entry.
1852 Only the drawers that *immediately* follow the headline and the
1853 deadline/scheduled line are skipped.
1854 When nil, insert notes right after the heading and perhaps the line
1855 with deadline/scheduling if present.
1857 This variable will have no effect if `org-log-into-drawer' is
1858 set."
1864 "Non-nil means, the latest state change note will be directly after heading.
1865 When nil, the notes will be orderer according to time."
1871 "Non-nil means, record moving through the DONE state when triggering repeat.
1872 An auto-repeating tasks is immediately switched back to TODO when marked
1874 the TODO keyword definition, or recording a closing note by setting
1875 `org-log-done', there will be no record of the task moving through DONE.
1876 This variable forces taking a note anyway. Possible values are:
1878 nil Don't force a record
1879 time Record a time stamp
1880 note Record a note
1882 This option can also be set with on a per-file-basis with
1884 #+STARTUP: logrepeat
1885 #+STARTUP: lognoterepeat
1886 #+STARTUP: nologrepeat
1888 You can have local logging settings for a subtree by setting the LOGGING
1889 property to one or more of these keywords."
1899 "Priorities in Org-mode."
1904 "The highest priority of TODO items. A character like ?A, ?B etc.
1905 Must have a smaller ASCII number than `org-lowest-priority'."
1910 "The lowest priority of TODO items. A character like ?A, ?B etc.
1911 Must have a larger ASCII number than `org-highest-priority'."
1916 "The default priority of TODO items.
1917 This is the priority an item get if no explicit priority is given."
1922 "Non-nil means, start with default priority when starting to cycle.
1923 When this is nil, the first step in the cycle will be (depending on the
1924 command used) one higher or lower that the default priority."
1929 "Options concerning time stamps and deadlines in Org-mode."
1934 "Non-nil means, SCHEDULED and DEADLINE timestamps are inserted at point.
1935 When nil, these labeled time stamps are forces into the second line of an
1936 entry, just after the headline. When scheduling from the global TODO list,
1937 the time stamp will always be forced into the second line."
1942 "Formats for `format-time-string' which are used for time stamps.
1946 "Number of minutes to round time stamps to.
1947 These are two values, the first applies when first creating a time stamp.
1948 The second applies when changing it with the commands `S-up' and `S-down'.
1949 When changing the time stamp, this means that it will change in steps
1950 of N minutes, as given by the second value.
1952 When a setting is 0 or 1, insert the time unmodified. Useful rounding
1953 numbers should be factors of 60, so for example 5, 10, 15.
1955 When this is larger than 1, you can still force an exact time-stamp by using
1956 a double prefix argument to a time-stamp command like `C-c .' or `C-c !',
1957 and by using a prefix arg to `S-up/down' to specify the exact number
1958 of minutes to shift."
1968 ;; Normalize old customizations of this variable.
1972 org-time-stamp-rounding-minutes)))
1975 "Non-nil means, overlay custom formats over all time stamps.
1976 The formats are defined through the variable `org-time-stamp-custom-formats'.
1977 To turn this on on a per-file basis, insert anywhere in the file:
1978 #+STARTUP: customtime"
1986 "Custom formats for time stamps. See `format-time-string' for the syntax.
1987 These are overlayed over the default ISO format if the variable
1988 `org-display-custom-times' is set. Time like %H:%M should be at the
1989 end of the second format."
1994 "Get the right format for a time string."
1999 f)))
2002 "The format string used when creating CLOCKSUM lines, or when
2003 org-mode generates a time duration."
2008 "No. of days before expiration during which a deadline becomes active.
2009 This variable governs the display in sparse trees and in the agenda.
2010 When 0 or negative, it means use this number (the absolute value of it)
2011 even if a deadline has a different individual lead time specified."
2017 "Non-nil means, assume future for incomplete date input from user.
2018 This affects the following situations:
2019 1. The user gives a day, but no month.
2022 it will be considered as *this* month.
2023 2. The user gives a month but not a year.
2027 Currently this does not work for ISO week specifications.
2029 When this option is nil, the current month and year will always be used
2030 as defaults."
2035 "Non-nil means, display current interpretation of date prompt live.
2036 This display will be in an overlay, in the minibuffer."
2041 "Non-nil means, pop up a calendar when prompting for a date.
2042 In the calendar, the date can be selected with mouse-1. However, the
2043 minibuffer will also be active, and you can simply enter the date as well.
2044 When nil, only the minibuffer will be available."
2052 "The hour when your day really ends. Must be an integer.
2053 This has influence for the following applications:
2055 the time given here, the day recognized as TODAY is actually yesterday.
2056 - When a date is read from the user and it is still before the time given
2057 here, the current date and time will be assumed to be yesterday, 23:59.
2058 Also, timestamps inserted in remember templates follow this rule.
2060 IMPORTANT: This is a feature whose implementation is and likely will
2061 remain incomplete. Really, it is only here because past midnight seems to
2062 be the favorite working time of John Wiegley :-)"
2067 "Non-nil means, S-down will increase the time in a time stamp.
2068 When nil, S-up will increase."
2073 "Non-nil means, make the calendar window follow timestamp changes.
2074 When a timestamp is modified and the calendar window is visible, it will be
2075 moved to the new date."
2080 "Options concerning tags in Org-mode."
2085 "List of tags allowed in Org-mode files.
2086 When this list is nil, Org-mode will base TAG input on what is already in the
2087 buffer.
2088 The value of this variable is an alist, the car of each entry must be a
2089 keyword as a string, the cdr may be a character that is used to select
2090 that tag through the fast-tag-selection interface.
2091 See the manual for details."
2102 "List of tags that will always appear in all Org-mode files.
2103 This is in addition to any in buffer settings or customizations
2104 of `org-tag-alist'.
2105 When this list is nil, Org-mode will base TAG input on `org-tag-alist'.
2106 The value of this variable is an alist, the car of each entry must be a
2107 keyword as a string, the cdr may be a character that is used to select
2108 that tag through the fast-tag-selection interface.
2109 See the manual for details.
2110 To disable these tags on a per-file basis, insert anywhere in the file:
2111 #+STARTUP: noptag"
2122 "List of tags that can be inherited by all entries in the file.
2123 The tags will be inherited if the variable `org-use-tag-inheritance'
2124 says they should be.
2128 "Non-nil means, use fast tag selection scheme.
2129 This is a special interface to select and deselect tags with single keys.
2130 When nil, fast selection is never used.
2131 When the symbol `auto', fast selection is used if and only if selection
2132 characters for tags have been configured, either through the variable
2133 `org-tag-alist' or through a #+TAGS line in the buffer.
2134 When t, fast selection is always used and selection keys are assigned
2135 automatically if necessary."
2143 "Non-nil means, fast tag selection exits after first change.
2144 When nil, you have to press RET to exit it.
2145 During fast tag selection, you can toggle this flag with `C-c'.
2146 This variable can also have the value `expert'. In this case, the window
2147 displaying the tags menu is not even shown, until you press C-c again."
2155 "Non-nil means, fast tags selection interface will also offer TODO states.
2159 "The column to which tags should be indented in a headline.
2160 If this number is positive, it specifies the column. If it is negative,
2161 it means that the tags should be flushright to that column. For example,
2162 -80 works well for a normal 80 character screen."
2167 "Non-nil means, realign tags after pro/demotion of TODO state change.
2168 These operations change the length of a headline and therefore shift
2169 the tags around. With this options turned on, after each such operation
2170 the tags are again aligned to `org-tags-column'."
2175 "Non-nil means, tags in levels apply also for sublevels.
2176 When nil, only the tags directly given in a specific line apply there.
2177 This may also be a list of tags that should be inherited, or a regexp that
2178 matches tags that should be inherited. Additional control is possible
2179 with the variable `org-tags-exclude-from-inheritance' which gives an
2180 explicit list of tags to be excluded from inheritance., even if the value of
2181 `org-use-tag-inheritance' would select it for inheritance.
2183 If this option is t, a match early-on in a tree can lead to a large
2184 number of matches in the subtree when constructing the agenda or creating
2185 a sparse tree. If you only want to see the first match in a tree during
2186 a search, check out the variable `org-tags-match-list-sublevels'."
2195 "List of tags that should never be inherited.
2196 This is a way to exclude a few tags from inheritance. For way to do
2197 the opposite, to actively allow inheritance for selected tags,
2198 see the variable `org-use-tag-inheritance'."
2203 "Check if TAG is one that should be inherited."
2215 "Non-nil means list also sublevels of headlines matching tag search.
2216 Because of tag inheritance (see variable `org-use-tag-inheritance'),
2217 the sublevels of a headline matching a tag search often also match
2218 the same search. Listing all of them can create very long lists.
2219 Setting this variable to nil causes subtrees of a match to be skipped.
2220 This option is off by default, because inheritance in on. If you turn
2221 inheritance off, you very likely want to turn this option on.
2223 As a special case, if the tag search is restricted to TODO items, the
2224 value of this variable is ignored and sublevels are always checked, to
2225 make sure all corresponding TODO items find their way into the list.
2227 This variable is semi-obsolete and probably should always be true. It
2228 is better to limit inheritance to certain tags using the variables
2229 `org-use-tag-inheritance' and `org-tags-exclude-from-inheritance'."
2241 "Options concerning properties in Org-mode."
2246 "How property key/value pairs should be formatted by `indent-line'.
2247 When `indent-line' hits a property definition, it will format the line
2248 according to this format, mainly to make sure that the values are
2249 lined-up with respect to each other."
2254 "Non-nil means, properties apply also for sublevels.
2256 This setting is chiefly used during property searches. Turning it on can
2257 cause significant overhead when doing a search, which is why it is not
2258 on by default.
2260 When nil, only the properties directly given in the current entry count.
2261 When t, every property is inherited. The value may also be a list of
2262 properties that should have inheritance, or a regular expression matching
2263 properties that should be inherited.
2265 However, note that some special properties use inheritance under special
2266 circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS,
2268 for valid values of a property.
2270 Note for programmers:
2271 When querying an entry with `org-entry-get', you can control if inheritance
2272 should be used. By default, `org-entry-get' looks only at the local
2273 properties. You can request inheritance by setting the inherit argument
2274 to t (to force inheritance) or to `selective' (to respect the setting
2275 in this variable)."
2284 "Check if PROPERTY is one that should be inherited."
2295 "The default column format, if no other format has been defined.
2296 This variable can be set on the per-file basis by inserting a line
2298 #+COLUMNS: %25ITEM ....."
2303 "The ellipses to be used when a field in column view is truncated.
2304 When this is the empty string, as many characters as possible are shown,
2305 but then there will be no visual indication that the field has been truncated.
2306 When this is a string of length N, the last N characters of a truncated
2307 field are replaced by this string. If the column is narrower than the
2308 ellipses string, only part of the ellipses string will be shown."
2313 "Function that modifies values for display in column view.
2314 For example, it can be used to cut out a certain part from a time stamp.
2315 The function must take 2 arguments:
2317 column-title The title of the column (*not* the property name)
2318 value The value that should be modified.
2320 The function should return the value that should be displayed,
2321 or nil if the normal value should be used."
2326 "The property that is being used to keep track of effort estimates.
2327 Effort estimates given in this property need to have the format H:MM."
2334 "List of property/value pairs that can be inherited by any entry.
2336 These are fixed values, for the preset properties. The user variable
2337 that can be used to add to this list is `org-global-properties'.
2339 The entries in this list are cons cells where the car is a property
2340 name and cdr is a string with the value. If the value represents
2345 "List of property/value pairs that can be inherited by any entry.
2347 This list will be combined with the constant `org-global-properties-fixed'.
2349 The entries in this list are cons cells where the car is a property
2350 name and cdr is a string with the value.
2352 You can set buffer-local values for the same purpose in the variable
2353 `org-file-properties' this by adding lines like
2355 #+PROPERTY: NAME VALUE"
2362 "List of property/value pairs that can be inherited by any entry.
2363 Valid for the current buffer.
2368 "Options concerning agenda views in Org-mode."
2373 "Variable used by org files to set a category for agenda display.
2374 Such files should use a file variable to set it, for example
2378 or contain a special line
2380 #+CATEGORY: ELisp
2382 If the file does not specify a category, then file's base name
2388 "The files to be used for agenda display.
2392 If an entry is a directory, all files in that directory that are matched by
2393 `org-agenda-file-regexp' will be part of the file list.
2395 If the value of the variable is not a list but a single file name, then
2396 the list of agenda files is actually stored and maintained in that file, one
2397 agenda file per line."
2404 "Regular expression to match files for `org-agenda-files'.
2405 If any element in the list in that variable contains a directory instead
2406 of a normal file, all files in that directory that are matched by this
2407 regular expression will be included."
2412 "List of extra files to be searched by text search commands.
2413 These files will be search in addition to the agenda files by the
2414 commands `org-search-view' (`C-c a s') and `org-occur-in-agenda-files'.
2415 Note that these files will only be searched for text search commands,
2416 not for the other agenda views like todo lists, tag searches or the weekly
2417 agenda. This variable is intended to list notes and possibly archive files
2418 that should also be searched by these two commands.
2419 In fact, if the first element in the list is the symbol `agenda-archives',
2420 than all archive files of all agenda files will be added to the search
2421 scope."
2432 "Non-nil means to just skip non-reachable files in `org-agenda-files'.
2433 A nil value means to remove them, after a query, from the list."
2438 "The key to be installed in `calendar-mode-map' for switching to the agenda.
2439 The command `org-calendar-goto-agenda' will be bound to this key. The
2440 default is the character `c' because then `c' can be used to switch back and
2441 forth between agenda and calendar."
2446 "The key to be installed in `calendar-mode-map' for agenda-action.
2447 The command `org-agenda-action' will be bound to this key. The
2448 default is the character `k' because we use the same key in the agenda."
2460 "Options for embedding LaTeX code into Org-mode."
2468 "Options for creating images from LaTeX fragments.
2469 This is a property list with the following properties:
2471 `default' means use the foreground of the default face.
2473 `default' means use the background of the default face.
2474 :scale a scaling factor for the size of the images.
2475 :html-foreground, :html-background, :html-scale
2476 the same numbers for HTML export.
2477 :matchers a list indicating which matchers should be used to
2478 find LaTeX fragments. Valid members of this list are:
2496 "The document header used for processing LaTeX fragments."
2502 "Font-lock settings for highlighting in Org-mode."
2507 "Non-nil means fontify only the stars in each headline.
2508 When nil, the entire headline is fontified.
2509 Changing it requires restart of `font-lock-mode' to become effective
2510 also in regions already fontified."
2515 "Non-nil means, hide the first N-1 stars in a headline.
2516 This works by using the face `org-hide' for these stars. This
2517 face is white for a light background, and black for a dark
2518 background. You may have to customize the face `org-hide' to
2519 make this work.
2520 Changing it requires restart of `font-lock-mode' to become effective
2521 also in regions already fontified.
2522 You may also set this on a per-file basis by adding one of the following
2523 lines to the buffer:
2525 #+STARTUP: hidestars
2526 #+STARTUP: showstars"
2531 "Non-nil means, change the face of a headline if it is marked DONE.
2532 Normally, only the TODO/DONE keyword indicates the state of a headline.
2533 When this is non-nil, the headline after the keyword is set to the
2534 `org-headline-done' as an additional indication."
2539 "Non-nil means fontify *bold*, /italic/ and _underlined_ text.
2540 Changing this variable requires a restart of Emacs to take effect."
2545 "Non-nil means, fontify what is treated specially by the exporters."
2550 "Non-nil mean font-lock should hide the emphasis marker characters."
2561 "Set variable and compute the emphasis regular expression."
2565 org-emphasis-alist org-emphasis-regexp-components)
2577 ;; make sure special characters appear at the right position in the class
2589 ;; Make the regexp
2597 body1
2609 body1
2617 "Components used to build the regular expression for emphasis.
2618 This is a list with 6 entries. Terminology: In an emphasis string
2622 specify what is allowed/forbidden in each part:
2624 pre Chars allowed as prematch. Beginning of line will be allowed too.
2625 post Chars allowed as postmatch. End of line will be allowed too.
2626 border The chars *forbidden* as border characters.
2628 non-shy groups here, and don't allow newline here.
2629 newline The maximum number of newlines allowed in an emphasis exp.
2631 Use customize to modify this, or restart Emacs after changing it."
2650 )
2651 "Special syntax for emphasized text.
2652 Text starting and ending with a special character will be emphasized, for
2653 example *bold*, _underlined_ and /italic/. This variable sets the marker
2654 characters, the face to be used by font-lock for highlighting in Org-mode
2655 Emacs buffers, and the HTML tags to be used for this.
2656 For LaTeX export, see the variable `org-export-latex-emphasis-alist'.
2657 Use customize to modify this, or restart Emacs after changing it."
2670 ;;; Miscellaneous options
2673 "Completion in Org-mode."
2678 "Non-nil means, use ido completion wherever possible.
2679 Note that `ido-mode' must be active for this variable to be relevant.
2680 If you decide to turn this variable on, you might well want to turn off
2681 `org-outline-path-complete-in-steps'."
2687 Normal means, no org-mode-specific context."
2691 ;;; Functions and variables from ther packages
2692 ;; Declared here to avoid compiler warnings
2694 ;; XEmacs only
2700 ;; Emacs only
2703 ;; Various packages
2716 (declare-function iswitchb-read-buffer (prompt &optional default require-match start matches-set))
2753 ;;; Autoload and prepare some org modules
2755 ;; Some table stuff that needs to be defined here, because it is used
2756 ;; by the functions setting up org-mode or checking for table context.
2769 "Searching from within a table (any type) this finds the first line
2772 ;; Autoload the functions in org-table.el that are needed by functions here.
2777 org-table-convert org-table-convert-region org-table-copy-down
2778 org-table-copy-region org-table-create
2779 org-table-create-or-convert-from-region
2780 org-table-create-with-table.el org-table-current-dline
2781 org-table-cut-region org-table-delete-column org-table-edit-field
2782 org-table-edit-formulas org-table-end org-table-eval-formula
2783 org-table-export org-table-field-info
2784 org-table-get-stored-formulas org-table-goto-column
2785 org-table-hline-and-move org-table-import org-table-insert-column
2786 org-table-insert-hline org-table-insert-row org-table-iterate
2787 org-table-justify-field-maybe org-table-kill-row
2788 org-table-maybe-eval-formula org-table-maybe-recalculate-line
2789 org-table-move-column org-table-move-column-left
2790 org-table-move-column-right org-table-move-row
2791 org-table-move-row-down org-table-move-row-up
2792 org-table-next-field org-table-next-row org-table-paste-rectangle
2793 org-table-previous-field org-table-recalculate
2794 org-table-rotate-recalc-marks org-table-sort-lines org-table-sum
2795 org-table-toggle-coordinate-overlays
2796 org-table-toggle-formula-debugger org-table-wrap-region
2797 orgtbl-mode turn-on-orgtbl org-table-to-lisp)))
2800 "Return t if the cursor is inside an org-type table.
2801 If TABLE-TYPE is non-nil, also check for table.el-type tables."
2806 org-table-line-regexp)))
2807 nil))
2811 "Return t if and only if we are at a table.el table."
2817 "If there is a table.el table nearby, recognize it and move into it."
2823 nil
2833 t
2838 t)
2839 nil)
2840 nil))
2843 "Return t if the cursor is inside a hline in a table."
2848 nil))
2853 "Apply FUNCTION to the start of all tables in the buffer."
2866 ;; Declare and autoload functions from org-exp.el
2874 org-insert-export-options-template org-export-as-html-and-open
2875 org-export-as-html-batch org-export-as-html-to-buffer
2876 org-replace-region-by-html org-export-region-as-html
2877 org-export-as-html org-export-icalendar-this-file
2878 org-export-icalendar-all-agenda-files
2879 org-table-clean-before-export
2880 org-export-icalendar-combine-agenda-files org-export-as-xoxo)))
2882 ;; Declare and autoload functions from org-agenda.el
2887 org-todo-list org-tags-view org-agenda-list-stuck-projects
2888 org-diary org-agenda-to-appt
2889 org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item)))
2891 ;; Autoload org-remember
2896 org-remember-apply-template org-remember org-remember-handler)))
2898 ;; Autoload org-clock.el
2910 "org-clock"
2912 org-clock-goto org-clock-sum org-clock-display
2913 org-clock-remove-overlays org-clock-report
2914 org-clocktable-shift org-dblock-write:clocktable
2915 org-get-clocktable)))
2918 "If this is a CLOCK line, update it and return t.
2919 Otherwise, return nil."
2928 ts te h m s neg)
2931 nil)
2936 ;; The clock is running here
2957 t))))))
2960 "Check if the current buffer contains the running clock.
2961 If yes, offer to stop it and to save the buffer with the changes."
2970 "Check if this line starts a clock table, if yes, shift the time block."
2974 ;; Autoload org-timer.el
2976 ;(declare-function org-timer "org-timer")
2980 "org-timer"
2982 org-timer-change-times-in-region)))
2985 ;; Autoload archiving code
2986 ;; The stuff that is needed for cycling and tags has to be defined here.
2989 "Options concerning archiving in Org-mode."
2994 "The location where subtrees should be archived.
2996 The value of this variable is a string, consisting of two parts,
2997 separated by a double-colon. The first part is a filename and
2998 the second part is a headline.
3000 When the filename is omitted, archiving happens in the same file.
3001 %s in the filename will be replaced by the current file
3002 name (without the directory part). Archiving to a different file
3003 is useful to keep archived entries from contributing to the
3004 Org-mode Agenda.
3006 The archived entries will be filed as subtrees of the specified
3007 headline. When the headline is omitted, the subtrees are simply
3008 filed away at the end of the file, as top-level entries. Also in
3009 the heading you can use %s to represent the file name, this can be
3010 useful when using the same archive for a number of different files.
3012 Here are a few examples:
3014 If the current file is Projects.org, archive in file
3015 Projects.org_archive, as top-level trees. This is the default.
3018 Archive in the current file, under the top-level headline
3022 Archive in file ~/org/archive.org (absolute path), as top-level trees.
3025 Archive in file ~/org/archive.org (absolute path), und headlines
3029 Archive in file ./basement (relative path), as level 3 trees
3032 You may set this option on a per-file basis by adding to the buffer a
3033 line like
3035 #+ARCHIVE: basement::** Finished Tasks
3037 You may also define it locally for a subtree by setting an ARCHIVE property
3038 in the entry. If such a property is found in an entry, or anywhere up
3039 the hierarchy, it will be used."
3044 "The tag that marks a subtree as archived.
3045 An archived subtree does not open during visibility cycling, and does
3046 not contribute to the agenda listings.
3047 After changing this, font-lock must be restarted in the relevant buffers to
3048 get the proper fontification."
3054 "Non-nil means, the agenda will skip any items located in archived trees.
3055 An archived tree is a tree marked with the tag ARCHIVE. The use of this
3056 variable is no longer recommended, you should leave it at the value t.
3057 Instead, use the key `v' to cycle the archives-mode in the agenda."
3063 "Non-nil means, `org-cycle' will open archived trees.
3064 An archived tree is a tree marked with the tag ARCHIVE.
3065 When nil, archived trees will stay folded. You can still open them with
3066 normal outline commands like `show-all', but not with the cycling commands."
3072 "Non-nil means sparse tree construction shows matches in archived trees.
3073 When nil, matches in these trees are highlighted, but the trees are kept in
3074 collapsed state."
3080 "Re-hide all archived subtrees after a visibility state change."
3091 "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway.")))))))
3094 "Cycle subtree even if it is archived."
3101 "Re-hide all archived subtrees after a visibility state change."
3114 org-archive-to-archive-sibling org-toggle-archive-tag)))
3116 ;; Autoload Column View Code
3124 org-columns-compute org-agenda-columns org-columns-remove-overlays
3127 ;; Autoload ID code
3135 org-id-get-with-outline-path-completion
3136 org-id-get-with-outline-drilling
3137 org-id-goto org-id-find org-id-store-link))
3139 ;; Autoload Plotting Code
3144 ;;; Variables for pre-computed regular expressions, all buffer local
3159 "Matches a headline and puts everything into groups:
3160 group 1: the stars
3161 group 2: The todo keyword, maybe
3162 group 3: Priority cookie
3163 group 4: True headline
3167 "Matches a headline and puts TODO state into group 2 if present.
3219 "Regular expression to match a plain time or time range.
3220 Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following
3221 groups carry important information:
3222 0 the full match
3223 1 the first time, range or not
3231 "Regular expression to match a time range like 13:30+2:10 = 13:30-15:40.
3232 Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following
3233 groups carry important information:
3234 0 the full match
3235 7 hours of duration
3244 "Regular expression to match a timestamp time or time range.
3245 After a match, the following groups carry important information:
3246 0 the full match
3247 1 date plus weekday, for backreferencing to make sure both times on same day
3248 2 the first time, range or not
3282 "Variable associated with STARTUP options for org-mode.
3283 Each element is a list of three items: The startup options as written
3284 in the #+STARTUP line, the corresponding variable, and the value to
3285 set this variable to if the option is found. An optional forth element PUSH
3289 "Precompute regular expressions for current buffer."
3307 kwds kws0 kwsa key log value cat arch tags const links hw dws
3308 tail sep kws1 prio props ftags drawers
3331 ;; general TODO-like setup
3343 links)))
3349 props)))
3354 ftags
3364 l var val)
3390 ))))
3405 ;; Process the TODO keywords
3407 ;; Use the global values as if they had been given locally.
3419 kws)))
3422 kwsa nil
3425 ;; 1 2
3433 kw)
3435 kws0)
3452 ;; Process the constants
3460 ;; Process the tags.
3471 tgs))
3479 ;; Compute the regular expressions and other local variables
3486 org-drawer-regexp
3490 org-not-done-keywords
3492 org-todo-regexp
3495 org-not-done-regexp
3499 org-todo-line-regexp
3503 org-complex-heading-regexp
3508 org-nl-done-regexp
3512 org-todo-line-tags-regexp
3517 org-looking-at-done-regexp
3522 org-deadline-time-regexp
3524 org-deadline-line-regexp
3526 org-scheduled-regexp
3528 org-scheduled-time-regexp
3530 org-closed-time-regexp
3532 org-keyword-time-regexp
3538 org-keyword-time-not-clock-regexp
3544 org-maybe-keyword-time-regexp
3550 org-planning-or-clock-line-re
3555 )
3560 "Return the contents of FILE, as a string."
3574 "Extract the log state setting from a TODO keyword string.
3588 "Remove a pair of parenthesis at the end of each string in LIST."
3592 x))
3593 list))
3595 ;; FIXME: this could be done much better, using second characters etc.
3597 "Assign fast keys to a keyword-key alist.
3598 Respect keys that are already there."
3609 ;; automatically assign a character.
3621 ;;; Some variables used in various places
3626 "Function to be called when `C-c C-c' is used.
3630 ;; FIXME: Occasionally check by commenting these, to make sure
3631 ;; no other functions uses these, forgetting to let-bind them.
3638 ;; Defined somewhere in this file, but used before definition.
3645 ;;;; Define the Org-mode
3648 (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or upgrade to newer allout, for example by switching to Emacs 22."))
3651 ;; We use a before-change function to check if a table might need
3652 ;; an update.
3654 "Indicates that a table might need an update.
3655 This variable is set by `org-before-change-function'.
3658 "Every change indicates that a table might need an update."
3668 ;;;###autoload
3670 "Outline-based notes management and organizer, alias
3673 Org-mode develops organizational tasks around a NOTES file which
3674 contains information about projects as plain text. Org-mode is
3675 implemented on top of outline-mode, which is ideal to keep the content
3676 of large files well structured. It supports ToDo items, deadlines and
3677 time stamps, which magically appear in the diary listing of the Emacs
3678 calendar. Tables are easily created with a built-in table editor.
3679 Plain text URL-like links connect to websites, emails (VM), Usenet
3680 messages (Gnus), BBDB entries, and any files related to the project.
3681 For printing and sharing of notes, an Org-mode file (or a part of it)
3682 can be exported as a structured ASCII or HTML file.
3684 The following commands are available:
3688 ;; Get rid of Outline menus, they are not needed
3689 ;; Need to do this here because define-derived-mode sets up
3690 ;; the keymap so late. Still, it is a waste to call this each time
3691 ;; we switch another buffer into org-mode.
3694 ;; Assume this is Greg's port, it used easymenu
3718 org-display-table 4
3721 org-ellipsis)))
3726 ;; tag faces set outside customize.... force initialization.
3728 ;; Calc embedded
3735 ;; Activate before-change-function
3739 ;; Check for running clock before killing a buffer
3741 ;; Paragraphs and auto-filling
3745 ;; Make sure dependence stuff works reliably, even for users who set it
3746 ;; too late :-(
3758 ;; Comment characters
3759 ; (org-set-local 'comment-start "#") ;; FIXME: this breaks wrapping
3762 ;; Align options lines
3764 'align-mode-rules-list
3769 ;; Imenu
3773 ;; Make isearch reveal context
3776 ;; Emacs 21 and XEmacs make use of the hook
3778 ;; Emacs 22 deals with this through a special variable
3782 ;; If empty file that did not turn on org-mode automatically, make it to.
3798 "Current time, possibly rounded to `org-time-stamp-rounding-minutes'."
3807 ;;;; Font-Lock stuff, including the activators
3812 (org-defkey org-mouse-map
3813 (if (featurep 'xemacs) [button3] [mouse-3]) 'org-find-file-at-mouse)
3814 (when org-mouse-1-follows-link
3815 (org-defkey org-mouse-map [follow-link] 'mouse-face))
3816 (when org-tab-follows-link
3817 (org-defkey org-mouse-map [(tab)] 'org-open-at-point)
3818 (org-defkey org-mouse-map "\C-i" 'org-open-at-point))
3820 (require 'font-lock)
3823 (defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news"
3824 "shell" "elisp"))
3825 (defvar org-link-types-re nil
3827 (defvar org-link-re-with-space nil
3828 "Matches a link with spaces, optional angular brackets around it.")
3829 (defvar org-link-re-with-space2 nil
3830 "Matches a link with spaces, optional angular brackets around it.")
3831 (defvar org-link-re-with-space3 nil
3832 "Matches a link with spaces, only for internal part in bracket links.")
3833 (defvar org-angle-link-re nil
3834 "Matches link with angular brackets, spaces are allowed.")
3835 (defvar org-plain-link-re nil
3836 "Matches plain link, without spaces.")
3837 (defvar org-bracket-link-regexp nil
3838 "Matches a link in double brackets.")
3839 (defvar org-bracket-link-analytic-regexp nil
3840 "Regular expression used to analyze links.
3841 Here is what the match groups contain after a match:
3842 1: http:
3843 2: http
3844 3: path
3845 4: [desc]
3846 5: desc")
3847 (defvar org-bracket-link-analytic-regexp++ nil
3848 "Like org-bracket-link-analytic-regexp, but include coderef internal type.")
3849 (defvar org-any-link-re nil
3850 "Regular expression matching any link.")
3852 (defun org-make-link-regexps ()
3853 "Update the link regular expressions.
3854 This should be called after the variable `org-link-types' has changed."
3855 (setq org-link-types-re
3856 (concat
3858 org-link-re-with-space
3859 (concat
3862 "[^" org-non-link-chars "]*"
3864 org-link-re-with-space2
3865 (concat
3870 org-link-re-with-space3
3871 (concat
3875 org-angle-link-re
3876 (concat
3879 "[^" org-non-link-chars "]*"
3881 org-plain-link-re
3882 (concat
3885 org-bracket-link-regexp
3887 org-bracket-link-analytic-regexp
3888 (concat
3895 org-bracket-link-analytic-regexp++
3896 (concat
3903 org-any-link-re
3908 (org-make-link-regexps)
3911 "Regular expression for fast time stamp matching.")
3913 "Regular expression for fast time stamp matching.")
3914 (defconst org-ts-regexp0 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]-+0-9>\r\n ]*\\)\\( \\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
3915 "Regular expression matching time strings for analysis.
3916 This one does not require the space after the date, so it can be used
3917 on a string that terminates immediately after the date.")
3918 (defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) +\\([^]-+0-9>\r\n ]*\\)\\( \\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
3919 "Regular expression matching time strings for analysis.")
3921 "Regular expression matching time stamps, with groups.")
3923 "Regular expression matching time stamps (also [..]), with groups.")
3924 (defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp)
3925 "Regular expression matching a time stamp range.")
3926 (defconst org-tr-regexp-both
3927 (concat org-ts-regexp-both "--?-?" org-ts-regexp-both)
3928 "Regular expression matching a time stamp range.")
3931 "Regular expression matching a time stamp or time stamp range.")
3934 "Regular expression matching a time stamp or time stamp range.
3935 The time stamps may be either active or inactive.")
3937 (defvar org-emph-face nil)
3939 (defun org-do-emphasis-faces (limit)
3940 "Run through the buffer and add overlays to links."
3941 (let (rtn)
3942 (while (and (not rtn) (re-search-forward org-emph-re limit t))
3943 (if (not (= (char-after (match-beginning 3))
3944 (char-after (match-beginning 4))))
3945 (progn
3946 (setq rtn t)
3947 (font-lock-prepend-text-property (match-beginning 2) (match-end 2)
3948 'face
3949 (nth 1 (assoc (match-string 3)
3950 org-emphasis-alist)))
3951 (add-text-properties (match-beginning 2) (match-end 2)
3952 '(font-lock-multiline t))
3953 (when org-hide-emphasis-markers
3954 (add-text-properties (match-end 4) (match-beginning 5)
3955 '(invisible org-link))
3956 (add-text-properties (match-beginning 3) (match-end 3)
3957 '(invisible org-link)))))
3958 (backward-char 1))
3959 rtn))
3961 (defun org-emphasize (&optional char)
3962 "Insert or change an emphasis, i.e. a font like bold or italic.
3963 If there is an active region, change that region to a new emphasis.
3964 If there is no region, just insert the marker characters and position
3965 the cursor between them.
3966 CHAR should be either the marker character, or the first character of the
3967 HTML tag associated with that emphasis. If CHAR is a space, the means
3968 to remove the emphasis of the selected region.
3969 If char is not given (for example in an interactive call) it
3970 will be prompted for."
3971 (interactive)
3972 (let ((eal org-emphasis-alist) e det
3973 (erc org-emphasis-regexp-components)
3974 (prompt "")
3975 (string "") beg end move tag c s)
3976 (if (org-region-active-p)
3977 (setq beg (region-beginning) end (region-end)
3978 string (buffer-substring beg end))
3979 (setq move t))
3981 (while (setq e (pop eal))
3982 (setq tag (car (org-split-string (nth 2 e) "[ <>/]+"))
3983 c (aref tag 0))
3984 (push (cons c (string-to-char (car e))) det)
3985 (setq prompt (concat prompt (format " [%s%c]%s" (car e) c
3986 (substring tag 1)))))
3987 (setq det (nreverse det))
3988 (unless char
3989 (message "%s" (concat "Emphasis marker or tag:" prompt))
3990 (setq char (read-char-exclusive)))
3991 (setq char (or (cdr (assoc char det)) char))
3992 (if (equal char ?\ )
3993 (setq s "" move nil)
3994 (unless (assoc (char-to-string char) org-emphasis-alist)
3996 (setq s (char-to-string char)))
3997 (while (and (> (length string) 1)
3998 (equal (substring string 0 1) (substring string -1))
3999 (assoc (substring string 0 1) org-emphasis-alist))
4000 (setq string (substring string 1 -1)))
4001 (setq string (concat s string s))
4002 (if beg (delete-region beg end))
4003 (unless (or (bolp)
4005 (char-to-string (char-before (point)))))
4006 (insert " "))
4008 (char-to-string (char-after (point))))
4009 (insert " ") (backward-char 1))
4010 (insert string)
4011 (and move (backward-char 1))))
4013 (defconst org-nonsticky-props
4014 '(mouse-face highlight keymap invisible intangible help-echo org-linked-text))
4017 (defun org-activate-plain-links (limit)
4018 "Run through the buffer and add overlays to links."
4019 (catch 'exit
4020 (let (f)
4021 (while (re-search-forward org-plain-link-re limit t)
4022 (setq f (get-text-property (match-beginning 0) 'face))
4023 (if (or (eq f 'org-tag)
4024 (and (listp f) (memq 'org-tag f)))
4025 nil
4026 (add-text-properties (match-beginning 0) (match-end 0)
4027 (list 'mouse-face 'highlight
4028 'rear-nonsticky org-nonsticky-props
4029 'keymap org-mouse-map
4030 ))
4031 (throw 'exit t))))))
4033 (defun org-activate-code (limit)
4035 (progn
4036 (remove-text-properties (match-beginning 0) (match-end 0)
4037 '(display t invisible t intangible t))
4038 t)))
4040 (defun org-activate-angle-links (limit)
4041 "Run through the buffer and add overlays to links."
4042 (if (re-search-forward org-angle-link-re limit t)
4043 (progn
4044 (add-text-properties (match-beginning 0) (match-end 0)
4045 (list 'mouse-face 'highlight
4046 'rear-nonsticky org-nonsticky-props
4047 'keymap org-mouse-map
4048 ))
4049 t)))
4051 (defun org-activate-footnote-links (limit)
4052 "Run through the buffer and add overlays to links."
4054 limit t)
4055 (progn
4056 (add-text-properties (match-beginning 2) (match-end 2)
4057 (list 'mouse-face 'highlight
4058 'rear-nonsticky org-nonsticky-props
4059 'keymap org-mouse-map
4060 'help-echo
4061 (if (= (point-at-bol) (match-beginning 2))
4062 "Footnote definition"
4063 "Footnote reference")
4064 ))
4065 t)))
4067 (defun org-activate-bracket-links (limit)
4068 "Run through the buffer and add overlays to bracketed links."
4069 (if (re-search-forward org-bracket-link-regexp limit t)
4070 (let* ((help (concat "LINK: "
4071 (org-match-string-no-properties 1)))
4072 ;; FIXME: above we should remove the escapes.
4073 ;; but that requires another match, protecting match data,
4074 ;; a lot of overhead for font-lock.
4075 (ip (org-maybe-intangible
4076 (list 'invisible 'org-link 'rear-nonsticky org-nonsticky-props
4077 'keymap org-mouse-map 'mouse-face 'highlight
4078 'font-lock-multiline t 'help-echo help)))
4079 (vp (list 'rear-nonsticky org-nonsticky-props
4080 'keymap org-mouse-map 'mouse-face 'highlight
4081 ' font-lock-multiline t 'help-echo help)))
4082 ;; We need to remove the invisible property here. Table narrowing
4083 ;; may have made some of this invisible.
4084 (remove-text-properties (match-beginning 0) (match-end 0)
4085 '(invisible nil))
4086 (if (match-end 3)
4087 (progn
4088 (add-text-properties (match-beginning 0) (match-beginning 3) ip)
4089 (add-text-properties (match-beginning 3) (match-end 3) vp)
4090 (add-text-properties (match-end 3) (match-end 0) ip))
4091 (add-text-properties (match-beginning 0) (match-beginning 1) ip)
4092 (add-text-properties (match-beginning 1) (match-end 1) vp)
4093 (add-text-properties (match-end 1) (match-end 0) ip))
4094 t)))
4096 (defun org-activate-dates (limit)
4097 "Run through the buffer and add overlays to dates."
4098 (if (re-search-forward org-tsr-regexp-both limit t)
4099 (progn
4100 (add-text-properties (match-beginning 0) (match-end 0)
4101 (list 'mouse-face 'highlight
4102 'rear-nonsticky org-nonsticky-props
4103 'keymap org-mouse-map))
4104 (when org-display-custom-times
4105 (if (match-end 3)
4106 (org-display-custom-time (match-beginning 3) (match-end 3)))
4107 (org-display-custom-time (match-beginning 1) (match-end 1)))
4108 t)))
4110 (defvar org-target-link-regexp nil
4111 "Regular expression matching radio targets in plain text.")
4112 (make-variable-buffer-local 'org-target-link-regexp)
4114 "Regular expression matching a link target.")
4116 "Regular expression matching a radio target.")
4117 (defvar org-any-target-regexp "<<<?\\([^<>\n\r]+\\)>>>?" ; FIXME, not exact, would match <<<aaa>> as a radio target.
4118 "Regular expression matching any target.")
4120 (defun org-activate-target-links (limit)
4121 "Run through the buffer and add overlays to target matches."
4122 (when org-target-link-regexp
4123 (let ((case-fold-search t))
4124 (if (re-search-forward org-target-link-regexp limit t)
4125 (progn
4126 (add-text-properties (match-beginning 0) (match-end 0)
4127 (list 'mouse-face 'highlight
4128 'rear-nonsticky org-nonsticky-props
4129 'keymap org-mouse-map
4130 'help-echo "Radio target link"
4131 'org-linked-text t))
4132 t)))))
4134 (defun org-update-radio-target-regexp ()
4135 "Find all radio targets in this file and update the regular expression."
4136 (interactive)
4137 (when (memq 'radio org-activate-links)
4138 (setq org-target-link-regexp
4139 (org-make-target-link-regexp (org-all-targets 'radio)))
4140 (org-restart-font-lock)))
4142 (defun org-hide-wide-columns (limit)
4143 (let (s e)
4144 (setq s (text-property-any (point) (or limit (point-max))
4145 'org-cwidth t))
4146 (when s
4147 (setq e (next-single-property-change s 'org-cwidth))
4148 (add-text-properties s e (org-maybe-intangible '(invisible org-cwidth)))
4149 (goto-char e)
4150 t)))
4152 (defvar org-latex-and-specials-regexp nil
4153 "Regular expression for highlighting export special stuff.")
4154 (defvar org-match-substring-regexp)
4155 (defvar org-match-substring-with-braces-regexp)
4156 (defvar org-export-html-special-string-regexps)
4158 (defun org-compute-latex-and-specials-regexp ()
4159 "Compute regular expression for stuff treated specially by exporters."
4160 (if (not org-highlight-latex-fragments-and-specials)
4161 (org-set-local 'org-latex-and-specials-regexp nil)
4162 (require 'org-exp)
4163 (let*
4164 ((matchers (plist-get org-format-latex-options :matchers))
4165 (latexs (delq nil (mapcar (lambda (x) (if (member (car x) matchers) x))
4166 org-latex-regexps)))
4167 (options (org-combine-plists (org-default-export-plist)
4168 (org-infile-export-plist)))
4169 (org-export-with-sub-superscripts (plist-get options :sub-superscript))
4170 (org-export-with-LaTeX-fragments (plist-get options :LaTeX-fragments))
4171 (org-export-with-TeX-macros (plist-get options :TeX-macros))
4172 (org-export-html-expand (plist-get options :expand-quoted-html))
4173 (org-export-with-special-strings (plist-get options :special-strings))
4174 (re-sub
4175 (cond
4176 ((equal org-export-with-sub-superscripts '{})
4177 (list org-match-substring-with-braces-regexp))
4178 (org-export-with-sub-superscripts
4179 (list org-match-substring-regexp))
4180 (t nil)))
4181 (re-latex
4182 (if org-export-with-LaTeX-fragments
4183 (mapcar (lambda (x) (nth 1 x)) latexs)))
4184 (re-macros
4185 (if org-export-with-TeX-macros
4187 (regexp-opt
4188 (append (mapcar 'car org-html-entities)
4189 (if (boundp 'org-latex-entities)
4190 org-latex-entities nil))
4191 'words))) ; FIXME
4192 ))
4194 (re-special (if org-export-with-special-strings
4195 (mapcar (lambda (x) (car x))
4196 org-export-html-special-string-regexps)))
4197 (re-rest
4198 (delq nil
4199 (list
4201 ))))
4202 (org-set-local
4203 'org-latex-and-specials-regexp
4204 (mapconcat 'identity (append re-latex re-sub re-macros re-special
4207 (defun org-do-latex-and-special-faces (limit)
4208 "Run through the buffer and add overlays to links."
4209 (when org-latex-and-specials-regexp
4210 (let (rtn d)
4211 (while (and (not rtn) (re-search-forward org-latex-and-specials-regexp
4212 limit t))
4213 (if (not (memq (car-safe (get-text-property (1+ (match-beginning 0))
4214 'face))
4215 '(org-code org-verbatim underline)))
4216 (progn
4217 (setq rtn t
4218 d (cond ((member (char-after (1+ (match-beginning 0)))
4219 '(?_ ?^)) 1)
4220 (t 0)))
4221 (font-lock-prepend-text-property
4222 (+ d (match-beginning 0)) (match-end 0)
4223 'face 'org-latex-and-export-specials)
4224 (add-text-properties (+ d (match-beginning 0)) (match-end 0)
4225 '(font-lock-multiline t)))))
4226 rtn)))
4228 (defun org-restart-font-lock ()
4229 "Restart font-lock-mode, to force refontification."
4230 (when (and (boundp 'font-lock-mode) font-lock-mode)
4231 (font-lock-mode -1)
4232 (font-lock-mode 1)))
4234 (defun org-all-targets (&optional radio)
4235 "Return a list of all targets in this file.
4236 With optional argument RADIO, only find radio targets."
4237 (let ((re (if radio org-radio-target-regexp org-target-regexp))
4238 rtn)
4239 (save-excursion
4240 (goto-char (point-min))
4241 (while (re-search-forward re nil t)
4242 (add-to-list 'rtn (downcase (org-match-string-no-properties 1))))
4243 rtn)))
4245 (defun org-make-target-link-regexp (targets)
4246 "Make regular expression matching all strings in TARGETS.
4247 The regular expression finds the targets also if there is a line break
4248 between words."
4249 (and targets
4250 (concat
4252 (mapconcat
4253 (lambda (x)
4254 (while (string-match " +" x)
4256 x)
4257 targets
4261 (defun org-activate-tags (limit)
4263 (progn
4264 (add-text-properties (match-beginning 1) (match-end 1)
4265 (list 'mouse-face 'highlight
4266 'rear-nonsticky org-nonsticky-props
4267 'keymap org-mouse-map))
4268 t)))
4270 (defun org-outline-level ()
4271 (save-excursion
4272 (looking-at outline-regexp)
4273 (if (match-beginning 1)
4274 (+ (org-get-string-indentation (match-string 1)) 1000)
4275 (1- (- (match-end 0) (match-beginning 0))))))
4277 (defvar org-font-lock-keywords nil)
4279 (defconst org-property-re (org-re "^[ \t]*\\(:\\([-[:alnum:]_]+\\):\\)[ \t]*\\([^ \t\r\n].*\\)")
4280 "Regular expression matching a property line.")
4282 (defvar org-font-lock-hook nil
4283 "Functions to be called for special font lock stuff.")
4285 (defun org-font-lock-hook (limit)
4286 (run-hook-with-args 'org-font-lock-hook limit))
4288 (defun org-set-font-lock-defaults ()
4289 (let* ((em org-fontify-emphasized-text)
4290 (lk org-activate-links)
4291 (org-font-lock-extra-keywords
4292 (list
4293 ;; Call the hook
4294 '(org-font-lock-hook)
4295 ;; Headlines
4297 (2 (org-get-level-face 2)) (3 (org-get-level-face 3)))
4298 ;; Table lines
4300 (1 'org-table t))
4301 ;; Table internals
4305 ;; Drawers
4306 (list org-drawer-regexp '(0 'org-special-keyword t))
4308 ;; Properties
4309 (list org-property-re
4310 '(1 'org-special-keyword t)
4311 '(3 'org-property-value t))
4312 (if org-format-transports-properties-p
4314 ;; Links
4315 (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
4316 (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t)))
4317 (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t)))
4318 (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t)))
4319 (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t)))
4320 (if (memq 'date lk) '(org-activate-dates (0 'org-date t)))
4321 (if (memq 'footnote lk) '(org-activate-footnote-links
4322 (2 'org-footnote t)))
4324 '(org-hide-wide-columns (0 nil append))
4325 ;; TODO lines
4327 '(1 (org-get-todo-face 1) t))
4328 ;; DONE
4329 (if org-fontify-done-headline
4333 '(2 'org-headline-done t))
4334 nil)
4335 ;; Priorities
4336 '(org-font-lock-add-priority-faces)
4337 ;; Tags
4338 '(org-font-lock-add-tag-faces)
4339 ;; Special keywords
4344 ;; Emphasis
4345 (if em
4346 (if (featurep 'xemacs)
4347 '(org-do-emphasis-faces (0 nil append))
4348 '(org-do-emphasis-faces)))
4349 ;; Checkboxes
4351 2 'bold prepend)
4352 (if org-provide-checkbox-statistics
4354 (0 (org-get-checkbox-statistics-face) t)))
4355 ;; Description list items
4357 2 'bold prepend)
4359 '(1 'org-archived prepend))
4360 ;; Specials
4361 '(org-do-latex-and-special-faces)
4362 ;; Code
4363 '(org-activate-code (1 'org-code t))
4364 ;; COMMENT
4367 '(1 'org-special-keyword t))
4368 '("^#.*" (0 'font-lock-comment-face t))
4369 )))
4370 (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
4371 ;; Now set the full font-lock-keywords
4372 (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords)
4373 (org-set-local 'font-lock-defaults
4374 '(org-font-lock-keywords t nil nil backward-paragraph))
4375 (kill-local-variable 'font-lock-keywords) nil))
4377 (defvar org-m nil)
4378 (defvar org-l nil)
4379 (defvar org-f nil)
4380 (defun org-get-level-face (n)
4381 "Get the right face for match N in font-lock matching of headlines."
4382 (setq org-l (- (match-end 2) (match-beginning 1) 1))
4383 (if org-odd-levels-only (setq org-l (1+ (/ org-l 2))))
4384 (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces))
4385 (cond
4386 ((eq n 1) (if org-hide-leading-stars 'org-hide org-f))
4387 ((eq n 2) org-f)
4388 (t (if org-level-color-stars-only nil org-f))))
4390 (defun org-get-todo-face (kwd)
4391 "Get the right face for a TODO keyword KWD.
4392 If KWD is a number, get the corresponding match group."
4393 (if (numberp kwd) (setq kwd (match-string kwd)))
4394 (or (cdr (assoc kwd org-todo-keyword-faces))
4395 (and (member kwd org-done-keywords) 'org-done)
4396 'org-todo))
4398 (defun org-font-lock-add-tag-faces (limit)
4399 "Add the special tag faces."
4400 (when (and org-tag-faces org-tags-special-faces-re)
4401 (while (re-search-forward org-tags-special-faces-re limit t)
4402 (add-text-properties (match-beginning 1) (match-end 1)
4403 (list 'face (org-get-tag-face 1)
4404 'font-lock-fontified t))
4405 (backward-char 1))))
4407 (defun org-font-lock-add-priority-faces (limit)
4408 "Add the special priority faces."
4410 (add-text-properties
4411 (match-beginning 0) (match-end 0)
4412 (list 'face (or (cdr (assoc (char-after (match-beginning 1))
4413 org-priority-faces))
4414 'org-special-keyword)
4415 'font-lock-fontified t))))
4417 (defun org-get-tag-face (kwd)
4418 "Get the right face for a TODO keyword KWD.
4419 If KWD is a number, get the corresponding match group."
4420 (if (numberp kwd) (setq kwd (match-string kwd)))
4421 (or (cdr (assoc kwd org-tag-faces))
4422 'org-tag))
4424 (defun org-unfontify-region (beg end &optional maybe_loudly)
4425 "Remove fontification and activation overlays from links."
4426 (font-lock-default-unfontify-region beg end)
4427 (let* ((buffer-undo-list t)
4428 (inhibit-read-only t) (inhibit-point-motion-hooks t)
4429 (inhibit-modification-hooks t)
4430 deactivate-mark buffer-file-name buffer-file-truename)
4431 (remove-text-properties beg end
4432 '(mouse-face t keymap t org-linked-text t
4433 invisible t intangible t))))
4435 ;;;; Visibility cycling, including org-goto and indirect buffer
4437 ;;; Cycling
4439 (defvar org-cycle-global-status nil)
4440 (make-variable-buffer-local 'org-cycle-global-status)
4441 (defvar org-cycle-subtree-status nil)
4442 (make-variable-buffer-local 'org-cycle-subtree-status)
4444 ;;;###autoload
4445 (defun org-cycle (&optional arg)
4446 "Visibility cycling for Org-mode.
4448 - When this function is called with a prefix argument, rotate the entire
4449 buffer through 3 states (global cycling)
4450 1. OVERVIEW: Show only top-level headlines.
4451 2. CONTENTS: Show all headlines of all levels, but no body text.
4452 3. SHOW ALL: Show everything.
4453 When called with two C-u C-u prefixes, switch to the startup visibility,
4454 determined by the variable `org-startup-folded', and by any VISIBILITY
4455 properties in the buffer.
4456 When called with three C-u C-u C-u prefixed, show the entire buffer,
4457 including drawers.
4459 - When point is at the beginning of a headline, rotate the subtree started
4460 by this line through 3 different states (local cycling)
4461 1. FOLDED: Only the main headline is shown.
4462 2. CHILDREN: The main headline and the direct children are shown.
4463 From this state, you can move to one of the children
4464 and zoom in further.
4465 3. SUBTREE: Show the entire subtree, including body text.
4467 - When there is a numeric prefix, go up to a heading with level ARG, do
4468 a `show-subtree' and return to the previous cursor position. If ARG
4469 is negative, go up that many levels.
4471 - When point is not at the beginning of a headline, execute the global
4472 binding for TAB, which is re-indenting the line. See the option
4473 `org-cycle-emulate-tab' for details.
4475 - Special case: if point is at the beginning of the buffer and there is
4476 no headline in line 1, this function will act as if called with prefix arg.
4477 But only if also the variable `org-cycle-global-at-bob' is t."
4478 (interactive "P")
4479 (org-load-modules-maybe)
4480 (let* ((outline-regexp
4481 (if (and (org-mode-p) org-cycle-include-plain-lists)
4483 outline-regexp))
4484 (bob-special (and org-cycle-global-at-bob (bobp)
4485 (not (looking-at outline-regexp))))
4486 (org-cycle-hook
4487 (if bob-special
4488 (delq 'org-optimize-window-after-visibility-change
4489 (copy-sequence org-cycle-hook))
4490 org-cycle-hook))
4491 (pos (point)))
4493 (if (or bob-special (equal arg '(4)))
4494 ;; special case: use global cycling
4495 (setq arg t))
4497 (cond
4499 ((equal arg '(16))
4500 (org-set-startup-visibility)
4501 (message "Startup visibility, plus VISIBILITY properties"))
4503 ((equal arg '(64))
4504 (show-all)
4505 (message "Entire buffer visible, including drawers"))
4507 ((org-at-table-p 'any)
4508 ;; Enter the table or move to the next field in the table
4509 (or (org-table-recognize-table.el)
4510 (progn
4511 (if arg (org-table-edit-field t)
4512 (org-table-justify-field-maybe)
4513 (call-interactively 'org-table-next-field)))))
4515 ((eq arg t) ;; Global cycling
4517 (cond
4518 ((and (eq last-command this-command)
4519 (eq org-cycle-global-status 'overview))
4520 ;; We just created the overview - now do table of contents
4521 ;; This can be slow in very large buffers, so indicate action
4522 (message "CONTENTS...")
4523 (org-content)
4524 (message "CONTENTS...done")
4525 (setq org-cycle-global-status 'contents)
4526 (run-hook-with-args 'org-cycle-hook 'contents))
4528 ((and (eq last-command this-command)
4529 (eq org-cycle-global-status 'contents))
4530 ;; We just showed the table of contents - now show everything
4531 (show-all)
4532 (message "SHOW ALL")
4533 (setq org-cycle-global-status 'all)
4534 (run-hook-with-args 'org-cycle-hook 'all))
4536 (t
4537 ;; Default action: go to overview
4538 (org-overview)
4539 (message "OVERVIEW")
4540 (setq org-cycle-global-status 'overview)
4541 (run-hook-with-args 'org-cycle-hook 'overview))))
4543 ((and org-drawers org-drawer-regexp
4544 (save-excursion
4545 (beginning-of-line 1)
4546 (looking-at org-drawer-regexp)))
4547 ;; Toggle block visibility
4548 (org-flag-drawer
4549 (not (get-char-property (match-end 0) 'invisible))))
4551 ((integerp arg)
4552 ;; Show-subtree, ARG levels up from here.
4553 (save-excursion
4554 (org-back-to-heading)
4555 (outline-up-heading (if (< arg 0) (- arg)
4556 (- (funcall outline-level) arg)))
4557 (org-show-subtree)))
4559 ((and (save-excursion (beginning-of-line 1) (looking-at outline-regexp))
4560 (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
4561 ;; At a heading: rotate between three different views
4562 (org-back-to-heading)
4563 (let ((goal-column 0) eoh eol eos)
4564 ;; First, some boundaries
4565 (save-excursion
4566 (org-back-to-heading)
4567 (save-excursion
4568 (beginning-of-line 2)
4569 (while (and (not (eobp)) ;; this is like `next-line'
4570 (get-char-property (1- (point)) 'invisible))
4571 (beginning-of-line 2)) (setq eol (point)))
4572 (outline-end-of-heading) (setq eoh (point))
4573 (org-end-of-subtree t)
4574 (unless (eobp)
4576 (beginning-of-line 1) ; in case this is an item
4577 )
4578 (setq eos (1- (point))))
4579 ;; Find out what to do next and set `this-command'
4580 (cond
4581 ((= eos eoh)
4582 ;; Nothing is hidden behind this heading
4583 (message "EMPTY ENTRY")
4584 (setq org-cycle-subtree-status nil)
4585 (save-excursion
4586 (goto-char eos)
4587 (outline-next-heading)
4588 (if (org-invisible-p) (org-flag-heading nil))))
4589 ((or (>= eol eos)
4591 ;; Entire subtree is hidden in one line: open it
4592 (org-show-entry)
4593 (show-children)
4594 (message "CHILDREN")
4595 (save-excursion
4596 (goto-char eos)
4597 (outline-next-heading)
4598 (if (org-invisible-p) (org-flag-heading nil)))
4599 (setq org-cycle-subtree-status 'children)
4600 (run-hook-with-args 'org-cycle-hook 'children))
4601 ((and (eq last-command this-command)
4602 (eq org-cycle-subtree-status 'children))
4603 ;; We just showed the children, now show everything.
4604 (org-show-subtree)
4605 (message "SUBTREE")
4606 (setq org-cycle-subtree-status 'subtree)
4607 (run-hook-with-args 'org-cycle-hook 'subtree))
4608 (t
4609 ;; Default action: hide the subtree.
4610 (hide-subtree)
4611 (message "FOLDED")
4612 (setq org-cycle-subtree-status 'folded)
4613 (run-hook-with-args 'org-cycle-hook 'folded)))))
4615 ;; TAB emulation and template completion
4616 (buffer-read-only (org-back-to-heading))
4618 ((org-try-structure-completion))
4620 ((org-try-cdlatex-tab))
4622 ((and (eq org-cycle-emulate-tab 'exc-hl-bol)
4623 (or (not (bolp))
4624 (not (looking-at outline-regexp))))
4627 ((if (and (memq org-cycle-emulate-tab '(white whitestart))
4629 (or (and (eq org-cycle-emulate-tab 'white)
4630 (= (match-end 0) (point-at-eol)))
4631 (and (eq org-cycle-emulate-tab 'whitestart)
4632 (>= (match-end 0) pos))))
4633 t
4634 (eq org-cycle-emulate-tab t))
4637 (t (save-excursion
4638 (org-back-to-heading)
4639 (org-cycle))))))
4641 ;;;###autoload
4642 (defun org-global-cycle (&optional arg)
4643 "Cycle the global visibility. For details see `org-cycle'.
4644 With C-u prefix arg, switch to startup visibility.
4645 With a numeric prefix, show all headlines up to that level."
4646 (interactive "P")
4647 (let ((org-cycle-include-plain-lists
4648 (if (org-mode-p) org-cycle-include-plain-lists nil)))
4649 (cond
4650 ((integerp arg)
4651 (show-all)
4652 (hide-sublevels arg)
4653 (setq org-cycle-global-status 'contents))
4654 ((equal arg '(4))
4655 (org-set-startup-visibility)
4656 (message "Startup visibility, plus VISIBILITY properties."))
4657 (t
4658 (org-cycle '(4))))))
4660 (defun org-set-startup-visibility ()
4661 "Set the visibility required by startup options and properties."
4662 (cond
4663 ((eq org-startup-folded t)
4664 (org-cycle '(4)))
4665 ((eq org-startup-folded 'content)
4666 (let ((this-command 'org-cycle) (last-command 'org-cycle))
4667 (org-cycle '(4)) (org-cycle '(4)))))
4668 (org-set-visibility-according-to-property 'no-cleanup)
4669 (org-cycle-hide-archived-subtrees 'all)
4670 (org-cycle-hide-drawers 'all)
4671 (org-cycle-show-empty-lines 'all))
4673 (defun org-set-visibility-according-to-property (&optional no-cleanup)
4674 "Switch subtree visibilities according to :VISIBILITY: property."
4675 (interactive)
4676 (let (org-show-entry-below state)
4677 (save-excursion
4678 (goto-char (point-min))
4679 (while (re-search-forward
4681 nil t)
4682 (setq state (match-string 1))
4683 (save-excursion
4684 (org-back-to-heading t)
4685 (hide-subtree)
4686 (org-reveal)
4687 (cond
4688 ((equal state '("fold" "folded"))
4689 (hide-subtree))
4690 ((equal state "children")
4691 (org-show-hidden-entry)
4692 (show-children))
4693 ((equal state "content")
4694 (save-excursion
4695 (save-restriction
4696 (org-narrow-to-subtree)
4697 (org-content))))
4698 ((member state '("all" "showall"))
4699 (show-subtree)))))
4700 (unless no-cleanup
4701 (org-cycle-hide-archived-subtrees 'all)
4702 (org-cycle-hide-drawers 'all)
4703 (org-cycle-show-empty-lines 'all)))))
4705 (defun org-overview ()
4706 "Switch to overview mode, showing only top-level headlines.
4707 Really, this shows all headlines with level equal or greater than the level
4708 of the first headline in the buffer. This is important, because if the
4709 first headline is not level one, then (hide-sublevels 1) gives confusing
4710 results."
4711 (interactive)
4712 (let ((level (save-excursion
4713 (goto-char (point-min))
4714 (if (re-search-forward (concat "^" outline-regexp) nil t)
4715 (progn
4716 (goto-char (match-beginning 0))
4717 (funcall outline-level))))))
4718 (and level (hide-sublevels level))))
4720 (defun org-content (&optional arg)
4721 "Show all headlines in the buffer, like a table of contents.
4722 With numerical argument N, show content up to level N."
4723 (interactive "P")
4724 (save-excursion
4725 ;; Visit all headings and show their offspring
4726 (and (integerp arg) (org-overview))
4727 (goto-char (point-max))
4728 (catch 'exit
4729 (while (and (progn (condition-case nil
4730 (outline-previous-visible-heading 1)
4731 (error (goto-char (point-min))))
4732 t)
4733 (looking-at outline-regexp))
4734 (if (integerp arg)
4735 (show-children (1- arg))
4736 (show-branches))
4737 (if (bobp) (throw 'exit nil))))))
4740 (defun org-optimize-window-after-visibility-change (state)
4741 "Adjust the window after a change in outline visibility.
4742 This function is the default value of the hook `org-cycle-hook'."
4743 (when (get-buffer-window (current-buffer))
4744 (cond
4745 ((eq state 'content) nil)
4746 ((eq state 'all) nil)
4747 ((eq state 'folded) nil)
4748 ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1)))
4749 ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1))))))
4751 (defun org-compact-display-after-subtree-move ()
4752 "Show a compacter version of the tree of the entry's parent."
4753 (save-excursion
4754 (if (org-up-heading-safe)
4755 (progn
4756 (hide-subtree)
4757 (show-entry)
4758 (show-children)
4759 (org-cycle-show-empty-lines 'children)
4760 (org-cycle-hide-drawers 'children))
4761 (org-overview))))
4763 (defun org-cycle-show-empty-lines (state)
4764 "Show empty lines above all visible headlines.
4765 The region to be covered depends on STATE when called through
4766 `org-cycle-hook'. Lisp program can use t for STATE to get the
4767 entire buffer covered. Note that an empty line is only shown if there
4768 are at least `org-cycle-separator-lines' empty lines before the headline."
4769 (when (> org-cycle-separator-lines 0)
4770 (save-excursion
4771 (let* ((n org-cycle-separator-lines)
4772 (re (cond
4775 (t (let ((ns (number-to-string (- n 2))))
4778 beg end)
4779 (cond
4780 ((memq state '(overview contents t))
4781 (setq beg (point-min) end (point-max)))
4782 ((memq state '(children folded))
4783 (setq beg (point) end (progn (org-end-of-subtree t t)
4784 (beginning-of-line 2)
4785 (point)))))
4786 (when beg
4787 (goto-char beg)
4788 (while (re-search-forward re end t)
4789 (if (not (get-char-property (match-end 1) 'invisible))
4790 (outline-flag-region
4791 (match-beginning 1) (match-end 1) nil)))))))
4792 ;; Never hide empty lines at the end of the file.
4793 (save-excursion
4794 (goto-char (point-max))
4795 (outline-previous-heading)
4796 (outline-end-of-heading)
4798 (= (match-end 0) (point-max)))
4799 (outline-flag-region (point) (match-end 0) nil))))
4801 (defun org-show-empty-lines-in-parent ()
4802 "Move to the parent and re-show empty lines before visible headlines."
4803 (save-excursion
4804 (let ((context (if (org-up-heading-safe) 'children 'overview)))
4805 (org-cycle-show-empty-lines context))))
4807 (defun org-cycle-hide-drawers (state)
4808 "Re-hide all drawers after a visibility state change."
4809 (when (and (org-mode-p)
4810 (not (memq state '(overview folded))))
4811 (save-excursion
4812 (let* ((globalp (memq state '(contents all)))
4813 (beg (if globalp (point-min) (point)))
4814 (end (if globalp (point-max) (org-end-of-subtree t))))
4815 (goto-char beg)
4816 (while (re-search-forward org-drawer-regexp end t)
4817 (org-flag-drawer t))))))
4819 (defun org-flag-drawer (flag)
4820 (save-excursion
4821 (beginning-of-line 1)
4823 (let ((b (match-end 0))
4824 (outline-regexp org-outline-regexp))
4825 (if (re-search-forward
4827 (save-excursion (outline-next-heading) (point)) t)
4828 (outline-flag-region b (point-at-eol) flag)
4829 (error ":END: line missing"))))))
4831 (defun org-subtree-end-visible-p ()
4832 "Is the end of the current subtree visible?"
4833 (pos-visible-in-window-p
4834 (save-excursion (org-end-of-subtree t) (point))))
4836 (defun org-first-headline-recenter (&optional N)
4837 "Move cursor to the first headline and recenter the headline.
4838 Optional argument N means, put the headline into the Nth line of the window."
4839 (goto-char (point-min))
4841 (beginning-of-line)
4842 (recenter (prefix-numeric-value N))))
4844 ;;; Org-goto
4846 (defvar org-goto-window-configuration nil)
4847 (defvar org-goto-marker nil)
4848 (defvar org-goto-map
4849 (let ((map (make-sparse-keymap)))
4850 (let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command mouse-drag-region universal-argument org-occur)) cmd)
4851 (while (setq cmd (pop cmds))
4852 (substitute-key-definition cmd cmd map global-map)))
4853 (suppress-keymap map)
4854 (org-defkey map "\C-m" 'org-goto-ret)
4855 (org-defkey map [(return)] 'org-goto-ret)
4856 (org-defkey map [(left)] 'org-goto-left)
4857 (org-defkey map [(right)] 'org-goto-right)
4858 (org-defkey map [(control ?g)] 'org-goto-quit)
4859 (org-defkey map "\C-i" 'org-cycle)
4860 (org-defkey map [(tab)] 'org-cycle)
4861 (org-defkey map [(down)] 'outline-next-visible-heading)
4862 (org-defkey map [(up)] 'outline-previous-visible-heading)
4863 (if org-goto-auto-isearch
4864 (if (fboundp 'define-key-after)
4865 (define-key-after map [t] 'org-goto-local-auto-isearch)
4866 nil)
4867 (org-defkey map "q" 'org-goto-quit)
4868 (org-defkey map "n" 'outline-next-visible-heading)
4869 (org-defkey map "p" 'outline-previous-visible-heading)
4870 (org-defkey map "f" 'outline-forward-same-level)
4871 (org-defkey map "b" 'outline-backward-same-level)
4872 (org-defkey map "u" 'outline-up-heading))
4873 (org-defkey map "/" 'org-occur)
4874 (org-defkey map "\C-c\C-n" 'outline-next-visible-heading)
4875 (org-defkey map "\C-c\C-p" 'outline-previous-visible-heading)
4876 (org-defkey map "\C-c\C-f" 'outline-forward-same-level)
4877 (org-defkey map "\C-c\C-b" 'outline-backward-same-level)
4878 (org-defkey map "\C-c\C-u" 'outline-up-heading)
4879 map))
4881 (defconst org-goto-help
4882 "Browse buffer copy, to find location or copy text. Just type for auto-isearch.
4883 RET=jump to location [Q]uit and return to previous location
4884 \[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur")
4886 (defvar org-goto-start-pos) ; dynamically scoped parameter
4888 ;; FIXME: Docstring doe not mention both interfaces
4889 (defun org-goto (&optional alternative-interface)
4890 "Look up a different location in the current file, keeping current visibility.
4892 When you want look-up or go to a different location in a document, the
4893 fastest way is often to fold the entire buffer and then dive into the tree.
4894 This method has the disadvantage, that the previous location will be folded,
4895 which may not be what you want.
4897 This command works around this by showing a copy of the current buffer
4898 in an indirect buffer, in overview mode. You can dive into the tree in
4899 that copy, use org-occur and incremental search to find a location.
4900 When pressing RET or `Q', the command returns to the original buffer in
4901 which the visibility is still unchanged. After RET is will also jump to
4902 the location selected in the indirect buffer and expose the
4903 the headline hierarchy above."
4904 (interactive "P")
4905 (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level))))
4906 (org-refile-use-outline-path t)
4907 (interface
4908 (if (not alternative-interface)
4909 org-goto-interface
4910 (if (eq org-goto-interface 'outline)
4911 'outline-path-completion
4912 'outline)))
4913 (org-goto-start-pos (point))
4914 (selected-point
4915 (if (eq interface 'outline)
4916 (car (org-get-location (current-buffer) org-goto-help))
4917 (nth 3 (org-refile-get-location "Goto: ")))))
4918 (if selected-point
4919 (progn
4920 (org-mark-ring-push org-goto-start-pos)
4921 (goto-char selected-point)
4922 (if (or (org-invisible-p) (org-invisible-p2))
4923 (org-show-context 'org-goto)))
4924 (message "Quit"))))
4926 (defvar org-goto-selected-point nil) ; dynamically scoped parameter
4927 (defvar org-goto-exit-command nil) ; dynamically scoped parameter
4928 (defvar org-goto-local-auto-isearch-map) ; defined below
4930 (defun org-get-location (buf help)
4931 "Let the user select a location in the Org-mode buffer BUF.
4932 This function uses a recursive edit. It returns the selected position
4933 or nil."
4934 (let ((isearch-mode-map org-goto-local-auto-isearch-map)
4935 (isearch-hide-immediately nil)
4936 (isearch-search-fun-function
4937 (lambda () 'org-goto-local-search-headings))
4938 (org-goto-selected-point org-goto-exit-command))
4939 (save-excursion
4940 (save-window-excursion
4941 (delete-other-windows)
4942 (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*"))
4943 (switch-to-buffer
4944 (condition-case nil
4945 (make-indirect-buffer (current-buffer) "*org-goto*")
4946 (error (make-indirect-buffer (current-buffer) "*org-goto*"))))
4947 (with-output-to-temp-buffer "*Help*"
4948 (princ help))
4949 (org-fit-window-to-buffer (get-buffer-window "*Help*"))
4950 (setq buffer-read-only nil)
4951 (let ((org-startup-truncated t)
4952 (org-startup-folded nil)
4953 (org-startup-align-all-tables nil))
4954 (org-mode)
4955 (org-overview))
4956 (setq buffer-read-only t)
4957 (if (and (boundp 'org-goto-start-pos)
4958 (integer-or-marker-p org-goto-start-pos))
4959 (let ((org-show-hierarchy-above t)
4960 (org-show-siblings t)
4961 (org-show-following-heading t))
4962 (goto-char org-goto-start-pos)
4963 (and (org-invisible-p) (org-show-context)))
4964 (goto-char (point-min)))
4965 (let (org-special-ctrl-a/e) (org-beginning-of-line))
4966 (message "Select location and press RET")
4967 (use-local-map org-goto-map)
4968 (recursive-edit)
4969 ))
4970 (kill-buffer "*org-goto*")
4971 (cons org-goto-selected-point org-goto-exit-command)))
4973 (defvar org-goto-local-auto-isearch-map (make-sparse-keymap))
4974 (set-keymap-parent org-goto-local-auto-isearch-map isearch-mode-map)
4975 (define-key org-goto-local-auto-isearch-map "\C-i" 'isearch-other-control-char)
4976 (define-key org-goto-local-auto-isearch-map "\C-m" 'isearch-other-control-char)
4978 (defun org-goto-local-search-headings (string bound noerror)
4979 "Search and make sure that any matches are in headlines."
4980 (catch 'return
4981 (while (if isearch-forward
4982 (search-forward string bound noerror)
4983 (search-backward string bound noerror))
4984 (when (let ((context (mapcar 'car (save-match-data (org-context)))))
4985 (and (member :headline context)
4986 (not (member :tags context))))
4987 (throw 'return (point))))))
4989 (defun org-goto-local-auto-isearch ()
4990 "Start isearch."
4991 (interactive)
4992 (goto-char (point-min))
4993 (let ((keys (this-command-keys)))
4994 (when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char)
4995 (isearch-mode t)
4996 (isearch-process-search-char (string-to-char keys)))))
4998 (defun org-goto-ret (&optional arg)
4999 "Finish `org-goto' by going to the new location."
5000 (interactive "P")
5001 (setq org-goto-selected-point (point)
5002 org-goto-exit-command 'return)
5003 (throw 'exit nil))
5005 (defun org-goto-left ()
5006 "Finish `org-goto' by going to the new location."
5007 (interactive)
5008 (if (org-on-heading-p)
5009 (progn
5010 (beginning-of-line 1)
5011 (setq org-goto-selected-point (point)
5012 org-goto-exit-command 'left)
5013 (throw 'exit nil))
5014 (error "Not on a heading")))
5016 (defun org-goto-right ()
5017 "Finish `org-goto' by going to the new location."
5018 (interactive)
5019 (if (org-on-heading-p)
5020 (progn
5021 (setq org-goto-selected-point (point)
5022 org-goto-exit-command 'right)
5023 (throw 'exit nil))
5024 (error "Not on a heading")))
5026 (defun org-goto-quit ()
5027 "Finish `org-goto' without cursor motion."
5028 (interactive)
5029 (setq org-goto-selected-point nil)
5030 (setq org-goto-exit-command 'quit)
5031 (throw 'exit nil))
5033 ;;; Indirect buffer display of subtrees
5035 (defvar org-indirect-dedicated-frame nil
5036 "This is the frame being used for indirect tree display.")
5037 (defvar org-last-indirect-buffer nil)
5039 (defun org-tree-to-indirect-buffer (&optional arg)
5040 "Create indirect buffer and narrow it to current subtree.
5041 With numerical prefix ARG, go up to this level and then take that tree.
5042 If ARG is negative, go up that many levels.
5043 If `org-indirect-buffer-display' is not `new-frame', the command removes the
5044 indirect buffer previously made with this command, to avoid proliferation of
5045 indirect buffers. However, when you call the command with a `C-u' prefix, or
5046 when `org-indirect-buffer-display' is `new-frame', the last buffer
5047 is kept so that you can work with several indirect buffers at the same time.
5048 If `org-indirect-buffer-display' is `dedicated-frame', the C-u prefix also
5049 requests that a new frame be made for the new buffer, so that the dedicated
5050 frame is not changed."
5051 (interactive "P")
5052 (let ((cbuf (current-buffer))
5053 (cwin (selected-window))
5054 (pos (point))
5055 beg end level heading ibuf)
5056 (save-excursion
5057 (org-back-to-heading t)
5058 (when (numberp arg)
5059 (setq level (org-outline-level))
5060 (if (< arg 0) (setq arg (+ level arg)))
5061 (while (> (setq level (org-outline-level)) arg)
5062 (outline-up-heading 1 t)))
5063 (setq beg (point)
5064 heading (org-get-heading))
5065 (org-end-of-subtree t) (setq end (point)))
5066 (if (and (buffer-live-p org-last-indirect-buffer)
5067 (not (eq org-indirect-buffer-display 'new-frame))
5068 (not arg))
5069 (kill-buffer org-last-indirect-buffer))
5070 (setq ibuf (org-get-indirect-buffer cbuf)
5071 org-last-indirect-buffer ibuf)
5072 (cond
5073 ((or (eq org-indirect-buffer-display 'new-frame)
5074 (and arg (eq org-indirect-buffer-display 'dedicated-frame)))
5075 (select-frame (make-frame))
5076 (delete-other-windows)
5077 (switch-to-buffer ibuf)
5078 (org-set-frame-title heading))
5079 ((eq org-indirect-buffer-display 'dedicated-frame)
5080 (raise-frame
5081 (select-frame (or (and org-indirect-dedicated-frame
5082 (frame-live-p org-indirect-dedicated-frame)
5083 org-indirect-dedicated-frame)
5084 (setq org-indirect-dedicated-frame (make-frame)))))
5085 (delete-other-windows)
5086 (switch-to-buffer ibuf)
5087 (org-set-frame-title (concat "Indirect: " heading)))
5088 ((eq org-indirect-buffer-display 'current-window)
5089 (switch-to-buffer ibuf))
5090 ((eq org-indirect-buffer-display 'other-window)
5091 (pop-to-buffer ibuf))
5092 (t (error "Invalid value.")))
5093 (if (featurep 'xemacs)
5094 (save-excursion (org-mode) (turn-on-font-lock)))
5095 (narrow-to-region beg end)
5096 (show-all)
5097 (goto-char pos)
5098 (and (window-live-p cwin) (select-window cwin))))
5100 (defun org-get-indirect-buffer (&optional buffer)
5101 (setq buffer (or buffer (current-buffer)))
5102 (let ((n 1) (base (buffer-name buffer)) bname)
5103 (while (buffer-live-p
5104 (get-buffer (setq bname (concat base "-" (number-to-string n)))))
5105 (setq n (1+ n)))
5106 (condition-case nil
5107 (make-indirect-buffer buffer bname 'clone)
5108 (error (make-indirect-buffer buffer bname)))))
5110 (defun org-set-frame-title (title)
5111 "Set the title of the current frame to the string TITLE."
5112 ;; FIXME: how to name a single frame in XEmacs???
5113 (unless (featurep 'xemacs)
5114 (modify-frame-parameters (selected-frame) (list (cons 'name title)))))
5116 ;;;; Structure editing
5118 ;;; Inserting headlines
5120 (defun org-previous-line-empty-p ()
5121 (save-excursion
5122 (and (not (bobp))
5123 (or (beginning-of-line 0) t)
5124 (save-match-data
5127 (defun org-insert-heading (&optional force-heading)
5128 "Insert a new heading or item with same depth at point.
5129 If point is in a plain list and FORCE-HEADING is nil, create a new list item.
5130 If point is at the beginning of a headline, insert a sibling before the
5131 current headline. If point is not at the beginning, do not split the line,
5132 but create the new headline after the current line."
5133 (interactive "P")
5134 (if (= (buffer-size) 0)
5136 (when (or force-heading (not (org-insert-item)))
5137 (let* ((empty-line-p nil)
5138 (head (save-excursion
5139 (condition-case nil
5140 (progn
5141 (org-back-to-heading)
5142 (setq empty-line-p (org-previous-line-empty-p))
5143 (match-string 0))
5144 (error "*"))))
5145 (blank-a (cdr (assq 'heading org-blank-before-new-entry)))
5146 (blank (if (eq blank-a 'auto) empty-line-p blank-a))
5147 pos hide-previous previous-pos)
5148 (cond
5149 ((and (org-on-heading-p) (bolp)
5150 (or (bobp)
5151 (save-excursion (backward-char 1) (not (org-invisible-p)))))
5152 ;; insert before the current line
5153 (open-line (if blank 2 1)))
5154 ((and (bolp)
5155 (or (bobp)
5156 (save-excursion
5157 (backward-char 1) (not (org-invisible-p)))))
5158 ;; insert right here
5159 nil)
5160 (t
5161 ;; somewhere in the line
5162 (save-excursion
5163 (setq previous-pos (point-at-bol))
5164 (end-of-line)
5165 (setq hide-previous (org-invisible-p)))
5166 (and org-insert-heading-respect-content (org-show-subtree))
5167 (let ((split
5168 (and (org-get-alist-option org-M-RET-may-split-line 'headline)
5169 (save-excursion
5170 (let ((p (point)))
5171 (goto-char (point-at-bol))
5172 (and (looking-at org-complex-heading-regexp)
5173 (> p (match-beginning 4)))))))
5174 tags pos)
5175 (cond
5176 (org-insert-heading-respect-content
5177 (org-end-of-subtree nil t)
5178 (or (bolp) (newline))
5179 (or (org-previous-line-empty-p)
5180 (and blank (newline)))
5181 (open-line 1))
5182 ((org-on-heading-p)
5183 (when hide-previous
5184 (show-children)
5185 (org-show-entry))
5187 (setq tags (and (match-end 2) (match-string 2)))
5188 (and (match-end 1)
5189 (delete-region (match-beginning 1) (match-end 1)))
5190 (setq pos (point-at-bol))
5191 (or split (end-of-line 1))
5192 (delete-horizontal-space)
5193 (newline (if blank 2 1))
5194 (when tags
5195 (save-excursion
5196 (goto-char pos)
5197 (end-of-line 1)
5198 (insert " " tags)
5199 (org-set-tags nil 'align))))
5200 (t
5201 (or split (end-of-line 1))
5202 (newline (if blank 2 1)))))))
5203 (insert head) (just-one-space)
5204 (setq pos (point))
5205 (end-of-line 1)
5206 (unless (= (point) pos) (just-one-space) (backward-delete-char 1))
5207 (when (and org-insert-heading-respect-content hide-previous)
5208 (save-excursion
5209 (goto-char previous-pos)
5210 (hide-subtree)))
5211 (run-hooks 'org-insert-heading-hook)))))
5213 (defun org-get-heading (&optional no-tags)
5214 "Return the heading of the current entry, without the stars."
5215 (save-excursion
5216 (org-back-to-heading t)
5217 (if (looking-at
5218 (if no-tags
5221 (match-string 1) "")))
5223 (defun org-heading-components ()
5224 "Return the components of the current heading.
5225 This is a list with the following elements:
5226 - the level as an integer
5227 - the reduced level, different if `org-odd-levels-only' is set.
5228 - the TODO keyword, or nil
5229 - the priority character, like ?A, or nil if no priority is given
5230 - the headline text itself, or the tags string if no headline text
5231 - the tags string, or nil."
5232 (save-excursion
5233 (org-back-to-heading t)
5234 (if (looking-at org-complex-heading-regexp)
5235 (list (length (match-string 1))
5236 (org-reduced-level (length (match-string 1)))
5237 (org-match-string-no-properties 2)
5238 (and (match-end 3) (aref (match-string 3) 2))
5239 (org-match-string-no-properties 4)
5240 (org-match-string-no-properties 5)))))
5242 (defun org-insert-heading-after-current ()
5243 "Insert a new heading with same level as current, after current subtree."
5244 (interactive)
5245 (org-back-to-heading)
5246 (org-insert-heading)
5247 (org-move-subtree-down)
5248 (end-of-line 1))
5250 (defun org-insert-heading-respect-content ()
5251 (interactive)
5252 (let ((org-insert-heading-respect-content t))
5253 (org-insert-heading t)))
5255 (defun org-insert-todo-heading-respect-content (&optional force-state)
5256 (interactive "P")
5257 (let ((org-insert-heading-respect-content t))
5258 (org-insert-todo-heading force-state t)))
5260 (defun org-insert-todo-heading (arg &optional force-heading)
5261 "Insert a new heading with the same level and TODO state as current heading.
5262 If the heading has no TODO state, or if the state is DONE, use the first
5263 state (TODO by default). Also with prefix arg, force first state."
5264 (interactive "P")
5265 (when (or force-heading (not (org-insert-item 'checkbox)))
5266 (org-insert-heading force-heading)
5267 (save-excursion
5268 (org-back-to-heading)
5269 (outline-previous-heading)
5270 (looking-at org-todo-line-regexp))
5271 (let*
5272 ((new-mark-x
5273 (if (or arg
5274 (not (match-beginning 2))
5275 (member (match-string 2) org-done-keywords))
5276 (car org-todo-keywords-1)
5277 (match-string 2)))
5278 (new-mark
5279 (or
5280 (run-hook-with-args-until-success
5281 'org-todo-get-default-hook new-mark-x nil)
5282 new-mark-x)))
5283 (insert new-mark " "))
5284 (when org-provide-todo-statistics
5285 (org-update-parent-todo-statistics))))
5287 (defun org-insert-subheading (arg)
5288 "Insert a new subheading and demote it.
5289 Works for outline headings and for plain lists alike."
5290 (interactive "P")
5291 (org-insert-heading arg)
5292 (cond
5293 ((org-on-heading-p) (org-do-demote))
5294 ((org-at-item-p) (org-indent-item 1))))
5296 (defun org-insert-todo-subheading (arg)
5297 "Insert a new subheading with TODO keyword or checkbox and demote it.
5298 Works for outline headings and for plain lists alike."
5299 (interactive "P")
5300 (org-insert-todo-heading arg)
5301 (cond
5302 ((org-on-heading-p) (org-do-demote))
5303 ((org-at-item-p) (org-indent-item 1))))
5305 ;;; Promotion and Demotion
5307 (defun org-promote-subtree ()
5308 "Promote the entire subtree.
5309 See also `org-promote'."
5310 (interactive)
5311 (save-excursion
5312 (org-map-tree 'org-promote))
5313 (org-fix-position-after-promote))
5315 (defun org-demote-subtree ()
5316 "Demote the entire subtree. See `org-demote'.
5317 See also `org-promote'."
5318 (interactive)
5319 (save-excursion
5320 (org-map-tree 'org-demote))
5321 (org-fix-position-after-promote))
5324 (defun org-do-promote ()
5325 "Promote the current heading higher up the tree.
5326 If the region is active in `transient-mark-mode', promote all headings
5327 in the region."
5328 (interactive)
5329 (save-excursion
5330 (if (org-region-active-p)
5331 (org-map-region 'org-promote (region-beginning) (region-end))
5332 (org-promote)))
5333 (org-fix-position-after-promote))
5335 (defun org-do-demote ()
5336 "Demote the current heading lower down the tree.
5337 If the region is active in `transient-mark-mode', demote all headings
5338 in the region."
5339 (interactive)
5340 (save-excursion
5341 (if (org-region-active-p)
5342 (org-map-region 'org-demote (region-beginning) (region-end))
5343 (org-demote)))
5344 (org-fix-position-after-promote))
5346 (defun org-fix-position-after-promote ()
5347 "Make sure that after pro/demotion cursor position is right."
5348 (let ((pos (point)))
5349 (when (save-excursion
5350 (beginning-of-line 1)
5351 (looking-at org-todo-line-regexp)
5352 (or (equal pos (match-end 1)) (equal pos (match-end 2))))
5353 (cond ((eobp) (insert " "))
5354 ((eolp) (insert " "))
5355 ((equal (char-after) ?\ ) (forward-char 1))))))
5357 (defun org-reduced-level (l)
5358 "Compute the effective level of a heading.
5359 This takes into account the setting of `org-odd-levels-only'."
5360 (if org-odd-levels-only (1+ (floor (/ l 2))) l))
5362 (defun org-get-valid-level (level &optional change)
5363 "Rectify a level change under the influence of `org-odd-levels-only'
5364 LEVEL is a current level, CHANGE is by how much the level should be
5365 modified. Even if CHANGE is nil, LEVEL may be returned modified because
5366 even level numbers will become the next higher odd number."
5367 (if org-odd-levels-only
5368 (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2))))
5369 ((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2))))
5370 ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2))))))
5371 (max 1 (+ level (or change 0)))))
5373 (if (boundp 'define-obsolete-function-alias)
5374 (if (or (featurep 'xemacs) (< emacs-major-version 23))
5375 (define-obsolete-function-alias 'org-get-legal-level
5376 'org-get-valid-level)
5377 (define-obsolete-function-alias 'org-get-legal-level
5378 'org-get-valid-level "23.1")))
5380 (defun org-promote ()
5381 "Promote the current heading higher up the tree.
5382 If the region is active in `transient-mark-mode', promote all headings
5383 in the region."
5384 (org-back-to-heading t)
5385 (let* ((level (save-match-data (funcall outline-level)))
5386 (up-head (concat (make-string (org-get-valid-level level -1) ?*) " "))
5387 (diff (abs (- level (length up-head) -1))))
5388 (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary"))
5389 (replace-match up-head nil t)
5390 ;; Fixup tag positioning
5391 (and org-auto-align-tags (org-set-tags nil t))
5392 (if org-adapt-indentation (org-fixup-indentation (- diff)))))
5394 (defun org-demote ()
5395 "Demote the current heading lower down the tree.
5396 If the region is active in `transient-mark-mode', demote all headings
5397 in the region."
5398 (org-back-to-heading t)
5399 (let* ((level (save-match-data (funcall outline-level)))
5400 (down-head (concat (make-string (org-get-valid-level level 1) ?*) " "))
5401 (diff (abs (- level (length down-head) -1))))
5402 (replace-match down-head nil t)
5403 ;; Fixup tag positioning
5404 (and org-auto-align-tags (org-set-tags nil t))
5405 (if org-adapt-indentation (org-fixup-indentation diff))))
5407 (defun org-map-tree (fun)
5408 "Call FUN for every heading underneath the current one."
5409 (org-back-to-heading)
5410 (let ((level (funcall outline-level)))
5411 (save-excursion
5412 (funcall fun)
5413 (while (and (progn
5414 (outline-next-heading)
5415 (> (funcall outline-level) level))
5416 (not (eobp)))
5417 (funcall fun)))))
5419 (defun org-map-region (fun beg end)
5420 "Call FUN for every heading between BEG and END."
5421 (let ((org-ignore-region t))
5422 (save-excursion
5423 (setq end (copy-marker end))
5424 (goto-char beg)
5425 (if (and (re-search-forward (concat "^" outline-regexp) nil t)
5426 (< (point) end))
5427 (funcall fun))
5428 (while (and (progn
5429 (outline-next-heading)
5430 (< (point) end))
5431 (not (eobp)))
5432 (funcall fun)))))
5434 (defun org-fixup-indentation (diff)
5435 "Change the indentation in the current entry by DIFF
5436 However, if any line in the current entry has no indentation, or if it
5437 would end up with no indentation after the change, nothing at all is done."
5438 (save-excursion
5439 (let ((end (save-excursion (outline-next-heading)
5440 (point-marker)))
5441 (prohibit (if (> diff 0)
5444 col)
5445 (unless (save-excursion (end-of-line 1)
5446 (re-search-forward prohibit end t))
5447 (while (and (< (point) end)
5449 (goto-char (match-end 0))
5450 (setq col (current-column))
5451 (if (< diff 0) (replace-match ""))
5452 (org-indent-to-column (+ diff col))))
5453 (move-marker end nil))))
5455 (defun org-convert-to-odd-levels ()
5456 "Convert an org-mode file with all levels allowed to one with odd levels.
5457 This will leave level 1 alone, convert level 2 to level 3, level 3 to
5458 level 5 etc."
5459 (interactive)
5460 (when (yes-or-no-p "Are you sure you want to globally change levels to odd? ")
5461 (let ((org-odd-levels-only nil) n)
5462 (save-excursion
5463 (goto-char (point-min))
5465 (setq n (- (length (match-string 0)) 2))
5466 (while (>= (setq n (1- n)) 0)
5467 (org-demote))
5468 (end-of-line 1))))))
5471 (defun org-convert-to-oddeven-levels ()
5472 "Convert an org-mode file with only odd levels to one with odd and even levels.
5473 This promotes level 3 to level 2, level 5 to level 3 etc. If the file contains a
5474 section with an even level, conversion would destroy the structure of the file. An error
5475 is signaled in this case."
5476 (interactive)
5477 (goto-char (point-min))
5478 ;; First check if there are no even levels
5480 (org-show-context t)
5481 (error "Not all levels are odd in this file. Conversion not possible."))
5482 (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ")
5483 (let ((org-odd-levels-only nil) n)
5484 (save-excursion
5485 (goto-char (point-min))
5487 (setq n (/ (1- (length (match-string 0))) 2))
5488 (while (>= (setq n (1- n)) 0)
5489 (org-promote))
5490 (end-of-line 1))))))
5492 (defun org-tr-level (n)
5493 "Make N odd if required."
5494 (if org-odd-levels-only (1+ (/ n 2)) n))
5496 ;;; Vertical tree motion, cutting and pasting of subtrees
5498 (defun org-move-subtree-up (&optional arg)
5499 "Move the current subtree up past ARG headlines of the same level."
5500 (interactive "p")
5501 (org-move-subtree-down (- (prefix-numeric-value arg))))
5503 (defun org-move-subtree-down (&optional arg)
5504 "Move the current subtree down past ARG headlines of the same level."
5505 (interactive "p")
5506 (setq arg (prefix-numeric-value arg))
5507 (let ((movfunc (if (> arg 0) 'outline-get-next-sibling
5508 'outline-get-last-sibling))
5509 (ins-point (make-marker))
5510 (cnt (abs arg))
5511 beg beg0 end txt folded ne-beg ne-end ne-ins ins-end)
5512 ;; Select the tree
5513 (org-back-to-heading)
5514 (setq beg0 (point))
5515 (save-excursion
5516 (setq ne-beg (org-back-over-empty-lines))
5517 (setq beg (point)))
5518 (save-match-data
5519 (save-excursion (outline-end-of-heading)
5520 (setq folded (org-invisible-p)))
5521 (outline-end-of-subtree))
5522 (outline-next-heading)
5523 (setq ne-end (org-back-over-empty-lines))
5524 (setq end (point))
5525 (goto-char beg0)
5526 (when (and (> arg 0) (org-first-sibling-p) (< ne-end ne-beg))
5527 ;; include less whitespace
5528 (save-excursion
5529 (goto-char beg)
5530 (forward-line (- ne-beg ne-end))
5531 (setq beg (point))))
5532 ;; Find insertion point, with error handling
5533 (while (> cnt 0)
5534 (or (and (funcall movfunc) (looking-at outline-regexp))
5535 (progn (goto-char beg0)
5536 (error "Cannot move past superior level or buffer limit")))
5537 (setq cnt (1- cnt)))
5538 (if (> arg 0)
5539 ;; Moving forward - still need to move over subtree
5540 (progn (org-end-of-subtree t t)
5541 (save-excursion
5542 (org-back-over-empty-lines)
5543 (or (bolp) (newline)))))
5544 (setq ne-ins (org-back-over-empty-lines))
5545 (move-marker ins-point (point))
5546 (setq txt (buffer-substring beg end))
5547 (org-save-markers-in-region beg end)
5548 (delete-region beg end)
5549 (or (= beg (point-min)) (outline-flag-region (1- beg) beg nil))
5550 (or (bobp) (outline-flag-region (1- (point)) (point) nil))
5551 (let ((bbb (point)))
5552 (insert-before-markers txt)
5553 (org-reinstall-markers-in-region bbb)
5554 (move-marker ins-point bbb))
5556 (setq ins-end (point))
5557 (goto-char ins-point)
5558 (org-skip-whitespace)
5559 (when (and (< arg 0)
5560 (org-first-sibling-p)
5561 (> ne-ins ne-beg))
5562 ;; Move whitespace back to beginning
5563 (save-excursion
5564 (goto-char ins-end)
5565 (let ((kill-whole-line t))
5566 (kill-line (- ne-ins ne-beg)) (point)))
5568 (move-marker ins-point nil)
5569 (org-compact-display-after-subtree-move)
5570 (org-show-empty-lines-in-parent)
5571 (unless folded
5572 (org-show-entry)
5573 (show-children)
5574 (org-cycle-hide-drawers 'children))))
5576 (defvar org-subtree-clip ""
5577 "Clipboard for cut and paste of subtrees.
5578 This is actually only a copy of the kill, because we use the normal kill
5579 ring. We need it to check if the kill was created by `org-copy-subtree'.")
5581 (defvar org-subtree-clip-folded nil
5582 "Was the last copied subtree folded?
5583 This is used to fold the tree back after pasting.")
5585 (defun org-cut-subtree (&optional n)
5586 "Cut the current subtree into the clipboard.
5587 With prefix arg N, cut this many sequential subtrees.
5588 This is a short-hand for marking the subtree and then cutting it."
5589 (interactive "p")
5590 (org-copy-subtree n 'cut))
5592 (defun org-copy-subtree (&optional n cut force-store-markers)
5593 "Cut the current subtree into the clipboard.
5594 With prefix arg N, cut this many sequential subtrees.
5595 This is a short-hand for marking the subtree and then copying it.
5596 If CUT is non-nil, actually cut the subtree.
5597 If FORCE-STORE-MARKERS is non-nil, store the relative locations
5598 of some markers in the region, even if CUT is non-nil. This is
5599 useful if the caller implements cut-and-paste as copy-then-paste-then-cut."
5600 (interactive "p")
5601 (let (beg end folded (beg0 (point)))
5602 (if (interactive-p)
5603 (org-back-to-heading nil) ; take what looks like a subtree
5604 (org-back-to-heading t)) ; take what is really there
5605 (org-back-over-empty-lines)
5606 (setq beg (point))
5608 (save-match-data
5609 (save-excursion (outline-end-of-heading)
5610 (setq folded (org-invisible-p)))
5611 (condition-case nil
5612 (outline-forward-same-level (1- n))
5613 (error nil))
5614 (org-end-of-subtree t t))
5615 (org-back-over-empty-lines)
5616 (setq end (point))
5617 (goto-char beg0)
5618 (when (> end beg)
5619 (setq org-subtree-clip-folded folded)
5620 (when (or cut force-store-markers)
5621 (org-save-markers-in-region beg end))
5622 (if cut (kill-region beg end) (copy-region-as-kill beg end))
5623 (setq org-subtree-clip (current-kill 0))
5624 (message "%s: Subtree(s) with %d characters"
5625 (if cut "Cut" "Copied")
5626 (length org-subtree-clip)))))
5628 (defun org-paste-subtree (&optional level tree for-yank)
5629 "Paste the clipboard as a subtree, with modification of headline level.
5630 The entire subtree is promoted or demoted in order to match a new headline
5631 level.
5633 If the cursor is at the beginning of a headline, the same level as
5634 that headline is used to paste the tree
5636 If not, the new level is derived from the *visible* headings
5637 before and after the insertion point, and taken to be the inferior headline
5638 level of the two. So if the previous visible heading is level 3 and the
5639 next is level 4 (or vice versa), level 4 will be used for insertion.
5640 This makes sure that the subtree remains an independent subtree and does
5641 not swallow low level entries.
5643 You can also force a different level, either by using a numeric prefix
5644 argument, or by inserting the heading marker by hand. For example, if the
5647 If optional TREE is given, use this text instead of the kill ring.
5649 When FOR-YANK is set, this is called by `org-yank'. In this case, do not
5650 move back over whitespace before inserting, and move point to the end of
5651 the inserted text when done."
5652 (interactive "P")
5653 (unless (org-kill-is-subtree-p tree)
5654 (error "%s"
5655 (substitute-command-keys
5657 (let* ((visp (not (org-invisible-p)))
5658 (txt (or tree (and kill-ring (current-kill 0))))
5663 (old-level (if (string-match ^re txt)
5664 (- (match-end 0) (match-beginning 0) 1)
5665 -1))
5666 (force-level (cond (level (prefix-numeric-value level))
5668 (string-match
5669 ^re_ (buffer-substring
5670 (point-at-bol) (point))))
5671 (- (match-end 1) (match-beginning 1)))
5672 ((and (bolp)
5673 (looking-at org-outline-regexp))
5674 (- (match-end 0) (point) 1))
5675 (t nil)))
5676 (previous-level (save-excursion
5677 (condition-case nil
5678 (progn
5679 (outline-previous-visible-heading 1)
5680 (if (looking-at re)
5681 (- (match-end 0) (match-beginning 0) 1)
5682 1))
5683 (error 1))))
5684 (next-level (save-excursion
5685 (condition-case nil
5686 (progn
5687 (or (looking-at outline-regexp)
5688 (outline-next-visible-heading 1))
5689 (if (looking-at re)
5690 (- (match-end 0) (match-beginning 0) 1)
5691 1))
5692 (error 1))))
5693 (new-level (or force-level (max previous-level next-level)))
5694 (shift (if (or (= old-level -1)
5695 (= new-level -1)
5696 (= old-level new-level))
5697 0
5698 (- new-level old-level)))
5699 (delta (if (> shift 0) -1 1))
5700 (func (if (> shift 0) 'org-demote 'org-promote))
5701 (org-odd-levels-only nil)
5702 beg end newend)
5703 ;; Remove the forced level indicator
5704 (if force-level
5705 (delete-region (point-at-bol) (point)))
5706 ;; Paste
5707 (beginning-of-line 1)
5708 (unless for-yank (org-back-over-empty-lines))
5709 (setq beg (point))
5710 (and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt))
5711 (insert-before-markers txt)
5713 (setq newend (point))
5714 (org-reinstall-markers-in-region beg)
5715 (setq end (point))
5716 (goto-char beg)
5718 (setq beg (point))
5719 (if (and (org-invisible-p) visp)
5720 (save-excursion (outline-show-heading)))
5721 ;; Shift if necessary
5722 (unless (= shift 0)
5723 (save-restriction
5724 (narrow-to-region beg end)
5725 (while (not (= shift 0))
5726 (org-map-region func (point-min) (point-max))
5727 (setq shift (+ delta shift)))
5728 (goto-char (point-min))
5729 (setq newend (point-max))))
5730 (when (or (interactive-p) for-yank)
5731 (message "Clipboard pasted as level %d subtree" new-level))
5732 (if (and (not for-yank) ; in this case, org-yank will decide about folding
5733 kill-ring
5734 (eq org-subtree-clip (current-kill 0))
5735 org-subtree-clip-folded)
5736 ;; The tree was folded before it was killed/copied
5737 (hide-subtree))
5738 (and for-yank (goto-char newend))))
5740 (defun org-kill-is-subtree-p (&optional txt)
5741 "Check if the current kill is an outline subtree, or a set of trees.
5742 Returns nil if kill does not start with a headline, or if the first
5743 headline level is not the largest headline level in the tree.
5744 So this will actually accept several entries of equal levels as well,
5745 which is OK for `org-paste-subtree'.
5746 If optional TXT is given, check this string instead of the current kill."
5747 (let* ((kill (or txt (and kill-ring (current-kill 0)) ""))
5748 (start-level (and kill
5751 kill)
5752 (- (match-end 2) (match-beginning 2) 1)))
5753 (re (concat "^" org-outline-regexp))
5754 (start (1+ (or (match-beginning 2) -1))))
5755 (if (not start-level)
5756 (progn
5757 nil) ;; does not even start with a heading
5758 (catch 'exit
5759 (while (setq start (string-match re kill (1+ start)))
5760 (when (< (- (match-end 0) (match-beginning 0) 1) start-level)
5761 (throw 'exit nil)))
5762 t))))
5764 (defvar org-markers-to-move nil
5765 "Markers that should be moved with a cut-and-paste operation.
5766 Those markers are stored together with their positions relative to
5767 the start of the region.")
5769 (defun org-save-markers-in-region (beg end)
5770 "Check markers in region.
5771 If these markers are between BEG and END, record their position relative
5772 to BEG, so that after moving the block of text, we can put the markers back
5773 into place.
5774 This function gets called just before an entry or tree gets cut from the
5775 buffer. After re-insertion, `org-reinstall-markers-in-region' must be
5776 called immediately, to move the markers with the entries."
5777 (setq org-markers-to-move nil)
5778 (when (featurep 'org-clock)
5779 (org-clock-save-markers-for-cut-and-paste beg end))
5780 (when (featurep 'org-agenda)
5781 (org-agenda-save-markers-for-cut-and-paste beg end)))
5783 (defun org-check-and-save-marker (marker beg end)
5784 "Check if MARKER is between BEG and END.
5785 If yes, remember the marker and the distance to BEG."
5786 (when (and (marker-buffer marker)
5787 (equal (marker-buffer marker) (current-buffer)))
5788 (if (and (>= marker beg) (< marker end))
5789 (push (cons marker (- marker beg)) org-markers-to-move))))
5791 (defun org-reinstall-markers-in-region (beg)
5792 "Move all remembered markers to their position relative to BEG."
5793 (mapc (lambda (x)
5794 (move-marker (car x) (+ beg (cdr x))))
5795 org-markers-to-move)
5796 (setq org-markers-to-move nil))
5798 (defun org-narrow-to-subtree ()
5799 "Narrow buffer to the current subtree."
5800 (interactive)
5801 (save-excursion
5802 (save-match-data
5803 (narrow-to-region
5804 (progn (org-back-to-heading) (point))
5805 (progn (org-end-of-subtree t) (point))))))
5808 ;;; Outline Sorting
5810 (defun org-sort (with-case)
5811 "Call `org-sort-entries-or-items' or `org-table-sort-lines'.
5812 Optional argument WITH-CASE means sort case-sensitively.
5813 With a double prefix argument, also remove duplicate entries."
5814 (interactive "P")
5815 (if (org-at-table-p)
5816 (org-call-with-arg 'org-table-sort-lines with-case)
5817 (org-call-with-arg 'org-sort-entries-or-items with-case)))
5819 (defun org-sort-remove-invisible (s)
5820 (remove-text-properties 0 (length s) org-rm-props s)
5821 (while (string-match org-bracket-link-regexp s)
5822 (setq s (replace-match (if (match-end 2)
5823 (match-string 3 s)
5824 (match-string 1 s)) t t s)))
5825 s)
5827 (defvar org-priority-regexp) ; defined later in the file
5829 (defun org-sort-entries-or-items
5830 (&optional with-case sorting-type getkey-func compare-func property)
5831 "Sort entries on a certain level of an outline tree.
5832 If there is an active region, the entries in the region are sorted.
5833 Else, if the cursor is before the first entry, sort the top-level items.
5834 Else, the children of the entry at point are sorted.
5836 Sorting can be alphabetically, numerically, and by date/time as given by
5837 the first time stamp in the entry. The command prompts for the sorting
5838 type unless it has been given to the function through the SORTING-TYPE
5839 argument, which needs to a character, any of (?n ?N ?a ?A ?t ?T ?p ?P ?f ?F).
5840 If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be
5841 called with point at the beginning of the record. It must return either
5842 a string or a number that should serve as the sorting key for that record.
5844 Comparing entries ignores case by default. However, with an optional argument
5845 WITH-CASE, the sorting considers case as well."
5846 (interactive "P")
5847 (let ((case-func (if with-case 'identity 'downcase))
5848 start beg end stars re re2
5849 txt what tmp plain-list-p)
5850 ;; Find beginning and end of region to sort
5851 (cond
5852 ((org-region-active-p)
5853 ;; we will sort the region
5854 (setq end (region-end)
5855 what "region")
5856 (goto-char (region-beginning))
5857 (if (not (org-on-heading-p)) (outline-next-heading))
5858 (setq start (point)))
5859 ((org-at-item-p)
5860 ;; we will sort this plain list
5861 (org-beginning-of-item-list) (setq start (point))
5862 (org-end-of-item-list) (setq end (point))
5863 (goto-char start)
5864 (setq plain-list-p t
5865 what "plain list"))
5866 ((or (org-on-heading-p)
5867 (condition-case nil (progn (org-back-to-heading) t) (error nil)))
5868 ;; we will sort the children of the current headline
5869 (org-back-to-heading)
5870 (setq start (point)
5871 end (progn (org-end-of-subtree t t)
5872 (org-back-over-empty-lines)
5873 (point))
5874 what "children")
5875 (goto-char start)
5876 (show-subtree)
5877 (outline-next-heading))
5878 (t
5879 ;; we will sort the top-level entries in this file
5880 (goto-char (point-min))
5881 (or (org-on-heading-p) (outline-next-heading))
5882 (setq start (point) end (point-max) what "top-level")
5883 (goto-char start)
5884 (show-all)))
5886 (setq beg (point))
5887 (if (>= beg end) (error "Nothing to sort"))
5889 (unless plain-list-p
5891 (setq stars (match-string 1)
5892 re (concat "^" (regexp-quote stars) " +")
5893 re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[^*]")
5894 txt (buffer-substring beg end))
5896 (if (and (not (equal stars "*")) (string-match re2 txt))
5897 (error "Region to sort contains a level above the first entry")))
5899 (unless sorting-type
5900 (message
5901 (if plain-list-p
5902 "Sort %s: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:"
5903 "Sort %s: [a]lpha [n]umeric [t]ime [p]riority p[r]operty todo[o]rder [f]unc A/N/T/P/O/F means reversed:")
5904 what)
5905 (setq sorting-type (read-char-exclusive))
5907 (and (= (downcase sorting-type) ?f)
5908 (setq getkey-func
5909 (org-ido-completing-read "Sort using function: "
5910 obarray 'fboundp t nil nil))
5911 (setq getkey-func (intern getkey-func)))
5913 (and (= (downcase sorting-type) ?r)
5914 (setq property
5915 (org-ido-completing-read "Property: "
5916 (mapcar 'list (org-buffer-property-keys t))
5917 nil t))))
5919 (message "Sorting entries...")
5921 (save-restriction
5922 (narrow-to-region start end)
5924 (let ((dcst (downcase sorting-type))
5925 (now (current-time)))
5926 (sort-subr
5927 (/= dcst sorting-type)
5928 ;; This function moves to the beginning character of the "record" to
5929 ;; be sorted.
5930 (if plain-list-p
5931 (lambda nil
5932 (if (org-at-item-p) t (goto-char (point-max))))
5933 (lambda nil
5934 (if (re-search-forward re nil t)
5935 (goto-char (match-beginning 0))
5936 (goto-char (point-max)))))
5937 ;; This function moves to the last character of the "record" being
5938 ;; sorted.
5939 (if plain-list-p
5940 'org-end-of-item
5941 (lambda nil
5942 (save-match-data
5943 (condition-case nil
5944 (outline-forward-same-level 1)
5945 (error
5946 (goto-char (point-max)))))))
5948 ;; This function returns the value that gets sorted against.
5949 (if plain-list-p
5950 (lambda nil
5952 (cond
5953 ((= dcst ?n)
5954 (string-to-number (buffer-substring (match-end 0)
5955 (point-at-eol))))
5956 ((= dcst ?a)
5957 (buffer-substring (match-end 0) (point-at-eol)))
5958 ((= dcst ?t)
5959 (if (re-search-forward org-ts-regexp
5960 (point-at-eol) t)
5961 (org-time-string-to-time (match-string 0))
5962 now))
5963 ((= dcst ?f)
5964 (if getkey-func
5965 (progn
5966 (setq tmp (funcall getkey-func))
5967 (if (stringp tmp) (setq tmp (funcall case-func tmp)))
5968 tmp)
5969 (error "Invalid key function `%s'" getkey-func)))
5970 (t (error "Invalid sorting type `%c'" sorting-type)))))
5971 (lambda nil
5972 (cond
5973 ((= dcst ?n)
5974 (if (looking-at org-complex-heading-regexp)
5975 (string-to-number (match-string 4))
5976 nil))
5977 ((= dcst ?a)
5978 (if (looking-at org-complex-heading-regexp)
5979 (funcall case-func (match-string 4))
5980 nil))
5981 ((= dcst ?t)
5982 (if (re-search-forward org-ts-regexp
5983 (save-excursion
5984 (forward-line 2)
5985 (point)) t)
5986 (org-time-string-to-time (match-string 0))
5987 now))
5988 ((= dcst ?p)
5989 (if (re-search-forward org-priority-regexp (point-at-eol) t)
5990 (string-to-char (match-string 2))
5991 org-default-priority))
5992 ((= dcst ?r)
5993 (or (org-entry-get nil property) ""))
5994 ((= dcst ?o)
5995 (if (looking-at org-complex-heading-regexp)
5996 (- 9999 (length (member (match-string 2)
5997 org-todo-keywords-1)))))
5998 ((= dcst ?f)
5999 (if getkey-func
6000 (progn
6001 (setq tmp (funcall getkey-func))
6002 (if (stringp tmp) (setq tmp (funcall case-func tmp)))
6003 tmp)
6004 (error "Invalid key function `%s'" getkey-func)))
6005 (t (error "Invalid sorting type `%c'" sorting-type)))))
6006 nil
6007 (cond
6008 ((= dcst ?a) 'string<)
6009 ((= dcst ?t) 'time-less-p)
6010 ((= dcst ?f) compare-func)
6011 (t nil)))))
6012 (message "Sorting entries...done")))
6014 (defun org-do-sort (table what &optional with-case sorting-type)
6015 "Sort TABLE of WHAT according to SORTING-TYPE.
6016 The user will be prompted for the SORTING-TYPE if the call to this
6017 function does not specify it. WHAT is only for the prompt, to indicate
6018 what is being sorted. The sorting key will be extracted from
6019 the car of the elements of the table.
6020 If WITH-CASE is non-nil, the sorting will be case-sensitive."
6021 (unless sorting-type
6022 (message
6023 "Sort %s: [a]lphabetic. [n]umeric. [t]ime. A/N/T means reversed:"
6024 what)
6025 (setq sorting-type (read-char-exclusive)))
6026 (let ((dcst (downcase sorting-type))
6027 extractfun comparefun)
6028 ;; Define the appropriate functions
6029 (cond
6030 ((= dcst ?n)
6031 (setq extractfun 'string-to-number
6032 comparefun (if (= dcst sorting-type) '< '>)))
6033 ((= dcst ?a)
6034 (setq extractfun (if with-case (lambda(x) (org-sort-remove-invisible x))
6035 (lambda(x) (downcase (org-sort-remove-invisible x))))
6036 comparefun (if (= dcst sorting-type)
6037 'string<
6038 (lambda (a b) (and (not (string< a b))
6039 (not (string= a b)))))))
6040 ((= dcst ?t)
6041 (setq extractfun
6042 (lambda (x)
6043 (if (or (string-match org-ts-regexp x)
6044 (string-match org-ts-regexp-both x))
6045 (time-to-seconds
6046 (org-time-string-to-time (match-string 0 x)))
6047 0))
6048 comparefun (if (= dcst sorting-type) '< '>)))
6049 (t (error "Invalid sorting type `%c'" sorting-type)))
6051 (sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x)))
6052 table)
6053 (lambda (a b) (funcall comparefun (car a) (car b))))))
6055 ;;; Editing source examples
6057 (defvar org-exit-edit-mode-map (make-sparse-keymap))
6058 (define-key org-exit-edit-mode-map "\C-c'" 'org-edit-src-exit)
6059 (defvar org-edit-src-force-single-line nil)
6060 (defvar org-edit-src-from-org-mode nil)
6061 (defvar org-edit-src-picture nil)
6063 (define-minor-mode org-exit-edit-mode
6066 (defun org-edit-src-code ()
6067 "Edit the source code example at point.
6068 An indirect buffer is created, and that buffer is then narrowed to the
6069 example at point and switched to the correct language mode. When done,
6071 (interactive)
6072 (let ((line (org-current-line))
6073 (case-fold-search t)
6074 (msg (substitute-command-keys
6075 "Edit, then exit with C-c ' (C-c and single quote)"))
6076 (info (org-edit-src-find-region-and-lang))
6077 (org-mode-p (eq major-mode 'org-mode))
6078 beg end lang lang-f single lfmt)
6079 (if (not info)
6080 nil
6081 (setq beg (nth 0 info)
6082 end (nth 1 info)
6083 lang (nth 2 info)
6084 single (nth 3 info)
6085 lfmt (nth 4 info)
6086 lang-f (intern (concat lang "-mode")))
6087 (unless (functionp lang-f)
6088 (error "No such language mode: %s" lang-f))
6089 (goto-line line)
6090 (if (get-buffer "*Org Edit Src Example*")
6091 (kill-buffer "*Org Edit Src Example*"))
6092 (switch-to-buffer (make-indirect-buffer (current-buffer)
6093 "*Org Edit Src Example*"))
6094 (narrow-to-region beg end)
6095 (remove-text-properties beg end '(display nil invisible nil
6096 intangible nil))
6097 (let ((org-inhibit-startup t))
6098 (funcall lang-f))
6099 (set (make-local-variable 'org-edit-src-force-single-line) single)
6100 (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p)
6101 (when lfmt
6102 (set (make-local-variable 'org-coderef-label-format) lfmt))
6103 (when org-mode-p
6104 (goto-char (point-min))
6105 (while (re-search-forward "^," nil t)
6106 (replace-match "")))
6107 (goto-line line)
6108 (org-exit-edit-mode)
6109 (org-set-local 'header-line-format msg)
6110 (message "%s" msg)
6111 t)))
6113 (defun org-edit-fixed-width-region ()
6114 "Edit the fixed-width ascii drawing at point.
6115 This must be a region where each line starts with a colon followed by
6116 a space character.
6117 An indirect buffer is created, and that buffer is then narrowed to the
6118 example at point and switched to artist-mode. When done,
6120 (interactive)
6121 (let ((line (org-current-line))
6122 (case-fold-search t)
6123 (msg (substitute-command-keys
6124 "Edit, then exit with C-c ' (C-c and single quote)"))
6125 (org-mode-p (eq major-mode 'org-mode))
6126 beg end)
6127 (beginning-of-line 1)
6129 nil
6131 (setq beg (point) end beg)
6132 (save-excursion
6134 (setq beg (point-at-bol 2))
6135 (setq beg (point))))
6136 (save-excursion
6138 (setq end (1- (match-beginning 0)))
6139 (setq end (point))))
6140 (goto-line line))
6141 (if (get-buffer "*Org Edit Picture*")
6142 (kill-buffer "*Org Edit Picture*"))
6143 (switch-to-buffer (make-indirect-buffer (current-buffer)
6144 "*Org Edit Picture*"))
6145 (narrow-to-region beg end)
6146 (remove-text-properties beg end '(display nil invisible nil
6147 intangible nil))
6148 (when (fboundp 'font-lock-unfontify-region)
6149 (font-lock-unfontify-region (point-min) (point-max)))
6150 (cond
6151 ((eq org-edit-fixed-width-region-mode 'artist-mode)
6152 (fundamental-mode)
6153 (artist-mode 1))
6154 (t (funcall org-edit-fixed-width-region-mode)))
6155 (set (make-local-variable 'org-edit-src-force-single-line) nil)
6156 (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p)
6157 (set (make-local-variable 'org-edit-src-picture) t)
6158 (goto-char (point-min))
6160 (replace-match ""))
6161 (goto-line line)
6162 (org-exit-edit-mode)
6163 (org-set-local 'header-line-format msg)
6164 (message "%s" msg)
6165 t)))
6168 (defun org-edit-src-find-region-and-lang ()
6169 "Find the region and language for a local edit.
6170 Return a list with beginning and end of the region, a string representing
6171 the language, a switch telling of the content should be in a single line."
6172 (let ((re-list
6173 (append
6174 org-edit-src-region-extra
6175 '(
6191 )))
6192 (pos (point))
6193 re1 re2 single beg end lang lfmt match-re1)
6194 (catch 'exit
6195 (while (setq entry (pop re-list))
6196 (setq re1 (car entry) re2 (nth 1 entry) lang (nth 2 entry)
6197 single (nth 3 entry))
6198 (save-excursion
6199 (if (or (looking-at re1)
6200 (re-search-backward re1 nil t))
6201 (progn
6202 (setq match-re1 (match-string 0))
6203 (setq beg (match-end 0)
6204 lang (org-edit-src-get-lang lang)
6205 lfmt (org-edit-src-get-label-format match-re1))
6206 (if (and (re-search-forward re2 nil t)
6207 (>= (match-end 0) pos))
6208 (throw 'exit (list beg (match-beginning 0)
6209 lang single lfmt))))
6210 (if (or (looking-at re2)
6211 (re-search-forward re2 nil t))
6212 (progn
6213 (setq end (match-beginning 0))
6214 (if (and (re-search-backward re1 nil t)
6215 (<= (match-beginning 0) pos))
6216 (progn
6217 (setq lfmt (org-edit-src-get-label-format
6218 (match-string 0)))
6219 (throw 'exit
6220 (list (match-end 0) end
6221 (org-edit-src-get-lang lang)
6222 single lfmt))))))))))))
6224 (defun org-edit-src-get-lang (lang)
6225 "Extract the src language."
6226 (let ((m (match-string 0)))
6227 (cond
6228 ((stringp lang) lang)
6229 ((integerp lang) (match-string lang))
6230 ((and (eq lang 'lang)
6232 (match-string 1 m))
6233 ((and (eq lang 'style)
6235 (match-string 1 m))
6236 (t "fundamental"))))
6238 (defun org-edit-src-get-label-format (s)
6239 "Extract the label format."
6240 (save-match-data
6242 (match-string 1 s))))
6244 (defun org-edit-src-exit ()
6245 "Exit special edit and protect problematic lines."
6246 (interactive)
6247 (unless (buffer-base-buffer (current-buffer))
6248 (error "This is not an indirect buffer, something is wrong..."))
6249 (unless (> (point-min) 1)
6250 (error "This buffer is not narrowed, something is wrong..."))
6251 (goto-char (point-min))
6254 (when (org-bound-and-true-p org-edit-src-force-single-line)
6255 (goto-char (point-min))
6257 (replace-match " "))
6258 (goto-char (point-min))
6261 (replace-match "")))
6262 (when (org-bound-and-true-p org-edit-src-from-org-mode)
6263 (goto-char (point-min))
6266 (when font-lock-mode
6267 (font-lock-unfontify-region (point-min) (point-max)))
6268 (put-text-property (point-min) (point-max) 'font-lock-fontified t))
6269 (when (org-bound-and-true-p org-edit-src-picture)
6270 (untabify (point-min) (point-max))
6271 (goto-char (point-min))
6272 (while (re-search-forward "^" nil t)
6273 (replace-match ": "))
6274 (when font-lock-mode
6275 (font-lock-unfontify-region (point-min) (point-max)))
6276 (put-text-property (point-min) (point-max) 'font-lock-fontified t))
6277 (kill-buffer (current-buffer))
6278 (and (org-mode-p) (org-restart-font-lock)))
6281 ;;; The orgstruct minor mode
6283 ;; Define a minor mode which can be used in other modes in order to
6284 ;; integrate the org-mode structure editing commands.
6286 ;; This is really a hack, because the org-mode structure commands use
6287 ;; keys which normally belong to the major mode. Here is how it
6288 ;; works: The minor mode defines all the keys necessary to operate the
6289 ;; structure commands, but wraps the commands into a function which
6290 ;; tests if the cursor is currently at a headline or a plain list
6291 ;; item. If that is the case, the structure command is used,
6292 ;; temporarily setting many Org-mode variables like regular
6293 ;; expressions for filling etc. However, when any of those keys is
6294 ;; used at a different location, function uses `key-binding' to look
6295 ;; up if the key has an associated command in another currently active
6296 ;; keymap (minor modes, major mode, global), and executes that
6297 ;; command. There might be problems if any of the keys is otherwise
6298 ;; used as a prefix key.
6300 ;; Another challenge is that the key binding for TAB can be tab or \C-i,
6301 ;; likewise the binding for RET can be return or \C-m. Orgtbl-mode
6302 ;; addresses this by checking explicitly for both bindings.
6304 (defvar orgstruct-mode-map (make-sparse-keymap)
6305 "Keymap for the minor `orgstruct-mode'.")
6307 (defvar org-local-vars nil
6308 "List of local variables, for use by `orgstruct-mode'")
6310 ;;;###autoload
6311 (define-minor-mode orgstruct-mode
6312 "Toggle the minor more `orgstruct-mode'.
6313 This mode is for using Org-mode structure commands in other modes.
6314 The following key behave as if Org-mode was active, if the cursor
6315 is on a headline, or on a plain list item (both in the definition
6316 of Org-mode).
6318 M-up Move entry/item up
6319 M-down Move entry/item down
6320 M-left Promote
6321 M-right Demote
6322 M-S-up Move entry/item up
6323 M-S-down Move entry/item down
6324 M-S-left Promote subtree
6325 M-S-right Demote subtree
6326 M-q Fill paragraph and items like in Org-mode
6327 C-c ^ Sort entries
6328 C-c - Cycle list bullet
6329 TAB Cycle item visibility
6330 M-RET Insert new heading/item
6331 S-M-RET Insert new TODO heading / Checkbox item
6332 C-c C-c Set tags / toggle checkbox"
6333 nil " OrgStruct" nil
6334 (org-load-modules-maybe)
6335 (and (orgstruct-setup) (defun orgstruct-setup () nil)))
6337 ;;;###autoload
6338 (defun turn-on-orgstruct ()
6339 "Unconditionally turn on `orgstruct-mode'."
6340 (orgstruct-mode 1))
6342 (defun orgstruct++-mode (&optional arg)
6343 "Toggle `orgstruct-mode', the enhanced version of it.
6344 In addition to setting orgstruct-mode, this also exports all indentation and
6345 autofilling variables from org-mode into the buffer. It will also
6346 recognize item context in multiline items.
6347 Note that turning off orgstruct-mode will *not* remove the
6348 indentation/paragraph settings. This can only be done by refreshing the
6349 major mode, for example with \[normal-mode]."
6350 (interactive "P")
6351 (setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1))))
6352 (if (< arg 1)
6353 (orgstruct-mode -1)
6354 (orgstruct-mode 1)
6355 (let (var val)
6356 (mapc
6357 (lambda (x)
6358 (when (string-match
6360 (symbol-name (car x)))
6361 (setq var (car x) val (nth 1 x))
6362 (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val))))
6363 org-local-vars)
6364 (org-set-local 'orgstruct-is-++ t))))
6366 (defvar orgstruct-is-++ nil
6367 "Is orgstruct-mode in ++ version in the current-buffer?")
6368 (make-variable-buffer-local 'orgstruct-is-++)
6370 ;;;###autoload
6371 (defun turn-on-orgstruct++ ()
6372 "Unconditionally turn on `orgstruct++-mode'."
6373 (orgstruct++-mode 1))
6375 (defun orgstruct-error ()
6376 "Error when there is no default binding for a structure key."
6377 (interactive)
6378 (error "This key has no function outside structure elements"))
6380 (defun orgstruct-setup ()
6381 "Setup orgstruct keymaps."
6382 (let ((nfunc 0)
6383 (bindings
6384 (list
6385 '([(meta up)] org-metaup)
6386 '([(meta down)] org-metadown)
6387 '([(meta left)] org-metaleft)
6388 '([(meta right)] org-metaright)
6389 '([(meta shift up)] org-shiftmetaup)
6390 '([(meta shift down)] org-shiftmetadown)
6391 '([(meta shift left)] org-shiftmetaleft)
6392 '([(meta shift right)] org-shiftmetaright)
6393 '([(shift up)] org-shiftup)
6394 '([(shift down)] org-shiftdown)
6395 '([(shift left)] org-shiftleft)
6396 '([(shift right)] org-shiftright)
6397 '("\C-c\C-c" org-ctrl-c-ctrl-c)
6398 '("\M-q" fill-paragraph)
6399 '("\C-c^" org-sort)
6400 '("\C-c-" org-cycle-list-bullet)))
6401 elt key fun cmd)
6402 (while (setq elt (pop bindings))
6403 (setq nfunc (1+ nfunc))
6404 (setq key (org-key (car elt))
6405 fun (nth 1 elt)
6406 cmd (orgstruct-make-binding fun nfunc key))
6407 (org-defkey orgstruct-mode-map key cmd))
6409 ;; Special treatment needed for TAB and RET
6410 (org-defkey orgstruct-mode-map [(tab)]
6411 (orgstruct-make-binding 'org-cycle 102 [(tab)] "\C-i"))
6412 (org-defkey orgstruct-mode-map "\C-i"
6413 (orgstruct-make-binding 'org-cycle 103 "\C-i" [(tab)]))
6415 (org-defkey orgstruct-mode-map "\M-\C-m"
6416 (orgstruct-make-binding 'org-insert-heading 105
6417 "\M-\C-m" [(meta return)]))
6418 (org-defkey orgstruct-mode-map [(meta return)]
6419 (orgstruct-make-binding 'org-insert-heading 106
6420 [(meta return)] "\M-\C-m"))
6422 (org-defkey orgstruct-mode-map [(shift meta return)]
6423 (orgstruct-make-binding 'org-insert-todo-heading 107
6424 [(meta return)] "\M-\C-m"))
6426 (unless org-local-vars
6427 (setq org-local-vars (org-get-local-variables)))
6429 t))
6431 (defun orgstruct-make-binding (fun n &rest keys)
6432 "Create a function for binding in the structure minor mode.
6433 FUN is the command to call inside a table. N is used to create a unique
6434 command name. KEYS are keys that should be checked in for a command
6435 to execute outside of tables."
6436 (eval
6437 (list 'defun
6438 (intern (concat "orgstruct-hijacker-command-" (int-to-string n)))
6439 '(arg)
6441 "Outside of structure, run the binding of `"
6442 (mapconcat (lambda (x) (format "%s" x)) keys "' or `")
6443 "'.")
6444 '(interactive "p")
6445 (list 'if
6446 `(org-context-p 'headline 'item
6447 (and orgstruct-is-++
6448 ,(and (memq fun '(org-insert-heading org-insert-todo-heading)) t)
6449 'item-body))
6450 (list 'org-run-like-in-org-mode (list 'quote fun))
6451 (list 'let '(orgstruct-mode)
6452 (list 'call-interactively
6453 (append '(or)
6454 (mapcar (lambda (k)
6455 (list 'key-binding k))
6456 keys)
6457 '('orgstruct-error))))))))
6459 (defun org-context-p (&rest contexts)
6460 "Check if local context is any of CONTEXTS.
6461 Possible values in the list of contexts are `table', `headline', and `item'."
6462 (let ((pos (point)))
6463 (goto-char (point-at-bol))
6464 (prog1 (or (and (memq 'table contexts)
6466 (and (memq 'headline contexts)
6468 (looking-at outline-regexp))
6469 (and (memq 'item contexts)
6471 (and (memq 'item-body contexts)
6472 (org-in-item-p)))
6473 (goto-char pos))))
6475 (defun org-get-local-variables ()
6476 "Return a list of all local variables in an org-mode buffer."
6477 (let (varlist)
6478 (with-current-buffer (get-buffer-create "*Org tmp*")
6479 (erase-buffer)
6480 (org-mode)
6481 (setq varlist (buffer-local-variables)))
6482 (kill-buffer "*Org tmp*")
6483 (delq nil
6484 (mapcar
6485 (lambda (x)
6486 (setq x
6487 (if (symbolp x)
6488 (list x)
6489 (list (car x) (list 'quote (cdr x)))))
6490 (if (string-match
6491 "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)"
6492 (symbol-name (car x)))
6493 x nil))
6494 varlist))))
6496 ;;;###autoload
6497 (defun org-run-like-in-org-mode (cmd)
6498 "Run a command, pretending that the current buffer is in Org-mode.
6499 This will temporarily bind local variables that are typically bound in
6500 Org-mode to the values they have in Org-mode, and then interactively
6501 call CMD."
6502 (org-load-modules-maybe)
6503 (unless org-local-vars
6504 (setq org-local-vars (org-get-local-variables)))
6505 (eval (list 'let org-local-vars
6506 (list 'call-interactively (list 'quote cmd)))))
6508 ;;;; Archiving
6510 (defun org-get-category (&optional pos)
6511 "Get the category applying to position POS."
6512 (get-text-property (or pos (point)) 'org-category))
6514 (defun org-refresh-category-properties ()
6515 "Refresh category text properties in the buffer."
6516 (let ((def-cat (cond
6517 ((null org-category)
6518 (if buffer-file-name
6519 (file-name-sans-extension
6520 (file-name-nondirectory buffer-file-name))
6521 "???"))
6522 ((symbolp org-category) (symbol-name org-category))
6523 (t org-category)))
6524 beg end cat pos optionp)
6525 (org-unmodified
6526 (save-excursion
6527 (save-restriction
6528 (widen)
6529 (goto-char (point-min))
6530 (put-text-property (point) (point-max) 'org-category def-cat)
6531 (while (re-search-forward
6533 (setq pos (match-end 0)
6534 optionp (equal (char-after (match-beginning 0)) ?#)
6535 cat (org-trim (match-string 2)))
6536 (if optionp
6537 (setq beg (point-at-bol) end (point-max))
6538 (org-back-to-heading t)
6539 (setq beg (point) end (org-end-of-subtree t t)))
6540 (put-text-property beg end 'org-category cat)
6541 (goto-char pos)))))))
6544 ;;;; Link Stuff
6546 ;;; Link abbreviations
6548 (defun org-link-expand-abbrev (link)
6549 "Apply replacements as defined in `org-link-abbrev-alist."
6551 (let* ((key (match-string 1 link))
6552 (as (or (assoc key org-link-abbrev-alist-local)
6553 (assoc key org-link-abbrev-alist)))
6554 (tag (and (match-end 2) (match-string 3 link)))
6555 rpl)
6556 (if (not as)
6557 link
6558 (setq rpl (cdr as))
6559 (cond
6560 ((symbolp rpl) (funcall rpl tag))
6561 ((string-match "%s" rpl) (replace-match (or tag "") t t rpl))
6562 ((string-match "%h" rpl)
6563 (replace-match (url-hexify-string (or tag "")) t t rpl))
6564 (t (concat rpl tag)))))
6565 link))
6567 ;;; Storing and inserting links
6569 (defvar org-insert-link-history nil
6570 "Minibuffer history for links inserted with `org-insert-link'.")
6572 (defvar org-stored-links nil
6573 "Contains the links stored with `org-store-link'.")
6575 (defvar org-store-link-plist nil
6576 "Plist with info about the most recently link created with `org-store-link'.")
6578 (defvar org-link-protocols nil
6579 "Link protocols added to Org-mode using `org-add-link-type'.")
6581 (defvar org-store-link-functions nil
6582 "List of functions that are called to create and store a link.
6583 Each function will be called in turn until one returns a non-nil
6584 value. Each function should check if it is responsible for creating
6585 this link (for example by looking at the major mode).
6586 If not, it must exit and return nil.
6587 If yes, it should return a non-nil value after a calling
6588 `org-store-link-props' with a list of properties and values.
6589 Special properties are:
6593 This is obligatory as well.
6594 :description Optional default description for the second pair
6595 of brackets in an Org-mode link. The user can still change
6596 this when inserting this link into an Org-mode buffer.
6598 In addition to these, any additional properties can be specified
6599 and then used in remember templates.")
6601 (defun org-add-link-type (type &optional follow export)
6602 "Add TYPE to the list of `org-link-types'.
6603 Re-compute all regular expressions depending on `org-link-types'
6605 FOLLOW and EXPORT are two functions.
6607 FOLLOW should take the link path as the single argument and do whatever
6608 is necessary to follow the link, for example find a file or display
6609 a mail message.
6611 EXPORT should format the link path for export to one of the export formats.
6612 It should be a function accepting three arguments:
6615 desc the description of the link, if any, nil if there was no description
6616 format the export format, a symbol like `html' or `latex'.
6618 The function may use the FORMAT information to return different values
6619 depending on the format. The return value will be put literally into
6620 the exported file.
6621 Org-mode has a built-in default for exporting links. If you are happy with
6622 this default, there is no need to define an export function for the link
6623 type. For a simple example of an export function, see `org-bbdb.el'."
6624 (add-to-list 'org-link-types type t)
6625 (org-make-link-regexps)
6626 (if (assoc type org-link-protocols)
6627 (setcdr (assoc type org-link-protocols) (list follow export))
6628 (push (list type follow export) org-link-protocols)))
6630 ;;;###autoload
6631 (defun org-store-link (arg)
6633 This link is added to `org-stored-links' and can later be inserted
6636 For some link types, a prefix arg is interpreted:
6637 For links to usenet articles, arg negates `org-gnus-prefer-web-links'.
6638 For file links, arg negates `org-context-in-file-links'."
6639 (interactive "P")
6640 (org-load-modules-maybe)
6641 (setq org-store-link-plist nil) ; reset
6642 (let (link cpltxt desc description search txt)
6643 (cond
6645 ((run-hook-with-args-until-success 'org-store-link-functions)
6646 (setq link (plist-get org-store-link-plist :link)
6647 desc (or (plist-get org-store-link-plist :description) link)))
6649 ((equal (buffer-name) "*Org Edit Src Example*")
6650 (let (label gc)
6651 (while (or (not label)
6652 (save-excursion
6653 (save-restriction
6654 (widen)
6655 (goto-char (point-min))
6656 (re-search-forward
6657 (regexp-quote (format org-coderef-label-format label))
6658 nil t))))
6659 (when label (message "Label exists already") (sit-for 2))
6660 (setq label (read-string "Code line label: " label)))
6661 (end-of-line 1)
6662 (setq link (format org-coderef-label-format label))
6663 (setq gc (- 79 (length link)))
6664 (if (< (current-column) gc) (org-move-to-column gc t) (insert " "))
6665 (insert link)
6666 (setq link (concat "(" label ")") desc nil)))
6668 ((eq major-mode 'calendar-mode)
6669 (let ((cd (calendar-cursor-to-date)))
6670 (setq link
6671 (format-time-string
6672 (car org-time-stamp-formats)
6673 (apply 'encode-time
6674 (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
6675 nil nil nil))))
6676 (org-store-link-props :type "calendar" :date cd)))
6678 ((eq major-mode 'w3-mode)
6679 (setq cpltxt (url-view-url t)
6680 link (org-make-link cpltxt))
6681 (org-store-link-props :type "w3" :url (url-view-url t)))
6683 ((eq major-mode 'w3m-mode)
6684 (setq cpltxt (or w3m-current-title w3m-current-url)
6685 link (org-make-link w3m-current-url))
6686 (org-store-link-props :type "w3m" :url (url-view-url t)))
6688 ((setq search (run-hook-with-args-until-success
6689 'org-create-file-search-functions))
6690 (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
6691 "::" search))
6692 (setq cpltxt (or description link)))
6694 ((eq major-mode 'image-mode)
6695 (setq cpltxt (concat "file:"
6696 (abbreviate-file-name buffer-file-name))
6697 link (org-make-link cpltxt))
6698 (org-store-link-props :type "image" :file buffer-file-name))
6700 ((eq major-mode 'dired-mode)
6701 ;; link to the file in the current line
6702 (setq cpltxt (concat "file:"
6703 (abbreviate-file-name
6704 (expand-file-name
6705 (dired-get-filename nil t))))
6706 link (org-make-link cpltxt)))
6708 ((and buffer-file-name (org-mode-p))
6709 (cond
6711 (setq cpltxt
6712 (concat "file:"
6713 (abbreviate-file-name buffer-file-name)
6714 "::" (match-string 1))
6715 link (org-make-link cpltxt)))
6716 ((and (featurep 'org-id)
6717 (or (eq org-link-to-org-use-id t)
6718 (and (eq org-link-to-org-use-id 'create-if-interactive)
6719 (interactive-p))
6720 (and org-link-to-org-use-id
6721 (condition-case nil
6722 (org-entry-get nil "ID")
6723 (error nil)))))
6724 ;; We can make a link using the ID.
6725 (setq link (condition-case nil
6726 (prog1 (org-id-store-link)
6727 (setq desc (plist-get org-store-link-plist
6728 :description)))
6729 (error
6730 ;; probably before first headline, link to file only
6731 (concat "file:"
6732 (abbreviate-file-name buffer-file-name))))))
6733 (t
6734 ;; Just link to current headline
6735 (setq cpltxt (concat "file:"
6736 (abbreviate-file-name buffer-file-name)))
6737 ;; Add a context search string
6738 (when (org-xor org-context-in-file-links arg)
6739 (setq txt (cond
6740 ((org-on-heading-p) nil)
6741 ((org-region-active-p)
6742 (buffer-substring (region-beginning) (region-end)))
6743 (t nil)))
6745 (setq cpltxt
6746 (concat cpltxt "::"
6747 (condition-case nil
6748 (org-make-org-heading-search-string txt)
6749 (error "")))
6750 desc "NONE")))
6752 (setq cpltxt (substring cpltxt 0 -2)))
6753 (setq link (org-make-link cpltxt)))))
6755 ((buffer-file-name (buffer-base-buffer))
6756 ;; Just link to this file here.
6757 (setq cpltxt (concat "file:"
6758 (abbreviate-file-name
6759 (buffer-file-name (buffer-base-buffer)))))
6760 ;; Add a context string
6761 (when (org-xor org-context-in-file-links arg)
6762 (setq txt (if (org-region-active-p)
6763 (buffer-substring (region-beginning) (region-end))
6764 (buffer-substring (point-at-bol) (point-at-eol))))
6765 ;; Only use search option if there is some text.
6767 (setq cpltxt
6768 (concat cpltxt "::" (org-make-org-heading-search-string txt))
6769 desc "NONE")))
6770 (setq link (org-make-link cpltxt)))
6772 ((interactive-p)
6773 (error "Cannot link to a buffer which is not visiting a file"))
6775 (t (setq link nil)))
6777 (if (consp link) (setq cpltxt (car link) link (cdr link)))
6778 (setq link (or link cpltxt)
6779 desc (or desc cpltxt))
6780 (if (equal desc "NONE") (setq desc nil))
6782 (if (and (interactive-p) link)
6783 (progn
6784 (setq org-stored-links
6785 (cons (list link desc) org-stored-links))
6786 (message "Stored: %s" (or desc link)))
6787 (and link (org-make-link-string link desc)))))
6789 (defun org-store-link-props (&rest plist)
6790 "Store link properties, extract names and addresses."
6791 (let (x adr)
6792 (when (setq x (plist-get plist :from))
6793 (setq adr (mail-extract-address-components x))
6794 (setq plist (plist-put plist :fromname (car adr)))
6795 (setq plist (plist-put plist :fromaddress (nth 1 adr))))
6796 (when (setq x (plist-get plist :to))
6797 (setq adr (mail-extract-address-components x))
6798 (setq plist (plist-put plist :toname (car adr)))
6799 (setq plist (plist-put plist :toaddress (nth 1 adr)))))
6800 (let ((from (plist-get plist :from))
6801 (to (plist-get plist :to)))
6802 (when (and from to org-from-is-user-regexp)
6803 (setq plist
6804 (plist-put plist :fromto
6805 (if (string-match org-from-is-user-regexp from)
6806 (concat "to %t")
6807 (concat "from %f"))))))
6808 (setq org-store-link-plist plist))
6810 (defun org-add-link-props (&rest plist)
6811 "Add these properties to the link property list."
6812 (let (key value)
6813 (while plist
6814 (setq key (pop plist) value (pop plist))
6815 (setq org-store-link-plist
6816 (plist-put org-store-link-plist key value)))))
6818 (defun org-email-link-description (&optional fmt)
6819 "Return the description part of an email link.
6820 This takes information from `org-store-link-plist' and formats it
6821 according to FMT (default from `org-email-link-description-format')."
6822 (setq fmt (or fmt org-email-link-description-format))
6823 (let* ((p org-store-link-plist)
6824 (to (plist-get p :toaddress))
6825 (from (plist-get p :fromaddress))
6826 (table
6827 (list
6828 (cons "%c" (plist-get p :fromto))
6829 (cons "%F" (plist-get p :from))
6830 (cons "%f" (or (plist-get p :fromname) (plist-get p :fromaddress) "?"))
6831 (cons "%T" (plist-get p :to))
6832 (cons "%t" (or (plist-get p :toname) (plist-get p :toaddress) "?"))
6833 (cons "%s" (plist-get p :subject))
6834 (cons "%m" (plist-get p :message-id)))))
6835 (when (string-match "%c" fmt)
6836 ;; Check if the user wrote this message
6837 (if (and org-from-is-user-regexp from to
6838 (save-match-data (string-match org-from-is-user-regexp from)))
6839 (setq fmt (replace-match "to %t" t t fmt))
6840 (setq fmt (replace-match "from %f" t t fmt))))
6841 (org-replace-escapes fmt table)))
6843 (defun org-make-org-heading-search-string (&optional string heading)
6844 "Make search string for STRING or current headline."
6845 (interactive)
6846 (let ((s (or string (org-get-heading))))
6847 (unless (and string (not heading))
6848 ;; We are using a headline, clean up garbage in there.
6849 (if (string-match org-todo-regexp s)
6850 (setq s (replace-match "" t t s)))
6852 (setq s (replace-match "" t t s)))
6853 (setq s (org-trim s))
6856 (setq s (replace-match "" t t s)))
6857 (while (string-match org-ts-regexp s)
6858 (setq s (replace-match "" t t s))))
6860 (setq s (replace-match " " t t s)))
6861 (or string (setq s (concat "*" s))) ; Add * for headlines
6864 (defun org-make-link (&rest strings)
6865 "Concatenate STRINGS."
6866 (apply 'concat strings))
6868 (defun org-make-link-string (link &optional description)
6869 "Make a link with brackets, consisting of LINK and DESCRIPTION."
6871 (error "Empty link"))
6872 (when (stringp description)
6873 ;; Remove brackets from the description, they are fatal.
6875 (setq description (replace-match "{" t t description)))
6877 (setq description (replace-match "}" t t description))))
6878 (when (equal (org-link-escape link) description)
6879 ;; No description needed, it is identical
6880 (setq description nil))
6881 (when (and (not description)
6882 (not (equal link (org-link-escape link))))
6883 (setq description (org-extract-attributes link)))
6884 (concat "[[" (org-link-escape link) "]"
6885 (if description (concat "[" description "]") "")
6886 "]"))
6888 (defconst org-link-escape-chars
6889 '((?\ . "%20")
6890 (?\[ . "%5B")
6891 (?\] . "%5D")
6902 (?\; . "%3B")
6903 (?? . "%3F")
6904 (?= . "%3D")
6905 (?+ . "%2B")
6906 )
6907 "Association list of escapes for some characters problematic in links.
6908 This is the list that is used for internal purposes.")
6910 (defconst org-link-escape-chars-browser
6911 '((?\ . "%20")) ; 32 for the SPC char
6912 "Association list of escapes for some characters problematic in links.
6913 This is the list that is used before handing over to the browser.")
6915 (defun org-link-escape (text &optional table)
6916 "Escape characters in TEXT that are problematic for links."
6917 (setq table (or table org-link-escape-chars))
6918 (when text
6919 (let ((re (mapconcat (lambda (x) (regexp-quote
6920 (char-to-string (car x))))
6922 (while (string-match re text)
6923 (setq text
6924 (replace-match
6925 (cdr (assoc (string-to-char (match-string 0 text))
6926 table))
6927 t t text)))
6928 text)))
6930 (defun org-link-unescape (text &optional table)
6931 "Reverse the action of `org-link-escape'."
6932 (setq table (or table org-link-escape-chars))
6933 (when text
6934 (let ((re (mapconcat (lambda (x) (regexp-quote (cdr x)))
6936 (while (string-match re text)
6937 (setq text
6938 (replace-match
6939 (char-to-string (car (rassoc (match-string 0 text) table)))
6940 t t text)))
6941 text)))
6943 (defun org-xor (a b)
6944 "Exclusive or."
6945 (if a (not b) b))
6947 (defun org-fixup-message-id-for-http (s)
6948 "Replace special characters in a message id, so it can be used in an http query."
6949 (while (string-match "<" s)
6950 (setq s (replace-match "%3C" t t s)))
6951 (while (string-match ">" s)
6952 (setq s (replace-match "%3E" t t s)))
6953 (while (string-match "@" s)
6954 (setq s (replace-match "%40" t t s)))
6955 s)
6957 ;;;###autoload
6958 (defun org-insert-link-global ()
6959 "Insert a link like Org-mode does.
6960 This command can be called in any mode to insert a link in Org-mode syntax."
6961 (interactive)
6962 (org-load-modules-maybe)
6963 (org-run-like-in-org-mode 'org-insert-link))
6965 (defun org-insert-link (&optional complete-file link-location)
6966 "Insert a link. At the prompt, enter the link.
6968 Completion can be used to insert any of the link protocol prefixes like
6969 http or ftp in use.
6971 The history can be used to select a link previously stored with
6972 `org-store-link'. When the empty string is entered (i.e. if you just
6973 press RET at the prompt), the link defaults to the most recently
6974 stored link. As SPC triggers completion in the minibuffer, you need to
6975 use M-SPC or C-q SPC to force the insertion of a space character.
6977 You will also be prompted for a description, and if one is given, it will
6978 be displayed in the buffer instead of the link.
6980 If there is already a link at point, this command will allow you to edit link
6981 and description parts.
6984 be selected using completion. The path to the file will be relative to the
6985 current directory if the file is in the current directory or a subdirectory.
6986 Otherwise, the link will be the absolute path as completed in the minibuffer
6987 \(i.e. normally ~/path/to/file). You can configure this behavior using the
6988 option `org-link-file-path-type'.
6991 the current directory or below.
6994 `org-keep-stored-link-after-insertion'.
6996 If `org-make-link-description-function' is non-nil, this function will be
6997 called with the link target, and the result will be the default
6998 link description.
7000 If the LINK-LOCATION parameter is non-nil, this value will be
7001 used as the link location instead of reading one interactively."
7002 (interactive "P")
7003 (let* ((wcf (current-window-configuration))
7004 (region (if (org-region-active-p)
7005 (buffer-substring (region-beginning) (region-end))))
7006 (remove (and region (list (region-beginning) (region-end))))
7007 (desc region)
7008 tmphist ; byte-compile incorrectly complains about this
7009 (link link-location)
7010 entry file)
7011 (cond
7012 (link-location) ; specified by arg, just use it.
7013 ((org-in-regexp org-bracket-link-regexp 1)
7014 ;; We do have a link at point, and we are going to edit it.
7015 (setq remove (list (match-beginning 0) (match-end 0)))
7016 (setq desc (if (match-end 3) (org-match-string-no-properties 3)))
7017 (setq link (read-string "Link: "
7018 (org-link-unescape
7019 (org-match-string-no-properties 1)))))
7020 ((or (org-in-regexp org-angle-link-re)
7021 (org-in-regexp org-plain-link-re))
7022 ;; Convert to bracket link
7023 (setq remove (list (match-beginning 0) (match-end 0))
7024 link (read-string "Link: "
7025 (org-remove-angle-brackets (match-string 0)))))
7026 ((member complete-file '((4) (16)))
7027 ;; Completing read for file names.
7028 (setq file (read-file-name "File: "))
7029 (let ((pwd (file-name-as-directory (expand-file-name ".")))
7030 (pwd1 (file-name-as-directory (abbreviate-file-name
7031 (expand-file-name ".")))))
7032 (cond
7033 ((equal complete-file '(16))
7034 (setq link (org-make-link
7035 "file:"
7036 (abbreviate-file-name (expand-file-name file)))))
7038 (setq link (org-make-link "file:" (match-string 1 file))))
7040 (expand-file-name file))
7041 (setq link (org-make-link
7042 "file:" (match-string 1 (expand-file-name file)))))
7043 (t (setq link (org-make-link "file:" file))))))
7044 (t
7045 ;; Read link, with completion for stored links.
7046 (with-output-to-temp-buffer "*Org Links*"
7048 (when org-stored-links
7050 (princ (mapconcat
7051 (lambda (x)
7052 (if (nth 1 x) (concat (car x) " (" (nth 1 x) ")") (car x)))
7054 (let ((cw (selected-window)))
7055 (select-window (get-buffer-window "*Org Links*"))
7056 (setq truncate-lines t)
7057 (org-fit-window-to-buffer)
7058 (select-window cw))
7059 ;; Fake a link history, containing the stored links.
7060 (setq tmphist (append (mapcar 'car org-stored-links)
7061 org-insert-link-history))
7062 (unwind-protect
7063 (setq link
7064 (let ((org-completion-use-ido nil))
7065 (org-completing-read
7066 "Link: "
7067 (append
7068 (mapcar (lambda (x) (list (concat (car x) ":")))
7069 (append org-link-abbrev-alist-local org-link-abbrev-alist))
7070 (mapcar (lambda (x) (list (concat x ":")))
7071 org-link-types))
7072 nil nil nil
7073 'tmphist
7074 (or (car (car org-stored-links))))))
7075 (set-window-configuration wcf)
7076 (kill-buffer "*Org Links*"))
7077 (setq entry (assoc link org-stored-links))
7078 (or entry (push link org-insert-link-history))
7079 (if (funcall (if (equal complete-file '(64)) 'not 'identity)
7080 (not org-keep-stored-link-after-insertion))
7081 (setq org-stored-links (delq (assoc link org-stored-links)
7082 org-stored-links)))
7083 (setq desc (or desc (nth 1 entry)))))
7085 (if (string-match org-plain-link-re link)
7086 ;; URL-like link, normalize the use of angular brackets.
7087 (setq link (org-make-link (org-remove-angle-brackets link))))
7089 ;; Check if we are linking to the current file with a search option
7090 ;; If yes, simplify the link by using only the search option.
7091 (when (and buffer-file-name
7093 (let* ((path (match-string 1 link))
7094 (case-fold-search nil)
7095 (search (match-string 2 link)))
7096 (save-match-data
7097 (if (equal (file-truename buffer-file-name) (file-truename path))
7098 ;; We are linking to this same file, with a search option
7099 (setq link search)))))
7101 ;; Check if we can/should use a relative path. If yes, simplify the link
7103 (let* ((path (match-string 1 link))
7104 (origpath path)
7105 (case-fold-search nil))
7106 (cond
7107 ((or (eq org-link-file-path-type 'absolute)
7108 (equal complete-file '(16)))
7109 (setq path (abbreviate-file-name (expand-file-name path))))
7110 ((eq org-link-file-path-type 'noabbrev)
7111 (setq path (expand-file-name path)))
7112 ((eq org-link-file-path-type 'relative)
7113 (setq path (file-relative-name path)))
7114 (t
7115 (save-match-data
7116 (if (string-match (concat "^" (regexp-quote
7117 (file-name-as-directory
7118 (expand-file-name "."))))
7119 (expand-file-name path))
7120 ;; We are linking a file with relative path name.
7121 (setq path (substring (expand-file-name path)
7122 (match-end 0)))
7123 (setq path (abbreviate-file-name (expand-file-name path)))))))
7124 (setq link (concat "file:" path))
7125 (if (equal desc origpath)
7126 (setq desc path))))
7128 (if org-make-link-description-function
7129 (setq desc (funcall org-make-link-description-function link desc)))
7131 (setq desc (read-string "Description: " desc))
7133 (if remove (apply 'delete-region remove))
7134 (insert (org-make-link-string link desc))))
7136 (defun org-completing-read (&rest args)
7137 "Completing-read with SPACE being a normal character."
7138 (let ((minibuffer-local-completion-map
7139 (copy-keymap minibuffer-local-completion-map)))
7140 (org-defkey minibuffer-local-completion-map " " 'self-insert-command)
7141 (org-defkey minibuffer-local-completion-map "?" 'self-insert-command)
7142 (apply 'org-ido-completing-read args)))
7144 (defun org-completing-read-no-ido (&rest args)
7145 (let (org-completion-use-ido)
7146 (apply 'org-completing-read args)))
7148 (defun org-ido-completing-read (&rest args)
7149 "Completing-read using `ido-mode' speedups if available"
7150 (if (and org-completion-use-ido
7151 (fboundp 'ido-completing-read)
7152 (boundp 'ido-mode) ido-mode
7153 (listp (second args)))
7154 (let ((ido-enter-matching-directory nil))
7155 (apply 'ido-completing-read (concat (car args))
7156 (mapcar (lambda (x) (car x)) (nth 1 args))
7157 (cddr args)))
7158 (apply 'completing-read args)))
7161 (defun org-extract-attributes (s)
7162 "Extract the attributes cookie from a string and set as text property."
7163 (let (a attr (start 0) key value)
7164 (save-match-data
7166 (setq a (match-string 1 s) s (substring s 0 (match-beginning 0)))
7168 (setq key (match-string 1 a) value (match-string 2 a)
7169 start (match-end 0)
7170 attr (plist-put attr (intern key) value))))
7171 (org-add-props s nil 'org-attr attr))
7172 s))
7174 (defun org-attributes-to-string (plist)
7175 "Format a property list into an HTML attribute list."
7176 (let ((s "") key value)
7177 (while plist
7178 (setq key (pop plist) value (pop plist))
7179 (and value
7181 s))
7183 ;;; Opening/following a link
7185 (defvar org-link-search-failed nil)
7187 (defun org-next-link ()
7188 "Move forward to the next link.
7189 If the link is in hidden text, expose it."
7190 (interactive)
7191 (when (and org-link-search-failed (eq this-command last-command))
7192 (goto-char (point-min))
7193 (message "Link search wrapped back to beginning of buffer"))
7194 (setq org-link-search-failed nil)
7195 (let* ((pos (point))
7196 (ct (org-context))
7197 (a (assoc :link ct)))
7198 (if a (goto-char (nth 2 a)))
7199 (if (re-search-forward org-any-link-re nil t)
7200 (progn
7201 (goto-char (match-beginning 0))
7202 (if (org-invisible-p) (org-show-context)))
7203 (goto-char pos)
7204 (setq org-link-search-failed t)
7205 (error "No further link found"))))
7207 (defun org-previous-link ()
7208 "Move backward to the previous link.
7209 If the link is in hidden text, expose it."
7210 (interactive)
7211 (when (and org-link-search-failed (eq this-command last-command))
7212 (goto-char (point-max))
7213 (message "Link search wrapped back to end of buffer"))
7214 (setq org-link-search-failed nil)
7215 (let* ((pos (point))
7216 (ct (org-context))
7217 (a (assoc :link ct)))
7218 (if a (goto-char (nth 1 a)))
7219 (if (re-search-backward org-any-link-re nil t)
7220 (progn
7221 (goto-char (match-beginning 0))
7222 (if (org-invisible-p) (org-show-context)))
7223 (goto-char pos)
7224 (setq org-link-search-failed t)
7225 (error "No further link found"))))
7227 (defun org-translate-link (s)
7228 "Translate a link string if a translation function has been defined."
7229 (if (and org-link-translation-function
7230 (fboundp org-link-translation-function)
7232 (progn
7233 (setq s (funcall org-link-translation-function
7234 (match-string 1) (match-string 2)))
7235 (concat (car s) ":" (cdr s)))
7236 s))
7238 (defun org-translate-link-from-planner (type path)
7239 "Translate a link from Emacs Planner syntax so that Org can follow it.
7240 This is still an experimental function, your mileage may vary."
7241 (cond
7242 ((member type '("http" "https" "news" "ftp"))
7243 ;; standard Internet links are the same.
7244 nil)
7245 ((and (equal type "irc") (string-match "^//" path))
7246 ;; Planner has two / at the beginning of an irc link, we have 1.
7247 ;; We should have zero, actually....
7248 (setq path (substring path 1)))
7249 ((and (equal type "lisp") (string-match "^/" path))
7250 ;; Planner has a slash, we do not.
7251 (setq type "elisp" path (substring path 1)))
7253 ;; A typical message link. Planner has the id after the fina slash,
7254 ;; we separate it with a hash mark
7255 (setq path (concat (match-string 1 path) "#"
7256 (org-remove-angle-brackets (match-string 2 path)))))
7257 )
7258 (cons type path))
7260 (defun org-find-file-at-mouse (ev)
7261 "Open file link or URL at mouse."
7262 (interactive "e")
7263 (mouse-set-point ev)
7264 (org-open-at-point 'in-emacs))
7266 (defun org-open-at-mouse (ev)
7267 "Open file link or URL at mouse."
7268 (interactive "e")
7269 (mouse-set-point ev)
7270 (if (eq major-mode 'org-agenda-mode)
7271 (org-agenda-copy-local-variable 'org-link-abbrev-alist-local))
7272 (org-open-at-point))
7274 (defvar org-window-config-before-follow-link nil
7275 "The window configuration before following a link.
7276 This is saved in case the need arises to restore it.")
7278 (defvar org-open-link-marker (make-marker)
7279 "Marker pointing to the location where `org-open-at-point; was called.")
7281 ;;;###autoload
7282 (defun org-open-at-point-global ()
7283 "Follow a link like Org-mode does.
7284 This command can be called in any mode to follow a link that has
7285 Org-mode syntax."
7286 (interactive)
7287 (org-run-like-in-org-mode 'org-open-at-point))
7289 ;;;###autoload
7290 (defun org-open-link-from-string (s &optional arg)
7291 "Open a link in the string S, as if it was in Org-mode."
7293 (with-temp-buffer
7294 (let ((org-inhibit-startup t))
7295 (org-mode)
7296 (insert s)
7297 (goto-char (point-min))
7298 (org-open-at-point arg))))
7300 (defun org-open-at-point (&optional in-emacs)
7301 "Open link at or after point.
7302 If there is no link at point, this function will search forward up to
7303 the end of the current subtree.
7304 Normally, files will be opened by an appropriate application. If the
7305 optional argument IN-EMACS is non-nil, Emacs will visit the file.
7306 With a double prefix argument, try to open outside of Emacs, in the
7307 application the system uses for this file type."
7308 (interactive "P")
7309 (org-load-modules-maybe)
7310 (move-marker org-open-link-marker (point))
7311 (setq org-window-config-before-follow-link (current-window-configuration))
7312 (org-remove-occur-highlights nil nil t)
7313 (cond
7314 ((org-at-timestamp-p t) (org-follow-timestamp-link))
7315 ((or (org-footnote-at-reference-p) (org-footnote-at-definition-p))
7316 (org-footnote-action))
7317 (t
7318 (let (type path link line search (pos (point)))
7319 (catch 'match
7320 (save-excursion
7322 (when (org-in-regexp org-bracket-link-regexp)
7323 (setq link (org-extract-attributes
7324 (org-link-unescape (org-match-string-no-properties 1))))
7326 (setq link (replace-match " " t t link)))
7327 (setq link (org-link-expand-abbrev link))
7328 (cond
7329 ((or (file-name-absolute-p link)
7331 (setq type "file" path link))
7332 ((string-match org-link-re-with-space3 link)
7333 (setq type (match-string 1 link) path (match-string 2 link)))
7334 (t (setq type "thisfile" path link)))
7335 (throw 'match t)))
7337 (when (get-text-property (point) 'org-linked-text)
7338 (setq type "thisfile"
7339 pos (if (get-text-property (1+ (point)) 'org-linked-text)
7340 (1+ (point)) (point))
7341 path (buffer-substring
7342 (previous-single-property-change pos 'org-linked-text)
7343 (next-single-property-change pos 'org-linked-text)))
7344 (throw 'match t))
7346 (save-excursion
7347 (when (or (org-in-regexp org-angle-link-re)
7348 (org-in-regexp org-plain-link-re))
7349 (setq type (match-string 1) path (match-string 2))
7350 (throw 'match t)))
7352 (setq type "tree-match"
7353 path (match-string 1))
7354 (throw 'match t))
7355 (save-excursion
7357 (setq type "tags"
7358 path (match-string 1))
7359 (while (string-match ":" path)
7360 (setq path (replace-match "+" t t path)))
7361 (throw 'match t))))
7362 (unless path
7363 (error "No link found"))
7364 ;; Remove any trailing spaces in path
7366 (setq path (replace-match "" t t path)))
7367 (if (and org-link-translation-function
7368 (fboundp org-link-translation-function))
7369 ;; Check if we need to translate the link
7370 (let ((tmp (funcall org-link-translation-function type path)))
7371 (setq type (car tmp) path (cdr tmp))))
7373 (cond
7375 ((assoc type org-link-protocols)
7376 (funcall (nth 1 (assoc type org-link-protocols)) path))
7378 ((equal type "mailto")
7379 (let ((cmd (car org-link-mailto-program))
7380 (args (cdr org-link-mailto-program)) args1
7381 (address path) (subject "") a)
7383 (setq address (match-string 1 path)
7384 subject (org-link-escape (match-string 2 path))))
7385 (while args
7386 (cond
7387 ((not (stringp (car args))) (push (pop args) args1))
7388 (t (setq a (pop args))
7389 (if (string-match "%a" a)
7390 (setq a (replace-match address t t a)))
7391 (if (string-match "%s" a)
7392 (setq a (replace-match subject t t a)))
7393 (push a args1))))
7394 (apply cmd (nreverse args1))))
7396 ((member type '("http" "https" "ftp" "news"))
7397 (browse-url (concat type ":" (org-link-escape
7398 path org-link-escape-chars-browser))))
7400 ((member type '("message"))
7401 (browse-url (concat type ":" path)))
7403 ((string= type "tags")
7404 (org-tags-view in-emacs path))
7405 ((string= type "thisfile")
7406 (if in-emacs
7407 (switch-to-buffer-other-window
7408 (org-get-buffer-for-internal-link (current-buffer)))
7409 (org-mark-ring-push))
7410 (let ((cmd `(org-link-search
7411 ,path
7412 ,(cond ((equal in-emacs '(4)) 'occur)
7413 ((equal in-emacs '(16)) 'org-occur)
7414 (t nil))
7415 ,pos)))
7416 (condition-case nil (eval cmd)
7417 (error (progn (widen) (eval cmd))))))
7419 ((string= type "tree-match")
7422 ((string= type "file")
7424 (setq line (string-to-number (match-string 1 path))
7425 path (substring path 0 (match-beginning 0)))
7427 (setq search (match-string 1 path)
7428 path (substring path 0 (match-beginning 0)))))
7429 (if (string-match "[*?{]" (file-name-nondirectory path))
7430 (dired path)
7431 (org-open-file path in-emacs line search)))
7433 ((string= type "news")
7434 (require 'org-gnus)
7435 (org-gnus-follow-link path))
7437 ((string= type "shell")
7438 (let ((cmd path))
7439 (if (or (not org-confirm-shell-link-function)
7440 (funcall org-confirm-shell-link-function
7442 (org-add-props cmd nil
7443 'face 'org-warning))))
7444 (progn
7445 (message "Executing %s" cmd)
7446 (shell-command cmd))
7447 (error "Abort"))))
7449 ((string= type "elisp")
7450 (let ((cmd path))
7451 (if (or (not org-confirm-elisp-link-function)
7452 (funcall org-confirm-elisp-link-function
7454 (org-add-props cmd nil
7455 'face 'org-warning))))
7456 (message "%s => %s" cmd
7457 (if (equal (string-to-char cmd) ?\()
7458 (eval (read cmd))
7459 (call-interactively (read cmd))))
7460 (error "Abort"))))
7462 (t
7463 (browse-url-at-point))))))
7464 (move-marker org-open-link-marker nil)
7465 (run-hook-with-args 'org-follow-link-hook))
7467 ;;;; Time estimates
7469 (defun org-get-effort (&optional pom)
7470 "Get the effort estimate for the current entry."
7471 (org-entry-get pom org-effort-property))
7473 ;;; File search
7475 (defvar org-create-file-search-functions nil
7476 "List of functions to construct the right search string for a file link.
7477 These functions are called in turn with point at the location to
7478 which the link should point.
7480 A function in the hook should first test if it would like to
7481 handle this file type, for example by checking the major-mode or
7482 the file extension. If it decides not to handle this file, it
7483 should just return nil to give other functions a chance. If it
7484 does handle the file, it must return the search string to be used
7485 when following the link. The search string will be part of the
7486 file link, given after a double colon, and `org-open-at-point'
7487 will automatically search for it. If special measures must be
7488 taken to make the search successful, another function should be
7489 added to the companion hook `org-execute-file-search-functions',
7490 which see.
7492 A function in this hook may also use `setq' to set the variable
7493 `description' to provide a suggestion for the descriptive text to
7494 be used for this link when it gets inserted into an Org-mode
7497 (defvar org-execute-file-search-functions nil
7498 "List of functions to execute a file search triggered by a link.
7500 Functions added to this hook must accept a single argument, the
7501 search string that was part of the file link, the part after the
7502 double colon. The function must first check if it would like to
7503 handle this search, for example by checking the major-mode or the
7504 file extension. If it decides not to handle this search, it
7505 should just return nil to give other functions a chance. If it
7506 does handle the search, it must return a non-nil value to keep
7507 other functions from trying.
7509 Each function can access the current prefix argument through the
7510 variable `current-prefix-argument'. Note that a single prefix is
7511 used to force opening a link in Emacs, so it may be good to only
7512 use a numeric or double prefix to guide the search function.
7514 In case this is needed, a function in this hook can also restore
7515 the window configuration before `org-open-at-point' was called using:
7517 (set-window-configuration org-window-config-before-follow-link)")
7519 (defun org-link-search (s &optional type avoid-pos)
7520 "Search for a link search option.
7521 If S is surrounded by forward slashes, it is interpreted as a
7522 regular expression. In org-mode files, this will create an `org-occur'
7523 sparse tree. In ordinary files, `occur' will be used to list matches.
7524 If the current buffer is in `dired-mode', grep will be used to search
7525 in all files. If AVOID-POS is given, ignore matches near that position."
7526 (let ((case-fold-search t)
7530 org-emphasis-alist)
7532 (pos (point))
7533 (pre nil) (post nil)
7534 words re0 re1 re2 re3 re4_ re4 re5 re2a re2a_ reall)
7535 (cond
7536 ;; First check if there are any special
7537 ((run-hook-with-args-until-success 'org-execute-file-search-functions s))
7538 ;; Now try the builtin stuff
7539 ((save-excursion
7540 (goto-char (point-min))
7541 (and
7542 (re-search-forward
7543 (concat "<<" (regexp-quote s0) ">>") nil t)
7544 (setq type 'dedicated
7545 pos (match-beginning 0))))
7546 ;; There is an exact target for this
7547 (goto-char pos))
7549 (save-excursion
7550 (goto-char (point-min))
7551 (and
7552 (re-search-forward
7553 (concat "[^[]" (regexp-quote
7554 (format org-coderef-label-format
7555 (match-string 1 s0))))
7556 nil t)
7557 (setq type 'dedicated
7558 pos (1+ (match-beginning 0))))))
7559 ;; There is a coderef target for this
7560 (goto-char pos))
7562 ;; A regular expression
7563 (cond
7564 ((org-mode-p)
7565 (org-occur (match-string 1 s)))
7566 ;;((eq major-mode 'dired-mode)
7567 ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *")))
7568 (t (org-do-occur (match-string 1 s)))))
7569 (t
7570 ;; A normal search strings
7571 (when (equal (string-to-char s) ?*)
7572 ;; Anchor on headlines, post may include tags.
7575 s (substring s 1)))
7576 (remove-text-properties
7577 0 (length s)
7578 '(face nil mouse-face nil keymap nil fontified nil) s)
7579 ;; Make a series of regular expressions to find a match
7588 re4 (concat "[^a-zA-Z_]" re4_)
7590 re1 (concat pre re2 post)
7591 re3 (concat pre (if pre re4_ re4) post)
7592 re5 (concat pre ".*" re4)
7593 re2 (concat pre re2)
7594 re2a (concat pre (if pre re2a_ re2a))
7595 re4 (concat pre (if pre re4_ re4))
7599 ))
7600 (cond
7601 ((eq type 'org-occur) (org-occur reall))
7602 ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup))
7603 (t (goto-char (point-min))
7604 (setq type 'fuzzy)
7605 (if (or (and (org-search-not-self 1 re0 nil t) (setq type 'dedicated))
7606 (org-search-not-self 1 re1 nil t)
7607 (org-search-not-self 1 re2 nil t)
7608 (org-search-not-self 1 re2a nil t)
7609 (org-search-not-self 1 re3 nil t)
7610 (org-search-not-self 1 re4 nil t)
7611 (org-search-not-self 1 re5 nil t)
7612 )
7613 (goto-char (match-beginning 1))
7614 (goto-char pos)
7615 (error "No match")))))
7616 (t
7617 ;; Normal string-search
7618 (goto-char (point-min))
7619 (if (search-forward s nil t)
7620 (goto-char (match-beginning 0))
7621 (error "No match"))))
7622 (and (org-mode-p) (org-show-context 'link-search))
7623 type))
7625 (defun org-search-not-self (group &rest args)
7626 "Execute `re-search-forward', but only accept matches that do not
7627 enclose the position of `org-open-link-marker'."
7628 (let ((m org-open-link-marker))
7629 (catch 'exit
7630 (while (apply 're-search-forward args)
7631 (unless (get-text-property (match-end group) 'intangible) ; Emacs 21
7632 (goto-char (match-end group))
7633 (if (and (or (not (eq (marker-buffer m) (current-buffer)))
7634 (> (match-beginning 0) (marker-position m))
7635 (< (match-end 0) (marker-position m)))
7636 (save-match-data
7637 (or (not (org-in-regexp
7638 org-bracket-link-analytic-regexp 1))
7639 (not (match-end 4)) ; no description
7640 (and (<= (match-beginning 4) (point))
7641 (>= (match-end 4) (point))))))
7642 (throw 'exit (point))))))))
7644 (defun org-get-buffer-for-internal-link (buffer)
7645 "Return a buffer to be used for displaying the link target of internal links."
7646 (cond
7647 ((not org-display-internal-link-with-indirect-buffer)
7648 buffer)
7649 ((string-match "(Clone)$" (buffer-name buffer))
7650 (message "Buffer is already a clone, not making another one")
7651 ;; we also do not modify visibility in this case
7652 buffer)
7653 (t ; make a new indirect buffer for displaying the link
7654 (let* ((bn (buffer-name buffer))
7655 (ibn (concat bn "(Clone)"))
7656 (ib (or (get-buffer ibn) (make-indirect-buffer buffer ibn 'clone))))
7657 (with-current-buffer ib (org-overview))
7658 ib))))
7660 (defun org-do-occur (regexp &optional cleanup)
7661 "Call the Emacs command `occur'.
7662 If CLEANUP is non-nil, remove the printout of the regular expression
7663 in the *Occur* buffer. This is useful if the regex is long and not useful
7664 to read."
7665 (occur regexp)
7666 (when cleanup
7667 (let ((cwin (selected-window)) win beg end)
7668 (when (setq win (get-buffer-window "*Occur*"))
7669 (select-window win))
7670 (goto-char (point-min))
7671 (when (re-search-forward "match[a-z]+" nil t)
7672 (setq beg (match-end 0))
7674 (setq end (1- (match-beginning 0)))))
7675 (and beg end (let ((inhibit-read-only t)) (delete-region beg end)))
7676 (goto-char (point-min))
7677 (select-window cwin))))
7679 ;;; The mark ring for links jumps
7681 (defvar org-mark-ring nil
7682 "Mark ring for positions before jumps in Org-mode.")
7683 (defvar org-mark-ring-last-goto nil
7684 "Last position in the mark ring used to go back.")
7685 ;; Fill and close the ring
7686 (setq org-mark-ring nil org-mark-ring-last-goto nil) ;; in case file is reloaded
7687 (loop for i from 1 to org-mark-ring-length do
7688 (push (make-marker) org-mark-ring))
7689 (setcdr (nthcdr (1- org-mark-ring-length) org-mark-ring)
7690 org-mark-ring)
7692 (defun org-mark-ring-push (&optional pos buffer)
7693 "Put the current position or POS into the mark ring and rotate it."
7694 (interactive)
7695 (setq pos (or pos (point)))
7696 (setq org-mark-ring (nthcdr (1- org-mark-ring-length) org-mark-ring))
7697 (move-marker (car org-mark-ring)
7698 (or pos (point))
7699 (or buffer (current-buffer)))
7700 (message "%s"
7701 (substitute-command-keys
7704 (defun org-mark-ring-goto (&optional n)
7705 "Jump to the previous position in the mark ring.
7706 With prefix arg N, jump back that many stored positions. When
7707 called several times in succession, walk through the entire ring.
7708 Org-mode commands jumping to a different position in the current file,
7709 or to another Org-mode file, automatically push the old position
7710 onto the ring."
7711 (interactive "p")
7712 (let (p m)
7713 (if (eq last-command this-command)
7714 (setq p (nthcdr n (or org-mark-ring-last-goto org-mark-ring)))
7715 (setq p org-mark-ring))
7716 (setq org-mark-ring-last-goto p)
7717 (setq m (car p))
7718 (switch-to-buffer (marker-buffer m))
7719 (goto-char m)
7720 (if (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto))))
7722 (defun org-remove-angle-brackets (s)
7723 (if (equal (substring s 0 1) "<") (setq s (substring s 1)))
7724 (if (equal (substring s -1) ">") (setq s (substring s 0 -1)))
7725 s)
7726 (defun org-add-angle-brackets (s)
7727 (if (equal (substring s 0 1) "<") nil (setq s (concat "<" s)))
7728 (if (equal (substring s -1) ">") nil (setq s (concat s ">")))
7729 s)
7730 (defun org-remove-double-quotes (s)
7733 s)
7735 ;;; Following specific links
7737 (defun org-follow-timestamp-link ()
7738 (cond
7739 ((org-at-date-range-p t)
7740 (let ((org-agenda-start-on-weekday)
7741 (t1 (match-string 1))
7742 (t2 (match-string 2)))
7743 (setq t1 (time-to-days (org-time-string-to-time t1))
7744 t2 (time-to-days (org-time-string-to-time t2)))
7745 (org-agenda-list nil t1 (1+ (- t2 t1)))))
7746 ((org-at-timestamp-p t)
7747 (org-agenda-list nil (time-to-days (org-time-string-to-time
7748 (substring (match-string 1) 0 10)))
7749 1))
7750 (t (error "This should not happen"))))
7753 ;;; Following file links
7754 (defvar org-wait nil)
7755 (defun org-open-file (path &optional in-emacs line search)
7756 "Open the file at PATH.
7757 First, this expands any special file name abbreviations. Then the
7758 configuration variable `org-file-apps' is checked if it contains an
7759 entry for this file type, and if yes, the corresponding command is launched.
7761 If no application is found, Emacs simply visits the file.
7763 With optional prefix argument IN-EMACS, Emacs will visit the file.
7764 With a double C-c C-u prefix arg, Org tries to avoid opening in Emacs
7765 and o use an external application to visit the file.
7767 Optional LINE specifies a line to go to, optional SEARCH a string to
7768 search for. If LINE or SEARCH is given, the file will always be
7769 opened in Emacs.
7770 If the file does not exist, an error is thrown."
7771 (setq in-emacs (or in-emacs line search))
7772 (let* ((file (if (equal path "")
7773 buffer-file-name
7774 (substitute-in-file-name (expand-file-name path))))
7775 (apps (append org-file-apps (org-default-apps)))
7776 (remp (and (assq 'remote apps) (org-file-remote-p file)))
7777 (dirp (if remp nil (file-directory-p file)))
7778 (file (if (and dirp org-open-directory-means-index-dot-org)
7779 (concat (file-name-as-directory file) "index.org")
7780 file))
7781 (a-m-a-p (assq 'auto-mode apps))
7782 (dfile (downcase file))
7783 (old-buffer (current-buffer))
7784 (old-pos (point))
7785 (old-mode major-mode)
7786 ext cmd)
7788 (setq ext (match-string 1 dfile))
7790 (setq ext (match-string 1 dfile))))
7791 (cond
7792 ((equal in-emacs '(16))
7793 (setq cmd (cdr (assoc 'system apps))))
7794 (in-emacs (setq cmd 'emacs))
7795 (t
7796 (setq cmd (or (and remp (cdr (assoc 'remote apps)))
7797 (and dirp (cdr (assoc 'directory apps)))
7798 (assoc-default dfile (org-apps-regexp-alist apps a-m-a-p)
7799 'string-match)
7800 (cdr (assoc ext apps))
7801 (cdr (assoc t apps))))))
7802 (when (eq cmd 'system)
7803 (setq cmd (cdr (assoc 'system apps))))
7804 (when (eq cmd 'default)
7805 (setq cmd (cdr (assoc t apps))))
7806 (when (eq cmd 'mailcap)
7807 (require 'mailcap)
7808 (mailcap-parse-mailcaps)
7809 (let* ((mime-type (mailcap-extension-to-mime (or ext "")))
7810 (command (mailcap-mime-info mime-type)))
7811 (if (stringp command)
7812 (setq cmd command)
7813 (setq cmd 'emacs))))
7814 (if (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files
7815 (not (file-exists-p file))
7816 (not org-open-non-existing-files))
7817 (error "No such file: %s" file))
7818 (cond
7820 ;; Remove quotes around the file name - we'll use shell-quote-argument.
7822 (setq cmd (replace-match "%s" t t cmd)))
7823 (while (string-match "%s" cmd)
7824 (setq cmd (replace-match
7825 (save-match-data
7826 (shell-quote-argument
7827 (convert-standard-filename file)))
7828 t t cmd)))
7829 (save-window-excursion
7830 (start-process-shell-command cmd nil cmd)
7831 (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
7832 ))
7833 ((or (stringp cmd)
7834 (eq cmd 'emacs))
7835 (funcall (cdr (assq 'file org-link-frame-setup)) file)
7836 (widen)
7837 (if line (goto-line line)
7838 (if search (org-link-search search))))
7839 ((consp cmd)
7840 (let ((file (convert-standard-filename file)))
7841 (eval cmd)))
7842 (t (funcall (cdr (assq 'file org-link-frame-setup)) file)))
7843 (and (org-mode-p) (eq old-mode 'org-mode)
7844 (or (not (equal old-buffer (current-buffer)))
7845 (not (equal old-pos (point))))
7846 (org-mark-ring-push old-pos old-buffer))))
7848 (defun org-default-apps ()
7849 "Return the default applications for this operating system."
7850 (cond
7851 ((eq system-type 'darwin)
7852 org-file-apps-defaults-macosx)
7853 ((eq system-type 'windows-nt)
7854 org-file-apps-defaults-windowsnt)
7855 (t org-file-apps-defaults-gnu)))
7857 (defun org-apps-regexp-alist (list &optional add-auto-mode)
7858 "Convert extensions to regular expressions in the cars of LIST.
7859 Also, weed out any non-string entries, because the return value is used
7860 only for regexp matching.
7861 When ADD-AUTO-MODE is set, make all matches in `auto-mode-alist'
7862 point to the symbol `emacs', indicating that the file should
7863 be opened in Emacs."
7864 (append
7865 (delq nil
7866 (mapcar (lambda (x)
7867 (if (not (stringp (car x)))
7868 nil
7870 x
7872 list))
7873 (if add-auto-mode
7874 (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist))))
7876 (defvar ange-ftp-name-format) ; to silence the XEmacs compiler.
7877 (defun org-file-remote-p (file)
7878 "Test whether FILE specifies a location on a remote system.
7879 Return non-nil if the location is indeed remote.
7883 (cond ((fboundp 'file-remote-p)
7884 (file-remote-p file))
7885 ((fboundp 'tramp-handle-file-remote-p)
7886 (tramp-handle-file-remote-p file))
7887 ((and (boundp 'ange-ftp-name-format)
7888 (string-match (car ange-ftp-name-format) file))
7889 t)
7890 (t nil)))
7893 ;;;; Refiling
7895 (defun org-get-org-file ()
7896 "Read a filename, with default directory `org-directory'."
7897 (let ((default (or org-default-notes-file remember-data-file)))
7898 (read-file-name (format "File name [%s]: " default)
7899 (file-name-as-directory org-directory)
7900 default)))
7902 (defun org-notes-order-reversed-p ()
7903 "Check if the current file should receive notes in reversed order."
7904 (cond
7905 ((not org-reverse-note-order) nil)
7906 ((eq t org-reverse-note-order) t)
7907 ((not (listp org-reverse-note-order)) nil)
7908 (t (catch 'exit
7909 (let ((all org-reverse-note-order)
7910 entry)
7911 (while (setq entry (pop all))
7912 (if (string-match (car entry) buffer-file-name)
7913 (throw 'exit (cdr entry))))
7914 nil)))))
7916 (defvar org-refile-target-table nil
7917 "The list of refile targets, created by `org-refile'.")
7919 (defvar org-agenda-new-buffers nil
7920 "Buffers created to visit agenda files.")
7922 (defun org-get-refile-targets (&optional default-buffer)
7923 "Produce a table with refile targets."
7924 (let ((entries (or org-refile-targets '((nil . (:level . 1)))))
7925 targets txt re files f desc descre fast-path-p level)
7926 (message "Getting targets...")
7927 (with-current-buffer (or default-buffer (current-buffer))
7928 (while (setq entry (pop entries))
7929 (setq files (car entry) desc (cdr entry))
7930 (setq fast-path-p nil)
7931 (cond
7932 ((null files) (setq files (list (current-buffer))))
7933 ((eq files 'org-agenda-files)
7934 (setq files (org-agenda-files 'unrestricted)))
7935 ((and (symbolp files) (fboundp files))
7936 (setq files (funcall files)))
7937 ((and (symbolp files) (boundp files))
7938 (setq files (symbol-value files))))
7939 (if (stringp files) (setq files (list files)))
7940 (cond
7941 ((eq (car desc) :tag)
7943 ((eq (car desc) :todo)
7945 ((eq (car desc) :regexp)
7946 (setq descre (cdr desc)))
7947 ((eq (car desc) :level)
7949 (if org-odd-levels-only
7950 (1- (* 2 (cdr desc)))
7951 (cdr desc)))
7953 ((eq (car desc) :maxlevel)
7954 (setq fast-path-p t)
7956 (if org-odd-levels-only
7957 (1- (* 2 (cdr desc)))
7958 (cdr desc)))
7960 (t (error "Bad refiling target description %s" desc)))
7961 (while (setq f (pop files))
7962 (save-excursion
7963 (set-buffer (if (bufferp f) f (org-get-agenda-file-buffer f)))
7964 (if (bufferp f) (setq f (buffer-file-name (buffer-base-buffer f))))
7965 (setq f (expand-file-name f))
7966 (save-excursion
7967 (save-restriction
7968 (widen)
7969 (goto-char (point-min))
7970 (while (re-search-forward descre nil t)
7971 (goto-char (point-at-bol))
7972 (when (looking-at org-complex-heading-regexp)
7973 (setq level (org-reduced-level (- (match-end 1) (match-beginning 1)))
7974 txt (org-link-display-format (match-string 4))
7975 re (concat "^" (regexp-quote
7976 (buffer-substring (match-beginning 1)
7977 (match-end 4)))))
7979 (regexp-quote
7980 (match-string 5)))))
7982 (when org-refile-use-outline-path
7983 (setq txt (mapconcat 'org-protect-slash
7984 (append
7985 (if (eq org-refile-use-outline-path 'file)
7986 (list (file-name-nondirectory
7987 (buffer-file-name (buffer-base-buffer))))
7988 (if (eq org-refile-use-outline-path 'full-file-path)
7989 (list (buffer-file-name (buffer-base-buffer)))))
7990 (org-get-outline-path fast-path-p level txt)
7991 (list txt))
7992 "/")))
7993 (push (list txt f re (point)) targets))
7994 (goto-char (point-at-eol))))))))
7995 (message "Getting targets...done")
7996 (nreverse targets))))
7998 (defun org-protect-slash (s)
7999 (while (string-match "/" s)
8001 s)
8003 (defvar org-olpa (make-vector 20 nil))
8005 (defun org-get-outline-path (&optional fastp level heading)
8006 "Return the outline path to the current entry, as a list."
8007 (if fastp
8008 (progn
8009 (if (> level 19)
8010 (error "Outline path failure, more than 19 levels."))
8011 (loop for i from level upto 19 do
8012 (aset org-olpa i nil))
8013 (prog1
8014 (delq nil (append org-olpa nil))
8015 (aset org-olpa level heading)))
8016 (let (rtn)
8017 (save-excursion
8018 (while (org-up-heading-safe)
8019 (when (looking-at org-complex-heading-regexp)
8020 (push (org-match-string-no-properties 4) rtn)))
8021 rtn))))
8023 (defvar org-refile-history nil
8024 "History for refiling operations.")
8026 (defun org-refile (&optional goto default-buffer)
8027 "Move the entry at point to another heading.
8028 The list of target headings is compiled using the information in
8029 `org-refile-targets', which see. This list is created before each use
8030 and will therefore always be up-to-date.
8032 At the target location, the entry is filed as a subitem of the target heading.
8033 Depending on `org-reverse-note-order', the new subitem will either be the
8034 first or the last subitem.
8036 If there is an active region, all entries in that region will be moved.
8037 However, the region must fulfil the requirement that the first heading
8038 is the first one sets the top-level of the moved text - at most siblings
8039 below it are allowed.
8041 With prefix arg GOTO, the command will only visit the target location,
8042 not actually move anything.
8043 With a double prefix `C-u C-u', go to the location where the last refiling
8044 operation has put the subtree."
8045 (interactive "P")
8046 (let* ((cbuf (current-buffer))
8047 (regionp (org-region-active-p))
8048 (region-start (and regionp (region-beginning)))
8049 (region-end (and regionp (region-end)))
8050 (region-length (and regionp (- region-end region-start)))
8051 (filename (buffer-file-name (buffer-base-buffer cbuf)))
8052 pos it nbuf file re level reversed)
8053 (when regionp (goto-char region-start)
8054 (unless (org-kill-is-subtree-p
8055 (buffer-substring region-start region-end))
8056 (error "The region is not a (sequence of) subtree(s)")))
8057 (if (equal goto '(16))
8058 (org-refile-goto-last-stored)
8059 (when (setq it (org-refile-get-location
8060 (if goto "Goto: " "Refile to: ") default-buffer))
8061 (setq file (nth 1 it)
8062 re (nth 2 it)
8063 pos (nth 3 it))
8064 (if (and (equal (buffer-file-name) file)
8065 (if regionp
8066 (and (>= pos region-start)
8067 (<= pos region-end))
8068 (and (>= pos (point))
8069 (< pos (save-excursion
8070 (org-end-of-subtree t t))))))
8071 (error "Cannot refile to position inside the tree or region"))
8073 (setq nbuf (or (find-buffer-visiting file)
8074 (find-file-noselect file)))
8075 (if goto
8076 (progn
8077 (switch-to-buffer nbuf)
8078 (goto-char pos)
8079 (org-show-context 'org-goto))
8080 (if regionp
8081 (progn
8082 (kill-new (buffer-substring region-start region-end))
8083 (org-save-markers-in-region region-start region-end))
8084 (org-copy-subtree 1 nil t))
8085 (save-excursion
8086 (set-buffer (setq nbuf (or (find-buffer-visiting file)
8087 (find-file-noselect file))))
8088 (setq reversed (org-notes-order-reversed-p))
8089 (save-excursion
8090 (save-restriction
8091 (widen)
8092 (goto-char pos)
8093 (looking-at outline-regexp)
8094 (setq level (org-get-valid-level (funcall outline-level) 1))
8095 (goto-char
8096 (if reversed
8097 (or (outline-next-heading) (point-max))
8098 (or (save-excursion (outline-get-next-sibling))
8099 (org-end-of-subtree t t)
8100 (point-max))))
8101 (if (not (bolp)) (newline))
8102 (bookmark-set "org-refile-last-stored")
8103 (org-paste-subtree level))))
8104 (if regionp
8105 (delete-region (point) (+ (point) region-length))
8106 (org-cut-subtree))
8107 (setq org-markers-to-move nil)
8110 (defun org-refile-goto-last-stored ()
8111 "Go to the location where the last refile was stored."
8112 (interactive)
8113 (bookmark-jump "org-refile-last-stored")
8114 (message "This is the location of the last refile"))
8116 (defun org-refile-get-location (&optional prompt default-buffer)
8117 "Prompt the user for a refile location, using PROMPT."
8118 (let ((org-refile-targets org-refile-targets)
8119 (org-refile-use-outline-path org-refile-use-outline-path))
8120 (setq org-refile-target-table (org-get-refile-targets default-buffer)))
8121 (unless org-refile-target-table
8122 (error "No refile targets"))
8123 (let* ((cbuf (current-buffer))
8124 (partial-completion-mode nil)
8125 (cfn (buffer-file-name (buffer-base-buffer cbuf)))
8126 (cfunc (if (and org-refile-use-outline-path
8127 org-outline-path-complete-in-steps)
8128 'org-olpath-completing-read
8129 'org-ido-completing-read))
8130 (extra (if org-refile-use-outline-path "/" ""))
8131 (filename (and cfn (expand-file-name cfn)))
8132 (tbl (mapcar
8133 (lambda (x)
8134 (if (not (equal filename (nth 1 x)))
8135 (cons (concat (car x) extra " ("
8136 (file-name-nondirectory (nth 1 x)) ")")
8137 (cdr x))
8138 (cons (concat (car x) extra) (cdr x))))
8139 org-refile-target-table))
8140 (completion-ignore-case t))
8141 (assoc (funcall cfunc prompt tbl nil t nil 'org-refile-history)
8142 tbl)))
8144 (defun org-olpath-completing-read (prompt collection &rest args)
8145 "Read an outline path like a file name."
8146 (let ((thetable collection)
8147 (org-completion-use-ido nil)) ; does not work with ido.
8148 (apply
8149 'org-ido-completing-read prompt
8150 (lambda (string predicate &optional flag)
8151 (let (rtn r f (l (length string)))
8152 (cond
8153 ((eq flag nil)
8154 ;; try completion
8155 (try-completion string thetable))
8156 ((eq flag t)
8157 ;; all-completions
8158 (setq rtn (all-completions string thetable predicate))
8159 (mapcar
8160 (lambda (x)
8161 (setq r (substring x l))
8162 (if (string-match " ([^)]*)$" x)
8163 (setq f (match-string 0 x))
8164 (setq f ""))
8165 (if (string-match "/" r)
8166 (concat string (substring r 0 (match-end 0)) f)
8167 x))
8168 rtn))
8169 ((eq flag 'lambda)
8170 ;; exact match?
8171 (assoc string thetable)))
8172 ))
8173 args)))
8175 ;;;; Dynamic blocks
8177 (defun org-find-dblock (name)
8178 "Find the first dynamic block with name NAME in the buffer.
8179 If not found, stay at current position and return nil."
8180 (let (pos)
8181 (save-excursion
8182 (goto-char (point-min))
8184 nil t)
8185 (match-beginning 0))))
8186 (if pos (goto-char pos))
8187 pos))
8189 (defconst org-dblock-start-re
8191 "Matches the startline of a dynamic block, with parameters.")
8194 "Matches the end of a dynamic block.")
8196 (defun org-create-dblock (plist)
8197 "Create a dynamic block section, with parameters taken from PLIST.
8198 PLIST must contain a :name entry which is used as name of the block."
8199 (unless (bolp) (newline))
8200 (let ((name (plist-get plist :name)))
8201 (insert "#+BEGIN: " name)
8202 (while plist
8203 (if (eq (car plist) :name)
8204 (setq plist (cddr plist))
8205 (insert " " (prin1-to-string (pop plist)))))
8207 (beginning-of-line -2)))
8209 (defun org-prepare-dblock ()
8210 "Prepare dynamic block for refresh.
8211 This empties the block, puts the cursor at the insert position and returns
8212 the property list including an extra property :name with the block name."
8213 (unless (looking-at org-dblock-start-re)
8214 (error "Not at a dynamic block"))
8215 (let* ((begdel (1+ (match-end 0)))
8216 (name (org-no-properties (match-string 1)))
8217 (params (append (list :name name)
8218 (read (concat "(" (match-string 3) ")")))))
8219 (unless (re-search-forward org-dblock-end-re nil t)
8220 (error "Dynamic block not terminated"))
8221 (setq params
8222 (append params
8223 (list :content (buffer-substring
8224 begdel (match-beginning 0)))))
8225 (delete-region begdel (match-beginning 0))
8226 (goto-char begdel)
8227 (open-line 1)
8228 params))
8230 (defun org-map-dblocks (&optional command)
8231 "Apply COMMAND to all dynamic blocks in the current buffer.
8232 If COMMAND is not given, use `org-update-dblock'."
8233 (let ((cmd (or command 'org-update-dblock))
8234 pos)
8235 (save-excursion
8236 (goto-char (point-min))
8237 (while (re-search-forward org-dblock-start-re nil t)
8238 (goto-char (setq pos (match-beginning 0)))
8239 (condition-case nil
8240 (funcall cmd)
8241 (error (message "Error during update of dynamic block")))
8242 (goto-char pos)
8243 (unless (re-search-forward org-dblock-end-re nil t)
8244 (error "Dynamic block not terminated"))))))
8246 (defun org-dblock-update (&optional arg)
8247 "User command for updating dynamic blocks.
8248 Update the dynamic block at point. With prefix ARG, update all dynamic
8249 blocks in the buffer."
8250 (interactive "P")
8251 (if arg
8252 (org-update-all-dblocks)
8253 (or (looking-at org-dblock-start-re)
8254 (org-beginning-of-dblock))
8255 (org-update-dblock)))
8257 (defun org-update-dblock ()
8258 "Update the dynamic block at point
8259 This means to empty the block, parse for parameters and then call
8260 the correct writing function."
8261 (save-window-excursion
8262 (let* ((pos (point))
8263 (line (org-current-line))
8264 (params (org-prepare-dblock))
8265 (name (plist-get params :name))
8266 (cmd (intern (concat "org-dblock-write:" name))))
8267 (message "Updating dynamic block `%s' at line %d..." name line)
8268 (funcall cmd params)
8269 (message "Updating dynamic block `%s' at line %d...done" name line)
8270 (goto-char pos))))
8272 (defun org-beginning-of-dblock ()
8273 "Find the beginning of the dynamic block at point.
8274 Error if there is no such block at point."
8275 (let ((pos (point))
8276 beg)
8277 (end-of-line 1)
8278 (if (and (re-search-backward org-dblock-start-re nil t)
8279 (setq beg (match-beginning 0))
8280 (re-search-forward org-dblock-end-re nil t)
8281 (> (match-end 0) pos))
8282 (goto-char beg)
8283 (goto-char pos)
8284 (error "Not in a dynamic block"))))
8286 (defun org-update-all-dblocks ()
8287 "Update all dynamic blocks in the buffer.
8288 This function can be used in a hook."
8289 (when (org-mode-p)
8290 (org-map-dblocks 'org-update-dblock)))
8293 ;;;; Completion
8295 (defconst org-additional-option-like-keywords
8296 '("BEGIN_HTML" "BEGIN_LaTeX" "END_HTML" "END_LaTeX"
8297 "ORGTBL" "HTML:" "LaTeX:" "BEGIN:" "END:" "TBLFM"
8298 "BEGIN_EXAMPLE" "END_EXAMPLE"
8299 "BEGIN_QUOTE" "END_QUOTE"
8300 "BEGIN_VERSE" "END_VERSE"
8301 "BEGIN_SRC" "END_SRC"
8302 "CAPTION" "LABEL" "ATTR_HTML" "ATTR_LaTeX"))
8304 (defcustom org-structure-template-alist
8305 '(
8316 ("L" "#+latex: "
8320 ("H" "#+html: "
8323 ("A" "#+ascii: ")
8324 ("i" "#+include %file ?"
8326 )
8327 "Structure completion elements.
8328 This is a list of abbreviation keys and values. The value gets inserted
8329 it you type @samp{.} followed by the key and then the completion key,
8330 usually `M-TAB'. %file will be replaced by a file name after prompting
8331 for the file using completion.
8332 There are two templates for each key, the first uses the original Org syntax,
8333 the second uses Emacs Muse-like syntax tags. These Muse-like tags become
8334 the default when the /org-mtags.el/ module has been loaded. See also the
8335 variable `org-mtags-prefer-muse-templates'.
8336 This is an experimental feature, it is undecided if it is going to stay in."
8337 :group 'org-completion
8338 :type '(repeat
8339 (string :tag "Key")
8340 (string :tag "Template")
8341 (string :tag "Muse Template")))
8343 (defun org-try-structure-completion ()
8344 "Try to complete a structure template before point.
8346 expands them."
8347 (let ((l (buffer-substring (point-at-bol) (point)))
8348 a)
8351 (setq a (assoc (match-string 1 l) org-structure-template-alist)))
8352 (org-complete-expand-structure-template (+ -1 (point-at-bol)
8353 (match-beginning 1)) a)
8354 t)))
8356 (defun org-complete-expand-structure-template (start cell)
8357 "Expand a structure template."
8358 (let* ((musep (org-bound-and-true-p org-mtags-prefer-muse-templates))
8359 (rpl (nth (if musep 2 1) cell)))
8360 (delete-region start (point))
8362 (cond
8363 ((bolp))
8365 (delete-region (point-at-bol) (point)))
8366 (t (newline))))
8367 (setq start (point))
8368 (if (string-match "%file" rpl)
8369 (setq rpl (replace-match
8370 (concat
8372 (save-match-data
8373 (abbreviate-file-name (read-file-name "Include file: ")))
8375 t t rpl)))
8376 (insert rpl)
8380 (defun org-complete (&optional arg)
8381 "Perform completion on word at point.
8382 At the beginning of a headline, this completes TODO keywords as given in
8383 `org-todo-keywords'.
8384 If the current word is preceded by a backslash, completes the TeX symbols
8385 that are supported for HTML support.
8387 setting file options.
8389 At all other locations, this simply calls the value of
8390 `org-completion-fallback-command'."
8391 (interactive "P")
8392 (org-without-partial-completion
8393 (catch 'exit
8394 (let* ((a nil)
8395 (end (point))
8396 (beg1 (save-excursion
8397 (skip-chars-backward (org-re "[:alnum:]_@"))
8398 (point)))
8399 (beg (save-excursion
8400 (skip-chars-backward "a-zA-Z0-9_:$")
8401 (point)))
8402 (confirm (lambda (x) (stringp (car x))))
8403 (searchhead (equal (char-before beg) ?*))
8404 (struct
8405 (when (and (member (char-before beg1) '(?. ?<))
8406 (setq a (assoc (buffer-substring beg1 (point))
8407 org-structure-template-alist)))
8408 (org-complete-expand-structure-template (1- beg1) a)
8409 (throw 'exit t)))
8410 (tag (and (equal (char-before beg1) ?:)
8411 (equal (char-after (point-at-bol)) ?*)))
8412 (prop (and (equal (char-before beg1) ?:)
8413 (not (equal (char-after (point-at-bol)) ?*))))
8415 (link (equal (char-before beg) ?\[))
8416 (opt (equal (buffer-substring (max (point-at-bol) (- beg 2))
8417 beg)
8418 "#+"))
8420 (buffer-substring (point-at-bol) (point))))
8421 (completion-ignore-case opt)
8422 (type nil)
8423 (tbl nil)
8424 (table (cond
8425 (opt
8426 (setq type :opt)
8427 (require 'org-exp)
8428 (append
8429 (mapcar
8430 (lambda (x)
8432 (cons (match-string 2 x) (match-string 1 x)))
8434 (mapcar 'list org-additional-option-like-keywords)))
8435 (startup
8436 (setq type :startup)
8437 org-startup-options)
8438 (link (append org-link-abbrev-alist-local
8439 org-link-abbrev-alist))
8440 (texp
8441 (setq type :tex)
8442 org-html-entities)
8444 (buffer-substring (point-at-bol) beg))
8445 (setq type :todo)
8446 (mapcar 'list org-todo-keywords-1))
8447 (searchhead
8448 (setq type :searchhead)
8449 (save-excursion
8450 (goto-char (point-min))
8451 (while (re-search-forward org-todo-line-regexp nil t)
8452 (push (list
8453 (org-make-org-heading-search-string
8454 (match-string 3) t))
8455 tbl)))
8456 tbl)
8457 (tag (setq type :tag beg beg1)
8458 (or org-tag-alist (org-get-buffer-tags)))
8459 (prop (setq type :prop beg beg1)
8460 (mapcar 'list (org-buffer-property-keys nil t t)))
8461 (t (progn
8462 (call-interactively org-completion-fallback-command)
8463 (throw 'exit nil)))))
8464 (pattern (buffer-substring-no-properties beg end))
8465 (completion (try-completion pattern table confirm)))
8466 (cond ((eq completion t)
8467 (if (not (assoc (upcase pattern) table))
8468 (message "Already complete")
8469 (if (and (equal type :opt)
8470 (not (member (car (assoc (upcase pattern) table))
8471 org-additional-option-like-keywords)))
8472 (insert (substring (cdr (assoc (upcase pattern) table))
8473 (length pattern)))
8474 (if (memq type '(:tag :prop)) (insert ":")))))
8475 ((null completion)
8477 (ding))
8478 ((not (string= pattern completion))
8479 (delete-region beg end)
8480 (if (string-match " +$" completion)
8481 (setq completion (replace-match "" t t completion)))
8482 (insert completion)
8483 (if (get-buffer-window "*Completions*")
8484 (delete-window (get-buffer-window "*Completions*")))
8485 (if (assoc completion table)
8486 (if (eq type :todo) (insert " ")
8487 (if (memq type '(:tag :prop)) (insert ":"))))
8488 (if (and (equal type :opt) (assoc completion table))
8489 (message "%s" (substitute-command-keys
8491 (t
8492 (message "Making completion list...")
8493 (let ((list (sort (all-completions pattern table confirm)
8494 'string<)))
8495 (with-output-to-temp-buffer "*Completions*"
8496 (condition-case nil
8497 ;; Protection needed for XEmacs and emacs 21
8498 (display-completion-list list pattern)
8499 (error (display-completion-list list)))))
8500 (message "Making completion list...%s" "done")))))))
8502 ;;;; TODO, DEADLINE, Comments
8504 (defun org-toggle-comment ()
8505 "Change the COMMENT state of an entry."
8506 (interactive)
8507 (save-excursion
8508 (org-back-to-heading)
8509 (let (case-fold-search)
8510 (if (looking-at (concat outline-regexp
8512 (replace-match "" t t nil 1)
8513 (if (looking-at outline-regexp)
8514 (progn
8515 (goto-char (match-end 0))
8516 (insert org-comment-string " ")))))))
8518 (defvar org-last-todo-state-is-todo nil
8519 "This is non-nil when the last TODO state change led to a TODO state.
8520 If the last change removed the TODO tag or switched to DONE, then
8521 this is nil.")
8523 (defvar org-setting-tags nil) ; dynamically skipped
8525 (defun org-parse-local-options (string var)
8526 "Parse STRING for startup setting relevant for variable VAR."
8527 (let ((rtn (symbol-value var))
8528 e opts)
8529 (save-match-data
8531 rtn
8532 (setq opts (delq nil (mapcar (lambda (x)
8533 (setq e (assoc x org-startup-options))
8534 (if (eq (nth 1 e) var) e nil))
8536 (if (not opts)
8537 rtn
8538 (setq rtn nil)
8539 (while (setq e (pop opts))
8540 (if (not (nth 3 e))
8541 (setq rtn (nth 2 e))
8542 (if (not (listp rtn)) (setq rtn nil))
8543 (push (nth 2 e) rtn)))
8544 rtn)))))
8546 (defvar org-todo-setup-filter-hook nil
8547 "Hook for functions that pre-filter todo specs.
8549 Each function takes a todo spec and returns either `nil' or the spec
8550 transformed into canonical form." )
8552 (defvar org-todo-get-default-hook nil
8553 "Hook for functions that get a default item for todo.
8555 Each function takes arguments (NEW-MARK OLD-MARK) and returns either
8556 `nil' or a string to be used for the todo mark." )
8558 (defvar org-agenda-headline-snapshot-before-repeat)
8559 (defun org-todo (&optional arg)
8560 "Change the TODO state of an item.
8561 The state of an item is given by a keyword at the start of the heading,
8562 like
8563 *** TODO Write paper
8564 *** DONE Call mom
8566 The different keywords are specified in the variable `org-todo-keywords'.
8568 So for this example: when the item starts with TODO, it is changed to DONE.
8569 When it starts with DONE, the DONE is removed. And when neither TODO nor
8570 DONE are present, add TODO at the beginning of the heading.
8572 With C-u prefix arg, use completion to determine the new state.
8573 With numeric prefix arg, switch to that state.
8574 With a double C-u prefix, switch to the next set of TODO keywords (nextset).
8575 With a tripple C-u prefix, circumvent any state blocking.
8577 For calling through lisp, arg is also interpreted in the following way:
8578 'none -> empty state
8580 'done -> switch to DONE
8581 'nextset -> switch to the next set of keywords
8582 'previousset -> switch to the previous set of keywords
8584 really is a member of `org-todo-keywords'."
8585 (interactive "P")
8586 (if (equal arg '(16)) (setq arg 'nextset))
8587 (let ((org-blocker-hook org-blocker-hook))
8588 (when (equal arg '(64))
8589 (setq arg nil org-blocker-hook nil))
8590 (save-excursion
8591 (catch 'exit
8592 (org-back-to-heading)
8593 (if (looking-at outline-regexp) (goto-char (1- (match-end 0))))
8594 (or (looking-at (concat " +" org-todo-regexp " *"))
8595 (looking-at " *"))
8596 (let* ((match-data (match-data))
8597 (startpos (point-at-bol))
8598 (logging (save-match-data (org-entry-get nil "LOGGING" t)))
8599 (org-log-done org-log-done)
8600 (org-log-repeat org-log-repeat)
8601 (org-todo-log-states org-todo-log-states)
8602 (this (match-string 1))
8603 (hl-pos (match-beginning 0))
8604 (head (org-get-todo-sequence-head this))
8605 (ass (assoc head org-todo-kwd-alist))
8606 (interpret (nth 1 ass))
8607 (done-word (nth 3 ass))
8608 (final-done-word (nth 4 ass))
8609 (last-state (or this ""))
8610 (completion-ignore-case t)
8611 (member (member this org-todo-keywords-1))
8612 (tail (cdr member))
8613 (state (cond
8614 ((and org-todo-key-trigger
8615 (or (and (equal arg '(4))
8616 (eq org-use-fast-todo-selection 'prefix))
8617 (and (not arg) org-use-fast-todo-selection
8618 (not (eq org-use-fast-todo-selection
8619 'prefix)))))
8620 ;; Use fast selection
8621 (org-fast-todo-selection))
8622 ((and (equal arg '(4))
8623 (or (not org-use-fast-todo-selection)
8624 (not org-todo-key-trigger)))
8625 ;; Read a state with completion
8626 (org-ido-completing-read
8627 "State: " (mapcar (lambda(x) (list x))
8628 org-todo-keywords-1)
8629 nil t))
8630 ((eq arg 'right)
8631 (if this
8632 (if tail (car tail) nil)
8633 (car org-todo-keywords-1)))
8634 ((eq arg 'left)
8635 (if (equal member org-todo-keywords-1)
8636 nil
8637 (if this
8638 (nth (- (length org-todo-keywords-1)
8639 (length tail) 2)
8640 org-todo-keywords-1)
8641 (org-last org-todo-keywords-1))))
8642 ((and (eq org-use-fast-todo-selection t) (equal arg '(4))
8643 (setq arg nil))) ; hack to fall back to cycling
8644 (arg
8645 ;; user or caller requests a specific state
8646 (cond
8647 ((equal arg "") nil)
8648 ((eq arg 'none) nil)
8649 ((eq arg 'done) (or done-word (car org-done-keywords)))
8650 ((eq arg 'nextset)
8651 (or (car (cdr (member head org-todo-heads)))
8652 (car org-todo-heads)))
8653 ((eq arg 'previousset)
8654 (let ((org-todo-heads (reverse org-todo-heads)))
8655 (or (car (cdr (member head org-todo-heads)))
8656 (car org-todo-heads))))
8657 ((car (member arg org-todo-keywords-1)))
8658 ((nth (1- (prefix-numeric-value arg))
8659 org-todo-keywords-1))))
8660 ((null member) (or head (car org-todo-keywords-1)))
8661 ((equal this final-done-word) nil) ;; -> make empty
8662 ((null tail) nil) ;; -> first entry
8663 ((memq interpret '(type priority))
8664 (if (eq this-command last-command)
8665 (car tail)
8666 (if (> (length tail) 0)
8667 (or done-word (car org-done-keywords))
8668 nil)))
8669 (t
8670 (car tail))))
8671 (state (or
8672 (run-hook-with-args-until-success
8673 'org-todo-get-default-hook state last-state)
8674 state))
8675 (next (if state (concat " " state " ") " "))
8676 (change-plist (list :type 'todo-state-change :from this :to state
8677 :position startpos))
8678 dolog now-done-p)
8679 (when org-blocker-hook
8680 (setq org-last-todo-state-is-todo
8681 (not (member this org-done-keywords)))
8682 (unless (save-excursion
8683 (save-match-data
8684 (run-hook-with-args-until-failure
8685 'org-blocker-hook change-plist)))
8686 (if (interactive-p)
8687 (error "TODO state change from %s to %s blocked" this state)
8688 ;; fail silently
8689 (message "TODO state change from %s to %s blocked" this state)
8690 (throw 'exit nil))))
8691 (store-match-data match-data)
8692 (replace-match next t t)
8693 (unless (pos-visible-in-window-p hl-pos)
8694 (message "TODO state changed to %s" (org-trim next)))
8695 (unless head
8696 (setq head (org-get-todo-sequence-head state)
8697 ass (assoc head org-todo-kwd-alist)
8698 interpret (nth 1 ass)
8699 done-word (nth 3 ass)
8700 final-done-word (nth 4 ass)))
8701 (when (memq arg '(nextset previousset))
8702 (message "Keyword-Set %d/%d: %s"
8703 (- (length org-todo-sets) -1
8704 (length (memq (assoc state org-todo-sets) org-todo-sets)))
8705 (length org-todo-sets)
8706 (mapconcat 'identity (assoc state org-todo-sets) " ")))
8707 (setq org-last-todo-state-is-todo
8708 (not (member state org-done-keywords)))
8709 (setq now-done-p (and (member state org-done-keywords)
8710 (not (member this org-done-keywords))))
8711 (and logging (org-local-logging logging))
8712 (when (and (or org-todo-log-states org-log-done)
8713 (not (memq arg '(nextset previousset))))
8714 ;; we need to look at recording a time and note
8715 (setq dolog (or (nth 1 (assoc state org-todo-log-states))
8716 (nth 2 (assoc this org-todo-log-states))))
8717 (when (and state
8718 (member state org-not-done-keywords)
8719 (not (member this org-not-done-keywords)))
8720 ;; This is now a todo state and was not one before
8721 ;; If there was a CLOSED time stamp, get rid of it.
8722 (org-add-planning-info nil nil 'closed))
8723 (when (and now-done-p org-log-done)
8724 ;; It is now done, and it was not done before
8725 (org-add-planning-info 'closed (org-current-time))
8726 (if (and (not dolog) (eq 'note org-log-done))
8727 (org-add-log-setup 'done state this 'findpos 'note)))
8728 (when (and state dolog)
8729 ;; This is a non-nil state, and we need to log it
8730 (org-add-log-setup 'state state this 'findpos dolog)))
8731 ;; Fixup tag positioning
8732 (org-todo-trigger-tag-changes state)
8733 (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t))
8734 (when org-provide-todo-statistics
8735 (org-update-parent-todo-statistics))
8736 (run-hooks 'org-after-todo-state-change-hook)
8737 (if (and arg (not (member state org-done-keywords)))
8738 (setq head (org-get-todo-sequence-head state)))
8739 (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head)
8740 ;; Do we need to trigger a repeat?
8741 (when now-done-p
8742 (when (boundp 'org-agenda-headline-snapshot-before-repeat)
8743 ;; This is for the agenda, take a snapshot of the headline.
8744 (save-match-data
8745 (setq org-agenda-headline-snapshot-before-repeat
8746 (org-get-heading))))
8747 (org-auto-repeat-maybe state))
8748 ;; Fixup cursor location if close to the keyword
8749 (if (and (outline-on-heading-p)
8750 (not (bolp))
8751 (save-excursion (beginning-of-line 1)
8752 (looking-at org-todo-line-regexp))
8753 (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
8754 (progn
8755 (goto-char (or (match-end 2) (match-end 1)))
8756 (just-one-space)))
8757 (when org-trigger-hook
8758 (save-excursion
8759 (run-hook-with-args 'org-trigger-hook change-plist))))))))
8761 (defun org-block-todo-from-children-or-siblings (change-plist)
8762 "Block turning an entry into a TODO, using the hierarchy.
8763 This checks whether the current task should be blocked from state
8764 changes. Such blocking occurs when:
8766 1. The task has children which are not all in a completed state.
8768 2. A task has a parent with the property :ORDERED:, and there
8769 are siblings prior to the current task with incomplete
8770 status."
8771 (catch 'dont-block
8772 ;; If this is not a todo state change, or if this entry is already DONE,
8773 ;; do not block
8774 (when (or (not (eq (plist-get change-plist :type) 'todo-state-change))
8775 (member (plist-get change-plist :from)
8776 (cons 'done org-done-keywords))
8777 (member (plist-get change-plist :to)
8778 (cons 'todo org-not-done-keywords)))
8779 (throw 'dont-block t))
8780 ;; If this task has children, and any are undone, it's blocked
8781 (save-excursion
8782 (org-back-to-heading t)
8783 (let ((this-level (funcall outline-level)))
8784 (outline-next-heading)
8785 (let ((child-level (funcall outline-level)))
8786 (while (and (not (eobp))
8787 (> child-level this-level))
8788 ;; this todo has children, check whether they are all
8789 ;; completed
8790 (if (and (not (org-entry-is-done-p))
8791 (org-entry-is-todo-p))
8792 (throw 'dont-block nil))
8793 (outline-next-heading)
8794 (setq child-level (funcall outline-level))))))
8795 ;; Otherwise, if the task's parent has the :ORDERED: property, and
8796 ;; any previous siblings are undone, it's blocked
8797 (save-excursion
8798 (org-back-to-heading t)
8799 (when (save-excursion
8800 (ignore-errors
8801 (org-up-heading-all 1)
8802 (org-entry-get (point) "ORDERED")))
8803 (let* ((this-level (funcall outline-level))
8804 (current-level this-level))
8805 (while (and (not (bobp))
8806 (= current-level this-level))
8807 (outline-previous-heading)
8808 (setq current-level (funcall outline-level))
8809 (if (= current-level this-level)
8810 ;; this todo has children, check whether they are all
8811 ;; completed
8812 (if (and (not (org-entry-is-done-p))
8813 (org-entry-is-todo-p))
8814 (throw 'dont-block nil)))))))
8815 t)) ; don't block
8817 (defcustom org-track-ordered-property-with-tag nil
8818 "Should the ORDERED property also be shown as a tag?
8819 The ORDERED property decides if an entry should require subtasks to be
8820 completed in sequence. Since a property is not very visible, setting
8821 this option means that toggling the ORDERED property with the command
8822 `org-toggle-ordered-property' will also toggle a tag ORDERED. That tag is
8823 not relevant for the behavior, but it makes things more visible.
8825 Note that toggling the tag with tags commands will not change the property
8826 and therefore not influence behavior!
8828 This can be t, meaning the tag ORDERED should be used, It can also be a
8829 string to select a different tag for this task."
8830 :group 'org-todo
8831 :type '(choice
8832 (const :tag "No tracking" nil)
8833 (const :tag "Track with ORDERED tag" t)
8834 (string :tag "Use other tag")))
8836 (defun org-toggle-ordered-property ()
8837 "Toggle the ORDERED property of the current entry.
8838 For better visibility, you can track the value of this property with a tag.
8839 See variable `org-track-ordered-property-with-tag'."
8840 (interactive)
8841 (let* ((t1 org-track-ordered-property-with-tag)
8842 (tag (and t1 (if (stringp t1) t1 "ORDERED"))))
8843 (save-excursion
8844 (org-back-to-heading)
8845 (if (org-entry-get nil "ORDERED")
8846 (progn
8847 (org-delete-property "ORDERED")
8848 (and tag (org-toggle-tag tag 'off))
8849 (message "Subtasks can be completed in arbitrary order"))
8850 (org-entry-put nil "ORDERED" "t")
8851 (and tag (org-toggle-tag tag 'on))
8852 (message "Subtasks must be completed in sequence")))))
8854 (defvar org-blocked-by-checkboxes) ; dynamically scoped
8855 (defun org-block-todo-from-checkboxes (change-plist)
8856 "Block turning an entry into a TODO, using checkboxes.
8857 This checks whether the current task should be blocked from state
8858 changes because there are uncheckd boxes in this entry."
8859 (catch 'dont-block
8860 ;; If this is not a todo state change, or if this entry is already DONE,
8861 ;; do not block
8862 (when (or (not (eq (plist-get change-plist :type) 'todo-state-change))
8863 (member (plist-get change-plist :from)
8864 (cons 'done org-done-keywords))
8865 (member (plist-get change-plist :to)
8866 (cons 'todo org-not-done-keywords)))
8867 (throw 'dont-block t))
8868 ;; If this task has checkboxes that are not checked, it's blocked
8869 (save-excursion
8870 (org-back-to-heading t)
8871 (let ((beg (point)) end)
8872 (outline-next-heading)
8873 (setq end (point))
8874 (goto-char beg)
8876 end t)
8877 (progn
8878 (if (boundp 'org-blocked-by-checkboxes)
8879 (setq org-blocked-by-checkboxes t))
8880 (throw 'dont-block nil)))))
8881 t)) ; do not block
8883 (defun org-update-parent-todo-statistics ()
8884 "Update any statistics cookie in the parent of the current headline."
8885 (interactive)
8887 level (cnt-all 0) (cnt-done 0) is-percent kwd cookie-present)
8888 (catch 'exit
8889 (save-excursion
8890 (setq level (org-up-heading-safe))
8891 (unless level
8892 (throw 'exit nil))
8893 (while (re-search-forward box-re (point-at-eol) t)
8894 (setq cnt-all 0 cnt-done 0 cookie-present t)
8895 (setq is-percent (match-end 2))
8896 (save-match-data
8897 (unless (outline-next-heading) (throw 'exit nil))
8898 (while (looking-at org-todo-line-regexp)
8899 (setq kwd (match-string 2))
8900 (and kwd (setq cnt-all (1+ cnt-all)))
8901 (and (member kwd org-done-keywords)
8902 (setq cnt-done (1+ cnt-done)))
8903 (condition-case nil
8904 (org-forward-same-level 1)
8905 (error (end-of-line 1)))))
8906 (replace-match
8907 (if is-percent
8908 (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all)))
8909 (format "[%d/%d]" cnt-done cnt-all))))
8910 (when cookie-present
8911 (run-hook-with-args 'org-after-todo-statistics-hook
8912 cnt-done (- cnt-all cnt-done)))))))
8914 (defvar org-after-todo-statistics-hook nil
8915 "Hook that is called after a TODO statistics cookie has been updated.
8916 Each function is called with two arguments: the number of not-done entries
8917 and the number of done entries.
8919 For example, the following function, when added to this hook, will switch
8920 an entry to DONE when all children are done, and back to TODO when new
8921 entries are set to a TODO status. Note that this hook is only called
8922 when there is a statistics cookie in the headline!
8924 (defun org-summary-todo (n-done n-not-done)
8926 (let (org-log-done org-log-states) ; turn off logging
8928 ")
8930 (defun org-todo-trigger-tag-changes (state)
8931 "Apply the changes defined in `org-todo-state-tags-triggers'."
8932 (let ((l org-todo-state-tags-triggers)
8933 changes)
8934 (when (or (not state) (equal state ""))
8935 (setq changes (append changes (cdr (assoc "" l)))))
8936 (when (and (stringp state) (> (length state) 0))
8937 (setq changes (append changes (cdr (assoc state l)))))
8938 (when (member state org-not-done-keywords)
8939 (setq changes (append changes (cdr (assoc 'todo l)))))
8940 (when (member state org-done-keywords)
8941 (setq changes (append changes (cdr (assoc 'done l)))))
8942 (dolist (c changes)
8943 (org-toggle-tag (car c) (if (cdr c) 'on 'off)))))
8945 (defun org-local-logging (value)
8946 "Get logging settings from a property VALUE."
8947 (let* (words w a)
8948 ;; directly set the variables, they are already local.
8949 (setq org-log-done nil
8950 org-log-repeat nil
8951 org-todo-log-states nil)
8952 (setq words (org-split-string value))
8953 (while (setq w (pop words))
8954 (cond
8955 ((setq a (assoc w org-startup-options))
8956 (and (member (nth 1 a) '(org-log-done org-log-repeat))
8957 (set (nth 1 a) (nth 2 a))))
8958 ((setq a (org-extract-log-state-settings w))
8959 (and (member (car a) org-todo-keywords-1)
8960 (push a org-todo-log-states)))))))
8962 (defun org-get-todo-sequence-head (kwd)
8963 "Return the head of the TODO sequence to which KWD belongs.
8964 If KWD is not set, check if there is a text property remembering the
8965 right sequence."
8966 (let (p)
8967 (cond
8968 ((not kwd)
8969 (or (get-text-property (point-at-bol) 'org-todo-head)
8970 (progn
8971 (setq p (next-single-property-change (point-at-bol) 'org-todo-head
8972 nil (point-at-eol)))
8973 (get-text-property p 'org-todo-head))))
8974 ((not (member kwd org-todo-keywords-1))
8975 (car org-todo-keywords-1))
8976 (t (nth 2 (assoc kwd org-todo-kwd-alist))))))
8978 (defun org-fast-todo-selection ()
8979 "Fast TODO keyword selection with single keys.
8980 Returns the new TODO keyword, or nil if no state change should occur."
8981 (let* ((fulltable org-todo-key-alist)
8982 (done-keywords org-done-keywords) ;; needed for the faces.
8983 (maxlen (apply 'max (mapcar
8984 (lambda (x)
8985 (if (stringp (car x)) (string-width (car x)) 0))
8986 fulltable)))
8987 (expert nil)
8988 (fwidth (+ maxlen 3 1 3))
8989 (ncol (/ (- (window-width) 4) fwidth))
8990 tg cnt e c tbl
8991 groups ingroup)
8992 (save-excursion
8993 (save-window-excursion
8994 (if expert
8995 (set-buffer (get-buffer-create " *Org todo*"))
8996 (org-switch-to-buffer-other-window (get-buffer-create " *Org todo*")))
8997 (erase-buffer)
8998 (org-set-local 'org-done-keywords done-keywords)
8999 (setq tbl fulltable cnt 0)
9000 (while (setq e (pop tbl))
9001 (cond
9002 ((equal e '(:startgroup))
9003 (push '() groups) (setq ingroup t)
9004 (when (not (= cnt 0))
9005 (setq cnt 0)
9007 (insert "{ "))
9008 ((equal e '(:endgroup))
9009 (setq ingroup nil cnt 0)
9011 ((equal e '(:newline))
9012 (when (not (= cnt 0))
9013 (setq cnt 0)
9015 (setq e (car tbl))
9016 (while (equal (car tbl) '(:newline))
9018 (setq tbl (cdr tbl)))))
9019 (t
9020 (setq tg (car e) c (cdr e))
9021 (if ingroup (push tg (car groups)))
9022 (setq tg (org-add-props tg nil 'face
9023 (org-get-todo-face tg)))
9024 (if (and (= cnt 0) (not ingroup)) (insert " "))
9025 (insert "[" c "] " tg (make-string
9026 (- fwidth 4 (length tg)) ?\ ))
9027 (when (= (setq cnt (1+ cnt)) ncol)
9029 (if ingroup (insert " "))
9030 (setq cnt 0)))))
9032 (goto-char (point-min))
9033 (if (not expert) (org-fit-window-to-buffer))
9034 (message "[a-z..]:Set [SPC]:clear")
9035 (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
9036 (cond
9037 ((or (= c ?\C-g)
9038 (and (= c ?q) (not (rassoc c fulltable))))
9039 (setq quit-flag t))
9040 ((= c ?\ ) nil)
9041 ((setq e (rassoc c fulltable) tg (car e))
9042 tg)
9043 (t (setq quit-flag t)))))))
9045 (defun org-entry-is-todo-p ()
9046 (member (org-get-todo-state) org-not-done-keywords))
9048 (defun org-entry-is-done-p ()
9049 (member (org-get-todo-state) org-done-keywords))
9051 (defun org-get-todo-state ()
9052 (save-excursion
9053 (org-back-to-heading t)
9054 (and (looking-at org-todo-line-regexp)
9055 (match-end 2)
9056 (match-string 2))))
9058 (defun org-at-date-range-p (&optional inactive-ok)
9059 "Is the cursor inside a date range?"
9060 (interactive)
9061 (save-excursion
9062 (catch 'exit
9063 (let ((pos (point)))
9065 (skip-chars-backward "<[")
9066 (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp))
9067 (>= (match-end 0) pos)
9068 (throw 'exit t))
9070 (skip-chars-backward "<[")
9071 (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp))
9072 (>= (match-end 0) pos)
9073 (throw 'exit t)))
9074 nil)))
9076 (defun org-get-repeat ()
9077 "Check if there is a deadline/schedule with repeater in this entry."
9078 (save-match-data
9079 (save-excursion
9080 (org-back-to-heading t)
9081 (if (re-search-forward
9082 org-repeat-re (save-excursion (outline-next-heading) (point)) t)
9083 (match-string 1)))))
9085 (defvar org-last-changed-timestamp)
9086 (defvar org-last-inserted-timestamp)
9087 (defvar org-log-post-message)
9088 (defvar org-log-note-purpose)
9089 (defvar org-log-note-how)
9090 (defvar org-log-note-extra)
9091 (defun org-auto-repeat-maybe (done-word)
9092 "Check if the current headline contains a repeated deadline/schedule.
9093 If yes, set TODO state back to what it was and change the base date
9094 of repeating deadline/scheduled time stamps to new date.
9095 This function is run automatically after each state change to a DONE state."
9096 ;; last-state is dynamically scoped into this function
9097 (let* ((repeat (org-get-repeat))
9098 (aa (assoc last-state org-todo-kwd-alist))
9099 (interpret (nth 1 aa))
9100 (head (nth 2 aa))
9101 (whata '(("d" . day) ("m" . month) ("y" . year)))
9102 (msg "Entry repeats: ")
9103 (org-log-done nil)
9104 (org-todo-log-states nil)
9105 (nshiftmax 10) (nshift 0)
9106 re type n what ts time)
9107 (when repeat
9108 (if (eq org-log-repeat t) (setq org-log-repeat 'state))
9109 (org-todo (if (eq interpret 'type) last-state head))
9110 (when org-log-repeat
9111 (if (or (memq 'org-add-log-note (default-value 'post-command-hook))
9112 (memq 'org-add-log-note post-command-hook))
9113 ;; OK, we are already setup for some record
9114 (if (eq org-log-repeat 'note)
9115 ;; make sure we take a note, not only a time stamp
9116 (setq org-log-note-how 'note))
9117 ;; Set up for taking a record
9118 (org-add-log-setup 'state (or done-word (car org-done-keywords))
9119 last-state
9120 'findpos org-log-repeat)))
9121 (org-back-to-heading t)
9122 (org-add-planning-info nil nil 'closed)
9126 (while (re-search-forward
9127 re (save-excursion (outline-next-heading) (point)) t)
9128 (setq type (if (match-end 1) org-scheduled-string
9129 (if (match-end 3) org-deadline-string "Plain:"))
9130 ts (match-string (if (match-end 2) 2 (if (match-end 4) 4 0))))
9132 (setq n (string-to-number (match-string 2 ts))
9133 what (match-string 3 ts))
9134 (if (equal what "w") (setq n (* n 7) what "d"))
9135 ;; Preparation, see if we need to modify the start date for the change
9136 (when (match-end 1)
9137 (setq time (save-match-data (org-time-string-to-time ts)))
9138 (cond
9139 ((equal (match-string 1 ts) ".")
9140 ;; Shift starting date to today
9141 (org-timestamp-change
9142 (- (time-to-days (current-time)) (time-to-days time))
9143 'day))
9144 ((equal (match-string 1 ts) "+")
9145 (while (or (= nshift 0)
9146 (<= (time-to-days time) (time-to-days (current-time))))
9147 (when (= (incf nshift) nshiftmax)
9148 (or (y-or-n-p (message "%d repeater intervals were not enough to shift date past today. Continue? " nshift))
9149 (error "Abort")))
9150 (org-timestamp-change n (cdr (assoc what whata)))
9151 (org-at-timestamp-p t)
9152 (setq ts (match-string 1))
9153 (setq time (save-match-data (org-time-string-to-time ts))))
9154 (org-timestamp-change (- n) (cdr (assoc what whata)))
9155 ;; rematch, so that we have everything in place for the real shift
9156 (org-at-timestamp-p t)
9157 (setq ts (match-string 1))
9159 (org-timestamp-change n (cdr (assoc what whata)))
9160 (setq msg (concat msg type " " org-last-changed-timestamp " "))))
9161 (setq org-log-post-message msg)
9162 (message "%s" msg))))
9164 (defun org-show-todo-tree (arg)
9165 "Make a compact tree which shows all headlines marked with TODO.
9166 The tree will show the lines where the regexp matches, and all higher
9167 headlines above the match.
9169 With a numeric prefix N, construct a sparse tree for the Nth element
9170 of `org-todo-keywords-1'."
9171 (interactive "P")
9172 (let ((case-fold-search nil)
9173 (kwd-re
9174 (cond ((null arg) org-not-done-regexp)
9175 ((equal arg '(4))
9176 (let ((kwd (org-ido-completing-read "Keyword (or KWD1|KWD2|...): "
9177 (mapcar 'list org-todo-keywords-1))))
9181 ((<= (prefix-numeric-value arg) (length org-todo-keywords-1))
9182 (regexp-quote (nth (1- (prefix-numeric-value arg))
9183 org-todo-keywords-1)))
9184 (t (error "Invalid prefix argument: %s" arg)))))
9185 (message "%d TODO entries found"
9186 (org-occur (concat "^" outline-regexp " *" kwd-re )))))
9188 (defun org-deadline (&optional remove time)
9190 With argument REMOVE, remove any deadline from the item.
9191 When TIME is set, it should be an internal time specification, and the
9192 scheduling will use the corresponding date."
9193 (interactive "P")
9194 (if remove
9195 (progn
9196 (org-remove-timestamp-with-keyword org-deadline-string)
9197 (message "Item no longer has a deadline."))
9198 (if (org-get-repeat)
9199 (error "Cannot change deadline on task with repeater, please do that by hand")
9200 (org-add-planning-info 'deadline time 'closed)
9201 (message "Deadline on %s" org-last-inserted-timestamp))))
9203 (defun org-schedule (&optional remove time)
9204 "Insert the SCHEDULED: string with a timestamp to schedule a TODO item.
9205 With argument REMOVE, remove any scheduling date from the item.
9206 When TIME is set, it should be an internal time specification, and the
9207 scheduling will use the corresponding date."
9208 (interactive "P")
9209 (if remove
9210 (progn
9211 (org-remove-timestamp-with-keyword org-scheduled-string)
9212 (message "Item is no longer scheduled."))
9213 (if (org-get-repeat)
9214 (error "Cannot reschedule task with repeater, please do that by hand")
9215 (org-add-planning-info 'scheduled time 'closed)
9216 (message "Scheduled to %s" org-last-inserted-timestamp))))
9218 (defun org-get-scheduled-time (pom &optional inherit)
9219 "Get the scheduled time as a time tuple, of a format suitable
9220 for calling org-schedule with, or if there is no scheduling,
9221 returns nil."
9222 (let ((time (org-entry-get pom "SCHEDULED" inherit)))
9223 (when time
9224 (apply 'encode-time (org-parse-time-string time)))))
9226 (defun org-get-deadline-time (pom &optional inherit)
9227 "Get the deadine as a time tuple, of a format suitable for
9228 calling org-deadlin with, or if there is no scheduling, returns
9229 nil."
9230 (let ((time (org-entry-get pom "DEADLINE" inherit)))
9231 (when time
9232 (apply 'encode-time (org-parse-time-string time)))))
9234 (defun org-remove-timestamp-with-keyword (keyword)
9235 "Remove all time stamps with KEYWORD in the current entry."
9237 beg)
9238 (save-excursion
9239 (org-back-to-heading t)
9240 (setq beg (point))
9241 (org-end-of-subtree t t)
9242 (while (re-search-backward re beg t)
9243 (replace-match "")
9245 (equal (char-before) ?\ ))
9246 (backward-delete-char 1)
9248 (point-at-bol) (point-at-eol)))
9249 (delete-region (point-at-bol)
9250 (min (point-max) (1+ (point-at-eol))))))))))
9252 (defun org-add-planning-info (what &optional time &rest remove)
9253 "Insert new timestamp with keyword in the line directly after the headline.
9254 WHAT indicates what kind of time stamp to add. TIME indicated the time to use.
9255 If non is given, the user is prompted for a date.
9256 REMOVE indicates what kind of entries to remove. An old WHAT entry will also
9257 be removed."
9258 (interactive)
9259 (let (org-time-was-given org-end-time-was-given ts
9260 end default-time default-input)
9262 (catch 'exit
9263 (when (and (not time) (memq what '(scheduled deadline)))
9264 ;; Try to get a default date/time from existing timestamp
9265 (save-excursion
9266 (org-back-to-heading t)
9267 (setq end (save-excursion (outline-next-heading) (point)))
9268 (when (re-search-forward (if (eq what 'scheduled)
9269 org-scheduled-time-regexp
9270 org-deadline-time-regexp)
9271 end t)
9272 (setq ts (match-string 1)
9273 default-time
9274 (apply 'encode-time (org-parse-time-string ts))
9275 default-input (and ts (org-get-compact-tod ts))))))
9276 (when what
9277 ;; If necessary, get the time from the user
9278 (setq time (or time (org-read-date nil 'to-time nil nil
9279 default-time default-input))))
9281 (when (and org-insert-labeled-timestamps-at-point
9282 (member what '(scheduled deadline)))
9283 (insert
9284 (if (eq what 'scheduled) org-scheduled-string org-deadline-string) " ")
9285 (org-insert-time-stamp time org-time-was-given
9286 nil nil nil (list org-end-time-was-given))
9287 (setq what nil))
9288 (save-excursion
9289 (save-restriction
9290 (let (col list elt ts buffer-invisibility-spec)
9291 (org-back-to-heading t)
9293 (goto-char (match-end 1))
9294 (setq col (current-column))
9295 (goto-char (match-end 0))
9297 (when (and (not what)
9298 (not (looking-at org-keyword-time-not-clock-regexp)))
9299 ;; Nothing to add, nothing to remove...... :-)
9300 (throw 'exit nil))
9301 (if (and (not (looking-at outline-regexp))
9304 (not (equal (match-string 1) org-clock-string)))
9305 (narrow-to-region (match-beginning 0) (match-end 0))
9307 (backward-char 1)
9308 (narrow-to-region (point) (point))
9309 (and org-adapt-indentation (org-indent-to-column col)))
9310 ;; Check if we have to remove something.
9311 (setq list (cons what remove))
9312 (while list
9313 (setq elt (pop list))
9314 (goto-char (point-min))
9315 (when (or (and (eq elt 'scheduled)
9316 (re-search-forward org-scheduled-time-regexp nil t))
9317 (and (eq elt 'deadline)
9318 (re-search-forward org-deadline-time-regexp nil t))
9319 (and (eq elt 'closed)
9320 (re-search-forward org-closed-time-regexp nil t)))
9321 (replace-match "")
9322 (if (looking-at "--+<[^>]+>") (replace-match ""))
9323 (if (looking-at " +") (replace-match ""))))
9324 (goto-char (point-max))
9325 (when what
9326 (insert
9327 (if (not (or (bolp) (eq (char-before) ?\ ))) " " "")
9328 (cond ((eq what 'scheduled) org-scheduled-string)
9329 ((eq what 'deadline) org-deadline-string)
9330 ((eq what 'closed) org-closed-string))
9331 " ")
9332 (setq ts (org-insert-time-stamp
9333 time
9334 (or org-time-was-given
9335 (and (eq what 'closed) org-log-done-with-time))
9336 (eq what 'closed)
9337 nil nil (list org-end-time-was-given)))
9338 (end-of-line 1))
9339 (goto-char (point-min))
9340 (widen)
9343 (delete-region (1- (point)) (point-at-eol)))
9344 ts))))))
9346 (defvar org-log-note-marker (make-marker))
9347 (defvar org-log-note-purpose nil)
9348 (defvar org-log-note-state nil)
9349 (defvar org-log-note-previous-state nil)
9350 (defvar org-log-note-how nil)
9351 (defvar org-log-note-extra nil)
9352 (defvar org-log-note-window-configuration nil)
9353 (defvar org-log-note-return-to (make-marker))
9354 (defvar org-log-post-message nil
9355 "Message to be displayed after a log note has been stored.
9356 The auto-repeater uses this.")
9358 (defun org-add-note ()
9359 "Add a note to the current entry.
9360 This is done in the same way as adding a state change note."
9361 (interactive)
9362 (org-add-log-setup 'note nil nil 'findpos nil))
9364 (defvar org-property-end-re)
9365 (defun org-add-log-setup (&optional purpose state prev-state
9366 findpos how &optional extra)
9367 "Set up the post command hook to take a note.
9368 If this is about to TODO state change, the new state is expected in STATE.
9369 When FINDPOS is non-nil, find the correct position for the note in
9370 the current entry. If not, assume that it can be inserted at point.
9371 HOW is an indicator what kind of note should be created.
9372 EXTRA is additional text that will be inserted into the notes buffer."
9373 (let ((drawer (cond ((stringp org-log-into-drawer)
9374 org-log-into-drawer)
9375 (org-log-into-drawer "LOGBOOK")
9376 (t nil))))
9377 (save-restriction
9378 (save-excursion
9379 (when findpos
9380 (org-back-to-heading t)
9381 (narrow-to-region (point) (save-excursion
9382 (outline-next-heading) (point)))
9386 (goto-char (match-end 0))
9387 (cond
9388 (drawer
9390 nil t)
9391 (progn
9392 (goto-char (match-end 0))
9393 (or org-log-states-order-reversed
9394 (and (re-search-forward org-property-end-re nil t)
9395 (goto-char (1- (match-beginning 0))))))
9397 (beginning-of-line 0)
9398 (org-indent-line-function)
9399 (beginning-of-line 2)
9400 (org-indent-line-function)
9401 (end-of-line 0)))
9402 ((and org-log-state-notes-insert-after-drawers
9403 (save-excursion
9404 (forward-line) (looking-at org-drawer-regexp)))
9405 (forward-line)
9406 (while (looking-at org-drawer-regexp)
9407 (goto-char (match-end 0))
9408 (re-search-forward org-property-end-re (point-max) t)
9409 (forward-line))
9410 (forward-line -1)))
9411 (unless org-log-states-order-reversed
9413 (org-skip-over-state-notes)
9415 (move-marker org-log-note-marker (point))
9416 (setq org-log-note-purpose purpose
9417 org-log-note-state state
9418 org-log-note-previous-state prev-state
9419 org-log-note-how how
9420 org-log-note-extra extra)
9421 (add-hook 'post-command-hook 'org-add-log-note 'append)))))
9423 (defun org-skip-over-state-notes ()
9424 "Skip past the list of State notes in an entry."
9427 (condition-case nil
9428 (org-next-item)
9429 (error (org-end-of-item)))))
9431 (defun org-add-log-note (&optional purpose)
9432 "Pop up a window for taking a note, and add this note later at point."
9433 (remove-hook 'post-command-hook 'org-add-log-note)
9434 (setq org-log-note-window-configuration (current-window-configuration))
9435 (delete-other-windows)
9436 (move-marker org-log-note-return-to (point))
9437 (switch-to-buffer (marker-buffer org-log-note-marker))
9438 (goto-char org-log-note-marker)
9439 (org-switch-to-buffer-other-window "*Org Note*")
9440 (erase-buffer)
9441 (if (memq org-log-note-how '(time state))
9442 (let (current-prefix-arg) (org-store-log-note))
9443 (let ((org-inhibit-startup t)) (org-mode))
9444 (insert (format "# Insert note for %s.
9446 (cond
9447 ((eq org-log-note-purpose 'clock-out) "stopped clock")
9448 ((eq org-log-note-purpose 'done) "closed todo item")
9449 ((eq org-log-note-purpose 'state)
9451 (or org-log-note-previous-state "")
9452 (or org-log-note-state "")))
9453 ((eq org-log-note-purpose 'note)
9454 "this entry")
9455 (t (error "This should not happen")))))
9456 (if org-log-note-extra (insert org-log-note-extra))
9457 (org-set-local 'org-finish-function 'org-store-log-note)))
9459 (defvar org-note-abort nil) ; dynamically scoped
9460 (defun org-store-log-note ()
9461 "Finish taking a log note, and insert it to where it belongs."
9462 (let ((txt (buffer-string))
9463 (note (cdr (assq org-log-note-purpose org-log-note-headings)))
9464 lines ind)
9465 (kill-buffer (current-buffer))
9467 (setq txt (replace-match "" t t txt)))
9469 (setq txt (replace-match "" t t txt)))
9472 (setq note
9473 (org-replace-escapes
9474 note
9475 (list (cons "%u" (user-login-name))
9476 (cons "%U" user-full-name)
9477 (cons "%t" (format-time-string
9478 (org-time-stamp-format 'long 'inactive)
9479 (current-time)))
9480 (cons "%s" (if org-log-note-state
9482 ""))
9483 (cons "%S" (if org-log-note-previous-state
9487 (push note lines))
9488 (when (or current-prefix-arg org-note-abort) (setq lines nil))
9489 (when lines
9490 (save-excursion
9491 (set-buffer (marker-buffer org-log-note-marker))
9492 (save-excursion
9493 (goto-char org-log-note-marker)
9494 (move-marker org-log-note-marker nil)
9495 (end-of-line 1)
9497 (insert "- " (pop lines))
9498 (org-indent-line-function)
9499 (beginning-of-line 1)
9501 (setq ind (concat (match-string 0) " "))
9502 (end-of-line 1)
9504 (message "Note stored")
9505 (org-back-to-heading t)
9506 (org-cycle-hide-drawers 'children)))))
9507 (set-window-configuration org-log-note-window-configuration)
9508 (with-current-buffer (marker-buffer org-log-note-return-to)
9509 (goto-char org-log-note-return-to))
9510 (move-marker org-log-note-return-to nil)
9511 (and org-log-post-message (message "%s" org-log-post-message)))
9513 (defun org-sparse-tree (&optional arg)
9514 "Create a sparse tree, prompt for the details.
9515 This command can create sparse trees. You first need to select the type
9516 of match used to create the tree:
9518 t Show entries with a specific TODO keyword.
9519 m Show entries selected by a tags/property match.
9520 p Enter a property name and its value (both with completion on existing
9521 names/values) and show entries with that property.
9522 r Show entries matching a regular expression
9523 d Show deadlines due within `org-deadline-warning-days'."
9524 (interactive "P")
9525 (let (ans kwd value)
9526 (message "Sparse tree: [/]regexp [t]odo-kwd [m]atch [p]roperty [d]eadlines [b]efore-date")
9527 (setq ans (read-char-exclusive))
9528 (cond
9529 ((equal ans ?d)
9530 (call-interactively 'org-check-deadlines))
9531 ((equal ans ?b)
9532 (call-interactively 'org-check-before-date))
9533 ((equal ans ?t)
9534 (org-show-todo-tree '(4)))
9535 ((member ans '(?T ?m))
9536 (call-interactively 'org-match-sparse-tree))
9537 ((member ans '(?p ?P))
9538 (setq kwd (org-ido-completing-read "Property: "
9539 (mapcar 'list (org-buffer-property-keys))))
9540 (setq value (org-ido-completing-read "Value: "
9541 (mapcar 'list (org-property-values kwd))))
9544 (org-match-sparse-tree arg (concat kwd "=" value)))
9545 ((member ans '(?r ?R ?/))
9546 (call-interactively 'org-occur))
9549 (defvar org-occur-highlights nil
9550 "List of overlays used for occur matches.")
9551 (make-variable-buffer-local 'org-occur-highlights)
9552 (defvar org-occur-parameters nil
9553 "Parameters of the active org-occur calls.
9554 This is a list, each call to org-occur pushes as cons cell,
9555 containing the regular expression and the callback, onto the list.
9556 The list can contain several entries if `org-occur' has been called
9557 several time with the KEEP-PREVIOUS argument. Otherwise, this list
9558 will only contain one set of parameters. When the highlights are
9559 removed (for example with `C-c C-c', or with the next edit (depending
9560 on `org-remove-highlights-with-change'), this variable is emptied
9561 as well.")
9562 (make-variable-buffer-local 'org-occur-parameters)
9564 (defun org-occur (regexp &optional keep-previous callback)
9565 "Make a compact tree which shows all matches of REGEXP.
9566 The tree will show the lines where the regexp matches, and all higher
9567 headlines above the match. It will also show the heading after the match,
9568 to make sure editing the matching entry is easy.
9569 If KEEP-PREVIOUS is non-nil, highlighting and exposing done by a previous
9570 call to `org-occur' will be kept, to allow stacking of calls to this
9571 command.
9572 If CALLBACK is non-nil, it is a function which is called to confirm
9573 that the match should indeed be shown."
9575 (unless keep-previous
9576 (org-remove-occur-highlights nil nil t))
9577 (push (cons regexp callback) org-occur-parameters)
9578 (let ((cnt 0))
9579 (save-excursion
9580 (goto-char (point-min))
9581 (if (or (not keep-previous) ; do not want to keep
9582 (not org-occur-highlights)) ; no previous matches
9583 ;; hide everything
9584 (org-overview))
9585 (while (re-search-forward regexp nil t)
9586 (when (or (not callback)
9587 (save-match-data (funcall callback)))
9588 (setq cnt (1+ cnt))
9589 (when org-highlight-sparse-tree-matches
9590 (org-highlight-new-match (match-beginning 0) (match-end 0)))
9591 (org-show-context 'occur-tree))))
9592 (when org-remove-highlights-with-change
9593 (org-add-hook 'before-change-functions 'org-remove-occur-highlights
9594 nil 'local))
9595 (unless org-sparse-tree-open-archived-trees
9596 (org-hide-archived-subtrees (point-min) (point-max)))
9597 (run-hooks 'org-occur-hook)
9598 (if (interactive-p)
9599 (message "%d match(es) for regexp %s" cnt regexp))
9600 cnt))
9602 (defun org-show-context (&optional key)
9603 "Make sure point and context and visible.
9604 How much context is shown depends upon the variables
9605 `org-show-hierarchy-above', `org-show-following-heading'. and
9606 `org-show-siblings'."
9607 (let ((heading-p (org-on-heading-p t))
9608 (hierarchy-p (org-get-alist-option org-show-hierarchy-above key))
9609 (following-p (org-get-alist-option org-show-following-heading key))
9610 (entry-p (org-get-alist-option org-show-entry-below key))
9611 (siblings-p (org-get-alist-option org-show-siblings key)))
9612 (catch 'exit
9613 ;; Show heading or entry text
9614 (if (and heading-p (not entry-p))
9615 (org-flag-heading nil) ; only show the heading
9616 (and (or entry-p (org-invisible-p) (org-invisible-p2))
9617 (org-show-hidden-entry))) ; show entire entry
9618 (when following-p
9619 ;; Show next sibling, or heading below text
9620 (save-excursion
9621 (and (if heading-p (org-goto-sibling) (outline-next-heading))
9622 (org-flag-heading nil))))
9623 (when siblings-p (org-show-siblings))
9624 (when hierarchy-p
9625 ;; show all higher headings, possibly with siblings
9626 (save-excursion
9627 (while (and (condition-case nil
9628 (progn (org-up-heading-all 1) t)
9629 (error nil))
9630 (not (bobp)))
9631 (org-flag-heading nil)
9632 (when siblings-p (org-show-siblings))))))))
9634 (defun org-reveal (&optional siblings)
9635 "Show current entry, hierarchy above it, and the following headline.
9636 This can be used to show a consistent set of context around locations
9637 exposed with `org-show-hierarchy-above' or `org-show-following-heading'
9638 not t for the search context.
9640 With optional argument SIBLINGS, on each level of the hierarchy all
9641 siblings are shown. This repairs the tree structure to what it would
9642 look like when opened with hierarchical calls to `org-cycle'."
9643 (interactive "P")
9644 (let ((org-show-hierarchy-above t)
9645 (org-show-following-heading t)
9646 (org-show-siblings (if siblings t org-show-siblings)))
9647 (org-show-context nil)))
9649 (defun org-highlight-new-match (beg end)
9650 "Highlight from BEG to END and mark the highlight is an occur headline."
9651 (let ((ov (org-make-overlay beg end)))
9652 (org-overlay-put ov 'face 'secondary-selection)
9653 (push ov org-occur-highlights)))
9655 (defun org-remove-occur-highlights (&optional beg end noremove)
9656 "Remove the occur highlights from the buffer.
9657 BEG and END are ignored. If NOREMOVE is nil, remove this function
9658 from the `before-change-functions' in the current buffer."
9659 (interactive)
9660 (unless org-inhibit-highlight-removal
9661 (mapc 'org-delete-overlay org-occur-highlights)
9662 (setq org-occur-highlights nil)
9663 (setq org-occur-parameters nil)
9664 (unless noremove
9665 (remove-hook 'before-change-functions
9666 'org-remove-occur-highlights 'local))))
9668 ;;;; Priorities
9671 "Regular expression matching the priority indicator.")
9673 (defvar org-remove-priority-next-time nil)
9675 (defun org-priority-up ()
9676 "Increase the priority of the current item."
9677 (interactive)
9678 (org-priority 'up))
9680 (defun org-priority-down ()
9681 "Decrease the priority of the current item."
9682 (interactive)
9683 (org-priority 'down))
9685 (defun org-priority (&optional action)
9686 "Change the priority of an item by ARG.
9687 ACTION can be `set', `up', `down', or a character."
9688 (interactive)
9689 (setq action (or action 'set))
9690 (let (current new news have remove)
9691 (save-excursion
9692 (org-back-to-heading t)
9693 (if (looking-at org-priority-regexp)
9694 (setq current (string-to-char (match-string 2))
9695 have t)
9696 (setq current org-default-priority))
9697 (cond
9698 ((or (eq action 'set)
9699 (if (featurep 'xemacs) (characterp action) (integerp action)))
9700 (if (not (eq action 'set))
9701 (setq new action)
9702 (message "Priority %c-%c, SPC to remove: "
9703 org-highest-priority org-lowest-priority)
9704 (setq new (read-char-exclusive)))
9705 (if (and (= (upcase org-highest-priority) org-highest-priority)
9706 (= (upcase org-lowest-priority) org-lowest-priority))
9707 (setq new (upcase new)))
9708 (cond ((equal new ?\ ) (setq remove t))
9709 ((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority))
9710 (error "Priority must be between `%c' and `%c'"
9711 org-highest-priority org-lowest-priority))))
9712 ((eq action 'up)
9713 (if (and (not have) (eq last-command this-command))
9714 (setq new org-lowest-priority)
9715 (setq new (if (and org-priority-start-cycle-with-default (not have))
9716 org-default-priority (1- current)))))
9717 ((eq action 'down)
9718 (if (and (not have) (eq last-command this-command))
9719 (setq new org-highest-priority)
9720 (setq new (if (and org-priority-start-cycle-with-default (not have))
9721 org-default-priority (1+ current)))))
9722 (t (error "Invalid action")))
9723 (if (or (< (upcase new) org-highest-priority)
9724 (> (upcase new) org-lowest-priority))
9725 (setq remove t))
9726 (setq news (format "%c" new))
9727 (if have
9728 (if remove
9729 (replace-match "" t t nil 1)
9730 (replace-match news t t nil 2))
9731 (if remove
9732 (error "No priority cookie found in line")
9733 (looking-at org-todo-line-regexp)
9734 (if (match-end 2)
9735 (progn
9736 (goto-char (match-end 2))
9737 (insert " [#" news "]"))
9738 (goto-char (match-beginning 3))
9739 (insert "[#" news "] ")))))
9740 (org-preserve-lc (org-set-tags nil 'align))
9741 (if remove
9742 (message "Priority removed")
9743 (message "Priority of current item set to %s" news))))
9746 (defun org-get-priority (s)
9747 "Find priority cookie and return priority."
9748 (save-match-data
9749 (if (not (string-match org-priority-regexp s))
9750 (* 1000 (- org-lowest-priority org-default-priority))
9751 (* 1000 (- org-lowest-priority
9752 (string-to-char (match-string 2 s)))))))
9754 ;;;; Tags
9756 (defvar org-agenda-archives-mode)
9757 (defun org-scan-tags (action matcher &optional todo-only)
9758 "Scan headline tags with inheritance and produce output ACTION.
9760 ACTION can be `sparse-tree' to produce a sparse tree in the current buffer,
9761 or `agenda' to produce an entry list for an agenda view. It can also be
9762 a Lisp form or a function that should be called at each matched headline, in
9763 this case the return value is a list of all return values from these calls.
9765 MATCHER is a Lisp form to be evaluated, testing if a given set of tags
9766 qualifies a headline for inclusion. When TODO-ONLY is non-nil,
9767 only lines with a TODO keyword are included in the output."
9768 (require 'org-agenda)
9771 (org-re
9773 (props (list 'face 'default
9774 'done-face 'org-done
9775 'undone-face 'default
9776 'mouse-face 'highlight
9777 'org-not-done-regexp org-not-done-regexp
9778 'org-todo-regexp org-todo-regexp
9779 'keymap org-agenda-keymap
9780 'help-echo
9781 (format "mouse-2 or RET jump to org file %s"
9782 (abbreviate-file-name
9783 (or (buffer-file-name (buffer-base-buffer))
9784 (buffer-name (buffer-base-buffer)))))))
9785 (case-fold-search nil)
9786 lspos tags tags-list
9787 (tags-alist (list (cons 0 (mapcar 'downcase org-file-tags))))
9788 (llast 0) rtn rtn1 level category i txt
9789 todo marker entry priority)
9790 (when (not (or (member action '(agenda sparse-tree)) (functionp action)))
9791 (setq action (list 'lambda nil action)))
9792 (save-excursion
9793 (goto-char (point-min))
9794 (when (eq action 'sparse-tree)
9795 (org-overview)
9796 (org-remove-occur-highlights))
9797 (while (re-search-forward re nil t)
9798 (catch :skip
9799 (setq todo (if (match-end 1) (match-string 2))
9800 tags (if (match-end 4) (match-string 4)))
9801 (goto-char (setq lspos (1+ (match-beginning 0))))
9802 (setq level (org-reduced-level (funcall outline-level))
9803 category (org-get-category))
9804 (setq i llast llast level)
9805 ;; remove tag lists from same and sublevels
9806 (while (>= i level)
9807 (when (setq entry (assoc i tags-alist))
9808 (setq tags-alist (delete entry tags-alist)))
9809 (setq i (1- i)))
9810 ;; add the next tags
9811 (when tags
9812 (setq tags (mapcar 'downcase (org-split-string tags ":"))
9813 tags-alist
9814 (cons (cons level tags) tags-alist)))
9815 ;; compile tags for current headline
9816 (setq tags-list
9817 (if org-use-tag-inheritance
9818 (apply 'append (mapcar 'cdr (reverse tags-alist)))
9819 tags))
9820 (when org-use-tag-inheritance
9821 (setcdr (car tags-alist)
9822 (mapcar (lambda (x)
9823 (setq x (copy-sequence x))
9824 (org-add-prop-inherited x))
9825 (cdar tags-alist))))
9826 (when (and tags org-use-tag-inheritance
9827 (not (eq t org-use-tag-inheritance)))
9828 ;; selective inheritance, remove uninherited ones
9829 (setcdr (car tags-alist)
9830 (org-remove-uniherited-tags (cdar tags-alist))))
9831 (when (and (or (not todo-only)
9832 (and (member todo org-not-done-keywords)
9833 (or (not org-agenda-tags-todo-honor-ignore-options)
9834 (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item)))))
9835 (let ((case-fold-search t)) (eval matcher))
9836 (or
9837 (not (member org-archive-tag tags-list))
9838 ;; we have an archive tag, should we use this anyway?
9839 (or (not org-agenda-skip-archived-trees)
9840 (and (eq action 'agenda) org-agenda-archives-mode))))
9841 (unless (eq action 'sparse-tree) (org-agenda-skip))
9843 ;; select this headline
9845 (cond
9846 ((eq action 'sparse-tree)
9847 (and org-highlight-sparse-tree-matches
9848 (org-get-heading) (match-end 0)
9849 (org-highlight-new-match
9850 (match-beginning 0) (match-beginning 1)))
9851 (org-show-context 'tags-tree))
9852 ((eq action 'agenda)
9853 (setq txt (org-format-agenda-item
9854 ""
9855 (concat
9856 (if org-tags-match-list-sublevels
9857 (make-string (1- level) ?.) "")
9858 (org-get-heading))
9859 category (org-get-tags-at))
9860 priority (org-get-priority txt))
9861 (goto-char lspos)
9862 (setq marker (org-agenda-new-marker))
9863 (org-add-props txt props
9864 'org-marker marker 'org-hd-marker marker 'org-category category
9865 'todo-state todo
9866 'priority priority 'type "tagsmatch")
9867 (push txt rtn))
9868 ((functionp action)
9869 (save-excursion
9870 (setq rtn1 (funcall action))
9871 (push rtn1 rtn))
9872 (goto-char (point-at-eol)))
9873 (t (error "Invalid action")))
9875 ;; if we are to skip sublevels, jump to end of subtree
9876 (or org-tags-match-list-sublevels (org-end-of-subtree t))))))
9877 (when (and (eq action 'sparse-tree)
9878 (not org-sparse-tree-open-archived-trees))
9879 (org-hide-archived-subtrees (point-min) (point-max)))
9880 (nreverse rtn)))
9882 (defun org-remove-uniherited-tags (tags)
9883 "Remove all tags that are not inherited from the list TAGS."
9884 (cond
9885 ((eq org-use-tag-inheritance t)
9886 (if org-tags-exclude-from-inheritance
9887 (org-delete-all org-tags-exclude-from-inheritance tags)
9888 tags))
9889 ((not org-use-tag-inheritance) nil)
9890 ((stringp org-use-tag-inheritance)
9891 (delq nil (mapcar
9892 (lambda (x)
9893 (if (and (string-match org-use-tag-inheritance x)
9894 (not (member x org-tags-exclude-from-inheritance)))
9895 x nil))
9896 tags)))
9897 ((listp org-use-tag-inheritance)
9898 (delq nil (mapcar
9899 (lambda (x)
9900 (if (member x org-use-tag-inheritance) x nil))
9901 tags)))))
9903 (defvar todo-only) ;; dynamically scoped
9905 (defun org-match-sparse-tree (&optional todo-only match)
9906 "Create a sparse tree according to tags string MATCH.
9907 MATCH can contain positive and negative selection of tags, like
9909 If optional argument TODO-ONLY is non-nil, only select lines that are
9910 also TODO lines."
9911 (interactive "P")
9912 (org-prepare-agenda-buffers (list (current-buffer)))
9913 (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only))
9915 (defalias 'org-tags-sparse-tree 'org-match-sparse-tree)
9917 (defvar org-cached-props nil)
9918 (defun org-cached-entry-get (pom property)
9919 (if (or (eq t org-use-property-inheritance)
9920 (and (stringp org-use-property-inheritance)
9921 (string-match org-use-property-inheritance property))
9922 (and (listp org-use-property-inheritance)
9923 (member property org-use-property-inheritance)))
9924 ;; Caching is not possible, check it directly
9925 (org-entry-get pom property 'inherit)
9926 ;; Get all properties, so that we can do complicated checks easily
9927 (cdr (assoc property (or org-cached-props
9928 (setq org-cached-props
9929 (org-entry-properties pom)))))))
9931 (defun org-global-tags-completion-table (&optional files)
9932 "Return the list of all tags in all agenda buffer/files."
9933 (save-excursion
9934 (org-uniquify
9935 (delq nil
9936 (apply 'append
9937 (mapcar
9938 (lambda (file)
9939 (set-buffer (find-file-noselect file))
9940 (append (org-get-buffer-tags)
9941 (mapcar (lambda (x) (if (stringp (car-safe x))
9942 (list (car-safe x)) nil))
9943 org-tag-alist)))
9944 (if (and files (car files))
9945 files
9946 (org-agenda-files))))))))
9948 (defun org-make-tags-matcher (match)
9949 "Create the TAGS//TODO matcher form for the selection string MATCH."
9950 ;; todo-only is scoped dynamically into this function, and the function
9951 ;; may change it if the matcher asks for it.
9952 (unless match
9953 ;; Get a new match request, with completion
9954 (let ((org-last-tags-completion-table
9955 (org-global-tags-completion-table)))
9956 (setq match (org-completing-read-no-ido
9957 "Match: " 'org-tags-completion-function nil nil nil
9958 'org-tags-history))))
9960 ;; Parse the string and create a lisp form
9961 (let ((match0 match)
9962 (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\([[:alnum:]_]+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@]+\\)"))
9963 minus tag mm
9964 tagsmatch todomatch tagsmatcher todomatcher kwd matcher
9965 orterms term orlist re-p str-p level-p level-op time-p
9966 prop-p pn pv po cat-p gv rest)
9967 (if (string-match "/+" match)
9968 ;; match contains also a todo-matching request
9969 (progn
9970 (setq tagsmatch (substring match 0 (match-beginning 0))
9971 todomatch (substring match (match-end 0)))
9972 (if (string-match "^!" todomatch)
9973 (setq todo-only t todomatch (substring todomatch 1)))
9975 (setq todomatch nil)))
9976 ;; only matching tags
9977 (setq tagsmatch match todomatch nil))
9979 ;; Make the tags matcher
9981 (setq tagsmatcher t)
9982 (setq orterms (org-split-string tagsmatch "|") orlist nil)
9983 (while (setq term (pop orterms))
9985 (setq term (concat term "|" (pop orterms)))) ; repair bad split
9986 (while (string-match re term)
9987 (setq rest (substring term (match-end 0))
9988 minus (and (match-end 1)
9989 (equal (match-string 1 term) "-"))
9990 tag (match-string 2 term)
9991 re-p (equal (string-to-char tag) ?{)
9992 level-p (match-end 4)
9993 prop-p (match-end 5)
9994 mm (cond
9995 (re-p `(org-match-any-p ,(substring tag 1 -1) tags-list))
9996 (level-p
9997 (setq level-op (org-op-to-function (match-string 3 term)))
9998 `(,level-op level ,(string-to-number
9999 (match-string 4 term))))
10000 (prop-p
10001 (setq pn (match-string 5 term)
10002 po (match-string 6 term)
10003 pv (match-string 7 term)
10004 cat-p (equal pn "CATEGORY")
10005 re-p (equal (string-to-char pv) ?{)
10007 time-p (save-match-data
10009 pv (if (or re-p str-p) (substring pv 1 -1) pv))
10010 (if time-p (setq pv (org-matcher-time pv)))
10011 (setq po (org-op-to-function po (if time-p 'time str-p)))
10012 (cond
10013 ((equal pn "CATEGORY")
10014 (setq gv '(get-text-property (point) 'org-category)))
10015 ((equal pn "TODO")
10016 (setq gv 'todo))
10017 (t
10018 (setq gv `(org-cached-entry-get nil ,pn))))
10019 (if re-p
10020 (if (eq po 'org<>)
10021 `(not (string-match ,pv (or ,gv "")))
10022 `(string-match ,pv (or ,gv "")))
10023 (if str-p
10024 `(,po (or ,gv "") ,pv)
10025 `(,po (string-to-number (or ,gv ""))
10026 ,(string-to-number pv) ))))
10027 (t `(member ,(downcase tag) tags-list)))
10028 mm (if minus (list 'not mm) mm)
10029 term rest)
10030 (push mm tagsmatcher))
10031 (push (if (> (length tagsmatcher) 1)
10032 (cons 'and tagsmatcher)
10033 (car tagsmatcher))
10034 orlist)
10035 (setq tagsmatcher nil))
10036 (setq tagsmatcher (if (> (length orlist) 1) (cons 'or orlist) (car orlist)))
10037 (setq tagsmatcher
10038 (list 'progn '(setq org-cached-props nil) tagsmatcher)))
10039 ;; Make the todo matcher
10041 (setq todomatcher t)
10042 (setq orterms (org-split-string todomatch "|") orlist nil)
10043 (while (setq term (pop orterms))
10044 (while (string-match re term)
10045 (setq minus (and (match-end 1)
10046 (equal (match-string 1 term) "-"))
10047 kwd (match-string 2 term)
10048 re-p (equal (string-to-char kwd) ?{)
10049 term (substring term (match-end 0))
10050 mm (if re-p
10051 `(string-match ,(substring kwd 1 -1) todo)
10052 (list 'equal 'todo kwd))
10053 mm (if minus (list 'not mm) mm))
10054 (push mm todomatcher))
10055 (push (if (> (length todomatcher) 1)
10056 (cons 'and todomatcher)
10057 (car todomatcher))
10058 orlist)
10059 (setq todomatcher nil))
10060 (setq todomatcher (if (> (length orlist) 1)
10061 (cons 'or orlist) (car orlist))))
10063 ;; Return the string and lisp forms of the matcher
10064 (setq matcher (if todomatcher
10065 (list 'and tagsmatcher todomatcher)
10066 tagsmatcher))
10067 (cons match0 matcher)))
10069 (defun org-op-to-function (op &optional stringp)
10070 "Turn an operator into the appropriate function."
10071 (setq op
10072 (cond
10073 ((equal op "<" ) '(< string< org-time<))
10074 ((equal op ">" ) '(> org-string> org-time>))
10075 ((member op '("<=" "=<")) '(<= org-string<= org-time<=))
10076 ((member op '(">=" "=>")) '(>= org-string>= org-time>=))
10077 ((member op '("=" "==")) '(= string= org-time=))
10078 ((member op '("<>" "!=")) '(org<> org-string<> org-time<>))))
10079 (nth (if (eq stringp 'time) 2 (if stringp 1 0)) op))
10081 (defun org<> (a b) (not (= a b)))
10082 (defun org-string<= (a b) (or (string= a b) (string< a b)))
10083 (defun org-string>= (a b) (not (string< a b)))
10084 (defun org-string> (a b) (and (not (string= a b)) (not (string< a b))))
10085 (defun org-string<> (a b) (not (string= a b)))
10086 (defun org-time= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (= a b)))
10087 (defun org-time< (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (< a b)))
10088 (defun org-time<= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (<= a b)))
10089 (defun org-time> (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (> a b)))
10090 (defun org-time>= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (>= a b)))
10091 (defun org-time<> (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (org<> a b)))
10092 (defun org-2ft (s)
10093 "Convert S to a floating point time.
10094 If S is already a number, just return it. If it is a string, parse
10095 it as a time string and apply `float-time' to it. If S is nil, just return 0."
10096 (cond
10097 ((numberp s) s)
10098 ((stringp s)
10099 (condition-case nil
10100 (float-time (apply 'encode-time (org-parse-time-string s)))
10101 (error 0.)))
10102 (t 0.)))
10104 (defun org-time-today ()
10105 "Time in seconds today at 0:00.
10106 Returns the float number of seconds since the beginning of the
10107 epoch to the beginning of today (00:00)."
10108 (float-time (apply 'encode-time
10109 (append '(0 0 0) (nthcdr 3 (decode-time))))))
10111 (defun org-matcher-time (s)
10112 "Interpret a time comparison value."
10113 (save-match-data
10114 (cond
10115 ((string= s "<now>") (float-time))
10116 ((string= s "<today>") (org-time-today))
10117 ((string= s "<tomorrow>") (+ 86400.0 (org-time-today)))
10118 ((string= s "<yesterday>") (- (org-time-today) 86400.0))
10120 (+ (org-time-today)
10121 (* (string-to-number (match-string 1 s))
10122 (cdr (assoc (match-string 2 s)
10123 '(("d" . 86400.0) ("w" . 604800.0)
10124 ("m" . 2678400.0) ("y" . 31557600.0)))))))
10125 (t (org-2ft s)))))
10127 (defun org-match-any-p (re list)
10128 "Does re match any element of list?"
10129 (setq list (mapcar (lambda (x) (string-match re x)) list))
10130 (delq nil list))
10132 (defvar org-add-colon-after-tag-completion nil) ;; dynamically scoped param
10133 (defvar org-tags-overlay (org-make-overlay 1 1))
10134 (org-detach-overlay org-tags-overlay)
10136 (defun org-get-local-tags-at (&optional pos)
10137 "Get a list of tags defined in the current headline."
10138 (org-get-tags-at pos 'local))
10140 (defun org-get-local-tags ()
10141 "Get a list of tags defined in the current headline."
10142 (org-get-tags-at nil 'local))
10144 (defun org-get-tags-at (&optional pos local)
10145 "Get a list of all headline tags applicable at POS.
10146 POS defaults to point. If tags are inherited, the list contains
10147 the targets in the same sequence as the headlines appear, i.e.
10148 the tags of the current headline come last.
10149 When LOCAL is non-nil, only return tags from the current headline,
10150 ignore inherited ones."
10151 (interactive)
10152 (let (tags ltags lastpos parent)
10153 (save-excursion
10154 (save-restriction
10155 (widen)
10156 (goto-char (or pos (point)))
10157 (save-match-data
10158 (catch 'done
10159 (condition-case nil
10160 (progn
10161 (org-back-to-heading t)
10162 (while (not (equal lastpos (point)))
10163 (setq lastpos (point))
10165 (setq ltags (org-split-string
10166 (org-match-string-no-properties 1) ":"))
10167 (when parent
10168 (setq ltags (mapcar 'org-add-prop-inherited ltags)))
10169 (setq tags (append
10170 (if parent
10171 (org-remove-uniherited-tags ltags)
10172 ltags)
10173 tags)))
10174 (or org-use-tag-inheritance (throw 'done t))
10175 (if local (throw 'done t))
10176 (org-up-heading-all 1)
10177 (setq parent t)))
10178 (error nil)))))
10179 (append (org-remove-uniherited-tags org-file-tags) tags))))
10181 (defun org-add-prop-inherited (s)
10182 (add-text-properties 0 (length s) '(inherited t) s)
10183 s)
10185 (defun org-toggle-tag (tag &optional onoff)
10186 "Toggle the tag TAG for the current line.
10187 If ONOFF is `on' or `off', don't toggle but set to this state."
10188 (let (res current)
10189 (save-excursion
10190 (org-back-to-heading t)
10192 (point-at-eol) t)
10193 (progn
10194 (setq current (match-string 1))
10195 (replace-match ""))
10196 (setq current ""))
10197 (setq current (nreverse (org-split-string current ":")))
10198 (cond
10199 ((eq onoff 'on)
10200 (setq res t)
10201 (or (member tag current) (push tag current)))
10202 ((eq onoff 'off)
10203 (or (not (member tag current)) (setq current (delete tag current))))
10204 (t (if (member tag current)
10205 (setq current (delete tag current))
10206 (setq res t)
10207 (push tag current))))
10208 (end-of-line 1)
10209 (if current
10210 (progn
10211 (insert " :" (mapconcat 'identity (nreverse current) ":") ":")
10212 (org-set-tags nil t))
10213 (delete-horizontal-space))
10214 (run-hooks 'org-after-tags-change-hook))
10215 res))
10217 (defun org-align-tags-here (to-col)
10218 ;; Assumes that this is a headline
10219 (let ((pos (point)) (col (current-column)) ncol tags-l p)
10220 (beginning-of-line 1)
10222 (< pos (match-beginning 2)))
10223 (progn
10224 (setq tags-l (- (match-end 2) (match-beginning 2)))
10225 (goto-char (match-beginning 1))
10226 (insert " ")
10227 (delete-region (point) (1+ (match-beginning 2)))
10228 (setq ncol (max (1+ (current-column))
10229 (1+ col)
10230 (if (> to-col 0)
10231 to-col
10232 (- (abs to-col) tags-l))))
10233 (setq p (point))
10234 (insert (make-string (- ncol (current-column)) ?\ ))
10235 (setq ncol (current-column))
10236 (when indent-tabs-mode (tabify p (point-at-eol)))
10237 (org-move-to-column (min ncol col) t))
10238 (goto-char pos))))
10240 (defun org-set-tags-command (&optional arg just-align)
10241 "Call the set-tags command for the current entry."
10242 (interactive "P")
10243 (if (org-on-heading-p)
10244 (org-set-tags arg just-align)
10245 (save-excursion
10246 (org-back-to-heading t)
10247 (org-set-tags arg just-align))))
10249 (defun org-set-tags (&optional arg just-align)
10250 "Set the tags for the current headline.
10251 With prefix ARG, realign all tags in headings in the current buffer."
10252 (interactive "P")
10253 (let* ((re (concat "^" outline-regexp))
10254 (current (org-get-tags-string))
10255 (col (current-column))
10256 (org-setting-tags t)
10257 table current-tags inherited-tags ; computed below when needed
10258 tags p0 c0 c1 rpl)
10259 (if arg
10260 (save-excursion
10261 (goto-char (point-min))
10262 (let ((buffer-invisibility-spec (org-inhibit-invisibility)))
10263 (while (re-search-forward re nil t)
10264 (org-set-tags nil t)
10265 (end-of-line 1)))
10266 (message "All tags realigned to column %d" org-tags-column))
10267 (if just-align
10268 (setq tags current)
10269 ;; Get a new set of tags from the user
10270 (save-excursion
10271 (setq table (append org-tag-persistent-alist
10272 (or org-tag-alist (org-get-buffer-tags)))
10273 org-last-tags-completion-table table
10274 current-tags (org-split-string current ":")
10275 inherited-tags (nreverse
10276 (nthcdr (length current-tags)
10277 (nreverse (org-get-tags-at))))
10278 tags
10279 (if (or (eq t org-use-fast-tag-selection)
10280 (and org-use-fast-tag-selection
10281 (delq nil (mapcar 'cdr table))))
10282 (org-fast-tag-selection
10283 current-tags inherited-tags table
10284 (if org-fast-tag-selection-include-todo org-todo-key-alist))
10285 (let ((org-add-colon-after-tag-completion t))
10286 (org-trim
10287 (org-without-partial-completion
10288 (org-ido-completing-read "Tags: " 'org-tags-completion-function
10289 nil nil current 'org-tags-history)))))))
10290 (while (string-match "[-+&]+" tags)
10291 ;; No boolean logic, just a list
10292 (setq tags (replace-match ":" t t tags))))
10295 (setq tags "")
10296 (unless (string-match ":$" tags) (setq tags (concat tags ":")))
10297 (unless (string-match "^:" tags) (setq tags (concat ":" tags))))
10299 ;; Insert new tags at the correct column
10300 (beginning-of-line 1)
10301 (cond
10302 ((and (equal current "") (equal tags "")))
10303 ((re-search-forward
10305 (point-at-eol) t)
10306 (if (equal tags "")
10307 (setq rpl "")
10308 (goto-char (match-beginning 0))
10309 (setq c0 (current-column) p0 (point)
10310 c1 (max (1+ c0) (if (> org-tags-column 0)
10311 org-tags-column
10312 (- (- org-tags-column) (length tags))))
10313 rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags)))
10314 (replace-match rpl t t)
10315 (and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point)))
10316 tags)
10317 (t (error "Tags alignment failed")))
10318 (org-move-to-column col)
10319 (unless just-align
10320 (run-hooks 'org-after-tags-change-hook)))))
10322 (defun org-change-tag-in-region (beg end tag off)
10323 "Add or remove TAG for each entry in the region.
10324 This works in the agenda, and also in an org-mode buffer."
10325 (interactive
10326 (list (region-beginning) (region-end)
10327 (let ((org-last-tags-completion-table
10328 (if (org-mode-p)
10329 (org-get-buffer-tags)
10330 (org-global-tags-completion-table))))
10331 (org-ido-completing-read
10332 "Tag: " 'org-tags-completion-function nil nil nil
10333 'org-tags-history))
10334 (progn
10335 (message "[s]et or [r]emove? ")
10336 (equal (read-char-exclusive) ?r))))
10337 (if (fboundp 'deactivate-mark) (deactivate-mark))
10338 (let ((agendap (equal major-mode 'org-agenda-mode))
10339 l1 l2 m buf pos newhead (cnt 0))
10340 (goto-char end)
10341 (setq l2 (1- (org-current-line)))
10342 (goto-char beg)
10343 (setq l1 (org-current-line))
10344 (loop for l from l1 to l2 do
10345 (goto-line l)
10346 (setq m (get-text-property (point) 'org-hd-marker))
10347 (when (or (and (org-mode-p) (org-on-heading-p))
10348 (and agendap m))
10349 (setq buf (if agendap (marker-buffer m) (current-buffer))
10350 pos (if agendap m (point)))
10351 (with-current-buffer buf
10352 (save-excursion
10353 (save-restriction
10354 (goto-char pos)
10355 (setq cnt (1+ cnt))
10356 (org-toggle-tag tag (if off 'off 'on))
10357 (setq newhead (org-get-heading)))))
10358 (and agendap (org-agenda-change-all-lines newhead m))))
10359 (message "Tag :%s: %s in %d headings" tag (if off "removed" "set") cnt)))
10361 (defun org-tags-completion-function (string predicate &optional flag)
10362 (let (s1 s2 rtn (ctable org-last-tags-completion-table)
10363 (confirm (lambda (x) (stringp (car x)))))
10365 (setq s1 (match-string 1 string)
10366 s2 (match-string 2 string))
10367 (setq s1 "" s2 string))
10368 (cond
10369 ((eq flag nil)
10370 ;; try completion
10371 (setq rtn (try-completion s2 ctable confirm))
10372 (if (stringp rtn)
10373 (setq rtn
10374 (concat s1 s2 (substring rtn (length s2))
10375 (if (and org-add-colon-after-tag-completion
10376 (assoc rtn ctable))
10377 ":" ""))))
10378 rtn)
10379 ((eq flag t)
10380 ;; all-completions
10381 (all-completions s2 ctable confirm)
10382 )
10383 ((eq flag 'lambda)
10384 ;; exact match?
10385 (assoc s2 ctable)))
10386 ))
10388 (defun org-fast-tag-insert (kwd tags face &optional end)
10389 "Insert KDW, and the TAGS, the latter with face FACE. Also insert END."
10390 (insert (format "%-12s" (concat kwd ":"))
10391 (org-add-props (mapconcat 'identity tags " ") nil 'face face)
10392 (or end "")))
10394 (defun org-fast-tag-show-exit (flag)
10395 (save-excursion
10396 (goto-line 3)
10398 (replace-match ""))
10399 (when flag
10400 (end-of-line 1)
10401 (org-move-to-column (- (window-width) 19) t)
10402 (insert (org-add-props " Next change exits" nil 'face 'org-warning)))))
10404 (defun org-set-current-tags-overlay (current prefix)
10405 (let ((s (concat ":" (mapconcat 'identity current ":") ":")))
10406 (if (featurep 'xemacs)
10407 (org-overlay-display org-tags-overlay (concat prefix s)
10408 'secondary-selection)
10409 (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s)
10410 (org-overlay-display org-tags-overlay (concat prefix s)))))
10412 (defun org-fast-tag-selection (current inherited table &optional todo-table)
10413 "Fast tag selection with single keys.
10414 CURRENT is the current list of tags in the headline, INHERITED is the
10415 list of inherited tags, and TABLE is an alist of tags and corresponding keys,
10416 possibly with grouping information. TODO-TABLE is a similar table with
10417 TODO keywords, should these have keys assigned to them.
10418 If the keys are nil, a-z are automatically assigned.
10419 Returns the new tags string, or nil to not change the current settings."
10420 (let* ((fulltable (append table todo-table))
10421 (maxlen (apply 'max (mapcar
10422 (lambda (x)
10423 (if (stringp (car x)) (string-width (car x)) 0))
10424 fulltable)))
10425 (buf (current-buffer))
10426 (expert (eq org-fast-tag-selection-single-key 'expert))
10427 (buffer-tags nil)
10428 (fwidth (+ maxlen 3 1 3))
10429 (ncol (/ (- (window-width) 4) fwidth))
10430 (i-face 'org-done)
10431 (c-face 'org-todo)
10432 tg cnt e c char c1 c2 ntable tbl rtn
10433 ov-start ov-end ov-prefix
10434 (exit-after-next org-fast-tag-selection-single-key)
10435 (done-keywords org-done-keywords)
10436 groups ingroup)
10437 (save-excursion
10438 (beginning-of-line 1)
10439 (if (looking-at
10441 (setq ov-start (match-beginning 1)
10442 ov-end (match-end 1)
10443 ov-prefix "")
10444 (setq ov-start (1- (point-at-eol))
10445 ov-end (1+ ov-start))
10447 (setq ov-prefix
10448 (concat
10449 (buffer-substring (1- (point)) (point))
10450 (if (> (current-column) org-tags-column)
10451 " "
10452 (make-string (- org-tags-column (current-column)) ?\ ))))))
10453 (org-move-overlay org-tags-overlay ov-start ov-end)
10454 (save-window-excursion
10455 (if expert
10456 (set-buffer (get-buffer-create " *Org tags*"))
10457 (delete-other-windows)
10458 (split-window-vertically)
10459 (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*")))
10460 (erase-buffer)
10461 (org-set-local 'org-done-keywords done-keywords)
10464 (org-fast-tag-show-exit exit-after-next)
10465 (org-set-current-tags-overlay current ov-prefix)
10466 (setq tbl fulltable char ?a cnt 0)
10467 (while (setq e (pop tbl))
10468 (cond
10469 ((equal e '(:startgroup))
10470 (push '() groups) (setq ingroup t)
10471 (when (not (= cnt 0))
10472 (setq cnt 0)
10474 (insert "{ "))
10475 ((equal e '(:endgroup))
10476 (setq ingroup nil cnt 0)
10478 ((equal e '(:newline))
10479 (when (not (= cnt 0))
10480 (setq cnt 0)
10482 (setq e (car tbl))
10483 (while (equal (car tbl) '(:newline))
10485 (setq tbl (cdr tbl)))))
10486 (t
10487 (setq tg (car e) c2 nil)
10488 (if (cdr e)
10489 (setq c (cdr e))
10490 ;; automatically assign a character.
10491 (setq c1 (string-to-char
10492 (downcase (substring
10493 tg (if (= (string-to-char tg) ?@) 1 0)))))
10494 (if (or (rassoc c1 ntable) (rassoc c1 table))
10495 (while (or (rassoc char ntable) (rassoc char table))
10496 (setq char (1+ char)))
10497 (setq c2 c1))
10498 (setq c (or c2 char)))
10499 (if ingroup (push tg (car groups)))
10500 (setq tg (org-add-props tg nil 'face
10501 (cond
10502 ((not (assoc tg table))
10503 (org-get-todo-face tg))
10504 ((member tg current) c-face)
10505 ((member tg inherited) i-face)
10506 (t nil))))
10507 (if (and (= cnt 0) (not ingroup)) (insert " "))
10508 (insert "[" c "] " tg (make-string
10509 (- fwidth 4 (length tg)) ?\ ))
10510 (push (cons tg c) ntable)
10511 (when (= (setq cnt (1+ cnt)) ncol)
10513 (if ingroup (insert " "))
10514 (setq cnt 0)))))
10515 (setq ntable (nreverse ntable))
10517 (goto-char (point-min))
10518 (if (not expert) (org-fit-window-to-buffer))
10519 (setq rtn
10520 (catch 'exit
10521 (while t
10522 (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free%s%s"
10523 (if groups " [!] no groups" " [!]groups")
10524 (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
10525 (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
10526 (cond
10528 ((= c ?!)
10529 (setq groups (not groups))
10530 (goto-char (point-min))
10531 (while (re-search-forward "[{}]" nil t) (replace-match " ")))
10532 ((= c ?\C-c)
10533 (if (not expert)
10534 (org-fast-tag-show-exit
10535 (setq exit-after-next (not exit-after-next)))
10536 (setq expert nil)
10537 (delete-other-windows)
10538 (split-window-vertically)
10539 (org-switch-to-buffer-other-window " *Org tags*")
10540 (org-fit-window-to-buffer)))
10541 ((or (= c ?\C-g)
10542 (and (= c ?q) (not (rassoc c ntable))))
10543 (org-detach-overlay org-tags-overlay)
10544 (setq quit-flag t))
10545 ((= c ?\ )
10546 (setq current nil)
10547 (if exit-after-next (setq exit-after-next 'now)))
10549 (condition-case nil
10550 (setq tg (org-ido-completing-read
10551 "Tag: "
10552 (or buffer-tags
10553 (with-current-buffer buf
10554 (org-get-buffer-tags)))))
10555 (quit (setq tg "")))
10557 (add-to-list 'buffer-tags (list tg))
10558 (if (member tg current)
10559 (setq current (delete tg current))
10560 (push tg current)))
10561 (if exit-after-next (setq exit-after-next 'now)))
10562 ((setq e (rassoc c todo-table) tg (car e))
10563 (with-current-buffer buf
10564 (save-excursion (org-todo tg)))
10565 (if exit-after-next (setq exit-after-next 'now)))
10566 ((setq e (rassoc c ntable) tg (car e))
10567 (if (member tg current)
10568 (setq current (delete tg current))
10569 (loop for g in groups do
10570 (if (member tg g)
10571 (mapc (lambda (x)
10572 (setq current (delete x current)))
10573 g)))
10574 (push tg current))
10575 (if exit-after-next (setq exit-after-next 'now))))
10577 ;; Create a sorted list
10578 (setq current
10579 (sort current
10580 (lambda (a b)
10581 (assoc b (cdr (memq (assoc a ntable) ntable))))))
10582 (if (eq exit-after-next 'now) (throw 'exit t))
10583 (goto-char (point-min))
10584 (beginning-of-line 2)
10585 (delete-region (point) (point-at-eol))
10586 (org-fast-tag-insert "Current" current c-face)
10587 (org-set-current-tags-overlay current ov-prefix)
10588 (while (re-search-forward
10590 (setq tg (match-string 1))
10591 (add-text-properties
10592 (match-beginning 1) (match-end 1)
10593 (list 'face
10594 (cond
10595 ((member tg current) c-face)
10596 ((member tg inherited) i-face)
10597 (t (get-text-property (match-beginning 1) 'face))))))
10598 (goto-char (point-min)))))
10599 (org-detach-overlay org-tags-overlay)
10600 (if rtn
10601 (mapconcat 'identity current ":")
10602 nil))))
10604 (defun org-get-tags-string ()
10605 "Get the TAGS string in the current headline."
10606 (unless (org-on-heading-p t)
10607 (error "Not on a heading"))
10608 (save-excursion
10609 (beginning-of-line 1)
10611 (org-match-string-no-properties 1)
10612 "")))
10614 (defun org-get-tags ()
10615 "Get the list of tags specified in the current headline."
10616 (org-split-string (org-get-tags-string) ":"))
10618 (defun org-get-buffer-tags ()
10619 "Get a table of all tags used in the buffer, for completion."
10620 (let (tags)
10621 (save-excursion
10622 (goto-char (point-min))
10623 (while (re-search-forward
10625 (when (equal (char-after (point-at-bol 0)) ?*)
10626 (mapc (lambda (x) (add-to-list 'tags x))
10627 (org-split-string (org-match-string-no-properties 1) ":")))))
10628 (mapcar 'list tags)))
10630 ;;;; The mapping API
10632 ;;;###autoload
10633 (defun org-map-entries (func &optional match scope &rest skip)
10634 "Call FUNC at each headline selected by MATCH in SCOPE.
10636 FUNC is a function or a lisp form. The function will be called without
10637 arguments, with the cursor positioned at the beginning of the headline.
10638 The return values of all calls to the function will be collected and
10639 returned as a list.
10641 MATCH is a tags/property/todo match as it is used in the agenda tags view.
10642 Only headlines that are matched by this query will be considered during
10643 the iteration. When MATCH is nil or t, all headlines will be
10644 visited by the iteration.
10646 SCOPE determines the scope of this command. It can be any of:
10648 nil The current buffer, respecting the restriction if any
10649 tree The subtree started with the entry at point
10650 file The current buffer, without restriction
10651 file-with-archives
10652 The current buffer, and any archives associated with it
10653 agenda All agenda files
10654 agenda-with-archives
10655 All agenda files with any archive files associated with them
10656 \(file1 file2 ...)
10657 If this is a list, all files in the list will be scanned
10659 The remaining args are treated as settings for the skipping facilities of
10660 the scanner. The following items can be given here:
10662 archive skip trees with the archive tag.
10663 comment skip trees with the COMMENT keyword
10664 function or Emacs Lisp form:
10665 will be used as value for `org-agenda-skip-function', so whenever
10666 the the function returns t, FUNC will not be called for that
10667 entry and search will continue from the point where the
10668 function leaves it."
10669 (let* ((org-agenda-archives-mode nil) ; just to make sure
10670 (org-agenda-skip-archived-trees (memq 'archive skip))
10671 (org-agenda-skip-comment-trees (memq 'comment skip))
10672 (org-agenda-skip-function
10673 (car (org-delete-all '(comment archive) skip)))
10674 (org-tags-match-list-sublevels t)
10675 matcher file res
10676 org-todo-keywords-for-agenda
10677 org-done-keywords-for-agenda
10678 org-todo-keyword-alist-for-agenda
10679 org-tag-alist-for-agenda)
10681 (cond
10682 ((eq match t) (setq matcher t))
10683 ((eq match nil) (setq matcher t))
10684 (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t))))
10686 (save-excursion
10687 (save-restriction
10688 (when (eq scope 'tree)
10689 (org-back-to-heading t)
10690 (org-narrow-to-subtree)
10691 (setq scope nil))
10693 (if (not scope)
10694 (progn
10695 (org-prepare-agenda-buffers
10696 (list (buffer-file-name (current-buffer))))
10697 (setq res (org-scan-tags func matcher)))
10698 ;; Get the right scope
10699 (cond
10700 ((and scope (listp scope) (symbolp (car scope)))
10701 (setq scope (eval scope)))
10702 ((eq scope 'agenda)
10703 (setq scope (org-agenda-files t)))
10704 ((eq scope 'agenda-with-archives)
10705 (setq scope (org-agenda-files t))
10706 (setq scope (org-add-archive-files scope)))
10707 ((eq scope 'file)
10708 (setq scope (list (buffer-file-name))))
10709 ((eq scope 'file-with-archives)
10710 (setq scope (org-add-archive-files (list (buffer-file-name))))))
10711 (org-prepare-agenda-buffers scope)
10712 (while (setq file (pop scope))
10713 (with-current-buffer (org-find-base-buffer-visiting file)
10714 (save-excursion
10715 (save-restriction
10716 (widen)
10717 (goto-char (point-min))
10718 (setq res (append res (org-scan-tags func matcher))))))))))
10719 res))
10721 ;;;; Properties
10723 ;;; Setting and retrieving properties
10725 (defconst org-special-properties
10726 '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "CLOSED" "PRIORITY"
10727 "TIMESTAMP" "TIMESTAMP_IA")
10728 "The special properties valid in Org-mode.
10730 These are properties that are not defined in the property drawer,
10731 but in some other way.")
10733 (defconst org-default-properties
10734 '("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION"
10735 "LOCATION" "LOGGING" "COLUMNS" "VISIBILITY"
10736 "TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE"
10737 "EXPORT_FILE_NAME" "EXPORT_TITLE" "ORDERED")
10738 "Some properties that are used by Org-mode for various purposes.
10739 Being in this list makes sure that they are offered for completion.")
10742 "Regular expression matching the first line of a property drawer.")
10745 "Regular expression matching the first line of a property drawer.")
10748 "Regular expression matching the first line of a property drawer.")
10751 "Regular expression matching the first line of a property drawer.")
10753 (defconst org-property-drawer-re
10756 "Matches an entire property drawer.")
10758 (defconst org-clock-drawer-re
10761 "Matches an entire clock drawer.")
10763 (defun org-property-action ()
10764 "Do an action on properties."
10765 (interactive)
10766 (let (c)
10767 (org-at-property-p)
10768 (message "Property Action: [s]et [d]elete [D]elete globally [c]ompute")
10769 (setq c (read-char-exclusive))
10770 (cond
10771 ((equal c ?s)
10772 (call-interactively 'org-set-property))
10773 ((equal c ?d)
10774 (call-interactively 'org-delete-property))
10775 ((equal c ?D)
10776 (call-interactively 'org-delete-property-globally))
10777 ((equal c ?c)
10778 (call-interactively 'org-compute-property-at-point))
10779 (t (error "No such property action %c" c)))))
10781 (defun org-at-property-p ()
10782 "Is the cursor in a property line?"
10783 ;; FIXME: Does not check if we are actually in the drawer.
10784 ;; FIXME: also returns true on any drawers.....
10785 ;; This is used by C-c C-c for property action.
10786 (save-excursion
10787 (beginning-of-line 1)
10790 (defun org-get-property-block (&optional beg end force)
10791 "Return the (beg . end) range of the body of the property drawer.
10792 BEG and END can be beginning and end of subtree, if not given
10793 they will be found.
10794 If the drawer does not exist and FORCE is non-nil, create the drawer."
10795 (catch 'exit
10796 (save-excursion
10797 (let* ((beg (or beg (progn (org-back-to-heading t) (point))))
10798 (end (or end (progn (outline-next-heading) (point)))))
10799 (goto-char beg)
10800 (if (re-search-forward org-property-start-re end t)
10801 (setq beg (1+ (match-end 0)))
10802 (if force
10803 (save-excursion
10804 (org-insert-property-drawer)
10805 (setq end (progn (outline-next-heading) (point))))
10806 (throw 'exit nil))
10807 (goto-char beg)
10808 (if (re-search-forward org-property-start-re end t)
10809 (setq beg (1+ (match-end 0)))))
10810 (if (re-search-forward org-property-end-re end t)
10811 (setq end (match-beginning 0))
10812 (or force (throw 'exit nil))
10813 (goto-char beg)
10814 (setq end beg)
10815 (org-indent-line-function)
10817 (cons beg end)))))
10819 (defun org-entry-properties (&optional pom which)
10820 "Get all properties of the entry at point-or-marker POM.
10821 This includes the TODO keyword, the tags, time strings for deadline,
10822 scheduled, and clocking, and any additional properties defined in the
10823 entry. The return value is an alist, keys may occur multiple times
10824 if the property key was used several times.
10825 POM may also be nil, in which case the current entry is used.
10826 If WHICH is nil or `all', get all properties. If WHICH is
10827 `special' or `standard', only get that subclass."
10828 (setq which (or which 'all))
10829 (org-with-point-at pom
10830 (let ((clockstr (substring org-clock-string 0 -1))
10831 (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY"))
10832 beg end range props sum-props key value string clocksum)
10833 (save-excursion
10834 (when (condition-case nil
10835 (and (org-mode-p) (org-back-to-heading t))
10836 (error nil))
10837 (setq beg (point))
10838 (setq sum-props (get-text-property (point) 'org-summaries))
10839 (setq clocksum (get-text-property (point) :org-clock-minutes))
10840 (outline-next-heading)
10841 (setq end (point))
10842 (when (memq which '(all special))
10843 ;; Get the special properties, like TODO and tags
10844 (goto-char beg)
10845 (when (and (looking-at org-todo-line-regexp) (match-end 2))
10846 (push (cons "TODO" (org-match-string-no-properties 2)) props))
10847 (when (looking-at org-priority-regexp)
10848 (push (cons "PRIORITY" (org-match-string-no-properties 2)) props))
10849 (when (and (setq value (org-get-tags-string))
10851 (push (cons "TAGS" value) props))
10852 (when (setq value (org-get-tags-at))
10853 (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") ":"))
10854 props))
10855 (while (re-search-forward org-maybe-keyword-time-regexp end t)
10856 (setq key (if (match-end 1) (substring (org-match-string-no-properties 1) 0 -1))
10857 string (if (equal key clockstr)
10858 (org-no-properties
10859 (org-trim
10860 (buffer-substring
10861 (match-beginning 3) (goto-char (point-at-eol)))))
10862 (substring (org-match-string-no-properties 3) 1 -1)))
10863 (unless key
10864 (if (= (char-after (match-beginning 3)) ?\[)
10865 (setq key "TIMESTAMP_IA")
10866 (setq key "TIMESTAMP")))
10867 (when (or (equal key clockstr) (not (assoc key props)))
10868 (push (cons key string) props)))
10870 )
10872 (when (memq which '(all standard))
10873 ;; Get the standard properties, like :PORP: ...
10874 (setq range (org-get-property-block beg end))
10875 (when range
10876 (goto-char (car range))
10877 (while (re-search-forward
10879 (cdr range) t)
10880 (setq key (org-match-string-no-properties 1)
10881 value (org-trim (or (org-match-string-no-properties 2) "")))
10882 (unless (member key excluded)
10883 (push (cons key (or value "")) props)))))
10884 (if clocksum
10885 (push (cons "CLOCKSUM"
10886 (org-columns-number-to-string (/ (float clocksum) 60.)
10887 'add_times))
10888 props))
10889 (unless (assoc "CATEGORY" props)
10890 (setq value (or (org-get-category)
10891 (progn (org-refresh-category-properties)
10892 (org-get-category))))
10893 (push (cons "CATEGORY" value) props))
10894 (append sum-props (nreverse props)))))))
10896 (defun org-entry-get (pom property &optional inherit)
10897 "Get value of PROPERTY for entry at point-or-marker POM.
10898 If INHERIT is non-nil and the entry does not have the property,
10899 then also check higher levels of the hierarchy.
10900 If INHERIT is the symbol `selective', use inheritance only if the setting
10901 in `org-use-property-inheritance' selects PROPERTY for inheritance.
10902 If the property is present but empty, the return value is the empty string.
10903 If the property is not present at all, nil is returned."
10904 (org-with-point-at pom
10905 (if (and inherit (if (eq inherit 'selective)
10906 (org-property-inherit-p property)
10907 t))
10908 (org-entry-get-with-inheritance property)
10909 (if (member property org-special-properties)
10910 ;; We need a special property. Use brute force, get all properties.
10911 (cdr (assoc property (org-entry-properties nil 'special)))
10912 (let ((range (org-get-property-block)))
10913 (if (and range
10914 (goto-char (car range))
10915 (re-search-forward
10917 (cdr range) t))
10918 ;; Found the property, return it.
10919 (if (match-end 1)
10920 (org-match-string-no-properties 1)
10921 "")))))))
10923 (defun org-property-or-variable-value (var &optional inherit)
10924 "Check if there is a property fixing the value of VAR.
10925 If yes, return this value. If not, return the current value of the variable."
10926 (let ((prop (org-entry-get nil (symbol-name var) inherit)))
10928 (read prop)
10929 (symbol-value var))))
10931 (defun org-entry-delete (pom property)
10932 "Delete the property PROPERTY from entry at point-or-marker POM."
10933 (org-with-point-at pom
10934 (if (member property org-special-properties)
10935 nil ; cannot delete these properties.
10936 (let ((range (org-get-property-block)))
10937 (if (and range
10938 (goto-char (car range))
10939 (re-search-forward
10941 (cdr range) t))
10942 (progn
10943 (delete-region (match-beginning 0) (1+ (point-at-eol)))
10944 t)
10945 nil)))))
10947 ;; Multi-values properties are properties that contain multiple values
10948 ;; These values are assumed to be single words, separated by whitespace.
10949 (defun org-entry-add-to-multivalued-property (pom property value)
10950 "Add VALUE to the words in the PROPERTY in entry at point-or-marker POM."
10951 (let* ((old (org-entry-get pom property))
10953 (setq value (org-entry-protect-space value))
10954 (unless (member value values)
10955 (setq values (cons value values))
10956 (org-entry-put pom property
10957 (mapconcat 'identity values " ")))))
10959 (defun org-entry-remove-from-multivalued-property (pom property value)
10960 "Remove VALUE from words in the PROPERTY in entry at point-or-marker POM."
10961 (let* ((old (org-entry-get pom property))
10963 (setq value (org-entry-protect-space value))
10964 (when (member value values)
10965 (setq values (delete value values))
10966 (org-entry-put pom property
10967 (mapconcat 'identity values " ")))))
10969 (defun org-entry-member-in-multivalued-property (pom property value)
10970 "Is VALUE one of the words in the PROPERTY in entry at point-or-marker POM?"
10971 (let* ((old (org-entry-get pom property))
10973 (setq value (org-entry-protect-space value))
10974 (member value values)))
10976 (defun org-entry-get-multivalued-property (pom property)
10977 "Return a list of values in a multivalued property."
10978 (let* ((value (org-entry-get pom property))
10980 (mapcar 'org-entry-restore-space values)))
10982 (defun org-entry-put-multivalued-property (pom property &rest values)
10983 "Set multivalued PROPERTY at point-or-marker POM to VALUES.
10984 VALUES should be a list of strings. Spaces will be protected."
10985 (org-entry-put pom property
10986 (mapconcat 'org-entry-protect-space values " "))
10987 (let* ((value (org-entry-get pom property))
10989 (mapcar 'org-entry-restore-space values)))
10991 (defun org-entry-protect-space (s)
10992 "Protect spaces and newline in string S."
10993 (while (string-match " " s)
10994 (setq s (replace-match "%20" t t s)))
10996 (setq s (replace-match "%0A" t t s)))
10997 s)
10999 (defun org-entry-restore-space (s)
11000 "Restore spaces and newline in string S."
11001 (while (string-match "%20" s)
11002 (setq s (replace-match " " t t s)))
11003 (while (string-match "%0A" s)
11005 s)
11007 (defvar org-entry-property-inherited-from (make-marker)
11008 "Marker pointing to the entry from where a property was inherited.
11009 Each call to `org-entry-get-with-inheritance' will set this marker to the
11010 location of the entry where the inheritance search matched. If there was
11011 no match, the marker will point nowhere.
11012 Note that also `org-entry-get' calls this function, if the INHERIT flag
11013 is set.")
11015 (defun org-entry-get-with-inheritance (property)
11016 "Get entry property, and search higher levels if not present."
11017 (move-marker org-entry-property-inherited-from nil)
11018 (let (tmp)
11019 (save-excursion
11020 (save-restriction
11021 (widen)
11022 (catch 'ex
11023 (while t
11024 (when (setq tmp (org-entry-get nil property))
11025 (org-back-to-heading t)
11026 (move-marker org-entry-property-inherited-from (point))
11027 (throw 'ex tmp))
11028 (or (org-up-heading-safe) (throw 'ex nil)))))
11029 (or tmp
11030 (cdr (assoc property org-file-properties))
11031 (cdr (assoc property org-global-properties))
11032 (cdr (assoc property org-global-properties-fixed))))))
11034 (defun org-entry-put (pom property value)
11035 "Set PROPERTY to VALUE for entry at point-or-marker POM."
11036 (org-with-point-at pom
11037 (org-back-to-heading t)
11038 (let ((beg (point)) (end (save-excursion (outline-next-heading) (point)))
11039 range)
11040 (cond
11041 ((equal property "TODO")
11043 (not (member value org-todo-keywords-1)))
11045 (if (or (not value)
11047 (setq value 'none))
11048 (org-todo value)
11049 (org-set-tags nil 'align))
11050 ((equal property "PRIORITY")
11052 (string-to-char value) ?\ ))
11053 (org-set-tags nil 'align))
11054 ((equal property "SCHEDULED")
11055 (if (re-search-forward org-scheduled-time-regexp end t)
11056 (cond
11057 ((eq value 'earlier) (org-timestamp-change -1 'day))
11058 ((eq value 'later) (org-timestamp-change 1 'day))
11059 (t (call-interactively 'org-schedule)))
11060 (call-interactively 'org-schedule)))
11061 ((equal property "DEADLINE")
11062 (if (re-search-forward org-deadline-time-regexp end t)
11063 (cond
11064 ((eq value 'earlier) (org-timestamp-change -1 'day))
11065 ((eq value 'later) (org-timestamp-change 1 'day))
11066 (t (call-interactively 'org-deadline)))
11067 (call-interactively 'org-deadline)))
11068 ((member property org-special-properties)
11069 (error "The %s property can not yet be set with `org-entry-put'"
11070 property))
11071 (t ; a non-special property
11072 (let ((buffer-invisibility-spec (org-inhibit-invisibility))) ; Emacs 21
11073 (setq range (org-get-property-block beg end 'force))
11074 (goto-char (car range))
11075 (if (re-search-forward
11077 (progn
11078 (delete-region (match-beginning 1) (match-end 1))
11079 (goto-char (match-beginning 1)))
11080 (goto-char (cdr range))
11082 (backward-char 1)
11083 (org-indent-line-function)
11084 (insert ":" property ":"))
11085 (and value (insert " " value))
11086 (org-indent-line-function)))))))
11088 (defun org-buffer-property-keys (&optional include-specials include-defaults include-columns)
11089 "Get all property keys in the current buffer.
11090 With INCLUDE-SPECIALS, also list the special properties that reflect things
11091 like tags and TODO state.
11092 With INCLUDE-DEFAULTS, also include properties that has special meaning
11093 internally: ARCHIVE, CATEGORY, SUMMARY, DESCRIPTION, LOCATION, and LOGGING.
11094 With INCLUDE-COLUMNS, also include property names given in COLUMN
11095 formats in the current buffer."
11096 (let (rtn range cfmt s p)
11097 (save-excursion
11098 (save-restriction
11099 (widen)
11100 (goto-char (point-min))
11101 (while (re-search-forward org-property-start-re nil t)
11102 (setq range (org-get-property-block))
11103 (goto-char (car range))
11104 (while (re-search-forward
11106 (cdr range) t)
11107 (add-to-list 'rtn (org-match-string-no-properties 1)))
11108 (outline-next-heading))))
11110 (when include-specials
11111 (setq rtn (append org-special-properties rtn)))
11113 (when include-defaults
11114 (mapc (lambda (x) (add-to-list 'rtn x)) org-default-properties))
11116 (when include-columns
11117 (save-excursion
11118 (save-restriction
11119 (widen)
11120 (goto-char (point-min))
11121 (while (re-search-forward
11123 nil t)
11124 (setq cfmt (match-string 2) s 0)
11126 cfmt s)
11127 (setq s (match-end 0)
11128 p (match-string 1 cfmt))
11129 (unless (or (equal p "ITEM")
11130 (member p org-special-properties))
11131 (add-to-list 'rtn (match-string 1 cfmt))))))))
11133 (sort rtn (lambda (a b) (string< (upcase a) (upcase b))))))
11135 (defun org-property-values (key)
11136 "Return a list of all values of property KEY."
11137 (save-excursion
11138 (save-restriction
11139 (widen)
11140 (goto-char (point-min))
11142 values)
11143 (while (re-search-forward re nil t)
11144 (add-to-list 'values (org-trim (match-string 1))))
11145 (delete "" values)))))
11147 (defun org-insert-property-drawer ()
11148 "Insert a property drawer into the current entry."
11149 (interactive)
11150 (org-back-to-heading t)
11151 (looking-at outline-regexp)
11152 (let ((indent (- (match-end 0)(match-beginning 0)))
11153 (beg (point))
11155 end hiddenp)
11156 (outline-next-heading)
11157 (setq end (point))
11158 (goto-char beg)
11159 (while (re-search-forward re end t))
11160 (setq hiddenp (org-invisible-p))
11161 (end-of-line 1)
11164 (if (member (match-string 1) '("CLOCK:" ":END:"))
11165 ;; just skip this line
11166 (beginning-of-line 2)
11167 ;; Drawer start, find the end
11169 (beginning-of-line 1)))
11170 (org-skip-over-state-notes)
11172 (if (eq (char-before) ?*) (forward-char 1))
11174 (beginning-of-line 0)
11175 (org-indent-to-column indent)
11176 (beginning-of-line 2)
11177 (org-indent-to-column indent)
11178 (beginning-of-line 0)
11179 (if hiddenp
11180 (save-excursion
11181 (org-back-to-heading t)
11182 (hide-entry))
11183 (org-flag-drawer t))))
11185 (defun org-set-property (property value)
11186 "In the current entry, set PROPERTY to VALUE.
11187 When called interactively, this will prompt for a property name, offering
11188 completion on existing and default properties. And then it will prompt
11189 for a value, offering completion either on allowed values (via an inherited
11190 xxx_ALL property) or on existing values in other instances of this property
11191 in the current file."
11192 (interactive
11193 (let* ((completion-ignore-case t)
11194 (keys (org-buffer-property-keys nil t t))
11195 (prop0 (org-ido-completing-read "Property: " (mapcar 'list keys)))
11196 (prop (if (member prop0 keys)
11197 prop0
11198 (or (cdr (assoc (downcase prop0)
11199 (mapcar (lambda (x) (cons (downcase x) x))
11200 keys)))
11201 prop0)))
11202 (cur (org-entry-get nil prop))
11203 (allowed (org-property-get-allowed-values nil prop 'table))
11204 (existing (mapcar 'list (org-property-values prop)))
11205 (val (if allowed
11206 (org-completing-read "Value: " allowed nil 'req-match)
11207 (let (org-completion-use-ido)
11208 (org-completing-read
11210 (concat "[" cur "]") "")
11211 ": ")
11212 existing nil nil "" nil cur)))))
11213 (list prop (if (equal val "") cur val))))
11214 (unless (equal (org-entry-get nil property) value)
11215 (org-entry-put nil property value)))
11217 (defun org-delete-property (property)
11218 "In the current entry, delete PROPERTY."
11219 (interactive
11220 (let* ((completion-ignore-case t)
11221 (prop (org-ido-completing-read
11222 "Property: " (org-entry-properties nil 'standard))))
11223 (list prop)))
11224 (message "Property %s %s" property
11225 (if (org-entry-delete nil property)
11226 "deleted"
11227 "was not present in the entry")))
11229 (defun org-delete-property-globally (property)
11230 "Remove PROPERTY globally, from all entries."
11231 (interactive
11232 (let* ((completion-ignore-case t)
11233 (prop (org-ido-completing-read
11234 "Globally remove property: "
11235 (mapcar 'list (org-buffer-property-keys)))))
11236 (list prop)))
11237 (save-excursion
11238 (save-restriction
11239 (widen)
11240 (goto-char (point-min))
11241 (let ((cnt 0))
11242 (while (re-search-forward
11244 nil t)
11245 (setq cnt (1+ cnt))
11246 (replace-match ""))
11249 (defvar org-columns-current-fmt-compiled) ; defined in org-colview.el
11251 (defun org-compute-property-at-point ()
11252 "Compute the property at point.
11253 This looks for an enclosing column format, extracts the operator and
11254 then applies it to the property in the column format's scope."
11255 (interactive)
11256 (unless (org-at-property-p)
11257 (error "Not at a property"))
11258 (let ((prop (org-match-string-no-properties 2)))
11259 (org-columns-get-format-and-top-level)
11260 (unless (nth 3 (assoc prop org-columns-current-fmt-compiled))
11261 (error "No operator defined for property %s" prop))
11262 (org-columns-compute prop)))
11264 (defun org-property-get-allowed-values (pom property &optional table)
11265 "Get allowed values for the property PROPERTY.
11266 When TABLE is non-nil, return an alist that can directly be used for
11267 completion."
11268 (let (vals)
11269 (cond
11270 ((equal property "TODO")
11271 (setq vals (org-with-point-at pom
11272 (append org-todo-keywords-1 '("")))))
11273 ((equal property "PRIORITY")
11274 (let ((n org-lowest-priority))
11275 (while (>= n org-highest-priority)
11276 (push (char-to-string n) vals)
11277 (setq n (1- n)))))
11278 ((member property org-special-properties))
11279 (t
11280 (setq vals (org-entry-get pom (concat property "_ALL") 'inherit))
11283 (setq vals (car (read-from-string (concat "(" vals ")"))))
11284 (setq vals (mapcar (lambda (x)
11285 (cond ((stringp x) x)
11286 ((numberp x) (number-to-string x))
11287 ((symbolp x) (symbol-name x))
11288 (t "???")))
11289 vals)))))
11290 (if table (mapcar 'list vals) vals)))
11292 (defun org-property-previous-allowed-value (&optional previous)
11293 "Switch to the next allowed value for this property."
11294 (interactive)
11295 (org-property-next-allowed-value t))
11297 (defun org-property-next-allowed-value (&optional previous)
11298 "Switch to the next allowed value for this property."
11299 (interactive)
11300 (unless (org-at-property-p)
11301 (error "Not at a property"))
11302 (let* ((key (match-string 2))
11303 (value (match-string 3))
11304 (allowed (or (org-property-get-allowed-values (point) key)
11305 (and (member value '("[ ]" "[-]" "[X]"))
11306 '("[ ]" "[X]"))))
11307 nval)
11308 (unless allowed
11309 (error "Allowed values for this property have not been defined"))
11310 (if previous (setq allowed (reverse allowed)))
11311 (if (member value allowed)
11312 (setq nval (car (cdr (member value allowed)))))
11313 (setq nval (or nval (car allowed)))
11314 (if (equal nval value)
11315 (error "Only one allowed value for this property"))
11316 (org-at-property-p)
11317 (replace-match (concat " :" key ": " nval) t t)
11318 (org-indent-line-function)
11319 (beginning-of-line 1)
11322 (defun org-find-entry-with-id (ident)
11323 "Locate the entry that contains the ID property with exact value IDENT.
11324 IDENT can be a string, a symbol or a number, this function will search for
11325 the string representation of it.
11326 Return the position where this entry starts, or nil if there is no such entry."
11327 (interactive "sID: ")
11328 (let ((id (cond
11329 ((stringp ident) ident)
11330 ((symbol-name ident) (symbol-name ident))
11331 ((numberp ident) (number-to-string ident))
11332 (t (error "IDENT %s must be a string, symbol or number" ident))))
11333 (case-fold-search nil))
11334 (save-excursion
11335 (save-restriction
11336 (widen)
11337 (goto-char (point-min))
11338 (when (re-search-forward
11340 nil t)
11341 (org-back-to-heading)
11342 (point))))))
11344 ;;;; Timestamps
11346 (defvar org-last-changed-timestamp nil)
11347 (defvar org-last-inserted-timestamp nil
11348 "The last time stamp inserted with `org-insert-time-stamp'.")
11349 (defvar org-time-was-given) ; dynamically scoped parameter
11350 (defvar org-end-time-was-given) ; dynamically scoped parameter
11351 (defvar org-ts-what) ; dynamically scoped parameter
11353 (defun org-time-stamp (arg &optional inactive)
11354 "Prompt for a date/time and insert a time stamp.
11355 If the user specifies a time like HH:MM, or if this command is called
11356 with a prefix argument, the time stamp will contain date and time.
11357 Otherwise, only the date will be included. All parts of a date not
11358 specified by the user will be filled in from the current date/time.
11359 So if you press just return without typing anything, the time stamp
11360 will represent the current date/time. If there is already a timestamp
11361 at the cursor, it will be modified."
11362 (interactive "P")
11363 (let* ((ts nil)
11364 (default-time
11365 ;; Default time is either today, or, when entering a range,
11366 ;; the range start.
11367 (if (or (and (org-at-timestamp-p t) (setq ts (match-string 0)))
11368 (save-excursion
11369 (re-search-backward
11371 (- (point) 20) t)))
11372 (apply 'encode-time (org-parse-time-string (match-string 1)))
11373 (current-time)))
11374 (default-input (and ts (org-get-compact-tod ts)))
11375 org-time-was-given org-end-time-was-given time)
11376 (cond
11377 ((and (org-at-timestamp-p t)
11378 (memq last-command '(org-time-stamp org-time-stamp-inactive))
11379 (memq this-command '(org-time-stamp org-time-stamp-inactive)))
11380 (insert "--")
11381 (setq time (let ((this-command this-command))
11382 (org-read-date arg 'totime nil nil
11383 default-time default-input)))
11384 (org-insert-time-stamp time (or org-time-was-given arg) inactive))
11385 ((org-at-timestamp-p t)
11386 (setq time (let ((this-command this-command))
11387 (org-read-date arg 'totime nil nil default-time default-input)))
11388 (when (org-at-timestamp-p t) ; just to get the match data
11389 ; (setq inactive (eq (char-after (match-beginning 0)) ?\[))
11390 (replace-match "")
11391 (setq org-last-changed-timestamp
11392 (org-insert-time-stamp
11393 time (or org-time-was-given arg)
11394 inactive nil nil (list org-end-time-was-given))))
11395 (message "Timestamp updated"))
11396 (t
11397 (setq time (let ((this-command this-command))
11398 (org-read-date arg 'totime nil nil default-time default-input)))
11399 (org-insert-time-stamp time (or org-time-was-given arg) inactive
11400 nil nil (list org-end-time-was-given))))))
11402 ;; FIXME: can we use this for something else, like computing time differences?
11403 (defun org-get-compact-tod (s)
11404 (when (string-match "\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\(-\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\)?" s)
11405 (let* ((t1 (match-string 1 s))
11406 (h1 (string-to-number (match-string 2 s)))
11407 (m1 (string-to-number (match-string 3 s)))
11408 (t2 (and (match-end 4) (match-string 5 s)))
11409 (h2 (and t2 (string-to-number (match-string 6 s))))
11410 (m2 (and t2 (string-to-number (match-string 7 s))))
11411 dh dm)
11412 (if (not t2)
11413 t1
11414 (setq dh (- h2 h1) dm (- m2 m1))
11415 (if (< dm 0) (setq dm (+ dm 60) dh (1- dh)))
11416 (concat t1 "+" (number-to-string dh)
11417 (if (/= 0 dm) (concat ":" (number-to-string dm))))))))
11419 (defun org-time-stamp-inactive (&optional arg)
11420 "Insert an inactive time stamp.
11421 An inactive time stamp is enclosed in square brackets instead of angle
11422 brackets. It is inactive in the sense that it does not trigger agenda entries,
11423 does not link to the calendar and cannot be changed with the S-cursor keys.
11424 So these are more for recording a certain time/date."
11425 (interactive "P")
11426 (org-time-stamp arg 'inactive))
11428 (defvar org-date-ovl (org-make-overlay 1 1))
11429 (org-overlay-put org-date-ovl 'face 'org-warning)
11430 (org-detach-overlay org-date-ovl)
11432 (defvar org-ans1) ; dynamically scoped parameter
11433 (defvar org-ans2) ; dynamically scoped parameter
11435 (defvar org-plain-time-of-day-regexp) ; defined below
11437 (defvar org-overriding-default-time nil) ; dynamically scoped
11438 (defvar org-read-date-overlay nil)
11439 (defvar org-dcst nil) ; dynamically scoped
11441 (defun org-read-date (&optional with-time to-time from-string prompt
11442 default-time default-input)
11443 "Read a date, possibly a time, and make things smooth for the user.
11444 The prompt will suggest to enter an ISO date, but you can also enter anything
11445 which will at least partially be understood by `parse-time-string'.
11446 Unrecognized parts of the date will default to the current day, month, year,
11447 hour and minute. If this command is called to replace a timestamp at point,
11448 of to enter the second timestamp of a range, the default time is taken from the
11449 existing stamp. For example,
11450 3-2-5 --> 2003-02-05
11451 feb 15 --> currentyear-02-15
11452 sep 12 9 --> 2009-09-12
11453 12:45 --> today 12:45
11454 22 sept 0:34 --> currentyear-09-22 0:34
11455 12 --> currentyear-currentmonth-12
11456 Fri --> nearest Friday (today or later)
11457 etc.
11459 Furthermore you can specify a relative date by giving, as the *first* thing
11460 in the input: a plus/minus sign, a number and a letter [dwmy] to indicate
11461 change in days weeks, months, years.
11462 With a single plus or minus, the date is relative to today. With a double
11463 plus or minus, it is relative to the date in DEFAULT-TIME. E.g.
11464 +4d --> four days from today
11465 +4 --> same as above
11466 +2w --> two weeks from today
11467 ++5 --> five days from default date
11469 The function understands only English month and weekday abbreviations,
11470 but this can be configured with the variables `parse-time-months' and
11471 `parse-time-weekdays'.
11473 While prompting, a calendar is popped up - you can also select the
11474 date with the mouse (button 1). The calendar shows a period of three
11475 months. To scroll it to other months, use the keys `>' and `<'.
11476 If you don't like the calendar, turn it off with
11477 \(setq org-read-date-popup-calendar nil)
11479 With optional argument TO-TIME, the date will immediately be converted
11480 to an internal time.
11481 With an optional argument WITH-TIME, the prompt will suggest to also
11482 insert a time. Note that when WITH-TIME is not set, you can still
11483 enter a time, and this function will inform the calling routine about
11484 this change. The calling routine may then choose to change the format
11485 used to insert the time stamp into the buffer to include the time.
11486 With optional argument FROM-STRING, read from this string instead from
11487 the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is
11488 the time/date that is used for everything that is not specified by the
11489 user."
11490 (require 'parse-time)
11491 (let* ((org-time-stamp-rounding-minutes
11492 (if (equal with-time '(16)) '(0 0) org-time-stamp-rounding-minutes))
11493 (org-dcst org-display-custom-times)
11494 (ct (org-current-time))
11495 (def (or org-overriding-default-time default-time ct))
11496 (defdecode (decode-time def))
11497 (dummy (progn
11498 (when (< (nth 2 defdecode) org-extend-today-until)
11499 (setcar (nthcdr 2 defdecode) -1)
11500 (setcar (nthcdr 1 defdecode) 59)
11501 (setq def (apply 'encode-time defdecode)
11502 defdecode (decode-time def)))))
11503 (calendar-move-hook nil)
11504 (calendar-view-diary-initially-flag nil)
11505 (view-diary-entries-initially nil)
11506 (calendar-view-holidays-initially-flag nil)
11507 (view-calendar-holidays-initially nil)
11508 (timestr (format-time-string
11509 (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") def))
11510 (prompt (concat (if prompt (concat prompt " ") "")
11511 (format "Date+time [%s]: " timestr)))
11512 ans (org-ans0 "") org-ans1 org-ans2 final)
11514 (cond
11515 (from-string (setq ans from-string))
11516 (org-read-date-popup-calendar
11517 (save-excursion
11518 (save-window-excursion
11519 (calendar)
11520 (calendar-forward-day (- (time-to-days def)
11521 (calendar-absolute-from-gregorian
11522 (calendar-current-date))))
11523 (org-eval-in-calendar nil t)
11524 (let* ((old-map (current-local-map))
11525 (map (copy-keymap calendar-mode-map))
11526 (minibuffer-local-map (copy-keymap minibuffer-local-map)))
11527 (org-defkey map (kbd "RET") 'org-calendar-select)
11528 (org-defkey map (if (featurep 'xemacs) [button1] [mouse-1])
11529 'org-calendar-select-mouse)
11567 ;; org-ans0: from prompt
11568 ;; org-ans1: from mouse click
11569 ;; org-ans2: from calendar motion
11597 "Display the current date prompt interpretation in the minibuffer."
11613 org-time-stamp-custom-formats
11614 org-time-stamp-formats))
11623 org-end-time-was-given
11630 "Analyse the combined answer of the date prompt."
11631 ;; FIXME: cleanup and comment
11633 hour minute second wday pm h2 m2 tl wday1
11634 iso-year iso-weekday iso-week iso-year iso-date)
11645 ;; Check if there is an iso week date in there
11646 ;; If yes, sore the info and postpone interpreting it until the rest
11647 ;; of the parsing is done
11648 (when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans)
11649 (setq iso-year (if (match-end 1) (org-small-year-to-year (string-to-number (match-string 1 ans))))
11654 ;; Help matching ISO dates with single digit month ot day, like 2006-8-11.
11664 t nil ans)))
11665 ;; Help matching am/pm times, because `parse-time-string' does not do that.
11666 ;; If there is a time with am/pm, and *no* time without it, we convert
11667 ;; so that matching will be successful.
11681 t t ans))))
11683 ;; Check if a time range is given as a duration
11684 (when (string-match "\\([012]?[0-9]\\):\\([0-6][0-9]\\)\\+\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?" ans)
11692 t t ans)))
11694 ;; Check if there is a time range
11720 ;; Special date definitions below
11723 ;; There was an iso week
11726 wday nil ; to make sure that the trigger below does not match
11730 ; FIXME: Should we also push ISO weeks into the future?
11731 ; (when (and org-read-date-prefer-future
11732 ; (not iso-year)
11733 ; (< (calendar-absolute-from-gregorian iso-date)
11734 ; (time-to-days (current-time))))
11735 ; (setq year (1+ year)
11736 ; iso-date (calendar-gregorian-from-absolute
11737 ; (calendar-absolute-from-iso
11738 ; (list iso-week day year)))))
11751 ;; Weekday was given, but no day, so pick that day in the week
11752 ;; on or after the derived date.
11766 "Check string S for special relative date string.
11767 TODAY and DEFAULT are internal times, for today and for a default.
11768 Return shift list (N what def-flag)
11770 N is the number of WHATs to shift.
11771 DEF-FLAG is t when a double ++ or -- indicates shift relative to
11772 the DEFAULT date rather than TODAY."
11783 ?+))
11790 delta)
11800 "Eval FORM in the calendar window and return to current window.
11801 Also, store the cursor date in variable org-ans2."
11813 "Return to `org-read-date' with the date currently selected.
11814 This is used by `org-read-date' in a temporary keymap for the calendar buffer."
11823 "Insert a date stamp for the date given by the internal TIME.
11824 WITH-HM means, use the stamp format that includes the time of the day.
11825 INACTIVE means use square brackets instead of angular ones, so that the
11826 stamp will not contribute to the agenda.
11827 PRE and POST are optional strings to be inserted before and after the
11828 stamp.
11829 The command returns the inserted time stamp."
11831 stamp)
11851 "Toggle the use of custom time stamp formats."
11872 "Overlay modified time stamp format over timestamp between BEG and END."
11899 "Translate all timestamps in STRING to custom format.
11900 But do this only if the variable `org-display-custom-times' is set."
11905 t1 with-hm inactive tf time str beg end)
11914 org-time-stamp-custom-formats)
11923 string)
11926 "Set 0 instead of nil for the first 6 elements of time.
11927 Don't touch the rest."
11932 "Difference between TIMESTAMP-STRING and now in days."
11937 "Is the time in TIMESTAMP-STRING close to the current date?"
11943 "Get the deadline lead time appropriate for timestring TS."
11946 ;; 0 or negative, enforce this value no matter what
11949 ;; lead time is specified.
11954 ;; go for the default.
11958 "Return to `org-read-date' with the date currently selected.
11959 This is used by `org-read-date' in a temporary keymap for the calendar buffer."
11969 "Check if there are any deadlines due or past due.
11970 A deadline is considered due if it happens within `org-deadline-warning-days'
11971 days from today's date. If the deadline appears in an entry marked DONE,
11972 it is not shown. The prefix arg NDAYS can be used to test that many
11987 org-warn-days)))
11990 "Check if there are deadlines or scheduled entries before DATE."
12004 "Evaluate a time range by computing the difference between start and end.
12005 Normally the result is just printed in the echo area, but with prefix arg
12006 TO-BUFFER, the result is inserted just after the date stamp into the buffer.
12007 If the time range is actually in a table, the result is inserted into the
12008 next column.
12009 For time difference computation, a year is assumed to be exactly 365
12010 days in order to avoid rounding problems."
12030 ;; (ys (floor (* 365 24 60 60)))
12038 y d h m align)
12041 y 0
12046 y 0
12084 "Convert a time stamp to an absolute day number.
12085 If there is a specifyer for a cyclic time stamp, get the closest date to
12086 DAYNR.
12087 PREFER and SHOW-ALL are passed through to `org-closest-date'."
12091 daynr
12096 prefer show-all))
12100 "Return the iso week number."
12105 "Convert 2-digit years into 4-digit years.
12106 38-99 are mapped into 1938-1999. 1-37 are mapped into 2001-2007.
12107 The year 2000 cannot be abbreviated. Any year larger than 99
12108 is returned unchanged."
12113 year)
12116 "Return the time corresponding to date D.
12117 D may be an absolute day number, or a calendar-type list (month day year)."
12122 "List of holidays, for Diary display in Org-mode."
12130 "Process a SEXP diary ENTRY for DATE."
12150 "Get iCalendar entries from diary entries in buffer FROMBUF.
12151 This uses the icalendar.el library."
12154 temporary-file-directory))
12157 buf rtn b e)
12172 rtn))
12175 "Find the date closest to CURRENT that is consistent with START and CHANGE.
12176 When PREFER is `past' return a date that is either CURRENT or past.
12177 When PREFER is `future', return a date that is either CURRENT or future.
12178 When SHOW-ALL is nil, only return the current occurrence of a time stamp."
12179 ;; Make the proper lists from the dates
12182 dn dw sday cday n1 n2 n0
12183 d m y y1 y2 date1 date2 nmonths nm ny m2)
12188 current
12212 ;; approx number of month between the two dates
12214 ;; How often does dn fit in there?
12231 ;; Make sure n1 is the earlier date
12244 "Turn any specification of DATE into a gregorian date for the calendar."
12254 "Parse the standard Org-mode time string.
12255 This should be a lot faster than the normal `parse-time-string'.
12256 If time is not given, defaults to 0:00. However, with optional NODEFAULT,
12257 hour and minute fields will be nil if not given."
12267 nil nil nil)
12271 "Increase the date item at the cursor by one.
12272 If the cursor is on the year, change the year. If it is on the month or
12273 the day, change that.
12274 With prefix ARG, change by that many units."
12279 "Decrease the date item at the cursor by one.
12280 If the cursor is on the year, change the year. If it is on the month or
12281 the day, change that.
12282 With prefix ARG, change by that many units."
12287 "Increase the date in the time stamp by one day.
12288 With prefix ARG, change that many days."
12296 "Decrease the date in the time stamp by one day.
12297 With prefix ARG, change that many days."
12305 "Determine if the cursor is in or at a timestamp."
12331 ans))
12334 "Toggle the type (<active> or [inactive]) of a time stamp."
12343 t t)))
12348 "Change the date in the time stamp at point.
12349 The date will be changed by N times WHAT. WHAT can be `day', `month',
12350 `year', `minute', `second'. If WHAT is not given, the cursor position
12351 in the timestamp determines what will be changed."
12353 with-hm inactive
12355 org-ts-what
12356 extra rem
12357 ts time time0)
12363 org-display-custom-times
12373 ts)
12407 ;; Try to recenter the calendar window, if any
12414 "Change the different parts of the lead-time and repeat fields in timestamp."
12416 ng h m new rem)
12417 (when (string-match "\\(-\\([012][0-9]\\):\\([0-5][0-9]\\)\\)?\\( +\\+\\([0-9]+\\)\\([dmwy]\\)\\)?\\( +-\\([0-9]+\\)\\([dmwy]\\)\\)?" s)
12446 new
12448 s))
12451 "If the calendar is visible, recenter it to DATE."
12462 "Go to the Emacs calendar at the current date.
12463 If there is a time stamp in the current line, go to that date.
12464 A prefix ARG can be used to force the current date."
12485 "Return a list (month day year) of date at point in calendar."
12491 "Insert time stamp corresponding to cursor date in *Calendar* buffer.
12492 If there is already a time stamp at the cursor position, update it."
12501 "Compute H:MM from a number of minutes."
12507 "Convert a string H:MM to a number of minutes."
12513 ;;;; Files
12516 "Save all Org-mode buffers without user confirmation."
12524 "Revert all Org-mode buffers.
12525 Prompt for confirmation when there are unsaved changes.
12526 Be sure you know what you are doing before letting this function
12527 overwrite your changes.
12529 This function is useful in a setup where one tracks org files
12530 with a version control system, to revert on one machine after pulling
12531 changes from another. I believe the procedure must be like this:
12533 1. M-x org-save-all-org-buffers
12534 2. Pull changes from the other machine, resolve conflicts
12535 3. M-x org-revert-all-org-buffers"
12551 ;;;; Agenda files
12553 ;;;###autoload
12555 "Use `iswitchb-read-buffer' to prompt for an Org buffer to switch to.
12556 With a prefix argument, restrict available to files.
12557 With two prefix arguments, restrict available buffers to agenda files.
12559 Due to some yet unresolved reason, the global function
12560 `iswitchb-mode' needs to be active for this function to work."
12578 ;;;###autoload
12580 "Use `org-ido-completing-read' to prompt for an Org buffer to switch to.
12581 With a prefix argument, restrict available to files.
12582 With two prefix arguments, restrict available buffers to agenda files."
12590 nil t))))
12593 "Return a list of Org buffers.
12594 PREDICATE can be `export', `files' or `agenda'.
12596 export restrict the list to Export buffers.
12597 files restrict the list to buffers visiting Org files.
12598 agenda restrict the list to buffers visiting agenda files.
12600 If EXCLUDE-TMP is non-nil, ignore temporary buffers."
12626 b
12627 nil))
12631 "Get the list of agenda files.
12632 Optional UNRESTRICTED means return the full list even if a restriction
12633 is currently in place.
12634 When ARCHIVES is t, include all archive files hat are really being
12635 used by the agenda files. If ARCHIVE is `ifmode', do this only if
12636 `org-agenda-archives-mode' is t."
12647 f t org-agenda-file-regexp)
12649 files)))
12655 files))))
12659 files))
12662 "Edit the list of agenda files.
12663 Depending on setup, this either uses customize to edit the variable
12664 `org-agenda-files', or it visits the file that is holding the list. In the
12665 latter case, the buffer is set up in a way that saving it automatically kills
12666 the buffer and restores the previous window configuration."
12685 "Set new value for the agenda file list and save it correctly."
12696 "Read the list of agenda files from a file."
12705 ;;;###autoload
12707 "Cycle through the files in `org-agenda-files'.
12708 If the current buffer visits an agenda file, find the next one in the list.
12709 If the current buffer does not, find the first agenda file."
12714 file)
12726 "Move/add the current file to the top of the agenda file list.
12727 If the file is not present in the list, it is added to the front. If it is
12728 present, it is moved there. With optional argument TO-END, add/move to the
12729 end of the list."
12736 x had)
12749 "Remove current file from the list of files in variable `org-agenda-files'.
12750 These are the files which are being checked for agenda entries.
12751 Optional argument FILE means, use this file instead of the current."
12761 nil x))
12774 "Make sure FILE exists. If not, ask user what to do."
12786 "Get a buffer visiting FILE. If the buffer needs to be created, add
12787 it to the list of buffers which might be released later."
12790 buf ; just return it
12791 ;; Make a new buffer and remember it
12794 buf)))
12797 "Release all buffers in list, asking the user for confirmation when needed.
12798 When a buffer is unmodified, it is just killed. When modified, it is saved
12799 \(if the user agrees) and then killed."
12804 file
12810 "Create buffers for all agenda files, protect archived trees and comments."
12817 bmp file re)
12854 ;;;; Embedded LaTeX
12869 "Toggle the minor `org-cdlatex-mode'.
12870 This mode supports entering LaTeX environment and math in LaTeX fragments
12871 in Org-mode.
12873 nil " OCDL" nil
12878 "Always return t in org-mode buffers.
12879 This is because we want to insert math symbols without dollars even outside
12880 the LaTeX math segments. If Orgmode thinks that point is actually inside
12881 an embedded LaTeX fragment, let texmathp do its job.
12898 "Unconditionally turn on `org-cdlatex-mode'."
12902 "Test if point is inside a LaTeX fragment.
12904 sequence appearing also before point.
12905 Even though the matchers for math are configurable, this function assumes
12907 delimiters are skipped when they have been removed by customization.
12908 The return value is nil, or a cons cell with the delimiter and
12909 and the position of this delimiter.
12911 This function does a reasonably good job, but can locally be fooled by
12912 for example currency specifications. For example it will assume being in
12914 fragments that are properly closed, but during editing, we have to live
12915 with the uncertainty caused by missing closing delimiters. This function
12916 looks only before point, not after."
12935 (when (setq m (re-search-backward "\\(\\\\begin{[^}]*}\\|\\\\(\\|\\\\\\[\\)\\|\\(\\\\end{[^}]*}\\|\\\\)\\|\\\\\\]\\)\\|\\(\\$\\$\\)" lim t))
12939 ;; count $$
12947 "Check if it makes sense to execute `cdlatex-tab', and do it if yes.
12948 It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is
12949 - inside a LaTeX fragment, or
12950 - after the first word in a line, where an abbreviation expansion could
12951 insert a LaTeX environment."
12964 "Execute `cdlatex-sub-superscript' in LaTeX fragments.
12965 Revert to the normal definition outside of these fragments."
12973 "Execute `cdlatex-math-modify' in LaTeX fragments.
12974 Revert to the normal definition outside of these fragments."
12986 "Remove all overlays with LaTeX fragment images in current buffer."
12991 "Preview the LaTeX fragment at point, or all locally or globally.
12992 If the cursor is in a LaTeX fragment, create the image and overlay
12993 it over the source code. If there is no fragment at point, display
12994 all fragments in the current text, from one headline to the next. With
12995 prefix SUBTREE, display all fragments in the current subtree. With a
12996 double prefix `C-u C-u', or when the cursor is before the first headline,
12997 display all fragments in the buffer.
13027 buffer-file-name)))
13033 ;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil)
13034 ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p
13036 ("$" "\\([^$]\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil)
13043 "Replace LaTeX fragments with links to an image, and produce images."
13052 m n block linkfile movefile ov)
13053 ;; Check if there are old images files with this prefix, and remove them
13057 todir 'full
13059 ;; Check the different regular expressions
13081 txt movefile opt forbuffer)
13089 ov 'end-glyph
13092 ov 'display
13099 ;; This function borrows from Ganesh Swami's latex2png.el
13103 temporary-file-directory))
13135 "-D" dpi
13136 ;;"-x" scale "-y" scale
13138 "-o" pngfile
13139 dvifile)
13143 ;; Use the requested file name and clean up
13147 pngfile))))
13150 "Return an rgb color specification for dvipng."
13156 "Return string to be used as color value for an RGB component."
13159 ;;;; Key bindings
13161 ;; Make `C-c C-x' a prefix key
13164 ;; TAB key with modifiers
13171 ;; The following line is necessary under Suse GNU/Linux
13177 (org-defkey org-mode-map [(shift return)] 'org-table-copy-down)
13178 (org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading)
13179 (org-defkey org-mode-map [(meta return)] 'org-meta-return)
13181 ;; Cursor keys with modifiers
13182 (org-defkey org-mode-map [(meta left)] 'org-metaleft)
13183 (org-defkey org-mode-map [(meta right)] 'org-metaright)
13184 (org-defkey org-mode-map [(meta up)] 'org-metaup)
13185 (org-defkey org-mode-map [(meta down)] 'org-metadown)
13187 (org-defkey org-mode-map [(meta shift left)] 'org-shiftmetaleft)
13188 (org-defkey org-mode-map [(meta shift right)] 'org-shiftmetaright)
13189 (org-defkey org-mode-map [(meta shift up)] 'org-shiftmetaup)
13190 (org-defkey org-mode-map [(meta shift down)] 'org-shiftmetadown)
13192 (org-defkey org-mode-map [(shift up)] 'org-shiftup)
13193 (org-defkey org-mode-map [(shift down)] 'org-shiftdown)
13194 (org-defkey org-mode-map [(shift left)] 'org-shiftleft)
13195 (org-defkey org-mode-map [(shift right)] 'org-shiftright)
13197 (org-defkey org-mode-map [(control shift right)] 'org-shiftcontrolright)
13198 (org-defkey org-mode-map [(control shift left)] 'org-shiftcontrolleft)
13200 ;;; Extra keys for tty access.
13201 ;; We only set them when really needed because otherwise the
13202 ;; menus don't show the simple keys
13204 (when (or org-use-extra-keys
13205 (featurep 'xemacs) ;; because XEmacs supports multi-device stuff
13206 (not window-system))
13207 (org-defkey org-mode-map "\C-c\C-xc" 'org-table-copy-down)
13208 (org-defkey org-mode-map "\C-c\C-xM" 'org-insert-todo-heading)
13209 (org-defkey org-mode-map "\C-c\C-xm" 'org-meta-return)
13210 (org-defkey org-mode-map [?\e (return)] 'org-meta-return)
13211 (org-defkey org-mode-map [?\e (left)] 'org-metaleft)
13212 (org-defkey org-mode-map "\C-c\C-xl" 'org-metaleft)
13213 (org-defkey org-mode-map [?\e (right)] 'org-metaright)
13214 (org-defkey org-mode-map "\C-c\C-xr" 'org-metaright)
13215 (org-defkey org-mode-map [?\e (up)] 'org-metaup)
13216 (org-defkey org-mode-map "\C-c\C-xu" 'org-metaup)
13217 (org-defkey org-mode-map [?\e (down)] 'org-metadown)
13218 (org-defkey org-mode-map "\C-c\C-xd" 'org-metadown)
13219 (org-defkey org-mode-map "\C-c\C-xL" 'org-shiftmetaleft)
13220 (org-defkey org-mode-map "\C-c\C-xR" 'org-shiftmetaright)
13221 (org-defkey org-mode-map "\C-c\C-xU" 'org-shiftmetaup)
13222 (org-defkey org-mode-map "\C-c\C-xD" 'org-shiftmetadown)
13223 (org-defkey org-mode-map [?\C-c (up)] 'org-shiftup)
13224 (org-defkey org-mode-map [?\C-c (down)] 'org-shiftdown)
13225 (org-defkey org-mode-map [?\C-c (left)] 'org-shiftleft)
13226 (org-defkey org-mode-map [?\C-c (right)] 'org-shiftright)
13227 (org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright)
13228 (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft))
13230 ;; All the other keys
13232 (org-defkey org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up.
13233 (org-defkey org-mode-map "\C-c\C-r" 'org-reveal)
13234 (if (boundp 'narrow-map)
13235 (org-defkey narrow-map "s" 'org-narrow-to-subtree)
13236 (org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree))
13237 (org-defkey org-mode-map "\C-c$" 'org-archive-subtree)
13238 (org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree)
13239 (org-defkey org-mode-map "\C-c\C-x\C-a" 'org-toggle-archive-tag)
13240 (org-defkey org-mode-map "\C-c\C-xa" 'org-toggle-archive-tag)
13241 (org-defkey org-mode-map "\C-c\C-xA" 'org-archive-to-archive-sibling)
13242 (org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer)
13243 (org-defkey org-mode-map "\C-c\C-j" 'org-goto)
13244 (org-defkey org-mode-map "\C-c\C-t" 'org-todo)
13245 (org-defkey org-mode-map "\C-c\C-q" 'org-set-tags-command)
13246 (org-defkey org-mode-map "\C-c\C-s" 'org-schedule)
13247 (org-defkey org-mode-map "\C-c\C-d" 'org-deadline)
13248 (org-defkey org-mode-map "\C-c;" 'org-toggle-comment)
13249 (org-defkey org-mode-map "\C-c\C-v" 'org-show-todo-tree)
13250 (org-defkey org-mode-map "\C-c\C-w" 'org-refile)
13251 (org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved
13253 (org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret)
13254 (org-defkey org-mode-map "\M-\C-m" 'org-insert-heading)
13255 (org-defkey org-mode-map [(control return)] 'org-insert-heading-respect-content)
13256 (org-defkey org-mode-map [(shift control return)] 'org-insert-todo-heading-respect-content)
13257 (org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link)
13258 (org-defkey org-mode-map "\C-c\C-x\C-p" 'org-previous-link)
13259 (org-defkey org-mode-map "\C-c\C-l" 'org-insert-link)
13260 (org-defkey org-mode-map "\C-c\C-o" 'org-open-at-point)
13261 (org-defkey org-mode-map "\C-c%" 'org-mark-ring-push)
13262 (org-defkey org-mode-map "\C-c&" 'org-mark-ring-goto)
13263 (org-defkey org-mode-map "\C-c\C-z" 'org-add-note) ; Alternative binding
13264 (org-defkey org-mode-map "\C-c." 'org-time-stamp) ; Minor-mode reserved
13265 (org-defkey org-mode-map "\C-c!" 'org-time-stamp-inactive) ; Minor-mode r.
13266 (org-defkey org-mode-map "\C-c," 'org-priority) ; Minor-mode reserved
13267 (org-defkey org-mode-map "\C-c\C-y" 'org-evaluate-time-range)
13268 (org-defkey org-mode-map "\C-c>" 'org-goto-calendar)
13269 (org-defkey org-mode-map "\C-c<" 'org-date-from-calendar)
13270 (org-defkey org-mode-map [(control ?,)] 'org-cycle-agenda-files)
13272 (org-defkey org-mode-map "\C-c[" 'org-agenda-file-to-front)
13273 (org-defkey org-mode-map "\C-c]" 'org-remove-file)
13274 (org-defkey org-mode-map "\C-c\C-x<" 'org-agenda-set-restriction-lock)
13275 (org-defkey org-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
13276 (org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus)
13277 (org-defkey org-mode-map "\C-c*" 'org-ctrl-c-star)
13278 (org-defkey org-mode-map "\C-c^" 'org-sort)
13279 (org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c)
13280 (org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches)
13281 (org-defkey org-mode-map "\C-c#" 'org-update-checkbox-count)
13282 (org-defkey org-mode-map "\C-m" 'org-return)
13283 (org-defkey org-mode-map "\C-j" 'org-return-indent)
13284 (org-defkey org-mode-map "\C-c?" 'org-table-field-info)
13285 (org-defkey org-mode-map "\C-c " 'org-table-blank-field)
13286 (org-defkey org-mode-map "\C-c+" 'org-table-sum)
13287 (org-defkey org-mode-map "\C-c=" 'org-table-eval-formula)
13288 (org-defkey org-mode-map "\C-c'" 'org-edit-special)
13289 (org-defkey org-mode-map "\C-c`" 'org-table-edit-field)
13290 (org-defkey org-mode-map "\C-c|" 'org-table-create-or-convert-from-region)
13291 (org-defkey org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks)
13292 (org-defkey org-mode-map "\C-c~" 'org-table-create-with-table.el)
13293 (org-defkey org-mode-map "\C-c\C-a" 'org-attach)
13294 (org-defkey org-mode-map "\C-c}" 'org-table-toggle-coordinate-overlays)
13295 (org-defkey org-mode-map "\C-c{" 'org-table-toggle-formula-debugger)
13296 (org-defkey org-mode-map "\C-c\C-e" 'org-export)
13297 (org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section)
13298 (org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize)
13299 (org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action)
13301 (org-defkey org-mode-map "\C-c\C-x\C-k" 'org-mark-entry-for-agenda-action)
13302 (org-defkey org-mode-map "\C-c\C-x\C-w" 'org-cut-special)
13303 (org-defkey org-mode-map "\C-c\C-x\M-w" 'org-copy-special)
13304 (org-defkey org-mode-map "\C-c\C-x\C-y" 'org-paste-special)
13306 (org-defkey org-mode-map "\C-c\C-x\C-t" 'org-toggle-time-stamp-overlays)
13307 (org-defkey org-mode-map "\C-c\C-x\C-i" 'org-clock-in)
13308 (org-defkey org-mode-map "\C-c\C-x\C-o" 'org-clock-out)
13309 (org-defkey org-mode-map "\C-c\C-x\C-j" 'org-clock-goto)
13310 (org-defkey org-mode-map "\C-c\C-x\C-x" 'org-clock-cancel)
13311 (org-defkey org-mode-map "\C-c\C-x\C-d" 'org-clock-display)
13312 (org-defkey org-mode-map "\C-c\C-x\C-r" 'org-clock-report)
13313 (org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update)
13314 (org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment)
13315 (org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox)
13316 (org-defkey org-mode-map "\C-c\C-xp" 'org-set-property)
13317 (org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property)
13318 (org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock)
13320 (org-defkey org-mode-map "\C-c\C-x." 'org-timer)
13321 (org-defkey org-mode-map "\C-c\C-x-" 'org-timer-item)
13322 (org-defkey org-mode-map "\C-c\C-x0" 'org-timer-start)
13323 (org-defkey org-mode-map "\C-c\C-x," 'org-timer-pause-or-continue)
13325 (define-key org-mode-map "\C-c\C-x\C-c" 'org-columns)
13327 (define-key org-mode-map "\C-c\C-xr" 'org-reload)
13329 (when (featurep 'xemacs)
13330 (org-defkey org-mode-map 'button3 'popup-mode-menu))
13333 (defvar org-self-insert-command-undo-counter 0)
13335 (defvar org-table-auto-blank-field) ; defined in org-table.el
13336 (defun org-self-insert-command (N)
13337 "Like `self-insert-command', use overwrite-mode for whitespace in tables.
13338 If the cursor is in a table looking at whitespace, the whitespace is
13339 overwritten, and the table is not marked as requiring realignment."
13340 (interactive "p")
13341 (if (and
13342 (org-table-p)
13343 (progn
13344 ;; check if we blank the field, and if that triggers align
13345 (and (featurep 'org-table) org-table-auto-blank-field
13346 (member last-command
13347 '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c))
13349 ;; got extra space, this field does not determine column width
13350 (let (org-table-may-need-update) (org-table-blank-field))
13351 ;; no extra space, this field may determine column width
13352 (org-table-blank-field)))
13353 t)
13354 (eq N 1)
13356 (let (org-table-may-need-update)
13357 (goto-char (1- (match-end 0)))
13358 (delete-backward-char 1)
13359 (goto-char (match-beginning 0))
13360 (self-insert-command N))
13361 (setq org-table-may-need-update t)
13362 (self-insert-command N)
13363 (org-fix-tags-on-the-fly)
13364 (if org-self-insert-cluster-for-undo
13365 (if (not (eq last-command 'org-self-insert-command))
13366 (setq org-self-insert-command-undo-counter 1)
13367 (if (>= org-self-insert-command-undo-counter 20)
13368 (setq org-self-insert-command-undo-counter 1)
13369 (and (> org-self-insert-command-undo-counter 0)
13370 buffer-undo-list
13371 (not (cadr buffer-undo-list)) ; remove nil entry
13372 (setcdr buffer-undo-list (cddr buffer-undo-list)))
13373 (setq org-self-insert-command-undo-counter
13374 (1+ org-self-insert-command-undo-counter)))))))
13376 (defun org-fix-tags-on-the-fly ()
13377 (when (and (equal (char-after (point-at-bol)) ?*)
13378 (org-on-heading-p))
13379 (org-align-tags-here org-tags-column)))
13381 (defun org-delete-backward-char (N)
13382 "Like `delete-backward-char', insert whitespace at field end in tables.
13383 When deleting backwards, in tables this function will insert whitespace in
13385 still be marked for re-alignment if the field did fill the entire column,
13386 because, in this case the deletion might narrow the column."
13387 (interactive "p")
13388 (if (and (org-table-p)
13389 (eq N 1)
13390 (string-match "|" (buffer-substring (point-at-bol) (point)))
13391 (looking-at ".*?|"))
13392 (let ((pos (point))
13394 (c org-table-may-need-update))
13395 (backward-delete-char N)
13396 (skip-chars-forward "^|")
13397 (insert " ")
13398 (goto-char (1- pos))
13399 ;; noalign: if there were two spaces at the end, this field
13400 ;; does not determine the width of the column.
13401 (if noalign (setq org-table-may-need-update c)))
13402 (backward-delete-char N)
13403 (org-fix-tags-on-the-fly)))
13405 (defun org-delete-char (N)
13406 "Like `delete-char', but insert whitespace at field end in tables.
13407 When deleting characters, in tables this function will insert whitespace in
13409 still be marked for re-alignment if the field did fill the entire column,
13410 because, in this case the deletion might narrow the column."
13411 (interactive "p")
13412 (if (and (org-table-p)
13413 (not (bolp))
13414 (not (= (char-after) ?|))
13415 (eq N 1))
13416 (if (looking-at ".*?|")
13417 (let ((pos (point))
13419 (c org-table-may-need-update))
13420 (replace-match (concat
13421 (substring (match-string 0) 1 -1)
13422 " |"))
13423 (goto-char pos)
13424 ;; noalign: if there were two spaces at the end, this field
13425 ;; does not determine the width of the column.
13426 (if noalign (setq org-table-may-need-update c)))
13427 (delete-char N))
13428 (delete-char N)
13429 (org-fix-tags-on-the-fly)))
13431 ;; Make `delete-selection-mode' work with org-mode and orgtbl-mode
13432 (put 'org-self-insert-command 'delete-selection t)
13433 (put 'orgtbl-self-insert-command 'delete-selection t)
13434 (put 'org-delete-char 'delete-selection 'supersede)
13435 (put 'org-delete-backward-char 'delete-selection 'supersede)
13436 (put 'org-yank 'delete-selection 'yank)
13438 ;; Make `flyspell-mode' delay after some commands
13439 (put 'org-self-insert-command 'flyspell-delayed t)
13440 (put 'orgtbl-self-insert-command 'flyspell-delayed t)
13441 (put 'org-delete-char 'flyspell-delayed t)
13442 (put 'org-delete-backward-char 'flyspell-delayed t)
13444 ;; Make pabbrev-mode expand after org-mode commands
13445 (put 'org-self-insert-command 'pabbrev-expand-after-command t)
13446 (put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t)
13448 ;; How to do this: Measure non-white length of current string
13449 ;; If equal to column width, we should realign.
13451 (defun org-remap (map &rest commands)
13452 "In MAP, remap the functions given in COMMANDS.
13453 COMMANDS is a list of alternating OLDDEF NEWDEF command names."
13454 (let (new old)
13455 (while commands
13456 (setq old (pop commands) new (pop commands))
13457 (if (fboundp 'command-remapping)
13458 (org-defkey map (vector 'remap old) new)
13459 (substitute-key-definition old new map global-map)))))
13461 (when (eq org-enable-table-editor 'optimized)
13462 ;; If the user wants maximum table support, we need to hijack
13463 ;; some standard editing functions
13464 (org-remap org-mode-map
13465 'self-insert-command 'org-self-insert-command
13466 'delete-char 'org-delete-char
13467 'delete-backward-char 'org-delete-backward-char)
13468 (org-defkey org-mode-map "|" 'org-force-self-insert))
13470 (defvar org-ctrl-c-ctrl-c-hook nil
13471 "Hook for functions attaching themselves to `C-c C-c'.
13472 This can be used to add additional functionality to the C-c C-c key which
13473 executes context-dependent commands.
13474 Each function will be called with no arguments. The function must check
13475 if the context is appropriate for it to act. If yes, it should do its
13476 thing and then return a non-nil value. If the context is wrong,
13477 just do nothing.")
13479 (defvar org-metaleft-hook nil
13480 "Hook for functions attaching themselves to `M-left'.
13481 See `org-ctrl-c-ctrl-c-hook' for more information.")
13482 (defvar org-metaright-hook nil
13483 "Hook for functions attaching themselves to `M-right'.
13484 See `org-ctrl-c-ctrl-c-hook' for more information.")
13485 (defvar org-metaup-hook nil
13486 "Hook for functions attaching themselves to `M-up'.
13487 See `org-ctrl-c-ctrl-c-hook' for more information.")
13488 (defvar org-metadown-hook nil
13489 "Hook for functions attaching themselves to `M-down'.
13490 See `org-ctrl-c-ctrl-c-hook' for more information.")
13491 (defvar org-shiftmetaleft-hook nil
13492 "Hook for functions attaching themselves to `M-S-left'.
13493 See `org-ctrl-c-ctrl-c-hook' for more information.")
13494 (defvar org-shiftmetaright-hook nil
13495 "Hook for functions attaching themselves to `M-S-right'.
13496 See `org-ctrl-c-ctrl-c-hook' for more information.")
13497 (defvar org-shiftmetaup-hook nil
13498 "Hook for functions attaching themselves to `M-S-up'.
13499 See `org-ctrl-c-ctrl-c-hook' for more information.")
13500 (defvar org-shiftmetadown-hook nil
13501 "Hook for functions attaching themselves to `M-S-down'.
13502 See `org-ctrl-c-ctrl-c-hook' for more information.")
13503 (defvar org-metareturn-hook nil
13504 "Hook for functions attaching themselves to `M-RET'.
13505 See `org-ctrl-c-ctrl-c-hook' for more information.")
13507 (defun org-modifier-cursor-error ()
13508 "Throw an error, a modified cursor command was applied in wrong context."
13509 (error "This command is active in special context like tables, headlines or items"))
13511 (defun org-shiftselect-error ()
13512 "Throw an error because Shift-Cursor command was applied in wrong context."
13513 (if (and (boundp 'shift-select-mode) shift-select-mode)
13514 (error "To use shift-selection with Org-mode, customize `org-support-shift-select'.")
13515 (error "This command works only in special context like headlines or timestamps.")))
13517 (defun org-call-for-shift-select (cmd)
13518 (let ((this-command-keys-shift-translated t))
13519 (call-interactively cmd)))
13521 (defun org-shifttab (&optional arg)
13522 "Global visibility cycling or move to previous table field.
13523 Calls `org-cycle' with argument t, or `org-table-previous-field', depending
13524 on context.
13525 See the individual commands for more information."
13526 (interactive "P")
13527 (cond
13528 ((org-at-table-p) (call-interactively 'org-table-previous-field))
13529 ((integerp arg)
13530 (message "Content view to level: %d" arg)
13531 (org-content (prefix-numeric-value arg))
13532 (setq org-cycle-global-status 'overview))
13533 (t (call-interactively 'org-global-cycle))))
13535 (defun org-shiftmetaleft ()
13536 "Promote subtree or delete table column.
13537 Calls `org-promote-subtree', `org-outdent-item',
13538 or `org-table-delete-column', depending on context.
13539 See the individual commands for more information."
13540 (interactive)
13541 (cond
13542 ((run-hook-with-args-until-success 'org-shiftmetaleft-hook))
13543 ((org-at-table-p) (call-interactively 'org-table-delete-column))
13544 ((org-on-heading-p) (call-interactively 'org-promote-subtree))
13545 ((org-at-item-p) (call-interactively 'org-outdent-item))
13546 (t (org-modifier-cursor-error))))
13548 (defun org-shiftmetaright ()
13549 "Demote subtree or insert table column.
13550 Calls `org-demote-subtree', `org-indent-item',
13551 or `org-table-insert-column', depending on context.
13552 See the individual commands for more information."
13553 (interactive)
13554 (cond
13555 ((run-hook-with-args-until-success 'org-shiftmetaright-hook))
13556 ((org-at-table-p) (call-interactively 'org-table-insert-column))
13557 ((org-on-heading-p) (call-interactively 'org-demote-subtree))
13558 ((org-at-item-p) (call-interactively 'org-indent-item))
13559 (t (org-modifier-cursor-error))))
13561 (defun org-shiftmetaup (&optional arg)
13562 "Move subtree up or kill table row.
13563 Calls `org-move-subtree-up' or `org-table-kill-row' or
13564 `org-move-item-up' depending on context. See the individual commands
13565 for more information."
13566 (interactive "P")
13567 (cond
13568 ((run-hook-with-args-until-success 'org-shiftmetaup-hook))
13569 ((org-at-table-p) (call-interactively 'org-table-kill-row))
13570 ((org-on-heading-p) (call-interactively 'org-move-subtree-up))
13571 ((org-at-item-p) (call-interactively 'org-move-item-up))
13572 (t (org-modifier-cursor-error))))
13574 (defun org-shiftmetadown (&optional arg)
13575 "Move subtree down or insert table row.
13576 Calls `org-move-subtree-down' or `org-table-insert-row' or
13577 `org-move-item-down', depending on context. See the individual
13578 commands for more information."
13579 (interactive "P")
13580 (cond
13581 ((run-hook-with-args-until-success 'org-shiftmetadown-hook))
13582 ((org-at-table-p) (call-interactively 'org-table-insert-row))
13583 ((org-on-heading-p) (call-interactively 'org-move-subtree-down))
13584 ((org-at-item-p) (call-interactively 'org-move-item-down))
13585 (t (org-modifier-cursor-error))))
13587 (defun org-metaleft (&optional arg)
13588 "Promote heading or move table column to left.
13589 Calls `org-do-promote' or `org-table-move-column', depending on context.
13590 With no specific context, calls the Emacs default `backward-word'.
13591 See the individual commands for more information."
13592 (interactive "P")
13593 (cond
13594 ((run-hook-with-args-until-success 'org-metaleft-hook))
13595 ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left))
13596 ((or (org-on-heading-p)
13597 (and (org-region-active-p)
13598 (save-excursion
13599 (goto-char (region-beginning))
13600 (org-on-heading-p))))
13601 (call-interactively 'org-do-promote))
13602 ((or (org-at-item-p)
13603 (and (org-region-active-p)
13604 (save-excursion
13605 (goto-char (region-beginning))
13606 (org-at-item-p))))
13607 (call-interactively 'org-outdent-item))
13608 (t (call-interactively 'backward-word))))
13610 (defun org-metaright (&optional arg)
13611 "Demote subtree or move table column to right.
13612 Calls `org-do-demote' or `org-table-move-column', depending on context.
13613 With no specific context, calls the Emacs default `forward-word'.
13614 See the individual commands for more information."
13615 (interactive "P")
13616 (cond
13617 ((run-hook-with-args-until-success 'org-metaright-hook))
13618 ((org-at-table-p) (call-interactively 'org-table-move-column))
13619 ((or (org-on-heading-p)
13620 (and (org-region-active-p)
13621 (save-excursion
13622 (goto-char (region-beginning))
13623 (org-on-heading-p))))
13624 (call-interactively 'org-do-demote))
13625 ((or (org-at-item-p)
13626 (and (org-region-active-p)
13627 (save-excursion
13628 (goto-char (region-beginning))
13629 (org-at-item-p))))
13630 (call-interactively 'org-indent-item))
13631 (t (call-interactively 'forward-word))))
13633 (defun org-metaup (&optional arg)
13634 "Move subtree up or move table row up.
13635 Calls `org-move-subtree-up' or `org-table-move-row' or
13636 `org-move-item-up', depending on context. See the individual commands
13637 for more information."
13638 (interactive "P")
13639 (cond
13640 ((run-hook-with-args-until-success 'org-metaup-hook))
13641 ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up))
13642 ((org-on-heading-p) (call-interactively 'org-move-subtree-up))
13643 ((org-at-item-p) (call-interactively 'org-move-item-up))
13644 (t (transpose-lines 1) (beginning-of-line -1))))
13646 (defun org-metadown (&optional arg)
13647 "Move subtree down or move table row down.
13648 Calls `org-move-subtree-down' or `org-table-move-row' or
13649 `org-move-item-down', depending on context. See the individual
13650 commands for more information."
13651 (interactive "P")
13652 (cond
13653 ((run-hook-with-args-until-success 'org-metadown-hook))
13654 ((org-at-table-p) (call-interactively 'org-table-move-row))
13655 ((org-on-heading-p) (call-interactively 'org-move-subtree-down))
13656 ((org-at-item-p) (call-interactively 'org-move-item-down))
13657 (t (beginning-of-line 2) (transpose-lines 1) (beginning-of-line 0))))
13659 (defun org-shiftup (&optional arg)
13660 "Increase item in timestamp or increase priority of current headline.
13661 Calls `org-timestamp-up' or `org-priority-up', or `org-previous-item',
13662 depending on context. See the individual commands for more information."
13663 (interactive "P")
13664 (cond
13665 ((and org-support-shift-select (org-region-active-p))
13666 (org-call-for-shift-select 'previous-line))
13667 ((org-at-timestamp-p t)
13668 (call-interactively (if org-edit-timestamp-down-means-later
13669 'org-timestamp-down 'org-timestamp-up)))
13670 ((and (not (eq org-support-shift-select 'always))
13671 (org-on-heading-p))
13672 (call-interactively 'org-priority-up))
13673 ((and (not org-support-shift-select) (org-at-item-p))
13674 (call-interactively 'org-previous-item))
13675 ((org-clocktable-try-shift 'up arg))
13676 (org-support-shift-select
13677 (org-call-for-shift-select 'previous-line))
13678 (t (org-shiftselect-error))))
13680 (defun org-shiftdown (&optional arg)
13681 "Decrease item in timestamp or decrease priority of current headline.
13682 Calls `org-timestamp-down' or `org-priority-down', or `org-next-item'
13683 depending on context. See the individual commands for more information."
13684 (interactive "P")
13685 (cond
13686 ((and org-support-shift-select (org-region-active-p))
13687 (org-call-for-shift-select 'next-line))
13688 ((org-at-timestamp-p t)
13689 (call-interactively (if org-edit-timestamp-down-means-later
13690 'org-timestamp-up 'org-timestamp-down)))
13691 ((and (not (eq org-support-shift-select 'always))
13692 (org-on-heading-p))
13693 (call-interactively 'org-priority-down))
13694 ((and (not org-support-shift-select) (org-at-item-p))
13695 (call-interactively 'org-next-item))
13696 ((org-clocktable-try-shift 'down arg))
13697 (org-support-shift-select
13698 (org-call-for-shift-select 'next-line))
13699 (t (org-shiftselect-error))))
13701 (defun org-shiftright (&optional arg)
13702 "Cycle the thing at point or in the current line, depending on context.
13703 Depending on context, this does one of the following:
13705 - switch a timestamp at point one day into the future
13706 - on a headline, switch to the next TODO keyword.
13707 - on an item, switch entire list to the next bullet type
13708 - on a property line, switch to the next allowed value
13709 - on a clocktable definition line, move time block into the future"
13710 (interactive "P")
13711 (cond
13712 ((and org-support-shift-select (org-region-active-p))
13713 (org-call-for-shift-select 'forward-char))
13714 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day))
13715 ((and (not (eq org-support-shift-select 'always))
13716 (org-on-heading-p))
13717 (org-call-with-arg 'org-todo 'right))
13718 ((or (and org-support-shift-select
13719 (not (eq org-support-shift-select 'always))
13720 (org-at-item-bullet-p))
13721 (and (not org-support-shift-select) (org-at-item-p)))
13722 (org-call-with-arg 'org-cycle-list-bullet nil))
13723 ((and (not (eq org-support-shift-select 'always))
13724 (org-at-property-p))
13725 (call-interactively 'org-property-next-allowed-value))
13726 ((org-clocktable-try-shift 'right arg))
13727 (org-support-shift-select
13728 (org-call-for-shift-select 'forward-char))
13729 (t (org-shiftselect-error))))
13731 (defun org-shiftleft (&optional arg)
13732 "Cycle the thing at point or in the current line, depending on context.
13733 Depending on context, this does one of the following:
13735 - switch a timestamp at point one day into the past
13736 - on a headline, switch to the previous TODO keyword.
13737 - on an item, switch entire list to the previous bullet type
13738 - on a property line, switch to the previous allowed value
13739 - on a clocktable definition line, move time block into the past"
13740 (interactive "P")
13741 (cond
13742 ((and org-support-shift-select (org-region-active-p))
13743 (org-call-for-shift-select 'backward-char))
13744 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day))
13745 ((and (not (eq org-support-shift-select 'always))
13746 (org-on-heading-p))
13747 (org-call-with-arg 'org-todo 'left))
13748 ((or (and org-support-shift-select
13749 (not (eq org-support-shift-select 'always))
13750 (org-at-item-bullet-p))
13751 (and (not org-support-shift-select) (org-at-item-p)))
13752 (org-call-with-arg 'org-cycle-list-bullet 'previous))
13753 ((and (not (eq org-support-shift-select 'always))
13754 (org-at-property-p))
13755 (call-interactively 'org-property-previous-allowed-value))
13756 ((org-clocktable-try-shift 'left arg))
13757 (org-support-shift-select
13758 (org-call-for-shift-select 'backward-char))
13759 (t (org-shiftselect-error))))
13761 (defun org-shiftcontrolright ()
13762 "Switch to next TODO set."
13763 (interactive)
13764 (cond
13765 ((and org-support-shift-select (org-region-active-p))
13766 (org-call-for-shift-select 'forward-word))
13767 ((and (not (eq org-support-shift-select 'always))
13768 (org-on-heading-p))
13769 (org-call-with-arg 'org-todo 'nextset))
13770 (org-support-shift-select
13771 (org-call-for-shift-select 'forward-word))
13772 (t (org-shiftselect-error))))
13774 (defun org-shiftcontrolleft ()
13775 "Switch to previous TODO set."
13776 (interactive)
13777 (cond
13778 ((and org-support-shift-select (org-region-active-p))
13779 (org-call-for-shift-select 'backward-word))
13780 ((and (not (eq org-support-shift-select 'always))
13781 (org-on-heading-p))
13782 (org-call-with-arg 'org-todo 'previousset))
13783 (org-support-shift-select
13784 (org-call-for-shift-select 'backward-word))
13785 (t (org-shiftselect-error))))
13787 (defun org-ctrl-c-ret ()
13788 "Call `org-table-hline-and-move' or `org-insert-heading' dep. on context."
13789 (interactive)
13790 (cond
13791 ((org-at-table-p) (call-interactively 'org-table-hline-and-move))
13792 (t (call-interactively 'org-insert-heading))))
13794 (defun org-copy-special ()
13795 "Copy region in table or copy current subtree.
13796 Calls `org-table-copy' or `org-copy-subtree', depending on context.
13797 See the individual commands for more information."
13798 (interactive)
13799 (call-interactively
13800 (if (org-at-table-p) 'org-table-copy-region 'org-copy-subtree)))
13802 (defun org-cut-special ()
13803 "Cut region in table or cut current subtree.
13804 Calls `org-table-copy' or `org-cut-subtree', depending on context.
13805 See the individual commands for more information."
13806 (interactive)
13807 (call-interactively
13808 (if (org-at-table-p) 'org-table-cut-region 'org-cut-subtree)))
13810 (defun org-paste-special (arg)
13811 "Paste rectangular region into table, or past subtree relative to level.
13812 Calls `org-table-paste-rectangle' or `org-paste-subtree', depending on context.
13813 See the individual commands for more information."
13814 (interactive "P")
13815 (if (org-at-table-p)
13816 (org-table-paste-rectangle)
13817 (org-paste-subtree arg)))
13819 (defun org-edit-special ()
13820 "Call a special editor for the stuff at point.
13821 When at a table, call the formula editor with `org-table-edit-formulas'.
13822 When at the first line of an src example, call `org-edit-src-code'.
13823 When in an #+include line, visit the include file. Otherwise call
13824 `ffap' to visit the file at point."
13825 (interactive)
13826 (cond
13827 ((org-at-table-p)
13828 (call-interactively 'org-table-edit-formulas))
13829 ((save-excursion
13830 (beginning-of-line 1)
13831 (looking-at "\\(?:#\\+\\(?:setupfile\\|include\\):?[ \t]+\"?\\|[ \t]*<include\\>.*?file=\"\\)\\([^\"\n>]+\\)"))
13832 (find-file (org-trim (match-string 1))))
13833 ((org-edit-src-code))
13834 ((org-edit-fixed-width-region))
13835 (t (call-interactively 'ffap))))
13838 (defun org-ctrl-c-ctrl-c (&optional arg)
13839 "Set tags in headline, or update according to changed information at point.
13841 This command does many different things, depending on context:
13843 - If a function in `org-ctrl-c-ctrl-c-hook' recognizes this location,
13844 this is what we do.
13846 - If the cursor is in a headline, prompt for tags and insert them
13847 into the current line, aligned to `org-tags-column'. When called
13848 with prefix arg, realign all tags in the current buffer.
13850 - If the cursor is in one of the special #+KEYWORD lines, this
13851 triggers scanning the buffer for these lines and updating the
13852 information.
13854 - If the cursor is inside a table, realign the table. This command
13855 works even if the automatic table editor has been turned off.
13857 - If the cursor is on a #+TBLFM line, re-apply the formulas to
13858 the entire table.
13860 - If the cursor is at a footnote reference or definition, jump to
13861 the corresponding definition or references, respectively.
13863 - If the cursor is a the beginning of a dynamic block, update it.
13865 - If the cursor is inside a table created by the table.el package,
13866 activate that table.
13868 - If the current buffer is a remember buffer, close note and file
13869 it. A prefix argument of 1 files to the default location
13870 without further interaction. A prefix argument of 2 files to
13871 the currently clocking task.
13873 - If the cursor is on a <<<target>>>, update radio targets and corresponding
13874 links in this buffer.
13876 - If the cursor is on a numbered item in a plain list, renumber the
13877 ordered list.
13879 - If the cursor is on a checkbox, toggle it."
13880 (interactive "P")
13881 (let ((org-enable-table-editor t))
13882 (cond
13883 ((or (and (boundp 'org-clock-overlays) org-clock-overlays)
13884 org-occur-highlights
13885 org-latex-fragment-image-overlays)
13886 (and (boundp 'org-clock-overlays) (org-clock-remove-overlays))
13887 (org-remove-occur-highlights)
13888 (org-remove-latex-fragment-image-overlays)
13889 (message "Temporary highlights/overlays removed from current buffer"))
13890 ((and (local-variable-p 'org-finish-function (current-buffer))
13891 (fboundp org-finish-function))
13892 (funcall org-finish-function))
13893 ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook))
13894 ((org-at-property-p)
13895 (call-interactively 'org-property-action))
13896 ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp))
13897 ((org-on-heading-p) (call-interactively 'org-set-tags))
13898 ((org-at-table.el-p)
13899 (require 'table)
13900 (beginning-of-line 1)
13901 (re-search-forward "|" (save-excursion (end-of-line 2) (point)))
13902 (call-interactively 'table-recognize-table))
13903 ((org-at-table-p)
13904 (org-table-maybe-eval-formula)
13905 (if arg
13906 (call-interactively 'org-table-recalculate)
13907 (org-table-maybe-recalculate-line))
13908 (call-interactively 'org-table-align))
13909 ((or (org-footnote-at-reference-p)
13910 (org-footnote-at-definition-p))
13911 (call-interactively 'org-footnote-action))
13912 ((org-at-item-checkbox-p)
13913 (call-interactively 'org-toggle-checkbox))
13914 ((org-at-item-p)
13915 (if arg
13916 (call-interactively 'org-toggle-checkbox)
13917 (call-interactively 'org-maybe-renumber-ordered-list)))
13919 ;; Dynamic block
13920 (beginning-of-line 1)
13921 (save-excursion (org-update-dblock)))
13923 (cond
13924 ((equal (match-string 1) "TBLFM")
13925 ;; Recalculate the table before this line
13926 (save-excursion
13927 (beginning-of-line 1)
13929 (if (org-at-table-p)
13930 (org-call-with-arg 'org-table-recalculate t))))
13931 (t
13932 ; (org-set-regexps-and-options)
13933 ; (org-restart-font-lock)
13934 (let ((org-inhibit-startup t)) (org-mode-restart))
13935 (message "Local setup has been refreshed"))))
13936 (t (error "C-c C-c can do nothing useful at this location.")))))
13938 (defun org-mode-restart ()
13939 "Restart Org-mode, to scan again for special lines.
13940 Also updates the keyword regular expressions."
13941 (interactive)
13942 (org-mode)
13943 (message "Org-mode restarted"))
13945 (defun org-kill-note-or-show-branches ()
13946 "If this is a Note buffer, abort storing the note. Else call `show-branches'."
13947 (interactive)
13948 (if (not org-finish-function)
13949 (call-interactively 'show-branches)
13950 (let ((org-note-abort t))
13951 (funcall org-finish-function))))
13953 (defun org-return (&optional indent)
13954 "Goto next table row or insert a newline.
13955 Calls `org-table-next-row' or `newline', depending on context.
13956 See the individual commands for more information."
13957 (interactive)
13958 (cond
13959 ((bobp) (if indent (newline-and-indent) (newline)))
13960 ((org-at-table-p)
13961 (org-table-justify-field-maybe)
13962 (call-interactively 'org-table-next-row))
13963 ((and org-return-follows-link
13964 (eq (get-text-property (point) 'face) 'org-link))
13965 (call-interactively 'org-open-at-point))
13966 ((and (org-at-heading-p)
13967 (looking-at
13969 (org-show-entry)
13970 (end-of-line 1)
13971 (newline))
13972 (t (if indent (newline-and-indent) (newline)))))
13974 (defun org-return-indent ()
13975 "Goto next table row or insert a newline and indent.
13976 Calls `org-table-next-row' or `newline-and-indent', depending on
13977 context. See the individual commands for more information."
13978 (interactive)
13979 (org-return t))
13981 (defun org-ctrl-c-star ()
13982 "Compute table, or change heading status of lines.
13983 Calls `org-table-recalculate' or `org-toggle-heading',
13984 depending on context."
13985 (interactive)
13986 (cond
13987 ((org-at-table-p)
13988 (call-interactively 'org-table-recalculate))
13989 (t
13990 ;; Convert all lines in region to list items
13991 (call-interactively 'org-toggle-heading))))
13993 (defun org-ctrl-c-minus ()
13994 "Insert separator line in table or modify bullet status of line.
13995 Also turns a plain line or a region of lines into list items.
13996 Calls `org-table-insert-hline', `org-toggle-item', or
13997 `org-cycle-list-bullet', depending on context."
13998 (interactive)
13999 (cond
14000 ((org-at-table-p)
14001 (call-interactively 'org-table-insert-hline))
14002 ((org-region-active-p)
14003 (call-interactively 'org-toggle-item))
14004 ((org-in-item-p)
14005 (call-interactively 'org-cycle-list-bullet))
14006 (t
14007 (call-interactively 'org-toggle-item))))
14009 (defun org-toggle-item ()
14010 "Convert headings or normal lines to items, items to normal lines.
14011 If there is no active region, only the current line is considered.
14013 If the first line in the region is a headline, convert all headlines to items.
14015 If the first line in the region is an item, convert all items to normal lines.
14017 If the first line is normal text, add an item bullet to each line."
14018 (interactive)
14019 (let (l2 l beg end)
14020 (if (org-region-active-p)
14021 (setq beg (region-beginning) end (region-end))
14022 (setq beg (point-at-bol)
14023 end (min (1+ (point-at-eol)) (point-max))))
14024 (save-excursion
14025 (goto-char end)
14026 (setq l2 (org-current-line))
14027 (goto-char beg)
14028 (beginning-of-line 1)
14029 (setq l (1- (org-current-line)))
14030 (if (org-at-item-p)
14031 ;; We already have items, de-itemize
14032 (while (< (setq l (1+ l)) l2)
14033 (when (org-at-item-p)
14034 (goto-char (match-beginning 2))
14035 (delete-region (match-beginning 2) (match-end 2))
14037 (beginning-of-line 2))
14038 (if (org-on-heading-p)
14039 ;; Headings, convert to items
14040 (while (< (setq l (1+ l)) l2)
14041 (if (looking-at org-outline-regexp)
14042 (replace-match "- " t t))
14043 (beginning-of-line 2))
14044 ;; normal lines, turn them into items
14045 (while (< (setq l (1+ l)) l2)
14046 (unless (org-at-item-p)
14049 (beginning-of-line 2)))))))
14051 (defun org-toggle-heading (&optional nstars)
14052 "Convert headings to normal text, or items or text to headings.
14053 If there is no active region, only the current line is considered.
14055 If the first line is a heading, remove the stars from all headlines
14056 in the region.
14058 If the first line is a plain list item, turn all plain list items into
14059 headings.
14061 If the first line is a normal line, turn each and every line in the region
14062 into a heading.
14064 When converting a line into a heading, the number of stars is chosen
14065 such that the lines become children of the current entry. However, when
14066 a prefix argument is given, its value determines the number of stars to add."
14067 (interactive "P")
14068 (let (l2 l itemp beg end)
14069 (if (org-region-active-p)
14070 (setq beg (region-beginning) end (region-end))
14071 (setq beg (point-at-bol)
14072 end (min (1+ (point-at-eol)) (point-max))))
14073 (save-excursion
14074 (goto-char end)
14075 (setq l2 (org-current-line))
14076 (goto-char beg)
14077 (beginning-of-line 1)
14078 (setq l (1- (org-current-line)))
14079 (if (org-on-heading-p)
14080 ;; We already have headlines, de-star them
14081 (while (< (setq l (1+ l)) l2)
14082 (when (org-on-heading-p t)
14083 (and (looking-at outline-regexp) (replace-match "")))
14084 (beginning-of-line 2))
14085 (setq itemp (org-at-item-p))
14086 (let* ((stars
14087 (if nstars
14088 (make-string (prefix-numeric-value current-prefix-arg)
14089 ?*)
14090 (save-excursion
14091 (re-search-backward org-complex-heading-regexp nil t)
14092 (or (match-string 1) "*"))))
14093 (add-stars (if nstars "" (if org-odd-levels-only "**" "*")))
14094 (rpl (concat stars add-stars " ")))
14095 (while (< (setq l (1+ l)) l2)
14096 (if itemp
14097 (and (org-at-item-p) (replace-match rpl t t))
14098 (unless (org-on-heading-p)
14100 (replace-match (concat rpl (match-string 2))))))
14101 (beginning-of-line 2)))))))
14103 (defun org-meta-return (&optional arg)
14104 "Insert a new heading or wrap a region in a table.
14105 Calls `org-insert-heading' or `org-table-wrap-region', depending on context.
14106 See the individual commands for more information."
14107 (interactive "P")
14108 (cond
14109 ((run-hook-with-args-until-success 'org-metareturn-hook))
14110 ((org-at-table-p)
14111 (call-interactively 'org-table-wrap-region))
14112 (t (call-interactively 'org-insert-heading))))
14114 ;;; Menu entries
14116 ;; Define the Org-mode menus
14117 (easy-menu-define org-tbl-menu org-mode-map "Tbl menu"
14118 '("Tbl"
14119 ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p)]
14120 ["Next Field" org-cycle (org-at-table-p)]
14121 ["Previous Field" org-shifttab (org-at-table-p)]
14122 ["Next Row" org-return (org-at-table-p)]
14123 "--"
14124 ["Blank Field" org-table-blank-field (org-at-table-p)]
14125 ["Edit Field" org-table-edit-field (org-at-table-p)]
14126 ["Copy Field from Above" org-table-copy-down (org-at-table-p)]
14127 "--"
14128 ("Column"
14129 ["Move Column Left" org-metaleft (org-at-table-p)]
14130 ["Move Column Right" org-metaright (org-at-table-p)]
14131 ["Delete Column" org-shiftmetaleft (org-at-table-p)]
14132 ["Insert Column" org-shiftmetaright (org-at-table-p)])
14133 ("Row"
14134 ["Move Row Up" org-metaup (org-at-table-p)]
14135 ["Move Row Down" org-metadown (org-at-table-p)]
14136 ["Delete Row" org-shiftmetaup (org-at-table-p)]
14137 ["Insert Row" org-shiftmetadown (org-at-table-p)]
14138 ["Sort lines in region" org-table-sort-lines (org-at-table-p)]
14139 "--"
14140 ["Insert Hline" org-ctrl-c-minus (org-at-table-p)])
14141 ("Rectangle"
14142 ["Copy Rectangle" org-copy-special (org-at-table-p)]
14143 ["Cut Rectangle" org-cut-special (org-at-table-p)]
14144 ["Paste Rectangle" org-paste-special (org-at-table-p)]
14145 ["Fill Rectangle" org-table-wrap-region (org-at-table-p)])
14146 "--"
14147 ("Calculate"
14148 ["Set Column Formula" org-table-eval-formula (org-at-table-p)]
14149 ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
14150 ["Edit Formulas" org-edit-special (org-at-table-p)]
14151 "--"
14152 ["Recalculate line" org-table-recalculate (org-at-table-p)]
14153 ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"]
14154 ["Iterate all" (lambda () (interactive) (org-table-recalculate '(16))) :active (org-at-table-p) :keys "C-u C-u C-c *"]
14155 "--"
14156 ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)]
14157 "--"
14158 ["Sum Column/Rectangle" org-table-sum
14159 (or (org-at-table-p) (org-region-active-p))]
14160 ["Which Column?" org-table-current-column (org-at-table-p)])
14161 ["Debug Formulas"
14162 org-table-toggle-formula-debugger
14163 :style toggle :selected (org-bound-and-true-p org-table-formula-debug)]
14164 ["Show Col/Row Numbers"
14165 org-table-toggle-coordinate-overlays
14166 :style toggle
14167 :selected (org-bound-and-true-p org-table-overlay-coordinates)]
14168 "--"
14169 ["Create" org-table-create (and (not (org-at-table-p))
14170 org-enable-table-editor)]
14171 ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))]
14172 ["Import from File" org-table-import (not (org-at-table-p))]
14173 ["Export to File" org-table-export (org-at-table-p)]
14174 "--"
14175 ["Create/Convert from/to table.el" org-table-create-with-table.el t]))
14177 (easy-menu-define org-org-menu org-mode-map "Org menu"
14178 '("Org"
14179 ("Show/Hide"
14180 ["Cycle Visibility" org-cycle :active (or (bobp) (outline-on-heading-p))]
14181 ["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))]
14182 ["Sparse Tree..." org-sparse-tree t]
14183 ["Reveal Context" org-reveal t]
14184 ["Show All" show-all t]
14185 "--"
14186 ["Subtree to indirect buffer" org-tree-to-indirect-buffer t])
14187 "--"
14188 ["New Heading" org-insert-heading t]
14189 ("Navigate Headings"
14190 ["Up" outline-up-heading t]
14191 ["Next" outline-next-visible-heading t]
14192 ["Previous" outline-previous-visible-heading t]
14193 ["Next Same Level" outline-forward-same-level t]
14194 ["Previous Same Level" outline-backward-same-level t]
14195 "--"
14196 ["Jump" org-goto t])
14197 ("Edit Structure"
14198 ["Move Subtree Up" org-shiftmetaup (not (org-at-table-p))]
14199 ["Move Subtree Down" org-shiftmetadown (not (org-at-table-p))]
14200 "--"
14201 ["Copy Subtree" org-copy-special (not (org-at-table-p))]
14202 ["Cut Subtree" org-cut-special (not (org-at-table-p))]
14203 ["Paste Subtree" org-paste-special (not (org-at-table-p))]
14204 "--"
14205 ["Promote Heading" org-metaleft (not (org-at-table-p))]
14206 ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))]
14207 ["Demote Heading" org-metaright (not (org-at-table-p))]
14208 ["Demote Subtree" org-shiftmetaright (not (org-at-table-p))]
14209 "--"
14210 ["Sort Region/Children" org-sort (not (org-at-table-p))]
14211 "--"
14212 ["Convert to odd levels" org-convert-to-odd-levels t]
14213 ["Convert to odd/even levels" org-convert-to-oddeven-levels t])
14214 ("Editing"
14215 ["Emphasis..." org-emphasize t]
14216 ["Edit Source Example" org-edit-special t]
14217 "--"
14218 ["Footnote new/jump" org-footnote-action t]
14219 ["Footnote extra" (org-footnote-action t) :active t :keys "C-u C-c C-x f"])
14220 ("Archive"
14221 ["Toggle ARCHIVE tag" org-toggle-archive-tag t]
14222 ; ["Check and Tag Children" (org-toggle-archive-tag (4))
14223 ; :active t :keys "C-u C-c C-x C-a"]
14224 ["Sparse trees open ARCHIVE trees"
14225 (setq org-sparse-tree-open-archived-trees
14226 (not org-sparse-tree-open-archived-trees))
14227 :style toggle :selected org-sparse-tree-open-archived-trees]
14228 ["Cycling opens ARCHIVE trees"
14229 (setq org-cycle-open-archived-trees (not org-cycle-open-archived-trees))
14230 :style toggle :selected org-cycle-open-archived-trees]
14231 "--"
14232 ["Move subtree to archive sibling" org-archive-to-archive-sibling t]
14233 ["Move Subtree to Archive" org-advertized-archive-subtree t]
14234 ; ["Check and Move Children" (org-archive-subtree '(4))
14235 ; :active t :keys "C-u C-c C-x C-s"]
14236 )
14237 "--"
14238 ("TODO Lists"
14239 ["TODO/DONE/-" org-todo t]
14240 ("Select keyword"
14241 ["Next keyword" org-shiftright (org-on-heading-p)]
14242 ["Previous keyword" org-shiftleft (org-on-heading-p)]
14243 ["Complete Keyword" org-complete (assq :todo-keyword (org-context))]
14244 ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))]
14245 ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))])
14246 ["Show TODO Tree" org-show-todo-tree t]
14247 ["Global TODO list" org-todo-list t]
14248 "--"
14249 ["Enforce dependencies" (customize-variable 'org-enforce-todo-dependencies)
14250 :selected org-enforce-todo-dependencies :style toggle :active t]
14251 "Settings for tree at point"
14252 ["Do Children sequentially" org-toggle-ordered-property :style radio
14253 :selected (ignore-errors (org-entry-get nil "ORDERED"))
14254 :active org-enforce-todo-dependencies :keys "C-c C-x o"]
14255 ["Do Children parallel" org-toggle-ordered-property :style radio
14256 :selected (ignore-errors (not (org-entry-get nil "ORDERED")))
14257 :active org-enforce-todo-dependencies :keys "C-c C-x o"]
14258 "--"
14259 ["Set Priority" org-priority t]
14260 ["Priority Up" org-shiftup t]
14261 ["Priority Down" org-shiftdown t])
14262 ("TAGS and Properties"
14263 ["Set Tags" org-set-tags-command t]
14264 ["Change tag in region" org-change-tag-in-region (org-region-active-p)]
14265 "--"
14266 ["Set property" org-set-property t]
14267 ["Column view of properties" org-columns t]
14268 ["Insert Column View DBlock" org-insert-columns-dblock t])
14269 ("Dates and Scheduling"
14270 ["Timestamp" org-time-stamp t]
14271 ["Timestamp (inactive)" org-time-stamp-inactive t]
14272 ("Change Date"
14273 ["1 Day Later" org-shiftright t]
14274 ["1 Day Earlier" org-shiftleft t]
14275 ["1 ... Later" org-shiftup t]
14276 ["1 ... Earlier" org-shiftdown t])
14277 ["Compute Time Range" org-evaluate-time-range t]
14278 ["Schedule Item" org-schedule t]
14279 ["Deadline" org-deadline t]
14280 "--"
14281 ["Custom time format" org-toggle-time-stamp-overlays
14282 :style radio :selected org-display-custom-times]
14283 "--"
14284 ["Goto Calendar" org-goto-calendar t]
14285 ["Date from Calendar" org-date-from-calendar t]
14286 "--"
14287 ["Start/Restart Timer" org-timer-start t]
14288 ["Pause/Continue Timer" org-timer-pause-or-continue t]
14289 ["Stop Timer" org-timer-pause-or-continue :active t :keys "C-u C-c C-x ,"]
14290 ["Insert Timer String" org-timer t]
14291 ["Insert Timer Item" org-timer-item t])
14292 ("Logging work"
14293 ["Clock in" org-clock-in t]
14294 ["Clock out" org-clock-out t]
14295 ["Clock cancel" org-clock-cancel t]
14296 ["Goto running clock" org-clock-goto t]
14297 ["Display times" org-clock-display t]
14298 ["Create clock table" org-clock-report t]
14299 "--"
14300 ["Record DONE time"
14301 (progn (setq org-log-done (not org-log-done))
14302 (message "Switching to %s will %s record a timestamp"
14303 (car org-done-keywords)
14304 (if org-log-done "automatically" "not")))
14305 :style toggle :selected org-log-done])
14306 "--"
14307 ["Agenda Command..." org-agenda t]
14308 ["Set Restriction Lock" org-agenda-set-restriction-lock t]
14309 ("File List for Agenda")
14310 ("Special views current file"
14311 ["TODO Tree" org-show-todo-tree t]
14312 ["Check Deadlines" org-check-deadlines t]
14313 ["Timeline" org-timeline t]
14314 ["Tags/Property tree" org-match-sparse-tree t])
14315 "--"
14316 ("Hyperlinks"
14317 ["Store Link (Global)" org-store-link t]
14318 ["Insert Link" org-insert-link t]
14319 ["Follow Link" org-open-at-point t]
14320 "--"
14321 ["Next link" org-next-link t]
14322 ["Previous link" org-previous-link t]
14323 "--"
14324 ["Descriptive Links"
14325 (progn (org-add-to-invisibility-spec '(org-link)) (org-restart-font-lock))
14326 :style radio
14327 :selected (member '(org-link) buffer-invisibility-spec)]
14328 ["Literal Links"
14329 (progn
14330 (org-remove-from-invisibility-spec '(org-link)) (org-restart-font-lock))
14331 :style radio
14332 :selected (not (member '(org-link) buffer-invisibility-spec))])
14333 "--"
14334 ["Export/Publish..." org-export t]
14335 ("LaTeX"
14336 ["Org CDLaTeX mode" org-cdlatex-mode :style toggle
14337 :selected org-cdlatex-mode]
14338 ["Insert Environment" cdlatex-environment (fboundp 'cdlatex-environment)]
14339 ["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)]
14340 ["Modify math symbol" org-cdlatex-math-modify
14341 (org-inside-LaTeX-fragment-p)]
14342 ["Export LaTeX fragments as images"
14343 (if (featurep 'org-exp)
14344 (setq org-export-with-LaTeX-fragments
14345 (not org-export-with-LaTeX-fragments))
14346 (require 'org-exp))
14347 :style toggle :selected (and (boundp 'org-export-with-LaTeX-fragments)
14348 org-export-with-LaTeX-fragments)])
14349 "--"
14350 ("Documentation"
14351 ["Show Version" org-version t]
14352 ["Info Documentation" org-info t])
14353 ("Customize"
14354 ["Browse Org Group" org-customize t]
14355 "--"
14356 ["Expand This Menu" org-create-customize-menu
14357 (fboundp 'customize-menu-create)])
14358 "--"
14359 ("Refresh/Reload"
14360 ["Refresh setup current buffer" org-mode-restart t]
14361 ["Reload Org (after update)" org-reload t]
14362 ["Reload Org uncompiled" (org-reload t) :active t :keys "C-u C-c C-x r"])
14363 ))
14365 (defun org-info (&optional node)
14366 "Read documentation for Org-mode in the info system.
14367 With optional NODE, go directly to that node."
14368 (interactive)
14369 (info (format "(org)%s" (or node ""))))
14371 (defun org-install-agenda-files-menu ()
14372 (let ((bl (buffer-list)))
14373 (save-excursion
14374 (while bl
14375 (set-buffer (pop bl))
14376 (if (org-mode-p) (setq bl nil)))
14377 (when (org-mode-p)
14378 (easy-menu-change
14379 '("Org") "File List for Agenda"
14380 (append
14381 (list
14382 ["Edit File List" (org-edit-agenda-file-list) t]
14383 ["Add/Move Current File to Front of List" org-agenda-file-to-front t]
14384 ["Remove Current File from List" org-remove-file t]
14385 ["Cycle through agenda files" org-cycle-agenda-files t]
14386 ["Occur in all agenda files" org-occur-in-agenda-files t]
14387 "--")
14388 (mapcar 'org-file-menu-entry (org-agenda-files t))))))))
14390 ;;;; Documentation
14392 ;;;###autoload
14393 (defun org-require-autoloaded-modules ()
14394 (interactive)
14395 (mapc 'require
14396 '(org-agenda org-archive org-attach org-clock org-colview
14397 org-exp org-id org-export-latex org-publish
14398 org-remember org-table org-timer)))
14400 ;;;###autoload
14401 (defun org-reload (&optional uncompiled)
14402 "Reload all org lisp files.
14403 With prefix arg UNCOMPILED, load the uncompiled versions."
14404 (interactive "P")
14405 (require 'find-func)
14406 (let* ((dir (file-name-directory (find-library-name "org")))
14408 (remove-re (concat (if (featurep 'xemacs)
14409 "org-colview" "org-colview-xemacs")
14411 (setq files (mapcar 'file-name-sans-extension files))
14412 (setq files (mapcar
14413 (lambda (x) (if (string-match remove-re x) nil x))
14414 files))
14415 (setq files (delq nil files))
14416 (mapc
14417 (lambda (f)
14418 (if (and (not uncompiled)
14419 (file-exists-p (concat f ".elc")))
14420 (load (concat f ".elc") nil nil t)
14421 (load (concat f ".el") nil nil t)))
14422 files)))
14424 ;;;###autoload
14425 (defun org-customize ()
14426 "Call the customize function with org as argument."
14427 (interactive)
14428 (org-load-modules-maybe)
14429 (org-require-autoloaded-modules)
14430 (customize-browse 'org))
14432 (defun org-create-customize-menu ()
14433 "Create a full customization menu for Org-mode, insert it into the menu."
14434 (interactive)
14435 (org-load-modules-maybe)
14436 (org-require-autoloaded-modules)
14437 (if (fboundp 'customize-menu-create)
14438 (progn
14439 (easy-menu-change
14440 '("Org") "Customize"
14441 `(["Browse Org group" org-customize t]
14442 "--"
14443 ,(customize-menu-create 'org)
14444 ["Set" Custom-set t]
14445 ["Save" Custom-save t]
14446 ["Reset to Current" Custom-reset-current t]
14447 ["Reset to Saved" Custom-reset-saved t]
14448 ["Reset to Standard Settings" Custom-reset-standard t]))
14450 (error "Cannot expand menu (outdated version of cus-edit.el)")))
14452 ;;;; Miscellaneous stuff
14454 ;;; Generally useful functions
14456 (defun org-find-text-property-in-string (prop s)
14457 "Return the first non-nil value of property PROP in string S."
14458 (or (get-text-property 0 prop s)
14459 (get-text-property (or (next-single-property-change 0 prop s) 0)
14460 prop s)))
14462 (defun org-display-warning (message) ;; Copied from Emacs-Muse
14463 "Display the given MESSAGE as a warning."
14464 (if (fboundp 'display-warning)
14465 (display-warning 'org message
14466 (if (featurep 'xemacs)
14467 'warning
14468 :warning))
14469 (let ((buf (get-buffer-create "*Org warnings*")))
14470 (with-current-buffer buf
14471 (goto-char (point-max))
14472 (insert "Warning (Org): " message)
14473 (unless (bolp)
14474 (newline)))
14475 (display-buffer buf)
14476 (sit-for 0))))
14478 (defun org-goto-marker-or-bmk (marker &optional bookmark)
14479 "Go to MARKER, widen if necessary. When marker is not live, try BOOKMARK."
14480 (if (and marker (marker-buffer marker)
14481 (buffer-live-p (marker-buffer marker)))
14482 (progn
14483 (switch-to-buffer (marker-buffer marker))
14484 (if (or (> marker (point-max)) (< marker (point-min)))
14485 (widen))
14486 (goto-char marker)
14487 (org-show-context 'org-goto))
14488 (if bookmark
14489 (bookmark-jump bookmark)
14490 (error "Cannot find location"))))
14492 (defun org-quote-csv-field (s)
14493 "Quote field for inclusion in CSV material."
14496 s))
14498 (defun org-plist-delete (plist property)
14499 "Delete PROPERTY from PLIST.
14500 This is in contrast to merely setting it to 0."
14501 (let (p)
14502 (while plist
14503 (if (not (eq property (car plist)))
14504 (setq p (plist-put p (car plist) (nth 1 plist))))
14505 (setq plist (cddr plist)))
14506 p))
14508 (defun org-force-self-insert (N)
14509 "Needed to enforce self-insert under remapping."
14510 (interactive "p")
14511 (self-insert-command N))
14513 (defun org-string-width (s)
14514 "Compute width of string, ignoring invisible characters.
14515 This ignores character with invisibility property `org-link', and also
14516 characters with property `org-cwidth', because these will become invisible
14517 upon the next fontification round."
14518 (let (b l)
14519 (when (or (eq t buffer-invisibility-spec)
14520 (assq 'org-link buffer-invisibility-spec))
14521 (while (setq b (text-property-any 0 (length s)
14522 'invisible 'org-link s))
14523 (setq s (concat (substring s 0 b)
14524 (substring s (or (next-single-property-change
14525 b 'invisible s) (length s)))))))
14526 (while (setq b (text-property-any 0 (length s) 'org-cwidth t s))
14527 (setq s (concat (substring s 0 b)
14528 (substring s (or (next-single-property-change
14529 b 'org-cwidth s) (length s))))))
14530 (setq l (string-width s) b -1)
14531 (while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s))
14532 (setq l (- l (get-text-property b 'org-dwidth-n s))))
14533 l))
14535 (defun org-get-indentation (&optional line)
14536 "Get the indentation of the current line, interpreting tabs.
14537 When LINE is given, assume it represents a line and compute its indentation."
14538 (if line
14539 (if (string-match "^ *" (org-remove-tabs line))
14540 (match-end 0))
14541 (save-excursion
14542 (beginning-of-line 1)
14544 (current-column))))
14546 (defun org-remove-tabs (s &optional width)
14547 "Replace tabulators in S with spaces.
14548 Assumes that s is a single line, starting in column 0."
14549 (setq width (or width tab-width))
14551 (setq s (replace-match
14552 (make-string
14553 (- (* width (/ (+ (match-beginning 0) width) width))
14554 (match-beginning 0)) ?\ )
14555 t t s)))
14556 s)
14558 (defun org-fix-indentation (line ind)
14559 "Fix indentation in LINE.
14560 IND is a cons cell with target and minimum indentation.
14561 If the current indentation in LINE is smaller than the minimum,
14562 leave it alone. If it is larger than ind, set it to the target."
14563 (let* ((l (org-remove-tabs line))
14564 (i (org-get-indentation l))
14565 (i1 (car ind)) (i2 (cdr ind)))
14566 (if (>= i i2) (setq l (substring line i2)))
14567 (if (> i1 0)
14568 (concat (make-string i1 ?\ ) l)
14569 l)))
14571 (defun org-base-buffer (buffer)
14572 "Return the base buffer of BUFFER, if it has one. Else return the buffer."
14573 (if (not buffer)
14574 buffer
14575 (or (buffer-base-buffer buffer)
14576 buffer)))
14578 (defun org-trim (s)
14579 "Remove whitespace at beginning and end of string."
14582 s)
14584 (defun org-wrap (string &optional width lines)
14585 "Wrap string to either a number of lines, or a width in characters.
14586 If WIDTH is non-nil, the string is wrapped to that width, however many lines
14587 that costs. If there is a word longer than WIDTH, the text is actually
14588 wrapped to the length of that word.
14589 IF WIDTH is nil and LINES is non-nil, the string is forced into at most that
14590 many lines, whatever width that takes.
14591 The return value is a list of lines, without newlines at the end."
14593 (maxword (apply 'max (mapcar 'org-string-width words)))
14594 w ll)
14595 (cond (width
14596 (org-do-wrap words (max maxword width)))
14597 (lines
14598 (setq w maxword)
14599 (setq ll (org-do-wrap words maxword))
14600 (if (<= (length ll) lines)
14601 ll
14602 (setq ll words)
14603 (while (> (length ll) lines)
14604 (setq w (1+ w))
14605 (setq ll (org-do-wrap words w)))
14606 ll))
14607 (t (error "Cannot wrap this")))))
14609 (defun org-do-wrap (words width)
14610 "Create lines of maximum width WIDTH (in characters) from word list WORDS."
14611 (let (lines line)
14612 (while words
14613 (setq line (pop words))
14614 (while (and words (< (+ (length line) (length (car words))) width))
14615 (setq line (concat line " " (pop words))))
14616 (setq lines (push line lines)))
14617 (nreverse lines)))
14619 (defun org-split-string (string &optional separators)
14620 "Splits STRING into substrings at SEPARATORS.
14621 No empty strings are returned if there are matches at the beginning
14622 and end of string."
14624 (start 0)
14625 notfirst
14626 (list nil))
14627 (while (and (string-match rexp string
14628 (if (and notfirst
14629 (= start (match-beginning 0))
14630 (< start (length string)))
14631 (1+ start) start))
14632 (< (match-beginning 0) (length string)))
14633 (setq notfirst t)
14634 (or (eq (match-beginning 0) 0)
14635 (and (eq (match-beginning 0) (match-end 0))
14636 (eq (match-beginning 0) start))
14637 (setq list
14638 (cons (substring string start (match-beginning 0))
14639 list)))
14640 (setq start (match-end 0)))
14641 (or (eq start (length string))
14642 (setq list
14643 (cons (substring string start)
14644 list)))
14645 (nreverse list)))
14647 (defun org-uuidgen-p (s)
14648 "Is S an ID created by UUIDGEN?"
14649 (string-match "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'" (downcase s)))
14651 (defun org-context ()
14652 "Return a list of contexts of the current cursor position.
14653 If several contexts apply, all are returned.
14654 Each context entry is a list with a symbol naming the context, and
14655 two positions indicating start and end of the context. Possible
14656 contexts are:
14658 :headline anywhere in a headline
14659 :headline-stars on the leading stars in a headline
14660 :todo-keyword on a TODO keyword (including DONE) in a headline
14661 :tags on the TAGS in a headline
14662 :priority on the priority cookie in a headline
14663 :item on the first line of a plain list item
14664 :item-bullet on the bullet/number of a plain list item
14665 :checkbox on the checkbox in a plain list item
14666 :table in an org-mode table
14667 :table-special on a special filed in a table
14668 :table-table in a table.el table
14669 :link on a hyperlink
14670 :keyword on a keyword: SCHEDULED, DEADLINE, CLOSE,COMMENT, QUOTE.
14671 :target on a <<target>>
14672 :radio-target on a <<<radio-target>>>
14673 :latex-fragment on a LaTeX fragment
14674 :latex-preview on a LaTeX fragment with overlayed preview image
14676 This function expects the position to be visible because it uses font-lock
14677 faces as a help to recognize the following contexts: :table-special, :link,
14678 and :keyword."
14679 (let* ((f (get-text-property (point) 'face))
14680 (faces (if (listp f) f (list f)))
14681 (p (point)) clist o)
14682 ;; First the large context
14683 (cond
14684 ((org-on-heading-p t)
14685 (push (list :headline (point-at-bol) (point-at-eol)) clist)
14686 (when (progn
14687 (beginning-of-line 1)
14688 (looking-at org-todo-line-tags-regexp))
14689 (push (org-point-in-group p 1 :headline-stars) clist)
14690 (push (org-point-in-group p 2 :todo-keyword) clist)
14691 (push (org-point-in-group p 4 :tags) clist))
14692 (goto-char p)
14695 (push (org-point-in-group p 0 :priority) clist)))
14697 ((org-at-item-p)
14698 (push (org-point-in-group p 2 :item-bullet) clist)
14699 (push (list :item (point-at-bol)
14700 (save-excursion (org-end-of-item) (point)))
14701 clist)
14702 (and (org-at-item-checkbox-p)
14703 (push (org-point-in-group p 0 :checkbox) clist)))
14705 ((org-at-table-p)
14706 (push (list :table (org-table-begin) (org-table-end)) clist)
14707 (if (memq 'org-formula faces)
14708 (push (list :table-special
14709 (previous-single-property-change p 'face)
14710 (next-single-property-change p 'face)) clist)))
14711 ((org-at-table-p 'any)
14712 (push (list :table-table) clist)))
14713 (goto-char p)
14715 ;; Now the small context
14716 (cond
14717 ((org-at-timestamp-p)
14718 (push (org-point-in-group p 0 :timestamp) clist))
14719 ((memq 'org-link faces)
14720 (push (list :link
14721 (previous-single-property-change p 'face)
14722 (next-single-property-change p 'face)) clist))
14723 ((memq 'org-special-keyword faces)
14724 (push (list :keyword
14725 (previous-single-property-change p 'face)
14726 (next-single-property-change p 'face)) clist))
14727 ((org-on-target-p)
14728 (push (org-point-in-group p 0 :target) clist)
14729 (goto-char (1- (match-beginning 0)))
14730 (if (looking-at org-radio-target-regexp)
14731 (push (org-point-in-group p 0 :radio-target) clist))
14732 (goto-char p))
14733 ((setq o (car (delq nil
14734 (mapcar
14735 (lambda (x)
14736 (if (memq x org-latex-fragment-image-overlays) x))
14737 (org-overlays-at (point))))))
14738 (push (list :latex-fragment
14739 (org-overlay-start o) (org-overlay-end o)) clist)
14740 (push (list :latex-preview
14741 (org-overlay-start o) (org-overlay-end o)) clist))
14742 ((org-inside-LaTeX-fragment-p)
14743 ;; FIXME: positions wrong.
14744 (push (list :latex-fragment (point) (point)) clist)))
14746 (setq clist (nreverse (delq nil clist)))
14747 clist))
14749 ;; FIXME: Compare with at-regexp-p Do we need both?
14750 (defun org-in-regexp (re &optional nlines visually)
14751 "Check if point is inside a match of regexp.
14752 Normally only the current line is checked, but you can include NLINES extra
14753 lines both before and after point into the search.
14754 If VISUALLY is set, require that the cursor is not after the match but
14755 really on, so that the block visually is on the match."
14756 (catch 'exit
14757 (let ((pos (point))
14758 (eol (point-at-eol (+ 1 (or nlines 0))))
14759 (inc (if visually 1 0)))
14760 (save-excursion
14761 (beginning-of-line (- 1 (or nlines 0)))
14762 (while (re-search-forward re eol t)
14763 (if (and (<= (match-beginning 0) pos)
14764 (>= (+ inc (match-end 0)) pos))
14765 (throw 'exit (cons (match-beginning 0) (match-end 0)))))))))
14767 (defun org-at-regexp-p (regexp)
14768 "Is point inside a match of REGEXP in the current line?"
14769 (catch 'exit
14770 (save-excursion
14771 (let ((pos (point)) (end (point-at-eol)))
14772 (beginning-of-line 1)
14773 (while (re-search-forward regexp end t)
14774 (if (and (<= (match-beginning 0) pos)
14775 (>= (match-end 0) pos))
14776 (throw 'exit t)))
14777 nil))))
14779 (defun org-occur-in-agenda-files (regexp &optional nlines)
14780 "Call `multi-occur' with buffers for all agenda files."
14782 (let* ((files (org-agenda-files))
14783 (tnames (mapcar 'file-truename files))
14784 (extra org-agenda-text-search-extra-files)
14785 f)
14786 (when (eq (car extra) 'agenda-archives)
14787 (setq extra (cdr extra))
14788 (setq files (org-add-archive-files files)))
14789 (while (setq f (pop extra))
14790 (unless (member (file-truename f) tnames)
14791 (add-to-list 'files f 'append)
14792 (add-to-list 'tnames (file-truename f) 'append)))
14793 (multi-occur
14794 (mapcar (lambda (x) (or (get-file-buffer x) (find-file-noselect x))) files)
14795 regexp)))
14797 (if (boundp 'occur-mode-find-occurrence-hook)
14798 ;; Emacs 23
14799 (add-hook 'occur-mode-find-occurrence-hook
14800 (lambda ()
14801 (when (org-mode-p)
14802 (org-reveal))))
14803 ;; Emacs 22
14804 (defadvice occur-mode-goto-occurrence
14805 (after org-occur-reveal activate)
14806 (and (org-mode-p) (org-reveal)))
14807 (defadvice occur-mode-goto-occurrence-other-window
14808 (after org-occur-reveal activate)
14809 (and (org-mode-p) (org-reveal)))
14810 (defadvice occur-mode-display-occurrence
14811 (after org-occur-reveal activate)
14812 (when (org-mode-p)
14813 (let ((pos (occur-mode-find-occurrence)))
14814 (with-current-buffer (marker-buffer pos)
14815 (save-excursion
14816 (goto-char pos)
14817 (org-reveal)))))))
14819 (defun org-uniquify (list)
14820 "Remove duplicate elements from LIST."
14821 (let (res)
14822 (mapc (lambda (x) (add-to-list 'res x 'append)) list)
14823 res))
14825 (defun org-delete-all (elts list)
14826 "Remove all elements in ELTS from LIST."
14827 (while elts
14828 (setq list (delete (pop elts) list)))
14829 list)
14831 (defun org-back-over-empty-lines ()
14832 "Move backwards over whitespace, to the beginning of the first empty line.
14833 Returns the number of empty lines passed."
14834 (let ((pos (point)))
14836 (beginning-of-line 2)
14837 (goto-char (min (point) pos))
14838 (count-lines (point) pos)))
14840 (defun org-skip-whitespace ()
14843 (defun org-point-in-group (point group &optional context)
14844 "Check if POINT is in match-group GROUP.
14845 If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the
14846 match. If the match group does ot exist or point is not inside it,
14847 return nil."
14848 (and (match-beginning group)
14849 (>= point (match-beginning group))
14850 (<= point (match-end group))
14851 (if context
14852 (list context (match-beginning group) (match-end group))
14853 t)))
14855 (defun org-switch-to-buffer-other-window (&rest args)
14856 "Switch to buffer in a second window on the current frame.
14857 In particular, do not allow pop-up frames."
14858 (let (pop-up-frames special-display-buffer-names special-display-regexps
14859 special-display-function)
14860 (apply 'switch-to-buffer-other-window args)))
14862 (defun org-combine-plists (&rest plists)
14863 "Create a single property list from all plists in PLISTS.
14864 The process starts by copying the first list, and then setting properties
14865 from the other lists. Settings in the last list are the most significant
14866 ones and overrule settings in the other lists."
14867 (let ((rtn (copy-sequence (pop plists)))
14868 p v ls)
14869 (while plists
14870 (setq ls (pop plists))
14871 (while ls
14872 (setq p (pop ls) v (pop ls))
14873 (setq rtn (plist-put rtn p v))))
14874 rtn))
14876 (defun org-move-line-down (arg)
14877 "Move the current line down. With prefix argument, move it past ARG lines."
14878 (interactive "p")
14879 (let ((col (current-column))
14880 beg end pos)
14881 (beginning-of-line 1) (setq beg (point))
14882 (beginning-of-line 2) (setq end (point))
14883 (beginning-of-line (+ 1 arg))
14884 (setq pos (move-marker (make-marker) (point)))
14885 (insert (delete-and-extract-region beg end))
14886 (goto-char pos)
14887 (org-move-to-column col)))
14889 (defun org-move-line-up (arg)
14890 "Move the current line up. With prefix argument, move it past ARG lines."
14891 (interactive "p")
14892 (let ((col (current-column))
14893 beg end pos)
14894 (beginning-of-line 1) (setq beg (point))
14895 (beginning-of-line 2) (setq end (point))
14896 (beginning-of-line (- arg))
14897 (setq pos (move-marker (make-marker) (point)))
14898 (insert (delete-and-extract-region beg end))
14899 (goto-char pos)
14900 (org-move-to-column col)))
14902 (defun org-replace-escapes (string table)
14903 "Replace %-escapes in STRING with values in TABLE.
14905 The sequences in STRING may contain normal field width and padding information,
14907 so values can contain further %-escapes if they are define later in TABLE."
14908 (let ((case-fold-search nil)
14909 e re rpl)
14910 (while (setq e (pop table))
14911 (setq re (concat "%-?[0-9.]*" (substring (car e) 1)))
14912 (while (string-match re string)
14913 (setq rpl (format (concat (substring (match-string 0 string) 0 -1) "s")
14914 (cdr e)))
14915 (setq string (replace-match rpl t t string))))
14916 string))
14919 (defun org-sublist (list start end)
14920 "Return a section of LIST, from START to END.
14921 Counting starts at 1."
14922 (let (rtn (c start))
14923 (setq list (nthcdr (1- start) list))
14924 (while (and list (<= c end))
14925 (push (pop list) rtn)
14926 (setq c (1+ c)))
14927 (nreverse rtn)))
14929 (defun org-find-base-buffer-visiting (file)
14930 "Like `find-buffer-visiting' but alway return the base buffer and
14931 not an indirect buffer."
14932 (let ((buf (find-buffer-visiting file)))
14933 (if buf
14934 (or (buffer-base-buffer buf) buf)
14935 nil)))
14937 (defun org-image-file-name-regexp (&optional extensions)
14938 "Return regexp matching the file names of images.
14939 If EXTENSIONS is given, only match these."
14940 (if (and (not extensions) (fboundp 'image-file-name-regexp))
14941 (image-file-name-regexp)
14942 (let ((image-file-name-extensions
14943 (or extensions
14944 '("png" "jpeg" "jpg" "gif" "tiff" "tif"
14945 "xbm" "xpm" "pbm" "pgm" "ppm"))))
14947 (regexp-opt (nconc (mapcar 'upcase
14948 image-file-name-extensions)
14949 image-file-name-extensions)
14950 t)
14953 (defun org-file-image-p (file &optional extensions)
14954 "Return non-nil if FILE is an image."
14955 (save-match-data
14956 (string-match (org-image-file-name-regexp extensions) file)))
14958 (defun org-get-cursor-date ()
14959 "Return the date at cursor in as a time.
14960 This works in the calendar and in the agenda, anywhere else it just
14961 returns the current time."
14962 (let (date day defd)
14963 (cond
14964 ((eq major-mode 'calendar-mode)
14965 (setq date (calendar-cursor-to-date)
14966 defd (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
14967 ((eq major-mode 'org-agenda-mode)
14968 (setq day (get-text-property (point) 'day))
14969 (if day
14970 (setq date (calendar-gregorian-from-absolute day)
14971 defd (encode-time 0 0 0 (nth 1 date) (nth 0 date)
14972 (nth 2 date))))))
14973 (or defd (current-time))))
14975 (defvar org-agenda-action-marker (make-marker)
14976 "Marker pointing to the entry for the next agenda action.")
14978 (defun org-mark-entry-for-agenda-action ()
14979 "Mark the current entry as target of an agenda action.
14980 Agenda actions are actions executed from the agenda with the key `k',
14981 which make use of the date at the cursor."
14982 (interactive)
14983 (move-marker org-agenda-action-marker
14984 (save-excursion (org-back-to-heading t) (point))
14985 (current-buffer))
14986 (message
14987 "Entry marked for action; press `k' at desired date in agenda or calendar"))
14989 ;;; Paragraph filling stuff.
14990 ;; We want this to be just right, so use the full arsenal.
14992 (defun org-indent-line-function ()
14993 "Indent line like previous, but further if previous was headline or item."
14994 (interactive)
14995 (let* ((pos (point))
14996 (itemp (org-at-item-p))
14998 column bpos bcol tpos tcol bullet btype bullet-type)
14999 ;; Find the previous relevant line
15000 (beginning-of-line 1)
15001 (cond
15002 ((looking-at "#") (setq column 0))
15005 (save-excursion (re-search-backward org-drawer-regexp nil t)))
15006 (save-excursion
15007 (goto-char (1- (match-beginning 1)))
15008 (setq column (current-column))))
15009 (t
15010 (beginning-of-line 0)
15013 (not (looking-at org-drawer-regexp)))
15014 (beginning-of-line 0))
15015 (cond
15017 (if (not org-adapt-indentation)
15018 (setq column 0)
15019 (goto-char (match-end 0))
15020 (setq column (current-column))))
15021 ((looking-at org-drawer-regexp)
15022 (goto-char (1- (match-beginning 1)))
15023 (setq column (current-column)))
15025 (goto-char (match-end 1))
15026 (setq column (current-column)))
15027 ((org-in-item-p)
15028 (org-beginning-of-item)
15030 (setq bpos (match-beginning 1) tpos (match-end 0)
15031 bcol (progn (goto-char bpos) (current-column))
15032 tcol (progn (goto-char tpos) (current-column))
15033 bullet (match-string 1)
15034 bullet-type (if (string-match "[0-9]" bullet) "n" bullet))
15035 (if (> tcol (+ bcol org-description-max-indent))
15036 (setq tcol (+ bcol 5)))
15037 (if (not itemp)
15038 (setq column tcol)
15039 (goto-char pos)
15040 (beginning-of-line 1)
15042 (progn
15044 (setq bullet (match-string 1)
15045 btype (if (string-match "[0-9]" bullet) "n" bullet))
15046 (setq column (if (equal btype bullet-type) bcol tcol)))
15047 (setq column (org-get-indentation)))))
15048 (t (setq column (org-get-indentation))))))
15049 (goto-char pos)
15050 (if (<= (current-column) (current-indentation))
15051 (org-indent-line-to column)
15052 (save-excursion (org-indent-line-to column)))
15053 (setq column (current-column))
15054 (beginning-of-line 1)
15055 (if (looking-at
15058 (match-string 2) (match-string 3)))
15059 t nil))
15060 (org-move-to-column column)))
15062 (defun org-set-autofill-regexps ()
15063 (interactive)
15064 ;; In the paragraph separator we include headlines, because filling
15065 ;; text in a line directly attached to a headline would otherwise
15066 ;; fill the headline as well.
15069 ;; The paragraph starter includes hand-formatted lists.
15070 (org-set-local 'paragraph-start
15072 ;; Inhibit auto-fill for headers, tables and fixed-width lines.
15073 ;; But only if the user has not turned off tables or fixed-width regions
15074 (org-set-local
15075 'auto-fill-inhibit-regexp
15078 (if (or org-enable-table-editor org-enable-fixed-width-editor)
15079 (concat
15081 (if org-enable-table-editor "|" "")
15082 (if org-enable-fixed-width-editor ":" "")
15083 "]"))))
15084 ;; We use our own fill-paragraph function, to make sure that tables
15085 ;; and fixed-width regions are not wrapped. That function will pass
15086 ;; through to `fill-paragraph' when appropriate.
15087 (org-set-local 'fill-paragraph-function 'org-fill-paragraph)
15088 ; Adaptive filling: To get full control, first make sure that
15089 ;; `adaptive-fill-regexp' never matches. Then install our own matcher.
15091 (org-set-local 'adaptive-fill-function
15092 'org-adaptive-fill-function)
15093 (org-set-local
15094 'align-mode-rules-list
15095 '((org-in-buffer-settings
15097 (modes . '(org-mode))))))
15099 (defun org-fill-paragraph (&optional justify)
15100 "Re-align a table, pass through to fill-paragraph if no table."
15101 (let ((table-p (org-at-table-p))
15102 (table.el-p (org-at-table.el-p)))
15103 (cond ((and (equal (char-after (point-at-bol)) ?*)
15104 (save-excursion (goto-char (point-at-bol))
15105 (looking-at outline-regexp)))
15106 t) ; skip headlines
15107 (table.el-p t) ; skip table.el tables
15108 (table-p (org-table-align) t) ; align org-mode tables
15109 (t nil)))) ; call paragraph-fill
15111 ;; For reference, this is the default value of adaptive-fill-regexp
15114 (defun org-adaptive-fill-function ()
15115 "Return a fill prefix for org-mode files.
15116 In particular, this makes sure hanging paragraphs for hand-formatted lists
15117 work correctly."
15119 (match-string 0))
15121 (save-excursion
15122 (if (> (match-end 1) (+ (match-beginning 1)
15123 org-description-max-indent))
15124 (goto-char (+ (match-beginning 1) 5))
15125 (goto-char (match-end 0)))
15126 (make-string (current-column) ?\ )))
15128 (save-excursion
15129 (goto-char (match-end 0))
15130 (make-string (current-column) ?\ )))
15131 (t nil)))
15133 ;;; Other stuff.
15135 (defun org-toggle-fixed-width-section (arg)
15136 "Toggle the fixed-width export.
15137 If there is no active region, the QUOTE keyword at the current headline is
15138 inserted or removed. When present, it causes the text between this headline
15139 and the next to be exported as fixed-width text, and unmodified.
15140 If there is an active region, this command adds or removes a colon as the
15141 first character of this line. If the first character of a line is a colon,
15142 this line is also exported in fixed-width font."
15143 (interactive "P")
15144 (let* ((cc 0)
15145 (regionp (org-region-active-p))
15146 (beg (if regionp (region-beginning) (point)))
15147 (end (if regionp (region-end)))
15148 (nlines (or arg (if (and beg end) (count-lines beg end) 1)))
15149 (case-fold-search nil)
15151 off)
15152 (if regionp
15153 (save-excursion
15154 (goto-char beg)
15155 (setq cc (current-column))
15156 (beginning-of-line 1)
15157 (setq off (looking-at re))
15158 (while (> nlines 0)
15159 (setq nlines (1- nlines))
15160 (beginning-of-line 1)
15161 (cond
15162 (arg
15163 (org-move-to-column cc t)
15165 (forward-line -1))
15166 ((and off (looking-at re))
15167 (replace-match "" t t nil 1))
15168 ((not off) (org-move-to-column cc t) (insert ":")))
15169 (forward-line 1)))
15170 (save-excursion
15171 (org-back-to-heading)
15172 (if (looking-at (concat outline-regexp
15174 (replace-match "" t t nil 1)
15175 (if (looking-at outline-regexp)
15176 (progn
15177 (goto-char (match-end 0))
15178 (insert org-quote-string " "))))))))
15180 ;;;; Functions extending outline functionality
15182 (defun org-beginning-of-line (&optional arg)
15183 "Go to the beginning of the current line. If that is invisible, continue
15184 to a visible line beginning. This makes the function of C-a more intuitive.
15185 If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the
15186 first attempt, and only move to after the tags when the cursor is already
15187 beyond the end of the headline."
15188 (interactive "P")
15189 (let ((pos (point))
15190 (special (if (consp org-special-ctrl-a/e)
15191 (car org-special-ctrl-a/e)
15192 org-special-ctrl-a/e))
15193 refpos)
15194 (beginning-of-line 1)
15195 (if (and arg (fboundp 'move-beginning-of-line))
15196 (call-interactively 'move-beginning-of-line)
15197 (if (bobp)
15198 nil
15199 (backward-char 1)
15200 (if (org-invisible-p)
15201 (while (and (not (bobp)) (org-invisible-p))
15202 (backward-char 1)
15203 (beginning-of-line 1))
15204 (forward-char 1))))
15205 (when special
15206 (cond
15207 ((and (looking-at org-complex-heading-regexp)
15208 (= (char-after (match-end 1)) ?\ ))
15209 (setq refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1)))
15210 (point-at-eol)))
15211 (goto-char
15212 (if (eq special t)
15213 (cond ((> pos refpos) refpos)
15214 ((= pos (point)) refpos)
15215 (t (point)))
15216 (cond ((> pos (point)) (point))
15217 ((not (eq last-command this-command)) (point))
15218 (t refpos)))))
15219 ((org-at-item-p)
15220 (goto-char
15221 (if (eq special t)
15222 (cond ((> pos (match-end 4)) (match-end 4))
15223 ((= pos (point)) (match-end 4))
15224 (t (point)))
15225 (cond ((> pos (point)) (point))
15226 ((not (eq last-command this-command)) (point))
15227 (t (match-end 4))))))))
15228 (org-no-warnings
15229 (and (featurep 'xemacs) (setq zmacs-region-stays t)))))
15231 (defun org-end-of-line (&optional arg)
15232 "Go to the end of the line.
15233 If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the
15234 first attempt, and only move to after the tags when the cursor is already
15235 beyond the end of the headline."
15236 (interactive "P")
15237 (let ((special (if (consp org-special-ctrl-a/e)
15238 (cdr org-special-ctrl-a/e)
15239 org-special-ctrl-a/e)))
15240 (if (or (not special)
15241 (not (org-on-heading-p))
15242 arg)
15243 (call-interactively (if (fboundp 'move-end-of-line)
15244 'move-end-of-line
15245 'end-of-line))
15246 (let ((pos (point)))
15247 (beginning-of-line 1)
15249 (if (eq special t)
15250 (if (or (< pos (match-beginning 1))
15251 (= pos (match-end 0)))
15252 (goto-char (match-beginning 1))
15253 (goto-char (match-end 0)))
15254 (if (or (< pos (match-end 0)) (not (eq this-command last-command)))
15255 (goto-char (match-end 0))
15256 (goto-char (match-beginning 1))))
15257 (call-interactively (if (fboundp 'move-end-of-line)
15258 'move-end-of-line
15259 'end-of-line)))))
15260 (org-no-warnings
15261 (and (featurep 'xemacs) (setq zmacs-region-stays t)))))
15263 (define-key org-mode-map "\C-a" 'org-beginning-of-line)
15264 (define-key org-mode-map "\C-e" 'org-end-of-line)
15266 (defun org-kill-line (&optional arg)
15267 "Kill line, to tags or end of line."
15268 (interactive "P")
15269 (cond
15270 ((or (not org-special-ctrl-k)
15271 (bolp)
15272 (not (org-on-heading-p)))
15273 (call-interactively 'kill-line))
15275 (kill-region (point) (match-beginning 1))
15276 (org-set-tags nil t))
15277 (t (kill-region (point) (point-at-eol)))))
15279 (define-key org-mode-map "\C-k" 'org-kill-line)
15281 (defun org-yank (&optional arg)
15282 "Yank. If the kill is a subtree, treat it specially.
15283 This command will look at the current kill and check if is a single
15284 subtree, or a series of subtrees[1]. If it passes the test, and if the
15285 cursor is at the beginning of a line or after the stars of a currently
15286 empty headline, then the yank is handled specially. How exactly depends
15287 on the value of the following variables, both set by default.
15289 org-yank-folded-subtrees
15290 When set, the subtree(s) will be folded after insertion, but only
15291 if doing so would now swallow text after the yanked text.
15293 org-yank-adjusted-subtrees
15294 When set, the subtree will be promoted or demoted in order to
15295 fit into the local outline tree structure, which means that the level
15296 will be adjusted so that it becomes the smaller one of the two
15297 *visible* surrounding headings.
15299 Any prefix to this command will cause `yank' to be called directly with
15300 no special treatment. In particular, a simple `C-u' prefix will just
15301 plainly yank the text as it is.
15303 \[1] Basically, the test checks if the first non-white line is a heading
15304 and if there are no other headings with fewer stars."
15305 (interactive "P")
15306 (setq this-command 'yank)
15307 (if arg
15308 (call-interactively 'yank)
15309 (let ((subtreep ; is kill a subtree, and the yank position appropriate?
15310 (and (org-kill-is-subtree-p)
15311 (or (bolp)
15313 (string-match
15315 (buffer-substring (point-at-bol) (point)))))))
15316 swallowp)
15317 (cond
15318 ((and subtreep org-yank-folded-subtrees)
15319 (let ((beg (point))
15320 end)
15321 (if (and subtreep org-yank-adjusted-subtrees)
15322 (org-paste-subtree nil nil 'for-yank)
15323 (call-interactively 'yank))
15324 (setq end (point))
15325 (goto-char beg)
15326 (when (and (bolp) subtreep
15327 (not (setq swallowp
15328 (org-yank-folding-would-swallow-text beg end))))
15329 (or (looking-at outline-regexp)
15330 (re-search-forward (concat "^" outline-regexp) end t))
15331 (while (and (< (point) end) (looking-at outline-regexp))
15332 (hide-subtree)
15333 (org-cycle-show-empty-lines 'folded)
15334 (condition-case nil
15335 (outline-forward-same-level 1)
15336 (error (goto-char end)))))
15337 (when swallowp
15338 (message
15339 "Yanked text not folded because that would swallow text"))
15340 (goto-char end)
15342 (beginning-of-line 1)
15343 (push-mark beg 'nomsg)))
15344 ((and subtreep org-yank-adjusted-subtrees)
15345 (let ((beg (point-at-bol)))
15346 (org-paste-subtree nil nil 'for-yank)
15347 (push-mark beg 'nomsg)))
15348 (t
15349 (call-interactively 'yank))))))
15351 (defun org-yank-folding-would-swallow-text (beg end)
15352 "Would hide-subtree at BEG swallow any text after END?"
15353 (let (level)
15354 (save-excursion
15355 (goto-char beg)
15356 (when (or (looking-at outline-regexp)
15357 (re-search-forward (concat "^" outline-regexp) end t))
15358 (setq level (org-outline-level)))
15359 (goto-char end)
15361 (if (or (eobp)
15362 (and (bolp) (looking-at org-outline-regexp)
15363 (<= (org-outline-level) level)))
15364 nil ; Nothing would be swallowed
15365 t)))) ; something would swallow
15367 (define-key org-mode-map "\C-y" 'org-yank)
15369 (defun org-invisible-p ()
15370 "Check if point is at a character currently not visible."
15371 ;; Early versions of noutline don't have `outline-invisible-p'.
15372 (if (fboundp 'outline-invisible-p)
15373 (outline-invisible-p)
15374 (get-char-property (point) 'invisible)))
15376 (defun org-invisible-p2 ()
15377 "Check if point is at a character currently not visible."
15378 (save-excursion
15379 (if (and (eolp) (not (bobp))) (backward-char 1))
15380 ;; Early versions of noutline don't have `outline-invisible-p'.
15381 (if (fboundp 'outline-invisible-p)
15382 (outline-invisible-p)
15383 (get-char-property (point) 'invisible))))
15385 (defun org-back-to-heading (&optional invisible-ok)
15386 "Call `outline-back-to-heading', but provide a better error message."
15387 (condition-case nil
15388 (outline-back-to-heading invisible-ok)
15389 (error (error "Before first headline at position %d in buffer %s"
15390 (point) (current-buffer)))))
15392 (defun org-before-first-heading-p ()
15393 "Before first heading?"
15394 (save-excursion
15397 (defalias 'org-on-heading-p 'outline-on-heading-p)
15398 (defalias 'org-at-heading-p 'outline-on-heading-p)
15399 (defun org-at-heading-or-item-p ()
15400 (or (org-on-heading-p) (org-at-item-p)))
15402 (defun org-on-target-p ()
15403 (or (org-in-regexp org-radio-target-regexp)
15404 (org-in-regexp org-target-regexp)))
15406 (defun org-up-heading-all (arg)
15407 "Move to the heading line of which the present line is a subheading.
15408 This function considers both visible and invisible heading lines.
15409 With argument, move up ARG levels."
15410 (if (fboundp 'outline-up-heading-all)
15411 (outline-up-heading-all arg) ; emacs 21 version of outline.el
15412 (outline-up-heading arg t))) ; emacs 22 version of outline.el
15414 (defun org-up-heading-safe ()
15415 "Move to the heading line of which the present line is a subheading.
15416 This version will not throw an error. It will return the level of the
15417 headline found, or nil if no higher level is found."
15418 (let (start-level re)
15419 (org-back-to-heading t)
15420 (setq start-level (funcall outline-level))
15421 (if (equal start-level 1)
15422 nil
15424 (if (re-search-backward re nil t)
15425 (funcall outline-level)))))
15427 (defun org-first-sibling-p ()
15428 "Is this heading the first child of its parents?"
15429 (interactive)
15430 (let ((re (concat "^" outline-regexp))
15431 level l)
15432 (unless (org-at-heading-p t)
15433 (error "Not at a heading"))
15434 (setq level (funcall outline-level))
15435 (save-excursion
15436 (if (not (re-search-backward re nil t))
15437 t
15438 (setq l (funcall outline-level))
15439 (< l level)))))
15441 (defun org-goto-sibling (&optional previous)
15442 "Goto the next sibling, even if it is invisible.
15443 When PREVIOUS is set, go to the previous sibling instead. Returns t
15444 when a sibling was found. When none is found, return nil and don't
15445 move point."
15446 (let ((fun (if previous 're-search-backward 're-search-forward))
15447 (pos (point))
15448 (re (concat "^" outline-regexp))
15449 level l)
15450 (when (condition-case nil (org-back-to-heading t) (error nil))
15451 (setq level (funcall outline-level))
15452 (catch 'exit
15453 (or previous (forward-char 1))
15454 (while (funcall fun re nil t)
15455 (setq l (funcall outline-level))
15456 (when (< l level) (goto-char pos) (throw 'exit nil))
15457 (when (= l level) (goto-char (match-beginning 0)) (throw 'exit t)))
15458 (goto-char pos)
15459 nil))))
15461 (defun org-show-siblings ()
15462 "Show all siblings of the current headline."
15463 (save-excursion
15464 (while (org-goto-sibling) (org-flag-heading nil)))
15465 (save-excursion
15466 (while (org-goto-sibling 'previous)
15467 (org-flag-heading nil))))
15469 (defun org-show-hidden-entry ()
15470 "Show an entry where even the heading is hidden."
15471 (save-excursion
15472 (org-show-entry)))
15474 (defun org-flag-heading (flag &optional entry)
15475 "Flag the current heading. FLAG non-nil means make invisible.
15476 When ENTRY is non-nil, show the entire entry."
15477 (save-excursion
15478 (org-back-to-heading t)
15479 ;; Check if we should show the entire entry
15480 (if entry
15481 (progn
15482 (org-show-entry)
15483 (save-excursion
15484 (and (outline-next-heading)
15485 (org-flag-heading nil))))
15486 (outline-flag-region (max (point-min) (1- (point)))
15487 (save-excursion (outline-end-of-heading) (point))
15488 flag))))
15490 (defun org-forward-same-level (arg)
15491 "Move forward to the ARG'th subheading at same level as this one.
15492 Stop at the first and last subheadings of a superior heading.
15493 This is like outline-forward-same-level, but invisible headings are ok."
15494 (interactive "p")
15495 (org-back-to-heading t)
15496 (while (> arg 0)
15497 (let ((point-to-move-to (save-excursion
15498 (org-get-next-sibling))))
15499 (if point-to-move-to
15500 (progn
15501 (goto-char point-to-move-to)
15502 (setq arg (1- arg)))
15503 (progn
15504 (setq arg 0)
15505 (error "No following same-level heading"))))))
15507 (defun org-get-next-sibling ()
15508 "Move to next heading of the same level, and return point.
15509 If there is no such heading, return nil.
15510 This is like outline-next-sibling, but invisible headings are ok."
15511 (let ((level (funcall outline-level)))
15512 (outline-next-heading)
15513 (while (and (not (eobp)) (> (funcall outline-level) level))
15514 (outline-next-heading))
15515 (if (or (eobp) (< (funcall outline-level) level))
15516 nil
15517 (point))))
15519 (defun org-end-of-subtree (&optional invisible-OK to-heading)
15520 ;; This is an exact copy of the original function, but it uses
15521 ;; `org-back-to-heading', to make it work also in invisible
15522 ;; trees. And is uses an invisible-OK argument.
15523 ;; Under Emacs this is not needed, but the old outline.el needs this fix.
15524 (org-back-to-heading invisible-OK)
15525 (let ((first t)
15526 (level (funcall outline-level)))
15527 (while (and (not (eobp))
15528 (or first (> (funcall outline-level) level)))
15529 (setq first nil)
15530 (outline-next-heading))
15531 (unless to-heading
15533 (progn
15534 ;; Go to end of line before heading
15535 (forward-char -1)
15537 ;; leave blank line before heading
15538 (forward-char -1))))))
15539 (point))
15541 (defun org-show-subtree ()
15542 "Show everything after this heading at deeper levels."
15543 (outline-flag-region
15544 (point)
15545 (save-excursion
15546 (outline-end-of-subtree) (outline-next-heading) (point))
15547 nil))
15549 (defun org-show-entry ()
15550 "Show the body directly following this heading.
15551 Show the heading too, if it is currently invisible."
15552 (interactive)
15553 (save-excursion
15554 (condition-case nil
15555 (progn
15556 (org-back-to-heading t)
15557 (outline-flag-region
15558 (max (point-min) (1- (point)))
15559 (save-excursion
15560 (if (re-search-forward
15562 (match-beginning 1)
15563 (point-max)))
15564 nil))
15565 (error nil))))
15567 (defun org-make-options-regexp (kwds &optional extra)
15568 "Make a regular expression for keyword lines."
15569 (concat
15570 "^"
15577 ;; Make isearch reveal the necessary context
15578 (defun org-isearch-end ()
15579 "Reveal context after isearch exits."
15580 (when isearch-success ; only if search was successful
15581 (if (featurep 'xemacs)
15582 ;; Under XEmacs, the hook is run in the correct place,
15583 ;; we directly show the context.
15584 (org-show-context 'isearch)
15585 ;; In Emacs the hook runs *before* restoring the overlays.
15586 ;; So we have to use a one-time post-command-hook to do this.
15587 ;; (Emacs 22 has a special variable, see function `org-mode')
15588 (unless (and (boundp 'isearch-mode-end-hook-quit)
15589 isearch-mode-end-hook-quit)
15590 ;; Only when the isearch was not quitted.
15591 (org-add-hook 'post-command-hook 'org-isearch-post-command
15592 'append 'local)))))
15594 (defun org-isearch-post-command ()
15595 "Remove self from hook, and show context."
15596 (remove-hook 'post-command-hook 'org-isearch-post-command 'local)
15597 (org-show-context 'isearch))
15600 ;;;; Integration with and fixes for other packages
15602 ;;; Imenu support
15604 (defvar org-imenu-markers nil
15605 "All markers currently used by Imenu.")
15606 (make-variable-buffer-local 'org-imenu-markers)
15608 (defun org-imenu-new-marker (&optional pos)
15609 "Return a new marker for use by Imenu, and remember the marker."
15610 (let ((m (make-marker)))
15611 (move-marker m (or pos (point)))
15612 (push m org-imenu-markers)
15613 m))
15615 (defun org-imenu-get-tree ()
15616 "Produce the index for Imenu."
15617 (mapc (lambda (x) (move-marker x nil)) org-imenu-markers)
15618 (setq org-imenu-markers nil)
15619 (let* ((n org-imenu-depth)
15620 (re (concat "^" outline-regexp))
15621 (subs (make-vector (1+ n) nil))
15622 (last-level 0)
15623 m level head)
15624 (save-excursion
15625 (save-restriction
15626 (widen)
15627 (goto-char (point-max))
15628 (while (re-search-backward re nil t)
15629 (setq level (org-reduced-level (funcall outline-level)))
15630 (when (<= level n)
15631 (looking-at org-complex-heading-regexp)
15632 (setq head (org-link-display-format
15633 (org-match-string-no-properties 4))
15634 m (org-imenu-new-marker))
15635 (org-add-props head nil 'org-imenu-marker m 'org-imenu t)
15636 (if (>= level last-level)
15637 (push (cons head m) (aref subs level))
15638 (push (cons head (aref subs (1+ level))) (aref subs level))
15639 (loop for i from (1+ level) to n do (aset subs i nil)))
15640 (setq last-level level)))))
15641 (aref subs 1)))
15643 (eval-after-load "imenu"
15644 '(progn
15645 (add-hook 'imenu-after-jump-hook
15646 (lambda ()
15647 (if (eq major-mode 'org-mode)
15648 (org-show-context 'org-goto))))))
15650 (defun org-link-display-format (link)
15651 "Replace a link with either the description, or the link target
15652 if no description is present"
15653 (save-match-data
15654 (if (string-match org-bracket-link-analytic-regexp link)
15655 (replace-match (or (match-string 5 link)
15656 (concat (match-string 1 link)
15657 (match-string 3 link)))
15658 nil nil link)
15659 link)))
15661 ;; Speedbar support
15663 (defvar org-speedbar-restriction-lock-overlay (org-make-overlay 1 1)
15664 "Overlay marking the agenda restriction line in speedbar.")
15665 (org-overlay-put org-speedbar-restriction-lock-overlay
15666 'face 'org-agenda-restriction-lock)
15667 (org-overlay-put org-speedbar-restriction-lock-overlay
15668 'help-echo "Agendas are currently limited to this item.")
15669 (org-detach-overlay org-speedbar-restriction-lock-overlay)
15671 (defun org-speedbar-set-agenda-restriction ()
15672 "Restrict future agenda commands to the location at point in speedbar.
15674 (interactive)
15675 (require 'org-agenda)
15676 (let (p m tp np dir txt)
15677 (cond
15678 ((setq p (text-property-any (point-at-bol) (point-at-eol)
15679 'org-imenu t))
15680 (setq m (get-text-property p 'org-imenu-marker))
15681 (save-excursion
15682 (save-restriction
15683 (set-buffer (marker-buffer m))
15684 (goto-char m)
15685 (org-agenda-set-restriction-lock 'subtree))))
15686 ((setq p (text-property-any (point-at-bol) (point-at-eol)
15687 'speedbar-function 'speedbar-find-file))
15688 (setq tp (previous-single-property-change
15689 (1+ p) 'speedbar-function)
15690 np (next-single-property-change
15691 tp 'speedbar-function)
15692 dir (speedbar-line-directory)
15693 txt (buffer-substring-no-properties (or tp (point-min))
15694 (or np (point-max))))
15695 (save-excursion
15696 (save-restriction
15697 (set-buffer (find-file-noselect
15698 (let ((default-directory dir))
15699 (expand-file-name txt))))
15700 (unless (org-mode-p)
15701 (error "Cannot restrict to non-Org-mode file"))
15702 (org-agenda-set-restriction-lock 'file))))
15703 (t (error "Don't know how to restrict Org-mode's agenda")))
15704 (org-move-overlay org-speedbar-restriction-lock-overlay
15705 (point-at-bol) (point-at-eol))
15706 (setq current-prefix-arg nil)
15707 (org-agenda-maybe-redo)))
15709 (eval-after-load "speedbar"
15710 '(progn
15711 (speedbar-add-supported-extension ".org")
15712 (define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction)
15713 (define-key speedbar-file-key-map "\C-c\C-x<" 'org-speedbar-set-agenda-restriction)
15714 (define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock)
15715 (define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
15716 (add-hook 'speedbar-visiting-tag-hook
15717 (lambda () (and (org-mode-p) (org-show-context 'org-goto))))))
15720 ;;; Fixes and Hacks for problems with other packages
15722 ;; Make flyspell not check words in links, to not mess up our keymap
15723 (defun org-mode-flyspell-verify ()
15724 "Don't let flyspell put overlays at active buttons."
15725 (not (get-text-property (point) 'keymap)))
15727 ;; Make `bookmark-jump' show the jump location if it was hidden.
15728 (eval-after-load "bookmark"
15729 '(if (boundp 'bookmark-after-jump-hook)
15730 ;; We can use the hook
15731 (add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide)
15732 ;; Hook not available, use advice
15733 (defadvice bookmark-jump (after org-make-visible activate)
15734 "Make the position visible."
15735 (org-bookmark-jump-unhide))))
15737 ;; Make sure saveplace show the location if it was hidden
15738 (eval-after-load "saveplace"
15739 '(defadvice save-place-find-file-hook (after org-make-visible activate)
15740 "Make the position visible."
15741 (org-bookmark-jump-unhide)))
15743 (defun org-bookmark-jump-unhide ()
15744 "Unhide the current position, to show the bookmark location."
15745 (and (org-mode-p)
15746 (or (org-invisible-p)
15747 (save-excursion (goto-char (max (point-min) (1- (point))))
15748 (org-invisible-p)))
15749 (org-show-context 'bookmark-jump)))
15751 ;; Make session.el ignore our circular variable
15752 (eval-after-load "session"
15753 '(add-to-list 'session-globals-exclude 'org-mark-ring))
15755 ;;;; Experimental code
15757 (defun org-closed-in-range ()
15758 "Sparse tree of items closed in a certain time range.
15759 Still experimental, may disappear in the future."
15760 (interactive)
15761 ;; Get the time interval from the user.
15762 (let* ((time1 (time-to-seconds
15763 (org-read-date nil 'to-time nil "Starting date: ")))
15764 (time2 (time-to-seconds
15765 (org-read-date nil 'to-time nil "End date:")))
15766 ;; callback function
15767 (callback (lambda ()
15768 (let ((time
15769 (time-to-seconds
15770 (apply 'encode-time
15771 (org-parse-time-string
15772 (match-string 1))))))
15773 ;; check if time in interval
15774 (and (>= time time1) (<= time time2))))))
15775 ;; make tree, check each match with the callback
15779 ;;;; Finish up
15781 (provide 'org)
15783 (run-hooks 'org-load-hook)
15785 ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
15787 ;;; org.el ends here