aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorCarsten Dominik2007-08-22 11:49:10 +0000
committerCarsten Dominik2007-08-22 11:49:10 +0000
commit48aaad2d38c90e5214b0efa8250e2963401ec3d8 (patch)
tree4a32a8eb0eb9eeeefd784fcda4293ba44bf07e67
parentf50236f65b6602b1b6e115120a7f86ecab185029 (diff)
downloademacs-48aaad2d38c90e5214b0efa8250e2963401ec3d8.tar.gz
emacs-48aaad2d38c90e5214b0efa8250e2963401ec3d8.zip
* textmodes/org.el (org-agenda-skip): Allow a form for
`org-agenda-skip-function'. (org-agenda-redo): Re-use local settings. (org-agenda): Store local settings. (org-agenda-deadline-faces): New option. (org-agenda-deadline-face): New function. (org-agenda-get-deadlines, org-agenda-get-scheduled): Also handle entries on their due date. (org-agenda-get-timestamps): No longer handle the due dates of schedules and deadline items. (org-insert-link-global, org-open-at-point-global): New commands. (org-export-as-ascii): Call `org-cleaned-string-for-export' with a :for-ascii parameter. (org-skip-comments): Function removed. (org-cleaned-string-for-export): Handle special table lines. (org-global-properties): New option. (org-entry-get-with-inheritance): Check global properties. (org-local-properties): New variable. (org-set-regexps-and-options): Find the #+PROPERTY line. (org-link-types): Change type into variable (was constant). (org-make-link-regexps): New function. (org-link-re-with-space, org-link-re-with-space2) (org-angle-link-re, org-plain-link-re, org-bracket-link-regexp) (org-bracket-link-analytic-regexp, org-any-link-re): Creation of these regular expressions happens now in the function `org-make-link-regexps'. (org-store-link): Call the functions in `org-store-link-functions'. (org-add-link-type): New function. (org-store-link-functions): New variable. (org-activate-tags): Force matches to be in headlines. (org-batch-store-agenda-views): Fix bug with killing agenda buffer. (org-columns-display-here): Make sure this works in a narrowed buffer by checking for point-min. (org-columns-display-here): Make the rest of the line intangible, so that point never can be there. (org-cleaned-string-for-export): Use `with-current-buffer'. (org-replace-region-by-html): Use `with-current-buffer'. (org-unfontify-region, org-do-occur, org-columns-display-here) (org-columns-remove-overlays, org-columns-quit) (org-columns-edit-value, org-columns-next-allowed-value) (org-eval-in-calendar, org-agenda-undo, org-no-read-only) (org-finalize-agenda, org-remove-subtree-entries-from-agenda) (org-agenda-todo, org-agenda-change-all-lines) (org-agenda-align-tags, org-agenda-priority) (org-agenda-set-tags, org-agenda-toggle-archive-tag) (org-agenda-show-new-time, org-cleaned-string-for-export) (org-export-grab-title-from-buffer): (org-export-as-ascii, org-export-as-html): Use `inhibit-read-only' instead of `buffer-read-only'. (org-export-as-html): Set `coding-system-for-write'. (org-remember-store-without-prompt): New option. (org-archive-subtree): Fixed bug with modifying TODO keyword. (org-beginning-of-line): Also treat C-a special in items. (org-table-convert-refs-to-rc): Fixed problem with column reference after "..". (org-columns-compute): Don't mark buffer modified because of text properties. (org-batch-store-agenda-views): Use the variable `default-directory', not the function. (org-clock-out-if-current): Respect `org-clock-out-when-done'. (org-clock-out-when-done): New option. (org-html-entities): Added HTML entities for smileys.
Diffstat
-rw-r--r--lisp/ChangeLog3
-rw-r--r--lisp/textmodes/org.el1283
2 files changed, 883 insertions, 403 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index aca979b4912..9ef7f409184 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,8 @@
12007-08-22 Carsten Dominik <dominik@science.uva.nl> 12007-08-22 Carsten Dominik <dominik@science.uva.nl>
2 2
3 * textmodes/org-publish.el (org-publish-org-to-latex): New
4 function.
5
3 * textmodes/org.el (org-agenda-skip): Allow a form for 6 * textmodes/org.el (org-agenda-skip): Allow a form for
4 `org-agenda-skip-function'. 7 `org-agenda-skip-function'.
5 (org-agenda-redo): Re-use local settings. 8 (org-agenda-redo): Re-use local settings.
diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el
index 35591cba168..629a847d8eb 100644
--- a/lisp/textmodes/org.el
+++ b/lisp/textmodes/org.el
@@ -5,13 +5,13 @@
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: 5.03b 8;; Version: 5.05
9;; 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11;; 11;;
12;; GNU Emacs is free software; you can redistribute it and/or modify 12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by 13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 3, or (at your option) 14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version. 15;; any later version.
16 16
17;; GNU Emacs is distributed in the hope that it will be useful, 17;; GNU Emacs is distributed in the hope that it will be useful,
@@ -83,7 +83,7 @@
83 83
84;;; Version 84;;; Version
85 85
86(defconst org-version "5.03b" 86(defconst org-version "5.05"
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)
@@ -491,9 +491,10 @@ the values `folded', `children', or `subtree'."
491 491
492 492
493(defcustom org-special-ctrl-a/e nil 493(defcustom org-special-ctrl-a/e nil
494 "Non-nil means `C-a' and `C-e' behave specially in headlines. 494 "Non-nil means `C-a' and `C-e' behave specially in headlines and items.
495When set, `C-a' will bring back the cursor to the beginning of the 495When set, `C-a' will bring back the cursor to the beginning of the
496headline text, i.e. after the stars and after a possible TODO keyword. 496headline text, i.e. after the stars and after a possible TODO keyword.
497In an item, this will be the position after the bullet.
497When the cursor is already at that position, another `C-a' will bring 498When the cursor is already at that position, another `C-a' will bring
498it to the beginning of the line. 499it to the beginning of the line.
499`C-e' will jump to the end of the headline, ignoring the presence of tags 500`C-e' will jump to the end of the headline, ignoring the presence of tags
@@ -699,9 +700,14 @@ line like
699 :type 'string) 700 :type 'string)
700 701
701(defcustom org-archive-mark-done t 702(defcustom org-archive-mark-done t
702 "Non-nil means, mark entries as DONE when they are moved to the archive file." 703 "Non-nil means, mark entries as DONE when they are moved to the archive file.
704This can be a string to set the keyword to use. When t, Org-mode will
705use the first keyword in its list that means done."
703 :group 'org-archive 706 :group 'org-archive
704 :type 'boolean) 707 :type '(choice
708 (const :tag "No" nil)
709 (const :tag "Yes" t)
710 (string :tag "Use this keyword")))
705 711
706(defcustom org-archive-stamp-time t 712(defcustom org-archive-stamp-time t
707 "Non-nil means, add a time stamp to entries moved to an archive file." 713 "Non-nil means, add a time stamp to entries moved to an archive file."
@@ -796,7 +802,7 @@ table, obtained by prompting the user."
796 :type 'string) 802 :type 'string)
797 803
798(defcustom org-table-number-regexp 804(defcustom org-table-number-regexp
799 "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\)$" 805 "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$"
800 "Regular expression for recognizing numbers in table columns. 806 "Regular expression for recognizing numbers in table columns.
801If a table column contains mostly numbers, it will be aligned to the 807If a table column contains mostly numbers, it will be aligned to the
802right. If not, it will be aligned to the left. 808right. If not, it will be aligned to the left.
@@ -821,7 +827,7 @@ Other options offered by the customize interface are more restrictive."
821 (const :tag "Exponential, Floating point, Integer" 827 (const :tag "Exponential, Floating point, Integer"
822 "^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$") 828 "^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$")
823 (const :tag "Very General Number-Like, including hex" 829 (const :tag "Very General Number-Like, including hex"
824 "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\)$") 830 "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$")
825 (string :tag "Regexp:"))) 831 (string :tag "Regexp:")))
826 832
827(defcustom org-table-number-fraction 0.5 833(defcustom org-table-number-fraction 0.5
@@ -1336,6 +1342,15 @@ You can set this on a per-template basis with the variable
1336 (const :tag "Default from remember-data-file" nil) 1342 (const :tag "Default from remember-data-file" nil)
1337 file)) 1343 file))
1338 1344
1345(defcustom org-remember-store-without-prompt nil
1346 "Non-nil means, `C-c C-c' stores remember note without further promts.
1347In this case, you need `C-u C-c C-c' to get the prompts for
1348note file and headline.
1349When this variable is nil, `C-c C-c' give you the prompts, and
1350`C-u C-c C-c' trigger the fasttrack."
1351 :group 'org-remember
1352 :type 'boolean)
1353
1339(defcustom org-remember-default-headline "" 1354(defcustom org-remember-default-headline ""
1340 "The headline that should be the default location in the notes file. 1355 "The headline that should be the default location in the notes file.
1341When filing remember notes, the cursor will start at that position. 1356When filing remember notes, the cursor will start at that position.
@@ -1546,7 +1561,7 @@ When nil, only the date will be recorded."
1546 (state . "State %-12s %t") 1561 (state . "State %-12s %t")
1547 (clock-out . "")) 1562 (clock-out . ""))
1548 "Headings for notes added when clocking out or closing TODO items. 1563 "Headings for notes added when clocking out or closing TODO items.
1549The value is an alist, with the car being a sympol indicating the note 1564The value is an alist, with the car being a symbol indicating the note
1550context, and the cdr is the heading to be used. The heading may also be the 1565context, and the cdr is the heading to be used. The heading may also be the
1551empty string. 1566empty string.
1552%t in the heading will be replaced by a time stamp. 1567%t in the heading will be replaced by a time stamp.
@@ -1562,6 +1577,13 @@ empty string.
1562 state) string) 1577 state) string)
1563 (cons (const :tag "Heading when clocking out" clock-out) string))) 1578 (cons (const :tag "Heading when clocking out" clock-out) string)))
1564 1579
1580(defcustom org-log-states-order-reversed t
1581 "Non-nil means, the latest state change note will be directly after heading.
1582When nil, the notes will be orderer according to time."
1583 :group 'org-todo
1584 :group 'org-progress
1585 :type 'boolean)
1586
1565(defcustom org-log-repeat t 1587(defcustom org-log-repeat t
1566 "Non-nil means, prompt for a note when REPEAT is resetting a TODO entry. 1588 "Non-nil means, prompt for a note when REPEAT is resetting a TODO entry.
1567When nil, no note will be taken." 1589When nil, no note will be taken."
@@ -1569,6 +1591,13 @@ When nil, no note will be taken."
1569 :group 'org-progress 1591 :group 'org-progress
1570 :type 'boolean) 1592 :type 'boolean)
1571 1593
1594(defcustom org-clock-out-when-done t
1595 "When t, the clock will be stopped when the relevant entry is marked DONE.
1596Nil means, clock will keep running until stopped explicitly with
1597`C-c C-x C-o', or until the clock is started in a different item."
1598 :group 'org-progress
1599 :type 'boolean)
1600
1572(defgroup org-priorities nil 1601(defgroup org-priorities nil
1573 "Priorities in Org-mode." 1602 "Priorities in Org-mode."
1574 :tag "Org Priorities" 1603 :tag "Org Priorities"
@@ -1605,6 +1634,15 @@ the time stamp will always be forced into the second line."
1605 :group 'org-time 1634 :group 'org-time
1606 :type 'boolean) 1635 :type 'boolean)
1607 1636
1637(defcustom org-insert-labeled-timestamps-before-properties-drawer t
1638 "Non-nil means, always insert planning info before property drawer.
1639When this is nil and there is a property drawer *directly* after
1640the headline, move the planning info into the drawer. If the property
1641drawer separated from the headline by at least one line, this variable
1642has no effect."
1643 :group 'org-time
1644 :type 'boolean)
1645
1608(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") 1646(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>")
1609 "Formats for `format-time-string' which are used for time stamps. 1647 "Formats for `format-time-string' which are used for time stamps.
1610It is not recommended to change this constant.") 1648It is not recommended to change this constant.")
@@ -1778,6 +1816,20 @@ This variable can be set on the per-file basis by inserting a line
1778 :group 'org-properties 1816 :group 'org-properties
1779 :type 'string) 1817 :type 'string)
1780 1818
1819(defcustom org-global-properties nil
1820 "List of property/value pairs that can be inherited by any entry.
1821You can set buffer-local values for this by adding lines like
1822
1823#+PROPERTY: NAME VALUE"
1824 :group 'org-properties
1825 :type '(repeat
1826 (cons (string :tag "Property")
1827 (string :tag "Value"))))
1828
1829(defvar org-local-properties nil
1830 "List of property/value pairs that can be inherited by any entry.
1831Valid for the current buffer.
1832This variable is populated from #+PROPERTY lines.")
1781 1833
1782(defgroup org-agenda nil 1834(defgroup org-agenda nil
1783 "Options concerning agenda views in Org-mode." 1835 "Options concerning agenda views in Org-mode."
@@ -1912,7 +1964,7 @@ match What to search for:
1912 - a single keyword for TODO keyword searches 1964 - a single keyword for TODO keyword searches
1913 - a tags match expression for tags searches 1965 - a tags match expression for tags searches
1914 - a regular expression for occur searches 1966 - a regular expression for occur searches
1915options A list of option setttings, similar to that in a let form, so like 1967options A list of option settings, similar to that in a let form, so like
1916 this: ((opt1 val1) (opt2 val2) ...) 1968 this: ((opt1 val1) (opt2 val2) ...)
1917files A list of files file to write the produced agenda buffer to 1969files A list of files file to write the produced agenda buffer to
1918 with the command `org-store-agenda-views'. 1970 with the command `org-store-agenda-views'.
@@ -2200,6 +2252,13 @@ the entries for specific days."
2200 :group 'org-agenda-daily/weekly 2252 :group 'org-agenda-daily/weekly
2201 :type 'boolean) 2253 :type 'boolean)
2202 2254
2255(defcustom org-agenda-repeating-timestamp-show-all t
2256 "Non-nil means, show all occurences of a repeating stamp in the agenda.
2257When nil, only one occurence is shown, either today or the
2258nearest into the future."
2259 :group 'org-agenda-daily/weekly
2260 :type 'boolean)
2261
2203(defgroup org-agenda-time-grid nil 2262(defgroup org-agenda-time-grid nil
2204 "Options concerning the time grid in the Org-mode Agenda." 2263 "Options concerning the time grid in the Org-mode Agenda."
2205 :tag "Org Agenda Time Grid" 2264 :tag "Org Agenda Time Grid"
@@ -2455,7 +2514,7 @@ This is a property list with the following properties:
2455 \"$$\" find math expressions surrounded by $$....$$ 2514 \"$$\" find math expressions surrounded by $$....$$
2456 \"\\(\" find math expressions surrounded by \\(...\\) 2515 \"\\(\" find math expressions surrounded by \\(...\\)
2457 \"\\ [\" find math expressions surrounded by \\ [...\\]" 2516 \"\\ [\" find math expressions surrounded by \\ [...\\]"
2458 :group 'org-latex 2517 :group 'org-export-latex
2459 :type 'plist) 2518 :type 'plist)
2460 2519
2461(defcustom org-format-latex-header "\\documentclass{article} 2520(defcustom org-format-latex-header "\\documentclass{article}
@@ -2467,7 +2526,7 @@ This is a property list with the following properties:
2467\\usepackage[mathscr]{eucal} 2526\\usepackage[mathscr]{eucal}
2468\\pagestyle{empty} % do not remove" 2527\\pagestyle{empty} % do not remove"
2469 "The document header used for processing LaTeX fragments." 2528 "The document header used for processing LaTeX fragments."
2470 :group 'org-latex 2529 :group 'org-export-latex
2471 :type 'string) 2530 :type 'string)
2472 2531
2473(defgroup org-export nil 2532(defgroup org-export nil
@@ -2485,7 +2544,7 @@ This is a property list with the following properties:
2485This path may be relative to the directory where the Org-mode file lives. 2544This path may be relative to the directory where the Org-mode file lives.
2486The default is to put them into the same directory as the Org-mode file. 2545The default is to put them into the same directory as the Org-mode file.
2487The variable may also be an alist with export types `:html', `:ascii', 2546The variable may also be an alist with export types `:html', `:ascii',
2488`:ical', or `:xoxo' and the corresponding directories. If a direcoty path 2547`:ical', or `:xoxo' and the corresponding directories. If a directory path
2489is relative, it is interpreted relative to the directory where the exported 2548is relative, it is interpreted relative to the directory where the exported
2490Org-mode files lives." 2549Org-mode files lives."
2491 :group 'org-export-general 2550 :group 'org-export-general
@@ -2597,6 +2656,23 @@ headline Only export the headline, but skip the tree below it."
2597 (const :tag "headline only" 'headline) 2656 (const :tag "headline only" 'headline)
2598 (const :tag "entirely" t))) 2657 (const :tag "entirely" t)))
2599 2658
2659(defcustom org-export-author-info t
2660 "Non-nil means, insert author name and email into the exported file.
2661
2662This option can also be set with the +OPTIONS line,
2663e.g. \"author-info:nil\"."
2664 :group 'org-export-general
2665 :type 'boolean)
2666
2667(defcustom org-export-time-stamp-file t
2668 "Non-nil means, insert a time stamp into the exported file.
2669The time stamp shows when the file was created.
2670
2671This option can also be set with the +OPTIONS line,
2672e.g. \"timestamp:nil\"."
2673 :group 'org-export-general
2674 :type 'boolean)
2675
2600(defcustom org-export-with-timestamps t 2676(defcustom org-export-with-timestamps t
2601 "If nil, do not export time stamps and associated keywords." 2677 "If nil, do not export time stamps and associated keywords."
2602 :group 'org-export-general 2678 :group 'org-export-general
@@ -2688,7 +2764,7 @@ Not all export backends support this.
2688 2764
2689This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"." 2765This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"."
2690 :group 'org-export-translation 2766 :group 'org-export-translation
2691 :group 'org-latex 2767 :group 'org-export-latex
2692 :type 'boolean) 2768 :type 'boolean)
2693 2769
2694(defcustom org-export-with-LaTeX-fragments nil 2770(defcustom org-export-with-LaTeX-fragments nil
@@ -2700,7 +2776,7 @@ display math.
2700 2776
2701This option can also be set with the +OPTIONS line, e.g. \"LaTeX:t\"." 2777This option can also be set with the +OPTIONS line, e.g. \"LaTeX:t\"."
2702 :group 'org-export-translation 2778 :group 'org-export-translation
2703 :group 'org-latex 2779 :group 'org-export-latex
2704 :type 'boolean) 2780 :type 'boolean)
2705 2781
2706(defcustom org-export-with-fixed-width t 2782(defcustom org-export-with-fixed-width t
@@ -3403,6 +3479,31 @@ to the part of the headline after the DONE keyword."
3403 "Face for items scheduled previously, and not yet done." 3479 "Face for items scheduled previously, and not yet done."
3404 :group 'org-faces) 3480 :group 'org-faces)
3405 3481
3482(defcustom org-agenda-deadline-faces
3483 '((1.0 . org-warning)
3484 (0.5 . org-upcoming-deadline)
3485 (0.0 . default))
3486 "Faces for showing deadlines in the agenda.
3487This is a list of cons cells. The cdr of each cess is a face to be used,
3488and it can also just be a like like '(:foreground \"yellow\").
3489Each car is a fraction of the head-warning time that must have passed for
3490this the face in the cdr to be used for display. The numbers must be
3491given in descending order. The head-warning time is normally taken
3492from `org-deadline-warning-days', but can also be specified in the deadline
3493timestamp itself, like this:
3494
3495 DEADLINE: <2007-08-13 Mon -8d>
3496
3497You may use d for days, w for weeks, m for months and y for years. Months
3498and years will only be treated in an approximate fashion (30.4 days for a
3499month and 365.24 days for a year)."
3500 :group 'org-faces
3501 :group 'org-agenda-daily/weekly
3502 :type '(repeat
3503 (cons
3504 (number :tag "Fraction of head-warning time passed")
3505 (sexp :tag "Face"))))
3506
3406(defface org-time-grid ;; font-lock-variable-name-face 3507(defface org-time-grid ;; font-lock-variable-name-face
3407 (org-compatible-face 3508 (org-compatible-face
3408 '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) 3509 '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
@@ -3570,9 +3671,10 @@ means to push this value onto the list in the variable.")
3570 (let ((re (org-make-options-regexp 3671 (let ((re (org-make-options-regexp
3571 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" "COLUMNS" 3672 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" "COLUMNS"
3572 "STARTUP" "ARCHIVE" "TAGS" "LINK" "PRIORITIES" 3673 "STARTUP" "ARCHIVE" "TAGS" "LINK" "PRIORITIES"
3573 "CONSTANTS"))) 3674 "CONSTANTS" "PROPERTY")))
3574 (splitre "[ \t]+") 3675 (splitre "[ \t]+")
3575 kwds key value cat arch tags const links hw dws tail sep kws1 prio) 3676 kwds key value cat arch tags const links hw dws tail sep kws1 prio
3677 props)
3576 (save-excursion 3678 (save-excursion
3577 (save-restriction 3679 (save-restriction
3578 (widen) 3680 (widen)
@@ -3599,6 +3701,10 @@ means to push this value onto the list in the variable.")
3599 links))) 3701 links)))
3600 ((equal key "PRIORITIES") 3702 ((equal key "PRIORITIES")
3601 (setq prio (org-split-string value " +"))) 3703 (setq prio (org-split-string value " +")))
3704 ((equal key "PROPERTY")
3705 (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value)
3706 (push (cons (match-string 1 value) (match-string 2 value))
3707 props)))
3602 ((equal key "CONSTANTS") 3708 ((equal key "CONSTANTS")
3603 (setq const (append const (org-split-string value splitre)))) 3709 (setq const (append const (org-split-string value splitre))))
3604 ((equal key "STARTUP") 3710 ((equal key "STARTUP")
@@ -3626,6 +3732,7 @@ means to push this value onto the list in the variable.")
3626 (org-set-local 'org-highest-priority (nth 0 prio)) 3732 (org-set-local 'org-highest-priority (nth 0 prio))
3627 (org-set-local 'org-lowest-priority (nth 1 prio)) 3733 (org-set-local 'org-lowest-priority (nth 1 prio))
3628 (org-set-local 'org-default-priority (nth 2 prio))) 3734 (org-set-local 'org-default-priority (nth 2 prio)))
3735 (and props (org-set-local 'org-local-properties (nreverse props)))
3629 (and arch (org-set-local 'org-archive-location arch)) 3736 (and arch (org-set-local 'org-archive-location arch))
3630 (and links (setq org-link-abbrev-alist-local (nreverse links))) 3737 (and links (setq org-link-abbrev-alist-local (nreverse links)))
3631 ;; Process the TODO keywords 3738 ;; Process the TODO keywords
@@ -4000,7 +4107,7 @@ The following commands are available:
4000 (org-add-to-invisibility-spec '(org-cwidth)) 4107 (org-add-to-invisibility-spec '(org-cwidth))
4001 (when (featurep 'xemacs) 4108 (when (featurep 'xemacs)
4002 (org-set-local 'line-move-ignore-invisible t)) 4109 (org-set-local 'line-move-ignore-invisible t))
4003 (setq outline-regexp "\\*+ ") 4110 (org-set-local 'outline-regexp "\\*+ ")
4004 (setq outline-level 'org-outline-level) 4111 (setq outline-level 'org-outline-level)
4005 (when (and org-ellipsis (stringp org-ellipsis) 4112 (when (and org-ellipsis (stringp org-ellipsis)
4006 (fboundp 'set-display-table-slot) (boundp 'buffer-display-table)) 4113 (fboundp 'set-display-table-slot) (boundp 'buffer-display-table))
@@ -4068,6 +4175,7 @@ The following commands are available:
4068(defsubst org-current-line (&optional pos) 4175(defsubst org-current-line (&optional pos)
4069 (save-excursion 4176 (save-excursion
4070 (and pos (goto-char pos)) 4177 (and pos (goto-char pos))
4178 ;; works also in narrowed buffer, because we start at 1, not point-min
4071 (+ (if (bolp) 1 0) (count-lines 1 (point))))) 4179 (+ (if (bolp) 1 0) (count-lines 1 (point)))))
4072 4180
4073(defun org-current-time () 4181(defun org-current-time ()
@@ -4109,61 +4217,71 @@ that will be added to PLIST. Returns the string that was modified."
4109(require 'font-lock) 4217(require 'font-lock)
4110 4218
4111(defconst org-non-link-chars "]\t\n\r<>") 4219(defconst org-non-link-chars "]\t\n\r<>")
4112(defconst org-link-types '("http" "https" "ftp" "mailto" "file" "news" "bbdb" "vm" 4220(defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" "bbdb" "vm"
4113 "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp")) 4221 "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp"))
4114(defconst org-link-re-with-space 4222(defvar org-link-re-with-space nil
4115 (concat
4116 "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):"
4117 "\\([^" org-non-link-chars " ]"
4118 "[^" org-non-link-chars "]*"
4119 "[^" org-non-link-chars " ]\\)>?")
4120 "Matches a link with spaces, optional angular brackets around it.") 4223 "Matches a link with spaces, optional angular brackets around it.")
4121 4224(defvar org-link-re-with-space2 nil
4122(defconst org-link-re-with-space2
4123 (concat
4124 "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):"
4125 "\\([^" org-non-link-chars " ]"
4126 "[^]\t\n\r]*"
4127 "[^" org-non-link-chars " ]\\)>?")
4128 "Matches a link with spaces, optional angular brackets around it.") 4225 "Matches a link with spaces, optional angular brackets around it.")
4129 4226(defvar org-angle-link-re nil
4130(defconst org-angle-link-re
4131 (concat
4132 "<\\(" (mapconcat 'identity org-link-types "\\|") "\\):"
4133 "\\([^" org-non-link-chars " ]"
4134 "[^" org-non-link-chars "]*"
4135 "\\)>")
4136 "Matches link with angular brackets, spaces are allowed.") 4227 "Matches link with angular brackets, spaces are allowed.")
4137(defconst org-plain-link-re 4228(defvar org-plain-link-re nil
4138 (concat
4139 "\\(" (mapconcat 'identity org-link-types "\\|") "\\):"
4140 "\\([^]\t\n\r<>,;() ]+\\)")
4141 "Matches plain link, without spaces.") 4229 "Matches plain link, without spaces.")
4142 4230(defvar org-bracket-link-regexp nil
4143(defconst org-bracket-link-regexp
4144 "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]"
4145 "Matches a link in double brackets.") 4231 "Matches a link in double brackets.")
4146 4232(defvar org-bracket-link-analytic-regexp nil
4147(defconst org-bracket-link-analytic-regexp 4233 "Regular expression used to analyze links.
4148 (concat 4234Here is what the match groups contain after a match:
4149 "\\[\\[" 42351: http:
4150 "\\(\\(" (mapconcat 'identity org-link-types "\\|") "\\):\\)?" 42362: http
4151 "\\([^]]+\\)" 42373: path
4152 "\\]" 42384: [desc]
4153 "\\(\\[" "\\([^]]+\\)" "\\]\\)?" 42395: desc")
4154 "\\]")) 4240(defvar org-any-link-re nil
4155; 1: http:
4156; 2: http
4157; 3: path
4158; 4: [desc]
4159; 5: desc
4160
4161(defconst org-any-link-re
4162 (concat "\\(" org-bracket-link-regexp "\\)\\|\\("
4163 org-angle-link-re "\\)\\|\\("
4164 org-plain-link-re "\\)")
4165 "Regular expression matching any link.") 4241 "Regular expression matching any link.")
4166 4242
4243(defun org-make-link-regexps ()
4244 "Update the link regular expressions.
4245This should be called after the variable `org-link-types' has changed."
4246 (setq org-link-re-with-space
4247 (concat
4248 "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):"
4249 "\\([^" org-non-link-chars " ]"
4250 "[^" org-non-link-chars "]*"
4251 "[^" org-non-link-chars " ]\\)>?")
4252 org-link-re-with-space2
4253 (concat
4254 "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):"
4255 "\\([^" org-non-link-chars " ]"
4256 "[^]\t\n\r]*"
4257 "[^" org-non-link-chars " ]\\)>?")
4258 org-angle-link-re
4259 (concat
4260 "<\\(" (mapconcat 'identity org-link-types "\\|") "\\):"
4261 "\\([^" org-non-link-chars " ]"
4262 "[^" org-non-link-chars "]*"
4263 "\\)>")
4264 org-plain-link-re
4265 (concat
4266 "\\(" (mapconcat 'identity org-link-types "\\|") "\\):"
4267 "\\([^]\t\n\r<>,;() ]+\\)")
4268 org-bracket-link-regexp
4269 "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]"
4270 org-bracket-link-analytic-regexp
4271 (concat
4272 "\\[\\["
4273 "\\(\\(" (mapconcat 'identity org-link-types "\\|") "\\):\\)?"
4274 "\\([^]]+\\)"
4275 "\\]"
4276 "\\(\\[" "\\([^]]+\\)" "\\]\\)?"
4277 "\\]")
4278 org-any-link-re
4279 (concat "\\(" org-bracket-link-regexp "\\)\\|\\("
4280 org-angle-link-re "\\)\\|\\("
4281 org-plain-link-re "\\)")))
4282
4283(org-make-link-regexps)
4284
4167(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)>" 4285(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)>"
4168 "Regular expression for fast time stamp matching.") 4286 "Regular expression for fast time stamp matching.")
4169(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)[]>]" 4287(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)[]>]"
@@ -4386,6 +4504,7 @@ We use a macro so that the test can happen at compilation time."
4386(defun org-restart-font-lock () 4504(defun org-restart-font-lock ()
4387 "Restart font-lock-mode, to force refontification." 4505 "Restart font-lock-mode, to force refontification."
4388 (when (and (boundp 'font-lock-mode) font-lock-mode) 4506 (when (and (boundp 'font-lock-mode) font-lock-mode)
4507 ;; FIXME: Could font-lock-fontify-buffer be enough???
4389 (font-lock-mode -1) 4508 (font-lock-mode -1)
4390 (font-lock-mode 1))) 4509 (font-lock-mode 1)))
4391 4510
@@ -4417,7 +4536,7 @@ between words."
4417 "\\)\\>"))) 4536 "\\)\\>")))
4418 4537
4419(defun org-activate-tags (limit) 4538(defun org-activate-tags (limit)
4420 (if (re-search-forward (org-re "[ \t]\\(:[[:alnum:]_@:]+:\\)[ \r\n]") limit t) 4539 (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \r\n]") limit t)
4421 (progn 4540 (progn
4422 (add-text-properties (match-beginning 1) (match-end 1) 4541 (add-text-properties (match-beginning 1) (match-end 1)
4423 (list 'mouse-face 'highlight 4542 (list 'mouse-face 'highlight
@@ -4683,7 +4802,8 @@ between words."
4683 (goto-char eos) 4802 (goto-char eos)
4684 (outline-next-heading) 4803 (outline-next-heading)
4685 (if (org-invisible-p) (org-flag-heading nil)))) 4804 (if (org-invisible-p) (org-flag-heading nil))))
4686 ((>= eol eos) 4805 ((or (>= eol eos)
4806 (not (string-match "\\S-" (buffer-substring eol eos))))
4687 ;; Entire subtree is hidden in one line: open it 4807 ;; Entire subtree is hidden in one line: open it
4688 (org-show-entry) 4808 (org-show-entry)
4689 (show-children) 4809 (show-children)
@@ -4855,31 +4975,34 @@ Optional argument N means, put the headline into the Nth line of the window."
4855 4975
4856(defvar org-goto-window-configuration nil) 4976(defvar org-goto-window-configuration nil)
4857(defvar org-goto-marker nil) 4977(defvar org-goto-marker nil)
4858(defvar org-goto-map (make-sparse-keymap)) 4978(defvar org-goto-map
4859(let ((cmds '(isearch-forward isearch-backward)) cmd) 4979 (let ((map (make-sparse-keymap)))
4860 (while (setq cmd (pop cmds)) 4980 (let ((cmds '(isearch-forward isearch-backward)) cmd)
4861 (substitute-key-definition cmd cmd org-goto-map global-map))) 4981 (while (setq cmd (pop cmds))
4862(org-defkey org-goto-map "\C-m" 'org-goto-ret) 4982 (substitute-key-definition cmd cmd map global-map)))
4863(org-defkey org-goto-map [(left)] 'org-goto-left) 4983 (org-defkey map "\C-m" 'org-goto-ret)
4864(org-defkey org-goto-map [(right)] 'org-goto-right) 4984 (org-defkey map [(left)] 'org-goto-left)
4865(org-defkey org-goto-map [(?q)] 'org-goto-quit) 4985 (org-defkey map [(right)] 'org-goto-right)
4866(org-defkey org-goto-map [(control ?g)] 'org-goto-quit) 4986 (org-defkey map [(?q)] 'org-goto-quit)
4867(org-defkey org-goto-map "\C-i" 'org-cycle) 4987 (org-defkey map [(control ?g)] 'org-goto-quit)
4868(org-defkey org-goto-map [(tab)] 'org-cycle) 4988 (org-defkey map "\C-i" 'org-cycle)
4869(org-defkey org-goto-map [(down)] 'outline-next-visible-heading) 4989 (org-defkey map [(tab)] 'org-cycle)
4870(org-defkey org-goto-map [(up)] 'outline-previous-visible-heading) 4990 (org-defkey map [(down)] 'outline-next-visible-heading)
4871(org-defkey org-goto-map "n" 'outline-next-visible-heading) 4991 (org-defkey map [(up)] 'outline-previous-visible-heading)
4872(org-defkey org-goto-map "p" 'outline-previous-visible-heading) 4992 (org-defkey map "n" 'outline-next-visible-heading)
4873(org-defkey org-goto-map "f" 'outline-forward-same-level) 4993 (org-defkey map "p" 'outline-previous-visible-heading)
4874(org-defkey org-goto-map "b" 'outline-backward-same-level) 4994 (org-defkey map "f" 'outline-forward-same-level)
4875(org-defkey org-goto-map "u" 'outline-up-heading) 4995 (org-defkey map "b" 'outline-backward-same-level)
4876(org-defkey org-goto-map "\C-c\C-n" 'outline-next-visible-heading) 4996 (org-defkey map "u" 'outline-up-heading)
4877(org-defkey org-goto-map "\C-c\C-p" 'outline-previous-visible-heading) 4997 (org-defkey map "\C-c\C-n" 'outline-next-visible-heading)
4878(org-defkey org-goto-map "\C-c\C-f" 'outline-forward-same-level) 4998 (org-defkey map "\C-c\C-p" 'outline-previous-visible-heading)
4879(org-defkey org-goto-map "\C-c\C-b" 'outline-backward-same-level) 4999 (org-defkey map "\C-c\C-f" 'outline-forward-same-level)
4880(org-defkey org-goto-map "\C-c\C-u" 'outline-up-heading) 5000 (org-defkey map "\C-c\C-b" 'outline-backward-same-level)
4881(let ((l '(1 2 3 4 5 6 7 8 9 0))) 5001 (org-defkey map "\C-c\C-u" 'outline-up-heading)
4882 (while l (org-defkey org-goto-map (int-to-string (pop l)) 'digit-argument))) 5002 ;; FIXME: Could we use suppress-keymap?
5003 (let ((l '(1 2 3 4 5 6 7 8 9 0)))
5004 (while l (org-defkey map (int-to-string (pop l)) 'digit-argument)))
5005 map))
4883 5006
4884(defconst org-goto-help 5007(defconst org-goto-help
4885"Select a location to jump to, press RET 5008"Select a location to jump to, press RET
@@ -5110,7 +5233,6 @@ the current headline."
5110 (unless (= (point) pos) (just-one-space) (backward-delete-char 1)) 5233 (unless (= (point) pos) (just-one-space) (backward-delete-char 1))
5111 (run-hooks 'org-insert-heading-hook))))) 5234 (run-hooks 'org-insert-heading-hook)))))
5112 5235
5113
5114(defun org-insert-todo-heading (arg) 5236(defun org-insert-todo-heading (arg)
5115 "Insert a new heading with the same level and TODO state as current heading. 5237 "Insert a new heading with the same level and TODO state as current heading.
5116If the heading has no TODO state, or if the state is DONE, use the first 5238If the heading has no TODO state, or if the state is DONE, use the first
@@ -5128,6 +5250,24 @@ state (TODO by default). Also with prefix arg, force first state."
5128 (insert (car org-todo-keywords-1) " ") 5250 (insert (car org-todo-keywords-1) " ")
5129 (insert (match-string 2) " ")))) 5251 (insert (match-string 2) " "))))
5130 5252
5253(defun org-insert-subheading (arg)
5254 "Insert a new subheading and demote it.
5255Works for outline headings and for plain lists alike."
5256 (interactive "P")
5257 (org-insert-heading arg)
5258 (cond
5259 ((org-on-heading-p) (org-do-demote))
5260 ((org-at-item-p) (org-indent-item 1))))
5261
5262(defun org-insert-todo-subheading (arg)
5263 "Insert a new subheading with TODO keyword or checkbox and demote it.
5264Works for outline headings and for plain lists alike."
5265 (interactive "P")
5266 (org-insert-todo-heading arg)
5267 (cond
5268 ((org-on-heading-p) (org-do-demote))
5269 ((org-at-item-p) (org-indent-item 1))))
5270
5131;;; Promotion and Demotion 5271;;; Promotion and Demotion
5132 5272
5133(defun org-promote-subtree () 5273(defun org-promote-subtree ()
@@ -5259,7 +5399,8 @@ would end up with no indentation after the change, nothing at all is done."
5259 "^\\S-" 5399 "^\\S-"
5260 (concat "^ \\{0," (int-to-string (- diff)) "\\}\\S-"))) 5400 (concat "^ \\{0," (int-to-string (- diff)) "\\}\\S-")))
5261 col) 5401 col)
5262 (unless (save-excursion (re-search-forward prohibit end t)) 5402 (unless (save-excursion (end-of-line 1)
5403 (re-search-forward prohibit end t))
5263 (while (re-search-forward "^[ \t]+" end t) 5404 (while (re-search-forward "^[ \t]+" end t)
5264 (goto-char (match-end 0)) 5405 (goto-char (match-end 0))
5265 (setq col (current-column)) 5406 (setq col (current-column))
@@ -5793,11 +5934,13 @@ the whole buffer."
5793 (if (member (match-string 2) '("[ ]" "[-]")) 5934 (if (member (match-string 2) '("[ ]" "[-]"))
5794 (setq c-off (1+ c-off)) 5935 (setq c-off (1+ c-off))
5795 (setq c-on (1+ c-on)))) 5936 (setq c-on (1+ c-on))))
5796 (delete-region b1 e1) 5937; (delete-region b1 e1)
5797 (goto-char b1) 5938 (goto-char b1)
5798 (insert (if f1 5939 (insert (if f1
5799 (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off)))) 5940 (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off))))
5800 (format "[%d/%d]" c-on (+ c-on c-off)))))) 5941 (format "[%d/%d]" c-on (+ c-on c-off))))
5942 (and (looking-at "\\[.*?\\]")
5943 (replace-match ""))))
5801 (when (interactive-p) 5944 (when (interactive-p)
5802 (message "Checkbox satistics updated %s (%d places)" 5945 (message "Checkbox satistics updated %s (%d places)"
5803 (if all "in entire file" "in current outline entry") cstat))))) 5946 (if all "in entire file" "in current outline entry") cstat)))))
@@ -6157,11 +6300,13 @@ I.e. to the first item in this list."
6157 (while t 6300 (while t
6158 (catch 'next 6301 (catch 'next
6159 (beginning-of-line 0) 6302 (beginning-of-line 0)
6160 (if (looking-at "[ \t]*$") (throw 'next t)) 6303 (if (looking-at "[ \t]*$")
6304 (throw (if (bobp) 'exit 'next) t))
6161 (skip-chars-forward " \t") (setq ind1 (current-column)) 6305 (skip-chars-forward " \t") (setq ind1 (current-column))
6162 (if (or (< ind1 ind) 6306 (if (or (< ind1 ind)
6163 (and (= ind1 ind) 6307 (and (= ind1 ind)
6164 (not (org-at-item-p)))) 6308 (not (org-at-item-p)))
6309 (bobp))
6165 (throw 'exit t) 6310 (throw 'exit t)
6166 (when (org-at-item-p) (setq pos (point-at-bol))))))) 6311 (when (org-at-item-p) (setq pos (point-at-bol)))))))
6167 (goto-char pos))) 6312 (goto-char pos)))
@@ -6194,8 +6339,8 @@ I.e. to the first item in this list."
6194 ind-down (nth 2 tmp) 6339 ind-down (nth 2 tmp)
6195 ind-up (nth 1 tmp) 6340 ind-up (nth 1 tmp)
6196 delta (if (> arg 0) 6341 delta (if (> arg 0)
6197 (if ind-down (- ind-down ind) (+ 2 ind)) 6342 (if ind-down (- ind-down ind) 2)
6198 (if ind-up (- ind-up ind) (- ind 2)))) 6343 (if ind-up (- ind-up ind) -2)))
6199 (if (< (+ delta ind) 0) (error "Cannot outdent beyond margin")) 6344 (if (< (+ delta ind) 0) (error "Cannot outdent beyond margin"))
6200 (while (< (point) end) 6345 (while (< (point) end)
6201 (beginning-of-line 1) 6346 (beginning-of-line 1)
@@ -6260,7 +6405,7 @@ I.e. to the first item in this list."
6260;; addresses this by checking explicitly for both bindings. 6405;; addresses this by checking explicitly for both bindings.
6261 6406
6262(defvar orgstruct-mode-map (make-sparse-keymap) 6407(defvar orgstruct-mode-map (make-sparse-keymap)
6263 "Keymap for the minor `org-cdlatex-mode'.") 6408 "Keymap for the minor `orgstruct-mode'.")
6264 6409
6265;;;###autoload 6410;;;###autoload
6266(define-minor-mode orgstruct-mode 6411(define-minor-mode orgstruct-mode
@@ -6316,6 +6461,7 @@ C-c C-c Set tags / toggle checkbox"
6316 '([(meta shift right)] org-shiftmetaright) 6461 '([(meta shift right)] org-shiftmetaright)
6317 '([(shift up)] org-shiftup) 6462 '([(shift up)] org-shiftup)
6318 '([(shift down)] org-shiftdown) 6463 '([(shift down)] org-shiftdown)
6464 '("\C-c\C-c" org-ctrl-c-ctrl-c)
6319 '("\M-q" fill-paragraph) 6465 '("\M-q" fill-paragraph)
6320 '("\C-c^" org-sort) 6466 '("\C-c^" org-sort)
6321 '("\C-c-" org-cycle-list-bullet))) 6467 '("\C-c-" org-cycle-list-bullet)))
@@ -6344,8 +6490,8 @@ C-c C-c Set tags / toggle checkbox"
6344 (orgstruct-make-binding 'org-insert-todo-heading 107 6490 (orgstruct-make-binding 'org-insert-todo-heading 107
6345 [(meta return)] "\M-\C-m")) 6491 [(meta return)] "\M-\C-m"))
6346 6492
6347 (org-defkey orgstruct-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) 6493 (unless org-local-vars
6348 (setq org-local-vars (org-get-local-variables)) 6494 (setq org-local-vars (org-get-local-variables)))
6349 6495
6350 t)) 6496 t))
6351 6497
@@ -6407,7 +6553,10 @@ to execute outside of tables."
6407 x nil)) 6553 x nil))
6408 varlist)))) 6554 varlist))))
6409 6555
6556;;;###autoload
6410(defun org-run-like-in-org-mode (cmd) 6557(defun org-run-like-in-org-mode (cmd)
6558 (unless org-local-vars
6559 (setq org-local-vars (org-get-local-variables)))
6411 (eval (list 'let org-local-vars 6560 (eval (list 'let org-local-vars
6412 (list 'call-interactively (list 'quote cmd))))) 6561 (list 'call-interactively (list 'quote cmd)))))
6413 6562
@@ -6516,13 +6665,16 @@ this heading."
6516 (goto-char (point-max)) (insert "\n")) 6665 (goto-char (point-max)) (insert "\n"))
6517 ;; Paste 6666 ;; Paste
6518 (org-paste-subtree (org-get-legal-level level 1)) 6667 (org-paste-subtree (org-get-legal-level level 1))
6519 ;; Mark the entry as done, i.e. set to last word in org-todo-keywords-1 FIXME: not right anymore!!!!!!! 6668
6669 ;; Mark the entry as done
6520 (when (and org-archive-mark-done 6670 (when (and org-archive-mark-done
6521 (looking-at org-todo-line-regexp) 6671 (looking-at org-todo-line-regexp)
6522 (or (not (match-end 3)) 6672 (or (not (match-end 2))
6523 (not (member (match-string 3) org-done-keywords)))) 6673 (not (member (match-string 2) org-done-keywords))))
6524 (let (org-log-done) 6674 (let (org-log-done)
6525 (org-todo (car org-done-keywords)))) 6675 (org-todo
6676 (car (or (member org-archive-mark-done org-done-keywords)
6677 org-done-keywords)))))
6526 6678
6527 ;; Move cursor to right after the TODO keyword 6679 ;; Move cursor to right after the TODO keyword
6528 (when org-archive-stamp-time 6680 (when org-archive-stamp-time
@@ -6582,7 +6734,7 @@ When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
6582 (message "%d trees archived" cntarch))) 6734 (message "%d trees archived" cntarch)))
6583 6735
6584(defun org-cycle-hide-drawers (state) 6736(defun org-cycle-hide-drawers (state)
6585 "Re-hide all archived subtrees after a visibility state change." 6737 "Re-hide all drawers after a visibility state change."
6586 (when (not (memq state '(overview folded))) 6738 (when (not (memq state '(overview folded)))
6587 (save-excursion 6739 (save-excursion
6588 (let* ((globalp (memq state '(contents all))) 6740 (let* ((globalp (memq state '(contents all)))
@@ -8839,7 +8991,7 @@ LISPP means to return something appropriate for a Lisp list."
8839 (if (eq lispp 'literal) 8991 (if (eq lispp 'literal)
8840 x 8992 x
8841 (prin1-to-string (if numbers (string-to-number x) x)))) 8993 (prin1-to-string (if numbers (string-to-number x) x))))
8842 " ") 8994 elements " ")
8843 (concat "[" (mapconcat 8995 (concat "[" (mapconcat
8844 (lambda (x) 8996 (lambda (x)
8845 (if numbers (number-to-string (string-to-number x)) x)) 8997 (if numbers (number-to-string (string-to-number x)) x))
@@ -9001,26 +9153,28 @@ Parameters get priority."
9001 (org-entry-get nil (substring const 5) 'inherit)) 9153 (org-entry-get nil (substring const 5) 'inherit))
9002 "#UNDEFINED_NAME")) 9154 "#UNDEFINED_NAME"))
9003 9155
9004(defvar org-table-fedit-map (make-sparse-keymap)) 9156(defvar org-table-fedit-map
9005(org-defkey org-table-fedit-map "\C-x\C-s" 'org-table-fedit-finish) 9157 (let ((map (make-sparse-keymap)))
9006(org-defkey org-table-fedit-map "\C-c\C-s" 'org-table-fedit-finish) 9158 (org-defkey map "\C-x\C-s" 'org-table-fedit-finish)
9007(org-defkey org-table-fedit-map "\C-c\C-c" 'org-table-fedit-finish) 9159 (org-defkey map "\C-c\C-s" 'org-table-fedit-finish)
9008(org-defkey org-table-fedit-map "\C-c\C-q" 'org-table-fedit-abort) 9160 (org-defkey map "\C-c\C-c" 'org-table-fedit-finish)
9009(org-defkey org-table-fedit-map "\C-c?" 'org-table-show-reference) 9161 (org-defkey map "\C-c\C-q" 'org-table-fedit-abort)
9010(org-defkey org-table-fedit-map [(meta shift up)] 'org-table-fedit-line-up) 9162 (org-defkey map "\C-c?" 'org-table-show-reference)
9011(org-defkey org-table-fedit-map [(meta shift down)] 'org-table-fedit-line-down) 9163 (org-defkey map [(meta shift up)] 'org-table-fedit-line-up)
9012(org-defkey org-table-fedit-map [(shift up)] 'org-table-fedit-ref-up) 9164 (org-defkey map [(meta shift down)] 'org-table-fedit-line-down)
9013(org-defkey org-table-fedit-map [(shift down)] 'org-table-fedit-ref-down) 9165 (org-defkey map [(shift up)] 'org-table-fedit-ref-up)
9014(org-defkey org-table-fedit-map [(shift left)] 'org-table-fedit-ref-left) 9166 (org-defkey map [(shift down)] 'org-table-fedit-ref-down)
9015(org-defkey org-table-fedit-map [(shift right)] 'org-table-fedit-ref-right) 9167 (org-defkey map [(shift left)] 'org-table-fedit-ref-left)
9016(org-defkey org-table-fedit-map [(meta up)] 'org-table-fedit-scroll-down) 9168 (org-defkey map [(shift right)] 'org-table-fedit-ref-right)
9017(org-defkey org-table-fedit-map [(meta down)] 'org-table-fedit-scroll) 9169 (org-defkey map [(meta up)] 'org-table-fedit-scroll-down)
9018(org-defkey org-table-fedit-map [(meta tab)] 'lisp-complete-symbol) 9170 (org-defkey map [(meta down)] 'org-table-fedit-scroll)
9019(org-defkey org-table-fedit-map "\M-\C-i" 'lisp-complete-symbol) 9171 (org-defkey map [(meta tab)] 'lisp-complete-symbol)
9020(org-defkey org-table-fedit-map [(tab)] 'org-table-fedit-lisp-indent) 9172 (org-defkey map "\M-\C-i" 'lisp-complete-symbol)
9021(org-defkey org-table-fedit-map "\C-i" 'org-table-fedit-lisp-indent) 9173 (org-defkey map [(tab)] 'org-table-fedit-lisp-indent)
9022(org-defkey org-table-fedit-map "\C-c\C-r" 'org-table-fedit-toggle-ref-type) 9174 (org-defkey map "\C-i" 'org-table-fedit-lisp-indent)
9023(org-defkey org-table-fedit-map "\C-c}" 'org-table-fedit-toggle-coordinates) 9175 (org-defkey map "\C-c\C-r" 'org-table-fedit-toggle-ref-type)
9176 (org-defkey map "\C-c}" 'org-table-fedit-toggle-coordinates)
9177 map))
9024 9178
9025(easy-menu-define org-table-fedit-menu org-table-fedit-map "Org Edit Formulas Menu" 9179(easy-menu-define org-table-fedit-menu org-table-fedit-map "Org Edit Formulas Menu"
9026 '("Edit-Formulas" 9180 '("Edit-Formulas"
@@ -9132,7 +9286,8 @@ full TBLFM line."
9132 ;; format match, just advance 9286 ;; format match, just advance
9133 (setq start (match-end 0))) 9287 (setq start (match-end 0)))
9134 ((and (> (match-beginning 0) 0) 9288 ((and (> (match-beginning 0) 0)
9135 (equal ?. (aref s (max (1- (match-beginning 0)) 0)))) 9289 (equal ?. (aref s (max (1- (match-beginning 0)) 0)))
9290 (not (equal ?. (aref s (max (- (match-beginning 0) 2) 0)))))
9136 ;; 3.e5 or something like this. FIXME: is this ok???? 9291 ;; 3.e5 or something like this. FIXME: is this ok????
9137 (setq start (match-end 0))) 9292 (setq start (match-end 0)))
9138 (t 9293 (t
@@ -9150,7 +9305,7 @@ full TBLFM line."
9150 "Convert spreadsheet references from to @7$28 to AB7. 9305 "Convert spreadsheet references from to @7$28 to AB7.
9151Works for single references, but also for entire formulas and even the 9306Works for single references, but also for entire formulas and even the
9152full TBLFM line." 9307full TBLFM line."
9153 (while (string-match "@\\([0-9]+\\)$\\([0-9]+\\)" s) 9308 (while (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" s)
9154 (setq s (replace-match 9309 (setq s (replace-match
9155 (format "%s%d" 9310 (format "%s%d"
9156 (org-number-to-letters 9311 (org-number-to-letters
@@ -10339,7 +10494,7 @@ this function is called."
10339 10494
10340(defun org-link-expand-abbrev (link) 10495(defun org-link-expand-abbrev (link)
10341 "Apply replacements as defined in `org-link-abbrev-alist." 10496 "Apply replacements as defined in `org-link-abbrev-alist."
10342 (if (string-match "^\\([a-zA-Z]+\\)\\(::?\\(.*\\)\\)?$" link) 10497 (if (string-match "^\\([a-zA-Z][-_a-zA-Z0-9]*\\)\\(::?\\(.*\\)\\)?$" link)
10343 (let* ((key (match-string 1 link)) 10498 (let* ((key (match-string 1 link))
10344 (as (or (assoc key org-link-abbrev-alist-local) 10499 (as (or (assoc key org-link-abbrev-alist-local)
10345 (assoc key org-link-abbrev-alist))) 10500 (assoc key org-link-abbrev-alist)))
@@ -10365,6 +10520,52 @@ this function is called."
10365(defvar org-store-link-plist nil 10520(defvar org-store-link-plist nil
10366 "Plist with info about the most recently link created with `org-store-link'.") 10521 "Plist with info about the most recently link created with `org-store-link'.")
10367 10522
10523(defvar org-link-protocols nil
10524 "Link protocols added to Org-mode using `org-add-link-type'.")
10525
10526(defvar org-store-link-functions nil
10527 "List of functions that are called to create and store a link.
10528Each function will be called in turn until one returns a non-nil
10529value. Each function should check if it is responsible for creating
10530this link (for example by looking at the major mode).
10531If not, it must exit and return nil.
10532If yes, it should return a non-nil value after a calling
10533`org-store-link-properties' with a list of properties and values.
10534Special properties are:
10535
10536:type The link prefix. like \"http\". This must be given.
10537:link The link, like \"http://www.astro.uva.nl/~dominik\".
10538 This is obligatory as well.
10539:description Optional default description for the second pair
10540 of brackets in an Org-mode link. The user can still change
10541 this when inserting this link into an Org-mode buffer.
10542
10543In addition to these, any additional properties can be specified
10544and then used in remember templates.")
10545
10546(defun org-add-link-type (type &optional follow publish)
10547 "Add TYPE to the list of `org-link-types'.
10548Re-compute all regular expressions depending on `org-link-types'
10549FOLLOW and PUBLISH are two functions. Both take the link path as
10550an argument.
10551FOLLOW should do whatever is necessary to follow the link, for example
10552to find a file or display a mail message.
10553PUBLISH takes the path and retuns the string that should be used when
10554this document is published."
10555 (add-to-list 'org-link-types type t)
10556 (org-make-link-regexps)
10557 (add-to-list 'org-link-protocols
10558 (list type follow publish)))
10559
10560(defun org-add-agenda-custom-command (entry)
10561 "Replace or add a command in `org-agenda-custom-commands'.
10562This is mostly for hacking and trying a new command - once the command
10563works you probably want to add it to `org-agenda-custom-commands' for good."
10564 (let ((ass (assoc (car entry) org-agenda-custom-commands)))
10565 (if ass
10566 (setcdr ass (cdr entry))
10567 (push entry org-agenda-custom-commands))))
10568
10368;;;###autoload 10569;;;###autoload
10369(defun org-store-link (arg) 10570(defun org-store-link (arg)
10370 "\\<org-mode-map>Store an org-link to the current location. 10571 "\\<org-mode-map>Store an org-link to the current location.
@@ -10378,6 +10579,10 @@ For file links, arg negates `org-context-in-file-links'."
10378 (let (link cpltxt desc description search txt) 10579 (let (link cpltxt desc description search txt)
10379 (cond 10580 (cond
10380 10581
10582 ((run-hook-with-args-until-success 'org-store-link-functions)
10583 (setq link (plist-get org-store-link-plist :link)
10584 desc (or (plist-get org-store-link-plist :description) link)))
10585
10381 ((eq major-mode 'bbdb-mode) 10586 ((eq major-mode 'bbdb-mode)
10382 (let ((name (bbdb-record-name (bbdb-current-record))) 10587 (let ((name (bbdb-record-name (bbdb-current-record)))
10383 (company (bbdb-record-getprop (bbdb-current-record) 'company))) 10588 (company (bbdb-record-getprop (bbdb-current-record) 'company)))
@@ -10663,7 +10868,7 @@ according to FMT (default from `org-email-link-description-format')."
10663 (mapconcat 'identity (org-split-string s "[ \t]+") " "))) 10868 (mapconcat 'identity (org-split-string s "[ \t]+") " ")))
10664 10869
10665(defun org-make-link (&rest strings) 10870(defun org-make-link (&rest strings)
10666 "Concatenate STRINGS, format resulting string with `org-link-format'." 10871 "Concatenate STRINGS."
10667 (apply 'concat strings)) 10872 (apply 'concat strings))
10668 10873
10669(defun org-make-link-string (link &optional description) 10874(defun org-make-link-string (link &optional description)
@@ -10682,7 +10887,15 @@ according to FMT (default from `org-email-link-description-format')."
10682 (if description (concat "[" description "]") "") 10887 (if description (concat "[" description "]") "")
10683 "]")) 10888 "]"))
10684 10889
10685(defconst org-link-escape-chars '(("[" . "%5B") ("]" . "%5D") (" " . "%20")) 10890(defconst org-link-escape-chars
10891 '((" " . "%20") ("\340" . "%E0")
10892 ("\342" . "%E2") ("\347" . "%E7")
10893 ("\350" . "%E8") ("\351" . "%E9")
10894 ("\352" . "%EA") ("\356" . "%EE")
10895 ("\364" . "%F4") ("\371" . "%F9")
10896 ("\373" . "%FB") (";" . "%3B")
10897 ("?" . "%3F") ("=" . "%3D")
10898 ("+" . "%2B"))
10686 "Association list of escapes for some characters problematic in links.") 10899 "Association list of escapes for some characters problematic in links.")
10687 10900
10688(defun org-link-escape (text) 10901(defun org-link-escape (text)
@@ -10747,6 +10960,14 @@ according to FMT (default from `org-email-link-description-format')."
10747 (setq s (replace-match "%40" t t s))) 10960 (setq s (replace-match "%40" t t s)))
10748 s) 10961 s)
10749 10962
10963;;;###autoload
10964(defun org-insert-link-global ()
10965 "Insert a link like Org-mode does.
10966This command can be called in any mode to follow a link that has
10967Org-mode syntax."
10968 (interactive)
10969 (org-run-like-in-org-mode 'org-insert-link))
10970
10750(defun org-insert-link (&optional complete-file) 10971(defun org-insert-link (&optional complete-file)
10751 "Insert a link. At the prompt, enter the link. 10972 "Insert a link. At the prompt, enter the link.
10752 10973
@@ -10959,6 +11180,14 @@ This is saved in case the need arises to restore it.")
10959(defvar org-open-link-marker (make-marker) 11180(defvar org-open-link-marker (make-marker)
10960 "Marker pointing to the location where `org-open-at-point; was called.") 11181 "Marker pointing to the location where `org-open-at-point; was called.")
10961 11182
11183;;;###autoload
11184(defun org-open-at-point-global ()
11185 "Follow a link like Org-mode does.
11186This command can be called in any mode to follow a link that has
11187Org-mode syntax."
11188 (interactive)
11189 (org-run-like-in-org-mode 'org-open-at-point))
11190
10962(defun org-open-at-point (&optional in-emacs) 11191(defun org-open-at-point (&optional in-emacs)
10963 "Open link at or after point. 11192 "Open link at or after point.
10964If there is no link at point, this function will search forward up to 11193If there is no link at point, this function will search forward up to
@@ -11018,6 +11247,9 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
11018 11247
11019 (cond 11248 (cond
11020 11249
11250 ((assoc type org-link-protocols)
11251 (funcall (nth 1 (assoc type org-link-protocols)) path))
11252
11021 ((equal type "mailto") 11253 ((equal type "mailto")
11022 (let ((cmd (car org-link-mailto-program)) 11254 (let ((cmd (car org-link-mailto-program))
11023 (args (cdr org-link-mailto-program)) args1 11255 (args (cdr org-link-mailto-program)) args1
@@ -11329,7 +11561,7 @@ to read."
11329 (setq beg (match-end 0)) 11561 (setq beg (match-end 0))
11330 (if (re-search-forward "^[ \t]*[0-9]+" nil t) 11562 (if (re-search-forward "^[ \t]*[0-9]+" nil t)
11331 (setq end (1- (match-beginning 0))))) 11563 (setq end (1- (match-beginning 0)))))
11332 (and beg end (let ((buffer-read-only)) (delete-region beg end))) 11564 (and beg end (let ((inhibit-read-only t)) (delete-region beg end)))
11333 (goto-char (point-min)) 11565 (goto-char (point-min))
11334 (select-window cwin)))) 11566 (select-window cwin))))
11335 11567
@@ -11947,8 +12179,10 @@ RET no heading at cursor position, level taken from context.
11947 12179
11948So the fastest way to store the note is to press RET RET to append it to 12180So the fastest way to store the note is to press RET RET to append it to
11949the default file. This way your current train of thought is not 12181the default file. This way your current train of thought is not
11950interrupted, in accordance with the principles of remember.el. But with 12182interrupted, in accordance with the principles of remember.el.
11951little extra effort, you can push it directly to the correct location. 12183You can also get the fast execution without prompting by using
12184C-u C-c C-c to exit the remember buffer. See also the variable
12185`org-remember-store-without-prompt'.
11952 12186
11953Before being stored away, the function ensures that the text has a 12187Before being stored away, the function ensures that the text has a
11954headline, i.e. a first line that starts with a \"*\". If not, a headline 12188headline, i.e. a first line that starts with a \"*\". If not, a headline
@@ -11964,7 +12198,8 @@ See also the variable `org-reverse-note-order'."
11964 (replace-match "")) 12198 (replace-match ""))
11965 (catch 'quit 12199 (catch 'quit
11966 (let* ((txt (buffer-substring (point-min) (point-max))) 12200 (let* ((txt (buffer-substring (point-min) (point-max)))
11967 (fastp (equal current-prefix-arg '(4))) 12201 (fastp (org-xor (equal current-prefix-arg '(4))
12202 org-remember-store-without-prompt))
11968 (file (if fastp org-default-notes-file (org-get-org-file))) 12203 (file (if fastp org-default-notes-file (org-get-org-file)))
11969 (heading org-remember-default-headline) 12204 (heading org-remember-default-headline)
11970 (visiting (org-find-base-buffer-visiting file)) 12205 (visiting (org-find-base-buffer-visiting file))
@@ -12404,7 +12639,10 @@ For calling through lisp, arg is also interpreted in the following way:
12404 done-word (nth 3 ass) 12639 done-word (nth 3 ass)
12405 final-done-word (nth 4 ass))) 12640 final-done-word (nth 4 ass)))
12406 (when (memq arg '(nextset previousset)) 12641 (when (memq arg '(nextset previousset))
12407 (message "Keyword set: %s" 12642 (message "Keyword-Set %d/%d: %s"
12643 (- (length org-todo-sets) -1
12644 (length (memq (assoc state org-todo-sets) org-todo-sets)))
12645 (length org-todo-sets)
12408 (mapconcat 'identity (assoc state org-todo-sets) " "))) 12646 (mapconcat 'identity (assoc state org-todo-sets) " ")))
12409 (setq org-last-todo-state-is-todo 12647 (setq org-last-todo-state-is-todo
12410 (not (member state org-done-keywords))) 12648 (not (member state org-done-keywords)))
@@ -12413,6 +12651,7 @@ For calling through lisp, arg is also interpreted in the following way:
12413 (listp org-log-done) (memq 'state org-log-done))) 12651 (listp org-log-done) (memq 'state org-log-done)))
12414 (cond 12652 (cond
12415 ((and state (not this)) 12653 ((and state (not this))
12654 ;; FIXME: should we remove CLOSED already then state is nil?
12416 (org-add-planning-info nil nil 'closed) 12655 (org-add-planning-info nil nil 'closed)
12417 (and dostates (org-add-log-maybe 'state state 'findpos))) 12656 (and dostates (org-add-log-maybe 'state state 'findpos)))
12418 ((and state dostates) 12657 ((and state dostates)
@@ -12571,7 +12810,8 @@ be removed."
12571 (goto-char (match-end 0)) 12810 (goto-char (match-end 0))
12572 (if (eobp) (insert "\n")) 12811 (if (eobp) (insert "\n"))
12573 (forward-char 1) 12812 (forward-char 1)
12574 (when (looking-at "[ \t]*:PROPERTIES:[ \t]*$") 12813 (when (and (not org-insert-labeled-timestamps-before-properties-drawer)
12814 (looking-at "[ \t]*:PROPERTIES:[ \t]*$"))
12575 (goto-char (match-end 0)) 12815 (goto-char (match-end 0))
12576 (if (eobp) (insert "\n")) 12816 (if (eobp) (insert "\n"))
12577 (forward-char 1)) 12817 (forward-char 1))
@@ -12580,7 +12820,7 @@ be removed."
12580 "[^\r\n]*")) 12820 "[^\r\n]*"))
12581 (not (equal (match-string 1) org-clock-string))) 12821 (not (equal (match-string 1) org-clock-string)))
12582 (narrow-to-region (match-beginning 0) (match-end 0)) 12822 (narrow-to-region (match-beginning 0) (match-end 0))
12583 (insert "\n") 12823 (insert-before-markers "\n")
12584 (backward-char 1) 12824 (backward-char 1)
12585 (narrow-to-region (point) (point)) 12825 (narrow-to-region (point) (point))
12586 (indent-to-column col)) 12826 (indent-to-column col))
@@ -12639,7 +12879,14 @@ The auto-repeater uses this.")
12639 (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*" 12879 (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*"
12640 "\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp 12880 "\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp
12641 "[^\r\n]*\\)?")) 12881 "[^\r\n]*\\)?"))
12642 (goto-char (match-end 0))) 12882 (goto-char (match-end 0))
12883 (unless org-log-states-order-reversed
12884 (if (looking-at "\n[ \t]*- State") (forward-char 1))
12885 (while (looking-at "[ \t]*- State")
12886 (condition-case nil
12887 (org-next-item)
12888 (error (org-end-of-item))))
12889 (skip-chars-backward " \t\n\r")))
12643 (move-marker org-log-note-marker (point)) 12890 (move-marker org-log-note-marker (point))
12644 (setq org-log-note-purpose purpose) 12891 (setq org-log-note-purpose purpose)
12645 (setq org-log-note-state state) 12892 (setq org-log-note-state state)
@@ -12697,10 +12944,13 @@ The auto-repeater uses this.")
12697 (move-marker org-log-note-marker nil) 12944 (move-marker org-log-note-marker nil)
12698 (end-of-line 1) 12945 (end-of-line 1)
12699 (if (not (bolp)) (insert "\n")) (indent-relative nil) 12946 (if (not (bolp)) (insert "\n")) (indent-relative nil)
12700 (setq ind (concat (buffer-substring (point-at-bol) (point)) " "))
12701 (insert " - " (pop lines)) 12947 (insert " - " (pop lines))
12702 (while lines 12948 (org-indent-line-function)
12703 (insert "\n" ind (pop lines))))))) 12949 (beginning-of-line 1)
12950 (looking-at "[ \t]*")
12951 (setq ind (concat (match-string 0) " "))
12952 (end-of-line 1)
12953 (while lines (insert "\n" ind (pop lines)))))))
12704 (set-window-configuration org-log-note-window-configuration) 12954 (set-window-configuration org-log-note-window-configuration)
12705 (with-current-buffer (marker-buffer org-log-note-return-to) 12955 (with-current-buffer (marker-buffer org-log-note-return-to)
12706 (goto-char org-log-note-return-to)) 12956 (goto-char org-log-note-return-to))
@@ -13463,7 +13713,7 @@ but in some other way.")
13463 (let (c prop) 13713 (let (c prop)
13464 (org-at-property-p) 13714 (org-at-property-p)
13465 (setq prop (match-string 2)) 13715 (setq prop (match-string 2))
13466 (message "Property Action: [s]et [d]elete [D]delete globally") 13716 (message "Property Action: [s]et [d]elete [D]elete globally [c]ompute")
13467 (setq c (read-char-exclusive)) 13717 (setq c (read-char-exclusive))
13468 (cond 13718 (cond
13469 ((equal c ?s) 13719 ((equal c ?s)
@@ -13472,6 +13722,8 @@ but in some other way.")
13472 (call-interactively 'org-delete-property)) 13722 (call-interactively 'org-delete-property))
13473 ((equal c ?D) 13723 ((equal c ?D)
13474 (call-interactively 'org-delete-property-globally)) 13724 (call-interactively 'org-delete-property-globally))
13725 ((equal c ?c)
13726 (call-interactively 'org-compute-property-at-point))
13475 (t (error "No such property action %c" c))))) 13727 (t (error "No such property action %c" c)))))
13476 13728
13477(defun org-at-property-p () 13729(defun org-at-property-p ()
@@ -13631,7 +13883,9 @@ If the property is not present at all, nil is returned."
13631 (throw 'ex tmp)) 13883 (throw 'ex tmp))
13632 (condition-case nil 13884 (condition-case nil
13633 (org-up-heading-all 1) 13885 (org-up-heading-all 1)
13634 (error (throw 'ex nil)))))))) 13886 (error (throw 'ex nil))))))
13887 (or tmp (cdr (assoc property org-local-properties))
13888 (cdr (assoc property org-global-properties)))))
13635 13889
13636(defun org-entry-put (pom property value) 13890(defun org-entry-put (pom property value)
13637 "Set PROPERTY to VALUE for entry at point-or-marker POM." 13891 "Set PROPERTY to VALUE for entry at point-or-marker POM."
@@ -13653,6 +13907,20 @@ If the property is not present at all, nil is returned."
13653 (org-priority (if (and value (stringp value) (string-match "\\S-" value)) 13907 (org-priority (if (and value (stringp value) (string-match "\\S-" value))
13654 (string-to-char value) ?\ )) 13908 (string-to-char value) ?\ ))
13655 (org-set-tags nil 'align)) 13909 (org-set-tags nil 'align))
13910 ((equal property "SCHEDULED")
13911 (if (re-search-forward org-scheduled-time-regexp end t)
13912 (cond
13913 ((eq value 'earlier) (org-timestamp-change -1 'day))
13914 ((eq value 'later) (org-timestamp-change 1 'day))
13915 (t (call-interactively 'org-schedule)))
13916 (call-interactively 'org-schedule)))
13917 ((equal property "DEADLINE")
13918 (if (re-search-forward org-deadline-time-regexp end t)
13919 (cond
13920 ((eq value 'earlier) (org-timestamp-change -1 'day))
13921 ((eq value 'later) (org-timestamp-change 1 'day))
13922 (t (call-interactively 'org-deadline)))
13923 (call-interactively 'org-deadline)))
13656 ((member property org-special-properties) 13924 ((member property org-special-properties)
13657 (error "The %s property can not yet be set with `org-entry-put'" 13925 (error "The %s property can not yet be set with `org-entry-put'"
13658 property)) 13926 property))
@@ -13762,6 +14030,19 @@ If the property is not present at all, nil is returned."
13762 (replace-match "")) 14030 (replace-match ""))
13763 (message "Property \"%s\" removed from %d entries" property cnt))))) 14031 (message "Property \"%s\" removed from %d entries" property cnt)))))
13764 14032
14033(defvar org-columns-current-fmt-compiled) ; defined below
14034
14035(defun org-compute-property-at-point ()
14036 "FIXME:"
14037 (interactive)
14038 (unless (org-at-property-p)
14039 (error "Not at a property"))
14040 (let ((prop (org-match-string-no-properties 2)))
14041 (org-columns-get-format-and-top-level)
14042 (unless (nth 3 (assoc prop org-columns-current-fmt-compiled))
14043 (error "No operator defined for property %s" prop))
14044 (org-columns-compute prop)))
14045
13765(defun org-property-get-allowed-values (pom property &optional table) 14046(defun org-property-get-allowed-values (pom property &optional table)
13766 "Get allowed values for the property PROPERTY. 14047 "Get allowed values for the property PROPERTY.
13767When TABLE is non-nil, return an alist that can directly be used for 14048When TABLE is non-nil, return an alist that can directly be used for
@@ -13779,6 +14060,7 @@ completion."
13779 ((member property org-special-properties)) 14060 ((member property org-special-properties))
13780 (t 14061 (t
13781 (setq vals (org-entry-get pom (concat property "_ALL") 'inherit)) 14062 (setq vals (org-entry-get pom (concat property "_ALL") 'inherit))
14063
13782 (when (and vals (string-match "\\S-" vals)) 14064 (when (and vals (string-match "\\S-" vals))
13783 (setq vals (car (read-from-string (concat "(" vals ")")))) 14065 (setq vals (car (read-from-string (concat "(" vals ")"))))
13784 (setq vals (mapcar (lambda (x) 14066 (setq vals (mapcar (lambda (x)
@@ -13789,6 +14071,36 @@ completion."
13789 vals))))) 14071 vals)))))
13790 (if table (mapcar 'list vals) vals))) 14072 (if table (mapcar 'list vals) vals)))
13791 14073
14074(defun org-property-previous-allowed-value (&optional previous)
14075 "Switch to the next allowed value for this property."
14076 (interactive)
14077 (org-property-next-allowed-value t))
14078
14079(defun org-property-next-allowed-value (&optional previous)
14080 "Switch to the next allowed value for this property."
14081 (interactive)
14082 (unless (org-at-property-p)
14083 (error "Not at a property"))
14084 (let* ((key (match-string 2))
14085 (value (match-string 3))
14086 (allowed (or (org-property-get-allowed-values (point) key)
14087 (and (member value '("[ ]" "[-]" "[X]"))
14088 '("[ ]" "[X]"))))
14089 nval)
14090 (unless allowed
14091 (error "Allowed values for this property have not been defined"))
14092 (if previous (setq allowed (reverse allowed)))
14093 (if (member value allowed)
14094 (setq nval (car (cdr (member value allowed)))))
14095 (setq nval (or nval (car allowed)))
14096 (if (equal nval value)
14097 (error "Only one allowed value for this property"))
14098 (org-at-property-p)
14099 (replace-match (concat " :" key ": " nval) t t)
14100 (org-indent-line-function)
14101 (beginning-of-line 1)
14102 (skip-chars-forward " \t")))
14103
13792;;; Column View 14104;;; Column View
13793 14105
13794(defvar org-columns-overlays nil 14106(defvar org-columns-overlays nil
@@ -13825,6 +14137,7 @@ This is the compiled version of the format.")
13825(org-defkey org-columns-map "a" 'org-columns-edit-allowed) 14137(org-defkey org-columns-map "a" 'org-columns-edit-allowed)
13826(org-defkey org-columns-map "s" 'org-columns-edit-attributes) 14138(org-defkey org-columns-map "s" 'org-columns-edit-attributes)
13827(org-defkey org-columns-map [right] 'forward-char) 14139(org-defkey org-columns-map [right] 'forward-char)
14140(org-defkey org-columns-map [right] (lambda () (interactive) (goto-char (1+ (point)))))
13828(org-defkey org-columns-map [(shift right)] 'org-columns-next-allowed-value) 14141(org-defkey org-columns-map [(shift right)] 'org-columns-next-allowed-value)
13829(org-defkey org-columns-map "\C-c\C-c" 'org-columns-next-allowed-value) 14142(org-defkey org-columns-map "\C-c\C-c" 'org-columns-next-allowed-value)
13830(org-defkey org-columns-map "n" 'org-columns-next-allowed-value) 14143(org-defkey org-columns-map "n" 'org-columns-next-allowed-value)
@@ -13924,12 +14237,13 @@ This is the compiled version of the format.")
13924 (setq ov (org-columns-new-overlay beg (point-at-eol))) 14237 (setq ov (org-columns-new-overlay beg (point-at-eol)))
13925 (org-overlay-put ov 'invisible t) 14238 (org-overlay-put ov 'invisible t)
13926 (org-overlay-put ov 'keymap org-columns-map) 14239 (org-overlay-put ov 'keymap org-columns-map)
14240 (org-overlay-put ov 'intangible t)
13927 (push ov org-columns-overlays) 14241 (push ov org-columns-overlays)
13928 (setq ov (org-make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) 14242 (setq ov (org-make-overlay (1- (point-at-eol)) (1+ (point-at-eol))))
13929 (org-overlay-put ov 'keymap org-columns-map) 14243 (org-overlay-put ov 'keymap org-columns-map)
13930 (push ov org-columns-overlays) 14244 (push ov org-columns-overlays)
13931 (let ((inhibit-read-only t)) 14245 (let ((inhibit-read-only t))
13932 (put-text-property (1- (point-at-bol)) 14246 (put-text-property (max (point-min) (1- (point-at-bol)))
13933 (min (point-max) (1+ (point-at-eol))) 14247 (min (point-max) (1+ (point-at-eol)))
13934 'read-only "Type `e' to edit property"))))) 14248 'read-only "Type `e' to edit property")))))
13935 14249
@@ -14032,7 +14346,7 @@ Where possible, use the standard interface for changing this line."
14032 (call-interactively 'org-deadline)))) 14346 (call-interactively 'org-deadline))))
14033 ((equal key "SCHEDULED") 14347 ((equal key "SCHEDULED")
14034 (setq eval '(org-with-point-at pom 14348 (setq eval '(org-with-point-at pom
14035 (call-interactively 'org-deadline)))) 14349 (call-interactively 'org-schedule))))
14036 (t 14350 (t
14037 (setq allowed (org-property-get-allowed-values pom key 'table)) 14351 (setq allowed (org-property-get-allowed-values pom key 'table))
14038 (if allowed 14352 (if allowed
@@ -14109,14 +14423,16 @@ Where possible, use the standard interface for changing this line."
14109 nval) 14423 nval)
14110 (when (equal key "ITEM") 14424 (when (equal key "ITEM")
14111 (error "Cannot edit item headline from here")) 14425 (error "Cannot edit item headline from here"))
14112 (unless allowed 14426 (unless (or allowed (member key '("SCHEDULED" "DEADLINE")))
14113 (error "Allowed values for this property have not been defined")) 14427 (error "Allowed values for this property have not been defined"))
14114 (if previous (setq allowed (reverse allowed))) 14428 (if (member key '("SCHEDULED" "DEADLINE"))
14115 (if (member value allowed) 14429 (setq nval (if previous 'earlier 'later))
14116 (setq nval (car (cdr (member value allowed))))) 14430 (if previous (setq allowed (reverse allowed)))
14117 (setq nval (or nval (car allowed))) 14431 (if (member value allowed)
14118 (if (equal nval value) 14432 (setq nval (car (cdr (member value allowed)))))
14119 (error "Only one allowed value for this property")) 14433 (setq nval (or nval (car allowed)))
14434 (if (equal nval value)
14435 (error "Only one allowed value for this property")))
14120 (let ((inhibit-read-only t)) 14436 (let ((inhibit-read-only t))
14121 (remove-text-properties (1- bol) eol '(read-only t)) 14437 (remove-text-properties (1- bol) eol '(read-only t))
14122 (unwind-protect 14438 (unwind-protect
@@ -14137,6 +14453,20 @@ Where possible, use the standard interface for changing this line."
14137 (< emacs-major-version 22)) 14453 (< emacs-major-version 22))
14138 (error "Emacs 22 is required for the columns feature"))))) 14454 (error "Emacs 22 is required for the columns feature")))))
14139 14455
14456(defun org-columns-get-format-and-top-level ()
14457 (let (fmt)
14458 (when (condition-case nil (org-back-to-heading) (error nil))
14459 (move-marker org-entry-property-inherited-from nil)
14460 (setq fmt (org-entry-get nil "COLUMNS" t)))
14461 (setq fmt (or fmt org-columns-default-format))
14462 (org-set-local 'org-columns-current-fmt fmt)
14463 (org-columns-compile-format fmt)
14464 (if (marker-position org-entry-property-inherited-from)
14465 (move-marker org-columns-top-level-marker
14466 org-entry-property-inherited-from)
14467 (move-marker org-columns-top-level-marker (point)))
14468 fmt))
14469
14140(defun org-columns () 14470(defun org-columns ()
14141 "Turn on column view on an org-mode file." 14471 "Turn on column view on an org-mode file."
14142 (interactive) 14472 (interactive)
@@ -14144,17 +14474,10 @@ Where possible, use the standard interface for changing this line."
14144 (org-columns-remove-overlays) 14474 (org-columns-remove-overlays)
14145 (move-marker org-columns-begin-marker (point)) 14475 (move-marker org-columns-begin-marker (point))
14146 (let (beg end fmt cache maxwidths) 14476 (let (beg end fmt cache maxwidths)
14147 (when (condition-case nil (org-back-to-heading) (error nil)) 14477 (setq fmt (org-columns-get-format-and-top-level))
14148 (move-marker org-entry-property-inherited-from nil)
14149 (setq fmt (org-entry-get nil "COLUMNS" t)))
14150 (setq fmt (or fmt org-columns-default-format))
14151 (org-set-local 'org-columns-current-fmt fmt)
14152 (org-columns-compile-format fmt)
14153 (save-excursion 14478 (save-excursion
14154 (if (marker-position org-entry-property-inherited-from) 14479 (goto-char org-columns-top-level-marker)
14155 (goto-char org-entry-property-inherited-from))
14156 (setq beg (point)) 14480 (setq beg (point))
14157 (move-marker org-columns-top-level-marker (point))
14158 (unless org-columns-inhibit-recalculation 14481 (unless org-columns-inhibit-recalculation
14159 (org-columns-compute-all)) 14482 (org-columns-compute-all))
14160 (setq end (or (condition-case nil (org-end-of-subtree t t) (error nil)) 14483 (setq end (or (condition-case nil (org-end-of-subtree t t) (error nil))
@@ -14166,7 +14489,6 @@ Where possible, use the standard interface for changing this line."
14166 (when cache 14489 (when cache
14167 (setq maxwidths (org-columns-get-autowidth-alist fmt cache)) 14490 (setq maxwidths (org-columns-get-autowidth-alist fmt cache))
14168 (org-set-local 'org-columns-current-maxwidths maxwidths) 14491 (org-set-local 'org-columns-current-maxwidths maxwidths)
14169 (goto-line (car (org-last cache)))
14170 (org-columns-display-here-title) 14492 (org-columns-display-here-title)
14171 (mapc (lambda (x) 14493 (mapc (lambda (x)
14172 (goto-line (car x)) 14494 (goto-line (car x))
@@ -14323,7 +14645,6 @@ display, or in the #+COLUMNS line of the current buffer."
14323 (when cache 14645 (when cache
14324 (setq maxwidths (org-columns-get-autowidth-alist fmt cache)) 14646 (setq maxwidths (org-columns-get-autowidth-alist fmt cache))
14325 (org-set-local 'org-columns-current-maxwidths maxwidths) 14647 (org-set-local 'org-columns-current-maxwidths maxwidths)
14326 (goto-line (car (org-last cache)))
14327 (org-columns-display-here-title) 14648 (org-columns-display-here-title)
14328 (mapc (lambda (x) 14649 (mapc (lambda (x)
14329 (goto-line (car x)) 14650 (goto-line (car x))
@@ -14347,7 +14668,8 @@ display, or in the #+COLUMNS line of the current buffer."
14347 14668
14348(defun org-columns-compute-all () 14669(defun org-columns-compute-all ()
14349 "Compute all columns that have operators defined." 14670 "Compute all columns that have operators defined."
14350 (remove-text-properties (point-min) (point-max) '(org-summaries t)) 14671 (org-unmodified
14672 (remove-text-properties (point-min) (point-max) '(org-summaries t)))
14351 (let ((columns org-columns-current-fmt-compiled) col) 14673 (let ((columns org-columns-current-fmt-compiled) col)
14352 (while (setq col (pop columns)) 14674 (while (setq col (pop columns))
14353 (when (nth 3 col) 14675 (when (nth 3 col)
@@ -14400,9 +14722,10 @@ display, or in the #+COLUMNS line of the current buffer."
14400 (if (assoc property sum-alist) 14722 (if (assoc property sum-alist)
14401 (setcdr (assoc property sum-alist) str) 14723 (setcdr (assoc property sum-alist) str)
14402 (push (cons property str) sum-alist) 14724 (push (cons property str) sum-alist)
14403 (add-text-properties sumpos (1+ sumpos) 14725 (org-unmodified
14404 (list 'org-summaries sum-alist))) 14726 (add-text-properties sumpos (1+ sumpos)
14405 (when val 14727 (list 'org-summaries sum-alist))))
14728 (when val ;?????????????????????????????????? and force?????
14406 (org-entry-put nil property str)) 14729 (org-entry-put nil property str))
14407 ;; add current to current level accumulator 14730 ;; add current to current level accumulator
14408 (aset lsum level (+ (aref lsum level) sum)) 14731 (aset lsum level (+ (aref lsum level) sum))
@@ -15009,7 +15332,7 @@ days in order to avoid rounding problems."
15009(defun org-time-string-to-absolute (s &optional daynr) 15332(defun org-time-string-to-absolute (s &optional daynr)
15010 "Convert a time stamp to an absolute day number. 15333 "Convert a time stamp to an absolute day number.
15011If there is a specifyer for a cyclic time stamp, get the closest date to 15334If there is a specifyer for a cyclic time stamp, get the closest date to
15012DATE." 15335DAYNR."
15013 (cond 15336 (cond
15014 ((and daynr (string-match "\\`%%\\((.*)\\)" s)) 15337 ((and daynr (string-match "\\`%%\\((.*)\\)" s))
15015 (if (org-diary-sexp-entry (match-string 1 s) "" date) 15338 (if (org-diary-sexp-entry (match-string 1 s) "" date)
@@ -15027,6 +15350,7 @@ DATE."
15027 15350
15028(defun org-diary-sexp-entry (sexp entry date) 15351(defun org-diary-sexp-entry (sexp entry date)
15029 "Process a SEXP diary ENTRY for DATE." 15352 "Process a SEXP diary ENTRY for DATE."
15353 (require 'diary-lib)
15030 (let ((result (if calendar-debug-sexp 15354 (let ((result (if calendar-debug-sexp
15031 (let ((stack-trace-on-error t)) 15355 (let ((stack-trace-on-error t))
15032 (eval (car (read-from-string sexp)))) 15356 (eval (car (read-from-string sexp))))
@@ -15078,7 +15402,10 @@ DATE."
15078 d m y y1 y2 date1 date2 nmonths nm ny m2) 15402 d m y y1 y2 date1 date2 nmonths nm ny m2)
15079 15403
15080 (setq start (org-date-to-gregorian start) 15404 (setq start (org-date-to-gregorian start)
15081 current (org-date-to-gregorian current) 15405 current (org-date-to-gregorian
15406 (if org-agenda-repeating-timestamp-show-all
15407 current
15408 (time-to-days (current-time))))
15082 sday (calendar-absolute-from-gregorian start) 15409 sday (calendar-absolute-from-gregorian start)
15083 cday (calendar-absolute-from-gregorian current)) 15410 cday (calendar-absolute-from-gregorian current))
15084 15411
@@ -15121,7 +15448,9 @@ DATE."
15121 (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12))) 15448 (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12)))
15122 (setq n2 (calendar-absolute-from-gregorian (list m2 d y2)))))) 15449 (setq n2 (calendar-absolute-from-gregorian (list m2 d y2))))))
15123 15450
15124 (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1)))) 15451 (if org-agenda-repeating-timestamp-show-all
15452 (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1)
15453 (if (= cday n1) n1 n2)))))
15125 15454
15126(defun org-date-to-gregorian (date) 15455(defun org-date-to-gregorian (date)
15127 "Turn any specification of DATE into a gregorian date for the calendar." 15456 "Turn any specification of DATE into a gregorian date for the calendar."
@@ -15237,7 +15566,7 @@ in the timestamp determines what will be changed."
15237 ts (match-string 0)) 15566 ts (match-string 0))
15238 (replace-match "") 15567 (replace-match "")
15239 (if (string-match 15568 (if (string-match
15240 "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( \\+[0-9]+[dwmy]\\)?\\)[]>]" 15569 "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( [-+][0-9]+[dwmy]\\)*\\)[]>]"
15241 ts) 15570 ts)
15242 (setq extra (match-string 1 ts))) 15571 (setq extra (match-string 1 ts)))
15243 (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts) 15572 (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts)
@@ -15382,9 +15711,12 @@ If necessary, clock-out of the currently active clock."
15382 (setq org-clock-heading "???")) 15711 (setq org-clock-heading "???"))
15383 (setq org-clock-heading (propertize org-clock-heading 'face nil)) 15712 (setq org-clock-heading (propertize org-clock-heading 'face nil))
15384 (beginning-of-line 2) 15713 (beginning-of-line 2)
15385 (when (and (looking-at (concat "[ \t]*" org-keyword-time-regexp)) 15714 (while
15386 (not (equal (match-string 1) org-clock-string))) 15715 (or (and (looking-at (concat "[ \t]*" org-keyword-time-regexp))
15387 ;; First line hast scheduling info, move one further 15716 (not (equal (match-string 1) org-clock-string)))
15717 (and (looking-at "[ \t]*:PROPERTIES:")
15718 (not org-insert-labeled-timestamps-before-properties-drawer)))
15719 ;; Scheduling info, or properties drawer, move one line further
15388 (beginning-of-line 2) 15720 (beginning-of-line 2)
15389 (or (bolp) (newline))) 15721 (or (bolp) (newline)))
15390 (insert "\n") (backward-char 1) 15722 (insert "\n") (backward-char 1)
@@ -15567,8 +15899,10 @@ from the `before-change-functions' in the current buffer."
15567 15899
15568(defun org-clock-out-if-current () 15900(defun org-clock-out-if-current ()
15569 "Clock out if the current entry contains the running clock. 15901 "Clock out if the current entry contains the running clock.
15570This is used to stop the clock after a TODO entry is marked DONE." 15902This is used to stop the clock after a TODO entry is marked DONE,
15571 (when (and (member state org-done-keywords) 15903and is only done if the variable `org-clock-out-when-done' is not nil."
15904 (when (and org-clock-out-when-done
15905 (member state org-done-keywords)
15572 (equal (marker-buffer org-clock-marker) (current-buffer)) 15906 (equal (marker-buffer org-clock-marker) (current-buffer))
15573 (< (point) org-clock-marker) 15907 (< (point) org-clock-marker)
15574 (> (save-excursion (outline-next-heading) (point)) 15908 (> (save-excursion (outline-next-heading) (point))
@@ -15868,6 +16202,7 @@ The following commands are available:
15868(org-defkey org-agenda-mode-map "a" 'org-agenda-toggle-archive-tag) 16202(org-defkey org-agenda-mode-map "a" 'org-agenda-toggle-archive-tag)
15869(org-defkey org-agenda-mode-map ":" 'org-agenda-set-tags) 16203(org-defkey org-agenda-mode-map ":" 'org-agenda-set-tags)
15870(org-defkey org-agenda-mode-map "." 'org-agenda-goto-today) 16204(org-defkey org-agenda-mode-map "." 'org-agenda-goto-today)
16205(org-defkey org-agenda-mode-map "j" 'org-agenda-goto-date)
15871(org-defkey org-agenda-mode-map "d" 'org-agenda-day-view) 16206(org-defkey org-agenda-mode-map "d" 'org-agenda-day-view)
15872(org-defkey org-agenda-mode-map "w" 'org-agenda-week-view) 16207(org-defkey org-agenda-mode-map "w" 'org-agenda-week-view)
15873(org-defkey org-agenda-mode-map "m" 'org-agenda-month-view) 16208(org-defkey org-agenda-mode-map "m" 'org-agenda-month-view)
@@ -15951,6 +16286,7 @@ The following commands are available:
15951 ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda 'timeline)] 16286 ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda 'timeline)]
15952 ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)] 16287 ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)]
15953 ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)] 16288 ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)]
16289 ["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)]
15954 "--" 16290 "--"
15955 ("Tags and Properties" 16291 ("Tags and Properties"
15956 ["Show all Tags" org-agenda-show-tags t] 16292 ["Show all Tags" org-agenda-show-tags t]
@@ -16017,7 +16353,7 @@ The following commands are available:
16017 "In a series of undo commands, this is the list of remaning undo items.") 16353 "In a series of undo commands, this is the list of remaning undo items.")
16018 16354
16019(defmacro org-if-unprotected (&rest body) 16355(defmacro org-if-unprotected (&rest body)
16020 "Execute BODY if ther is no `org-protected' text property at point." 16356 "Execute BODY if there is no `org-protected' text property at point."
16021 (declare (debug t)) 16357 (declare (debug t))
16022 `(unless (get-text-property (point) 'org-protected) 16358 `(unless (get-text-property (point) 'org-protected)
16023 ,@body)) 16359 ,@body))
@@ -16067,7 +16403,7 @@ that have been changed along."
16067 (if (pop entry) 16403 (if (pop entry)
16068 (with-current-buffer buf 16404 (with-current-buffer buf
16069 (let ((last-undo-buffer buf) 16405 (let ((last-undo-buffer buf)
16070 buffer-read-only) 16406 (inhibit-read-only t))
16071 (unless (memq buf org-agenda-undo-has-started-in) 16407 (unless (memq buf org-agenda-undo-has-started-in)
16072 (push buf org-agenda-undo-has-started-in) 16408 (push buf org-agenda-undo-has-started-in)
16073 (make-local-variable 'pending-undo-list) 16409 (make-local-variable 'pending-undo-list)
@@ -16106,7 +16442,7 @@ T Call `org-todo-list' to display the global todo list, select only
16106m Call `org-tags-view' to display headlines with tags matching 16442m Call `org-tags-view' to display headlines with tags matching
16107 a condition (the user is prompted for the condition). 16443 a condition (the user is prompted for the condition).
16108M Like `m', but select only TODO entries, no ordinary headlines. 16444M Like `m', but select only TODO entries, no ordinary headlines.
16109l Create a timeline for the current buffer. 16445L Create a timeline for the current buffer.
16110e Export views to associated files. 16446e Export views to associated files.
16111 16447
16112More commands can be added by configuring the variable 16448More commands can be added by configuring the variable
@@ -16128,6 +16464,8 @@ next use of \\[org-agenda]) restricted to the current file."
16128 (setq org-agenda-restrict nil) 16464 (setq org-agenda-restrict nil)
16129 (move-marker org-agenda-restrict-begin nil) 16465 (move-marker org-agenda-restrict-begin nil)
16130 (move-marker org-agenda-restrict-end nil) 16466 (move-marker org-agenda-restrict-end nil)
16467 ;; Delete old local properties
16468 (put 'org-agenda-redo-command 'org-lprops nil)
16131 ;; Remember where this call originated 16469 ;; Remember where this call originated
16132 (setq org-agenda-last-dispatch-buffer (current-buffer)) 16470 (setq org-agenda-last-dispatch-buffer (current-buffer))
16133 (save-window-excursion 16471 (save-window-excursion
@@ -16212,6 +16550,7 @@ L Timeline for current buffer # List stuck projects (!=configure)
16212 (progn 16550 (progn
16213 (setq type (nth 1 entry) match (nth 2 entry) lprops (nth 3 entry) 16551 (setq type (nth 1 entry) match (nth 2 entry) lprops (nth 3 entry)
16214 lprops (nth 3 entry)) 16552 lprops (nth 3 entry))
16553 (put 'org-agenda-redo-command 'org-lprops lprops)
16215 (cond 16554 (cond
16216 ((eq type 'agenda) 16555 ((eq type 'agenda)
16217 (org-let lprops '(org-agenda-list current-prefix-arg))) 16556 (org-let lprops '(org-agenda-list current-prefix-arg)))
@@ -16435,7 +16774,7 @@ agenda-day The day in the agenda where this is listed"
16435(defmacro org-batch-store-agenda-views (&rest parameters) 16774(defmacro org-batch-store-agenda-views (&rest parameters)
16436 "Run all custom agenda commands that have a file argument." 16775 "Run all custom agenda commands that have a file argument."
16437 (let ((cmds org-agenda-custom-commands) 16776 (let ((cmds org-agenda-custom-commands)
16438 (dir (default-directory)) 16777 (dir default-directory)
16439 pars cmd thiscmdkey files opts) 16778 pars cmd thiscmdkey files opts)
16440 (while parameters 16779 (while parameters
16441 (push (list (pop parameters) (if parameters (pop parameters))) pars)) 16780 (push (list (pop parameters) (if parameters (pop parameters))) pars))
@@ -16663,7 +17002,7 @@ Optional argument FILE means, use this file instead of the current."
16663 (progn 17002 (progn
16664 (setq buffer-read-only nil) 17003 (setq buffer-read-only nil)
16665 (goto-char (point-max)) 17004 (goto-char (point-max))
16666 (unless (= (point) 1) 17005 (unless (bobp)
16667 (insert "\n" (make-string (window-width) ?=) "\n")) 17006 (insert "\n" (make-string (window-width) ?=) "\n"))
16668 (narrow-to-region (point) (point-max))) 17007 (narrow-to-region (point) (point-max)))
16669 (org-agenda-maybe-reset-markers 'force) 17008 (org-agenda-maybe-reset-markers 'force)
@@ -16698,7 +17037,7 @@ Optional argument FILE means, use this file instead of the current."
16698 "Finishing touch for the agenda buffer, called just before displaying it." 17037 "Finishing touch for the agenda buffer, called just before displaying it."
16699 (unless org-agenda-multi 17038 (unless org-agenda-multi
16700 (save-excursion 17039 (save-excursion
16701 (let ((buffer-read-only)) 17040 (let ((inhibit-read-only t))
16702 (goto-char (point-min)) 17041 (goto-char (point-min))
16703 (while (org-activate-bracket-links (point-max)) 17042 (while (org-activate-bracket-links (point-max))
16704 (add-text-properties (match-beginning 0) (match-end 0) 17043 (add-text-properties (match-beginning 0) (match-end 0)
@@ -16721,6 +17060,7 @@ Optional argument FILE means, use this file instead of the current."
16721 (let ((pa '(:org-archived t)) 17060 (let ((pa '(:org-archived t))
16722 (pc '(:org-comment t)) 17061 (pc '(:org-comment t))
16723 (pall '(:org-archived t :org-comment t)) 17062 (pall '(:org-archived t :org-comment t))
17063 (inhibit-read-only t)
16724 (rea (concat ":" org-archive-tag ":")) 17064 (rea (concat ":" org-archive-tag ":"))
16725 bmp file re) 17065 bmp file re)
16726 (save-excursion 17066 (save-excursion
@@ -16750,18 +17090,20 @@ Optional argument FILE means, use this file instead of the current."
16750 17090
16751(defvar org-agenda-skip-function nil 17091(defvar org-agenda-skip-function nil
16752 "Function to be called at each match during agenda construction. 17092 "Function to be called at each match during agenda construction.
16753If this function return nil, the current match should not be skipped. 17093If this function returns nil, the current match should not be skipped.
16754Otherwise, the function must return a position from where the search 17094Otherwise, the function must return a position from where the search
16755should be continued. 17095should be continued.
17096This may also be a Lisp form, it will be evaluated.
16756Never set this variable using `setq' or so, because then it will apply 17097Never set this variable using `setq' or so, because then it will apply
16757to all future agenda commands. Instead, bind it with `let' to scope 17098to all future agenda commands. Instead, bind it with `let' to scope
16758it dynamically into the agenda-constructing command.") 17099it dynamically into the agenda-constructing command. A good way to set
17100it is through options in org-agenda-custom-commands.")
16759 17101
16760(defun org-agenda-skip () 17102(defun org-agenda-skip ()
16761 "Throw to `:skip' in places that should be skipped. 17103 "Throw to `:skip' in places that should be skipped.
16762Also moves point to the end of the skipped region, so that search can 17104Also moves point to the end of the skipped region, so that search can
16763continue from there." 17105continue from there."
16764 (let ((p (point-at-bol)) to) 17106 (let ((p (point-at-bol)) to fp)
16765 (and org-agenda-skip-archived-trees 17107 (and org-agenda-skip-archived-trees
16766 (get-text-property p :org-archived) 17108 (get-text-property p :org-archived)
16767 (org-end-of-subtree t) 17109 (org-end-of-subtree t)
@@ -16770,10 +17112,13 @@ continue from there."
16770 (org-end-of-subtree t) 17112 (org-end-of-subtree t)
16771 (throw :skip t)) 17113 (throw :skip t))
16772 (if (equal (char-after p) ?#) (throw :skip t)) 17114 (if (equal (char-after p) ?#) (throw :skip t))
16773 (when (and (functionp org-agenda-skip-function) 17115 (when (and (or (setq fp (functionp org-agenda-skip-function))
17116 (consp org-agenda-skip-function))
16774 (setq to (save-excursion 17117 (setq to (save-excursion
16775 (save-match-data 17118 (save-match-data
16776 (funcall org-agenda-skip-function))))) 17119 (if fp
17120 (funcall org-agenda-skip-function)
17121 (eval org-agenda-skip-function))))))
16777 (goto-char to) 17122 (goto-char to)
16778 (throw :skip t)))) 17123 (throw :skip t))))
16779 17124
@@ -17288,12 +17633,66 @@ used by user-defined selections using `org-agenda-skip-function'.")
17288If yes, it returns the end position of this tree, causing agenda commands 17633If yes, it returns the end position of this tree, causing agenda commands
17289to skip this subtree. This is a function that can be put into 17634to skip this subtree. This is a function that can be put into
17290`org-agenda-skip-function' for the duration of a command." 17635`org-agenda-skip-function' for the duration of a command."
17291 (save-match-data 17636 (let ((end (save-excursion (org-end-of-subtree t)))
17292 (let ((end (save-excursion (org-end-of-subtree t))) 17637 skip)
17293 skip) 17638 (save-excursion
17294 (save-excursion 17639 (setq skip (re-search-forward org-agenda-skip-regexp end t)))
17295 (setq skip (re-search-forward org-agenda-skip-regexp end t))) 17640 (and skip end)))
17296 (and skip end)))) 17641
17642(defun org-agenda-skip-entry-if (&rest conditions)
17643 "Skip entry is any of CONDITIONS is true.
17644See `org-agenda-skip-if for details."
17645 (org-agenda-skip-if nil conditions))
17646(defun org-agenda-skip-subtree-if (&rest conditions)
17647 "Skip entry is any of CONDITIONS is true.
17648See `org-agenda-skip-if for details."
17649 (org-agenda-skip-if t conditions))
17650
17651(defun org-agenda-skip-if (subtree conditions)
17652 "Checks current entity for CONDITIONS.
17653If SUBTREE is non-nil, the entire subtree is checked. Otherwise, only
17654the entry, i.e. the text before the next heading is checked.
17655
17656CONDITIONS is a list of symbols, boolean OR is used to combine the results
17657from different tests. Valid conditions are:
17658
17659scheduled Check if there is a scheduled cookie
17660notscheduled Check if there is no scheduled cookie
17661deadline Check if there is a deadline
17662notdeadline Check if there is no deadline
17663regexp Check if regexp matches
17664notregexp Check if regexp does not match.
17665
17666The regexp is taken from the conditions list, it must com right after the
17667`regexp' of `notregexp' element.
17668
17669If any of these conditions is met, this function returns the end point of
17670the entity, causing the search to continue from there. This is a function
17671that can be put into `org-agenda-skip-function' for the duration of a command."
17672 (let (beg end m r)
17673 (org-back-to-heading t)
17674 (setq beg (point)
17675 end (if subtree
17676 (progn (org-end-of-subtree t) (point))
17677 (progn (outline-next-heading) (1- (point)))))
17678 (goto-char beg)
17679 (and
17680 (or
17681 (and (memq 'scheduled conditions)
17682 (re-search-forward org-scheduled-time-regexp end t))
17683 (and (memq 'notscheduled conditions)
17684 (not (re-search-forward org-scheduled-time-regexp end t)))
17685 (and (memq 'deadline conditions)
17686 (re-search-forward org-deadline-time-regexp end t))
17687 (and (memq 'notdeadline conditions)
17688 (not (re-search-forward org-deadline-time-regexp end t)))
17689 (and (setq m (memq 'regexp conditions))
17690 (stringp (setq r (nth 1 m)))
17691 (re-search-forward m end t))
17692 (and (setq m (memq 'notregexp conditions))
17693 (stringp (setq r (nth 1 m)))
17694 (not (re-search-forward m end t))))
17695 end)))
17297 17696
17298(defun org-agenda-list-stuck-projects (&rest ignore) 17697(defun org-agenda-list-stuck-projects (&rest ignore)
17299 "Create agenda view for projects that are stuck. 17698 "Create agenda view for projects that are stuck.
@@ -17303,6 +17702,7 @@ of what a project is and how to check if it stuck, customize the variable
17303MATCH is being ignored." 17702MATCH is being ignored."
17304 (interactive) 17703 (interactive)
17305 (let* ((org-agenda-skip-function 'org-agenda-skip-subtree-when-regexp-matches) 17704 (let* ((org-agenda-skip-function 'org-agenda-skip-subtree-when-regexp-matches)
17705 ;; FIXME: we could have used org-agenda-skip-if here.
17306 (org-agenda-overriding-header "List of stuck projects: ") 17706 (org-agenda-overriding-header "List of stuck projects: ")
17307 (matcher (nth 0 org-stuck-projects)) 17707 (matcher (nth 0 org-stuck-projects))
17308 (todo (nth 1 org-stuck-projects)) 17708 (todo (nth 1 org-stuck-projects))
@@ -17361,13 +17761,13 @@ MATCH is being ignored."
17361 (setq entries nil) 17761 (setq entries nil)
17362 (with-current-buffer fancy-diary-buffer 17762 (with-current-buffer fancy-diary-buffer
17363 (setq buffer-read-only nil) 17763 (setq buffer-read-only nil)
17364 (if (= (point-max) 1) 17764 (if (zerop (buffer-size))
17365 ;; No entries 17765 ;; No entries
17366 (setq entries nil) 17766 (setq entries nil)
17367 ;; Omit the date and other unnecessary stuff 17767 ;; Omit the date and other unnecessary stuff
17368 (org-agenda-cleanup-fancy-diary) 17768 (org-agenda-cleanup-fancy-diary)
17369 ;; Add prefix to each line and extend the text properties 17769 ;; Add prefix to each line and extend the text properties
17370 (if (= (point-max) 1) 17770 (if (zerop (buffer-size))
17371 (setq entries nil) 17771 (setq entries nil)
17372 (setq entries (buffer-substring (point-min) (- (point-max) 1))))) 17772 (setq entries (buffer-substring (point-min) (- (point-max) 1)))))
17373 (set-buffer-modified-p nil) 17773 (set-buffer-modified-p nil)
@@ -17553,8 +17953,7 @@ the documentation of `org-diary'."
17553 ((eq arg :closed) 17953 ((eq arg :closed)
17554 (setq rtn (org-agenda-get-closed)) 17954 (setq rtn (org-agenda-get-closed))
17555 (setq results (append results rtn))) 17955 (setq results (append results rtn)))
17556 ((and (eq arg :deadline) 17956 ((eq arg :deadline)
17557 (equal date (calendar-current-date)))
17558 (setq rtn (org-agenda-get-deadlines)) 17957 (setq rtn (org-agenda-get-deadlines))
17559 (setq results (append results rtn)))))))) 17958 (setq results (append results rtn))))))))
17560 results)))) 17959 results))))
@@ -17564,7 +17963,7 @@ the documentation of `org-diary'."
17564(defun org-entry-is-done-p () 17963(defun org-entry-is-done-p ()
17565 "Is the current entry marked DONE?" 17964 "Is the current entry marked DONE?"
17566 (save-excursion 17965 (save-excursion
17567 (and (re-search-backward "[\r\n]\\* " nil t) 17966 (and (re-search-backward "[\r\n]\\*+ " nil t)
17568 (looking-at org-nl-done-regexp)))) 17967 (looking-at org-nl-done-regexp))))
17569 17968
17570(defun org-at-date-range-p (&optional inactive-ok) 17969(defun org-at-date-range-p (&optional inactive-ok)
@@ -17597,7 +17996,7 @@ the documentation of `org-diary'."
17597 (format "mouse-2 or RET jump to org file %s" 17996 (format "mouse-2 or RET jump to org file %s"
17598 (abbreviate-file-name buffer-file-name)))) 17997 (abbreviate-file-name buffer-file-name))))
17599 ;; FIXME: get rid of the \n at some point but watch out 17998 ;; FIXME: get rid of the \n at some point but watch out
17600 (regexp (concat "\n\\*+[ \t]+\\(" 17999 (regexp (concat "^\\*+[ \t]+\\("
17601 (if org-select-this-todo-keyword 18000 (if org-select-this-todo-keyword
17602 (if (equal org-select-this-todo-keyword "*") 18001 (if (equal org-select-this-todo-keyword "*")
17603 org-todo-regexp 18002 org-todo-regexp
@@ -17625,7 +18024,7 @@ the documentation of `org-diary'."
17625 (goto-char beg) 18024 (goto-char beg)
17626 (org-agenda-skip) 18025 (org-agenda-skip)
17627 (goto-char (match-beginning 1)) 18026 (goto-char (match-beginning 1))
17628 (setq marker (org-agenda-new-marker (1+ (match-beginning 0))) 18027 (setq marker (org-agenda-new-marker (match-beginning 0))
17629 category (org-get-category) 18028 category (org-get-category)
17630 tags (org-get-tags-at (point)) 18029 tags (org-get-tags-at (point))
17631 txt (org-format-agenda-item "" (match-string 1) category tags) 18030 txt (org-format-agenda-item "" (match-string 1) category tags)
@@ -17653,13 +18052,6 @@ the documentation of `org-diary'."
17653 'help-echo 18052 'help-echo
17654 (format "mouse-2 or RET jump to org file %s" 18053 (format "mouse-2 or RET jump to org file %s"
17655 (abbreviate-file-name buffer-file-name)))) 18054 (abbreviate-file-name buffer-file-name))))
17656;???? (regexp (regexp-quote
17657; (substring
17658; (format-time-string
17659; (car org-time-stamp-formats)
17660; (apply 'encode-time ; DATE bound by calendar
17661; (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
17662; 0 11)))
17663 (d1 (calendar-absolute-from-gregorian date)) 18055 (d1 (calendar-absolute-from-gregorian date))
17664 (regexp 18056 (regexp
17665 (concat 18057 (concat
@@ -17696,12 +18088,7 @@ the documentation of `org-diary'."
17696 deadlinep (string-match org-deadline-regexp tmp) 18088 deadlinep (string-match org-deadline-regexp tmp)
17697 scheduledp (string-match org-scheduled-regexp tmp) 18089 scheduledp (string-match org-scheduled-regexp tmp)
17698 donep (org-entry-is-done-p)) 18090 donep (org-entry-is-done-p))
17699 (and org-agenda-skip-scheduled-if-done 18091 (if (or scheduledp deadlinep) (throw :skip t))
17700 scheduledp donep
17701 (throw :skip t))
17702 (and org-agenda-skip-deadline-if-done
17703 deadlinep donep
17704 (throw :skip t))
17705 (if (string-match ">" timestr) 18092 (if (string-match ">" timestr)
17706 ;; substring should only run to end of time stamp 18093 ;; substring should only run to end of time stamp
17707 (setq timestr (substring timestr 0 (match-end 0)))) 18094 (setq timestr (substring timestr 0 (match-end 0))))
@@ -17713,29 +18100,14 @@ the documentation of `org-diary'."
17713 tags (org-get-tags-at)) 18100 tags (org-get-tags-at))
17714 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") 18101 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
17715 (setq txt (org-format-agenda-item 18102 (setq txt (org-format-agenda-item
17716 (format "%s%s" 18103 nil (match-string 1) category tags timestr)))
17717 (if deadlinep "Deadline: " "")
17718 (if scheduledp "Scheduled: " ""))
17719 (match-string 1) category tags timestr)))
17720 (setq txt org-agenda-no-heading-message)) 18104 (setq txt org-agenda-no-heading-message))
17721 (setq priority (org-get-priority txt)) 18105 (setq priority (org-get-priority txt))
17722 (org-add-props txt props 18106 (org-add-props txt props
17723 'org-marker marker 'org-hd-marker hdmarker) 18107 'org-marker marker 'org-hd-marker hdmarker)
17724 (if deadlinep 18108 (org-add-props txt nil 'priority priority
17725 (org-add-props txt nil 18109 'org-category category 'date date
17726 'face (if donep 'org-done 'org-warning) 18110 'type "timestamp")
17727 'type "deadline" 'date date
17728 'undone-face 'org-warning 'done-face 'org-done
17729 'org-category category 'priority (+ 100 priority))
17730 (if scheduledp
17731 (org-add-props txt nil
17732 'face 'org-scheduled-today
17733 'type "scheduled" 'date date
17734 'undone-face 'org-scheduled-today 'done-face 'org-done
17735 'org-category category 'priority (+ 99 priority))
17736 (org-add-props txt nil 'priority priority
17737 'org-category category 'date date
17738 'type "timestamp")))
17739 (push txt ee)) 18111 (push txt ee))
17740 (outline-next-heading))) 18112 (outline-next-heading)))
17741 (nreverse ee))) 18113 (nreverse ee)))
@@ -17837,8 +18209,7 @@ the documentation of `org-diary'."
17837 18209
17838(defun org-agenda-get-deadlines () 18210(defun org-agenda-get-deadlines ()
17839 "Return the deadline information for agenda display." 18211 "Return the deadline information for agenda display."
17840 (let* ((wdays org-deadline-warning-days) 18212 (let* ((props (list 'mouse-face 'highlight
17841 (props (list 'mouse-face 'highlight
17842 'org-not-done-regexp org-not-done-regexp 18213 'org-not-done-regexp org-not-done-regexp
17843 'org-todo-regexp org-todo-regexp 18214 'org-todo-regexp org-todo-regexp
17844 'keymap org-agenda-keymap 18215 'keymap org-agenda-keymap
@@ -17848,21 +18219,31 @@ the documentation of `org-diary'."
17848 (regexp org-deadline-time-regexp) 18219 (regexp org-deadline-time-regexp)
17849 (todayp (equal date (calendar-current-date))) ; DATE bound by calendar 18220 (todayp (equal date (calendar-current-date))) ; DATE bound by calendar
17850 (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar 18221 (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
17851 d2 diff pos pos1 category tags 18222 d2 diff dfrac wdays pos pos1 category tags
17852 ee txt head face) 18223 ee txt head face s upcomingp)
17853 (goto-char (point-min)) 18224 (goto-char (point-min))
17854 (while (re-search-forward regexp nil t) 18225 (while (re-search-forward regexp nil t)
17855 (catch :skip 18226 (catch :skip
17856 (org-agenda-skip) 18227 (org-agenda-skip)
17857 (setq pos (1- (match-beginning 1)) 18228 (setq s (match-string 1)
17858;??? d2 (time-to-days 18229 pos (1- (match-beginning 1))
17859;??? (org-time-string-to-time (match-string 1)))
17860 d2 (org-time-string-to-absolute (match-string 1) d1) 18230 d2 (org-time-string-to-absolute (match-string 1) d1)
17861 diff (- d2 d1)) 18231 diff (- d2 d1))
18232 (if (string-match "-\\([0-9]+\\)\\([dwmy]\\)\\'" s)
18233 (setq wdays
18234 (floor
18235 (* (string-to-number (match-string 1 s))
18236 (cdr (assoc (match-string 2 s)
18237 '(("d" . 1) ("w" . 7)
18238 ("m" . 30.4) ("y" . 365.25)))))))
18239 (setq wdays org-deadline-warning-days))
18240 (setq dfrac (/ (* 1.0 (- wdays diff)) wdays))
18241 (setq upcomingp (and todayp (> diff 0)))
17862 ;; When to show a deadline in the calendar: 18242 ;; When to show a deadline in the calendar:
17863 ;; If the expiration is within wdays warning time. 18243 ;; If the expiration is within wdays warning time.
17864 ;; Past-due deadlines are only shown on the current date 18244 ;; Past-due deadlines are only shown on the current date
17865 (if (and (< diff wdays) todayp (not (= diff 0))) 18245 (if (or (and (<= diff wdays) todayp)
18246 (= diff 0))
17866 (save-excursion 18247 (save-excursion
17867 (setq category (org-get-category)) 18248 (setq category (org-get-category))
17868 (if (re-search-backward "^\\*+[ \t]+" nil t) 18249 (if (re-search-backward "^\\*+[ \t]+" nil t)
@@ -17874,31 +18255,41 @@ the documentation of `org-diary'."
17874 (point) 18255 (point)
17875 (progn (skip-chars-forward "^\r\n") 18256 (progn (skip-chars-forward "^\r\n")
17876 (point)))) 18257 (point))))
17877 (if (string-match org-looking-at-done-regexp head) 18258 (if (and org-agenda-skip-deadline-if-done
18259 (string-match org-looking-at-done-regexp head))
17878 (setq txt nil) 18260 (setq txt nil)
17879 (setq txt (org-format-agenda-item 18261 (setq txt (org-format-agenda-item
17880 (format "In %3d d.: " diff) head category tags)))) 18262 (if (= diff 0)
18263 "Deadline: "
18264 (format "In %3d d.: " diff))
18265 head category tags))))
17881 (setq txt org-agenda-no-heading-message)) 18266 (setq txt org-agenda-no-heading-message))
17882 (when txt 18267 (when txt
17883 (setq face (cond ((<= diff 0) 'org-warning) 18268 (setq face (org-agenda-deadline-face dfrac))
17884 ((<= diff 5) 'org-upcoming-deadline)
17885 (t nil)))
17886 (org-add-props txt props 18269 (org-add-props txt props
17887 'org-marker (org-agenda-new-marker pos) 18270 'org-marker (org-agenda-new-marker pos)
17888 'org-hd-marker (org-agenda-new-marker pos1) 18271 'org-hd-marker (org-agenda-new-marker pos1)
17889 'priority (+ (- 10 diff) (org-get-priority txt)) 18272 'priority (+ (if upcomingp (floor (* dfrac 10.)) 100)
18273 (org-get-priority txt))
17890 'org-category category 18274 'org-category category
17891 'type "upcoming-deadline" 'date d2 18275 'type (if upcomingp "upcoming-deadline" "deadline")
18276 'date (if upcomingp date d2)
17892 'face face 'undone-face face 'done-face 'org-done) 18277 'face face 'undone-face face 'done-face 'org-done)
17893 (push txt ee)))))) 18278 (push txt ee))))))
17894 ee)) 18279 ee))
17895 18280
18281(defun org-agenda-deadline-face (fraction)
18282 "Return the face to displaying a deadline item.
18283FRACTION is what fraction of the head-warning time has passed."
18284 (let ((faces org-agenda-deadline-faces) f)
18285 (catch 'exit
18286 (while (setq f (pop faces))
18287 (if (>= fraction (car f)) (throw 'exit (cdr f)))))))
18288
17896(defun org-agenda-get-scheduled () 18289(defun org-agenda-get-scheduled ()
17897 "Return the scheduled information for agenda display." 18290 "Return the scheduled information for agenda display."
17898 (let* ((props (list 'face 'org-scheduled-previously 18291 (let* ((props (list 'org-not-done-regexp org-not-done-regexp
17899 'org-not-done-regexp org-not-done-regexp
17900 'org-todo-regexp org-todo-regexp 18292 'org-todo-regexp org-todo-regexp
17901 'undone-face 'org-scheduled-previously
17902 'done-face 'org-done 18293 'done-face 'org-done
17903 'mouse-face 'highlight 18294 'mouse-face 'highlight
17904 'keymap org-agenda-keymap 18295 'keymap org-agenda-keymap
@@ -17909,19 +18300,19 @@ the documentation of `org-diary'."
17909 (todayp (equal date (calendar-current-date))) ; DATE bound by calendar 18300 (todayp (equal date (calendar-current-date))) ; DATE bound by calendar
17910 (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar 18301 (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
17911 d2 diff pos pos1 category tags 18302 d2 diff pos pos1 category tags
17912 ee txt head) 18303 ee txt head pastduep donep face)
17913 (goto-char (point-min)) 18304 (goto-char (point-min))
17914 (while (re-search-forward regexp nil t) 18305 (while (re-search-forward regexp nil t)
17915 (catch :skip 18306 (catch :skip
17916 (org-agenda-skip) 18307 (org-agenda-skip)
17917 (setq pos (1- (match-beginning 1)) 18308 (setq pos (1- (match-beginning 1))
17918 d2 (org-time-string-to-absolute (match-string 1) d1) 18309 d2 (org-time-string-to-absolute (match-string 1) d1)
17919;??? d2 (time-to-days
17920;??? (org-time-string-to-time (match-string 1)))
17921 diff (- d2 d1)) 18310 diff (- d2 d1))
18311 (setq pastduep (and todayp (< diff 0)))
17922 ;; When to show a scheduled item in the calendar: 18312 ;; When to show a scheduled item in the calendar:
17923 ;; If it is on or past the date. 18313 ;; If it is on or past the date.
17924 (if (and (< diff 0) todayp) 18314 (if (or (and (< diff 0) todayp)
18315 (= diff 0))
17925 (save-excursion 18316 (save-excursion
17926 (setq category (org-get-category)) 18317 (setq category (org-get-category))
17927 (if (re-search-backward "^\\*+[ \t]+" nil t) 18318 (if (re-search-backward "^\\*+[ \t]+" nil t)
@@ -17932,17 +18323,26 @@ the documentation of `org-diary'."
17932 (setq head (buffer-substring-no-properties 18323 (setq head (buffer-substring-no-properties
17933 (point) 18324 (point)
17934 (progn (skip-chars-forward "^\r\n") (point)))) 18325 (progn (skip-chars-forward "^\r\n") (point))))
17935 (if (string-match org-looking-at-done-regexp head) 18326 (setq donep (string-match org-looking-at-done-regexp head))
18327 (if (and org-agenda-skip-scheduled-if-done donep)
17936 (setq txt nil) 18328 (setq txt nil)
17937 (setq txt (org-format-agenda-item 18329 (setq txt (org-format-agenda-item
17938 (format "Sched.%2dx: " (- 1 diff)) head 18330 (if (= diff 0)
17939 category tags)))) 18331 "Scheduled: "
18332 (format "Sched.%2dx: " (- 1 diff)))
18333 head category tags))))
17940 (setq txt org-agenda-no-heading-message)) 18334 (setq txt org-agenda-no-heading-message))
17941 (when txt 18335 (when txt
18336 (setq face (if pastduep
18337 'org-scheduled-previously
18338 'org-scheduled-today))
17942 (org-add-props txt props 18339 (org-add-props txt props
18340 'undone-face face
18341 'face (if donep 'org-done face)
17943 'org-marker (org-agenda-new-marker pos) 18342 'org-marker (org-agenda-new-marker pos)
17944 'org-hd-marker (org-agenda-new-marker pos1) 18343 'org-hd-marker (org-agenda-new-marker pos1)
17945 'type "past-scheduled" 'date d2 18344 'type (if pastduep "past-scheduled" "scheduled")
18345 'date (if pastduep d2 date)
17946 'priority (+ (- 5 diff) (org-get-priority txt)) 18346 'priority (+ (- 5 diff) (org-get-priority txt))
17947 'org-category category) 18347 'org-category category)
17948 (push txt ee)))))) 18348 (push txt ee))))))
@@ -18357,15 +18757,21 @@ When this is the global TODO list, a prefix argument will be interpreted."
18357 (interactive) 18757 (interactive)
18358 (let* ((org-agenda-keep-modes t) 18758 (let* ((org-agenda-keep-modes t)
18359 (line (org-current-line)) 18759 (line (org-current-line))
18360 (window-line (- line (org-current-line (window-start))))) 18760 (window-line (- line (org-current-line (window-start))))
18761 (lprops (get 'org-agenda-redo-command 'org-lprops)))
18361 (message "Rebuilding agenda buffer...") 18762 (message "Rebuilding agenda buffer...")
18362 (eval org-agenda-redo-command) 18763 (org-let lprops '(eval org-agenda-redo-command))
18363 (setq org-agenda-undo-list nil 18764 (setq org-agenda-undo-list nil
18364 org-agenda-pending-undo-list nil) 18765 org-agenda-pending-undo-list nil)
18365 (message "Rebuilding agenda buffer...done") 18766 (message "Rebuilding agenda buffer...done")
18366 (goto-line line) 18767 (goto-line line)
18367 (recenter window-line))) 18768 (recenter window-line)))
18368 18769
18770(defun org-agenda-goto-date (date)
18771 "Jump to DATE in agenda."
18772 (interactive (list (org-read-date)))
18773 (org-agenda-list nil date))
18774
18369(defun org-agenda-goto-today () 18775(defun org-agenda-goto-today ()
18370 "Go to today." 18776 "Go to today."
18371 (interactive) 18777 (interactive)
@@ -18700,7 +19106,7 @@ If this information is not given, the function uses the tree at point."
18700 (setq p (marker-position m)) 19106 (setq p (marker-position m))
18701 (>= p beg) 19107 (>= p beg)
18702 (<= p end)) 19108 (<= p end))
18703 (let (buffer-read-only) 19109 (let ((inhibit-read-only t))
18704 (delete-region (point-at-bol) (1+ (point-at-eol))))) 19110 (delete-region (point-at-bol) (1+ (point-at-eol)))))
18705 (beginning-of-line 0)))))) 19111 (beginning-of-line 0))))))
18706 19112
@@ -18811,7 +19217,7 @@ the same tree node, and the headline of the tree node in the Org-mode file."
18811 (buffer (marker-buffer marker)) 19217 (buffer (marker-buffer marker))
18812 (pos (marker-position marker)) 19218 (pos (marker-position marker))
18813 (hdmarker (get-text-property (point) 'org-hd-marker)) 19219 (hdmarker (get-text-property (point) 'org-hd-marker))
18814 (buffer-read-only nil) 19220 (inhibit-read-only t)
18815 newhead) 19221 newhead)
18816 (org-with-remote-undo buffer 19222 (org-with-remote-undo buffer
18817 (with-current-buffer buffer 19223 (with-current-buffer buffer
@@ -18839,7 +19245,7 @@ The new content of the line will be NEWHEAD (as modified by
18839`equal' against all `org-hd-marker' text properties in the file. 19245`equal' against all `org-hd-marker' text properties in the file.
18840If FIXFACE is non-nil, the face of each item is modified acording to 19246If FIXFACE is non-nil, the face of each item is modified acording to
18841the new TODO state." 19247the new TODO state."
18842 (let* ((buffer-read-only nil) 19248 (let* ((inhibit-read-only t)
18843 props m pl undone-face done-face finish new dotime cat tags) 19249 props m pl undone-face done-face finish new dotime cat tags)
18844 (save-excursion 19250 (save-excursion
18845 (goto-char (point-max)) 19251 (goto-char (point-max))
@@ -18881,7 +19287,7 @@ the new TODO state."
18881;; See the code in set-tags for the way to do this. 19287;; See the code in set-tags for the way to do this.
18882(defun org-agenda-align-tags (&optional line) 19288(defun org-agenda-align-tags (&optional line)
18883 "Align all tags in agenda items to `org-agenda-align-tags-to-column'." 19289 "Align all tags in agenda items to `org-agenda-align-tags-to-column'."
18884 (let ((buffer-read-only)) 19290 (let ((inhibit-read-only t))
18885 (save-excursion 19291 (save-excursion
18886 (goto-char (if line (point-at-bol) (point-min))) 19292 (goto-char (if line (point-at-bol) (point-min)))
18887 (while (re-search-forward (org-re "\\([ \t]+\\):[[:alnum:]_@:]+:[ \t]*$") 19293 (while (re-search-forward (org-re "\\([ \t]+\\):[[:alnum:]_@:]+:[ \t]*$")
@@ -18911,10 +19317,10 @@ the same tree node, and the headline of the tree node in the Org-mode file."
18911 (org-agenda-check-no-diary) 19317 (org-agenda-check-no-diary)
18912 (let* ((marker (or (get-text-property (point) 'org-marker) 19318 (let* ((marker (or (get-text-property (point) 'org-marker)
18913 (org-agenda-error))) 19319 (org-agenda-error)))
18914 (buffer (marker-buffer marker))
18915 (pos (marker-position marker))
18916 (hdmarker (get-text-property (point) 'org-hd-marker)) 19320 (hdmarker (get-text-property (point) 'org-hd-marker))
18917 (buffer-read-only nil) 19321 (buffer (marker-buffer hdmarker))
19322 (pos (marker-position hdmarker))
19323 (inhibit-read-only t)
18918 newhead) 19324 newhead)
18919 (org-with-remote-undo buffer 19325 (org-with-remote-undo buffer
18920 (with-current-buffer buffer 19326 (with-current-buffer buffer
@@ -18964,7 +19370,7 @@ the tags of the current headline come last."
18964 (org-agenda-error))) 19370 (org-agenda-error)))
18965 (buffer (marker-buffer hdmarker)) 19371 (buffer (marker-buffer hdmarker))
18966 (pos (marker-position hdmarker)) 19372 (pos (marker-position hdmarker))
18967 (buffer-read-only nil) 19373 (inhibit-read-only t)
18968 newhead) 19374 newhead)
18969 (org-with-remote-undo buffer 19375 (org-with-remote-undo buffer
18970 (with-current-buffer buffer 19376 (with-current-buffer buffer
@@ -18991,7 +19397,7 @@ the tags of the current headline come last."
18991 (org-agenda-error))) 19397 (org-agenda-error)))
18992 (buffer (marker-buffer hdmarker)) 19398 (buffer (marker-buffer hdmarker))
18993 (pos (marker-position hdmarker)) 19399 (pos (marker-position hdmarker))
18994 (buffer-read-only nil) 19400 (inhibit-read-only t)
18995 newhead) 19401 newhead)
18996 (org-with-remote-undo buffer 19402 (org-with-remote-undo buffer
18997 (with-current-buffer buffer 19403 (with-current-buffer buffer
@@ -19034,7 +19440,7 @@ the tags of the current headline come last."
19034(defun org-agenda-show-new-time (marker stamp) 19440(defun org-agenda-show-new-time (marker stamp)
19035 "Show new date stamp via text properties." 19441 "Show new date stamp via text properties."
19036 ;; We use text properties to make this undoable 19442 ;; We use text properties to make this undoable
19037 (let ((buffer-read-only nil)) 19443 (let ((inhibit-read-only t))
19038 (setq stamp (concat " => " stamp)) 19444 (setq stamp (concat " => " stamp))
19039 (save-excursion 19445 (save-excursion
19040 (goto-char (point-max)) 19446 (goto-char (point-max))
@@ -19619,6 +20025,8 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
19619 (:skip-before-1st-heading . org-export-skip-text-before-1st-heading) 20025 (:skip-before-1st-heading . org-export-skip-text-before-1st-heading)
19620 (:fixed-width . org-export-with-fixed-width) 20026 (:fixed-width . org-export-with-fixed-width)
19621 (:timestamps . org-export-with-timestamps) 20027 (:timestamps . org-export-with-timestamps)
20028 (:author-info . org-export-author-info)
20029 (:time-stamp-file . org-export-time-stamp-file)
19622 (:tables . org-export-with-tables) 20030 (:tables . org-export-with-tables)
19623 (:table-auto-headline . org-export-highlight-first-table-line) 20031 (:table-auto-headline . org-export-highlight-first-table-line)
19624 (:style . org-export-html-style) 20032 (:style . org-export-html-style)
@@ -19675,7 +20083,9 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
19675 ("*" . :emphasize) 20083 ("*" . :emphasize)
19676 ("TeX" . :TeX-macros) 20084 ("TeX" . :TeX-macros)
19677 ("LaTeX" . :LaTeX-fragments) 20085 ("LaTeX" . :LaTeX-fragments)
19678 ("skip" . :skip-before-1st-heading))) 20086 ("skip" . :skip-before-1st-heading)
20087 ("author" . :author-info)
20088 ("timestamp" . :time-stamp-file)))
19679 o) 20089 o)
19680 (while (setq o (pop op)) 20090 (while (setq o (pop op))
19681 (if (string-match (concat (regexp-quote (car o)) 20091 (if (string-match (concat (regexp-quote (car o))
@@ -19727,11 +20137,16 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
19727\[v] limit export to visible part of outline tree 20137\[v] limit export to visible part of outline tree
19728 20138
19729\[a] export as ASCII 20139\[a] export as ASCII
20140
19730\[h] export as HTML 20141\[h] export as HTML
19731\[H] export as HTML to temporary buffer 20142\[H] export as HTML to temporary buffer
20143\[R] export region as HTML
19732\[b] export as HTML and browse immediately 20144\[b] export as HTML and browse immediately
19733\[x] export as XOXO 20145\[x] export as XOXO
19734 20146
20147\[l] export as LaTeX
20148\[L] export as LaTeX to temporary buffer
20149
19735\[i] export current file as iCalendar file 20150\[i] export current file as iCalendar file
19736\[I] export all agenda files as iCalendar files 20151\[I] export all agenda files as iCalendar files
19737\[c] export agenda files into combined iCalendar file 20152\[c] export agenda files into combined iCalendar file
@@ -19749,6 +20164,8 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
19749 (?H . org-export-as-html-to-buffer) 20164 (?H . org-export-as-html-to-buffer)
19750 (?R . org-export-region-as-html) 20165 (?R . org-export-region-as-html)
19751 (?x . org-export-as-xoxo) 20166 (?x . org-export-as-xoxo)
20167 (?l . org-export-as-latex)
20168 (?L . org-export-as-latex-to-buffer)
19752 (?i . org-export-icalendar-this-file) 20169 (?i . org-export-icalendar-this-file)
19753 (?I . org-export-icalendar-all-agenda-files) 20170 (?I . org-export-icalendar-all-agenda-files)
19754 (?c . org-export-icalendar-combine-agenda-files) 20171 (?c . org-export-icalendar-combine-agenda-files)
@@ -19993,6 +20410,7 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
19993 ("clubs") ("clubsuit"."&clubs;") 20410 ("clubs") ("clubsuit"."&clubs;")
19994 ("hearts") ("diamondsuit"."&hearts;") 20411 ("hearts") ("diamondsuit"."&hearts;")
19995 ("diams") ("diamondsuit"."&diams;") 20412 ("diams") ("diamondsuit"."&diams;")
20413 ("smile"."&#9786;") ("blacksmile"."&#9787;") ("sad"."&#9785;")
19996 ("quot") 20414 ("quot")
19997 ("amp") 20415 ("amp")
19998 ("lt") 20416 ("lt")
@@ -20070,7 +20488,7 @@ translations. There is currently no way for users to extend this.")
20070;;; General functions for all backends 20488;;; General functions for all backends
20071 20489
20072(defun org-cleaned-string-for-export (string &rest parameters) 20490(defun org-cleaned-string-for-export (string &rest parameters)
20073 "Cleanup a buffer substring so that links can be created safely." 20491 "Cleanup a buffer STRING so that links can be created safely."
20074 (interactive) 20492 (interactive)
20075 (let* ((re-radio (and org-target-link-regexp 20493 (let* ((re-radio (and org-target-link-regexp
20076 (concat "\\([^<]\\)\\(" org-target-link-regexp "\\)"))) 20494 (concat "\\([^<]\\)\\(" org-target-link-regexp "\\)")))
@@ -20078,13 +20496,16 @@ translations. There is currently no way for users to extend this.")
20078 (re-angle-link (concat "\\([^[]\\)" org-angle-link-re)) 20496 (re-angle-link (concat "\\([^[]\\)" org-angle-link-re))
20079 (re-archive (concat ":" org-archive-tag ":")) 20497 (re-archive (concat ":" org-archive-tag ":"))
20080 (re-quote (concat "^\\*+[ \t]+" org-quote-string "\\>")) 20498 (re-quote (concat "^\\*+[ \t]+" org-quote-string "\\>"))
20499 (re-commented (concat "^\\*+[ \t]+" org-comment-string "\\>"))
20081 (htmlp (plist-get parameters :for-html)) 20500 (htmlp (plist-get parameters :for-html))
20501 (asciip (plist-get parameters :for-ascii))
20502 (latexp (plist-get parameters :for-LaTeX))
20503 (commentsp (plist-get parameters :comments))
20082 (inhibit-read-only t) 20504 (inhibit-read-only t)
20083 (outline-regexp "\\*+ ") 20505 (outline-regexp "\\*+ ")
20084 a b 20506 a b xx
20085 rtn p) 20507 rtn p)
20086 (save-excursion 20508 (with-current-buffer (get-buffer-create " org-mode-tmp")
20087 (set-buffer (get-buffer-create " org-mode-tmp"))
20088 (erase-buffer) 20509 (erase-buffer)
20089 (insert string) 20510 (insert string)
20090 ;; Remove license-to-kill stuff 20511 ;; Remove license-to-kill stuff
@@ -20124,25 +20545,43 @@ translations. There is currently no way for users to extend this.")
20124 (while (re-search-forward "^[ \t]*:PROPERTIES:[ \t]*\n\\([^@]*?\n\\)?[ \t]*:END:[ \t]*\n" nil t) 20545 (while (re-search-forward "^[ \t]*:PROPERTIES:[ \t]*\n\\([^@]*?\n\\)?[ \t]*:END:[ \t]*\n" nil t)
20125 (replace-match ""))) 20546 (replace-match "")))
20126 20547
20127 ;; Protect stuff from HTML processing 20548 ;; Find targets in comments and move them out of comments,
20549 ;; but mark them as targets that should be invisible
20128 (goto-char (point-min)) 20550 (goto-char (point-min))
20129 (while (re-search-forward "^[ \t]*:.*\\(\n[ \t]*:.*\\)*" nil t) 20551 (while (re-search-forward "^#.*?\\(<<<?[^>\r\n]+>>>?\\).*" nil t)
20130 (add-text-properties (match-beginning 0) (match-end 0) 20552 (replace-match "\\1(INVISIBLE)"))
20131 '(org-protected t))) 20553
20132 (when htmlp 20554 ;; Protect backend specific stuff, throw away the others.
20133 (goto-char (point-min))
20134 (while (re-search-forward "^#\\+HTML:[ \t]*\\(.*\\)" nil t)
20135 (replace-match "\\1" t)
20136 (add-text-properties
20137 (point-at-bol) (min (1+ (point-at-eol)) (point-max))
20138 '(org-protected t))))
20139 (goto-char (point-min)) 20555 (goto-char (point-min))
20140 (while (re-search-forward 20556 (let ((formatters
20141 "^#\\+BEGIN_HTML\\>.*\\(\\(\n.*\\)*?\n\\)#\\+END_HTML\\>.*\n?" nil t) 20557 `((,htmlp "HTML" "BEGIN_HTML" "END_HTML")
20142 (if htmlp 20558 (,asciip "ASCII" "BEGIN_ASCII" "END_ASCII")
20143 (add-text-properties (match-beginning 1) (1+ (match-end 1)) 20559 (,latexp "LaTeX" "BEGIN_LaTeX" "END_LaTeX")))
20144 '(org-protected t)) 20560 fmt)
20145 (delete-region (match-beginning 0) (match-end 0)))) 20561 (while (re-search-forward "^[ \t]*:.*\\(\n[ \t]*:.*\\)*" nil t)
20562 (add-text-properties (match-beginning 0) (match-end 0)
20563 '(org-protected t)))
20564 (while formatters
20565 (setq fmt (pop formatters))
20566 (when (car fmt)
20567 (goto-char (point-min))
20568 (while (re-search-forward (concat "^#\\+" (cadr fmt)
20569 ":[ \t]*\\(.*\\)") nil t)
20570 (replace-match "\\1" t)
20571 (add-text-properties
20572 (point-at-bol) (min (1+ (point-at-eol)) (point-max))
20573 '(org-protected t))))
20574 (goto-char (point-min))
20575 (while (re-search-forward
20576 (concat "^#\\+"
20577 (caddr fmt) "\\>.*\\(\\(\n.*\\)*?\n\\)#\\+"
20578 (cadddr fmt) "\\>.*\n?") nil t)
20579 (if (car fmt)
20580 (add-text-properties (match-beginning 1) (1+ (match-end 1))
20581 '(org-protected t))
20582 (delete-region (match-beginning 0) (match-end 0))))))
20583
20584 ;; Protect quoted subtreedes
20146 (goto-char (point-min)) 20585 (goto-char (point-min))
20147 (while (re-search-forward re-quote nil t) 20586 (while (re-search-forward re-quote nil t)
20148 (goto-char (match-beginning 0)) 20587 (goto-char (match-beginning 0))
@@ -20150,16 +20589,39 @@ translations. There is currently no way for users to extend this.")
20150 (add-text-properties (point) (org-end-of-subtree t) 20589 (add-text-properties (point) (org-end-of-subtree t)
20151 '(org-protected t))) 20590 '(org-protected t)))
20152 20591
20153 ;; Find targets in comments and move them out of comments, 20592 ;; Remove subtrees that are commented
20154 ;; but mark them as targets that should be invisible
20155 (goto-char (point-min)) 20593 (goto-char (point-min))
20156 (while (re-search-forward "^#.*?\\(<<<?[^>\r\n]+>>>?\\).*" nil t) 20594 (while (re-search-forward re-commented nil t)
20157 (replace-match "\\1(INVISIBLE)")) 20595 (goto-char (match-beginning 0))
20596 (delete-region (point) (org-end-of-subtree t)))
20158 20597
20159 ;; Remove comments 20598 ;; Remove special table lines
20599 (when org-export-table-remove-special-lines
20600 (goto-char (point-min))
20601 (while (re-search-forward "^[ \t]*|" nil t)
20602 (beginning-of-line 1)
20603 (if (or (looking-at "[ \t]*| *[!_^] *|")
20604 (and (looking-at ".*?| *<[0-9]+> *|")
20605 (not (looking-at ".*?| *[^ <|]"))))
20606 (delete-region (max (point-min) (1- (point-at-bol)))
20607 (point-at-eol))
20608 (end-of-line 1))))
20609
20610 ;; Specific LaTeX cleaning
20611 (when latexp
20612 (require 'org-export-latex nil t)
20613 (org-export-latex-cleaned-string))
20614
20615 ;; Remove or replace comments
20616 ;; If :comments is set, use this char for commenting out comments and
20617 ;; protect them. otherwise delete them
20160 (goto-char (point-min)) 20618 (goto-char (point-min))
20161 (while (re-search-forward "^#.*\n?" nil t) 20619 (while (re-search-forward "^#\\(.*\n?\\)" nil t)
20162 (replace-match "")) 20620 (if commentsp
20621 (progn (add-text-properties
20622 (match-beginning 0) (match-end 0) '(org-protected t))
20623 (replace-match (format commentsp (match-string 1)) t t))
20624 (replace-match "")))
20163 20625
20164 ;; Find matches for radio targets and turn them into internal links 20626 ;; Find matches for radio targets and turn them into internal links
20165 (goto-char (point-min)) 20627 (goto-char (point-min))
@@ -20190,30 +20652,31 @@ translations. There is currently no way for users to extend this.")
20190 (while (re-search-forward re-plain-link nil t) 20652 (while (re-search-forward re-plain-link nil t)
20191 (goto-char (1- (match-end 0))) 20653 (goto-char (1- (match-end 0)))
20192 (org-if-unprotected 20654 (org-if-unprotected
20193 (replace-match 20655 (let* ((s (concat (match-string 1) "[[" (match-string 2)
20194 (concat 20656 ":" (match-string 3) "]]")))
20195 (match-string 1) "[[" (match-string 2) ":" (match-string 3) "]]") 20657 ;; added 'org-link face to links
20196 t t))) 20658 (put-text-property 0 (length s) 'face 'org-link s)
20659 (replace-match s t t))))
20197 (goto-char (point-min)) 20660 (goto-char (point-min))
20198 (while (re-search-forward re-angle-link nil t) 20661 (while (re-search-forward re-angle-link nil t)
20199 (goto-char (1- (match-end 0))) 20662 (goto-char (1- (match-end 0)))
20200 (org-if-unprotected 20663 (org-if-unprotected
20201 (replace-match 20664 (let* ((s (concat (match-string 1) "[[" (match-string 2)
20202 (concat 20665 ":" (match-string 3) "]]")))
20203 (match-string 1) "[[" (match-string 2) ":" (match-string 3) "]]") 20666 (put-text-property 0 (length s) 'face 'org-link s)
20204 t t))) 20667 (replace-match s t t))))
20205 (goto-char (point-min)) 20668 (goto-char (point-min))
20206 (while (re-search-forward org-bracket-link-regexp nil t) 20669 (while (re-search-forward org-bracket-link-regexp nil t)
20207 (org-if-unprotected 20670 (org-if-unprotected
20208 (replace-match 20671 (let* ((s (concat "[[" (setq xx (save-match-data
20209 (concat "[[" (save-match-data 20672 (org-link-expand-abbrev (match-string 1))))
20210 (org-link-expand-abbrev (match-string 1))) 20673 "]"
20211 "]" 20674 (if (match-end 3)
20212 (if (match-end 3) 20675 (match-string 2)
20213 (match-string 2) 20676 (concat "[" xx "]"))
20214 (concat "[" (match-string 1) "]")) 20677 "]")))
20215 "]") 20678 (put-text-property 0 (length s) 'face 'org-link s)
20216 t t))) 20679 (replace-match s t t))))
20217 20680
20218 ;; Find multiline emphasis and put them into single line 20681 ;; Find multiline emphasis and put them into single line
20219 (when (plist-get parameters :emph-multiline) 20682 (when (plist-get parameters :emph-multiline)
@@ -20233,7 +20696,7 @@ translations. There is currently no way for users to extend this.")
20233 20696
20234(defun org-export-grab-title-from-buffer () 20697(defun org-export-grab-title-from-buffer ()
20235 "Get a title for the current document, from looking at the buffer." 20698 "Get a title for the current document, from looking at the buffer."
20236 (let (buffer-read-only) 20699 (let ((inhibit-read-only t))
20237 (save-excursion 20700 (save-excursion
20238 (goto-char (point-min)) 20701 (goto-char (point-min))
20239 (let ((end (save-excursion (outline-next-heading) (point)))) 20702 (let ((end (save-excursion (outline-next-heading) (point))))
@@ -20327,6 +20790,10 @@ underlined headlines. The default is 3."
20327 (file-name-sans-extension 20790 (file-name-sans-extension
20328 (file-name-nondirectory buffer-file-name)) 20791 (file-name-nondirectory buffer-file-name))
20329 ".txt")) 20792 ".txt"))
20793 (filename (if (equal (file-truename filename)
20794 (file-truename buffer-file-name))
20795 (concat filename ".txt")
20796 filename))
20330 (buffer (find-file-noselect filename)) 20797 (buffer (find-file-noselect filename))
20331 (org-levels-open (make-vector org-level-max nil)) 20798 (org-levels-open (make-vector org-level-max nil))
20332 (odd org-odd-levels-only) 20799 (odd org-odd-levels-only)
@@ -20349,18 +20816,18 @@ underlined headlines. The default is 3."
20349 (buffer-substring 20816 (buffer-substring
20350 (if (org-region-active-p) (region-beginning) (point-min)) 20817 (if (org-region-active-p) (region-beginning) (point-min))
20351 (if (org-region-active-p) (region-end) (point-max)))) 20818 (if (org-region-active-p) (region-end) (point-max))))
20352 (lines (org-skip-comments 20819 (lines (org-split-string
20353 (org-split-string 20820 (org-cleaned-string-for-export
20354 (org-cleaned-string-for-export 20821 region
20355 region 20822 :for-ascii t
20356 :skip-before-1st-heading 20823 :skip-before-1st-heading
20357 (plist-get opt-plist :skip-before-1st-heading) 20824 (plist-get opt-plist :skip-before-1st-heading)
20358 :add-text (plist-get opt-plist :text)) 20825 :add-text (plist-get opt-plist :text))
20359 "[\r\n]"))) ;; FIXME: why \r here???/ 20826 "[\r\n]")) ;; FIXME: why \r here???/
20360 thetoc have-headings first-heading-pos 20827 thetoc have-headings first-heading-pos
20361 table-open table-buffer) 20828 table-open table-buffer)
20362 20829
20363 (let (buffer-read-only) 20830 (let ((inhibit-read-only t))
20364 (org-unmodified 20831 (org-unmodified
20365 (remove-text-properties (point-min) (point-max) 20832 (remove-text-properties (point-min) (point-max)
20366 '(:org-license-to-kill t)))) 20833 '(:org-license-to-kill t))))
@@ -20391,11 +20858,12 @@ underlined headlines. The default is 3."
20391 ;; File header 20858 ;; File header
20392 (if title (org-insert-centered title ?=)) 20859 (if title (org-insert-centered title ?=))
20393 (insert "\n") 20860 (insert "\n")
20394 (if (or author email) 20861 (if (and (or author email)
20862 org-export-author-info)
20395 (insert (concat (nth 1 lang-words) ": " (or author "") 20863 (insert (concat (nth 1 lang-words) ": " (or author "")
20396 (if email (concat " <" email ">") "") 20864 (if email (concat " <" email ">") "")
20397 "\n"))) 20865 "\n")))
20398 (if (and date time) 20866 (if (and date time org-export-time-stamp-file)
20399 (insert (concat (nth 2 lang-words) ": " date " " time "\n"))) 20867 (insert (concat (nth 2 lang-words) ": " date " " time "\n")))
20400 20868
20401 (insert "\n\n") 20869 (insert "\n\n")
@@ -20800,19 +21268,19 @@ itemized list in org-mode syntax in an HTML buffer and then use this
20800command to convert it." 21268command to convert it."
20801 (interactive "r") 21269 (interactive "r")
20802 (let (reg html buf) 21270 (let (reg html buf)
20803 (if (org-mode-p) 21271 (save-window-excursion
20804 (setq html (org-export-region-as-html 21272 (if (org-mode-p)
20805 beg end t 'string)) 21273 (setq html (org-export-region-as-html
20806 (setq reg (buffer-substring beg end) 21274 beg end t 'string))
20807 buf (get-buffer-create "*Org tmp*")) 21275 (setq reg (buffer-substring beg end)
20808 (save-excursion 21276 buf (get-buffer-create "*Org tmp*"))
20809 (set-buffer buf) 21277 (with-current-buffer buf
20810 (erase-buffer) 21278 (erase-buffer)
20811 (insert reg) 21279 (insert reg)
20812 (org-mode) 21280 (org-mode)
20813 (setq html (org-export-region-as-html 21281 (setq html (org-export-region-as-html
20814 (point-min) (point-max) t 'string))) 21282 (point-min) (point-max) t 'string)))
20815 (kill-buffer buf)) 21283 (kill-buffer buf)))
20816 (delete-region beg end) 21284 (delete-region beg end)
20817 (insert html))) 21285 (insert html)))
20818 21286
@@ -20832,7 +21300,7 @@ When called interactively, the output buffer is selected, and shown
20832in a window. A non-interactive call will only retunr the buffer." 21300in a window. A non-interactive call will only retunr the buffer."
20833 (interactive "r\nP") 21301 (interactive "r\nP")
20834 (when (interactive-p) 21302 (when (interactive-p)
20835 (setq buffer "*Org HTML EXPORT*")) 21303 (setq buffer "*Org HTML Export*"))
20836 (let ((transient-mark-mode t) (zmacs-regions t) 21304 (let ((transient-mark-mode t) (zmacs-regions t)
20837 rtn) 21305 rtn)
20838 (goto-char end) 21306 (goto-char end)
@@ -20905,7 +21373,7 @@ the body tags themselves."
20905 (buffer (if to-buffer 21373 (buffer (if to-buffer
20906 (cond 21374 (cond
20907 ((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*")) 21375 ((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*"))
20908 (t (get-buffer-create to-buffer))) 21376 (t (get-buffer-create to-buffer)))
20909 (find-file-noselect filename))) 21377 (find-file-noselect filename)))
20910 (org-levels-open (make-vector org-level-max nil)) 21378 (org-levels-open (make-vector org-level-max nil))
20911 (date (format-time-string "%Y/%m/%d" (current-time))) 21379 (date (format-time-string "%Y/%m/%d" (current-time)))
@@ -20948,25 +21416,25 @@ the body tags themselves."
20948 (if region-p (region-beginning) (point-min)) 21416 (if region-p (region-beginning) (point-min))
20949 (if region-p (region-end) (point-max)))) 21417 (if region-p (region-end) (point-max))))
20950 (lines 21418 (lines
20951 (org-skip-comments (org-split-string 21419 (org-split-string
20952 (org-cleaned-string-for-export 21420 (org-cleaned-string-for-export
20953 region 21421 region
20954 :emph-multiline t 21422 :emph-multiline t
20955 :for-html t 21423 :for-html t
20956 :skip-before-1st-heading 21424 :skip-before-1st-heading
20957 (plist-get opt-plist :skip-before-1st-heading) 21425 (plist-get opt-plist :skip-before-1st-heading)
20958 :add-text 21426 :add-text
20959 (plist-get opt-plist :text) 21427 (plist-get opt-plist :text)
20960 :LaTeX-fragments 21428 :LaTeX-fragments
20961 (plist-get opt-plist :LaTeX-fragments)) 21429 (plist-get opt-plist :LaTeX-fragments))
20962 "[\r\n]"))) 21430 "[\r\n]"))
20963 table-open type 21431 table-open type
20964 table-buffer table-orig-buffer 21432 table-buffer table-orig-buffer
20965 ind start-is-num starter didclose 21433 ind start-is-num starter didclose
20966 rpl path desc descp desc1 desc2 link 21434 rpl path desc descp desc1 desc2 link
20967 ) 21435 )
20968 21436
20969 (let (buffer-read-only) 21437 (let ((inhibit-read-only t))
20970 (org-unmodified 21438 (org-unmodified
20971 (remove-text-properties (point-min) (point-max) 21439 (remove-text-properties (point-min) (point-max)
20972 '(:org-license-to-kill t)))) 21440 '(:org-license-to-kill t))))
@@ -20984,6 +21452,10 @@ the body tags themselves."
20984 (set-buffer buffer) 21452 (set-buffer buffer)
20985 (erase-buffer) 21453 (erase-buffer)
20986 (fundamental-mode) 21454 (fundamental-mode)
21455
21456 (and (fboundp 'set-buffer-file-coding-system)
21457 (set-buffer-file-coding-system coding-system-for-write))
21458
20987 (let ((case-fold-search nil) 21459 (let ((case-fold-search nil)
20988 (org-odd-levels-only odd)) 21460 (org-odd-levels-only odd))
20989 ;; create local variables for all options, to make sure all called 21461 ;; create local variables for all options, to make sure all called
@@ -21422,14 +21894,14 @@ lang=\"%s\" xml:lang=\"%s\">
21422 21894
21423 (unless body-only 21895 (unless body-only
21424 (when (plist-get opt-plist :auto-postamble) 21896 (when (plist-get opt-plist :auto-postamble)
21425 (when author 21897 (when (and org-export-author-info author)
21426 (insert "<p class=\"author\"> " 21898 (insert "<p class=\"author\"> "
21427 (nth 1 lang-words) ": " author "\n") 21899 (nth 1 lang-words) ": " author "\n")
21428 (when email 21900 (when email
21429 (insert "<a href=\"mailto:" email "\">&lt;" 21901 (insert "<a href=\"mailto:" email "\">&lt;"
21430 email "&gt;</a>\n")) 21902 email "&gt;</a>\n"))
21431 (insert "</p>\n")) 21903 (insert "</p>\n"))
21432 (when (and date time) 21904 (when (and date time org-export-time-stamp-file)
21433 (insert "<p class=\"date\"> " 21905 (insert "<p class=\"date\"> "
21434 (nth 2 lang-words) ": " 21906 (nth 2 lang-words) ": "
21435 date " " time "</p>\n"))) 21907 date " " time "</p>\n")))
@@ -22177,7 +22649,11 @@ a time), or the day by one (if it does not contain a time)."
22177 (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2)) 22649 (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2))
22178 (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2))) 22650 (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2)))
22179 (when inc 22651 (when inc
22180 (if have-time (setq h (+ 2 h)) (setq d (1+ d)))) 22652 (if have-time
22653 (if org-agenda-default-appointment-duration
22654 (setq mi (+ org-agenda-default-appointment-duration mi))
22655 (setq h (+ 2 h)))
22656 (setq d (1+ d))))
22181 (setq time (encode-time s mi h d m y))) 22657 (setq time (encode-time s mi h d m y)))
22182 (setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d")) 22658 (setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d"))
22183 (concat keyword (format-time-string fmt time)))) 22659 (concat keyword (format-time-string fmt time))))
@@ -22936,7 +23412,7 @@ See the individual commands for more information."
22936 "--" 23412 "--"
22937 ["Jump" org-goto t] 23413 ["Jump" org-goto t]
22938 "--" 23414 "--"
22939 ["C-a/e find headline start/end" 23415 ["C-a/e find headline/item start/end"
22940 (setq org-special-ctrl-a/e (not org-special-ctrl-a/e)) 23416 (setq org-special-ctrl-a/e (not org-special-ctrl-a/e))
22941 :style toggle :selected org-special-ctrl-a/e]) 23417 :style toggle :selected org-special-ctrl-a/e])
22942 ("Edit Structure" 23418 ("Edit Structure"
@@ -23397,7 +23873,8 @@ not an indirect buffer"
23397 (setq column (current-column))) 23873 (setq column (current-column)))
23398 ((org-in-item-p) 23874 ((org-in-item-p)
23399 (org-beginning-of-item) 23875 (org-beginning-of-item)
23400 (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") 23876; (looking-at "[ \t]*\\(\\S-+\\)[ \t]*")
23877 (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\[[- X]\\][ \t]*\\)?")
23401 (setq bpos (match-beginning 1) tpos (match-end 0) 23878 (setq bpos (match-beginning 1) tpos (match-end 0)
23402 bcol (progn (goto-char bpos) (current-column)) 23879 bcol (progn (goto-char bpos) (current-column))
23403 tcol (progn (goto-char tpos) (current-column)) 23880 tcol (progn (goto-char tpos) (current-column))
@@ -23484,8 +23961,6 @@ work correctly."
23484 23961
23485;;;; Functions extending outline functionality 23962;;;; Functions extending outline functionality
23486 23963
23487;; C-a should go to the beginning of a *visible* line, also in the
23488;; new outline.el. I guess this should be patched into Emacs?
23489(defun org-beginning-of-line (&optional arg) 23964(defun org-beginning-of-line (&optional arg)
23490 "Go to the beginning of the current line. If that is invisible, continue 23965 "Go to the beginning of the current line. If that is invisible, continue
23491to a visible line beginning. This makes the function of C-a more intuitive. 23966to a visible line beginning. This makes the function of C-a more intuitive.
@@ -23503,12 +23978,19 @@ beyond the end of the headline."
23503 (backward-char 1) 23978 (backward-char 1)
23504 (beginning-of-line 1)) 23979 (beginning-of-line 1))
23505 (forward-char 1))) 23980 (forward-char 1)))
23506 (when (and org-special-ctrl-a/e (looking-at org-todo-line-regexp) 23981 (when org-special-ctrl-a/e
23507 (= (char-after (match-end 1)) ?\ )) 23982 (cond
23508 (goto-char 23983 ((and (looking-at org-todo-line-regexp)
23509 (cond ((> pos (match-beginning 3)) (match-beginning 3)) 23984 (= (char-after (match-end 1)) ?\ ))
23510 ((= pos (point)) (match-beginning 3)) 23985 (goto-char
23511 (t (point))))))) 23986 (cond ((> pos (match-beginning 3)) (match-beginning 3))
23987 ((= pos (point)) (match-beginning 3))
23988 (t (point)))))
23989 ((org-at-item-p)
23990 (goto-char
23991 (cond ((> pos (match-end 4)) (match-end 4))
23992 ((= pos (point)) (match-end 4))
23993 (t (point)))))))))
23512 23994
23513(defun org-end-of-line (&optional arg) 23995(defun org-end-of-line (&optional arg)
23514 "Go to the end of the line. 23996 "Go to the end of the line.
@@ -23610,7 +24092,7 @@ When ENTRY is non-nil, show the entire entry."
23610 (save-excursion 24092 (save-excursion
23611 (and (outline-next-heading) 24093 (and (outline-next-heading)
23612 (org-flag-heading nil)))) 24094 (org-flag-heading nil))))
23613 (outline-flag-region (max 1 (1- (point))) 24095 (outline-flag-region (max (point-min) (1- (point)))
23614 (save-excursion (outline-end-of-heading) (point)) 24096 (save-excursion (outline-end-of-heading) (point))
23615 flag)))) 24097 flag))))
23616 24098
@@ -23651,7 +24133,7 @@ Show the heading too, if it is currently invisible."
23651 (save-excursion 24133 (save-excursion
23652 (org-back-to-heading t) 24134 (org-back-to-heading t)
23653 (outline-flag-region 24135 (outline-flag-region
23654 (max 1 (1- (point))) 24136 (max (point-min) (1- (point)))
23655 (save-excursion 24137 (save-excursion
23656 (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) 24138 (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move)
23657 (or (match-beginning 1) (point-max))) 24139 (or (match-beginning 1) (point-max)))
@@ -23720,6 +24202,29 @@ Show the heading too, if it is currently invisible."
23720 24202
23721;;;; Experimental code 24203;;;; Experimental code
23722 24204
24205;; Make appt aware of appointments from the agenda
24206(defun org-agenda-to-appt ()
24207 "Activate appointments found in `org-agenda-files'."
24208 (interactive)
24209 (require 'org)
24210 (let* ((today (org-date-to-gregorian
24211 (time-to-days (current-time))))
24212 (files org-agenda-files) entries file)
24213 (while (setq file (pop files))
24214 (setq entries (append entries (org-agenda-get-day-entries
24215 file today :timestamp))))
24216 (setq entries (delq nil entries))
24217 (mapc (lambda(x)
24218 (let* ((event (org-trim (get-text-property 1 'txt x)))
24219 (time-of-day (get-text-property 1 'time-of-day x)) tod)
24220 (when time-of-day
24221 (setq tod (number-to-string time-of-day)
24222 tod (when (string-match
24223 "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)" tod)
24224 (concat (match-string 1 tod) ":"
24225 (match-string 2 tod))))
24226 (if tod (appt-add tod event))))) entries)))
24227
23723(defun org-closed-in-range () 24228(defun org-closed-in-range ()
23724 "Sparse tree of items closed in a certain time range. 24229 "Sparse tree of items closed in a certain time range.
23725Still experimental, may disappear in the furture." 24230Still experimental, may disappear in the furture."
@@ -23759,35 +24264,7 @@ Still experimental, may disappear in the furture."
23759 t))) 24264 t)))
23760 (t nil)))) ; call paragraph-fill 24265 (t nil)))) ; call paragraph-fill
23761 24266
23762(defun org-property-previous-allowed-value (&optional previous)
23763 "Switch to the next allowed value for this property."
23764 (interactive)
23765 (org-property-next-allowed-value t))
23766 24267
23767(defun org-property-next-allowed-value (&optional previous)
23768 "Switch to the next allowed value for this property."
23769 (interactive)
23770 (unless (org-at-property-p)
23771 (error "Not at a property"))
23772 (let* ((key (match-string 2))
23773 (value (match-string 3))
23774 (allowed (or (org-property-get-allowed-values (point) key)
23775 (and (member value '("[ ]" "[-]" "[X]"))
23776 '("[ ]" "[X]"))))
23777 nval)
23778 (unless allowed
23779 (error "Allowed values for this property have not been defined"))
23780 (if previous (setq allowed (reverse allowed)))
23781 (if (member value allowed)
23782 (setq nval (car (cdr (member value allowed)))))
23783 (setq nval (or nval (car allowed)))
23784 (if (equal nval value)
23785 (error "Only one allowed value for this property"))
23786 (org-at-property-p)
23787 (replace-match (concat " :" key ": " nval))
23788 (org-indent-line-function)
23789 (beginning-of-line 1)
23790 (skip-chars-forward " \t")))
23791 24268
23792;;;; Finish up 24269;;;; Finish up
23793 24270
generated by cgit v1.2.1 (git 2.18.0) at 2026-02-12 21:02:29 +0000