| blob | 4b177c1f7d05fec400bfda1c8f3dccd2a88f2eaa |
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 Free Software Foundation, Inc.
4 ;;
5 ;; Author: Carsten Dominik <dominik at science dot uva dot nl>
6 ;; Keywords: outlines, hypermedia, calendar, wp
7 ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
8 ;; Version: 4.72
9 ;;
10 ;; This file is part of GNU Emacs.
11 ;;
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25 ;; Boston, MA 02110-1301, USA.
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27 ;;
28 ;;; Commentary:
29 ;;
30 ;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing
31 ;; project planning with a fast and effective plain-text system.
32 ;;
33 ;; Org-mode develops organizational tasks around NOTES files that contain
34 ;; information about projects as plain text. Org-mode is implemented on
35 ;; top of outline-mode, which makes it possible to keep the content of
36 ;; large files well structured. Visibility cycling and structure editing
37 ;; help to work with the tree. Tables are easily created with a built-in
38 ;; table editor. Org-mode supports ToDo items, deadlines, time stamps,
39 ;; and scheduling. It dynamically compiles entries into an agenda that
40 ;; utilizes and smoothly integrates much of the Emacs calendar and diary.
41 ;; Plain text URL-like links connect to websites, emails, Usenet
42 ;; messages, BBDB entries, and any files related to the projects. For
43 ;; printing and sharing of notes, an Org-mode file can be exported as a
44 ;; structured ASCII file, as HTML, or (todo and agenda items only) as an
45 ;; iCalendar file. It can also serve as a publishing tool for a set of
46 ;; linked webpages.
47 ;;
48 ;; Installation and Activation
49 ;; ---------------------------
50 ;; See the corresponding sections in the manual at
51 ;;
52 ;; http://staff.science.uva.nl/~dominik/Tools/org/org.html#Installation
53 ;;
54 ;; Documentation
55 ;; -------------
56 ;; The documentation of Org-mode can be found in the TeXInfo file. The
57 ;; distribution also contains a PDF version of it. At the homepage of
58 ;; Org-mode, you can read the same text online as HTML. There is also an
59 ;; excellent reference card made by Philip Rooke. This card can be found
60 ;; in the etc/ directory of Emacs 22.
61 ;;
62 ;; A list of recent changes can be found at
63 ;; http://www.astro.uva.nl/~dominik/Tools/org/Changes
64 ;;
65 ;;; Code:
67 ;;;; Require other packages
73 ;; For XEmacs, noutline is not yet provided by outline.el, so arrange for
74 ;; the file noutline.el being loaded.
76 ;; We require noutline, which might be provided in outline.el
78 ;; Other stuff we need.
82 ;;;; Customization variables
84 ;;; Version
92 ;;; Compatibility constants
100 ;;; The custom variables
103 "Outline-based notes management and organizer."
110 "Options concerning startup of Org-mode."
115 "Non-nil means, entering Org-mode will switch to OVERVIEW.
116 This can also be configured on a per-file basis by adding one of
117 the following lines anywhere in the buffer:
119 #+STARTUP: fold
120 #+STARTUP: nofold
121 #+STARTUP: content"
129 "Non-nil means, entering Org-mode will set `truncate-lines'.
130 This is useful since some lines containing links can be very long and
131 uninteresting. Also tables look terrible when wrapped."
136 "Non-nil means, align all tables when visiting a file.
137 This is useful when the column width in tables is forced with <N> cookies
138 in table fields. Such tables will look correct only after the first re-align.
139 This can also be configured on a per-file basis by adding one of
140 the following lines anywhere in the buffer:
141 #+STARTUP: align
142 #+STARTUP: noalign"
147 "Non-nil means insert the first line setting Org-mode in empty files.
148 When the function `org-mode' is called interactively in an empty file, this
149 normally means that the file name does not automatically trigger Org-mode.
150 To ensure that the file will always be in Org-mode in the future, a
151 line enforcing Org-mode will be inserted into the buffer, if this option
152 has been set."
157 "Non-nil means use alternative key bindings for S-<cursor movement>.
158 Org-mode used S-<cursor movement> for changing timestamps and priorities.
159 S-<cursor movement> is also used for example by `CUA-mode' to select text.
160 If you want to use Org-mode together with `CUA-mode', Org-mode needs to use
161 alternative bindings. Setting this variable to t will replace the following
162 keys both in Org-mode and in the Org-agenda buffer.
164 S-up -> M-p
165 S-down -> M-n
166 S-left -> M--
167 S-right -> M-+
169 If you do not like the alternative keys, take a look at the variable
170 `org-disputed-keys'.
172 This option is only relevant at load-time of Org-mode, and must be set
173 *before* org.el is loaded. Changing it requires a restart of Emacs to
174 become effective."
187 "Keys for which Org-mode and other modes compete.
188 This is an alist, cars are the default keys, second element specifies
189 the alternative to use when `org-replace-disputed-keys' is t.
191 Keys can be specified in any syntax supported by `define-key'.
192 The value of this option takes effect only at Org-mode's startup,
193 therefore you'll have to restart Emacs to apply it after changing."
198 "Select key according to `org-replace-disputed-keys' and `org-disputed-keys'.
199 Or return the original if not disputed."
203 org-disputed-keys)))
209 "Define a key, possibly translated, as returned by `org-key'."
213 "The ellipsis to use in the Org-mode outline.
214 When nil, just use the standard three dots. When a string, use that instead,
215 and just in Org-mode (which will then use its own display table).
216 Changing this requires executing `M-x org-mode' in a buffer to become
217 effective."
226 "Keywords in Org-mode."
231 "String to mark deadline entries.
232 A deadline is this string, followed by a time stamp. Should be a word,
233 terminated by a colon. You can insert a schedule keyword and
235 Changes become only effective after restarting Emacs."
240 "String to mark scheduled TODO entries.
241 A schedule is this string, followed by a time stamp. Should be a word,
242 terminated by a colon. You can insert a schedule keyword and
244 Changes become only effective after restarting Emacs."
249 "String used as the prefix for timestamps logging closing a TODO entry."
254 "String used as prefix for timestamps clocking work hours on an item."
259 "Entries starting with this keyword will never be exported.
260 An entry can be toggled between COMMENT and normal with
262 Changes become only effective after restarting Emacs."
267 "Entries starting with this keyword will be exported in fixed-width font.
268 Quoting applies only to the text in the entry following the headline, and does
269 not extend beyond the next headline, even if that is lower level.
270 An entry can be toggled between QUOTE and normal with
276 "Regular expression for specifying repeated events.
280 "Options concerning the general structure of Org-mode files."
285 "Options about how to make context of a location visible."
290 "Non-nil means, show full hierarchy when revealing a location.
291 Org-mode often shows locations in an org-mode file which might have
292 been invisible before. When this is set, the hierarchy of headings
293 above the exposed location is shown.
294 Turning this off for example for sparse trees makes them very compact.
295 Instead of t, this can also be an alist specifying this option for different
296 contexts. Valid contexts are
297 agenda when exposing an entry from the agenda
298 org-goto when using the command `org-goto' on key C-c C-j
299 occur-tree when using the command `org-occur' on key C-c /
300 tags-tree when constructing a sparse tree based on tags matches
301 link-search when exposing search matches associated with a link
302 mark-goto when exposing the jump goal of a mark
303 bookmark-jump when exposing a bookmark location
304 isearch when exiting from an incremental search
305 default default for all contexts not set explicitly"
325 "Non-nil means, show following heading when revealing a location.
326 Org-mode often shows locations in an org-mode file which might have
327 been invisible before. When this is set, the heading following the
328 match is shown.
329 Turning this off for example for sparse trees makes them very compact,
330 but makes it harder to edit the location of the match. In such a case,
332 Instead of t, this can also be an alist specifying this option for different
333 contexts. See `org-show-hierarchy-above' for valid contexts."
353 "Non-nil means, show all sibling heading when revealing a location.
354 Org-mode often shows locations in an org-mode file which might have
355 been invisible before. When this is set, the sibling of the current entry
356 heading are all made visible. If `org-show-hierarchy-above' is t,
357 the same happens on each level of the hierarchy above the current entry.
359 By default this is on for the isearch context, off for all other contexts.
360 Turning this off for example for sparse trees makes them very compact,
361 but makes it harder to edit the location of the match. In such a case,
363 Instead of t, this can also be an alist specifying this option for different
364 contexts. See `org-show-hierarchy-above' for valid contexts."
384 "Options concerning visibility cycling in Org-mode."
389 "Cycle globally if cursor is at beginning of buffer and not at a headline.
390 This makes it possible to do global cycling without having to use S-TAB or
391 C-u TAB. For this special case to work, the first line of the buffer
392 must not be a headline - it may be empty ot some other text. When used in
393 this way, `org-cycle-hook' is disables temporarily, to make sure the
394 cursor stays at the beginning of the buffer.
395 When this option is nil, don't do anything special at the beginning
396 of the buffer."
401 "Where should `org-cycle' emulate TAB.
402 nil Never
403 white Only in completely white lines
404 whitestart Only at the beginning of lines, before the first non-white char.
405 t Everywhere except in headlines
406 If TAB is used in a place where it does not emulate TAB, the current subtree
407 visibility is cycled."
413 ))
416 "Number of empty lines needed to keep an empty line between collapsed trees.
417 If you leave an empty line between the end of a subtree and the following
418 headline, this empty line is hidden when the subtree is folded.
419 Org-mode will leave (exactly) one empty line visible if the number of
420 empty lines is equal or larger to the number given in this variable.
421 So the default 2 means, at least 2 empty lines after the end of a subtree
422 are needed to produce free space between a collapsed subtree and the
423 following headline.
425 Special case: when 0, never leave empty lines in collapsed view."
430 org-cycle-show-empty-lines
431 org-optimize-window-after-visibility-change)
432 "Hook that is run after `org-cycle' has changed the buffer visibility.
433 The function(s) in this hook must accept a single argument which indicates
434 the new state that was set by the most recent `org-cycle' command. The
435 argument is a symbol. After a global state change, it can have the values
436 `overview', `content', or `all'. After a local state change, it can have
437 the values `folded', `children', or `subtree'."
442 "Options concerning structure editing in Org-mode."
447 "Non-nil means `C-a' behaves specially in headlines.
448 When set, `C-a' will bring back the cursor to the beginning of the
449 headline text, i.e. after the stars and after a possible TODO keyword.
450 When the cursor is already at that position, another `C-a' will bring
451 it to the beginning of the line."
456 "Non-nil means, skip even levels and only use odd levels for the outline.
457 This has the effect that two stars are being added/taken away in
458 promotion/demotion commands. It also influences how levels are
459 handled by the exporters.
460 Changing it requires restart of `font-lock-mode' to become effective
461 for fontification also in regions already fontified.
462 You may also set this on a per-file basis by adding one of the following
463 lines to the buffer:
465 #+STARTUP: odd
466 #+STARTUP: oddeven"
472 "Non-nil means, adapt indentation when promoting and demoting.
473 When this is set and the *entire* text in an entry is indented, the
474 indentation is increased by one space in a demotion command, and
475 decreased by one in a promotion command. If any line in the entry
476 body starts at column 0, indentation is not changed at all."
482 "Should `org-insert-heading' leave a blank line before new heading/item?
483 The value is an alist, with `heading' and `plain-list-item' as car,
484 and a boolean flag as cdr."
491 "Hook being run after inserting a new heading."
497 This currently only means, they are never auto-wrapped.
498 When nil, such lines will be treated like ordinary lines.
499 See also the QUOTE keyword."
504 "Options concerning sparse trees in Org-mode."
509 "Non-nil means, highlight all matches that define a sparse tree.
510 The highlights will automatically disappear the next time the buffer is
511 changed by an edit command."
516 "Non-nil means, any change to the buffer will remove temporary highlights.
517 Such highlights are created by `org-occur' and `org-clock-display'.
518 When nil, `C-c C-c needs to be used to get rid of the highlights.
519 The highlights created by `org-preview-latex-fragment' always need
520 `C-c C-c' to be removed."
527 "Hook that is run after `org-occur' has constructed a sparse tree.
528 This can be used to recenter the window to show as much of the structure
529 as possible."
534 "Options concerning plain lists in Org-mode."
539 "Non-nil means, include plain lists into visibility cycling.
540 This means that during cycling, plain list items will *temporarily* be
541 interpreted as outline headlines with a level given by 1000+i where i is the
542 indentation of the bullet. In all other operations, plain list items are
543 not seen as headlines. For example, you cannot assign a TODO keyword to
544 such an item."
549 "The character that makes a line with leading number an ordered list item.
550 Valid values are ?. and ?\). To get both terminators, use t. While
551 ?. may look nicer, it creates the danger that a line with leading
552 number may be incorrectly interpreted as an item. ?\) therefore is
553 the safe choice."
560 "Non-nil means, automatically renumber ordered plain lists.
561 Renumbering happens when the sequence have been changed with
568 "Non-nil means, update checkbox statistics after insert and toggle.
569 When this is set, checkbox statistics is updated each time you either insert
576 "Options concerning archiving in Org-mode."
581 "The tag that marks a subtree as archived.
582 An archived subtree does not open during visibility cycling, and does
583 not contribute to the agenda listings."
589 "Non-nil means, the agenda will skip any items located in archived trees.
590 An archived tree is a tree marked with the tag ARCHIVE."
596 "Non-nil means, `org-cycle' will open archived trees.
597 An archived tree is a tree marked with the tag ARCHIVE.
598 When nil, archived trees will stay folded. You can still open them with
599 normal outline commands like `show-all', but not with the cycling commands."
605 "Non-nil means sparse tree construction shows matches in archived trees.
606 When nil, matches in these trees are highlighted, but the trees are kept in
607 collapsed state."
613 "The location where subtrees should be archived.
614 This string consists of two parts, separated by a double-colon.
616 The first part is a file name - when omitted, archiving happens in the same
617 file. %s will be replaced by the current file name (without directory part).
618 Archiving to a different file is useful to keep archived entries from
619 contributing to the Org-mode Agenda.
621 The part after the double colon is a headline. The archived entries will be
622 filed under that headline. When omitted, the subtrees are simply filed away
623 at the end of the file, as top-level entries.
625 Here are a few examples:
627 If the current file is Projects.org, archive in file
628 Projects.org_archive, as top-level trees. This is the default.
631 Archive in the current file, under the top-level headline
635 Archive in file ~/org/archive.org (absolute path), as top-level trees.
638 Archive in file ./basement (relative path), as level 3 trees
641 You may set this option on a per-file basis by adding to the buffer a
642 line like
644 #+ARCHIVE: basement::** Finished Tasks"
649 "Non-nil means, mark entries as DONE when they are moved to the archive file."
654 "Non-nil means, add a time stamp to entries moved to an archive file.
655 The time stamp will be added directly after the TODO state keyword in the
656 first line, so it is probably best to use this in combinations with
657 `org-archive-mark-done'."
662 "Options concerning tables in Org-mode."
668 When nil, such lines will be treated like ordinary lines.
670 When equal to the symbol `optimized', the table editor will be optimized to
671 do the following:
672 - Automatic overwrite mode in front of whitespace in table fields.
673 This makes the structure of the table stay in tact as long as the edited
674 field does not exceed the column width.
675 - Minimize the number of realigns. Normally, the table is aligned each time
676 TAB or RET are pressed to move to another field. With optimization this
677 happens only if changes to a field might have changed the column width.
678 Optimization requires replacing the functions `self-insert-command',
679 `delete-char', and `backward-delete-char' in Org-mode buffers, with a
680 slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is
681 very good at guessing when a re-align will be necessary, but you can always
684 If you would like to use the optimized version in Org-mode, but the
685 un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'.
687 This variable can be used to turn on and off the table editor during a session,
688 but in order to toggle optimization, a restart is required.
690 See also the variable `org-table-auto-blank-field'."
698 "Non-nil means, use the optimized table editor version for `orgtbl-mode'.
699 In the optimized version, the table editor takes over all simple keys that
700 normally just insert a character. In tables, the characters are inserted
701 in a way to minimize disturbing the table structure (i.e. in overwrite mode
702 for empty fields). Outside tables, the correct binding of the keys is
703 restored.
705 The default for this option is t if the optimized version is also used in
706 Org-mode. See the variable `org-enable-table-editor' for details. Changing
707 this variable requires a restart of Emacs to become effective."
713 % END RECEIVE ORGTBL %n
715 #+ORGTBL: SEND %n orgtbl-to-latex :splice nil :skip 0
716 | | |
719 @c END RECEIVE ORGTBL %n
720 @ignore
721 #+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0
722 | | |
725 <!-- END RECEIVE ORGTBL %n -->
726 <!--
727 #+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0
728 | | |
730 "Templates for radio tables in different major modes.
731 All occurrences of %n in a template will be replaced with the name of the
732 table, obtained by prompting the user."
739 "Settings for tables in Org-mode."
744 "The default size for newly created tables, Columns x Rows."
750 "Regular expression for recognizing numbers in table columns.
751 If a table column contains mostly numbers, it will be aligned to the
752 right. If not, it will be aligned to the left.
754 The default value of this option is a regular expression which allows
755 anything which looks remotely like a number as used in scientific
756 context. For example, all of the following will be considered a
757 number:
758 12 12.2 2.4e-08 2x10^12 4.034+-0.02 2.7(10) >3.5
760 Other options offered by the customize interface are more restrictive."
778 "Fraction of numbers in a column required to make the column align right.
779 In a column all non-white fields are considered. If at least this
780 fraction of fields is matched by `org-table-number-fraction',
781 alignment to the right border applies."
786 "Bahavior of tables during editing in Org-mode."
791 "Non-nil means, automatically re-align table when pressing TAB or RETURN.
793 removal/insertion."
798 "Non-nil means, automatically blank table field when starting to type into it.
799 This only happens when typing immediately after a field motion
800 command (TAB, S-TAB or RET).
801 Only relevant when `org-enable-table-editor' is equal to `optimized'."
806 "Non-nil means, tab in the last column of a table with jump over a hline.
807 If a horizontal separator line is following the current line,
808 `org-table-next-field' can either create a new row before that line, or jump
809 over the line. When this option is nil, a new line will be created before
810 this line."
815 "Non-nil means, TAB will automatically notice a table.el table.
816 When it sees such a table, it moves point into it and - if necessary -
817 calls `table-recognize-table'."
822 "Options concerning tables in Org-mode."
827 "Should org-mode work with table refrences like B3 instead of @3$2?
828 Possible values are:
829 nil never use them
830 from accept as input, do not present for editing
831 t: accept as input and present for editing"
846 calc-angle-mode deg
847 calc-prefer-frac nil
848 calc-symbolic-mode nil
850 calc-display-working-message t
851 )
852 "List with Calc mode settings for use in calc-eval for table formulas.
853 The list must contain alternating symbols (Calc modes variables and values).
854 Don't remove any of the default settings, just change the values. Org-mode
855 relies on the variables to be present in the list."
860 "Non-nil means, TAB and RET evaluate a formula in current table field.
861 If the current field starts with an equal sign, it is assumed to be a formula
862 which should be evaluated as described in the manual and in the documentation
863 string of the command `org-table-eval-formula'. This feature requires the
864 Emacs calc package.
865 When this variable is nil, formula calculation is only available through
871 "Non-nil means, interpret constants in formulas in tables.
872 A constant looks like `$c' or `$Grav' and will be replaced before evaluation
873 by the value given in `org-table-formula-constants', or by a value obtained
874 from the `constants.el' package."
878 ;; FIXME this is also a variable that makes Org-mode files non-portable
879 ;; Maybe I should have a #+ options for constants?
881 "Alist with constant names and values, for use in table formulas.
882 The car of each element is a name of a constant, without the `$' before it.
883 The cdr is the value as a string. For example, if you'd like to use the
884 speed of light in a formula, you would configure
888 and then use it in an equation like `$1*$c'."
895 "Non-nil means, lines marked with |#| or |*| will be recomputed automatically.
896 Automatically means, when TAB or RET or C-c C-c are pressed in the line."
901 "Options concerning links in Org-mode."
906 "buffer-local version of `org-link-abbrev-alist', which see.
911 "Alist of link abbreviations.
912 The car of each element is a string, to be replaced at the start of a link.
914 links in Org-mode buffers can have an optional tag after a double colon, e.g.
916 [[linkkey:tag][description]]
918 If REPLACE is a string, the tag will simply be appended to create the link.
920 also be a function that will be called with the tag as the only argument to
921 create the link. See the manual for examples."
926 "Non-nil means, hide link part and only show description of bracket links.
927 Bracket links are like [[link][descritpion]]. This variable sets the initial
928 state in new org-mode buffers. The setting can then be toggled on a
929 per-buffer basis from the Org->Hyperlinks menu."
934 "How the path name in file links should be stored.
935 Valid values are:
937 relative relative to the current directory, i.e. the directory of the file
938 into which the link is being inserted.
939 absolute absolute path, if possible with ~ for home directory.
940 noabbrev absolute path, no abbreviation of home directory.
941 adaptive Use relative path for files in the current directory and sub-
942 directories of it. For other files, use an absolute path."
951 "Types of links that should be activated in Org-mode files.
952 This is a list of symbols, each leading to the activation of a certain link
953 type. In principle, it does not hurt to turn on most link types - there may
954 be a small gain when turning off unused link types. The types are:
956 bracket The recommended [[link][description]] or [[link]] links with hiding.
957 angular Links in angular brackes that may contain whitespace like
958 <bbdb:Carsten Dominik>.
959 plain Plain links in normal text, no whitespace, like http://google.com.
960 radio Text that is matched by a radio target, see manual for details.
961 tag Tag settings in a headline (link to tag search).
962 date Time stamps (link to calendar).
964 Changing this variable requires a restart of Emacs to become effective."
974 "Options concerning storing links in Org-mode"
979 "Format of the description part of a link to an email or usenet message.
980 The following %-excapes will be replaced by corresponding information:
988 %s subject
989 %m message-id.
991 You may use normal field width specification between the % and the letter.
992 This is for example useful to limit the length of the subject.
1006 It should match if the message is from the user him/herself."
1011 "Non-nil means, file links from `org-store-link' contain context.
1012 A search string will be added to the file name with :: as separator and
1013 used to find the context when the link is activated by the command
1014 `org-open-at-point'.
1016 negates this setting for the duration of the command."
1021 "Non-nil means, keep link in list for entire session.
1023 The command `org-store-link' adds a link pointing to the current
1024 location to an internal list. These links accumulate during a session.
1025 The command `org-insert-link' can be used to insert links into any
1026 Org-mode file (offering completion for all stored links). When this
1028 will be removed from the list, to make completing the unused links
1029 more efficient."
1034 "Non-nil means, `org-store-link' will create web links to Google groups.
1035 When nil, Gnus will be used for such links.
1037 negates this setting for the duration of the command."
1042 "Options concerning following links in Org-mode"
1047 "Non-nil means, on links TAB will follow the link.
1048 Needs to be set before org.el is loaded."
1053 "Non-nil means, on links RET will follow the link.
1054 Needs to be set before org.el is loaded."
1059 "Non-nil means, mouse-1 on a link will follow the link.
1060 A longer mouse click will still set point. Does not wortk on XEmacs.
1061 Needs to be set before org.el is loaded."
1066 "Number of different positions to be recorded in the ring
1067 Changing this requires a restart of Emacs to work correctly."
1075 "Setup the frame configuration for following links.
1076 When following a link with Emacs, it may often be useful to display
1077 this link in another window or frame. This variable can be used to
1078 set this up for the different types of links.
1079 For VM, use any of
1080 `vm-visit-folder'
1081 `vm-visit-folder-other-frame'
1082 For Gnus, use any of
1083 `gnus'
1084 `gnus-other-frame'
1085 For FILE, use any of
1086 `find-file'
1087 `find-file-other-window'
1088 `find-file-other-frame'
1089 For the calendar, use the variable `calendar-setup'.
1090 For BBDB, it is currently only possible to display the matches in
1091 another window."
1110 "Non-nil means, use indirect buffer to display infile links.
1111 Activating internal links (from one location in a file to another location
1112 in the same file) normally just jumps to the location. When the link is
1113 activated with a C-u prefix (or with mouse-3), the link is displayed in
1114 another window. When this option is set, the other window actually displays
1115 an indirect buffer clone of the current buffer, to avoid any visibility
1116 changes to the current buffer."
1121 "Non-nil means, `org-open-file' will open non-existing files.
1122 When nil, an error will be generated."
1127 "Function and arguments to call for following mailto links.
1128 This is a list with the first element being a lisp function, and the
1129 remaining elements being arguments to the function. In string arguments,
1130 %a will be replaced by the address, and %s will be replaced by the subject
1131 if one was given like in <mailto:arthur@galaxy.org::this subject>."
1140 "Non-nil means, ask for confirmation before executing shell links.
1141 Shell links can be dangerous, just thing about a link
1143 [[shell:rm -rf ~/*][Google Search]]
1146 but really it would remove your entire home directory.
1147 Therefore I *definitely* advise against setting this variable to nil.
1148 Just change it to `y-or-n-p' of you want to confirm with a single key press
1157 "Non-nil means, ask for confirmation before executing elisp links.
1158 Elisp links can be dangerous, just think about a link
1163 but really it would remove your entire home directory.
1164 Therefore I *definitely* advise against setting this variable to nil.
1165 Just change it to `y-or-n-p' of you want to confirm with a single key press
1176 "Default file applications on a UNIX or GNU/Linux system.
1188 "Default file applications on a MacOS X system.
1190 for some files for which the OS does not have a good default.
1198 'mswindows-shell-execute
1201 "Default file applications on a Windows NT system.
1206 '(
1213 )
1214 "External applications for opening `file:path' items in a document.
1215 Org-mode uses system defaults for different file types, but
1216 you can use this variable to set the application for a given file
1217 extension. The entries in this list are cons cells where the car identifies
1218 files and the cdr the corresponding command. Possible values for the
1219 file identifier are
1221 `directory' Matches a directory
1222 `remote' Matches a remote file, accessible through tramp or efs.
1223 Remote files most likely should be visited through Emacs
1224 because external applications cannot handle such paths.
1225 t Default for all remaining files
1227 Possible values for the command are:
1228 `emacs' The file will be visited by the current Emacs process.
1229 `default' Use the default application for this file type.
1230 string A command to be executed by a shell; %s will be replaced
1231 by the path to the file.
1232 sexp A Lisp form which will be evaluated. The file path will
1233 be available in the Lisp variable `file'.
1234 For more examples, see the system specific constants
1235 `org-file-apps-defaults-macosx'
1236 `org-file-apps-defaults-windowsnt'
1237 `org-file-apps-defaults-gnu'."
1252 "Non-nil means, that the search for the mh-message will be extended to
1253 all folders if the message cannot be found in the folder given in the link.
1254 Searching all folders is very efficient with one of the search engines
1255 supported by MH-E, but will be slow with pick."
1260 "Options concerning interaction with remember.el."
1265 "Directory with org files.
1266 This directory will be used as default to prompt for org files.
1267 Used by the hooks for remember.el."
1272 "Default target for storing notes.
1273 Used by the hooks for remember.el. This can be a string, or nil to mean
1274 the value of `remember-data-file'.
1275 You can set this on a per-template basis with the variable
1276 `org-remember-templates'."
1280 file))
1283 "The headline that should be the default location in the notes file.
1284 When filing remember notes, the cursor will start at that position.
1285 You can set this on a per-template basis with the variable
1286 `org-remember-templates'."
1291 "Templates for the creation of remember buffers.
1292 When nil, just let remember make the buffer.
1293 When not nil, this is a list of 4-element lists. In each entry, the first
1294 element is a character, a unique key to select this template.
1295 The second element is the template. The third element is optional and can
1296 specify a destination file for remember items created with this template.
1297 The default file is given by `org-default-notes-file'. An optional third
1298 element can specify the headline in that file that should be offered
1299 first when the user is asked to file the entry. The default headline is
1300 given in the variable `org-remember-default-headline'.
1302 The template specifies the structure of the remember buffer. It should have
1303 a first line starting with a star, to act as the org-mode headline.
1304 Furthermore, the following %-escapes will be replaced with content:
1306 %^{prompt} prompt the user for a string and replace this sequence with it.
1307 %t time stamp, date only
1308 %T time stamp with date and time
1309 %u, %U like the above, but inactive time stamps
1310 %^t like %t, but prompt for date. Similarly %^T, %^u, %^U
1311 You may define a prompt like %^{Please specify birthday}t
1312 %n user name (taken from `user-full-name')
1313 %a annotation, normally the link created with org-store-link
1314 %i initial content, the region when remember is called with C-u.
1315 If %i is indented, the entire inserted text will be indented
1316 as well.
1318 %? After completing the template, position cursor here.
1320 Apart from these general escapes, you can access information specific to the
1321 link type that is created. For example, calling `remember' in emails or gnus
1322 will record the author and the subject of the message, which you can access
1323 with %:author and %:subject, respectively. Here is a complete list of what
1324 is recorded for each link type.
1326 Link type | Available information
1327 -------------------+------------------------------------------------------
1328 bbdb | %:type %:name %:company
1329 vm, wl, mh, rmail | %:type %:subject %:message-id
1330 | %:from %:fromname %:fromaddress
1331 | %:to %:toname %:toaddress
1333 gnus | %:group, for messages also all email fields
1334 w3, w3m | %:type %:url
1335 info | %:type %:file %:node
1336 calendar | %:type %:date"
1353 "Non-nil means, store new notes at the beginning of a file or entry.
1354 When nil, new notes will be filed to the end of a file or entry."
1363 "Options concerning TODO items in Org-mode."
1368 "Options concerning Progress logging in Org-mode."
1373 "List of TODO entry keyword sequences and their interpretation.
1376 Each sequence starts with a symbol, either `sequence' or `type',
1377 indicating if the keywords should be interpreted as a sequence of
1378 action steps, or as different types of TODO items. The first
1379 keywords are states requiring action - these states will select a headline
1380 for inclusion into the global TODO list Org-mode produces. If one of
1383 the last keyword is treated as the only DONE state of the sequence.
1386 additional state where no keyword is present. For details about this
1387 cycling, see the manual.
1389 TODO keywords and interpretation can also be set on a per-file basis with
1390 the special #+SEQ_TODO and #+TYP_TODO lines.
1392 For backward compatibility, this variable may also be just a list
1393 of keywords - in this case the interptetation (sequence or type) will be
1394 taken from the (otherwise obsolete) variable `org-todo-interpretation'."
1425 "Controls how TODO keywords are interpreted.
1426 This variable is in principle obsolete and is only used for
1427 backward compatibility, if the interpretation of todo keywords is
1428 not given already in `org-todo-keywords'. See that variable for
1429 more information."
1436 "Hook which is run after the state of a TODO item was changed.
1437 The new state (a string with a TODO keyword, or nil) is available in the
1438 Lisp variable `state'."
1443 "When set, insert a (non-active) time stamp when TODO entry is marked DONE.
1444 When the state of an entry is changed from nothing to TODO, remove a previous
1445 closing date.
1447 This can also be a list of symbols indicating under which conditions
1448 the time stamp recording the action should be annotated with a short note.
1449 Valid members of this list are
1451 done Offer to record a note when marking entries done
1452 state Offer to record a note whenever changing the TODO state
1453 of an item. This is only relevant if TODO keywords are
1454 interpreted as sequence, see variable `org-todo-interpretation'.
1455 When `state' is set, this includes tracking `done'.
1456 clock-out Offer to record a note when clocking out of an item.
1458 A separate window will then pop up and allow you to type a note.
1459 After finishing with C-c C-c, the note will be added directly after the
1460 timestamp, as a plain list item. See also the variable
1461 `org-log-note-headings'.
1463 Logging can also be configured on a per-file basis by adding one of
1464 the following lines anywhere in the buffer:
1466 #+STARTUP: logdone
1467 #+STARTUP: nologging
1468 #+STARTUP: lognotedone
1469 #+STARTUP: lognotestate
1470 #+STARTUP: lognoteclock-out"
1485 "Headings for notes added when clocking out or closing TODO items.
1486 The value is an alist, with the car being a sympol indicating the note
1487 context, and the cdr is the heading to be used. The heading may also be the
1488 empty string.
1489 %t in the heading will be replaced by a time stamp.
1490 %s will be replaced by the new TODO state, in double quotes.
1491 %u will be replaced by the user name.
1492 %U will be replaced by the full user name."
1498 "Heading when changing todo state (todo sequence only)"
1503 "Non-nil means, find REPEAT cookies in entries and apply them.
1504 A repeat cookie looks like REPEAT(+1m) and causes deadlines and schedules
1505 to repeat themselves shifted by a certain amount of time, each time an
1506 entry is marked DONE."
1512 "Non-nil means, prompt for a note when REPEAT is resetting a TODO entry.
1513 When nil, no note will be taken."
1519 "Priorities in Org-mode."
1524 "The default priority of TODO items.
1525 This is the priority an item get if no explicit priority is given."
1530 "The lowest priority of TODO items. A character like ?A, ?B etc."
1535 "Options concerning time stamps and deadlines in Org-mode."
1540 "Non-nil means, SCHEDULED and DEADLINE timestamps are inserted at point.
1541 When nil, these labeled time stamps are forces into the second line of an
1542 entry, just after the headline. When scheduling from the global TODO list,
1543 the time stamp will always be forced into the second line."
1548 "Formats for `format-time-string' which are used for time stamps.
1552 "Number of minutes to round time stamps to upon insertion.
1553 When zero, insert the time unmodified. Useful rounding numbers
1554 should be factors of 60, so for example 5, 10, 15.
1555 When this is not zero, you can still force an exact time-stamp by using
1556 a double prefix argument to a time-stamp command like `C-c .' or `C-c !'."
1561 "Non-nil means, overlay custom formats over all time stamps.
1562 The formats are defined through the variable `org-time-stamp-custom-formats'.
1563 To turn this on on a per-file basis, insert anywhere in the file:
1564 #+STARTUP: customtime"
1572 "Custom formats for time stamps. See `format-time-string' for the syntax.
1573 These are overlayed over the default ISO format if the variable
1574 `org-display-custom-times' is set."
1579 "Get the right format for a time string."
1584 f)))
1587 "No. of days before expiration during which a deadline becomes active.
1588 This variable governs the display in sparse trees and in the agenda."
1593 "Non-nil means, pop up a calendar when prompting for a date.
1594 In the calendar, the date can be selected with mouse-1. However, the
1595 minibuffer will also be active, and you can simply enter the date as well.
1596 When nil, only the minibuffer will be available."
1601 "Non-nil means, make the calendar window follow timestamp changes.
1602 When a timestamp is modified and the calendar window is visible, it will be
1603 moved to the new date."
1608 "Options concerning tags in Org-mode."
1613 "List of tags allowed in Org-mode files.
1614 When this list is nil, Org-mode will base TAG input on what is already in the
1615 buffer.
1616 The value of this variable is an alist, the car may be (and should) be a
1617 character that is used to select that tag through the fast-tag-selection
1618 interface. See the manual for details."
1628 "Non-nil means, use fast tag selection scheme.
1629 This is a special interface to select and deselect tags with single keys.
1630 When nil, fast selection is never used.
1631 When the symbol `auto', fast selection is used if and only if selection
1632 characters for tags have been configured, either through the variable
1633 `org-tag-alist' or through a #+TAGS line in the buffer.
1634 When t, fast selection is always used and selection keys are assigned
1635 automatically if necessary."
1643 "Non-nil means, fast tag selection exits after first change.
1644 When nil, you have to press RET to exit it.
1645 During fast tag selection, you can toggle this flag with `C-c'.
1646 This variable can also have the value `expert'. In this case, the window
1647 displaying the tags menu is not even shown, until you press C-c again."
1655 "The column to which tags should be indented in a headline.
1656 If this number is positive, it specifies the column. If it is negative,
1657 it means that the tags should be flushright to that column. For example,
1658 -79 works well for a normal 80 character screen."
1663 "Non-nil means, realign tags after pro/demotion of TODO state change.
1664 These operations change the length of a headline and therefore shift
1665 the tags around. With this options turned on, after each such operation
1666 the tags are again aligned to `org-tags-column'."
1671 "Non-nil means, tags in levels apply also for sublevels.
1672 When nil, only the tags directly given in a specific line apply there.
1673 If you turn off this option, you very likely want to turn on the
1674 companion option `org-tags-match-list-sublevels'."
1679 "Non-nil means list also sublevels of headlines matching tag search.
1680 Because of tag inheritance (see variable `org-use-tag-inheritance'),
1681 the sublevels of a headline matching a tag search often also match
1682 the same search. Listing all of them can create very long lists.
1683 Setting this variable to nil causes subtrees of a match to be skipped.
1684 This option is off by default, because inheritance in on. If you turn
1685 inheritance off, you very likely want to turn this option on.
1687 As a special case, if the tag search is restricted to TODO items, the
1688 value of this variable is ignored and sublevels are always checked, to
1689 make sure all corresponding TODO items find their way into the list."
1699 "Options concerning agenda views in Org-mode."
1704 "Variable used by org files to set a category for agenda display.
1705 Such files should use a file variable to set it, for example
1709 or contain a special line
1711 #+CATEGORY: ELisp
1713 If the file does not specify a category, then file's base name
1718 "The files to be used for agenda display.
1722 If the value of the variable is not a list but a single file name, then
1723 the list of agenda files is actually stored and maintained in that file, one
1724 agenda file per line."
1732 "When set, remote killing from the agenda buffer needs confirmation.
1733 When t, a confirmation is always needed. When a number N, confirmation is
1734 only needed when the text to be killed contains more than N non-white lines."
1742 "The key to be installed in `calendar-mode-map' for switching to the agenda.
1743 The command `org-calendar-goto-agenda' will be bound to this key. The
1744 default is the character `c' because then `c' can be used to switch back and
1745 forth between agenda and calendar."
1750 "Options concerning agenda views in Org-mode."
1755 "Custom commands for the agenda.
1756 These commands will be offered on the splash screen displayed by the
1759 (key type match options)
1761 key The key (a single char as a string) to be associated with the command.
1762 type The command type, any of the following symbols:
1763 todo Entries with a specific TODO keyword, in all agenda files.
1764 tags Tags match in all agenda files.
1765 tags-todo Tags match in all agenda files, TODO entries only.
1766 todo-tree Sparse tree of specific TODO keyword in *current* file.
1767 tags-tree Sparse tree with all tags matches in *current* file.
1768 occur-tree Occur sparse tree for *current* file.
1769 match What to search for:
1770 - a single keyword for TODO keyword searches
1771 - a tags match expression for tags searches
1772 - a regular expression for occur searches
1773 options A list of option setttings, similar to that in a let form, so like
1774 this: ((opt1 val1) (opt2 val2) ...)
1776 You can also define a set of commands, to create a composite agenda buffer.
1777 In this case, an entry looks like this:
1779 (key desc (cmd1 cmd2 ...) general-options)
1781 where
1783 desc A description string to be displayed in the dispatcher menu.
1784 cmd An agenda command, similar to the above. However, tree commands
1785 are no allowed, but instead you can get agenda and global todo list.
1786 So valid commands for a set are:
1787 (agenda)
1788 (alltodo)
1789 (stuck)
1794 Each command can carry a list of options, and another set of options can be
1795 given for the whole set of commands. Individual command options take
1796 precedence over the general options."
1855 "How to identify stuck projects.
1856 This is a list of four items:
1857 1. A tags/todo matcher string that is used to identify a project.
1858 The entire tree below a headline matched by this is considered one project.
1859 2. A list of TODO keywords identifying non-stuck projects.
1860 If the project subtree contains any headline with one of these todo
1861 keywords, the project is considered to be not stuck. If you specify
1863 3. A list of tags identifying non-stuck projects.
1864 If the project subtree contains any headline with one of these tags,
1866 a tag, any tag will mark the project unstuck.
1867 4. An arbitrary regular expression matching non-stuck projects.
1870 or `C-c a #' to produce the list."
1874 (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string))
1880 "Options concerning skipping parts of agenda files."
1885 "Non-nil means, check also the sublevels of a TODO entry for TODO entries.
1886 When nil, the sublevels of a TODO entry are not checked, resulting in
1887 potentially much shorter TODO lists."
1893 "Non-nil means, don't show scheduled entries in the global todo list.
1894 The idea behind this is that by scheduling it, you have already taken care
1895 of this item."
1901 "Non-nil means, don't show near deadline entries in the global todo list.
1902 Near means closer than `org-deadline-warning-days' days.
1903 The idea behind this is that such items will appear in the agenda anyway."
1909 "Non-nil means don't show scheduled items in agenda when they are done.
1910 This is relevant for the daily/weekly agenda, not for the TODO list."
1915 "Non-nil means, `org-timeline' also shows dates without an entry.
1916 When nil, only the days which actually have entries are shown.
1917 When t, all days between the first and the last date are shown.
1918 When an integer, show also empty dates, but if there is a gap of more than
1919 N days, just insert a special line indicating the size of the gap."
1928 "Options concerning initial settings in the Agenda in Org Mode."
1933 "Hook run just before displaying an agenda buffer."
1938 "Non-nil means, mouse-1 on a link will follow the link in the agenda.
1939 A longer mouse click will still set point. Does not wortk on XEmacs.
1940 Needs to be set before org.el is loaded."
1945 "The initial value of follwo-mode in a newly created agenda window."
1950 "Options concerning the windows used by the Agenda in Org Mode."
1955 "How the agenda buffer should be displayed.
1956 Possible values for this option are:
1958 current-window Show agenda in the current window, keeping all other windows.
1959 other-frame Use `switch-to-buffer-other-frame' to display agenda.
1960 other-window Use `switch-to-buffer-other-window' to display agenda.
1961 reorganize-frame Show only two windows on the current frame, the current
1962 window and the agenda.
1963 See also the variable `org-agenda-restore-windows-after-quit'."
1972 "Non-nil means, restore window configuration open exiting agenda.
1973 Before the window configuration is changed for displaying the agenda,
1974 the current status is recorded. When the agenda is exited with
1975 `q' or `x' and this option is set, the old state is restored. If
1976 `org-agenda-window-setup' is `other-frame', the value of this
1977 option will be ignored.."
1982 "How should indirect tree buffers be displayed?
1983 This applies to indirect buffers created with the commands
1985 Valid values are:
1986 current-window Display in the current window
1987 other-window Just display in another window.
1988 dedicated-frame Create one new frame, and re-use it each time.
1989 new-frame Make a new frame each time."
1999 "Options concerning the daily/weekly agenda."
2004 "Number of days to include in overview display.
2005 Should be 1 or 7."
2010 "Non-nil means, start the overview always on the specified weekday.
2011 0 denotes Sunday, 1 denotes Monday etc.
2012 When nil, always start on the current day."
2018 "Non-nil means, `org-agenda' shows every day in the selected range.
2019 When nil, only the days which actually have entries are shown."
2024 "Format string for displaying dates in the agenda.
2025 Used by the daily/weekly agenda and by the timeline. This should be
2026 a format string understood by `format-time-string'.
2027 FIXME: Not used currently, because of timezone problem."
2032 "If non-nil, include in the agenda entries from the Emacs Calendar's diary."
2037 "Set means weekly/daily agenda will always contain all TODO entries.
2038 The TODO entries will be listed at the top of the agenda, before
2039 the entries for specific days."
2044 "Options concerning the time grid in the Org-mode Agenda."
2049 "Non-nil means, show a time grid in the agenda schedule.
2050 A time grid is a set of lines for specific times (like every two hours between
2051 8:00 and 20:00). The items scheduled for a day at specific times are
2052 sorted in between these lines.
2053 For details about when the grid will be shown, and what it will look like, see
2054 the variable `org-agenda-time-grid'."
2060 "----------------"
2063 "The settings for time grid for agenda display.
2064 This is a list of three items. The first item is again a list. It contains
2065 symbols specifying conditions when the grid should be displayed:
2067 daily if the agenda shows a single day
2068 weekly if the agenda shows an entire week
2069 today show grid on current date, independent of daily/weekly display
2070 require-timed show grid only if at least one item has a time specification
2072 The second item is a string which will be places behing the grid time.
2074 The third item is a list of integers, indicating the times that should have
2075 a grid line."
2077 :type
2084 require-timed)
2086 remove-match))
2091 "Options concerning sorting in the Org-mode Agenda."
2106 "Sorting structure for the agenda items of a single day.
2107 This is a list of symbols which will be used in sequence to determine
2108 if an entry should be listed before another entry. The following
2109 symbols are recognized:
2111 time-up Put entries with time-of-day indications first, early first
2112 time-down Put entries with time-of-day indications first, late first
2113 category-keep Keep the default order of categories, corresponding to the
2114 sequence in `org-agenda-files'.
2115 category-up Sort alphabetically by category, A-Z.
2116 category-down Sort alphabetically by category, Z-A.
2117 tag-up Sort alphabetically by last tag, A-Z.
2118 tag-down Sort alphabetically by last tag, Z-A.
2119 priority-up Sort numerically by priority, high priority last.
2120 priority-down Sort numerically by priority, high priority first.
2122 The different possibilities will be tried in sequence, and testing stops
2124 '(time-up category-keep priority-down)
2125 means: Pull out all entries having a specified time of day and sort them,
2126 in order to make a time schedule for the current day the first thing in the
2127 agenda listing for the day. Of the entries without a time indication, keep
2128 the grouped in categories, don't sort the categories, but keep them in
2129 the sequence given in `org-agenda-files'. Within each category sort by
2130 priority.
2132 Leaving out `category-keep' would mean that items will be sorted across
2133 categories by priority."
2146 "Non-nil means, items without time are considered late.
2147 This is only relevant for sorting. When t, items which have no explicit
2148 time like 15:30 will be considered as 99:01, i.e. later than any items which
2149 do have a time. When nil, the default time is before 0:00. You can use this
2150 option to decide if the schedule for today should come before or after timeless
2151 agenda entries."
2156 "Options concerning the entry prefix in the Org-mode agenda display."
2165 "Format specifications for the prefix of items in the agenda views.
2166 An alist with four entries, for the different agenda types. The keys to the
2167 sublists are `agenda', `timeline', `todo', and `tags'. The values
2168 are format strings.
2169 This format works similar to a printf format, with the following meaning:
2172 as given by the CATEGORY keyword or derived from the file name.
2173 %T the *last* tag of the item. Last because inherited tags come
2174 first in the list.
2175 %t the time-of-day specification if one applies to the entry, in the
2176 format HH:MM
2177 %s Scheduling/Deadline information, a short string
2179 All specifiers work basically like the standard `%s' of printf, but may
2180 contain two additional characters: A question mark just after the `%' and
2181 a whitespace/punctuation character just before the final letter.
2183 If the first character after `%' is a question mark, the entire field
2184 will only be included if the corresponding value applies to the
2185 current entry. This is useful for fields which should have fixed
2186 width when present, but zero width when absent. For example,
2188 day is specified, but will completely disappear in entries which do
2189 not contain a time.
2191 If there is punctuation or whitespace character just before the final
2192 format letter, this character will be appended to the field value if
2195 empty, no additional colon would be interted.
2198 - Indent the line with two space characters
2199 - Give the category in a 12 chars wide field, padded with whitespace on
2200 the right (because of `-'). Append a colon if there is a category
2201 (because of `:').
2202 - If there is a time-of-day, put it into a 12 chars wide field. If no
2203 time, don't put in an empty field, just skip it (because of '?').
2204 - Finally, put the scheduling information and append a whitespace.
2206 As another example, if you don't want the time-of-day of entries in
2207 the prefix, you could use:
2211 See also the variables `org-agenda-remove-times-when-in-prefix' and
2212 `org-agenda-remove-tags-when-in-prefix'."
2223 "The compiled version of the most recently used prefix format.
2227 "Non-nil means, remove duplicate time specifications in agenda items.
2228 When the format `org-agenda-prefix-format' contains a `%t' specifier, a
2229 time-of-day specification in a headline or diary entry is extracted and
2230 placed into the prefix. If this option is non-nil, the original specification
2231 \(a timestamp or -range, or just a plain time(range) specification like
2232 11:30-4pm) will be removed for agenda display. This makes the agenda less
2233 cluttered.
2234 The option can be t or nil. It may also be the symbol `beg', indicating
2235 that the time should only be removed what it is located at the beginning of
2236 the headline/diary entry."
2244 "Non-nil means, remove the tags from the headline copy in the agenda.
2245 When this is the symbol `prefix', only remove tags when
2246 `org-agenda-prefix-format' contains a `%T' specifier."
2254 "Shift tags in agenda items to this column."
2259 "Options for embedding LaTeX code into Org-mode"
2267 "Options for creating images from LaTeX fragments.
2268 This is a property list with the following properties:
2270 `default' means use the forground of the default face.
2272 `default' means use the background of the default face.
2273 :scale a scaling factor for the size of the images
2274 :html-foreground, :html-background, :html-scale
2275 The same numbers for HTML export.
2276 :matchers a list indicating which matchers should be used to
2277 find LaTeX fragments. Valid members of this list are:
2294 "The document header used for processing LaTeX fragments."
2299 "Options for exporting org-listings."
2304 "General options for exporting Org-mode files."
2309 "Path to the location where exported files should be located.
2310 This path may be relative to the directory where the Org-mode file lives.
2311 The default is to put them into the same directory as the Org-mode file.
2312 The variable may also be an alist with export types `:html', `:ascii',
2313 `:ical', or `:xoxo' and the corresponding directories. If a direcoty path
2314 is relative, it is interpreted relative to the directory where the exported
2315 Org-mode files lives."
2336 "Terms used in export text, translated to different languages.
2337 Use the variable `org-export-default-language' to set the language,
2338 or use the +OPTION lines for a per-file setting."
2348 "The default language of HTML export, as a string.
2349 This should have an association in `org-export-language-setup'."
2354 "Non-nil means, skip all text before the first headline when exporting.
2355 When nil, that text is exported as well."
2360 "The last level which is still exported as a headline.
2361 Inferior levels will produce itemize lists when exported.
2362 Note that a numeric prefix argument to an exporter function overrides
2363 this setting.
2370 "Non-nil means, add section numbers to headlines when exporting.
2377 "Non-nil means, create a table of contents in exported files.
2378 The TOC contains headlines with levels up to`org-export-headline-levels'.
2379 When an integer, include levels up to N in the toc, this may then be
2380 different from `org-export-headline-levels', but it will not be allowed
2381 to be larger than the number of headline levels.
2382 When nil, no table of contents is made.
2385 ASCII export, and with red color in HTML output, if the option
2386 `org-export-mark-todo-in-toc' is set.
2388 In HTML output, the TOC will be clickable.
2399 "Non-nil means, mark TOC lines that contain any open TODO items."
2404 "Non-nil means, preserve all line breaks when exporting.
2405 Normally, in HTML output paragraphs will be reformatted. In ASCII
2406 export, line breaks will always be preserved, regardless of this variable.
2413 "Whether subtrees with the ARCHIVE tag should be exported.
2414 This can have three different values
2415 nil Do not export, pretend this tree is not present
2416 t Do export the entire tree
2417 headline Only export the headline, but skip the tree below it."
2426 "If nil, do not export time stamps and associated keywords."
2431 "If nil, remove timestamps from the table of contents entries."
2436 "If nil, do not export tags, just remove them from headlines.
2437 If this is the symbol `not-in-toc', tags will be removed from table of
2438 contents entries, but still be shown in the headlines of the document."
2446 "Options for translating special ascii sequences for the export backends."
2451 "Non-nil means, interpret *word*, /word/, and _word_ as emphasized text.
2452 If the export target supports emphasizing text, the word will be
2453 typeset in bold, italic, or underlined, respectively. Works only for
2454 single words, but you can say: I *really* *mean* *this*.
2455 Not all export backends support this.
2463 When this option is turned on, you can use TeX-like syntax for sub- and
2465 considered as a single item - so grouping with {} is normally not
2466 needed. For example, the following things will be parsed as single
2467 sub- or superscripts.
2469 10^24 or 10^tau several digits will be considered 1 item.
2470 10^-12 or 10^-tau a leading sign with digits or a word
2471 x^2-y^3 will be read as x^2 - y^3, because items are
2472 terminated by almost any nonword/nondigit char.
2473 x_{i^2} or x^(2-i) braces or parenthesis do grouping.
2475 Still, ambiguity is possible - so when in doubt use {} to enclose the
2476 sub/superscript. If you set this variable to the symbol `{}',
2477 the braces are *required* in order to trigger interpretations as
2479 frequently in plain text.
2481 Not all export backends support this, but HTML does.
2491 "Non-nil means, interpret simple TeX-like macros when exporting.
2493 No only real TeX macros will work here, but the standard HTML entities
2494 for math can be used as macro names as well. For a list of supported
2495 names in HTML export, see the constant `org-html-entities'.
2496 Not all export backends support this.
2504 "Non-nil means, convert LaTeX fragments to images when exporting to HTML.
2506 the first non-white thing on a line. It will also find the math delimiters
2508 display math.
2517 This can be used to have pre-formatted text, fragments of code etc. For
2518 example:
2519 : ;; Some Lisp examples
2520 : (while (defc cnt)
2521 : (ding))
2522 will be looking just like this in also HTML. See also the QUOTE keyword.
2523 Not all export backends support this.
2530 "Number of stacked braces for sub/superscript matching.
2531 This has to be set before loading org.el to be effective."
2536 "Options for exporting tables in Org-mode."
2542 For example:
2544 | Name | Address | Birthday |
2545 |-------------+----------+-----------|
2546 | Arthur Dent | England | 29.2.2100 |
2548 Not all export backends support this.
2555 "Non-nil means, highlight the first table line.
2556 In HTML export, this means use <th> instead of <td>.
2557 In tables created with table.el, this applies to the first table line.
2558 In Org-mode tables, all lines before the first horizontal separator
2559 line will be formatted with <th> tags."
2564 "Remove special lines and marking characters in calculating tables.
2565 This removes the special marking character column from tables that are set
2566 up for spreadsheet calculations. It also removes the entire lines
2567 marked with `!', `_', or `^'. The lines with `$' are kept, because
2568 the values of constants may be useful to have."
2573 "Non-nil means, always export tables created with table.el natively.
2574 Natively means, use the HTML code generator in table.el.
2575 When nil, Org-mode's own HTML generator is used when possible (i.e. if
2576 the table does not use row- or column-spanning). This has the
2577 advantage, that the automatic HTML conversions for math symbols and
2578 sub/superscripts can be applied. Org-mode's HTML generator is also
2579 much faster."
2584 "Options specific for ASCII export of Org-mode files."
2589 "Characters for underlining headings in ASCII export.
2590 In the given sequence, these characters will be used for level 1, 2, ..."
2595 "Bullet characters for headlines converted to lists in ASCII export.
2596 The first character is is used for the first lest level generated in this
2597 way, and so on. If there are more levels than characters given here,
2598 the list will be repeated.
2599 Note that plain lists will keep the same bullets as the have in the
2600 Org-mode file."
2605 "Options specific for XML export of Org-mode files."
2610 "Options specific for HTML export of Org-mode files."
2616 html {
2617 font-family: Times, serif;
2618 font-size: 12pt;
2619 }
2620 .title { text-align: center; }
2621 .todo { color: red; }
2622 .done { color: green; }
2623 .timestamp { color: grey }
2624 .timestamp-kwd { color: CadetBlue }
2625 .tag { background-color:lightblue; font-weight:normal }
2626 .target { background-color: lavender; }
2627 pre {
2628 border: 1pt solid #AEBDCC;
2629 background-color: #F3F5F7;
2630 padding: 5pt;
2631 font-family: courier, monospace;
2632 }
2633 table { border-collapse: collapse; }
2634 td, th {
2635 vertical-align: top;
2636 <!--border: 1pt solid #ADB9CC;-->
2637 }
2638 </style>"
2639 "The default style specification for exported HTML files.
2640 Since there are different ways of setting style information, this variable
2641 needs to contain the full HTML structure to provide a style, including the
2642 surrounding HTML tags. The style specifications should include definitions
2643 for new classes todo, done, title, and deadline. For example, legal values
2644 would be:
2647 p { font-weight: normal; color: gray; }
2648 h1 { color: black; }
2649 .title { text-align: center; }
2650 .todo, .deadline { color: red; }
2651 .done { color: green; }
2652 </style>
2654 or, if you want to keep the style in a file,
2658 As the value of this option simply gets inserted into the HTML <head> header,
2664 "Format for typesetting the document title in HTML export."
2669 "The <H> level for level 1 headings in HTML export."
2674 "Non-nil means, make file links to `file.org' point to `file.html'.
2675 When org-mode is exporting an org-mode file to HTML, links to
2676 non-html files are directly put into a href tag in HTML.
2677 However, links to other Org-mode files (recognized by the
2678 extension `.org.) should become links to the corresponding html
2679 file, assuming that the linked org-mode file will also be
2680 converted to HTML.
2681 When nil, the links still point to the plain `.org' file."
2686 "Non-nil means, inline images into exported HTML pages.
2687 This is done using an <img> tag. When nil, an anchor with href is used to
2688 link to the image. If this option is `maybe', then images in links with
2689 an empty description will be inlined, while images with a description will
2690 be linked only."
2696 ;; FIXME: rename
2698 "Non-nil means, for HTML export, treat @<...> as HTML tag.
2699 When nil, these tags will be exported as plain text and therefore
2700 not be interpreted by a browser.
2708 "The HTML tag that is used to start a table.
2709 This must be a <table> tag, but you may change the options like
2710 borders and spacing."
2715 "The opening tag for table header fields.
2716 This is customizable so that alignment options can be specified."
2721 "The opening tag for table data fields.
2722 This is customizable so that alignment options can be specified."
2727 "If non-nil, write `org-export-html-html-helper-timestamp'
2728 into the exported HTML text. Otherwise, the buffer will just be saved
2729 to a file."
2735 "The HTML tag used as timestamp delimiter for HTML-helper-mode."
2740 "Options specific for iCalendar export of Org-mode files."
2745 "The file name for the iCalendar file covering all agenda files.
2747 The file name should be absolute."
2752 "Non-nil means, export to iCalendar files should also cover TODO items."
2760 "Calendar name for the combined iCalendar representing all agenda files."
2765 "Font-lock settings for highlighting in Org-mode."
2770 "Non-nil means fontify only the stars in each headline.
2771 When nil, the entire headline is fontified.
2772 Changing it requires restart of `font-lock-mode' to become effective
2773 also in regions already fontified."
2778 "Non-nil means, hide the first N-1 stars in a headline.
2779 This works by using the face `org-hide' for these stars. This
2780 face is white for a light background, and black for a dark
2781 background. You may have to customize the face `org-hide' to
2782 make this work.
2783 Changing it requires restart of `font-lock-mode' to become effective
2784 also in regions already fontified.
2785 You may also set this on a per-file basis by adding one of the following
2786 lines to the buffer:
2788 #+STARTUP: hidestars
2789 #+STARTUP: showstars"
2794 "Non-nil means, change the face of a headline if it is marked DONE.
2795 Normally, only the TODO/DONE keyword indicates the state of a headline.
2796 When this is non-nil, the headline after the keyword is set to the
2797 `org-headline-done' as an additional indication."
2802 "Non-nil means fontify *bold*, /italic/ and _underlined_ text.
2803 Changing this variable requires a restart of Emacs to take effect."
2812 "Set variable and compute the emphasis regular expression."
2816 org-emphasis-alist org-emphasis-regexp-components)
2826 ;; make sure special characters appear at the right position in the class
2834 ;; Make the regexp
2841 body1
2849 "Components used to build the reqular expression for emphasis.
2850 This is a list with 6 entries. Terminology: In an emphasis string
2854 specify what is allowed/forbidden in each part:
2856 pre Chars allowed as prematch. Beginning of line will be allowed too.
2857 post Chars allowed as postmatch. End of line will be allowed too.
2858 border The chars *forbidden* as border characters. In addition to the
2859 characters given here, all marker characters are forbidden too.
2860 FIXME: the last statement is no longer true.
2862 non-shy groups here, and don't allow newline here.
2863 newline The maximum number of newlines allowed in an emphasis exp.
2864 stacked Non-nil means, allow stacked styles. This works only in HTML
2865 export. When this is set, all marker characters (as given in
2866 `org-emphasis-alist') will be allowed as pre/post, aiding
2867 inside-out matching.
2868 Use customize to modify this, or restart Emacs after changing it."
2885 )
2886 "Special syntax for emphasized text.
2887 Text starting and ending with a special character will be emphasized, for
2888 example *bold*, _underlined_ and /italic/. This variable sets the marker
2889 characters, the face to bbe used by font-lock for highlighting in Org-mode
2890 Emacs buffers, and the HTML tags to be used for this.
2891 Use customize to modify this, or restart Emacs after changing it."
2903 ;;; The faces
2906 "Faces in Org-mode."
2911 "Make a compatible face specification.
2912 XEmacs and Emacs 21 do not know about the `min-colors' attribute.
2913 For them we convert a (min-colors 8) entry to a `tty' entry and move it
2914 to the top of the list. The `min-colors' attribute will be removed from
2915 any other entries, and any resulting duplicates will be removed entirely."
2929 specs))
2934 "Face used to hide leading stars in headlines.
2935 The forground color of this face should be equal to the background
2936 color of the frame."
2947 "Face used for level 1 headlines."
2957 "Face used for level 2 headlines."
2969 "Face used for level 3 headlines."
2981 "Face used for level 4 headlines."
2989 "Face used for level 5 headlines."
2997 "Face used for level 6 headlines."
3005 "Face used for level 7 headlines."
3013 "Face used for level 8 headlines."
3021 "Face used for special keywords."
3031 "Face for deadlines and TODO keywords."
3044 "Face for headline with the ARCHIVE tag."
3051 "Face for links."
3058 "Face for links."
3063 "Face for tags."
3073 "Face for TODO keywords."
3082 "Face used for todo keywords that indicate DONE items."
3090 "Face used to indicate that a headline is DONE.
3091 This face is only used if `org-fontify-done-headline' is set. If applies
3092 to the part of the headline after the DONE keyword."
3103 "Face used for tables."
3113 "Face for formulas."
3122 "Face for items scheduled for a certain day."
3132 "Face for items scheduled previously, and not yet done."
3142 "Face for items scheduled previously, and not yet done."
3150 "Face used for time grids."
3155 org-level-5 org-level-6 org-level-7 org-level-8
3156 ))
3160 ;;; Variables for pre-computed regular expressions, all buffer local
3172 "Matches a headline and puts TODO state into group 2 if present.
3214 rear-nonsticky t mouse-map t fontified t)
3221 s)
3226 s)
3235 "Modified `buffer-invisibility-spec' for Emacs 21.
3236 Some ops with invisible text do not work correctly on Emacs 21. For these
3237 we turn off invisibility temporarily. Use this in a `let' form."
3241 "Make VAR local in current buffer and set it to VALUE."
3245 "Check if the current buffer is in Org-mode."
3249 "Return the last element of LIST."
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."
3300 kwds key value cat arch tags links hw dws tail sep kws1)
3322 links)))
3325 l var val)
3340 )))
3344 ;; Process the TODO keywords
3346 ;; Use the global values as if they had been given locally.
3367 ;; Process the tags.
3377 tgs))
3385 ;; Compute the regular expressions and other local variables
3390 org-not-done-keywords
3392 org-todo-regexp
3395 org-not-done-regexp
3399 org-todo-line-regexp
3403 org-nl-done-regexp
3407 org-todo-line-tags-regexp
3411 org-looking-at-done-regexp
3416 org-deadline-time-regexp
3418 org-deadline-line-regexp
3420 org-scheduled-regexp
3422 org-scheduled-time-regexp
3424 org-closed-time-regexp
3426 org-keyword-time-regexp
3432 org-keyword-time-not-clock-regexp
3437 org-maybe-keyword-time-regexp
3447 ;;; Some variables ujsed in various places
3452 "Function to be called when `C-c C-c' is used.
3455 ;;; Foreign variables, to inform the compiler
3457 ;; XEmacs only
3462 ;; Emacs only
3465 ;; Packages that org-mode interacts with
3497 ;; FIXME: Occasionally check by commenting these, to make sure
3498 ;; no other functions uses these, forgetting to let-bind them.
3506 ;; Defined somewhere in this file, but used before definition.
3519 ;;;; Emacs/XEmacs compatibility
3521 ;; Overlay compatibility functions
3539 "Make overlay OVL display TEXT with face FACE."
3549 "Make overlay OVL display TEXT with face FACE."
3563 ;; FIXME: this is currently not used
3572 ;; FIXME: this is currently not used
3574 "Find all overlays specifying PROP at POS or point.
3575 If DELETE is non-nil, delete all those overlays."
3577 ov found)
3581 found))
3583 ;; Region compatibility
3586 "Add-hook, compatible with both Emacsen."
3595 "Is `transient-mark-mode' on and the region active?
3596 Works on both Emacs and XEmacs."
3598 nil
3603 ;; Invisibility compatibility
3606 "Add elements to `buffer-invisibility-spec'.
3607 See documentation for `buffer-invisibility-spec' for the kind of elements
3608 that can be added."
3619 "Remove elements from `buffer-invisibility-spec'."
3626 ;; FIXME: this is currently not used
3628 "Is ARG a member of `buffer-invisibility-spec'?"
3631 nil))
3633 ;;;; Define the Org-mode
3636 (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or ugrade to newer allout, for example by switching to Emacs 22."))
3639 ;; We use a before-change function to check if a table might need
3640 ;; an update.
3642 "Indicates that a table might need an update.
3643 This variable is set by `org-before-change-function'.
3652 ;;;###autoload
3654 "Outline-based notes management and organizer, alias
3657 Org-mode develops organizational tasks around a NOTES file which
3658 contains information about projects as plain text. Org-mode is
3659 implemented on top of outline-mode, which is ideal to keep the content
3660 of large files well structured. It supports ToDo items, deadlines and
3661 time stamps, which magically appear in the diary listing of the Emacs
3662 calendar. Tables are easily created with a built-in table editor.
3663 Plain text URL-like links connect to websites, emails (VM), Usenet
3664 messages (Gnus), BBDB entries, and any files related to the project.
3665 For printing and sharing of notes, an Org-mode file (or a part of it)
3666 can be exported as a structured ASCII or HTML file.
3668 The following commands are available:
3672 ;; Get rid of Outline menus, they are not needed
3673 ;; Need to do this here because define-derived-mode sets up
3674 ;; the keymap so late. Still, it is a waste to call this each time
3675 ;; we switch another buffer into org-mode.
3678 ;; Assume this is Greg's port, it used easymenu
3703 ;; Calc embedded
3710 ;; Activate before-change-function
3714 ;; Check for running clock before killing a buffer
3716 ;; Paragraphs and auto-filling
3721 ;; Comment characters
3722 ; (org-set-local 'comment-start "#") ;; FIXME: this breaks wrapping
3725 ;; Make isearch reveal context
3728 ;; Emacs 21 and XEmacs make use of the hook
3730 ;; Emacs 22 deals with this through a special variable
3734 ;; If empty file that did not turn on org-mode automatically, make it to.
3755 "Call COMMAND interactively, but pretend prefix are was ARG."
3764 "Current time, possibly rounded to `org-time-stamp-rounding-minutes'."
3774 "Add text properties to entire string, from beginning to end.
3775 PLIST may be a list of properties, PROPS are individual properties and values
3776 that will be added to PLIST. Returns the string that was modified."
3779 string)
3783 ;;;; Font-Lock stuff, including the activators
3788 (org-defkey org-mouse-map
3789 (if (featurep 'xemacs) [button3] [mouse-3]) 'org-find-file-at-mouse)
3790 (when org-mouse-1-follows-link
3791 (org-defkey org-mouse-map [follow-link] 'mouse-face))
3792 (when org-tab-follows-link
3793 (org-defkey org-mouse-map [(tab)] 'org-open-at-point)
3794 (org-defkey org-mouse-map "\C-i" 'org-open-at-point))
3795 (when org-return-follows-link
3796 (org-defkey org-mouse-map [(return)] 'org-open-at-point)
3797 (org-defkey org-mouse-map "\C-m" 'org-open-at-point))
3799 (require 'font-lock)
3802 (defconst org-link-types '("https?" "ftp" "mailto" "file" "news" "bbdb" "vm"
3803 "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp"))
3804 (defconst org-link-re-with-space
3805 (concat
3808 "[^" org-non-link-chars "]*"
3810 "Matches a link with spaces, optional angular brackets around it.")
3812 (defconst org-link-re-with-space2
3813 (concat
3818 "Matches a link with spaces, optional angular brackets around it.")
3820 (defconst org-angle-link-re
3821 (concat
3824 "[^" org-non-link-chars "]*"
3826 "Matches link with angular brackets, spaces are allowed.")
3827 (defconst org-plain-link-re
3828 (concat
3831 "Matches plain link, without spaces.")
3833 (defconst org-bracket-link-regexp
3835 "Matches a link in double brackets.")
3837 (defconst org-bracket-link-analytic-regexp
3838 (concat
3845 ; 1: http:
3846 ; 2: http
3847 ; 3: path
3848 ; 4: [desc]
3849 ; 5: desc
3851 (defconst org-any-link-re
3855 "Regular expression matching any link.")
3857 (defconst org-ts-lengths
3858 (cons (length (format-time-string (car org-time-stamp-formats)))
3859 (length (format-time-string (cdr org-time-stamp-formats))))
3860 "This holds the lengths of the two different time formats.")
3862 "Regular expression for fast time stamp matching.")
3864 "Regular expression for fast time stamp matching.")
3865 (defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\([^]0-9>\r\n]*\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
3866 "Regular expression matching time strings for analysis.")
3867 (defconst org-ts-regexp2 (concat "<" org-ts-regexp1 ">")
3868 "Regular expression matching time stamps, with groups.")
3869 (defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[]>]")
3870 "Regular expression matching time stamps (also [..]), with groups.")
3871 (defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp)
3872 "Regular expression matching a time stamp range.")
3873 (defconst org-tr-regexp-both
3874 (concat org-ts-regexp-both "--?-?" org-ts-regexp-both)
3875 "Regular expression matching a time stamp range.")
3878 "Regular expression matching a time stamp or time stamp range.")
3881 "Regular expression matching a time stamp or time stamp range.
3882 The time stamps may be either active or inactive.")
3884 (defvar org-emph-face nil)
3886 (defun org-do-emphasis-faces (limit)
3887 "Run through the buffer and add overlays to links."
3888 (let (rtn)
3889 (while (and (not rtn) (re-search-forward org-emph-re limit t))
3890 (if (not (= (char-after (match-beginning 3))
3891 (char-after (match-beginning 4))))
3892 (progn
3893 (setq rtn t)
3894 (font-lock-prepend-text-property (match-beginning 2) (match-end 2)
3895 'face
3896 (nth 1 (assoc (match-string 3)
3897 org-emphasis-alist)))
3898 (add-text-properties (match-beginning 2) (match-end 2)
3899 '(font-lock-multiline t))
3900 (backward-char 1))))
3901 rtn))
3903 (defun org-activate-plain-links (limit)
3904 "Run through the buffer and add overlays to links."
3905 (if (re-search-forward org-plain-link-re limit t)
3906 (progn
3907 (add-text-properties (match-beginning 0) (match-end 0)
3908 (list 'mouse-face 'highlight
3909 'rear-nonsticky t
3910 'keymap org-mouse-map
3911 ))
3912 t)))
3914 (defun org-activate-angle-links (limit)
3915 "Run through the buffer and add overlays to links."
3916 (if (re-search-forward org-angle-link-re limit t)
3917 (progn
3918 (add-text-properties (match-beginning 0) (match-end 0)
3919 (list 'mouse-face 'highlight
3920 'rear-nonsticky t
3921 'keymap org-mouse-map
3922 ))
3923 t)))
3925 (defmacro org-maybe-intangible (props)
3926 "Add '(intangigble t) to PROPS if Emacs version is earlier than Emacs 22.
3927 In emacs 21, invisible text is not avoided by the command loop, so the
3928 intangible property is needed to make sure point skips this text.
3929 In Emacs 22, this is not necessary. The intangible text property has
3930 led to problems with flyspell. These problems are fixed in flyspell.el,
3931 but we still avoid setting the property in Emacs 22 and later.
3932 We use a macro so that the test can happen at compilation time."
3933 (if (< emacs-major-version 22)
3934 `(append '(intangible t) ,props)
3935 props))
3937 (defun org-activate-bracket-links (limit)
3938 "Run through the buffer and add overlays to bracketed links."
3939 (if (re-search-forward org-bracket-link-regexp limit t)
3940 (let* ((help (concat "LINK: "
3941 (org-match-string-no-properties 1)))
3942 ;; FIXME: above we should remove the escapes.
3943 ;; but that requires another match, protecting match data,
3944 ;; a lot of overhead for font-lock.
3945 (ip (org-maybe-intangible
3946 (list 'invisible 'org-link 'rear-nonsticky t
3947 'keymap org-mouse-map 'mouse-face 'highlight
3948 'help-echo help)))
3949 (vp (list 'rear-nonsticky t
3950 'keymap org-mouse-map 'mouse-face 'highlight
3951 'help-echo help)))
3952 ;; We need to remove the invisible property here. Table narrowing
3953 ;; may have made some of this invisible.
3954 (remove-text-properties (match-beginning 0) (match-end 0)
3955 '(invisible nil))
3956 (if (match-end 3)
3957 (progn
3958 (add-text-properties (match-beginning 0) (match-beginning 3) ip)
3959 (add-text-properties (match-beginning 3) (match-end 3) vp)
3960 (add-text-properties (match-end 3) (match-end 0) ip))
3961 (add-text-properties (match-beginning 0) (match-beginning 1) ip)
3962 (add-text-properties (match-beginning 1) (match-end 1) vp)
3963 (add-text-properties (match-end 1) (match-end 0) ip))
3964 t)))
3966 (defun org-activate-dates (limit)
3967 "Run through the buffer and add overlays to dates."
3968 (if (re-search-forward org-tsr-regexp-both limit t)
3969 (progn
3970 (add-text-properties (match-beginning 0) (match-end 0)
3971 (list 'mouse-face 'highlight
3972 'rear-nonsticky t
3973 'keymap org-mouse-map))
3974 (when org-display-custom-times
3975 (if (match-end 3)
3976 (org-display-custom-time (match-beginning 3) (match-end 3)))
3977 (org-display-custom-time (match-beginning 1) (match-end 1)))
3978 t)))
3980 (defvar org-target-link-regexp nil
3981 "Regular expression matching radio targets in plain text.")
3983 "Regular expression matching a link target.")
3985 "Regular expression matching a link target.")
3987 (defun org-activate-target-links (limit)
3988 "Run through the buffer and add overlays to target matches."
3989 (when org-target-link-regexp
3990 (let ((case-fold-search t))
3991 (if (re-search-forward org-target-link-regexp limit t)
3992 (progn
3993 (add-text-properties (match-beginning 0) (match-end 0)
3994 (list 'mouse-face 'highlight
3995 'rear-nonsticky t
3996 'keymap org-mouse-map
3997 'help-echo "Radio target link"
3998 'org-linked-text t))
3999 t)))))
4001 (defun org-update-radio-target-regexp ()
4002 "Find all radio targets in this file and update the regular expression."
4003 (interactive)
4004 (when (memq 'radio org-activate-links)
4005 (setq org-target-link-regexp
4006 (org-make-target-link-regexp (org-all-targets 'radio)))
4007 (org-restart-font-lock)))
4009 (defun org-hide-wide-columns (limit)
4010 (let (s e)
4011 (setq s (text-property-any (point) (or limit (point-max))
4012 'org-cwidth t))
4013 (when s
4014 (setq e (next-single-property-change s 'org-cwidth))
4015 (add-text-properties s e (org-maybe-intangible '(invisible org-cwidth)))
4016 (goto-char e)
4017 t)))
4019 (defun org-restart-font-lock ()
4020 "Restart font-lock-mode, to force refontification."
4021 (when (and (boundp 'font-lock-mode) font-lock-mode)
4022 (font-lock-mode -1)
4023 (font-lock-mode 1)))
4025 (defun org-all-targets (&optional radio)
4026 "Return a list of all targets in this file.
4027 With optional argument RADIO, only find radio targets."
4028 (let ((re (if radio org-radio-target-regexp org-target-regexp))
4029 rtn)
4030 (save-excursion
4031 (goto-char (point-min))
4032 (while (re-search-forward re nil t)
4033 (add-to-list 'rtn (downcase (org-match-string-no-properties 1))))
4034 rtn)))
4036 (defun org-make-target-link-regexp (targets)
4037 "Make regular expression matching all strings in TARGETS.
4038 The regular expression finds the targets also if there is a line break
4039 between words."
4040 (and targets
4041 (concat
4043 (mapconcat
4044 (lambda (x)
4045 (while (string-match " +" x)
4047 x)
4048 targets
4052 (defun org-activate-tags (limit)
4054 (progn
4055 (add-text-properties (match-beginning 1) (match-end 1)
4056 (list 'mouse-face 'highlight
4057 'rear-nonsticky t
4058 'keymap org-mouse-map))
4059 t)))
4061 (defun org-outline-level ()
4062 (save-excursion
4063 (looking-at outline-regexp)
4064 (if (match-beginning 1)
4065 (+ (org-get-string-indentation (match-string 1)) 1000)
4066 (- (match-end 0) (match-beginning 0)))))
4068 (defvar org-font-lock-keywords nil)
4070 (defun org-set-font-lock-defaults ()
4071 (let* ((em org-fontify-emphasized-text)
4072 (lk org-activate-links)
4073 (org-font-lock-extra-keywords
4074 ;; Headlines
4075 (list
4077 (2 (org-get-level-face 2)) (3 (org-get-level-face 3)))
4079 (1 'org-table))
4080 ;; Links
4081 (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t)))
4082 (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t)))
4083 (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t)))
4084 (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t)))
4085 (if (memq 'date lk) '(org-activate-dates (0 'org-date t)))
4086 (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
4087 '(org-hide-wide-columns (0 nil append))
4088 ;; TODO lines
4090 '(1 'org-todo t))
4091 ;; Priorities
4093 ;; Special keywords
4094 (list org-repeat-re '(0 'org-special-keyword t))
4099 ;; Emphasis
4100 (if em
4101 (if (featurep 'xemacs)
4102 '(org-do-emphasis-faces (0 nil append))
4103 '(org-do-emphasis-faces)))
4104 ;; Checkboxes, similar to Frank Ruell's org-checklet.el
4106 2 'bold prepend)
4107 (if org-provide-checkbox-statistics
4109 (0 (org-get-checkbox-statistics-face) t)))
4110 ;; COMMENT
4113 '(1 'org-special-keyword t))
4114 '("^#.*" (0 'font-lock-comment-face t))
4115 ;; DONE
4116 (if org-fontify-done-headline
4120 '(1 'org-done t) '(2 'org-headline-done t))
4124 '(1 'org-done t)))
4125 ;; Table stuff
4129 (if org-format-transports-properties-p
4132 )))
4133 (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
4134 ;; Now set the full font-lock-keywords
4135 (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords)
4136 (org-set-local 'font-lock-defaults
4137 '(org-font-lock-keywords t nil nil backward-paragraph))
4138 (kill-local-variable 'font-lock-keywords) nil))
4140 (defvar org-m nil)
4141 (defvar org-l nil)
4142 (defvar org-f nil)
4143 (defun org-get-level-face (n)
4144 "Get the right face for match N in font-lock matching of healdines."
4145 (setq org-l (- (match-end 2) (match-beginning 1)))
4146 (if org-odd-levels-only (setq org-l (1+ (/ org-l 2))))
4147 ; (setq org-f (nth (1- (% org-l org-n-levels)) org-level-faces))
4148 (setq org-f (nth (% (1- org-l) org-n-levels) org-level-faces))
4149 (cond
4150 ((eq n 1) (if org-hide-leading-stars 'org-hide org-f))
4151 ((eq n 2) org-f)
4152 (t (if org-level-color-stars-only nil org-f))))
4154 (defun org-unfontify-region (beg end &optional maybe_loudly)
4155 "Remove fontification and activation overlays from links."
4156 (font-lock-default-unfontify-region beg end)
4157 (let* ((buffer-undo-list t)
4158 (inhibit-read-only t) (inhibit-point-motion-hooks t)
4159 (inhibit-modification-hooks t)
4160 deactivate-mark buffer-file-name buffer-file-truename)
4161 (remove-text-properties beg end
4162 '(mouse-face t keymap t org-linked-text t
4163 rear-nonsticky t
4164 invisible t intangible t))))
4166 ;;;; Visibility cycling, including org-goto and indirect buffer
4168 ;;; Cycling
4170 (defvar org-cycle-global-status nil)
4171 (make-variable-buffer-local 'org-cycle-global-status)
4172 (defvar org-cycle-subtree-status nil)
4173 (make-variable-buffer-local 'org-cycle-subtree-status)
4175 ;;;###autoload
4176 (defun org-cycle (&optional arg)
4177 "Visibility cycling for Org-mode.
4179 - When this function is called with a prefix argument, rotate the entire
4180 buffer through 3 states (global cycling)
4181 1. OVERVIEW: Show only top-level headlines.
4182 2. CONTENTS: Show all headlines of all levels, but no body text.
4183 3. SHOW ALL: Show everything.
4185 - When point is at the beginning of a headline, rotate the subtree started
4186 by this line through 3 different states (local cycling)
4187 1. FOLDED: Only the main headline is shown.
4188 2. CHILDREN: The main headline and the direct children are shown.
4189 From this state, you can move to one of the children
4190 and zoom in further.
4191 3. SUBTREE: Show the entire subtree, including body text.
4193 - When there is a numeric prefix, go up to a heading with level ARG, do
4194 a `show-subtree' and return to the previous cursor position. If ARG
4195 is negative, go up that many levels.
4197 - When point is not at the beginning of a headline, execute
4198 `indent-relative', like TAB normally does. See the option
4199 `org-cycle-emulate-tab' for details.
4201 - Special case: if point is the the beginning of the buffer and there is
4202 no headline in line 1, this function will act as if called with prefix arg."
4203 (interactive "P")
4204 (let* ((outline-regexp
4205 (if (and (org-mode-p) org-cycle-include-plain-lists)
4207 outline-regexp))
4208 (bob-special (and org-cycle-global-at-bob (bobp)
4209 (not (looking-at outline-regexp))))
4210 (org-cycle-hook
4211 (if bob-special
4212 (delq 'org-optimize-window-after-visibility-change
4213 (copy-sequence org-cycle-hook))
4214 org-cycle-hook))
4215 (pos (point)))
4217 (if (or bob-special (equal arg '(4)))
4218 ;; special case: use global cycling
4219 (setq arg t))
4221 (cond
4223 ((org-at-table-p 'any)
4224 ;; Enter the table or move to the next field in the table
4225 (or (org-table-recognize-table.el)
4226 (progn
4227 (if arg (org-table-edit-field t)
4228 (org-table-justify-field-maybe)
4229 (call-interactively 'org-table-next-field)))))
4231 ((eq arg t) ;; Global cycling
4233 (cond
4234 ((and (eq last-command this-command)
4235 (eq org-cycle-global-status 'overview))
4236 ;; We just created the overview - now do table of contents
4237 ;; This can be slow in very large buffers, so indicate action
4238 (message "CONTENTS...")
4239 (org-content)
4240 (message "CONTENTS...done")
4241 (setq org-cycle-global-status 'contents)
4242 (run-hook-with-args 'org-cycle-hook 'contents))
4244 ((and (eq last-command this-command)
4245 (eq org-cycle-global-status 'contents))
4246 ;; We just showed the table of contents - now show everything
4247 (show-all)
4248 (message "SHOW ALL")
4249 (setq org-cycle-global-status 'all)
4250 (run-hook-with-args 'org-cycle-hook 'all))
4252 (t
4253 ;; Default action: go to overview
4254 (org-overview)
4255 (message "OVERVIEW")
4256 (setq org-cycle-global-status 'overview)
4257 (run-hook-with-args 'org-cycle-hook 'overview))))
4259 ((integerp arg)
4260 ;; Show-subtree, ARG levels up from here.
4261 (save-excursion
4262 (org-back-to-heading)
4263 (outline-up-heading (if (< arg 0) (- arg)
4264 (- (funcall outline-level) arg)))
4265 (org-show-subtree)))
4267 ((save-excursion (beginning-of-line 1) (looking-at outline-regexp))
4268 ;; At a heading: rotate between three different views
4269 (org-back-to-heading)
4270 (let ((goal-column 0) eoh eol eos)
4271 ;; First, some boundaries
4272 (save-excursion
4273 (org-back-to-heading)
4274 (save-excursion
4275 (beginning-of-line 2)
4276 (while (and (not (eobp)) ;; this is like `next-line'
4277 (get-char-property (1- (point)) 'invisible))
4278 (beginning-of-line 2)) (setq eol (point)))
4279 (outline-end-of-heading) (setq eoh (point))
4280 (org-end-of-subtree t)
4282 (beginning-of-line 1) ; in case this is an item
4283 (setq eos (1- (point))))
4284 ;; Find out what to do next and set `this-command'
4285 (cond
4286 ((= eos eoh)
4287 ;; Nothing is hidden behind this heading
4288 (message "EMPTY ENTRY")
4289 (setq org-cycle-subtree-status nil))
4290 ((>= eol eos)
4291 ;; Entire subtree is hidden in one line: open it
4292 (org-show-entry)
4293 (show-children)
4294 (message "CHILDREN")
4295 (setq org-cycle-subtree-status 'children)
4296 (run-hook-with-args 'org-cycle-hook 'children))
4297 ((and (eq last-command this-command)
4298 (eq org-cycle-subtree-status 'children))
4299 ;; We just showed the children, now show everything.
4300 (org-show-subtree)
4301 (message "SUBTREE")
4302 (setq org-cycle-subtree-status 'subtree)
4303 (run-hook-with-args 'org-cycle-hook 'subtree))
4304 (t
4305 ;; Default action: hide the subtree.
4306 (hide-subtree)
4307 (message "FOLDED")
4308 (setq org-cycle-subtree-status 'folded)
4309 (run-hook-with-args 'org-cycle-hook 'folded)))))
4311 ;; TAB emulation
4312 (buffer-read-only (org-back-to-heading))
4314 ((org-try-cdlatex-tab))
4316 ((if (and (memq org-cycle-emulate-tab '(white whitestart))
4318 (or (and (eq org-cycle-emulate-tab 'white)
4319 (= (match-end 0) (point-at-eol)))
4320 (and (eq org-cycle-emulate-tab 'whitestart)
4321 (>= (match-end 0) pos))))
4322 t
4323 (eq org-cycle-emulate-tab t))
4326 (point-at-bol) (point))))
4327 (progn
4328 (beginning-of-line 1)
4330 (indent-relative))
4332 (t (save-excursion
4333 (org-back-to-heading)
4334 (org-cycle))))))
4336 ;;;###autoload
4337 (defun org-global-cycle (&optional arg)
4338 "Cycle the global visibility. For details see `org-cycle'."
4339 (interactive "P")
4340 (let ((org-cycle-include-plain-lists
4341 (if (org-mode-p) org-cycle-include-plain-lists nil)))
4342 (if (integerp arg)
4343 (progn
4344 (show-all)
4345 (hide-sublevels arg)
4346 (setq org-cycle-global-status 'contents))
4347 (org-cycle '(4)))))
4349 (defun org-overview ()
4350 "Switch to overview mode, shoing only top-level headlines.
4351 Really, this shows all headlines with level equal or greater than the level
4352 of the first headline in the buffer. This is important, because if the
4353 first headline is not level one, then (hide-sublevels 1) gives confusing
4354 results."
4355 (interactive)
4356 (let ((level (save-excursion
4357 (goto-char (point-min))
4358 (if (re-search-forward (concat "^" outline-regexp) nil t)
4359 (progn
4360 (goto-char (match-beginning 0))
4361 (funcall outline-level))))))
4362 (and level (hide-sublevels level))))
4364 (defun org-content (&optional arg)
4365 "Show all headlines in the buffer, like a table of contents.
4366 With numerical argument N, show content up to level N."
4367 (interactive "P")
4368 (save-excursion
4369 ;; Visit all headings and show their offspring
4370 (and (integerp arg) (org-overview))
4371 (goto-char (point-max))
4372 (catch 'exit
4373 (while (and (progn (condition-case nil
4374 (outline-previous-visible-heading 1)
4375 (error (goto-char (point-min))))
4376 t)
4377 (looking-at outline-regexp))
4378 (if (integerp arg)
4379 (show-children (1- arg))
4380 (show-branches))
4381 (if (bobp) (throw 'exit nil))))))
4384 (defun org-optimize-window-after-visibility-change (state)
4385 "Adjust the window after a change in outline visibility.
4386 This function is the default value of the hook `org-cycle-hook'."
4387 (when (get-buffer-window (current-buffer))
4388 (cond
4389 ((eq state 'overview) (org-first-headline-recenter 1))
4390 ((eq state 'content) nil)
4391 ((eq state 'all) nil)
4392 ((eq state 'folded) nil)
4393 ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1)))
4394 ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1))))))
4397 (defun org-cycle-show-empty-lines (state)
4398 "Show empty lines above all visible headlines.
4399 The region to be covered depends on STATE when called through
4400 `org-cycle-hook'. Lisp program can use t for STATE to get the
4401 entire buffer covered. Note that an empty line is only shown if there
4402 are at least `org-cycle-separator-lines' empty lines before the headeline."
4403 (when (> org-cycle-separator-lines 0)
4404 (save-excursion
4405 (let* ((n org-cycle-separator-lines)
4406 (re (cond
4409 (t (let ((ns (number-to-string (- n 2))))
4412 beg end)
4413 (cond
4414 ((memq state '(overview content t))
4415 (setq beg (point-min) end (point-max)))
4416 ((memq state '(children))
4417 (setq beg (point) end (org-end-of-subtree t t))))
4418 (when beg
4419 (goto-char beg)
4420 (while (re-search-forward re end t)
4421 (if (not (get-char-property (match-end 1) 'invisible))
4422 (outline-flag-region
4423 (match-beginning 1) (match-end 1) nil))))))))
4425 (defun org-subtree-end-visible-p ()
4426 "Is the end of the current subtree visible?"
4427 (pos-visible-in-window-p
4428 (save-excursion (org-end-of-subtree t) (point))))
4430 (defun org-first-headline-recenter (&optional N)
4431 "Move cursor to the first headline and recenter the headline.
4432 Optional argument N means, put the headline into the Nth line of the window."
4433 (goto-char (point-min))
4435 (beginning-of-line)
4436 (recenter (prefix-numeric-value N))))
4438 ;;; Org-goto
4440 (defvar org-goto-window-configuration nil)
4441 (defvar org-goto-marker nil)
4442 (defvar org-goto-map (make-sparse-keymap))
4443 (let ((cmds '(isearch-forward isearch-backward)) cmd)
4444 (while (setq cmd (pop cmds))
4445 (substitute-key-definition cmd cmd org-goto-map global-map)))
4446 (org-defkey org-goto-map "\C-m" 'org-goto-ret)
4447 (org-defkey org-goto-map [(left)] 'org-goto-left)
4448 (org-defkey org-goto-map [(right)] 'org-goto-right)
4449 (org-defkey org-goto-map [(?q)] 'org-goto-quit)
4450 (org-defkey org-goto-map [(control ?g)] 'org-goto-quit)
4451 (org-defkey org-goto-map "\C-i" 'org-cycle)
4452 (org-defkey org-goto-map [(tab)] 'org-cycle)
4453 (org-defkey org-goto-map [(down)] 'outline-next-visible-heading)
4454 (org-defkey org-goto-map [(up)] 'outline-previous-visible-heading)
4455 (org-defkey org-goto-map "n" 'outline-next-visible-heading)
4456 (org-defkey org-goto-map "p" 'outline-previous-visible-heading)
4457 (org-defkey org-goto-map "f" 'outline-forward-same-level)
4458 (org-defkey org-goto-map "b" 'outline-backward-same-level)
4459 (org-defkey org-goto-map "u" 'outline-up-heading)
4460 (org-defkey org-goto-map "\C-c\C-n" 'outline-next-visible-heading)
4461 (org-defkey org-goto-map "\C-c\C-p" 'outline-previous-visible-heading)
4462 (org-defkey org-goto-map "\C-c\C-f" 'outline-forward-same-level)
4463 (org-defkey org-goto-map "\C-c\C-b" 'outline-backward-same-level)
4464 (org-defkey org-goto-map "\C-c\C-u" 'outline-up-heading)
4465 (let ((l '(1 2 3 4 5 6 7 8 9 0)))
4466 (while l (org-defkey org-goto-map (int-to-string (pop l)) 'digit-argument)))
4468 (defconst org-goto-help
4469 "Select a location to jump to, press RET
4470 \[Up]/[Down]=next/prev headline TAB=cycle visibility RET=select [Q]uit")
4472 (defun org-goto ()
4473 "Go to a different location of the document, keeping current visibility.
4475 When you want to go to a different location in a document, the fastest way
4476 is often to fold the entire buffer and then dive into the tree. This
4477 method has the disadvantage, that the previous location will be folded,
4478 which may not be what you want.
4480 This command works around this by showing a copy of the current buffer in
4481 overview mode. You can dive into the tree in that copy, to find the
4482 location you want to reach. When pressing RET, the command returns to the
4483 original buffer in which the visibility is still unchanged. It then jumps
4484 to the new location, making it and the headline hierarchy above it visible."
4485 (interactive)
4486 (let* ((org-goto-start-pos (point))
4487 (selected-point
4488 (org-get-location (current-buffer) org-goto-help)))
4489 (if selected-point
4490 (progn
4491 (org-mark-ring-push org-goto-start-pos)
4492 (goto-char selected-point)
4493 (if (or (org-invisible-p) (org-invisible-p2))
4494 (org-show-context 'org-goto)))
4495 (error "Quit"))))
4497 (defvar org-selected-point nil) ; dynamically scoped parameter
4499 (defun org-get-location (buf help)
4500 "Let the user select a location in the Org-mode buffer BUF.
4501 This function uses a recursive edit. It returns the selected position
4502 or nil."
4503 (let (org-selected-point)
4504 (save-excursion
4505 (save-window-excursion
4506 (delete-other-windows)
4507 (switch-to-buffer (get-buffer-create "*org-goto*"))
4508 (with-output-to-temp-buffer "*Help*"
4509 (princ help))
4510 (shrink-window-if-larger-than-buffer (get-buffer-window "*Help*"))
4511 (setq buffer-read-only nil)
4512 (erase-buffer)
4513 (insert-buffer-substring buf)
4514 (let ((org-startup-truncated t)
4515 (org-startup-folded t)
4516 (org-startup-align-all-tables nil))
4517 (org-mode))
4518 (setq buffer-read-only t)
4519 (if (and (boundp 'org-goto-start-pos)
4520 (integer-or-marker-p org-goto-start-pos))
4521 (let ((org-show-hierarchy-above t)
4522 (org-show-siblings t)
4523 (org-show-following-heading t))
4524 (goto-char org-goto-start-pos)
4525 (and (org-invisible-p) (org-show-context)))
4526 (goto-char (point-min)))
4527 (org-beginning-of-line)
4528 (message "Select location and press RET")
4529 ;; now we make sure that during selection, ony very few keys work
4530 ;; and that it is impossible to switch to another window.
4531 (let ((gm (current-global-map))
4532 (overriding-local-map org-goto-map))
4533 (unwind-protect
4534 (progn
4535 (use-global-map org-goto-map)
4536 (recursive-edit))
4537 (use-global-map gm)))))
4538 (kill-buffer "*org-goto*")
4539 org-selected-point))
4541 (defun org-goto-ret (&optional arg)
4542 "Finish `org-goto' by going to the new location."
4543 (interactive "P")
4544 (setq org-selected-point (point)
4545 current-prefix-arg arg)
4546 (throw 'exit nil))
4548 (defun org-goto-left ()
4549 "Finish `org-goto' by going to the new location."
4550 (interactive)
4551 (if (org-on-heading-p)
4552 (progn
4553 (beginning-of-line 1)
4554 (setq org-selected-point (point)
4555 current-prefix-arg (- (match-end 0) (match-beginning 0)))
4556 (throw 'exit nil))
4557 (error "Not on a heading")))
4559 (defun org-goto-right ()
4560 "Finish `org-goto' by going to the new location."
4561 (interactive)
4562 (if (org-on-heading-p)
4563 (progn
4564 (outline-end-of-subtree)
4565 (or (eobp) (forward-char 1))
4566 (setq org-selected-point (point)
4567 current-prefix-arg (- (match-end 0) (match-beginning 0)))
4568 (throw 'exit nil))
4569 (error "Not on a heading")))
4571 (defun org-goto-quit ()
4572 "Finish `org-goto' without cursor motion."
4573 (interactive)
4574 (setq org-selected-point nil)
4575 (throw 'exit nil))
4577 ;;; Indirect buffer display of subtrees
4579 (defvar org-indirect-dedicated-frame nil
4580 "This is the frame being used for indirect tree display.")
4581 (defvar org-last-indirect-buffer nil)
4583 (defun org-tree-to-indirect-buffer (&optional arg)
4584 "Create indirect buffer and narrow it to current subtree.
4585 With numerical prefix ARG, go up to this level and then take that tree.
4586 If ARG is negative, go up that many levels.
4587 Normally this command removes the indirect buffer previously made
4588 with this command. However, when called with a C-u prefix, the last buffer
4589 is kept so that you can work with several indirect buffers at the same time.
4590 If `org-indirect-buffer-display' is `dedicated-frame', the C-u prefix also
4591 requests that a new frame be made for the new buffer, so that the dedicated
4592 frame is not changed."
4593 (interactive "P")
4594 (let ((cbuf (current-buffer))
4595 (cwin (selected-window))
4596 (pos (point))
4597 beg end level heading ibuf)
4598 (save-excursion
4599 (org-back-to-heading t)
4600 (when (numberp arg)
4601 (setq level (org-outline-level))
4602 (if (< arg 0) (setq arg (+ level arg)))
4603 (while (> (setq level (org-outline-level)) arg)
4604 (outline-up-heading 1 t)))
4605 (setq beg (point)
4606 heading (org-get-heading))
4607 (org-end-of-subtree t) (setq end (point)))
4608 (if (and (not arg)
4609 (buffer-live-p org-last-indirect-buffer))
4610 (kill-buffer org-last-indirect-buffer))
4611 (setq ibuf (org-get-indirect-buffer cbuf)
4612 org-last-indirect-buffer ibuf)
4613 (cond
4614 ((or (eq org-indirect-buffer-display 'new-frame)
4615 (and arg (eq org-indirect-buffer-display 'dedicated-frame)))
4616 (select-frame (make-frame))
4617 (delete-other-windows)
4618 (switch-to-buffer ibuf)
4619 (org-set-frame-title heading))
4620 ((eq org-indirect-buffer-display 'dedicated-frame)
4621 (raise-frame
4622 (select-frame (or (and org-indirect-dedicated-frame
4623 (frame-live-p org-indirect-dedicated-frame)
4624 org-indirect-dedicated-frame)
4625 (setq org-indirect-dedicated-frame (make-frame)))))
4626 (delete-other-windows)
4627 (switch-to-buffer ibuf)
4628 (org-set-frame-title (concat "Indirect: " heading)))
4629 ((eq org-indirect-buffer-display 'current-window)
4630 (switch-to-buffer ibuf))
4631 ((eq org-indirect-buffer-display 'other-window)
4632 (pop-to-buffer ibuf))
4633 (t (error "Invalid value.")))
4634 (if (featurep 'xemacs)
4635 (save-excursion (org-mode) (turn-on-font-lock)))
4636 (narrow-to-region beg end)
4637 (show-all)
4638 (goto-char pos)
4639 (and (window-live-p cwin) (select-window cwin))))
4641 (defun org-get-indirect-buffer (&optional buffer)
4642 (setq buffer (or buffer (current-buffer)))
4643 (let ((n 1) (base (buffer-name buffer)) bname)
4644 (while (buffer-live-p
4645 (get-buffer (setq bname (concat base "-" (number-to-string n)))))
4646 (setq n (1+ n)))
4647 (condition-case nil
4648 (make-indirect-buffer buffer bname 'clone)
4649 (error (make-indirect-buffer buffer bname)))))
4651 (defun org-set-frame-title (title)
4652 "Set the title of the current frame to the string TITLE."
4653 ;; FIXME: how to name a single frame in XEmacs???
4654 (unless (featurep 'xemacs)
4655 (modify-frame-parameters (selected-frame) (list (cons 'name title)))))
4657 ;;;; Structure editing
4659 ;;; Inserting headlines
4661 (defun org-insert-heading (&optional force-heading)
4662 "Insert a new heading or item with same depth at point.
4663 If point is in a plain list and FORCE-HEADING is nil, create a new list item.
4664 If point is at the beginning of a headline, insert a sibling before the
4665 current headline. If point is in the middle of a headline, split the headline
4666 at that position and make the rest of the headline part of the sibling below
4667 the current headline."
4668 (interactive "P")
4669 (if (= (buffer-size) 0)
4671 (when (or force-heading (not (org-insert-item)))
4672 (let* ((head (save-excursion
4673 (condition-case nil
4674 (progn
4675 (org-back-to-heading)
4676 (match-string 0))
4677 (error "*"))))
4678 (blank (cdr (assq 'heading org-blank-before-new-entry)))
4679 pos)
4680 (cond
4681 ((and (org-on-heading-p) (bolp)
4682 (or (bobp)
4683 (save-excursion (backward-char 1) (not (org-invisible-p)))))
4684 (open-line (if blank 2 1)))
4685 ((and (bolp)
4686 (or (bobp)
4687 (save-excursion
4688 (backward-char 1) (not (org-invisible-p)))))
4689 nil)
4690 (t (newline (if blank 2 1))))
4691 (insert head) (just-one-space)
4692 (setq pos (point))
4693 (end-of-line 1)
4694 (unless (= (point) pos) (just-one-space) (backward-delete-char 1))
4695 (run-hooks 'org-insert-heading-hook)))))
4698 (defun org-insert-todo-heading (arg)
4699 "Insert a new heading with the same level and TODO state as current heading.
4700 If the heading has no TODO state, or if the state is DONE, use the first
4701 state (TODO by default). Also with prefix arg, force first state."
4702 (interactive "P")
4703 (when (not (org-insert-item 'checkbox))
4704 (org-insert-heading)
4705 (save-excursion
4706 (org-back-to-heading)
4707 (outline-previous-heading)
4708 (looking-at org-todo-line-regexp))
4709 (if (or arg
4710 (not (match-beginning 2))
4711 (member (match-string 2) org-done-keywords))
4712 (insert (car org-todo-keywords-1) " ")
4713 (insert (match-string 2) " "))))
4715 ;;; Promotion and Demotion
4717 (defun org-promote-subtree ()
4718 "Promote the entire subtree.
4719 See also `org-promote'."
4720 (interactive)
4721 (save-excursion
4722 (org-map-tree 'org-promote))
4723 (org-fix-position-after-promote))
4725 (defun org-demote-subtree ()
4726 "Demote the entire subtree. See `org-demote'.
4727 See also `org-promote'."
4728 (interactive)
4729 (save-excursion
4730 (org-map-tree 'org-demote))
4731 (org-fix-position-after-promote))
4734 (defun org-do-promote ()
4735 "Promote the current heading higher up the tree.
4736 If the region is active in `transient-mark-mode', promote all headings
4737 in the region."
4738 (interactive)
4739 (save-excursion
4740 (if (org-region-active-p)
4741 (org-map-region 'org-promote (region-beginning) (region-end))
4742 (org-promote)))
4743 (org-fix-position-after-promote))
4745 (defun org-do-demote ()
4746 "Demote the current heading lower down the tree.
4747 If the region is active in `transient-mark-mode', demote all headings
4748 in the region."
4749 (interactive)
4750 (save-excursion
4751 (if (org-region-active-p)
4752 (org-map-region 'org-demote (region-beginning) (region-end))
4753 (org-demote)))
4754 (org-fix-position-after-promote))
4756 (defun org-fix-position-after-promote ()
4757 "Make sure that after pro/demotion cursor position is right."
4758 (let ((pos (point)))
4759 (when (save-excursion
4760 (beginning-of-line 1)
4761 (looking-at org-todo-line-regexp)
4762 (or (equal pos (match-end 1)) (equal pos (match-end 2))))
4763 (cond ((eobp) (insert " "))
4764 ((eolp) (insert " "))
4765 ((equal (char-after) ?\ ) (forward-char 1))))))
4767 (defun org-get-legal-level (level &optional change)
4768 "Rectify a level change under the influence of `org-odd-levels-only'
4769 LEVEL is a current level, CHANGE is by how much the level should be
4770 modified. Even if CHANGE is nil, LEVEL may be returned modified because
4771 even level numbers will become the next higher odd number."
4772 (if org-odd-levels-only
4773 (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2))))
4774 ((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2))))
4775 ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2))))))
4776 (max 1 (+ level change))))
4778 (defun org-promote ()
4779 "Promote the current heading higher up the tree.
4780 If the region is active in `transient-mark-mode', promote all headings
4781 in the region."
4782 (org-back-to-heading t)
4783 (let* ((level (save-match-data (funcall outline-level)))
4784 (up-head (make-string (org-get-legal-level level -1) ?*))
4785 (diff (abs (- level (length up-head)))))
4786 (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary"))
4787 (replace-match up-head nil t)
4788 ;; Fixup tag positioning
4789 (and org-auto-align-tags (org-set-tags nil t))
4790 (if org-adapt-indentation (org-fixup-indentation (- diff)))))
4792 (defun org-demote ()
4793 "Demote the current heading lower down the tree.
4794 If the region is active in `transient-mark-mode', demote all headings
4795 in the region."
4796 (org-back-to-heading t)
4797 (let* ((level (save-match-data (funcall outline-level)))
4798 (down-head (make-string (org-get-legal-level level 1) ?*))
4799 (diff (abs (- level (length down-head)))))
4800 (replace-match down-head nil t)
4801 ;; Fixup tag positioning
4802 (and org-auto-align-tags (org-set-tags nil t))
4803 (if org-adapt-indentation (org-fixup-indentation diff))))
4805 (defun org-map-tree (fun)
4806 "Call FUN for every heading underneath the current one."
4807 (org-back-to-heading)
4808 (let ((level (funcall outline-level)))
4809 (save-excursion
4810 (funcall fun)
4811 (while (and (progn
4812 (outline-next-heading)
4813 (> (funcall outline-level) level))
4814 (not (eobp)))
4815 (funcall fun)))))
4817 (defun org-map-region (fun beg end)
4818 "Call FUN for every heading between BEG and END."
4819 (let ((org-ignore-region t))
4820 (save-excursion
4821 (setq end (copy-marker end))
4822 (goto-char beg)
4823 (if (and (re-search-forward (concat "^" outline-regexp) nil t)
4824 (< (point) end))
4825 (funcall fun))
4826 (while (and (progn
4827 (outline-next-heading)
4828 (< (point) end))
4829 (not (eobp)))
4830 (funcall fun)))))
4832 (defun org-fixup-indentation (diff)
4833 "Change the indentation in the current entry by DIFF
4834 However, if any line in the current entry has no indentation, or if it
4835 would end up with no indentation after the change, nothing at all is done."
4836 (save-excursion
4837 (let ((end (save-excursion (outline-next-heading)
4838 (point-marker)))
4839 (prohibit (if (> diff 0)
4842 col)
4843 (unless (save-excursion (re-search-forward prohibit end t))
4845 (goto-char (match-end 0))
4846 (setq col (current-column))
4847 (if (< diff 0) (replace-match ""))
4848 (indent-to (+ diff col))))
4849 (move-marker end nil))))
4851 (defun org-convert-to-odd-levels ()
4852 "Convert an org-mode file with all levels allowed to one with odd levels.
4853 This will leave level 1 alone, convert level 2 to level 3, level 3 to
4854 level 5 etc."
4855 (interactive)
4856 (when (yes-or-no-p "Are you sure you want to globally change levels to odd? ")
4857 (let ((org-odd-levels-only nil) n)
4858 (save-excursion
4859 (goto-char (point-min))
4861 (setq n (1- (length (match-string 0))))
4862 (while (>= (setq n (1- n)) 0)
4863 (org-demote))
4864 (end-of-line 1))))))
4867 (defun org-convert-to-oddeven-levels ()
4868 "Convert an org-mode file with only odd levels to one with odd and even levels.
4869 This promotes level 3 to level 2, level 5 to level 3 etc. If the file contains a
4870 section with an even level, conversion would destroy the structure of the file. An error
4871 is signaled in this case."
4872 (interactive)
4873 (goto-char (point-min))
4874 ;; First check if there are no even levels
4876 (org-show-context t)
4877 (error "Not all levels are odd in this file. Conversion not possible."))
4878 (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ")
4879 (let ((org-odd-levels-only nil) n)
4880 (save-excursion
4881 (goto-char (point-min))
4883 (setq n (/ (length (match-string 0)) 2))
4884 (while (>= (setq n (1- n)) 0)
4885 (org-promote))
4886 (end-of-line 1))))))
4888 (defun org-tr-level (n)
4889 "Make N odd if required."
4890 (if org-odd-levels-only (1+ (/ n 2)) n))
4892 ;;; Vertical tree motion, cutting and pasting of subtrees
4894 (defun org-move-subtree-up (&optional arg)
4895 "Move the current subtree up past ARG headlines of the same level."
4896 (interactive "p")
4897 (org-move-subtree-down (- (prefix-numeric-value arg))))
4899 (defun org-move-subtree-down (&optional arg)
4900 "Move the current subtree down past ARG headlines of the same level."
4901 (interactive "p")
4902 (setq arg (prefix-numeric-value arg))
4903 (let ((movfunc (if (> arg 0) 'outline-get-next-sibling
4904 'outline-get-last-sibling))
4905 (ins-point (make-marker))
4906 (cnt (abs arg))
4907 beg end txt folded)
4908 ;; Select the tree
4909 (org-back-to-heading)
4910 (setq beg (point))
4911 (save-match-data
4912 (save-excursion (outline-end-of-heading)
4913 (setq folded (org-invisible-p)))
4914 (outline-end-of-subtree))
4915 (outline-next-heading)
4916 (setq end (point))
4917 ;; Find insertion point, with error handling
4918 (goto-char beg)
4919 (while (> cnt 0)
4920 (or (and (funcall movfunc) (looking-at outline-regexp))
4921 (progn (goto-char beg)
4922 (error "Cannot move past superior level or buffer limit")))
4923 (setq cnt (1- cnt)))
4924 (if (> arg 0)
4925 ;; Moving forward - still need to move over subtree
4926 (progn (outline-end-of-subtree)
4927 (outline-next-heading)
4928 (if (not (or (looking-at (concat "^" outline-regexp))
4929 (bolp)))
4930 (newline))))
4931 (move-marker ins-point (point))
4932 (setq txt (buffer-substring beg end))
4933 (delete-region beg end)
4934 (insert txt)
4936 (goto-char ins-point)
4937 (if folded (hide-subtree))
4938 (move-marker ins-point nil)))
4940 (defvar org-subtree-clip ""
4941 "Clipboard for cut and paste of subtrees.
4942 This is actually only a copy of the kill, because we use the normal kill
4943 ring. We need it to check if the kill was created by `org-copy-subtree'.")
4945 (defvar org-subtree-clip-folded nil
4946 "Was the last copied subtree folded?
4947 This is used to fold the tree back after pasting.")
4949 (defun org-cut-subtree ()
4950 "Cut the current subtree into the clipboard.
4951 This is a short-hand for marking the subtree and then cutting it."
4952 (interactive)
4953 (org-copy-subtree 'cut))
4955 (defun org-copy-subtree (&optional cut)
4956 "Cut the current subtree into the clipboard.
4957 This is a short-hand for marking the subtree and then copying it.
4958 If CUT is non-nil, actually cut the subtree."
4959 (interactive)
4960 (let (beg end folded)
4961 (org-back-to-heading)
4962 (setq beg (point))
4963 (save-match-data
4964 (save-excursion (outline-end-of-heading)
4965 (setq folded (org-invisible-p)))
4966 (outline-end-of-subtree))
4968 (setq end (point))
4969 (goto-char beg)
4970 (when (> end beg)
4971 (setq org-subtree-clip-folded folded)
4972 (if cut (kill-region beg end) (copy-region-as-kill beg end))
4973 (setq org-subtree-clip (current-kill 0))
4974 (message "%s: Subtree with %d characters"
4975 (if cut "Cut" "Copied")
4976 (length org-subtree-clip)))))
4978 (defun org-paste-subtree (&optional level tree)
4979 "Paste the clipboard as a subtree, with modification of headline level.
4980 The entire subtree is promoted or demoted in order to match a new headline
4981 level. By default, the new level is derived from the visible headings
4982 before and after the insertion point, and taken to be the inferior headline
4983 level of the two. So if the previous visible heading is level 3 and the
4984 next is level 4 (or vice versa), level 4 will be used for insertion.
4985 This makes sure that the subtree remains an independent subtree and does
4986 not swallow low level entries.
4988 You can also force a different level, either by using a numeric prefix
4989 argument, or by inserting the heading marker by hand. For example, if the
4994 If optional TREE is given, use this text instead of the kill ring."
4995 (interactive "P")
4996 (unless (org-kill-is-subtree-p tree)
4997 (error
4998 (substitute-command-keys
5000 (let* ((txt (or tree (and kill-ring (current-kill 0))))
5005 (old-level (if (string-match ^re txt)
5006 (- (match-end 0) (match-beginning 0))
5007 -1))
5008 (force-level (cond (level (prefix-numeric-value level))
5009 ((string-match
5010 ^re_ (buffer-substring (point-at-bol) (point)))
5011 (- (match-end 0) (match-beginning 0)))
5012 (t nil)))
5013 (previous-level (save-excursion
5014 (condition-case nil
5015 (progn
5016 (outline-previous-visible-heading 1)
5017 (if (looking-at re)
5018 (- (match-end 0) (match-beginning 0))
5019 1))
5020 (error 1))))
5021 (next-level (save-excursion
5022 (condition-case nil
5023 (progn
5024 (outline-next-visible-heading 1)
5025 (if (looking-at re)
5026 (- (match-end 0) (match-beginning 0))
5027 1))
5028 (error 1))))
5029 (new-level (or force-level (max previous-level next-level)))
5030 (shift (if (or (= old-level -1)
5031 (= new-level -1)
5032 (= old-level new-level))
5033 0
5034 (- new-level old-level)))
5035 (shift1 shift)
5036 (delta (if (> shift 0) -1 1))
5037 (func (if (> shift 0) 'org-demote 'org-promote))
5038 (org-odd-levels-only nil)
5039 beg end)
5040 ;; Remove the forces level indicator
5041 (if force-level
5042 (delete-region (point-at-bol) (point)))
5043 ;; Make sure we start at the beginning of an empty line
5047 ;; Paste
5048 (setq beg (point))
5051 (insert txt)
5052 (setq end (point))
5055 (goto-char beg)
5056 ;; Shift if necessary
5057 (if (= shift 0)
5058 (message "Pasted at level %d, without shift" new-level)
5059 (save-restriction
5060 (narrow-to-region beg end)
5061 (while (not (= shift 0))
5062 (org-map-region func (point-min) (point-max))
5063 (setq shift (+ delta shift)))
5064 (goto-char (point-min))
5065 (message "Pasted at level %d, with shift by %d levels"
5066 new-level shift1)))
5067 (if (and kill-ring
5068 (eq org-subtree-clip (current-kill 0))
5069 org-subtree-clip-folded)
5070 ;; The tree was folded before it was killed/copied
5071 (hide-subtree))))
5073 (defun org-kill-is-subtree-p (&optional txt)
5074 "Check if the current kill is an outline subtree, or a set of trees.
5075 Returns nil if kill does not start with a headline, or if the first
5076 headline level is not the largest headline level in the tree.
5077 So this will actually accept several entries of equal levels as well,
5078 which is OK for `org-paste-subtree'.
5079 If optional TXT is given, check this string instead of the current kill."
5080 (let* ((kill (or txt (and kill-ring (current-kill 0)) ""))
5081 (start-level (and kill
5083 (- (match-end 0) (match-beginning 0))))
5084 (re (concat "^" outline-regexp))
5085 (start 1))
5086 (if (not start-level)
5087 nil ;; does not even start with a heading
5088 (catch 'exit
5089 (while (setq start (string-match re kill (1+ start)))
5090 (if (< (- (match-end 0) (match-beginning 0)) start-level)
5091 (throw 'exit nil)))
5092 t))))
5094 (defun org-narrow-to-subtree ()
5095 "Narrow buffer to the current subtree."
5096 (interactive)
5097 (save-excursion
5098 (narrow-to-region
5099 (progn (org-back-to-heading) (point))
5100 (progn (org-end-of-subtree t t) (point)))))
5103 ;;; Outline Sorting
5105 (defun org-sort (with-case)
5106 "Call `org-sort-entries' or `org-table-sort-lines', depending on context."
5107 (interactive "P")
5108 (if (org-at-table-p)
5109 (org-call-with-arg 'org-table-sort-lines with-case)
5110 (org-call-with-arg 'org-sort-entries with-case)))
5112 (defun org-sort-entries (&optional with-case sorting-type)
5113 "Sort entries on a certain level of an outline tree.
5114 If there is an active region, the entries in the region are sorted.
5115 Else, if the cursor is before the first entry, sort the top-level items.
5116 Else, the children of the entry at point are sorted.
5118 Sorting can be alphabetically, numerically, and by date/time as given by
5119 the first time stamp in the entry. The command prompts for the sorting
5120 type unless it has been given to the function through the SORTING-TYPE
5121 argument, which needs to a character, any of (?n ?N ?a ?A ?t ?T).
5123 Comparing entries ignores case by default. However, with an optional argument
5124 WITH-CASE, the sorting considers case as well. With two prefix arguments
5125 `C-u C-u', sorting is case-sensitive and duplicate entries will be removed."
5126 (interactive "P")
5127 (let ((unique (equal with-case '(16)))
5128 start beg end entries stars re re2 p nentries (nremoved 0)
5129 last txt what)
5130 ;; Find beginning and end of region to sort
5131 (cond
5132 ((org-region-active-p)
5133 ;; we will sort the region
5134 (setq end (region-end)
5135 what "region")
5136 (goto-char (region-beginning))
5137 (if (not (org-on-heading-p)) (outline-next-heading))
5138 (setq start (point)))
5139 ((or (org-on-heading-p)
5140 (condition-case nil (progn (org-back-to-heading) t) (error nil)))
5141 ;; we will sort the children of the current headline
5142 (org-back-to-heading)
5143 (setq start (point) end (org-end-of-subtree) what "children")
5144 (goto-char start)
5145 (show-subtree)
5146 (outline-next-heading))
5147 (t
5148 ;; we will sort the top-level entries in this file
5149 (goto-char (point-min))
5150 (or (org-on-heading-p) (outline-next-heading))
5151 (setq start (point) end (point-max) what "top-level")
5152 (goto-char start)
5153 (show-all)))
5154 (setq beg (point))
5155 (if (>= (point) end) (error "Nothing to sort"))
5157 (setq stars (match-string 1)
5158 re (concat "^" (regexp-quote stars) " +")
5159 re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[^*]")
5160 txt (buffer-substring beg end))
5162 (if (and (not (equal stars "*")) (string-match re2 txt))
5163 (error "Region to sort contains a level above the first entry"))
5164 ;; Make a list that can be sorted.
5165 ;; The car is the string for comparison, the cdr is the subtree
5166 (message "Sorting entries...")
5167 (setq entries
5168 (mapcar
5169 (lambda (x)
5171 (cons (match-string 0 x) x))
5172 (org-split-string txt re)))
5174 ;; Sort the list
5175 (save-excursion
5176 (goto-char start)
5177 (setq entries (org-do-sort entries what with-case sorting-type)))
5179 ;; Delete the old stuff
5180 (goto-char beg)
5181 (kill-region beg end)
5182 (setq nentries (length entries))
5183 ;; Insert the sorted entries, and remove duplicates if this is required
5184 (while (setq p (pop entries))
5185 (if (and unique (equal last (setq last (org-trim (cdr p)))))
5186 (setq nremoved (1+ nremoved)) ; same entry as before, skip it
5187 (insert stars " " (cdr p))))
5188 (goto-char start)
5189 (message "Sorting entries...done (%d entries%s)"
5190 nentries
5191 (if unique (format ", %d duplicates removed" nremoved) ""))))
5193 (defun org-do-sort (table what &optional with-case sorting-type)
5194 "Sort TABLE of WHAT according to SORTING-TYPE.
5195 The user will be prompted for the SORTING-TYPE if the call to this
5196 function does not specify it. WHAT is only for the prompt, to indicate
5197 what is being sorted. The sorting key will be extracted from
5198 the car of the elements of the table.
5199 If WITH-CASE is non-nil, the sorting will be case-sensitive."
5200 (unless sorting-type
5201 (message
5202 "Sort %s: [a]lphabetically [n]umerically [t]ime. A/N/T means reversed:"
5203 what)
5204 (setq sorting-type (read-char-exclusive)))
5205 (let ((dcst (downcase sorting-type))
5206 extractfun comparefun)
5207 ;; Define the appropriate functions
5208 (cond
5209 ((= dcst ?n)
5210 (setq extractfun 'string-to-number
5211 comparefun (if (= dcst sorting-type) '< '>)))
5212 ((= dcst ?a)
5213 (setq extractfun (if with-case 'identity 'downcase)
5214 comparefun (if (= dcst sorting-type)
5215 'string<
5216 (lambda (a b) (and (not (string< a b))
5217 (not (string= a b)))))))
5218 ((= dcst ?t)
5219 (setq extractfun
5220 (lambda (x)
5221 (if (string-match org-ts-regexp x)
5222 (time-to-seconds
5223 (org-time-string-to-time (match-string 0 x)))
5224 0))
5225 comparefun (if (= dcst sorting-type) '< '>)))
5226 (t (error "Invalid sorting type `%c'" sorting-type)))
5228 (sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x)))
5229 table)
5230 (lambda (a b) (funcall comparefun (car a) (car b))))))
5232 ;;;; Plain list items, including checkboxes
5234 ;;; Plain list items
5236 (defun org-at-item-p ()
5237 "Is point in a line starting a hand-formatted item?"
5238 (let ((llt org-plain-list-ordered-item-terminator))
5239 (save-excursion
5240 (goto-char (point-at-bol))
5241 (looking-at
5242 (cond
5246 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))))))
5249 (defun org-in-item-p ()
5250 "It the cursor inside a plain list item.
5251 Does not have to be the first line."
5252 (save-excursion
5253 (condition-case nil
5254 (progn
5255 (org-beginning-of-item)
5256 (org-at-item-p)
5257 t)
5258 (error nil))))
5260 (defun org-insert-item (&optional checkbox)
5261 "Insert a new item at the current level.
5262 Return t when things worked, nil when we are not in an item."
5263 (when (save-excursion
5264 (condition-case nil
5265 (progn
5266 (org-beginning-of-item)
5267 (org-at-item-p)
5268 (if (org-invisible-p) (error "Invisible item"))
5269 t)
5270 (error nil)))
5271 (let* ((bul (match-string 0))
5273 (match-end 0)))
5274 (blank (cdr (assq 'plain-list-item org-blank-before-new-entry)))
5275 pos)
5276 (cond
5277 ((and (org-at-item-p) (<= (point) eow))
5278 ;; before the bullet
5279 (beginning-of-line 1)
5280 (open-line (if blank 2 1)))
5281 ((<= (point) eow)
5282 (beginning-of-line 1))
5283 (t (newline (if blank 2 1))))
5284 (insert bul (if checkbox "[ ]" ""))
5285 (just-one-space)
5286 (setq pos (point))
5287 (end-of-line 1)
5288 (unless (= (point) pos) (just-one-space) (backward-delete-char 1)))
5289 (org-maybe-renumber-ordered-list)
5290 (and checkbox (org-update-checkbox-count-maybe))
5291 t))
5293 ;;; Checkboxes
5295 (defun org-at-item-checkbox-p ()
5296 "Is point at a line starting a plain-list item with a checklet?"
5297 (and (org-at-item-p)
5298 (save-excursion
5299 (goto-char (match-end 0))
5303 (defun org-toggle-checkbox (&optional arg)
5304 "Toggle the checkbox in the current line."
5305 (interactive "P")
5306 (catch 'exit
5307 (let (beg end status (firstnew 'unknown))
5308 (cond
5309 ((org-region-active-p)
5310 (setq beg (region-beginning) end (region-end)))
5311 ((org-on-heading-p)
5312 (setq beg (point) end (save-excursion (outline-next-heading) (point))))
5313 ((org-at-item-checkbox-p)
5314 (save-excursion
5315 (replace-match (if (equal (match-string 0) "[ ]") "[X]" "[ ]") t t))
5316 (throw 'exit t))
5317 (t (error "Not at a checkbox or heading, and no active region")))
5318 (save-excursion
5319 (goto-char beg)
5320 (while (< (point) end)
5321 (when (org-at-item-checkbox-p)
5322 (setq status (equal (match-string 0) "[X]"))
5323 (when (eq firstnew 'unknown)
5324 (setq firstnew (not status)))
5325 (replace-match
5326 (if (if arg (not status) firstnew) "[X]" "[ ]") t t))
5327 (beginning-of-line 2)))))
5328 (org-update-checkbox-count-maybe))
5330 (defun org-update-checkbox-count-maybe ()
5331 "Update checkbox statistics unless turned off by user."
5332 (when org-provide-checkbox-statistics
5333 (org-update-checkbox-count)))
5335 (defun org-update-checkbox-count (&optional all)
5336 "Update the checkbox statistics in the current section.
5337 This will find all statistic cookies like [57%] and [6/12] and update them
5338 with the current numbers. With optional prefix argument ALL, do this for
5339 the whole buffer."
5340 (interactive "P")
5341 (save-excursion
5342 (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21
5343 (beg (progn (outline-back-to-heading) (point)))
5344 (end (move-marker (make-marker)
5345 (progn (outline-next-heading) (point))))
5348 b1 e1 f1 c-on c-off lim (cstat 0))
5349 (when all
5350 (goto-char (point-min))
5351 (outline-next-heading)
5352 (setq beg (point) end (point-max)))
5353 (goto-char beg)
5354 (while (re-search-forward re end t)
5355 (setq cstat (1+ cstat)
5356 b1 (match-beginning 0)
5357 e1 (match-end 0)
5358 f1 (match-beginning 1)
5359 lim (cond
5360 ((org-on-heading-p) (outline-next-heading) (point))
5361 ((org-at-item-p) (org-end-of-item) (point))
5362 (t nil))
5363 c-on 0 c-off 0)
5364 (goto-char e1)
5365 (when lim
5366 (while (re-search-forward re-box lim t)
5367 (if (equal (match-string 2) "[ ]")
5368 (setq c-off (1+ c-off))
5369 (setq c-on (1+ c-on))))
5370 (delete-region b1 e1)
5371 (goto-char b1)
5372 (insert (if f1
5373 (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off))))
5374 (format "[%d/%d]" c-on (+ c-on c-off))))))
5375 (when (interactive-p)
5376 (message "Checkbox satistics updated %s (%d places)"
5377 (if all "in entire file" "in current outline entry") cstat)))))
5379 (defun org-get-checkbox-statistics-face ()
5380 "Select the face for checkbox statistics.
5381 The face will be `org-done' when all relevant boxes are checked. Otherwise
5382 it will be `org-todo'."
5383 (if (match-end 1)
5384 (if (equal (match-string 1) "100%") 'org-done 'org-todo)
5385 (if (and (> (match-end 2) (match-beginning 2))
5386 (equal (match-string 2) (match-string 3)))
5387 'org-done
5388 'org-todo)))
5390 (defun org-get-indentation (&optional line)
5391 "Get the indentation of the current line, interpreting tabs.
5392 When LINE is given, assume it represents a line and compute its indentation."
5393 (if line
5394 (if (string-match "^ *" (org-remove-tabs line))
5395 (match-end 0))
5396 (save-excursion
5397 (beginning-of-line 1)
5399 (current-column))))
5401 (defun org-remove-tabs (s &optional width)
5402 "Replace tabulators in S with spaces.
5403 Assumes that s is a single line, starting in column 0."
5404 (setq width (or width tab-width))
5406 (setq s (replace-match
5407 (make-string
5408 (- (* width (/ (+ (match-beginning 0) width) width))
5409 (match-beginning 0)) ?\ )
5410 t t s)))
5411 s)
5413 (defun org-fix-indentation (line ind)
5414 "Fix indentation in LINE.
5415 IND is a cons cell with target and minimum indentation.
5416 If the current indenation in LINE is smaller than the minimum,
5417 leave it alone. If it is larger than ind, set it to the target."
5418 (let* ((l (org-remove-tabs line))
5419 (i (org-get-indentation l))
5420 (i1 (car ind)) (i2 (cdr ind)))
5421 (if (>= i i2) (setq l (substring line i2)))
5422 (if (> i1 0)
5423 (concat (make-string i1 ?\ ) l)
5424 l)))
5426 (defcustom org-empty-line-terminates-plain-lists nil
5427 "Non-nil means, an empty line ends all plain list levels.
5428 When nil, empty lines are part of the preceeding item."
5429 :group 'org-plain-lists
5430 :type 'boolean)
5432 (defun org-beginning-of-item ()
5433 "Go to the beginning of the current hand-formatted item.
5434 If the cursor is not in an item, throw an error."
5435 (interactive)
5436 (let ((pos (point))
5437 (limit (save-excursion
5438 (condition-case nil
5439 (progn
5440 (org-back-to-heading)
5441 (beginning-of-line 2) (point))
5442 (error (point-min)))))
5443 (ind-empty (if org-empty-line-terminates-plain-lists 0 10000))
5444 ind ind1)
5445 (if (org-at-item-p)
5446 (beginning-of-line 1)
5447 (beginning-of-line 1)
5449 (setq ind (current-column))
5450 (if (catch 'exit
5451 (while t
5452 (beginning-of-line 0)
5453 (if (or (bobp) (< (point) limit)) (throw 'exit nil))
5456 (setq ind1 ind-empty)
5458 (setq ind1 (current-column)))
5459 (if (< ind1 ind)
5460 (throw 'exit (org-at-item-p)))))
5461 nil
5462 (goto-char pos)
5463 (error "Not in an item")))))
5465 (defun org-end-of-item ()
5466 "Go to the end of the current hand-formatted item.
5467 If the cursor is not in an item, throw an error."
5468 (interactive)
5469 (let* ((pos (point))
5470 ind1
5471 (ind-empty (if org-empty-line-terminates-plain-lists 0 10000))
5472 (limit (save-excursion (outline-next-heading) (point)))
5473 (ind (save-excursion
5474 (org-beginning-of-item)
5476 (current-column)))
5477 (end (catch 'exit
5478 (while t
5479 (beginning-of-line 2)
5480 (if (eobp) (throw 'exit (point)))
5481 (if (>= (point) limit) (throw 'exit (point-at-bol)))
5483 (setq ind1 ind-empty)
5485 (setq ind1 (current-column)))
5486 (if (<= ind1 ind)
5487 (throw 'exit (point-at-bol)))))))
5488 (if end
5489 (goto-char end)
5490 (goto-char pos)
5491 (error "Not in an item"))))
5493 (defun org-next-item ()
5494 "Move to the beginning of the next item in the current plain list.
5495 Error if not at a plain list, or if this is the last item in the list."
5496 (interactive)
5497 (let (ind ind1 (pos (point)))
5498 (org-beginning-of-item)
5499 (setq ind (org-get-indentation))
5500 (org-end-of-item)
5501 (setq ind1 (org-get-indentation))
5502 (unless (and (org-at-item-p) (= ind ind1))
5503 (goto-char pos)
5504 (error "On last item"))))
5506 (defun org-previous-item ()
5507 "Move to the beginning of the previous item in the current plain list.
5508 Error if not at a plain list, or if this is the last item in the list."
5509 (interactive)
5510 (let (beg ind (pos (point)))
5511 (org-beginning-of-item)
5512 (setq beg (point))
5513 (setq ind (org-get-indentation))
5514 (goto-char beg)
5515 (catch 'exit
5516 (while t
5517 (beginning-of-line 0)
5519 nil
5520 (if (<= (org-get-indentation) ind)
5521 (throw 'exit t)))))
5522 (condition-case nil
5523 (org-beginning-of-item)
5524 (error (goto-char pos)
5525 (error "On first item")))))
5527 (defun org-move-item-down ()
5528 "Move the plain list item at point down, i.e. swap with following item.
5529 Subitems (items with larger indentation) are considered part of the item,
5530 so this really moves item trees."
5531 (interactive)
5532 (let (beg end ind ind1 (pos (point)) txt)
5533 (org-beginning-of-item)
5534 (setq beg (point))
5535 (setq ind (org-get-indentation))
5536 (org-end-of-item)
5537 (setq end (point))
5538 (setq ind1 (org-get-indentation))
5539 (if (and (org-at-item-p) (= ind ind1))
5540 (progn
5541 (org-end-of-item)
5542 (setq txt (buffer-substring beg end))
5543 (save-excursion
5544 (delete-region beg end))
5545 (setq pos (point))
5546 (insert txt)
5547 (goto-char pos)
5548 (org-maybe-renumber-ordered-list))
5549 (goto-char pos)
5550 (error "Cannot move this item further down"))))
5552 (defun org-move-item-up (arg)
5553 "Move the plain list item at point up, i.e. swap with previous item.
5554 Subitems (items with larger indentation) are considered part of the item,
5555 so this really moves item trees."
5556 (interactive "p")
5557 (let (beg end ind ind1 (pos (point)) txt)
5558 (org-beginning-of-item)
5559 (setq beg (point))
5560 (setq ind (org-get-indentation))
5561 (org-end-of-item)
5562 (setq end (point))
5563 (goto-char beg)
5564 (catch 'exit
5565 (while t
5566 (beginning-of-line 0)
5568 (if org-empty-line-terminates-plain-lists
5569 (progn
5570 (goto-char pos)
5571 (error "Cannot move this item further up"))
5572 nil)
5573 (if (<= (setq ind1 (org-get-indentation)) ind)
5574 (throw 'exit t)))))
5575 (condition-case nil
5576 (org-beginning-of-item)
5577 (error (goto-char beg)
5578 (error "Cannot move this item further up")))
5579 (setq ind1 (org-get-indentation))
5580 (if (and (org-at-item-p) (= ind ind1))
5581 (progn
5582 (setq txt (buffer-substring beg end))
5583 (save-excursion
5584 (delete-region beg end))
5585 (setq pos (point))
5586 (insert txt)
5587 (goto-char pos)
5588 (org-maybe-renumber-ordered-list))
5589 (goto-char pos)
5590 (error "Cannot move this item further up"))))
5592 (defun org-maybe-renumber-ordered-list ()
5593 "Renumber the ordered list at point if setup allows it.
5594 This tests the user option `org-auto-renumber-ordered-lists' before
5595 doing the renumbering."
5596 (and org-auto-renumber-ordered-lists
5597 (org-at-item-p)
5598 (match-beginning 3)
5599 (org-renumber-ordered-list 1)))
5601 (defun org-get-string-indentation (s)
5602 "What indentation has S due to SPACE and TAB at the beginning of the string?"
5603 (let ((n -1) (i 0) (w tab-width) c)
5604 (catch 'exit
5605 (while (< (setq n (1+ n)) (length s))
5606 (setq c (aref s n))
5607 (cond ((= c ?\ ) (setq i (1+ i)))
5609 (t (throw 'exit t)))))
5610 i))
5612 (defun org-renumber-ordered-list (arg)
5613 "Renumber an ordered plain list.
5614 Cursor needs to be in the first line of an item, the line that starts
5616 (interactive "p")
5617 (unless (and (org-at-item-p)
5618 (match-beginning 3))
5619 (error "This is not an ordered list"))
5620 (let ((line (org-current-line))
5621 (col (current-column))
5622 (ind (org-get-string-indentation
5623 (buffer-substring (point-at-bol) (match-beginning 3))))
5624 ;; (term (substring (match-string 3) -1))
5625 ind1 (n (1- arg)))
5626 ;; find where this list begins
5627 (catch 'exit
5628 (while t
5629 (catch 'next
5630 (beginning-of-line 0)
5633 (if (or (< ind1 ind)
5634 (and (= ind1 ind)
5635 (not (org-at-item-p))))
5636 (throw 'exit t)))))
5637 ;; Walk forward and replace these numbers
5638 (catch 'exit
5639 (while t
5640 (catch 'next
5641 (beginning-of-line 2)
5642 (if (eobp) (throw 'exit nil))
5645 (if (> ind1 ind) (throw 'next t))
5646 (if (< ind1 ind) (throw 'exit t))
5647 (if (not (org-at-item-p)) (throw 'exit nil))
5648 (if (not (match-beginning 3))
5650 (delete-region (match-beginning 3) (1- (match-end 3)))
5651 (goto-char (match-beginning 3))
5652 (insert (format "%d" (setq n (1+ n)))))))
5653 (goto-line line)
5654 (move-to-column col)))
5656 (defvar org-last-indent-begin-marker (make-marker))
5657 (defvar org-last-indent-end-marker (make-marker))
5659 (defun org-outdent-item (arg)
5660 "Outdent a local list item."
5661 (interactive "p")
5662 (org-indent-item (- arg)))
5664 (defun org-indent-item (arg)
5665 "Indent a local list item."
5666 (interactive "p")
5667 (unless (org-at-item-p)
5668 (error "Not on an item"))
5669 (save-excursion
5670 (let (beg end ind ind1)
5671 (if (memq last-command '(org-shiftmetaright org-shiftmetaleft))
5672 (setq beg org-last-indent-begin-marker
5673 end org-last-indent-end-marker)
5674 (org-beginning-of-item)
5675 (setq beg (move-marker org-last-indent-begin-marker (point)))
5676 (org-end-of-item)
5677 (setq end (move-marker org-last-indent-end-marker (point))))
5678 (goto-char beg)
5680 (if (< (+ arg ind) 0) (error "Cannot outdent beyond margin"))
5681 (while (< (point) end)
5682 (beginning-of-line 1)
5684 (delete-region (point-at-bol) (point))
5685 (indent-to-column (+ ind1 arg))
5686 (beginning-of-line 2)))))
5688 ;;;; Archiving
5690 (defalias 'org-advertized-archive-subtree 'org-archive-subtree)
5692 (defun org-archive-subtree (&optional find-done)
5693 "Move the current subtree to the archive.
5694 The archive can be a certain top-level heading in the current file, or in
5695 a different file. The tree will be moved to that location, the subtree
5696 heading be marked DONE, and the current time will be added.
5698 When called with prefix argument FIND-DONE, find whole trees without any
5699 open TODO items and archive them (after getting confirmation from the user).
5700 If the cursor is not at a headline when this comand is called, try all level
5701 1 trees. If the cursor is on a headline, only try the direct children of
5702 this heading."
5703 (interactive "P")
5704 (if find-done
5705 (org-archive-all-done)
5706 ;; Save all relevant TODO keyword-relatex variables
5708 (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler
5709 (tr-org-todo-keywords-1 org-todo-keywords-1)
5710 (tr-org-todo-kwd-alist org-todo-kwd-alist)
5711 (tr-org-done-keywords org-done-keywords)
5712 (tr-org-todo-regexp org-todo-regexp)
5713 (tr-org-todo-line-regexp org-todo-line-regexp)
5714 (tr-org-odd-levels-only org-odd-levels-only)
5715 (this-buffer (current-buffer))
5716 (org-archive-location org-archive-location)
5718 file heading buffer level newfile-p)
5720 ;; Try to find a local archive location
5721 (save-excursion
5722 (if (or (re-search-backward re nil t) (re-search-forward re nil t))
5723 (setq org-archive-location (match-string 1))))
5726 (progn
5727 (setq file (format (match-string 1 org-archive-location)
5728 (file-name-nondirectory buffer-file-name))
5729 heading (match-string 2 org-archive-location)))
5730 (error "Invalid `org-archive-location'"))
5731 (if (> (length file) 0)
5732 (setq newfile-p (not (file-exists-p file))
5733 buffer (find-file-noselect file))
5734 (setq buffer (current-buffer)))
5735 (unless buffer
5737 (if (and (> (length heading) 0)
5739 (setq level (match-end 0))
5740 (setq heading nil level 0))
5741 (save-excursion
5742 ;; We first only copy, in case something goes wrong
5743 ;; we need to protect this-command, to avoid kill-region sets it,
5744 ;; which would lead to duplication of subtrees
5745 (let (this-command) (org-copy-subtree))
5746 (set-buffer buffer)
5747 ;; Enforce org-mode for the archive buffer
5748 (if (not (org-mode-p))
5749 ;; Force the mode for future visits.
5750 (let ((org-insert-mode-line-in-empty-file t)
5751 (org-inhibit-startup t))
5752 (call-interactively 'org-mode)))
5753 (when newfile-p
5754 (goto-char (point-max))
5756 (buffer-file-name this-buffer))))
5757 ;; Force the TODO keywords of the original buffer
5758 (let ((org-todo-line-regexp tr-org-todo-line-regexp)
5759 (org-todo-keywords-1 tr-org-todo-keywords-1)
5760 (org-todo-kwd-alist tr-org-todo-kwd-alist)
5761 (org-done-keywords tr-org-done-keywords)
5762 (org-todo-regexp tr-org-todo-regexp)
5763 (org-todo-line-regexp tr-org-todo-line-regexp)
5764 (org-odd-levels-only
5765 (if (local-variable-p 'org-odd-levels-only (current-buffer))
5766 org-odd-levels-only
5767 tr-org-odd-levels-only)))
5768 (goto-char (point-min))
5769 (if heading
5770 (progn
5771 (if (re-search-forward
5774 nil t)
5775 (goto-char (match-end 0))
5776 ;; Heading not found, just insert it at the end
5777 (goto-char (point-max))
5780 (end-of-line 0))
5781 ;; Make the subtree visible
5782 (show-subtree)
5783 (org-end-of-subtree t)
5787 ;; No specific heading, just go to end of file.
5789 ;; Paste
5790 (org-paste-subtree (org-get-legal-level level 1))
5791 ;; Mark the entry as done, i.e. set to last word in org-todo-keywords-1 FIXME: not right anymore!!!!!!!
5792 (if org-archive-mark-done
5793 (let (org-log-done)
5794 (org-todo (length org-todo-keywords-1))))
5795 ;; Move cursor to right after the TODO keyword
5796 (when org-archive-stamp-time
5797 (beginning-of-line 1)
5798 (looking-at org-todo-line-regexp)
5799 (goto-char (or (match-end 2) (match-beginning 3)))
5800 (org-insert-time-stamp (org-current-time) t t "(" ")"))
5801 ;; Save the buffer, if it is not the same buffer.
5802 (if (not (eq this-buffer buffer)) (save-buffer))))
5803 ;; Here we are back in the original buffer. Everything seems to have
5804 ;; worked. So now cut the tree and finish up.
5805 (let (this-command) (org-cut-subtree))
5807 (message "Subtree archived %s"
5808 (if (eq this-buffer buffer)
5809 (concat "under heading: " heading)
5810 (concat "in file: " (abbreviate-file-name file)))))))
5812 (defun org-archive-all-done (&optional tag)
5813 "Archive sublevels of the current tree without open TODO items.
5814 If the cursor is not on a headline, try all level 1 trees. If
5815 it is on a headline, try all direct children.
5816 When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
5818 (rea (concat ".*:" org-archive-tag ":"))
5819 (begm (make-marker))
5820 (endm (make-marker))
5821 (question (if tag "Set ARCHIVE tag (no open TODO items)? "
5822 "Move subtree to archive (no open TODO items)? "))
5823 beg end (cntarch 0))
5824 (if (org-on-heading-p)
5825 (progn
5826 (setq re1 (concat "^" (regexp-quote
5827 (make-string
5828 (1+ (- (match-end 0) (match-beginning 0)))
5829 ?*))
5830 " "))
5831 (move-marker begm (point))
5832 (move-marker endm (org-end-of-subtree t)))
5833 (setq re1 "^* ")
5834 (move-marker begm (point-min))
5835 (move-marker endm (point-max)))
5836 (save-excursion
5837 (goto-char begm)
5838 (while (re-search-forward re1 endm t)
5839 (setq beg (match-beginning 0)
5840 end (save-excursion (org-end-of-subtree t) (point)))
5841 (goto-char beg)
5842 (if (re-search-forward re end t)
5843 (goto-char end)
5844 (goto-char beg)
5845 (if (and (or (not tag) (not (looking-at rea)))
5846 (y-or-n-p question))
5847 (progn
5848 (if tag
5849 (org-toggle-tag org-archive-tag 'on)
5850 (org-archive-subtree))
5851 (setq cntarch (1+ cntarch)))
5852 (goto-char end)))))
5853 (message "%d trees archived" cntarch)))
5855 (defun org-cycle-hide-archived-subtrees (state)
5856 "Re-hide all archived subtrees after a visibility state change."
5857 (when (and (not org-cycle-open-archived-trees)
5858 (not (memq state '(overview folded))))
5859 (save-excursion
5860 (let* ((globalp (memq state '(contents all)))
5861 (beg (if globalp (point-min) (point)))
5862 (end (if globalp (point-max) (org-end-of-subtree t))))
5863 (org-hide-archived-subtrees beg end)
5864 (goto-char beg)
5865 (if (looking-at (concat ".*:" org-archive-tag ":"))
5866 (message (substitute-command-keys
5867 "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway.")))))))
5869 (defun org-force-cycle-archived ()
5870 "Cycle subtree even if it is archived."
5871 (interactive)
5872 (setq this-command 'org-cycle)
5873 (let ((org-cycle-open-archived-trees t))
5874 (call-interactively 'org-cycle)))
5876 (defun org-hide-archived-subtrees (beg end)
5877 "Re-hide all archived subtrees after a visibility state change."
5878 (save-excursion
5879 (let* ((re (concat ":" org-archive-tag ":")))
5880 (goto-char beg)
5881 (while (re-search-forward re end t)
5882 (and (org-on-heading-p) (hide-subtree))
5883 (org-end-of-subtree t)))))
5885 (defun org-toggle-tag (tag &optional onoff)
5886 "Toggle the tag TAG for the current line.
5887 If ONOFF is `on' or `off', don't toggle but set to this state."
5888 (unless (org-on-heading-p t) (error "Not on headling"))
5889 (let (res current)
5890 (save-excursion
5891 (beginning-of-line)
5893 (point-at-eol) t)
5894 (progn
5895 (setq current (match-string 1))
5896 (replace-match ""))
5897 (setq current ""))
5898 (setq current (nreverse (org-split-string current ":")))
5899 (cond
5900 ((eq onoff 'on)
5901 (setq res t)
5902 (or (member tag current) (push tag current)))
5903 ((eq onoff 'off)
5904 (or (not (member tag current)) (setq current (delete tag current))))
5905 (t (if (member tag current)
5906 (setq current (delete tag current))
5907 (setq res t)
5908 (push tag current))))
5909 (end-of-line 1)
5910 (when current
5911 (insert " :" (mapconcat 'identity (nreverse current) ":") ":"))
5912 (org-set-tags nil t))
5913 res))
5915 (defun org-toggle-archive-tag (&optional arg)
5916 "Toggle the archive tag for the current headline.
5917 With prefix ARG, check all children of current headline and offer tagging
5918 the children that do not contain any open TODO items."
5919 (interactive "P")
5920 (if arg
5921 (org-archive-all-done 'tag)
5922 (let (set)
5923 (save-excursion
5924 (org-back-to-heading t)
5925 (setq set (org-toggle-tag org-archive-tag))
5926 (when set (hide-subtree)))
5927 (and set (beginning-of-line 1))
5928 (message "Subtree %s" (if set "archived" "unarchived")))))
5931 ;;;; Tables
5933 ;;; The table editor
5935 ;; Watch out: Here we are talking about two different kind of tables.
5936 ;; Most of the code is for the tables created with the Org-mode table editor.
5937 ;; Sometimes, we talk about tables created and edited with the table.el
5938 ;; Emacs package. We call the former org-type tables, and the latter
5939 ;; table.el-type tables.
5941 (defun org-before-change-function (beg end)
5942 "Every change indicates that a table might need an update."
5943 (setq org-table-may-need-update t))
5946 "Detects an org-type table line.")
5948 "Detects an org-type table line.")
5950 "Detects a table line marked for automatic recalculation.")
5952 "Detects a table line marked for automatic recalculation.")
5954 "Detects a table line marked for automatic recalculation.")
5956 "Detects an org-type table hline.")
5958 "Detects a table-type table hline.")
5960 "Detects an org-type or table-type table.")
5962 "Searching from within a table (any type) this finds the first line
5963 outside the table.")
5965 "Searching from within a table (any type) this finds the first line
5966 outside the table.")
5968 (defvar org-table-last-highlighted-reference nil)
5969 (defvar org-table-formula-history nil)
5971 (defvar org-table-column-names nil
5972 "Alist with column names, derived from the `!' line.")
5973 (defvar org-table-column-name-regexp nil
5974 "Regular expression matching the current column names.")
5975 (defvar org-table-local-parameters nil
5976 "Alist with parameter names, derived from the `$' line.")
5977 (defvar org-table-named-field-locations nil
5978 "Alist with locations of named fields.")
5980 (defvar org-table-current-line-types nil
5981 "Table row types, non-nil only for the duration of a comand.")
5982 (defvar org-table-current-begin-line nil
5983 "Table begin line, non-nil only for the duration of a comand.")
5984 (defvar org-table-current-begin-pos nil
5985 "Table begin position, non-nil only for the duration of a comand.")
5986 (defvar org-table-dlines nil
5987 "Vector of data line line numbers in the current table.")
5988 (defvar org-table-hlines nil
5989 "Vector of hline line numbers in the current table.")
5991 (defconst org-table-range-regexp
5992 "@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?"
5993 ;; 1 2 3 4 5
5994 "Regular expression for matching ranges in formulas.")
5996 (defconst org-table-range-regexp2
5997 (concat
6001 "Match a range for reference display.")
6003 (defconst org-table-translate-regexp
6005 "Match a reference that needs translation, for reference display.")
6007 (defvar org-inhibit-highlight-removal nil) ; dynamically scoped param
6009 (defun org-table-create-with-table.el ()
6010 "Use the table.el package to insert a new table.
6011 If there is already a table at point, convert between Org-mode tables
6012 and table.el tables."
6013 (interactive)
6014 (require 'table)
6015 (cond
6016 ((org-at-table.el-p)
6017 (if (y-or-n-p "Convert table to Org-mode table? ")
6018 (org-table-convert)))
6019 ((org-at-table-p)
6020 (if (y-or-n-p "Convert table to table.el table? ")
6021 (org-table-convert)))
6022 (t (call-interactively 'table-insert))))
6024 (defun org-table-create-or-convert-from-region (arg)
6025 "Convert region to table, or create an empty table.
6026 If there is an active region, convert it to a table. If there is no such
6027 region, create an empty table."
6028 (interactive "P")
6029 (if (org-region-active-p)
6030 (org-table-convert-region (region-beginning) (region-end) arg)
6031 (org-table-create arg)))
6033 (defun org-table-create (&optional size)
6034 "Query for a size and insert a table skeleton.
6036 (interactive "P")
6037 (unless size
6038 (setq size (read-string
6039 (concat "Table size Columns x Rows [e.g. "
6040 org-table-default-size "]: ")
6041 "" nil org-table-default-size)))
6043 (let* ((pos (point))
6044 (indent (make-string (current-column) ?\ ))
6045 (split (org-split-string size " *x *"))
6046 (rows (string-to-number (nth 1 split)))
6047 (columns (string-to-number (car split)))
6048 (line (concat (apply 'concat indent "|" (make-list columns " |"))
6051 (point-at-bol) (point)))
6052 (beginning-of-line 1)
6053 (newline))
6054 ;; (mapcar (lambda (x) (insert line)) (make-list rows t))
6055 (dotimes (i rows) (insert line))
6056 (goto-char pos)
6057 (if (> rows 1)
6058 ;; Insert a hline after the first row.
6059 (progn
6060 (end-of-line 1)
6062 (goto-char pos)))
6063 (org-table-align)))
6065 (defun org-table-convert-region (beg0 end0 &optional nspace)
6066 "Convert region to a table.
6067 The region goes from BEG0 to END0, but these borders will be moved
6068 slightly, to make sure a beginning of line in the first line is included.
6069 When NSPACE is non-nil, it indicates the minimum number of spaces that
6070 separate columns (default: just one space)."
6071 (interactive "rP")
6072 (let* ((beg (min beg0 end0))
6073 (end (max beg0 end0))
6074 (tabsep t)
6075 re)
6076 (goto-char beg)
6077 (beginning-of-line 1)
6078 (setq beg (move-marker (make-marker) (point)))
6079 (goto-char end)
6080 (if (bolp) (backward-char 1) (end-of-line 1))
6081 (setq end (move-marker (make-marker) (point)))
6082 ;; Lets see if this is tab-separated material. If every nonempty line
6083 ;; contains a tab, we will assume that it is tab-separated material
6084 (if nspace
6085 (setq tabsep nil)
6086 (goto-char beg)
6088 (if nspace (setq tabsep nil))
6089 (if tabsep
6092 (max 1 (prefix-numeric-value nspace)))))
6093 (goto-char beg)
6094 (while (re-search-forward re end t)
6095 (replace-match "| " t t))
6096 (goto-char beg)
6097 (insert " ")
6098 (org-table-align)))
6100 (defun org-table-import (file arg)
6101 "Import FILE as a table.
6102 The file is assumed to be tab-separated. Such files can be produced by most
6103 spreadsheet and database applications. If no tabs (at least one per line)
6104 are found, lines will be split on whitespace into fields."
6106 (or (bolp) (newline))
6107 (let ((beg (point))
6108 (pm (point-max)))
6109 (insert-file-contents file)
6110 (org-table-convert-region beg (+ (point) (- (point-max) pm)) arg)))
6112 (defun org-table-export ()
6113 "Export table as a tab-separated file.
6114 Such a file can be imported into a spreadsheet program like Excel."
6115 (interactive)
6116 (let* ((beg (org-table-begin))
6117 (end (org-table-end))
6118 (table (buffer-substring beg end))
6119 (file (read-file-name "Export table to: "))
6120 buf)
6121 (unless (or (not (file-exists-p file))
6122 (y-or-n-p (format "Overwrite file %s? " file)))
6123 (error "Abort"))
6124 (with-current-buffer (find-file-noselect file)
6125 (setq buf (current-buffer))
6126 (erase-buffer)
6127 (fundamental-mode)
6128 (insert table)
6129 (goto-char (point-min))
6131 (replace-match "" t t)
6132 (end-of-line 1))
6133 (goto-char (point-min))
6135 (replace-match "" t t)
6136 (goto-char (min (1+ (point)) (point-max))))
6137 (goto-char (point-min))
6138 (while (re-search-forward "^-[-+]*$" nil t)
6139 (replace-match "")
6141 (delete-char 1)))
6142 (goto-char (point-min))
6145 (save-buffer))
6146 (kill-buffer buf)))
6148 (defvar org-table-aligned-begin-marker (make-marker)
6149 "Marker at the beginning of the table last aligned.
6150 Used to check if cursor still is in that table, to minimize realignment.")
6151 (defvar org-table-aligned-end-marker (make-marker)
6152 "Marker at the end of the table last aligned.
6153 Used to check if cursor still is in that table, to minimize realignment.")
6154 (defvar org-table-last-alignment nil
6155 "List of flags for flushright alignment, from the last re-alignment.
6156 This is being used to correctly align a single field after TAB or RET.")
6157 (defvar org-table-last-column-widths nil
6158 "List of max width of fields in each column.
6159 This is being used to correctly align a single field after TAB or RET.")
6160 (defvar org-table-overlay-coordinates nil
6161 "Overlay coordinates after each align of a table.")
6162 (make-variable-buffer-local 'org-table-overlay-coordinates)
6164 (defvar org-last-recalc-line nil)
6165 (defconst org-narrow-column-arrow "=>"
6166 "Used as display property in narrowed table columns.")
6168 (defun org-table-align ()
6169 "Align the table at point by aligning all vertical bars."
6170 (interactive)
6171 (let* (
6172 ;; Limits of table
6173 (beg (org-table-begin))
6174 (end (org-table-end))
6175 ;; Current cursor position
6176 (linepos (org-current-line))
6177 (colpos (org-table-current-column))
6178 (winstart (window-start))
6179 (winstartline (org-current-line (min winstart (1- (point-max)))))
6180 lines (new "") lengths l typenums ty fields maxfields i
6181 column
6182 (indent "") cnt frac
6183 rfmt hfmt
6184 (spaces '(1 . 1))
6185 (sp1 (car spaces))
6186 (sp2 (cdr spaces))
6187 (rfmt1 (concat
6188 (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|"))
6189 (hfmt1 (concat
6190 (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+"))
6191 emptystrings links dates narrow fmax f1 len c e)
6192 (untabify beg end)
6193 (remove-text-properties beg end '(org-cwidth t org-dwidth t display t))
6194 ;; Check if we have links or dates
6195 (goto-char beg)
6196 (setq links (re-search-forward org-bracket-link-regexp end t))
6197 (goto-char beg)
6198 (setq dates (and org-display-custom-times
6199 (re-search-forward org-ts-regexp-both end t)))
6200 ;; Make sure the link properties are right
6201 (when links (goto-char beg) (while (org-activate-bracket-links end)))
6202 ;; Make sure the date properties are right
6203 (when dates (goto-char beg) (while (org-activate-dates end)))
6205 ;; Check if we are narrowing any columns
6206 (goto-char beg)
6207 (setq narrow (and org-format-transports-properties-p
6208 (re-search-forward "<[0-9]+>" end t)))
6209 ;; Get the rows
6210 (setq lines (org-split-string
6212 ;; Store the indentation of the first line
6213 (if (string-match "^ *" (car lines))
6214 (setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ )))
6215 ;; Mark the hlines by setting the corresponding element to nil
6216 ;; At the same time, we remove trailing space.
6217 (setq lines (mapcar (lambda (l)
6218 (if (string-match "^ *|-" l)
6219 nil
6221 (substring l 0 (match-beginning 0))
6222 l)))
6223 lines))
6224 ;; Get the data fields by splitting the lines.
6225 (setq fields (mapcar
6226 (lambda (l)
6227 (org-split-string l " *| *"))
6228 (delq nil (copy-sequence lines))))
6229 ;; How many fields in the longest line?
6230 (condition-case nil
6231 (setq maxfields (apply 'max (mapcar 'length fields)))
6232 (error
6233 (kill-region beg end)
6234 (org-table-create org-table-default-size)
6235 (error "Empty table - created default table")))
6236 ;; A list of empty strings to fill any short rows on output
6237 (setq emptystrings (make-list maxfields ""))
6238 ;; Check for special formatting.
6239 (setq i -1)
6240 (while (< (setq i (1+ i)) maxfields) ;; Loop over all columns
6241 (setq column (mapcar (lambda (x) (or (nth i x) "")) fields))
6242 ;; Check if there is an explicit width specified
6243 (when narrow
6244 (setq c column fmax nil)
6245 (while c
6246 (setq e (pop c))
6248 (setq fmax (string-to-number (match-string 1 e)) c nil)))
6249 ;; Find fields that are wider than fmax, and shorten them
6250 (when fmax
6251 (loop for xx in column do
6252 (when (and (stringp xx)
6253 (> (org-string-width xx) fmax))
6254 (org-add-props xx nil
6255 'help-echo
6256 (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx))))
6257 (setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax)))
6258 (unless (> f1 1)
6260 (match-string 0 xx)))
6261 (add-text-properties f1 (length xx) (list 'org-cwidth t) xx)
6262 (add-text-properties (- f1 2) f1
6263 (list 'display org-narrow-column-arrow)
6264 xx)))))
6265 ;; Get the maximum width for each column
6266 (push (apply 'max 1 (mapcar 'org-string-width column)) lengths)
6267 ;; Get the fraction of numbers, to decide about alignment of the column
6268 (setq cnt 0 frac 0.0)
6269 (loop for x in column do
6270 (if (equal x "")
6271 nil
6272 (setq frac ( / (+ (* frac cnt)
6273 (if (string-match org-table-number-regexp x) 1 0))
6274 (setq cnt (1+ cnt))))))
6275 (push (>= frac org-table-number-fraction) typenums))
6276 (setq lengths (nreverse lengths) typenums (nreverse typenums))
6278 ;; Store the alignment of this table, for later editing of single fields
6279 (setq org-table-last-alignment typenums
6280 org-table-last-column-widths lengths)
6282 ;; With invisible characters, `format' does not get the field width right
6283 ;; So we need to make these fields wide by hand.
6284 (when links
6285 (loop for i from 0 upto (1- maxfields) do
6286 (setq len (nth i lengths))
6287 (loop for j from 0 upto (1- (length fields)) do
6288 (setq c (nthcdr i (car (nthcdr j fields))))
6289 (if (and (stringp (car c))
6290 (string-match org-bracket-link-regexp (car c))
6291 (< (org-string-width (car c)) len))
6292 (setcar c (concat (car c) (make-string (- len (org-string-width (car c))) ?\ )))))))
6294 ;; Compute the formats needed for output of the table
6295 (setq rfmt (concat indent "|") hfmt (concat indent "|"))
6296 (while (setq l (pop lengths))
6297 (setq ty (if (pop typenums) "" "-")) ; number types flushright
6298 (setq rfmt (concat rfmt (format rfmt1 ty l))
6299 hfmt (concat hfmt (format hfmt1 (make-string l ?-)))))
6303 (setq new (mapconcat
6304 (lambda (l)
6305 (if l (apply 'format rfmt
6306 (append (pop fields) emptystrings))
6307 hfmt))
6308 lines ""))
6309 ;; Replace the old one
6310 (delete-region beg end)
6311 (move-marker end nil)
6312 (move-marker org-table-aligned-begin-marker (point))
6313 (insert new)
6314 (move-marker org-table-aligned-end-marker (point))
6315 (when (and orgtbl-mode (not (org-mode-p)))
6316 (goto-char org-table-aligned-begin-marker)
6317 (while (org-hide-wide-columns org-table-aligned-end-marker)))
6318 ;; Try to move to the old location
6319 (goto-line winstartline)
6320 (setq winstart (point-at-bol))
6321 (goto-line linepos)
6322 (set-window-start (selected-window) winstart 'noforce)
6323 (org-table-goto-column colpos)
6324 (and org-table-overlay-coordinates (org-table-overlay-coordinates))
6325 (setq org-table-may-need-update nil)
6326 ))
6328 (defun org-string-width (s)
6329 "Compute width of string, ignoring invisible characters.
6330 This ignores character with invisibility property `org-link', and also
6331 characters with property `org-cwidth', because these will become invisible
6332 upon the next fontification round."
6333 (let (b l)
6334 (when (or (eq t buffer-invisibility-spec)
6335 (assq 'org-link buffer-invisibility-spec))
6336 (while (setq b (text-property-any 0 (length s)
6337 'invisible 'org-link s))
6338 (setq s (concat (substring s 0 b)
6339 (substring s (or (next-single-property-change
6340 b 'invisible s) (length s)))))))
6341 (while (setq b (text-property-any 0 (length s) 'org-cwidth t s))
6342 (setq s (concat (substring s 0 b)
6343 (substring s (or (next-single-property-change
6344 b 'org-cwidth s) (length s))))))
6345 (setq l (string-width s) b -1)
6346 (while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s))
6347 (setq l (- l (get-text-property b 'org-dwidth-n s))))
6348 l))
6350 (defun org-table-begin (&optional table-type)
6351 "Find the beginning of the table and return its position.
6352 With argument TABLE-TYPE, go to the beginning of a table.el-type table."
6353 (save-excursion
6354 (if (not (re-search-backward
6355 (if table-type org-table-any-border-regexp
6356 org-table-border-regexp)
6357 nil t))
6358 (progn (goto-char (point-min)) (point))
6359 (goto-char (match-beginning 0))
6360 (beginning-of-line 2)
6361 (point))))
6363 (defun org-table-end (&optional table-type)
6364 "Find the end of the table and return its position.
6365 With argument TABLE-TYPE, go to the end of a table.el-type table."
6366 (save-excursion
6367 (if (not (re-search-forward
6368 (if table-type org-table-any-border-regexp
6369 org-table-border-regexp)
6370 nil t))
6371 (goto-char (point-max))
6372 (goto-char (match-beginning 0)))
6373 (point-marker)))
6375 (defun org-table-justify-field-maybe (&optional new)
6376 "Justify the current field, text to left, number to right.
6377 Optional argument NEW may specify text to replace the current field content."
6378 (cond
6379 ((and (not new) org-table-may-need-update)) ; Realignment will happen anyway
6380 ((org-at-table-hline-p))
6381 ((and (not new)
6382 (or (not (equal (marker-buffer org-table-aligned-begin-marker)
6383 (current-buffer)))
6384 (< (point) org-table-aligned-begin-marker)
6385 (>= (point) org-table-aligned-end-marker)))
6386 ;; This is not the same table, force a full re-align
6387 (setq org-table-may-need-update t))
6388 (t ;; realign the current field, based on previous full realign
6389 (let* ((pos (point)) s
6390 (col (org-table-current-column))
6391 (num (if (> col 0) (nth (1- col) org-table-last-alignment)))
6392 l f n o e)
6393 (when (> col 0)
6396 (progn
6397 (setq s (match-string 1)
6398 o (match-string 0)
6399 l (max 1 (- (match-end 0) (match-beginning 0) 3))
6400 e (not (= (match-beginning 2) (match-end 2))))
6401 (setq f (format (if num " %%%ds %s" " %%-%ds %s")
6402 l (if e "|" (setq org-table-may-need-update t) ""))
6403 n (format f s))
6404 (if new
6405 (if (<= (length new) l) ;; FIXME: length -> str-width?
6406 (setq n (format f new))
6407 (setq n (concat new "|") org-table-may-need-update t)))
6408 (or (equal n o)
6409 (let (org-table-may-need-update)
6410 (replace-match n))))
6411 (setq org-table-may-need-update t))
6412 (goto-char pos))))))
6414 (defun org-table-next-field ()
6415 "Go to the next field in the current table, creating new lines as needed.
6416 Before doing so, re-align the table if necessary."
6417 (interactive)
6418 (org-table-maybe-eval-formula)
6419 (org-table-maybe-recalculate-line)
6420 (if (and org-table-automatic-realign
6421 org-table-may-need-update)
6422 (org-table-align))
6423 (let ((end (org-table-end)))
6424 (if (org-at-table-hline-p)
6425 (end-of-line 1))
6426 (condition-case nil
6427 (progn
6428 (re-search-forward "|" end)
6430 (re-search-forward "|" end))
6431 (if (and (looking-at "-")
6432 org-table-tab-jumps-over-hlines
6434 (goto-char (match-beginning 1)))
6435 (if (looking-at "-")
6436 (progn
6437 (beginning-of-line 0)
6438 (org-table-insert-row 'below))
6439 (if (looking-at " ") (forward-char 1))))
6440 (error
6441 (org-table-insert-row 'below)))))
6443 (defun org-table-previous-field ()
6444 "Go to the previous field in the table.
6445 Before doing so, re-align the table if necessary."
6446 (interactive)
6447 (org-table-justify-field-maybe)
6448 (org-table-maybe-recalculate-line)
6449 (if (and org-table-automatic-realign
6450 org-table-may-need-update)
6451 (org-table-align))
6452 (if (org-at-table-hline-p)
6453 (end-of-line 1))
6454 (re-search-backward "|" (org-table-begin))
6455 (re-search-backward "|" (org-table-begin))
6457 (re-search-backward "|" (org-table-begin)))
6458 (if (looking-at "| ?")
6459 (goto-char (match-end 0))))
6461 (defun org-table-next-row ()
6462 "Go to the next row (same column) in the current table.
6463 Before doing so, re-align the table if necessary."
6464 (interactive)
6465 (org-table-maybe-eval-formula)
6466 (org-table-maybe-recalculate-line)
6469 (newline)
6470 (if (and org-table-automatic-realign
6471 org-table-may-need-update)
6472 (org-table-align))
6473 (let ((col (org-table-current-column)))
6474 (beginning-of-line 2)
6475 (if (or (not (org-at-table-p))
6476 (org-at-table-hline-p))
6477 (progn
6478 (beginning-of-line 0)
6479 (org-table-insert-row 'below)))
6480 (org-table-goto-column col)
6482 (if (looking-at " ") (forward-char 1)))))
6484 (defun org-table-copy-down (n)
6485 "Copy a field down in the current column.
6486 If the field at the cursor is empty, copy into it the content of the nearest
6487 non-empty field above. With argument N, use the Nth non-empty field.
6488 If the current field is not empty, it is copied down to the next row, and
6489 the cursor is moved with it. Therefore, repeating this command causes the
6490 column to be filled row-by-row.
6491 If the variable `org-table-copy-increment' is non-nil and the field is an
6492 integer, it will be incremented while copying."
6493 (interactive "p")
6494 (let* ((colpos (org-table-current-column))
6495 (field (org-table-get-field))
6497 (beg (org-table-begin))
6498 txt)
6499 (org-table-check-inside-data-field)
6500 (if non-empty
6501 (progn
6502 (setq txt (org-trim field))
6503 (org-table-next-row)
6504 (org-table-blank-field))
6505 (save-excursion
6506 (setq txt
6507 (catch 'exit
6508 (while (progn (beginning-of-line 1)
6509 (re-search-backward org-table-dataline-regexp
6510 beg t))
6511 (org-table-goto-column colpos t)
6512 (if (and (looking-at
6514 (= (setq n (1- n)) 0))
6515 (throw 'exit (match-string 1))))))))
6516 (if txt
6517 (progn
6518 (if (and org-table-copy-increment
6519 (string-match "^[0-9]+$" txt))
6520 (setq txt (format "%d" (+ (string-to-number txt) 1))))
6521 (insert txt)
6522 (org-table-maybe-recalculate-line)
6523 (org-table-align))
6524 (error "No non-empty field found"))))
6526 (defun org-table-check-inside-data-field ()
6527 "Is point inside a table data field?
6528 I.e. not on a hline or before the first or after the last column?
6529 This actually throws an error, so it aborts the current command."
6530 (if (or (not (org-at-table-p))
6531 (= (org-table-current-column) 0)
6532 (org-at-table-hline-p)
6534 (error "Not in table data field")))
6536 (defvar org-table-clip nil
6537 "Clipboard for table regions.")
6539 (defun org-table-blank-field ()
6540 "Blank the current table field or active region."
6541 (interactive)
6542 (org-table-check-inside-data-field)
6543 (if (and (interactive-p) (org-region-active-p))
6544 (let (org-table-clip)
6545 (org-table-cut-region (region-beginning) (region-end)))
6546 (skip-chars-backward "^|")
6547 (backward-char 1)
6549 (let* ((pos (match-beginning 0))
6550 (match (match-string 0))
6551 (len (org-string-width match)))
6552 (replace-match (concat "|" (make-string (1- len) ?\ )))
6553 (goto-char (+ 2 pos))
6554 (substring match 1)))))
6556 (defun org-table-get-field (&optional n replace)
6557 "Return the value of the field in column N of current row.
6558 N defaults to current field.
6559 If REPLACE is a string, replace field with this value. The return value
6560 is always the old value."
6561 (and n (org-table-goto-column n))
6563 (backward-char 1)
6565 (let* ((pos (match-beginning 0))
6566 (val (buffer-substring (1+ pos) (match-end 0))))
6567 (if replace
6568 (replace-match (concat "|" replace) t t))
6569 (goto-char (min (point-at-eol) (+ 2 pos)))
6570 val)
6571 (forward-char 1) ""))
6574 (defun org-table-field-info (arg)
6575 "Show info about the current field, and highlight any reference at point."
6576 (interactive "P")
6577 (org-table-get-specials)
6578 (save-excursion
6579 (let* ((pos (point))
6580 (col (org-table-current-column))
6581 (cname (car (rassoc (int-to-string col) org-table-column-names)))
6582 (name (car (rassoc (list (org-current-line) col)
6583 org-table-named-field-locations)))
6584 (eql (org-table-get-stored-formulas))
6585 (dline (org-table-current-dline))
6586 (ref (format "@%d$%d" dline col))
6587 (ref1 (org-table-convert-refs-to-an ref))
6588 (fequation (or (assoc name eql) (assoc ref eql)))
6589 (cequation (assoc (int-to-string col) eql))
6590 (eqn (or fequation cequation)))
6591 (goto-char pos)
6592 (condition-case nil
6593 (org-table-show-reference 'local)
6594 (error nil))
6595 (message "line @%d, col $%s%s, ref @%d$%d or %s%s%s"
6596 dline col
6597 (if cname (concat " or $" cname) "")
6598 dline col ref1
6599 (if name (concat " or $" name) "")
6600 ;; FIXME: formula info not correct if special table line
6601 (if eqn
6602 (concat ", formula: "
6603 (org-table-formula-to-user
6604 (concat
6605 (if (string-match "^[$@]"(car eqn)) "" "$")
6606 (car eqn) "=" (cdr eqn))))
6607 "")))))
6609 (defun org-table-current-column ()
6610 "Find out which column we are in.
6611 When called interactively, column is also displayed in echo area."
6612 (interactive)
6613 (if (interactive-p) (org-table-check-inside-data-field))
6614 (save-excursion
6615 (let ((cnt 0) (pos (point)))
6616 (beginning-of-line 1)
6617 (while (search-forward "|" pos t)
6618 (setq cnt (1+ cnt)))
6619 (if (interactive-p) (message "This is table column %d" cnt))
6620 cnt)))
6622 (defun org-table-current-dline ()
6623 "Find out what table data line we are in.
6624 Only datalins count for this."
6625 (interactive)
6626 (if (interactive-p) (org-table-check-inside-data-field))
6627 (save-excursion
6628 (let ((cnt 0) (pos (point)))
6629 (goto-char (org-table-begin))
6630 (while (<= (point) pos)
6631 (if (looking-at org-table-dataline-regexp) (setq cnt (1+ cnt)))
6632 (beginning-of-line 2))
6633 (if (interactive-p) (message "This is table line %d" cnt))
6634 cnt)))
6636 (defun org-table-goto-column (n &optional on-delim force)
6637 "Move the cursor to the Nth column in the current table line.
6638 With optional argument ON-DELIM, stop with point before the left delimiter
6639 of the field.
6640 If there are less than N fields, just go to after the last delimiter.
6641 However, when FORCE is non-nil, create new columns if necessary."
6642 (interactive "p")
6643 (let ((pos (point-at-eol)))
6644 (beginning-of-line 1)
6645 (when (> n 0)
6646 (while (and (> (setq n (1- n)) -1)
6647 (or (search-forward "|" pos t)
6648 (and force
6649 (progn (end-of-line 1)
6650 (skip-chars-backward "^|")
6651 (insert " | "))))))
6652 ; (backward-char 2) t)))))
6653 (when (and force (not (looking-at ".*|")))
6654 (save-excursion (end-of-line 1) (insert " | ")))
6655 (if on-delim
6656 (backward-char 1)
6657 (if (looking-at " ") (forward-char 1))))))
6659 (defun org-at-table-p (&optional table-type)
6660 "Return t if the cursor is inside an org-type table.
6661 If TABLE-TYPE is non-nil, also check for table.el-type tables."
6662 (if org-enable-table-editor
6663 (save-excursion
6664 (beginning-of-line 1)
6665 (looking-at (if table-type org-table-any-line-regexp
6666 org-table-line-regexp)))
6667 nil))
6669 (defun org-at-table.el-p ()
6670 "Return t if and only if we are at a table.el table."
6671 (and (org-at-table-p 'any)
6672 (save-excursion
6673 (goto-char (org-table-begin 'any))
6674 (looking-at org-table1-hline-regexp))))
6676 (defun org-table-recognize-table.el ()
6677 "If there is a table.el table nearby, recognize it and move into it."
6678 (if org-table-tab-recognizes-table.el
6679 (if (org-at-table.el-p)
6680 (progn
6681 (beginning-of-line 1)
6682 (if (looking-at org-table-dataline-regexp)
6683 nil
6684 (if (looking-at org-table1-hline-regexp)
6685 (progn
6686 (beginning-of-line 2)
6687 (if (looking-at org-table-any-border-regexp)
6688 (beginning-of-line -1)))))
6689 (if (re-search-forward "|" (org-table-end t) t)
6690 (progn
6691 (require 'table)
6692 (if (table--at-cell-p (point))
6693 t
6694 (message "recognizing table.el table...")
6695 (table-recognize-table)
6696 (message "recognizing table.el table...done")))
6697 (error "This should not happen..."))
6698 t)
6699 nil)
6700 nil))
6702 (defun org-at-table-hline-p ()
6703 "Return t if the cursor is inside a hline in a table."
6704 (if org-enable-table-editor
6705 (save-excursion
6706 (beginning-of-line 1)
6707 (looking-at org-table-hline-regexp))
6708 nil))
6710 (defun org-table-insert-column ()
6711 "Insert a new column into the table."
6712 (interactive)
6713 (if (not (org-at-table-p))
6714 (error "Not at a table"))
6715 (org-table-find-dataline)
6716 (let* ((col (max 1 (org-table-current-column)))
6717 (beg (org-table-begin))
6718 (end (org-table-end))
6719 ;; Current cursor position
6720 (linepos (org-current-line))
6721 (colpos col))
6722 (goto-char beg)
6723 (while (< (point) end)
6724 (if (org-at-table-hline-p)
6725 nil
6726 (org-table-goto-column col t)
6727 (insert "| "))
6728 (beginning-of-line 2))
6729 (move-marker end nil)
6730 (goto-line linepos)
6731 (org-table-goto-column colpos)
6732 (org-table-align)
6733 (org-table-fix-formulas "$" nil (1- col) 1)))
6735 (defun org-table-find-dataline ()
6736 "Find a dataline in the current table, which is needed for column commands."
6737 (if (and (org-at-table-p)
6738 (not (org-at-table-hline-p)))
6739 t
6740 (let ((col (current-column))
6741 (end (org-table-end)))
6742 (move-to-column col)
6743 (while (and (< (point) end)
6744 (or (not (= (current-column) col))
6745 (org-at-table-hline-p)))
6746 (beginning-of-line 2)
6747 (move-to-column col))
6748 (if (and (org-at-table-p)
6749 (not (org-at-table-hline-p)))
6750 t
6751 (error
6752 "Please position cursor in a data line for column operations")))))
6754 (defun org-table-delete-column ()
6755 "Delete a column from the table."
6756 (interactive)
6757 (if (not (org-at-table-p))
6758 (error "Not at a table"))
6759 (org-table-find-dataline)
6760 (org-table-check-inside-data-field)
6761 (let* ((col (org-table-current-column))
6762 (beg (org-table-begin))
6763 (end (org-table-end))
6764 ;; Current cursor position
6765 (linepos (org-current-line))
6766 (colpos col))
6767 (goto-char beg)
6768 (while (< (point) end)
6769 (if (org-at-table-hline-p)
6770 nil
6771 (org-table-goto-column col t)
6773 (replace-match "|")))
6774 (beginning-of-line 2))
6775 (move-marker end nil)
6776 (goto-line linepos)
6777 (org-table-goto-column colpos)
6778 (org-table-align)
6779 (org-table-fix-formulas "$" (list (cons (number-to-string col) "INVALID"))
6780 col -1 col)))
6782 (defun org-table-move-column-right ()
6783 "Move column to the right."
6784 (interactive)
6785 (org-table-move-column nil))
6786 (defun org-table-move-column-left ()
6787 "Move column to the left."
6788 (interactive)
6789 (org-table-move-column 'left))
6791 (defun org-table-move-column (&optional left)
6792 "Move the current column to the right. With arg LEFT, move to the left."
6793 (interactive "P")
6794 (if (not (org-at-table-p))
6795 (error "Not at a table"))
6796 (org-table-find-dataline)
6797 (org-table-check-inside-data-field)
6798 (let* ((col (org-table-current-column))
6799 (col1 (if left (1- col) col))
6800 (beg (org-table-begin))
6801 (end (org-table-end))
6802 ;; Current cursor position
6803 (linepos (org-current-line))
6804 (colpos (if left (1- col) (1+ col))))
6805 (if (and left (= col 1))
6806 (error "Cannot move column further left"))
6808 (error "Cannot move column further right"))
6809 (goto-char beg)
6810 (while (< (point) end)
6811 (if (org-at-table-hline-p)
6812 nil
6813 (org-table-goto-column col1 t)
6816 (beginning-of-line 2))
6817 (move-marker end nil)
6818 (goto-line linepos)
6819 (org-table-goto-column colpos)
6820 (org-table-align)
6821 (org-table-fix-formulas
6822 "$" (list (cons (number-to-string col) (number-to-string colpos))
6823 (cons (number-to-string colpos) (number-to-string col))))))
6825 (defun org-table-move-row-down ()
6826 "Move table row down."
6827 (interactive)
6828 (org-table-move-row nil))
6829 (defun org-table-move-row-up ()
6830 "Move table row up."
6831 (interactive)
6832 (org-table-move-row 'up))
6834 (defun org-table-move-row (&optional up)
6835 "Move the current table line down. With arg UP, move it up."
6836 (interactive "P")
6837 (let* ((col (current-column))
6838 (pos (point))
6839 (hline1p (save-excursion (beginning-of-line 1)
6840 (looking-at org-table-hline-regexp)))
6841 (dline1 (org-table-current-dline))
6842 (dline2 (+ dline1 (if up -1 1)))
6843 (tonew (if up 0 2))
6844 txt hline2p)
6845 (beginning-of-line tonew)
6846 (unless (org-at-table-p)
6847 (goto-char pos)
6848 (error "Cannot move row further"))
6849 (setq hline2p (looking-at org-table-hline-regexp))
6850 (goto-char pos)
6851 (beginning-of-line 1)
6852 (setq pos (point))
6853 (setq txt (buffer-substring (point) (1+ (point-at-eol))))
6854 (delete-region (point) (1+ (point-at-eol)))
6855 (beginning-of-line tonew)
6856 (insert txt)
6857 (beginning-of-line 0)
6858 (move-to-column col)
6859 (unless (or hline1p hline2p)
6860 (org-table-fix-formulas
6861 "@" (list (cons (number-to-string dline1) (number-to-string dline2))
6862 (cons (number-to-string dline2) (number-to-string dline1)))))))
6864 (defun org-table-insert-row (&optional arg)
6865 "Insert a new row above the current line into the table.
6866 With prefix ARG, insert below the current line."
6867 (interactive "P")
6868 (if (not (org-at-table-p))
6869 (error "Not at a table"))
6870 (let* ((line (buffer-substring (point-at-bol) (point-at-eol)))
6871 (new (org-table-clean-line line)))
6872 ;; Fix the first field if necessary
6874 (setq new (replace-match (match-string 0 line) t t new)))
6875 (beginning-of-line (if arg 2 1))
6877 (beginning-of-line 0)
6878 (re-search-forward "| ?" (point-at-eol) t)
6879 (and (or org-table-may-need-update org-table-overlay-coordinates)
6880 (org-table-align))
6881 (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1)))
6883 (defun org-table-insert-hline (&optional above)
6884 "Insert a horizontal-line below the current line into the table.
6885 With prefix ABOVE, insert above the current line."
6886 (interactive "P")
6887 (if (not (org-at-table-p))
6888 (error "Not at a table"))
6889 (let ((line (org-table-clean-line
6890 (buffer-substring (point-at-bol) (point-at-eol))))
6891 (col (current-column)))
6893 (setq line (replace-match
6894 (concat "+" (make-string (- (match-end 1) (match-beginning 1))
6895 ?-) "|") t t line)))
6897 (beginning-of-line (if above 1 2))
6899 (beginning-of-line (if above 1 -1))
6900 (move-to-column col)
6901 (and org-table-overlay-coordinates (org-table-align))))
6903 (defun org-table-hline-and-move (&optional same-column)
6904 "Insert a hline and move to the row below that line."
6905 (interactive "P")
6906 (let ((col (org-table-current-column)))
6907 (org-table-maybe-eval-formula)
6908 (org-table-maybe-recalculate-line)
6909 (org-table-insert-hline)
6910 (end-of-line 2)
6913 (org-table-next-field))
6914 (if same-column (org-table-goto-column col))))
6916 (defun org-table-clean-line (s)
6918 In particular, this does handle wide and invisible characters."
6920 ;; It's a hline, just map the characters
6921 (setq s (mapconcat (lambda (x) (if (member x '(?| ?+)) "|" " ")) s ""))
6923 (setq s (replace-match
6924 (concat "|" (make-string (org-string-width (match-string 1 s))
6925 ?\ ) "|")
6926 t t s)))
6927 s))
6929 (defun org-table-kill-row ()
6930 "Delete the current row or horizontal line from the table."
6931 (interactive)
6932 (if (not (org-at-table-p))
6933 (error "Not at a table"))
6934 (let ((col (current-column))
6935 (dline (org-table-current-dline)))
6936 (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))
6937 (if (not (org-at-table-p)) (beginning-of-line 0))
6938 (move-to-column col)
6939 (org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID"))
6940 dline -1 dline)))
6943 (defun org-table-sort-lines (with-case &optional sorting-type)
6944 "Sort table lines according to the column at point.
6946 The position of point indicates the column to be used for
6947 sorting, and the range of lines is the range between the nearest
6948 horizontal separator lines, or the entire table of no such lines
6949 exist. If point is before the first column, you will be prompted
6950 for the sorting column. If there is an active region, the mark
6951 specifies the first line and the sorting column, while point
6952 should be in the last line to be included into the sorting.
6954 The command then prompts for the sorting type which can be
6955 alphabetically, numerically, or by time (as given in a time stamp
6956 in the field). Sorting in reverse order is also possible.
6958 With prefix argument WITH-CASE, alphabetic sorting will be case-sensitive.
6960 If SORTING-TYPE is specified when this function is called from a Lisp
6961 program, no prompting will take place. SORTING-TYPE must be a character,
6962 any of (?a ?A ?n ?N ?t ?T) where the capital letter indicate that sorting
6963 should be done in reverse order."
6964 (interactive "P")
6965 (let* ((thisline (org-current-line))
6966 (thiscol (org-table-current-column))
6967 beg end bcol ecol tend tbeg column lns pos)
6968 (when (equal thiscol 0)
6969 (if (interactive-p)
6970 (setq thiscol
6971 (string-to-number
6972 (read-string "Use column N for sorting: ")))
6973 (setq thiscol 1))
6974 (org-table-goto-column thiscol))
6975 (org-table-check-inside-data-field)
6976 (if (org-region-active-p)
6977 (progn
6978 (setq beg (region-beginning) end (region-end))
6979 (goto-char beg)
6980 (setq column (org-table-current-column)
6981 beg (point-at-bol))
6982 (goto-char end)
6983 (setq end (point-at-bol 2)))
6984 (setq column (org-table-current-column)
6985 pos (point)
6986 tbeg (org-table-begin)
6987 tend (org-table-end))
6988 (if (re-search-backward org-table-hline-regexp tbeg t)
6989 (setq beg (point-at-bol 2))
6990 (goto-char tbeg)
6991 (setq beg (point-at-bol 1)))
6992 (goto-char pos)
6993 (if (re-search-forward org-table-hline-regexp tend t)
6994 (setq beg (point-at-bol 0))
6995 (goto-char tend)
6996 (setq end (point-at-bol))))
6997 (setq beg (move-marker (make-marker) beg)
6998 end (move-marker (make-marker) end))
6999 (untabify beg end)
7000 (goto-char beg)
7001 (org-table-goto-column column)
7002 (skip-chars-backward "^|")
7003 (setq bcol (current-column))
7004 (org-table-goto-column (1+ column))
7005 (skip-chars-backward "^|")
7006 (setq ecol (1- (current-column)))
7007 (org-table-goto-column column)
7008 (setq lns (mapcar (lambda(x) (cons (org-trim (substring x bcol ecol)) x))
7010 (setq lns (org-do-sort lns "Table" with-case sorting-type))
7011 (delete-region beg end)
7012 (move-marker beg nil)
7013 (move-marker end nil)
7015 (goto-line thisline)
7016 (org-table-goto-column thiscol)
7017 (message "%d lines sorted, based on column %d" (length lns) column)))
7019 (defun org-table-cut-region (beg end)
7020 "Copy region in table to the clipboard and blank all relevant fields."
7021 (interactive "r")
7022 (org-table-copy-region beg end 'cut))
7024 (defun org-table-copy-region (beg end &optional cut)
7025 "Copy rectangular region in table to clipboard.
7026 A special clipboard is used which can only be accessed
7027 with `org-table-paste-rectangle'."
7028 (interactive "rP")
7029 (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2
7030 region cols
7031 (rpl (if cut " " nil)))
7032 (goto-char beg)
7033 (org-table-check-inside-data-field)
7034 (setq l01 (org-current-line)
7035 c01 (org-table-current-column))
7036 (goto-char end)
7037 (org-table-check-inside-data-field)
7038 (setq l02 (org-current-line)
7039 c02 (org-table-current-column))
7040 (setq l1 (min l01 l02) l2 (max l01 l02)
7041 c1 (min c01 c02) c2 (max c01 c02))
7042 (catch 'exit
7043 (while t
7044 (catch 'nextline
7045 (if (> l1 l2) (throw 'exit t))
7046 (goto-line l1)
7047 (if (org-at-table-hline-p) (throw 'nextline (setq l1 (1+ l1))))
7048 (setq cols nil ic1 c1 ic2 c2)
7049 (while (< ic1 (1+ ic2))
7050 (push (org-table-get-field ic1 rpl) cols)
7051 (setq ic1 (1+ ic1)))
7052 (push (nreverse cols) region)
7053 (setq l1 (1+ l1)))))
7054 (setq org-table-clip (nreverse region))
7055 (if cut (org-table-align))
7056 org-table-clip))
7058 (defun org-table-paste-rectangle ()
7059 "Paste a rectangular region into a table.
7060 The upper right corner ends up in the current field. All involved fields
7061 will be overwritten. If the rectangle does not fit into the present table,
7062 the table is enlarged as needed. The process ignores horizontal separator
7063 lines."
7064 (interactive)
7065 (unless (and org-table-clip (listp org-table-clip))
7066 (error "First cut/copy a region to paste!"))
7067 (org-table-check-inside-data-field)
7068 (let* ((clip org-table-clip)
7069 (line (org-current-line))
7070 (col (org-table-current-column))
7071 (org-enable-table-editor t)
7072 (org-table-automatic-realign nil)
7073 c cols field)
7074 (while (setq cols (pop clip))
7075 (while (org-at-table-hline-p) (beginning-of-line 2))
7076 (if (not (org-at-table-p))
7077 (progn (end-of-line 0) (org-table-next-field)))
7078 (setq c col)
7079 (while (setq field (pop cols))
7080 (org-table-goto-column c nil 'force)
7081 (org-table-get-field nil field)
7082 (setq c (1+ c)))
7083 (beginning-of-line 2))
7084 (goto-line line)
7085 (org-table-goto-column col)
7086 (org-table-align)))
7088 (defun org-table-convert ()
7089 "Convert from `org-mode' table to table.el and back.
7090 Obviously, this only works within limits. When an Org-mode table is
7091 converted to table.el, all horizontal separator lines get lost, because
7092 table.el uses these as cell boundaries and has no notion of horizontal lines.
7093 A table.el table can be converted to an Org-mode table only if it does not
7094 do row or column spanning. Multiline cells will become multiple cells.
7095 Beware, Org-mode does not test if the table can be successfully converted - it
7096 blindly applies a recipe that works for simple tables."
7097 (interactive)
7098 (require 'table)
7099 (if (org-at-table.el-p)
7100 ;; convert to Org-mode table
7101 (let ((beg (move-marker (make-marker) (org-table-begin t)))
7102 (end (move-marker (make-marker) (org-table-end t))))
7103 (table-unrecognize-region beg end)
7104 (goto-char beg)
7106 (replace-match ""))
7107 (goto-char beg))
7108 (if (org-at-table-p)
7109 ;; convert to table.el table
7110 (let ((beg (move-marker (make-marker) (org-table-begin)))
7111 (end (move-marker (make-marker) (org-table-end))))
7112 ;; first, get rid of all horizontal lines
7113 (goto-char beg)
7115 (replace-match ""))
7116 ;; insert a hline before first
7117 (goto-char beg)
7118 (org-table-insert-hline 'above)
7119 (beginning-of-line -1)
7120 ;; insert a hline after each line
7121 (while (progn (beginning-of-line 3) (< (point) end))
7122 (org-table-insert-hline))
7123 (goto-char beg)
7124 (setq end (move-marker end (org-table-end)))
7125 ;; replace "+" at beginning and ending of hlines
7128 (goto-char beg)
7130 (replace-match "-+"))
7131 (goto-char beg)))))
7133 (defun org-table-wrap-region (arg)
7134 "Wrap several fields in a column like a paragraph.
7135 This is useful if you'd like to spread the contents of a field over several
7136 lines, in order to keep the table compact.
7138 If there is an active region, and both point and mark are in the same column,
7139 the text in the column is wrapped to minimum width for the given number of
7140 lines. Generally, this makes the table more compact. A prefix ARG may be
7142 formats the selected text to two lines. If the region was longer than two
7143 lines, the remaining lines remain empty. A negative prefix argument reduces
7144 the current number of lines by that amount. The wrapped text is pasted back
7145 into the table. If you formatted it to more lines than it was before, fields
7146 further down in the table get overwritten - so you might need to make space in
7147 the table first.
7149 If there is no region, the current field is split at the cursor position and
7150 the text fragment to the right of the cursor is prepended to the field one
7151 line down.
7153 If there is no region, but you specify a prefix ARG, the current field gets
7154 blank, and the content is appended to the field above."
7155 (interactive "P")
7156 (org-table-check-inside-data-field)
7157 (if (org-region-active-p)
7158 ;; There is a region: fill as a paragraph
7159 (let* ((beg (region-beginning))
7160 (cline (save-excursion (goto-char beg) (org-current-line)))
7161 (ccol (save-excursion (goto-char beg) (org-table-current-column)))
7162 nlines)
7163 (org-table-cut-region (region-beginning) (region-end))
7164 (if (> (length (car org-table-clip)) 1)
7165 (error "Region must be limited to single column"))
7166 (setq nlines (if arg
7167 (if (< arg 1)
7168 (+ (length org-table-clip) arg)
7169 arg)
7170 (length org-table-clip)))
7171 (setq org-table-clip
7172 (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ")
7173 nil nlines)))
7174 (goto-line cline)
7175 (org-table-goto-column ccol)
7176 (org-table-paste-rectangle))
7177 ;; No region, split the current field at point
7178 (if arg
7179 ;; combine with field above
7180 (let ((s (org-table-blank-field))
7181 (col (org-table-current-column)))
7182 (beginning-of-line 0)
7183 (while (org-at-table-hline-p) (beginning-of-line 0))
7184 (org-table-goto-column col)
7185 (skip-chars-forward "^|")
7186 (skip-chars-backward " ")
7187 (insert " " (org-trim s))
7188 (org-table-align))
7189 ;; split field
7191 (let ((s (match-string 1)))
7192 (replace-match " |")
7193 (goto-char (match-beginning 0))
7194 (org-table-next-row)
7195 (insert (org-trim s) " ")
7196 (org-table-align))))))
7198 (defvar org-field-marker nil)
7200 (defun org-table-edit-field (arg)
7201 "Edit table field in a different window.
7202 This is mainly useful for fields that contain hidden parts.
7204 it can be edited in place."
7205 (interactive "P")
7206 (if arg
7207 (let ((b (save-excursion (skip-chars-backward "^|") (point)))
7209 (remove-text-properties b e '(org-cwidth t invisible t
7210 display t intangible t))
7211 (if (and (boundp 'font-lock-mode) font-lock-mode)
7212 (font-lock-fontify-block)))
7213 (let ((pos (move-marker (make-marker) (point)))
7214 (field (org-table-get-field))
7215 (cw (current-window-configuration))
7216 p)
7217 (switch-to-buffer-other-window "*Org tmp*")
7218 (erase-buffer)
7220 (let ((org-inhibit-startup t)) (org-mode))
7221 (goto-char (setq p (point-max)))
7222 (insert (org-trim field))
7223 (remove-text-properties p (point-max)
7224 '(invisible t org-cwidth t display t
7225 intangible t))
7226 (goto-char p)
7227 (org-set-local 'org-finish-function 'org-table-finish-edit-field)
7228 (org-set-local 'org-window-configuration cw)
7229 (org-set-local 'org-field-marker pos)
7230 (message "Edit and finish with C-c C-c"))))
7232 (defun org-table-finish-edit-field ()
7233 "Finish editing a table data field.
7234 Remove all newline characters, insert the result into the table, realign
7235 the table and kill the editing buffer."
7236 (let ((pos org-field-marker)
7237 (cw org-window-configuration)
7238 (cb (current-buffer))
7239 text)
7240 (goto-char (point-min))
7243 (replace-match " "))
7244 (setq text (org-trim (buffer-string)))
7245 (set-window-configuration cw)
7246 (kill-buffer cb)
7247 (select-window (get-buffer-window (marker-buffer pos)))
7248 (goto-char pos)
7249 (move-marker pos nil)
7250 (org-table-check-inside-data-field)
7251 (org-table-get-field nil text)
7252 (org-table-align)
7253 (message "New field value inserted")))
7255 (defun org-trim (s)
7256 "Remove whitespace at beginning and end of string."
7259 s)
7261 (defun org-wrap (string &optional width lines)
7262 "Wrap string to either a number of lines, or a width in characters.
7263 If WIDTH is non-nil, the string is wrapped to that width, however many lines
7264 that costs. If there is a word longer than WIDTH, the text is actually
7265 wrapped to the length of that word.
7266 IF WIDTH is nil and LINES is non-nil, the string is forced into at most that
7267 many lines, whatever width that takes.
7268 The return value is a list of lines, without newlines at the end."
7270 (maxword (apply 'max (mapcar 'org-string-width words)))
7271 w ll)
7272 (cond (width
7273 (org-do-wrap words (max maxword width)))
7274 (lines
7275 (setq w maxword)
7276 (setq ll (org-do-wrap words maxword))
7277 (if (<= (length ll) lines)
7278 ll
7279 (setq ll words)
7280 (while (> (length ll) lines)
7281 (setq w (1+ w))
7282 (setq ll (org-do-wrap words w)))
7283 ll))
7284 (t (error "Cannot wrap this")))))
7287 (defun org-do-wrap (words width)
7288 "Create lines of maximum width WIDTH (in characters) from word list WORDS."
7289 (let (lines line)
7290 (while words
7291 (setq line (pop words))
7292 (while (and words (< (+ (length line) (length (car words))) width))
7293 (setq line (concat line " " (pop words))))
7294 (setq lines (push line lines)))
7295 (nreverse lines)))
7297 (defun org-split-string (string &optional separators)
7298 "Splits STRING into substrings at SEPARATORS.
7299 No empty strings are returned if there are matches at the beginning
7300 and end of string."
7302 (start 0)
7303 notfirst
7304 (list nil))
7305 (while (and (string-match rexp string
7306 (if (and notfirst
7307 (= start (match-beginning 0))
7308 (< start (length string)))
7309 (1+ start) start))
7310 (< (match-beginning 0) (length string)))
7311 (setq notfirst t)
7312 (or (eq (match-beginning 0) 0)
7313 (and (eq (match-beginning 0) (match-end 0))
7314 (eq (match-beginning 0) start))
7315 (setq list
7316 (cons (substring string start (match-beginning 0))
7317 list)))
7318 (setq start (match-end 0)))
7319 (or (eq start (length string))
7320 (setq list
7321 (cons (substring string start)
7322 list)))
7323 (nreverse list)))
7325 (defun org-table-map-tables (function)
7326 "Apply FUNCTION to the start of all tables in the buffer."
7327 (save-excursion
7328 (save-restriction
7329 (widen)
7330 (goto-char (point-min))
7331 (while (re-search-forward org-table-any-line-regexp nil t)
7332 (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size)))
7333 (beginning-of-line 1)
7334 (if (looking-at org-table-line-regexp)
7335 (save-excursion (funcall function)))
7336 (re-search-forward org-table-any-border-regexp nil 1))))
7337 (message "Mapping tables: done"))
7339 (defvar org-timecnt) ; dynamically scoped parameter
7341 (defun org-table-sum (&optional beg end nlast)
7342 "Sum numbers in region of current table column.
7343 The result will be displayed in the echo area, and will be available
7346 If there is an active region, it is interpreted as a rectangle and all
7347 numbers in that rectangle will be summed. If there is no active
7348 region and point is located in a table column, sum all numbers in that
7349 column.
7351 If at least one number looks like a time HH:MM or HH:MM:SS, all other
7352 numbers are assumed to be times as well (in decimal hours) and the
7353 numbers are added as such.
7355 If NLAST is a number, only the NLAST fields will actually be summed."
7356 (interactive)
7357 (save-excursion
7358 (let (col (org-timecnt 0) diff h m s org-table-clip)
7359 (cond
7360 ((and beg end)) ; beg and end given explicitly
7361 ((org-region-active-p)
7362 (setq beg (region-beginning) end (region-end)))
7363 (t
7364 (setq col (org-table-current-column))
7365 (goto-char (org-table-begin))
7367 (error "No table data"))
7368 (org-table-goto-column col)
7369 (setq beg (point))
7370 (goto-char (org-table-end))
7372 (error "No table data"))
7373 (org-table-goto-column col)
7374 (setq end (point))))
7375 (let* ((items (apply 'append (org-table-copy-region beg end)))
7376 (items1 (cond ((not nlast) items)
7377 ((>= nlast (length items)) items)
7378 (t (setq items (reverse items))
7379 (setcdr (nthcdr (1- nlast) items) nil)
7380 (nreverse items))))
7381 (numbers (delq nil (mapcar 'org-table-get-number-for-summing
7382 items1)))
7383 (res (apply '+ numbers))
7384 (sres (if (= org-timecnt 0)
7385 (format "%g" res)
7386 (setq diff (* 3600 res)
7387 h (floor (/ diff 3600)) diff (mod diff 3600)
7388 m (floor (/ diff 60)) diff (mod diff 60)
7389 s diff)
7390 (format "%d:%02d:%02d" h m s))))
7391 (kill-new sres)
7392 (if (interactive-p)
7393 (message "%s"
7394 (substitute-command-keys
7396 (length numbers) sres))))
7397 sres))))
7399 (defun org-table-get-number-for-summing (s)
7400 (let (n)
7401 (if (string-match "^ *|? *" s)
7402 (setq s (replace-match "" nil nil s)))
7403 (if (string-match " *|? *$" s)
7404 (setq s (replace-match "" nil nil s)))
7405 (setq n (string-to-number s))
7406 (cond
7407 ((and (string-match "0" s)
7411 (let ((h (string-to-number (or (match-string 1 s) "0")))
7412 (m (string-to-number (or (match-string 2 s) "0")))
7413 (s (string-to-number (or (match-string 4 s) "0"))))
7414 (if (boundp 'org-timecnt) (setq org-timecnt (1+ org-timecnt)))
7415 (* 1.0 (+ h (/ m 60.0) (/ s 3600.0)))))
7416 ((equal n 0) nil)
7417 (t n))))
7419 (defun org-table-current-field-formula (&optional key noerror)
7420 "Return the formula active for the current field.
7421 Assumes that specials are in place.
7422 If KEY is given, return the key to this formula.
7424 (let* ((name (car (rassoc (list (org-current-line)
7425 (org-table-current-column))
7426 org-table-named-field-locations)))
7427 (col (org-table-current-column))
7428 (scol (int-to-string col))
7429 (ref (format "@%d$%d" (org-table-current-dline) col))
7430 (stored-list (org-table-get-stored-formulas noerror))
7431 (ass (or (assoc name stored-list)
7432 (assoc ref stored-list)
7433 (assoc scol stored-list))))
7434 (if key
7435 (car ass)
7436 (if ass (concat (if (string-match "^[0-9]+$" (car ass)) "=" ":=")
7437 (cdr ass))))))
7439 (defun org-table-get-formula (&optional equation named)
7440 "Read a formula from the minibuffer, offer stored formula as default.
7441 When NAMED is non-nil, look for a named equation."
7442 (let* ((stored-list (org-table-get-stored-formulas))
7443 (name (car (rassoc (list (org-current-line)
7444 (org-table-current-column))
7445 org-table-named-field-locations)))
7446 (ref (format "@%d$%d" (org-table-current-dline)
7447 (org-table-current-column)))
7448 (refass (assoc ref stored-list))
7449 (scol (if named
7450 (if name name ref)
7451 (int-to-string (org-table-current-column))))
7452 (dummy (and (or name refass) (not named)
7453 (not (y-or-n-p "Replace field formula with column formula? " ))
7454 (error "Abort")))
7455 (name (or name ref))
7456 (org-table-may-need-update nil)
7457 (stored (cdr (assoc scol stored-list)))
7458 (eq (cond
7459 ((and stored equation (string-match "^ *=? *$" equation))
7460 stored)
7461 ((stringp equation)
7462 equation)
7463 (t (org-table-formula-from-user
7464 (read-string
7465 (org-table-formula-to-user
7466 (format "%s formula %s%s="
7467 (if named "Field" "Column")
7468 (if (member (string-to-char scol) '(?$ ?@)) "" "$")
7469 scol))
7470 (if stored (org-table-formula-to-user stored) "")
7471 'org-table-formula-history
7472 )))))
7473 mustsave)
7475 ;; remove formula
7476 (setq stored-list (delq (assoc scol stored-list) stored-list))
7477 (org-table-store-formulas stored-list)
7478 (error "Formula removed"))
7479 (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq)))
7480 (if (string-match " *$" eq) (setq eq (replace-match "" t t eq)))
7481 (if (and name (not named))
7482 ;; We set the column equation, delete the named one.
7483 (setq stored-list (delq (assoc name stored-list) stored-list)
7484 mustsave t))
7485 (if stored
7486 (setcdr (assoc scol stored-list) eq)
7487 (setq stored-list (cons (cons scol eq) stored-list)))
7488 (if (or mustsave (not (equal stored eq)))
7489 (org-table-store-formulas stored-list))
7490 eq))
7492 (defun org-table-store-formulas (alist)
7493 "Store the list of formulas below the current table."
7494 (setq alist (sort alist 'org-table-formula-less-p))
7495 (save-excursion
7496 (goto-char (org-table-end))
7498 (progn
7499 ;; don't overwrite TBLFM, we might use text properties to store stuff
7500 (goto-char (match-beginning 2))
7501 (delete-region (match-beginning 2) (match-end 0)))
7502 (insert "#+TBLFM:"))
7503 (insert " "
7504 (mapconcat (lambda (x)
7505 (concat
7506 (if (equal (string-to-char (car x)) ?@) "" "$")
7507 (car x) "=" (cdr x)))
7508 alist "::")
7511 (defsubst org-table-formula-make-cmp-string (a)
7513 (concat
7514 (if (match-end 2) (format "@%05d" (string-to-number (match-string 2 a))) "")
7515 (if (match-end 4) (format "$%05d" (string-to-number (match-string 4 a))) "")
7516 (if (match-end 5) (concat "@@" (match-string 5 a))))))
7518 (defun org-table-formula-less-p (a b)
7519 "Compare two formulas for sorting."
7520 (let ((as (org-table-formula-make-cmp-string (car a)))
7521 (bs (org-table-formula-make-cmp-string (car b))))
7522 (and as bs (string< as bs))))
7524 (defun org-table-get-stored-formulas (&optional noerror)
7525 "Return an alist with the stored formulas directly after current table."
7526 (interactive)
7527 (let (scol eq eq-alist strings string seen)
7528 (save-excursion
7529 (goto-char (org-table-end))
7531 (setq strings (org-split-string (match-string 2) " *:: *"))
7532 (while (setq string (pop strings))
7533 (when (string-match "\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*[^ \t]\\)" string)
7534 (setq scol (if (match-end 2)
7535 (match-string 2 string)
7536 (match-string 1 string))
7537 eq (match-string 3 string)
7538 eq-alist (cons (cons scol eq) eq-alist))
7539 (if (member scol seen)
7540 (if noerror
7541 (progn
7542 (message "Double definition `$%s=' in TBLFM line, please fix by hand" scol)
7543 (ding)
7544 (sit-for 2))
7545 (error "Double definition `$%s=' in TBLFM line, please fix by hand" scol))
7546 (push scol seen))))))
7547 (nreverse eq-alist)))
7549 (defun org-table-fix-formulas (key replace &optional limit delta remove)
7550 "Modify the equations after the table structure has been edited.
7552 For all numbers larger than LIMIT, shift them by DELTA."
7553 (save-excursion
7554 (goto-char (org-table-end))
7557 (re2
7558 (when remove
7559 (if (equal key "$")
7562 s n a)
7563 (when remove
7564 (while (re-search-forward re2 (point-at-eol) t)
7565 (replace-match "")))
7566 (while (re-search-forward re (point-at-eol) t)
7567 (setq s (match-string 1) n (string-to-number s))
7568 (cond
7569 ((setq a (assoc s replace))
7570 (replace-match (concat key (cdr a)) t t))
7571 ((and limit (> n limit))
7572 (replace-match (concat key (int-to-string (+ n delta))) t t))))))))
7574 (defun org-table-get-specials ()
7575 "Get the column names and local parameters for this table."
7576 (save-excursion
7577 (let ((beg (org-table-begin)) (end (org-table-end))
7578 names name fields fields1 field cnt
7579 c v l line col types dlines hlines)
7580 (setq org-table-column-names nil
7581 org-table-local-parameters nil
7582 org-table-named-field-locations nil
7583 org-table-current-begin-line nil
7584 org-table-current-begin-pos nil
7585 org-table-current-line-types nil)
7586 (goto-char beg)
7588 (setq names (org-split-string (match-string 1) " *| *")
7589 cnt 1)
7590 (while (setq name (pop names))
7591 (setq cnt (1+ cnt))
7592 (if (string-match "^[a-zA-Z][a-zA-Z0-9]*$" name)
7593 (push (cons name (int-to-string cnt)) org-table-column-names))))
7594 (setq org-table-column-names (nreverse org-table-column-names))
7595 (setq org-table-column-name-regexp
7597 (goto-char beg)
7599 (setq fields (org-split-string (match-string 1) " *| *"))
7600 (while (setq field (pop fields))
7602 (push (cons (match-string 1 field) (match-string 2 field))
7603 org-table-local-parameters))))
7604 (goto-char beg)
7606 (setq c (match-string 1)
7607 fields (org-split-string (match-string 2) " *| *"))
7608 (save-excursion
7609 (beginning-of-line (if (equal c "_") 2 0))
7610 (setq line (org-current-line) col 1)
7612 (setq fields1 (org-split-string (match-string 1) " *| *"))))
7613 (while (and fields1 (setq field (pop fields)))
7614 (setq v (pop fields1) col (1+ col))
7615 (when (and (stringp field) (stringp v)
7616 (string-match "^[a-zA-Z][a-zA-Z0-9]*$" field))
7617 (push (cons field v) org-table-local-parameters)
7618 (push (list field line col) org-table-named-field-locations))))
7619 ;; Analyse the line types
7620 (goto-char beg)
7621 (setq org-table-current-begin-line (org-current-line)
7622 org-table-current-begin-pos (point)
7623 l org-table-current-begin-line)
7625 (push (if (match-end 1) 'hline 'dline) types)
7626 (if (match-end 1) (push l hlines) (push l dlines))
7627 (beginning-of-line 2)
7628 (setq l (1+ l)))
7629 (setq org-table-current-line-types (apply 'vector (nreverse types))
7630 org-table-dlines (apply 'vector (cons nil (nreverse dlines)))
7631 org-table-hlines (apply 'vector (cons nil (nreverse hlines)))))))
7633 (defun org-table-maybe-eval-formula ()
7635 If yes, store the formula and apply it."
7636 ;; We already know we are in a table. Get field will only return a formula
7637 ;; when appropriate. It might return a separator line, but no problem.
7638 (when org-table-formula-evaluate-inline
7639 (let* ((field (org-trim (or (org-table-get-field) "")))
7640 named eq)
7642 (setq named (equal (string-to-char field) ?:)
7643 eq (match-string 1 field))
7644 (if (or (fboundp 'calc-eval)
7645 (equal (substring eq 0 (min 2 (length eq))) "'("))
7646 (org-table-eval-formula (if named '(4) nil)
7647 (org-table-formula-from-user eq))
7648 (error "Calc does not seem to be installed, and is needed to evaluate the formula"))))))
7650 (defvar org-recalc-commands nil
7651 "List of commands triggering the recalculation of a line.
7652 Will be filled automatically during use.")
7654 (defvar org-recalc-marks
7655 '((" " . "Unmarked: no special line, no automatic recalculation")
7656 ("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line")
7657 ("*" . "Recalculate only when entire table is recalculated with `C-u C-c *'")
7658 ("!" . "Column name definition line. Reference in formula as $name.")
7659 ("$" . "Parameter definition line name=value. Reference in formula as $name.")
7660 ("_" . "Names for values in row below this one.")
7661 ("^" . "Names for values in row above this one.")))
7663 (defun org-table-rotate-recalc-marks (&optional newchar)
7664 "Rotate the recalculation mark in the first column.
7665 If in any row, the first field is not consistent with a mark,
7666 insert a new column for the markers.
7667 When there is an active region, change all the lines in the region,
7668 after prompting for the marking character.
7669 After each change, a message will be displayed indicating the meaning
7670 of the new mark."
7671 (interactive)
7672 (unless (org-at-table-p) (error "Not at a table"))
7673 (let* ((marks (append (mapcar 'car org-recalc-marks) '(" ")))
7674 (beg (org-table-begin))
7675 (end (org-table-end))
7676 (l (org-current-line))
7677 (l1 (if (org-region-active-p) (org-current-line (region-beginning))))
7678 (l2 (if (org-region-active-p) (org-current-line (region-end))))
7679 (have-col
7680 (save-excursion
7681 (goto-char beg)
7683 (col (org-table-current-column))
7684 (forcenew (car (assoc newchar org-recalc-marks)))
7685 epos new)
7686 (when l1
7687 (message "Change region to what mark? Type # * ! $ or SPC: ")
7688 (setq newchar (char-to-string (read-char-exclusive))
7689 forcenew (car (assoc newchar org-recalc-marks))))
7690 (if (and newchar (not forcenew))
7691 (error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'"
7692 newchar))
7693 (if l1 (goto-line l1))
7694 (save-excursion
7695 (beginning-of-line 1)
7696 (unless (looking-at org-table-dataline-regexp)
7697 (error "Not at a table data line")))
7698 (unless have-col
7699 (org-table-goto-column 1)
7700 (org-table-insert-column)
7701 (org-table-goto-column (1+ col)))
7702 (setq epos (point-at-eol))
7703 (save-excursion
7704 (beginning-of-line 1)
7705 (org-table-get-field
7707 (concat " "
7708 (setq new (or forcenew
7709 (cadr (member (match-string 1) marks))))
7710 " ")
7711 " # ")))
7712 (if (and l1 l2)
7713 (progn
7714 (goto-line l1)
7715 (while (progn (beginning-of-line 2) (not (= (org-current-line) l2)))
7716 (and (looking-at org-table-dataline-regexp)
7717 (org-table-get-field 1 (concat " " new " "))))
7718 (goto-line l1)))
7719 (if (not (= epos (point-at-eol))) (org-table-align))
7720 (goto-line l)
7721 (and (interactive-p) (message (cdr (assoc new org-recalc-marks))))))
7723 (defun org-table-maybe-recalculate-line ()
7724 "Recompute the current line if marked for it, and if we haven't just done it."
7725 (interactive)
7726 (and org-table-allow-automatic-line-recalculation
7727 (not (and (memq last-command org-recalc-commands)
7728 (equal org-last-recalc-line (org-current-line))))
7729 (save-excursion (beginning-of-line 1)
7730 (looking-at org-table-auto-recalculate-regexp))
7731 (org-table-recalculate) t))
7733 (defvar org-table-formula-debug nil
7734 "Non-nil means, debug table formulas.
7736 (make-variable-buffer-local 'org-table-formula-debug)
7738 (defvar modes)
7739 (defsubst org-set-calc-mode (var &optional value)
7740 (if (stringp var)
7741 (setq var (assoc var '(("D" calc-angle-mode deg)
7742 ("R" calc-angle-mode rad)
7743 ("F" calc-prefer-frac t)
7744 ("S" calc-symbolic-mode t)))
7745 value (nth 2 var) var (nth 1 var)))
7746 (if (memq var modes)
7747 (setcar (cdr (memq var modes)) value)
7748 (cons var (cons value modes)))
7749 modes)
7751 (defun org-table-eval-formula (&optional arg equation
7752 suppress-align suppress-const
7753 suppress-store suppress-analysis)
7754 "Replace the table field value at the cursor by the result of a calculation.
7756 This function makes use of Dave Gillespie's Calc package, in my view the
7757 most exciting program ever written for GNU Emacs. So you need to have Calc
7758 installed in order to use this function.
7760 In a table, this command replaces the value in the current field with the
7762 formula, by storing it in a special line below the table. When called
7763 with a `C-u' prefix, the current field must ba a named field, and the
7764 formula is installed as valid in only this specific field.
7766 When called with two `C-u' prefixes, insert the active equation
7767 for the field back into the current field, so that it can be
7769 to check the referenced fields.
7771 When called, the command first prompts for a formula, which is read in
7772 the minibuffer. Previously entered formulas are available through the
7773 history list, and the last used formula is offered as a default.
7774 These stored formulas are adapted correctly when moving, inserting, or
7775 deleting columns with the corresponding commands.
7777 The formula can be any algebraic expression understood by the Calc package.
7778 For details, see the Org-mode manual.
7780 This function can also be called from Lisp programs and offers
7781 additional arguments: EQUATION can be the formula to apply. If this
7782 argument is given, the user will not be prompted. SUPPRESS-ALIGN is
7783 used to speed-up recursive calls by by-passing unnecessary aligns.
7784 SUPPRESS-CONST suppresses the interpretation of constants in the
7785 formula, assuming that this has been done already outside the function.
7786 SUPPRESS-STORE means the formula should not be stored, either because
7787 it is already stored, or because it is a modified equation that should
7788 not overwrite the stored one."
7789 (interactive "P")
7790 (org-table-check-inside-data-field)
7791 (or suppress-analysis (org-table-get-specials))
7792 (if (equal arg '(16))
7793 (let ((eq (org-table-current-field-formula)))
7794 (or eq (error "No equation active for current field"))
7795 (org-table-get-field nil eq)
7796 (org-table-align)
7797 (setq org-table-may-need-update t))
7798 (let* (fields
7799 (ndown (if (integerp arg) arg 1))
7800 (org-table-automatic-realign nil)
7801 (case-fold-search nil)
7802 (down (> ndown 1))
7803 (formula (if (and equation suppress-store)
7804 equation
7805 (org-table-get-formula equation (equal arg '(4)))))
7806 (n0 (org-table-current-column))
7807 (modes (copy-sequence org-calc-default-modes))
7808 (numbers nil) ; was a variable, now fixed default
7809 (keep-empty nil)
7810 n form form0 bw fmt x ev orig c lispp)
7811 ;; Parse the format string. Since we have a lot of modes, this is
7812 ;; a lot of work. However, I think calc still uses most of the time.
7813 (if (string-match ";" formula)
7814 (let ((tmp (org-split-string formula ";")))
7815 (setq formula (car tmp)
7816 fmt (concat (cdr (assoc "%" org-table-local-parameters))
7817 (nth 1 tmp)))
7819 (setq c (string-to-char (match-string 1 fmt))
7820 n (string-to-number (match-string 2 fmt)))
7821 (if (= c ?p)
7822 (setq modes (org-set-calc-mode 'calc-internal-prec n))
7823 (setq modes (org-set-calc-mode
7824 'calc-float-format
7825 (list (cdr (assoc c '((?n . float) (?f . fix)
7826 (?s . sci) (?e . eng))))
7827 n))))
7828 (setq fmt (replace-match "" t t fmt)))
7829 (if (string-match "[NT]" fmt)
7830 (setq numbers (equal (match-string 0 fmt) "N")
7831 fmt (replace-match "" t t fmt)))
7832 (if (string-match "E" fmt)
7833 (setq keep-empty t
7834 fmt (replace-match "" t t fmt)))
7835 (while (string-match "[DRFS]" fmt)
7836 (setq modes (org-set-calc-mode (match-string 0 fmt)))
7837 (setq fmt (replace-match "" t t fmt)))
7839 (setq fmt nil))))
7840 (if (and (not suppress-const) org-table-formula-use-constants)
7841 (setq formula (org-table-formula-substitute-names formula)))
7842 (setq orig (or (get-text-property 1 :orig-formula formula) "?"))
7843 (while (> ndown 0)
7844 (setq fields (org-split-string
7845 (org-no-properties
7846 (buffer-substring (point-at-bol) (point-at-eol)))
7847 " *| *"))
7848 (if numbers
7849 (setq fields (mapcar
7850 (lambda (x) (number-to-string (string-to-number x)))
7851 fields)))
7852 (setq ndown (1- ndown))
7853 (setq form (copy-sequence formula)
7854 lispp (and (> (length form) 2)(equal (substring form 0 2) "'(")))
7855 ;; Check for old vertical references
7856 (setq form (org-rewrite-old-row-references form))
7857 ;; Insert complex ranges
7858 (while (string-match org-table-range-regexp form)
7859 (setq form
7860 (replace-match
7861 (save-match-data
7862 (org-table-make-reference
7863 (org-table-get-range (match-string 0 form) nil n0)
7864 keep-empty numbers lispp))
7865 t t form)))
7866 ;; Insert simple ranges
7868 (setq form
7869 (replace-match
7870 (save-match-data
7871 (org-table-make-reference
7872 (org-sublist
7873 fields (string-to-number (match-string 1 form))
7874 (string-to-number (match-string 2 form)))
7875 keep-empty numbers lispp))
7876 t t form)))
7877 (setq form0 form)
7878 ;; Insert the references to fields in same row
7880 (setq n (string-to-number (match-string 1 form))
7881 x (nth (1- (if (= n 0) n0 n)) fields))
7883 (match-string 0 form)))
7884 (setq form (replace-match
7885 (save-match-data
7886 (org-table-make-reference x nil numbers lispp))
7887 t t form)))
7889 (if lispp
7890 (setq ev (condition-case nil
7891 (eval (eval (read form)))
7892 (error "#ERROR"))
7893 ev (if (numberp ev) (number-to-string ev) ev))
7894 (or (fboundp 'calc-eval)
7895 (error "Calc does not seem to be installed, and is needed to evaluate the formula"))
7896 (setq ev (calc-eval (cons form modes)
7897 (if numbers 'num))))
7899 (when org-table-formula-debug
7900 (with-output-to-temp-buffer "*Substitution History*"
7901 (princ (format "Substitution history of formula
7902 Orig: %s
7903 $xyz-> %s
7904 @r$c-> %s
7906 (if (listp ev)
7908 (make-string (car ev) ?\-) (nth 1 ev)))
7910 ev (or fmt "NONE")
7911 (if fmt (format fmt (string-to-number ev)) ev)))))
7912 (setq bw (get-buffer-window "*Substitution History*"))
7913 (shrink-window-if-larger-than-buffer bw)
7914 (unless (and (interactive-p) (not ndown))
7915 (unless (let (inhibit-redisplay)
7916 (y-or-n-p "Debugging Formula. Continue to next? "))
7917 (org-table-align)
7918 (error "Abort"))
7919 (delete-window bw)
7920 (message "")))
7921 (if (listp ev) (setq fmt nil ev "#ERROR"))
7922 (org-table-justify-field-maybe
7923 (if fmt (format fmt (string-to-number ev)) ev))
7925 (call-interactively 'org-return)
7926 (setq ndown 0)))
7927 (and down (org-table-maybe-recalculate-line))
7928 (or suppress-align (and org-table-may-need-update
7929 (org-table-align))))))
7931 (defun org-table-get-range (desc &optional tbeg col highlight)
7932 "Get a calc vector from a column, accorting to descriptor DESC.
7933 Optional arguments TBEG and COL can give the beginning of the table and
7934 the current column, to avoid unnecessary parsing.
7935 HIGHLIGHT means, just highlight the range."
7936 (if (not (equal (string-to-char desc) ?@))
7937 (setq desc (concat "@" desc)))
7938 (save-excursion
7939 (or tbeg (setq tbeg (org-table-begin)))
7940 (or col (setq col (org-table-current-column)))
7941 (let ((thisline (org-current-line))
7942 beg end c1 c2 r1 r2 rangep tmp)
7943 (unless (string-match org-table-range-regexp desc)
7944 (error "Invalid table range specifier `%s'" desc))
7945 (setq rangep (match-end 3)
7946 r1 (and (match-end 1) (match-string 1 desc))
7947 r2 (and (match-end 4) (match-string 4 desc))
7948 c1 (and (match-end 2) (substring (match-string 2 desc) 1))
7949 c2 (and (match-end 5) (substring (match-string 5 desc) 1)))
7951 (and c1 (setq c1 (+ (string-to-number c1)
7952 (if (memq (string-to-char c1) '(?- ?+)) col 0))))
7953 (and c2 (setq c2 (+ (string-to-number c2)
7954 (if (memq (string-to-char c2) '(?- ?+)) col 0))))
7955 (if (equal r1 "") (setq r1 nil))
7956 (if (equal r2 "") (setq r2 nil))
7957 (if r1 (setq r1 (org-table-get-descriptor-line r1)))
7958 (if r2 (setq r2 (org-table-get-descriptor-line r2)))
7959 ; (setq r2 (or r2 r1) c2 (or c2 c1))
7960 (if (not r1) (setq r1 thisline))
7961 (if (not r2) (setq r2 thisline))
7962 (if (not c1) (setq c1 col))
7963 (if (not c2) (setq c2 col))
7964 (if (or (not rangep) (and (= r1 r2) (= c1 c2)))
7965 ;; just one field
7966 (progn
7967 (goto-line r1)
7968 (while (not (looking-at org-table-dataline-regexp))
7969 (beginning-of-line 2))
7970 (prog1 (org-table-get-field c1)
7971 (if highlight (org-table-highlight-rectangle (point) (point)))))
7972 ;; A range, return a vector
7973 ;; First sort the numbers to get a regular ractangle
7974 (if (< r2 r1) (setq tmp r1 r1 r2 r2 tmp))
7975 (if (< c2 c1) (setq tmp c1 c1 c2 c2 tmp))
7976 (goto-line r1)
7977 (while (not (looking-at org-table-dataline-regexp))
7978 (beginning-of-line 2))
7979 (org-table-goto-column c1)
7980 (setq beg (point))
7981 (goto-line r2)
7982 (while (not (looking-at org-table-dataline-regexp))
7983 (beginning-of-line 0))
7984 (org-table-goto-column c2)
7985 (setq end (point))
7986 (if highlight
7987 (org-table-highlight-rectangle
7989 ;; return string representation of calc vector
7990 (apply 'append (org-table-copy-region beg end))))))
7992 (defun org-table-get-descriptor-line (desc &optional cline bline table)
7993 "Analyze descriptor DESC and retrieve the corresponding line number.
7994 The cursor is currently in line CLINE, the table begins in line BLINE,
7995 and TABLE is a vector with line types."
7996 (if (string-match "^[0-9]+$" desc)
7997 (aref org-table-dlines (string-to-number desc))
7998 (setq cline (or cline (org-current-line))
7999 bline (or bline org-table-current-begin-line)
8000 table (or table org-table-current-line-types))
8001 (if (or
8003 ;; 1 2 3 4 5 6
8004 (and (not (match-end 3)) (not (match-end 6)))
8005 (and (match-end 3) (match-end 6) (not (match-end 5))))
8006 (error "invalid row descriptor `%s'" desc))
8007 (let* ((hdir (and (match-end 2) (match-string 2 desc)))
8008 (hn (if (match-end 3) (- (match-end 3) (match-beginning 3)) nil))
8009 (odir (and (match-end 5) (match-string 5 desc)))
8010 (on (if (match-end 6) (string-to-number (match-string 6 desc))))
8011 (i (- cline bline))
8012 (rel (and (match-end 6)
8013 (or (and (match-end 1) (not (match-end 3)))
8014 (match-end 5)))))
8015 (if (and hn (not hdir))
8016 (progn
8017 (setq i 0 hdir "+")
8018 (if (eq (aref table 0) 'hline) (setq hn (1- hn)))))
8019 (if (and (not hn) on (not odir))
8020 (error "should never happen");;(aref org-table-dlines on) FIXME
8021 (if (and hn (> hn 0))
8022 (setq i (org-find-row-type table i 'hline (equal hdir "-") nil hn)))
8023 (if on
8024 (setq i (org-find-row-type table i 'dline (equal odir "-") rel on)))
8025 (+ bline i)))))
8027 (defun org-find-row-type (table i type backwards relative n)
8028 (let ((l (length table)))
8029 (while (> n 0)
8030 (while (and (setq i (+ i (if backwards -1 1)))
8031 (>= i 0) (< i l)
8032 (not (eq (aref table i) type))
8033 (if (and relative (eq (aref table i) 'hline))
8034 (progn (setq i (- i (if backwards -1 1)) n 1) nil)
8035 t)))
8036 (setq n (1- n)))
8037 (if (or (< i 0) (>= i l))
8038 (error "Row descriptior leads outside table")
8039 i)))
8041 (defun org-rewrite-old-row-references (s)
8042 (if (string-match "&[-+0-9I]" s)
8043 (error "Formula contains old &row reference, please rewrite using @-syntax")
8044 s))
8046 (defun org-table-make-reference (elements keep-empty numbers lispp)
8047 "Convert list ELEMENTS to something appropriate to insert into formula.
8048 KEEP-EMPTY indicated to keep empty fields, default is to skip them.
8049 NUMBERS indicates that everything should be converted to numbers.
8050 LISPP means to return something appropriate for a Lisp list."
8051 (if (stringp elements) ; just a single val
8052 (if lispp
8053 (prin1-to-string (if numbers (string-to-number elements) elements))
8054 (if (equal elements "") (setq elements "0"))
8055 (if numbers (number-to-string (string-to-number elements)) elements))
8056 (unless keep-empty
8057 (setq elements
8058 (delq nil
8060 elements))))
8061 (setq elements (or elements '("0")))
8062 (if lispp
8063 (mapconcat 'prin1-to-string
8064 (if numbers (mapcar 'string-to-number elements) elements)
8065 " ")
8066 (concat "[" (mapconcat
8067 (lambda (x)
8068 (if numbers (number-to-string (string-to-number x)) x))
8069 elements
8070 ",") "]"))))
8072 (defun org-table-recalculate (&optional all noalign)
8073 "Recalculate the current table line by applying all stored formulas.
8074 With prefix arg ALL, do this for all lines in the table."
8075 (interactive "P")
8076 (or (memq this-command org-recalc-commands)
8077 (setq org-recalc-commands (cons this-command org-recalc-commands)))
8078 (unless (org-at-table-p) (error "Not at a table"))
8079 (if (equal all '(16))
8080 (org-table-iterate)
8081 (org-table-get-specials)
8082 (let* ((eqlist (sort (org-table-get-stored-formulas)
8083 (lambda (a b) (string< (car a) (car b)))))
8084 (inhibit-redisplay (not debug-on-error))
8085 (line-re org-table-dataline-regexp)
8086 (thisline (org-current-line))
8087 (thiscol (org-table-current-column))
8088 beg end entry eqlnum eqlname eql (cnt 0) eq a name)
8089 ;; Insert constants in all formulas
8090 (setq eqlist
8091 (mapcar (lambda (x)
8092 (setcdr x (org-table-formula-substitute-names (cdr x)))
8093 x)
8094 eqlist))
8095 ;; Split the equation list
8096 (while (setq eq (pop eqlist))
8097 (if (<= (string-to-char (car eq)) ?9)
8098 (push eq eqlnum)
8099 (push eq eqlname)))
8100 (setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname))
8101 (if all
8102 (progn
8103 (setq end (move-marker (make-marker) (1+ (org-table-end))))
8104 (goto-char (setq beg (org-table-begin)))
8105 (if (re-search-forward org-table-calculate-mark-regexp end t)
8106 ;; This is a table with marked lines, compute selected lines
8107 (setq line-re org-table-recalculate-regexp)
8108 ;; Move forward to the first non-header line
8109 (if (and (re-search-forward org-table-dataline-regexp end t)
8110 (re-search-forward org-table-hline-regexp end t)
8111 (re-search-forward org-table-dataline-regexp end t))
8112 (setq beg (match-beginning 0))
8113 nil))) ;; just leave beg where it is
8114 (setq beg (point-at-bol)
8115 end (move-marker (make-marker) (1+ (point-at-eol)))))
8116 (goto-char beg)
8117 (and all (message "Re-applying formulas to full table..."))
8118 (while (re-search-forward line-re end t)
8119 (unless (string-match "^ *[_^!$] *$" (org-table-get-field 1))
8120 ;; Unprotected line, recalculate
8121 (and all (message "Re-applying formulas to full table...(line %d)"
8122 (setq cnt (1+ cnt))))
8123 (setq org-last-recalc-line (org-current-line))
8124 (setq eql eqlnum)
8125 (while (setq entry (pop eql))
8126 (goto-line org-last-recalc-line)
8127 (org-table-goto-column (string-to-number (car entry)) nil 'force)
8128 (org-table-eval-formula nil (cdr entry)
8129 'noalign 'nocst 'nostore 'noanalysis))))
8130 (goto-line thisline)
8131 (org-table-goto-column thiscol)
8132 (or noalign (and org-table-may-need-update (org-table-align))
8133 (and all (message "Re-applying formulas to %d lines...done" cnt)))
8134 ;; Now do the named fields
8135 (while (setq eq (pop eqlname))
8136 (setq name (car eq)
8137 a (assoc name org-table-named-field-locations))
8138 (and (not a)
8140 (setq a
8141 (list
8142 name
8143 (aref org-table-dlines
8144 (string-to-number (match-string 1 name)))
8145 (string-to-number (match-string 2 name)))))
8146 (when (and a (or all (equal (nth 1 a) thisline)))
8147 (message "Re-applying formula to field: %s" name)
8148 (goto-line (nth 1 a))
8149 (org-table-goto-column (nth 2 a))
8150 (org-table-eval-formula nil (cdr eq) 'noalign 'nocst
8151 'nostore 'noanalysis)))
8152 ;; back to initial position
8153 (message "Re-applying formulas...done")
8154 (goto-line thisline)
8155 (org-table-goto-column thiscol)
8156 (or noalign (and org-table-may-need-update (org-table-align))
8157 (and all (message "Re-applying formulas...done"))))))
8159 (defun org-table-iterate (&optional arg)
8160 "Recalculate the table until it does not change anymore."
8161 (interactive "P")
8162 (let ((imax (if arg (prefix-numeric-value arg) 10))
8163 (i 0)
8164 (lasttbl (buffer-substring (org-table-begin) (org-table-end)))
8165 thistbl)
8166 (catch 'exit
8167 (while (< i imax)
8168 (setq i (1+ i))
8169 (org-table-recalculate 'all)
8170 (setq thistbl (buffer-substring (org-table-begin) (org-table-end)))
8171 (if (not (string= lasttbl thistbl))
8172 (setq lasttbl thistbl)
8173 (if (> i 1)
8174 (message "Convergence after %d iterations" i)
8175 (message "Table was already stable"))
8176 (throw 'exit t)))
8177 (error "No convergence after %d iterations" i))))
8179 (defun org-table-formula-substitute-names (f)
8180 "Replace $const with values in string F."
8181 (let ((start 0) a (f1 f))
8182 ;; First, check for column names
8183 (while (setq start (string-match org-table-column-name-regexp f start))
8184 (setq start (1+ start))
8185 (setq a (assoc (match-string 1 f) org-table-column-names))
8186 (setq f (replace-match (concat "$" (cdr a)) t t f)))
8187 ;; Parameters and constants
8188 (setq start 0)
8190 (setq start (1+ start))
8191 (if (setq a (save-match-data
8192 (org-table-get-constant (match-string 1 f))))
8193 (setq f (replace-match (concat "(" a ")") t t f))))
8194 (if org-table-formula-debug
8195 (put-text-property 0 (length f) :orig-formula f1 f))
8196 f))
8198 (defun org-table-get-constant (const)
8199 "Find the value for a parameter or constant in a formula.
8200 Parameters get priority."
8201 (or (cdr (assoc const org-table-local-parameters))
8202 (cdr (assoc const org-table-formula-constants))
8203 (and (fboundp 'constants-get) (constants-get const))
8204 "#UNDEFINED_NAME"))
8206 (defvar org-table-fedit-map (make-sparse-keymap))
8207 (org-defkey org-table-fedit-map "\C-x\C-s" 'org-table-fedit-finish)
8208 (org-defkey org-table-fedit-map "\C-c\C-s" 'org-table-fedit-finish)
8209 (org-defkey org-table-fedit-map "\C-c\C-c" 'org-table-fedit-finish)
8210 (org-defkey org-table-fedit-map "\C-c\C-q" 'org-table-fedit-abort)
8211 (org-defkey org-table-fedit-map "\C-c?" 'org-table-show-reference)
8212 (org-defkey org-table-fedit-map [(meta shift up)] 'org-table-fedit-line-up)
8213 (org-defkey org-table-fedit-map [(meta shift down)] 'org-table-fedit-line-down)
8214 (org-defkey org-table-fedit-map [(shift up)] 'org-table-fedit-ref-up)
8215 (org-defkey org-table-fedit-map [(shift down)] 'org-table-fedit-ref-down)
8216 (org-defkey org-table-fedit-map [(shift left)] 'org-table-fedit-ref-left)
8217 (org-defkey org-table-fedit-map [(shift right)] 'org-table-fedit-ref-right)
8218 (org-defkey org-table-fedit-map [(meta up)] 'org-table-fedit-scroll-down)
8219 (org-defkey org-table-fedit-map [(meta down)] 'org-table-fedit-scroll)
8220 (org-defkey org-table-fedit-map [(meta tab)] 'lisp-complete-symbol)
8221 (org-defkey org-table-fedit-map "\M-\C-i" 'lisp-complete-symbol)
8222 (org-defkey org-table-fedit-map [(tab)] 'org-table-fedit-lisp-indent)
8223 (org-defkey org-table-fedit-map "\C-i" 'org-table-fedit-lisp-indent)
8224 (org-defkey org-table-fedit-map "\C-c\C-r" 'org-table-fedit-toggle-ref-type)
8225 (org-defkey org-table-fedit-map "\C-c}" 'org-table-fedit-toggle-coordinates)
8227 (easy-menu-define org-table-fedit-menu org-table-fedit-map "Org Edit Formulas Menu"
8228 '("Edit-Formulas"
8229 ["Finish and Install" org-table-fedit-finish t]
8230 ["Finish, Install, and Apply" (org-table-fedit-finish t) :keys "C-u C-c C-c"]
8231 ["Abort" org-table-fedit-abort t]
8232 "--"
8233 ["Pretty-Print Lisp Formula" org-table-fedit-lisp-indent t]
8234 ["Complete Lisp Symbol" lisp-complete-symbol t]
8235 "--"
8236 "Shift Reference at Point"
8237 ["Up" org-table-fedit-ref-up t]
8238 ["Down" org-table-fedit-ref-down t]
8239 ["Left" org-table-fedit-ref-left t]
8240 ["Right" org-table-fedit-ref-right t]
8241 "-"
8242 "Change Test Row for Column Formulas"
8243 ["Up" org-table-fedit-line-up t]
8244 ["Down" org-table-fedit-line-down t]
8245 "--"
8246 ["Scroll Table Window" org-table-fedit-scroll t]
8247 ["Scroll Table Window down" org-table-fedit-scroll-down t]
8248 ["Show Table Grid" org-table-fedit-toggle-coordinates
8249 :style toggle :selected (with-current-buffer (marker-buffer org-pos)
8250 org-table-overlay-coordinates)]
8251 "--"
8252 ["Standard Refs (B3 instead of @3$2)" org-table-fedit-toggle-ref-type
8253 :style toggle :selected org-table-buffer-is-an]))
8255 (defvar org-pos)
8257 (defun org-table-edit-formulas ()
8258 "Edit the formulas of the current table in a separate buffer."
8259 (interactive)
8261 (beginning-of-line 0))
8262 (unless (org-at-table-p) (error "Not at a table"))
8263 (org-table-get-specials)
8264 (let ((key (org-table-current-field-formula 'key 'noerror))
8265 (eql (sort (org-table-get-stored-formulas 'noerror)
8266 'org-table-formula-less-p))
8267 (pos (move-marker (make-marker) (point)))
8268 (startline 1)
8269 (wc (current-window-configuration))
8273 entry s type title)
8274 (switch-to-buffer-other-window "*Edit Formulas*")
8275 (erase-buffer)
8276 ;; Keep global-font-lock-mode from turning on font-lock-mode
8277 (let ((font-lock-global-modes '(not fundamental-mode)))
8278 (fundamental-mode))
8279 (org-set-local 'font-lock-global-modes (list 'not major-mode))
8280 (org-set-local 'org-pos pos)
8281 (org-set-local 'org-window-configuration wc)
8282 (use-local-map org-table-fedit-map)
8283 (org-add-hook 'post-command-hook 'org-table-fedit-post-command t t)
8284 (easy-menu-add org-table-fedit-menu)
8285 (setq startline (org-current-line))
8286 (while (setq entry (pop eql))
8287 (setq type (cond
8288 ((equal (string-to-char (car entry)) ?@) 'field)
8289 ((string-match "^[0-9]" (car entry)) 'column)
8290 (t 'named)))
8291 (when (setq title (assq type titles))
8293 (insert (org-add-props (cdr title) nil 'face font-lock-comment-face))
8294 (setq titles (delq title titles)))
8295 (if (equal key (car entry)) (setq startline (org-current-line)))
8296 (setq s (concat (if (equal (string-to-char (car entry)) ?@) "" "$")
8298 (remove-text-properties 0 (length s) '(face nil) s)
8299 (insert s))
8300 (if (eq org-table-use-standard-references t)
8301 (org-table-fedit-toggle-ref-type))
8302 (goto-line startline)
8303 (message "Edit formulas and finish with `C-c C-c'. See menu for more commands.")))
8305 (defun org-table-fedit-post-command ()
8306 (when (not (memq this-command '(lisp-complete-symbol)))
8307 (let ((win (selected-window)))
8308 (save-excursion
8309 (condition-case nil
8310 (org-table-show-reference)
8311 (error nil))
8312 (select-window win)))))
8314 (defun org-table-formula-to-user (s)
8315 "Convert a formula from internal to user representation."
8316 (if (eq org-table-use-standard-references t)
8317 (org-table-convert-refs-to-an s)
8318 s))
8320 (defun org-table-formula-from-user (s)
8321 "Convert a formula from user to internal representation."
8322 (if org-table-use-standard-references
8323 (org-table-convert-refs-to-rc s)
8324 s))
8326 (defun org-table-convert-refs-to-rc (s)
8327 "Convert spreadsheet references from AB7 to @7$28.
8328 Works for single references, but also for entire formulas and even the
8329 full TBLFM line."
8330 (let ((start 0))
8332 (if (match-end 3)
8333 ;; format match, just advance
8334 (setq start (match-end 0))
8335 (setq start (match-beginning 0)
8336 s (replace-match
8337 (if (equal (match-string 2 s) "&")
8338 (format "$%d" (org-letters-to-number (match-string 1 s)))
8339 (format "@%d$%d"
8340 (string-to-number (match-string 2 s))
8341 (org-letters-to-number (match-string 1 s))))
8342 t t s))))
8343 s))
8345 (defun org-table-convert-refs-to-an (s)
8346 "Convert spreadsheet references from to @7$28 to AB7.
8347 Works for single references, but also for entire formulas and even the
8348 full TBLFM line."
8350 (setq s (replace-match
8351 (format "%s%d"
8352 (org-number-to-letters
8353 (string-to-number (match-string 2 s)))
8354 (string-to-number (match-string 1 s)))
8355 t t s)))
8358 (org-number-to-letters
8359 (string-to-number (match-string 2 s))) "&")
8360 t nil s)))
8361 s)
8363 (defun org-letters-to-number (s)
8364 "Convert a base 26 number represented by letters into an integer.
8365 For example: AB -> 28."
8366 (let ((n 0))
8367 (setq s (upcase s))
8368 (while (> (length s) 0)
8369 (setq n (+ (* n 26) (string-to-char s) (- ?A) 1)
8370 s (substring s 1)))
8371 n))
8373 (defun org-number-to-letters (n)
8374 "Convert an integer into a base 26 number represented by letters.
8375 For example: 28 -> AB."
8376 (let ((s ""))
8377 (while (> n 0)
8378 (setq s (concat (char-to-string (+ (mod (1- n) 26) ?A)) s)
8379 n (/ (1- n) 26)))
8380 s))
8382 (defun org-table-fedit-convert-buffer (function)
8383 "Convert all references in this buffer, using FUNTION."
8384 (let ((line (org-current-line)))
8385 (goto-char (point-min))
8386 (while (not (eobp))
8387 (insert (funcall function (buffer-substring (point) (point-at-eol))))
8388 (delete-region (point) (point-at-eol))
8389 (or (eobp) (forward-char 1)))
8390 (goto-line line)))
8392 (defun org-table-fedit-toggle-ref-type ()
8393 "Convert all references in the buffer from B3 to @3$2 and back."
8394 (interactive)
8395 (org-set-local 'org-table-buffer-is-an (not org-table-buffer-is-an))
8396 (org-table-fedit-convert-buffer
8397 (if org-table-buffer-is-an
8398 'org-table-convert-refs-to-an 'org-table-convert-refs-to-rc))
8399 (message "Reference type switched to %s"
8400 (if org-table-buffer-is-an "A1 etc" "@row$column")))
8402 (defun org-table-fedit-ref-up ()
8403 "Shift the reference at point one row/hline up."
8404 (interactive)
8405 (org-table-fedit-shift-reference 'up))
8406 (defun org-table-fedit-ref-down ()
8407 "Shift the reference at point one row/hline down."
8408 (interactive)
8409 (org-table-fedit-shift-reference 'down))
8410 (defun org-table-fedit-ref-left ()
8411 "Shift the reference at point one field to the left."
8412 (interactive)
8413 (org-table-fedit-shift-reference 'left))
8414 (defun org-table-fedit-ref-right ()
8415 "Shift the reference at point one field to the right."
8416 (interactive)
8417 (org-table-fedit-shift-reference 'right))
8419 (defun org-table-fedit-shift-reference (dir)
8420 (cond
8422 (if (memq dir '(left right))
8423 (org-rematch-and-replace 1 (eq dir 'left))
8424 (error "Cannot shift reference in this direction")))
8426 ;; A B3-like reference
8427 (if (memq dir '(up down))
8428 (org-rematch-and-replace 2 (eq dir 'up))
8429 (org-rematch-and-replace 1 (eq dir 'left))))
8430 ((org-at-regexp-p
8432 ;; An internal reference
8433 (if (memq dir '(up down))
8434 (org-rematch-and-replace 2 (eq dir 'up) (match-end 3))
8435 (org-rematch-and-replace 5 (eq dir 'left))))))
8437 (defun org-rematch-and-replace (n &optional decr hline)
8438 "Re-match the group N, and replace it with the shifted refrence."
8439 (or (match-end n) (error "Cannot shift reference in this direction"))
8440 (goto-char (match-beginning n))
8441 (and (looking-at (regexp-quote (match-string n)))
8442 (replace-match (org-shift-refpart (match-string 0) decr hline)
8443 t t)))
8445 (defun org-shift-refpart (ref &optional decr hline)
8446 "Shift a refrence part REF.
8447 If DECR is set, decrease the references row/column, else increase.
8448 If HLINE is set, this may be a hline reference, it certainly is not
8449 a translation reference."
8450 (save-match-data
8451 (let* ((sign (string-match "^[-+]" ref)) n)
8453 (if sign (setq sign (substring ref 0 1) ref (substring ref 1)))
8454 (cond
8455 ((and hline (string-match "^I+" ref))
8456 (setq n (string-to-number (concat sign (number-to-string (length ref)))))
8457 (setq n (+ n (if decr -1 1)))
8458 (if (= n 0) (setq n (+ n (if decr -1 1))))
8459 (if sign
8460 (setq sign (if (< n 0) "-" "+") n (abs n))
8461 (setq n (max 1 n)))
8462 (concat sign (make-string n ?I)))
8464 ((string-match "^[0-9]+" ref)
8465 (setq n (string-to-number (concat sign ref)))
8466 (setq n (+ n (if decr -1 1)))
8467 (if sign
8468 (concat (if (< n 0) "-" "+") (number-to-string (abs n)))
8469 (number-to-string (max 1 n))))
8471 ((string-match "^[a-zA-Z]+" ref)
8472 (org-number-to-letters
8473 (max 1 (+ (org-letters-to-number ref) (if decr -1 1)))))
8475 (t (error "Cannot shift reference"))))))
8477 (defun org-table-fedit-toggle-coordinates ()
8478 "Toggle the display of coordinates in the refrenced table."
8479 (interactive)
8480 (let ((pos (marker-position org-pos)))
8481 (with-current-buffer (marker-buffer org-pos)
8482 (save-excursion
8483 (goto-char pos)
8484 (org-table-toggle-coordinate-overlays)))))
8486 (defun org-table-fedit-finish (&optional arg)
8487 "Parse the buffer for formula definitions and install them.
8488 With prefix ARG, apply the new formulas to the table."
8489 (interactive "P")
8490 (org-table-remove-rectangle-highlight)
8491 (if org-table-use-standard-references
8492 (progn
8493 (org-table-fedit-convert-buffer 'org-table-convert-refs-to-rc)
8494 (setq org-table-buffer-is-an nil)))
8495 (let ((pos org-pos) eql var form)
8496 (goto-char (point-min))
8497 (while (re-search-forward
8499 nil t)
8500 (setq var (if (match-end 2) (match-string 2) (match-string 1))
8501 form (match-string 3))
8502 (setq form (org-trim form))
8503 (when (not (equal form ""))
8505 (setq form (replace-match " " t t form)))
8506 (when (assoc var eql)
8507 (error "Double formulas for %s" var))
8508 (push (cons var form) eql)))
8509 (setq org-pos nil)
8510 (set-window-configuration org-window-configuration)
8511 (select-window (get-buffer-window (marker-buffer pos)))
8512 (goto-char pos)
8513 (unless (org-at-table-p)
8514 (error "Lost table position - cannot install formulae"))
8515 (org-table-store-formulas eql)
8516 (move-marker pos nil)
8517 (kill-buffer "*Edit Formulas*")
8518 (if arg
8519 (org-table-recalculate 'all)
8520 (message "New formulas installed - press C-u C-c C-c to apply."))))
8522 (defun org-table-fedit-abort ()
8523 "Abort editing formulas, without installing the changes."
8524 (interactive)
8525 (org-table-remove-rectangle-highlight)
8526 (let ((pos org-pos))
8527 (set-window-configuration org-window-configuration)
8528 (select-window (get-buffer-window (marker-buffer pos)))
8529 (goto-char pos)
8530 (move-marker pos nil)
8531 (message "Formula editing aborted without installing changes")))
8533 (defun org-table-fedit-lisp-indent ()
8534 "Pretty-print and re-indent Lisp expressions in the Formula Editor."
8535 (interactive)
8536 (let ((pos (point)) beg end ind)
8537 (beginning-of-line 1)
8538 (cond
8540 (goto-char pos)
8541 (call-interactively 'lisp-indent-line))
8543 ((not (fboundp 'pp-buffer))
8544 (error "Cannot pretty-print. Command `pp-buffer' is not available."))
8545 ((looking-at "[$@0-9a-zA-Z]+ *= *'(")
8546 (goto-char (- (match-end 0) 2))
8547 (setq beg (point))
8548 (setq ind (make-string (current-column) ?\ ))
8549 (condition-case nil (forward-sexp 1)
8550 (error
8551 (error "Cannot pretty-print Lisp expression: Unbalanced parenthesis")))
8552 (setq end (point))
8553 (save-restriction
8554 (narrow-to-region beg end)
8555 (if (eq last-command this-command)
8556 (progn
8557 (goto-char (point-min))
8558 (setq this-command nil)
8560 (replace-match " ")))
8561 (pp-buffer)
8562 (untabify (point-min) (point-max))
8563 (goto-char (1+ (point-min)))
8564 (while (re-search-forward "^." nil t)
8565 (beginning-of-line 1)
8566 (insert ind))
8567 (goto-char (point-max))
8568 (backward-delete-char 1)))
8569 (goto-char beg))
8570 (t nil))))
8572 (defvar org-show-positions nil)
8574 (defun org-table-show-reference (&optional local)
8575 "Show the location/value of the $ expression at point."
8576 (interactive)
8577 (org-table-remove-rectangle-highlight)
8578 (catch 'exit
8579 (let ((pos (if local (point) org-pos))
8580 (face2 'highlight)
8581 (org-inhibit-highlight-removal t)
8582 (win (selected-window))
8583 (org-show-positions nil)
8584 var name e what match dest)
8585 (if local (org-table-get-specials))
8586 (setq what (cond
8587 ((or (org-at-regexp-p org-table-range-regexp2)
8588 (org-at-regexp-p org-table-translate-regexp)
8589 (org-at-regexp-p org-table-range-regexp))
8590 (setq match
8591 (save-match-data
8592 (org-table-convert-refs-to-rc (match-string 0))))
8593 'range)
8596 ((not local) nil)
8597 (t (error "No reference at point")))
8598 match (and what (or match (match-string 0))))
8599 (when (and match (not (equal (match-beginning 0) (point-at-bol))))
8600 (org-table-add-rectangle-overlay (match-beginning 0) (match-end 0)
8601 'secondary-selection))
8602 (org-add-hook 'before-change-functions
8603 'org-table-remove-rectangle-highlight)
8604 (if (eq what 'name) (setq var (substring match 1)))
8605 (when (eq what 'range)
8606 (or (equal (string-to-char match) ?@) (setq match (concat "@" match)))
8607 (setq match (org-table-formula-substitute-names match)))
8608 (unless local
8609 (save-excursion
8610 (end-of-line 1)
8612 (beginning-of-line 1)
8614 (setq dest
8615 (save-match-data
8616 (org-table-convert-refs-to-rc (match-string 1))))
8617 (org-table-add-rectangle-overlay
8618 (match-beginning 1) (match-end 1) face2))))
8619 (if (and (markerp pos) (marker-buffer pos))
8620 (if (get-buffer-window (marker-buffer pos))
8621 (select-window (get-buffer-window (marker-buffer pos)))
8622 (switch-to-buffer-other-window (get-buffer-window
8623 (marker-buffer pos)))))
8624 (goto-char pos)
8625 (org-table-force-dataline)
8626 (when dest
8627 (setq name (substring dest 1))
8628 (cond
8630 (setq e (assoc name org-table-named-field-locations))
8631 (goto-line (nth 1 e))
8632 (org-table-goto-column (nth 2 e)))
8634 (let ((l (string-to-number (match-string 1 dest)))
8635 (c (string-to-number (match-string 2 dest))))
8636 (goto-line (aref org-table-dlines l))
8637 (org-table-goto-column c)))
8638 (t (org-table-goto-column (string-to-number name))))
8639 (move-marker pos (point))
8640 (org-table-highlight-rectangle nil nil face2))
8641 (cond
8642 ((equal dest match))
8643 ((not match))
8644 ((eq what 'range)
8645 (condition-case nil
8646 (save-excursion
8647 (org-table-get-range match nil nil 'highlight))
8648 (error nil)))
8649 ((setq e (assoc var org-table-named-field-locations))
8650 (goto-line (nth 1 e))
8651 (org-table-goto-column (nth 2 e))
8652 (org-table-highlight-rectangle (point) (point))
8653 (message "Named field, column %d of line %d" (nth 2 e) (nth 1 e)))
8654 ((setq e (assoc var org-table-column-names))
8655 (org-table-goto-column (string-to-number (cdr e)))
8656 (org-table-highlight-rectangle (point) (point))
8657 (goto-char (org-table-begin))
8659 (org-table-end) t)
8660 (progn
8661 (goto-char (match-beginning 1))
8662 (org-table-highlight-rectangle)
8663 (message "Named column (column %s)" (cdr e)))
8664 (error "Column name not found")))
8665 ((eq what 'column)
8666 ;; column number
8667 (org-table-goto-column (string-to-number (substring match 1)))
8668 (org-table-highlight-rectangle (point) (point))
8669 (message "Column %s" (substring match 1)))
8670 ((setq e (assoc var org-table-local-parameters))
8671 (goto-char (org-table-begin))
8673 (progn
8674 (goto-char (match-beginning 1))
8675 (org-table-highlight-rectangle)
8676 (message "Local parameter."))
8677 (error "Parameter not found")))
8678 (t
8679 (cond
8680 ((not var) (error "No reference at point"))
8681 ((setq e (assoc var org-table-formula-constants))
8682 (message "Constant: $%s=%s in `org-table-formula-constants'."
8683 var (cdr e)))
8684 ((setq e (and (fboundp 'constants-get) (constants-get var)))
8685 (message "Constant: $%s=%s, from `constants.el'%s."
8686 var e (format " (%s units)" constants-unit-system)))
8687 (t (error "Undefined name $%s" var)))))
8688 (goto-char pos)
8689 (when (and org-show-positions
8690 (not (memq this-command '(org-table-fedit-scroll
8691 org-table-fedit-scroll-down))))
8692 (push pos org-show-positions)
8693 (push org-table-current-begin-pos org-show-positions)
8694 (let ((min (apply 'min org-show-positions))
8695 (max (apply 'max org-show-positions)))
8696 (goto-char min) (recenter 0)
8697 (goto-char max)
8698 (or (pos-visible-in-window-p max) (recenter -1))))
8699 (select-window win))))
8701 (defun org-table-force-dataline ()
8702 "Make sure the cursor is in a dataline in a table."
8703 (unless (save-excursion
8704 (beginning-of-line 1)
8705 (looking-at org-table-dataline-regexp))
8706 (let* ((re org-table-dataline-regexp)
8707 (p1 (save-excursion (re-search-forward re nil 'move)))
8708 (p2 (save-excursion (re-search-backward re nil 'move))))
8709 (cond ((and p1 p2)
8710 (goto-char (if (< (abs (- p1 (point))) (abs (- p2 (point))))
8711 p1 p2)))
8712 ((or p1 p2) (goto-char (or p1 p2)))
8713 (t (error "No table dataline around here"))))))
8715 (defun org-table-fedit-line-up ()
8716 "Move cursor one line up in the window showing the table."
8717 (interactive)
8718 (org-table-fedit-move 'previous-line))
8720 (defun org-table-fedit-line-down ()
8721 "Move cursor one line down in the window showing the table."
8722 (interactive)
8723 (org-table-fedit-move 'next-line))
8725 (defun org-table-fedit-move (command)
8726 "Move the cursor in the window shoinw the table.
8727 Use COMMAND to do the motion, repeat if necessary to end up in a data line."
8728 (let ((org-table-allow-automatic-line-recalculation nil)
8729 (pos org-pos) (win (selected-window)) p)
8730 (select-window (get-buffer-window (marker-buffer org-pos)))
8731 (setq p (point))
8732 (call-interactively command)
8733 (while (and (org-at-table-p)
8734 (org-at-table-hline-p))
8735 (call-interactively command))
8736 (or (org-at-table-p) (goto-char p))
8737 (move-marker pos (point))
8738 (select-window win)))
8740 (defun org-table-fedit-scroll (N)
8741 (interactive "p")
8742 (let ((other-window-scroll-buffer (marker-buffer org-pos)))
8743 (scroll-other-window N)))
8745 (defun org-table-fedit-scroll-down (N)
8746 (interactive "p")
8747 (org-table-fedit-scroll (- N)))
8749 (defvar org-table-rectangle-overlays nil)
8751 (defun org-table-add-rectangle-overlay (beg end &optional face)
8752 "Add a new overlay."
8753 (let ((ov (org-make-overlay beg end)))
8754 (org-overlay-put ov 'face (or face 'secondary-selection))
8755 (push ov org-table-rectangle-overlays)))
8757 (defun org-table-highlight-rectangle (&optional beg end face)
8758 "Highlight rectangular region in a table."
8759 (setq beg (or beg (point)) end (or end (point)))
8760 (let ((b (min beg end))
8761 (e (max beg end))
8762 l1 c1 l2 c2 tmp)
8763 (and (boundp 'org-show-positions)
8764 (setq org-show-positions (cons b (cons e org-show-positions))))
8765 (goto-char (min beg end))
8766 (setq l1 (org-current-line)
8767 c1 (org-table-current-column))
8768 (goto-char (max beg end))
8769 (setq l2 (org-current-line)
8770 c2 (org-table-current-column))
8771 (if (> c1 c2) (setq tmp c1 c1 c2 c2 tmp))
8772 (goto-line l1)
8773 (beginning-of-line 1)
8774 (loop for line from l1 to l2 do
8775 (when (looking-at org-table-dataline-regexp)
8776 (org-table-goto-column c1)
8778 (org-table-goto-column c2)
8780 (org-table-add-rectangle-overlay beg end face))
8781 (beginning-of-line 2))
8782 (goto-char b))
8783 (add-hook 'before-change-functions 'org-table-remove-rectangle-highlight))
8785 (defun org-table-remove-rectangle-highlight (&rest ignore)
8786 "Remove the rectangle overlays."
8787 (unless org-inhibit-highlight-removal
8788 (remove-hook 'before-change-functions 'org-table-remove-rectangle-highlight)
8789 (mapc 'org-delete-overlay org-table-rectangle-overlays)
8790 (setq org-table-rectangle-overlays nil)))
8792 (defvar org-table-coordinate-overlays nil
8793 "Collects the cooordinate grid overlays, so that they can be removed.")
8794 (make-variable-buffer-local 'org-table-coordinate-overlays)
8796 (defun org-table-overlay-coordinates ()
8797 "Add overlays to the table at point, to show row/column coordinates."
8798 (interactive)
8799 (mapc 'org-delete-overlay org-table-coordinate-overlays)
8800 (setq org-table-coordinate-overlays nil)
8801 (save-excursion
8802 (let ((id 0) (ih 0) hline eol s1 s2 str ic ov beg)
8803 (goto-char (org-table-begin))
8804 (while (org-at-table-p)
8805 (setq eol (point-at-eol))
8806 (setq ov (org-make-overlay (point-at-bol) (1+ (point-at-bol))))
8807 (push ov org-table-coordinate-overlays)
8808 (setq hline (looking-at org-table-hline-regexp))
8809 (setq str (if hline (format "I*%-2d" (setq ih (1+ ih)))
8810 (format "%4d" (setq id (1+ id)))))
8811 (org-overlay-before-string ov str 'org-special-keyword 'evaporate)
8812 (when hline
8813 (setq ic 0)
8815 (setq beg (1+ (match-beginning 0))
8816 ic (1+ ic)
8817 s1 (concat "$" (int-to-string ic))
8818 s2 (org-number-to-letters ic)
8819 str (if org-table-use-standard-references s2 s1))
8820 (setq ov (org-make-overlay beg (+ beg (length str))))
8821 (push ov org-table-coordinate-overlays)
8822 (org-overlay-display ov str 'org-special-keyword 'evaporate)))
8823 (beginning-of-line 2)))))
8825 (defun org-table-toggle-coordinate-overlays ()
8826 "Toggle the display of Row/Column numbers in tables."
8827 (interactive)
8828 (setq org-table-overlay-coordinates (not org-table-overlay-coordinates))
8829 (message "Row/Column number display turned %s"
8830 (if org-table-overlay-coordinates "on" "off"))
8831 (if (and (org-at-table-p) org-table-overlay-coordinates)
8832 (org-table-align))
8833 (unless org-table-overlay-coordinates
8834 (mapc 'org-delete-overlay org-table-coordinate-overlays)
8835 (setq org-table-coordinate-overlays nil)))
8837 (defun org-table-toggle-formula-debugger ()
8838 "Toggle the formula debugger in tables."
8839 (interactive)
8840 (setq org-table-formula-debug (not org-table-formula-debug))
8841 (message "Formula debugging has been turned %s"
8842 (if org-table-formula-debug "on" "off")))
8844 ;;; The orgtbl minor mode
8846 ;; Define a minor mode which can be used in other modes in order to
8847 ;; integrate the org-mode table editor.
8849 ;; This is really a hack, because the org-mode table editor uses several
8850 ;; keys which normally belong to the major mode, for example the TAB and
8851 ;; RET keys. Here is how it works: The minor mode defines all the keys
8852 ;; necessary to operate the table editor, but wraps the commands into a
8853 ;; function which tests if the cursor is currently inside a table. If that
8854 ;; is the case, the table editor command is executed. However, when any of
8855 ;; those keys is used outside a table, the function uses `key-binding' to
8856 ;; look up if the key has an associated command in another currently active
8857 ;; keymap (minor modes, major mode, global), and executes that command.
8858 ;; There might be problems if any of the keys used by the table editor is
8859 ;; otherwise used as a prefix key.
8861 ;; Another challenge is that the key binding for TAB can be tab or \C-i,
8862 ;; likewise the binding for RET can be return or \C-m. Orgtbl-mode
8863 ;; addresses this by checking explicitly for both bindings.
8865 ;; The optimized version (see variable `orgtbl-optimized') takes over
8866 ;; all keys which are bound to `self-insert-command' in the *global map*.
8867 ;; Some modes bind other commands to simple characters, for example
8868 ;; AUCTeX binds the double quote to `Tex-insert-quote'. With orgtbl-mode
8869 ;; active, this binding is ignored inside tables and replaced with a
8870 ;; modified self-insert.
8872 (defvar orgtbl-mode nil
8873 "Variable controlling `orgtbl-mode', a minor mode enabling the `org-mode'
8874 table editor in arbitrary modes.")
8875 (make-variable-buffer-local 'orgtbl-mode)
8877 (defvar orgtbl-mode-map (make-keymap)
8878 "Keymap for `orgtbl-mode'.")
8880 ;;;###autoload
8881 (defun turn-on-orgtbl ()
8882 "Unconditionally turn on `orgtbl-mode'."
8883 (orgtbl-mode 1))
8885 (defvar org-old-auto-fill-inhibit-regexp nil
8886 "Local variable used by `orgtbl-mode'")
8889 "Matches a line belonging to an orgtbl.")
8891 (defconst orgtbl-extra-font-lock-keywords
8892 (list (list (concat "^" orgtbl-line-start-regexp ".*")
8893 0 (quote 'org-table) 'prepend))
8894 "Extra font-lock-keywords to be added when orgtbl-mode is active.")
8896 ;;;###autoload
8897 (defun orgtbl-mode (&optional arg)
8898 "The `org-mode' table editor as a minor mode for use in other modes."
8899 (interactive)
8900 (if (org-mode-p)
8901 ;; Exit without error, in case some hook functions calls this
8902 ;; by accident in org-mode.
8903 (message "Orgtbl-mode is not useful in org-mode, command ignored")
8904 (setq orgtbl-mode
8905 (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode)))
8906 (if orgtbl-mode
8907 (progn
8908 (and (orgtbl-setup) (defun orgtbl-setup () nil))
8909 ;; Make sure we are first in minor-mode-map-alist
8910 (let ((c (assq 'orgtbl-mode minor-mode-map-alist)))
8911 (and c (setq minor-mode-map-alist
8912 (cons c (delq c minor-mode-map-alist)))))
8913 (org-set-local (quote org-table-may-need-update) t)
8914 (org-add-hook 'before-change-functions 'org-before-change-function
8915 nil 'local)
8916 (org-set-local 'org-old-auto-fill-inhibit-regexp
8917 auto-fill-inhibit-regexp)
8918 (org-set-local 'auto-fill-inhibit-regexp
8919 (if auto-fill-inhibit-regexp
8921 auto-fill-inhibit-regexp)
8922 orgtbl-line-start-regexp))
8923 (org-add-to-invisibility-spec '(org-cwidth))
8924 (when (fboundp 'font-lock-add-keywords)
8925 (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords)
8926 (org-restart-font-lock))
8927 (easy-menu-add orgtbl-mode-menu)
8928 (run-hooks 'orgtbl-mode-hook))
8929 (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp)
8930 (org-cleanup-narrow-column-properties)
8931 (org-remove-from-invisibility-spec '(org-cwidth))
8932 (remove-hook 'before-change-functions 'org-before-change-function t)
8933 (when (fboundp 'font-lock-remove-keywords)
8934 (font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords)
8935 (org-restart-font-lock))
8936 (easy-menu-remove orgtbl-mode-menu)
8937 (force-mode-line-update 'all))))
8939 (defun org-cleanup-narrow-column-properties ()
8940 "Remove all properties related to narrow-column invisibility."
8941 (let ((s 1))
8942 (while (setq s (text-property-any s (point-max)
8943 'display org-narrow-column-arrow))
8944 (remove-text-properties s (1+ s) '(display t)))
8945 (setq s 1)
8946 (while (setq s (text-property-any s (point-max) 'org-cwidth 1))
8947 (remove-text-properties s (1+ s) '(org-cwidth t)))
8948 (setq s 1)
8949 (while (setq s (text-property-any s (point-max) 'invisible 'org-cwidth))
8950 (remove-text-properties s (1+ s) '(invisible t)))))
8952 ;; Install it as a minor mode.
8953 (put 'orgtbl-mode :included t)
8954 (put 'orgtbl-mode :menu-tag "Org Table Mode")
8955 (add-minor-mode 'orgtbl-mode " OrgTbl" orgtbl-mode-map)
8957 (defun orgtbl-make-binding (fun n &rest keys)
8958 "Create a function for binding in the table minor mode.
8959 FUN is the command to call inside a table. N is used to create a unique
8960 command name. KEYS are keys that should be checked in for a command
8961 to execute outside of tables."
8962 (eval
8963 (list 'defun
8964 (intern (concat "orgtbl-hijacker-command-" (int-to-string n)))
8965 '(arg)
8967 "Outside of tables, run the binding of `"
8968 (mapconcat (lambda (x) (format "%s" x)) keys "' or `")
8969 "'.")
8970 '(interactive "p")
8971 (list 'if
8972 '(org-at-table-p)
8973 (list 'call-interactively (list 'quote fun))
8974 (list 'let '(orgtbl-mode)
8975 (list 'call-interactively
8976 (append '(or)
8977 (mapcar (lambda (k)
8978 (list 'key-binding k))
8979 keys)
8980 '('orgtbl-error))))))))
8982 (defun orgtbl-error ()
8983 "Error when there is no default binding for a table key."
8984 (interactive)
8985 (error "This key is has no function outside tables"))
8987 (defun orgtbl-setup ()
8988 "Setup orgtbl keymaps."
8989 (let ((nfunc 0)
8990 (bindings
8991 (list
8992 '([(meta shift left)] org-table-delete-column)
8993 '([(meta left)] org-table-move-column-left)
8994 '([(meta right)] org-table-move-column-right)
8995 '([(meta shift right)] org-table-insert-column)
8996 '([(meta shift up)] org-table-kill-row)
8997 '([(meta shift down)] org-table-insert-row)
8998 '([(meta up)] org-table-move-row-up)
8999 '([(meta down)] org-table-move-row-down)
9000 '("\C-c\C-w" org-table-cut-region)
9001 '("\C-c\M-w" org-table-copy-region)
9002 '("\C-c\C-y" org-table-paste-rectangle)
9003 '("\C-c-" org-table-insert-hline)
9004 '("\C-c}" org-table-toggle-coordinate-overlays)
9005 '("\C-c{" org-table-toggle-formula-debugger)
9006 '("\C-m" org-table-next-row)
9007 '([(shift return)] org-table-copy-down)
9008 '("\C-c\C-q" org-table-wrap-region)
9009 '("\C-c?" org-table-field-info)
9010 '("\C-c " org-table-blank-field)
9011 '("\C-c+" org-table-sum)
9012 '("\C-c=" org-table-eval-formula)
9013 '("\C-c'" org-table-edit-formulas)
9014 '("\C-c`" org-table-edit-field)
9015 '("\C-c*" org-table-recalculate)
9016 '("\C-c|" org-table-create-or-convert-from-region)
9017 '("\C-c^" org-table-sort-lines)
9018 '([(control ?#)] org-table-rotate-recalc-marks)))
9019 elt key fun cmd)
9020 (while (setq elt (pop bindings))
9021 (setq nfunc (1+ nfunc))
9022 (setq key (org-key (car elt))
9023 fun (nth 1 elt)
9024 cmd (orgtbl-make-binding fun nfunc key))
9025 (org-defkey orgtbl-mode-map key cmd))
9027 ;; Special treatment needed for TAB and RET
9028 (org-defkey orgtbl-mode-map [(return)]
9029 (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m"))
9030 (org-defkey orgtbl-mode-map "\C-m"
9031 (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)]))
9033 (org-defkey orgtbl-mode-map [(tab)]
9034 (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i"))
9035 (org-defkey orgtbl-mode-map "\C-i"
9036 (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)]))
9038 (org-defkey orgtbl-mode-map [(shift tab)]
9039 (orgtbl-make-binding 'org-table-previous-field 104
9040 [(shift tab)] [(tab)] "\C-i"))
9042 (org-defkey orgtbl-mode-map "\M-\C-m"
9043 (orgtbl-make-binding 'org-table-wrap-region 105
9044 "\M-\C-m" [(meta return)]))
9045 (org-defkey orgtbl-mode-map [(meta return)]
9046 (orgtbl-make-binding 'org-table-wrap-region 106
9047 [(meta return)] "\M-\C-m"))
9049 (org-defkey orgtbl-mode-map "\C-c\C-c" 'orgtbl-ctrl-c-ctrl-c)
9050 (when orgtbl-optimized
9051 ;; If the user wants maximum table support, we need to hijack
9052 ;; some standard editing functions
9053 (org-remap orgtbl-mode-map
9054 'self-insert-command 'orgtbl-self-insert-command
9055 'delete-char 'org-delete-char
9056 'delete-backward-char 'org-delete-backward-char)
9057 (org-defkey orgtbl-mode-map "|" 'org-force-self-insert))
9058 (easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu"
9059 '("OrgTbl"
9060 ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"]
9061 ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"]
9062 ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"]
9063 ["Next Row" org-return :active (org-at-table-p) :keys "RET"]
9064 "--"
9065 ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"]
9066 ["Edit Field" org-table-edit-field :active (org-at-table-p) :keys "C-c ` "]
9067 ["Copy Field from Above"
9068 org-table-copy-down :active (org-at-table-p) :keys "S-RET"]
9069 "--"
9070 ("Column"
9071 ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-<left>"]
9072 ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-<right>"]
9073 ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"]
9074 ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-<right>"])
9075 ("Row"
9076 ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-<up>"]
9077 ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-<down>"]
9078 ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-<up>"]
9079 ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-<down>"]
9080 ["Sort lines in region" org-table-sort-lines (org-at-table-p) :keys "C-c ^"]
9081 "--"
9082 ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"])
9083 ("Rectangle"
9084 ["Copy Rectangle" org-copy-special :active (org-at-table-p)]
9085 ["Cut Rectangle" org-cut-special :active (org-at-table-p)]
9086 ["Paste Rectangle" org-paste-special :active (org-at-table-p)]
9087 ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p)])
9088 "--"
9089 ("Radio tables"
9090 ["Insert table template" orgtbl-insert-radio-table
9091 (assq major-mode orgtbl-radio-table-templates)]
9092 ["Comment/uncomment table" orgtbl-toggle-comment t])
9093 "--"
9094 ["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="]
9095 ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
9096 ["Edit Formulas" org-table-edit-formulas :active (org-at-table-p) :keys "C-c '"]
9097 ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"]
9098 ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"]
9099 ["Iterate all" (org-table-recalculate '(16)) :active (org-at-table-p) :keys "C-u C-u C-c *"]
9100 ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"]
9101 ["Sum Column/Rectangle" org-table-sum
9102 :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"]
9103 ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"]
9104 ["Debug Formulas"
9105 org-table-toggle-formula-debugger :active (org-at-table-p)
9106 :keys "C-c {"
9107 :style toggle :selected org-table-formula-debug]
9108 ["Show Col/Row Numbers"
9109 org-table-toggle-coordinate-overlays :active (org-at-table-p)
9110 :keys "C-c }"
9111 :style toggle :selected org-table-overlay-coordinates]
9112 ))
9113 t))
9115 (defun orgtbl-ctrl-c-ctrl-c (arg)
9116 "If the cursor is inside a table, realign the table.
9117 It it is a table to be sent away to a receiver, do it.
9118 With prefix arg, also recompute table."
9119 (interactive "P")
9120 (let ((pos (point)) action)
9121 (save-excursion
9122 (beginning-of-line 1)
9126 (cond
9127 ((integerp action)
9128 (goto-char action)
9129 (org-table-maybe-eval-formula)
9130 (if arg
9131 (call-interactively 'org-table-recalculate)
9132 (org-table-maybe-recalculate-line))
9133 (call-interactively 'org-table-align)
9134 (orgtbl-send-table 'maybe))
9135 ((eq action 'recalc)
9136 (save-excursion
9137 (beginning-of-line 1)
9139 (if (org-at-table-p)
9140 (org-call-with-arg 'org-table-recalculate t))))
9141 (t (let (orgtbl-mode)
9142 (call-interactively (key-binding "\C-c\C-c")))))))
9144 (defun orgtbl-tab (arg)
9145 "Justification and field motion for `orgtbl-mode'."
9146 (interactive "P")
9147 (if arg (org-table-edit-field t)
9148 (org-table-justify-field-maybe)
9149 (org-table-next-field)))
9151 (defun orgtbl-ret ()
9152 "Justification and field motion for `orgtbl-mode'."
9153 (interactive)
9154 (org-table-justify-field-maybe)
9155 (org-table-next-row))
9157 (defun orgtbl-self-insert-command (N)
9158 "Like `self-insert-command', use overwrite-mode for whitespace in tables.
9159 If the cursor is in a table looking at whitespace, the whitespace is
9160 overwritten, and the table is not marked as requiring realignment."
9161 (interactive "p")
9162 (if (and (org-at-table-p)
9163 (or
9164 (and org-table-auto-blank-field
9165 (member last-command
9166 '(orgtbl-hijacker-command-100
9167 orgtbl-hijacker-command-101
9168 orgtbl-hijacker-command-102
9169 orgtbl-hijacker-command-103
9170 orgtbl-hijacker-command-104
9171 orgtbl-hijacker-command-105))
9172 (org-table-blank-field))
9173 t)
9174 (eq N 1)
9176 (let (org-table-may-need-update)
9177 (goto-char (1- (match-end 0)))
9178 (delete-backward-char 1)
9179 (goto-char (match-beginning 0))
9180 (self-insert-command N))
9181 (setq org-table-may-need-update t)
9182 (let (orgtbl-mode)
9183 (call-interactively (key-binding (vector last-input-event))))))
9185 (defun org-force-self-insert (N)
9186 "Needed to enforce self-insert under remapping."
9187 (interactive "p")
9188 (self-insert-command N))
9191 "Regula expression matching exponentials as produced by calc.")
9193 (defvar org-table-clean-did-remove-column-1 nil)
9195 (defun orgtbl-send-table (&optional maybe)
9196 "Send a tranformed version of this table to the receiver position.
9197 With argument MAYBE, fail quietly if no transformation is defined for
9198 this table."
9199 (interactive)
9200 (catch 'exit
9201 (unless (org-at-table-p) (error "Not at a table"))
9202 ;; when non-interactive, we assume align has just happened.
9203 (when (interactive-p) (org-table-align))
9204 (save-excursion
9205 (goto-char (org-table-begin))
9206 (beginning-of-line 0)
9208 (if maybe
9209 (throw 'exit nil)
9210 (error "Don't know how to transform this table."))))
9211 (let* ((name (match-string 1))
9212 beg
9213 (transform (intern (match-string 2)))
9214 (params (if (match-end 3) (read (concat "(" (match-string 3) ")"))))
9215 (skip (plist-get params :skip))
9216 (skipcols (plist-get params :skipcols))
9217 (txt (buffer-substring-no-properties
9218 (org-table-begin) (org-table-end)))
9220 (lines (org-table-clean-before-export lines))
9221 (i0 (if org-table-clean-did-remove-column-1 2 1))
9222 (table (mapcar
9223 (lambda (x)
9224 (if (string-match org-table-hline-regexp x)
9225 'hline
9226 (org-remove-by-index
9228 skipcols i0)))
9229 lines))
9230 (fun (if (= i0 2) 'cdr 'identity))
9231 (org-table-last-alignment
9232 (org-remove-by-index (funcall fun org-table-last-alignment)
9233 skipcols i0))
9234 (org-table-last-column-widths
9235 (org-remove-by-index (funcall fun org-table-last-column-widths)
9236 skipcols i0)))
9238 (unless (fboundp transform)
9239 (error "No such transformation function %s" transform))
9240 (setq txt (funcall transform table params))
9241 ;; Find the insertion place
9242 (save-excursion
9243 (goto-char (point-min))
9244 (unless (re-search-forward
9246 (error "Don't know where to insert translated table"))
9247 (goto-char (match-beginning 0))
9248 (beginning-of-line 2)
9249 (setq beg (point))
9250 (unless (re-search-forward (concat "END RECEIVE ORGTBL +" name) nil t)
9251 (error "Cannot find end of insertion region"))
9252 (beginning-of-line 1)
9253 (delete-region beg (point))
9254 (goto-char beg)
9256 (message "Table converted and installed at receiver location"))))
9258 (defun org-remove-by-index (list indices &optional i0)
9259 "Remove the elements in LIST with indices in INDICES.
9260 First element has index 0, or I0 if given."
9261 (if (not indices)
9262 list
9263 (if (integerp indices) (setq indices (list indices)))
9264 (setq i0 (1- (or i0 0)))
9265 (delq :rm (mapcar (lambda (x)
9266 (setq i0 (1+ i0))
9267 (if (memq i0 indices) :rm x))
9268 list))))
9270 (defun orgtbl-toggle-comment ()
9271 "Comment or uncomment the orgtbl at point."
9272 (interactive)
9273 (let* ((re1 (concat "^" (regexp-quote comment-start) orgtbl-line-start-regexp))
9274 (re2 (concat "^" orgtbl-line-start-regexp))
9275 (commented (save-excursion (beginning-of-line 1)
9276 (cond ((looking-at re1) t)
9277 ((looking-at re2) nil)
9278 (t (error "Not at an org table")))))
9279 (re (if commented re1 re2))
9280 beg end)
9281 (save-excursion
9282 (beginning-of-line 1)
9283 (while (looking-at re) (beginning-of-line 0))
9284 (beginning-of-line 2)
9285 (setq beg (point))
9286 (while (looking-at re) (beginning-of-line 2))
9287 (setq end (point)))
9288 (comment-region beg end (if commented '(4) nil))))
9290 (defun orgtbl-insert-radio-table ()
9291 "Insert a radio table template appropriate for this major mode."
9292 (interactive)
9293 (let* ((e (assq major-mode orgtbl-radio-table-templates))
9294 (txt (nth 1 e))
9295 name pos)
9296 (unless e (error "No radio table setup defined for %s" major-mode))
9297 (setq name (read-string "Table name: "))
9298 (while (string-match "%n" txt)
9299 (setq txt (replace-match name t t txt)))
9301 (setq pos (point))
9302 (insert txt)
9303 (goto-char pos)))
9305 (defun org-get-param (params header i sym &optional hsym)
9306 "Get parameter value for symbol SYM.
9307 If this is a header line, actually get the value for the symbol with an
9309 If the value is a protperty list, get the element for the current column.
9310 Assumes variables VAL, PARAMS, HEAD and I to be scoped into the function."
9311 (let ((val (plist-get params sym)))
9312 (and hsym header (setq val (or (plist-get params hsym) val)))
9313 (if (consp val) (plist-get val i) val)))
9315 (defun orgtbl-to-generic (table params)
9316 "Convert the orgtbl-mode TABLE to some other format.
9317 This generic routine can be used for many standard cases.
9318 TABLE is a list, each entry either the symbol `hline' for a horizontal
9319 separator line, or a list of fields for that line.
9320 PARAMS is a property list of parameters that can influence the conversion.
9321 For the generic converter, some parameters are obligatory: You need to
9322 specify either :lfmt, or all of (:lstart :lend :sep). If you do not use
9323 :splice, you must have :tstart and :tend.
9325 Valid parameters are
9327 :tstart String to start the table. Ignored when :splice is t.
9328 :tend String to end the table. Ignored when :splice is t.
9330 :splice When set to t, return only table body lines, don't wrap
9331 them into :tstart and :tend. Default is nil.
9333 :hline String to be inserted on horizontal separation lines.
9334 May be nil to ignore hlines.
9336 :lstart String to start a new table line.
9337 :lend String to end a table line
9338 :sep Separator between two fields
9339 :lfmt Format for entire line, with enough %s to capture all fields.
9340 If this is present, :lstart, :lend, and :sep are ignored.
9341 :fmt A format to be used to wrap the field, should contain
9342 %s for the original field value. For example, to wrap
9344 This may also be a property list with column numbers and
9347 :hlstart :hlend :hlsep :hlfmt :hfmt
9348 Same as above, specific for the header lines in the table.
9349 All lines before the first hline are treated as header.
9350 If any of these is not present, the data line value is used.
9352 :efmt Use this format to print numbers with exponentials.
9353 The format should have %s twice for inserting mantissa
9355 may also be a property list with column numbers and
9356 formats. :fmt will still be applied after :efmt.
9358 In addition to this, the parameters :skip and :skipcols are always handled
9359 directly by `orgtbl-send-table'. See manual."
9360 (interactive)
9361 (let* ((p params)
9362 (splicep (plist-get p :splice))
9363 (hline (plist-get p :hline))
9364 rtn line i fm efm lfmt h)
9366 ;; Do we have a header?
9367 (if (and (not splicep) (listp (car table)) (memq 'hline table))
9368 (setq h t))
9370 ;; Put header
9371 (unless splicep
9372 (push (or (plist-get p :tstart) "ERROR: no :tstart") rtn))
9374 ;; Now loop over all lines
9375 (while (setq line (pop table))
9376 (if (eq line 'hline)
9377 ;; A horizontal separator line
9378 (progn (if hline (push hline rtn))
9379 (setq h nil)) ; no longer in header
9380 ;; A normal line. Convert the fields, push line onto the result list
9381 (setq i 0)
9382 (setq line
9383 (mapcar
9384 (lambda (f)
9385 (setq i (1+ i)
9386 fm (org-get-param p h i :fmt :hfmt)
9387 efm (org-get-param p h i :efmt))
9388 (if (and efm (string-match orgtbl-exp-regexp f))
9389 (setq f (format
9390 efm (match-string 1 f) (match-string 2 f))))
9391 (if fm (setq f (format fm f)))
9392 f)
9393 line))
9394 (if (setq lfmt (org-get-param p h i :lfmt :hlfmt))
9395 (push (apply 'format lfmt line) rtn)
9396 (push (concat
9397 (org-get-param p h i :lstart :hlstart)
9398 (mapconcat 'identity line (org-get-param p h i :sep :hsep))
9399 (org-get-param p h i :lend :hlend))
9400 rtn))))
9402 (unless splicep
9403 (push (or (plist-get p :tend) "ERROR: no :tend") rtn))
9407 (defun orgtbl-to-latex (table params)
9408 "Convert the orgtbl-mode TABLE to LaTeX.
9409 TABLE is a list, each entry either the symbol `hline' for a horizontal
9410 separator line, or a list of fields for that line.
9411 PARAMS is a property list of parameters that can influence the conversion.
9412 Supports all parameters from `orgtbl-to-generic'. Most important for
9413 LaTeX are:
9415 :splice When set to t, return only table body lines, don't wrap
9416 them into a tabular environment. Default is nil.
9418 :fmt A format to be used to wrap the field, should contain %s for the
9419 original field value. For example, to wrap everything in dollars,
9423 :efmt Format for transforming numbers with exponentials. The format
9424 should have %s twice for inserting mantissa and exponent, for
9426 This may also be a property list with column numbers and formats.
9428 The general parameters :skip and :skipcols have already been applied when
9429 this function is called."
9430 (let* ((alignment (mapconcat (lambda (x) (if x "r" "l"))
9431 org-table-last-alignment ""))
9432 (params2
9433 (list
9438 (orgtbl-to-generic table (org-combine-plists params2 params))))
9440 (defun orgtbl-to-html (table params)
9441 "Convert the orgtbl-mode TABLE to LaTeX.
9442 TABLE is a list, each entry either the symbol `hline' for a horizontal
9443 separator line, or a list of fields for that line.
9444 PARAMS is a property list of parameters that can influence the conversion.
9445 Currently this function recognizes the following parameters:
9447 :splice When set to t, return only table body lines, don't wrap
9448 them into a <table> environment. Default is nil.
9450 The general parameters :skip and :skipcols have already been applied when
9451 this function is called. The function does *not* use `orgtbl-to-generic',
9452 so you cannot specify parameters for it."
9453 (let* ((splicep (plist-get params :splice))
9454 html)
9455 ;; Just call the formatter we already have
9456 ;; We need to make text lines for it, so put the fields back together.
9457 (setq html (org-format-org-table-html
9458 (mapcar
9459 (lambda (x)
9460 (if (eq x 'hline)
9461 "|----+----|"
9462 (concat "| " (mapconcat 'identity x " | ") " |")))
9463 table)
9464 splicep))
9466 (setq html (replace-match "" t t html)))
9467 html))
9469 (defun orgtbl-to-texinfo (table params)
9470 "Convert the orgtbl-mode TABLE to TeXInfo.
9471 TABLE is a list, each entry either the symbol `hline' for a horizontal
9472 separator line, or a list of fields for that line.
9473 PARAMS is a property list of parameters that can influence the conversion.
9474 Supports all parameters from `orgtbl-to-generic'. Most important for
9475 TeXInfo are:
9477 :splice nil/t When set to t, return only table body lines, don't wrap
9478 them into a multitable environment. Default is nil.
9480 :fmt fmt A format to be used to wrap the field, should contain
9481 %s for the original field value. For example, to wrap
9483 This may also be a property list with column numbers and
9487 are computed automatically from the width of the columns
9488 under org-mode.
9490 The general parameters :skip and :skipcols have already been applied when
9491 this function is called."
9492 (let* ((total (float (apply '+ org-table-last-column-widths)))
9493 (colfrac (or (plist-get params :cf)
9494 (mapconcat
9495 (lambda (x) (format "%.3f" (/ (float x) total)))
9496 org-table-last-column-widths " ")))
9497 (params2
9498 (list
9499 :tstart (concat "@multitable @columnfractions " colfrac)
9500 :tend "@end multitable"
9501 :lstart "@item " :lend "" :sep " @tab "
9502 :hlstart "@headitem ")))
9503 (orgtbl-to-generic table (org-combine-plists params2 params))))
9505 ;;;; Link Stuff
9507 ;;; Link abbreviations
9509 (defun org-link-expand-abbrev (link)
9510 "Apply replacements as defined in `org-link-abbrev-alist."
9512 (let* ((key (match-string 1 link))
9513 (as (or (assoc key org-link-abbrev-alist-local)
9514 (assoc key org-link-abbrev-alist)))
9515 (tag (and (match-end 2) (match-string 3 link)))
9516 rpl)
9517 (if (not as)
9518 link
9519 (setq rpl (cdr as))
9520 (cond
9521 ((symbolp rpl) (funcall rpl tag))
9522 ((string-match "%s" rpl) (replace-match (or tag "") t t rpl))
9523 (t (concat rpl tag)))))
9524 link))
9526 ;;; Storing and inserting links
9528 (defvar org-insert-link-history nil
9529 "Minibuffer history for links inserted with `org-insert-link'.")
9531 (defvar org-stored-links nil
9532 "Contains the links stored with `org-store-link'.")
9534 (defvar org-store-link-plist nil
9535 "Plist with info about the most recently link created with `org-store-link'.")
9537 ;;;###autoload
9538 (defun org-store-link (arg)
9540 This link can later be inserted into an org-buffer with
9542 For some link types, a prefix arg is interpreted:
9543 For links to usenet articles, arg negates `org-usenet-links-prefer-google'.
9544 For file links, arg negates `org-context-in-file-links'."
9545 (interactive "P")
9546 (setq org-store-link-plist nil) ; reset
9547 (let (link cpltxt desc description search txt)
9548 (cond
9550 ((eq major-mode 'bbdb-mode)
9551 (let ((name (bbdb-record-name (bbdb-current-record)))
9552 (company (bbdb-record-company (bbdb-current-record))))
9553 (setq cpltxt (concat "bbdb:" (or name company))
9554 link (org-make-link cpltxt))
9555 (org-store-link-props :type "bbdb" :name name :company company)))
9557 ((eq major-mode 'Info-mode)
9558 (setq link (org-make-link "info:"
9559 (file-name-nondirectory Info-current-file)
9560 ":" Info-current-node))
9561 (setq cpltxt (concat (file-name-nondirectory Info-current-file)
9562 ":" Info-current-node))
9563 (org-store-link-props :type "info" :file Info-current-file
9564 :node Info-current-node))
9566 ((eq major-mode 'calendar-mode)
9567 (let ((cd (calendar-cursor-to-date)))
9568 (setq link
9569 (format-time-string
9570 (car org-time-stamp-formats)
9571 (apply 'encode-time
9572 (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
9573 nil nil nil))))
9574 (org-store-link-props :type "calendar" :date cd)))
9576 ((or (eq major-mode 'vm-summary-mode)
9577 (eq major-mode 'vm-presentation-mode))
9578 (and (eq major-mode 'vm-presentation-mode) (vm-summarize))
9579 (vm-follow-summary-cursor)
9580 (save-excursion
9581 (vm-select-folder-buffer)
9582 (let* ((message (car vm-message-pointer))
9583 (folder buffer-file-name)
9584 (subject (vm-su-subject message))
9585 (to (vm-get-header-contents message "To"))
9586 (from (vm-get-header-contents message "From"))
9587 (message-id (vm-su-message-id message)))
9588 (org-store-link-props :type "vm" :from from :to to :subject subject
9589 :message-id message-id)
9590 (setq message-id (org-remove-angle-brackets message-id))
9591 (setq folder (abbreviate-file-name folder))
9592 (if (string-match (concat "^" (regexp-quote vm-folder-directory))
9593 folder)
9594 (setq folder (replace-match "" t t folder)))
9595 (setq cpltxt (org-email-link-description))
9596 (setq link (org-make-link "vm:" folder "#" message-id)))))
9598 ((eq major-mode 'wl-summary-mode)
9599 (let* ((msgnum (wl-summary-message-number))
9600 (message-id (elmo-message-field wl-summary-buffer-elmo-folder
9601 msgnum 'message-id))
9602 (wl-message-entity
9603 (if (fboundp 'elmo-message-entity)
9604 (elmo-message-entity
9605 wl-summary-buffer-elmo-folder msgnum)
9606 (elmo-msgdb-overview-get-entity
9607 msgnum (wl-summary-buffer-msgdb))))
9608 (from (wl-summary-line-from))
9609 (to (car (elmo-message-entity-field wl-message-entity 'to)))
9610 (subject (let (wl-thr-indent-string wl-parent-message-entity)
9611 (wl-summary-line-subject))))
9612 (org-store-link-props :type "wl" :from from :to to
9613 :subject subject :message-id message-id)
9614 (setq message-id (org-remove-angle-brackets message-id))
9615 (setq cpltxt (org-email-link-description))
9616 (setq link (org-make-link "wl:" wl-summary-buffer-folder-name
9617 "#" message-id))))
9619 ((or (equal major-mode 'mh-folder-mode)
9620 (equal major-mode 'mh-show-mode))
9621 (let ((from (org-mhe-get-header "From:"))
9622 (to (org-mhe-get-header "To:"))
9623 (message-id (org-mhe-get-header "Message-Id:"))
9624 (subject (org-mhe-get-header "Subject:")))
9625 (org-store-link-props :type "mh" :from from :to to
9626 :subject subject :message-id message-id)
9627 (setq cpltxt (org-email-link-description))
9628 (setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#"
9629 (org-remove-angle-brackets message-id)))))
9631 ((eq major-mode 'rmail-mode)
9632 (save-excursion
9633 (save-restriction
9634 (rmail-narrow-to-non-pruned-header)
9635 (let ((folder buffer-file-name)
9636 (message-id (mail-fetch-field "message-id"))
9637 (from (mail-fetch-field "from"))
9638 (to (mail-fetch-field "to"))
9639 (subject (mail-fetch-field "subject")))
9640 (org-store-link-props
9641 :type "rmail" :from from :to to
9642 :subject subject :message-id message-id)
9643 (setq message-id (org-remove-angle-brackets message-id))
9644 (setq cpltxt (org-email-link-description))
9645 (setq link (org-make-link "rmail:" folder "#" message-id))))))
9647 ((eq major-mode 'gnus-group-mode)
9648 (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus
9649 (gnus-group-group-name)) ; version
9650 ((fboundp 'gnus-group-name)
9651 (gnus-group-name))
9652 (t "???"))))
9653 (unless group (error "Not on a group"))
9654 (org-store-link-props :type "gnus" :group group)
9655 (setq cpltxt (concat
9656 (if (org-xor arg org-usenet-links-prefer-google)
9657 "http://groups.google.com/groups?group="
9658 "gnus:")
9659 group)
9660 link (org-make-link cpltxt))))
9662 ((memq major-mode '(gnus-summary-mode gnus-article-mode))
9663 (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary))
9664 (let* ((group gnus-newsgroup-name)
9665 (article (gnus-summary-article-number))
9666 (header (gnus-summary-article-header article))
9667 (from (mail-header-from header))
9668 (message-id (mail-header-id header))
9669 (date (mail-header-date header))
9670 (subject (gnus-summary-subject-string)))
9671 (org-store-link-props :type "gnus" :from from :subject subject
9672 :message-id message-id :group group)
9673 (setq cpltxt (org-email-link-description))
9674 (if (org-xor arg org-usenet-links-prefer-google)
9675 (setq link
9676 (concat
9678 (format "http://groups.google.com/groups?as_umsgid=%s"
9679 (org-fixup-message-id-for-http message-id))))
9680 (setq link (org-make-link "gnus:" group
9681 "#" (number-to-string article))))))
9683 ((eq major-mode 'w3-mode)
9684 (setq cpltxt (url-view-url t)
9685 link (org-make-link cpltxt))
9686 (org-store-link-props :type "w3" :url (url-view-url t)))
9688 ((eq major-mode 'w3m-mode)
9689 (setq cpltxt (or w3m-current-title w3m-current-url)
9690 link (org-make-link w3m-current-url))
9691 (org-store-link-props :type "w3m" :url (url-view-url t)))
9693 ((setq search (run-hook-with-args-until-success
9694 'org-create-file-search-functions))
9695 (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
9696 "::" search))
9697 (setq cpltxt (or description link)))
9699 ((eq major-mode 'image-mode)
9700 (setq cpltxt (concat "file:"
9701 (abbreviate-file-name buffer-file-name))
9702 link (org-make-link cpltxt))
9703 (org-store-link-props :type "image" :file buffer-file-name))
9705 ((eq major-mode 'dired-mode)
9706 ;; link to the file in the current line
9707 (setq cpltxt (concat "file:"
9708 (abbreviate-file-name
9709 (expand-file-name
9710 (dired-get-filename nil t))))
9711 link (org-make-link cpltxt)))
9713 ((and buffer-file-name (org-mode-p))
9714 ;; Just link to current headline
9715 (setq cpltxt (concat "file:"
9716 (abbreviate-file-name buffer-file-name)))
9717 ;; Add a context search string
9718 (when (org-xor org-context-in-file-links arg)
9719 ;; Check if we are on a target
9721 (setq cpltxt (concat cpltxt "::" (match-string 1)))
9722 (setq txt (cond
9723 ((org-on-heading-p) nil)
9724 ((org-region-active-p)
9725 (buffer-substring (region-beginning) (region-end)))
9726 (t (buffer-substring (point-at-bol) (point-at-eol)))))
9728 (setq cpltxt
9729 (concat cpltxt "::" (org-make-org-heading-search-string txt))
9730 desc "NONE"))))
9732 (setq cpltxt (substring cpltxt 0 -2)))
9733 (setq link (org-make-link cpltxt)))
9735 (buffer-file-name
9736 ;; Just link to this file here.
9737 (setq cpltxt (concat "file:"
9738 (abbreviate-file-name buffer-file-name)))
9739 ;; Add a context string
9740 (when (org-xor org-context-in-file-links arg)
9741 (setq txt (if (org-region-active-p)
9742 (buffer-substring (region-beginning) (region-end))
9743 (buffer-substring (point-at-bol) (point-at-eol))))
9744 ;; Only use search option if there is some text.
9746 (setq cpltxt
9747 (concat cpltxt "::" (org-make-org-heading-search-string txt))
9748 desc "NONE")))
9749 (setq link (org-make-link cpltxt)))
9751 ((interactive-p)
9752 (error "Cannot link to a buffer which is not visiting a file"))
9754 (t (setq link nil)))
9756 (if (consp link) (setq cpltxt (car link) link (cdr link)))
9757 (setq link (or link cpltxt)
9758 desc (or desc cpltxt))
9759 (if (equal desc "NONE") (setq desc nil))
9761 (if (and (interactive-p) link)
9762 (progn
9763 (setq org-stored-links
9764 (cons (list cpltxt link desc) org-stored-links))
9765 (message "Stored: %s" (or cpltxt link)))
9766 (org-make-link-string link desc))))
9768 (defun org-store-link-props (&rest plist)
9769 "Store link properties, extract names and addresses."
9770 (let (x adr)
9771 (when (setq x (plist-get plist :from))
9772 (setq adr (mail-extract-address-components x))
9773 (plist-put plist :fromname (car adr))
9774 (plist-put plist :fromaddress (nth 1 adr)))
9775 (when (setq x (plist-get plist :to))
9776 (setq adr (mail-extract-address-components x))
9777 (plist-put plist :toname (car adr))
9778 (plist-put plist :toaddress (nth 1 adr))))
9779 (let ((from (plist-get plist :from))
9780 (to (plist-get plist :to)))
9781 (when (and from to org-from-is-user-regexp)
9782 (plist-put plist :fromto
9783 (if (string-match org-from-is-user-regexp from)
9784 (concat "to %t")
9785 (concat "from %f")))))
9786 (setq org-store-link-plist plist))
9788 (defun org-email-link-description (&optional fmt)
9789 "Return the description part of an email link.
9790 This takes information from `org-store-link-plist' and formats it
9791 according to FMT (default from `org-email-link-description-format')."
9792 (setq fmt (or fmt org-email-link-description-format))
9793 (let* ((p org-store-link-plist)
9794 (to (plist-get p :toaddress))
9795 (from (plist-get p :fromaddress))
9796 (table
9797 (list
9798 (cons "%c" (plist-get p :fromto))
9799 (cons "%F" (plist-get p :from))
9800 (cons "%f" (or (plist-get p :fromname) (plist-get p :fromaddress) "?"))
9801 (cons "%T" (plist-get p :to))
9802 (cons "%t" (or (plist-get p :toname) (plist-get p :toaddress) "?"))
9803 (cons "%s" (plist-get p :subject))
9804 (cons "%m" (plist-get p :message-id)))))
9805 (when (string-match "%c" fmt)
9806 ;; Check if the user wrote this message
9807 (if (and org-from-is-user-regexp from to
9808 (save-match-data (string-match org-from-is-user-regexp from)))
9809 (setq fmt (replace-match "to %t" t t fmt))
9810 (setq fmt (replace-match "from %f" t t fmt))))
9811 (org-replace-escapes fmt table)))
9813 (defun org-make-org-heading-search-string (&optional string heading)
9814 "Make search string for STRING or current headline."
9815 (interactive)
9816 (let ((s (or string (org-get-heading))))
9817 (unless (and string (not heading))
9818 ;; We are using a headline, clean up garbage in there.
9819 (if (string-match org-todo-regexp s)
9820 (setq s (replace-match "" t t s)))
9822 (setq s (replace-match "" t t s)))
9823 (setq s (org-trim s))
9826 (setq s (replace-match "" t t s)))
9827 (while (string-match org-ts-regexp s)
9828 (setq s (replace-match "" t t s))))
9830 (setq s (replace-match " " t t s)))
9831 (or string (setq s (concat "*" s))) ; Add * for headlines
9834 (defun org-make-link (&rest strings)
9835 "Concatenate STRINGS, format resulting string with `org-link-format'."
9836 (apply 'concat strings))
9838 (defun org-make-link-string (link &optional description)
9839 "Make a link with brackets, consisting of LINK and DESCRIPTION."
9840 (when (stringp description)
9841 ;; Remove brackets from the description, they are fatal.
9843 (setq description (replace-match "" t t description))))
9844 (when (equal (org-link-escape link) description)
9845 ;; No description needed, it is identical
9846 (setq description nil))
9847 (when (and (not description)
9848 (not (equal link (org-link-escape link))))
9849 (setq description link))
9850 (concat "[[" (org-link-escape link) "]"
9851 (if description (concat "[" description "]") "")
9852 "]"))
9854 (defconst org-link-escape-chars '(("[" . "%5B") ("]" . "%5D") (" " . "%20"))
9855 "Association list of escapes for some characters problematic in links.")
9857 (defun org-link-escape (text)
9858 "Escape charaters in TEXT that are problematic for links."
9859 (when text
9860 (let ((re (mapconcat (lambda (x) (regexp-quote (car x)))
9862 (while (string-match re text)
9863 (setq text
9864 (replace-match
9865 (cdr (assoc (match-string 0 text) org-link-escape-chars))
9866 t t text)))
9867 text)))
9869 (defun org-link-unescape (text)
9870 "Reverse the action of `org-link-escape'."
9871 (when text
9872 (let ((re (mapconcat (lambda (x) (regexp-quote (cdr x)))
9874 (while (string-match re text)
9875 (setq text
9876 (replace-match
9877 (car (rassoc (match-string 0 text) org-link-escape-chars))
9878 t t text)))
9879 text)))
9881 (defun org-xor (a b)
9882 "Exclusive or."
9883 (if a (not b) b))
9885 (defun org-get-header (header)
9886 "Find a header field in the current buffer."
9887 (save-excursion
9888 (goto-char (point-min))
9889 (let ((case-fold-search t) s)
9890 (cond
9891 ((eq header 'from)
9893 (setq s (match-string 1)))
9895 (setq s (replace-match "" t t s)))
9896 (if (string-match "[<(].*" s)
9897 (setq s (replace-match "" t t s))))
9898 ((eq header 'message-id)
9900 (setq s (match-string 1))))
9901 ((eq header 'subject)
9903 (setq s (match-string 1)))))
9906 s)))
9909 (defun org-fixup-message-id-for-http (s)
9910 "Replace special characters in a message id, so it can be used in an http query."
9911 (while (string-match "<" s)
9912 (setq s (replace-match "%3C" t t s)))
9913 (while (string-match ">" s)
9914 (setq s (replace-match "%3E" t t s)))
9915 (while (string-match "@" s)
9916 (setq s (replace-match "%40" t t s)))
9917 s)
9919 (defun org-insert-link (&optional complete-file)
9920 "Insert a link. At the prompt, enter the link.
9922 Completion can be used to select a link previously stored with
9923 `org-store-link'. When the empty string is entered (i.e. if you just
9924 press RET at the prompt), the link defaults to the most recently
9925 stored link. As SPC triggers completion in the minibuffer, you need to
9926 use M-SPC or C-q SPC to force the insertion of a space character.
9928 You will also be prompted for a description, and if one is given, it will
9929 be displayed in the buffer instead of the link.
9931 If there is already a link at point, this command will allow you to edit link
9932 and description parts.
9935 selected using completion. The path to the file will be relative to
9936 the current directory if the file is in the current directory or a
9937 subdirectory. Otherwise, the link will be the absolute path as
9938 completed in the minibuffer (i.e. normally ~/path/to/file).
9941 is in the current directory or below.
9943 `org-keep-stored-link-after-insertion'."
9944 (interactive "P")
9945 (let ((region (if (org-region-active-p)
9946 (prog1 (buffer-substring (region-beginning) (region-end))
9947 (delete-region (region-beginning) (region-end)))))
9948 tmphist ; byte-compile incorrectly complains about this
9949 link desc entry remove file)
9950 (cond
9951 ((org-in-regexp org-bracket-link-regexp 1)
9952 ;; We do have a link at point, and we are going to edit it.
9953 (setq remove (list (match-beginning 0) (match-end 0)))
9954 (setq desc (if (match-end 3) (org-match-string-no-properties 3)))
9955 (setq link (read-string "Link: "
9956 (org-link-unescape
9957 (org-match-string-no-properties 1)))))
9958 ((or (org-in-regexp org-angle-link-re)
9959 (org-in-regexp org-plain-link-re))
9960 ;; Convert to bracket link
9961 (setq remove (list (match-beginning 0) (match-end 0))
9962 link (read-string "Link: "
9963 (org-remove-angle-brackets (match-string 0)))))
9964 ((equal complete-file '(4))
9965 ;; Completing read for file names.
9966 (setq file (read-file-name "File: "))
9967 (let ((pwd (file-name-as-directory (expand-file-name ".")))
9968 (pwd1 (file-name-as-directory (abbreviate-file-name
9969 (expand-file-name ".")))))
9970 (cond
9971 ((equal complete-file '(16))
9972 (setq link (org-make-link
9973 "file:"
9974 (abbreviate-file-name (expand-file-name file)))))
9976 (setq link (org-make-link "file:" (match-string 1 file))))
9978 (expand-file-name file))
9979 (setq link (org-make-link
9980 "file:" (match-string 1 (expand-file-name file)))))
9981 (t (setq link (org-make-link "file:" file))))))
9982 (t
9983 ;; Read link, with completion for stored links.
9984 ;; Fake a link history
9985 (setq tmphist (append (mapcar 'car org-stored-links)
9986 org-insert-link-history))
9987 (setq link (org-completing-read
9988 "Link: " org-stored-links nil nil nil
9989 'tmphist
9990 (or (car (car org-stored-links)))))
9991 (setq entry (assoc link org-stored-links))
9992 (or entry (push link org-insert-link-history))
9993 (if (funcall (if (equal complete-file '(64)) 'not 'identity)
9994 (not org-keep-stored-link-after-insertion))
9995 (setq org-stored-links (delq (assoc link org-stored-links)
9996 org-stored-links)))
9997 (setq link (if entry (nth 1 entry) link)
9998 desc (or region desc (nth 2 entry)))))
10000 (if (string-match org-plain-link-re link)
10001 ;; URL-like link, normalize the use of angular brackets.
10002 (setq link (org-make-link (org-remove-angle-brackets link))))
10004 ;; Check if we are linking to the current file with a search option
10005 ;; If yes, simplify the link by using only the search option.
10006 (when (and buffer-file-name
10008 (let* ((path (match-string 1 link))
10009 (case-fold-search nil)
10010 (search (match-string 2 link)))
10011 (save-match-data
10012 (if (equal (file-truename buffer-file-name) (file-truename path))
10013 ;; We are linking to this same file, with a search option
10014 (setq link search)))))
10016 ;; Check if we can/should use a relative path. If yes, simplify the link
10018 (let* ((path (match-string 1 link))
10019 (case-fold-search nil))
10020 (cond
10021 ((eq org-link-file-path-type 'absolute)
10022 (setq path (abbreviate-file-name (expand-file-name path))))
10023 ((eq org-link-file-path-type 'noabbrev)
10024 (setq path (expand-file-name path)))
10025 ((eq org-link-file-path-type 'relative)
10026 (setq path (file-relative-name path)))
10027 (t
10028 (save-match-data
10029 (if (string-match (concat "^" (regexp-quote
10030 (file-name-as-directory
10031 (expand-file-name "."))))
10032 (expand-file-name path))
10033 ;; We are linking a file with relative path name.
10034 (setq path (substring (expand-file-name path)
10035 (match-end 0)))))))
10036 (setq link (concat "file:" path))))
10038 (setq desc (read-string "Description: " desc))
10040 (if remove (apply 'delete-region remove))
10041 (insert (org-make-link-string link desc))))
10043 (defun org-completing-read (&rest args)
10044 (let ((minibuffer-local-completion-map
10045 (copy-keymap minibuffer-local-completion-map)))
10046 (org-defkey minibuffer-local-completion-map " " 'self-insert-command)
10047 (apply 'completing-read args)))
10049 ;;; Opening/following a link
10050 (defvar org-link-search-failed nil)
10052 (defun org-next-link ()
10053 "Move forward to the next link.
10054 If the link is in hidden text, expose it."
10055 (interactive)
10056 (when (and org-link-search-failed (eq this-command last-command))
10057 (goto-char (point-min))
10058 (message "Link search wrapped back to beginning of buffer"))
10059 (setq org-link-search-failed nil)
10060 (let* ((pos (point))
10061 (ct (org-context))
10062 (a (assoc :link ct)))
10063 (if a (goto-char (nth 2 a)))
10064 (if (re-search-forward org-any-link-re nil t)
10065 (progn
10066 (goto-char (match-beginning 0))
10067 (if (org-invisible-p) (org-show-context)))
10068 (goto-char pos)
10069 (setq org-link-search-failed t)
10070 (error "No further link found"))))
10072 (defun org-previous-link ()
10073 "Move backward to the previous link.
10074 If the link is in hidden text, expose it."
10075 (interactive)
10076 (when (and org-link-search-failed (eq this-command last-command))
10077 (goto-char (point-max))
10078 (message "Link search wrapped back to end of buffer"))
10079 (setq org-link-search-failed nil)
10080 (let* ((pos (point))
10081 (ct (org-context))
10082 (a (assoc :link ct)))
10083 (if a (goto-char (nth 1 a)))
10084 (if (re-search-backward org-any-link-re nil t)
10085 (progn
10086 (goto-char (match-beginning 0))
10087 (if (org-invisible-p) (org-show-context)))
10088 (goto-char pos)
10089 (setq org-link-search-failed t)
10090 (error "No further link found"))))
10092 (defun org-find-file-at-mouse (ev)
10093 "Open file link or URL at mouse."
10094 (interactive "e")
10095 (mouse-set-point ev)
10096 (org-open-at-point 'in-emacs))
10098 (defun org-open-at-mouse (ev)
10099 "Open file link or URL at mouse."
10100 (interactive "e")
10101 (mouse-set-point ev)
10102 (org-open-at-point))
10104 (defvar org-window-config-before-follow-link nil
10105 "The window configuration before following a link.
10106 This is saved in case the need arises to restore it.")
10108 (defvar org-open-link-marker (make-marker)
10109 "Marker pointing to the location where `org-open-at-point; was called.")
10111 (defun org-open-at-point (&optional in-emacs)
10112 "Open link at or after point.
10113 If there is no link at point, this function will search forward up to
10114 the end of the current subtree.
10115 Normally, files will be opened by an appropriate application. If the
10116 optional argument IN-EMACS is non-nil, Emacs will visit the file."
10117 (interactive "P")
10118 (move-marker org-open-link-marker (point))
10119 (setq org-window-config-before-follow-link (current-window-configuration))
10120 (org-remove-occur-highlights nil nil t)
10121 (if (org-at-timestamp-p t)
10122 (org-follow-timestamp-link)
10123 (let (type path link line search (pos (point)))
10124 (catch 'match
10125 (save-excursion
10127 (when (org-in-regexp org-bracket-link-regexp)
10128 (setq link (org-link-unescape (org-match-string-no-properties 1)))
10130 (setq link (replace-match " " t t link)))
10131 (setq link (org-link-expand-abbrev link))
10132 (if (string-match org-link-re-with-space2 link)
10133 (setq type (match-string 1 link) path (match-string 2 link))
10134 (setq type "thisfile" path link))
10135 (throw 'match t)))
10137 (when (get-text-property (point) 'org-linked-text)
10138 (setq type "thisfile"
10139 pos (if (get-text-property (1+ (point)) 'org-linked-text)
10140 (1+ (point)) (point))
10141 path (buffer-substring
10142 (previous-single-property-change pos 'org-linked-text)
10143 (next-single-property-change pos 'org-linked-text)))
10144 (throw 'match t))
10146 (save-excursion
10147 (when (or (org-in-regexp org-angle-link-re)
10148 (org-in-regexp org-plain-link-re))
10149 (setq type (match-string 1) path (match-string 2))
10150 (throw 'match t)))
10151 (save-excursion
10153 (setq type "tags"
10154 path (match-string 1))
10155 (while (string-match ":" path)
10156 (setq path (replace-match "+" t t path)))
10157 (throw 'match t))))
10158 (unless path
10159 (error "No link found"))
10160 ;; Remove any trailing spaces in path
10162 (setq path (replace-match "" t t path)))
10164 (cond
10166 ((equal type "mailto")
10167 (let ((cmd (car org-link-mailto-program))
10168 (args (cdr org-link-mailto-program)) args1
10169 (address path) (subject "") a)
10171 (setq address (match-string 1 path)
10172 subject (org-link-escape (match-string 2 path))))
10173 (while args
10174 (cond
10175 ((not (stringp (car args))) (push (pop args) args1))
10176 (t (setq a (pop args))
10177 (if (string-match "%a" a)
10178 (setq a (replace-match address t t a)))
10179 (if (string-match "%s" a)
10180 (setq a (replace-match subject t t a)))
10181 (push a args1))))
10182 (apply cmd (nreverse args1))))
10184 ((member type '("http" "https" "ftp" "news"))
10185 (browse-url (concat type ":" path)))
10187 ((string= type "tags")
10188 (org-tags-view in-emacs path))
10189 ((string= type "thisfile")
10190 (if in-emacs
10191 (switch-to-buffer-other-window
10192 (org-get-buffer-for-internal-link (current-buffer)))
10193 (org-mark-ring-push))
10194 (org-link-search
10195 path
10196 (cond ((equal in-emacs '(4)) 'occur)
10197 ((equal in-emacs '(16)) 'org-occur)
10198 (t nil))
10199 pos))
10201 ((string= type "file")
10203 (setq line (string-to-number (match-string 1 path))
10204 path (substring path 0 (match-beginning 0)))
10206 (setq search (match-string 1 path)
10207 path (substring path 0 (match-beginning 0)))))
10208 (org-open-file path in-emacs line search))
10210 ((string= type "news")
10211 (org-follow-gnus-link path))
10213 ((string= type "bbdb")
10214 (org-follow-bbdb-link path))
10216 ((string= type "info")
10217 (org-follow-info-link path))
10219 ((string= type "gnus")
10220 (let (group article)
10222 (error "Error in Gnus link"))
10223 (setq group (match-string 1 path)
10224 article (match-string 3 path))
10225 (org-follow-gnus-link group article)))
10227 ((string= type "vm")
10228 (let (folder article)
10230 (error "Error in VM link"))
10231 (setq folder (match-string 1 path)
10232 article (match-string 3 path))
10233 ;; in-emacs is the prefix arg, will be interpreted as read-only
10234 (org-follow-vm-link folder article in-emacs)))
10236 ((string= type "wl")
10237 (let (folder article)
10239 (error "Error in Wanderlust link"))
10240 (setq folder (match-string 1 path)
10241 article (match-string 3 path))
10242 (org-follow-wl-link folder article)))
10244 ((string= type "mhe")
10245 (let (folder article)
10247 (error "Error in MHE link"))
10248 (setq folder (match-string 1 path)
10249 article (match-string 3 path))
10250 (org-follow-mhe-link folder article)))
10252 ((string= type "rmail")
10253 (let (folder article)
10255 (error "Error in RMAIL link"))
10256 (setq folder (match-string 1 path)
10257 article (match-string 3 path))
10258 (org-follow-rmail-link folder article)))
10260 ((string= type "shell")
10261 (let ((cmd path))
10262 ;; FIXME: the following is only for backward compatibility
10263 (while (string-match "@{" cmd) (setq cmd (replace-match "<" t t cmd)))
10264 (while (string-match "@}" cmd) (setq cmd (replace-match ">" t t cmd)))
10265 (if (or (not org-confirm-shell-link-function)
10266 (funcall org-confirm-shell-link-function
10268 (org-add-props cmd nil
10269 'face 'org-warning))))
10270 (progn
10271 (message "Executing %s" cmd)
10272 (shell-command cmd))
10273 (error "Abort"))))
10275 ((string= type "elisp")
10276 (let ((cmd path))
10277 (if (or (not org-confirm-elisp-link-function)
10278 (funcall org-confirm-elisp-link-function
10280 (org-add-props cmd nil
10281 'face 'org-warning))))
10282 (message "%s => %s" cmd (eval (read cmd)))
10283 (error "Abort"))))
10285 (t
10286 (browse-url-at-point)))))
10287 (move-marker org-open-link-marker nil))
10290 ;;; File search
10292 (defvar org-create-file-search-functions nil
10293 "List of functions to construct the right search string for a file link.
10294 These functions are called in turn with point at the location to
10295 which the link should point.
10297 A function in the hook should first test if it would like to
10298 handle this file type, for example by checking the major-mode or
10299 the file extension. If it decides not to handle this file, it
10300 should just return nil to give other functions a chance. If it
10301 does handle the file, it must return the search string to be used
10302 when following the link. The search string will be part of the
10303 file link, given after a double colon, and `org-open-at-point'
10304 will automatically search for it. If special measures must be
10305 taken to make the search successful, another function should be
10306 added to the companion hook `org-execute-file-search-functions',
10307 which see.
10309 A function in this hook may also use `setq' to set the variable
10310 `description' to provide a suggestion for the descriptive text to
10311 be used for this link when it gets inserted into an Org-mode
10314 (defvar org-execute-file-search-functions nil
10315 "List of functions to execute a file search triggered by a link.
10317 Functions added to this hook must accept a single argument, the
10318 search string that was part of the file link, the part after the
10319 double colon. The function must first check if it would like to
10320 handle this search, for example by checking the major-mode or the
10321 file extension. If it decides not to handle this search, it
10322 should just return nil to give other functions a chance. If it
10323 does handle the search, it must return a non-nil value to keep
10324 other functions from trying.
10326 Each function can access the current prefix argument through the
10327 variable `current-prefix-argument'. Note that a single prefix is
10328 used to force opening a link in Emacs, so it may be good to only
10329 use a numeric or double prefix to guide the search function.
10331 In case this is needed, a function in this hook can also restore
10332 the window configuration before `org-open-at-point' was called using:
10334 (set-window-configuration org-window-config-before-follow-link)")
10336 (defun org-link-search (s &optional type avoid-pos)
10337 "Search for a link search option.
10338 If S is surrounded by forward slashes, it is interpreted as a
10339 regular expression. In org-mode files, this will create an `org-occur'
10340 sparse tree. In ordinary files, `occur' will be used to list matches.
10341 If the current buffer is in `dired-mode', grep will be used to search
10342 in all files. If AVOID-POS is given, ignore matches near that position."
10343 (let ((case-fold-search t)
10345 (pos (point))
10346 (pre "") (post "")
10347 words re0 re1 re2 re3 re4 re5 re2a reall)
10348 (cond
10349 ;; First check if there are any special
10350 ((run-hook-with-args-until-success 'org-execute-file-search-functions s))
10351 ;; Now try the builtin stuff
10352 ((save-excursion
10353 (goto-char (point-min))
10354 (and
10355 (re-search-forward
10356 (concat "<<" (regexp-quote s0) ">>") nil t)
10357 (setq pos (match-beginning 0))))
10358 ;; There is an exact target for this
10359 (goto-char pos))
10361 ;; A regular expression
10362 (cond
10363 ((org-mode-p)
10364 (org-occur (match-string 1 s)))
10365 ;;((eq major-mode 'dired-mode)
10366 ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *")))
10367 (t (org-do-occur (match-string 1 s)))))
10368 (t
10369 ;; A normal search string
10370 (when (equal (string-to-char s) ?*)
10371 ;; Anchor on headlines, post may include tags.
10374 s (substring s 1)))
10375 (remove-text-properties
10376 0 (length s)
10377 '(face nil mouse-face nil keymap nil fontified nil) s)
10378 ;; Make a series of regular expressions to find a match
10384 re1 (concat pre re2 post)
10385 re3 (concat pre re4 post)
10386 re5 (concat pre ".*" re4)
10387 re2 (concat pre re2)
10388 re2a (concat pre re2a)
10389 re4 (concat pre re4)
10393 ))
10394 (cond
10395 ((eq type 'org-occur) (org-occur reall))
10396 ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup))
10397 (t (goto-char (point-min))
10398 (if (or (org-search-not-self 1 re0 nil t)
10399 (org-search-not-self 1 re1 nil t)
10400 (org-search-not-self 1 re2 nil t)
10401 (org-search-not-self 1 re2a nil t)
10402 (org-search-not-self 1 re3 nil t)
10403 (org-search-not-self 1 re4 nil t)
10404 (org-search-not-self 1 re5 nil t)
10405 )
10406 (goto-char (match-beginning 1))
10407 (goto-char pos)
10408 (error "No match")))))
10409 (t
10410 ;; Normal string-search
10411 (goto-char (point-min))
10412 (if (search-forward s nil t)
10413 (goto-char (match-beginning 0))
10414 (error "No match"))))
10415 (and (org-mode-p) (org-show-context 'link-search))))
10417 (defun org-search-not-self (group &rest args)
10418 "Execute `re-search-forward', but only accept matches that do not
10419 enclose the position of `org-open-link-marker'."
10420 (let ((m org-open-link-marker))
10421 (catch 'exit
10422 (while (apply 're-search-forward args)
10423 (unless (get-text-property (match-end group) 'intangible) ; Emacs 21
10424 (goto-char (match-end group))
10425 (if (and (or (not (eq (marker-buffer m) (current-buffer)))
10426 (> (match-beginning 0) (marker-position m))
10427 (< (match-end 0) (marker-position m)))
10428 (save-match-data
10429 (or (not (org-in-regexp
10430 org-bracket-link-analytic-regexp 1))
10431 (not (match-end 4)) ; no description
10432 (and (<= (match-beginning 4) (point))
10433 (>= (match-end 4) (point))))))
10434 (throw 'exit (point))))))))
10436 (defun org-get-buffer-for-internal-link (buffer)
10437 "Return a buffer to be used for displaying the link target of internal links."
10438 (cond
10439 ((not org-display-internal-link-with-indirect-buffer)
10440 buffer)
10441 ((string-match "(Clone)$" (buffer-name buffer))
10442 (message "Buffer is already a clone, not making another one")
10443 ;; we also do not modify visibility in this case
10444 buffer)
10445 (t ; make a new indirect buffer for displaying the link
10446 (let* ((bn (buffer-name buffer))
10447 (ibn (concat bn "(Clone)"))
10448 (ib (or (get-buffer ibn) (make-indirect-buffer buffer ibn 'clone))))
10449 (with-current-buffer ib (org-overview))
10450 ib))))
10452 (defun org-do-occur (regexp &optional cleanup)
10453 "Call the Emacs command `occur'.
10454 If CLEANUP is non-nil, remove the printout of the regular expression
10455 in the *Occur* buffer. This is useful if the regex is long and not useful
10456 to read."
10457 (occur regexp)
10458 (when cleanup
10459 (let ((cwin (selected-window)) win beg end)
10460 (when (setq win (get-buffer-window "*Occur*"))
10461 (select-window win))
10462 (goto-char (point-min))
10463 (when (re-search-forward "match[a-z]+" nil t)
10464 (setq beg (match-end 0))
10466 (setq end (1- (match-beginning 0)))))
10467 (and beg end (let ((buffer-read-only)) (delete-region beg end)))
10468 (goto-char (point-min))
10469 (select-window cwin))))
10471 ;;; The mark ring for links jumps
10473 (defvar org-mark-ring nil
10474 "Mark ring for positions before jumps in Org-mode.")
10475 (defvar org-mark-ring-last-goto nil
10476 "Last position in the mark ring used to go back.")
10477 ;; Fill and close the ring
10478 (setq org-mark-ring nil org-mark-ring-last-goto nil) ;; in case file is reloaded
10479 (loop for i from 1 to org-mark-ring-length do
10480 (push (make-marker) org-mark-ring))
10481 (setcdr (nthcdr (1- org-mark-ring-length) org-mark-ring)
10482 org-mark-ring)
10484 (defun org-mark-ring-push (&optional pos buffer)
10485 "Put the current position or POS into the mark ring and rotate it."
10486 (interactive)
10487 (setq pos (or pos (point)))
10488 (setq org-mark-ring (nthcdr (1- org-mark-ring-length) org-mark-ring))
10489 (move-marker (car org-mark-ring)
10490 (or pos (point))
10491 (or buffer (current-buffer)))
10492 (message
10493 (substitute-command-keys
10496 (defun org-mark-ring-goto (&optional n)
10497 "Jump to the previous position in the mark ring.
10498 With prefix arg N, jump back that many stored positions. When
10499 called several times in succession, walk through the entire ring.
10500 Org-mode commands jumping to a different position in the current file,
10501 or to another Org-mode file, automatically push the old position
10502 onto the ring."
10503 (interactive "p")
10504 (let (p m)
10505 (if (eq last-command this-command)
10506 (setq p (nthcdr n (or org-mark-ring-last-goto org-mark-ring)))
10507 (setq p org-mark-ring))
10508 (setq org-mark-ring-last-goto p)
10509 (setq m (car p))
10510 (switch-to-buffer (marker-buffer m))
10511 (goto-char m)
10512 (if (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto))))
10514 (defun org-remove-angle-brackets (s)
10515 (if (equal (substring s 0 1) "<") (setq s (substring s 1)))
10516 (if (equal (substring s -1) ">") (setq s (substring s 0 -1)))
10517 s)
10518 (defun org-add-angle-brackets (s)
10519 (if (equal (substring s 0 1) "<") nil (setq s (concat "<" s)))
10520 (if (equal (substring s -1) ">") nil (setq s (concat s ">")))
10521 s)
10523 ;;; Following specific links
10525 (defun org-follow-timestamp-link ()
10526 (cond
10527 ((org-at-date-range-p t)
10528 (let ((org-agenda-start-on-weekday)
10529 (t1 (match-string 1))
10530 (t2 (match-string 2)))
10531 (setq t1 (time-to-days (org-time-string-to-time t1))
10532 t2 (time-to-days (org-time-string-to-time t2)))
10533 (org-agenda-list nil t1 (1+ (- t2 t1)))))
10534 ((org-at-timestamp-p t)
10535 (org-agenda-list nil (time-to-days (org-time-string-to-time
10536 (substring (match-string 1) 0 10)))
10537 1))
10538 (t (error "This should not happen"))))
10541 (defun org-follow-bbdb-link (name)
10542 "Follow a BBDB link to NAME."
10543 (require 'bbdb)
10544 (let ((inhibit-redisplay (not debug-on-error))
10545 (bbdb-electric-p nil))
10546 (catch 'exit
10547 ;; Exact match on name
10549 (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
10550 ;; Exact match on name
10552 (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
10553 ;; Partial match on name
10554 (bbdb-name name nil)
10555 (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
10556 ;; Partial match on company
10557 (bbdb-company name nil)
10558 (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
10559 ;; General match including network address and notes
10560 (bbdb name nil)
10561 (when (= 0 (buffer-size (get-buffer "*BBDB*")))
10562 (delete-window (get-buffer-window "*BBDB*"))
10563 (error "No matching BBDB record")))))
10565 (defun org-follow-info-link (name)
10566 "Follow an info file & node link to NAME."
10569 (progn
10570 (require 'info)
10571 (if (match-string 2 name) ; If there isn't a node, choose "Top"
10572 (Info-find-node (match-string 1 name) (match-string 2 name))
10573 (Info-find-node (match-string 1 name) "Top")))
10574 (message (concat "Could not open: " name))))
10576 (defun org-follow-gnus-link (&optional group article)
10577 "Follow a Gnus link to GROUP and ARTICLE."
10578 (require 'gnus)
10579 (funcall (cdr (assq 'gnus org-link-frame-setup)))
10580 (if gnus-other-frame-object (select-frame gnus-other-frame-object))
10581 (cond ((and group article)
10582 (gnus-group-read-group 0 nil group)
10583 (gnus-summary-goto-article (string-to-number article) nil t))
10584 (group (gnus-group-jump-to-group group))))
10586 (defun org-follow-vm-link (&optional folder article readonly)
10587 "Follow a VM link to FOLDER and ARTICLE."
10588 (require 'vm)
10589 (setq article (org-add-angle-brackets article))
10591 ;; ange-ftp or efs or tramp access
10592 (let ((user (or (match-string 1 folder) (user-login-name)))
10593 (host (match-string 2 folder))
10594 (file (match-string 3 folder)))
10595 (cond
10596 ((featurep 'tramp)
10597 ;; use tramp to access the file
10598 (if (featurep 'xemacs)
10599 (setq folder (format "[%s@%s]%s" user host file))
10600 (setq folder (format "/%s@%s:%s" user host file))))
10601 (t
10602 ;; use ange-ftp or efs
10603 (require (if (featurep 'xemacs) 'efs 'ange-ftp))
10604 (setq folder (format "/%s@%s:%s" user host file))))))
10605 (when folder
10606 (funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly)
10607 (sit-for 0.1)
10608 (when article
10609 (vm-select-folder-buffer)
10610 (widen)
10611 (let ((case-fold-search t))
10612 (goto-char (point-min))
10613 (if (not (re-search-forward
10614 (concat "^" "message-id: *" (regexp-quote article))))
10615 (error "Could not find the specified message in this folder"))
10616 (vm-isearch-update)
10617 (vm-isearch-narrow)
10618 (vm-beginning-of-message)
10619 (vm-summarize)))))
10621 (defun org-follow-wl-link (folder article)
10622 "Follow a Wanderlust link to FOLDER and ARTICLE."
10623 (if (and (string= folder "%")
10624 article
10626 ;; XXX: imap-uw supports folders starting with '#' such as "#mh/inbox".
10627 ;; Thus, we recompose folder and article ids.
10628 (setq folder (format "%s#%s" folder (match-string 1 article))
10629 article (match-string 3 article)))
10630 (if (not (elmo-folder-exists-p (wl-folder-get-elmo-folder folder)))
10631 (error "No such folder: %s" folder))
10632 (wl-summary-goto-folder-subr folder 'no-sync t nil t nil nil)
10633 (and article
10634 (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets article))
10635 (wl-summary-redisplay)))
10637 (defun org-follow-rmail-link (folder article)
10638 "Follow an RMAIL link to FOLDER and ARTICLE."
10639 (setq article (org-add-angle-brackets article))
10640 (let (message-number)
10641 (save-excursion
10642 (save-window-excursion
10643 (rmail (if (string= folder "RMAIL") rmail-file-name folder))
10644 (setq message-number
10645 (save-restriction
10646 (widen)
10647 (goto-char (point-max))
10648 (if (re-search-backward
10650 (or article "")))
10651 nil t)
10652 (rmail-what-message))))))
10653 (if message-number
10654 (progn
10655 (rmail (if (string= folder "RMAIL") rmail-file-name folder))
10656 (rmail-show-message message-number)
10657 message-number)
10658 (error "Message not found"))))
10660 ;;; mh-e integration based on planner-mode
10661 (defun org-mhe-get-message-real-folder ()
10662 "Return the name of the current message real folder, so if you use
10663 sequences, it will now work."
10664 (save-excursion
10665 (let* ((folder
10666 (if (equal major-mode 'mh-folder-mode)
10667 mh-current-folder
10668 ;; Refer to the show buffer
10669 mh-show-folder-buffer))
10670 (end-index
10671 (if (boundp 'mh-index-folder)
10672 (min (length mh-index-folder) (length folder))))
10673 )
10674 ;; a simple test on mh-index-data does not work, because
10675 ;; mh-index-data is always nil in a show buffer.
10676 (if (and (boundp 'mh-index-folder)
10677 (string= mh-index-folder (substring folder 0 end-index)))
10678 (if (equal major-mode 'mh-show-mode)
10679 (save-window-excursion
10680 (when (buffer-live-p (get-buffer folder))
10681 (progn
10682 (pop-to-buffer folder)
10683 (org-mhe-get-message-folder-from-index)
10684 )
10685 ))
10686 (org-mhe-get-message-folder-from-index)
10687 )
10688 folder
10689 )
10690 )))
10692 (defun org-mhe-get-message-folder-from-index ()
10693 "Returns the name of the message folder in a index folder buffer."
10694 (save-excursion
10695 (mh-index-previous-folder)
10697 (message (match-string 1))))
10699 (defun org-mhe-get-message-folder ()
10700 "Return the name of the current message folder. Be careful if you
10701 use sequences."
10702 (save-excursion
10703 (if (equal major-mode 'mh-folder-mode)
10704 mh-current-folder
10705 ;; Refer to the show buffer
10706 mh-show-folder-buffer)))
10708 (defun org-mhe-get-message-num ()
10709 "Return the number of the current message. Be careful if you
10710 use sequences."
10711 (save-excursion
10712 (if (equal major-mode 'mh-folder-mode)
10713 (mh-get-msg-num nil)
10714 ;; Refer to the show buffer
10715 (mh-show-buffer-message-number))))
10717 (defun org-mhe-get-header (header)
10718 "Return a header of the message in folder mode. This will create a
10719 show buffer for the corresponding message. If you have a more clever
10720 idea..."
10721 (let* ((folder (org-mhe-get-message-folder))
10722 (num (org-mhe-get-message-num))
10723 (buffer (get-buffer-create (concat "show-" folder)))
10724 (header-field))
10725 (with-current-buffer buffer
10726 (mh-display-msg num folder)
10727 (if (equal major-mode 'mh-folder-mode)
10728 (mh-header-display)
10729 (mh-show-header-display))
10730 (set-buffer buffer)
10731 (setq header-field (mh-get-header-field header))
10732 (if (equal major-mode 'mh-folder-mode)
10733 (mh-show)
10734 (mh-show-show))
10735 header-field)))
10737 (defun org-follow-mhe-link (folder article)
10738 "Follow an MHE link to FOLDER and ARTICLE.
10739 If ARTICLE is nil FOLDER is shown. If the configuration variable
10740 `org-mhe-search-all-folders' is t and `mh-searcher' is pick,
10741 ARTICLE is searched in all folders. Indexed searches (swish++,
10742 namazu, and others supported by MH-E) will always search in all
10743 folders."
10744 (require 'mh-e)
10745 (require 'mh-search)
10746 (require 'mh-utils)
10747 (mh-find-path)
10748 (if (not article)
10749 (mh-visit-folder (mh-normalize-folder-name folder))
10750 (setq article (org-add-angle-brackets article))
10751 (mh-search-choose)
10752 (if (equal mh-searcher 'pick)
10753 (progn
10754 (mh-search folder (list "--message-id" article))
10755 (when (and org-mhe-search-all-folders
10756 (not (org-mhe-get-message-real-folder)))
10757 (kill-this-buffer)
10758 (mh-search "+" (list "--message-id" article))))
10759 (mh-search "+" article))
10760 (if (org-mhe-get-message-real-folder)
10761 (mh-show-msg 1)
10762 (kill-this-buffer)
10763 (error "Message not found"))))
10765 ;;; BibTeX links
10767 ;; Use the custom search meachnism to construct and use search strings for
10768 ;; file links to BibTeX database entries.
10770 (defun org-create-file-search-in-bibtex ()
10771 "Create the search string and description for a BibTeX database entry."
10772 (when (eq major-mode 'bibtex-mode)
10773 ;; yes, we want to construct this search string.
10774 ;; Make a good description for this entry, using names, year and the title
10775 ;; Put it into the `description' variable which is dynamically scoped.
10776 (let ((bibtex-autokey-names 1)
10777 (bibtex-autokey-names-stretch 1)
10778 (bibtex-autokey-name-case-convert-function 'identity)
10779 (bibtex-autokey-name-separator " & ")
10780 (bibtex-autokey-additional-names " et al.")
10781 (bibtex-autokey-year-length 4)
10782 (bibtex-autokey-name-year-separator " ")
10783 (bibtex-autokey-titlewords 3)
10784 (bibtex-autokey-titleword-separator " ")
10785 (bibtex-autokey-titleword-case-convert-function 'identity)
10786 (bibtex-autokey-titleword-length 'infty)
10787 (bibtex-autokey-year-title-separator ": "))
10788 (setq description (bibtex-generate-autokey)))
10789 ;; Now parse the entry, get the key and return it.
10790 (save-excursion
10791 (bibtex-beginning-of-entry)
10792 (cdr (assoc "=key=" (bibtex-parse-entry))))))
10794 (defun org-execute-file-search-in-bibtex (s)
10795 "Find the link search string S as a key for a database entry."
10796 (when (eq major-mode 'bibtex-mode)
10797 ;; Yes, we want to do the search in this file.
10798 ;; We construct a regexp that searches for "@entrytype{" followed by the key
10799 (goto-char (point-min))
10802 (goto-char (match-beginning 0)))
10803 (if (and (match-beginning 0) (equal current-prefix-arg '(16)))
10804 ;; Use double prefix to indicate that any web link should be browsed
10805 (let ((b (current-buffer)) (p (point)))
10806 ;; Restore the window configuration because we just use the web link
10807 (set-window-configuration org-window-config-before-follow-link)
10808 (save-excursion (set-buffer b) (goto-char p)
10809 (bibtex-url)))
10810 (recenter 0)) ; Move entry start to beginning of window
10811 ;; return t to indicate that the search is done.
10812 t))
10814 ;; Finally add the functions to the right hooks.
10815 (add-hook 'org-create-file-search-functions 'org-create-file-search-in-bibtex)
10816 (add-hook 'org-execute-file-search-functions 'org-execute-file-search-in-bibtex)
10818 ;; end of Bibtex link setup
10820 ;;; Following file links
10822 (defun org-open-file (path &optional in-emacs line search)
10823 "Open the file at PATH.
10824 First, this expands any special file name abbreviations. Then the
10825 configuration variable `org-file-apps' is checked if it contains an
10826 entry for this file type, and if yes, the corresponding command is launched.
10827 If no application is found, Emacs simply visits the file.
10828 With optional argument IN-EMACS, Emacs will visit the file.
10829 Optional LINE specifies a line to go to, optional SEARCH a string to
10830 search for. If LINE or SEARCH is given, the file will always be
10831 opened in Emacs.
10832 If the file does not exist, an error is thrown."
10833 (setq in-emacs (or in-emacs line search))
10834 (let* ((file (if (equal path "")
10835 buffer-file-name
10836 (substitute-in-file-name (expand-file-name path))))
10837 (apps (append org-file-apps (org-default-apps)))
10838 (remp (and (assq 'remote apps) (org-file-remote-p file)))
10839 (dirp (if remp nil (file-directory-p file)))
10840 (dfile (downcase file))
10841 (old-buffer (current-buffer))
10842 (old-pos (point))
10843 (old-mode major-mode)
10844 ext cmd)
10846 (setq ext (match-string 1 dfile))
10848 (setq ext (match-string 1 dfile))))
10849 (if in-emacs
10850 (setq cmd 'emacs)
10851 (setq cmd (or (and remp (cdr (assoc 'remote apps)))
10852 (and dirp (cdr (assoc 'directory apps)))
10853 (cdr (assoc ext apps))
10854 (cdr (assoc t apps)))))
10855 (when (eq cmd 'mailcap)
10856 (require 'mailcap)
10857 (mailcap-parse-mailcaps)
10858 (let* ((mime-type (mailcap-extension-to-mime (or ext "")))
10859 (command (mailcap-mime-info mime-type)))
10860 (if (stringp command)
10861 (setq cmd command)
10862 (setq cmd 'emacs))))
10863 (if (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files
10864 (not (file-exists-p file))
10865 (not org-open-non-existing-files))
10866 (error "No such file: %s" file))
10867 (cond
10869 ;; Remove quotes around the file name - we'll use shell-quote-argument.
10871 (setq cmd (replace-match "%s" t t cmd)))
10872 (setq cmd (format cmd (shell-quote-argument file)))
10873 (save-window-excursion
10874 (shell-command (concat cmd " &"))))
10875 ((or (stringp cmd)
10876 (eq cmd 'emacs))
10877 (funcall (cdr (assq 'file org-link-frame-setup)) file)
10878 (if line (goto-line line)
10879 (if search (org-link-search search))))
10880 ((consp cmd)
10881 (eval cmd))
10882 (t (funcall (cdr (assq 'file org-link-frame-setup)) file)))
10883 (and (org-mode-p) (eq old-mode 'org-mode)
10884 (or (not (equal old-buffer (current-buffer)))
10885 (not (equal old-pos (point))))
10886 (org-mark-ring-push old-pos old-buffer))))
10888 (defun org-default-apps ()
10889 "Return the default applications for this operating system."
10890 (cond
10891 ((eq system-type 'darwin)
10892 org-file-apps-defaults-macosx)
10893 ((eq system-type 'windows-nt)
10894 org-file-apps-defaults-windowsnt)
10895 (t org-file-apps-defaults-gnu)))
10897 (defvar ange-ftp-name-format) ; to silence the XEmacs compiler.
10898 (defun org-file-remote-p (file)
10899 "Test whether FILE specifies a location on a remote system.
10900 Return non-nil if the location is indeed remote.
10904 (cond ((fboundp 'file-remote-p)
10905 (file-remote-p file))
10906 ((fboundp 'tramp-handle-file-remote-p)
10907 (tramp-handle-file-remote-p file))
10908 ((and (boundp 'ange-ftp-name-format)
10909 (string-match (car ange-ftp-name-format) file))
10910 t)
10911 (t nil)))
10914 ;;;; Hooks for remember.el
10916 ;;;###autoload
10917 (defun org-remember-annotation ()
10918 "Return a link to the current location as an annotation for remember.el.
10919 If you are using Org-mode files as target for data storage with
10920 remember.el, then the annotations should include a link compatible with the
10921 conventions in Org-mode. This function returns such a link."
10922 (org-store-link nil))
10924 (defconst org-remember-help
10925 "Select a destination location for the note.
10926 UP/DOWN=headline TAB=cycle visibility [Q]uit RET/<left>/<right>=Store
10927 RET at beg-of-buf -> Append to file as level 2 headline
10928 RET on headline -> Store as sublevel entry to current headline
10929 <left>/<right> -> before/after current headline, same headings level")
10931 ;;;###autoload
10932 (defun org-remember-apply-template (&optional use-char skip-interactive)
10933 "Initialize *remember* buffer with template, invoke `org-mode'.
10934 This function should be placed into `remember-mode-hook' and in fact requires
10935 to be run from that hook to fucntion properly."
10936 (if org-remember-templates
10938 (let* ((char (or use-char
10939 (if (= (length org-remember-templates) 1)
10940 (caar org-remember-templates)
10941 (message "Select template: %s"
10942 (mapconcat
10943 (lambda (x) (char-to-string (car x)))
10944 org-remember-templates " "))
10945 (read-char-exclusive))))
10946 (entry (cdr (assoc char org-remember-templates)))
10947 (tpl (car entry))
10948 (plist-p (if org-store-link-plist t nil))
10949 (file (if (and (nth 1 entry) (stringp (nth 1 entry))
10951 (nth 1 entry)
10952 org-default-notes-file))
10953 (headline (nth 2 entry))
10954 (v-t (format-time-string (car org-time-stamp-formats) (org-current-time)))
10955 (v-T (format-time-string (cdr org-time-stamp-formats) (org-current-time)))
10956 (v-u (concat "[" (substring v-t 1 -1) "]"))
10957 (v-U (concat "[" (substring v-T 1 -1) "]"))
10958 (v-i initial) ; defined in `remember-mode'
10959 (v-a (if (equal annotation "[[]]") "" annotation)) ; likewise
10960 (v-n user-full-name)
10961 (org-startup-folded nil)
10962 org-time-was-given x prompt char time)
10963 (setq org-store-link-plist
10964 (append (list :annotation v-a :initial v-i)))
10965 (unless tpl (setq tpl "") (message "No template") (ding))
10966 (erase-buffer)
10967 (insert (substitute-command-keys
10968 (format
10969 "## `C-c C-c' to file interactively, `C-u C-c C-c' to file directly.
10972 (abbreviate-file-name (or file org-default-notes-file))
10973 (or headline ""))))
10974 (insert tpl) (goto-char (point-min))
10975 ;; Simple %-escapes
10977 (when (and initial (equal (match-string 0) "%i"))
10978 (save-match-data
10979 (let* ((lead (buffer-substring
10980 (point-at-bol) (match-beginning 0))))
10981 (setq v-i (mapconcat 'identity
10984 (replace-match
10985 (or (eval (intern (concat "v-" (match-string 1)))) "")
10986 t t))
10987 ;; From the property list
10988 (when plist-p
10989 (goto-char (point-min))
10991 (and (setq x (plist-get org-store-link-plist
10992 (intern (match-string 1))))
10993 (replace-match x t t))))
10994 ;; Turn on org-mode in the remember buffer, set local variables
10995 (org-mode)
10996 (org-set-local 'org-finish-function 'remember-buffer)
10998 (org-set-local 'org-default-notes-file file))
11000 (org-set-local 'org-remember-default-headline headline))
11001 ;; Interactive template entries
11002 (goto-char (point-min))
11004 (setq char (if (match-end 3) (match-string 3))
11005 prompt (if (match-end 2) (match-string 2)))
11006 (goto-char (match-beginning 0))
11007 (replace-match "")
11008 (if char
11009 (progn
11010 (setq org-time-was-given (equal (upcase char) char))
11011 (setq time (org-read-date (equal (upcase char) "U") t nil
11012 prompt))
11013 (org-insert-time-stamp time org-time-was-given
11014 (member char '("u" "U"))))
11015 (insert (read-string
11016 (if prompt (concat prompt ": ") "Enter string")))))
11017 (goto-char (point-min))
11019 (replace-match "")
11021 (org-mode)
11022 (org-set-local 'org-finish-function 'remember-buffer)))
11024 ;;;###autoload
11025 (defun org-remember ()
11026 "Call `remember'. If this is already a remember buffer, re-apply template.
11027 If there is an active region, make sure remember uses it as initial content
11028 of the remember buffer."
11029 (interactive)
11030 (if (eq org-finish-function 'remember-buffer)
11031 (progn
11032 (when (< (length org-remember-templates) 2)
11033 (error "No other template available"))
11034 (erase-buffer)
11035 (let ((annotation (plist-get org-store-link-plist :annotation))
11036 (initial (plist-get org-store-link-plist :initial)))
11037 (org-remember-apply-template))
11038 (message "Press C-c C-c to remember data"))
11039 (if (org-region-active-p)
11040 (remember (buffer-substring (point) (mark)))
11041 (call-interactively 'remember))))
11043 ;;;###autoload
11044 (defun org-remember-handler ()
11045 "Store stuff from remember.el into an org file.
11046 First prompts for an org file. If the user just presses return, the value
11047 of `org-default-notes-file' is used.
11048 Then the command offers the headings tree of the selected file in order to
11049 file the text at a specific location.
11050 You can either immediately press RET to get the note appended to the
11051 file, or you can use vertical cursor motion and visibility cycling (TAB) to
11052 find a better place. Then press RET or <left> or <right> in insert the note.
11054 Key Cursor position Note gets inserted
11055 -----------------------------------------------------------------------------
11056 RET buffer-start as level 2 heading at end of file
11057 RET on headline as sublevel of the heading at cursor
11058 RET no heading at cursor position, level taken from context.
11059 Or use prefix arg to specify level manually.
11060 <left> on headline as same level, before current heading
11061 <right> on headline as same level, after current heading
11063 So the fastest way to store the note is to press RET RET to append it to
11064 the default file. This way your current train of thought is not
11065 interrupted, in accordance with the principles of remember.el. But with
11066 little extra effort, you can push it directly to the correct location.
11068 Before being stored away, the function ensures that the text has a
11070 is constructed from the current date and some additional data.
11072 If the variable `org-adapt-indentation' is non-nil, the entire text is
11073 also indented so that it starts in the same column as the headline
11074 \(i.e. after the stars).
11076 See also the variable `org-reverse-note-order'."
11077 (goto-char (point-min))
11079 (replace-match ""))
11080 (catch 'quit
11081 (let* ((txt (buffer-substring (point-min) (point-max)))
11082 (fastp (equal current-prefix-arg '(4)))
11083 (file (if fastp org-default-notes-file (org-get-org-file)))
11084 (heading org-remember-default-headline)
11085 (visiting (org-find-base-buffer-visiting file))
11086 (org-startup-folded nil)
11087 (org-startup-align-all-tables nil)
11088 (org-goto-start-pos 1)
11089 spos level indent reversed)
11090 (setq current-prefix-arg nil)
11091 ;; Modify text so that it becomes a nice subtree which can be inserted
11092 ;; into an org tree.
11094 first)
11095 (setq first (car lines) lines (cdr lines))
11097 ;; Is already a headline
11098 (setq indent nil)
11099 ;; We need to add a headline: Use time and first buffer line
11100 (setq lines (cons first lines)
11101 first (concat "* " (current-time-string)
11102 " (" (remember-buffer-desc) ")")
11103 indent " "))
11104 (if (and org-adapt-indentation indent)
11105 (setq lines (mapcar (lambda (x) (concat indent x)) lines)))
11108 ;; Find the file
11109 (if (not visiting) (find-file-noselect file))
11110 (with-current-buffer (or visiting (get-file-buffer file))
11111 (save-excursion (and (goto-char (point-min))
11114 (setq reversed (org-notes-order-reversed-p))
11115 (save-excursion
11116 (save-restriction
11117 (widen)
11119 ;; Find the default location
11121 (goto-char (point-min))
11122 (if (re-search-forward
11125 nil t)
11126 (setq org-goto-start-pos (match-beginning 0))))
11128 ;; Ask the User for a location
11129 (setq spos (if fastp
11130 org-goto-start-pos
11131 (org-get-location (current-buffer) org-remember-help)))
11132 (if (not spos) (throw 'quit nil)) ; return nil to show we did
11133 ; not handle this note
11134 (goto-char spos)
11135 (cond ((and (bobp) (not reversed))
11136 ;; Put it at the end, one level below level 1
11137 (save-restriction
11138 (widen)
11139 (goto-char (point-max))
11140 (if (not (bolp)) (newline))
11141 (org-paste-subtree (org-get-legal-level 1 1) txt)))
11142 ((and (bobp) reversed)
11143 ;; Put it at the start, as level 1
11144 (save-restriction
11145 (widen)
11146 (goto-char (point-min))
11148 (beginning-of-line 1)
11149 (org-paste-subtree 1 txt)))
11150 ((and (org-on-heading-p nil) (not current-prefix-arg))
11151 ;; Put it below this entry, at the beg/end of the subtree
11152 (org-back-to-heading t)
11153 (setq level (funcall outline-level))
11154 (if reversed
11155 (outline-end-of-heading)
11156 (org-end-of-subtree t))
11157 (if (not (bolp)) (newline))
11158 (beginning-of-line 1)
11159 (org-paste-subtree (org-get-legal-level level 1) txt))
11160 (t
11161 ;; Put it right there, with automatic level determined by
11162 ;; org-paste-subtree or from prefix arg
11163 (org-paste-subtree
11164 (if (numberp current-prefix-arg) current-prefix-arg)
11165 txt)))
11166 (when remember-save-after-remembering
11167 (save-buffer)
11168 (if (not visiting) (kill-buffer (current-buffer)))))))))
11169 t) ;; return t to indicate that we took care of this note.
11171 (defun org-get-org-file ()
11172 "Read a filename, with default directory `org-directory'."
11173 (let ((default (or org-default-notes-file remember-data-file)))
11174 (read-file-name (format "File name [%s]: " default)
11175 (file-name-as-directory org-directory)
11176 default)))
11178 (defun org-notes-order-reversed-p ()
11179 "Check if the current file should receive notes in reversed order."
11180 (cond
11181 ((not org-reverse-note-order) nil)
11182 ((eq t org-reverse-note-order) t)
11183 ((not (listp org-reverse-note-order)) nil)
11184 (t (catch 'exit
11185 (let ((all org-reverse-note-order)
11186 entry)
11187 (while (setq entry (pop all))
11188 (if (string-match (car entry) buffer-file-name)
11189 (throw 'exit (cdr entry))))
11190 nil)))))
11192 ;;;; Dynamic blocks
11194 (defun org-find-dblock (name)
11195 "Find the first dynamic block with name NAME in the buffer.
11196 If not found, stay at current position and return nil."
11197 (let (pos)
11198 (save-excursion
11199 (goto-char (point-min))
11201 nil t)
11202 (match-beginning 0))))
11203 (if pos (goto-char pos))
11204 pos))
11206 (defconst org-dblock-start-re
11208 "Matches the startline of a dynamic block, with parameters.")
11211 "Matches the end of a dyhamic block.")
11213 (defun org-create-dblock (plist)
11214 "Create a dynamic block section, with parameters taken from PLIST.
11215 PLIST must containe a :name entry which is used as name of the block."
11216 (unless (bolp) (newline))
11217 (let ((name (plist-get plist :name)))
11218 (insert "#+BEGIN: " name)
11219 (while plist
11220 (if (eq (car plist) :name)
11221 (setq plist (cddr plist))
11222 (insert " " (prin1-to-string (pop plist)))))
11224 (beginning-of-line -2)))
11226 (defun org-prepare-dblock ()
11227 "Prepare dynamic block for refresh.
11228 This empties the block, puts the cursor at the insert position and returns
11229 the property list including an extra property :name with the block name."
11230 (unless (looking-at org-dblock-start-re)
11231 (error "Not at a dynamic block"))
11232 (let* ((begdel (1+ (match-end 0)))
11233 (name (match-string 1))
11234 (params (append (list :name name)
11235 (read (concat "(" (match-string 3) ")")))))
11236 (unless (re-search-forward org-dblock-end-re nil t)
11237 (error "Dynamic block not terminated"))
11238 (delete-region begdel (match-beginning 0))
11239 (goto-char begdel)
11240 (open-line 1)
11241 params))
11243 (defun org-map-dblocks (&optional command)
11244 "Apply COMMAND to all dynamic blocks in the current buffer.
11245 If COMMAND is not given, use `org-update-dblock'."
11246 (let ((cmd (or command 'org-update-dblock))
11247 pos)
11248 (save-excursion
11249 (goto-char (point-min))
11250 (while (re-search-forward org-dblock-start-re nil t)
11251 (goto-char (setq pos (match-beginning 0)))
11252 (condition-case nil
11253 (funcall cmd)
11254 (error (message "Error during update of dynamic block")))
11255 (goto-char pos)
11256 (unless (re-search-forward org-dblock-end-re nil t)
11257 (error "Dynamic block not terminated"))))))
11259 (defun org-dblock-update (&optional arg)
11260 "User command for updating dynamic blocks.
11261 Update the dynamic block at point. With prefix ARG, update all dynamic
11262 blocks in the buffer."
11263 (interactive "P")
11264 (if arg
11265 (org-update-all-dblocks)
11266 (or (looking-at org-dblock-start-re)
11267 (org-beginning-of-dblock))
11268 (org-update-dblock)))
11270 (defun org-update-dblock ()
11271 "Update the dynamic block at point
11272 This means to empty the block, parse for parameters and then call
11273 the correct writing function."
11274 (let* ((pos (point))
11275 (params (org-prepare-dblock))
11276 (name (plist-get params :name))
11277 (cmd (intern (concat "org-dblock-write:" name))))
11278 (funcall cmd params)
11279 (goto-char pos)))
11281 (defun org-beginning-of-dblock ()
11282 "Find the beginning of the dynamic block at point.
11283 Error if there is no scuh block at point."
11284 (let ((pos (point))
11285 beg)
11286 (end-of-line 1)
11287 (if (and (re-search-backward org-dblock-start-re nil t)
11288 (setq beg (match-beginning 0))
11289 (re-search-forward org-dblock-end-re nil t)
11290 (> (match-end 0) pos))
11291 (goto-char beg)
11292 (goto-char pos)
11293 (error "Not in a dynamic block"))))
11295 (defun org-update-all-dblocks ()
11296 "Update all dynamic blocks in the buffer.
11297 This function can be used in a hook."
11298 (when (org-mode-p)
11299 (org-map-dblocks 'org-update-dblock)))
11302 ;;;; Completion
11304 (defun org-complete (&optional arg)
11305 "Perform completion on word at point.
11306 At the beginning of a headline, this completes TODO keywords as given in
11307 `org-todo-keywords'.
11308 If the current word is preceded by a backslash, completes the TeX symbols
11309 that are supported for HTML support.
11311 setting file options.
11313 At all other locations, this simply calls `ispell-complete-word'."
11314 (interactive "P")
11315 (catch 'exit
11316 (let* ((end (point))
11317 (beg1 (save-excursion
11318 (skip-chars-backward "a-zA-Z_@0-9")
11319 (point)))
11320 (beg (save-excursion
11321 (skip-chars-backward "a-zA-Z0-9_:$")
11322 (point)))
11323 (confirm (lambda (x) (stringp (car x))))
11324 (searchhead (equal (char-before beg) ?*))
11325 (tag (equal (char-before beg1) ?:))
11327 (link (equal (char-before beg) ?\[))
11328 (opt (equal (buffer-substring (max (point-at-bol) (- beg 2))
11329 beg)
11330 "#+"))
11332 (buffer-substring (point-at-bol) (point))))
11333 (completion-ignore-case opt)
11334 (type nil)
11335 (tbl nil)
11336 (table (cond
11337 (opt
11338 (setq type :opt)
11339 (mapcar (lambda (x)
11341 (cons (match-string 2 x) (match-string 1 x)))
11343 (startup
11344 (setq type :startup)
11345 org-startup-options)
11346 (link (append org-link-abbrev-alist-local
11347 org-link-abbrev-alist))
11348 (texp
11349 (setq type :tex)
11350 org-html-entities)
11352 (buffer-substring (point-at-bol) beg))
11353 (setq type :todo)
11354 (mapcar 'list org-todo-keywords-1))
11355 (searchhead
11356 (setq type :searchhead)
11357 (save-excursion
11358 (goto-char (point-min))
11359 (while (re-search-forward org-todo-line-regexp nil t)
11360 (push (list
11361 (org-make-org-heading-search-string
11362 (match-string 3) t))
11363 tbl)))
11364 tbl)
11365 (tag (setq type :tag beg beg1)
11366 (or org-tag-alist (org-get-buffer-tags)))
11367 (t (progn (ispell-complete-word arg) (throw 'exit nil)))))
11368 (pattern (buffer-substring-no-properties beg end))
11369 (completion (try-completion pattern table confirm)))
11370 (cond ((eq completion t)
11371 (if (equal type :opt)
11372 (insert (substring (cdr (assoc (upcase pattern) table))
11373 (length pattern)))
11374 (if (equal type :tag) (insert ":"))))
11375 ((null completion)
11377 (ding))
11378 ((not (string= pattern completion))
11379 (delete-region beg end)
11380 (if (string-match " +$" completion)
11381 (setq completion (replace-match "" t t completion)))
11382 (insert completion)
11383 (if (get-buffer-window "*Completions*")
11384 (delete-window (get-buffer-window "*Completions*")))
11385 (if (assoc completion table)
11386 (if (eq type :todo) (insert " ")
11387 (if (eq type :tag) (insert ":"))))
11388 (if (and (equal type :opt) (assoc completion table))
11389 (message "%s" (substitute-command-keys
11391 (t
11392 (message "Making completion list...")
11393 (let ((list (sort (all-completions pattern table confirm)
11394 'string<)))
11395 (with-output-to-temp-buffer "*Completions*"
11396 (condition-case nil
11397 ;; Protection needed for XEmacs and emacs 21
11398 (display-completion-list list pattern)
11399 (error (display-completion-list list)))))
11400 (message "Making completion list...%s" "done"))))))
11402 ;;;; TODO, DEADLINE, Comments
11404 (defun org-toggle-comment ()
11405 "Change the COMMENT state of an entry."
11406 (interactive)
11407 (save-excursion
11408 (org-back-to-heading)
11409 (if (looking-at (concat outline-regexp
11411 (replace-match "" t t nil 1)
11412 (if (looking-at outline-regexp)
11413 (progn
11414 (goto-char (match-end 0))
11415 (insert " " org-comment-string))))))
11417 (defvar org-last-todo-state-is-todo nil
11418 "This is non-nil when the last TODO state change led to a TODO state.
11419 If the last change removed the TODO tag or switched to DONE, then
11420 this is nil.")
11422 (defun org-todo (&optional arg)
11423 "Change the TODO state of an item.
11424 The state of an item is given by a keyword at the start of the heading,
11425 like
11426 *** TODO Write paper
11427 *** DONE Call mom
11429 The different keywords are specified in the variable `org-todo-keywords'.
11431 So for this example: when the item starts with TODO, it is changed to DONE.
11432 When it starts with DONE, the DONE is removed. And when neither TODO nor
11433 DONE are present, add TODO at the beginning of the heading.
11435 With C-u prefix arg, use completion to determine the new state.
11436 With numeric prefix arg, switch to that state.
11438 For calling through lisp, arg is also interpreted in the following way:
11439 'none -> empty state
11441 'done -> switch to DONE
11442 'nextset -> switch to the next set of keywords
11443 'previousset -> switch to the previous set of keywords
11445 really is a member of `org-todo-keywords'."
11446 (interactive "P")
11447 (save-excursion
11448 (org-back-to-heading)
11449 (if (looking-at outline-regexp) (goto-char (match-end 0)))
11450 (or (looking-at (concat " +" org-todo-regexp " *"))
11451 (looking-at " *"))
11452 (let* ((this (match-string 1))
11453 (head (org-get-todo-sequence-head this))
11454 (ass (assoc head org-todo-kwd-alist))
11455 (interpret (nth 1 ass))
11456 (done-word (nth 3 ass))
11457 (final-done-word (nth 4 ass))
11458 (last-state (or this ""))
11459 (completion-ignore-case t)
11460 (member (member this org-todo-keywords-1))
11461 (tail (cdr member))
11462 (state (cond
11463 ((equal arg '(4))
11464 ;; Read a state with completion
11465 (completing-read "State: " (mapcar (lambda(x) (list x))
11466 org-todo-keywords-1)
11467 nil t))
11468 ((eq arg 'right)
11469 (if this
11470 (if tail (car tail) nil)
11471 (car org-todo-keywords-1)))
11472 ((eq arg 'left)
11473 (if (equal member org-todo-keywords-1)
11474 nil
11475 (if this
11476 (nth (- (length org-todo-keywords-1) (length tail) 2)
11477 org-todo-keywords-1)
11478 (org-last org-todo-keywords-1))))
11479 (arg
11480 ;; user or caller requests a specific state
11481 (cond
11482 ((equal arg "") nil)
11483 ((eq arg 'none) nil)
11484 ((eq arg 'done) (or done-word (car org-done-keywords)))
11485 ((eq arg 'nextset)
11486 (or (car (cdr (member head org-todo-heads)))
11487 (car org-todo-heads)))
11488 ((eq arg 'previousset)
11489 (let ((org-todo-heads (reverse org-todo-heads)))
11490 (or (car (cdr (member head org-todo-heads)))
11491 (car org-todo-heads))))
11492 ((car (member arg org-todo-keywords-1)))
11493 ((nth (1- (prefix-numeric-value arg))
11494 org-todo-keywords-1))))
11495 ((null member) (or head (car org-todo-keywords-1)))
11496 ((equal this final-done-word) nil) ;; -> make empty
11497 ((null tail) nil) ;; -> first entry
11498 ((eq interpret 'sequence)
11499 (car tail))
11500 ((memq interpret '(type priority))
11501 (if (eq this-command last-command)
11502 (car tail)
11503 (if (> (length tail) 0)
11504 (or done-word (car org-done-keywords))
11505 nil)))
11506 (t nil)))
11507 (next (if state (concat " " state " ") " "))
11508 dostates)
11509 (replace-match next t t)
11510 (when (memq arg '(nextset previousset))
11511 (message "Keyword set: %s"
11512 (mapconcat 'identity (assoc state org-todo-sets) " ")))
11513 (setq org-last-todo-state-is-todo
11514 (not (member state org-done-keywords)))
11515 (when (and org-log-done (not (memq arg '(nextset previousset))))
11516 (setq dostates (and (eq interpret 'sequence)
11517 (listp org-log-done) (memq 'state org-log-done)))
11518 (cond
11519 ((and state (not this))
11520 (org-add-planning-info nil nil 'closed)
11521 (and dostates (org-add-log-maybe 'state state 'findpos)))
11522 ((and state dostates)
11523 (org-add-log-maybe 'state state 'findpos))
11524 ((member state org-done-keywords)
11525 ;; Planning info calls the note-setting command.
11526 (org-add-planning-info 'closed (org-current-time)
11527 (if (org-get-repeat) nil 'scheduled))
11528 (org-add-log-maybe 'done state 'findpos))))
11529 ;; Fixup tag positioning
11530 (and org-auto-align-tags (org-set-tags nil t))
11531 (run-hooks 'org-after-todo-state-change-hook)
11532 (and (member state org-done-keywords) (org-auto-repeat-maybe))
11533 (if (and arg (not (member state org-done-keywords)))
11534 (setq head (org-get-todo-sequence-head state)))
11535 (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head)))
11536 ;; Fixup cursor location if close to the keyword
11537 (if (and (outline-on-heading-p)
11538 (not (bolp))
11539 (save-excursion (beginning-of-line 1)
11540 (looking-at org-todo-line-regexp))
11541 (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
11542 (progn
11543 (goto-char (or (match-end 2) (match-end 1)))
11544 (just-one-space))))
11546 (defun org-get-todo-sequence-head (kwd)
11547 "Return the head of the TODO sequence to which KWD belongs.
11548 If KWD is not set, check if there is a text property remembering the
11549 right sequence."
11550 (let (p)
11551 (cond
11552 ((not kwd)
11553 (or (get-text-property (point-at-bol) 'org-todo-head)
11554 (progn
11555 (setq p (next-single-property-change (point-at-bol) 'org-todo-head
11556 nil (point-at-eol)))
11557 (get-text-property p 'org-todo-head))))
11558 ((not (member kwd org-todo-keywords-1))
11559 (car org-todo-keywords-1))
11560 (t (nth 2 (assoc kwd org-todo-kwd-alist))))))
11562 (defun org-get-repeat ()
11563 "Return the REPEAT statement of this entry."
11564 (save-match-data
11565 (save-excursion
11566 (org-back-to-heading t)
11567 (if (re-search-forward
11568 org-repeat-re (save-excursion (outline-next-heading) (point)) t)
11569 (match-string 1)))))
11571 (defvar org-last-changed-timestamp)
11572 (defvar org-log-post-message)
11573 (defun org-auto-repeat-maybe ()
11574 "Check if the current headline contains a REPEAT key.
11575 If yes, set TODO state back to what it was and change any SCHEDULED
11576 or DEADLINE times the new date.
11577 This function should be run in the `org-after-todo-state-change-hook'."
11578 ;; last-state is dynamically scoped into this function
11579 (let* ((repeat (org-get-repeat))
11580 (aa (assoc last-state org-todo-kwd-alist))
11581 (interpret (nth 1 aa))
11582 (head (nth 2 aa))
11583 (done-word (nth 3 aa))
11584 (whata '(("d" . day) ("m" . month) ("y" . year)))
11585 (msg "Entry repeats: ")
11586 (org-log-done)
11587 re type n what start)
11588 (when repeat
11589 (org-todo (if (eq interpret 'type) last-state head))
11590 (when (and org-log-repeat
11591 (not (memq 'org-add-log-note
11592 (default-value 'post-command-hook))))
11593 ;; Make sure a note is taken
11594 (let ((org-log-done '(done)))
11595 (org-add-log-maybe 'done (or done-word (car org-done-keywords))
11596 'findpos)))
11597 (org-back-to-heading t)
11598 (org-add-planning-info nil nil 'closed)
11601 (while (re-search-forward
11602 re (save-excursion (outline-next-heading) (point)) t)
11603 (setq type (if (match-end 1) org-scheduled-string org-deadline-string)
11604 start 0)
11606 (setq start (match-end 0)
11607 n (string-to-number (match-string 1 repeat))
11608 what (match-string 2 repeat))
11609 (if (equal what "w") (setq n (* n 7) what "d"))
11610 (org-timestamp-change n (cdr (assoc what whata))))
11611 (setq msg (concat msg type org-last-changed-timestamp " ")))
11612 (setq org-log-post-message msg)
11613 (message msg))))
11615 (defun org-show-todo-tree (arg)
11616 "Make a compact tree which shows all headlines marked with TODO.
11617 The tree will show the lines where the regexp matches, and all higher
11618 headlines above the match.
11620 With a numeric prefix N, construct a sparse tree for the Nth element
11621 of `org-todo-keywords-1'."
11622 (interactive "P")
11623 (let ((case-fold-search nil)
11624 (kwd-re
11625 (cond ((null arg) org-not-done-regexp)
11626 ((equal arg '(4))
11627 (let ((kwd (completing-read "Keyword (or KWD1|KWD2|...): "
11628 (mapcar 'list org-todo-keywords-1))))
11632 ((<= (prefix-numeric-value arg) (length org-todo-keywords-1))
11633 (regexp-quote (nth (1- (prefix-numeric-value arg))
11634 org-todo-keywords-1)))
11635 (t (error "Invalid prefix argument: %s" arg)))))
11636 (message "%d TODO entries found"
11637 (org-occur (concat "^" outline-regexp " +" kwd-re )))))
11639 (defun org-deadline ()
11640 "Insert the DEADLINE: string to make a deadline.
11642 to modify it to the correct date."
11643 (interactive)
11644 (org-add-planning-info 'deadline nil 'closed))
11646 (defun org-schedule ()
11647 "Insert the SCHEDULED: string to schedule a TODO item.
11649 to modify it to the correct date."
11650 (interactive)
11651 (org-add-planning-info 'scheduled nil 'closed))
11653 (defun org-add-planning-info (what &optional time &rest remove)
11654 "Insert new timestamp with keyword in the line directly after the headline.
11655 WHAT indicates what kind of time stamp to add. TIME indicated the time to use.
11656 If non is given, the user is prompted for a date.
11657 REMOVE indicates what kind of entries to remove. An old WHAT entry will also
11658 be removed."
11659 (interactive)
11660 (let (org-time-was-given)
11661 (when what (setq time (or time (org-read-date nil 'to-time))))
11662 (when (and org-insert-labeled-timestamps-at-point
11663 (member what '(scheduled deadline)))
11664 (insert
11665 (if (eq what 'scheduled) org-scheduled-string org-deadline-string) " ")
11666 (org-insert-time-stamp time org-time-was-given)
11667 (setq what nil))
11668 (save-excursion
11669 (save-restriction
11670 (let (col list elt ts buffer-invisibility-spec)
11671 (org-back-to-heading t)
11673 (goto-char (match-end 1))
11674 (setq col (current-column))
11675 (goto-char (1+ (match-end 0)))
11676 (if (and (not (looking-at outline-regexp))
11679 (not (equal (match-string 1) org-clock-string)))
11680 (narrow-to-region (match-beginning 0) (match-end 0))
11682 (backward-char 1)
11683 (narrow-to-region (point) (point))
11684 (indent-to-column col))
11685 ;; Check if we have to remove something.
11686 (setq list (cons what remove))
11687 (while list
11688 (setq elt (pop list))
11689 (goto-char (point-min))
11690 (when (or (and (eq elt 'scheduled)
11691 (re-search-forward org-scheduled-time-regexp nil t))
11692 (and (eq elt 'deadline)
11693 (re-search-forward org-deadline-time-regexp nil t))
11694 (and (eq elt 'closed)
11695 (re-search-forward org-closed-time-regexp nil t)))
11696 (replace-match "")
11697 (if (looking-at "--+<[^>]+>") (replace-match ""))
11698 (if (looking-at " +") (replace-match ""))))
11699 (goto-char (point-max))
11700 (when what
11701 (insert
11702 (if (not (equal (char-before) ?\ )) " " "")
11703 (cond ((eq what 'scheduled) org-scheduled-string)
11704 ((eq what 'deadline) org-deadline-string)
11705 ((eq what 'closed) org-closed-string))
11706 " ")
11707 (org-insert-time-stamp time
11708 (or org-time-was-given (eq what 'closed))
11709 (eq what 'closed))
11710 (end-of-line 1))
11711 (goto-char (point-min))
11712 (widen)
11714 (replace-match ""))
11715 ts)))))
11717 (defvar org-log-note-marker (make-marker))
11718 (defvar org-log-note-purpose nil)
11719 (defvar org-log-note-state nil)
11720 (defvar org-log-note-window-configuration nil)
11721 (defvar org-log-note-return-to (make-marker))
11722 (defvar org-log-post-message nil
11723 "Message to be displayed after a log note has been stored.
11724 The auto-repeater uses this.")
11726 (defun org-add-log-maybe (&optional purpose state findpos)
11727 (save-excursion
11728 (when (and (listp org-log-done)
11729 (memq purpose org-log-done))
11730 (when findpos
11731 (org-back-to-heading t)
11735 (goto-char (match-end 0)))
11736 (move-marker org-log-note-marker (point))
11737 (setq org-log-note-purpose purpose)
11738 (setq org-log-note-state state)
11739 (add-hook 'post-command-hook 'org-add-log-note 'append))))
11741 (defun org-add-log-note (&optional purpose)
11742 "Pop up a window for taking a note, and add this note later at point."
11743 (remove-hook 'post-command-hook 'org-add-log-note)
11744 (setq org-log-note-window-configuration (current-window-configuration))
11745 (delete-other-windows)
11746 (move-marker org-log-note-return-to (point))
11747 (switch-to-buffer (marker-buffer org-log-note-marker))
11748 (goto-char org-log-note-marker)
11749 (switch-to-buffer-other-window "*Org Note*")
11750 (erase-buffer)
11751 (let ((org-inhibit-startup t)) (org-mode))
11753 (cond
11754 ((eq org-log-note-purpose 'clock-out) "stopped clock")
11755 ((eq org-log-note-purpose 'done) "closed todo item")
11756 ((eq org-log-note-purpose 'state) "state change")
11757 (t (error "This should not happen")))))
11758 (org-set-local 'org-finish-function 'org-store-log-note))
11760 (defun org-store-log-note ()
11761 "Finish taking a log note, and insert it to where it belongs."
11762 (let ((txt (buffer-string))
11763 (note (cdr (assq org-log-note-purpose org-log-note-headings)))
11764 lines ind)
11765 (kill-buffer (current-buffer))
11767 (setq txt (replace-match "" t t txt)))
11769 (setq txt (replace-match "" t t txt)))
11772 (setq note
11773 (org-replace-escapes
11774 note
11775 (list (cons "%u" (user-login-name))
11776 (cons "%U" user-full-name)
11777 (cons "%t" (format-time-string
11778 (org-time-stamp-format 'long 'inactive)
11779 (current-time)))
11780 (cons "%s" (if org-log-note-state
11782 "")))))
11784 (push note lines))
11785 (save-excursion
11786 (set-buffer (marker-buffer org-log-note-marker))
11787 (save-excursion
11788 (goto-char org-log-note-marker)
11789 (move-marker org-log-note-marker nil)
11790 (end-of-line 1)
11792 (setq ind (concat (buffer-substring (point-at-bol) (point)) " "))
11793 (insert " - " (pop lines))
11794 (while lines
11796 (set-window-configuration org-log-note-window-configuration)
11797 (with-current-buffer (marker-buffer org-log-note-return-to)
11798 (goto-char org-log-note-return-to))
11799 (move-marker org-log-note-return-to nil)
11800 (and org-log-post-message (message org-log-post-message)))
11802 (defvar org-occur-highlights nil)
11803 (make-variable-buffer-local 'org-occur-highlights)
11805 (defun org-occur (regexp &optional keep-previous callback)
11806 "Make a compact tree which shows all matches of REGEXP.
11807 The tree will show the lines where the regexp matches, and all higher
11808 headlines above the match. It will also show the heading after the match,
11809 to make sure editing the matching entry is easy.
11810 If KEEP-PREVIOUS is non-nil, highlighting and exposing done by a previous
11811 call to `org-occur' will be kept, to allow stacking of calls to this
11812 command.
11813 If CALLBACK is non-nil, it is a function which is called to confirm
11814 that the match should indeed be shown."
11816 (or keep-previous (org-remove-occur-highlights nil nil t))
11817 (let ((cnt 0))
11818 (save-excursion
11819 (goto-char (point-min))
11820 (if (or (not keep-previous) ; do not want to keep
11821 (not org-occur-highlights)) ; no previous matches
11822 ;; hide everything
11823 (org-overview))
11824 (while (re-search-forward regexp nil t)
11825 (when (or (not callback)
11826 (save-match-data (funcall callback)))
11827 (setq cnt (1+ cnt))
11828 (org-highlight-new-match (match-beginning 0) (match-end 0))
11829 (org-show-context 'occur-tree))))
11830 (when org-remove-highlights-with-change
11831 (org-add-hook 'before-change-functions 'org-remove-occur-highlights
11832 nil 'local))
11833 (unless org-sparse-tree-open-archived-trees
11834 (org-hide-archived-subtrees (point-min) (point-max)))
11835 (run-hooks 'org-occur-hook)
11836 (if (interactive-p)
11837 (message "%d match(es) for regexp %s" cnt regexp))
11838 cnt))
11840 (defun org-show-context (&optional key)
11841 "Make sure point and context and visible.
11842 How much context is shown depends upon the variables
11843 `org-show-hierarchy-above', `org-show-following-heading'. and
11844 `org-show-siblings'."
11845 (let ((heading-p (org-on-heading-p t))
11846 (hierarchy-p (org-get-alist-option org-show-hierarchy-above key))
11847 (following-p (org-get-alist-option org-show-following-heading key))
11848 (siblings-p (org-get-alist-option org-show-siblings key)))
11849 (catch 'exit
11850 ;; Show heading or entry text
11851 (if heading-p
11852 (org-flag-heading nil) ; only show the heading
11853 (and (or (org-invisible-p) (org-invisible-p2))
11854 (org-show-hidden-entry))) ; show entire entry
11855 (when following-p
11856 ;; Show next sibling, or heading below text
11857 (save-excursion
11858 (and (if heading-p (org-goto-sibling) (outline-next-heading))
11859 (org-flag-heading nil))))
11860 (when siblings-p (org-show-siblings))
11861 (when hierarchy-p
11862 ;; show all higher headings, possibly with siblings
11863 (save-excursion
11864 (while (and (condition-case nil
11865 (progn (org-up-heading-all 1) t)
11866 (error nil))
11867 (not (bobp)))
11868 (org-flag-heading nil)
11869 (when siblings-p (org-show-siblings))))))))
11871 (defun org-reveal (&optional siblings)
11872 "Show current entry, hierarchy above it, and the following headline.
11873 This can be used to show a consistent set of context around locations
11874 exposed with `org-show-hierarchy-above' or `org-show-following-heading'
11875 not t for the search context.
11877 With optional argument SIBLINGS, on each level of the hierarchy all
11878 siblings are shown. This repairs the tree structure to what it would
11879 look like when opened with hierarchical calls to `org-cycle'."
11880 (interactive "P")
11881 (let ((org-show-hierarchy-above t)
11882 (org-show-following-heading t)
11883 (org-show-siblings (if siblings t org-show-siblings)))
11884 (org-show-context nil)))
11886 (defun org-highlight-new-match (beg end)
11887 "Highlight from BEG to END and mark the highlight is an occur headline."
11888 (let ((ov (org-make-overlay beg end)))
11889 (org-overlay-put ov 'face 'secondary-selection)
11890 (push ov org-occur-highlights)))
11892 (defun org-remove-occur-highlights (&optional beg end noremove)
11893 "Remove the occur highlights from the buffer.
11894 BEG and END are ignored. If NOREMOVE is nil, remove this function
11895 from the `before-change-functions' in the current buffer."
11896 (interactive)
11897 (unless org-inhibit-highlight-removal
11898 (mapc 'org-delete-overlay org-occur-highlights)
11899 (setq org-occur-highlights nil)
11900 (unless noremove
11901 (remove-hook 'before-change-functions
11902 'org-remove-occur-highlights 'local))))
11904 ;;;; Priorities
11907 "Regular expression matching the priority indicator.")
11909 (defvar org-remove-priority-next-time nil)
11911 (defun org-priority-up ()
11912 "Increase the priority of the current item."
11913 (interactive)
11914 (org-priority 'up))
11916 (defun org-priority-down ()
11917 "Decrease the priority of the current item."
11918 (interactive)
11919 (org-priority 'down))
11921 (defun org-priority (&optional action)
11922 "Change the priority of an item by ARG.
11923 ACTION can be set, up, or down."
11924 (interactive)
11925 (setq action (or action 'set))
11926 (let (current new news have remove)
11927 (save-excursion
11928 (org-back-to-heading)
11929 (if (looking-at org-priority-regexp)
11930 (setq current (string-to-char (match-string 2))
11931 have t)
11932 (setq current org-default-priority))
11933 (cond
11934 ((eq action 'set)
11935 (message "Priority A-%c, SPC to remove: " org-lowest-priority)
11936 (setq new (read-char-exclusive))
11937 (cond ((equal new ?\ ) (setq remove t))
11938 ((or (< (upcase new) ?A) (> (upcase new) org-lowest-priority))
11939 (error "Priority must be between `%c' and `%c'"
11940 ?A org-lowest-priority))))
11941 ((eq action 'up)
11942 (setq new (1- current)))
11943 ((eq action 'down)
11944 (setq new (1+ current)))
11945 (t (error "Invalid action")))
11946 (setq new (min (max ?A (upcase new)) org-lowest-priority))
11947 (setq news (format "%c" new))
11948 (if have
11949 (if remove
11950 (replace-match "" t t nil 1)
11951 (replace-match news t t nil 2))
11952 (if remove
11953 (error "No priority cookie found in line")
11954 (looking-at org-todo-line-regexp)
11955 (if (match-end 2)
11956 (progn
11957 (goto-char (match-end 2))
11958 (insert " [#" news "]"))
11959 (goto-char (match-beginning 3))
11960 (insert "[#" news "] ")))))
11961 (if remove
11962 (message "Priority removed")
11963 (message "Priority of current item set to %s" news))))
11966 (defun org-get-priority (s)
11967 "Find priority cookie and return priority."
11968 (save-match-data
11969 (if (not (string-match org-priority-regexp s))
11970 (* 1000 (- org-lowest-priority org-default-priority))
11971 (* 1000 (- org-lowest-priority
11972 (string-to-char (match-string 2 s)))))))
11974 ;;;; Tags
11976 (defun org-scan-tags (action matcher &optional todo-only)
11977 "Scan headline tags with inheritance and produce output ACTION.
11978 ACTION can be `sparse-tree' or `agenda'. MATCHER is a Lisp form to be
11979 evaluated, testing if a given set of tags qualifies a headline for
11980 inclusion. When TODO-ONLY is non-nil, only lines with a TODO keyword
11981 are included in the output."
11983 (mapconcat 'regexp-quote
11984 (nreverse (cdr (reverse org-todo-keywords-1)))
11987 (props (list 'face nil
11988 'done-face 'org-done
11989 'undone-face nil
11990 'mouse-face 'highlight
11991 'org-not-done-regexp org-not-done-regexp
11992 'keymap org-agenda-keymap
11993 'help-echo
11994 (format "mouse-2 or RET jump to org file %s"
11995 (abbreviate-file-name buffer-file-name))))
11996 (case-fold-search nil)
11997 lspos
11998 tags tags-list tags-alist (llast 0) rtn level category i txt
11999 todo marker entry priority)
12000 (save-excursion
12001 (goto-char (point-min))
12002 (when (eq action 'sparse-tree) (org-overview))
12003 (while (re-search-forward re nil t)
12004 (catch :skip
12005 (setq todo (if (match-end 1) (match-string 2))
12006 tags (if (match-end 4) (match-string 4)))
12007 (goto-char (setq lspos (1+ (match-beginning 0))))
12008 (setq level (funcall outline-level)
12009 category (org-get-category))
12010 (setq i llast llast level)
12011 ;; remove tag lists from same and sublevels
12012 (while (>= i level)
12013 (when (setq entry (assoc i tags-alist))
12014 (setq tags-alist (delete entry tags-alist)))
12015 (setq i (1- i)))
12016 ;; add the nex tags
12017 (when tags
12018 (setq tags (mapcar 'downcase (org-split-string tags ":"))
12019 tags-alist
12020 (cons (cons level tags) tags-alist)))
12021 ;; compile tags for current headline
12022 (setq tags-list
12023 (if org-use-tag-inheritance
12024 (apply 'append (mapcar 'cdr tags-alist))
12025 tags))
12026 (when (and (or (not todo-only) todo)
12027 (eval matcher)
12028 (or (not org-agenda-skip-archived-trees)
12029 (not (member org-archive-tag tags-list))))
12030 (and (eq action 'agenda) (org-agenda-skip))
12031 ;; list this headline
12032 (if (eq action 'sparse-tree)
12033 (progn
12034 (org-show-context 'tags-tree))
12035 (setq txt (org-format-agenda-item
12036 ""
12037 (concat
12038 (if org-tags-match-list-sublevels
12039 (make-string (1- level) ?.) "")
12040 (org-get-heading))
12041 category tags-list)
12042 priority (org-get-priority txt))
12043 (goto-char lspos)
12044 (setq marker (org-agenda-new-marker))
12045 (org-add-props txt props
12046 'org-marker marker 'org-hd-marker marker 'org-category category
12047 'priority priority)
12048 (push txt rtn))
12049 ;; if we are to skip sublevels, jump to end of subtree
12050 (or org-tags-match-list-sublevels (org-end-of-subtree t))))))
12051 (when (and (eq action 'sparse-tree)
12052 (not org-sparse-tree-open-archived-trees))
12053 (org-hide-archived-subtrees (point-min) (point-max)))
12054 (nreverse rtn)))
12056 (defvar todo-only) ;; dynamically scoped
12058 (defun org-tags-sparse-tree (&optional todo-only match)
12059 "Create a sparse tree according to tags string MATCH.
12060 MATCH can contain positive and negative selection of tags, like
12062 If optional argument TODO_ONLY is non-nil, only select lines that are
12063 also TODO lines."
12064 (interactive "P")
12065 (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only))
12067 (defun org-make-tags-matcher (match)
12068 "Create the TAGS//TODO matcher form for the selection string MATCH."
12069 ;; todo-only is scoped dynamically into this function, and the function
12070 ;; may change it it the matcher asksk for it.
12071 (unless match
12072 ;; Get a new match request, with completion
12073 (setq org-last-tags-completion-table
12074 (or org-tag-alist
12075 org-last-tags-completion-table))
12076 (setq match (completing-read
12077 "Match: " 'org-tags-completion-function nil nil nil
12078 'org-tags-history)))
12080 ;; Parse the string and create a lisp form
12081 (let ((match0 match)
12083 minus tag mm
12084 tagsmatch todomatch tagsmatcher todomatcher kwd matcher
12085 orterms term orlist re-p level-p)
12086 (if (string-match "/+" match)
12087 ;; match contains also a todo-matching request
12088 (progn
12089 (setq tagsmatch (substring match 0 (match-beginning 0))
12090 todomatch (substring match (match-end 0)))
12091 (if (string-match "^!" todomatch)
12092 (setq todo-only t todomatch (substring todomatch 1)))
12094 (setq todomatch nil)))
12095 ;; only matching tags
12096 (setq tagsmatch match todomatch nil))
12098 ;; Make the tags matcher
12100 (setq tagsmatcher t)
12101 (setq orterms (org-split-string tagsmatch "|") orlist nil)
12102 (while (setq term (pop orterms))
12104 (setq term (concat term "|" (pop orterms)))) ; repair bad split
12105 (while (string-match re term)
12106 (setq minus (and (match-end 1)
12107 (equal (match-string 1 term) "-"))
12108 tag (match-string 2 term)
12109 re-p (equal (string-to-char tag) ?{)
12110 level-p (match-end 3)
12111 mm (cond
12112 (re-p `(org-match-any-p ,(substring tag 1 -1) tags-list))
12113 (level-p `(= level ,(string-to-number
12114 (match-string 3 term))))
12115 (t `(member ,(downcase tag) tags-list)))
12116 mm (if minus (list 'not mm) mm)
12117 term (substring term (match-end 0)))
12118 (push mm tagsmatcher))
12119 (push (if (> (length tagsmatcher) 1)
12120 (cons 'and tagsmatcher)
12121 (car tagsmatcher))
12122 orlist)
12123 (setq tagsmatcher nil))
12124 (setq tagsmatcher (if (> (length orlist) 1) (cons 'or orlist) (car orlist))))
12126 ;; Make the todo matcher
12128 (setq todomatcher t)
12129 (setq orterms (org-split-string todomatch "|") orlist nil)
12130 (while (setq term (pop orterms))
12131 (while (string-match re term)
12132 (setq minus (and (match-end 1)
12133 (equal (match-string 1 term) "-"))
12134 kwd (match-string 2 term)
12135 re-p (equal (string-to-char kwd) ?{)
12136 term (substring term (match-end 0))
12137 mm (if re-p
12138 `(string-match ,(substring kwd 1 -1) todo)
12139 (list 'equal 'todo kwd))
12140 mm (if minus (list 'not mm) mm))
12141 (push mm todomatcher))
12142 (push (if (> (length todomatcher) 1)
12143 (cons 'and todomatcher)
12144 (car todomatcher))
12145 orlist)
12146 (setq todomatcher nil))
12147 (setq todomatcher (if (> (length orlist) 1)
12148 (cons 'or orlist) (car orlist))))
12150 ;; Return the string and lisp forms of the matcher
12151 (setq matcher (if todomatcher
12152 (list 'and tagsmatcher todomatcher)
12153 tagsmatcher))
12154 (cons match0 matcher)))
12156 (defun org-match-any-p (re list)
12157 "Does re match any element of list?"
12158 (setq list (mapcar (lambda (x) (string-match re x)) list))
12159 (delq nil list))
12161 (defvar org-add-colon-after-tag-completion nil) ;; dynamically skoped param
12162 (defvar org-tags-overlay (org-make-overlay 1 1))
12163 (org-detach-overlay org-tags-overlay)
12165 (defun org-set-tags (&optional arg just-align)
12166 "Set the tags for the current headline.
12167 With prefix ARG, realign all tags in headings in the current buffer."
12168 (interactive "P")
12169 (let* ((re (concat "^" outline-regexp))
12170 (current (org-get-tags))
12171 table current-tags inherited-tags ; computed below when needed
12172 tags p0 c0 c1 rpl)
12173 (if arg
12174 (save-excursion
12175 (goto-char (point-min))
12176 (let ((buffer-invisibility-spec (org-inhibit-invisibility)))
12177 (while (re-search-forward re nil t)
12178 (org-set-tags nil t)
12179 (end-of-line 1)))
12180 (message "All tags realigned to column %d" org-tags-column))
12181 (if just-align
12182 (setq tags current)
12183 ;; Get a new set of tags from the user
12184 (save-excursion
12185 (setq table (or org-tag-alist (org-get-buffer-tags))
12186 org-last-tags-completion-table table
12187 current-tags (org-split-string current ":")
12188 inherited-tags (nreverse
12189 (nthcdr (length current-tags)
12190 (nreverse (org-get-tags-at))))
12191 tags
12192 (if (or (eq t org-use-fast-tag-selection)
12193 (and org-use-fast-tag-selection
12194 (delq nil (mapcar 'cdr table))))
12195 (org-fast-tag-selection current-tags inherited-tags table)
12196 (let ((org-add-colon-after-tag-completion t))
12197 (org-trim
12198 (completing-read "Tags: " 'org-tags-completion-function
12199 nil nil current 'org-tags-history))))))
12200 (while (string-match "[-+&]+" tags)
12201 ;; No boolean logic, just a list
12202 (setq tags (replace-match ":" t t tags))))
12205 (setq tags "")
12206 (unless (string-match ":$" tags) (setq tags (concat tags ":")))
12207 (unless (string-match "^:" tags) (setq tags (concat ":" tags))))
12209 ;; Insert new tags at the correct column
12210 (beginning-of-line 1)
12211 (if (re-search-forward
12213 (point-at-eol) t)
12214 (progn
12215 (if (equal tags "")
12216 (setq rpl "")
12217 (goto-char (match-beginning 0))
12218 (setq c0 (current-column) p0 (point)
12219 c1 (max (1+ c0) (if (> org-tags-column 0)
12220 org-tags-column
12221 (- (- org-tags-column) (length tags))))
12222 rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags)))
12223 (replace-match rpl t t)
12224 (and (not (featurep 'xemacs)) c0 (tabify p0 (point)))
12225 tags)
12226 (error "Tags alignment failed")))))
12228 (defun org-tags-completion-function (string predicate &optional flag)
12229 (let (s1 s2 rtn (ctable org-last-tags-completion-table)
12230 (confirm (lambda (x) (stringp (car x)))))
12232 (setq s1 (match-string 1 string)
12233 s2 (match-string 2 string))
12234 (setq s1 "" s2 string))
12235 (cond
12236 ((eq flag nil)
12237 ;; try completion
12238 (setq rtn (try-completion s2 ctable confirm))
12239 (if (stringp rtn)
12240 (concat s1 s2 (substring rtn (length s2))
12241 (if (and org-add-colon-after-tag-completion
12242 (assoc rtn ctable))
12243 ":" "")))
12244 )
12245 ((eq flag t)
12246 ;; all-completions
12247 (all-completions s2 ctable confirm)
12248 )
12249 ((eq flag 'lambda)
12250 ;; exact match?
12251 (assoc s2 ctable)))
12252 ))
12254 (defun org-fast-tag-insert (kwd tags face &optional end)
12255 "Insert KDW, and the TAGS, the latter with face FACE. Also inser END."
12256 (insert (format "%-12s" (concat kwd ":"))
12257 (org-add-props (mapconcat 'identity tags " ") nil 'face face)
12258 (or end "")))
12260 (defun org-fast-tag-show-exit (flag)
12261 (save-excursion
12262 (goto-line 3)
12264 (replace-match ""))
12265 (when flag
12266 (end-of-line 1)
12267 (move-to-column (- (window-width) 19) t)
12268 (insert (org-add-props " Next change exits" nil 'face 'org-warning)))))
12270 (defun org-set-current-tags-overlay (current prefix)
12271 (let ((s (concat ":" (mapconcat 'identity current ":") ":")))
12272 (if (featurep 'xemacs)
12273 (org-overlay-display org-tags-overlay (concat prefix s)
12274 'secondary-selection)
12275 (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s)
12276 (org-overlay-display org-tags-overlay (concat prefix s)))))
12278 (defun org-fast-tag-selection (current inherited table)
12279 "Fast tag selection with single keys.
12280 CURRENT is the current list of tags in the headline, INHERITED is the
12281 list of inherited tags, and TABLE is an alist of tags and corresponding keys,
12282 possibly with grouping information.
12283 If the keys are nil, a-z are automatically assigned.
12284 Returns the new tags string, or nil to not change the current settings."
12285 (let* ((maxlen (apply 'max (mapcar
12286 (lambda (x)
12287 (if (stringp (car x)) (string-width (car x)) 0))
12288 table)))
12289 (buf (current-buffer))
12290 (expert (eq org-fast-tag-selection-single-key 'expert))
12291 (buffer-tags nil)
12292 (fwidth (+ maxlen 3 1 3))
12293 (ncol (/ (- (window-width) 4) fwidth))
12294 (i-face 'org-done)
12295 (c-face 'org-todo)
12296 tg cnt e c char c1 c2 ntable tbl rtn
12297 ov-start ov-end ov-prefix
12298 (exit-after-next org-fast-tag-selection-single-key)
12299 groups ingroup)
12300 (save-excursion
12301 (beginning-of-line 1)
12303 (setq ov-start (match-beginning 1)
12304 ov-end (match-end 1)
12305 ov-prefix "")
12306 (setq ov-start (1- (point-at-eol))
12307 ov-end (1+ ov-start))
12309 (setq ov-prefix
12310 (concat
12311 (buffer-substring (1- (point)) (point))
12312 (if (> (current-column) org-tags-column)
12313 " "
12314 (make-string (- org-tags-column (current-column)) ?\ ))))))
12315 (org-move-overlay org-tags-overlay ov-start ov-end)
12316 (save-window-excursion
12317 (if expert
12318 (set-buffer (get-buffer-create " *Org tags*"))
12319 (delete-other-windows)
12320 (split-window-vertically)
12321 (switch-to-buffer-other-window (get-buffer-create " *Org tags*")))
12322 (erase-buffer)
12325 (org-fast-tag-show-exit exit-after-next)
12326 (org-set-current-tags-overlay current ov-prefix)
12327 (setq tbl table char ?a cnt 0)
12328 (while (setq e (pop tbl))
12329 (cond
12330 ((equal e '(:startgroup))
12331 (push '() groups) (setq ingroup t)
12332 (when (not (= cnt 0))
12333 (setq cnt 0)
12335 (insert "{ "))
12336 ((equal e '(:endgroup))
12337 (setq ingroup nil cnt 0)
12339 (t
12340 (setq tg (car e) c2 nil)
12341 (if (cdr e)
12342 (setq c (cdr e))
12343 ;; automatically assign a character.
12344 (setq c1 (string-to-char
12345 (downcase (substring
12346 tg (if (= (string-to-char tg) ?@) 1 0)))))
12347 (if (or (rassoc c1 ntable) (rassoc c1 table))
12348 (while (or (rassoc char ntable) (rassoc char table))
12349 (setq char (1+ char)))
12350 (setq c2 c1))
12351 (setq c (or c2 char)))
12352 (if ingroup (push tg (car groups)))
12353 (setq tg (org-add-props tg nil 'face
12354 (cond
12355 ((member tg current) c-face)
12356 ((member tg inherited) i-face)
12357 (t nil))))
12358 (if (and (= cnt 0) (not ingroup)) (insert " "))
12359 (insert "[" c "] " tg (make-string
12360 (- fwidth 4 (length tg)) ?\ ))
12361 (push (cons tg c) ntable)
12362 (when (= (setq cnt (1+ cnt)) ncol)
12364 (if ingroup (insert " "))
12365 (setq cnt 0)))))
12366 (setq ntable (nreverse ntable))
12368 (goto-char (point-min))
12369 (if (and (not expert) (fboundp 'fit-window-to-buffer))
12370 (fit-window-to-buffer))
12371 (setq rtn
12372 (catch 'exit
12373 (while t
12374 (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free%s%s"
12375 (if groups " [!] no groups" " [!]groups")
12376 (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
12377 (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
12378 (cond
12380 ((= c ?!)
12381 (setq groups (not groups))
12382 (goto-char (point-min))
12383 (while (re-search-forward "[{}]" nil t) (replace-match " ")))
12384 ((= c ?\C-c)
12385 (if (not expert)
12386 (org-fast-tag-show-exit
12387 (setq exit-after-next (not exit-after-next)))
12388 (setq expert nil)
12389 (delete-other-windows)
12390 (split-window-vertically)
12391 (switch-to-buffer-other-window " *Org tags*")
12392 (and (fboundp 'fit-window-to-buffer)
12393 (fit-window-to-buffer))))
12394 ((or (= c ?\C-g)
12395 (and (= c ?q) (not (rassoc c ntable))))
12396 (org-detach-overlay org-tags-overlay)
12397 (setq quit-flag t))
12398 ((= c ?\ )
12399 (setq current nil)
12400 (if exit-after-next (setq exit-after-next 'now)))
12402 (condition-case nil
12403 (setq tg (completing-read
12404 "Tag: "
12405 (or buffer-tags
12406 (with-current-buffer buf
12407 (org-get-buffer-tags)))))
12408 (quit (setq tg "")))
12410 (add-to-list 'buffer-tags (list tg))
12411 (if (member tg current)
12412 (setq current (delete tg current))
12413 (push tg current)))
12414 (if exit-after-next (setq exit-after-next 'now)))
12415 ((setq e (rassoc c ntable) tg (car e))
12416 (if (member tg current)
12417 (setq current (delete tg current))
12418 (loop for g in groups do
12419 (if (member tg g)
12420 (mapcar (lambda (x)
12421 (setq current (delete x current)))
12422 g)))
12423 (push tg current))
12424 (if exit-after-next (setq exit-after-next 'now))))
12426 ;; Create a sorted list
12427 (setq current
12428 (sort current
12429 (lambda (a b)
12430 (assoc b (cdr (memq (assoc a ntable) ntable))))))
12431 (if (eq exit-after-next 'now) (throw 'exit t))
12432 (goto-char (point-min))
12433 (beginning-of-line 2)
12434 (delete-region (point) (point-at-eol))
12435 (org-fast-tag-insert "Current" current c-face)
12436 (org-set-current-tags-overlay current ov-prefix)
12438 (setq tg (match-string 1))
12439 (add-text-properties (match-beginning 1) (match-end 1)
12440 (list 'face
12441 (cond
12442 ((member tg current) c-face)
12443 ((member tg inherited) i-face)
12444 (t nil)))))
12445 (goto-char (point-min)))))
12446 (org-detach-overlay org-tags-overlay)
12447 (if rtn
12448 (mapconcat 'identity current ":")
12449 nil))))
12451 (defun org-get-tags ()
12452 "Get the TAGS string in the current headline."
12453 (unless (org-on-heading-p t)
12454 (error "Not on a heading"))
12455 (save-excursion
12456 (beginning-of-line 1)
12458 (org-match-string-no-properties 1)
12459 "")))
12461 (defun org-get-buffer-tags ()
12462 "Get a table of all tags used in the buffer, for completion."
12463 (let (tags)
12464 (save-excursion
12465 (goto-char (point-min))
12467 (mapc (lambda (x) (add-to-list 'tags x))
12468 (org-split-string (org-match-string-no-properties 1) ":"))))
12469 (mapcar 'list tags)))
12471 ;;;; Timestamps
12473 (defvar org-last-changed-timestamp nil)
12474 (defvar org-time-was-given) ; dynamically scoped parameter
12475 (defvar org-ts-what) ; dynamically scoped parameter
12477 (defun org-time-stamp (arg)
12478 "Prompt for a date/time and insert a time stamp.
12479 If the user specifies a time like HH:MM, or if this command is called
12480 with a prefix argument, the time stamp will contain date and time.
12481 Otherwise, only the date will be included. All parts of a date not
12482 specified by the user will be filled in from the current date/time.
12483 So if you press just return without typing anything, the time stamp
12484 will represent the current date/time. If there is already a timestamp
12485 at the cursor, it will be modified."
12486 (interactive "P")
12487 (let (org-time-was-given time)
12488 (cond
12489 ((and (org-at-timestamp-p)
12490 (eq last-command 'org-time-stamp)
12491 (eq this-command 'org-time-stamp))
12492 (insert "--")
12493 (setq time (let ((this-command this-command))
12494 (org-read-date arg 'totime)))
12495 (org-insert-time-stamp time (or org-time-was-given arg)))
12496 ((org-at-timestamp-p)
12497 (setq time (let ((this-command this-command))
12498 (org-read-date arg 'totime)))
12499 (when (org-at-timestamp-p) ; just to get the match data
12500 (replace-match "")
12501 (setq org-last-changed-timestamp
12502 (org-insert-time-stamp time (or org-time-was-given arg))))
12503 (message "Timestamp updated"))
12504 (t
12505 (setq time (let ((this-command this-command))
12506 (org-read-date arg 'totime)))
12507 (org-insert-time-stamp time (or org-time-was-given arg))))))
12509 (defun org-time-stamp-inactive (&optional arg)
12510 "Insert an inactive time stamp.
12511 An inactive time stamp is enclosed in square brackets instead of angle
12512 brackets. It is inactive in the sense that it does not trigger agenda entries,
12513 does not link to the calendar and cannot be changed with the S-cursor keys.
12514 So these are more for recording a certain time/date."
12515 (interactive "P")
12516 (let (org-time-was-given time)
12517 (setq time (org-read-date arg 'totime))
12518 (org-insert-time-stamp time (or org-time-was-given arg) 'inactive)))
12520 (defvar org-date-ovl (org-make-overlay 1 1))
12521 (org-overlay-put org-date-ovl 'face 'org-warning)
12522 (org-detach-overlay org-date-ovl)
12524 (defvar org-ans1) ; dynamically scoped parameter
12525 (defvar org-ans2) ; dynamically scoped parameter
12527 (defun org-read-date (&optional with-time to-time from-string prompt)
12528 "Read a date and make things smooth for the user.
12529 The prompt will suggest to enter an ISO date, but you can also enter anything
12530 which will at least partially be understood by `parse-time-string'.
12531 Unrecognized parts of the date will default to the current day, month, year,
12532 hour and minute. For example,
12533 3-2-5 --> 2003-02-05
12534 feb 15 --> currentyear-02-15
12535 sep 12 9 --> 2009-09-12
12536 12:45 --> today 12:45
12537 22 sept 0:34 --> currentyear-09-22 0:34
12538 12 --> currentyear-currentmonth-12
12539 Fri --> nearest Friday (today or later)
12540 +4 --> four days from today (only if +N is the only thing given)
12541 etc.
12542 The function understands only English month and weekday abbreviations,
12543 but this can be configured with the variables `parse-time-months' and
12544 `parse-time-weekdays'.
12546 While prompting, a calendar is popped up - you can also select the
12547 date with the mouse (button 1). The calendar shows a period of three
12548 months. To scroll it to other months, use the keys `>' and `<'.
12549 If you don't like the calendar, turn it off with
12550 \(setq org-popup-calendar-for-date-prompt nil)
12552 With optional argument TO-TIME, the date will immediately be converted
12553 to an internal time.
12554 With an optional argument WITH-TIME, the prompt will suggest to also
12555 insert a time. Note that when WITH-TIME is not set, you can still
12556 enter a time, and this function will inform the calling routine about
12557 this change. The calling routine may then choose to change the format
12558 used to insert the time stamp into the buffer to include the time."
12559 (require 'parse-time)
12560 (let* ((org-time-stamp-rounding-minutes
12561 (if (equal with-time '(16)) 0 org-time-stamp-rounding-minutes))
12562 (ct (org-current-time))
12563 (default-time
12564 ;; Default time is either today, or, when entering a range,
12565 ;; the range start.
12566 (if (save-excursion
12567 (re-search-backward
12569 (- (point) 20) t))
12570 (apply
12571 'encode-time
12572 (mapcar (lambda(x) (or x 0))
12573 (parse-time-string (match-string 1))))
12574 ct))
12575 (calendar-move-hook nil)
12576 (view-diary-entries-initially nil)
12577 (view-calendar-holidays-initially nil)
12578 (timestr (format-time-string
12579 (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") default-time))
12580 (prompt (concat (if prompt (concat prompt " ") "")
12581 (format "Date and/or time (default [%s]): " timestr)))
12582 ans (org-ans0 "") org-ans1 org-ans2 (deltadays 0)
12583 second minute hour day month year tl wday wday1 pm)
12585 (cond
12586 (from-string (setq ans from-string))
12587 (org-popup-calendar-for-date-prompt
12588 (save-excursion
12589 (save-window-excursion
12590 (calendar)
12591 (calendar-forward-day (- (time-to-days default-time)
12592 (calendar-absolute-from-gregorian
12593 (calendar-current-date))))
12594 (org-eval-in-calendar nil t)
12595 (let* ((old-map (current-local-map))
12596 (map (copy-keymap calendar-mode-map))
12597 (minibuffer-local-map (copy-keymap minibuffer-local-map)))
12598 (org-defkey map (kbd "RET") 'org-calendar-select)
12599 (org-defkey map (if (featurep 'xemacs) [button1] [mouse-1])
12600 'org-calendar-select-mouse)
12631 ;; org-ans0: from prompt
12632 ;; org-ans1: from mouse click
12633 ;; org-ans2: from calendar motion
12643 ;; Help matching ISO dates with single digit month ot day, like 2006-8-11.
12653 t nil ans)))
12654 ;; Help matching am/pm times, because `parse-time-string' does not do that.
12655 ;; If there is a time with am/pm, and *no* time without it, we convert
12656 ;; convert so that matching will be successful.
12677 ;; Weekday was given, but no day, so pick that day in the week
12678 ;; on or after the derived date.
12693 "Eval FORM in the calendar window and return to current window.
12694 Also, store the cursor date in variable org-ans2."
12704 ;; Update the prompt to show new default date
12716 "Return to `org-read-date' with the date currently selected.
12717 This is used by `org-read-date' in a temporary keymap for the calendar buffer."
12726 "Insert a date stamp for the date given by the internal TIME.
12727 WITH-HM means, use the stamp format that includes the time of the day.
12728 INACTIVE means use square brackets instead of angular ones, so that the
12729 stamp will not contribute to the agenda.
12730 PRE and POST are optional strings to be inserted before and after the
12731 stamp.
12732 The command returns the inserted time stamp."
12734 stamp)
12739 stamp))
12742 "Toggle the use of custom time stamp formats."
12763 "Overlay modified time stamp format over timestamp between BED and END."
12785 "Translate all timestamps in STRING to custom format.
12786 But do this only if the variable `org-display-custom-times' is set."
12791 t1 with-hm inactive tf time str beg end)
12800 org-time-stamp-custom-formats)
12809 string)
12812 "Set 0 instead of nil for the first 6 elements of time.
12813 Don't touch the rest."
12818 "Difference between TIMESTAMP-STRING and now in days."
12823 "Is the time in TIMESTAMP-STRING close to the current date?"
12829 "Return to `org-read-date' with the date currently selected.
12830 This is used by `org-read-date' in a temporary keymap for the calendar buffer."
12840 "Check if there are any deadlines due or past due.
12841 A deadline is considered due if it happens within `org-deadline-warning-days'
12842 days from today's date. If the deadline appears in an entry marked DONE,
12843 it is not shown. The prefix arg NDAYS can be used to test that many
12858 org-warn-days)))
12861 "Evaluate a time range by computing the difference between start and end.
12862 Normally the result is just printed in the echo area, but with prefix arg
12863 TO-BUFFER, the result is inserted just after the date stamp into the buffer.
12864 If the time range is actually in a table, the result is inserted into the
12865 next column.
12866 For time difference computation, a year is assumed to be exactly 365
12867 days in order to avoid rounding problems."
12887 ;; (ys (floor (* 365 24 60 60)))
12895 y d h m align)
12898 y 0
12903 y 0
12939 "Parse the standard Org-mode time string.
12940 This should be a lot faster than the normal `parse-time-string'.
12941 If time is not given, defaults to 0:00. However, with optional NODEFAULT,
12942 hour and minute fields will be nil if not given."
12952 nil nil nil)
12956 "Increase the date item at the cursor by one.
12957 If the cursor is on the year, change the year. If it is on the month or
12958 the day, change that.
12959 With prefix ARG, change by that many units."
12964 "Decrease the date item at the cursor by one.
12965 If the cursor is on the year, change the year. If it is on the month or
12966 the day, change that.
12967 With prefix ARG, change by that many units."
12972 "Increase the date in the time stamp by one day.
12973 With prefix ARG, change that many days."
12981 "Decrease the date in the time stamp by one day.
12982 With prefix ARG, change that many days."
12995 "Determine if the cursor is in or at a timestamp."
13015 ans))
13018 "Change the date in the time stamp at point.
13019 The date will be changed by N times WHAT. WHAT can be `day', `month',
13020 `year', `minute', `second'. If WHAT is not given, the cursor position
13021 in the timestamp determines what will be changed."
13023 with-hm inactive
13024 org-ts-what
13025 ts time time0)
13029 org-display-custom-times
13068 ;; Try to recenter the calendar window, if any
13075 "If the calendar is visible, recenter it to DATE."
13086 "Go to the Emacs calendar at the current date.
13087 If there is a time stamp in the current line, go to that date.
13088 A prefix ARG can be used to force the current date."
13107 "Insert time stamp corresponding to cursor date in *Calendar* buffer.
13108 If there is already a time stamp at the cursor position, update it."
13112 ;;; The clock for measuring work time.
13137 "Start the clock on the current item.
13138 If necessary, clock-out of the currently active clock."
13151 ;; First line hast scheduling info, move one further
13169 "Stop the currently running clock.
13170 If there is no running clock, throw an error, unless FAIL-QUIETLY is set."
13205 "Cancel the running clock be removing the start timestamp."
13220 "Sum the times for each subtree.
13221 Puts the resulting times in minutes as a text property on each headline."
13225 org-clock-string
13231 ts te dt
13232 time)
13238 ;; A time
13249 ;; A headline
13263 "Show subtree times in the entire buffer.
13264 If TOTAL-ONLY is non-nil, only show the total time for the entire file
13265 in the echo area."
13279 ;; Arrange to remove the overlays upon next change.
13289 "Put an overlays on the current line, displaying TIME.
13290 If LEVEL is given, prefix time with a corresponding number of stars.
13291 This creates a new overlay and stores it in `org-clock-overlays', so that it
13292 will be easy to remove."
13296 ov tx)
13315 "Remove the occur highlights from the buffer.
13316 BEG and END are ignored. If NOREMOVE is nil, remove this function
13317 from the `before-change-functions' in the current buffer."
13327 "Clock out if the current entry contains the running clock.
13328 This is used to stop the clock after a TODO entry is marked DONE."
13333 org-clock-marker))
13334 ;; Clock out, but don't accept a logging message for this.
13338 org-log-done)))
13345 "Check if the current buffer contains the running clock.
13346 If yes, offer to stop it and to save the buffer with the changes."
13355 "Create a table containing a report about clocked time.
13356 If the buffer contains lines
13357 #+BEGIN: clocktable :maxlevel 3 :emphasize nil
13359 #+END: clocktable
13360 then the table will be inserted between these lines, replacing whatever
13361 is was there before. If these lines are not in the buffer, the table
13362 is inserted at point, surrounded by the special lines.
13363 The BEGIN line can contain parameters. Allowed are:
13364 :maxlevel The maximum level to be included in the table. Default is 3.
13365 :emphasize t/nil, if levell 1 and level 2 should be bold/italic in the table."
13374 "If this is a CLOCK line, update it and return t.
13375 Otherwise, return nil."
13384 ts te h m s)
13386 nil
13400 t)))))
13403 "Return two times bordering a special time range.
13404 Key is a symbol specifying the range and can be one of `today', `yesterday',
13405 `thisweek', `lastweek', `thismonth', `lastmonth', `thisyear', `lastyear'.
13406 A week starts Monday 0:00 and ends Sunday 24:00.
13407 The range is determined relative to TIME. TIME defaults to the current time.
13408 The return value is a cons cell with two internal times like the ones
13409 returned by `current time' or `encode-time'. if AS-STRINGS is non-nil,
13410 the returned times will be formatted strings."
13415 s1 m1 h1 d1 month1 y1 diff ts te fm)
13445 "Write the standard clocktable."
13449 ipos time h m p level hlc hdl maxlevel
13450 ts te cc block)
13469 "]."
13498 hlc
13500 hlc
13508 ;; FIXME: I don't think anybody uses this, ask David
13510 "Return an internal list with clocking information.
13511 This list has one entry for each CLOCK interval.
13512 FIXME: describe the elements."
13516 rtn beg end next cont level title total closedp leafp
13517 clockpos titlepos h m donep)
13542 total title titlepos level leafp)
13543 rtn)
13547 ;;;; Agenda, and Diary Integration
13549 ;;; Define the Org-agenda-mode
13563 "Mode for time-sorted view on action items in Org-mode files.
13565 The following commands are available:
13571 org-agenda-pending-undo-list nil)
13573 ;; Keep global-font-lock-mode from turning on font-lock-mode
13581 ;; Make sure properties are removed when copying text
13586 buffer-substring-filters)))
13589 org-agenda-show-log nil))
13596 "Restricted to single file"
13608 org-agenda-mode-map global-map)
13694 "--"
13701 "--"
13705 "--"
13709 "--"
13716 "--"
13728 ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda 'timeline)]
13732 "--"
13734 "--"
13740 "--"
13742 :style toggle :selected org-agenda-show-log :active (org-agenda-check-type nil 'agenda 'timeline)]
13746 :style toggle :selected org-agenda-use-time-grid :active (org-agenda-check-type nil 'agenda)])
13749 "--"
13751 "--"
13754 ))
13756 ;;; Agenda undo
13768 "Execute BODY if ther is no `org-protected' text property at point."
13774 "Execute body without changing buffer-modified-p."
13779 "Execute BODY while recording undo information in two buffers."
13787 _c1 _c2)
13788 ,@_body
13795 ;; make sure there are undo boundaries
13798 ;; remember which buffer to undo
13800 org-agenda-undo-list)))))
13803 "Undo a remote editing step in the agenda.
13804 This undoes changes both in the agenda buffer and in the remote buffer
13805 that have been changed along."
13811 org-agenda-pending-undo-list org-agenda-undo-list))
13815 buf line cmd rembuf)
13823 buffer-read-only)
13837 "Verify that a real change occurred between the undo lists L1 and L2."
13842 ;;; Agenda dispatch
13849 ;;;###autoload
13851 "Dispatch agenda commands to collect entries to the agenda buffer.
13852 Prompts for a character to select a command. Any prefix arg will be passed
13853 on to the selected command. The default selections are:
13854 g
13855 a Call `org-agenda-list' to display the agenda for current day or week.
13856 t Call `org-todo-list' to display the global todo list.
13857 T Call `org-todo-list' to display the global todo list, select only
13858 entries with a specific TODO keyword (the user gets a prompt).
13859 m Call `org-tags-view' to display headlines with tags matching
13860 a condition (the user is prompted for the condition).
13861 M Like `m', but select only TODO entries, no ordinary headlines.
13862 l Create a timeeline for the current buffer.
13864 More commands can be added by configuring the variable
13865 `org-agenda-custom-commands'. In particular, specific tags and TODO keyword
13866 searches can be pre-defined in this way.
13868 If the current buffer is in Org-mode and visiting a file, you can also
13869 first press `1' to indicate that the agenda should be temporarily (until the
13877 c entry key type match lprops)
13878 ;; Turn off restriction
13883 ;; Remember where this call originated
13891 "Press key for an agenda command:
13892 -------------------------------- C Configure custom agenda commands
13893 a Agenda for current week or day
13894 t List of all TODO entries T Entries with special TODO kwd
13895 m Match a TAGS query M Like m, but only TODO entries
13896 L Timeline for current buffer # List stuck projects (!=configure)
13903 header)))
13924 (org-add-props "1 Restrict call to current buffer 0 Restrict call to region or subtree" nil 'face 'org-table)))
13957 ;; For example the todo list should not need it (but does...)
14006 match ;; The byte compiler incorrectly complains about this. Keep it!
14007 cmd type lprops)
14035 ;;;###autoload
14037 "Run an agenda command in batch mode, send result to STDOUT.
14038 CMD-KEY is a string that is also a key in `org-agenda-custom-commands'.
14039 Paramters are alternating variable names and values that will be bound
14040 before running the agenda command."
14050 "Inhibit read-only for BODY."
14054 "Make sure current buffer is in org-mode. Error if not."
14057 major-mode)))
14060 "Fit the window to the buffer size."
14066 ;;; Agenda file list
14069 "Get the list of agenda files.
14070 Optional UNRESTRICTED means return the full list even if a restriction
14071 is currently in place."
14079 "Edit the list of agenda files.
14080 Depending on setup, this either uses customize to edit the variable
14081 `org-agenda-files', or it visits the file that is holding the list. In the
14082 latter case, the buffer is set up in a way that saving it automatically kills
14083 the buffer and restores the previous window configuration."
14102 "Set new value for the agenda file list and save it correcly."
14113 "Read the list of agenda files from a file."
14120 ;;;###autoload
14122 "Cycle through the files in `org-agenda-files'.
14123 If the current buffer visits an agenda file, find the next one in the list.
14124 If the current buffer does not, find the first agenda file."
14129 file)
14141 "Move/add the current file to the top of the agenda file list.
14142 If the file is not present in the list, it is added to the front. If it is
14143 present, it is moved there. With optional argument TO-END, add/move to the
14144 end of the list."
14150 x had)
14163 "Remove current file from the list of files in variable `org-agenda-files'.
14164 These are the files which are being checked for agenda entries.
14165 Optional argument FILE means, use this file instead of the current."
14174 nil x))
14187 "Make sure FILE exists. If not, ask user what to do."
14198 ;;; Agenda prepare and finalize
14240 "Finishing touch for the agenda buffer, called just before displaying it."
14252 "Create buffers for all agenda files, protect archived trees and comments."
14258 bmp file re)
14285 "Function to be called at each match during agenda construction.
14286 If this function return nil, the current match should not be skipped.
14287 Otherwise, the function must return a position from where the search
14288 should be continued.
14289 Never set this variable using `setq' or so, because then it will apply
14290 to all future agenda commands. Instead, bind it with `let' to scope
14294 "Throw to `:skip' in places that should be skipped.
14295 Also moves point to the end of the skipped region, so that search can
14296 continue from there."
14319 "Return a new agenda marker.
14320 Org-mode keeps a list of these markers and resets them when they are
14321 no longer in use."
14325 m))
14328 "Reset markers created by `org-agenda'. But only if they are old enough."
14331 org-agenda-last-marker-time)
14340 "Get a buffer visiting FILE. If the buffer needs to be created, add
14341 it to the list of buffers which might be released later."
14344 buf ; just return it
14345 ;; Make a new buffer and remember it
14348 buf)))
14351 "Release all buffers in list, asking the user for confirmation when needed.
14352 When a buffer is unmodified, it is just killed. When modified, it is saved
14353 \(if the user agrees) and then killed."
14358 file
14365 "Get the table of categories and positions in current buffer."
14372 nil t)
14375 tbl))
14378 "Get the category applying to position POS."
14394 org-category-table))))))
14395 ;;; Agenda timeline
14398 "Show a time-sorted view of the entries in the current org file.
14399 Only entries with a time stamp of today or later will be listed. With
14401 under the current date.
14402 If the buffer contains an active region, only check the region for
14403 dates."
14416 t doclosed ; always include today
14417 org-timeline-show-empty-dates))
14420 args
14421 s e rtn d emptyp)
14427 ;; Remove past dates from the list of dates.
14430 day-numbers))))
14443 dopast
14444 past)
14452 entry date args)))
14459 ; FIXME: this gives a timezone problem
14460 ; (insert (format-time-string org-agenda-date-format
14461 ; (calendar-time-from-absolute d 0))
14462 ; "\n")
14477 "Return a list of all relevant day numbers from BEG to END buffer positions.
14478 If NO-RANGES is non-nil, include only the start and end dates of a range,
14479 not every single day in the range. If FORCE-TODAY is non-nil, make
14480 sure that TODAY is included in the list. If INACTIVE is non-nil, also
14481 inactive time stamps (those in square brackets) are included.
14482 When EMPTY is non-nil, also include days without any entries."
14484 dates dates1 date day day1 day2 ts1 ts2)
14514 dates)))
14516 ;;; Agenda Daily/Weekly
14525 ;;;###autoload
14527 "Produce a weekly view from all files in variable `org-agenda-files'.
14528 The view will be for the current week, but from the overview buffer you
14529 will be able to go to other weeks.
14531 also be shown, under the current date.
14533 on the days are also shown. See the variable `org-log-done' for how
14534 to turn on logging.
14535 START-DAY defaults to TODAY, or to the most recent match for the weekday
14536 given in `org-agenda-start-on-weekday'.
14537 NDAYS defaults to `org-agenda-ndays'."
14550 nil org-agenda-start-on-weekday))
14557 sd
14565 s e rtn rtnall file date d start-pos end-pos todayp nd)
14568 ;; Make the list of days
14570 nd ndays)
14581 rtnall nil)
14606 rtnall nil)
14612 file date
14615 file date
14630 ; FIXME: this gives a timezone problem
14631 ; (insert (format-time-string org-agenda-date-format
14632 ; (calendar-time-from-absolute d 0)) "\n")
14639 rtnall nd todayp))
14658 ;;; Agenda TODO list
14663 ;;;###autoload
14665 "Show all TODO entries from all agenda file in a single list.
14666 The prefix arg can be used to select a specific TODO keyword and limit
14668 for a keyword. A numeric prefix directly selects the Nth keyword in
14669 `org-todo-keywords-1'."
14683 rtn rtnall files file pos)
14690 ;FIXME (org-set-local 'org-todo-keywords-for-agenda kwds)
14694 rtnall nil)
14718 kwds))
14729 ;;; Agenda tags match
14731 ;;;###autoload
14733 "Show all headlines for all `org-agenda-files' matching a TAGS criterion.
14734 The prefix arg TODO-ONLY limits the search to TODO entries."
14741 rtn rtnall files file pos matcher
14742 buffer)
14750 rtnall nil)
14758 ;; If file does not exist, merror message to agenda
14770 org-agenda-restrict-end)
14795 ;;; Agenda Finding stuck projects
14798 "Regular expression used in skipping subtrees for the agenda.
14799 This is basically a temporary global variable that can be set and then
14806 "Checks if the current subtree contains match for `org-agenda-skip-regexp'.
14807 If yes, it returns the end position of this tree, causing agenda commands
14808 to skip this subtree. This is a function that can be put into
14809 `org-agenda-skip-function' for the duration of a command."
14812 skip)
14818 "Create agenda view for projects that are stuck.
14819 Stuck projects are project that have no next actions. For the definitions
14820 of what a project is and how to check if it stuck, customize the variable
14821 `org-stuck-projects'.
14822 MATCH is being ignored."
14832 org-done-keywords-for-agenda
14834 todo))
14851 gen-re)))))
14862 ;;; Diary integration
14867 "Get the (Emacs Calendar) diary entries for DATE."
14874 entries
14884 ;; No entries
14886 ;; Omit the date and other unnecessary stuff
14888 ;; Add prefix to each line and extend the text properties
14900 ;; Extend the text properties to the beginning of the line
14902 entries)))))
14905 "Remove unwanted stuff in buffer created by `fancy-diary-display'.
14906 This gets rid of the date, the underline under the date, and
14907 the dummy entry installed by `org-mode' to ensure non-empty diary for each
14908 date. It also removes lines that contain only whitespace."
14925 ;; Make sure entries from the diary have the right text properties.
14928 ;; We can rely on the hook, nothing to do
14929 nil
14930 ;; Hook not avaiable, must use advice to make this work
14932 "Make the position visible."
14935 buffer-file-name)
14939 "Add text properties to string, allowing org-mode to act on it."
14942 'keymap org-agenda-keymap
14945 'org-agenda-diary-link t
14949 "Add a dummy entry to the diary.
14950 Needed to avoid empty dates which mess up holiday display."
14951 ;; Catch the error if dealing with the new add-to-diary-alist
14958 ;;;###autoload
14960 "Return diary information from org-files.
14962 It accesses org files and extracts information from those files to be
14963 listed in the diary. The function accepts arguments specifying what
14964 items should be listed. The following arguments are allowed:
14966 :timestamp List the headlines of items containing a date stamp or
14967 date range matching the selected date. Deadlines will
14968 also be listed, on the expiration day.
14970 :deadline List any deadlines past due, or due within
14971 `org-deadline-warning-days'. The listing occurs only
14972 in the diary for *today*, not at any other date. If
14973 an entry is marked DONE, it is no longer listed.
14975 :scheduled List all items which are scheduled for the given date.
14976 The diary for *today* also contains items which were
14977 scheduled earlier and are not yet marked DONE.
14979 :todo List all TODO items from the org-file. This may be a
14980 long list - so this is not turned on by default.
14981 Like deadlines, these entries only show up in the
14982 diary for *today*, not at any other date.
14984 The call in the diary file should look like this:
14986 &%%(org-diary) ~/path/to/some/orgfile.org
14988 Use a separate line for each org file to check. Or, if you omit the file name,
14989 all files listed in `org-agenda-files' will be checked automatically:
14991 &%%(org-diary)
14993 If you don't give any arguments (as in the example above), the default
14994 arguments (:deadline :scheduled :timestamp) are used. So the example above may
14995 also be written as
14997 &%%(org-diary :deadline :timestamp :scheduled)
14999 The function expects the lisp variables `entry' and `date' to be provided
15000 by the caller, because this is how the calendar works. Don't use this
15001 function from a program - use `org-agenda-get-day-entries' instead."
15009 file rtn results)
15010 ;; If this is called during org-agenda, don't return any entries to
15011 ;; the calendar. Org Agenda will list these entries itself.
15019 ;;; Agenda entry finders
15022 "Does the work for `org-diary' and `org-agenda'.
15023 FILE is the path to a file to be checked for entries. DATE is date like
15024 the one returned by `calendar-current-date'. ARGS are symbols indicating
15025 which kind of entries should be extracted. For details about these, see
15026 the documentation of `org-diary'."
15033 arg results rtn)
15035 ;; If file does not exist, make sure an error message ends up in diary
15046 org-agenda-restrict-end)
15048 ;; The way we repeatedly append to `results' makes it O(n^2) :-(
15070 results))))
15073 "Is the current entry marked DONE?"
15079 "Is the cursor inside a date range?"
15094 nil)))
15097 "Return the TODO information for agenda display."
15100 'org-not-done-regexp org-not-done-regexp
15102 'keymap org-agenda-keymap
15103 'help-echo
15106 ;; FIXME: get rid of the \n at some point but watch out
15112 org-not-done-regexp)
15114 marker priority category tags
15115 ee txt beg end)
15151 "Return the date stamp information for agenda display."
15153 'org-not-done-regexp org-not-done-regexp
15155 'keymap org-agenda-keymap
15156 'help-echo
15166 marker hdmarker deadlinep scheduledp donep tmp priority category
15167 ee txt timestr tags)
15177 org-ds-keyword-length))
15184 scheduledp donep
15187 ;; substring should only run to end of time stamp
15221 "Return the logged TODO entries for agenda display."
15223 'org-not-done-regexp org-not-done-regexp
15224 'keymap org-agenda-keymap
15225 'help-echo
15237 marker hdmarker priority category tags closedp
15238 ee txt timestr)
15247 ;; donep (org-entry-is-done-p)
15248 )
15250 ;; substring should only run to end of time stamp
15273 "Return the deadline information for agenda display."
15276 'org-not-done-regexp org-not-done-regexp
15277 'keymap org-agenda-keymap
15278 'help-echo
15284 d2 diff pos pos1 category tags
15285 ee txt head face)
15294 ;; When to show a deadline in the calendar:
15295 ;; If the expiration is within wdays warning time.
15296 ;; Past-due deadlines are only shown on the current date
15322 'org-category category
15325 ee))
15328 "Return the scheduled information for agenda display."
15330 'org-not-done-regexp org-not-done-regexp
15334 'keymap org-agenda-keymap
15335 'help-echo
15341 d2 diff pos pos1 category tags
15342 ee txt head)
15351 ;; When to show a scheduled item in the calendar:
15352 ;; If it is on or past the date.
15368 category tags))))
15377 ee))
15380 "Return the date-range information for agenda display."
15382 'org-not-done-regexp org-not-done-regexp
15384 'keymap org-agenda-keymap
15385 'help-echo
15390 marker hdmarker ee txt d1 d2 s1 s2 timestr category tags pos)
15402 ;; Only allow days between the limits, because the normal
15403 ;; date stamps will catch the limits.
15424 ;; Sort the entries by expiration date.
15427 ;;; Agenda presentation and sorting
15429 ;; FIXME: should I allow spaces around the dash?
15438 "Regular expression to match a plain time or time range.
15439 Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following
15440 groups carry important information:
15441 0 the full match
15442 1 the first time, range or not
15451 "Regular expression to match a timestamp time or time range.
15452 After a match, the following groups carry important information:
15453 0 the full match
15454 1 date plus weekday, for backreferencing to make sure both times on same day
15455 2 the first time, range or not
15459 "A flag, set by `org-compile-prefix-format'.
15462 "A flag, set by `org-compile-prefix-format'.
15466 noprefix)
15467 "Format TXT to be inserted into the agenda buffer.
15468 In particular, it adds the prefix and corresponding text properties. EXTRA
15469 must be a string and replaces the `%s' specifier in the prefix format.
15470 CATEGORY (string, symbol or nil) may be used to overrule the default
15471 category taken from local variable or file name. It will replace the `%c'
15472 specifier in the format. DOTIME, when non-nil, indicates that a
15473 time-of-day should be extracted from TXT for sorting of this entry, and for
15474 the `%t' specifier in the format. When DOTIME is a string, this string is
15475 searched for a time before TXT is. NOPREFIX is a flag and indicates that
15476 only the correctly processes TXT should be returned - this is used by
15477 `org-agenda-change-all-lines'. TAGS can be the tags of the headline."
15479 ;; Diary entries sometimes have extra whitespace at the beginning
15482 org-category
15488 time ; time and tag are needed for the eval of the prefix format
15491 stamp plain s0 s1 s2 rtn)
15493 ;; Extract starting and ending time and move them to prefix
15500 ;; If the times are in TXT (not in DOTIMES), and the prefix will list
15501 ;; them, we might want to remove them there to avoid duplication.
15502 ;; The user can turn this off with a variable.
15507 t))
15509 ;; Normalize the time(s) to 24 hour
15514 ;; Tags are in the string
15517 org-prefix-has-tag))
15522 t t txt))))
15524 ;; Create the final string
15527 ;; Prepare the variables needed in the eval of the compiled format
15533 ;; Evaluate the compiled format
15536 ;; And finally add the text properties
15540 'time-of-day time-of-day
15555 list)))
15560 new time)
15562 ;; don't show empty grid
15568 nil string "" nil
15570 new)
15578 "Compile the prefix format into a Lisp form that can be evaluated.
15579 The resulting form is returned and stored in the variable
15580 `org-prefix-format-compiled'."
15584 org-agenda-prefix-format)
15589 varform vars var e c f opt)
15591 s start)
15604 ""
15614 ;; the old format
15622 "Check string S for a time of day.
15623 If found, return it as a military time number between 0 and 2400.
15624 If not found, return nil.
15625 The optional STRING argument forces conversion into a 5 character wide string
15626 HH:MM."
15651 "Sort and concatenate the agenda items."
15654 list
15672 x)))
15675 "Compare the priorities of string A and B."
15683 "Compare the string values of categories of strings A and B."
15691 "Compare the string values of categories of strings A and B."
15701 "Compare the time-of-day values of strings A and B."
15710 "Predicate for sorting agenda entries."
15711 ;; The following variables will be used when the form is evaluated.
15712 ;; So even though the compiler complains, keep them.
15726 ;;; Agenda commands
15729 "Check if agenda buffer is of allowed type.
15730 If ERROR is non-nil, throw an error, otherwise just return nil."
15732 t
15735 nil)))
15738 "Exit agenda by removing the window or the buffer."
15744 ;; Maybe restore the pre-agenda window configuration.
15747 org-pre-agenda-window-conf
15751 "Exit agenda by removing the window or the buffer.
15752 Also kill all Org-mode buffers which have been loaded by `org-agenda'.
15753 Org-mode buffers visited directly by the user will not be touched."
15760 "Save all Org-mode buffers without user confirmation."
15767 "Rebuild Agenda.
15768 When this is the global TODO list, a prefix argument will be interpreted."
15776 org-agenda-pending-undo-list nil)
15782 "Go to today."
15802 "Go forward in time by `org-agenda-ndays' days.
15803 With prefix ARG, go forward that many times `org-agenda-ndays'."
15809 nil t)))
15814 "Go back in time by `org-agenda-ndays' days.
15815 With prefix ARG, go back that many times `org-agenda-ndays'."
15821 nil t)))
15826 "Switch to weekly view for agenda."
15835 org-starting-day)
15836 nil t)))
15843 "Switch to daily view for agenda."
15852 org-starting-day)
15853 nil t)))
15859 ;; FIXME: this no longer works if user make date format that starts with a blank
15861 "Jump to the next line indicating a date in agenda buffer."
15873 "Jump to the previous line indicating a date in agenda buffer."
15880 ;; Initialize the highlight
15885 "Highlight a region with overlay."
15890 "Detach overlay INDEX."
15893 ;; FIXME this is currently not used.
15903 "Toggle follow mode in an agenda buffer."
15911 "Toggle log mode in an agenda buffer."
15921 "Toggle diary inclusion in an agenda buffer."
15931 "Toggle time grid in an agenda buffer."
15941 "Set the mode name to indicate all the small mode settings."
15960 "Show the priority of the current item.
15961 This priority is composed of the main priority given with the [#A] cookies,
15962 and by additional input from the age of a schedules or deadline entry."
15968 "Show the tags applicable to the current item."
15977 "Go to the Org-mode file which contains the item at point."
15994 "Kill the entry or subtree belonging to the current agenda entry."
16026 "Kill the entry or subtree belonging to the current agenda entry."
16044 "Remove all lines in the agenda that correspond to a given subtree.
16045 The subtree is the one in buffer BUF, starting at BEG and ending at END.
16046 If this information is not given, the function uses the tree at point."
16069 "Follow the link in the current line, if any."
16080 "Go to the Org-mode file which contains the item at point."
16097 "Go to the Org-mode file which contains the item at the mouse click."
16103 "Display the Org-mode file which contains the item at point."
16110 "Display the Org-mode file which contains the item at point and recenter."
16118 "Display the Org-mode file which contains the item at the mouse click."
16124 "Check if the entry is a diary link and abort if yes."
16132 "Show the subtree corresponding to the current entry in an indirect buffer.
16133 This calls the command `org-tree-to-indirect-buffer' from the original
16134 Org-mode buffer.
16135 With numerical prefix arg ARG, go up to this level and then take that tree.
16136 With a C-u prefix, make a separate frame for this tree (i.e. don't use the
16137 dedicated frame)."
16150 "Marker pointing to the headline that last changed its TODO state
16154 "Switch TODO entry to next sequence."
16159 "Switch TODO entry to previous sequence."
16164 "Cycle TODO state of line at point, also in Org-mode file.
16165 This changes the line at point, all other lines in the agenda referring to
16166 the same tree node, and the headline of the tree node in the Org-mode file."
16176 newhead)
16197 "Change all lines in the agenda buffer which match HDMARKER.
16198 The new content of the line will be NEWHEAD (as modified by
16199 `org-format-agenda-item'). HDMARKER is checked with
16200 `equal' against all `org-hd-marker' text properties in the file.
16201 If FIXFACE is non-nil, the face of each item is modified acording to
16202 the new TODO state."
16204 props m pl undone-face done-face finish new dotime cat tags)
16234 undone-face done-face))))
16241 ;; FIXME: allow negative value for org-agenda-align-tags-to-column
16242 ;; See the code in set-tags for the way to do this.
16244 "Align all tags in agenda items to `org-agenda-align-tags-to-column'."
16258 "Increase the priority of line at point, also in Org-mode file."
16263 "Decrease the priority of line at point, also in Org-mode file."
16268 "Set the priority of line at point, also in Org-mode file.
16269 This changes the line at point, all other lines in the agenda referring to
16270 the same tree node, and the headline of the tree node in the Org-mode file."
16279 newhead)
16295 "Get a list of all headline tags applicable at POS.
16296 POS defaults to point. If tags are inherited, the list contains
16297 the targets in the same sequence as the headlines appear, i.e.
16298 the tags of the current headline come last."
16312 tags)))
16316 tags)))
16318 ;; FIXME: should fix the tags property of the agenda line.
16320 "Set tags for the current headline."
16329 newhead)
16347 "Toggle the archive tag for the current entry."
16356 newhead)
16372 "Change the date of this item to one day later."
16391 "Change the date of this item to one day earlier."
16396 "Show new date stamp via text properties."
16397 ;; We use text properties to make this undoable
16406 ;; Use `duplicable' property to trigger undo recording
16421 "Change the date of this item. Date is prompted for, with default today.
16422 The prefix ARG is passed to the `org-time-stamp' command and can therefore
16423 be used to request time specification in the time stamp."
16441 "Schedule the item at point."
16450 ts)
16459 "Schedule the item at point."
16468 ts)
16477 "Return the heading of the current entry, without the stars."
16483 "Start the clock on the currently selected item."
16496 "Stop the currently running clock."
16504 "Cancel the currently running clock."
16512 "Make a diary entry, like the `i' command from the calendar.
16513 All the standard commands work: block, weekly etc."
16529 ; (buf (get-file-buffer (substitute-in-file-name diary-file)))
16538 ;; We implement this by hacking the `calendar-cursor-to-date' function
16539 ;; and the `calendar-mark-ring' variable. Saves a lot of code.
16555 "Execute a calendar command from the agenda, with the date associated to
16556 the cursor position."
16565 ;; the following 3 vars are needed in the calendar
16579 "Display the phases of the moon for the 3 months around the cursor date."
16584 "Display the holidays for the 3 months around the cursor date."
16589 "Display sunrise and sunset for the cursor date.
16590 Latitude and longitude can be specified with the variables
16591 `calendar-latitude' and `calendar-longitude'. When called with prefix
16592 argument, latitude and longitude will be prompted for."
16601 "Open the Emacs calendar with the date at the cursor."
16614 "Compute the Org-mode agenda for the calendar date displayed at the cursor.
16615 This is a command that has to be installed in `calendar-mode-map'."
16619 nil))
16625 date s)
16650 ;;;; Embedded LaTeX
16665 "Toggle the minor `org-cdlatex-mode'.
16666 This mode supports entering LaTeX environment and math in LaTeX fragments
16667 in Org-mode.
16669 nil " OCDL" nil
16674 "Always return t in org-mode buffers.
16675 This is because we want to insert math symbols without dollars even outside
16676 the LaTeX math segments. If Orgmode thinks that point is actually inside
16677 en embedded LaTeX fragement, let texmathp do its job.
16694 "Unconditionally turn on `org-cdlatex-mode'."
16698 "Test if point is inside a LaTeX fragment.
16700 sequence appearing also before point.
16701 Even though the matchers for math are configurable, this function assumes
16703 delimiters are skipped when they have been removed by customization.
16704 The return value is nil, or a cons cell with the delimiter and
16705 and the position of this delimiter.
16707 This function does a reasonably good job, but can locally be fooled by
16708 for example currency specifications. For example it will assume being in
16710 fragments that are properly closed, but during editing, we have to live
16711 with the uncertainty caused by missing closing delimiters. This function
16712 looks only before point, not after."
16731 (when (setq m (re-search-backward "\\(\\\\begin{[^}]*}\\|\\\\(\\|\\\\\\[\\)\\|\\(\\\\end{[^}]*}\\|\\\\)\\|\\\\\\]\\)\\|\\(\\$\\$\\)" lim t))
16735 ;; count $$
16743 "Check if it makes sense to execute `cdlatex-tab', and do it if yes.
16744 It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is
16745 - inside a LaTeX fragment, or
16746 - after the first word in a line, where an abbreviation expansion could
16747 insert a LaTeX environment."
16760 "Execute `cdlatex-sub-superscript' in LaTeX fragments.
16761 Revert to the normal definition outside of these fragments."
16769 "Execute `cdlatex-math-modify' in LaTeX fragments.
16770 Revert to the normal definition outside of these fragments."
16782 "Remove all overlays with LaTeX fragment images in current buffer."
16787 "Preview the LaTeX fragment at point, or all locally or globally.
16788 If the cursor is in a LaTeX fragment, create the image and overlay
16789 it over the source code. If there is no fragment at point, display
16790 all fragments in the current text, from one headline to the next. With
16791 prefix SUBTREE, display all fragments in the current subtree. With a
16792 double prefix `C-u C-u', or when the cursor is before the first headline,
16793 display all fragments in the buffer.
16823 buffer-file-name)))
16829 ;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil)
16830 ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p
16831 ("$" "\\([^$]\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([ .,?;:'\")\000]\\|$\\)" 2 nil)
16838 "Replace LaTeX fragments with links to an image, and produce images."
16847 m n block linkfile movefile ov)
16848 ;; Check if there are old images files with this prefix, and remove them
16852 todir 'full
16854 ;; Check the different regular expressions
16874 txt movefile opt forbuffer)
16882 ov 'end-glyph
16885 ov 'display
16892 ;; This function borrows from Ganesh Swami's latex2png.el
16896 temporary-file-directory))
16925 "-D" dpi
16926 ;;"-x" scale "-y" scale
16928 "-o" pngfile
16929 dvifile)
16932 ;; Use the requested file name and clean up
16936 pngfile))))
16939 "Return an rgb color specification for dvipng."
16947 "Return string to be used as color value for an RGB component."
16950 ;;;; Exporting
16952 ;;; Variables, constants, and parameter plists
16998 "Return the property list with default settings for the export variables."
17002 rtn))
17005 "Return the property list with file-local settings for export."
17010 p key val text options)
17036 o)
17040 options)
17044 p)))
17050 val)))
17051 dir))
17058 rtn line level)
17063 ;; Beginning of a COMMENT subtree. Skip it.
17069 ;; an ordinary comment line
17070 )
17076 ;; a special table line that should be removed
17077 )
17084 \[v] limit export to visible part of outline tree
17086 \[a] export as ASCII
17087 \[h] export as HTML
17088 \[H] export as HTML to temporary buffer
17089 \[b] export as HTML and browse immediately
17090 \[x] export as XOXO
17092 \[i] export current file as iCalendar file
17093 \[I] export all agenda files as iCalendar files
17094 \[c] export agenda files into combined iCalendar file
17096 \[F] publish current file
17097 \[P] publish current project
17098 \[X] publish... (project will be prompted for)
17115 r1 r2 ass)
17417 )
17418 "Entities for TeX->HTML translation.
17422 The list contains HTML entities for Latin-1, Greek and other symbols.
17423 It is supplemented by a number of commonly used TeX macros with appropriate
17426 ;;; General functions for all backends
17429 "Cleanup a buffer substring so that links can be created safely."
17439 rtn p)
17444 ;; Remove license-to-kill stuff
17452 ;; Get the correct stuff before the first headline
17463 ;; Get rid of archived trees
17474 ;; Protect stuff from HTML processing
17500 ;; Find targets in comments and move them out of comments,
17501 ;; but mark them as targets that should be invisible
17506 ;; Remove comments
17511 ;; Find matches for radio targets and turn them into internal links
17518 ;; Find all links that contain a newline and put them into a single line
17520 (while (re-search-forward "\\(\\(\\[\\|\\]\\)\\[[^]]*?\\)[ \t]*\n[ \t]*\\([^]]*\\]\\(\\[\\|\\]\\)\\)" nil t)
17525 ;; Convert LaTeX fragments to images
17530 org-current-export-file)))
17534 ;; Normalize links: Convert angle and plain links into bracket links
17535 ;; Expand link abbreviations
17543 t t)))
17551 t t)))
17558 "]"
17563 t t)))
17565 ;; Find multiline emphasis and put them into single line
17579 rtn))
17582 "Get a title for the current document, from looking at the buffer."
17588 ;; Mark the line so that it will not be exported as normal text.
17592 ;; Return the title string
17596 "Take link text and make a safe target out of it."
17600 'identity
17605 ;; Variable holding the vector with section numbers
17609 "Initialize the vector for the section numbers."
17626 "Return a string with the current section number.
17627 When LEVEL is non-nil, increase section numbers on that level."
17649 string))
17651 ;;; ASCII export
17658 "Export the outline as a pretty ASCII file.
17659 If there is an active region, export only the region.
17660 The prefix ARG specifies how many levels of the outline should become
17661 underlined headlines. The default is 3."
17692 ; (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)"))
17702 region
17703 :skip-before-1st-heading
17707 thetoc have-headings first-heading-pos)
17724 ;; create local variables for all options, to make sure all called
17725 ;; functions get the correct information
17729 org-export-plist-vars)
17732 org-export-headline-levels))
17735 umax))
17737 ;; File header
17755 line)
17756 ;; This is a headline
17762 todo
17766 org-done-keywords)))
17767 ; TODO, not DONE
17771 line lines level))))
17789 thetoc)
17791 ))))
17792 lines)
17797 ;; Remove the quoted HTML tags.
17799 ;; Remove targets
17802 ;; Replace internal links
17806 t nil line)))
17811 ;; a Headline
17820 ;; insert the table of contents
17833 ;; remove display and invisible chars
17849 "Search the subtree below LINE for any TODO entries."
17852 line lv todo)
17860 org-done-keywords))))
17861 ; TODO, not DONE
17866 "Handle quoted HTML for ASCII export."
17869 ;; We just remove the tags for now.
17871 line)
17874 "Insert the string S centered and underline it with character UNDERLINE."
17883 "Insert a new level in ASCII export."
17889 org-export-ascii-bullets))
17891 ;; find the indentation of the next non-empty line
17912 "Create a copy of the visible part of the current buffer, and export it.
17913 The copy is created in a temporary buffer and removed after use.
17914 TYPE is the final key (as a string) that also select the export command in
17915 the `C-c C-e' export dispatcher.
17916 As a special case, if the you type SPC at the prompt, the temporary
17917 org-mode file will not be removed but presented to you so that you can
17918 continue to use it. The prefix arg ARG is passed through to the exporting
17919 command."
17922 (message "Export visible: [a]SCII [h]tml [b]rowse HTML [H]uffer with HTML [x]OXO [ ]keep buffer")
17924 current-prefix-arg))
17938 s e)
17948 ;; Copy all comment lines to the end, to make sure #+ settings are
17949 ;; still available for the second export step. Kind of a hack, but
17950 ;; does do the trick.
17971 s))
17976 s))
17978 ;;; HTML export
17981 "Return a string with current options as keyword options.
17982 Does include HTML export options as well as TODO and CATEGORY stuff."
17984 "#+TITLE: %s
17985 #+AUTHOR: %s
17986 #+EMAIL: %s
17987 #+LANGUAGE: %s
17988 #+TEXT: Some descriptive text to be emitted. Several lines OK.
17990 #+CATEGORY: %s
17991 #+SEQ_TODO: %s
17992 #+TYP_TODO: %s
17993 #+STARTUP: %s %s %s %s %s
17994 #+TAGS: %s
17995 #+ARCHIVE: %s
17996 #+LINK: %s
17997 "
17999 org-export-headline-levels
18000 org-export-with-section-numbers
18001 org-export-with-toc
18002 org-export-preserve-breaks
18003 org-export-html-expand
18004 org-export-with-fixed-width
18005 org-export-with-tables
18006 org-export-with-sub-superscripts
18007 org-export-with-emphasize
18008 org-export-with-TeX-macros
18009 org-export-with-LaTeX-fragments
18010 org-export-skip-text-before-1st-heading
18012 "TODO FEEDBACK VERIFY DONE"
18013 "Me Jason Marie DONE"
18031 org-archive-location
18032 "org file:~/org/%s.org"
18033 ))
18036 "Insert into the buffer a template with information for exporting."
18045 "Toggle the fixed-width export.
18046 If there is no active region, the QUOTE keyword at the current headline is
18047 inserted or removed. When present, it causes the text between this headline
18048 and the next to be exported as fixed-width text, and unmodified.
18049 If there is an active region, this command adds or removes a colon as the
18050 first character of this line. If the first character of a line is a colon,
18051 this line is also exported in fixed-width font."
18059 off)
18089 "Export the outline as HTML and immediately open it with a browser.
18090 If there is an active region, export only the region.
18091 The prefix ARG specifies how many levels of the outline should become
18092 headlines. The default is 3. Lower levels will become bulleted lists."
18098 "Call `org-export-as-html', may be used in batch processing as
18099 emacs --batch
18100 --load=$HOME/lib/emacs/org.el
18102 --visit=MyFile --funcall org-export-as-html-batch"
18106 "Call `org-exort-as-html` with output to a temporary buffer.
18107 No file is created. The prefix ARG is passed through to `org-export-as-html'."
18113 "Export the outline as a pretty HTML file.
18114 If there is an active region, export only the region. The prefix
18115 ARG specifies how many levels of the outline should become
18116 headlines. The default is 3. Lower levels will become bulleted
18117 lists. When HIDDEN is non-nil, don't display the HTML buffer.
18118 EXT-PLIST is a property list with external parameters overriding
18119 org-mode's default settings, but still inferior to file-local
18120 settings. Wehn TEMP-BUFFER-ONLY is non-nil, export to a buffer not
18121 associated with a file."
18129 ext-plist
18134 valid thetoc have-headings first-heading-pos
18141 ;; The following two are dynamically scoped into other
18142 ;; routines below.
18182 buffer-file-coding-system))
18191 region
18192 :emph-multiline t
18193 :for-html t
18194 :skip-before-1st-heading
18196 :add-text
18198 :LaTeX-fragments
18201 table-open type
18202 table-buffer table-orig-buffer
18203 ind start-is-num starter didclose
18204 rpl path desc descp desc1 desc2 link
18205 )
18217 ;; Get the language-dependent settings
18221 ;; Switch to the output buffer
18229 ;; create local variables for all options, to make sure all called
18230 ;; functions get the correct information
18234 org-export-plist-vars)
18236 org-export-headline-levels))
18239 umax))
18240 ;; File header
18246 <head>
18247 <title>%s</title>
18252 %s
18253 </head><body>
18254 "
18256 date time author style))
18268 org-export-html-toplevel-hlevel
18270 org-export-html-toplevel-hlevel)
18271 thetoc)
18276 ;; This is a headline
18285 todo
18289 org-done-keywords)))
18290 ; TODO, not DONE
18294 line lines level))))
18318 ;; Check for targets
18323 t t line))
18326 target-alist))
18337 )))
18338 line)
18339 lines))
18350 ;; end of quote section?
18354 ;; inside a quote section?
18359 ;; verbatim lines
18373 ;; Protected HTML
18387 ;; Horizontal line
18392 ;; make targets to anchors
18400 t t line)))
18404 ; (concat "@<i>" (match-string 1 line) "@</i> ")
18405 t t line)))
18411 t t line)))))
18415 ;; replace "&" by "&", "<" and ">" by "<" and ">"
18416 ;; handle @<..> HTML tags (replace "@>..<" by "<..>")
18417 ;; Also handle sub_superscripts and checkboxes
18420 ;; Format the links
18430 ;; Make an image out of the description if that is so wanted
18436 ;; FIXME: do we need to unescape here somewhere?
18445 ;; standard URL, just check if we need to inline an image
18453 ;; standard URL
18457 ;; FILE link
18460 thefile file-is-image-p search)
18468 t))
18477 ;; make sure this is can be used as target search
18501 ;; TODO items
18513 ;; This is a headline
18520 ;; Close any local lists before inserting a new header line
18526 in-local-list nil))
18530 head-count)
18531 ;; QUOTES
18539 ;; New table starts
18541 ;; Accumulate lines
18553 ;; Normal lines
18556 ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
18557 ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
18560 line)
18567 ;; empty line. Pretend indentation is large.
18569 0
18585 ;; Start new (level of) list
18592 ;; continue current list
18596 ;; we did close a list, normal text follows: need <p>
18602 "<b>[X]</b>"
18604 t t line))))
18606 ;; Empty lines start a new paragraph. If hand-formatted lists
18607 ;; are not fully interpreted, lines starting with "-", "+", "*"
18608 ;; also start a new paragraph.
18611 ;; Check if the line break needs to be conserved
18620 ;; Properly close all local lists and other lists
18623 ;; Close any local lists before inserting a new header line
18629 in-local-list nil))
18632 head-count)
18652 ;; insert the table of contents
18667 ;; remove empty paragraphs and lists
18679 "Find out which HTML converter to use and return the HTML code."
18681 ;; A normal org table
18683 ;; Table made by table.el - test for spanning
18687 nil))
18688 lines)))
18694 hlines))))
18697 ;; We can use my own converter with HTML conversions
18699 ;; Need to use the code generator in table.el, with the original text.
18703 "Format a table into HTML."
18704 ;; Get rid of hlines at beginning and end
18710 ;; Check if the table has a marking column. If yes remove the
18711 ;; column and the special lines
18719 tbopen line fields html)
18731 ;; ignore this line
18733 ;; Break the line into fields
18751 html)))
18756 ;; Put in COL tags with the alignment (unfortuntely often ignored...)
18763 html)
18768 "Check if the table has a marking column.
18769 If yes remove the column and the special lines."
18774 lines))
18777 lines)
18782 nil ; ignore this line
18786 lines))))
18789 "Format a table generated by table.el into HTML.
18790 This conversion does *not* use `table-generate-source' from table.el.
18791 This has the advantage that Org-mode's HTML conversions can be used.
18792 But it has the disadvantage, that no cell- or row-spanning is allowed."
18795 fields html empty)
18805 html
18807 html
18808 "<tr>"
18821 ;; Ignore this line
18823 ;; Break the line into fields and store the fields
18829 field-buffer))
18832 html))
18835 "Format a table into html, using `table-generate-source' from table.el.
18836 This has the advantage that cell- or row-spanning is allowed.
18837 But it has the disadvantage, that Org-mode's HTML conversions cannot be used."
18852 "Format time stamps in string S, or remove them."
18857 ;; never export CLOCK
18872 ;; Line break if line started and ended with time stamp stuff
18874 s
18878 r))))
18881 ;; convert & to &, < to < and > to >
18890 s)
18893 "Remove tags and time staps from lines going into the toc."
18899 s)
18902 "Prepare STRING for HTML export. Applies all active conversions.
18903 If there are links in the string, don't modify these."
18915 "Apply all active conversions to translate special ASCII to HTML."
18931 t t s))
18933 s)
18936 "Create a regular expression which will match a balanced sexp.
18937 Opening delimiter is LEFT, and closing delimiter is RIGHT, both given
18938 as single character strings.
18939 The regexp returned will match the entire expression including the
18940 delimiters. It will also define a single group which contains the
18941 match except for the outermost delimiters. The maximum depth of
18942 stacked delimiters is N. Escaping delimiters is not possible."
18963 ;(let ((s "a\\_b"))
18964 ; (and (string-match org-match-substring-regexp s)
18965 ; (conca t (match-string 1 s) ":::" (match-string 2 s))))
18968 "Convert sub- and superscripts in STRING to HTML."
18981 t t string))))
18984 string))
18986 ;; FIXME: what if the if does not match???????
18988 "Apply emphasis."
18999 string))
19003 "Insert <p>, but first close previous paragraph if any."
19008 "Close paragraph if there is one open."
19013 "Close <li> if necessary."
19018 "Insert a new level in HTML export.
19019 When TITLE is nil, just close all open levels."
19029 ;; If title is nil, this means this function is called to close
19030 ;; all levels, so the rest is done only if title is given
19042 t t title)))
19057 level head-count title level))
19062 "Terminate one level in HTML export."
19066 ;;; iCalendar export
19068 ;;;###autoload
19070 "Export current file as an iCalendar file.
19071 The iCalendar file will be located in the same directory as the Org-mode
19072 file, but with extension `.ics'."
19076 ;;;###autoload
19078 "Export all files in `org-agenda-files' to iCalendar .ics files.
19079 Each iCalendar file will be located in the same directory as the Org-mode
19080 file, but with extension `.ics'."
19084 ;;;###autoload
19086 "Export all files in `org-agenda-files' to a single combined iCalendar file.
19087 The file is stored under the name `org-combined-agenda-icalendar-file'."
19092 "Create iCalendar files for all elements of FILES.
19093 If COMBINE is non-nil, combine all calendar entries into a single large
19094 file and store it under the name `org-combined-agenda-icalendar-file'."
19098 org-export-publishing-directory)))
19099 file ical-file ical-buffer category started org-agenda-new-buffers)
19104 org-combined-agenda-icalendar-file
19137 "Hook run after an iCalendar file has been saved.
19138 The iCalendar buffer is still current when this hook is run.
19139 A good way to use this is to tell a desktop calenndar application to re-read
19143 "Print iCalendar entries for the current Org-mode file to `standard-output'.
19144 When COMBINE is non nil, add the category to each line."
19151 scheduledp deadlinep tmp pri category)
19157 inc t
19167 pos)
19170 ;; donep (org-entry-is-done-p)
19171 ))
19178 t t hd)))
19182 %s
19183 %s
19184 SUMMARY:%s
19185 CATEGORIES:%s
19189 hd category)))
19200 )
19205 t t hd)))
19215 %s
19216 SUMMARY:%s
19217 CATEGORIES:%s
19218 SEQUENCE:1
19219 PRIORITY:%d
19220 STATUS:%s
19222 dts hd category pri status))))))))
19225 "Start an iCalendar file by inserting the header."
19231 VERSION:2.0
19232 X-WR-CALNAME:%s
19233 PRODID:-//%s//Emacs with Org-mode//EN
19234 X-WR-TIMEZONE:%s
19238 "Finish an iCalendar file by inserting the END statement."
19242 "Take a time string S and convert it to iCalendar format.
19243 KEYWORD is added in front, to make a complete line like DTSTART....
19244 When INC is non-nil, increase the hour by two (if time string contains
19245 a time), or the day by one (if it does not contain a time)."
19247 t2 fmt have-time time)
19259 ;;; XOXO export
19267 "Export the org buffer as XOXO.
19268 The XOXO buffer is named *xoxo-<source buffer name>*"
19270 ;; A quickie abstraction
19272 ;; Output everything as XOXO
19285 ;; Check the output buffer is empty.
19287 ;; Kick off the output
19304 ;; Handle level rendering
19321 )
19325 ;; And output the new li
19331 ;; Finally finish off the ol
19337 ;; Finish the buffer off and clean it up.
19342 )))
19345 ;;;; Key bindings
19347 ;; Make `C-c C-x' a prefix key
19350 ;; TAB key with modifiers
19357 ;; The following line is necessary under Suse GNU/Linux
19366 ;; Cursor keys with modifiers
19385 ;;; Extra keys for tty access.
19386 ;; We only set them when really needed because otherwise the
19387 ;; menus don't show the simple keys
19414 ;; All the other keys
19493 "Like `self-insert-command', use overwrite-mode for whitespace in tables.
19494 If the cursor is in a table looking at whitespace, the whitespace is
19495 overwritten, and the table is not marked as requiring realignment."
19499 ;; check if we blank the field, and if that triggers align
19504 ;; got extra space, this field does not determine column width
19506 ;; no extra space, this field may determine column width
19508 t)
19520 "Like `delete-backward-char', insert whitespace at field end in tables.
19521 When deleting backwards, in tables this function will insert whitespace in
19523 still be marked for re-alignment if the field did fill the entire column,
19524 because, in this case the deletion might narrow the column."
19537 ;; noalign: if there were two spaces at the end, this field
19538 ;; does not determine the width of the column.
19543 "Like `delete-char', but insert whitespace at field end in tables.
19544 When deleting characters, in tables this function will insert whitespace in
19546 still be marked for re-alignment if the field did fill the entire column,
19547 because, in this case the deletion might narrow the column."
19561 ;; noalign: if there were two spaces at the end, this field
19562 ;; does not determine the width of the column.
19567 ;; Make `delete-selection-mode' work with org-mode and orgtbl-mode
19573 ;; Make `flyspell-mode' delay after some commands
19579 ;; How to do this: Measure non-white length of current string
19580 ;; If equal to column width, we should realign.
19583 "In MAP, remap the functions given in COMMANDS.
19584 COMMANDS is a list of alternating OLDDEF NEWDEF command names."
19593 ;; If the user wants maximum table support, we need to hijack
19594 ;; some standard editing functions
19602 "Throw an error because Shift-Cursor command was applied in wrong context."
19606 "Global visibility cycling or move to previous table field.
19607 Calls `org-cycle' with argument t, or `org-table-previous-field', depending
19608 on context.
19609 See the individual commands for more information."
19619 "Promote subtree or delete table column.
19620 Calls `org-promote-subtree', `org-outdent-item',
19621 or `org-table-delete-column', depending on context.
19622 See the individual commands for more information."
19631 "Demote subtree or insert table column.
19632 Calls `org-demote-subtree', `org-indent-item',
19633 or `org-table-insert-column', depending on context.
19634 See the individual commands for more information."
19643 "Move subtree up or kill table row.
19644 Calls `org-move-subtree-up' or `org-table-kill-row' or
19645 `org-move-item-up' depending on context. See the individual commands
19646 for more information."
19654 "Move subtree down or insert table row.
19655 Calls `org-move-subtree-down' or `org-table-insert-row' or
19656 `org-move-item-down', depending on context. See the individual
19657 commands for more information."
19666 "Promote heading or move table column to left.
19667 Calls `org-do-promote' or `org-table-move-column', depending on context.
19668 With no specific context, calls the Emacs default `backward-word'.
19669 See the individual commands for more information."
19679 "Demote subtree or move table column to right.
19680 Calls `org-do-demote' or `org-table-move-column', depending on context.
19681 With no specific context, calls the Emacs default `forward-word'.
19682 See the individual commands for more information."
19692 "Move subtree up or move table row up.
19693 Calls `org-move-subtree-up' or `org-table-move-row' or
19694 `org-move-item-up', depending on context. See the individual commands
19695 for more information."
19704 "Move subtree down or move table row down.
19705 Calls `org-move-subtree-down' or `org-table-move-row' or
19706 `org-move-item-down', depending on context. See the individual
19707 commands for more information."
19716 "Increase item in timestamp or increase priority of current headline.
19717 Calls `org-timestamp-up' or `org-priority-up', or `org-previous-item',
19718 depending on context. See the individual commands for more information."
19727 "Decrease item in timestamp or decrease priority of current headline.
19728 Calls `org-timestamp-down' or `org-priority-down', or `org-next-item'
19729 depending on context. See the individual commands for more information."
19737 "Next TODO keyword or timestamp one day later, depending on context."
19745 "Previous TODO keyword or timestamp one day earlier, depending on context."
19753 "Switch to next TODO set."
19760 "Switch to previous TODO set."
19767 "Call `org-table-hline-and-move' or `org-insert-heading' dep. on context."
19774 "Copy region in table or copy current subtree.
19775 Calls `org-table-copy' or `org-copy-subtree', depending on context.
19776 See the individual commands for more information."
19782 "Cut region in table or cut current subtree.
19783 Calls `org-table-copy' or `org-cut-subtree', depending on context.
19784 See the individual commands for more information."
19790 "Paste rectangular region into table, or past subtree relative to level.
19791 Calls `org-table-paste-rectangle' or `org-paste-subtree', depending on context.
19792 See the individual commands for more information."
19799 "Set tags in headline, or update according to changed information at point.
19801 This command does many different things, depending on context:
19803 - If the cursor is in a headline, prompt for tags and insert them
19804 into the current line, aligned to `org-tags-column'. When called
19805 with prefix arg, realign all tags in the current buffer.
19807 - If the cursor is in one of the special #+KEYWORD lines, this
19808 triggers scanning the buffer for these lines and updating the
19809 information.
19811 - If the cursor is inside a table, realign the table. This command
19812 works even if the automatic table editor has been turned off.
19814 - If the cursor is on a #+TBLFM line, re-apply the formulas to
19815 the entire table.
19817 - If the cursor is inside a table created by the table.el package,
19818 activate that table.
19820 - If the current buffer is a remember buffer, close note and file it.
19821 with a prefix argument, file it without further interaction to the default
19822 location.
19824 - If the cursor is on a <<<target>>>, update radio targets and corresponding
19825 links in this buffer.
19827 - If the cursor is on a numbered item in a plain list, renumber the
19828 ordered list."
19833 org-occur-highlights
19834 org-latex-fragment-image-overlays)
19862 ;; Recalculate the table before this line
19873 "Restart Org-mode, to scan again for special lines.
19874 Also updates the keyword regular expressions."
19880 "Goto next table row or insert a newline.
19881 Calls `org-table-next-row' or `newline', depending on context.
19882 See the individual commands for more information."
19891 "Insert a new heading or wrap a region in a table.
19892 Calls `org-insert-heading' or `org-table-wrap-region', depending on context.
19893 See the individual commands for more information."
19900 ;;; Menu entries
19902 ;; Define the Org-mode menus
19909 "--"
19913 "--"
19925 "--"
19932 "--"
19935 ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
19937 "--"
19939 ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"]
19940 ["Iterate all" (lambda () (interactive) (org-table-recalculate '(16))) :active (org-at-table-p) :keys "C-u C-u C-c *"]
19941 "--"
19943 "--"
19948 org-table-toggle-formula-debugger
19951 org-table-toggle-coordinate-overlays
19953 "--"
19955 org-enable-table-editor)]
19959 "--"
19970 "--"
19972 "--"
19980 "--"
19985 "--"
19989 "--"
19994 "--"
19996 "--"
20001 ; ["Check and Tag Children" (org-toggle-archive-tag (4))
20002 ; :active t :keys "C-u C-c C-x C-a"]
20013 "--"
20015 ; ["Check and Move Children" (org-archive-subtree '(4))
20016 ; :active t :keys "C-u C-c C-x C-s"]
20017 )
20018 "--"
20025 ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))]
20026 ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))])
20029 "--"
20033 "--"
20034 ;; FIXME: why is this still here????
20035 ; ["Insert Checkbox" org-insert-todo-heading (org-in-item-p)]
20036 ; ["Toggle Checkbox" org-ctrl-c-ctrl-c (org-at-item-checkbox-p)]
20037 ; ["Insert [n/m] cookie" (progn (insert "[/]") (org-update-checkbox-count))
20038 ; (or (org-on-heading-p) (org-at-item-p))]
20039 ; ["Insert [%] cookie" (progn (insert "[%]") (org-update-checkbox-count))
20040 ; (or (org-on-heading-p) (org-at-item-p))]
20041 ; ["Update Statistics" org-update-checkbox-count t]
20042 )
20054 "--"
20057 "--"
20066 "--"
20073 "--"
20081 "--"
20086 "--"
20089 "--"
20097 "--"
20109 "--"
20115 "--"
20118 "--"
20120 ))
20123 "Read documentation for Org-mode in the info system.
20124 With optional NODE, go directly to that node."
20147 ;;;; Documentation
20150 "Call the customize function with org as argument."
20155 "Create a full customization menu for Org-mode, insert it into the menu."
20162 "--"
20172 ;;;; Miscellaneous stuff
20175 ;;; Generally useful functions
20178 "Return a list of contexts of the current cursor position.
20179 If several contexts apply, all are returned.
20180 Each context entry is a list with a symbol naming the context, and
20181 two positions indicating start and end of the context. Possible
20182 contexts are:
20184 :headline anywhere in a headline
20185 :headline-stars on the leading stars in a headline
20186 :todo-keyword on a TODO keyword (including DONE) in a headline
20187 :tags on the TAGS in a headline
20188 :priority on the priority cookie in a headline
20189 :item on the first line of a plain list item
20190 :item-bullet on the bullet/number of a plain list item
20191 :checkbox on the checkbox in a plain list item
20192 :table in an org-mode table
20193 :table-special on a special filed in a table
20194 :table-table in a table.el table
20195 :link on a hyperlink
20196 :keyword on a keyword: SCHEDULED, DEADLINE, CLOSE,COMMENT, QUOTE.
20197 :target on a <<target>>
20198 :radio-target on a <<<radio-target>>>
20199 :latex-fragment on a LaTeX fragment
20200 :latex-preview on a LaTeX fragment with overlayed preview image
20202 This function expects the position to be visible because it uses font-lock
20203 faces as a help to recognize the following contexts: :table-special, :link,
20204 and :keyword."
20208 ;; First the large context
20227 clist)
20241 ;; Now the small context
20269 ;; FIXME: positions wrong.
20273 clist))
20275 ;; FIXME Compare with at-regexp-p
20277 "Check if point is inside a match of regexp.
20278 Normally only the current line is checked, but you can include NLINES extra
20279 lines both before and after point into the search.
20280 If VISUALLY is set, require that the cursor is not after the match but
20281 really on, so that the block visually is on the match."
20294 "Is point inside a match of REGEXP in the current line?"
20303 nil))))
20306 "Remove duplicate elements from LIST."
20309 res))
20312 "Remove all elements in ELTS from LIST."
20315 list)
20318 "Check if POINT is in match-group GROUP.
20319 If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the
20320 match. If the match group does ot exist or point is not inside it,
20321 return nil."
20327 t)))
20330 "Create a single property list from all plists in PLISTS.
20331 The process starts by copying the first list, and then setting properties
20332 from the other lists. Settings in the last list are the most significant
20333 ones and overrule settings in the other lists."
20335 p v ls)
20341 rtn))
20344 "Move the current line down. With prefix argument, move it past ARG lines."
20347 beg end pos)
20357 "Move the current line up. With prefix argument, move it past ARG lines."
20360 beg end pos)
20370 "Replace %-escapes in STRING with values in TABLE.
20372 The sequences in STRING may contain normal field width and padding information,
20374 so values can contain further %-escapes if they are define later in TABLE."
20376 e re rpl)
20383 string))
20387 "Return a section of LIST, from START to END.
20388 Counting starts at 1."
20397 "Like `find-buffer-visiting' but alway return the base buffer and
20398 not an indirect buffer"
20403 "Return regexp matching the file names of images."
20411 image-file-name-extensions)
20412 image-file-name-extensions)
20413 t)
20417 "Return non-nil if FILE is an image."
20421 ;;; Paragraph filling stuff.
20422 ;; We want this to be just right, so use the full arsenal.
20425 "Indent line like previous, but further if previous was headline or item."
20442 ;; In the paragraph separator we include headlines, because filling
20443 ;; text in a line directly attached to a headline would otherwise
20444 ;; fill the headline as well.
20447 ;; FIXME!!!!!!! (org-set-local 'paragraph-separate "\f\\|[ ]*$")
20448 ;; The paragraph starter includes hand-formatted lists.
20451 ;; Inhibit auto-fill for headers, tables and fixed-width lines.
20452 ;; But only if the user has not turned off tables or fixed-width regions
20454 'auto-fill-inhibit-regexp
20463 ;; We use our own fill-paragraph function, to make sure that tables
20464 ;; and fixed-width regions are not wrapped. That function will pass
20465 ;; through to `fill-paragraph' when appropriate.
20467 ; Adaptive filling: To get full control, first make sure that
20468 ;; `adaptive-fill-regexp' never matches. Then install our own matcher.
20474 "Re-align a table, pass through to fill-paragraph if no table."
20482 ;; For reference, this is the default value of adaptive-fill-regexp
20483 ;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*"
20486 "Return a fill prefix for org-mode files.
20487 In particular, this makes sure hanging paragraphs for hand-formatted lists
20488 work correctly."
20495 ;;;; Functions extending outline functionality
20497 ;; C-a should go to the beginning of a *visible* line, also in the
20498 ;; new outline.el. I guess this should be patched into Emacs?
20500 "Go to the beginning of the current line. If that is invisible, continue
20501 to a visible line beginning. This makes the function of C-a more intuitive."
20506 nil
20523 "Check if point is at a character currently not visible."
20524 ;; Early versions of noutline don't have `outline-invisible-p'.
20530 "Check if point is at a character currently not visible."
20533 ;; Early versions of noutline don't have `outline-invisible-p'.
20549 "Move to the heading line of which the present line is a subheading.
20550 This function considers both visible and invisible heading lines.
20551 With argument, move up ARG levels."
20557 "Goto the next sibling, even if it is invisible.
20558 When PREVIOUS is set, go to the previous sibling instead. Returns t
20559 when a sibling was found. When none is found, return nil and don't
20560 move point."
20564 level l)
20574 nil)))
20577 "Show all siblings of the current headline."
20585 "Show an entry where even the heading is hidden."
20590 "Flag the current heading. FLAG non-nil means make invisible.
20591 When ENTRY is non-nil, show the entire entry."
20594 ;; Check if we should show the entire entry
20603 flag))))
20606 ;; This is an exact copy of the original function, but it uses
20607 ;; `org-back-to-heading', to make it work also in invisible
20608 ;; trees. And is uses an invisible-OK argument.
20609 ;; Under Emacs this is not needed, but the old outline.el needs this fix.
20620 ;; Go to end of line before heading
20623 ;; leave blank line before heading
20628 "Show everything after this heading at deeper levels."
20633 nil))
20636 "Show the body directly following this heading.
20637 Show the heading too, if it is currently invisible."
20646 nil)))
20649 "Make a regular expression for keyword lines."
20651 "^"
20657 ;; Make isearch reveal the necessary context
20659 "Reveal context after isearch exits."
20662 ;; Under XEmacs, the hook is run in the correct place,
20663 ;; we directly show the context.
20665 ;; In Emacs the hook runs *before* restoring the overlays.
20666 ;; So we have to use a one-time post-command-hook to do this.
20667 ;; (Emacs 22 has a special variable, see function `org-mode')
20669 isearch-mode-end-hook-quit)
20670 ;; Only when the isearch was not quitted.
20675 "Remove self from hook, and show context."
20680 ;;;; Address problems with some other packages
20682 ;; Make flyspell not check words in links, to not mess up our keymap
20684 "Don't let flyspell put overlays at active buttons."
20687 ;; Make `bookmark-jump' show the jump location if it was hidden.
20690 ;; We can use the hook
20692 ;; Hook not available, use advice
20694 "Make the position visible."
20698 "Unhide the current position, to show the bookmark location."
20705 ;; Make session.el ignore our circular variable
20709 ;;;; Experimental code
20712 ;;;; Finish up
20718 ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
20719 ;;; org.el ends here