aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorCarsten Dominik2007-06-06 15:13:27 +0000
committerCarsten Dominik2007-06-06 15:13:27 +0000
commita3fbe8c4e5d022d61e14ab6d73d045b2cf2b2074 (patch)
tree3471b978843adecf9c90d8d1915f2ce1c85a17ec
parent12cd5d567ecbf8f4617d6a4eca42fb4b6d525bdb (diff)
downloademacs-a3fbe8c4e5d022d61e14ab6d73d045b2cf2b2074.tar.gz
emacs-a3fbe8c4e5d022d61e14ab6d73d045b2cf2b2074.zip
(org-export-region-as-html, org-replace-region-by-html)
(org-number-to-letters, org-table-fedit-finish) (org-normalize-color, org-table-fedit-ref-right) (org-date-to-gregorian, org-table-fedit-move) (org-table-convert-refs-to-rc, org-calendar-holiday) (org-table-fedit-toggle-ref-type, org-write-agenda) (org-colgroup-info-to-vline-list, org-agenda-todo-previousset) (org-defkey, org-encode-for-stdout) (org-indent-line-function, org-export-as-html-to-buffer) (org-store-agenda-views, org-update-mode-line) (org-find-if, org-delete-all) (org-table-fedit-convert-buffer, org-emphasize) (org-uniquify, org-table-fedit-lisp-indent) (org-table-fedit-scroll, org-get-todo-sequence-head) (org-table-fedit-scroll-down, org-table-fedit-line-down) (org-table-fedit-ref-left, org-agenda-export-csv-mapper) (org-table-fedit-toggle-coordinates, org-dvipng-color) (org-table-fedit-line-up, org-table-fedit-ref-down) (org-table-formula-from-user, org-mode-flyspell-verify) (org-cycle-show-empty-lines, org-ctrl-c-ret) (org-table-formula-to-user, org-diary-to-ical-string) (orgtbl-export, org-table-fedit-post-command) (org-closed-in-range, org-shiftcontrolright) (org-table-convert-refs-to-an, org-table-hline-and-move) (org-table-formula-less-p, org-format-table-ascii) (org-agenda-get-sexps, org-shift-refpart) (org-diary-sexp-entry, org-time-string-to-absolute) (org-table-show-reference, org-letters-to-number) (org-fix-agenda-info, org-table-fedit-ref-up) (org-table-fedit-shift-reference, org-table-fedit-abort) (org-closest-date, org-shiftcontrolleft) (org-at-heading-or-item-p, org-rematch-and-replace) (org-agenda-todo-nextset, org-export-grab-title-from-buffer): New function. (org-table-edit-scroll-down, org-finish-edit-formulas) (org-table-edit-next-field, org-abort-edit-formulas) (org-font-lock-level, org-export-find-first-heading-line) (org-table-edit-line-down, org-table-edit-backward-field) (org-edit-formula-lisp-indent, org-table-edit-move) (org-check-log-option, org-this-word) (org-table-edit-line-up, org-table-edit-formulas-post-command) (org-agenda-file-to-end, org-expand-file-name) (org-fake-empty-table-line, org-table-edit-scroll) (org-toggle-log-option, org-show-reference): Function removed. (org-inhibit-invisibility, org-table-formula-make-cmp-string): New defsubst. (org-unmodified, org-batch-store-agenda-views) (org-batch-agenda-csv): New macro. (org-agenda-export): New customization group. (org-agenda-skip-deadline-if-done, org-agenda-remove-tags) (org-highest-priority, org-agenda-exporter-settings) (org-log-done-with-time, org-replace-disputed-keys) (org-format-latex-header, org-export-table-header-tags) (org-cycle-separator-lines, org-export-table-data-tags) (org-icalendar-include-sexps) (org-empty-line-terminates-plain-lists) (org-log-repeat, org-special-ctrl-a) (org-table-use-standard-references, org-disputed-keys) (org-export-skip-text-before-1st-heading, org-agenda-with-colors) (org-agenda-export-html-style): New option. (org-allow-auto-repeat, org-agenda-remove-tags-when-in-prefix) (org-CUA-compatible): Option removed. (org-agenda-structure, org-sexp-date): New face. (org-todo-keywords-for-agenda, org-not-done-keywords) (org-planning-or-clock-line-re, org-agenda-name) (org-table-colgroup-info, org-todo-sets) (constants-unit-system, org-clock-mode-line-entry) (org-mode-line-timer, org-table-current-begin-pos) (org-todo-keywords-1, org-mode-line-string) (org-table-clean-did-remove-column, org-table-fedit-map) (org-clock-heading, org-table-buffer-is-an) (org-agenda-info, org-done-keywords) (org-done-keywords-for-agenda, org-todo-heads) (org-todo-kwd-alist, org-clock-start-time): New variable. (org-todo-kwd-priority-p, org-edit-formulas-map) (org-repeat-re, org-todo-kwd-max-priority) (org-version, org-done-string) (org-table-clean-did-remove-column-1, org-disputed-keys): Variable removed. (org-table-translate-regexp, org-repeat-re, org-version): New constant. (org-ts-lengths): Constant removed. (org-follow-gnus-link): Don't ask how many articles to read. (org-export-find-first-export-line): Renamed from `org-export-find-first-heading'. Use `org-export-skip-text-before-1st-heading'. (org-table-fedit-post-command): Renamed from `org-table-edit-formulas-post-command'. (org-table-fedit-finish): Renamed from `org-finish-edit-formulas'. (org-table-fedit-abort): Renamed from `org-abort-edit-formulas'. (org-table-fedit-lisp-indent): Renamed from `org-edit-formula-lisp-indent'. (org-table-show-reference): Renamed from `org-show-reference'. (org-table-store-formulas): Use `org-table-formula-less-p'. (org-table-edit-formulas): Position cursor to current field equation. (org-update-checkbox-count, org-hide-archived-subtrees) (org-timestamp-up-day, org-timestamp-down-day) (org-shiftmetaleft, org-shiftmetaright, org-shiftmetaup) (org-shiftmetadown, org-metaleft, org-metaright, org-metaup) (org-metadown, org-shiftup, org-shiftdown, org-shiftright) (org-shiftleft, org-ctrl-c-ctrl-c, org-context): Let `org-on-heading-p' also check for invisible heading. (org-read-date): Match am/pm times. (org-eval-in-calendar): Fix default date in prompt.
-rw-r--r--lisp/textmodes/org.el4484
1 files changed, 3175 insertions, 1309 deletions
diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el
index 8ee12638dee..2758f12a17f 100644
--- a/lisp/textmodes/org.el
+++ b/lisp/textmodes/org.el
@@ -1,11 +1,11 @@
1;;;; org.el --- Outline-based notes management and organize 1;;; org.el --- Outline-based notes management and organizer
2;; Carstens outline-mode for keeping track of everything. 2;; Carstens outline-mode for keeping track of everything.
3;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
4;; 4;;
5;; Author: Carsten Dominik <dominik at science dot uva dot nl> 5;; Author: Carsten Dominik <dominik at science dot uva dot nl>
6;; Keywords: outlines, hypermedia, calendar, wp 6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ 7;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
8;; Version: 4.67d 8;; Version: 4.77
9;; 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11;; 11;;
@@ -83,7 +83,7 @@
83 83
84;;; Version 84;;; Version
85 85
86(defvar org-version "4.67c" 86(defconst org-version "4.76"
87 "The version number of the file org.el.") 87 "The version number of the file org.el.")
88(defun org-version () 88(defun org-version ()
89 (interactive) 89 (interactive)
@@ -153,21 +153,13 @@ has been set."
153 :group 'org-startup 153 :group 'org-startup
154 :type 'boolean) 154 :type 'boolean)
155 155
156(defcustom org-CUA-compatible nil 156(defcustom org-replace-disputed-keys nil
157 "Non-nil means use alternative key bindings for S-<cursor movement>. 157 "Non-nil means use alternative key bindings for some keys.
158Org-mode used S-<cursor movement> for changing timestamps and priorities. 158Org-mode uses S-<cursor> keys for changing timestamps and priorities.
159S-<cursor movement> is also used for example by `CUA-mode' to select text. 159These keys are also used by other packages like `CUA-mode' or `windmove.el'.
160If you want to use Org-mode together with `CUA-mode', Org-mode needs to use 160If you want to use Org-mode together with one of these other modes,
161alternative bindings. Setting this variable to t will replace the following 161or more generally if you would like to move some Org-mode commands to
162keys both in Org-mode and in the Org-agenda buffer. 162other keys, set this variable and configure the keys with the variable
163
164S-RET -> C-S-RET
165S-up -> M-p
166S-down -> M-n
167S-left -> M--
168S-right -> M-+
169
170If you do not like the alternative keys, take a look at the variable
171`org-disputed-keys'. 163`org-disputed-keys'.
172 164
173This option is only relevant at load-time of Org-mode, and must be set 165This option is only relevant at load-time of Org-mode, and must be set
@@ -176,21 +168,47 @@ become effective."
176 :group 'org-startup 168 :group 'org-startup
177 :type 'boolean) 169 :type 'boolean)
178 170
179(defvar org-disputed-keys 171(if (fboundp 'defvaralias)
180 '((S-up [(shift up)] [(meta ?p)]) 172 (defvaralias 'org-CUA-compatible 'org-replace-disputed-keys))
181 (S-down [(shift down)] [(meta ?n)]) 173
182 (S-left [(shift left)] [(meta ?-)]) 174(defcustom org-disputed-keys
183 (S-right [(shift right)] [(meta ?+)]) 175 '(([(shift up)] . [(meta p)])
184 (S-return [(shift return)] [(control shift return)])) 176 ([(shift down)] . [(meta n)])
177 ([(shift left)] . [(meta -)])
178 ([(shift right)] . [(meta +)])
179 ([(control shift right)] . [(meta shift +)])
180 ([(control shift left)] . [(meta shift -)]))
185 "Keys for which Org-mode and other modes compete. 181 "Keys for which Org-mode and other modes compete.
186This is an alist, cars are symbols for lookup, 1st element is the default key, 182This is an alist, cars are the default keys, second element specifies
187second element will be used when `org-CUA-compatible' is t.") 183the alternative to use when `org-replace-disputed-keys' is t.
184
185Keys can be specified in any syntax supported by `define-key'.
186The value of this option takes effect only at Org-mode's startup,
187therefore you'll have to restart Emacs to apply it after changing."
188 :group 'org-startup
189 :type 'alist)
188 190
189(defun org-key (key) 191(defun org-key (key)
190 "Select a key according to `org-CUA-compatible'." 192 "Select key according to `org-replace-disputed-keys' and `org-disputed-keys'.
191 (nth (if org-CUA-compatible 2 1) 193Or return the original if not disputed."
192 (or (assq key org-disputed-keys) 194 (if org-replace-disputed-keys
193 (error "Invalid Key %s in `org-key'" key)))) 195 (let* ((nkey (key-description key))
196 (x (org-find-if (lambda (x)
197 (equal (key-description (car x)) nkey))
198 org-disputed-keys)))
199 (if x (cdr x) key))
200 key))
201
202(defun org-find-if (predicate seq)
203 (catch 'exit
204 (while seq
205 (if (funcall predicate (car seq))
206 (throw 'exit (car seq))
207 (pop seq)))))
208
209(defun org-defkey (keymap key def)
210 "Define a key, possibly translated, as returned by `org-key'."
211 (define-key keymap (org-key key) def))
194 212
195(defcustom org-ellipsis nil 213(defcustom org-ellipsis nil
196 "The ellipsis to use in the Org-mode outline. 214 "The ellipsis to use in the Org-mode outline.
@@ -255,7 +273,9 @@ An entry can be toggled between QUOTE and normal with
255 :group 'org-keywords 273 :group 'org-keywords
256 :type 'string) 274 :type 'string)
257 275
258(defvar org-repeat-re "\\<REPEAT(\\([-+ 0-9dwmy]+\\))" 276(defconst org-repeat-re
277 (concat "\\(?:\\<\\(?:" org-scheduled-string "\\|" org-deadline-string "\\)"
278 " +<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*\\)\\(\\+[0-9]+[dwmy]\\)")
259 "Regular expression for specifying repeated events. 279 "Regular expression for specifying repeated events.
260After a match, group 1 contains the repeat expression.") 280After a match, group 1 contains the repeat expression.")
261 281
@@ -304,7 +324,7 @@ contexts. Valid contexts are
304 (const default)) 324 (const default))
305 (boolean))))) 325 (boolean)))))
306 326
307(defcustom org-show-following-heading '((default . t)) 327(defcustom org-show-following-heading '((default . nil))
308 "Non-nil means, show following heading when revealing a location. 328 "Non-nil means, show following heading when revealing a location.
309Org-mode often shows locations in an org-mode file which might have 329Org-mode often shows locations in an org-mode file which might have
310been invisible before. When this is set, the heading following the 330been invisible before. When this is set, the heading following the
@@ -386,6 +406,7 @@ nil Never
386white Only in completely white lines 406white Only in completely white lines
387whitestart Only at the beginning of lines, before the first non-white char. 407whitestart Only at the beginning of lines, before the first non-white char.
388t Everywhere except in headlines 408t Everywhere except in headlines
409exc-hl-bol Everywhere except at the start of a headline
389If TAB is used in a place where it does not emulate TAB, the current subtree 410If TAB is used in a place where it does not emulate TAB, the current subtree
390visibility is cycled." 411visibility is cycled."
391 :group 'org-cycle 412 :group 'org-cycle
@@ -393,9 +414,25 @@ visibility is cycled."
393 (const :tag "Only in completely white lines" white) 414 (const :tag "Only in completely white lines" white)
394 (const :tag "Before first char in a line" whitestart) 415 (const :tag "Before first char in a line" whitestart)
395 (const :tag "Everywhere except in headlines" t) 416 (const :tag "Everywhere except in headlines" t)
417 (const :tag "Everywhere except at bol in headlines" exc-hl-bol)
396 )) 418 ))
397 419
420(defcustom org-cycle-separator-lines 2
421 "Number of empty lines needed to keep an empty line between collapsed trees.
422If you leave an empty line between the end of a subtree and the following
423headline, this empty line is hidden when the subtree is folded.
424Org-mode will leave (exactly) one empty line visible if the number of
425empty lines is equal or larger to the number given in this variable.
426So the default 2 means, at least 2 empty lines after the end of a subtree
427are needed to produce free space between a collapsed subtree and the
428following headline.
429
430Special case: when 0, never leave empty lines in collapsed view."
431 :group 'org-cycle
432 :type 'integer)
433
398(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees 434(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees
435 org-cycle-show-empty-lines
399 org-optimize-window-after-visibility-change) 436 org-optimize-window-after-visibility-change)
400 "Hook that is run after `org-cycle' has changed the buffer visibility. 437 "Hook that is run after `org-cycle' has changed the buffer visibility.
401The function(s) in this hook must accept a single argument which indicates 438The function(s) in this hook must accept a single argument which indicates
@@ -406,12 +443,20 @@ the values `folded', `children', or `subtree'."
406 :group 'org-cycle 443 :group 'org-cycle
407 :type 'hook) 444 :type 'hook)
408 445
409
410(defgroup org-edit-structure nil 446(defgroup org-edit-structure nil
411 "Options concerning structure editing in Org-mode." 447 "Options concerning structure editing in Org-mode."
412 :tag "Org Edit Structure" 448 :tag "Org Edit Structure"
413 :group 'org-structure) 449 :group 'org-structure)
414 450
451(defcustom org-special-ctrl-a nil
452 "Non-nil means `C-a' behaves specially in headlines.
453When set, `C-a' will bring back the cursor to the beginning of the
454headline text, i.e. after the stars and after a possible TODO keyword.
455When the cursor is already at that position, another `C-a' will bring
456it to the beginning of the line."
457 :group 'org-edit-structure
458 :type 'boolean)
459
415(defcustom org-odd-levels-only nil 460(defcustom org-odd-levels-only nil
416 "Non-nil means, skip even levels and only use odd levels for the outline. 461 "Non-nil means, skip even levels and only use odd levels for the outline.
417This has the effect that two stars are being added/taken away in 462This has the effect that two stars are being added/taken away in
@@ -783,6 +828,18 @@ calls `table-recognize-table'."
783 :tag "Org Table Calculation" 828 :tag "Org Table Calculation"
784 :group 'org-table) 829 :group 'org-table)
785 830
831(defcustom org-table-use-standard-references t
832 "Should org-mode work with table refrences like B3 instead of @3$2?
833Possible values are:
834nil never use them
835from accept as input, do not present for editing
836t: accept as input and present for editing"
837 :group 'org-table-calculation
838 :type '(choice
839 (const :tag "Never, don't even check unser input for them" nil)
840 (const :tag "Always, both as user input, and when editing" t)
841 (const :tag "Convert user input, don't offer during editing" 'from)))
842
786(defcustom org-table-copy-increment t 843(defcustom org-table-copy-increment t
787 "Non-nil means, increment when copying current field with \\[org-table-copy-down]." 844 "Non-nil means, increment when copying current field with \\[org-table-copy-down]."
788 :group 'org-table-calculation 845 :group 'org-table-calculation
@@ -815,9 +872,6 @@ the command \\[org-table-eval-formula]."
815 :group 'org-table-calculation 872 :group 'org-table-calculation
816 :type 'boolean) 873 :type 'boolean)
817 874
818;; FIXME this is also a variable that makes Org-mode files non-portable
819;; Maybe I should have a #+ options for constants?
820;; How about the SI/cgs issue?
821(defcustom org-table-formula-use-constants t 875(defcustom org-table-formula-use-constants t
822 "Non-nil means, interpret constants in formulas in tables. 876 "Non-nil means, interpret constants in formulas in tables.
823A constant looks like `$c' or `$Grav' and will be replaced before evaluation 877A constant looks like `$c' or `$Grav' and will be replaced before evaluation
@@ -826,6 +880,8 @@ from the `constants.el' package."
826 :group 'org-table-calculation 880 :group 'org-table-calculation
827 :type 'boolean) 881 :type 'boolean)
828 882
883;; FIXME this is also a variable that makes Org-mode files non-portable
884;; Maybe I should have a #+ options for constants?
829(defcustom org-table-formula-constants nil 885(defcustom org-table-formula-constants nil
830 "Alist with constant names and values, for use in table formulas. 886 "Alist with constant names and values, for use in table formulas.
831The car of each element is a name of a constant, without the `$' before it. 887The car of each element is a name of a constant, without the `$' before it.
@@ -852,7 +908,7 @@ Automatically means, when TAB or RET or C-c C-c are pressed in the line."
852 :group 'org) 908 :group 'org)
853 909
854(defvar org-link-abbrev-alist-local nil 910(defvar org-link-abbrev-alist-local nil
855 "buffer-local version of `org-link-abbrev-alist', which see. 911 "Buffer-local version of `org-link-abbrev-alist', which see.
856The value of this is taken from the #+LINK lines.") 912The value of this is taken from the #+LINK lines.")
857(make-variable-buffer-local 'org-link-abbrev-alist-local) 913(make-variable-buffer-local 'org-link-abbrev-alist-local)
858 914
@@ -1318,30 +1374,64 @@ When nil, new notes will be filed to the end of a file or entry."
1318 :tag "Org Progress" 1374 :tag "Org Progress"
1319 :group 'org-time) 1375 :group 'org-time)
1320 1376
1321(defcustom org-todo-keywords '("TODO" "DONE") 1377(defcustom org-todo-keywords '((sequence "TODO" "DONE"))
1322 "List of TODO entry keywords. 1378 "List of TODO entry keyword sequences and their interpretation.
1323\\<org-mode-map>By default, this is '(\"TODO\" \"DONE\"). The last entry in the list is 1379\\<org-mode-map>This is a list of sequences.
1324considered to mean that the entry is \"done\". All the other mean that 1380
1325action is required, and will make the entry show up in todo lists, diaries 1381Each sequence starts with a symbol, either `sequence' or `type',
1326etc. 1382indicating if the keywords should be interpreted as a sequence of
1327The command \\[org-todo] cycles an entry through these states, and an 1383action steps, or as different types of TODO items. The first
1384keywords are states requiring action - these states will select a headline
1385for inclusion into the global TODO list Org-mode produces. If one of
1386the \"keywords\" is the vertical bat \"|\" the remaining keywords
1387signify that no further action is necessary. If \"|\" is not found,
1388the last keyword is treated as the only DONE state of the sequence.
1389
1390The command \\[org-todo] cycles an entry through these states, and one
1328additional state where no keyword is present. For details about this 1391additional state where no keyword is present. For details about this
1329cycling, see also the variable `org-todo-interpretation' 1392cycling, see the manual.
1330Changes become only effective after restarting Emacs." 1393
1394TODO keywords and interpretation can also be set on a per-file basis with
1395the special #+SEQ_TODO and #+TYP_TODO lines.
1396
1397For backward compatibility, this variable may also be just a list
1398of keywords - in this case the interptetation (sequence or type) will be
1399taken from the (otherwise obsolete) variable `org-todo-interpretation'."
1331 :group 'org-todo 1400 :group 'org-todo
1332 :group 'org-keywords 1401 :group 'org-keywords
1333 :type '(repeat (string :tag "Keyword"))) 1402 :type '(choice
1403 (repeat :tag "Old syntax, just keywords"
1404 (string :tag "Keyword"))
1405 (repeat :tag "New syntax"
1406 (cons
1407 (choice
1408 :tag "Interpretation"
1409 (const :tag "Sequence (cycling hits every state)" sequence)
1410 (const :tag "Type (cycling directly to DONE)" type))
1411 (repeat
1412 (string :tag "Keyword"))))))
1413
1414(defvar org-todo-keywords-1 nil)
1415(make-variable-buffer-local 'org-todo-keywords-1)
1416(defvar org-todo-keywords-for-agenda nil)
1417(defvar org-done-keywords-for-agenda nil)
1418(defvar org-not-done-keywords nil)
1419(make-variable-buffer-local 'org-not-done-keywords)
1420(defvar org-done-keywords nil)
1421(make-variable-buffer-local 'org-done-keywords)
1422(defvar org-todo-heads nil)
1423(make-variable-buffer-local 'org-todo-heads)
1424(defvar org-todo-sets nil)
1425(make-variable-buffer-local 'org-todo-sets)
1426(defvar org-todo-kwd-alist nil)
1427(make-variable-buffer-local 'org-todo-kwd-alist)
1334 1428
1335(defcustom org-todo-interpretation 'sequence 1429(defcustom org-todo-interpretation 'sequence
1336 "Controls how TODO keywords are interpreted. 1430 "Controls how TODO keywords are interpreted.
1337This variable is only relevant if `org-todo-keywords' contains more than two 1431This variable is in principle obsolete and is only used for
1338states. \\<org-mode-map>Possible values are `sequence' and `type'. 1432backward compatibility, if the interpretation of todo keywords is
1339 1433not given already in `org-todo-keywords'. See that variable for
1340When `sequence', \\[org-todo] will always switch to the next state in the 1434more information."
1341`org-todo-keywords' list. When `type', \\[org-todo] only cycles from state
1342to state when executed several times in direct succession. Otherwise, it
1343switches directly to DONE from any state.
1344See the manual for more information."
1345 :group 'org-todo 1435 :group 'org-todo
1346 :group 'org-keywords 1436 :group 'org-keywords
1347 :type '(choice (const sequence) 1437 :type '(choice (const sequence)
@@ -1393,6 +1483,12 @@ the following lines anywhere in the buffer:
1393 (const :tag "when TODO state changes" state) 1483 (const :tag "when TODO state changes" state)
1394 (const :tag "when clocking out" clock-out)))) 1484 (const :tag "when clocking out" clock-out))))
1395 1485
1486(defcustom org-log-done-with-time t
1487 "Non-nil means, the CLOSED time stamp will contain date and time.
1488When nil, only the date will be recorded."
1489 :group 'org-progress
1490 :type 'boolean)
1491
1396(defcustom org-log-note-headings 1492(defcustom org-log-note-headings
1397 '((done . "CLOSING NOTE %t") 1493 '((done . "CLOSING NOTE %t")
1398 (state . "State %-12s %t") 1494 (state . "State %-12s %t")
@@ -1414,11 +1510,9 @@ empty string.
1414 state) string) 1510 state) string)
1415 (cons (const :tag "Heading when clocking out" clock-out) string))) 1511 (cons (const :tag "Heading when clocking out" clock-out) string)))
1416 1512
1417(defcustom org-allow-auto-repeat t 1513(defcustom org-log-repeat t
1418 "Non-nil means, find REPEAT cookies in entries and apply them. 1514 "Non-nil means, prompt for a note when REPEAT is resetting a TODO entry.
1419A repeat cookie looks like REPEAT(+1m) and causes deadlines and schedules 1515When nil, no note will be taken."
1420to repeat themselves shifted by a certain amount of time, each time an
1421entry is marked DONE."
1422 :group 'org-todo 1516 :group 'org-todo
1423 :group 'org-progress 1517 :group 'org-progress
1424 :type 'boolean) 1518 :type 'boolean)
@@ -1428,14 +1522,21 @@ entry is marked DONE."
1428 :tag "Org Priorities" 1522 :tag "Org Priorities"
1429 :group 'org-todo) 1523 :group 'org-todo)
1430 1524
1431(defcustom org-default-priority ?B 1525(defcustom org-highest-priority ?A
1432 "The default priority of TODO items. 1526 "The highest priority of TODO items. A character like ?A, ?B etc.
1433This is the priority an item get if no explicit priority is given." 1527Must have a smaller ASCII number than `org-lowest-priority'."
1434 :group 'org-priorities 1528 :group 'org-priorities
1435 :type 'character) 1529 :type 'character)
1436 1530
1437(defcustom org-lowest-priority ?C 1531(defcustom org-lowest-priority ?C
1438 "The lowest priority of TODO items. A character like ?A, ?B etc." 1532 "The lowest priority of TODO items. A character like ?A, ?B etc.
1533Must have a larger ASCII number than `org-highest-priority'."
1534 :group 'org-priorities
1535 :type 'character)
1536
1537(defcustom org-default-priority ?B
1538 "The default priority of TODO items.
1539This is the priority an item get if no explicit priority is given."
1439 :group 'org-priorities 1540 :group 'org-priorities
1440 :type 'character) 1541 :type 'character)
1441 1542
@@ -1612,7 +1713,7 @@ make sure all corresponding TODO items find their way into the list."
1612 "Variable used by org files to set a category for agenda display. 1713 "Variable used by org files to set a category for agenda display.
1613Such files should use a file variable to set it, for example 1714Such files should use a file variable to set it, for example
1614 1715
1615 -*- mode: org; org-category: \"ELisp\" 1716# -*- mode: org; org-category: \"ELisp\"
1616 1717
1617or contain a special line 1718or contain a special line
1618 1719
@@ -1654,17 +1755,75 @@ forth between agenda and calendar."
1654 :group 'org-agenda 1755 :group 'org-agenda
1655 :type 'sexp) 1756 :type 'sexp)
1656 1757
1758(defgroup org-agenda-export nil
1759 "Options concerning exporting agenda views in Org-mode."
1760 :tag "Org Agenda Export"
1761 :group 'org-agenda)
1762
1763(defcustom org-agenda-with-colors t
1764 "Non-nil means, use colors in agenda views."
1765 :group 'org-agenda-export
1766 :type 'boolean)
1767
1768(defcustom org-agenda-exporter-settings nil
1769 "Alist of variable/value pairs that should be active during agenda export.
1770This is a good place to set uptions for ps-print and for htmlize."
1771 :group 'org-agenda-export
1772 :type '(repeat
1773 (list
1774 (variable)
1775 (sexp :tag "Value"))))
1776
1777(defcustom org-agenda-export-html-style ""
1778 "The style specification for exported HTML Agenda files.
1779If this variable contains a string, it will replace the default <style>
1780section as produced by `htmlize'.
1781Since there are different ways of setting style information, this variable
1782needs to contain the full HTML structure to provide a style, including the
1783surrounding HTML tags. The style specifications should include definitions
1784the fonts used by the agenda, here is an example:
1785
1786 <style type=\"text/css\">
1787 p { font-weight: normal; color: gray; }
1788 .org-agenda-structure {
1789 font-size: 110%;
1790 color: #003399;
1791 font-weight: 600;
1792 }
1793 .org-todo {
1794 color: #cc6666;Week-agenda:
1795 font-weight: bold;
1796 }
1797 .org-done {
1798 color: #339933;
1799 }
1800 .title { text-align: center; }
1801 .todo, .deadline { color: red; }
1802 .done { color: green; }
1803 </style>
1804
1805or, if you want to keep the style in a file,
1806
1807 <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
1808
1809As the value of this option simply gets inserted into the HTML <head> header,
1810you can \"misuse\" it to also add other text to the header. However,
1811<style>...</style> is required, if not present the variable will be ignored."
1812 :group 'org-agenda-export
1813 :group 'org-export-html
1814 :type 'string)
1815
1657(defgroup org-agenda-custom-commands nil 1816(defgroup org-agenda-custom-commands nil
1658 "Options concerning agenda views in Org-mode." 1817 "Options concerning agenda views in Org-mode."
1659 :tag "Org Agenda Custom Commands" 1818 :tag "Org Agenda Custom Commands"
1660 :group 'org-agenda) 1819 :group 'org-agenda)
1661 1820
1662(defcustom org-agenda-custom-commands '(("w" todo "WAITING")) 1821(defcustom org-agenda-custom-commands nil
1663 "Custom commands for the agenda. 1822 "Custom commands for the agenda.
1664These commands will be offered on the splash screen displayed by the 1823These commands will be offered on the splash screen displayed by the
1665agenda dispatcher \\[org-agenda]. Each entry is a list like this: 1824agenda dispatcher \\[org-agenda]. Each entry is a list like this:
1666 1825
1667 (key type match options) 1826 (key type match options files)
1668 1827
1669key The key (a single char as a string) to be associated with the command. 1828key The key (a single char as a string) to be associated with the command.
1670type The command type, any of the following symbols: 1829type The command type, any of the following symbols:
@@ -1680,11 +1839,16 @@ match What to search for:
1680 - a regular expression for occur searches 1839 - a regular expression for occur searches
1681options A list of option setttings, similar to that in a let form, so like 1840options A list of option setttings, similar to that in a let form, so like
1682 this: ((opt1 val1) (opt2 val2) ...) 1841 this: ((opt1 val1) (opt2 val2) ...)
1842files A list of files file to write the produced agenda buffer to
1843 with the command `org-store-agenda-views'.
1844 If a file name ends in \".html\", an HTML version of the buffer
1845 is written out. If it ends in \".ps\", a postscript version is
1846 produced. Otherwide, only the plain text is written to the file.
1683 1847
1684You can also define a set of commands, to create a composite agenda buffer. 1848You can also define a set of commands, to create a composite agenda buffer.
1685In this case, an entry looks like this: 1849In this case, an entry looks like this:
1686 1850
1687 (key desc (cmd1 cmd2 ...) general-options) 1851 (key desc (cmd1 cmd2 ...) general-options file)
1688 1852
1689where 1853where
1690 1854
@@ -1695,19 +1859,22 @@ cmd An agenda command, similar to the above. However, tree commands
1695 (agenda) 1859 (agenda)
1696 (alltodo) 1860 (alltodo)
1697 (stuck) 1861 (stuck)
1698 (todo \"match\" options) 1862 (todo \"match\" options files)
1699 (tags \"match\" options ) 1863 (tags \"match\" options files)
1700 (tags-todo \"match\" options) 1864 (tags-todo \"match\" options files)
1701 1865
1702Each command can carry a list of options, and another set of options can be 1866Each command can carry a list of options, and another set of options can be
1703given for the whole set of commands. Individual command options take 1867given for the whole set of commands. Individual command options take
1704precedence over the general options." 1868precedence over the general options."
1705 :group 'org-agenda-custom-commands 1869 :group 'org-agenda-custom-commands
1706 :type '(repeat 1870 :type '(repeat
1707 (choice 1871 (choice :value ("a" tags "" nil)
1708 (list :tag "Single command" 1872 (list :tag "Single command"
1709 (string :tag "Key") 1873 (string :tag "Key")
1710 (choice 1874 (choice
1875 (const :tag "Agenda" agenda)
1876 (const :tag "TODO list" alltodo)
1877 (const :tag "Stuck projects" stuck)
1711 (const :tag "Tags search (all agenda files)" tags) 1878 (const :tag "Tags search (all agenda files)" tags)
1712 (const :tag "Tags search of TODO entries (all agenda files)" tags-todo) 1879 (const :tag "Tags search of TODO entries (all agenda files)" tags-todo)
1713 (const :tag "TODO keyword search (all agenda files)" todo) 1880 (const :tag "TODO keyword search (all agenda files)" todo)
@@ -1717,7 +1884,8 @@ precedence over the general options."
1717 (symbol :tag "Other, user-defined function")) 1884 (symbol :tag "Other, user-defined function"))
1718 (string :tag "Match") 1885 (string :tag "Match")
1719 (repeat :tag "Local options" 1886 (repeat :tag "Local options"
1720 (list (variable :tag "Option") (sexp :tag "Value")))) 1887 (list (variable :tag "Option") (sexp :tag "Value")))
1888 (option (repeat :tag "Export" (file :tag "Export to"))))
1721 (list :tag "Command series, all agenda files" 1889 (list :tag "Command series, all agenda files"
1722 (string :tag "Key") 1890 (string :tag "Key")
1723 (string :tag "Description") 1891 (string :tag "Description")
@@ -1756,20 +1924,24 @@ precedence over the general options."
1756 1924
1757 (repeat :tag "General options" 1925 (repeat :tag "General options"
1758 (list (variable :tag "Option") 1926 (list (variable :tag "Option")
1759 (sexp :tag "Value"))))))) 1927 (sexp :tag "Value")))
1928 (option (repeat :tag "Export" (file :tag "Export to")))))))
1760 1929
1761(defcustom org-stuck-projects 1930(defcustom org-stuck-projects
1762 '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil) 1931 '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "")
1763 "How to identify stuck projects. 1932 "How to identify stuck projects.
1764This is a list of three items: 1933This is a list of four items:
17651. A tags/todo matcher string that is used to identify a project. 19341. A tags/todo matcher string that is used to identify a project.
1766 The entire tree below a headline matched by this is considered a project. 1935 The entire tree below a headline matched by this is considered one project.
17672. A list of TODO keywords itentifying non-stuck projects. 19362. A list of TODO keywords identifying non-stuck projects.
1768 If the project subtree contains any headline with one of these todo 1937 If the project subtree contains any headline with one of these todo
1769 keywords, the project is consitered to be not stuck. 1938 keywords, the project is considered to be not stuck. If you specify
1939 \"*\" as a keyword, any TODO keyword will mark the project unstuck.
17703. A list of tags identifying non-stuck projects. 19403. A list of tags identifying non-stuck projects.
1771 If the project subtree contains any headline with one of these tags, 1941 If the project subtree contains any headline with one of these tags,
1772 the project is consitered to be not stuck. 1942 the project is considered to be not stuck. If you specify \"*\" as
1943 a tag, any tag will mark the project unstuck.
19444. An arbitrary regular expression matching non-stuck projects.
1773 1945
1774After defining this variable, you may use \\[org-agenda-list-stuck-projects] 1946After defining this variable, you may use \\[org-agenda-list-stuck-projects]
1775or `C-c a #' to produce the list." 1947or `C-c a #' to produce the list."
@@ -1777,7 +1949,8 @@ or `C-c a #' to produce the list."
1777 :type '(list 1949 :type '(list
1778 (string :tag "Tags/TODO match to identify a project") 1950 (string :tag "Tags/TODO match to identify a project")
1779 (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string)) 1951 (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string))
1780 (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string)))) 1952 (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string))
1953 (regexp :tag "Projects are *not* stuck if this regexp matches\ninside the subtree")))
1781 1954
1782 1955
1783(defgroup org-agenda-skip nil 1956(defgroup org-agenda-skip nil
@@ -1815,6 +1988,14 @@ This is relevant for the daily/weekly agenda, not for the TODO list."
1815 :group 'org-agenda-skip 1988 :group 'org-agenda-skip
1816 :type 'boolean) 1989 :type 'boolean)
1817 1990
1991(defcustom org-agenda-skip-deadline-if-done nil
1992 "Non-nil means don't show deadines when the corresponding item is done.
1993When nil, the deadline is still shown and should give you a happy feeling.
1994
1995This is relevant for the daily/weekly agenda."
1996 :group 'org-agenda-skip
1997 :type 'boolean)
1998
1818(defcustom org-timeline-show-empty-dates 3 1999(defcustom org-timeline-show-empty-dates 3
1819 "Non-nil means, `org-timeline' also shows dates without an entry. 2000 "Non-nil means, `org-timeline' also shows dates without an entry.
1820When nil, only the days which actually have entries are shown. 2001When nil, only the days which actually have entries are shown.
@@ -1846,7 +2027,7 @@ Needs to be set before org.el is loaded."
1846 :type 'boolean) 2027 :type 'boolean)
1847 2028
1848(defcustom org-agenda-start-with-follow-mode nil 2029(defcustom org-agenda-start-with-follow-mode nil
1849 "The initial value of follwo-mode in a newly created agenda window." 2030 "The initial value of follow-mode in a newly created agenda window."
1850 :group 'org-agenda-startup 2031 :group 'org-agenda-startup
1851 :type 'boolean) 2032 :type 'boolean)
1852 2033
@@ -1931,7 +2112,7 @@ a format string understood by `format-time-string'.
1931FIXME: Not used currently, because of timezone problem." 2112FIXME: Not used currently, because of timezone problem."
1932 :group 'org-agenda-daily/weekly 2113 :group 'org-agenda-daily/weekly
1933 :type 'string) 2114 :type 'string)
1934 2115
1935(defcustom org-agenda-include-diary nil 2116(defcustom org-agenda-include-diary nil
1936 "If non-nil, include in the agenda entries from the Emacs Calendar's diary." 2117 "If non-nil, include in the agenda entries from the Emacs Calendar's diary."
1937 :group 'org-agenda-daily/weekly 2118 :group 'org-agenda-daily/weekly
@@ -2006,7 +2187,7 @@ a grid line."
2006 (defcustom org-agenda-sorting-strategy 2187 (defcustom org-agenda-sorting-strategy
2007 '((agenda time-up category-keep priority-down) 2188 '((agenda time-up category-keep priority-down)
2008 (todo category-keep priority-down) 2189 (todo category-keep priority-down)
2009 (tags category-keep)) 2190 (tags category-keep priority-down))
2010 "Sorting structure for the agenda items of a single day. 2191 "Sorting structure for the agenda items of a single day.
2011This is a list of symbols which will be used in sequence to determine 2192This is a list of symbols which will be used in sequence to determine
2012if an entry should be listed before another entry. The following 2193if an entry should be listed before another entry. The following
@@ -2113,7 +2294,7 @@ the prefix, you could use:
2113 (setq org-agenda-prefix-format \" %-11:c% s\") 2294 (setq org-agenda-prefix-format \" %-11:c% s\")
2114 2295
2115See also the variables `org-agenda-remove-times-when-in-prefix' and 2296See also the variables `org-agenda-remove-times-when-in-prefix' and
2116`org-agenda-remove-tags-when-in-prefix'." 2297`org-agenda-remove-tags'."
2117 :type '(choice 2298 :type '(choice
2118 (string :tag "General format") 2299 (string :tag "General format")
2119 (list :greedy t :tag "View dependent" 2300 (list :greedy t :tag "View dependent"
@@ -2144,7 +2325,7 @@ the headline/diary entry."
2144 (const :tag "Never" nil) 2325 (const :tag "Never" nil)
2145 (const :tag "When at beginning of entry" beg))) 2326 (const :tag "When at beginning of entry" beg)))
2146 2327
2147(defcustom org-agenda-remove-tags-when-in-prefix nil 2328(defcustom org-agenda-remove-tags nil
2148 "Non-nil means, remove the tags from the headline copy in the agenda. 2329 "Non-nil means, remove the tags from the headline copy in the agenda.
2149When this is the symbol `prefix', only remove tags when 2330When this is the symbol `prefix', only remove tags when
2150`org-agenda-prefix-format' contains a `%T' specifier." 2331`org-agenda-prefix-format' contains a `%T' specifier."
@@ -2154,6 +2335,10 @@ When this is the symbol `prefix', only remove tags when
2154 (const :tag "Never" nil) 2335 (const :tag "Never" nil)
2155 (const :tag "When prefix format contains %T" prefix))) 2336 (const :tag "When prefix format contains %T" prefix)))
2156 2337
2338(if (fboundp 'defvaralias)
2339 (defvaralias 'org-agenda-remove-tags-when-in-prefix
2340 'org-agenda-remove-tags))
2341
2157(defcustom org-agenda-align-tags-to-column 65 2342(defcustom org-agenda-align-tags-to-column 65
2158 "Shift tags in agenda items to this column." 2343 "Shift tags in agenda items to this column."
2159 :group 'org-agenda-prefix 2344 :group 'org-agenda-prefix
@@ -2165,13 +2350,18 @@ When this is the symbol `prefix', only remove tags when
2165 :group 'org) 2350 :group 'org)
2166 2351
2167(defcustom org-format-latex-options 2352(defcustom org-format-latex-options
2168 '(:foreground "Black" :background "Transparent" :scale 1.0 2353 '(:foreground default :background default :scale 1.0
2169 :matchers ("begin" "$" "$$" "\\(" "\\[")) 2354 :html-foreground "Black" :html-background "Transparent" :html-scale 1.0
2355 :matchers ("begin" "$" "$$" "\\(" "\\["))
2170 "Options for creating images from LaTeX fragments. 2356 "Options for creating images from LaTeX fragments.
2171This is a property list with the following properties: 2357This is a property list with the following properties:
2172:foreground the foreground color, for example \"Black\". 2358:foreground the foreground color for images embedded in emacs, e.g. \"Black\".
2359 `default' means use the forground of the default face.
2173:background the background color, or \"Transparent\". 2360:background the background color, or \"Transparent\".
2361 `default' means use the background of the default face.
2174:scale a scaling factor for the size of the images 2362:scale a scaling factor for the size of the images
2363:html-foreground, :html-background, :html-scale
2364 The same numbers for HTML export.
2175:matchers a list indicating which matchers should be used to 2365:matchers a list indicating which matchers should be used to
2176 find LaTeX fragments. Valid members of this list are: 2366 find LaTeX fragments. Valid members of this list are:
2177 \"begin\" find environments 2367 \"begin\" find environments
@@ -2182,6 +2372,18 @@ This is a property list with the following properties:
2182 :group 'org-latex 2372 :group 'org-latex
2183 :type 'plist) 2373 :type 'plist)
2184 2374
2375(defcustom org-format-latex-header "\\documentclass{article}
2376\\usepackage{fullpage} % do not remove
2377\\usepackage{amssymb}
2378\\usepackage[usenames]{color}
2379\\usepackage{amsmath}
2380\\usepackage{latexsym}
2381\\usepackage[mathscr]{eucal}
2382\\pagestyle{empty} % do not remove"
2383 "The document header used for processing LaTeX fragments."
2384 :group 'org-latex
2385 :type 'string)
2386
2185(defgroup org-export nil 2387(defgroup org-export nil
2186 "Options for exporting org-listings." 2388 "Options for exporting org-listings."
2187 :tag "Org Export" 2389 :tag "Org Export"
@@ -2237,6 +2439,12 @@ This should have an association in `org-export-language-setup'."
2237 :group 'org-export-general 2439 :group 'org-export-general
2238 :type 'string) 2440 :type 'string)
2239 2441
2442(defcustom org-export-skip-text-before-1st-heading t
2443 "Non-nil means, skip all text before the first headline when exporting.
2444When nil, that text is exported as well."
2445 :group 'org-export-general
2446 :type 'boolean)
2447
2240(defcustom org-export-headline-levels 3 2448(defcustom org-export-headline-levels 3
2241 "The last level which is still exported as a headline. 2449 "The last level which is still exported as a headline.
2242Inferior levels will produce itemize lists when exported. 2450Inferior levels will produce itemize lists when exported.
@@ -2354,12 +2562,19 @@ sub- or superscripts.
2354 x_{i^2} or x^(2-i) braces or parenthesis do grouping. 2562 x_{i^2} or x^(2-i) braces or parenthesis do grouping.
2355 2563
2356Still, ambiguity is possible - so when in doubt use {} to enclose the 2564Still, ambiguity is possible - so when in doubt use {} to enclose the
2357sub/superscript. 2565sub/superscript. If you set this variable to the symbol `{}',
2566the braces are *required* in order to trigger interpretations as
2567sub/superscript. This can be helpful in documents that need \"_\"
2568frequently in plain text.
2569
2358Not all export backends support this, but HTML does. 2570Not all export backends support this, but HTML does.
2359 2571
2360This option can also be set with the +OPTIONS line, e.g. \"^:nil\"." 2572This option can also be set with the +OPTIONS line, e.g. \"^:nil\"."
2361 :group 'org-export-translation 2573 :group 'org-export-translation
2362 :type 'boolean) 2574 :type '(choice
2575 (const :tag "Always interpret" t)
2576 (const :tag "Only with braces" {})
2577 (const :tag "Never interpret" nil)))
2363 2578
2364(defcustom org-export-with-TeX-macros t 2579(defcustom org-export-with-TeX-macros t
2365 "Non-nil means, interpret simple TeX-like macros when exporting. 2580 "Non-nil means, interpret simple TeX-like macros when exporting.
@@ -2534,6 +2749,7 @@ you can \"misuse\" it to add arbitrary text to the header."
2534 :group 'org-export-html 2749 :group 'org-export-html
2535 :type 'string) 2750 :type 'string)
2536 2751
2752
2537(defcustom org-export-html-title-format "<h1 class=\"title\">%s</h1>\n" 2753(defcustom org-export-html-title-format "<h1 class=\"title\">%s</h1>\n"
2538 "Format for typesetting the document title in HTML export." 2754 "Format for typesetting the document title in HTML export."
2539 :group 'org-export-html 2755 :group 'org-export-html
@@ -2567,7 +2783,7 @@ be linked only."
2567 (const :tag "Always" t) 2783 (const :tag "Always" t)
2568 (const :tag "When there is no description" maybe))) 2784 (const :tag "When there is no description" maybe)))
2569 2785
2570;; FIXME: rename 2786;; FIXME: rename
2571(defcustom org-export-html-expand t 2787(defcustom org-export-html-expand t
2572 "Non-nil means, for HTML export, treat @<...> as HTML tag. 2788 "Non-nil means, for HTML export, treat @<...> as HTML tag.
2573When nil, these tags will be exported as plain text and therefore 2789When nil, these tags will be exported as plain text and therefore
@@ -2579,12 +2795,24 @@ This option can also be set with the +OPTIONS line, e.g. \"@:nil\"."
2579 2795
2580(defcustom org-export-html-table-tag 2796(defcustom org-export-html-table-tag
2581 "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">" 2797 "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">"
2582 "The HTML tag used to start a table. 2798 "The HTML tag that is used to start a table.
2583This must be a <table> tag, but you may change the options like 2799This must be a <table> tag, but you may change the options like
2584borders and spacing." 2800borders and spacing."
2585 :group 'org-export-html 2801 :group 'org-export-html
2586 :type 'string) 2802 :type 'string)
2587 2803
2804(defcustom org-export-table-header-tags '("<th>" . "</th>")
2805 "The opening tag for table header fields.
2806This is customizable so that alignment options can be specified."
2807 :group 'org-export-tables
2808 :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
2809
2810(defcustom org-export-table-data-tags '("<td>" . "</td>")
2811 "The opening tag for table data fields.
2812This is customizable so that alignment options can be specified."
2813 :group 'org-export-tables
2814 :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
2815
2588(defcustom org-export-html-with-timestamp nil 2816(defcustom org-export-html-with-timestamp nil
2589 "If non-nil, write `org-export-html-html-helper-timestamp' 2817 "If non-nil, write `org-export-html-html-helper-timestamp'
2590into the exported HTML text. Otherwise, the buffer will just be saved 2818into the exported HTML text. Otherwise, the buffer will just be saved
@@ -2618,6 +2846,12 @@ The file name should be absolute."
2618 (const :tag "Unfinished" t) 2846 (const :tag "Unfinished" t)
2619 (const :tag "All" all))) 2847 (const :tag "All" all)))
2620 2848
2849(defcustom org-icalendar-include-sexps t
2850 "Non-nil means, export to iCalendar files should also cover sexp entries.
2851These are entries like in the diary, but directly in an Org-mode file."
2852 :group 'org-export-icalendar
2853 :type 'boolean)
2854
2621(defcustom org-icalendar-combined-name "OrgMode" 2855(defcustom org-icalendar-combined-name "OrgMode"
2622 "Calendar name for the combined iCalendar representing all agenda files." 2856 "Calendar name for the combined iCalendar representing all agenda files."
2623 :group 'org-export-icalendar 2857 :group 'org-export-icalendar
@@ -2690,8 +2924,6 @@ Changing this variable requires a restart of Emacs to take effect."
2690 (setq markers (concat (replace-match "" t t markers) "^"))) 2924 (setq markers (concat (replace-match "" t t markers) "^")))
2691 (if (string-match "-" markers) 2925 (if (string-match "-" markers)
2692 (setq markers (concat (replace-match "" t t markers) "-"))) 2926 (setq markers (concat (replace-match "" t t markers) "-")))
2693; (while (>= (setq nl (1- nl)) 0) (setq body1 (concat body1 "\n?" body "*?")))
2694; (while (>= (setq nl (1- nl)) 0) (setq body1 (concat body1 "\\(?:\n?" body "*?\\)?")))
2695 (if (> nl 0) 2927 (if (> nl 0)
2696 (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0," 2928 (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0,"
2697 (int-to-string nl) "\\}"))) 2929 (int-to-string nl) "\\}")))
@@ -2701,15 +2933,15 @@ Changing this variable requires a restart of Emacs to take effect."
2701 "\\(" 2933 "\\("
2702 "\\([" markers "]\\)" 2934 "\\([" markers "]\\)"
2703 "\\(" 2935 "\\("
2704 "[^" border markers "]" 2936 "[^" border (if (and nil stacked) markers) "]"
2705 body1 2937 body1
2706 "[^" border markers "]" 2938 "[^" border (if (and nil stacked) markers) "]"
2707 "\\)" 2939 "\\)"
2708 "\\3\\)" 2940 "\\3\\)"
2709 "\\([" post (if stacked markers) "]\\|$\\)"))))) 2941 "\\([" post (if stacked markers) "]\\|$\\)")))))
2710 2942
2711(defcustom org-emphasis-regexp-components 2943(defcustom org-emphasis-regexp-components
2712 '(" \t('\"" " \t.,?;'\")" " \t\r\n," "." 1 nil) 2944 '(" \t('\"" "- \t.,:?;'\")" " \t\r\n,\"'" "." 1 nil)
2713 "Components used to build the reqular expression for emphasis. 2945 "Components used to build the reqular expression for emphasis.
2714This is a list with 6 entries. Terminology: In an emphasis string 2946This is a list with 6 entries. Terminology: In an emphasis string
2715like \" *strong word* \", we call the initial space PREMATCH, the final 2947like \" *strong word* \", we call the initial space PREMATCH, the final
@@ -2719,8 +2951,7 @@ specify what is allowed/forbidden in each part:
2719 2951
2720pre Chars allowed as prematch. Beginning of line will be allowed too. 2952pre Chars allowed as prematch. Beginning of line will be allowed too.
2721post Chars allowed as postmatch. End of line will be allowed too. 2953post Chars allowed as postmatch. End of line will be allowed too.
2722border The chars *forbidden* as border characters. In addition to the 2954border The chars *forbidden* as border characters.
2723 characters given here, all marker characters are forbidden too.
2724body-regexp A regexp like \".\" to match a body character. Don't use 2955body-regexp A regexp like \".\" to match a body character. Don't use
2725 non-shy groups here, and don't allow newline here. 2956 non-shy groups here, and don't allow newline here.
2726newline The maximum number of newlines allowed in an emphasis exp. 2957newline The maximum number of newlines allowed in an emphasis exp.
@@ -2745,11 +2976,11 @@ Use customize to modify this, or restart Emacs after changing it."
2745 ("_" underline "<u>" "</u>") 2976 ("_" underline "<u>" "</u>")
2746 ("=" shadow "<code>" "</code>") 2977 ("=" shadow "<code>" "</code>")
2747 ("+" (:strike-through t) "<del>" "</del>") 2978 ("+" (:strike-through t) "<del>" "</del>")
2748) 2979 )
2749"Special syntax for emphasized text. 2980"Special syntax for emphasized text.
2750Text starting and ending with a special character will be emphasized, for 2981Text starting and ending with a special character will be emphasized, for
2751example *bold*, _underlined_ and /italic/. This variable sets the marker 2982example *bold*, _underlined_ and /italic/. This variable sets the marker
2752characters, the face to bbe used by font-lock for highlighting in Org-mode 2983characters, the face to be used by font-lock for highlighting in Org-mode
2753Emacs buffers, and the HTML tags to be used for this. 2984Emacs buffers, and the HTML tags to be used for this.
2754Use customize to modify this, or restart Emacs after changing it." 2985Use customize to modify this, or restart Emacs after changing it."
2755 :group 'org-font-lock 2986 :group 'org-font-lock
@@ -2894,15 +3125,6 @@ color of the frame."
2894 "Face for deadlines and TODO keywords." 3125 "Face for deadlines and TODO keywords."
2895 :group 'org-faces) 3126 :group 'org-faces)
2896 3127
2897(defface org-headline-done ;; font-lock-string-face
2898 (org-compatible-face
2899 '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
2900 (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
2901 (((class color) (min-colors 8) (background light)) (:bold nil))))
2902 "Face used to indicate that a headline is DONE.
2903This face is only used if `org-fontify-done-headline' is set."
2904 :group 'org-faces)
2905
2906(defface org-archived ; similar to shadow 3128(defface org-archived ; similar to shadow
2907 (org-compatible-face 3129 (org-compatible-face
2908 '((((class color grayscale) (min-colors 88) (background light)) 3130 '((((class color grayscale) (min-colors 88) (background light))
@@ -2930,6 +3152,13 @@ This face is only used if `org-fontify-done-headline' is set."
2930 "Face for links." 3152 "Face for links."
2931 :group 'org-faces) 3153 :group 'org-faces)
2932 3154
3155(defface org-sexp-date
3156 '((((class color) (background light)) (:foreground "Purple"))
3157 (((class color) (background dark)) (:foreground "Cyan"))
3158 (t (:underline t)))
3159 "Face for links."
3160 :group 'org-faces)
3161
2933(defface org-tag 3162(defface org-tag
2934 '((t (:bold t))) 3163 '((t (:bold t)))
2935 "Face for tags." 3164 "Face for tags."
@@ -2951,7 +3180,17 @@ This face is only used if `org-fontify-done-headline' is set."
2951 (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t)) 3180 (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t))
2952 (((class color) (min-colors 8)) (:foreground "green")) 3181 (((class color) (min-colors 8)) (:foreground "green"))
2953 (t (:bold t)))) 3182 (t (:bold t))))
2954 "Face used for DONE." 3183 "Face used for todo keywords that indicate DONE items."
3184 :group 'org-faces)
3185
3186(defface org-headline-done ;; font-lock-string-face
3187 (org-compatible-face
3188 '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
3189 (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
3190 (((class color) (min-colors 8) (background light)) (:bold nil))))
3191 "Face used to indicate that a headline is DONE.
3192This face is only used if `org-fontify-done-headline' is set. If applies
3193to the part of the headline after the DONE keyword."
2955 :group 'org-faces) 3194 :group 'org-faces)
2956 3195
2957(defface org-table ;; font-lock-function-name-face 3196(defface org-table ;; font-lock-function-name-face
@@ -2975,6 +3214,17 @@ This face is only used if `org-fontify-done-headline' is set."
2975 "Face for formulas." 3214 "Face for formulas."
2976 :group 'org-faces) 3215 :group 'org-faces)
2977 3216
3217(defface org-agenda-structure ;; font-lock-function-name-face
3218 (org-compatible-face
3219 '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
3220 (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
3221 (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
3222 (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
3223 (((class color) (min-colors 8)) (:foreground "blue" :bold t))
3224 (t (:bold t))))
3225 "Face used in agenda for captions and dates."
3226 :group 'org-faces)
3227
2978(defface org-scheduled-today 3228(defface org-scheduled-today
2979 (org-compatible-face 3229 (org-compatible-face
2980 '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) 3230 '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen"))
@@ -3021,9 +3271,6 @@ This face is only used if `org-fontify-done-headline' is set."
3021 3271
3022;;; Variables for pre-computed regular expressions, all buffer local 3272;;; Variables for pre-computed regular expressions, all buffer local
3023 3273
3024(defvar org-done-string nil
3025 "The last string in `org-todo-keywords', indicating an item is DONE.")
3026(make-variable-buffer-local 'org-done-string)
3027(defvar org-todo-regexp nil 3274(defvar org-todo-regexp nil
3028 "Matches any of the TODO state keywords.") 3275 "Matches any of the TODO state keywords.")
3029(make-variable-buffer-local 'org-todo-regexp) 3276(make-variable-buffer-local 'org-todo-regexp)
@@ -3043,12 +3290,6 @@ Also put tags into group 4 if tags are present.")
3043(defvar org-looking-at-done-regexp nil 3290(defvar org-looking-at-done-regexp nil
3044 "Matches the DONE keyword a point.") 3291 "Matches the DONE keyword a point.")
3045(make-variable-buffer-local 'org-looking-at-done-regexp) 3292(make-variable-buffer-local 'org-looking-at-done-regexp)
3046(defvar org-todo-kwd-priority-p nil
3047 "Do TODO items have priorities?")
3048(make-variable-buffer-local 'org-todo-kwd-priority-p)
3049(defvar org-todo-kwd-max-priority nil
3050 "Maximum priority of TODO items.")
3051(make-variable-buffer-local 'org-todo-kwd-max-priority)
3052(defvar org-ds-keyword-length 12 3293(defvar org-ds-keyword-length 12
3053 "Maximum length of the Deadline and SCHEDULED keywords.") 3294 "Maximum length of the Deadline and SCHEDULED keywords.")
3054(make-variable-buffer-local 'org-ds-keyword-length) 3295(make-variable-buffer-local 'org-ds-keyword-length)
@@ -3080,6 +3321,9 @@ Also put tags into group 4 if tags are present.")
3080(defvar org-maybe-keyword-time-regexp nil 3321(defvar org-maybe-keyword-time-regexp nil
3081 "Matches a timestamp, possibly preceeded by a keyword.") 3322 "Matches a timestamp, possibly preceeded by a keyword.")
3082(make-variable-buffer-local 'org-maybe-keyword-time-regexp) 3323(make-variable-buffer-local 'org-maybe-keyword-time-regexp)
3324(defvar org-planning-or-clock-line-re nil
3325 "Matches a line with planning or clock info.")
3326(make-variable-buffer-local 'org-planning-or-clock-line-re)
3083 3327
3084(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t 3328(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t
3085 rear-nonsticky t mouse-map t fontified t) 3329 rear-nonsticky t mouse-map t fontified t)
@@ -3102,6 +3346,12 @@ Also put tags into group 4 if tags are present.")
3102 ((assoc key option) (cdr (assoc key option))) 3346 ((assoc key option) (cdr (assoc key option)))
3103 (t (cdr (assq 'default option))))) 3347 (t (cdr (assq 'default option)))))
3104 3348
3349(defsubst org-inhibit-invisibility ()
3350 "Modified `buffer-invisibility-spec' for Emacs 21.
3351Some ops with invisible text do not work correctly on Emacs 21. For these
3352we turn off invisibility temporarily. Use this in a `let' form."
3353 (if (< emacs-major-version 22) nil buffer-invisibility-spec))
3354
3105(defsubst org-set-local (var value) 3355(defsubst org-set-local (var value)
3106 "Make VAR local in current buffer and set it to VALUE." 3356 "Make VAR local in current buffer and set it to VALUE."
3107 (set (make-variable-buffer-local var) value)) 3357 (set (make-variable-buffer-local var) value))
@@ -3139,7 +3389,11 @@ Also put tags into group 4 if tags are present.")
3139 ("nologging" org-log-done nil) 3389 ("nologging" org-log-done nil)
3140 ("lognotedone" org-log-done done push) 3390 ("lognotedone" org-log-done done push)
3141 ("lognotestate" org-log-done state push) 3391 ("lognotestate" org-log-done state push)
3142 ("lognoteclock-out" org-log-done clock-out push)) 3392 ("lognoteclock-out" org-log-done clock-out push)
3393 ("logrepeat" org-log-repeat t)
3394 ("nologrepeat" org-log-repeat nil)
3395 ("constcgs" constants-unit-system cgs)
3396 ("constSI" constants-unit-system SI))
3143 "Variable associated with STARTUP options for org-mode. 3397 "Variable associated with STARTUP options for org-mode.
3144Each element is a list of three items: The startup options as written 3398Each element is a list of three items: The startup options as written
3145in the #+STARTUP line, the corresponding variable, and the value to 3399in the #+STARTUP line, the corresponding variable, and the value to
@@ -3149,11 +3403,16 @@ means to push this value onto the list in the variable.")
3149(defun org-set-regexps-and-options () 3403(defun org-set-regexps-and-options ()
3150 "Precompute regular expressions for current buffer." 3404 "Precompute regular expressions for current buffer."
3151 (when (org-mode-p) 3405 (when (org-mode-p)
3406 (org-set-local 'org-todo-kwd-alist nil)
3407 (org-set-local 'org-todo-keywords-1 nil)
3408 (org-set-local 'org-done-keywords nil)
3409 (org-set-local 'org-todo-heads nil)
3410 (org-set-local 'org-todo-sets nil)
3152 (let ((re (org-make-options-regexp 3411 (let ((re (org-make-options-regexp
3153 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" 3412 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO"
3154 "STARTUP" "ARCHIVE" "TAGS" "LINK"))) 3413 "STARTUP" "ARCHIVE" "TAGS" "LINK" "PRIORITIES")))
3155 (splitre "[ \t]+") 3414 (splitre "[ \t]+")
3156 kwds int key value cat arch tags links) 3415 kwds key value cat arch tags links hw dws tail sep kws1 prio)
3157 (save-excursion 3416 (save-excursion
3158 (save-restriction 3417 (save-restriction
3159 (widen) 3418 (widen)
@@ -3166,14 +3425,9 @@ means to push this value onto the list in the variable.")
3166 (setq value (replace-match "" t t value))) 3425 (setq value (replace-match "" t t value)))
3167 (setq cat (intern value))) 3426 (setq cat (intern value)))
3168 ((equal key "SEQ_TODO") 3427 ((equal key "SEQ_TODO")
3169 (setq int 'sequence 3428 (push (cons 'sequence (org-split-string value splitre)) kwds))
3170 kwds (append kwds (org-split-string value splitre))))
3171 ((equal key "PRI_TODO")
3172 (setq int 'priority
3173 kwds (append kwds (org-split-string value splitre))))
3174 ((equal key "TYP_TODO") 3429 ((equal key "TYP_TODO")
3175 (setq int 'type 3430 (push (cons 'type (org-split-string value splitre)) kwds))
3176 kwds (append kwds (org-split-string value splitre))))
3177 ((equal key "TAGS") 3431 ((equal key "TAGS")
3178 (setq tags (append tags (org-split-string value splitre)))) 3432 (setq tags (append tags (org-split-string value splitre))))
3179 ((equal key "LINK") 3433 ((equal key "LINK")
@@ -3181,17 +3435,20 @@ means to push this value onto the list in the variable.")
3181 (push (cons (match-string 1 value) 3435 (push (cons (match-string 1 value)
3182 (org-trim (match-string 2 value))) 3436 (org-trim (match-string 2 value)))
3183 links))) 3437 links)))
3438 ((equal key "PRIORITIES")
3439 (setq prio (org-split-string value " +")))
3184 ((equal key "STARTUP") 3440 ((equal key "STARTUP")
3185 (let ((opts (org-split-string value splitre)) 3441 (let ((opts (org-split-string value splitre))
3186 l var val) 3442 l var val)
3187 (while (setq l (assoc (pop opts) org-startup-options)) 3443 (while (setq l (pop opts))
3188 (setq var (nth 1 l) val (nth 2 l)) 3444 (when (setq l (assoc l org-startup-options))
3189 (if (not (nth 3 l)) 3445 (setq var (nth 1 l) val (nth 2 l))
3190 (set (make-local-variable var) val) 3446 (if (not (nth 3 l))
3191 (if (not (listp (symbol-value var))) 3447 (set (make-local-variable var) val)
3192 (set (make-local-variable var) nil)) 3448 (if (not (listp (symbol-value var)))
3193 (set (make-local-variable var) (symbol-value var)) 3449 (set (make-local-variable var) nil))
3194 (add-to-list var val))))) 3450 (set (make-local-variable var) (symbol-value var))
3451 (add-to-list var val))))))
3195 ((equal key "ARCHIVE") 3452 ((equal key "ARCHIVE")
3196 (string-match " *$" value) 3453 (string-match " *$" value)
3197 (setq arch (replace-match "" t t value)) 3454 (setq arch (replace-match "" t t value))
@@ -3199,10 +3456,38 @@ means to push this value onto the list in the variable.")
3199 '(face t fontified t) arch))) 3456 '(face t fontified t) arch)))
3200 ))) 3457 )))
3201 (and cat (org-set-local 'org-category cat)) 3458 (and cat (org-set-local 'org-category cat))
3202 (and kwds (org-set-local 'org-todo-keywords kwds)) 3459 (when prio
3460 (if (< (length prio) 3) (setq prio '("A" "C" "B")))
3461 (setq prio (mapcar 'string-to-char prio))
3462 (org-set-local 'org-highest-priority (nth 0 prio))
3463 (org-set-local 'org-lowest-priority (nth 1 prio))
3464 (org-set-local 'org-default-priority (nth 2 prio)))
3203 (and arch (org-set-local 'org-archive-location arch)) 3465 (and arch (org-set-local 'org-archive-location arch))
3204 (and int (org-set-local 'org-todo-interpretation int))
3205 (and links (setq org-link-abbrev-alist-local (nreverse links))) 3466 (and links (setq org-link-abbrev-alist-local (nreverse links)))
3467 ;; Process the TODO keywords
3468 (unless kwds
3469 ;; Use the global values as if they had been given locally.
3470 (setq kwds (default-value 'org-todo-keywords))
3471 (if (stringp (car kwds))
3472 (setq kwds (list (cons org-todo-interpretation
3473 (default-value 'org-todo-keywords)))))
3474 (setq kwds (reverse kwds)))
3475 (setq kwds (nreverse kwds))
3476 (let (inter kws)
3477 (while (setq kws (pop kwds))
3478 (setq inter (pop kws) sep (member "|" kws)
3479 kws1 (delete "|" (copy-sequence kws))
3480 hw (car kws1)
3481 dws (if sep (cdr sep) (last kws1))
3482 tail (list inter hw (car dws) (org-last dws)))
3483 (add-to-list 'org-todo-heads hw 'append)
3484 (push kws1 org-todo-sets)
3485 (setq org-done-keywords (append org-done-keywords dws nil))
3486 (mapc (lambda (x) (push (cons x tail) org-todo-kwd-alist)) kws1)
3487 (setq org-todo-keywords-1 (append org-todo-keywords-1 kws1 nil)))
3488 (setq org-todo-sets (nreverse org-todo-sets)
3489 org-todo-kwd-alist (nreverse org-todo-kwd-alist)))
3490 ;; Process the tags.
3206 (when tags 3491 (when tags
3207 (let (e tgs) 3492 (let (e tgs)
3208 (while (setq e (pop tags)) 3493 (while (setq e (pop tags))
@@ -3221,32 +3506,35 @@ means to push this value onto the list in the variable.")
3221 (push e org-tag-alist)))))) 3506 (push e org-tag-alist))))))
3222 3507
3223 ;; Compute the regular expressions and other local variables 3508 ;; Compute the regular expressions and other local variables
3224 (setq org-todo-kwd-priority-p (equal org-todo-interpretation 'priority) 3509 (if (not org-done-keywords)
3225 org-todo-kwd-max-priority (1- (length org-todo-keywords)) 3510 (setq org-done-keywords (list (org-last org-todo-keywords-1))))
3226 org-ds-keyword-length (+ 2 (max (length org-deadline-string) 3511 (setq org-ds-keyword-length (+ 2 (max (length org-deadline-string)
3227 (length org-scheduled-string))) 3512 (length org-scheduled-string)))
3228 org-done-string 3513 org-not-done-keywords
3229 (nth (1- (length org-todo-keywords)) org-todo-keywords) 3514 (org-delete-all org-done-keywords (copy-sequence org-todo-keywords-1))
3230 org-todo-regexp 3515 org-todo-regexp
3231 (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords 3516 (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords-1
3232 "\\|") "\\)\\>") 3517 "\\|") "\\)\\>")
3233 org-not-done-regexp 3518 org-not-done-regexp
3234 (concat "\\<\\(" 3519 (concat "\\<\\("
3235 (mapconcat 'regexp-quote 3520 (mapconcat 'regexp-quote org-not-done-keywords "\\|")
3236 (nreverse (cdr (reverse org-todo-keywords)))
3237 "\\|")
3238 "\\)\\>") 3521 "\\)\\>")
3239 org-todo-line-regexp 3522 org-todo-line-regexp
3240 (concat "^\\(\\*+\\)[ \t]*\\(?:\\(" 3523 (concat "^\\(\\*+\\)[ \t]*\\(?:\\("
3241 (mapconcat 'regexp-quote org-todo-keywords "\\|") 3524 (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
3242 "\\)\\>\\)? *\\(.*\\)") 3525 "\\)\\>\\)? *\\(.*\\)")
3243 org-nl-done-regexp 3526 org-nl-done-regexp
3244 (concat "[\r\n]\\*+[ \t]+" org-done-string "\\>") 3527 (concat "[\r\n]\\*+[ \t]+"
3528 "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|")
3529 "\\)" "\\>")
3245 org-todo-line-tags-regexp 3530 org-todo-line-tags-regexp
3246 (concat "^\\(\\*+\\)[ \t]*\\(?:\\(" 3531 (concat "^\\(\\*+\\)[ \t]*\\(?:\\("
3247 (mapconcat 'regexp-quote org-todo-keywords "\\|") 3532 (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
3248 "\\)\\>\\)? *\\(.*?\\([ \t]:[a-zA-Z0-9:_@]+:[ \t]*\\)?$\\)") 3533 "\\)\\>\\)? *\\(.*?\\([ \t]:[a-zA-Z0-9:_@]+:[ \t]*\\)?$\\)")
3249 org-looking-at-done-regexp (concat "^" org-done-string "\\>") 3534 org-looking-at-done-regexp
3535 (concat "^" "\\(?:"
3536 (mapconcat 'regexp-quote org-done-keywords "\\|") "\\)"
3537 "\\>")
3250 org-deadline-regexp (concat "\\<" org-deadline-string) 3538 org-deadline-regexp (concat "\\<" org-deadline-string)
3251 org-deadline-time-regexp 3539 org-deadline-time-regexp
3252 (concat "\\<" org-deadline-string " *<\\([^>]+\\)>") 3540 (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")
@@ -3274,7 +3562,12 @@ means to push this value onto the list in the variable.")
3274 "\\|" org-deadline-string 3562 "\\|" org-deadline-string
3275 "\\|" org-closed-string 3563 "\\|" org-closed-string
3276 "\\|" org-clock-string "\\)\\)?" 3564 "\\|" org-clock-string "\\)\\)?"
3277 " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^]\r\n>]*?[]>]\\)")) 3565 " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)")
3566 org-planning-or-clock-line-re
3567 (concat "\\(?:^[ \t]*\\(" org-scheduled-string
3568 "\\|" org-deadline-string
3569 "\\|" org-closed-string "\\|" org-clock-string "\\)\\>\\)")
3570 )
3278 3571
3279 (org-set-font-lock-defaults))) 3572 (org-set-font-lock-defaults)))
3280 3573
@@ -3325,6 +3618,7 @@ This is for getting out of special buffers like remember.")
3325(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode' 3618(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode'
3326(defvar initial) ; from remember.el, dynamically scoped in `remember-mode' 3619(defvar initial) ; from remember.el, dynamically scoped in `remember-mode'
3327(defvar org-latex-regexps) 3620(defvar org-latex-regexps)
3621(defvar constants-unit-system)
3328 3622
3329(defvar original-date) ; dynamically scoped in calendar.el does scope this 3623(defvar original-date) ; dynamically scoped in calendar.el does scope this
3330 3624
@@ -3394,6 +3688,7 @@ This is for getting out of special buffers like remember.")
3394 (overlay-get ovl prop))) 3688 (overlay-get ovl prop)))
3395(defun org-overlays-at (pos) 3689(defun org-overlays-at (pos)
3396 (if (featurep 'xemacs) (extents-at pos) (overlays-at pos))) 3690 (if (featurep 'xemacs) (extents-at pos) (overlays-at pos)))
3691;; FIXME: this is currently not used
3397(defun org-overlays-in (&optional start end) 3692(defun org-overlays-in (&optional start end)
3398 (if (featurep 'xemacs) 3693 (if (featurep 'xemacs)
3399 (extent-list nil start end) 3694 (extent-list nil start end)
@@ -3402,6 +3697,7 @@ This is for getting out of special buffers like remember.")
3402 (if (featurep 'xemacs) (extent-start-position o) (overlay-start o))) 3697 (if (featurep 'xemacs) (extent-start-position o) (overlay-start o)))
3403(defun org-overlay-end (o) 3698(defun org-overlay-end (o)
3404 (if (featurep 'xemacs) (extent-end-position o) (overlay-end o))) 3699 (if (featurep 'xemacs) (extent-end-position o) (overlay-end o)))
3700;; FIXME: this is currently not used
3405(defun org-find-overlays (prop &optional pos delete) 3701(defun org-find-overlays (prop &optional pos delete)
3406 "Find all overlays specifying PROP at POS or point. 3702 "Find all overlays specifying PROP at POS or point.
3407If DELETE is non-nil, delete all those overlays." 3703If DELETE is non-nil, delete all those overlays."
@@ -3455,6 +3751,7 @@ that can be added."
3455 (setq buffer-invisibility-spec 3751 (setq buffer-invisibility-spec
3456 (delete arg buffer-invisibility-spec))))) 3752 (delete arg buffer-invisibility-spec)))))
3457 3753
3754;; FIXME: this is currently not used
3458(defun org-in-invisibility-spec-p (arg) 3755(defun org-in-invisibility-spec-p (arg)
3459 "Is ARG a member of `buffer-invisibility-spec'?" 3756 "Is ARG a member of `buffer-invisibility-spec'?"
3460 (if (consp buffer-invisibility-spec) 3757 (if (consp buffer-invisibility-spec)
@@ -3477,6 +3774,7 @@ This variable is set by `org-before-change-function'.
3477(defvar org-mode-hook nil) 3774(defvar org-mode-hook nil)
3478(defvar org-inhibit-startup nil) ; Dynamically-scoped param. 3775(defvar org-inhibit-startup nil) ; Dynamically-scoped param.
3479(defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. 3776(defvar org-agenda-keep-modes nil) ; Dynamically-scoped param.
3777(defvar org-table-buffer-is-an nil)
3480 3778
3481 3779
3482;;;###autoload 3780;;;###autoload
@@ -3521,7 +3819,6 @@ The following commands are available:
3521 (when (featurep 'xemacs) 3819 (when (featurep 'xemacs)
3522 (org-set-local 'line-move-ignore-invisible t)) 3820 (org-set-local 'line-move-ignore-invisible t))
3523 (setq outline-regexp "\\*+") 3821 (setq outline-regexp "\\*+")
3524 ;;(setq outline-regexp "\\(?:\\*+\\|[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\) \\)")
3525 (setq outline-level 'org-outline-level) 3822 (setq outline-level 'org-outline-level)
3526 (when (and org-ellipsis (stringp org-ellipsis) 3823 (when (and org-ellipsis (stringp org-ellipsis)
3527 (fboundp 'set-display-table-slot) (boundp 'buffer-display-table)) 3824 (fboundp 'set-display-table-slot) (boundp 'buffer-display-table))
@@ -3534,6 +3831,7 @@ The following commands are available:
3534 ;; Calc embedded 3831 ;; Calc embedded
3535 (org-set-local 'calc-embedded-open-mode "# ") 3832 (org-set-local 'calc-embedded-open-mode "# ")
3536 (modify-syntax-entry ?# "<") 3833 (modify-syntax-entry ?# "<")
3834 (modify-syntax-entry ?@ "w")
3537 (if org-startup-truncated (setq truncate-lines t)) 3835 (if org-startup-truncated (setq truncate-lines t))
3538 (org-set-local 'font-lock-unfontify-region-function 3836 (org-set-local 'font-lock-unfontify-region-function
3539 'org-unfontify-region) 3837 'org-unfontify-region)
@@ -3545,6 +3843,7 @@ The following commands are available:
3545 (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) 3843 (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local)
3546 ;; Paragraphs and auto-filling 3844 ;; Paragraphs and auto-filling
3547 (org-set-autofill-regexps) 3845 (org-set-autofill-regexps)
3846 (setq indent-line-function 'org-indent-line-function)
3548 (org-update-radio-target-regexp) 3847 (org-update-radio-target-regexp)
3549 3848
3550 ;; Comment characters 3849 ;; Comment characters
@@ -3564,7 +3863,7 @@ The following commands are available:
3564 (if (and org-insert-mode-line-in-empty-file 3863 (if (and org-insert-mode-line-in-empty-file
3565 (interactive-p) 3864 (interactive-p)
3566 (= (point-min) (point-max))) 3865 (= (point-min) (point-max)))
3567 (insert " -*- mode: org -*-\n\n")) 3866 (insert "# -*- mode: org -*-\n\n"))
3568 3867
3569 (unless org-inhibit-startup 3868 (unless org-inhibit-startup
3570 (when org-startup-align-all-tables 3869 (when org-startup-align-all-tables
@@ -3578,6 +3877,8 @@ The following commands are available:
3578 (let ((this-command 'org-cycle) (last-command 'org-cycle)) 3877 (let ((this-command 'org-cycle) (last-command 'org-cycle))
3579 (org-cycle '(4)) (org-cycle '(4))))))) 3878 (org-cycle '(4)) (org-cycle '(4)))))))
3580 3879
3880(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
3881
3581(defsubst org-call-with-arg (command arg) 3882(defsubst org-call-with-arg (command arg)
3582 "Call COMMAND interactively, but pretend prefix are was ARG." 3883 "Call COMMAND interactively, but pretend prefix are was ARG."
3583 (let ((current-prefix-arg arg)) (call-interactively command))) 3884 (let ((current-prefix-arg arg)) (call-interactively command)))
@@ -3610,23 +3911,23 @@ that will be added to PLIST. Returns the string that was modified."
3610;;;; Font-Lock stuff, including the activators 3911;;;; Font-Lock stuff, including the activators
3611 3912
3612(defvar org-mouse-map (make-sparse-keymap)) 3913(defvar org-mouse-map (make-sparse-keymap))
3613(define-key org-mouse-map 3914(org-defkey org-mouse-map
3614 (if (featurep 'xemacs) [button2] [mouse-2]) 'org-open-at-mouse) 3915 (if (featurep 'xemacs) [button2] [mouse-2]) 'org-open-at-mouse)
3615(define-key org-mouse-map 3916(org-defkey org-mouse-map
3616 (if (featurep 'xemacs) [button3] [mouse-3]) 'org-find-file-at-mouse) 3917 (if (featurep 'xemacs) [button3] [mouse-3]) 'org-find-file-at-mouse)
3617(when org-mouse-1-follows-link 3918(when org-mouse-1-follows-link
3618 (define-key org-mouse-map [follow-link] 'mouse-face)) 3919 (org-defkey org-mouse-map [follow-link] 'mouse-face))
3619(when org-tab-follows-link 3920(when org-tab-follows-link
3620 (define-key org-mouse-map [(tab)] 'org-open-at-point) 3921 (org-defkey org-mouse-map [(tab)] 'org-open-at-point)
3621 (define-key org-mouse-map "\C-i" 'org-open-at-point)) 3922 (org-defkey org-mouse-map "\C-i" 'org-open-at-point))
3622(when org-return-follows-link 3923(when org-return-follows-link
3623 (define-key org-mouse-map [(return)] 'org-open-at-point) 3924 (org-defkey org-mouse-map [(return)] 'org-open-at-point)
3624 (define-key org-mouse-map "\C-m" 'org-open-at-point)) 3925 (org-defkey org-mouse-map "\C-m" 'org-open-at-point))
3625 3926
3626(require 'font-lock) 3927(require 'font-lock)
3627 3928
3628(defconst org-non-link-chars "]\t\n\r<>") 3929(defconst org-non-link-chars "]\t\n\r<>")
3629(defconst org-link-types '("https?" "ftp" "mailto" "file" "news" "bbdb" "vm" 3930(defconst org-link-types '("http" "https" "ftp" "mailto" "file" "news" "bbdb" "vm"
3630 "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp")) 3931 "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp"))
3631(defconst org-link-re-with-space 3932(defconst org-link-re-with-space
3632 (concat 3933 (concat
@@ -3679,21 +3980,17 @@ that will be added to PLIST. Returns the string that was modified."
3679 (concat "\\(" org-bracket-link-regexp "\\)\\|\\(" 3980 (concat "\\(" org-bracket-link-regexp "\\)\\|\\("
3680 org-angle-link-re "\\)\\|\\(" 3981 org-angle-link-re "\\)\\|\\("
3681 org-plain-link-re "\\)") 3982 org-plain-link-re "\\)")
3682 "Regular expression matching any link.") 3983 "Regular expression matching any link.")
3683 3984
3684(defconst org-ts-lengths 3985(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)>"
3685 (cons (length (format-time-string (car org-time-stamp-formats)))
3686 (length (format-time-string (cdr org-time-stamp-formats))))
3687 "This holds the lengths of the two different time formats.")
3688(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^\r\n>]*?\\)>"
3689 "Regular expression for fast time stamp matching.") 3986 "Regular expression for fast time stamp matching.")
3690(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^\r\n>]*?\\)[]>]" 3987(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)[]>]"
3691 "Regular expression for fast time stamp matching.") 3988 "Regular expression for fast time stamp matching.")
3692(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\([^]0-9>\r\n]*\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" 3989(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) \\([^]0-9>\r\n]*\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
3693 "Regular expression matching time strings for analysis.") 3990 "Regular expression matching time strings for analysis.")
3694(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 ">") 3991(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,6\\}>")
3695 "Regular expression matching time stamps, with groups.") 3992 "Regular expression matching time stamps, with groups.")
3696(defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[]>]") 3993(defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,6\\}[]>]")
3697 "Regular expression matching time stamps (also [..]), with groups.") 3994 "Regular expression matching time stamps (also [..]), with groups.")
3698(defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp) 3995(defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp)
3699 "Regular expression matching a time stamp range.") 3996 "Regular expression matching a time stamp range.")
@@ -3712,27 +4009,87 @@ The time stamps may be either active or inactive.")
3712 4009
3713(defun org-do-emphasis-faces (limit) 4010(defun org-do-emphasis-faces (limit)
3714 "Run through the buffer and add overlays to links." 4011 "Run through the buffer and add overlays to links."
3715 (if (re-search-forward org-emph-re limit t) 4012 (let (rtn)
3716 (progn 4013 (while (and (not rtn) (re-search-forward org-emph-re limit t))
3717 (font-lock-prepend-text-property (match-beginning 2) (match-end 2) 4014 (if (not (= (char-after (match-beginning 3))
3718 'face 4015 (char-after (match-beginning 4))))
3719 (nth 1 (assoc (match-string 3) 4016 (progn
3720 org-emphasis-alist))) 4017 (setq rtn t)
3721 (add-text-properties (match-beginning 2) (match-end 2) 4018 (font-lock-prepend-text-property (match-beginning 2) (match-end 2)
3722 '(font-lock-multiline t)) 4019 'face
3723 (backward-char 1) 4020 (nth 1 (assoc (match-string 3)
3724 t))) 4021 org-emphasis-alist)))
4022 (add-text-properties (match-beginning 2) (match-end 2)
4023 '(font-lock-multiline t))
4024 (backward-char 1))))
4025 rtn))
4026
4027(defun org-emphasize (&optional char)
4028 "Insert or change an emphasis, i.e. a font like bold or italic.
4029If there is an active region, change that region to a new emphasis.
4030If there is no region, just insert the marker characters and position
4031the cursor between them.
4032CHAR should be either the marker character, or the first character of the
4033HTML tag associated with that emphasis. If CHAR is a space, the means
4034to remove the emphasis of the selected region.
4035If char is not given (for example in an interactive call) it
4036will be prompted for."
4037 (interactive)
4038 (let ((eal org-emphasis-alist) e det
4039 (erc org-emphasis-regexp-components)
4040 (prompt "")
4041 (string "") beg end move tag c s)
4042 (if (org-region-active-p)
4043 (setq beg (region-beginning) end (region-end)
4044 string (buffer-substring beg end))
4045 (setq move t))
4046
4047 (while (setq e (pop eal))
4048 (setq tag (car (org-split-string (nth 2 e) "[ <>/]+"))
4049 c (aref tag 0))
4050 (push (cons c (string-to-char (car e))) det)
4051 (setq prompt (concat prompt (format " [%s%c]%s" (car e) c
4052 (substring tag 1)))))
4053 (unless char
4054 (message "%s" (concat "Emphasis marker or tag:" prompt))
4055 (setq char (read-char-exclusive)))
4056 (setq char (or (cdr (assoc char det)) char))
4057 (if (equal char ?\ )
4058 (setq s "" move nil)
4059 (unless (assoc (char-to-string char) org-emphasis-alist)
4060 (error "No such emphasis marker: \"%c\"" char))
4061 (setq s (char-to-string char)))
4062 (while (and (> (length string) 1)
4063 (equal (substring string 0 1) (substring string -1))
4064 (assoc (substring string 0 1) org-emphasis-alist))
4065 (setq string (substring string 1 -1)))
4066 (setq string (concat s string s))
4067 (if beg (delete-region beg end))
4068 (unless (or (bolp)
4069 (string-match (concat "[" (nth 0 erc) "\n]")
4070 (char-to-string (char-before (point)))))
4071 (insert " "))
4072 (unless (string-match (concat "[" (nth 1 erc) "\n]")
4073 (char-to-string (char-after (point))))
4074 (insert " ") (backward-char 1))
4075 (insert string)
4076 (and move (backward-char 1))))
3725 4077
3726(defun org-activate-plain-links (limit) 4078(defun org-activate-plain-links (limit)
3727 "Run through the buffer and add overlays to links." 4079 "Run through the buffer and add overlays to links."
3728 (if (re-search-forward org-plain-link-re limit t) 4080 (catch 'exit
3729 (progn 4081 (let (f)
3730 (add-text-properties (match-beginning 0) (match-end 0) 4082 (while (re-search-forward org-plain-link-re limit t)
3731 (list 'mouse-face 'highlight 4083 (setq f (get-text-property (match-beginning 0) 'face))
3732 'rear-nonsticky t 4084 (if (or (eq f 'org-tag)
3733 'keymap org-mouse-map 4085 (and (listp f) (memq 'org-tag f)))
3734 )) 4086 nil
3735 t))) 4087 (add-text-properties (match-beginning 0) (match-end 0)
4088 (list 'mouse-face 'highlight
4089 'rear-nonsticky t
4090 'keymap org-mouse-map
4091 ))
4092 (throw 'exit t))))))
3736 4093
3737(defun org-activate-angle-links (limit) 4094(defun org-activate-angle-links (limit)
3738 "Run through the buffer and add overlays to links." 4095 "Run through the buffer and add overlays to links."
@@ -3881,11 +4238,6 @@ between words."
3881 'keymap org-mouse-map)) 4238 'keymap org-mouse-map))
3882 t))) 4239 t)))
3883 4240
3884(defun org-font-lock-level ()
3885 (save-excursion
3886 (org-back-to-heading t)
3887 (- (match-end 0) (match-beginning 0))))
3888
3889(defun org-outline-level () 4241(defun org-outline-level ()
3890 (save-excursion 4242 (save-excursion
3891 (looking-at outline-regexp) 4243 (looking-at outline-regexp)
@@ -3906,20 +4258,20 @@ between words."
3906 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" 4258 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
3907 (1 'org-table)) 4259 (1 'org-table))
3908 ;; Links 4260 ;; Links
4261 (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
3909 (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) 4262 (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t)))
3910 (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t))) 4263 (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t)))
3911 (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t))) 4264 (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t)))
3912 (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t))) 4265 (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t)))
3913 (if (memq 'date lk) '(org-activate-dates (0 'org-date t))) 4266 (if (memq 'date lk) '(org-activate-dates (0 'org-date t)))
3914 (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) 4267 '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
3915 '(org-hide-wide-columns (0 nil append)) 4268 '(org-hide-wide-columns (0 nil append))
3916 ;; TODO lines 4269 ;; TODO lines
3917 (list (concat "^\\*+[ \t]*" org-not-done-regexp) 4270 (list (concat "^\\*+[ \t]*" org-not-done-regexp)
3918 '(1 'org-todo t)) 4271 '(1 'org-todo t))
3919 ;; Priorities 4272 ;; Priorities
3920 (list (concat "\\[#[A-Z]\\]") '(0 'org-special-keyword t)) 4273 (list (concat "\\[#[A-Z0-9]\\]") '(0 'org-special-keyword t))
3921 ;; Special keywords 4274 ;; Special keywords
3922 (list org-repeat-re '(0 'org-special-keyword t))
3923 (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) 4275 (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
3924 (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) 4276 (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
3925 (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t)) 4277 (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t))
@@ -3942,9 +4294,13 @@ between words."
3942 '("^#.*" (0 'font-lock-comment-face t)) 4294 '("^#.*" (0 'font-lock-comment-face t))
3943 ;; DONE 4295 ;; DONE
3944 (if org-fontify-done-headline 4296 (if org-fontify-done-headline
3945 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>") 4297 (list (concat "^[*]+ +\\<\\("
4298 (mapconcat 'regexp-quote org-done-keywords "\\|")
4299 "\\)\\(.*\\)")
3946 '(1 'org-done t) '(2 'org-headline-done t)) 4300 '(1 'org-done t) '(2 'org-headline-done t))
3947 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>") 4301 (list (concat "^[*]+ +\\<\\("
4302 (mapconcat 'regexp-quote org-done-keywords "\\|")
4303 "\\)\\>")
3948 '(1 'org-done t))) 4304 '(1 'org-done t)))
3949 ;; Table stuff 4305 ;; Table stuff
3950 '("^[ \t]*\\(:.*\\)" (1 'org-table t)) 4306 '("^[ \t]*\\(:.*\\)" (1 'org-table t))
@@ -4088,7 +4444,8 @@ between words."
4088 (- (funcall outline-level) arg))) 4444 (- (funcall outline-level) arg)))
4089 (org-show-subtree))) 4445 (org-show-subtree)))
4090 4446
4091 ((save-excursion (beginning-of-line 1) (looking-at outline-regexp)) 4447 ((and (save-excursion (beginning-of-line 1) (looking-at outline-regexp))
4448 (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
4092 ;; At a heading: rotate between three different views 4449 ;; At a heading: rotate between three different views
4093 (org-back-to-heading) 4450 (org-back-to-heading)
4094 (let ((goal-column 0) eoh eol eos) 4451 (let ((goal-column 0) eoh eol eos)
@@ -4102,20 +4459,30 @@ between words."
4102 (beginning-of-line 2)) (setq eol (point))) 4459 (beginning-of-line 2)) (setq eol (point)))
4103 (outline-end-of-heading) (setq eoh (point)) 4460 (outline-end-of-heading) (setq eoh (point))
4104 (org-end-of-subtree t) 4461 (org-end-of-subtree t)
4105 (skip-chars-forward " \t\n") 4462 (unless (eobp)
4106 (beginning-of-line 1) ; in case this is an item 4463 (skip-chars-forward " \t\n")
4464 (beginning-of-line 1) ; in case this is an item
4465 )
4107 (setq eos (1- (point)))) 4466 (setq eos (1- (point))))
4108 ;; Find out what to do next and set `this-command' 4467 ;; Find out what to do next and set `this-command'
4109 (cond 4468 (cond
4110 ((= eos eoh) 4469 ((= eos eoh)
4111 ;; Nothing is hidden behind this heading 4470 ;; Nothing is hidden behind this heading
4112 (message "EMPTY ENTRY") 4471 (message "EMPTY ENTRY")
4113 (setq org-cycle-subtree-status nil)) 4472 (setq org-cycle-subtree-status nil)
4473 (save-excursion
4474 (goto-char eos)
4475 (outline-next-heading)
4476 (if (org-invisible-p) (org-flag-heading nil))))
4114 ((>= eol eos) 4477 ((>= eol eos)
4115 ;; Entire subtree is hidden in one line: open it 4478 ;; Entire subtree is hidden in one line: open it
4116 (org-show-entry) 4479 (org-show-entry)
4117 (show-children) 4480 (show-children)
4118 (message "CHILDREN") 4481 (message "CHILDREN")
4482 (save-excursion
4483 (goto-char eos)
4484 (outline-next-heading)
4485 (if (org-invisible-p) (org-flag-heading nil)))
4119 (setq org-cycle-subtree-status 'children) 4486 (setq org-cycle-subtree-status 'children)
4120 (run-hook-with-args 'org-cycle-hook 'children)) 4487 (run-hook-with-args 'org-cycle-hook 'children))
4121 ((and (eq last-command this-command) 4488 ((and (eq last-command this-command)
@@ -4137,6 +4504,11 @@ between words."
4137 4504
4138 ((org-try-cdlatex-tab)) 4505 ((org-try-cdlatex-tab))
4139 4506
4507 ((and (eq org-cycle-emulate-tab 'exc-hl-bol)
4508 (or (not (bolp))
4509 (not (looking-at outline-regexp))))
4510 (call-interactively (global-key-binding "\t")))
4511
4140 ((if (and (memq org-cycle-emulate-tab '(white whitestart)) 4512 ((if (and (memq org-cycle-emulate-tab '(white whitestart))
4141 (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) 4513 (save-excursion (beginning-of-line 1) (looking-at "[ \t]*"))
4142 (or (and (eq org-cycle-emulate-tab 'white) 4514 (or (and (eq org-cycle-emulate-tab 'white)
@@ -4151,7 +4523,7 @@ between words."
4151 (progn 4523 (progn
4152 (beginning-of-line 1) 4524 (beginning-of-line 1)
4153 (and (looking-at "[ \t]+") (replace-match "")))) 4525 (and (looking-at "[ \t]+") (replace-match ""))))
4154 (indent-relative)) 4526 (call-interactively (global-key-binding "\t")))
4155 4527
4156 (t (save-excursion 4528 (t (save-excursion
4157 (org-back-to-heading) 4529 (org-back-to-heading)
@@ -4177,13 +4549,13 @@ of the first headline in the buffer. This is important, because if the
4177first headline is not level one, then (hide-sublevels 1) gives confusing 4549first headline is not level one, then (hide-sublevels 1) gives confusing
4178results." 4550results."
4179 (interactive) 4551 (interactive)
4180 (hide-sublevels (save-excursion 4552 (let ((level (save-excursion
4181 (goto-char (point-min)) 4553 (goto-char (point-min))
4182 (if (re-search-forward (concat "^" outline-regexp) nil t) 4554 (if (re-search-forward (concat "^" outline-regexp) nil t)
4183 (progn 4555 (progn
4184 (goto-char (match-beginning 0)) 4556 (goto-char (match-beginning 0))
4185 (funcall outline-level)) 4557 (funcall outline-level))))))
4186 1)))) 4558 (and level (hide-sublevels level))))
4187 4559
4188(defun org-content (&optional arg) 4560(defun org-content (&optional arg)
4189 "Show all headlines in the buffer, like a table of contents. 4561 "Show all headlines in the buffer, like a table of contents.
@@ -4210,13 +4582,53 @@ With numerical argument N, show content up to level N."
4210This function is the default value of the hook `org-cycle-hook'." 4582This function is the default value of the hook `org-cycle-hook'."
4211 (when (get-buffer-window (current-buffer)) 4583 (when (get-buffer-window (current-buffer))
4212 (cond 4584 (cond
4213 ((eq state 'overview) (org-first-headline-recenter 1)) 4585; ((eq state 'overview) (org-first-headline-recenter 1))
4586; ((eq state 'overview) (org-beginning-of-line))
4214 ((eq state 'content) nil) 4587 ((eq state 'content) nil)
4215 ((eq state 'all) nil) 4588 ((eq state 'all) nil)
4216 ((eq state 'folded) nil) 4589 ((eq state 'folded) nil)
4217 ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1))) 4590 ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1)))
4218 ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1)))))) 4591 ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1))))))
4219 4592
4593
4594(defun org-cycle-show-empty-lines (state)
4595 "Show empty lines above all visible headlines.
4596The region to be covered depends on STATE when called through
4597`org-cycle-hook'. Lisp program can use t for STATE to get the
4598entire buffer covered. Note that an empty line is only shown if there
4599are at least `org-cycle-separator-lines' empty lines before the headeline."
4600 (when (> org-cycle-separator-lines 0)
4601 (save-excursion
4602 (let* ((n org-cycle-separator-lines)
4603 (re (cond
4604 ((= n 1) "\\(\n[ \t]*\n\\*+\\) ")
4605 ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ")
4606 (t (let ((ns (number-to-string (- n 2))))
4607 (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}"
4608 "[ \t]*\\(\n[ \t]*\n\\*+\\) ")))))
4609 beg end)
4610 (cond
4611 ((memq state '(overview contents t))
4612 (setq beg (point-min) end (point-max)))
4613 ((memq state '(children folded))
4614 (setq beg (point) end (progn (org-end-of-subtree t t)
4615 (beginning-of-line 2)
4616 (point)))))
4617 (when beg
4618 (goto-char beg)
4619 (while (re-search-forward re end t)
4620 (if (not (get-char-property (match-end 1) 'invisible))
4621 (outline-flag-region
4622 (match-beginning 1) (match-end 1) nil)))))))
4623 ;; Never hide empty lines at the end of the file.
4624 (save-excursion
4625 (goto-char (point-max))
4626 (outline-previous-heading)
4627 (outline-end-of-heading)
4628 (if (and (looking-at "[ \t\n]+")
4629 (= (match-end 0) (point-max)))
4630 (outline-flag-region (point) (match-end 0) nil))))
4631
4220(defun org-subtree-end-visible-p () 4632(defun org-subtree-end-visible-p ()
4221 "Is the end of the current subtree visible?" 4633 "Is the end of the current subtree visible?"
4222 (pos-visible-in-window-p 4634 (pos-visible-in-window-p
@@ -4238,27 +4650,27 @@ Optional argument N means, put the headline into the Nth line of the window."
4238(let ((cmds '(isearch-forward isearch-backward)) cmd) 4650(let ((cmds '(isearch-forward isearch-backward)) cmd)
4239 (while (setq cmd (pop cmds)) 4651 (while (setq cmd (pop cmds))
4240 (substitute-key-definition cmd cmd org-goto-map global-map))) 4652 (substitute-key-definition cmd cmd org-goto-map global-map)))
4241(define-key org-goto-map "\C-m" 'org-goto-ret) 4653(org-defkey org-goto-map "\C-m" 'org-goto-ret)
4242(define-key org-goto-map [(left)] 'org-goto-left) 4654(org-defkey org-goto-map [(left)] 'org-goto-left)
4243(define-key org-goto-map [(right)] 'org-goto-right) 4655(org-defkey org-goto-map [(right)] 'org-goto-right)
4244(define-key org-goto-map [(?q)] 'org-goto-quit) 4656(org-defkey org-goto-map [(?q)] 'org-goto-quit)
4245(define-key org-goto-map [(control ?g)] 'org-goto-quit) 4657(org-defkey org-goto-map [(control ?g)] 'org-goto-quit)
4246(define-key org-goto-map "\C-i" 'org-cycle) 4658(org-defkey org-goto-map "\C-i" 'org-cycle)
4247(define-key org-goto-map [(tab)] 'org-cycle) 4659(org-defkey org-goto-map [(tab)] 'org-cycle)
4248(define-key org-goto-map [(down)] 'outline-next-visible-heading) 4660(org-defkey org-goto-map [(down)] 'outline-next-visible-heading)
4249(define-key org-goto-map [(up)] 'outline-previous-visible-heading) 4661(org-defkey org-goto-map [(up)] 'outline-previous-visible-heading)
4250(define-key org-goto-map "n" 'outline-next-visible-heading) 4662(org-defkey org-goto-map "n" 'outline-next-visible-heading)
4251(define-key org-goto-map "p" 'outline-previous-visible-heading) 4663(org-defkey org-goto-map "p" 'outline-previous-visible-heading)
4252(define-key org-goto-map "f" 'outline-forward-same-level) 4664(org-defkey org-goto-map "f" 'outline-forward-same-level)
4253(define-key org-goto-map "b" 'outline-backward-same-level) 4665(org-defkey org-goto-map "b" 'outline-backward-same-level)
4254(define-key org-goto-map "u" 'outline-up-heading) 4666(org-defkey org-goto-map "u" 'outline-up-heading)
4255(define-key org-goto-map "\C-c\C-n" 'outline-next-visible-heading) 4667(org-defkey org-goto-map "\C-c\C-n" 'outline-next-visible-heading)
4256(define-key org-goto-map "\C-c\C-p" 'outline-previous-visible-heading) 4668(org-defkey org-goto-map "\C-c\C-p" 'outline-previous-visible-heading)
4257(define-key org-goto-map "\C-c\C-f" 'outline-forward-same-level) 4669(org-defkey org-goto-map "\C-c\C-f" 'outline-forward-same-level)
4258(define-key org-goto-map "\C-c\C-b" 'outline-backward-same-level) 4670(org-defkey org-goto-map "\C-c\C-b" 'outline-backward-same-level)
4259(define-key org-goto-map "\C-c\C-u" 'outline-up-heading) 4671(org-defkey org-goto-map "\C-c\C-u" 'outline-up-heading)
4260(let ((l '(1 2 3 4 5 6 7 8 9 0))) 4672(let ((l '(1 2 3 4 5 6 7 8 9 0)))
4261 (while l (define-key org-goto-map (int-to-string (pop l)) 'digit-argument))) 4673 (while l (org-defkey org-goto-map (int-to-string (pop l)) 'digit-argument)))
4262 4674
4263(defconst org-goto-help 4675(defconst org-goto-help
4264"Select a location to jump to, press RET 4676"Select a location to jump to, press RET
@@ -4474,10 +4886,13 @@ the current headline."
4474 pos) 4886 pos)
4475 (cond 4887 (cond
4476 ((and (org-on-heading-p) (bolp) 4888 ((and (org-on-heading-p) (bolp)
4477 (save-excursion (backward-char 1) (not (org-invisible-p)))) 4889 (or (bobp)
4890 (save-excursion (backward-char 1) (not (org-invisible-p)))))
4478 (open-line (if blank 2 1))) 4891 (open-line (if blank 2 1)))
4479 ((and (bolp) (save-excursion 4892 ((and (bolp)
4480 (backward-char 1) (not (org-invisible-p)))) 4893 (or (bobp)
4894 (save-excursion
4895 (backward-char 1) (not (org-invisible-p)))))
4481 nil) 4896 nil)
4482 (t (newline (if blank 2 1)))) 4897 (t (newline (if blank 2 1))))
4483 (insert head) (just-one-space) 4898 (insert head) (just-one-space)
@@ -4500,8 +4915,8 @@ state (TODO by default). Also with prefix arg, force first state."
4500 (looking-at org-todo-line-regexp)) 4915 (looking-at org-todo-line-regexp))
4501 (if (or arg 4916 (if (or arg
4502 (not (match-beginning 2)) 4917 (not (match-beginning 2))
4503 (equal (match-string 2) org-done-string)) 4918 (member (match-string 2) org-done-keywords))
4504 (insert (car org-todo-keywords) " ") 4919 (insert (car org-todo-keywords-1) " ")
4505 (insert (match-string 2) " ")))) 4920 (insert (match-string 2) " "))))
4506 4921
4507;;; Promotion and Demotion 4922;;; Promotion and Demotion
@@ -4724,6 +5139,7 @@ is signaled in this case."
4724 (setq txt (buffer-substring beg end)) 5139 (setq txt (buffer-substring beg end))
4725 (delete-region beg end) 5140 (delete-region beg end)
4726 (insert txt) 5141 (insert txt)
5142 (or (bolp) (insert "\n"))
4727 (goto-char ins-point) 5143 (goto-char ins-point)
4728 (if folded (hide-subtree)) 5144 (if folded (hide-subtree))
4729 (move-marker ins-point nil))) 5145 (move-marker ins-point nil)))
@@ -4749,7 +5165,9 @@ This is a short-hand for marking the subtree and then copying it.
4749If CUT is non-nil, actually cut the subtree." 5165If CUT is non-nil, actually cut the subtree."
4750 (interactive) 5166 (interactive)
4751 (let (beg end folded) 5167 (let (beg end folded)
4752 (org-back-to-heading) 5168 (if (interactive-p)
5169 (org-back-to-heading nil) ; take what looks like a subtree
5170 (org-back-to-heading t)) ; take what is really there
4753 (setq beg (point)) 5171 (setq beg (point))
4754 (save-match-data 5172 (save-match-data
4755 (save-excursion (outline-end-of-heading) 5173 (save-excursion (outline-end-of-heading)
@@ -4888,7 +5306,7 @@ If optional TXT is given, check this string instead of the current kill."
4888 (save-excursion 5306 (save-excursion
4889 (narrow-to-region 5307 (narrow-to-region
4890 (progn (org-back-to-heading) (point)) 5308 (progn (org-back-to-heading) (point))
4891 (progn (org-end-of-subtree t) (point))))) 5309 (progn (org-end-of-subtree t t) (point)))))
4892 5310
4893 5311
4894;;; Outline Sorting 5312;;; Outline Sorting
@@ -5130,7 +5548,7 @@ with the current numbers. With optional prefix argument ALL, do this for
5130the whole buffer." 5548the whole buffer."
5131 (interactive "P") 5549 (interactive "P")
5132 (save-excursion 5550 (save-excursion
5133 (let* ((buffer-invisibility-spec nil) ; Emacs 21 compatibility 5551 (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21
5134 (beg (progn (outline-back-to-heading) (point))) 5552 (beg (progn (outline-back-to-heading) (point)))
5135 (end (move-marker (make-marker) 5553 (end (move-marker (make-marker)
5136 (progn (outline-next-heading) (point)))) 5554 (progn (outline-next-heading) (point))))
@@ -5214,13 +5632,24 @@ leave it alone. If it is larger than ind, set it to the target."
5214 (concat (make-string i1 ?\ ) l) 5632 (concat (make-string i1 ?\ ) l)
5215 l))) 5633 l)))
5216 5634
5635(defcustom org-empty-line-terminates-plain-lists nil
5636 "Non-nil means, an empty line ends all plain list levels.
5637When nil, empty lines are part of the preceeding item."
5638 :group 'org-plain-lists
5639 :type 'boolean)
5640
5217(defun org-beginning-of-item () 5641(defun org-beginning-of-item ()
5218 "Go to the beginning of the current hand-formatted item. 5642 "Go to the beginning of the current hand-formatted item.
5219If the cursor is not in an item, throw an error." 5643If the cursor is not in an item, throw an error."
5220 (interactive) 5644 (interactive)
5221 (let ((pos (point)) 5645 (let ((pos (point))
5222 (limit (save-excursion (org-back-to-heading) 5646 (limit (save-excursion
5223 (beginning-of-line 2) (point))) 5647 (condition-case nil
5648 (progn
5649 (org-back-to-heading)
5650 (beginning-of-line 2) (point))
5651 (error (point-min)))))
5652 (ind-empty (if org-empty-line-terminates-plain-lists 0 10000))
5224 ind ind1) 5653 ind ind1)
5225 (if (org-at-item-p) 5654 (if (org-at-item-p)
5226 (beginning-of-line 1) 5655 (beginning-of-line 1)
@@ -5230,12 +5659,14 @@ If the cursor is not in an item, throw an error."
5230 (if (catch 'exit 5659 (if (catch 'exit
5231 (while t 5660 (while t
5232 (beginning-of-line 0) 5661 (beginning-of-line 0)
5233 (if (< (point) limit) (throw 'exit nil)) 5662 (if (or (bobp) (< (point) limit)) (throw 'exit nil))
5234 (unless (looking-at "[ \t]*$") 5663
5664 (if (looking-at "[ \t]*$")
5665 (setq ind1 ind-empty)
5235 (skip-chars-forward " \t") 5666 (skip-chars-forward " \t")
5236 (setq ind1 (current-column)) 5667 (setq ind1 (current-column)))
5237 (if (< ind1 ind) 5668 (if (< ind1 ind)
5238 (throw 'exit (org-at-item-p)))))) 5669 (progn (beginning-of-line 1) (throw 'exit (org-at-item-p))))))
5239 nil 5670 nil
5240 (goto-char pos) 5671 (goto-char pos)
5241 (error "Not in an item"))))) 5672 (error "Not in an item")))))
@@ -5244,22 +5675,27 @@ If the cursor is not in an item, throw an error."
5244 "Go to the end of the current hand-formatted item. 5675 "Go to the end of the current hand-formatted item.
5245If the cursor is not in an item, throw an error." 5676If the cursor is not in an item, throw an error."
5246 (interactive) 5677 (interactive)
5247 (let ((pos (point)) 5678 (let* ((pos (point))
5248 (limit (save-excursion (outline-next-heading) (point))) 5679 ind1
5249 (ind (save-excursion 5680 (ind-empty (if org-empty-line-terminates-plain-lists 0 10000))
5250 (org-beginning-of-item) 5681 (limit (save-excursion (outline-next-heading) (point)))
5251 (skip-chars-forward " \t") 5682 (ind (save-excursion
5252 (current-column))) 5683 (org-beginning-of-item)
5253 ind1) 5684 (skip-chars-forward " \t")
5254 (if (catch 'exit 5685 (current-column)))
5255 (while t 5686 (end (catch 'exit
5256 (beginning-of-line 2) 5687 (while t
5257 (if (>= (point) limit) (throw 'exit t)) 5688 (beginning-of-line 2)
5258 (unless (looking-at "[ \t]*$") 5689 (if (eobp) (throw 'exit (point)))
5259 (skip-chars-forward " \t") 5690 (if (>= (point) limit) (throw 'exit (point-at-bol)))
5260 (setq ind1 (current-column)) 5691 (if (looking-at "[ \t]*$")
5261 (if (<= ind1 ind) (throw 'exit t))))) 5692 (setq ind1 ind-empty)
5262 (beginning-of-line 1) 5693 (skip-chars-forward " \t")
5694 (setq ind1 (current-column)))
5695 (if (<= ind1 ind)
5696 (throw 'exit (point-at-bol)))))))
5697 (if end
5698 (goto-char end)
5263 (goto-char pos) 5699 (goto-char pos)
5264 (error "Not in an item")))) 5700 (error "Not in an item"))))
5265 5701
@@ -5338,7 +5774,11 @@ so this really moves item trees."
5338 (while t 5774 (while t
5339 (beginning-of-line 0) 5775 (beginning-of-line 0)
5340 (if (looking-at "[ \t]*$") 5776 (if (looking-at "[ \t]*$")
5341 nil 5777 (if org-empty-line-terminates-plain-lists
5778 (progn
5779 (goto-char pos)
5780 (error "Cannot move this item further up"))
5781 nil)
5342 (if (<= (setq ind1 (org-get-indentation)) ind) 5782 (if (<= (setq ind1 (org-get-indentation)) ind)
5343 (throw 'exit t))))) 5783 (throw 'exit t)))))
5344 (condition-case nil 5784 (condition-case nil
@@ -5468,16 +5908,16 @@ When called with prefix argument FIND-DONE, find whole trees without any
5468open TODO items and archive them (after getting confirmation from the user). 5908open TODO items and archive them (after getting confirmation from the user).
5469If the cursor is not at a headline when this comand is called, try all level 5909If the cursor is not at a headline when this comand is called, try all level
54701 trees. If the cursor is on a headline, only try the direct children of 59101 trees. If the cursor is on a headline, only try the direct children of
5471this heading. " 5911this heading."
5472 (interactive "P") 5912 (interactive "P")
5473 (if find-done 5913 (if find-done
5474 (org-archive-all-done) 5914 (org-archive-all-done)
5475 ;; Save all relevant TODO keyword-relatex variables 5915 ;; Save all relevant TODO keyword-relatex variables
5476 5916
5477 (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler 5917 (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler
5478 (tr-org-todo-keywords org-todo-keywords) 5918 (tr-org-todo-keywords-1 org-todo-keywords-1)
5479 (tr-org-todo-interpretation org-todo-interpretation) 5919 (tr-org-todo-kwd-alist org-todo-kwd-alist)
5480 (tr-org-done-string org-done-string) 5920 (tr-org-done-keywords org-done-keywords)
5481 (tr-org-todo-regexp org-todo-regexp) 5921 (tr-org-todo-regexp org-todo-regexp)
5482 (tr-org-todo-line-regexp org-todo-line-regexp) 5922 (tr-org-todo-line-regexp org-todo-line-regexp)
5483 (tr-org-odd-levels-only org-odd-levels-only) 5923 (tr-org-odd-levels-only org-odd-levels-only)
@@ -5488,8 +5928,10 @@ this heading. "
5488 5928
5489 ;; Try to find a local archive location 5929 ;; Try to find a local archive location
5490 (save-excursion 5930 (save-excursion
5491 (if (or (re-search-backward re nil t) (re-search-forward re nil t)) 5931 (save-restriction
5492 (setq org-archive-location (match-string 1)))) 5932 (widen)
5933 (if (or (re-search-backward re nil t) (re-search-forward re nil t))
5934 (setq org-archive-location (match-string 1)))))
5493 5935
5494 (if (string-match "\\(.*\\)::\\(.*\\)" org-archive-location) 5936 (if (string-match "\\(.*\\)::\\(.*\\)" org-archive-location)
5495 (progn 5937 (progn
@@ -5516,7 +5958,8 @@ this heading. "
5516 ;; Enforce org-mode for the archive buffer 5958 ;; Enforce org-mode for the archive buffer
5517 (if (not (org-mode-p)) 5959 (if (not (org-mode-p))
5518 ;; Force the mode for future visits. 5960 ;; Force the mode for future visits.
5519 (let ((org-insert-mode-line-in-empty-file t)) 5961 (let ((org-insert-mode-line-in-empty-file t)
5962 (org-inhibit-startup t))
5520 (call-interactively 'org-mode))) 5963 (call-interactively 'org-mode)))
5521 (when newfile-p 5964 (when newfile-p
5522 (goto-char (point-max)) 5965 (goto-char (point-max))
@@ -5524,13 +5967,13 @@ this heading. "
5524 (buffer-file-name this-buffer)))) 5967 (buffer-file-name this-buffer))))
5525 ;; Force the TODO keywords of the original buffer 5968 ;; Force the TODO keywords of the original buffer
5526 (let ((org-todo-line-regexp tr-org-todo-line-regexp) 5969 (let ((org-todo-line-regexp tr-org-todo-line-regexp)
5527 (org-todo-keywords tr-org-todo-keywords) 5970 (org-todo-keywords-1 tr-org-todo-keywords-1)
5528 (org-todo-interpretation tr-org-todo-interpretation) 5971 (org-todo-kwd-alist tr-org-todo-kwd-alist)
5529 (org-done-string tr-org-done-string) 5972 (org-done-keywords tr-org-done-keywords)
5530 (org-todo-regexp tr-org-todo-regexp) 5973 (org-todo-regexp tr-org-todo-regexp)
5531 (org-todo-line-regexp tr-org-todo-line-regexp) 5974 (org-todo-line-regexp tr-org-todo-line-regexp)
5532 (org-odd-levels-only 5975 (org-odd-levels-only
5533 (if (local-variable-p 'org-odd-levels-only) 5976 (if (local-variable-p 'org-odd-levels-only (current-buffer))
5534 org-odd-levels-only 5977 org-odd-levels-only
5535 tr-org-odd-levels-only))) 5978 tr-org-odd-levels-only)))
5536 (goto-char (point-min)) 5979 (goto-char (point-min))
@@ -5556,10 +5999,10 @@ this heading. "
5556 (goto-char (point-max)) (insert "\n")) 5999 (goto-char (point-max)) (insert "\n"))
5557 ;; Paste 6000 ;; Paste
5558 (org-paste-subtree (org-get-legal-level level 1)) 6001 (org-paste-subtree (org-get-legal-level level 1))
5559 ;; Mark the entry as done, i.e. set to last work in org-todo-keywords 6002 ;; Mark the entry as done, i.e. set to last word in org-todo-keywords-1 FIXME: not right anymore!!!!!!!
5560 (if org-archive-mark-done 6003 (if org-archive-mark-done
5561 (let (org-log-done) 6004 (let (org-log-done)
5562 (org-todo (length org-todo-keywords)))) 6005 (org-todo (length org-todo-keywords-1))))
5563 ;; Move cursor to right after the TODO keyword 6006 ;; Move cursor to right after the TODO keyword
5564 (when org-archive-stamp-time 6007 (when org-archive-stamp-time
5565 (beginning-of-line 1) 6008 (beginning-of-line 1)
@@ -5653,7 +6096,7 @@ When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
5653(defun org-toggle-tag (tag &optional onoff) 6096(defun org-toggle-tag (tag &optional onoff)
5654 "Toggle the tag TAG for the current line. 6097 "Toggle the tag TAG for the current line.
5655If ONOFF is `on' or `off', don't toggle but set to this state." 6098If ONOFF is `on' or `off', don't toggle but set to this state."
5656 (unless (org-on-heading-p) (error "Not on headling")) 6099 (unless (org-on-heading-p t) (error "Not on headling"))
5657 (let (res current) 6100 (let (res current)
5658 (save-excursion 6101 (save-excursion
5659 (beginning-of-line) 6102 (beginning-of-line)
@@ -5749,6 +6192,8 @@ outside the table.")
5749 "Table row types, non-nil only for the duration of a comand.") 6192 "Table row types, non-nil only for the duration of a comand.")
5750(defvar org-table-current-begin-line nil 6193(defvar org-table-current-begin-line nil
5751 "Table begin line, non-nil only for the duration of a comand.") 6194 "Table begin line, non-nil only for the duration of a comand.")
6195(defvar org-table-current-begin-pos nil
6196 "Table begin position, non-nil only for the duration of a comand.")
5752(defvar org-table-dlines nil 6197(defvar org-table-dlines nil
5753 "Vector of data line line numbers in the current table.") 6198 "Vector of data line line numbers in the current table.")
5754(defvar org-table-hlines nil 6199(defvar org-table-hlines nil
@@ -5760,11 +6205,17 @@ outside the table.")
5760 "Regular expression for matching ranges in formulas.") 6205 "Regular expression for matching ranges in formulas.")
5761 6206
5762(defconst org-table-range-regexp2 6207(defconst org-table-range-regexp2
5763 "@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[a-zA-Z0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[a-zA-Z0-9]+\\)?\\)?\\|\\$[a-zA-Z0-9]+\\.\\.\\$[a-zA-Z0-9]+" 6208 (concat
5764 "Regular expression to recognize ranges in formulas for highlighting.") 6209 "\\(" "@[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)"
6210 "\\.\\."
6211 "\\(" "@?[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)")
6212 "Match a range for reference display.")
5765 6213
5766(defvar org-inhibit-highlight-removal nil) 6214(defconst org-table-translate-regexp
6215 (concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)")
6216 "Match a reference that needs translation, for reference display.")
5767 6217
6218(defvar org-inhibit-highlight-removal nil) ; dynamically scoped param
5768 6219
5769(defun org-table-create-with-table.el () 6220(defun org-table-create-with-table.el ()
5770 "Use the table.el package to insert a new table. 6221 "Use the table.el package to insert a new table.
@@ -5783,8 +6234,9 @@ and table.el tables."
5783 6234
5784(defun org-table-create-or-convert-from-region (arg) 6235(defun org-table-create-or-convert-from-region (arg)
5785 "Convert region to table, or create an empty table. 6236 "Convert region to table, or create an empty table.
5786If there is an active region, convert it to a table. If there is no such 6237If there is an active region, convert it to a table, using the function
5787region, create an empty table." 6238`org-table-convert-region'.
6239If there is no such region, create an empty table with `org-table-create'."
5788 (interactive "P") 6240 (interactive "P")
5789 (if (org-region-active-p) 6241 (if (org-region-active-p)
5790 (org-table-convert-region (region-beginning) (region-end) arg) 6242 (org-table-convert-region (region-beginning) (region-end) arg)
@@ -5827,7 +6279,9 @@ SIZE is a string Columns x Rows like for example \"3x2\"."
5827The region goes from BEG0 to END0, but these borders will be moved 6279The region goes from BEG0 to END0, but these borders will be moved
5828slightly, to make sure a beginning of line in the first line is included. 6280slightly, to make sure a beginning of line in the first line is included.
5829When NSPACE is non-nil, it indicates the minimum number of spaces that 6281When NSPACE is non-nil, it indicates the minimum number of spaces that
5830separate columns (default: just one space)." 6282separate columns. By default, the function first checks if every line
6283contains at lease one TAB. If yes, it assumes that the material is TAB
6284separated. If not, it assumes a single space as separator."
5831 (interactive "rP") 6285 (interactive "rP")
5832 (let* ((beg (min beg0 end0)) 6286 (let* ((beg (min beg0 end0))
5833 (end (max beg0 end0)) 6287 (end (max beg0 end0))
@@ -6249,9 +6703,13 @@ If the current field is not empty, it is copied down to the next row, and
6249the cursor is moved with it. Therefore, repeating this command causes the 6703the cursor is moved with it. Therefore, repeating this command causes the
6250column to be filled row-by-row. 6704column to be filled row-by-row.
6251If the variable `org-table-copy-increment' is non-nil and the field is an 6705If the variable `org-table-copy-increment' is non-nil and the field is an
6252integer, it will be incremented while copying." 6706integer or a timestamp, it will be incremented while copying. In the case of
6707a timestamp, if the cursor is on the year, change the year. If it is on the
6708month or the day, change that. Point will stay on the current date field
6709in order to easily repeat the interval."
6253 (interactive "p") 6710 (interactive "p")
6254 (let* ((colpos (org-table-current-column)) 6711 (let* ((colpos (org-table-current-column))
6712 (col (current-column))
6255 (field (org-table-get-field)) 6713 (field (org-table-get-field))
6256 (non-empty (string-match "[^ \t]" field)) 6714 (non-empty (string-match "[^ \t]" field))
6257 (beg (org-table-begin)) 6715 (beg (org-table-begin))
@@ -6279,8 +6737,12 @@ integer, it will be incremented while copying."
6279 (string-match "^[0-9]+$" txt)) 6737 (string-match "^[0-9]+$" txt))
6280 (setq txt (format "%d" (+ (string-to-number txt) 1)))) 6738 (setq txt (format "%d" (+ (string-to-number txt) 1))))
6281 (insert txt) 6739 (insert txt)
6282 (org-table-maybe-recalculate-line) 6740 (move-to-column col)
6283 (org-table-align)) 6741 (if (and org-table-copy-increment (org-at-timestamp-p t))
6742 (org-timestamp-up 1)
6743 (org-table-maybe-recalculate-line))
6744 (org-table-align)
6745 (move-to-column col))
6284 (error "No non-empty field found")))) 6746 (error "No non-empty field found"))))
6285 6747
6286(defun org-table-check-inside-data-field () 6748(defun org-table-check-inside-data-field ()
@@ -6333,7 +6795,7 @@ is always the old value."
6333 6795
6334(defun org-table-field-info (arg) 6796(defun org-table-field-info (arg)
6335 "Show info about the current field, and highlight any reference at point." 6797 "Show info about the current field, and highlight any reference at point."
6336 (interactive "P") 6798 (interactive "P")
6337 (org-table-get-specials) 6799 (org-table-get-specials)
6338 (save-excursion 6800 (save-excursion
6339 (let* ((pos (point)) 6801 (let* ((pos (point))
@@ -6344,21 +6806,26 @@ is always the old value."
6344 (eql (org-table-get-stored-formulas)) 6806 (eql (org-table-get-stored-formulas))
6345 (dline (org-table-current-dline)) 6807 (dline (org-table-current-dline))
6346 (ref (format "@%d$%d" dline col)) 6808 (ref (format "@%d$%d" dline col))
6809 (ref1 (org-table-convert-refs-to-an ref))
6347 (fequation (or (assoc name eql) (assoc ref eql))) 6810 (fequation (or (assoc name eql) (assoc ref eql)))
6348 (cequation (assoc (int-to-string col) eql))) 6811 (cequation (assoc (int-to-string col) eql))
6812 (eqn (or fequation cequation)))
6349 (goto-char pos) 6813 (goto-char pos)
6350 (condition-case nil 6814 (condition-case nil
6351 (org-show-reference 'local) 6815 (org-table-show-reference 'local)
6352 (error nil)) 6816 (error nil))
6353 (message "line @%d, col $%s%s, ref @%d$%d%s%s" 6817 (message "line @%d, col $%s%s, ref @%d$%d or %s%s%s"
6354 dline col 6818 dline col
6355 (if cname (concat " or $" cname) "") 6819 (if cname (concat " or $" cname) "")
6356 dline col 6820 dline col ref1
6357 (if name (concat " or $" name) "") 6821 (if name (concat " or $" name) "")
6358 ;; FIXME: formula info not correct if special table line 6822 ;; FIXME: formula info not correct if special table line
6359 (if (or fequation cequation) 6823 (if eqn
6360 (concat ", " (if fequation "field" "column") 6824 (concat ", formula: "
6361 " formula applies" "") 6825 (org-table-formula-to-user
6826 (concat
6827 (if (string-match "^[$@]"(car eqn)) "" "$")
6828 (car eqn) "=" (cdr eqn))))
6362 ""))))) 6829 "")))))
6363 6830
6364(defun org-table-current-column () 6831(defun org-table-current-column ()
@@ -6573,7 +7040,7 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
6573 (goto-line linepos) 7040 (goto-line linepos)
6574 (org-table-goto-column colpos) 7041 (org-table-goto-column colpos)
6575 (org-table-align) 7042 (org-table-align)
6576 (org-table-fix-formulas 7043 (org-table-fix-formulas
6577 "$" (list (cons (number-to-string col) (number-to-string colpos)) 7044 "$" (list (cons (number-to-string col) (number-to-string colpos))
6578 (cons (number-to-string colpos) (number-to-string col)))))) 7045 (cons (number-to-string colpos) (number-to-string col))))))
6579 7046
@@ -6591,7 +7058,7 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
6591 (interactive "P") 7058 (interactive "P")
6592 (let* ((col (current-column)) 7059 (let* ((col (current-column))
6593 (pos (point)) 7060 (pos (point))
6594 (hline1p (save-excursion (beginning-of-line 1) 7061 (hline1p (save-excursion (beginning-of-line 1)
6595 (looking-at org-table-hline-regexp))) 7062 (looking-at org-table-hline-regexp)))
6596 (dline1 (org-table-current-dline)) 7063 (dline1 (org-table-current-dline))
6597 (dline2 (+ dline1 (if up -1 1))) 7064 (dline2 (+ dline1 (if up -1 1)))
@@ -6612,7 +7079,7 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
6612 (beginning-of-line 0) 7079 (beginning-of-line 0)
6613 (move-to-column col) 7080 (move-to-column col)
6614 (unless (or hline1p hline2p) 7081 (unless (or hline1p hline2p)
6615 (org-table-fix-formulas 7082 (org-table-fix-formulas
6616 "@" (list (cons (number-to-string dline1) (number-to-string dline2)) 7083 "@" (list (cons (number-to-string dline1) (number-to-string dline2))
6617 (cons (number-to-string dline2) (number-to-string dline1))))))) 7084 (cons (number-to-string dline2) (number-to-string dline1)))))))
6618 7085
@@ -6635,9 +7102,9 @@ With prefix ARG, insert below the current line."
6635 (org-table-align)) 7102 (org-table-align))
6636 (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1))) 7103 (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1)))
6637 7104
6638(defun org-table-insert-hline (&optional arg) 7105(defun org-table-insert-hline (&optional above)
6639 "Insert a horizontal-line below the current line into the table. 7106 "Insert a horizontal-line below the current line into the table.
6640With prefix ARG, insert above the current line." 7107With prefix ABOVE, insert above the current line."
6641 (interactive "P") 7108 (interactive "P")
6642 (if (not (org-at-table-p)) 7109 (if (not (org-at-table-p))
6643 (error "Not at a table")) 7110 (error "Not at a table"))
@@ -6649,12 +7116,25 @@ With prefix ARG, insert above the current line."
6649 (concat "+" (make-string (- (match-end 1) (match-beginning 1)) 7116 (concat "+" (make-string (- (match-end 1) (match-beginning 1))
6650 ?-) "|") t t line))) 7117 ?-) "|") t t line)))
6651 (and (string-match "\\+" line) (setq line (replace-match "|" t t line))) 7118 (and (string-match "\\+" line) (setq line (replace-match "|" t t line)))
6652 (beginning-of-line (if arg 1 2)) 7119 (beginning-of-line (if above 1 2))
6653 (insert line "\n") 7120 (insert line "\n")
6654 (beginning-of-line (if arg 1 -1)) 7121 (beginning-of-line (if above 1 -1))
6655 (move-to-column col) 7122 (move-to-column col)
6656 (and org-table-overlay-coordinates (org-table-align)))) 7123 (and org-table-overlay-coordinates (org-table-align))))
6657 7124
7125(defun org-table-hline-and-move (&optional same-column)
7126 "Insert a hline and move to the row below that line."
7127 (interactive "P")
7128 (let ((col (org-table-current-column)))
7129 (org-table-maybe-eval-formula)
7130 (org-table-maybe-recalculate-line)
7131 (org-table-insert-hline)
7132 (end-of-line 2)
7133 (if (looking-at "\n[ \t]*|-")
7134 (progn (insert "\n|") (org-table-align))
7135 (org-table-next-field))
7136 (if same-column (org-table-goto-column col))))
7137
6658(defun org-table-clean-line (s) 7138(defun org-table-clean-line (s)
6659 "Convert a table line S into a string with only \"|\" and space. 7139 "Convert a table line S into a string with only \"|\" and space.
6660In particular, this does handle wide and invisible characters." 7140In particular, this does handle wide and invisible characters."
@@ -6959,15 +7439,14 @@ it can be edited in place."
6959 (switch-to-buffer-other-window "*Org tmp*") 7439 (switch-to-buffer-other-window "*Org tmp*")
6960 (erase-buffer) 7440 (erase-buffer)
6961 (insert "#\n# Edit field and finish with C-c C-c\n#\n") 7441 (insert "#\n# Edit field and finish with C-c C-c\n#\n")
6962 (org-mode) 7442 (let ((org-inhibit-startup t)) (org-mode))
6963 (goto-char (setq p (point-max))) 7443 (goto-char (setq p (point-max)))
6964 (insert (org-trim field)) 7444 (insert (org-trim field))
6965 (remove-text-properties p (point-max) 7445 (remove-text-properties p (point-max)
6966 '(invisible t org-cwidth t display t 7446 '(invisible t org-cwidth t display t
6967 intangible t)) 7447 intangible t))
6968 (goto-char p) 7448 (goto-char p)
6969 (org-set-local 'org-finish-function 7449 (org-set-local 'org-finish-function 'org-table-finish-edit-field)
6970 'org-table-finish-edit-field)
6971 (org-set-local 'org-window-configuration cw) 7450 (org-set-local 'org-window-configuration cw)
6972 (org-set-local 'org-field-marker pos) 7451 (org-set-local 'org-field-marker pos)
6973 (message "Edit and finish with C-c C-c")))) 7452 (message "Edit and finish with C-c C-c"))))
@@ -6997,8 +7476,8 @@ the table and kill the editing buffer."
6997 7476
6998(defun org-trim (s) 7477(defun org-trim (s)
6999 "Remove whitespace at beginning and end of string." 7478 "Remove whitespace at beginning and end of string."
7000 (if (string-match "^[ \t]+" s) (setq s (replace-match "" t t s))) 7479 (if (string-match "^[ \t\n\r]+" s) (setq s (replace-match "" t t s)))
7001 (if (string-match "[ \t]+$" s) (setq s (replace-match "" t t s))) 7480 (if (string-match "[ \t\n\r]+$" s) (setq s (replace-match "" t t s)))
7002 s) 7481 s)
7003 7482
7004(defun org-wrap (string &optional width lines) 7483(defun org-wrap (string &optional width lines)
@@ -7159,21 +7638,25 @@ If NLAST is a number, only the NLAST fields will actually be summed."
7159 ((equal n 0) nil) 7638 ((equal n 0) nil)
7160 (t n)))) 7639 (t n))))
7161 7640
7162(defun org-table-current-field-formula () 7641(defun org-table-current-field-formula (&optional key noerror)
7163 "Return the formula active for the current field. 7642 "Return the formula active for the current field.
7164Assumes that specials are in place." 7643Assumes that specials are in place.
7644If KEY is given, return the key to this formula.
7645Otherwise return the formula preceeded with \"=\" or \":=\"."
7165 (let* ((name (car (rassoc (list (org-current-line) 7646 (let* ((name (car (rassoc (list (org-current-line)
7166 (org-table-current-column)) 7647 (org-table-current-column))
7167 org-table-named-field-locations))) 7648 org-table-named-field-locations)))
7168 (col (org-table-current-column)) 7649 (col (org-table-current-column))
7169 (scol (int-to-string col)) 7650 (scol (int-to-string col))
7170 (ref (format "@%d$%d" (org-table-current-dline) col)) 7651 (ref (format "@%d$%d" (org-table-current-dline) col))
7171 (stored-list (org-table-get-stored-formulas)) 7652 (stored-list (org-table-get-stored-formulas noerror))
7172 (ass (or (assoc name stored-list) 7653 (ass (or (assoc name stored-list)
7173 (assoc ref stored-list) 7654 (assoc ref stored-list)
7174 (assoc scol stored-list)))) 7655 (assoc scol stored-list))))
7175 (if ass (concat (if (string-match "^[0-9]+$" (car ass)) "=" ":=") 7656 (if key
7176 (cdr ass))))) 7657 (car ass)
7658 (if ass (concat (if (string-match "^[0-9]+$" (car ass)) "=" ":=")
7659 (cdr ass))))))
7177 7660
7178(defun org-table-get-formula (&optional equation named) 7661(defun org-table-get-formula (&optional equation named)
7179 "Read a formula from the minibuffer, offer stored formula as default. 7662 "Read a formula from the minibuffer, offer stored formula as default.
@@ -7199,11 +7682,16 @@ When NAMED is non-nil, look for a named equation."
7199 stored) 7682 stored)
7200 ((stringp equation) 7683 ((stringp equation)
7201 equation) 7684 equation)
7202 (t (read-string 7685 (t (org-table-formula-from-user
7203 (format "%s formula $%s=" (if named "Field" "Column") scol) 7686 (read-string
7204 (or stored "") 'org-table-formula-history 7687 (org-table-formula-to-user
7205 ;stored 7688 (format "%s formula %s%s="
7206 )))) 7689 (if named "Field" "Column")
7690 (if (member (string-to-char scol) '(?$ ?@)) "" "$")
7691 scol))
7692 (if stored (org-table-formula-to-user stored) "")
7693 'org-table-formula-history
7694 )))))
7207 mustsave) 7695 mustsave)
7208 (when (not (string-match "\\S-" eq)) 7696 (when (not (string-match "\\S-" eq))
7209 ;; remove formula 7697 ;; remove formula
@@ -7225,7 +7713,7 @@ When NAMED is non-nil, look for a named equation."
7225 7713
7226(defun org-table-store-formulas (alist) 7714(defun org-table-store-formulas (alist)
7227 "Store the list of formulas below the current table." 7715 "Store the list of formulas below the current table."
7228 (setq alist (sort alist (lambda (a b) (string< (car a) (car b))))) 7716 (setq alist (sort alist 'org-table-formula-less-p))
7229 (save-excursion 7717 (save-excursion
7230 (goto-char (org-table-end)) 7718 (goto-char (org-table-end))
7231 (if (looking-at "\\([ \t]*\n\\)*#\\+TBLFM:\\(.*\n?\\)") 7719 (if (looking-at "\\([ \t]*\n\\)*#\\+TBLFM:\\(.*\n?\\)")
@@ -7242,7 +7730,20 @@ When NAMED is non-nil, look for a named equation."
7242 alist "::") 7730 alist "::")
7243 "\n"))) 7731 "\n")))
7244 7732
7245(defun org-table-get-stored-formulas () 7733(defsubst org-table-formula-make-cmp-string (a)
7734 (when (string-match "^\\(@\\([0-9]+\\)\\)?\\(\\$?\\([0-9]+\\)\\)?\\(\\$?[a-zA-Z0-9]+\\)?" a)
7735 (concat
7736 (if (match-end 2) (format "@%05d" (string-to-number (match-string 2 a))) "")
7737 (if (match-end 4) (format "$%05d" (string-to-number (match-string 4 a))) "")
7738 (if (match-end 5) (concat "@@" (match-string 5 a))))))
7739
7740(defun org-table-formula-less-p (a b)
7741 "Compare two formulas for sorting."
7742 (let ((as (org-table-formula-make-cmp-string (car a)))
7743 (bs (org-table-formula-make-cmp-string (car b))))
7744 (and as bs (string< as bs))))
7745
7746(defun org-table-get-stored-formulas (&optional noerror)
7246 "Return an alist with the stored formulas directly after current table." 7747 "Return an alist with the stored formulas directly after current table."
7247 (interactive) 7748 (interactive)
7248 (let (scol eq eq-alist strings string seen) 7749 (let (scol eq eq-alist strings string seen)
@@ -7252,13 +7753,18 @@ When NAMED is non-nil, look for a named equation."
7252 (setq strings (org-split-string (match-string 2) " *:: *")) 7753 (setq strings (org-split-string (match-string 2) " *:: *"))
7253 (while (setq string (pop strings)) 7754 (while (setq string (pop strings))
7254 (when (string-match "\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*[^ \t]\\)" string) 7755 (when (string-match "\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*[^ \t]\\)" string)
7255 (setq scol (if (match-end 2) 7756 (setq scol (if (match-end 2)
7256 (match-string 2 string) 7757 (match-string 2 string)
7257 (match-string 1 string)) 7758 (match-string 1 string))
7258 eq (match-string 3 string) 7759 eq (match-string 3 string)
7259 eq-alist (cons (cons scol eq) eq-alist)) 7760 eq-alist (cons (cons scol eq) eq-alist))
7260 (if (member scol seen) 7761 (if (member scol seen)
7261 (error "Double definition `$%s=' in TBLFM line, please fix by hand" scol) 7762 (if noerror
7763 (progn
7764 (message "Double definition `$%s=' in TBLFM line, please fix by hand" scol)
7765 (ding)
7766 (sit-for 2))
7767 (error "Double definition `$%s=' in TBLFM line, please fix by hand" scol))
7262 (push scol seen)))))) 7768 (push scol seen))))))
7263 (nreverse eq-alist))) 7769 (nreverse eq-alist)))
7264 7770
@@ -7297,7 +7803,8 @@ For all numbers larger than LIMIT, shift them by DELTA."
7297 org-table-local-parameters nil 7803 org-table-local-parameters nil
7298 org-table-named-field-locations nil 7804 org-table-named-field-locations nil
7299 org-table-current-begin-line nil 7805 org-table-current-begin-line nil
7300 org-table-current-line-types nil) 7806 org-table-current-begin-pos nil
7807 org-table-current-line-types nil)
7301 (goto-char beg) 7808 (goto-char beg)
7302 (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t) 7809 (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t)
7303 (setq names (org-split-string (match-string 1) " *| *") 7810 (setq names (org-split-string (match-string 1) " *| *")
@@ -7334,7 +7841,8 @@ For all numbers larger than LIMIT, shift them by DELTA."
7334 ;; Analyse the line types 7841 ;; Analyse the line types
7335 (goto-char beg) 7842 (goto-char beg)
7336 (setq org-table-current-begin-line (org-current-line) 7843 (setq org-table-current-begin-line (org-current-line)
7337 l org-table-current-begin-line) 7844 org-table-current-begin-pos (point)
7845 l org-table-current-begin-line)
7338 (while (looking-at "[ \t]*|\\(-\\)?") 7846 (while (looking-at "[ \t]*|\\(-\\)?")
7339 (push (if (match-end 1) 'hline 'dline) types) 7847 (push (if (match-end 1) 'hline 'dline) types)
7340 (if (match-end 1) (push l hlines) (push l dlines)) 7848 (if (match-end 1) (push l hlines) (push l dlines))
@@ -7344,13 +7852,6 @@ For all numbers larger than LIMIT, shift them by DELTA."
7344 org-table-dlines (apply 'vector (cons nil (nreverse dlines))) 7852 org-table-dlines (apply 'vector (cons nil (nreverse dlines)))
7345 org-table-hlines (apply 'vector (cons nil (nreverse hlines))))))) 7853 org-table-hlines (apply 'vector (cons nil (nreverse hlines)))))))
7346 7854
7347(defun org-this-word ()
7348 ;; Get the current word
7349 (save-excursion
7350 (let ((beg (progn (skip-chars-backward "^ \t\n") (point)))
7351 (end (progn (skip-chars-forward "^ \t\n") (point))))
7352 (buffer-substring-no-properties beg end))))
7353
7354(defun org-table-maybe-eval-formula () 7855(defun org-table-maybe-eval-formula ()
7355 "Check if the current field starts with \"=\" or \":=\". 7856 "Check if the current field starts with \"=\" or \":=\".
7356If yes, store the formula and apply it." 7857If yes, store the formula and apply it."
@@ -7364,7 +7865,8 @@ If yes, store the formula and apply it."
7364 eq (match-string 1 field)) 7865 eq (match-string 1 field))
7365 (if (or (fboundp 'calc-eval) 7866 (if (or (fboundp 'calc-eval)
7366 (equal (substring eq 0 (min 2 (length eq))) "'(")) 7867 (equal (substring eq 0 (min 2 (length eq))) "'("))
7367 (org-table-eval-formula (if named '(4) nil) eq) 7868 (org-table-eval-formula (if named '(4) nil)
7869 (org-table-formula-from-user eq))
7368 (error "Calc does not seem to be installed, and is needed to evaluate the formula")))))) 7870 (error "Calc does not seem to be installed, and is needed to evaluate the formula"))))))
7369 7871
7370(defvar org-recalc-commands nil 7872(defvar org-recalc-commands nil
@@ -7485,7 +7987,7 @@ formula is installed as valid in only this specific field.
7485 7987
7486When called with two `C-u' prefixes, insert the active equation 7988When called with two `C-u' prefixes, insert the active equation
7487for the field back into the current field, so that it can be 7989for the field back into the current field, so that it can be
7488edited there. This is useful in order to use \\[org-show-reference] 7990edited there. This is useful in order to use \\[org-table-show-reference]
7489to check the referenced fields. 7991to check the referenced fields.
7490 7992
7491When called, the command first prompts for a formula, which is read in 7993When called, the command first prompts for a formula, which is read in
@@ -7577,7 +8079,7 @@ not overwrite the stored one."
7577 ;; Insert complex ranges 8079 ;; Insert complex ranges
7578 (while (string-match org-table-range-regexp form) 8080 (while (string-match org-table-range-regexp form)
7579 (setq form 8081 (setq form
7580 (replace-match 8082 (replace-match
7581 (save-match-data 8083 (save-match-data
7582 (org-table-make-reference 8084 (org-table-make-reference
7583 (org-table-get-range (match-string 0 form) nil n0) 8085 (org-table-get-range (match-string 0 form) nil n0)
@@ -7585,7 +8087,7 @@ not overwrite the stored one."
7585 t t form))) 8087 t t form)))
7586 ;; Insert simple ranges 8088 ;; Insert simple ranges
7587 (while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form) 8089 (while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form)
7588 (setq form 8090 (setq form
7589 (replace-match 8091 (replace-match
7590 (save-match-data 8092 (save-match-data
7591 (org-table-make-reference 8093 (org-table-make-reference
@@ -7596,17 +8098,16 @@ not overwrite the stored one."
7596 t t form))) 8098 t t form)))
7597 (setq form0 form) 8099 (setq form0 form)
7598 ;; Insert the references to fields in same row 8100 ;; Insert the references to fields in same row
7599 (while (string-match "\\$\\([0-9]+\\)?" form) 8101 (while (string-match "\\$\\([0-9]+\\)" form)
7600 (setq n (if (match-beginning 1) 8102 (setq n (string-to-number (match-string 1 form))
7601 (string-to-number (match-string 1 form)) 8103 x (nth (1- (if (= n 0) n0 n)) fields))
7602 n0)
7603 x (nth (1- n) fields))
7604 (unless x (error "Invalid field specifier \"%s\"" 8104 (unless x (error "Invalid field specifier \"%s\""
7605 (match-string 0 form))) 8105 (match-string 0 form)))
7606 (setq form (replace-match 8106 (setq form (replace-match
7607 (save-match-data 8107 (save-match-data
7608 (org-table-make-reference x nil numbers lispp)) 8108 (org-table-make-reference x nil numbers lispp))
7609 t t form))) 8109 t t form)))
8110
7610 (if lispp 8111 (if lispp
7611 (setq ev (condition-case nil 8112 (setq ev (condition-case nil
7612 (eval (eval (read form))) 8113 (eval (eval (read form)))
@@ -7616,7 +8117,7 @@ not overwrite the stored one."
7616 (error "Calc does not seem to be installed, and is needed to evaluate the formula")) 8117 (error "Calc does not seem to be installed, and is needed to evaluate the formula"))
7617 (setq ev (calc-eval (cons form modes) 8118 (setq ev (calc-eval (cons form modes)
7618 (if numbers 'num)))) 8119 (if numbers 'num))))
7619 8120
7620 (when org-table-formula-debug 8121 (when org-table-formula-debug
7621 (with-output-to-temp-buffer "*Substitution History*" 8122 (with-output-to-temp-buffer "*Substitution History*"
7622 (princ (format "Substitution history of formula 8123 (princ (format "Substitution history of formula
@@ -7738,7 +8239,7 @@ and TABLE is a vector with line types."
7738 (setq i 0 hdir "+") 8239 (setq i 0 hdir "+")
7739 (if (eq (aref table 0) 'hline) (setq hn (1- hn))))) 8240 (if (eq (aref table 0) 'hline) (setq hn (1- hn)))))
7740 (if (and (not hn) on (not odir)) 8241 (if (and (not hn) on (not odir))
7741 (error "should never happen");;(aref org-table-dlines on) FIXME 8242 (error "should never happen");;(aref org-table-dlines on)
7742 (if (and hn (> hn 0)) 8243 (if (and hn (> hn 0))
7743 (setq i (org-find-row-type table i 'hline (equal hdir "-") nil hn))) 8244 (setq i (org-find-row-type table i 'hline (equal hdir "-") nil hn)))
7744 (if on 8245 (if on
@@ -7837,7 +8338,7 @@ With prefix arg ALL, do this for all lines in the table."
7837 (goto-char beg) 8338 (goto-char beg)
7838 (and all (message "Re-applying formulas to full table...")) 8339 (and all (message "Re-applying formulas to full table..."))
7839 (while (re-search-forward line-re end t) 8340 (while (re-search-forward line-re end t)
7840 (unless (string-match "^ *[_^!$] *$" (org-table-get-field 1)) 8341 (unless (string-match "^ *[_^!$/] *$" (org-table-get-field 1))
7841 ;; Unprotected line, recalculate 8342 ;; Unprotected line, recalculate
7842 (and all (message "Re-applying formulas to full table...(line %d)" 8343 (and all (message "Re-applying formulas to full table...(line %d)"
7843 (setq cnt (1+ cnt)))) 8344 (setq cnt (1+ cnt))))
@@ -7858,7 +8359,7 @@ With prefix arg ALL, do this for all lines in the table."
7858 a (assoc name org-table-named-field-locations)) 8359 a (assoc name org-table-named-field-locations))
7859 (and (not a) 8360 (and (not a)
7860 (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name) 8361 (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name)
7861 (setq a 8362 (setq a
7862 (list 8363 (list
7863 name 8364 name
7864 (aref org-table-dlines 8365 (aref org-table-dlines
@@ -7876,12 +8377,12 @@ With prefix arg ALL, do this for all lines in the table."
7876 (org-table-goto-column thiscol) 8377 (org-table-goto-column thiscol)
7877 (or noalign (and org-table-may-need-update (org-table-align)) 8378 (or noalign (and org-table-may-need-update (org-table-align))
7878 (and all (message "Re-applying formulas...done")))))) 8379 (and all (message "Re-applying formulas...done"))))))
7879 8380
7880(defun org-table-iterate (&optional arg) 8381(defun org-table-iterate (&optional arg)
7881 "Recalculate the table until it does not change anymore." 8382 "Recalculate the table until it does not change anymore."
7882 (interactive "P") 8383 (interactive "P")
7883 (let ((imax (if arg (prefix-numeric-value arg) 10)) 8384 (let ((imax (if arg (prefix-numeric-value arg) 10))
7884 (i 0) 8385 (i 0)
7885 (lasttbl (buffer-substring (org-table-begin) (org-table-end))) 8386 (lasttbl (buffer-substring (org-table-begin) (org-table-end)))
7886 thistbl) 8387 thistbl)
7887 (catch 'exit 8388 (catch 'exit
@@ -7924,32 +8425,74 @@ Parameters get priority."
7924 (and (fboundp 'constants-get) (constants-get const)) 8425 (and (fboundp 'constants-get) (constants-get const))
7925 "#UNDEFINED_NAME")) 8426 "#UNDEFINED_NAME"))
7926 8427
7927(defvar org-edit-formulas-map (make-sparse-keymap)) 8428(defvar org-table-fedit-map (make-sparse-keymap))
7928(define-key org-edit-formulas-map "\C-c\C-c" 'org-finish-edit-formulas) 8429(org-defkey org-table-fedit-map "\C-x\C-s" 'org-table-fedit-finish)
7929(define-key org-edit-formulas-map "\C-c\C-q" 'org-abort-edit-formulas) 8430(org-defkey org-table-fedit-map "\C-c\C-s" 'org-table-fedit-finish)
7930(define-key org-edit-formulas-map "\C-c?" 'org-show-reference) 8431(org-defkey org-table-fedit-map "\C-c\C-c" 'org-table-fedit-finish)
7931(define-key org-edit-formulas-map [(shift up)] 'org-table-edit-line-up) 8432(org-defkey org-table-fedit-map "\C-c\C-q" 'org-table-fedit-abort)
7932(define-key org-edit-formulas-map [(shift down)] 'org-table-edit-line-down) 8433(org-defkey org-table-fedit-map "\C-c?" 'org-table-show-reference)
7933(define-key org-edit-formulas-map [(shift left)] 'org-table-edit-backward-field) 8434(org-defkey org-table-fedit-map [(meta shift up)] 'org-table-fedit-line-up)
7934(define-key org-edit-formulas-map [(shift right)] 'org-table-edit-next-field) 8435(org-defkey org-table-fedit-map [(meta shift down)] 'org-table-fedit-line-down)
7935(define-key org-edit-formulas-map [(meta up)] 'org-table-edit-scroll-down) 8436(org-defkey org-table-fedit-map [(shift up)] 'org-table-fedit-ref-up)
7936(define-key org-edit-formulas-map [(meta down)] 'org-table-edit-scroll) 8437(org-defkey org-table-fedit-map [(shift down)] 'org-table-fedit-ref-down)
7937(define-key org-edit-formulas-map [(meta tab)] 'lisp-complete-symbol) 8438(org-defkey org-table-fedit-map [(shift left)] 'org-table-fedit-ref-left)
7938(define-key org-edit-formulas-map "\M-\C-i" 'lisp-complete-symbol) 8439(org-defkey org-table-fedit-map [(shift right)] 'org-table-fedit-ref-right)
7939(define-key org-edit-formulas-map [(tab)] 'org-edit-formula-lisp-indent) 8440(org-defkey org-table-fedit-map [(meta up)] 'org-table-fedit-scroll-down)
7940(define-key org-edit-formulas-map "\C-i" 'org-edit-formula-lisp-indent) 8441(org-defkey org-table-fedit-map [(meta down)] 'org-table-fedit-scroll)
8442(org-defkey org-table-fedit-map [(meta tab)] 'lisp-complete-symbol)
8443(org-defkey org-table-fedit-map "\M-\C-i" 'lisp-complete-symbol)
8444(org-defkey org-table-fedit-map [(tab)] 'org-table-fedit-lisp-indent)
8445(org-defkey org-table-fedit-map "\C-i" 'org-table-fedit-lisp-indent)
8446(org-defkey org-table-fedit-map "\C-c\C-r" 'org-table-fedit-toggle-ref-type)
8447(org-defkey org-table-fedit-map "\C-c}" 'org-table-fedit-toggle-coordinates)
8448
8449(easy-menu-define org-table-fedit-menu org-table-fedit-map "Org Edit Formulas Menu"
8450 '("Edit-Formulas"
8451 ["Finish and Install" org-table-fedit-finish t]
8452 ["Finish, Install, and Apply" (org-table-fedit-finish t) :keys "C-u C-c C-c"]
8453 ["Abort" org-table-fedit-abort t]
8454 "--"
8455 ["Pretty-Print Lisp Formula" org-table-fedit-lisp-indent t]
8456 ["Complete Lisp Symbol" lisp-complete-symbol t]
8457 "--"
8458 "Shift Reference at Point"
8459 ["Up" org-table-fedit-ref-up t]
8460 ["Down" org-table-fedit-ref-down t]
8461 ["Left" org-table-fedit-ref-left t]
8462 ["Right" org-table-fedit-ref-right t]
8463 "-"
8464 "Change Test Row for Column Formulas"
8465 ["Up" org-table-fedit-line-up t]
8466 ["Down" org-table-fedit-line-down t]
8467 "--"
8468 ["Scroll Table Window" org-table-fedit-scroll t]
8469 ["Scroll Table Window down" org-table-fedit-scroll-down t]
8470 ["Show Table Grid" org-table-fedit-toggle-coordinates
8471 :style toggle :selected (with-current-buffer (marker-buffer org-pos)
8472 org-table-overlay-coordinates)]
8473 "--"
8474 ["Standard Refs (B3 instead of @3$2)" org-table-fedit-toggle-ref-type
8475 :style toggle :selected org-table-buffer-is-an]))
7941 8476
7942(defvar org-pos) 8477(defvar org-pos)
7943 8478
7944(defun org-table-edit-formulas () 8479(defun org-table-edit-formulas ()
7945 "Edit the formulas of the current table in a separate buffer." 8480 "Edit the formulas of the current table in a separate buffer."
7946 (interactive) 8481 (interactive)
8482 (when (save-excursion (beginning-of-line 1) (looking-at "#\\+TBLFM"))
8483 (beginning-of-line 0))
7947 (unless (org-at-table-p) (error "Not at a table")) 8484 (unless (org-at-table-p) (error "Not at a table"))
7948 (org-table-get-specials) 8485 (org-table-get-specials)
7949 (let ((eql (org-table-get-stored-formulas)) 8486 (let ((key (org-table-current-field-formula 'key 'noerror))
8487 (eql (sort (org-table-get-stored-formulas 'noerror)
8488 'org-table-formula-less-p))
7950 (pos (move-marker (make-marker) (point))) 8489 (pos (move-marker (make-marker) (point)))
8490 (startline 1)
7951 (wc (current-window-configuration)) 8491 (wc (current-window-configuration))
7952 entry s) 8492 (titles '((column . "# Column Formulas\n")
8493 (field . "# Field Formulas\n")
8494 (named . "# Named Field Formulas\n")))
8495 entry s type title)
7953 (switch-to-buffer-other-window "*Edit Formulas*") 8496 (switch-to-buffer-other-window "*Edit Formulas*")
7954 (erase-buffer) 8497 (erase-buffer)
7955 ;; Keep global-font-lock-mode from turning on font-lock-mode 8498 ;; Keep global-font-lock-mode from turning on font-lock-mode
@@ -7958,38 +8501,226 @@ Parameters get priority."
7958 (org-set-local 'font-lock-global-modes (list 'not major-mode)) 8501 (org-set-local 'font-lock-global-modes (list 'not major-mode))
7959 (org-set-local 'org-pos pos) 8502 (org-set-local 'org-pos pos)
7960 (org-set-local 'org-window-configuration wc) 8503 (org-set-local 'org-window-configuration wc)
7961 (use-local-map org-edit-formulas-map) 8504 (use-local-map org-table-fedit-map)
7962 (org-add-hook 'post-command-hook 'org-table-edit-formulas-post-command t t) 8505 (org-add-hook 'post-command-hook 'org-table-fedit-post-command t t)
7963 (setq s "# `C-c C-c' to finish, `C-u C-c C-c' to also apply, `C-c C-q' to abort. 8506 (easy-menu-add org-table-fedit-menu)
7964# `TAB' to pretty-print Lisp expressions, `M-TAB' to complete List symbols 8507 (setq startline (org-current-line))
7965# `M-up/down' to scroll table, `S-up/down' to change line for column formulas\n\n")
7966
7967 (put-text-property 0 (length s) 'face 'font-lock-comment-face s)
7968 (insert s)
7969 (while (setq entry (pop eql)) 8508 (while (setq entry (pop eql))
8509 (setq type (cond
8510 ((equal (string-to-char (car entry)) ?@) 'field)
8511 ((string-match "^[0-9]" (car entry)) 'column)
8512 (t 'named)))
8513 (when (setq title (assq type titles))
8514 (or (bobp) (insert "\n"))
8515 (insert (org-add-props (cdr title) nil 'face font-lock-comment-face))
8516 (setq titles (delq title titles)))
8517 (if (equal key (car entry)) (setq startline (org-current-line)))
7970 (setq s (concat (if (equal (string-to-char (car entry)) ?@) "" "$") 8518 (setq s (concat (if (equal (string-to-char (car entry)) ?@) "" "$")
7971 (car entry) " = " (cdr entry) "\n")) 8519 (car entry) " = " (cdr entry) "\n"))
7972 (remove-text-properties 0 (length s) '(face nil) s) 8520 (remove-text-properties 0 (length s) '(face nil) s)
7973 (insert s)) 8521 (insert s))
7974 (goto-char (point-min)) 8522 (if (eq org-table-use-standard-references t)
7975 (message "Edit formulas and finish with `C-c C-c'."))) 8523 (org-table-fedit-toggle-ref-type))
8524 (goto-line startline)
8525 (message "Edit formulas and finish with `C-c C-c'. See menu for more commands.")))
7976 8526
7977(defun org-table-edit-formulas-post-command () 8527(defun org-table-fedit-post-command ()
7978 (when (not (memq this-command '(lisp-complete-symbol))) 8528 (when (not (memq this-command '(lisp-complete-symbol)))
7979 (let ((win (selected-window))) 8529 (let ((win (selected-window)))
7980 (save-excursion 8530 (save-excursion
7981 (condition-case nil 8531 (condition-case nil
7982 (org-show-reference) 8532 (org-table-show-reference)
7983 (error nil)) 8533 (error nil))
7984 (select-window win))))) 8534 (select-window win)))))
7985 8535
7986(defun org-finish-edit-formulas (&optional arg) 8536(defun org-table-formula-to-user (s)
8537 "Convert a formula from internal to user representation."
8538 (if (eq org-table-use-standard-references t)
8539 (org-table-convert-refs-to-an s)
8540 s))
8541
8542(defun org-table-formula-from-user (s)
8543 "Convert a formula from user to internal representation."
8544 (if org-table-use-standard-references
8545 (org-table-convert-refs-to-rc s)
8546 s))
8547
8548(defun org-table-convert-refs-to-rc (s)
8549 "Convert spreadsheet references from AB7 to @7$28.
8550Works for single references, but also for entire formulas and even the
8551full TBLFM line."
8552 (let ((start 0))
8553 (while (string-match "\\<\\([a-zA-Z]+\\)\\([0-9]+\\>\\|&\\)\\|\\(;[^\r\n:]+\\)" s start)
8554 (cond
8555 ((match-end 3)
8556 ;; format match, just advance
8557 (setq start (match-end 0)))
8558 ((and (> (match-beginning 0) 0)
8559 (equal ?. (aref s (max (1- (match-beginning 0)) 0))))
8560 ;; 3.e5 or something like this. FIXME: is this ok????
8561 (setq start (match-end 0)))
8562 (t
8563 (setq start (match-beginning 0)
8564 s (replace-match
8565 (if (equal (match-string 2 s) "&")
8566 (format "$%d" (org-letters-to-number (match-string 1 s)))
8567 (format "@%d$%d"
8568 (string-to-number (match-string 2 s))
8569 (org-letters-to-number (match-string 1 s))))
8570 t t s)))))
8571 s))
8572
8573(defun org-table-convert-refs-to-an (s)
8574 "Convert spreadsheet references from to @7$28 to AB7.
8575Works for single references, but also for entire formulas and even the
8576full TBLFM line."
8577 (while (string-match "@\\([0-9]+\\)$\\([0-9]+\\)" s)
8578 (setq s (replace-match
8579 (format "%s%d"
8580 (org-number-to-letters
8581 (string-to-number (match-string 2 s)))
8582 (string-to-number (match-string 1 s)))
8583 t t s)))
8584 (while (string-match "\\(^\\|[^0-9a-zA-Z]\\)\\$\\([0-9]+\\)" s)
8585 (setq s (replace-match (concat "\\1"
8586 (org-number-to-letters
8587 (string-to-number (match-string 2 s))) "&")
8588 t nil s)))
8589 s)
8590
8591(defun org-letters-to-number (s)
8592 "Convert a base 26 number represented by letters into an integer.
8593For example: AB -> 28."
8594 (let ((n 0))
8595 (setq s (upcase s))
8596 (while (> (length s) 0)
8597 (setq n (+ (* n 26) (string-to-char s) (- ?A) 1)
8598 s (substring s 1)))
8599 n))
8600
8601(defun org-number-to-letters (n)
8602 "Convert an integer into a base 26 number represented by letters.
8603For example: 28 -> AB."
8604 (let ((s ""))
8605 (while (> n 0)
8606 (setq s (concat (char-to-string (+ (mod (1- n) 26) ?A)) s)
8607 n (/ (1- n) 26)))
8608 s))
8609
8610(defun org-table-fedit-convert-buffer (function)
8611 "Convert all references in this buffer, using FUNTION."
8612 (let ((line (org-current-line)))
8613 (goto-char (point-min))
8614 (while (not (eobp))
8615 (insert (funcall function (buffer-substring (point) (point-at-eol))))
8616 (delete-region (point) (point-at-eol))
8617 (or (eobp) (forward-char 1)))
8618 (goto-line line)))
8619
8620(defun org-table-fedit-toggle-ref-type ()
8621 "Convert all references in the buffer from B3 to @3$2 and back."
8622 (interactive)
8623 (org-set-local 'org-table-buffer-is-an (not org-table-buffer-is-an))
8624 (org-table-fedit-convert-buffer
8625 (if org-table-buffer-is-an
8626 'org-table-convert-refs-to-an 'org-table-convert-refs-to-rc))
8627 (message "Reference type switched to %s"
8628 (if org-table-buffer-is-an "A1 etc" "@row$column")))
8629
8630(defun org-table-fedit-ref-up ()
8631 "Shift the reference at point one row/hline up."
8632 (interactive)
8633 (org-table-fedit-shift-reference 'up))
8634(defun org-table-fedit-ref-down ()
8635 "Shift the reference at point one row/hline down."
8636 (interactive)
8637 (org-table-fedit-shift-reference 'down))
8638(defun org-table-fedit-ref-left ()
8639 "Shift the reference at point one field to the left."
8640 (interactive)
8641 (org-table-fedit-shift-reference 'left))
8642(defun org-table-fedit-ref-right ()
8643 "Shift the reference at point one field to the right."
8644 (interactive)
8645 (org-table-fedit-shift-reference 'right))
8646
8647(defun org-table-fedit-shift-reference (dir)
8648 (cond
8649 ((org-at-regexp-p "\\(\\<[a-zA-Z]\\)&")
8650 (if (memq dir '(left right))
8651 (org-rematch-and-replace 1 (eq dir 'left))
8652 (error "Cannot shift reference in this direction")))
8653 ((org-at-regexp-p "\\(\\<[a-zA-Z]\\{1,2\\}\\)\\([0-9]+\\)")
8654 ;; A B3-like reference
8655 (if (memq dir '(up down))
8656 (org-rematch-and-replace 2 (eq dir 'up))
8657 (org-rematch-and-replace 1 (eq dir 'left))))
8658 ((org-at-regexp-p
8659 "\\(@\\|\\.\\.\\)\\([-+]?\\(I+\\>\\|[0-9]+\\)\\)\\(\\$\\([-+]?[0-9]+\\)\\)?")
8660 ;; An internal reference
8661 (if (memq dir '(up down))
8662 (org-rematch-and-replace 2 (eq dir 'up) (match-end 3))
8663 (org-rematch-and-replace 5 (eq dir 'left))))))
8664
8665(defun org-rematch-and-replace (n &optional decr hline)
8666 "Re-match the group N, and replace it with the shifted refrence."
8667 (or (match-end n) (error "Cannot shift reference in this direction"))
8668 (goto-char (match-beginning n))
8669 (and (looking-at (regexp-quote (match-string n)))
8670 (replace-match (org-shift-refpart (match-string 0) decr hline)
8671 t t)))
8672
8673(defun org-shift-refpart (ref &optional decr hline)
8674 "Shift a refrence part REF.
8675If DECR is set, decrease the references row/column, else increase.
8676If HLINE is set, this may be a hline reference, it certainly is not
8677a translation reference."
8678 (save-match-data
8679 (let* ((sign (string-match "^[-+]" ref)) n)
8680
8681 (if sign (setq sign (substring ref 0 1) ref (substring ref 1)))
8682 (cond
8683 ((and hline (string-match "^I+" ref))
8684 (setq n (string-to-number (concat sign (number-to-string (length ref)))))
8685 (setq n (+ n (if decr -1 1)))
8686 (if (= n 0) (setq n (+ n (if decr -1 1))))
8687 (if sign
8688 (setq sign (if (< n 0) "-" "+") n (abs n))
8689 (setq n (max 1 n)))
8690 (concat sign (make-string n ?I)))
8691
8692 ((string-match "^[0-9]+" ref)
8693 (setq n (string-to-number (concat sign ref)))
8694 (setq n (+ n (if decr -1 1)))
8695 (if sign
8696 (concat (if (< n 0) "-" "+") (number-to-string (abs n)))
8697 (number-to-string (max 1 n))))
8698
8699 ((string-match "^[a-zA-Z]+" ref)
8700 (org-number-to-letters
8701 (max 1 (+ (org-letters-to-number ref) (if decr -1 1)))))
8702
8703 (t (error "Cannot shift reference"))))))
8704
8705(defun org-table-fedit-toggle-coordinates ()
8706 "Toggle the display of coordinates in the refrenced table."
8707 (interactive)
8708 (let ((pos (marker-position org-pos)))
8709 (with-current-buffer (marker-buffer org-pos)
8710 (save-excursion
8711 (goto-char pos)
8712 (org-table-toggle-coordinate-overlays)))))
8713
8714(defun org-table-fedit-finish (&optional arg)
7987 "Parse the buffer for formula definitions and install them. 8715 "Parse the buffer for formula definitions and install them.
7988With prefix ARG, apply the new formulas to the table." 8716With prefix ARG, apply the new formulas to the table."
7989 (interactive "P") 8717 (interactive "P")
7990 (org-table-remove-rectangle-highlight) 8718 (org-table-remove-rectangle-highlight)
8719 (if org-table-use-standard-references
8720 (progn
8721 (org-table-fedit-convert-buffer 'org-table-convert-refs-to-rc)
8722 (setq org-table-buffer-is-an nil)))
7991 (let ((pos org-pos) eql var form) 8723 (let ((pos org-pos) eql var form)
7992 (setq org-pos nil)
7993 (goto-char (point-min)) 8724 (goto-char (point-min))
7994 (while (re-search-forward 8725 (while (re-search-forward
7995 "^\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)" 8726 "^\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)"
@@ -7997,9 +8728,13 @@ With prefix ARG, apply the new formulas to the table."
7997 (setq var (if (match-end 2) (match-string 2) (match-string 1)) 8728 (setq var (if (match-end 2) (match-string 2) (match-string 1))
7998 form (match-string 3)) 8729 form (match-string 3))
7999 (setq form (org-trim form)) 8730 (setq form (org-trim form))
8000 (while (string-match "[ \t]*\n[ \t]*" form) 8731 (when (not (equal form ""))
8001 (setq form (replace-match " " t t form))) 8732 (while (string-match "[ \t]*\n[ \t]*" form)
8002 (push (cons var form) eql)) 8733 (setq form (replace-match " " t t form)))
8734 (when (assoc var eql)
8735 (error "Double formulas for %s" var))
8736 (push (cons var form) eql)))
8737 (setq org-pos nil)
8003 (set-window-configuration org-window-configuration) 8738 (set-window-configuration org-window-configuration)
8004 (select-window (get-buffer-window (marker-buffer pos))) 8739 (select-window (get-buffer-window (marker-buffer pos)))
8005 (goto-char pos) 8740 (goto-char pos)
@@ -8012,7 +8747,7 @@ With prefix ARG, apply the new formulas to the table."
8012 (org-table-recalculate 'all) 8747 (org-table-recalculate 'all)
8013 (message "New formulas installed - press C-u C-c C-c to apply.")))) 8748 (message "New formulas installed - press C-u C-c C-c to apply."))))
8014 8749
8015(defun org-abort-edit-formulas () 8750(defun org-table-fedit-abort ()
8016 "Abort editing formulas, without installing the changes." 8751 "Abort editing formulas, without installing the changes."
8017 (interactive) 8752 (interactive)
8018 (org-table-remove-rectangle-highlight) 8753 (org-table-remove-rectangle-highlight)
@@ -8023,7 +8758,7 @@ With prefix ARG, apply the new formulas to the table."
8023 (move-marker pos nil) 8758 (move-marker pos nil)
8024 (message "Formula editing aborted without installing changes"))) 8759 (message "Formula editing aborted without installing changes")))
8025 8760
8026(defun org-edit-formula-lisp-indent () 8761(defun org-table-fedit-lisp-indent ()
8027 "Pretty-print and re-indent Lisp expressions in the Formula Editor." 8762 "Pretty-print and re-indent Lisp expressions in the Formula Editor."
8028 (interactive) 8763 (interactive)
8029 (let ((pos (point)) beg end ind) 8764 (let ((pos (point)) beg end ind)
@@ -8064,7 +8799,7 @@ With prefix ARG, apply the new formulas to the table."
8064 8799
8065(defvar org-show-positions nil) 8800(defvar org-show-positions nil)
8066 8801
8067(defun org-show-reference (&optional local) 8802(defun org-table-show-reference (&optional local)
8068 "Show the location/value of the $ expression at point." 8803 "Show the location/value of the $ expression at point."
8069 (interactive) 8804 (interactive)
8070 (org-table-remove-rectangle-highlight) 8805 (org-table-remove-rectangle-highlight)
@@ -8077,12 +8812,18 @@ With prefix ARG, apply the new formulas to the table."
8077 var name e what match dest) 8812 var name e what match dest)
8078 (if local (org-table-get-specials)) 8813 (if local (org-table-get-specials))
8079 (setq what (cond 8814 (setq what (cond
8080 ((org-at-regexp-p org-table-range-regexp2) 'range) 8815 ((or (org-at-regexp-p org-table-range-regexp2)
8816 (org-at-regexp-p org-table-translate-regexp)
8817 (org-at-regexp-p org-table-range-regexp))
8818 (setq match
8819 (save-match-data
8820 (org-table-convert-refs-to-rc (match-string 0))))
8821 'range)
8081 ((org-at-regexp-p "\\$[a-zA-Z][a-zA-Z0-9]*") 'name) 8822 ((org-at-regexp-p "\\$[a-zA-Z][a-zA-Z0-9]*") 'name)
8082 ((org-at-regexp-p "\\$[0-9]+") 'column) 8823 ((org-at-regexp-p "\\$[0-9]+") 'column)
8083 ((not local) nil) 8824 ((not local) nil)
8084 (t (error "No reference at point"))) 8825 (t (error "No reference at point")))
8085 match (and what (match-string 0))) 8826 match (and what (or match (match-string 0))))
8086 (when (and match (not (equal (match-beginning 0) (point-at-bol)))) 8827 (when (and match (not (equal (match-beginning 0) (point-at-bol))))
8087 (org-table-add-rectangle-overlay (match-beginning 0) (match-end 0) 8828 (org-table-add-rectangle-overlay (match-beginning 0) (match-end 0)
8088 'secondary-selection)) 8829 'secondary-selection))
@@ -8094,9 +8835,13 @@ With prefix ARG, apply the new formulas to the table."
8094 (setq match (org-table-formula-substitute-names match))) 8835 (setq match (org-table-formula-substitute-names match)))
8095 (unless local 8836 (unless local
8096 (save-excursion 8837 (save-excursion
8838 (end-of-line 1)
8839 (re-search-backward "^\\S-" nil t)
8097 (beginning-of-line 1) 8840 (beginning-of-line 1)
8098 (when (looking-at "\\(\\$[0-9a-zA-Z]+\\|@[0-9]+\\$[0-9]+\\)=") 8841 (when (looking-at "\\(\\$[0-9a-zA-Z]+\\|@[0-9]+\\$[0-9]+\\|[a-zA-Z]+\\([0-9]+\\|&\\)\\) *=")
8099 (setq dest (match-string 1)) 8842 (setq dest
8843 (save-match-data
8844 (org-table-convert-refs-to-rc (match-string 1))))
8100 (org-table-add-rectangle-overlay 8845 (org-table-add-rectangle-overlay
8101 (match-beginning 1) (match-end 1) face2)))) 8846 (match-beginning 1) (match-end 1) face2))))
8102 (if (and (markerp pos) (marker-buffer pos)) 8847 (if (and (markerp pos) (marker-buffer pos))
@@ -8165,18 +8910,20 @@ With prefix ARG, apply the new formulas to the table."
8165 (message "Constant: $%s=%s in `org-table-formula-constants'." 8910 (message "Constant: $%s=%s in `org-table-formula-constants'."
8166 var (cdr e))) 8911 var (cdr e)))
8167 ((setq e (and (fboundp 'constants-get) (constants-get var))) 8912 ((setq e (and (fboundp 'constants-get) (constants-get var)))
8168 (message "Constant: $%s=%s, retrieved from `constants.el'." var e)) 8913 (message "Constant: $%s=%s, from `constants.el'%s."
8914 var e (format " (%s units)" constants-unit-system)))
8169 (t (error "Undefined name $%s" var))))) 8915 (t (error "Undefined name $%s" var)))))
8170 (goto-char pos) 8916 (goto-char pos)
8171 (when org-show-positions 8917 (when (and org-show-positions
8918 (not (memq this-command '(org-table-fedit-scroll
8919 org-table-fedit-scroll-down))))
8172 (push pos org-show-positions) 8920 (push pos org-show-positions)
8921 (push org-table-current-begin-pos org-show-positions)
8173 (let ((min (apply 'min org-show-positions)) 8922 (let ((min (apply 'min org-show-positions))
8174 (max (apply 'max org-show-positions))) 8923 (max (apply 'max org-show-positions)))
8175 (when (or (not (pos-visible-in-window-p min)) 8924 (goto-char min) (recenter 0)
8176 (not (pos-visible-in-window-p max))) 8925 (goto-char max)
8177 (goto-char min) 8926 (or (pos-visible-in-window-p max) (recenter -1))))
8178 (set-window-start (selected-window) (point-at-bol))
8179 (goto-char pos))))
8180 (select-window win)))) 8927 (select-window win))))
8181 8928
8182(defun org-table-force-dataline () 8929(defun org-table-force-dataline ()
@@ -8193,27 +8940,17 @@ With prefix ARG, apply the new formulas to the table."
8193 ((or p1 p2) (goto-char (or p1 p2))) 8940 ((or p1 p2) (goto-char (or p1 p2)))
8194 (t (error "No table dataline around here")))))) 8941 (t (error "No table dataline around here"))))))
8195 8942
8196(defun org-table-edit-line-up () 8943(defun org-table-fedit-line-up ()
8197 "Move cursor one line up in the window showing the table." 8944 "Move cursor one line up in the window showing the table."
8198 (interactive) 8945 (interactive)
8199 (org-table-edit-move 'previous-line)) 8946 (org-table-fedit-move 'previous-line))
8200 8947
8201(defun org-table-edit-line-down () 8948(defun org-table-fedit-line-down ()
8202 "Move cursor one line down in the window showing the table." 8949 "Move cursor one line down in the window showing the table."
8203 (interactive) 8950 (interactive)
8204 (org-table-edit-move 'next-line)) 8951 (org-table-fedit-move 'next-line))
8205 8952
8206(defun org-table-edit-backward-field () 8953(defun org-table-fedit-move (command)
8207 "Move cursor one field backward in the window showing the table."
8208 (interactive)
8209 (org-table-edit-move 'org-table-previous-field))
8210
8211(defun org-table-edit-next-field ()
8212 "Move cursor one field forward in the window showing the table."
8213 (interactive)
8214 (org-table-edit-move 'org-table-next-field))
8215
8216(defun org-table-edit-move (command)
8217 "Move the cursor in the window shoinw the table. 8954 "Move the cursor in the window shoinw the table.
8218Use COMMAND to do the motion, repeat if necessary to end up in a data line." 8955Use COMMAND to do the motion, repeat if necessary to end up in a data line."
8219 (let ((org-table-allow-automatic-line-recalculation nil) 8956 (let ((org-table-allow-automatic-line-recalculation nil)
@@ -8228,17 +8965,17 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line."
8228 (move-marker pos (point)) 8965 (move-marker pos (point))
8229 (select-window win))) 8966 (select-window win)))
8230 8967
8231(defun org-table-edit-scroll (N) 8968(defun org-table-fedit-scroll (N)
8232 (interactive "p") 8969 (interactive "p")
8233 (let ((other-window-scroll-buffer (marker-buffer org-pos))) 8970 (let ((other-window-scroll-buffer (marker-buffer org-pos)))
8234 (scroll-other-window N))) 8971 (scroll-other-window N)))
8235 8972
8236(defun org-table-edit-scroll-down (N) 8973(defun org-table-fedit-scroll-down (N)
8237 (interactive "p") 8974 (interactive "p")
8238 (org-table-edit-scroll (- N))) 8975 (org-table-fedit-scroll (- N)))
8239 8976
8240(defvar org-table-rectangle-overlays nil) 8977(defvar org-table-rectangle-overlays nil)
8241 8978
8242(defun org-table-add-rectangle-overlay (beg end &optional face) 8979(defun org-table-add-rectangle-overlay (beg end &optional face)
8243 "Add a new overlay." 8980 "Add a new overlay."
8244 (let ((ov (org-make-overlay beg end))) 8981 (let ((ov (org-make-overlay beg end)))
@@ -8290,7 +9027,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line."
8290 (mapc 'org-delete-overlay org-table-coordinate-overlays) 9027 (mapc 'org-delete-overlay org-table-coordinate-overlays)
8291 (setq org-table-coordinate-overlays nil) 9028 (setq org-table-coordinate-overlays nil)
8292 (save-excursion 9029 (save-excursion
8293 (let ((id 0) (ih 0) hline eol str ic ov beg) 9030 (let ((id 0) (ih 0) hline eol s1 s2 str ic ov beg)
8294 (goto-char (org-table-begin)) 9031 (goto-char (org-table-begin))
8295 (while (org-at-table-p) 9032 (while (org-at-table-p)
8296 (setq eol (point-at-eol)) 9033 (setq eol (point-at-eol))
@@ -8299,15 +9036,18 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line."
8299 (setq hline (looking-at org-table-hline-regexp)) 9036 (setq hline (looking-at org-table-hline-regexp))
8300 (setq str (if hline (format "I*%-2d" (setq ih (1+ ih))) 9037 (setq str (if hline (format "I*%-2d" (setq ih (1+ ih)))
8301 (format "%4d" (setq id (1+ id))))) 9038 (format "%4d" (setq id (1+ id)))))
8302 (org-overlay-before-string ov str 'org-formula 'evaporate) 9039 (org-overlay-before-string ov str 'org-special-keyword 'evaporate)
8303 (when hline 9040 (when hline
8304 (setq ic 0) 9041 (setq ic 0)
8305 (while (re-search-forward "[+|]-+" eol t) 9042 (while (re-search-forward "[+|]\\(-+\\)" eol t)
8306 (setq beg (1+ (match-beginning 0)) 9043 (setq beg (1+ (match-beginning 0))
8307 str (concat "$" (int-to-string (setq ic (1+ ic))))) 9044 ic (1+ ic)
9045 s1 (concat "$" (int-to-string ic))
9046 s2 (org-number-to-letters ic)
9047 str (if (eq org-table-use-standard-references t) s2 s1))
8308 (setq ov (org-make-overlay beg (+ beg (length str)))) 9048 (setq ov (org-make-overlay beg (+ beg (length str))))
8309 (push ov org-table-coordinate-overlays) 9049 (push ov org-table-coordinate-overlays)
8310 (org-overlay-display ov str 'org-formula 'evaporate))) 9050 (org-overlay-display ov str 'org-special-keyword 'evaporate)))
8311 (beginning-of-line 2))))) 9051 (beginning-of-line 2)))))
8312 9052
8313(defun org-table-toggle-coordinate-overlays () 9053(defun org-table-toggle-coordinate-overlays ()
@@ -8492,7 +9232,7 @@ to execute outside of tables."
8492 '("\C-c}" org-table-toggle-coordinate-overlays) 9232 '("\C-c}" org-table-toggle-coordinate-overlays)
8493 '("\C-c{" org-table-toggle-formula-debugger) 9233 '("\C-c{" org-table-toggle-formula-debugger)
8494 '("\C-m" org-table-next-row) 9234 '("\C-m" org-table-next-row)
8495 (list (org-key 'S-return) 'org-table-copy-down) 9235 '([(shift return)] org-table-copy-down)
8496 '("\C-c\C-q" org-table-wrap-region) 9236 '("\C-c\C-q" org-table-wrap-region)
8497 '("\C-c?" org-table-field-info) 9237 '("\C-c?" org-table-field-info)
8498 '("\C-c " org-table-blank-field) 9238 '("\C-c " org-table-blank-field)
@@ -8507,34 +9247,34 @@ to execute outside of tables."
8507 elt key fun cmd) 9247 elt key fun cmd)
8508 (while (setq elt (pop bindings)) 9248 (while (setq elt (pop bindings))
8509 (setq nfunc (1+ nfunc)) 9249 (setq nfunc (1+ nfunc))
8510 (setq key (car elt) 9250 (setq key (org-key (car elt))
8511 fun (nth 1 elt) 9251 fun (nth 1 elt)
8512 cmd (orgtbl-make-binding fun nfunc key)) 9252 cmd (orgtbl-make-binding fun nfunc key))
8513 (define-key orgtbl-mode-map key cmd)) 9253 (org-defkey orgtbl-mode-map key cmd))
8514 9254
8515 ;; Special treatment needed for TAB and RET 9255 ;; Special treatment needed for TAB and RET
8516 (define-key orgtbl-mode-map [(return)] 9256 (org-defkey orgtbl-mode-map [(return)]
8517 (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m")) 9257 (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m"))
8518 (define-key orgtbl-mode-map "\C-m" 9258 (org-defkey orgtbl-mode-map "\C-m"
8519 (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)])) 9259 (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)]))
8520 9260
8521 (define-key orgtbl-mode-map [(tab)] 9261 (org-defkey orgtbl-mode-map [(tab)]
8522 (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i")) 9262 (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i"))
8523 (define-key orgtbl-mode-map "\C-i" 9263 (org-defkey orgtbl-mode-map "\C-i"
8524 (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)])) 9264 (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)]))
8525 9265
8526 (define-key orgtbl-mode-map [(shift tab)] 9266 (org-defkey orgtbl-mode-map [(shift tab)]
8527 (orgtbl-make-binding 'org-table-previous-field 104 9267 (orgtbl-make-binding 'org-table-previous-field 104
8528 [(shift tab)] [(tab)] "\C-i")) 9268 [(shift tab)] [(tab)] "\C-i"))
8529 9269
8530 (define-key orgtbl-mode-map "\M-\C-m" 9270 (org-defkey orgtbl-mode-map "\M-\C-m"
8531 (orgtbl-make-binding 'org-table-wrap-region 105 9271 (orgtbl-make-binding 'org-table-wrap-region 105
8532 "\M-\C-m" [(meta return)])) 9272 "\M-\C-m" [(meta return)]))
8533 (define-key orgtbl-mode-map [(meta return)] 9273 (org-defkey orgtbl-mode-map [(meta return)]
8534 (orgtbl-make-binding 'org-table-wrap-region 106 9274 (orgtbl-make-binding 'org-table-wrap-region 106
8535 [(meta return)] "\M-\C-m")) 9275 [(meta return)] "\M-\C-m"))
8536 9276
8537 (define-key orgtbl-mode-map "\C-c\C-c" 'orgtbl-ctrl-c-ctrl-c) 9277 (org-defkey orgtbl-mode-map "\C-c\C-c" 'orgtbl-ctrl-c-ctrl-c)
8538 (when orgtbl-optimized 9278 (when orgtbl-optimized
8539 ;; If the user wants maximum table support, we need to hijack 9279 ;; If the user wants maximum table support, we need to hijack
8540 ;; some standard editing functions 9280 ;; some standard editing functions
@@ -8542,7 +9282,7 @@ to execute outside of tables."
8542 'self-insert-command 'orgtbl-self-insert-command 9282 'self-insert-command 'orgtbl-self-insert-command
8543 'delete-char 'org-delete-char 9283 'delete-char 'org-delete-char
8544 'delete-backward-char 'org-delete-backward-char) 9284 'delete-backward-char 'org-delete-backward-char)
8545 (define-key orgtbl-mode-map "|" 'org-force-self-insert)) 9285 (org-defkey orgtbl-mode-map "|" 'org-force-self-insert))
8546 (easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu" 9286 (easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu"
8547 '("OrgTbl" 9287 '("OrgTbl"
8548 ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"] 9288 ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"]
@@ -8678,7 +9418,31 @@ overwritten, and the table is not marked as requiring realignment."
8678(defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$" 9418(defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$"
8679 "Regula expression matching exponentials as produced by calc.") 9419 "Regula expression matching exponentials as produced by calc.")
8680 9420
8681(defvar org-table-clean-did-remove-column-1 nil) 9421(defvar org-table-clean-did-remove-column nil)
9422
9423(defun orgtbl-export (table target)
9424 (let ((func (intern (concat "orgtbl-to-" (symbol-name target))))
9425 (lines (org-split-string table "[ \t]*\n[ \t]*"))
9426 org-table-last-alignment org-table-last-column-widths
9427 maxcol column)
9428 (if (not (fboundp func))
9429 (error "Cannot export orgtbl table to %s" target))
9430 (setq lines (org-table-clean-before-export lines))
9431 (setq table
9432 (mapcar
9433 (lambda (x)
9434 (if (string-match org-table-hline-regexp x)
9435 'hline
9436 (org-split-string (org-trim x) "\\s-*|\\s-*")))
9437 lines))
9438 (setq maxcol (apply 'max (mapcar (lambda (x) (if (listp x) (length x) 0))
9439 table)))
9440 (loop for i from (1- maxcol) downto 0 do
9441 (setq column (mapcar (lambda (x) (if (listp x) (nth i x) nil)) table))
9442 (setq column (delq nil column))
9443 (push (apply 'max (mapcar 'string-width column)) org-table-last-column-widths)
9444 (push (> (/ (apply '+ (mapcar (lambda (x) (if (string-match org-table-number-regexp x) 1 0)) column)) maxcol) org-table-number-fraction) org-table-last-alignment))
9445 (funcall func table nil)))
8682 9446
8683(defun orgtbl-send-table (&optional maybe) 9447(defun orgtbl-send-table (&optional maybe)
8684 "Send a tranformed version of this table to the receiver position. 9448 "Send a tranformed version of this table to the receiver position.
@@ -8706,7 +9470,7 @@ this table."
8706 (org-table-begin) (org-table-end))) 9470 (org-table-begin) (org-table-end)))
8707 (lines (nthcdr (or skip 0) (org-split-string txt "[ \t]*\n[ \t]*"))) 9471 (lines (nthcdr (or skip 0) (org-split-string txt "[ \t]*\n[ \t]*")))
8708 (lines (org-table-clean-before-export lines)) 9472 (lines (org-table-clean-before-export lines))
8709 (i0 (if org-table-clean-did-remove-column-1 2 1)) 9473 (i0 (if org-table-clean-did-remove-column 2 1))
8710 (table (mapcar 9474 (table (mapcar
8711 (lambda (x) 9475 (lambda (x)
8712 (if (string-match org-table-hline-regexp x) 9476 (if (string-match org-table-hline-regexp x)
@@ -8722,7 +9486,7 @@ this table."
8722 (org-table-last-column-widths 9486 (org-table-last-column-widths
8723 (org-remove-by-index (funcall fun org-table-last-column-widths) 9487 (org-remove-by-index (funcall fun org-table-last-column-widths)
8724 skipcols i0))) 9488 skipcols i0)))
8725 9489
8726 (unless (fboundp transform) 9490 (unless (fboundp transform)
8727 (error "No such transformation function %s" transform)) 9491 (error "No such transformation function %s" transform))
8728 (setq txt (funcall transform table params)) 9492 (setq txt (funcall transform table params))
@@ -8754,7 +9518,7 @@ First element has index 0, or I0 if given."
8754 (setq i0 (1+ i0)) 9518 (setq i0 (1+ i0))
8755 (if (memq i0 indices) :rm x)) 9519 (if (memq i0 indices) :rm x))
8756 list)))) 9520 list))))
8757 9521
8758(defun orgtbl-toggle-comment () 9522(defun orgtbl-toggle-comment ()
8759 "Comment or uncomment the orgtbl at point." 9523 "Comment or uncomment the orgtbl at point."
8760 (interactive) 9524 (interactive)
@@ -8850,7 +9614,7 @@ directly by `orgtbl-send-table'. See manual."
8850 (splicep (plist-get p :splice)) 9614 (splicep (plist-get p :splice))
8851 (hline (plist-get p :hline)) 9615 (hline (plist-get p :hline))
8852 rtn line i fm efm lfmt h) 9616 rtn line i fm efm lfmt h)
8853 9617
8854 ;; Do we have a header? 9618 ;; Do we have a header?
8855 (if (and (not splicep) (listp (car table)) (memq 'hline table)) 9619 (if (and (not splicep) (listp (car table)) (memq 'hline table))
8856 (setq h t)) 9620 (setq h t))
@@ -8858,7 +9622,7 @@ directly by `orgtbl-send-table'. See manual."
8858 ;; Put header 9622 ;; Put header
8859 (unless splicep 9623 (unless splicep
8860 (push (or (plist-get p :tstart) "ERROR: no :tstart") rtn)) 9624 (push (or (plist-get p :tstart) "ERROR: no :tstart") rtn))
8861 9625
8862 ;; Now loop over all lines 9626 ;; Now loop over all lines
8863 (while (setq line (pop table)) 9627 (while (setq line (pop table))
8864 (if (eq line 'hline) 9628 (if (eq line 'hline)
@@ -8886,10 +9650,10 @@ directly by `orgtbl-send-table'. See manual."
8886 (mapconcat 'identity line (org-get-param p h i :sep :hsep)) 9650 (mapconcat 'identity line (org-get-param p h i :sep :hsep))
8887 (org-get-param p h i :lend :hlend)) 9651 (org-get-param p h i :lend :hlend))
8888 rtn)))) 9652 rtn))))
8889 9653
8890 (unless splicep 9654 (unless splicep
8891 (push (or (plist-get p :tend) "ERROR: no :tend") rtn)) 9655 (push (or (plist-get p :tend) "ERROR: no :tend") rtn))
8892 9656
8893 (mapconcat 'identity (nreverse rtn) "\n"))) 9657 (mapconcat 'identity (nreverse rtn) "\n")))
8894 9658
8895(defun orgtbl-to-latex (table params) 9659(defun orgtbl-to-latex (table params)
@@ -9041,7 +9805,7 @@ For file links, arg negates `org-context-in-file-links'."
9041 (setq cpltxt (concat "bbdb:" (or name company)) 9805 (setq cpltxt (concat "bbdb:" (or name company))
9042 link (org-make-link cpltxt)) 9806 link (org-make-link cpltxt))
9043 (org-store-link-props :type "bbdb" :name name :company company))) 9807 (org-store-link-props :type "bbdb" :name name :company company)))
9044 9808
9045 ((eq major-mode 'Info-mode) 9809 ((eq major-mode 'Info-mode)
9046 (setq link (org-make-link "info:" 9810 (setq link (org-make-link "info:"
9047 (file-name-nondirectory Info-current-file) 9811 (file-name-nondirectory Info-current-file)
@@ -9219,7 +9983,7 @@ For file links, arg negates `org-context-in-file-links'."
9219 (if (string-match "::\\'" cpltxt) 9983 (if (string-match "::\\'" cpltxt)
9220 (setq cpltxt (substring cpltxt 0 -2))) 9984 (setq cpltxt (substring cpltxt 0 -2)))
9221 (setq link (org-make-link cpltxt))) 9985 (setq link (org-make-link cpltxt)))
9222 9986
9223 (buffer-file-name 9987 (buffer-file-name
9224 ;; Just link to this file here. 9988 ;; Just link to this file here.
9225 (setq cpltxt (concat "file:" 9989 (setq cpltxt (concat "file:"
@@ -9430,7 +10194,8 @@ is in the current directory or below.
9430With three \\[universal-argument] prefixes, negate the meaning of 10194With three \\[universal-argument] prefixes, negate the meaning of
9431`org-keep-stored-link-after-insertion'." 10195`org-keep-stored-link-after-insertion'."
9432 (interactive "P") 10196 (interactive "P")
9433 (let ((region (if (org-region-active-p) 10197 (let ((wcf (current-window-configuration))
10198 (region (if (org-region-active-p)
9434 (prog1 (buffer-substring (region-beginning) (region-end)) 10199 (prog1 (buffer-substring (region-beginning) (region-end))
9435 (delete-region (region-beginning) (region-end))))) 10200 (delete-region (region-beginning) (region-end)))))
9436 tmphist ; byte-compile incorrectly complains about this 10201 tmphist ; byte-compile incorrectly complains about this
@@ -9469,13 +10234,31 @@ With three \\[universal-argument] prefixes, negate the meaning of
9469 (t (setq link (org-make-link "file:" file)))))) 10234 (t (setq link (org-make-link "file:" file))))))
9470 (t 10235 (t
9471 ;; Read link, with completion for stored links. 10236 ;; Read link, with completion for stored links.
9472 ;; Fake a link history 10237 (with-output-to-temp-buffer "*Org Links*"
10238 (princ "Insert a link. Use TAB to complete valid link prefixes.\n")
10239 (when org-stored-links
10240 (princ "\nStored links ar available with <up>/<down> (most recent with RET):\n\n")
10241 (princ (mapconcat 'car (reverse org-stored-links) "\n"))))
10242 (let ((cw (selected-window)))
10243 (select-window (get-buffer-window "*Org Links*"))
10244 (shrink-window-if-larger-than-buffer)
10245 (setq truncate-lines t)
10246 (select-window cw))
10247 ;; Fake a link history, containing the stored links.
9473 (setq tmphist (append (mapcar 'car org-stored-links) 10248 (setq tmphist (append (mapcar 'car org-stored-links)
9474 org-insert-link-history)) 10249 org-insert-link-history))
9475 (setq link (org-completing-read 10250 (unwind-protect
9476 "Link: " org-stored-links nil nil nil 10251 (setq link (org-completing-read
9477 'tmphist 10252 "Link: "
9478 (or (car (car org-stored-links))))) 10253 (append
10254 (mapcar (lambda (x) (concat (car x) ":"))
10255 (append org-link-abbrev-alist-local org-link-abbrev-alist))
10256 (mapcar (lambda (x) (concat x ":")) org-link-types))
10257 nil nil nil
10258 'tmphist
10259 (or (car (car org-stored-links)))))
10260 (set-window-configuration wcf)
10261 (kill-buffer "*Org Links*"))
9479 (setq entry (assoc link org-stored-links)) 10262 (setq entry (assoc link org-stored-links))
9480 (or entry (push link org-insert-link-history)) 10263 (or entry (push link org-insert-link-history))
9481 (if (funcall (if (equal complete-file '(64)) 'not 'identity) 10264 (if (funcall (if (equal complete-file '(64)) 'not 'identity)
@@ -9531,7 +10314,7 @@ With three \\[universal-argument] prefixes, negate the meaning of
9531(defun org-completing-read (&rest args) 10314(defun org-completing-read (&rest args)
9532 (let ((minibuffer-local-completion-map 10315 (let ((minibuffer-local-completion-map
9533 (copy-keymap minibuffer-local-completion-map))) 10316 (copy-keymap minibuffer-local-completion-map)))
9534 (define-key minibuffer-local-completion-map " " 'self-insert-command) 10317 (org-defkey minibuffer-local-completion-map " " 'self-insert-command)
9535 (apply 'completing-read args))) 10318 (apply 'completing-read args)))
9536 10319
9537;;; Opening/following a link 10320;;; Opening/following a link
@@ -9637,7 +10420,7 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
9637 (setq type (match-string 1) path (match-string 2)) 10420 (setq type (match-string 1) path (match-string 2))
9638 (throw 'match t))) 10421 (throw 'match t)))
9639 (save-excursion 10422 (save-excursion
9640 (when (org-in-regexp "\\(:[A-Za-z_@0-9:]+\\):[ \t\r\n]") 10423 (when (org-in-regexp "\\(:[A-Za-z_@0-9:]+\\):[ \t]*$")
9641 (setq type "tags" 10424 (setq type "tags"
9642 path (match-string 1)) 10425 path (match-string 1))
9643 (while (string-match ":" path) 10426 (while (string-match ":" path)
@@ -9830,6 +10613,10 @@ If the current buffer is in `dired-mode', grep will be used to search
9830in all files. If AVOID-POS is given, ignore matches near that position." 10613in all files. If AVOID-POS is given, ignore matches near that position."
9831 (let ((case-fold-search t) 10614 (let ((case-fold-search t)
9832 (s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " ")) 10615 (s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " "))
10616 (markers (concat "\\(?:" (mapconcat (lambda (x) (regexp-quote (car x)))
10617 (append '((" ") ("\t") ("\n"))
10618 org-emphasis-alist)
10619 "\\|") "\\)"))
9833 (pos (point)) 10620 (pos (point))
9834 (pre "") (post "") 10621 (pre "") (post "")
9835 words re0 re1 re2 re3 re4 re5 re2a reall) 10622 words re0 re1 re2 re3 re4 re5 re2a reall)
@@ -9866,7 +10653,8 @@ in all files. If AVOID-POS is given, ignore matches near that position."
9866 ;; Make a series of regular expressions to find a match 10653 ;; Make a series of regular expressions to find a match
9867 (setq words (org-split-string s "[ \n\r\t]+") 10654 (setq words (org-split-string s "[ \n\r\t]+")
9868 re0 (concat "\\(<<" (regexp-quote s0) ">>\\)") 10655 re0 (concat "\\(<<" (regexp-quote s0) ">>\\)")
9869 re2 (concat "[ \t\r\n]\\(" (mapconcat 'downcase words "[ \t]+") "\\)[ \t\r\n]") 10656 re2 (concat markers "\\(" (mapconcat 'downcase words "[ \t]+")
10657 "\\)" markers)
9870 re2a (concat "[ \t\r\n]\\(" (mapconcat 'downcase words "[ \t\r\n]+") "\\)[ \t\r\n]") 10658 re2a (concat "[ \t\r\n]\\(" (mapconcat 'downcase words "[ \t\r\n]+") "\\)[ \t\r\n]")
9871 re4 (concat "[^a-zA-Z_]\\(" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]") 10659 re4 (concat "[^a-zA-Z_]\\(" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]")
9872 re1 (concat pre re2 post) 10660 re1 (concat pre re2 post)
@@ -9908,16 +10696,18 @@ enclose the position of `org-open-link-marker'."
9908 (let ((m org-open-link-marker)) 10696 (let ((m org-open-link-marker))
9909 (catch 'exit 10697 (catch 'exit
9910 (while (apply 're-search-forward args) 10698 (while (apply 're-search-forward args)
9911 (goto-char (match-end group)) 10699 (unless (get-text-property (match-end group) 'intangible) ; Emacs 21
9912 (if (and (or (not (eq (marker-buffer m) (current-buffer))) 10700 (goto-char (match-end group))
9913 (> (match-beginning 0) (marker-position m)) 10701 (if (and (or (not (eq (marker-buffer m) (current-buffer)))
9914 (< (match-end 0) (marker-position m))) 10702 (> (match-beginning 0) (marker-position m))
9915 (save-match-data 10703 (< (match-end 0) (marker-position m)))
9916 (or (not (org-in-regexp org-bracket-link-analytic-regexp 1)) 10704 (save-match-data
9917 (not (match-end 4)) ; no description 10705 (or (not (org-in-regexp
9918 (and (<= (match-beginning 4) (point)) 10706 org-bracket-link-analytic-regexp 1))
9919 (>= (match-end 4) (point)))))) 10707 (not (match-end 4)) ; no description
9920 (throw 'exit (point))))))) 10708 (and (<= (match-beginning 4) (point))
10709 (>= (match-end 4) (point))))))
10710 (throw 'exit (point))))))))
9921 10711
9922(defun org-get-buffer-for-internal-link (buffer) 10712(defun org-get-buffer-for-internal-link (buffer)
9923 "Return a buffer to be used for displaying the link target of internal links." 10713 "Return a buffer to be used for displaying the link target of internal links."
@@ -10065,7 +10855,7 @@ onto the ring."
10065 (funcall (cdr (assq 'gnus org-link-frame-setup))) 10855 (funcall (cdr (assq 'gnus org-link-frame-setup)))
10066 (if gnus-other-frame-object (select-frame gnus-other-frame-object)) 10856 (if gnus-other-frame-object (select-frame gnus-other-frame-object))
10067 (cond ((and group article) 10857 (cond ((and group article)
10068 (gnus-group-read-group 0 nil group) 10858 (gnus-group-read-group 1 nil group)
10069 (gnus-summary-goto-article (string-to-number article) nil t)) 10859 (gnus-summary-goto-article (string-to-number article) nil t))
10070 (group (gnus-group-jump-to-group group)))) 10860 (group (gnus-group-jump-to-group group))))
10071 10861
@@ -10346,7 +11136,7 @@ If the file does not exist, an error is thrown."
10346 (if (stringp command) 11136 (if (stringp command)
10347 (setq cmd command) 11137 (setq cmd command)
10348 (setq cmd 'emacs)))) 11138 (setq cmd 'emacs))))
10349 (if (and (not (eq cmd 'emacs)) ; Emacs has not problems with non-ex files 11139 (if (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files
10350 (not (file-exists-p file)) 11140 (not (file-exists-p file))
10351 (not org-open-non-existing-files)) 11141 (not org-open-non-existing-files))
10352 (error "No such file: %s" file)) 11142 (error "No such file: %s" file))
@@ -10380,10 +11170,6 @@ If the file does not exist, an error is thrown."
10380 org-file-apps-defaults-windowsnt) 11170 org-file-apps-defaults-windowsnt)
10381 (t org-file-apps-defaults-gnu))) 11171 (t org-file-apps-defaults-gnu)))
10382 11172
10383(defun org-expand-file-name (path)
10384 "Replace special path abbreviations and expand the file name."
10385 (expand-file-name path))
10386
10387(defvar ange-ftp-name-format) ; to silence the XEmacs compiler. 11173(defvar ange-ftp-name-format) ; to silence the XEmacs compiler.
10388(defun org-file-remote-p (file) 11174(defun org-file-remote-p (file)
10389 "Test whether FILE specifies a location on a remote system. 11175 "Test whether FILE specifies a location on a remote system.
@@ -10569,7 +11355,7 @@ See also the variable `org-reverse-note-order'."
10569 (replace-match "")) 11355 (replace-match ""))
10570 (catch 'quit 11356 (catch 'quit
10571 (let* ((txt (buffer-substring (point-min) (point-max))) 11357 (let* ((txt (buffer-substring (point-min) (point-max)))
10572 (fastp current-prefix-arg) 11358 (fastp (equal current-prefix-arg '(4)))
10573 (file (if fastp org-default-notes-file (org-get-org-file))) 11359 (file (if fastp org-default-notes-file (org-get-org-file)))
10574 (heading org-remember-default-headline) 11360 (heading org-remember-default-headline)
10575 (visiting (org-find-base-buffer-visiting file)) 11361 (visiting (org-find-base-buffer-visiting file))
@@ -10577,6 +11363,7 @@ See also the variable `org-reverse-note-order'."
10577 (org-startup-align-all-tables nil) 11363 (org-startup-align-all-tables nil)
10578 (org-goto-start-pos 1) 11364 (org-goto-start-pos 1)
10579 spos level indent reversed) 11365 spos level indent reversed)
11366 (setq current-prefix-arg nil)
10580 ;; Modify text so that it becomes a nice subtree which can be inserted 11367 ;; Modify text so that it becomes a nice subtree which can be inserted
10581 ;; into an org tree. 11368 ;; into an org tree.
10582 (let* ((lines (split-string txt "\n")) 11369 (let* ((lines (split-string txt "\n"))
@@ -10597,13 +11384,13 @@ See also the variable `org-reverse-note-order'."
10597 ;; Find the file 11384 ;; Find the file
10598 (if (not visiting) (find-file-noselect file)) 11385 (if (not visiting) (find-file-noselect file))
10599 (with-current-buffer (or visiting (get-file-buffer file)) 11386 (with-current-buffer (or visiting (get-file-buffer file))
10600 (save-excursion (and (goto-char (point-min))
10601 (not (re-search-forward "^\\* " nil t))
10602 (insert "\n* Notes\n")))
10603 (setq reversed (org-notes-order-reversed-p))
10604 (save-excursion 11387 (save-excursion
10605 (save-restriction 11388 (save-restriction
10606 (widen) 11389 (widen)
11390 (and (goto-char (point-min))
11391 (not (re-search-forward "^\\* " nil t))
11392 (insert "\n* Notes\n"))
11393 (setq reversed (org-notes-order-reversed-p))
10607 11394
10608 ;; Find the default location 11395 ;; Find the default location
10609 (when (and heading (stringp heading) (string-match "\\S-" heading)) 11396 (when (and heading (stringp heading) (string-match "\\S-" heading))
@@ -10619,7 +11406,7 @@ See also the variable `org-reverse-note-order'."
10619 org-goto-start-pos 11406 org-goto-start-pos
10620 (org-get-location (current-buffer) org-remember-help))) 11407 (org-get-location (current-buffer) org-remember-help)))
10621 (if (not spos) (throw 'quit nil)) ; return nil to show we did 11408 (if (not spos) (throw 'quit nil)) ; return nil to show we did
10622 ; not handle this note 11409 ; not handle this note
10623 (goto-char spos) 11410 (goto-char spos)
10624 (cond ((and (bobp) (not reversed)) 11411 (cond ((and (bobp) (not reversed))
10625 ;; Put it at the end, one level below level 1 11412 ;; Put it at the end, one level below level 1
@@ -10636,12 +11423,12 @@ See also the variable `org-reverse-note-order'."
10636 (re-search-forward "^\\*" nil t) 11423 (re-search-forward "^\\*" nil t)
10637 (beginning-of-line 1) 11424 (beginning-of-line 1)
10638 (org-paste-subtree 1 txt))) 11425 (org-paste-subtree 1 txt)))
10639 ((and (org-on-heading-p nil) (not current-prefix-arg)) 11426 ((and (org-on-heading-p t) (not current-prefix-arg))
10640 ;; Put it below this entry, at the beg/end of the subtree 11427 ;; Put it below this entry, at the beg/end of the subtree
10641 (org-back-to-heading t) 11428 (org-back-to-heading t)
10642 (setq level (funcall outline-level)) 11429 (setq level (funcall outline-level))
10643 (if reversed 11430 (if reversed
10644 (outline-end-of-heading) 11431 (outline-next-heading)
10645 (org-end-of-subtree t)) 11432 (org-end-of-subtree t))
10646 (if (not (bolp)) (newline)) 11433 (if (not (bolp)) (newline))
10647 (beginning-of-line 1) 11434 (beginning-of-line 1)
@@ -10649,7 +11436,9 @@ See also the variable `org-reverse-note-order'."
10649 (t 11436 (t
10650 ;; Put it right there, with automatic level determined by 11437 ;; Put it right there, with automatic level determined by
10651 ;; org-paste-subtree or from prefix arg 11438 ;; org-paste-subtree or from prefix arg
10652 (org-paste-subtree current-prefix-arg txt))) 11439 (org-paste-subtree
11440 (if (numberp current-prefix-arg) current-prefix-arg)
11441 txt)))
10653 (when remember-save-after-remembering 11442 (when remember-save-after-remembering
10654 (save-buffer) 11443 (save-buffer)
10655 (if (not visiting) (kill-buffer (current-buffer))))))))) 11444 (if (not visiting) (kill-buffer (current-buffer)))))))))
@@ -10838,7 +11627,7 @@ At all other locations, this simply calls `ispell-complete-word'."
10838 ((string-match "\\`\\*+[ \t]*\\'" 11627 ((string-match "\\`\\*+[ \t]*\\'"
10839 (buffer-substring (point-at-bol) beg)) 11628 (buffer-substring (point-at-bol) beg))
10840 (setq type :todo) 11629 (setq type :todo)
10841 (mapcar 'list org-todo-keywords)) 11630 (mapcar 'list org-todo-keywords-1))
10842 (searchhead 11631 (searchhead
10843 (setq type :searchhead) 11632 (setq type :searchhead)
10844 (save-excursion 11633 (save-excursion
@@ -10926,6 +11715,8 @@ For calling through lisp, arg is also interpreted in the following way:
10926'none -> empty state 11715'none -> empty state
10927\"\"(empty string) -> switch to empty state 11716\"\"(empty string) -> switch to empty state
10928'done -> switch to DONE 11717'done -> switch to DONE
11718'nextset -> switch to the next set of keywords
11719'previousset -> switch to the previous set of keywords
10929\"WAITING\" -> switch to the specified keyword, but only if it 11720\"WAITING\" -> switch to the specified keyword, but only if it
10930 really is a member of `org-todo-keywords'." 11721 really is a member of `org-todo-keywords'."
10931 (interactive "P") 11722 (interactive "P")
@@ -10935,52 +11726,76 @@ For calling through lisp, arg is also interpreted in the following way:
10935 (or (looking-at (concat " +" org-todo-regexp " *")) 11726 (or (looking-at (concat " +" org-todo-regexp " *"))
10936 (looking-at " *")) 11727 (looking-at " *"))
10937 (let* ((this (match-string 1)) 11728 (let* ((this (match-string 1))
11729 (head (org-get-todo-sequence-head this))
11730 (ass (assoc head org-todo-kwd-alist))
11731 (interpret (nth 1 ass))
11732 (done-word (nth 3 ass))
11733 (final-done-word (nth 4 ass))
10938 (last-state (or this "")) 11734 (last-state (or this ""))
10939 (completion-ignore-case t) 11735 (completion-ignore-case t)
10940 (member (member this org-todo-keywords)) 11736 (member (member this org-todo-keywords-1))
10941 (tail (cdr member)) 11737 (tail (cdr member))
10942 (state (cond 11738 (state (cond
10943 ((equal arg '(4)) 11739 ((equal arg '(4))
10944 ;; Read a state with completion 11740 ;; Read a state with completion
10945 (completing-read "State: " (mapcar (lambda(x) (list x)) 11741 (completing-read "State: " (mapcar (lambda(x) (list x))
10946 org-todo-keywords) 11742 org-todo-keywords-1)
10947 nil t)) 11743 nil t))
10948 ((eq arg 'right) 11744 ((eq arg 'right)
10949 (if this 11745 (if this
10950 (if tail (car tail) nil) 11746 (if tail (car tail) nil)
10951 (car org-todo-keywords))) 11747 (car org-todo-keywords-1)))
10952 ((eq arg 'left) 11748 ((eq arg 'left)
10953 (if (equal member org-todo-keywords) 11749 (if (equal member org-todo-keywords-1)
10954 nil 11750 nil
10955 (if this 11751 (if this
10956 (nth (- (length org-todo-keywords) (length tail) 2) 11752 (nth (- (length org-todo-keywords-1) (length tail) 2)
10957 org-todo-keywords) 11753 org-todo-keywords-1)
10958 org-done-string))) 11754 (org-last org-todo-keywords-1))))
10959 (arg 11755 (arg
10960 ;; user requests a specific state 11756 ;; user or caller requests a specific state
10961 (cond 11757 (cond
10962 ((equal arg "") nil) 11758 ((equal arg "") nil)
10963 ((eq arg 'none) nil) 11759 ((eq arg 'none) nil)
10964 ((eq arg 'done) (org-last org-todo-keywords)) 11760 ((eq arg 'done) (or done-word (car org-done-keywords)))
10965 ((car (member arg org-todo-keywords))) 11761 ((eq arg 'nextset)
11762 (or (car (cdr (member head org-todo-heads)))
11763 (car org-todo-heads)))
11764 ((eq arg 'previousset)
11765 (let ((org-todo-heads (reverse org-todo-heads)))
11766 (or (car (cdr (member head org-todo-heads)))
11767 (car org-todo-heads))))
11768 ((car (member arg org-todo-keywords-1)))
10966 ((nth (1- (prefix-numeric-value arg)) 11769 ((nth (1- (prefix-numeric-value arg))
10967 org-todo-keywords)))) 11770 org-todo-keywords-1))))
10968 ((null member) (car org-todo-keywords)) 11771 ((null member) (or head (car org-todo-keywords-1)))
11772 ((equal this final-done-word) nil) ;; -> make empty
10969 ((null tail) nil) ;; -> first entry 11773 ((null tail) nil) ;; -> first entry
10970 ((eq org-todo-interpretation 'sequence) 11774 ((eq interpret 'sequence)
10971 (car tail)) 11775 (car tail))
10972 ((memq org-todo-interpretation '(type priority)) 11776 ((memq interpret '(type priority))
10973 (if (eq this-command last-command) 11777 (if (eq this-command last-command)
10974 (car tail) 11778 (car tail)
10975 (if (> (length tail) 0) org-done-string nil))) 11779 (if (> (length tail) 0)
11780 (or done-word (car org-done-keywords))
11781 nil)))
10976 (t nil))) 11782 (t nil)))
10977 (next (if state (concat " " state " ") " ")) 11783 (next (if state (concat " " state " ") " "))
10978 dostates) 11784 dostates)
10979 (replace-match next t t) 11785 (replace-match next t t)
11786 (unless head
11787 (setq head (org-get-todo-sequence-head state)
11788 ass (assoc head org-todo-kwd-alist)
11789 interpret (nth 1 ass)
11790 done-word (nth 3 ass)
11791 final-done-word (nth 4 ass)))
11792 (when (memq arg '(nextset previousset))
11793 (message "Keyword set: %s"
11794 (mapconcat 'identity (assoc state org-todo-sets) " ")))
10980 (setq org-last-todo-state-is-todo 11795 (setq org-last-todo-state-is-todo
10981 (not (equal state org-done-string))) 11796 (not (member state org-done-keywords)))
10982 (when org-log-done 11797 (when (and org-log-done (not (memq arg '(nextset previousset))))
10983 (setq dostates (and (eq org-todo-interpretation 'sequence) 11798 (setq dostates (and (eq interpret 'sequence)
10984 (listp org-log-done) (memq 'state org-log-done))) 11799 (listp org-log-done) (memq 'state org-log-done)))
10985 (cond 11800 (cond
10986 ((and state (not this)) 11801 ((and state (not this))
@@ -10988,7 +11803,7 @@ For calling through lisp, arg is also interpreted in the following way:
10988 (and dostates (org-add-log-maybe 'state state 'findpos))) 11803 (and dostates (org-add-log-maybe 'state state 'findpos)))
10989 ((and state dostates) 11804 ((and state dostates)
10990 (org-add-log-maybe 'state state 'findpos)) 11805 (org-add-log-maybe 'state state 'findpos))
10991 ((equal state org-done-string) 11806 ((member state org-done-keywords)
10992 ;; Planning info calls the note-setting command. 11807 ;; Planning info calls the note-setting command.
10993 (org-add-planning-info 'closed (org-current-time) 11808 (org-add-planning-info 'closed (org-current-time)
10994 (if (org-get-repeat) nil 'scheduled)) 11809 (if (org-get-repeat) nil 'scheduled))
@@ -10996,8 +11811,10 @@ For calling through lisp, arg is also interpreted in the following way:
10996 ;; Fixup tag positioning 11811 ;; Fixup tag positioning
10997 (and org-auto-align-tags (org-set-tags nil t)) 11812 (and org-auto-align-tags (org-set-tags nil t))
10998 (run-hooks 'org-after-todo-state-change-hook) 11813 (run-hooks 'org-after-todo-state-change-hook)
10999 (and (equal state org-done-string) (org-auto-repeat-maybe)) 11814 (and (member state org-done-keywords) (org-auto-repeat-maybe))
11000 )) 11815 (if (and arg (not (member state org-done-keywords)))
11816 (setq head (org-get-todo-sequence-head state)))
11817 (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head)))
11001 ;; Fixup cursor location if close to the keyword 11818 ;; Fixup cursor location if close to the keyword
11002 (if (and (outline-on-heading-p) 11819 (if (and (outline-on-heading-p)
11003 (not (bolp)) 11820 (not (bolp))
@@ -11008,8 +11825,24 @@ For calling through lisp, arg is also interpreted in the following way:
11008 (goto-char (or (match-end 2) (match-end 1))) 11825 (goto-char (or (match-end 2) (match-end 1)))
11009 (just-one-space)))) 11826 (just-one-space))))
11010 11827
11828(defun org-get-todo-sequence-head (kwd)
11829 "Return the head of the TODO sequence to which KWD belongs.
11830If KWD is not set, check if there is a text property remembering the
11831right sequence."
11832 (let (p)
11833 (cond
11834 ((not kwd)
11835 (or (get-text-property (point-at-bol) 'org-todo-head)
11836 (progn
11837 (setq p (next-single-property-change (point-at-bol) 'org-todo-head
11838 nil (point-at-eol)))
11839 (get-text-property p 'org-todo-head))))
11840 ((not (member kwd org-todo-keywords-1))
11841 (car org-todo-keywords-1))
11842 (t (nth 2 (assoc kwd org-todo-kwd-alist))))))
11843
11011(defun org-get-repeat () 11844(defun org-get-repeat ()
11012 "Return the REPEAT statement of this entry." 11845 "Check if tere is a deadline/schedule with repeater in this entry."
11013 (save-match-data 11846 (save-match-data
11014 (save-excursion 11847 (save-excursion
11015 (org-back-to-heading t) 11848 (org-back-to-heading t)
@@ -11020,24 +11853,29 @@ For calling through lisp, arg is also interpreted in the following way:
11020(defvar org-last-changed-timestamp) 11853(defvar org-last-changed-timestamp)
11021(defvar org-log-post-message) 11854(defvar org-log-post-message)
11022(defun org-auto-repeat-maybe () 11855(defun org-auto-repeat-maybe ()
11023 "Check if the current headline contains a REPEAT key. 11856 "Check if the current headline contains a repeated deadline/schedule.
11024If yes, set TODO state back to what it was and change any SCHEDULED 11857If yes, set TODO state back to what it was and change the base date
11025or DEADLINE times the new date. 11858of repeating deadline/scheduled time stamps to new date.
11026This function should be run in the `org-after-todo-state-change-hook'." 11859This function should be run in the `org-after-todo-state-change-hook'."
11027 ;; last-state is dynamically scoped into this function 11860 ;; last-state is dynamically scoped into this function
11028 (let ((repeat (org-get-repeat)) 11861 (let* ((repeat (org-get-repeat))
11029 (whata '(("d" . day) ("m" . month) ("y" . year))) 11862 (aa (assoc last-state org-todo-kwd-alist))
11030 (msg "Entry repeats: ") 11863 (interpret (nth 1 aa))
11031 (org-log-done) 11864 (head (nth 2 aa))
11032 re type n what start) 11865 (done-word (nth 3 aa))
11866 (whata '(("d" . day) ("m" . month) ("y" . year)))
11867 (msg "Entry repeats: ")
11868 (org-log-done)
11869 re type n what ts)
11033 (when repeat 11870 (when repeat
11034 (org-todo (if (eq 'org-todo-interpretation 'type) 11871 (org-todo (if (eq interpret 'type) last-state head))
11035 last-state 11872 (when (and org-log-repeat
11036 (car org-todo-keywords))) 11873 (not (memq 'org-add-log-note
11037 (unless (memq 'org-add-log-note (default-value 'post-command-hook)) 11874 (default-value 'post-command-hook))))
11038 ;; Make sure a note is taken 11875 ;; Make sure a note is taken
11039 (let ((org-log-done '(done))) 11876 (let ((org-log-done '(done)))
11040 (org-add-log-maybe 'done org-done-string 'findpos))) 11877 (org-add-log-maybe 'done (or done-word (car org-done-keywords))
11878 'findpos)))
11041 (org-back-to-heading t) 11879 (org-back-to-heading t)
11042 (org-add-planning-info nil nil 'closed) 11880 (org-add-planning-info nil nil 'closed)
11043 (setq re (concat "\\(" org-scheduled-time-regexp "\\)\\|\\(" 11881 (setq re (concat "\\(" org-scheduled-time-regexp "\\)\\|\\("
@@ -11045,11 +11883,10 @@ This function should be run in the `org-after-todo-state-change-hook'."
11045 (while (re-search-forward 11883 (while (re-search-forward
11046 re (save-excursion (outline-next-heading) (point)) t) 11884 re (save-excursion (outline-next-heading) (point)) t)
11047 (setq type (if (match-end 1) org-scheduled-string org-deadline-string) 11885 (setq type (if (match-end 1) org-scheduled-string org-deadline-string)
11048 start 0) 11886 ts (match-string (if (match-end 2) 2 4)))
11049 (while (string-match "\\([-+]?[0-9]+\\)\\([dwmy]\\)" repeat start) 11887 (when (string-match "\\([-+]?[0-9]+\\)\\([dwmy]\\)" ts)
11050 (setq start (match-end 0) 11888 (setq n (string-to-number (match-string 1 ts))
11051 n (string-to-number (match-string 1 repeat)) 11889 what (match-string 2 ts))
11052 what (match-string 2 repeat))
11053 (if (equal what "w") (setq n (* n 7) what "d")) 11890 (if (equal what "w") (setq n (* n 7) what "d"))
11054 (org-timestamp-change n (cdr (assoc what whata)))) 11891 (org-timestamp-change n (cdr (assoc what whata))))
11055 (setq msg (concat msg type org-last-changed-timestamp " "))) 11892 (setq msg (concat msg type org-last-changed-timestamp " ")))
@@ -11062,15 +11899,20 @@ The tree will show the lines where the regexp matches, and all higher
11062headlines above the match. 11899headlines above the match.
11063With \\[universal-argument] prefix, also show the DONE entries. 11900With \\[universal-argument] prefix, also show the DONE entries.
11064With a numeric prefix N, construct a sparse tree for the Nth element 11901With a numeric prefix N, construct a sparse tree for the Nth element
11065of `org-todo-keywords'." 11902of `org-todo-keywords-1'."
11066 (interactive "P") 11903 (interactive "P")
11067 (let ((case-fold-search nil) 11904 (let ((case-fold-search nil)
11068 (kwd-re 11905 (kwd-re
11069 (cond ((null arg) org-not-done-regexp) 11906 (cond ((null arg) org-not-done-regexp)
11070 ((equal arg '(4)) org-todo-regexp) 11907 ((equal arg '(4))
11071 ((<= (prefix-numeric-value arg) (length org-todo-keywords)) 11908 (let ((kwd (completing-read "Keyword (or KWD1|KWD2|...): "
11909 (mapcar 'list org-todo-keywords-1))))
11910 (concat "\\("
11911 (mapconcat 'identity (org-split-string kwd "|") "\\|")
11912 "\\)\\>")))
11913 ((<= (prefix-numeric-value arg) (length org-todo-keywords-1))
11072 (regexp-quote (nth (1- (prefix-numeric-value arg)) 11914 (regexp-quote (nth (1- (prefix-numeric-value arg))
11073 org-todo-keywords))) 11915 org-todo-keywords-1)))
11074 (t (error "Invalid prefix argument: %s" arg))))) 11916 (t (error "Invalid prefix argument: %s" arg)))))
11075 (message "%d TODO entries found" 11917 (message "%d TODO entries found"
11076 (org-occur (concat "^" outline-regexp " +" kwd-re ))))) 11918 (org-occur (concat "^" outline-regexp " +" kwd-re )))))
@@ -11143,9 +11985,11 @@ be removed."
11143 ((eq what 'deadline) org-deadline-string) 11985 ((eq what 'deadline) org-deadline-string)
11144 ((eq what 'closed) org-closed-string)) 11986 ((eq what 'closed) org-closed-string))
11145 " ") 11987 " ")
11146 (org-insert-time-stamp time 11988 (org-insert-time-stamp
11147 (or org-time-was-given (eq what 'closed)) 11989 time
11148 (eq what 'closed)) 11990 (or org-time-was-given
11991 (and (eq what 'closed) org-log-done-with-time))
11992 (eq what 'closed))
11149 (end-of-line 1)) 11993 (end-of-line 1))
11150 (goto-char (point-min)) 11994 (goto-char (point-min))
11151 (widen) 11995 (widen)
@@ -11163,6 +12007,7 @@ be removed."
11163The auto-repeater uses this.") 12007The auto-repeater uses this.")
11164 12008
11165(defun org-add-log-maybe (&optional purpose state findpos) 12009(defun org-add-log-maybe (&optional purpose state findpos)
12010 "Set up the post command hook to take a note."
11166 (save-excursion 12011 (save-excursion
11167 (when (and (listp org-log-done) 12012 (when (and (listp org-log-done)
11168 (memq purpose org-log-done)) 12013 (memq purpose org-log-done))
@@ -11221,17 +12066,18 @@ The auto-repeater uses this.")
11221 ""))))) 12066 "")))))
11222 (if lines (setq note (concat note " \\\\"))) 12067 (if lines (setq note (concat note " \\\\")))
11223 (push note lines)) 12068 (push note lines))
11224 (save-excursion 12069 (when lines
11225 (set-buffer (marker-buffer org-log-note-marker))
11226 (save-excursion 12070 (save-excursion
11227 (goto-char org-log-note-marker) 12071 (set-buffer (marker-buffer org-log-note-marker))
11228 (move-marker org-log-note-marker nil) 12072 (save-excursion
11229 (end-of-line 1) 12073 (goto-char org-log-note-marker)
11230 (if (not (bolp)) (insert "\n")) (indent-relative nil) 12074 (move-marker org-log-note-marker nil)
11231 (setq ind (concat (buffer-substring (point-at-bol) (point)) " ")) 12075 (end-of-line 1)
11232 (insert " - " (pop lines)) 12076 (if (not (bolp)) (insert "\n")) (indent-relative nil)
11233 (while lines 12077 (setq ind (concat (buffer-substring (point-at-bol) (point)) " "))
11234 (insert "\n" ind (pop lines)))))) 12078 (insert " - " (pop lines))
12079 (while lines
12080 (insert "\n" ind (pop lines)))))))
11235 (set-window-configuration org-log-note-window-configuration) 12081 (set-window-configuration org-log-note-window-configuration)
11236 (with-current-buffer (marker-buffer org-log-note-return-to) 12082 (with-current-buffer (marker-buffer org-log-note-return-to)
11237 (goto-char org-log-note-return-to)) 12083 (goto-char org-log-note-return-to))
@@ -11264,7 +12110,8 @@ that the match should indeed be shown."
11264 (when (or (not callback) 12110 (when (or (not callback)
11265 (save-match-data (funcall callback))) 12111 (save-match-data (funcall callback)))
11266 (setq cnt (1+ cnt)) 12112 (setq cnt (1+ cnt))
11267 (org-highlight-new-match (match-beginning 0) (match-end 0)) 12113 (when org-highlight-sparse-tree-matches
12114 (org-highlight-new-match (match-beginning 0) (match-end 0)))
11268 (org-show-context 'occur-tree)))) 12115 (org-show-context 'occur-tree))))
11269 (when org-remove-highlights-with-change 12116 (when org-remove-highlights-with-change
11270 (org-add-hook 'before-change-functions 'org-remove-occur-highlights 12117 (org-add-hook 'before-change-functions 'org-remove-occur-highlights
@@ -11342,7 +12189,7 @@ from the `before-change-functions' in the current buffer."
11342 12189
11343;;;; Priorities 12190;;;; Priorities
11344 12191
11345(defvar org-priority-regexp ".*?\\(\\[#\\([A-Z]\\)\\] ?\\)" 12192(defvar org-priority-regexp ".*?\\(\\[#\\([A-Z0-9]\\)\\] ?\\)"
11346 "Regular expression matching the priority indicator.") 12193 "Regular expression matching the priority indicator.")
11347 12194
11348(defvar org-remove-priority-next-time nil) 12195(defvar org-remove-priority-next-time nil)
@@ -11371,18 +12218,18 @@ ACTION can be set, up, or down."
11371 (setq current org-default-priority)) 12218 (setq current org-default-priority))
11372 (cond 12219 (cond
11373 ((eq action 'set) 12220 ((eq action 'set)
11374 (message "Priority A-%c, SPC to remove: " org-lowest-priority) 12221 (message "Priority %c-%c, SPC to remove: " org-highest-priority org-lowest-priority)
11375 (setq new (read-char-exclusive)) 12222 (setq new (read-char-exclusive))
11376 (cond ((equal new ?\ ) (setq remove t)) 12223 (cond ((equal new ?\ ) (setq remove t))
11377 ((or (< (upcase new) ?A) (> (upcase new) org-lowest-priority)) 12224 ((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority))
11378 (error "Priority must be between `%c' and `%c'" 12225 (error "Priority must be between `%c' and `%c'"
11379 ?A org-lowest-priority)))) 12226 org-highest-priority org-lowest-priority))))
11380 ((eq action 'up) 12227 ((eq action 'up)
11381 (setq new (1- current))) 12228 (setq new (1- current)))
11382 ((eq action 'down) 12229 ((eq action 'down)
11383 (setq new (1+ current))) 12230 (setq new (1+ current)))
11384 (t (error "Invalid action"))) 12231 (t (error "Invalid action")))
11385 (setq new (min (max ?A (upcase new)) org-lowest-priority)) 12232 (setq new (min (max org-highest-priority (upcase new)) org-lowest-priority))
11386 (setq news (format "%c" new)) 12233 (setq news (format "%c" new))
11387 (if have 12234 (if have
11388 (if remove 12235 (if remove
@@ -11419,15 +12266,14 @@ evaluated, testing if a given set of tags qualifies a headline for
11419inclusion. When TODO-ONLY is non-nil, only lines with a TODO keyword 12266inclusion. When TODO-ONLY is non-nil, only lines with a TODO keyword
11420are included in the output." 12267are included in the output."
11421 (let* ((re (concat "[\n\r]" outline-regexp " *\\(\\<\\(" 12268 (let* ((re (concat "[\n\r]" outline-regexp " *\\(\\<\\("
11422 (mapconcat 'regexp-quote 12269 (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
11423 (nreverse (cdr (reverse org-todo-keywords)))
11424 "\\|")
11425 "\\>\\)\\)? *\\(.*?\\)\\(:[A-Za-z_@0-9:]+:\\)?[ \t]*$")) 12270 "\\>\\)\\)? *\\(.*?\\)\\(:[A-Za-z_@0-9:]+:\\)?[ \t]*$"))
11426 (props (list 'face nil 12271 (props (list 'face nil
11427 'done-face 'org-done 12272 'done-face 'org-done
11428 'undone-face nil 12273 'undone-face nil
11429 'mouse-face 'highlight 12274 'mouse-face 'highlight
11430 'org-not-done-regexp org-not-done-regexp 12275 'org-not-done-regexp org-not-done-regexp
12276 'org-todo-regexp org-todo-regexp
11431 'keymap org-agenda-keymap 12277 'keymap org-agenda-keymap
11432 'help-echo 12278 'help-echo
11433 (format "mouse-2 or RET jump to org file %s" 12279 (format "mouse-2 or RET jump to org file %s"
@@ -11435,7 +12281,7 @@ are included in the output."
11435 (case-fold-search nil) 12281 (case-fold-search nil)
11436 lspos 12282 lspos
11437 tags tags-list tags-alist (llast 0) rtn level category i txt 12283 tags tags-list tags-alist (llast 0) rtn level category i txt
11438 todo marker entry) 12284 todo marker entry priority)
11439 (save-excursion 12285 (save-excursion
11440 (goto-char (point-min)) 12286 (goto-char (point-min))
11441 (when (eq action 'sparse-tree) (org-overview)) 12287 (when (eq action 'sparse-tree) (org-overview))
@@ -11462,7 +12308,7 @@ are included in the output."
11462 (if org-use-tag-inheritance 12308 (if org-use-tag-inheritance
11463 (apply 'append (mapcar 'cdr tags-alist)) 12309 (apply 'append (mapcar 'cdr tags-alist))
11464 tags)) 12310 tags))
11465 (when (and (or (not todo-only) todo) 12311 (when (and (or (not todo-only) (member todo org-not-done-keywords))
11466 (eval matcher) 12312 (eval matcher)
11467 (or (not org-agenda-skip-archived-trees) 12313 (or (not org-agenda-skip-archived-trees)
11468 (not (member org-archive-tag tags-list)))) 12314 (not (member org-archive-tag tags-list))))
@@ -11477,11 +12323,13 @@ are included in the output."
11477 (if org-tags-match-list-sublevels 12323 (if org-tags-match-list-sublevels
11478 (make-string (1- level) ?.) "") 12324 (make-string (1- level) ?.) "")
11479 (org-get-heading)) 12325 (org-get-heading))
11480 category tags-list)) 12326 category tags-list)
12327 priority (org-get-priority txt))
11481 (goto-char lspos) 12328 (goto-char lspos)
11482 (setq marker (org-agenda-new-marker)) 12329 (setq marker (org-agenda-new-marker))
11483 (org-add-props txt props 12330 (org-add-props txt props
11484 'org-marker marker 'org-hd-marker marker 'org-category category) 12331 'org-marker marker 'org-hd-marker marker 'org-category category
12332 'priority priority 'type "tagsmatch")
11485 (push txt rtn)) 12333 (push txt rtn))
11486 ;; if we are to skip sublevels, jump to end of subtree 12334 ;; if we are to skip sublevels, jump to end of subtree
11487 (or org-tags-match-list-sublevels (org-end-of-subtree t)))))) 12335 (or org-tags-match-list-sublevels (org-end-of-subtree t))))))
@@ -11610,7 +12458,7 @@ With prefix ARG, realign all tags in headings in the current buffer."
11610 (if arg 12458 (if arg
11611 (save-excursion 12459 (save-excursion
11612 (goto-char (point-min)) 12460 (goto-char (point-min))
11613 (let (buffer-invisibility-spec) ; Emacs 21 compatibility 12461 (let ((buffer-invisibility-spec (org-inhibit-invisibility)))
11614 (while (re-search-forward re nil t) 12462 (while (re-search-forward re nil t)
11615 (org-set-tags nil t) 12463 (org-set-tags nil t)
11616 (end-of-line 1))) 12464 (end-of-line 1)))
@@ -11637,11 +12485,12 @@ With prefix ARG, realign all tags in headings in the current buffer."
11637 (while (string-match "[-+&]+" tags) 12485 (while (string-match "[-+&]+" tags)
11638 ;; No boolean logic, just a list 12486 ;; No boolean logic, just a list
11639 (setq tags (replace-match ":" t t tags)))) 12487 (setq tags (replace-match ":" t t tags))))
12488
11640 (if (string-match "\\`[\t ]*\\'" tags) 12489 (if (string-match "\\`[\t ]*\\'" tags)
11641 (setq tags "") 12490 (setq tags "")
11642 (unless (string-match ":$" tags) (setq tags (concat tags ":"))) 12491 (unless (string-match ":$" tags) (setq tags (concat tags ":")))
11643 (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) 12492 (unless (string-match "^:" tags) (setq tags (concat ":" tags))))
11644 12493
11645 ;; Insert new tags at the correct column 12494 ;; Insert new tags at the correct column
11646 (beginning-of-line 1) 12495 (beginning-of-line 1)
11647 (if (re-search-forward 12496 (if (re-search-forward
@@ -11728,7 +12577,7 @@ Returns the new tags string, or nil to not change the current settings."
11728 (fwidth (+ maxlen 3 1 3)) 12577 (fwidth (+ maxlen 3 1 3))
11729 (ncol (/ (- (window-width) 4) fwidth)) 12578 (ncol (/ (- (window-width) 4) fwidth))
11730 (i-face 'org-done) 12579 (i-face 'org-done)
11731 (c-face 'org-tag) 12580 (c-face 'org-todo)
11732 tg cnt e c char c1 c2 ntable tbl rtn 12581 tg cnt e c char c1 c2 ntable tbl rtn
11733 ov-start ov-end ov-prefix 12582 ov-start ov-end ov-prefix
11734 (exit-after-next org-fast-tag-selection-single-key) 12583 (exit-after-next org-fast-tag-selection-single-key)
@@ -12014,9 +12863,9 @@ used to insert the time stamp into the buffer to include the time."
12014 (timestr (format-time-string 12863 (timestr (format-time-string
12015 (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") default-time)) 12864 (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") default-time))
12016 (prompt (concat (if prompt (concat prompt " ") "") 12865 (prompt (concat (if prompt (concat prompt " ") "")
12017 (format "YYYY-MM-DD [%s]: " timestr))) 12866 (format "Date and/or time (default [%s]): " timestr)))
12018 ans (org-ans0 "") org-ans1 org-ans2 (deltadays 0) 12867 ans (org-ans0 "") org-ans1 org-ans2 (deltadays 0)
12019 second minute hour day month year tl wday wday1) 12868 second minute hour day month year tl wday wday1 pm)
12020 12869
12021 (cond 12870 (cond
12022 (from-string (setq ans from-string)) 12871 (from-string (setq ans from-string))
@@ -12027,44 +12876,43 @@ used to insert the time stamp into the buffer to include the time."
12027 (calendar-forward-day (- (time-to-days default-time) 12876 (calendar-forward-day (- (time-to-days default-time)
12028 (calendar-absolute-from-gregorian 12877 (calendar-absolute-from-gregorian
12029 (calendar-current-date)))) 12878 (calendar-current-date))))
12030 (org-eval-in-calendar nil) 12879 (org-eval-in-calendar nil t)
12031 (let* ((old-map (current-local-map)) 12880 (let* ((old-map (current-local-map))
12032 (map (copy-keymap calendar-mode-map)) 12881 (map (copy-keymap calendar-mode-map))
12033 (minibuffer-local-map (copy-keymap minibuffer-local-map))) 12882 (minibuffer-local-map (copy-keymap minibuffer-local-map)))
12034 (define-key map (kbd "RET") 'org-calendar-select) 12883 (org-defkey map (kbd "RET") 'org-calendar-select)
12035 (define-key map (if (featurep 'xemacs) [button1] [mouse-1]) 12884 (org-defkey map (if (featurep 'xemacs) [button1] [mouse-1])
12036 'org-calendar-select-mouse) 12885 'org-calendar-select-mouse)
12037 (define-key map (if (featurep 'xemacs) [button2] [mouse-2]) 12886 (org-defkey map (if (featurep 'xemacs) [button2] [mouse-2])
12038 'org-calendar-select-mouse) 12887 'org-calendar-select-mouse)
12039 (define-key minibuffer-local-map [(meta shift left)] 12888 (org-defkey minibuffer-local-map [(meta shift left)]
12040 (lambda () (interactive) 12889 (lambda () (interactive)
12041 (org-eval-in-calendar '(calendar-backward-month 1)))) 12890 (org-eval-in-calendar '(calendar-backward-month 1))))
12042 (define-key minibuffer-local-map [(meta shift right)] 12891 (org-defkey minibuffer-local-map [(meta shift right)]
12043 (lambda () (interactive) 12892 (lambda () (interactive)
12044 (org-eval-in-calendar '(calendar-forward-month 1)))) 12893 (org-eval-in-calendar '(calendar-forward-month 1))))
12045 (define-key minibuffer-local-map [(shift up)] 12894 (org-defkey minibuffer-local-map [(shift up)]
12046 (lambda () (interactive) 12895 (lambda () (interactive)
12047 (org-eval-in-calendar '(calendar-backward-week 1)))) 12896 (org-eval-in-calendar '(calendar-backward-week 1))))
12048 (define-key minibuffer-local-map [(shift down)] 12897 (org-defkey minibuffer-local-map [(shift down)]
12049 (lambda () (interactive) 12898 (lambda () (interactive)
12050 (org-eval-in-calendar '(calendar-forward-week 1)))) 12899 (org-eval-in-calendar '(calendar-forward-week 1))))
12051 (define-key minibuffer-local-map [(shift left)] 12900 (org-defkey minibuffer-local-map [(shift left)]
12052 (lambda () (interactive) 12901 (lambda () (interactive)
12053 (org-eval-in-calendar '(calendar-backward-day 1)))) 12902 (org-eval-in-calendar '(calendar-backward-day 1))))
12054 (define-key minibuffer-local-map [(shift right)] 12903 (org-defkey minibuffer-local-map [(shift right)]
12055 (lambda () (interactive) 12904 (lambda () (interactive)
12056 (org-eval-in-calendar '(calendar-forward-day 1)))) 12905 (org-eval-in-calendar '(calendar-forward-day 1))))
12057 (define-key minibuffer-local-map ">" 12906 (org-defkey minibuffer-local-map ">"
12058 (lambda () (interactive) 12907 (lambda () (interactive)
12059 (org-eval-in-calendar '(scroll-calendar-left 1)))) 12908 (org-eval-in-calendar '(scroll-calendar-left 1))))
12060 (define-key minibuffer-local-map "<" 12909 (org-defkey minibuffer-local-map "<"
12061 (lambda () (interactive) 12910 (lambda () (interactive)
12062 (org-eval-in-calendar '(scroll-calendar-right 1)))) 12911 (org-eval-in-calendar '(scroll-calendar-right 1))))
12063 (unwind-protect 12912 (unwind-protect
12064 (progn 12913 (progn
12065 (use-local-map map) 12914 (use-local-map map)
12066 (setq org-ans0 (read-string prompt "" nil nil)) 12915 (setq org-ans0 (read-string prompt "" nil nil))
12067; (if (not (string-match "\\S-" org-ans0)) (setq org-ans0 nil))
12068 ;; org-ans0: from prompt 12916 ;; org-ans0: from prompt
12069 ;; org-ans1: from mouse click 12917 ;; org-ans1: from mouse click
12070 ;; org-ans2: from calendar motion 12918 ;; org-ans2: from calendar motion
@@ -12077,17 +12925,30 @@ used to insert the time stamp into the buffer to include the time."
12077 (if (string-match "^[ \t]*[-+][0-9]+[ \t]*$" org-ans0) 12925 (if (string-match "^[ \t]*[-+][0-9]+[ \t]*$" org-ans0)
12078 (setq deltadays (string-to-number ans) ans "")) 12926 (setq deltadays (string-to-number ans) ans ""))
12079 12927
12080 (if (string-match 12928 ;; Help matching ISO dates with single digit month ot day, like 2006-8-11.
12081 "^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans) 12929 (when (string-match
12082 (progn 12930 "^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans)
12083 (setq year (if (match-end 2) 12931 (setq year (if (match-end 2)
12084 (string-to-number (match-string 2 ans)) 12932 (string-to-number (match-string 2 ans))
12085 (string-to-number (format-time-string "%Y"))) 12933 (string-to-number (format-time-string "%Y")))
12086 month (string-to-number (match-string 3 ans)) 12934 month (string-to-number (match-string 3 ans))
12087 day (string-to-number (match-string 4 ans))) 12935 day (string-to-number (match-string 4 ans)))
12088 (if (< year 100) (setq year (+ 2000 year))) 12936 (if (< year 100) (setq year (+ 2000 year)))
12089 (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day) 12937 (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
12090 t nil ans)))) 12938 t nil ans)))
12939 ;; Help matching am/pm times, because `parse-time-string' does not do that.
12940 ;; If there is a time with am/pm, and *no* time without it, we convert
12941 ;; convert so that matching will be successful.
12942 (when (and (not (string-match "[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans))
12943 (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans))
12944 (setq hour (string-to-number (match-string 1 ans))
12945 minute (if (match-end 3) (string-to-number (match-string 3 ans)) 0)
12946 pm (equal ?p (string-to-char (downcase (match-string 4 ans)))))
12947 (if (and (= hour 12) (not pm))
12948 (setq hour 0)
12949 (if (and pm (< hour 12)) (setq hour (+ 12 hour))))
12950 (setq ans (replace-match (format "%02d:%02d" hour minute) t t ans)))
12951
12091 (setq tl (parse-time-string ans) 12952 (setq tl (parse-time-string ans)
12092 year (or (nth 5 tl) (string-to-number (format-time-string "%Y" ct))) 12953 year (or (nth 5 tl) (string-to-number (format-time-string "%Y" ct)))
12093 month (or (nth 4 tl) (string-to-number (format-time-string "%m" ct))) 12954 month (or (nth 4 tl) (string-to-number (format-time-string "%m" ct)))
@@ -12113,18 +12974,28 @@ used to insert the time stamp into the buffer to include the time."
12113 (format "%04d-%02d-%02d %02d:%02d" year month day hour minute) 12974 (format "%04d-%02d-%02d %02d:%02d" year month day hour minute)
12114 (format "%04d-%02d-%02d" year month day))))) 12975 (format "%04d-%02d-%02d" year month day)))))
12115 12976
12116(defun org-eval-in-calendar (form) 12977(defun org-eval-in-calendar (form &optional keepdate)
12117 "Eval FORM in the calendar window and return to current window. 12978 "Eval FORM in the calendar window and return to current window.
12118Also, store the cursor date in variable org-ans2." 12979Also, store the cursor date in variable org-ans2."
12119 (let ((sw (selected-window))) 12980 (let ((sw (selected-window)))
12120 (select-window (get-buffer-window "*Calendar*")) 12981 (select-window (get-buffer-window "*Calendar*"))
12121 (eval form) 12982 (eval form)
12122 (when (calendar-cursor-to-date) 12983 (when (and (not keepdate) (calendar-cursor-to-date))
12123 (let* ((date (calendar-cursor-to-date)) 12984 (let* ((date (calendar-cursor-to-date))
12124 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) 12985 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
12125 (setq org-ans2 (format-time-string "%Y-%m-%d" time)))) 12986 (setq org-ans2 (format-time-string "%Y-%m-%d" time))))
12126 (org-move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) 12987 (org-move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer))
12127 (select-window sw))) 12988 (select-window sw)
12989 ;; Update the prompt to show new default date
12990 (save-excursion
12991 (goto-char (point-min))
12992 (when (and org-ans2
12993 (re-search-forward "\\[[-0-9]+\\]" nil t)
12994 (get-text-property (match-end 0) 'field))
12995 (let ((inhibit-read-only t))
12996 (replace-match (concat "[" org-ans2 "]") t t)
12997 (add-text-properties (point-min) (1+ (match-end 0))
12998 (text-properties-at (1+ (point-min)))))))))
12128 12999
12129(defun org-calendar-select () 13000(defun org-calendar-select ()
12130 "Return to `org-read-date' with the date currently selected. 13001 "Return to `org-read-date' with the date currently selected.
@@ -12136,7 +13007,7 @@ This is used by `org-read-date' in a temporary keymap for the calendar buffer."
12136 (setq org-ans1 (format-time-string "%Y-%m-%d" time))) 13007 (setq org-ans1 (format-time-string "%Y-%m-%d" time)))
12137 (if (active-minibuffer-window) (exit-minibuffer)))) 13008 (if (active-minibuffer-window) (exit-minibuffer))))
12138 13009
12139(defun org-insert-time-stamp (time &optional with-hm inactive pre post) 13010(defun org-insert-time-stamp (time &optional with-hm inactive pre post extra)
12140 "Insert a date stamp for the date given by the internal TIME. 13011 "Insert a date stamp for the date given by the internal TIME.
12141WITH-HM means, use the stamp format that includes the time of the day. 13012WITH-HM means, use the stamp format that includes the time of the day.
12142INACTIVE means use square brackets instead of angular ones, so that the 13013INACTIVE means use square brackets instead of angular ones, so that the
@@ -12149,6 +13020,10 @@ The command returns the inserted time stamp."
12149 (if inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) 13020 (if inactive (setq fmt (concat "[" (substring fmt 1 -1) "]")))
12150 (insert (or pre "")) 13021 (insert (or pre ""))
12151 (insert (setq stamp (format-time-string fmt time))) 13022 (insert (setq stamp (format-time-string fmt time)))
13023 (when extra
13024 (backward-char 1)
13025 (insert extra)
13026 (forward-char 1))
12152 (insert (or post "")) 13027 (insert (or post ""))
12153 stamp)) 13028 stamp))
12154 13029
@@ -12175,17 +13050,22 @@ The command returns the inserted time stamp."
12175 13050
12176(defun org-display-custom-time (beg end) 13051(defun org-display-custom-time (beg end)
12177 "Overlay modified time stamp format over timestamp between BED and END." 13052 "Overlay modified time stamp format over timestamp between BED and END."
12178 (let* ((t1 (save-match-data 13053 (let* ((ts (buffer-substring beg end))
12179 (org-parse-time-string (buffer-substring beg end) t))) 13054 t1 w1 with-hm tf time str w2 (off 0))
12180 (w1 (- end beg)) 13055 (save-match-data
12181 (with-hm (and (nth 1 t1) (nth 2 t1))) 13056 (setq t1 (org-parse-time-string ts t))
12182 (tf (funcall (if with-hm 'cdr 'car) org-time-stamp-custom-formats)) 13057 (if (string-match " \\+[0-9]+[dwmy]\\'" ts)
12183 (time (org-fix-decoded-time t1)) 13058 (setq off (- (match-end 0) (match-beginning 0)))))
12184 (str (org-add-props 13059 (setq end (- end off))
13060 (setq w1 (- end beg)
13061 with-hm (and (nth 1 t1) (nth 2 t1))
13062 tf (funcall (if with-hm 'cdr 'car) org-time-stamp-custom-formats)
13063 time (org-fix-decoded-time t1)
13064 str (org-add-props
12185 (format-time-string 13065 (format-time-string
12186 (substring tf 1 -1) (apply 'encode-time time)) 13066 (substring tf 1 -1) (apply 'encode-time time))
12187 nil 'mouse-face 'highlight)) 13067 nil 'mouse-face 'highlight)
12188 (w2 (length str))) 13068 w2 (length str))
12189 (if (not (= w2 w1)) 13069 (if (not (= w2 w1))
12190 (add-text-properties (1+ beg) (+ 2 beg) 13070 (add-text-properties (1+ beg) (+ 2 beg)
12191 (list 'org-dwidth t 'org-dwidth-n (- w1 w2)))) 13071 (list 'org-dwidth t 'org-dwidth-n (- w1 w2))))
@@ -12349,6 +13229,133 @@ days in order to avoid rounding problems."
12349(defun org-time-string-to-time (s) 13229(defun org-time-string-to-time (s)
12350 (apply 'encode-time (org-parse-time-string s))) 13230 (apply 'encode-time (org-parse-time-string s)))
12351 13231
13232(defun org-time-string-to-absolute (s &optional daynr)
13233 "Convert a time stamp to an absolute day number.
13234If there is a specifyer for a cyclic time stamp, get the closest date to
13235DATE."
13236 (cond
13237 ((and daynr (string-match "\\`%%\\((.*)\\)" s))
13238 (if (org-diary-sexp-entry (match-string 1 s) "" date)
13239 daynr
13240 (+ daynr 1000)))
13241 ((and daynr (string-match "\\+[0-9]+[dwmy]" s))
13242 (org-closest-date s (if (and (boundp 'daynr) (integerp daynr)) daynr
13243 (time-to-days (current-time))) (match-string 0 s)))
13244 (t (time-to-days (apply 'encode-time (org-parse-time-string s))))))
13245
13246(defun org-calendar-holiday ()
13247 "List of holidays, for Diary display in Org-mode."
13248 (let ((hl (check-calendar-holidays date)))
13249 (if hl (mapconcat 'identity hl "; "))))
13250
13251(defun org-diary-sexp-entry (sexp entry date)
13252 "Process a SEXP diary ENTRY for DATE."
13253 (let ((result (if calendar-debug-sexp
13254 (let ((stack-trace-on-error t))
13255 (eval (car (read-from-string sexp))))
13256 (condition-case nil
13257 (eval (car (read-from-string sexp)))
13258 (error
13259 (beep)
13260 (message "Bad sexp at line %d in %s: %s"
13261 (org-current-line)
13262 (buffer-file-name) sexp)
13263 (sleep-for 2))))))
13264 (cond ((stringp result) result)
13265 ((and (consp result)
13266 (stringp (cdr result))) (cdr result))
13267 (result entry)
13268 (t nil))))
13269
13270(defun org-diary-to-ical-string (frombuf)
13271 "FIXME"
13272 (let* ((tmpdir (if (featurep 'xemacs)
13273 (temp-directory)
13274 temporary-file-directory))
13275 (tmpfile (make-temp-name
13276 (expand-file-name "orgics" tmpdir)))
13277 buf rtn b e)
13278 (save-excursion
13279 (set-buffer frombuf)
13280 (icalendar-export-region (point-min) (point-max) tmpfile)
13281 (setq buf (find-buffer-visiting tmpfile))
13282 (set-buffer buf)
13283 (goto-char (point-min))
13284 (if (re-search-forward "^BEGIN:VEVENT" nil t)
13285 (setq b (match-beginning 0)))
13286 (goto-char (point-max))
13287 (if (re-search-backward "^END:VEVENT" nil t)
13288 (setq e (match-end 0)))
13289 (setq rtn (if (and b e) (concat (buffer-substring b e) "\n") "")))
13290 (kill-buffer buf)
13291 (kill-buffer frombuf)
13292 (delete-file tmpfile)
13293 rtn))
13294
13295(defun org-closest-date (start current change)
13296 "Find the date closest to CURRENT that is consistent with START and CHANGE."
13297 ;; Make the proper lists from the dates
13298 (catch 'exit
13299 (let ((a1 '(("d" . day) ("w" . week) ("m" . month) ("y" . year)))
13300 dn dw sday cday n1 n2
13301 d m y y1 y2 date1 date2 nmonths nm ny m2)
13302
13303 (setq start (org-date-to-gregorian start)
13304 current (org-date-to-gregorian current)
13305 sday (calendar-absolute-from-gregorian start)
13306 cday (calendar-absolute-from-gregorian current))
13307
13308 (if (<= cday sday) (throw 'exit sday))
13309
13310 (if (string-match "\\(\\+[0-9]+\\)\\([dwmy]\\)" change)
13311 (setq dn (string-to-number (match-string 1 change))
13312 dw (cdr (assoc (match-string 2 change) a1)))
13313 (error "Invalid change specifyer: %s" change))
13314 (if (eq dw 'week) (setq dw 'day dn (* 7 dn)))
13315 (cond
13316 ((eq dw 'day)
13317 (setq n1 (+ sday (* dn (floor (/ (- cday sday) dn))))
13318 n2 (+ n1 dn)))
13319 ((eq dw 'year)
13320 (setq d (nth 1 start) m (car start) y1 (nth 2 start) y2 (nth 2 current))
13321 (setq y1 (+ (* (floor (/ (- y2 y1) dn)) dn) y1))
13322 (setq date1 (list m d y1)
13323 n1 (calendar-absolute-from-gregorian date1)
13324 date2 (list m d (+ y1 (* (if (< n1 cday) 1 -1) dn)))
13325 n2 (calendar-absolute-from-gregorian date2)))
13326 ((eq dw 'month)
13327 ;; approx number of month between the tow dates
13328 (setq nmonths (floor (/ (- cday sday) 30.436875)))
13329 ;; How often does dn fit in there?
13330 (setq d (nth 1 start) m (car start) y (nth 2 start)
13331 nm (* dn (max 0 (1- (floor (/ nmonths dn)))))
13332 m (+ m nm)
13333 ny (floor (/ m 12))
13334 y (+ y ny)
13335 m (- m (* ny 12)))
13336 (while (> m 12) (setq m (- m 12) y (1+ y)))
13337 (setq n1 (calendar-absolute-from-gregorian (list m d y)))
13338 (setq m2 (+ m dn) y2 y)
13339 (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12)))
13340 (setq n2 (calendar-absolute-from-gregorian (list m2 d y2)))
13341 (while (< n2 cday)
13342 (setq n1 n2 m m2 y y2)
13343 (setq m2 (+ m dn) y2 y)
13344 (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12)))
13345 (setq n2 (calendar-absolute-from-gregorian (list m2 d y2))))))
13346
13347 (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1))))
13348
13349(defun org-date-to-gregorian (date)
13350 "Turn any specification of DATE into a gregorian date for the calendar."
13351 (cond ((integerp date) (calendar-gregorian-from-absolute date))
13352 ((and (listp date) (= (length date) 3)) date)
13353 ((stringp date)
13354 (setq date (org-parse-time-string date))
13355 (list (nth 4 date) (nth 3 date) (nth 5 date)))
13356 ((listp date)
13357 (list (nth 4 date) (nth 3 date) (nth 5 date)))))
13358
12352(defun org-parse-time-string (s &optional nodefault) 13359(defun org-parse-time-string (s &optional nodefault)
12353 "Parse the standard Org-mode time string. 13360 "Parse the standard Org-mode time string.
12354This should be a lot faster than the normal `parse-time-string'. 13361This should be a lot faster than the normal `parse-time-string'.
@@ -12436,6 +13443,7 @@ in the timestamp determines what will be changed."
12436 (let ((pos (point)) 13443 (let ((pos (point))
12437 with-hm inactive 13444 with-hm inactive
12438 org-ts-what 13445 org-ts-what
13446 extra
12439 ts time time0) 13447 ts time time0)
12440 (if (not (org-at-timestamp-p t)) 13448 (if (not (org-at-timestamp-p t))
12441 (error "Not at a timestamp")) 13449 (error "Not at a timestamp"))
@@ -12445,12 +13453,13 @@ in the timestamp determines what will be changed."
12445 (not (get-text-property (1- (point)) 'display))) 13453 (not (get-text-property (1- (point)) 'display)))
12446 (setq org-ts-what 'day)) 13454 (setq org-ts-what 'day))
12447 (setq org-ts-what (or what org-ts-what) 13455 (setq org-ts-what (or what org-ts-what)
12448 with-hm (<= (abs (- (cdr org-ts-lengths)
12449 (- (match-end 0) (match-beginning 0))))
12450 1)
12451 inactive (= (char-after (match-beginning 0)) ?\[) 13456 inactive (= (char-after (match-beginning 0)) ?\[)
12452 ts (match-string 0)) 13457 ts (match-string 0))
12453 (replace-match "") 13458 (replace-match "")
13459 (if (string-match " \\+[0-9]+[dwmy]" ts)
13460 (setq extra (match-string 0 ts)))
13461 (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts)
13462 (setq with-hm t))
12454 (setq time0 (org-parse-time-string ts)) 13463 (setq time0 (org-parse-time-string ts))
12455 (setq time 13464 (setq time
12456 (apply 'encode-time 13465 (apply 'encode-time
@@ -12476,7 +13485,7 @@ in the timestamp determines what will be changed."
12476 (setcar (nthcdr 2 time0) (or (nth 1 time0) 0)) 13485 (setcar (nthcdr 2 time0) (or (nth 1 time0) 0))
12477 (setq time (apply 'encode-time time0)))) 13486 (setq time (apply 'encode-time time0))))
12478 (setq org-last-changed-timestamp 13487 (setq org-last-changed-timestamp
12479 (org-insert-time-stamp time with-hm inactive)) 13488 (org-insert-time-stamp time with-hm inactive nil nil extra))
12480 (org-clock-update-time-maybe) 13489 (org-clock-update-time-maybe)
12481 (goto-char pos) 13490 (goto-char pos)
12482 ;; Try to recenter the calendar window, if any 13491 ;; Try to recenter the calendar window, if any
@@ -12525,8 +13534,27 @@ If there is already a time stamp at the cursor position, update it."
12525 13534
12526;;; The clock for measuring work time. 13535;;; The clock for measuring work time.
12527 13536
13537(defvar org-mode-line-string "")
13538(put 'org-mode-line-string 'risky-local-variable t)
13539
13540(defvar org-mode-line-timer nil)
13541(defvar org-clock-heading "")
13542(defvar org-clock-start-time "")
13543
13544(defun org-update-mode-line ()
13545 (let* ((delta (- (time-to-seconds (current-time))
13546 (time-to-seconds org-clock-start-time)))
13547 (h (floor delta 3600))
13548 (m (floor (- delta (* 3600 h)) 60)))
13549 (setq org-mode-line-string
13550 (propertize (format "-[%d:%02d (%s)]" h m org-clock-heading)
13551 'help-echo "Org-mode clock is running"))
13552 (force-mode-line-update)))
13553
12528(defvar org-clock-marker (make-marker) 13554(defvar org-clock-marker (make-marker)
12529 "Marker recording the last clock-in.") 13555 "Marker recording the last clock-in.")
13556(defvar org-clock-mode-line-entry nil
13557 "Information for the modeline about the running clock.")
12530 13558
12531(defun org-clock-in () 13559(defun org-clock-in ()
12532 "Start the clock on the current item. 13560 "Start the clock on the current item.
@@ -12536,6 +13564,10 @@ If necessary, clock-out of the currently active clock."
12536 (let (ts) 13564 (let (ts)
12537 (save-excursion 13565 (save-excursion
12538 (org-back-to-heading t) 13566 (org-back-to-heading t)
13567 (if (looking-at org-todo-line-regexp)
13568 (setq org-clock-heading (match-string 3))
13569 (setq org-clock-heading "???"))
13570 (setq org-clock-heading (propertize org-clock-heading 'face nil))
12539 (beginning-of-line 2) 13571 (beginning-of-line 2)
12540 (when (and (looking-at (concat "[ \t]*" org-keyword-time-regexp)) 13572 (when (and (looking-at (concat "[ \t]*" org-keyword-time-regexp))
12541 (not (equal (match-string 1) org-clock-string))) 13573 (not (equal (match-string 1) org-clock-string)))
@@ -12545,8 +13577,15 @@ If necessary, clock-out of the currently active clock."
12545 (insert "\n") (backward-char 1) 13577 (insert "\n") (backward-char 1)
12546 (indent-relative) 13578 (indent-relative)
12547 (insert org-clock-string " ") 13579 (insert org-clock-string " ")
13580 (setq org-clock-start-time (current-time))
12548 (setq ts (org-insert-time-stamp (current-time) 'with-hm 'inactive)) 13581 (setq ts (org-insert-time-stamp (current-time) 'with-hm 'inactive))
12549 (move-marker org-clock-marker (point) (buffer-base-buffer)) 13582 (move-marker org-clock-marker (point) (buffer-base-buffer))
13583 (or global-mode-string (setq global-mode-string '("")))
13584 (or (memq 'org-mode-line-string global-mode-string)
13585 (setq global-mode-string
13586 (append global-mode-string '(org-mode-line-string))))
13587 (org-update-mode-line)
13588 (setq org-mode-line-timer (run-with-timer 60 60 'org-update-mode-line))
12550 (message "Clock started at %s" ts)))) 13589 (message "Clock started at %s" ts))))
12551 13590
12552(defun org-clock-out (&optional fail-quietly) 13591(defun org-clock-out (&optional fail-quietly)
@@ -12577,6 +13616,12 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set."
12577 (insert " => " (format "%2d:%02d" h m)) 13616 (insert " => " (format "%2d:%02d" h m))
12578 (move-marker org-clock-marker nil) 13617 (move-marker org-clock-marker nil)
12579 (org-add-log-maybe 'clock-out) 13618 (org-add-log-maybe 'clock-out)
13619 (when org-mode-line-timer
13620 (cancel-timer org-mode-line-timer)
13621 (setq org-mode-line-timer nil))
13622 (setq global-mode-string
13623 (delq 'org-mode-line-string global-mode-string))
13624 (force-mode-line-update)
12580 (message "Clock stopped at %s after HH:MM = %d:%02d" te h m))))) 13625 (message "Clock stopped at %s after HH:MM = %d:%02d" te h m)))))
12581 13626
12582(defun org-clock-cancel () 13627(defun org-clock-cancel ()
@@ -12704,7 +13749,7 @@ from the `before-change-functions' in the current buffer."
12704(defun org-clock-out-if-current () 13749(defun org-clock-out-if-current ()
12705 "Clock out if the current entry contains the running clock. 13750 "Clock out if the current entry contains the running clock.
12706This is used to stop the clock after a TODO entry is marked DONE." 13751This is used to stop the clock after a TODO entry is marked DONE."
12707 (when (and (equal state org-done-string) 13752 (when (and (member state org-done-keywords)
12708 (equal (marker-buffer org-clock-marker) (current-buffer)) 13753 (equal (marker-buffer org-clock-marker) (current-buffer))
12709 (< (point) org-clock-marker) 13754 (< (point) org-clock-marker)
12710 (> (save-excursion (outline-next-heading) (point)) 13755 (> (save-excursion (outline-next-heading) (point))
@@ -12984,86 +14029,89 @@ The following commands are available:
12984 14029
12985(substitute-key-definition 'undo 'org-agenda-undo 14030(substitute-key-definition 'undo 'org-agenda-undo
12986 org-agenda-mode-map global-map) 14031 org-agenda-mode-map global-map)
12987(define-key org-agenda-mode-map "\C-i" 'org-agenda-goto) 14032(org-defkey org-agenda-mode-map "\C-i" 'org-agenda-goto)
12988(define-key org-agenda-mode-map [(tab)] 'org-agenda-goto) 14033(org-defkey org-agenda-mode-map [(tab)] 'org-agenda-goto)
12989(define-key org-agenda-mode-map "\C-m" 'org-agenda-switch-to) 14034(org-defkey org-agenda-mode-map "\C-m" 'org-agenda-switch-to)
12990(define-key org-agenda-mode-map "\C-k" 'org-agenda-kill) 14035(org-defkey org-agenda-mode-map "\C-k" 'org-agenda-kill)
12991(define-key org-agenda-mode-map "\C-c$" 'org-agenda-archive) 14036(org-defkey org-agenda-mode-map "\C-c$" 'org-agenda-archive)
12992(define-key org-agenda-mode-map "\C-c\C-x\C-s" 'org-agenda-archive) 14037(org-defkey org-agenda-mode-map "\C-c\C-x\C-s" 'org-agenda-archive)
12993(define-key org-agenda-mode-map "$" 'org-agenda-archive) 14038(org-defkey org-agenda-mode-map "$" 'org-agenda-archive)
12994(define-key org-agenda-mode-map "\C-c\C-o" 'org-agenda-open-link) 14039(org-defkey org-agenda-mode-map "\C-c\C-o" 'org-agenda-open-link)
12995(define-key org-agenda-mode-map " " 'org-agenda-show) 14040(org-defkey org-agenda-mode-map " " 'org-agenda-show)
12996(define-key org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo) 14041(org-defkey org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo)
12997(define-key org-agenda-mode-map "\C-c\C-xb" 'org-agenda-tree-to-indirect-buffer) 14042(org-defkey org-agenda-mode-map [(control shift right)] 'org-agenda-todo-nextset)
12998(define-key org-agenda-mode-map "b" 'org-agenda-tree-to-indirect-buffer) 14043(org-defkey org-agenda-mode-map [(control shift left)] 'org-agenda-todo-previousset)
12999(define-key org-agenda-mode-map "o" 'delete-other-windows) 14044(org-defkey org-agenda-mode-map "\C-c\C-xb" 'org-agenda-tree-to-indirect-buffer)
13000(define-key org-agenda-mode-map "L" 'org-agenda-recenter) 14045(org-defkey org-agenda-mode-map "b" 'org-agenda-tree-to-indirect-buffer)
13001(define-key org-agenda-mode-map "t" 'org-agenda-todo) 14046(org-defkey org-agenda-mode-map "o" 'delete-other-windows)
13002(define-key org-agenda-mode-map "a" 'org-agenda-toggle-archive-tag) 14047(org-defkey org-agenda-mode-map "L" 'org-agenda-recenter)
13003(define-key org-agenda-mode-map ":" 'org-agenda-set-tags) 14048(org-defkey org-agenda-mode-map "t" 'org-agenda-todo)
13004(define-key org-agenda-mode-map "." 'org-agenda-goto-today) 14049(org-defkey org-agenda-mode-map "a" 'org-agenda-toggle-archive-tag)
13005(define-key org-agenda-mode-map "d" 'org-agenda-day-view) 14050(org-defkey org-agenda-mode-map ":" 'org-agenda-set-tags)
13006(define-key org-agenda-mode-map "w" 'org-agenda-week-view) 14051(org-defkey org-agenda-mode-map "." 'org-agenda-goto-today)
13007(define-key org-agenda-mode-map (org-key 'S-right) 'org-agenda-date-later) 14052(org-defkey org-agenda-mode-map "d" 'org-agenda-day-view)
13008(define-key org-agenda-mode-map (org-key 'S-left) 'org-agenda-date-earlier) 14053(org-defkey org-agenda-mode-map "w" 'org-agenda-week-view)
13009(define-key org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-date-later) 14054(org-defkey org-agenda-mode-map [(shift right)] 'org-agenda-date-later)
13010(define-key org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-date-earlier) 14055(org-defkey org-agenda-mode-map [(shift left)] 'org-agenda-date-earlier)
13011 14056(org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-date-later)
13012(define-key org-agenda-mode-map ">" 'org-agenda-date-prompt) 14057(org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-date-earlier)
13013(define-key org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule) 14058
13014(define-key org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline) 14059(org-defkey org-agenda-mode-map ">" 'org-agenda-date-prompt)
14060(org-defkey org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule)
14061(org-defkey org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline)
13015(let ((l '(1 2 3 4 5 6 7 8 9 0))) 14062(let ((l '(1 2 3 4 5 6 7 8 9 0)))
13016 (while l (define-key org-agenda-mode-map 14063 (while l (org-defkey org-agenda-mode-map
13017 (int-to-string (pop l)) 'digit-argument))) 14064 (int-to-string (pop l)) 'digit-argument)))
13018 14065
13019(define-key org-agenda-mode-map "f" 'org-agenda-follow-mode) 14066(org-defkey org-agenda-mode-map "f" 'org-agenda-follow-mode)
13020(define-key org-agenda-mode-map "l" 'org-agenda-log-mode) 14067(org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode)
13021(define-key org-agenda-mode-map "D" 'org-agenda-toggle-diary) 14068(org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary)
13022(define-key org-agenda-mode-map "g" 'org-agenda-toggle-time-grid) 14069(org-defkey org-agenda-mode-map "g" 'org-agenda-toggle-time-grid)
13023(define-key org-agenda-mode-map "r" 'org-agenda-redo) 14070(org-defkey org-agenda-mode-map "r" 'org-agenda-redo)
13024(define-key org-agenda-mode-map "q" 'org-agenda-quit) 14071(org-defkey org-agenda-mode-map "q" 'org-agenda-quit)
13025(define-key org-agenda-mode-map "x" 'org-agenda-exit) 14072(org-defkey org-agenda-mode-map "x" 'org-agenda-exit)
13026(define-key org-agenda-mode-map "s" 'org-save-all-org-buffers) 14073(org-defkey org-agenda-mode-map "\C-x\C-w" 'org-write-agenda)
13027(define-key org-agenda-mode-map "P" 'org-agenda-show-priority) 14074(org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers)
13028(define-key org-agenda-mode-map "T" 'org-agenda-show-tags) 14075(org-defkey org-agenda-mode-map "P" 'org-agenda-show-priority)
13029(define-key org-agenda-mode-map "n" 'next-line) 14076(org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags)
13030(define-key org-agenda-mode-map "p" 'previous-line) 14077(org-defkey org-agenda-mode-map "n" 'next-line)
13031(define-key org-agenda-mode-map "\C-n" 'org-agenda-next-date-line) 14078(org-defkey org-agenda-mode-map "p" 'previous-line)
13032(define-key org-agenda-mode-map "\C-p" 'org-agenda-previous-date-line) 14079(org-defkey org-agenda-mode-map "\C-n" 'org-agenda-next-date-line)
13033(define-key org-agenda-mode-map "," 'org-agenda-priority) 14080(org-defkey org-agenda-mode-map "\C-p" 'org-agenda-previous-date-line)
13034(define-key org-agenda-mode-map "\C-c," 'org-agenda-priority) 14081(org-defkey org-agenda-mode-map "," 'org-agenda-priority)
13035(define-key org-agenda-mode-map "i" 'org-agenda-diary-entry) 14082(org-defkey org-agenda-mode-map "\C-c," 'org-agenda-priority)
13036(define-key org-agenda-mode-map "c" 'org-agenda-goto-calendar) 14083(org-defkey org-agenda-mode-map "i" 'org-agenda-diary-entry)
14084(org-defkey org-agenda-mode-map "c" 'org-agenda-goto-calendar)
13037(eval-after-load "calendar" 14085(eval-after-load "calendar"
13038 '(define-key calendar-mode-map org-calendar-to-agenda-key 14086 '(org-defkey calendar-mode-map org-calendar-to-agenda-key
13039 'org-calendar-goto-agenda)) 14087 'org-calendar-goto-agenda))
13040(define-key org-agenda-mode-map "C" 'org-agenda-convert-date) 14088(org-defkey org-agenda-mode-map "C" 'org-agenda-convert-date)
13041(define-key org-agenda-mode-map "m" 'org-agenda-phases-of-moon) 14089(org-defkey org-agenda-mode-map "m" 'org-agenda-phases-of-moon)
13042(define-key org-agenda-mode-map "M" 'org-agenda-phases-of-moon) 14090(org-defkey org-agenda-mode-map "M" 'org-agenda-phases-of-moon)
13043(define-key org-agenda-mode-map "S" 'org-agenda-sunrise-sunset) 14091(org-defkey org-agenda-mode-map "S" 'org-agenda-sunrise-sunset)
13044(define-key org-agenda-mode-map "h" 'org-agenda-holidays) 14092(org-defkey org-agenda-mode-map "h" 'org-agenda-holidays)
13045(define-key org-agenda-mode-map "H" 'org-agenda-holidays) 14093(org-defkey org-agenda-mode-map "H" 'org-agenda-holidays)
13046(define-key org-agenda-mode-map "+" 'org-agenda-priority-up) 14094(org-defkey org-agenda-mode-map "I" 'org-agenda-clock-in)
13047(define-key org-agenda-mode-map "I" 'org-agenda-clock-in) 14095(org-defkey org-agenda-mode-map "O" 'org-agenda-clock-out)
13048(define-key org-agenda-mode-map "O" 'org-agenda-clock-out) 14096(org-defkey org-agenda-mode-map "X" 'org-agenda-clock-cancel)
13049(define-key org-agenda-mode-map "X" 'org-agenda-clock-cancel) 14097(org-defkey org-agenda-mode-map "+" 'org-agenda-priority-up)
13050(define-key org-agenda-mode-map "-" 'org-agenda-priority-down) 14098(org-defkey org-agenda-mode-map "-" 'org-agenda-priority-down)
13051(define-key org-agenda-mode-map (org-key 'S-up) 'org-agenda-priority-up) 14099(org-defkey org-agenda-mode-map [(shift up)] 'org-agenda-priority-up)
13052(define-key org-agenda-mode-map (org-key 'S-down) 'org-agenda-priority-down) 14100(org-defkey org-agenda-mode-map [(shift down)] 'org-agenda-priority-down)
13053(define-key org-agenda-mode-map [?\C-c ?\C-x (up)] 'org-agenda-priority-up) 14101(org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] 'org-agenda-priority-up)
13054(define-key org-agenda-mode-map [?\C-c ?\C-x (down)] 'org-agenda-priority-down) 14102(org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] 'org-agenda-priority-down)
13055(define-key org-agenda-mode-map [(right)] 'org-agenda-later) 14103(org-defkey org-agenda-mode-map [(right)] 'org-agenda-later)
13056(define-key org-agenda-mode-map [(left)] 'org-agenda-earlier) 14104(org-defkey org-agenda-mode-map [(left)] 'org-agenda-earlier)
13057(define-key org-agenda-mode-map "\C-c\C-x\C-c" 'org-export-icalendar-combine-agenda-files) 14105(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-export-icalendar-combine-agenda-files)
13058(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) 14106(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map)
13059 "Local keymap for agenda entries from Org-mode.") 14107 "Local keymap for agenda entries from Org-mode.")
13060 14108
13061(define-key org-agenda-keymap 14109(org-defkey org-agenda-keymap
13062 (if (featurep 'xemacs) [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse) 14110 (if (featurep 'xemacs) [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse)
13063(define-key org-agenda-keymap 14111(org-defkey org-agenda-keymap
13064 (if (featurep 'xemacs) [(button3)] [(mouse-3)]) 'org-agenda-show-mouse) 14112 (if (featurep 'xemacs) [(button3)] [(mouse-3)]) 'org-agenda-show-mouse)
13065(when org-agenda-mouse-1-follows-link 14113(when org-agenda-mouse-1-follows-link
13066 (define-key org-agenda-keymap [follow-link] 'mouse-face)) 14114 (org-defkey org-agenda-keymap [follow-link] 'mouse-face))
13067(easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu" 14115(easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu"
13068 '("Agenda" 14116 '("Agenda"
13069 ("Agenda Files") 14117 ("Agenda Files")
@@ -13120,6 +14168,7 @@ The following commands are available:
13120 :style toggle :selected org-agenda-include-diary :active (org-agenda-check-type nil 'agenda)] 14168 :style toggle :selected org-agenda-include-diary :active (org-agenda-check-type nil 'agenda)]
13121 ["Use Time Grid" org-agenda-toggle-time-grid 14169 ["Use Time Grid" org-agenda-toggle-time-grid
13122 :style toggle :selected org-agenda-use-time-grid :active (org-agenda-check-type nil 'agenda)]) 14170 :style toggle :selected org-agenda-use-time-grid :active (org-agenda-check-type nil 'agenda)])
14171 ["Write view to file" org-write-agenda t]
13123 ["Rebuild buffer" org-agenda-redo t] 14172 ["Rebuild buffer" org-agenda-redo t]
13124 ["Save all Org-mode Buffers" org-save-all-org-buffers t] 14173 ["Save all Org-mode Buffers" org-save-all-org-buffers t]
13125 "--" 14174 "--"
@@ -13146,6 +14195,11 @@ The following commands are available:
13146 `(unless (get-text-property (point) 'org-protected) 14195 `(unless (get-text-property (point) 'org-protected)
13147 ,@body)) 14196 ,@body))
13148 14197
14198(defmacro org-unmodified (&rest body)
14199 "Execute body without changing buffer-modified-p."
14200 `(set-buffer-modified-p
14201 (prog1 (buffer-modified-p) ,@body)))
14202
13149(defmacro org-with-remote-undo (_buffer &rest _body) 14203(defmacro org-with-remote-undo (_buffer &rest _body)
13150 "Execute BODY while recording undo information in two buffers." 14204 "Execute BODY while recording undo information in two buffers."
13151 (declare (indent 1) (debug t)) 14205 (declare (indent 1) (debug t))
@@ -13230,7 +14284,8 @@ T Call `org-todo-list' to display the global todo list, select only
13230m Call `org-tags-view' to display headlines with tags matching 14284m Call `org-tags-view' to display headlines with tags matching
13231 a condition (the user is prompted for the condition). 14285 a condition (the user is prompted for the condition).
13232M Like `m', but select only TODO entries, no ordinary headlines. 14286M Like `m', but select only TODO entries, no ordinary headlines.
13233l Create a timeeline for the current buffer. 14287l Create a timeline for the current buffer.
14288e Export views to associated files.
13234 14289
13235More commands can be added by configuring the variable 14290More commands can be added by configuring the variable
13236`org-agenda-custom-commands'. In particular, specific tags and TODO keyword 14291`org-agenda-custom-commands'. In particular, specific tags and TODO keyword
@@ -13261,7 +14316,7 @@ next use of \\[org-agenda]) restricted to the current file."
13261 (let ((header 14316 (let ((header
13262"Press key for an agenda command: 14317"Press key for an agenda command:
13263-------------------------------- C Configure custom agenda commands 14318-------------------------------- C Configure custom agenda commands
13264a Agenda for current week or day 14319a Agenda for current week or day e Export agenda views
13265t List of all TODO entries T Entries with special TODO kwd 14320t List of all TODO entries T Entries with special TODO kwd
13266m Match a TAGS query M Like m, but only TODO entries 14321m Match a TAGS query M Like m, but only TODO entries
13267L Timeline for current buffer # List stuck projects (!=configure) 14322L Timeline for current buffer # List stuck projects (!=configure)
@@ -13279,6 +14334,9 @@ L Timeline for current buffer # List stuck projects (!=configure)
13279 '(face bold)) 14334 '(face bold))
13280 (cond 14335 (cond
13281 ((stringp type) type) 14336 ((stringp type) type)
14337 ((eq type 'agenda) "Agenda for current week or day")
14338 ((eq type 'alltodo) "List of all TODO entries")
14339 ((eq type 'stuck) "List of stuck projects")
13282 ((eq type 'todo) "TODO keyword") 14340 ((eq type 'todo) "TODO keyword")
13283 ((eq type 'tags) "Tags query") 14341 ((eq type 'tags) "Tags query")
13284 ((eq type 'tags-todo) "Tags (TODO)") 14342 ((eq type 'tags-todo) "Tags (TODO)")
@@ -13333,6 +14391,13 @@ L Timeline for current buffer # List stuck projects (!=configure)
13333 (setq type (nth 1 entry) match (nth 2 entry) lprops (nth 3 entry) 14391 (setq type (nth 1 entry) match (nth 2 entry) lprops (nth 3 entry)
13334 lprops (nth 3 entry)) 14392 lprops (nth 3 entry))
13335 (cond 14393 (cond
14394 ((eq type 'agenda)
14395 (org-let lprops '(org-agenda-list current-prefix-arg)))
14396 ((eq type 'alltodo)
14397 (org-let lprops '(org-todo-list current-prefix-arg)))
14398 ((eq type 'stuck)
14399 (org-let lprops '(org-agenda-list-stuck-projects
14400 current-prefix-arg)))
13336 ((eq type 'tags) 14401 ((eq type 'tags)
13337 (org-let lprops '(org-tags-view current-prefix-arg match))) 14402 (org-let lprops '(org-tags-view current-prefix-arg match)))
13338 ((eq type 'tags-todo) 14403 ((eq type 'tags-todo)
@@ -13353,13 +14418,14 @@ L Timeline for current buffer # List stuck projects (!=configure)
13353 ((fboundp type) 14418 ((fboundp type)
13354 (org-let lprops '(funcall type match))) 14419 (org-let lprops '(funcall type match)))
13355 (t (error "Invalid custom agenda command type %s" type)))) 14420 (t (error "Invalid custom agenda command type %s" type))))
13356 (org-run-agenda-series (cddr entry)))) 14421 (org-run-agenda-series (nth 1 entry) (cddr entry))))
13357 ((equal c ?C) (customize-variable 'org-agenda-custom-commands)) 14422 ((equal c ?C) (customize-variable 'org-agenda-custom-commands))
13358 ((equal c ?a) (call-interactively 'org-agenda-list)) 14423 ((equal c ?a) (call-interactively 'org-agenda-list))
13359 ((equal c ?t) (call-interactively 'org-todo-list)) 14424 ((equal c ?t) (call-interactively 'org-todo-list))
13360 ((equal c ?T) (org-call-with-arg 'org-todo-list (or arg '(4)))) 14425 ((equal c ?T) (org-call-with-arg 'org-todo-list (or arg '(4))))
13361 ((equal c ?m) (call-interactively 'org-tags-view)) 14426 ((equal c ?m) (call-interactively 'org-tags-view))
13362 ((equal c ?M) (org-call-with-arg 'org-tags-view (or arg '(4)))) 14427 ((equal c ?M) (org-call-with-arg 'org-tags-view (or arg '(4))))
14428 ((equal c ?e) (call-interactively 'org-store-agenda-views))
13363 ((equal c ?L) 14429 ((equal c ?L)
13364 (unless restrict-ok 14430 (unless restrict-ok
13365 (error "This is not an Org-mode file")) 14431 (error "This is not an Org-mode file"))
@@ -13368,10 +14434,10 @@ L Timeline for current buffer # List stuck projects (!=configure)
13368 ((equal c ?!) (customize-variable 'org-stuck-projects)) 14434 ((equal c ?!) (customize-variable 'org-stuck-projects))
13369 (t (error "Invalid key")))))) 14435 (t (error "Invalid key"))))))
13370 14436
13371(defun org-run-agenda-series (series) 14437(defun org-run-agenda-series (name series)
13372 (org-prepare-agenda) 14438 (org-prepare-agenda name)
13373 (let* ((org-agenda-multi t) 14439 (let* ((org-agenda-multi t)
13374 (redo (list 'org-run-agenda-series (list 'quote series))) 14440 (redo (list 'org-run-agenda-series name (list 'quote series)))
13375 (cmds (car series)) 14441 (cmds (car series))
13376 (gprops (nth 1 series)) 14442 (gprops (nth 1 series))
13377 match ;; The byte compiler incorrectly complains about this. Keep it! 14443 match ;; The byte compiler incorrectly complains about this. Keep it!
@@ -13380,11 +14446,14 @@ L Timeline for current buffer # List stuck projects (!=configure)
13380 (setq type (car cmd) match (nth 1 cmd) lprops (nth 2 cmd)) 14446 (setq type (car cmd) match (nth 1 cmd) lprops (nth 2 cmd))
13381 (cond 14447 (cond
13382 ((eq type 'agenda) 14448 ((eq type 'agenda)
13383 (call-interactively 'org-agenda-list)) 14449 (org-let2 gprops lprops
14450 '(call-interactively 'org-agenda-list)))
13384 ((eq type 'alltodo) 14451 ((eq type 'alltodo)
13385 (call-interactively 'org-todo-list)) 14452 (org-let2 gprops lprops
14453 '(call-interactively 'org-todo-list)))
13386 ((eq type 'stuck) 14454 ((eq type 'stuck)
13387 (call-interactively 'org-agenda-list-stuck-projects)) 14455 (org-let2 gprops lprops
14456 '(call-interactively 'org-agenda-list-stuck-projects)))
13388 ((eq type 'tags) 14457 ((eq type 'tags)
13389 (org-let2 gprops lprops 14458 (org-let2 gprops lprops
13390 '(org-tags-view current-prefix-arg match))) 14459 '(org-tags-view current-prefix-arg match)))
@@ -13405,17 +14474,208 @@ L Timeline for current buffer # List stuck projects (!=configure)
13405 14474
13406;;;###autoload 14475;;;###autoload
13407(defmacro org-batch-agenda (cmd-key &rest parameters) 14476(defmacro org-batch-agenda (cmd-key &rest parameters)
13408 "Run an agenda command in batch mode, send result to STDOUT. 14477 "Run an agenda command in batch mode and send the result to STDOUT.
13409CMD-KEY is a string that is also a key in `org-agenda-custom-commands'. 14478If CMD-KEY is a string of length 1, it is used as a key in
14479`org-agenda-custom-commands' and triggers this command. If it is a
14480longer string is is used as a tags/todo match string.
13410Paramters are alternating variable names and values that will be bound 14481Paramters are alternating variable names and values that will be bound
13411before running the agenda command." 14482before running the agenda command."
13412 (let (pars) 14483 (let (pars)
13413 (while parameters 14484 (while parameters
13414 (push (list (pop parameters) (if parameters (pop parameters))) pars)) 14485 (push (list (pop parameters) (if parameters (pop parameters))) pars))
13415 (flet ((read-char-exclusive () (string-to-char cmd-key))) 14486 (if (> (length cmd-key) 1)
13416 (eval (list 'let (nreverse pars) '(org-agenda nil)))) 14487 (eval (list 'let (nreverse pars)
14488 (list 'org-tags-view nil cmd-key)))
14489 (flet ((read-char-exclusive () (string-to-char cmd-key)))
14490 (eval (list 'let (nreverse pars) '(org-agenda nil)))))
14491 (set-buffer "*Org Agenda*")
14492 (princ (org-encode-for-stdout (buffer-string)))))
14493
14494(defun org-encode-for-stdout (string)
14495 (if (fboundp 'encode-coding-string)
14496 (encode-coding-string string buffer-file-coding-system)
14497 string))
14498
14499(defvar org-agenda-info nil)
14500
14501;;;###autoload
14502(defmacro org-batch-agenda-csv (cmd-key &rest parameters)
14503 "Run an agenda command in batch mode and send the result to STDOUT.
14504If CMD-KEY is a string of length 1, it is used as a key in
14505`org-agenda-custom-commands' and triggers this command. If it is a
14506longer string is is used as a tags/todo match string.
14507Paramters are alternating variable names and values that will be bound
14508before running the agenda command.
14509
14510The output gives a line for each selected agenda item. Each
14511item is a list of comma-separated values, like this:
14512
14513category,head,type,todo,tags,date,time,extra,priority-l,priority-n
14514
14515category The category of the item
14516head The headline, without TODO kwd, TAGS and PRIORITY
14517type The type of the agenda entry, can be
14518 todo selected in TODO match
14519 tagsmatch selected in tags match
14520 diary imported from diary
14521 deadline a deadline on given date
14522 scheduled scheduled on given date
14523 timestamp entry has timestamp on given date
14524 closed entry was closed on given date
14525 upcoming-deadline warning about deadline
14526 past-scheduled forwarded scheduled item
14527 block entry has date block including g. date
14528todo The todo keyword, if any
14529tags All tags including inherited ones, separated by colons
14530date The relevant date, like 2007-2-14
14531time The time, like 15:00-16:50
14532extra Sting with extra planning info
14533priority-l The priority letter if any was given
14534priority-n The computed numerical priority"
14535
14536 (let (pars)
14537 (while parameters
14538 (push (list (pop parameters) (if parameters (pop parameters))) pars))
14539 (push (list 'org-agenda-remove-tags t) pars)
14540 (if (> (length cmd-key) 1)
14541 (eval (list 'let (nreverse pars)
14542 (list 'org-tags-view nil cmd-key)))
14543 (flet ((read-char-exclusive () (string-to-char cmd-key)))
14544 (eval (list 'let (nreverse pars) '(org-agenda nil)))))
13417 (set-buffer "*Org Agenda*") 14545 (set-buffer "*Org Agenda*")
13418 (princ (buffer-string)))) 14546 (let* ((lines (org-split-string (buffer-string) "\n"))
14547 line)
14548 (while (setq line (pop lines))
14549 (catch 'next
14550 (if (not (get-text-property 0 'org-category line)) (throw 'next nil))
14551 (setq org-agenda-info
14552 (org-fix-agenda-info (text-properties-at 0 line)))
14553 (princ
14554 (org-encode-for-stdout
14555 (mapconcat 'org-agenda-export-csv-mapper
14556 '(org-category txt type todo tags date time-of-day extra
14557 priority-letter priority)
14558 ",")))
14559 (princ "\n"))))))
14560
14561(defun org-fix-agenda-info (props)
14562 "FIXME"
14563 (let (tmp re)
14564 (when (setq tmp (plist-get props 'tags))
14565 (setq props (plist-put props 'tags (mapconcat 'identity tmp ":"))))
14566 (when (setq tmp (plist-get props 'date))
14567 (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp)))
14568 (let ((calendar-date-display-form '(year "-" month "-" day)))
14569 '((format "%4d, %9s %2s, %4s" dayname monthname day year))
14570
14571 (setq tmp (calendar-date-string tmp)))
14572 (setq props (plist-put props 'date tmp)))
14573 (when (setq tmp (plist-get props 'day))
14574 (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp)))
14575 (let ((calendar-date-display-form '(year "-" month "-" day)))
14576 (setq tmp (calendar-date-string tmp)))
14577 (setq props (plist-put props 'day tmp)))
14578 (when (setq tmp (plist-get props 'txt))
14579 (when (string-match "\\[#\\([A-Z0-9]\\)\\] ?" tmp)
14580 (plist-put props 'priority-letter (match-string 1 tmp))
14581 (setq tmp (replace-match "" t t tmp)))
14582 (when (and (setq re (plist-get props 'org-todo-regexp))
14583 (setq re (concat "\\`\\.*" re " ?"))
14584 (string-match re tmp))
14585 (plist-put props 'todo (match-string 1 tmp))
14586 (setq tmp (replace-match "" t t tmp)))
14587 (plist-put props 'txt tmp)))
14588 props)
14589
14590(defun org-agenda-export-csv-mapper (prop)
14591 (let ((res (plist-get org-agenda-info prop)))
14592 (setq res
14593 (cond
14594 ((not res) "")
14595 ((stringp res) res)
14596 (t (prin1-to-string res))))
14597 (while (string-match "," res)
14598 (setq res (replace-match ";" t t res)))
14599 (org-trim res)))
14600
14601
14602;;;###autoload
14603(defun org-store-agenda-views (&rest parameters)
14604 (interactive)
14605 (eval (list 'org-batch-store-agenda-views)))
14606
14607(defvar org-agenda-buffer-name)
14608
14609;; FIXME, why is this a macro?????
14610;;;###autoload
14611(defmacro org-batch-store-agenda-views (&rest parameters)
14612 "Run all custom agenda commands that have a file argument."
14613 (let ((cmds org-agenda-custom-commands)
14614 (dir (default-directory))
14615 pars cmd thiscmdkey files opts)
14616 (while parameters
14617 (push (list (pop parameters) (if parameters (pop parameters))) pars))
14618 (setq pars (reverse pars))
14619 (save-window-excursion
14620 (while cmds
14621 (setq cmd (pop cmds)
14622 thiscmdkey (car cmd)
14623 opts (nth 3 cmd)
14624 files (org-last cmd))
14625 (if (stringp files) (setq files (list files)))
14626 (when files
14627 (flet ((read-char-exclusive () (string-to-char thiscmdkey)))
14628 (eval (list 'let (append org-agenda-exporter-settings opts pars)
14629 '(org-agenda nil))))
14630 (set-buffer "*Org Agenda*")
14631 (while files
14632 (eval (list 'let (append org-agenda-exporter-settings opts pars)
14633 (list 'org-write-agenda
14634 (expand-file-name (pop files) dir) t)))))
14635 (kill-buffer org-agenda-buffer-name)))))
14636
14637(defun org-write-agenda (file &optional nosettings)
14638 "Write the current buffer (an agenda view) as a file.
14639Depending on the extension of the file name, plain text (.txt),
14640HTML (.html or .htm) or Postscript (.ps) is produced.
14641If NOSETTINGS is given, do not scope the settings of
14642`org-agenda-exporter-settings' into the export commands. This is used when
14643the settings have already been scoped and we do not wish to overrule other,
14644higher priority settings."
14645 (interactive "FWrite agenda to file: ")
14646 (if (not (file-writable-p file))
14647 (error "Cannot write agenda to file %s" file))
14648 (cond
14649 ((string-match "\\.html?\\'" file) (require 'htmlize))
14650 ((string-match "\\.ps\\'" file) (require 'ps-print)))
14651 (org-let (if nosettings nil org-agenda-exporter-settings)
14652 '(save-excursion
14653 (save-window-excursion
14654 (cond
14655 ((string-match "\\.html?\\'" file)
14656 (set-buffer (htmlize-buffer (current-buffer)))
14657
14658 (when (and org-agenda-export-html-style
14659 (string-match "<style>" org-agenda-export-html-style))
14660 ;; replace <style> section with org-agenda-export-html-style
14661 (goto-char (point-min))
14662 (kill-region (- (search-forward "<style") 6)
14663 (search-forward "</style>"))
14664 (insert org-agenda-export-html-style))
14665 (write-file file)
14666 (kill-buffer (current-buffer))
14667 (message "HTML written to %s" file))
14668 ((string-match "\\.ps\\'" file)
14669 (ps-print-buffer-with-faces file)
14670 (message "Postscript written to %s" file))
14671 (t
14672 (let ((bs (buffer-string)))
14673 (find-file file)
14674 (insert bs)
14675 (save-buffer 0)
14676 (kill-buffer (current-buffer))
14677 (message "Plain text written to %s" file))))))
14678 (set-buffer org-agenda-buffer-name)))
13419 14679
13420(defmacro org-no-read-only (&rest body) 14680(defmacro org-no-read-only (&rest body)
13421 "Inhibit read-only for BODY." 14681 "Inhibit read-only for BODY."
@@ -13508,13 +14768,6 @@ If the current buffer does not, find the first agenda file."
13508 (find-file (car fs))) 14768 (find-file (car fs)))
13509 (if (buffer-base-buffer) (switch-to-buffer (buffer-base-buffer))))) 14769 (if (buffer-base-buffer) (switch-to-buffer (buffer-base-buffer)))))
13510 14770
13511(defun org-agenda-file-to-end ()
13512 "Move/add the current file to the end of the agenda file list.
13513If the file is not present in the list, it is appended to the list. If it is
13514present, it is moved there."
13515 (interactive)
13516 (org-agenda-file-to-front 'to-end))
13517
13518(defun org-agenda-file-to-front (&optional to-end) 14771(defun org-agenda-file-to-front (&optional to-end)
13519 "Move/add the current file to the top of the agenda file list. 14772 "Move/add the current file to the top of the agenda file list.
13520If the file is not present in the list, it is added to the front. If it is 14773If the file is not present in the list, it is added to the front. If it is
@@ -13578,7 +14831,10 @@ Optional argument FILE means, use this file instead of the current."
13578(defvar org-agenda-multi nil) ; dynammically scoped 14831(defvar org-agenda-multi nil) ; dynammically scoped
13579(defvar org-agenda-buffer-name "*Org Agenda*") 14832(defvar org-agenda-buffer-name "*Org Agenda*")
13580(defvar org-pre-agenda-window-conf nil) 14833(defvar org-pre-agenda-window-conf nil)
13581(defun org-prepare-agenda () 14834(defvar org-agenda-name nil)
14835(defun org-prepare-agenda (&optional name)
14836 (setq org-todo-keywords-for-agenda nil)
14837 (setq org-done-keywords-for-agenda nil)
13582 (if org-agenda-multi 14838 (if org-agenda-multi
13583 (progn 14839 (progn
13584 (setq buffer-read-only nil) 14840 (setq buffer-read-only nil)
@@ -13588,6 +14844,10 @@ Optional argument FILE means, use this file instead of the current."
13588 (narrow-to-region (point) (point-max))) 14844 (narrow-to-region (point) (point-max)))
13589 (org-agenda-maybe-reset-markers 'force) 14845 (org-agenda-maybe-reset-markers 'force)
13590 (org-prepare-agenda-buffers (org-agenda-files)) 14846 (org-prepare-agenda-buffers (org-agenda-files))
14847 (setq org-todo-keywords-for-agenda
14848 (org-uniquify org-todo-keywords-for-agenda))
14849 (setq org-done-keywords-for-agenda
14850 (org-uniquify org-done-keywords-for-agenda))
13591 (let* ((abuf (get-buffer-create org-agenda-buffer-name)) 14851 (let* ((abuf (get-buffer-create org-agenda-buffer-name))
13592 (awin (get-buffer-window abuf))) 14852 (awin (get-buffer-window abuf)))
13593 (cond 14853 (cond
@@ -13605,7 +14865,9 @@ Optional argument FILE means, use this file instead of the current."
13605 (switch-to-buffer-other-window abuf)))) 14865 (switch-to-buffer-other-window abuf))))
13606 (setq buffer-read-only nil) 14866 (setq buffer-read-only nil)
13607 (erase-buffer) 14867 (erase-buffer)
13608 (org-agenda-mode)) 14868 (org-agenda-mode)
14869 (and name (not org-agenda-name)
14870 (org-set-local 'org-agenda-name name)))
13609 (setq buffer-read-only nil)) 14871 (setq buffer-read-only nil))
13610 14872
13611(defun org-finalize-agenda () 14873(defun org-finalize-agenda ()
@@ -13617,7 +14879,9 @@ Optional argument FILE means, use this file instead of the current."
13617 (goto-char (point-min)) 14879 (goto-char (point-min))
13618 (while (org-activate-bracket-links (point-max)) 14880 (while (org-activate-bracket-links (point-max))
13619 (add-text-properties (match-beginning 0) (match-end 0) 14881 (add-text-properties (match-beginning 0) (match-end 0)
13620 '(face org-link)))) 14882 '(face org-link)))
14883 (unless org-agenda-with-colors
14884 (remove-text-properties (point-min) (point-max) '(face nil))))
13621 (run-hooks 'org-finalize-agenda-hook)))) 14885 (run-hooks 'org-finalize-agenda-hook))))
13622 14886
13623(defun org-prepare-agenda-buffers (files) 14887(defun org-prepare-agenda-buffers (files)
@@ -13635,6 +14899,10 @@ Optional argument FILE means, use this file instead of the current."
13635 (set-buffer (org-get-agenda-file-buffer file)) 14899 (set-buffer (org-get-agenda-file-buffer file))
13636 (widen) 14900 (widen)
13637 (setq bmp (buffer-modified-p)) 14901 (setq bmp (buffer-modified-p))
14902 (setq org-todo-keywords-for-agenda
14903 (append org-todo-keywords-for-agenda org-todo-keywords-1))
14904 (setq org-done-keywords-for-agenda
14905 (append org-done-keywords-for-agenda org-done-keywords))
13638 (save-excursion 14906 (save-excursion
13639 (remove-text-properties (point-min) (point-max) pall) 14907 (remove-text-properties (point-min) (point-max) pall)
13640 (when org-agenda-skip-archived-trees 14908 (when org-agenda-skip-archived-trees
@@ -13648,7 +14916,7 @@ Optional argument FILE means, use this file instead of the current."
13648 (add-text-properties 14916 (add-text-properties
13649 (match-beginning 0) (org-end-of-subtree t) pc))) 14917 (match-beginning 0) (org-end-of-subtree t) pc)))
13650 (set-buffer-modified-p bmp)))))) 14918 (set-buffer-modified-p bmp))))))
13651 14919
13652(defvar org-agenda-skip-function nil 14920(defvar org-agenda-skip-function nil
13653 "Function to be called at each match during agenda construction. 14921 "Function to be called at each match during agenda construction.
13654If this function return nil, the current match should not be skipped. 14922If this function return nil, the current match should not be skipped.
@@ -13733,9 +15001,13 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
13733 "Get the table of categories and positions in current buffer." 15001 "Get the table of categories and positions in current buffer."
13734 (let (tbl) 15002 (let (tbl)
13735 (save-excursion 15003 (save-excursion
13736 (goto-char (point-min)) 15004 (save-restriction
13737 (while (re-search-forward "\\(^\\|\r\\)#\\+CATEGORY:[ \t]*\\(.*\\)" nil t) 15005 (widen)
13738 (push (cons (point) (org-trim (match-string 2))) tbl))) 15006 (goto-char (point-min))
15007 (while (re-search-forward "^#\\+CATEGORY:[ \t]*\\(.*\\)"
15008 nil t)
15009 (push (cons (match-beginning 1)
15010 (org-trim (match-string 1))) tbl))))
13739 tbl)) 15011 tbl))
13740 15012
13741(defun org-get-category (&optional pos) 15013(defun org-get-category (&optional pos)
@@ -13792,16 +15064,18 @@ dates."
13792 (setq day-numbers (delq nil (mapcar (lambda(x) 15064 (setq day-numbers (delq nil (mapcar (lambda(x)
13793 (if (>= x today) x nil)) 15065 (if (>= x today) x nil))
13794 day-numbers)))) 15066 day-numbers))))
13795 (org-prepare-agenda) 15067 (org-prepare-agenda (concat "Timeline "
15068 (file-name-nondirectory buffer-file-name)))
13796 (if doclosed (push :closed args)) 15069 (if doclosed (push :closed args))
13797 (push :timestamp args) 15070 (push :timestamp args)
15071 (push :sexp args)
13798 (if dotodo (push :todo args)) 15072 (if dotodo (push :todo args))
13799 (while (setq d (pop day-numbers)) 15073 (while (setq d (pop day-numbers))
13800 (if (and (listp d) (eq (car d) :omitted)) 15074 (if (and (listp d) (eq (car d) :omitted))
13801 (progn 15075 (progn
13802 (setq s (point)) 15076 (setq s (point))
13803 (insert (format "\n[... %d empty days omitted]\n\n" (cdr d))) 15077 (insert (format "\n[... %d empty days omitted]\n\n" (cdr d)))
13804 (put-text-property s (1- (point)) 'face 'org-level-3)) 15078 (put-text-property s (1- (point)) 'face 'org-agenda-structure))
13805 (if (listp d) (setq d (car d) emptyp t) (setq emptyp nil)) 15079 (if (listp d) (setq d (car d) emptyp t) (setq emptyp nil))
13806 (if (and (>= d today) 15080 (if (and (>= d today)
13807 dopast 15081 dopast
@@ -13824,7 +15098,7 @@ dates."
13824; (insert (format-time-string org-agenda-date-format 15098; (insert (format-time-string org-agenda-date-format
13825; (calendar-time-from-absolute d 0)) 15099; (calendar-time-from-absolute d 0))
13826; "\n") 15100; "\n")
13827 (put-text-property s (1- (point)) 'face 'org-level-3) 15101 (put-text-property s (1- (point)) 'face 'org-agenda-structure)
13828 (put-text-property s (1- (point)) 'org-date-line t) 15102 (put-text-property s (1- (point)) 'org-date-line t)
13829 (if (equal d today) 15103 (if (equal d today)
13830 (put-text-property s (1- (point)) 'org-today t)) 15104 (put-text-property s (1- (point)) 'org-today t))
@@ -13936,7 +15210,7 @@ NDAYS defaults to `org-agenda-ndays'."
13936 (push (1+ (car day-numbers)) day-numbers) 15210 (push (1+ (car day-numbers)) day-numbers)
13937 (setq ndays (1- ndays))) 15211 (setq ndays (1- ndays)))
13938 (setq day-numbers (nreverse day-numbers)) 15212 (setq day-numbers (nreverse day-numbers))
13939 (org-prepare-agenda) 15213 (org-prepare-agenda "Day/Week")
13940 (org-set-local 'org-starting-day (car day-numbers)) 15214 (org-set-local 'org-starting-day (car day-numbers))
13941 (org-set-local 'org-include-all-loc include-all) 15215 (org-set-local 'org-include-all-loc include-all)
13942 (when (and (or include-all org-agenda-include-all-todo) 15216 (when (and (or include-all org-agenda-include-all-todo)
@@ -13953,11 +15227,12 @@ NDAYS defaults to `org-agenda-ndays'."
13953 (when rtnall 15227 (when rtnall
13954 (insert "ALL CURRENTLY OPEN TODO ITEMS:\n") 15228 (insert "ALL CURRENTLY OPEN TODO ITEMS:\n")
13955 (add-text-properties (point-min) (1- (point)) 15229 (add-text-properties (point-min) (1- (point))
13956 (list 'face 'org-level-3)) 15230 (list 'face 'org-agenda-structure))
13957 (insert (org-finalize-agenda-entries rtnall) "\n"))) 15231 (insert (org-finalize-agenda-entries rtnall) "\n")))
13958 (setq s (point)) 15232 (setq s (point))
13959 (insert (if (= nd 7) "Week-" "Day-") "agenda:\n") 15233 (insert (if (= nd 7) "Week-" "Day-") "agenda:\n")
13960 (add-text-properties s (1- (point)) (list 'face 'org-level-3)) 15234 (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure
15235 'org-date-line t))
13961 (while (setq d (pop day-numbers)) 15236 (while (setq d (pop day-numbers))
13962 (setq date (calendar-gregorian-from-absolute d) 15237 (setq date (calendar-gregorian-from-absolute d)
13963 s (point)) 15238 s (point))
@@ -13974,10 +15249,10 @@ NDAYS defaults to `org-agenda-ndays'."
13974 (if org-agenda-show-log 15249 (if org-agenda-show-log
13975 (setq rtn (org-agenda-get-day-entries 15250 (setq rtn (org-agenda-get-day-entries
13976 file date 15251 file date
13977 :deadline :scheduled :timestamp :closed)) 15252 :deadline :scheduled :timestamp :sexp :closed))
13978 (setq rtn (org-agenda-get-day-entries 15253 (setq rtn (org-agenda-get-day-entries
13979 file date 15254 file date
13980 :deadline :scheduled :timestamp))) 15255 :deadline :scheduled :sexp :timestamp)))
13981 (setq rtnall (append rtnall rtn)))) 15256 (setq rtnall (append rtnall rtn))))
13982 (if org-agenda-include-diary 15257 (if org-agenda-include-diary
13983 (progn 15258 (progn
@@ -13994,7 +15269,7 @@ NDAYS defaults to `org-agenda-ndays'."
13994; FIXME: this gives a timezone problem 15269; FIXME: this gives a timezone problem
13995; (insert (format-time-string org-agenda-date-format 15270; (insert (format-time-string org-agenda-date-format
13996; (calendar-time-from-absolute d 0)) "\n") 15271; (calendar-time-from-absolute d 0)) "\n")
13997 (put-text-property s (1- (point)) 'face 'org-level-3) 15272 (put-text-property s (1- (point)) 'face 'org-agenda-structure)
13998 (put-text-property s (1- (point)) 'org-date-line t) 15273 (put-text-property s (1- (point)) 'org-date-line t)
13999 (if todayp (put-text-property s (1- (point)) 'org-today t)) 15274 (if todayp (put-text-property s (1- (point)) 'org-today t))
14000 (if rtnall (insert 15275 (if rtnall (insert
@@ -14030,28 +15305,28 @@ NDAYS defaults to `org-agenda-ndays'."
14030The prefix arg can be used to select a specific TODO keyword and limit 15305The prefix arg can be used to select a specific TODO keyword and limit
14031the list to these. When using \\[universal-argument], you will be prompted 15306the list to these. When using \\[universal-argument], you will be prompted
14032for a keyword. A numeric prefix directly selects the Nth keyword in 15307for a keyword. A numeric prefix directly selects the Nth keyword in
14033`org-todo-keywords'." 15308`org-todo-keywords-1'."
14034 (interactive "P") 15309 (interactive "P")
14035 (require 'calendar) 15310 (require 'calendar)
14036 (org-compile-prefix-format 'todo) 15311 (org-compile-prefix-format 'todo)
14037 (org-set-sorting-strategy 'todo) 15312 (org-set-sorting-strategy 'todo)
15313 (org-prepare-agenda "TODO")
14038 (let* ((today (time-to-days (current-time))) 15314 (let* ((today (time-to-days (current-time)))
14039 (date (calendar-gregorian-from-absolute today)) 15315 (date (calendar-gregorian-from-absolute today))
14040 (kwds org-todo-keywords) 15316 (kwds org-todo-keywords-for-agenda)
14041 (completion-ignore-case t) 15317 (completion-ignore-case t)
14042 (org-select-this-todo-keyword 15318 (org-select-this-todo-keyword
14043 (if (stringp arg) arg 15319 (if (stringp arg) arg
14044 (and arg (integerp arg) (> arg 0) 15320 (and arg (integerp arg) (> arg 0)
14045 (nth (1- arg) org-todo-keywords)))) 15321 (nth (1- arg) kwds))))
14046 rtn rtnall files file pos) 15322 rtn rtnall files file pos)
14047 (when (equal arg '(4)) 15323 (when (equal arg '(4))
14048 (setq org-select-this-todo-keyword 15324 (setq org-select-this-todo-keyword
14049 (completing-read "Keyword: " (mapcar 'list org-todo-keywords) 15325 (completing-read "Keyword (or KWD1|K2D2|...): "
14050 nil t))) 15326 (mapcar 'list kwds) nil nil)))
14051 (and (equal 0 arg) (setq org-select-this-todo-keyword nil)) 15327 (and (equal 0 arg) (setq org-select-this-todo-keyword nil))
14052 (org-prepare-agenda)
14053 (org-set-local 'org-last-arg arg) 15328 (org-set-local 'org-last-arg arg)
14054 (org-set-local 'org-todo-keywords kwds) 15329;FIXME (org-set-local 'org-todo-keywords-for-agenda kwds)
14055 (setq org-agenda-redo-command 15330 (setq org-agenda-redo-command
14056 '(org-todo-list (or current-prefix-arg org-last-arg))) 15331 '(org-todo-list (or current-prefix-arg org-last-arg)))
14057 (setq files (org-agenda-files) 15332 (setq files (org-agenda-files)
@@ -14063,23 +15338,25 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
14063 (setq rtnall (append rtnall rtn)))) 15338 (setq rtnall (append rtnall rtn))))
14064 (if org-agenda-overriding-header 15339 (if org-agenda-overriding-header
14065 (insert (org-add-props (copy-sequence org-agenda-overriding-header) 15340 (insert (org-add-props (copy-sequence org-agenda-overriding-header)
14066 nil 'face 'org-level-3) "\n") 15341 nil 'face 'org-agenda-structure) "\n")
14067 (insert "Global list of TODO items of type: ") 15342 (insert "Global list of TODO items of type: ")
14068 (add-text-properties (point-min) (1- (point)) 15343 (add-text-properties (point-min) (1- (point))
14069 (list 'face 'org-level-3)) 15344 (list 'face 'org-agenda-structure))
14070 (setq pos (point)) 15345 (setq pos (point))
14071 (insert (or org-select-this-todo-keyword "ALL") "\n") 15346 (insert (or org-select-this-todo-keyword "ALL") "\n")
14072 (add-text-properties pos (1- (point)) (list 'face 'org-warning)) 15347 (add-text-properties pos (1- (point)) (list 'face 'org-warning))
14073 (setq pos (point)) 15348 (setq pos (point))
14074 (unless org-agenda-multi 15349 (unless org-agenda-multi
14075 (insert 15350 (insert "Available with `N r': (0)ALL")
14076 "Available with `N r': (0)ALL " 15351 (let ((n 0) s)
14077 (let ((n 0)) 15352 (mapc (lambda (x)
14078 (mapconcat (lambda (x) 15353 (setq s (format "(%d)%s" (setq n (1+ n)) x))
14079 (format "(%d)%s" (setq n (1+ n)) x)) 15354 (if (> (+ (current-column) (string-width s) 1) (frame-width))
14080 org-todo-keywords " ")) 15355 (insert "\n "))
14081 "\n")) 15356 (insert " " s))
14082 (add-text-properties pos (1- (point)) (list 'face 'org-level-3))) 15357 kwds))
15358 (insert "\n"))
15359 (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
14083 (when rtnall 15360 (when rtnall
14084 (insert (org-finalize-agenda-entries rtnall) "\n")) 15361 (insert (org-finalize-agenda-entries rtnall) "\n"))
14085 (goto-char (point-min)) 15362 (goto-char (point-min))
@@ -14104,7 +15381,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
14104 buffer) 15381 buffer)
14105 (setq matcher (org-make-tags-matcher match) 15382 (setq matcher (org-make-tags-matcher match)
14106 match (car matcher) matcher (cdr matcher)) 15383 match (car matcher) matcher (cdr matcher))
14107 (org-prepare-agenda) 15384 (org-prepare-agenda (concat "TAGS " match))
14108 (setq org-agenda-redo-command 15385 (setq org-agenda-redo-command
14109 (list 'org-tags-view (list 'quote todo-only) 15386 (list 'org-tags-view (list 'quote todo-only)
14110 (list 'if 'current-prefix-arg nil match))) 15387 (list 'if 'current-prefix-arg nil match)))
@@ -14135,17 +15412,17 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
14135 (setq rtnall (append rtnall rtn)))))))) 15412 (setq rtnall (append rtnall rtn))))))))
14136 (if org-agenda-overriding-header 15413 (if org-agenda-overriding-header
14137 (insert (org-add-props (copy-sequence org-agenda-overriding-header) 15414 (insert (org-add-props (copy-sequence org-agenda-overriding-header)
14138 nil 'face 'org-level-3) "\n") 15415 nil 'face 'org-agenda-structure) "\n")
14139 (insert "Headlines with TAGS match: ") 15416 (insert "Headlines with TAGS match: ")
14140 (add-text-properties (point-min) (1- (point)) 15417 (add-text-properties (point-min) (1- (point))
14141 (list 'face 'org-level-3)) 15418 (list 'face 'org-agenda-structure))
14142 (setq pos (point)) 15419 (setq pos (point))
14143 (insert match "\n") 15420 (insert match "\n")
14144 (add-text-properties pos (1- (point)) (list 'face 'org-warning)) 15421 (add-text-properties pos (1- (point)) (list 'face 'org-warning))
14145 (setq pos (point)) 15422 (setq pos (point))
14146 (unless org-agenda-multi 15423 (unless org-agenda-multi
14147 (insert "Press `C-u r' to search again with new search string\n")) 15424 (insert "Press `C-u r' to search again with new search string\n"))
14148 (add-text-properties pos (1- (point)) (list 'face 'org-level-3))) 15425 (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
14149 (when rtnall 15426 (when rtnall
14150 (insert (org-finalize-agenda-entries rtnall) "\n")) 15427 (insert (org-finalize-agenda-entries rtnall) "\n"))
14151 (goto-char (point-min)) 15428 (goto-char (point-min))
@@ -14187,21 +15464,34 @@ MATCH is being ignored."
14187 (org-agenda-overriding-header "List of stuck projects: ") 15464 (org-agenda-overriding-header "List of stuck projects: ")
14188 (matcher (nth 0 org-stuck-projects)) 15465 (matcher (nth 0 org-stuck-projects))
14189 (todo (nth 1 org-stuck-projects)) 15466 (todo (nth 1 org-stuck-projects))
14190 (tags (nth 2 org-stuck-projects)) 15467 (todo-wds (if (member "*" todo)
15468 (progn
15469 (org-prepare-agenda-buffers (org-agenda-files))
15470 (org-delete-all
15471 org-done-keywords-for-agenda
15472 (copy-sequence org-todo-keywords-for-agenda)))
15473 todo))
14191 (todo-re (concat "^\\*+[ \t]+\\(" 15474 (todo-re (concat "^\\*+[ \t]+\\("
14192 (mapconcat 'identity todo "\\|") 15475 (mapconcat 'identity todo-wds "\\|")
14193 "\\)\\>")) 15476 "\\)\\>"))
14194 (tags-re (concat "^\\*+.*:\\(" 15477 (tags (nth 2 org-stuck-projects))
14195 (mapconcat 'identity tags "\\|") 15478 (tags-re (if (member "*" tags)
14196 "\\):[a-zA-Z0-9_@:]*[ \t]*$"))) 15479 "^\\*+.*:[a-zA-Z0-9_@]+:[ \t]*$"
14197 15480 (concat "^\\*+.*:\\("
15481 (mapconcat 'identity tags "\\|")
15482 "\\):[a-zA-Z0-9_@:]*[ \t]*$")))
15483 (gen-re (nth 3 org-stuck-projects))
15484 (re-list
15485 (delq nil
15486 (list
15487 (if todo todo-re)
15488 (if tags tags-re)
15489 (and gen-re (stringp gen-re) (string-match "\\S-" gen-re)
15490 gen-re)))))
14198 (setq org-agenda-skip-regexp 15491 (setq org-agenda-skip-regexp
14199 (cond 15492 (if re-list
14200 ((and todo tags) 15493 (mapconcat 'identity re-list "\\|")
14201 (concat todo-re "\\|" tags-re)) 15494 (error "No information how to identify unstuck projects")))
14202 (todo todo-re)
14203 (tags tags-re)
14204 (t (error "No information how to identify unstuck projects"))))
14205 (org-tags-view nil matcher) 15495 (org-tags-view nil matcher)
14206 (with-current-buffer org-agenda-buffer-name 15496 (with-current-buffer org-agenda-buffer-name
14207 (setq org-agenda-redo-command 15497 (setq org-agenda-redo-command
@@ -14247,7 +15537,8 @@ MATCH is being ignored."
14247 (lambda (x) 15537 (lambda (x)
14248 (setq x (org-format-agenda-item "" x "Diary" nil 'time)) 15538 (setq x (org-format-agenda-item "" x "Diary" nil 'time))
14249 ;; Extend the text properties to the beginning of the line 15539 ;; Extend the text properties to the beginning of the line
14250 (org-add-props x (text-properties-at (1- (length x)) x))) 15540 (org-add-props x (text-properties-at (1- (length x)) x)
15541 'type "diary" 'date date))
14251 entries))))) 15542 entries)))))
14252 15543
14253(defun org-agenda-cleanup-fancy-diary () 15544(defun org-agenda-cleanup-fancy-diary ()
@@ -14316,6 +15607,8 @@ items should be listed. The following arguments are allowed:
14316 date range matching the selected date. Deadlines will 15607 date range matching the selected date. Deadlines will
14317 also be listed, on the expiration day. 15608 also be listed, on the expiration day.
14318 15609
15610 :sexp FIXME
15611
14319 :deadline List any deadlines past due, or due within 15612 :deadline List any deadlines past due, or due within
14320 `org-deadline-warning-days'. The listing occurs only 15613 `org-deadline-warning-days'. The listing occurs only
14321 in the diary for *today*, not at any other date. If 15614 in the diary for *today*, not at any other date. If
@@ -14340,10 +15633,10 @@ all files listed in `org-agenda-files' will be checked automatically:
14340 &%%(org-diary) 15633 &%%(org-diary)
14341 15634
14342If you don't give any arguments (as in the example above), the default 15635If you don't give any arguments (as in the example above), the default
14343arguments (:deadline :scheduled :timestamp) are used. So the example above may 15636arguments (:deadline :scheduled :timestamp :sexp) are used.
14344also be written as 15637So the example above may also be written as
14345 15638
14346 &%%(org-diary :deadline :timestamp :scheduled) 15639 &%%(org-diary :deadline :timestamp :sexp :scheduled)
14347 15640
14348The function expects the lisp variables `entry' and `date' to be provided 15641The function expects the lisp variables `entry' and `date' to be provided
14349by the caller, because this is how the calendar works. Don't use this 15642by the caller, because this is how the calendar works. Don't use this
@@ -14351,11 +15644,12 @@ function from a program - use `org-agenda-get-day-entries' instead."
14351 (org-agenda-maybe-reset-markers) 15644 (org-agenda-maybe-reset-markers)
14352 (org-compile-prefix-format 'agenda) 15645 (org-compile-prefix-format 'agenda)
14353 (org-set-sorting-strategy 'agenda) 15646 (org-set-sorting-strategy 'agenda)
14354 (setq args (or args '(:deadline :scheduled :timestamp))) 15647 (setq args (or args '(:deadline :scheduled :timestamp :sexp)))
14355 (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) 15648 (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry))
14356 (list entry) 15649 (list entry)
14357 (org-agenda-files t))) 15650 (org-agenda-files t)))
14358 file rtn results) 15651 file rtn results)
15652 (org-prepare-agenda-buffers files)
14359 ;; If this is called during org-agenda, don't return any entries to 15653 ;; If this is called during org-agenda, don't return any entries to
14360 ;; the calendar. Org Agenda will list these entries itself. 15654 ;; the calendar. Org Agenda will list these entries itself.
14361 (if org-disable-agenda-to-diary (setq files nil)) 15655 (if org-disable-agenda-to-diary (setq files nil))
@@ -14373,7 +15667,7 @@ FILE is the path to a file to be checked for entries. DATE is date like
14373the one returned by `calendar-current-date'. ARGS are symbols indicating 15667the one returned by `calendar-current-date'. ARGS are symbols indicating
14374which kind of entries should be extracted. For details about these, see 15668which kind of entries should be extracted. For details about these, see
14375the documentation of `org-diary'." 15669the documentation of `org-diary'."
14376 (setq args (or args '(:deadline :scheduled :timestamp))) 15670 (setq args (or args '(:deadline :scheduled :timestamp :sexp)))
14377 (let* ((org-startup-folded nil) 15671 (let* ((org-startup-folded nil)
14378 (org-startup-align-all-tables nil) 15672 (org-startup-align-all-tables nil)
14379 (buffer (if (file-exists-p file) 15673 (buffer (if (file-exists-p file)
@@ -14406,6 +15700,9 @@ the documentation of `org-diary'."
14406 (setq results (append results rtn)) 15700 (setq results (append results rtn))
14407 (setq rtn (org-agenda-get-timestamps)) 15701 (setq rtn (org-agenda-get-timestamps))
14408 (setq results (append results rtn))) 15702 (setq results (append results rtn)))
15703 ((eq arg :sexp)
15704 (setq rtn (org-agenda-get-sexps))
15705 (setq results (append results rtn)))
14409 ((eq arg :scheduled) 15706 ((eq arg :scheduled)
14410 (setq rtn (org-agenda-get-scheduled)) 15707 (setq rtn (org-agenda-get-scheduled))
14411 (setq results (append results rtn))) 15708 (setq results (append results rtn)))
@@ -14447,15 +15744,20 @@ the documentation of `org-diary'."
14447 (let* ((props (list 'face nil 15744 (let* ((props (list 'face nil
14448 'done-face 'org-done 15745 'done-face 'org-done
14449 'org-not-done-regexp org-not-done-regexp 15746 'org-not-done-regexp org-not-done-regexp
15747 'org-todo-regexp org-todo-regexp
14450 'mouse-face 'highlight 15748 'mouse-face 'highlight
14451 'keymap org-agenda-keymap 15749 'keymap org-agenda-keymap
14452 'help-echo 15750 'help-echo
14453 (format "mouse-2 or RET jump to org file %s" 15751 (format "mouse-2 or RET jump to org file %s"
14454 (abbreviate-file-name buffer-file-name)))) 15752 (abbreviate-file-name buffer-file-name))))
15753 ;; FIXME: get rid of the \n at some point but watch out
14455 (regexp (concat "[\n\r]\\*+ *\\(" 15754 (regexp (concat "[\n\r]\\*+ *\\("
14456 (if org-select-this-todo-keyword 15755 (if org-select-this-todo-keyword
14457 (concat "\\<\\(" org-select-this-todo-keyword 15756 (if (equal org-select-this-todo-keyword "*")
14458 "\\)\\>") 15757 org-todo-regexp
15758 (concat "\\<\\("
15759 (mapconcat 'identity (org-split-string org-select-this-todo-keyword "|") "\\|")
15760 "\\)\\>"))
14459 org-not-done-regexp) 15761 org-not-done-regexp)
14460 "[^\n\r]*\\)")) 15762 "[^\n\r]*\\)"))
14461 marker priority category tags 15763 marker priority category tags
@@ -14481,16 +15783,11 @@ the documentation of `org-diary'."
14481 category (org-get-category) 15783 category (org-get-category)
14482 tags (org-get-tags-at (point)) 15784 tags (org-get-tags-at (point))
14483 txt (org-format-agenda-item "" (match-string 1) category tags) 15785 txt (org-format-agenda-item "" (match-string 1) category tags)
14484 priority 15786 priority (1+ (org-get-priority txt)))
14485 (+ (org-get-priority txt)
14486 (if org-todo-kwd-priority-p
14487 (- org-todo-kwd-max-priority -2
14488 (length
14489 (member (match-string 2) org-todo-keywords)))
14490 1)))
14491 (org-add-props txt props 15787 (org-add-props txt props
14492 'org-marker marker 'org-hd-marker marker 15788 'org-marker marker 'org-hd-marker marker
14493 'priority priority 'org-category category) 15789 'priority priority 'org-category category
15790 'type "todo")
14494 (push txt ee) 15791 (push txt ee)
14495 (if org-agenda-todo-list-sublevels 15792 (if org-agenda-todo-list-sublevels
14496 (goto-char (match-end 1)) 15793 (goto-char (match-end 1))
@@ -14504,38 +15801,61 @@ the documentation of `org-diary'."
14504 "Return the date stamp information for agenda display." 15801 "Return the date stamp information for agenda display."
14505 (let* ((props (list 'face nil 15802 (let* ((props (list 'face nil
14506 'org-not-done-regexp org-not-done-regexp 15803 'org-not-done-regexp org-not-done-regexp
15804 'org-todo-regexp org-todo-regexp
14507 'mouse-face 'highlight 15805 'mouse-face 'highlight
14508 'keymap org-agenda-keymap 15806 'keymap org-agenda-keymap
14509 'help-echo 15807 'help-echo
14510 (format "mouse-2 or RET jump to org file %s" 15808 (format "mouse-2 or RET jump to org file %s"
14511 (abbreviate-file-name buffer-file-name)))) 15809 (abbreviate-file-name buffer-file-name))))
14512 (regexp (regexp-quote 15810;???? (regexp (regexp-quote
14513 (substring 15811; (substring
14514 (format-time-string 15812; (format-time-string
14515 (car org-time-stamp-formats) 15813; (car org-time-stamp-formats)
14516 (apply 'encode-time ; DATE bound by calendar 15814; (apply 'encode-time ; DATE bound by calendar
14517 (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) 15815; (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
14518 0 11))) 15816; 0 11)))
15817 (d1 (calendar-absolute-from-gregorian date))
15818 (regexp
15819 (concat
15820 (regexp-quote
15821 (substring
15822 (format-time-string
15823 (car org-time-stamp-formats)
15824 (apply 'encode-time ; DATE bound by calendar
15825 (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
15826 0 11))
15827 "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
15828 "\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
14519 marker hdmarker deadlinep scheduledp donep tmp priority category 15829 marker hdmarker deadlinep scheduledp donep tmp priority category
14520 ee txt timestr tags) 15830 ee txt timestr tags b0 b3 e3)
14521 (goto-char (point-min)) 15831 (goto-char (point-min))
14522 (while (re-search-forward regexp nil t) 15832 (while (re-search-forward regexp nil t)
15833 (setq b0 (match-beginning 0)
15834 b3 (match-beginning 3) e3 (match-end 3))
14523 (catch :skip 15835 (catch :skip
14524 (and (save-match-data (org-at-date-range-p)) (throw :skip nil)) 15836 (and (org-at-date-range-p) (throw :skip nil))
14525 (org-agenda-skip) 15837 (org-agenda-skip)
14526 (setq marker (org-agenda-new-marker (match-beginning 0)) 15838 (if (and (match-end 1)
14527 category (org-get-category (match-beginning 0)) 15839 (not (= d1 (org-time-string-to-absolute (match-string 1) d1))))
15840 (throw :skip nil))
15841 (if (and e3
15842 (not (org-diary-sexp-entry (buffer-substring b3 e3) "" date)))
15843 (throw :skip nil))
15844 (setq marker (org-agenda-new-marker b0)
15845 category (org-get-category b0)
14528 tmp (buffer-substring (max (point-min) 15846 tmp (buffer-substring (max (point-min)
14529 (- (match-beginning 0) 15847 (- b0 org-ds-keyword-length))
14530 org-ds-keyword-length)) 15848 b0)
14531 (match-beginning 0)) 15849 timestr (if b3 "" (buffer-substring b0 (point-at-eol)))
14532 timestr (buffer-substring (match-beginning 0) (point-at-eol))
14533 deadlinep (string-match org-deadline-regexp tmp) 15850 deadlinep (string-match org-deadline-regexp tmp)
14534 scheduledp (string-match org-scheduled-regexp tmp) 15851 scheduledp (string-match org-scheduled-regexp tmp)
14535 donep (org-entry-is-done-p)) 15852 donep (org-entry-is-done-p))
14536 (and org-agenda-skip-scheduled-if-done 15853 (and org-agenda-skip-scheduled-if-done
14537 scheduledp donep 15854 scheduledp donep
14538 (throw :skip t)) 15855 (throw :skip t))
15856 (and org-agenda-skip-deadline-if-done
15857 deadlinep donep
15858 (throw :skip t))
14539 (if (string-match ">" timestr) 15859 (if (string-match ">" timestr)
14540 ;; substring should only run to end of time stamp 15860 ;; substring should only run to end of time stamp
14541 (setq timestr (substring timestr 0 (match-end 0)))) 15861 (setq timestr (substring timestr 0 (match-end 0))))
@@ -14558,22 +15878,68 @@ the documentation of `org-diary'."
14558 (if deadlinep 15878 (if deadlinep
14559 (org-add-props txt nil 15879 (org-add-props txt nil
14560 'face (if donep 'org-done 'org-warning) 15880 'face (if donep 'org-done 'org-warning)
15881 'type "deadline" 'date date
14561 'undone-face 'org-warning 'done-face 'org-done 15882 'undone-face 'org-warning 'done-face 'org-done
14562 'org-category category 'priority (+ 100 priority)) 15883 'org-category category 'priority (+ 100 priority))
14563 (if scheduledp 15884 (if scheduledp
14564 (org-add-props txt nil 15885 (org-add-props txt nil
14565 'face 'org-scheduled-today 15886 'face 'org-scheduled-today
15887 'type "scheduled" 'date date
14566 'undone-face 'org-scheduled-today 'done-face 'org-done 15888 'undone-face 'org-scheduled-today 'done-face 'org-done
14567 'org-category category 'priority (+ 99 priority)) 15889 'org-category category 'priority (+ 99 priority))
14568 (org-add-props txt nil 'priority priority 'org-category category))) 15890 (org-add-props txt nil 'priority priority
15891 'org-category category 'date date
15892 'type "timestamp")))
14569 (push txt ee)) 15893 (push txt ee))
14570 (outline-next-heading))) 15894 (outline-next-heading)))
14571 (nreverse ee))) 15895 (nreverse ee)))
14572 15896
15897(defun org-agenda-get-sexps ()
15898 "Return the sexp information for agenda display."
15899 (require 'diary-lib)
15900 (let* ((props (list 'face nil
15901 'mouse-face 'highlight
15902 'keymap org-agenda-keymap
15903 'help-echo
15904 (format "mouse-2 or RET jump to org file %s"
15905 (abbreviate-file-name buffer-file-name))))
15906 (regexp "^&?%%(")
15907 marker category ee txt tags entry result beg b sexp sexp-entry)
15908 (goto-char (point-min))
15909 (while (re-search-forward regexp nil t)
15910 (catch :skip
15911 (org-agenda-skip)
15912 (setq beg (match-beginning 0))
15913 (goto-char (1- (match-end 0)))
15914 (setq b (point))
15915 (forward-sexp 1)
15916 (setq sexp (buffer-substring b (point)))
15917 (setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)")
15918 (org-trim (match-string 1))
15919 ""))
15920 (setq result (org-diary-sexp-entry sexp sexp-entry date))
15921 (when result
15922 (setq marker (org-agenda-new-marker beg)
15923 category (org-get-category beg))
15924
15925 (if (string-match "\\S-" result)
15926 (setq txt result)
15927 (setq txt "SEXP entry returned empty string"))
15928
15929 (setq txt (org-format-agenda-item
15930 "" txt category tags 'time))
15931 (org-add-props txt props 'org-marker marker)
15932 (org-add-props txt nil
15933 'org-category category 'date date
15934 'type "sexp")
15935 (push txt ee))))
15936 (nreverse ee)))
15937
14573(defun org-agenda-get-closed () 15938(defun org-agenda-get-closed ()
14574 "Return the logged TODO entries for agenda display." 15939 "Return the logged TODO entries for agenda display."
14575 (let* ((props (list 'mouse-face 'highlight 15940 (let* ((props (list 'mouse-face 'highlight
14576 'org-not-done-regexp org-not-done-regexp 15941 'org-not-done-regexp org-not-done-regexp
15942 'org-todo-regexp org-todo-regexp
14577 'keymap org-agenda-keymap 15943 'keymap org-agenda-keymap
14578 'help-echo 15944 'help-echo
14579 (format "mouse-2 or RET jump to org file %s" 15945 (format "mouse-2 or RET jump to org file %s"
@@ -14617,6 +15983,7 @@ the documentation of `org-diary'."
14617 (org-add-props txt props 15983 (org-add-props txt props
14618 'org-marker marker 'org-hd-marker hdmarker 'face 'org-done 15984 'org-marker marker 'org-hd-marker hdmarker 'face 'org-done
14619 'priority priority 'org-category category 15985 'priority priority 'org-category category
15986 'type "closed" 'date date
14620 'undone-face 'org-warning 'done-face 'org-done) 15987 'undone-face 'org-warning 'done-face 'org-done)
14621 (push txt ee)) 15988 (push txt ee))
14622 (outline-next-heading))) 15989 (outline-next-heading)))
@@ -14627,6 +15994,7 @@ the documentation of `org-diary'."
14627 (let* ((wdays org-deadline-warning-days) 15994 (let* ((wdays org-deadline-warning-days)
14628 (props (list 'mouse-face 'highlight 15995 (props (list 'mouse-face 'highlight
14629 'org-not-done-regexp org-not-done-regexp 15996 'org-not-done-regexp org-not-done-regexp
15997 'org-todo-regexp org-todo-regexp
14630 'keymap org-agenda-keymap 15998 'keymap org-agenda-keymap
14631 'help-echo 15999 'help-echo
14632 (format "mouse-2 or RET jump to org file %s" 16000 (format "mouse-2 or RET jump to org file %s"
@@ -14641,8 +16009,9 @@ the documentation of `org-diary'."
14641 (catch :skip 16009 (catch :skip
14642 (org-agenda-skip) 16010 (org-agenda-skip)
14643 (setq pos (1- (match-beginning 1)) 16011 (setq pos (1- (match-beginning 1))
14644 d2 (time-to-days 16012;??? d2 (time-to-days
14645 (org-time-string-to-time (match-string 1))) 16013;??? (org-time-string-to-time (match-string 1)))
16014 d2 (org-time-string-to-absolute (match-string 1) d1)
14646 diff (- d2 d1)) 16015 diff (- d2 d1))
14647 ;; When to show a deadline in the calendar: 16016 ;; When to show a deadline in the calendar:
14648 ;; If the expiration is within wdays warning time. 16017 ;; If the expiration is within wdays warning time.
@@ -14673,6 +16042,7 @@ the documentation of `org-diary'."
14673 'org-hd-marker (org-agenda-new-marker pos1) 16042 'org-hd-marker (org-agenda-new-marker pos1)
14674 'priority (+ (- 10 diff) (org-get-priority txt)) 16043 'priority (+ (- 10 diff) (org-get-priority txt))
14675 'org-category category 16044 'org-category category
16045 'type "upcoming-deadline" 'date d2
14676 'face face 'undone-face face 'done-face 'org-done) 16046 'face face 'undone-face face 'done-face 'org-done)
14677 (push txt ee)))))) 16047 (push txt ee))))))
14678 ee)) 16048 ee))
@@ -14681,6 +16051,7 @@ the documentation of `org-diary'."
14681 "Return the scheduled information for agenda display." 16051 "Return the scheduled information for agenda display."
14682 (let* ((props (list 'face 'org-scheduled-previously 16052 (let* ((props (list 'face 'org-scheduled-previously
14683 'org-not-done-regexp org-not-done-regexp 16053 'org-not-done-regexp org-not-done-regexp
16054 'org-todo-regexp org-todo-regexp
14684 'undone-face 'org-scheduled-previously 16055 'undone-face 'org-scheduled-previously
14685 'done-face 'org-done 16056 'done-face 'org-done
14686 'mouse-face 'highlight 16057 'mouse-face 'highlight
@@ -14698,8 +16069,9 @@ the documentation of `org-diary'."
14698 (catch :skip 16069 (catch :skip
14699 (org-agenda-skip) 16070 (org-agenda-skip)
14700 (setq pos (1- (match-beginning 1)) 16071 (setq pos (1- (match-beginning 1))
14701 d2 (time-to-days 16072 d2 (org-time-string-to-absolute (match-string 1) d1)
14702 (org-time-string-to-time (match-string 1))) 16073;??? d2 (time-to-days
16074;??? (org-time-string-to-time (match-string 1)))
14703 diff (- d2 d1)) 16075 diff (- d2 d1))
14704 ;; When to show a scheduled item in the calendar: 16076 ;; When to show a scheduled item in the calendar:
14705 ;; If it is on or past the date. 16077 ;; If it is on or past the date.
@@ -14724,6 +16096,7 @@ the documentation of `org-diary'."
14724 (org-add-props txt props 16096 (org-add-props txt props
14725 'org-marker (org-agenda-new-marker pos) 16097 'org-marker (org-agenda-new-marker pos)
14726 'org-hd-marker (org-agenda-new-marker pos1) 16098 'org-hd-marker (org-agenda-new-marker pos1)
16099 'type "past-scheduled" 'date d2
14727 'priority (+ (- 5 diff) (org-get-priority txt)) 16100 'priority (+ (- 5 diff) (org-get-priority txt))
14728 'org-category category) 16101 'org-category category)
14729 (push txt ee)))))) 16102 (push txt ee))))))
@@ -14733,6 +16106,7 @@ the documentation of `org-diary'."
14733 "Return the date-range information for agenda display." 16106 "Return the date-range information for agenda display."
14734 (let* ((props (list 'face nil 16107 (let* ((props (list 'face nil
14735 'org-not-done-regexp org-not-done-regexp 16108 'org-not-done-regexp org-not-done-regexp
16109 'org-todo-regexp org-todo-regexp
14736 'mouse-face 'highlight 16110 'mouse-face 'highlight
14737 'keymap org-agenda-keymap 16111 'keymap org-agenda-keymap
14738 'help-echo 16112 'help-echo
@@ -14771,6 +16145,7 @@ the documentation of `org-diary'."
14771 (setq txt org-agenda-no-heading-message)) 16145 (setq txt org-agenda-no-heading-message))
14772 (org-add-props txt props 16146 (org-add-props txt props
14773 'org-marker marker 'org-hd-marker hdmarker 16147 'org-marker marker 'org-hd-marker hdmarker
16148 'type "block" 'date date
14774 'priority (org-get-priority txt) 'org-category category) 16149 'priority (org-get-priority txt) 'org-category category)
14775 (push txt ee))) 16150 (push txt ee)))
14776 (goto-char pos))) 16151 (goto-char pos)))
@@ -14865,8 +16240,8 @@ only the correctly processes TXT should be returned - this is used by
14865 16240
14866 (when (string-match "\\([ \t]+\\)\\(:[a-zA-Z_@0-9:]+:\\)[ \t]*$" txt) 16241 (when (string-match "\\([ \t]+\\)\\(:[a-zA-Z_@0-9:]+:\\)[ \t]*$" txt)
14867 ;; Tags are in the string 16242 ;; Tags are in the string
14868 (if (or (eq org-agenda-remove-tags-when-in-prefix t) 16243 (if (or (eq org-agenda-remove-tags t)
14869 (and org-agenda-remove-tags-when-in-prefix 16244 (and org-agenda-remove-tags
14870 org-prefix-has-tag)) 16245 org-prefix-has-tag))
14871 (setq txt (replace-match "" t t txt)) 16246 (setq txt (replace-match "" t t txt))
14872 (setq txt (replace-match 16247 (setq txt (replace-match
@@ -14891,9 +16266,12 @@ only the correctly processes TXT should be returned - this is used by
14891 'org-category (downcase category) 'tags tags 16266 'org-category (downcase category) 'tags tags
14892 'prefix-length (- (length rtn) (length txt)) 16267 'prefix-length (- (length rtn) (length txt))
14893 'time-of-day time-of-day 16268 'time-of-day time-of-day
16269 'txt txt
16270 'time time
16271 'extra extra
14894 'dotime dotime)))) 16272 'dotime dotime))))
14895 16273
14896(defvar org-agenda-sorting-strategy) 16274(defvar org-agenda-sorting-strategy) ;; FIXME: can be removed?
14897(defvar org-agenda-sorting-strategy-selected nil) 16275(defvar org-agenda-sorting-strategy-selected nil)
14898 16276
14899(defun org-agenda-add-time-grid-maybe (list ndays todayp) 16277(defun org-agenda-add-time-grid-maybe (list ndays todayp)
@@ -15243,6 +16621,7 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
15243 "Detach overlay INDEX." 16621 "Detach overlay INDEX."
15244 (funcall (if (featurep 'xemacs) 'detach-extent 'delete-overlay) org-hl)) 16622 (funcall (if (featurep 'xemacs) 'detach-extent 'delete-overlay) org-hl))
15245 16623
16624;; FIXME this is currently not used.
15246(defun org-highlight-until-next-command (beg end &optional buffer) 16625(defun org-highlight-until-next-command (beg end &optional buffer)
15247 (org-highlight beg end buffer) 16626 (org-highlight beg end buffer)
15248 (add-hook 'pre-command-hook 'org-unhighlight-once)) 16627 (add-hook 'pre-command-hook 'org-unhighlight-once))
@@ -15350,12 +16729,13 @@ and by additional input from the age of a schedules or deadline entry."
15350 (org-agenda-error))) 16729 (org-agenda-error)))
15351 (buffer (marker-buffer marker)) 16730 (buffer (marker-buffer marker))
15352 (pos (marker-position marker)) 16731 (pos (marker-position marker))
16732 (type (get-text-property (point) 'type))
15353 dbeg dend (n 0) conf) 16733 dbeg dend (n 0) conf)
15354 (org-with-remote-undo buffer 16734 (org-with-remote-undo buffer
15355 (with-current-buffer buffer 16735 (with-current-buffer buffer
15356 (save-excursion 16736 (save-excursion
15357 (goto-char pos) 16737 (goto-char pos)
15358 (if (org-mode-p) 16738 (if (and (org-mode-p) (not (member type '("sexp"))))
15359 (setq dbeg (progn (org-back-to-heading t) (point)) 16739 (setq dbeg (progn (org-back-to-heading t) (point))
15360 dend (org-end-of-subtree t)) 16740 dend (org-end-of-subtree t))
15361 (setq dbeg (point-at-bol) 16741 (setq dbeg (point-at-bol)
@@ -15502,6 +16882,16 @@ dedicated frame)."
15502 "Marker pointing to the headline that last changed its TODO state 16882 "Marker pointing to the headline that last changed its TODO state
15503by a remote command from the agenda.") 16883by a remote command from the agenda.")
15504 16884
16885(defun org-agenda-todo-nextset ()
16886 "Switch TODO entry to next sequence."
16887 (interactive)
16888 (org-agenda-todo 'nextset))
16889
16890(defun org-agenda-todo-previousset ()
16891 "Switch TODO entry to previous sequence."
16892 (interactive)
16893 (org-agenda-todo 'previousset))
16894
15505(defun org-agenda-todo (&optional arg) 16895(defun org-agenda-todo (&optional arg)
15506 "Cycle TODO state of line at point, also in Org-mode file. 16896 "Cycle TODO state of line at point, also in Org-mode file.
15507This changes the line at point, all other lines in the agenda referring to 16897This changes the line at point, all other lines in the agenda referring to
@@ -15656,7 +17046,7 @@ the tags of the current headline come last."
15656 (org-up-heading-all 1)) 17046 (org-up-heading-all 1))
15657 (error nil)))) 17047 (error nil))))
15658 tags))) 17048 tags)))
15659 17049
15660;; FIXME: should fix the tags property of the agenda line. 17050;; FIXME: should fix the tags property of the agenda line.
15661(defun org-agenda-set-tags () 17051(defun org-agenda-set-tags ()
15662 "Set tags for the current headline." 17052 "Set tags for the current headline."
@@ -15673,10 +17063,12 @@ the tags of the current headline come last."
15673 (with-current-buffer buffer 17063 (with-current-buffer buffer
15674 (widen) 17064 (widen)
15675 (goto-char pos) 17065 (goto-char pos)
15676 (org-show-context 'agenda) 17066 (save-excursion
17067 (org-show-context 'agenda))
15677 (save-excursion 17068 (save-excursion
15678 (and (outline-next-heading) 17069 (and (outline-next-heading)
15679 (org-flag-heading nil))) ; show the next heading 17070 (org-flag-heading nil))) ; show the next heading
17071 (goto-char pos)
15680 (call-interactively 'org-set-tags) 17072 (call-interactively 'org-set-tags)
15681 (end-of-line 1) 17073 (end-of-line 1)
15682 (setq newhead (org-get-heading))) 17074 (setq newhead (org-get-heading)))
@@ -15992,11 +17384,11 @@ This is a command that has to be installed in `calendar-mode-map'."
15992(defvar org-cdlatex-mode-map (make-sparse-keymap) 17384(defvar org-cdlatex-mode-map (make-sparse-keymap)
15993 "Keymap for the minor `org-cdlatex-mode'.") 17385 "Keymap for the minor `org-cdlatex-mode'.")
15994 17386
15995(define-key org-cdlatex-mode-map "_" 'org-cdlatex-underscore-caret) 17387(org-defkey org-cdlatex-mode-map "_" 'org-cdlatex-underscore-caret)
15996(define-key org-cdlatex-mode-map "^" 'org-cdlatex-underscore-caret) 17388(org-defkey org-cdlatex-mode-map "^" 'org-cdlatex-underscore-caret)
15997(define-key org-cdlatex-mode-map "`" 'cdlatex-math-symbol) 17389(org-defkey org-cdlatex-mode-map "`" 'cdlatex-math-symbol)
15998(define-key org-cdlatex-mode-map "'" 'org-cdlatex-math-modify) 17390(org-defkey org-cdlatex-mode-map "'" 'org-cdlatex-math-modify)
15999(define-key org-cdlatex-mode-map "\C-c{" 'cdlatex-environment) 17391(org-defkey org-cdlatex-mode-map "\C-c{" 'cdlatex-environment)
16000 17392
16001(defvar org-cdlatex-texmathp-advice-is-done nil 17393(defvar org-cdlatex-texmathp-advice-is-done nil
16002 "Flag remembering if we have applied the advice to texmathp already.") 17394 "Flag remembering if we have applied the advice to texmathp already.")
@@ -16064,7 +17456,7 @@ looks only before point, not after."
16064 (while (string-match re str start) 17456 (while (string-match re str start)
16065 (cond 17457 (cond
16066 ((= (match-end 0) (length str)) 17458 ((= (match-end 0) (length str))
16067 (throw 'exit (cons "$" (+ lim (match-beginning 0))))) 17459 (throw 'exit (cons "$" (+ lim (match-beginning 0) 1))))
16068 ((= (match-end 0) (- (length str) 5)) 17460 ((= (match-end 0) (- (length str) 5))
16069 (throw 'exit nil)) 17461 (throw 'exit nil))
16070 (t (setq start (match-end 0)))))) 17462 (t (setq start (match-end 0))))))
@@ -16156,11 +17548,12 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
16156 "Creating images for entry...%s")))) 17548 "Creating images for entry...%s"))))
16157 (message msg "") 17549 (message msg "")
16158 (narrow-to-region beg end) 17550 (narrow-to-region beg end)
17551 (goto-char beg)
16159 (org-format-latex 17552 (org-format-latex
16160 (concat "ltxpng/" (file-name-sans-extension 17553 (concat "ltxpng/" (file-name-sans-extension
16161 (file-name-nondirectory 17554 (file-name-nondirectory
16162 buffer-file-name))) 17555 buffer-file-name)))
16163 default-directory 'overlays msg at) 17556 default-directory 'overlays msg at 'forbuffer)
16164 (message msg "done. Use `C-c C-c' to remove images."))))) 17557 (message msg "done. Use `C-c C-c' to remove images.")))))
16165 17558
16166(defvar org-latex-regexps 17559(defvar org-latex-regexps
@@ -16173,7 +17566,7 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
16173 ("$$" "\\$\\$[^\000]*?\\$\\$" 0 t)) 17566 ("$$" "\\$\\$[^\000]*?\\$\\$" 0 t))
16174 "Regular expressions for matching embedded LaTeX.") 17567 "Regular expressions for matching embedded LaTeX.")
16175 17568
16176(defun org-format-latex (prefix &optional dir overlays msg at) 17569(defun org-format-latex (prefix &optional dir overlays msg at forbuffer)
16177 "Replace LaTeX fragments with links to an image, and produce images." 17570 "Replace LaTeX fragments with links to an image, and produce images."
16178 (if (and overlays (fboundp 'clear-image-cache)) (clear-image-cache)) 17571 (if (and overlays (fboundp 'clear-image-cache)) (clear-image-cache))
16179 (let* ((prefixnodir (file-name-nondirectory prefix)) 17572 (let* ((prefixnodir (file-name-nondirectory prefix))
@@ -16210,7 +17603,7 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
16210 (setq checkdir t) 17603 (setq checkdir t)
16211 (or (file-directory-p todir) (make-directory todir))) 17604 (or (file-directory-p todir) (make-directory todir)))
16212 (org-create-formula-image 17605 (org-create-formula-image
16213 txt movefile opt) 17606 txt movefile opt forbuffer)
16214 (if overlays 17607 (if overlays
16215 (progn 17608 (progn
16216 (setq ov (org-make-overlay beg end)) 17609 (setq ov (org-make-overlay beg end))
@@ -16229,31 +17622,27 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
16229 (insert link)))))))) 17622 (insert link))))))))
16230 17623
16231;; This function borrows from Ganesh Swami's latex2png.el 17624;; This function borrows from Ganesh Swami's latex2png.el
16232(defun org-create-formula-image (string tofile options) 17625(defun org-create-formula-image (string tofile options buffer)
16233 (let* ((tmpdir (if (featurep 'xemacs) 17626 (let* ((tmpdir (if (featurep 'xemacs)
16234 (temp-directory) 17627 (temp-directory)
16235 temporary-file-directory)) 17628 temporary-file-directory))
16236 (texfilebase (make-temp-name 17629 (texfilebase (make-temp-name
16237 (expand-file-name "orgtex" tmpdir))) 17630 (expand-file-name "orgtex" tmpdir)))
16238
16239;(texfilebase (make-temp-file "orgtex"))
16240; (dummy (delete-file texfilebase))
16241 (texfile (concat texfilebase ".tex")) 17631 (texfile (concat texfilebase ".tex"))
16242 (dvifile (concat texfilebase ".dvi")) 17632 (dvifile (concat texfilebase ".dvi"))
16243 (pngfile (concat texfilebase ".png")) 17633 (pngfile (concat texfilebase ".png"))
16244 (scale (number-to-string (* 1000 (or (plist-get options :scale) 1.0)))) 17634 (fnh (face-attribute 'default :height nil))
16245 (fg (or (plist-get options :foreground) "Black")) 17635 (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0))
16246 (bg (or (plist-get options :background) "Transparent"))) 17636 (dpi (number-to-string (* scale (floor (* 0.9 (if buffer fnh 140.))))))
17637 (fg (or (plist-get options (if buffer :foreground :html-foreground))
17638 "Black"))
17639 (bg (or (plist-get options (if buffer :background :html-background))
17640 "Transparent")))
17641 (if (eq fg 'default) (setq fg (org-dvipng-color :foreground)))
17642 (if (eq bg 'default) (setq bg (org-dvipng-color :background)))
16247 (with-temp-file texfile 17643 (with-temp-file texfile
16248 (insert "\\documentclass{article} 17644 (insert org-format-latex-header
16249\\usepackage{fullpage} 17645 "\n\\begin{document}\n" string "\n\\end{document}\n"))
16250\\usepackage{amssymb}
16251\\usepackage[usenames]{color}
16252\\usepackage{amsmath}
16253\\usepackage{latexsym}
16254\\usepackage[mathscr]{eucal}
16255\\pagestyle{empty}
16256\\begin{document}\n" string "\n\\end{document}\n"))
16257 (let ((dir default-directory)) 17646 (let ((dir default-directory))
16258 (condition-case nil 17647 (condition-case nil
16259 (progn 17648 (progn
@@ -16265,7 +17654,9 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
16265 (progn (message "Failed to create dvi file from %s" texfile) nil) 17654 (progn (message "Failed to create dvi file from %s" texfile) nil)
16266 (call-process "dvipng" nil nil nil 17655 (call-process "dvipng" nil nil nil
16267 "-E" "-fg" fg "-bg" bg 17656 "-E" "-fg" fg "-bg" bg
16268 "-x" scale "-y" scale "-T" "tight" 17657 "-D" dpi
17658 ;;"-x" scale "-y" scale
17659 "-T" "tight"
16269 "-o" pngfile 17660 "-o" pngfile
16270 dvifile) 17661 dvifile)
16271 (if (not (file-exists-p pngfile)) 17662 (if (not (file-exists-p pngfile))
@@ -16276,6 +17667,16 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
16276 (delete-file (concat texfilebase e))) 17667 (delete-file (concat texfilebase e)))
16277 pngfile)))) 17668 pngfile))))
16278 17669
17670(defun org-dvipng-color (attr)
17671 "Return an rgb color specification for dvipng."
17672 (apply 'format "rgb %s %s %s"
17673 (mapcar 'org-normalize-color
17674 (color-values (face-attribute 'default attr nil)))))
17675
17676(defun org-normalize-color (value)
17677 "Return string to be used as color value for an RGB component."
17678 (format "%g" (/ value 65535.0)))
17679
16279;;;; Exporting 17680;;;; Exporting
16280 17681
16281;;; Variables, constants, and parameter plists 17682;;; Variables, constants, and parameter plists
@@ -16300,16 +17701,19 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
16300 (:headline-levels . org-export-headline-levels) 17701 (:headline-levels . org-export-headline-levels)
16301 (:section-numbers . org-export-with-section-numbers) 17702 (:section-numbers . org-export-with-section-numbers)
16302 (:table-of-contents . org-export-with-toc) 17703 (:table-of-contents . org-export-with-toc)
17704 (:preserve-breaks . org-export-preserve-breaks)
16303 (:archived-trees . org-export-with-archived-trees) 17705 (:archived-trees . org-export-with-archived-trees)
16304 (:emphasize . org-export-with-emphasize) 17706 (:emphasize . org-export-with-emphasize)
16305 (:sub-superscript . org-export-with-sub-superscripts) 17707 (:sub-superscript . org-export-with-sub-superscripts)
16306 (:TeX-macros . org-export-with-TeX-macros) 17708 (:TeX-macros . org-export-with-TeX-macros)
16307 (:LaTeX-fragments . org-export-with-LaTeX-fragments) 17709 (:LaTeX-fragments . org-export-with-LaTeX-fragments)
17710 (:skip-before-1st-heading . org-export-skip-text-before-1st-heading)
16308 (:fixed-width . org-export-with-fixed-width) 17711 (:fixed-width . org-export-with-fixed-width)
16309 (:timestamps . org-export-with-timestamps) 17712 (:timestamps . org-export-with-timestamps)
16310 (:tables . org-export-with-tables) 17713 (:tables . org-export-with-tables)
16311 (:table-auto-headline . org-export-highlight-first-table-line) 17714 (:table-auto-headline . org-export-highlight-first-table-line)
16312 (:style . org-export-html-style) 17715 (:style . org-export-html-style)
17716 (:agenda-style . org-agenda-export-html-style) ;; FIXME: Does this work????
16313 (:convert-org-links . org-export-html-link-org-files-as-html) 17717 (:convert-org-links . org-export-html-link-org-files-as-html)
16314 (:inline-images . org-export-html-inline-images) 17718 (:inline-images . org-export-html-inline-images)
16315 (:expand-quoted-html . org-export-html-expand) 17719 (:expand-quoted-html . org-export-html-expand)
@@ -16359,7 +17763,8 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
16359 ("^" . :sub-superscript) 17763 ("^" . :sub-superscript)
16360 ("*" . :emphasize) 17764 ("*" . :emphasize)
16361 ("TeX" . :TeX-macros) 17765 ("TeX" . :TeX-macros)
16362 ("LaTeX" . :LaTeX-fragments))) 17766 ("LaTeX" . :LaTeX-fragments)
17767 ("skip" . :skip-before-1st-heading)))
16363 o) 17768 o)
16364 (while (setq o (pop op)) 17769 (while (setq o (pop op))
16365 (if (string-match (concat (regexp-quote (car o)) 17770 (if (string-match (concat (regexp-quote (car o))
@@ -16377,19 +17782,11 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
16377 val))) 17782 val)))
16378 dir)) 17783 dir))
16379 17784
16380(defun org-export-find-first-heading-line (list)
16381 "Remove all lines from LIST which are before the first headline."
16382 (let ((orig-list list)
16383 (re (concat "^" outline-regexp)))
16384 (while (and list
16385 (not (string-match re (car list))))
16386 (pop list))
16387 (or list orig-list)))
16388
16389(defun org-skip-comments (lines) 17785(defun org-skip-comments (lines)
16390 "Skip lines starting with \"#\" and subtrees starting with COMMENT." 17786 "Skip lines starting with \"#\" and subtrees starting with COMMENT."
16391 (let ((re1 (concat "^\\(\\*+\\)[ \t]+" org-comment-string)) 17787 (let ((re1 (concat "^\\(\\*+\\)[ \t]+" org-comment-string))
16392 (re2 "^\\(\\*+\\)[ \t\n\r]") 17788 (re2 "^\\(\\*+\\)[ \t\n\r]")
17789 (case-fold-search nil)
16393 rtn line level) 17790 rtn line level)
16394 (while (setq line (pop lines)) 17791 (while (setq line (pop lines))
16395 (cond 17792 (cond
@@ -16420,6 +17817,7 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
16420 17817
16421\[a] export as ASCII 17818\[a] export as ASCII
16422\[h] export as HTML 17819\[h] export as HTML
17820\[H] export as HTML to temporary buffer
16423\[b] export as HTML and browse immediately 17821\[b] export as HTML and browse immediately
16424\[x] export as XOXO 17822\[x] export as XOXO
16425 17823
@@ -16437,6 +17835,8 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
16437 (?a . org-export-as-ascii) 17835 (?a . org-export-as-ascii)
16438 (?h . org-export-as-html) 17836 (?h . org-export-as-html)
16439 (?b . org-export-as-html-and-open) 17837 (?b . org-export-as-html-and-open)
17838 (?H . org-export-as-html-to-buffer)
17839 (?R . org-export-region-as-html)
16440 (?x . org-export-as-xoxo) 17840 (?x . org-export-as-xoxo)
16441 (?i . org-export-icalendar-this-file) 17841 (?i . org-export-icalendar-this-file)
16442 (?I . org-export-icalendar-all-agenda-files) 17842 (?I . org-export-icalendar-all-agenda-files)
@@ -16465,6 +17865,7 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
16465 ("curren") 17865 ("curren")
16466 ("yen") 17866 ("yen")
16467 ("brvbar") 17867 ("brvbar")
17868 ("vert" . "&#124;")
16468 ("sect") 17869 ("sect")
16469 ("uml") 17870 ("uml")
16470 ("copy") 17871 ("copy")
@@ -16766,26 +18167,44 @@ translations. There is currently no way for users to extend this.")
16766 (re-angle-link (concat "\\([^[]\\)" org-angle-link-re)) 18167 (re-angle-link (concat "\\([^[]\\)" org-angle-link-re))
16767 (re-archive (concat ":" org-archive-tag ":")) 18168 (re-archive (concat ":" org-archive-tag ":"))
16768 (re-quote (concat "^\\*+[ \t]+" org-quote-string "\\>")) 18169 (re-quote (concat "^\\*+[ \t]+" org-quote-string "\\>"))
16769 (htmlp (memq :for-html parameters)) 18170 (htmlp (plist-get parameters :for-html))
16770 (outline-regexp "\\*+") 18171 (outline-regexp "\\*+")
16771 rtn) 18172 a b
18173 rtn p)
16772 (save-excursion 18174 (save-excursion
16773 (set-buffer (get-buffer-create " org-mode-tmp")) 18175 (set-buffer (get-buffer-create " org-mode-tmp"))
16774 (erase-buffer) 18176 (erase-buffer)
16775 (insert string) 18177 (insert string)
18178 ;; Remove license-to-kill stuff
18179 (while (setq p (text-property-any (point-min) (point-max)
18180 :org-license-to-kill t))
18181 (delete-region p (next-single-property-change p :org-license-to-kill)))
18182
16776 (let ((org-inhibit-startup t)) (org-mode)) 18183 (let ((org-inhibit-startup t)) (org-mode))
16777 (untabify (point-min) (point-max)) 18184 (untabify (point-min) (point-max))
16778 18185
18186 ;; Get the correct stuff before the first headline
18187 (when (plist-get parameters :skip-before-1st-heading)
18188 (goto-char (point-min))
18189 (when (re-search-forward "^\\*+[ \t]" nil t)
18190 (delete-region (point-min) (match-beginning 0))
18191 (goto-char (point-min))
18192 (insert "\n")))
18193 (when (plist-get parameters :add-text)
18194 (goto-char (point-min))
18195 (insert (plist-get parameters :add-text) "\n"))
18196
16779 ;; Get rid of archived trees 18197 ;; Get rid of archived trees
16780 (when (not (eq org-export-with-archived-trees t)) 18198 (when (not (eq org-export-with-archived-trees t))
16781 (goto-char (point-min)) 18199 (goto-char (point-min))
16782 (while (re-search-forward re-archive nil t) 18200 (while (re-search-forward re-archive nil t)
16783 (if (not (org-on-heading-p)) 18201 (if (not (org-on-heading-p t))
16784 (org-end-of-subtree t) 18202 (org-end-of-subtree t)
16785 (beginning-of-line 1) 18203 (beginning-of-line 1)
16786 (delete-region 18204 (setq a (if org-export-with-archived-trees
16787 (if org-export-with-archived-trees (1+ (point-at-eol)) (point)) 18205 (1+ (point-at-eol)) (point))
16788 (org-end-of-subtree t))))) 18206 b (org-end-of-subtree t))
18207 (if (> b a) (delete-region a b)))))
16789 18208
16790 ;; Protect stuff from HTML processing 18209 ;; Protect stuff from HTML processing
16791 (goto-char (point-min)) 18210 (goto-char (point-min))
@@ -16796,12 +18215,12 @@ translations. There is currently no way for users to extend this.")
16796 (goto-char (point-min)) 18215 (goto-char (point-min))
16797 (while (re-search-forward "^#\\+HTML:[ \t]*\\(.*\\)" nil t) 18216 (while (re-search-forward "^#\\+HTML:[ \t]*\\(.*\\)" nil t)
16798 (replace-match "\\1" t) 18217 (replace-match "\\1" t)
16799 (add-text-properties 18218 (add-text-properties
16800 (point-at-bol) (min (1+ (point-at-eol)) (point-max)) 18219 (point-at-bol) (min (1+ (point-at-eol)) (point-max))
16801 '(org-protected t)))) 18220 '(org-protected t))))
16802 (goto-char (point-min)) 18221 (goto-char (point-min))
16803 (while (re-search-forward 18222 (while (re-search-forward
16804 "^#\\+BEGIN_HTML\\>.*\\(\n.*\\)*?\n#\\+END_HTML\\>.*\n?" nil t) 18223 "^#\\+BEGIN_HTML\\>.*\\(\\(\n.*\\)*?\n\\)#\\+END_HTML\\>.*\n?" nil t)
16805 (if htmlp 18224 (if htmlp
16806 (add-text-properties (match-beginning 1) (1+ (match-end 1)) 18225 (add-text-properties (match-beginning 1) (1+ (match-end 1))
16807 '(org-protected t)) 18226 '(org-protected t))
@@ -16839,7 +18258,7 @@ translations. There is currently no way for users to extend this.")
16839 (goto-char (match-beginning 0)))) 18258 (goto-char (match-beginning 0))))
16840 18259
16841 ;; Convert LaTeX fragments to images 18260 ;; Convert LaTeX fragments to images
16842 (when (memq :LaTeX-fragments parameters) 18261 (when (plist-get parameters :LaTeX-fragments)
16843 (org-format-latex 18262 (org-format-latex
16844 (concat "ltxpng/" (file-name-sans-extension 18263 (concat "ltxpng/" (file-name-sans-extension
16845 (file-name-nondirectory 18264 (file-name-nondirectory
@@ -16851,6 +18270,7 @@ translations. There is currently no way for users to extend this.")
16851 ;; Expand link abbreviations 18270 ;; Expand link abbreviations
16852 (goto-char (point-min)) 18271 (goto-char (point-min))
16853 (while (re-search-forward re-plain-link nil t) 18272 (while (re-search-forward re-plain-link nil t)
18273 (goto-char (1- (match-end 0)))
16854 (org-if-unprotected 18274 (org-if-unprotected
16855 (replace-match 18275 (replace-match
16856 (concat 18276 (concat
@@ -16858,6 +18278,7 @@ translations. There is currently no way for users to extend this.")
16858 t t))) 18278 t t)))
16859 (goto-char (point-min)) 18279 (goto-char (point-min))
16860 (while (re-search-forward re-angle-link nil t) 18280 (while (re-search-forward re-angle-link nil t)
18281 (goto-char (1- (match-end 0)))
16861 (org-if-unprotected 18282 (org-if-unprotected
16862 (replace-match 18283 (replace-match
16863 (concat 18284 (concat
@@ -16877,17 +18298,35 @@ translations. There is currently no way for users to extend this.")
16877 t t))) 18298 t t)))
16878 18299
16879 ;; Find multiline emphasis and put them into single line 18300 ;; Find multiline emphasis and put them into single line
16880 (when (memq :emph-multiline parameters) 18301 (when (plist-get parameters :emph-multiline)
16881 (goto-char (point-min)) 18302 (goto-char (point-min))
16882 (while (re-search-forward org-emph-re nil t) 18303 (while (re-search-forward org-emph-re nil t)
16883 (org-if-unprotected 18304 (if (not (= (char-after (match-beginning 3))
16884 (subst-char-in-region (match-beginning 0) (match-end 0) ?\n ?\ t) 18305 (char-after (match-beginning 4))))
16885 (goto-char (1- (match-end 0)))))) 18306 (org-if-unprotected
18307 (subst-char-in-region (match-beginning 0) (match-end 0)
18308 ?\n ?\ t)
18309 (goto-char (1- (match-end 0))))
18310 (goto-char (1+ (match-beginning 0))))))
16886 18311
16887 (setq rtn (buffer-string))) 18312 (setq rtn (buffer-string)))
16888 (kill-buffer " org-mode-tmp") 18313 (kill-buffer " org-mode-tmp")
16889 rtn)) 18314 rtn))
16890 18315
18316(defun org-export-grab-title-from-buffer ()
18317 "Get a title for the current document, from looking at the buffer."
18318 (let (buffer-read-only)
18319 (save-excursion
18320 (goto-char (point-min))
18321 (let ((end (save-excursion (outline-next-heading) (point))))
18322 (when (re-search-forward "^[ \t]*[^# \t\r\n].*\n" end t)
18323 ;; Mark the line so that it will not be exported as normal text.
18324 (org-unmodified
18325 (add-text-properties (match-beginning 0) (match-end 0)
18326 (list :org-license-to-kill t)))
18327 ;; Return the title string
18328 (org-trim (match-string 0)))))))
18329
16891(defun org-solidify-link-text (s &optional alist) 18330(defun org-solidify-link-text (s &optional alist)
16892 "Take link text and make a safe target out of it." 18331 "Take link text and make a safe target out of it."
16893 (save-match-data 18332 (save-match-data
@@ -16959,16 +18398,7 @@ underlined headlines. The default is 3."
16959 (setq-default org-todo-line-regexp org-todo-line-regexp) 18398 (setq-default org-todo-line-regexp org-todo-line-regexp)
16960 (let* ((opt-plist (org-combine-plists (org-default-export-plist) 18399 (let* ((opt-plist (org-combine-plists (org-default-export-plist)
16961 (org-infile-export-plist))) 18400 (org-infile-export-plist)))
16962 (region
16963 (buffer-substring
16964 (if (org-region-active-p) (region-beginning) (point-min))
16965 (if (org-region-active-p) (region-end) (point-max))))
16966 (custom-times org-display-custom-times) 18401 (custom-times org-display-custom-times)
16967 (lines (org-export-find-first-heading-line
16968 (org-skip-comments
16969 (org-split-string
16970 (org-cleaned-string-for-export region)
16971 "[\r\n]"))))
16972 (org-ascii-current-indentation '(0 . 0)) 18402 (org-ascii-current-indentation '(0 . 0))
16973 (level 0) line txt 18403 (level 0) line txt
16974 (umax nil) 18404 (umax nil)
@@ -16986,15 +18416,36 @@ underlined headlines. The default is 3."
16986 (time (format-time-string "%X" (org-current-time))) 18416 (time (format-time-string "%X" (org-current-time)))
16987 (author (plist-get opt-plist :author)) 18417 (author (plist-get opt-plist :author))
16988 (title (or (plist-get opt-plist :title) 18418 (title (or (plist-get opt-plist :title)
18419 (and (not
18420 (plist-get opt-plist :skip-before-1st-heading))
18421 (org-export-grab-title-from-buffer))
16989 (file-name-sans-extension 18422 (file-name-sans-extension
16990 (file-name-nondirectory buffer-file-name)))) 18423 (file-name-nondirectory buffer-file-name))))
16991 (email (plist-get opt-plist :email)) 18424 (email (plist-get opt-plist :email))
16992 (language (plist-get opt-plist :language)) 18425 (language (plist-get opt-plist :language))
16993 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) 18426 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
16994; (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)")) 18427; (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)"))
16995 (text nil)
16996 (todo nil) 18428 (todo nil)
16997 (lang-words nil)) 18429 (lang-words nil)
18430 (region
18431 (buffer-substring
18432 (if (org-region-active-p) (region-beginning) (point-min))
18433 (if (org-region-active-p) (region-end) (point-max))))
18434 (lines (org-skip-comments
18435 (org-split-string
18436 (org-cleaned-string-for-export
18437 region
18438 :skip-before-1st-heading
18439 (plist-get opt-plist :skip-before-1st-heading)
18440 :add-text (plist-get opt-plist :text))
18441 "[\r\n]")))
18442 thetoc have-headings first-heading-pos
18443 table-open table-buffer)
18444
18445 (let (buffer-read-only)
18446 (org-unmodified
18447 (remove-text-properties (point-min) (point-max)
18448 '(:org-license-to-kill t))))
16998 18449
16999 (setq org-last-level 1) 18450 (setq org-last-level 1)
17000 (org-init-section-numbers) 18451 (org-init-section-numbers)
@@ -17028,27 +18479,27 @@ underlined headlines. The default is 3."
17028 "\n"))) 18479 "\n")))
17029 (if (and date time) 18480 (if (and date time)
17030 (insert (concat (nth 2 lang-words) ": " date " " time "\n"))) 18481 (insert (concat (nth 2 lang-words) ": " date " " time "\n")))
17031 (if text (insert (concat (org-html-expand-for-ascii text) "\n\n")))
17032 18482
17033 (insert "\n\n") 18483 (insert "\n\n")
17034 18484
17035 (if org-export-with-toc 18485 (if org-export-with-toc
17036 (progn 18486 (progn
17037 (insert (nth 3 lang-words) "\n" 18487 (push (concat (nth 3 lang-words) "\n") thetoc)
17038 (make-string (length (nth 3 lang-words)) ?=) "\n") 18488 (push (concat (make-string (length (nth 3 lang-words)) ?=) "\n") thetoc)
17039 (mapcar '(lambda (line) 18489 (mapcar '(lambda (line)
17040 (if (string-match org-todo-line-regexp 18490 (if (string-match org-todo-line-regexp
17041 line) 18491 line)
17042 ;; This is a headline 18492 ;; This is a headline
17043 (progn 18493 (progn
18494 (setq have-headings t)
17044 (setq level (- (match-end 1) (match-beginning 1)) 18495 (setq level (- (match-end 1) (match-beginning 1))
17045 level (org-tr-level level) 18496 level (org-tr-level level)
17046 txt (match-string 3 line) 18497 txt (match-string 3 line)
17047 todo 18498 todo
17048 (or (and org-export-mark-todo-in-toc 18499 (or (and org-export-mark-todo-in-toc
17049 (match-beginning 2) 18500 (match-beginning 2)
17050 (not (equal (match-string 2 line) 18501 (not (member (match-string 2 line)
17051 org-done-string))) 18502 org-done-keywords)))
17052 ; TODO, not DONE 18503 ; TODO, not DONE
17053 (and org-export-mark-todo-in-toc 18504 (and org-export-mark-todo-in-toc
17054 (= level umax-toc) 18505 (= level umax-toc)
@@ -17067,12 +18518,15 @@ underlined headlines. The default is 3."
17067 " " txt))) 18518 " " txt)))
17068 (if (<= level umax-toc) 18519 (if (<= level umax-toc)
17069 (progn 18520 (progn
17070 (insert 18521 (push
17071 (make-string (* (1- level) 4) ?\ ) 18522 (concat
17072 (format (if todo "%s (*)\n" "%s\n") txt)) 18523 (make-string (* (1- level) 4) ?\ )
18524 (format (if todo "%s (*)\n" "%s\n") txt))
18525 thetoc)
17073 (setq org-last-level level)) 18526 (setq org-last-level level))
17074 )))) 18527 ))))
17075 lines))) 18528 lines)
18529 (setq thetoc (if have-headings (nreverse thetoc) nil))))
17076 18530
17077 (org-init-section-numbers) 18531 (org-init-section-numbers)
17078 (while (setq line (pop lines)) 18532 (while (setq line (pop lines))
@@ -17091,12 +18545,44 @@ underlined headlines. The default is 3."
17091 (cond 18545 (cond
17092 ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) 18546 ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line)
17093 ;; a Headline 18547 ;; a Headline
18548 (setq first-heading-pos (or first-heading-pos (point)))
17094 (setq level (org-tr-level (- (match-end 1) (match-beginning 1))) 18549 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)))
17095 txt (match-string 2 line)) 18550 txt (match-string 2 line))
17096 (org-ascii-level-start level txt umax lines)) 18551 (org-ascii-level-start level txt umax lines))
18552
18553 ((and org-export-with-tables
18554 (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
18555 (if (not table-open)
18556 ;; New table starts
18557 (setq table-open t table-buffer nil))
18558 ;; Accumulate lines
18559 (setq table-buffer (cons line table-buffer))
18560 (when (or (not lines)
18561 (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
18562 (car lines))))
18563 (setq table-open nil
18564 table-buffer (nreverse table-buffer))
18565 (insert (mapconcat
18566 (lambda (x)
18567 (org-fix-indentation x org-ascii-current-indentation))
18568 (org-format-table-ascii table-buffer)
18569 "\n") "\n")))
17097 (t 18570 (t
17098 (insert (org-fix-indentation line org-ascii-current-indentation) "\n")))) 18571 (insert (org-fix-indentation line org-ascii-current-indentation) "\n"))))
17099 (normal-mode) 18572 (normal-mode)
18573
18574 ;; insert the table of contents
18575 (when thetoc
18576 (goto-char (point-min))
18577 (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t)
18578 (progn
18579 (goto-char (match-beginning 0))
18580 (replace-match ""))
18581 (goto-char first-heading-pos))
18582 (mapc 'insert thetoc)
18583 (or (looking-at "[ \t]*\n[ \t]*\n")
18584 (insert "\n\n")))
18585
17100 (save-buffer) 18586 (save-buffer)
17101 ;; remove display and invisible chars 18587 ;; remove display and invisible chars
17102 (let (beg end) 18588 (let (beg end)
@@ -17124,8 +18610,8 @@ underlined headlines. The default is 3."
17124 (progn 18610 (progn
17125 (setq lv (- (match-end 1) (match-beginning 1)) 18611 (setq lv (- (match-end 1) (match-beginning 1))
17126 todo (and (match-beginning 2) 18612 todo (and (match-beginning 2)
17127 (not (equal (match-string 2 line) 18613 (not (member (match-string 2 line)
17128 org-done-string)))) 18614 org-done-keywords))))
17129 ; TODO, not DONE 18615 ; TODO, not DONE
17130 (if (<= lv level) (throw 'exit nil)) 18616 (if (<= lv level) (throw 'exit nil))
17131 (if todo (throw 'exit t)))))))) 18617 (if todo (throw 'exit t))))))))
@@ -17187,7 +18673,7 @@ continue to use it. The prefix arg ARG is passed through to the exporting
17187command." 18673command."
17188 (interactive 18674 (interactive
17189 (list (progn 18675 (list (progn
17190 (message "Export visible: [a]SCII [h]tml [b]rowse HTML [x]OXO [ ]keep buffer") 18676 (message "Export visible: [a]SCII [h]tml [b]rowse HTML [H/R]uffer with HTML [x]OXO [ ]keep buffer")
17191 (read-char-exclusive)) 18677 (read-char-exclusive))
17192 current-prefix-arg)) 18678 current-prefix-arg))
17193 (if (not (member type '(?a ?\C-a ?b ?\C-b ?h ?x ?\ ))) 18679 (if (not (member type '(?a ?\C-a ?b ?\C-b ?h ?x ?\ )))
@@ -17198,6 +18684,8 @@ command."
17198 (?b . org-export-as-html-and-open) 18684 (?b . org-export-as-html-and-open)
17199 (?\C-b . org-export-as-html-and-open) 18685 (?\C-b . org-export-as-html-and-open)
17200 (?h . org-export-as-html) 18686 (?h . org-export-as-html)
18687 (?H . org-export-as-html-to-buffer)
18688 (?R . org-export-region-as-html)
17201 (?x . org-export-as-xoxo))))) 18689 (?x . org-export-as-xoxo)))))
17202 (keepp (equal type ?\ )) 18690 (keepp (equal type ?\ ))
17203 (file buffer-file-name) 18691 (file buffer-file-name)
@@ -17253,10 +18741,11 @@ Does include HTML export options as well as TODO and CATEGORY stuff."
17253#+EMAIL: %s 18741#+EMAIL: %s
17254#+LANGUAGE: %s 18742#+LANGUAGE: %s
17255#+TEXT: Some descriptive text to be emitted. Several lines OK. 18743#+TEXT: Some descriptive text to be emitted. Several lines OK.
17256#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s *:%s TeX:%s LaTeX:%s 18744#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s *:%s TeX:%s LaTeX:%s skip:%s
17257#+CATEGORY: %s 18745#+CATEGORY: %s
17258#+SEQ_TODO: %s 18746#+SEQ_TODO: %s
17259#+TYP_TODO: %s 18747#+TYP_TODO: %s
18748#+PRIORITIES: %c %c %c
17260#+STARTUP: %s %s %s %s %s 18749#+STARTUP: %s %s %s %s %s
17261#+TAGS: %s 18750#+TAGS: %s
17262#+ARCHIVE: %s 18751#+ARCHIVE: %s
@@ -17274,13 +18763,11 @@ Does include HTML export options as well as TODO and CATEGORY stuff."
17274 org-export-with-emphasize 18763 org-export-with-emphasize
17275 org-export-with-TeX-macros 18764 org-export-with-TeX-macros
17276 org-export-with-LaTeX-fragments 18765 org-export-with-LaTeX-fragments
18766 org-export-skip-text-before-1st-heading
17277 (file-name-nondirectory buffer-file-name) 18767 (file-name-nondirectory buffer-file-name)
17278 (if (equal org-todo-interpretation 'sequence) 18768 "TODO FEEDBACK VERIFY DONE"
17279 (mapconcat 'identity org-todo-keywords " ") 18769 "Me Jason Marie DONE"
17280 "TODO FEEDBACK VERIFY DONE") 18770 org-highest-priority org-lowest-priority org-default-priority
17281 (if (equal org-todo-interpretation 'type)
17282 (mapconcat 'identity org-todo-keywords " ")
17283 "Me Jason Marie DONE")
17284 (cdr (assoc org-startup-folded 18771 (cdr (assoc org-startup-folded
17285 '((nil . "showall") (t . "overview") (content . "content")))) 18772 '((nil . "showall") (t . "overview") (content . "content"))))
17286 (if org-odd-levels-only "odd" "oddeven") 18773 (if org-odd-levels-only "odd" "oddeven")
@@ -17372,19 +18859,96 @@ emacs --batch
17372 --visit=MyFile --funcall org-export-as-html-batch" 18859 --visit=MyFile --funcall org-export-as-html-batch"
17373 (org-export-as-html org-export-headline-levels 'hidden)) 18860 (org-export-as-html org-export-headline-levels 'hidden))
17374 18861
17375(defun org-export-as-html (arg &optional hidden ext-plist) 18862(defun org-export-as-html-to-buffer (arg)
18863 "Call `org-exort-as-html` with output to a temporary buffer.
18864No file is created. The prefix ARG is passed through to `org-export-as-html'."
18865 (interactive "P")
18866 (org-export-as-html arg nil nil "*Org HTML Export*")
18867 (switch-to-buffer-other-window "*Org HTML Export*"))
18868
18869(defun org-replace-region-by-html (beg end)
18870 "Assume the current region has org-mode syntax, and convert it to HTML.
18871This can be used in any buffer. For example, you could write an
18872itemized list in org-mode syntax in an HTML buffer and then use this
18873command to convert it."
18874 (interactive "r")
18875 (let (reg html buf)
18876 (if (org-mode-p)
18877 (setq html (org-export-region-as-html
18878 beg end t 'string))
18879 (setq reg (buffer-substring beg end)
18880 buf (get-buffer-create "*Org tmp*"))
18881 (save-excursion
18882 (set-buffer buf)
18883 (erase-buffer)
18884 (insert reg)
18885 (org-mode)
18886 (setq html (org-export-region-as-html
18887 (point-min) (point-max) t 'string)))
18888 (kill-buffer buf))
18889 (delete-region beg end)
18890 (insert html)))
18891
18892(defun org-export-region-as-html (beg end &optional body-only buffer)
18893 "Convert region from BEG to END in org-mode buffer to HTML.
18894If prefix arg BODY-ONLY is set, omit file header, footer, and table of
18895contents, and only produce the region of converted text, useful for
18896cut-and-paste operations.
18897If BUFFER is a buffer or a string, use/create that buffer as a target
18898of the converted HTML. If BUFFER is the symbol `string', return the
18899produced HTML as a string and leave not buffer behind. For example,
18900a Lisp program could call this function in the following way:
18901
18902 (setq html (org-export-region-as-html beg end t 'string))
18903
18904When called interactively, the output buffer is selected, and shown
18905in a window. A non-interactive call will only retunr the buffer."
18906 (interactive "r\nP")
18907 (when (interactive-p)
18908 (setq buffer "*Org HTML EXPORT*"))
18909 (let ((transient-mark-mode t) (zmacs-regions t)
18910 rtn)
18911 (goto-char end)
18912 (set-mark (point)) ;; to activate the region
18913 (goto-char beg)
18914 (setq rtn (org-export-as-html
18915 nil nil nil
18916 buffer body-only))
18917 (if (fboundp 'deactivate-mark) (deactivate-mark))
18918 (if (and (interactive-p) (bufferp rtn))
18919 (switch-to-buffer-other-window rtn)
18920 rtn)))
18921
18922(defun org-export-as-html (arg &optional hidden ext-plist
18923 to-buffer body-only)
17376 "Export the outline as a pretty HTML file. 18924 "Export the outline as a pretty HTML file.
17377If there is an active region, export only the region. 18925If there is an active region, export only the region. The prefix
17378The prefix ARG specifies how many levels of the outline should become 18926ARG specifies how many levels of the outline should become
17379headlines. The default is 3. Lower levels will become bulleted lists. 18927headlines. The default is 3. Lower levels will become bulleted
17380When HIDDEN is non-nil, don't display the HTML buffer. 18928lists. When HIDDEN is non-nil, don't display the HTML buffer.
17381EXT-PLIST is a property list with external parameters overriding 18929EXT-PLIST is a property list with external parameters overriding
17382org-mode's default settings, but still inferior to file-local settings." 18930org-mode's default settings, but still inferior to file-local
18931settings. When TO-BUFFER is non-nil, create a buffer with that
18932name and export to that buffer. If TO-BUFFER is the symbol `string',
18933don't leave any buffer behind but just return the resulting HTML as
18934a string. When BODY-ONLY is set, don't produce the file header and footer,
18935simply return the content of <body>...</body>, without even
18936the body tags themselves."
17383 (interactive "P") 18937 (interactive "P")
18938
18939 ;; Make sure we have a file name when we need it.
18940 (when (and (not (or to-buffer body-only))
18941 (not buffer-file-name))
18942 (if (buffer-base-buffer)
18943 (org-set-local 'buffer-file-name
18944 (with-current-buffer (buffer-base-buffer)
18945 buffer-file-name))
18946 (error "Need a file name to be able to export.")))
18947
17384 (message "Exporting...") 18948 (message "Exporting...")
17385 (setq-default org-todo-line-regexp org-todo-line-regexp) 18949 (setq-default org-todo-line-regexp org-todo-line-regexp)
17386 (setq-default org-deadline-line-regexp org-deadline-line-regexp) 18950 (setq-default org-deadline-line-regexp org-deadline-line-regexp)
17387 (setq-default org-done-string org-done-string) 18951 (setq-default org-done-keywords org-done-keywords)
17388 (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp) 18952 (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
17389 (let* ((opt-plist (org-combine-plists (org-default-export-plist) 18953 (let* ((opt-plist (org-combine-plists (org-default-export-plist)
17390 ext-plist 18954 ext-plist
@@ -17392,42 +18956,42 @@ org-mode's default settings, but still inferior to file-local settings."
17392 18956
17393 (style (plist-get opt-plist :style)) 18957 (style (plist-get opt-plist :style))
17394 (link-validate (plist-get opt-plist :link-validation-function)) 18958 (link-validate (plist-get opt-plist :link-validation-function))
17395 valid 18959 valid thetoc have-headings first-heading-pos
17396 (odd org-odd-levels-only) 18960 (odd org-odd-levels-only)
17397 (region-p (org-region-active-p)) 18961 (region-p (org-region-active-p))
17398 (region
17399 (buffer-substring
17400 (if region-p (region-beginning) (point-min))
17401 (if region-p (region-end) (point-max))))
17402 ;; The following two are dynamically scoped into other 18962 ;; The following two are dynamically scoped into other
17403 ;; routines below. 18963 ;; routines below.
17404 (org-current-export-dir (org-export-directory :html opt-plist)) 18964 (org-current-export-dir (org-export-directory :html opt-plist))
17405 (org-current-export-file buffer-file-name) 18965 (org-current-export-file buffer-file-name)
17406 (all_lines
17407 (org-skip-comments (org-split-string
17408 (org-cleaned-string-for-export
17409 region :emph-multiline :for-html
17410 (if (plist-get opt-plist :LaTeX-fragments)
17411 :LaTeX-fragments))
17412 "[\r\n]")))
17413 (lines (org-export-find-first-heading-line all_lines))
17414 (level 0) (line "") (origline "") txt todo 18966 (level 0) (line "") (origline "") txt todo
17415 (umax nil) 18967 (umax nil)
17416 (umax-toc nil) 18968 (umax-toc nil)
17417 (filename (concat (file-name-as-directory 18969 (filename (if to-buffer nil
17418 (org-export-directory :html opt-plist)) 18970 (concat (file-name-as-directory
17419 (file-name-sans-extension 18971 (org-export-directory :html opt-plist))
17420 (file-name-nondirectory buffer-file-name)) 18972 (file-name-sans-extension
17421 ".html")) 18973 (file-name-nondirectory buffer-file-name))
17422 (current-dir (file-name-directory buffer-file-name)) 18974 ".html")))
17423 (buffer (find-file-noselect filename)) 18975 (current-dir (if buffer-file-name
18976 (file-name-directory buffer-file-name)
18977 default-directory))
18978 (buffer (if to-buffer
18979 (cond
18980 ((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*"))
18981 (t (get-buffer-create to-buffer)))
18982 (find-file-noselect filename)))
17424 (org-levels-open (make-vector org-level-max nil)) 18983 (org-levels-open (make-vector org-level-max nil))
17425 (date (format-time-string "%Y/%m/%d" (current-time))) 18984 (date (format-time-string "%Y/%m/%d" (current-time)))
17426 (time (format-time-string "%X" (org-current-time))) 18985 (time (format-time-string "%X" (org-current-time)))
17427 (author (plist-get opt-plist :author)) 18986 (author (plist-get opt-plist :author))
17428 (title (or (plist-get opt-plist :title) 18987 (title (or (plist-get opt-plist :title)
17429 (file-name-sans-extension 18988 (and (not
17430 (file-name-nondirectory buffer-file-name)))) 18989 (plist-get opt-plist :skip-before-1st-heading))
18990 (org-export-grab-title-from-buffer))
18991 (and buffer-file-name
18992 (file-name-sans-extension
18993 (file-name-nondirectory buffer-file-name)))
18994 "UNTITLED"))
17431 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) 18995 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
17432 (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)")) 18996 (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)"))
17433 (inquote nil) 18997 (inquote nil)
@@ -17438,7 +19002,6 @@ org-mode's default settings, but still inferior to file-local settings."
17438 (llt org-plain-list-ordered-item-terminator) 19002 (llt org-plain-list-ordered-item-terminator)
17439 (email (plist-get opt-plist :email)) 19003 (email (plist-get opt-plist :email))
17440 (language (plist-get opt-plist :language)) 19004 (language (plist-get opt-plist :language))
17441 (text (plist-get opt-plist :text))
17442 (lang-words nil) 19005 (lang-words nil)
17443 (target-alist nil) tg 19006 (target-alist nil) tg
17444 (head-count 0) cnt 19007 (head-count 0) cnt
@@ -17450,11 +19013,34 @@ org-mode's default settings, but still inferior to file-local settings."
17450 (charset (and coding-system 19013 (charset (and coding-system
17451 (fboundp 'coding-system-get) 19014 (fboundp 'coding-system-get)
17452 (coding-system-get coding-system 'mime-charset))) 19015 (coding-system-get coding-system 'mime-charset)))
19016 (region
19017 (buffer-substring
19018 (if region-p (region-beginning) (point-min))
19019 (if region-p (region-end) (point-max))))
19020 (lines
19021 (org-skip-comments (org-split-string
19022 (org-cleaned-string-for-export
19023 region
19024 :emph-multiline t
19025 :for-html t
19026 :skip-before-1st-heading
19027 (plist-get opt-plist :skip-before-1st-heading)
19028 :add-text
19029 (plist-get opt-plist :text)
19030 :LaTeX-fragments
19031 (plist-get opt-plist :LaTeX-fragments))
19032 "[\r\n]")))
17453 table-open type 19033 table-open type
17454 table-buffer table-orig-buffer 19034 table-buffer table-orig-buffer
17455 ind start-is-num starter 19035 ind start-is-num starter didclose
17456 rpl path desc descp desc1 desc2 link 19036 rpl path desc descp desc1 desc2 link
17457 ) 19037 )
19038
19039 (let (buffer-read-only)
19040 (org-unmodified
19041 (remove-text-properties (point-min) (point-max)
19042 '(:org-license-to-kill t))))
19043
17458 (message "Exporting...") 19044 (message "Exporting...")
17459 19045
17460 (setq org-last-level 1) 19046 (setq org-last-level 1)
@@ -17465,9 +19051,7 @@ org-mode's default settings, but still inferior to file-local settings."
17465 (assoc "en" org-export-language-setup))) 19051 (assoc "en" org-export-language-setup)))
17466 19052
17467 ;; Switch to the output buffer 19053 ;; Switch to the output buffer
17468 (if (or hidden t) 19054 (set-buffer buffer)
17469 (set-buffer buffer)
17470 (switch-to-buffer-other-window buffer))
17471 (erase-buffer) 19055 (erase-buffer)
17472 (fundamental-mode) 19056 (fundamental-mode)
17473 (let ((case-fold-search nil) 19057 (let ((case-fold-search nil)
@@ -17483,10 +19067,10 @@ org-mode's default settings, but still inferior to file-local settings."
17483 (setq umax-toc (if (integerp org-export-with-toc) 19067 (setq umax-toc (if (integerp org-export-with-toc)
17484 (min org-export-with-toc umax) 19068 (min org-export-with-toc umax)
17485 umax)) 19069 umax))
17486 19070 (unless body-only
17487 ;; File header 19071 ;; File header
17488 (insert (format 19072 (insert (format
17489 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" 19073 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
17490 \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\"> 19074 \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
17491<html xmlns=\"http://www.w3.org/1999/xhtml\" 19075<html xmlns=\"http://www.w3.org/1999/xhtml\"
17492lang=\"%s\" xml:lang=\"%s\"> 19076lang=\"%s\" xml:lang=\"%s\">
@@ -17499,94 +19083,96 @@ lang=\"%s\" xml:lang=\"%s\">
17499%s 19083%s
17500</head><body> 19084</head><body>
17501" 19085"
17502 language language (org-html-expand title) (or charset "iso-8859-1") 19086 language language (org-html-expand title)
17503 date time author style)) 19087 (or charset "iso-8859-1") date time author style))
17504 19088
19089 (insert (or (plist-get opt-plist :preamble) ""))
17505 19090
17506 (insert (or (plist-get opt-plist :preamble) "")) 19091 (when (plist-get opt-plist :auto-preamble)
19092 (if title (insert (format org-export-html-title-format
19093 (org-html-expand title))))))
17507 19094
17508 (when (plist-get opt-plist :auto-preamble) 19095 (if (and org-export-with-toc (not body-only))
17509 (if title (insert (format org-export-html-title-format
17510 (org-html-expand title))))
17511 (if text (insert "<p>\n" (org-html-expand text) "</p>")))
17512
17513 (if org-export-with-toc
17514 (progn 19096 (progn
17515 (insert (format "<h%d>%s</h%d>\n" 19097 (push (format "<h%d>%s</h%d>\n"
17516 org-export-html-toplevel-hlevel 19098 org-export-html-toplevel-hlevel
17517 (nth 3 lang-words) 19099 (nth 3 lang-words)
17518 org-export-html-toplevel-hlevel)) 19100 org-export-html-toplevel-hlevel)
17519 (insert "<ul>\n<li>") 19101 thetoc)
19102 (push "<ul>\n<li>" thetoc)
17520 (setq lines 19103 (setq lines
17521 (mapcar '(lambda (line) 19104 (mapcar '(lambda (line)
17522 (if (string-match org-todo-line-regexp line) 19105 (if (string-match org-todo-line-regexp line)
17523 ;; This is a headline 19106 ;; This is a headline
17524 (progn 19107 (progn
17525 (setq level (- (match-end 1) (match-beginning 1)) 19108 (setq have-headings t)
17526 level (org-tr-level level) 19109 (setq level (- (match-end 1) (match-beginning 1))
17527 txt (save-match-data 19110 level (org-tr-level level)
17528 (org-html-expand 19111 txt (save-match-data
17529 (org-export-cleanup-toc-line 19112 (org-html-expand
17530 (match-string 3 line)))) 19113 (org-export-cleanup-toc-line
17531 todo 19114 (match-string 3 line))))
17532 (or (and org-export-mark-todo-in-toc 19115 todo
17533 (match-beginning 2) 19116 (or (and org-export-mark-todo-in-toc
17534 (not (equal (match-string 2 line) 19117 (match-beginning 2)
17535 org-done-string))) 19118 (not (member (match-string 2 line)
19119 org-done-keywords)))
17536 ; TODO, not DONE 19120 ; TODO, not DONE
17537 (and org-export-mark-todo-in-toc 19121 (and org-export-mark-todo-in-toc
17538 (= level umax-toc) 19122 (= level umax-toc)
17539 (org-search-todo-below 19123 (org-search-todo-below
17540 line lines level)))) 19124 line lines level))))
17541 (if (and (memq org-export-with-tags '(not-in-toc nil)) 19125 (if (and (memq org-export-with-tags '(not-in-toc nil))
17542 (string-match "[ \t]+:[a-zA-Z0-9_@:]+:[ \t]*$" txt)) 19126 (string-match "[ \t]+:[a-zA-Z0-9_@:]+:[ \t]*$" txt))
17543 (setq txt (replace-match "" t t txt))) 19127 (setq txt (replace-match "" t t txt)))
17544 (if (string-match quote-re0 txt) 19128 (if (string-match quote-re0 txt)
17545 (setq txt (replace-match "" t t txt))) 19129 (setq txt (replace-match "" t t txt)))
17546 (if org-export-with-section-numbers 19130 (if org-export-with-section-numbers
17547 (setq txt (concat (org-section-number level) 19131 (setq txt (concat (org-section-number level)
17548 " " txt))) 19132 " " txt)))
17549 (if (<= level umax-toc) 19133 (if (<= level (max umax umax-toc))
17550 (progn 19134 (setq head-count (+ head-count 1)))
17551 (setq head-count (+ head-count 1)) 19135 (if (<= level umax-toc)
17552 (if (> level org-last-level) 19136 (progn
17553 (progn 19137 (if (> level org-last-level)
17554 (setq cnt (- level org-last-level)) 19138 (progn
17555 (while (>= (setq cnt (1- cnt)) 0) 19139 (setq cnt (- level org-last-level))
17556 (insert "\n<ul>\n<li>")) 19140 (while (>= (setq cnt (1- cnt)) 0)
17557 (insert "\n"))) 19141 (push "\n<ul>\n<li>" thetoc))
17558 (if (< level org-last-level) 19142 (push "\n" thetoc)))
17559 (progn 19143 (if (< level org-last-level)
17560 (setq cnt (- org-last-level level)) 19144 (progn
17561 (while (>= (setq cnt (1- cnt)) 0) 19145 (setq cnt (- org-last-level level))
17562 (insert "</li>\n</ul>")) 19146 (while (>= (setq cnt (1- cnt)) 0)
17563 (insert "\n"))) 19147 (push "</li>\n</ul>" thetoc))
17564 ;; Check for targets 19148 (push "\n" thetoc)))
17565 (while (string-match org-target-regexp line) 19149 ;; Check for targets
17566 (setq tg (match-string 1 line) 19150 (while (string-match org-target-regexp line)
17567 line (replace-match 19151 (setq tg (match-string 1 line)
17568 (concat "@<span class=\"target\">" tg "@</span> ") 19152 line (replace-match
17569 t t line)) 19153 (concat "@<span class=\"target\">" tg "@</span> ")
17570 (push (cons (org-solidify-link-text tg) 19154 t t line))
17571 (format "sec-%d" head-count)) 19155 (push (cons (org-solidify-link-text tg)
17572 target-alist)) 19156 (format "sec-%d" head-count))
17573 (while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt) 19157 target-alist))
17574 (setq txt (replace-match "" t t txt))) 19158 (while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
17575 (insert 19159 (setq txt (replace-match "" t t txt)))
17576 (format 19160 (push
17577 (if todo 19161 (format
17578 "</li>\n<li><a href=\"#sec-%d\"><span class=\"todo\">%s</span></a>" 19162 (if todo
17579 "</li>\n<li><a href=\"#sec-%d\">%s</a>") 19163 "</li>\n<li><a href=\"#sec-%d\"><span class=\"todo\">%s</span></a>"
17580 head-count txt)) 19164 "</li>\n<li><a href=\"#sec-%d\">%s</a>")
17581 19165 head-count txt) thetoc)
17582 (setq org-last-level level)) 19166
17583 ))) 19167 (setq org-last-level level))
17584 line) 19168 )))
17585 lines)) 19169 line)
19170 lines))
17586 (while (> org-last-level 0) 19171 (while (> org-last-level 0)
17587 (setq org-last-level (1- org-last-level)) 19172 (setq org-last-level (1- org-last-level))
17588 (insert "</li>\n</ul>\n")) 19173 (push "</li>\n</ul>\n" thetoc))
17589 )) 19174 (setq thetoc (if have-headings (nreverse thetoc) nil))))
19175
17590 (setq head-count 0) 19176 (setq head-count 0)
17591 (org-init-section-numbers) 19177 (org-init-section-numbers)
17592 19178
@@ -17618,7 +19204,16 @@ lang=\"%s\" xml:lang=\"%s\">
17618 19204
17619 ;; Protected HTML 19205 ;; Protected HTML
17620 (when (get-text-property 0 'org-protected line) 19206 (when (get-text-property 0 'org-protected line)
17621 (insert line "\n") 19207 (let (par)
19208 (when (re-search-backward
19209 "\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t)
19210 (setq par (match-string 1))
19211 (replace-match "\\2\n"))
19212 (insert line "\n")
19213 (while (and lines
19214 (get-text-property 0 'org-protected (car lines)))
19215 (insert (pop lines) "\n"))
19216 (and par (insert "<p>\n")))
17622 (throw 'nextline nil)) 19217 (throw 'nextline nil))
17623 19218
17624 ;; Horizontal line 19219 ;; Horizontal line
@@ -17676,7 +19271,8 @@ lang=\"%s\" xml:lang=\"%s\">
17676 (setq rpl 19271 (setq rpl
17677 (concat 19272 (concat
17678 "<a href=\"#" 19273 "<a href=\"#"
17679 (org-solidify-link-text path target-alist) 19274 (org-solidify-link-text
19275 (save-match-data (org-link-unescape path)) target-alist)
17680 "\">" desc "</a>"))) 19276 "\">" desc "</a>")))
17681 ((member type '("http" "https")) ; FIXME: need to test this. 19277 ((member type '("http" "https")) ; FIXME: need to test this.
17682 ;; standard URL, just check if we need to inline an image 19278 ;; standard URL, just check if we need to inline an image
@@ -17738,12 +19334,24 @@ lang=\"%s\" xml:lang=\"%s\">
17738 ;; TODO items 19334 ;; TODO items
17739 (if (and (string-match org-todo-line-regexp line) 19335 (if (and (string-match org-todo-line-regexp line)
17740 (match-beginning 2)) 19336 (match-beginning 2))
17741 (if (equal (match-string 2 line) org-done-string) 19337 (if (member (match-string 2 line) org-done-keywords)
17742 (setq line (replace-match 19338 (setq line (replace-match
17743 "<span class=\"done\">\\2</span>" 19339 "<span class=\"done\">\\2</span>"
17744 t nil line 2)) 19340 t nil line 2))
17745 (setq line (replace-match "<span class=\"todo\">\\2</span>" 19341 (setq line
17746 t nil line 2)))) 19342 (concat (substring line 0 (match-beginning 2))
19343 "<span class=\"todo\">" (match-string 2 line)
19344 "</span>" (substring line (match-end 2))))))
19345
19346 ;; Does this contain a reference to a footnote?
19347 (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line)
19348 (let ((n (match-string 2 line)))
19349 (setq line
19350 (replace-match
19351 (format
19352 "%s<sup><a class=\"footref\" name=\"fnr.%s\" href=\"#fn.%s\">%s</a></sup>"
19353 (match-string 1 line) n n n)
19354 t t line))))
17747 19355
17748 (cond 19356 (cond
17749 ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) 19357 ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line)
@@ -17752,7 +19360,8 @@ lang=\"%s\" xml:lang=\"%s\">
17752 txt (match-string 2 line)) 19360 txt (match-string 2 line))
17753 (if (string-match quote-re0 txt) 19361 (if (string-match quote-re0 txt)
17754 (setq txt (replace-match "" t t txt))) 19362 (setq txt (replace-match "" t t txt)))
17755 (if (<= level umax) (setq head-count (+ head-count 1))) 19363 (if (<= level (max umax umax-toc))
19364 (setq head-count (+ head-count 1)))
17756 (when in-local-list 19365 (when in-local-list
17757 ;; Close any local lists before inserting a new header line 19366 ;; Close any local lists before inserting a new header line
17758 (while local-list-num 19367 (while local-list-num
@@ -17761,6 +19370,7 @@ lang=\"%s\" xml:lang=\"%s\">
17761 (pop local-list-num)) 19370 (pop local-list-num))
17762 (setq local-list-indent nil 19371 (setq local-list-indent nil
17763 in-local-list nil)) 19372 in-local-list nil))
19373 (setq first-heading-pos (or first-heading-pos (point)))
17764 (org-html-level-start level txt umax 19374 (org-html-level-start level txt umax
17765 (and org-export-with-toc (<= level umax)) 19375 (and org-export-with-toc (<= level umax))
17766 head-count) 19376 head-count)
@@ -17801,11 +19411,15 @@ lang=\"%s\" xml:lang=\"%s\">
17801 line (substring line (match-beginning 5))) 19411 line (substring line (match-beginning 5)))
17802 (unless (string-match "[^ \t]" line) 19412 (unless (string-match "[^ \t]" line)
17803 ;; empty line. Pretend indentation is large. 19413 ;; empty line. Pretend indentation is large.
17804 (setq ind (1+ (or (car local-list-indent) 1)))) 19414 (setq ind (if org-empty-line-terminates-plain-lists
19415 0
19416 (1+ (or (car local-list-indent) 1)))))
19417 (setq didclose nil)
17805 (while (and in-local-list 19418 (while (and in-local-list
17806 (or (and (= ind (car local-list-indent)) 19419 (or (and (= ind (car local-list-indent))
17807 (not starter)) 19420 (not starter))
17808 (< ind (car local-list-indent)))) 19421 (< ind (car local-list-indent))))
19422 (setq didclose t)
17809 (org-close-li) 19423 (org-close-li)
17810 (insert (if (car local-list-num) "</ol>\n" "</ul>")) 19424 (insert (if (car local-list-num) "</ol>\n" "</ul>"))
17811 (pop local-list-num) (pop local-list-indent) 19425 (pop local-list-num) (pop local-list-indent)
@@ -17814,7 +19428,7 @@ lang=\"%s\" xml:lang=\"%s\">
17814 ((and starter 19428 ((and starter
17815 (or (not in-local-list) 19429 (or (not in-local-list)
17816 (> ind (car local-list-indent)))) 19430 (> ind (car local-list-indent))))
17817 ;; Start new (level of ) list 19431 ;; Start new (level of) list
17818 (org-close-par-maybe) 19432 (org-close-par-maybe)
17819 (insert (if start-is-num "<ol>\n<li>\n" "<ul>\n<li>\n")) 19433 (insert (if start-is-num "<ol>\n<li>\n" "<ul>\n<li>\n"))
17820 (push start-is-num local-list-num) 19434 (push start-is-num local-list-num)
@@ -17823,7 +19437,10 @@ lang=\"%s\" xml:lang=\"%s\">
17823 (starter 19437 (starter
17824 ;; continue current list 19438 ;; continue current list
17825 (org-close-li) 19439 (org-close-li)
17826 (insert "<li>\n"))) 19440 (insert "<li>\n"))
19441 (didclose
19442 ;; we did close a list, normal text follows: need <p>
19443 (org-open-par)))
17827 (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line) 19444 (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line)
17828 (setq line 19445 (setq line
17829 (replace-match 19446 (replace-match
@@ -17837,6 +19454,13 @@ lang=\"%s\" xml:lang=\"%s\">
17837 ;; also start a new paragraph. 19454 ;; also start a new paragraph.
17838 (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par)) 19455 (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par))
17839 19456
19457 ;; Is this the start of a footnote?
19458 (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
19459 (org-close-par-maybe)
19460 (let ((n (match-string 1 line)))
19461 (setq line (replace-match
19462 (format "<p class=\"footnote\"><sup><a class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a></sup>" n n n) t t line))))
19463
17840 ;; Check if the line break needs to be conserved 19464 ;; Check if the line break needs to be conserved
17841 (cond 19465 (cond
17842 ((string-match "\\\\\\\\[ \t]*$" line) 19466 ((string-match "\\\\\\\\[ \t]*$" line)
@@ -17860,24 +19484,43 @@ lang=\"%s\" xml:lang=\"%s\">
17860 (and org-export-with-toc (<= level umax)) 19484 (and org-export-with-toc (<= level umax))
17861 head-count) 19485 head-count)
17862 19486
17863 (when (plist-get opt-plist :auto-postamble) 19487 (unless body-only
17864 (when author 19488 (when (plist-get opt-plist :auto-postamble)
17865 (insert "<p class=\"author\"> " 19489 (when author
17866 (nth 1 lang-words) ": " author "\n") 19490 (insert "<p class=\"author\"> "
17867 (when email 19491 (nth 1 lang-words) ": " author "\n")
17868 (insert "<a href=\"mailto:" email "\">&lt;" 19492 (when email
17869 email "&gt;</a>\n")) 19493 (insert "<a href=\"mailto:" email "\">&lt;"
17870 (insert "</p>\n")) 19494 email "&gt;</a>\n"))
17871 (when (and date time) 19495 (insert "</p>\n"))
17872 (insert "<p class=\"date\"> " 19496 (when (and date time)
17873 (nth 2 lang-words) ": " 19497 (insert "<p class=\"date\"> "
17874 date " " time "</p>\n"))) 19498 (nth 2 lang-words) ": "
17875 19499 date " " time "</p>\n")))
17876 (if org-export-html-with-timestamp 19500
17877 (insert org-export-html-html-helper-timestamp)) 19501 (if org-export-html-with-timestamp
17878 (insert (or (plist-get opt-plist :postamble) "")) 19502 (insert org-export-html-html-helper-timestamp))
17879 (insert "</body>\n</html>\n") 19503 (insert (or (plist-get opt-plist :postamble) ""))
19504 (insert "</body>\n</html>\n"))
19505
17880 (normal-mode) 19506 (normal-mode)
19507 (if (eq major-mode default-major-mode) (html-mode))
19508
19509 ;; insert the table of contents
19510 (goto-char (point-min))
19511 (when thetoc
19512 (if (or (re-search-forward
19513 "<p>\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*</p>" nil t)
19514 (re-search-forward
19515 "\\[TABLE-OF-CONTENTS\\]" nil t))
19516 (progn
19517 (goto-char (match-beginning 0))
19518 (replace-match ""))
19519 (goto-char first-heading-pos)
19520 (when (looking-at "\\s-*</p>")
19521 (goto-char (match-end 0))
19522 (insert "\n")))
19523 (mapc 'insert thetoc))
17881 ;; remove empty paragraphs and lists 19524 ;; remove empty paragraphs and lists
17882 (goto-char (point-min)) 19525 (goto-char (point-min))
17883 (while (re-search-forward "<p>[ \r\n\t]*</p>" nil t) 19526 (while (re-search-forward "<p>[ \r\n\t]*</p>" nil t)
@@ -17885,13 +19528,62 @@ lang=\"%s\" xml:lang=\"%s\">
17885 (goto-char (point-min)) 19528 (goto-char (point-min))
17886 (while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t) 19529 (while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t)
17887 (replace-match "")) 19530 (replace-match ""))
17888 (save-buffer) 19531 (or to-buffer (save-buffer))
17889 (goto-char (point-min)) 19532 (goto-char (point-min))
17890 (message "Exporting... done")))) 19533 (message "Exporting... done")
19534 (if (eq to-buffer 'string)
19535 (prog1 (buffer-substring (point-min) (point-max))
19536 (kill-buffer (current-buffer)))
19537 (current-buffer)))))
19538
19539(defvar org-table-colgroup-info nil) ;; FIXME: mode to a better place
19540(defun org-format-table-ascii (lines)
19541 "Format a table for ascii export."
19542 (if (stringp lines)
19543 (setq lines (org-split-string lines "\n")))
19544 (if (not (string-match "^[ \t]*|" (car lines)))
19545 ;; Table made by table.el - test for spanning
19546 lines
19547
19548 ;; A normal org table
19549 ;; Get rid of hlines at beginning and end
19550 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
19551 (setq lines (nreverse lines))
19552 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
19553 (setq lines (nreverse lines))
19554 (when org-export-table-remove-special-lines
19555 ;; Check if the table has a marking column. If yes remove the
19556 ;; column and the special lines
19557 (setq lines (org-table-clean-before-export lines)))
19558 ;; Get rid of the vertical lines except for grouping
19559 (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info))
19560 rtn line vl1 start)
19561 (while (setq line (pop lines))
19562 (if (string-match org-table-hline-regexp line)
19563 (and (string-match "|\\(.*\\)|" line)
19564 (setq line (replace-match " \\1" t nil line)))
19565 (setq start 0 vl1 vl)
19566 (while (string-match "|" line start)
19567 (setq start (match-end 0))
19568 (or (pop vl1) (setq line (replace-match " " t t line)))))
19569 (push line rtn))
19570 (nreverse rtn))))
19571
19572(defun org-colgroup-info-to-vline-list (info)
19573 (let (vl new last rtn line)
19574 (while info
19575 (setq last new new (pop info))
19576 (if (or (memq last '(:end :startend))
19577 (memq new '(:start :startend)))
19578 (push t vl)
19579 (push nil vl)))
19580 (setq vl (cons nil (nreverse vl)))))
17891 19581
17892 19582
17893(defun org-format-table-html (lines olines) 19583(defun org-format-table-html (lines olines)
17894 "Find out which HTML converter to use and return the HTML code." 19584 "Find out which HTML converter to use and return the HTML code."
19585 (if (stringp lines)
19586 (setq lines (org-split-string lines "\n")))
17895 (if (string-match "^[ \t]*|" (car lines)) 19587 (if (string-match "^[ \t]*|" (car lines))
17896 ;; A normal org table 19588 ;; A normal org table
17897 (org-format-org-table-html lines) 19589 (org-format-org-table-html lines)
@@ -17931,7 +19623,7 @@ lang=\"%s\" xml:lang=\"%s\">
17931 (lambda (x) (string-match "^[ \t]*|-" x)) 19623 (lambda (x) (string-match "^[ \t]*|-" x))
17932 (cdr lines))))) 19624 (cdr lines)))))
17933 (nlines 0) fnum i 19625 (nlines 0) fnum i
17934 tbopen line fields html) 19626 tbopen line fields html gr)
17935 (if splice (setq head nil)) 19627 (if splice (setq head nil))
17936 (unless splice (push (if head "<thead>" "<tbody>") html)) 19628 (unless splice (push (if head "<thead>" "<tbody>") html))
17937 (setq tbopen t) 19629 (setq tbopen t)
@@ -17939,7 +19631,7 @@ lang=\"%s\" xml:lang=\"%s\">
17939 (catch 'next-line 19631 (catch 'next-line
17940 (if (string-match "^[ \t]*|-" line) 19632 (if (string-match "^[ \t]*|-" line)
17941 (progn 19633 (progn
17942 (unless splice 19634 (unless splice
17943 (push (if head "</thead>" "</tbody>") html) 19635 (push (if head "</thead>" "</tbody>") html)
17944 (if lines (push "<tbody>" html) (setq tbopen nil))) 19636 (if lines (push "<tbody>" html) (setq tbopen nil)))
17945 (setq head nil) ;; head ends here, first time around 19637 (setq head nil) ;; head ends here, first time around
@@ -17957,8 +19649,10 @@ lang=\"%s\" xml:lang=\"%s\">
17957 (string-match org-table-number-regexp x)) 19649 (string-match org-table-number-regexp x))
17958 (incf (aref fnum i))) 19650 (incf (aref fnum i)))
17959 (if head 19651 (if head
17960 (concat "<th>" x "</th>") 19652 (concat (car org-export-table-header-tags) x
17961 (concat "<td>" x "</td>"))) 19653 (cdr org-export-table-header-tags))
19654 (concat (car org-export-table-data-tags) x
19655 (cdr org-export-table-data-tags))))
17962 fields "") 19656 fields "")
17963 "</tr>") 19657 "</tr>")
17964 html))) 19658 html)))
@@ -17969,9 +19663,12 @@ lang=\"%s\" xml:lang=\"%s\">
17969 ;; Put in COL tags with the alignment (unfortuntely often ignored...) 19663 ;; Put in COL tags with the alignment (unfortuntely often ignored...)
17970 (push (mapconcat 19664 (push (mapconcat
17971 (lambda (x) 19665 (lambda (x)
17972 (format "<COL align=\"%s\">" 19666 (setq gr (pop org-table-colgroup-info))
19667 (format "%s<COL align=\"%s\">%s"
19668 (if (memq gr '(:start :startend)) "<colgroup>" "")
17973 (if (> (/ (float x) nlines) org-table-number-fraction) 19669 (if (> (/ (float x) nlines) org-table-number-fraction)
17974 "right" "left"))) 19670 "right" "left")
19671 (if (memq gr '(:end :startend)) "</colgroup>" "")))
17975 fnum "") 19672 fnum "")
17976 html) 19673 html)
17977 (push org-export-html-table-tag html)) 19674 (push org-export-html-table-tag html))
@@ -17980,34 +19677,52 @@ lang=\"%s\" xml:lang=\"%s\">
17980(defun org-table-clean-before-export (lines) 19677(defun org-table-clean-before-export (lines)
17981 "Check if the table has a marking column. 19678 "Check if the table has a marking column.
17982If yes remove the column and the special lines." 19679If yes remove the column and the special lines."
19680 (setq org-table-colgroup-info nil)
17983 (if (memq nil 19681 (if (memq nil
17984 (mapcar 19682 (mapcar
17985 (lambda (x) (or (string-match "^[ \t]*|-" x) 19683 (lambda (x) (or (string-match "^[ \t]*|-" x)
17986 (string-match "^[ \t]*| *\\([#!$*_^ /]\\) *|" x))) 19684 (string-match "^[ \t]*| *\\([#!$*_^ /]\\) *|" x)))
17987 lines)) 19685 lines))
17988 (progn 19686 (progn
17989 (setq org-table-clean-did-remove-column-1 nil) 19687 (setq org-table-clean-did-remove-column nil)
17990 lines) 19688 (delq nil
17991 (setq org-table-clean-did-remove-column-1 t) 19689 (mapcar
19690 (lambda (x)
19691 (cond
19692 ((string-match "^[ \t]*| */ *|" x)
19693 (setq org-table-colgroup-info
19694 (mapcar (lambda (x)
19695 (cond ((member x '("<" "&lt;")) :start)
19696 ((member x '(">" "&gt;")) :end)
19697 ((member x '("<>" "&lt;&gt;")) :startend)
19698 (t nil)))
19699 (org-split-string x "[ \t]*|[ \t]*")))
19700 nil)
19701 (t x)))
19702 lines)))
19703 (setq org-table-clean-did-remove-column t)
17992 (delq nil 19704 (delq nil
17993 (mapcar 19705 (mapcar
17994 (lambda (x) (if (string-match "^[ \t]*| *[!_^/] *|" x) 19706 (lambda (x)
17995 nil ; ignore this line 19707 (cond
17996 (and (or (string-match "^[ \t]*|-+\\+" x) 19708 ((string-match "^[ \t]*| */ *|" x)
17997 (string-match "^[ \t]*|[^|]*|" x)) 19709 (setq org-table-colgroup-info
17998 (replace-match "|" t t x)))) 19710 (mapcar (lambda (x)
19711 (cond ((member x '("<" "&lt;")) :start)
19712 ((member x '(">" "&gt;")) :end)
19713 ((member x '("<>" "&lt;&gt;")) :startend)
19714 (t nil)))
19715 (cdr (org-split-string x "[ \t]*|[ \t]*"))))
19716 nil)
19717 ((string-match "^[ \t]*| *[!_^/] *|" x)
19718 nil) ; ignore this line
19719 ((or (string-match "^\\([ \t]*\\)|-+\\+" x)
19720 (string-match "^\\([ \t]*\\)|[^|]*|" x))
19721 ;; remove the first column
19722 (replace-match "\\1|" t nil x))
19723 (t (error "This should not happen"))))
17999 lines)))) 19724 lines))))
18000 19725
18001(defun org-fake-empty-table-line (line)
18002 "Replace everything except \"|\" with spaces."
18003 (let ((i (length line))
18004 (newstr (copy-sequence line)))
18005 (while (> i 0)
18006 (setq i (1- i))
18007 (if (not (eq (aref newstr i) ?|))
18008 (aset newstr i ?\ )))
18009 newstr))
18010
18011(defun org-format-table-table-html (lines) 19726(defun org-format-table-table-html (lines)
18012 "Format a table generated by table.el into HTML. 19727 "Format a table generated by table.el into HTML.
18013This conversion does *not* use `table-generate-source' from table.el. 19728This conversion does *not* use `table-generate-source' from table.el.
@@ -18024,17 +19739,21 @@ But it has the disadvantage, that no cell- or row-spanning is allowed."
18024 (progn 19739 (progn
18025 (if field-buffer 19740 (if field-buffer
18026 (progn 19741 (progn
18027 (setq html (concat 19742 (setq
18028 html 19743 html
18029 "<tr>" 19744 (concat
18030 (mapconcat 19745 html
18031 (lambda (x) 19746 "<tr>"
18032 (if (equal x "") (setq x empty)) 19747 (mapconcat
18033 (if head 19748 (lambda (x)
18034 (concat "<th>" x "</th>\n") 19749 (if (equal x "") (setq x empty))
18035 (concat "<td>" x "</td>\n"))) 19750 (if head
18036 field-buffer "\n") 19751 (concat (car org-export-table-header-tags) x
18037 "</tr>\n")) 19752 (cdr org-export-table-header-tags))
19753 (concat (car org-export-table-data-tags) x
19754 (cdr org-export-table-data-tags))))
19755 field-buffer "\n")
19756 "</tr>\n"))
18038 (setq head nil) 19757 (setq head nil)
18039 (setq field-buffer nil))) 19758 (setq field-buffer nil)))
18040 ;; Ignore this line 19759 ;; Ignore this line
@@ -18115,6 +19834,9 @@ But it has the disadvantage, that Org-mode's HTML conversions cannot be used."
18115 (when org-export-remove-timestamps-from-toc 19834 (when org-export-remove-timestamps-from-toc
18116 (while (string-match org-maybe-keyword-time-regexp s) 19835 (while (string-match org-maybe-keyword-time-regexp s)
18117 (setq s (replace-match "" t t s)))) 19836 (setq s (replace-match "" t t s))))
19837 (while (string-match org-bracket-link-regexp s)
19838 (setq s (replace-match (match-string (if (match-end 3) 3 1) s)
19839 t t s)))
18118 s) 19840 s)
18119 19841
18120(defun org-html-expand (string) 19842(defun org-html-expand (string)
@@ -18179,27 +19901,42 @@ stacked delimiters is N. Escaping delimiters is not possible."
18179 "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") 19901 "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)")
18180 "The regular expression matching a sub- or superscript.") 19902 "The regular expression matching a sub- or superscript.")
18181 19903
19904;(let ((s "a\\_b"))
19905; (and (string-match org-match-substring-regexp s)
19906; (conca t (match-string 1 s) ":::" (match-string 2 s))))
19907
18182(defun org-export-html-convert-sub-super (string) 19908(defun org-export-html-convert-sub-super (string)
18183 "Convert sub- and superscripts in STRING to HTML." 19909 "Convert sub- and superscripts in STRING to HTML."
18184 (let (key c) 19910 (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
18185 (while (string-match org-match-substring-regexp string) 19911 (while (string-match org-match-substring-regexp string s)
18186 (setq key (if (string= (match-string 2 string) "_") "sub" "sup")) 19912 (if (and requireb (match-end 8))
18187 (setq c (or (match-string 8 string) 19913 (setq s (match-end 2))
18188 (match-string 6 string) 19914 (setq s (match-end 1)
18189 (match-string 5 string))) 19915 key (if (string= (match-string 2 string) "_") "sub" "sup")
18190 (setq string (replace-match 19916 c (or (match-string 8 string)
18191 (concat (match-string 1 string) 19917 (match-string 6 string)
18192 "<" key ">" c "</" key ">") 19918 (match-string 5 string))
18193 t t string))) 19919 string (replace-match
19920 (concat (match-string 1 string)
19921 "<" key ">" c "</" key ">")
19922 t t string))))
18194 (while (string-match "\\\\\\([_^]\\)" string) 19923 (while (string-match "\\\\\\([_^]\\)" string)
18195 (setq string (replace-match (match-string 1 string) t t string)))) 19924 (setq string (replace-match (match-string 1 string) t t string)))
18196 string) 19925 string))
18197 19926
18198(defun org-export-html-convert-emphasize (string) 19927(defun org-export-html-convert-emphasize (string)
18199 "Apply emphasis." 19928 "Apply emphasis."
18200 (while (string-match org-emph-re string) 19929 (let ((s 0))
18201 (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))) 19930 (while (string-match org-emph-re string s)
18202 string) 19931 (if (not (equal
19932 (substring string (match-beginning 3) (1+ (match-beginning 3)))
19933 (substring string (match-beginning 4) (1+ (match-beginning 4)))))
19934 (setq string (replace-match
19935 (concat "\\1" (nth 2 (assoc (match-string 3 string) org-emphasis-alist))
19936 "\\4" (nth 3 (assoc (match-string 3 string) org-emphasis-alist))
19937 "\\5") t nil string))
19938 (setq s (1+ s))))
19939 string))
18203 19940
18204(defvar org-par-open nil) 19941(defvar org-par-open nil)
18205(defun org-open-par () 19942(defun org-open-par ()
@@ -18216,10 +19953,6 @@ stacked delimiters is N. Escaping delimiters is not possible."
18216 "Close <li> if necessary." 19953 "Close <li> if necessary."
18217 (org-close-par-maybe) 19954 (org-close-par-maybe)
18218 (insert "</li>\n")) 19955 (insert "</li>\n"))
18219; (when (save-excursion
18220; (re-search-backward "</?\\(ul\\|ol\\|li\\|[hH][0-9]\\)>" nil t))
18221; (if (member (match-string 0) '("</ul>" "</ol>" "<li>"))
18222; (insert "</li>"))))
18223 19956
18224(defun org-html-level-start (level title umax with-toc head-count) 19957(defun org-html-level-start (level title umax with-toc head-count)
18225 "Insert a new level in HTML export. 19958 "Insert a new level in HTML export.
@@ -18260,7 +19993,7 @@ When TITLE is nil, just close all open levels."
18260 (setq title (concat (org-section-number level) " " title))) 19993 (setq title (concat (org-section-number level) " " title)))
18261 (setq level (+ level org-export-html-toplevel-hlevel -1)) 19994 (setq level (+ level org-export-html-toplevel-hlevel -1))
18262 (if with-toc 19995 (if with-toc
18263 (insert (format "\n<h%d><a name=\"sec-%d\">%s</a></h%d>\n" 19996 (insert (format "\n<h%d id=\"sec-%d\">%s</h%d>\n"
18264 level head-count title level)) 19997 level head-count title level))
18265 (insert (format "\n<h%d>%s</h%d>\n" level title level))) 19998 (insert (format "\n<h%d>%s</h%d>\n" level title level)))
18266 (org-open-par))))) 19999 (org-open-par)))))
@@ -18268,7 +20001,7 @@ When TITLE is nil, just close all open levels."
18268(defun org-html-level-close (&rest args) 20001(defun org-html-level-close (&rest args)
18269 "Terminate one level in HTML export." 20002 "Terminate one level in HTML export."
18270 (org-close-li) 20003 (org-close-li)
18271 (insert "</ul>")) 20004 (insert "</ul>\n"))
18272 20005
18273;;; iCalendar export 20006;;; iCalendar export
18274 20007
@@ -18300,11 +20033,13 @@ The file is stored under the name `org-combined-agenda-icalendar-file'."
18300If COMBINE is non-nil, combine all calendar entries into a single large 20033If COMBINE is non-nil, combine all calendar entries into a single large
18301file and store it under the name `org-combined-agenda-icalendar-file'." 20034file and store it under the name `org-combined-agenda-icalendar-file'."
18302 (save-excursion 20035 (save-excursion
20036 (org-prepare-agenda-buffers files)
18303 (let* ((dir (org-export-directory 20037 (let* ((dir (org-export-directory
18304 :ical (list :publishing-directory 20038 :ical (list :publishing-directory
18305 org-export-publishing-directory))) 20039 org-export-publishing-directory)))
18306 file ical-file ical-buffer category started org-agenda-new-buffers) 20040 file ical-file ical-buffer category started org-agenda-new-buffers)
18307 20041
20042 (and (get-buffer "*ical-tmp*") (kill-buffer "*ical-tmp*"))
18308 (when combine 20043 (when combine
18309 (setq ical-file 20044 (setq ical-file
18310 (if (file-name-absolute-p org-combined-agenda-icalendar-file) 20045 (if (file-name-absolute-p org-combined-agenda-icalendar-file)
@@ -18349,70 +20084,112 @@ the iCalendar file.")
18349(defun org-print-icalendar-entries (&optional combine) 20084(defun org-print-icalendar-entries (&optional combine)
18350 "Print iCalendar entries for the current Org-mode file to `standard-output'. 20085 "Print iCalendar entries for the current Org-mode file to `standard-output'.
18351When COMBINE is non nil, add the category to each line." 20086When COMBINE is non nil, add the category to each line."
18352 (let ((re2 (concat "--?-?\\(" org-ts-regexp "\\)")) 20087 (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>"))
20088 (re2 (concat "--?-?\\(" org-ts-regexp "\\)"))
18353 (org-category-table (org-get-category-table)) 20089 (org-category-table (org-get-category-table))
18354 (dts (org-ical-ts-to-string 20090 (dts (org-ical-ts-to-string
18355 (format-time-string (cdr org-time-stamp-formats) (current-time)) 20091 (format-time-string (cdr org-time-stamp-formats) (current-time))
18356 "DTSTART")) 20092 "DTSTART"))
18357 hd ts ts2 state status (inc t) pos 20093 hd ts ts2 state status (inc t) pos b sexp rrule
18358 scheduledp deadlinep tmp pri category) 20094 scheduledp deadlinep tmp pri category
20095 (sexp-buffer (get-buffer-create "*ical-tmp*")))
18359 (save-excursion 20096 (save-excursion
18360 (goto-char (point-min)) 20097 (goto-char (point-min))
18361 (while (re-search-forward org-ts-regexp nil t) 20098 (while (re-search-forward re1 nil t)
18362 (setq pos (match-beginning 0) 20099 (catch :skip
18363 ts (match-string 0) 20100 (org-agenda-skip)
18364 inc t 20101 (setq pos (match-beginning 0)
18365 hd (org-get-heading) 20102 ts (match-string 0)
18366 category (org-get-category)) 20103 inc t
18367 (if (looking-at re2) 20104 hd (org-get-heading)
18368 (progn 20105 category (org-get-category))
18369 (goto-char (match-end 0)) 20106 (if (looking-at re2)
18370 (setq ts2 (match-string 1) inc nil)) 20107 (progn
18371 (setq ts2 ts 20108 (goto-char (match-end 0))
18372 tmp (buffer-substring (max (point-min) 20109 (setq ts2 (match-string 1) inc nil))
20110 (setq ts2 ts
20111 tmp (buffer-substring (max (point-min)
18373 (- pos org-ds-keyword-length)) 20112 (- pos org-ds-keyword-length))
18374 pos) 20113 pos)
18375 deadlinep (string-match org-deadline-regexp tmp) 20114 deadlinep (string-match org-deadline-regexp tmp)
18376 scheduledp (string-match org-scheduled-regexp tmp) 20115 scheduledp (string-match org-scheduled-regexp tmp)
18377 ;; donep (org-entry-is-done-p) 20116 ;; donep (org-entry-is-done-p)
18378 )) 20117 ))
18379 (if (or (string-match org-tr-regexp hd) 20118 (if (or (string-match org-tr-regexp hd)
18380 (string-match org-ts-regexp hd)) 20119 (string-match org-ts-regexp hd))
18381 (setq hd (replace-match "" t t hd))) 20120 (setq hd (replace-match "" t t hd)))
18382 (if (string-match org-bracket-link-regexp hd) 20121 (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts)
18383 (setq hd (replace-match (if (match-end 3) (match-string 3 hd) 20122 (setq rrule
18384 (match-string 1 hd)) 20123 (concat "\nRRULE:FREQ="
18385 t t hd))) 20124 (cdr (assoc
18386 (if deadlinep (setq hd (concat "DL: " hd))) 20125 (match-string 2 ts)
18387 (if scheduledp (setq hd (concat "S: " hd))) 20126 '(("d" . "DAILY")("w" . "WEEKLY")
18388 (princ (format "BEGIN:VEVENT 20127 ("m" . "MONTHLY")("y" . "YEARLY"))))
18389%s 20128 ";INTERVAL=" (match-string 1 ts)))
20129 (setq rrule ""))
20130 (if (string-match org-bracket-link-regexp hd)
20131 (setq hd (replace-match (if (match-end 3) (match-string 3 hd)
20132 (match-string 1 hd))
20133 t t hd)))
20134 (if deadlinep (setq hd (concat "DL: " hd)))
20135 (if scheduledp (setq hd (concat "S: " hd)))
20136 (if (string-match "\\`<%%" ts)
20137 (with-current-buffer sexp-buffer
20138 (insert (substring ts 1 -1) " " hd "\n"))
20139 (princ (format "BEGIN:VEVENT
18390%s 20140%s
20141%s%s
18391SUMMARY:%s 20142SUMMARY:%s
18392CATEGORIES:%s 20143CATEGORIES:%s
18393END:VEVENT\n" 20144END:VEVENT\n"
18394 (org-ical-ts-to-string ts "DTSTART") 20145 (org-ical-ts-to-string ts "DTSTART")
18395 (org-ical-ts-to-string ts2 "DTEND" inc) 20146 (org-ical-ts-to-string ts2 "DTEND" inc)
18396 hd category))) 20147 rrule hd category)))))
20148
20149 (when (and org-icalendar-include-sexps
20150 (condition-case nil (require 'icalendar) (error nil))
20151 (fboundp 'icalendar-export-region))
20152 ;; Get all the literal sexps
20153 (goto-char (point-min))
20154 (while (re-search-forward "^&?%%(" nil t)
20155 (catch :skip
20156 (org-agenda-skip)
20157 (setq b (match-beginning 0))
20158 (goto-char (1- (match-end 0)))
20159 (forward-sexp 1)
20160 (end-of-line 1)
20161 (setq sexp (buffer-substring b (point)))
20162 (with-current-buffer sexp-buffer
20163 (insert sexp "\n"))
20164 (princ (org-diary-to-ical-string sexp-buffer)))))
20165
18397 (when org-icalendar-include-todo 20166 (when org-icalendar-include-todo
18398 (goto-char (point-min)) 20167 (goto-char (point-min))
18399 (while (re-search-forward org-todo-line-regexp nil t) 20168 (while (re-search-forward org-todo-line-regexp nil t)
18400 (setq state (match-string 2)) 20169 (catch :skip
18401 (setq status (if (equal state org-done-string) 20170 (org-agenda-skip)
18402 "COMPLETED" "NEEDS-ACTION")) 20171 (setq state (match-string 2))
18403 (when (and state 20172 (setq status (if (member state org-done-keywords)
18404 (or (not (equal state org-done-string)) 20173 "COMPLETED" "NEEDS-ACTION"))
18405 (eq org-icalendar-include-todo 'all))) 20174 (when (and state
18406 (setq hd (match-string 3)) 20175 (or (not (member state org-done-keywords))
18407 (if (string-match org-priority-regexp hd) 20176 (eq org-icalendar-include-todo 'all))
18408 (setq pri (string-to-char (match-string 2 hd)) 20177 (not (member org-archive-tag (org-get-tags-at)))
18409 hd (concat (substring hd 0 (match-beginning 1)) 20178 )
18410 (substring hd (match-end 1)))) 20179 (setq hd (match-string 3))
18411 (setq pri org-default-priority)) 20180 (if (string-match org-bracket-link-regexp hd)
18412 (setq pri (floor (1+ (* 8. (/ (float (- org-lowest-priority pri)) 20181 (setq hd (replace-match (if (match-end 3) (match-string 3 hd)
18413 (- org-lowest-priority ?A)))))) 20182 (match-string 1 hd))
18414 20183 t t hd)))
18415 (princ (format "BEGIN:VTODO 20184 (if (string-match org-priority-regexp hd)
20185 (setq pri (string-to-char (match-string 2 hd))
20186 hd (concat (substring hd 0 (match-beginning 1))
20187 (substring hd (match-end 1))))
20188 (setq pri org-default-priority))
20189 (setq pri (floor (1+ (* 8. (/ (float (- org-lowest-priority pri))
20190 (- org-lowest-priority org-highest-priority))))))
20191
20192 (princ (format "BEGIN:VTODO
18416%s 20193%s
18417SUMMARY:%s 20194SUMMARY:%s
18418CATEGORIES:%s 20195CATEGORIES:%s
@@ -18420,7 +20197,7 @@ SEQUENCE:1
18420PRIORITY:%d 20197PRIORITY:%d
18421STATUS:%s 20198STATUS:%s
18422END:VTODO\n" 20199END:VTODO\n"
18423 dts hd category pri status)))))))) 20200 dts hd category pri status)))))))))
18424 20201
18425(defun org-start-icalendar-file (name) 20202(defun org-start-icalendar-file (name)
18426 "Start an iCalendar file by inserting the header." 20203 "Start an iCalendar file by inserting the header."
@@ -18545,47 +20322,44 @@ The XOXO buffer is named *xoxo-<source buffer name>*"
18545 20322
18546;;;; Key bindings 20323;;;; Key bindings
18547 20324
18548;; - Bindings in Org-mode map are currently
18549;; 0123456789abcdefghijklmnopqrstuvwxyz!?@#$%^&-+*/=()_{}[]:;"|,.<>~`'\t the alphabet
18550;; abcd fgh j lmnopqrstuvwxyz!? #$ ^ -+*/= [] ; |,.<>~ '\t necessary bindings
18551;; e (?) useful from outline-mode
18552;; i k @ expendable from outline-mode
18553;; 0123456789 % & ()_{} " ` free
18554
18555;; Make `C-c C-x' a prefix key 20325;; Make `C-c C-x' a prefix key
18556(define-key org-mode-map "\C-c\C-x" (make-sparse-keymap)) 20326(org-defkey org-mode-map "\C-c\C-x" (make-sparse-keymap))
18557 20327
18558;; TAB key with modifiers 20328;; TAB key with modifiers
18559(define-key org-mode-map "\C-i" 'org-cycle) 20329(org-defkey org-mode-map "\C-i" 'org-cycle)
18560(define-key org-mode-map [(tab)] 'org-cycle) 20330(org-defkey org-mode-map [(tab)] 'org-cycle)
18561(define-key org-mode-map [(control tab)] 'org-force-cycle-archived) 20331(org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived)
18562(define-key org-mode-map [(meta tab)] 'org-complete) 20332(org-defkey org-mode-map [(meta tab)] 'org-complete)
18563(define-key org-mode-map "\M-\t" 'org-complete) 20333(org-defkey org-mode-map "\M-\t" 'org-complete)
18564(define-key org-mode-map "\M-\C-i" 'org-complete) 20334(org-defkey org-mode-map "\M-\C-i" 'org-complete)
18565;; The following line is necessary under Suse GNU/Linux 20335;; The following line is necessary under Suse GNU/Linux
18566(unless (featurep 'xemacs) 20336(unless (featurep 'xemacs)
18567 (define-key org-mode-map [S-iso-lefttab] 'org-shifttab)) 20337 (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab))
18568(define-key org-mode-map [(shift tab)] 'org-shifttab) 20338(org-defkey org-mode-map [(shift tab)] 'org-shifttab)
20339(define-key org-mode-map (kbd "<backtab>") 'org-shifttab)
18569 20340
18570(define-key org-mode-map (org-key 'S-return) 'org-table-copy-down) 20341(org-defkey org-mode-map [(shift return)] 'org-table-copy-down)
18571(define-key org-mode-map [(meta shift return)] 'org-insert-todo-heading) 20342(org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading)
18572(define-key org-mode-map [(meta return)] 'org-meta-return) 20343(org-defkey org-mode-map [(meta return)] 'org-meta-return)
18573 20344
18574;; Cursor keys with modifiers 20345;; Cursor keys with modifiers
18575(define-key org-mode-map [(meta left)] 'org-metaleft) 20346(org-defkey org-mode-map [(meta left)] 'org-metaleft)
18576(define-key org-mode-map [(meta right)] 'org-metaright) 20347(org-defkey org-mode-map [(meta right)] 'org-metaright)
18577(define-key org-mode-map [(meta up)] 'org-metaup) 20348(org-defkey org-mode-map [(meta up)] 'org-metaup)
18578(define-key org-mode-map [(meta down)] 'org-metadown) 20349(org-defkey org-mode-map [(meta down)] 'org-metadown)
18579 20350
18580(define-key org-mode-map [(meta shift left)] 'org-shiftmetaleft) 20351(org-defkey org-mode-map [(meta shift left)] 'org-shiftmetaleft)
18581(define-key org-mode-map [(meta shift right)] 'org-shiftmetaright) 20352(org-defkey org-mode-map [(meta shift right)] 'org-shiftmetaright)
18582(define-key org-mode-map [(meta shift up)] 'org-shiftmetaup) 20353(org-defkey org-mode-map [(meta shift up)] 'org-shiftmetaup)
18583(define-key org-mode-map [(meta shift down)] 'org-shiftmetadown) 20354(org-defkey org-mode-map [(meta shift down)] 'org-shiftmetadown)
18584 20355
18585(define-key org-mode-map (org-key 'S-up) 'org-shiftup) 20356(org-defkey org-mode-map [(shift up)] 'org-shiftup)
18586(define-key org-mode-map (org-key 'S-down) 'org-shiftdown) 20357(org-defkey org-mode-map [(shift down)] 'org-shiftdown)
18587(define-key org-mode-map (org-key 'S-left) 'org-shiftleft) 20358(org-defkey org-mode-map [(shift left)] 'org-shiftleft)
18588(define-key org-mode-map (org-key 'S-right) 'org-shiftright) 20359(org-defkey org-mode-map [(shift right)] 'org-shiftright)
20360
20361(org-defkey org-mode-map [(control shift right)] 'org-shiftcontrolright)
20362(org-defkey org-mode-map [(control shift left)] 'org-shiftcontrolleft)
18589 20363
18590;;; Extra keys for tty access. 20364;;; Extra keys for tty access.
18591;; We only set them when really needed because otherwise the 20365;; We only set them when really needed because otherwise the
@@ -18593,102 +20367,105 @@ The XOXO buffer is named *xoxo-<source buffer name>*"
18593 20367
18594(when (or (featurep 'xemacs) ;; because XEmacs supports multi-device stuff 20368(when (or (featurep 'xemacs) ;; because XEmacs supports multi-device stuff
18595 (not window-system)) 20369 (not window-system))
18596 (define-key org-mode-map "\C-c\C-xc" 'org-table-copy-down) 20370 (org-defkey org-mode-map "\C-c\C-xc" 'org-table-copy-down)
18597 (define-key org-mode-map "\C-c\C-xM" 'org-insert-todo-heading) 20371 (org-defkey org-mode-map "\C-c\C-xM" 'org-insert-todo-heading)
18598 (define-key org-mode-map "\C-c\C-xm" 'org-meta-return) 20372 (org-defkey org-mode-map "\C-c\C-xm" 'org-meta-return)
18599 (define-key org-mode-map [?\e (return)] 'org-meta-return) 20373 (org-defkey org-mode-map [?\e (return)] 'org-meta-return)
18600 (define-key org-mode-map [?\e (left)] 'org-metaleft) 20374 (org-defkey org-mode-map [?\e (left)] 'org-metaleft)
18601 (define-key org-mode-map "\C-c\C-xl" 'org-metaleft) 20375 (org-defkey org-mode-map "\C-c\C-xl" 'org-metaleft)
18602 (define-key org-mode-map [?\e (right)] 'org-metaright) 20376 (org-defkey org-mode-map [?\e (right)] 'org-metaright)
18603 (define-key org-mode-map "\C-c\C-xr" 'org-metaright) 20377 (org-defkey org-mode-map "\C-c\C-xr" 'org-metaright)
18604 (define-key org-mode-map [?\e (up)] 'org-metaup) 20378 (org-defkey org-mode-map [?\e (up)] 'org-metaup)
18605 (define-key org-mode-map "\C-c\C-xu" 'org-metaup) 20379 (org-defkey org-mode-map "\C-c\C-xu" 'org-metaup)
18606 (define-key org-mode-map [?\e (down)] 'org-metadown) 20380 (org-defkey org-mode-map [?\e (down)] 'org-metadown)
18607 (define-key org-mode-map "\C-c\C-xd" 'org-metadown) 20381 (org-defkey org-mode-map "\C-c\C-xd" 'org-metadown)
18608 (define-key org-mode-map "\C-c\C-xL" 'org-shiftmetaleft) 20382 (org-defkey org-mode-map "\C-c\C-xL" 'org-shiftmetaleft)
18609 (define-key org-mode-map "\C-c\C-xR" 'org-shiftmetaright) 20383 (org-defkey org-mode-map "\C-c\C-xR" 'org-shiftmetaright)
18610 (define-key org-mode-map "\C-c\C-xU" 'org-shiftmetaup) 20384 (org-defkey org-mode-map "\C-c\C-xU" 'org-shiftmetaup)
18611 (define-key org-mode-map "\C-c\C-xD" 'org-shiftmetadown) 20385 (org-defkey org-mode-map "\C-c\C-xD" 'org-shiftmetadown)
18612 (define-key org-mode-map [?\C-c ?\C-x (up)] 'org-shiftup) 20386 (org-defkey org-mode-map [?\C-c (up)] 'org-shiftup)
18613 (define-key org-mode-map [?\C-c ?\C-x (down)] 'org-shiftdown) 20387 (org-defkey org-mode-map [?\C-c (down)] 'org-shiftdown)
18614 (define-key org-mode-map [?\C-c ?\C-x (left)] 'org-shiftleft) 20388 (org-defkey org-mode-map [?\C-c (left)] 'org-shiftleft)
18615 (define-key org-mode-map [?\C-c ?\C-x (right)] 'org-shiftright)) 20389 (org-defkey org-mode-map [?\C-c (right)] 'org-shiftright)
20390 (org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright)
20391 (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft))
18616 20392
18617 ;; All the other keys 20393 ;; All the other keys
18618 20394
18619(define-key org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up. 20395(org-defkey org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up.
18620(define-key org-mode-map "\C-c\C-r" 'org-reveal) 20396(org-defkey org-mode-map "\C-c\C-r" 'org-reveal)
18621(define-key org-mode-map "\C-xns" 'org-narrow-to-subtree) 20397(org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree)
18622(define-key org-mode-map "\C-c$" 'org-archive-subtree) 20398(org-defkey org-mode-map "\C-c$" 'org-archive-subtree)
18623(define-key org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree) 20399(org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree)
18624(define-key org-mode-map "\C-c\C-x\C-a" 'org-toggle-archive-tag) 20400(org-defkey org-mode-map "\C-c\C-x\C-a" 'org-toggle-archive-tag)
18625(define-key org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer) 20401(org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer)
18626(define-key org-mode-map "\C-c\C-j" 'org-goto) 20402(org-defkey org-mode-map "\C-c\C-j" 'org-goto)
18627(define-key org-mode-map "\C-c\C-t" 'org-todo) 20403(org-defkey org-mode-map "\C-c\C-t" 'org-todo)
18628(define-key org-mode-map "\C-c\C-s" 'org-schedule) 20404(org-defkey org-mode-map "\C-c\C-s" 'org-schedule)
18629(define-key org-mode-map "\C-c\C-d" 'org-deadline) 20405(org-defkey org-mode-map "\C-c\C-d" 'org-deadline)
18630(define-key org-mode-map "\C-c;" 'org-toggle-comment) 20406(org-defkey org-mode-map "\C-c;" 'org-toggle-comment)
18631(define-key org-mode-map "\C-c\C-v" 'org-show-todo-tree) 20407(org-defkey org-mode-map "\C-c\C-v" 'org-show-todo-tree)
18632(define-key org-mode-map "\C-c\C-w" 'org-check-deadlines) 20408(org-defkey org-mode-map "\C-c\C-w" 'org-check-deadlines)
18633(define-key org-mode-map "\C-c/" 'org-occur) ; Minor-mode reserved 20409(org-defkey org-mode-map "\C-c/" 'org-occur) ; Minor-mode reserved
18634(define-key org-mode-map "\C-c\\" 'org-tags-sparse-tree) ; Minor-mode res. 20410(org-defkey org-mode-map "\C-c\\" 'org-tags-sparse-tree) ; Minor-mode res.
18635(define-key org-mode-map "\C-c\C-m" 'org-insert-heading) 20411(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret)
18636(define-key org-mode-map "\M-\C-m" 'org-insert-heading) 20412(org-defkey org-mode-map "\M-\C-m" 'org-insert-heading)
18637(define-key org-mode-map "\C-c\C-x\C-n" 'org-next-link) 20413(org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link)
18638(define-key org-mode-map "\C-c\C-x\C-p" 'org-previous-link) 20414(org-defkey org-mode-map "\C-c\C-x\C-p" 'org-previous-link)
18639(define-key org-mode-map "\C-c\C-l" 'org-insert-link) 20415(org-defkey org-mode-map "\C-c\C-l" 'org-insert-link)
18640(define-key org-mode-map "\C-c\C-o" 'org-open-at-point) 20416(org-defkey org-mode-map "\C-c\C-o" 'org-open-at-point)
18641(define-key org-mode-map "\C-c%" 'org-mark-ring-push) 20417(org-defkey org-mode-map "\C-c%" 'org-mark-ring-push)
18642(define-key org-mode-map "\C-c&" 'org-mark-ring-goto) 20418(org-defkey org-mode-map "\C-c&" 'org-mark-ring-goto)
18643(define-key org-mode-map "\C-c\C-z" 'org-time-stamp) ; Alternative binding 20419(org-defkey org-mode-map "\C-c\C-z" 'org-time-stamp) ; Alternative binding
18644(define-key org-mode-map "\C-c." 'org-time-stamp) ; Minor-mode reserved 20420(org-defkey org-mode-map "\C-c." 'org-time-stamp) ; Minor-mode reserved
18645(define-key org-mode-map "\C-c!" 'org-time-stamp-inactive) ; Minor-mode r. 20421(org-defkey org-mode-map "\C-c!" 'org-time-stamp-inactive) ; Minor-mode r.
18646(define-key org-mode-map "\C-c," 'org-priority) ; Minor-mode reserved 20422(org-defkey org-mode-map "\C-c," 'org-priority) ; Minor-mode reserved
18647(define-key org-mode-map "\C-c\C-y" 'org-evaluate-time-range) 20423(org-defkey org-mode-map "\C-c\C-y" 'org-evaluate-time-range)
18648(define-key org-mode-map "\C-c>" 'org-goto-calendar) 20424(org-defkey org-mode-map "\C-c>" 'org-goto-calendar)
18649(define-key org-mode-map "\C-c<" 'org-date-from-calendar) 20425(org-defkey org-mode-map "\C-c<" 'org-date-from-calendar)
18650(define-key org-mode-map [(control ?,)] 'org-cycle-agenda-files) 20426(org-defkey org-mode-map [(control ?,)] 'org-cycle-agenda-files)
18651(define-key org-mode-map [(control ?\')] 'org-cycle-agenda-files) 20427(org-defkey org-mode-map [(control ?\')] 'org-cycle-agenda-files)
18652(define-key org-mode-map "\C-c[" 'org-agenda-file-to-front) 20428(org-defkey org-mode-map "\C-c[" 'org-agenda-file-to-front)
18653(define-key org-mode-map "\C-c]" 'org-remove-file) 20429(org-defkey org-mode-map "\C-c]" 'org-remove-file)
18654(define-key org-mode-map "\C-c-" 'org-table-insert-hline) 20430(org-defkey org-mode-map "\C-c-" 'org-table-insert-hline)
18655(define-key org-mode-map "\C-c^" 'org-sort) 20431(org-defkey org-mode-map "\C-c^" 'org-sort)
18656(define-key org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) 20432(org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c)
18657(define-key org-mode-map "\C-c#" 'org-update-checkbox-count) 20433(org-defkey org-mode-map "\C-c#" 'org-update-checkbox-count)
18658(define-key org-mode-map "\C-m" 'org-return) 20434(org-defkey org-mode-map "\C-m" 'org-return)
18659(define-key org-mode-map "\C-c?" 'org-table-field-info) 20435(org-defkey org-mode-map "\C-c?" 'org-table-field-info)
18660(define-key org-mode-map "\C-c " 'org-table-blank-field) 20436(org-defkey org-mode-map "\C-c " 'org-table-blank-field)
18661(define-key org-mode-map "\C-c+" 'org-table-sum) 20437(org-defkey org-mode-map "\C-c+" 'org-table-sum)
18662(define-key org-mode-map "\C-c=" 'org-table-eval-formula) 20438(org-defkey org-mode-map "\C-c=" 'org-table-eval-formula)
18663(define-key org-mode-map "\C-c'" 'org-table-edit-formulas) 20439(org-defkey org-mode-map "\C-c'" 'org-table-edit-formulas)
18664(define-key org-mode-map "\C-c`" 'org-table-edit-field) 20440(org-defkey org-mode-map "\C-c`" 'org-table-edit-field)
18665(define-key org-mode-map "\C-c|" 'org-table-create-or-convert-from-region) 20441(org-defkey org-mode-map "\C-c|" 'org-table-create-or-convert-from-region)
18666(define-key org-mode-map "\C-c*" 'org-table-recalculate) 20442(org-defkey org-mode-map "\C-c*" 'org-table-recalculate)
18667(define-key org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks) 20443(org-defkey org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks)
18668(define-key org-mode-map "\C-c~" 'org-table-create-with-table.el) 20444(org-defkey org-mode-map "\C-c~" 'org-table-create-with-table.el)
18669(define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region) 20445(org-defkey org-mode-map "\C-c\C-q" 'org-table-wrap-region)
18670(define-key org-mode-map "\C-c}" 'org-table-toggle-coordinate-overlays) 20446(org-defkey org-mode-map "\C-c}" 'org-table-toggle-coordinate-overlays)
18671(define-key org-mode-map "\C-c{" 'org-table-toggle-formula-debugger) 20447(org-defkey org-mode-map "\C-c{" 'org-table-toggle-formula-debugger)
18672(define-key org-mode-map "\C-c\C-e" 'org-export) 20448(org-defkey org-mode-map "\C-c\C-e" 'org-export)
18673(define-key org-mode-map "\C-c:" 'org-toggle-fixed-width-section) 20449(org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section)
18674 20450(org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize)
18675(define-key org-mode-map "\C-c\C-x\C-k" 'org-cut-special) 20451
18676(define-key org-mode-map "\C-c\C-x\C-w" 'org-cut-special) 20452(org-defkey org-mode-map "\C-c\C-x\C-k" 'org-cut-special)
18677(define-key org-mode-map "\C-c\C-x\M-w" 'org-copy-special) 20453(org-defkey org-mode-map "\C-c\C-x\C-w" 'org-cut-special)
18678(define-key org-mode-map "\C-c\C-x\C-y" 'org-paste-special) 20454(org-defkey org-mode-map "\C-c\C-x\M-w" 'org-copy-special)
18679 20455(org-defkey org-mode-map "\C-c\C-x\C-y" 'org-paste-special)
18680(define-key org-mode-map "\C-c\C-x\C-t" 'org-toggle-time-stamp-overlays) 20456
18681(define-key org-mode-map "\C-c\C-x\C-i" 'org-clock-in) 20457(org-defkey org-mode-map "\C-c\C-x\C-t" 'org-toggle-time-stamp-overlays)
18682(define-key org-mode-map "\C-c\C-x\C-o" 'org-clock-out) 20458(org-defkey org-mode-map "\C-c\C-x\C-i" 'org-clock-in)
18683(define-key org-mode-map "\C-c\C-x\C-x" 'org-clock-cancel) 20459(org-defkey org-mode-map "\C-c\C-x\C-o" 'org-clock-out)
18684(define-key org-mode-map "\C-c\C-x\C-d" 'org-clock-display) 20460(org-defkey org-mode-map "\C-c\C-x\C-x" 'org-clock-cancel)
18685(define-key org-mode-map "\C-c\C-x\C-r" 'org-clock-report) 20461(org-defkey org-mode-map "\C-c\C-x\C-d" 'org-clock-display)
18686(define-key org-mode-map "\C-c\C-x\C-u" 'org-dblock-update) 20462(org-defkey org-mode-map "\C-c\C-x\C-r" 'org-clock-report)
18687(define-key org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment) 20463(org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update)
18688(define-key org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox) 20464(org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment)
20465(org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox)
18689 20466
18690(when (featurep 'xemacs) 20467(when (featurep 'xemacs)
18691 (define-key org-mode-map 'button3 'popup-mode-menu)) 20468 (org-defkey org-mode-map 'button3 'popup-mode-menu))
18692 20469
18693(defsubst org-table-p () (org-at-table-p)) 20470(defsubst org-table-p () (org-at-table-p))
18694 20471
@@ -18779,7 +20556,6 @@ because, in this case the deletion might narrow the column."
18779(put 'org-delete-char 'flyspell-delayed t) 20556(put 'org-delete-char 'flyspell-delayed t)
18780(put 'org-delete-backward-char 'flyspell-delayed t) 20557(put 'org-delete-backward-char 'flyspell-delayed t)
18781 20558
18782
18783;; How to do this: Measure non-white length of current string 20559;; How to do this: Measure non-white length of current string
18784;; If equal to column width, we should realign. 20560;; If equal to column width, we should realign.
18785 20561
@@ -18790,7 +20566,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
18790 (while commands 20566 (while commands
18791 (setq old (pop commands) new (pop commands)) 20567 (setq old (pop commands) new (pop commands))
18792 (if (fboundp 'command-remapping) 20568 (if (fboundp 'command-remapping)
18793 (define-key map (vector 'remap old) new) 20569 (org-defkey map (vector 'remap old) new)
18794 (substitute-key-definition old new map global-map))))) 20570 (substitute-key-definition old new map global-map)))))
18795 20571
18796(when (eq org-enable-table-editor 'optimized) 20572(when (eq org-enable-table-editor 'optimized)
@@ -18800,7 +20576,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
18800 'self-insert-command 'org-self-insert-command 20576 'self-insert-command 'org-self-insert-command
18801 'delete-char 'org-delete-char 20577 'delete-char 'org-delete-char
18802 'delete-backward-char 'org-delete-backward-char) 20578 'delete-backward-char 'org-delete-backward-char)
18803 (define-key org-mode-map "|" 'org-force-self-insert)) 20579 (org-defkey org-mode-map "|" 'org-force-self-insert))
18804 20580
18805(defun org-shiftcursor-error () 20581(defun org-shiftcursor-error ()
18806 "Throw an error because Shift-Cursor command was applied in wrong context." 20582 "Throw an error because Shift-Cursor command was applied in wrong context."
@@ -18821,7 +20597,8 @@ See the individual commands for more information."
18821 20597
18822(defun org-shiftmetaleft () 20598(defun org-shiftmetaleft ()
18823 "Promote subtree or delete table column. 20599 "Promote subtree or delete table column.
18824Calls `org-promote-subtree' or `org-table-delete-column', depending on context. 20600Calls `org-promote-subtree', `org-outdent-item',
20601or `org-table-delete-column', depending on context.
18825See the individual commands for more information." 20602See the individual commands for more information."
18826 (interactive) 20603 (interactive)
18827 (cond 20604 (cond
@@ -18832,7 +20609,8 @@ See the individual commands for more information."
18832 20609
18833(defun org-shiftmetaright () 20610(defun org-shiftmetaright ()
18834 "Demote subtree or insert table column. 20611 "Demote subtree or insert table column.
18835Calls `org-demote-subtree' or `org-table-insert-column', depending on context. 20612Calls `org-demote-subtree', `org-indent-item',
20613or `org-table-insert-column', depending on context.
18836See the individual commands for more information." 20614See the individual commands for more information."
18837 (interactive) 20615 (interactive)
18838 (cond 20616 (cond
@@ -18916,8 +20694,8 @@ commands for more information."
18916 20694
18917(defun org-shiftup (&optional arg) 20695(defun org-shiftup (&optional arg)
18918 "Increase item in timestamp or increase priority of current headline. 20696 "Increase item in timestamp or increase priority of current headline.
18919Calls `org-timestamp-up' or `org-priority-up', depending on context. 20697Calls `org-timestamp-up' or `org-priority-up', or `org-previous-item',
18920See the individual commands for more information." 20698depending on context. See the individual commands for more information."
18921 (interactive "P") 20699 (interactive "P")
18922 (cond 20700 (cond
18923 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up)) 20701 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up))
@@ -18927,8 +20705,8 @@ See the individual commands for more information."
18927 20705
18928(defun org-shiftdown (&optional arg) 20706(defun org-shiftdown (&optional arg)
18929 "Decrease item in timestamp or decrease priority of current headline. 20707 "Decrease item in timestamp or decrease priority of current headline.
18930Calls `org-timestamp-down' or `org-priority-down', depending on context. 20708Calls `org-timestamp-down' or `org-priority-down', or `org-next-item'
18931See the individual commands for more information." 20709depending on context. See the individual commands for more information."
18932 (interactive "P") 20710 (interactive "P")
18933 (cond 20711 (cond
18934 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down)) 20712 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down))
@@ -18951,6 +20729,27 @@ See the individual commands for more information."
18951 ((org-on-heading-p) (org-call-with-arg 'org-todo 'left)) 20729 ((org-on-heading-p) (org-call-with-arg 'org-todo 'left))
18952 (t (org-shiftcursor-error)))) 20730 (t (org-shiftcursor-error))))
18953 20731
20732(defun org-shiftcontrolright ()
20733 "Switch to next TODO set."
20734 (interactive)
20735 (cond
20736 ((org-on-heading-p) (org-call-with-arg 'org-todo 'nextset))
20737 (t (org-shiftcursor-error))))
20738
20739(defun org-shiftcontrolleft ()
20740 "Switch to previous TODO set."
20741 (interactive)
20742 (cond
20743 ((org-on-heading-p) (org-call-with-arg 'org-todo 'previousset))
20744 (t (org-shiftcursor-error))))
20745
20746(defun org-ctrl-c-ret ()
20747 "Call `org-table-hline-and-move' or `org-insert-heading' dep. on context."
20748 (interactive)
20749 (cond
20750 ((org-at-table-p) (call-interactively 'org-table-hline-and-move))
20751 (t (call-interactively 'org-insert-heading))))
20752
18954(defun org-copy-special () 20753(defun org-copy-special ()
18955 "Copy region in table or copy current subtree. 20754 "Copy region in table or copy current subtree.
18956Calls `org-table-copy' or `org-copy-subtree', depending on context. 20755Calls `org-table-copy' or `org-copy-subtree', depending on context.
@@ -19159,7 +20958,11 @@ See the individual commands for more information."
19159 ["Next Same Level" outline-forward-same-level t] 20958 ["Next Same Level" outline-forward-same-level t]
19160 ["Previous Same Level" outline-backward-same-level t] 20959 ["Previous Same Level" outline-backward-same-level t]
19161 "--" 20960 "--"
19162 ["Jump" org-goto t]) 20961 ["Jump" org-goto t]
20962 "--"
20963 ["C-a finds headline start"
20964 (setq org-special-ctrl-a (not org-special-ctrl-a))
20965 :style toggle :selected org-special-ctrl-a])
19163 ("Edit Structure" 20966 ("Edit Structure"
19164 ["Move Subtree Up" org-shiftmetaup (not (org-at-table-p))] 20967 ["Move Subtree Up" org-shiftmetaup (not (org-at-table-p))]
19165 ["Move Subtree Down" org-shiftmetadown (not (org-at-table-p))] 20968 ["Move Subtree Down" org-shiftmetadown (not (org-at-table-p))]
@@ -19177,6 +20980,8 @@ See the individual commands for more information."
19177 "--" 20980 "--"
19178 ["Convert to odd levels" org-convert-to-odd-levels t] 20981 ["Convert to odd levels" org-convert-to-odd-levels t]
19179 ["Convert to odd/even levels" org-convert-to-oddeven-levels t]) 20982 ["Convert to odd/even levels" org-convert-to-oddeven-levels t])
20983 ("Editing"
20984 ["Emphasis..." org-emphasize t])
19180 ("Archive" 20985 ("Archive"
19181 ["Toggle ARCHIVE tag" org-toggle-archive-tag t] 20986 ["Toggle ARCHIVE tag" org-toggle-archive-tag t]
19182; ["Check and Tag Children" (org-toggle-archive-tag (4)) 20987; ["Check and Tag Children" (org-toggle-archive-tag (4))
@@ -19202,7 +21007,9 @@ See the individual commands for more information."
19202 ("Select keyword" 21007 ("Select keyword"
19203 ["Next keyword" org-shiftright (org-on-heading-p)] 21008 ["Next keyword" org-shiftright (org-on-heading-p)]
19204 ["Previous keyword" org-shiftleft (org-on-heading-p)] 21009 ["Previous keyword" org-shiftleft (org-on-heading-p)]
19205 ["Complete Keyword" org-complete (assq :todo-keyword (org-context))]) 21010 ["Complete Keyword" org-complete (assq :todo-keyword (org-context))]
21011 ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))]
21012 ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))])
19206 ["Show TODO Tree" org-show-todo-tree t] 21013 ["Show TODO Tree" org-show-todo-tree t]
19207 ["Global TODO list" org-todo-list t] 21014 ["Global TODO list" org-todo-list t]
19208 "--" 21015 "--"
@@ -19210,6 +21017,7 @@ See the individual commands for more information."
19210 ["Priority Up" org-shiftup t] 21017 ["Priority Up" org-shiftup t]
19211 ["Priority Down" org-shiftdown t] 21018 ["Priority Down" org-shiftdown t]
19212 "--" 21019 "--"
21020 ;; FIXME: why is this still here????
19213; ["Insert Checkbox" org-insert-todo-heading (org-in-item-p)] 21021; ["Insert Checkbox" org-insert-todo-heading (org-in-item-p)]
19214; ["Toggle Checkbox" org-ctrl-c-ctrl-c (org-at-item-checkbox-p)] 21022; ["Toggle Checkbox" org-ctrl-c-ctrl-c (org-at-item-checkbox-p)]
19215; ["Insert [n/m] cookie" (progn (insert "[/]") (org-update-checkbox-count)) 21023; ["Insert [n/m] cookie" (progn (insert "[/]") (org-update-checkbox-count))
@@ -19245,7 +21053,7 @@ See the individual commands for more information."
19245 ["Record DONE time" 21053 ["Record DONE time"
19246 (progn (setq org-log-done (not org-log-done)) 21054 (progn (setq org-log-done (not org-log-done))
19247 (message "Switching to %s will %s record a timestamp" 21055 (message "Switching to %s will %s record a timestamp"
19248 org-done-string 21056 (car org-done-keywords)
19249 (if org-log-done "automatically" "not"))) 21057 (if org-log-done "automatically" "not")))
19250 :style toggle :selected org-log-done]) 21058 :style toggle :selected org-log-done])
19251 "--" 21059 "--"
@@ -19297,15 +21105,6 @@ See the individual commands for more information."
19297 ["Refresh setup" org-mode-restart t] 21105 ["Refresh setup" org-mode-restart t]
19298 )) 21106 ))
19299 21107
19300(defun org-toggle-log-option (type)
19301 (if (not (listp org-log-done)) (setq org-log-done nil))
19302 (if (memq type org-log-done)
19303 (setq org-log-done (delq type org-log-done))
19304 (add-to-list 'org-log-done type)))
19305
19306(defun org-check-log-option (type)
19307 (and (listp org-log-done) (memq type org-log-done)))
19308
19309(defun org-info (&optional node) 21108(defun org-info (&optional node)
19310 "Read documentation for Org-mode in the info system. 21109 "Read documentation for Org-mode in the info system.
19311With optional NODE, go directly to that node." 21110With optional NODE, go directly to that node."
@@ -19394,7 +21193,7 @@ and :keyword."
19394 (p (point)) clist o) 21193 (p (point)) clist o)
19395 ;; First the large context 21194 ;; First the large context
19396 (cond 21195 (cond
19397 ((org-on-heading-p) 21196 ((org-on-heading-p t)
19398 (push (list :headline (point-at-bol) (point-at-eol)) clist) 21197 (push (list :headline (point-at-bol) (point-at-eol)) clist)
19399 (when (progn 21198 (when (progn
19400 (beginning-of-line 1) 21199 (beginning-of-line 1)
@@ -19404,7 +21203,7 @@ and :keyword."
19404 (push (org-point-in-group p 4 :tags) clist)) 21203 (push (org-point-in-group p 4 :tags) clist))
19405 (goto-char p) 21204 (goto-char p)
19406 (skip-chars-backward "^[\n\r \t") (or (eobp) (backward-char 1)) 21205 (skip-chars-backward "^[\n\r \t") (or (eobp) (backward-char 1))
19407 (if (looking-at "\\[#[A-Z]\\]") 21206 (if (looking-at "\\[#[A-Z0-9]\\]")
19408 (push (org-point-in-group p 0 :priority) clist))) 21207 (push (org-point-in-group p 0 :priority) clist)))
19409 21208
19410 ((org-at-item-p) 21209 ((org-at-item-p)
@@ -19459,6 +21258,7 @@ and :keyword."
19459 (setq clist (nreverse (delq nil clist))) 21258 (setq clist (nreverse (delq nil clist)))
19460 clist)) 21259 clist))
19461 21260
21261;; FIXME Compare with at-regexp-p
19462(defun org-in-regexp (re &optional nlines visually) 21262(defun org-in-regexp (re &optional nlines visually)
19463 "Check if point is inside a match of regexp. 21263 "Check if point is inside a match of regexp.
19464Normally only the current line is checked, but you can include NLINES extra 21264Normally only the current line is checked, but you can include NLINES extra
@@ -19472,10 +21272,34 @@ really on, so that the block visually is on the match."
19472 (save-excursion 21272 (save-excursion
19473 (beginning-of-line (- 1 (or nlines 0))) 21273 (beginning-of-line (- 1 (or nlines 0)))
19474 (while (re-search-forward re eol t) 21274 (while (re-search-forward re eol t)
19475 (if (and (<= (match-beginning 0) pos) 21275 (if (and (<= (match-beginning 0) pos)
19476 (>= (+ inc (match-end 0)) pos)) 21276 (>= (+ inc (match-end 0)) pos))
19477 (throw 'exit (cons (match-beginning 0) (match-end 0))))))))) 21277 (throw 'exit (cons (match-beginning 0) (match-end 0)))))))))
19478 21278
21279(defun org-at-regexp-p (regexp)
21280 "Is point inside a match of REGEXP in the current line?"
21281 (catch 'exit
21282 (save-excursion
21283 (let ((pos (point)) (end (point-at-eol)))
21284 (beginning-of-line 1)
21285 (while (re-search-forward regexp end t)
21286 (if (and (<= (match-beginning 0) pos)
21287 (>= (match-end 0) pos))
21288 (throw 'exit t)))
21289 nil))))
21290
21291(defun org-uniquify (list)
21292 "Remove duplicate elements from LIST."
21293 (let (res)
21294 (mapc (lambda (x) (add-to-list 'res x 'append)) list)
21295 res))
21296
21297(defun org-delete-all (elts list)
21298 "Remove all elements in ELTS from LIST."
21299 (while elts
21300 (setq list (delete (pop elts) list)))
21301 list)
21302
19479(defun org-point-in-group (point group &optional context) 21303(defun org-point-in-group (point group &optional context)
19480 "Check if POINT is in match-group GROUP. 21304 "Check if POINT is in match-group GROUP.
19481If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the 21305If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the
@@ -19535,7 +21359,7 @@ The sequences in STRING may contain normal field width and padding information,
19535for example \"%-5s\". Replacements happen in the sequence given by TABLE, 21359for example \"%-5s\". Replacements happen in the sequence given by TABLE,
19536so values can contain further %-escapes if they are define later in TABLE." 21360so values can contain further %-escapes if they are define later in TABLE."
19537 (let ((case-fold-search nil) 21361 (let ((case-fold-search nil)
19538 e re rpl) 21362 e re rpl)
19539 (while (setq e (pop table)) 21363 (while (setq e (pop table))
19540 (setq re (concat "%-?[0-9.]*" (substring (car e) 1))) 21364 (setq re (concat "%-?[0-9.]*" (substring (car e) 1)))
19541 (while (string-match re string) 21365 (while (string-match re string)
@@ -19555,27 +21379,49 @@ Counting starts at 1."
19555 (setq c (1+ c))) 21379 (setq c (1+ c)))
19556 (nreverse rtn))) 21380 (nreverse rtn)))
19557 21381
19558(defun org-at-regexp-p (regexp)
19559 "Is point inside a match of REGEXP in the current line?"
19560 (catch 'exit
19561 (save-excursion
19562 (let ((pos (point)) (end (point-at-eol)))
19563 (beginning-of-line 1)
19564 (while (re-search-forward regexp end t)
19565 (if (and (<= (match-beginning 0) pos)
19566 (>= (match-end 0) pos))
19567 (throw 'exit t)))
19568 nil))))
19569
19570(defun org-find-base-buffer-visiting (file) 21382(defun org-find-base-buffer-visiting (file)
19571 "Like `find-buffer-visiting' but alway return the base buffer and 21383 "Like `find-buffer-visiting' but alway return the base buffer and
19572not an indirect buffer" 21384not an indirect buffer"
19573 (let ((buf (find-buffer-visiting file))) 21385 (let ((buf (find-buffer-visiting file)))
19574 (or (buffer-base-buffer buf) buf))) 21386 (or (buffer-base-buffer buf) buf)))
19575 21387
21388(defun org-image-file-name-regexp ()
21389 "Return regexp matching the file names of images."
21390 (if (fboundp 'image-file-name-regexp)
21391 (image-file-name-regexp)
21392 (let ((image-file-name-extensions
21393 '("png" "jpeg" "jpg" "gif" "tiff" "tif"
21394 "xbm" "xpm" "pbm" "pgm" "ppm")))
21395 (concat "\\."
21396 (regexp-opt (nconc (mapcar 'upcase
21397 image-file-name-extensions)
21398 image-file-name-extensions)
21399 t)
21400 "\\'"))))
21401
21402(defun org-file-image-p (file)
21403 "Return non-nil if FILE is an image."
21404 (save-match-data
21405 (string-match (org-image-file-name-regexp) file)))
21406
19576;;; Paragraph filling stuff. 21407;;; Paragraph filling stuff.
19577;; We want this to be just right, so use the full arsenal. 21408;; We want this to be just right, so use the full arsenal.
19578;; FIXME: configure filladapt for XEmacs 21409
21410(defun org-indent-line-function ()
21411 "Indent line like previous, but further if previous was headline or item."
21412 (interactive)
21413 (let ((column (save-excursion
21414 (beginning-of-line)
21415 (if (looking-at "#") 0
21416 (skip-chars-backward "\n \t")
21417 (beginning-of-line)
21418 (if (or (looking-at "\\*+[ \t]+")
21419 (looking-at "[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)"))
21420 (progn (goto-char (match-end 0)) (current-column))
21421 (current-indentation))))))
21422 (if (<= (current-column) (current-indentation))
21423 (indent-line-to column)
21424 (save-excursion (indent-line-to column)))))
19579 21425
19580(defun org-set-autofill-regexps () 21426(defun org-set-autofill-regexps ()
19581 (interactive) 21427 (interactive)
@@ -19584,6 +21430,7 @@ not an indirect buffer"
19584 ;; fill the headline as well. 21430 ;; fill the headline as well.
19585 (org-set-local 'comment-start-skip "^#+[ \t]*") 21431 (org-set-local 'comment-start-skip "^#+[ \t]*")
19586 (org-set-local 'paragraph-separate "\f\\|\\*\\|[ ]*$\\|[ \t]*[:|]") 21432 (org-set-local 'paragraph-separate "\f\\|\\*\\|[ ]*$\\|[ \t]*[:|]")
21433;; FIXME!!!!!!! (org-set-local 'paragraph-separate "\f\\|[ ]*$")
19587 ;; The paragraph starter includes hand-formatted lists. 21434 ;; The paragraph starter includes hand-formatted lists.
19588 (org-set-local 'paragraph-start 21435 (org-set-local 'paragraph-start
19589 "\f\\|[ ]*$\\|\\([*\f]+\\)\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]") 21436 "\f\\|[ ]*$\\|\\([*\f]+\\)\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]")
@@ -19627,30 +21474,12 @@ In particular, this makes sure hanging paragraphs for hand-formatted lists
19627work correctly." 21474work correctly."
19628 (cond ((looking-at "#[ \t]+") 21475 (cond ((looking-at "#[ \t]+")
19629 (match-string 0)) 21476 (match-string 0))
19630 ((looking-at " *\\([-*+] \\|[0-9]+[.)] \\)?") 21477 ((looking-at "[ \t]*\\([-*+] \\|[0-9]+[.)] \\)?")
19631 (make-string (- (match-end 0) (match-beginning 0)) ?\ )) 21478 (save-excursion
21479 (goto-char (match-end 0))
21480 (make-string (current-column) ?\ )))
19632 (t nil))) 21481 (t nil)))
19633 21482
19634
19635(defun org-image-file-name-regexp ()
19636 "Return regexp matching the file names of images."
19637 (if (fboundp 'image-file-name-regexp)
19638 (image-file-name-regexp)
19639 (let ((image-file-name-extensions
19640 '("png" "jpeg" "jpg" "gif" "tiff" "tif"
19641 "xbm" "xpm" "pbm" "pgm" "ppm")))
19642 (concat "\\."
19643 (regexp-opt (nconc (mapcar 'upcase
19644 image-file-name-extensions)
19645 image-file-name-extensions)
19646 t)
19647 "\\'"))))
19648
19649(defun org-file-image-p (file)
19650 "Return non-nil if FILE is an image."
19651 (save-match-data
19652 (string-match (org-image-file-name-regexp) file)))
19653
19654;;;; Functions extending outline functionality 21483;;;; Functions extending outline functionality
19655 21484
19656;; C-a should go to the beginning of a *visible* line, also in the 21485;; C-a should go to the beginning of a *visible* line, also in the
@@ -19659,15 +21488,22 @@ work correctly."
19659 "Go to the beginning of the current line. If that is invisible, continue 21488 "Go to the beginning of the current line. If that is invisible, continue
19660to a visible line beginning. This makes the function of C-a more intuitive." 21489to a visible line beginning. This makes the function of C-a more intuitive."
19661 (interactive) 21490 (interactive)
19662 (beginning-of-line 1) 21491 (let ((pos (point)))
19663 (if (bobp) 21492 (beginning-of-line 1)
19664 nil 21493 (if (bobp)
19665 (backward-char 1) 21494 nil
19666 (if (org-invisible-p) 21495 (backward-char 1)
19667 (while (and (not (bobp)) (org-invisible-p)) 21496 (if (org-invisible-p)
19668 (backward-char 1) 21497 (while (and (not (bobp)) (org-invisible-p))
19669 (beginning-of-line 1)) 21498 (backward-char 1)
19670 (forward-char 1)))) 21499 (beginning-of-line 1))
21500 (forward-char 1)))
21501 (when (and org-special-ctrl-a (looking-at org-todo-line-regexp)
21502 (= (char-after (match-end 1)) ?\ ))
21503 (goto-char
21504 (cond ((> pos (match-beginning 3)) (match-beginning 3))
21505 ((= pos (point)) (match-beginning 3))
21506 (t (point)))))))
19671 21507
19672(define-key org-mode-map "\C-a" 'org-beginning-of-line) 21508(define-key org-mode-map "\C-a" 'org-beginning-of-line)
19673 21509
@@ -19689,6 +21525,9 @@ to a visible line beginning. This makes the function of C-a more intuitive."
19689 21525
19690(defalias 'org-back-to-heading 'outline-back-to-heading) 21526(defalias 'org-back-to-heading 'outline-back-to-heading)
19691(defalias 'org-on-heading-p 'outline-on-heading-p) 21527(defalias 'org-on-heading-p 'outline-on-heading-p)
21528(defalias 'org-at-heading-p 'outline-on-heading-p)
21529(defun org-at-heading-or-item-p ()
21530 (or (org-on-heading-p) (org-at-item-p)))
19692 21531
19693(defun org-on-target-p () 21532(defun org-on-target-p ()
19694 (or (org-in-regexp org-radio-target-regexp) 21533 (or (org-in-regexp org-radio-target-regexp)
@@ -19751,7 +21590,7 @@ When ENTRY is non-nil, show the entire entry."
19751 (save-excursion (outline-end-of-heading) (point)) 21590 (save-excursion (outline-end-of-heading) (point))
19752 flag)))) 21591 flag))))
19753 21592
19754(defun org-end-of-subtree (&optional invisible-OK) 21593(defun org-end-of-subtree (&optional invisible-OK to-heading)
19755 ;; This is an exact copy of the original function, but it uses 21594 ;; This is an exact copy of the original function, but it uses
19756 ;; `org-back-to-heading', to make it work also in invisible 21595 ;; `org-back-to-heading', to make it work also in invisible
19757 ;; trees. And is uses an invisible-OK argument. 21596 ;; trees. And is uses an invisible-OK argument.
@@ -19763,13 +21602,14 @@ When ENTRY is non-nil, show the entire entry."
19763 (or first (> (funcall outline-level) level))) 21602 (or first (> (funcall outline-level) level)))
19764 (setq first nil) 21603 (setq first nil)
19765 (outline-next-heading)) 21604 (outline-next-heading))
19766 (if (memq (preceding-char) '(?\n ?\^M)) 21605 (unless to-heading
19767 (progn 21606 (if (memq (preceding-char) '(?\n ?\^M))
19768 ;; Go to end of line before heading 21607 (progn
19769 (forward-char -1) 21608 ;; Go to end of line before heading
19770 (if (memq (preceding-char) '(?\n ?\^M)) 21609 (forward-char -1)
19771 ;; leave blank line before heading 21610 (if (memq (preceding-char) '(?\n ?\^M))
19772 (forward-char -1))))) 21611 ;; leave blank line before heading
21612 (forward-char -1))))))
19773 (point)) 21613 (point))
19774 21614
19775(defun org-show-subtree () 21615(defun org-show-subtree ()
@@ -19824,7 +21664,13 @@ Show the heading too, if it is currently invisible."
19824 (remove-hook 'post-command-hook 'org-isearch-post-command 'local) 21664 (remove-hook 'post-command-hook 'org-isearch-post-command 'local)
19825 (org-show-context 'isearch)) 21665 (org-show-context 'isearch))
19826 21666
19827;;;; Repair problems with some other packages 21667
21668;;;; Address problems with some other packages
21669
21670;; Make flyspell not check words in links, to not mess up our keymap
21671(defun org-mode-flyspell-verify ()
21672 "Don't let flyspell put overlays at active buttons."
21673 (not (get-text-property (point) 'keymap)))
19828 21674
19829;; Make `bookmark-jump' show the jump location if it was hidden. 21675;; Make `bookmark-jump' show the jump location if it was hidden.
19830(eval-after-load "bookmark" 21676(eval-after-load "bookmark"
@@ -19850,6 +21696,26 @@ Show the heading too, if it is currently invisible."
19850 21696
19851;;;; Experimental code 21697;;;; Experimental code
19852 21698
21699(defun org-closed-in-range ()
21700 "Sparse tree of items closed in a certain time range.
21701Still experimental, may disappear in the furture."
21702 (interactive)
21703 ;; Get the time interval from the user.
21704 (let* ((time1 (time-to-seconds
21705 (org-read-date nil 'to-time nil "Starting date: ")))
21706 (time2 (time-to-seconds
21707 (org-read-date nil 'to-time nil "End date:")))
21708 ;; callback function
21709 (callback (lambda ()
21710 (let ((time
21711 (time-to-seconds
21712 (apply 'encode-time
21713 (org-parse-time-string
21714 (match-string 1))))))
21715 ;; check if time in interval
21716 (and (>= time time1) (<= time time2))))))
21717 ;; make tree, check each match with the callback
21718 (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback)))
19853 21719
19854;;;; Finish up 21720;;;; Finish up
19855 21721