Mercurial > emacs
comparison lisp/textmodes/org.el @ 62546:153ddc124932
(org-agenda-toggle-time-grid): New command.
(org-agenda-use-time-grid, org-agenda-time-grid): New options.
(org-agenda-add-time-grid-maybe): New function.
(org-agenda): Call `org-agenda-add-time-grid-maybe'.
(org-table-create): `dotimes' instead of `mapcar'.
(org-xor): Simplified implementation.
(org-agenda): `inhibit-redisplay' turned on.
(org-agenda-change-all-lines): Use `org-format-agenda-item' to get
a consistent line after a state change.
(org-agenda-remove-times-when-in-prefix): New option.
(org-prefix-has-time): New variable.
(org-parse-time-string): Optional argument NODEFAULT.
(org-format-agenda-item): Parse items for time-of-day
specifications and move these into the prefix if possible.
(org-agenda-priority): Get current heading, not previous heading
during agenda remote editing.
author | Carsten Dominik <dominik@science.uva.nl> |
---|---|
date | Fri, 20 May 2005 11:24:48 +0000 |
parents | fab4f3bb60e0 |
children | b9935dc86aa4 5b029ff3b08d |
comparison
equal
deleted
inserted
replaced
62545:bea5728f69fa | 62546:153ddc124932 |
---|---|
3 ;; Copyright (c) 2004, 2005 Free Software Foundation | 3 ;; Copyright (c) 2004, 2005 Free Software Foundation |
4 ;; | 4 ;; |
5 ;; Author: Carsten Dominik <dominik at science dot uva dot nl> | 5 ;; Author: Carsten Dominik <dominik at science dot uva dot nl> |
6 ;; Keywords: outlines, hypermedia, calendar | 6 ;; Keywords: outlines, hypermedia, calendar |
7 ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ | 7 ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ |
8 ;; Version: 3.08 | 8 ;; Version: 3.09 |
9 ;; | 9 ;; |
10 ;; This file is part of GNU Emacs. | 10 ;; This file is part of GNU Emacs. |
11 ;; | 11 ;; |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | 12 ;; GNU Emacs is free software; you can redistribute it and/or modify |
13 ;; it under the terms of the GNU General Public License as published by | 13 ;; it under the terms of the GNU General Public License as published by |
29 ;; | 29 ;; |
30 ;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing | 30 ;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing |
31 ;; project planning with a fast and effective plain-text system. | 31 ;; project planning with a fast and effective plain-text system. |
32 ;; | 32 ;; |
33 ;; Org-mode develops organizational tasks around a NOTES file that contains | 33 ;; Org-mode develops organizational tasks around a NOTES file that contains |
34 ;; information about projects as plain text. Org-mode is implemented on | 34 ;; information about projects as plain text. Org-mode is implemented on top |
35 ;; top of outline-mode - ideal to keep the content of large files well | 35 ;; of outline-mode - ideal to keep the content of large files well structured. |
36 ;; structured. It supports ToDo items, deadlines and time stamps, which | 36 ;; It supports ToDo items, deadlines and time stamps, which can be extracted |
37 ;; magically appear in the diary listing of the Emacs calendar. Tables are | 37 ;; to create a daily/weekly agenda that also integrates the diary of the Emacs |
38 ;; easily created with a built-in table editor. Plain text URL-like links | 38 ;; calendar. Tables are easily created with a built-in table editor. Plain |
39 ;; connect to websites, emails (VM,RMAIL,WANDERLUST), Usenet messages (Gnus), | 39 ;; text URL-like links connect to websites, emails (VM, RMAIL, WANDERLUST), |
40 ;; BBDB entries, and any files related to the projects. For printing and | 40 ;; Usenet messages (Gnus), BBDB entries, and any files related to the |
41 ;; sharing of notes, an Org-mode file (or a part of it) can be exported as | 41 ;; projects. For printing and sharing of notes, an Org-mode file (or a part |
42 ;; a structured ASCII file, or as HTML. | 42 ;; of it) can be exported as a structured ASCII file, or as HTML. |
43 ;; | 43 ;; |
44 ;; Installation | 44 ;; Installation |
45 ;; ------------ | 45 ;; ------------ |
46 ;; The instruction below assume that you have downloaded Org-mode from the | 46 ;; If Org-mode is part of the Emacs distribution or an XEmacs package, you |
47 ;; web. If Org-mode is part of the Emacs distribution or an XEmacs package, | 47 ;; only need to copy the following lines to your .emacs file. The last two |
48 ;; you only need to add to .emacs the last three lines of Lisp code listed | 48 ;; lines define *global* keys for the commands `org-store-link' and |
49 ;; below, i.e. the `auto-mode-alist' modification and the global key bindings. | 49 ;; `org-agenda' - please choose suitable keys yourself. |
50 ;; | 50 ;; |
51 ;; Byte-compile org.el and put it on your load path. Then copy the | 51 ;; (add-to-list 'auto-mode-alist '("\\.org$" . org-mode)) |
52 ;; following lines into .emacs. The last two lines define *global* | 52 ;; (define-key global-map "\C-cl" 'org-store-link) |
53 ;; keys for the commands `org-store-link' and `org-agenda' - please | 53 ;; (define-key global-map "\C-ca" 'org-agenda) |
54 ;; choose suitable keys yourself. | 54 ;; |
55 ;; If you have downloaded Org-mode from the Web, you must byte-compile | |
56 ;; org.el and put it on your load path. In addition to the Emacs Lisp | |
57 ;; lines above, you also need to add the following lines to .emacs: | |
55 ;; | 58 ;; |
56 ;; (autoload 'org-mode "org" "Org mode" t) | 59 ;; (autoload 'org-mode "org" "Org mode" t) |
57 ;; (autoload 'org-diary "org" "Diary entries from Org mode") | 60 ;; (autoload 'org-diary "org" "Diary entries from Org mode") |
58 ;; (autoload 'org-agenda "org" "Multi-file agenda from Org mode" t) | 61 ;; (autoload 'org-agenda "org" "Multi-file agenda from Org mode" t) |
59 ;; (autoload 'org-store-link "org" "Store a link to the current location" t) | 62 ;; (autoload 'org-store-link "org" "Store a link to the current location" t) |
60 ;; (autoload 'orgtbl-mode "org" "Org tables as a minor mode" t) | 63 ;; (autoload 'orgtbl-mode "org" "Org tables as a minor mode" t) |
61 ;; (autoload 'turn-on-orgtbl "org" "Org tables as a minor mode") | 64 ;; (autoload 'turn-on-orgtbl "org" "Org tables as a minor mode") |
62 ;; (add-to-list 'auto-mode-alist '("\\.org$" . org-mode)) | |
63 ;; (define-key global-map "\C-cl" 'org-store-link) | |
64 ;; (define-key global-map "\C-ca" 'org-agenda) | |
65 ;; | 65 ;; |
66 ;; This will put all files with extension ".org" into Org-mode. As an | 66 ;; This setup will put all files with extension ".org" into Org-mode. As |
67 ;; alternative, make the first line of a file look like this: | 67 ;; an alternative, make the first line of a file look like this: |
68 ;; | 68 ;; |
69 ;; MY PROJECTS -*- mode: org; -*- | 69 ;; MY PROJECTS -*- mode: org; -*- |
70 ;; | 70 ;; |
71 ;; which will select Org-mode for this buffer no matter what the file's | 71 ;; which will select Org-mode for this buffer no matter what the file's |
72 ;; name is. | 72 ;; name is. |
73 ;; | 73 ;; |
74 ;; Documentation | 74 ;; Documentation |
75 ;; ------------- | 75 ;; ------------- |
76 ;; The documentation of Org-mode can be found in the TeXInfo file. | 76 ;; The documentation of Org-mode can be found in the TeXInfo file. The |
77 ;; The distribution also contains a PDF version of it. At the homepage | 77 ;; distribution also contains a PDF version of it. At the homepage of |
78 ;; of Org-mode, you can read the same text online as HTML. | 78 ;; Org-mode, you can read the same text online as HTML. There is also an |
79 ;; excellent reference card made by Philip Rooke. | |
79 ;; | 80 ;; |
80 ;; Changes: | 81 ;; Changes: |
81 ;; ------- | 82 ;; ------- |
83 ;; Version 3.09 | |
84 ;; - Time-of-day specifications in agenda are extracted and placed | |
85 ;; into the prefix. Timed entries can be placed into a time grid for | |
86 ;; day. | |
87 ;; | |
82 ;; Version 3.08 | 88 ;; Version 3.08 |
83 ;; - "|" no longer allowed as part of a link, to allow links in tables. | 89 ;; - "|" no longer allowed as part of a link, to allow links in tables. |
84 ;; - The prefix of items in the agenda buffer can be configured. | 90 ;; - The prefix of items in the agenda buffer can be configured. |
85 ;; - Cleanup. | 91 ;; - Cleanup. |
86 ;; | 92 ;; |
134 ;; - New reference card, thanks to Philip Rooke for creating it. | 140 ;; - New reference card, thanks to Philip Rooke for creating it. |
135 ;; - Single file agenda renamed to "Timeline". It no longer shows | 141 ;; - Single file agenda renamed to "Timeline". It no longer shows |
136 ;; warnings about upcoming deadlines/overdue scheduled items. | 142 ;; warnings about upcoming deadlines/overdue scheduled items. |
137 ;; That functionality is now limited to the (multifile) agenda. | 143 ;; That functionality is now limited to the (multifile) agenda. |
138 ;; - When reading a date, the calendar can be manipulated with keys. | 144 ;; - When reading a date, the calendar can be manipulated with keys. |
139 ;; - Link support for RMAIL and Wanderlust (from planner.el, untested) | 145 ;; - Link support for RMAIL and Wanderlust (from planner.el, untested). |
140 ;; - Minor bug fixes and documentation improvements. | 146 ;; - Minor bug fixes and documentation improvements. |
141 | 147 |
142 ;;; Code: | 148 ;;; Code: |
143 | 149 |
144 (eval-when-compile (require 'cl) (require 'calendar)) | 150 (eval-when-compile (require 'cl) (require 'calendar)) |
146 (require 'time-date) | 152 (require 'time-date) |
147 (require 'easymenu) | 153 (require 'easymenu) |
148 | 154 |
149 ;;; Customization variables | 155 ;;; Customization variables |
150 | 156 |
151 (defvar org-version "3.08" | 157 (defvar org-version "3.09" |
152 "The version number of the file org.el.") | 158 "The version number of the file org.el.") |
153 (defun org-version () | 159 (defun org-version () |
154 (interactive) | 160 (interactive) |
155 (message "Org-mode version %s" org-version)) | 161 (message "Org-mode version %s" org-version)) |
156 | 162 |
157 ;; The following two constants are for compatibility with different | 163 ;; The following two constants are for compatibility with different Emacs |
158 ;; Emacs versions (Emacs versus XEmacs) and with different versions of | 164 ;; versions (Emacs versus XEmacs) and with different versions of outline.el. |
159 ;; outline.el. All the compatibility code in org.el is based on these two | 165 ;; The compatibility code in org.el is based on these two constants. |
160 ;; constants. | |
161 (defconst org-xemacs-p (featurep 'xemacs) | 166 (defconst org-xemacs-p (featurep 'xemacs) |
162 "Are we running xemacs?") | 167 "Are we running xemacs?") |
163 (defconst org-noutline-p (featurep 'noutline) | 168 (defconst org-noutline-p (featurep 'noutline) |
164 "Are we using the new outline mode?") | 169 "Are we using the new outline mode?") |
165 | 170 |
568 agenda listing for the day. Of the entries without a time indication, keep | 573 agenda listing for the day. Of the entries without a time indication, keep |
569 the grouped in categories, don't sort the categories, but keep them in | 574 the grouped in categories, don't sort the categories, but keep them in |
570 the sequence given in `org-agenda-files'. Within each category sort by | 575 the sequence given in `org-agenda-files'. Within each category sort by |
571 priority. | 576 priority. |
572 | 577 |
573 Leaving out the `category-keep' would mean that items will be sorted across | 578 Leaving out `category-keep' would mean that items will be sorted across |
574 categories by priority." | 579 categories by priority." |
575 :group 'org-agenda | 580 :group 'org-agenda |
576 :type '(repeat | 581 :type '(repeat |
577 (choice | 582 (choice |
578 (const time-up) | 583 (const time-up) |
581 (const category-up) | 586 (const category-up) |
582 (const category-down) | 587 (const category-down) |
583 (const priority-up) | 588 (const priority-up) |
584 (const priority-down)))) | 589 (const priority-down)))) |
585 | 590 |
586 (defcustom org-agenda-prefix-format " %-12:c% s" | 591 (defcustom org-agenda-prefix-format " %-12:c%?-12t% s" |
587 "Format specification for the prefix of items in the agenda buffer. | 592 "Format specification for the prefix of items in the agenda buffer. |
588 This format works similar to a printf format, with the following meaning: | 593 This format works similar to a printf format, with the following meaning: |
589 | 594 |
590 %c the category of the item, \"Diary\" for entries from the diary, or | 595 %c the category of the item, \"Diary\" for entries from the diary, or |
591 as given by the CATEGORY keyword or derived from the file name. | 596 as given by the CATEGORY keyword or derived from the file name. |
592 %t the time-of-day specification if one applies to the entry, in the | 597 %t the time-of-day specification if one applies to the entry, in the |
593 format HH:MM | 598 format HH:MM |
594 %s Scheduling/Deadline information, a short string | 599 %s Scheduling/Deadline information, a short string |
595 | 600 |
596 In addition to the normal printf field modifiers like field width and | 601 All specifiers work basically like the standard `%s' of printf, but may |
597 padding instructions, in this format you can also add an additional | 602 contain two additional characters: A question mark just after the `%' and |
598 punctuation or whitespace character just before the final format letter. | 603 a whitespace/punctuation character just before the final letter. |
599 This character will be appended to the field value if the value is not | 604 |
600 empty. For example, the format \"%-12:c\" leads to \"Diary: \" if | 605 If the first character after `%' is a question mark, the entire field |
601 the category is \"Diary\". If the category were be empty, no additional | 606 will only be included if the corresponding value applies to the |
602 colon would be interted. | 607 current entry. This is useful for fields which should have fixed |
603 | 608 width when present, but zero width when absent. For example, |
604 Including `%t' in the format string leads to a double time specification | 609 \"%?-12t\" will result in a 12 character time field if a time of the |
605 because the headline/diary item will contain the time specification as | 610 day is specified, but will completely disappear in entries which do |
606 well. However, using `%t' in the format will result in a canonical 24 | 611 not contain a time. |
607 hour time specification at a consistent position in the prefix, while the | 612 |
608 time specification in the headline/diary item may be at any position and in | 613 If there is punctuation or whitespace character just before the final |
609 various formats. | 614 format letter, this character will be appended to the field value if |
610 Example: | 615 the value is not empty. For example, the format \"%-12:c\" leads to |
611 (setq org-agenda-prefix-format \" %-12:c% t% s\")" | 616 \"Diary: \" if the category is \"Diary\". If the category were be |
617 empty, no additional colon would be interted. | |
618 | |
619 The default value of this option is \" %-12:c%?-12t% s\", meaning: | |
620 - Indent the line with two space characters | |
621 - Give the category in a 12 chars wide field, padded with whitespace on | |
622 the right (because of `-'). Append a colon if there is a category | |
623 (because of `:'). | |
624 - If there is a time-of-day, put it into a 12 chars wide field. If no | |
625 time, don't put in an empty field, just skip it (because of '?'). | |
626 - Finally, put the scheduling information and append a whitespace. | |
627 | |
628 As another example, if you don't want the time-of-day of entries in | |
629 the prefix, you could use: | |
630 | |
631 (setq org-agenda-prefix-format \" %-11:c% s\") | |
632 | |
633 See also the variable `org-agenda-remove-times-when-in-prefix'." | |
612 :type 'string | 634 :type 'string |
613 :group 'org-agenda) | 635 :group 'org-agenda) |
614 | 636 |
615 (defcustom org-timeline-prefix-format " % s" | 637 (defcustom org-timeline-prefix-format " % s" |
616 "Like `org-agenda-prefix-format', but for the timeline of a single file." | 638 "Like `org-agenda-prefix-format', but for the timeline of a single file." |
617 :type 'string | 639 :type 'string |
618 :group 'org-agenda) | 640 :group 'org-agenda) |
619 | 641 |
620 (defvar org-prefix-format-compiled nil | 642 (defvar org-prefix-format-compiled nil |
621 "The compiled version of `org-???-prefix-format'.") | 643 "The compiled version of the most recently used prefix format. |
644 Depending on which command was used last, this may be the compiled version | |
645 of `org-agenda-prefix-format' or `org-timeline-prefix-format'.") | |
646 | |
647 (defcustom org-agenda-use-time-grid t | |
648 "Non-nil means, show a time grid in the agenda schedule. | |
649 A time grid is a set of lines for specific times (like every two hours between | |
650 8:00 and 20:00. The items scheduled for a day at specific times are | |
651 sorted in between these lines. | |
652 For deails about when the grid will be shown, and what it will look like, see | |
653 the variable `org-agenda-time-grid'." | |
654 :group 'org-agenda | |
655 :type 'boolean) | |
656 | |
657 (defcustom org-agenda-time-grid | |
658 '((daily today require-timed) | |
659 "----------------" | |
660 (800 1000 1200 1400 1600 1800 2000)) | |
661 | |
662 "FIXME: document" | |
663 :group 'org-agenda | |
664 :type | |
665 '(list | |
666 (set :greedy t :tag "Grid Display Options" | |
667 (const :tag "Show grid in single day agenda display" daily) | |
668 (const :tag "Show grid in weekly agenda display" weekly) | |
669 (const :tag "Always show grid for today" today) | |
670 (const :tag "Show grid only if any timed entries are present" | |
671 require-timed) | |
672 (const :tag "Skip grid times already present in an entry" | |
673 remove-match)) | |
674 (string :tag "Grid String") | |
675 (repeat :tag "Grid Times" (integer :tag "Time")))) | |
676 | |
677 (defcustom org-agenda-remove-times-when-in-prefix t | |
678 "Non-nil means, remove duplicate time specifications in agenda items. | |
679 When the format `org-agenda-prefix-format' contains a `%t' specifier, a | |
680 time-of-day specification in a headline or diary entry is extracted and | |
681 placed into the prefix. If this option is non-nil, the original specification | |
682 \(a timestamp or -range, or just a plain time(range) specification like | |
683 11:30-4pm) will be removed for agenda display. This makes the agenda less | |
684 cluttered. | |
685 The option can be t or nil. It may also be the symbol `beg', indicating | |
686 that the time should only be removed what it is located at the beginning of | |
687 the headline/diary entry." | |
688 :group 'org-agenda | |
689 :type '(choice | |
690 (const :tag "Always" t) | |
691 (const :tag "Never" nil) | |
692 (const :tag "When at beginning of entry" beg))) | |
622 | 693 |
623 (defcustom org-sort-agenda-notime-is-late t | 694 (defcustom org-sort-agenda-notime-is-late t |
624 "Non-nil means, items without time are considered late. | 695 "Non-nil means, items without time are considered late. |
625 This is only relevant for sorting. When t, items which have no explicit | 696 This is only relevant for sorting. When t, items which have no explicit |
626 time like 15:30 will be considered as 24:01, i.e. later than any items which | 697 time like 15:30 will be considered as 24:01, i.e. later than any items which |
627 do have a time. When nil, the default time is before 0:00." | 698 do have a time. When nil, the default time is before 0:00. You can use this |
699 option to decide if the schedule for today should come before or after timeless | |
700 agenda entries." | |
628 :group 'org-agenda | 701 :group 'org-agenda |
629 :type 'boolean) | 702 :type 'boolean) |
630 | 703 |
631 (defgroup org-structure nil | 704 (defgroup org-structure nil |
632 "Options concerning structure editing in Org-mode." | 705 "Options concerning structure editing in Org-mode." |
1366 '((((type tty) (class color)) (:foreground "blue" :weight bold)) | 1439 '((((type tty) (class color)) (:foreground "blue" :weight bold)) |
1367 (((class color) (background light)) (:foreground "Blue")) | 1440 (((class color) (background light)) (:foreground "Blue")) |
1368 (((class color) (background dark)) (:foreground "LightSkyBlue")) | 1441 (((class color) (background dark)) (:foreground "LightSkyBlue")) |
1369 (t (:inverse-video t :bold t))) | 1442 (t (:inverse-video t :bold t))) |
1370 "Face used for tables." | 1443 "Face used for tables." |
1444 :group 'org-faces) | |
1445 | |
1446 (defface org-time-grid-face ;; font-lock-variable-name-face | |
1447 '((((type tty) (class color)) (:foreground "yellow" :weight light)) | |
1448 (((class color) (background light)) (:foreground "DarkGoldenrod")) | |
1449 (((class color) (background dark)) (:foreground "LightGoldenrod")) | |
1450 (t (:bold t :italic t))) | |
1451 "Face used for level 2 headlines." | |
1371 :group 'org-faces) | 1452 :group 'org-faces) |
1372 | 1453 |
1373 (defvar org-level-faces | 1454 (defvar org-level-faces |
1374 '( | 1455 '( |
1375 org-level-1-face | 1456 org-level-1-face |
1494 (interactive-p) | 1575 (interactive-p) |
1495 (= (point-min) (point-max)))) | 1576 (= (point-min) (point-max)))) |
1496 (save-excursion | 1577 (save-excursion |
1497 (goto-char (point-min)) | 1578 (goto-char (point-min)) |
1498 (insert " -*- mode: org -*-\n\n"))) | 1579 (insert " -*- mode: org -*-\n\n"))) |
1499 (run-hooks 'org-mode-hook) ;FIXME: Should be run-mode-hooks. | 1580 (run-hooks 'org-mode-hook) |
1500 (unless org-inhibit-startup | 1581 (unless org-inhibit-startup |
1501 (if org-startup-with-deadline-check | 1582 (if org-startup-with-deadline-check |
1502 (call-interactively 'org-check-deadlines) | 1583 (call-interactively 'org-check-deadlines) |
1503 (cond | 1584 (cond |
1504 ((eq org-startup-folded t) | 1585 ((eq org-startup-folded t) |
1563 | 1644 |
1564 (defun org-font-lock-level () | 1645 (defun org-font-lock-level () |
1565 (save-excursion | 1646 (save-excursion |
1566 (org-back-to-heading t) | 1647 (org-back-to-heading t) |
1567 (- (match-end 0) (match-beginning 0)))) | 1648 (- (match-end 0) (match-beginning 0)))) |
1568 | 1649 |
1569 (defvar org-font-lock-keywords nil) | 1650 (defvar org-font-lock-keywords nil) |
1570 | 1651 |
1571 (defun org-set-font-lock-defaults () | 1652 (defun org-set-font-lock-defaults () |
1572 (let ((org-font-lock-extra-keywords | 1653 (let ((org-font-lock-extra-keywords |
1573 (list | 1654 (list |
2842 (apply 'format fmt (nreverse l)))) | 2923 (apply 'format fmt (nreverse l)))) |
2843 | 2924 |
2844 (defun org-time-string-to-time (s) | 2925 (defun org-time-string-to-time (s) |
2845 (apply 'encode-time (org-parse-time-string s))) | 2926 (apply 'encode-time (org-parse-time-string s))) |
2846 | 2927 |
2847 (defun org-parse-time-string (s) | 2928 (defun org-parse-time-string (s &optional nodefault) |
2848 "Parse the standard Org-mode time string. | 2929 "Parse the standard Org-mode time string. |
2849 This should be a lot faster than the normal `parse-time-string'." | 2930 This should be a lot faster than the normal `parse-time-string'. |
2931 If time is not given, defaults to 0:00. However, with optional NODEFAULT, | |
2932 hour and minute fields will be nil if not given." | |
2850 (if (string-match org-ts-regexp1 s) | 2933 (if (string-match org-ts-regexp1 s) |
2851 (list 0 | 2934 (list 0 |
2852 (string-to-number (or (match-string 8 s) "0")) | 2935 (if (or (match-beginning 8) (not nodefault)) |
2853 (string-to-number (or (match-string 7 s) "0")) | 2936 (string-to-number (or (match-string 8 s) "0"))) |
2937 (if (or (match-beginning 7) (not nodefault)) | |
2938 (string-to-number (or (match-string 7 s) "0"))) | |
2854 (string-to-number (match-string 4 s)) | 2939 (string-to-number (match-string 4 s)) |
2855 (string-to-number (match-string 3 s)) | 2940 (string-to-number (match-string 3 s)) |
2856 (string-to-number (match-string 2 s)) | 2941 (string-to-number (match-string 2 s)) |
2857 nil nil nil) | 2942 nil nil nil) |
2858 (make-list 9 0))) | 2943 (make-list 9 0))) |
3054 (while l (define-key org-agenda-mode-map | 3139 (while l (define-key org-agenda-mode-map |
3055 (int-to-string (pop l)) 'digit-argument))) | 3140 (int-to-string (pop l)) 'digit-argument))) |
3056 | 3141 |
3057 (define-key org-agenda-mode-map "f" 'org-agenda-follow-mode) | 3142 (define-key org-agenda-mode-map "f" 'org-agenda-follow-mode) |
3058 (define-key org-agenda-mode-map "d" 'org-agenda-toggle-diary) | 3143 (define-key org-agenda-mode-map "d" 'org-agenda-toggle-diary) |
3144 (define-key org-agenda-mode-map "g" 'org-agenda-toggle-time-grid) | |
3059 (define-key org-agenda-mode-map "r" 'org-agenda-redo) | 3145 (define-key org-agenda-mode-map "r" 'org-agenda-redo) |
3060 (define-key org-agenda-mode-map "q" 'org-agenda-quit) | 3146 (define-key org-agenda-mode-map "q" 'org-agenda-quit) |
3061 (define-key org-agenda-mode-map "x" 'org-agenda-exit) | 3147 (define-key org-agenda-mode-map "x" 'org-agenda-exit) |
3062 (define-key org-agenda-mode-map "P" 'org-agenda-show-priority) | 3148 (define-key org-agenda-mode-map "P" 'org-agenda-show-priority) |
3063 (define-key org-agenda-mode-map "n" 'next-line) | 3149 (define-key org-agenda-mode-map "n" 'next-line) |
3113 ["Set Priority" org-agenda-priority t] | 3199 ["Set Priority" org-agenda-priority t] |
3114 ["Increase Priority" org-agenda-priority-up t] | 3200 ["Increase Priority" org-agenda-priority-up t] |
3115 ["Decrease Priority" org-agenda-priority-down t] | 3201 ["Decrease Priority" org-agenda-priority-down t] |
3116 ["Show Priority" org-agenda-show-priority t]) | 3202 ["Show Priority" org-agenda-show-priority t]) |
3117 "--" | 3203 "--" |
3118 ["Rebuild" org-agenda-redo t] | 3204 ["Rebuild buffer" org-agenda-redo t] |
3119 ["Goto Today" org-agenda-goto-today t] | 3205 ["Goto Today" org-agenda-goto-today t] |
3120 ["Next Dates" org-agenda-later (local-variable-p 'starting-day)] | 3206 ["Next Dates" org-agenda-later (local-variable-p 'starting-day)] |
3121 ["Previous Dates" org-agenda-earlier (local-variable-p 'starting-day)] | 3207 ["Previous Dates" org-agenda-earlier (local-variable-p 'starting-day)] |
3122 "--" | 3208 "--" |
3123 ["Week/Day View" org-agenda-toggle-week-view | 3209 ["Week/Day View" org-agenda-toggle-week-view |
3124 (local-variable-p 'starting-day)] | 3210 (local-variable-p 'starting-day)] |
3125 ["Include Diary" org-agenda-toggle-diary | 3211 ["Include Diary" org-agenda-toggle-diary |
3126 :style toggle :selected org-agenda-include-diary :active t] | 3212 :style toggle :selected org-agenda-include-diary :active t] |
3213 ["Use Time Grid" org-agenda-toggle-time-grid | |
3214 :style toggle :selected org-agenda-use-time-grid :active t] | |
3127 "--" | 3215 "--" |
3128 ["New Diary Entry" org-agenda-diary-entry t] | 3216 ["New Diary Entry" org-agenda-diary-entry t] |
3129 ("Calendar Commands" | 3217 ("Calendar Commands" |
3130 ["Goto Calendar" org-agenda-goto-calendar t] | 3218 ["Goto Calendar" org-agenda-goto-calendar t] |
3131 ["Phases of the Moon" org-agenda-phases-of-moon t] | 3219 ["Phases of the Moon" org-agenda-phases-of-moon t] |
3292 (calendar-gregorian-from-absolute sd))) | 3380 (calendar-gregorian-from-absolute sd))) |
3293 (n1 org-agenda-start-on-weekday) | 3381 (n1 org-agenda-start-on-weekday) |
3294 (d (- nt n1))) | 3382 (d (- nt n1))) |
3295 (- sd (+ (if (< d 0) 7 0) d))))) | 3383 (- sd (+ (if (< d 0) 7 0) d))))) |
3296 (day-numbers (list start)) | 3384 (day-numbers (list start)) |
3297 s e rtn rtnall file date d start-pos end-pos) | 3385 (inhibit-redisplay t) |
3386 s e rtn rtnall file date d start-pos end-pos todayp nd) | |
3298 (setq org-agenda-redo-command | 3387 (setq org-agenda-redo-command |
3299 (list 'org-agenda include-all start-day ndays)) | 3388 (list 'org-agenda include-all start-day ndays)) |
3300 ;; Make the list of days | 3389 ;; Make the list of days |
3301 (setq ndays (or ndays org-agenda-ndays)) | 3390 (setq ndays (or ndays org-agenda-ndays) |
3391 nd ndays) | |
3302 (while (> ndays 1) | 3392 (while (> ndays 1) |
3303 (push (1+ (car day-numbers)) day-numbers) | 3393 (push (1+ (car day-numbers)) day-numbers) |
3304 (setq ndays (1- ndays))) | 3394 (setq ndays (1- ndays))) |
3305 (setq day-numbers (nreverse day-numbers)) | 3395 (setq day-numbers (nreverse day-numbers)) |
3306 (if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name))) | 3396 (if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name))) |
3322 (org-check-agenda-file file) | 3412 (org-check-agenda-file file) |
3323 (setq date (calendar-gregorian-from-absolute today) | 3413 (setq date (calendar-gregorian-from-absolute today) |
3324 rtn (org-agenda-get-day-entries | 3414 rtn (org-agenda-get-day-entries |
3325 file date :todo)) | 3415 file date :todo)) |
3326 (setq rtnall (append rtnall rtn)))) | 3416 (setq rtnall (append rtnall rtn)))) |
3327 (if rtnall (insert (org-finalize-agenda-entries rtnall) "\n"))) | 3417 (when rtnall |
3418 (insert "ALL CURRENTLY OPEN TODO ITEMS:\n") | |
3419 (add-text-properties (point-min) (1- (point)) | |
3420 (list 'face 'org-link-face)) | |
3421 (insert (org-finalize-agenda-entries rtnall) "\n"))) | |
3328 (while (setq d (pop day-numbers)) | 3422 (while (setq d (pop day-numbers)) |
3329 (setq date (calendar-gregorian-from-absolute d) | 3423 (setq date (calendar-gregorian-from-absolute d) |
3330 s (point)) | 3424 s (point)) |
3331 (if (or (= d today) | 3425 (if (or (setq todayp (= d today)) |
3332 (and (not start-pos) (= d sd))) | 3426 (and (not start-pos) (= d sd))) |
3333 (setq start-pos (point)) | 3427 (setq start-pos (point)) |
3334 (if (and start-pos (not end-pos)) | 3428 (if (and start-pos (not end-pos)) |
3335 (setq end-pos (point)))) | 3429 (setq end-pos (point)))) |
3336 (setq files org-agenda-files | 3430 (setq files org-agenda-files |
3345 (require 'diary-lib) | 3439 (require 'diary-lib) |
3346 (setq rtn (org-get-entries-from-diary date)) | 3440 (setq rtn (org-get-entries-from-diary date)) |
3347 (setq rtnall (append rtnall rtn)))) | 3441 (setq rtnall (append rtnall rtn)))) |
3348 (if (or rtnall org-agenda-show-all-dates) | 3442 (if (or rtnall org-agenda-show-all-dates) |
3349 (progn | 3443 (progn |
3350 (insert (format "%-9s %2d %-9s %4d\n" | 3444 (insert (format "%-9s %2d %s %4d\n" |
3351 (calendar-day-name date) | 3445 (calendar-day-name date) |
3352 (extract-calendar-day date) | 3446 (extract-calendar-day date) |
3353 (calendar-month-name (extract-calendar-month date)) | 3447 (calendar-month-name (extract-calendar-month date)) |
3354 (extract-calendar-year date))) | 3448 (extract-calendar-year date))) |
3355 (put-text-property s (1- (point)) 'face | 3449 (put-text-property s (1- (point)) 'face |
3356 'org-link-face) | 3450 'org-link-face) |
3357 (if rtnall (insert (org-finalize-agenda-entries rtnall) "\n")) | 3451 (if rtnall (insert |
3452 (org-finalize-agenda-entries ;; FIXME: condition needed | |
3453 (org-agenda-add-time-grid-maybe | |
3454 rtnall nd todayp)) | |
3455 "\n")) | |
3358 (put-text-property s (1- (point)) 'day d)))) | 3456 (put-text-property s (1- (point)) 'day d)))) |
3359 (goto-char (point-min)) | 3457 (goto-char (point-min)) |
3360 (setq buffer-read-only t) | 3458 (setq buffer-read-only t) |
3361 (if org-fit-agenda-window | 3459 (if org-fit-agenda-window |
3362 (fit-window-to-buffer nil (/ (* (frame-height) 3) 4) | 3460 (fit-window-to-buffer nil (/ (* (frame-height) 3) 4) |
3500 (org-agenda-redo) | 3598 (org-agenda-redo) |
3501 (org-agenda-set-mode-name) | 3599 (org-agenda-set-mode-name) |
3502 (message "Diary inclusion turned %s" | 3600 (message "Diary inclusion turned %s" |
3503 (if org-agenda-include-diary "on" "off"))) | 3601 (if org-agenda-include-diary "on" "off"))) |
3504 | 3602 |
3603 (defun org-agenda-toggle-time-grid () | |
3604 "Toggle follow mode in an agenda buffer." | |
3605 (interactive) | |
3606 (setq org-agenda-use-time-grid (not org-agenda-use-time-grid)) | |
3607 (org-agenda-redo) | |
3608 (org-agenda-set-mode-name) | |
3609 (message "Time-grid turned %s" | |
3610 (if org-agenda-use-time-grid "on" "off"))) | |
3611 | |
3505 (defun org-agenda-set-mode-name () | 3612 (defun org-agenda-set-mode-name () |
3506 "Set the mode name to indicate all the small mode settings." | 3613 "Set the mode name to indicate all the small mode settings." |
3507 (setq mode-name | 3614 (setq mode-name |
3508 (concat "Org-Agenda" | 3615 (concat "Org-Agenda" |
3509 (if (equal org-agenda-ndays 1) " Day" "") | 3616 (if (equal org-agenda-ndays 1) " Day" "") |
3510 (if (equal org-agenda-ndays 7) " Week" "") | 3617 (if (equal org-agenda-ndays 7) " Week" "") |
3511 (if org-agenda-follow-mode " Follow" "") | 3618 (if org-agenda-follow-mode " Follow" "") |
3512 (if org-agenda-include-diary " Diary" ""))) | 3619 (if org-agenda-include-diary " Diary" "") |
3620 (if org-agenda-use-time-grid " Grid" ""))) | |
3513 (force-mode-line-update)) | 3621 (force-mode-line-update)) |
3514 | 3622 |
3515 (defun org-agenda-post-command-hook () | 3623 (defun org-agenda-post-command-hook () |
3516 (and (eolp) (not (bolp)) (backward-char 1)) | 3624 (and (eolp) (not (bolp)) (backward-char 1)) |
3517 (if (and org-agenda-follow-mode | 3625 (if (and org-agenda-follow-mode |
3522 | 3630 |
3523 (defun org-get-entries-from-diary (date) | 3631 (defun org-get-entries-from-diary (date) |
3524 "Get the (Emacs Calendar) diary entries for DATE." | 3632 "Get the (Emacs Calendar) diary entries for DATE." |
3525 (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*") | 3633 (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*") |
3526 (diary-display-hook '(fancy-diary-display)) | 3634 (diary-display-hook '(fancy-diary-display)) |
3527 (list-diary-entries-hook | 3635 (list-diary-entries-hook |
3528 (cons 'org-diary-default-entry list-diary-entries-hook)) | 3636 (cons 'org-diary-default-entry list-diary-entries-hook)) |
3529 entries | 3637 entries |
3530 (org-disable-diary t)) | 3638 (org-disable-diary t)) |
3531 (save-excursion | 3639 (save-excursion |
3532 (save-window-excursion | 3640 (save-window-excursion |
3549 (when entries | 3657 (when entries |
3550 (setq entries (org-split-string entries "\n")) | 3658 (setq entries (org-split-string entries "\n")) |
3551 (setq entries | 3659 (setq entries |
3552 (mapcar | 3660 (mapcar |
3553 (lambda (x) | 3661 (lambda (x) |
3554 (setq x (org-format-agenda-item "" x "Diary")) | 3662 (setq x (org-format-agenda-item "" x "Diary" 'time)) |
3555 ;; Extend the text properties to the beginning of the line | 3663 ;; Extend the text properties to the beginning of the line |
3556 (add-text-properties | 3664 (add-text-properties |
3557 0 (length x) | 3665 0 (length x) |
3558 (text-properties-at (1- (length x)) x) | 3666 (text-properties-at (1- (length x)) x) |
3559 x) | 3667 x) |
3762 (org-get-agenda-file-buffer file) | 3870 (org-get-agenda-file-buffer file) |
3763 (error "No such file %s" file))) | 3871 (error "No such file %s" file))) |
3764 arg results rtn) | 3872 arg results rtn) |
3765 (if (not buffer) | 3873 (if (not buffer) |
3766 ;; If file does not exist, make sure an error message ends up in diary | 3874 ;; If file does not exist, make sure an error message ends up in diary |
3767 (format "ORG-AGENDA-ERROR: No such org-file %s" file) | 3875 (list (format "ORG-AGENDA-ERROR: No such org-file %s" file)) |
3768 (with-current-buffer buffer | 3876 (with-current-buffer buffer |
3769 (unless (eq major-mode 'org-mode) | 3877 (unless (eq major-mode 'org-mode) |
3770 (error "Agenda file %s is not in `org-mode'" file)) | 3878 (error "Agenda file %s is not in `org-mode'" file)) |
3771 (let ((case-fold-search nil)) | 3879 (let ((case-fold-search nil)) |
3772 (save-excursion | 3880 (save-excursion |
3794 (setq rtn (org-agenda-get-scheduled)) | 3902 (setq rtn (org-agenda-get-scheduled)) |
3795 (setq results (append results rtn))) | 3903 (setq results (append results rtn))) |
3796 ((and (eq arg :deadline) | 3904 ((and (eq arg :deadline) |
3797 (equal date (calendar-current-date))) | 3905 (equal date (calendar-current-date))) |
3798 (setq rtn (org-agenda-get-deadlines)) | 3906 (setq rtn (org-agenda-get-deadlines)) |
3799 (setq results (append results rtn)))))))))) | 3907 (setq results (append results rtn)))))))) |
3800 results)) | 3908 results)))) |
3801 | 3909 |
3802 (defun org-entry-is-done-p () | 3910 (defun org-entry-is-done-p () |
3803 "Is the current entry marked DONE?" | 3911 "Is the current entry marked DONE?" |
3804 (save-excursion | 3912 (save-excursion |
3805 (and (re-search-backward "[\r\n]\\*" nil t) | 3913 (and (re-search-backward "[\r\n]\\*" nil t) |
3874 (car org-time-stamp-formats) | 3982 (car org-time-stamp-formats) |
3875 (apply 'encode-time ; DATE bound by calendar | 3983 (apply 'encode-time ; DATE bound by calendar |
3876 (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) | 3984 (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) |
3877 0 11))) | 3985 0 11))) |
3878 marker hdmarker deadlinep scheduledp donep tmp priority | 3986 marker hdmarker deadlinep scheduledp donep tmp priority |
3879 ee txt) | 3987 ee txt timestr) |
3880 (goto-char (point-min)) | 3988 (goto-char (point-min)) |
3881 (while (re-search-forward regexp nil t) | 3989 (while (re-search-forward regexp nil t) |
3882 (if (not (save-match-data (org-at-date-range-p))) | 3990 (if (not (save-match-data (org-at-date-range-p))) |
3883 (progn | 3991 (progn |
3884 (setq marker (org-agenda-new-marker (match-beginning 0)) | 3992 (setq marker (org-agenda-new-marker (match-beginning 0)) |
3885 tmp (buffer-substring (max (point-min) | 3993 tmp (buffer-substring (max (point-min) |
3886 (- (match-beginning 0) | 3994 (- (match-beginning 0) |
3887 org-ds-keyword-length)) | 3995 org-ds-keyword-length)) |
3888 (match-beginning 0)) | 3996 (match-beginning 0)) |
3997 timestr (buffer-substring (match-beginning 0) (point-at-eol)) | |
3889 deadlinep (string-match org-deadline-regexp tmp) | 3998 deadlinep (string-match org-deadline-regexp tmp) |
3890 scheduledp (string-match org-scheduled-regexp tmp) | 3999 scheduledp (string-match org-scheduled-regexp tmp) |
3891 donep (org-entry-is-done-p)) | 4000 donep (org-entry-is-done-p)) |
4001 (if (string-match ">" timestr) | |
4002 ;; substring should only run to end of time stamp | |
4003 (setq timestr (substring timestr 0 (match-end 0)))) | |
3892 (save-excursion | 4004 (save-excursion |
3893 (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) | 4005 (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) |
3894 (progn | 4006 (progn |
3895 (goto-char (match-end 1)) | 4007 (goto-char (match-end 1)) |
3896 (setq hdmarker (org-agenda-new-marker)) | 4008 (setq hdmarker (org-agenda-new-marker)) |
3897 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") | 4009 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") |
3898 (setq txt (org-format-agenda-item | 4010 (setq txt (org-format-agenda-item |
3899 (format "%s%s" | 4011 (format "%s%s" |
3900 (if deadlinep "Deadline: " "") | 4012 (if deadlinep "Deadline: " "") |
3901 (if scheduledp "Scheduled: " "")) | 4013 (if scheduledp "Scheduled: " "")) |
3902 (match-string 1)))) | 4014 (match-string 1) nil timestr))) |
3903 (setq txt org-agenda-no-heading-message)) | 4015 (setq txt org-agenda-no-heading-message)) |
3904 (setq priority (org-get-priority txt)) | 4016 (setq priority (org-get-priority txt)) |
3905 (add-text-properties | 4017 (add-text-properties |
3906 0 (length txt) (append (list 'org-marker marker | 4018 0 (length txt) (append (list 'org-marker marker |
3907 'org-hd-marker hdmarker) props) | 4019 'org-hd-marker hdmarker) props) |
4042 'help-echo | 4154 'help-echo |
4043 (format "mouse-2 or RET jump to org file %s" | 4155 (format "mouse-2 or RET jump to org file %s" |
4044 (abbreviate-file-name (buffer-file-name))))) | 4156 (abbreviate-file-name (buffer-file-name))))) |
4045 (regexp org-tr-regexp) | 4157 (regexp org-tr-regexp) |
4046 (d0 (calendar-absolute-from-gregorian date)) | 4158 (d0 (calendar-absolute-from-gregorian date)) |
4047 marker hdmarker ee txt d1 d2 s1 s2) | 4159 marker hdmarker ee txt d1 d2 s1 s2 timestr) |
4048 (goto-char (point-min)) | 4160 (goto-char (point-min)) |
4049 (while (re-search-forward regexp nil t) | 4161 (while (re-search-forward regexp nil t) |
4050 (setq s1 (match-string 1) | 4162 (setq timestr (match-string 0) |
4163 s1 (match-string 1) | |
4051 s2 (match-string 2) | 4164 s2 (match-string 2) |
4052 d1 (time-to-days (org-time-string-to-time s1)) | 4165 d1 (time-to-days (org-time-string-to-time s1)) |
4053 d2 (time-to-days (org-time-string-to-time s2))) | 4166 d2 (time-to-days (org-time-string-to-time s2))) |
4054 (if (and (> (- d0 d1) -1) (> (- d2 d0) -1)) | 4167 (if (and (> (- d0 d1) -1) (> (- d2 d0) -1)) |
4055 ;; Only allow days between the limits, because the normal | 4168 ;; Only allow days between the limits, because the normal |
4060 (progn | 4173 (progn |
4061 (setq hdmarker (org-agenda-new-marker (match-end 1))) | 4174 (setq hdmarker (org-agenda-new-marker (match-end 1))) |
4062 (goto-char (match-end 1)) | 4175 (goto-char (match-end 1)) |
4063 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") | 4176 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") |
4064 (setq txt (org-format-agenda-item | 4177 (setq txt (org-format-agenda-item |
4065 (format "(%d/%d): " | 4178 (format (if (= d1 d2) "" "(%d/%d): ") |
4066 (1+ (- d0 d1)) (1+ (- d2 d1))) | 4179 (1+ (- d0 d1)) (1+ (- d2 d1))) |
4067 (match-string 1)))) | 4180 (match-string 1) nil (if (= d0 d1) timestr)))) |
4068 (setq txt org-agenda-no-heading-message)) | 4181 (setq txt org-agenda-no-heading-message)) |
4069 (add-text-properties | 4182 (add-text-properties |
4070 0 (length txt) (append (list 'org-marker marker | 4183 0 (length txt) (append (list 'org-marker marker |
4071 'org-hd-marker hdmarker | 4184 'org-hd-marker hdmarker |
4072 'priority (org-get-priority txt)) | 4185 'priority (org-get-priority txt)) |
4075 (push txt ee))) | 4188 (push txt ee))) |
4076 (outline-next-heading)) | 4189 (outline-next-heading)) |
4077 ;; Sort the entries by expiration date. | 4190 ;; Sort the entries by expiration date. |
4078 (nreverse ee))) | 4191 (nreverse ee))) |
4079 | 4192 |
4080 (defun org-format-agenda-item (prefix txt &optional category) | 4193 |
4194 | |
4195 (defconst org-plain-time-of-day-regexp | |
4196 (concat | |
4197 "\\(\\<[012]?[0-9]" | |
4198 "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" | |
4199 "\\(--?" | |
4200 "\\(\\<[012]?[0-9]" | |
4201 "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" | |
4202 "\\)?") | |
4203 "Regular expression to match a plain time or time range. | |
4204 Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following | |
4205 groups carry important information: | |
4206 0 the full match | |
4207 1 the first time, range or not | |
4208 8 the second time, if it is a range.") | |
4209 | |
4210 (defconst org-stamp-time-of-day-regexp | |
4211 (concat | |
4212 "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +[a-zA-Z]+ +\\)" | |
4213 "\\([012][0-9]:[0-5][0-9]\\)>" | |
4214 "\\(--?" | |
4215 "<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?") | |
4216 "Regular expression to match a timestamp time or time range. | |
4217 After a match, the following groups carry important information: | |
4218 0 the full match | |
4219 1 date plus weekday, for backreferencing to make sure both times on same day | |
4220 2 the first time, range or not | |
4221 4 the second time, if it is a range.") | |
4222 | |
4223 (defvar org-prefix-has-time nil | |
4224 "A flag, set by `org-compile-prefix-format'. | |
4225 The flag is set if the currently compiled format contains a `%t'.") | |
4226 | |
4227 (defun org-format-agenda-item (extra txt &optional category dotime noprefix) | |
4081 "Format TXT to be inserted into the agenda buffer. | 4228 "Format TXT to be inserted into the agenda buffer. |
4082 In particular, this indents the line and adds a category." | 4229 In particular, it adds the prefix and corresponding text properties. EXTRA |
4083 (let* ((category (or category | 4230 must be a string and replaces the `%s' specifier in the prefix format. |
4084 org-category | 4231 CATEGORY (string, symbol or nil) may be used to overule the default |
4085 (file-name-sans-extension | 4232 category taken from local variable or file name. It will replace the `%c' |
4086 (file-name-nondirectory (buffer-file-name))))) | 4233 specifier in the format. DOTIME, when non-nil, indicates that a |
4087 (extra prefix) | 4234 time-of-day should be extracted from TXT for sorting of this entry, and for |
4088 (time-of-day (org-get-time-of-day txt)) | 4235 the `%t' specifier in the format. When DOTIME is a string, this string is |
4089 (t1 (if time-of-day (concat "0" (int-to-string time-of-day)) "0000")) | 4236 searched for a time before TXT is. NOPREFIX is a flag and indicates that |
4090 (time (if time-of-day | 4237 only the correctly processes TXT should be returned - this is used by |
4091 (concat (substring t1 -4 -2) | 4238 `org-agenda-change-all-lines'." |
4092 ":" (substring t1 -2)) | 4239 (save-match-data |
4093 "")) | 4240 ;; Diary entries sometimes have extra whitespace at the beginning |
4094 rtn) | 4241 (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt))) |
4095 (if (symbolp category) (setq category (symbol-name category))) | 4242 (let* ((category (or category |
4096 (setq rtn (concat (eval org-prefix-format-compiled) txt)) | 4243 org-category |
4097 (add-text-properties | 4244 (if (buffer-file-name) |
4098 0 (length rtn) (list 'category (downcase category) | 4245 (file-name-sans-extension |
4099 'prefix-length (- (length rtn) (length txt)) | 4246 (file-name-nondirectory (buffer-file-name))) |
4100 'time-of-day time-of-day) | 4247 ""))) |
4101 rtn) | 4248 time ;; needed for the eval of the prefix format |
4102 rtn)) | 4249 (ts (if dotime (concat (if (stringp dotime) dotime "") txt))) |
4103 | 4250 (time-of-day (and dotime (org-get-time-of-day ts))) |
4251 stamp plain s0 s1 s2 rtn) | |
4252 (when (and dotime time-of-day org-prefix-has-time) | |
4253 ;; Extract starting and ending time and move them to prefix | |
4254 (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) | |
4255 (setq plain (string-match org-plain-time-of-day-regexp ts))) | |
4256 (setq s0 (match-string 0 ts) | |
4257 s1 (match-string (if plain 1 2) ts) | |
4258 s2 (match-string (if plain 8 4) ts)) | |
4259 | |
4260 ;; If the times are in TXT (not in DOTIMES), and the prefix will list | |
4261 ;; them, we might want to remove them there to avoid duplication. | |
4262 ;; The user can turn this off with a variable. | |
4263 (if (and org-agenda-remove-times-when-in-prefix (or stamp plain) | |
4264 (string-match (concat (regexp-quote s0) " *") txt) | |
4265 (if (eq org-agenda-remove-times-when-in-prefix 'beg) | |
4266 (= (match-beginning 0) 0) | |
4267 t)) | |
4268 (setq txt (replace-match "" nil nil txt)))) | |
4269 ;; Normalize the time(s) to 24 hour | |
4270 (if s1 (setq s1 (org-get-time-of-day s1 'string))) | |
4271 (if s2 (setq s2 (org-get-time-of-day s2 'string)))) | |
4272 | |
4273 ;; Create the final string | |
4274 (if noprefix | |
4275 (setq rtn txt) | |
4276 ;; Prepare the variables needed in the eval of the compiled format | |
4277 (setq time (cond (s2 (concat s1 "-" s2)) | |
4278 (s1 (concat s1 "......")) | |
4279 (t "")) | |
4280 extra (or extra "") | |
4281 category (if (symbolp category) (symbol-name category) category)) | |
4282 ;; Evaluate the compiled format | |
4283 (setq rtn (concat (eval org-prefix-format-compiled) txt))) | |
4284 | |
4285 ;; And finally add the text properties | |
4286 (add-text-properties | |
4287 0 (length rtn) (list 'category (downcase category) | |
4288 'prefix-length (- (length rtn) (length txt)) | |
4289 'time-of-day time-of-day | |
4290 'dotime dotime) | |
4291 rtn) | |
4292 rtn))) | |
4293 | |
4294 (defun org-agenda-add-time-grid-maybe (list ndays todayp) | |
4295 (catch 'exit | |
4296 (cond ((not org-agenda-use-time-grid) (throw 'exit list)) | |
4297 ((and todayp (member 'today (car org-agenda-time-grid)))) | |
4298 ((and (= ndays 1) (member 'daily (car org-agenda-time-grid)))) | |
4299 ((member 'weekly (car org-agenda-time-grid))) | |
4300 (t (throw 'exit list))) | |
4301 (let* ((have (delq nil (mapcar | |
4302 (lambda (x) (get-text-property 1 'time-of-day x)) | |
4303 list))) | |
4304 (string (nth 1 org-agenda-time-grid)) | |
4305 (gridtimes (nth 2 org-agenda-time-grid)) | |
4306 (req (car org-agenda-time-grid)) | |
4307 (remove (member 'remove-match req)) | |
4308 new time) | |
4309 (if (and (member 'require-timed req) (not have)) | |
4310 ;; don't show empty grid | |
4311 (throw 'exit list)) | |
4312 (while (setq time (pop gridtimes)) | |
4313 (unless (and remove (member time have)) | |
4314 (setq time (int-to-string time)) | |
4315 (push (org-format-agenda-item | |
4316 nil string "" ;; FIXME: put a category? | |
4317 (concat (substring time 0 -2) ":" (substring time -2))) | |
4318 new) | |
4319 (put-text-property | |
4320 1 (length (car new)) 'face 'org-time-grid-face (car new)))) | |
4321 (if (member 'time-up org-agenda-sorting-strategy) | |
4322 (append new list) | |
4323 (append list new))))) | |
4324 | |
4104 (defun org-compile-prefix-format (format) | 4325 (defun org-compile-prefix-format (format) |
4105 "Compile the prefix format into a Lisp form that can be evaluated. | 4326 "Compile the prefix format into a Lisp form that can be evaluated. |
4106 The resulting form is returned and stored in the variable | 4327 The resulting form is returned and stored in the variable |
4107 `org-prefix-format-compiled'." | 4328 `org-prefix-format-compiled'." |
4108 (let ((start 0) varform vars (s format) c) | 4329 (setq org-prefix-has-time nil) |
4109 (while (string-match "%\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cts]\\)" | 4330 (let ((start 0) varform vars var (s format) c f opt) |
4331 (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cts]\\)" | |
4110 s start) | 4332 s start) |
4111 (setq var (cdr (assoc (match-string 3 s) | 4333 (setq var (cdr (assoc (match-string 4 s) |
4112 '(("c" . category) ("t" . time) ("s" . extra)))) | 4334 '(("c" . category) ("t" . time) ("s" . extra)))) |
4113 c (match-string 2 s) | 4335 c (or (match-string 3 s) "") |
4336 opt (match-beginning 1) | |
4114 start (1+ (match-beginning 0))) | 4337 start (1+ (match-beginning 0))) |
4115 (if (= (length c) 1) | 4338 (if (equal var 'time) (setq org-prefix-has-time t)) |
4116 (setq varform `(if (equal "" ,var) "" (concat ,var ,c))) | 4339 (setq f (concat "%" (match-string 2 s) "s")) |
4117 (setq varform var)) | 4340 (if opt |
4118 (setq s (replace-match "%\\1s" t nil s)) | 4341 (setq varform |
4342 `(if (equal "" ,var) | |
4343 "" | |
4344 (format ,f (if (equal "" ,var) "" (concat ,var ,c))))) | |
4345 (setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c))))) | |
4346 (setq s (replace-match "%s" t nil s)) | |
4119 (push varform vars)) | 4347 (push varform vars)) |
4120 (setq vars (nreverse vars)) | 4348 (setq vars (nreverse vars)) |
4121 (setq org-prefix-format-compiled `(format ,s ,@vars)))) | 4349 (setq org-prefix-format-compiled `(format ,s ,@vars)))) |
4122 | 4350 |
4123 (defun org-get-time-of-day (s) | 4351 (defun org-get-time-of-day (s &optional string) |
4124 "Check string S for a time of day. | 4352 "Check string S for a time of day. |
4125 If found, return it as a military time number between 0 and 2400. | 4353 If found, return it as a military time number between 0 and 2400. |
4126 If not found, return nil." | 4354 If not found, return nil. |
4355 The optional STRING argument forces conversion into a 5 character wide string | |
4356 HH:MM." | |
4127 (save-match-data | 4357 (save-match-data |
4128 (when (or | 4358 (when |
4129 (string-match | 4359 (or |
4130 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\>" s) | 4360 (string-match |
4131 (string-match | 4361 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s) |
4132 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\>" s)) | 4362 (string-match |
4133 (+ (* 100 (+ (string-to-number (match-string 1 s)) | 4363 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s)) |
4134 (if (and (match-beginning 4) | 4364 (let* ((t0 (+ (* 100 |
4135 (equal (downcase (match-string 4 s)) "pm")) | 4365 (+ (string-to-number (match-string 1 s)) |
4136 12 0))) | 4366 (if (and (match-beginning 4) |
4137 (if (match-beginning 3) | 4367 (equal (downcase (match-string 4 s)) "pm")) |
4138 (string-to-number (match-string 3 s)) | 4368 12 0))) |
4139 0))))) | 4369 (if (match-beginning 3) |
4370 (string-to-number (match-string 3 s)) | |
4371 0))) | |
4372 (t1 (concat " " (int-to-string t0)))) | |
4373 (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0))))) | |
4140 | 4374 |
4141 (defun org-finalize-agenda-entries (list) | 4375 (defun org-finalize-agenda-entries (list) |
4142 "Sort and concatenate the agenda items." | 4376 "Sort and concatenate the agenda items." |
4143 (mapconcat 'identity (sort list 'org-entries-lessp) "\n")) | 4377 (mapconcat 'identity (sort list 'org-entries-lessp) "\n")) |
4144 | 4378 |
4293 (org-agenda-change-all-lines newhead hdmarker 'fixface)) | 4527 (org-agenda-change-all-lines newhead hdmarker 'fixface)) |
4294 (move-to-column col))) | 4528 (move-to-column col))) |
4295 | 4529 |
4296 (defun org-agenda-change-all-lines (newhead hdmarker &optional fixface) | 4530 (defun org-agenda-change-all-lines (newhead hdmarker &optional fixface) |
4297 "Change all lines in the agenda buffer which match hdmarker. | 4531 "Change all lines in the agenda buffer which match hdmarker. |
4298 The new content of the line will be NEWHEAD. HDMARKER is checked with | 4532 The new content of the line will be NEWHEAD (as modified by |
4299 `equal' against all `org-hd-marker' text properties in the file." | 4533 `org-format-agenda-item'). HDMARKER is checked with |
4300 (let* (props m pl undone-face done-face) | 4534 `equal' against all `org-hd-marker' text properties in the file. |
4535 If FIXFACE is non-nil, the face of each item is modified acording to | |
4536 the new TODO state." | |
4537 (let* (props m pl undone-face done-face finish new dotime) | |
4538 ; (setq newhead (org-format-agenda-item "x" newhead "x" nil 'noprefix)) | |
4301 (save-excursion | 4539 (save-excursion |
4302 (goto-char (point-max)) | 4540 (goto-char (point-max)) |
4303 (beginning-of-line 1) | 4541 (beginning-of-line 1) |
4304 (while (not (bobp)) | 4542 (while (not finish) |
4543 (setq finish (bobp)) | |
4305 (when (and (setq m (get-text-property (point) 'org-hd-marker)) | 4544 (when (and (setq m (get-text-property (point) 'org-hd-marker)) |
4306 (equal m hdmarker)) | 4545 (equal m hdmarker)) |
4307 (setq props (text-properties-at (point)) | 4546 (setq props (text-properties-at (point)) |
4547 dotime (get-text-property (point) 'dotime) | |
4548 new (org-format-agenda-item "x" newhead "x" dotime 'noprefix) | |
4308 pl (get-text-property (point) 'prefix-length) | 4549 pl (get-text-property (point) 'prefix-length) |
4309 undone-face (get-text-property (point) 'undone-face) | 4550 undone-face (get-text-property (point) 'undone-face) |
4310 done-face (get-text-property (point) 'done-face)) | 4551 done-face (get-text-property (point) 'done-face)) |
4311 (move-to-column pl) | 4552 (move-to-column pl) |
4312 (if (looking-at ".*") | 4553 (if (looking-at ".*") |
4313 (progn | 4554 (progn |
4314 (replace-match newhead t t) | 4555 (replace-match new t t) |
4315 (beginning-of-line 1) | 4556 (beginning-of-line 1) |
4316 (add-text-properties (point-at-bol) (point-at-eol) props) | 4557 (add-text-properties (point-at-bol) (point-at-eol) props) |
4317 (if fixface | 4558 (if fixface |
4318 (add-text-properties | 4559 (add-text-properties |
4319 (point-at-bol) (point-at-eol) | 4560 (point-at-bol) (point-at-eol) |
4353 (org-show-hidden-entry) | 4594 (org-show-hidden-entry) |
4354 (save-excursion | 4595 (save-excursion |
4355 (and (outline-next-heading) | 4596 (and (outline-next-heading) |
4356 (org-flag-heading nil))) ; show the next heading | 4597 (org-flag-heading nil))) ; show the next heading |
4357 (funcall 'org-priority force-direction) | 4598 (funcall 'org-priority force-direction) |
4599 (end-of-line 1) | |
4358 (setq newhead (org-get-heading))) | 4600 (setq newhead (org-get-heading))) |
4359 (org-agenda-change-all-lines newhead hdmarker) | 4601 (org-agenda-change-all-lines newhead hdmarker) |
4360 (beginning-of-line 1))) | 4602 (beginning-of-line 1))) |
4361 | 4603 |
4362 (defun org-agenda-date-later (arg &optional what) | 4604 (defun org-agenda-date-later (arg &optional what) |
4517 (setq s (concat | 4759 (setq s (concat |
4518 "Gregorian: " (calendar-date-string date) "\n" | 4760 "Gregorian: " (calendar-date-string date) "\n" |
4519 "ISO: " (calendar-iso-date-string date) "\n" | 4761 "ISO: " (calendar-iso-date-string date) "\n" |
4520 "Day of Yr: " (calendar-day-of-year-string date) "\n" | 4762 "Day of Yr: " (calendar-day-of-year-string date) "\n" |
4521 "Julian: " (calendar-julian-date-string date) "\n" | 4763 "Julian: " (calendar-julian-date-string date) "\n" |
4522 "Astronomic: " (calendar-astro-date-string date) | 4764 "Astron. JD: " (calendar-astro-date-string date) |
4523 " (Julian date number at noon UTC)\n" | 4765 " (Julian date number at noon UTC)\n" |
4524 "Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n" | 4766 "Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n" |
4525 "Islamic: " (calendar-islamic-date-string date) " (until sunset)\n" | 4767 "Islamic: " (calendar-islamic-date-string date) " (until sunset)\n" |
4526 "French: " (calendar-french-date-string date) "\n" | 4768 "French: " (calendar-french-date-string date) "\n" |
4527 "Mayan: " (calendar-mayan-date-string date) "\n" | 4769 "Mayan: " (calendar-mayan-date-string date) "\n" |
4863 (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus | 5105 (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus |
4864 (gnus-group-group-name)) ; version | 5106 (gnus-group-group-name)) ; version |
4865 ((fboundp 'gnus-group-name) | 5107 ((fboundp 'gnus-group-name) |
4866 (gnus-group-name)) | 5108 (gnus-group-name)) |
4867 (t "???")))) | 5109 (t "???")))) |
4868 (setq link (concat (if (org-xor arg org-usenet-links-prefer-google) | 5110 (setq link (concat |
4869 "http://groups.google.com/groups?group=" | 5111 (if (org-xor arg org-usenet-links-prefer-google) |
4870 "gnus:") | 5112 "http://groups.google.com/groups?group=" |
4871 group)))) | 5113 "gnus:") |
5114 group)))) | |
4872 | 5115 |
4873 ((memq major-mode '(gnus-summary-mode gnus-article-mode)) | 5116 ((memq major-mode '(gnus-summary-mode gnus-article-mode)) |
4874 (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary)) | 5117 (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary)) |
4875 (gnus-summary-beginning-of-article) | 5118 (gnus-summary-beginning-of-article) |
4876 (let* ((group (car gnus-article-current)) | 5119 (let* ((group (car gnus-article-current)) |
4917 (message "Stored: %s" (or cpltxt link))) | 5160 (message "Stored: %s" (or cpltxt link))) |
4918 link))) | 5161 link))) |
4919 | 5162 |
4920 (defun org-xor (a b) | 5163 (defun org-xor (a b) |
4921 "Exclusive or." | 5164 "Exclusive or." |
4922 ;; (if a (not b) b) | 5165 (if a (not b) b)) |
4923 (or (and a (not b)) | |
4924 (and b (not a)))) | |
4925 | 5166 |
4926 (defun org-get-header (header) | 5167 (defun org-get-header (header) |
4927 "Find a header field in the current buffer." | 5168 "Find a header field in the current buffer." |
4928 (save-excursion | 5169 (save-excursion |
4929 (goto-char (point-min)) | 5170 (goto-char (point-min)) |
5215 "\n"))) | 5456 "\n"))) |
5216 (if (string-match "^[ \t]*$" (buffer-substring-no-properties | 5457 (if (string-match "^[ \t]*$" (buffer-substring-no-properties |
5217 (point-at-bol) (point))) | 5458 (point-at-bol) (point))) |
5218 (beginning-of-line 1) | 5459 (beginning-of-line 1) |
5219 (newline)) | 5460 (newline)) |
5220 (mapcar (lambda (x) (insert line)) (make-list rows t)) | 5461 ;; (mapcar (lambda (x) (insert line)) (make-list rows t)) |
5462 (dotimes (i rows) (insert line)) | |
5221 (goto-char pos) | 5463 (goto-char pos) |
5222 (if (> rows 1) | 5464 (if (> rows 1) |
5223 ;; Insert a hline after the first row. | 5465 ;; Insert a hline after the first row. |
5224 (progn | 5466 (progn |
5225 (end-of-line 1) | 5467 (end-of-line 1) |
5283 (file (read-file-name "Export table to: ")) | 5525 (file (read-file-name "Export table to: ")) |
5284 buf) | 5526 buf) |
5285 (unless (or (not (file-exists-p file)) | 5527 (unless (or (not (file-exists-p file)) |
5286 (y-or-n-p (format "Overwrite file %s? " file))) | 5528 (y-or-n-p (format "Overwrite file %s? " file))) |
5287 (error "Abort")) | 5529 (error "Abort")) |
5288 (save-excursion | 5530 (with-current-buffer (find-file-noselect file) |
5289 (find-file file) | |
5290 (setq buf (current-buffer)) | 5531 (setq buf (current-buffer)) |
5291 (erase-buffer) | 5532 (erase-buffer) |
5292 (fundamental-mode) | 5533 (fundamental-mode) |
5293 (insert table) | 5534 (insert table) |
5294 (goto-char (point-min)) | 5535 (goto-char (point-min)) |
5404 (setq rfmt (concat rfmt (format rfmt1 ty l)) | 5645 (setq rfmt (concat rfmt (format rfmt1 ty l)) |
5405 hfmt (concat hfmt (format hfmt1 (make-string l ?-))))) | 5646 hfmt (concat hfmt (format hfmt1 (make-string l ?-))))) |
5406 (setq rfmt (concat rfmt "\n") | 5647 (setq rfmt (concat rfmt "\n") |
5407 hfmt (concat (substring hfmt 0 -1) "|\n")) | 5648 hfmt (concat (substring hfmt 0 -1) "|\n")) |
5408 ;; Produce the new table | 5649 ;; Produce the new table |
5409 (while lines | 5650 ;;(while lines |
5410 (setq l (pop lines)) | 5651 ;; (setq l (pop lines)) |
5411 (if l | 5652 ;; (if l |
5412 (setq new (concat new (apply 'format rfmt | 5653 ;; (setq new (concat new (apply 'format rfmt |
5413 (append (pop fields) emptystrings)))) | 5654 ;; (append (pop fields) emptystrings)))) |
5414 (setq new (concat new hfmt)))) | 5655 ;; (setq new (concat new hfmt)))) |
5656 (setq new (mapconcat | |
5657 (lambda (l) | |
5658 (if l (apply 'format rfmt | |
5659 (append (pop fields) emptystrings)) | |
5660 hfmt)) | |
5661 lines "")) | |
5415 ;; Replace the old one | 5662 ;; Replace the old one |
5416 (delete-region beg end) | 5663 (delete-region beg end) |
5417 (move-marker end nil) | 5664 (move-marker end nil) |
5418 (move-marker org-table-aligned-begin-marker (point)) | 5665 (move-marker org-table-aligned-begin-marker (point)) |
5419 (insert new) | 5666 (insert new) |
8478 (if (fboundp 'outline-invisible-p) | 8725 (if (fboundp 'outline-invisible-p) |
8479 (outline-invisible-p) | 8726 (outline-invisible-p) |
8480 (get-char-property (point) 'invisible)) | 8727 (get-char-property (point) 'invisible)) |
8481 (save-excursion | 8728 (save-excursion |
8482 (skip-chars-backward "^\r\n") | 8729 (skip-chars-backward "^\r\n") |
8483 (if (bobp) | 8730 (equal (char-before) ?\r)))) |
8484 nil | |
8485 (equal (char-before) ?\r))))) | |
8486 | 8731 |
8487 (defun org-back-to-heading (&optional invisible-ok) | 8732 (defun org-back-to-heading (&optional invisible-ok) |
8488 "Move to previous heading line, or beg of this line if it's a heading. | 8733 "Move to previous heading line, or beg of this line if it's a heading. |
8489 Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." | 8734 Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." |
8490 (if org-noutline-p | 8735 (if org-noutline-p |