diff options
| author | Carsten Dominik | 2005-03-30 12:37:36 +0000 |
|---|---|---|
| committer | Carsten Dominik | 2005-03-30 12:37:36 +0000 |
| commit | ef943dbafe50f9e3ade231d5da47311aead345cc (patch) | |
| tree | 59d5b8a6923b8c9c4adcab3631825664e8585ed8 | |
| parent | ba0243c6345b45b81a4e7eff3b45cfb86ad97579 (diff) | |
| download | emacs-ef943dbafe50f9e3ade231d5da47311aead345cc.tar.gz emacs-ef943dbafe50f9e3ade231d5da47311aead345cc.zip | |
* org.el (org-agenda-phases-of-moon, org-agenda-sunrise-sunset)
(org-agenda-convert-date, org-agenda-goto-calendar): New commands.
(org-diary-default-entry): New function.
(org-get-entries-from-diary): Better parsing of diary entries
(org-agenda-check-no-diary): New function.
("diary-lib"): Advice to function `add-to-diary-list', to allow
linking to diary entries.
(org-agenda-execute-calendar-command): New function
(org-agenda): Improved visible section in window. And
use `org-fit-agenda-window'.
(org-fit-agenda-window): New option.
(org-move-subtree-down): Better handling of empty lines
at end of subtree.
(org-cycle): Numeric prefix is interpreted now as show-subtree N
levels up.
(org-fontify-done-headline): New option.
(org-headline-done-face): New face.
(org-set-font-lock-defaults): Use `org-headline-done-face'.
(org-table-copy-down): renamed from
`org-table-copy-from-above'. When current field is non-empty, it
is copied to next row.
(org-table-copy-from-above): Fixed bug which made it
impossible to copy fields containing only a single non-white
character.
| -rw-r--r-- | lisp/ChangeLog | 27 | ||||
| -rw-r--r-- | lisp/textmodes/org.el | 453 |
2 files changed, 396 insertions, 84 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 721512dc01c..0f049936249 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,30 @@ | |||
| 1 | 2005-03-30 Carsten Dominik <dominik@science.uva.nl> | ||
| 2 | |||
| 3 | * org.el (org-agenda-phases-of-moon, org-agenda-sunrise-sunset) | ||
| 4 | (org-agenda-convert-date, org-agenda-goto-calendar): New commands. | ||
| 5 | (org-diary-default-entry): New function. | ||
| 6 | (org-get-entries-from-diary): Better parsing of diary entries | ||
| 7 | (org-agenda-check-no-diary): New function. | ||
| 8 | ("diary-lib"): Advice to function `add-to-diary-list', to allow | ||
| 9 | linking to diary entries. | ||
| 10 | (org-agenda-execute-calendar-command): New function | ||
| 11 | (org-agenda): Improved visible section in window. And | ||
| 12 | use `org-fit-agenda-window'. | ||
| 13 | (org-fit-agenda-window): New option. | ||
| 14 | (org-move-subtree-down): Better handling of empty lines | ||
| 15 | at end of subtree. | ||
| 16 | (org-cycle): Numeric prefix is interpreted now as show-subtree N | ||
| 17 | levels up. | ||
| 18 | (org-fontify-done-headline): New option. | ||
| 19 | (org-headline-done-face): New face. | ||
| 20 | (org-set-font-lock-defaults): Use `org-headline-done-face'. | ||
| 21 | (org-table-copy-down): renamed from | ||
| 22 | `org-table-copy-from-above'. When current field is non-empty, it | ||
| 23 | is copied to next row. | ||
| 24 | (org-table-copy-from-above): Fixed bug which made it | ||
| 25 | impossible to copy fields containing only a single non-white | ||
| 26 | character. | ||
| 27 | |||
| 1 | 2005-03-30 Kim F. Storm <storm@cua.dk> | 28 | 2005-03-30 Kim F. Storm <storm@cua.dk> |
| 2 | 29 | ||
| 3 | * kmacro.el (kmacro-end-macro): Isearch may store this command | 30 | * kmacro.el (kmacro-end-macro): Isearch may store this command |
diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el index ab45434526a..86406d37475 100644 --- a/lisp/textmodes/org.el +++ b/lisp/textmodes/org.el | |||
| @@ -1,14 +1,14 @@ | |||
| 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) 2003, 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.04 | 8 | ;; Version: 3.05 |
| 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 |
| 14 | ;; the Free Software Foundation; either version 2, or (at your option) | 14 | ;; the Free Software Foundation; either version 2, or (at your option) |
| @@ -75,10 +75,18 @@ | |||
| 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. |
| 77 | ;; This distribution also contains a PDF version of it. At the homepage | 77 | ;; This distribution also contains a PDF version of it. At the homepage |
| 78 | ;; of Org-mode, you can find and read online the same text as HTML. | 78 | ;; of Org-mode, you can read online the same text online as HTML. |
| 79 | ;; | 79 | ;; |
| 80 | ;; Changes: | 80 | ;; Changes: |
| 81 | ;; ------- | 81 | ;; ------- |
| 82 | ;; Version 3.05 | ||
| 83 | ;; - Agenda entries from the diary are linked to the diary file, so | ||
| 84 | ;; adding and editing diary entries can be done directly from the agenda. | ||
| 85 | ;; - Many calendar/diary commands available directly from agenda. | ||
| 86 | ;; - Field copying in tables with S-RET does increment. | ||
| 87 | ;; - C-c C-x C-v extracts the visible part of the buffer for printing. | ||
| 88 | ;; - Moving subtrees up and down preserves the whitespace at the tree end. | ||
| 89 | ;; | ||
| 82 | ;; Version 3.04 | 90 | ;; Version 3.04 |
| 83 | ;; - Table editor optimized to need fewer realignments, and to keep | 91 | ;; - Table editor optimized to need fewer realignments, and to keep |
| 84 | ;; table shape when typing in fields. | 92 | ;; table shape when typing in fields. |
| @@ -213,7 +221,7 @@ | |||
| 213 | 221 | ||
| 214 | ;;; Customization variables | 222 | ;;; Customization variables |
| 215 | 223 | ||
| 216 | (defvar org-version "3.04" | 224 | (defvar org-version "3.05" |
| 217 | "The version number of the file org.el.") | 225 | "The version number of the file org.el.") |
| 218 | (defun org-version () | 226 | (defun org-version () |
| 219 | (interactive) | 227 | (interactive) |
| @@ -241,7 +249,13 @@ | |||
| 241 | :group 'org) | 249 | :group 'org) |
| 242 | 250 | ||
| 243 | (defcustom org-startup-folded t | 251 | (defcustom org-startup-folded t |
| 244 | "Non-nil means, entering Org-mode will switch to OVERVIEW." | 252 | "Non-nil means, entering Org-mode will switch to OVERVIEW. |
| 253 | This can also be configured on a per-file basis by adding one of | ||
| 254 | the following lines anywhere in the buffer: | ||
| 255 | |||
| 256 | #+STARTUP: fold | ||
| 257 | #+STARTUP: nofold | ||
| 258 | " | ||
| 245 | :group 'org-startup | 259 | :group 'org-startup |
| 246 | :type 'boolean) | 260 | :type 'boolean) |
| 247 | 261 | ||
| @@ -255,7 +269,13 @@ uninteresting. Also tables look terrible when wrapped." | |||
| 255 | (defcustom org-startup-with-deadline-check nil | 269 | (defcustom org-startup-with-deadline-check nil |
| 256 | "Non-nil means, entering Org-mode will run the deadline check. | 270 | "Non-nil means, entering Org-mode will run the deadline check. |
| 257 | This means, if you start editing an org file, you will get an | 271 | This means, if you start editing an org file, you will get an |
| 258 | immediate reminder of any due deadlines." | 272 | immediate reminder of any due deadlines. |
| 273 | This can also be configured on a per-file basis by adding one of | ||
| 274 | the following lines anywhere in the buffer: | ||
| 275 | |||
| 276 | #+STARTUP: dlcheck | ||
| 277 | #+STARTUP: nodlcheck | ||
| 278 | " | ||
| 259 | :group 'org-startup | 279 | :group 'org-startup |
| 260 | :type 'boolean) | 280 | :type 'boolean) |
| 261 | 281 | ||
| @@ -534,6 +554,11 @@ When nil, cursor will remain in the current window." | |||
| 534 | :group 'org-agenda | 554 | :group 'org-agenda |
| 535 | :type 'boolean) | 555 | :type 'boolean) |
| 536 | 556 | ||
| 557 | (defcustom org-fit-agenda-window t | ||
| 558 | "Non-nil means, change windo size of agenda to fit content." | ||
| 559 | :group 'org-agenda | ||
| 560 | :type 'boolean) | ||
| 561 | |||
| 537 | (defcustom org-agenda-show-all-dates t | 562 | (defcustom org-agenda-show-all-dates t |
| 538 | "Non-nil means, `org-agenda' shows every day in the selected range. | 563 | "Non-nil means, `org-agenda' shows every day in the selected range. |
| 539 | When nil, only the days which actually have entries are shown." | 564 | When nil, only the days which actually have entries are shown." |
| @@ -892,7 +917,7 @@ slight (in fact: unnoticable) speed impact for normal typing. Org-mode is | |||
| 892 | very good at guessing when a re-align will be necessary, but you can always | 917 | very good at guessing when a re-align will be necessary, but you can always |
| 893 | force one with `C-c C-c'. | 918 | force one with `C-c C-c'. |
| 894 | 919 | ||
| 895 | I you would like to use the optimized version in Org-mode, but the un-optimized | 920 | If you would like to use the optimized version in Org-mode, but the un-optimized |
| 896 | version in OrgTbl-mode, see the variable `orgtbl-optimized'. | 921 | version in OrgTbl-mode, see the variable `orgtbl-optimized'. |
| 897 | 922 | ||
| 898 | This variable can be used to turn on and off the table editor during a session, | 923 | This variable can be used to turn on and off the table editor during a session, |
| @@ -971,6 +996,11 @@ line will be formatted with <th> tags." | |||
| 971 | :group 'org-table | 996 | :group 'org-table |
| 972 | :type 'boolean) | 997 | :type 'boolean) |
| 973 | 998 | ||
| 999 | (defcustom org-table-copy-increment t | ||
| 1000 | "Non-nil means, increment when copying current field with \\[org-table-copy-down]." | ||
| 1001 | :group 'org-table | ||
| 1002 | :type 'boolean) | ||
| 1003 | |||
| 974 | (defcustom org-table-tab-recognizes-table.el t | 1004 | (defcustom org-table-tab-recognizes-table.el t |
| 975 | "Non-nil means, TAB will automatically notice a table.el table. | 1005 | "Non-nil means, TAB will automatically notice a table.el table. |
| 976 | When it sees such a table, it moves point into it and - if necessary - | 1006 | When it sees such a table, it moves point into it and - if necessary - |
| @@ -1260,7 +1290,7 @@ Otherwise, the buffer will just be saved to a file and stay hidden." | |||
| 1260 | "Face used for level 7 headlines." | 1290 | "Face used for level 7 headlines." |
| 1261 | :group 'org-faces) | 1291 | :group 'org-faces) |
| 1262 | 1292 | ||
| 1263 | (defface org-level-8-face ;;font-lock-string-face | 1293 | (defface org-level-8-face ;; font-lock-string-face |
| 1264 | '((((type tty) (class color)) (:foreground "green")) | 1294 | '((((type tty) (class color)) (:foreground "green")) |
| 1265 | (((class color) (background light)) (:foreground "RosyBrown")) | 1295 | (((class color) (background light)) (:foreground "RosyBrown")) |
| 1266 | (((class color) (background dark)) (:foreground "LightSalmon")) | 1296 | (((class color) (background dark)) (:foreground "LightSalmon")) |
| @@ -1276,8 +1306,24 @@ Otherwise, the buffer will just be saved to a file and stay hidden." | |||
| 1276 | "Face for deadlines and TODO keyords." | 1306 | "Face for deadlines and TODO keyords." |
| 1277 | :group 'org-faces) | 1307 | :group 'org-faces) |
| 1278 | 1308 | ||
| 1279 | ;; Inheritance does not work for xemacs, unfortunately. | 1309 | (defcustom org-fontify-done-headline nil |
| 1280 | ;; We just copy the definitions and waste some space.... | 1310 | "Non-nil means, change the face of a headline if it is marked DONE. |
| 1311 | Normally, only the TODO/DONE keyword indicates the state of a headline. | ||
| 1312 | When this is non-nil, the headline after the keyword is set to the | ||
| 1313 | `org-headline-done-face' as an additional indication." | ||
| 1314 | :group 'org-faces | ||
| 1315 | :type 'boolean) | ||
| 1316 | |||
| 1317 | (defface org-headline-done-face ;; font-lock-string-face | ||
| 1318 | '((((type tty) (class color)) (:foreground "green")) | ||
| 1319 | (((class color) (background light)) (:foreground "RosyBrown")) | ||
| 1320 | (((class color) (background dark)) (:foreground "LightSalmon")) | ||
| 1321 | (t (:italic t))) | ||
| 1322 | "Face used to indicate that a headline is DONE. See also the variable | ||
| 1323 | `org-fontify-done-headline'." | ||
| 1324 | :group 'org-faces) | ||
| 1325 | |||
| 1326 | ;; Inheritance does not yet work for xemacs. So we just copy... | ||
| 1281 | 1327 | ||
| 1282 | (defface org-deadline-announce-face | 1328 | (defface org-deadline-announce-face |
| 1283 | '((((type tty) (class color)) (:foreground "blue" :weight bold)) | 1329 | '((((type tty) (class color)) (:foreground "blue" :weight bold)) |
| @@ -1341,11 +1387,11 @@ Otherwise, the buffer will just be saved to a file and stay hidden." | |||
| 1341 | )) | 1387 | )) |
| 1342 | (defvar org-n-levels (length org-level-faces)) | 1388 | (defvar org-n-levels (length org-level-faces)) |
| 1343 | 1389 | ||
| 1344 | |||
| 1345 | ;; Tell the compiler about dynamically scoped variables, | 1390 | ;; Tell the compiler about dynamically scoped variables, |
| 1346 | ;; and variables from other packages | 1391 | ;; and variables from other packages |
| 1347 | (eval-when-compile | 1392 | (eval-when-compile |
| 1348 | (defvar zmacs-regions) | 1393 | (defvar zmacs-regions) |
| 1394 | (defvar original-date) | ||
| 1349 | (defvar org-transient-mark-mode) | 1395 | (defvar org-transient-mark-mode) |
| 1350 | (defvar org-old-auto-fill-inhibit-regexp) | 1396 | (defvar org-old-auto-fill-inhibit-regexp) |
| 1351 | (defvar orgtbl-mode-menu) | 1397 | (defvar orgtbl-mode-menu) |
| @@ -1521,8 +1567,11 @@ The following commands are available: | |||
| 1521 | (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>") | 1567 | (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>") |
| 1522 | '(1 'org-warning-face t)) | 1568 | '(1 'org-warning-face t)) |
| 1523 | '("^#.*" (0 'font-lock-comment-face t)) | 1569 | '("^#.*" (0 'font-lock-comment-face t)) |
| 1524 | (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>") | 1570 | (if org-fontify-done-headline |
| 1525 | '(1 'org-done-face t)) | 1571 | (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>") |
| 1572 | '(1 'org-done-face t) '(2 'org-headline-done-face t)) | ||
| 1573 | (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>") | ||
| 1574 | '(1 'org-done-face t))) | ||
| 1526 | '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" | 1575 | '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" |
| 1527 | (1 'org-table-face t)) | 1576 | (1 'org-table-face t)) |
| 1528 | '("^[ \t]*\\(:.*\\)" (1 'org-table-face t))))) | 1577 | '("^[ \t]*\\(:.*\\)" (1 'org-table-face t))))) |
| @@ -1563,7 +1612,7 @@ The following commands are available: | |||
| 1563 | (defvar org-cycle-global-status nil) | 1612 | (defvar org-cycle-global-status nil) |
| 1564 | (defvar org-cycle-subtree-status nil) | 1613 | (defvar org-cycle-subtree-status nil) |
| 1565 | (defun org-cycle (&optional arg) | 1614 | (defun org-cycle (&optional arg) |
| 1566 | "Visibility cycling for org-mode. | 1615 | "Visibility cycling for Org-mode. |
| 1567 | 1616 | ||
| 1568 | - When this function is called with a prefix argument, rotate the entire | 1617 | - When this function is called with a prefix argument, rotate the entire |
| 1569 | buffer through 3 states (global cycling) | 1618 | buffer through 3 states (global cycling) |
| @@ -1579,6 +1628,9 @@ The following commands are available: | |||
| 1579 | zoom in further. | 1628 | zoom in further. |
| 1580 | 3. SUBTREE: Show the entire subtree, including body text. | 1629 | 3. SUBTREE: Show the entire subtree, including body text. |
| 1581 | 1630 | ||
| 1631 | - When there is a numeric prefix, go ARG levels up and do a `show-subtree', | ||
| 1632 | keeping cursor position. | ||
| 1633 | |||
| 1582 | - When point is not at the beginning of a headline, execute | 1634 | - When point is not at the beginning of a headline, execute |
| 1583 | `indent-relative', like TAB normally does. See the option | 1635 | `indent-relative', like TAB normally does. See the option |
| 1584 | `org-cycle-emulate-tab' for details. | 1636 | `org-cycle-emulate-tab' for details. |
| @@ -1587,8 +1639,9 @@ The following commands are available: | |||
| 1587 | no headline in line 1, this function will act as if called with prefix arg." | 1639 | no headline in line 1, this function will act as if called with prefix arg." |
| 1588 | (interactive "P") | 1640 | (interactive "P") |
| 1589 | 1641 | ||
| 1590 | (if (and (bobp) (not (looking-at outline-regexp))) | 1642 | (if (or (and (bobp) (not (looking-at outline-regexp))) |
| 1591 | ; special case: use global cycling | 1643 | (equal arg '(4))) |
| 1644 | ;; special case: use global cycling | ||
| 1592 | (setq arg t)) | 1645 | (setq arg t)) |
| 1593 | 1646 | ||
| 1594 | (cond | 1647 | (cond |
| @@ -1600,7 +1653,7 @@ The following commands are available: | |||
| 1600 | (org-table-justify-field-maybe) | 1653 | (org-table-justify-field-maybe) |
| 1601 | (org-table-next-field)))) | 1654 | (org-table-next-field)))) |
| 1602 | 1655 | ||
| 1603 | (arg ;; Global cycling | 1656 | ((eq arg t) ;; Global cycling |
| 1604 | 1657 | ||
| 1605 | (cond | 1658 | (cond |
| 1606 | ((and (eq last-command this-command) | 1659 | ((and (eq last-command this-command) |
| @@ -1621,18 +1674,27 @@ The following commands are available: | |||
| 1621 | (if (bobp) (throw 'exit nil)))) | 1674 | (if (bobp) (throw 'exit nil)))) |
| 1622 | (message "CONTENTS...done")) | 1675 | (message "CONTENTS...done")) |
| 1623 | (setq org-cycle-global-status 'contents)) | 1676 | (setq org-cycle-global-status 'contents)) |
| 1677 | |||
| 1624 | ((and (eq last-command this-command) | 1678 | ((and (eq last-command this-command) |
| 1625 | (eq org-cycle-global-status 'contents)) | 1679 | (eq org-cycle-global-status 'contents)) |
| 1626 | ;; We just showed the table of contents - now show everything | 1680 | ;; We just showed the table of contents - now show everything |
| 1627 | (show-all) | 1681 | (show-all) |
| 1628 | (message "SHOW ALL") | 1682 | (message "SHOW ALL") |
| 1629 | (setq org-cycle-global-status 'all)) | 1683 | (setq org-cycle-global-status 'all)) |
| 1684 | |||
| 1630 | (t | 1685 | (t |
| 1631 | ;; Default action: go to overview | 1686 | ;; Default action: go to overview |
| 1632 | (hide-sublevels 1) | 1687 | (hide-sublevels 1) |
| 1633 | (message "OVERVIEW") | 1688 | (message "OVERVIEW") |
| 1634 | (setq org-cycle-global-status 'overview)))) | 1689 | (setq org-cycle-global-status 'overview)))) |
| 1635 | 1690 | ||
| 1691 | ((integerp arg) | ||
| 1692 | ;; Show-subtree, ARG levels up from here. | ||
| 1693 | (save-excursion | ||
| 1694 | (org-back-to-heading) | ||
| 1695 | (outline-up-heading arg) | ||
| 1696 | (show-subtree))) | ||
| 1697 | |||
| 1636 | ((save-excursion (beginning-of-line 1) (looking-at outline-regexp)) | 1698 | ((save-excursion (beginning-of-line 1) (looking-at outline-regexp)) |
| 1637 | ;; At a heading: rotate between three different views | 1699 | ;; At a heading: rotate between three different views |
| 1638 | (org-back-to-heading) | 1700 | (org-back-to-heading) |
| @@ -1970,7 +2032,7 @@ is changed at all." | |||
| 1970 | (save-excursion (outline-end-of-heading) | 2032 | (save-excursion (outline-end-of-heading) |
| 1971 | (setq folded (org-invisible-p))) | 2033 | (setq folded (org-invisible-p))) |
| 1972 | (outline-end-of-subtree)) | 2034 | (outline-end-of-subtree)) |
| 1973 | (if (equal (char-after) ?\n) (forward-char 1)) | 2035 | (outline-next-heading) |
| 1974 | (setq end (point)) | 2036 | (setq end (point)) |
| 1975 | ;; Find insertion point, with error handling | 2037 | ;; Find insertion point, with error handling |
| 1976 | (goto-char beg) | 2038 | (goto-char beg) |
| @@ -1982,7 +2044,10 @@ is changed at all." | |||
| 1982 | (if (> arg 0) | 2044 | (if (> arg 0) |
| 1983 | ;; Moving forward - still need to move over subtree | 2045 | ;; Moving forward - still need to move over subtree |
| 1984 | (progn (outline-end-of-subtree) | 2046 | (progn (outline-end-of-subtree) |
| 1985 | (if (equal (char-after) ?\n) (forward-char 1)))) | 2047 | (outline-next-heading) |
| 2048 | (if (not (or (looking-at (concat "^" outline-regexp)) | ||
| 2049 | (bolp))) | ||
| 2050 | (newline)))) | ||
| 1986 | (move-marker ins-point (point)) | 2051 | (move-marker ins-point (point)) |
| 1987 | (setq txt (buffer-substring beg end)) | 2052 | (setq txt (buffer-substring beg end)) |
| 1988 | (delete-region beg end) | 2053 | (delete-region beg end) |
| @@ -1993,7 +2058,7 @@ is changed at all." | |||
| 1993 | 2058 | ||
| 1994 | (defvar org-subtree-clip "" | 2059 | (defvar org-subtree-clip "" |
| 1995 | "Clipboard for cut and paste of subtrees. | 2060 | "Clipboard for cut and paste of subtrees. |
| 1996 | This is actually only a cpoy of the kill, because we use the normal kill | 2061 | This is actually only a copy of the kill, because we use the normal kill |
| 1997 | ring. We need it to check if the kill was created by `org-copy-subtree'.") | 2062 | ring. We need it to check if the kill was created by `org-copy-subtree'.") |
| 1998 | 2063 | ||
| 1999 | (defvar org-subtree-clip-folded nil | 2064 | (defvar org-subtree-clip-folded nil |
| @@ -2906,6 +2971,14 @@ The following commands are available: | |||
| 2906 | (define-key org-agenda-mode-map "p" 'org-agenda-priority) | 2971 | (define-key org-agenda-mode-map "p" 'org-agenda-priority) |
| 2907 | (define-key org-agenda-mode-map "," 'org-agenda-priority) | 2972 | (define-key org-agenda-mode-map "," 'org-agenda-priority) |
| 2908 | (define-key org-agenda-mode-map "i" 'org-agenda-diary-entry) | 2973 | (define-key org-agenda-mode-map "i" 'org-agenda-diary-entry) |
| 2974 | (define-key org-agenda-mode-map "c" 'org-agenda-goto-calendar) | ||
| 2975 | (define-key org-agenda-mode-map "C" 'org-agenda-convert-date) | ||
| 2976 | (define-key org-agenda-mode-map "m" 'org-agenda-phases-of-moon) | ||
| 2977 | (define-key org-agenda-mode-map "M" 'org-agenda-phases-of-moon) | ||
| 2978 | (define-key org-agenda-mode-map "s" 'org-agenda-sunrise-sunset) | ||
| 2979 | (define-key org-agenda-mode-map "S" 'org-agenda-sunrise-sunset) | ||
| 2980 | (define-key org-agenda-mode-map "h" 'org-agenda-holidays) | ||
| 2981 | (define-key org-agenda-mode-map "H" 'org-agenda-holidays) | ||
| 2909 | (define-key org-agenda-mode-map "+" 'org-agenda-priority-up) | 2982 | (define-key org-agenda-mode-map "+" 'org-agenda-priority-up) |
| 2910 | (define-key org-agenda-mode-map "-" 'org-agenda-priority-down) | 2983 | (define-key org-agenda-mode-map "-" 'org-agenda-priority-down) |
| 2911 | (define-key org-agenda-mode-map [(right)] 'org-agenda-later) | 2984 | (define-key org-agenda-mode-map [(right)] 'org-agenda-later) |
| @@ -2951,6 +3024,12 @@ The following commands are available: | |||
| 2951 | :style toggle :selected org-agenda-include-diary :active t] | 3024 | :style toggle :selected org-agenda-include-diary :active t] |
| 2952 | "--" | 3025 | "--" |
| 2953 | ["New Diary Entry" org-agenda-diary-entry t] | 3026 | ["New Diary Entry" org-agenda-diary-entry t] |
| 3027 | ("Calendar commands" | ||
| 3028 | ["Goto calendar" org-agenda-goto-calendar t] | ||
| 3029 | ["Phases of the Moon" org-agenda-phases-of-moon t] | ||
| 3030 | ["Sunrise/Sunset" org-agenda-sunrise-sunset t] | ||
| 3031 | ["Holidays" org-agenda-holidays t] | ||
| 3032 | ["Convert" org-agenda-convert-date t]) | ||
| 2954 | "--" | 3033 | "--" |
| 2955 | ["Quit" org-agenda-quit t] | 3034 | ["Quit" org-agenda-quit t] |
| 2956 | ["Exit and Release Buffers" org-agenda-exit t] | 3035 | ["Exit and Release Buffers" org-agenda-exit t] |
| @@ -3110,7 +3189,7 @@ NDAYS defaults to `org-agenda-ndays'." | |||
| 3110 | (d (- nt n1))) | 3189 | (d (- nt n1))) |
| 3111 | (- sd (+ (if (< d 0) 7 0) d))))) | 3190 | (- sd (+ (if (< d 0) 7 0) d))))) |
| 3112 | (day-numbers (list start)) | 3191 | (day-numbers (list start)) |
| 3113 | s e rtn rtnall file date d start-pos) | 3192 | s e rtn rtnall file date d start-pos end-pos) |
| 3114 | (setq org-agenda-redo-command | 3193 | (setq org-agenda-redo-command |
| 3115 | (list 'org-agenda include-all start-day ndays)) | 3194 | (list 'org-agenda include-all start-day ndays)) |
| 3116 | ;; Make the list of days | 3195 | ;; Make the list of days |
| @@ -3146,7 +3225,9 @@ NDAYS defaults to `org-agenda-ndays'." | |||
| 3146 | s (point)) | 3225 | s (point)) |
| 3147 | (if (or (= d today) | 3226 | (if (or (= d today) |
| 3148 | (and (not start-pos) (= d sd))) | 3227 | (and (not start-pos) (= d sd))) |
| 3149 | (setq start-pos (point))) | 3228 | (setq start-pos (point)) |
| 3229 | (if (and start-pos (not end-pos)) | ||
| 3230 | (setq end-pos (point)))) | ||
| 3150 | (setq files org-agenda-files | 3231 | (setq files org-agenda-files |
| 3151 | rtnall nil) | 3232 | rtnall nil) |
| 3152 | (while (setq file (pop files)) | 3233 | (while (setq file (pop files)) |
| @@ -3173,6 +3254,17 @@ NDAYS defaults to `org-agenda-ndays'." | |||
| 3173 | (put-text-property s (1- (point)) 'day d)))) | 3254 | (put-text-property s (1- (point)) 'day d)))) |
| 3174 | (goto-char (point-min)) | 3255 | (goto-char (point-min)) |
| 3175 | (setq buffer-read-only t) | 3256 | (setq buffer-read-only t) |
| 3257 | (if org-fit-agenda-window | ||
| 3258 | (fit-window-to-buffer nil (/ (* (frame-height) 3) 4) | ||
| 3259 | (/ (frame-height) 2))) | ||
| 3260 | (unless (and (pos-visible-in-window-p (point-min)) | ||
| 3261 | (pos-visible-in-window-p (point-max))) | ||
| 3262 | (goto-char (1- (point-max))) | ||
| 3263 | (recenter -1) | ||
| 3264 | (if (not (pos-visible-in-window-p (or start-pos 1))) | ||
| 3265 | (progn | ||
| 3266 | (goto-char (or start-pos 1)) | ||
| 3267 | (recenter 1)))) | ||
| 3176 | (goto-char (or start-pos 1)) | 3268 | (goto-char (or start-pos 1)) |
| 3177 | (if (not org-select-agenda-window) (select-window win)) | 3269 | (if (not org-select-agenda-window) (select-window win)) |
| 3178 | (message ""))) | 3270 | (message ""))) |
| @@ -3285,10 +3377,10 @@ With prefix ARG, go back that many times `org-agenda-ndays'." | |||
| 3285 | "Set the mode name to indicate all the small mode seetings." | 3377 | "Set the mode name to indicate all the small mode seetings." |
| 3286 | (setq mode-name | 3378 | (setq mode-name |
| 3287 | (concat "Org-Agenda" | 3379 | (concat "Org-Agenda" |
| 3288 | (if (equal org-agenda-ndays 1) " Day" "") | 3380 | (if (equal org-agenda-ndays 1) " Day" "") |
| 3289 | (if (equal org-agenda-ndays 7) " Week" "") | 3381 | (if (equal org-agenda-ndays 7) " Week" "") |
| 3290 | (if org-agenda-follow-mode " Follow" "") | 3382 | (if org-agenda-follow-mode " Follow" "") |
| 3291 | (if org-agenda-include-diary " Diary" ""))) | 3383 | (if org-agenda-include-diary " Diary" ""))) |
| 3292 | (force-mode-line-update)) | 3384 | (force-mode-line-update)) |
| 3293 | 3385 | ||
| 3294 | (defun org-agenda-post-command-hook () | 3386 | (defun org-agenda-post-command-hook () |
| @@ -3299,26 +3391,33 @@ With prefix ARG, go back that many times `org-agenda-ndays'." | |||
| 3299 | (defun org-get-entries-from-diary (date) | 3391 | (defun org-get-entries-from-diary (date) |
| 3300 | "Get the (emacs calendar) diary entries for DATE." | 3392 | "Get the (emacs calendar) diary entries for DATE." |
| 3301 | (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*") | 3393 | (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*") |
| 3302 | (diary-display-hook '(sort-diary-entries fancy-diary-display)) | 3394 | (diary-display-hook '(fancy-diary-display)) |
| 3395 | (list-diary-entries-hook | ||
| 3396 | (cons 'org-diary-default-entry list-diary-entries-hook)) | ||
| 3303 | entries | 3397 | entries |
| 3304 | (disable-org-agenda t)) | 3398 | (disable-org-diary t)) |
| 3305 | (save-excursion | 3399 | (save-excursion |
| 3306 | (save-window-excursion | 3400 | (save-window-excursion |
| 3307 | (list-diary-entries date 1))) | 3401 | (list-diary-entries date 1))) |
| 3308 | (if (not (get-buffer fancy-diary-buffer)) | 3402 | (if (not (get-buffer fancy-diary-buffer)) |
| 3309 | (setq entries nil) | 3403 | (setq entries nil) |
| 3310 | (save-excursion | 3404 | (save-excursion |
| 3311 | (set-buffer fancy-diary-buffer) | 3405 | (switch-to-buffer fancy-diary-buffer) |
| 3312 | (setq buffer-read-only nil) | 3406 | (setq buffer-read-only nil) |
| 3313 | (if (= (point-max) 1) | 3407 | (if (= (point-max) 1) |
| 3314 | ;; No entries | 3408 | ;; No entries |
| 3315 | (setq entries nil) | 3409 | (setq entries nil) |
| 3316 | ;; Omit the date | 3410 | ;; Omit the date and other unnecessary stuff |
| 3317 | (beginning-of-line 3) | 3411 | (org-agenda-cleanup-fancy-diary) |
| 3318 | (delete-region (point-min) (point)) | 3412 | ;; Add prefix to each line and extend the text properties |
| 3413 | (goto-char (point-min)) | ||
| 3319 | (while (and (re-search-forward "^" nil t) (not (eobp))) | 3414 | (while (and (re-search-forward "^" nil t) (not (eobp))) |
| 3320 | (replace-match " Diary: ")) | 3415 | (replace-match " Diary: ") |
| 3321 | (setq entries (buffer-substring (point-min) (- (point-max) 1)))) | 3416 | (add-text-properties (point-at-bol) (point) |
| 3417 | (text-properties-at (point)))) | ||
| 3418 | (if (= (point-max) 1) | ||
| 3419 | (setq entries nil) | ||
| 3420 | (setq entries (buffer-substring (point-min) (- (point-max) 1))))) | ||
| 3322 | (set-buffer-modified-p nil) | 3421 | (set-buffer-modified-p nil) |
| 3323 | (kill-buffer fancy-diary-buffer))) | 3422 | (kill-buffer fancy-diary-buffer))) |
| 3324 | (when entries | 3423 | (when entries |
| @@ -3337,6 +3436,49 @@ With prefix ARG, go back that many times `org-agenda-ndays'." | |||
| 3337 | x) | 3436 | x) |
| 3338 | entries))))) | 3437 | entries))))) |
| 3339 | 3438 | ||
| 3439 | (defun org-agenda-cleanup-fancy-diary () | ||
| 3440 | "Remove unwanted stuff in buffer created by fancy-diary-display. | ||
| 3441 | This gets rid of the date, the underline under the date, and | ||
| 3442 | the dummy entry installed by org-mode to ensure non-empty diary for each | ||
| 3443 | date." | ||
| 3444 | (goto-char (point-min)) | ||
| 3445 | (if (looking-at ".*?:[ \t]*") | ||
| 3446 | (progn | ||
| 3447 | (replace-match "") | ||
| 3448 | (re-search-forward "\n=+$" nil t) | ||
| 3449 | (replace-match "") | ||
| 3450 | (while (re-search-backward "^ +" nil t) (replace-match ""))) | ||
| 3451 | (re-search-forward "\n=+$" nil t) | ||
| 3452 | (delete-region (point-min) (min (point-max) (1+ (match-end 0))))) | ||
| 3453 | (if (re-search-forward "^Org-mode dummy\n?" nil t) | ||
| 3454 | (replace-match ""))) | ||
| 3455 | |||
| 3456 | ;; Advise the add-to-diary-list function to allow org to jump to | ||
| 3457 | ;; diary entires. Wrapped into eval-after-load to avoid loading | ||
| 3458 | ;; advice unnecessarily | ||
| 3459 | (eval-after-load "diary-lib" | ||
| 3460 | '(defadvice add-to-diary-list (before org-mark-diary-entry activate) | ||
| 3461 | "Make the position visible." | ||
| 3462 | (if (and (boundp 'disable-org-diary) ;; called from org-agenda | ||
| 3463 | (stringp string) | ||
| 3464 | (buffer-file-name)) | ||
| 3465 | (add-text-properties | ||
| 3466 | 0 (length string) | ||
| 3467 | (list 'mouse-face 'highlight | ||
| 3468 | 'keymap org-agenda-keymap | ||
| 3469 | 'help-echo | ||
| 3470 | (format | ||
| 3471 | "mouse-2 or RET jump to diary file %s" | ||
| 3472 | (abbreviate-file-name (buffer-file-name))) | ||
| 3473 | 'org-agenda-diary-link t | ||
| 3474 | 'org-marker (org-agenda-new-marker (point-at-bol))) | ||
| 3475 | string)))) | ||
| 3476 | |||
| 3477 | (defun org-diary-default-entry () | ||
| 3478 | "Add a dummy entry to the diary. | ||
| 3479 | Needed to avoid empty dates which mess up holiday display." | ||
| 3480 | (add-to-diary-list original-date "Org-mode dummy" "")) | ||
| 3481 | |||
| 3340 | (defun org-add-file (&optional file) | 3482 | (defun org-add-file (&optional file) |
| 3341 | "Add current file to the list of files in variable `org-agenda-files'. | 3483 | "Add current file to the list of files in variable `org-agenda-files'. |
| 3342 | These are the files which are being checked for agenda entries. | 3484 | These are the files which are being checked for agenda entries. |
| @@ -3468,7 +3610,7 @@ function from a program - use `org-agenda-get-day-entries' instead." | |||
| 3468 | file rtn results) | 3610 | file rtn results) |
| 3469 | ;; If this is called during org-agenda, don't return any entries to | 3611 | ;; If this is called during org-agenda, don't return any entries to |
| 3470 | ;; the calendar. Org Agenda will list these entries itself. | 3612 | ;; the calendar. Org Agenda will list these entries itself. |
| 3471 | (if (boundp 'disable-org-agenda) (setq files nil)) | 3613 | (if (boundp 'disable-org-diary) (setq files nil)) |
| 3472 | (while (setq file (pop files)) | 3614 | (while (setq file (pop files)) |
| 3473 | (setq rtn (apply 'org-agenda-get-day-entries file date args)) | 3615 | (setq rtn (apply 'org-agenda-get-day-entries file date args)) |
| 3474 | (setq results (append results rtn))) | 3616 | (setq results (append results rtn))) |
| @@ -3864,7 +4006,6 @@ and by additional input from the age of a schedules or deadline entry." | |||
| 3864 | (let* ((pri (get-text-property (point-at-bol) 'priority))) | 4006 | (let* ((pri (get-text-property (point-at-bol) 'priority))) |
| 3865 | (message "Priority is %d" (if pri pri -1000)))) | 4007 | (message "Priority is %d" (if pri pri -1000)))) |
| 3866 | 4008 | ||
| 3867 | |||
| 3868 | (defun org-agenda-goto () | 4009 | (defun org-agenda-goto () |
| 3869 | "Go to the Org-mode file which contains the item at point." | 4010 | "Go to the Org-mode file which contains the item at point." |
| 3870 | (interactive) | 4011 | (interactive) |
| @@ -3875,10 +4016,11 @@ and by additional input from the age of a schedules or deadline entry." | |||
| 3875 | (switch-to-buffer-other-window buffer) | 4016 | (switch-to-buffer-other-window buffer) |
| 3876 | (widen) | 4017 | (widen) |
| 3877 | (goto-char pos) | 4018 | (goto-char pos) |
| 3878 | (org-show-hidden-entry) | 4019 | (when (eq major-mode 'org-mode) |
| 3879 | (save-excursion | 4020 | (org-show-hidden-entry) |
| 3880 | (and (outline-next-heading) | 4021 | (save-excursion |
| 3881 | (org-flag-heading nil))))) ; show the next heading | 4022 | (and (outline-next-heading) |
| 4023 | (org-flag-heading nil)))))) ; show the next heading | ||
| 3882 | 4024 | ||
| 3883 | (defun org-agenda-switch-to () | 4025 | (defun org-agenda-switch-to () |
| 3884 | "Go to the Org-mode file which contains the item at point." | 4026 | "Go to the Org-mode file which contains the item at point." |
| @@ -3891,10 +4033,11 @@ and by additional input from the age of a schedules or deadline entry." | |||
| 3891 | (delete-other-windows) | 4033 | (delete-other-windows) |
| 3892 | (widen) | 4034 | (widen) |
| 3893 | (goto-char pos) | 4035 | (goto-char pos) |
| 3894 | (org-show-hidden-entry) | 4036 | (when (eq major-mode 'org-mode) |
| 3895 | (save-excursion | 4037 | (org-show-hidden-entry) |
| 3896 | (and (outline-next-heading) | 4038 | (save-excursion |
| 3897 | (org-flag-heading nil))))) ; show the next heading | 4039 | (and (outline-next-heading) |
| 4040 | (org-flag-heading nil)))))) ; show the next heading | ||
| 3898 | 4041 | ||
| 3899 | (defun org-agenda-goto-mouse (ev) | 4042 | (defun org-agenda-goto-mouse (ev) |
| 3900 | "Go to the Org-mode file which contains the deadline at the mouse click." | 4043 | "Go to the Org-mode file which contains the deadline at the mouse click." |
| @@ -3923,12 +4066,18 @@ and by additional input from the age of a schedules or deadline entry." | |||
| 3923 | (mouse-set-point ev) | 4066 | (mouse-set-point ev) |
| 3924 | (org-agenda-show)) | 4067 | (org-agenda-show)) |
| 3925 | 4068 | ||
| 4069 | (defun org-agenda-check-no-diary () | ||
| 4070 | "Check if the entry is a diary link and abort if yes." | ||
| 4071 | (if (get-text-property (point) 'org-agenda-diary-link) | ||
| 4072 | (org-agenda-error))) | ||
| 4073 | |||
| 3926 | (defun org-agenda-error () | 4074 | (defun org-agenda-error () |
| 3927 | (error "Command not allowed in this line.")) | 4075 | (error "Command not allowed in this line.")) |
| 3928 | 4076 | ||
| 3929 | (defun org-agenda-todo () | 4077 | (defun org-agenda-todo () |
| 3930 | "Cycle TODO state of line at point, also in Org-mode file." | 4078 | "Cycle TODO state of line at point, also in Org-mode file." |
| 3931 | (interactive) | 4079 | (interactive) |
| 4080 | (org-agenda-check-no-diary) | ||
| 3932 | (let* ((props (text-properties-at (point))) | 4081 | (let* ((props (text-properties-at (point))) |
| 3933 | (col (current-column)) | 4082 | (col (current-column)) |
| 3934 | (marker (or (get-text-property (point) 'org-marker) | 4083 | (marker (or (get-text-property (point) 'org-marker) |
| @@ -3971,6 +4120,7 @@ and by additional input from the age of a schedules or deadline entry." | |||
| 3971 | (defun org-agenda-priority (&optional force-direction) | 4120 | (defun org-agenda-priority (&optional force-direction) |
| 3972 | "Set the priority of line at point, also in Org-mode file." | 4121 | "Set the priority of line at point, also in Org-mode file." |
| 3973 | (interactive) | 4122 | (interactive) |
| 4123 | (org-agenda-check-no-diary) | ||
| 3974 | (let* ((props (text-properties-at (point))) | 4124 | (let* ((props (text-properties-at (point))) |
| 3975 | (col (current-column)) | 4125 | (col (current-column)) |
| 3976 | (marker (or (get-text-property (point) 'org-marker) | 4126 | (marker (or (get-text-property (point) 'org-marker) |
| @@ -4003,6 +4153,7 @@ and by additional input from the age of a schedules or deadline entry." | |||
| 4003 | (defun org-agenda-date-later (arg &optional what) | 4153 | (defun org-agenda-date-later (arg &optional what) |
| 4004 | "Change the date of this item to one day later." | 4154 | "Change the date of this item to one day later." |
| 4005 | (interactive "p") | 4155 | (interactive "p") |
| 4156 | (org-agenda-check-no-diary) | ||
| 4006 | (let* ((marker (or (get-text-property (point) 'org-marker) | 4157 | (let* ((marker (or (get-text-property (point) 'org-marker) |
| 4007 | (org-agenda-error))) | 4158 | (org-agenda-error))) |
| 4008 | (buffer (marker-buffer marker)) | 4159 | (buffer (marker-buffer marker)) |
| @@ -4022,8 +4173,9 @@ and by additional input from the age of a schedules or deadline entry." | |||
| 4022 | (org-agenda-date-later (- arg) what)) | 4173 | (org-agenda-date-later (- arg) what)) |
| 4023 | 4174 | ||
| 4024 | (defun org-agenda-date-today (arg) | 4175 | (defun org-agenda-date-today (arg) |
| 4025 | "Change the date of this item to one day later." | 4176 | "Change the date of this item to today." |
| 4026 | (interactive "p") | 4177 | (interactive "p") |
| 4178 | (org-agenda-check-no-diary) | ||
| 4027 | (let* ((marker (or (get-text-property (point) 'org-marker) | 4179 | (let* ((marker (or (get-text-property (point) 'org-marker) |
| 4028 | (org-agenda-error))) | 4180 | (org-agenda-error))) |
| 4029 | (buffer (marker-buffer marker)) | 4181 | (buffer (marker-buffer marker)) |
| @@ -4084,7 +4236,91 @@ All the standard commands work: block, weekly etc" | |||
| 4084 | (get-text-property point 'day)))) | 4236 | (get-text-property point 'day)))) |
| 4085 | (call-interactively cmd)) | 4237 | (call-interactively cmd)) |
| 4086 | (fset 'calendar-cursor-to-date oldf))))) | 4238 | (fset 'calendar-cursor-to-date oldf))))) |
| 4087 | 4239 | ||
| 4240 | |||
| 4241 | (defun org-agenda-execute-calendar-command (cmd) | ||
| 4242 | "Execute a calendar command from the agenda, with the date associated to | ||
| 4243 | the cursor position." | ||
| 4244 | (require 'diary-lib) | ||
| 4245 | (unless (get-text-property (point) 'day) | ||
| 4246 | (error "Don't know which date to use for calendar command")) | ||
| 4247 | (let* ((oldf (symbol-function 'calendar-cursor-to-date)) | ||
| 4248 | (point (point)) | ||
| 4249 | (mark (or (mark t) (point))) | ||
| 4250 | (date (calendar-gregorian-from-absolute | ||
| 4251 | (get-text-property point 'day))) | ||
| 4252 | (displayed-day (extract-calendar-day date)) | ||
| 4253 | (displayed-month (extract-calendar-month date)) | ||
| 4254 | (displayed-year (extract-calendar-year date))) | ||
| 4255 | (unwind-protect | ||
| 4256 | (progn | ||
| 4257 | (fset 'calendar-cursor-to-date | ||
| 4258 | (lambda (&optional error) | ||
| 4259 | (calendar-gregorian-from-absolute | ||
| 4260 | (get-text-property point 'day)))) | ||
| 4261 | (call-interactively cmd)) | ||
| 4262 | (fset 'calendar-cursor-to-date oldf)))) | ||
| 4263 | |||
| 4264 | (defun org-agenda-phases-of-moon () | ||
| 4265 | "Display the phases of the moon for 3 month around cursor date." | ||
| 4266 | (interactive) | ||
| 4267 | (org-agenda-execute-calendar-command 'calendar-phases-of-moon)) | ||
| 4268 | |||
| 4269 | (defun org-agenda-holidays () | ||
| 4270 | "Display the holidays for 3 month around cursor date." | ||
| 4271 | (interactive) | ||
| 4272 | (org-agenda-execute-calendar-command 'list-calendar-holidays)) | ||
| 4273 | |||
| 4274 | (defun org-agenda-sunrise-sunset (arg) | ||
| 4275 | "Display sunrise and sunset for the cursor date. | ||
| 4276 | Latitude and longitude can be specified with the variables | ||
| 4277 | `calendar-latitude' and `calendar-longitude'. When called with prefix | ||
| 4278 | argument, location will be prompted for." | ||
| 4279 | (interactive "P") | ||
| 4280 | (let ((calendar-longitude (if arg nil calendar-longitude)) | ||
| 4281 | (calendar-latitude (if arg nil calendar-latitude)) | ||
| 4282 | (calendar-location-name nil)) | ||
| 4283 | (org-agenda-execute-calendar-command 'calendar-sunrise-sunset))) | ||
| 4284 | |||
| 4285 | (defun org-agenda-goto-calendar () | ||
| 4286 | "Open the Emacs calendar with the date at the cursor." | ||
| 4287 | (interactive) | ||
| 4288 | (let* ((day (or (get-text-property (point) 'day) | ||
| 4289 | (error "Don't know which date to open in calendar"))) | ||
| 4290 | (date (calendar-gregorian-from-absolute day))) | ||
| 4291 | (calendar) | ||
| 4292 | (calendar-goto-date date))) | ||
| 4293 | |||
| 4294 | (defun org-agenda-convert-date () | ||
| 4295 | (interactive) | ||
| 4296 | (let ((day (get-text-property (point) 'day)) | ||
| 4297 | date s) | ||
| 4298 | (unless day | ||
| 4299 | (error "Don't know which date to convert")) | ||
| 4300 | (setq date (calendar-gregorian-from-absolute day)) | ||
| 4301 | (require 'cal-julian) | ||
| 4302 | (require 'cal-hebrew) | ||
| 4303 | (require 'cal-islam) | ||
| 4304 | (require 'cal-french) | ||
| 4305 | (require 'cal-mayan) | ||
| 4306 | (require 'cal-coptic) | ||
| 4307 | (require 'cal-persia) | ||
| 4308 | (require 'cal-china) | ||
| 4309 | (setq s (concat | ||
| 4310 | "Gregorian: " (calendar-date-string date) "\n" | ||
| 4311 | "Julian: " (calendar-julian-date-string date) "\n" | ||
| 4312 | "Astronomic: " (calendar-astro-date-string date) " (at noon UTC)\n" | ||
| 4313 | "Hebrew: " (calendar-hebrew-date-string date) "\n" | ||
| 4314 | "Islamic: " (calendar-islamic-date-string date) "\n" | ||
| 4315 | "French: " (calendar-french-date-string date) "\n" | ||
| 4316 | "Maya: " (calendar-mayan-date-string date) "\n" | ||
| 4317 | "Coptic: " (calendar-coptic-date-string date) "\n" | ||
| 4318 | "Persian: " (calendar-persian-date-string date) "\n" | ||
| 4319 | "Chineese: " (calendar-chinese-date-string date) "\n")) | ||
| 4320 | (with-output-to-temp-buffer "*Dates*" | ||
| 4321 | (princ s)) | ||
| 4322 | (fit-window-to-buffer (get-buffer-window "*Dates*")))) | ||
| 4323 | |||
| 4088 | ;;; Link Stuff | 4324 | ;;; Link Stuff |
| 4089 | 4325 | ||
| 4090 | (defun org-find-file-at-mouse (ev) | 4326 | (defun org-find-file-at-mouse (ev) |
| @@ -5087,14 +5323,23 @@ Before doing so, re-align the table if necessary." | |||
| 5087 | (skip-chars-backward "^|\n\r") | 5323 | (skip-chars-backward "^|\n\r") |
| 5088 | (if (looking-at " ") (forward-char 1))))) | 5324 | (if (looking-at " ") (forward-char 1))))) |
| 5089 | 5325 | ||
| 5090 | (defun org-table-copy-from-above (n) | 5326 | (defun org-table-copy-down (n) |
| 5091 | "Copy into the current column the nearest non-empty field from above. | 5327 | "Copy a field down in the current column. |
| 5092 | With prefix argument N, take the Nth non-empty field." | 5328 | If the field at the cursor is empty, copy into it the content of the nearest |
| 5329 | non-empty field above. With argument N, use the Nth non-empty field. | ||
| 5330 | If the current fields is not empty, it is copied down to the next row, and | ||
| 5331 | the cursor is moved with it. Therefore, repeating this command causes the | ||
| 5332 | column to be filled row-by-row. | ||
| 5333 | If the variable `org-table-copy-increment' is non-nil and the field is an | ||
| 5334 | integer, it will be incremented while copying." | ||
| 5093 | (interactive "p") | 5335 | (interactive "p") |
| 5094 | (let ((colpos (org-table-current-column)) | 5336 | (let* ((colpos (org-table-current-column)) |
| 5095 | (beg (org-table-begin)) | 5337 | (field (org-table-get-field)) |
| 5096 | txt) | 5338 | (non-empty (string-match "[^ \t]" field)) |
| 5339 | (beg (org-table-begin)) | ||
| 5340 | txt) | ||
| 5097 | (org-table-check-inside-data-field) | 5341 | (org-table-check-inside-data-field) |
| 5342 | (if non-empty (progn (org-table-next-row) (org-table-blank-field))) | ||
| 5098 | (if (save-excursion | 5343 | (if (save-excursion |
| 5099 | (setq txt | 5344 | (setq txt |
| 5100 | (catch 'exit | 5345 | (catch 'exit |
| @@ -5103,10 +5348,13 @@ With prefix argument N, take the Nth non-empty field." | |||
| 5103 | beg t)) | 5348 | beg t)) |
| 5104 | (org-table-goto-column colpos t) | 5349 | (org-table-goto-column colpos t) |
| 5105 | (if (and (looking-at | 5350 | (if (and (looking-at |
| 5106 | "|[ \t]*\\([^| \t][^|]*[^| \t]\\)[ \t]*|") | 5351 | "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") |
| 5107 | (= (setq n (1- n)) 0)) | 5352 | (= (setq n (1- n)) 0)) |
| 5108 | (throw 'exit (match-string 1))))))) | 5353 | (throw 'exit (match-string 1))))))) |
| 5109 | (progn | 5354 | (progn |
| 5355 | (if (and org-table-copy-increment | ||
| 5356 | (string-match "^[0-9]+$" txt)) | ||
| 5357 | (setq txt (format "%d" (+ (string-to-int txt) 1)))) | ||
| 5110 | (insert txt) | 5358 | (insert txt) |
| 5111 | (org-table-align)) | 5359 | (org-table-align)) |
| 5112 | (error "No non-empty field found")))) | 5360 | (error "No non-empty field found")))) |
| @@ -6039,7 +6287,7 @@ table editor iin arbitrary modes.") | |||
| 6039 | ([(shift tab)] org-table-previous-field) | 6287 | ([(shift tab)] org-table-previous-field) |
| 6040 | ("\C-c\C-c" org-table-align) | 6288 | ("\C-c\C-c" org-table-align) |
| 6041 | ([(return)] org-table-next-row) | 6289 | ([(return)] org-table-next-row) |
| 6042 | ([(shift return)] org-table-copy-from-above) | 6290 | ([(shift return)] org-table-copy-down) |
| 6043 | ([(meta return)] org-table-wrap-region) | 6291 | ([(meta return)] org-table-wrap-region) |
| 6044 | ("\C-c\C-q" org-table-wrap-region) | 6292 | ("\C-c\C-q" org-table-wrap-region) |
| 6045 | ("\C-c?" org-table-current-column) | 6293 | ("\C-c?" org-table-current-column) |
| @@ -6157,7 +6405,7 @@ a reduced column width." | |||
| 6157 | "--" | 6405 | "--" |
| 6158 | ["Blank field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"] | 6406 | ["Blank field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"] |
| 6159 | ["Copy field from above" | 6407 | ["Copy field from above" |
| 6160 | org-table-copy-from-above :active (org-at-table-p) :keys "S-RET"] | 6408 | org-table-copy-down :active (org-at-table-p) :keys "S-RET"] |
| 6161 | "--" | 6409 | "--" |
| 6162 | ("Column" | 6410 | ("Column" |
| 6163 | ["Move column left" org-metaleft :active (org-at-table-p) :keys "M-<left>"] | 6411 | ["Move column left" org-metaleft :active (org-at-table-p) :keys "M-<left>"] |
| @@ -6678,7 +6926,57 @@ underlined headlines. The default is 3." | |||
| 6678 | (setq char (nth (- umax level) (reverse org-ascii-underline))) | 6926 | (setq char (nth (- umax level) (reverse org-ascii-underline))) |
| 6679 | (if org-export-with-section-numbers | 6927 | (if org-export-with-section-numbers |
| 6680 | (setq title (concat (org-section-number level) " " title))) | 6928 | (setq title (concat (org-section-number level) " " title))) |
| 6681 | (insert title "\n" (make-string (length title) char) "\n")))) | 6929 | (insert title "\n" (make-string (string-width title) char) "\n")))) |
| 6930 | |||
| 6931 | (defun org-export-copy-visible (&optional arg) | ||
| 6932 | "Copy the visible part of the buffer to another buffer, for printing. | ||
| 6933 | Also removes the first line of the buffer it is specifies a mode, | ||
| 6934 | and all options lines." | ||
| 6935 | (interactive "P") | ||
| 6936 | (let* ((filename (concat (file-name-sans-extension (buffer-file-name)) | ||
| 6937 | ".txt")) | ||
| 6938 | (buffer (find-file-noselect filename)) | ||
| 6939 | (ore (concat | ||
| 6940 | (org-make-options-regexp | ||
| 6941 | '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" "STARTUP" | ||
| 6942 | "TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE")) | ||
| 6943 | (if org-noutline-p "\\(\n\\|$\\)" ""))) | ||
| 6944 | s e) | ||
| 6945 | (save-excursion | ||
| 6946 | (set-buffer buffer) | ||
| 6947 | (erase-buffer) | ||
| 6948 | (text-mode)) | ||
| 6949 | (save-excursion | ||
| 6950 | (setq s (goto-char (point-min))) | ||
| 6951 | (while (not (= (point) (point-max))) | ||
| 6952 | (goto-char (org-find-invisible)) | ||
| 6953 | (append-to-buffer buffer s (point)) | ||
| 6954 | (setq s (goto-char (org-find-visible))))) | ||
| 6955 | (switch-to-buffer-other-window buffer) | ||
| 6956 | (newline) | ||
| 6957 | (goto-char (point-min)) | ||
| 6958 | (if (looking-at ".*-\\*- mode:.*\n") | ||
| 6959 | (replace-match "")) | ||
| 6960 | (while (re-search-forward ore nil t) | ||
| 6961 | (replace-match "")) | ||
| 6962 | (goto-char (point-min)))) | ||
| 6963 | |||
| 6964 | (defun org-find-visible () | ||
| 6965 | (if (featurep 'noutline) | ||
| 6966 | (let ((s (point))) | ||
| 6967 | (while (and (not (= (point-max) (setq s (next-overlay-change s)))) | ||
| 6968 | (get-char-property s 'invisible))) | ||
| 6969 | s) | ||
| 6970 | (skip-chars-forward "^\n") | ||
| 6971 | (point))) | ||
| 6972 | (defun org-find-invisible () | ||
| 6973 | (if (featurep 'noutline) | ||
| 6974 | (let ((s (point))) | ||
| 6975 | (while (and (not (= (point-max) (setq s (next-overlay-change s)))) | ||
| 6976 | (not (get-char-property s 'invisible)))) | ||
| 6977 | s) | ||
| 6978 | (skip-chars-forward "^\r") | ||
| 6979 | (point))) | ||
| 6682 | 6980 | ||
| 6683 | ;; HTML | 6981 | ;; HTML |
| 6684 | 6982 | ||
| @@ -7423,7 +7721,7 @@ When LEVEL is non-nil, increase section numbers on that level." | |||
| 7423 | (define-key org-mode-map [(shift tab)] 'org-shifttab) | 7721 | (define-key org-mode-map [(shift tab)] 'org-shifttab) |
| 7424 | (define-key org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) | 7722 | (define-key org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) |
| 7425 | (define-key org-mode-map [(return)] 'org-return) | 7723 | (define-key org-mode-map [(return)] 'org-return) |
| 7426 | (define-key org-mode-map [(shift return)] 'org-table-copy-from-above) | 7724 | (define-key org-mode-map [(shift return)] 'org-table-copy-down) |
| 7427 | (define-key org-mode-map [(meta return)] 'org-meta-return) | 7725 | (define-key org-mode-map [(meta return)] 'org-meta-return) |
| 7428 | (define-key org-mode-map [(control up)] 'org-move-line-up) | 7726 | (define-key org-mode-map [(control up)] 'org-move-line-up) |
| 7429 | (define-key org-mode-map [(control down)] 'org-move-line-down) | 7727 | (define-key org-mode-map [(control down)] 'org-move-line-down) |
| @@ -7436,6 +7734,10 @@ When LEVEL is non-nil, increase section numbers on that level." | |||
| 7436 | (define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region) | 7734 | (define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region) |
| 7437 | (define-key org-mode-map "\C-c\C-xa" 'org-export-as-ascii) | 7735 | (define-key org-mode-map "\C-c\C-xa" 'org-export-as-ascii) |
| 7438 | (define-key org-mode-map "\C-c\C-x\C-a" 'org-export-as-ascii) | 7736 | (define-key org-mode-map "\C-c\C-x\C-a" 'org-export-as-ascii) |
| 7737 | (define-key org-mode-map "\C-c\C-xv" 'org-export-copy-visible) | ||
| 7738 | (define-key org-mode-map "\C-c\C-x\C-v" 'org-export-copy-visible) | ||
| 7739 | (define-key org-mode-map "\C-c\C-xo" 'org-export-as-opml) | ||
| 7740 | (define-key org-mode-map "\C-c\C-x\C-o" 'org-export-as-opml) | ||
| 7439 | (define-key org-mode-map "\C-c\C-xt" 'org-insert-export-options-template) | 7741 | (define-key org-mode-map "\C-c\C-xt" 'org-insert-export-options-template) |
| 7440 | (define-key org-mode-map "\C-c:" 'org-toggle-fixed-width-section) | 7742 | (define-key org-mode-map "\C-c:" 'org-toggle-fixed-width-section) |
| 7441 | (define-key org-mode-map "\C-c\C-xh" 'org-export-as-html) | 7743 | (define-key org-mode-map "\C-c\C-xh" 'org-export-as-html) |
| @@ -7444,7 +7746,7 @@ When LEVEL is non-nil, increase section numbers on that level." | |||
| 7444 | 7746 | ||
| 7445 | ;; FIXME: Do we really need to save match data in these commands? | 7747 | ;; FIXME: Do we really need to save match data in these commands? |
| 7446 | ;; I would like to remove it in order to minimize impact. | 7748 | ;; I would like to remove it in order to minimize impact. |
| 7447 | ;; Self-insert already does not preserve it. How much resources does this take??? | 7749 | ;; Self-insert already does not preserve it. How much resources used by this??? |
| 7448 | 7750 | ||
| 7449 | (defsubst org-table-p () | 7751 | (defsubst org-table-p () |
| 7450 | (if (and (eq major-mode 'org-mode) font-lock-mode) | 7752 | (if (and (eq major-mode 'org-mode) font-lock-mode) |
| @@ -7469,28 +7771,7 @@ overwritten, and the table is not marked as requiring realignment." | |||
| 7469 | 7771 | ||
| 7470 | ;; FIXME: | 7772 | ;; FIXME: |
| 7471 | ;; The following two functions might still be optimized to trigger | 7773 | ;; The following two functions might still be optimized to trigger |
| 7472 | ;; re-alignment less frequently. Right now they raise the flag each time | 7774 | ;; re-alignment less frequently. |
| 7473 | ;; (through before-change-functions). Here is how this could be minimized: | ||
| 7474 | ;; Basically, check if the non-white field width before deletion is | ||
| 7475 | ;; equal to the column width. If yes, the delete should trigger a | ||
| 7476 | ;; re-align. I have not implemented this so far because it is not so | ||
| 7477 | ;; easy, requires grabbing the field etc. So it may finally have some | ||
| 7478 | ;; impact on typing performance which we don't want. | ||
| 7479 | |||
| 7480 | ;; The defsubst is only a draft, untested... | ||
| 7481 | |||
| 7482 | ;; Maybe it is not so important to get rid of realigns - maybe the most | ||
| 7483 | ;; important aspect is to keep the table look noce as long as possible, | ||
| 7484 | ;; which is already achieved... | ||
| 7485 | |||
| 7486 | ;(defsubst org-check-delete-triggers-realign () | ||
| 7487 | ; (let ((pos (point))) | ||
| 7488 | ; (skip-chars-backward "^|\n") | ||
| 7489 | ; (and (looking-at " *\\(.*?\\) *|") | ||
| 7490 | ; (= (nth (1- (org-table-current-column)) | ||
| 7491 | ; org-table-last-column-widths) | ||
| 7492 | ; (- (match-end 1) (match-beginning 1))) | ||
| 7493 | ; (setq org-table-may-need-update t)))) | ||
| 7494 | 7775 | ||
| 7495 | (defun org-delete-backward-char (N) | 7776 | (defun org-delete-backward-char (N) |
| 7496 | "Like `delete-backward-char', insert whitespace at field end in tables. | 7777 | "Like `delete-backward-char', insert whitespace at field end in tables. |
| @@ -7769,7 +8050,7 @@ the automatic table editor has been turned off." | |||
| 7769 | ["Next row" org-return (org-at-table-p)] | 8050 | ["Next row" org-return (org-at-table-p)] |
| 7770 | "--" | 8051 | "--" |
| 7771 | ["Blank field" org-table-blank-field (org-at-table-p)] | 8052 | ["Blank field" org-table-blank-field (org-at-table-p)] |
| 7772 | ["Copy field from above" org-table-copy-from-above (org-at-table-p)] | 8053 | ["Copy field from above" org-table-copy-down (org-at-table-p)] |
| 7773 | "--" | 8054 | "--" |
| 7774 | ("Column" | 8055 | ("Column" |
| 7775 | ["Move column left" org-metaleft (org-at-table-p)] | 8056 | ["Move column left" org-metaleft (org-at-table-p)] |
| @@ -7807,8 +8088,10 @@ the automatic table editor has been turned off." | |||
| 7807 | "--" | 8088 | "--" |
| 7808 | ("Export" | 8089 | ("Export" |
| 7809 | ["ASCII" org-export-as-ascii t] | 8090 | ["ASCII" org-export-as-ascii t] |
| 8091 | ["Extract visible text" org-export-copy-visible t] | ||
| 7810 | ["HTML" org-export-as-html t] | 8092 | ["HTML" org-export-as-html t] |
| 7811 | ["HTML, and open" org-export-as-html-and-open t] | 8093 | ["HTML, and open" org-export-as-html-and-open t] |
| 8094 | ["OPML" org-export-as-opml nil] | ||
| 7812 | "--" | 8095 | "--" |
| 7813 | ["Option template" org-insert-export-options-template t] | 8096 | ["Option template" org-insert-export-options-template t] |
| 7814 | ["Toggle fixed width" org-toggle-fixed-width-section t]) | 8097 | ["Toggle fixed width" org-toggle-fixed-width-section t]) |
| @@ -8098,3 +8381,5 @@ When ENTRY is non-nil, show the entire entry." | |||
| 8098 | 8381 | ||
| 8099 | ;;; org.el ends here | 8382 | ;;; org.el ends here |
| 8100 | 8383 | ||
| 8384 | |||
| 8385 | |||