Mercurial > emacs
comparison lisp/textmodes/org.el @ 63902:0b526dc24ccb
(org-agenda-start-on-weekday, org-calendar-to-agenda-key,
org-agenda-sorting-strategy, org-agenda-use-time-grid, org-archive-location,
org-allow-space-in-links, org-usenet-links-prefer-google,
org-enable-table-editor, org-export-default-language,
org-export-html-show-new-buffer, org-fill-paragraph, org-cycle, org-goto-ret,
org-goto-left, org-goto-right, org-goto-quit, org-occur, org-eval-in-calendar,
org-agenda-cleanup-fancy-diary, org-agenda-no-heading-message,
org-agenda-diary-entry, org-remember-help, org-table-convert-region,
org-at-table-p, org-table-move-row-down, org-table-move-row-up,
org-table-copy-region, org-table-toggle-vline-visibility,
org-table-get-stored-formulas, org-table-get-specials, org-recalc-commands,
org-table-eval-formula, org-table-formula-substitute-names, orgtbl-make-binding,
org-format-org-table-html, org-format-table-table-html,
org-format-table-table-html-using-table-generate-source, org-customize): Fix
typos in docstrings.
(org-level-2, org-at-timestamp-p, org-agenda-day-view, org-agenda-toggle-diary,
org-agenda-toggle-time-grid, org-back-to-heading): Doc fixes.
(org-agenda-toggle-time-grid, org-cmp-category, org-cmp-time,
org-agenda-change-all-lines, org-get-header): Improve argument/docstring
consistency.
(orgtbl-error): Fix error message.
author | Juanma Barranquero <lekktu@gmail.com> |
---|---|
date | Fri, 01 Jul 2005 14:38:23 +0000 |
parents | d367f23e6db1 |
children | dc2198941327 |
comparison
equal
deleted
inserted
replaced
63901:05e4043d377b | 63902:0b526dc24ccb |
---|---|
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 |
453 (save-restriction | 453 (save-restriction |
454 (widen) | 454 (widen) |
455 (goto-char (point-min)) | 455 (goto-char (point-min)) |
456 (while (re-search-forward re nil t) | 456 (while (re-search-forward re nil t) |
457 (setq key (match-string 1) value (match-string 2)) | 457 (setq key (match-string 1) value (match-string 2)) |
458 (cond | 458 (cond |
459 ((equal key "CATEGORY") | 459 ((equal key "CATEGORY") |
460 (if (string-match "[ \t]+$" value) | 460 (if (string-match "[ \t]+$" value) |
461 (setq value (replace-match "" t t value))) | 461 (setq value (replace-match "" t t value))) |
462 (setq cat (intern value))) | 462 (setq cat (intern value))) |
463 ((equal key "SEQ_TODO") | 463 ((equal key "SEQ_TODO") |
493 ;; Compute the regular expressions and other local variables | 493 ;; Compute the regular expressions and other local variables |
494 (setq org-todo-kwd-priority-p (equal org-todo-interpretation 'priority) | 494 (setq org-todo-kwd-priority-p (equal org-todo-interpretation 'priority) |
495 org-todo-kwd-max-priority (1- (length org-todo-keywords)) | 495 org-todo-kwd-max-priority (1- (length org-todo-keywords)) |
496 org-ds-keyword-length (+ 2 (max (length org-deadline-string) | 496 org-ds-keyword-length (+ 2 (max (length org-deadline-string) |
497 (length org-scheduled-string))) | 497 (length org-scheduled-string))) |
498 org-done-string | 498 org-done-string |
499 (nth (1- (length org-todo-keywords)) org-todo-keywords) | 499 (nth (1- (length org-todo-keywords)) org-todo-keywords) |
500 org-todo-regexp | 500 org-todo-regexp |
501 (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords | 501 (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords |
502 "\\|") "\\)\\>") | 502 "\\|") "\\)\\>") |
503 org-not-done-regexp | 503 org-not-done-regexp |
573 :group 'org-agenda | 573 :group 'org-agenda |
574 :type 'boolean) | 574 :type 'boolean) |
575 | 575 |
576 (defcustom org-select-agenda-window t | 576 (defcustom org-select-agenda-window t |
577 "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. |
578 When nil, cursor will remain in the current window." | 578 When nil, cursor will remain in the current window." |
579 :group 'org-agenda | 579 :group 'org-agenda |
580 :type 'boolean) | 580 :type 'boolean) |
581 | 581 |
582 (defcustom org-fit-agenda-window t | 582 (defcustom org-fit-agenda-window t |
583 "Non-nil means, change window size of agenda to fit content." | 583 "Non-nil means, change window size of agenda to fit content." |
592 | 592 |
593 ;; FIXME: First day of month works only for current month because it would | 593 ;; FIXME: First day of month works only for current month because it would |
594 ;; require a variable ndays treatment. | 594 ;; require a variable ndays treatment. |
595 (defcustom org-agenda-start-on-weekday 1 | 595 (defcustom org-agenda-start-on-weekday 1 |
596 "Non-nil means, start the overview always on the specified weekday. | 596 "Non-nil means, start the overview always on the specified weekday. |
597 0 Denotes Sunday, 1 denotes Monday etc. | 597 0 denotes Sunday, 1 denotes Monday etc. |
598 When nil, always start on the current day." | 598 When nil, always start on the current day." |
599 :group 'org-agenda | 599 :group 'org-agenda |
600 :type '(choice (const :tag "Today" nil) | 600 :type '(choice (const :tag "Today" nil) |
601 (const :tag "First day of month" t) | 601 (const :tag "First day of month" t) |
602 (number :tag "Weekday No."))) | 602 (number :tag "Weekday No."))) |
609 (defcustom org-agenda-include-all-todo t | 609 (defcustom org-agenda-include-all-todo t |
610 "Non-nil means, the agenda will always contain all TODO entries. | 610 "Non-nil means, the agenda will always contain all TODO entries. |
611 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 |
612 with a prefix argument. | 612 with a prefix argument. |
613 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 |
614 the entries for specific days." | 614 the entries for specific days." |
615 :group 'org-agenda | 615 :group 'org-agenda |
616 :type 'boolean) | 616 :type 'boolean) |
617 | 617 |
618 (defcustom org-agenda-include-diary nil | 618 (defcustom org-agenda-include-diary nil |
619 "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." |
621 :type 'boolean) | 621 :type 'boolean) |
622 | 622 |
623 (defcustom org-calendar-to-agenda-key [?c] | 623 (defcustom org-calendar-to-agenda-key [?c] |
624 "The key to be installed in `calendar-mode-map' for switching to the agenda. | 624 "The key to be installed in `calendar-mode-map' for switching to the agenda. |
625 The command `org-calendar-goto-agenda' will be bound to this key. The | 625 The command `org-calendar-goto-agenda' will be bound to this key. The |
626 default is the character `c' because then`c' can be used to switch back and | 626 default is the character `c' because then `c' can be used to switch back and |
627 force between agenda and calendar." | 627 forth between agenda and calendar." |
628 :group 'org-agenda | 628 :group 'org-agenda |
629 :type 'sexp) | 629 :type 'sexp) |
630 | 630 |
631 (defcustom org-agenda-sorting-strategy '(time-up category-keep priority-down) | 631 (defcustom org-agenda-sorting-strategy '(time-up category-keep priority-down) |
632 "Sorting structure for the agenda items of a single day. | 632 "Sorting structure for the agenda items of a single day. |
633 This is a list of symbols which will be used in sequence to determine | 633 This is a list of symbols which will be used in sequence to determine |
634 if an entry should be listed before another entry. The following | 634 if an entry should be listed before another entry. The following |
635 symbols are recognized. | 635 symbols are recognized: |
636 | 636 |
637 time-up Put entries with time-of-day indications first, early first | 637 time-up Put entries with time-of-day indications first, early first |
638 time-down Put entries with time-of-day indications first, late first | 638 time-down Put entries with time-of-day indications first, late first |
639 category-keep Keep the default order of categories, corresponding to the | 639 category-keep Keep the default order of categories, corresponding to the |
640 sequence in `org-agenda-files'. | 640 sequence in `org-agenda-files'. |
654 priority. | 654 priority. |
655 | 655 |
656 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 |
657 categories by priority." | 657 categories by priority." |
658 :group 'org-agenda | 658 :group 'org-agenda |
659 :type '(repeat | 659 :type '(repeat |
660 (choice | 660 (choice |
661 (const time-up) | 661 (const time-up) |
662 (const time-down) | 662 (const time-down) |
663 (const category-keep) | 663 (const category-keep) |
664 (const category-up) | 664 (const category-up) |
723 of `org-agenda-prefix-format' or `org-timeline-prefix-format'.") | 723 of `org-agenda-prefix-format' or `org-timeline-prefix-format'.") |
724 | 724 |
725 (defcustom org-agenda-use-time-grid t | 725 (defcustom org-agenda-use-time-grid t |
726 "Non-nil means, show a time grid in the agenda schedule. | 726 "Non-nil means, show a time grid in the agenda schedule. |
727 A time grid is a set of lines for specific times (like every two hours between | 727 A time grid is a set of lines for specific times (like every two hours between |
728 8:00 and 20:00. The items scheduled for a day at specific times are | 728 8:00 and 20:00). The items scheduled for a day at specific times are |
729 sorted in between these lines. | 729 sorted in between these lines. |
730 For deails about when the grid will be shown, and what it will look like, see | 730 For details about when the grid will be shown, and what it will look like, see |
731 the variable `org-agenda-time-grid'." | 731 the variable `org-agenda-time-grid'." |
732 :group 'org-agenda | 732 :group 'org-agenda |
733 :type 'boolean) | 733 :type 'boolean) |
734 | 734 |
735 (defcustom org-agenda-time-grid | 735 (defcustom org-agenda-time-grid |
736 '((daily today require-timed) | 736 '((daily today require-timed) |
737 "----------------" | 737 "----------------" |
738 (800 1000 1200 1400 1600 1800 2000)) | 738 (800 1000 1200 1400 1600 1800 2000)) |
739 | 739 |
740 "The settings for time grid for agenda display. | 740 "The settings for time grid for agenda display. |
749 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. |
750 | 750 |
751 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 |
752 a grid line." | 752 a grid line." |
753 :group 'org-agenda | 753 :group 'org-agenda |
754 :type | 754 :type |
755 '(list | 755 '(list |
756 (set :greedy t :tag "Grid Display Options" | 756 (set :greedy t :tag "Grid Display Options" |
757 (const :tag "Show grid in single day agenda display" daily) | 757 (const :tag "Show grid in single day agenda display" daily) |
758 (const :tag "Show grid in weekly agenda display" weekly) | 758 (const :tag "Show grid in weekly agenda display" weekly) |
759 (const :tag "Always show grid for today" today) | 759 (const :tag "Always show grid for today" today) |
843 :group 'org-structure | 843 :group 'org-structure |
844 :type 'boolean) | 844 :type 'boolean) |
845 | 845 |
846 (defcustom org-archive-location "%s_archive::" | 846 (defcustom org-archive-location "%s_archive::" |
847 "The location where subtrees should be archived. | 847 "The location where subtrees should be archived. |
848 This string consists of two parts, separated by a double-colon. | 848 This string consists of two parts, separated by a double-colon. |
849 | 849 |
850 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 |
851 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). |
852 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 |
853 contributing to the Org-mode Agenda. | 853 contributing to the Org-mode Agenda. |
854 | 854 |
855 The part after the double colon is a headline. The archived entries will be | 855 The part after the double colon is a headline. The archived entries will be |
856 filed under that headline. When omitted, the subtrees are simply filed away | 856 filed under that headline. When omitted, the subtrees are simply filed away |
872 Archive in file ./basement (relative path), as level 3 trees | 872 Archive in file ./basement (relative path), as level 3 trees |
873 below the level 2 heading \"** Finished Tasks\". | 873 below the level 2 heading \"** Finished Tasks\". |
874 | 874 |
875 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 |
876 line like | 876 line like |
877 | 877 |
878 #+ARCHIVE: basement::** Finished Tasks" | 878 #+ARCHIVE: basement::** Finished Tasks" |
879 :group 'org-structure | 879 :group 'org-structure |
880 :type 'string) | 880 :type 'string) |
881 | 881 |
882 (defcustom org-archive-mark-done t | 882 (defcustom org-archive-mark-done t |
913 (defcustom org-allow-space-in-links t | 913 (defcustom org-allow-space-in-links t |
914 "Non-nil means, file names in links may contain space characters. | 914 "Non-nil means, file names in links may contain space characters. |
915 When nil, it becomes possible to put several links into a line. | 915 When nil, it becomes possible to put several links into a line. |
916 Note that in tables, a link never extends accross fields, so in a table | 916 Note that in tables, a link never extends accross fields, so in a table |
917 it is always possible to put several links into a line. | 917 it is always possible to put several links into a line. |
918 Changing this varable requires a re-launch of Emacs of become effective." | 918 Changing this variable requires a re-launch of Emacs to become effective." |
919 :group 'org-link | 919 :group 'org-link |
920 :type 'boolean) | 920 :type 'boolean) |
921 | 921 |
922 (defcustom org-line-numbers-in-file-links t | 922 (defcustom org-line-numbers-in-file-links t |
923 "Non-nil means, file links from `org-store-link' contain line numbers. | 923 "Non-nil means, file links from `org-store-link' contain line numbers. |
978 (const find-file) | 978 (const find-file) |
979 (const find-file-other-window) | 979 (const find-file-other-window) |
980 (const find-file-other-frame))))) | 980 (const find-file-other-frame))))) |
981 | 981 |
982 (defcustom org-usenet-links-prefer-google nil | 982 (defcustom org-usenet-links-prefer-google nil |
983 "Non-nil means, `org-store-link' will create web links to google groups. | 983 "Non-nil means, `org-store-link' will create web links to Google groups. |
984 When nil, Gnus will be used for such links. | 984 When nil, Gnus will be used for such links. |
985 Using a prefix arg to the command \\[org-store-link] (`org-store-link') | 985 Using a prefix arg to the command \\[org-store-link] (`org-store-link') |
986 negates this setting for the duration of the command." | 986 negates this setting for the duration of the command." |
987 :group 'org-link | 987 :group 'org-link |
988 :type 'boolean) | 988 :type 'boolean) |
1117 (defcustom org-enable-table-editor 'optimized | 1117 (defcustom org-enable-table-editor 'optimized |
1118 "Non-nil means, lines starting with \"|\" are handled by the table editor. | 1118 "Non-nil means, lines starting with \"|\" are handled by the table editor. |
1119 When nil, such lines will be treated like ordinary lines. | 1119 When nil, such lines will be treated like ordinary lines. |
1120 | 1120 |
1121 When equal to the symbol `optimized', the table editor will be optimized to | 1121 When equal to the symbol `optimized', the table editor will be optimized to |
1122 do the following | 1122 do the following: |
1123 - Use automatic overwrite mode in front of whitespace in table fields. | 1123 - Use automatic overwrite mode in front of whitespace in table fields. |
1124 This make the structure of the table stay in tact as long as the edited | 1124 This makes the structure of the table stay intact as long as the edited |
1125 field does not exceed the column width. | 1125 field does not exceed the column width. |
1126 - Minimize the number of realigns. Normally, the table is aligned each time | 1126 - Minimize the number of realigns. Normally, the table is aligned each time |
1127 TAB or RET are pressed to move to another field. With optimization this | 1127 TAB or RET are pressed to move to another field. With optimization this |
1128 happens only if changes to a field might have changed the column width. | 1128 happens only if changes to a field might have changed the column width. |
1129 Optimization requires replacing the functions `self-insert-command', | 1129 Optimization requires replacing the functions `self-insert-command', |
1130 `delete-char', and `backward-delete-char' in Org-mode buffers, with a | 1130 `delete-char', and `backward-delete-char' in Org-mode buffers, with a |
1131 slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is | 1131 slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is |
1132 very good at guessing when a re-align will be necessary, but you can always | 1132 very good at guessing when a re-align will be necessary, but you can always |
1133 force one with `C-c C-c'. | 1133 force one with `C-c C-c'. |
1328 (string :tag "Date") | 1328 (string :tag "Date") |
1329 (string :tag "Table of Contents")))) | 1329 (string :tag "Table of Contents")))) |
1330 | 1330 |
1331 (defcustom org-export-default-language "en" | 1331 (defcustom org-export-default-language "en" |
1332 "The default language of HTML export, as a string. | 1332 "The default language of HTML export, as a string. |
1333 This should have an association in `org-export-language-setup'" | 1333 This should have an association in `org-export-language-setup'." |
1334 :group 'org-export | 1334 :group 'org-export |
1335 :type 'string) | 1335 :type 'string) |
1336 | 1336 |
1337 (defcustom org-export-headline-levels 3 | 1337 (defcustom org-export-headline-levels 3 |
1338 "The last level which is still exported as a headline. | 1338 "The last level which is still exported as a headline. |
1496 Otherwise the buffer will just be saved to a file and stay hidden." | 1496 Otherwise the buffer will just be saved to a file and stay hidden." |
1497 :group 'org-export | 1497 :group 'org-export |
1498 :type 'boolean) | 1498 :type 'boolean) |
1499 | 1499 |
1500 (defcustom org-export-html-show-new-buffer nil | 1500 (defcustom org-export-html-show-new-buffer nil |
1501 "Non-nil means, popup buffer containing the exported html text. | 1501 "Non-nil means, popup buffer containing the exported HTML text. |
1502 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." |
1503 :group 'org-export | 1503 :group 'org-export |
1504 :type 'boolean) | 1504 :type 'boolean) |
1505 | 1505 |
1506 (defgroup org-faces nil | 1506 (defgroup org-faces nil |
1633 (((class color) (background dark)) (:foreground "chocolate1")) | 1633 (((class color) (background dark)) (:foreground "chocolate1")) |
1634 (t (:bold t :italic t))) | 1634 (t (:bold t :italic t))) |
1635 "Face for items scheduled previously, and not yet done." | 1635 "Face for items scheduled previously, and not yet done." |
1636 :group 'org-faces) | 1636 :group 'org-faces) |
1637 | 1637 |
1638 (defface org-link | 1638 (defface org-link |
1639 '((((type tty) (class color)) (:foreground "cyan" :weight bold)) | 1639 '((((type tty) (class color)) (:foreground "cyan" :weight bold)) |
1640 (((class color) (background light)) (:foreground "Purple")) | 1640 (((class color) (background light)) (:foreground "Purple")) |
1641 (((class color) (background dark)) (:foreground "Cyan")) | 1641 (((class color) (background dark)) (:foreground "Cyan")) |
1642 (t (:bold t))) | 1642 (t (:bold t))) |
1643 "Face for links." | 1643 "Face for links." |
1662 (defface org-time-grid ;; font-lock-variable-name-face | 1662 (defface org-time-grid ;; font-lock-variable-name-face |
1663 '((((type tty) (class color)) (:foreground "yellow" :weight light)) | 1663 '((((type tty) (class color)) (:foreground "yellow" :weight light)) |
1664 (((class color) (background light)) (:foreground "DarkGoldenrod")) | 1664 (((class color) (background light)) (:foreground "DarkGoldenrod")) |
1665 (((class color) (background dark)) (:foreground "LightGoldenrod")) | 1665 (((class color) (background dark)) (:foreground "LightGoldenrod")) |
1666 (t (:bold t :italic t))) | 1666 (t (:bold t :italic t))) |
1667 "Face used for level 2 headlines." | 1667 "Face used for time grids." |
1668 :group 'org-faces) | 1668 :group 'org-faces) |
1669 | 1669 |
1670 (defvar org-level-faces | 1670 (defvar org-level-faces |
1671 '( | 1671 '( |
1672 org-level-1 | 1672 org-level-1 |
1740 (defvar org-inhibit-startup nil) ; Dynamically-scoped param. | 1740 (defvar org-inhibit-startup nil) ; Dynamically-scoped param. |
1741 | 1741 |
1742 | 1742 |
1743 ;;;###autoload | 1743 ;;;###autoload |
1744 (define-derived-mode org-mode outline-mode "Org" | 1744 (define-derived-mode org-mode outline-mode "Org" |
1745 "Outline-based notes management and organizer, alias | 1745 "Outline-based notes management and organizer, alias |
1746 \"Carstens outline-mode for keeping track of everything.\" | 1746 \"Carstens outline-mode for keeping track of everything.\" |
1747 | 1747 |
1748 Org-mode develops organizational tasks around a NOTES file which | 1748 Org-mode develops organizational tasks around a NOTES file which |
1749 contains information about projects as plain text. Org-mode is | 1749 contains information about projects as plain text. Org-mode is |
1750 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 |
1812 ((eq org-startup-folded 'content) | 1812 ((eq org-startup-folded 'content) |
1813 (let ((this-command 'org-cycle) (last-command 'org-cycle)) | 1813 (let ((this-command 'org-cycle) (last-command 'org-cycle)) |
1814 (org-cycle '(4)) (org-cycle '(4)))))))) | 1814 (org-cycle '(4)) (org-cycle '(4)))))))) |
1815 | 1815 |
1816 (defun org-fill-paragraph (&optional justify) | 1816 (defun org-fill-paragraph (&optional justify) |
1817 "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." |
1818 (save-excursion | 1818 (save-excursion |
1819 (beginning-of-line 1) | 1819 (beginning-of-line 1) |
1820 (looking-at "\\s-*\\(|\\|\\+-+\\)"))) | 1820 (looking-at "\\s-*\\(|\\|\\+-+\\)"))) |
1821 | 1821 |
1822 (defsubst org-current-line (&optional pos) | 1822 (defsubst org-current-line (&optional pos) |
1823 (+ (if (bolp) 1 0) (count-lines (point-min) (or pos (point))))) | 1823 (+ (if (bolp) 1 0) (count-lines (point-min) (or pos (point))))) |
1824 | 1824 |
1825 ;;; Font-Lock stuff | 1825 ;;; Font-Lock stuff |
1826 | 1826 |
1827 (defvar org-mouse-map (make-sparse-keymap)) | 1827 (defvar org-mouse-map (make-sparse-keymap)) |
1828 (define-key org-mouse-map | 1828 (define-key org-mouse-map |
1829 (if org-xemacs-p [button2] [mouse-2]) 'org-open-at-mouse) | 1829 (if org-xemacs-p [button2] [mouse-2]) 'org-open-at-mouse) |
1830 (define-key org-mouse-map | 1830 (define-key org-mouse-map |
1831 (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) |
1832 | 1832 |
1833 (require 'font-lock) | 1833 (require 'font-lock) |
1899 (list (concat "\\[#[A-Z]\\]") '(0 'org-warning t)) | 1899 (list (concat "\\[#[A-Z]\\]") '(0 'org-warning t)) |
1900 (list (concat "\\<" org-deadline-string) '(0 'org-warning t)) | 1900 (list (concat "\\<" org-deadline-string) '(0 'org-warning t)) |
1901 (list (concat "\\<" org-scheduled-string) '(0 'org-warning t)) | 1901 (list (concat "\\<" org-scheduled-string) '(0 'org-warning t)) |
1902 ;; '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)" | 1902 ;; '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)" |
1903 ;; (3 'bold)) | 1903 ;; (3 'bold)) |
1904 ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)" | 1904 ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)" |
1905 ;; (3 'italic)) | 1905 ;; (3 'italic)) |
1906 ;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)" | 1906 ;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)" |
1907 ;; (3 'underline)) | 1907 ;; (3 'underline)) |
1908 (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>") | 1908 (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>") |
1909 '(1 'org-warning t)) | 1909 '(1 'org-warning t)) |
1910 '("^#.*" (0 'font-lock-comment-face t)) | 1910 '("^#.*" (0 'font-lock-comment-face t)) |
1911 (if org-fontify-done-headline | 1911 (if org-fontify-done-headline |
1922 (set (make-local-variable 'org-font-lock-keywords) | 1922 (set (make-local-variable 'org-font-lock-keywords) |
1923 (append | 1923 (append |
1924 (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 |
1925 ; on XEmacs if noutline is ever ported | 1925 ; on XEmacs if noutline is ever ported |
1926 '((eval . (list "^\\(\\*+\\).*" | 1926 '((eval . (list "^\\(\\*+\\).*" |
1927 0 '(nth | 1927 0 '(nth |
1928 (% (- (match-end 1) (match-beginning 1) 1) | 1928 (% (- (match-end 1) (match-beginning 1) 1) |
1929 org-n-levels) | 1929 org-n-levels) |
1930 org-level-faces) | 1930 org-level-faces) |
1931 nil t))) | 1931 nil t))) |
1932 '(("^\\(\\(\\*+\\)[^\r\n]*\\)[\n\r]" | 1932 '(("^\\(\\(\\*+\\)[^\r\n]*\\)[\n\r]" |
1936 nil t)))) | 1936 nil t)))) |
1937 org-font-lock-extra-keywords)) | 1937 org-font-lock-extra-keywords)) |
1938 (set (make-local-variable 'font-lock-defaults) | 1938 (set (make-local-variable 'font-lock-defaults) |
1939 '(org-font-lock-keywords t nil nil backward-paragraph)) | 1939 '(org-font-lock-keywords t nil nil backward-paragraph)) |
1940 (kill-local-variable 'font-lock-keywords) nil)) | 1940 (kill-local-variable 'font-lock-keywords) nil)) |
1941 | 1941 |
1942 (defun org-unfontify-region (beg end &optional maybe_loudly) | 1942 (defun org-unfontify-region (beg end &optional maybe_loudly) |
1943 "Remove fontification and activation overlays from links." | 1943 "Remove fontification and activation overlays from links." |
1944 (font-lock-default-unfontify-region beg end) | 1944 (font-lock-default-unfontify-region beg end) |
1945 (let* ((buffer-undo-list t) | 1945 (let* ((buffer-undo-list t) |
1946 (inhibit-read-only t) (inhibit-point-motion-hooks t) | 1946 (inhibit-read-only t) (inhibit-point-motion-hooks t) |
1954 (defvar org-cycle-subtree-status nil) | 1954 (defvar org-cycle-subtree-status nil) |
1955 (defun org-cycle (&optional arg) | 1955 (defun org-cycle (&optional arg) |
1956 "Visibility cycling for Org-mode. | 1956 "Visibility cycling for Org-mode. |
1957 | 1957 |
1958 - When this function is called with a prefix argument, rotate the entire | 1958 - When this function is called with a prefix argument, rotate the entire |
1959 buffer through 3 states (global cycling) | 1959 buffer through 3 states (global cycling): |
1960 1. OVERVIEW: Show only top-level headlines. | 1960 1. OVERVIEW: Show only top-level headlines. |
1961 2. CONTENTS: Show all headlines of all levels, but no body text. | 1961 2. CONTENTS: Show all headlines of all levels, but no body text. |
1962 3. SHOW ALL: Show everything. | 1962 3. SHOW ALL: Show everything. |
1963 | 1963 |
1964 - When point is at the beginning of a headline, rotate the subtree started | 1964 - When point is at the beginning of a headline, rotate the subtree started |
1965 by this line through 3 different states (local cycling) | 1965 by this line through 3 different states (local cycling): |
1966 1. FOLDED: Only the main headline is shown. | 1966 1. FOLDED: Only the main headline is shown. |
1967 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 |
1968 this state, you can move to one of the children and | 1968 this state, you can move to one of the children and |
1969 zoom in further. | 1969 zoom in further. |
1970 3. SUBTREE: Show the entire subtree, including body text. | 1970 3. SUBTREE: Show the entire subtree, including body text. |
2216 (kill-buffer "*org-goto*") | 2216 (kill-buffer "*org-goto*") |
2217 org-selected-point)) | 2217 org-selected-point)) |
2218 | 2218 |
2219 ;; FIXME: It may not be a good idea to temper with the prefix argument... | 2219 ;; FIXME: It may not be a good idea to temper with the prefix argument... |
2220 (defun org-goto-ret (&optional arg) | 2220 (defun org-goto-ret (&optional arg) |
2221 "Finish org-goto by going to the new location." | 2221 "Finish `org-goto' by going to the new location." |
2222 (interactive "P") | 2222 (interactive "P") |
2223 (setq org-selected-point (point) | 2223 (setq org-selected-point (point) |
2224 current-prefix-arg arg) | 2224 current-prefix-arg arg) |
2225 (throw 'exit nil)) | 2225 (throw 'exit nil)) |
2226 | 2226 |
2227 (defun org-goto-left () | 2227 (defun org-goto-left () |
2228 "Finish org-goto by going to the new location." | 2228 "Finish `org-goto' by going to the new location." |
2229 (interactive) | 2229 (interactive) |
2230 (if (org-on-heading-p) | 2230 (if (org-on-heading-p) |
2231 (progn | 2231 (progn |
2232 (beginning-of-line 1) | 2232 (beginning-of-line 1) |
2233 (setq org-selected-point (point) | 2233 (setq org-selected-point (point) |
2234 current-prefix-arg (- (match-end 0) (match-beginning 0))) | 2234 current-prefix-arg (- (match-end 0) (match-beginning 0))) |
2235 (throw 'exit nil)) | 2235 (throw 'exit nil)) |
2236 (error "Not on a heading"))) | 2236 (error "Not on a heading"))) |
2237 | 2237 |
2238 (defun org-goto-right () | 2238 (defun org-goto-right () |
2239 "Finish org-goto by going to the new location." | 2239 "Finish `org-goto' by going to the new location." |
2240 (interactive) | 2240 (interactive) |
2241 (if (org-on-heading-p) | 2241 (if (org-on-heading-p) |
2242 (progn | 2242 (progn |
2243 (outline-end-of-subtree) | 2243 (outline-end-of-subtree) |
2244 (or (eobp) (forward-char 1)) | 2244 (or (eobp) (forward-char 1)) |
2246 current-prefix-arg (- (match-end 0) (match-beginning 0))) | 2246 current-prefix-arg (- (match-end 0) (match-beginning 0))) |
2247 (throw 'exit nil)) | 2247 (throw 'exit nil)) |
2248 (error "Not on a heading"))) | 2248 (error "Not on a heading"))) |
2249 | 2249 |
2250 (defun org-goto-quit () | 2250 (defun org-goto-quit () |
2251 "Finish org-goto without cursor motion." | 2251 "Finish `org-goto' without cursor motion." |
2252 (interactive) | 2252 (interactive) |
2253 (setq org-selected-point nil) | 2253 (setq org-selected-point nil) |
2254 (throw 'exit nil)) | 2254 (throw 'exit nil)) |
2255 | 2255 |
2256 ;;; Promotion, Demotion, Inserting new headlines | 2256 ;;; Promotion, Demotion, Inserting new headlines |
2655 (or (bolp) (insert "\n")) | 2655 (or (bolp) (insert "\n")) |
2656 (insert "\n" heading "\n") | 2656 (insert "\n" heading "\n") |
2657 (end-of-line 0)) | 2657 (end-of-line 0)) |
2658 ;; Make the heading visible, and the following as well | 2658 ;; Make the heading visible, and the following as well |
2659 (let ((org-show-following-heading t)) (org-show-hierarchy-above)) | 2659 (let ((org-show-following-heading t)) (org-show-hierarchy-above)) |
2660 (if (re-search-forward | 2660 (if (re-search-forward |
2661 (concat "^" (regexp-quote (make-string level ?*)) "[ \t]") | 2661 (concat "^" (regexp-quote (make-string level ?*)) "[ \t]") |
2662 nil t) | 2662 nil t) |
2663 (progn (goto-char (match-beginning 0)) (insert "\n") | 2663 (progn (goto-char (match-beginning 0)) (insert "\n") |
2664 (beginning-of-line 0)) | 2664 (beginning-of-line 0)) |
2665 (goto-char (point-max)) (insert "\n"))) | 2665 (goto-char (point-max)) (insert "\n"))) |
2715 (completion-ignore-case opt) | 2715 (completion-ignore-case opt) |
2716 (type nil) | 2716 (type nil) |
2717 (table (cond | 2717 (table (cond |
2718 (opt | 2718 (opt |
2719 (setq type :opt) | 2719 (setq type :opt) |
2720 (mapcar (lambda (x) | 2720 (mapcar (lambda (x) |
2721 (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x) | 2721 (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x) |
2722 (cons (match-string 2 x) (match-string 1 x))) | 2722 (cons (match-string 2 x) (match-string 1 x))) |
2723 (org-split-string (org-get-current-options) "\n"))) | 2723 (org-split-string (org-get-current-options) "\n"))) |
2724 (texp | 2724 (texp |
2725 (setq type :tex) | 2725 (setq type :tex) |
2726 org-html-entities) | 2726 org-html-entities) |
2727 (form | 2727 (form |
2728 (setq type :form) | 2728 (setq type :form) |
2729 '(("sum") ("sumv") ("sumh"))) | 2729 '(("sum") ("sumv") ("sumh"))) |
2730 ((string-match "\\`\\*+[ \t]*\\'" | 2730 ((string-match "\\`\\*+[ \t]*\\'" |
2731 (buffer-substring (point-at-bol) beg)) | 2731 (buffer-substring (point-at-bol) beg)) |
2732 (setq type :todo) | 2732 (setq type :todo) |
2733 (mapcar 'list org-todo-keywords)) | 2733 (mapcar 'list org-todo-keywords)) |
2734 (t (progn (ispell-complete-word arg) (throw 'exit nil))))) | 2734 (t (progn (ispell-complete-word arg) (throw 'exit nil))))) |
2735 (completion (try-completion pattern table))) | 2735 (completion (try-completion pattern table))) |
2736 (cond ((eq completion t) | 2736 (cond ((eq completion t) |
2737 (if (equal type :opt) | 2737 (if (equal type :opt) |
2738 (insert (substring (cdr (assoc (upcase pattern) table)) | 2738 (insert (substring (cdr (assoc (upcase pattern) table)) |
2739 (length pattern))))) | 2739 (length pattern))))) |
2740 ((null completion) | 2740 ((null completion) |
2741 (message "Can't find completion for \"%s\"" pattern) | 2741 (message "Can't find completion for \"%s\"" pattern) |
2742 (ding)) | 2742 (ding)) |
2743 ((not (string= pattern completion)) | 2743 ((not (string= pattern completion)) |
2744 (delete-region beg end) | 2744 (delete-region beg end) |
2745 (if (string-match " +$" completion) | 2745 (if (string-match " +$" completion) |
2746 (setq completion (replace-match "" t t completion))) | 2746 (setq completion (replace-match "" t t completion))) |
2747 (insert completion) | 2747 (insert completion) |
2748 (if (get-buffer-window "*Completions*") | 2748 (if (get-buffer-window "*Completions*") |
2749 (delete-window (get-buffer-window "*Completions*"))) | 2749 (delete-window (get-buffer-window "*Completions*"))) |
2750 (if (and (eq type :todo) | 2750 (if (and (eq type :todo) |
2877 (defun org-occur (regexp &optional callback) | 2877 (defun org-occur (regexp &optional callback) |
2878 "Make a compact tree which shows all matches of REGEXP. | 2878 "Make a compact tree which shows all matches of REGEXP. |
2879 The tree will show the lines where the regexp matches, and all higher | 2879 The tree will show the lines where the regexp matches, and all higher |
2880 headlines above the match. It will also show the heading after the match, | 2880 headlines above the match. It will also show the heading after the match, |
2881 to make sure editing the matching entry is easy. | 2881 to make sure editing the matching entry is easy. |
2882 if CALLBACK is non-nil, it is a function which is called to confirm | 2882 If CALLBACK is non-nil, it is a function which is called to confirm |
2883 that the match should indeed be shown." | 2883 that the match should indeed be shown." |
2884 (interactive "sRegexp: ") | 2884 (interactive "sRegexp: ") |
2885 (setq regexp (org-check-occur-regexp regexp)) | 2885 (setq regexp (org-check-occur-regexp regexp)) |
2886 (let ((cnt 0)) | 2886 (let ((cnt 0)) |
2887 (save-excursion | 2887 (save-excursion |
2977 (defun org-get-priority (s) | 2977 (defun org-get-priority (s) |
2978 "Find priority cookie and return priority." | 2978 "Find priority cookie and return priority." |
2979 (save-match-data | 2979 (save-match-data |
2980 (if (not (string-match org-priority-regexp s)) | 2980 (if (not (string-match org-priority-regexp s)) |
2981 (* 1000 (- org-lowest-priority org-default-priority)) | 2981 (* 1000 (- org-lowest-priority org-default-priority)) |
2982 (* 1000 (- org-lowest-priority | 2982 (* 1000 (- org-lowest-priority |
2983 (string-to-char (match-string 2 s))))))) | 2983 (string-to-char (match-string 2 s))))))) |
2984 | 2984 |
2985 ;;; Timestamps | 2985 ;;; Timestamps |
2986 | 2986 |
2987 (defvar org-last-changed-timestamp nil) | 2987 (defvar org-last-changed-timestamp nil) |
2988 | 2988 |
2989 (defun org-time-stamp (arg) | 2989 (defun org-time-stamp (arg) |
3011 (insert (format-time-string fmt time))) | 3011 (insert (format-time-string fmt time))) |
3012 ((org-at-timestamp-p) | 3012 ((org-at-timestamp-p) |
3013 (setq time (let ((this-command this-command)) | 3013 (setq time (let ((this-command this-command)) |
3014 (org-read-date arg 'totime))) | 3014 (org-read-date arg 'totime))) |
3015 (and (org-at-timestamp-p) (replace-match | 3015 (and (org-at-timestamp-p) (replace-match |
3016 (setq org-last-changed-timestamp | 3016 (setq org-last-changed-timestamp |
3017 (format-time-string fmt time)) | 3017 (format-time-string fmt time)) |
3018 t t)) | 3018 t t)) |
3019 (message "Timestamp updated")) | 3019 (message "Timestamp updated")) |
3020 (t | 3020 (t |
3021 (setq time (let ((this-command this-command)) | 3021 (setq time (let ((this-command this-command)) |
3041 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 |
3042 `parse-time-weekdays'. | 3042 `parse-time-weekdays'. |
3043 | 3043 |
3044 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 |
3045 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 |
3046 month. To scroll it to other months, use the keys `>' and `<'. | 3046 month. To scroll it to other months, use the keys `>' and `<'. |
3047 If you don't like the calendar, turn it off with | 3047 If you don't like the calendar, turn it off with |
3048 \(setq org-popup-calendar-for-date-prompt nil). | 3048 \(setq org-popup-calendar-for-date-prompt nil). |
3049 | 3049 |
3050 With optional argument TO-TIME, the date will immediately be converted | 3050 With optional argument TO-TIME, the date will immediately be converted |
3051 to an internal time. | 3051 to an internal time. |
3052 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 |
3056 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." |
3057 (let* ((default-time | 3057 (let* ((default-time |
3058 ;; Default time is either today, or, when entering a range, | 3058 ;; Default time is either today, or, when entering a range, |
3059 ;; the range start. | 3059 ;; the range start. |
3060 (if (save-excursion | 3060 (if (save-excursion |
3061 (re-search-backward | 3061 (re-search-backward |
3062 (concat org-ts-regexp "--\\=") | 3062 (concat org-ts-regexp "--\\=") |
3063 (- (point) 20) t)) | 3063 (- (point) 20) t)) |
3064 (apply | 3064 (apply |
3065 'encode-time | 3065 'encode-time |
3066 (mapcar (lambda(x) (or x 0)) ;; FIXME: Problem with timezone? | 3066 (mapcar (lambda(x) (or x 0)) ;; FIXME: Problem with timezone? |
3148 (format "%04d-%02d-%02d %02d:%02d" year month day hour minute) | 3148 (format "%04d-%02d-%02d %02d:%02d" year month day hour minute) |
3149 (format "%04d-%02d-%02d" year month day))))) | 3149 (format "%04d-%02d-%02d" year month day))))) |
3150 | 3150 |
3151 (defun org-eval-in-calendar (form) | 3151 (defun org-eval-in-calendar (form) |
3152 "Eval FORM in the calendar window and return to current window. | 3152 "Eval FORM in the calendar window and return to current window. |
3153 Also, store the cursor date in variable ans2." | 3153 Also, store the cursor date in variable `ans2'." |
3154 (let ((sw (selected-window))) | 3154 (let ((sw (selected-window))) |
3155 (select-window (get-buffer-window "*Calendar*")) | 3155 (select-window (get-buffer-window "*Calendar*")) |
3156 (eval form) | 3156 (eval form) |
3157 (when (calendar-cursor-to-date) | 3157 (when (calendar-cursor-to-date) |
3158 (let* ((date (calendar-cursor-to-date)) | 3158 (let* ((date (calendar-cursor-to-date)) |
3167 (when (calendar-cursor-to-date) | 3167 (when (calendar-cursor-to-date) |
3168 (let* ((date (calendar-cursor-to-date)) | 3168 (let* ((date (calendar-cursor-to-date)) |
3169 (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)))) |
3170 (setq ans1 (format-time-string "%Y-%m-%d" time))) | 3170 (setq ans1 (format-time-string "%Y-%m-%d" time))) |
3171 (if (active-minibuffer-window) (exit-minibuffer)))) | 3171 (if (active-minibuffer-window) (exit-minibuffer)))) |
3172 | 3172 |
3173 (defun org-check-deadlines (ndays) | 3173 (defun org-check-deadlines (ndays) |
3174 "Check if there are any deadlines due or past due. | 3174 "Check if there are any deadlines due or past due. |
3175 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' |
3176 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, |
3177 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 |
3322 (and (match-beginning n) | 3322 (and (match-beginning n) |
3323 (<= (match-beginning n) pos) | 3323 (<= (match-beginning n) pos) |
3324 (>= (match-end n) pos))) | 3324 (>= (match-end n) pos))) |
3325 | 3325 |
3326 (defun org-at-timestamp-p () | 3326 (defun org-at-timestamp-p () |
3327 "Determine if the cursor is or at a timestamp." | 3327 "Determine if the cursor is at a timestamp." |
3328 (interactive) | 3328 (interactive) |
3329 (let* ((tsr org-ts-regexp2) | 3329 (let* ((tsr org-ts-regexp2) |
3330 (pos (point)) | 3330 (pos (point)) |
3331 (ans (or (looking-at tsr) | 3331 (ans (or (looking-at tsr) |
3332 (save-excursion | 3332 (save-excursion |
3459 (easy-menu-add org-agenda-menu) | 3459 (easy-menu-add org-agenda-menu) |
3460 (if org-startup-truncated (setq truncate-lines t)) | 3460 (if org-startup-truncated (setq truncate-lines t)) |
3461 (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) |
3462 (add-hook 'pre-command-hook 'org-unhighlight nil 'local) | 3462 (add-hook 'pre-command-hook 'org-unhighlight nil 'local) |
3463 (setq org-agenda-follow-mode nil) | 3463 (setq org-agenda-follow-mode nil) |
3464 (easy-menu-change | 3464 (easy-menu-change |
3465 '("Agenda") "Agenda Files" | 3465 '("Agenda") "Agenda Files" |
3466 (append | 3466 (append |
3467 (list | 3467 (list |
3468 ["Edit File List" (customize-variable 'org-agenda-files) t] | 3468 ["Edit File List" (customize-variable 'org-agenda-files) t] |
3469 "--") | 3469 "--") |
3470 (mapcar 'org-file-menu-entry org-agenda-files))) | 3470 (mapcar 'org-file-menu-entry org-agenda-files))) |
3471 (org-agenda-set-mode-name) | 3471 (org-agenda-set-mode-name) |
3472 (apply | 3472 (apply |
3524 (define-key org-agenda-mode-map [(left)] 'org-agenda-earlier) | 3524 (define-key org-agenda-mode-map [(left)] 'org-agenda-earlier) |
3525 | 3525 |
3526 (defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) | 3526 (defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) |
3527 "Local keymap for agenda entries from Org-mode.") | 3527 "Local keymap for agenda entries from Org-mode.") |
3528 | 3528 |
3529 (define-key org-agenda-keymap | 3529 (define-key org-agenda-keymap |
3530 (if org-xemacs-p [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse) | 3530 (if org-xemacs-p [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse) |
3531 (define-key org-agenda-keymap | 3531 (define-key org-agenda-keymap |
3532 (if org-xemacs-p [(button3)] [(mouse-3)]) 'org-agenda-show-mouse) | 3532 (if org-xemacs-p [(button3)] [(mouse-3)]) 'org-agenda-show-mouse) |
3533 | 3533 |
3534 (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" |
3536 ("Agenda Files") | 3536 ("Agenda Files") |
3537 "--" | 3537 "--" |
3538 ["Show" org-agenda-show t] | 3538 ["Show" org-agenda-show t] |
3539 ["Go To (other window)" org-agenda-goto t] | 3539 ["Go To (other window)" org-agenda-goto t] |
3540 ["Go To (one window)" org-agenda-switch-to t] | 3540 ["Go To (one window)" org-agenda-switch-to t] |
3541 ["Follow Mode" org-agenda-follow-mode | 3541 ["Follow Mode" org-agenda-follow-mode |
3542 :style toggle :selected org-agenda-follow-mode :active t] | 3542 :style toggle :selected org-agenda-follow-mode :active t] |
3543 "--" | 3543 "--" |
3544 ["Cycle TODO" org-agenda-todo t] | 3544 ["Cycle TODO" org-agenda-todo t] |
3545 ("Reschedule" | 3545 ("Reschedule" |
3546 ["Reschedule +1 day" org-agenda-date-later t] | 3546 ["Reschedule +1 day" org-agenda-date-later t] |
3657 t)) ; always include today | 3657 t)) ; always include today |
3658 (today (time-to-days (current-time))) | 3658 (today (time-to-days (current-time))) |
3659 (org-respect-restriction t) | 3659 (org-respect-restriction t) |
3660 (past t) | 3660 (past t) |
3661 s e rtn d) | 3661 s e rtn d) |
3662 (setq org-agenda-redo-command | 3662 (setq org-agenda-redo-command |
3663 (list 'progn | 3663 (list 'progn |
3664 (list 'switch-to-buffer-other-window (current-buffer)) | 3664 (list 'switch-to-buffer-other-window (current-buffer)) |
3665 (list 'org-timeline include-all))) | 3665 (list 'org-timeline include-all))) |
3666 (if (not dopast) | 3666 (if (not dopast) |
3667 ;; Remove past dates from the list of dates. | 3667 ;; Remove past dates from the list of dates. |
3668 (setq day-numbers (delq nil (mapcar (lambda(x) | 3668 (setq day-numbers (delq nil (mapcar (lambda(x) |
3669 (if (>= x today) x nil)) | 3669 (if (>= x today) x nil)) |
3670 day-numbers)))) | 3670 day-numbers)))) |
3671 (switch-to-buffer-other-window | 3671 (switch-to-buffer-other-window |
3672 (get-buffer-create org-agenda-buffer-name)) | 3672 (get-buffer-create org-agenda-buffer-name)) |
3673 (setq buffer-read-only nil) | 3673 (setq buffer-read-only nil) |
3674 (erase-buffer) | 3674 (erase-buffer) |
3675 (org-agenda-mode) (setq buffer-read-only nil) | 3675 (org-agenda-mode) (setq buffer-read-only nil) |
3676 (while (setq d (pop day-numbers)) | 3676 (while (setq d (pop day-numbers)) |
3681 (setq past nil) | 3681 (setq past nil) |
3682 (insert (make-string 79 ?-) "\n"))) | 3682 (insert (make-string 79 ?-) "\n"))) |
3683 (setq date (calendar-gregorian-from-absolute d)) | 3683 (setq date (calendar-gregorian-from-absolute d)) |
3684 (setq s (point)) | 3684 (setq s (point)) |
3685 (if dotodo | 3685 (if dotodo |
3686 (setq rtn (org-agenda-get-day-entries | 3686 (setq rtn (org-agenda-get-day-entries |
3687 entry date :todo :timestamp)) | 3687 entry date :todo :timestamp)) |
3688 (setq rtn (org-agenda-get-day-entries entry date :timestamp))) | 3688 (setq rtn (org-agenda-get-day-entries entry date :timestamp))) |
3689 (if (or rtn (equal d today)) | 3689 (if (or rtn (equal d today)) |
3690 (progn | 3690 (progn |
3691 (insert (calendar-day-name date) " " | 3691 (insert (calendar-day-name date) " " |
3737 (d (- nt n1))) | 3737 (d (- nt n1))) |
3738 (- sd (+ (if (< d 0) 7 0) d))))) | 3738 (- sd (+ (if (< d 0) 7 0) d))))) |
3739 (day-numbers (list start)) | 3739 (day-numbers (list start)) |
3740 (inhibit-redisplay t) | 3740 (inhibit-redisplay t) |
3741 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) |
3742 (setq org-agenda-redo-command | 3742 (setq org-agenda-redo-command |
3743 (list 'org-agenda include-all start-day ndays)) | 3743 (list 'org-agenda include-all start-day ndays)) |
3744 ;; Make the list of days | 3744 ;; Make the list of days |
3745 (setq ndays (or ndays org-agenda-ndays) | 3745 (setq ndays (or ndays org-agenda-ndays) |
3746 nd ndays) | 3746 nd ndays) |
3747 (while (> ndays 1) | 3747 (while (> ndays 1) |
3749 (setq ndays (1- ndays))) | 3749 (setq ndays (1- ndays))) |
3750 (setq day-numbers (nreverse day-numbers)) | 3750 (setq day-numbers (nreverse day-numbers)) |
3751 (if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name))) | 3751 (if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name))) |
3752 (progn | 3752 (progn |
3753 (delete-other-windows) | 3753 (delete-other-windows) |
3754 (switch-to-buffer-other-window | 3754 (switch-to-buffer-other-window |
3755 (get-buffer-create org-agenda-buffer-name)))) | 3755 (get-buffer-create org-agenda-buffer-name)))) |
3756 (setq buffer-read-only nil) | 3756 (setq buffer-read-only nil) |
3757 (erase-buffer) | 3757 (erase-buffer) |
3758 (org-agenda-mode) (setq buffer-read-only nil) | 3758 (org-agenda-mode) (setq buffer-read-only nil) |
3759 (set (make-local-variable 'starting-day) (car day-numbers)) | 3759 (set (make-local-variable 'starting-day) (car day-numbers)) |
3767 (org-check-agenda-file file) | 3767 (org-check-agenda-file file) |
3768 (setq date (calendar-gregorian-from-absolute today) | 3768 (setq date (calendar-gregorian-from-absolute today) |
3769 rtn (org-agenda-get-day-entries | 3769 rtn (org-agenda-get-day-entries |
3770 file date :todo)) | 3770 file date :todo)) |
3771 (setq rtnall (append rtnall rtn)))) | 3771 (setq rtnall (append rtnall rtn)))) |
3772 (when rtnall | 3772 (when rtnall |
3773 (insert "ALL CURRENTLY OPEN TODO ITEMS:\n") | 3773 (insert "ALL CURRENTLY OPEN TODO ITEMS:\n") |
3774 (add-text-properties (point-min) (1- (point)) | 3774 (add-text-properties (point-min) (1- (point)) |
3775 (list 'face 'org-link)) | 3775 (list 'face 'org-link)) |
3776 (insert (org-finalize-agenda-entries rtnall) "\n"))) | 3776 (insert (org-finalize-agenda-entries rtnall) "\n"))) |
3777 (while (setq d (pop day-numbers)) | 3777 (while (setq d (pop day-numbers)) |
3801 (extract-calendar-day date) | 3801 (extract-calendar-day date) |
3802 (calendar-month-name (extract-calendar-month date)) | 3802 (calendar-month-name (extract-calendar-month date)) |
3803 (extract-calendar-year date))) | 3803 (extract-calendar-year date))) |
3804 (put-text-property s (1- (point)) 'face | 3804 (put-text-property s (1- (point)) 'face |
3805 'org-link) | 3805 'org-link) |
3806 (if rtnall (insert | 3806 (if rtnall (insert |
3807 (org-finalize-agenda-entries ;; FIXME: condition needed | 3807 (org-finalize-agenda-entries ;; FIXME: condition needed |
3808 (org-agenda-add-time-grid-maybe | 3808 (org-agenda-add-time-grid-maybe |
3809 rtnall nd todayp)) | 3809 rtnall nd todayp)) |
3810 "\n")) | 3810 "\n")) |
3811 (put-text-property s (1- (point)) 'day d)))) | 3811 (put-text-property s (1- (point)) 'day d)))) |
3812 (goto-char (point-min)) | 3812 (goto-char (point-min)) |
3813 (setq buffer-read-only t) | 3813 (setq buffer-read-only t) |
3814 (if org-fit-agenda-window | 3814 (if org-fit-agenda-window |
3815 (fit-window-to-buffer nil (/ (* (frame-height) 3) 4) | 3815 (fit-window-to-buffer nil (/ (* (frame-height) 3) 4) |
3816 (/ (frame-height) 2))) | 3816 (/ (frame-height) 2))) |
3895 "Switch to weekly view for agenda." | 3895 "Switch to weekly view for agenda." |
3896 (interactive) | 3896 (interactive) |
3897 (unless (boundp 'starting-day) | 3897 (unless (boundp 'starting-day) |
3898 (error "Not allowed")) | 3898 (error "Not allowed")) |
3899 (setq org-agenda-ndays 7) | 3899 (setq org-agenda-ndays 7) |
3900 (org-agenda include-all-loc | 3900 (org-agenda include-all-loc |
3901 (or (get-text-property (point) 'day) | 3901 (or (get-text-property (point) 'day) |
3902 starting-day)) | 3902 starting-day)) |
3903 (org-agenda-set-mode-name) | 3903 (org-agenda-set-mode-name) |
3904 (message "Switched to week view")) | 3904 (message "Switched to week view")) |
3905 | 3905 |
3906 (defun org-agenda-day-view () | 3906 (defun org-agenda-day-view () |
3907 "Switch to weekly view for agenda." | 3907 "Switch to daily view for agenda." |
3908 (interactive) | 3908 (interactive) |
3909 (unless (boundp 'starting-day) | 3909 (unless (boundp 'starting-day) |
3910 (error "Not allowed")) | 3910 (error "Not allowed")) |
3911 (setq org-agenda-ndays 1) | 3911 (setq org-agenda-ndays 1) |
3912 (org-agenda include-all-loc | 3912 (org-agenda include-all-loc |
3913 (or (get-text-property (point) 'day) | 3913 (or (get-text-property (point) 'day) |
3914 starting-day)) | 3914 starting-day)) |
3915 (org-agenda-set-mode-name) | 3915 (org-agenda-set-mode-name) |
3916 (message "Switched to day view")) | 3916 (message "Switched to day view")) |
3917 | 3917 |
3955 (org-agenda-set-mode-name) | 3955 (org-agenda-set-mode-name) |
3956 (message "Follow mode is %s" | 3956 (message "Follow mode is %s" |
3957 (if org-agenda-follow-mode "on" "off"))) | 3957 (if org-agenda-follow-mode "on" "off"))) |
3958 | 3958 |
3959 (defun org-agenda-toggle-diary () | 3959 (defun org-agenda-toggle-diary () |
3960 "Toggle follow mode in an agenda buffer." | 3960 "Toggle diary inclusion in an agenda buffer." |
3961 (interactive) | 3961 (interactive) |
3962 (setq org-agenda-include-diary (not org-agenda-include-diary)) | 3962 (setq org-agenda-include-diary (not org-agenda-include-diary)) |
3963 (org-agenda-redo) | 3963 (org-agenda-redo) |
3964 (org-agenda-set-mode-name) | 3964 (org-agenda-set-mode-name) |
3965 (message "Diary inclusion turned %s" | 3965 (message "Diary inclusion turned %s" |
3966 (if org-agenda-include-diary "on" "off"))) | 3966 (if org-agenda-include-diary "on" "off"))) |
3967 | 3967 |
3968 (defun org-agenda-toggle-time-grid () | 3968 (defun org-agenda-toggle-time-grid () |
3969 "Toggle follow mode in an agenda buffer." | 3969 "Toggle time-grid in an agenda buffer." |
3970 (interactive) | 3970 (interactive) |
3971 (setq org-agenda-use-time-grid (not org-agenda-use-time-grid)) | 3971 (setq org-agenda-use-time-grid (not org-agenda-use-time-grid)) |
3972 (org-agenda-redo) | 3972 (org-agenda-redo) |
3973 (org-agenda-set-mode-name) | 3973 (org-agenda-set-mode-name) |
3974 (message "Time-grid turned %s" | 3974 (message "Time-grid turned %s" |
3995 | 3995 |
3996 (defun org-get-entries-from-diary (date) | 3996 (defun org-get-entries-from-diary (date) |
3997 "Get the (Emacs Calendar) diary entries for DATE." | 3997 "Get the (Emacs Calendar) diary entries for DATE." |
3998 (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*") | 3998 (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*") |
3999 (diary-display-hook '(fancy-diary-display)) | 3999 (diary-display-hook '(fancy-diary-display)) |
4000 (list-diary-entries-hook | 4000 (list-diary-entries-hook |
4001 (cons 'org-diary-default-entry list-diary-entries-hook)) | 4001 (cons 'org-diary-default-entry list-diary-entries-hook)) |
4002 entries | 4002 entries |
4003 (org-disable-diary t)) | 4003 (org-disable-diary t)) |
4004 (save-excursion | 4004 (save-excursion |
4005 (save-window-excursion | 4005 (save-window-excursion |
4019 (setq entries (buffer-substring (point-min) (- (point-max) 1))))) | 4019 (setq entries (buffer-substring (point-min) (- (point-max) 1))))) |
4020 (set-buffer-modified-p nil) | 4020 (set-buffer-modified-p nil) |
4021 (kill-buffer fancy-diary-buffer))) | 4021 (kill-buffer fancy-diary-buffer))) |
4022 (when entries | 4022 (when entries |
4023 (setq entries (org-split-string entries "\n")) | 4023 (setq entries (org-split-string entries "\n")) |
4024 (setq entries | 4024 (setq entries |
4025 (mapcar | 4025 (mapcar |
4026 (lambda (x) | 4026 (lambda (x) |
4027 (setq x (org-format-agenda-item "" x "Diary" 'time)) | 4027 (setq x (org-format-agenda-item "" x "Diary" 'time)) |
4028 ;; Extend the text properties to the beginning of the line | 4028 ;; Extend the text properties to the beginning of the line |
4029 (add-text-properties | 4029 (add-text-properties |
4030 0 (length x) | 4030 0 (length x) |
4031 (text-properties-at (1- (length x)) x) | 4031 (text-properties-at (1- (length x)) x) |
4032 x) | 4032 x) |
4033 x) | 4033 x) |
4034 entries))))) | 4034 entries))))) |
4035 | 4035 |
4036 (defun org-agenda-cleanup-fancy-diary () | 4036 (defun org-agenda-cleanup-fancy-diary () |
4037 "Remove unwanted stuff in buffer created by fancy-diary-display. | 4037 "Remove unwanted stuff in buffer created by `fancy-diary-display'. |
4038 This gets rid of the date, the underline under the date, and | 4038 This gets rid of the date, the underline under the date, and |
4039 the dummy entry installed by `org-mode' to ensure non-empty diary for each | 4039 the dummy entry installed by `org-mode' to ensure non-empty diary for each |
4040 date. Itt also removes lines that contain only whitespace." | 4040 date. It also removes lines that contain only whitespace." |
4041 (goto-char (point-min)) | 4041 (goto-char (point-min)) |
4042 (if (looking-at ".*?:[ \t]*") | 4042 (if (looking-at ".*?:[ \t]*") |
4043 (progn | 4043 (progn |
4044 (replace-match "") | 4044 (replace-match "") |
4045 (re-search-forward "\n=+$" nil t) | 4045 (re-search-forward "\n=+$" nil t) |
4065 (buffer-file-name)) | 4065 (buffer-file-name)) |
4066 (add-text-properties | 4066 (add-text-properties |
4067 0 (length string) | 4067 0 (length string) |
4068 (list 'mouse-face 'highlight | 4068 (list 'mouse-face 'highlight |
4069 'keymap org-agenda-keymap | 4069 'keymap org-agenda-keymap |
4070 'help-echo | 4070 'help-echo |
4071 (format | 4071 (format |
4072 "mouse-2 or RET jump to diary file %s" | 4072 "mouse-2 or RET jump to diary file %s" |
4073 (abbreviate-file-name (buffer-file-name))) | 4073 (abbreviate-file-name (buffer-file-name))) |
4074 'org-agenda-diary-link t | 4074 'org-agenda-diary-link t |
4075 'org-marker (org-agenda-new-marker (point-at-bol))) | 4075 'org-marker (org-agenda-new-marker (point-at-bol))) |
4087 (defun org-add-file (&optional file) | 4087 (defun org-add-file (&optional file) |
4088 "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'. |
4089 These are the files which are being checked for agenda entries. | 4089 These are the files which are being checked for agenda entries. |
4090 Optional argument FILE means, use this file instead of the current. | 4090 Optional argument FILE means, use this file instead of the current. |
4091 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 |
4092 `org-mode-hook'." | 4092 `org-mode-hook'." |
4093 (interactive) | 4093 (interactive) |
4094 (catch 'exit | 4094 (catch 'exit |
4095 (let* ((file (or file (buffer-file-name) | 4095 (let* ((file (or file (buffer-file-name) |
4096 (if (interactive-p) | 4096 (if (interactive-p) |
4097 (error "Buffer is not visiting a file") | 4097 (error "Buffer is not visiting a file") |
4102 (lambda (x) | 4102 (lambda (x) |
4103 (equal true-file (file-truename x))) | 4103 (equal true-file (file-truename x))) |
4104 org-agenda-files)))) | 4104 org-agenda-files)))) |
4105 (if (not present) | 4105 (if (not present) |
4106 (progn | 4106 (progn |
4107 (setq org-agenda-files | 4107 (setq org-agenda-files |
4108 (cons afile org-agenda-files)) | 4108 (cons afile org-agenda-files)) |
4109 ;; Make sure custom.el does not end up with Org-mode | 4109 ;; Make sure custom.el does not end up with Org-mode |
4110 (let ((org-mode-hook nil) (default-major-mode 'fundamental-mode)) | 4110 (let ((org-mode-hook nil) (default-major-mode 'fundamental-mode)) |
4111 (customize-save-variable 'org-agenda-files org-agenda-files)) | 4111 (customize-save-variable 'org-agenda-files org-agenda-files)) |
4112 (org-install-agenda-files-menu) | 4112 (org-install-agenda-files-menu) |
4119 Optional argument FILE means, use this file instead of the current." | 4119 Optional argument FILE means, use this file instead of the current." |
4120 (interactive) | 4120 (interactive) |
4121 (let* ((file (or file (buffer-file-name))) | 4121 (let* ((file (or file (buffer-file-name))) |
4122 (true-file (file-truename file)) | 4122 (true-file (file-truename file)) |
4123 (afile (abbreviate-file-name file)) | 4123 (afile (abbreviate-file-name file)) |
4124 (files (delq nil (mapcar | 4124 (files (delq nil (mapcar |
4125 (lambda (x) | 4125 (lambda (x) |
4126 (if (equal true-file | 4126 (if (equal true-file |
4127 (file-truename x)) | 4127 (file-truename x)) |
4128 nil x)) | 4128 nil x)) |
4129 org-agenda-files)))) | 4129 org-agenda-files)))) |
4166 ;;;###autoload | 4166 ;;;###autoload |
4167 (defun org-diary (&rest args) | 4167 (defun org-diary (&rest args) |
4168 "Return diary information from org-files. | 4168 "Return diary information from org-files. |
4169 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. |
4170 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 | |
4172 listed in the diary. The function accepts arguments specifying what | 4171 listed in the diary. The function accepts arguments specifying what |
4173 items should be listed. The following arguments are allowed: | 4172 items should be listed. The following arguments are allowed: |
4174 | 4173 |
4175 :timestamp List the headlines of items containing a date stamp or | 4174 :timestamp List the headlines of items containing a date stamp or |
4176 date range matching the selected date. Deadlines will | 4175 date range matching the selected date. Deadlines will |
4205 | 4204 |
4206 &%%(org-diary :deadline :timestamp :scheduled) | 4205 &%%(org-diary :deadline :timestamp :scheduled) |
4207 | 4206 |
4208 The function expects the lisp variables `entry' and `date' to be provided | 4207 The function expects the lisp variables `entry' and `date' to be provided |
4209 by the caller, because this is how the calendar works. Don't use this | 4208 by the caller, because this is how the calendar works. Don't use this |
4210 function from a program - use `org-agenda-get-day-entries' instead." | 4209 function from a program - use `org-agenda-get-day-entries' instead." |
4211 (org-agenda-maybe-reset-markers) | 4210 (org-agenda-maybe-reset-markers) |
4212 (org-compile-prefix-format org-agenda-prefix-format) | 4211 (org-compile-prefix-format org-agenda-prefix-format) |
4213 (setq args (or args '(:deadline :scheduled :timestamp))) | 4212 (setq args (or args '(:deadline :scheduled :timestamp))) |
4214 (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) | 4213 (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) |
4215 (list entry) | 4214 (list entry) |
4247 (save-restriction | 4246 (save-restriction |
4248 (if org-respect-restriction | 4247 (if org-respect-restriction |
4249 (if (org-region-active-p) | 4248 (if (org-region-active-p) |
4250 ;; Respect a region to restrict search | 4249 ;; Respect a region to restrict search |
4251 (narrow-to-region (region-beginning) (region-end))) | 4250 (narrow-to-region (region-beginning) (region-end))) |
4252 ;; If we work for the calendar or many files, | 4251 ;; If we work for the calendar or many files, |
4253 ;; get rid of any restriction | 4252 ;; get rid of any restriction |
4254 (widen)) | 4253 (widen)) |
4255 ;; The way we repeatedly append to `results' makes it O(n^2) :-( | 4254 ;; The way we repeatedly append to `results' makes it O(n^2) :-( |
4256 (while (setq arg (pop args)) | 4255 (while (setq arg (pop args)) |
4257 (cond | 4256 (cond |
4313 (goto-char (point-min)) | 4312 (goto-char (point-min)) |
4314 (while (re-search-forward regexp nil t) | 4313 (while (re-search-forward regexp nil t) |
4315 (goto-char (match-beginning 1)) | 4314 (goto-char (match-beginning 1)) |
4316 (setq marker (org-agenda-new-marker (point-at-bol)) | 4315 (setq marker (org-agenda-new-marker (point-at-bol)) |
4317 txt (org-format-agenda-item "" (match-string 1)) | 4316 txt (org-format-agenda-item "" (match-string 1)) |
4318 priority | 4317 priority |
4319 (+ (org-get-priority txt) | 4318 (+ (org-get-priority txt) |
4320 (if org-todo-kwd-priority-p | 4319 (if org-todo-kwd-priority-p |
4321 (- org-todo-kwd-max-priority -2 | 4320 (- org-todo-kwd-max-priority -2 |
4322 (length | 4321 (length |
4323 (member (match-string 2) org-todo-keywords))) | 4322 (member (match-string 2) org-todo-keywords))) |
4330 (push txt ee) | 4329 (push txt ee) |
4331 (goto-char (match-end 1))) | 4330 (goto-char (match-end 1))) |
4332 (nreverse ee))) | 4331 (nreverse ee))) |
4333 | 4332 |
4334 (defconst org-agenda-no-heading-message | 4333 (defconst org-agenda-no-heading-message |
4335 "No heading for this item in buffer or region") | 4334 "No heading for this item in buffer or region.") |
4336 | 4335 |
4337 (defun org-agenda-get-timestamps () | 4336 (defun org-agenda-get-timestamps () |
4338 "Return the date stamp information for agenda display." | 4337 "Return the date stamp information for agenda display." |
4339 (let* ((props (list 'face nil | 4338 (let* ((props (list 'face nil |
4340 'mouse-face 'highlight | 4339 'mouse-face 'highlight |
4385 'org-hd-marker hdmarker) props) | 4384 'org-hd-marker hdmarker) props) |
4386 txt) | 4385 txt) |
4387 (if deadlinep | 4386 (if deadlinep |
4388 (add-text-properties | 4387 (add-text-properties |
4389 0 (length txt) | 4388 0 (length txt) |
4390 (list 'face | 4389 (list 'face |
4391 (if donep 'org-done 'org-warning) | 4390 (if donep 'org-done 'org-warning) |
4392 'undone-face 'org-warning | 4391 'undone-face 'org-warning |
4393 'done-face 'org-done | 4392 'done-face 'org-done |
4394 'priority (+ 100 priority)) | 4393 'priority (+ 100 priority)) |
4395 txt) | 4394 txt) |
4445 (setq txt (org-format-agenda-item | 4444 (setq txt (org-format-agenda-item |
4446 (format "In %3d d.: " diff) head)))) | 4445 (format "In %3d d.: " diff) head)))) |
4447 (setq txt org-agenda-no-heading-message)) | 4446 (setq txt org-agenda-no-heading-message)) |
4448 (when txt | 4447 (when txt |
4449 (add-text-properties | 4448 (add-text-properties |
4450 0 (length txt) | 4449 0 (length txt) |
4451 (append | 4450 (append |
4452 (list 'org-marker (org-agenda-new-marker pos) | 4451 (list 'org-marker (org-agenda-new-marker pos) |
4453 'org-hd-marker (org-agenda-new-marker pos1) | 4452 'org-hd-marker (org-agenda-new-marker pos1) |
4454 'priority (+ (- 10 diff) (org-get-priority txt)) | 4453 'priority (+ (- 10 diff) (org-get-priority txt)) |
4455 'face (cond ((<= diff 0) 'org-warning) | 4454 'face (cond ((<= diff 0) 'org-warning) |
4456 ((<= diff 5) 'org-scheduled-previously) | 4455 ((<= diff 5) 'org-scheduled-previously) |
4538 (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) | 4537 (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) |
4539 (progn | 4538 (progn |
4540 (setq hdmarker (org-agenda-new-marker (match-end 1))) | 4539 (setq hdmarker (org-agenda-new-marker (match-end 1))) |
4541 (goto-char (match-end 1)) | 4540 (goto-char (match-end 1)) |
4542 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") | 4541 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") |
4543 (setq txt (org-format-agenda-item | 4542 (setq txt (org-format-agenda-item |
4544 (format (if (= d1 d2) "" "(%d/%d): ") | 4543 (format (if (= d1 d2) "" "(%d/%d): ") |
4545 (1+ (- d0 d1)) (1+ (- d2 d1))) | 4544 (1+ (- d0 d1)) (1+ (- d2 d1))) |
4546 (match-string 1) nil (if (= d0 d1) timestr)))) | 4545 (match-string 1) nil (if (= d0 d1) timestr)))) |
4547 (setq txt org-agenda-no-heading-message)) | 4546 (setq txt org-agenda-no-heading-message)) |
4548 (add-text-properties | 4547 (add-text-properties |
4620 (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) | 4619 (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) |
4621 (setq plain (string-match org-plain-time-of-day-regexp ts))) | 4620 (setq plain (string-match org-plain-time-of-day-regexp ts))) |
4622 (setq s0 (match-string 0 ts) | 4621 (setq s0 (match-string 0 ts) |
4623 s1 (match-string (if plain 1 2) ts) | 4622 s1 (match-string (if plain 1 2) ts) |
4624 s2 (match-string (if plain 8 4) ts)) | 4623 s2 (match-string (if plain 8 4) ts)) |
4625 | 4624 |
4626 ;; If the times are in TXT (not in DOTIMES), and the prefix will list | 4625 ;; If the times are in TXT (not in DOTIMES), and the prefix will list |
4627 ;; them, we might want to remove them there to avoid duplication. | 4626 ;; them, we might want to remove them there to avoid duplication. |
4628 ;; The user can turn this off with a variable. | 4627 ;; The user can turn this off with a variable. |
4629 (if (and org-agenda-remove-times-when-in-prefix (or stamp plain) | 4628 (if (and org-agenda-remove-times-when-in-prefix (or stamp plain) |
4630 (string-match (concat (regexp-quote s0) " *") txt) | 4629 (string-match (concat (regexp-quote s0) " *") txt) |
4633 t)) | 4632 t)) |
4634 (setq txt (replace-match "" nil nil txt)))) | 4633 (setq txt (replace-match "" nil nil txt)))) |
4635 ;; Normalize the time(s) to 24 hour | 4634 ;; Normalize the time(s) to 24 hour |
4636 (if s1 (setq s1 (org-get-time-of-day s1 'string))) | 4635 (if s1 (setq s1 (org-get-time-of-day s1 'string))) |
4637 (if s2 (setq s2 (org-get-time-of-day s2 'string)))) | 4636 (if s2 (setq s2 (org-get-time-of-day s2 'string)))) |
4638 | 4637 |
4639 ;; Create the final string | 4638 ;; Create the final string |
4640 (if noprefix | 4639 (if noprefix |
4641 (setq rtn txt) | 4640 (setq rtn txt) |
4642 ;; Prepare the variables needed in the eval of the compiled format | 4641 ;; Prepare the variables needed in the eval of the compiled format |
4643 (setq time (cond (s2 (concat s1 "-" s2)) | 4642 (setq time (cond (s2 (concat s1 "-" s2)) |
4645 (t "")) | 4644 (t "")) |
4646 extra (or extra "") | 4645 extra (or extra "") |
4647 category (if (symbolp category) (symbol-name category) category)) | 4646 category (if (symbolp category) (symbol-name category) category)) |
4648 ;; Evaluate the compiled format | 4647 ;; Evaluate the compiled format |
4649 (setq rtn (concat (eval org-prefix-format-compiled) txt))) | 4648 (setq rtn (concat (eval org-prefix-format-compiled) txt))) |
4650 | 4649 |
4651 ;; And finally add the text properties | 4650 ;; And finally add the text properties |
4652 (add-text-properties | 4651 (add-text-properties |
4653 0 (length rtn) (list 'category (downcase category) | 4652 0 (length rtn) (list 'category (downcase category) |
4654 'prefix-length (- (length rtn) (length txt)) | 4653 'prefix-length (- (length rtn) (length txt)) |
4655 'time-of-day time-of-day | 4654 'time-of-day time-of-day |
4676 ;; don't show empty grid | 4675 ;; don't show empty grid |
4677 (throw 'exit list)) | 4676 (throw 'exit list)) |
4678 (while (setq time (pop gridtimes)) | 4677 (while (setq time (pop gridtimes)) |
4679 (unless (and remove (member time have)) | 4678 (unless (and remove (member time have)) |
4680 (setq time (int-to-string time)) | 4679 (setq time (int-to-string time)) |
4681 (push (org-format-agenda-item | 4680 (push (org-format-agenda-item |
4682 nil string "" ;; FIXME: put a category? | 4681 nil string "" ;; FIXME: put a category? |
4683 (concat (substring time 0 -2) ":" (substring time -2))) | 4682 (concat (substring time 0 -2) ":" (substring time -2))) |
4684 new) | 4683 new) |
4685 (put-text-property | 4684 (put-text-property |
4686 1 (length (car new)) 'face 'org-time-grid (car new)))) | 4685 1 (length (car new)) 'face 'org-time-grid (car new)))) |
4687 (if (member 'time-up org-agenda-sorting-strategy) | 4686 (if (member 'time-up org-agenda-sorting-strategy) |
4688 (append new list) | 4687 (append new list) |
4689 (append list new))))) | 4688 (append list new))))) |
4690 | 4689 |
4719 If found, return it as a military time number between 0 and 2400. | 4718 If found, return it as a military time number between 0 and 2400. |
4720 If not found, return nil. | 4719 If not found, return nil. |
4721 The optional STRING argument forces conversion into a 5 character wide string | 4720 The optional STRING argument forces conversion into a 5 character wide string |
4722 HH:MM." | 4721 HH:MM." |
4723 (save-match-data | 4722 (save-match-data |
4724 (when | 4723 (when |
4725 (or | 4724 (or |
4726 (string-match | 4725 (string-match |
4727 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s) | 4726 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s) |
4728 (string-match | 4727 (string-match |
4729 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s)) | 4728 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s)) |
4741 (defun org-finalize-agenda-entries (list) | 4740 (defun org-finalize-agenda-entries (list) |
4742 "Sort and concatenate the agenda items." | 4741 "Sort and concatenate the agenda items." |
4743 (mapconcat 'identity (sort list 'org-entries-lessp) "\n")) | 4742 (mapconcat 'identity (sort list 'org-entries-lessp) "\n")) |
4744 | 4743 |
4745 (defsubst org-cmp-priority (a b) | 4744 (defsubst org-cmp-priority (a b) |
4746 "Compare the priorities of string a and b." | 4745 "Compare the priorities of strings A and B." |
4747 (let ((pa (or (get-text-property 1 'priority a) 0)) | 4746 (let ((pa (or (get-text-property 1 'priority a) 0)) |
4748 (pb (or (get-text-property 1 'priority b) 0))) | 4747 (pb (or (get-text-property 1 'priority b) 0))) |
4749 (cond ((> pa pb) +1) | 4748 (cond ((> pa pb) +1) |
4750 ((< pa pb) -1) | 4749 ((< pa pb) -1) |
4751 (t nil)))) | 4750 (t nil)))) |
4752 | 4751 |
4753 (defsubst org-cmp-category (a b) | 4752 (defsubst org-cmp-category (a b) |
4754 "Compare the string values of categories of strings a and b." | 4753 "Compare the string values of categories of strings A and B." |
4755 (let ((ca (or (get-text-property 1 'category a) "")) | 4754 (let ((ca (or (get-text-property 1 'category a) "")) |
4756 (cb (or (get-text-property 1 'category b) ""))) | 4755 (cb (or (get-text-property 1 'category b) ""))) |
4757 (cond ((string-lessp ca cb) -1) | 4756 (cond ((string-lessp ca cb) -1) |
4758 ((string-lessp cb ca) +1) | 4757 ((string-lessp cb ca) +1) |
4759 (t nil)))) | 4758 (t nil)))) |
4760 | 4759 |
4761 (defsubst org-cmp-time (a b) | 4760 (defsubst org-cmp-time (a b) |
4762 "Compare the time-of-day values of strings a and b." | 4761 "Compare the time-of-day values of strings A and B." |
4763 (let* ((def (if org-sort-agenda-notime-is-late 2401 -1)) | 4762 (let* ((def (if org-sort-agenda-notime-is-late 2401 -1)) |
4764 (ta (or (get-text-property 1 'time-of-day a) def)) | 4763 (ta (or (get-text-property 1 'time-of-day a) def)) |
4765 (tb (or (get-text-property 1 'time-of-day b) def))) | 4764 (tb (or (get-text-property 1 'time-of-day b) def))) |
4766 (cond ((< ta tb) -1) | 4765 (cond ((< ta tb) -1) |
4767 ((< tb ta) +1) | 4766 ((< tb ta) +1) |
4775 (priority-up (org-cmp-priority a b)) | 4774 (priority-up (org-cmp-priority a b)) |
4776 (priority-down (if priority-up (- priority-up) nil)) | 4775 (priority-down (if priority-up (- priority-up) nil)) |
4777 (category-up (org-cmp-category a b)) | 4776 (category-up (org-cmp-category a b)) |
4778 (category-down (if category-up (- category-up) nil)) | 4777 (category-down (if category-up (- category-up) nil)) |
4779 (category-keep (if category-up +1 nil))) ; FIXME +1 or -1? | 4778 (category-keep (if category-up +1 nil))) ; FIXME +1 or -1? |
4780 (cdr (assoc | 4779 (cdr (assoc |
4781 (eval (cons 'or org-agenda-sorting-strategy)) | 4780 (eval (cons 'or org-agenda-sorting-strategy)) |
4782 '((-1 . t) (1 . nil) (nil . nil)))))) | 4781 '((-1 . t) (1 . nil) (nil . nil)))))) |
4783 | 4782 |
4784 (defun org-agenda-show-priority () | 4783 (defun org-agenda-show-priority () |
4785 "Show the priority of the current item. | 4784 "Show the priority of the current item. |
4790 (message "Priority is %d" (if pri pri -1000)))) | 4789 (message "Priority is %d" (if pri pri -1000)))) |
4791 | 4790 |
4792 (defun org-agenda-goto (&optional highlight) | 4791 (defun org-agenda-goto (&optional highlight) |
4793 "Go to the Org-mode file which contains the item at point." | 4792 "Go to the Org-mode file which contains the item at point." |
4794 (interactive) | 4793 (interactive) |
4795 (let* ((marker (or (get-text-property (point) 'org-marker) | 4794 (let* ((marker (or (get-text-property (point) 'org-marker) |
4796 (org-agenda-error))) | 4795 (org-agenda-error))) |
4797 (buffer (marker-buffer marker)) | 4796 (buffer (marker-buffer marker)) |
4798 (pos (marker-position marker))) | 4797 (pos (marker-position marker))) |
4799 (switch-to-buffer-other-window buffer) | 4798 (switch-to-buffer-other-window buffer) |
4800 (widen) | 4799 (widen) |
4807 (and highlight (org-highlight (point-at-bol) (point-at-eol))))) | 4806 (and highlight (org-highlight (point-at-bol) (point-at-eol))))) |
4808 | 4807 |
4809 (defun org-agenda-switch-to () | 4808 (defun org-agenda-switch-to () |
4810 "Go to the Org-mode file which contains the item at point." | 4809 "Go to the Org-mode file which contains the item at point." |
4811 (interactive) | 4810 (interactive) |
4812 (let* ((marker (or (get-text-property (point) 'org-marker) | 4811 (let* ((marker (or (get-text-property (point) 'org-marker) |
4813 (org-agenda-error))) | 4812 (org-agenda-error))) |
4814 (buffer (marker-buffer marker)) | 4813 (buffer (marker-buffer marker)) |
4815 (pos (marker-position marker))) | 4814 (pos (marker-position marker))) |
4816 (switch-to-buffer buffer) | 4815 (switch-to-buffer buffer) |
4817 (delete-other-windows) | 4816 (delete-other-windows) |
4893 (save-excursion | 4892 (save-excursion |
4894 (org-agenda-change-all-lines newhead hdmarker 'fixface)) | 4893 (org-agenda-change-all-lines newhead hdmarker 'fixface)) |
4895 (move-to-column col))) | 4894 (move-to-column col))) |
4896 | 4895 |
4897 (defun org-agenda-change-all-lines (newhead hdmarker &optional fixface) | 4896 (defun org-agenda-change-all-lines (newhead hdmarker &optional fixface) |
4898 "Change all lines in the agenda buffer which match hdmarker. | 4897 "Change all lines in the agenda buffer which match HDMARKER. |
4899 The new content of the line will be NEWHEAD (as modified by | 4898 The new content of the line will be NEWHEAD (as modified by |
4900 `org-format-agenda-item'). HDMARKER is checked with | 4899 `org-format-agenda-item'). HDMARKER is checked with |
4901 `equal' against all `org-hd-marker' text properties in the file. | 4900 `equal' against all `org-hd-marker' text properties in the file. |
4902 If FIXFACE is non-nil, the face of each item is modified acording to | 4901 If FIXFACE is non-nil, the face of each item is modified acording to |
4903 the new TODO state." | 4902 the new TODO state." |
4921 (progn | 4920 (progn |
4922 (replace-match new t t) | 4921 (replace-match new t t) |
4923 (beginning-of-line 1) | 4922 (beginning-of-line 1) |
4924 (add-text-properties (point-at-bol) (point-at-eol) props) | 4923 (add-text-properties (point-at-bol) (point-at-eol) props) |
4925 (if fixface | 4924 (if fixface |
4926 (add-text-properties | 4925 (add-text-properties |
4927 (point-at-bol) (point-at-eol) | 4926 (point-at-bol) (point-at-eol) |
4928 (list 'face | 4927 (list 'face |
4929 (if org-last-todo-state-is-todo | 4928 (if org-last-todo-state-is-todo |
4930 undone-face done-face)))) | 4929 undone-face done-face)))) |
4931 (beginning-of-line 1)) | 4930 (beginning-of-line 1)) |
5015 (match-string 1) | 5014 (match-string 1) |
5016 ""))) | 5015 ""))) |
5017 | 5016 |
5018 (defun org-agenda-diary-entry () | 5017 (defun org-agenda-diary-entry () |
5019 "Make a diary entry, like the `i' command from the calendar. | 5018 "Make a diary entry, like the `i' command from the calendar. |
5020 All the standard commands work: block, weekly etc" | 5019 All the standard commands work: block, weekly etc." |
5021 (interactive) | 5020 (interactive) |
5022 (require 'diary-lib) | 5021 (require 'diary-lib) |
5023 (let* ((char (progn | 5022 (let* ((char (progn |
5024 (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic") | 5023 (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic") |
5025 (read-char-exclusive))) | 5024 (read-char-exclusive))) |
5026 (cmd (cdr (assoc char | 5025 (cmd (cdr (assoc char |
5027 '((?d . insert-diary-entry) | 5026 '((?d . insert-diary-entry) |
5028 (?w . insert-weekly-diary-entry) | 5027 (?w . insert-weekly-diary-entry) |
5048 (get-text-property point 'day)))))) | 5047 (get-text-property point 'day)))))) |
5049 (unwind-protect | 5048 (unwind-protect |
5050 (progn | 5049 (progn |
5051 (fset 'calendar-cursor-to-date | 5050 (fset 'calendar-cursor-to-date |
5052 (lambda (&optional error) | 5051 (lambda (&optional error) |
5053 (calendar-gregorian-from-absolute | 5052 (calendar-gregorian-from-absolute |
5054 (get-text-property point 'day)))) | 5053 (get-text-property point 'day)))) |
5055 (call-interactively cmd)) | 5054 (call-interactively cmd)) |
5056 (fset 'calendar-cursor-to-date oldf))))) | 5055 (fset 'calendar-cursor-to-date oldf))))) |
5057 | 5056 |
5058 | 5057 |
5071 (displayed-year (extract-calendar-year date))) | 5070 (displayed-year (extract-calendar-year date))) |
5072 (unwind-protect | 5071 (unwind-protect |
5073 (progn | 5072 (progn |
5074 (fset 'calendar-cursor-to-date | 5073 (fset 'calendar-cursor-to-date |
5075 (lambda (&optional error) | 5074 (lambda (&optional error) |
5076 (calendar-gregorian-from-absolute | 5075 (calendar-gregorian-from-absolute |
5077 (get-text-property point 'day)))) | 5076 (get-text-property point 'day)))) |
5078 (call-interactively cmd)) | 5077 (call-interactively cmd)) |
5079 (fset 'calendar-cursor-to-date oldf)))) | 5078 (fset 'calendar-cursor-to-date oldf)))) |
5080 | 5079 |
5081 (defun org-agenda-phases-of-moon () | 5080 (defun org-agenda-phases-of-moon () |
5121 (let ((day (get-text-property (point) 'day)) | 5120 (let ((day (get-text-property (point) 'day)) |
5122 date s) | 5121 date s) |
5123 (unless day | 5122 (unless day |
5124 (error "Don't know which date to convert")) | 5123 (error "Don't know which date to convert")) |
5125 (setq date (calendar-gregorian-from-absolute day)) | 5124 (setq date (calendar-gregorian-from-absolute day)) |
5126 (setq s (concat | 5125 (setq s (concat |
5127 "Gregorian: " (calendar-date-string date) "\n" | 5126 "Gregorian: " (calendar-date-string date) "\n" |
5128 "ISO: " (calendar-iso-date-string date) "\n" | 5127 "ISO: " (calendar-iso-date-string date) "\n" |
5129 "Day of Yr: " (calendar-day-of-year-string date) "\n" | 5128 "Day of Yr: " (calendar-day-of-year-string date) "\n" |
5130 "Julian: " (calendar-julian-date-string date) "\n" | 5129 "Julian: " (calendar-julian-date-string date) "\n" |
5131 "Astron. JD: " (calendar-astro-date-string date) | 5130 "Astron. JD: " (calendar-astro-date-string date) |
5234 article (match-string 3 path)) | 5233 article (match-string 3 path)) |
5235 (org-follow-rmail-link folder article))) | 5234 (org-follow-rmail-link folder article))) |
5236 | 5235 |
5237 ((string= type "shell") | 5236 ((string= type "shell") |
5238 (let ((cmd path)) | 5237 (let ((cmd path)) |
5239 (while (string-match "@{" cmd) | 5238 (while (string-match "@{" cmd) |
5240 (setq cmd (replace-match "<" t t cmd))) | 5239 (setq cmd (replace-match "<" t t cmd))) |
5241 (while (string-match "@}" cmd) | 5240 (while (string-match "@}" cmd) |
5242 (setq cmd (replace-match ">" t t cmd))) | 5241 (setq cmd (replace-match ">" t t cmd))) |
5243 (if (or (not org-confirm-shell-links) | 5242 (if (or (not org-confirm-shell-links) |
5244 (yes-or-no-p (format "Execute \"%s\" in the shell? " cmd))) | 5243 (yes-or-no-p (format "Execute \"%s\" in the shell? " cmd))) |
5245 (shell-command cmd) | 5244 (shell-command cmd) |
5246 (error "Abort")))) | 5245 (error "Abort")))) |
5333 (setq message-number | 5332 (setq message-number |
5334 (save-restriction | 5333 (save-restriction |
5335 (widen) | 5334 (widen) |
5336 (goto-char (point-max)) | 5335 (goto-char (point-max)) |
5337 (if (re-search-backward | 5336 (if (re-search-backward |
5338 (concat "^Message-ID:\\s-+" (regexp-quote | 5337 (concat "^Message-ID:\\s-+" (regexp-quote |
5339 (or article ""))) | 5338 (or article ""))) |
5340 nil t) | 5339 nil t) |
5341 (rmail-what-message)))))) | 5340 (rmail-what-message)))))) |
5342 (if message-number | 5341 (if message-number |
5343 (progn | 5342 (progn |
5420 (setq cpltxt (concat | 5419 (setq cpltxt (concat |
5421 "bbdb:" | 5420 "bbdb:" |
5422 (or (bbdb-record-name (bbdb-current-record)) | 5421 (or (bbdb-record-name (bbdb-current-record)) |
5423 (bbdb-record-company (bbdb-current-record)))) | 5422 (bbdb-record-company (bbdb-current-record)))) |
5424 link (org-make-link cpltxt))) | 5423 link (org-make-link cpltxt))) |
5425 | 5424 |
5426 ((eq major-mode 'calendar-mode) | 5425 ((eq major-mode 'calendar-mode) |
5427 (let ((cd (calendar-cursor-to-date))) | 5426 (let ((cd (calendar-cursor-to-date))) |
5428 (setq link | 5427 (setq link |
5429 (format-time-string | 5428 (format-time-string |
5430 (car org-time-stamp-formats) | 5429 (car org-time-stamp-formats) |
5446 (setq folder (abbreviate-file-name folder)) | 5445 (setq folder (abbreviate-file-name folder)) |
5447 (if (string-match (concat "^" (regexp-quote vm-folder-directory)) | 5446 (if (string-match (concat "^" (regexp-quote vm-folder-directory)) |
5448 folder) | 5447 folder) |
5449 (setq folder (replace-match "" t t folder))) | 5448 (setq folder (replace-match "" t t folder))) |
5450 (setq cpltxt (concat author " on: " subject)) | 5449 (setq cpltxt (concat author " on: " subject)) |
5451 (setq link (concat cpltxt "\n " | 5450 (setq link (concat cpltxt "\n " |
5452 (org-make-link | 5451 (org-make-link |
5453 "vm:" folder "#" message-id)))))) | 5452 "vm:" folder "#" message-id)))))) |
5454 | 5453 |
5455 ((eq major-mode 'wl-summary-mode) | 5454 ((eq major-mode 'wl-summary-mode) |
5456 (let* ((msgnum (wl-summary-message-number)) | 5455 (let* ((msgnum (wl-summary-message-number)) |
5457 (message-id (elmo-message-field wl-summary-buffer-elmo-folder | 5456 (message-id (elmo-message-field wl-summary-buffer-elmo-folder |
5459 (wl-message-entity (elmo-msgdb-overview-get-entity | 5458 (wl-message-entity (elmo-msgdb-overview-get-entity |
5460 msgnum (wl-summary-buffer-msgdb))) | 5459 msgnum (wl-summary-buffer-msgdb))) |
5461 (author (wl-summary-line-from)) ; FIXME: how to get author name? | 5460 (author (wl-summary-line-from)) ; FIXME: how to get author name? |
5462 (subject "???")) ; FIXME: How to get subject of email? | 5461 (subject "???")) ; FIXME: How to get subject of email? |
5463 (setq cpltxt (concat author " on: " subject)) | 5462 (setq cpltxt (concat author " on: " subject)) |
5464 (setq link (concat cpltxt "\n " | 5463 (setq link (concat cpltxt "\n " |
5465 (org-make-link | 5464 (org-make-link |
5466 "wl:" wl-summary-buffer-folder-name | 5465 "wl:" wl-summary-buffer-folder-name |
5467 "#" message-id))))) | 5466 "#" message-id))))) |
5468 | 5467 |
5469 ((eq major-mode 'rmail-mode) | 5468 ((eq major-mode 'rmail-mode) |
5473 (let ((folder (buffer-file-name)) | 5472 (let ((folder (buffer-file-name)) |
5474 (message-id (mail-fetch-field "message-id")) | 5473 (message-id (mail-fetch-field "message-id")) |
5475 (author (mail-fetch-field "from")) | 5474 (author (mail-fetch-field "from")) |
5476 (subject (mail-fetch-field "subject"))) | 5475 (subject (mail-fetch-field "subject"))) |
5477 (setq cpltxt (concat author " on: " subject)) | 5476 (setq cpltxt (concat author " on: " subject)) |
5478 (setq link (concat cpltxt "\n " | 5477 (setq link (concat cpltxt "\n " |
5479 (org-make-link | 5478 (org-make-link |
5480 "rmail:" folder "#" message-id))))))) | 5479 "rmail:" folder "#" message-id))))))) |
5481 | 5480 |
5482 ((eq major-mode 'gnus-group-mode) | 5481 ((eq major-mode 'gnus-group-mode) |
5483 (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus | 5482 (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus |
5527 (abbreviate-file-name (buffer-file-name)))) | 5526 (abbreviate-file-name (buffer-file-name)))) |
5528 ;; Add the line number? | 5527 ;; Add the line number? |
5529 (if (org-xor org-line-numbers-in-file-links arg) | 5528 (if (org-xor org-line-numbers-in-file-links arg) |
5530 (setq cpltxt | 5529 (setq cpltxt |
5531 (concat cpltxt | 5530 (concat cpltxt |
5532 ":" (int-to-string | 5531 ":" (int-to-string |
5533 (+ (if (bolp) 1 0) (count-lines | 5532 (+ (if (bolp) 1 0) (count-lines |
5534 (point-min) (point))))))) | 5533 (point-min) (point))))))) |
5535 (setq link (org-make-link cpltxt))) | 5534 (setq link (org-make-link cpltxt))) |
5536 | 5535 |
5537 ((interactive-p) | 5536 ((interactive-p) |
5553 (defun org-xor (a b) | 5552 (defun org-xor (a b) |
5554 "Exclusive or." | 5553 "Exclusive or." |
5555 (if a (not b) b)) | 5554 (if a (not b) b)) |
5556 | 5555 |
5557 (defun org-get-header (header) | 5556 (defun org-get-header (header) |
5558 "Find a header field in the current buffer." | 5557 "Find a HEADER field in the current buffer." |
5559 (save-excursion | 5558 (save-excursion |
5560 (goto-char (point-min)) | 5559 (goto-char (point-min)) |
5561 (let ((case-fold-search t) s) | 5560 (let ((case-fold-search t) s) |
5562 (cond | 5561 (cond |
5563 ((eq header 'from) | 5562 ((eq header 'from) |
5662 (defconst org-remember-help | 5661 (defconst org-remember-help |
5663 "Select a destination location for the note. | 5662 "Select a destination location for the note. |
5664 UP/DOWN=headline TAB=cycle visibility [Q]uit RET/<left>/<right>=Store | 5663 UP/DOWN=headline TAB=cycle visibility [Q]uit RET/<left>/<right>=Store |
5665 RET at beg-of-buf -> Append to file as level 2 headline | 5664 RET at beg-of-buf -> Append to file as level 2 headline |
5666 RET on headline -> Store as sublevel entry to current headline | 5665 RET on headline -> Store as sublevel entry to current headline |
5667 <left>/<right> -> before/after current headline, same headings level") | 5666 <left>/<right> -> Before/after current headline, same headings level") |
5668 | 5667 |
5669 ;;;###autoload | 5668 ;;;###autoload |
5670 (defun org-remember-handler () | 5669 (defun org-remember-handler () |
5671 "Store stuff from remember.el into an org file. | 5670 "Store stuff from remember.el into an org file. |
5672 First prompts for an org file. If the user just presses return, the value | 5671 First prompts for an org file. If the user just presses return, the value |
5697 | 5696 |
5698 If the variable `org-adapt-indentation' is non-nil, the entire text is | 5697 If the variable `org-adapt-indentation' is non-nil, the entire text is |
5699 also indented so that it starts in the same column as the headline | 5698 also indented so that it starts in the same column as the headline |
5700 \(i.e. after the stars). | 5699 \(i.e. after the stars). |
5701 | 5700 |
5702 See also the variable `org-reverse-note-order'." | 5701 See also the variable `org-reverse-note-order'." |
5703 (catch 'quit | 5702 (catch 'quit |
5704 (let* ((txt (buffer-substring (point-min) (point-max))) | 5703 (let* ((txt (buffer-substring (point-min) (point-max))) |
5705 (fastp current-prefix-arg) | 5704 (fastp current-prefix-arg) |
5706 (file (if fastp org-default-notes-file (org-get-org-file))) | 5705 (file (if fastp org-default-notes-file (org-get-org-file))) |
5707 (visiting (find-buffer-visiting file)) | 5706 (visiting (find-buffer-visiting file)) |
5872 (defun org-table-convert-region (beg0 end0 nspace) | 5871 (defun org-table-convert-region (beg0 end0 nspace) |
5873 "Convert region to a table. | 5872 "Convert region to a table. |
5874 The region goes from BEG0 to END0, but these borders will be moved | 5873 The region goes from BEG0 to END0, but these borders will be moved |
5875 slightly, to make sure a beginning of line in the first line is included. | 5874 slightly, to make sure a beginning of line in the first line is included. |
5876 When NSPACE is non-nil, it indicates the minimum number of spaces that | 5875 When NSPACE is non-nil, it indicates the minimum number of spaces that |
5877 separate columns (default: just one space)" | 5876 separate columns (default: just one space)." |
5878 (let* ((beg (min beg0 end0)) | 5877 (let* ((beg (min beg0 end0)) |
5879 (end (max beg0 end0)) | 5878 (end (max beg0 end0)) |
5880 (tabsep t) | 5879 (tabsep t) |
5881 re) | 5880 re) |
5882 (goto-char beg) | 5881 (goto-char beg) |
6205 "Copy a field down in the current column. | 6204 "Copy a field down in the current column. |
6206 If the field at the cursor is empty, copy into it the content of the nearest | 6205 If the field at the cursor is empty, copy into it the content of the nearest |
6207 non-empty field above. With argument N, use the Nth non-empty field. | 6206 non-empty field above. With argument N, use the Nth non-empty field. |
6208 If the current field is not empty, it is copied down to the next row, and | 6207 If the current field is not empty, it is copied down to the next row, and |
6209 the cursor is moved with it. Therefore, repeating this command causes the | 6208 the cursor is moved with it. Therefore, repeating this command causes the |
6210 column to be filled row-by-row. | 6209 column to be filled row-by-row. |
6211 If the variable `org-table-copy-increment' is non-nil and the field is an | 6210 If the variable `org-table-copy-increment' is non-nil and the field is an |
6212 integer, it will be incremented while copying." | 6211 integer, it will be incremented while copying." |
6213 (interactive "p") | 6212 (interactive "p") |
6214 (let* ((colpos (org-table-current-column)) | 6213 (let* ((colpos (org-table-current-column)) |
6215 (field (org-table-get-field)) | 6214 (field (org-table-get-field)) |
6303 cnt))) | 6302 cnt))) |
6304 | 6303 |
6305 (defun org-table-goto-column (n &optional on-delim force) | 6304 (defun org-table-goto-column (n &optional on-delim force) |
6306 "Move the cursor to the Nth column in the current table line. | 6305 "Move the cursor to the Nth column in the current table line. |
6307 With optional argument ON-DELIM, stop with point before the left delimiter | 6306 With optional argument ON-DELIM, stop with point before the left delimiter |
6308 of the field. | 6307 of the field. |
6309 If there are less than N fields, just go to after the last delimiter. | 6308 If there are less than N fields, just go to after the last delimiter. |
6310 However, when FORCE is non-nil, create new columns if necessary." | 6309 However, when FORCE is non-nil, create new columns if necessary." |
6311 (let ((pos (point-at-eol))) | 6310 (let ((pos (point-at-eol))) |
6312 (beginning-of-line 1) | 6311 (beginning-of-line 1) |
6313 (when (> n 0) | 6312 (when (> n 0) |
6324 (backward-char 1) | 6323 (backward-char 1) |
6325 (if (looking-at " ") (forward-char 1)))))) | 6324 (if (looking-at " ") (forward-char 1)))))) |
6326 | 6325 |
6327 (defun org-at-table-p (&optional table-type) | 6326 (defun org-at-table-p (&optional table-type) |
6328 "Return t if the cursor is inside an org-type table. | 6327 "Return t if the cursor is inside an org-type table. |
6329 If TABLE-TYPE is non-nil, also chack for table.el-type tables." | 6328 If TABLE-TYPE is non-nil, also check for table.el-type tables." |
6330 (if org-enable-table-editor | 6329 (if org-enable-table-editor |
6331 (save-excursion | 6330 (save-excursion |
6332 (beginning-of-line 1) | 6331 (beginning-of-line 1) |
6333 (looking-at (if table-type org-table-any-line-regexp | 6332 (looking-at (if table-type org-table-any-line-regexp |
6334 org-table-line-regexp))) | 6333 org-table-line-regexp))) |
6488 (org-table-goto-column colpos) | 6487 (org-table-goto-column colpos) |
6489 (org-table-align) | 6488 (org-table-align) |
6490 (org-table-modify-formulas 'swap col (if left (1- col) (1+ col))))) | 6489 (org-table-modify-formulas 'swap col (if left (1- col) (1+ col))))) |
6491 | 6490 |
6492 (defun org-table-move-row-down () | 6491 (defun org-table-move-row-down () |
6493 "move table row down." | 6492 "Move table row down." |
6494 (interactive) | 6493 (interactive) |
6495 (org-table-move-row nil)) | 6494 (org-table-move-row nil)) |
6496 (defun org-table-move-row-up () | 6495 (defun org-table-move-row-up () |
6497 "move table row up." | 6496 "Move table row up." |
6498 (interactive) | 6497 (interactive) |
6499 (org-table-move-row 'up)) | 6498 (org-table-move-row 'up)) |
6500 | 6499 |
6501 (defun org-table-move-row (&optional up) | 6500 (defun org-table-move-row (&optional up) |
6502 "Move the current table line down. With arg UP, move it up." | 6501 "Move the current table line down. With arg UP, move it up." |
6588 (org-table-copy-region beg end 'cut)) | 6587 (org-table-copy-region beg end 'cut)) |
6589 | 6588 |
6590 (defun org-table-copy-region (beg end &optional cut) | 6589 (defun org-table-copy-region (beg end &optional cut) |
6591 "Copy rectangular region in table to clipboard. | 6590 "Copy rectangular region in table to clipboard. |
6592 A special clipboard is used which can only be accessed | 6591 A special clipboard is used which can only be accessed |
6593 with `org-table-paste-rectangle'" | 6592 with `org-table-paste-rectangle'." |
6594 (interactive "rP") | 6593 (interactive "rP") |
6595 (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2 | 6594 (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2 |
6596 region cols | 6595 region cols |
6597 (rpl (if cut " " nil))) | 6596 (rpl (if cut " " nil))) |
6598 (goto-char beg) | 6597 (goto-char beg) |
6599 (org-table-check-inside-data-field) | 6598 (org-table-check-inside-data-field) |
6600 (setq l01 (count-lines (point-min) (point)) | 6599 (setq l01 (count-lines (point-min) (point)) |
6601 c01 (org-table-current-column)) | 6600 c01 (org-table-current-column)) |
6602 (goto-char end) | 6601 (goto-char end) |
6603 (org-table-check-inside-data-field) | 6602 (org-table-check-inside-data-field) |
6604 (setq l02 (count-lines (point-min) (point)) | 6603 (setq l02 (count-lines (point-min) (point)) |
6605 c02 (org-table-current-column)) | 6604 c02 (org-table-current-column)) |
6606 (setq l1 (min l01 l02) l2 (max l01 l02) | 6605 (setq l1 (min l01 l02) l2 (max l01 l02) |
6618 (push (nreverse cols) region) | 6617 (push (nreverse cols) region) |
6619 (setq l1 (1+ l1))))) | 6618 (setq l1 (1+ l1))))) |
6620 (setq org-table-clip (nreverse region)) | 6619 (setq org-table-clip (nreverse region)) |
6621 (if cut (org-table-align)) | 6620 (if cut (org-table-align)) |
6622 org-table-clip)) | 6621 org-table-clip)) |
6623 | 6622 |
6624 (defun org-table-paste-rectangle () | 6623 (defun org-table-paste-rectangle () |
6625 "Paste a rectangular region into a table. | 6624 "Paste a rectangular region into a table. |
6626 The upper right corner ends up in the current field. All involved fields | 6625 The upper right corner ends up in the current field. All involved fields |
6627 will be overwritten. If the rectangle does not fit into the present table, | 6626 will be overwritten. If the rectangle does not fit into the present table, |
6628 the table is enlarged as needed. The process ignores horizontal separator | 6627 the table is enlarged as needed. The process ignores horizontal separator |
6729 (setq nlines (if arg | 6728 (setq nlines (if arg |
6730 (if (< arg 1) | 6729 (if (< arg 1) |
6731 (+ (length org-table-clip) arg) | 6730 (+ (length org-table-clip) arg) |
6732 arg) | 6731 arg) |
6733 (length org-table-clip))) | 6732 (length org-table-clip))) |
6734 (setq org-table-clip | 6733 (setq org-table-clip |
6735 (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ") | 6734 (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ") |
6736 nil nlines))) | 6735 nil nlines))) |
6737 (goto-char beg) | 6736 (goto-char beg) |
6738 (org-table-paste-rectangle)) | 6737 (org-table-paste-rectangle)) |
6739 ;; No region, split the current field at point | 6738 ;; No region, split the current field at point |
6785 (while (> (length ll) lines) | 6784 (while (> (length ll) lines) |
6786 (setq w (1+ w)) | 6785 (setq w (1+ w)) |
6787 (setq ll (org-do-wrap words w))) | 6786 (setq ll (org-do-wrap words w))) |
6788 ll)) | 6787 ll)) |
6789 (t (error "Cannot wrap this"))))) | 6788 (t (error "Cannot wrap this"))))) |
6790 | 6789 |
6791 | 6790 |
6792 (defun org-do-wrap (words width) | 6791 (defun org-do-wrap (words width) |
6793 "Create lines of maximum width WIDTH (in characters) from word list WORDS." | 6792 "Create lines of maximum width WIDTH (in characters) from word list WORDS." |
6794 (let (lines line) | 6793 (let (lines line) |
6795 (while words | 6794 (while words |
6849 | 6848 |
6850 (defun org-table-toggle-vline-visibility (&optional arg) | 6849 (defun org-table-toggle-vline-visibility (&optional arg) |
6851 "Toggle the visibility of table vertical lines. | 6850 "Toggle the visibility of table vertical lines. |
6852 The effect is immediate and on all tables in the file. | 6851 The effect is immediate and on all tables in the file. |
6853 With prefix ARG, make lines invisible when ARG is positive, make lines | 6852 With prefix ARG, make lines invisible when ARG is positive, make lines |
6854 visible when ARG is not positive" | 6853 visible when ARG is not positive." |
6855 (interactive "P") | 6854 (interactive "P") |
6856 (let ((action (cond | 6855 (let ((action (cond |
6857 ((and arg (> (prefix-numeric-value arg) 0)) 'on) | 6856 ((and arg (> (prefix-numeric-value arg) 0)) 'on) |
6858 ((and arg (< (prefix-numeric-value arg) 1)) 'off) | 6857 ((and arg (< (prefix-numeric-value arg) 1)) 'off) |
6859 (t (if (org-in-invisibility-spec-p '(org-table)) | 6858 (t (if (org-in-invisibility-spec-p '(org-table)) |
7001 (concat "$" (int-to-string (car x)) "=" (cdr x))) | 7000 (concat "$" (int-to-string (car x)) "=" (cdr x))) |
7002 alist "::") | 7001 alist "::") |
7003 "\n"))) | 7002 "\n"))) |
7004 | 7003 |
7005 (defun org-table-get-stored-formulas () | 7004 (defun org-table-get-stored-formulas () |
7006 "Return an alist withh the t=stored formulas directly after current table." | 7005 "Return an alist with the stored formulas directly after current table." |
7007 (interactive) | 7006 (interactive) |
7008 (let (col eq eq-alist strings string) | 7007 (let (col eq eq-alist strings string) |
7009 (save-excursion | 7008 (save-excursion |
7010 (goto-char (org-table-end)) | 7009 (goto-char (org-table-end)) |
7011 (when (looking-at "\\([ \t]*\n\\)*#\\+TBLFM: *\\(.*\\)") | 7010 (when (looking-at "\\([ \t]*\n\\)*#\\+TBLFM: *\\(.*\\)") |
7067 "Regular expression matching the current column names.") | 7066 "Regular expression matching the current column names.") |
7068 (defvar org-table-local-parameters nil | 7067 (defvar org-table-local-parameters nil |
7069 "Alist with parameter names, derived from the `$' line.") | 7068 "Alist with parameter names, derived from the `$' line.") |
7070 | 7069 |
7071 (defun org-table-get-specials () | 7070 (defun org-table-get-specials () |
7072 "Get the column nmaes and local parameters for this table." | 7071 "Get the column names and local parameters for this table." |
7073 (save-excursion | 7072 (save-excursion |
7074 (let ((beg (org-table-begin)) (end (org-table-end)) | 7073 (let ((beg (org-table-begin)) (end (org-table-end)) |
7075 names name fields field cnt) | 7074 names name fields field cnt) |
7076 (setq org-table-column-names nil | 7075 (setq org-table-column-names nil |
7077 org-table-local-parameters nil) | 7076 org-table-local-parameters nil) |
7113 (if (string-match "^\\(=sum[vh]?\\)\\([0-9]+\\)$" dfield) | 7112 (if (string-match "^\\(=sum[vh]?\\)\\([0-9]+\\)$" dfield) |
7114 (setq nlast (1+ (string-to-number (match-string 2 dfield))) | 7113 (setq nlast (1+ (string-to-number (match-string 2 dfield))) |
7115 dfield (match-string 1 dfield))) | 7114 dfield (match-string 1 dfield))) |
7116 (cond | 7115 (cond |
7117 ((equal dfield "=sumh") | 7116 ((equal dfield "=sumh") |
7118 (org-table-get-field | 7117 (org-table-get-field |
7119 nil (org-table-sum | 7118 nil (org-table-sum |
7120 (save-excursion (org-table-goto-column 1) (point)) | 7119 (save-excursion (org-table-goto-column 1) (point)) |
7121 (point) nlast))) | 7120 (point) nlast))) |
7122 ((member dfield '("=sum" "=sumv")) | 7121 ((member dfield '("=sum" "=sumv")) |
7123 (setq col (org-table-current-column) | 7122 (setq col (org-table-current-column) |
7124 bolpos (point-at-bol)) | 7123 bolpos (point-at-bol)) |
7125 (org-table-get-field | 7124 (org-table-get-field |
7126 nil (org-table-sum | 7125 nil (org-table-sum |
7127 (save-excursion | 7126 (save-excursion |
7128 (goto-char (org-table-begin)) | 7127 (goto-char (org-table-begin)) |
7129 (if (re-search-forward org-table-dataline-regexp bolpos t) | 7128 (if (re-search-forward org-table-dataline-regexp bolpos t) |
7130 (progn | 7129 (progn |
7142 "FIXME:" | 7141 "FIXME:" |
7143 :group 'org-table | 7142 :group 'org-table |
7144 :type 'boolean) | 7143 :type 'boolean) |
7145 | 7144 |
7146 (defvar org-recalc-commands nil | 7145 (defvar org-recalc-commands nil |
7147 "List of commands triggering the reccalculation of a line. | 7146 "List of commands triggering the recalculation of a line. |
7148 Will be filled automatically during use.") | 7147 Will be filled automatically during use.") |
7149 | 7148 |
7150 (defvar org-recalc-marks | 7149 (defvar org-recalc-marks |
7151 '((" " . "Unmarked: no special line, no automatic recalculation") | 7150 '((" " . "Unmarked: no special line, no automatic recalculation") |
7152 ("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line") | 7151 ("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line") |
7192 (org-table-insert-column) | 7191 (org-table-insert-column) |
7193 (org-table-goto-column (1+ col))) | 7192 (org-table-goto-column (1+ col))) |
7194 (setq epos (point-at-eol)) | 7193 (setq epos (point-at-eol)) |
7195 (save-excursion | 7194 (save-excursion |
7196 (beginning-of-line 1) | 7195 (beginning-of-line 1) |
7197 (org-table-get-field | 7196 (org-table-get-field |
7198 1 (if (looking-at "^[ \t]*| *\\([#!$* ]\\) *|") | 7197 1 (if (looking-at "^[ \t]*| *\\([#!$* ]\\) *|") |
7199 (concat " " | 7198 (concat " " |
7200 (setq new (or forcenew | 7199 (setq new (or forcenew |
7201 (cadr (member (match-string 1) marks)))) | 7200 (cadr (member (match-string 1) marks)))) |
7202 " ") | 7201 " ") |
7203 " # "))) | 7202 " # "))) |
7204 (if (and l1 l2) | 7203 (if (and l1 l2) |
7205 (progn | 7204 (progn |
7264 A few examples for formulas: | 7263 A few examples for formulas: |
7265 $1+$2 Sum of first and second field | 7264 $1+$2 Sum of first and second field |
7266 $1+$2;%.2f Same, and format result to two digits after dec.point | 7265 $1+$2;%.2f Same, and format result to two digits after dec.point |
7267 exp($2)+exp($1) Math functions can be used | 7266 exp($2)+exp($1) Math functions can be used |
7268 $;%.1f Reformat current cell to 1 digit after dec.point | 7267 $;%.1f Reformat current cell to 1 digit after dec.point |
7269 ($3-32)*5/9 degrees F -> C conversion | 7268 ($3-32)*5/9 Degrees F -> C conversion |
7270 | 7269 |
7271 When called with a raw \\[universal-argument] prefix, the formula is applied to the current | 7270 When called with a raw \\[universal-argument] prefix, the formula is applied to the current |
7272 field, and to the same same column in all following rows, until reaching a | 7271 field, and to the same same column in all following rows, until reaching a |
7273 horizontal line or the end of the table. When the command is called with a | 7272 horizontal line or the end of the table. When the command is called with a |
7274 numeric prefix argument (like M-3 or C-7 or \\[universal-argument] 24), the formula is applied | 7273 numeric prefix argument (like M-3 or C-7 or \\[universal-argument] 24), the formula is applied |
7304 (while (string-match "[pnfse]\\(-?[0-9]+\\)" fmt) | 7303 (while (string-match "[pnfse]\\(-?[0-9]+\\)" fmt) |
7305 (setq c (string-to-char (match-string 1 fmt)) | 7304 (setq c (string-to-char (match-string 1 fmt)) |
7306 n (string-to-number (or (match-string 1 fmt) ""))) | 7305 n (string-to-number (or (match-string 1 fmt) ""))) |
7307 (if (= c ?p) (org-set-calc-mode 'calc-internal-prec n) | 7306 (if (= c ?p) (org-set-calc-mode 'calc-internal-prec n) |
7308 (org-set-calc-mode 'calc-float-format | 7307 (org-set-calc-mode 'calc-float-format |
7309 (list (cdr (assoc c '((?n. float) (?f. fix) | 7308 (list (cdr (assoc c '((?n. float) (?f. fix) |
7310 (?s. sci) (?e. eng)))) | 7309 (?s. sci) (?e. eng)))) |
7311 n))) | 7310 n))) |
7312 (setq fmt (replace-match "" t t fmt))) | 7311 (setq fmt (replace-match "" t t fmt))) |
7313 (when (string-match "[DR]" fmt) | 7312 (when (string-match "[DR]" fmt) |
7314 (org-set-calc-mode 'calc-angle-mode | 7313 (org-set-calc-mode 'calc-angle-mode |
7348 (setq ev (calc-eval (cons form modes) | 7347 (setq ev (calc-eval (cons form modes) |
7349 (if org-table-formula-numbers-only 'num))) | 7348 (if org-table-formula-numbers-only 'num))) |
7350 | 7349 |
7351 (when org-table-formula-debug | 7350 (when org-table-formula-debug |
7352 (with-output-to-temp-buffer "*Help*" | 7351 (with-output-to-temp-buffer "*Help*" |
7353 (princ (format "Substitution history of formula | 7352 (princ (format "Substitution history of formula |
7354 Orig: %s | 7353 Orig: %s |
7355 $xyz-> %s | 7354 $xyz-> %s |
7356 $1-> %s\n" orig formula form)) | 7355 $1-> %s\n" orig formula form)) |
7357 (if (listp ev) | 7356 (if (listp ev) |
7358 (princ (format " %s^\nError: %s" | 7357 (princ (format " %s^\nError: %s" |
7427 (org-table-goto-column thiscol) | 7426 (org-table-goto-column thiscol) |
7428 (or noalign (org-table-align) | 7427 (or noalign (org-table-align) |
7429 (and all (message "Re-applying formulas to %d lines...done" cnt))))) | 7428 (and all (message "Re-applying formulas to %d lines...done" cnt))))) |
7430 | 7429 |
7431 (defun org-table-formula-substitute-names (f) | 7430 (defun org-table-formula-substitute-names (f) |
7432 "Replace $const with values in stirng F." | 7431 "Replace $const with values in string F." |
7433 (let ((start 0) a n1 n2 nn1 nn2 s (f1 f)) | 7432 (let ((start 0) a n1 n2 nn1 nn2 s (f1 f)) |
7434 ;; First, check for column names | 7433 ;; First, check for column names |
7435 (while (setq start (string-match org-table-column-name-regexp f start)) | 7434 (while (setq start (string-match org-table-column-name-regexp f start)) |
7436 (setq start (1+ start)) | 7435 (setq start (1+ start)) |
7437 (setq a (assoc (match-string 1 f) org-table-column-names)) | 7436 (setq a (assoc (match-string 1 f) org-table-column-names)) |
7449 (setq f (replace-match s t t f))) | 7448 (setq f (replace-match s t t f))) |
7450 ;; Parameters and constants | 7449 ;; Parameters and constants |
7451 (setq start 0) | 7450 (setq start 0) |
7452 (while (setq start (string-match "\\$\\([a-zA-Z][a-zA-Z0-9]*\\)" f start)) | 7451 (while (setq start (string-match "\\$\\([a-zA-Z][a-zA-Z0-9]*\\)" f start)) |
7453 (setq start (1+ start)) | 7452 (setq start (1+ start)) |
7454 (if (setq a (save-match-data | 7453 (if (setq a (save-match-data |
7455 (org-table-get-constant (match-string 1 f)))) | 7454 (org-table-get-constant (match-string 1 f)))) |
7456 (setq f (replace-match (concat "(" a ")") t t f)))) | 7455 (setq f (replace-match (concat "(" a ")") t t f)))) |
7457 (if org-table-formula-debug | 7456 (if org-table-formula-debug |
7458 (put-text-property 0 (length f) :orig-formula f1 f)) | 7457 (put-text-property 0 (length f) :orig-formula f1 f)) |
7459 f)) | 7458 f)) |
7521 "Unconditionally turn on `orgtbl-mode'." | 7520 "Unconditionally turn on `orgtbl-mode'." |
7522 (orgtbl-mode 1)) | 7521 (orgtbl-mode 1)) |
7523 | 7522 |
7524 ;;;###autoload | 7523 ;;;###autoload |
7525 (defun orgtbl-mode (&optional arg) | 7524 (defun orgtbl-mode (&optional arg) |
7526 "The `org-mode' table editor as a minor mode for use in other modes." | 7525 "The `org-mode' table editor as a minor mode for use in other modes." |
7527 (interactive) | 7526 (interactive) |
7528 (if (eq major-mode 'org-mode) | 7527 (if (eq major-mode 'org-mode) |
7529 ;; Exit without error, in case some hook functions calls this | 7528 ;; Exit without error, in case some hook functions calls this |
7530 ;; by accident in org-mode. | 7529 ;; by accident in org-mode. |
7531 (message "Orgtbl-mode is not useful in org-mode, command ignored") | 7530 (message "Orgtbl-mode is not useful in org-mode, command ignored") |
7543 (add-hook 'before-change-functions 'org-before-change-function | 7542 (add-hook 'before-change-functions 'org-before-change-function |
7544 nil 'local) | 7543 nil 'local) |
7545 (set (make-local-variable 'org-old-auto-fill-inhibit-regexp) | 7544 (set (make-local-variable 'org-old-auto-fill-inhibit-regexp) |
7546 auto-fill-inhibit-regexp) | 7545 auto-fill-inhibit-regexp) |
7547 (set (make-local-variable 'auto-fill-inhibit-regexp) | 7546 (set (make-local-variable 'auto-fill-inhibit-regexp) |
7548 (if auto-fill-inhibit-regexp | 7547 (if auto-fill-inhibit-regexp |
7549 (concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp) | 7548 (concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp) |
7550 "[ \t]*|")) | 7549 "[ \t]*|")) |
7551 (easy-menu-add orgtbl-mode-menu) | 7550 (easy-menu-add orgtbl-mode-menu) |
7552 (run-hooks 'orgtbl-mode-hook)) | 7551 (run-hooks 'orgtbl-mode-hook)) |
7553 (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) | 7552 (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) |
7560 (put 'orgtbl-mode :menu-tag "Org Table Mode") | 7559 (put 'orgtbl-mode :menu-tag "Org Table Mode") |
7561 (add-minor-mode 'orgtbl-mode " OrgTbl" orgtbl-mode-map) | 7560 (add-minor-mode 'orgtbl-mode " OrgTbl" orgtbl-mode-map) |
7562 | 7561 |
7563 (defun orgtbl-make-binding (fun n &rest keys) | 7562 (defun orgtbl-make-binding (fun n &rest keys) |
7564 "Create a function for binding in the table minor mode. | 7563 "Create a function for binding in the table minor mode. |
7565 FUN is the command to call inside a table. N is used to create a unique | 7564 FUN is the command to call inside a table. N is used to create a unique |
7566 command name. KEYS are keys that should be checked in for a command | 7565 command name. KEYS are keys that should be checked in for a command |
7567 to execute outside of tables." | 7566 to execute outside of tables." |
7568 (eval | 7567 (eval |
7569 (list 'defun | 7568 (list 'defun |
7570 (intern (concat "orgtbl-hijacker-command-" (int-to-string n))) | 7569 (intern (concat "orgtbl-hijacker-command-" (int-to-string n))) |
7571 '(arg) | 7570 '(arg) |
7572 (concat "In tables, run `" (symbol-name fun) "'.\n" | 7571 (concat "In tables, run `" (symbol-name fun) "'.\n" |
7573 "Outside of tables, run the binding of `" | 7572 "Outside of tables, run the binding of `" |
7574 (mapconcat (lambda (x) (format "%s" x)) keys "' or `") | 7573 (mapconcat (lambda (x) (format "%s" x)) keys "' or `") |
7586 '('orgtbl-error)))))))) | 7585 '('orgtbl-error)))))))) |
7587 | 7586 |
7588 (defun orgtbl-error () | 7587 (defun orgtbl-error () |
7589 "Error when there is no default binding for a table key." | 7588 "Error when there is no default binding for a table key." |
7590 (interactive) | 7589 (interactive) |
7591 (error "This key is has no function outside tables")) | 7590 (error "This key has no function outside tables")) |
7592 | 7591 |
7593 (defun orgtbl-setup () | 7592 (defun orgtbl-setup () |
7594 "Setup orgtbl keymaps." | 7593 "Setup orgtbl keymaps." |
7595 (let ((nfunc 0) | 7594 (let ((nfunc 0) |
7596 (bindings | 7595 (bindings |
7626 (setq key (car elt) | 7625 (setq key (car elt) |
7627 fun (nth 1 elt) | 7626 fun (nth 1 elt) |
7628 cmd (orgtbl-make-binding fun nfunc key)) | 7627 cmd (orgtbl-make-binding fun nfunc key)) |
7629 (define-key orgtbl-mode-map key cmd)) | 7628 (define-key orgtbl-mode-map key cmd)) |
7630 ;; Special treatment needed for TAB and RET | 7629 ;; Special treatment needed for TAB and RET |
7631 (define-key orgtbl-mode-map [(return)] | 7630 (define-key orgtbl-mode-map [(return)] |
7632 (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m")) | 7631 (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m")) |
7633 (define-key orgtbl-mode-map "\C-m" | 7632 (define-key orgtbl-mode-map "\C-m" |
7634 (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)])) | 7633 (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)])) |
7635 (define-key orgtbl-mode-map [(tab)] | 7634 (define-key orgtbl-mode-map [(tab)] |
7636 (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i")) | 7635 (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i")) |
7637 (define-key orgtbl-mode-map "\C-i" | 7636 (define-key orgtbl-mode-map "\C-i" |
7638 (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)]))) | 7637 (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)]))) |
7639 (when orgtbl-optimized | 7638 (when orgtbl-optimized |
7640 ;; If the user wants maximum table support, we need to hijack | 7639 ;; If the user wants maximum table support, we need to hijack |
7678 ["Eval Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="] | 7677 ["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 ="] | 7678 ["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 *"] | 7679 ["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 *"] | 7680 ["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 #"] | 7681 ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"] |
7683 ["Sum Column/Rectangle" org-table-sum | 7682 ["Sum Column/Rectangle" org-table-sum |
7684 :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"] | 7683 :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 ?"] | 7684 ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"] |
7686 ["Debug Formulas" | 7685 ["Debug Formulas" |
7687 (setq org-table-formula-debug (not org-table-formula-debug)) | 7686 (setq org-table-formula-debug (not org-table-formula-debug)) |
7688 :style toggle :selected org-table-formula-debug] | 7687 :style toggle :selected org-table-formula-debug] |
8260 and all options lines." | 8259 and all options lines." |
8261 (interactive) | 8260 (interactive) |
8262 (let* ((filename (concat (file-name-sans-extension (buffer-file-name)) | 8261 (let* ((filename (concat (file-name-sans-extension (buffer-file-name)) |
8263 ".txt")) | 8262 ".txt")) |
8264 (buffer (find-file-noselect filename)) | 8263 (buffer (find-file-noselect filename)) |
8265 (ore (concat | 8264 (ore (concat |
8266 (org-make-options-regexp | 8265 (org-make-options-regexp |
8267 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" | 8266 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" |
8268 "STARTUP" "ARCHIVE" | 8267 "STARTUP" "ARCHIVE" |
8269 "TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE")) | 8268 "TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE")) |
8270 (if org-noutline-p "\\(\n\\|$\\)" ""))) | 8269 (if org-noutline-p "\\(\n\\|$\\)" ""))) |
8492 (mapcar '(lambda (line) | 8491 (mapcar '(lambda (line) |
8493 (if (string-match org-todo-line-regexp line) | 8492 (if (string-match org-todo-line-regexp line) |
8494 ;; This is a headline | 8493 ;; This is a headline |
8495 (progn | 8494 (progn |
8496 (setq level (- (match-end 1) (match-beginning 1)) | 8495 (setq level (- (match-end 1) (match-beginning 1)) |
8497 txt (save-match-data | 8496 txt (save-match-data |
8498 (org-html-expand | 8497 (org-html-expand |
8499 (match-string 3 line))) | 8498 (match-string 3 line))) |
8500 todo | 8499 todo |
8501 (or (and (match-beginning 2) | 8500 (or (and (match-beginning 2) |
8502 (not (equal (match-string 2 line) | 8501 (not (equal (match-string 2 line) |
8679 (org-format-table-table-html lines) | 8678 (org-format-table-table-html lines) |
8680 ;; Need to use the code generator in table.el, with the original text. | 8679 ;; Need to use the code generator in table.el, with the original text. |
8681 (org-format-table-table-html-using-table-generate-source olines))))) | 8680 (org-format-table-table-html-using-table-generate-source olines))))) |
8682 | 8681 |
8683 (defun org-format-org-table-html (lines) | 8682 (defun org-format-org-table-html (lines) |
8684 "Format a table into html." | 8683 "Format a table into HTML." |
8685 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) | 8684 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) |
8686 (setq lines (nreverse lines)) | 8685 (setq lines (nreverse lines)) |
8687 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) | 8686 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) |
8688 (setq lines (nreverse lines)) | 8687 (setq lines (nreverse lines)) |
8689 (let ((head (and org-export-highlight-first-table-line | 8688 (let ((head (and org-export-highlight-first-table-line |
8722 (if (not (eq (aref newstr i) ?|)) | 8721 (if (not (eq (aref newstr i) ?|)) |
8723 (aset newstr i ?\ ))) | 8722 (aset newstr i ?\ ))) |
8724 newstr)) | 8723 newstr)) |
8725 | 8724 |
8726 (defun org-format-table-table-html (lines) | 8725 (defun org-format-table-table-html (lines) |
8727 "Format a table generated by table.el into html. | 8726 "Format a table generated by table.el into HTML. |
8728 This conversion does *not* use `table-generate-source' from table.el. | 8727 This conversion does *not* use `table-generate-source' from table.el. |
8729 This has the advantage that Org-mode's HTML conversions can be used. | 8728 This has the advantage that Org-mode's HTML conversions can be used. |
8730 But it has the disadvantage, that no cell- or row-spanning is allowed." | 8729 But it has the disadvantage, that no cell- or row-spanning is allowed." |
8731 (let (line field-buffer | 8730 (let (line field-buffer |
8732 (head org-export-highlight-first-table-line) | 8731 (head org-export-highlight-first-table-line) |
8766 (setq field-buffer fields)))) | 8765 (setq field-buffer fields)))) |
8767 (setq html (concat html "</table>\n")) | 8766 (setq html (concat html "</table>\n")) |
8768 html)) | 8767 html)) |
8769 | 8768 |
8770 (defun org-format-table-table-html-using-table-generate-source (lines) | 8769 (defun org-format-table-table-html-using-table-generate-source (lines) |
8771 "Format a table into html, using `table-generate-source' from table.el. | 8770 "Format a table into HTML, using `table-generate-source' from table.el. |
8772 This has the advantage that cell- or row-spanning is allowed. | 8771 This has the advantage that cell- or row-spanning is allowed. |
8773 But it has the disadvantage, that Org-mode's HTML conversions cannot be used." | 8772 But it has the disadvantage, that Org-mode's HTML conversions cannot be used." |
8774 (require 'table) | 8773 (require 'table) |
8775 (with-current-buffer (get-buffer-create " org-tmp1 ") | 8774 (with-current-buffer (get-buffer-create " org-tmp1 ") |
8776 (erase-buffer) | 8775 (erase-buffer) |
9107 reduced column width." | 9106 reduced column width." |
9108 (interactive "p") | 9107 (interactive "p") |
9109 (if (and (org-table-p) | 9108 (if (and (org-table-p) |
9110 (eq N 1) | 9109 (eq N 1) |
9111 (string-match "|" (buffer-substring (point-at-bol) (point))) | 9110 (string-match "|" (buffer-substring (point-at-bol) (point))) |
9112 (looking-at ".*?|")) | 9111 (looking-at ".*?|")) |
9113 (let ((pos (point))) | 9112 (let ((pos (point))) |
9114 (backward-delete-char N) | 9113 (backward-delete-char N) |
9115 (skip-chars-forward "^|") | 9114 (skip-chars-forward "^|") |
9116 (insert " ") | 9115 (insert " ") |
9117 (goto-char (1- pos))) | 9116 (goto-char (1- pos))) |
9239 (t (org-priority-down)))) | 9238 (t (org-priority-down)))) |
9240 | 9239 |
9241 (defun org-copy-special () | 9240 (defun org-copy-special () |
9242 "Call either `org-table-copy' or `org-copy-subtree'." | 9241 "Call either `org-table-copy' or `org-copy-subtree'." |
9243 (interactive) | 9242 (interactive) |
9244 (call-interactively | 9243 (call-interactively |
9245 (if (org-at-table-p) 'org-table-copy-region 'org-copy-subtree))) | 9244 (if (org-at-table-p) 'org-table-copy-region 'org-copy-subtree))) |
9246 | 9245 |
9247 (defun org-cut-special () | 9246 (defun org-cut-special () |
9248 "Call either `org-table-copy' or `org-cut-subtree'." | 9247 "Call either `org-table-copy' or `org-cut-subtree'." |
9249 (interactive) | 9248 (interactive) |
9260 (defun org-ctrl-c-ctrl-c (&optional arg) | 9259 (defun org-ctrl-c-ctrl-c (&optional arg) |
9261 "Call realign table, or recognize a table.el table, or update keywords. | 9260 "Call realign table, or recognize a table.el table, or update keywords. |
9262 When the cursor is inside a table created by the table.el package, | 9261 When the cursor is inside a table created by the table.el package, |
9263 activate that table. Otherwise, if the cursor is at a normal table | 9262 activate that table. Otherwise, if the cursor is at a normal table |
9264 created with org.el, re-align that table. This command works even if | 9263 created with org.el, re-align that table. This command works even if |
9265 the automatic table editor has been turned off. | 9264 the automatic table editor has been turned off. |
9266 If the cursor is in one of the special #+KEYWORD lines, this triggers | 9265 If the cursor is in one of the special #+KEYWORD lines, this triggers |
9267 scanning the buffer for these lines and updating the information." | 9266 scanning the buffer for these lines and updating the information." |
9268 (interactive "P") | 9267 (interactive "P") |
9269 (let ((org-enable-table-editor t)) | 9268 (let ((org-enable-table-editor t)) |
9270 (cond | 9269 (cond |
9349 ["Eval Formula" org-table-eval-formula (org-at-table-p)] | 9348 ["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 ="] | 9349 ["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)] | 9350 ["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 *"] | 9351 ["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)] | 9352 ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)] |
9354 ["Sum Column/Rectangle" org-table-sum | 9353 ["Sum Column/Rectangle" org-table-sum |
9355 (or (org-at-table-p) (org-region-active-p))] | 9354 (or (org-at-table-p) (org-region-active-p))] |
9356 ["Which Column?" org-table-current-column (org-at-table-p)]) | 9355 ["Which Column?" org-table-current-column (org-at-table-p)]) |
9357 ["Debug Formulas" | 9356 ["Debug Formulas" |
9358 (setq org-table-formula-debug (not org-table-formula-debug)) | 9357 (setq org-table-formula-debug (not org-table-formula-debug)) |
9359 :style toggle :selected org-table-formula-debug] | 9358 :style toggle :selected org-table-formula-debug] |
9459 (interactive) | 9458 (interactive) |
9460 (require 'info) | 9459 (require 'info) |
9461 (Info-goto-node (format "(org)%s" (or node "")))) | 9460 (Info-goto-node (format "(org)%s" (or node "")))) |
9462 | 9461 |
9463 (defun org-install-agenda-files-menu () | 9462 (defun org-install-agenda-files-menu () |
9464 (easy-menu-change | 9463 (easy-menu-change |
9465 '("Org") "File List for Agenda" | 9464 '("Org") "File List for Agenda" |
9466 (append | 9465 (append |
9467 (list | 9466 (list |
9468 ["Edit File List" (customize-variable 'org-agenda-files) t] | 9467 ["Edit File List" (customize-variable 'org-agenda-files) t] |
9469 ["Add Current File to List" org-add-file t] | 9468 ["Add Current File to List" org-add-file t] |
9470 ["Remove Current File from List" org-remove-file t] | 9469 ["Remove Current File from List" org-remove-file t] |
9471 "--") | 9470 "--") |
9472 (mapcar 'org-file-menu-entry org-agenda-files)))) | 9471 (mapcar 'org-file-menu-entry org-agenda-files)))) |
9473 | 9472 |
9474 ;;; Documentation | 9473 ;;; Documentation |
9475 | 9474 |
9476 (defun org-customize () | 9475 (defun org-customize () |
9477 "Call the customize function with org as argument." | 9476 "Call the customize function with `org' as argument." |
9478 (interactive) | 9477 (interactive) |
9479 (customize-browse 'org)) | 9478 (customize-browse 'org)) |
9480 | 9479 |
9481 (defun org-create-customize-menu () | 9480 (defun org-create-customize-menu () |
9482 "Create a full customization menu for Org-mode, insert it into the menu." | 9481 "Create a full customization menu for Org-mode, insert it into the menu." |
9577 "\\'")))) | 9576 "\\'")))) |
9578 | 9577 |
9579 ;; Functions needed for compatibility with old outline.el | 9578 ;; Functions needed for compatibility with old outline.el |
9580 | 9579 |
9581 ;; The following functions capture almost the entire compatibility code | 9580 ;; The following functions capture almost the entire compatibility code |
9582 ;; between the different versions of outline-mode. The only other place | 9581 ;; between the different versions of outline-mode. The only other place |
9583 ;; where this is important are the font-lock-keywords. Search for | 9582 ;; where this is important are the font-lock-keywords. Search for |
9584 ;; `org-noutline-p' to find it. | 9583 ;; `org-noutline-p' to find it. |
9585 | 9584 |
9586 ;; C-a should go to the beginning of a *visible* line, also in the | 9585 ;; C-a should go to the beginning of a *visible* line, also in the |
9587 ;; new outline.el. I guess this should be patched into Emacs? | 9586 ;; new outline.el. I guess this should be patched into Emacs? |
9611 (save-excursion | 9610 (save-excursion |
9612 (skip-chars-backward "^\r\n") | 9611 (skip-chars-backward "^\r\n") |
9613 (equal (char-before) ?\r)))) | 9612 (equal (char-before) ?\r)))) |
9614 | 9613 |
9615 (defun org-back-to-heading (&optional invisible-ok) | 9614 (defun org-back-to-heading (&optional invisible-ok) |
9616 "Move to previous heading line, or beg of this line if it's a heading. | 9615 "Move to previous heading line, or beginning of this line if it's a heading. |
9617 Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." | 9616 Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." |
9618 (if org-noutline-p | 9617 (if org-noutline-p |
9619 (outline-back-to-heading invisible-ok) | 9618 (outline-back-to-heading invisible-ok) |
9620 (if (looking-at outline-regexp) | 9619 (if (looking-at outline-regexp) |
9621 t | 9620 t |
9642 (defun org-up-heading-all (arg) | 9641 (defun org-up-heading-all (arg) |
9643 "Move to the heading line of which the present line is a subheading. | 9642 "Move to the heading line of which the present line is a subheading. |
9644 This function considers both visible and invisible heading lines. | 9643 This function considers both visible and invisible heading lines. |
9645 With argument, move up ARG levels." | 9644 With argument, move up ARG levels." |
9646 (if org-noutline-p | 9645 (if org-noutline-p |
9647 (if (fboundp 'outline-up-heading-all) | 9646 (if (fboundp 'outline-up-heading-all) |
9648 (outline-up-heading-all arg) ; emacs 21 version of outline.el | 9647 (outline-up-heading-all arg) ; emacs 21 version of outline.el |
9649 (outline-up-heading arg t)) ; emacs 22 version of outline.el | 9648 (outline-up-heading arg t)) ; emacs 22 version of outline.el |
9650 (org-back-to-heading t) | 9649 (org-back-to-heading t) |
9651 (looking-at outline-regexp) | 9650 (looking-at outline-regexp) |
9652 (if (<= (- (match-end 0) (match-beginning 0)) arg) | 9651 (if (<= (- (match-end 0) (match-beginning 0)) arg) |
9698 flag | 9697 flag |
9699 (if flag ?\r ?\n)))))) | 9698 (if flag ?\r ?\n)))))) |
9700 | 9699 |
9701 (defun org-show-subtree () | 9700 (defun org-show-subtree () |
9702 "Show everything after this heading at deeper levels." | 9701 "Show everything after this heading at deeper levels." |
9703 (outline-flag-region | 9702 (outline-flag-region |
9704 (point) | 9703 (point) |
9705 (save-excursion | 9704 (save-excursion |
9706 (outline-end-of-subtree) (outline-next-heading) (point)) | 9705 (outline-end-of-subtree) (outline-next-heading) (point)) |
9707 (if org-noutline-p nil ?\n))) | 9706 (if org-noutline-p nil ?\n))) |
9708 | 9707 |
9709 (defun org-show-entry () | 9708 (defun org-show-entry () |
9710 "Show the body directly following this heading. | 9709 "Show the body directly following this heading. |
9711 Show the heading too, if it is currently invisible." | 9710 Show the heading too, if it is currently invisible." |
9712 (interactive) | 9711 (interactive) |
9713 (save-excursion | 9712 (save-excursion |
9714 (org-back-to-heading t) | 9713 (org-back-to-heading t) |
9715 (outline-flag-region | 9714 (outline-flag-region |
9716 (1- (point)) | 9715 (1- (point)) |
9717 (save-excursion | 9716 (save-excursion |
9718 (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) | 9717 (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) |
9719 (or (match-beginning 1) (point-max))) | 9718 (or (match-beginning 1) (point-max))) |
9720 (if org-noutline-p nil ?\n)))) | 9719 (if org-noutline-p nil ?\n)))) |