Mercurial > emacs
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)))) |