| blob | ee73a2646551a9c673c363a1554216568a17dda3 |
1 ;;;; org.el --- Outline-based notes management and organize
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.68
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-RET -> C-S-RET
165 S-up -> M-p
166 S-down -> M-n
167 S-left -> M--
168 S-right -> M-+
170 If you do not like the alternative keys, take a look at the variable
171 `org-disputed-keys'.
173 This option is only relevant at load-time of Org-mode, and must be set
174 *before* org.el is loaded. Changing it requires a restart of Emacs to
175 become effective."
185 "Keys for which Org-mode and other modes compete.
186 This is an alist, cars are symbols for lookup, 1st element is the default key,
190 "Select a key according to `org-CUA-compatible'."
196 "The ellipsis to use in the Org-mode outline.
197 When nil, just use the standard three dots. When a string, use that instead,
198 and just in Org-mode (which will then use its own display table).
199 Changing this requires executing `M-x org-mode' in a buffer to become
200 effective."
209 "Keywords in Org-mode."
214 "String to mark deadline entries.
215 A deadline is this string, followed by a time stamp. Should be a word,
216 terminated by a colon. You can insert a schedule keyword and
218 Changes become only effective after restarting Emacs."
223 "String to mark scheduled TODO entries.
224 A schedule is this string, followed by a time stamp. Should be a word,
225 terminated by a colon. You can insert a schedule keyword and
227 Changes become only effective after restarting Emacs."
232 "String used as the prefix for timestamps logging closing a TODO entry."
237 "String used as prefix for timestamps clocking work hours on an item."
242 "Entries starting with this keyword will never be exported.
243 An entry can be toggled between COMMENT and normal with
245 Changes become only effective after restarting Emacs."
250 "Entries starting with this keyword will be exported in fixed-width font.
251 Quoting applies only to the text in the entry following the headline, and does
252 not extend beyond the next headline, even if that is lower level.
253 An entry can be toggled between QUOTE and normal with
259 "Regular expression for specifying repeated events.
263 "Options concerning the general structure of Org-mode files."
268 "Options about how to make context of a location visible."
273 "Non-nil means, show full hierarchy when revealing a location.
274 Org-mode often shows locations in an org-mode file which might have
275 been invisible before. When this is set, the hierarchy of headings
276 above the exposed location is shown.
277 Turning this off for example for sparse trees makes them very compact.
278 Instead of t, this can also be an alist specifying this option for different
279 contexts. Valid contexts are
280 agenda when exposing an entry from the agenda
281 org-goto when using the command `org-goto' on key C-c C-j
282 occur-tree when using the command `org-occur' on key C-c /
283 tags-tree when constructing a sparse tree based on tags matches
284 link-search when exposing search matches associated with a link
285 mark-goto when exposing the jump goal of a mark
286 bookmark-jump when exposing a bookmark location
287 isearch when exiting from an incremental search
288 default default for all contexts not set explicitly"
308 "Non-nil means, show following heading when revealing a location.
309 Org-mode often shows locations in an org-mode file which might have
310 been invisible before. When this is set, the heading following the
311 match is shown.
312 Turning this off for example for sparse trees makes them very compact,
313 but makes it harder to edit the location of the match. In such a case,
315 Instead of t, this can also be an alist specifying this option for different
316 contexts. See `org-show-hierarchy-above' for valid contexts."
336 "Non-nil means, show all sibling heading when revealing a location.
337 Org-mode often shows locations in an org-mode file which might have
338 been invisible before. When this is set, the sibling of the current entry
339 heading are all made visible. If `org-show-hierarchy-above' is t,
340 the same happens on each level of the hierarchy above the current entry.
342 By default this is on for the isearch context, off for all other contexts.
343 Turning this off for example for sparse trees makes them very compact,
344 but makes it harder to edit the location of the match. In such a case,
346 Instead of t, this can also be an alist specifying this option for different
347 contexts. See `org-show-hierarchy-above' for valid contexts."
367 "Options concerning visibility cycling in Org-mode."
372 "Cycle globally if cursor is at beginning of buffer and not at a headline.
373 This makes it possible to do global cycling without having to use S-TAB or
374 C-u TAB. For this special case to work, the first line of the buffer
375 must not be a headline - it may be empty ot some other text. When used in
376 this way, `org-cycle-hook' is disables temporarily, to make sure the
377 cursor stays at the beginning of the buffer.
378 When this option is nil, don't do anything special at the beginning
379 of the buffer."
384 "Where should `org-cycle' emulate TAB.
385 nil Never
386 white Only in completely white lines
387 whitestart Only at the beginning of lines, before the first non-white char.
388 t Everywhere except in headlines
389 If TAB is used in a place where it does not emulate TAB, the current subtree
390 visibility is cycled."
396 ))
399 org-optimize-window-after-visibility-change)
400 "Hook that is run after `org-cycle' has changed the buffer visibility.
401 The function(s) in this hook must accept a single argument which indicates
402 the new state that was set by the most recent `org-cycle' command. The
403 argument is a symbol. After a global state change, it can have the values
404 `overview', `content', or `all'. After a local state change, it can have
405 the values `folded', `children', or `subtree'."
411 "Options concerning structure editing in Org-mode."
416 "Non-nil means, skip even levels and only use odd levels for the outline.
417 This has the effect that two stars are being added/taken away in
418 promotion/demotion commands. It also influences how levels are
419 handled by the exporters.
420 Changing it requires restart of `font-lock-mode' to become effective
421 for fontification also in regions already fontified.
422 You may also set this on a per-file basis by adding one of the following
423 lines to the buffer:
425 #+STARTUP: odd
426 #+STARTUP: oddeven"
432 "Non-nil means, adapt indentation when promoting and demoting.
433 When this is set and the *entire* text in an entry is indented, the
434 indentation is increased by one space in a demotion command, and
435 decreased by one in a promotion command. If any line in the entry
436 body starts at column 0, indentation is not changed at all."
442 "Should `org-insert-heading' leave a blank line before new heading/item?
443 The value is an alist, with `heading' and `plain-list-item' as car,
444 and a boolean flag as cdr."
451 "Hook being run after inserting a new heading."
457 This currently only means, they are never auto-wrapped.
458 When nil, such lines will be treated like ordinary lines.
459 See also the QUOTE keyword."
464 "Options concerning sparse trees in Org-mode."
469 "Non-nil means, highlight all matches that define a sparse tree.
470 The highlights will automatically disappear the next time the buffer is
471 changed by an edit command."
476 "Non-nil means, any change to the buffer will remove temporary highlights.
477 Such highlights are created by `org-occur' and `org-clock-display'.
478 When nil, `C-c C-c needs to be used to get rid of the highlights.
479 The highlights created by `org-preview-latex-fragment' always need
480 `C-c C-c' to be removed."
487 "Hook that is run after `org-occur' has constructed a sparse tree.
488 This can be used to recenter the window to show as much of the structure
489 as possible."
494 "Options concerning plain lists in Org-mode."
499 "Non-nil means, include plain lists into visibility cycling.
500 This means that during cycling, plain list items will *temporarily* be
501 interpreted as outline headlines with a level given by 1000+i where i is the
502 indentation of the bullet. In all other operations, plain list items are
503 not seen as headlines. For example, you cannot assign a TODO keyword to
504 such an item."
509 "The character that makes a line with leading number an ordered list item.
510 Valid values are ?. and ?\). To get both terminators, use t. While
511 ?. may look nicer, it creates the danger that a line with leading
512 number may be incorrectly interpreted as an item. ?\) therefore is
513 the safe choice."
520 "Non-nil means, automatically renumber ordered plain lists.
521 Renumbering happens when the sequence have been changed with
528 "Non-nil means, update checkbox statistics after insert and toggle.
529 When this is set, checkbox statistics is updated each time you either insert
536 "Options concerning archiving in Org-mode."
541 "The tag that marks a subtree as archived.
542 An archived subtree does not open during visibility cycling, and does
543 not contribute to the agenda listings."
549 "Non-nil means, the agenda will skip any items located in archived trees.
550 An archived tree is a tree marked with the tag ARCHIVE."
556 "Non-nil means, `org-cycle' will open archived trees.
557 An archived tree is a tree marked with the tag ARCHIVE.
558 When nil, archived trees will stay folded. You can still open them with
559 normal outline commands like `show-all', but not with the cycling commands."
565 "Non-nil means sparse tree construction shows matches in archived trees.
566 When nil, matches in these trees are highlighted, but the trees are kept in
567 collapsed state."
573 "The location where subtrees should be archived.
574 This string consists of two parts, separated by a double-colon.
576 The first part is a file name - when omitted, archiving happens in the same
577 file. %s will be replaced by the current file name (without directory part).
578 Archiving to a different file is useful to keep archived entries from
579 contributing to the Org-mode Agenda.
581 The part after the double colon is a headline. The archived entries will be
582 filed under that headline. When omitted, the subtrees are simply filed away
583 at the end of the file, as top-level entries.
585 Here are a few examples:
587 If the current file is Projects.org, archive in file
588 Projects.org_archive, as top-level trees. This is the default.
591 Archive in the current file, under the top-level headline
595 Archive in file ~/org/archive.org (absolute path), as top-level trees.
598 Archive in file ./basement (relative path), as level 3 trees
601 You may set this option on a per-file basis by adding to the buffer a
602 line like
604 #+ARCHIVE: basement::** Finished Tasks"
609 "Non-nil means, mark entries as DONE when they are moved to the archive file."
614 "Non-nil means, add a time stamp to entries moved to an archive file.
615 The time stamp will be added directly after the TODO state keyword in the
616 first line, so it is probably best to use this in combinations with
617 `org-archive-mark-done'."
622 "Options concerning tables in Org-mode."
628 When nil, such lines will be treated like ordinary lines.
630 When equal to the symbol `optimized', the table editor will be optimized to
631 do the following:
632 - Automatic overwrite mode in front of whitespace in table fields.
633 This makes the structure of the table stay in tact as long as the edited
634 field does not exceed the column width.
635 - Minimize the number of realigns. Normally, the table is aligned each time
636 TAB or RET are pressed to move to another field. With optimization this
637 happens only if changes to a field might have changed the column width.
638 Optimization requires replacing the functions `self-insert-command',
639 `delete-char', and `backward-delete-char' in Org-mode buffers, with a
640 slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is
641 very good at guessing when a re-align will be necessary, but you can always
644 If you would like to use the optimized version in Org-mode, but the
645 un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'.
647 This variable can be used to turn on and off the table editor during a session,
648 but in order to toggle optimization, a restart is required.
650 See also the variable `org-table-auto-blank-field'."
658 "Non-nil means, use the optimized table editor version for `orgtbl-mode'.
659 In the optimized version, the table editor takes over all simple keys that
660 normally just insert a character. In tables, the characters are inserted
661 in a way to minimize disturbing the table structure (i.e. in overwrite mode
662 for empty fields). Outside tables, the correct binding of the keys is
663 restored.
665 The default for this option is t if the optimized version is also used in
666 Org-mode. See the variable `org-enable-table-editor' for details. Changing
667 this variable requires a restart of Emacs to become effective."
673 % END RECEIVE ORGTBL %n
675 #+ORGTBL: SEND %n orgtbl-to-latex :splice nil :skip 0
676 | | |
679 @c END RECEIVE ORGTBL %n
680 @ignore
681 #+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0
682 | | |
685 <!-- END RECEIVE ORGTBL %n -->
686 <!--
687 #+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0
688 | | |
690 "Templates for radio tables in different major modes.
691 All occurrences of %n in a template will be replaced with the name of the
692 table, obtained by prompting the user."
699 "Settings for tables in Org-mode."
704 "The default size for newly created tables, Columns x Rows."
710 "Regular expression for recognizing numbers in table columns.
711 If a table column contains mostly numbers, it will be aligned to the
712 right. If not, it will be aligned to the left.
714 The default value of this option is a regular expression which allows
715 anything which looks remotely like a number as used in scientific
716 context. For example, all of the following will be considered a
717 number:
718 12 12.2 2.4e-08 2x10^12 4.034+-0.02 2.7(10) >3.5
720 Other options offered by the customize interface are more restrictive."
738 "Fraction of numbers in a column required to make the column align right.
739 In a column all non-white fields are considered. If at least this
740 fraction of fields is matched by `org-table-number-fraction',
741 alignment to the right border applies."
746 "Bahavior of tables during editing in Org-mode."
751 "Non-nil means, automatically re-align table when pressing TAB or RETURN.
753 removal/insertion."
758 "Non-nil means, automatically blank table field when starting to type into it.
759 This only happens when typing immediately after a field motion
760 command (TAB, S-TAB or RET).
761 Only relevant when `org-enable-table-editor' is equal to `optimized'."
766 "Non-nil means, tab in the last column of a table with jump over a hline.
767 If a horizontal separator line is following the current line,
768 `org-table-next-field' can either create a new row before that line, or jump
769 over the line. When this option is nil, a new line will be created before
770 this line."
775 "Non-nil means, TAB will automatically notice a table.el table.
776 When it sees such a table, it moves point into it and - if necessary -
777 calls `table-recognize-table'."
782 "Options concerning tables in Org-mode."
787 "Should org-mode work with table refrences like B3 instead of @3$2?
788 Possible values are:
789 nil never use them
790 from accept as input, do not present for editing
791 t: accept as input and present for editing"
806 calc-angle-mode deg
807 calc-prefer-frac nil
808 calc-symbolic-mode nil
810 calc-display-working-message t
811 )
812 "List with Calc mode settings for use in calc-eval for table formulas.
813 The list must contain alternating symbols (Calc modes variables and values).
814 Don't remove any of the default settings, just change the values. Org-mode
815 relies on the variables to be present in the list."
820 "Non-nil means, TAB and RET evaluate a formula in current table field.
821 If the current field starts with an equal sign, it is assumed to be a formula
822 which should be evaluated as described in the manual and in the documentation
823 string of the command `org-table-eval-formula'. This feature requires the
824 Emacs calc package.
825 When this variable is nil, formula calculation is only available through
831 "Non-nil means, interpret constants in formulas in tables.
832 A constant looks like `$c' or `$Grav' and will be replaced before evaluation
833 by the value given in `org-table-formula-constants', or by a value obtained
834 from the `constants.el' package."
838 ;; FIXME this is also a variable that makes Org-mode files non-portable
839 ;; Maybe I should have a #+ options for constants?
841 "Alist with constant names and values, for use in table formulas.
842 The car of each element is a name of a constant, without the `$' before it.
843 The cdr is the value as a string. For example, if you'd like to use the
844 speed of light in a formula, you would configure
848 and then use it in an equation like `$1*$c'."
855 "Non-nil means, lines marked with |#| or |*| will be recomputed automatically.
856 Automatically means, when TAB or RET or C-c C-c are pressed in the line."
861 "Options concerning links in Org-mode."
866 "buffer-local version of `org-link-abbrev-alist', which see.
871 "Alist of link abbreviations.
872 The car of each element is a string, to be replaced at the start of a link.
874 links in Org-mode buffers can have an optional tag after a double colon, e.g.
876 [[linkkey:tag][description]]
878 If REPLACE is a string, the tag will simply be appended to create the link.
880 also be a function that will be called with the tag as the only argument to
881 create the link. See the manual for examples."
886 "Non-nil means, hide link part and only show description of bracket links.
887 Bracket links are like [[link][descritpion]]. This variable sets the initial
888 state in new org-mode buffers. The setting can then be toggled on a
889 per-buffer basis from the Org->Hyperlinks menu."
894 "How the path name in file links should be stored.
895 Valid values are:
897 relative relative to the current directory, i.e. the directory of the file
898 into which the link is being inserted.
899 absolute absolute path, if possible with ~ for home directory.
900 noabbrev absolute path, no abbreviation of home directory.
901 adaptive Use relative path for files in the current directory and sub-
902 directories of it. For other files, use an absolute path."
911 "Types of links that should be activated in Org-mode files.
912 This is a list of symbols, each leading to the activation of a certain link
913 type. In principle, it does not hurt to turn on most link types - there may
914 be a small gain when turning off unused link types. The types are:
916 bracket The recommended [[link][description]] or [[link]] links with hiding.
917 angular Links in angular brackes that may contain whitespace like
918 <bbdb:Carsten Dominik>.
919 plain Plain links in normal text, no whitespace, like http://google.com.
920 radio Text that is matched by a radio target, see manual for details.
921 tag Tag settings in a headline (link to tag search).
922 date Time stamps (link to calendar).
924 Changing this variable requires a restart of Emacs to become effective."
934 "Options concerning storing links in Org-mode"
939 "Format of the description part of a link to an email or usenet message.
940 The following %-excapes will be replaced by corresponding information:
948 %s subject
949 %m message-id.
951 You may use normal field width specification between the % and the letter.
952 This is for example useful to limit the length of the subject.
966 It should match if the message is from the user him/herself."
971 "Non-nil means, file links from `org-store-link' contain context.
972 A search string will be added to the file name with :: as separator and
973 used to find the context when the link is activated by the command
974 `org-open-at-point'.
976 negates this setting for the duration of the command."
981 "Non-nil means, keep link in list for entire session.
983 The command `org-store-link' adds a link pointing to the current
984 location to an internal list. These links accumulate during a session.
985 The command `org-insert-link' can be used to insert links into any
986 Org-mode file (offering completion for all stored links). When this
988 will be removed from the list, to make completing the unused links
989 more efficient."
994 "Non-nil means, `org-store-link' will create web links to Google groups.
995 When nil, Gnus will be used for such links.
997 negates this setting for the duration of the command."
1002 "Options concerning following links in Org-mode"
1007 "Non-nil means, on links TAB will follow the link.
1008 Needs to be set before org.el is loaded."
1013 "Non-nil means, on links RET will follow the link.
1014 Needs to be set before org.el is loaded."
1019 "Non-nil means, mouse-1 on a link will follow the link.
1020 A longer mouse click will still set point. Does not wortk on XEmacs.
1021 Needs to be set before org.el is loaded."
1026 "Number of different positions to be recorded in the ring
1027 Changing this requires a restart of Emacs to work correctly."
1035 "Setup the frame configuration for following links.
1036 When following a link with Emacs, it may often be useful to display
1037 this link in another window or frame. This variable can be used to
1038 set this up for the different types of links.
1039 For VM, use any of
1040 `vm-visit-folder'
1041 `vm-visit-folder-other-frame'
1042 For Gnus, use any of
1043 `gnus'
1044 `gnus-other-frame'
1045 For FILE, use any of
1046 `find-file'
1047 `find-file-other-window'
1048 `find-file-other-frame'
1049 For the calendar, use the variable `calendar-setup'.
1050 For BBDB, it is currently only possible to display the matches in
1051 another window."
1070 "Non-nil means, use indirect buffer to display infile links.
1071 Activating internal links (from one location in a file to another location
1072 in the same file) normally just jumps to the location. When the link is
1073 activated with a C-u prefix (or with mouse-3), the link is displayed in
1074 another window. When this option is set, the other window actually displays
1075 an indirect buffer clone of the current buffer, to avoid any visibility
1076 changes to the current buffer."
1081 "Non-nil means, `org-open-file' will open non-existing files.
1082 When nil, an error will be generated."
1087 "Function and arguments to call for following mailto links.
1088 This is a list with the first element being a lisp function, and the
1089 remaining elements being arguments to the function. In string arguments,
1090 %a will be replaced by the address, and %s will be replaced by the subject
1091 if one was given like in <mailto:arthur@galaxy.org::this subject>."
1100 "Non-nil means, ask for confirmation before executing shell links.
1101 Shell links can be dangerous, just thing about a link
1103 [[shell:rm -rf ~/*][Google Search]]
1106 but really it would remove your entire home directory.
1107 Therefore I *definitely* advise against setting this variable to nil.
1108 Just change it to `y-or-n-p' of you want to confirm with a single key press
1117 "Non-nil means, ask for confirmation before executing elisp links.
1118 Elisp links can be dangerous, just think about a link
1123 but really it would remove your entire home directory.
1124 Therefore I *definitely* advise against setting this variable to nil.
1125 Just change it to `y-or-n-p' of you want to confirm with a single key press
1136 "Default file applications on a UNIX or GNU/Linux system.
1148 "Default file applications on a MacOS X system.
1150 for some files for which the OS does not have a good default.
1158 'mswindows-shell-execute
1161 "Default file applications on a Windows NT system.
1166 '(
1173 )
1174 "External applications for opening `file:path' items in a document.
1175 Org-mode uses system defaults for different file types, but
1176 you can use this variable to set the application for a given file
1177 extension. The entries in this list are cons cells where the car identifies
1178 files and the cdr the corresponding command. Possible values for the
1179 file identifier are
1181 `directory' Matches a directory
1182 `remote' Matches a remote file, accessible through tramp or efs.
1183 Remote files most likely should be visited through Emacs
1184 because external applications cannot handle such paths.
1185 t Default for all remaining files
1187 Possible values for the command are:
1188 `emacs' The file will be visited by the current Emacs process.
1189 `default' Use the default application for this file type.
1190 string A command to be executed by a shell; %s will be replaced
1191 by the path to the file.
1192 sexp A Lisp form which will be evaluated. The file path will
1193 be available in the Lisp variable `file'.
1194 For more examples, see the system specific constants
1195 `org-file-apps-defaults-macosx'
1196 `org-file-apps-defaults-windowsnt'
1197 `org-file-apps-defaults-gnu'."
1212 "Non-nil means, that the search for the mh-message will be extended to
1213 all folders if the message cannot be found in the folder given in the link.
1214 Searching all folders is very efficient with one of the search engines
1215 supported by MH-E, but will be slow with pick."
1220 "Options concerning interaction with remember.el."
1225 "Directory with org files.
1226 This directory will be used as default to prompt for org files.
1227 Used by the hooks for remember.el."
1232 "Default target for storing notes.
1233 Used by the hooks for remember.el. This can be a string, or nil to mean
1234 the value of `remember-data-file'.
1235 You can set this on a per-template basis with the variable
1236 `org-remember-templates'."
1240 file))
1243 "The headline that should be the default location in the notes file.
1244 When filing remember notes, the cursor will start at that position.
1245 You can set this on a per-template basis with the variable
1246 `org-remember-templates'."
1251 "Templates for the creation of remember buffers.
1252 When nil, just let remember make the buffer.
1253 When not nil, this is a list of 4-element lists. In each entry, the first
1254 element is a character, a unique key to select this template.
1255 The second element is the template. The third element is optional and can
1256 specify a destination file for remember items created with this template.
1257 The default file is given by `org-default-notes-file'. An optional third
1258 element can specify the headline in that file that should be offered
1259 first when the user is asked to file the entry. The default headline is
1260 given in the variable `org-remember-default-headline'.
1262 The template specifies the structure of the remember buffer. It should have
1263 a first line starting with a star, to act as the org-mode headline.
1264 Furthermore, the following %-escapes will be replaced with content:
1266 %^{prompt} prompt the user for a string and replace this sequence with it.
1267 %t time stamp, date only
1268 %T time stamp with date and time
1269 %u, %U like the above, but inactive time stamps
1270 %^t like %t, but prompt for date. Similarly %^T, %^u, %^U
1271 You may define a prompt like %^{Please specify birthday}t
1272 %n user name (taken from `user-full-name')
1273 %a annotation, normally the link created with org-store-link
1274 %i initial content, the region when remember is called with C-u.
1275 If %i is indented, the entire inserted text will be indented
1276 as well.
1278 %? After completing the template, position cursor here.
1280 Apart from these general escapes, you can access information specific to the
1281 link type that is created. For example, calling `remember' in emails or gnus
1282 will record the author and the subject of the message, which you can access
1283 with %:author and %:subject, respectively. Here is a complete list of what
1284 is recorded for each link type.
1286 Link type | Available information
1287 -------------------+------------------------------------------------------
1288 bbdb | %:type %:name %:company
1289 vm, wl, mh, rmail | %:type %:subject %:message-id
1290 | %:from %:fromname %:fromaddress
1291 | %:to %:toname %:toaddress
1293 gnus | %:group, for messages also all email fields
1294 w3, w3m | %:type %:url
1295 info | %:type %:file %:node
1296 calendar | %:type %:date"
1313 "Non-nil means, store new notes at the beginning of a file or entry.
1314 When nil, new notes will be filed to the end of a file or entry."
1323 "Options concerning TODO items in Org-mode."
1328 "Options concerning Progress logging in Org-mode."
1333 "List of TODO entry keywords.
1336 action is required, and will make the entry show up in todo lists, diaries
1337 etc.
1339 additional state where no keyword is present. For details about this
1340 cycling, see also the variable `org-todo-interpretation'
1341 Changes become only effective after restarting Emacs."
1346 ;; FIXME: remove priority as a possible value, this seems to be obsolete.
1348 "Controls how TODO keywords are interpreted.
1349 This variable is only relevant if `org-todo-keywords' contains more than two
1354 to state when executed several times in direct succession. Otherwise, it
1355 switches directly to DONE from any state.
1356 See the manual for more information."
1363 "Hook which is run after the state of a TODO item was changed.
1364 The new state (a string with a TODO keyword, or nil) is available in the
1365 Lisp variable `state'."
1370 "When set, insert a (non-active) time stamp when TODO entry is marked DONE.
1371 When the state of an entry is changed from nothing to TODO, remove a previous
1372 closing date.
1374 This can also be a list of symbols indicating under which conditions
1375 the time stamp recording the action should be annotated with a short note.
1376 Valid members of this list are
1378 done Offer to record a note when marking entries done
1379 state Offer to record a note whenever changing the TODO state
1380 of an item. This is only relevant if TODO keywords are
1381 interpreted as sequence, see variable `org-todo-interpretation'.
1382 When `state' is set, this includes tracking `done'.
1383 clock-out Offer to record a note when clocking out of an item.
1385 A separate window will then pop up and allow you to type a note.
1386 After finishing with C-c C-c, the note will be added directly after the
1387 timestamp, as a plain list item. See also the variable
1388 `org-log-note-headings'.
1390 Logging can also be configured on a per-file basis by adding one of
1391 the following lines anywhere in the buffer:
1393 #+STARTUP: logdone
1394 #+STARTUP: nologging
1395 #+STARTUP: lognotedone
1396 #+STARTUP: lognotestate
1397 #+STARTUP: lognoteclock-out"
1412 "Headings for notes added when clocking out or closing TODO items.
1413 The value is an alist, with the car being a sympol indicating the note
1414 context, and the cdr is the heading to be used. The heading may also be the
1415 empty string.
1416 %t in the heading will be replaced by a time stamp.
1417 %s will be replaced by the new TODO state, in double quotes.
1418 %u will be replaced by the user name.
1419 %U will be replaced by the full user name."
1425 "Heading when changing todo state (todo sequence only)"
1430 "Non-nil means, find REPEAT cookies in entries and apply them.
1431 A repeat cookie looks like REPEAT(+1m) and causes deadlines and schedules
1432 to repeat themselves shifted by a certain amount of time, each time an
1433 entry is marked DONE."
1439 "Priorities in Org-mode."
1444 "The default priority of TODO items.
1445 This is the priority an item get if no explicit priority is given."
1450 "The lowest priority of TODO items. A character like ?A, ?B etc."
1455 "Options concerning time stamps and deadlines in Org-mode."
1460 "Non-nil means, SCHEDULED and DEADLINE timestamps are inserted at point.
1461 When nil, these labeled time stamps are forces into the second line of an
1462 entry, just after the headline. When scheduling from the global TODO list,
1463 the time stamp will always be forced into the second line."
1468 "Formats for `format-time-string' which are used for time stamps.
1472 "Number of minutes to round time stamps to upon insertion.
1473 When zero, insert the time unmodified. Useful rounding numbers
1474 should be factors of 60, so for example 5, 10, 15.
1475 When this is not zero, you can still force an exact time-stamp by using
1476 a double prefix argument to a time-stamp command like `C-c .' or `C-c !'."
1481 "Non-nil means, overlay custom formats over all time stamps.
1482 The formats are defined through the variable `org-time-stamp-custom-formats'.
1483 To turn this on on a per-file basis, insert anywhere in the file:
1484 #+STARTUP: customtime"
1492 "Custom formats for time stamps. See `format-time-string' for the syntax.
1493 These are overlayed over the default ISO format if the variable
1494 `org-display-custom-times' is set."
1499 "Get the right format for a time string."
1504 f)))
1507 "No. of days before expiration during which a deadline becomes active.
1508 This variable governs the display in sparse trees and in the agenda."
1513 "Non-nil means, pop up a calendar when prompting for a date.
1514 In the calendar, the date can be selected with mouse-1. However, the
1515 minibuffer will also be active, and you can simply enter the date as well.
1516 When nil, only the minibuffer will be available."
1521 "Non-nil means, make the calendar window follow timestamp changes.
1522 When a timestamp is modified and the calendar window is visible, it will be
1523 moved to the new date."
1528 "Options concerning tags in Org-mode."
1533 "List of tags allowed in Org-mode files.
1534 When this list is nil, Org-mode will base TAG input on what is already in the
1535 buffer.
1536 The value of this variable is an alist, the car may be (and should) be a
1537 character that is used to select that tag through the fast-tag-selection
1538 interface. See the manual for details."
1548 "Non-nil means, use fast tag selection scheme.
1549 This is a special interface to select and deselect tags with single keys.
1550 When nil, fast selection is never used.
1551 When the symbol `auto', fast selection is used if and only if selection
1552 characters for tags have been configured, either through the variable
1553 `org-tag-alist' or through a #+TAGS line in the buffer.
1554 When t, fast selection is always used and selection keys are assigned
1555 automatically if necessary."
1563 "Non-nil means, fast tag selection exits after first change.
1564 When nil, you have to press RET to exit it.
1565 During fast tag selection, you can toggle this flag with `C-c'.
1566 This variable can also have the value `expert'. In this case, the window
1567 displaying the tags menu is not even shown, until you press C-c again."
1575 "The column to which tags should be indented in a headline.
1576 If this number is positive, it specifies the column. If it is negative,
1577 it means that the tags should be flushright to that column. For example,
1578 -79 works well for a normal 80 character screen."
1583 "Non-nil means, realign tags after pro/demotion of TODO state change.
1584 These operations change the length of a headline and therefore shift
1585 the tags around. With this options turned on, after each such operation
1586 the tags are again aligned to `org-tags-column'."
1591 "Non-nil means, tags in levels apply also for sublevels.
1592 When nil, only the tags directly given in a specific line apply there.
1593 If you turn off this option, you very likely want to turn on the
1594 companion option `org-tags-match-list-sublevels'."
1599 "Non-nil means list also sublevels of headlines matching tag search.
1600 Because of tag inheritance (see variable `org-use-tag-inheritance'),
1601 the sublevels of a headline matching a tag search often also match
1602 the same search. Listing all of them can create very long lists.
1603 Setting this variable to nil causes subtrees of a match to be skipped.
1604 This option is off by default, because inheritance in on. If you turn
1605 inheritance off, you very likely want to turn this option on.
1607 As a special case, if the tag search is restricted to TODO items, the
1608 value of this variable is ignored and sublevels are always checked, to
1609 make sure all corresponding TODO items find their way into the list."
1619 "Options concerning agenda views in Org-mode."
1624 "Variable used by org files to set a category for agenda display.
1625 Such files should use a file variable to set it, for example
1629 or contain a special line
1631 #+CATEGORY: ELisp
1633 If the file does not specify a category, then file's base name
1638 "The files to be used for agenda display.
1642 If the value of the variable is not a list but a single file name, then
1643 the list of agenda files is actually stored and maintained in that file, one
1644 agenda file per line."
1652 "When set, remote killing from the agenda buffer needs confirmation.
1653 When t, a confirmation is always needed. When a number N, confirmation is
1654 only needed when the text to be killed contains more than N non-white lines."
1662 "The key to be installed in `calendar-mode-map' for switching to the agenda.
1663 The command `org-calendar-goto-agenda' will be bound to this key. The
1664 default is the character `c' because then `c' can be used to switch back and
1665 forth between agenda and calendar."
1670 "Options concerning agenda views in Org-mode."
1675 "Custom commands for the agenda.
1676 These commands will be offered on the splash screen displayed by the
1679 (key type match options)
1681 key The key (a single char as a string) to be associated with the command.
1682 type The command type, any of the following symbols:
1683 todo Entries with a specific TODO keyword, in all agenda files.
1684 tags Tags match in all agenda files.
1685 tags-todo Tags match in all agenda files, TODO entries only.
1686 todo-tree Sparse tree of specific TODO keyword in *current* file.
1687 tags-tree Sparse tree with all tags matches in *current* file.
1688 occur-tree Occur sparse tree for *current* file.
1689 match What to search for:
1690 - a single keyword for TODO keyword searches
1691 - a tags match expression for tags searches
1692 - a regular expression for occur searches
1693 options A list of option setttings, similar to that in a let form, so like
1694 this: ((opt1 val1) (opt2 val2) ...)
1696 You can also define a set of commands, to create a composite agenda buffer.
1697 In this case, an entry looks like this:
1699 (key desc (cmd1 cmd2 ...) general-options)
1701 where
1703 desc A description string to be displayed in the dispatcher menu.
1704 cmd An agenda command, similar to the above. However, tree commands
1705 are no allowed, but instead you can get agenda and global todo list.
1706 So valid commands for a set are:
1707 (agenda)
1708 (alltodo)
1709 (stuck)
1714 Each command can carry a list of options, and another set of options can be
1715 given for the whole set of commands. Individual command options take
1716 precedence over the general options."
1775 "How to identify stuck projects.
1776 This is a list of three items:
1777 1. A tags/todo matcher string that is used to identify a project.
1778 The entire tree below a headline matched by this is considered a project.
1779 2. A list of TODO keywords itentifying non-stuck projects.
1780 If the project subtree contains any headline with one of these todo
1781 keywords, the project is consitered to be not stuck.
1782 3. A list of tags identifying non-stuck projects.
1783 If the project subtree contains any headline with one of these tags,
1784 the project is consitered to be not stuck.
1787 or `C-c a #' to produce the list."
1791 (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string))
1792 (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string))))
1796 "Options concerning skipping parts of agenda files."
1801 "Non-nil means, check also the sublevels of a TODO entry for TODO entries.
1802 When nil, the sublevels of a TODO entry are not checked, resulting in
1803 potentially much shorter TODO lists."
1809 "Non-nil means, don't show scheduled entries in the global todo list.
1810 The idea behind this is that by scheduling it, you have already taken care
1811 of this item."
1817 "Non-nil means, don't show near deadline entries in the global todo list.
1818 Near means closer than `org-deadline-warning-days' days.
1819 The idea behind this is that such items will appear in the agenda anyway."
1825 "Non-nil means don't show scheduled items in agenda when they are done.
1826 This is relevant for the daily/weekly agenda, not for the TODO list."
1831 "Non-nil means, `org-timeline' also shows dates without an entry.
1832 When nil, only the days which actually have entries are shown.
1833 When t, all days between the first and the last date are shown.
1834 When an integer, show also empty dates, but if there is a gap of more than
1835 N days, just insert a special line indicating the size of the gap."
1844 "Options concerning initial settings in the Agenda in Org Mode."
1849 "Hook run just before displaying an agenda buffer."
1854 "Non-nil means, mouse-1 on a link will follow the link in the agenda.
1855 A longer mouse click will still set point. Does not wortk on XEmacs.
1856 Needs to be set before org.el is loaded."
1861 "The initial value of follwo-mode in a newly created agenda window."
1866 "Options concerning the windows used by the Agenda in Org Mode."
1871 "How the agenda buffer should be displayed.
1872 Possible values for this option are:
1874 current-window Show agenda in the current window, keeping all other windows.
1875 other-frame Use `switch-to-buffer-other-frame' to display agenda.
1876 other-window Use `switch-to-buffer-other-window' to display agenda.
1877 reorganize-frame Show only two windows on the current frame, the current
1878 window and the agenda.
1879 See also the variable `org-agenda-restore-windows-after-quit'."
1888 "Non-nil means, restore window configuration open exiting agenda.
1889 Before the window configuration is changed for displaying the agenda,
1890 the current status is recorded. When the agenda is exited with
1891 `q' or `x' and this option is set, the old state is restored. If
1892 `org-agenda-window-setup' is `other-frame', the value of this
1893 option will be ignored.."
1898 "How should indirect tree buffers be displayed?
1899 This applies to indirect buffers created with the commands
1901 Valid values are:
1902 current-window Display in the current window
1903 other-window Just display in another window.
1904 dedicated-frame Create one new frame, and re-use it each time.
1905 new-frame Make a new frame each time."
1915 "Options concerning the daily/weekly agenda."
1920 "Number of days to include in overview display.
1921 Should be 1 or 7."
1926 "Non-nil means, start the overview always on the specified weekday.
1927 0 denotes Sunday, 1 denotes Monday etc.
1928 When nil, always start on the current day."
1934 "Non-nil means, `org-agenda' shows every day in the selected range.
1935 When nil, only the days which actually have entries are shown."
1940 "Format string for displaying dates in the agenda.
1941 Used by the daily/weekly agenda and by the timeline. This should be
1942 a format string understood by `format-time-string'.
1943 FIXME: Not used currently, because of timezone problem."
1948 "If non-nil, include in the agenda entries from the Emacs Calendar's diary."
1953 "Set means weekly/daily agenda will always contain all TODO entries.
1954 The TODO entries will be listed at the top of the agenda, before
1955 the entries for specific days."
1960 "Options concerning the time grid in the Org-mode Agenda."
1965 "Non-nil means, show a time grid in the agenda schedule.
1966 A time grid is a set of lines for specific times (like every two hours between
1967 8:00 and 20:00). The items scheduled for a day at specific times are
1968 sorted in between these lines.
1969 For details about when the grid will be shown, and what it will look like, see
1970 the variable `org-agenda-time-grid'."
1976 "----------------"
1979 "The settings for time grid for agenda display.
1980 This is a list of three items. The first item is again a list. It contains
1981 symbols specifying conditions when the grid should be displayed:
1983 daily if the agenda shows a single day
1984 weekly if the agenda shows an entire week
1985 today show grid on current date, independent of daily/weekly display
1986 require-timed show grid only if at least one item has a time specification
1988 The second item is a string which will be places behing the grid time.
1990 The third item is a list of integers, indicating the times that should have
1991 a grid line."
1993 :type
2000 require-timed)
2002 remove-match))
2007 "Options concerning sorting in the Org-mode Agenda."
2022 "Sorting structure for the agenda items of a single day.
2023 This is a list of symbols which will be used in sequence to determine
2024 if an entry should be listed before another entry. The following
2025 symbols are recognized:
2027 time-up Put entries with time-of-day indications first, early first
2028 time-down Put entries with time-of-day indications first, late first
2029 category-keep Keep the default order of categories, corresponding to the
2030 sequence in `org-agenda-files'.
2031 category-up Sort alphabetically by category, A-Z.
2032 category-down Sort alphabetically by category, Z-A.
2033 tag-up Sort alphabetically by last tag, A-Z.
2034 tag-down Sort alphabetically by last tag, Z-A.
2035 priority-up Sort numerically by priority, high priority last.
2036 priority-down Sort numerically by priority, high priority first.
2038 The different possibilities will be tried in sequence, and testing stops
2040 '(time-up category-keep priority-down)
2041 means: Pull out all entries having a specified time of day and sort them,
2042 in order to make a time schedule for the current day the first thing in the
2043 agenda listing for the day. Of the entries without a time indication, keep
2044 the grouped in categories, don't sort the categories, but keep them in
2045 the sequence given in `org-agenda-files'. Within each category sort by
2046 priority.
2048 Leaving out `category-keep' would mean that items will be sorted across
2049 categories by priority."
2062 "Non-nil means, items without time are considered late.
2063 This is only relevant for sorting. When t, items which have no explicit
2064 time like 15:30 will be considered as 99:01, i.e. later than any items which
2065 do have a time. When nil, the default time is before 0:00. You can use this
2066 option to decide if the schedule for today should come before or after timeless
2067 agenda entries."
2072 "Options concerning the entry prefix in the Org-mode agenda display."
2081 "Format specifications for the prefix of items in the agenda views.
2082 An alist with four entries, for the different agenda types. The keys to the
2083 sublists are `agenda', `timeline', `todo', and `tags'. The values
2084 are format strings.
2085 This format works similar to a printf format, with the following meaning:
2088 as given by the CATEGORY keyword or derived from the file name.
2089 %T the *last* tag of the item. Last because inherited tags come
2090 first in the list.
2091 %t the time-of-day specification if one applies to the entry, in the
2092 format HH:MM
2093 %s Scheduling/Deadline information, a short string
2095 All specifiers work basically like the standard `%s' of printf, but may
2096 contain two additional characters: A question mark just after the `%' and
2097 a whitespace/punctuation character just before the final letter.
2099 If the first character after `%' is a question mark, the entire field
2100 will only be included if the corresponding value applies to the
2101 current entry. This is useful for fields which should have fixed
2102 width when present, but zero width when absent. For example,
2104 day is specified, but will completely disappear in entries which do
2105 not contain a time.
2107 If there is punctuation or whitespace character just before the final
2108 format letter, this character will be appended to the field value if
2111 empty, no additional colon would be interted.
2114 - Indent the line with two space characters
2115 - Give the category in a 12 chars wide field, padded with whitespace on
2116 the right (because of `-'). Append a colon if there is a category
2117 (because of `:').
2118 - If there is a time-of-day, put it into a 12 chars wide field. If no
2119 time, don't put in an empty field, just skip it (because of '?').
2120 - Finally, put the scheduling information and append a whitespace.
2122 As another example, if you don't want the time-of-day of entries in
2123 the prefix, you could use:
2127 See also the variables `org-agenda-remove-times-when-in-prefix' and
2128 `org-agenda-remove-tags-when-in-prefix'."
2139 "The compiled version of the most recently used prefix format.
2143 "Non-nil means, remove duplicate time specifications in agenda items.
2144 When the format `org-agenda-prefix-format' contains a `%t' specifier, a
2145 time-of-day specification in a headline or diary entry is extracted and
2146 placed into the prefix. If this option is non-nil, the original specification
2147 \(a timestamp or -range, or just a plain time(range) specification like
2148 11:30-4pm) will be removed for agenda display. This makes the agenda less
2149 cluttered.
2150 The option can be t or nil. It may also be the symbol `beg', indicating
2151 that the time should only be removed what it is located at the beginning of
2152 the headline/diary entry."
2160 "Non-nil means, remove the tags from the headline copy in the agenda.
2161 When this is the symbol `prefix', only remove tags when
2162 `org-agenda-prefix-format' contains a `%T' specifier."
2170 "Shift tags in agenda items to this column."
2175 "Options for embedding LaTeX code into Org-mode"
2182 "Options for creating images from LaTeX fragments.
2183 This is a property list with the following properties:
2186 :scale a scaling factor for the size of the images
2187 :matchers a list indicating which matchers should be used to
2188 find LaTeX fragments. Valid members of this list are:
2198 "Options for exporting org-listings."
2203 "General options for exporting Org-mode files."
2208 "Path to the location where exported files should be located.
2209 This path may be relative to the directory where the Org-mode file lives.
2210 The default is to put them into the same directory as the Org-mode file.
2211 The variable may also be an alist with export types `:html', `:ascii',
2212 `:ical', or `:xoxo' and the corresponding directories. If a direcoty path
2213 is relative, it is interpreted relative to the directory where the exported
2214 Org-mode files lives."
2235 "Terms used in export text, translated to different languages.
2236 Use the variable `org-export-default-language' to set the language,
2237 or use the +OPTION lines for a per-file setting."
2247 "The default language of HTML export, as a string.
2248 This should have an association in `org-export-language-setup'."
2253 "The last level which is still exported as a headline.
2254 Inferior levels will produce itemize lists when exported.
2255 Note that a numeric prefix argument to an exporter function overrides
2256 this setting.
2263 "Non-nil means, add section numbers to headlines when exporting.
2270 "Non-nil means, create a table of contents in exported files.
2271 The TOC contains headlines with levels up to`org-export-headline-levels'.
2272 When an integer, include levels up to N in the toc, this may then be
2273 different from `org-export-headline-levels', but it will not be allowed
2274 to be larger than the number of headline levels.
2275 When nil, no table of contents is made.
2278 ASCII export, and with red color in HTML output, if the option
2279 `org-export-mark-todo-in-toc' is set.
2281 In HTML output, the TOC will be clickable.
2292 "Non-nil means, mark TOC lines that contain any open TODO items."
2297 "Non-nil means, preserve all line breaks when exporting.
2298 Normally, in HTML output paragraphs will be reformatted. In ASCII
2299 export, line breaks will always be preserved, regardless of this variable.
2306 "Whether subtrees with the ARCHIVE tag should be exported.
2307 This can have three different values
2308 nil Do not export, pretend this tree is not present
2309 t Do export the entire tree
2310 headline Only export the headline, but skip the tree below it."
2319 "If nil, do not export time stamps and associated keywords."
2324 "If nil, remove timestamps from the table of contents entries."
2329 "If nil, do not export tags, just remove them from headlines.
2330 If this is the symbol `not-in-toc', tags will be removed from table of
2331 contents entries, but still be shown in the headlines of the document."
2339 "Options for translating special ascii sequences for the export backends."
2344 "Non-nil means, interpret *word*, /word/, and _word_ as emphasized text.
2345 If the export target supports emphasizing text, the word will be
2346 typeset in bold, italic, or underlined, respectively. Works only for
2347 single words, but you can say: I *really* *mean* *this*.
2348 Not all export backends support this.
2356 When this option is turned on, you can use TeX-like syntax for sub- and
2358 considered as a single item - so grouping with {} is normally not
2359 needed. For example, the following things will be parsed as single
2360 sub- or superscripts.
2362 10^24 or 10^tau several digits will be considered 1 item.
2363 10^-12 or 10^-tau a leading sign with digits or a word
2364 x^2-y^3 will be read as x^2 - y^3, because items are
2365 terminated by almost any nonword/nondigit char.
2366 x_{i^2} or x^(2-i) braces or parenthesis do grouping.
2368 Still, ambiguity is possible - so when in doubt use {} to enclose the
2369 sub/superscript.
2370 Not all export backends support this, but HTML does.
2377 "Non-nil means, interpret simple TeX-like macros when exporting.
2379 No only real TeX macros will work here, but the standard HTML entities
2380 for math can be used as macro names as well. For a list of supported
2381 names in HTML export, see the constant `org-html-entities'.
2382 Not all export backends support this.
2390 "Non-nil means, convert LaTeX fragments to images when exporting to HTML.
2392 the first non-white thing on a line. It will also find the math delimiters
2394 display math.
2403 This can be used to have pre-formatted text, fragments of code etc. For
2404 example:
2405 : ;; Some Lisp examples
2406 : (while (defc cnt)
2407 : (ding))
2408 will be looking just like this in also HTML. See also the QUOTE keyword.
2409 Not all export backends support this.
2416 "Number of stacked braces for sub/superscript matching.
2417 This has to be set before loading org.el to be effective."
2422 "Options for exporting tables in Org-mode."
2428 For example:
2430 | Name | Address | Birthday |
2431 |-------------+----------+-----------|
2432 | Arthur Dent | England | 29.2.2100 |
2434 Not all export backends support this.
2441 "Non-nil means, highlight the first table line.
2442 In HTML export, this means use <th> instead of <td>.
2443 In tables created with table.el, this applies to the first table line.
2444 In Org-mode tables, all lines before the first horizontal separator
2445 line will be formatted with <th> tags."
2450 "Remove special lines and marking characters in calculating tables.
2451 This removes the special marking character column from tables that are set
2452 up for spreadsheet calculations. It also removes the entire lines
2453 marked with `!', `_', or `^'. The lines with `$' are kept, because
2454 the values of constants may be useful to have."
2459 "Non-nil means, always export tables created with table.el natively.
2460 Natively means, use the HTML code generator in table.el.
2461 When nil, Org-mode's own HTML generator is used when possible (i.e. if
2462 the table does not use row- or column-spanning). This has the
2463 advantage, that the automatic HTML conversions for math symbols and
2464 sub/superscripts can be applied. Org-mode's HTML generator is also
2465 much faster."
2470 "Options specific for ASCII export of Org-mode files."
2475 "Characters for underlining headings in ASCII export.
2476 In the given sequence, these characters will be used for level 1, 2, ..."
2481 "Bullet characters for headlines converted to lists in ASCII export.
2482 The first character is is used for the first lest level generated in this
2483 way, and so on. If there are more levels than characters given here,
2484 the list will be repeated.
2485 Note that plain lists will keep the same bullets as the have in the
2486 Org-mode file."
2491 "Options specific for XML export of Org-mode files."
2496 "Options specific for HTML export of Org-mode files."
2502 html {
2503 font-family: Times, serif;
2504 font-size: 12pt;
2505 }
2506 .title { text-align: center; }
2507 .todo { color: red; }
2508 .done { color: green; }
2509 .timestamp { color: grey }
2510 .timestamp-kwd { color: CadetBlue }
2511 .tag { background-color:lightblue; font-weight:normal }
2512 .target { background-color: lavender; }
2513 pre {
2514 border: 1pt solid #AEBDCC;
2515 background-color: #F3F5F7;
2516 padding: 5pt;
2517 font-family: courier, monospace;
2518 }
2519 table { border-collapse: collapse; }
2520 td, th {
2521 vertical-align: top;
2522 <!--border: 1pt solid #ADB9CC;-->
2523 }
2524 </style>"
2525 "The default style specification for exported HTML files.
2526 Since there are different ways of setting style information, this variable
2527 needs to contain the full HTML structure to provide a style, including the
2528 surrounding HTML tags. The style specifications should include definitions
2529 for new classes todo, done, title, and deadline. For example, legal values
2530 would be:
2533 p { font-weight: normal; color: gray; }
2534 h1 { color: black; }
2535 .title { text-align: center; }
2536 .todo, .deadline { color: red; }
2537 .done { color: green; }
2538 </style>
2540 or, if you want to keep the style in a file,
2544 As the value of this option simply gets inserted into the HTML <head> header,
2550 "Format for typesetting the document title in HTML export."
2555 "The <H> level for level 1 headings in HTML export."
2560 "Non-nil means, make file links to `file.org' point to `file.html'.
2561 When org-mode is exporting an org-mode file to HTML, links to
2562 non-html files are directly put into a href tag in HTML.
2563 However, links to other Org-mode files (recognized by the
2564 extension `.org.) should become links to the corresponding html
2565 file, assuming that the linked org-mode file will also be
2566 converted to HTML.
2567 When nil, the links still point to the plain `.org' file."
2572 "Non-nil means, inline images into exported HTML pages.
2573 This is done using an <img> tag. When nil, an anchor with href is used to
2574 link to the image. If this option is `maybe', then images in links with
2575 an empty description will be inlined, while images with a description will
2576 be linked only."
2582 ;; FIXME: rename
2584 "Non-nil means, for HTML export, treat @<...> as HTML tag.
2585 When nil, these tags will be exported as plain text and therefore
2586 not be interpreted by a browser.
2594 "The HTML tag used to start a table.
2595 This must be a <table> tag, but you may change the options like
2596 borders and spacing."
2601 "If non-nil, write `org-export-html-html-helper-timestamp'
2602 into the exported HTML text. Otherwise, the buffer will just be saved
2603 to a file."
2609 "The HTML tag used as timestamp delimiter for HTML-helper-mode."
2614 "Options specific for iCalendar export of Org-mode files."
2619 "The file name for the iCalendar file covering all agenda files.
2621 The file name should be absolute."
2626 "Non-nil means, export to iCalendar files should also cover TODO items."
2634 "Calendar name for the combined iCalendar representing all agenda files."
2639 "Font-lock settings for highlighting in Org-mode."
2644 "Non-nil means fontify only the stars in each headline.
2645 When nil, the entire headline is fontified.
2646 Changing it requires restart of `font-lock-mode' to become effective
2647 also in regions already fontified."
2652 "Non-nil means, hide the first N-1 stars in a headline.
2653 This works by using the face `org-hide' for these stars. This
2654 face is white for a light background, and black for a dark
2655 background. You may have to customize the face `org-hide' to
2656 make this work.
2657 Changing it requires restart of `font-lock-mode' to become effective
2658 also in regions already fontified.
2659 You may also set this on a per-file basis by adding one of the following
2660 lines to the buffer:
2662 #+STARTUP: hidestars
2663 #+STARTUP: showstars"
2668 "Non-nil means, change the face of a headline if it is marked DONE.
2669 Normally, only the TODO/DONE keyword indicates the state of a headline.
2670 When this is non-nil, the headline after the keyword is set to the
2671 `org-headline-done' as an additional indication."
2676 "Non-nil means fontify *bold*, /italic/ and _underlined_ text.
2677 Changing this variable requires a restart of Emacs to take effect."
2686 "Set variable and compute the emphasis regular expression."
2690 org-emphasis-alist org-emphasis-regexp-components)
2700 ;; make sure special characters appear at the right position in the class
2705 ; (while (>= (setq nl (1- nl)) 0) (setq body1 (concat body1 "\n?" body "*?")))
2706 ; (while (>= (setq nl (1- nl)) 0) (setq body1 (concat body1 "\\(?:\n?" body "*?\\)?")))
2710 ;; Make the regexp
2717 body1
2725 "Components used to build the reqular expression for emphasis.
2726 This is a list with 6 entries. Terminology: In an emphasis string
2730 specify what is allowed/forbidden in each part:
2732 pre Chars allowed as prematch. Beginning of line will be allowed too.
2733 post Chars allowed as postmatch. End of line will be allowed too.
2734 border The chars *forbidden* as border characters. In addition to the
2735 characters given here, all marker characters are forbidden too.
2737 non-shy groups here, and don't allow newline here.
2738 newline The maximum number of newlines allowed in an emphasis exp.
2739 stacked Non-nil means, allow stacked styles. This works only in HTML
2740 export. When this is set, all marker characters (as given in
2741 `org-emphasis-alist') will be allowed as pre/post, aiding
2742 inside-out matching.
2743 Use customize to modify this, or restart Emacs after changing it."
2760 )
2761 "Special syntax for emphasized text.
2762 Text starting and ending with a special character will be emphasized, for
2763 example *bold*, _underlined_ and /italic/. This variable sets the marker
2764 characters, the face to bbe used by font-lock for highlighting in Org-mode
2765 Emacs buffers, and the HTML tags to be used for this.
2766 Use customize to modify this, or restart Emacs after changing it."
2778 ;;; The faces
2781 "Faces in Org-mode."
2786 "Make a compatible face specification.
2787 XEmacs and Emacs 21 do not know about the `min-colors' attribute.
2788 For them we convert a (min-colors 8) entry to a `tty' entry and move it
2789 to the top of the list. The `min-colors' attribute will be removed from
2790 any other entries, and any resulting duplicates will be removed entirely."
2804 specs))
2809 "Face used to hide leading stars in headlines.
2810 The forground color of this face should be equal to the background
2811 color of the frame."
2822 "Face used for level 1 headlines."
2832 "Face used for level 2 headlines."
2844 "Face used for level 3 headlines."
2856 "Face used for level 4 headlines."
2864 "Face used for level 5 headlines."
2872 "Face used for level 6 headlines."
2880 "Face used for level 7 headlines."
2888 "Face used for level 8 headlines."
2896 "Face used for special keywords."
2906 "Face for deadlines and TODO keywords."
2914 "Face used to indicate that a headline is DONE.
2915 This face is only used if `org-fontify-done-headline' is set."
2928 "Face for headline with the ARCHIVE tag."
2935 "Face for links."
2942 "Face for links."
2947 "Face for tags."
2957 "Face for TODO keywords."
2966 "Face used for DONE."
2977 "Face used for tables."
2987 "Face for formulas."
2996 "Face for items scheduled for a certain day."
3006 "Face for items scheduled previously, and not yet done."
3016 "Face for items scheduled previously, and not yet done."
3024 "Face used for time grids."
3029 org-level-5 org-level-6 org-level-7 org-level-8
3030 ))
3034 ;;; Variables for pre-computed regular expressions, all buffer local
3049 "Matches a headline and puts TODO state into group 2 if present.
3097 rear-nonsticky t mouse-map t fontified t)
3104 s)
3109 s)
3118 "Modified `buffer-invisibility-spec' for Emacs 21.
3119 Some ops with invisible text do not work correctly on Emacs 21. For these
3120 we turn off invisibility temporarily. Use this in a `let' form."
3124 "Make VAR local in current buffer and set it to VALUE."
3128 "Check if the current buffer is in Org-mode."
3132 "Return the last element of LIST."
3163 "Variable associated with STARTUP options for org-mode.
3164 Each element is a list of three items: The startup options as written
3165 in the #+STARTUP line, the corresponding variable, and the value to
3166 set this variable to if the option is found. An optional forth element PUSH
3170 "Precompute regular expressions for current buffer."
3176 kwds int key value cat arch tags links)
3203 links)))
3206 l var val)
3221 )))
3236 tgs))
3244 ;; Compute the regular expressions and other local variables
3249 org-done-string
3251 org-todo-regexp
3254 org-not-done-regexp
3260 org-todo-line-regexp
3264 org-nl-done-regexp
3266 org-todo-line-tags-regexp
3272 org-deadline-time-regexp
3274 org-deadline-line-regexp
3276 org-scheduled-regexp
3278 org-scheduled-time-regexp
3280 org-closed-time-regexp
3282 org-keyword-time-regexp
3288 org-keyword-time-not-clock-regexp
3293 org-maybe-keyword-time-regexp
3303 ;;; Some variables ujsed in various places
3308 "Function to be called when `C-c C-c' is used.
3311 ;;; Foreign variables, to inform the compiler
3313 ;; XEmacs only
3318 ;; Emacs only
3321 ;; Packages that org-mode interacts with
3353 ;; FIXME: Occasionally check by commenting these, to make sure
3354 ;; no other functions uses these, forgetting to let-bind them.
3362 ;; Defined somewhere in this file, but used before definition.
3375 ;;;; Emacs/XEmacs compatibility
3377 ;; Overlay compatibility functions
3395 "Make overlay OVL display TEXT with face FACE."
3405 "Make overlay OVL display TEXT with face FACE."
3428 "Find all overlays specifying PROP at POS or point.
3429 If DELETE is non-nil, delete all those overlays."
3431 ov found)
3435 found))
3437 ;; Region compatibility
3440 "Add-hook, compatible with both Emacsen."
3449 "Is `transient-mark-mode' on and the region active?
3450 Works on both Emacs and XEmacs."
3452 nil
3457 ;; Invisibility compatibility
3460 "Add elements to `buffer-invisibility-spec'.
3461 See documentation for `buffer-invisibility-spec' for the kind of elements
3462 that can be added."
3473 "Remove elements from `buffer-invisibility-spec'."
3481 "Is ARG a member of `buffer-invisibility-spec'?"
3484 nil))
3486 ;;;; Define the Org-mode
3489 (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."))
3492 ;; We use a before-change function to check if a table might need
3493 ;; an update.
3495 "Indicates that a table might need an update.
3496 This variable is set by `org-before-change-function'.
3504 ;;;###autoload
3506 "Outline-based notes management and organizer, alias
3509 Org-mode develops organizational tasks around a NOTES file which
3510 contains information about projects as plain text. Org-mode is
3511 implemented on top of outline-mode, which is ideal to keep the content
3512 of large files well structured. It supports ToDo items, deadlines and
3513 time stamps, which magically appear in the diary listing of the Emacs
3514 calendar. Tables are easily created with a built-in table editor.
3515 Plain text URL-like links connect to websites, emails (VM), Usenet
3516 messages (Gnus), BBDB entries, and any files related to the project.
3517 For printing and sharing of notes, an Org-mode file (or a part of it)
3518 can be exported as a structured ASCII or HTML file.
3520 The following commands are available:
3524 ;; Get rid of Outline menus, they are not needed
3525 ;; Need to do this here because define-derived-mode sets up
3526 ;; the keymap so late. Still, it is a waste to call this each time
3527 ;; we switch another buffer into org-mode.
3530 ;; Assume this is Greg's port, it used easymenu
3555 ;; Calc embedded
3562 ;; Activate before-change-function
3566 ;; Check for running clock before killing a buffer
3568 ;; Paragraphs and auto-filling
3573 ;; Comment characters
3574 ; (org-set-local 'comment-start "#") ;; FIXME: this breaks wrapping
3577 ;; Make isearch reveal context
3580 ;; Emacs 21 and XEmacs make use of the hook
3582 ;; Emacs 22 deals with this through a special variable
3586 ;; If empty file that did not turn on org-mode automatically, make it to.
3605 "Call COMMAND interactively, but pretend prefix are was ARG."
3614 "Current time, possibly rounded to `org-time-stamp-rounding-minutes'."
3624 "Add text properties to entire string, from beginning to end.
3625 PLIST may be a list of properties, PROPS are individual properties and values
3626 that will be added to PLIST. Returns the string that was modified."
3629 string)
3633 ;;;; Font-Lock stuff, including the activators
3638 (define-key org-mouse-map
3639 (if (featurep 'xemacs) [button3] [mouse-3]) 'org-find-file-at-mouse)
3640 (when org-mouse-1-follows-link
3641 (define-key org-mouse-map [follow-link] 'mouse-face))
3642 (when org-tab-follows-link
3643 (define-key org-mouse-map [(tab)] 'org-open-at-point)
3644 (define-key org-mouse-map "\C-i" 'org-open-at-point))
3645 (when org-return-follows-link
3646 (define-key org-mouse-map [(return)] 'org-open-at-point)
3647 (define-key org-mouse-map "\C-m" 'org-open-at-point))
3649 (require 'font-lock)
3652 (defconst org-link-types '("https?" "ftp" "mailto" "file" "news" "bbdb" "vm"
3653 "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp"))
3654 (defconst org-link-re-with-space
3655 (concat
3658 "[^" org-non-link-chars "]*"
3660 "Matches a link with spaces, optional angular brackets around it.")
3662 (defconst org-link-re-with-space2
3663 (concat
3668 "Matches a link with spaces, optional angular brackets around it.")
3670 (defconst org-angle-link-re
3671 (concat
3674 "[^" org-non-link-chars "]*"
3676 "Matches link with angular brackets, spaces are allowed.")
3677 (defconst org-plain-link-re
3678 (concat
3681 "Matches plain link, without spaces.")
3683 (defconst org-bracket-link-regexp
3685 "Matches a link in double brackets.")
3687 (defconst org-bracket-link-analytic-regexp
3688 (concat
3695 ; 1: http:
3696 ; 2: http
3697 ; 3: path
3698 ; 4: [desc]
3699 ; 5: desc
3701 (defconst org-any-link-re
3705 "Regular expression matching any link.")
3707 (defconst org-ts-lengths
3708 (cons (length (format-time-string (car org-time-stamp-formats)))
3709 (length (format-time-string (cdr org-time-stamp-formats))))
3710 "This holds the lengths of the two different time formats.")
3712 "Regular expression for fast time stamp matching.")
3714 "Regular expression for fast time stamp matching.")
3715 (defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\([^]0-9>\r\n]*\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
3716 "Regular expression matching time strings for analysis.")
3717 (defconst org-ts-regexp2 (concat "<" org-ts-regexp1 ">")
3718 "Regular expression matching time stamps, with groups.")
3719 (defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[]>]")
3720 "Regular expression matching time stamps (also [..]), with groups.")
3721 (defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp)
3722 "Regular expression matching a time stamp range.")
3723 (defconst org-tr-regexp-both
3724 (concat org-ts-regexp-both "--?-?" org-ts-regexp-both)
3725 "Regular expression matching a time stamp range.")
3728 "Regular expression matching a time stamp or time stamp range.")
3731 "Regular expression matching a time stamp or time stamp range.
3732 The time stamps may be either active or inactive.")
3734 (defvar org-emph-face nil)
3736 (defun org-do-emphasis-faces (limit)
3737 "Run through the buffer and add overlays to links."
3738 (if (re-search-forward org-emph-re limit t)
3739 (progn
3740 (font-lock-prepend-text-property (match-beginning 2) (match-end 2)
3741 'face
3742 (nth 1 (assoc (match-string 3)
3743 org-emphasis-alist)))
3744 (add-text-properties (match-beginning 2) (match-end 2)
3745 '(font-lock-multiline t))
3746 (backward-char 1)
3747 t)))
3749 (defun org-activate-plain-links (limit)
3750 "Run through the buffer and add overlays to links."
3751 (if (re-search-forward org-plain-link-re limit t)
3752 (progn
3753 (add-text-properties (match-beginning 0) (match-end 0)
3754 (list 'mouse-face 'highlight
3755 'rear-nonsticky t
3756 'keymap org-mouse-map
3757 ))
3758 t)))
3760 (defun org-activate-angle-links (limit)
3761 "Run through the buffer and add overlays to links."
3762 (if (re-search-forward org-angle-link-re limit t)
3763 (progn
3764 (add-text-properties (match-beginning 0) (match-end 0)
3765 (list 'mouse-face 'highlight
3766 'rear-nonsticky t
3767 'keymap org-mouse-map
3768 ))
3769 t)))
3771 (defmacro org-maybe-intangible (props)
3772 "Add '(intangigble t) to PROPS if Emacs version is earlier than Emacs 22.
3773 In emacs 21, invisible text is not avoided by the command loop, so the
3774 intangible property is needed to make sure point skips this text.
3775 In Emacs 22, this is not necessary. The intangible text property has
3776 led to problems with flyspell. These problems are fixed in flyspell.el,
3777 but we still avoid setting the property in Emacs 22 and later.
3778 We use a macro so that the test can happen at compilation time."
3779 (if (< emacs-major-version 22)
3780 `(append '(intangible t) ,props)
3781 props))
3783 (defun org-activate-bracket-links (limit)
3784 "Run through the buffer and add overlays to bracketed links."
3785 (if (re-search-forward org-bracket-link-regexp limit t)
3786 (let* ((help (concat "LINK: "
3787 (org-match-string-no-properties 1)))
3788 ;; FIXME: above we should remove the escapes.
3789 ;; but that requires another match, protecting match data,
3790 ;; a lot of overhead for font-lock.
3791 (ip (org-maybe-intangible
3792 (list 'invisible 'org-link 'rear-nonsticky t
3793 'keymap org-mouse-map 'mouse-face 'highlight
3794 'help-echo help)))
3795 (vp (list 'rear-nonsticky t
3796 'keymap org-mouse-map 'mouse-face 'highlight
3797 'help-echo help)))
3798 ;; We need to remove the invisible property here. Table narrowing
3799 ;; may have made some of this invisible.
3800 (remove-text-properties (match-beginning 0) (match-end 0)
3801 '(invisible nil))
3802 (if (match-end 3)
3803 (progn
3804 (add-text-properties (match-beginning 0) (match-beginning 3) ip)
3805 (add-text-properties (match-beginning 3) (match-end 3) vp)
3806 (add-text-properties (match-end 3) (match-end 0) ip))
3807 (add-text-properties (match-beginning 0) (match-beginning 1) ip)
3808 (add-text-properties (match-beginning 1) (match-end 1) vp)
3809 (add-text-properties (match-end 1) (match-end 0) ip))
3810 t)))
3812 (defun org-activate-dates (limit)
3813 "Run through the buffer and add overlays to dates."
3814 (if (re-search-forward org-tsr-regexp-both limit t)
3815 (progn
3816 (add-text-properties (match-beginning 0) (match-end 0)
3817 (list 'mouse-face 'highlight
3818 'rear-nonsticky t
3819 'keymap org-mouse-map))
3820 (when org-display-custom-times
3821 (if (match-end 3)
3822 (org-display-custom-time (match-beginning 3) (match-end 3)))
3823 (org-display-custom-time (match-beginning 1) (match-end 1)))
3824 t)))
3826 (defvar org-target-link-regexp nil
3827 "Regular expression matching radio targets in plain text.")
3829 "Regular expression matching a link target.")
3831 "Regular expression matching a link target.")
3833 (defun org-activate-target-links (limit)
3834 "Run through the buffer and add overlays to target matches."
3835 (when org-target-link-regexp
3836 (let ((case-fold-search t))
3837 (if (re-search-forward org-target-link-regexp limit t)
3838 (progn
3839 (add-text-properties (match-beginning 0) (match-end 0)
3840 (list 'mouse-face 'highlight
3841 'rear-nonsticky t
3842 'keymap org-mouse-map
3843 'help-echo "Radio target link"
3844 'org-linked-text t))
3845 t)))))
3847 (defun org-update-radio-target-regexp ()
3848 "Find all radio targets in this file and update the regular expression."
3849 (interactive)
3850 (when (memq 'radio org-activate-links)
3851 (setq org-target-link-regexp
3852 (org-make-target-link-regexp (org-all-targets 'radio)))
3853 (org-restart-font-lock)))
3855 (defun org-hide-wide-columns (limit)
3856 (let (s e)
3857 (setq s (text-property-any (point) (or limit (point-max))
3858 'org-cwidth t))
3859 (when s
3860 (setq e (next-single-property-change s 'org-cwidth))
3861 (add-text-properties s e (org-maybe-intangible '(invisible org-cwidth)))
3862 (goto-char e)
3863 t)))
3865 (defun org-restart-font-lock ()
3866 "Restart font-lock-mode, to force refontification."
3867 (when (and (boundp 'font-lock-mode) font-lock-mode)
3868 (font-lock-mode -1)
3869 (font-lock-mode 1)))
3871 (defun org-all-targets (&optional radio)
3872 "Return a list of all targets in this file.
3873 With optional argument RADIO, only find radio targets."
3874 (let ((re (if radio org-radio-target-regexp org-target-regexp))
3875 rtn)
3876 (save-excursion
3877 (goto-char (point-min))
3878 (while (re-search-forward re nil t)
3879 (add-to-list 'rtn (downcase (org-match-string-no-properties 1))))
3880 rtn)))
3882 (defun org-make-target-link-regexp (targets)
3883 "Make regular expression matching all strings in TARGETS.
3884 The regular expression finds the targets also if there is a line break
3885 between words."
3886 (and targets
3887 (concat
3889 (mapconcat
3890 (lambda (x)
3891 (while (string-match " +" x)
3893 x)
3894 targets
3898 (defun org-activate-tags (limit)
3900 (progn
3901 (add-text-properties (match-beginning 1) (match-end 1)
3902 (list 'mouse-face 'highlight
3903 'rear-nonsticky t
3904 'keymap org-mouse-map))
3905 t)))
3907 (defun org-font-lock-level ()
3908 (save-excursion
3909 (org-back-to-heading t)
3910 (- (match-end 0) (match-beginning 0))))
3912 (defun org-outline-level ()
3913 (save-excursion
3914 (looking-at outline-regexp)
3915 (if (match-beginning 1)
3916 (+ (org-get-string-indentation (match-string 1)) 1000)
3917 (- (match-end 0) (match-beginning 0)))))
3919 (defvar org-font-lock-keywords nil)
3921 (defun org-set-font-lock-defaults ()
3922 (let* ((em org-fontify-emphasized-text)
3923 (lk org-activate-links)
3924 (org-font-lock-extra-keywords
3925 ;; Headlines
3926 (list
3928 (2 (org-get-level-face 2)) (3 (org-get-level-face 3)))
3930 (1 'org-table))
3931 ;; Links
3932 (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t)))
3933 (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t)))
3934 (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t)))
3935 (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t)))
3936 (if (memq 'date lk) '(org-activate-dates (0 'org-date t)))
3937 (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
3938 '(org-hide-wide-columns (0 nil append))
3939 ;; TODO lines
3941 '(1 'org-todo t))
3942 ;; Priorities
3944 ;; Special keywords
3945 (list org-repeat-re '(0 'org-special-keyword t))
3950 ;; Emphasis
3951 (if em
3952 (if (featurep 'xemacs)
3953 '(org-do-emphasis-faces (0 nil append))
3954 '(org-do-emphasis-faces)))
3955 ;; Checkboxes, similar to Frank Ruell's org-checklet.el
3957 2 'bold prepend)
3958 (if org-provide-checkbox-statistics
3960 (0 (org-get-checkbox-statistics-face) t)))
3961 ;; COMMENT
3964 '(1 'org-special-keyword t))
3965 '("^#.*" (0 'font-lock-comment-face t))
3966 ;; DONE
3967 (if org-fontify-done-headline
3969 '(1 'org-done t) '(2 'org-headline-done t))
3971 '(1 'org-done t)))
3972 ;; Table stuff
3976 (if org-format-transports-properties-p
3979 )))
3980 (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
3981 ;; Now set the full font-lock-keywords
3982 (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords)
3983 (org-set-local 'font-lock-defaults
3984 '(org-font-lock-keywords t nil nil backward-paragraph))
3985 (kill-local-variable 'font-lock-keywords) nil))
3987 (defvar org-m nil)
3988 (defvar org-l nil)
3989 (defvar org-f nil)
3990 (defun org-get-level-face (n)
3991 "Get the right face for match N in font-lock matching of healdines."
3992 (setq org-l (- (match-end 2) (match-beginning 1)))
3993 (if org-odd-levels-only (setq org-l (1+ (/ org-l 2))))
3994 ; (setq org-f (nth (1- (% org-l org-n-levels)) org-level-faces))
3995 (setq org-f (nth (% (1- org-l) org-n-levels) org-level-faces))
3996 (cond
3997 ((eq n 1) (if org-hide-leading-stars 'org-hide org-f))
3998 ((eq n 2) org-f)
3999 (t (if org-level-color-stars-only nil org-f))))
4001 (defun org-unfontify-region (beg end &optional maybe_loudly)
4002 "Remove fontification and activation overlays from links."
4003 (font-lock-default-unfontify-region beg end)
4004 (let* ((buffer-undo-list t)
4005 (inhibit-read-only t) (inhibit-point-motion-hooks t)
4006 (inhibit-modification-hooks t)
4007 deactivate-mark buffer-file-name buffer-file-truename)
4008 (remove-text-properties beg end
4009 '(mouse-face t keymap t org-linked-text t
4010 rear-nonsticky t
4011 invisible t intangible t))))
4013 ;;;; Visibility cycling, including org-goto and indirect buffer
4015 ;;; Cycling
4017 (defvar org-cycle-global-status nil)
4018 (make-variable-buffer-local 'org-cycle-global-status)
4019 (defvar org-cycle-subtree-status nil)
4020 (make-variable-buffer-local 'org-cycle-subtree-status)
4022 ;;;###autoload
4023 (defun org-cycle (&optional arg)
4024 "Visibility cycling for Org-mode.
4026 - When this function is called with a prefix argument, rotate the entire
4027 buffer through 3 states (global cycling)
4028 1. OVERVIEW: Show only top-level headlines.
4029 2. CONTENTS: Show all headlines of all levels, but no body text.
4030 3. SHOW ALL: Show everything.
4032 - When point is at the beginning of a headline, rotate the subtree started
4033 by this line through 3 different states (local cycling)
4034 1. FOLDED: Only the main headline is shown.
4035 2. CHILDREN: The main headline and the direct children are shown.
4036 From this state, you can move to one of the children
4037 and zoom in further.
4038 3. SUBTREE: Show the entire subtree, including body text.
4040 - When there is a numeric prefix, go up to a heading with level ARG, do
4041 a `show-subtree' and return to the previous cursor position. If ARG
4042 is negative, go up that many levels.
4044 - When point is not at the beginning of a headline, execute
4045 `indent-relative', like TAB normally does. See the option
4046 `org-cycle-emulate-tab' for details.
4048 - Special case: if point is the the beginning of the buffer and there is
4049 no headline in line 1, this function will act as if called with prefix arg."
4050 (interactive "P")
4051 (let* ((outline-regexp
4052 (if (and (org-mode-p) org-cycle-include-plain-lists)
4054 outline-regexp))
4055 (bob-special (and org-cycle-global-at-bob (bobp)
4056 (not (looking-at outline-regexp))))
4057 (org-cycle-hook
4058 (if bob-special
4059 (delq 'org-optimize-window-after-visibility-change
4060 (copy-sequence org-cycle-hook))
4061 org-cycle-hook))
4062 (pos (point)))
4064 (if (or bob-special (equal arg '(4)))
4065 ;; special case: use global cycling
4066 (setq arg t))
4068 (cond
4070 ((org-at-table-p 'any)
4071 ;; Enter the table or move to the next field in the table
4072 (or (org-table-recognize-table.el)
4073 (progn
4074 (if arg (org-table-edit-field t)
4075 (org-table-justify-field-maybe)
4076 (call-interactively 'org-table-next-field)))))
4078 ((eq arg t) ;; Global cycling
4080 (cond
4081 ((and (eq last-command this-command)
4082 (eq org-cycle-global-status 'overview))
4083 ;; We just created the overview - now do table of contents
4084 ;; This can be slow in very large buffers, so indicate action
4085 (message "CONTENTS...")
4086 (org-content)
4087 (message "CONTENTS...done")
4088 (setq org-cycle-global-status 'contents)
4089 (run-hook-with-args 'org-cycle-hook 'contents))
4091 ((and (eq last-command this-command)
4092 (eq org-cycle-global-status 'contents))
4093 ;; We just showed the table of contents - now show everything
4094 (show-all)
4095 (message "SHOW ALL")
4096 (setq org-cycle-global-status 'all)
4097 (run-hook-with-args 'org-cycle-hook 'all))
4099 (t
4100 ;; Default action: go to overview
4101 (org-overview)
4102 (message "OVERVIEW")
4103 (setq org-cycle-global-status 'overview)
4104 (run-hook-with-args 'org-cycle-hook 'overview))))
4106 ((integerp arg)
4107 ;; Show-subtree, ARG levels up from here.
4108 (save-excursion
4109 (org-back-to-heading)
4110 (outline-up-heading (if (< arg 0) (- arg)
4111 (- (funcall outline-level) arg)))
4112 (org-show-subtree)))
4114 ((save-excursion (beginning-of-line 1) (looking-at outline-regexp))
4115 ;; At a heading: rotate between three different views
4116 (org-back-to-heading)
4117 (let ((goal-column 0) eoh eol eos)
4118 ;; First, some boundaries
4119 (save-excursion
4120 (org-back-to-heading)
4121 (save-excursion
4122 (beginning-of-line 2)
4123 (while (and (not (eobp)) ;; this is like `next-line'
4124 (get-char-property (1- (point)) 'invisible))
4125 (beginning-of-line 2)) (setq eol (point)))
4126 (outline-end-of-heading) (setq eoh (point))
4127 (org-end-of-subtree t)
4129 (beginning-of-line 1) ; in case this is an item
4130 (setq eos (1- (point))))
4131 ;; Find out what to do next and set `this-command'
4132 (cond
4133 ((= eos eoh)
4134 ;; Nothing is hidden behind this heading
4135 (message "EMPTY ENTRY")
4136 (setq org-cycle-subtree-status nil))
4137 ((>= eol eos)
4138 ;; Entire subtree is hidden in one line: open it
4139 (org-show-entry)
4140 (show-children)
4141 (message "CHILDREN")
4142 (setq org-cycle-subtree-status 'children)
4143 (run-hook-with-args 'org-cycle-hook 'children))
4144 ((and (eq last-command this-command)
4145 (eq org-cycle-subtree-status 'children))
4146 ;; We just showed the children, now show everything.
4147 (org-show-subtree)
4148 (message "SUBTREE")
4149 (setq org-cycle-subtree-status 'subtree)
4150 (run-hook-with-args 'org-cycle-hook 'subtree))
4151 (t
4152 ;; Default action: hide the subtree.
4153 (hide-subtree)
4154 (message "FOLDED")
4155 (setq org-cycle-subtree-status 'folded)
4156 (run-hook-with-args 'org-cycle-hook 'folded)))))
4158 ;; TAB emulation
4159 (buffer-read-only (org-back-to-heading))
4161 ((org-try-cdlatex-tab))
4163 ((if (and (memq org-cycle-emulate-tab '(white whitestart))
4165 (or (and (eq org-cycle-emulate-tab 'white)
4166 (= (match-end 0) (point-at-eol)))
4167 (and (eq org-cycle-emulate-tab 'whitestart)
4168 (>= (match-end 0) pos))))
4169 t
4170 (eq org-cycle-emulate-tab t))
4173 (point-at-bol) (point))))
4174 (progn
4175 (beginning-of-line 1)
4177 (indent-relative))
4179 (t (save-excursion
4180 (org-back-to-heading)
4181 (org-cycle))))))
4183 ;;;###autoload
4184 (defun org-global-cycle (&optional arg)
4185 "Cycle the global visibility. For details see `org-cycle'."
4186 (interactive "P")
4187 (let ((org-cycle-include-plain-lists
4188 (if (org-mode-p) org-cycle-include-plain-lists nil)))
4189 (if (integerp arg)
4190 (progn
4191 (show-all)
4192 (hide-sublevels arg)
4193 (setq org-cycle-global-status 'contents))
4194 (org-cycle '(4)))))
4196 (defun org-overview ()
4197 "Switch to overview mode, shoing only top-level headlines.
4198 Really, this shows all headlines with level equal or greater than the level
4199 of the first headline in the buffer. This is important, because if the
4200 first headline is not level one, then (hide-sublevels 1) gives confusing
4201 results."
4202 (interactive)
4203 (hide-sublevels (save-excursion
4204 (goto-char (point-min))
4205 (if (re-search-forward (concat "^" outline-regexp) nil t)
4206 (progn
4207 (goto-char (match-beginning 0))
4208 (funcall outline-level))
4209 1))))
4211 (defun org-content (&optional arg)
4212 "Show all headlines in the buffer, like a table of contents.
4213 With numerical argument N, show content up to level N."
4214 (interactive "P")
4215 (save-excursion
4216 ;; Visit all headings and show their offspring
4217 (and (integerp arg) (org-overview))
4218 (goto-char (point-max))
4219 (catch 'exit
4220 (while (and (progn (condition-case nil
4221 (outline-previous-visible-heading 1)
4222 (error (goto-char (point-min))))
4223 t)
4224 (looking-at outline-regexp))
4225 (if (integerp arg)
4226 (show-children (1- arg))
4227 (show-branches))
4228 (if (bobp) (throw 'exit nil))))))
4231 (defun org-optimize-window-after-visibility-change (state)
4232 "Adjust the window after a change in outline visibility.
4233 This function is the default value of the hook `org-cycle-hook'."
4234 (when (get-buffer-window (current-buffer))
4235 (cond
4236 ((eq state 'overview) (org-first-headline-recenter 1))
4237 ((eq state 'content) nil)
4238 ((eq state 'all) nil)
4239 ((eq state 'folded) nil)
4240 ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1)))
4241 ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1))))))
4243 (defun org-subtree-end-visible-p ()
4244 "Is the end of the current subtree visible?"
4245 (pos-visible-in-window-p
4246 (save-excursion (org-end-of-subtree t) (point))))
4248 (defun org-first-headline-recenter (&optional N)
4249 "Move cursor to the first headline and recenter the headline.
4250 Optional argument N means, put the headline into the Nth line of the window."
4251 (goto-char (point-min))
4253 (beginning-of-line)
4254 (recenter (prefix-numeric-value N))))
4256 ;;; Org-goto
4258 (defvar org-goto-window-configuration nil)
4259 (defvar org-goto-marker nil)
4260 (defvar org-goto-map (make-sparse-keymap))
4261 (let ((cmds '(isearch-forward isearch-backward)) cmd)
4262 (while (setq cmd (pop cmds))
4263 (substitute-key-definition cmd cmd org-goto-map global-map)))
4264 (define-key org-goto-map "\C-m" 'org-goto-ret)
4265 (define-key org-goto-map [(left)] 'org-goto-left)
4266 (define-key org-goto-map [(right)] 'org-goto-right)
4267 (define-key org-goto-map [(?q)] 'org-goto-quit)
4268 (define-key org-goto-map [(control ?g)] 'org-goto-quit)
4269 (define-key org-goto-map "\C-i" 'org-cycle)
4270 (define-key org-goto-map [(tab)] 'org-cycle)
4271 (define-key org-goto-map [(down)] 'outline-next-visible-heading)
4272 (define-key org-goto-map [(up)] 'outline-previous-visible-heading)
4273 (define-key org-goto-map "n" 'outline-next-visible-heading)
4274 (define-key org-goto-map "p" 'outline-previous-visible-heading)
4275 (define-key org-goto-map "f" 'outline-forward-same-level)
4276 (define-key org-goto-map "b" 'outline-backward-same-level)
4277 (define-key org-goto-map "u" 'outline-up-heading)
4278 (define-key org-goto-map "\C-c\C-n" 'outline-next-visible-heading)
4279 (define-key org-goto-map "\C-c\C-p" 'outline-previous-visible-heading)
4280 (define-key org-goto-map "\C-c\C-f" 'outline-forward-same-level)
4281 (define-key org-goto-map "\C-c\C-b" 'outline-backward-same-level)
4282 (define-key org-goto-map "\C-c\C-u" 'outline-up-heading)
4283 (let ((l '(1 2 3 4 5 6 7 8 9 0)))
4284 (while l (define-key org-goto-map (int-to-string (pop l)) 'digit-argument)))
4286 (defconst org-goto-help
4287 "Select a location to jump to, press RET
4288 \[Up]/[Down]=next/prev headline TAB=cycle visibility RET=select [Q]uit")
4290 (defun org-goto ()
4291 "Go to a different location of the document, keeping current visibility.
4293 When you want to go to a different location in a document, the fastest way
4294 is often to fold the entire buffer and then dive into the tree. This
4295 method has the disadvantage, that the previous location will be folded,
4296 which may not be what you want.
4298 This command works around this by showing a copy of the current buffer in
4299 overview mode. You can dive into the tree in that copy, to find the
4300 location you want to reach. When pressing RET, the command returns to the
4301 original buffer in which the visibility is still unchanged. It then jumps
4302 to the new location, making it and the headline hierarchy above it visible."
4303 (interactive)
4304 (let* ((org-goto-start-pos (point))
4305 (selected-point
4306 (org-get-location (current-buffer) org-goto-help)))
4307 (if selected-point
4308 (progn
4309 (org-mark-ring-push org-goto-start-pos)
4310 (goto-char selected-point)
4311 (if (or (org-invisible-p) (org-invisible-p2))
4312 (org-show-context 'org-goto)))
4313 (error "Quit"))))
4315 (defvar org-selected-point nil) ; dynamically scoped parameter
4317 (defun org-get-location (buf help)
4318 "Let the user select a location in the Org-mode buffer BUF.
4319 This function uses a recursive edit. It returns the selected position
4320 or nil."
4321 (let (org-selected-point)
4322 (save-excursion
4323 (save-window-excursion
4324 (delete-other-windows)
4325 (switch-to-buffer (get-buffer-create "*org-goto*"))
4326 (with-output-to-temp-buffer "*Help*"
4327 (princ help))
4328 (shrink-window-if-larger-than-buffer (get-buffer-window "*Help*"))
4329 (setq buffer-read-only nil)
4330 (erase-buffer)
4331 (insert-buffer-substring buf)
4332 (let ((org-startup-truncated t)
4333 (org-startup-folded t)
4334 (org-startup-align-all-tables nil))
4335 (org-mode))
4336 (setq buffer-read-only t)
4337 (if (and (boundp 'org-goto-start-pos)
4338 (integer-or-marker-p org-goto-start-pos))
4339 (let ((org-show-hierarchy-above t)
4340 (org-show-siblings t)
4341 (org-show-following-heading t))
4342 (goto-char org-goto-start-pos)
4343 (and (org-invisible-p) (org-show-context)))
4344 (goto-char (point-min)))
4345 (org-beginning-of-line)
4346 (message "Select location and press RET")
4347 ;; now we make sure that during selection, ony very few keys work
4348 ;; and that it is impossible to switch to another window.
4349 (let ((gm (current-global-map))
4350 (overriding-local-map org-goto-map))
4351 (unwind-protect
4352 (progn
4353 (use-global-map org-goto-map)
4354 (recursive-edit))
4355 (use-global-map gm)))))
4356 (kill-buffer "*org-goto*")
4357 org-selected-point))
4359 (defun org-goto-ret (&optional arg)
4360 "Finish `org-goto' by going to the new location."
4361 (interactive "P")
4362 (setq org-selected-point (point)
4363 current-prefix-arg arg)
4364 (throw 'exit nil))
4366 (defun org-goto-left ()
4367 "Finish `org-goto' by going to the new location."
4368 (interactive)
4369 (if (org-on-heading-p)
4370 (progn
4371 (beginning-of-line 1)
4372 (setq org-selected-point (point)
4373 current-prefix-arg (- (match-end 0) (match-beginning 0)))
4374 (throw 'exit nil))
4375 (error "Not on a heading")))
4377 (defun org-goto-right ()
4378 "Finish `org-goto' by going to the new location."
4379 (interactive)
4380 (if (org-on-heading-p)
4381 (progn
4382 (outline-end-of-subtree)
4383 (or (eobp) (forward-char 1))
4384 (setq org-selected-point (point)
4385 current-prefix-arg (- (match-end 0) (match-beginning 0)))
4386 (throw 'exit nil))
4387 (error "Not on a heading")))
4389 (defun org-goto-quit ()
4390 "Finish `org-goto' without cursor motion."
4391 (interactive)
4392 (setq org-selected-point nil)
4393 (throw 'exit nil))
4395 ;;; Indirect buffer display of subtrees
4397 (defvar org-indirect-dedicated-frame nil
4398 "This is the frame being used for indirect tree display.")
4399 (defvar org-last-indirect-buffer nil)
4401 (defun org-tree-to-indirect-buffer (&optional arg)
4402 "Create indirect buffer and narrow it to current subtree.
4403 With numerical prefix ARG, go up to this level and then take that tree.
4404 If ARG is negative, go up that many levels.
4405 Normally this command removes the indirect buffer previously made
4406 with this command. However, when called with a C-u prefix, the last buffer
4407 is kept so that you can work with several indirect buffers at the same time.
4408 If `org-indirect-buffer-display' is `dedicated-frame', the C-u prefix also
4409 requests that a new frame be made for the new buffer, so that the dedicated
4410 frame is not changed."
4411 (interactive "P")
4412 (let ((cbuf (current-buffer))
4413 (cwin (selected-window))
4414 (pos (point))
4415 beg end level heading ibuf)
4416 (save-excursion
4417 (org-back-to-heading t)
4418 (when (numberp arg)
4419 (setq level (org-outline-level))
4420 (if (< arg 0) (setq arg (+ level arg)))
4421 (while (> (setq level (org-outline-level)) arg)
4422 (outline-up-heading 1 t)))
4423 (setq beg (point)
4424 heading (org-get-heading))
4425 (org-end-of-subtree t) (setq end (point)))
4426 (if (and (not arg)
4427 (buffer-live-p org-last-indirect-buffer))
4428 (kill-buffer org-last-indirect-buffer))
4429 (setq ibuf (org-get-indirect-buffer cbuf)
4430 org-last-indirect-buffer ibuf)
4431 (cond
4432 ((or (eq org-indirect-buffer-display 'new-frame)
4433 (and arg (eq org-indirect-buffer-display 'dedicated-frame)))
4434 (select-frame (make-frame))
4435 (delete-other-windows)
4436 (switch-to-buffer ibuf)
4437 (org-set-frame-title heading))
4438 ((eq org-indirect-buffer-display 'dedicated-frame)
4439 (raise-frame
4440 (select-frame (or (and org-indirect-dedicated-frame
4441 (frame-live-p org-indirect-dedicated-frame)
4442 org-indirect-dedicated-frame)
4443 (setq org-indirect-dedicated-frame (make-frame)))))
4444 (delete-other-windows)
4445 (switch-to-buffer ibuf)
4446 (org-set-frame-title (concat "Indirect: " heading)))
4447 ((eq org-indirect-buffer-display 'current-window)
4448 (switch-to-buffer ibuf))
4449 ((eq org-indirect-buffer-display 'other-window)
4450 (pop-to-buffer ibuf))
4451 (t (error "Invalid value.")))
4452 (if (featurep 'xemacs)
4453 (save-excursion (org-mode) (turn-on-font-lock)))
4454 (narrow-to-region beg end)
4455 (show-all)
4456 (goto-char pos)
4457 (and (window-live-p cwin) (select-window cwin))))
4459 (defun org-get-indirect-buffer (&optional buffer)
4460 (setq buffer (or buffer (current-buffer)))
4461 (let ((n 1) (base (buffer-name buffer)) bname)
4462 (while (buffer-live-p
4463 (get-buffer (setq bname (concat base "-" (number-to-string n)))))
4464 (setq n (1+ n)))
4465 (condition-case nil
4466 (make-indirect-buffer buffer bname 'clone)
4467 (error (make-indirect-buffer buffer bname)))))
4469 (defun org-set-frame-title (title)
4470 "Set the title of the current frame to the string TITLE."
4471 ;; FIXME: how to name a single frame in XEmacs???
4472 (unless (featurep 'xemacs)
4473 (modify-frame-parameters (selected-frame) (list (cons 'name title)))))
4475 ;;;; Structure editing
4477 ;;; Inserting headlines
4479 (defun org-insert-heading (&optional force-heading)
4480 "Insert a new heading or item with same depth at point.
4481 If point is in a plain list and FORCE-HEADING is nil, create a new list item.
4482 If point is at the beginning of a headline, insert a sibling before the
4483 current headline. If point is in the middle of a headline, split the headline
4484 at that position and make the rest of the headline part of the sibling below
4485 the current headline."
4486 (interactive "P")
4487 (if (= (buffer-size) 0)
4489 (when (or force-heading (not (org-insert-item)))
4490 (let* ((head (save-excursion
4491 (condition-case nil
4492 (progn
4493 (org-back-to-heading)
4494 (match-string 0))
4495 (error "*"))))
4496 (blank (cdr (assq 'heading org-blank-before-new-entry)))
4497 pos)
4498 (cond
4499 ((and (org-on-heading-p) (bolp)
4500 (or (bobp)
4501 (save-excursion (backward-char 1) (not (org-invisible-p)))))
4502 (open-line (if blank 2 1)))
4503 ((and (bolp)
4504 (or (bobp)
4505 (save-excursion
4506 (backward-char 1) (not (org-invisible-p)))))
4507 nil)
4508 (t (newline (if blank 2 1))))
4509 (insert head) (just-one-space)
4510 (setq pos (point))
4511 (end-of-line 1)
4512 (unless (= (point) pos) (just-one-space) (backward-delete-char 1))
4513 (run-hooks 'org-insert-heading-hook)))))
4516 (defun org-insert-todo-heading (arg)
4517 "Insert a new heading with the same level and TODO state as current heading.
4518 If the heading has no TODO state, or if the state is DONE, use the first
4519 state (TODO by default). Also with prefix arg, force first state."
4520 (interactive "P")
4521 (when (not (org-insert-item 'checkbox))
4522 (org-insert-heading)
4523 (save-excursion
4524 (org-back-to-heading)
4525 (outline-previous-heading)
4526 (looking-at org-todo-line-regexp))
4527 (if (or arg
4528 (not (match-beginning 2))
4529 (equal (match-string 2) org-done-string))
4530 (insert (car org-todo-keywords) " ")
4531 (insert (match-string 2) " "))))
4533 ;;; Promotion and Demotion
4535 (defun org-promote-subtree ()
4536 "Promote the entire subtree.
4537 See also `org-promote'."
4538 (interactive)
4539 (save-excursion
4540 (org-map-tree 'org-promote))
4541 (org-fix-position-after-promote))
4543 (defun org-demote-subtree ()
4544 "Demote the entire subtree. See `org-demote'.
4545 See also `org-promote'."
4546 (interactive)
4547 (save-excursion
4548 (org-map-tree 'org-demote))
4549 (org-fix-position-after-promote))
4552 (defun org-do-promote ()
4553 "Promote the current heading higher up the tree.
4554 If the region is active in `transient-mark-mode', promote all headings
4555 in the region."
4556 (interactive)
4557 (save-excursion
4558 (if (org-region-active-p)
4559 (org-map-region 'org-promote (region-beginning) (region-end))
4560 (org-promote)))
4561 (org-fix-position-after-promote))
4563 (defun org-do-demote ()
4564 "Demote the current heading lower down the tree.
4565 If the region is active in `transient-mark-mode', demote all headings
4566 in the region."
4567 (interactive)
4568 (save-excursion
4569 (if (org-region-active-p)
4570 (org-map-region 'org-demote (region-beginning) (region-end))
4571 (org-demote)))
4572 (org-fix-position-after-promote))
4574 (defun org-fix-position-after-promote ()
4575 "Make sure that after pro/demotion cursor position is right."
4576 (let ((pos (point)))
4577 (when (save-excursion
4578 (beginning-of-line 1)
4579 (looking-at org-todo-line-regexp)
4580 (or (equal pos (match-end 1)) (equal pos (match-end 2))))
4581 (cond ((eobp) (insert " "))
4582 ((eolp) (insert " "))
4583 ((equal (char-after) ?\ ) (forward-char 1))))))
4585 (defun org-get-legal-level (level &optional change)
4586 "Rectify a level change under the influence of `org-odd-levels-only'
4587 LEVEL is a current level, CHANGE is by how much the level should be
4588 modified. Even if CHANGE is nil, LEVEL may be returned modified because
4589 even level numbers will become the next higher odd number."
4590 (if org-odd-levels-only
4591 (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2))))
4592 ((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2))))
4593 ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2))))))
4594 (max 1 (+ level change))))
4596 (defun org-promote ()
4597 "Promote the current heading higher up the tree.
4598 If the region is active in `transient-mark-mode', promote all headings
4599 in the region."
4600 (org-back-to-heading t)
4601 (let* ((level (save-match-data (funcall outline-level)))
4602 (up-head (make-string (org-get-legal-level level -1) ?*))
4603 (diff (abs (- level (length up-head)))))
4604 (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary"))
4605 (replace-match up-head nil t)
4606 ;; Fixup tag positioning
4607 (and org-auto-align-tags (org-set-tags nil t))
4608 (if org-adapt-indentation (org-fixup-indentation (- diff)))))
4610 (defun org-demote ()
4611 "Demote the current heading lower down the tree.
4612 If the region is active in `transient-mark-mode', demote all headings
4613 in the region."
4614 (org-back-to-heading t)
4615 (let* ((level (save-match-data (funcall outline-level)))
4616 (down-head (make-string (org-get-legal-level level 1) ?*))
4617 (diff (abs (- level (length down-head)))))
4618 (replace-match down-head nil t)
4619 ;; Fixup tag positioning
4620 (and org-auto-align-tags (org-set-tags nil t))
4621 (if org-adapt-indentation (org-fixup-indentation diff))))
4623 (defun org-map-tree (fun)
4624 "Call FUN for every heading underneath the current one."
4625 (org-back-to-heading)
4626 (let ((level (funcall outline-level)))
4627 (save-excursion
4628 (funcall fun)
4629 (while (and (progn
4630 (outline-next-heading)
4631 (> (funcall outline-level) level))
4632 (not (eobp)))
4633 (funcall fun)))))
4635 (defun org-map-region (fun beg end)
4636 "Call FUN for every heading between BEG and END."
4637 (let ((org-ignore-region t))
4638 (save-excursion
4639 (setq end (copy-marker end))
4640 (goto-char beg)
4641 (if (and (re-search-forward (concat "^" outline-regexp) nil t)
4642 (< (point) end))
4643 (funcall fun))
4644 (while (and (progn
4645 (outline-next-heading)
4646 (< (point) end))
4647 (not (eobp)))
4648 (funcall fun)))))
4650 (defun org-fixup-indentation (diff)
4651 "Change the indentation in the current entry by DIFF
4652 However, if any line in the current entry has no indentation, or if it
4653 would end up with no indentation after the change, nothing at all is done."
4654 (save-excursion
4655 (let ((end (save-excursion (outline-next-heading)
4656 (point-marker)))
4657 (prohibit (if (> diff 0)
4660 col)
4661 (unless (save-excursion (re-search-forward prohibit end t))
4663 (goto-char (match-end 0))
4664 (setq col (current-column))
4665 (if (< diff 0) (replace-match ""))
4666 (indent-to (+ diff col))))
4667 (move-marker end nil))))
4669 (defun org-convert-to-odd-levels ()
4670 "Convert an org-mode file with all levels allowed to one with odd levels.
4671 This will leave level 1 alone, convert level 2 to level 3, level 3 to
4672 level 5 etc."
4673 (interactive)
4674 (when (yes-or-no-p "Are you sure you want to globally change levels to odd? ")
4675 (let ((org-odd-levels-only nil) n)
4676 (save-excursion
4677 (goto-char (point-min))
4679 (setq n (1- (length (match-string 0))))
4680 (while (>= (setq n (1- n)) 0)
4681 (org-demote))
4682 (end-of-line 1))))))
4685 (defun org-convert-to-oddeven-levels ()
4686 "Convert an org-mode file with only odd levels to one with odd and even levels.
4687 This promotes level 3 to level 2, level 5 to level 3 etc. If the file contains a
4688 section with an even level, conversion would destroy the structure of the file. An error
4689 is signaled in this case."
4690 (interactive)
4691 (goto-char (point-min))
4692 ;; First check if there are no even levels
4694 (org-show-context t)
4695 (error "Not all levels are odd in this file. Conversion not possible."))
4696 (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ")
4697 (let ((org-odd-levels-only nil) n)
4698 (save-excursion
4699 (goto-char (point-min))
4701 (setq n (/ (length (match-string 0)) 2))
4702 (while (>= (setq n (1- n)) 0)
4703 (org-promote))
4704 (end-of-line 1))))))
4706 (defun org-tr-level (n)
4707 "Make N odd if required."
4708 (if org-odd-levels-only (1+ (/ n 2)) n))
4710 ;;; Vertical tree motion, cutting and pasting of subtrees
4712 (defun org-move-subtree-up (&optional arg)
4713 "Move the current subtree up past ARG headlines of the same level."
4714 (interactive "p")
4715 (org-move-subtree-down (- (prefix-numeric-value arg))))
4717 (defun org-move-subtree-down (&optional arg)
4718 "Move the current subtree down past ARG headlines of the same level."
4719 (interactive "p")
4720 (setq arg (prefix-numeric-value arg))
4721 (let ((movfunc (if (> arg 0) 'outline-get-next-sibling
4722 'outline-get-last-sibling))
4723 (ins-point (make-marker))
4724 (cnt (abs arg))
4725 beg end txt folded)
4726 ;; Select the tree
4727 (org-back-to-heading)
4728 (setq beg (point))
4729 (save-match-data
4730 (save-excursion (outline-end-of-heading)
4731 (setq folded (org-invisible-p)))
4732 (outline-end-of-subtree))
4733 (outline-next-heading)
4734 (setq end (point))
4735 ;; Find insertion point, with error handling
4736 (goto-char beg)
4737 (while (> cnt 0)
4738 (or (and (funcall movfunc) (looking-at outline-regexp))
4739 (progn (goto-char beg)
4740 (error "Cannot move past superior level or buffer limit")))
4741 (setq cnt (1- cnt)))
4742 (if (> arg 0)
4743 ;; Moving forward - still need to move over subtree
4744 (progn (outline-end-of-subtree)
4745 (outline-next-heading)
4746 (if (not (or (looking-at (concat "^" outline-regexp))
4747 (bolp)))
4748 (newline))))
4749 (move-marker ins-point (point))
4750 (setq txt (buffer-substring beg end))
4751 (delete-region beg end)
4752 (insert txt)
4753 (goto-char ins-point)
4754 (if folded (hide-subtree))
4755 (move-marker ins-point nil)))
4757 (defvar org-subtree-clip ""
4758 "Clipboard for cut and paste of subtrees.
4759 This is actually only a copy of the kill, because we use the normal kill
4760 ring. We need it to check if the kill was created by `org-copy-subtree'.")
4762 (defvar org-subtree-clip-folded nil
4763 "Was the last copied subtree folded?
4764 This is used to fold the tree back after pasting.")
4766 (defun org-cut-subtree ()
4767 "Cut the current subtree into the clipboard.
4768 This is a short-hand for marking the subtree and then cutting it."
4769 (interactive)
4770 (org-copy-subtree 'cut))
4772 (defun org-copy-subtree (&optional cut)
4773 "Cut the current subtree into the clipboard.
4774 This is a short-hand for marking the subtree and then copying it.
4775 If CUT is non-nil, actually cut the subtree."
4776 (interactive)
4777 (let (beg end folded)
4778 (org-back-to-heading)
4779 (setq beg (point))
4780 (save-match-data
4781 (save-excursion (outline-end-of-heading)
4782 (setq folded (org-invisible-p)))
4783 (outline-end-of-subtree))
4785 (setq end (point))
4786 (goto-char beg)
4787 (when (> end beg)
4788 (setq org-subtree-clip-folded folded)
4789 (if cut (kill-region beg end) (copy-region-as-kill beg end))
4790 (setq org-subtree-clip (current-kill 0))
4791 (message "%s: Subtree with %d characters"
4792 (if cut "Cut" "Copied")
4793 (length org-subtree-clip)))))
4795 (defun org-paste-subtree (&optional level tree)
4796 "Paste the clipboard as a subtree, with modification of headline level.
4797 The entire subtree is promoted or demoted in order to match a new headline
4798 level. By default, the new level is derived from the visible headings
4799 before and after the insertion point, and taken to be the inferior headline
4800 level of the two. So if the previous visible heading is level 3 and the
4801 next is level 4 (or vice versa), level 4 will be used for insertion.
4802 This makes sure that the subtree remains an independent subtree and does
4803 not swallow low level entries.
4805 You can also force a different level, either by using a numeric prefix
4806 argument, or by inserting the heading marker by hand. For example, if the
4811 If optional TREE is given, use this text instead of the kill ring."
4812 (interactive "P")
4813 (unless (org-kill-is-subtree-p tree)
4814 (error
4815 (substitute-command-keys
4817 (let* ((txt (or tree (and kill-ring (current-kill 0))))
4822 (old-level (if (string-match ^re txt)
4823 (- (match-end 0) (match-beginning 0))
4824 -1))
4825 (force-level (cond (level (prefix-numeric-value level))
4826 ((string-match
4827 ^re_ (buffer-substring (point-at-bol) (point)))
4828 (- (match-end 0) (match-beginning 0)))
4829 (t nil)))
4830 (previous-level (save-excursion
4831 (condition-case nil
4832 (progn
4833 (outline-previous-visible-heading 1)
4834 (if (looking-at re)
4835 (- (match-end 0) (match-beginning 0))
4836 1))
4837 (error 1))))
4838 (next-level (save-excursion
4839 (condition-case nil
4840 (progn
4841 (outline-next-visible-heading 1)
4842 (if (looking-at re)
4843 (- (match-end 0) (match-beginning 0))
4844 1))
4845 (error 1))))
4846 (new-level (or force-level (max previous-level next-level)))
4847 (shift (if (or (= old-level -1)
4848 (= new-level -1)
4849 (= old-level new-level))
4850 0
4851 (- new-level old-level)))
4852 (shift1 shift)
4853 (delta (if (> shift 0) -1 1))
4854 (func (if (> shift 0) 'org-demote 'org-promote))
4855 (org-odd-levels-only nil)
4856 beg end)
4857 ;; Remove the forces level indicator
4858 (if force-level
4859 (delete-region (point-at-bol) (point)))
4860 ;; Make sure we start at the beginning of an empty line
4864 ;; Paste
4865 (setq beg (point))
4868 (insert txt)
4869 (setq end (point))
4872 (goto-char beg)
4873 ;; Shift if necessary
4874 (if (= shift 0)
4875 (message "Pasted at level %d, without shift" new-level)
4876 (save-restriction
4877 (narrow-to-region beg end)
4878 (while (not (= shift 0))
4879 (org-map-region func (point-min) (point-max))
4880 (setq shift (+ delta shift)))
4881 (goto-char (point-min))
4882 (message "Pasted at level %d, with shift by %d levels"
4883 new-level shift1)))
4884 (if (and kill-ring
4885 (eq org-subtree-clip (current-kill 0))
4886 org-subtree-clip-folded)
4887 ;; The tree was folded before it was killed/copied
4888 (hide-subtree))))
4890 (defun org-kill-is-subtree-p (&optional txt)
4891 "Check if the current kill is an outline subtree, or a set of trees.
4892 Returns nil if kill does not start with a headline, or if the first
4893 headline level is not the largest headline level in the tree.
4894 So this will actually accept several entries of equal levels as well,
4895 which is OK for `org-paste-subtree'.
4896 If optional TXT is given, check this string instead of the current kill."
4897 (let* ((kill (or txt (and kill-ring (current-kill 0)) ""))
4898 (start-level (and kill
4900 (- (match-end 0) (match-beginning 0))))
4901 (re (concat "^" outline-regexp))
4902 (start 1))
4903 (if (not start-level)
4904 nil ;; does not even start with a heading
4905 (catch 'exit
4906 (while (setq start (string-match re kill (1+ start)))
4907 (if (< (- (match-end 0) (match-beginning 0)) start-level)
4908 (throw 'exit nil)))
4909 t))))
4911 (defun org-narrow-to-subtree ()
4912 "Narrow buffer to the current subtree."
4913 (interactive)
4914 (save-excursion
4915 (narrow-to-region
4916 (progn (org-back-to-heading) (point))
4917 (progn (org-end-of-subtree t) (point)))))
4920 ;;; Outline Sorting
4922 (defun org-sort (with-case)
4923 "Call `org-sort-entries' or `org-table-sort-lines', depending on context."
4924 (interactive "P")
4925 (if (org-at-table-p)
4926 (org-call-with-arg 'org-table-sort-lines with-case)
4927 (org-call-with-arg 'org-sort-entries with-case)))
4929 (defun org-sort-entries (&optional with-case sorting-type)
4930 "Sort entries on a certain level of an outline tree.
4931 If there is an active region, the entries in the region are sorted.
4932 Else, if the cursor is before the first entry, sort the top-level items.
4933 Else, the children of the entry at point are sorted.
4935 Sorting can be alphabetically, numerically, and by date/time as given by
4936 the first time stamp in the entry. The command prompts for the sorting
4937 type unless it has been given to the function through the SORTING-TYPE
4938 argument, which needs to a character, any of (?n ?N ?a ?A ?t ?T).
4940 Comparing entries ignores case by default. However, with an optional argument
4941 WITH-CASE, the sorting considers case as well. With two prefix arguments
4942 `C-u C-u', sorting is case-sensitive and duplicate entries will be removed."
4943 (interactive "P")
4944 (let ((unique (equal with-case '(16)))
4945 start beg end entries stars re re2 p nentries (nremoved 0)
4946 last txt what)
4947 ;; Find beginning and end of region to sort
4948 (cond
4949 ((org-region-active-p)
4950 ;; we will sort the region
4951 (setq end (region-end)
4952 what "region")
4953 (goto-char (region-beginning))
4954 (if (not (org-on-heading-p)) (outline-next-heading))
4955 (setq start (point)))
4956 ((or (org-on-heading-p)
4957 (condition-case nil (progn (org-back-to-heading) t) (error nil)))
4958 ;; we will sort the children of the current headline
4959 (org-back-to-heading)
4960 (setq start (point) end (org-end-of-subtree) what "children")
4961 (goto-char start)
4962 (show-subtree)
4963 (outline-next-heading))
4964 (t
4965 ;; we will sort the top-level entries in this file
4966 (goto-char (point-min))
4967 (or (org-on-heading-p) (outline-next-heading))
4968 (setq start (point) end (point-max) what "top-level")
4969 (goto-char start)
4970 (show-all)))
4971 (setq beg (point))
4972 (if (>= (point) end) (error "Nothing to sort"))
4974 (setq stars (match-string 1)
4975 re (concat "^" (regexp-quote stars) " +")
4976 re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[^*]")
4977 txt (buffer-substring beg end))
4979 (if (and (not (equal stars "*")) (string-match re2 txt))
4980 (error "Region to sort contains a level above the first entry"))
4981 ;; Make a list that can be sorted.
4982 ;; The car is the string for comparison, the cdr is the subtree
4983 (message "Sorting entries...")
4984 (setq entries
4985 (mapcar
4986 (lambda (x)
4988 (cons (match-string 0 x) x))
4989 (org-split-string txt re)))
4991 ;; Sort the list
4992 (save-excursion
4993 (goto-char start)
4994 (setq entries (org-do-sort entries what with-case sorting-type)))
4996 ;; Delete the old stuff
4997 (goto-char beg)
4998 (kill-region beg end)
4999 (setq nentries (length entries))
5000 ;; Insert the sorted entries, and remove duplicates if this is required
5001 (while (setq p (pop entries))
5002 (if (and unique (equal last (setq last (org-trim (cdr p)))))
5003 (setq nremoved (1+ nremoved)) ; same entry as before, skip it
5004 (insert stars " " (cdr p))))
5005 (goto-char start)
5006 (message "Sorting entries...done (%d entries%s)"
5007 nentries
5008 (if unique (format ", %d duplicates removed" nremoved) ""))))
5010 (defun org-do-sort (table what &optional with-case sorting-type)
5011 "Sort TABLE of WHAT according to SORTING-TYPE.
5012 The user will be prompted for the SORTING-TYPE if the call to this
5013 function does not specify it. WHAT is only for the prompt, to indicate
5014 what is being sorted. The sorting key will be extracted from
5015 the car of the elements of the table.
5016 If WITH-CASE is non-nil, the sorting will be case-sensitive."
5017 (unless sorting-type
5018 (message
5019 "Sort %s: [a]lphabetically [n]umerically [t]ime. A/N/T means reversed:"
5020 what)
5021 (setq sorting-type (read-char-exclusive)))
5022 (let ((dcst (downcase sorting-type))
5023 extractfun comparefun)
5024 ;; Define the appropriate functions
5025 (cond
5026 ((= dcst ?n)
5027 (setq extractfun 'string-to-number
5028 comparefun (if (= dcst sorting-type) '< '>)))
5029 ((= dcst ?a)
5030 (setq extractfun (if with-case 'identity 'downcase)
5031 comparefun (if (= dcst sorting-type)
5032 'string<
5033 (lambda (a b) (and (not (string< a b))
5034 (not (string= a b)))))))
5035 ((= dcst ?t)
5036 (setq extractfun
5037 (lambda (x)
5038 (if (string-match org-ts-regexp x)
5039 (time-to-seconds
5040 (org-time-string-to-time (match-string 0 x)))
5041 0))
5042 comparefun (if (= dcst sorting-type) '< '>)))
5043 (t (error "Invalid sorting type `%c'" sorting-type)))
5045 (sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x)))
5046 table)
5047 (lambda (a b) (funcall comparefun (car a) (car b))))))
5049 ;;;; Plain list items, including checkboxes
5051 ;;; Plain list items
5053 (defun org-at-item-p ()
5054 "Is point in a line starting a hand-formatted item?"
5055 (let ((llt org-plain-list-ordered-item-terminator))
5056 (save-excursion
5057 (goto-char (point-at-bol))
5058 (looking-at
5059 (cond
5063 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))))))
5066 (defun org-in-item-p ()
5067 "It the cursor inside a plain list item.
5068 Does not have to be the first line."
5069 (save-excursion
5070 (condition-case nil
5071 (progn
5072 (org-beginning-of-item)
5073 (org-at-item-p)
5074 t)
5075 (error nil))))
5077 (defun org-insert-item (&optional checkbox)
5078 "Insert a new item at the current level.
5079 Return t when things worked, nil when we are not in an item."
5080 (when (save-excursion
5081 (condition-case nil
5082 (progn
5083 (org-beginning-of-item)
5084 (org-at-item-p)
5085 (if (org-invisible-p) (error "Invisible item"))
5086 t)
5087 (error nil)))
5088 (let* ((bul (match-string 0))
5090 (match-end 0)))
5091 (blank (cdr (assq 'plain-list-item org-blank-before-new-entry)))
5092 pos)
5093 (cond
5094 ((and (org-at-item-p) (<= (point) eow))
5095 ;; before the bullet
5096 (beginning-of-line 1)
5097 (open-line (if blank 2 1)))
5098 ((<= (point) eow)
5099 (beginning-of-line 1))
5100 (t (newline (if blank 2 1))))
5101 (insert bul (if checkbox "[ ]" ""))
5102 (just-one-space)
5103 (setq pos (point))
5104 (end-of-line 1)
5105 (unless (= (point) pos) (just-one-space) (backward-delete-char 1)))
5106 (org-maybe-renumber-ordered-list)
5107 (and checkbox (org-update-checkbox-count-maybe))
5108 t))
5110 ;;; Checkboxes
5112 (defun org-at-item-checkbox-p ()
5113 "Is point at a line starting a plain-list item with a checklet?"
5114 (and (org-at-item-p)
5115 (save-excursion
5116 (goto-char (match-end 0))
5120 (defun org-toggle-checkbox (&optional arg)
5121 "Toggle the checkbox in the current line."
5122 (interactive "P")
5123 (catch 'exit
5124 (let (beg end status (firstnew 'unknown))
5125 (cond
5126 ((org-region-active-p)
5127 (setq beg (region-beginning) end (region-end)))
5128 ((org-on-heading-p)
5129 (setq beg (point) end (save-excursion (outline-next-heading) (point))))
5130 ((org-at-item-checkbox-p)
5131 (save-excursion
5132 (replace-match (if (equal (match-string 0) "[ ]") "[X]" "[ ]") t t))
5133 (throw 'exit t))
5134 (t (error "Not at a checkbox or heading, and no active region")))
5135 (save-excursion
5136 (goto-char beg)
5137 (while (< (point) end)
5138 (when (org-at-item-checkbox-p)
5139 (setq status (equal (match-string 0) "[X]"))
5140 (when (eq firstnew 'unknown)
5141 (setq firstnew (not status)))
5142 (replace-match
5143 (if (if arg (not status) firstnew) "[X]" "[ ]") t t))
5144 (beginning-of-line 2)))))
5145 (org-update-checkbox-count-maybe))
5147 (defun org-update-checkbox-count-maybe ()
5148 "Update checkbox statistics unless turned off by user."
5149 (when org-provide-checkbox-statistics
5150 (org-update-checkbox-count)))
5152 (defun org-update-checkbox-count (&optional all)
5153 "Update the checkbox statistics in the current section.
5154 This will find all statistic cookies like [57%] and [6/12] and update them
5155 with the current numbers. With optional prefix argument ALL, do this for
5156 the whole buffer."
5157 (interactive "P")
5158 (save-excursion
5159 (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21
5160 (beg (progn (outline-back-to-heading) (point)))
5161 (end (move-marker (make-marker)
5162 (progn (outline-next-heading) (point))))
5165 b1 e1 f1 c-on c-off lim (cstat 0))
5166 (when all
5167 (goto-char (point-min))
5168 (outline-next-heading)
5169 (setq beg (point) end (point-max)))
5170 (goto-char beg)
5171 (while (re-search-forward re end t)
5172 (setq cstat (1+ cstat)
5173 b1 (match-beginning 0)
5174 e1 (match-end 0)
5175 f1 (match-beginning 1)
5176 lim (cond
5177 ((org-on-heading-p) (outline-next-heading) (point))
5178 ((org-at-item-p) (org-end-of-item) (point))
5179 (t nil))
5180 c-on 0 c-off 0)
5181 (goto-char e1)
5182 (when lim
5183 (while (re-search-forward re-box lim t)
5184 (if (equal (match-string 2) "[ ]")
5185 (setq c-off (1+ c-off))
5186 (setq c-on (1+ c-on))))
5187 (delete-region b1 e1)
5188 (goto-char b1)
5189 (insert (if f1
5190 (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off))))
5191 (format "[%d/%d]" c-on (+ c-on c-off))))))
5192 (when (interactive-p)
5193 (message "Checkbox satistics updated %s (%d places)"
5194 (if all "in entire file" "in current outline entry") cstat)))))
5196 (defun org-get-checkbox-statistics-face ()
5197 "Select the face for checkbox statistics.
5198 The face will be `org-done' when all relevant boxes are checked. Otherwise
5199 it will be `org-todo'."
5200 (if (match-end 1)
5201 (if (equal (match-string 1) "100%") 'org-done 'org-todo)
5202 (if (and (> (match-end 2) (match-beginning 2))
5203 (equal (match-string 2) (match-string 3)))
5204 'org-done
5205 'org-todo)))
5207 (defun org-get-indentation (&optional line)
5208 "Get the indentation of the current line, interpreting tabs.
5209 When LINE is given, assume it represents a line and compute its indentation."
5210 (if line
5211 (if (string-match "^ *" (org-remove-tabs line))
5212 (match-end 0))
5213 (save-excursion
5214 (beginning-of-line 1)
5216 (current-column))))
5218 (defun org-remove-tabs (s &optional width)
5219 "Replace tabulators in S with spaces.
5220 Assumes that s is a single line, starting in column 0."
5221 (setq width (or width tab-width))
5223 (setq s (replace-match
5224 (make-string
5225 (- (* width (/ (+ (match-beginning 0) width) width))
5226 (match-beginning 0)) ?\ )
5227 t t s)))
5228 s)
5230 (defun org-fix-indentation (line ind)
5231 "Fix indentation in LINE.
5232 IND is a cons cell with target and minimum indentation.
5233 If the current indenation in LINE is smaller than the minimum,
5234 leave it alone. If it is larger than ind, set it to the target."
5235 (let* ((l (org-remove-tabs line))
5236 (i (org-get-indentation l))
5237 (i1 (car ind)) (i2 (cdr ind)))
5238 (if (>= i i2) (setq l (substring line i2)))
5239 (if (> i1 0)
5240 (concat (make-string i1 ?\ ) l)
5241 l)))
5243 (defun org-beginning-of-item ()
5244 "Go to the beginning of the current hand-formatted item.
5245 If the cursor is not in an item, throw an error."
5246 (interactive)
5247 (let ((pos (point))
5248 (limit (save-excursion (org-back-to-heading)
5249 (beginning-of-line 2) (point)))
5250 ind ind1)
5251 (if (org-at-item-p)
5252 (beginning-of-line 1)
5253 (beginning-of-line 1)
5255 (setq ind (current-column))
5256 (if (catch 'exit
5257 (while t
5258 (beginning-of-line 0)
5259 (if (< (point) limit) (throw 'exit nil))
5262 (setq ind1 (current-column))
5263 (if (< ind1 ind)
5264 (throw 'exit (org-at-item-p))))))
5265 nil
5266 (goto-char pos)
5267 (error "Not in an item")))))
5269 (defun org-end-of-item ()
5270 "Go to the end of the current hand-formatted item.
5271 If the cursor is not in an item, throw an error."
5272 (interactive)
5273 (let ((pos (point))
5274 (limit (save-excursion (outline-next-heading) (point)))
5275 (ind (save-excursion
5276 (org-beginning-of-item)
5278 (current-column)))
5279 ind1)
5280 (if (catch 'exit
5281 (while t
5282 (beginning-of-line 2)
5283 (if (>= (point) limit) (throw 'exit t))
5286 (setq ind1 (current-column))
5287 (if (<= ind1 ind) (throw 'exit t)))))
5288 (beginning-of-line 1)
5289 (goto-char pos)
5290 (error "Not in an item"))))
5292 (defun org-next-item ()
5293 "Move to the beginning of the next item in the current plain list.
5294 Error if not at a plain list, or if this is the last item in the list."
5295 (interactive)
5296 (let (ind ind1 (pos (point)))
5297 (org-beginning-of-item)
5298 (setq ind (org-get-indentation))
5299 (org-end-of-item)
5300 (setq ind1 (org-get-indentation))
5301 (unless (and (org-at-item-p) (= ind ind1))
5302 (goto-char pos)
5303 (error "On last item"))))
5305 (defun org-previous-item ()
5306 "Move to the beginning of the previous item in the current plain list.
5307 Error if not at a plain list, or if this is the last item in the list."
5308 (interactive)
5309 (let (beg ind (pos (point)))
5310 (org-beginning-of-item)
5311 (setq beg (point))
5312 (setq ind (org-get-indentation))
5313 (goto-char beg)
5314 (catch 'exit
5315 (while t
5316 (beginning-of-line 0)
5318 nil
5319 (if (<= (org-get-indentation) ind)
5320 (throw 'exit t)))))
5321 (condition-case nil
5322 (org-beginning-of-item)
5323 (error (goto-char pos)
5324 (error "On first item")))))
5326 (defun org-move-item-down ()
5327 "Move the plain list item at point down, i.e. swap with following item.
5328 Subitems (items with larger indentation) are considered part of the item,
5329 so this really moves item trees."
5330 (interactive)
5331 (let (beg end ind ind1 (pos (point)) txt)
5332 (org-beginning-of-item)
5333 (setq beg (point))
5334 (setq ind (org-get-indentation))
5335 (org-end-of-item)
5336 (setq end (point))
5337 (setq ind1 (org-get-indentation))
5338 (if (and (org-at-item-p) (= ind ind1))
5339 (progn
5340 (org-end-of-item)
5341 (setq txt (buffer-substring beg end))
5342 (save-excursion
5343 (delete-region beg end))
5344 (setq pos (point))
5345 (insert txt)
5346 (goto-char pos)
5347 (org-maybe-renumber-ordered-list))
5348 (goto-char pos)
5349 (error "Cannot move this item further down"))))
5351 (defun org-move-item-up (arg)
5352 "Move the plain list item at point up, i.e. swap with previous item.
5353 Subitems (items with larger indentation) are considered part of the item,
5354 so this really moves item trees."
5355 (interactive "p")
5356 (let (beg end ind ind1 (pos (point)) txt)
5357 (org-beginning-of-item)
5358 (setq beg (point))
5359 (setq ind (org-get-indentation))
5360 (org-end-of-item)
5361 (setq end (point))
5362 (goto-char beg)
5363 (catch 'exit
5364 (while t
5365 (beginning-of-line 0)
5367 nil
5368 (if (<= (setq ind1 (org-get-indentation)) ind)
5369 (throw 'exit t)))))
5370 (condition-case nil
5371 (org-beginning-of-item)
5372 (error (goto-char beg)
5373 (error "Cannot move this item further up")))
5374 (setq ind1 (org-get-indentation))
5375 (if (and (org-at-item-p) (= ind ind1))
5376 (progn
5377 (setq txt (buffer-substring beg end))
5378 (save-excursion
5379 (delete-region beg end))
5380 (setq pos (point))
5381 (insert txt)
5382 (goto-char pos)
5383 (org-maybe-renumber-ordered-list))
5384 (goto-char pos)
5385 (error "Cannot move this item further up"))))
5387 (defun org-maybe-renumber-ordered-list ()
5388 "Renumber the ordered list at point if setup allows it.
5389 This tests the user option `org-auto-renumber-ordered-lists' before
5390 doing the renumbering."
5391 (and org-auto-renumber-ordered-lists
5392 (org-at-item-p)
5393 (match-beginning 3)
5394 (org-renumber-ordered-list 1)))
5396 (defun org-get-string-indentation (s)
5397 "What indentation has S due to SPACE and TAB at the beginning of the string?"
5398 (let ((n -1) (i 0) (w tab-width) c)
5399 (catch 'exit
5400 (while (< (setq n (1+ n)) (length s))
5401 (setq c (aref s n))
5402 (cond ((= c ?\ ) (setq i (1+ i)))
5404 (t (throw 'exit t)))))
5405 i))
5407 (defun org-renumber-ordered-list (arg)
5408 "Renumber an ordered plain list.
5409 Cursor needs to be in the first line of an item, the line that starts
5411 (interactive "p")
5412 (unless (and (org-at-item-p)
5413 (match-beginning 3))
5414 (error "This is not an ordered list"))
5415 (let ((line (org-current-line))
5416 (col (current-column))
5417 (ind (org-get-string-indentation
5418 (buffer-substring (point-at-bol) (match-beginning 3))))
5419 ;; (term (substring (match-string 3) -1))
5420 ind1 (n (1- arg)))
5421 ;; find where this list begins
5422 (catch 'exit
5423 (while t
5424 (catch 'next
5425 (beginning-of-line 0)
5428 (if (or (< ind1 ind)
5429 (and (= ind1 ind)
5430 (not (org-at-item-p))))
5431 (throw 'exit t)))))
5432 ;; Walk forward and replace these numbers
5433 (catch 'exit
5434 (while t
5435 (catch 'next
5436 (beginning-of-line 2)
5437 (if (eobp) (throw 'exit nil))
5440 (if (> ind1 ind) (throw 'next t))
5441 (if (< ind1 ind) (throw 'exit t))
5442 (if (not (org-at-item-p)) (throw 'exit nil))
5443 (if (not (match-beginning 3))
5445 (delete-region (match-beginning 3) (1- (match-end 3)))
5446 (goto-char (match-beginning 3))
5447 (insert (format "%d" (setq n (1+ n)))))))
5448 (goto-line line)
5449 (move-to-column col)))
5451 (defvar org-last-indent-begin-marker (make-marker))
5452 (defvar org-last-indent-end-marker (make-marker))
5454 (defun org-outdent-item (arg)
5455 "Outdent a local list item."
5456 (interactive "p")
5457 (org-indent-item (- arg)))
5459 (defun org-indent-item (arg)
5460 "Indent a local list item."
5461 (interactive "p")
5462 (unless (org-at-item-p)
5463 (error "Not on an item"))
5464 (save-excursion
5465 (let (beg end ind ind1)
5466 (if (memq last-command '(org-shiftmetaright org-shiftmetaleft))
5467 (setq beg org-last-indent-begin-marker
5468 end org-last-indent-end-marker)
5469 (org-beginning-of-item)
5470 (setq beg (move-marker org-last-indent-begin-marker (point)))
5471 (org-end-of-item)
5472 (setq end (move-marker org-last-indent-end-marker (point))))
5473 (goto-char beg)
5475 (if (< (+ arg ind) 0) (error "Cannot outdent beyond margin"))
5476 (while (< (point) end)
5477 (beginning-of-line 1)
5479 (delete-region (point-at-bol) (point))
5480 (indent-to-column (+ ind1 arg))
5481 (beginning-of-line 2)))))
5483 ;;;; Archiving
5485 (defalias 'org-advertized-archive-subtree 'org-archive-subtree)
5487 (defun org-archive-subtree (&optional find-done)
5488 "Move the current subtree to the archive.
5489 The archive can be a certain top-level heading in the current file, or in
5490 a different file. The tree will be moved to that location, the subtree
5491 heading be marked DONE, and the current time will be added.
5493 When called with prefix argument FIND-DONE, find whole trees without any
5494 open TODO items and archive them (after getting confirmation from the user).
5495 If the cursor is not at a headline when this comand is called, try all level
5496 1 trees. If the cursor is on a headline, only try the direct children of
5497 this heading. "
5498 (interactive "P")
5499 (if find-done
5500 (org-archive-all-done)
5501 ;; Save all relevant TODO keyword-relatex variables
5503 (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler
5504 (tr-org-todo-keywords org-todo-keywords)
5505 (tr-org-todo-interpretation org-todo-interpretation)
5506 (tr-org-done-string org-done-string)
5507 (tr-org-todo-regexp org-todo-regexp)
5508 (tr-org-todo-line-regexp org-todo-line-regexp)
5509 (tr-org-odd-levels-only org-odd-levels-only)
5510 (this-buffer (current-buffer))
5511 (org-archive-location org-archive-location)
5513 file heading buffer level newfile-p)
5515 ;; Try to find a local archive location
5516 (save-excursion
5517 (if (or (re-search-backward re nil t) (re-search-forward re nil t))
5518 (setq org-archive-location (match-string 1))))
5521 (progn
5522 (setq file (format (match-string 1 org-archive-location)
5523 (file-name-nondirectory buffer-file-name))
5524 heading (match-string 2 org-archive-location)))
5525 (error "Invalid `org-archive-location'"))
5526 (if (> (length file) 0)
5527 (setq newfile-p (not (file-exists-p file))
5528 buffer (find-file-noselect file))
5529 (setq buffer (current-buffer)))
5530 (unless buffer
5532 (if (and (> (length heading) 0)
5534 (setq level (match-end 0))
5535 (setq heading nil level 0))
5536 (save-excursion
5537 ;; We first only copy, in case something goes wrong
5538 ;; we need to protect this-command, to avoid kill-region sets it,
5539 ;; which would lead to duplication of subtrees
5540 (let (this-command) (org-copy-subtree))
5541 (set-buffer buffer)
5542 ;; Enforce org-mode for the archive buffer
5543 (if (not (org-mode-p))
5544 ;; Force the mode for future visits.
5545 (let ((org-insert-mode-line-in-empty-file t))
5546 (call-interactively 'org-mode)))
5547 (when newfile-p
5548 (goto-char (point-max))
5550 (buffer-file-name this-buffer))))
5551 ;; Force the TODO keywords of the original buffer
5552 (let ((org-todo-line-regexp tr-org-todo-line-regexp)
5553 (org-todo-keywords tr-org-todo-keywords)
5554 (org-todo-interpretation tr-org-todo-interpretation)
5555 (org-done-string tr-org-done-string)
5556 (org-todo-regexp tr-org-todo-regexp)
5557 (org-todo-line-regexp tr-org-todo-line-regexp)
5558 (org-odd-levels-only
5559 (if (local-variable-p 'org-odd-levels-only (current-buffer))
5560 org-odd-levels-only
5561 tr-org-odd-levels-only)))
5562 (goto-char (point-min))
5563 (if heading
5564 (progn
5565 (if (re-search-forward
5568 nil t)
5569 (goto-char (match-end 0))
5570 ;; Heading not found, just insert it at the end
5571 (goto-char (point-max))
5574 (end-of-line 0))
5575 ;; Make the subtree visible
5576 (show-subtree)
5577 (org-end-of-subtree t)
5581 ;; No specific heading, just go to end of file.
5583 ;; Paste
5584 (org-paste-subtree (org-get-legal-level level 1))
5585 ;; Mark the entry as done, i.e. set to last work in org-todo-keywords
5586 (if org-archive-mark-done
5587 (let (org-log-done)
5588 (org-todo (length org-todo-keywords))))
5589 ;; Move cursor to right after the TODO keyword
5590 (when org-archive-stamp-time
5591 (beginning-of-line 1)
5592 (looking-at org-todo-line-regexp)
5593 (goto-char (or (match-end 2) (match-beginning 3)))
5594 (org-insert-time-stamp (org-current-time) t t "(" ")"))
5595 ;; Save the buffer, if it is not the same buffer.
5596 (if (not (eq this-buffer buffer)) (save-buffer))))
5597 ;; Here we are back in the original buffer. Everything seems to have
5598 ;; worked. So now cut the tree and finish up.
5599 (let (this-command) (org-cut-subtree))
5601 (message "Subtree archived %s"
5602 (if (eq this-buffer buffer)
5603 (concat "under heading: " heading)
5604 (concat "in file: " (abbreviate-file-name file)))))))
5606 (defun org-archive-all-done (&optional tag)
5607 "Archive sublevels of the current tree without open TODO items.
5608 If the cursor is not on a headline, try all level 1 trees. If
5609 it is on a headline, try all direct children.
5610 When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
5612 (rea (concat ".*:" org-archive-tag ":"))
5613 (begm (make-marker))
5614 (endm (make-marker))
5615 (question (if tag "Set ARCHIVE tag (no open TODO items)? "
5616 "Move subtree to archive (no open TODO items)? "))
5617 beg end (cntarch 0))
5618 (if (org-on-heading-p)
5619 (progn
5620 (setq re1 (concat "^" (regexp-quote
5621 (make-string
5622 (1+ (- (match-end 0) (match-beginning 0)))
5623 ?*))
5624 " "))
5625 (move-marker begm (point))
5626 (move-marker endm (org-end-of-subtree t)))
5627 (setq re1 "^* ")
5628 (move-marker begm (point-min))
5629 (move-marker endm (point-max)))
5630 (save-excursion
5631 (goto-char begm)
5632 (while (re-search-forward re1 endm t)
5633 (setq beg (match-beginning 0)
5634 end (save-excursion (org-end-of-subtree t) (point)))
5635 (goto-char beg)
5636 (if (re-search-forward re end t)
5637 (goto-char end)
5638 (goto-char beg)
5639 (if (and (or (not tag) (not (looking-at rea)))
5640 (y-or-n-p question))
5641 (progn
5642 (if tag
5643 (org-toggle-tag org-archive-tag 'on)
5644 (org-archive-subtree))
5645 (setq cntarch (1+ cntarch)))
5646 (goto-char end)))))
5647 (message "%d trees archived" cntarch)))
5649 (defun org-cycle-hide-archived-subtrees (state)
5650 "Re-hide all archived subtrees after a visibility state change."
5651 (when (and (not org-cycle-open-archived-trees)
5652 (not (memq state '(overview folded))))
5653 (save-excursion
5654 (let* ((globalp (memq state '(contents all)))
5655 (beg (if globalp (point-min) (point)))
5656 (end (if globalp (point-max) (org-end-of-subtree t))))
5657 (org-hide-archived-subtrees beg end)
5658 (goto-char beg)
5659 (if (looking-at (concat ".*:" org-archive-tag ":"))
5660 (message (substitute-command-keys
5661 "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway.")))))))
5663 (defun org-force-cycle-archived ()
5664 "Cycle subtree even if it is archived."
5665 (interactive)
5666 (setq this-command 'org-cycle)
5667 (let ((org-cycle-open-archived-trees t))
5668 (call-interactively 'org-cycle)))
5670 (defun org-hide-archived-subtrees (beg end)
5671 "Re-hide all archived subtrees after a visibility state change."
5672 (save-excursion
5673 (let* ((re (concat ":" org-archive-tag ":")))
5674 (goto-char beg)
5675 (while (re-search-forward re end t)
5676 (and (org-on-heading-p) (hide-subtree))
5677 (org-end-of-subtree t)))))
5679 (defun org-toggle-tag (tag &optional onoff)
5680 "Toggle the tag TAG for the current line.
5681 If ONOFF is `on' or `off', don't toggle but set to this state."
5682 (unless (org-on-heading-p t) (error "Not on headling"))
5683 (let (res current)
5684 (save-excursion
5685 (beginning-of-line)
5687 (point-at-eol) t)
5688 (progn
5689 (setq current (match-string 1))
5690 (replace-match ""))
5691 (setq current ""))
5692 (setq current (nreverse (org-split-string current ":")))
5693 (cond
5694 ((eq onoff 'on)
5695 (setq res t)
5696 (or (member tag current) (push tag current)))
5697 ((eq onoff 'off)
5698 (or (not (member tag current)) (setq current (delete tag current))))
5699 (t (if (member tag current)
5700 (setq current (delete tag current))
5701 (setq res t)
5702 (push tag current))))
5703 (end-of-line 1)
5704 (when current
5705 (insert " :" (mapconcat 'identity (nreverse current) ":") ":"))
5706 (org-set-tags nil t))
5707 res))
5709 (defun org-toggle-archive-tag (&optional arg)
5710 "Toggle the archive tag for the current headline.
5711 With prefix ARG, check all children of current headline and offer tagging
5712 the children that do not contain any open TODO items."
5713 (interactive "P")
5714 (if arg
5715 (org-archive-all-done 'tag)
5716 (let (set)
5717 (save-excursion
5718 (org-back-to-heading t)
5719 (setq set (org-toggle-tag org-archive-tag))
5720 (when set (hide-subtree)))
5721 (and set (beginning-of-line 1))
5722 (message "Subtree %s" (if set "archived" "unarchived")))))
5725 ;;;; Tables
5727 ;;; The table editor
5729 ;; Watch out: Here we are talking about two different kind of tables.
5730 ;; Most of the code is for the tables created with the Org-mode table editor.
5731 ;; Sometimes, we talk about tables created and edited with the table.el
5732 ;; Emacs package. We call the former org-type tables, and the latter
5733 ;; table.el-type tables.
5735 (defun org-before-change-function (beg end)
5736 "Every change indicates that a table might need an update."
5737 (setq org-table-may-need-update t))
5740 "Detects an org-type table line.")
5742 "Detects an org-type table line.")
5744 "Detects a table line marked for automatic recalculation.")
5746 "Detects a table line marked for automatic recalculation.")
5748 "Detects a table line marked for automatic recalculation.")
5750 "Detects an org-type table hline.")
5752 "Detects a table-type table hline.")
5754 "Detects an org-type or table-type table.")
5756 "Searching from within a table (any type) this finds the first line
5757 outside the table.")
5759 "Searching from within a table (any type) this finds the first line
5760 outside the table.")
5762 (defvar org-table-last-highlighted-reference nil)
5763 (defvar org-table-formula-history nil)
5765 (defvar org-table-column-names nil
5766 "Alist with column names, derived from the `!' line.")
5767 (defvar org-table-column-name-regexp nil
5768 "Regular expression matching the current column names.")
5769 (defvar org-table-local-parameters nil
5770 "Alist with parameter names, derived from the `$' line.")
5771 (defvar org-table-named-field-locations nil
5772 "Alist with locations of named fields.")
5774 (defvar org-table-current-line-types nil
5775 "Table row types, non-nil only for the duration of a comand.")
5776 (defvar org-table-current-begin-line nil
5777 "Table begin line, non-nil only for the duration of a comand.")
5778 (defvar org-table-current-begin-pos nil
5779 "Table begin position, non-nil only for the duration of a comand.")
5780 (defvar org-table-dlines nil
5781 "Vector of data line line numbers in the current table.")
5782 (defvar org-table-hlines nil
5783 "Vector of hline line numbers in the current table.")
5785 (defconst org-table-range-regexp
5786 "@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?"
5787 ;; 1 2 3 4 5
5788 "Regular expression for matching ranges in formulas.")
5790 (defconst org-table-range-regexp2
5791 (concat
5795 "Match a range for reference display.")
5797 (defconst org-table-translate-regexp
5799 "Match a reference that needs translation, for reference display.")
5801 (defvar org-inhibit-highlight-removal nil) ; dynamically scoped param
5803 (defun org-table-create-with-table.el ()
5804 "Use the table.el package to insert a new table.
5805 If there is already a table at point, convert between Org-mode tables
5806 and table.el tables."
5807 (interactive)
5808 (require 'table)
5809 (cond
5810 ((org-at-table.el-p)
5811 (if (y-or-n-p "Convert table to Org-mode table? ")
5812 (org-table-convert)))
5813 ((org-at-table-p)
5814 (if (y-or-n-p "Convert table to table.el table? ")
5815 (org-table-convert)))
5816 (t (call-interactively 'table-insert))))
5818 (defun org-table-create-or-convert-from-region (arg)
5819 "Convert region to table, or create an empty table.
5820 If there is an active region, convert it to a table. If there is no such
5821 region, create an empty table."
5822 (interactive "P")
5823 (if (org-region-active-p)
5824 (org-table-convert-region (region-beginning) (region-end) arg)
5825 (org-table-create arg)))
5827 (defun org-table-create (&optional size)
5828 "Query for a size and insert a table skeleton.
5830 (interactive "P")
5831 (unless size
5832 (setq size (read-string
5833 (concat "Table size Columns x Rows [e.g. "
5834 org-table-default-size "]: ")
5835 "" nil org-table-default-size)))
5837 (let* ((pos (point))
5838 (indent (make-string (current-column) ?\ ))
5839 (split (org-split-string size " *x *"))
5840 (rows (string-to-number (nth 1 split)))
5841 (columns (string-to-number (car split)))
5842 (line (concat (apply 'concat indent "|" (make-list columns " |"))
5845 (point-at-bol) (point)))
5846 (beginning-of-line 1)
5847 (newline))
5848 ;; (mapcar (lambda (x) (insert line)) (make-list rows t))
5849 (dotimes (i rows) (insert line))
5850 (goto-char pos)
5851 (if (> rows 1)
5852 ;; Insert a hline after the first row.
5853 (progn
5854 (end-of-line 1)
5856 (goto-char pos)))
5857 (org-table-align)))
5859 (defun org-table-convert-region (beg0 end0 &optional nspace)
5860 "Convert region to a table.
5861 The region goes from BEG0 to END0, but these borders will be moved
5862 slightly, to make sure a beginning of line in the first line is included.
5863 When NSPACE is non-nil, it indicates the minimum number of spaces that
5864 separate columns (default: just one space)."
5865 (interactive "rP")
5866 (let* ((beg (min beg0 end0))
5867 (end (max beg0 end0))
5868 (tabsep t)
5869 re)
5870 (goto-char beg)
5871 (beginning-of-line 1)
5872 (setq beg (move-marker (make-marker) (point)))
5873 (goto-char end)
5874 (if (bolp) (backward-char 1) (end-of-line 1))
5875 (setq end (move-marker (make-marker) (point)))
5876 ;; Lets see if this is tab-separated material. If every nonempty line
5877 ;; contains a tab, we will assume that it is tab-separated material
5878 (if nspace
5879 (setq tabsep nil)
5880 (goto-char beg)
5882 (if nspace (setq tabsep nil))
5883 (if tabsep
5886 (max 1 (prefix-numeric-value nspace)))))
5887 (goto-char beg)
5888 (while (re-search-forward re end t)
5889 (replace-match "| " t t))
5890 (goto-char beg)
5891 (insert " ")
5892 (org-table-align)))
5894 (defun org-table-import (file arg)
5895 "Import FILE as a table.
5896 The file is assumed to be tab-separated. Such files can be produced by most
5897 spreadsheet and database applications. If no tabs (at least one per line)
5898 are found, lines will be split on whitespace into fields."
5900 (or (bolp) (newline))
5901 (let ((beg (point))
5902 (pm (point-max)))
5903 (insert-file-contents file)
5904 (org-table-convert-region beg (+ (point) (- (point-max) pm)) arg)))
5906 (defun org-table-export ()
5907 "Export table as a tab-separated file.
5908 Such a file can be imported into a spreadsheet program like Excel."
5909 (interactive)
5910 (let* ((beg (org-table-begin))
5911 (end (org-table-end))
5912 (table (buffer-substring beg end))
5913 (file (read-file-name "Export table to: "))
5914 buf)
5915 (unless (or (not (file-exists-p file))
5916 (y-or-n-p (format "Overwrite file %s? " file)))
5917 (error "Abort"))
5918 (with-current-buffer (find-file-noselect file)
5919 (setq buf (current-buffer))
5920 (erase-buffer)
5921 (fundamental-mode)
5922 (insert table)
5923 (goto-char (point-min))
5925 (replace-match "" t t)
5926 (end-of-line 1))
5927 (goto-char (point-min))
5929 (replace-match "" t t)
5930 (goto-char (min (1+ (point)) (point-max))))
5931 (goto-char (point-min))
5932 (while (re-search-forward "^-[-+]*$" nil t)
5933 (replace-match "")
5935 (delete-char 1)))
5936 (goto-char (point-min))
5939 (save-buffer))
5940 (kill-buffer buf)))
5942 (defvar org-table-aligned-begin-marker (make-marker)
5943 "Marker at the beginning of the table last aligned.
5944 Used to check if cursor still is in that table, to minimize realignment.")
5945 (defvar org-table-aligned-end-marker (make-marker)
5946 "Marker at the end of the table last aligned.
5947 Used to check if cursor still is in that table, to minimize realignment.")
5948 (defvar org-table-last-alignment nil
5949 "List of flags for flushright alignment, from the last re-alignment.
5950 This is being used to correctly align a single field after TAB or RET.")
5951 (defvar org-table-last-column-widths nil
5952 "List of max width of fields in each column.
5953 This is being used to correctly align a single field after TAB or RET.")
5954 (defvar org-table-overlay-coordinates nil
5955 "Overlay coordinates after each align of a table.")
5956 (make-variable-buffer-local 'org-table-overlay-coordinates)
5958 (defvar org-last-recalc-line nil)
5959 (defconst org-narrow-column-arrow "=>"
5960 "Used as display property in narrowed table columns.")
5962 (defun org-table-align ()
5963 "Align the table at point by aligning all vertical bars."
5964 (interactive)
5965 (let* (
5966 ;; Limits of table
5967 (beg (org-table-begin))
5968 (end (org-table-end))
5969 ;; Current cursor position
5970 (linepos (org-current-line))
5971 (colpos (org-table-current-column))
5972 (winstart (window-start))
5973 (winstartline (org-current-line (min winstart (1- (point-max)))))
5974 lines (new "") lengths l typenums ty fields maxfields i
5975 column
5976 (indent "") cnt frac
5977 rfmt hfmt
5978 (spaces '(1 . 1))
5979 (sp1 (car spaces))
5980 (sp2 (cdr spaces))
5981 (rfmt1 (concat
5982 (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|"))
5983 (hfmt1 (concat
5984 (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+"))
5985 emptystrings links dates narrow fmax f1 len c e)
5986 (untabify beg end)
5987 (remove-text-properties beg end '(org-cwidth t org-dwidth t display t))
5988 ;; Check if we have links or dates
5989 (goto-char beg)
5990 (setq links (re-search-forward org-bracket-link-regexp end t))
5991 (goto-char beg)
5992 (setq dates (and org-display-custom-times
5993 (re-search-forward org-ts-regexp-both end t)))
5994 ;; Make sure the link properties are right
5995 (when links (goto-char beg) (while (org-activate-bracket-links end)))
5996 ;; Make sure the date properties are right
5997 (when dates (goto-char beg) (while (org-activate-dates end)))
5999 ;; Check if we are narrowing any columns
6000 (goto-char beg)
6001 (setq narrow (and org-format-transports-properties-p
6002 (re-search-forward "<[0-9]+>" end t)))
6003 ;; Get the rows
6004 (setq lines (org-split-string
6006 ;; Store the indentation of the first line
6007 (if (string-match "^ *" (car lines))
6008 (setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ )))
6009 ;; Mark the hlines by setting the corresponding element to nil
6010 ;; At the same time, we remove trailing space.
6011 (setq lines (mapcar (lambda (l)
6012 (if (string-match "^ *|-" l)
6013 nil
6015 (substring l 0 (match-beginning 0))
6016 l)))
6017 lines))
6018 ;; Get the data fields by splitting the lines.
6019 (setq fields (mapcar
6020 (lambda (l)
6021 (org-split-string l " *| *"))
6022 (delq nil (copy-sequence lines))))
6023 ;; How many fields in the longest line?
6024 (condition-case nil
6025 (setq maxfields (apply 'max (mapcar 'length fields)))
6026 (error
6027 (kill-region beg end)
6028 (org-table-create org-table-default-size)
6029 (error "Empty table - created default table")))
6030 ;; A list of empty strings to fill any short rows on output
6031 (setq emptystrings (make-list maxfields ""))
6032 ;; Check for special formatting.
6033 (setq i -1)
6034 (while (< (setq i (1+ i)) maxfields) ;; Loop over all columns
6035 (setq column (mapcar (lambda (x) (or (nth i x) "")) fields))
6036 ;; Check if there is an explicit width specified
6037 (when narrow
6038 (setq c column fmax nil)
6039 (while c
6040 (setq e (pop c))
6042 (setq fmax (string-to-number (match-string 1 e)) c nil)))
6043 ;; Find fields that are wider than fmax, and shorten them
6044 (when fmax
6045 (loop for xx in column do
6046 (when (and (stringp xx)
6047 (> (org-string-width xx) fmax))
6048 (org-add-props xx nil
6049 'help-echo
6050 (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx))))
6051 (setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax)))
6052 (unless (> f1 1)
6054 (match-string 0 xx)))
6055 (add-text-properties f1 (length xx) (list 'org-cwidth t) xx)
6056 (add-text-properties (- f1 2) f1
6057 (list 'display org-narrow-column-arrow)
6058 xx)))))
6059 ;; Get the maximum width for each column
6060 (push (apply 'max 1 (mapcar 'org-string-width column)) lengths)
6061 ;; Get the fraction of numbers, to decide about alignment of the column
6062 (setq cnt 0 frac 0.0)
6063 (loop for x in column do
6064 (if (equal x "")
6065 nil
6066 (setq frac ( / (+ (* frac cnt)
6067 (if (string-match org-table-number-regexp x) 1 0))
6068 (setq cnt (1+ cnt))))))
6069 (push (>= frac org-table-number-fraction) typenums))
6070 (setq lengths (nreverse lengths) typenums (nreverse typenums))
6072 ;; Store the alignment of this table, for later editing of single fields
6073 (setq org-table-last-alignment typenums
6074 org-table-last-column-widths lengths)
6076 ;; With invisible characters, `format' does not get the field width right
6077 ;; So we need to make these fields wide by hand.
6078 (when links
6079 (loop for i from 0 upto (1- maxfields) do
6080 (setq len (nth i lengths))
6081 (loop for j from 0 upto (1- (length fields)) do
6082 (setq c (nthcdr i (car (nthcdr j fields))))
6083 (if (and (stringp (car c))
6084 (string-match org-bracket-link-regexp (car c))
6085 (< (org-string-width (car c)) len))
6086 (setcar c (concat (car c) (make-string (- len (org-string-width (car c))) ?\ )))))))
6088 ;; Compute the formats needed for output of the table
6089 (setq rfmt (concat indent "|") hfmt (concat indent "|"))
6090 (while (setq l (pop lengths))
6091 (setq ty (if (pop typenums) "" "-")) ; number types flushright
6092 (setq rfmt (concat rfmt (format rfmt1 ty l))
6093 hfmt (concat hfmt (format hfmt1 (make-string l ?-)))))
6097 (setq new (mapconcat
6098 (lambda (l)
6099 (if l (apply 'format rfmt
6100 (append (pop fields) emptystrings))
6101 hfmt))
6102 lines ""))
6103 ;; Replace the old one
6104 (delete-region beg end)
6105 (move-marker end nil)
6106 (move-marker org-table-aligned-begin-marker (point))
6107 (insert new)
6108 (move-marker org-table-aligned-end-marker (point))
6109 (when (and orgtbl-mode (not (org-mode-p)))
6110 (goto-char org-table-aligned-begin-marker)
6111 (while (org-hide-wide-columns org-table-aligned-end-marker)))
6112 ;; Try to move to the old location
6113 (goto-line winstartline)
6114 (setq winstart (point-at-bol))
6115 (goto-line linepos)
6116 (set-window-start (selected-window) winstart 'noforce)
6117 (org-table-goto-column colpos)
6118 (and org-table-overlay-coordinates (org-table-overlay-coordinates))
6119 (setq org-table-may-need-update nil)
6120 ))
6122 (defun org-string-width (s)
6123 "Compute width of string, ignoring invisible characters.
6124 This ignores character with invisibility property `org-link', and also
6125 characters with property `org-cwidth', because these will become invisible
6126 upon the next fontification round."
6127 (let (b l)
6128 (when (or (eq t buffer-invisibility-spec)
6129 (assq 'org-link buffer-invisibility-spec))
6130 (while (setq b (text-property-any 0 (length s)
6131 'invisible 'org-link s))
6132 (setq s (concat (substring s 0 b)
6133 (substring s (or (next-single-property-change
6134 b 'invisible s) (length s)))))))
6135 (while (setq b (text-property-any 0 (length s) 'org-cwidth t s))
6136 (setq s (concat (substring s 0 b)
6137 (substring s (or (next-single-property-change
6138 b 'org-cwidth s) (length s))))))
6139 (setq l (string-width s) b -1)
6140 (while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s))
6141 (setq l (- l (get-text-property b 'org-dwidth-n s))))
6142 l))
6144 (defun org-table-begin (&optional table-type)
6145 "Find the beginning of the table and return its position.
6146 With argument TABLE-TYPE, go to the beginning of a table.el-type table."
6147 (save-excursion
6148 (if (not (re-search-backward
6149 (if table-type org-table-any-border-regexp
6150 org-table-border-regexp)
6151 nil t))
6152 (progn (goto-char (point-min)) (point))
6153 (goto-char (match-beginning 0))
6154 (beginning-of-line 2)
6155 (point))))
6157 (defun org-table-end (&optional table-type)
6158 "Find the end of the table and return its position.
6159 With argument TABLE-TYPE, go to the end of a table.el-type table."
6160 (save-excursion
6161 (if (not (re-search-forward
6162 (if table-type org-table-any-border-regexp
6163 org-table-border-regexp)
6164 nil t))
6165 (goto-char (point-max))
6166 (goto-char (match-beginning 0)))
6167 (point-marker)))
6169 (defun org-table-justify-field-maybe (&optional new)
6170 "Justify the current field, text to left, number to right.
6171 Optional argument NEW may specify text to replace the current field content."
6172 (cond
6173 ((and (not new) org-table-may-need-update)) ; Realignment will happen anyway
6174 ((org-at-table-hline-p))
6175 ((and (not new)
6176 (or (not (equal (marker-buffer org-table-aligned-begin-marker)
6177 (current-buffer)))
6178 (< (point) org-table-aligned-begin-marker)
6179 (>= (point) org-table-aligned-end-marker)))
6180 ;; This is not the same table, force a full re-align
6181 (setq org-table-may-need-update t))
6182 (t ;; realign the current field, based on previous full realign
6183 (let* ((pos (point)) s
6184 (col (org-table-current-column))
6185 (num (if (> col 0) (nth (1- col) org-table-last-alignment)))
6186 l f n o e)
6187 (when (> col 0)
6190 (progn
6191 (setq s (match-string 1)
6192 o (match-string 0)
6193 l (max 1 (- (match-end 0) (match-beginning 0) 3))
6194 e (not (= (match-beginning 2) (match-end 2))))
6195 (setq f (format (if num " %%%ds %s" " %%-%ds %s")
6196 l (if e "|" (setq org-table-may-need-update t) ""))
6197 n (format f s))
6198 (if new
6199 (if (<= (length new) l) ;; FIXME: length -> str-width?
6200 (setq n (format f new))
6201 (setq n (concat new "|") org-table-may-need-update t)))
6202 (or (equal n o)
6203 (let (org-table-may-need-update)
6204 (replace-match n))))
6205 (setq org-table-may-need-update t))
6206 (goto-char pos))))))
6208 (defun org-table-next-field ()
6209 "Go to the next field in the current table, creating new lines as needed.
6210 Before doing so, re-align the table if necessary."
6211 (interactive)
6212 (org-table-maybe-eval-formula)
6213 (org-table-maybe-recalculate-line)
6214 (if (and org-table-automatic-realign
6215 org-table-may-need-update)
6216 (org-table-align))
6217 (let ((end (org-table-end)))
6218 (if (org-at-table-hline-p)
6219 (end-of-line 1))
6220 (condition-case nil
6221 (progn
6222 (re-search-forward "|" end)
6224 (re-search-forward "|" end))
6225 (if (and (looking-at "-")
6226 org-table-tab-jumps-over-hlines
6228 (goto-char (match-beginning 1)))
6229 (if (looking-at "-")
6230 (progn
6231 (beginning-of-line 0)
6232 (org-table-insert-row 'below))
6233 (if (looking-at " ") (forward-char 1))))
6234 (error
6235 (org-table-insert-row 'below)))))
6237 (defun org-table-previous-field ()
6238 "Go to the previous field in the table.
6239 Before doing so, re-align the table if necessary."
6240 (interactive)
6241 (org-table-justify-field-maybe)
6242 (org-table-maybe-recalculate-line)
6243 (if (and org-table-automatic-realign
6244 org-table-may-need-update)
6245 (org-table-align))
6246 (if (org-at-table-hline-p)
6247 (end-of-line 1))
6248 (re-search-backward "|" (org-table-begin))
6249 (re-search-backward "|" (org-table-begin))
6251 (re-search-backward "|" (org-table-begin)))
6252 (if (looking-at "| ?")
6253 (goto-char (match-end 0))))
6255 (defun org-table-next-row ()
6256 "Go to the next row (same column) in the current table.
6257 Before doing so, re-align the table if necessary."
6258 (interactive)
6259 (org-table-maybe-eval-formula)
6260 (org-table-maybe-recalculate-line)
6263 (newline)
6264 (if (and org-table-automatic-realign
6265 org-table-may-need-update)
6266 (org-table-align))
6267 (let ((col (org-table-current-column)))
6268 (beginning-of-line 2)
6269 (if (or (not (org-at-table-p))
6270 (org-at-table-hline-p))
6271 (progn
6272 (beginning-of-line 0)
6273 (org-table-insert-row 'below)))
6274 (org-table-goto-column col)
6276 (if (looking-at " ") (forward-char 1)))))
6278 (defun org-table-copy-down (n)
6279 "Copy a field down in the current column.
6280 If the field at the cursor is empty, copy into it the content of the nearest
6281 non-empty field above. With argument N, use the Nth non-empty field.
6282 If the current field is not empty, it is copied down to the next row, and
6283 the cursor is moved with it. Therefore, repeating this command causes the
6284 column to be filled row-by-row.
6285 If the variable `org-table-copy-increment' is non-nil and the field is an
6286 integer, it will be incremented while copying."
6287 (interactive "p")
6288 (let* ((colpos (org-table-current-column))
6289 (field (org-table-get-field))
6291 (beg (org-table-begin))
6292 txt)
6293 (org-table-check-inside-data-field)
6294 (if non-empty
6295 (progn
6296 (setq txt (org-trim field))
6297 (org-table-next-row)
6298 (org-table-blank-field))
6299 (save-excursion
6300 (setq txt
6301 (catch 'exit
6302 (while (progn (beginning-of-line 1)
6303 (re-search-backward org-table-dataline-regexp
6304 beg t))
6305 (org-table-goto-column colpos t)
6306 (if (and (looking-at
6308 (= (setq n (1- n)) 0))
6309 (throw 'exit (match-string 1))))))))
6310 (if txt
6311 (progn
6312 (if (and org-table-copy-increment
6313 (string-match "^[0-9]+$" txt))
6314 (setq txt (format "%d" (+ (string-to-number txt) 1))))
6315 (insert txt)
6316 (org-table-maybe-recalculate-line)
6317 (org-table-align))
6318 (error "No non-empty field found"))))
6320 (defun org-table-check-inside-data-field ()
6321 "Is point inside a table data field?
6322 I.e. not on a hline or before the first or after the last column?
6323 This actually throws an error, so it aborts the current command."
6324 (if (or (not (org-at-table-p))
6325 (= (org-table-current-column) 0)
6326 (org-at-table-hline-p)
6328 (error "Not in table data field")))
6330 (defvar org-table-clip nil
6331 "Clipboard for table regions.")
6333 (defun org-table-blank-field ()
6334 "Blank the current table field or active region."
6335 (interactive)
6336 (org-table-check-inside-data-field)
6337 (if (and (interactive-p) (org-region-active-p))
6338 (let (org-table-clip)
6339 (org-table-cut-region (region-beginning) (region-end)))
6340 (skip-chars-backward "^|")
6341 (backward-char 1)
6343 (let* ((pos (match-beginning 0))
6344 (match (match-string 0))
6345 (len (org-string-width match)))
6346 (replace-match (concat "|" (make-string (1- len) ?\ )))
6347 (goto-char (+ 2 pos))
6348 (substring match 1)))))
6350 (defun org-table-get-field (&optional n replace)
6351 "Return the value of the field in column N of current row.
6352 N defaults to current field.
6353 If REPLACE is a string, replace field with this value. The return value
6354 is always the old value."
6355 (and n (org-table-goto-column n))
6357 (backward-char 1)
6359 (let* ((pos (match-beginning 0))
6360 (val (buffer-substring (1+ pos) (match-end 0))))
6361 (if replace
6362 (replace-match (concat "|" replace) t t))
6363 (goto-char (min (point-at-eol) (+ 2 pos)))
6364 val)
6365 (forward-char 1) ""))
6368 (defun org-table-field-info (arg)
6369 "Show info about the current field, and highlight any reference at point."
6370 (interactive "P")
6371 (org-table-get-specials)
6372 (save-excursion
6373 (let* ((pos (point))
6374 (col (org-table-current-column))
6375 (cname (car (rassoc (int-to-string col) org-table-column-names)))
6376 (name (car (rassoc (list (org-current-line) col)
6377 org-table-named-field-locations)))
6378 (eql (org-table-get-stored-formulas))
6379 (dline (org-table-current-dline))
6380 (ref (format "@%d$%d" dline col))
6381 (ref1 (org-table-convert-refs-to-an ref))
6382 (fequation (or (assoc name eql) (assoc ref eql)))
6383 (cequation (assoc (int-to-string col) eql))
6384 (eqn (or fequation cequation)))
6385 (goto-char pos)
6386 (condition-case nil
6387 (org-table-show-reference 'local)
6388 (error nil))
6389 (message "line @%d, col $%s%s, ref @%d$%d or %s%s%s"
6390 dline col
6391 (if cname (concat " or $" cname) "")
6392 dline col ref1
6393 (if name (concat " or $" name) "")
6394 ;; FIXME: formula info not correct if special table line
6395 (if eqn
6396 (concat ", formula: "
6397 (org-table-formula-to-user
6398 (concat
6399 (if (string-match "^[$@]"(car eqn)) "" "$")
6400 (car eqn) "=" (cdr eqn))))
6401 "")))))
6403 (defun org-table-current-column ()
6404 "Find out which column we are in.
6405 When called interactively, column is also displayed in echo area."
6406 (interactive)
6407 (if (interactive-p) (org-table-check-inside-data-field))
6408 (save-excursion
6409 (let ((cnt 0) (pos (point)))
6410 (beginning-of-line 1)
6411 (while (search-forward "|" pos t)
6412 (setq cnt (1+ cnt)))
6413 (if (interactive-p) (message "This is table column %d" cnt))
6414 cnt)))
6416 (defun org-table-current-dline ()
6417 "Find out what table data line we are in.
6418 Only datalins count for this."
6419 (interactive)
6420 (if (interactive-p) (org-table-check-inside-data-field))
6421 (save-excursion
6422 (let ((cnt 0) (pos (point)))
6423 (goto-char (org-table-begin))
6424 (while (<= (point) pos)
6425 (if (looking-at org-table-dataline-regexp) (setq cnt (1+ cnt)))
6426 (beginning-of-line 2))
6427 (if (interactive-p) (message "This is table line %d" cnt))
6428 cnt)))
6430 (defun org-table-goto-column (n &optional on-delim force)
6431 "Move the cursor to the Nth column in the current table line.
6432 With optional argument ON-DELIM, stop with point before the left delimiter
6433 of the field.
6434 If there are less than N fields, just go to after the last delimiter.
6435 However, when FORCE is non-nil, create new columns if necessary."
6436 (interactive "p")
6437 (let ((pos (point-at-eol)))
6438 (beginning-of-line 1)
6439 (when (> n 0)
6440 (while (and (> (setq n (1- n)) -1)
6441 (or (search-forward "|" pos t)
6442 (and force
6443 (progn (end-of-line 1)
6444 (skip-chars-backward "^|")
6445 (insert " | "))))))
6446 ; (backward-char 2) t)))))
6447 (when (and force (not (looking-at ".*|")))
6448 (save-excursion (end-of-line 1) (insert " | ")))
6449 (if on-delim
6450 (backward-char 1)
6451 (if (looking-at " ") (forward-char 1))))))
6453 (defun org-at-table-p (&optional table-type)
6454 "Return t if the cursor is inside an org-type table.
6455 If TABLE-TYPE is non-nil, also check for table.el-type tables."
6456 (if org-enable-table-editor
6457 (save-excursion
6458 (beginning-of-line 1)
6459 (looking-at (if table-type org-table-any-line-regexp
6460 org-table-line-regexp)))
6461 nil))
6463 (defun org-at-table.el-p ()
6464 "Return t if and only if we are at a table.el table."
6465 (and (org-at-table-p 'any)
6466 (save-excursion
6467 (goto-char (org-table-begin 'any))
6468 (looking-at org-table1-hline-regexp))))
6470 (defun org-table-recognize-table.el ()
6471 "If there is a table.el table nearby, recognize it and move into it."
6472 (if org-table-tab-recognizes-table.el
6473 (if (org-at-table.el-p)
6474 (progn
6475 (beginning-of-line 1)
6476 (if (looking-at org-table-dataline-regexp)
6477 nil
6478 (if (looking-at org-table1-hline-regexp)
6479 (progn
6480 (beginning-of-line 2)
6481 (if (looking-at org-table-any-border-regexp)
6482 (beginning-of-line -1)))))
6483 (if (re-search-forward "|" (org-table-end t) t)
6484 (progn
6485 (require 'table)
6486 (if (table--at-cell-p (point))
6487 t
6488 (message "recognizing table.el table...")
6489 (table-recognize-table)
6490 (message "recognizing table.el table...done")))
6491 (error "This should not happen..."))
6492 t)
6493 nil)
6494 nil))
6496 (defun org-at-table-hline-p ()
6497 "Return t if the cursor is inside a hline in a table."
6498 (if org-enable-table-editor
6499 (save-excursion
6500 (beginning-of-line 1)
6501 (looking-at org-table-hline-regexp))
6502 nil))
6504 (defun org-table-insert-column ()
6505 "Insert a new column into the table."
6506 (interactive)
6507 (if (not (org-at-table-p))
6508 (error "Not at a table"))
6509 (org-table-find-dataline)
6510 (let* ((col (max 1 (org-table-current-column)))
6511 (beg (org-table-begin))
6512 (end (org-table-end))
6513 ;; Current cursor position
6514 (linepos (org-current-line))
6515 (colpos col))
6516 (goto-char beg)
6517 (while (< (point) end)
6518 (if (org-at-table-hline-p)
6519 nil
6520 (org-table-goto-column col t)
6521 (insert "| "))
6522 (beginning-of-line 2))
6523 (move-marker end nil)
6524 (goto-line linepos)
6525 (org-table-goto-column colpos)
6526 (org-table-align)
6527 (org-table-fix-formulas "$" nil (1- col) 1)))
6529 (defun org-table-find-dataline ()
6530 "Find a dataline in the current table, which is needed for column commands."
6531 (if (and (org-at-table-p)
6532 (not (org-at-table-hline-p)))
6533 t
6534 (let ((col (current-column))
6535 (end (org-table-end)))
6536 (move-to-column col)
6537 (while (and (< (point) end)
6538 (or (not (= (current-column) col))
6539 (org-at-table-hline-p)))
6540 (beginning-of-line 2)
6541 (move-to-column col))
6542 (if (and (org-at-table-p)
6543 (not (org-at-table-hline-p)))
6544 t
6545 (error
6546 "Please position cursor in a data line for column operations")))))
6548 (defun org-table-delete-column ()
6549 "Delete a column from the table."
6550 (interactive)
6551 (if (not (org-at-table-p))
6552 (error "Not at a table"))
6553 (org-table-find-dataline)
6554 (org-table-check-inside-data-field)
6555 (let* ((col (org-table-current-column))
6556 (beg (org-table-begin))
6557 (end (org-table-end))
6558 ;; Current cursor position
6559 (linepos (org-current-line))
6560 (colpos col))
6561 (goto-char beg)
6562 (while (< (point) end)
6563 (if (org-at-table-hline-p)
6564 nil
6565 (org-table-goto-column col t)
6567 (replace-match "|")))
6568 (beginning-of-line 2))
6569 (move-marker end nil)
6570 (goto-line linepos)
6571 (org-table-goto-column colpos)
6572 (org-table-align)
6573 (org-table-fix-formulas "$" (list (cons (number-to-string col) "INVALID"))
6574 col -1 col)))
6576 (defun org-table-move-column-right ()
6577 "Move column to the right."
6578 (interactive)
6579 (org-table-move-column nil))
6580 (defun org-table-move-column-left ()
6581 "Move column to the left."
6582 (interactive)
6583 (org-table-move-column 'left))
6585 (defun org-table-move-column (&optional left)
6586 "Move the current column to the right. With arg LEFT, move to the left."
6587 (interactive "P")
6588 (if (not (org-at-table-p))
6589 (error "Not at a table"))
6590 (org-table-find-dataline)
6591 (org-table-check-inside-data-field)
6592 (let* ((col (org-table-current-column))
6593 (col1 (if left (1- col) col))
6594 (beg (org-table-begin))
6595 (end (org-table-end))
6596 ;; Current cursor position
6597 (linepos (org-current-line))
6598 (colpos (if left (1- col) (1+ col))))
6599 (if (and left (= col 1))
6600 (error "Cannot move column further left"))
6602 (error "Cannot move column further right"))
6603 (goto-char beg)
6604 (while (< (point) end)
6605 (if (org-at-table-hline-p)
6606 nil
6607 (org-table-goto-column col1 t)
6610 (beginning-of-line 2))
6611 (move-marker end nil)
6612 (goto-line linepos)
6613 (org-table-goto-column colpos)
6614 (org-table-align)
6615 (org-table-fix-formulas
6616 "$" (list (cons (number-to-string col) (number-to-string colpos))
6617 (cons (number-to-string colpos) (number-to-string col))))))
6619 (defun org-table-move-row-down ()
6620 "Move table row down."
6621 (interactive)
6622 (org-table-move-row nil))
6623 (defun org-table-move-row-up ()
6624 "Move table row up."
6625 (interactive)
6626 (org-table-move-row 'up))
6628 (defun org-table-move-row (&optional up)
6629 "Move the current table line down. With arg UP, move it up."
6630 (interactive "P")
6631 (let* ((col (current-column))
6632 (pos (point))
6633 (hline1p (save-excursion (beginning-of-line 1)
6634 (looking-at org-table-hline-regexp)))
6635 (dline1 (org-table-current-dline))
6636 (dline2 (+ dline1 (if up -1 1)))
6637 (tonew (if up 0 2))
6638 txt hline2p)
6639 (beginning-of-line tonew)
6640 (unless (org-at-table-p)
6641 (goto-char pos)
6642 (error "Cannot move row further"))
6643 (setq hline2p (looking-at org-table-hline-regexp))
6644 (goto-char pos)
6645 (beginning-of-line 1)
6646 (setq pos (point))
6647 (setq txt (buffer-substring (point) (1+ (point-at-eol))))
6648 (delete-region (point) (1+ (point-at-eol)))
6649 (beginning-of-line tonew)
6650 (insert txt)
6651 (beginning-of-line 0)
6652 (move-to-column col)
6653 (unless (or hline1p hline2p)
6654 (org-table-fix-formulas
6655 "@" (list (cons (number-to-string dline1) (number-to-string dline2))
6656 (cons (number-to-string dline2) (number-to-string dline1)))))))
6658 (defun org-table-insert-row (&optional arg)
6659 "Insert a new row above the current line into the table.
6660 With prefix ARG, insert below the current line."
6661 (interactive "P")
6662 (if (not (org-at-table-p))
6663 (error "Not at a table"))
6664 (let* ((line (buffer-substring (point-at-bol) (point-at-eol)))
6665 (new (org-table-clean-line line)))
6666 ;; Fix the first field if necessary
6668 (setq new (replace-match (match-string 0 line) t t new)))
6669 (beginning-of-line (if arg 2 1))
6671 (beginning-of-line 0)
6672 (re-search-forward "| ?" (point-at-eol) t)
6673 (and (or org-table-may-need-update org-table-overlay-coordinates)
6674 (org-table-align))
6675 (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1)))
6677 (defun org-table-insert-hline (&optional arg)
6678 "Insert a horizontal-line below the current line into the table.
6679 With prefix ARG, insert above the current line."
6680 (interactive "P")
6681 (if (not (org-at-table-p))
6682 (error "Not at a table"))
6683 (let ((line (org-table-clean-line
6684 (buffer-substring (point-at-bol) (point-at-eol))))
6685 (col (current-column)))
6687 (setq line (replace-match
6688 (concat "+" (make-string (- (match-end 1) (match-beginning 1))
6689 ?-) "|") t t line)))
6691 (beginning-of-line (if arg 1 2))
6693 (beginning-of-line (if arg 1 -1))
6694 (move-to-column col)
6695 (and org-table-overlay-coordinates (org-table-align))))
6697 (defun org-table-clean-line (s)
6699 In particular, this does handle wide and invisible characters."
6701 ;; It's a hline, just map the characters
6702 (setq s (mapconcat (lambda (x) (if (member x '(?| ?+)) "|" " ")) s ""))
6704 (setq s (replace-match
6705 (concat "|" (make-string (org-string-width (match-string 1 s))
6706 ?\ ) "|")
6707 t t s)))
6708 s))
6710 (defun org-table-kill-row ()
6711 "Delete the current row or horizontal line from the table."
6712 (interactive)
6713 (if (not (org-at-table-p))
6714 (error "Not at a table"))
6715 (let ((col (current-column))
6716 (dline (org-table-current-dline)))
6717 (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))
6718 (if (not (org-at-table-p)) (beginning-of-line 0))
6719 (move-to-column col)
6720 (org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID"))
6721 dline -1 dline)))
6724 (defun org-table-sort-lines (with-case &optional sorting-type)
6725 "Sort table lines according to the column at point.
6727 The position of point indicates the column to be used for
6728 sorting, and the range of lines is the range between the nearest
6729 horizontal separator lines, or the entire table of no such lines
6730 exist. If point is before the first column, you will be prompted
6731 for the sorting column. If there is an active region, the mark
6732 specifies the first line and the sorting column, while point
6733 should be in the last line to be included into the sorting.
6735 The command then prompts for the sorting type which can be
6736 alphabetically, numerically, or by time (as given in a time stamp
6737 in the field). Sorting in reverse order is also possible.
6739 With prefix argument WITH-CASE, alphabetic sorting will be case-sensitive.
6741 If SORTING-TYPE is specified when this function is called from a Lisp
6742 program, no prompting will take place. SORTING-TYPE must be a character,
6743 any of (?a ?A ?n ?N ?t ?T) where the capital letter indicate that sorting
6744 should be done in reverse order."
6745 (interactive "P")
6746 (let* ((thisline (org-current-line))
6747 (thiscol (org-table-current-column))
6748 beg end bcol ecol tend tbeg column lns pos)
6749 (when (equal thiscol 0)
6750 (if (interactive-p)
6751 (setq thiscol
6752 (string-to-number
6753 (read-string "Use column N for sorting: ")))
6754 (setq thiscol 1))
6755 (org-table-goto-column thiscol))
6756 (org-table-check-inside-data-field)
6757 (if (org-region-active-p)
6758 (progn
6759 (setq beg (region-beginning) end (region-end))
6760 (goto-char beg)
6761 (setq column (org-table-current-column)
6762 beg (point-at-bol))
6763 (goto-char end)
6764 (setq end (point-at-bol 2)))
6765 (setq column (org-table-current-column)
6766 pos (point)
6767 tbeg (org-table-begin)
6768 tend (org-table-end))
6769 (if (re-search-backward org-table-hline-regexp tbeg t)
6770 (setq beg (point-at-bol 2))
6771 (goto-char tbeg)
6772 (setq beg (point-at-bol 1)))
6773 (goto-char pos)
6774 (if (re-search-forward org-table-hline-regexp tend t)
6775 (setq beg (point-at-bol 0))
6776 (goto-char tend)
6777 (setq end (point-at-bol))))
6778 (setq beg (move-marker (make-marker) beg)
6779 end (move-marker (make-marker) end))
6780 (untabify beg end)
6781 (goto-char beg)
6782 (org-table-goto-column column)
6783 (skip-chars-backward "^|")
6784 (setq bcol (current-column))
6785 (org-table-goto-column (1+ column))
6786 (skip-chars-backward "^|")
6787 (setq ecol (1- (current-column)))
6788 (org-table-goto-column column)
6789 (setq lns (mapcar (lambda(x) (cons (org-trim (substring x bcol ecol)) x))
6791 (setq lns (org-do-sort lns "Table" with-case sorting-type))
6792 (delete-region beg end)
6793 (move-marker beg nil)
6794 (move-marker end nil)
6796 (goto-line thisline)
6797 (org-table-goto-column thiscol)
6798 (message "%d lines sorted, based on column %d" (length lns) column)))
6800 (defun org-table-cut-region (beg end)
6801 "Copy region in table to the clipboard and blank all relevant fields."
6802 (interactive "r")
6803 (org-table-copy-region beg end 'cut))
6805 (defun org-table-copy-region (beg end &optional cut)
6806 "Copy rectangular region in table to clipboard.
6807 A special clipboard is used which can only be accessed
6808 with `org-table-paste-rectangle'."
6809 (interactive "rP")
6810 (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2
6811 region cols
6812 (rpl (if cut " " nil)))
6813 (goto-char beg)
6814 (org-table-check-inside-data-field)
6815 (setq l01 (org-current-line)
6816 c01 (org-table-current-column))
6817 (goto-char end)
6818 (org-table-check-inside-data-field)
6819 (setq l02 (org-current-line)
6820 c02 (org-table-current-column))
6821 (setq l1 (min l01 l02) l2 (max l01 l02)
6822 c1 (min c01 c02) c2 (max c01 c02))
6823 (catch 'exit
6824 (while t
6825 (catch 'nextline
6826 (if (> l1 l2) (throw 'exit t))
6827 (goto-line l1)
6828 (if (org-at-table-hline-p) (throw 'nextline (setq l1 (1+ l1))))
6829 (setq cols nil ic1 c1 ic2 c2)
6830 (while (< ic1 (1+ ic2))
6831 (push (org-table-get-field ic1 rpl) cols)
6832 (setq ic1 (1+ ic1)))
6833 (push (nreverse cols) region)
6834 (setq l1 (1+ l1)))))
6835 (setq org-table-clip (nreverse region))
6836 (if cut (org-table-align))
6837 org-table-clip))
6839 (defun org-table-paste-rectangle ()
6840 "Paste a rectangular region into a table.
6841 The upper right corner ends up in the current field. All involved fields
6842 will be overwritten. If the rectangle does not fit into the present table,
6843 the table is enlarged as needed. The process ignores horizontal separator
6844 lines."
6845 (interactive)
6846 (unless (and org-table-clip (listp org-table-clip))
6847 (error "First cut/copy a region to paste!"))
6848 (org-table-check-inside-data-field)
6849 (let* ((clip org-table-clip)
6850 (line (org-current-line))
6851 (col (org-table-current-column))
6852 (org-enable-table-editor t)
6853 (org-table-automatic-realign nil)
6854 c cols field)
6855 (while (setq cols (pop clip))
6856 (while (org-at-table-hline-p) (beginning-of-line 2))
6857 (if (not (org-at-table-p))
6858 (progn (end-of-line 0) (org-table-next-field)))
6859 (setq c col)
6860 (while (setq field (pop cols))
6861 (org-table-goto-column c nil 'force)
6862 (org-table-get-field nil field)
6863 (setq c (1+ c)))
6864 (beginning-of-line 2))
6865 (goto-line line)
6866 (org-table-goto-column col)
6867 (org-table-align)))
6869 (defun org-table-convert ()
6870 "Convert from `org-mode' table to table.el and back.
6871 Obviously, this only works within limits. When an Org-mode table is
6872 converted to table.el, all horizontal separator lines get lost, because
6873 table.el uses these as cell boundaries and has no notion of horizontal lines.
6874 A table.el table can be converted to an Org-mode table only if it does not
6875 do row or column spanning. Multiline cells will become multiple cells.
6876 Beware, Org-mode does not test if the table can be successfully converted - it
6877 blindly applies a recipe that works for simple tables."
6878 (interactive)
6879 (require 'table)
6880 (if (org-at-table.el-p)
6881 ;; convert to Org-mode table
6882 (let ((beg (move-marker (make-marker) (org-table-begin t)))
6883 (end (move-marker (make-marker) (org-table-end t))))
6884 (table-unrecognize-region beg end)
6885 (goto-char beg)
6887 (replace-match ""))
6888 (goto-char beg))
6889 (if (org-at-table-p)
6890 ;; convert to table.el table
6891 (let ((beg (move-marker (make-marker) (org-table-begin)))
6892 (end (move-marker (make-marker) (org-table-end))))
6893 ;; first, get rid of all horizontal lines
6894 (goto-char beg)
6896 (replace-match ""))
6897 ;; insert a hline before first
6898 (goto-char beg)
6899 (org-table-insert-hline 'above)
6900 (beginning-of-line -1)
6901 ;; insert a hline after each line
6902 (while (progn (beginning-of-line 3) (< (point) end))
6903 (org-table-insert-hline))
6904 (goto-char beg)
6905 (setq end (move-marker end (org-table-end)))
6906 ;; replace "+" at beginning and ending of hlines
6909 (goto-char beg)
6911 (replace-match "-+"))
6912 (goto-char beg)))))
6914 (defun org-table-wrap-region (arg)
6915 "Wrap several fields in a column like a paragraph.
6916 This is useful if you'd like to spread the contents of a field over several
6917 lines, in order to keep the table compact.
6919 If there is an active region, and both point and mark are in the same column,
6920 the text in the column is wrapped to minimum width for the given number of
6921 lines. Generally, this makes the table more compact. A prefix ARG may be
6923 formats the selected text to two lines. If the region was longer than two
6924 lines, the remaining lines remain empty. A negative prefix argument reduces
6925 the current number of lines by that amount. The wrapped text is pasted back
6926 into the table. If you formatted it to more lines than it was before, fields
6927 further down in the table get overwritten - so you might need to make space in
6928 the table first.
6930 If there is no region, the current field is split at the cursor position and
6931 the text fragment to the right of the cursor is prepended to the field one
6932 line down.
6934 If there is no region, but you specify a prefix ARG, the current field gets
6935 blank, and the content is appended to the field above."
6936 (interactive "P")
6937 (org-table-check-inside-data-field)
6938 (if (org-region-active-p)
6939 ;; There is a region: fill as a paragraph
6940 (let* ((beg (region-beginning))
6941 (cline (save-excursion (goto-char beg) (org-current-line)))
6942 (ccol (save-excursion (goto-char beg) (org-table-current-column)))
6943 nlines)
6944 (org-table-cut-region (region-beginning) (region-end))
6945 (if (> (length (car org-table-clip)) 1)
6946 (error "Region must be limited to single column"))
6947 (setq nlines (if arg
6948 (if (< arg 1)
6949 (+ (length org-table-clip) arg)
6950 arg)
6951 (length org-table-clip)))
6952 (setq org-table-clip
6953 (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ")
6954 nil nlines)))
6955 (goto-line cline)
6956 (org-table-goto-column ccol)
6957 (org-table-paste-rectangle))
6958 ;; No region, split the current field at point
6959 (if arg
6960 ;; combine with field above
6961 (let ((s (org-table-blank-field))
6962 (col (org-table-current-column)))
6963 (beginning-of-line 0)
6964 (while (org-at-table-hline-p) (beginning-of-line 0))
6965 (org-table-goto-column col)
6966 (skip-chars-forward "^|")
6967 (skip-chars-backward " ")
6968 (insert " " (org-trim s))
6969 (org-table-align))
6970 ;; split field
6972 (let ((s (match-string 1)))
6973 (replace-match " |")
6974 (goto-char (match-beginning 0))
6975 (org-table-next-row)
6976 (insert (org-trim s) " ")
6977 (org-table-align))))))
6979 (defvar org-field-marker nil)
6981 (defun org-table-edit-field (arg)
6982 "Edit table field in a different window.
6983 This is mainly useful for fields that contain hidden parts.
6985 it can be edited in place."
6986 (interactive "P")
6987 (if arg
6988 (let ((b (save-excursion (skip-chars-backward "^|") (point)))
6990 (remove-text-properties b e '(org-cwidth t invisible t
6991 display t intangible t))
6992 (if (and (boundp 'font-lock-mode) font-lock-mode)
6993 (font-lock-fontify-block)))
6994 (let ((pos (move-marker (make-marker) (point)))
6995 (field (org-table-get-field))
6996 (cw (current-window-configuration))
6997 p)
6998 (switch-to-buffer-other-window "*Org tmp*")
6999 (erase-buffer)
7001 (org-mode)
7002 (goto-char (setq p (point-max)))
7003 (insert (org-trim field))
7004 (remove-text-properties p (point-max)
7005 '(invisible t org-cwidth t display t
7006 intangible t))
7007 (goto-char p)
7008 (org-set-local 'org-finish-function
7009 'org-table-finish-edit-field)
7010 (org-set-local 'org-window-configuration cw)
7011 (org-set-local 'org-field-marker pos)
7012 (message "Edit and finish with C-c C-c"))))
7014 (defun org-table-finish-edit-field ()
7015 "Finish editing a table data field.
7016 Remove all newline characters, insert the result into the table, realign
7017 the table and kill the editing buffer."
7018 (let ((pos org-field-marker)
7019 (cw org-window-configuration)
7020 (cb (current-buffer))
7021 text)
7022 (goto-char (point-min))
7025 (replace-match " "))
7026 (setq text (org-trim (buffer-string)))
7027 (set-window-configuration cw)
7028 (kill-buffer cb)
7029 (select-window (get-buffer-window (marker-buffer pos)))
7030 (goto-char pos)
7031 (move-marker pos nil)
7032 (org-table-check-inside-data-field)
7033 (org-table-get-field nil text)
7034 (org-table-align)
7035 (message "New field value inserted")))
7037 (defun org-trim (s)
7038 "Remove whitespace at beginning and end of string."
7041 s)
7043 (defun org-wrap (string &optional width lines)
7044 "Wrap string to either a number of lines, or a width in characters.
7045 If WIDTH is non-nil, the string is wrapped to that width, however many lines
7046 that costs. If there is a word longer than WIDTH, the text is actually
7047 wrapped to the length of that word.
7048 IF WIDTH is nil and LINES is non-nil, the string is forced into at most that
7049 many lines, whatever width that takes.
7050 The return value is a list of lines, without newlines at the end."
7052 (maxword (apply 'max (mapcar 'org-string-width words)))
7053 w ll)
7054 (cond (width
7055 (org-do-wrap words (max maxword width)))
7056 (lines
7057 (setq w maxword)
7058 (setq ll (org-do-wrap words maxword))
7059 (if (<= (length ll) lines)
7060 ll
7061 (setq ll words)
7062 (while (> (length ll) lines)
7063 (setq w (1+ w))
7064 (setq ll (org-do-wrap words w)))
7065 ll))
7066 (t (error "Cannot wrap this")))))
7069 (defun org-do-wrap (words width)
7070 "Create lines of maximum width WIDTH (in characters) from word list WORDS."
7071 (let (lines line)
7072 (while words
7073 (setq line (pop words))
7074 (while (and words (< (+ (length line) (length (car words))) width))
7075 (setq line (concat line " " (pop words))))
7076 (setq lines (push line lines)))
7077 (nreverse lines)))
7079 (defun org-split-string (string &optional separators)
7080 "Splits STRING into substrings at SEPARATORS.
7081 No empty strings are returned if there are matches at the beginning
7082 and end of string."
7084 (start 0)
7085 notfirst
7086 (list nil))
7087 (while (and (string-match rexp string
7088 (if (and notfirst
7089 (= start (match-beginning 0))
7090 (< start (length string)))
7091 (1+ start) start))
7092 (< (match-beginning 0) (length string)))
7093 (setq notfirst t)
7094 (or (eq (match-beginning 0) 0)
7095 (and (eq (match-beginning 0) (match-end 0))
7096 (eq (match-beginning 0) start))
7097 (setq list
7098 (cons (substring string start (match-beginning 0))
7099 list)))
7100 (setq start (match-end 0)))
7101 (or (eq start (length string))
7102 (setq list
7103 (cons (substring string start)
7104 list)))
7105 (nreverse list)))
7107 (defun org-table-map-tables (function)
7108 "Apply FUNCTION to the start of all tables in the buffer."
7109 (save-excursion
7110 (save-restriction
7111 (widen)
7112 (goto-char (point-min))
7113 (while (re-search-forward org-table-any-line-regexp nil t)
7114 (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size)))
7115 (beginning-of-line 1)
7116 (if (looking-at org-table-line-regexp)
7117 (save-excursion (funcall function)))
7118 (re-search-forward org-table-any-border-regexp nil 1))))
7119 (message "Mapping tables: done"))
7121 (defvar org-timecnt) ; dynamically scoped parameter
7123 (defun org-table-sum (&optional beg end nlast)
7124 "Sum numbers in region of current table column.
7125 The result will be displayed in the echo area, and will be available
7128 If there is an active region, it is interpreted as a rectangle and all
7129 numbers in that rectangle will be summed. If there is no active
7130 region and point is located in a table column, sum all numbers in that
7131 column.
7133 If at least one number looks like a time HH:MM or HH:MM:SS, all other
7134 numbers are assumed to be times as well (in decimal hours) and the
7135 numbers are added as such.
7137 If NLAST is a number, only the NLAST fields will actually be summed."
7138 (interactive)
7139 (save-excursion
7140 (let (col (org-timecnt 0) diff h m s org-table-clip)
7141 (cond
7142 ((and beg end)) ; beg and end given explicitly
7143 ((org-region-active-p)
7144 (setq beg (region-beginning) end (region-end)))
7145 (t
7146 (setq col (org-table-current-column))
7147 (goto-char (org-table-begin))
7149 (error "No table data"))
7150 (org-table-goto-column col)
7151 (setq beg (point))
7152 (goto-char (org-table-end))
7154 (error "No table data"))
7155 (org-table-goto-column col)
7156 (setq end (point))))
7157 (let* ((items (apply 'append (org-table-copy-region beg end)))
7158 (items1 (cond ((not nlast) items)
7159 ((>= nlast (length items)) items)
7160 (t (setq items (reverse items))
7161 (setcdr (nthcdr (1- nlast) items) nil)
7162 (nreverse items))))
7163 (numbers (delq nil (mapcar 'org-table-get-number-for-summing
7164 items1)))
7165 (res (apply '+ numbers))
7166 (sres (if (= org-timecnt 0)
7167 (format "%g" res)
7168 (setq diff (* 3600 res)
7169 h (floor (/ diff 3600)) diff (mod diff 3600)
7170 m (floor (/ diff 60)) diff (mod diff 60)
7171 s diff)
7172 (format "%d:%02d:%02d" h m s))))
7173 (kill-new sres)
7174 (if (interactive-p)
7175 (message "%s"
7176 (substitute-command-keys
7178 (length numbers) sres))))
7179 sres))))
7181 (defun org-table-get-number-for-summing (s)
7182 (let (n)
7183 (if (string-match "^ *|? *" s)
7184 (setq s (replace-match "" nil nil s)))
7185 (if (string-match " *|? *$" s)
7186 (setq s (replace-match "" nil nil s)))
7187 (setq n (string-to-number s))
7188 (cond
7189 ((and (string-match "0" s)
7193 (let ((h (string-to-number (or (match-string 1 s) "0")))
7194 (m (string-to-number (or (match-string 2 s) "0")))
7195 (s (string-to-number (or (match-string 4 s) "0"))))
7196 (if (boundp 'org-timecnt) (setq org-timecnt (1+ org-timecnt)))
7197 (* 1.0 (+ h (/ m 60.0) (/ s 3600.0)))))
7198 ((equal n 0) nil)
7199 (t n))))
7201 (defun org-table-current-field-formula (&optional key noerror)
7202 "Return the formula active for the current field.
7203 Assumes that specials are in place.
7204 If KEY is given, return the key to this formula.
7206 (let* ((name (car (rassoc (list (org-current-line)
7207 (org-table-current-column))
7208 org-table-named-field-locations)))
7209 (col (org-table-current-column))
7210 (scol (int-to-string col))
7211 (ref (format "@%d$%d" (org-table-current-dline) col))
7212 (stored-list (org-table-get-stored-formulas noerror))
7213 (ass (or (assoc name stored-list)
7214 (assoc ref stored-list)
7215 (assoc scol stored-list))))
7216 (if key
7217 (car ass)
7218 (if ass (concat (if (string-match "^[0-9]+$" (car ass)) "=" ":=")
7219 (cdr ass))))))
7221 (defun org-table-get-formula (&optional equation named)
7222 "Read a formula from the minibuffer, offer stored formula as default.
7223 When NAMED is non-nil, look for a named equation."
7224 (let* ((stored-list (org-table-get-stored-formulas))
7225 (name (car (rassoc (list (org-current-line)
7226 (org-table-current-column))
7227 org-table-named-field-locations)))
7228 (ref (format "@%d$%d" (org-table-current-dline)
7229 (org-table-current-column)))
7230 (refass (assoc ref stored-list))
7231 (scol (if named
7232 (if name name ref)
7233 (int-to-string (org-table-current-column))))
7234 (dummy (and (or name refass) (not named)
7235 (not (y-or-n-p "Replace field formula with column formula? " ))
7236 (error "Abort")))
7237 (name (or name ref))
7238 (org-table-may-need-update nil)
7239 (stored (cdr (assoc scol stored-list)))
7240 (eq (cond
7241 ((and stored equation (string-match "^ *=? *$" equation))
7242 stored)
7243 ((stringp equation)
7244 equation)
7245 (t (org-table-formula-from-user
7246 (read-string
7247 (org-table-formula-to-user
7248 (format "%s formula %s%s="
7249 (if named "Field" "Column")
7250 (if (member (string-to-char scol) '(?$ ?@)) "" "$")
7251 scol))
7252 (if stored (org-table-formula-to-user stored) "")
7253 'org-table-formula-history
7254 )))))
7255 mustsave)
7257 ;; remove formula
7258 (setq stored-list (delq (assoc scol stored-list) stored-list))
7259 (org-table-store-formulas stored-list)
7260 (error "Formula removed"))
7261 (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq)))
7262 (if (string-match " *$" eq) (setq eq (replace-match "" t t eq)))
7263 (if (and name (not named))
7264 ;; We set the column equation, delete the named one.
7265 (setq stored-list (delq (assoc name stored-list) stored-list)
7266 mustsave t))
7267 (if stored
7268 (setcdr (assoc scol stored-list) eq)
7269 (setq stored-list (cons (cons scol eq) stored-list)))
7270 (if (or mustsave (not (equal stored eq)))
7271 (org-table-store-formulas stored-list))
7272 eq))
7274 (defun org-table-store-formulas (alist)
7275 "Store the list of formulas below the current table."
7276 (setq alist (sort alist 'org-table-formula-less-p))
7277 (save-excursion
7278 (goto-char (org-table-end))
7280 (progn
7281 ;; don't overwrite TBLFM, we might use text properties to store stuff
7282 (goto-char (match-beginning 2))
7283 (delete-region (match-beginning 2) (match-end 0)))
7284 (insert "#+TBLFM:"))
7285 (insert " "
7286 (mapconcat (lambda (x)
7287 (concat
7288 (if (equal (string-to-char (car x)) ?@) "" "$")
7289 (car x) "=" (cdr x)))
7290 alist "::")
7293 (defsubst org-table-formula-make-cmp-string (a)
7295 (concat
7296 (if (match-end 2) (format "@%05d" (string-to-number (match-string 2 a))) "")
7297 (if (match-end 4) (format "$%05d" (string-to-number (match-string 4 a))) "")
7298 (if (match-end 5) (concat "@@" (match-string 5 a))))))
7300 (defun org-table-formula-less-p (a b)
7301 "Compare two formulas for sorting."
7302 (let ((as (org-table-formula-make-cmp-string (car a)))
7303 (bs (org-table-formula-make-cmp-string (car b))))
7304 (and as bs (string< as bs))))
7306 (defun org-table-get-stored-formulas (&optional noerror)
7307 "Return an alist with the stored formulas directly after current table."
7308 (interactive)
7309 (let (scol eq eq-alist strings string seen)
7310 (save-excursion
7311 (goto-char (org-table-end))
7313 (setq strings (org-split-string (match-string 2) " *:: *"))
7314 (while (setq string (pop strings))
7315 (when (string-match "\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*[^ \t]\\)" string)
7316 (setq scol (if (match-end 2)
7317 (match-string 2 string)
7318 (match-string 1 string))
7319 eq (match-string 3 string)
7320 eq-alist (cons (cons scol eq) eq-alist))
7321 (if (member scol seen)
7322 (if noerror
7323 (progn
7324 (message "Double definition `$%s=' in TBLFM line, please fix by hand" scol)
7325 (ding)
7326 (sit-for 2))
7327 (error "Double definition `$%s=' in TBLFM line, please fix by hand" scol))
7328 (push scol seen))))))
7329 (nreverse eq-alist)))
7331 (defun org-table-fix-formulas (key replace &optional limit delta remove)
7332 "Modify the equations after the table structure has been edited.
7334 For all numbers larger than LIMIT, shift them by DELTA."
7335 (save-excursion
7336 (goto-char (org-table-end))
7339 (re2
7340 (when remove
7341 (if (equal key "$")
7344 s n a)
7345 (when remove
7346 (while (re-search-forward re2 (point-at-eol) t)
7347 (replace-match "")))
7348 (while (re-search-forward re (point-at-eol) t)
7349 (setq s (match-string 1) n (string-to-number s))
7350 (cond
7351 ((setq a (assoc s replace))
7352 (replace-match (concat key (cdr a)) t t))
7353 ((and limit (> n limit))
7354 (replace-match (concat key (int-to-string (+ n delta))) t t))))))))
7356 (defun org-table-get-specials ()
7357 "Get the column names and local parameters for this table."
7358 (save-excursion
7359 (let ((beg (org-table-begin)) (end (org-table-end))
7360 names name fields fields1 field cnt
7361 c v l line col types dlines hlines)
7362 (setq org-table-column-names nil
7363 org-table-local-parameters nil
7364 org-table-named-field-locations nil
7365 org-table-current-begin-line nil
7366 org-table-current-begin-pos nil
7367 org-table-current-line-types nil)
7368 (goto-char beg)
7370 (setq names (org-split-string (match-string 1) " *| *")
7371 cnt 1)
7372 (while (setq name (pop names))
7373 (setq cnt (1+ cnt))
7374 (if (string-match "^[a-zA-Z][a-zA-Z0-9]*$" name)
7375 (push (cons name (int-to-string cnt)) org-table-column-names))))
7376 (setq org-table-column-names (nreverse org-table-column-names))
7377 (setq org-table-column-name-regexp
7379 (goto-char beg)
7381 (setq fields (org-split-string (match-string 1) " *| *"))
7382 (while (setq field (pop fields))
7384 (push (cons (match-string 1 field) (match-string 2 field))
7385 org-table-local-parameters))))
7386 (goto-char beg)
7388 (setq c (match-string 1)
7389 fields (org-split-string (match-string 2) " *| *"))
7390 (save-excursion
7391 (beginning-of-line (if (equal c "_") 2 0))
7392 (setq line (org-current-line) col 1)
7394 (setq fields1 (org-split-string (match-string 1) " *| *"))))
7395 (while (and fields1 (setq field (pop fields)))
7396 (setq v (pop fields1) col (1+ col))
7397 (when (and (stringp field) (stringp v)
7398 (string-match "^[a-zA-Z][a-zA-Z0-9]*$" field))
7399 (push (cons field v) org-table-local-parameters)
7400 (push (list field line col) org-table-named-field-locations))))
7401 ;; Analyse the line types
7402 (goto-char beg)
7403 (setq org-table-current-begin-line (org-current-line)
7404 org-table-current-begin-pos (point)
7405 l org-table-current-begin-line)
7407 (push (if (match-end 1) 'hline 'dline) types)
7408 (if (match-end 1) (push l hlines) (push l dlines))
7409 (beginning-of-line 2)
7410 (setq l (1+ l)))
7411 (setq org-table-current-line-types (apply 'vector (nreverse types))
7412 org-table-dlines (apply 'vector (cons nil (nreverse dlines)))
7413 org-table-hlines (apply 'vector (cons nil (nreverse hlines)))))))
7415 (defun org-this-word ()
7416 ;; Get the current word
7417 (save-excursion
7420 (buffer-substring-no-properties beg end))))
7422 (defun org-table-maybe-eval-formula ()
7424 If yes, store the formula and apply it."
7425 ;; We already know we are in a table. Get field will only return a formula
7426 ;; when appropriate. It might return a separator line, but no problem.
7427 (when org-table-formula-evaluate-inline
7428 (let* ((field (org-trim (or (org-table-get-field) "")))
7429 named eq)
7431 (setq named (equal (string-to-char field) ?:)
7432 eq (match-string 1 field))
7433 (if (or (fboundp 'calc-eval)
7434 (equal (substring eq 0 (min 2 (length eq))) "'("))
7435 (org-table-eval-formula (if named '(4) nil)
7436 (org-table-formula-from-user eq))
7437 (error "Calc does not seem to be installed, and is needed to evaluate the formula"))))))
7439 (defvar org-recalc-commands nil
7440 "List of commands triggering the recalculation of a line.
7441 Will be filled automatically during use.")
7443 (defvar org-recalc-marks
7444 '((" " . "Unmarked: no special line, no automatic recalculation")
7445 ("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line")
7446 ("*" . "Recalculate only when entire table is recalculated with `C-u C-c *'")
7447 ("!" . "Column name definition line. Reference in formula as $name.")
7448 ("$" . "Parameter definition line name=value. Reference in formula as $name.")
7449 ("_" . "Names for values in row below this one.")
7450 ("^" . "Names for values in row above this one.")))
7452 (defun org-table-rotate-recalc-marks (&optional newchar)
7453 "Rotate the recalculation mark in the first column.
7454 If in any row, the first field is not consistent with a mark,
7455 insert a new column for the markers.
7456 When there is an active region, change all the lines in the region,
7457 after prompting for the marking character.
7458 After each change, a message will be displayed indicating the meaning
7459 of the new mark."
7460 (interactive)
7461 (unless (org-at-table-p) (error "Not at a table"))
7462 (let* ((marks (append (mapcar 'car org-recalc-marks) '(" ")))
7463 (beg (org-table-begin))
7464 (end (org-table-end))
7465 (l (org-current-line))
7466 (l1 (if (org-region-active-p) (org-current-line (region-beginning))))
7467 (l2 (if (org-region-active-p) (org-current-line (region-end))))
7468 (have-col
7469 (save-excursion
7470 (goto-char beg)
7472 (col (org-table-current-column))
7473 (forcenew (car (assoc newchar org-recalc-marks)))
7474 epos new)
7475 (when l1
7476 (message "Change region to what mark? Type # * ! $ or SPC: ")
7477 (setq newchar (char-to-string (read-char-exclusive))
7478 forcenew (car (assoc newchar org-recalc-marks))))
7479 (if (and newchar (not forcenew))
7480 (error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'"
7481 newchar))
7482 (if l1 (goto-line l1))
7483 (save-excursion
7484 (beginning-of-line 1)
7485 (unless (looking-at org-table-dataline-regexp)
7486 (error "Not at a table data line")))
7487 (unless have-col
7488 (org-table-goto-column 1)
7489 (org-table-insert-column)
7490 (org-table-goto-column (1+ col)))
7491 (setq epos (point-at-eol))
7492 (save-excursion
7493 (beginning-of-line 1)
7494 (org-table-get-field
7496 (concat " "
7497 (setq new (or forcenew
7498 (cadr (member (match-string 1) marks))))
7499 " ")
7500 " # ")))
7501 (if (and l1 l2)
7502 (progn
7503 (goto-line l1)
7504 (while (progn (beginning-of-line 2) (not (= (org-current-line) l2)))
7505 (and (looking-at org-table-dataline-regexp)
7506 (org-table-get-field 1 (concat " " new " "))))
7507 (goto-line l1)))
7508 (if (not (= epos (point-at-eol))) (org-table-align))
7509 (goto-line l)
7510 (and (interactive-p) (message (cdr (assoc new org-recalc-marks))))))
7512 (defun org-table-maybe-recalculate-line ()
7513 "Recompute the current line if marked for it, and if we haven't just done it."
7514 (interactive)
7515 (and org-table-allow-automatic-line-recalculation
7516 (not (and (memq last-command org-recalc-commands)
7517 (equal org-last-recalc-line (org-current-line))))
7518 (save-excursion (beginning-of-line 1)
7519 (looking-at org-table-auto-recalculate-regexp))
7520 (org-table-recalculate) t))
7522 (defvar org-table-formula-debug nil
7523 "Non-nil means, debug table formulas.
7525 (make-variable-buffer-local 'org-table-formula-debug)
7527 (defvar modes)
7528 (defsubst org-set-calc-mode (var &optional value)
7529 (if (stringp var)
7530 (setq var (assoc var '(("D" calc-angle-mode deg)
7531 ("R" calc-angle-mode rad)
7532 ("F" calc-prefer-frac t)
7533 ("S" calc-symbolic-mode t)))
7534 value (nth 2 var) var (nth 1 var)))
7535 (if (memq var modes)
7536 (setcar (cdr (memq var modes)) value)
7537 (cons var (cons value modes)))
7538 modes)
7540 (defun org-table-eval-formula (&optional arg equation
7541 suppress-align suppress-const
7542 suppress-store suppress-analysis)
7543 "Replace the table field value at the cursor by the result of a calculation.
7545 This function makes use of Dave Gillespie's Calc package, in my view the
7546 most exciting program ever written for GNU Emacs. So you need to have Calc
7547 installed in order to use this function.
7549 In a table, this command replaces the value in the current field with the
7551 formula, by storing it in a special line below the table. When called
7552 with a `C-u' prefix, the current field must ba a named field, and the
7553 formula is installed as valid in only this specific field.
7555 When called with two `C-u' prefixes, insert the active equation
7556 for the field back into the current field, so that it can be
7558 to check the referenced fields.
7560 When called, the command first prompts for a formula, which is read in
7561 the minibuffer. Previously entered formulas are available through the
7562 history list, and the last used formula is offered as a default.
7563 These stored formulas are adapted correctly when moving, inserting, or
7564 deleting columns with the corresponding commands.
7566 The formula can be any algebraic expression understood by the Calc package.
7567 For details, see the Org-mode manual.
7569 This function can also be called from Lisp programs and offers
7570 additional arguments: EQUATION can be the formula to apply. If this
7571 argument is given, the user will not be prompted. SUPPRESS-ALIGN is
7572 used to speed-up recursive calls by by-passing unnecessary aligns.
7573 SUPPRESS-CONST suppresses the interpretation of constants in the
7574 formula, assuming that this has been done already outside the function.
7575 SUPPRESS-STORE means the formula should not be stored, either because
7576 it is already stored, or because it is a modified equation that should
7577 not overwrite the stored one."
7578 (interactive "P")
7579 (org-table-check-inside-data-field)
7580 (or suppress-analysis (org-table-get-specials))
7581 (if (equal arg '(16))
7582 (let ((eq (org-table-current-field-formula)))
7583 (or eq (error "No equation active for current field"))
7584 (org-table-get-field nil eq)
7585 (org-table-align)
7586 (setq org-table-may-need-update t))
7587 (let* (fields
7588 (ndown (if (integerp arg) arg 1))
7589 (org-table-automatic-realign nil)
7590 (case-fold-search nil)
7591 (down (> ndown 1))
7592 (formula (if (and equation suppress-store)
7593 equation
7594 (org-table-get-formula equation (equal arg '(4)))))
7595 (n0 (org-table-current-column))
7596 (modes (copy-sequence org-calc-default-modes))
7597 (numbers nil) ; was a variable, now fixed default
7598 (keep-empty nil)
7599 n form form0 bw fmt x ev orig c lispp)
7600 ;; Parse the format string. Since we have a lot of modes, this is
7601 ;; a lot of work. However, I think calc still uses most of the time.
7602 (if (string-match ";" formula)
7603 (let ((tmp (org-split-string formula ";")))
7604 (setq formula (car tmp)
7605 fmt (concat (cdr (assoc "%" org-table-local-parameters))
7606 (nth 1 tmp)))
7608 (setq c (string-to-char (match-string 1 fmt))
7609 n (string-to-number (match-string 2 fmt)))
7610 (if (= c ?p)
7611 (setq modes (org-set-calc-mode 'calc-internal-prec n))
7612 (setq modes (org-set-calc-mode
7613 'calc-float-format
7614 (list (cdr (assoc c '((?n . float) (?f . fix)
7615 (?s . sci) (?e . eng))))
7616 n))))
7617 (setq fmt (replace-match "" t t fmt)))
7618 (if (string-match "[NT]" fmt)
7619 (setq numbers (equal (match-string 0 fmt) "N")
7620 fmt (replace-match "" t t fmt)))
7621 (if (string-match "E" fmt)
7622 (setq keep-empty t
7623 fmt (replace-match "" t t fmt)))
7624 (while (string-match "[DRFS]" fmt)
7625 (setq modes (org-set-calc-mode (match-string 0 fmt)))
7626 (setq fmt (replace-match "" t t fmt)))
7628 (setq fmt nil))))
7629 (if (and (not suppress-const) org-table-formula-use-constants)
7630 (setq formula (org-table-formula-substitute-names formula)))
7631 (setq orig (or (get-text-property 1 :orig-formula formula) "?"))
7632 (while (> ndown 0)
7633 (setq fields (org-split-string
7634 (org-no-properties
7635 (buffer-substring (point-at-bol) (point-at-eol)))
7636 " *| *"))
7637 (if numbers
7638 (setq fields (mapcar
7639 (lambda (x) (number-to-string (string-to-number x)))
7640 fields)))
7641 (setq ndown (1- ndown))
7642 (setq form (copy-sequence formula)
7643 lispp (and (> (length form) 2)(equal (substring form 0 2) "'(")))
7644 ;; Check for old vertical references
7645 (setq form (org-rewrite-old-row-references form))
7646 ;; Insert complex ranges
7647 (while (string-match org-table-range-regexp form)
7648 (setq form
7649 (replace-match
7650 (save-match-data
7651 (org-table-make-reference
7652 (org-table-get-range (match-string 0 form) nil n0)
7653 keep-empty numbers lispp))
7654 t t form)))
7655 ;; Insert simple ranges
7657 (setq form
7658 (replace-match
7659 (save-match-data
7660 (org-table-make-reference
7661 (org-sublist
7662 fields (string-to-number (match-string 1 form))
7663 (string-to-number (match-string 2 form)))
7664 keep-empty numbers lispp))
7665 t t form)))
7666 (setq form0 form)
7667 ;; Insert the references to fields in same row
7669 (setq n (string-to-number (match-string 1 form))
7670 x (nth (1- (if (= n 0) n0 n)) fields))
7672 (match-string 0 form)))
7673 (setq form (replace-match
7674 (save-match-data
7675 (org-table-make-reference x nil numbers lispp))
7676 t t form)))
7678 (if lispp
7679 (setq ev (condition-case nil
7680 (eval (eval (read form)))
7681 (error "#ERROR"))
7682 ev (if (numberp ev) (number-to-string ev) ev))
7683 (or (fboundp 'calc-eval)
7684 (error "Calc does not seem to be installed, and is needed to evaluate the formula"))
7685 (setq ev (calc-eval (cons form modes)
7686 (if numbers 'num))))
7688 (when org-table-formula-debug
7689 (with-output-to-temp-buffer "*Substitution History*"
7690 (princ (format "Substitution history of formula
7691 Orig: %s
7692 $xyz-> %s
7693 @r$c-> %s
7695 (if (listp ev)
7697 (make-string (car ev) ?\-) (nth 1 ev)))
7699 ev (or fmt "NONE")
7700 (if fmt (format fmt (string-to-number ev)) ev)))))
7701 (setq bw (get-buffer-window "*Substitution History*"))
7702 (shrink-window-if-larger-than-buffer bw)
7703 (unless (and (interactive-p) (not ndown))
7704 (unless (let (inhibit-redisplay)
7705 (y-or-n-p "Debugging Formula. Continue to next? "))
7706 (org-table-align)
7707 (error "Abort"))
7708 (delete-window bw)
7709 (message "")))
7710 (if (listp ev) (setq fmt nil ev "#ERROR"))
7711 (org-table-justify-field-maybe
7712 (if fmt (format fmt (string-to-number ev)) ev))
7714 (call-interactively 'org-return)
7715 (setq ndown 0)))
7716 (and down (org-table-maybe-recalculate-line))
7717 (or suppress-align (and org-table-may-need-update
7718 (org-table-align))))))
7720 (defun org-table-get-range (desc &optional tbeg col highlight)
7721 "Get a calc vector from a column, accorting to descriptor DESC.
7722 Optional arguments TBEG and COL can give the beginning of the table and
7723 the current column, to avoid unnecessary parsing.
7724 HIGHLIGHT means, just highlight the range."
7725 (if (not (equal (string-to-char desc) ?@))
7726 (setq desc (concat "@" desc)))
7727 (save-excursion
7728 (or tbeg (setq tbeg (org-table-begin)))
7729 (or col (setq col (org-table-current-column)))
7730 (let ((thisline (org-current-line))
7731 beg end c1 c2 r1 r2 rangep tmp)
7732 (unless (string-match org-table-range-regexp desc)
7733 (error "Invalid table range specifier `%s'" desc))
7734 (setq rangep (match-end 3)
7735 r1 (and (match-end 1) (match-string 1 desc))
7736 r2 (and (match-end 4) (match-string 4 desc))
7737 c1 (and (match-end 2) (substring (match-string 2 desc) 1))
7738 c2 (and (match-end 5) (substring (match-string 5 desc) 1)))
7740 (and c1 (setq c1 (+ (string-to-number c1)
7741 (if (memq (string-to-char c1) '(?- ?+)) col 0))))
7742 (and c2 (setq c2 (+ (string-to-number c2)
7743 (if (memq (string-to-char c2) '(?- ?+)) col 0))))
7744 (if (equal r1 "") (setq r1 nil))
7745 (if (equal r2 "") (setq r2 nil))
7746 (if r1 (setq r1 (org-table-get-descriptor-line r1)))
7747 (if r2 (setq r2 (org-table-get-descriptor-line r2)))
7748 ; (setq r2 (or r2 r1) c2 (or c2 c1))
7749 (if (not r1) (setq r1 thisline))
7750 (if (not r2) (setq r2 thisline))
7751 (if (not c1) (setq c1 col))
7752 (if (not c2) (setq c2 col))
7753 (if (or (not rangep) (and (= r1 r2) (= c1 c2)))
7754 ;; just one field
7755 (progn
7756 (goto-line r1)
7757 (while (not (looking-at org-table-dataline-regexp))
7758 (beginning-of-line 2))
7759 (prog1 (org-table-get-field c1)
7760 (if highlight (org-table-highlight-rectangle (point) (point)))))
7761 ;; A range, return a vector
7762 ;; First sort the numbers to get a regular ractangle
7763 (if (< r2 r1) (setq tmp r1 r1 r2 r2 tmp))
7764 (if (< c2 c1) (setq tmp c1 c1 c2 c2 tmp))
7765 (goto-line r1)
7766 (while (not (looking-at org-table-dataline-regexp))
7767 (beginning-of-line 2))
7768 (org-table-goto-column c1)
7769 (setq beg (point))
7770 (goto-line r2)
7771 (while (not (looking-at org-table-dataline-regexp))
7772 (beginning-of-line 0))
7773 (org-table-goto-column c2)
7774 (setq end (point))
7775 (if highlight
7776 (org-table-highlight-rectangle
7778 ;; return string representation of calc vector
7779 (apply 'append (org-table-copy-region beg end))))))
7781 (defun org-table-get-descriptor-line (desc &optional cline bline table)
7782 "Analyze descriptor DESC and retrieve the corresponding line number.
7783 The cursor is currently in line CLINE, the table begins in line BLINE,
7784 and TABLE is a vector with line types."
7785 (if (string-match "^[0-9]+$" desc)
7786 (aref org-table-dlines (string-to-number desc))
7787 (setq cline (or cline (org-current-line))
7788 bline (or bline org-table-current-begin-line)
7789 table (or table org-table-current-line-types))
7790 (if (or
7792 ;; 1 2 3 4 5 6
7793 (and (not (match-end 3)) (not (match-end 6)))
7794 (and (match-end 3) (match-end 6) (not (match-end 5))))
7795 (error "invalid row descriptor `%s'" desc))
7796 (let* ((hdir (and (match-end 2) (match-string 2 desc)))
7797 (hn (if (match-end 3) (- (match-end 3) (match-beginning 3)) nil))
7798 (odir (and (match-end 5) (match-string 5 desc)))
7799 (on (if (match-end 6) (string-to-number (match-string 6 desc))))
7800 (i (- cline bline))
7801 (rel (and (match-end 6)
7802 (or (and (match-end 1) (not (match-end 3)))
7803 (match-end 5)))))
7804 (if (and hn (not hdir))
7805 (progn
7806 (setq i 0 hdir "+")
7807 (if (eq (aref table 0) 'hline) (setq hn (1- hn)))))
7808 (if (and (not hn) on (not odir))
7809 (error "should never happen");;(aref org-table-dlines on) FIXME
7810 (if (and hn (> hn 0))
7811 (setq i (org-find-row-type table i 'hline (equal hdir "-") nil hn)))
7812 (if on
7813 (setq i (org-find-row-type table i 'dline (equal odir "-") rel on)))
7814 (+ bline i)))))
7816 (defun org-find-row-type (table i type backwards relative n)
7817 (let ((l (length table)))
7818 (while (> n 0)
7819 (while (and (setq i (+ i (if backwards -1 1)))
7820 (>= i 0) (< i l)
7821 (not (eq (aref table i) type))
7822 (if (and relative (eq (aref table i) 'hline))
7823 (progn (setq i (- i (if backwards -1 1)) n 1) nil)
7824 t)))
7825 (setq n (1- n)))
7826 (if (or (< i 0) (>= i l))
7827 (error "Row descriptior leads outside table")
7828 i)))
7830 (defun org-rewrite-old-row-references (s)
7831 (if (string-match "&[-+0-9I]" s)
7832 (error "Formula contains old &row reference, please rewrite using @-syntax")
7833 s))
7835 (defun org-table-make-reference (elements keep-empty numbers lispp)
7836 "Convert list ELEMENTS to something appropriate to insert into formula.
7837 KEEP-EMPTY indicated to keep empty fields, default is to skip them.
7838 NUMBERS indicates that everything should be converted to numbers.
7839 LISPP means to return something appropriate for a Lisp list."
7840 (if (stringp elements) ; just a single val
7841 (if lispp
7842 (prin1-to-string (if numbers (string-to-number elements) elements))
7843 (if (equal elements "") (setq elements "0"))
7844 (if numbers (number-to-string (string-to-number elements)) elements))
7845 (unless keep-empty
7846 (setq elements
7847 (delq nil
7849 elements))))
7850 (setq elements (or elements '("0")))
7851 (if lispp
7852 (mapconcat 'prin1-to-string
7853 (if numbers (mapcar 'string-to-number elements) elements)
7854 " ")
7855 (concat "[" (mapconcat
7856 (lambda (x)
7857 (if numbers (number-to-string (string-to-number x)) x))
7858 elements
7859 ",") "]"))))
7861 (defun org-table-recalculate (&optional all noalign)
7862 "Recalculate the current table line by applying all stored formulas.
7863 With prefix arg ALL, do this for all lines in the table."
7864 (interactive "P")
7865 (or (memq this-command org-recalc-commands)
7866 (setq org-recalc-commands (cons this-command org-recalc-commands)))
7867 (unless (org-at-table-p) (error "Not at a table"))
7868 (if (equal all '(16))
7869 (org-table-iterate)
7870 (org-table-get-specials)
7871 (let* ((eqlist (sort (org-table-get-stored-formulas)
7872 (lambda (a b) (string< (car a) (car b)))))
7873 (inhibit-redisplay (not debug-on-error))
7874 (line-re org-table-dataline-regexp)
7875 (thisline (org-current-line))
7876 (thiscol (org-table-current-column))
7877 beg end entry eqlnum eqlname eql (cnt 0) eq a name)
7878 ;; Insert constants in all formulas
7879 (setq eqlist
7880 (mapcar (lambda (x)
7881 (setcdr x (org-table-formula-substitute-names (cdr x)))
7882 x)
7883 eqlist))
7884 ;; Split the equation list
7885 (while (setq eq (pop eqlist))
7886 (if (<= (string-to-char (car eq)) ?9)
7887 (push eq eqlnum)
7888 (push eq eqlname)))
7889 (setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname))
7890 (if all
7891 (progn
7892 (setq end (move-marker (make-marker) (1+ (org-table-end))))
7893 (goto-char (setq beg (org-table-begin)))
7894 (if (re-search-forward org-table-calculate-mark-regexp end t)
7895 ;; This is a table with marked lines, compute selected lines
7896 (setq line-re org-table-recalculate-regexp)
7897 ;; Move forward to the first non-header line
7898 (if (and (re-search-forward org-table-dataline-regexp end t)
7899 (re-search-forward org-table-hline-regexp end t)
7900 (re-search-forward org-table-dataline-regexp end t))
7901 (setq beg (match-beginning 0))
7902 nil))) ;; just leave beg where it is
7903 (setq beg (point-at-bol)
7904 end (move-marker (make-marker) (1+ (point-at-eol)))))
7905 (goto-char beg)
7906 (and all (message "Re-applying formulas to full table..."))
7907 (while (re-search-forward line-re end t)
7908 (unless (string-match "^ *[_^!$] *$" (org-table-get-field 1))
7909 ;; Unprotected line, recalculate
7910 (and all (message "Re-applying formulas to full table...(line %d)"
7911 (setq cnt (1+ cnt))))
7912 (setq org-last-recalc-line (org-current-line))
7913 (setq eql eqlnum)
7914 (while (setq entry (pop eql))
7915 (goto-line org-last-recalc-line)
7916 (org-table-goto-column (string-to-number (car entry)) nil 'force)
7917 (org-table-eval-formula nil (cdr entry)
7918 'noalign 'nocst 'nostore 'noanalysis))))
7919 (goto-line thisline)
7920 (org-table-goto-column thiscol)
7921 (or noalign (and org-table-may-need-update (org-table-align))
7922 (and all (message "Re-applying formulas to %d lines...done" cnt)))
7923 ;; Now do the named fields
7924 (while (setq eq (pop eqlname))
7925 (setq name (car eq)
7926 a (assoc name org-table-named-field-locations))
7927 (and (not a)
7929 (setq a
7930 (list
7931 name
7932 (aref org-table-dlines
7933 (string-to-number (match-string 1 name)))
7934 (string-to-number (match-string 2 name)))))
7935 (when (and a (or all (equal (nth 1 a) thisline)))
7936 (message "Re-applying formula to field: %s" name)
7937 (goto-line (nth 1 a))
7938 (org-table-goto-column (nth 2 a))
7939 (org-table-eval-formula nil (cdr eq) 'noalign 'nocst
7940 'nostore 'noanalysis)))
7941 ;; back to initial position
7942 (message "Re-applying formulas...done")
7943 (goto-line thisline)
7944 (org-table-goto-column thiscol)
7945 (or noalign (and org-table-may-need-update (org-table-align))
7946 (and all (message "Re-applying formulas...done"))))))
7948 (defun org-table-iterate (&optional arg)
7949 "Recalculate the table until it does not change anymore."
7950 (interactive "P")
7951 (let ((imax (if arg (prefix-numeric-value arg) 10))
7952 (i 0)
7953 (lasttbl (buffer-substring (org-table-begin) (org-table-end)))
7954 thistbl)
7955 (catch 'exit
7956 (while (< i imax)
7957 (setq i (1+ i))
7958 (org-table-recalculate 'all)
7959 (setq thistbl (buffer-substring (org-table-begin) (org-table-end)))
7960 (if (not (string= lasttbl thistbl))
7961 (setq lasttbl thistbl)
7962 (if (> i 1)
7963 (message "Convergence after %d iterations" i)
7964 (message "Table was already stable"))
7965 (throw 'exit t)))
7966 (error "No convergence after %d iterations" i))))
7968 (defun org-table-formula-substitute-names (f)
7969 "Replace $const with values in string F."
7970 (let ((start 0) a (f1 f))
7971 ;; First, check for column names
7972 (while (setq start (string-match org-table-column-name-regexp f start))
7973 (setq start (1+ start))
7974 (setq a (assoc (match-string 1 f) org-table-column-names))
7975 (setq f (replace-match (concat "$" (cdr a)) t t f)))
7976 ;; Parameters and constants
7977 (setq start 0)
7979 (setq start (1+ start))
7980 (if (setq a (save-match-data
7981 (org-table-get-constant (match-string 1 f))))
7982 (setq f (replace-match (concat "(" a ")") t t f))))
7983 (if org-table-formula-debug
7984 (put-text-property 0 (length f) :orig-formula f1 f))
7985 f))
7987 (defun org-table-get-constant (const)
7988 "Find the value for a parameter or constant in a formula.
7989 Parameters get priority."
7990 (or (cdr (assoc const org-table-local-parameters))
7991 (cdr (assoc const org-table-formula-constants))
7992 (and (fboundp 'constants-get) (constants-get const))
7993 "#UNDEFINED_NAME"))
7995 (defvar org-table-fedit-map (make-sparse-keymap))
7996 (define-key org-table-fedit-map "\C-x\C-s" 'org-table-fedit-finish)
7997 (define-key org-table-fedit-map "\C-c\C-s" 'org-table-fedit-finish)
7998 (define-key org-table-fedit-map "\C-c\C-c" 'org-table-fedit-finish)
7999 (define-key org-table-fedit-map "\C-c\C-q" 'org-table-fedit-abort)
8000 (define-key org-table-fedit-map "\C-c?" 'org-table-show-reference)
8001 (define-key org-table-fedit-map [(meta shift up)] 'org-table-fedit-line-up)
8002 (define-key org-table-fedit-map [(meta shift down)] 'org-table-fedit-line-down)
8003 (define-key org-table-fedit-map [(shift up)] 'org-table-fedit-ref-up)
8004 (define-key org-table-fedit-map [(shift down)] 'org-table-fedit-ref-down)
8005 (define-key org-table-fedit-map [(shift left)] 'org-table-fedit-ref-left)
8006 (define-key org-table-fedit-map [(shift right)] 'org-table-fedit-ref-right)
8007 (define-key org-table-fedit-map [(meta up)] 'org-table-fedit-scroll-down)
8008 (define-key org-table-fedit-map [(meta down)] 'org-table-fedit-scroll)
8009 (define-key org-table-fedit-map [(meta tab)] 'lisp-complete-symbol)
8010 (define-key org-table-fedit-map "\M-\C-i" 'lisp-complete-symbol)
8011 (define-key org-table-fedit-map [(tab)] 'org-table-fedit-lisp-indent)
8012 (define-key org-table-fedit-map "\C-i" 'org-table-fedit-lisp-indent)
8013 (define-key org-table-fedit-map "\C-c\C-r" 'org-table-fedit-toggle-ref-type)
8014 (define-key org-table-fedit-map "\C-c}" 'org-table-fedit-toggle-coordinates)
8016 (easy-menu-define org-table-fedit-menu org-table-fedit-map "Org Edit Formulas Menu"
8017 '("Edit-Formulas"
8018 ["Finish and Install" org-table-fedit-finish t]
8019 ["Finish, Install, and Apply" (org-table-fedit-finish t) :keys "C-u C-c C-c"]
8020 ["Abort" org-table-fedit-abort t]
8021 "--"
8022 ["Pretty-Print Lisp Formula" org-table-fedit-lisp-indent t]
8023 ["Complete Lisp Symbol" lisp-complete-symbol t]
8024 "--"
8025 "Shift Reference at Point"
8026 ["Up" org-table-fedit-ref-up t]
8027 ["Down" org-table-fedit-ref-down t]
8028 ["Left" org-table-fedit-ref-left t]
8029 ["Right" org-table-fedit-ref-right t]
8030 "-"
8031 "Change Test Row for Column Formulas"
8032 ["Up" org-table-fedit-line-up t]
8033 ["Down" org-table-fedit-line-down t]
8034 "--"
8035 ["Scroll Table Window" org-table-fedit-scroll t]
8036 ["Scroll Table Window down" org-table-fedit-scroll-down t]
8037 ["Show Table Grid" org-table-fedit-toggle-coordinates
8038 :style toggle :selected (with-current-buffer (marker-buffer org-pos)
8039 org-table-overlay-coordinates)]
8040 "--"
8041 ["Standard Refs (B3 instead of @3$2)" org-table-fedit-toggle-ref-type
8042 :style toggle :selected org-table-buffer-is-an]))
8044 (defvar org-pos)
8046 (defun org-table-edit-formulas ()
8047 "Edit the formulas of the current table in a separate buffer."
8048 (interactive)
8050 (beginning-of-line 0))
8051 (unless (org-at-table-p) (error "Not at a table"))
8052 (org-table-get-specials)
8053 (let ((key (org-table-current-field-formula 'key 'noerror))
8054 (eql (sort (org-table-get-stored-formulas 'noerror)
8055 'org-table-formula-less-p))
8056 (pos (move-marker (make-marker) (point)))
8057 (startline 1)
8058 (wc (current-window-configuration))
8062 entry s type title)
8063 (switch-to-buffer-other-window "*Edit Formulas*")
8064 (erase-buffer)
8065 (fundamental-mode)
8066 (org-set-local 'org-pos pos)
8067 (org-set-local 'org-window-configuration wc)
8068 (use-local-map org-table-fedit-map)
8069 (org-add-hook 'post-command-hook 'org-table-fedit-post-command t t)
8070 (easy-menu-add org-table-fedit-menu)
8071 (setq startline (org-current-line))
8072 (while (setq entry (pop eql))
8073 (setq type (cond
8074 ((equal (string-to-char (car entry)) ?@) 'field)
8075 ((string-match "^[0-9]" (car entry)) 'column)
8076 (t 'named)))
8077 (when (setq title (assq type titles))
8079 (insert (org-add-props (cdr title) nil 'face font-lock-comment-face))
8080 (setq titles (delq title titles)))
8081 (if (equal key (car entry)) (setq startline (org-current-line)))
8082 (setq s (concat (if (equal (string-to-char (car entry)) ?@) "" "$")
8084 (remove-text-properties 0 (length s) '(face nil) s)
8085 (insert s))
8086 (if (eq org-table-use-standard-references t)
8087 (org-table-fedit-toggle-ref-type))
8088 (goto-line startline)
8089 (message "Edit formulas and finish with `C-c C-c'. See menu for more commands.")))
8091 (defun org-table-fedit-post-command ()
8092 (when (not (memq this-command '(lisp-complete-symbol)))
8093 (let ((win (selected-window)))
8094 (save-excursion
8095 (condition-case nil
8096 (org-table-show-reference)
8097 (error nil))
8098 (select-window win)))))
8100 (defun org-table-fedit-finish (&optional arg)
8101 "Parse the buffer for formula definitions and install them.
8102 With prefix ARG, apply the new formulas to the table."
8103 (interactive "P")
8104 (org-table-remove-rectangle-highlight)
8105 (if org-table-use-standard-references
8106 (progn
8107 (org-table-fedit-convert-buffer 'org-table-convert-refs-to-rc)
8108 (setq org-table-buffer-is-an nil)))
8109 (let ((pos org-pos) eql var form)
8110 (goto-char (point-min))
8111 (while (re-search-forward
8113 nil t)
8114 (setq var (if (match-end 2) (match-string 2) (match-string 1))
8115 form (match-string 3))
8116 (setq form (org-trim form))
8117 (when (not (equal form ""))
8119 (setq form (replace-match " " t t form)))
8120 (when (assoc var eql)
8121 (error "Double formulas for %s" var))
8122 (push (cons var form) eql)))
8123 (setq org-pos nil)
8124 (set-window-configuration org-window-configuration)
8125 (select-window (get-buffer-window (marker-buffer pos)))
8126 (goto-char pos)
8127 (unless (org-at-table-p)
8128 (error "Lost table position - cannot install formulae"))
8129 (org-table-store-formulas eql)
8130 (move-marker pos nil)
8131 (kill-buffer "*Edit Formulas*")
8132 (if arg
8133 (org-table-recalculate 'all)
8134 (message "New formulas installed - press C-u C-c C-c to apply."))))
8136 (defun org-table-fedit-abort ()
8137 "Abort editing formulas, without installing the changes."
8138 (interactive)
8139 (org-table-remove-rectangle-highlight)
8140 (let ((pos org-pos))
8141 (set-window-configuration org-window-configuration)
8142 (select-window (get-buffer-window (marker-buffer pos)))
8143 (goto-char pos)
8144 (move-marker pos nil)
8145 (message "Formula editing aborted without installing changes")))
8147 (defun org-table-fedit-lisp-indent ()
8148 "Pretty-print and re-indent Lisp expressions in the Formula Editor."
8149 (interactive)
8150 (let ((pos (point)) beg end ind)
8151 (beginning-of-line 1)
8152 (cond
8154 (goto-char pos)
8155 (call-interactively 'lisp-indent-line))
8157 ((not (fboundp 'pp-buffer))
8158 (error "Cannot pretty-print. Command `pp-buffer' is not available."))
8159 ((looking-at "[$@0-9a-zA-Z]+ *= *'(")
8160 (goto-char (- (match-end 0) 2))
8161 (setq beg (point))
8162 (setq ind (make-string (current-column) ?\ ))
8163 (condition-case nil (forward-sexp 1)
8164 (error
8165 (error "Cannot pretty-print Lisp expression: Unbalanced parenthesis")))
8166 (setq end (point))
8167 (save-restriction
8168 (narrow-to-region beg end)
8169 (if (eq last-command this-command)
8170 (progn
8171 (goto-char (point-min))
8172 (setq this-command nil)
8174 (replace-match " ")))
8175 (pp-buffer)
8176 (untabify (point-min) (point-max))
8177 (goto-char (1+ (point-min)))
8178 (while (re-search-forward "^." nil t)
8179 (beginning-of-line 1)
8180 (insert ind))
8181 (goto-char (point-max))
8182 (backward-delete-char 1)))
8183 (goto-char beg))
8184 (t nil))))
8186 (defvar org-show-positions nil)
8188 (defun org-table-show-reference (&optional local)
8189 "Show the location/value of the $ expression at point."
8190 (interactive)
8191 (org-table-remove-rectangle-highlight)
8192 (catch 'exit
8193 (let ((pos (if local (point) org-pos))
8194 (face2 'highlight)
8195 (org-inhibit-highlight-removal t)
8196 (win (selected-window))
8197 (org-show-positions nil)
8198 var name e what match dest)
8199 (if local (org-table-get-specials))
8200 (setq what (cond
8201 ((or (org-at-regexp-p org-table-range-regexp2)
8202 (org-at-regexp-p org-table-translate-regexp)
8203 (org-at-regexp-p org-table-range-regexp))
8204 (setq match
8205 (save-match-data
8206 (org-table-convert-refs-to-rc (match-string 0))))
8207 'range)
8210 ((not local) nil)
8211 (t (error "No reference at point")))
8212 match (and what (or match (match-string 0))))
8213 (when (and match (not (equal (match-beginning 0) (point-at-bol))))
8214 (org-table-add-rectangle-overlay (match-beginning 0) (match-end 0)
8215 'secondary-selection))
8216 (org-add-hook 'before-change-functions
8217 'org-table-remove-rectangle-highlight)
8218 (if (eq what 'name) (setq var (substring match 1)))
8219 (when (eq what 'range)
8220 (or (equal (string-to-char match) ?@) (setq match (concat "@" match)))
8221 (setq match (org-table-formula-substitute-names match)))
8222 (unless local
8223 (save-excursion
8224 (end-of-line 1)
8226 (beginning-of-line 1)
8228 (setq dest
8229 (save-match-data
8230 (org-table-convert-refs-to-rc (match-string 1))))
8231 (org-table-add-rectangle-overlay
8232 (match-beginning 1) (match-end 1) face2))))
8233 (if (and (markerp pos) (marker-buffer pos))
8234 (if (get-buffer-window (marker-buffer pos))
8235 (select-window (get-buffer-window (marker-buffer pos)))
8236 (switch-to-buffer-other-window (get-buffer-window
8237 (marker-buffer pos)))))
8238 (goto-char pos)
8239 (org-table-force-dataline)
8240 (when dest
8241 (setq name (substring dest 1))
8242 (cond
8244 (setq e (assoc name org-table-named-field-locations))
8245 (goto-line (nth 1 e))
8246 (org-table-goto-column (nth 2 e)))
8248 (let ((l (string-to-number (match-string 1 dest)))
8249 (c (string-to-number (match-string 2 dest))))
8250 (goto-line (aref org-table-dlines l))
8251 (org-table-goto-column c)))
8252 (t (org-table-goto-column (string-to-number name))))
8253 (move-marker pos (point))
8254 (org-table-highlight-rectangle nil nil face2))
8255 (cond
8256 ((equal dest match))
8257 ((not match))
8258 ((eq what 'range)
8259 (condition-case nil
8260 (save-excursion
8261 (org-table-get-range match nil nil 'highlight))
8262 (error nil)))
8263 ((setq e (assoc var org-table-named-field-locations))
8264 (goto-line (nth 1 e))
8265 (org-table-goto-column (nth 2 e))
8266 (org-table-highlight-rectangle (point) (point))
8267 (message "Named field, column %d of line %d" (nth 2 e) (nth 1 e)))
8268 ((setq e (assoc var org-table-column-names))
8269 (org-table-goto-column (string-to-number (cdr e)))
8270 (org-table-highlight-rectangle (point) (point))
8271 (goto-char (org-table-begin))
8273 (org-table-end) t)
8274 (progn
8275 (goto-char (match-beginning 1))
8276 (org-table-highlight-rectangle)
8277 (message "Named column (column %s)" (cdr e)))
8278 (error "Column name not found")))
8279 ((eq what 'column)
8280 ;; column number
8281 (org-table-goto-column (string-to-number (substring match 1)))
8282 (org-table-highlight-rectangle (point) (point))
8283 (message "Column %s" (substring match 1)))
8284 ((setq e (assoc var org-table-local-parameters))
8285 (goto-char (org-table-begin))
8287 (progn
8288 (goto-char (match-beginning 1))
8289 (org-table-highlight-rectangle)
8290 (message "Local parameter."))
8291 (error "Parameter not found")))
8292 (t
8293 (cond
8294 ((not var) (error "No reference at point"))
8295 ((setq e (assoc var org-table-formula-constants))
8296 (message "Constant: $%s=%s in `org-table-formula-constants'."
8297 var (cdr e)))
8298 ((setq e (and (fboundp 'constants-get) (constants-get var)))
8299 (message "Constant: $%s=%s, from `constants.el'%s."
8300 var e (format " (%s units)" constants-unit-system)))
8301 (t (error "Undefined name $%s" var)))))
8302 (goto-char pos)
8303 (when (and org-show-positions
8304 (not (memq this-command '(org-table-fedit-scroll
8305 org-table-fedit-scroll-down))))
8306 (push pos org-show-positions)
8307 (push org-table-current-begin-pos org-show-positions)
8308 (let ((min (apply 'min org-show-positions))
8309 (max (apply 'max org-show-positions)))
8310 (goto-char min) (recenter 0)
8311 (goto-char max)
8312 (or (pos-visible-in-window-p max) (recenter -1))))
8313 (select-window win))))
8315 (defun org-table-force-dataline ()
8316 "Make sure the cursor is in a dataline in a table."
8317 (unless (save-excursion
8318 (beginning-of-line 1)
8319 (looking-at org-table-dataline-regexp))
8320 (let* ((re org-table-dataline-regexp)
8321 (p1 (save-excursion (re-search-forward re nil 'move)))
8322 (p2 (save-excursion (re-search-backward re nil 'move))))
8323 (cond ((and p1 p2)
8324 (goto-char (if (< (abs (- p1 (point))) (abs (- p2 (point))))
8325 p1 p2)))
8326 ((or p1 p2) (goto-char (or p1 p2)))
8327 (t (error "No table dataline around here"))))))
8329 (defun org-table-fedit-line-up ()
8330 "Move cursor one line up in the window showing the table."
8331 (interactive)
8332 (org-table-fedit-move 'previous-line))
8334 (defun org-table-fedit-line-down ()
8335 "Move cursor one line down in the window showing the table."
8336 (interactive)
8337 (org-table-fedit-move 'next-line))
8339 (defun org-table-fedit-move (command)
8340 "Move the cursor in the window shoinw the table.
8341 Use COMMAND to do the motion, repeat if necessary to end up in a data line."
8342 (let ((org-table-allow-automatic-line-recalculation nil)
8343 (pos org-pos) (win (selected-window)) p)
8344 (select-window (get-buffer-window (marker-buffer org-pos)))
8345 (setq p (point))
8346 (call-interactively command)
8347 (while (and (org-at-table-p)
8348 (org-at-table-hline-p))
8349 (call-interactively command))
8350 (or (org-at-table-p) (goto-char p))
8351 (move-marker pos (point))
8352 (select-window win)))
8354 (defun org-table-fedit-scroll (N)
8355 (interactive "p")
8356 (let ((other-window-scroll-buffer (marker-buffer org-pos)))
8357 (scroll-other-window N)))
8359 (defun org-table-fedit-scroll-down (N)
8360 (interactive "p")
8361 (org-table-fedit-scroll (- N)))
8363 (defvar org-table-rectangle-overlays nil)
8365 (defun org-table-add-rectangle-overlay (beg end &optional face)
8366 "Add a new overlay."
8367 (let ((ov (org-make-overlay beg end)))
8368 (org-overlay-put ov 'face (or face 'secondary-selection))
8369 (push ov org-table-rectangle-overlays)))
8371 (defun org-table-highlight-rectangle (&optional beg end face)
8372 "Highlight rectangular region in a table."
8373 (setq beg (or beg (point)) end (or end (point)))
8374 (let ((b (min beg end))
8375 (e (max beg end))
8376 l1 c1 l2 c2 tmp)
8377 (and (boundp 'org-show-positions)
8378 (setq org-show-positions (cons b (cons e org-show-positions))))
8379 (goto-char (min beg end))
8380 (setq l1 (org-current-line)
8381 c1 (org-table-current-column))
8382 (goto-char (max beg end))
8383 (setq l2 (org-current-line)
8384 c2 (org-table-current-column))
8385 (if (> c1 c2) (setq tmp c1 c1 c2 c2 tmp))
8386 (goto-line l1)
8387 (beginning-of-line 1)
8388 (loop for line from l1 to l2 do
8389 (when (looking-at org-table-dataline-regexp)
8390 (org-table-goto-column c1)
8392 (org-table-goto-column c2)
8394 (org-table-add-rectangle-overlay beg end face))
8395 (beginning-of-line 2))
8396 (goto-char b))
8397 (add-hook 'before-change-functions 'org-table-remove-rectangle-highlight))
8399 (defun org-table-remove-rectangle-highlight (&rest ignore)
8400 "Remove the rectangle overlays."
8401 (unless org-inhibit-highlight-removal
8402 (remove-hook 'before-change-functions 'org-table-remove-rectangle-highlight)
8403 (mapc 'org-delete-overlay org-table-rectangle-overlays)
8404 (setq org-table-rectangle-overlays nil)))
8406 (defvar org-table-coordinate-overlays nil
8407 "Collects the cooordinate grid overlays, so that they can be removed.")
8408 (make-variable-buffer-local 'org-table-coordinate-overlays)
8410 (defun org-table-overlay-coordinates ()
8411 "Add overlays to the table at point, to show row/column coordinates."
8412 (interactive)
8413 (mapc 'org-delete-overlay org-table-coordinate-overlays)
8414 (setq org-table-coordinate-overlays nil)
8415 (save-excursion
8416 (let ((id 0) (ih 0) hline eol s1 s2 str ic ov beg)
8417 (goto-char (org-table-begin))
8418 (while (org-at-table-p)
8419 (setq eol (point-at-eol))
8420 (setq ov (org-make-overlay (point-at-bol) (1+ (point-at-bol))))
8421 (push ov org-table-coordinate-overlays)
8422 (setq hline (looking-at org-table-hline-regexp))
8423 (setq str (if hline (format "I*%-2d" (setq ih (1+ ih)))
8424 (format "%4d" (setq id (1+ id)))))
8425 (org-overlay-before-string ov str 'org-special-keyword 'evaporate)
8426 (when hline
8427 (setq ic 0)
8429 (setq beg (1+ (match-beginning 0))
8430 ic (1+ ic)
8431 s1 (concat "$" (int-to-string ic))
8432 s2 (org-number-to-letters ic)
8433 str (if org-table-use-standard-references s2 s1))
8434 (setq ov (org-make-overlay beg (+ beg (length str))))
8435 (push ov org-table-coordinate-overlays)
8436 (org-overlay-display ov str 'org-special-keyword 'evaporate)))
8437 (beginning-of-line 2)))))
8439 (defun org-table-toggle-coordinate-overlays ()
8440 "Toggle the display of Row/Column numbers in tables."
8441 (interactive)
8442 (setq org-table-overlay-coordinates (not org-table-overlay-coordinates))
8443 (message "Row/Column number display turned %s"
8444 (if org-table-overlay-coordinates "on" "off"))
8445 (if (and (org-at-table-p) org-table-overlay-coordinates)
8446 (org-table-align))
8447 (unless org-table-overlay-coordinates
8448 (mapc 'org-delete-overlay org-table-coordinate-overlays)
8449 (setq org-table-coordinate-overlays nil)))
8451 (defun org-table-toggle-formula-debugger ()
8452 "Toggle the formula debugger in tables."
8453 (interactive)
8454 (setq org-table-formula-debug (not org-table-formula-debug))
8455 (message "Formula debugging has been turned %s"
8456 (if org-table-formula-debug "on" "off")))
8458 ;;; The orgtbl minor mode
8460 ;; Define a minor mode which can be used in other modes in order to
8461 ;; integrate the org-mode table editor.
8463 ;; This is really a hack, because the org-mode table editor uses several
8464 ;; keys which normally belong to the major mode, for example the TAB and
8465 ;; RET keys. Here is how it works: The minor mode defines all the keys
8466 ;; necessary to operate the table editor, but wraps the commands into a
8467 ;; function which tests if the cursor is currently inside a table. If that
8468 ;; is the case, the table editor command is executed. However, when any of
8469 ;; those keys is used outside a table, the function uses `key-binding' to
8470 ;; look up if the key has an associated command in another currently active
8471 ;; keymap (minor modes, major mode, global), and executes that command.
8472 ;; There might be problems if any of the keys used by the table editor is
8473 ;; otherwise used as a prefix key.
8475 ;; Another challenge is that the key binding for TAB can be tab or \C-i,
8476 ;; likewise the binding for RET can be return or \C-m. Orgtbl-mode
8477 ;; addresses this by checking explicitly for both bindings.
8479 ;; The optimized version (see variable `orgtbl-optimized') takes over
8480 ;; all keys which are bound to `self-insert-command' in the *global map*.
8481 ;; Some modes bind other commands to simple characters, for example
8482 ;; AUCTeX binds the double quote to `Tex-insert-quote'. With orgtbl-mode
8483 ;; active, this binding is ignored inside tables and replaced with a
8484 ;; modified self-insert.
8486 (defvar orgtbl-mode nil
8487 "Variable controlling `orgtbl-mode', a minor mode enabling the `org-mode'
8488 table editor in arbitrary modes.")
8489 (make-variable-buffer-local 'orgtbl-mode)
8491 (defvar orgtbl-mode-map (make-keymap)
8492 "Keymap for `orgtbl-mode'.")
8494 ;;;###autoload
8495 (defun turn-on-orgtbl ()
8496 "Unconditionally turn on `orgtbl-mode'."
8497 (orgtbl-mode 1))
8499 (defvar org-old-auto-fill-inhibit-regexp nil
8500 "Local variable used by `orgtbl-mode'")
8503 "Matches a line belonging to an orgtbl.")
8505 (defconst orgtbl-extra-font-lock-keywords
8506 (list (list (concat "^" orgtbl-line-start-regexp ".*")
8507 0 (quote 'org-table) 'prepend))
8508 "Extra font-lock-keywords to be added when orgtbl-mode is active.")
8510 ;;;###autoload
8511 (defun orgtbl-mode (&optional arg)
8512 "The `org-mode' table editor as a minor mode for use in other modes."
8513 (interactive)
8514 (if (org-mode-p)
8515 ;; Exit without error, in case some hook functions calls this
8516 ;; by accident in org-mode.
8517 (message "Orgtbl-mode is not useful in org-mode, command ignored")
8518 (setq orgtbl-mode
8519 (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode)))
8520 (if orgtbl-mode
8521 (progn
8522 (and (orgtbl-setup) (defun orgtbl-setup () nil))
8523 ;; Make sure we are first in minor-mode-map-alist
8524 (let ((c (assq 'orgtbl-mode minor-mode-map-alist)))
8525 (and c (setq minor-mode-map-alist
8526 (cons c (delq c minor-mode-map-alist)))))
8527 (org-set-local (quote org-table-may-need-update) t)
8528 (org-add-hook 'before-change-functions 'org-before-change-function
8529 nil 'local)
8530 (org-set-local 'org-old-auto-fill-inhibit-regexp
8531 auto-fill-inhibit-regexp)
8532 (org-set-local 'auto-fill-inhibit-regexp
8533 (if auto-fill-inhibit-regexp
8535 auto-fill-inhibit-regexp)
8536 orgtbl-line-start-regexp))
8537 (org-add-to-invisibility-spec '(org-cwidth))
8538 (when (fboundp 'font-lock-add-keywords)
8539 (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords)
8540 (org-restart-font-lock))
8541 (easy-menu-add orgtbl-mode-menu)
8542 (run-hooks 'orgtbl-mode-hook))
8543 (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp)
8544 (org-cleanup-narrow-column-properties)
8545 (org-remove-from-invisibility-spec '(org-cwidth))
8546 (remove-hook 'before-change-functions 'org-before-change-function t)
8547 (when (fboundp 'font-lock-remove-keywords)
8548 (font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords)
8549 (org-restart-font-lock))
8550 (easy-menu-remove orgtbl-mode-menu)
8551 (force-mode-line-update 'all))))
8553 (defun org-cleanup-narrow-column-properties ()
8554 "Remove all properties related to narrow-column invisibility."
8555 (let ((s 1))
8556 (while (setq s (text-property-any s (point-max)
8557 'display org-narrow-column-arrow))
8558 (remove-text-properties s (1+ s) '(display t)))
8559 (setq s 1)
8560 (while (setq s (text-property-any s (point-max) 'org-cwidth 1))
8561 (remove-text-properties s (1+ s) '(org-cwidth t)))
8562 (setq s 1)
8563 (while (setq s (text-property-any s (point-max) 'invisible 'org-cwidth))
8564 (remove-text-properties s (1+ s) '(invisible t)))))
8566 ;; Install it as a minor mode.
8567 (put 'orgtbl-mode :included t)
8568 (put 'orgtbl-mode :menu-tag "Org Table Mode")
8569 (add-minor-mode 'orgtbl-mode " OrgTbl" orgtbl-mode-map)
8571 (defun orgtbl-make-binding (fun n &rest keys)
8572 "Create a function for binding in the table minor mode.
8573 FUN is the command to call inside a table. N is used to create a unique
8574 command name. KEYS are keys that should be checked in for a command
8575 to execute outside of tables."
8576 (eval
8577 (list 'defun
8578 (intern (concat "orgtbl-hijacker-command-" (int-to-string n)))
8579 '(arg)
8581 "Outside of tables, run the binding of `"
8582 (mapconcat (lambda (x) (format "%s" x)) keys "' or `")
8583 "'.")
8584 '(interactive "p")
8585 (list 'if
8586 '(org-at-table-p)
8587 (list 'call-interactively (list 'quote fun))
8588 (list 'let '(orgtbl-mode)
8589 (list 'call-interactively
8590 (append '(or)
8591 (mapcar (lambda (k)
8592 (list 'key-binding k))
8593 keys)
8594 '('orgtbl-error))))))))
8596 (defun orgtbl-error ()
8597 "Error when there is no default binding for a table key."
8598 (interactive)
8599 (error "This key is has no function outside tables"))
8601 (defun orgtbl-setup ()
8602 "Setup orgtbl keymaps."
8603 (let ((nfunc 0)
8604 (bindings
8605 (list
8606 '([(meta shift left)] org-table-delete-column)
8607 '([(meta left)] org-table-move-column-left)
8608 '([(meta right)] org-table-move-column-right)
8609 '([(meta shift right)] org-table-insert-column)
8610 '([(meta shift up)] org-table-kill-row)
8611 '([(meta shift down)] org-table-insert-row)
8612 '([(meta up)] org-table-move-row-up)
8613 '([(meta down)] org-table-move-row-down)
8614 '("\C-c\C-w" org-table-cut-region)
8615 '("\C-c\M-w" org-table-copy-region)
8616 '("\C-c\C-y" org-table-paste-rectangle)
8617 '("\C-c-" org-table-insert-hline)
8618 '("\C-c}" org-table-toggle-coordinate-overlays)
8619 '("\C-c{" org-table-toggle-formula-debugger)
8620 '("\C-m" org-table-next-row)
8621 (list (org-key 'S-return) 'org-table-copy-down)
8622 '("\C-c\C-q" org-table-wrap-region)
8623 '("\C-c?" org-table-field-info)
8624 '("\C-c " org-table-blank-field)
8625 '("\C-c+" org-table-sum)
8626 '("\C-c=" org-table-eval-formula)
8627 '("\C-c'" org-table-edit-formulas)
8628 '("\C-c`" org-table-edit-field)
8629 '("\C-c*" org-table-recalculate)
8630 '("\C-c|" org-table-create-or-convert-from-region)
8631 '("\C-c^" org-table-sort-lines)
8632 '([(control ?#)] org-table-rotate-recalc-marks)))
8633 elt key fun cmd)
8634 (while (setq elt (pop bindings))
8635 (setq nfunc (1+ nfunc))
8636 (setq key (car elt)
8637 fun (nth 1 elt)
8638 cmd (orgtbl-make-binding fun nfunc key))
8639 (define-key orgtbl-mode-map key cmd))
8641 ;; Special treatment needed for TAB and RET
8642 (define-key orgtbl-mode-map [(return)]
8643 (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m"))
8644 (define-key orgtbl-mode-map "\C-m"
8645 (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)]))
8647 (define-key orgtbl-mode-map [(tab)]
8648 (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i"))
8649 (define-key orgtbl-mode-map "\C-i"
8650 (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)]))
8652 (define-key orgtbl-mode-map [(shift tab)]
8653 (orgtbl-make-binding 'org-table-previous-field 104
8654 [(shift tab)] [(tab)] "\C-i"))
8656 (define-key orgtbl-mode-map "\M-\C-m"
8657 (orgtbl-make-binding 'org-table-wrap-region 105
8658 "\M-\C-m" [(meta return)]))
8659 (define-key orgtbl-mode-map [(meta return)]
8660 (orgtbl-make-binding 'org-table-wrap-region 106
8661 [(meta return)] "\M-\C-m"))
8663 (define-key orgtbl-mode-map "\C-c\C-c" 'orgtbl-ctrl-c-ctrl-c)
8664 (when orgtbl-optimized
8665 ;; If the user wants maximum table support, we need to hijack
8666 ;; some standard editing functions
8667 (org-remap orgtbl-mode-map
8668 'self-insert-command 'orgtbl-self-insert-command
8669 'delete-char 'org-delete-char
8670 'delete-backward-char 'org-delete-backward-char)
8671 (define-key orgtbl-mode-map "|" 'org-force-self-insert))
8672 (easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu"
8673 '("OrgTbl"
8674 ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"]
8675 ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"]
8676 ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"]
8677 ["Next Row" org-return :active (org-at-table-p) :keys "RET"]
8678 "--"
8679 ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"]
8680 ["Edit Field" org-table-edit-field :active (org-at-table-p) :keys "C-c ` "]
8681 ["Copy Field from Above"
8682 org-table-copy-down :active (org-at-table-p) :keys "S-RET"]
8683 "--"
8684 ("Column"
8685 ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-<left>"]
8686 ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-<right>"]
8687 ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"]
8688 ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-<right>"])
8689 ("Row"
8690 ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-<up>"]
8691 ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-<down>"]
8692 ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-<up>"]
8693 ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-<down>"]
8694 ["Sort lines in region" org-table-sort-lines (org-at-table-p) :keys "C-c ^"]
8695 "--"
8696 ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"])
8697 ("Rectangle"
8698 ["Copy Rectangle" org-copy-special :active (org-at-table-p)]
8699 ["Cut Rectangle" org-cut-special :active (org-at-table-p)]
8700 ["Paste Rectangle" org-paste-special :active (org-at-table-p)]
8701 ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p)])
8702 "--"
8703 ("Radio tables"
8704 ["Insert table template" orgtbl-insert-radio-table
8705 (assq major-mode orgtbl-radio-table-templates)]
8706 ["Comment/uncomment table" orgtbl-toggle-comment t])
8707 "--"
8708 ["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="]
8709 ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
8710 ["Edit Formulas" org-table-edit-formulas :active (org-at-table-p) :keys "C-c '"]
8711 ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"]
8712 ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"]
8713 ["Iterate all" (org-table-recalculate '(16)) :active (org-at-table-p) :keys "C-u C-u C-c *"]
8714 ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"]
8715 ["Sum Column/Rectangle" org-table-sum
8716 :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"]
8717 ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"]
8718 ["Debug Formulas"
8719 org-table-toggle-formula-debugger :active (org-at-table-p)
8720 :keys "C-c {"
8721 :style toggle :selected org-table-formula-debug]
8722 ["Show Col/Row Numbers"
8723 org-table-toggle-coordinate-overlays :active (org-at-table-p)
8724 :keys "C-c }"
8725 :style toggle :selected org-table-overlay-coordinates]
8726 ))
8727 t))
8729 (defun orgtbl-ctrl-c-ctrl-c (arg)
8730 "If the cursor is inside a table, realign the table.
8731 It it is a table to be sent away to a receiver, do it.
8732 With prefix arg, also recompute table."
8733 (interactive "P")
8734 (let ((pos (point)) action)
8735 (save-excursion
8736 (beginning-of-line 1)
8740 (cond
8741 ((integerp action)
8742 (goto-char action)
8743 (org-table-maybe-eval-formula)
8744 (if arg
8745 (call-interactively 'org-table-recalculate)
8746 (org-table-maybe-recalculate-line))
8747 (call-interactively 'org-table-align)
8748 (orgtbl-send-table 'maybe))
8749 ((eq action 'recalc)
8750 (save-excursion
8751 (beginning-of-line 1)
8753 (if (org-at-table-p)
8754 (org-call-with-arg 'org-table-recalculate t))))
8755 (t (let (orgtbl-mode)
8756 (call-interactively (key-binding "\C-c\C-c")))))))
8758 (defun orgtbl-tab (arg)
8759 "Justification and field motion for `orgtbl-mode'."
8760 (interactive "P")
8761 (if arg (org-table-edit-field t)
8762 (org-table-justify-field-maybe)
8763 (org-table-next-field)))
8765 (defun orgtbl-ret ()
8766 "Justification and field motion for `orgtbl-mode'."
8767 (interactive)
8768 (org-table-justify-field-maybe)
8769 (org-table-next-row))
8771 (defun orgtbl-self-insert-command (N)
8772 "Like `self-insert-command', use overwrite-mode for whitespace in tables.
8773 If the cursor is in a table looking at whitespace, the whitespace is
8774 overwritten, and the table is not marked as requiring realignment."
8775 (interactive "p")
8776 (if (and (org-at-table-p)
8777 (or
8778 (and org-table-auto-blank-field
8779 (member last-command
8780 '(orgtbl-hijacker-command-100
8781 orgtbl-hijacker-command-101
8782 orgtbl-hijacker-command-102
8783 orgtbl-hijacker-command-103
8784 orgtbl-hijacker-command-104
8785 orgtbl-hijacker-command-105))
8786 (org-table-blank-field))
8787 t)
8788 (eq N 1)
8790 (let (org-table-may-need-update)
8791 (goto-char (1- (match-end 0)))
8792 (delete-backward-char 1)
8793 (goto-char (match-beginning 0))
8794 (self-insert-command N))
8795 (setq org-table-may-need-update t)
8796 (let (orgtbl-mode)
8797 (call-interactively (key-binding (vector last-input-event))))))
8799 (defun org-force-self-insert (N)
8800 "Needed to enforce self-insert under remapping."
8801 (interactive "p")
8802 (self-insert-command N))
8805 "Regula expression matching exponentials as produced by calc.")
8807 (defvar org-table-clean-did-remove-column-1 nil)
8809 (defun orgtbl-send-table (&optional maybe)
8810 "Send a tranformed version of this table to the receiver position.
8811 With argument MAYBE, fail quietly if no transformation is defined for
8812 this table."
8813 (interactive)
8814 (catch 'exit
8815 (unless (org-at-table-p) (error "Not at a table"))
8816 ;; when non-interactive, we assume align has just happened.
8817 (when (interactive-p) (org-table-align))
8818 (save-excursion
8819 (goto-char (org-table-begin))
8820 (beginning-of-line 0)
8822 (if maybe
8823 (throw 'exit nil)
8824 (error "Don't know how to transform this table."))))
8825 (let* ((name (match-string 1))
8826 beg
8827 (transform (intern (match-string 2)))
8828 (params (if (match-end 3) (read (concat "(" (match-string 3) ")"))))
8829 (skip (plist-get params :skip))
8830 (skipcols (plist-get params :skipcols))
8831 (txt (buffer-substring-no-properties
8832 (org-table-begin) (org-table-end)))
8834 (lines (org-table-clean-before-export lines))
8835 (i0 (if org-table-clean-did-remove-column-1 2 1))
8836 (table (mapcar
8837 (lambda (x)
8838 (if (string-match org-table-hline-regexp x)
8839 'hline
8840 (org-remove-by-index
8842 skipcols i0)))
8843 lines))
8844 (fun (if (= i0 2) 'cdr 'identity))
8845 (org-table-last-alignment
8846 (org-remove-by-index (funcall fun org-table-last-alignment)
8847 skipcols i0))
8848 (org-table-last-column-widths
8849 (org-remove-by-index (funcall fun org-table-last-column-widths)
8850 skipcols i0)))
8852 (unless (fboundp transform)
8853 (error "No such transformation function %s" transform))
8854 (setq txt (funcall transform table params))
8855 ;; Find the insertion place
8856 (save-excursion
8857 (goto-char (point-min))
8858 (unless (re-search-forward
8860 (error "Don't know where to insert translated table"))
8861 (goto-char (match-beginning 0))
8862 (beginning-of-line 2)
8863 (setq beg (point))
8864 (unless (re-search-forward (concat "END RECEIVE ORGTBL +" name) nil t)
8865 (error "Cannot find end of insertion region"))
8866 (beginning-of-line 1)
8867 (delete-region beg (point))
8868 (goto-char beg)
8870 (message "Table converted and installed at receiver location"))))
8872 (defun org-remove-by-index (list indices &optional i0)
8873 "Remove the elements in LIST with indices in INDICES.
8874 First element has index 0, or I0 if given."
8875 (if (not indices)
8876 list
8877 (if (integerp indices) (setq indices (list indices)))
8878 (setq i0 (1- (or i0 0)))
8879 (delq :rm (mapcar (lambda (x)
8880 (setq i0 (1+ i0))
8881 (if (memq i0 indices) :rm x))
8882 list))))
8884 (defun orgtbl-toggle-comment ()
8885 "Comment or uncomment the orgtbl at point."
8886 (interactive)
8887 (let* ((re1 (concat "^" (regexp-quote comment-start) orgtbl-line-start-regexp))
8888 (re2 (concat "^" orgtbl-line-start-regexp))
8889 (commented (save-excursion (beginning-of-line 1)
8890 (cond ((looking-at re1) t)
8891 ((looking-at re2) nil)
8892 (t (error "Not at an org table")))))
8893 (re (if commented re1 re2))
8894 beg end)
8895 (save-excursion
8896 (beginning-of-line 1)
8897 (while (looking-at re) (beginning-of-line 0))
8898 (beginning-of-line 2)
8899 (setq beg (point))
8900 (while (looking-at re) (beginning-of-line 2))
8901 (setq end (point)))
8902 (comment-region beg end (if commented '(4) nil))))
8904 (defun orgtbl-insert-radio-table ()
8905 "Insert a radio table template appropriate for this major mode."
8906 (interactive)
8907 (let* ((e (assq major-mode orgtbl-radio-table-templates))
8908 (txt (nth 1 e))
8909 name pos)
8910 (unless e (error "No radio table setup defined for %s" major-mode))
8911 (setq name (read-string "Table name: "))
8912 (while (string-match "%n" txt)
8913 (setq txt (replace-match name t t txt)))
8915 (setq pos (point))
8916 (insert txt)
8917 (goto-char pos)))
8919 (defun org-get-param (params header i sym &optional hsym)
8920 "Get parameter value for symbol SYM.
8921 If this is a header line, actually get the value for the symbol with an
8923 If the value is a protperty list, get the element for the current column.
8924 Assumes variables VAL, PARAMS, HEAD and I to be scoped into the function."
8925 (let ((val (plist-get params sym)))
8926 (and hsym header (setq val (or (plist-get params hsym) val)))
8927 (if (consp val) (plist-get val i) val)))
8929 (defun orgtbl-to-generic (table params)
8930 "Convert the orgtbl-mode TABLE to some other format.
8931 This generic routine can be used for many standard cases.
8932 TABLE is a list, each entry either the symbol `hline' for a horizontal
8933 separator line, or a list of fields for that line.
8934 PARAMS is a property list of parameters that can influence the conversion.
8935 For the generic converter, some parameters are obligatory: You need to
8936 specify either :lfmt, or all of (:lstart :lend :sep). If you do not use
8937 :splice, you must have :tstart and :tend.
8939 Valid parameters are
8941 :tstart String to start the table. Ignored when :splice is t.
8942 :tend String to end the table. Ignored when :splice is t.
8944 :splice When set to t, return only table body lines, don't wrap
8945 them into :tstart and :tend. Default is nil.
8947 :hline String to be inserted on horizontal separation lines.
8948 May be nil to ignore hlines.
8950 :lstart String to start a new table line.
8951 :lend String to end a table line
8952 :sep Separator between two fields
8953 :lfmt Format for entire line, with enough %s to capture all fields.
8954 If this is present, :lstart, :lend, and :sep are ignored.
8955 :fmt A format to be used to wrap the field, should contain
8956 %s for the original field value. For example, to wrap
8958 This may also be a property list with column numbers and
8961 :hlstart :hlend :hlsep :hlfmt :hfmt
8962 Same as above, specific for the header lines in the table.
8963 All lines before the first hline are treated as header.
8964 If any of these is not present, the data line value is used.
8966 :efmt Use this format to print numbers with exponentials.
8967 The format should have %s twice for inserting mantissa
8969 may also be a property list with column numbers and
8970 formats. :fmt will still be applied after :efmt.
8972 In addition to this, the parameters :skip and :skipcols are always handled
8973 directly by `orgtbl-send-table'. See manual."
8974 (interactive)
8975 (let* ((p params)
8976 (splicep (plist-get p :splice))
8977 (hline (plist-get p :hline))
8978 rtn line i fm efm lfmt h)
8980 ;; Do we have a header?
8981 (if (and (not splicep) (listp (car table)) (memq 'hline table))
8982 (setq h t))
8984 ;; Put header
8985 (unless splicep
8986 (push (or (plist-get p :tstart) "ERROR: no :tstart") rtn))
8988 ;; Now loop over all lines
8989 (while (setq line (pop table))
8990 (if (eq line 'hline)
8991 ;; A horizontal separator line
8992 (progn (if hline (push hline rtn))
8993 (setq h nil)) ; no longer in header
8994 ;; A normal line. Convert the fields, push line onto the result list
8995 (setq i 0)
8996 (setq line
8997 (mapcar
8998 (lambda (f)
8999 (setq i (1+ i)
9000 fm (org-get-param p h i :fmt :hfmt)
9001 efm (org-get-param p h i :efmt))
9002 (if (and efm (string-match orgtbl-exp-regexp f))
9003 (setq f (format
9004 efm (match-string 1 f) (match-string 2 f))))
9005 (if fm (setq f (format fm f)))
9006 f)
9007 line))
9008 (if (setq lfmt (org-get-param p h i :lfmt :hlfmt))
9009 (push (apply 'format lfmt line) rtn)
9010 (push (concat
9011 (org-get-param p h i :lstart :hlstart)
9012 (mapconcat 'identity line (org-get-param p h i :sep :hsep))
9013 (org-get-param p h i :lend :hlend))
9014 rtn))))
9016 (unless splicep
9017 (push (or (plist-get p :tend) "ERROR: no :tend") rtn))
9021 (defun orgtbl-to-latex (table params)
9022 "Convert the orgtbl-mode TABLE to LaTeX.
9023 TABLE is a list, each entry either the symbol `hline' for a horizontal
9024 separator line, or a list of fields for that line.
9025 PARAMS is a property list of parameters that can influence the conversion.
9026 Supports all parameters from `orgtbl-to-generic'. Most important for
9027 LaTeX are:
9029 :splice When set to t, return only table body lines, don't wrap
9030 them into a tabular environment. Default is nil.
9032 :fmt A format to be used to wrap the field, should contain %s for the
9033 original field value. For example, to wrap everything in dollars,
9037 :efmt Format for transforming numbers with exponentials. The format
9038 should have %s twice for inserting mantissa and exponent, for
9040 This may also be a property list with column numbers and formats.
9042 The general parameters :skip and :skipcols have already been applied when
9043 this function is called."
9044 (let* ((alignment (mapconcat (lambda (x) (if x "r" "l"))
9045 org-table-last-alignment ""))
9046 (params2
9047 (list
9052 (orgtbl-to-generic table (org-combine-plists params2 params))))
9054 (defun orgtbl-to-html (table params)
9055 "Convert the orgtbl-mode TABLE to LaTeX.
9056 TABLE is a list, each entry either the symbol `hline' for a horizontal
9057 separator line, or a list of fields for that line.
9058 PARAMS is a property list of parameters that can influence the conversion.
9059 Currently this function recognizes the following parameters:
9061 :splice When set to t, return only table body lines, don't wrap
9062 them into a <table> environment. Default is nil.
9064 The general parameters :skip and :skipcols have already been applied when
9065 this function is called. The function does *not* use `orgtbl-to-generic',
9066 so you cannot specify parameters for it."
9067 (let* ((splicep (plist-get params :splice))
9068 html)
9069 ;; Just call the formatter we already have
9070 ;; We need to make text lines for it, so put the fields back together.
9071 (setq html (org-format-org-table-html
9072 (mapcar
9073 (lambda (x)
9074 (if (eq x 'hline)
9075 "|----+----|"
9076 (concat "| " (mapconcat 'identity x " | ") " |")))
9077 table)
9078 splicep))
9080 (setq html (replace-match "" t t html)))
9081 html))
9083 (defun orgtbl-to-texinfo (table params)
9084 "Convert the orgtbl-mode TABLE to TeXInfo.
9085 TABLE is a list, each entry either the symbol `hline' for a horizontal
9086 separator line, or a list of fields for that line.
9087 PARAMS is a property list of parameters that can influence the conversion.
9088 Supports all parameters from `orgtbl-to-generic'. Most important for
9089 TeXInfo are:
9091 :splice nil/t When set to t, return only table body lines, don't wrap
9092 them into a multitable environment. Default is nil.
9094 :fmt fmt A format to be used to wrap the field, should contain
9095 %s for the original field value. For example, to wrap
9097 This may also be a property list with column numbers and
9101 are computed automatically from the width of the columns
9102 under org-mode.
9104 The general parameters :skip and :skipcols have already been applied when
9105 this function is called."
9106 (let* ((total (float (apply '+ org-table-last-column-widths)))
9107 (colfrac (or (plist-get params :cf)
9108 (mapconcat
9109 (lambda (x) (format "%.3f" (/ (float x) total)))
9110 org-table-last-column-widths " ")))
9111 (params2
9112 (list
9113 :tstart (concat "@multitable @columnfractions " colfrac)
9114 :tend "@end multitable"
9115 :lstart "@item " :lend "" :sep " @tab "
9116 :hlstart "@headitem ")))
9117 (orgtbl-to-generic table (org-combine-plists params2 params))))
9119 ;;;; Link Stuff
9121 ;;; Link abbreviations
9123 (defun org-link-expand-abbrev (link)
9124 "Apply replacements as defined in `org-link-abbrev-alist."
9126 (let* ((key (match-string 1 link))
9127 (as (or (assoc key org-link-abbrev-alist-local)
9128 (assoc key org-link-abbrev-alist)))
9129 (tag (and (match-end 2) (match-string 3 link)))
9130 rpl)
9131 (if (not as)
9132 link
9133 (setq rpl (cdr as))
9134 (cond
9135 ((symbolp rpl) (funcall rpl tag))
9136 ((string-match "%s" rpl) (replace-match (or tag "") t t rpl))
9137 (t (concat rpl tag)))))
9138 link))
9140 ;;; Storing and inserting links
9142 (defvar org-insert-link-history nil
9143 "Minibuffer history for links inserted with `org-insert-link'.")
9145 (defvar org-stored-links nil
9146 "Contains the links stored with `org-store-link'.")
9148 (defvar org-store-link-plist nil
9149 "Plist with info about the most recently link created with `org-store-link'.")
9151 ;;;###autoload
9152 (defun org-store-link (arg)
9154 This link can later be inserted into an org-buffer with
9156 For some link types, a prefix arg is interpreted:
9157 For links to usenet articles, arg negates `org-usenet-links-prefer-google'.
9158 For file links, arg negates `org-context-in-file-links'."
9159 (interactive "P")
9160 (setq org-store-link-plist nil) ; reset
9161 (let (link cpltxt desc description search txt)
9162 (cond
9164 ((eq major-mode 'bbdb-mode)
9165 (let ((name (bbdb-record-name (bbdb-current-record)))
9166 (company (bbdb-record-company (bbdb-current-record))))
9167 (setq cpltxt (concat "bbdb:" (or name company))
9168 link (org-make-link cpltxt))
9169 (org-store-link-props :type "bbdb" :name name :company company)))
9171 ((eq major-mode 'Info-mode)
9172 (setq link (org-make-link "info:"
9173 (file-name-nondirectory Info-current-file)
9174 ":" Info-current-node))
9175 (setq cpltxt (concat (file-name-nondirectory Info-current-file)
9176 ":" Info-current-node))
9177 (org-store-link-props :type "info" :file Info-current-file
9178 :node Info-current-node))
9180 ((eq major-mode 'calendar-mode)
9181 (let ((cd (calendar-cursor-to-date)))
9182 (setq link
9183 (format-time-string
9184 (car org-time-stamp-formats)
9185 (apply 'encode-time
9186 (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
9187 nil nil nil))))
9188 (org-store-link-props :type "calendar" :date cd)))
9190 ((or (eq major-mode 'vm-summary-mode)
9191 (eq major-mode 'vm-presentation-mode))
9192 (and (eq major-mode 'vm-presentation-mode) (vm-summarize))
9193 (vm-follow-summary-cursor)
9194 (save-excursion
9195 (vm-select-folder-buffer)
9196 (let* ((message (car vm-message-pointer))
9197 (folder buffer-file-name)
9198 (subject (vm-su-subject message))
9199 (to (vm-get-header-contents message "To"))
9200 (from (vm-get-header-contents message "From"))
9201 (message-id (vm-su-message-id message)))
9202 (org-store-link-props :type "vm" :from from :to to :subject subject
9203 :message-id message-id)
9204 (setq message-id (org-remove-angle-brackets message-id))
9205 (setq folder (abbreviate-file-name folder))
9206 (if (string-match (concat "^" (regexp-quote vm-folder-directory))
9207 folder)
9208 (setq folder (replace-match "" t t folder)))
9209 (setq cpltxt (org-email-link-description))
9210 (setq link (org-make-link "vm:" folder "#" message-id)))))
9212 ((eq major-mode 'wl-summary-mode)
9213 (let* ((msgnum (wl-summary-message-number))
9214 (message-id (elmo-message-field wl-summary-buffer-elmo-folder
9215 msgnum 'message-id))
9216 (wl-message-entity
9217 (if (fboundp 'elmo-message-entity)
9218 (elmo-message-entity
9219 wl-summary-buffer-elmo-folder msgnum)
9220 (elmo-msgdb-overview-get-entity
9221 msgnum (wl-summary-buffer-msgdb))))
9222 (from (wl-summary-line-from))
9223 (to (car (elmo-message-entity-field wl-message-entity 'to)))
9224 (subject (let (wl-thr-indent-string wl-parent-message-entity)
9225 (wl-summary-line-subject))))
9226 (org-store-link-props :type "wl" :from from :to to
9227 :subject subject :message-id message-id)
9228 (setq message-id (org-remove-angle-brackets message-id))
9229 (setq cpltxt (org-email-link-description))
9230 (setq link (org-make-link "wl:" wl-summary-buffer-folder-name
9231 "#" message-id))))
9233 ((or (equal major-mode 'mh-folder-mode)
9234 (equal major-mode 'mh-show-mode))
9235 (let ((from (org-mhe-get-header "From:"))
9236 (to (org-mhe-get-header "To:"))
9237 (message-id (org-mhe-get-header "Message-Id:"))
9238 (subject (org-mhe-get-header "Subject:")))
9239 (org-store-link-props :type "mh" :from from :to to
9240 :subject subject :message-id message-id)
9241 (setq cpltxt (org-email-link-description))
9242 (setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#"
9243 (org-remove-angle-brackets message-id)))))
9245 ((eq major-mode 'rmail-mode)
9246 (save-excursion
9247 (save-restriction
9248 (rmail-narrow-to-non-pruned-header)
9249 (let ((folder buffer-file-name)
9250 (message-id (mail-fetch-field "message-id"))
9251 (from (mail-fetch-field "from"))
9252 (to (mail-fetch-field "to"))
9253 (subject (mail-fetch-field "subject")))
9254 (org-store-link-props
9255 :type "rmail" :from from :to to
9256 :subject subject :message-id message-id)
9257 (setq message-id (org-remove-angle-brackets message-id))
9258 (setq cpltxt (org-email-link-description))
9259 (setq link (org-make-link "rmail:" folder "#" message-id))))))
9261 ((eq major-mode 'gnus-group-mode)
9262 (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus
9263 (gnus-group-group-name)) ; version
9264 ((fboundp 'gnus-group-name)
9265 (gnus-group-name))
9266 (t "???"))))
9267 (unless group (error "Not on a group"))
9268 (org-store-link-props :type "gnus" :group group)
9269 (setq cpltxt (concat
9270 (if (org-xor arg org-usenet-links-prefer-google)
9271 "http://groups.google.com/groups?group="
9272 "gnus:")
9273 group)
9274 link (org-make-link cpltxt))))
9276 ((memq major-mode '(gnus-summary-mode gnus-article-mode))
9277 (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary))
9278 (let* ((group gnus-newsgroup-name)
9279 (article (gnus-summary-article-number))
9280 (header (gnus-summary-article-header article))
9281 (from (mail-header-from header))
9282 (message-id (mail-header-id header))
9283 (date (mail-header-date header))
9284 (subject (gnus-summary-subject-string)))
9285 (org-store-link-props :type "gnus" :from from :subject subject
9286 :message-id message-id :group group)
9287 (setq cpltxt (org-email-link-description))
9288 (if (org-xor arg org-usenet-links-prefer-google)
9289 (setq link
9290 (concat
9292 (format "http://groups.google.com/groups?as_umsgid=%s"
9293 (org-fixup-message-id-for-http message-id))))
9294 (setq link (org-make-link "gnus:" group
9295 "#" (number-to-string article))))))
9297 ((eq major-mode 'w3-mode)
9298 (setq cpltxt (url-view-url t)
9299 link (org-make-link cpltxt))
9300 (org-store-link-props :type "w3" :url (url-view-url t)))
9302 ((eq major-mode 'w3m-mode)
9303 (setq cpltxt (or w3m-current-title w3m-current-url)
9304 link (org-make-link w3m-current-url))
9305 (org-store-link-props :type "w3m" :url (url-view-url t)))
9307 ((setq search (run-hook-with-args-until-success
9308 'org-create-file-search-functions))
9309 (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
9310 "::" search))
9311 (setq cpltxt (or description link)))
9313 ((eq major-mode 'image-mode)
9314 (setq cpltxt (concat "file:"
9315 (abbreviate-file-name buffer-file-name))
9316 link (org-make-link cpltxt))
9317 (org-store-link-props :type "image" :file buffer-file-name))
9319 ((eq major-mode 'dired-mode)
9320 ;; link to the file in the current line
9321 (setq cpltxt (concat "file:"
9322 (abbreviate-file-name
9323 (expand-file-name
9324 (dired-get-filename nil t))))
9325 link (org-make-link cpltxt)))
9327 ((and buffer-file-name (org-mode-p))
9328 ;; Just link to current headline
9329 (setq cpltxt (concat "file:"
9330 (abbreviate-file-name buffer-file-name)))
9331 ;; Add a context search string
9332 (when (org-xor org-context-in-file-links arg)
9333 ;; Check if we are on a target
9335 (setq cpltxt (concat cpltxt "::" (match-string 1)))
9336 (setq txt (cond
9337 ((org-on-heading-p) nil)
9338 ((org-region-active-p)
9339 (buffer-substring (region-beginning) (region-end)))
9340 (t (buffer-substring (point-at-bol) (point-at-eol)))))
9342 (setq cpltxt
9343 (concat cpltxt "::" (org-make-org-heading-search-string txt))
9344 desc "NONE"))))
9346 (setq cpltxt (substring cpltxt 0 -2)))
9347 (setq link (org-make-link cpltxt)))
9349 (buffer-file-name
9350 ;; Just link to this file here.
9351 (setq cpltxt (concat "file:"
9352 (abbreviate-file-name buffer-file-name)))
9353 ;; Add a context string
9354 (when (org-xor org-context-in-file-links arg)
9355 (setq txt (if (org-region-active-p)
9356 (buffer-substring (region-beginning) (region-end))
9357 (buffer-substring (point-at-bol) (point-at-eol))))
9358 ;; Only use search option if there is some text.
9360 (setq cpltxt
9361 (concat cpltxt "::" (org-make-org-heading-search-string txt))
9362 desc "NONE")))
9363 (setq link (org-make-link cpltxt)))
9365 ((interactive-p)
9366 (error "Cannot link to a buffer which is not visiting a file"))
9368 (t (setq link nil)))
9370 (if (consp link) (setq cpltxt (car link) link (cdr link)))
9371 (setq link (or link cpltxt)
9372 desc (or desc cpltxt))
9373 (if (equal desc "NONE") (setq desc nil))
9375 (if (and (interactive-p) link)
9376 (progn
9377 (setq org-stored-links
9378 (cons (list cpltxt link desc) org-stored-links))
9379 (message "Stored: %s" (or cpltxt link)))
9380 (org-make-link-string link desc))))
9382 (defun org-store-link-props (&rest plist)
9383 "Store link properties, extract names and addresses."
9384 (let (x adr)
9385 (when (setq x (plist-get plist :from))
9386 (setq adr (mail-extract-address-components x))
9387 (plist-put plist :fromname (car adr))
9388 (plist-put plist :fromaddress (nth 1 adr)))
9389 (when (setq x (plist-get plist :to))
9390 (setq adr (mail-extract-address-components x))
9391 (plist-put plist :toname (car adr))
9392 (plist-put plist :toaddress (nth 1 adr))))
9393 (let ((from (plist-get plist :from))
9394 (to (plist-get plist :to)))
9395 (when (and from to org-from-is-user-regexp)
9396 (plist-put plist :fromto
9397 (if (string-match org-from-is-user-regexp from)
9398 (concat "to %t")
9399 (concat "from %f")))))
9400 (setq org-store-link-plist plist))
9402 (defun org-email-link-description (&optional fmt)
9403 "Return the description part of an email link.
9404 This takes information from `org-store-link-plist' and formats it
9405 according to FMT (default from `org-email-link-description-format')."
9406 (setq fmt (or fmt org-email-link-description-format))
9407 (let* ((p org-store-link-plist)
9408 (to (plist-get p :toaddress))
9409 (from (plist-get p :fromaddress))
9410 (table
9411 (list
9412 (cons "%c" (plist-get p :fromto))
9413 (cons "%F" (plist-get p :from))
9414 (cons "%f" (or (plist-get p :fromname) (plist-get p :fromaddress) "?"))
9415 (cons "%T" (plist-get p :to))
9416 (cons "%t" (or (plist-get p :toname) (plist-get p :toaddress) "?"))
9417 (cons "%s" (plist-get p :subject))
9418 (cons "%m" (plist-get p :message-id)))))
9419 (when (string-match "%c" fmt)
9420 ;; Check if the user wrote this message
9421 (if (and org-from-is-user-regexp from to
9422 (save-match-data (string-match org-from-is-user-regexp from)))
9423 (setq fmt (replace-match "to %t" t t fmt))
9424 (setq fmt (replace-match "from %f" t t fmt))))
9425 (org-replace-escapes fmt table)))
9427 (defun org-make-org-heading-search-string (&optional string heading)
9428 "Make search string for STRING or current headline."
9429 (interactive)
9430 (let ((s (or string (org-get-heading))))
9431 (unless (and string (not heading))
9432 ;; We are using a headline, clean up garbage in there.
9433 (if (string-match org-todo-regexp s)
9434 (setq s (replace-match "" t t s)))
9436 (setq s (replace-match "" t t s)))
9437 (setq s (org-trim s))
9440 (setq s (replace-match "" t t s)))
9441 (while (string-match org-ts-regexp s)
9442 (setq s (replace-match "" t t s))))
9444 (setq s (replace-match " " t t s)))
9445 (or string (setq s (concat "*" s))) ; Add * for headlines
9448 (defun org-make-link (&rest strings)
9449 "Concatenate STRINGS, format resulting string with `org-link-format'."
9450 (apply 'concat strings))
9452 (defun org-make-link-string (link &optional description)
9453 "Make a link with brackets, consisting of LINK and DESCRIPTION."
9454 (when (stringp description)
9455 ;; Remove brackets from the description, they are fatal.
9457 (setq description (replace-match "" t t description))))
9458 (when (equal (org-link-escape link) description)
9459 ;; No description needed, it is identical
9460 (setq description nil))
9461 (when (and (not description)
9462 (not (equal link (org-link-escape link))))
9463 (setq description link))
9464 (concat "[[" (org-link-escape link) "]"
9465 (if description (concat "[" description "]") "")
9466 "]"))
9468 (defconst org-link-escape-chars '(("[" . "%5B") ("]" . "%5D") (" " . "%20"))
9469 "Association list of escapes for some characters problematic in links.")
9471 (defun org-link-escape (text)
9472 "Escape charaters in TEXT that are problematic for links."
9473 (when text
9474 (let ((re (mapconcat (lambda (x) (regexp-quote (car x)))
9476 (while (string-match re text)
9477 (setq text
9478 (replace-match
9479 (cdr (assoc (match-string 0 text) org-link-escape-chars))
9480 t t text)))
9481 text)))
9483 (defun org-link-unescape (text)
9484 "Reverse the action of `org-link-escape'."
9485 (when text
9486 (let ((re (mapconcat (lambda (x) (regexp-quote (cdr x)))
9488 (while (string-match re text)
9489 (setq text
9490 (replace-match
9491 (car (rassoc (match-string 0 text) org-link-escape-chars))
9492 t t text)))
9493 text)))
9495 (defun org-xor (a b)
9496 "Exclusive or."
9497 (if a (not b) b))
9499 (defun org-get-header (header)
9500 "Find a header field in the current buffer."
9501 (save-excursion
9502 (goto-char (point-min))
9503 (let ((case-fold-search t) s)
9504 (cond
9505 ((eq header 'from)
9507 (setq s (match-string 1)))
9509 (setq s (replace-match "" t t s)))
9510 (if (string-match "[<(].*" s)
9511 (setq s (replace-match "" t t s))))
9512 ((eq header 'message-id)
9514 (setq s (match-string 1))))
9515 ((eq header 'subject)
9517 (setq s (match-string 1)))))
9520 s)))
9523 (defun org-fixup-message-id-for-http (s)
9524 "Replace special characters in a message id, so it can be used in an http query."
9525 (while (string-match "<" s)
9526 (setq s (replace-match "%3C" t t s)))
9527 (while (string-match ">" s)
9528 (setq s (replace-match "%3E" t t s)))
9529 (while (string-match "@" s)
9530 (setq s (replace-match "%40" t t s)))
9531 s)
9533 (defun org-insert-link (&optional complete-file)
9534 "Insert a link. At the prompt, enter the link.
9536 Completion can be used to select a link previously stored with
9537 `org-store-link'. When the empty string is entered (i.e. if you just
9538 press RET at the prompt), the link defaults to the most recently
9539 stored link. As SPC triggers completion in the minibuffer, you need to
9540 use M-SPC or C-q SPC to force the insertion of a space character.
9542 You will also be prompted for a description, and if one is given, it will
9543 be displayed in the buffer instead of the link.
9545 If there is already a link at point, this command will allow you to edit link
9546 and description parts.
9549 selected using completion. The path to the file will be relative to
9550 the current directory if the file is in the current directory or a
9551 subdirectory. Otherwise, the link will be the absolute path as
9552 completed in the minibuffer (i.e. normally ~/path/to/file).
9555 is in the current directory or below.
9557 `org-keep-stored-link-after-insertion'."
9558 (interactive "P")
9559 (let ((region (if (org-region-active-p)
9560 (prog1 (buffer-substring (region-beginning) (region-end))
9561 (delete-region (region-beginning) (region-end)))))
9562 tmphist ; byte-compile incorrectly complains about this
9563 link desc entry remove file)
9564 (cond
9565 ((org-in-regexp org-bracket-link-regexp 1)
9566 ;; We do have a link at point, and we are going to edit it.
9567 (setq remove (list (match-beginning 0) (match-end 0)))
9568 (setq desc (if (match-end 3) (org-match-string-no-properties 3)))
9569 (setq link (read-string "Link: "
9570 (org-link-unescape
9571 (org-match-string-no-properties 1)))))
9572 ((or (org-in-regexp org-angle-link-re)
9573 (org-in-regexp org-plain-link-re))
9574 ;; Convert to bracket link
9575 (setq remove (list (match-beginning 0) (match-end 0))
9576 link (read-string "Link: "
9577 (org-remove-angle-brackets (match-string 0)))))
9578 ((equal complete-file '(4))
9579 ;; Completing read for file names.
9580 (setq file (read-file-name "File: "))
9581 (let ((pwd (file-name-as-directory (expand-file-name ".")))
9582 (pwd1 (file-name-as-directory (abbreviate-file-name
9583 (expand-file-name ".")))))
9584 (cond
9585 ((equal complete-file '(16))
9586 (setq link (org-make-link
9587 "file:"
9588 (abbreviate-file-name (expand-file-name file)))))
9590 (setq link (org-make-link "file:" (match-string 1 file))))
9592 (expand-file-name file))
9593 (setq link (org-make-link
9594 "file:" (match-string 1 (expand-file-name file)))))
9595 (t (setq link (org-make-link "file:" file))))))
9596 (t
9597 ;; Read link, with completion for stored links.
9598 ;; Fake a link history
9599 (setq tmphist (append (mapcar 'car org-stored-links)
9600 org-insert-link-history))
9601 (setq link (org-completing-read
9602 "Link: " org-stored-links nil nil nil
9603 'tmphist
9604 (or (car (car org-stored-links)))))
9605 (setq entry (assoc link org-stored-links))
9606 (or entry (push link org-insert-link-history))
9607 (if (funcall (if (equal complete-file '(64)) 'not 'identity)
9608 (not org-keep-stored-link-after-insertion))
9609 (setq org-stored-links (delq (assoc link org-stored-links)
9610 org-stored-links)))
9611 (setq link (if entry (nth 1 entry) link)
9612 desc (or region desc (nth 2 entry)))))
9614 (if (string-match org-plain-link-re link)
9615 ;; URL-like link, normalize the use of angular brackets.
9616 (setq link (org-make-link (org-remove-angle-brackets link))))
9618 ;; Check if we are linking to the current file with a search option
9619 ;; If yes, simplify the link by using only the search option.
9620 (when (and buffer-file-name
9622 (let* ((path (match-string 1 link))
9623 (case-fold-search nil)
9624 (search (match-string 2 link)))
9625 (save-match-data
9626 (if (equal (file-truename buffer-file-name) (file-truename path))
9627 ;; We are linking to this same file, with a search option
9628 (setq link search)))))
9630 ;; Check if we can/should use a relative path. If yes, simplify the link
9632 (let* ((path (match-string 1 link))
9633 (case-fold-search nil))
9634 (cond
9635 ((eq org-link-file-path-type 'absolute)
9636 (setq path (abbreviate-file-name (expand-file-name path))))
9637 ((eq org-link-file-path-type 'noabbrev)
9638 (setq path (expand-file-name path)))
9639 ((eq org-link-file-path-type 'relative)
9640 (setq path (file-relative-name path)))
9641 (t
9642 (save-match-data
9643 (if (string-match (concat "^" (regexp-quote
9644 (file-name-as-directory
9645 (expand-file-name "."))))
9646 (expand-file-name path))
9647 ;; We are linking a file with relative path name.
9648 (setq path (substring (expand-file-name path)
9649 (match-end 0)))))))
9650 (setq link (concat "file:" path))))
9652 (setq desc (read-string "Description: " desc))
9654 (if remove (apply 'delete-region remove))
9655 (insert (org-make-link-string link desc))))
9657 (defun org-completing-read (&rest args)
9658 (let ((minibuffer-local-completion-map
9659 (copy-keymap minibuffer-local-completion-map)))
9660 (define-key minibuffer-local-completion-map " " 'self-insert-command)
9661 (apply 'completing-read args)))
9663 ;;; Opening/following a link
9664 (defvar org-link-search-failed nil)
9666 (defun org-next-link ()
9667 "Move forward to the next link.
9668 If the link is in hidden text, expose it."
9669 (interactive)
9670 (when (and org-link-search-failed (eq this-command last-command))
9671 (goto-char (point-min))
9672 (message "Link search wrapped back to beginning of buffer"))
9673 (setq org-link-search-failed nil)
9674 (let* ((pos (point))
9675 (ct (org-context))
9676 (a (assoc :link ct)))
9677 (if a (goto-char (nth 2 a)))
9678 (if (re-search-forward org-any-link-re nil t)
9679 (progn
9680 (goto-char (match-beginning 0))
9681 (if (org-invisible-p) (org-show-context)))
9682 (goto-char pos)
9683 (setq org-link-search-failed t)
9684 (error "No further link found"))))
9686 (defun org-previous-link ()
9687 "Move backward to the previous link.
9688 If the link is in hidden text, expose it."
9689 (interactive)
9690 (when (and org-link-search-failed (eq this-command last-command))
9691 (goto-char (point-max))
9692 (message "Link search wrapped back to end of buffer"))
9693 (setq org-link-search-failed nil)
9694 (let* ((pos (point))
9695 (ct (org-context))
9696 (a (assoc :link ct)))
9697 (if a (goto-char (nth 1 a)))
9698 (if (re-search-backward org-any-link-re nil t)
9699 (progn
9700 (goto-char (match-beginning 0))
9701 (if (org-invisible-p) (org-show-context)))
9702 (goto-char pos)
9703 (setq org-link-search-failed t)
9704 (error "No further link found"))))
9706 (defun org-find-file-at-mouse (ev)
9707 "Open file link or URL at mouse."
9708 (interactive "e")
9709 (mouse-set-point ev)
9710 (org-open-at-point 'in-emacs))
9712 (defun org-open-at-mouse (ev)
9713 "Open file link or URL at mouse."
9714 (interactive "e")
9715 (mouse-set-point ev)
9716 (org-open-at-point))
9718 (defvar org-window-config-before-follow-link nil
9719 "The window configuration before following a link.
9720 This is saved in case the need arises to restore it.")
9722 (defvar org-open-link-marker (make-marker)
9723 "Marker pointing to the location where `org-open-at-point; was called.")
9725 (defun org-open-at-point (&optional in-emacs)
9726 "Open link at or after point.
9727 If there is no link at point, this function will search forward up to
9728 the end of the current subtree.
9729 Normally, files will be opened by an appropriate application. If the
9730 optional argument IN-EMACS is non-nil, Emacs will visit the file."
9731 (interactive "P")
9732 (move-marker org-open-link-marker (point))
9733 (setq org-window-config-before-follow-link (current-window-configuration))
9734 (org-remove-occur-highlights nil nil t)
9735 (if (org-at-timestamp-p t)
9736 (org-follow-timestamp-link)
9737 (let (type path link line search (pos (point)))
9738 (catch 'match
9739 (save-excursion
9741 (when (org-in-regexp org-bracket-link-regexp)
9742 (setq link (org-link-unescape (org-match-string-no-properties 1)))
9744 (setq link (replace-match " " t t link)))
9745 (setq link (org-link-expand-abbrev link))
9746 (if (string-match org-link-re-with-space2 link)
9747 (setq type (match-string 1 link) path (match-string 2 link))
9748 (setq type "thisfile" path link))
9749 (throw 'match t)))
9751 (when (get-text-property (point) 'org-linked-text)
9752 (setq type "thisfile"
9753 pos (if (get-text-property (1+ (point)) 'org-linked-text)
9754 (1+ (point)) (point))
9755 path (buffer-substring
9756 (previous-single-property-change pos 'org-linked-text)
9757 (next-single-property-change pos 'org-linked-text)))
9758 (throw 'match t))
9760 (save-excursion
9761 (when (or (org-in-regexp org-angle-link-re)
9762 (org-in-regexp org-plain-link-re))
9763 (setq type (match-string 1) path (match-string 2))
9764 (throw 'match t)))
9765 (save-excursion
9767 (setq type "tags"
9768 path (match-string 1))
9769 (while (string-match ":" path)
9770 (setq path (replace-match "+" t t path)))
9771 (throw 'match t))))
9772 (unless path
9773 (error "No link found"))
9774 ;; Remove any trailing spaces in path
9776 (setq path (replace-match "" t t path)))
9778 (cond
9780 ((equal type "mailto")
9781 (let ((cmd (car org-link-mailto-program))
9782 (args (cdr org-link-mailto-program)) args1
9783 (address path) (subject "") a)
9785 (setq address (match-string 1 path)
9786 subject (org-link-escape (match-string 2 path))))
9787 (while args
9788 (cond
9789 ((not (stringp (car args))) (push (pop args) args1))
9790 (t (setq a (pop args))
9791 (if (string-match "%a" a)
9792 (setq a (replace-match address t t a)))
9793 (if (string-match "%s" a)
9794 (setq a (replace-match subject t t a)))
9795 (push a args1))))
9796 (apply cmd (nreverse args1))))
9798 ((member type '("http" "https" "ftp" "news"))
9799 (browse-url (concat type ":" path)))
9801 ((string= type "tags")
9802 (org-tags-view in-emacs path))
9803 ((string= type "thisfile")
9804 (if in-emacs
9805 (switch-to-buffer-other-window
9806 (org-get-buffer-for-internal-link (current-buffer)))
9807 (org-mark-ring-push))
9808 (org-link-search
9809 path
9810 (cond ((equal in-emacs '(4)) 'occur)
9811 ((equal in-emacs '(16)) 'org-occur)
9812 (t nil))
9813 pos))
9815 ((string= type "file")
9817 (setq line (string-to-number (match-string 1 path))
9818 path (substring path 0 (match-beginning 0)))
9820 (setq search (match-string 1 path)
9821 path (substring path 0 (match-beginning 0)))))
9822 (org-open-file path in-emacs line search))
9824 ((string= type "news")
9825 (org-follow-gnus-link path))
9827 ((string= type "bbdb")
9828 (org-follow-bbdb-link path))
9830 ((string= type "info")
9831 (org-follow-info-link path))
9833 ((string= type "gnus")
9834 (let (group article)
9836 (error "Error in Gnus link"))
9837 (setq group (match-string 1 path)
9838 article (match-string 3 path))
9839 (org-follow-gnus-link group article)))
9841 ((string= type "vm")
9842 (let (folder article)
9844 (error "Error in VM link"))
9845 (setq folder (match-string 1 path)
9846 article (match-string 3 path))
9847 ;; in-emacs is the prefix arg, will be interpreted as read-only
9848 (org-follow-vm-link folder article in-emacs)))
9850 ((string= type "wl")
9851 (let (folder article)
9853 (error "Error in Wanderlust link"))
9854 (setq folder (match-string 1 path)
9855 article (match-string 3 path))
9856 (org-follow-wl-link folder article)))
9858 ((string= type "mhe")
9859 (let (folder article)
9861 (error "Error in MHE link"))
9862 (setq folder (match-string 1 path)
9863 article (match-string 3 path))
9864 (org-follow-mhe-link folder article)))
9866 ((string= type "rmail")
9867 (let (folder article)
9869 (error "Error in RMAIL link"))
9870 (setq folder (match-string 1 path)
9871 article (match-string 3 path))
9872 (org-follow-rmail-link folder article)))
9874 ((string= type "shell")
9875 (let ((cmd path))
9876 ;; FIXME: the following is only for backward compatibility
9877 (while (string-match "@{" cmd) (setq cmd (replace-match "<" t t cmd)))
9878 (while (string-match "@}" cmd) (setq cmd (replace-match ">" t t cmd)))
9879 (if (or (not org-confirm-shell-link-function)
9880 (funcall org-confirm-shell-link-function
9882 (org-add-props cmd nil
9883 'face 'org-warning))))
9884 (progn
9885 (message "Executing %s" cmd)
9886 (shell-command cmd))
9887 (error "Abort"))))
9889 ((string= type "elisp")
9890 (let ((cmd path))
9891 (if (or (not org-confirm-elisp-link-function)
9892 (funcall org-confirm-elisp-link-function
9894 (org-add-props cmd nil
9895 'face 'org-warning))))
9896 (message "%s => %s" cmd (eval (read cmd)))
9897 (error "Abort"))))
9899 (t
9900 (browse-url-at-point)))))
9901 (move-marker org-open-link-marker nil))
9904 ;;; File search
9906 (defvar org-create-file-search-functions nil
9907 "List of functions to construct the right search string for a file link.
9908 These functions are called in turn with point at the location to
9909 which the link should point.
9911 A function in the hook should first test if it would like to
9912 handle this file type, for example by checking the major-mode or
9913 the file extension. If it decides not to handle this file, it
9914 should just return nil to give other functions a chance. If it
9915 does handle the file, it must return the search string to be used
9916 when following the link. The search string will be part of the
9917 file link, given after a double colon, and `org-open-at-point'
9918 will automatically search for it. If special measures must be
9919 taken to make the search successful, another function should be
9920 added to the companion hook `org-execute-file-search-functions',
9921 which see.
9923 A function in this hook may also use `setq' to set the variable
9924 `description' to provide a suggestion for the descriptive text to
9925 be used for this link when it gets inserted into an Org-mode
9928 (defvar org-execute-file-search-functions nil
9929 "List of functions to execute a file search triggered by a link.
9931 Functions added to this hook must accept a single argument, the
9932 search string that was part of the file link, the part after the
9933 double colon. The function must first check if it would like to
9934 handle this search, for example by checking the major-mode or the
9935 file extension. If it decides not to handle this search, it
9936 should just return nil to give other functions a chance. If it
9937 does handle the search, it must return a non-nil value to keep
9938 other functions from trying.
9940 Each function can access the current prefix argument through the
9941 variable `current-prefix-argument'. Note that a single prefix is
9942 used to force opening a link in Emacs, so it may be good to only
9943 use a numeric or double prefix to guide the search function.
9945 In case this is needed, a function in this hook can also restore
9946 the window configuration before `org-open-at-point' was called using:
9948 (set-window-configuration org-window-config-before-follow-link)")
9950 (defun org-link-search (s &optional type avoid-pos)
9951 "Search for a link search option.
9952 If S is surrounded by forward slashes, it is interpreted as a
9953 regular expression. In org-mode files, this will create an `org-occur'
9954 sparse tree. In ordinary files, `occur' will be used to list matches.
9955 If the current buffer is in `dired-mode', grep will be used to search
9956 in all files. If AVOID-POS is given, ignore matches near that position."
9957 (let ((case-fold-search t)
9959 (pos (point))
9960 (pre "") (post "")
9961 words re0 re1 re2 re3 re4 re5 re2a reall)
9962 (cond
9963 ;; First check if there are any special
9964 ((run-hook-with-args-until-success 'org-execute-file-search-functions s))
9965 ;; Now try the builtin stuff
9966 ((save-excursion
9967 (goto-char (point-min))
9968 (and
9969 (re-search-forward
9970 (concat "<<" (regexp-quote s0) ">>") nil t)
9971 (setq pos (match-beginning 0))))
9972 ;; There is an exact target for this
9973 (goto-char pos))
9975 ;; A regular expression
9976 (cond
9977 ((org-mode-p)
9978 (org-occur (match-string 1 s)))
9979 ;;((eq major-mode 'dired-mode)
9980 ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *")))
9981 (t (org-do-occur (match-string 1 s)))))
9982 (t
9983 ;; A normal search string
9984 (when (equal (string-to-char s) ?*)
9985 ;; Anchor on headlines, post may include tags.
9988 s (substring s 1)))
9989 (remove-text-properties
9990 0 (length s)
9991 '(face nil mouse-face nil keymap nil fontified nil) s)
9992 ;; Make a series of regular expressions to find a match
9998 re1 (concat pre re2 post)
9999 re3 (concat pre re4 post)
10000 re5 (concat pre ".*" re4)
10001 re2 (concat pre re2)
10002 re2a (concat pre re2a)
10003 re4 (concat pre re4)
10007 ))
10008 (cond
10009 ((eq type 'org-occur) (org-occur reall))
10010 ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup))
10011 (t (goto-char (point-min))
10012 (if (or (org-search-not-self 1 re0 nil t)
10013 (org-search-not-self 1 re1 nil t)
10014 (org-search-not-self 1 re2 nil t)
10015 (org-search-not-self 1 re2a nil t)
10016 (org-search-not-self 1 re3 nil t)
10017 (org-search-not-self 1 re4 nil t)
10018 (org-search-not-self 1 re5 nil t)
10019 )
10020 (goto-char (match-beginning 1))
10021 (goto-char pos)
10022 (error "No match")))))
10023 (t
10024 ;; Normal string-search
10025 (goto-char (point-min))
10026 (if (search-forward s nil t)
10027 (goto-char (match-beginning 0))
10028 (error "No match"))))
10029 (and (org-mode-p) (org-show-context 'link-search))))
10031 (defun org-search-not-self (group &rest args)
10032 "Execute `re-search-forward', but only accept matches that do not
10033 enclose the position of `org-open-link-marker'."
10034 (let ((m org-open-link-marker))
10035 (catch 'exit
10036 (while (apply 're-search-forward args)
10037 (goto-char (match-end group))
10038 (if (and (or (not (eq (marker-buffer m) (current-buffer)))
10039 (> (match-beginning 0) (marker-position m))
10040 (< (match-end 0) (marker-position m)))
10041 (save-match-data
10042 (or (not (org-in-regexp org-bracket-link-analytic-regexp 1))
10043 (not (match-end 4)) ; no description
10044 (and (<= (match-beginning 4) (point))
10045 (>= (match-end 4) (point))))))
10046 (throw 'exit (point)))))))
10048 (defun org-get-buffer-for-internal-link (buffer)
10049 "Return a buffer to be used for displaying the link target of internal links."
10050 (cond
10051 ((not org-display-internal-link-with-indirect-buffer)
10052 buffer)
10053 ((string-match "(Clone)$" (buffer-name buffer))
10054 (message "Buffer is already a clone, not making another one")
10055 ;; we also do not modify visibility in this case
10056 buffer)
10057 (t ; make a new indirect buffer for displaying the link
10058 (let* ((bn (buffer-name buffer))
10059 (ibn (concat bn "(Clone)"))
10060 (ib (or (get-buffer ibn) (make-indirect-buffer buffer ibn 'clone))))
10061 (with-current-buffer ib (org-overview))
10062 ib))))
10064 (defun org-do-occur (regexp &optional cleanup)
10065 "Call the Emacs command `occur'.
10066 If CLEANUP is non-nil, remove the printout of the regular expression
10067 in the *Occur* buffer. This is useful if the regex is long and not useful
10068 to read."
10069 (occur regexp)
10070 (when cleanup
10071 (let ((cwin (selected-window)) win beg end)
10072 (when (setq win (get-buffer-window "*Occur*"))
10073 (select-window win))
10074 (goto-char (point-min))
10075 (when (re-search-forward "match[a-z]+" nil t)
10076 (setq beg (match-end 0))
10078 (setq end (1- (match-beginning 0)))))
10079 (and beg end (let ((buffer-read-only)) (delete-region beg end)))
10080 (goto-char (point-min))
10081 (select-window cwin))))
10083 ;;; The mark ring for links jumps
10085 (defvar org-mark-ring nil
10086 "Mark ring for positions before jumps in Org-mode.")
10087 (defvar org-mark-ring-last-goto nil
10088 "Last position in the mark ring used to go back.")
10089 ;; Fill and close the ring
10090 (setq org-mark-ring nil org-mark-ring-last-goto nil) ;; in case file is reloaded
10091 (loop for i from 1 to org-mark-ring-length do
10092 (push (make-marker) org-mark-ring))
10093 (setcdr (nthcdr (1- org-mark-ring-length) org-mark-ring)
10094 org-mark-ring)
10096 (defun org-mark-ring-push (&optional pos buffer)
10097 "Put the current position or POS into the mark ring and rotate it."
10098 (interactive)
10099 (setq pos (or pos (point)))
10100 (setq org-mark-ring (nthcdr (1- org-mark-ring-length) org-mark-ring))
10101 (move-marker (car org-mark-ring)
10102 (or pos (point))
10103 (or buffer (current-buffer)))
10104 (message
10105 (substitute-command-keys
10108 (defun org-mark-ring-goto (&optional n)
10109 "Jump to the previous position in the mark ring.
10110 With prefix arg N, jump back that many stored positions. When
10111 called several times in succession, walk through the entire ring.
10112 Org-mode commands jumping to a different position in the current file,
10113 or to another Org-mode file, automatically push the old position
10114 onto the ring."
10115 (interactive "p")
10116 (let (p m)
10117 (if (eq last-command this-command)
10118 (setq p (nthcdr n (or org-mark-ring-last-goto org-mark-ring)))
10119 (setq p org-mark-ring))
10120 (setq org-mark-ring-last-goto p)
10121 (setq m (car p))
10122 (switch-to-buffer (marker-buffer m))
10123 (goto-char m)
10124 (if (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto))))
10126 (defun org-remove-angle-brackets (s)
10127 (if (equal (substring s 0 1) "<") (setq s (substring s 1)))
10128 (if (equal (substring s -1) ">") (setq s (substring s 0 -1)))
10129 s)
10130 (defun org-add-angle-brackets (s)
10131 (if (equal (substring s 0 1) "<") nil (setq s (concat "<" s)))
10132 (if (equal (substring s -1) ">") nil (setq s (concat s ">")))
10133 s)
10135 ;;; Following specific links
10137 (defun org-follow-timestamp-link ()
10138 (cond
10139 ((org-at-date-range-p t)
10140 (let ((org-agenda-start-on-weekday)
10141 (t1 (match-string 1))
10142 (t2 (match-string 2)))
10143 (setq t1 (time-to-days (org-time-string-to-time t1))
10144 t2 (time-to-days (org-time-string-to-time t2)))
10145 (org-agenda-list nil t1 (1+ (- t2 t1)))))
10146 ((org-at-timestamp-p t)
10147 (org-agenda-list nil (time-to-days (org-time-string-to-time
10148 (substring (match-string 1) 0 10)))
10149 1))
10150 (t (error "This should not happen"))))
10153 (defun org-follow-bbdb-link (name)
10154 "Follow a BBDB link to NAME."
10155 (require 'bbdb)
10156 (let ((inhibit-redisplay (not debug-on-error))
10157 (bbdb-electric-p nil))
10158 (catch 'exit
10159 ;; Exact match on name
10161 (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
10162 ;; Exact match on name
10164 (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
10165 ;; Partial match on name
10166 (bbdb-name name nil)
10167 (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
10168 ;; Partial match on company
10169 (bbdb-company name nil)
10170 (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
10171 ;; General match including network address and notes
10172 (bbdb name nil)
10173 (when (= 0 (buffer-size (get-buffer "*BBDB*")))
10174 (delete-window (get-buffer-window "*BBDB*"))
10175 (error "No matching BBDB record")))))
10177 (defun org-follow-info-link (name)
10178 "Follow an info file & node link to NAME."
10181 (progn
10182 (require 'info)
10183 (if (match-string 2 name) ; If there isn't a node, choose "Top"
10184 (Info-find-node (match-string 1 name) (match-string 2 name))
10185 (Info-find-node (match-string 1 name) "Top")))
10186 (message (concat "Could not open: " name))))
10188 (defun org-follow-gnus-link (&optional group article)
10189 "Follow a Gnus link to GROUP and ARTICLE."
10190 (require 'gnus)
10191 (funcall (cdr (assq 'gnus org-link-frame-setup)))
10192 (if gnus-other-frame-object (select-frame gnus-other-frame-object))
10193 (cond ((and group article)
10194 (gnus-group-read-group 0 nil group)
10195 (gnus-summary-goto-article (string-to-number article) nil t))
10196 (group (gnus-group-jump-to-group group))))
10198 (defun org-follow-vm-link (&optional folder article readonly)
10199 "Follow a VM link to FOLDER and ARTICLE."
10200 (require 'vm)
10201 (setq article (org-add-angle-brackets article))
10203 ;; ange-ftp or efs or tramp access
10204 (let ((user (or (match-string 1 folder) (user-login-name)))
10205 (host (match-string 2 folder))
10206 (file (match-string 3 folder)))
10207 (cond
10208 ((featurep 'tramp)
10209 ;; use tramp to access the file
10210 (if (featurep 'xemacs)
10211 (setq folder (format "[%s@%s]%s" user host file))
10212 (setq folder (format "/%s@%s:%s" user host file))))
10213 (t
10214 ;; use ange-ftp or efs
10215 (require (if (featurep 'xemacs) 'efs 'ange-ftp))
10216 (setq folder (format "/%s@%s:%s" user host file))))))
10217 (when folder
10218 (funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly)
10219 (sit-for 0.1)
10220 (when article
10221 (vm-select-folder-buffer)
10222 (widen)
10223 (let ((case-fold-search t))
10224 (goto-char (point-min))
10225 (if (not (re-search-forward
10226 (concat "^" "message-id: *" (regexp-quote article))))
10227 (error "Could not find the specified message in this folder"))
10228 (vm-isearch-update)
10229 (vm-isearch-narrow)
10230 (vm-beginning-of-message)
10231 (vm-summarize)))))
10233 (defun org-follow-wl-link (folder article)
10234 "Follow a Wanderlust link to FOLDER and ARTICLE."
10235 (if (and (string= folder "%")
10236 article
10238 ;; XXX: imap-uw supports folders starting with '#' such as "#mh/inbox".
10239 ;; Thus, we recompose folder and article ids.
10240 (setq folder (format "%s#%s" folder (match-string 1 article))
10241 article (match-string 3 article)))
10242 (if (not (elmo-folder-exists-p (wl-folder-get-elmo-folder folder)))
10243 (error "No such folder: %s" folder))
10244 (wl-summary-goto-folder-subr folder 'no-sync t nil t nil nil)
10245 (and article
10246 (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets article))
10247 (wl-summary-redisplay)))
10249 (defun org-follow-rmail-link (folder article)
10250 "Follow an RMAIL link to FOLDER and ARTICLE."
10251 (setq article (org-add-angle-brackets article))
10252 (let (message-number)
10253 (save-excursion
10254 (save-window-excursion
10255 (rmail (if (string= folder "RMAIL") rmail-file-name folder))
10256 (setq message-number
10257 (save-restriction
10258 (widen)
10259 (goto-char (point-max))
10260 (if (re-search-backward
10262 (or article "")))
10263 nil t)
10264 (rmail-what-message))))))
10265 (if message-number
10266 (progn
10267 (rmail (if (string= folder "RMAIL") rmail-file-name folder))
10268 (rmail-show-message message-number)
10269 message-number)
10270 (error "Message not found"))))
10272 ;;; mh-e integration based on planner-mode
10273 (defun org-mhe-get-message-real-folder ()
10274 "Return the name of the current message real folder, so if you use
10275 sequences, it will now work."
10276 (save-excursion
10277 (let* ((folder
10278 (if (equal major-mode 'mh-folder-mode)
10279 mh-current-folder
10280 ;; Refer to the show buffer
10281 mh-show-folder-buffer))
10282 (end-index
10283 (if (boundp 'mh-index-folder)
10284 (min (length mh-index-folder) (length folder))))
10285 )
10286 ;; a simple test on mh-index-data does not work, because
10287 ;; mh-index-data is always nil in a show buffer.
10288 (if (and (boundp 'mh-index-folder)
10289 (string= mh-index-folder (substring folder 0 end-index)))
10290 (if (equal major-mode 'mh-show-mode)
10291 (save-window-excursion
10292 (when (buffer-live-p (get-buffer folder))
10293 (progn
10294 (pop-to-buffer folder)
10295 (org-mhe-get-message-folder-from-index)
10296 )
10297 ))
10298 (org-mhe-get-message-folder-from-index)
10299 )
10300 folder
10301 )
10302 )))
10304 (defun org-mhe-get-message-folder-from-index ()
10305 "Returns the name of the message folder in a index folder buffer."
10306 (save-excursion
10307 (mh-index-previous-folder)
10309 (message (match-string 1))))
10311 (defun org-mhe-get-message-folder ()
10312 "Return the name of the current message folder. Be careful if you
10313 use sequences."
10314 (save-excursion
10315 (if (equal major-mode 'mh-folder-mode)
10316 mh-current-folder
10317 ;; Refer to the show buffer
10318 mh-show-folder-buffer)))
10320 (defun org-mhe-get-message-num ()
10321 "Return the number of the current message. Be careful if you
10322 use sequences."
10323 (save-excursion
10324 (if (equal major-mode 'mh-folder-mode)
10325 (mh-get-msg-num nil)
10326 ;; Refer to the show buffer
10327 (mh-show-buffer-message-number))))
10329 (defun org-mhe-get-header (header)
10330 "Return a header of the message in folder mode. This will create a
10331 show buffer for the corresponding message. If you have a more clever
10332 idea..."
10333 (let* ((folder (org-mhe-get-message-folder))
10334 (num (org-mhe-get-message-num))
10335 (buffer (get-buffer-create (concat "show-" folder)))
10336 (header-field))
10337 (with-current-buffer buffer
10338 (mh-display-msg num folder)
10339 (if (equal major-mode 'mh-folder-mode)
10340 (mh-header-display)
10341 (mh-show-header-display))
10342 (set-buffer buffer)
10343 (setq header-field (mh-get-header-field header))
10344 (if (equal major-mode 'mh-folder-mode)
10345 (mh-show)
10346 (mh-show-show))
10347 header-field)))
10349 (defun org-follow-mhe-link (folder article)
10350 "Follow an MHE link to FOLDER and ARTICLE.
10351 If ARTICLE is nil FOLDER is shown. If the configuration variable
10352 `org-mhe-search-all-folders' is t and `mh-searcher' is pick,
10353 ARTICLE is searched in all folders. Indexed searches (swish++,
10354 namazu, and others supported by MH-E) will always search in all
10355 folders."
10356 (require 'mh-e)
10357 (require 'mh-search)
10358 (require 'mh-utils)
10359 (mh-find-path)
10360 (if (not article)
10361 (mh-visit-folder (mh-normalize-folder-name folder))
10362 (setq article (org-add-angle-brackets article))
10363 (mh-search-choose)
10364 (if (equal mh-searcher 'pick)
10365 (progn
10366 (mh-search folder (list "--message-id" article))
10367 (when (and org-mhe-search-all-folders
10368 (not (org-mhe-get-message-real-folder)))
10369 (kill-this-buffer)
10370 (mh-search "+" (list "--message-id" article))))
10371 (mh-search "+" article))
10372 (if (org-mhe-get-message-real-folder)
10373 (mh-show-msg 1)
10374 (kill-this-buffer)
10375 (error "Message not found"))))
10377 ;;; BibTeX links
10379 ;; Use the custom search meachnism to construct and use search strings for
10380 ;; file links to BibTeX database entries.
10382 (defun org-create-file-search-in-bibtex ()
10383 "Create the search string and description for a BibTeX database entry."
10384 (when (eq major-mode 'bibtex-mode)
10385 ;; yes, we want to construct this search string.
10386 ;; Make a good description for this entry, using names, year and the title
10387 ;; Put it into the `description' variable which is dynamically scoped.
10388 (let ((bibtex-autokey-names 1)
10389 (bibtex-autokey-names-stretch 1)
10390 (bibtex-autokey-name-case-convert-function 'identity)
10391 (bibtex-autokey-name-separator " & ")
10392 (bibtex-autokey-additional-names " et al.")
10393 (bibtex-autokey-year-length 4)
10394 (bibtex-autokey-name-year-separator " ")
10395 (bibtex-autokey-titlewords 3)
10396 (bibtex-autokey-titleword-separator " ")
10397 (bibtex-autokey-titleword-case-convert-function 'identity)
10398 (bibtex-autokey-titleword-length 'infty)
10399 (bibtex-autokey-year-title-separator ": "))
10400 (setq description (bibtex-generate-autokey)))
10401 ;; Now parse the entry, get the key and return it.
10402 (save-excursion
10403 (bibtex-beginning-of-entry)
10404 (cdr (assoc "=key=" (bibtex-parse-entry))))))
10406 (defun org-execute-file-search-in-bibtex (s)
10407 "Find the link search string S as a key for a database entry."
10408 (when (eq major-mode 'bibtex-mode)
10409 ;; Yes, we want to do the search in this file.
10410 ;; We construct a regexp that searches for "@entrytype{" followed by the key
10411 (goto-char (point-min))
10414 (goto-char (match-beginning 0)))
10415 (if (and (match-beginning 0) (equal current-prefix-arg '(16)))
10416 ;; Use double prefix to indicate that any web link should be browsed
10417 (let ((b (current-buffer)) (p (point)))
10418 ;; Restore the window configuration because we just use the web link
10419 (set-window-configuration org-window-config-before-follow-link)
10420 (save-excursion (set-buffer b) (goto-char p)
10421 (bibtex-url)))
10422 (recenter 0)) ; Move entry start to beginning of window
10423 ;; return t to indicate that the search is done.
10424 t))
10426 ;; Finally add the functions to the right hooks.
10427 (add-hook 'org-create-file-search-functions 'org-create-file-search-in-bibtex)
10428 (add-hook 'org-execute-file-search-functions 'org-execute-file-search-in-bibtex)
10430 ;; end of Bibtex link setup
10432 ;;; Following file links
10434 (defun org-open-file (path &optional in-emacs line search)
10435 "Open the file at PATH.
10436 First, this expands any special file name abbreviations. Then the
10437 configuration variable `org-file-apps' is checked if it contains an
10438 entry for this file type, and if yes, the corresponding command is launched.
10439 If no application is found, Emacs simply visits the file.
10440 With optional argument IN-EMACS, Emacs will visit the file.
10441 Optional LINE specifies a line to go to, optional SEARCH a string to
10442 search for. If LINE or SEARCH is given, the file will always be
10443 opened in Emacs.
10444 If the file does not exist, an error is thrown."
10445 (setq in-emacs (or in-emacs line search))
10446 (let* ((file (if (equal path "")
10447 buffer-file-name
10448 (substitute-in-file-name (expand-file-name path))))
10449 (apps (append org-file-apps (org-default-apps)))
10450 (remp (and (assq 'remote apps) (org-file-remote-p file)))
10451 (dirp (if remp nil (file-directory-p file)))
10452 (dfile (downcase file))
10453 (old-buffer (current-buffer))
10454 (old-pos (point))
10455 (old-mode major-mode)
10456 ext cmd)
10458 (setq ext (match-string 1 dfile))
10460 (setq ext (match-string 1 dfile))))
10461 (if in-emacs
10462 (setq cmd 'emacs)
10463 (setq cmd (or (and remp (cdr (assoc 'remote apps)))
10464 (and dirp (cdr (assoc 'directory apps)))
10465 (cdr (assoc ext apps))
10466 (cdr (assoc t apps)))))
10467 (when (eq cmd 'mailcap)
10468 (require 'mailcap)
10469 (mailcap-parse-mailcaps)
10470 (let* ((mime-type (mailcap-extension-to-mime (or ext "")))
10471 (command (mailcap-mime-info mime-type)))
10472 (if (stringp command)
10473 (setq cmd command)
10474 (setq cmd 'emacs))))
10475 (if (and (not (eq cmd 'emacs)) ; Emacs has not problems with non-ex files
10476 (not (file-exists-p file))
10477 (not org-open-non-existing-files))
10478 (error "No such file: %s" file))
10479 (cond
10481 ;; Remove quotes around the file name - we'll use shell-quote-argument.
10483 (setq cmd (replace-match "%s" t t cmd)))
10484 (setq cmd (format cmd (shell-quote-argument file)))
10485 (save-window-excursion
10486 (shell-command (concat cmd " &"))))
10487 ((or (stringp cmd)
10488 (eq cmd 'emacs))
10489 (funcall (cdr (assq 'file org-link-frame-setup)) file)
10490 (if line (goto-line line)
10491 (if search (org-link-search search))))
10492 ((consp cmd)
10493 (eval cmd))
10494 (t (funcall (cdr (assq 'file org-link-frame-setup)) file)))
10495 (and (org-mode-p) (eq old-mode 'org-mode)
10496 (or (not (equal old-buffer (current-buffer)))
10497 (not (equal old-pos (point))))
10498 (org-mark-ring-push old-pos old-buffer))))
10500 (defun org-default-apps ()
10501 "Return the default applications for this operating system."
10502 (cond
10503 ((eq system-type 'darwin)
10504 org-file-apps-defaults-macosx)
10505 ((eq system-type 'windows-nt)
10506 org-file-apps-defaults-windowsnt)
10507 (t org-file-apps-defaults-gnu)))
10509 (defun org-expand-file-name (path)
10510 "Replace special path abbreviations and expand the file name."
10511 (expand-file-name path))
10513 (defvar ange-ftp-name-format) ; to silence the XEmacs compiler.
10514 (defun org-file-remote-p (file)
10515 "Test whether FILE specifies a location on a remote system.
10516 Return non-nil if the location is indeed remote.
10520 (cond ((fboundp 'file-remote-p)
10521 (file-remote-p file))
10522 ((fboundp 'tramp-handle-file-remote-p)
10523 (tramp-handle-file-remote-p file))
10524 ((and (boundp 'ange-ftp-name-format)
10525 (string-match (car ange-ftp-name-format) file))
10526 t)
10527 (t nil)))
10530 ;;;; Hooks for remember.el
10532 ;;;###autoload
10533 (defun org-remember-annotation ()
10534 "Return a link to the current location as an annotation for remember.el.
10535 If you are using Org-mode files as target for data storage with
10536 remember.el, then the annotations should include a link compatible with the
10537 conventions in Org-mode. This function returns such a link."
10538 (org-store-link nil))
10540 (defconst org-remember-help
10541 "Select a destination location for the note.
10542 UP/DOWN=headline TAB=cycle visibility [Q]uit RET/<left>/<right>=Store
10543 RET at beg-of-buf -> Append to file as level 2 headline
10544 RET on headline -> Store as sublevel entry to current headline
10545 <left>/<right> -> before/after current headline, same headings level")
10547 ;;;###autoload
10548 (defun org-remember-apply-template (&optional use-char skip-interactive)
10549 "Initialize *remember* buffer with template, invoke `org-mode'.
10550 This function should be placed into `remember-mode-hook' and in fact requires
10551 to be run from that hook to fucntion properly."
10552 (if org-remember-templates
10554 (let* ((char (or use-char
10555 (if (= (length org-remember-templates) 1)
10556 (caar org-remember-templates)
10557 (message "Select template: %s"
10558 (mapconcat
10559 (lambda (x) (char-to-string (car x)))
10560 org-remember-templates " "))
10561 (read-char-exclusive))))
10562 (entry (cdr (assoc char org-remember-templates)))
10563 (tpl (car entry))
10564 (plist-p (if org-store-link-plist t nil))
10565 (file (if (and (nth 1 entry) (stringp (nth 1 entry))
10567 (nth 1 entry)
10568 org-default-notes-file))
10569 (headline (nth 2 entry))
10570 (v-t (format-time-string (car org-time-stamp-formats) (org-current-time)))
10571 (v-T (format-time-string (cdr org-time-stamp-formats) (org-current-time)))
10572 (v-u (concat "[" (substring v-t 1 -1) "]"))
10573 (v-U (concat "[" (substring v-T 1 -1) "]"))
10574 (v-i initial) ; defined in `remember-mode'
10575 (v-a (if (equal annotation "[[]]") "" annotation)) ; likewise
10576 (v-n user-full-name)
10577 (org-startup-folded nil)
10578 org-time-was-given x prompt char time)
10579 (setq org-store-link-plist
10580 (append (list :annotation v-a :initial v-i)))
10581 (unless tpl (setq tpl "") (message "No template") (ding))
10582 (erase-buffer)
10583 (insert (substitute-command-keys
10584 (format
10585 "## `C-c C-c' to file interactively, `C-u C-c C-c' to file directly.
10588 (abbreviate-file-name (or file org-default-notes-file))
10589 (or headline ""))))
10590 (insert tpl) (goto-char (point-min))
10591 ;; Simple %-escapes
10593 (when (and initial (equal (match-string 0) "%i"))
10594 (save-match-data
10595 (let* ((lead (buffer-substring
10596 (point-at-bol) (match-beginning 0))))
10597 (setq v-i (mapconcat 'identity
10600 (replace-match
10601 (or (eval (intern (concat "v-" (match-string 1)))) "")
10602 t t))
10603 ;; From the property list
10604 (when plist-p
10605 (goto-char (point-min))
10607 (and (setq x (plist-get org-store-link-plist
10608 (intern (match-string 1))))
10609 (replace-match x t t))))
10610 ;; Turn on org-mode in the remember buffer, set local variables
10611 (org-mode)
10612 (org-set-local 'org-finish-function 'remember-buffer)
10614 (org-set-local 'org-default-notes-file file))
10616 (org-set-local 'org-remember-default-headline headline))
10617 ;; Interactive template entries
10618 (goto-char (point-min))
10620 (setq char (if (match-end 3) (match-string 3))
10621 prompt (if (match-end 2) (match-string 2)))
10622 (goto-char (match-beginning 0))
10623 (replace-match "")
10624 (if char
10625 (progn
10626 (setq org-time-was-given (equal (upcase char) char))
10627 (setq time (org-read-date (equal (upcase char) "U") t nil
10628 prompt))
10629 (org-insert-time-stamp time org-time-was-given
10630 (member char '("u" "U"))))
10631 (insert (read-string
10632 (if prompt (concat prompt ": ") "Enter string")))))
10633 (goto-char (point-min))
10635 (replace-match "")
10637 (org-mode)
10638 (org-set-local 'org-finish-function 'remember-buffer)))
10640 ;;;###autoload
10641 (defun org-remember ()
10642 "Call `remember'. If this is already a remember buffer, re-apply template.
10643 If there is an active region, make sure remember uses it as initial content
10644 of the remember buffer."
10645 (interactive)
10646 (if (eq org-finish-function 'remember-buffer)
10647 (progn
10648 (when (< (length org-remember-templates) 2)
10649 (error "No other template available"))
10650 (erase-buffer)
10651 (let ((annotation (plist-get org-store-link-plist :annotation))
10652 (initial (plist-get org-store-link-plist :initial)))
10653 (org-remember-apply-template))
10654 (message "Press C-c C-c to remember data"))
10655 (if (org-region-active-p)
10656 (remember (buffer-substring (point) (mark)))
10657 (call-interactively 'remember))))
10659 ;;;###autoload
10660 (defun org-remember-handler ()
10661 "Store stuff from remember.el into an org file.
10662 First prompts for an org file. If the user just presses return, the value
10663 of `org-default-notes-file' is used.
10664 Then the command offers the headings tree of the selected file in order to
10665 file the text at a specific location.
10666 You can either immediately press RET to get the note appended to the
10667 file, or you can use vertical cursor motion and visibility cycling (TAB) to
10668 find a better place. Then press RET or <left> or <right> in insert the note.
10670 Key Cursor position Note gets inserted
10671 -----------------------------------------------------------------------------
10672 RET buffer-start as level 2 heading at end of file
10673 RET on headline as sublevel of the heading at cursor
10674 RET no heading at cursor position, level taken from context.
10675 Or use prefix arg to specify level manually.
10676 <left> on headline as same level, before current heading
10677 <right> on headline as same level, after current heading
10679 So the fastest way to store the note is to press RET RET to append it to
10680 the default file. This way your current train of thought is not
10681 interrupted, in accordance with the principles of remember.el. But with
10682 little extra effort, you can push it directly to the correct location.
10684 Before being stored away, the function ensures that the text has a
10686 is constructed from the current date and some additional data.
10688 If the variable `org-adapt-indentation' is non-nil, the entire text is
10689 also indented so that it starts in the same column as the headline
10690 \(i.e. after the stars).
10692 See also the variable `org-reverse-note-order'."
10693 (goto-char (point-min))
10695 (replace-match ""))
10696 (catch 'quit
10697 (let* ((txt (buffer-substring (point-min) (point-max)))
10698 (fastp current-prefix-arg)
10699 (file (if fastp org-default-notes-file (org-get-org-file)))
10700 (heading org-remember-default-headline)
10701 (visiting (org-find-base-buffer-visiting file))
10702 (org-startup-folded nil)
10703 (org-startup-align-all-tables nil)
10704 (org-goto-start-pos 1)
10705 spos level indent reversed)
10706 ;; Modify text so that it becomes a nice subtree which can be inserted
10707 ;; into an org tree.
10709 first)
10710 (setq first (car lines) lines (cdr lines))
10712 ;; Is already a headline
10713 (setq indent nil)
10714 ;; We need to add a headline: Use time and first buffer line
10715 (setq lines (cons first lines)
10716 first (concat "* " (current-time-string)
10717 " (" (remember-buffer-desc) ")")
10718 indent " "))
10719 (if (and org-adapt-indentation indent)
10720 (setq lines (mapcar (lambda (x) (concat indent x)) lines)))
10723 ;; Find the file
10724 (if (not visiting) (find-file-noselect file))
10725 (with-current-buffer (or visiting (get-file-buffer file))
10726 (save-excursion (and (goto-char (point-min))
10729 (setq reversed (org-notes-order-reversed-p))
10730 (save-excursion
10731 (save-restriction
10732 (widen)
10734 ;; Find the default location
10736 (goto-char (point-min))
10737 (if (re-search-forward
10740 nil t)
10741 (setq org-goto-start-pos (match-beginning 0))))
10743 ;; Ask the User for a location
10744 (setq spos (if fastp
10745 org-goto-start-pos
10746 (org-get-location (current-buffer) org-remember-help)))
10747 (if (not spos) (throw 'quit nil)) ; return nil to show we did
10748 ; not handle this note
10749 (goto-char spos)
10750 (cond ((and (bobp) (not reversed))
10751 ;; Put it at the end, one level below level 1
10752 (save-restriction
10753 (widen)
10754 (goto-char (point-max))
10755 (if (not (bolp)) (newline))
10756 (org-paste-subtree (org-get-legal-level 1 1) txt)))
10757 ((and (bobp) reversed)
10758 ;; Put it at the start, as level 1
10759 (save-restriction
10760 (widen)
10761 (goto-char (point-min))
10763 (beginning-of-line 1)
10764 (org-paste-subtree 1 txt)))
10765 ((and (org-on-heading-p nil) (not current-prefix-arg))
10766 ;; Put it below this entry, at the beg/end of the subtree
10767 (org-back-to-heading t)
10768 (setq level (funcall outline-level))
10769 (if reversed
10770 (outline-end-of-heading)
10771 (org-end-of-subtree t))
10772 (if (not (bolp)) (newline))
10773 (beginning-of-line 1)
10774 (org-paste-subtree (org-get-legal-level level 1) txt))
10775 (t
10776 ;; Put it right there, with automatic level determined by
10777 ;; org-paste-subtree or from prefix arg
10778 (org-paste-subtree current-prefix-arg txt)))
10779 (when remember-save-after-remembering
10780 (save-buffer)
10781 (if (not visiting) (kill-buffer (current-buffer)))))))))
10782 t) ;; return t to indicate that we took care of this note.
10784 (defun org-get-org-file ()
10785 "Read a filename, with default directory `org-directory'."
10786 (let ((default (or org-default-notes-file remember-data-file)))
10787 (read-file-name (format "File name [%s]: " default)
10788 (file-name-as-directory org-directory)
10789 default)))
10791 (defun org-notes-order-reversed-p ()
10792 "Check if the current file should receive notes in reversed order."
10793 (cond
10794 ((not org-reverse-note-order) nil)
10795 ((eq t org-reverse-note-order) t)
10796 ((not (listp org-reverse-note-order)) nil)
10797 (t (catch 'exit
10798 (let ((all org-reverse-note-order)
10799 entry)
10800 (while (setq entry (pop all))
10801 (if (string-match (car entry) buffer-file-name)
10802 (throw 'exit (cdr entry))))
10803 nil)))))
10805 ;;;; Dynamic blocks
10807 (defun org-find-dblock (name)
10808 "Find the first dynamic block with name NAME in the buffer.
10809 If not found, stay at current position and return nil."
10810 (let (pos)
10811 (save-excursion
10812 (goto-char (point-min))
10814 nil t)
10815 (match-beginning 0))))
10816 (if pos (goto-char pos))
10817 pos))
10819 (defconst org-dblock-start-re
10821 "Matches the startline of a dynamic block, with parameters.")
10824 "Matches the end of a dyhamic block.")
10826 (defun org-create-dblock (plist)
10827 "Create a dynamic block section, with parameters taken from PLIST.
10828 PLIST must containe a :name entry which is used as name of the block."
10829 (unless (bolp) (newline))
10830 (let ((name (plist-get plist :name)))
10831 (insert "#+BEGIN: " name)
10832 (while plist
10833 (if (eq (car plist) :name)
10834 (setq plist (cddr plist))
10835 (insert " " (prin1-to-string (pop plist)))))
10837 (beginning-of-line -2)))
10839 (defun org-prepare-dblock ()
10840 "Prepare dynamic block for refresh.
10841 This empties the block, puts the cursor at the insert position and returns
10842 the property list including an extra property :name with the block name."
10843 (unless (looking-at org-dblock-start-re)
10844 (error "Not at a dynamic block"))
10845 (let* ((begdel (1+ (match-end 0)))
10846 (name (match-string 1))
10847 (params (append (list :name name)
10848 (read (concat "(" (match-string 3) ")")))))
10849 (unless (re-search-forward org-dblock-end-re nil t)
10850 (error "Dynamic block not terminated"))
10851 (delete-region begdel (match-beginning 0))
10852 (goto-char begdel)
10853 (open-line 1)
10854 params))
10856 (defun org-map-dblocks (&optional command)
10857 "Apply COMMAND to all dynamic blocks in the current buffer.
10858 If COMMAND is not given, use `org-update-dblock'."
10859 (let ((cmd (or command 'org-update-dblock))
10860 pos)
10861 (save-excursion
10862 (goto-char (point-min))
10863 (while (re-search-forward org-dblock-start-re nil t)
10864 (goto-char (setq pos (match-beginning 0)))
10865 (condition-case nil
10866 (funcall cmd)
10867 (error (message "Error during update of dynamic block")))
10868 (goto-char pos)
10869 (unless (re-search-forward org-dblock-end-re nil t)
10870 (error "Dynamic block not terminated"))))))
10872 (defun org-dblock-update (&optional arg)
10873 "User command for updating dynamic blocks.
10874 Update the dynamic block at point. With prefix ARG, update all dynamic
10875 blocks in the buffer."
10876 (interactive "P")
10877 (if arg
10878 (org-update-all-dblocks)
10879 (or (looking-at org-dblock-start-re)
10880 (org-beginning-of-dblock))
10881 (org-update-dblock)))
10883 (defun org-update-dblock ()
10884 "Update the dynamic block at point
10885 This means to empty the block, parse for parameters and then call
10886 the correct writing function."
10887 (let* ((pos (point))
10888 (params (org-prepare-dblock))
10889 (name (plist-get params :name))
10890 (cmd (intern (concat "org-dblock-write:" name))))
10891 (funcall cmd params)
10892 (goto-char pos)))
10894 (defun org-beginning-of-dblock ()
10895 "Find the beginning of the dynamic block at point.
10896 Error if there is no scuh block at point."
10897 (let ((pos (point))
10898 beg)
10899 (end-of-line 1)
10900 (if (and (re-search-backward org-dblock-start-re nil t)
10901 (setq beg (match-beginning 0))
10902 (re-search-forward org-dblock-end-re nil t)
10903 (> (match-end 0) pos))
10904 (goto-char beg)
10905 (goto-char pos)
10906 (error "Not in a dynamic block"))))
10908 (defun org-update-all-dblocks ()
10909 "Update all dynamic blocks in the buffer.
10910 This function can be used in a hook."
10911 (when (org-mode-p)
10912 (org-map-dblocks 'org-update-dblock)))
10915 ;;;; Completion
10917 (defun org-complete (&optional arg)
10918 "Perform completion on word at point.
10919 At the beginning of a headline, this completes TODO keywords as given in
10920 `org-todo-keywords'.
10921 If the current word is preceded by a backslash, completes the TeX symbols
10922 that are supported for HTML support.
10924 setting file options.
10926 At all other locations, this simply calls `ispell-complete-word'."
10927 (interactive "P")
10928 (catch 'exit
10929 (let* ((end (point))
10930 (beg1 (save-excursion
10931 (skip-chars-backward "a-zA-Z_@0-9")
10932 (point)))
10933 (beg (save-excursion
10934 (skip-chars-backward "a-zA-Z0-9_:$")
10935 (point)))
10936 (confirm (lambda (x) (stringp (car x))))
10937 (searchhead (equal (char-before beg) ?*))
10938 (tag (equal (char-before beg1) ?:))
10940 (link (equal (char-before beg) ?\[))
10941 (opt (equal (buffer-substring (max (point-at-bol) (- beg 2))
10942 beg)
10943 "#+"))
10945 (buffer-substring (point-at-bol) (point))))
10946 (completion-ignore-case opt)
10947 (type nil)
10948 (tbl nil)
10949 (table (cond
10950 (opt
10951 (setq type :opt)
10952 (mapcar (lambda (x)
10954 (cons (match-string 2 x) (match-string 1 x)))
10956 (startup
10957 (setq type :startup)
10958 org-startup-options)
10959 (link (append org-link-abbrev-alist-local
10960 org-link-abbrev-alist))
10961 (texp
10962 (setq type :tex)
10963 org-html-entities)
10965 (buffer-substring (point-at-bol) beg))
10966 (setq type :todo)
10967 (mapcar 'list org-todo-keywords))
10968 (searchhead
10969 (setq type :searchhead)
10970 (save-excursion
10971 (goto-char (point-min))
10972 (while (re-search-forward org-todo-line-regexp nil t)
10973 (push (list
10974 (org-make-org-heading-search-string
10975 (match-string 3) t))
10976 tbl)))
10977 tbl)
10978 (tag (setq type :tag beg beg1)
10979 (or org-tag-alist (org-get-buffer-tags)))
10980 (t (progn (ispell-complete-word arg) (throw 'exit nil)))))
10981 (pattern (buffer-substring-no-properties beg end))
10982 (completion (try-completion pattern table confirm)))
10983 (cond ((eq completion t)
10984 (if (equal type :opt)
10985 (insert (substring (cdr (assoc (upcase pattern) table))
10986 (length pattern)))
10987 (if (equal type :tag) (insert ":"))))
10988 ((null completion)
10990 (ding))
10991 ((not (string= pattern completion))
10992 (delete-region beg end)
10993 (if (string-match " +$" completion)
10994 (setq completion (replace-match "" t t completion)))
10995 (insert completion)
10996 (if (get-buffer-window "*Completions*")
10997 (delete-window (get-buffer-window "*Completions*")))
10998 (if (assoc completion table)
10999 (if (eq type :todo) (insert " ")
11000 (if (eq type :tag) (insert ":"))))
11001 (if (and (equal type :opt) (assoc completion table))
11002 (message "%s" (substitute-command-keys
11004 (t
11005 (message "Making completion list...")
11006 (let ((list (sort (all-completions pattern table confirm)
11007 'string<)))
11008 (with-output-to-temp-buffer "*Completions*"
11009 (condition-case nil
11010 ;; Protection needed for XEmacs and emacs 21
11011 (display-completion-list list pattern)
11012 (error (display-completion-list list)))))
11013 (message "Making completion list...%s" "done"))))))
11015 ;;;; TODO, DEADLINE, Comments
11017 (defun org-toggle-comment ()
11018 "Change the COMMENT state of an entry."
11019 (interactive)
11020 (save-excursion
11021 (org-back-to-heading)
11022 (if (looking-at (concat outline-regexp
11024 (replace-match "" t t nil 1)
11025 (if (looking-at outline-regexp)
11026 (progn
11027 (goto-char (match-end 0))
11028 (insert " " org-comment-string))))))
11030 (defvar org-last-todo-state-is-todo nil
11031 "This is non-nil when the last TODO state change led to a TODO state.
11032 If the last change removed the TODO tag or switched to DONE, then
11033 this is nil.")
11035 (defun org-todo (&optional arg)
11036 "Change the TODO state of an item.
11037 The state of an item is given by a keyword at the start of the heading,
11038 like
11039 *** TODO Write paper
11040 *** DONE Call mom
11042 The different keywords are specified in the variable `org-todo-keywords'.
11044 So for this example: when the item starts with TODO, it is changed to DONE.
11045 When it starts with DONE, the DONE is removed. And when neither TODO nor
11046 DONE are present, add TODO at the beginning of the heading.
11048 With C-u prefix arg, use completion to determine the new state.
11049 With numeric prefix arg, switch to that state.
11051 For calling through lisp, arg is also interpreted in the following way:
11052 'none -> empty state
11054 'done -> switch to DONE
11056 really is a member of `org-todo-keywords'."
11057 (interactive "P")
11058 (save-excursion
11059 (org-back-to-heading)
11060 (if (looking-at outline-regexp) (goto-char (match-end 0)))
11061 (or (looking-at (concat " +" org-todo-regexp " *"))
11062 (looking-at " *"))
11063 (let* ((this (match-string 1))
11064 (last-state (or this ""))
11065 (completion-ignore-case t)
11066 (member (member this org-todo-keywords))
11067 (tail (cdr member))
11068 (state (cond
11069 ((equal arg '(4))
11070 ;; Read a state with completion
11071 (completing-read "State: " (mapcar (lambda(x) (list x))
11072 org-todo-keywords)
11073 nil t))
11074 ((eq arg 'right)
11075 (if this
11076 (if tail (car tail) nil)
11077 (car org-todo-keywords)))
11078 ((eq arg 'left)
11079 (if (equal member org-todo-keywords)
11080 nil
11081 (if this
11082 (nth (- (length org-todo-keywords) (length tail) 2)
11083 org-todo-keywords)
11084 org-done-string)))
11085 (arg
11086 ;; user requests a specific state
11087 (cond
11088 ((equal arg "") nil)
11089 ((eq arg 'none) nil)
11090 ((eq arg 'done) (org-last org-todo-keywords))
11091 ((car (member arg org-todo-keywords)))
11092 ((nth (1- (prefix-numeric-value arg))
11093 org-todo-keywords))))
11094 ((null member) (car org-todo-keywords))
11095 ((null tail) nil) ;; -> first entry
11096 ((eq org-todo-interpretation 'sequence)
11097 (car tail))
11098 ((memq org-todo-interpretation '(type priority))
11099 (if (eq this-command last-command)
11100 (car tail)
11101 (if (> (length tail) 0) org-done-string nil)))
11102 (t nil)))
11103 (next (if state (concat " " state " ") " "))
11104 dostates)
11105 (replace-match next t t)
11106 (setq org-last-todo-state-is-todo
11107 (not (equal state org-done-string)))
11108 (when org-log-done
11109 (setq dostates (and (eq org-todo-interpretation 'sequence)
11110 (listp org-log-done) (memq 'state org-log-done)))
11111 (cond
11112 ((and state (not this))
11113 (org-add-planning-info nil nil 'closed)
11114 (and dostates (org-add-log-maybe 'state state 'findpos)))
11115 ((and state dostates)
11116 (org-add-log-maybe 'state state 'findpos))
11117 ((equal state org-done-string)
11118 ;; Planning info calls the note-setting command.
11119 (org-add-planning-info 'closed (org-current-time)
11120 (if (org-get-repeat) nil 'scheduled))
11121 (org-add-log-maybe 'done state 'findpos))))
11122 ;; Fixup tag positioning
11123 (and org-auto-align-tags (org-set-tags nil t))
11124 (run-hooks 'org-after-todo-state-change-hook)
11125 (and (equal state org-done-string) (org-auto-repeat-maybe))
11126 ))
11127 ;; Fixup cursor location if close to the keyword
11128 (if (and (outline-on-heading-p)
11129 (not (bolp))
11130 (save-excursion (beginning-of-line 1)
11131 (looking-at org-todo-line-regexp))
11132 (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
11133 (progn
11134 (goto-char (or (match-end 2) (match-end 1)))
11135 (just-one-space))))
11137 (defun org-get-repeat ()
11138 "Return the REPEAT statement of this entry."
11139 (save-match-data
11140 (save-excursion
11141 (org-back-to-heading t)
11142 (if (re-search-forward
11143 org-repeat-re (save-excursion (outline-next-heading) (point)) t)
11144 (match-string 1)))))
11146 (defvar org-last-changed-timestamp)
11147 (defvar org-log-post-message)
11148 (defun org-auto-repeat-maybe ()
11149 "Check if the current headline contains a REPEAT key.
11150 If yes, set TODO state back to what it was and change any SCHEDULED
11151 or DEADLINE times the new date.
11152 This function should be run in the `org-after-todo-state-change-hook'."
11153 ;; last-state is dynamically scoped into this function
11154 (let ((repeat (org-get-repeat))
11155 (whata '(("d" . day) ("m" . month) ("y" . year)))
11156 (msg "Entry repeats: ")
11157 (org-log-done)
11158 re type n what start)
11159 (when repeat
11160 (org-todo (if (eq 'org-todo-interpretation 'type)
11161 last-state
11162 (car org-todo-keywords)))
11163 (unless (memq 'org-add-log-note (default-value 'post-command-hook))
11164 ;; Make sure a note is taken
11165 (let ((org-log-done '(done)))
11166 (org-add-log-maybe 'done org-done-string 'findpos)))
11167 (org-back-to-heading t)
11168 (org-add-planning-info nil nil 'closed)
11171 (while (re-search-forward
11172 re (save-excursion (outline-next-heading) (point)) t)
11173 (setq type (if (match-end 1) org-scheduled-string org-deadline-string)
11174 start 0)
11176 (setq start (match-end 0)
11177 n (string-to-number (match-string 1 repeat))
11178 what (match-string 2 repeat))
11179 (if (equal what "w") (setq n (* n 7) what "d"))
11180 (org-timestamp-change n (cdr (assoc what whata))))
11181 (setq msg (concat msg type org-last-changed-timestamp " ")))
11182 (setq org-log-post-message msg)
11183 (message msg))))
11185 (defun org-show-todo-tree (arg)
11186 "Make a compact tree which shows all headlines marked with TODO.
11187 The tree will show the lines where the regexp matches, and all higher
11188 headlines above the match.
11190 With a numeric prefix N, construct a sparse tree for the Nth element
11191 of `org-todo-keywords'."
11192 (interactive "P")
11193 (let ((case-fold-search nil)
11194 (kwd-re
11195 (cond ((null arg) org-not-done-regexp)
11196 ((equal arg '(4)) org-todo-regexp)
11197 ((<= (prefix-numeric-value arg) (length org-todo-keywords))
11198 (regexp-quote (nth (1- (prefix-numeric-value arg))
11199 org-todo-keywords)))
11200 (t (error "Invalid prefix argument: %s" arg)))))
11201 (message "%d TODO entries found"
11202 (org-occur (concat "^" outline-regexp " +" kwd-re )))))
11204 (defun org-deadline ()
11205 "Insert the DEADLINE: string to make a deadline.
11207 to modify it to the correct date."
11208 (interactive)
11209 (org-add-planning-info 'deadline nil 'closed))
11211 (defun org-schedule ()
11212 "Insert the SCHEDULED: string to schedule a TODO item.
11214 to modify it to the correct date."
11215 (interactive)
11216 (org-add-planning-info 'scheduled nil 'closed))
11218 (defun org-add-planning-info (what &optional time &rest remove)
11219 "Insert new timestamp with keyword in the line directly after the headline.
11220 WHAT indicates what kind of time stamp to add. TIME indicated the time to use.
11221 If non is given, the user is prompted for a date.
11222 REMOVE indicates what kind of entries to remove. An old WHAT entry will also
11223 be removed."
11224 (interactive)
11225 (let (org-time-was-given)
11226 (when what (setq time (or time (org-read-date nil 'to-time))))
11227 (when (and org-insert-labeled-timestamps-at-point
11228 (member what '(scheduled deadline)))
11229 (insert
11230 (if (eq what 'scheduled) org-scheduled-string org-deadline-string) " ")
11231 (org-insert-time-stamp time org-time-was-given)
11232 (setq what nil))
11233 (save-excursion
11234 (save-restriction
11235 (let (col list elt ts buffer-invisibility-spec)
11236 (org-back-to-heading t)
11238 (goto-char (match-end 1))
11239 (setq col (current-column))
11240 (goto-char (1+ (match-end 0)))
11241 (if (and (not (looking-at outline-regexp))
11244 (not (equal (match-string 1) org-clock-string)))
11245 (narrow-to-region (match-beginning 0) (match-end 0))
11247 (backward-char 1)
11248 (narrow-to-region (point) (point))
11249 (indent-to-column col))
11250 ;; Check if we have to remove something.
11251 (setq list (cons what remove))
11252 (while list
11253 (setq elt (pop list))
11254 (goto-char (point-min))
11255 (when (or (and (eq elt 'scheduled)
11256 (re-search-forward org-scheduled-time-regexp nil t))
11257 (and (eq elt 'deadline)
11258 (re-search-forward org-deadline-time-regexp nil t))
11259 (and (eq elt 'closed)
11260 (re-search-forward org-closed-time-regexp nil t)))
11261 (replace-match "")
11262 (if (looking-at "--+<[^>]+>") (replace-match ""))
11263 (if (looking-at " +") (replace-match ""))))
11264 (goto-char (point-max))
11265 (when what
11266 (insert
11267 (if (not (equal (char-before) ?\ )) " " "")
11268 (cond ((eq what 'scheduled) org-scheduled-string)
11269 ((eq what 'deadline) org-deadline-string)
11270 ((eq what 'closed) org-closed-string))
11271 " ")
11272 (org-insert-time-stamp time
11273 (or org-time-was-given (eq what 'closed))
11274 (eq what 'closed))
11275 (end-of-line 1))
11276 (goto-char (point-min))
11277 (widen)
11279 (replace-match ""))
11280 ts)))))
11282 (defvar org-log-note-marker (make-marker))
11283 (defvar org-log-note-purpose nil)
11284 (defvar org-log-note-state nil)
11285 (defvar org-log-note-window-configuration nil)
11286 (defvar org-log-note-return-to (make-marker))
11287 (defvar org-log-post-message nil
11288 "Message to be displayed after a log note has been stored.
11289 The auto-repeater uses this.")
11291 (defun org-add-log-maybe (&optional purpose state findpos)
11292 (save-excursion
11293 (when (and (listp org-log-done)
11294 (memq purpose org-log-done))
11295 (when findpos
11296 (org-back-to-heading t)
11300 (goto-char (match-end 0)))
11301 (move-marker org-log-note-marker (point))
11302 (setq org-log-note-purpose purpose)
11303 (setq org-log-note-state state)
11304 (add-hook 'post-command-hook 'org-add-log-note 'append))))
11306 (defun org-add-log-note (&optional purpose)
11307 "Pop up a window for taking a note, and add this note later at point."
11308 (remove-hook 'post-command-hook 'org-add-log-note)
11309 (setq org-log-note-window-configuration (current-window-configuration))
11310 (delete-other-windows)
11311 (move-marker org-log-note-return-to (point))
11312 (switch-to-buffer (marker-buffer org-log-note-marker))
11313 (goto-char org-log-note-marker)
11314 (switch-to-buffer-other-window "*Org Note*")
11315 (erase-buffer)
11316 (let ((org-inhibit-startup t)) (org-mode))
11318 (cond
11319 ((eq org-log-note-purpose 'clock-out) "stopped clock")
11320 ((eq org-log-note-purpose 'done) "closed todo item")
11321 ((eq org-log-note-purpose 'state) "state change")
11322 (t (error "This should not happen")))))
11323 (org-set-local 'org-finish-function 'org-store-log-note))
11325 (defun org-store-log-note ()
11326 "Finish taking a log note, and insert it to where it belongs."
11327 (let ((txt (buffer-string))
11328 (note (cdr (assq org-log-note-purpose org-log-note-headings)))
11329 lines ind)
11330 (kill-buffer (current-buffer))
11332 (setq txt (replace-match "" t t txt)))
11334 (setq txt (replace-match "" t t txt)))
11337 (setq note
11338 (org-replace-escapes
11339 note
11340 (list (cons "%u" (user-login-name))
11341 (cons "%U" user-full-name)
11342 (cons "%t" (format-time-string
11343 (org-time-stamp-format 'long 'inactive)
11344 (current-time)))
11345 (cons "%s" (if org-log-note-state
11347 "")))))
11349 (push note lines))
11350 (save-excursion
11351 (set-buffer (marker-buffer org-log-note-marker))
11352 (save-excursion
11353 (goto-char org-log-note-marker)
11354 (move-marker org-log-note-marker nil)
11355 (end-of-line 1)
11357 (setq ind (concat (buffer-substring (point-at-bol) (point)) " "))
11358 (insert " - " (pop lines))
11359 (while lines
11361 (set-window-configuration org-log-note-window-configuration)
11362 (with-current-buffer (marker-buffer org-log-note-return-to)
11363 (goto-char org-log-note-return-to))
11364 (move-marker org-log-note-return-to nil)
11365 (and org-log-post-message (message org-log-post-message)))
11367 (defvar org-occur-highlights nil)
11368 (make-variable-buffer-local 'org-occur-highlights)
11370 (defun org-occur (regexp &optional keep-previous callback)
11371 "Make a compact tree which shows all matches of REGEXP.
11372 The tree will show the lines where the regexp matches, and all higher
11373 headlines above the match. It will also show the heading after the match,
11374 to make sure editing the matching entry is easy.
11375 If KEEP-PREVIOUS is non-nil, highlighting and exposing done by a previous
11376 call to `org-occur' will be kept, to allow stacking of calls to this
11377 command.
11378 If CALLBACK is non-nil, it is a function which is called to confirm
11379 that the match should indeed be shown."
11381 (or keep-previous (org-remove-occur-highlights nil nil t))
11382 (let ((cnt 0))
11383 (save-excursion
11384 (goto-char (point-min))
11385 (if (or (not keep-previous) ; do not want to keep
11386 (not org-occur-highlights)) ; no previous matches
11387 ;; hide everything
11388 (org-overview))
11389 (while (re-search-forward regexp nil t)
11390 (when (or (not callback)
11391 (save-match-data (funcall callback)))
11392 (setq cnt (1+ cnt))
11393 (org-highlight-new-match (match-beginning 0) (match-end 0))
11394 (org-show-context 'occur-tree))))
11395 (when org-remove-highlights-with-change
11396 (org-add-hook 'before-change-functions 'org-remove-occur-highlights
11397 nil 'local))
11398 (unless org-sparse-tree-open-archived-trees
11399 (org-hide-archived-subtrees (point-min) (point-max)))
11400 (run-hooks 'org-occur-hook)
11401 (if (interactive-p)
11402 (message "%d match(es) for regexp %s" cnt regexp))
11403 cnt))
11405 (defun org-show-context (&optional key)
11406 "Make sure point and context and visible.
11407 How much context is shown depends upon the variables
11408 `org-show-hierarchy-above', `org-show-following-heading'. and
11409 `org-show-siblings'."
11410 (let ((heading-p (org-on-heading-p t))
11411 (hierarchy-p (org-get-alist-option org-show-hierarchy-above key))
11412 (following-p (org-get-alist-option org-show-following-heading key))
11413 (siblings-p (org-get-alist-option org-show-siblings key)))
11414 (catch 'exit
11415 ;; Show heading or entry text
11416 (if heading-p
11417 (org-flag-heading nil) ; only show the heading
11418 (and (or (org-invisible-p) (org-invisible-p2))
11419 (org-show-hidden-entry))) ; show entire entry
11420 (when following-p
11421 ;; Show next sibling, or heading below text
11422 (save-excursion
11423 (and (if heading-p (org-goto-sibling) (outline-next-heading))
11424 (org-flag-heading nil))))
11425 (when siblings-p (org-show-siblings))
11426 (when hierarchy-p
11427 ;; show all higher headings, possibly with siblings
11428 (save-excursion
11429 (while (and (condition-case nil
11430 (progn (org-up-heading-all 1) t)
11431 (error nil))
11432 (not (bobp)))
11433 (org-flag-heading nil)
11434 (when siblings-p (org-show-siblings))))))))
11436 (defun org-reveal (&optional siblings)
11437 "Show current entry, hierarchy above it, and the following headline.
11438 This can be used to show a consistent set of context around locations
11439 exposed with `org-show-hierarchy-above' or `org-show-following-heading'
11440 not t for the search context.
11442 With optional argument SIBLINGS, on each level of the hierarchy all
11443 siblings are shown. This repairs the tree structure to what it would
11444 look like when opened with hierarchical calls to `org-cycle'."
11445 (interactive "P")
11446 (let ((org-show-hierarchy-above t)
11447 (org-show-following-heading t)
11448 (org-show-siblings (if siblings t org-show-siblings)))
11449 (org-show-context nil)))
11451 (defun org-highlight-new-match (beg end)
11452 "Highlight from BEG to END and mark the highlight is an occur headline."
11453 (let ((ov (org-make-overlay beg end)))
11454 (org-overlay-put ov 'face 'secondary-selection)
11455 (push ov org-occur-highlights)))
11457 (defun org-remove-occur-highlights (&optional beg end noremove)
11458 "Remove the occur highlights from the buffer.
11459 BEG and END are ignored. If NOREMOVE is nil, remove this function
11460 from the `before-change-functions' in the current buffer."
11461 (interactive)
11462 (unless org-inhibit-highlight-removal
11463 (mapc 'org-delete-overlay org-occur-highlights)
11464 (setq org-occur-highlights nil)
11465 (unless noremove
11466 (remove-hook 'before-change-functions
11467 'org-remove-occur-highlights 'local))))
11469 ;;;; Priorities
11472 "Regular expression matching the priority indicator.")
11474 (defvar org-remove-priority-next-time nil)
11476 (defun org-priority-up ()
11477 "Increase the priority of the current item."
11478 (interactive)
11479 (org-priority 'up))
11481 (defun org-priority-down ()
11482 "Decrease the priority of the current item."
11483 (interactive)
11484 (org-priority 'down))
11486 (defun org-priority (&optional action)
11487 "Change the priority of an item by ARG.
11488 ACTION can be set, up, or down."
11489 (interactive)
11490 (setq action (or action 'set))
11491 (let (current new news have remove)
11492 (save-excursion
11493 (org-back-to-heading)
11494 (if (looking-at org-priority-regexp)
11495 (setq current (string-to-char (match-string 2))
11496 have t)
11497 (setq current org-default-priority))
11498 (cond
11499 ((eq action 'set)
11500 (message "Priority A-%c, SPC to remove: " org-lowest-priority)
11501 (setq new (read-char-exclusive))
11502 (cond ((equal new ?\ ) (setq remove t))
11503 ((or (< (upcase new) ?A) (> (upcase new) org-lowest-priority))
11504 (error "Priority must be between `%c' and `%c'"
11505 ?A org-lowest-priority))))
11506 ((eq action 'up)
11507 (setq new (1- current)))
11508 ((eq action 'down)
11509 (setq new (1+ current)))
11510 (t (error "Invalid action")))
11511 (setq new (min (max ?A (upcase new)) org-lowest-priority))
11512 (setq news (format "%c" new))
11513 (if have
11514 (if remove
11515 (replace-match "" t t nil 1)
11516 (replace-match news t t nil 2))
11517 (if remove
11518 (error "No priority cookie found in line")
11519 (looking-at org-todo-line-regexp)
11520 (if (match-end 2)
11521 (progn
11522 (goto-char (match-end 2))
11523 (insert " [#" news "]"))
11524 (goto-char (match-beginning 3))
11525 (insert "[#" news "] ")))))
11526 (if remove
11527 (message "Priority removed")
11528 (message "Priority of current item set to %s" news))))
11531 (defun org-get-priority (s)
11532 "Find priority cookie and return priority."
11533 (save-match-data
11534 (if (not (string-match org-priority-regexp s))
11535 (* 1000 (- org-lowest-priority org-default-priority))
11536 (* 1000 (- org-lowest-priority
11537 (string-to-char (match-string 2 s)))))))
11539 ;;;; Tags
11541 (defun org-scan-tags (action matcher &optional todo-only)
11542 "Scan headline tags with inheritance and produce output ACTION.
11543 ACTION can be `sparse-tree' or `agenda'. MATCHER is a Lisp form to be
11544 evaluated, testing if a given set of tags qualifies a headline for
11545 inclusion. When TODO-ONLY is non-nil, only lines with a TODO keyword
11546 are included in the output."
11548 (mapconcat 'regexp-quote
11549 (nreverse (cdr (reverse org-todo-keywords)))
11552 (props (list 'face nil
11553 'done-face 'org-done
11554 'undone-face nil
11555 'mouse-face 'highlight
11556 'org-not-done-regexp org-not-done-regexp
11557 'keymap org-agenda-keymap
11558 'help-echo
11559 (format "mouse-2 or RET jump to org file %s"
11560 (abbreviate-file-name buffer-file-name))))
11561 (case-fold-search nil)
11562 lspos
11563 tags tags-list tags-alist (llast 0) rtn level category i txt
11564 todo marker entry priority)
11565 (save-excursion
11566 (goto-char (point-min))
11567 (when (eq action 'sparse-tree) (org-overview))
11568 (while (re-search-forward re nil t)
11569 (catch :skip
11570 (setq todo (if (match-end 1) (match-string 2))
11571 tags (if (match-end 4) (match-string 4)))
11572 (goto-char (setq lspos (1+ (match-beginning 0))))
11573 (setq level (funcall outline-level)
11574 category (org-get-category))
11575 (setq i llast llast level)
11576 ;; remove tag lists from same and sublevels
11577 (while (>= i level)
11578 (when (setq entry (assoc i tags-alist))
11579 (setq tags-alist (delete entry tags-alist)))
11580 (setq i (1- i)))
11581 ;; add the nex tags
11582 (when tags
11583 (setq tags (mapcar 'downcase (org-split-string tags ":"))
11584 tags-alist
11585 (cons (cons level tags) tags-alist)))
11586 ;; compile tags for current headline
11587 (setq tags-list
11588 (if org-use-tag-inheritance
11589 (apply 'append (mapcar 'cdr tags-alist))
11590 tags))
11591 (when (and (or (not todo-only) todo)
11592 (eval matcher)
11593 (or (not org-agenda-skip-archived-trees)
11594 (not (member org-archive-tag tags-list))))
11595 (and (eq action 'agenda) (org-agenda-skip))
11596 ;; list this headline
11597 (if (eq action 'sparse-tree)
11598 (progn
11599 (org-show-context 'tags-tree))
11600 (setq txt (org-format-agenda-item
11601 ""
11602 (concat
11603 (if org-tags-match-list-sublevels
11604 (make-string (1- level) ?.) "")
11605 (org-get-heading))
11606 category tags-list)
11607 priority (org-get-priority txt))
11608 (goto-char lspos)
11609 (setq marker (org-agenda-new-marker))
11610 (org-add-props txt props
11611 'org-marker marker 'org-hd-marker marker 'org-category category
11612 'priority priority)
11613 (push txt rtn))
11614 ;; if we are to skip sublevels, jump to end of subtree
11615 (or org-tags-match-list-sublevels (org-end-of-subtree t))))))
11616 (when (and (eq action 'sparse-tree)
11617 (not org-sparse-tree-open-archived-trees))
11618 (org-hide-archived-subtrees (point-min) (point-max)))
11619 (nreverse rtn)))
11621 (defvar todo-only) ;; dynamically scoped
11623 (defun org-tags-sparse-tree (&optional todo-only match)
11624 "Create a sparse tree according to tags string MATCH.
11625 MATCH can contain positive and negative selection of tags, like
11627 If optional argument TODO_ONLY is non-nil, only select lines that are
11628 also TODO lines."
11629 (interactive "P")
11630 (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only))
11632 (defun org-make-tags-matcher (match)
11633 "Create the TAGS//TODO matcher form for the selection string MATCH."
11634 ;; todo-only is scoped dynamically into this function, and the function
11635 ;; may change it it the matcher asksk for it.
11636 (unless match
11637 ;; Get a new match request, with completion
11638 (setq org-last-tags-completion-table
11639 (or org-tag-alist
11640 org-last-tags-completion-table))
11641 (setq match (completing-read
11642 "Match: " 'org-tags-completion-function nil nil nil
11643 'org-tags-history)))
11645 ;; Parse the string and create a lisp form
11646 (let ((match0 match)
11648 minus tag mm
11649 tagsmatch todomatch tagsmatcher todomatcher kwd matcher
11650 orterms term orlist re-p level-p)
11651 (if (string-match "/+" match)
11652 ;; match contains also a todo-matching request
11653 (progn
11654 (setq tagsmatch (substring match 0 (match-beginning 0))
11655 todomatch (substring match (match-end 0)))
11656 (if (string-match "^!" todomatch)
11657 (setq todo-only t todomatch (substring todomatch 1)))
11659 (setq todomatch nil)))
11660 ;; only matching tags
11661 (setq tagsmatch match todomatch nil))
11663 ;; Make the tags matcher
11665 (setq tagsmatcher t)
11666 (setq orterms (org-split-string tagsmatch "|") orlist nil)
11667 (while (setq term (pop orterms))
11669 (setq term (concat term "|" (pop orterms)))) ; repair bad split
11670 (while (string-match re term)
11671 (setq minus (and (match-end 1)
11672 (equal (match-string 1 term) "-"))
11673 tag (match-string 2 term)
11674 re-p (equal (string-to-char tag) ?{)
11675 level-p (match-end 3)
11676 mm (cond
11677 (re-p `(org-match-any-p ,(substring tag 1 -1) tags-list))
11678 (level-p `(= level ,(string-to-number
11679 (match-string 3 term))))
11680 (t `(member ,(downcase tag) tags-list)))
11681 mm (if minus (list 'not mm) mm)
11682 term (substring term (match-end 0)))
11683 (push mm tagsmatcher))
11684 (push (if (> (length tagsmatcher) 1)
11685 (cons 'and tagsmatcher)
11686 (car tagsmatcher))
11687 orlist)
11688 (setq tagsmatcher nil))
11689 (setq tagsmatcher (if (> (length orlist) 1) (cons 'or orlist) (car orlist))))
11691 ;; Make the todo matcher
11693 (setq todomatcher t)
11694 (setq orterms (org-split-string todomatch "|") orlist nil)
11695 (while (setq term (pop orterms))
11696 (while (string-match re term)
11697 (setq minus (and (match-end 1)
11698 (equal (match-string 1 term) "-"))
11699 kwd (match-string 2 term)
11700 re-p (equal (string-to-char kwd) ?{)
11701 term (substring term (match-end 0))
11702 mm (if re-p
11703 `(string-match ,(substring kwd 1 -1) todo)
11704 (list 'equal 'todo kwd))
11705 mm (if minus (list 'not mm) mm))
11706 (push mm todomatcher))
11707 (push (if (> (length todomatcher) 1)
11708 (cons 'and todomatcher)
11709 (car todomatcher))
11710 orlist)
11711 (setq todomatcher nil))
11712 (setq todomatcher (if (> (length orlist) 1)
11713 (cons 'or orlist) (car orlist))))
11715 ;; Return the string and lisp forms of the matcher
11716 (setq matcher (if todomatcher
11717 (list 'and tagsmatcher todomatcher)
11718 tagsmatcher))
11719 (cons match0 matcher)))
11721 (defun org-match-any-p (re list)
11722 "Does re match any element of list?"
11723 (setq list (mapcar (lambda (x) (string-match re x)) list))
11724 (delq nil list))
11726 (defvar org-add-colon-after-tag-completion nil) ;; dynamically skoped param
11727 (defvar org-tags-overlay (org-make-overlay 1 1))
11728 (org-detach-overlay org-tags-overlay)
11730 (defun org-set-tags (&optional arg just-align)
11731 "Set the tags for the current headline.
11732 With prefix ARG, realign all tags in headings in the current buffer."
11733 (interactive "P")
11734 (let* ((re (concat "^" outline-regexp))
11735 (current (org-get-tags))
11736 table current-tags inherited-tags ; computed below when needed
11737 tags p0 c0 c1 rpl)
11738 (if arg
11739 (save-excursion
11740 (goto-char (point-min))
11741 (let ((buffer-invisibility-spec (org-inhibit-invisibility)))
11742 (while (re-search-forward re nil t)
11743 (org-set-tags nil t)
11744 (end-of-line 1)))
11745 (message "All tags realigned to column %d" org-tags-column))
11746 (if just-align
11747 (setq tags current)
11748 ;; Get a new set of tags from the user
11749 (save-excursion
11750 (setq table (or org-tag-alist (org-get-buffer-tags))
11751 org-last-tags-completion-table table
11752 current-tags (org-split-string current ":")
11753 inherited-tags (nreverse
11754 (nthcdr (length current-tags)
11755 (nreverse (org-get-tags-at))))
11756 tags
11757 (if (or (eq t org-use-fast-tag-selection)
11758 (and org-use-fast-tag-selection
11759 (delq nil (mapcar 'cdr table))))
11760 (org-fast-tag-selection current-tags inherited-tags table)
11761 (let ((org-add-colon-after-tag-completion t))
11762 (org-trim
11763 (completing-read "Tags: " 'org-tags-completion-function
11764 nil nil current 'org-tags-history))))))
11765 (while (string-match "[-+&]+" tags)
11766 ;; No boolean logic, just a list
11767 (setq tags (replace-match ":" t t tags))))
11770 (setq tags "")
11771 (unless (string-match ":$" tags) (setq tags (concat tags ":")))
11772 (unless (string-match "^:" tags) (setq tags (concat ":" tags))))
11774 ;; Insert new tags at the correct column
11775 (beginning-of-line 1)
11776 (if (re-search-forward
11778 (point-at-eol) t)
11779 (progn
11780 (if (equal tags "")
11781 (setq rpl "")
11782 (goto-char (match-beginning 0))
11783 (setq c0 (current-column) p0 (point)
11784 c1 (max (1+ c0) (if (> org-tags-column 0)
11785 org-tags-column
11786 (- (- org-tags-column) (length tags))))
11787 rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags)))
11788 (replace-match rpl t t)
11789 (and (not (featurep 'xemacs)) c0 (tabify p0 (point)))
11790 tags)
11791 (error "Tags alignment failed")))))
11793 (defun org-tags-completion-function (string predicate &optional flag)
11794 (let (s1 s2 rtn (ctable org-last-tags-completion-table)
11795 (confirm (lambda (x) (stringp (car x)))))
11797 (setq s1 (match-string 1 string)
11798 s2 (match-string 2 string))
11799 (setq s1 "" s2 string))
11800 (cond
11801 ((eq flag nil)
11802 ;; try completion
11803 (setq rtn (try-completion s2 ctable confirm))
11804 (if (stringp rtn)
11805 (concat s1 s2 (substring rtn (length s2))
11806 (if (and org-add-colon-after-tag-completion
11807 (assoc rtn ctable))
11808 ":" "")))
11809 )
11810 ((eq flag t)
11811 ;; all-completions
11812 (all-completions s2 ctable confirm)
11813 )
11814 ((eq flag 'lambda)
11815 ;; exact match?
11816 (assoc s2 ctable)))
11817 ))
11819 (defun org-fast-tag-insert (kwd tags face &optional end)
11820 "Insert KDW, and the TAGS, the latter with face FACE. Also inser END."
11821 (insert (format "%-12s" (concat kwd ":"))
11822 (org-add-props (mapconcat 'identity tags " ") nil 'face face)
11823 (or end "")))
11825 (defun org-fast-tag-show-exit (flag)
11826 (save-excursion
11827 (goto-line 3)
11829 (replace-match ""))
11830 (when flag
11831 (end-of-line 1)
11832 (move-to-column (- (window-width) 19) t)
11833 (insert (org-add-props " Next change exits" nil 'face 'org-warning)))))
11835 (defun org-set-current-tags-overlay (current prefix)
11836 (let ((s (concat ":" (mapconcat 'identity current ":") ":")))
11837 (if (featurep 'xemacs)
11838 (org-overlay-display org-tags-overlay (concat prefix s)
11839 'secondary-selection)
11840 (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s)
11841 (org-overlay-display org-tags-overlay (concat prefix s)))))
11843 (defun org-fast-tag-selection (current inherited table)
11844 "Fast tag selection with single keys.
11845 CURRENT is the current list of tags in the headline, INHERITED is the
11846 list of inherited tags, and TABLE is an alist of tags and corresponding keys,
11847 possibly with grouping information.
11848 If the keys are nil, a-z are automatically assigned.
11849 Returns the new tags string, or nil to not change the current settings."
11850 (let* ((maxlen (apply 'max (mapcar
11851 (lambda (x)
11852 (if (stringp (car x)) (string-width (car x)) 0))
11853 table)))
11854 (buf (current-buffer))
11855 (expert (eq org-fast-tag-selection-single-key 'expert))
11856 (buffer-tags nil)
11857 (fwidth (+ maxlen 3 1 3))
11858 (ncol (/ (- (window-width) 4) fwidth))
11859 (i-face 'org-done)
11860 (c-face 'org-tag)
11861 tg cnt e c char c1 c2 ntable tbl rtn
11862 ov-start ov-end ov-prefix
11863 (exit-after-next org-fast-tag-selection-single-key)
11864 groups ingroup)
11865 (save-excursion
11866 (beginning-of-line 1)
11868 (setq ov-start (match-beginning 1)
11869 ov-end (match-end 1)
11870 ov-prefix "")
11871 (setq ov-start (1- (point-at-eol))
11872 ov-end (1+ ov-start))
11874 (setq ov-prefix
11875 (concat
11876 (buffer-substring (1- (point)) (point))
11877 (if (> (current-column) org-tags-column)
11878 " "
11879 (make-string (- org-tags-column (current-column)) ?\ ))))))
11880 (org-move-overlay org-tags-overlay ov-start ov-end)
11881 (save-window-excursion
11882 (if expert
11883 (set-buffer (get-buffer-create " *Org tags*"))
11884 (delete-other-windows)
11885 (split-window-vertically)
11886 (switch-to-buffer-other-window (get-buffer-create " *Org tags*")))
11887 (erase-buffer)
11890 (org-fast-tag-show-exit exit-after-next)
11891 (org-set-current-tags-overlay current ov-prefix)
11892 (setq tbl table char ?a cnt 0)
11893 (while (setq e (pop tbl))
11894 (cond
11895 ((equal e '(:startgroup))
11896 (push '() groups) (setq ingroup t)
11897 (when (not (= cnt 0))
11898 (setq cnt 0)
11900 (insert "{ "))
11901 ((equal e '(:endgroup))
11902 (setq ingroup nil cnt 0)
11904 (t
11905 (setq tg (car e) c2 nil)
11906 (if (cdr e)
11907 (setq c (cdr e))
11908 ;; automatically assign a character.
11909 (setq c1 (string-to-char
11910 (downcase (substring
11911 tg (if (= (string-to-char tg) ?@) 1 0)))))
11912 (if (or (rassoc c1 ntable) (rassoc c1 table))
11913 (while (or (rassoc char ntable) (rassoc char table))
11914 (setq char (1+ char)))
11915 (setq c2 c1))
11916 (setq c (or c2 char)))
11917 (if ingroup (push tg (car groups)))
11918 (setq tg (org-add-props tg nil 'face
11919 (cond
11920 ((member tg current) c-face)
11921 ((member tg inherited) i-face)
11922 (t nil))))
11923 (if (and (= cnt 0) (not ingroup)) (insert " "))
11924 (insert "[" c "] " tg (make-string
11925 (- fwidth 4 (length tg)) ?\ ))
11926 (push (cons tg c) ntable)
11927 (when (= (setq cnt (1+ cnt)) ncol)
11929 (if ingroup (insert " "))
11930 (setq cnt 0)))))
11931 (setq ntable (nreverse ntable))
11933 (goto-char (point-min))
11934 (if (and (not expert) (fboundp 'fit-window-to-buffer))
11935 (fit-window-to-buffer))
11936 (setq rtn
11937 (catch 'exit
11938 (while t
11939 (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free%s%s"
11940 (if groups " [!] no groups" " [!]groups")
11941 (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
11942 (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
11943 (cond
11945 ((= c ?!)
11946 (setq groups (not groups))
11947 (goto-char (point-min))
11948 (while (re-search-forward "[{}]" nil t) (replace-match " ")))
11949 ((= c ?\C-c)
11950 (if (not expert)
11951 (org-fast-tag-show-exit
11952 (setq exit-after-next (not exit-after-next)))
11953 (setq expert nil)
11954 (delete-other-windows)
11955 (split-window-vertically)
11956 (switch-to-buffer-other-window " *Org tags*")
11957 (and (fboundp 'fit-window-to-buffer)
11958 (fit-window-to-buffer))))
11959 ((or (= c ?\C-g)
11960 (and (= c ?q) (not (rassoc c ntable))))
11961 (org-detach-overlay org-tags-overlay)
11962 (setq quit-flag t))
11963 ((= c ?\ )
11964 (setq current nil)
11965 (if exit-after-next (setq exit-after-next 'now)))
11967 (condition-case nil
11968 (setq tg (completing-read
11969 "Tag: "
11970 (or buffer-tags
11971 (with-current-buffer buf
11972 (org-get-buffer-tags)))))
11973 (quit (setq tg "")))
11975 (add-to-list 'buffer-tags (list tg))
11976 (if (member tg current)
11977 (setq current (delete tg current))
11978 (push tg current)))
11979 (if exit-after-next (setq exit-after-next 'now)))
11980 ((setq e (rassoc c ntable) tg (car e))
11981 (if (member tg current)
11982 (setq current (delete tg current))
11983 (loop for g in groups do
11984 (if (member tg g)
11985 (mapcar (lambda (x)
11986 (setq current (delete x current)))
11987 g)))
11988 (push tg current))
11989 (if exit-after-next (setq exit-after-next 'now))))
11991 ;; Create a sorted list
11992 (setq current
11993 (sort current
11994 (lambda (a b)
11995 (assoc b (cdr (memq (assoc a ntable) ntable))))))
11996 (if (eq exit-after-next 'now) (throw 'exit t))
11997 (goto-char (point-min))
11998 (beginning-of-line 2)
11999 (delete-region (point) (point-at-eol))
12000 (org-fast-tag-insert "Current" current c-face)
12001 (org-set-current-tags-overlay current ov-prefix)
12003 (setq tg (match-string 1))
12004 (add-text-properties (match-beginning 1) (match-end 1)
12005 (list 'face
12006 (cond
12007 ((member tg current) c-face)
12008 ((member tg inherited) i-face)
12009 (t nil)))))
12010 (goto-char (point-min)))))
12011 (org-detach-overlay org-tags-overlay)
12012 (if rtn
12013 (mapconcat 'identity current ":")
12014 nil))))
12016 (defun org-get-tags ()
12017 "Get the TAGS string in the current headline."
12018 (unless (org-on-heading-p t)
12019 (error "Not on a heading"))
12020 (save-excursion
12021 (beginning-of-line 1)
12023 (org-match-string-no-properties 1)
12024 "")))
12026 (defun org-get-buffer-tags ()
12027 "Get a table of all tags used in the buffer, for completion."
12028 (let (tags)
12029 (save-excursion
12030 (goto-char (point-min))
12032 (mapc (lambda (x) (add-to-list 'tags x))
12033 (org-split-string (org-match-string-no-properties 1) ":"))))
12034 (mapcar 'list tags)))
12036 ;;;; Timestamps
12038 (defvar org-last-changed-timestamp nil)
12039 (defvar org-time-was-given) ; dynamically scoped parameter
12040 (defvar org-ts-what) ; dynamically scoped parameter
12042 (defun org-time-stamp (arg)
12043 "Prompt for a date/time and insert a time stamp.
12044 If the user specifies a time like HH:MM, or if this command is called
12045 with a prefix argument, the time stamp will contain date and time.
12046 Otherwise, only the date will be included. All parts of a date not
12047 specified by the user will be filled in from the current date/time.
12048 So if you press just return without typing anything, the time stamp
12049 will represent the current date/time. If there is already a timestamp
12050 at the cursor, it will be modified."
12051 (interactive "P")
12052 (let (org-time-was-given time)
12053 (cond
12054 ((and (org-at-timestamp-p)
12055 (eq last-command 'org-time-stamp)
12056 (eq this-command 'org-time-stamp))
12057 (insert "--")
12058 (setq time (let ((this-command this-command))
12059 (org-read-date arg 'totime)))
12060 (org-insert-time-stamp time (or org-time-was-given arg)))
12061 ((org-at-timestamp-p)
12062 (setq time (let ((this-command this-command))
12063 (org-read-date arg 'totime)))
12064 (when (org-at-timestamp-p) ; just to get the match data
12065 (replace-match "")
12066 (setq org-last-changed-timestamp
12067 (org-insert-time-stamp time (or org-time-was-given arg))))
12068 (message "Timestamp updated"))
12069 (t
12070 (setq time (let ((this-command this-command))
12071 (org-read-date arg 'totime)))
12072 (org-insert-time-stamp time (or org-time-was-given arg))))))
12074 (defun org-time-stamp-inactive (&optional arg)
12075 "Insert an inactive time stamp.
12076 An inactive time stamp is enclosed in square brackets instead of angle
12077 brackets. It is inactive in the sense that it does not trigger agenda entries,
12078 does not link to the calendar and cannot be changed with the S-cursor keys.
12079 So these are more for recording a certain time/date."
12080 (interactive "P")
12081 (let (org-time-was-given time)
12082 (setq time (org-read-date arg 'totime))
12083 (org-insert-time-stamp time (or org-time-was-given arg) 'inactive)))
12085 (defvar org-date-ovl (org-make-overlay 1 1))
12086 (org-overlay-put org-date-ovl 'face 'org-warning)
12087 (org-detach-overlay org-date-ovl)
12089 (defvar org-ans1) ; dynamically scoped parameter
12090 (defvar org-ans2) ; dynamically scoped parameter
12092 (defun org-read-date (&optional with-time to-time from-string prompt)
12093 "Read a date and make things smooth for the user.
12094 The prompt will suggest to enter an ISO date, but you can also enter anything
12095 which will at least partially be understood by `parse-time-string'.
12096 Unrecognized parts of the date will default to the current day, month, year,
12097 hour and minute. For example,
12098 3-2-5 --> 2003-02-05
12099 feb 15 --> currentyear-02-15
12100 sep 12 9 --> 2009-09-12
12101 12:45 --> today 12:45
12102 22 sept 0:34 --> currentyear-09-22 0:34
12103 12 --> currentyear-currentmonth-12
12104 Fri --> nearest Friday (today or later)
12105 +4 --> four days from today (only if +N is the only thing given)
12106 etc.
12107 The function understands only English month and weekday abbreviations,
12108 but this can be configured with the variables `parse-time-months' and
12109 `parse-time-weekdays'.
12111 While prompting, a calendar is popped up - you can also select the
12112 date with the mouse (button 1). The calendar shows a period of three
12113 months. To scroll it to other months, use the keys `>' and `<'.
12114 If you don't like the calendar, turn it off with
12115 \(setq org-popup-calendar-for-date-prompt nil)
12117 With optional argument TO-TIME, the date will immediately be converted
12118 to an internal time.
12119 With an optional argument WITH-TIME, the prompt will suggest to also
12120 insert a time. Note that when WITH-TIME is not set, you can still
12121 enter a time, and this function will inform the calling routine about
12122 this change. The calling routine may then choose to change the format
12123 used to insert the time stamp into the buffer to include the time."
12124 (require 'parse-time)
12125 (let* ((org-time-stamp-rounding-minutes
12126 (if (equal with-time '(16)) 0 org-time-stamp-rounding-minutes))
12127 (ct (org-current-time))
12128 (default-time
12129 ;; Default time is either today, or, when entering a range,
12130 ;; the range start.
12131 (if (save-excursion
12132 (re-search-backward
12134 (- (point) 20) t))
12135 (apply
12136 'encode-time
12137 (mapcar (lambda(x) (or x 0))
12138 (parse-time-string (match-string 1))))
12139 ct))
12140 (calendar-move-hook nil)
12141 (view-diary-entries-initially nil)
12142 (view-calendar-holidays-initially nil)
12143 (timestr (format-time-string
12144 (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") default-time))
12145 (prompt (concat (if prompt (concat prompt " ") "")
12146 (format "Date and/or time (default [%s]): " timestr)))
12147 ans (org-ans0 "") org-ans1 org-ans2 (deltadays 0)
12148 second minute hour day month year tl wday wday1 pm)
12150 (cond
12151 (from-string (setq ans from-string))
12152 (org-popup-calendar-for-date-prompt
12153 (save-excursion
12154 (save-window-excursion
12155 (calendar)
12156 (calendar-forward-day (- (time-to-days default-time)
12157 (calendar-absolute-from-gregorian
12158 (calendar-current-date))))
12159 (org-eval-in-calendar nil)
12160 (let* ((old-map (current-local-map))
12161 (map (copy-keymap calendar-mode-map))
12162 (minibuffer-local-map (copy-keymap minibuffer-local-map)))
12163 (define-key map (kbd "RET") 'org-calendar-select)
12164 (define-key map (if (featurep 'xemacs) [button1] [mouse-1])
12165 'org-calendar-select-mouse)
12196 ;; org-ans0: from prompt
12197 ;; org-ans1: from mouse click
12198 ;; org-ans2: from calendar motion
12208 ;; Help matching ISO dates with single digit month ot day, like 2006-8-11.
12218 t nil ans)))
12219 ;; Help matching am/pm times, because `parse-time-string' does not do that.
12220 ;; If there is a time with am/pm, and *no* time without it, we convert
12221 ;; convert so that matching will be successful.
12242 ;; Weekday was given, but no day, so pick that day in the week
12243 ;; on or after the derived date.
12258 "Eval FORM in the calendar window and return to current window.
12259 Also, store the cursor date in variable org-ans2."
12269 ;; Update the prompt to show new default date
12280 "Return to `org-read-date' with the date currently selected.
12281 This is used by `org-read-date' in a temporary keymap for the calendar buffer."
12290 "Insert a date stamp for the date given by the internal TIME.
12291 WITH-HM means, use the stamp format that includes the time of the day.
12292 INACTIVE means use square brackets instead of angular ones, so that the
12293 stamp will not contribute to the agenda.
12294 PRE and POST are optional strings to be inserted before and after the
12295 stamp.
12296 The command returns the inserted time stamp."
12298 stamp)
12303 stamp))
12306 "Toggle the use of custom time stamp formats."
12327 "Overlay modified time stamp format over timestamp between BED and END."
12349 "Translate all timestamps in STRING to custom format.
12350 But do this only if the variable `org-display-custom-times' is set."
12355 t1 with-hm inactive tf time str beg end)
12364 org-time-stamp-custom-formats)
12373 string)
12376 "Set 0 instead of nil for the first 6 elements of time.
12377 Don't touch the rest."
12382 "Difference between TIMESTAMP-STRING and now in days."
12387 "Is the time in TIMESTAMP-STRING close to the current date?"
12393 "Return to `org-read-date' with the date currently selected.
12394 This is used by `org-read-date' in a temporary keymap for the calendar buffer."
12404 "Check if there are any deadlines due or past due.
12405 A deadline is considered due if it happens within `org-deadline-warning-days'
12406 days from today's date. If the deadline appears in an entry marked DONE,
12407 it is not shown. The prefix arg NDAYS can be used to test that many
12422 org-warn-days)))
12425 "Evaluate a time range by computing the difference between start and end.
12426 Normally the result is just printed in the echo area, but with prefix arg
12427 TO-BUFFER, the result is inserted just after the date stamp into the buffer.
12428 If the time range is actually in a table, the result is inserted into the
12429 next column.
12430 For time difference computation, a year is assumed to be exactly 365
12431 days in order to avoid rounding problems."
12451 ;; (ys (floor (* 365 24 60 60)))
12459 y d h m align)
12462 y 0
12467 y 0
12503 "Parse the standard Org-mode time string.
12504 This should be a lot faster than the normal `parse-time-string'.
12505 If time is not given, defaults to 0:00. However, with optional NODEFAULT,
12506 hour and minute fields will be nil if not given."
12516 nil nil nil)
12520 "Increase the date item at the cursor by one.
12521 If the cursor is on the year, change the year. If it is on the month or
12522 the day, change that.
12523 With prefix ARG, change by that many units."
12528 "Decrease the date item at the cursor by one.
12529 If the cursor is on the year, change the year. If it is on the month or
12530 the day, change that.
12531 With prefix ARG, change by that many units."
12536 "Increase the date in the time stamp by one day.
12537 With prefix ARG, change that many days."
12545 "Decrease the date in the time stamp by one day.
12546 With prefix ARG, change that many days."
12559 "Determine if the cursor is in or at a timestamp."
12579 ans))
12582 "Change the date in the time stamp at point.
12583 The date will be changed by N times WHAT. WHAT can be `day', `month',
12584 `year', `minute', `second'. If WHAT is not given, the cursor position
12585 in the timestamp determines what will be changed."
12587 with-hm inactive
12588 org-ts-what
12589 ts time time0)
12593 org-display-custom-times
12632 ;; Try to recenter the calendar window, if any
12639 "If the calendar is visible, recenter it to DATE."
12650 "Go to the Emacs calendar at the current date.
12651 If there is a time stamp in the current line, go to that date.
12652 A prefix ARG can be used to force the current date."
12671 "Insert time stamp corresponding to cursor date in *Calendar* buffer.
12672 If there is already a time stamp at the cursor position, update it."
12676 ;;; The clock for measuring work time.
12682 "Start the clock on the current item.
12683 If necessary, clock-out of the currently active clock."
12692 ;; First line hast scheduling info, move one further
12703 "Stop the currently running clock.
12704 If there is no running clock, throw an error, unless FAIL-QUIETLY is set."
12733 "Cancel the running clock be removing the start timestamp."
12748 "Sum the times for each subtree.
12749 Puts the resulting times in minutes as a text property on each headline."
12753 org-clock-string
12759 ts te dt
12760 time)
12766 ;; A time
12777 ;; A headline
12791 "Show subtree times in the entire buffer.
12792 If TOTAL-ONLY is non-nil, only show the total time for the entire file
12793 in the echo area."
12807 ;; Arrange to remove the overlays upon next change.
12817 "Put an overlays on the current line, displaying TIME.
12818 If LEVEL is given, prefix time with a corresponding number of stars.
12819 This creates a new overlay and stores it in `org-clock-overlays', so that it
12820 will be easy to remove."
12824 ov tx)
12843 "Remove the occur highlights from the buffer.
12844 BEG and END are ignored. If NOREMOVE is nil, remove this function
12845 from the `before-change-functions' in the current buffer."
12855 "Clock out if the current entry contains the running clock.
12856 This is used to stop the clock after a TODO entry is marked DONE."
12861 org-clock-marker))
12862 ;; Clock out, but don't accept a logging message for this.
12866 org-log-done)))
12873 "Check if the current buffer contains the running clock.
12874 If yes, offer to stop it and to save the buffer with the changes."
12883 "Create a table containing a report about clocked time.
12884 If the buffer contains lines
12885 #+BEGIN: clocktable :maxlevel 3 :emphasize nil
12887 #+END: clocktable
12888 then the table will be inserted between these lines, replacing whatever
12889 is was there before. If these lines are not in the buffer, the table
12890 is inserted at point, surrounded by the special lines.
12891 The BEGIN line can contain parameters. Allowed are:
12892 :maxlevel The maximum level to be included in the table. Default is 3.
12893 :emphasize t/nil, if levell 1 and level 2 should be bold/italic in the table."
12902 "If this is a CLOCK line, update it and return t.
12903 Otherwise, return nil."
12912 ts te h m s)
12914 nil
12928 t)))))
12931 "Return two times bordering a special time range.
12932 Key is a symbol specifying the range and can be one of `today', `yesterday',
12933 `thisweek', `lastweek', `thismonth', `lastmonth', `thisyear', `lastyear'.
12934 A week starts Monday 0:00 and ends Sunday 24:00.
12935 The range is determined relative to TIME. TIME defaults to the current time.
12936 The return value is a cons cell with two internal times like the ones
12937 returned by `current time' or `encode-time'. if AS-STRINGS is non-nil,
12938 the returned times will be formatted strings."
12943 s1 m1 h1 d1 month1 y1 diff ts te fm)
12973 "Write the standard clocktable."
12977 ipos time h m p level hlc hdl maxlevel
12978 ts te cc block)
12997 "]."
13026 hlc
13028 hlc
13036 ;; FIXME: I don't think anybody uses this, ask David
13038 "Return an internal list with clocking information.
13039 This list has one entry for each CLOCK interval.
13040 FIXME: describe the elements."
13044 rtn beg end next cont level title total closedp leafp
13045 clockpos titlepos h m donep)
13070 total title titlepos level leafp)
13071 rtn)
13075 ;;;; Agenda, and Diary Integration
13077 ;;; Define the Org-agenda-mode
13091 "Mode for time-sorted view on action items in Org-mode files.
13093 The following commands are available:
13099 org-agenda-pending-undo-list nil)
13107 ;; Make sure properties are removed when copying text
13112 buffer-substring-filters)))
13115 org-agenda-show-log nil))
13122 "Restricted to single file"
13134 org-agenda-mode-map global-map)
13218 "--"
13225 "--"
13229 "--"
13233 "--"
13240 "--"
13252 ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda 'timeline)]
13256 "--"
13258 "--"
13264 "--"
13266 :style toggle :selected org-agenda-show-log :active (org-agenda-check-type nil 'agenda 'timeline)]
13270 :style toggle :selected org-agenda-use-time-grid :active (org-agenda-check-type nil 'agenda)])
13273 "--"
13275 "--"
13278 ))
13280 ;;; Agenda undo
13292 "Execute BODY if ther is no `org-protected' text property at point."
13298 "Execute BODY while recording undo information in two buffers."
13306 _c1 _c2)
13307 ,@_body
13314 ;; make sure there are undo boundaries
13317 ;; remember which buffer to undo
13319 org-agenda-undo-list)))))
13322 "Undo a remote editing step in the agenda.
13323 This undoes changes both in the agenda buffer and in the remote buffer
13324 that have been changed along."
13330 org-agenda-pending-undo-list org-agenda-undo-list))
13334 buf line cmd rembuf)
13342 buffer-read-only)
13356 "Verify that a real change occurred between the undo lists L1 and L2."
13361 ;;; Agenda dispatch
13368 ;;;###autoload
13370 "Dispatch agenda commands to collect entries to the agenda buffer.
13371 Prompts for a character to select a command. Any prefix arg will be passed
13372 on to the selected command. The default selections are:
13373 g
13374 a Call `org-agenda-list' to display the agenda for current day or week.
13375 t Call `org-todo-list' to display the global todo list.
13376 T Call `org-todo-list' to display the global todo list, select only
13377 entries with a specific TODO keyword (the user gets a prompt).
13378 m Call `org-tags-view' to display headlines with tags matching
13379 a condition (the user is prompted for the condition).
13380 M Like `m', but select only TODO entries, no ordinary headlines.
13381 l Create a timeeline for the current buffer.
13383 More commands can be added by configuring the variable
13384 `org-agenda-custom-commands'. In particular, specific tags and TODO keyword
13385 searches can be pre-defined in this way.
13387 If the current buffer is in Org-mode and visiting a file, you can also
13388 first press `1' to indicate that the agenda should be temporarily (until the
13396 c entry key type match lprops)
13397 ;; Turn off restriction
13402 ;; Remember where this call originated
13410 "Press key for an agenda command:
13411 -------------------------------- C Configure custom agenda commands
13412 a Agenda for current week or day
13413 t List of all TODO entries T Entries with special TODO kwd
13414 m Match a TAGS query M Like m, but only TODO entries
13415 L Timeline for current buffer # List stuck projects (!=configure)
13422 header)))
13443 (org-add-props "1 Restrict call to current buffer 0 Restrict call to region or subtree" nil 'face 'org-table)))
13476 ;; For example the todo list should not need it (but does...)
13525 match ;; The byte compiler incorrectly complains about this. Keep it!
13526 cmd type lprops)
13554 ;;;###autoload
13556 "Run an agenda command in batch mode, send result to STDOUT.
13557 CMD-KEY is a string that is also a key in `org-agenda-custom-commands'.
13558 Paramters are alternating variable names and values that will be bound
13559 before running the agenda command."
13569 "Inhibit read-only for BODY."
13573 "Make sure current buffer is in org-mode. Error if not."
13576 major-mode)))
13579 "Fit the window to the buffer size."
13585 ;;; Agenda file list
13588 "Get the list of agenda files.
13589 Optional UNRESTRICTED means return the full list even if a restriction
13590 is currently in place."
13598 "Edit the list of agenda files.
13599 Depending on setup, this either uses customize to edit the variable
13600 `org-agenda-files', or it visits the file that is holding the list. In the
13601 latter case, the buffer is set up in a way that saving it automatically kills
13602 the buffer and restores the previous window configuration."
13621 "Set new value for the agenda file list and save it correcly."
13632 "Read the list of agenda files from a file."
13639 ;;;###autoload
13641 "Cycle through the files in `org-agenda-files'.
13642 If the current buffer visits an agenda file, find the next one in the list.
13643 If the current buffer does not, find the first agenda file."
13648 file)
13660 "Move/add the current file to the end of the agenda file list.
13661 If the file is not present in the list, it is appended to the list. If it is
13662 present, it is moved there."
13667 "Move/add the current file to the top of the agenda file list.
13668 If the file is not present in the list, it is added to the front. If it is
13669 present, it is moved there. With optional argument TO-END, add/move to the
13670 end of the list."
13676 x had)
13689 "Remove current file from the list of files in variable `org-agenda-files'.
13690 These are the files which are being checked for agenda entries.
13691 Optional argument FILE means, use this file instead of the current."
13700 nil x))
13713 "Make sure FILE exists. If not, ask user what to do."
13724 ;;; Agenda prepare and finalize
13760 "Finishing touch for the agenda buffer, called just before displaying it."
13772 "Create buffers for all agenda files, protect archived trees and comments."
13778 bmp file re)
13801 "Function to be called at each match during agenda construction.
13802 If this function return nil, the current match should not be skipped.
13803 Otherwise, the function must return a position from where the search
13804 should be continued.
13805 Never set this variable using `setq' or so, because then it will apply
13806 to all future agenda commands. Instead, bind it with `let' to scope
13810 "Throw to `:skip' in places that should be skipped.
13811 Also moves point to the end of the skipped region, so that search can
13812 continue from there."
13835 "Return a new agenda marker.
13836 Org-mode keeps a list of these markers and resets them when they are
13837 no longer in use."
13841 m))
13844 "Reset markers created by `org-agenda'. But only if they are old enough."
13847 org-agenda-last-marker-time)
13856 "Get a buffer visiting FILE. If the buffer needs to be created, add
13857 it to the list of buffers which might be released later."
13860 buf ; just return it
13861 ;; Make a new buffer and remember it
13864 buf)))
13867 "Release all buffers in list, asking the user for confirmation when needed.
13868 When a buffer is unmodified, it is just killed. When modified, it is saved
13869 \(if the user agrees) and then killed."
13874 file
13881 "Get the table of categories and positions in current buffer."
13887 tbl))
13890 "Get the category applying to position POS."
13906 org-category-table))))))
13907 ;;; Agenda timeline
13910 "Show a time-sorted view of the entries in the current org file.
13911 Only entries with a time stamp of today or later will be listed. With
13913 under the current date.
13914 If the buffer contains an active region, only check the region for
13915 dates."
13928 t doclosed ; always include today
13929 org-timeline-show-empty-dates))
13932 args
13933 s e rtn d emptyp)
13939 ;; Remove past dates from the list of dates.
13942 day-numbers))))
13955 dopast
13956 past)
13964 entry date args)))
13971 ; FIXME: this gives a timezone problem
13972 ; (insert (format-time-string org-agenda-date-format
13973 ; (calendar-time-from-absolute d 0))
13974 ; "\n")
13989 "Return a list of all relevant day numbers from BEG to END buffer positions.
13990 If NO-RANGES is non-nil, include only the start and end dates of a range,
13991 not every single day in the range. If FORCE-TODAY is non-nil, make
13992 sure that TODAY is included in the list. If INACTIVE is non-nil, also
13993 inactive time stamps (those in square brackets) are included.
13994 When EMPTY is non-nil, also include days without any entries."
13996 dates dates1 date day day1 day2 ts1 ts2)
14026 dates)))
14028 ;;; Agenda Daily/Weekly
14037 ;;;###autoload
14039 "Produce a weekly view from all files in variable `org-agenda-files'.
14040 The view will be for the current week, but from the overview buffer you
14041 will be able to go to other weeks.
14043 also be shown, under the current date.
14045 on the days are also shown. See the variable `org-log-done' for how
14046 to turn on logging.
14047 START-DAY defaults to TODAY, or to the most recent match for the weekday
14048 given in `org-agenda-start-on-weekday'.
14049 NDAYS defaults to `org-agenda-ndays'."
14062 nil org-agenda-start-on-weekday))
14069 sd
14077 s e rtn rtnall file date d start-pos end-pos todayp nd)
14080 ;; Make the list of days
14082 nd ndays)
14093 rtnall nil)
14118 rtnall nil)
14124 file date
14127 file date
14142 ; FIXME: this gives a timezone problem
14143 ; (insert (format-time-string org-agenda-date-format
14144 ; (calendar-time-from-absolute d 0)) "\n")
14151 rtnall nd todayp))
14170 ;;; Agenda TODO list
14175 ;;;###autoload
14177 "Show all TODO entries from all agenda file in a single list.
14178 The prefix arg can be used to select a specific TODO keyword and limit
14180 for a keyword. A numeric prefix directly selects the Nth keyword in
14181 `org-todo-keywords'."
14194 rtn rtnall files file pos)
14198 nil t)))
14206 rtnall nil)
14224 "Available with `N r': (0)ALL "
14239 ;;; Agenda tags match
14241 ;;;###autoload
14243 "Show all headlines for all `org-agenda-files' matching a TAGS criterion.
14244 The prefix arg TODO-ONLY limits the search to TODO entries."
14251 rtn rtnall files file pos matcher
14252 buffer)
14260 rtnall nil)
14268 ;; If file does not exist, merror message to agenda
14280 org-agenda-restrict-end)
14305 ;;; Agenda Finding stuck projects
14308 "Regular expression used in skipping subtrees for the agenda.
14309 This is basically a temporary global variable that can be set and then
14316 "Checks if the current subtree contains match for `org-agenda-skip-regexp'.
14317 If yes, it returns the end position of this tree, causing agenda commands
14318 to skip this subtree. This is a function that can be put into
14319 `org-agenda-skip-function' for the duration of a command."
14322 skip)
14328 "Create agenda view for projects that are stuck.
14329 Stuck projects are project that have no next actions. For the definitions
14330 of what a project is and how to check if it stuck, customize the variable
14331 `org-stuck-projects'.
14332 MATCH is being ignored."
14359 ;;; Diary integration
14364 "Get the (Emacs Calendar) diary entries for DATE."
14371 entries
14381 ;; No entries
14383 ;; Omit the date and other unnecessary stuff
14385 ;; Add prefix to each line and extend the text properties
14397 ;; Extend the text properties to the beginning of the line
14399 entries)))))
14402 "Remove unwanted stuff in buffer created by `fancy-diary-display'.
14403 This gets rid of the date, the underline under the date, and
14404 the dummy entry installed by `org-mode' to ensure non-empty diary for each
14405 date. It also removes lines that contain only whitespace."
14422 ;; Make sure entries from the diary have the right text properties.
14425 ;; We can rely on the hook, nothing to do
14426 nil
14427 ;; Hook not avaiable, must use advice to make this work
14429 "Make the position visible."
14432 buffer-file-name)
14436 "Add text properties to string, allowing org-mode to act on it."
14439 'keymap org-agenda-keymap
14442 'org-agenda-diary-link t
14446 "Add a dummy entry to the diary.
14447 Needed to avoid empty dates which mess up holiday display."
14448 ;; Catch the error if dealing with the new add-to-diary-alist
14455 ;;;###autoload
14457 "Return diary information from org-files.
14459 It accesses org files and extracts information from those files to be
14460 listed in the diary. The function accepts arguments specifying what
14461 items should be listed. The following arguments are allowed:
14463 :timestamp List the headlines of items containing a date stamp or
14464 date range matching the selected date. Deadlines will
14465 also be listed, on the expiration day.
14467 :deadline List any deadlines past due, or due within
14468 `org-deadline-warning-days'. The listing occurs only
14469 in the diary for *today*, not at any other date. If
14470 an entry is marked DONE, it is no longer listed.
14472 :scheduled List all items which are scheduled for the given date.
14473 The diary for *today* also contains items which were
14474 scheduled earlier and are not yet marked DONE.
14476 :todo List all TODO items from the org-file. This may be a
14477 long list - so this is not turned on by default.
14478 Like deadlines, these entries only show up in the
14479 diary for *today*, not at any other date.
14481 The call in the diary file should look like this:
14483 &%%(org-diary) ~/path/to/some/orgfile.org
14485 Use a separate line for each org file to check. Or, if you omit the file name,
14486 all files listed in `org-agenda-files' will be checked automatically:
14488 &%%(org-diary)
14490 If you don't give any arguments (as in the example above), the default
14491 arguments (:deadline :scheduled :timestamp) are used. So the example above may
14492 also be written as
14494 &%%(org-diary :deadline :timestamp :scheduled)
14496 The function expects the lisp variables `entry' and `date' to be provided
14497 by the caller, because this is how the calendar works. Don't use this
14498 function from a program - use `org-agenda-get-day-entries' instead."
14506 file rtn results)
14507 ;; If this is called during org-agenda, don't return any entries to
14508 ;; the calendar. Org Agenda will list these entries itself.
14516 ;;; Agenda entry finders
14519 "Does the work for `org-diary' and `org-agenda'.
14520 FILE is the path to a file to be checked for entries. DATE is date like
14521 the one returned by `calendar-current-date'. ARGS are symbols indicating
14522 which kind of entries should be extracted. For details about these, see
14523 the documentation of `org-diary'."
14530 arg results rtn)
14532 ;; If file does not exist, make sure an error message ends up in diary
14543 org-agenda-restrict-end)
14545 ;; The way we repeatedly append to `results' makes it O(n^2) :-(
14567 results))))
14570 "Is the current entry marked DONE?"
14576 "Is the cursor inside a date range?"
14591 nil)))
14594 "Return the TODO information for agenda display."
14597 'org-not-done-regexp org-not-done-regexp
14599 'keymap org-agenda-keymap
14600 'help-echo
14603 ;; FIXME: get rid of the \n at some point but watch out
14608 org-not-done-regexp)
14610 marker priority category tags
14611 ee txt beg end)
14633 priority
14653 "Return the date stamp information for agenda display."
14655 'org-not-done-regexp org-not-done-regexp
14657 'keymap org-agenda-keymap
14658 'help-echo
14668 marker hdmarker deadlinep scheduledp donep tmp priority category
14669 ee txt timestr tags)
14679 org-ds-keyword-length))
14686 scheduledp donep
14689 ;; substring should only run to end of time stamp
14723 "Return the logged TODO entries for agenda display."
14725 'org-not-done-regexp org-not-done-regexp
14726 'keymap org-agenda-keymap
14727 'help-echo
14739 marker hdmarker priority category tags closedp
14740 ee txt timestr)
14749 ;; donep (org-entry-is-done-p)
14750 )
14752 ;; substring should only run to end of time stamp
14775 "Return the deadline information for agenda display."
14778 'org-not-done-regexp org-not-done-regexp
14779 'keymap org-agenda-keymap
14780 'help-echo
14786 d2 diff pos pos1 category tags
14787 ee txt head face)
14796 ;; When to show a deadline in the calendar:
14797 ;; If the expiration is within wdays warning time.
14798 ;; Past-due deadlines are only shown on the current date
14824 'org-category category
14827 ee))
14830 "Return the scheduled information for agenda display."
14832 'org-not-done-regexp org-not-done-regexp
14836 'keymap org-agenda-keymap
14837 'help-echo
14843 d2 diff pos pos1 category tags
14844 ee txt head)
14853 ;; When to show a scheduled item in the calendar:
14854 ;; If it is on or past the date.
14870 category tags))))
14879 ee))
14882 "Return the date-range information for agenda display."
14884 'org-not-done-regexp org-not-done-regexp
14886 'keymap org-agenda-keymap
14887 'help-echo
14892 marker hdmarker ee txt d1 d2 s1 s2 timestr category tags pos)
14904 ;; Only allow days between the limits, because the normal
14905 ;; date stamps will catch the limits.
14926 ;; Sort the entries by expiration date.
14929 ;;; Agenda presentation and sorting
14931 ;; FIXME: should I allow spaces around the dash?
14940 "Regular expression to match a plain time or time range.
14941 Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following
14942 groups carry important information:
14943 0 the full match
14944 1 the first time, range or not
14953 "Regular expression to match a timestamp time or time range.
14954 After a match, the following groups carry important information:
14955 0 the full match
14956 1 date plus weekday, for backreferencing to make sure both times on same day
14957 2 the first time, range or not
14961 "A flag, set by `org-compile-prefix-format'.
14964 "A flag, set by `org-compile-prefix-format'.
14968 noprefix)
14969 "Format TXT to be inserted into the agenda buffer.
14970 In particular, it adds the prefix and corresponding text properties. EXTRA
14971 must be a string and replaces the `%s' specifier in the prefix format.
14972 CATEGORY (string, symbol or nil) may be used to overrule the default
14973 category taken from local variable or file name. It will replace the `%c'
14974 specifier in the format. DOTIME, when non-nil, indicates that a
14975 time-of-day should be extracted from TXT for sorting of this entry, and for
14976 the `%t' specifier in the format. When DOTIME is a string, this string is
14977 searched for a time before TXT is. NOPREFIX is a flag and indicates that
14978 only the correctly processes TXT should be returned - this is used by
14979 `org-agenda-change-all-lines'. TAGS can be the tags of the headline."
14981 ;; Diary entries sometimes have extra whitespace at the beginning
14984 org-category
14990 time ; time and tag are needed for the eval of the prefix format
14993 stamp plain s0 s1 s2 rtn)
14995 ;; Extract starting and ending time and move them to prefix
15002 ;; If the times are in TXT (not in DOTIMES), and the prefix will list
15003 ;; them, we might want to remove them there to avoid duplication.
15004 ;; The user can turn this off with a variable.
15009 t))
15011 ;; Normalize the time(s) to 24 hour
15016 ;; Tags are in the string
15019 org-prefix-has-tag))
15024 t t txt))))
15026 ;; Create the final string
15029 ;; Prepare the variables needed in the eval of the compiled format
15035 ;; Evaluate the compiled format
15038 ;; And finally add the text properties
15042 'time-of-day time-of-day
15057 list)))
15062 new time)
15064 ;; don't show empty grid
15070 nil string "" nil
15072 new)
15080 "Compile the prefix format into a Lisp form that can be evaluated.
15081 The resulting form is returned and stored in the variable
15082 `org-prefix-format-compiled'."
15086 org-agenda-prefix-format)
15091 varform vars var e c f opt)
15093 s start)
15106 ""
15116 ;; the old format
15124 "Check string S for a time of day.
15125 If found, return it as a military time number between 0 and 2400.
15126 If not found, return nil.
15127 The optional STRING argument forces conversion into a 5 character wide string
15128 HH:MM."
15153 "Sort and concatenate the agenda items."
15156 list
15174 x)))
15177 "Compare the priorities of string A and B."
15185 "Compare the string values of categories of strings A and B."
15193 "Compare the string values of categories of strings A and B."
15203 "Compare the time-of-day values of strings A and B."
15212 "Predicate for sorting agenda entries."
15213 ;; The following variables will be used when the form is evaluated.
15214 ;; So even though the compiler complains, keep them.
15228 ;;; Agenda commands
15231 "Check if agenda buffer is of allowed type.
15232 If ERROR is non-nil, throw an error, otherwise just return nil."
15234 t
15237 nil)))
15240 "Exit agenda by removing the window or the buffer."
15246 ;; Maybe restore the pre-agenda window configuration.
15249 org-pre-agenda-window-conf
15253 "Exit agenda by removing the window or the buffer.
15254 Also kill all Org-mode buffers which have been loaded by `org-agenda'.
15255 Org-mode buffers visited directly by the user will not be touched."
15262 "Save all Org-mode buffers without user confirmation."
15269 "Rebuild Agenda.
15270 When this is the global TODO list, a prefix argument will be interpreted."
15278 org-agenda-pending-undo-list nil)
15284 "Go to today."
15304 "Go forward in time by `org-agenda-ndays' days.
15305 With prefix ARG, go forward that many times `org-agenda-ndays'."
15311 nil t)))
15316 "Go back in time by `org-agenda-ndays' days.
15317 With prefix ARG, go back that many times `org-agenda-ndays'."
15323 nil t)))
15328 "Switch to weekly view for agenda."
15337 org-starting-day)
15338 nil t)))
15345 "Switch to daily view for agenda."
15354 org-starting-day)
15355 nil t)))
15361 ;; FIXME: this no longer works if user make date format that starts with a blank
15363 "Jump to the next line indicating a date in agenda buffer."
15375 "Jump to the previous line indicating a date in agenda buffer."
15382 ;; Initialize the highlight
15387 "Highlight a region with overlay."
15392 "Detach overlay INDEX."
15404 "Toggle follow mode in an agenda buffer."
15412 "Toggle log mode in an agenda buffer."
15422 "Toggle diary inclusion in an agenda buffer."
15432 "Toggle time grid in an agenda buffer."
15442 "Set the mode name to indicate all the small mode settings."
15461 "Show the priority of the current item.
15462 This priority is composed of the main priority given with the [#A] cookies,
15463 and by additional input from the age of a schedules or deadline entry."
15469 "Show the tags applicable to the current item."
15478 "Go to the Org-mode file which contains the item at point."
15495 "Kill the entry or subtree belonging to the current agenda entry."
15527 "Kill the entry or subtree belonging to the current agenda entry."
15545 "Remove all lines in the agenda that correspond to a given subtree.
15546 The subtree is the one in buffer BUF, starting at BEG and ending at END.
15547 If this information is not given, the function uses the tree at point."
15570 "Follow the link in the current line, if any."
15581 "Go to the Org-mode file which contains the item at point."
15598 "Go to the Org-mode file which contains the item at the mouse click."
15604 "Display the Org-mode file which contains the item at point."
15611 "Display the Org-mode file which contains the item at point and recenter."
15619 "Display the Org-mode file which contains the item at the mouse click."
15625 "Check if the entry is a diary link and abort if yes."
15633 "Show the subtree corresponding to the current entry in an indirect buffer.
15634 This calls the command `org-tree-to-indirect-buffer' from the original
15635 Org-mode buffer.
15636 With numerical prefix arg ARG, go up to this level and then take that tree.
15637 With a C-u prefix, make a separate frame for this tree (i.e. don't use the
15638 dedicated frame)."
15651 "Marker pointing to the headline that last changed its TODO state
15655 "Cycle TODO state of line at point, also in Org-mode file.
15656 This changes the line at point, all other lines in the agenda referring to
15657 the same tree node, and the headline of the tree node in the Org-mode file."
15667 newhead)
15688 "Change all lines in the agenda buffer which match HDMARKER.
15689 The new content of the line will be NEWHEAD (as modified by
15690 `org-format-agenda-item'). HDMARKER is checked with
15691 `equal' against all `org-hd-marker' text properties in the file.
15692 If FIXFACE is non-nil, the face of each item is modified acording to
15693 the new TODO state."
15695 props m pl undone-face done-face finish new dotime cat tags)
15725 undone-face done-face))))
15732 ;; FIXME: allow negative value for org-agenda-align-tags-to-column
15733 ;; See the code in set-tags for the way to do this.
15735 "Align all tags in agenda items to `org-agenda-align-tags-to-column'."
15749 "Increase the priority of line at point, also in Org-mode file."
15754 "Decrease the priority of line at point, also in Org-mode file."
15759 "Set the priority of line at point, also in Org-mode file.
15760 This changes the line at point, all other lines in the agenda referring to
15761 the same tree node, and the headline of the tree node in the Org-mode file."
15770 newhead)
15786 "Get a list of all headline tags applicable at POS.
15787 POS defaults to point. If tags are inherited, the list contains
15788 the targets in the same sequence as the headlines appear, i.e.
15789 the tags of the current headline come last."
15803 tags)))
15807 tags)))
15809 ;; FIXME: should fix the tags property of the agenda line.
15811 "Set tags for the current headline."
15820 newhead)
15838 "Toggle the archive tag for the current entry."
15847 newhead)
15863 "Change the date of this item to one day later."
15882 "Change the date of this item to one day earlier."
15887 "Show new date stamp via text properties."
15888 ;; We use text properties to make this undoable
15897 ;; Use `duplicable' property to trigger undo recording
15912 "Change the date of this item. Date is prompted for, with default today.
15913 The prefix ARG is passed to the `org-time-stamp' command and can therefore
15914 be used to request time specification in the time stamp."
15932 "Schedule the item at point."
15941 ts)
15950 "Schedule the item at point."
15959 ts)
15968 "Return the heading of the current entry, without the stars."
15974 "Start the clock on the currently selected item."
15987 "Stop the currently running clock."
15995 "Cancel the currently running clock."
16003 "Make a diary entry, like the `i' command from the calendar.
16004 All the standard commands work: block, weekly etc."
16020 ; (buf (get-file-buffer (substitute-in-file-name diary-file)))
16029 ;; We implement this by hacking the `calendar-cursor-to-date' function
16030 ;; and the `calendar-mark-ring' variable. Saves a lot of code.
16046 "Execute a calendar command from the agenda, with the date associated to
16047 the cursor position."
16056 ;; the following 3 vars are needed in the calendar
16070 "Display the phases of the moon for the 3 months around the cursor date."
16075 "Display the holidays for the 3 months around the cursor date."
16080 "Display sunrise and sunset for the cursor date.
16081 Latitude and longitude can be specified with the variables
16082 `calendar-latitude' and `calendar-longitude'. When called with prefix
16083 argument, latitude and longitude will be prompted for."
16092 "Open the Emacs calendar with the date at the cursor."
16105 "Compute the Org-mode agenda for the calendar date displayed at the cursor.
16106 This is a command that has to be installed in `calendar-mode-map'."
16110 nil))
16116 date s)
16141 ;;;; Embedded LaTeX
16156 "Toggle the minor `org-cdlatex-mode'.
16157 This mode supports entering LaTeX environment and math in LaTeX fragments
16158 in Org-mode.
16160 nil " OCDL" nil
16165 "Always return t in org-mode buffers.
16166 This is because we want to insert math symbols without dollars even outside
16167 the LaTeX math segments. If Orgmode thinks that point is actually inside
16168 en embedded LaTeX fragement, let texmathp do its job.
16185 "Unconditionally turn on `org-cdlatex-mode'."
16189 "Test if point is inside a LaTeX fragment.
16191 sequence appearing also before point.
16192 Even though the matchers for math are configurable, this function assumes
16194 delimiters are skipped when they have been removed by customization.
16195 The return value is nil, or a cons cell with the delimiter and
16196 and the position of this delimiter.
16198 This function does a reasonably good job, but can locally be fooled by
16199 for example currency specifications. For example it will assume being in
16201 fragments that are properly closed, but during editing, we have to live
16202 with the uncertainty caused by missing closing delimiters. This function
16203 looks only before point, not after."
16222 (when (setq m (re-search-backward "\\(\\\\begin{[^}]*}\\|\\\\(\\|\\\\\\[\\)\\|\\(\\\\end{[^}]*}\\|\\\\)\\|\\\\\\]\\)\\|\\(\\$\\$\\)" lim t))
16226 ;; count $$
16234 "Check if it makes sense to execute `cdlatex-tab', and do it if yes.
16235 It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is
16236 - inside a LaTeX fragment, or
16237 - after the first word in a line, where an abbreviation expansion could
16238 insert a LaTeX environment."
16251 "Execute `cdlatex-sub-superscript' in LaTeX fragments.
16252 Revert to the normal definition outside of these fragments."
16260 "Execute `cdlatex-math-modify' in LaTeX fragments.
16261 Revert to the normal definition outside of these fragments."
16273 "Remove all overlays with LaTeX fragment images in current buffer."
16278 "Preview the LaTeX fragment at point, or all locally or globally.
16279 If the cursor is in a LaTeX fragment, create the image and overlay
16280 it over the source code. If there is no fragment at point, display
16281 all fragments in the current text, from one headline to the next. With
16282 prefix SUBTREE, display all fragments in the current subtree. With a
16283 double prefix `C-u C-u', or when the cursor is before the first headline,
16284 display all fragments in the buffer.
16313 buffer-file-name)))
16319 ;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil)
16320 ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p
16321 ("$" "\\([^$]\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([ .,?;:'\")\000]\\|$\\)" 2 nil)
16328 "Replace LaTeX fragments with links to an image, and produce images."
16337 m n block linkfile movefile ov)
16338 ;; Check if there are old images files with this prefix, and remove them
16342 todir 'full
16344 ;; Check the different regular expressions
16364 txt movefile opt)
16372 ov 'end-glyph
16375 ov 'display
16382 ;; This function borrows from Ganesh Swami's latex2png.el
16386 temporary-file-directory))
16390 ;(texfilebase (make-temp-file "orgtex"))
16391 ; (dummy (delete-file texfilebase))
16420 "-o" pngfile
16421 dvifile)
16424 ;; Use the requested file name and clean up
16428 pngfile))))
16430 ;;;; Exporting
16432 ;;; Variables, constants, and parameter plists
16477 "Return the property list with default settings for the export variables."
16481 rtn))
16484 "Return the property list with file-local settings for export."
16489 p key val text options)
16514 o)
16518 options)
16522 p)))
16528 val)))
16529 dir))
16532 "Remove all lines from LIST which are before the first headline."
16544 rtn line level)
16549 ;; Beginning of a COMMENT subtree. Skip it.
16555 ;; an ordinary comment line
16556 )
16562 ;; a special table line that should be removed
16563 )
16570 \[v] limit export to visible part of outline tree
16572 \[a] export as ASCII
16573 \[h] export as HTML
16574 \[b] export as HTML and browse immediately
16575 \[x] export as XOXO
16577 \[i] export current file as iCalendar file
16578 \[I] export all agenda files as iCalendar files
16579 \[c] export agenda files into combined iCalendar file
16581 \[F] publish current file
16582 \[P] publish current project
16583 \[X] publish... (project will be prompted for)
16599 r1 r2 ass)
16900 )
16901 "Entities for TeX->HTML translation.
16905 The list contains HTML entities for Latin-1, Greek and other symbols.
16906 It is supplemented by a number of commonly used TeX macros with appropriate
16909 ;;; General functions for all backends
16912 "Cleanup a buffer substring so that links can be created safely."
16922 rtn)
16930 ;; Get rid of archived trees
16941 ;; Protect stuff from HTML processing
16967 ;; Find targets in comments and move them out of comments,
16968 ;; but mark them as targets that should be invisible
16973 ;; Remove comments
16978 ;; Find matches for radio targets and turn them into internal links
16985 ;; Find all links that contain a newline and put them into a single line
16987 (while (re-search-forward "\\(\\(\\[\\|\\]\\)\\[[^]]*?\\)[ \t]*\n[ \t]*\\([^]]*\\]\\(\\[\\|\\]\\)\\)" nil t)
16992 ;; Convert LaTeX fragments to images
16997 org-current-export-file)))
17001 ;; Normalize links: Convert angle and plain links into bracket links
17002 ;; Expand link abbreviations
17009 t t)))
17016 t t)))
17023 "]"
17028 t t)))
17030 ;; Find multiline emphasis and put them into single line
17040 rtn))
17043 "Take link text and make a safe target out of it."
17047 'identity
17052 ;; Variable holding the vector with section numbers
17056 "Initialize the vector for the section numbers."
17073 "Return a string with the current section number.
17074 When LEVEL is non-nil, increase section numbers on that level."
17096 string))
17098 ;;; ASCII export
17105 "Export the outline as a pretty ASCII file.
17106 If there is an active region, export only the region.
17107 The prefix ARG specifies how many levels of the outline should become
17108 underlined headlines. The default is 3."
17145 ; (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)"))
17160 ;; create local variables for all options, to make sure all called
17161 ;; functions get the correct information
17165 org-export-plist-vars)
17168 org-export-headline-levels))
17171 umax))
17173 ;; File header
17192 line)
17193 ;; This is a headline
17198 todo
17202 org-done-string)))
17203 ; TODO, not DONE
17207 line lines level))))
17225 ))))
17226 lines)))
17230 ;; Remove the quoted HTML tags.
17232 ;; Remove targets
17235 ;; Replace internal links
17239 t nil line)))
17244 ;; a Headline
17252 ;; remove display and invisible chars
17268 "Search the subtree below LINE for any TODO entries."
17271 line lv todo)
17279 org-done-string))))
17280 ; TODO, not DONE
17285 "Handle quoted HTML for ASCII export."
17288 ;; We just remove the tags for now.
17290 line)
17293 "Insert the string S centered and underline it with character UNDERLINE."
17302 "Insert a new level in ASCII export."
17308 org-export-ascii-bullets))
17310 ;; find the indentation of the next non-empty line
17331 "Create a copy of the visible part of the current buffer, and export it.
17332 The copy is created in a temporary buffer and removed after use.
17333 TYPE is the final key (as a string) that also select the export command in
17334 the `C-c C-e' export dispatcher.
17335 As a special case, if the you type SPC at the prompt, the temporary
17336 org-mode file will not be removed but presented to you so that you can
17337 continue to use it. The prefix arg ARG is passed through to the exporting
17338 command."
17343 current-prefix-arg))
17356 s e)
17366 ;; Copy all comment lines to the end, to make sure #+ settings are
17367 ;; still available for the second export step. Kind of a hack, but
17368 ;; does do the trick.
17389 s))
17394 s))
17396 ;;; HTML export
17399 "Return a string with current options as keyword options.
17400 Does include HTML export options as well as TODO and CATEGORY stuff."
17402 "#+TITLE: %s
17403 #+AUTHOR: %s
17404 #+EMAIL: %s
17405 #+LANGUAGE: %s
17406 #+TEXT: Some descriptive text to be emitted. Several lines OK.
17408 #+CATEGORY: %s
17409 #+SEQ_TODO: %s
17410 #+TYP_TODO: %s
17411 #+STARTUP: %s %s %s %s %s
17412 #+TAGS: %s
17413 #+ARCHIVE: %s
17414 #+LINK: %s
17415 "
17417 org-export-headline-levels
17418 org-export-with-section-numbers
17419 org-export-with-toc
17420 org-export-preserve-breaks
17421 org-export-html-expand
17422 org-export-with-fixed-width
17423 org-export-with-tables
17424 org-export-with-sub-superscripts
17425 org-export-with-emphasize
17426 org-export-with-TeX-macros
17427 org-export-with-LaTeX-fragments
17452 org-archive-location
17453 "org file:~/org/%s.org"
17454 ))
17457 "Insert into the buffer a template with information for exporting."
17466 "Toggle the fixed-width export.
17467 If there is no active region, the QUOTE keyword at the current headline is
17468 inserted or removed. When present, it causes the text between this headline
17469 and the next to be exported as fixed-width text, and unmodified.
17470 If there is an active region, this command adds or removes a colon as the
17471 first character of this line. If the first character of a line is a colon,
17472 this line is also exported in fixed-width font."
17480 off)
17510 "Export the outline as HTML and immediately open it with a browser.
17511 If there is an active region, export only the region.
17512 The prefix ARG specifies how many levels of the outline should become
17513 headlines. The default is 3. Lower levels will become bulleted lists."
17519 "Call `org-export-as-html', may be used in batch processing as
17520 emacs --batch
17521 --load=$HOME/lib/emacs/org.el
17523 --visit=MyFile --funcall org-export-as-html-batch"
17527 "Export the outline as a pretty HTML file.
17528 If there is an active region, export only the region.
17529 The prefix ARG specifies how many levels of the outline should become
17530 headlines. The default is 3. Lower levels will become bulleted lists.
17531 When HIDDEN is non-nil, don't display the HTML buffer.
17532 EXT-PLIST is a property list with external parameters overriding
17533 org-mode's default settings, but still inferior to file-local settings."
17541 ext-plist
17546 valid
17553 ;; The following two are dynamically scoped into other
17554 ;; routines below.
17598 buffer-file-coding-system))
17604 table-open type
17605 table-buffer table-orig-buffer
17606 ind start-is-num starter didclose
17607 rpl path desc descp desc1 desc2 link
17608 )
17614 ;; Get the language-dependent settings
17618 ;; Switch to the output buffer
17626 ;; create local variables for all options, to make sure all called
17627 ;; functions get the correct information
17631 org-export-plist-vars)
17633 org-export-headline-levels))
17636 umax))
17638 ;; File header
17644 <head>
17645 <title>%s</title>
17650 %s
17651 </head><body>
17652 "
17654 date time author style))
17667 org-export-html-toplevel-hlevel
17669 org-export-html-toplevel-hlevel))
17674 ;; This is a headline
17682 todo
17686 org-done-string)))
17687 ; TODO, not DONE
17691 line lines level))))
17715 ;; Check for targets
17720 t t line))
17723 target-alist))
17731 head-count txt))
17734 )))
17735 line)
17736 lines))
17740 ))
17747 ;; end of quote section?
17751 ;; inside a quote section?
17756 ;; verbatim lines
17770 ;; Protected HTML
17775 ;; Horizontal line
17780 ;; make targets to anchors
17788 t t line)))
17792 ; (concat "@<i>" (match-string 1 line) "@</i> ")
17793 t t line)))
17799 t t line)))))
17803 ;; replace "&" by "&", "<" and ">" by "<" and ">"
17804 ;; handle @<..> HTML tags (replace "@>..<" by "<..>")
17805 ;; Also handle sub_superscripts and checkboxes
17808 ;; Format the links
17818 ;; Make an image out of the description if that is so wanted
17824 ;; FIXME: do we need to unescape here somewhere?
17833 ;; standard URL, just check if we need to inline an image
17841 ;; standard URL
17845 ;; FILE link
17848 thefile file-is-image-p search)
17856 t))
17865 ;; make sure this is can be used as target search
17889 ;; TODO items
17901 ;; This is a headline
17908 ;; Close any local lists before inserting a new header line
17914 in-local-list nil))
17917 head-count)
17918 ;; QUOTES
17926 ;; New table starts
17928 ;; Accumulate lines
17940 ;; Normal lines
17943 ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
17944 ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
17947 line)
17954 ;; empty line. Pretend indentation is large.
17970 ;; Start new (level of) list
17977 ;; continue current list
17981 ;; we did close a list, normal text follows: need <p>
17987 "<b>[X]</b>"
17989 t t line))))
17991 ;; Empty lines start a new paragraph. If hand-formatted lists
17992 ;; are not fully interpreted, lines starting with "-", "+", "*"
17993 ;; also start a new paragraph.
17996 ;; Check if the line break needs to be conserved
18005 ;; Properly close all local lists and other lists
18008 ;; Close any local lists before inserting a new header line
18014 in-local-list nil))
18017 head-count)
18037 ;; remove empty paragraphs and lists
18050 "Find out which HTML converter to use and return the HTML code."
18052 ;; A normal org table
18054 ;; Table made by table.el - test for spanning
18058 nil))
18059 lines)))
18065 hlines))))
18068 ;; We can use my own converter with HTML conversions
18070 ;; Need to use the code generator in table.el, with the original text.
18074 "Format a table into HTML."
18075 ;; Get rid of hlines at beginning and end
18081 ;; Check if the table has a marking column. If yes remove the
18082 ;; column and the special lines
18090 tbopen line fields html)
18102 ;; ignore this line
18104 ;; Break the line into fields
18120 html)))
18125 ;; Put in COL tags with the alignment (unfortuntely often ignored...)
18132 html)
18137 "Check if the table has a marking column.
18138 If yes remove the column and the special lines."
18143 lines))
18146 lines)
18151 nil ; ignore this line
18155 lines))))
18165 newstr))
18168 "Format a table generated by table.el into HTML.
18169 This conversion does *not* use `table-generate-source' from table.el.
18170 This has the advantage that Org-mode's HTML conversions can be used.
18171 But it has the disadvantage, that no cell- or row-spanning is allowed."
18174 fields html empty)
18184 html
18185 "<tr>"
18196 ;; Ignore this line
18198 ;; Break the line into fields and store the fields
18204 field-buffer))
18207 html))
18210 "Format a table into html, using `table-generate-source' from table.el.
18211 This has the advantage that cell- or row-spanning is allowed.
18212 But it has the disadvantage, that Org-mode's HTML conversions cannot be used."
18227 "Format time stamps in string S, or remove them."
18232 ;; never export CLOCK
18247 ;; Line break if line started and ended with time stamp stuff
18249 s
18253 r))))
18256 ;; convert & to &, < to < and > to >
18265 s)
18268 "Remove tags and time staps from lines going into the toc."
18274 s)
18277 "Prepare STRING for HTML export. Applies all active conversions.
18278 If there are links in the string, don't modify these."
18290 "Apply all active conversions to translate special ASCII to HTML."
18306 t t s))
18308 s)
18311 "Create a regular expression which will match a balanced sexp.
18312 Opening delimiter is LEFT, and closing delimiter is RIGHT, both given
18313 as single character strings.
18314 The regexp returned will match the entire expression including the
18315 delimiters. It will also define a single group which contains the
18316 match except for the outermost delimiters. The maximum depth of
18317 stacked delimiters is N. Escaping delimiters is not possible."
18339 "Convert sub- and superscripts in STRING to HTML."
18349 t t string)))
18352 string)
18355 "Apply emphasis."
18357 (setq string (replace-match (concat "\\1" (nth 2 (assoc (match-string 3 string) org-emphasis-alist)) "\\4" (nth 3 (assoc (match-string 3 string) org-emphasis-alist)) "\\5") t nil string)))
18358 string)
18362 "Insert <p>, but first close previous paragraph if any."
18367 "Close paragraph if there is one open."
18372 "Close <li> if necessary."
18377 "Insert a new level in HTML export.
18378 When TITLE is nil, just close all open levels."
18388 ;; If title is nil, this means this function is called to close
18389 ;; all levels, so the rest is done only if title is given
18401 t t title)))
18416 level head-count title level))
18421 "Terminate one level in HTML export."
18425 ;;; iCalendar export
18427 ;;;###autoload
18429 "Export current file as an iCalendar file.
18430 The iCalendar file will be located in the same directory as the Org-mode
18431 file, but with extension `.ics'."
18435 ;;;###autoload
18437 "Export all files in `org-agenda-files' to iCalendar .ics files.
18438 Each iCalendar file will be located in the same directory as the Org-mode
18439 file, but with extension `.ics'."
18443 ;;;###autoload
18445 "Export all files in `org-agenda-files' to a single combined iCalendar file.
18446 The file is stored under the name `org-combined-agenda-icalendar-file'."
18451 "Create iCalendar files for all elements of FILES.
18452 If COMBINE is non-nil, combine all calendar entries into a single large
18453 file and store it under the name `org-combined-agenda-icalendar-file'."
18457 org-export-publishing-directory)))
18458 file ical-file ical-buffer category started org-agenda-new-buffers)
18463 org-combined-agenda-icalendar-file
18496 "Hook run after an iCalendar file has been saved.
18497 The iCalendar buffer is still current when this hook is run.
18498 A good way to use this is to tell a desktop calenndar application to re-read
18502 "Print iCalendar entries for the current Org-mode file to `standard-output'.
18503 When COMBINE is non nil, add the category to each line."
18510 scheduledp deadlinep tmp pri category)
18516 inc t
18526 pos)
18529 ;; donep (org-entry-is-done-p)
18530 ))
18537 t t hd)))
18541 %s
18542 %s
18543 SUMMARY:%s
18544 CATEGORIES:%s
18548 hd category)))
18568 %s
18569 SUMMARY:%s
18570 CATEGORIES:%s
18571 SEQUENCE:1
18572 PRIORITY:%d
18573 STATUS:%s
18575 dts hd category pri status))))))))
18578 "Start an iCalendar file by inserting the header."
18584 VERSION:2.0
18585 X-WR-CALNAME:%s
18586 PRODID:-//%s//Emacs with Org-mode//EN
18587 X-WR-TIMEZONE:%s
18591 "Finish an iCalendar file by inserting the END statement."
18595 "Take a time string S and convert it to iCalendar format.
18596 KEYWORD is added in front, to make a complete line like DTSTART....
18597 When INC is non-nil, increase the hour by two (if time string contains
18598 a time), or the day by one (if it does not contain a time)."
18600 t2 fmt have-time time)
18612 ;;; XOXO export
18620 "Export the org buffer as XOXO.
18621 The XOXO buffer is named *xoxo-<source buffer name>*"
18623 ;; A quickie abstraction
18625 ;; Output everything as XOXO
18638 ;; Check the output buffer is empty.
18640 ;; Kick off the output
18657 ;; Handle level rendering
18674 )
18678 ;; And output the new li
18684 ;; Finally finish off the ol
18690 ;; Finish the buffer off and clean it up.
18695 )))
18698 ;;;; Key bindings
18700 ;; Make `C-c C-x' a prefix key
18703 ;; TAB key with modifiers
18710 ;; The following line is necessary under Suse GNU/Linux
18719 ;; Cursor keys with modifiers
18735 ;;; Extra keys for tty access.
18736 ;; We only set them when really needed because otherwise the
18737 ;; menus don't show the simple keys
18762 ;; All the other keys
18841 "Like `self-insert-command', use overwrite-mode for whitespace in tables.
18842 If the cursor is in a table looking at whitespace, the whitespace is
18843 overwritten, and the table is not marked as requiring realignment."
18847 ;; check if we blank the field, and if that triggers align
18852 ;; got extra space, this field does not determine column width
18854 ;; no extra space, this field may determine column width
18856 t)
18868 "Like `delete-backward-char', insert whitespace at field end in tables.
18869 When deleting backwards, in tables this function will insert whitespace in
18871 still be marked for re-alignment if the field did fill the entire column,
18872 because, in this case the deletion might narrow the column."
18885 ;; noalign: if there were two spaces at the end, this field
18886 ;; does not determine the width of the column.
18891 "Like `delete-char', but insert whitespace at field end in tables.
18892 When deleting characters, in tables this function will insert whitespace in
18894 still be marked for re-alignment if the field did fill the entire column,
18895 because, in this case the deletion might narrow the column."
18909 ;; noalign: if there were two spaces at the end, this field
18910 ;; does not determine the width of the column.
18915 ;; Make `delete-selection-mode' work with org-mode and orgtbl-mode
18921 ;; Make `flyspell-mode' delay after some commands
18927 ;; How to do this: Measure non-white length of current string
18928 ;; If equal to column width, we should realign.
18931 "In MAP, remap the functions given in COMMANDS.
18932 COMMANDS is a list of alternating OLDDEF NEWDEF command names."
18941 ;; If the user wants maximum table support, we need to hijack
18942 ;; some standard editing functions
18950 "Throw an error because Shift-Cursor command was applied in wrong context."
18954 "Global visibility cycling or move to previous table field.
18955 Calls `org-cycle' with argument t, or `org-table-previous-field', depending
18956 on context.
18957 See the individual commands for more information."
18967 "Promote subtree or delete table column.
18968 Calls `org-promote-subtree' or `org-table-delete-column', depending on context.
18969 See the individual commands for more information."
18978 "Demote subtree or insert table column.
18979 Calls `org-demote-subtree' or `org-table-insert-column', depending on context.
18980 See the individual commands for more information."
18989 "Move subtree up or kill table row.
18990 Calls `org-move-subtree-up' or `org-table-kill-row' or
18991 `org-move-item-up' depending on context. See the individual commands
18992 for more information."
19000 "Move subtree down or insert table row.
19001 Calls `org-move-subtree-down' or `org-table-insert-row' or
19002 `org-move-item-down', depending on context. See the individual
19003 commands for more information."
19012 "Promote heading or move table column to left.
19013 Calls `org-do-promote' or `org-table-move-column', depending on context.
19014 With no specific context, calls the Emacs default `backward-word'.
19015 See the individual commands for more information."
19025 "Demote subtree or move table column to right.
19026 Calls `org-do-demote' or `org-table-move-column', depending on context.
19027 With no specific context, calls the Emacs default `forward-word'.
19028 See the individual commands for more information."
19038 "Move subtree up or move table row up.
19039 Calls `org-move-subtree-up' or `org-table-move-row' or
19040 `org-move-item-up', depending on context. See the individual commands
19041 for more information."
19050 "Move subtree down or move table row down.
19051 Calls `org-move-subtree-down' or `org-table-move-row' or
19052 `org-move-item-down', depending on context. See the individual
19053 commands for more information."
19062 "Increase item in timestamp or increase priority of current headline.
19063 Calls `org-timestamp-up' or `org-priority-up', depending on context.
19064 See the individual commands for more information."
19073 "Decrease item in timestamp or decrease priority of current headline.
19074 Calls `org-timestamp-down' or `org-priority-down', depending on context.
19075 See the individual commands for more information."
19083 "Next TODO keyword or timestamp one day later, depending on context."
19091 "Previous TODO keyword or timestamp one day earlier, depending on context."
19099 "Copy region in table or copy current subtree.
19100 Calls `org-table-copy' or `org-copy-subtree', depending on context.
19101 See the individual commands for more information."
19107 "Cut region in table or cut current subtree.
19108 Calls `org-table-copy' or `org-cut-subtree', depending on context.
19109 See the individual commands for more information."
19115 "Paste rectangular region into table, or past subtree relative to level.
19116 Calls `org-table-paste-rectangle' or `org-paste-subtree', depending on context.
19117 See the individual commands for more information."
19124 "Set tags in headline, or update according to changed information at point.
19126 This command does many different things, depending on context:
19128 - If the cursor is in a headline, prompt for tags and insert them
19129 into the current line, aligned to `org-tags-column'. When called
19130 with prefix arg, realign all tags in the current buffer.
19132 - If the cursor is in one of the special #+KEYWORD lines, this
19133 triggers scanning the buffer for these lines and updating the
19134 information.
19136 - If the cursor is inside a table, realign the table. This command
19137 works even if the automatic table editor has been turned off.
19139 - If the cursor is on a #+TBLFM line, re-apply the formulas to
19140 the entire table.
19142 - If the cursor is inside a table created by the table.el package,
19143 activate that table.
19145 - If the current buffer is a remember buffer, close note and file it.
19146 with a prefix argument, file it without further interaction to the default
19147 location.
19149 - If the cursor is on a <<<target>>>, update radio targets and corresponding
19150 links in this buffer.
19152 - If the cursor is on a numbered item in a plain list, renumber the
19153 ordered list."
19158 org-occur-highlights
19159 org-latex-fragment-image-overlays)
19187 ;; Recalculate the table before this line
19198 "Restart Org-mode, to scan again for special lines.
19199 Also updates the keyword regular expressions."
19205 "Goto next table row or insert a newline.
19206 Calls `org-table-next-row' or `newline', depending on context.
19207 See the individual commands for more information."
19216 "Insert a new heading or wrap a region in a table.
19217 Calls `org-insert-heading' or `org-table-wrap-region', depending on context.
19218 See the individual commands for more information."
19225 ;;; Menu entries
19227 ;; Define the Org-mode menus
19234 "--"
19238 "--"
19250 "--"
19257 "--"
19260 ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
19262 "--"
19264 ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"]
19265 ["Iterate all" (lambda () (interactive) (org-table-recalculate '(16))) :active (org-at-table-p) :keys "C-u C-u C-c *"]
19266 "--"
19268 "--"
19273 org-table-toggle-formula-debugger
19276 org-table-toggle-coordinate-overlays
19278 "--"
19280 org-enable-table-editor)]
19284 "--"
19295 "--"
19297 "--"
19305 "--"
19310 "--"
19314 "--"
19319 "--"
19321 "--"
19326 ; ["Check and Tag Children" (org-toggle-archive-tag (4))
19327 ; :active t :keys "C-u C-c C-x C-a"]
19338 "--"
19340 ; ["Check and Move Children" (org-archive-subtree '(4))
19341 ; :active t :keys "C-u C-c C-x C-s"]
19342 )
19343 "--"
19352 "--"
19356 "--"
19357 ;; FIXME: why is this still here????
19358 ; ["Insert Checkbox" org-insert-todo-heading (org-in-item-p)]
19359 ; ["Toggle Checkbox" org-ctrl-c-ctrl-c (org-at-item-checkbox-p)]
19360 ; ["Insert [n/m] cookie" (progn (insert "[/]") (org-update-checkbox-count))
19361 ; (or (org-on-heading-p) (org-at-item-p))]
19362 ; ["Insert [%] cookie" (progn (insert "[%]") (org-update-checkbox-count))
19363 ; (or (org-on-heading-p) (org-at-item-p))]
19364 ; ["Update Statistics" org-update-checkbox-count t]
19365 )
19377 "--"
19380 "--"
19389 "--"
19393 org-done-string
19396 "--"
19404 "--"
19409 "--"
19412 "--"
19420 "--"
19432 "--"
19438 "--"
19441 "--"
19443 ))
19455 "Read documentation for Org-mode in the info system.
19456 With optional NODE, go directly to that node."
19479 ;;;; Documentation
19482 "Call the customize function with org as argument."
19487 "Create a full customization menu for Org-mode, insert it into the menu."
19494 "--"
19504 ;;;; Miscellaneous stuff
19507 ;;; Generally useful functions
19510 "Return a list of contexts of the current cursor position.
19511 If several contexts apply, all are returned.
19512 Each context entry is a list with a symbol naming the context, and
19513 two positions indicating start and end of the context. Possible
19514 contexts are:
19516 :headline anywhere in a headline
19517 :headline-stars on the leading stars in a headline
19518 :todo-keyword on a TODO keyword (including DONE) in a headline
19519 :tags on the TAGS in a headline
19520 :priority on the priority cookie in a headline
19521 :item on the first line of a plain list item
19522 :item-bullet on the bullet/number of a plain list item
19523 :checkbox on the checkbox in a plain list item
19524 :table in an org-mode table
19525 :table-special on a special filed in a table
19526 :table-table in a table.el table
19527 :link on a hyperlink
19528 :keyword on a keyword: SCHEDULED, DEADLINE, CLOSE,COMMENT, QUOTE.
19529 :target on a <<target>>
19530 :radio-target on a <<<radio-target>>>
19531 :latex-fragment on a LaTeX fragment
19532 :latex-preview on a LaTeX fragment with overlayed preview image
19534 This function expects the position to be visible because it uses font-lock
19535 faces as a help to recognize the following contexts: :table-special, :link,
19536 and :keyword."
19540 ;; First the large context
19559 clist)
19573 ;; Now the small context
19601 ;; FIXME: positions wrong.
19605 clist))
19608 "Check if point is inside a match of regexp.
19609 Normally only the current line is checked, but you can include NLINES extra
19610 lines both before and after point into the search.
19611 If VISUALLY is set, require that the cursor is not after the match but
19612 really on, so that the block visually is on the match."
19625 "Check if POINT is in match-group GROUP.
19626 If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the
19627 match. If the match group does ot exist or point is not inside it,
19628 return nil."
19634 t)))
19637 "Create a single property list from all plists in PLISTS.
19638 The process starts by copying the first list, and then setting properties
19639 from the other lists. Settings in the last list are the most significant
19640 ones and overrule settings in the other lists."
19642 p v ls)
19648 rtn))
19651 "Move the current line down. With prefix argument, move it past ARG lines."
19654 beg end pos)
19664 "Move the current line up. With prefix argument, move it past ARG lines."
19667 beg end pos)
19677 "Replace %-escapes in STRING with values in TABLE.
19679 The sequences in STRING may contain normal field width and padding information,
19681 so values can contain further %-escapes if they are define later in TABLE."
19683 e re rpl)
19690 string))
19694 "Return a section of LIST, from START to END.
19695 Counting starts at 1."
19704 "Is point inside a match of REGEXP in the current line?"
19713 nil))))
19716 "Like `find-buffer-visiting' but alway return the base buffer and
19717 not an indirect buffer"
19721 ;;; Paragraph filling stuff.
19722 ;; We want this to be just right, so use the full arsenal.
19725 "Indent line like previous, but further if previous was headline or item."
19742 ;; In the paragraph separator we include headlines, because filling
19743 ;; text in a line directly attached to a headline would otherwise
19744 ;; fill the headline as well.
19747 ;; The paragraph starter includes hand-formatted lists.
19750 ;; Inhibit auto-fill for headers, tables and fixed-width lines.
19751 ;; But only if the user has not turned off tables or fixed-width regions
19753 'auto-fill-inhibit-regexp
19762 ;; We use our own fill-paragraph function, to make sure that tables
19763 ;; and fixed-width regions are not wrapped. That function will pass
19764 ;; through to `fill-paragraph' when appropriate.
19766 ; Adaptive filling: To get full control, first make sure that
19767 ;; `adaptive-fill-regexp' never matches. Then install our own matcher.
19773 "Re-align a table, pass through to fill-paragraph if no table."
19781 ;; For reference, this is the default value of adaptive-fill-regexp
19782 ;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*"
19785 "Return a fill prefix for org-mode files.
19786 In particular, this makes sure hanging paragraphs for hand-formatted lists
19787 work correctly."
19795 ;; FIXME: these 2 functions are not in the right place.
19797 "Return regexp matching the file names of images."
19805 image-file-name-extensions)
19806 image-file-name-extensions)
19807 t)
19811 "Return non-nil if FILE is an image."
19815 ;;;; Functions extending outline functionality
19817 ;; C-a should go to the beginning of a *visible* line, also in the
19818 ;; new outline.el. I guess this should be patched into Emacs?
19820 "Go to the beginning of the current line. If that is invisible, continue
19821 to a visible line beginning. This makes the function of C-a more intuitive."
19825 nil
19836 "Check if point is at a character currently not visible."
19837 ;; Early versions of noutline don't have `outline-invisible-p'.
19843 "Check if point is at a character currently not visible."
19846 ;; Early versions of noutline don't have `outline-invisible-p'.
19859 "Move to the heading line of which the present line is a subheading.
19860 This function considers both visible and invisible heading lines.
19861 With argument, move up ARG levels."
19867 "Goto the next sibling, even if it is invisible.
19868 When PREVIOUS is set, go to the previous sibling instead. Returns t
19869 when a sibling was found. When none is found, return nil and don't
19870 move point."
19874 level l)
19884 nil)))
19887 "Show all siblings of the current headline."
19895 "Show an entry where even the heading is hidden."
19900 "Flag the current heading. FLAG non-nil means make invisible.
19901 When ENTRY is non-nil, show the entire entry."
19904 ;; Check if we should show the entire entry
19913 flag))))
19916 ;; This is an exact copy of the original function, but it uses
19917 ;; `org-back-to-heading', to make it work also in invisible
19918 ;; trees. And is uses an invisible-OK argument.
19919 ;; Under Emacs this is not needed, but the old outline.el needs this fix.
19929 ;; Go to end of line before heading
19932 ;; leave blank line before heading
19937 "Show everything after this heading at deeper levels."
19942 nil))
19945 "Show the body directly following this heading.
19946 Show the heading too, if it is currently invisible."
19955 nil)))
19958 "Make a regular expression for keyword lines."
19960 "^"
19966 ;; Make isearch reveal the necessary context
19968 "Reveal context after isearch exits."
19971 ;; Under XEmacs, the hook is run in the correct place,
19972 ;; we directly show the context.
19974 ;; In Emacs the hook runs *before* restoring the overlays.
19975 ;; So we have to use a one-time post-command-hook to do this.
19976 ;; (Emacs 22 has a special variable, see function `org-mode')
19978 isearch-mode-end-hook-quit)
19979 ;; Only when the isearch was not quitted.
19984 "Remove self from hook, and show context."
19988 ;;;; Repair problems with some other packages
19990 ;; Make `bookmark-jump' show the jump location if it was hidden.
19993 ;; We can use the hook
19995 ;; Hook not available, use advice
19997 "Make the position visible."
20001 "Unhide the current position, to show the bookmark location."
20008 ;; Make session.el ignore our circular variable
20012 ;;;; Experimental code
20015 "Convert a formula from internal to user representation."
20018 s))
20021 "Convert a formula from user to internal representation."
20024 s))
20027 "Convert spreadsheet references from AB7 to @7$28.
20028 Works for single references, but also for entire formulas and even the
20029 full TBLFM line."
20033 ;; format match, just advance
20042 t t s))))
20043 s))
20046 "Convert spreadsheet references from to @7$28 to AB7.
20047 Works for single references, but also for entire formulas and even the
20048 full TBLFM line."
20055 t t s)))
20060 t nil s)))
20061 s)
20064 "Convert a base 26 number represented by letters into an integer.
20065 For example: AB -> 28."
20071 n))
20074 "Convert an integer into a base 26 number represented by letters.
20075 For example: 28 -> AB."
20080 s))
20083 "Convert all references in this buffer, using FUNTION."
20095 "Convert all references in the buffer from B3 to @3$2 and back."
20105 "Shift the reference at point one row/hline up."
20109 "Shift the reference at point one row/hline down."
20113 "Shift the reference at point one field to the left."
20117 "Shift the reference at point one field to the right."
20128 ;; A B3-like reference
20134 ;; An internal reference
20140 "Re-match the group N, and replace it with the shifted refrence."
20145 t t)))
20148 "Shift a refrence part REF.
20149 If DECR is set, decrease the references row/column, else increase.
20150 If HLINE is set, this may be a hline reference, it certainly is not
20151 a translation reference."
20180 "Toggle the display of coordinates in the refrenced table."
20188 ;;;; Finish up
20194 ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
20195 ;;; org.el ends here