comparison lisp/textmodes/org.el @ 63832:d367f23e6db1

(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.
author Carsten Dominik <dominik@science.uva.nl>
date Wed, 29 Jun 2005 07:01:26 +0000
parents fd4b70bc23a4
children 0b526dc24ccb bb71c6cf2009
comparison
equal deleted inserted replaced
63831:1962e8146bf4 63832:d367f23e6db1
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 ;;
12 ;; GNU Emacs is free software; you can redistribute it and/or modify 12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by 13 ;; it under the terms of the GNU General Public License as published by
78 ;; Org-mode, you can read the same text online as HTML. There is also an 78 ;; Org-mode, you can read the same text online as HTML. There is also an
79 ;; excellent reference card made by Philip Rooke. 79 ;; excellent reference card made by Philip Rooke.
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').
90 ;; - Compatibility problems with viper-mode fixed. 100 ;; - Compatibility problems with viper-mode fixed.
91 ;; - Improved html export of tables. 101 ;; - Improved html export of tables.
166 (require 'time-date) 176 (require 'time-date)
167 (require 'easymenu) 177 (require 'easymenu)
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)
175 (message "Org-mode version %s" org-version)) 185 (message "Org-mode version %s" org-version))
176 186
443 (save-restriction 453 (save-restriction
444 (widen) 454 (widen)
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)))
452 (setq cat (intern value))) 462 (setq cat (intern value)))
453 ((equal key "SEQ_TODO") 463 ((equal key "SEQ_TODO")
483 ;; Compute the regular expressions and other local variables 493 ;; Compute the regular expressions and other local variables
484 (setq org-todo-kwd-priority-p (equal org-todo-interpretation 'priority) 494 (setq org-todo-kwd-priority-p (equal org-todo-interpretation 'priority)
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
492 "\\|") "\\)\\>") 502 "\\|") "\\)\\>")
493 org-not-done-regexp 503 org-not-done-regexp
563 :group 'org-agenda 573 :group 'org-agenda
564 :type 'boolean) 574 :type 'boolean)
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.
568 When nil, cursor will remain in the current window." 578 When nil, cursor will remain in the current window."
569 :group 'org-agenda 579 :group 'org-agenda
570 :type 'boolean) 580 :type 'boolean)
571 581
572 (defcustom org-fit-agenda-window t 582 (defcustom org-fit-agenda-window t
573 "Non-nil means, change window size of agenda to fit content." 583 "Non-nil means, change window size of agenda to fit content."
599 (defcustom org-agenda-include-all-todo t 609 (defcustom org-agenda-include-all-todo t
600 "Non-nil means, the agenda will always contain all TODO entries. 610 "Non-nil means, the agenda will always contain all TODO entries.
601 When nil, date-less entries will only be shown if `org-agenda' is called 611 When nil, date-less entries will only be shown if `org-agenda' is called
602 with a prefix argument. 612 with a prefix argument.
603 When non-nil, the TODO entries will be listed at the top of the agenda, before 613 When non-nil, the TODO entries will be listed at the top of the agenda, before
604 the entries for specific days." 614 the entries for specific days."
605 :group 'org-agenda 615 :group 'org-agenda
606 :type 'boolean) 616 :type 'boolean)
607 617
608 (defcustom org-agenda-include-diary nil 618 (defcustom org-agenda-include-diary nil
609 "If non-nil, include in the agenda entries from the Emacs Calendar's diary." 619 "If non-nil, include in the agenda entries from the Emacs Calendar's diary."
644 priority. 654 priority.
645 655
646 Leaving out `category-keep' would mean that items will be sorted across 656 Leaving out `category-keep' would mean that items will be sorted across
647 categories by priority." 657 categories 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)
653 (const category-keep) 663 (const category-keep)
654 (const category-up) 664 (const category-up)
720 For deails about when the grid will be shown, and what it will look like, see 730 For deails about when the grid will be shown, and what it will look like, see
721 the variable `org-agenda-time-grid'." 731 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))
729 739
730 "The settings for time grid for agenda display. 740 "The settings for time grid for agenda display.
739 The second item is a string which will be places behing the grid time. 749 The second item is a string which will be places behing the grid time.
740 750
741 The third item is a list of integers, indicating the times that should have 751 The third item is a list of integers, indicating the times that should have
742 a grid line." 752 a 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)
748 (const :tag "Show grid in weekly agenda display" weekly) 758 (const :tag "Show grid in weekly agenda display" weekly)
749 (const :tag "Always show grid for today" today) 759 (const :tag "Always show grid for today" today)
833 :group 'org-structure 843 :group 'org-structure
834 :type 'boolean) 844 :type 'boolean)
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.
838 This string consists of two parts, separated by a double-colon. 848 This string consists of two parts, separated by a double-colon.
839 849
840 The first part is a file name - when omitted, archiving happens in the same 850 The first part is a file name - when omitted, archiving happens in the same
841 file. %s will be replaced by the current file name (without directory part). 851 file. %s will be replaced by the current file name (without directory part).
842 Archiving to a different file is useful to keep archived entries from 852 Archiving to a different file is useful to keep archived entries from
843 contributing to the Org-mode Agenda. 853 contributing to the Org-mode Agenda.
862 Archive in file ./basement (relative path), as level 3 trees 872 Archive in file ./basement (relative path), as level 3 trees
863 below the level 2 heading \"** Finished Tasks\". 873 below the level 2 heading \"** Finished Tasks\".
864 874
865 You may set this option on a per-file basis by adding to the buffer a 875 You may set this option on a per-file basis by adding to the buffer a
866 line like 876 line 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)
871 881
872 (defcustom org-archive-mark-done t 882 (defcustom org-archive-mark-done t
1199 In Org-mode tables, all lines before the first horizontal separator 1209 In Org-mode tables, all lines before the first horizontal separator
1200 line will be formatted with <th> tags." 1210 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.
1232 The list must contain alternating symbols (calc modes variables and values.
1233 Don't remove any of the default settings, just change the values. Org-mode
1234 relies 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.
1240 If the current field starts with an equal sign, it is assumed to be a formula
1241 which should be evaluated as described in the manual and in the documentation
1242 string of the command `org-table-eval-formula'. This feature requires the
1243 Emacs calc package.
1244 When this variable is nil, formula calculation is only available through
1245 the 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.
1252 A constant looks like `$c' or `$Grav' and will be replaced before evaluation
1253 by the value given in `org-table-formula-constants', or by a value obtained
1254 from 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.
1260 The car of each element is a name of a constant, without the `$' before it.
1261 The cdr is the value as a string. For example, if you'd like to use the
1262 speed of light in a formula, you would configure
1263
1264 (setq org-table-formula-constants '((\"c\" . \"299792458.\")))
1265
1266 and 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.
1274 Then all input fields will be converted to a number, and the result
1275 must also be a number. When nil, calc's full potential is available
1276 in 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
1210 "Non-nil means, TAB will automatically notice a table.el table. 1281 "Non-nil means, TAB will automatically notice a table.el table.
1211 When it sees such a table, it moves point into it and - if necessary - 1282 When it sees such a table, it moves point into it and - if necessary -
1430 "Non-nil means, popup buffer containing the exported html text. 1501 "Non-nil means, popup buffer containing the exported html text.
1431 Otherwise, the buffer will just be saved to a file and stay hidden." 1502 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"
1439 :group 'org) 1509 :group 'org)
1440 1510
1554 (((class color) (background dark)) (:foreground "chocolate1")) 1624 (((class color) (background dark)) (:foreground "chocolate1"))
1555 (t (:bold t :italic t))) 1625 (t (:bold t :italic t)))
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"))
1563 (t (:bold t))) 1642 (t (:bold t)))
1564 "Face for links." 1643 "Face for links."
1647 (defvar org-mode-map (copy-keymap outline-mode-map) 1726 (defvar org-mode-map (copy-keymap outline-mode-map)
1648 "Keymap for Org-mode.") 1727 "Keymap for Org-mode.")
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.
1655 (defvar org-table-may-need-update t 1735 (defvar org-table-may-need-update t
1656 "Indicates of a table might need an update. 1736 "Indicates of a table might need an update.
1657 This variable is set by `org-before-change-function'. `org-table-align' 1737 This variable is set by `org-before-change-function'. `org-table-align'
1658 sets it back to nil.") 1738 sets 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
1669 Org-mode develops organizational tasks around a NOTES file which 1748 Org-mode develops organizational tasks around a NOTES file which
1670 contains information about projects as plain text. Org-mode is 1749 contains information about projects as plain text. Org-mode is
1671 implemented on top of outline-mode, which is ideal to keep the content 1750 implemented on top of outline-mode, which is ideal to keep the content
1679 1758
1680 The following commands are available: 1759 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))
1687 (org-set-regexps-and-options) 1767 (org-set-regexps-and-options)
1688 (set (make-local-variable 'font-lock-unfontify-region-function) 1768 (set (make-local-variable 'font-lock-unfontify-region-function)
1691 (set (make-local-variable 'org-table-may-need-update) t) 1771 (set (make-local-variable 'org-table-may-need-update) t)
1692 (make-local-hook 'before-change-functions) ;; needed for XEmacs 1772 (make-local-hook 'before-change-functions) ;; needed for XEmacs
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]*["
1704 (if org-enable-table-editor "|" "") 1784 (if org-enable-table-editor "|" "")
1705 (if org-enable-fixed-width-editor ":" "") 1785 (if org-enable-fixed-width-editor ":" "")
1707 (set (make-local-variable 'fill-paragraph-function) 'org-fill-paragraph) 1787 (set (make-local-variable 'fill-paragraph-function) 'org-fill-paragraph)
1708 (if (and org-insert-mode-line-in-empty-file 1788 (if (and org-insert-mode-line-in-empty-file
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)
1715 (cond 1809 (cond
1716 ((eq org-startup-folded t) 1810 ((eq org-startup-folded t)
1723 "Re-align a table, pass through to fill-paragraph if no table." 1817 "Re-align a table, pass through to fill-paragraph if no table."
1724 (save-excursion 1818 (save-excursion
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)
1735 1832
1736 (require 'font-lock) 1833 (require 'font-lock)
1802 (list (concat "\\[#[A-Z]\\]") '(0 'org-warning t)) 1899 (list (concat "\\[#[A-Z]\\]") '(0 'org-warning t))
1803 (list (concat "\\<" org-deadline-string) '(0 'org-warning t)) 1900 (list (concat "\\<" org-deadline-string) '(0 'org-warning t))
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))
1815 (if org-fontify-done-headline 1911 (if org-fontify-done-headline
1816 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>") 1912 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>")
1817 '(1 'org-done t) '(2 'org-headline-done t)) 1913 '(1 'org-done t) '(2 'org-headline-done t))
1818 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>") 1914 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>")
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)
1832 nil t))) 1931 nil t)))
1833 '(("^\\(\\(\\*+\\)[^\r\n]*\\)[\n\r]" 1932 '(("^\\(\\(\\*+\\)[^\r\n]*\\)[\n\r]"
1837 nil t)))) 1936 nil t))))
1838 org-font-lock-extra-keywords)) 1937 org-font-lock-extra-keywords))
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)
1846 (let* ((buffer-undo-list t) 1945 (let* ((buffer-undo-list t)
1847 (inhibit-read-only t) (inhibit-point-motion-hooks t) 1946 (inhibit-read-only t) (inhibit-point-motion-hooks t)
1868 2. CHILDREN: The main headline and the direct children are shown. From 1967 2. CHILDREN: The main headline and the direct children are shown. From
1869 this state, you can move to one of the children and 1968 this state, you can move to one of the children and
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
1878 `org-cycle-emulate-tab' for details. 1978 `org-cycle-emulate-tab' for details.
1879 1979
1935 2035
1936 ((integerp arg) 2036 ((integerp arg)
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))
1944 ;; At a heading: rotate between three different views 2045 ;; At a heading: rotate between three different views
1945 (org-back-to-heading) 2046 (org-back-to-heading)
2271 "Call FUN for every heading between BEG and END." 2372 "Call FUN for every heading between BEG and END."
2272 (let ((org-ignore-region t)) 2373 (let ((org-ignore-region t))
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))
2281 (while (and (progn 2380 (while (and (progn
2282 (outline-next-heading) 2381 (outline-next-heading)
2556 (or (bolp) (insert "\n")) 2655 (or (bolp) (insert "\n"))
2557 (insert "\n" heading "\n") 2656 (insert "\n" heading "\n")
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")
2565 (beginning-of-line 0)) 2664 (beginning-of-line 0))
2566 (goto-char (point-max)) (insert "\n"))) 2665 (goto-char (point-max)) (insert "\n")))
2603 (interactive "P") 2702 (interactive "P")
2604 (catch 'exit 2703 (catch 'exit
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 "#+"))
2614 (pattern (buffer-substring-no-properties beg end)) 2714 (pattern (buffer-substring-no-properties beg end))
2615 (completion-ignore-case opt) 2715 (completion-ignore-case opt)
2616 (type nil) 2716 (type nil)
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)
2630 (mapcar 'list org-todo-keywords)) 2733 (mapcar 'list org-todo-keywords))
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)
2638 (message "Can't find completion for \"%s\"" pattern) 2741 (message "Can't find completion for \"%s\"" pattern)
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*")
2646 (delete-window (get-buffer-window "*Completions*"))) 2749 (delete-window (get-buffer-window "*Completions*")))
2647 (if (and (eq type :todo) 2750 (if (and (eq type :todo)
2874 (defun org-get-priority (s) 2977 (defun org-get-priority (s)
2875 "Find priority cookie and return priority." 2978 "Find priority cookie and return priority."
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)
2885 2988
2886 (defun org-time-stamp (arg) 2989 (defun org-time-stamp (arg)
2908 (insert (format-time-string fmt time))) 3011 (insert (format-time-string fmt time)))
2909 ((org-at-timestamp-p) 3012 ((org-at-timestamp-p)
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"))
2917 (t 3020 (t
2918 (setq time (let ((this-command this-command)) 3021 (setq time (let ((this-command this-command))
2938 but this can be configured with the variables `parse-time-months' and 3041 but this can be configured with the variables `parse-time-months' and
2939 `parse-time-weekdays'. 3042 `parse-time-weekdays'.
2940 3043
2941 While prompting, a calendar is popped up - you can also select the 3044 While prompting, a calendar is popped up - you can also select the
2942 date with the mouse (button 1). The calendar shows a period of three 3045 date with the mouse (button 1). The calendar shows a period of three
2943 month. To scroll it to other months, use the keys `>' and `<'. 3046 month. To scroll it to other months, use the keys `>' and `<'.
2944 If you don't like the calendar, turn it off with 3047 If 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
2947 With optional argument TO-TIME, the date will immediately be converted 3050 With optional argument TO-TIME, the date will immediately be converted
2948 to an internal time. 3051 to an internal time.
2949 With an optional argument WITH-TIME, the prompt will suggest to also 3052 With an optional argument WITH-TIME, the prompt will suggest to also
2953 used to insert the time stamp into the buffer to include the time." 3056 used to insert the time stamp into the buffer to include the time."
2954 (let* ((default-time 3057 (let* ((default-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
2962 'encode-time 3065 'encode-time
2963 (mapcar (lambda(x) (or x 0)) ;; FIXME: Problem with timezone? 3066 (mapcar (lambda(x) (or x 0)) ;; FIXME: Problem with timezone?
3064 (when (calendar-cursor-to-date) 3167 (when (calendar-cursor-to-date)
3065 (let* ((date (calendar-cursor-to-date)) 3168 (let* ((date (calendar-cursor-to-date))
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.
3072 A deadline is considered due if it happens within `org-deadline-warning-days' 3175 A deadline is considered due if it happens within `org-deadline-warning-days'
3073 days from today's date. If the deadline appears in an entry marked DONE, 3176 days from today's date. If the deadline appears in an entry marked DONE,
3074 it is not shown. The prefix arg NDAYS can be used to test that many 3177 it is not shown. The prefix arg NDAYS can be used to test that many
3356 (easy-menu-add org-agenda-menu) 3459 (easy-menu-add org-agenda-menu)
3357 (if org-startup-truncated (setq truncate-lines t)) 3460 (if org-startup-truncated (setq truncate-lines t))
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)))
3368 (org-agenda-set-mode-name) 3471 (org-agenda-set-mode-name)
3369 (apply 3472 (apply
3376 (define-key org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo) 3479 (define-key org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo)
3377 (define-key org-agenda-mode-map "o" 'delete-other-windows) 3480 (define-key org-agenda-mode-map "o" 'delete-other-windows)
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
3385 (define-key org-agenda-mode-map ">" 'org-agenda-date-prompt) 3489 (define-key org-agenda-mode-map ">" 'org-agenda-date-prompt)
3386 (let ((l '(1 2 3 4 5 6 7 8 9 0))) 3490 (let ((l '(1 2 3 4 5 6 7 8 9 0)))
3387 (while l (define-key org-agenda-mode-map 3491 (while l (define-key org-agenda-mode-map
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)
3395 (define-key org-agenda-mode-map "x" 'org-agenda-exit) 3499 (define-key org-agenda-mode-map "x" 'org-agenda-exit)
3396 (define-key org-agenda-mode-map "P" 'org-agenda-show-priority) 3500 (define-key org-agenda-mode-map "P" 'org-agenda-show-priority)
3420 (define-key org-agenda-mode-map [(left)] 'org-agenda-earlier) 3524 (define-key org-agenda-mode-map [(left)] 'org-agenda-earlier)
3421 3525
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)
3429 3533
3430 (easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu" 3534 (easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu"
3432 ("Agenda Files") 3536 ("Agenda Files")
3433 "--" 3537 "--"
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]
3441 ("Reschedule" 3545 ("Reschedule"
3442 ["Reschedule +1 day" org-agenda-date-later t] 3546 ["Reschedule +1 day" org-agenda-date-later t]
3452 ["Rebuild buffer" org-agenda-redo t] 3556 ["Rebuild buffer" org-agenda-redo t]
3453 ["Goto Today" org-agenda-goto-today t] 3557 ["Goto Today" org-agenda-goto-today t]
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
3462 :style toggle :selected org-agenda-use-time-grid :active t] 3569 :style toggle :selected org-agenda-use-time-grid :active t]
3463 "--" 3570 "--"
3550 t)) ; always include today 3657 t)) ; always include today
3551 (today (time-to-days (current-time))) 3658 (today (time-to-days (current-time)))
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)))
3559 (if (not dopast) 3666 (if (not dopast)
3560 ;; Remove past dates from the list of dates. 3667 ;; Remove past dates from the list of 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)
3568 (org-agenda-mode) (setq buffer-read-only nil) 3675 (org-agenda-mode) (setq buffer-read-only nil)
3569 (while (setq d (pop day-numbers)) 3676 (while (setq d (pop day-numbers))
3574 (setq past nil) 3681 (setq past nil)
3575 (insert (make-string 79 ?-) "\n"))) 3682 (insert (make-string 79 ?-) "\n")))
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))
3583 (progn 3690 (progn
3584 (insert (calendar-day-name date) " " 3691 (insert (calendar-day-name date) " "
3630 (d (- nt n1))) 3737 (d (- nt n1)))
3631 (- sd (+ (if (< d 0) 7 0) d))))) 3738 (- sd (+ (if (< d 0) 7 0) d)))))
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)
3639 nd ndays) 3746 nd ndays)
3640 (while (> ndays 1) 3747 (while (> ndays 1)
3642 (setq ndays (1- ndays))) 3749 (setq ndays (1- ndays)))
3643 (setq day-numbers (nreverse day-numbers)) 3750 (setq day-numbers (nreverse day-numbers))
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)
3651 (org-agenda-mode) (setq buffer-read-only nil) 3758 (org-agenda-mode) (setq buffer-read-only nil)
3652 (set (make-local-variable 'starting-day) (car day-numbers)) 3759 (set (make-local-variable 'starting-day) (car day-numbers))
3660 (org-check-agenda-file file) 3767 (org-check-agenda-file file)
3661 (setq date (calendar-gregorian-from-absolute today) 3768 (setq date (calendar-gregorian-from-absolute today)
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))
3669 (insert (org-finalize-agenda-entries rtnall) "\n"))) 3776 (insert (org-finalize-agenda-entries rtnall) "\n")))
3670 (while (setq d (pop day-numbers)) 3777 (while (setq d (pop day-numbers))
3694 (extract-calendar-day date) 3801 (extract-calendar-day date)
3695 (calendar-month-name (extract-calendar-month date)) 3802 (calendar-month-name (extract-calendar-month date))
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
3708 (fit-window-to-buffer nil (/ (* (frame-height) 3) 4) 3815 (fit-window-to-buffer nil (/ (* (frame-height) 3) 4)
3709 (/ (frame-height) 2))) 3816 (/ (frame-height) 2)))
3782 (unless (boundp 'starting-day) 3889 (unless (boundp 'starting-day)
3783 (error "Not allowed")) 3890 (error "Not allowed"))
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."
3789 (interactive) 3896 (interactive)
3790 (unless (boundp 'starting-day) 3897 (unless (boundp 'starting-day)
3791 (error "Not allowed")) 3898 (error "Not allowed"))
3792 (setq org-agenda-ndays 3899 (setq org-agenda-ndays 7)
3793 (if (equal org-agenda-ndays 1) 7 1)) 3900 (org-agenda include-all-loc
3794 (org-agenda include-all-loc
3795 (or (get-text-property (point) 'day) 3901 (or (get-text-property (point) 'day)
3796 starting-day)) 3902 starting-day))
3797 (org-agenda-set-mode-name) 3903 (org-agenda-set-mode-name)
3798 (message "Switched to %s view" 3904 (message "Switched to week view"))
3799 (if (equal org-agenda-ndays 1) "day" "week"))) 3905
3906 (defun org-agenda-day-view ()
3907 "Switch to weekly view for agenda."
3908 (interactive)
3909 (unless (boundp 'starting-day)
3910 (error "Not allowed"))
3911 (setq org-agenda-ndays 1)
3912 (org-agenda include-all-loc
3913 (or (get-text-property (point) 'day)
3914 starting-day))
3915 (org-agenda-set-mode-name)
3916 (message "Switched to day view"))
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."
3803 (interactive "p") 3920 (interactive "p")
3804 (beginning-of-line 1) 3921 (beginning-of-line 1)
3878 3995
3879 (defun org-get-entries-from-diary (date) 3996 (defun org-get-entries-from-diary (date)
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))
3887 (save-excursion 4004 (save-excursion
3888 (save-window-excursion 4005 (save-window-excursion
3902 (setq entries (buffer-substring (point-min) (- (point-max) 1))))) 4019 (setq entries (buffer-substring (point-min) (- (point-max) 1)))))
3903 (set-buffer-modified-p nil) 4020 (set-buffer-modified-p nil)
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)
3916 x) 4033 x)
3917 entries))))) 4034 entries)))))
3948 (buffer-file-name)) 4065 (buffer-file-name))
3949 (add-text-properties 4066 (add-text-properties
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)))
3957 'org-agenda-diary-link t 4074 'org-agenda-diary-link t
3958 'org-marker (org-agenda-new-marker (point-at-bol))) 4075 'org-marker (org-agenda-new-marker (point-at-bol)))
3970 (defun org-add-file (&optional file) 4087 (defun org-add-file (&optional file)
3971 "Add current file to the list of files in variable `org-agenda-files'. 4088 "Add current file to the list of files in variable `org-agenda-files'.
3972 These are the files which are being checked for agenda entries. 4089 These are the files which are being checked for agenda entries.
3973 Optional argument FILE means, use this file instead of the current. 4090 Optional argument FILE means, use this file instead of the current.
3974 It is possible (but not recommended) to add this function to the 4091 It 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)
3979 (if (interactive-p) 4096 (if (interactive-p)
3980 (error "Buffer is not visiting a file") 4097 (error "Buffer is not visiting a file")
3985 (lambda (x) 4102 (lambda (x)
3986 (equal true-file (file-truename x))) 4103 (equal true-file (file-truename x)))
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))
3994 (customize-save-variable 'org-agenda-files org-agenda-files)) 4111 (customize-save-variable 'org-agenda-files org-agenda-files))
3995 (org-install-agenda-files-menu) 4112 (org-install-agenda-files-menu)
4002 Optional argument FILE means, use this file instead of the current." 4119 Optional argument FILE means, use this file instead of the current."
4003 (interactive) 4120 (interactive)
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))
4011 nil x)) 4128 nil x))
4012 org-agenda-files)))) 4129 org-agenda-files))))
4049 ;;;###autoload 4166 ;;;###autoload
4050 (defun org-diary (&rest args) 4167 (defun org-diary (&rest args)
4051 "Return diary information from org-files. 4168 "Return diary information from org-files.
4052 This function can be used in a \"sexp\" diary entry in the Emacs calendar. 4169 This function can be used in a \"sexp\" diary entry in the Emacs calendar.
4053 It accesses org files and extracts information from those files to be 4170 It accesses org files and extracts information from those files to be
4171
4054 listed in the diary. The function accepts arguments specifying what 4172 listed in the diary. The function accepts arguments specifying what
4055 items should be listed. The following arguments are allowed: 4173 items should be listed. The following arguments are allowed:
4056 4174
4057 :timestamp List the headlines of items containing a date stamp or 4175 :timestamp List the headlines of items containing a date stamp or
4058 date range matching the selected date. Deadlines will 4176 date range matching the selected date. Deadlines will
4087 4205
4088 &%%(org-diary :deadline :timestamp :scheduled) 4206 &%%(org-diary :deadline :timestamp :scheduled)
4089 4207
4090 The function expects the lisp variables `entry' and `date' to be provided 4208 The function expects the lisp variables `entry' and `date' to be provided
4091 by the caller, because this is how the calendar works. Don't use this 4209 by the caller, because this is how the calendar works. Don't use this
4092 function from a program - use `org-agenda-get-day-entries' instead." 4210 function 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)
4098 org-agenda-files)) 4216 org-agenda-files))
4099 file rtn results) 4217 file rtn results)
4129 (save-restriction 4247 (save-restriction
4130 (if org-respect-restriction 4248 (if org-respect-restriction
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) :-(
4138 (while (setq arg (pop args)) 4256 (while (setq arg (pop args))
4139 (cond 4257 (cond
4195 (goto-char (point-min)) 4313 (goto-char (point-min))
4196 (while (re-search-forward regexp nil t) 4314 (while (re-search-forward regexp nil t)
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
4204 (length 4322 (length
4205 (member (match-string 2) org-todo-keywords))) 4323 (member (match-string 2) org-todo-keywords)))
4267 'org-hd-marker hdmarker) props) 4385 'org-hd-marker hdmarker) props)
4268 txt) 4386 txt)
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
4276 'priority (+ 100 priority)) 4394 'priority (+ 100 priority))
4277 txt) 4395 txt)
4327 (setq txt (org-format-agenda-item 4445 (setq txt (org-format-agenda-item
4328 (format "In %3d d.: " diff) head)))) 4446 (format "In %3d d.: " diff) head))))
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))
4337 'face (cond ((<= diff 0) 'org-warning) 4455 'face (cond ((<= diff 0) 'org-warning)
4338 ((<= diff 5) 'org-scheduled-previously) 4456 ((<= diff 5) 'org-scheduled-previously)
4420 (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) 4538 (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t)
4421 (progn 4539 (progn
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))))
4429 (setq txt org-agenda-no-heading-message)) 4547 (setq txt org-agenda-no-heading-message))
4430 (add-text-properties 4548 (add-text-properties
4502 (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) 4620 (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts))
4503 (setq plain (string-match org-plain-time-of-day-regexp ts))) 4621 (setq plain (string-match org-plain-time-of-day-regexp ts)))
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.
4511 (if (and org-agenda-remove-times-when-in-prefix (or stamp plain) 4629 (if (and org-agenda-remove-times-when-in-prefix (or stamp plain)
4512 (string-match (concat (regexp-quote s0) " *") txt) 4630 (string-match (concat (regexp-quote s0) " *") txt)
4515 t)) 4633 t))
4516 (setq txt (replace-match "" nil nil txt)))) 4634 (setq txt (replace-match "" nil nil txt))))
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)
4524 ;; Prepare the variables needed in the eval of the compiled format 4642 ;; Prepare the variables needed in the eval of the compiled format
4525 (setq time (cond (s2 (concat s1 "-" s2)) 4643 (setq time (cond (s2 (concat s1 "-" s2))
4527 (t "")) 4645 (t ""))
4528 extra (or extra "") 4646 extra (or extra "")
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)
4536 'prefix-length (- (length rtn) (length txt)) 4654 'prefix-length (- (length rtn) (length txt))
4537 'time-of-day time-of-day 4655 'time-of-day time-of-day
4558 ;; don't show empty grid 4676 ;; don't show empty grid
4559 (throw 'exit list)) 4677 (throw 'exit list))
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)
4571 (append list new))))) 4689 (append list new)))))
4572 4690
4601 If found, return it as a military time number between 0 and 2400. 4719 If found, return it as a military time number between 0 and 2400.
4602 If not found, return nil. 4720 If not found, return nil.
4603 The optional STRING argument forces conversion into a 5 character wide string 4721 The optional STRING argument forces conversion into a 5 character wide string
4604 HH:MM." 4722 HH: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)
4610 (string-match 4728 (string-match
4611 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s)) 4729 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
4657 (priority-up (org-cmp-priority a b)) 4775 (priority-up (org-cmp-priority a b))
4658 (priority-down (if priority-up (- priority-up) nil)) 4776 (priority-down (if priority-up (- priority-up) nil))
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
4666 (defun org-agenda-show-priority () 4784 (defun org-agenda-show-priority ()
4667 "Show the priority of the current item. 4785 "Show the priority of the current item.
4672 (message "Priority is %d" (if pri pri -1000)))) 4790 (message "Priority is %d" (if pri pri -1000))))
4673 4791
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)))
4681 (switch-to-buffer-other-window buffer) 4799 (switch-to-buffer-other-window buffer)
4682 (widen) 4800 (widen)
4689 (and highlight (org-highlight (point-at-bol) (point-at-eol))))) 4807 (and highlight (org-highlight (point-at-bol) (point-at-eol)))))
4690 4808
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)))
4698 (switch-to-buffer buffer) 4816 (switch-to-buffer buffer)
4699 (delete-other-windows) 4817 (delete-other-windows)
4803 (progn 4921 (progn
4804 (replace-match new t t) 4922 (replace-match new t t)
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
4812 undone-face done-face)))) 4930 undone-face done-face))))
4813 (beginning-of-line 1)) 4931 (beginning-of-line 1))
4900 (defun org-agenda-diary-entry () 5018 (defun org-agenda-diary-entry ()
4901 "Make a diary entry, like the `i' command from the calendar. 5019 "Make a diary entry, like the `i' command from the calendar.
4902 All the standard commands work: block, weekly etc" 5020 All 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
4909 '((?d . insert-diary-entry) 5027 '((?d . insert-diary-entry)
4910 (?w . insert-weekly-diary-entry) 5028 (?w . insert-weekly-diary-entry)
4930 (get-text-property point 'day)))))) 5048 (get-text-property point 'day))))))
4931 (unwind-protect 5049 (unwind-protect
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)))))
4939 5057
4940 5058
4953 (displayed-year (extract-calendar-year date))) 5071 (displayed-year (extract-calendar-year date)))
4954 (unwind-protect 5072 (unwind-protect
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))))
4962 5080
4963 (defun org-agenda-phases-of-moon () 5081 (defun org-agenda-phases-of-moon ()
5003 (let ((day (get-text-property (point) 'day)) 5121 (let ((day (get-text-property (point) 'day))
5004 date s) 5122 date s)
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"
5012 "Julian: " (calendar-julian-date-string date) "\n" 5130 "Julian: " (calendar-julian-date-string date) "\n"
5013 "Astron. JD: " (calendar-astro-date-string date) 5131 "Astron. JD: " (calendar-astro-date-string date)
5116 article (match-string 3 path)) 5234 article (match-string 3 path))
5117 (org-follow-rmail-link folder article))) 5235 (org-follow-rmail-link folder article)))
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)))
5127 (shell-command cmd) 5245 (shell-command cmd)
5128 (error "Abort")))) 5246 (error "Abort"))))
5215 (setq message-number 5333 (setq message-number
5216 (save-restriction 5334 (save-restriction
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))))))
5224 (if message-number 5342 (if message-number
5225 (progn 5343 (progn
5302 (setq cpltxt (concat 5420 (setq cpltxt (concat
5303 "bbdb:" 5421 "bbdb:"
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
5311 (format-time-string 5429 (format-time-string
5312 (car org-time-stamp-formats) 5430 (car org-time-stamp-formats)
5328 (setq folder (abbreviate-file-name folder)) 5446 (setq folder (abbreviate-file-name folder))
5329 (if (string-match (concat "^" (regexp-quote vm-folder-directory)) 5447 (if (string-match (concat "^" (regexp-quote vm-folder-directory))
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)
5338 (let* ((msgnum (wl-summary-message-number)) 5456 (let* ((msgnum (wl-summary-message-number))
5339 (message-id (elmo-message-field wl-summary-buffer-elmo-folder 5457 (message-id (elmo-message-field wl-summary-buffer-elmo-folder
5341 (wl-message-entity (elmo-msgdb-overview-get-entity 5459 (wl-message-entity (elmo-msgdb-overview-get-entity
5342 msgnum (wl-summary-buffer-msgdb))) 5460 msgnum (wl-summary-buffer-msgdb)))
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)))))
5350 5468
5351 ((eq major-mode 'rmail-mode) 5469 ((eq major-mode 'rmail-mode)
5355 (let ((folder (buffer-file-name)) 5473 (let ((folder (buffer-file-name))
5356 (message-id (mail-fetch-field "message-id")) 5474 (message-id (mail-fetch-field "message-id"))
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
5364 ((eq major-mode 'gnus-group-mode) 5482 ((eq major-mode 'gnus-group-mode)
5365 (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus 5483 (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus
5409 (abbreviate-file-name (buffer-file-name)))) 5527 (abbreviate-file-name (buffer-file-name))))
5410 ;; Add the line number? 5528 ;; Add the line number?
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)))
5418 5536
5419 ((interactive-p) 5537 ((interactive-p)
5579 5697
5580 If the variable `org-adapt-indentation' is non-nil, the entire text is 5698 If the variable `org-adapt-indentation' is non-nil, the entire text is
5581 also indented so that it starts in the same column as the headline 5699 also 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
5584 See also the variable `org-reverse-note-order'." 5702 See 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)
5588 (file (if fastp org-default-notes-file (org-get-org-file))) 5706 (file (if fastp org-default-notes-file (org-get-org-file)))
5589 (visiting (find-buffer-visiting file)) 5707 (visiting (find-buffer-visiting file))
5685 5803
5686 (defconst org-table-line-regexp "^[ \t]*|" 5804 (defconst org-table-line-regexp "^[ \t]*|"
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]*\\+-[-+]"
5693 "Detects a table-type table hline.") 5815 "Detects a table-type table hline.")
5694 (defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)" 5816 (defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)"
5841 ;; FIXME: The following is currently not used. 5963 ;; FIXME: The following is currently not used.
5842 (defvar org-table-last-column-widths nil 5964 (defvar org-table-last-column-widths nil
5843 "List of max width of fields in each column. 5965 "List of max width of fields in each column.
5844 This is being used to correctly align a single field after TAB or RET.") 5966 This 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."
5849 (interactive) 5972 (interactive)
5850 (let* ( 5973 (let* (
5876 (buffer-substring-no-properties beg end) "\n")) 5999 (buffer-substring-no-properties beg end) "\n"))
5877 ;; Store the indentation of the first line 6000 ;; Store the indentation of the first line
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
5885 (lambda (l) 6013 (lambda (l)
5886 (org-split-string l " *| *")) 6014 (org-split-string l " *| *"))
5992 (setq org-table-may-need-update t)) 6120 (setq org-table-may-need-update t))
5993 (t ;; realign the current field, based on previous full realign 6121 (t ;; realign the current field, based on previous full realign
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
6009 (defun org-table-next-field () 6139 (defun org-table-next-field ()
6010 "Go to the next field in the current table. 6140 "Go to the next field in the current table.
6011 Before doing so, re-align the table if necessary." 6141 Before 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))
6016 (if (org-at-table-hline-p) 6148 (if (org-at-table-hline-p)
6017 (end-of-line 1)) 6149 (end-of-line 1))
6030 6162
6031 (defun org-table-previous-field () 6163 (defun org-table-previous-field ()
6032 "Go to the previous field in the table. 6164 "Go to the previous field in the table.
6033 Before doing so, re-align the table if necessary." 6165 Before 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))
6038 (if (org-at-table-hline-p) 6172 (if (org-at-table-hline-p)
6039 (end-of-line 1)) 6173 (end-of-line 1))
6046 6180
6047 (defun org-table-next-row () 6181 (defun org-table-next-row ()
6048 "Go to the next row (same column) in the current table. 6182 "Go to the next row (same column) in the current table.
6049 Before doing so, re-align the table if necessary." 6183 Before 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)
6054 (if (and org-table-automatic-realign 6190 (if (and org-table-automatic-realign
6055 org-table-may-need-update) 6191 org-table-may-need-update)
6069 "Copy a field down in the current column. 6205 "Copy a field down in the current column.
6070 If the field at the cursor is empty, copy into it the content of the nearest 6206 If the field at the cursor is empty, copy into it the content of the nearest
6071 non-empty field above. With argument N, use the Nth non-empty field. 6207 non-empty field above. With argument N, use the Nth non-empty field.
6072 If the current field is not empty, it is copied down to the next row, and 6208 If the current field is not empty, it is copied down to the next row, and
6073 the cursor is moved with it. Therefore, repeating this command causes the 6209 the cursor is moved with it. Therefore, repeating this command causes the
6074 column to be filled row-by-row. 6210 column to be filled row-by-row.
6075 If the variable `org-table-copy-increment' is non-nil and the field is an 6211 If the variable `org-table-copy-increment' is non-nil and the field is an
6076 integer, it will be incremented while copying." 6212 integer, it will be incremented while copying."
6077 (interactive "p") 6213 (interactive "p")
6078 (let* ((colpos (org-table-current-column)) 6214 (let* ((colpos (org-table-current-column))
6079 (field (org-table-get-field)) 6215 (field (org-table-get-field))
6080 (non-empty (string-match "[^ \t]" field)) 6216 (non-empty (string-match "[^ \t]" field))
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
6104 (defun org-table-check-inside-data-field () 6246 (defun org-table-check-inside-data-field ()
6105 "Is point inside a table data field? 6247 "Is point inside a table data field?
6117 "Blank the current table field or active region." 6259 "Blank the current table field or active region."
6118 (interactive) 6260 (interactive)
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)))
6129 (replace-match (concat "|" (make-string (1- len) ?\ ))) 6271 (replace-match (concat "|" (make-string (1- len) ?\ )))
6130 (goto-char (+ 2 pos)) 6272 (goto-char (+ 2 pos))
6134 "Return the value of the field in column N of current row. 6276 "Return the value of the field in column N of current row.
6135 N defaults to current field. 6277 N defaults to current field.
6136 If REPLACE is a string, replace field with this value. The return value 6278 If REPLACE is a string, replace field with this value. The return value
6137 is always the old value." 6279 is 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.
6151 When called interactively, column is also displayed in echo area." 6294 When called interactively, column is also displayed in echo area."
6152 (interactive) 6295 (interactive)
6160 cnt))) 6303 cnt)))
6161 6304
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.
6164 With optional argument ON-DELIM, stop with point before the left delimiter 6307 With optional argument ON-DELIM, stop with point before the left delimiter
6165 of the field. 6308 of the field.
6166 If there are less than N fields, just go to after the last delimiter. 6309 If there are less than N fields, just go to after the last delimiter.
6167 However, when FORCE is non-nil, create new columns if necessary." 6310 However, when FORCE is non-nil, create new columns if necessary."
6168 (let ((pos (point-at-eol))) 6311 (let ((pos (point-at-eol)))
6169 (beginning-of-line 1) 6312 (beginning-of-line 1)
6170 (when (> n 0) 6313 (when (> n 0)
6171 (while (and (> (setq n (1- n)) -1) 6314 (while (and (> (setq n (1- n)) -1)
6172 (or (search-forward "|" pos t) 6315 (or (search-forward "|" pos t)
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))))))
6183 6326
6184 (defun org-at-table-p (&optional table-type) 6327 (defun org-at-table-p (&optional table-type)
6253 (org-table-goto-column col t) 6396 (org-table-goto-column col t)
6254 (insert "| ")) 6397 (insert "| "))
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."
6263 (if (and (org-at-table-p) 6407 (if (and (org-at-table-p)
6264 (not (org-at-table-hline-p))) 6408 (not (org-at-table-hline-p)))
6298 (and (looking-at "|[^|\n]+|") 6442 (and (looking-at "|[^|\n]+|")
6299 (replace-match "|"))) 6443 (replace-match "|")))
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."
6308 (interactive) 6453 (interactive)
6309 (org-table-move-column nil)) 6454 (org-table-move-column nil))
6338 (and (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|") 6483 (and (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|")
6339 (replace-match "|\\2|\\1|"))) 6484 (replace-match "|\\2|\\1|")))
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
6355 (defun org-table-move-row (&optional up) 6501 (defun org-table-move-row (&optional up)
6356 "Move the current table line down. With arg UP, move it up." 6502 "Move the current table line down. With arg UP, move it up."
6378 "Insert a new row above the current line into the table. 6524 "Insert a new row above the current line into the table.
6379 With prefix ARG, insert below the current line." 6525 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)
6393 (and org-table-may-need-update (org-table-align)))) 6544 (and org-table-may-need-update (org-table-align))))
6394 6545
6429 (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) 6580 (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))
6430 (if (not (org-at-table-p)) (beginning-of-line 0)) 6581 (if (not (org-at-table-p)) (beginning-of-line 0))
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.
6441 A special clipboard is used which can only be accessed 6592 A special clipboard is used which can only be accessed
6442 with `org-table-paste-rectangle'" 6593 with `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))
6457 c02 (org-table-current-column)) 6605 c02 (org-table-current-column))
6458 (setq l1 (min l01 l02) l2 (max l01 l02) 6606 (setq l1 (min l01 l02) l2 (max l01 l02)
6468 (push (org-table-get-field ic1 rpl) cols) 6616 (push (org-table-get-field ic1 rpl) cols)
6469 (setq ic1 (1+ ic1))) 6617 (setq ic1 (1+ ic1)))
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.
6477 The upper right corner ends up in the current field. All involved fields 6626 The upper right corner ends up in the current field. All involved fields
6478 will be overwritten. If the rectangle does not fit into the present table, 6627 will be overwritten. If the rectangle does not fit into the present table,
6479 the table is enlarged as needed. The process ignores horizontal separator 6628 the table is enlarged as needed. The process ignores horizontal separator
6572 (org-table-check-inside-data-field) 6721 (org-table-check-inside-data-field)
6573 (if (org-region-active-p) 6722 (if (org-region-active-p)
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
6581 (if (< arg 1) 6730 (if (< arg 1)
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)
6589 (org-table-paste-rectangle)) 6738 (org-table-paste-rectangle))
6590 ;; No region, split the current field at point 6739 ;; No region, split the current field at point
6609 (org-table-align)))))) 6758 (org-table-align))))))
6610 6759
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.
6618 If WIDTH is non-nil, the string is wrapped to that width, however many lines 6768 If WIDTH is non-nil, the string is wrapped to that width, however many lines
6619 that costs. If there is a word longer than WIDTH, the text is actually 6769 that costs. If there is a word longer than WIDTH, the text is actually
6635 (while (> (length ll) lines) 6785 (while (> (length ll) lines)
6636 (setq w (1+ w)) 6786 (setq w (1+ w))
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."
6644 (let (lines line) 6794 (let (lines line)
6645 (while words 6795 (while words
6732 (beginning-of-line 1) 6882 (beginning-of-line 1)
6733 (if (looking-at org-table-line-regexp) 6883 (if (looking-at org-table-line-regexp)
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.
6739 The result will be displayed in the echo area, and will be available 6889 The result will be displayed in the echo area, and will be available
6740 as kill to be inserted with \\[yank]. 6890 as kill to be inserted with \\[yank].
6741 6891
6742 If there is an active region, it is interpreted as a rectangle and all 6892 If there is an active region, it is interpreted as a rectangle and all
6744 region and point is located in a table column, sum all numbers in that 6894 region and point is located in a table column, sum all numbers in that
6745 column. 6895 column.
6746 6896
6747 If at least one number looks like a time HH:MM or HH:MM:SS, all other 6897 If at least one number looks like a time HH:MM or HH:MM:SS, all other
6748 numbers are assumed to be times as well (in decimal hours) and the 6898 numbers are assumed to be times as well (in decimal hours) and the
6749 numbers are added as such." 6899 numbers are added as such.
6900
6901 If 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)
6781 (setq diff (* 3600 res) 6934 (setq diff (* 3600 res)
6782 h (floor (/ diff 3600)) diff (mod diff 3600) 6935 h (floor (/ diff 3600)) diff (mod diff 3600)
6783 m (floor (/ diff 60)) diff (mod diff 60) 6936 m (floor (/ diff 60)) diff (mod diff 60)
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)
6793 (if (string-match "^ *|? *" s) 6948 (if (string-match "^ *|? *" s)
6794 (setq s (replace-match "" nil nil s))) 6949 (setq s (replace-match "" nil nil s)))
6806 (if (boundp 'timecnt) (setq timecnt (1+ timecnt))) 6961 (if (boundp 'timecnt) (setq timecnt (1+ timecnt)))
6807 (* 1.0 (+ h (/ m 60.0) (/ s 3600.0))))) 6962 (* 1.0 (+ h (/ m 60.0) (/ s 3600.0)))))
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.
7022 ACTION can be `remove', `insert', `swap'. For `swap', two column numbers are
7023 expected, 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
6823 (save-excursion 7099 (save-excursion
6824 (let ((beg (progn (skip-chars-backward "^ \t\n") (point))) 7100 (let ((beg (progn (skip-chars-backward "^ \t\n") (point)))
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.
7148 Will 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.
7159 If in any row, the first field is not consistent with a mark,
7160 insert a new column for the makers.
7161 When there is an active region, change all the lines in the region,
7162 after prompting for the marking character.
7163 After each change, a message will be displayed indication the meaning
7164 of 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.
7228 When 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
6831 This function makes use of Dave Gillespie's calc package, arguably the most 7239 This function makes use of Dave Gillespie's calc package, in my view the
6832 exciting program ever written for GNU Emacs. So you need to have calc 7240 most exciting program ever written for GNU Emacs. So you need to have calc
6833 installed in order to use this function. 7241 installed in order to use this function.
6834 7242
6835 In a table, this command replaces the value in the current field with the 7243 In a table, this command replaces the value in the current field with the
6836 result of a formula. While nowhere near the computation options of a 7244 result of a formula. While nowhere near the computation options of a
6837 spreadsheet program, this is still very useful. Note that there is no 7245 spreadsheet program, this is still very useful. There is no automatic
6838 automatic updating of a calculated field, nor will the field remember the 7246 updating of a calculated field, but the table will remember the last
6839 formula. The command needs to be applied again after changing input 7247 formula for each column. The command needs to be applied again after
6840 fields. 7248 changing input fields.
6841 7249
6842 When called, the command first prompts for a formula, which is read in the 7250 When called, the command first prompts for a formula, which is read in the
6843 minibuffer. Previously entered formulae are available through the history 7251 minibuffer. Previously entered formulas are available through the history
6844 list, and the last used formula is the default, reachable by simply 7252 list, and the last used formula for each column is offered as a default.
6845 pressing RET. 7253 These stored formulas are adapted correctly when moving, inserting, or
7254 deleting columns with the corresponding commands.
6846 7255
6847 The formula can be any algebraic expression understood by the calc package. 7256 The formula can be any algebraic expression understood by the calc package.
6848 Before evaluation, variable substitution takes place: \"$\" is replaced by 7257 Before evaluation, variable substitution takes place: \"$\" is replaced by
6849 the field the cursor is currently in, and $1..$n reference the fields in 7258 the field the cursor is currently in, and $1..$n reference the fields in
6850 the current row. Values from a *different* row can *not* be referenced 7259 the current row. Values from a *different* row can *not* be referenced
6851 here, so the command supports only horizontal computing. The formula can 7260 here, so the command supports only horizontal computing. The formula can
6852 contain an optional printf format specifier after a semicolon, to reformat 7261 contain an optional printf format specifier after a semicolon, to reformat
6853 the result. 7262 the result.
6854 7263
6855 A few examples for formulae: 7264 A 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
6859 $;%.1f Reformat current cell to 1 digit after dec.point 7268 $;%.1f Reformat current cell to 1 digit after dec.point
6860 ($3-32)*5/9 degrees F -> C conversion 7269 ($3-32)*5/9 degrees F -> C conversion
6862 When called with a raw \\[universal-argument] prefix, the formula is applied to the current 7271 When called with a raw \\[universal-argument] prefix, the formula is applied to the current
6863 field, and to the same same column in all following rows, until reaching a 7272 field, and to the same same column in all following rows, until reaching a
6864 horizontal line or the end of the table. When the command is called with a 7273 horizontal line or the end of the table. When the command is called with a
6865 numeric prefix argument (like M-3 or C-7 or \\[universal-argument] 24), the formula is applied 7274 numeric prefix argument (like M-3 or C-7 or \\[universal-argument] 24), the formula is applied
6866 to the current row, and to the following n-1 rows (but not beyond a 7275 to the current row, and to the following n-1 rows (but not beyond a
6867 separator line)." 7276 separator line).
7277
7278 This function can also be called from Lisp programs and offers two additional
7279 Arguments: EQUATION can be the formula to apply. If this argument is given,
7280 the user will not be prompted. SUPPRESS-ALIGN is used to speed-up
7281 recursive calls by by-passing unnecessary aligns. SUPPRESS-CONST suppresses
7282 the interpretation of constants in the formula. SUPPRESS-STORE means the
7283 formula should not be stored, either because it is already stored, or because
7284 it 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
7354 Orig: %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)))
6902 (insert ev)) 7374 (insert ev))
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.
7463 Parameters 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
6910 ;; Define a minor mode which can be used in other modes in order to 7471 ;; Define a minor mode which can be used in other modes in order to
6911 ;; integrate the org-mode table editor. 7472 ;; integrate the org-mode table editor.
6960 "Unconditionally turn on `orgtbl-mode'." 7521 "Unconditionally turn on `orgtbl-mode'."
6961 (orgtbl-mode 1)) 7522 (orgtbl-mode 1))
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
6969 ;; by accident in org-mode. 7530 ;; by accident in org-mode.
6970 (message "Orgtbl-mode is not useful in org-mode, command ignored") 7531 (message "Orgtbl-mode is not useful in org-mode, command ignored")
6971 (setq orgtbl-mode 7532 (setq orgtbl-mode
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
6978 nil 'local) 7544 nil 'local)
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)
6986 (run-hooks 'orgtbl-mode-hook)) 7552 (run-hooks 'orgtbl-mode-hook))
6987 (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) 7553 (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp)
6992 ;; Install it as a minor mode. 7558 ;; Install it as a minor mode.
6993 (put 'orgtbl-mode :included t) 7559 (put 'orgtbl-mode :included t)
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) 7565 FUN 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.") 7566 command name. KEYS are keys that should be checked in for a command
7001 '(interactive "p") 7567 to 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'."
7075 (interactive) 7694 (interactive)
7076 (org-table-justify-field-maybe) 7695 (org-table-justify-field-maybe)
7106 still be marked for re-alignment, because a narrow field may lead to a 7725 still be marked for re-alignment, because a narrow field may lead to a
7107 reduced column width." 7726 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)
7121 "Like `delete-char', but insert whitespace at field end in tables. 7740 "Like `delete-char', but insert whitespace at field end in tables.
7122 When deleting characters, in tables this function will insert whitespace in 7741 When deleting characters, in tables this function will insert whitespace in
7123 front of the next \"|\" separator, to keep the table aligned. The table 7742 front of the next \"|\" separator, to keep the table aligned. The table
7124 will still be marked for re-alignment, because a narrow field may lead to 7743 will still be marked for re-alignment, because a narrow field may lead to
7125 a reduced column width." 7744 a 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)))
7131 (replace-match (concat 7752 (replace-match (concat
7132 (substring (match-string 0) 1 -1) 7753 (substring (match-string 0) 1 -1)
7133 " |")) 7754 " |"))
7134 (goto-char pos))) 7755 (goto-char pos)))
7135 (delete-char N))) 7756 (delete-char N)))
7136
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 7757
7172 ;;; Exporting 7758 ;;; Exporting
7173 7759
7174 (defconst org-level-max 20) 7760 (defconst org-level-max 20)
7175 7761
7501 Entries can be like (\"ent\"), in which case \"\\ent\" will be translated to 8087 Entries can be like (\"ent\"), in which case \"\\ent\" will be translated to
7502 \"&ent;\". An entry can also be a dotted pair like (\"ent\".\"&other;\"). 8088 \"&ent;\". An entry can also be a dotted pair like (\"ent\".\"&other;\").
7503 In that case, \"\\ent\" will be translated to \"&other;\". 8089 In that case, \"\\ent\" will be translated to \"&other;\".
7504 The list contains HTML entities for Latin-1, Greek and other symbols. 8090 The list contains HTML entities for Latin-1, Greek and other symbols.
7505 It is supplemented by a number of commonly used TeX macros with appropriate 8091 It is supplemented by a number of commonly used TeX macros with appropriate
7506 translations.") 8092 translations. 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
7510 (defun org-export-as-ascii (arg) 8096 (defun org-export-as-ascii (arg)
7511 "Export the outline as a pretty ASCII file. 8097 "Export the outline as a pretty ASCII file.
7674 and all options lines." 8260 and all options lines."
7675 (interactive) 8261 (interactive)
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"
7683 "TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE")) 8269 "TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))
7684 (if org-noutline-p "\\(\n\\|$\\)" ""))) 8270 (if org-noutline-p "\\(\n\\|$\\)" "")))
7906 (mapcar '(lambda (line) 8492 (mapcar '(lambda (line)
7907 (if (string-match org-todo-line-regexp line) 8493 (if (string-match org-todo-line-regexp line)
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
7915 (or (and (match-beginning 2) 8501 (or (and (match-beginning 2)
7916 (not (equal (match-string 2 line) 8502 (not (equal (match-string 2 line)
8411 8997
8412 ;;; Key bindings 8998 ;;; Key bindings
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)
8423 (define-key org-mode-map "\M-\C-i" 'org-complete) 9009 (define-key org-mode-map "\M-\C-i" 'org-complete)
8424 (define-key org-mode-map [(meta shift left)] 'org-shiftmetaleft) 9010 (define-key org-mode-map [(meta shift left)] 'org-shiftmetaleft)
8474 (define-key org-mode-map "\C-c?" 'org-table-current-column) 9060 (define-key org-mode-map "\C-c?" 'org-table-current-column)
8475 (define-key org-mode-map "\C-c " 'org-table-blank-field) 9061 (define-key org-mode-map "\C-c " 'org-table-blank-field)
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)
8483 (define-key org-mode-map "\C-c\C-xv" 'org-export-copy-visible) 9071 (define-key org-mode-map "\C-c\C-xv" 'org-export-copy-visible)
8484 (define-key org-mode-map "\C-c\C-x\C-v" 'org-export-copy-visible) 9072 (define-key org-mode-map "\C-c\C-x\C-v" 'org-export-copy-visible)
8487 (define-key org-mode-map "\C-c\C-xt" 'org-insert-export-options-template) 9075 (define-key org-mode-map "\C-c\C-xt" 'org-insert-export-options-template)
8488 (define-key org-mode-map "\C-c:" 'org-toggle-fixed-width-section) 9076 (define-key org-mode-map "\C-c:" 'org-toggle-fixed-width-section)
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.
8501 If the cursor is in a table looking at whitespace, the whitespace is 9084 If the cursor is in a table looking at whitespace, the whitespace is
8502 overwritten, and the table is not marked as requiring realignment." 9085 overwritten, and the table is not marked as requiring realignment."
8523 still be marked for re-alignment, because a narrow field may lead to a 9106 still be marked for re-alignment, because a narrow field may lead to a
8524 reduced column width." 9107 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 "^|")
8532 (insert " ") 9116 (insert " ")
8533 (goto-char (1- pos))) 9117 (goto-char (1- pos)))
8539 front of the next \"|\" separator, to keep the table aligned. The table 9123 front of the next \"|\" separator, to keep the table aligned. The table
8540 will still be marked for re-alignment, because a narrow field may lead to 9124 will still be marked for re-alignment, because a narrow field may lead to
8541 a reduced column width." 9125 a 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)))
8547 (replace-match (concat 9133 (replace-match (concat
8548 (substring (match-string 0) 1 -1) 9134 (substring (match-string 0) 1 -1)
8653 (t (org-priority-down)))) 9239 (t (org-priority-down))))
8654 9240
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'."
8671 (interactive "P") 9255 (interactive "P")
8672 (if (org-at-table-p) 9256 (if (org-at-table-p)
8673 (org-table-paste-rectangle) 9257 (org-table-paste-rectangle)
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.
8678 When the cursor is inside a table created by the table.el package, 9262 When the cursor is inside a table created by the table.el package,
8679 activate that table. Otherwise, if the cursor is at a normal table 9263 activate that table. Otherwise, if the cursor is at a normal table
8680 created with org.el, re-align that table. This command works even if 9264 created with org.el, re-align that table. This command works even if
8681 the automatic table editor has been turned off." 9265 the automatic table editor has been turned off.
9266 If the cursor is in one of the special #+KEYWORD lines, this triggers
9267 scanning 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))
8697 (if (y-or-n-p "Convert inactive region to table? ") 9295 (if (y-or-n-p "Convert inactive region to table? ")
8698 (org-table-convert-region (region-beginning) (region-end) arg) 9296 (org-table-convert-region (region-beginning) (region-end) arg)
8716 (org-table-wrap-region arg)) 9314 (org-table-wrap-region arg))
8717 (t (org-insert-heading)))) 9315 (t (org-insert-heading))))
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))]
8736 ["Sparse Tree" org-occur t] 9375 ["Sparse Tree" org-occur t]
8737 ["Show All" show-all t] 9376 ["Show All" show-all t]
8792 ("Hyperlinks" 9431 ("Hyperlinks"
8793 ["Store Link (Global)" org-store-link t] 9432 ["Store Link (Global)" org-store-link t]
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]
8843 ["HTML" org-export-as-html t] 9439 ["HTML" org-export-as-html t]
8844 ["HTML and Open" org-export-as-html-and-open t] 9440 ["HTML and Open" org-export-as-html-and-open t]
8863 (interactive) 9459 (interactive)
8864 (require 'info) 9460 (require 'info)
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]
8875 "--") 9471 "--")
8876 (mapcar 'org-file-menu-entry org-agenda-files)))) 9472 (mapcar 'org-file-menu-entry org-agenda-files))))
8981 "\\'")))) 9577 "\\'"))))
8982 9578
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
8990 ;; C-a should go to the beginning of a *visible* line, also in the 9586 ;; C-a should go to the beginning of a *visible* line, also in the
8991 ;; new outline.el. I guess this should be patched into Emacs? 9587 ;; new outline.el. I guess this should be patched into Emacs?
9046 (defun org-up-heading-all (arg) 9642 (defun org-up-heading-all (arg)
9047 "Move to the heading line of which the present line is a subheading. 9643 "Move to the heading line of which the present line is a subheading.
9048 This function considers both visible and invisible heading lines. 9644 This function considers both visible and invisible heading lines.
9049 With argument, move up ARG levels." 9645 With 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)
9055 (looking-at outline-regexp) 9651 (looking-at outline-regexp)
9056 (if (<= (- (match-end 0) (match-beginning 0)) arg) 9652 (if (<= (- (match-end 0) (match-beginning 0)) arg)
9102 flag 9698 flag
9103 (if flag ?\r ?\n)))))) 9699 (if flag ?\r ?\n))))))
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)))
9112 9708
9113 (defun org-show-entry () 9709 (defun org-show-entry ()
9114 "Show the body directly following this heading. 9710 "Show the body directly following this heading.
9115 Show the heading too, if it is currently invisible." 9711 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)
9123 (or (match-beginning 1) (point-max))) 9719 (or (match-beginning 1) (point-max)))
9124 (if org-noutline-p nil ?\n)))) 9720 (if org-noutline-p nil ?\n))))