aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorCarsten Dominik2005-06-29 07:01:26 +0000
committerCarsten Dominik2005-06-29 07:01:26 +0000
commit9acdaa21d8dc445d399e97247f6fd70a8db3f649 (patch)
treef66f3ec42fbc95c3a6282e608d1132a04d008c59
parent533438b139c5de29067d47ba1d023e4c354d29c1 (diff)
downloademacs-9acdaa21d8dc445d399e97247f6fd70a8db3f649.tar.gz
emacs-9acdaa21d8dc445d399e97247f6fd70a8db3f649.zip
(orgtbl-setup): New function, for delayed
setup for the orgtbl commands. (org-calc-default-modes): New option. (orgtbl-make-binding): Use `defun' to get better help display. (org-diary): Call `org-compile-prefix-format'. (org-table-formula-substitute-names): New function. (org-agenda-day-view, org-agenda-week-view): New commands. (org-agenda-toggle-week-view): Command removed. (org-tbl-menu): Split off from org-org-menu. (org-mode): Moved removal of outline-mode menus to here. (org-table-formula-debug): New option. (org-table-insert-row): Keep first field if just "#" or "*". (org-mode): Paragraph regexps fixed. (org-table-recalculate-regexp): New constant. (org-table-justify-field-maybe): Avoid replace if not necessary. (org-copy-special, org-cut-special): Use `call-interactively'. (org-table-copy-region): Take region from `interactive' call. (org-trim): Return string even if no match. (org-formula): New face. (org-set-font-lock-defaults): No longer highlight "FIXME". But highlight formula-related fields in table. (org-table-p): Use regexp, not fontification. (org-table-align): Handle white space at end of line. (org-table-formula-evaluate-inline): New option. (org-mode): Auto-wrapping in comment lines turned off. (org-table-copy-down): Evaluate only in copied field, not in destination. (org-table-current-formula): Variable removed. (org-table-store-formulas, org-table-get-stored-formulas) (org-table-modify-formulas, org-table-replace-in-formulas) (org-table-maybe-eval-formula): New functions. (org-table-get-formula): Modified to use stored formulas. (org-table-insert-column, org-table-delete-column) (org-table-move-column): Call `org-table-modify-formulas'. (org-complete): Add completion for keyword formulas. (orgtbl-mode): Pull orgtbl-mode-map to start of minor-mode-map-alist.
-rw-r--r--lisp/textmodes/org.el1404
1 files changed, 1000 insertions, 404 deletions
diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el
index 635bb6b5a98..9db111ea7a9 100644
--- a/lisp/textmodes/org.el
+++ b/lisp/textmodes/org.el
@@ -1,11 +1,11 @@
1;;; org.el --- Outline-based notes management and organizer 1;; org.el --- Outline-based notes management and organizer
2;; Carstens outline-mode for keeping track of everything. 2;; Carstens outline-mode for keeping track of everything.
3;; Copyright (c) 2004, 2005 Free Software Foundation 3;; Copyright (c) 2004, 2005 Free Software Foundation
4;; 4;;
5;; Author: Carsten Dominik <dominik at science dot uva dot nl> 5;; Author: Carsten Dominik <dominik at science dot uva dot nl>
6;; Keywords: outlines, hypermedia, calendar 6;; Keywords: outlines, hypermedia, calendar
7;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ 7;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
8;; Version: 3.11 8;; Version: 3.12
9;; 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11;; 11;;
@@ -80,10 +80,20 @@
80;; 80;;
81;; Changes: 81;; Changes:
82;; ------- 82;; -------
83;; Version 3.12
84;; - Tables can store formulas (one per column) and compute fields.
85;; Not quite like a full spreadsheet, but very powerful.
86;; - table.el keybinding is now `C-c ~'.
87;; - Numeric argument to org-cycle does `show-subtree' above on level ARG.
88;; - Small changes to keys in agenda buffer. Affected keys:
89;; [w] weekly view; [d] daily view; [D] toggle diary inclusion.
90;; - Bug fixes.
91;;
83;; Version 3.11 92;; Version 3.11
84;; - Links inserted with C-c C-l are now by default enclosed in angle 93;; - Links inserted with C-c C-l are now by default enclosed in angle
85;; brackets. See the new variable `org-link-format'. 94;; brackets. See the new variable `org-link-format'.
86;; - ">" terminates a link, this is a way to have several links in a line. 95;; - ">" terminates a link, this is a way to have several links in a line.
96;; Both "<" and ">" are no longer allowed as characters in a link.
87;; - Archiving of finished tasks. 97;; - Archiving of finished tasks.
88;; - C-<up>/<down> bindings removed, to allow access to paragraph commands. 98;; - C-<up>/<down> bindings removed, to allow access to paragraph commands.
89;; - Compatibility with CUA-mode (see variable `org-CUA-compatible'). 99;; - Compatibility with CUA-mode (see variable `org-CUA-compatible').
@@ -168,7 +178,7 @@
168 178
169;;; Customization variables 179;;; Customization variables
170 180
171(defvar org-version "3.11" 181(defvar org-version "3.12"
172 "The version number of the file org.el.") 182 "The version number of the file org.el.")
173(defun org-version () 183(defun org-version ()
174 (interactive) 184 (interactive)
@@ -445,7 +455,7 @@ is used instead.")
445 (goto-char (point-min)) 455 (goto-char (point-min))
446 (while (re-search-forward re nil t) 456 (while (re-search-forward re nil t)
447 (setq key (match-string 1) value (match-string 2)) 457 (setq key (match-string 1) value (match-string 2))
448 (cond 458 (cond
449 ((equal key "CATEGORY") 459 ((equal key "CATEGORY")
450 (if (string-match "[ \t]+$" value) 460 (if (string-match "[ \t]+$" value)
451 (setq value (replace-match "" t t value))) 461 (setq value (replace-match "" t t value)))
@@ -485,7 +495,7 @@ is used instead.")
485 org-todo-kwd-max-priority (1- (length org-todo-keywords)) 495 org-todo-kwd-max-priority (1- (length org-todo-keywords))
486 org-ds-keyword-length (+ 2 (max (length org-deadline-string) 496 org-ds-keyword-length (+ 2 (max (length org-deadline-string)
487 (length org-scheduled-string))) 497 (length org-scheduled-string)))
488 org-done-string 498 org-done-string
489 (nth (1- (length org-todo-keywords)) org-todo-keywords) 499 (nth (1- (length org-todo-keywords)) org-todo-keywords)
490 org-todo-regexp 500 org-todo-regexp
491 (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords 501 (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords
@@ -565,7 +575,7 @@ When nil, cursor will remain in the current window."
565 575
566(defcustom org-select-agenda-window t 576(defcustom org-select-agenda-window t
567 "Non-nil means, after creating an agenda, move cursor into Agenda window. 577 "Non-nil means, after creating an agenda, move cursor into Agenda window.
568When nil, cursor will remain in the current window." 578When nil, cursor will remain in the current window."
569 :group 'org-agenda 579 :group 'org-agenda
570 :type 'boolean) 580 :type 'boolean)
571 581
@@ -601,7 +611,7 @@ When nil, always start on the current day."
601When nil, date-less entries will only be shown if `org-agenda' is called 611When nil, date-less entries will only be shown if `org-agenda' is called
602with a prefix argument. 612with a prefix argument.
603When non-nil, the TODO entries will be listed at the top of the agenda, before 613When non-nil, the TODO entries will be listed at the top of the agenda, before
604the entries for specific days." 614the entries for specific days."
605 :group 'org-agenda 615 :group 'org-agenda
606 :type 'boolean) 616 :type 'boolean)
607 617
@@ -646,7 +656,7 @@ priority.
646Leaving out `category-keep' would mean that items will be sorted across 656Leaving out `category-keep' would mean that items will be sorted across
647categories by priority." 657categories by priority."
648 :group 'org-agenda 658 :group 'org-agenda
649 :type '(repeat 659 :type '(repeat
650 (choice 660 (choice
651 (const time-up) 661 (const time-up)
652 (const time-down) 662 (const time-down)
@@ -722,7 +732,7 @@ the variable `org-agenda-time-grid'."
722 :group 'org-agenda 732 :group 'org-agenda
723 :type 'boolean) 733 :type 'boolean)
724 734
725(defcustom org-agenda-time-grid 735(defcustom org-agenda-time-grid
726 '((daily today require-timed) 736 '((daily today require-timed)
727 "----------------" 737 "----------------"
728 (800 1000 1200 1400 1600 1800 2000)) 738 (800 1000 1200 1400 1600 1800 2000))
@@ -741,7 +751,7 @@ The second item is a string which will be places behing the grid time.
741The third item is a list of integers, indicating the times that should have 751The third item is a list of integers, indicating the times that should have
742a grid line." 752a grid line."
743 :group 'org-agenda 753 :group 'org-agenda
744 :type 754 :type
745 '(list 755 '(list
746 (set :greedy t :tag "Grid Display Options" 756 (set :greedy t :tag "Grid Display Options"
747 (const :tag "Show grid in single day agenda display" daily) 757 (const :tag "Show grid in single day agenda display" daily)
@@ -835,7 +845,7 @@ unnecessary clutter."
835 845
836(defcustom org-archive-location "%s_archive::" 846(defcustom org-archive-location "%s_archive::"
837 "The location where subtrees should be archived. 847 "The location where subtrees should be archived.
838This string consists of two parts, separated by a double-colon. 848This string consists of two parts, separated by a double-colon.
839 849
840The first part is a file name - when omitted, archiving happens in the same 850The first part is a file name - when omitted, archiving happens in the same
841file. %s will be replaced by the current file name (without directory part). 851file. %s will be replaced by the current file name (without directory part).
@@ -864,7 +874,7 @@ Here are a few examples:
864 874
865You may set this option on a per-file basis by adding to the buffer a 875You may set this option on a per-file basis by adding to the buffer a
866line like 876line like
867 877
868#+ARCHIVE: basement::** Finished Tasks" 878#+ARCHIVE: basement::** Finished Tasks"
869 :group 'org-structure 879 :group 'org-structure
870 :type 'string) 880 :type 'string)
@@ -1201,9 +1211,70 @@ line will be formatted with <th> tags."
1201 :group 'org-table 1211 :group 'org-table
1202 :type 'boolean) 1212 :type 'boolean)
1203 1213
1214
1215(defgroup org-table-calculation nil
1216 "Options concerning tables in Org-mode."
1217 :tag "Org Table Calculation"
1218 :group 'org)
1219
1204(defcustom org-table-copy-increment t 1220(defcustom org-table-copy-increment t
1205 "Non-nil means, increment when copying current field with \\[org-table-copy-down]." 1221 "Non-nil means, increment when copying current field with \\[org-table-copy-down]."
1206 :group 'org-table 1222 :group 'org-table-calculation
1223 :type 'boolean)
1224
1225(defcustom org-calc-default-modes
1226 '(calc-internal-prec 12
1227 calc-float-format (float 5)
1228 calc-angle-mode deg
1229 calc-prefer-frac nil
1230 calc-symbolic-mode nil)
1231 "List with Calc mode settings for use in calc-eval for table formulas.
1232The list must contain alternating symbols (calc modes variables and values.
1233Don't remove any of the default settings, just change the values. Org-mode
1234relies on the variables to be present in the list."
1235 :group 'org-table-calculation
1236 :type 'plist)
1237
1238(defcustom org-table-formula-evaluate-inline t
1239 "Non-nil means, TAB and RET evaluate a formula in current table field.
1240If the current field starts with an equal sign, it is assumed to be a formula
1241which should be evaluated as described in the manual and in the documentation
1242string of the command `org-table-eval-formula'. This feature requires the
1243Emacs calc package.
1244When this variable is nil, formula calculation is only available through
1245the command \\[org-table-eval-formula]."
1246 :group 'org-table-calculation
1247 :type 'boolean)
1248
1249
1250(defcustom org-table-formula-use-constants t
1251 "Non-nil means, interpret constants in formulas in tables.
1252A constant looks like `$c' or `$Grav' and will be replaced before evaluation
1253by the value given in `org-table-formula-constants', or by a value obtained
1254from the `constants.el' package."
1255 :group 'org-table-calculation
1256 :type 'boolean)
1257
1258(defcustom org-table-formula-constants nil
1259 "Alist with constant names and values, for use in table formulas.
1260The car of each element is a name of a constant, without the `$' before it.
1261The cdr is the value as a string. For example, if you'd like to use the
1262speed of light in a formula, you would configure
1263
1264 (setq org-table-formula-constants '((\"c\" . \"299792458.\")))
1265
1266and then use it in an equation like `$1*$c'."
1267 :group 'org-table-calculation
1268 :type '(repeat
1269 (cons (string :tag "name")
1270 (string :tag "value"))))
1271
1272(defcustom org-table-formula-numbers-only nil
1273 "Non-nil means, calculate only with numbers in table formulas.
1274Then all input fields will be converted to a number, and the result
1275must also be a number. When nil, calc's full potential is available
1276in table calculations, including symbolics etc."
1277 :group 'org-table-calculation
1207 :type 'boolean) 1278 :type 'boolean)
1208 1279
1209(defcustom org-table-tab-recognizes-table.el t 1280(defcustom org-table-tab-recognizes-table.el t
@@ -1432,7 +1503,6 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1432 :group 'org-export 1503 :group 'org-export
1433 :type 'boolean) 1504 :type 'boolean)
1434 1505
1435
1436(defgroup org-faces nil 1506(defgroup org-faces nil
1437 "Faces for highlighting in Org-mode." 1507 "Faces for highlighting in Org-mode."
1438 :tag "Org Faces" 1508 :tag "Org Faces"
@@ -1556,7 +1626,16 @@ When this is non-nil, the headline after the keyword is set to the
1556 "Face for items scheduled previously, and not yet done." 1626 "Face for items scheduled previously, and not yet done."
1557 :group 'org-faces) 1627 :group 'org-faces)
1558 1628
1559(defface org-link 1629(defface org-formula
1630 '((((type tty pc) (class color) (background light)) (:foreground "red"))
1631 (((type tty pc) (class color) (background dark)) (:foreground "red1"))
1632 (((class color) (background light)) (:foreground "Firebrick"))
1633 (((class color) (background dark)) (:foreground "chocolate1"))
1634 (t (:bold t :italic t)))
1635 "Face for items scheduled previously, and not yet done."
1636 :group 'org-faces)
1637
1638(defface org-link
1560 '((((type tty) (class color)) (:foreground "cyan" :weight bold)) 1639 '((((type tty) (class color)) (:foreground "cyan" :weight bold))
1561 (((class color) (background light)) (:foreground "Purple")) 1640 (((class color) (background light)) (:foreground "Purple"))
1562 (((class color) (background dark)) (:foreground "Cyan")) 1641 (((class color) (background dark)) (:foreground "Cyan"))
@@ -1649,6 +1728,7 @@ When this is non-nil, the headline after the keyword is set to the
1649 1728
1650(defvar org-struct-menu) 1729(defvar org-struct-menu)
1651(defvar org-org-menu) 1730(defvar org-org-menu)
1731(defvar org-tbl-menu)
1652 1732
1653;; We use a before-change function to check if a table might need 1733;; We use a before-change function to check if a table might need
1654;; an update. 1734;; an update.
@@ -1656,14 +1736,13 @@ When this is non-nil, the headline after the keyword is set to the
1656 "Indicates of a table might need an update. 1736 "Indicates of a table might need an update.
1657This variable is set by `org-before-change-function'. `org-table-align' 1737This variable is set by `org-before-change-function'. `org-table-align'
1658sets it back to nil.") 1738sets it back to nil.")
1659
1660(defvar org-mode-hook nil) 1739(defvar org-mode-hook nil)
1661(defvar org-inhibit-startup nil) ; Dynamically-scoped param. 1740(defvar org-inhibit-startup nil) ; Dynamically-scoped param.
1662 1741
1663 1742
1664;;;###autoload 1743;;;###autoload
1665(define-derived-mode org-mode outline-mode "Org" 1744(define-derived-mode org-mode outline-mode "Org"
1666 "Outline-based notes management and organizer, alias 1745 "Outline-based notes management and organizer, alias
1667\"Carstens outline-mode for keeping track of everything.\" 1746\"Carstens outline-mode for keeping track of everything.\"
1668 1747
1669Org-mode develops organizational tasks around a NOTES file which 1748Org-mode develops organizational tasks around a NOTES file which
@@ -1681,6 +1760,7 @@ The following commands are available:
1681 1760
1682\\{org-mode-map}" 1761\\{org-mode-map}"
1683 (easy-menu-add org-org-menu) 1762 (easy-menu-add org-org-menu)
1763 (easy-menu-add org-tbl-menu)
1684 (org-install-agenda-files-menu) 1764 (org-install-agenda-files-menu)
1685 (setq outline-regexp "\\*+") 1765 (setq outline-regexp "\\*+")
1686 (if org-startup-truncated (setq truncate-lines t)) 1766 (if org-startup-truncated (setq truncate-lines t))
@@ -1693,11 +1773,11 @@ The following commands are available:
1693 (add-hook 'before-change-functions 'org-before-change-function nil 1773 (add-hook 'before-change-functions 'org-before-change-function nil
1694 'local) 1774 'local)
1695 ;; Paragraph regular expressions 1775 ;; Paragraph regular expressions
1696 (set (make-local-variable 'paragraph-separate) "\f\\|[ ]*$") 1776 (set (make-local-variable 'paragraph-separate) "\f\\|[ ]*$\\|\\([*\f]+\\)")
1697 (set (make-local-variable 'paragraph-start) "\f\\|[ ]*$\\|\\([*\f]+\\)") 1777 (set (make-local-variable 'paragraph-start) "\f\\|[ ]*$\\|\\([*\f]+\\)")
1698 ;; Inhibit auto-fill for headers, tables and fixed-width lines. 1778 ;; Inhibit auto-fill for headers, tables and fixed-width lines.
1699 (set (make-local-variable 'auto-fill-inhibit-regexp) 1779 (set (make-local-variable 'auto-fill-inhibit-regexp)
1700 (concat "\\*" 1780 (concat "\\*\\|#"
1701 (if (or org-enable-table-editor org-enable-fixed-width-editor) 1781 (if (or org-enable-table-editor org-enable-fixed-width-editor)
1702 (concat 1782 (concat
1703 "\\|[ \t]*[" 1783 "\\|[ \t]*["
@@ -1709,6 +1789,20 @@ The following commands are available:
1709 (interactive-p) 1789 (interactive-p)
1710 (= (point-min) (point-max))) 1790 (= (point-min) (point-max)))
1711 (insert " -*- mode: org -*-\n\n")) 1791 (insert " -*- mode: org -*-\n\n"))
1792
1793 ;; Get rid of Outline menus, they are not needed
1794 ;; Need to do this here because define-derived-mode sets up
1795 ;; the keymap so late.
1796 (if org-xemacs-p
1797 (progn
1798 (delete-menu-item '("Headings"))
1799 (delete-menu-item '("Show"))
1800 (delete-menu-item '("Hide"))
1801 (set-menubar-dirty-flag))
1802 (define-key org-mode-map [menu-bar headings] 'undefined)
1803 (define-key org-mode-map [menu-bar hide] 'undefined)
1804 (define-key org-mode-map [menu-bar show] 'undefined))
1805
1712 (unless org-inhibit-startup 1806 (unless org-inhibit-startup
1713 (if org-startup-with-deadline-check 1807 (if org-startup-with-deadline-check
1714 (call-interactively 'org-check-deadlines) 1808 (call-interactively 'org-check-deadlines)
@@ -1725,10 +1819,13 @@ The following commands are available:
1725 (beginning-of-line 1) 1819 (beginning-of-line 1)
1726 (looking-at "\\s-*\\(|\\|\\+-+\\)"))) 1820 (looking-at "\\s-*\\(|\\|\\+-+\\)")))
1727 1821
1822(defsubst org-current-line (&optional pos)
1823 (+ (if (bolp) 1 0) (count-lines (point-min) (or pos (point)))))
1824
1728;;; Font-Lock stuff 1825;;; Font-Lock stuff
1729 1826
1730(defvar org-mouse-map (make-sparse-keymap)) 1827(defvar org-mouse-map (make-sparse-keymap))
1731(define-key org-mouse-map 1828(define-key org-mouse-map
1732 (if org-xemacs-p [button2] [mouse-2]) 'org-open-at-mouse) 1829 (if org-xemacs-p [button2] [mouse-2]) 'org-open-at-mouse)
1733(define-key org-mouse-map 1830(define-key org-mouse-map
1734 (if org-xemacs-p [button3] [mouse-3]) 'org-find-file-at-mouse) 1831 (if org-xemacs-p [button3] [mouse-3]) 'org-find-file-at-mouse)
@@ -1804,11 +1901,10 @@ The following commands are available:
1804 (list (concat "\\<" org-scheduled-string) '(0 'org-warning t)) 1901 (list (concat "\\<" org-scheduled-string) '(0 'org-warning t))
1805 ;; '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)" 1902 ;; '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)"
1806 ;; (3 'bold)) 1903 ;; (3 'bold))
1807 ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)" 1904 ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)"
1808 ;; (3 'italic)) 1905 ;; (3 'italic))
1809 ;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)" 1906 ;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)"
1810 ;; (3 'underline)) 1907 ;; (3 'underline))
1811 '("\\<FIXME\\>" (0 'org-warning t))
1812 (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>") 1908 (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>")
1813 '(1 'org-warning t)) 1909 '(1 'org-warning t))
1814 '("^#.*" (0 'font-lock-comment-face t)) 1910 '("^#.*" (0 'font-lock-comment-face t))
@@ -1819,13 +1915,16 @@ The following commands are available:
1819 '(1 'org-done t))) 1915 '(1 'org-done t)))
1820 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" 1916 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
1821 (1 'org-table t)) 1917 (1 'org-table t))
1822 '("^[ \t]*\\(:.*\\)" (1 'org-table t))))) 1918 '("^[ \t]*\\(:.*\\)" (1 'org-table t))
1919 '("| *\\(=[^|\n]*\\)" (1 'org-formula t))
1920 '("^[ \t]*| *\\([#!$*]\\) *|" (1 'org-formula t))
1921 )))
1823 (set (make-local-variable 'org-font-lock-keywords) 1922 (set (make-local-variable 'org-font-lock-keywords)
1824 (append 1923 (append
1825 (if org-noutline-p ; FIXME: I am not sure if eval will work 1924 (if org-noutline-p ; FIXME: I am not sure if eval will work
1826 ; on XEmacs if noutline is ever ported 1925 ; on XEmacs if noutline is ever ported
1827 '((eval . (list "^\\(\\*+\\).*" 1926 '((eval . (list "^\\(\\*+\\).*"
1828 0 '(nth 1927 0 '(nth
1829 (% (- (match-end 1) (match-beginning 1) 1) 1928 (% (- (match-end 1) (match-beginning 1) 1)
1830 org-n-levels) 1929 org-n-levels)
1831 org-level-faces) 1930 org-level-faces)
@@ -1839,7 +1938,7 @@ The following commands are available:
1839 (set (make-local-variable 'font-lock-defaults) 1938 (set (make-local-variable 'font-lock-defaults)
1840 '(org-font-lock-keywords t nil nil backward-paragraph)) 1939 '(org-font-lock-keywords t nil nil backward-paragraph))
1841 (kill-local-variable 'font-lock-keywords) nil)) 1940 (kill-local-variable 'font-lock-keywords) nil))
1842 1941
1843(defun org-unfontify-region (beg end &optional maybe_loudly) 1942(defun org-unfontify-region (beg end &optional maybe_loudly)
1844 "Remove fontification and activation overlays from links." 1943 "Remove fontification and activation overlays from links."
1845 (font-lock-default-unfontify-region beg end) 1944 (font-lock-default-unfontify-region beg end)
@@ -1870,8 +1969,9 @@ The following commands are available:
1870 zoom in further. 1969 zoom in further.
1871 3. SUBTREE: Show the entire subtree, including body text. 1970 3. SUBTREE: Show the entire subtree, including body text.
1872 1971
1873- When there is a numeric prefix, go ARG levels up and do a `show-subtree', 1972- When there is a numeric prefix, go up to a heading with level ARG, do
1874 keeping cursor position. 1973 a `show-subtree' and return to the previous cursor position. If ARG
1974 is negative, go up that many levels.
1875 1975
1876- When point is not at the beginning of a headline, execute 1976- When point is not at the beginning of a headline, execute
1877 `indent-relative', like TAB normally does. See the option 1977 `indent-relative', like TAB normally does. See the option
@@ -1937,7 +2037,8 @@ The following commands are available:
1937 ;; Show-subtree, ARG levels up from here. 2037 ;; Show-subtree, ARG levels up from here.
1938 (save-excursion 2038 (save-excursion
1939 (org-back-to-heading) 2039 (org-back-to-heading)
1940 (outline-up-heading arg) 2040 (outline-up-heading (if (< arg 0) (- arg)
2041 (- (outline-level) arg)))
1941 (org-show-subtree))) 2042 (org-show-subtree)))
1942 2043
1943 ((save-excursion (beginning-of-line 1) (looking-at outline-regexp)) 2044 ((save-excursion (beginning-of-line 1) (looking-at outline-regexp))
@@ -2273,8 +2374,6 @@ in the region."
2273 (save-excursion 2374 (save-excursion
2274 (setq end (copy-marker end)) 2375 (setq end (copy-marker end))
2275 (goto-char beg) 2376 (goto-char beg)
2276 ;; (if (fboundp 'deactivate-mark) (deactivate-mark))
2277 ;; (if (fboundp 'zmacs-deactivate-region) (zmacs-deactivate-region))
2278 (if (and (re-search-forward (concat "^" outline-regexp) nil t) 2377 (if (and (re-search-forward (concat "^" outline-regexp) nil t)
2279 (< (point) end)) 2378 (< (point) end))
2280 (funcall fun)) 2379 (funcall fun))
@@ -2558,7 +2657,7 @@ heading be marked DONE, and the current time will be added."
2558 (end-of-line 0)) 2657 (end-of-line 0))
2559 ;; Make the heading visible, and the following as well 2658 ;; Make the heading visible, and the following as well
2560 (let ((org-show-following-heading t)) (org-show-hierarchy-above)) 2659 (let ((org-show-following-heading t)) (org-show-hierarchy-above))
2561 (if (re-search-forward 2660 (if (re-search-forward
2562 (concat "^" (regexp-quote (make-string level ?*)) "[ \t]") 2661 (concat "^" (regexp-quote (make-string level ?*)) "[ \t]")
2563 nil t) 2662 nil t)
2564 (progn (goto-char (match-beginning 0)) (insert "\n") 2663 (progn (goto-char (match-beginning 0)) (insert "\n")
@@ -2605,9 +2704,10 @@ At all other locations, this simply calls `ispell-complete-word'."
2605 (let* ((end (point)) 2704 (let* ((end (point))
2606 (beg (save-excursion 2705 (beg (save-excursion
2607 (if (equal (char-before (point)) ?\ ) (backward-char 1)) 2706 (if (equal (char-before (point)) ?\ ) (backward-char 1))
2608 (skip-chars-backward "a-zA-Z0-9_:") 2707 (skip-chars-backward "a-zA-Z0-9_:$")
2609 (point))) 2708 (point)))
2610 (texp (equal (char-before beg) ?\\)) 2709 (texp (equal (char-before beg) ?\\))
2710 (form (equal (char-before beg) ?=))
2611 (opt (equal (buffer-substring (max (point-at-bol) (- beg 2)) 2711 (opt (equal (buffer-substring (max (point-at-bol) (- beg 2))
2612 beg) 2712 beg)
2613 "#+")) 2713 "#+"))
@@ -2617,13 +2717,16 @@ At all other locations, this simply calls `ispell-complete-word'."
2617 (table (cond 2717 (table (cond
2618 (opt 2718 (opt
2619 (setq type :opt) 2719 (setq type :opt)
2620 (mapcar (lambda (x) 2720 (mapcar (lambda (x)
2621 (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x) 2721 (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x)
2622 (cons (match-string 2 x) (match-string 1 x))) 2722 (cons (match-string 2 x) (match-string 1 x)))
2623 (org-split-string (org-get-current-options) "\n"))) 2723 (org-split-string (org-get-current-options) "\n")))
2624 (texp 2724 (texp
2625 (setq type :tex) 2725 (setq type :tex)
2626 org-html-entities) 2726 org-html-entities)
2727 (form
2728 (setq type :form)
2729 '(("sum") ("sumv") ("sumh")))
2627 ((string-match "\\`\\*+[ \t]*\\'" 2730 ((string-match "\\`\\*+[ \t]*\\'"
2628 (buffer-substring (point-at-bol) beg)) 2731 (buffer-substring (point-at-bol) beg))
2629 (setq type :todo) 2732 (setq type :todo)
@@ -2631,7 +2734,7 @@ At all other locations, this simply calls `ispell-complete-word'."
2631 (t (progn (ispell-complete-word arg) (throw 'exit nil))))) 2734 (t (progn (ispell-complete-word arg) (throw 'exit nil)))))
2632 (completion (try-completion pattern table))) 2735 (completion (try-completion pattern table)))
2633 (cond ((eq completion t) 2736 (cond ((eq completion t)
2634 (if (equal type :opt) 2737 (if (equal type :opt)
2635 (insert (substring (cdr (assoc (upcase pattern) table)) 2738 (insert (substring (cdr (assoc (upcase pattern) table))
2636 (length pattern))))) 2739 (length pattern)))))
2637 ((null completion) 2740 ((null completion)
@@ -2639,7 +2742,7 @@ At all other locations, this simply calls `ispell-complete-word'."
2639 (ding)) 2742 (ding))
2640 ((not (string= pattern completion)) 2743 ((not (string= pattern completion))
2641 (delete-region beg end) 2744 (delete-region beg end)
2642 (if (string-match " +$" completion) 2745 (if (string-match " +$" completion)
2643 (setq completion (replace-match "" t t completion))) 2746 (setq completion (replace-match "" t t completion)))
2644 (insert completion) 2747 (insert completion)
2645 (if (get-buffer-window "*Completions*") 2748 (if (get-buffer-window "*Completions*")
@@ -2876,9 +2979,9 @@ ACTION can be set, up, or down."
2876 (save-match-data 2979 (save-match-data
2877 (if (not (string-match org-priority-regexp s)) 2980 (if (not (string-match org-priority-regexp s))
2878 (* 1000 (- org-lowest-priority org-default-priority)) 2981 (* 1000 (- org-lowest-priority org-default-priority))
2879 (* 1000 (- org-lowest-priority 2982 (* 1000 (- org-lowest-priority
2880 (string-to-char (match-string 2 s))))))) 2983 (string-to-char (match-string 2 s)))))))
2881 2984
2882;;; Timestamps 2985;;; Timestamps
2883 2986
2884(defvar org-last-changed-timestamp nil) 2987(defvar org-last-changed-timestamp nil)
@@ -2910,7 +3013,7 @@ at the cursor, it will be modified."
2910 (setq time (let ((this-command this-command)) 3013 (setq time (let ((this-command this-command))
2911 (org-read-date arg 'totime))) 3014 (org-read-date arg 'totime)))
2912 (and (org-at-timestamp-p) (replace-match 3015 (and (org-at-timestamp-p) (replace-match
2913 (setq org-last-changed-timestamp 3016 (setq org-last-changed-timestamp
2914 (format-time-string fmt time)) 3017 (format-time-string fmt time))
2915 t t)) 3018 t t))
2916 (message "Timestamp updated")) 3019 (message "Timestamp updated"))
@@ -2940,8 +3043,8 @@ but this can be configured with the variables `parse-time-months' and
2940 3043
2941While prompting, a calendar is popped up - you can also select the 3044While prompting, a calendar is popped up - you can also select the
2942date with the mouse (button 1). The calendar shows a period of three 3045date with the mouse (button 1). The calendar shows a period of three
2943month. To scroll it to other months, use the keys `>' and `<'. 3046month. To scroll it to other months, use the keys `>' and `<'.
2944If you don't like the calendar, turn it off with 3047If you don't like the calendar, turn it off with
2945 \(setq org-popup-calendar-for-date-prompt nil). 3048 \(setq org-popup-calendar-for-date-prompt nil).
2946 3049
2947With optional argument TO-TIME, the date will immediately be converted 3050With optional argument TO-TIME, the date will immediately be converted
@@ -2955,7 +3058,7 @@ used to insert the time stamp into the buffer to include the time."
2955 ;; Default time is either today, or, when entering a range, 3058 ;; Default time is either today, or, when entering a range,
2956 ;; the range start. 3059 ;; the range start.
2957 (if (save-excursion 3060 (if (save-excursion
2958 (re-search-backward 3061 (re-search-backward
2959 (concat org-ts-regexp "--\\=") 3062 (concat org-ts-regexp "--\\=")
2960 (- (point) 20) t)) 3063 (- (point) 20) t))
2961 (apply 3064 (apply
@@ -3066,7 +3169,7 @@ This is used by `org-read-date' in a temporary keymap for the calendar buffer."
3066 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) 3169 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
3067 (setq ans1 (format-time-string "%Y-%m-%d" time))) 3170 (setq ans1 (format-time-string "%Y-%m-%d" time)))
3068 (if (active-minibuffer-window) (exit-minibuffer)))) 3171 (if (active-minibuffer-window) (exit-minibuffer))))
3069 3172
3070(defun org-check-deadlines (ndays) 3173(defun org-check-deadlines (ndays)
3071 "Check if there are any deadlines due or past due. 3174 "Check if there are any deadlines due or past due.
3072A deadline is considered due if it happens within `org-deadline-warning-days' 3175A deadline is considered due if it happens within `org-deadline-warning-days'
@@ -3358,10 +3461,10 @@ The following commands are available:
3358 (add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local) 3461 (add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local)
3359 (add-hook 'pre-command-hook 'org-unhighlight nil 'local) 3462 (add-hook 'pre-command-hook 'org-unhighlight nil 'local)
3360 (setq org-agenda-follow-mode nil) 3463 (setq org-agenda-follow-mode nil)
3361 (easy-menu-change 3464 (easy-menu-change
3362 '("Agenda") "Agenda Files" 3465 '("Agenda") "Agenda Files"
3363 (append 3466 (append
3364 (list 3467 (list
3365 ["Edit File List" (customize-variable 'org-agenda-files) t] 3468 ["Edit File List" (customize-variable 'org-agenda-files) t]
3366 "--") 3469 "--")
3367 (mapcar 'org-file-menu-entry org-agenda-files))) 3470 (mapcar 'org-file-menu-entry org-agenda-files)))
@@ -3378,7 +3481,8 @@ The following commands are available:
3378(define-key org-agenda-mode-map "l" 'org-agenda-recenter) 3481(define-key org-agenda-mode-map "l" 'org-agenda-recenter)
3379(define-key org-agenda-mode-map "t" 'org-agenda-todo) 3482(define-key org-agenda-mode-map "t" 'org-agenda-todo)
3380(define-key org-agenda-mode-map "." 'org-agenda-goto-today) 3483(define-key org-agenda-mode-map "." 'org-agenda-goto-today)
3381(define-key org-agenda-mode-map "w" 'org-agenda-toggle-week-view) 3484(define-key org-agenda-mode-map "d" 'org-agenda-day-view)
3485(define-key org-agenda-mode-map "w" 'org-agenda-week-view)
3382(define-key org-agenda-mode-map (org-key 'S-right) 'org-agenda-date-later) 3486(define-key org-agenda-mode-map (org-key 'S-right) 'org-agenda-date-later)
3383(define-key org-agenda-mode-map (org-key 'S-left) 'org-agenda-date-earlier) 3487(define-key org-agenda-mode-map (org-key 'S-left) 'org-agenda-date-earlier)
3384 3488
@@ -3388,7 +3492,7 @@ The following commands are available:
3388 (int-to-string (pop l)) 'digit-argument))) 3492 (int-to-string (pop l)) 'digit-argument)))
3389 3493
3390(define-key org-agenda-mode-map "f" 'org-agenda-follow-mode) 3494(define-key org-agenda-mode-map "f" 'org-agenda-follow-mode)
3391(define-key org-agenda-mode-map "d" 'org-agenda-toggle-diary) 3495(define-key org-agenda-mode-map "D" 'org-agenda-toggle-diary)
3392(define-key org-agenda-mode-map "g" 'org-agenda-toggle-time-grid) 3496(define-key org-agenda-mode-map "g" 'org-agenda-toggle-time-grid)
3393(define-key org-agenda-mode-map "r" 'org-agenda-redo) 3497(define-key org-agenda-mode-map "r" 'org-agenda-redo)
3394(define-key org-agenda-mode-map "q" 'org-agenda-quit) 3498(define-key org-agenda-mode-map "q" 'org-agenda-quit)
@@ -3422,7 +3526,7 @@ The following commands are available:
3422(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) 3526(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map)
3423 "Local keymap for agenda entries from Org-mode.") 3527 "Local keymap for agenda entries from Org-mode.")
3424 3528
3425(define-key org-agenda-keymap 3529(define-key org-agenda-keymap
3426 (if org-xemacs-p [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse) 3530 (if org-xemacs-p [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse)
3427(define-key org-agenda-keymap 3531(define-key org-agenda-keymap
3428 (if org-xemacs-p [(button3)] [(mouse-3)]) 'org-agenda-show-mouse) 3532 (if org-xemacs-p [(button3)] [(mouse-3)]) 'org-agenda-show-mouse)
@@ -3434,7 +3538,7 @@ The following commands are available:
3434 ["Show" org-agenda-show t] 3538 ["Show" org-agenda-show t]
3435 ["Go To (other window)" org-agenda-goto t] 3539 ["Go To (other window)" org-agenda-goto t]
3436 ["Go To (one window)" org-agenda-switch-to t] 3540 ["Go To (one window)" org-agenda-switch-to t]
3437 ["Follow Mode" org-agenda-follow-mode 3541 ["Follow Mode" org-agenda-follow-mode
3438 :style toggle :selected org-agenda-follow-mode :active t] 3542 :style toggle :selected org-agenda-follow-mode :active t]
3439 "--" 3543 "--"
3440 ["Cycle TODO" org-agenda-todo t] 3544 ["Cycle TODO" org-agenda-todo t]
@@ -3454,8 +3558,11 @@ The following commands are available:
3454 ["Next Dates" org-agenda-later (local-variable-p 'starting-day)] 3558 ["Next Dates" org-agenda-later (local-variable-p 'starting-day)]
3455 ["Previous Dates" org-agenda-earlier (local-variable-p 'starting-day)] 3559 ["Previous Dates" org-agenda-earlier (local-variable-p 'starting-day)]
3456 "--" 3560 "--"
3457 ["Week/Day View" org-agenda-toggle-week-view 3561 ["Day View" org-agenda-day-view :active (local-variable-p 'starting-day)
3458 (local-variable-p 'starting-day)] 3562 :style radio :selected (equal org-agenda-ndays 1)]
3563 ["Week View" org-agenda-week-view :active (local-variable-p 'starting-day)
3564 :style radio :selected (equal org-agenda-ndays 7)]
3565 "--"
3459 ["Include Diary" org-agenda-toggle-diary 3566 ["Include Diary" org-agenda-toggle-diary
3460 :style toggle :selected org-agenda-include-diary :active t] 3567 :style toggle :selected org-agenda-include-diary :active t]
3461 ["Use Time Grid" org-agenda-toggle-time-grid 3568 ["Use Time Grid" org-agenda-toggle-time-grid
@@ -3552,7 +3659,7 @@ dates."
3552 (org-respect-restriction t) 3659 (org-respect-restriction t)
3553 (past t) 3660 (past t)
3554 s e rtn d) 3661 s e rtn d)
3555 (setq org-agenda-redo-command 3662 (setq org-agenda-redo-command
3556 (list 'progn 3663 (list 'progn
3557 (list 'switch-to-buffer-other-window (current-buffer)) 3664 (list 'switch-to-buffer-other-window (current-buffer))
3558 (list 'org-timeline include-all))) 3665 (list 'org-timeline include-all)))
@@ -3561,7 +3668,7 @@ dates."
3561 (setq day-numbers (delq nil (mapcar (lambda(x) 3668 (setq day-numbers (delq nil (mapcar (lambda(x)
3562 (if (>= x today) x nil)) 3669 (if (>= x today) x nil))
3563 day-numbers)))) 3670 day-numbers))))
3564 (switch-to-buffer-other-window 3671 (switch-to-buffer-other-window
3565 (get-buffer-create org-agenda-buffer-name)) 3672 (get-buffer-create org-agenda-buffer-name))
3566 (setq buffer-read-only nil) 3673 (setq buffer-read-only nil)
3567 (erase-buffer) 3674 (erase-buffer)
@@ -3576,7 +3683,7 @@ dates."
3576 (setq date (calendar-gregorian-from-absolute d)) 3683 (setq date (calendar-gregorian-from-absolute d))
3577 (setq s (point)) 3684 (setq s (point))
3578 (if dotodo 3685 (if dotodo
3579 (setq rtn (org-agenda-get-day-entries 3686 (setq rtn (org-agenda-get-day-entries
3580 entry date :todo :timestamp)) 3687 entry date :todo :timestamp))
3581 (setq rtn (org-agenda-get-day-entries entry date :timestamp))) 3688 (setq rtn (org-agenda-get-day-entries entry date :timestamp)))
3582 (if (or rtn (equal d today)) 3689 (if (or rtn (equal d today))
@@ -3632,7 +3739,7 @@ NDAYS defaults to `org-agenda-ndays'."
3632 (day-numbers (list start)) 3739 (day-numbers (list start))
3633 (inhibit-redisplay t) 3740 (inhibit-redisplay t)
3634 s e rtn rtnall file date d start-pos end-pos todayp nd) 3741 s e rtn rtnall file date d start-pos end-pos todayp nd)
3635 (setq org-agenda-redo-command 3742 (setq org-agenda-redo-command
3636 (list 'org-agenda include-all start-day ndays)) 3743 (list 'org-agenda include-all start-day ndays))
3637 ;; Make the list of days 3744 ;; Make the list of days
3638 (setq ndays (or ndays org-agenda-ndays) 3745 (setq ndays (or ndays org-agenda-ndays)
@@ -3644,7 +3751,7 @@ NDAYS defaults to `org-agenda-ndays'."
3644 (if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name))) 3751 (if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name)))
3645 (progn 3752 (progn
3646 (delete-other-windows) 3753 (delete-other-windows)
3647 (switch-to-buffer-other-window 3754 (switch-to-buffer-other-window
3648 (get-buffer-create org-agenda-buffer-name)))) 3755 (get-buffer-create org-agenda-buffer-name))))
3649 (setq buffer-read-only nil) 3756 (setq buffer-read-only nil)
3650 (erase-buffer) 3757 (erase-buffer)
@@ -3662,7 +3769,7 @@ NDAYS defaults to `org-agenda-ndays'."
3662 rtn (org-agenda-get-day-entries 3769 rtn (org-agenda-get-day-entries
3663 file date :todo)) 3770 file date :todo))
3664 (setq rtnall (append rtnall rtn)))) 3771 (setq rtnall (append rtnall rtn))))
3665 (when rtnall 3772 (when rtnall
3666 (insert "ALL CURRENTLY OPEN TODO ITEMS:\n") 3773 (insert "ALL CURRENTLY OPEN TODO ITEMS:\n")
3667 (add-text-properties (point-min) (1- (point)) 3774 (add-text-properties (point-min) (1- (point))
3668 (list 'face 'org-link)) 3775 (list 'face 'org-link))
@@ -3696,12 +3803,12 @@ NDAYS defaults to `org-agenda-ndays'."
3696 (extract-calendar-year date))) 3803 (extract-calendar-year date)))
3697 (put-text-property s (1- (point)) 'face 3804 (put-text-property s (1- (point)) 'face
3698 'org-link) 3805 'org-link)
3699 (if rtnall (insert 3806 (if rtnall (insert
3700 (org-finalize-agenda-entries ;; FIXME: condition needed 3807 (org-finalize-agenda-entries ;; FIXME: condition needed
3701 (org-agenda-add-time-grid-maybe 3808 (org-agenda-add-time-grid-maybe
3702 rtnall nd todayp)) 3809 rtnall nd todayp))
3703 "\n")) 3810 "\n"))
3704 (put-text-property s (1- (point)) 'day d)))) 3811 (put-text-property s (1- (point)) 'day d))))
3705 (goto-char (point-min)) 3812 (goto-char (point-min))
3706 (setq buffer-read-only t) 3813 (setq buffer-read-only t)
3707 (if org-fit-agenda-window 3814 (if org-fit-agenda-window
@@ -3784,19 +3891,29 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3784 (org-agenda (if (boundp 'include-all-loc) include-all-loc nil) 3891 (org-agenda (if (boundp 'include-all-loc) include-all-loc nil)
3785 (- starting-day (* arg org-agenda-ndays)))) 3892 (- starting-day (* arg org-agenda-ndays))))
3786 3893
3787(defun org-agenda-toggle-week-view () 3894(defun org-agenda-week-view ()
3788 "Toggle weekly/daily view for aagenda." 3895 "Switch to weekly view for agenda."
3896 (interactive)
3897 (unless (boundp 'starting-day)
3898 (error "Not allowed"))
3899 (setq org-agenda-ndays 7)
3900 (org-agenda include-all-loc
3901 (or (get-text-property (point) 'day)
3902 starting-day))
3903 (org-agenda-set-mode-name)
3904 (message "Switched to week view"))
3905
3906(defun org-agenda-day-view ()
3907 "Switch to weekly view for agenda."
3789 (interactive) 3908 (interactive)
3790 (unless (boundp 'starting-day) 3909 (unless (boundp 'starting-day)
3791 (error "Not allowed")) 3910 (error "Not allowed"))
3792 (setq org-agenda-ndays 3911 (setq org-agenda-ndays 1)
3793 (if (equal org-agenda-ndays 1) 7 1)) 3912 (org-agenda include-all-loc
3794 (org-agenda include-all-loc
3795 (or (get-text-property (point) 'day) 3913 (or (get-text-property (point) 'day)
3796 starting-day)) 3914 starting-day))
3797 (org-agenda-set-mode-name) 3915 (org-agenda-set-mode-name)
3798 (message "Switched to %s view" 3916 (message "Switched to day view"))
3799 (if (equal org-agenda-ndays 1) "day" "week")))
3800 3917
3801(defun org-agenda-next-date-line (&optional arg) 3918(defun org-agenda-next-date-line (&optional arg)
3802 "Jump to the next line indicating a date in agenda buffer." 3919 "Jump to the next line indicating a date in agenda buffer."
@@ -3880,7 +3997,7 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3880 "Get the (Emacs Calendar) diary entries for DATE." 3997 "Get the (Emacs Calendar) diary entries for DATE."
3881 (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*") 3998 (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*")
3882 (diary-display-hook '(fancy-diary-display)) 3999 (diary-display-hook '(fancy-diary-display))
3883 (list-diary-entries-hook 4000 (list-diary-entries-hook
3884 (cons 'org-diary-default-entry list-diary-entries-hook)) 4001 (cons 'org-diary-default-entry list-diary-entries-hook))
3885 entries 4002 entries
3886 (org-disable-diary t)) 4003 (org-disable-diary t))
@@ -3904,12 +4021,12 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3904 (kill-buffer fancy-diary-buffer))) 4021 (kill-buffer fancy-diary-buffer)))
3905 (when entries 4022 (when entries
3906 (setq entries (org-split-string entries "\n")) 4023 (setq entries (org-split-string entries "\n"))
3907 (setq entries 4024 (setq entries
3908 (mapcar 4025 (mapcar
3909 (lambda (x) 4026 (lambda (x)
3910 (setq x (org-format-agenda-item "" x "Diary" 'time)) 4027 (setq x (org-format-agenda-item "" x "Diary" 'time))
3911 ;; Extend the text properties to the beginning of the line 4028 ;; Extend the text properties to the beginning of the line
3912 (add-text-properties 4029 (add-text-properties
3913 0 (length x) 4030 0 (length x)
3914 (text-properties-at (1- (length x)) x) 4031 (text-properties-at (1- (length x)) x)
3915 x) 4032 x)
@@ -3950,7 +4067,7 @@ date. Itt also removes lines that contain only whitespace."
3950 0 (length string) 4067 0 (length string)
3951 (list 'mouse-face 'highlight 4068 (list 'mouse-face 'highlight
3952 'keymap org-agenda-keymap 4069 'keymap org-agenda-keymap
3953 'help-echo 4070 'help-echo
3954 (format 4071 (format
3955 "mouse-2 or RET jump to diary file %s" 4072 "mouse-2 or RET jump to diary file %s"
3956 (abbreviate-file-name (buffer-file-name))) 4073 (abbreviate-file-name (buffer-file-name)))
@@ -3972,7 +4089,7 @@ Needed to avoid empty dates which mess up holiday display."
3972These are the files which are being checked for agenda entries. 4089These are the files which are being checked for agenda entries.
3973Optional argument FILE means, use this file instead of the current. 4090Optional argument FILE means, use this file instead of the current.
3974It is possible (but not recommended) to add this function to the 4091It is possible (but not recommended) to add this function to the
3975`org-mode-hook'." 4092`org-mode-hook'."
3976 (interactive) 4093 (interactive)
3977 (catch 'exit 4094 (catch 'exit
3978 (let* ((file (or file (buffer-file-name) 4095 (let* ((file (or file (buffer-file-name)
@@ -3987,7 +4104,7 @@ It is possible (but not recommended) to add this function to the
3987 org-agenda-files)))) 4104 org-agenda-files))))
3988 (if (not present) 4105 (if (not present)
3989 (progn 4106 (progn
3990 (setq org-agenda-files 4107 (setq org-agenda-files
3991 (cons afile org-agenda-files)) 4108 (cons afile org-agenda-files))
3992 ;; Make sure custom.el does not end up with Org-mode 4109 ;; Make sure custom.el does not end up with Org-mode
3993 (let ((org-mode-hook nil) (default-major-mode 'fundamental-mode)) 4110 (let ((org-mode-hook nil) (default-major-mode 'fundamental-mode))
@@ -4004,7 +4121,7 @@ Optional argument FILE means, use this file instead of the current."
4004 (let* ((file (or file (buffer-file-name))) 4121 (let* ((file (or file (buffer-file-name)))
4005 (true-file (file-truename file)) 4122 (true-file (file-truename file))
4006 (afile (abbreviate-file-name file)) 4123 (afile (abbreviate-file-name file))
4007 (files (delq nil (mapcar 4124 (files (delq nil (mapcar
4008 (lambda (x) 4125 (lambda (x)
4009 (if (equal true-file 4126 (if (equal true-file
4010 (file-truename x)) 4127 (file-truename x))
@@ -4051,6 +4168,7 @@ sure that TODAY is included in the list."
4051 "Return diary information from org-files. 4168 "Return diary information from org-files.
4052This function can be used in a \"sexp\" diary entry in the Emacs calendar. 4169This function can be used in a \"sexp\" diary entry in the Emacs calendar.
4053It accesses org files and extracts information from those files to be 4170It accesses org files and extracts information from those files to be
4171
4054listed in the diary. The function accepts arguments specifying what 4172listed in the diary. The function accepts arguments specifying what
4055items should be listed. The following arguments are allowed: 4173items should be listed. The following arguments are allowed:
4056 4174
@@ -4089,9 +4207,9 @@ also be written as
4089 4207
4090The function expects the lisp variables `entry' and `date' to be provided 4208The function expects the lisp variables `entry' and `date' to be provided
4091by the caller, because this is how the calendar works. Don't use this 4209by the caller, because this is how the calendar works. Don't use this
4092function from a program - use `org-agenda-get-day-entries' instead." 4210function from a program - use `org-agenda-get-day-entries' instead."
4093 (org-agenda-maybe-reset-markers) 4211 (org-agenda-maybe-reset-markers)
4094 (org-compile-agenda-prefix-format org-agenda-prefix-format) 4212 (org-compile-prefix-format org-agenda-prefix-format)
4095 (setq args (or args '(:deadline :scheduled :timestamp))) 4213 (setq args (or args '(:deadline :scheduled :timestamp)))
4096 (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) 4214 (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry))
4097 (list entry) 4215 (list entry)
@@ -4131,7 +4249,7 @@ the documentation of `org-diary'."
4131 (if (org-region-active-p) 4249 (if (org-region-active-p)
4132 ;; Respect a region to restrict search 4250 ;; Respect a region to restrict search
4133 (narrow-to-region (region-beginning) (region-end))) 4251 (narrow-to-region (region-beginning) (region-end)))
4134 ;; If we work for the calendar or many files, 4252 ;; If we work for the calendar or many files,
4135 ;; get rid of any restriction 4253 ;; get rid of any restriction
4136 (widen)) 4254 (widen))
4137 ;; The way we repeatedly append to `results' makes it O(n^2) :-( 4255 ;; The way we repeatedly append to `results' makes it O(n^2) :-(
@@ -4197,7 +4315,7 @@ the documentation of `org-diary'."
4197 (goto-char (match-beginning 1)) 4315 (goto-char (match-beginning 1))
4198 (setq marker (org-agenda-new-marker (point-at-bol)) 4316 (setq marker (org-agenda-new-marker (point-at-bol))
4199 txt (org-format-agenda-item "" (match-string 1)) 4317 txt (org-format-agenda-item "" (match-string 1))
4200 priority 4318 priority
4201 (+ (org-get-priority txt) 4319 (+ (org-get-priority txt)
4202 (if org-todo-kwd-priority-p 4320 (if org-todo-kwd-priority-p
4203 (- org-todo-kwd-max-priority -2 4321 (- org-todo-kwd-max-priority -2
@@ -4269,7 +4387,7 @@ the documentation of `org-diary'."
4269 (if deadlinep 4387 (if deadlinep
4270 (add-text-properties 4388 (add-text-properties
4271 0 (length txt) 4389 0 (length txt)
4272 (list 'face 4390 (list 'face
4273 (if donep 'org-done 'org-warning) 4391 (if donep 'org-done 'org-warning)
4274 'undone-face 'org-warning 4392 'undone-face 'org-warning
4275 'done-face 'org-done 4393 'done-face 'org-done
@@ -4329,8 +4447,8 @@ the documentation of `org-diary'."
4329 (setq txt org-agenda-no-heading-message)) 4447 (setq txt org-agenda-no-heading-message))
4330 (when txt 4448 (when txt
4331 (add-text-properties 4449 (add-text-properties
4332 0 (length txt) 4450 0 (length txt)
4333 (append 4451 (append
4334 (list 'org-marker (org-agenda-new-marker pos) 4452 (list 'org-marker (org-agenda-new-marker pos)
4335 'org-hd-marker (org-agenda-new-marker pos1) 4453 'org-hd-marker (org-agenda-new-marker pos1)
4336 'priority (+ (- 10 diff) (org-get-priority txt)) 4454 'priority (+ (- 10 diff) (org-get-priority txt))
@@ -4422,7 +4540,7 @@ the documentation of `org-diary'."
4422 (setq hdmarker (org-agenda-new-marker (match-end 1))) 4540 (setq hdmarker (org-agenda-new-marker (match-end 1)))
4423 (goto-char (match-end 1)) 4541 (goto-char (match-end 1))
4424 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") 4542 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)")
4425 (setq txt (org-format-agenda-item 4543 (setq txt (org-format-agenda-item
4426 (format (if (= d1 d2) "" "(%d/%d): ") 4544 (format (if (= d1 d2) "" "(%d/%d): ")
4427 (1+ (- d0 d1)) (1+ (- d2 d1))) 4545 (1+ (- d0 d1)) (1+ (- d2 d1)))
4428 (match-string 1) nil (if (= d0 d1) timestr)))) 4546 (match-string 1) nil (if (= d0 d1) timestr))))
@@ -4504,7 +4622,7 @@ only the correctly processes TXT should be returned - this is used by
4504 (setq s0 (match-string 0 ts) 4622 (setq s0 (match-string 0 ts)
4505 s1 (match-string (if plain 1 2) ts) 4623 s1 (match-string (if plain 1 2) ts)
4506 s2 (match-string (if plain 8 4) ts)) 4624 s2 (match-string (if plain 8 4) ts))
4507 4625
4508 ;; If the times are in TXT (not in DOTIMES), and the prefix will list 4626 ;; If the times are in TXT (not in DOTIMES), and the prefix will list
4509 ;; them, we might want to remove them there to avoid duplication. 4627 ;; them, we might want to remove them there to avoid duplication.
4510 ;; The user can turn this off with a variable. 4628 ;; The user can turn this off with a variable.
@@ -4517,7 +4635,7 @@ only the correctly processes TXT should be returned - this is used by
4517 ;; Normalize the time(s) to 24 hour 4635 ;; Normalize the time(s) to 24 hour
4518 (if s1 (setq s1 (org-get-time-of-day s1 'string))) 4636 (if s1 (setq s1 (org-get-time-of-day s1 'string)))
4519 (if s2 (setq s2 (org-get-time-of-day s2 'string)))) 4637 (if s2 (setq s2 (org-get-time-of-day s2 'string))))
4520 4638
4521 ;; Create the final string 4639 ;; Create the final string
4522 (if noprefix 4640 (if noprefix
4523 (setq rtn txt) 4641 (setq rtn txt)
@@ -4529,7 +4647,7 @@ only the correctly processes TXT should be returned - this is used by
4529 category (if (symbolp category) (symbol-name category) category)) 4647 category (if (symbolp category) (symbol-name category) category))
4530 ;; Evaluate the compiled format 4648 ;; Evaluate the compiled format
4531 (setq rtn (concat (eval org-prefix-format-compiled) txt))) 4649 (setq rtn (concat (eval org-prefix-format-compiled) txt)))
4532 4650
4533 ;; And finally add the text properties 4651 ;; And finally add the text properties
4534 (add-text-properties 4652 (add-text-properties
4535 0 (length rtn) (list 'category (downcase category) 4653 0 (length rtn) (list 'category (downcase category)
@@ -4560,11 +4678,11 @@ only the correctly processes TXT should be returned - this is used by
4560 (while (setq time (pop gridtimes)) 4678 (while (setq time (pop gridtimes))
4561 (unless (and remove (member time have)) 4679 (unless (and remove (member time have))
4562 (setq time (int-to-string time)) 4680 (setq time (int-to-string time))
4563 (push (org-format-agenda-item 4681 (push (org-format-agenda-item
4564 nil string "" ;; FIXME: put a category? 4682 nil string "" ;; FIXME: put a category?
4565 (concat (substring time 0 -2) ":" (substring time -2))) 4683 (concat (substring time 0 -2) ":" (substring time -2)))
4566 new) 4684 new)
4567 (put-text-property 4685 (put-text-property
4568 1 (length (car new)) 'face 'org-time-grid (car new)))) 4686 1 (length (car new)) 'face 'org-time-grid (car new))))
4569 (if (member 'time-up org-agenda-sorting-strategy) 4687 (if (member 'time-up org-agenda-sorting-strategy)
4570 (append new list) 4688 (append new list)
@@ -4603,7 +4721,7 @@ If not found, return nil.
4603The optional STRING argument forces conversion into a 5 character wide string 4721The optional STRING argument forces conversion into a 5 character wide string
4604HH:MM." 4722HH:MM."
4605 (save-match-data 4723 (save-match-data
4606 (when 4724 (when
4607 (or 4725 (or
4608 (string-match 4726 (string-match
4609 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s) 4727 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
@@ -4659,7 +4777,7 @@ HH:MM."
4659 (category-up (org-cmp-category a b)) 4777 (category-up (org-cmp-category a b))
4660 (category-down (if category-up (- category-up) nil)) 4778 (category-down (if category-up (- category-up) nil))
4661 (category-keep (if category-up +1 nil))) ; FIXME +1 or -1? 4779 (category-keep (if category-up +1 nil))) ; FIXME +1 or -1?
4662 (cdr (assoc 4780 (cdr (assoc
4663 (eval (cons 'or org-agenda-sorting-strategy)) 4781 (eval (cons 'or org-agenda-sorting-strategy))
4664 '((-1 . t) (1 . nil) (nil . nil)))))) 4782 '((-1 . t) (1 . nil) (nil . nil))))))
4665 4783
@@ -4674,7 +4792,7 @@ and by additional input from the age of a schedules or deadline entry."
4674(defun org-agenda-goto (&optional highlight) 4792(defun org-agenda-goto (&optional highlight)
4675 "Go to the Org-mode file which contains the item at point." 4793 "Go to the Org-mode file which contains the item at point."
4676 (interactive) 4794 (interactive)
4677 (let* ((marker (or (get-text-property (point) 'org-marker) 4795 (let* ((marker (or (get-text-property (point) 'org-marker)
4678 (org-agenda-error))) 4796 (org-agenda-error)))
4679 (buffer (marker-buffer marker)) 4797 (buffer (marker-buffer marker))
4680 (pos (marker-position marker))) 4798 (pos (marker-position marker)))
@@ -4691,7 +4809,7 @@ and by additional input from the age of a schedules or deadline entry."
4691(defun org-agenda-switch-to () 4809(defun org-agenda-switch-to ()
4692 "Go to the Org-mode file which contains the item at point." 4810 "Go to the Org-mode file which contains the item at point."
4693 (interactive) 4811 (interactive)
4694 (let* ((marker (or (get-text-property (point) 'org-marker) 4812 (let* ((marker (or (get-text-property (point) 'org-marker)
4695 (org-agenda-error))) 4813 (org-agenda-error)))
4696 (buffer (marker-buffer marker)) 4814 (buffer (marker-buffer marker))
4697 (pos (marker-position marker))) 4815 (pos (marker-position marker)))
@@ -4805,7 +4923,7 @@ the new TODO state."
4805 (beginning-of-line 1) 4923 (beginning-of-line 1)
4806 (add-text-properties (point-at-bol) (point-at-eol) props) 4924 (add-text-properties (point-at-bol) (point-at-eol) props)
4807 (if fixface 4925 (if fixface
4808 (add-text-properties 4926 (add-text-properties
4809 (point-at-bol) (point-at-eol) 4927 (point-at-bol) (point-at-eol)
4810 (list 'face 4928 (list 'face
4811 (if org-last-todo-state-is-todo 4929 (if org-last-todo-state-is-todo
@@ -4902,7 +5020,7 @@ be used to request time specification in the time stamp."
4902All the standard commands work: block, weekly etc" 5020All the standard commands work: block, weekly etc"
4903 (interactive) 5021 (interactive)
4904 (require 'diary-lib) 5022 (require 'diary-lib)
4905 (let* ((char (progn 5023 (let* ((char (progn
4906 (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic") 5024 (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic")
4907 (read-char-exclusive))) 5025 (read-char-exclusive)))
4908 (cmd (cdr (assoc char 5026 (cmd (cdr (assoc char
@@ -4932,7 +5050,7 @@ All the standard commands work: block, weekly etc"
4932 (progn 5050 (progn
4933 (fset 'calendar-cursor-to-date 5051 (fset 'calendar-cursor-to-date
4934 (lambda (&optional error) 5052 (lambda (&optional error)
4935 (calendar-gregorian-from-absolute 5053 (calendar-gregorian-from-absolute
4936 (get-text-property point 'day)))) 5054 (get-text-property point 'day))))
4937 (call-interactively cmd)) 5055 (call-interactively cmd))
4938 (fset 'calendar-cursor-to-date oldf))))) 5056 (fset 'calendar-cursor-to-date oldf)))))
@@ -4955,7 +5073,7 @@ the cursor position."
4955 (progn 5073 (progn
4956 (fset 'calendar-cursor-to-date 5074 (fset 'calendar-cursor-to-date
4957 (lambda (&optional error) 5075 (lambda (&optional error)
4958 (calendar-gregorian-from-absolute 5076 (calendar-gregorian-from-absolute
4959 (get-text-property point 'day)))) 5077 (get-text-property point 'day))))
4960 (call-interactively cmd)) 5078 (call-interactively cmd))
4961 (fset 'calendar-cursor-to-date oldf)))) 5079 (fset 'calendar-cursor-to-date oldf))))
@@ -5005,7 +5123,7 @@ This is a command that has to be installed in `calendar-mode-map'."
5005 (unless day 5123 (unless day
5006 (error "Don't know which date to convert")) 5124 (error "Don't know which date to convert"))
5007 (setq date (calendar-gregorian-from-absolute day)) 5125 (setq date (calendar-gregorian-from-absolute day))
5008 (setq s (concat 5126 (setq s (concat
5009 "Gregorian: " (calendar-date-string date) "\n" 5127 "Gregorian: " (calendar-date-string date) "\n"
5010 "ISO: " (calendar-iso-date-string date) "\n" 5128 "ISO: " (calendar-iso-date-string date) "\n"
5011 "Day of Yr: " (calendar-day-of-year-string date) "\n" 5129 "Day of Yr: " (calendar-day-of-year-string date) "\n"
@@ -5118,9 +5236,9 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
5118 5236
5119 ((string= type "shell") 5237 ((string= type "shell")
5120 (let ((cmd path)) 5238 (let ((cmd path))
5121 (while (string-match "@{" cmd) 5239 (while (string-match "@{" cmd)
5122 (setq cmd (replace-match "<" t t cmd))) 5240 (setq cmd (replace-match "<" t t cmd)))
5123 (while (string-match "@}" cmd) 5241 (while (string-match "@}" cmd)
5124 (setq cmd (replace-match ">" t t cmd))) 5242 (setq cmd (replace-match ">" t t cmd)))
5125 (if (or (not org-confirm-shell-links) 5243 (if (or (not org-confirm-shell-links)
5126 (yes-or-no-p (format "Execute \"%s\" in the shell? " cmd))) 5244 (yes-or-no-p (format "Execute \"%s\" in the shell? " cmd)))
@@ -5217,7 +5335,7 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
5217 (widen) 5335 (widen)
5218 (goto-char (point-max)) 5336 (goto-char (point-max))
5219 (if (re-search-backward 5337 (if (re-search-backward
5220 (concat "^Message-ID:\\s-+" (regexp-quote 5338 (concat "^Message-ID:\\s-+" (regexp-quote
5221 (or article ""))) 5339 (or article "")))
5222 nil t) 5340 nil t)
5223 (rmail-what-message)))))) 5341 (rmail-what-message))))))
@@ -5304,7 +5422,7 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5304 (or (bbdb-record-name (bbdb-current-record)) 5422 (or (bbdb-record-name (bbdb-current-record))
5305 (bbdb-record-company (bbdb-current-record)))) 5423 (bbdb-record-company (bbdb-current-record))))
5306 link (org-make-link cpltxt))) 5424 link (org-make-link cpltxt)))
5307 5425
5308 ((eq major-mode 'calendar-mode) 5426 ((eq major-mode 'calendar-mode)
5309 (let ((cd (calendar-cursor-to-date))) 5427 (let ((cd (calendar-cursor-to-date)))
5310 (setq link 5428 (setq link
@@ -5330,8 +5448,8 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5330 folder) 5448 folder)
5331 (setq folder (replace-match "" t t folder))) 5449 (setq folder (replace-match "" t t folder)))
5332 (setq cpltxt (concat author " on: " subject)) 5450 (setq cpltxt (concat author " on: " subject))
5333 (setq link (concat cpltxt "\n " 5451 (setq link (concat cpltxt "\n "
5334 (org-make-link 5452 (org-make-link
5335 "vm:" folder "#" message-id)))))) 5453 "vm:" folder "#" message-id))))))
5336 5454
5337 ((eq major-mode 'wl-summary-mode) 5455 ((eq major-mode 'wl-summary-mode)
@@ -5343,7 +5461,7 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5343 (author (wl-summary-line-from)) ; FIXME: how to get author name? 5461 (author (wl-summary-line-from)) ; FIXME: how to get author name?
5344 (subject "???")) ; FIXME: How to get subject of email? 5462 (subject "???")) ; FIXME: How to get subject of email?
5345 (setq cpltxt (concat author " on: " subject)) 5463 (setq cpltxt (concat author " on: " subject))
5346 (setq link (concat cpltxt "\n " 5464 (setq link (concat cpltxt "\n "
5347 (org-make-link 5465 (org-make-link
5348 "wl:" wl-summary-buffer-folder-name 5466 "wl:" wl-summary-buffer-folder-name
5349 "#" message-id))))) 5467 "#" message-id)))))
@@ -5357,7 +5475,7 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5357 (author (mail-fetch-field "from")) 5475 (author (mail-fetch-field "from"))
5358 (subject (mail-fetch-field "subject"))) 5476 (subject (mail-fetch-field "subject")))
5359 (setq cpltxt (concat author " on: " subject)) 5477 (setq cpltxt (concat author " on: " subject))
5360 (setq link (concat cpltxt "\n " 5478 (setq link (concat cpltxt "\n "
5361 (org-make-link 5479 (org-make-link
5362 "rmail:" folder "#" message-id))))))) 5480 "rmail:" folder "#" message-id)))))))
5363 5481
@@ -5411,7 +5529,7 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5411 (if (org-xor org-line-numbers-in-file-links arg) 5529 (if (org-xor org-line-numbers-in-file-links arg)
5412 (setq cpltxt 5530 (setq cpltxt
5413 (concat cpltxt 5531 (concat cpltxt
5414 ":" (int-to-string 5532 ":" (int-to-string
5415 (+ (if (bolp) 1 0) (count-lines 5533 (+ (if (bolp) 1 0) (count-lines
5416 (point-min) (point))))))) 5534 (point-min) (point)))))))
5417 (setq link (org-make-link cpltxt))) 5535 (setq link (org-make-link cpltxt)))
@@ -5581,7 +5699,7 @@ If the variable `org-adapt-indentation' is non-nil, the entire text is
5581also indented so that it starts in the same column as the headline 5699also indented so that it starts in the same column as the headline
5582\(i.e. after the stars). 5700\(i.e. after the stars).
5583 5701
5584See also the variable `org-reverse-note-order'." 5702See also the variable `org-reverse-note-order'."
5585 (catch 'quit 5703 (catch 'quit
5586 (let* ((txt (buffer-substring (point-min) (point-max))) 5704 (let* ((txt (buffer-substring (point-min) (point-max)))
5587 (fastp current-prefix-arg) 5705 (fastp current-prefix-arg)
@@ -5687,6 +5805,10 @@ See also the variable `org-reverse-note-order'."
5687 "Detects an org-type table line.") 5805 "Detects an org-type table line.")
5688(defconst org-table-dataline-regexp "^[ \t]*|[^-]" 5806(defconst org-table-dataline-regexp "^[ \t]*|[^-]"
5689 "Detects an org-type table line.") 5807 "Detects an org-type table line.")
5808(defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)"
5809 "Detects a table line marked for automatic recalculation.")
5810(defconst org-table-recalculate-regexp "^[ \t]*| *[#*] *\\(|\\|$\\)"
5811 "Detects a table line marked for automatic recalculation.")
5690(defconst org-table-hline-regexp "^[ \t]*|-" 5812(defconst org-table-hline-regexp "^[ \t]*|-"
5691 "Detects an org-type table hline.") 5813 "Detects an org-type table hline.")
5692(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]" 5814(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]"
@@ -5843,6 +5965,7 @@ This is being used to correctly align a single field after TAB or RET.")
5843 "List of max width of fields in each column. 5965 "List of max width of fields in each column.
5844This is being used to correctly align a single field after TAB or RET.") 5966This is being used to correctly align a single field after TAB or RET.")
5845 5967
5968(defvar org-last-recalc-line nil)
5846 5969
5847(defun org-table-align () 5970(defun org-table-align ()
5848 "Align the table at point by aligning all vertical bars." 5971 "Align the table at point by aligning all vertical bars."
@@ -5878,7 +6001,12 @@ This is being used to correctly align a single field after TAB or RET.")
5878 (if (string-match "^ *" (car lines)) 6001 (if (string-match "^ *" (car lines))
5879 (setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ ))) 6002 (setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ )))
5880 ;; Mark the hlines 6003 ;; Mark the hlines
5881 (setq lines (mapcar (lambda (l) (if (string-match "^ *|-" l) nil l)) 6004 (setq lines (mapcar (lambda (l)
6005 (if (string-match "^ *|-" l)
6006 nil
6007 (if (string-match "[ \t]+$" l)
6008 (substring l 0 (match-beginning 0))
6009 l)))
5882 lines)) 6010 lines))
5883 ;; Get the data fields 6011 ;; Get the data fields
5884 (setq fields (mapcar 6012 (setq fields (mapcar
@@ -5994,15 +6122,17 @@ With argument TABLE-TYPE, go to the end of a table.el-type table."
5994 (let* ((pos (point)) s org-table-may-need-update 6122 (let* ((pos (point)) s org-table-may-need-update
5995 (col (org-table-current-column)) 6123 (col (org-table-current-column))
5996 (num (nth (1- col) org-table-last-alignment)) 6124 (num (nth (1- col) org-table-last-alignment))
5997 l f) 6125 l f n o)
5998 (when (> col 0) 6126 (when (> col 0)
5999 (skip-chars-backward "^|\n") 6127 (skip-chars-backward "^|\n")
6000 (if (looking-at " *\\([^|\n]*?\\) *|") 6128 (if (looking-at " *\\([^|\n]*?\\) *|")
6001 (progn 6129 (progn
6002 (setq s (match-string 1) 6130 (setq s (match-string 1)
6131 o (match-string 0)
6003 l (max 1 (- (match-end 0) (match-beginning 0) 3))) 6132 l (max 1 (- (match-end 0) (match-beginning 0) 3)))
6004 (setq f (format (if num " %%%ds |" " %%-%ds |") l)) 6133 (setq f (format (if num " %%%ds |" " %%-%ds |") l)
6005 (replace-match (format f s t t))) 6134 n (format f s t t))
6135 (or (equal n o) (replace-match n)))
6006 (setq org-table-may-need-update t)) 6136 (setq org-table-may-need-update t))
6007 (goto-char pos)))))) 6137 (goto-char pos))))))
6008 6138
@@ -6010,6 +6140,8 @@ With argument TABLE-TYPE, go to the end of a table.el-type table."
6010 "Go to the next field in the current table. 6140 "Go to the next field in the current table.
6011Before doing so, re-align the table if necessary." 6141Before doing so, re-align the table if necessary."
6012 (interactive) 6142 (interactive)
6143 (org-table-maybe-eval-formula)
6144 (org-table-maybe-recalculate-line)
6013 (if (and org-table-automatic-realign 6145 (if (and org-table-automatic-realign
6014 org-table-may-need-update) 6146 org-table-may-need-update)
6015 (org-table-align)) 6147 (org-table-align))
@@ -6032,6 +6164,8 @@ Before doing so, re-align the table if necessary."
6032 "Go to the previous field in the table. 6164 "Go to the previous field in the table.
6033Before doing so, re-align the table if necessary." 6165Before doing so, re-align the table if necessary."
6034 (interactive) 6166 (interactive)
6167 (org-table-justify-field-maybe)
6168 (org-table-maybe-recalculate-line)
6035 (if (and org-table-automatic-realign 6169 (if (and org-table-automatic-realign
6036 org-table-may-need-update) 6170 org-table-may-need-update)
6037 (org-table-align)) 6171 (org-table-align))
@@ -6048,6 +6182,8 @@ Before doing so, re-align the table if necessary."
6048 "Go to the next row (same column) in the current table. 6182 "Go to the next row (same column) in the current table.
6049Before doing so, re-align the table if necessary." 6183Before doing so, re-align the table if necessary."
6050 (interactive) 6184 (interactive)
6185 (org-table-maybe-eval-formula)
6186 (org-table-maybe-recalculate-line)
6051 (if (or (looking-at "[ \t]*$") 6187 (if (or (looking-at "[ \t]*$")
6052 (save-excursion (skip-chars-backward " \t") (bolp))) 6188 (save-excursion (skip-chars-backward " \t") (bolp)))
6053 (newline) 6189 (newline)
@@ -6071,7 +6207,7 @@ If the field at the cursor is empty, copy into it the content of the nearest
6071non-empty field above. With argument N, use the Nth non-empty field. 6207non-empty field above. With argument N, use the Nth non-empty field.
6072If the current field is not empty, it is copied down to the next row, and 6208If the current field is not empty, it is copied down to the next row, and
6073the cursor is moved with it. Therefore, repeating this command causes the 6209the cursor is moved with it. Therefore, repeating this command causes the
6074column to be filled row-by-row. 6210column to be filled row-by-row.
6075If the variable `org-table-copy-increment' is non-nil and the field is an 6211If the variable `org-table-copy-increment' is non-nil and the field is an
6076integer, it will be incremented while copying." 6212integer, it will be incremented while copying."
6077 (interactive "p") 6213 (interactive "p")
@@ -6081,23 +6217,29 @@ integer, it will be incremented while copying."
6081 (beg (org-table-begin)) 6217 (beg (org-table-begin))
6082 txt) 6218 txt)
6083 (org-table-check-inside-data-field) 6219 (org-table-check-inside-data-field)
6084 (if non-empty (progn (org-table-next-row) (org-table-blank-field))) 6220 (if non-empty
6085 (if (save-excursion 6221 (progn
6086 (setq txt 6222 (setq txt (org-trim field))
6087 (catch 'exit 6223 (org-table-next-row)
6088 (while (progn (beginning-of-line 1) 6224 (org-table-blank-field))
6089 (re-search-backward org-table-dataline-regexp 6225 (save-excursion
6090 beg t)) 6226 (setq txt
6091 (org-table-goto-column colpos t) 6227 (catch 'exit
6092 (if (and (looking-at 6228 (while (progn (beginning-of-line 1)
6093 "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") 6229 (re-search-backward org-table-dataline-regexp
6094 (= (setq n (1- n)) 0)) 6230 beg t))
6095 (throw 'exit (match-string 1))))))) 6231 (org-table-goto-column colpos t)
6232 (if (and (looking-at
6233 "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
6234 (= (setq n (1- n)) 0))
6235 (throw 'exit (match-string 1))))))))
6236 (if txt
6096 (progn 6237 (progn
6097 (if (and org-table-copy-increment 6238 (if (and org-table-copy-increment
6098 (string-match "^[0-9]+$" txt)) 6239 (string-match "^[0-9]+$" txt))
6099 (setq txt (format "%d" (+ (string-to-int txt) 1)))) 6240 (setq txt (format "%d" (+ (string-to-int txt) 1))))
6100 (insert txt) 6241 (insert txt)
6242 (org-table-maybe-recalculate-line)
6101 (org-table-align)) 6243 (org-table-align))
6102 (error "No non-empty field found")))) 6244 (error "No non-empty field found"))))
6103 6245
@@ -6119,10 +6261,10 @@ I.e. not on a hline or before the first or after the last column?"
6119 (org-table-check-inside-data-field) 6261 (org-table-check-inside-data-field)
6120 (if (and (interactive-p) (org-region-active-p)) 6262 (if (and (interactive-p) (org-region-active-p))
6121 (let (org-table-clip) 6263 (let (org-table-clip)
6122 (org-table-cut-region)) 6264 (org-table-cut-region (region-beginning) (region-end)))
6123 (skip-chars-backward "^|") 6265 (skip-chars-backward "^|")
6124 (backward-char 1) 6266 (backward-char 1)
6125 (if (looking-at "|[^|]+") 6267 (if (looking-at "|[^|\n]+")
6126 (let* ((pos (match-beginning 0)) 6268 (let* ((pos (match-beginning 0))
6127 (match (match-string 0)) 6269 (match (match-string 0))
6128 (len (length match))) 6270 (len (length match)))
@@ -6136,15 +6278,16 @@ N defaults to current field.
6136If REPLACE is a string, replace field with this value. The return value 6278If REPLACE is a string, replace field with this value. The return value
6137is always the old value." 6279is always the old value."
6138 (and n (org-table-goto-column n)) 6280 (and n (org-table-goto-column n))
6139 (skip-chars-backward "^|") 6281 (skip-chars-backward "^|\n")
6140 (backward-char 1) 6282 (backward-char 1)
6141 (if (looking-at "|[^|\r\n]*") 6283 (if (looking-at "|[^|\r\n]*")
6142 (let* ((pos (match-beginning 0)) 6284 (let* ((pos (match-beginning 0))
6143 (val (buffer-substring (1+ pos) (match-end 0)))) 6285 (val (buffer-substring (1+ pos) (match-end 0))))
6144 (if replace 6286 (if replace
6145 (replace-match (concat "|" replace))) 6287 (replace-match (concat "|" replace)))
6146 (goto-char (+ 2 pos)) 6288 (goto-char (min (point-at-eol) (+ 2 pos)))
6147 val))) 6289 val)
6290 (forward-char 1) ""))
6148 6291
6149(defun org-table-current-column () 6292(defun org-table-current-column ()
6150 "Find out which column we are in. 6293 "Find out which column we are in.
@@ -6162,7 +6305,7 @@ When called interactively, column is also displayed in echo area."
6162(defun org-table-goto-column (n &optional on-delim force) 6305(defun org-table-goto-column (n &optional on-delim force)
6163 "Move the cursor to the Nth column in the current table line. 6306 "Move the cursor to the Nth column in the current table line.
6164With optional argument ON-DELIM, stop with point before the left delimiter 6307With optional argument ON-DELIM, stop with point before the left delimiter
6165of the field. 6308of the field.
6166If there are less than N fields, just go to after the last delimiter. 6309If there are less than N fields, just go to after the last delimiter.
6167However, when FORCE is non-nil, create new columns if necessary." 6310However, when FORCE is non-nil, create new columns if necessary."
6168 (let ((pos (point-at-eol))) 6311 (let ((pos (point-at-eol)))
@@ -6173,10 +6316,10 @@ However, when FORCE is non-nil, create new columns if necessary."
6173 (and force 6316 (and force
6174 (progn (end-of-line 1) 6317 (progn (end-of-line 1)
6175 (skip-chars-backward "^|") 6318 (skip-chars-backward "^|")
6176 (insert " |") 6319 (insert " | "))))))
6177 (backward-char 2) t))))) 6320; (backward-char 2) t)))))
6178 (when (and force (not (looking-at ".*|"))) 6321 (when (and force (not (looking-at ".*|")))
6179 (save-excursion (end-of-line 1) (insert "|"))) 6322 (save-excursion (end-of-line 1) (insert " | ")))
6180 (if on-delim 6323 (if on-delim
6181 (backward-char 1) 6324 (backward-char 1)
6182 (if (looking-at " ") (forward-char 1)))))) 6325 (if (looking-at " ") (forward-char 1))))))
@@ -6255,8 +6398,9 @@ If TABLE-TYPE is non-nil, also chack for table.el-type tables."
6255 (beginning-of-line 2)) 6398 (beginning-of-line 2))
6256 (move-marker end nil) 6399 (move-marker end nil)
6257 (goto-line linepos) 6400 (goto-line linepos)
6258 (org-table-goto-column colpos)) 6401 (org-table-goto-column colpos)
6259 (org-table-align)) 6402 (org-table-align)
6403 (org-table-modify-formulas 'insert col)))
6260 6404
6261(defun org-table-find-dataline () 6405(defun org-table-find-dataline ()
6262 "Find a dataline in the current table, which is needed for column commands." 6406 "Find a dataline in the current table, which is needed for column commands."
@@ -6300,8 +6444,9 @@ If TABLE-TYPE is non-nil, also chack for table.el-type tables."
6300 (beginning-of-line 2)) 6444 (beginning-of-line 2))
6301 (move-marker end nil) 6445 (move-marker end nil)
6302 (goto-line linepos) 6446 (goto-line linepos)
6303 (org-table-goto-column colpos)) 6447 (org-table-goto-column colpos)
6304 (org-table-align)) 6448 (org-table-align)
6449 (org-table-modify-formulas 'remove col)))
6305 6450
6306(defun org-table-move-column-right () 6451(defun org-table-move-column-right ()
6307 "Move column to the right." 6452 "Move column to the right."
@@ -6340,15 +6485,16 @@ If TABLE-TYPE is non-nil, also chack for table.el-type tables."
6340 (beginning-of-line 2)) 6485 (beginning-of-line 2))
6341 (move-marker end nil) 6486 (move-marker end nil)
6342 (goto-line linepos) 6487 (goto-line linepos)
6343 (org-table-goto-column colpos)) 6488 (org-table-goto-column colpos)
6344 (org-table-align)) 6489 (org-table-align)
6490 (org-table-modify-formulas 'swap col (if left (1- col) (1+ col)))))
6345 6491
6346(defun org-table-move-row-down () 6492(defun org-table-move-row-down ()
6347 "Move table row down." 6493 "move table row down."
6348 (interactive) 6494 (interactive)
6349 (org-table-move-row nil)) 6495 (org-table-move-row nil))
6350(defun org-table-move-row-up () 6496(defun org-table-move-row-up ()
6351 "Move table row up." 6497 "move table row up."
6352 (interactive) 6498 (interactive)
6353 (org-table-move-row 'up)) 6499 (org-table-move-row 'up))
6354 6500
@@ -6380,13 +6526,18 @@ With prefix ARG, insert below the current line."
6380 (interactive "P") 6526 (interactive "P")
6381 (if (not (org-at-table-p)) 6527 (if (not (org-at-table-p))
6382 (error "Not at a table")) 6528 (error "Not at a table"))
6383 (let ((line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))) 6529 (let* ((line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
6530 new)
6384 (if (string-match "^[ \t]*|-" line) 6531 (if (string-match "^[ \t]*|-" line)
6385 (setq line (mapcar (lambda (x) (if (member x '(?| ?+)) ?| ?\ )) line)) 6532 (setq new (mapcar (lambda (x) (if (member x '(?| ?+)) ?| ?\ )) line))
6386 (setq line (mapcar (lambda (x) (if (equal x ?|) ?| ?\ )) line))) 6533 (setq new (mapcar (lambda (x) (if (equal x ?|) ?| ?\ )) line)))
6534 ;; Fix the first field if necessary
6535 (setq new (concat new))
6536 (if (string-match "^[ \t]*| *[#$] *|" line)
6537 (setq new (replace-match (match-string 0 line) t t new)))
6387 (beginning-of-line (if arg 2 1)) 6538 (beginning-of-line (if arg 2 1))
6388 (let (org-table-may-need-update) 6539 (let (org-table-may-need-update)
6389 (apply 'insert-before-markers line) 6540 (insert-before-markers new)
6390 (insert-before-markers "\n")) 6541 (insert-before-markers "\n"))
6391 (beginning-of-line 0) 6542 (beginning-of-line 0)
6392 (re-search-forward "| ?" (point-at-eol) t) 6543 (re-search-forward "| ?" (point-at-eol) t)
@@ -6431,26 +6582,23 @@ With prefix ARG, insert above the current line."
6431 (move-to-column col))) 6582 (move-to-column col)))
6432 6583
6433 6584
6434(defun org-table-cut-region () 6585(defun org-table-cut-region (beg end)
6435 "Copy region in table to the clipboard and blank all relevant fields." 6586 "Copy region in table to the clipboard and blank all relevant fields."
6436 (interactive) 6587 (interactive "r")
6437 (org-table-copy-region 'cut)) 6588 (org-table-copy-region beg end 'cut))
6438 6589
6439(defun org-table-copy-region (&optional cut) 6590(defun org-table-copy-region (beg end &optional cut)
6440 "Copy rectangular region in table to clipboard. 6591 "Copy rectangular region in table to clipboard.
6441A special clipboard is used which can only be accessed 6592A special clipboard is used which can only be accessed
6442with `org-table-paste-rectangle'" 6593with `org-table-paste-rectangle'"
6443 (interactive "P") 6594 (interactive "rP")
6444 (unless (org-region-active-p) (error "No active region")) 6595 (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2
6445 (let* ((beg (region-beginning))
6446 (end (region-end))
6447 l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2
6448 region cols 6596 region cols
6449 (rpl (if cut " " nil))) 6597 (rpl (if cut " " nil)))
6450 (goto-char beg) 6598 (goto-char beg)
6451 (org-table-check-inside-data-field) 6599 (org-table-check-inside-data-field)
6452 (setq l01 (count-lines (point-min) (point)) 6600 (setq l01 (count-lines (point-min) (point))
6453 c01 (org-table-current-column)) 6601 c01 (org-table-current-column))
6454 (goto-char end) 6602 (goto-char end)
6455 (org-table-check-inside-data-field) 6603 (org-table-check-inside-data-field)
6456 (setq l02 (count-lines (point-min) (point)) 6604 (setq l02 (count-lines (point-min) (point))
@@ -6470,8 +6618,9 @@ with `org-table-paste-rectangle'"
6470 (push (nreverse cols) region) 6618 (push (nreverse cols) region)
6471 (setq l1 (1+ l1))))) 6619 (setq l1 (1+ l1)))))
6472 (setq org-table-clip (nreverse region)) 6620 (setq org-table-clip (nreverse region))
6473 (if cut (org-table-align)))) 6621 (if cut (org-table-align))
6474 6622 org-table-clip))
6623
6475(defun org-table-paste-rectangle () 6624(defun org-table-paste-rectangle ()
6476 "Paste a rectangular region into a table. 6625 "Paste a rectangular region into a table.
6477The upper right corner ends up in the current field. All involved fields 6626The upper right corner ends up in the current field. All involved fields
@@ -6574,7 +6723,7 @@ blank, and the content is appended to the field above."
6574 ;; There is a region: fill as a paragraph 6723 ;; There is a region: fill as a paragraph
6575 (let ((beg (region-beginning)) 6724 (let ((beg (region-beginning))
6576 nlines) 6725 nlines)
6577 (org-table-cut-region) 6726 (org-table-cut-region (region-beginning) (region-end))
6578 (if (> (length (car org-table-clip)) 1) 6727 (if (> (length (car org-table-clip)) 1)
6579 (error "Region must be limited to single column")) 6728 (error "Region must be limited to single column"))
6580 (setq nlines (if arg 6729 (setq nlines (if arg
@@ -6582,7 +6731,7 @@ blank, and the content is appended to the field above."
6582 (+ (length org-table-clip) arg) 6731 (+ (length org-table-clip) arg)
6583 arg) 6732 arg)
6584 (length org-table-clip))) 6733 (length org-table-clip)))
6585 (setq org-table-clip 6734 (setq org-table-clip
6586 (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ") 6735 (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ")
6587 nil nlines))) 6736 nil nlines)))
6588 (goto-char beg) 6737 (goto-char beg)
@@ -6611,7 +6760,8 @@ blank, and the content is appended to the field above."
6611(defun org-trim (s) 6760(defun org-trim (s)
6612 "Remove whitespace at beginning and end of string." 6761 "Remove whitespace at beginning and end of string."
6613 (if (string-match "^[ \t]+" s) (setq s (replace-match "" t t s))) 6762 (if (string-match "^[ \t]+" s) (setq s (replace-match "" t t s)))
6614 (if (string-match "[ \t]+$" s) (setq s (replace-match "" t t s)))) 6763 (if (string-match "[ \t]+$" s) (setq s (replace-match "" t t s)))
6764 s)
6615 6765
6616(defun org-wrap (string &optional width lines) 6766(defun org-wrap (string &optional width lines)
6617 "Wrap string to either a number of lines, or a width in characters. 6767 "Wrap string to either a number of lines, or a width in characters.
@@ -6637,7 +6787,7 @@ The return value is a list of lines, without newlines at the end."
6637 (setq ll (org-do-wrap words w))) 6787 (setq ll (org-do-wrap words w)))
6638 ll)) 6788 ll))
6639 (t (error "Cannot wrap this"))))) 6789 (t (error "Cannot wrap this")))))
6640 6790
6641 6791
6642(defun org-do-wrap (words width) 6792(defun org-do-wrap (words width)
6643 "Create lines of maximum width WIDTH (in characters) from word list WORDS." 6793 "Create lines of maximum width WIDTH (in characters) from word list WORDS."
@@ -6734,7 +6884,7 @@ visible when ARG is not positive"
6734 (save-excursion (funcall function))) 6884 (save-excursion (funcall function)))
6735 (re-search-forward org-table-any-border-regexp nil 1))))) 6885 (re-search-forward org-table-any-border-regexp nil 1)))))
6736 6886
6737(defun org-table-sum () 6887(defun org-table-sum (&optional beg end nlast)
6738 "Sum numbers in region of current table column. 6888 "Sum numbers in region of current table column.
6739The result will be displayed in the echo area, and will be available 6889The result will be displayed in the echo area, and will be available
6740as kill to be inserted with \\[yank]. 6890as kill to be inserted with \\[yank].
@@ -6746,35 +6896,38 @@ column.
6746 6896
6747If at least one number looks like a time HH:MM or HH:MM:SS, all other 6897If at least one number looks like a time HH:MM or HH:MM:SS, all other
6748numbers are assumed to be times as well (in decimal hours) and the 6898numbers are assumed to be times as well (in decimal hours) and the
6749numbers are added as such." 6899numbers are added as such.
6900
6901If NLAST is a number, only the NLAST fields will actually be summed."
6750 (interactive) 6902 (interactive)
6751 (save-excursion 6903 (save-excursion
6752 (let (beg end col (timecnt 0) diff h m s) 6904 (let (col (timecnt 0) diff h m s org-table-clip)
6753 (if (org-region-active-p) 6905 (cond
6754 (setq beg (region-beginning) end (region-end)) 6906 ((and beg end)) ; beg and end given explicitly
6907 ((org-region-active-p)
6908 (setq beg (region-beginning) end (region-end)))
6909 (t
6755 (setq col (org-table-current-column)) 6910 (setq col (org-table-current-column))
6756 (goto-char (org-table-begin)) 6911 (goto-char (org-table-begin))
6757 (unless (re-search-forward "^[ \t]*|[^-]" nil t) 6912 (unless (re-search-forward "^[ \t]*|[^-]" nil t)
6758 (error "No table data")) 6913 (error "No table data"))
6759 (org-table-goto-column col) 6914 (org-table-goto-column col)
6760 (skip-chars-backward "^|") 6915;not needed? (skip-chars-backward "^|")
6761 (setq beg (point)) 6916 (setq beg (point))
6762 (goto-char (org-table-end)) 6917 (goto-char (org-table-end))
6763 (unless (re-search-backward "^[ \t]*|[^-]" nil t) 6918 (unless (re-search-backward "^[ \t]*|[^-]" nil t)
6764 (error "No table data")) 6919 (error "No table data"))
6765 (org-table-goto-column col) 6920 (org-table-goto-column col)
6766 (skip-chars-forward "^|") 6921;not needed? (skip-chars-forward "^|")
6767 (setq end (point))) 6922 (setq end (point))))
6768 (let* ((l1 (progn (goto-char beg) 6923 (let* ((items (apply 'append (org-table-copy-region beg end)))
6769 (+ (if (bolp) 1 0) (count-lines (point-min) (point))))) 6924 (items1 (cond ((not nlast) items)
6770 (l2 (progn (goto-char end) 6925 ((>= nlast (length items)) items)
6771 (+ (if (bolp) 1 0) (count-lines (point-min) (point))))) 6926 (t (setq items (reverse items))
6772 (items (if (= l1 l2) 6927 (setcdr (nthcdr (1- nlast) items) nil)
6773 (split-string (buffer-substring beg end)) 6928 (nreverse items))))
6774 (split-string
6775 (mapconcat 'identity (extract-rectangle beg end) " "))))
6776 (numbers (delq nil (mapcar 'org-table-get-number-for-summing 6929 (numbers (delq nil (mapcar 'org-table-get-number-for-summing
6777 items))) 6930 items1)))
6778 (res (apply '+ numbers)) 6931 (res (apply '+ numbers))
6779 (sres (if (= timecnt 0) 6932 (sres (if (= timecnt 0)
6780 (format "%g" res) 6933 (format "%g" res)
@@ -6784,9 +6937,11 @@ numbers are added as such."
6784 s diff) 6937 s diff)
6785 (format "%d:%02d:%02d" h m s)))) 6938 (format "%d:%02d:%02d" h m s))))
6786 (kill-new sres) 6939 (kill-new sres)
6787 (message (substitute-command-keys 6940 (if (interactive-p)
6788 (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)" 6941 (message (substitute-command-keys
6789 (length numbers) sres))))))) 6942 (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)"
6943 (length numbers) sres))))
6944 sres))))
6790 6945
6791(defun org-table-get-number-for-summing (s) 6946(defun org-table-get-number-for-summing (s)
6792 (let (n) 6947 (let (n)
@@ -6808,15 +6963,136 @@ numbers are added as such."
6808 ((equal n 0) nil) 6963 ((equal n 0) nil)
6809 (t n)))) 6964 (t n))))
6810 6965
6811(defvar org-table-current-formula nil)
6812(defvar org-table-formula-history nil) 6966(defvar org-table-formula-history nil)
6813(defun org-table-get-formula (current) 6967
6814 (if (and current (not (equal "" org-table-current-formula))) 6968(defun org-table-get-formula (&optional equation)
6815 org-table-current-formula 6969 "Read a formula from the minibuffer, offer stored formula as default."
6816 (setq org-table-current-formula 6970 (let* ((col (org-table-current-column))
6817 (read-string 6971 (stored-list (org-table-get-stored-formulas))
6818 "Formula [last]: " "" 'org-table-formula-history 6972 (stored (cdr (assoc col stored-list)))
6819 org-table-current-formula)))) 6973 (eq (cond
6974 ((and stored equation (string-match "^ *= *$" equation))
6975 stored)
6976 ((stringp equation)
6977 equation)
6978 (t (read-string
6979 "Formula: " (or stored "") 'org-table-formula-history
6980 stored)))))
6981 (if (not (string-match "\\S-" eq))
6982 (error "Empty formula"))
6983 (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq)))
6984 (if (string-match " *$" eq) (setq eq (replace-match "" t t eq)))
6985 (if stored
6986 (setcdr (assoc col stored-list) eq)
6987 (setq stored-list (cons (cons col eq) stored-list)))
6988 (if (not (equal stored eq))
6989 (org-table-store-formulas stored-list))
6990 eq))
6991
6992(defun org-table-store-formulas (alist)
6993 "Store the list of formulas below the current table."
6994 (setq alist (sort alist (lambda (a b) (< (car a) (car b)))))
6995 (save-excursion
6996 (goto-char (org-table-end))
6997 (if (looking-at "\\([ \t]*\n\\)*#\\+TBLFM:.*\n?")
6998 (delete-region (point) (match-end 0)))
6999 (insert "#+TBLFM: "
7000 (mapconcat (lambda (x)
7001 (concat "$" (int-to-string (car x)) "=" (cdr x)))
7002 alist "::")
7003 "\n")))
7004
7005(defun org-table-get-stored-formulas ()
7006 "Return an alist withh the t=stored formulas directly after current table."
7007 (interactive)
7008 (let (col eq eq-alist strings string)
7009 (save-excursion
7010 (goto-char (org-table-end))
7011 (when (looking-at "\\([ \t]*\n\\)*#\\+TBLFM: *\\(.*\\)")
7012 (setq strings (org-split-string (match-string 2) " *:: *"))
7013 (while (setq string (pop strings))
7014 (if (string-match "\\$\\([0-9]+\\) *= *\\(.*[^ \t]\\)" string)
7015 (setq col (string-to-number (match-string 1 string))
7016 eq (match-string 2 string)
7017 eq-alist (cons (cons col eq) eq-alist))))))
7018 eq-alist))
7019
7020(defun org-table-modify-formulas (action &rest columns)
7021 "Modify the formulas stored below the current table.
7022ACTION can be `remove', `insert', `swap'. For `swap', two column numbers are
7023expected, for the other action only a single column number is needed."
7024 (let ((list (org-table-get-stored-formulas))
7025 (nmax (length (org-split-string (buffer-substring (point-at-bol) (point-at-eol))
7026 "|")))
7027 col col1 col2)
7028 (cond
7029 ((null list)) ; No action needed if there are no stored formulas
7030 ((eq action 'remove)
7031 (setq col (car columns))
7032 (org-table-replace-in-formulas list col "INVALID")
7033 (if (assoc col list) (setq list (delq (assoc col list) list)))
7034 (loop for i from (1+ col) upto nmax by 1 do
7035 (org-table-replace-in-formulas list i (1- i))
7036 (if (assoc i list) (setcar (assoc i list) (1- i)))))
7037 ((eq action 'insert)
7038 (setq col (car columns))
7039 (loop for i from nmax downto col by 1 do
7040 (org-table-replace-in-formulas list i (1+ i))
7041 (if (assoc i list) (setcar (assoc i list) (1+ i)))))
7042 ((eq action 'swap)
7043 (setq col1 (car columns) col2 (nth 1 columns))
7044 (org-table-replace-in-formulas list col1 "Z")
7045 (org-table-replace-in-formulas list col2 col1)
7046 (org-table-replace-in-formulas list "Z" col2)
7047 (if (assoc col1 list) (setcar (assoc col1 list) "Z"))
7048 (if (assoc col2 list) (setcar (assoc col2 list) col1))
7049 (if (assoc "Z" list) (setcar (assoc "Z" list) col2)))
7050 (t (error "Invalid action in `org-table-modify-formulas'")))
7051 (if list (org-table-store-formulas list))))
7052
7053(defun org-table-replace-in-formulas (list s1 s2)
7054 (let (elt re s)
7055 (setq s1 (concat "$" (if (integerp s1) (int-to-string s1) s1))
7056 s2 (concat "$" (if (integerp s2) (int-to-string s2) s2))
7057 re (concat (regexp-quote s1) "\\>"))
7058 (while (setq elt (pop list))
7059 (setq s (cdr elt))
7060 (while (string-match re s)
7061 (setq s (replace-match s2 t t s)))
7062 (setcdr elt s))))
7063
7064(defvar org-table-column-names nil
7065 "Alist with column names, derived from the `!' line.")
7066(defvar org-table-column-name-regexp nil
7067 "Regular expression matching the current column names.")
7068(defvar org-table-local-parameters nil
7069 "Alist with parameter names, derived from the `$' line.")
7070
7071(defun org-table-get-specials ()
7072 "Get the column nmaes and local parameters for this table."
7073 (save-excursion
7074 (let ((beg (org-table-begin)) (end (org-table-end))
7075 names name fields field cnt)
7076 (setq org-table-column-names nil
7077 org-table-local-parameters nil)
7078 (goto-char beg)
7079 (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t)
7080 (setq names (org-split-string (match-string 1) " *| *")
7081 cnt 1)
7082 (while (setq name (pop names))
7083 (setq cnt (1+ cnt))
7084 (if (string-match "^[a-zA-Z][a-zA-Z0-9]*$" name)
7085 (push (cons name (int-to-string cnt)) org-table-column-names))))
7086 (setq org-table-column-names (nreverse org-table-column-names))
7087 (setq org-table-column-name-regexp
7088 (concat "\\$\\(" (mapconcat 'car org-table-column-names "\\|") "\\)\\>"))
7089 (goto-char beg)
7090 (while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t)
7091 (setq fields (org-split-string (match-string 1) " *| *"))
7092 (while (setq field (pop fields))
7093 (if (string-match "^\\([a-zA-Z][a-zA-Z0-9]*\\) *= *\\(.*\\)" field)
7094 (push (cons (match-string 1 field) (match-string 2 field))
7095 org-table-local-parameters)))))))
6820 7096
6821(defun org-this-word () 7097(defun org-this-word ()
6822 ;; Get the current word 7098 ;; Get the current word
@@ -6825,24 +7101,157 @@ numbers are added as such."
6825 (end (progn (skip-chars-forward "^ \t\n") (point)))) 7101 (end (progn (skip-chars-forward "^ \t\n") (point))))
6826 (buffer-substring-no-properties beg end)))) 7102 (buffer-substring-no-properties beg end))))
6827 7103
6828(defun org-table-eval-formula (&optional ndown) 7104(defun org-table-maybe-eval-formula ()
7105 "Check if the current field starts with \"=\" and evaluate the formula."
7106 ;; We already know we are in a table. Get field will only return a formula
7107 ;; when appropriate. It might return a separator line, but no problem.
7108 (when org-table-formula-evaluate-inline
7109 (let* ((field (org-trim (or (org-table-get-field) "")))
7110 (dfield (downcase field))
7111 col bolpos nlast)
7112 (when (equal (string-to-char field) ?=)
7113 (if (string-match "^\\(=sum[vh]?\\)\\([0-9]+\\)$" dfield)
7114 (setq nlast (1+ (string-to-number (match-string 2 dfield)))
7115 dfield (match-string 1 dfield)))
7116 (cond
7117 ((equal dfield "=sumh")
7118 (org-table-get-field
7119 nil (org-table-sum
7120 (save-excursion (org-table-goto-column 1) (point))
7121 (point) nlast)))
7122 ((member dfield '("=sum" "=sumv"))
7123 (setq col (org-table-current-column)
7124 bolpos (point-at-bol))
7125 (org-table-get-field
7126 nil (org-table-sum
7127 (save-excursion
7128 (goto-char (org-table-begin))
7129 (if (re-search-forward org-table-dataline-regexp bolpos t)
7130 (progn
7131 (goto-char (match-beginning 0))
7132 (org-table-goto-column col)
7133 (point))
7134 (error "No datalines above current")))
7135 (point) nlast)))
7136 ((and (string-match "^ *=" field)
7137 (fboundp 'calc-eval))
7138 (org-table-eval-formula nil field)))))))
7139
7140(defvar org-last-recalc-undo-list nil)
7141(defcustom org-table-allow-line-recalculation t
7142 "FIXME:"
7143 :group 'org-table
7144 :type 'boolean)
7145
7146(defvar org-recalc-commands nil
7147 "List of commands triggering the reccalculation of a line.
7148Will be filled automatically during use.")
7149
7150(defvar org-recalc-marks
7151 '((" " . "Unmarked: no special line, no automatic recalculation")
7152 ("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line")
7153 ("*" . "Recalculate only when entire table is recalculated with `C-u C-c *'")
7154 ("!" . "Column name definition line. Reference in formula as $name.")
7155 ("$" . "Parameter definition line name=value. Reference in formula as $name.")))
7156
7157(defun org-table-rotate-recalc-marks (&optional newchar)
7158 "Rotate the recalculation mark in the first column.
7159If in any row, the first field is not consistent with a mark,
7160insert a new column for the makers.
7161When there is an active region, change all the lines in the region,
7162after prompting for the marking character.
7163After each change, a message will be displayed indication the meaning
7164of the new mark."
7165 (interactive)
7166 (unless (org-at-table-p) (error "Not at a table"))
7167 (let* ((marks (append (mapcar 'car org-recalc-marks) '(" ")))
7168 (beg (org-table-begin))
7169 (end (org-table-end))
7170 (l (org-current-line))
7171 (l1 (if (org-region-active-p) (org-current-line (region-beginning))))
7172 (l2 (if (org-region-active-p) (org-current-line (region-end))))
7173 (have-col
7174 (save-excursion
7175 (goto-char beg)
7176 (not (re-search-forward "^[ \t]*|[^-|][^|]*[^#!$*| \t][^|]*|" end t))))
7177 (col (org-table-current-column))
7178 (forcenew (car (assoc newchar org-recalc-marks)))
7179 epos new)
7180 (if l1 (setq newchar (char-to-string (read-char-exclusive "Change region to what mark? Type # * ! $ or SPC: "))
7181 forcenew (car (assoc newchar org-recalc-marks))))
7182 (if (and newchar (not forcenew))
7183 (error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'"
7184 newchar))
7185 (if l1 (goto-line l1))
7186 (save-excursion
7187 (beginning-of-line 1)
7188 (unless (looking-at org-table-dataline-regexp)
7189 (error "Not at a table data line")))
7190 (unless have-col
7191 (org-table-goto-column 1)
7192 (org-table-insert-column)
7193 (org-table-goto-column (1+ col)))
7194 (setq epos (point-at-eol))
7195 (save-excursion
7196 (beginning-of-line 1)
7197 (org-table-get-field
7198 1 (if (looking-at "^[ \t]*| *\\([#!$* ]\\) *|")
7199 (concat " "
7200 (setq new (or forcenew
7201 (cadr (member (match-string 1) marks))))
7202 " ")
7203 " # ")))
7204 (if (and l1 l2)
7205 (progn
7206 (goto-line l1)
7207 (while (progn (beginning-of-line 2) (not (= (org-current-line) l2)))
7208 (and (looking-at org-table-dataline-regexp)
7209 (org-table-get-field 1 (concat " " new " "))))
7210 (goto-line l1)))
7211 (if (not (= epos (point-at-eol))) (org-table-align))
7212 (goto-line l)
7213 (and (interactive-p) (message (cdr (assoc new org-recalc-marks))))))
7214
7215(defun org-table-maybe-recalculate-line ()
7216 "Recompute the current line if marked for it, and if we haven't just done it."
7217 (interactive)
7218 (and org-table-allow-line-recalculation
7219 (not (and (memq last-command org-recalc-commands)
7220 (equal org-last-recalc-line (org-current-line))))
7221 (save-excursion (beginning-of-line 1)
7222 (looking-at org-table-auto-recalculate-regexp))
7223 (fboundp 'calc-eval)
7224 (org-table-recalculate) t))
7225
7226(defvar org-table-formula-debug nil
7227 "Non-nil means, debug table formulas.
7228When nil, simply write \"#ERROR\" in corrupted fields.")
7229
7230(defvar modes)
7231(defsubst org-set-calc-mode (var value)
7232 (setcar (or (cdr (memq var modes)) (cons nil nil)) value))
7233
7234(defun org-table-eval-formula (&optional ndown equation
7235 suppress-align suppress-const
7236 suppress-store)
6829 "Replace the table field value at the cursor by the result of a calculation. 7237 "Replace the table field value at the cursor by the result of a calculation.
6830 7238
6831This function makes use of Dave Gillespie's calc package, arguably the most 7239This function makes use of Dave Gillespie's calc package, in my view the
6832exciting program ever written for GNU Emacs. So you need to have calc 7240most exciting program ever written for GNU Emacs. So you need to have calc
6833installed in order to use this function. 7241installed in order to use this function.
6834 7242
6835In a table, this command replaces the value in the current field with the 7243In a table, this command replaces the value in the current field with the
6836result of a formula. While nowhere near the computation options of a 7244result of a formula. While nowhere near the computation options of a
6837spreadsheet program, this is still very useful. Note that there is no 7245spreadsheet program, this is still very useful. There is no automatic
6838automatic updating of a calculated field, nor will the field remember the 7246updating of a calculated field, but the table will remember the last
6839formula. The command needs to be applied again after changing input 7247formula for each column. The command needs to be applied again after
6840fields. 7248changing input fields.
6841 7249
6842When called, the command first prompts for a formula, which is read in the 7250When called, the command first prompts for a formula, which is read in the
6843minibuffer. Previously entered formulae are available through the history 7251minibuffer. Previously entered formulas are available through the history
6844list, and the last used formula is the default, reachable by simply 7252list, and the last used formula for each column is offered as a default.
6845pressing RET. 7253These stored formulas are adapted correctly when moving, inserting, or
7254deleting columns with the corresponding commands.
6846 7255
6847The formula can be any algebraic expression understood by the calc package. 7256The formula can be any algebraic expression understood by the calc package.
6848Before evaluation, variable substitution takes place: \"$\" is replaced by 7257Before evaluation, variable substitution takes place: \"$\" is replaced by
@@ -6852,7 +7261,7 @@ here, so the command supports only horizontal computing. The formula can
6852contain an optional printf format specifier after a semicolon, to reformat 7261contain an optional printf format specifier after a semicolon, to reformat
6853the result. 7262the result.
6854 7263
6855A few examples for formulae: 7264A few examples for formulas:
6856 $1+$2 Sum of first and second field 7265 $1+$2 Sum of first and second field
6857 $1+$2;%.2f Same, and format result to two digits after dec.point 7266 $1+$2;%.2f Same, and format result to two digits after dec.point
6858 exp($2)+exp($1) Math functions can be used 7267 exp($2)+exp($1) Math functions can be used
@@ -6864,38 +7273,101 @@ field, and to the same same column in all following rows, until reaching a
6864horizontal line or the end of the table. When the command is called with a 7273horizontal line or the end of the table. When the command is called with a
6865numeric prefix argument (like M-3 or C-7 or \\[universal-argument] 24), the formula is applied 7274numeric prefix argument (like M-3 or C-7 or \\[universal-argument] 24), the formula is applied
6866to the current row, and to the following n-1 rows (but not beyond a 7275to the current row, and to the following n-1 rows (but not beyond a
6867separator line)." 7276separator line).
7277
7278This function can also be called from Lisp programs and offers two additional
7279Arguments: EQUATION can be the formula to apply. If this argument is given,
7280the user will not be prompted. SUPPRESS-ALIGN is used to speed-up
7281recursive calls by by-passing unnecessary aligns. SUPPRESS-CONST suppresses
7282the interpretation of constants in the formula. SUPPRESS-STORE means the
7283formula should not be stored, either because it is already stored, or because
7284it is a modified equation that should not overwrite the stored one."
6868 (interactive "P") 7285 (interactive "P")
6869 (setq ndown (if (equal ndown '(4)) 10000 (prefix-numeric-value ndown))) 7286 (setq ndown (if (equal ndown '(4)) 10000 (prefix-numeric-value ndown)))
6870 (require 'calc) 7287 (require 'calc)
6871 (org-table-check-inside-data-field) 7288 (org-table-check-inside-data-field)
7289 (org-table-get-specials)
6872 (let* (fields 7290 (let* (fields
6873 (org-table-automatic-realign nil) 7291 (org-table-automatic-realign nil)
7292 (case-fold-search nil)
6874 (down (> ndown 1)) 7293 (down (> ndown 1))
6875 (formula (org-table-get-formula nil)) 7294 (formula (if (and equation suppress-store)
7295 equation
7296 (org-table-get-formula equation)))
6876 (n0 (org-table-current-column)) 7297 (n0 (org-table-current-column))
6877 n form fmt x ev) 7298 (modes (copy-sequence org-calc-default-modes))
7299 n form fmt x ev orig c)
7300 ;; Parse the format
6878 (if (string-match ";" formula) 7301 (if (string-match ";" formula)
6879 (let ((tmp (org-split-string formula ";"))) 7302 (let ((tmp (org-split-string formula ";")))
6880 (setq formula (car tmp) fmt (nth 1 tmp)))) 7303 (setq formula (car tmp) fmt (or (nth 1 tmp) ""))
7304 (while (string-match "[pnfse]\\(-?[0-9]+\\)" fmt)
7305 (setq c (string-to-char (match-string 1 fmt))
7306 n (string-to-number (or (match-string 1 fmt) "")))
7307 (if (= c ?p) (org-set-calc-mode 'calc-internal-prec n)
7308 (org-set-calc-mode 'calc-float-format
7309 (list (cdr (assoc c '((?n. float) (?f. fix)
7310 (?s. sci) (?e. eng))))
7311 n)))
7312 (setq fmt (replace-match "" t t fmt)))
7313 (when (string-match "[DR]" fmt)
7314 (org-set-calc-mode 'calc-angle-mode
7315 (if (equal (match-string 0 fmt) "D")
7316 'deg 'rad))
7317 (setq fmt (replace-match "" t t fmt)))
7318 (when (string-match "F" fmt)
7319 (org-set-calc-mode 'calc-prefer-frac t)
7320 (setq fmt (replace-match "" t t fmt)))
7321 (when (string-match "S" fmt)
7322 (org-set-calc-mode 'calc-symbolic-mode t)
7323 (setq fmt (replace-match "" t t fmt)))
7324 (unless (string-match "\\S-" fmt)
7325 (setq fmt nil))))
7326 (if (and (not suppress-const) org-table-formula-use-constants)
7327 (setq formula (org-table-formula-substitute-names formula)))
7328 (setq orig (or (get-text-property 1 :orig-formula formula) "?"))
6881 (while (> ndown 0) 7329 (while (> ndown 0)
6882 (setq fields (org-split-string 7330 (setq fields (org-split-string
6883 (concat " " (buffer-substring 7331 (buffer-substring
6884 (point-at-bol) (point-at-eol))) "|")) 7332 (point-at-bol) (point-at-eol)) " *| *"))
7333 (if org-table-formula-numbers-only
7334 (setq fields (mapcar
7335 (lambda (x) (number-to-string (string-to-number x)))
7336 fields)))
6885 (setq ndown (1- ndown)) 7337 (setq ndown (1- ndown))
6886 (setq form (copy-sequence formula)) 7338 (setq form (copy-sequence formula))
6887 (while (string-match "\\$\\([0-9]+\\)?" form) 7339 (while (string-match "\\$\\([0-9]+\\)?" form)
6888 (setq n (if (match-beginning 1) 7340 (setq n (if (match-beginning 1)
6889 (string-to-int (match-string 1 form)) 7341 (string-to-int (match-string 1 form))
6890 n0) 7342 n0)
6891 x (nth n fields)) 7343 x (nth (1- n) fields))
6892 (unless x (error "Invalid field specifier \"%s\"" 7344 (unless x (error "Invalid field specifier \"%s\""
6893 (match-string 0 form))) 7345 (match-string 0 form)))
6894 (if (equal (string-to-number x) 0) (setq x "0")) 7346 (if (equal x "") (setq x "0"))
6895 (setq form (replace-match x t t form))) 7347 (setq form (replace-match (concat "(" x ")") t t form)))
6896 (setq ev (calc-eval (list form) 'num)) 7348 (setq ev (calc-eval (cons form modes)
7349 (if org-table-formula-numbers-only 'num)))
7350
7351 (when org-table-formula-debug
7352 (with-output-to-temp-buffer "*Help*"
7353 (princ (format "Substitution history of formula
7354Orig: %s
7355$xyz-> %s
7356$1-> %s\n" orig formula form))
7357 (if (listp ev)
7358 (princ (format " %s^\nError: %s"
7359 (make-string (car ev) ?\-) (nth 1 ev)))
7360 (princ (format "Result: %s" ev))))
7361 (shrink-window-if-larger-than-buffer (get-buffer-window "*Help*"))
7362 (unless (and (interactive-p) (not ndown))
7363 (unless (let (inhibit-redisplay)
7364 (y-or-n-p "Debugging Formula. Continue to next? "))
7365 (org-table-align)
7366 (error "Abort"))
7367 (delete-window (get-buffer-window "*Help*"))
7368 (message "")))
6897 (if (listp ev) 7369 (if (listp ev)
6898 (error "Invalid expression: %s (%s at %d)" form (nth 1 ev) (car ev))) 7370 (setq fmt nil ev "#ERROR"))
6899 (org-table-blank-field) 7371 (org-table-blank-field)
6900 (if fmt 7372 (if fmt
6901 (insert (format fmt (string-to-number ev))) 7373 (insert (format fmt (string-to-number ev)))
@@ -6903,7 +7375,96 @@ separator line)."
6903 (if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]")) 7375 (if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]"))
6904 (call-interactively 'org-return) 7376 (call-interactively 'org-return)
6905 (setq ndown 0))) 7377 (setq ndown 0)))
6906 (org-table-align))) 7378 (or suppress-align (org-table-align))))
7379
7380(defun org-table-recalculate (&optional all noalign)
7381 "Recalculate the current table line by applying all stored formulas."
7382 (interactive "P")
7383 (or (memq this-command org-recalc-commands)
7384 (setq org-recalc-commands (cons this-command org-recalc-commands)))
7385 (unless (org-at-table-p) (error "Not at a table"))
7386 (org-table-get-specials)
7387 (let* ((eqlist (sort (org-table-get-stored-formulas)
7388 (lambda (a b) (< (car a) (car b)))))
7389 (inhibit-redisplay t)
7390 (line-re org-table-dataline-regexp)
7391 (thisline (+ (if (bolp) 1 0) (count-lines (point-min) (point))))
7392 (thiscol (org-table-current-column))
7393 beg end entry eql (cnt 0))
7394 ;; Insert constants in all formulas
7395 (setq eqlist
7396 (mapcar (lambda (x)
7397 (setcdr x (org-table-formula-substitute-names (cdr x)))
7398 x)
7399 eqlist))
7400 (if all
7401 (progn
7402 (setq end (move-marker (make-marker) (1+ (org-table-end))))
7403 (goto-char (setq beg (org-table-begin)))
7404 (if (re-search-forward org-table-recalculate-regexp end t)
7405 (setq line-re org-table-recalculate-regexp)
7406 (if (and (re-search-forward org-table-dataline-regexp end t)
7407 (re-search-forward org-table-hline-regexp end t)
7408 (re-search-forward org-table-dataline-regexp end t))
7409 (setq beg (match-beginning 0))
7410 nil))) ;; just leave beg where it is
7411 (setq beg (point-at-bol)
7412 end (move-marker (make-marker) (1+ (point-at-eol)))))
7413 (goto-char beg)
7414 (and all (message "Re-applying formulas to full table..."))
7415 (while (re-search-forward line-re end t)
7416 (unless (string-match "^ *[!$] *$" (org-table-get-field 1))
7417 ;; Unprotected line, recalculate
7418 (and all (message "Re-applying formulas to full table...(line %d)"
7419 (setq cnt (1+ cnt))))
7420 (setq org-last-recalc-line (org-current-line))
7421 (setq eql eqlist)
7422 (while (setq entry (pop eql))
7423 (goto-line org-last-recalc-line)
7424 (org-table-goto-column (car entry) nil 'force)
7425 (org-table-eval-formula nil (cdr entry) 'noalign 'nocst 'nostore))))
7426 (goto-line thisline)
7427 (org-table-goto-column thiscol)
7428 (or noalign (org-table-align)
7429 (and all (message "Re-applying formulas to %d lines...done" cnt)))))
7430
7431(defun org-table-formula-substitute-names (f)
7432 "Replace $const with values in stirng F."
7433 (let ((start 0) a n1 n2 nn1 nn2 s (f1 f))
7434 ;; First, check for column names
7435 (while (setq start (string-match org-table-column-name-regexp f start))
7436 (setq start (1+ start))
7437 (setq a (assoc (match-string 1 f) org-table-column-names))
7438 (setq f (replace-match (concat "$" (cdr a)) t t f)))
7439 ;; Expand ranges to vectors
7440 (while (string-match "\\$\\([0-9]+\\)\\.\\.\\.?\\$\\([0-9]+\\)" f)
7441 (setq n1 (string-to-number (match-string 1 f))
7442 n2 (string-to-number (match-string 2 f))
7443 nn1 (1+ (min n1 n2)) nn2 (max n1 n2)
7444 s (concat "[($" (number-to-string (1- nn1)) ")"))
7445 (loop for i from nn1 upto nn2 do
7446 (setq s (concat s ",($" (int-to-string i) ")")))
7447 (setq s (concat s "]"))
7448 (if (< n2 n1) (setq s (concat "rev(" s ")")))
7449 (setq f (replace-match s t t f)))
7450 ;; Parameters and constants
7451 (setq start 0)
7452 (while (setq start (string-match "\\$\\([a-zA-Z][a-zA-Z0-9]*\\)" f start))
7453 (setq start (1+ start))
7454 (if (setq a (save-match-data
7455 (org-table-get-constant (match-string 1 f))))
7456 (setq f (replace-match (concat "(" a ")") t t f))))
7457 (if org-table-formula-debug
7458 (put-text-property 0 (length f) :orig-formula f1 f))
7459 f))
7460
7461(defun org-table-get-constant (const)
7462 "Find the value for a parameter or constant in a formula.
7463Parameters get priority."
7464 (or (cdr (assoc const org-table-local-parameters))
7465 (cdr (assoc const org-table-formula-constants))
7466 (and (fboundp 'constants-get) (constants-get const))
7467 "#UNDEFINED_NAME"))
6907 7468
6908;;; The orgtbl minor mode 7469;;; The orgtbl minor mode
6909 7470
@@ -6962,7 +7523,7 @@ table editor in arbitrary modes.")
6962 7523
6963;;;###autoload 7524;;;###autoload
6964(defun orgtbl-mode (&optional arg) 7525(defun orgtbl-mode (&optional arg)
6965 "The `org-mode' table editor as a minor mode for use in other modes." 7526 "The `org-mode' table editor as a minor mode for use in other modes."
6966 (interactive) 7527 (interactive)
6967 (if (eq major-mode 'org-mode) 7528 (if (eq major-mode 'org-mode)
6968 ;; Exit without error, in case some hook functions calls this 7529 ;; Exit without error, in case some hook functions calls this
@@ -6972,6 +7533,11 @@ table editor in arbitrary modes.")
6972 (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode))) 7533 (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode)))
6973 (if orgtbl-mode 7534 (if orgtbl-mode
6974 (progn 7535 (progn
7536 (and (orgtbl-setup) (defun orgtbl-setup () nil))
7537 ;; Make sure we are first in minor-mode-map-alist
7538 (let ((c (assq 'orgtbl-mode minor-mode-map-alist)))
7539 (and c (setq minor-mode-map-alist
7540 (cons c (delq c minor-mode-map-alist)))))
6975 (set (make-local-variable (quote org-table-may-need-update)) t) 7541 (set (make-local-variable (quote org-table-may-need-update)) t)
6976 (make-local-hook (quote before-change-functions)) 7542 (make-local-hook (quote before-change-functions))
6977 (add-hook 'before-change-functions 'org-before-change-function 7543 (add-hook 'before-change-functions 'org-before-change-function
@@ -6979,7 +7545,7 @@ table editor in arbitrary modes.")
6979 (set (make-local-variable 'org-old-auto-fill-inhibit-regexp) 7545 (set (make-local-variable 'org-old-auto-fill-inhibit-regexp)
6980 auto-fill-inhibit-regexp) 7546 auto-fill-inhibit-regexp)
6981 (set (make-local-variable 'auto-fill-inhibit-regexp) 7547 (set (make-local-variable 'auto-fill-inhibit-regexp)
6982 (if auto-fill-inhibit-regexp 7548 (if auto-fill-inhibit-regexp
6983 (concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp) 7549 (concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp)
6984 "[ \t]*|")) 7550 "[ \t]*|"))
6985 (easy-menu-add orgtbl-mode-menu) 7551 (easy-menu-add orgtbl-mode-menu)
@@ -6994,81 +7560,134 @@ table editor in arbitrary modes.")
6994(put 'orgtbl-mode :menu-tag "Org Table Mode") 7560(put 'orgtbl-mode :menu-tag "Org Table Mode")
6995(add-minor-mode 'orgtbl-mode " OrgTbl" orgtbl-mode-map) 7561(add-minor-mode 'orgtbl-mode " OrgTbl" orgtbl-mode-map)
6996 7562
6997(defun orgtbl-make-binding (fun &rest keys) 7563(defun orgtbl-make-binding (fun n &rest keys)
6998 "Create a function for binding in the table minor mode." 7564 "Create a function for binding in the table minor mode.
6999 (list 'lambda '(arg) 7565FUN is the command to call inside a table. N is used to create a unique
7000 (concat "Run `" (symbol-name fun) "' or the default binding.") 7566command name. KEYS are keys that should be checked in for a command
7001 '(interactive "p") 7567to execute outside of tables."
7002 (list 'if 7568 (eval
7003 '(org-at-table-p) 7569 (list 'defun
7004 (list 'call-interactively (list 'quote fun)) 7570 (intern (concat "orgtbl-hijacker-command-" (int-to-string n)))
7005 (list 'let '(orgtbl-mode) 7571 '(arg)
7006 (list 'call-interactively 7572 (concat "In tables, run `" (symbol-name fun) "'.\n"
7007 (append '(or) 7573 "Outside of tables, run the binding of `"
7008 (mapcar (lambda (k) 7574 (mapconcat (lambda (x) (format "%s" x)) keys "' or `")
7009 (list 'key-binding k)) 7575 "'.")
7010 keys) 7576 '(interactive "p")
7011 '('orgtbl-error))))))) 7577 (list 'if
7578 '(org-at-table-p)
7579 (list 'call-interactively (list 'quote fun))
7580 (list 'let '(orgtbl-mode)
7581 (list 'call-interactively
7582 (append '(or)
7583 (mapcar (lambda (k)
7584 (list 'key-binding k))
7585 keys)
7586 '('orgtbl-error))))))))
7012 7587
7013(defun orgtbl-error () 7588(defun orgtbl-error ()
7014 "Error when there is no default binding for a table key." 7589 "Error when there is no default binding for a table key."
7015 (interactive) 7590 (interactive)
7016 (error "This key is has no function outside tables")) 7591 (error "This key is has no function outside tables"))
7017 7592
7018;; Keybindings for the minor mode 7593(defun orgtbl-setup ()
7019(let ((bindings 7594 "Setup orgtbl keymaps."
7020 (list 7595 (let ((nfunc 0)
7021 '([(meta shift left)] org-table-delete-column) 7596 (bindings
7022 '([(meta left)] org-table-move-column-left) 7597 (list
7023 '([(meta right)] org-table-move-column-right) 7598 '([(meta shift left)] org-table-delete-column)
7024 '([(meta shift right)] org-table-insert-column) 7599 '([(meta left)] org-table-move-column-left)
7025 '([(meta shift up)] org-table-kill-row) 7600 '([(meta right)] org-table-move-column-right)
7026 '([(meta shift down)] org-table-insert-row) 7601 '([(meta shift right)] org-table-insert-column)
7027 '([(meta up)] org-table-move-row-up) 7602 '([(meta shift up)] org-table-kill-row)
7028 '([(meta down)] org-table-move-row-down) 7603 '([(meta shift down)] org-table-insert-row)
7029 '("\C-c\C-w" org-table-cut-region) 7604 '([(meta up)] org-table-move-row-up)
7030 '("\C-c\M-w" org-table-copy-region) 7605 '([(meta down)] org-table-move-row-down)
7031 '("\C-c\C-y" org-table-paste-rectangle) 7606 '("\C-c\C-w" org-table-cut-region)
7032 '("\C-c-" org-table-insert-hline) 7607 '("\C-c\M-w" org-table-copy-region)
7033 '([(shift tab)] org-table-previous-field) 7608 '("\C-c\C-y" org-table-paste-rectangle)
7034 '("\C-c\C-c" org-table-align) 7609 '("\C-c-" org-table-insert-hline)
7035 '("\C-m" org-table-next-row) 7610 '([(shift tab)] org-table-previous-field)
7036 (list (org-key 'S-return) 'org-table-copy-down) 7611 '("\C-c\C-c" org-ctrl-c-ctrl-c)
7037 '([(meta return)] org-table-wrap-region) 7612 '("\C-m" org-table-next-row)
7038 '("\C-c\C-q" org-table-wrap-region) 7613 (list (org-key 'S-return) 'org-table-copy-down)
7039 '("\C-c?" org-table-current-column) 7614 '([(meta return)] org-table-wrap-region)
7040 '("\C-c " org-table-blank-field) 7615 '("\C-c\C-q" org-table-wrap-region)
7041 '("\C-c+" org-table-sum) 7616 '("\C-c?" org-table-current-column)
7042 '("\C-c|" org-table-toggle-vline-visibility) 7617 '("\C-c " org-table-blank-field)
7043 '("\C-c=" org-table-eval-formula))) 7618 '("\C-c+" org-table-sum)
7044 elt key fun cmd) 7619 '("\C-c|" org-table-toggle-vline-visibility)
7045 (while (setq elt (pop bindings)) 7620 '("\C-c=" org-table-eval-formula)
7046 (setq key (car elt) 7621 '("\C-c*" org-table-recalculate)
7047 fun (nth 1 elt) 7622 '([(control ?#)] org-table-rotate-recalc-marks)))
7048 cmd (orgtbl-make-binding fun key)) 7623 elt key fun cmd)
7049 (define-key orgtbl-mode-map key cmd))) 7624 (while (setq elt (pop bindings))
7050 7625 (setq nfunc (1+ nfunc))
7051;; Special treatment needed for TAB and RET 7626 (setq key (car elt)
7052 7627 fun (nth 1 elt)
7053(define-key orgtbl-mode-map [(return)] 7628 cmd (orgtbl-make-binding fun nfunc key))
7054 (orgtbl-make-binding 'orgtbl-ret [(return)] "\C-m")) 7629 (define-key orgtbl-mode-map key cmd))
7055(define-key orgtbl-mode-map "\C-m" 7630 ;; Special treatment needed for TAB and RET
7056 (orgtbl-make-binding 'orgtbl-ret "\C-m" [(return)])) 7631 (define-key orgtbl-mode-map [(return)]
7057(define-key orgtbl-mode-map [(tab)] 7632 (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m"))
7058 (orgtbl-make-binding 'orgtbl-tab [(tab)] "\C-i")) 7633 (define-key orgtbl-mode-map "\C-m"
7059(define-key orgtbl-mode-map "\C-i" 7634 (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)]))
7060 (orgtbl-make-binding 'orgtbl-tab "\C-i" [(tab)])) 7635 (define-key orgtbl-mode-map [(tab)]
7061 7636 (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i"))
7062(when orgtbl-optimized 7637 (define-key orgtbl-mode-map "\C-i"
7063 ;; If the user wants maximum table support, we need to hijack 7638 (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)])))
7064 ;; some standard editing functions 7639 (when orgtbl-optimized
7065 (substitute-key-definition 'self-insert-command 'orgtbl-self-insert-command 7640 ;; If the user wants maximum table support, we need to hijack
7066 orgtbl-mode-map global-map) 7641 ;; some standard editing functions
7067 (substitute-key-definition 'delete-char 'orgtbl-delete-char 7642 (substitute-key-definition 'self-insert-command 'orgtbl-self-insert-command
7068 orgtbl-mode-map global-map) 7643 orgtbl-mode-map global-map)
7069 (substitute-key-definition 'delete-backward-char 'orgtbl-delete-backward-char 7644 (substitute-key-definition 'delete-char 'orgtbl-delete-char
7070 orgtbl-mode-map global-map) 7645 orgtbl-mode-map global-map)
7071 (define-key org-mode-map "|" 'self-insert-command)) 7646 (substitute-key-definition 'delete-backward-char 'orgtbl-delete-backward-char
7647 orgtbl-mode-map global-map)
7648 (define-key org-mode-map "|" 'self-insert-command))
7649 (easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu"
7650 '("OrgTbl"
7651 ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"]
7652 ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"]
7653 ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"]
7654 ["Next Row" org-return :active (org-at-table-p) :keys "RET"]
7655 "--"
7656 ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"]
7657 ["Copy Field from Above"
7658 org-table-copy-down :active (org-at-table-p) :keys "S-RET"]
7659 "--"
7660 ("Column"
7661 ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-<left>"]
7662 ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-<right>"]
7663 ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"]
7664 ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-<right>"])
7665 ("Row"
7666 ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-<up>"]
7667 ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-<down>"]
7668 ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-<up>"]
7669 ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-<down>"]
7670 "--"
7671 ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"])
7672 ("Rectangle"
7673 ["Copy Rectangle" org-copy-special :active (org-at-table-p) :keys "C-c M-w"]
7674 ["Cut Rectangle" org-cut-special :active (org-at-table-p) :keys "C-c C-w"]
7675 ["Paste Rectangle" org-paste-special :active (org-at-table-p) :keys "C-c C-y"]
7676 ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p) :keys "C-c C-q"])
7677 "--"
7678 ["Eval Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="]
7679 ["Eval Formula Down " (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
7680 ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"]
7681 ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"]
7682 ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"]
7683 ["Sum Column/Rectangle" org-table-sum
7684 :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"]
7685 ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"]
7686 ["Debug Formulas"
7687 (setq org-table-formula-debug (not org-table-formula-debug))
7688 :style toggle :selected org-table-formula-debug]
7689 ))
7690 t)
7072 7691
7073(defun orgtbl-tab () 7692(defun orgtbl-tab ()
7074 "Justification and field motion for `orgtbl-mode'." 7693 "Justification and field motion for `orgtbl-mode'."
@@ -7108,13 +7727,13 @@ reduced column width."
7108 (interactive "p") 7727 (interactive "p")
7109 (if (and (org-at-table-p) 7728 (if (and (org-at-table-p)
7110 (eq N 1) 7729 (eq N 1)
7730 (string-match "|" (buffer-substring (point-at-bol) (point)))
7111 (looking-at ".*?|")) 7731 (looking-at ".*?|"))
7112 (let ((pos (point))) 7732 (let ((pos (point)))
7113 (backward-delete-char N) 7733 (backward-delete-char N)
7114 (skip-chars-forward "^|") 7734 (skip-chars-forward "^|")
7115 (insert " ") 7735 (insert " ")
7116 (goto-char (1- pos))) 7736 (goto-char (1- pos)))
7117 (message "%s" last-input-event) (sit-for 1)
7118 (delete-backward-char N))) 7737 (delete-backward-char N)))
7119 7738
7120(defun orgtbl-delete-char (N) 7739(defun orgtbl-delete-char (N)
@@ -7125,6 +7744,8 @@ will still be marked for re-alignment, because a narrow field may lead to
7125a reduced column width." 7744a reduced column width."
7126 (interactive "p") 7745 (interactive "p")
7127 (if (and (org-at-table-p) 7746 (if (and (org-at-table-p)
7747 (not (bolp))
7748 (not (= (char-after) ?|))
7128 (eq N 1)) 7749 (eq N 1))
7129 (if (looking-at ".*?|") 7750 (if (looking-at ".*?|")
7130 (let ((pos (point))) 7751 (let ((pos (point)))
@@ -7134,41 +7755,6 @@ a reduced column width."
7134 (goto-char pos))) 7755 (goto-char pos)))
7135 (delete-char N))) 7756 (delete-char N)))
7136 7757
7137(easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu"
7138 '("Tbl"
7139 ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"]
7140 ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"]
7141 ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"]
7142 ["Next Row" org-return :active (org-at-table-p) :keys "RET"]
7143 "--"
7144 ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"]
7145 ["Copy Field from Above"
7146 org-table-copy-down :active (org-at-table-p) :keys "S-RET"]
7147 "--"
7148 ("Column"
7149 ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-<left>"]
7150 ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-<right>"]
7151 ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"]
7152 ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-<right>"])
7153 ("Row"
7154 ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-<up>"]
7155 ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-<down>"]
7156 ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-<up>"]
7157 ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-<down>"]
7158 "--"
7159 ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"])
7160 ("Rectangle"
7161 ["Copy Rectangle" org-copy-special :active (org-at-table-p) :keys "C-c M-w"]
7162 ["Cut Rectangle" org-cut-special :active (org-at-table-p) :keys "C-c C-w"]
7163 ["Paste Rectangle" org-paste-special :active (org-at-table-p) :keys "C-c C-y"]
7164 ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p) :keys "C-c C-q"])
7165 "--"
7166 ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"]
7167 ["Sum Column/Rectangle" org-table-sum
7168 :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"]
7169 ["Eval Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="]
7170 ))
7171
7172;;; Exporting 7758;;; Exporting
7173 7759
7174(defconst org-level-max 20) 7760(defconst org-level-max 20)
@@ -7503,7 +8089,7 @@ Entries can be like (\"ent\"), in which case \"\\ent\" will be translated to
7503In that case, \"\\ent\" will be translated to \"&other;\". 8089In that case, \"\\ent\" will be translated to \"&other;\".
7504The list contains HTML entities for Latin-1, Greek and other symbols. 8090The list contains HTML entities for Latin-1, Greek and other symbols.
7505It is supplemented by a number of commonly used TeX macros with appropriate 8091It is supplemented by a number of commonly used TeX macros with appropriate
7506translations.") 8092translations. There is currently no way for users to extend this.")
7507 8093
7508(defvar org-last-level nil) ; dynamically scoped variable 8094(defvar org-last-level nil) ; dynamically scoped variable
7509 8095
@@ -7676,7 +8262,7 @@ and all options lines."
7676 (let* ((filename (concat (file-name-sans-extension (buffer-file-name)) 8262 (let* ((filename (concat (file-name-sans-extension (buffer-file-name))
7677 ".txt")) 8263 ".txt"))
7678 (buffer (find-file-noselect filename)) 8264 (buffer (find-file-noselect filename))
7679 (ore (concat 8265 (ore (concat
7680 (org-make-options-regexp 8266 (org-make-options-regexp
7681 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" 8267 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO"
7682 "STARTUP" "ARCHIVE" 8268 "STARTUP" "ARCHIVE"
@@ -7908,7 +8494,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
7908 ;; This is a headline 8494 ;; This is a headline
7909 (progn 8495 (progn
7910 (setq level (- (match-end 1) (match-beginning 1)) 8496 (setq level (- (match-end 1) (match-beginning 1))
7911 txt (save-match-data 8497 txt (save-match-data
7912 (org-html-expand 8498 (org-html-expand
7913 (match-string 3 line))) 8499 (match-string 3 line)))
7914 todo 8500 todo
@@ -8413,10 +8999,10 @@ When LEVEL is non-nil, increase section numbers on that level."
8413 8999
8414;; - Bindings in Org-mode map are currently 9000;; - Bindings in Org-mode map are currently
8415;; 0123456789abcdefghijklmnopqrstuvwxyz!?@#$%^&-+*/=()_{}[]:;"|,.<>~`'\t the alphabet 9001;; 0123456789abcdefghijklmnopqrstuvwxyz!?@#$%^&-+*/=()_{}[]:;"|,.<>~`'\t the alphabet
8416;; abcd fgh j lmnopqrstuvwxyz ? # -+ /= [] ; |,.<> \t necessary bindings 9002;; abcd fgh j lmnopqrstuvwxyz ? #$ -+*/= [] ; |,.<>~ \t necessary bindings
8417;; e (?) useful from outline-mode 9003;; e (?) useful from outline-mode
8418;; i k @ expendable from outline-mode 9004;; i k @ expendable from outline-mode
8419;; 0123456789 ! $%^& * ()_{} " ~`' free 9005;; 0123456789 ! %^& ()_{} " `' free
8420 9006
8421(define-key org-mode-map "\C-i" 'org-cycle) 9007(define-key org-mode-map "\C-i" 'org-cycle)
8422(define-key org-mode-map [(meta tab)] 'org-complete) 9008(define-key org-mode-map [(meta tab)] 'org-complete)
@@ -8476,7 +9062,9 @@ When LEVEL is non-nil, increase section numbers on that level."
8476(define-key org-mode-map "\C-c+" 'org-table-sum) 9062(define-key org-mode-map "\C-c+" 'org-table-sum)
8477(define-key org-mode-map "\C-c|" 'org-table-toggle-vline-visibility) 9063(define-key org-mode-map "\C-c|" 'org-table-toggle-vline-visibility)
8478(define-key org-mode-map "\C-c=" 'org-table-eval-formula) 9064(define-key org-mode-map "\C-c=" 'org-table-eval-formula)
8479(define-key org-mode-map "\C-c#" 'org-table-create-with-table.el) 9065(define-key org-mode-map "\C-c*" 'org-table-recalculate)
9066(define-key org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks)
9067(define-key org-mode-map "\C-c~" 'org-table-create-with-table.el)
8480(define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region) 9068(define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region)
8481(define-key org-mode-map "\C-c\C-xa" 'org-export-as-ascii) 9069(define-key org-mode-map "\C-c\C-xa" 'org-export-as-ascii)
8482(define-key org-mode-map "\C-c\C-x\C-a" 'org-export-as-ascii) 9070(define-key org-mode-map "\C-c\C-x\C-a" 'org-export-as-ascii)
@@ -8489,12 +9077,7 @@ When LEVEL is non-nil, increase section numbers on that level."
8489(define-key org-mode-map "\C-c\C-xh" 'org-export-as-html) 9077(define-key org-mode-map "\C-c\C-xh" 'org-export-as-html)
8490(define-key org-mode-map "\C-c\C-x\C-h" 'org-export-as-html-and-open) 9078(define-key org-mode-map "\C-c\C-x\C-h" 'org-export-as-html-and-open)
8491 9079
8492(defsubst org-table-p () 9080(defsubst org-table-p () (org-at-table-p))
8493 (if (and (eq major-mode 'org-mode) font-lock-mode)
8494 (eq (get-text-property (point) 'face) 'org-table)
8495 ;; (save-match-data (org-at-table-p)))) ; FIXME: OK to not use this?
8496 (org-at-table-p)))
8497
8498 9081
8499(defun org-self-insert-command (N) 9082(defun org-self-insert-command (N)
8500 "Like `self-insert-command', use overwrite-mode for whitespace in tables. 9083 "Like `self-insert-command', use overwrite-mode for whitespace in tables.
@@ -8525,7 +9108,8 @@ reduced column width."
8525 (interactive "p") 9108 (interactive "p")
8526 (if (and (org-table-p) 9109 (if (and (org-table-p)
8527 (eq N 1) 9110 (eq N 1)
8528 (looking-at ".*?|")) 9111 (string-match "|" (buffer-substring (point-at-bol) (point)))
9112 (looking-at ".*?|"))
8529 (let ((pos (point))) 9113 (let ((pos (point)))
8530 (backward-delete-char N) 9114 (backward-delete-char N)
8531 (skip-chars-forward "^|") 9115 (skip-chars-forward "^|")
@@ -8541,6 +9125,8 @@ will still be marked for re-alignment, because a narrow field may lead to
8541a reduced column width." 9125a reduced column width."
8542 (interactive "p") 9126 (interactive "p")
8543 (if (and (org-table-p) 9127 (if (and (org-table-p)
9128 (not (bolp))
9129 (not (= (char-after) ?|))
8544 (eq N 1)) 9130 (eq N 1))
8545 (if (looking-at ".*?|") 9131 (if (looking-at ".*?|")
8546 (let ((pos (point))) 9132 (let ((pos (point)))
@@ -8655,16 +9241,14 @@ a reduced column width."
8655(defun org-copy-special () 9241(defun org-copy-special ()
8656 "Call either `org-table-copy' or `org-copy-subtree'." 9242 "Call either `org-table-copy' or `org-copy-subtree'."
8657 (interactive) 9243 (interactive)
8658 (if (org-at-table-p) 9244 (call-interactively
8659 (org-table-copy-region) 9245 (if (org-at-table-p) 'org-table-copy-region 'org-copy-subtree)))
8660 (org-copy-subtree)))
8661 9246
8662(defun org-cut-special () 9247(defun org-cut-special ()
8663 "Call either `org-table-copy' or `org-cut-subtree'." 9248 "Call either `org-table-copy' or `org-cut-subtree'."
8664 (interactive) 9249 (interactive)
8665 (if (org-at-table-p) 9250 (call-interactively
8666 (org-table-cut-region) 9251 (if (org-at-table-p) 'org-table-cut-region 'org-cut-subtree)))
8667 (org-cut-subtree)))
8668 9252
8669(defun org-paste-special (arg) 9253(defun org-paste-special (arg)
8670 "Call either `org-table-paste-rectangle' or `org-paste-subtree'." 9254 "Call either `org-table-paste-rectangle' or `org-paste-subtree'."
@@ -8674,23 +9258,37 @@ a reduced column width."
8674 (org-paste-subtree arg))) 9258 (org-paste-subtree arg)))
8675 9259
8676(defun org-ctrl-c-ctrl-c (&optional arg) 9260(defun org-ctrl-c-ctrl-c (&optional arg)
8677 "Call realign table, or recognize a table.el table. 9261 "Call realign table, or recognize a table.el table, or update keywords.
8678When the cursor is inside a table created by the table.el package, 9262When the cursor is inside a table created by the table.el package,
8679activate that table. Otherwise, if the cursor is at a normal table 9263activate that table. Otherwise, if the cursor is at a normal table
8680created with org.el, re-align that table. This command works even if 9264created with org.el, re-align that table. This command works even if
8681the automatic table editor has been turned off." 9265the automatic table editor has been turned off.
9266If the cursor is in one of the special #+KEYWORD lines, this triggers
9267scanning the buffer for these lines and updating the information."
8682 (interactive "P") 9268 (interactive "P")
8683 (let ((org-enable-table-editor t)) 9269 (let ((org-enable-table-editor t))
8684 (cond 9270 (cond
8685 ((org-at-table.el-p) 9271 ((org-at-table.el-p)
8686 (require 'table) 9272 (require 'table)
8687 (beginning-of-line 1) 9273 (beginning-of-line 1)
8688 (re-search-forward "|" (save-excursion (end-of-line 2) (point))) ;FIXME: line-end-position? 9274 (re-search-forward "|" (save-excursion (end-of-line 2) (point)))
8689 (table-recognize-table)) 9275 (table-recognize-table))
8690 ((org-at-table-p) 9276 ((org-at-table-p)
9277 (org-table-maybe-eval-formula)
9278 (if arg
9279 (org-table-recalculate t)
9280 (org-table-maybe-recalculate-line))
8691 (org-table-align)) 9281 (org-table-align))
8692 ((save-excursion (beginning-of-line 1) (looking-at "#\\+[A-Z]+")) 9282 ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)"))
8693 (let ((org-inhibit-startup t)) (org-mode))) 9283 (cond
9284 ((equal (match-string 1) "TBLFM")
9285 ;; Recalculate the table before this line
9286 (save-excursion
9287 (beginning-of-line 1)
9288 (skip-chars-backward " \r\n\t")
9289 (if (org-at-table-p) (org-table-recalculate t))))
9290 (t
9291 (let ((org-inhibit-startup t)) (org-mode)))))
8694 ((org-region-active-p) 9292 ((org-region-active-p)
8695 (org-table-convert-region (region-beginning) (region-end) arg)) 9293 (org-table-convert-region (region-beginning) (region-end) arg))
8696 ((and (region-beginning) (region-end)) 9294 ((and (region-beginning) (region-end))
@@ -8718,18 +9316,59 @@ the automatic table editor has been turned off."
8718 9316
8719;;; Menu entries 9317;;; Menu entries
8720 9318
8721;; First, remove the outline menus. Org-mode does not neede these commands.
8722(if org-xemacs-p
8723 (add-hook 'org-mode-hook
8724 (lambda ()
8725 (delete-menu-item '("Headings"))
8726 (delete-menu-item '("Show"))
8727 (delete-menu-item '("Hide"))
8728 (set-menubar-dirty-flag)))
8729 (setq org-mode-map (delq (assoc 'menu-bar (cdr org-mode-map))
8730 org-mode-map)))
8731
8732;; Define the Org-mode menus 9319;; Define the Org-mode menus
9320(easy-menu-define org-tbl-menu org-mode-map "Tbl menu"
9321 '("Tbl"
9322 ["Align" org-ctrl-c-ctrl-c (org-at-table-p)]
9323 ["Next Field" org-cycle (org-at-table-p)]
9324 ["Previous Field" org-shifttab (org-at-table-p)]
9325 ["Next Row" org-return (org-at-table-p)]
9326 "--"
9327 ["Blank Field" org-table-blank-field (org-at-table-p)]
9328 ["Copy Field from Above" org-table-copy-down (org-at-table-p)]
9329 "--"
9330 ("Column"
9331 ["Move Column Left" org-metaleft (org-at-table-p)]
9332 ["Move Column Right" org-metaright (org-at-table-p)]
9333 ["Delete Column" org-shiftmetaleft (org-at-table-p)]
9334 ["Insert Column" org-shiftmetaright (org-at-table-p)])
9335 ("Row"
9336 ["Move Row Up" org-metaup (org-at-table-p)]
9337 ["Move Row Down" org-metadown (org-at-table-p)]
9338 ["Delete Row" org-shiftmetaup (org-at-table-p)]
9339 ["Insert Row" org-shiftmetadown (org-at-table-p)]
9340 "--"
9341 ["Insert Hline" org-table-insert-hline (org-at-table-p)])
9342 ("Rectangle"
9343 ["Copy Rectangle" org-copy-special (org-at-table-p)]
9344 ["Cut Rectangle" org-cut-special (org-at-table-p)]
9345 ["Paste Rectangle" org-paste-special (org-at-table-p)]
9346 ["Fill Rectangle" org-table-wrap-region (org-at-table-p)])
9347 "--"
9348 ("Calculate"
9349 ["Eval Formula" org-table-eval-formula (org-at-table-p)]
9350 ["Eval Formula Down" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
9351 ["Recalculate line" org-table-recalculate (org-at-table-p)]
9352 ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"]
9353 ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)]
9354 ["Sum Column/Rectangle" org-table-sum
9355 (or (org-at-table-p) (org-region-active-p))]
9356 ["Which Column?" org-table-current-column (org-at-table-p)])
9357 ["Debug Formulas"
9358 (setq org-table-formula-debug (not org-table-formula-debug))
9359 :style toggle :selected org-table-formula-debug]
9360 "--"
9361 ["Invisible Vlines" org-table-toggle-vline-visibility
9362 :style toggle :selected (org-in-invisibility-spec-p '(org-table))]
9363 "--"
9364 ["Create" org-table-create (and (not (org-at-table-p))
9365 org-enable-table-editor)]
9366 ["Convert Region" org-ctrl-c-ctrl-c (not (org-at-table-p 'any))]
9367 ["Import from File" org-table-import (not (org-at-table-p))]
9368 ["Export to File" org-table-export (org-at-table-p)]
9369 "--"
9370 ["Create/Convert from/to table.el" org-table-create-with-table.el t]))
9371
8733(easy-menu-define org-org-menu org-mode-map "Org menu" 9372(easy-menu-define org-org-menu org-mode-map "Org menu"
8734 '("Org" 9373 '("Org"
8735 ["Cycle Visibility" org-cycle (or (bobp) (outline-on-heading-p))] 9374 ["Cycle Visibility" org-cycle (or (bobp) (outline-on-heading-p))]
@@ -8794,49 +9433,6 @@ the automatic table editor has been turned off."
8794 ["Insert Link" org-insert-link t] 9433 ["Insert Link" org-insert-link t]
8795 ["Follow Link" org-open-at-point t]) 9434 ["Follow Link" org-open-at-point t])
8796 "--" 9435 "--"
8797 ("Table"
8798 ["Align" org-ctrl-c-ctrl-c (org-at-table-p)]
8799 ["Next Field" org-cycle (org-at-table-p)]
8800 ["Previous Field" org-shifttab (org-at-table-p)]
8801 ["Next Row" org-return (org-at-table-p)]
8802 "--"
8803 ["Blank Field" org-table-blank-field (org-at-table-p)]
8804 ["Copy Field from Above" org-table-copy-down (org-at-table-p)]
8805 "--"
8806 ("Column"
8807 ["Move Column Left" org-metaleft (org-at-table-p)]
8808 ["Move Column Right" org-metaright (org-at-table-p)]
8809 ["Delete Column" org-shiftmetaleft (org-at-table-p)]
8810 ["Insert Column" org-shiftmetaright (org-at-table-p)])
8811 ("Row"
8812 ["Move Row Up" org-metaup (org-at-table-p)]
8813 ["Move Row Down" org-metadown (org-at-table-p)]
8814 ["Delete Row" org-shiftmetaup (org-at-table-p)]
8815 ["Insert Row" org-shiftmetadown (org-at-table-p)]
8816 "--"
8817 ["Insert Hline" org-table-insert-hline (org-at-table-p)])
8818 ("Rectangle"
8819 ["Copy Rectangle" org-copy-special (org-at-table-p)]
8820 ["Cut Rectangle" org-cut-special (org-at-table-p)]
8821 ["Paste Rectangle" org-paste-special (org-at-table-p)]
8822 ["Fill Rectangle" org-table-wrap-region (org-at-table-p)])
8823 "--"
8824 ["Which Column?" org-table-current-column (org-at-table-p)]
8825 ["Sum Column/Rectangle" org-table-sum
8826 (or (org-at-table-p) (org-region-active-p))]
8827 ["Eval Formula" org-table-eval-formula (org-at-table-p)]
8828 "--"
8829 ["Invisible Vlines" org-table-toggle-vline-visibility
8830 :style toggle :selected (org-in-invisibility-spec-p '(org-table))]
8831 "--"
8832 ["Create" org-table-create (and (not (org-at-table-p))
8833 org-enable-table-editor)]
8834 ["Convert Region" org-ctrl-c-ctrl-c (not (org-at-table-p 'any))]
8835 ["Import from File" org-table-import (not (org-at-table-p))]
8836 ["Export to File" org-table-export (org-at-table-p)]
8837 "--"
8838 ["Create/Convert from/to table.el" org-table-create-with-table.el t])
8839 "--"
8840 ("Export" 9436 ("Export"
8841 ["ASCII" org-export-as-ascii t] 9437 ["ASCII" org-export-as-ascii t]
8842 ["Extract Visible Text" org-export-copy-visible t] 9438 ["Extract Visible Text" org-export-copy-visible t]
@@ -8865,10 +9461,10 @@ With optional NODE, go directly to that node."
8865 (Info-goto-node (format "(org)%s" (or node "")))) 9461 (Info-goto-node (format "(org)%s" (or node ""))))
8866 9462
8867(defun org-install-agenda-files-menu () 9463(defun org-install-agenda-files-menu ()
8868 (easy-menu-change 9464 (easy-menu-change
8869 '("Org") "File List for Agenda" 9465 '("Org") "File List for Agenda"
8870 (append 9466 (append
8871 (list 9467 (list
8872 ["Edit File List" (customize-variable 'org-agenda-files) t] 9468 ["Edit File List" (customize-variable 'org-agenda-files) t]
8873 ["Add Current File to List" org-add-file t] 9469 ["Add Current File to List" org-add-file t]
8874 ["Remove Current File from List" org-remove-file t] 9470 ["Remove Current File from List" org-remove-file t]
@@ -8983,7 +9579,7 @@ that can be added."
8983;; Functions needed for compatibility with old outline.el 9579;; Functions needed for compatibility with old outline.el
8984 9580
8985;; The following functions capture almost the entire compatibility code 9581;; The following functions capture almost the entire compatibility code
8986;; between the different versions of outline-mode. The only other place 9582;; between the different versions of outline-mode. The only other place
8987;; where this is important are the font-lock-keywords. Search for 9583;; where this is important are the font-lock-keywords. Search for
8988;; `org-noutline-p' to find it. 9584;; `org-noutline-p' to find it.
8989 9585
@@ -9048,7 +9644,7 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok too."
9048This function considers both visible and invisible heading lines. 9644This function considers both visible and invisible heading lines.
9049With argument, move up ARG levels." 9645With argument, move up ARG levels."
9050 (if org-noutline-p 9646 (if org-noutline-p
9051 (if (fboundp 'outline-up-heading-all) 9647 (if (fboundp 'outline-up-heading-all)
9052 (outline-up-heading-all arg) ; emacs 21 version of outline.el 9648 (outline-up-heading-all arg) ; emacs 21 version of outline.el
9053 (outline-up-heading arg t)) ; emacs 22 version of outline.el 9649 (outline-up-heading arg t)) ; emacs 22 version of outline.el
9054 (org-back-to-heading t) 9650 (org-back-to-heading t)
@@ -9104,8 +9700,8 @@ When ENTRY is non-nil, show the entire entry."
9104 9700
9105(defun org-show-subtree () 9701(defun org-show-subtree ()
9106 "Show everything after this heading at deeper levels." 9702 "Show everything after this heading at deeper levels."
9107 (outline-flag-region 9703 (outline-flag-region
9108 (point) 9704 (point)
9109 (save-excursion 9705 (save-excursion
9110 (outline-end-of-subtree) (outline-next-heading) (point)) 9706 (outline-end-of-subtree) (outline-next-heading) (point))
9111 (if org-noutline-p nil ?\n))) 9707 (if org-noutline-p nil ?\n)))
@@ -9116,7 +9712,7 @@ Show the heading too, if it is currently invisible."
9116 (interactive) 9712 (interactive)
9117 (save-excursion 9713 (save-excursion
9118 (org-back-to-heading t) 9714 (org-back-to-heading t)
9119 (outline-flag-region 9715 (outline-flag-region
9120 (1- (point)) 9716 (1- (point))
9121 (save-excursion 9717 (save-excursion
9122 (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) 9718 (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move)