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