diff options
| -rw-r--r-- | lisp/textmodes/org.el | 6476 |
1 files changed, 3259 insertions, 3217 deletions
diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el index 12ef9449aef..3477950b182 100644 --- a/lisp/textmodes/org.el +++ b/lisp/textmodes/org.el | |||
| @@ -5,7 +5,7 @@ | |||
| 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.12 | 8 | ;; Version: 3.13 |
| 9 | ;; | 9 | ;; |
| 10 | ;; This file is part of GNU Emacs. | 10 | ;; This file is part of GNU Emacs. |
| 11 | ;; | 11 | ;; |
| @@ -80,6 +80,10 @@ | |||
| 80 | ;; | 80 | ;; |
| 81 | ;; Changes: | 81 | ;; Changes: |
| 82 | ;; ------- | 82 | ;; ------- |
| 83 | ;; Version 3.13 | ||
| 84 | ;; - Efficiency improvements: Fewer table re-alignments needed. | ||
| 85 | ;; - New special lines in tables, for defining names for individual cells. | ||
| 86 | ;; | ||
| 83 | ;; Version 3.12 | 87 | ;; Version 3.12 |
| 84 | ;; - Tables can store formulas (one per column) and compute fields. | 88 | ;; - Tables can store formulas (one per column) and compute fields. |
| 85 | ;; Not quite like a full spreadsheet, but very powerful. | 89 | ;; Not quite like a full spreadsheet, but very powerful. |
| @@ -178,7 +182,7 @@ | |||
| 178 | 182 | ||
| 179 | ;;; Customization variables | 183 | ;;; Customization variables |
| 180 | 184 | ||
| 181 | (defvar org-version "3.12" | 185 | (defvar org-version "3.13" |
| 182 | "The version number of the file org.el.") | 186 | "The version number of the file org.el.") |
| 183 | (defun org-version () | 187 | (defun org-version () |
| 184 | (interactive) | 188 | (interactive) |
| @@ -193,7 +197,7 @@ | |||
| 193 | "Are we using the new outline mode?") | 197 | "Are we using the new outline mode?") |
| 194 | 198 | ||
| 195 | (defgroup org nil | 199 | (defgroup org nil |
| 196 | "Outline-based notes management and organizer." | 200 | "Outline-based notes management and organizer " |
| 197 | :tag "Org" | 201 | :tag "Org" |
| 198 | :group 'outlines | 202 | :group 'outlines |
| 199 | :group 'hypermedia | 203 | :group 'hypermedia |
| @@ -240,7 +244,7 @@ second element will be used when `org-CUA-compatible' is t.") | |||
| 240 | "Select a key according to `org-CUA-compatible'." | 244 | "Select a key according to `org-CUA-compatible'." |
| 241 | (nth (if org-CUA-compatible 2 1) | 245 | (nth (if org-CUA-compatible 2 1) |
| 242 | (or (assq key org-disputed-keys) | 246 | (or (assq key org-disputed-keys) |
| 243 | (error "Invalid Key %s in `org-key'" key)))) | 247 | (error "Invalid Key %s in `org-key'" key)))) |
| 244 | 248 | ||
| 245 | (defcustom org-startup-folded t | 249 | (defcustom org-startup-folded t |
| 246 | "Non-nil means, entering Org-mode will switch to OVERVIEW. | 250 | "Non-nil means, entering Org-mode will switch to OVERVIEW. |
| @@ -252,9 +256,9 @@ the following lines anywhere in the buffer: | |||
| 252 | #+STARTUP: content" | 256 | #+STARTUP: content" |
| 253 | :group 'org-startup | 257 | :group 'org-startup |
| 254 | :type '(choice | 258 | :type '(choice |
| 255 | (const :tag "nofold: show all" nil) | 259 | (const :tag "nofold: show all" nil) |
| 256 | (const :tag "fold: overview" t) | 260 | (const :tag "fold: overview" t) |
| 257 | (const :tag "content: all headlines" content))) | 261 | (const :tag "content: all headlines" content))) |
| 258 | 262 | ||
| 259 | (defcustom org-startup-truncated t | 263 | (defcustom org-startup-truncated t |
| 260 | "Non-nil means, entering Org-mode will set `truncate-lines'. | 264 | "Non-nil means, entering Org-mode will set `truncate-lines'. |
| @@ -311,11 +315,11 @@ states. There are two ways how these keywords can be used: | |||
| 311 | 315 | ||
| 312 | - As a sequence in the process of working on a TODO item, for example | 316 | - As a sequence in the process of working on a TODO item, for example |
| 313 | (setq org-todo-keywords '(\"TODO\" \"STARTED\" \"VERIFY\" \"DONE\") | 317 | (setq org-todo-keywords '(\"TODO\" \"STARTED\" \"VERIFY\" \"DONE\") |
| 314 | org-todo-interpretation 'sequence) | 318 | org-todo-interpretation 'sequence) |
| 315 | 319 | ||
| 316 | - As different types of TODO items, for example | 320 | - As different types of TODO items, for example |
| 317 | (setq org-todo-keywords '(\"URGENT\" \"RELAXED\" \"REMIND\" \"FOR_TOM\" \"DONE\") | 321 | (setq org-todo-keywords '(\"URGENT\" \"RELAXED\" \"REMIND\" \"FOR_TOM\" \"DONE\") |
| 318 | org-todo-interpretation 'type) | 322 | org-todo-interpretation 'type) |
| 319 | 323 | ||
| 320 | When the states are interpreted as a sequence, \\[org-todo] always cycles | 324 | When the states are interpreted as a sequence, \\[org-todo] always cycles |
| 321 | to the next state, in order to walk through all different states. So with | 325 | to the next state, in order to walk through all different states. So with |
| @@ -338,7 +342,7 @@ directly into the buffer. M-TAB completes TODO keywords at the | |||
| 338 | beginning of a headline." | 342 | beginning of a headline." |
| 339 | :group 'org-keywords | 343 | :group 'org-keywords |
| 340 | :type '(choice (const sequence) | 344 | :type '(choice (const sequence) |
| 341 | (const type))) | 345 | (const type))) |
| 342 | 346 | ||
| 343 | (defcustom org-default-priority ?B | 347 | (defcustom org-default-priority ?B |
| 344 | "The default priority of TODO items. | 348 | "The default priority of TODO items. |
| @@ -445,83 +449,83 @@ is used instead.") | |||
| 445 | "Precompute regular expressions for current buffer." | 449 | "Precompute regular expressions for current buffer." |
| 446 | (when (eq major-mode 'org-mode) | 450 | (when (eq major-mode 'org-mode) |
| 447 | (let ((re (org-make-options-regexp | 451 | (let ((re (org-make-options-regexp |
| 448 | '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" | 452 | '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" |
| 449 | "STARTUP" "ARCHIVE"))) | 453 | "STARTUP" "ARCHIVE"))) |
| 450 | (splitre "[ \t]+") | 454 | (splitre "[ \t]+") |
| 451 | kwds int key value cat arch) | 455 | kwds int key value cat arch) |
| 452 | (save-excursion | 456 | (save-excursion |
| 453 | (save-restriction | 457 | (save-restriction |
| 454 | (widen) | 458 | (widen) |
| 455 | (goto-char (point-min)) | 459 | (goto-char (point-min)) |
| 456 | (while (re-search-forward re nil t) | 460 | (while (re-search-forward re nil t) |
| 457 | (setq key (match-string 1) value (match-string 2)) | 461 | (setq key (match-string 1) value (match-string 2)) |
| 458 | (cond | 462 | (cond |
| 459 | ((equal key "CATEGORY") | 463 | ((equal key "CATEGORY") |
| 460 | (if (string-match "[ \t]+$" value) | 464 | (if (string-match "[ \t]+$" value) |
| 461 | (setq value (replace-match "" t t value))) | 465 | (setq value (replace-match "" t t value))) |
| 462 | (setq cat (intern value))) | 466 | (setq cat (intern value))) |
| 463 | ((equal key "SEQ_TODO") | 467 | ((equal key "SEQ_TODO") |
| 464 | (setq int 'sequence | 468 | (setq int 'sequence |
| 465 | kwds (append kwds (org-split-string value splitre)))) | 469 | kwds (append kwds (org-split-string value splitre)))) |
| 466 | ((equal key "PRI_TODO") | 470 | ((equal key "PRI_TODO") |
| 467 | (setq int 'priority | 471 | (setq int 'priority |
| 468 | kwds (append kwds (org-split-string value splitre)))) | 472 | kwds (append kwds (org-split-string value splitre)))) |
| 469 | ((equal key "TYP_TODO") | 473 | ((equal key "TYP_TODO") |
| 470 | (setq int 'type | 474 | (setq int 'type |
| 471 | kwds (append kwds (org-split-string value splitre)))) | 475 | kwds (append kwds (org-split-string value splitre)))) |
| 472 | ((equal key "STARTUP") | 476 | ((equal key "STARTUP") |
| 473 | (let ((opts (org-split-string value splitre)) | 477 | (let ((opts (org-split-string value splitre)) |
| 474 | (set '(("fold" org-startup-folded t) | 478 | (set '(("fold" org-startup-folded t) |
| 475 | ("nofold" org-startup-folded nil) | 479 | ("nofold" org-startup-folded nil) |
| 476 | ("content" org-startup-folded content) | 480 | ("content" org-startup-folded content) |
| 477 | ("dlcheck" org-startup-with-deadline-check t) | 481 | ("dlcheck" org-startup-with-deadline-check t) |
| 478 | ("nodlcheck" org-startup-with-deadline-check nil))) | 482 | ("nodlcheck" org-startup-with-deadline-check nil))) |
| 479 | l var val) | 483 | l var val) |
| 480 | (while (setq l (assoc (pop opts) set)) | 484 | (while (setq l (assoc (pop opts) set)) |
| 481 | (setq var (nth 1 l) val (nth 2 l)) | 485 | (setq var (nth 1 l) val (nth 2 l)) |
| 482 | (set (make-local-variable var) val)))) | 486 | (set (make-local-variable var) val)))) |
| 483 | ((equal key "ARCHIVE") | 487 | ((equal key "ARCHIVE") |
| 484 | (string-match " *$" value) | 488 | (string-match " *$" value) |
| 485 | (setq arch (replace-match "" t t value)) | 489 | (setq arch (replace-match "" t t value)) |
| 486 | (remove-text-properties 0 (length arch) | 490 | (remove-text-properties 0 (length arch) |
| 487 | '(face t fontified t) arch))) | 491 | '(face t fontified t) arch))) |
| 488 | ))) | 492 | ))) |
| 489 | (and cat (set (make-local-variable 'org-category) cat)) | 493 | (and cat (set (make-local-variable 'org-category) cat)) |
| 490 | (and kwds (set (make-local-variable 'org-todo-keywords) kwds)) | 494 | (and kwds (set (make-local-variable 'org-todo-keywords) kwds)) |
| 491 | (and arch (set (make-local-variable 'org-archive-location) arch)) | 495 | (and arch (set (make-local-variable 'org-archive-location) arch)) |
| 492 | (and int (set (make-local-variable 'org-todo-interpretation) int))) | 496 | (and int (set (make-local-variable 'org-todo-interpretation) int))) |
| 493 | ;; Compute the regular expressions and other local variables | 497 | ;; Compute the regular expressions and other local variables |
| 494 | (setq org-todo-kwd-priority-p (equal org-todo-interpretation 'priority) | 498 | (setq org-todo-kwd-priority-p (equal org-todo-interpretation 'priority) |
| 495 | org-todo-kwd-max-priority (1- (length org-todo-keywords)) | 499 | org-todo-kwd-max-priority (1- (length org-todo-keywords)) |
| 496 | org-ds-keyword-length (+ 2 (max (length org-deadline-string) | 500 | org-ds-keyword-length (+ 2 (max (length org-deadline-string) |
| 497 | (length org-scheduled-string))) | 501 | (length org-scheduled-string))) |
| 498 | org-done-string | 502 | org-done-string |
| 499 | (nth (1- (length org-todo-keywords)) org-todo-keywords) | 503 | (nth (1- (length org-todo-keywords)) org-todo-keywords) |
| 500 | org-todo-regexp | 504 | org-todo-regexp |
| 501 | (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords | 505 | (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords |
| 502 | "\\|") "\\)\\>") | 506 | "\\|") "\\)\\>") |
| 503 | org-not-done-regexp | 507 | org-not-done-regexp |
| 504 | (concat "\\<\\(" | 508 | (concat "\\<\\(" |
| 505 | (mapconcat 'regexp-quote | 509 | (mapconcat 'regexp-quote |
| 506 | (nreverse (cdr (reverse org-todo-keywords))) | 510 | (nreverse (cdr (reverse org-todo-keywords))) |
| 507 | "\\|") | 511 | "\\|") |
| 508 | "\\)\\>") | 512 | "\\)\\>") |
| 509 | org-todo-line-regexp | 513 | org-todo-line-regexp |
| 510 | (concat "^\\(\\*+\\)[ \t]*\\(" | 514 | (concat "^\\(\\*+\\)[ \t]*\\(" |
| 511 | (mapconcat 'regexp-quote org-todo-keywords "\\|") | 515 | (mapconcat 'regexp-quote org-todo-keywords "\\|") |
| 512 | "\\)? *\\(.*\\)") | 516 | "\\)? *\\(.*\\)") |
| 513 | org-nl-done-regexp | 517 | org-nl-done-regexp |
| 514 | (concat "[\r\n]\\*+[ \t]+" org-done-string "\\>") | 518 | (concat "[\r\n]\\*+[ \t]+" org-done-string "\\>") |
| 515 | org-looking-at-done-regexp (concat "^" org-done-string "\\>") | 519 | org-looking-at-done-regexp (concat "^" org-done-string "\\>") |
| 516 | org-deadline-regexp (concat "\\<" org-deadline-string) | 520 | org-deadline-regexp (concat "\\<" org-deadline-string) |
| 517 | org-deadline-time-regexp | 521 | org-deadline-time-regexp |
| 518 | (concat "\\<" org-deadline-string " *<\\([^>]+\\)>") | 522 | (concat "\\<" org-deadline-string " *<\\([^>]+\\)>") |
| 519 | org-deadline-line-regexp | 523 | org-deadline-line-regexp |
| 520 | (concat "\\<\\(" org-deadline-string "\\).*") | 524 | (concat "\\<\\(" org-deadline-string "\\).*") |
| 521 | org-scheduled-regexp | 525 | org-scheduled-regexp |
| 522 | (concat "\\<" org-scheduled-string) | 526 | (concat "\\<" org-scheduled-string) |
| 523 | org-scheduled-time-regexp | 527 | org-scheduled-time-regexp |
| 524 | (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")) | 528 | (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")) |
| 525 | (org-set-font-lock-defaults))) | 529 | (org-set-font-lock-defaults))) |
| 526 | 530 | ||
| 527 | (defgroup org-time nil | 531 | (defgroup org-time nil |
| @@ -594,12 +598,12 @@ When nil, only the days which actually have entries are shown." | |||
| 594 | ;; require a variable ndays treatment. | 598 | ;; require a variable ndays treatment. |
| 595 | (defcustom org-agenda-start-on-weekday 1 | 599 | (defcustom org-agenda-start-on-weekday 1 |
| 596 | "Non-nil means, start the overview always on the specified weekday. | 600 | "Non-nil means, start the overview always on the specified weekday. |
| 597 | 0 denotes Sunday, 1 denotes Monday etc. | 601 | 0 Denotes Sunday, 1 denotes Monday etc. |
| 598 | When nil, always start on the current day." | 602 | When nil, always start on the current day." |
| 599 | :group 'org-agenda | 603 | :group 'org-agenda |
| 600 | :type '(choice (const :tag "Today" nil) | 604 | :type '(choice (const :tag "Today" nil) |
| 601 | (const :tag "First day of month" t) | 605 | (const :tag "First day of month" t) |
| 602 | (number :tag "Weekday No."))) | 606 | (number :tag "Weekday No."))) |
| 603 | 607 | ||
| 604 | (defcustom org-agenda-ndays 7 | 608 | (defcustom org-agenda-ndays 7 |
| 605 | "Number of days to include in overview display." | 609 | "Number of days to include in overview display." |
| @@ -623,8 +627,8 @@ the entries for specific days." | |||
| 623 | (defcustom org-calendar-to-agenda-key [?c] | 627 | (defcustom org-calendar-to-agenda-key [?c] |
| 624 | "The key to be installed in `calendar-mode-map' for switching to the agenda. | 628 | "The key to be installed in `calendar-mode-map' for switching to the agenda. |
| 625 | The command `org-calendar-goto-agenda' will be bound to this key. The | 629 | The command `org-calendar-goto-agenda' will be bound to this key. The |
| 626 | default is the character `c' because then `c' can be used to switch back and | 630 | default is the character `c' because then`c' can be used to switch back and |
| 627 | forth between agenda and calendar." | 631 | force between agenda and calendar." |
| 628 | :group 'org-agenda | 632 | :group 'org-agenda |
| 629 | :type 'sexp) | 633 | :type 'sexp) |
| 630 | 634 | ||
| @@ -632,12 +636,12 @@ forth between agenda and calendar." | |||
| 632 | "Sorting structure for the agenda items of a single day. | 636 | "Sorting structure for the agenda items of a single day. |
| 633 | This is a list of symbols which will be used in sequence to determine | 637 | This is a list of symbols which will be used in sequence to determine |
| 634 | if an entry should be listed before another entry. The following | 638 | if an entry should be listed before another entry. The following |
| 635 | symbols are recognized: | 639 | symbols are recognized. |
| 636 | 640 | ||
| 637 | time-up Put entries with time-of-day indications first, early first | 641 | time-up Put entries with time-of-day indications first, early first |
| 638 | time-down Put entries with time-of-day indications first, late first | 642 | time-down Put entries with time-of-day indications first, late first |
| 639 | category-keep Keep the default order of categories, corresponding to the | 643 | category-keep Keep the default order of categories, corresponding to the |
| 640 | sequence in `org-agenda-files'. | 644 | sequence in `org-agenda-files'. |
| 641 | category-up Sort alphabetically by category, A-Z. | 645 | category-up Sort alphabetically by category, A-Z. |
| 642 | category-down Sort alphabetically by category, Z-A. | 646 | category-down Sort alphabetically by category, Z-A. |
| 643 | priority-up Sort numerically by priority, high priority last. | 647 | priority-up Sort numerically by priority, high priority last. |
| @@ -657,14 +661,14 @@ Leaving out `category-keep' would mean that items will be sorted across | |||
| 657 | categories by priority." | 661 | categories by priority." |
| 658 | :group 'org-agenda | 662 | :group 'org-agenda |
| 659 | :type '(repeat | 663 | :type '(repeat |
| 660 | (choice | 664 | (choice |
| 661 | (const time-up) | 665 | (const time-up) |
| 662 | (const time-down) | 666 | (const time-down) |
| 663 | (const category-keep) | 667 | (const category-keep) |
| 664 | (const category-up) | 668 | (const category-up) |
| 665 | (const category-down) | 669 | (const category-down) |
| 666 | (const priority-up) | 670 | (const priority-up) |
| 667 | (const priority-down)))) | 671 | (const priority-down)))) |
| 668 | 672 | ||
| 669 | (defcustom org-agenda-prefix-format " %-12:c%?-12t% s" | 673 | (defcustom org-agenda-prefix-format " %-12:c%?-12t% s" |
| 670 | "Format specification for the prefix of items in the agenda buffer. | 674 | "Format specification for the prefix of items in the agenda buffer. |
| @@ -725,9 +729,9 @@ of `org-agenda-prefix-format' or `org-timeline-prefix-format'.") | |||
| 725 | (defcustom org-agenda-use-time-grid t | 729 | (defcustom org-agenda-use-time-grid t |
| 726 | "Non-nil means, show a time grid in the agenda schedule. | 730 | "Non-nil means, show a time grid in the agenda schedule. |
| 727 | A time grid is a set of lines for specific times (like every two hours between | 731 | A time grid is a set of lines for specific times (like every two hours between |
| 728 | 8:00 and 20:00). The items scheduled for a day at specific times are | 732 | 8:00 and 20:00. The items scheduled for a day at specific times are |
| 729 | sorted in between these lines. | 733 | sorted in between these lines. |
| 730 | For details about when the grid will be shown, and what it will look like, see | 734 | For deails about when the grid will be shown, and what it will look like, see |
| 731 | the variable `org-agenda-time-grid'." | 735 | the variable `org-agenda-time-grid'." |
| 732 | :group 'org-agenda | 736 | :group 'org-agenda |
| 733 | :type 'boolean) | 737 | :type 'boolean) |
| @@ -754,13 +758,13 @@ a grid line." | |||
| 754 | :type | 758 | :type |
| 755 | '(list | 759 | '(list |
| 756 | (set :greedy t :tag "Grid Display Options" | 760 | (set :greedy t :tag "Grid Display Options" |
| 757 | (const :tag "Show grid in single day agenda display" daily) | 761 | (const :tag "Show grid in single day agenda display" daily) |
| 758 | (const :tag "Show grid in weekly agenda display" weekly) | 762 | (const :tag "Show grid in weekly agenda display" weekly) |
| 759 | (const :tag "Always show grid for today" today) | 763 | (const :tag "Always show grid for today" today) |
| 760 | (const :tag "Show grid only if any timed entries are present" | 764 | (const :tag "Show grid only if any timed entries are present" |
| 761 | require-timed) | 765 | require-timed) |
| 762 | (const :tag "Skip grid times already present in an entry" | 766 | (const :tag "Skip grid times already present in an entry" |
| 763 | remove-match)) | 767 | remove-match)) |
| 764 | (string :tag "Grid String") | 768 | (string :tag "Grid String") |
| 765 | (repeat :tag "Grid Times" (integer :tag "Time")))) | 769 | (repeat :tag "Grid Times" (integer :tag "Time")))) |
| 766 | 770 | ||
| @@ -777,9 +781,9 @@ that the time should only be removed what it is located at the beginning of | |||
| 777 | the headline/diary entry." | 781 | the headline/diary entry." |
| 778 | :group 'org-agenda | 782 | :group 'org-agenda |
| 779 | :type '(choice | 783 | :type '(choice |
| 780 | (const :tag "Always" t) | 784 | (const :tag "Always" t) |
| 781 | (const :tag "Never" nil) | 785 | (const :tag "Never" nil) |
| 782 | (const :tag "When at beginning of entry" beg))) | 786 | (const :tag "When at beginning of entry" beg))) |
| 783 | 787 | ||
| 784 | (defcustom org-sort-agenda-notime-is-late t | 788 | (defcustom org-sort-agenda-notime-is-late t |
| 785 | "Non-nil means, items without time are considered late. | 789 | "Non-nil means, items without time are considered late. |
| @@ -848,7 +852,7 @@ unnecessary clutter." | |||
| 848 | This string consists of two parts, separated by a double-colon. | 852 | This string consists of two parts, separated by a double-colon. |
| 849 | 853 | ||
| 850 | The first part is a file name - when omitted, archiving happens in the same | 854 | The first part is a file name - when omitted, archiving happens in the same |
| 851 | file. `%s' will be replaced by the current file name (without directory part). | 855 | file. %s will be replaced by the current file name (without directory part). |
| 852 | Archiving to a different file is useful to keep archived entries from | 856 | Archiving to a different file is useful to keep archived entries from |
| 853 | contributing to the Org-mode Agenda. | 857 | contributing to the Org-mode Agenda. |
| 854 | 858 | ||
| @@ -858,19 +862,19 @@ at the end of the file, as top-level entries. | |||
| 858 | 862 | ||
| 859 | Here are a few examples: | 863 | Here are a few examples: |
| 860 | \"%s_archive::\" | 864 | \"%s_archive::\" |
| 861 | If the current file is Projects.org, archive in file | 865 | If the current file is Projects.org, archive in file |
| 862 | Projects.org_archive, as top-level trees. This is the default. | 866 | Projects.org_archive, as top-level trees. This is the default. |
| 863 | 867 | ||
| 864 | \"::* Archived Tasks\" | 868 | \"::* Archived Tasks\" |
| 865 | Archive in the current file, under the top-level headline | 869 | Archive in the current file, under the top-level headline |
| 866 | \"* Archived Tasks\". | 870 | \"* Archived Tasks\". |
| 867 | 871 | ||
| 868 | \"~/org/archive.org::\" | 872 | \"~/org/archive.org::\" |
| 869 | Archive in file ~/org/archive.org (absolute path), as top-level trees. | 873 | Archive in file ~/org/archive.org (absolute path), as top-level trees. |
| 870 | 874 | ||
| 871 | \"basement::** Finished Tasks\" | 875 | \"basement::** Finished Tasks\" |
| 872 | Archive in file ./basement (relative path), as level 3 trees | 876 | Archive in file ./basement (relative path), as level 3 trees |
| 873 | below the level 2 heading \"** Finished Tasks\". | 877 | below the level 2 heading \"** Finished Tasks\". |
| 874 | 878 | ||
| 875 | You may set this option on a per-file basis by adding to the buffer a | 879 | You may set this option on a per-file basis by adding to the buffer a |
| 876 | line like | 880 | line like |
| @@ -905,17 +909,17 @@ include angle brackets into this format, like \"<%s>\". Some people also | |||
| 905 | recommend an additional URL: prefix, so the format would be \"<URL:%s>\"." | 909 | recommend an additional URL: prefix, so the format would be \"<URL:%s>\"." |
| 906 | :group 'org-link | 910 | :group 'org-link |
| 907 | :type '(choice | 911 | :type '(choice |
| 908 | (const :tag "\"%s\" (e.g. http://www.there.com)" "%s") | 912 | (const :tag "\"%s\" (e.g. http://www.there.com)" "%s") |
| 909 | (const :tag "\"<%s>\" (e.g. <http://www.there.com>)" "<%s>") | 913 | (const :tag "\"<%s>\" (e.g. <http://www.there.com>)" "<%s>") |
| 910 | (const :tag "\"<URL:%s>\" (e.g. <URL:http://www.there.com>)" "<URL:%s>") | 914 | (const :tag "\"<URL:%s>\" (e.g. <URL:http://www.there.com>)" "<URL:%s>") |
| 911 | (string :tag "Other" :value "<%s>"))) | 915 | (string :tag "Other" :value "<%s>"))) |
| 912 | 916 | ||
| 913 | (defcustom org-allow-space-in-links t | 917 | (defcustom org-allow-space-in-links t |
| 914 | "Non-nil means, file names in links may contain space characters. | 918 | "Non-nil means, file names in links may contain space characters. |
| 915 | When nil, it becomes possible to put several links into a line. | 919 | When nil, it becomes possible to put several links into a line. |
| 916 | Note that in tables, a link never extends accross fields, so in a table | 920 | Note that in tables, a link never extends accross fields, so in a table |
| 917 | it is always possible to put several links into a line. | 921 | it is always possible to put several links into a line. |
| 918 | Changing this variable requires a re-launch of Emacs to become effective." | 922 | Changing this varable requires a re-launch of Emacs of become effective." |
| 919 | :group 'org-link | 923 | :group 'org-link |
| 920 | :type 'boolean) | 924 | :type 'boolean) |
| 921 | 925 | ||
| @@ -964,23 +968,23 @@ For BBDB, it is currently only possible to display the matches in | |||
| 964 | another window." | 968 | another window." |
| 965 | :group 'org-link | 969 | :group 'org-link |
| 966 | :type '(list | 970 | :type '(list |
| 967 | (cons (const vm) | 971 | (cons (const vm) |
| 968 | (choice | 972 | (choice |
| 969 | (const vm-visit-folder) | 973 | (const vm-visit-folder) |
| 970 | (const vm-visit-folder-other-window) | 974 | (const vm-visit-folder-other-window) |
| 971 | (const vm-visit-folder-other-frame))) | 975 | (const vm-visit-folder-other-frame))) |
| 972 | (cons (const gnus) | 976 | (cons (const gnus) |
| 973 | (choice | 977 | (choice |
| 974 | (const gnus) | 978 | (const gnus) |
| 975 | (const gnus-other-frame))) | 979 | (const gnus-other-frame))) |
| 976 | (cons (const file) | 980 | (cons (const file) |
| 977 | (choice | 981 | (choice |
| 978 | (const find-file) | 982 | (const find-file) |
| 979 | (const find-file-other-window) | 983 | (const find-file-other-window) |
| 980 | (const find-file-other-frame))))) | 984 | (const find-file-other-frame))))) |
| 981 | 985 | ||
| 982 | (defcustom org-usenet-links-prefer-google nil | 986 | (defcustom org-usenet-links-prefer-google nil |
| 983 | "Non-nil means, `org-store-link' will create web links to Google groups. | 987 | "Non-nil means, `org-store-link' will create web links to google groups. |
| 984 | When nil, Gnus will be used for such links. | 988 | When nil, Gnus will be used for such links. |
| 985 | Using a prefix arg to the command \\[org-store-link] (`org-store-link') | 989 | Using a prefix arg to the command \\[org-store-link] (`org-store-link') |
| 986 | negates this setting for the duration of the command." | 990 | negates this setting for the duration of the command." |
| @@ -1023,7 +1027,7 @@ The default is true, to keep new users from shooting into their own foot." | |||
| 1023 | ("html" . "netscape -remote openURL(%s,new-window)") | 1027 | ("html" . "netscape -remote openURL(%s,new-window)") |
| 1024 | ("htm" . "netscape -remote openURL(%s,new-window)") | 1028 | ("htm" . "netscape -remote openURL(%s,new-window)") |
| 1025 | ("xs" . "soffice %s")) | 1029 | ("xs" . "soffice %s")) |
| 1026 | "Default file applications on a GNU-like system. | 1030 | "Default file applications on a UNIX/LINUX system. |
| 1027 | See `org-file-apps'.") | 1031 | See `org-file-apps'.") |
| 1028 | 1032 | ||
| 1029 | (defconst org-file-apps-defaults-macosx | 1033 | (defconst org-file-apps-defaults-macosx |
| @@ -1061,21 +1065,21 @@ and the corresponding command. Possible values for the command are: | |||
| 1061 | `emacs' The file will be visited by the current Emacs process. | 1065 | `emacs' The file will be visited by the current Emacs process. |
| 1062 | `default' Use the default application for this file type. | 1066 | `default' Use the default application for this file type. |
| 1063 | string A command to be executed by a shell; %s will be replaced | 1067 | string A command to be executed by a shell; %s will be replaced |
| 1064 | by the path to the file. | 1068 | by the path to the file. |
| 1065 | sexp A Lisp form which will be evaluated. The file path will | 1069 | sexp A Lisp form which will be evaluated. The file path will |
| 1066 | be available in the Lisp variable `file'. | 1070 | be available in the Lisp variable `file'. |
| 1067 | For more examples, see the system specific constants | 1071 | For more examples, see the system specific constants |
| 1068 | `org-file-apps-defaults-macosx' | 1072 | `org-file-apps-defaults-macosx' |
| 1069 | `org-file-apps-defaults-windowsnt' | 1073 | `org-file-apps-defaults-windowsnt' |
| 1070 | `org-file-apps-defaults-gnu'." | 1074 | `org-file-apps-defaults-gnu'." |
| 1071 | :group 'org-link | 1075 | :group 'org-link |
| 1072 | :type '(repeat | 1076 | :type '(repeat |
| 1073 | (cons (string :tag "Extension") | 1077 | (cons (string :tag "Extension") |
| 1074 | (choice :value "" | 1078 | (choice :value "" |
| 1075 | (const :tag "Visit with Emacs" 'emacs) | 1079 | (const :tag "Visit with Emacs" 'emacs) |
| 1076 | (const :tag "Use system default" 'default) | 1080 | (const :tag "Use system default" 'default) |
| 1077 | (string :tag "Command") | 1081 | (string :tag "Command") |
| 1078 | (sexp :tag "Lisp form"))))) | 1082 | (sexp :tag "Lisp form"))))) |
| 1079 | 1083 | ||
| 1080 | 1084 | ||
| 1081 | (defgroup org-remember nil | 1085 | (defgroup org-remember nil |
| @@ -1096,18 +1100,18 @@ Used by the hooks for remember.el. This can be a string, or nil to mean | |||
| 1096 | the value of `remember-data-file'." | 1100 | the value of `remember-data-file'." |
| 1097 | :group 'org-remember | 1101 | :group 'org-remember |
| 1098 | :type '(choice | 1102 | :type '(choice |
| 1099 | (const :tag "Default from remember-data-file" nil) | 1103 | (const :tag "Default from remember-data-file" nil) |
| 1100 | file)) | 1104 | file)) |
| 1101 | 1105 | ||
| 1102 | (defcustom org-reverse-note-order nil | 1106 | (defcustom org-reverse-note-order nil |
| 1103 | "Non-nil means, store new notes at the beginning of a file or entry. | 1107 | "Non-nil means, store new notes at the beginning of a file or entry. |
| 1104 | When nil, new notes will be filed to the end of a file or entry." | 1108 | When nil, new notes will be filed to the end of a file or entry." |
| 1105 | :group 'org-remember | 1109 | :group 'org-remember |
| 1106 | :type '(choice | 1110 | :type '(choice |
| 1107 | (const :tag "Reverse always" t) | 1111 | (const :tag "Reverse always" t) |
| 1108 | (const :tag "Reverse never" nil) | 1112 | (const :tag "Reverse never" nil) |
| 1109 | (repeat :tag "By file name regexp" | 1113 | (repeat :tag "By file name regexp" |
| 1110 | (cons regexp boolean)))) | 1114 | (cons regexp boolean)))) |
| 1111 | 1115 | ||
| 1112 | (defgroup org-table nil | 1116 | (defgroup org-table nil |
| 1113 | "Options concerning tables in Org-mode." | 1117 | "Options concerning tables in Org-mode." |
| @@ -1119,13 +1123,13 @@ When nil, new notes will be filed to the end of a file or entry." | |||
| 1119 | When nil, such lines will be treated like ordinary lines. | 1123 | When nil, such lines will be treated like ordinary lines. |
| 1120 | 1124 | ||
| 1121 | When equal to the symbol `optimized', the table editor will be optimized to | 1125 | When equal to the symbol `optimized', the table editor will be optimized to |
| 1122 | do the following: | 1126 | do the following |
| 1123 | - Use automatic overwrite mode in front of whitespace in table fields. | 1127 | - Use automatic overwrite mode in front of whitespace in table fields. |
| 1124 | This makes the structure of the table stay intact as long as the edited | 1128 | This make the structure of the table stay in tact as long as the edited |
| 1125 | field does not exceed the column width. | 1129 | field does not exceed the column width. |
| 1126 | - Minimize the number of realigns. Normally, the table is aligned each time | 1130 | - Minimize the number of realigns. Normally, the table is aligned each time |
| 1127 | TAB or RET are pressed to move to another field. With optimization this | 1131 | TAB or RET are pressed to move to another field. With optimization this |
| 1128 | happens only if changes to a field might have changed the column width. | 1132 | happens only if changes to a field might have changed the column width. |
| 1129 | Optimization requires replacing the functions `self-insert-command', | 1133 | Optimization requires replacing the functions `self-insert-command', |
| 1130 | `delete-char', and `backward-delete-char' in Org-mode buffers, with a | 1134 | `delete-char', and `backward-delete-char' in Org-mode buffers, with a |
| 1131 | slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is | 1135 | slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is |
| @@ -1139,9 +1143,9 @@ This variable can be used to turn on and off the table editor during a session, | |||
| 1139 | but in order to toggle optimization, a restart is required." | 1143 | but in order to toggle optimization, a restart is required." |
| 1140 | :group 'org-table | 1144 | :group 'org-table |
| 1141 | :type '(choice | 1145 | :type '(choice |
| 1142 | (const :tag "off" nil) | 1146 | (const :tag "off" nil) |
| 1143 | (const :tag "on" t) | 1147 | (const :tag "on" t) |
| 1144 | (const :tag "on, optimized" optimized))) | 1148 | (const :tag "on, optimized" optimized))) |
| 1145 | 1149 | ||
| 1146 | (defcustom org-table-default-size "5x2" | 1150 | (defcustom org-table-default-size "5x2" |
| 1147 | "The default size for newly created tables, Columns x Rows." | 1151 | "The default size for newly created tables, Columns x Rows." |
| @@ -1180,19 +1184,19 @@ number: | |||
| 1180 | Other options offered by the customize interface are more restrictive." | 1184 | Other options offered by the customize interface are more restrictive." |
| 1181 | :group 'org-table | 1185 | :group 'org-table |
| 1182 | :type '(choice | 1186 | :type '(choice |
| 1183 | (const :tag "Positive Integers" | 1187 | (const :tag "Positive Integers" |
| 1184 | "^[0-9]+$") | 1188 | "^[0-9]+$") |
| 1185 | (const :tag "Integers" | 1189 | (const :tag "Integers" |
| 1186 | "^[-+]?[0-9]+$") | 1190 | "^[-+]?[0-9]+$") |
| 1187 | (const :tag "Floating Point Numbers" | 1191 | (const :tag "Floating Point Numbers" |
| 1188 | "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.[0-9]*\\)$") | 1192 | "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.[0-9]*\\)$") |
| 1189 | (const :tag "Floating Point Number or Integer" | 1193 | (const :tag "Floating Point Number or Integer" |
| 1190 | "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.?[0-9]*\\)$") | 1194 | "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.?[0-9]*\\)$") |
| 1191 | (const :tag "Exponential, Floating point, Integer" | 1195 | (const :tag "Exponential, Floating point, Integer" |
| 1192 | "^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$") | 1196 | "^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$") |
| 1193 | (const :tag "Very General Number-Like" | 1197 | (const :tag "Very General Number-Like" |
| 1194 | "^[<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*$") | 1198 | "^[<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*$") |
| 1195 | (string :tag "Regexp:"))) | 1199 | (string :tag "Regexp:"))) |
| 1196 | 1200 | ||
| 1197 | (defcustom org-table-number-fraction 0.5 | 1201 | (defcustom org-table-number-fraction 0.5 |
| 1198 | "Fraction of numbers in a column required to make the column align right. | 1202 | "Fraction of numbers in a column required to make the column align right. |
| @@ -1227,7 +1231,10 @@ line will be formatted with <th> tags." | |||
| 1227 | calc-float-format (float 5) | 1231 | calc-float-format (float 5) |
| 1228 | calc-angle-mode deg | 1232 | calc-angle-mode deg |
| 1229 | calc-prefer-frac nil | 1233 | calc-prefer-frac nil |
| 1230 | calc-symbolic-mode nil) | 1234 | calc-symbolic-mode nil |
| 1235 | calc-date-format (YYYY "-" MM "-" DD " " Www (" " HH ":" mm)) | ||
| 1236 | calc-display-working-message t | ||
| 1237 | ) | ||
| 1231 | "List with Calc mode settings for use in calc-eval for table formulas. | 1238 | "List with Calc mode settings for use in calc-eval for table formulas. |
| 1232 | The list must contain alternating symbols (calc modes variables and values. | 1239 | The list must contain alternating symbols (calc modes variables and values. |
| 1233 | Don't remove any of the default settings, just change the values. Org-mode | 1240 | Don't remove any of the default settings, just change the values. Org-mode |
| @@ -1266,8 +1273,8 @@ speed of light in a formula, you would configure | |||
| 1266 | and then use it in an equation like `$1*$c'." | 1273 | and then use it in an equation like `$1*$c'." |
| 1267 | :group 'org-table-calculation | 1274 | :group 'org-table-calculation |
| 1268 | :type '(repeat | 1275 | :type '(repeat |
| 1269 | (cons (string :tag "name") | 1276 | (cons (string :tag "name") |
| 1270 | (string :tag "value")))) | 1277 | (string :tag "value")))) |
| 1271 | 1278 | ||
| 1272 | (defcustom org-table-formula-numbers-only nil | 1279 | (defcustom org-table-formula-numbers-only nil |
| 1273 | "Non-nil means, calculate only with numbers in table formulas. | 1280 | "Non-nil means, calculate only with numbers in table formulas. |
| @@ -1322,15 +1329,15 @@ Use the variable `org-export-default-language' to set the language, | |||
| 1322 | or use the +OPTION lines for a per-file setting." | 1329 | or use the +OPTION lines for a per-file setting." |
| 1323 | :group 'org-export | 1330 | :group 'org-export |
| 1324 | :type '(repeat | 1331 | :type '(repeat |
| 1325 | (list | 1332 | (list |
| 1326 | (string :tag "HTML language tag") | 1333 | (string :tag "HTML language tag") |
| 1327 | (string :tag "Author") | 1334 | (string :tag "Author") |
| 1328 | (string :tag "Date") | 1335 | (string :tag "Date") |
| 1329 | (string :tag "Table of Contents")))) | 1336 | (string :tag "Table of Contents")))) |
| 1330 | 1337 | ||
| 1331 | (defcustom org-export-default-language "en" | 1338 | (defcustom org-export-default-language "en" |
| 1332 | "The default language of HTML export, as a string. | 1339 | "The default language of HTML export, as a string. |
| 1333 | This should have an association in `org-export-language-setup'." | 1340 | This should have an association in `org-export-language-setup'" |
| 1334 | :group 'org-export | 1341 | :group 'org-export |
| 1335 | :type 'string) | 1342 | :type 'string) |
| 1336 | 1343 | ||
| @@ -1455,7 +1462,7 @@ sub- or superscripts. | |||
| 1455 | 10^24 or 10^tau several digits will be considered 1 item | 1462 | 10^24 or 10^tau several digits will be considered 1 item |
| 1456 | 10^-12 or 10^-tau a leading sign with digits or a word | 1463 | 10^-12 or 10^-tau a leading sign with digits or a word |
| 1457 | x^2-y^3 will be read as x^2 - y^3, because items are | 1464 | x^2-y^3 will be read as x^2 - y^3, because items are |
| 1458 | terminated by almost any nonword/nondigit char. | 1465 | terminated by almost any nonword/nondigit char. |
| 1459 | x_{i^2} or x^(2-i) braces or parenthesis do grouping. | 1466 | x_{i^2} or x^(2-i) braces or parenthesis do grouping. |
| 1460 | 1467 | ||
| 1461 | Still, ambiguity is possible - so when in doubt use {} to enclose the | 1468 | Still, ambiguity is possible - so when in doubt use {} to enclose the |
| @@ -1498,7 +1505,7 @@ Otherwise the buffer will just be saved to a file and stay hidden." | |||
| 1498 | :type 'boolean) | 1505 | :type 'boolean) |
| 1499 | 1506 | ||
| 1500 | (defcustom org-export-html-show-new-buffer nil | 1507 | (defcustom org-export-html-show-new-buffer nil |
| 1501 | "Non-nil means, popup buffer containing the exported HTML text. | 1508 | "Non-nil means, popup buffer containing the exported html text. |
| 1502 | Otherwise, the buffer will just be saved to a file and stay hidden." | 1509 | Otherwise, the buffer will just be saved to a file and stay hidden." |
| 1503 | :group 'org-export | 1510 | :group 'org-export |
| 1504 | :type 'boolean) | 1511 | :type 'boolean) |
| @@ -1664,7 +1671,7 @@ When this is non-nil, the headline after the keyword is set to the | |||
| 1664 | (((class color) (background light)) (:foreground "DarkGoldenrod")) | 1671 | (((class color) (background light)) (:foreground "DarkGoldenrod")) |
| 1665 | (((class color) (background dark)) (:foreground "LightGoldenrod")) | 1672 | (((class color) (background dark)) (:foreground "LightGoldenrod")) |
| 1666 | (t (:bold t :italic t))) | 1673 | (t (:bold t :italic t))) |
| 1667 | "Face used for time grids." | 1674 | "Face used for level 2 headlines." |
| 1668 | :group 'org-faces) | 1675 | :group 'org-faces) |
| 1669 | 1676 | ||
| 1670 | (defvar org-level-faces | 1677 | (defvar org-level-faces |
| @@ -1771,23 +1778,26 @@ The following commands are available: | |||
| 1771 | (set (make-local-variable 'org-table-may-need-update) t) | 1778 | (set (make-local-variable 'org-table-may-need-update) t) |
| 1772 | (make-local-hook 'before-change-functions) ;; needed for XEmacs | 1779 | (make-local-hook 'before-change-functions) ;; needed for XEmacs |
| 1773 | (add-hook 'before-change-functions 'org-before-change-function nil | 1780 | (add-hook 'before-change-functions 'org-before-change-function nil |
| 1774 | 'local) | 1781 | 'local) |
| 1775 | ;; Paragraph regular expressions | 1782 | ;; Paragraph regular expressions |
| 1776 | (set (make-local-variable 'paragraph-separate) "\f\\|[ ]*$\\|\\([*\f]+\\)") | 1783 | (set (make-local-variable 'paragraph-separate) "\f\\|[ ]*$\\|\\([*\f]+\\)") |
| 1777 | (set (make-local-variable 'paragraph-start) "\f\\|[ ]*$\\|\\([*\f]+\\)") | 1784 | (set (make-local-variable 'paragraph-start) "\f\\|[ ]*$\\|\\([*\f]+\\)") |
| 1778 | ;; Inhibit auto-fill for headers, tables and fixed-width lines. | 1785 | ;; Inhibit auto-fill for headers, tables and fixed-width lines. |
| 1779 | (set (make-local-variable 'auto-fill-inhibit-regexp) | 1786 | (set (make-local-variable 'auto-fill-inhibit-regexp) |
| 1780 | (concat "\\*\\|#" | 1787 | (concat "\\*\\|#" |
| 1781 | (if (or org-enable-table-editor org-enable-fixed-width-editor) | 1788 | (if (or org-enable-table-editor org-enable-fixed-width-editor) |
| 1782 | (concat | 1789 | (concat |
| 1783 | "\\|[ \t]*[" | 1790 | "\\|[ \t]*[" |
| 1784 | (if org-enable-table-editor "|" "") | 1791 | (if org-enable-table-editor "|" "") |
| 1785 | (if org-enable-fixed-width-editor ":" "") | 1792 | (if org-enable-fixed-width-editor ":" "") |
| 1786 | "]")))) | 1793 | "]")))) |
| 1787 | (set (make-local-variable 'fill-paragraph-function) 'org-fill-paragraph) | 1794 | (set (make-local-variable 'fill-paragraph-function) 'org-fill-paragraph) |
| 1795 | ;; Settings for Calc embedded mode | ||
| 1796 | (set (make-local-variable 'calc-embedded-open-formula) "|\\|\n") | ||
| 1797 | (set (make-local-variable 'calc-embedded-close-formula) "|\\|\n") | ||
| 1788 | (if (and org-insert-mode-line-in-empty-file | 1798 | (if (and org-insert-mode-line-in-empty-file |
| 1789 | (interactive-p) | 1799 | (interactive-p) |
| 1790 | (= (point-min) (point-max))) | 1800 | (= (point-min) (point-max))) |
| 1791 | (insert " -*- mode: org -*-\n\n")) | 1801 | (insert " -*- mode: org -*-\n\n")) |
| 1792 | 1802 | ||
| 1793 | ;; Get rid of Outline menus, they are not needed | 1803 | ;; Get rid of Outline menus, they are not needed |
| @@ -1805,16 +1815,16 @@ The following commands are available: | |||
| 1805 | 1815 | ||
| 1806 | (unless org-inhibit-startup | 1816 | (unless org-inhibit-startup |
| 1807 | (if org-startup-with-deadline-check | 1817 | (if org-startup-with-deadline-check |
| 1808 | (call-interactively 'org-check-deadlines) | 1818 | (call-interactively 'org-check-deadlines) |
| 1809 | (cond | 1819 | (cond |
| 1810 | ((eq org-startup-folded t) | 1820 | ((eq org-startup-folded t) |
| 1811 | (org-cycle '(4))) | 1821 | (org-cycle '(4))) |
| 1812 | ((eq org-startup-folded 'content) | 1822 | ((eq org-startup-folded 'content) |
| 1813 | (let ((this-command 'org-cycle) (last-command 'org-cycle)) | 1823 | (let ((this-command 'org-cycle) (last-command 'org-cycle)) |
| 1814 | (org-cycle '(4)) (org-cycle '(4)))))))) | 1824 | (org-cycle '(4)) (org-cycle '(4)))))))) |
| 1815 | 1825 | ||
| 1816 | (defun org-fill-paragraph (&optional justify) | 1826 | (defun org-fill-paragraph (&optional justify) |
| 1817 | "Re-align a table, pass through to `fill-paragraph' if no table." | 1827 | "Re-align a table, pass through to fill-paragraph if no table." |
| 1818 | (save-excursion | 1828 | (save-excursion |
| 1819 | (beginning-of-line 1) | 1829 | (beginning-of-line 1) |
| 1820 | (looking-at "\\s-*\\(|\\|\\+-+\\)"))) | 1830 | (looking-at "\\s-*\\(|\\|\\+-+\\)"))) |
| @@ -1850,7 +1860,7 @@ The following commands are available: | |||
| 1850 | 1860 | ||
| 1851 | (defconst org-ts-lengths | 1861 | (defconst org-ts-lengths |
| 1852 | (cons (length (format-time-string (car org-time-stamp-formats))) | 1862 | (cons (length (format-time-string (car org-time-stamp-formats))) |
| 1853 | (length (format-time-string (cdr org-time-stamp-formats)))) | 1863 | (length (format-time-string (cdr org-time-stamp-formats)))) |
| 1854 | "This holds the lengths of the two different time formats.") | 1864 | "This holds the lengths of the two different time formats.") |
| 1855 | (defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^\r\n>]*\\)>" | 1865 | (defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^\r\n>]*\\)>" |
| 1856 | "Regular expression for fast time stamp matching.") | 1866 | "Regular expression for fast time stamp matching.") |
| @@ -1861,26 +1871,26 @@ The following commands are available: | |||
| 1861 | (defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp) | 1871 | (defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp) |
| 1862 | "Regular expression matching a time stamp range.") | 1872 | "Regular expression matching a time stamp range.") |
| 1863 | (defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?" | 1873 | (defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?" |
| 1864 | org-ts-regexp "\\)?") | 1874 | org-ts-regexp "\\)?") |
| 1865 | "Regular expression matching a time stamp or time stamp range.") | 1875 | "Regular expression matching a time stamp or time stamp range.") |
| 1866 | 1876 | ||
| 1867 | (defun org-activate-links (limit) | 1877 | (defun org-activate-links (limit) |
| 1868 | "Run through the buffer and add overlays to links." | 1878 | "Run through the buffer and add overlays to links." |
| 1869 | (if (re-search-forward org-link-regexp limit t) | 1879 | (if (re-search-forward org-link-regexp limit t) |
| 1870 | (progn | 1880 | (progn |
| 1871 | (add-text-properties (match-beginning 0) (match-end 0) | 1881 | (add-text-properties (match-beginning 0) (match-end 0) |
| 1872 | (list 'mouse-face 'highlight | 1882 | (list 'mouse-face 'highlight |
| 1873 | 'keymap org-mouse-map)) | 1883 | 'keymap org-mouse-map)) |
| 1874 | t))) | 1884 | t))) |
| 1875 | 1885 | ||
| 1876 | (defun org-activate-dates (limit) | 1886 | (defun org-activate-dates (limit) |
| 1877 | "Run through the buffer and add overlays to dates." | 1887 | "Run through the buffer and add overlays to dates." |
| 1878 | (if (re-search-forward org-tsr-regexp limit t) | 1888 | (if (re-search-forward org-tsr-regexp limit t) |
| 1879 | (progn | 1889 | (progn |
| 1880 | (add-text-properties (match-beginning 0) (match-end 0) | 1890 | (add-text-properties (match-beginning 0) (match-end 0) |
| 1881 | (list 'mouse-face 'highlight | 1891 | (list 'mouse-face 'highlight |
| 1882 | 'keymap org-mouse-map)) | 1892 | 'keymap org-mouse-map)) |
| 1883 | t))) | 1893 | t))) |
| 1884 | 1894 | ||
| 1885 | (defun org-font-lock-level () | 1895 | (defun org-font-lock-level () |
| 1886 | (save-excursion | 1896 | (save-excursion |
| @@ -1891,61 +1901,61 @@ The following commands are available: | |||
| 1891 | 1901 | ||
| 1892 | (defun org-set-font-lock-defaults () | 1902 | (defun org-set-font-lock-defaults () |
| 1893 | (let ((org-font-lock-extra-keywords | 1903 | (let ((org-font-lock-extra-keywords |
| 1894 | (list | 1904 | (list |
| 1895 | '(org-activate-links (0 'org-link)) | 1905 | '(org-activate-links (0 'org-link)) |
| 1896 | '(org-activate-dates (0 'org-link)) | 1906 | '(org-activate-dates (0 'org-link)) |
| 1897 | (list (concat "^\\*+[ \t]*" org-not-done-regexp) | 1907 | (list (concat "^\\*+[ \t]*" org-not-done-regexp) |
| 1898 | '(1 'org-warning t)) | 1908 | '(1 'org-warning t)) |
| 1899 | (list (concat "\\[#[A-Z]\\]") '(0 'org-warning t)) | 1909 | (list (concat "\\[#[A-Z]\\]") '(0 'org-warning t)) |
| 1900 | (list (concat "\\<" org-deadline-string) '(0 'org-warning t)) | 1910 | (list (concat "\\<" org-deadline-string) '(0 'org-warning t)) |
| 1901 | (list (concat "\\<" org-scheduled-string) '(0 'org-warning t)) | 1911 | (list (concat "\\<" org-scheduled-string) '(0 'org-warning t)) |
| 1902 | ;; '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)" | 1912 | ;; '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)" |
| 1903 | ;; (3 'bold)) | 1913 | ;; (3 'bold)) |
| 1904 | ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)" | 1914 | ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)" |
| 1905 | ;; (3 'italic)) | 1915 | ;; (3 'italic)) |
| 1906 | ;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)" | 1916 | ;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)" |
| 1907 | ;; (3 'underline)) | 1917 | ;; (3 'underline)) |
| 1908 | (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>") | 1918 | (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>") |
| 1909 | '(1 'org-warning t)) | 1919 | '(1 'org-warning t)) |
| 1910 | '("^#.*" (0 'font-lock-comment-face t)) | 1920 | '("^#.*" (0 'font-lock-comment-face t)) |
| 1911 | (if org-fontify-done-headline | 1921 | (if org-fontify-done-headline |
| 1912 | (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>") | 1922 | (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>") |
| 1913 | '(1 'org-done t) '(2 'org-headline-done t)) | 1923 | '(1 'org-done t) '(2 'org-headline-done t)) |
| 1914 | (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>") | 1924 | (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>") |
| 1915 | '(1 'org-done t))) | 1925 | '(1 'org-done t))) |
| 1916 | '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" | 1926 | '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" |
| 1917 | (1 'org-table t)) | 1927 | (1 'org-table t)) |
| 1918 | '("^[ \t]*\\(:.*\\)" (1 'org-table t)) | 1928 | '("^[ \t]*\\(:.*\\)" (1 'org-table t)) |
| 1919 | '("| *\\(=[^|\n]*\\)" (1 'org-formula t)) | 1929 | '("| *\\(=[^|\n]*\\)" (1 'org-formula t)) |
| 1920 | '("^[ \t]*| *\\([#!$*]\\) *|" (1 'org-formula t)) | 1930 | '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t)) |
| 1921 | ))) | 1931 | ))) |
| 1922 | (set (make-local-variable 'org-font-lock-keywords) | 1932 | (set (make-local-variable 'org-font-lock-keywords) |
| 1923 | (append | 1933 | (append |
| 1924 | (if org-noutline-p ; FIXME: I am not sure if eval will work | 1934 | (if org-noutline-p ; FIXME: I am not sure if eval will work |
| 1925 | ; on XEmacs if noutline is ever ported | 1935 | ; on XEmacs if noutline is ever ported |
| 1926 | '((eval . (list "^\\(\\*+\\).*" | 1936 | '((eval . (list "^\\(\\*+\\).*" |
| 1927 | 0 '(nth | 1937 | 0 '(nth |
| 1928 | (% (- (match-end 1) (match-beginning 1) 1) | 1938 | (% (- (match-end 1) (match-beginning 1) 1) |
| 1929 | org-n-levels) | 1939 | org-n-levels) |
| 1930 | org-level-faces) | 1940 | org-level-faces) |
| 1931 | nil t))) | 1941 | nil t))) |
| 1932 | '(("^\\(\\(\\*+\\)[^\r\n]*\\)[\n\r]" | 1942 | '(("^\\(\\(\\*+\\)[^\r\n]*\\)[\n\r]" |
| 1933 | (1 (nth (% (- (match-end 2) (match-beginning 2) 1) | 1943 | (1 (nth (% (- (match-end 2) (match-beginning 2) 1) |
| 1934 | org-n-levels) | 1944 | org-n-levels) |
| 1935 | org-level-faces) | 1945 | org-level-faces) |
| 1936 | nil t)))) | 1946 | nil t)))) |
| 1937 | org-font-lock-extra-keywords)) | 1947 | org-font-lock-extra-keywords)) |
| 1938 | (set (make-local-variable 'font-lock-defaults) | 1948 | (set (make-local-variable 'font-lock-defaults) |
| 1939 | '(org-font-lock-keywords t nil nil backward-paragraph)) | 1949 | '(org-font-lock-keywords t nil nil backward-paragraph)) |
| 1940 | (kill-local-variable 'font-lock-keywords) nil)) | 1950 | (kill-local-variable 'font-lock-keywords) nil)) |
| 1941 | 1951 | ||
| 1942 | (defun org-unfontify-region (beg end &optional maybe_loudly) | 1952 | (defun org-unfontify-region (beg end &optional maybe_loudly) |
| 1943 | "Remove fontification and activation overlays from links." | 1953 | "Remove fontification and activation overlays from links." |
| 1944 | (font-lock-default-unfontify-region beg end) | 1954 | (font-lock-default-unfontify-region beg end) |
| 1945 | (let* ((buffer-undo-list t) | 1955 | (let* ((buffer-undo-list t) |
| 1946 | (inhibit-read-only t) (inhibit-point-motion-hooks t) | 1956 | (inhibit-read-only t) (inhibit-point-motion-hooks t) |
| 1947 | (inhibit-modification-hooks t) | 1957 | (inhibit-modification-hooks t) |
| 1948 | deactivate-mark buffer-file-name buffer-file-truename) | 1958 | deactivate-mark buffer-file-name buffer-file-truename) |
| 1949 | (remove-text-properties beg end '(mouse-face nil keymap nil)))) | 1959 | (remove-text-properties beg end '(mouse-face nil keymap nil)))) |
| 1950 | 1960 | ||
| 1951 | ;;; Visibility cycling | 1961 | ;;; Visibility cycling |
| @@ -1956,17 +1966,17 @@ The following commands are available: | |||
| 1956 | "Visibility cycling for Org-mode. | 1966 | "Visibility cycling for Org-mode. |
| 1957 | 1967 | ||
| 1958 | - When this function is called with a prefix argument, rotate the entire | 1968 | - When this function is called with a prefix argument, rotate the entire |
| 1959 | buffer through 3 states (global cycling): | 1969 | buffer through 3 states (global cycling) |
| 1960 | 1. OVERVIEW: Show only top-level headlines. | 1970 | 1. OVERVIEW: Show only top-level headlines. |
| 1961 | 2. CONTENTS: Show all headlines of all levels, but no body text. | 1971 | 2. CONTENTS: Show all headlines of all levels, but no body text. |
| 1962 | 3. SHOW ALL: Show everything. | 1972 | 3. SHOW ALL: Show everything. |
| 1963 | 1973 | ||
| 1964 | - When point is at the beginning of a headline, rotate the subtree started | 1974 | - When point is at the beginning of a headline, rotate the subtree started |
| 1965 | by this line through 3 different states (local cycling): | 1975 | by this line through 3 different states (local cycling) |
| 1966 | 1. FOLDED: Only the main headline is shown. | 1976 | 1. FOLDED: Only the main headline is shown. |
| 1967 | 2. CHILDREN: The main headline and the direct children are shown. From | 1977 | 2. CHILDREN: The main headline and the direct children are shown. From |
| 1968 | this state, you can move to one of the children and | 1978 | this state, you can move to one of the children and |
| 1969 | zoom in further. | 1979 | zoom in further. |
| 1970 | 3. SUBTREE: Show the entire subtree, including body text. | 1980 | 3. SUBTREE: Show the entire subtree, including body text. |
| 1971 | 1981 | ||
| 1972 | - When there is a numeric prefix, go up to a heading with level ARG, do | 1982 | - When there is a numeric prefix, go up to a heading with level ARG, do |
| @@ -1982,7 +1992,7 @@ The following commands are available: | |||
| 1982 | (interactive "P") | 1992 | (interactive "P") |
| 1983 | 1993 | ||
| 1984 | (if (or (and (bobp) (not (looking-at outline-regexp))) | 1994 | (if (or (and (bobp) (not (looking-at outline-regexp))) |
| 1985 | (equal arg '(4))) | 1995 | (equal arg '(4))) |
| 1986 | ;; special case: use global cycling | 1996 | ;; special case: use global cycling |
| 1987 | (setq arg t)) | 1997 | (setq arg t)) |
| 1988 | 1998 | ||
| @@ -1991,9 +2001,9 @@ The following commands are available: | |||
| 1991 | ((org-at-table-p 'any) | 2001 | ((org-at-table-p 'any) |
| 1992 | ;; Enter the table or move to the next field in the table | 2002 | ;; Enter the table or move to the next field in the table |
| 1993 | (or (org-table-recognize-table.el) | 2003 | (or (org-table-recognize-table.el) |
| 1994 | (progn | 2004 | (progn |
| 1995 | (org-table-justify-field-maybe) | 2005 | (org-table-justify-field-maybe) |
| 1996 | (org-table-next-field)))) | 2006 | (org-table-next-field)))) |
| 1997 | 2007 | ||
| 1998 | ((eq arg t) ;; Global cycling | 2008 | ((eq arg t) ;; Global cycling |
| 1999 | 2009 | ||
| @@ -2038,7 +2048,7 @@ The following commands are available: | |||
| 2038 | (save-excursion | 2048 | (save-excursion |
| 2039 | (org-back-to-heading) | 2049 | (org-back-to-heading) |
| 2040 | (outline-up-heading (if (< arg 0) (- arg) | 2050 | (outline-up-heading (if (< arg 0) (- arg) |
| 2041 | (- (outline-level) arg))) | 2051 | (- (outline-level) arg))) |
| 2042 | (org-show-subtree))) | 2052 | (org-show-subtree))) |
| 2043 | 2053 | ||
| 2044 | ((save-excursion (beginning-of-line 1) (looking-at outline-regexp)) | 2054 | ((save-excursion (beginning-of-line 1) (looking-at outline-regexp)) |
| @@ -2055,33 +2065,33 @@ The following commands are available: | |||
| 2055 | (beginning-of-line 2)) (setq eol (point))) | 2065 | (beginning-of-line 2)) (setq eol (point))) |
| 2056 | (outline-end-of-heading) (setq eoh (point)) | 2066 | (outline-end-of-heading) (setq eoh (point)) |
| 2057 | (outline-end-of-subtree) (setq eos (point)) | 2067 | (outline-end-of-subtree) (setq eos (point)) |
| 2058 | (outline-next-heading)) | 2068 | (outline-next-heading)) |
| 2059 | ;; Find out what to do next and set `this-command' | 2069 | ;; Find out what to do next and set `this-command' |
| 2060 | (cond | 2070 | (cond |
| 2061 | ((= eos eoh) | 2071 | ((= eos eoh) |
| 2062 | ;; Nothing is hidden behind this heading | 2072 | ;; Nothing is hidden behind this heading |
| 2063 | (message "EMPTY ENTRY") | 2073 | (message "EMPTY ENTRY") |
| 2064 | (setq org-cycle-subtree-status nil)) | 2074 | (setq org-cycle-subtree-status nil)) |
| 2065 | ((>= eol eos) | 2075 | ((>= eol eos) |
| 2066 | ;; Entire subtree is hidden in one line: open it | 2076 | ;; Entire subtree is hidden in one line: open it |
| 2067 | (org-show-entry) | 2077 | (org-show-entry) |
| 2068 | (show-children) | 2078 | (show-children) |
| 2069 | (message "CHILDREN") | 2079 | (message "CHILDREN") |
| 2070 | (setq org-cycle-subtree-status 'children) | 2080 | (setq org-cycle-subtree-status 'children) |
| 2071 | (run-hook-with-args 'org-cycle-hook 'children)) | 2081 | (run-hook-with-args 'org-cycle-hook 'children)) |
| 2072 | ((and (eq last-command this-command) | 2082 | ((and (eq last-command this-command) |
| 2073 | (eq org-cycle-subtree-status 'children)) | 2083 | (eq org-cycle-subtree-status 'children)) |
| 2074 | ;; We just showed the children, now show everything. | 2084 | ;; We just showed the children, now show everything. |
| 2075 | (org-show-subtree) | 2085 | (org-show-subtree) |
| 2076 | (message "SUBTREE") | 2086 | (message "SUBTREE") |
| 2077 | (setq org-cycle-subtree-status 'subtree) | 2087 | (setq org-cycle-subtree-status 'subtree) |
| 2078 | (run-hook-with-args 'org-cycle-hook 'subtree)) | 2088 | (run-hook-with-args 'org-cycle-hook 'subtree)) |
| 2079 | (t | 2089 | (t |
| 2080 | ;; Default action: hide the subtree. | 2090 | ;; Default action: hide the subtree. |
| 2081 | (hide-subtree) | 2091 | (hide-subtree) |
| 2082 | (message "FOLDED") | 2092 | (message "FOLDED") |
| 2083 | (setq org-cycle-subtree-status 'folded) | 2093 | (setq org-cycle-subtree-status 'folded) |
| 2084 | (run-hook-with-args 'org-cycle-hook 'folded))))) | 2094 | (run-hook-with-args 'org-cycle-hook 'folded))))) |
| 2085 | 2095 | ||
| 2086 | ;; TAB emulation | 2096 | ;; TAB emulation |
| 2087 | (buffer-read-only (org-back-to-heading)) | 2097 | (buffer-read-only (org-back-to-heading)) |
| @@ -2090,16 +2100,16 @@ The following commands are available: | |||
| 2090 | t | 2100 | t |
| 2091 | (eq org-cycle-emulate-tab t)) | 2101 | (eq org-cycle-emulate-tab t)) |
| 2092 | (if (and (looking-at "[ \n\r\t]") | 2102 | (if (and (looking-at "[ \n\r\t]") |
| 2093 | (string-match "^[ \t]*$" (buffer-substring | 2103 | (string-match "^[ \t]*$" (buffer-substring |
| 2094 | (point-at-bol) (point)))) | 2104 | (point-at-bol) (point)))) |
| 2095 | (progn | 2105 | (progn |
| 2096 | (beginning-of-line 1) | 2106 | (beginning-of-line 1) |
| 2097 | (and (looking-at "[ \t]+") (replace-match "")))) | 2107 | (and (looking-at "[ \t]+") (replace-match "")))) |
| 2098 | (indent-relative)) | 2108 | (indent-relative)) |
| 2099 | 2109 | ||
| 2100 | (t (save-excursion | 2110 | (t (save-excursion |
| 2101 | (org-back-to-heading) | 2111 | (org-back-to-heading) |
| 2102 | (org-cycle))))) | 2112 | (org-cycle))))) |
| 2103 | 2113 | ||
| 2104 | (defun org-optimize-window-after-visibility-change (state) | 2114 | (defun org-optimize-window-after-visibility-change (state) |
| 2105 | "Adjust the window after a change in outline visibility. | 2115 | "Adjust the window after a change in outline visibility. |
| @@ -2171,12 +2181,12 @@ original buffer in which the visibility is still unchanged. It then jumps | |||
| 2171 | to the new location, making it and the headline hierarchy above it visible." | 2181 | to the new location, making it and the headline hierarchy above it visible." |
| 2172 | (interactive) | 2182 | (interactive) |
| 2173 | (let* ((org-goto-start-pos (point)) | 2183 | (let* ((org-goto-start-pos (point)) |
| 2174 | (selected-point | 2184 | (selected-point |
| 2175 | (org-get-location (current-buffer) org-goto-help))) | 2185 | (org-get-location (current-buffer) org-goto-help))) |
| 2176 | (if selected-point | 2186 | (if selected-point |
| 2177 | (progn | 2187 | (progn |
| 2178 | (goto-char selected-point) | 2188 | (goto-char selected-point) |
| 2179 | (if (org-invisible-p) (org-show-hierarchy-above))) | 2189 | (if (org-invisible-p) (org-show-hierarchy-above))) |
| 2180 | (error "Quit")))) | 2190 | (error "Quit")))) |
| 2181 | 2191 | ||
| 2182 | (defun org-get-location (buf help) | 2192 | (defun org-get-location (buf help) |
| @@ -2186,69 +2196,69 @@ or nil." | |||
| 2186 | (let (org-selected-point) | 2196 | (let (org-selected-point) |
| 2187 | (save-excursion | 2197 | (save-excursion |
| 2188 | (save-window-excursion | 2198 | (save-window-excursion |
| 2189 | (delete-other-windows) | 2199 | (delete-other-windows) |
| 2190 | (switch-to-buffer (get-buffer-create "*org-goto*")) | 2200 | (switch-to-buffer (get-buffer-create "*org-goto*")) |
| 2191 | (with-output-to-temp-buffer "*Help*" | 2201 | (with-output-to-temp-buffer "*Help*" |
| 2192 | (princ help)) | 2202 | (princ help)) |
| 2193 | (shrink-window-if-larger-than-buffer (get-buffer-window "*Help*")) | 2203 | (shrink-window-if-larger-than-buffer (get-buffer-window "*Help*")) |
| 2194 | (setq buffer-read-only nil) | 2204 | (setq buffer-read-only nil) |
| 2195 | (erase-buffer) | 2205 | (erase-buffer) |
| 2196 | (insert-buffer buf) | 2206 | (insert-buffer buf) |
| 2197 | (let ((org-startup-truncated t) | 2207 | (let ((org-startup-truncated t) |
| 2198 | (org-startup-folded t) | 2208 | (org-startup-folded t) |
| 2199 | (org-startup-with-deadline-check nil)) | 2209 | (org-startup-with-deadline-check nil)) |
| 2200 | (org-mode)) | 2210 | (org-mode)) |
| 2201 | (setq buffer-read-only t) | 2211 | (setq buffer-read-only t) |
| 2202 | (if (boundp 'org-goto-start-pos) | 2212 | (if (boundp 'org-goto-start-pos) |
| 2203 | (goto-char org-goto-start-pos) | 2213 | (goto-char org-goto-start-pos) |
| 2204 | (goto-char (point-min))) | 2214 | (goto-char (point-min))) |
| 2205 | (org-beginning-of-line) | 2215 | (org-beginning-of-line) |
| 2206 | (message "Select location and press RET") | 2216 | (message "Select location and press RET") |
| 2207 | ;; now we make sure that during selection, ony very few keys work | 2217 | ;; now we make sure that during selection, ony very few keys work |
| 2208 | ;; and that it is impossible to switch to another window. | 2218 | ;; and that it is impossible to switch to another window. |
| 2209 | (let ((gm (current-global-map)) | 2219 | (let ((gm (current-global-map)) |
| 2210 | (overriding-local-map org-goto-map)) | 2220 | (overriding-local-map org-goto-map)) |
| 2211 | (unwind-protect | 2221 | (unwind-protect |
| 2212 | (progn | 2222 | (progn |
| 2213 | (use-global-map org-goto-map) | 2223 | (use-global-map org-goto-map) |
| 2214 | (recursive-edit)) | 2224 | (recursive-edit)) |
| 2215 | (use-global-map gm))))) | 2225 | (use-global-map gm))))) |
| 2216 | (kill-buffer "*org-goto*") | 2226 | (kill-buffer "*org-goto*") |
| 2217 | org-selected-point)) | 2227 | org-selected-point)) |
| 2218 | 2228 | ||
| 2219 | ;; FIXME: It may not be a good idea to temper with the prefix argument... | 2229 | ;; FIXME: It may not be a good idea to temper with the prefix argument... |
| 2220 | (defun org-goto-ret (&optional arg) | 2230 | (defun org-goto-ret (&optional arg) |
| 2221 | "Finish `org-goto' by going to the new location." | 2231 | "Finish org-goto by going to the new location." |
| 2222 | (interactive "P") | 2232 | (interactive "P") |
| 2223 | (setq org-selected-point (point) | 2233 | (setq org-selected-point (point) |
| 2224 | current-prefix-arg arg) | 2234 | current-prefix-arg arg) |
| 2225 | (throw 'exit nil)) | 2235 | (throw 'exit nil)) |
| 2226 | 2236 | ||
| 2227 | (defun org-goto-left () | 2237 | (defun org-goto-left () |
| 2228 | "Finish `org-goto' by going to the new location." | 2238 | "Finish org-goto by going to the new location." |
| 2229 | (interactive) | 2239 | (interactive) |
| 2230 | (if (org-on-heading-p) | 2240 | (if (org-on-heading-p) |
| 2231 | (progn | 2241 | (progn |
| 2232 | (beginning-of-line 1) | 2242 | (beginning-of-line 1) |
| 2233 | (setq org-selected-point (point) | 2243 | (setq org-selected-point (point) |
| 2234 | current-prefix-arg (- (match-end 0) (match-beginning 0))) | 2244 | current-prefix-arg (- (match-end 0) (match-beginning 0))) |
| 2235 | (throw 'exit nil)) | 2245 | (throw 'exit nil)) |
| 2236 | (error "Not on a heading"))) | 2246 | (error "Not on a heading"))) |
| 2237 | 2247 | ||
| 2238 | (defun org-goto-right () | 2248 | (defun org-goto-right () |
| 2239 | "Finish `org-goto' by going to the new location." | 2249 | "Finish org-goto by going to the new location." |
| 2240 | (interactive) | 2250 | (interactive) |
| 2241 | (if (org-on-heading-p) | 2251 | (if (org-on-heading-p) |
| 2242 | (progn | 2252 | (progn |
| 2243 | (outline-end-of-subtree) | 2253 | (outline-end-of-subtree) |
| 2244 | (or (eobp) (forward-char 1)) | 2254 | (or (eobp) (forward-char 1)) |
| 2245 | (setq org-selected-point (point) | 2255 | (setq org-selected-point (point) |
| 2246 | current-prefix-arg (- (match-end 0) (match-beginning 0))) | 2256 | current-prefix-arg (- (match-end 0) (match-beginning 0))) |
| 2247 | (throw 'exit nil)) | 2257 | (throw 'exit nil)) |
| 2248 | (error "Not on a heading"))) | 2258 | (error "Not on a heading"))) |
| 2249 | 2259 | ||
| 2250 | (defun org-goto-quit () | 2260 | (defun org-goto-quit () |
| 2251 | "Finish `org-goto' without cursor motion." | 2261 | "Finish org-goto without cursor motion." |
| 2252 | (interactive) | 2262 | (interactive) |
| 2253 | (setq org-selected-point nil) | 2263 | (setq org-selected-point nil) |
| 2254 | (throw 'exit nil)) | 2264 | (throw 'exit nil)) |
| @@ -2286,8 +2296,8 @@ state (TODO by default). Also with prefix arg, force first state." | |||
| 2286 | (outline-previous-heading) | 2296 | (outline-previous-heading) |
| 2287 | (looking-at org-todo-line-regexp)) | 2297 | (looking-at org-todo-line-regexp)) |
| 2288 | (if (or arg | 2298 | (if (or arg |
| 2289 | (not (match-beginning 2)) | 2299 | (not (match-beginning 2)) |
| 2290 | (equal (match-string 2) org-done-string)) | 2300 | (equal (match-string 2) org-done-string)) |
| 2291 | (insert (car org-todo-keywords) " ") | 2301 | (insert (car org-todo-keywords) " ") |
| 2292 | (insert (match-string 2) " "))) | 2302 | (insert (match-string 2) " "))) |
| 2293 | 2303 | ||
| @@ -2312,7 +2322,7 @@ in the region." | |||
| 2312 | (interactive) | 2322 | (interactive) |
| 2313 | (save-excursion | 2323 | (save-excursion |
| 2314 | (if (org-region-active-p) | 2324 | (if (org-region-active-p) |
| 2315 | (org-map-region 'org-promote (region-beginning) (region-end)) | 2325 | (org-map-region 'org-promote (region-beginning) (region-end)) |
| 2316 | (org-promote))) | 2326 | (org-promote))) |
| 2317 | (org-fix-position-after-promote)) | 2327 | (org-fix-position-after-promote)) |
| 2318 | 2328 | ||
| @@ -2323,7 +2333,7 @@ in the region." | |||
| 2323 | (interactive) | 2333 | (interactive) |
| 2324 | (save-excursion | 2334 | (save-excursion |
| 2325 | (if (org-region-active-p) | 2335 | (if (org-region-active-p) |
| 2326 | (org-map-region 'org-demote (region-beginning) (region-end)) | 2336 | (org-map-region 'org-demote (region-beginning) (region-end)) |
| 2327 | (org-demote))) | 2337 | (org-demote))) |
| 2328 | (org-fix-position-after-promote)) | 2338 | (org-fix-position-after-promote)) |
| 2329 | 2339 | ||
| @@ -2339,11 +2349,11 @@ If the region is active in `transient-mark-mode', promote all headings | |||
| 2339 | in the region." | 2349 | in the region." |
| 2340 | (org-back-to-heading t) | 2350 | (org-back-to-heading t) |
| 2341 | (let* ((level (save-match-data (funcall outline-level))) | 2351 | (let* ((level (save-match-data (funcall outline-level))) |
| 2342 | (up-head (make-string (1- level) ?*))) | 2352 | (up-head (make-string (1- level) ?*))) |
| 2343 | (if (= level 1) (error "Cannot promote to level 0. UNDO to recover")) | 2353 | (if (= level 1) (error "Cannot promote to level 0. UNDO to recover")) |
| 2344 | (replace-match up-head nil t) | 2354 | (replace-match up-head nil t) |
| 2345 | (if org-adapt-indentation | 2355 | (if org-adapt-indentation |
| 2346 | (org-fixup-indentation "^ " "" "^ ?\\S-")))) | 2356 | (org-fixup-indentation "^ " "" "^ ?\\S-")))) |
| 2347 | 2357 | ||
| 2348 | (defun org-demote () | 2358 | (defun org-demote () |
| 2349 | "Demote the current heading lower down the tree. | 2359 | "Demote the current heading lower down the tree. |
| @@ -2351,10 +2361,10 @@ If the region is active in `transient-mark-mode', demote all headings | |||
| 2351 | in the region." | 2361 | in the region." |
| 2352 | (org-back-to-heading t) | 2362 | (org-back-to-heading t) |
| 2353 | (let* ((level (save-match-data (funcall outline-level))) | 2363 | (let* ((level (save-match-data (funcall outline-level))) |
| 2354 | (down-head (make-string (1+ level) ?*))) | 2364 | (down-head (make-string (1+ level) ?*))) |
| 2355 | (replace-match down-head nil t) | 2365 | (replace-match down-head nil t) |
| 2356 | (if org-adapt-indentation | 2366 | (if org-adapt-indentation |
| 2357 | (org-fixup-indentation "^ " " " "^\\S-")))) | 2367 | (org-fixup-indentation "^ " " " "^\\S-")))) |
| 2358 | 2368 | ||
| 2359 | (defun org-map-tree (fun) | 2369 | (defun org-map-tree (fun) |
| 2360 | "Call FUN for every heading underneath the current one." | 2370 | "Call FUN for every heading underneath the current one." |
| @@ -2363,10 +2373,10 @@ in the region." | |||
| 2363 | (save-excursion | 2373 | (save-excursion |
| 2364 | (funcall fun) | 2374 | (funcall fun) |
| 2365 | (while (and (progn | 2375 | (while (and (progn |
| 2366 | (outline-next-heading) | 2376 | (outline-next-heading) |
| 2367 | (> (funcall outline-level) level)) | 2377 | (> (funcall outline-level) level)) |
| 2368 | (not (eobp))) | 2378 | (not (eobp))) |
| 2369 | (funcall fun))))) | 2379 | (funcall fun))))) |
| 2370 | 2380 | ||
| 2371 | (defun org-map-region (fun beg end) | 2381 | (defun org-map-region (fun beg end) |
| 2372 | "Call FUN for every heading between BEG and END." | 2382 | "Call FUN for every heading between BEG and END." |
| @@ -2375,13 +2385,13 @@ in the region." | |||
| 2375 | (setq end (copy-marker end)) | 2385 | (setq end (copy-marker end)) |
| 2376 | (goto-char beg) | 2386 | (goto-char beg) |
| 2377 | (if (and (re-search-forward (concat "^" outline-regexp) nil t) | 2387 | (if (and (re-search-forward (concat "^" outline-regexp) nil t) |
| 2378 | (< (point) end)) | 2388 | (< (point) end)) |
| 2379 | (funcall fun)) | 2389 | (funcall fun)) |
| 2380 | (while (and (progn | 2390 | (while (and (progn |
| 2381 | (outline-next-heading) | 2391 | (outline-next-heading) |
| 2382 | (< (point) end)) | 2392 | (< (point) end)) |
| 2383 | (not (eobp))) | 2393 | (not (eobp))) |
| 2384 | (funcall fun))))) | 2394 | (funcall fun))))) |
| 2385 | 2395 | ||
| 2386 | (defun org-fixup-indentation (from to prohibit) | 2396 | (defun org-fixup-indentation (from to prohibit) |
| 2387 | "Change the indentation in the current entry by re-replacing FROM with TO. | 2397 | "Change the indentation in the current entry by re-replacing FROM with TO. |
| @@ -2391,11 +2401,11 @@ heading marker. But if there are any lines which are not indented, nothing | |||
| 2391 | is changed at all." | 2401 | is changed at all." |
| 2392 | (save-excursion | 2402 | (save-excursion |
| 2393 | (let ((end (save-excursion (outline-next-heading) | 2403 | (let ((end (save-excursion (outline-next-heading) |
| 2394 | (point-marker)))) | 2404 | (point-marker)))) |
| 2395 | (unless (save-excursion (re-search-forward prohibit end t)) | 2405 | (unless (save-excursion (re-search-forward prohibit end t)) |
| 2396 | (while (re-search-forward from end t) | 2406 | (while (re-search-forward from end t) |
| 2397 | (replace-match to) | 2407 | (replace-match to) |
| 2398 | (beginning-of-line 2))) | 2408 | (beginning-of-line 2))) |
| 2399 | (move-marker end nil)))) | 2409 | (move-marker end nil)))) |
| 2400 | 2410 | ||
| 2401 | ;;; Vertical tree motion, cutting and pasting of subtrees | 2411 | ;;; Vertical tree motion, cutting and pasting of subtrees |
| @@ -2433,10 +2443,10 @@ is changed at all." | |||
| 2433 | (if (> arg 0) | 2443 | (if (> arg 0) |
| 2434 | ;; Moving forward - still need to move over subtree | 2444 | ;; Moving forward - still need to move over subtree |
| 2435 | (progn (outline-end-of-subtree) | 2445 | (progn (outline-end-of-subtree) |
| 2436 | (outline-next-heading) | 2446 | (outline-next-heading) |
| 2437 | (if (not (or (looking-at (concat "^" outline-regexp)) | 2447 | (if (not (or (looking-at (concat "^" outline-regexp)) |
| 2438 | (bolp))) | 2448 | (bolp))) |
| 2439 | (newline)))) | 2449 | (newline)))) |
| 2440 | (move-marker ins-point (point)) | 2450 | (move-marker ins-point (point)) |
| 2441 | (setq txt (buffer-substring beg end)) | 2451 | (setq txt (buffer-substring beg end)) |
| 2442 | (delete-region beg end) | 2452 | (delete-region beg end) |
| @@ -2470,7 +2480,7 @@ If CUT is non nil, actually cut the subtree." | |||
| 2470 | (setq beg (point)) | 2480 | (setq beg (point)) |
| 2471 | (save-match-data | 2481 | (save-match-data |
| 2472 | (save-excursion (outline-end-of-heading) | 2482 | (save-excursion (outline-end-of-heading) |
| 2473 | (setq folded (org-invisible-p))) | 2483 | (setq folded (org-invisible-p))) |
| 2474 | (outline-end-of-subtree)) | 2484 | (outline-end-of-subtree)) |
| 2475 | (if (equal (char-after) ?\n) (forward-char 1)) | 2485 | (if (equal (char-after) ?\n) (forward-char 1)) |
| 2476 | (setq end (point)) | 2486 | (setq end (point)) |
| @@ -2480,8 +2490,8 @@ If CUT is non nil, actually cut the subtree." | |||
| 2480 | (if cut (kill-region beg end) (copy-region-as-kill beg end)) | 2490 | (if cut (kill-region beg end) (copy-region-as-kill beg end)) |
| 2481 | (setq org-subtree-clip (current-kill 0)) | 2491 | (setq org-subtree-clip (current-kill 0)) |
| 2482 | (message "%s: Subtree with %d characters" | 2492 | (message "%s: Subtree with %d characters" |
| 2483 | (if cut "Cut" "Copied") | 2493 | (if cut "Cut" "Copied") |
| 2484 | (length org-subtree-clip))))) | 2494 | (length org-subtree-clip))))) |
| 2485 | 2495 | ||
| 2486 | (defun org-paste-subtree (&optional level tree) | 2496 | (defun org-paste-subtree (&optional level tree) |
| 2487 | "Paste the clipboard as a subtree, with modification of headline level. | 2497 | "Paste the clipboard as a subtree, with modification of headline level. |
| @@ -2506,51 +2516,51 @@ If optional TREE is given, use this text instead of the kill ring." | |||
| 2506 | (substitute-command-keys | 2516 | (substitute-command-keys |
| 2507 | "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) | 2517 | "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) |
| 2508 | (let* ((txt (or tree (current-kill 0))) | 2518 | (let* ((txt (or tree (current-kill 0))) |
| 2509 | (^re (concat "^\\(" outline-regexp "\\)")) | 2519 | (^re (concat "^\\(" outline-regexp "\\)")) |
| 2510 | (re (concat "\\(" outline-regexp "\\)")) | 2520 | (re (concat "\\(" outline-regexp "\\)")) |
| 2511 | (^re_ (concat "\\(" outline-regexp "\\)[ \t]*")) | 2521 | (^re_ (concat "\\(" outline-regexp "\\)[ \t]*")) |
| 2512 | 2522 | ||
| 2513 | (old-level (if (string-match ^re txt) | 2523 | (old-level (if (string-match ^re txt) |
| 2514 | (- (match-end 0) (match-beginning 0)) | 2524 | (- (match-end 0) (match-beginning 0)) |
| 2515 | -1)) | 2525 | -1)) |
| 2516 | (force-level (cond (level (prefix-numeric-value level)) | 2526 | (force-level (cond (level (prefix-numeric-value level)) |
| 2517 | ((string-match | 2527 | ((string-match |
| 2518 | ^re_ (buffer-substring (point-at-bol) (point))) | 2528 | ^re_ (buffer-substring (point-at-bol) (point))) |
| 2519 | (- (match-end 0) (match-beginning 0))) | 2529 | (- (match-end 0) (match-beginning 0))) |
| 2520 | (t nil))) | 2530 | (t nil))) |
| 2521 | (previous-level (save-excursion | 2531 | (previous-level (save-excursion |
| 2522 | (condition-case nil | 2532 | (condition-case nil |
| 2523 | (progn | 2533 | (progn |
| 2524 | (outline-previous-visible-heading 1) | 2534 | (outline-previous-visible-heading 1) |
| 2525 | (if (looking-at re) | 2535 | (if (looking-at re) |
| 2526 | (- (match-end 0) (match-beginning 0)) | 2536 | (- (match-end 0) (match-beginning 0)) |
| 2527 | 1)) | 2537 | 1)) |
| 2528 | (error 1)))) | 2538 | (error 1)))) |
| 2529 | (next-level (save-excursion | 2539 | (next-level (save-excursion |
| 2530 | (condition-case nil | 2540 | (condition-case nil |
| 2531 | (progn | 2541 | (progn |
| 2532 | (outline-next-visible-heading 1) | 2542 | (outline-next-visible-heading 1) |
| 2533 | (if (looking-at re) | 2543 | (if (looking-at re) |
| 2534 | (- (match-end 0) (match-beginning 0)) | 2544 | (- (match-end 0) (match-beginning 0)) |
| 2535 | 1)) | 2545 | 1)) |
| 2536 | (error 1)))) | 2546 | (error 1)))) |
| 2537 | (new-level (or force-level (max previous-level next-level))) | 2547 | (new-level (or force-level (max previous-level next-level))) |
| 2538 | (shift (if (or (= old-level -1) | 2548 | (shift (if (or (= old-level -1) |
| 2539 | (= new-level -1) | 2549 | (= new-level -1) |
| 2540 | (= old-level new-level)) | 2550 | (= old-level new-level)) |
| 2541 | 0 | 2551 | 0 |
| 2542 | (- new-level old-level))) | 2552 | (- new-level old-level))) |
| 2543 | (shift1 shift) | 2553 | (shift1 shift) |
| 2544 | (delta (if (> shift 0) -1 1)) | 2554 | (delta (if (> shift 0) -1 1)) |
| 2545 | (func (if (> shift 0) 'org-demote 'org-promote)) | 2555 | (func (if (> shift 0) 'org-demote 'org-promote)) |
| 2546 | beg end) | 2556 | beg end) |
| 2547 | ;; Remove the forces level indicator | 2557 | ;; Remove the forces level indicator |
| 2548 | (if force-level | 2558 | (if force-level |
| 2549 | (delete-region (point-at-bol) (point))) | 2559 | (delete-region (point-at-bol) (point))) |
| 2550 | ;; Make sure we start at the beginning of an empty line | 2560 | ;; Make sure we start at the beginning of an empty line |
| 2551 | (if (not (bolp)) (insert "\n")) | 2561 | (if (not (bolp)) (insert "\n")) |
| 2552 | (if (not (looking-at "[ \t]*$")) | 2562 | (if (not (looking-at "[ \t]*$")) |
| 2553 | (progn (insert "\n") (backward-char 1))) | 2563 | (progn (insert "\n") (backward-char 1))) |
| 2554 | ;; Paste | 2564 | ;; Paste |
| 2555 | (setq beg (point)) | 2565 | (setq beg (point)) |
| 2556 | (insert txt) | 2566 | (insert txt) |
| @@ -2558,19 +2568,19 @@ If optional TREE is given, use this text instead of the kill ring." | |||
| 2558 | (goto-char beg) | 2568 | (goto-char beg) |
| 2559 | ;; Shift if necessary | 2569 | ;; Shift if necessary |
| 2560 | (if (= shift 0) | 2570 | (if (= shift 0) |
| 2561 | (message "Pasted at level %d, without shift" new-level) | 2571 | (message "Pasted at level %d, without shift" new-level) |
| 2562 | (save-restriction | 2572 | (save-restriction |
| 2563 | (narrow-to-region beg end) | 2573 | (narrow-to-region beg end) |
| 2564 | (while (not (= shift 0)) | 2574 | (while (not (= shift 0)) |
| 2565 | (org-map-region func (point-min) (point-max)) | 2575 | (org-map-region func (point-min) (point-max)) |
| 2566 | (setq shift (+ delta shift))) | 2576 | (setq shift (+ delta shift))) |
| 2567 | (goto-char (point-min)) | 2577 | (goto-char (point-min)) |
| 2568 | (message "Pasted at level %d, with shift by %d levels" | 2578 | (message "Pasted at level %d, with shift by %d levels" |
| 2569 | new-level shift1))) | 2579 | new-level shift1))) |
| 2570 | (if (and (eq org-subtree-clip (current-kill 0)) | 2580 | (if (and (eq org-subtree-clip (current-kill 0)) |
| 2571 | org-subtree-clip-folded) | 2581 | org-subtree-clip-folded) |
| 2572 | ;; The tree was folded before it was killed/copied | 2582 | ;; The tree was folded before it was killed/copied |
| 2573 | (hide-subtree)))) | 2583 | (hide-subtree)))) |
| 2574 | 2584 | ||
| 2575 | (defun org-kill-is-subtree-p (&optional txt) | 2585 | (defun org-kill-is-subtree-p (&optional txt) |
| 2576 | "Check if the current kill is an outline subtree, or a set of trees. | 2586 | "Check if the current kill is an outline subtree, or a set of trees. |
| @@ -2580,17 +2590,17 @@ So this will actually accept several entries of equal levels as well, | |||
| 2580 | which is OK for `org-paste-subtree'. | 2590 | which is OK for `org-paste-subtree'. |
| 2581 | If optional TXT is given, check this string instead of the current kill." | 2591 | If optional TXT is given, check this string instead of the current kill." |
| 2582 | (let* ((kill (or txt (current-kill 0) "")) | 2592 | (let* ((kill (or txt (current-kill 0) "")) |
| 2583 | (start-level (and (string-match (concat "\\`" outline-regexp) kill) | 2593 | (start-level (and (string-match (concat "\\`" outline-regexp) kill) |
| 2584 | (- (match-end 0) (match-beginning 0)))) | 2594 | (- (match-end 0) (match-beginning 0)))) |
| 2585 | (re (concat "^" outline-regexp)) | 2595 | (re (concat "^" outline-regexp)) |
| 2586 | (start 1)) | 2596 | (start 1)) |
| 2587 | (if (not start-level) | 2597 | (if (not start-level) |
| 2588 | nil ;; does not even start with a heading | 2598 | nil ;; does not even start with a heading |
| 2589 | (catch 'exit | 2599 | (catch 'exit |
| 2590 | (while (setq start (string-match re kill (1+ start))) | 2600 | (while (setq start (string-match re kill (1+ start))) |
| 2591 | (if (< (- (match-end 0) (match-beginning 0)) start-level) | 2601 | (if (< (- (match-end 0) (match-beginning 0)) start-level) |
| 2592 | (throw 'exit nil))) | 2602 | (throw 'exit nil))) |
| 2593 | t)))) | 2603 | t)))) |
| 2594 | 2604 | ||
| 2595 | (defun org-archive-subtree () | 2605 | (defun org-archive-subtree () |
| 2596 | "Move the current subtree to the archive. | 2606 | "Move the current subtree to the archive. |
| @@ -2600,93 +2610,93 @@ heading be marked DONE, and the current time will be added." | |||
| 2600 | (interactive) | 2610 | (interactive) |
| 2601 | ;; Save all relevant TODO keyword-relatex variables | 2611 | ;; Save all relevant TODO keyword-relatex variables |
| 2602 | (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler | 2612 | (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler |
| 2603 | (tr-org-todo-keywords org-todo-keywords) | 2613 | (tr-org-todo-keywords org-todo-keywords) |
| 2604 | (tr-org-todo-interpretation org-todo-interpretation) | 2614 | (tr-org-todo-interpretation org-todo-interpretation) |
| 2605 | (tr-org-done-string org-done-string) | 2615 | (tr-org-done-string org-done-string) |
| 2606 | (tr-org-todo-regexp org-todo-regexp) | 2616 | (tr-org-todo-regexp org-todo-regexp) |
| 2607 | (tr-org-todo-line-regexp org-todo-line-regexp) | 2617 | (tr-org-todo-line-regexp org-todo-line-regexp) |
| 2608 | (this-buffer (current-buffer)) | 2618 | (this-buffer (current-buffer)) |
| 2609 | file heading buffer level newfile-p) | 2619 | file heading buffer level newfile-p) |
| 2610 | (if (string-match "\\(.*\\)::\\(.*\\)" org-archive-location) | 2620 | (if (string-match "\\(.*\\)::\\(.*\\)" org-archive-location) |
| 2611 | (progn | 2621 | (progn |
| 2612 | (setq file (format (match-string 1 org-archive-location) | 2622 | (setq file (format (match-string 1 org-archive-location) |
| 2613 | (file-name-nondirectory (buffer-file-name))) | 2623 | (file-name-nondirectory (buffer-file-name))) |
| 2614 | heading (match-string 2 org-archive-location))) | 2624 | heading (match-string 2 org-archive-location))) |
| 2615 | (error "Invalid `org-archive-location'")) | 2625 | (error "Invalid `org-archive-location'")) |
| 2616 | (if (> (length file) 0) | 2626 | (if (> (length file) 0) |
| 2617 | (setq newfile-p (not (file-exists-p file)) | 2627 | (setq newfile-p (not (file-exists-p file)) |
| 2618 | buffer (find-file-noselect file)) | 2628 | buffer (find-file-noselect file)) |
| 2619 | (setq buffer (current-buffer))) | 2629 | (setq buffer (current-buffer))) |
| 2620 | (unless buffer | 2630 | (unless buffer |
| 2621 | (error "Cannot access file \"%s\"" file)) | 2631 | (error "Cannot access file \"%s\"" file)) |
| 2622 | (if (and (> (length heading) 0) | 2632 | (if (and (> (length heading) 0) |
| 2623 | (string-match "^\\*+" heading)) | 2633 | (string-match "^\\*+" heading)) |
| 2624 | (setq level (match-end 0)) | 2634 | (setq level (match-end 0)) |
| 2625 | (setq heading nil level 0)) | 2635 | (setq heading nil level 0)) |
| 2626 | (save-excursion | 2636 | (save-excursion |
| 2627 | (org-copy-subtree) ; We first only copy, in case something goes wrong | 2637 | (org-copy-subtree) ; We first only copy, in case something goes wrong |
| 2628 | (set-buffer buffer) | 2638 | (set-buffer buffer) |
| 2629 | ;; Enforce org-mode for the archive buffer | 2639 | ;; Enforce org-mode for the archive buffer |
| 2630 | (if (not (eq major-mode 'org-mode)) | 2640 | (if (not (eq major-mode 'org-mode)) |
| 2631 | ;; Force the mode for future visits. | 2641 | ;; Force the mode for future visits. |
| 2632 | (let ((org-insert-mode-line-in-empty-file t)) | 2642 | (let ((org-insert-mode-line-in-empty-file t)) |
| 2633 | (call-interactively 'org-mode))) | 2643 | (call-interactively 'org-mode))) |
| 2634 | (when newfile-p | 2644 | (when newfile-p |
| 2635 | (goto-char (point-max)) | 2645 | (goto-char (point-max)) |
| 2636 | (insert (format "\nArchived entries from file %s\n\n" | 2646 | (insert (format "\nArchived entries from file %s\n\n" |
| 2637 | (buffer-file-name this-buffer)))) | 2647 | (buffer-file-name this-buffer)))) |
| 2638 | ;; Force the TODO keywords of the original buffer | 2648 | ;; Force the TODO keywords of the original buffer |
| 2639 | (let ((org-todo-line-regexp tr-org-todo-line-regexp) | 2649 | (let ((org-todo-line-regexp tr-org-todo-line-regexp) |
| 2640 | (org-todo-keywords tr-org-todo-keywords) | 2650 | (org-todo-keywords tr-org-todo-keywords) |
| 2641 | (org-todo-interpretation tr-org-todo-interpretation) | 2651 | (org-todo-interpretation tr-org-todo-interpretation) |
| 2642 | (org-done-string tr-org-done-string) | 2652 | (org-done-string tr-org-done-string) |
| 2643 | (org-todo-regexp tr-org-todo-regexp) | 2653 | (org-todo-regexp tr-org-todo-regexp) |
| 2644 | (org-todo-line-regexp tr-org-todo-line-regexp)) | 2654 | (org-todo-line-regexp tr-org-todo-line-regexp)) |
| 2645 | (goto-char (point-min)) | 2655 | (goto-char (point-min)) |
| 2646 | (if heading | 2656 | (if heading |
| 2647 | (progn | 2657 | (progn |
| 2648 | (if (re-search-forward | 2658 | (if (re-search-forward |
| 2649 | (concat "\\(^\\|\r\\)" | 2659 | (concat "\\(^\\|\r\\)" |
| 2650 | (regexp-quote heading) "[ \t]*\\($\\|\r\\)") | 2660 | (regexp-quote heading) "[ \t]*\\($\\|\r\\)") |
| 2651 | nil t) | 2661 | nil t) |
| 2652 | (goto-char (match-end 0)) | 2662 | (goto-char (match-end 0)) |
| 2653 | ;; Heading not found, just insert it at the end | 2663 | ;; Heading not found, just insert it at the end |
| 2654 | (goto-char (point-max)) | 2664 | (goto-char (point-max)) |
| 2655 | (or (bolp) (insert "\n")) | 2665 | (or (bolp) (insert "\n")) |
| 2656 | (insert "\n" heading "\n") | 2666 | (insert "\n" heading "\n") |
| 2657 | (end-of-line 0)) | 2667 | (end-of-line 0)) |
| 2658 | ;; Make the heading visible, and the following as well | 2668 | ;; Make the heading visible, and the following as well |
| 2659 | (let ((org-show-following-heading t)) (org-show-hierarchy-above)) | 2669 | (let ((org-show-following-heading t)) (org-show-hierarchy-above)) |
| 2660 | (if (re-search-forward | 2670 | (if (re-search-forward |
| 2661 | (concat "^" (regexp-quote (make-string level ?*)) "[ \t]") | 2671 | (concat "^" (regexp-quote (make-string level ?*)) "[ \t]") |
| 2662 | nil t) | 2672 | nil t) |
| 2663 | (progn (goto-char (match-beginning 0)) (insert "\n") | 2673 | (progn (goto-char (match-beginning 0)) (insert "\n") |
| 2664 | (beginning-of-line 0)) | 2674 | (beginning-of-line 0)) |
| 2665 | (goto-char (point-max)) (insert "\n"))) | 2675 | (goto-char (point-max)) (insert "\n"))) |
| 2666 | (goto-char (point-max)) (insert "\n")) | 2676 | (goto-char (point-max)) (insert "\n")) |
| 2667 | ;; Paste | 2677 | ;; Paste |
| 2668 | (org-paste-subtree (1+ level)) | 2678 | (org-paste-subtree (1+ level)) |
| 2669 | ;; Mark the entry as done, i.e. set to last work in org-todo-keywords | 2679 | ;; Mark the entry as done, i.e. set to last work in org-todo-keywords |
| 2670 | (if org-archive-mark-done | 2680 | (if org-archive-mark-done |
| 2671 | (org-todo (length org-todo-keywords))) | 2681 | (org-todo (length org-todo-keywords))) |
| 2672 | ;; Move cursor to right after the TODO keyword | 2682 | ;; Move cursor to right after the TODO keyword |
| 2673 | (when org-archive-stamp-time | 2683 | (when org-archive-stamp-time |
| 2674 | (beginning-of-line 1) | 2684 | (beginning-of-line 1) |
| 2675 | (looking-at org-todo-line-regexp) | 2685 | (looking-at org-todo-line-regexp) |
| 2676 | (goto-char (or (match-end 2) (match-beginning 3))) | 2686 | (goto-char (or (match-end 2) (match-beginning 3))) |
| 2677 | (insert "(" (format-time-string (cdr org-time-stamp-formats) | 2687 | (insert "(" (format-time-string (cdr org-time-stamp-formats) |
| 2678 | (current-time)) | 2688 | (current-time)) |
| 2679 | ")")) | 2689 | ")")) |
| 2680 | ;; Save the buffer, if it is not the same buffer. | 2690 | ;; Save the buffer, if it is not the same buffer. |
| 2681 | (if (not (eq this-buffer buffer)) (save-buffer)))) | 2691 | (if (not (eq this-buffer buffer)) (save-buffer)))) |
| 2682 | ;; Here we are back in the original buffer. Everything seems to have | 2692 | ;; Here we are back in the original buffer. Everything seems to have |
| 2683 | ;; worked. So now cut the tree and finish up. | 2693 | ;; worked. So now cut the tree and finish up. |
| 2684 | (org-cut-subtree) | 2694 | (org-cut-subtree) |
| 2685 | (if (looking-at "[ \t]*$") (kill-line)) | 2695 | (if (looking-at "[ \t]*$") (kill-line)) |
| 2686 | (message "Subtree archived %s" | 2696 | (message "Subtree archived %s" |
| 2687 | (if (eq this-buffer buffer) | 2697 | (if (eq this-buffer buffer) |
| 2688 | (concat "under heading: " heading) | 2698 | (concat "under heading: " heading) |
| 2689 | (concat "in file: " (abbreviate-file-name file)))))) | 2699 | (concat "in file: " (abbreviate-file-name file)))))) |
| 2690 | 2700 | ||
| 2691 | ;;; Completion | 2701 | ;;; Completion |
| 2692 | 2702 | ||
| @@ -2702,63 +2712,63 @@ At all other locations, this simply calls `ispell-complete-word'." | |||
| 2702 | (interactive "P") | 2712 | (interactive "P") |
| 2703 | (catch 'exit | 2713 | (catch 'exit |
| 2704 | (let* ((end (point)) | 2714 | (let* ((end (point)) |
| 2705 | (beg (save-excursion | 2715 | (beg (save-excursion |
| 2706 | (if (equal (char-before (point)) ?\ ) (backward-char 1)) | 2716 | (if (equal (char-before (point)) ?\ ) (backward-char 1)) |
| 2707 | (skip-chars-backward "a-zA-Z0-9_:$") | 2717 | (skip-chars-backward "a-zA-Z0-9_:$") |
| 2708 | (point))) | 2718 | (point))) |
| 2709 | (texp (equal (char-before beg) ?\\)) | 2719 | (texp (equal (char-before beg) ?\\)) |
| 2710 | (form (equal (char-before beg) ?=)) | 2720 | (form (equal (char-before beg) ?=)) |
| 2711 | (opt (equal (buffer-substring (max (point-at-bol) (- beg 2)) | 2721 | (opt (equal (buffer-substring (max (point-at-bol) (- beg 2)) |
| 2712 | beg) | 2722 | beg) |
| 2713 | "#+")) | 2723 | "#+")) |
| 2714 | (pattern (buffer-substring-no-properties beg end)) | 2724 | (pattern (buffer-substring-no-properties beg end)) |
| 2715 | (completion-ignore-case opt) | 2725 | (completion-ignore-case opt) |
| 2716 | (type nil) | 2726 | (type nil) |
| 2717 | (table (cond | 2727 | (table (cond |
| 2718 | (opt | 2728 | (opt |
| 2719 | (setq type :opt) | 2729 | (setq type :opt) |
| 2720 | (mapcar (lambda (x) | 2730 | (mapcar (lambda (x) |
| 2721 | (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x) | 2731 | (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x) |
| 2722 | (cons (match-string 2 x) (match-string 1 x))) | 2732 | (cons (match-string 2 x) (match-string 1 x))) |
| 2723 | (org-split-string (org-get-current-options) "\n"))) | 2733 | (org-split-string (org-get-current-options) "\n"))) |
| 2724 | (texp | 2734 | (texp |
| 2725 | (setq type :tex) | 2735 | (setq type :tex) |
| 2726 | org-html-entities) | 2736 | org-html-entities) |
| 2727 | (form | 2737 | (form |
| 2728 | (setq type :form) | 2738 | (setq type :form) |
| 2729 | '(("sum") ("sumv") ("sumh"))) | 2739 | '(("sum") ("sumv") ("sumh"))) |
| 2730 | ((string-match "\\`\\*+[ \t]*\\'" | 2740 | ((string-match "\\`\\*+[ \t]*\\'" |
| 2731 | (buffer-substring (point-at-bol) beg)) | 2741 | (buffer-substring (point-at-bol) beg)) |
| 2732 | (setq type :todo) | 2742 | (setq type :todo) |
| 2733 | (mapcar 'list org-todo-keywords)) | 2743 | (mapcar 'list org-todo-keywords)) |
| 2734 | (t (progn (ispell-complete-word arg) (throw 'exit nil))))) | 2744 | (t (progn (ispell-complete-word arg) (throw 'exit nil))))) |
| 2735 | (completion (try-completion pattern table))) | 2745 | (completion (try-completion pattern table))) |
| 2736 | (cond ((eq completion t) | 2746 | (cond ((eq completion t) |
| 2737 | (if (equal type :opt) | 2747 | (if (equal type :opt) |
| 2738 | (insert (substring (cdr (assoc (upcase pattern) table)) | 2748 | (insert (substring (cdr (assoc (upcase pattern) table)) |
| 2739 | (length pattern))))) | 2749 | (length pattern))))) |
| 2740 | ((null completion) | 2750 | ((null completion) |
| 2741 | (message "Can't find completion for \"%s\"" pattern) | 2751 | (message "Can't find completion for \"%s\"" pattern) |
| 2742 | (ding)) | 2752 | (ding)) |
| 2743 | ((not (string= pattern completion)) | 2753 | ((not (string= pattern completion)) |
| 2744 | (delete-region beg end) | 2754 | (delete-region beg end) |
| 2745 | (if (string-match " +$" completion) | 2755 | (if (string-match " +$" completion) |
| 2746 | (setq completion (replace-match "" t t completion))) | 2756 | (setq completion (replace-match "" t t completion))) |
| 2747 | (insert completion) | 2757 | (insert completion) |
| 2748 | (if (get-buffer-window "*Completions*") | 2758 | (if (get-buffer-window "*Completions*") |
| 2749 | (delete-window (get-buffer-window "*Completions*"))) | 2759 | (delete-window (get-buffer-window "*Completions*"))) |
| 2750 | (if (and (eq type :todo) | 2760 | (if (and (eq type :todo) |
| 2751 | (assoc completion table)) | 2761 | (assoc completion table)) |
| 2752 | (insert " ")) | 2762 | (insert " ")) |
| 2753 | (if (and (equal type :opt) (assoc completion table)) | 2763 | (if (and (equal type :opt) (assoc completion table)) |
| 2754 | (message (substitute-command-keys | 2764 | (message (substitute-command-keys |
| 2755 | "Press \\[org-complete] again to insert example settings")))) | 2765 | "Press \\[org-complete] again to insert example settings")))) |
| 2756 | (t | 2766 | (t |
| 2757 | (message "Making completion list...") | 2767 | (message "Making completion list...") |
| 2758 | (let ((list (sort (all-completions pattern table) 'string<))) | 2768 | (let ((list (sort (all-completions pattern table) 'string<))) |
| 2759 | (with-output-to-temp-buffer "*Completions*" | 2769 | (with-output-to-temp-buffer "*Completions*" |
| 2760 | (display-completion-list list))) | 2770 | (display-completion-list list))) |
| 2761 | (message "Making completion list...%s" "done")))))) | 2771 | (message "Making completion list...%s" "done")))))) |
| 2762 | 2772 | ||
| 2763 | ;;; Comments, TODO and DEADLINE | 2773 | ;;; Comments, TODO and DEADLINE |
| 2764 | 2774 | ||
| @@ -2768,12 +2778,12 @@ At all other locations, this simply calls `ispell-complete-word'." | |||
| 2768 | (save-excursion | 2778 | (save-excursion |
| 2769 | (org-back-to-heading) | 2779 | (org-back-to-heading) |
| 2770 | (if (looking-at (concat outline-regexp | 2780 | (if (looking-at (concat outline-regexp |
| 2771 | "\\( +\\<" org-comment-string "\\>\\)")) | 2781 | "\\( +\\<" org-comment-string "\\>\\)")) |
| 2772 | (replace-match "" t t nil 1) | 2782 | (replace-match "" t t nil 1) |
| 2773 | (if (looking-at outline-regexp) | 2783 | (if (looking-at outline-regexp) |
| 2774 | (progn | 2784 | (progn |
| 2775 | (goto-char (match-end 0)) | 2785 | (goto-char (match-end 0)) |
| 2776 | (insert " " org-comment-string)))))) | 2786 | (insert " " org-comment-string)))))) |
| 2777 | 2787 | ||
| 2778 | (defvar org-last-todo-state-is-todo nil | 2788 | (defvar org-last-todo-state-is-todo nil |
| 2779 | "This is non-nil when the last TODO state change led to a TODO state. | 2789 | "This is non-nil when the last TODO state change led to a TODO state. |
| @@ -2800,44 +2810,44 @@ prefix arg, switch to that state." | |||
| 2800 | (org-back-to-heading) | 2810 | (org-back-to-heading) |
| 2801 | (if (looking-at outline-regexp) (goto-char (match-end 0))) | 2811 | (if (looking-at outline-regexp) (goto-char (match-end 0))) |
| 2802 | (or (looking-at (concat " +" org-todo-regexp " *")) | 2812 | (or (looking-at (concat " +" org-todo-regexp " *")) |
| 2803 | (looking-at " *")) | 2813 | (looking-at " *")) |
| 2804 | (let* ((this (match-string 1)) | 2814 | (let* ((this (match-string 1)) |
| 2805 | (completion-ignore-case t) | 2815 | (completion-ignore-case t) |
| 2806 | (member (member this org-todo-keywords)) | 2816 | (member (member this org-todo-keywords)) |
| 2807 | (tail (cdr member)) | 2817 | (tail (cdr member)) |
| 2808 | (state (cond | 2818 | (state (cond |
| 2809 | ((equal arg '(4)) | 2819 | ((equal arg '(4)) |
| 2810 | ;; Read a state with completion | 2820 | ;; Read a state with completion |
| 2811 | (completing-read "State: " (mapcar (lambda(x) (list x)) | 2821 | (completing-read "State: " (mapcar (lambda(x) (list x)) |
| 2812 | org-todo-keywords) | 2822 | org-todo-keywords) |
| 2813 | nil t)) | 2823 | nil t)) |
| 2814 | (arg | 2824 | (arg |
| 2815 | ;; user requests a specific state | 2825 | ;; user requests a specific state |
| 2816 | (nth (1- (prefix-numeric-value arg)) | 2826 | (nth (1- (prefix-numeric-value arg)) |
| 2817 | org-todo-keywords)) | 2827 | org-todo-keywords)) |
| 2818 | ((null member) (car org-todo-keywords)) | 2828 | ((null member) (car org-todo-keywords)) |
| 2819 | ((null tail) nil) ;; -> first entry | 2829 | ((null tail) nil) ;; -> first entry |
| 2820 | ((eq org-todo-interpretation 'sequence) | 2830 | ((eq org-todo-interpretation 'sequence) |
| 2821 | (car tail)) | 2831 | (car tail)) |
| 2822 | ((memq org-todo-interpretation '(type priority)) | 2832 | ((memq org-todo-interpretation '(type priority)) |
| 2823 | (if (eq this-command last-command) | 2833 | (if (eq this-command last-command) |
| 2824 | (car tail) | 2834 | (car tail) |
| 2825 | (if (> (length tail) 0) org-done-string nil))) | 2835 | (if (> (length tail) 0) org-done-string nil))) |
| 2826 | (t nil))) | 2836 | (t nil))) |
| 2827 | (next (if state (concat " " state " ") " "))) | 2837 | (next (if state (concat " " state " ") " "))) |
| 2828 | (replace-match next t t) | 2838 | (replace-match next t t) |
| 2829 | (setq org-last-todo-state-is-todo | 2839 | (setq org-last-todo-state-is-todo |
| 2830 | (not (equal state org-done-string))) | 2840 | (not (equal state org-done-string))) |
| 2831 | (run-hooks 'org-after-todo-state-change-hook))) | 2841 | (run-hooks 'org-after-todo-state-change-hook))) |
| 2832 | ;; Fixup cursor location if close to the keyword | 2842 | ;; Fixup cursor location if close to the keyword |
| 2833 | (if (and (outline-on-heading-p) | 2843 | (if (and (outline-on-heading-p) |
| 2834 | (not (bolp)) | 2844 | (not (bolp)) |
| 2835 | (save-excursion (beginning-of-line 1) | 2845 | (save-excursion (beginning-of-line 1) |
| 2836 | (looking-at org-todo-line-regexp)) | 2846 | (looking-at org-todo-line-regexp)) |
| 2837 | (< (point) (+ 2 (or (match-end 2) (match-end 1))))) | 2847 | (< (point) (+ 2 (or (match-end 2) (match-end 1))))) |
| 2838 | (progn | 2848 | (progn |
| 2839 | (goto-char (or (match-end 2) (match-end 1))) | 2849 | (goto-char (or (match-end 2) (match-end 1))) |
| 2840 | (just-one-space)))) | 2850 | (just-one-space)))) |
| 2841 | 2851 | ||
| 2842 | (defun org-show-todo-tree (arg) | 2852 | (defun org-show-todo-tree (arg) |
| 2843 | "Make a compact tree which shows all headlines marked with TODO. | 2853 | "Make a compact tree which shows all headlines marked with TODO. |
| @@ -2845,9 +2855,9 @@ The tree will show the lines where the regexp matches, and all higher | |||
| 2845 | headlines above the match." | 2855 | headlines above the match." |
| 2846 | (interactive "P") | 2856 | (interactive "P") |
| 2847 | (let ((case-fold-search nil) | 2857 | (let ((case-fold-search nil) |
| 2848 | (kwd-re (if arg org-todo-regexp org-not-done-regexp))) | 2858 | (kwd-re (if arg org-todo-regexp org-not-done-regexp))) |
| 2849 | (message "%d TODO entries found" | 2859 | (message "%d TODO entries found" |
| 2850 | (org-occur (concat "^" outline-regexp " +" kwd-re ))))) | 2860 | (org-occur (concat "^" outline-regexp " +" kwd-re ))))) |
| 2851 | 2861 | ||
| 2852 | (defun org-deadline () | 2862 | (defun org-deadline () |
| 2853 | "Insert the DEADLINE: string to make a deadline. | 2863 | "Insert the DEADLINE: string to make a deadline. |
| @@ -2857,9 +2867,9 @@ to modify it to the correct date." | |||
| 2857 | (insert | 2867 | (insert |
| 2858 | org-deadline-string " " | 2868 | org-deadline-string " " |
| 2859 | (format-time-string (car org-time-stamp-formats) | 2869 | (format-time-string (car org-time-stamp-formats) |
| 2860 | (org-read-date nil 'to-time))) | 2870 | (org-read-date nil 'to-time))) |
| 2861 | (message (substitute-command-keys | 2871 | (message (substitute-command-keys |
| 2862 | "Use \\[org-timestamp-up-day] and \\[org-timestamp-down-day] to change the date."))) | 2872 | "Use \\[org-timestamp-up-day] and \\[org-timestamp-down-day] to change the date."))) |
| 2863 | 2873 | ||
| 2864 | (defun org-schedule () | 2874 | (defun org-schedule () |
| 2865 | "Insert the SCHEDULED: string to schedule a TODO item. | 2875 | "Insert the SCHEDULED: string to schedule a TODO item. |
| @@ -2869,9 +2879,9 @@ to modify it to the correct date." | |||
| 2869 | (insert | 2879 | (insert |
| 2870 | org-scheduled-string " " | 2880 | org-scheduled-string " " |
| 2871 | (format-time-string (car org-time-stamp-formats) | 2881 | (format-time-string (car org-time-stamp-formats) |
| 2872 | (org-read-date nil 'to-time))) | 2882 | (org-read-date nil 'to-time))) |
| 2873 | (message (substitute-command-keys | 2883 | (message (substitute-command-keys |
| 2874 | "Use \\[org-timestamp-up-day] and \\[org-timestamp-down-day] to change the date."))) | 2884 | "Use \\[org-timestamp-up-day] and \\[org-timestamp-down-day] to change the date."))) |
| 2875 | 2885 | ||
| 2876 | 2886 | ||
| 2877 | (defun org-occur (regexp &optional callback) | 2887 | (defun org-occur (regexp &optional callback) |
| @@ -2879,7 +2889,7 @@ to modify it to the correct date." | |||
| 2879 | The tree will show the lines where the regexp matches, and all higher | 2889 | The tree will show the lines where the regexp matches, and all higher |
| 2880 | headlines above the match. It will also show the heading after the match, | 2890 | headlines above the match. It will also show the heading after the match, |
| 2881 | to make sure editing the matching entry is easy. | 2891 | to make sure editing the matching entry is easy. |
| 2882 | If CALLBACK is non-nil, it is a function which is called to confirm | 2892 | if CALLBACK is non-nil, it is a function which is called to confirm |
| 2883 | that the match should indeed be shown." | 2893 | that the match should indeed be shown." |
| 2884 | (interactive "sRegexp: ") | 2894 | (interactive "sRegexp: ") |
| 2885 | (setq regexp (org-check-occur-regexp regexp)) | 2895 | (setq regexp (org-check-occur-regexp regexp)) |
| @@ -2888,13 +2898,13 @@ that the match should indeed be shown." | |||
| 2888 | (goto-char (point-min)) | 2898 | (goto-char (point-min)) |
| 2889 | (hide-sublevels 1) | 2899 | (hide-sublevels 1) |
| 2890 | (while (re-search-forward regexp nil t) | 2900 | (while (re-search-forward regexp nil t) |
| 2891 | (when (or (not callback) | 2901 | (when (or (not callback) |
| 2892 | (funcall callback)) | 2902 | (funcall callback)) |
| 2893 | (setq cnt (1+ cnt)) | 2903 | (setq cnt (1+ cnt)) |
| 2894 | (org-show-hierarchy-above)))) | 2904 | (org-show-hierarchy-above)))) |
| 2895 | (run-hooks 'org-occur-hook) | 2905 | (run-hooks 'org-occur-hook) |
| 2896 | (if (interactive-p) | 2906 | (if (interactive-p) |
| 2897 | (message "%d match(es) for regexp %s" cnt regexp)) | 2907 | (message "%d match(es) for regexp %s" cnt regexp)) |
| 2898 | cnt)) | 2908 | cnt)) |
| 2899 | 2909 | ||
| 2900 | (defun org-show-hierarchy-above () | 2910 | (defun org-show-hierarchy-above () |
| @@ -2904,12 +2914,12 @@ that the match should indeed be shown." | |||
| 2904 | (org-show-hidden-entry)) ; show entire entry | 2914 | (org-show-hidden-entry)) ; show entire entry |
| 2905 | (save-excursion | 2915 | (save-excursion |
| 2906 | (and org-show-following-heading | 2916 | (and org-show-following-heading |
| 2907 | (outline-next-heading) | 2917 | (outline-next-heading) |
| 2908 | (org-flag-heading nil))) ; show the next heading | 2918 | (org-flag-heading nil))) ; show the next heading |
| 2909 | (save-excursion ; show all higher headings | 2919 | (save-excursion ; show all higher headings |
| 2910 | (while (condition-case nil | 2920 | (while (condition-case nil |
| 2911 | (progn (org-up-heading-all 1) t) | 2921 | (progn (org-up-heading-all 1) t) |
| 2912 | (error nil)) | 2922 | (error nil)) |
| 2913 | (org-flag-heading nil)))) | 2923 | (org-flag-heading nil)))) |
| 2914 | 2924 | ||
| 2915 | ;;; Priorities | 2925 | ;;; Priorities |
| @@ -2938,39 +2948,39 @@ ACTION can be set, up, or down." | |||
| 2938 | (save-excursion | 2948 | (save-excursion |
| 2939 | (org-back-to-heading) | 2949 | (org-back-to-heading) |
| 2940 | (if (looking-at org-priority-regexp) | 2950 | (if (looking-at org-priority-regexp) |
| 2941 | (setq current (string-to-char (match-string 2)) | 2951 | (setq current (string-to-char (match-string 2)) |
| 2942 | have t) | 2952 | have t) |
| 2943 | (setq current org-default-priority)) | 2953 | (setq current org-default-priority)) |
| 2944 | (cond | 2954 | (cond |
| 2945 | ((eq action 'set) | 2955 | ((eq action 'set) |
| 2946 | (message (format "Priority A-%c, SPC to remove: " org-lowest-priority)) | 2956 | (message (format "Priority A-%c, SPC to remove: " org-lowest-priority)) |
| 2947 | (setq new (read-char-exclusive)) | 2957 | (setq new (read-char-exclusive)) |
| 2948 | (cond ((equal new ?\ ) (setq remove t)) | 2958 | (cond ((equal new ?\ ) (setq remove t)) |
| 2949 | ((or (< (upcase new) ?A) (> (upcase new) org-lowest-priority)) | 2959 | ((or (< (upcase new) ?A) (> (upcase new) org-lowest-priority)) |
| 2950 | (error "Priority must be between `%c' and `%c'" | 2960 | (error "Priority must be between `%c' and `%c'" |
| 2951 | ?A org-lowest-priority)))) | 2961 | ?A org-lowest-priority)))) |
| 2952 | ((eq action 'up) | 2962 | ((eq action 'up) |
| 2953 | (setq new (1- current))) | 2963 | (setq new (1- current))) |
| 2954 | ((eq action 'down) | 2964 | ((eq action 'down) |
| 2955 | (setq new (1+ current))) | 2965 | (setq new (1+ current))) |
| 2956 | (t (error "Invalid action"))) | 2966 | (t (error "Invalid action"))) |
| 2957 | (setq new (min (max ?A (upcase new)) org-lowest-priority)) | 2967 | (setq new (min (max ?A (upcase new)) org-lowest-priority)) |
| 2958 | (setq news (format "%c" new)) | 2968 | (setq news (format "%c" new)) |
| 2959 | (if have | 2969 | (if have |
| 2960 | (if remove | 2970 | (if remove |
| 2961 | (replace-match "" t t nil 1) | 2971 | (replace-match "" t t nil 1) |
| 2962 | (replace-match news t t nil 2)) | 2972 | (replace-match news t t nil 2)) |
| 2963 | (if remove | 2973 | (if remove |
| 2964 | (error "No priority cookie found in line") | 2974 | (error "No priority cookie found in line") |
| 2965 | (looking-at org-todo-line-regexp) | 2975 | (looking-at org-todo-line-regexp) |
| 2966 | (if (match-end 2) | 2976 | (if (match-end 2) |
| 2967 | (progn | 2977 | (progn |
| 2968 | (goto-char (match-end 2)) | 2978 | (goto-char (match-end 2)) |
| 2969 | (insert " [#" news "]")) | 2979 | (insert " [#" news "]")) |
| 2970 | (goto-char (match-beginning 3)) | 2980 | (goto-char (match-beginning 3)) |
| 2971 | (insert "[#" news "] "))))) | 2981 | (insert "[#" news "] "))))) |
| 2972 | (if remove | 2982 | (if remove |
| 2973 | (message "Priority removed") | 2983 | (message "Priority removed") |
| 2974 | (message "Priority of current item set to %s" news)))) | 2984 | (message "Priority of current item set to %s" news)))) |
| 2975 | 2985 | ||
| 2976 | 2986 | ||
| @@ -2978,9 +2988,9 @@ ACTION can be set, up, or down." | |||
| 2978 | "Find priority cookie and return priority." | 2988 | "Find priority cookie and return priority." |
| 2979 | (save-match-data | 2989 | (save-match-data |
| 2980 | (if (not (string-match org-priority-regexp s)) | 2990 | (if (not (string-match org-priority-regexp s)) |
| 2981 | (* 1000 (- org-lowest-priority org-default-priority)) | 2991 | (* 1000 (- org-lowest-priority org-default-priority)) |
| 2982 | (* 1000 (- org-lowest-priority | 2992 | (* 1000 (- org-lowest-priority |
| 2983 | (string-to-char (match-string 2 s))))))) | 2993 | (string-to-char (match-string 2 s))))))) |
| 2984 | 2994 | ||
| 2985 | ;;; Timestamps | 2995 | ;;; Timestamps |
| 2986 | 2996 | ||
| @@ -2997,29 +3007,29 @@ will represent the current date/time. If there is already a timestamp | |||
| 2997 | at the cursor, it will be modified." | 3007 | at the cursor, it will be modified." |
| 2998 | (interactive "P") | 3008 | (interactive "P") |
| 2999 | (let ((fmt (if arg (cdr org-time-stamp-formats) | 3009 | (let ((fmt (if arg (cdr org-time-stamp-formats) |
| 3000 | (car org-time-stamp-formats))) | 3010 | (car org-time-stamp-formats))) |
| 3001 | (org-time-was-given nil) | 3011 | (org-time-was-given nil) |
| 3002 | time) | 3012 | time) |
| 3003 | (cond | 3013 | (cond |
| 3004 | ((and (org-at-timestamp-p) | 3014 | ((and (org-at-timestamp-p) |
| 3005 | (eq last-command 'org-time-stamp) | 3015 | (eq last-command 'org-time-stamp) |
| 3006 | (eq this-command 'org-time-stamp)) | 3016 | (eq this-command 'org-time-stamp)) |
| 3007 | (insert "--") | 3017 | (insert "--") |
| 3008 | (setq time (let ((this-command this-command)) | 3018 | (setq time (let ((this-command this-command)) |
| 3009 | (org-read-date arg 'totime))) | 3019 | (org-read-date arg 'totime))) |
| 3010 | (if org-time-was-given (setq fmt (cdr org-time-stamp-formats))) | 3020 | (if org-time-was-given (setq fmt (cdr org-time-stamp-formats))) |
| 3011 | (insert (format-time-string fmt time))) | 3021 | (insert (format-time-string fmt time))) |
| 3012 | ((org-at-timestamp-p) | 3022 | ((org-at-timestamp-p) |
| 3013 | (setq time (let ((this-command this-command)) | 3023 | (setq time (let ((this-command this-command)) |
| 3014 | (org-read-date arg 'totime))) | 3024 | (org-read-date arg 'totime))) |
| 3015 | (and (org-at-timestamp-p) (replace-match | 3025 | (and (org-at-timestamp-p) (replace-match |
| 3016 | (setq org-last-changed-timestamp | 3026 | (setq org-last-changed-timestamp |
| 3017 | (format-time-string fmt time)) | 3027 | (format-time-string fmt time)) |
| 3018 | t t)) | 3028 | t t)) |
| 3019 | (message "Timestamp updated")) | 3029 | (message "Timestamp updated")) |
| 3020 | (t | 3030 | (t |
| 3021 | (setq time (let ((this-command this-command)) | 3031 | (setq time (let ((this-command this-command)) |
| 3022 | (org-read-date arg 'totime))) | 3032 | (org-read-date arg 'totime))) |
| 3023 | (if org-time-was-given (setq fmt (cdr org-time-stamp-formats))) | 3033 | (if org-time-was-given (setq fmt (cdr org-time-stamp-formats))) |
| 3024 | (insert (format-time-string fmt time)))))) | 3034 | (insert (format-time-string fmt time)))))) |
| 3025 | 3035 | ||
| @@ -3055,109 +3065,109 @@ enter a time, and this function will inform the calling routine about | |||
| 3055 | this change. The calling routine may then choose to change the format | 3065 | this change. The calling routine may then choose to change the format |
| 3056 | used to insert the time stamp into the buffer to include the time." | 3066 | used to insert the time stamp into the buffer to include the time." |
| 3057 | (let* ((default-time | 3067 | (let* ((default-time |
| 3058 | ;; Default time is either today, or, when entering a range, | 3068 | ;; Default time is either today, or, when entering a range, |
| 3059 | ;; the range start. | 3069 | ;; the range start. |
| 3060 | (if (save-excursion | 3070 | (if (save-excursion |
| 3061 | (re-search-backward | 3071 | (re-search-backward |
| 3062 | (concat org-ts-regexp "--\\=") | 3072 | (concat org-ts-regexp "--\\=") |
| 3063 | (- (point) 20) t)) | 3073 | (- (point) 20) t)) |
| 3064 | (apply | 3074 | (apply |
| 3065 | 'encode-time | 3075 | 'encode-time |
| 3066 | (mapcar (lambda(x) (or x 0)) ;; FIXME: Problem with timezone? | 3076 | (mapcar (lambda(x) (or x 0)) ;; FIXME: Problem with timezone? |
| 3067 | (parse-time-string (match-string 1)))) | 3077 | (parse-time-string (match-string 1)))) |
| 3068 | (current-time))) | 3078 | (current-time))) |
| 3069 | (timestr (format-time-string | 3079 | (timestr (format-time-string |
| 3070 | (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") default-time)) | 3080 | (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") default-time)) |
| 3071 | (prompt (format "YYYY-MM-DD [%s]: " timestr)) | 3081 | (prompt (format "YYYY-MM-DD [%s]: " timestr)) |
| 3072 | ans ans1 ans2 | 3082 | ans ans1 ans2 |
| 3073 | second minute hour day month year tl) | 3083 | second minute hour day month year tl) |
| 3074 | 3084 | ||
| 3075 | (if org-popup-calendar-for-date-prompt | 3085 | (if org-popup-calendar-for-date-prompt |
| 3076 | ;; Also show a calendar for date selection | 3086 | ;; Also show a calendar for date selection |
| 3077 | ;; Copied (with modifications) from planner.el by John Wiegley | 3087 | ;; Copied (with modifications) from planner.el by John Wiegley |
| 3078 | (save-excursion | 3088 | (save-excursion |
| 3079 | (save-window-excursion | 3089 | (save-window-excursion |
| 3080 | (calendar) | 3090 | (calendar) |
| 3081 | (calendar-forward-day (- (time-to-days default-time) | 3091 | (calendar-forward-day (- (time-to-days default-time) |
| 3082 | (calendar-absolute-from-gregorian | 3092 | (calendar-absolute-from-gregorian |
| 3083 | (calendar-current-date)))) | 3093 | (calendar-current-date)))) |
| 3084 | (let* ((old-map (current-local-map)) | 3094 | (let* ((old-map (current-local-map)) |
| 3085 | (map (copy-keymap calendar-mode-map)) | 3095 | (map (copy-keymap calendar-mode-map)) |
| 3086 | (minibuffer-local-map (copy-keymap minibuffer-local-map))) | 3096 | (minibuffer-local-map (copy-keymap minibuffer-local-map))) |
| 3087 | (define-key map (kbd "RET") 'org-calendar-select) | 3097 | (define-key map (kbd "RET") 'org-calendar-select) |
| 3088 | (define-key map (if org-xemacs-p [button1] [mouse-1]) | 3098 | (define-key map (if org-xemacs-p [button1] [mouse-1]) |
| 3089 | 'org-calendar-select) | 3099 | 'org-calendar-select) |
| 3090 | (define-key minibuffer-local-map [(meta shift left)] | 3100 | (define-key minibuffer-local-map [(meta shift left)] |
| 3091 | (lambda () (interactive) | 3101 | (lambda () (interactive) |
| 3092 | (org-eval-in-calendar '(calendar-backward-month 1)))) | 3102 | (org-eval-in-calendar '(calendar-backward-month 1)))) |
| 3093 | (define-key minibuffer-local-map [(meta shift right)] | 3103 | (define-key minibuffer-local-map [(meta shift right)] |
| 3094 | (lambda () (interactive) | 3104 | (lambda () (interactive) |
| 3095 | (org-eval-in-calendar '(calendar-forward-month 1)))) | 3105 | (org-eval-in-calendar '(calendar-forward-month 1)))) |
| 3096 | (define-key minibuffer-local-map [(shift up)] | 3106 | (define-key minibuffer-local-map [(shift up)] |
| 3097 | (lambda () (interactive) | 3107 | (lambda () (interactive) |
| 3098 | (org-eval-in-calendar '(calendar-backward-week 1)))) | 3108 | (org-eval-in-calendar '(calendar-backward-week 1)))) |
| 3099 | (define-key minibuffer-local-map [(shift down)] | 3109 | (define-key minibuffer-local-map [(shift down)] |
| 3100 | (lambda () (interactive) | 3110 | (lambda () (interactive) |
| 3101 | (org-eval-in-calendar '(calendar-forward-week 1)))) | 3111 | (org-eval-in-calendar '(calendar-forward-week 1)))) |
| 3102 | (define-key minibuffer-local-map [(shift left)] | 3112 | (define-key minibuffer-local-map [(shift left)] |
| 3103 | (lambda () (interactive) | 3113 | (lambda () (interactive) |
| 3104 | (org-eval-in-calendar '(calendar-backward-day 1)))) | 3114 | (org-eval-in-calendar '(calendar-backward-day 1)))) |
| 3105 | (define-key minibuffer-local-map [(shift right)] | 3115 | (define-key minibuffer-local-map [(shift right)] |
| 3106 | (lambda () (interactive) | 3116 | (lambda () (interactive) |
| 3107 | (org-eval-in-calendar '(calendar-forward-day 1)))) | 3117 | (org-eval-in-calendar '(calendar-forward-day 1)))) |
| 3108 | (define-key minibuffer-local-map ">" | 3118 | (define-key minibuffer-local-map ">" |
| 3109 | (lambda () (interactive) | 3119 | (lambda () (interactive) |
| 3110 | (org-eval-in-calendar '(scroll-calendar-left 1)))) | 3120 | (org-eval-in-calendar '(scroll-calendar-left 1)))) |
| 3111 | (define-key minibuffer-local-map "<" | 3121 | (define-key minibuffer-local-map "<" |
| 3112 | (lambda () (interactive) | 3122 | (lambda () (interactive) |
| 3113 | (org-eval-in-calendar '(scroll-calendar-right 1)))) | 3123 | (org-eval-in-calendar '(scroll-calendar-right 1)))) |
| 3114 | (unwind-protect | 3124 | (unwind-protect |
| 3115 | (progn | 3125 | (progn |
| 3116 | (use-local-map map) | 3126 | (use-local-map map) |
| 3117 | (setq ans (read-string prompt "" nil nil)) | 3127 | (setq ans (read-string prompt "" nil nil)) |
| 3118 | (setq ans (or ans1 ans2 ans))) | 3128 | (setq ans (or ans1 ans2 ans))) |
| 3119 | (use-local-map old-map))))) | 3129 | (use-local-map old-map))))) |
| 3120 | ;; Naked prompt only | 3130 | ;; Naked prompt only |
| 3121 | (setq ans (read-string prompt "" nil timestr))) | 3131 | (setq ans (read-string prompt "" nil timestr))) |
| 3122 | 3132 | ||
| 3123 | (if (string-match | 3133 | (if (string-match |
| 3124 | "^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans) | 3134 | "^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans) |
| 3125 | (progn | 3135 | (progn |
| 3126 | (setq year (if (match-end 2) | 3136 | (setq year (if (match-end 2) |
| 3127 | (string-to-number (match-string 2 ans)) | 3137 | (string-to-number (match-string 2 ans)) |
| 3128 | (string-to-number (format-time-string "%Y"))) | 3138 | (string-to-number (format-time-string "%Y"))) |
| 3129 | month (string-to-number (match-string 3 ans)) | 3139 | month (string-to-number (match-string 3 ans)) |
| 3130 | day (string-to-number (match-string 4 ans))) | 3140 | day (string-to-number (match-string 4 ans))) |
| 3131 | (if (< year 100) (setq year (+ 2000 year))) | 3141 | (if (< year 100) (setq year (+ 2000 year))) |
| 3132 | (setq ans (replace-match (format "%04d-%02d-%02d" year month day) | 3142 | (setq ans (replace-match (format "%04d-%02d-%02d" year month day) |
| 3133 | t t ans)))) | 3143 | t t ans)))) |
| 3134 | (setq tl (parse-time-string ans) | 3144 | (setq tl (parse-time-string ans) |
| 3135 | year (or (nth 5 tl) (string-to-number (format-time-string "%Y"))) | 3145 | year (or (nth 5 tl) (string-to-number (format-time-string "%Y"))) |
| 3136 | month (or (nth 4 tl) (string-to-number (format-time-string "%m"))) | 3146 | month (or (nth 4 tl) (string-to-number (format-time-string "%m"))) |
| 3137 | day (or (nth 3 tl) (string-to-number (format-time-string "%d"))) | 3147 | day (or (nth 3 tl) (string-to-number (format-time-string "%d"))) |
| 3138 | hour (or (nth 2 tl) (string-to-number (format-time-string "%H"))) | 3148 | hour (or (nth 2 tl) (string-to-number (format-time-string "%H"))) |
| 3139 | minute (or (nth 1 tl) (string-to-number (format-time-string "%M"))) | 3149 | minute (or (nth 1 tl) (string-to-number (format-time-string "%M"))) |
| 3140 | second (or (nth 0 tl) 0)) | 3150 | second (or (nth 0 tl) 0)) |
| 3141 | (if (and (boundp 'org-time-was-given) | 3151 | (if (and (boundp 'org-time-was-given) |
| 3142 | (nth 2 tl)) | 3152 | (nth 2 tl)) |
| 3143 | (setq org-time-was-given t)) | 3153 | (setq org-time-was-given t)) |
| 3144 | (if (< year 100) (setq year (+ 2000 year))) | 3154 | (if (< year 100) (setq year (+ 2000 year))) |
| 3145 | (if to-time | 3155 | (if to-time |
| 3146 | (encode-time second minute hour day month year) | 3156 | (encode-time second minute hour day month year) |
| 3147 | (if (or (nth 1 tl) (nth 2 tl)) | 3157 | (if (or (nth 1 tl) (nth 2 tl)) |
| 3148 | (format "%04d-%02d-%02d %02d:%02d" year month day hour minute) | 3158 | (format "%04d-%02d-%02d %02d:%02d" year month day hour minute) |
| 3149 | (format "%04d-%02d-%02d" year month day))))) | 3159 | (format "%04d-%02d-%02d" year month day))))) |
| 3150 | 3160 | ||
| 3151 | (defun org-eval-in-calendar (form) | 3161 | (defun org-eval-in-calendar (form) |
| 3152 | "Eval FORM in the calendar window and return to current window. | 3162 | "Eval FORM in the calendar window and return to current window. |
| 3153 | Also, store the cursor date in variable `ans2'." | 3163 | Also, store the cursor date in variable ans2." |
| 3154 | (let ((sw (selected-window))) | 3164 | (let ((sw (selected-window))) |
| 3155 | (select-window (get-buffer-window "*Calendar*")) | 3165 | (select-window (get-buffer-window "*Calendar*")) |
| 3156 | (eval form) | 3166 | (eval form) |
| 3157 | (when (calendar-cursor-to-date) | 3167 | (when (calendar-cursor-to-date) |
| 3158 | (let* ((date (calendar-cursor-to-date)) | 3168 | (let* ((date (calendar-cursor-to-date)) |
| 3159 | (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | 3169 | (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) |
| 3160 | (setq ans2 (format-time-string "%Y-%m-%d" time)))) | 3170 | (setq ans2 (format-time-string "%Y-%m-%d" time)))) |
| 3161 | (select-window sw))) | 3171 | (select-window sw))) |
| 3162 | 3172 | ||
| 3163 | (defun org-calendar-select () | 3173 | (defun org-calendar-select () |
| @@ -3166,7 +3176,7 @@ This is used by `org-read-date' in a temporary keymap for the calendar buffer." | |||
| 3166 | (interactive) | 3176 | (interactive) |
| 3167 | (when (calendar-cursor-to-date) | 3177 | (when (calendar-cursor-to-date) |
| 3168 | (let* ((date (calendar-cursor-to-date)) | 3178 | (let* ((date (calendar-cursor-to-date)) |
| 3169 | (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | 3179 | (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) |
| 3170 | (setq ans1 (format-time-string "%Y-%m-%d" time))) | 3180 | (setq ans1 (format-time-string "%Y-%m-%d" time))) |
| 3171 | (if (active-minibuffer-window) (exit-minibuffer)))) | 3181 | (if (active-minibuffer-window) (exit-minibuffer)))) |
| 3172 | 3182 | ||
| @@ -3178,22 +3188,22 @@ it is not shown. The prefix arg NDAYS can be used to test that many | |||
| 3178 | days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are shown." | 3188 | days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are shown." |
| 3179 | (interactive "P") | 3189 | (interactive "P") |
| 3180 | (let* ((org-warn-days | 3190 | (let* ((org-warn-days |
| 3181 | (cond | 3191 | (cond |
| 3182 | ((equal ndays '(4)) 100000) | 3192 | ((equal ndays '(4)) 100000) |
| 3183 | (ndays (prefix-numeric-value ndays)) | 3193 | (ndays (prefix-numeric-value ndays)) |
| 3184 | (t org-deadline-warning-days))) | 3194 | (t org-deadline-warning-days))) |
| 3185 | (case-fold-search nil) | 3195 | (case-fold-search nil) |
| 3186 | (regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")) | 3196 | (regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")) |
| 3187 | (callback | 3197 | (callback |
| 3188 | (lambda () | 3198 | (lambda () |
| 3189 | (and (let ((d1 (time-to-days (current-time))) | 3199 | (and (let ((d1 (time-to-days (current-time))) |
| 3190 | (d2 (time-to-days | 3200 | (d2 (time-to-days |
| 3191 | (org-time-string-to-time (match-string 1))))) | 3201 | (org-time-string-to-time (match-string 1))))) |
| 3192 | (< (- d2 d1) org-warn-days)) | 3202 | (< (- d2 d1) org-warn-days)) |
| 3193 | (not (org-entry-is-done-p)))))) | 3203 | (not (org-entry-is-done-p)))))) |
| 3194 | (message "%d deadlines past-due or due within %d days" | 3204 | (message "%d deadlines past-due or due within %d days" |
| 3195 | (org-occur regexp callback) | 3205 | (org-occur regexp callback) |
| 3196 | org-warn-days))) | 3206 | org-warn-days))) |
| 3197 | 3207 | ||
| 3198 | (defun org-evaluate-time-range (&optional to-buffer) | 3208 | (defun org-evaluate-time-range (&optional to-buffer) |
| 3199 | "Evaluate a time range by computing the difference between start and end. | 3209 | "Evaluate a time range by computing the difference between start and end. |
| @@ -3209,65 +3219,65 @@ days in order to avoid rounding problems." | |||
| 3209 | (goto-char (point-at-bol)) | 3219 | (goto-char (point-at-bol)) |
| 3210 | (re-search-forward org-tr-regexp (point-at-eol) t)) | 3220 | (re-search-forward org-tr-regexp (point-at-eol) t)) |
| 3211 | (if (not (org-at-date-range-p)) | 3221 | (if (not (org-at-date-range-p)) |
| 3212 | (error "Not at a time-stamp range, and none found in current line"))) | 3222 | (error "Not at a time-stamp range, and none found in current line"))) |
| 3213 | (let* ((ts1 (match-string 1)) | 3223 | (let* ((ts1 (match-string 1)) |
| 3214 | (ts2 (match-string 2)) | 3224 | (ts2 (match-string 2)) |
| 3215 | (havetime (or (> (length ts1) 15) (> (length ts2) 15))) | 3225 | (havetime (or (> (length ts1) 15) (> (length ts2) 15))) |
| 3216 | (match-end (match-end 0)) | 3226 | (match-end (match-end 0)) |
| 3217 | (time1 (org-time-string-to-time ts1)) | 3227 | (time1 (org-time-string-to-time ts1)) |
| 3218 | (time2 (org-time-string-to-time ts2)) | 3228 | (time2 (org-time-string-to-time ts2)) |
| 3219 | (t1 (time-to-seconds time1)) | 3229 | (t1 (time-to-seconds time1)) |
| 3220 | (t2 (time-to-seconds time2)) | 3230 | (t2 (time-to-seconds time2)) |
| 3221 | (diff (abs (- t2 t1))) | 3231 | (diff (abs (- t2 t1))) |
| 3222 | (negative (< (- t2 t1) 0)) | 3232 | (negative (< (- t2 t1) 0)) |
| 3223 | ;; (ys (floor (* 365 24 60 60))) | 3233 | ;; (ys (floor (* 365 24 60 60))) |
| 3224 | (ds (* 24 60 60)) | 3234 | (ds (* 24 60 60)) |
| 3225 | (hs (* 60 60)) | 3235 | (hs (* 60 60)) |
| 3226 | (fy "%dy %dd %02d:%02d") | 3236 | (fy "%dy %dd %02d:%02d") |
| 3227 | (fy1 "%dy %dd") | 3237 | (fy1 "%dy %dd") |
| 3228 | (fd "%dd %02d:%02d") | 3238 | (fd "%dd %02d:%02d") |
| 3229 | (fd1 "%dd") | 3239 | (fd1 "%dd") |
| 3230 | (fh "%02d:%02d") | 3240 | (fh "%02d:%02d") |
| 3231 | y d h m align) | 3241 | y d h m align) |
| 3232 | ;; FIXME: Should I re-introduce years, make year refer to same date? | 3242 | ;; FIXME: Should I re-introduce years, make year refer to same date? |
| 3233 | ;; This would be the only useful way to have years, actually. | 3243 | ;; This would be the only useful way to have years, actually. |
| 3234 | (if havetime | 3244 | (if havetime |
| 3235 | (setq ; y (floor (/ diff ys)) diff (mod diff ys) | 3245 | (setq ; y (floor (/ diff ys)) diff (mod diff ys) |
| 3236 | y 0 | 3246 | y 0 |
| 3237 | d (floor (/ diff ds)) diff (mod diff ds) | 3247 | d (floor (/ diff ds)) diff (mod diff ds) |
| 3238 | h (floor (/ diff hs)) diff (mod diff hs) | 3248 | h (floor (/ diff hs)) diff (mod diff hs) |
| 3239 | m (floor (/ diff 60))) | 3249 | m (floor (/ diff 60))) |
| 3240 | (setq ; y (floor (/ diff ys)) diff (mod diff ys) | 3250 | (setq ; y (floor (/ diff ys)) diff (mod diff ys) |
| 3241 | y 0 | 3251 | y 0 |
| 3242 | d (floor (+ (/ diff ds) 0.5)) | 3252 | d (floor (+ (/ diff ds) 0.5)) |
| 3243 | h 0 m 0)) | 3253 | h 0 m 0)) |
| 3244 | (if (not to-buffer) | 3254 | (if (not to-buffer) |
| 3245 | (message (org-make-tdiff-string y d h m)) | 3255 | (message (org-make-tdiff-string y d h m)) |
| 3246 | (when (org-at-table-p) | 3256 | (when (org-at-table-p) |
| 3247 | (goto-char match-end) | 3257 | (goto-char match-end) |
| 3248 | (setq align t) | 3258 | (setq align t) |
| 3249 | (and (looking-at " *|") (goto-char (match-end 0)))) | 3259 | (and (looking-at " *|") (goto-char (match-end 0)))) |
| 3250 | (if (looking-at | 3260 | (if (looking-at |
| 3251 | "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") | 3261 | "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") |
| 3252 | (replace-match "")) | 3262 | (replace-match "")) |
| 3253 | (if negative (insert " -")) | 3263 | (if negative (insert " -")) |
| 3254 | (if (> y 0) (insert " " (format (if havetime fy fy1) y d h m)) | 3264 | (if (> y 0) (insert " " (format (if havetime fy fy1) y d h m)) |
| 3255 | (if (> d 0) (insert " " (format (if havetime fd fd1) d h m)) | 3265 | (if (> d 0) (insert " " (format (if havetime fd fd1) d h m)) |
| 3256 | (insert " " (format fh h m)))) | 3266 | (insert " " (format fh h m)))) |
| 3257 | (if align (org-table-align)) | 3267 | (if align (org-table-align)) |
| 3258 | (message "Time difference inserted")))) | 3268 | (message "Time difference inserted")))) |
| 3259 | 3269 | ||
| 3260 | (defun org-make-tdiff-string (y d h m) | 3270 | (defun org-make-tdiff-string (y d h m) |
| 3261 | (let ((fmt "") | 3271 | (let ((fmt "") |
| 3262 | (l nil)) | 3272 | (l nil)) |
| 3263 | (if (> y 0) (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " ") | 3273 | (if (> y 0) (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " ") |
| 3264 | l (push y l))) | 3274 | l (push y l))) |
| 3265 | (if (> d 0) (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " ") | 3275 | (if (> d 0) (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " ") |
| 3266 | l (push d l))) | 3276 | l (push d l))) |
| 3267 | (if (> h 0) (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " ") | 3277 | (if (> h 0) (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " ") |
| 3268 | l (push h l))) | 3278 | l (push h l))) |
| 3269 | (if (> m 0) (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " ") | 3279 | (if (> m 0) (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " ") |
| 3270 | l (push m l))) | 3280 | l (push m l))) |
| 3271 | (apply 'format fmt (nreverse l)))) | 3281 | (apply 'format fmt (nreverse l)))) |
| 3272 | 3282 | ||
| 3273 | (defun org-time-string-to-time (s) | 3283 | (defun org-time-string-to-time (s) |
| @@ -3280,14 +3290,14 @@ If time is not given, defaults to 0:00. However, with optional NODEFAULT, | |||
| 3280 | hour and minute fields will be nil if not given." | 3290 | hour and minute fields will be nil if not given." |
| 3281 | (if (string-match org-ts-regexp1 s) | 3291 | (if (string-match org-ts-regexp1 s) |
| 3282 | (list 0 | 3292 | (list 0 |
| 3283 | (if (or (match-beginning 8) (not nodefault)) | 3293 | (if (or (match-beginning 8) (not nodefault)) |
| 3284 | (string-to-number (or (match-string 8 s) "0"))) | 3294 | (string-to-number (or (match-string 8 s) "0"))) |
| 3285 | (if (or (match-beginning 7) (not nodefault)) | 3295 | (if (or (match-beginning 7) (not nodefault)) |
| 3286 | (string-to-number (or (match-string 7 s) "0"))) | 3296 | (string-to-number (or (match-string 7 s) "0"))) |
| 3287 | (string-to-number (match-string 4 s)) | 3297 | (string-to-number (match-string 4 s)) |
| 3288 | (string-to-number (match-string 3 s)) | 3298 | (string-to-number (match-string 3 s)) |
| 3289 | (string-to-number (match-string 2 s)) | 3299 | (string-to-number (match-string 2 s)) |
| 3290 | nil nil nil) | 3300 | nil nil nil) |
| 3291 | (make-list 9 0))) | 3301 | (make-list 9 0))) |
| 3292 | 3302 | ||
| 3293 | (defun org-timestamp-up (&optional arg) | 3303 | (defun org-timestamp-up (&optional arg) |
| @@ -3324,26 +3334,26 @@ With prefix ARG, change that many days." | |||
| 3324 | (>= (match-end n) pos))) | 3334 | (>= (match-end n) pos))) |
| 3325 | 3335 | ||
| 3326 | (defun org-at-timestamp-p () | 3336 | (defun org-at-timestamp-p () |
| 3327 | "Determine if the cursor is at a timestamp." | 3337 | "Determine if the cursor is or at a timestamp." |
| 3328 | (interactive) | 3338 | (interactive) |
| 3329 | (let* ((tsr org-ts-regexp2) | 3339 | (let* ((tsr org-ts-regexp2) |
| 3330 | (pos (point)) | 3340 | (pos (point)) |
| 3331 | (ans (or (looking-at tsr) | 3341 | (ans (or (looking-at tsr) |
| 3332 | (save-excursion | 3342 | (save-excursion |
| 3333 | (skip-chars-backward "^<\n\r\t") | 3343 | (skip-chars-backward "^<\n\r\t") |
| 3334 | (if (> (point) 1) (backward-char 1)) | 3344 | (if (> (point) 1) (backward-char 1)) |
| 3335 | (and (looking-at tsr) | 3345 | (and (looking-at tsr) |
| 3336 | (> (- (match-end 0) pos) -1)))))) | 3346 | (> (- (match-end 0) pos) -1)))))) |
| 3337 | (and (boundp 'org-ts-what) | 3347 | (and (boundp 'org-ts-what) |
| 3338 | (setq org-ts-what | 3348 | (setq org-ts-what |
| 3339 | (cond | 3349 | (cond |
| 3340 | ((org-pos-in-match-range pos 2) 'year) | 3350 | ((org-pos-in-match-range pos 2) 'year) |
| 3341 | ((org-pos-in-match-range pos 3) 'month) | 3351 | ((org-pos-in-match-range pos 3) 'month) |
| 3342 | ((org-pos-in-match-range pos 7) 'hour) | 3352 | ((org-pos-in-match-range pos 7) 'hour) |
| 3343 | ((org-pos-in-match-range pos 8) 'minute) | 3353 | ((org-pos-in-match-range pos 8) 'minute) |
| 3344 | ((or (org-pos-in-match-range pos 4) | 3354 | ((or (org-pos-in-match-range pos 4) |
| 3345 | (org-pos-in-match-range pos 5)) 'day) | 3355 | (org-pos-in-match-range pos 5)) 'day) |
| 3346 | (t 'day)))) | 3356 | (t 'day)))) |
| 3347 | ans)) | 3357 | ans)) |
| 3348 | 3358 | ||
| 3349 | (defun org-timestamp-change (n &optional what) | 3359 | (defun org-timestamp-change (n &optional what) |
| @@ -3352,59 +3362,59 @@ The date will be changed by N times WHAT. WHAT can be `day', `month', | |||
| 3352 | `year', `minute', `second'. If WHAT is not given, the cursor position | 3362 | `year', `minute', `second'. If WHAT is not given, the cursor position |
| 3353 | in the timestamp determines what will be changed." | 3363 | in the timestamp determines what will be changed." |
| 3354 | (let ((fmt (car org-time-stamp-formats)) | 3364 | (let ((fmt (car org-time-stamp-formats)) |
| 3355 | org-ts-what | 3365 | org-ts-what |
| 3356 | (pos (point)) | 3366 | (pos (point)) |
| 3357 | ts time time0) | 3367 | ts time time0) |
| 3358 | (if (not (org-at-timestamp-p)) | 3368 | (if (not (org-at-timestamp-p)) |
| 3359 | (error "Not at a timestamp")) | 3369 | (error "Not at a timestamp")) |
| 3360 | (setq org-ts-what (or what org-ts-what)) | 3370 | (setq org-ts-what (or what org-ts-what)) |
| 3361 | (setq fmt (if (<= (abs (- (cdr org-ts-lengths) | 3371 | (setq fmt (if (<= (abs (- (cdr org-ts-lengths) |
| 3362 | (- (match-end 0) (match-beginning 0)))) | 3372 | (- (match-end 0) (match-beginning 0)))) |
| 3363 | 1) | 3373 | 1) |
| 3364 | (cdr org-time-stamp-formats) | 3374 | (cdr org-time-stamp-formats) |
| 3365 | (car org-time-stamp-formats))) | 3375 | (car org-time-stamp-formats))) |
| 3366 | (setq ts (match-string 0)) | 3376 | (setq ts (match-string 0)) |
| 3367 | (replace-match "") | 3377 | (replace-match "") |
| 3368 | (setq time0 (org-parse-time-string ts)) | 3378 | (setq time0 (org-parse-time-string ts)) |
| 3369 | (setq time | 3379 | (setq time |
| 3370 | (apply 'encode-time | 3380 | (apply 'encode-time |
| 3371 | (append | 3381 | (append |
| 3372 | (list (or (car time0) 0)) | 3382 | (list (or (car time0) 0)) |
| 3373 | (list (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0))) | 3383 | (list (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0))) |
| 3374 | (list (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0))) | 3384 | (list (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0))) |
| 3375 | (list (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0))) | 3385 | (list (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0))) |
| 3376 | (list (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0))) | 3386 | (list (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0))) |
| 3377 | (list (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0))) | 3387 | (list (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0))) |
| 3378 | (nthcdr 6 time0)))) | 3388 | (nthcdr 6 time0)))) |
| 3379 | (if (eq what 'calendar) | 3389 | (if (eq what 'calendar) |
| 3380 | (let ((cal-date | 3390 | (let ((cal-date |
| 3381 | (save-excursion | 3391 | (save-excursion |
| 3382 | (save-match-data | 3392 | (save-match-data |
| 3383 | (set-buffer "*Calendar*") | 3393 | (set-buffer "*Calendar*") |
| 3384 | (calendar-cursor-to-date))))) | 3394 | (calendar-cursor-to-date))))) |
| 3385 | (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month | 3395 | (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month |
| 3386 | (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day | 3396 | (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day |
| 3387 | (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year | 3397 | (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year |
| 3388 | (setcar time0 (or (car time0) 0)) | 3398 | (setcar time0 (or (car time0) 0)) |
| 3389 | (setcar (nthcdr 1 time0) (or (nth 1 time0) 0)) | 3399 | (setcar (nthcdr 1 time0) (or (nth 1 time0) 0)) |
| 3390 | (setcar (nthcdr 2 time0) (or (nth 1 time0) 0)) | 3400 | (setcar (nthcdr 2 time0) (or (nth 1 time0) 0)) |
| 3391 | (setq time (apply 'encode-time time0)))) | 3401 | (setq time (apply 'encode-time time0)))) |
| 3392 | (insert (setq org-last-changed-timestamp (format-time-string fmt time))) | 3402 | (insert (setq org-last-changed-timestamp (format-time-string fmt time))) |
| 3393 | (goto-char pos) | 3403 | (goto-char pos) |
| 3394 | ;; Try to recenter the calendar window, if any | 3404 | ;; Try to recenter the calendar window, if any |
| 3395 | (if (and org-calendar-follow-timestamp-change | 3405 | (if (and org-calendar-follow-timestamp-change |
| 3396 | (get-buffer-window "*Calendar*" t) | 3406 | (get-buffer-window "*Calendar*" t) |
| 3397 | (memq org-ts-what '(day month year))) | 3407 | (memq org-ts-what '(day month year))) |
| 3398 | (org-recenter-calendar (time-to-days time))))) | 3408 | (org-recenter-calendar (time-to-days time))))) |
| 3399 | 3409 | ||
| 3400 | (defun org-recenter-calendar (date) | 3410 | (defun org-recenter-calendar (date) |
| 3401 | "If the calendar is visible, recenter it to DATE." | 3411 | "If the calendar is visible, recenter it to DATE." |
| 3402 | (let* ((win (selected-window)) | 3412 | (let* ((win (selected-window)) |
| 3403 | (cwin (get-buffer-window "*Calendar*" t))) | 3413 | (cwin (get-buffer-window "*Calendar*" t))) |
| 3404 | (when cwin | 3414 | (when cwin |
| 3405 | (select-window cwin) | 3415 | (select-window cwin) |
| 3406 | (calendar-goto-date (if (listp date) date | 3416 | (calendar-goto-date (if (listp date) date |
| 3407 | (calendar-gregorian-from-absolute date))) | 3417 | (calendar-gregorian-from-absolute date))) |
| 3408 | (select-window win)))) | 3418 | (select-window win)))) |
| 3409 | 3419 | ||
| 3410 | (defun org-goto-calendar (&optional arg) | 3420 | (defun org-goto-calendar (&optional arg) |
| @@ -3414,13 +3424,13 @@ A prefix ARG can be used force the current date." | |||
| 3414 | (interactive "P") | 3424 | (interactive "P") |
| 3415 | (let ((tsr org-ts-regexp) diff) | 3425 | (let ((tsr org-ts-regexp) diff) |
| 3416 | (if (or (org-at-timestamp-p) | 3426 | (if (or (org-at-timestamp-p) |
| 3417 | (save-excursion | 3427 | (save-excursion |
| 3418 | (beginning-of-line 1) | 3428 | (beginning-of-line 1) |
| 3419 | (looking-at (concat ".*" tsr)))) | 3429 | (looking-at (concat ".*" tsr)))) |
| 3420 | (let ((d1 (time-to-days (current-time))) | 3430 | (let ((d1 (time-to-days (current-time))) |
| 3421 | (d2 (time-to-days | 3431 | (d2 (time-to-days |
| 3422 | (org-time-string-to-time (match-string 1))))) | 3432 | (org-time-string-to-time (match-string 1))))) |
| 3423 | (setq diff (- d2 d1)))) | 3433 | (setq diff (- d2 d1)))) |
| 3424 | (calendar) | 3434 | (calendar) |
| 3425 | (calendar-goto-today) | 3435 | (calendar-goto-today) |
| 3426 | (if (and diff (not arg)) (calendar-forward-day diff)))) | 3436 | (if (and diff (not arg)) (calendar-forward-day diff)))) |
| @@ -3489,7 +3499,7 @@ The following commands are available: | |||
| 3489 | (define-key org-agenda-mode-map ">" 'org-agenda-date-prompt) | 3499 | (define-key org-agenda-mode-map ">" 'org-agenda-date-prompt) |
| 3490 | (let ((l '(1 2 3 4 5 6 7 8 9 0))) | 3500 | (let ((l '(1 2 3 4 5 6 7 8 9 0))) |
| 3491 | (while l (define-key org-agenda-mode-map | 3501 | (while l (define-key org-agenda-mode-map |
| 3492 | (int-to-string (pop l)) 'digit-argument))) | 3502 | (int-to-string (pop l)) 'digit-argument))) |
| 3493 | 3503 | ||
| 3494 | (define-key org-agenda-mode-map "f" 'org-agenda-follow-mode) | 3504 | (define-key org-agenda-mode-map "f" 'org-agenda-follow-mode) |
| 3495 | (define-key org-agenda-mode-map "D" 'org-agenda-toggle-diary) | 3505 | (define-key org-agenda-mode-map "D" 'org-agenda-toggle-diary) |
| @@ -3597,11 +3607,11 @@ no longer in use." | |||
| 3597 | (defun org-agenda-maybe-reset-markers (&optional force) | 3607 | (defun org-agenda-maybe-reset-markers (&optional force) |
| 3598 | "Reset markers created by `org-agenda'. But only if they are old enough." | 3608 | "Reset markers created by `org-agenda'. But only if they are old enough." |
| 3599 | (if (or force | 3609 | (if (or force |
| 3600 | (> (- (time-to-seconds (current-time)) | 3610 | (> (- (time-to-seconds (current-time)) |
| 3601 | org-agenda-last-marker-time) | 3611 | org-agenda-last-marker-time) |
| 3602 | 5)) | 3612 | 5)) |
| 3603 | (while org-agenda-markers | 3613 | (while org-agenda-markers |
| 3604 | (move-marker (pop org-agenda-markers) nil)))) | 3614 | (move-marker (pop org-agenda-markers) nil)))) |
| 3605 | 3615 | ||
| 3606 | (defvar org-agenda-new-buffers nil | 3616 | (defvar org-agenda-new-buffers nil |
| 3607 | "Buffers created to visit agenda files.") | 3617 | "Buffers created to visit agenda files.") |
| @@ -3611,7 +3621,7 @@ no longer in use." | |||
| 3611 | it to the list of buffers which might be released later." | 3621 | it to the list of buffers which might be released later." |
| 3612 | (let ((buf (find-buffer-visiting file))) | 3622 | (let ((buf (find-buffer-visiting file))) |
| 3613 | (if buf | 3623 | (if buf |
| 3614 | buf ; just return it | 3624 | buf ; just return it |
| 3615 | ;; Make a new buffer and remember it | 3625 | ;; Make a new buffer and remember it |
| 3616 | (setq buf (find-file-noselect file)) | 3626 | (setq buf (find-file-noselect file)) |
| 3617 | (if buf (push buf org-agenda-new-buffers)) | 3627 | (if buf (push buf org-agenda-new-buffers)) |
| @@ -3625,9 +3635,9 @@ When a buffer is unmodified, it is just killed. When modified, it is saved | |||
| 3625 | (while (setq buf (pop blist)) | 3635 | (while (setq buf (pop blist)) |
| 3626 | (setq file (buffer-file-name buf)) | 3636 | (setq file (buffer-file-name buf)) |
| 3627 | (when (and (buffer-modified-p buf) | 3637 | (when (and (buffer-modified-p buf) |
| 3628 | file | 3638 | file |
| 3629 | (y-or-n-p (format "Save file %s? " file))) | 3639 | (y-or-n-p (format "Save file %s? " file))) |
| 3630 | (with-current-buffer buf (save-buffer))) | 3640 | (with-current-buffer buf (save-buffer))) |
| 3631 | (kill-buffer buf)))) | 3641 | (kill-buffer buf)))) |
| 3632 | 3642 | ||
| 3633 | (defvar org-respect-restriction nil) ; Dynamically-scoped param. | 3643 | (defvar org-respect-restriction nil) ; Dynamically-scoped param. |
| @@ -3645,29 +3655,29 @@ dates." | |||
| 3645 | (org-agenda-maybe-reset-markers 'force) | 3655 | (org-agenda-maybe-reset-markers 'force) |
| 3646 | (org-compile-prefix-format org-timeline-prefix-format) | 3656 | (org-compile-prefix-format org-timeline-prefix-format) |
| 3647 | (let* ((dopast include-all) | 3657 | (let* ((dopast include-all) |
| 3648 | (dotodo (equal include-all '(16))) | 3658 | (dotodo (equal include-all '(16))) |
| 3649 | (entry (buffer-file-name)) | 3659 | (entry (buffer-file-name)) |
| 3650 | (org-agenda-files (list (buffer-file-name))) | 3660 | (org-agenda-files (list (buffer-file-name))) |
| 3651 | (date (calendar-current-date)) | 3661 | (date (calendar-current-date)) |
| 3652 | (win (selected-window)) | 3662 | (win (selected-window)) |
| 3653 | (pos1 (point)) | 3663 | (pos1 (point)) |
| 3654 | (beg (if (org-region-active-p) (region-beginning) (point-min))) | 3664 | (beg (if (org-region-active-p) (region-beginning) (point-min))) |
| 3655 | (end (if (org-region-active-p) (region-end) (point-max))) | 3665 | (end (if (org-region-active-p) (region-end) (point-max))) |
| 3656 | (day-numbers (org-get-all-dates beg end 'no-ranges | 3666 | (day-numbers (org-get-all-dates beg end 'no-ranges |
| 3657 | t)) ; always include today | 3667 | t)) ; always include today |
| 3658 | (today (time-to-days (current-time))) | 3668 | (today (time-to-days (current-time))) |
| 3659 | (org-respect-restriction t) | 3669 | (org-respect-restriction t) |
| 3660 | (past t) | 3670 | (past t) |
| 3661 | s e rtn d) | 3671 | s e rtn d) |
| 3662 | (setq org-agenda-redo-command | 3672 | (setq org-agenda-redo-command |
| 3663 | (list 'progn | 3673 | (list 'progn |
| 3664 | (list 'switch-to-buffer-other-window (current-buffer)) | 3674 | (list 'switch-to-buffer-other-window (current-buffer)) |
| 3665 | (list 'org-timeline include-all))) | 3675 | (list 'org-timeline (list 'quote include-all)))) |
| 3666 | (if (not dopast) | 3676 | (if (not dopast) |
| 3667 | ;; Remove past dates from the list of dates. | 3677 | ;; Remove past dates from the list of dates. |
| 3668 | (setq day-numbers (delq nil (mapcar (lambda(x) | 3678 | (setq day-numbers (delq nil (mapcar (lambda(x) |
| 3669 | (if (>= x today) x nil)) | 3679 | (if (>= x today) x nil)) |
| 3670 | day-numbers)))) | 3680 | day-numbers)))) |
| 3671 | (switch-to-buffer-other-window | 3681 | (switch-to-buffer-other-window |
| 3672 | (get-buffer-create org-agenda-buffer-name)) | 3682 | (get-buffer-create org-agenda-buffer-name)) |
| 3673 | (setq buffer-read-only nil) | 3683 | (setq buffer-read-only nil) |
| @@ -3675,33 +3685,33 @@ dates." | |||
| 3675 | (org-agenda-mode) (setq buffer-read-only nil) | 3685 | (org-agenda-mode) (setq buffer-read-only nil) |
| 3676 | (while (setq d (pop day-numbers)) | 3686 | (while (setq d (pop day-numbers)) |
| 3677 | (if (and (>= d today) | 3687 | (if (and (>= d today) |
| 3678 | dopast | 3688 | dopast |
| 3679 | past) | 3689 | past) |
| 3680 | (progn | 3690 | (progn |
| 3681 | (setq past nil) | 3691 | (setq past nil) |
| 3682 | (insert (make-string 79 ?-) "\n"))) | 3692 | (insert (make-string 79 ?-) "\n"))) |
| 3683 | (setq date (calendar-gregorian-from-absolute d)) | 3693 | (setq date (calendar-gregorian-from-absolute d)) |
| 3684 | (setq s (point)) | 3694 | (setq s (point)) |
| 3685 | (if dotodo | 3695 | (if dotodo |
| 3686 | (setq rtn (org-agenda-get-day-entries | 3696 | (setq rtn (org-agenda-get-day-entries |
| 3687 | entry date :todo :timestamp)) | 3697 | entry date :todo :timestamp)) |
| 3688 | (setq rtn (org-agenda-get-day-entries entry date :timestamp))) | 3698 | (setq rtn (org-agenda-get-day-entries entry date :timestamp))) |
| 3689 | (if (or rtn (equal d today)) | 3699 | (if (or rtn (equal d today)) |
| 3690 | (progn | 3700 | (progn |
| 3691 | (insert (calendar-day-name date) " " | 3701 | (insert (calendar-day-name date) " " |
| 3692 | (number-to-string (extract-calendar-day date)) " " | 3702 | (number-to-string (extract-calendar-day date)) " " |
| 3693 | (calendar-month-name (extract-calendar-month date)) " " | 3703 | (calendar-month-name (extract-calendar-month date)) " " |
| 3694 | (number-to-string (extract-calendar-year date)) "\n") | 3704 | (number-to-string (extract-calendar-year date)) "\n") |
| 3695 | (put-text-property s (1- (point)) 'face | 3705 | (put-text-property s (1- (point)) 'face |
| 3696 | 'org-link) | 3706 | 'org-link) |
| 3697 | (if (equal d today) | 3707 | (if (equal d today) |
| 3698 | (put-text-property s (1- (point)) 'org-today t)) | 3708 | (put-text-property s (1- (point)) 'org-today t)) |
| 3699 | (insert (org-finalize-agenda-entries rtn) "\n") | 3709 | (insert (org-finalize-agenda-entries rtn) "\n") |
| 3700 | (put-text-property s (1- (point)) 'day d)))) | 3710 | (put-text-property s (1- (point)) 'day d)))) |
| 3701 | (goto-char (point-min)) | 3711 | (goto-char (point-min)) |
| 3702 | (setq buffer-read-only t) | 3712 | (setq buffer-read-only t) |
| 3703 | (goto-char (or (text-property-any (point-min) (point-max) 'org-today t) | 3713 | (goto-char (or (text-property-any (point-min) (point-max) 'org-today t) |
| 3704 | (point-min))) | 3714 | (point-min))) |
| 3705 | (when (not org-select-timeline-window) | 3715 | (when (not org-select-timeline-window) |
| 3706 | (select-window win) | 3716 | (select-window win) |
| 3707 | (goto-char pos1)))) | 3717 | (goto-char pos1)))) |
| @@ -3721,107 +3731,107 @@ NDAYS defaults to `org-agenda-ndays'." | |||
| 3721 | (org-compile-prefix-format org-agenda-prefix-format) | 3731 | (org-compile-prefix-format org-agenda-prefix-format) |
| 3722 | (require 'calendar) | 3732 | (require 'calendar) |
| 3723 | (let* ((org-agenda-start-on-weekday | 3733 | (let* ((org-agenda-start-on-weekday |
| 3724 | (if (or (equal ndays 1) | 3734 | (if (or (equal ndays 1) |
| 3725 | (and (null ndays) (equal 1 org-agenda-ndays))) | 3735 | (and (null ndays) (equal 1 org-agenda-ndays))) |
| 3726 | nil org-agenda-start-on-weekday)) | 3736 | nil org-agenda-start-on-weekday)) |
| 3727 | (files (copy-sequence org-agenda-files)) | 3737 | (files (copy-sequence org-agenda-files)) |
| 3728 | (win (selected-window)) | 3738 | (win (selected-window)) |
| 3729 | (today (time-to-days (current-time))) | 3739 | (today (time-to-days (current-time))) |
| 3730 | (sd (or start-day today)) | 3740 | (sd (or start-day today)) |
| 3731 | (start (if (or (null org-agenda-start-on-weekday) | 3741 | (start (if (or (null org-agenda-start-on-weekday) |
| 3732 | (< org-agenda-ndays 7)) | 3742 | (< org-agenda-ndays 7)) |
| 3733 | sd | 3743 | sd |
| 3734 | (let* ((nt (calendar-day-of-week | 3744 | (let* ((nt (calendar-day-of-week |
| 3735 | (calendar-gregorian-from-absolute sd))) | 3745 | (calendar-gregorian-from-absolute sd))) |
| 3736 | (n1 org-agenda-start-on-weekday) | 3746 | (n1 org-agenda-start-on-weekday) |
| 3737 | (d (- nt n1))) | 3747 | (d (- nt n1))) |
| 3738 | (- sd (+ (if (< d 0) 7 0) d))))) | 3748 | (- sd (+ (if (< d 0) 7 0) d))))) |
| 3739 | (day-numbers (list start)) | 3749 | (day-numbers (list start)) |
| 3740 | (inhibit-redisplay t) | 3750 | (inhibit-redisplay t) |
| 3741 | s e rtn rtnall file date d start-pos end-pos todayp nd) | 3751 | s e rtn rtnall file date d start-pos end-pos todayp nd) |
| 3742 | (setq org-agenda-redo-command | 3752 | (setq org-agenda-redo-command |
| 3743 | (list 'org-agenda include-all start-day ndays)) | 3753 | (list 'org-agenda (list 'quote include-all) start-day ndays)) |
| 3744 | ;; Make the list of days | 3754 | ;; Make the list of days |
| 3745 | (setq ndays (or ndays org-agenda-ndays) | 3755 | (setq ndays (or ndays org-agenda-ndays) |
| 3746 | nd ndays) | 3756 | nd ndays) |
| 3747 | (while (> ndays 1) | 3757 | (while (> ndays 1) |
| 3748 | (push (1+ (car day-numbers)) day-numbers) | 3758 | (push (1+ (car day-numbers)) day-numbers) |
| 3749 | (setq ndays (1- ndays))) | 3759 | (setq ndays (1- ndays))) |
| 3750 | (setq day-numbers (nreverse day-numbers)) | 3760 | (setq day-numbers (nreverse day-numbers)) |
| 3751 | (if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name))) | 3761 | (if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name))) |
| 3752 | (progn | 3762 | (progn |
| 3753 | (delete-other-windows) | 3763 | (delete-other-windows) |
| 3754 | (switch-to-buffer-other-window | 3764 | (switch-to-buffer-other-window |
| 3755 | (get-buffer-create org-agenda-buffer-name)))) | 3765 | (get-buffer-create org-agenda-buffer-name)))) |
| 3756 | (setq buffer-read-only nil) | 3766 | (setq buffer-read-only nil) |
| 3757 | (erase-buffer) | 3767 | (erase-buffer) |
| 3758 | (org-agenda-mode) (setq buffer-read-only nil) | 3768 | (org-agenda-mode) (setq buffer-read-only nil) |
| 3759 | (set (make-local-variable 'starting-day) (car day-numbers)) | 3769 | (set (make-local-variable 'starting-day) (car day-numbers)) |
| 3760 | (set (make-local-variable 'include-all-loc) include-all) | 3770 | (set (make-local-variable 'include-all-loc) include-all) |
| 3761 | (when (and (or include-all org-agenda-include-all-todo) | 3771 | (when (and (or include-all org-agenda-include-all-todo) |
| 3762 | (member today day-numbers)) | 3772 | (member today day-numbers)) |
| 3763 | (setq files org-agenda-files | 3773 | (setq files org-agenda-files |
| 3764 | rtnall nil) | 3774 | rtnall nil) |
| 3765 | (while (setq file (pop files)) | 3775 | (while (setq file (pop files)) |
| 3766 | (catch 'nextfile | 3776 | (catch 'nextfile |
| 3767 | (org-check-agenda-file file) | 3777 | (org-check-agenda-file file) |
| 3768 | (setq date (calendar-gregorian-from-absolute today) | 3778 | (setq date (calendar-gregorian-from-absolute today) |
| 3769 | rtn (org-agenda-get-day-entries | 3779 | rtn (org-agenda-get-day-entries |
| 3770 | file date :todo)) | 3780 | file date :todo)) |
| 3771 | (setq rtnall (append rtnall rtn)))) | 3781 | (setq rtnall (append rtnall rtn)))) |
| 3772 | (when rtnall | 3782 | (when rtnall |
| 3773 | (insert "ALL CURRENTLY OPEN TODO ITEMS:\n") | 3783 | (insert "ALL CURRENTLY OPEN TODO ITEMS:\n") |
| 3774 | (add-text-properties (point-min) (1- (point)) | 3784 | (add-text-properties (point-min) (1- (point)) |
| 3775 | (list 'face 'org-link)) | 3785 | (list 'face 'org-link)) |
| 3776 | (insert (org-finalize-agenda-entries rtnall) "\n"))) | 3786 | (insert (org-finalize-agenda-entries rtnall) "\n"))) |
| 3777 | (while (setq d (pop day-numbers)) | 3787 | (while (setq d (pop day-numbers)) |
| 3778 | (setq date (calendar-gregorian-from-absolute d) | 3788 | (setq date (calendar-gregorian-from-absolute d) |
| 3779 | s (point)) | 3789 | s (point)) |
| 3780 | (if (or (setq todayp (= d today)) | 3790 | (if (or (setq todayp (= d today)) |
| 3781 | (and (not start-pos) (= d sd))) | 3791 | (and (not start-pos) (= d sd))) |
| 3782 | (setq start-pos (point)) | 3792 | (setq start-pos (point)) |
| 3783 | (if (and start-pos (not end-pos)) | 3793 | (if (and start-pos (not end-pos)) |
| 3784 | (setq end-pos (point)))) | 3794 | (setq end-pos (point)))) |
| 3785 | (setq files org-agenda-files | 3795 | (setq files org-agenda-files |
| 3786 | rtnall nil) | 3796 | rtnall nil) |
| 3787 | (while (setq file (pop files)) | 3797 | (while (setq file (pop files)) |
| 3788 | (catch 'nextfile | 3798 | (catch 'nextfile |
| 3789 | (org-check-agenda-file file) | 3799 | (org-check-agenda-file file) |
| 3790 | (setq rtn (org-agenda-get-day-entries file date)) | 3800 | (setq rtn (org-agenda-get-day-entries file date)) |
| 3791 | (setq rtnall (append rtnall rtn)))) | 3801 | (setq rtnall (append rtnall rtn)))) |
| 3792 | (if org-agenda-include-diary | 3802 | (if org-agenda-include-diary |
| 3793 | (progn | 3803 | (progn |
| 3794 | (require 'diary-lib) | 3804 | (require 'diary-lib) |
| 3795 | (setq rtn (org-get-entries-from-diary date)) | 3805 | (setq rtn (org-get-entries-from-diary date)) |
| 3796 | (setq rtnall (append rtnall rtn)))) | 3806 | (setq rtnall (append rtnall rtn)))) |
| 3797 | (if (or rtnall org-agenda-show-all-dates) | 3807 | (if (or rtnall org-agenda-show-all-dates) |
| 3798 | (progn | 3808 | (progn |
| 3799 | (insert (format "%-9s %2d %s %4d\n" | 3809 | (insert (format "%-9s %2d %s %4d\n" |
| 3800 | (calendar-day-name date) | 3810 | (calendar-day-name date) |
| 3801 | (extract-calendar-day date) | 3811 | (extract-calendar-day date) |
| 3802 | (calendar-month-name (extract-calendar-month date)) | 3812 | (calendar-month-name (extract-calendar-month date)) |
| 3803 | (extract-calendar-year date))) | 3813 | (extract-calendar-year date))) |
| 3804 | (put-text-property s (1- (point)) 'face | 3814 | (put-text-property s (1- (point)) 'face |
| 3805 | 'org-link) | 3815 | 'org-link) |
| 3806 | (if rtnall (insert | 3816 | (if rtnall (insert |
| 3807 | (org-finalize-agenda-entries ;; FIXME: condition needed | 3817 | (org-finalize-agenda-entries ;; FIXME: condition needed |
| 3808 | (org-agenda-add-time-grid-maybe | 3818 | (org-agenda-add-time-grid-maybe |
| 3809 | rtnall nd todayp)) | 3819 | rtnall nd todayp)) |
| 3810 | "\n")) | 3820 | "\n")) |
| 3811 | (put-text-property s (1- (point)) 'day d)))) | 3821 | (put-text-property s (1- (point)) 'day d)))) |
| 3812 | (goto-char (point-min)) | 3822 | (goto-char (point-min)) |
| 3813 | (setq buffer-read-only t) | 3823 | (setq buffer-read-only t) |
| 3814 | (if org-fit-agenda-window | 3824 | (if org-fit-agenda-window |
| 3815 | (fit-window-to-buffer nil (/ (* (frame-height) 3) 4) | 3825 | (fit-window-to-buffer nil (/ (* (frame-height) 3) 4) |
| 3816 | (/ (frame-height) 2))) | 3826 | (/ (frame-height) 2))) |
| 3817 | (unless (and (pos-visible-in-window-p (point-min)) | 3827 | (unless (and (pos-visible-in-window-p (point-min)) |
| 3818 | (pos-visible-in-window-p (point-max))) | 3828 | (pos-visible-in-window-p (point-max))) |
| 3819 | (goto-char (1- (point-max))) | 3829 | (goto-char (1- (point-max))) |
| 3820 | (recenter -1) | 3830 | (recenter -1) |
| 3821 | (if (not (pos-visible-in-window-p (or start-pos 1))) | 3831 | (if (not (pos-visible-in-window-p (or start-pos 1))) |
| 3822 | (progn | 3832 | (progn |
| 3823 | (goto-char (or start-pos 1)) | 3833 | (goto-char (or start-pos 1)) |
| 3824 | (recenter 1)))) | 3834 | (recenter 1)))) |
| 3825 | (goto-char (or start-pos 1)) | 3835 | (goto-char (or start-pos 1)) |
| 3826 | (if (not org-select-agenda-window) (select-window win)) | 3836 | (if (not org-select-agenda-window) (select-window win)) |
| 3827 | (message ""))) | 3837 | (message ""))) |
| @@ -3832,12 +3842,12 @@ NDAYS defaults to `org-agenda-ndays'." | |||
| 3832 | ;; Could probably be fixed by explicitly going to the buffer. | 3842 | ;; Could probably be fixed by explicitly going to the buffer. |
| 3833 | (when (not (file-exists-p file)) | 3843 | (when (not (file-exists-p file)) |
| 3834 | (message "non-existent file %s. [R]emove from agenda-files or [A]bort?" | 3844 | (message "non-existent file %s. [R]emove from agenda-files or [A]bort?" |
| 3835 | file) | 3845 | file) |
| 3836 | (let ((r (downcase (read-char-exclusive)))) | 3846 | (let ((r (downcase (read-char-exclusive)))) |
| 3837 | (cond | 3847 | (cond |
| 3838 | ((equal r ?r) | 3848 | ((equal r ?r) |
| 3839 | (org-remove-file file) | 3849 | (org-remove-file file) |
| 3840 | (throw 'nextfile t)) | 3850 | (throw 'nextfile t)) |
| 3841 | (t (error "Abort")))))) | 3851 | (t (error "Abort")))))) |
| 3842 | 3852 | ||
| 3843 | (defun org-agenda-quit () | 3853 | (defun org-agenda-quit () |
| @@ -3867,11 +3877,11 @@ Org-mode buffers visited directly by the user will not be touched." | |||
| 3867 | (interactive) | 3877 | (interactive) |
| 3868 | (if (boundp 'starting-day) | 3878 | (if (boundp 'starting-day) |
| 3869 | (let ((cmd (car org-agenda-redo-command)) | 3879 | (let ((cmd (car org-agenda-redo-command)) |
| 3870 | (iall (nth 1 org-agenda-redo-command)) | 3880 | (iall (nth 1 org-agenda-redo-command)) |
| 3871 | (nday (nth 3 org-agenda-redo-command))) | 3881 | (nday (nth 3 org-agenda-redo-command))) |
| 3872 | (eval (list cmd iall nil nday))) | 3882 | (eval (list cmd iall nil nday))) |
| 3873 | (goto-char (or (text-property-any (point-min) (point-max) 'org-today t) | 3883 | (goto-char (or (text-property-any (point-min) (point-max) 'org-today t) |
| 3874 | (point-min))))) | 3884 | (point-min))))) |
| 3875 | 3885 | ||
| 3876 | (defun org-agenda-later (arg) | 3886 | (defun org-agenda-later (arg) |
| 3877 | "Go forward in time by `org-agenda-ndays' days. | 3887 | "Go forward in time by `org-agenda-ndays' days. |
| @@ -3880,7 +3890,7 @@ With prefix ARG, go forward that many times `org-agenda-ndays'." | |||
| 3880 | (unless (boundp 'starting-day) | 3890 | (unless (boundp 'starting-day) |
| 3881 | (error "Not allowed")) | 3891 | (error "Not allowed")) |
| 3882 | (org-agenda (if (boundp 'include-all-loc) include-all-loc nil) | 3892 | (org-agenda (if (boundp 'include-all-loc) include-all-loc nil) |
| 3883 | (+ starting-day (* arg org-agenda-ndays)))) | 3893 | (+ starting-day (* arg org-agenda-ndays)))) |
| 3884 | 3894 | ||
| 3885 | (defun org-agenda-earlier (arg) | 3895 | (defun org-agenda-earlier (arg) |
| 3886 | "Go back in time by `org-agenda-ndays' days. | 3896 | "Go back in time by `org-agenda-ndays' days. |
| @@ -3889,7 +3899,7 @@ With prefix ARG, go back that many times `org-agenda-ndays'." | |||
| 3889 | (unless (boundp 'starting-day) | 3899 | (unless (boundp 'starting-day) |
| 3890 | (error "Not allowed")) | 3900 | (error "Not allowed")) |
| 3891 | (org-agenda (if (boundp 'include-all-loc) include-all-loc nil) | 3901 | (org-agenda (if (boundp 'include-all-loc) include-all-loc nil) |
| 3892 | (- starting-day (* arg org-agenda-ndays)))) | 3902 | (- starting-day (* arg org-agenda-ndays)))) |
| 3893 | 3903 | ||
| 3894 | (defun org-agenda-week-view () | 3904 | (defun org-agenda-week-view () |
| 3895 | "Switch to weekly view for agenda." | 3905 | "Switch to weekly view for agenda." |
| @@ -3898,20 +3908,20 @@ With prefix ARG, go back that many times `org-agenda-ndays'." | |||
| 3898 | (error "Not allowed")) | 3908 | (error "Not allowed")) |
| 3899 | (setq org-agenda-ndays 7) | 3909 | (setq org-agenda-ndays 7) |
| 3900 | (org-agenda include-all-loc | 3910 | (org-agenda include-all-loc |
| 3901 | (or (get-text-property (point) 'day) | 3911 | (or (get-text-property (point) 'day) |
| 3902 | starting-day)) | 3912 | starting-day)) |
| 3903 | (org-agenda-set-mode-name) | 3913 | (org-agenda-set-mode-name) |
| 3904 | (message "Switched to week view")) | 3914 | (message "Switched to week view")) |
| 3905 | 3915 | ||
| 3906 | (defun org-agenda-day-view () | 3916 | (defun org-agenda-day-view () |
| 3907 | "Switch to daily view for agenda." | 3917 | "Switch to weekly view for agenda." |
| 3908 | (interactive) | 3918 | (interactive) |
| 3909 | (unless (boundp 'starting-day) | 3919 | (unless (boundp 'starting-day) |
| 3910 | (error "Not allowed")) | 3920 | (error "Not allowed")) |
| 3911 | (setq org-agenda-ndays 1) | 3921 | (setq org-agenda-ndays 1) |
| 3912 | (org-agenda include-all-loc | 3922 | (org-agenda include-all-loc |
| 3913 | (or (get-text-property (point) 'day) | 3923 | (or (get-text-property (point) 'day) |
| 3914 | starting-day)) | 3924 | starting-day)) |
| 3915 | (org-agenda-set-mode-name) | 3925 | (org-agenda-set-mode-name) |
| 3916 | (message "Switched to day view")) | 3926 | (message "Switched to day view")) |
| 3917 | 3927 | ||
| @@ -3922,8 +3932,8 @@ With prefix ARG, go back that many times `org-agenda-ndays'." | |||
| 3922 | (if (looking-at "^\\S-") (forward-char 1)) | 3932 | (if (looking-at "^\\S-") (forward-char 1)) |
| 3923 | (if (not (re-search-forward "^\\S-" nil t arg)) | 3933 | (if (not (re-search-forward "^\\S-" nil t arg)) |
| 3924 | (progn | 3934 | (progn |
| 3925 | (backward-char 1) | 3935 | (backward-char 1) |
| 3926 | (error "No next date after this line in this buffer"))) | 3936 | (error "No next date after this line in this buffer"))) |
| 3927 | (goto-char (match-beginning 0))) | 3937 | (goto-char (match-beginning 0))) |
| 3928 | 3938 | ||
| 3929 | (defun org-agenda-previous-date-line (&optional arg) | 3939 | (defun org-agenda-previous-date-line (&optional arg) |
| @@ -3936,12 +3946,12 @@ With prefix ARG, go back that many times `org-agenda-ndays'." | |||
| 3936 | ;; Initialize the highlight | 3946 | ;; Initialize the highlight |
| 3937 | (defvar org-hl (funcall (if org-xemacs-p 'make-extent 'make-overlay) 1 1)) | 3947 | (defvar org-hl (funcall (if org-xemacs-p 'make-extent 'make-overlay) 1 1)) |
| 3938 | (funcall (if org-xemacs-p 'set-extent-property 'overlay-put) org-hl | 3948 | (funcall (if org-xemacs-p 'set-extent-property 'overlay-put) org-hl |
| 3939 | 'face 'highlight) | 3949 | 'face 'highlight) |
| 3940 | 3950 | ||
| 3941 | (defun org-highlight (begin end &optional buffer) | 3951 | (defun org-highlight (begin end &optional buffer) |
| 3942 | "Highlight a region with overlay." | 3952 | "Highlight a region with overlay." |
| 3943 | (funcall (if org-xemacs-p 'set-extent-endpoints 'move-overlay) | 3953 | (funcall (if org-xemacs-p 'set-extent-endpoints 'move-overlay) |
| 3944 | org-hl begin end (or buffer (current-buffer)))) | 3954 | org-hl begin end (or buffer (current-buffer)))) |
| 3945 | 3955 | ||
| 3946 | (defun org-unhighlight () | 3956 | (defun org-unhighlight () |
| 3947 | "Detach overlay INDEX." | 3957 | "Detach overlay INDEX." |
| @@ -3954,41 +3964,41 @@ With prefix ARG, go back that many times `org-agenda-ndays'." | |||
| 3954 | (setq org-agenda-follow-mode (not org-agenda-follow-mode)) | 3964 | (setq org-agenda-follow-mode (not org-agenda-follow-mode)) |
| 3955 | (org-agenda-set-mode-name) | 3965 | (org-agenda-set-mode-name) |
| 3956 | (message "Follow mode is %s" | 3966 | (message "Follow mode is %s" |
| 3957 | (if org-agenda-follow-mode "on" "off"))) | 3967 | (if org-agenda-follow-mode "on" "off"))) |
| 3958 | 3968 | ||
| 3959 | (defun org-agenda-toggle-diary () | 3969 | (defun org-agenda-toggle-diary () |
| 3960 | "Toggle diary inclusion in an agenda buffer." | 3970 | "Toggle follow mode in an agenda buffer." |
| 3961 | (interactive) | 3971 | (interactive) |
| 3962 | (setq org-agenda-include-diary (not org-agenda-include-diary)) | 3972 | (setq org-agenda-include-diary (not org-agenda-include-diary)) |
| 3963 | (org-agenda-redo) | 3973 | (org-agenda-redo) |
| 3964 | (org-agenda-set-mode-name) | 3974 | (org-agenda-set-mode-name) |
| 3965 | (message "Diary inclusion turned %s" | 3975 | (message "Diary inclusion turned %s" |
| 3966 | (if org-agenda-include-diary "on" "off"))) | 3976 | (if org-agenda-include-diary "on" "off"))) |
| 3967 | 3977 | ||
| 3968 | (defun org-agenda-toggle-time-grid () | 3978 | (defun org-agenda-toggle-time-grid () |
| 3969 | "Toggle time-grid in an agenda buffer." | 3979 | "Toggle follow mode in an agenda buffer." |
| 3970 | (interactive) | 3980 | (interactive) |
| 3971 | (setq org-agenda-use-time-grid (not org-agenda-use-time-grid)) | 3981 | (setq org-agenda-use-time-grid (not org-agenda-use-time-grid)) |
| 3972 | (org-agenda-redo) | 3982 | (org-agenda-redo) |
| 3973 | (org-agenda-set-mode-name) | 3983 | (org-agenda-set-mode-name) |
| 3974 | (message "Time-grid turned %s" | 3984 | (message "Time-grid turned %s" |
| 3975 | (if org-agenda-use-time-grid "on" "off"))) | 3985 | (if org-agenda-use-time-grid "on" "off"))) |
| 3976 | 3986 | ||
| 3977 | (defun org-agenda-set-mode-name () | 3987 | (defun org-agenda-set-mode-name () |
| 3978 | "Set the mode name to indicate all the small mode settings." | 3988 | "Set the mode name to indicate all the small mode settings." |
| 3979 | (setq mode-name | 3989 | (setq mode-name |
| 3980 | (concat "Org-Agenda" | 3990 | (concat "Org-Agenda" |
| 3981 | (if (equal org-agenda-ndays 1) " Day" "") | 3991 | (if (equal org-agenda-ndays 1) " Day" "") |
| 3982 | (if (equal org-agenda-ndays 7) " Week" "") | 3992 | (if (equal org-agenda-ndays 7) " Week" "") |
| 3983 | (if org-agenda-follow-mode " Follow" "") | 3993 | (if org-agenda-follow-mode " Follow" "") |
| 3984 | (if org-agenda-include-diary " Diary" "") | 3994 | (if org-agenda-include-diary " Diary" "") |
| 3985 | (if org-agenda-use-time-grid " Grid" ""))) | 3995 | (if org-agenda-use-time-grid " Grid" ""))) |
| 3986 | (force-mode-line-update)) | 3996 | (force-mode-line-update)) |
| 3987 | 3997 | ||
| 3988 | (defun org-agenda-post-command-hook () | 3998 | (defun org-agenda-post-command-hook () |
| 3989 | (and (eolp) (not (bolp)) (backward-char 1)) | 3999 | (and (eolp) (not (bolp)) (backward-char 1)) |
| 3990 | (if (and org-agenda-follow-mode | 4000 | (if (and org-agenda-follow-mode |
| 3991 | (get-text-property (point) 'org-marker)) | 4001 | (get-text-property (point) 'org-marker)) |
| 3992 | (org-agenda-show))) | 4002 | (org-agenda-show))) |
| 3993 | 4003 | ||
| 3994 | (defvar org-disable-diary nil) ;Dynamically-scoped param. | 4004 | (defvar org-disable-diary nil) ;Dynamically-scoped param. |
| @@ -3996,55 +4006,55 @@ With prefix ARG, go back that many times `org-agenda-ndays'." | |||
| 3996 | (defun org-get-entries-from-diary (date) | 4006 | (defun org-get-entries-from-diary (date) |
| 3997 | "Get the (Emacs Calendar) diary entries for DATE." | 4007 | "Get the (Emacs Calendar) diary entries for DATE." |
| 3998 | (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*") | 4008 | (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*") |
| 3999 | (diary-display-hook '(fancy-diary-display)) | 4009 | (diary-display-hook '(fancy-diary-display)) |
| 4000 | (list-diary-entries-hook | 4010 | (list-diary-entries-hook |
| 4001 | (cons 'org-diary-default-entry list-diary-entries-hook)) | 4011 | (cons 'org-diary-default-entry list-diary-entries-hook)) |
| 4002 | entries | 4012 | entries |
| 4003 | (org-disable-diary t)) | 4013 | (org-disable-diary t)) |
| 4004 | (save-excursion | 4014 | (save-excursion |
| 4005 | (save-window-excursion | 4015 | (save-window-excursion |
| 4006 | (list-diary-entries date 1))) | 4016 | (list-diary-entries date 1))) |
| 4007 | (if (not (get-buffer fancy-diary-buffer)) | 4017 | (if (not (get-buffer fancy-diary-buffer)) |
| 4008 | (setq entries nil) | 4018 | (setq entries nil) |
| 4009 | (with-current-buffer fancy-diary-buffer | 4019 | (with-current-buffer fancy-diary-buffer |
| 4010 | (setq buffer-read-only nil) | 4020 | (setq buffer-read-only nil) |
| 4011 | (if (= (point-max) 1) | 4021 | (if (= (point-max) 1) |
| 4012 | ;; No entries | 4022 | ;; No entries |
| 4013 | (setq entries nil) | 4023 | (setq entries nil) |
| 4014 | ;; Omit the date and other unnecessary stuff | 4024 | ;; Omit the date and other unnecessary stuff |
| 4015 | (org-agenda-cleanup-fancy-diary) | 4025 | (org-agenda-cleanup-fancy-diary) |
| 4016 | ;; Add prefix to each line and extend the text properties | 4026 | ;; Add prefix to each line and extend the text properties |
| 4017 | (if (= (point-max) 1) | 4027 | (if (= (point-max) 1) |
| 4018 | (setq entries nil) | 4028 | (setq entries nil) |
| 4019 | (setq entries (buffer-substring (point-min) (- (point-max) 1))))) | 4029 | (setq entries (buffer-substring (point-min) (- (point-max) 1))))) |
| 4020 | (set-buffer-modified-p nil) | 4030 | (set-buffer-modified-p nil) |
| 4021 | (kill-buffer fancy-diary-buffer))) | 4031 | (kill-buffer fancy-diary-buffer))) |
| 4022 | (when entries | 4032 | (when entries |
| 4023 | (setq entries (org-split-string entries "\n")) | 4033 | (setq entries (org-split-string entries "\n")) |
| 4024 | (setq entries | 4034 | (setq entries |
| 4025 | (mapcar | 4035 | (mapcar |
| 4026 | (lambda (x) | 4036 | (lambda (x) |
| 4027 | (setq x (org-format-agenda-item "" x "Diary" 'time)) | 4037 | (setq x (org-format-agenda-item "" x "Diary" 'time)) |
| 4028 | ;; Extend the text properties to the beginning of the line | 4038 | ;; Extend the text properties to the beginning of the line |
| 4029 | (add-text-properties | 4039 | (add-text-properties |
| 4030 | 0 (length x) | 4040 | 0 (length x) |
| 4031 | (text-properties-at (1- (length x)) x) | 4041 | (text-properties-at (1- (length x)) x) |
| 4032 | x) | 4042 | x) |
| 4033 | x) | 4043 | x) |
| 4034 | entries))))) | 4044 | entries))))) |
| 4035 | 4045 | ||
| 4036 | (defun org-agenda-cleanup-fancy-diary () | 4046 | (defun org-agenda-cleanup-fancy-diary () |
| 4037 | "Remove unwanted stuff in buffer created by `fancy-diary-display'. | 4047 | "Remove unwanted stuff in buffer created by fancy-diary-display. |
| 4038 | This gets rid of the date, the underline under the date, and | 4048 | This gets rid of the date, the underline under the date, and |
| 4039 | the dummy entry installed by `org-mode' to ensure non-empty diary for each | 4049 | the dummy entry installed by `org-mode' to ensure non-empty diary for each |
| 4040 | date. It also removes lines that contain only whitespace." | 4050 | date. Itt also removes lines that contain only whitespace." |
| 4041 | (goto-char (point-min)) | 4051 | (goto-char (point-min)) |
| 4042 | (if (looking-at ".*?:[ \t]*") | 4052 | (if (looking-at ".*?:[ \t]*") |
| 4043 | (progn | 4053 | (progn |
| 4044 | (replace-match "") | 4054 | (replace-match "") |
| 4045 | (re-search-forward "\n=+$" nil t) | 4055 | (re-search-forward "\n=+$" nil t) |
| 4046 | (replace-match "") | 4056 | (replace-match "") |
| 4047 | (while (re-search-backward "^ +\n?" nil t) (replace-match ""))) | 4057 | (while (re-search-backward "^ +\n?" nil t) (replace-match ""))) |
| 4048 | (re-search-forward "\n=+$" nil t) | 4058 | (re-search-forward "\n=+$" nil t) |
| 4049 | (delete-region (point-min) (min (point-max) (1+ (match-end 0))))) | 4059 | (delete-region (point-min) (min (point-max) (1+ (match-end 0))))) |
| 4050 | (goto-char (point-min)) | 4060 | (goto-char (point-min)) |
| @@ -4061,19 +4071,19 @@ date. It also removes lines that contain only whitespace." | |||
| 4061 | '(defadvice add-to-diary-list (before org-mark-diary-entry activate) | 4071 | '(defadvice add-to-diary-list (before org-mark-diary-entry activate) |
| 4062 | "Make the position visible." | 4072 | "Make the position visible." |
| 4063 | (if (and org-disable-diary ;; called from org-agenda | 4073 | (if (and org-disable-diary ;; called from org-agenda |
| 4064 | (stringp string) | 4074 | (stringp string) |
| 4065 | (buffer-file-name)) | 4075 | (buffer-file-name)) |
| 4066 | (add-text-properties | 4076 | (add-text-properties |
| 4067 | 0 (length string) | 4077 | 0 (length string) |
| 4068 | (list 'mouse-face 'highlight | 4078 | (list 'mouse-face 'highlight |
| 4069 | 'keymap org-agenda-keymap | 4079 | 'keymap org-agenda-keymap |
| 4070 | 'help-echo | 4080 | 'help-echo |
| 4071 | (format | 4081 | (format |
| 4072 | "mouse-2 or RET jump to diary file %s" | 4082 | "mouse-2 or RET jump to diary file %s" |
| 4073 | (abbreviate-file-name (buffer-file-name))) | 4083 | (abbreviate-file-name (buffer-file-name))) |
| 4074 | 'org-agenda-diary-link t | 4084 | 'org-agenda-diary-link t |
| 4075 | 'org-marker (org-agenda-new-marker (point-at-bol))) | 4085 | 'org-marker (org-agenda-new-marker (point-at-bol))) |
| 4076 | string)))) | 4086 | string)))) |
| 4077 | 4087 | ||
| 4078 | (defun org-diary-default-entry () | 4088 | (defun org-diary-default-entry () |
| 4079 | "Add a dummy entry to the diary. | 4089 | "Add a dummy entry to the diary. |
| @@ -4093,25 +4103,25 @@ It is possible (but not recommended) to add this function to the | |||
| 4093 | (interactive) | 4103 | (interactive) |
| 4094 | (catch 'exit | 4104 | (catch 'exit |
| 4095 | (let* ((file (or file (buffer-file-name) | 4105 | (let* ((file (or file (buffer-file-name) |
| 4096 | (if (interactive-p) | 4106 | (if (interactive-p) |
| 4097 | (error "Buffer is not visiting a file") | 4107 | (error "Buffer is not visiting a file") |
| 4098 | (throw 'exit nil)))) | 4108 | (throw 'exit nil)))) |
| 4099 | (true-file (file-truename file)) | 4109 | (true-file (file-truename file)) |
| 4100 | (afile (abbreviate-file-name file)) | 4110 | (afile (abbreviate-file-name file)) |
| 4101 | (present (delq nil (mapcar | 4111 | (present (delq nil (mapcar |
| 4102 | (lambda (x) | 4112 | (lambda (x) |
| 4103 | (equal true-file (file-truename x))) | 4113 | (equal true-file (file-truename x))) |
| 4104 | org-agenda-files)))) | 4114 | org-agenda-files)))) |
| 4105 | (if (not present) | 4115 | (if (not present) |
| 4106 | (progn | 4116 | (progn |
| 4107 | (setq org-agenda-files | 4117 | (setq org-agenda-files |
| 4108 | (cons afile org-agenda-files)) | 4118 | (cons afile org-agenda-files)) |
| 4109 | ;; Make sure custom.el does not end up with Org-mode | 4119 | ;; Make sure custom.el does not end up with Org-mode |
| 4110 | (let ((org-mode-hook nil) (default-major-mode 'fundamental-mode)) | 4120 | (let ((org-mode-hook nil) (default-major-mode 'fundamental-mode)) |
| 4111 | (customize-save-variable 'org-agenda-files org-agenda-files)) | 4121 | (customize-save-variable 'org-agenda-files org-agenda-files)) |
| 4112 | (org-install-agenda-files-menu) | 4122 | (org-install-agenda-files-menu) |
| 4113 | (message "Added file: %s" afile)) | 4123 | (message "Added file: %s" afile)) |
| 4114 | (message "File was already in list: %s" afile))))) | 4124 | (message "File was already in list: %s" afile))))) |
| 4115 | 4125 | ||
| 4116 | (defun org-remove-file (&optional file) | 4126 | (defun org-remove-file (&optional file) |
| 4117 | "Remove current file from the list of files in variable `org-agenda-files'. | 4127 | "Remove current file from the list of files in variable `org-agenda-files'. |
| @@ -4119,20 +4129,20 @@ These are the files which are being checked for agenda entries. | |||
| 4119 | Optional argument FILE means, use this file instead of the current." | 4129 | Optional argument FILE means, use this file instead of the current." |
| 4120 | (interactive) | 4130 | (interactive) |
| 4121 | (let* ((file (or file (buffer-file-name))) | 4131 | (let* ((file (or file (buffer-file-name))) |
| 4122 | (true-file (file-truename file)) | 4132 | (true-file (file-truename file)) |
| 4123 | (afile (abbreviate-file-name file)) | 4133 | (afile (abbreviate-file-name file)) |
| 4124 | (files (delq nil (mapcar | 4134 | (files (delq nil (mapcar |
| 4125 | (lambda (x) | 4135 | (lambda (x) |
| 4126 | (if (equal true-file | 4136 | (if (equal true-file |
| 4127 | (file-truename x)) | 4137 | (file-truename x)) |
| 4128 | nil x)) | 4138 | nil x)) |
| 4129 | org-agenda-files)))) | 4139 | org-agenda-files)))) |
| 4130 | (if (not (= (length files) (length org-agenda-files))) | 4140 | (if (not (= (length files) (length org-agenda-files))) |
| 4131 | (progn | 4141 | (progn |
| 4132 | (setq org-agenda-files files) | 4142 | (setq org-agenda-files files) |
| 4133 | (customize-save-variable 'org-agenda-files org-agenda-files) | 4143 | (customize-save-variable 'org-agenda-files org-agenda-files) |
| 4134 | (org-install-agenda-files-menu) | 4144 | (org-install-agenda-files-menu) |
| 4135 | (message "Removed file: %s" afile)) | 4145 | (message "Removed file: %s" afile)) |
| 4136 | (message "File was not in list: %s" afile)))) | 4146 | (message "File was not in list: %s" afile)))) |
| 4137 | 4147 | ||
| 4138 | (defun org-file-menu-entry (file) | 4148 | (defun org-file-menu-entry (file) |
| @@ -4145,22 +4155,22 @@ not every single day in the range. If FORCE-TODAY is non-nil, make | |||
| 4145 | sure that TODAY is included in the list." | 4155 | sure that TODAY is included in the list." |
| 4146 | (let (dates date day day1 day2 ts1 ts2) | 4156 | (let (dates date day day1 day2 ts1 ts2) |
| 4147 | (if force-today | 4157 | (if force-today |
| 4148 | (setq dates (list (time-to-days (current-time))))) | 4158 | (setq dates (list (time-to-days (current-time))))) |
| 4149 | (save-excursion | 4159 | (save-excursion |
| 4150 | (goto-char beg) | 4160 | (goto-char beg) |
| 4151 | (while (re-search-forward org-ts-regexp end t) | 4161 | (while (re-search-forward org-ts-regexp end t) |
| 4152 | (setq day (time-to-days (org-time-string-to-time | 4162 | (setq day (time-to-days (org-time-string-to-time |
| 4153 | (substring (match-string 1) 0 10)))) | 4163 | (substring (match-string 1) 0 10)))) |
| 4154 | (or (memq day dates) (push day dates))) | 4164 | (or (memq day dates) (push day dates))) |
| 4155 | (unless no-ranges | 4165 | (unless no-ranges |
| 4156 | (goto-char beg) | 4166 | (goto-char beg) |
| 4157 | (while (re-search-forward org-tr-regexp end t) | 4167 | (while (re-search-forward org-tr-regexp end t) |
| 4158 | (setq ts1 (substring (match-string 1) 0 10) | 4168 | (setq ts1 (substring (match-string 1) 0 10) |
| 4159 | ts2 (substring (match-string 2) 0 10) | 4169 | ts2 (substring (match-string 2) 0 10) |
| 4160 | day1 (time-to-days (org-time-string-to-time ts1)) | 4170 | day1 (time-to-days (org-time-string-to-time ts1)) |
| 4161 | day2 (time-to-days (org-time-string-to-time ts2))) | 4171 | day2 (time-to-days (org-time-string-to-time ts2))) |
| 4162 | (while (< (setq day1 (1+ day1)) day2) | 4172 | (while (< (setq day1 (1+ day1)) day2) |
| 4163 | (or (memq day1 dates) (push day1 dates))))) | 4173 | (or (memq day1 dates) (push day1 dates))))) |
| 4164 | (sort dates '<)))) | 4174 | (sort dates '<)))) |
| 4165 | 4175 | ||
| 4166 | ;;;###autoload | 4176 | ;;;###autoload |
| @@ -4172,22 +4182,22 @@ listed in the diary. The function accepts arguments specifying what | |||
| 4172 | items should be listed. The following arguments are allowed: | 4182 | items should be listed. The following arguments are allowed: |
| 4173 | 4183 | ||
| 4174 | :timestamp List the headlines of items containing a date stamp or | 4184 | :timestamp List the headlines of items containing a date stamp or |
| 4175 | date range matching the selected date. Deadlines will | 4185 | date range matching the selected date. Deadlines will |
| 4176 | also be listed, on the expiration day. | 4186 | also be listed, on the expiration day. |
| 4177 | 4187 | ||
| 4178 | :deadline List any deadlines past due, or due within | 4188 | :deadline List any deadlines past due, or due within |
| 4179 | `org-deadline-warning-days'. The listing occurs only | 4189 | `org-deadline-warning-days'. The listing occurs only |
| 4180 | in the diary for *today*, not at any other date. If | 4190 | in the diary for *today*, not at any other date. If |
| 4181 | an entry is marked DONE, it is no longer listed. | 4191 | an entry is marked DONE, it is no longer listed. |
| 4182 | 4192 | ||
| 4183 | :scheduled List all items which are scheduled for the given date. | 4193 | :scheduled List all items which are scheduled for the given date. |
| 4184 | The diary for *today* also contains items which were | 4194 | The diary for *today* also contains items which were |
| 4185 | scheduled earlier and are not yet marked DONE. | 4195 | scheduled earlier and are not yet marked DONE. |
| 4186 | 4196 | ||
| 4187 | :todo List all TODO items from the org-file. This may be a | 4197 | :todo List all TODO items from the org-file. This may be a |
| 4188 | long list - so this is not turned on by default. | 4198 | long list - so this is not turned on by default. |
| 4189 | Like deadlines, these entries only show up in the | 4199 | Like deadlines, these entries only show up in the |
| 4190 | diary for *today*, not at any other date. | 4200 | diary for *today*, not at any other date. |
| 4191 | 4201 | ||
| 4192 | The call in the diary file should look like this: | 4202 | The call in the diary file should look like this: |
| 4193 | 4203 | ||
| @@ -4211,9 +4221,9 @@ function from a program - use `org-agenda-get-day-entries' instead." | |||
| 4211 | (org-compile-prefix-format org-agenda-prefix-format) | 4221 | (org-compile-prefix-format org-agenda-prefix-format) |
| 4212 | (setq args (or args '(:deadline :scheduled :timestamp))) | 4222 | (setq args (or args '(:deadline :scheduled :timestamp))) |
| 4213 | (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) | 4223 | (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) |
| 4214 | (list entry) | 4224 | (list entry) |
| 4215 | org-agenda-files)) | 4225 | org-agenda-files)) |
| 4216 | file rtn results) | 4226 | file rtn results) |
| 4217 | ;; If this is called during org-agenda, don't return any entries to | 4227 | ;; If this is called during org-agenda, don't return any entries to |
| 4218 | ;; the calendar. Org Agenda will list these entries itself. | 4228 | ;; the calendar. Org Agenda will list these entries itself. |
| 4219 | (if org-disable-diary (setq files nil)) | 4229 | (if org-disable-diary (setq files nil)) |
| @@ -4230,53 +4240,53 @@ which kind of entries should be extracted. For details about these, see | |||
| 4230 | the documentation of `org-diary'." | 4240 | the documentation of `org-diary'." |
| 4231 | (setq args (or args '(:deadline :scheduled :timestamp))) | 4241 | (setq args (or args '(:deadline :scheduled :timestamp))) |
| 4232 | (let* ((org-startup-with-deadline-check nil) | 4242 | (let* ((org-startup-with-deadline-check nil) |
| 4233 | (org-startup-folded nil) | 4243 | (org-startup-folded nil) |
| 4234 | (buffer (if (file-exists-p file) | 4244 | (buffer (if (file-exists-p file) |
| 4235 | (org-get-agenda-file-buffer file) | 4245 | (org-get-agenda-file-buffer file) |
| 4236 | (error "No such file %s" file))) | 4246 | (error "No such file %s" file))) |
| 4237 | arg results rtn) | 4247 | arg results rtn) |
| 4238 | (if (not buffer) | 4248 | (if (not buffer) |
| 4239 | ;; If file does not exist, make sure an error message ends up in diary | 4249 | ;; If file does not exist, make sure an error message ends up in diary |
| 4240 | (list (format "ORG-AGENDA-ERROR: No such org-file %s" file)) | 4250 | (list (format "ORG-AGENDA-ERROR: No such org-file %s" file)) |
| 4241 | (with-current-buffer buffer | 4251 | (with-current-buffer buffer |
| 4242 | (unless (eq major-mode 'org-mode) | 4252 | (unless (eq major-mode 'org-mode) |
| 4243 | (error "Agenda file %s is not in `org-mode'" file)) | 4253 | (error "Agenda file %s is not in `org-mode'" file)) |
| 4244 | (let ((case-fold-search nil)) | 4254 | (let ((case-fold-search nil)) |
| 4245 | (save-excursion | 4255 | (save-excursion |
| 4246 | (save-restriction | 4256 | (save-restriction |
| 4247 | (if org-respect-restriction | 4257 | (if org-respect-restriction |
| 4248 | (if (org-region-active-p) | 4258 | (if (org-region-active-p) |
| 4249 | ;; Respect a region to restrict search | 4259 | ;; Respect a region to restrict search |
| 4250 | (narrow-to-region (region-beginning) (region-end))) | 4260 | (narrow-to-region (region-beginning) (region-end))) |
| 4251 | ;; If we work for the calendar or many files, | 4261 | ;; If we work for the calendar or many files, |
| 4252 | ;; get rid of any restriction | 4262 | ;; get rid of any restriction |
| 4253 | (widen)) | 4263 | (widen)) |
| 4254 | ;; The way we repeatedly append to `results' makes it O(n^2) :-( | 4264 | ;; The way we repeatedly append to `results' makes it O(n^2) :-( |
| 4255 | (while (setq arg (pop args)) | 4265 | (while (setq arg (pop args)) |
| 4256 | (cond | 4266 | (cond |
| 4257 | ((and (eq arg :todo) | 4267 | ((and (eq arg :todo) |
| 4258 | (equal date (calendar-current-date))) | 4268 | (equal date (calendar-current-date))) |
| 4259 | (setq rtn (org-agenda-get-todos)) | 4269 | (setq rtn (org-agenda-get-todos)) |
| 4260 | (setq results (append results rtn))) | 4270 | (setq results (append results rtn))) |
| 4261 | ((eq arg :timestamp) | 4271 | ((eq arg :timestamp) |
| 4262 | (setq rtn (org-agenda-get-blocks)) | 4272 | (setq rtn (org-agenda-get-blocks)) |
| 4263 | (setq results (append results rtn)) | 4273 | (setq results (append results rtn)) |
| 4264 | (setq rtn (org-agenda-get-timestamps)) | 4274 | (setq rtn (org-agenda-get-timestamps)) |
| 4265 | (setq results (append results rtn))) | 4275 | (setq results (append results rtn))) |
| 4266 | ((eq arg :scheduled) | 4276 | ((eq arg :scheduled) |
| 4267 | (setq rtn (org-agenda-get-scheduled)) | 4277 | (setq rtn (org-agenda-get-scheduled)) |
| 4268 | (setq results (append results rtn))) | 4278 | (setq results (append results rtn))) |
| 4269 | ((and (eq arg :deadline) | 4279 | ((and (eq arg :deadline) |
| 4270 | (equal date (calendar-current-date))) | 4280 | (equal date (calendar-current-date))) |
| 4271 | (setq rtn (org-agenda-get-deadlines)) | 4281 | (setq rtn (org-agenda-get-deadlines)) |
| 4272 | (setq results (append results rtn)))))))) | 4282 | (setq results (append results rtn)))))))) |
| 4273 | results)))) | 4283 | results)))) |
| 4274 | 4284 | ||
| 4275 | (defun org-entry-is-done-p () | 4285 | (defun org-entry-is-done-p () |
| 4276 | "Is the current entry marked DONE?" | 4286 | "Is the current entry marked DONE?" |
| 4277 | (save-excursion | 4287 | (save-excursion |
| 4278 | (and (re-search-backward "[\r\n]\\*" nil t) | 4288 | (and (re-search-backward "[\r\n]\\*" nil t) |
| 4279 | (looking-at org-nl-done-regexp)))) | 4289 | (looking-at org-nl-done-regexp)))) |
| 4280 | 4290 | ||
| 4281 | (defun org-at-date-range-p () | 4291 | (defun org-at-date-range-p () |
| 4282 | "Is the cursor inside a date range?" | 4292 | "Is the cursor inside a date range?" |
| @@ -4284,273 +4294,273 @@ the documentation of `org-diary'." | |||
| 4284 | (save-excursion | 4294 | (save-excursion |
| 4285 | (catch 'exit | 4295 | (catch 'exit |
| 4286 | (let ((pos (point))) | 4296 | (let ((pos (point))) |
| 4287 | (skip-chars-backward "^<\r\n") | 4297 | (skip-chars-backward "^<\r\n") |
| 4288 | (skip-chars-backward "<") | 4298 | (skip-chars-backward "<") |
| 4289 | (and (looking-at org-tr-regexp) | 4299 | (and (looking-at org-tr-regexp) |
| 4290 | (>= (match-end 0) pos) | 4300 | (>= (match-end 0) pos) |
| 4291 | (throw 'exit t)) | 4301 | (throw 'exit t)) |
| 4292 | (skip-chars-backward "^<\r\n") | 4302 | (skip-chars-backward "^<\r\n") |
| 4293 | (skip-chars-backward "<") | 4303 | (skip-chars-backward "<") |
| 4294 | (and (looking-at org-tr-regexp) | 4304 | (and (looking-at org-tr-regexp) |
| 4295 | (>= (match-end 0) pos) | 4305 | (>= (match-end 0) pos) |
| 4296 | (throw 'exit t))) | 4306 | (throw 'exit t))) |
| 4297 | nil))) | 4307 | nil))) |
| 4298 | 4308 | ||
| 4299 | (defun org-agenda-get-todos () | 4309 | (defun org-agenda-get-todos () |
| 4300 | "Return the TODO information for agenda display." | 4310 | "Return the TODO information for agenda display." |
| 4301 | (let* ((props (list 'face nil | 4311 | (let* ((props (list 'face nil |
| 4302 | 'done-face 'org-done | 4312 | 'done-face 'org-done |
| 4303 | 'mouse-face 'highlight | 4313 | 'mouse-face 'highlight |
| 4304 | 'keymap org-agenda-keymap | 4314 | 'keymap org-agenda-keymap |
| 4305 | 'help-echo | 4315 | 'help-echo |
| 4306 | (format "mouse-2 or RET jump to org file %s" | 4316 | (format "mouse-2 or RET jump to org file %s" |
| 4307 | (abbreviate-file-name (buffer-file-name))))) | 4317 | (abbreviate-file-name (buffer-file-name))))) |
| 4308 | (regexp (concat "[\n\r]\\*+ *\\(" org-not-done-regexp | 4318 | (regexp (concat "[\n\r]\\*+ *\\(" org-not-done-regexp |
| 4309 | "[^\n\r]*\\)")) | 4319 | "[^\n\r]*\\)")) |
| 4310 | marker priority | 4320 | marker priority |
| 4311 | ee txt) | 4321 | ee txt) |
| 4312 | (goto-char (point-min)) | 4322 | (goto-char (point-min)) |
| 4313 | (while (re-search-forward regexp nil t) | 4323 | (while (re-search-forward regexp nil t) |
| 4314 | (goto-char (match-beginning 1)) | 4324 | (goto-char (match-beginning 1)) |
| 4315 | (setq marker (org-agenda-new-marker (point-at-bol)) | 4325 | (setq marker (org-agenda-new-marker (point-at-bol)) |
| 4316 | txt (org-format-agenda-item "" (match-string 1)) | 4326 | txt (org-format-agenda-item "" (match-string 1)) |
| 4317 | priority | 4327 | priority |
| 4318 | (+ (org-get-priority txt) | 4328 | (+ (org-get-priority txt) |
| 4319 | (if org-todo-kwd-priority-p | 4329 | (if org-todo-kwd-priority-p |
| 4320 | (- org-todo-kwd-max-priority -2 | 4330 | (- org-todo-kwd-max-priority -2 |
| 4321 | (length | 4331 | (length |
| 4322 | (member (match-string 2) org-todo-keywords))) | 4332 | (member (match-string 2) org-todo-keywords))) |
| 4323 | 1))) | 4333 | 1))) |
| 4324 | (add-text-properties | 4334 | (add-text-properties |
| 4325 | 0 (length txt) (append (list 'org-marker marker 'org-hd-marker marker | 4335 | 0 (length txt) (append (list 'org-marker marker 'org-hd-marker marker |
| 4326 | 'priority priority) | 4336 | 'priority priority) |
| 4327 | props) | 4337 | props) |
| 4328 | txt) | 4338 | txt) |
| 4329 | (push txt ee) | 4339 | (push txt ee) |
| 4330 | (goto-char (match-end 1))) | 4340 | (goto-char (match-end 1))) |
| 4331 | (nreverse ee))) | 4341 | (nreverse ee))) |
| 4332 | 4342 | ||
| 4333 | (defconst org-agenda-no-heading-message | 4343 | (defconst org-agenda-no-heading-message |
| 4334 | "No heading for this item in buffer or region.") | 4344 | "No heading for this item in buffer or region") |
| 4335 | 4345 | ||
| 4336 | (defun org-agenda-get-timestamps () | 4346 | (defun org-agenda-get-timestamps () |
| 4337 | "Return the date stamp information for agenda display." | 4347 | "Return the date stamp information for agenda display." |
| 4338 | (let* ((props (list 'face nil | 4348 | (let* ((props (list 'face nil |
| 4339 | 'mouse-face 'highlight | 4349 | 'mouse-face 'highlight |
| 4340 | 'keymap org-agenda-keymap | 4350 | 'keymap org-agenda-keymap |
| 4341 | 'help-echo | 4351 | 'help-echo |
| 4342 | (format "mouse-2 or RET jump to org file %s" | 4352 | (format "mouse-2 or RET jump to org file %s" |
| 4343 | (abbreviate-file-name (buffer-file-name))))) | 4353 | (abbreviate-file-name (buffer-file-name))))) |
| 4344 | (regexp (regexp-quote | 4354 | (regexp (regexp-quote |
| 4345 | (substring | 4355 | (substring |
| 4346 | (format-time-string | 4356 | (format-time-string |
| 4347 | (car org-time-stamp-formats) | 4357 | (car org-time-stamp-formats) |
| 4348 | (apply 'encode-time ; DATE bound by calendar | 4358 | (apply 'encode-time ; DATE bound by calendar |
| 4349 | (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) | 4359 | (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) |
| 4350 | 0 11))) | 4360 | 0 11))) |
| 4351 | marker hdmarker deadlinep scheduledp donep tmp priority | 4361 | marker hdmarker deadlinep scheduledp donep tmp priority |
| 4352 | ee txt timestr) | 4362 | ee txt timestr) |
| 4353 | (goto-char (point-min)) | 4363 | (goto-char (point-min)) |
| 4354 | (while (re-search-forward regexp nil t) | 4364 | (while (re-search-forward regexp nil t) |
| 4355 | (if (not (save-match-data (org-at-date-range-p))) | 4365 | (if (not (save-match-data (org-at-date-range-p))) |
| 4356 | (progn | 4366 | (progn |
| 4357 | (setq marker (org-agenda-new-marker (match-beginning 0)) | 4367 | (setq marker (org-agenda-new-marker (match-beginning 0)) |
| 4358 | tmp (buffer-substring (max (point-min) | 4368 | tmp (buffer-substring (max (point-min) |
| 4359 | (- (match-beginning 0) | 4369 | (- (match-beginning 0) |
| 4360 | org-ds-keyword-length)) | 4370 | org-ds-keyword-length)) |
| 4361 | (match-beginning 0)) | 4371 | (match-beginning 0)) |
| 4362 | timestr (buffer-substring (match-beginning 0) (point-at-eol)) | 4372 | timestr (buffer-substring (match-beginning 0) (point-at-eol)) |
| 4363 | deadlinep (string-match org-deadline-regexp tmp) | 4373 | deadlinep (string-match org-deadline-regexp tmp) |
| 4364 | scheduledp (string-match org-scheduled-regexp tmp) | 4374 | scheduledp (string-match org-scheduled-regexp tmp) |
| 4365 | donep (org-entry-is-done-p)) | 4375 | donep (org-entry-is-done-p)) |
| 4366 | (if (string-match ">" timestr) | 4376 | (if (string-match ">" timestr) |
| 4367 | ;; substring should only run to end of time stamp | 4377 | ;; substring should only run to end of time stamp |
| 4368 | (setq timestr (substring timestr 0 (match-end 0)))) | 4378 | (setq timestr (substring timestr 0 (match-end 0)))) |
| 4369 | (save-excursion | 4379 | (save-excursion |
| 4370 | (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) | 4380 | (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) |
| 4371 | (progn | 4381 | (progn |
| 4372 | (goto-char (match-end 1)) | 4382 | (goto-char (match-end 1)) |
| 4373 | (setq hdmarker (org-agenda-new-marker)) | 4383 | (setq hdmarker (org-agenda-new-marker)) |
| 4374 | (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") | 4384 | (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") |
| 4375 | (setq txt (org-format-agenda-item | 4385 | (setq txt (org-format-agenda-item |
| 4376 | (format "%s%s" | 4386 | (format "%s%s" |
| 4377 | (if deadlinep "Deadline: " "") | 4387 | (if deadlinep "Deadline: " "") |
| 4378 | (if scheduledp "Scheduled: " "")) | 4388 | (if scheduledp "Scheduled: " "")) |
| 4379 | (match-string 1) nil timestr))) | 4389 | (match-string 1) nil timestr))) |
| 4380 | (setq txt org-agenda-no-heading-message)) | 4390 | (setq txt org-agenda-no-heading-message)) |
| 4381 | (setq priority (org-get-priority txt)) | 4391 | (setq priority (org-get-priority txt)) |
| 4382 | (add-text-properties | 4392 | (add-text-properties |
| 4383 | 0 (length txt) (append (list 'org-marker marker | 4393 | 0 (length txt) (append (list 'org-marker marker |
| 4384 | 'org-hd-marker hdmarker) props) | 4394 | 'org-hd-marker hdmarker) props) |
| 4385 | txt) | 4395 | txt) |
| 4386 | (if deadlinep | 4396 | (if deadlinep |
| 4387 | (add-text-properties | 4397 | (add-text-properties |
| 4388 | 0 (length txt) | 4398 | 0 (length txt) |
| 4389 | (list 'face | 4399 | (list 'face |
| 4390 | (if donep 'org-done 'org-warning) | 4400 | (if donep 'org-done 'org-warning) |
| 4391 | 'undone-face 'org-warning | 4401 | 'undone-face 'org-warning |
| 4392 | 'done-face 'org-done | 4402 | 'done-face 'org-done |
| 4393 | 'priority (+ 100 priority)) | 4403 | 'priority (+ 100 priority)) |
| 4394 | txt) | 4404 | txt) |
| 4395 | (if scheduledp | 4405 | (if scheduledp |
| 4396 | (add-text-properties | 4406 | (add-text-properties |
| 4397 | 0 (length txt) | 4407 | 0 (length txt) |
| 4398 | (list 'face 'org-scheduled-today | 4408 | (list 'face 'org-scheduled-today |
| 4399 | 'undone-face 'org-scheduled-today | 4409 | 'undone-face 'org-scheduled-today |
| 4400 | 'done-face 'org-done | 4410 | 'done-face 'org-done |
| 4401 | priority (+ 99 priority)) | 4411 | priority (+ 99 priority)) |
| 4402 | txt) | 4412 | txt) |
| 4403 | (add-text-properties | 4413 | (add-text-properties |
| 4404 | 0 (length txt) | 4414 | 0 (length txt) |
| 4405 | (list 'priority priority) txt))) | 4415 | (list 'priority priority) txt))) |
| 4406 | (push txt ee)) | 4416 | (push txt ee)) |
| 4407 | (outline-next-heading)))) | 4417 | (outline-next-heading)))) |
| 4408 | (nreverse ee))) | 4418 | (nreverse ee))) |
| 4409 | 4419 | ||
| 4410 | (defun org-agenda-get-deadlines () | 4420 | (defun org-agenda-get-deadlines () |
| 4411 | "Return the deadline information for agenda display." | 4421 | "Return the deadline information for agenda display." |
| 4412 | (let* ((wdays org-deadline-warning-days) | 4422 | (let* ((wdays org-deadline-warning-days) |
| 4413 | (props (list 'mouse-face 'highlight | 4423 | (props (list 'mouse-face 'highlight |
| 4414 | 'keymap org-agenda-keymap | 4424 | 'keymap org-agenda-keymap |
| 4415 | 'help-echo | 4425 | 'help-echo |
| 4416 | (format "mouse-2 or RET jump to org file %s" | 4426 | (format "mouse-2 or RET jump to org file %s" |
| 4417 | (abbreviate-file-name (buffer-file-name))))) | 4427 | (abbreviate-file-name (buffer-file-name))))) |
| 4418 | (regexp org-deadline-time-regexp) | 4428 | (regexp org-deadline-time-regexp) |
| 4419 | (todayp (equal date (calendar-current-date))) ; DATE bound by calendar | 4429 | (todayp (equal date (calendar-current-date))) ; DATE bound by calendar |
| 4420 | (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar | 4430 | (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar |
| 4421 | d2 diff pos pos1 | 4431 | d2 diff pos pos1 |
| 4422 | ee txt head) | 4432 | ee txt head) |
| 4423 | (goto-char (point-min)) | 4433 | (goto-char (point-min)) |
| 4424 | (while (re-search-forward regexp nil t) | 4434 | (while (re-search-forward regexp nil t) |
| 4425 | (setq pos (1- (match-beginning 1)) | 4435 | (setq pos (1- (match-beginning 1)) |
| 4426 | d2 (time-to-days | 4436 | d2 (time-to-days |
| 4427 | (org-time-string-to-time (match-string 1))) | 4437 | (org-time-string-to-time (match-string 1))) |
| 4428 | diff (- d2 d1)) | 4438 | diff (- d2 d1)) |
| 4429 | ;; When to show a deadline in the calendar: | 4439 | ;; When to show a deadline in the calendar: |
| 4430 | ;; If the expiration is within wdays warning time. | 4440 | ;; If the expiration is within wdays warning time. |
| 4431 | ;; Past-due deadlines are only shown on the current date | 4441 | ;; Past-due deadlines are only shown on the current date |
| 4432 | (if (and (< diff wdays) todayp (not (= diff 0))) | 4442 | (if (and (< diff wdays) todayp (not (= diff 0))) |
| 4433 | (save-excursion | 4443 | (save-excursion |
| 4434 | (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) | 4444 | (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) |
| 4435 | (progn | 4445 | (progn |
| 4436 | (goto-char (match-end 0)) | 4446 | (goto-char (match-end 0)) |
| 4437 | (setq pos1 (match-end 1)) | 4447 | (setq pos1 (match-end 1)) |
| 4438 | (setq head (buffer-substring-no-properties | 4448 | (setq head (buffer-substring-no-properties |
| 4439 | (point) | 4449 | (point) |
| 4440 | (progn (skip-chars-forward "^\r\n") | 4450 | (progn (skip-chars-forward "^\r\n") |
| 4441 | (point)))) | 4451 | (point)))) |
| 4442 | (if (string-match org-looking-at-done-regexp head) | 4452 | (if (string-match org-looking-at-done-regexp head) |
| 4443 | (setq txt nil) | 4453 | (setq txt nil) |
| 4444 | (setq txt (org-format-agenda-item | 4454 | (setq txt (org-format-agenda-item |
| 4445 | (format "In %3d d.: " diff) head)))) | 4455 | (format "In %3d d.: " diff) head)))) |
| 4446 | (setq txt org-agenda-no-heading-message)) | 4456 | (setq txt org-agenda-no-heading-message)) |
| 4447 | (when txt | 4457 | (when txt |
| 4448 | (add-text-properties | 4458 | (add-text-properties |
| 4449 | 0 (length txt) | 4459 | 0 (length txt) |
| 4450 | (append | 4460 | (append |
| 4451 | (list 'org-marker (org-agenda-new-marker pos) | 4461 | (list 'org-marker (org-agenda-new-marker pos) |
| 4452 | 'org-hd-marker (org-agenda-new-marker pos1) | 4462 | 'org-hd-marker (org-agenda-new-marker pos1) |
| 4453 | 'priority (+ (- 10 diff) (org-get-priority txt)) | 4463 | 'priority (+ (- 10 diff) (org-get-priority txt)) |
| 4454 | 'face (cond ((<= diff 0) 'org-warning) | 4464 | 'face (cond ((<= diff 0) 'org-warning) |
| 4455 | ((<= diff 5) 'org-scheduled-previously) | 4465 | ((<= diff 5) 'org-scheduled-previously) |
| 4456 | (t nil)) | 4466 | (t nil)) |
| 4457 | 'undone-face (cond | 4467 | 'undone-face (cond |
| 4458 | ((<= diff 0) 'org-warning) | 4468 | ((<= diff 0) 'org-warning) |
| 4459 | ((<= diff 5) 'org-scheduled-previously) | 4469 | ((<= diff 5) 'org-scheduled-previously) |
| 4460 | (t nil)) | 4470 | (t nil)) |
| 4461 | 'done-face 'org-done) | 4471 | 'done-face 'org-done) |
| 4462 | props) | 4472 | props) |
| 4463 | txt) | 4473 | txt) |
| 4464 | (push txt ee))))) | 4474 | (push txt ee))))) |
| 4465 | ee)) | 4475 | ee)) |
| 4466 | 4476 | ||
| 4467 | (defun org-agenda-get-scheduled () | 4477 | (defun org-agenda-get-scheduled () |
| 4468 | "Return the scheduled information for agenda display." | 4478 | "Return the scheduled information for agenda display." |
| 4469 | (let* ((props (list 'face 'org-scheduled-previously | 4479 | (let* ((props (list 'face 'org-scheduled-previously |
| 4470 | 'undone-face 'org-scheduled-previously | 4480 | 'undone-face 'org-scheduled-previously |
| 4471 | 'done-face 'org-done | 4481 | 'done-face 'org-done |
| 4472 | 'mouse-face 'highlight | 4482 | 'mouse-face 'highlight |
| 4473 | 'keymap org-agenda-keymap | 4483 | 'keymap org-agenda-keymap |
| 4474 | 'help-echo | 4484 | 'help-echo |
| 4475 | (format "mouse-2 or RET jump to org file %s" | 4485 | (format "mouse-2 or RET jump to org file %s" |
| 4476 | (abbreviate-file-name (buffer-file-name))))) | 4486 | (abbreviate-file-name (buffer-file-name))))) |
| 4477 | (regexp org-scheduled-time-regexp) | 4487 | (regexp org-scheduled-time-regexp) |
| 4478 | (todayp (equal date (calendar-current-date))) ; DATE bound by calendar | 4488 | (todayp (equal date (calendar-current-date))) ; DATE bound by calendar |
| 4479 | (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar | 4489 | (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar |
| 4480 | d2 diff pos pos1 | 4490 | d2 diff pos pos1 |
| 4481 | ee txt head) | 4491 | ee txt head) |
| 4482 | (goto-char (point-min)) | 4492 | (goto-char (point-min)) |
| 4483 | (while (re-search-forward regexp nil t) | 4493 | (while (re-search-forward regexp nil t) |
| 4484 | (setq pos (1- (match-beginning 1)) | 4494 | (setq pos (1- (match-beginning 1)) |
| 4485 | d2 (time-to-days | 4495 | d2 (time-to-days |
| 4486 | (org-time-string-to-time (match-string 1))) | 4496 | (org-time-string-to-time (match-string 1))) |
| 4487 | diff (- d2 d1)) | 4497 | diff (- d2 d1)) |
| 4488 | ;; When to show a scheduled item in the calendar: | 4498 | ;; When to show a scheduled item in the calendar: |
| 4489 | ;; If it is on or past the date. | 4499 | ;; If it is on or past the date. |
| 4490 | (if (and (< diff 0) todayp) | 4500 | (if (and (< diff 0) todayp) |
| 4491 | (save-excursion | 4501 | (save-excursion |
| 4492 | (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) | 4502 | (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) |
| 4493 | (progn | 4503 | (progn |
| 4494 | (goto-char (match-end 0)) | 4504 | (goto-char (match-end 0)) |
| 4495 | (setq pos1 (match-end 1)) | 4505 | (setq pos1 (match-end 1)) |
| 4496 | (setq head (buffer-substring-no-properties | 4506 | (setq head (buffer-substring-no-properties |
| 4497 | (point) | 4507 | (point) |
| 4498 | (progn (skip-chars-forward "^\r\n") (point)))) | 4508 | (progn (skip-chars-forward "^\r\n") (point)))) |
| 4499 | (if (string-match org-looking-at-done-regexp head) | 4509 | (if (string-match org-looking-at-done-regexp head) |
| 4500 | (setq txt nil) | 4510 | (setq txt nil) |
| 4501 | (setq txt (org-format-agenda-item | 4511 | (setq txt (org-format-agenda-item |
| 4502 | (format "Sched.%2dx: " (- 1 diff)) head)))) | 4512 | (format "Sched.%2dx: " (- 1 diff)) head)))) |
| 4503 | (setq txt org-agenda-no-heading-message)) | 4513 | (setq txt org-agenda-no-heading-message)) |
| 4504 | (when txt | 4514 | (when txt |
| 4505 | (add-text-properties | 4515 | (add-text-properties |
| 4506 | 0 (length txt) | 4516 | 0 (length txt) |
| 4507 | (append (list 'org-marker (org-agenda-new-marker pos) | 4517 | (append (list 'org-marker (org-agenda-new-marker pos) |
| 4508 | 'org-hd-marker (org-agenda-new-marker pos1) | 4518 | 'org-hd-marker (org-agenda-new-marker pos1) |
| 4509 | 'priority (+ (- 5 diff) (org-get-priority txt))) | 4519 | 'priority (+ (- 5 diff) (org-get-priority txt))) |
| 4510 | props) txt) | 4520 | props) txt) |
| 4511 | (push txt ee))))) | 4521 | (push txt ee))))) |
| 4512 | ee)) | 4522 | ee)) |
| 4513 | 4523 | ||
| 4514 | (defun org-agenda-get-blocks () | 4524 | (defun org-agenda-get-blocks () |
| 4515 | "Return the date-range information for agenda display." | 4525 | "Return the date-range information for agenda display." |
| 4516 | (let* ((props (list 'face nil | 4526 | (let* ((props (list 'face nil |
| 4517 | 'mouse-face 'highlight | 4527 | 'mouse-face 'highlight |
| 4518 | 'keymap org-agenda-keymap | 4528 | 'keymap org-agenda-keymap |
| 4519 | 'help-echo | 4529 | 'help-echo |
| 4520 | (format "mouse-2 or RET jump to org file %s" | 4530 | (format "mouse-2 or RET jump to org file %s" |
| 4521 | (abbreviate-file-name (buffer-file-name))))) | 4531 | (abbreviate-file-name (buffer-file-name))))) |
| 4522 | (regexp org-tr-regexp) | 4532 | (regexp org-tr-regexp) |
| 4523 | (d0 (calendar-absolute-from-gregorian date)) | 4533 | (d0 (calendar-absolute-from-gregorian date)) |
| 4524 | marker hdmarker ee txt d1 d2 s1 s2 timestr) | 4534 | marker hdmarker ee txt d1 d2 s1 s2 timestr) |
| 4525 | (goto-char (point-min)) | 4535 | (goto-char (point-min)) |
| 4526 | (while (re-search-forward regexp nil t) | 4536 | (while (re-search-forward regexp nil t) |
| 4527 | (setq timestr (match-string 0) | 4537 | (setq timestr (match-string 0) |
| 4528 | s1 (match-string 1) | 4538 | s1 (match-string 1) |
| 4529 | s2 (match-string 2) | 4539 | s2 (match-string 2) |
| 4530 | d1 (time-to-days (org-time-string-to-time s1)) | 4540 | d1 (time-to-days (org-time-string-to-time s1)) |
| 4531 | d2 (time-to-days (org-time-string-to-time s2))) | 4541 | d2 (time-to-days (org-time-string-to-time s2))) |
| 4532 | (if (and (> (- d0 d1) -1) (> (- d2 d0) -1)) | 4542 | (if (and (> (- d0 d1) -1) (> (- d2 d0) -1)) |
| 4533 | ;; Only allow days between the limits, because the normal | 4543 | ;; Only allow days between the limits, because the normal |
| 4534 | ;; date stamps will catch the limits. | 4544 | ;; date stamps will catch the limits. |
| 4535 | (save-excursion | 4545 | (save-excursion |
| 4536 | (setq marker (org-agenda-new-marker (point))) | 4546 | (setq marker (org-agenda-new-marker (point))) |
| 4537 | (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) | 4547 | (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) |
| 4538 | (progn | 4548 | (progn |
| 4539 | (setq hdmarker (org-agenda-new-marker (match-end 1))) | 4549 | (setq hdmarker (org-agenda-new-marker (match-end 1))) |
| 4540 | (goto-char (match-end 1)) | 4550 | (goto-char (match-end 1)) |
| 4541 | (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") | 4551 | (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") |
| 4542 | (setq txt (org-format-agenda-item | 4552 | (setq txt (org-format-agenda-item |
| 4543 | (format (if (= d1 d2) "" "(%d/%d): ") | 4553 | (format (if (= d1 d2) "" "(%d/%d): ") |
| 4544 | (1+ (- d0 d1)) (1+ (- d2 d1))) | 4554 | (1+ (- d0 d1)) (1+ (- d2 d1))) |
| 4545 | (match-string 1) nil (if (= d0 d1) timestr)))) | 4555 | (match-string 1) nil (if (= d0 d1) timestr)))) |
| 4546 | (setq txt org-agenda-no-heading-message)) | 4556 | (setq txt org-agenda-no-heading-message)) |
| 4547 | (add-text-properties | 4557 | (add-text-properties |
| 4548 | 0 (length txt) (append (list 'org-marker marker | 4558 | 0 (length txt) (append (list 'org-marker marker |
| 4549 | 'org-hd-marker hdmarker | 4559 | 'org-hd-marker hdmarker |
| 4550 | 'priority (org-get-priority txt)) | 4560 | 'priority (org-get-priority txt)) |
| 4551 | props) | 4561 | props) |
| 4552 | txt) | 4562 | txt) |
| 4553 | (push txt ee))) | 4563 | (push txt ee))) |
| 4554 | (outline-next-heading)) | 4564 | (outline-next-heading)) |
| 4555 | ;; Sort the entries by expiration date. | 4565 | ;; Sort the entries by expiration date. |
| 4556 | (nreverse ee))) | 4566 | (nreverse ee))) |
| @@ -4605,87 +4615,87 @@ only the correctly processes TXT should be returned - this is used by | |||
| 4605 | ;; Diary entries sometimes have extra whitespace at the beginning | 4615 | ;; Diary entries sometimes have extra whitespace at the beginning |
| 4606 | (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt))) | 4616 | (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt))) |
| 4607 | (let* ((category (or category | 4617 | (let* ((category (or category |
| 4608 | org-category | 4618 | org-category |
| 4609 | (if (buffer-file-name) | 4619 | (if (buffer-file-name) |
| 4610 | (file-name-sans-extension | 4620 | (file-name-sans-extension |
| 4611 | (file-name-nondirectory (buffer-file-name))) | 4621 | (file-name-nondirectory (buffer-file-name))) |
| 4612 | ""))) | 4622 | ""))) |
| 4613 | time ;; needed for the eval of the prefix format | 4623 | time ;; needed for the eval of the prefix format |
| 4614 | (ts (if dotime (concat (if (stringp dotime) dotime "") txt))) | 4624 | (ts (if dotime (concat (if (stringp dotime) dotime "") txt))) |
| 4615 | (time-of-day (and dotime (org-get-time-of-day ts))) | 4625 | (time-of-day (and dotime (org-get-time-of-day ts))) |
| 4616 | stamp plain s0 s1 s2 rtn) | 4626 | stamp plain s0 s1 s2 rtn) |
| 4617 | (when (and dotime time-of-day org-prefix-has-time) | 4627 | (when (and dotime time-of-day org-prefix-has-time) |
| 4618 | ;; Extract starting and ending time and move them to prefix | 4628 | ;; Extract starting and ending time and move them to prefix |
| 4619 | (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) | 4629 | (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) |
| 4620 | (setq plain (string-match org-plain-time-of-day-regexp ts))) | 4630 | (setq plain (string-match org-plain-time-of-day-regexp ts))) |
| 4621 | (setq s0 (match-string 0 ts) | 4631 | (setq s0 (match-string 0 ts) |
| 4622 | s1 (match-string (if plain 1 2) ts) | 4632 | s1 (match-string (if plain 1 2) ts) |
| 4623 | s2 (match-string (if plain 8 4) ts)) | 4633 | s2 (match-string (if plain 8 4) ts)) |
| 4624 | 4634 | ||
| 4625 | ;; If the times are in TXT (not in DOTIMES), and the prefix will list | 4635 | ;; If the times are in TXT (not in DOTIMES), and the prefix will list |
| 4626 | ;; them, we might want to remove them there to avoid duplication. | 4636 | ;; them, we might want to remove them there to avoid duplication. |
| 4627 | ;; The user can turn this off with a variable. | 4637 | ;; The user can turn this off with a variable. |
| 4628 | (if (and org-agenda-remove-times-when-in-prefix (or stamp plain) | 4638 | (if (and org-agenda-remove-times-when-in-prefix (or stamp plain) |
| 4629 | (string-match (concat (regexp-quote s0) " *") txt) | 4639 | (string-match (concat (regexp-quote s0) " *") txt) |
| 4630 | (if (eq org-agenda-remove-times-when-in-prefix 'beg) | 4640 | (if (eq org-agenda-remove-times-when-in-prefix 'beg) |
| 4631 | (= (match-beginning 0) 0) | 4641 | (= (match-beginning 0) 0) |
| 4632 | t)) | 4642 | t)) |
| 4633 | (setq txt (replace-match "" nil nil txt)))) | 4643 | (setq txt (replace-match "" nil nil txt)))) |
| 4634 | ;; Normalize the time(s) to 24 hour | 4644 | ;; Normalize the time(s) to 24 hour |
| 4635 | (if s1 (setq s1 (org-get-time-of-day s1 'string))) | 4645 | (if s1 (setq s1 (org-get-time-of-day s1 'string))) |
| 4636 | (if s2 (setq s2 (org-get-time-of-day s2 'string)))) | 4646 | (if s2 (setq s2 (org-get-time-of-day s2 'string)))) |
| 4637 | 4647 | ||
| 4638 | ;; Create the final string | 4648 | ;; Create the final string |
| 4639 | (if noprefix | 4649 | (if noprefix |
| 4640 | (setq rtn txt) | 4650 | (setq rtn txt) |
| 4641 | ;; Prepare the variables needed in the eval of the compiled format | 4651 | ;; Prepare the variables needed in the eval of the compiled format |
| 4642 | (setq time (cond (s2 (concat s1 "-" s2)) | 4652 | (setq time (cond (s2 (concat s1 "-" s2)) |
| 4643 | (s1 (concat s1 "......")) | 4653 | (s1 (concat s1 "......")) |
| 4644 | (t "")) | 4654 | (t "")) |
| 4645 | extra (or extra "") | 4655 | extra (or extra "") |
| 4646 | category (if (symbolp category) (symbol-name category) category)) | 4656 | category (if (symbolp category) (symbol-name category) category)) |
| 4647 | ;; Evaluate the compiled format | 4657 | ;; Evaluate the compiled format |
| 4648 | (setq rtn (concat (eval org-prefix-format-compiled) txt))) | 4658 | (setq rtn (concat (eval org-prefix-format-compiled) txt))) |
| 4649 | 4659 | ||
| 4650 | ;; And finally add the text properties | 4660 | ;; And finally add the text properties |
| 4651 | (add-text-properties | 4661 | (add-text-properties |
| 4652 | 0 (length rtn) (list 'category (downcase category) | 4662 | 0 (length rtn) (list 'category (downcase category) |
| 4653 | 'prefix-length (- (length rtn) (length txt)) | 4663 | 'prefix-length (- (length rtn) (length txt)) |
| 4654 | 'time-of-day time-of-day | 4664 | 'time-of-day time-of-day |
| 4655 | 'dotime dotime) | 4665 | 'dotime dotime) |
| 4656 | rtn) | 4666 | rtn) |
| 4657 | rtn))) | 4667 | rtn))) |
| 4658 | 4668 | ||
| 4659 | (defun org-agenda-add-time-grid-maybe (list ndays todayp) | 4669 | (defun org-agenda-add-time-grid-maybe (list ndays todayp) |
| 4660 | (catch 'exit | 4670 | (catch 'exit |
| 4661 | (cond ((not org-agenda-use-time-grid) (throw 'exit list)) | 4671 | (cond ((not org-agenda-use-time-grid) (throw 'exit list)) |
| 4662 | ((and todayp (member 'today (car org-agenda-time-grid)))) | 4672 | ((and todayp (member 'today (car org-agenda-time-grid)))) |
| 4663 | ((and (= ndays 1) (member 'daily (car org-agenda-time-grid)))) | 4673 | ((and (= ndays 1) (member 'daily (car org-agenda-time-grid)))) |
| 4664 | ((member 'weekly (car org-agenda-time-grid))) | 4674 | ((member 'weekly (car org-agenda-time-grid))) |
| 4665 | (t (throw 'exit list))) | 4675 | (t (throw 'exit list))) |
| 4666 | (let* ((have (delq nil (mapcar | 4676 | (let* ((have (delq nil (mapcar |
| 4667 | (lambda (x) (get-text-property 1 'time-of-day x)) | 4677 | (lambda (x) (get-text-property 1 'time-of-day x)) |
| 4668 | list))) | 4678 | list))) |
| 4669 | (string (nth 1 org-agenda-time-grid)) | 4679 | (string (nth 1 org-agenda-time-grid)) |
| 4670 | (gridtimes (nth 2 org-agenda-time-grid)) | 4680 | (gridtimes (nth 2 org-agenda-time-grid)) |
| 4671 | (req (car org-agenda-time-grid)) | 4681 | (req (car org-agenda-time-grid)) |
| 4672 | (remove (member 'remove-match req)) | 4682 | (remove (member 'remove-match req)) |
| 4673 | new time) | 4683 | new time) |
| 4674 | (if (and (member 'require-timed req) (not have)) | 4684 | (if (and (member 'require-timed req) (not have)) |
| 4675 | ;; don't show empty grid | 4685 | ;; don't show empty grid |
| 4676 | (throw 'exit list)) | 4686 | (throw 'exit list)) |
| 4677 | (while (setq time (pop gridtimes)) | 4687 | (while (setq time (pop gridtimes)) |
| 4678 | (unless (and remove (member time have)) | 4688 | (unless (and remove (member time have)) |
| 4679 | (setq time (int-to-string time)) | 4689 | (setq time (int-to-string time)) |
| 4680 | (push (org-format-agenda-item | 4690 | (push (org-format-agenda-item |
| 4681 | nil string "" ;; FIXME: put a category? | 4691 | nil string "" ;; FIXME: put a category? |
| 4682 | (concat (substring time 0 -2) ":" (substring time -2))) | 4692 | (concat (substring time 0 -2) ":" (substring time -2))) |
| 4683 | new) | 4693 | new) |
| 4684 | (put-text-property | 4694 | (put-text-property |
| 4685 | 1 (length (car new)) 'face 'org-time-grid (car new)))) | 4695 | 1 (length (car new)) 'face 'org-time-grid (car new)))) |
| 4686 | (if (member 'time-up org-agenda-sorting-strategy) | 4696 | (if (member 'time-up org-agenda-sorting-strategy) |
| 4687 | (append new list) | 4697 | (append new list) |
| 4688 | (append list new))))) | 4698 | (append list new))))) |
| 4689 | 4699 | ||
| 4690 | (defun org-compile-prefix-format (format) | 4700 | (defun org-compile-prefix-format (format) |
| 4691 | "Compile the prefix format into a Lisp form that can be evaluated. | 4701 | "Compile the prefix format into a Lisp form that can be evaluated. |
| @@ -4694,20 +4704,20 @@ The resulting form is returned and stored in the variable | |||
| 4694 | (setq org-prefix-has-time nil) | 4704 | (setq org-prefix-has-time nil) |
| 4695 | (let ((start 0) varform vars var (s format) c f opt) | 4705 | (let ((start 0) varform vars var (s format) c f opt) |
| 4696 | (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cts]\\)" | 4706 | (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cts]\\)" |
| 4697 | s start) | 4707 | s start) |
| 4698 | (setq var (cdr (assoc (match-string 4 s) | 4708 | (setq var (cdr (assoc (match-string 4 s) |
| 4699 | '(("c" . category) ("t" . time) ("s" . extra)))) | 4709 | '(("c" . category) ("t" . time) ("s" . extra)))) |
| 4700 | c (or (match-string 3 s) "") | 4710 | c (or (match-string 3 s) "") |
| 4701 | opt (match-beginning 1) | 4711 | opt (match-beginning 1) |
| 4702 | start (1+ (match-beginning 0))) | 4712 | start (1+ (match-beginning 0))) |
| 4703 | (if (equal var 'time) (setq org-prefix-has-time t)) | 4713 | (if (equal var 'time) (setq org-prefix-has-time t)) |
| 4704 | (setq f (concat "%" (match-string 2 s) "s")) | 4714 | (setq f (concat "%" (match-string 2 s) "s")) |
| 4705 | (if opt | 4715 | (if opt |
| 4706 | (setq varform | 4716 | (setq varform |
| 4707 | `(if (equal "" ,var) | 4717 | `(if (equal "" ,var) |
| 4708 | "" | 4718 | "" |
| 4709 | (format ,f (if (equal "" ,var) "" (concat ,var ,c))))) | 4719 | (format ,f (if (equal "" ,var) "" (concat ,var ,c))))) |
| 4710 | (setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c))))) | 4720 | (setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c))))) |
| 4711 | (setq s (replace-match "%s" t nil s)) | 4721 | (setq s (replace-match "%s" t nil s)) |
| 4712 | (push varform vars)) | 4722 | (push varform vars)) |
| 4713 | (setq vars (nreverse vars)) | 4723 | (setq vars (nreverse vars)) |
| @@ -4727,14 +4737,14 @@ HH:MM." | |||
| 4727 | (string-match | 4737 | (string-match |
| 4728 | "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s)) | 4738 | "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s)) |
| 4729 | (let* ((t0 (+ (* 100 | 4739 | (let* ((t0 (+ (* 100 |
| 4730 | (+ (string-to-number (match-string 1 s)) | 4740 | (+ (string-to-number (match-string 1 s)) |
| 4731 | (if (and (match-beginning 4) | 4741 | (if (and (match-beginning 4) |
| 4732 | (equal (downcase (match-string 4 s)) "pm")) | 4742 | (equal (downcase (match-string 4 s)) "pm")) |
| 4733 | 12 0))) | 4743 | 12 0))) |
| 4734 | (if (match-beginning 3) | 4744 | (if (match-beginning 3) |
| 4735 | (string-to-number (match-string 3 s)) | 4745 | (string-to-number (match-string 3 s)) |
| 4736 | 0))) | 4746 | 0))) |
| 4737 | (t1 (concat " " (int-to-string t0)))) | 4747 | (t1 (concat " " (int-to-string t0)))) |
| 4738 | (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0))))) | 4748 | (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0))))) |
| 4739 | 4749 | ||
| 4740 | (defun org-finalize-agenda-entries (list) | 4750 | (defun org-finalize-agenda-entries (list) |
| @@ -4742,43 +4752,43 @@ HH:MM." | |||
| 4742 | (mapconcat 'identity (sort list 'org-entries-lessp) "\n")) | 4752 | (mapconcat 'identity (sort list 'org-entries-lessp) "\n")) |
| 4743 | 4753 | ||
| 4744 | (defsubst org-cmp-priority (a b) | 4754 | (defsubst org-cmp-priority (a b) |
| 4745 | "Compare the priorities of strings A and B." | 4755 | "Compare the priorities of string a and b." |
| 4746 | (let ((pa (or (get-text-property 1 'priority a) 0)) | 4756 | (let ((pa (or (get-text-property 1 'priority a) 0)) |
| 4747 | (pb (or (get-text-property 1 'priority b) 0))) | 4757 | (pb (or (get-text-property 1 'priority b) 0))) |
| 4748 | (cond ((> pa pb) +1) | 4758 | (cond ((> pa pb) +1) |
| 4749 | ((< pa pb) -1) | 4759 | ((< pa pb) -1) |
| 4750 | (t nil)))) | 4760 | (t nil)))) |
| 4751 | 4761 | ||
| 4752 | (defsubst org-cmp-category (a b) | 4762 | (defsubst org-cmp-category (a b) |
| 4753 | "Compare the string values of categories of strings A and B." | 4763 | "Compare the string values of categories of strings a and b." |
| 4754 | (let ((ca (or (get-text-property 1 'category a) "")) | 4764 | (let ((ca (or (get-text-property 1 'category a) "")) |
| 4755 | (cb (or (get-text-property 1 'category b) ""))) | 4765 | (cb (or (get-text-property 1 'category b) ""))) |
| 4756 | (cond ((string-lessp ca cb) -1) | 4766 | (cond ((string-lessp ca cb) -1) |
| 4757 | ((string-lessp cb ca) +1) | 4767 | ((string-lessp cb ca) +1) |
| 4758 | (t nil)))) | 4768 | (t nil)))) |
| 4759 | 4769 | ||
| 4760 | (defsubst org-cmp-time (a b) | 4770 | (defsubst org-cmp-time (a b) |
| 4761 | "Compare the time-of-day values of strings A and B." | 4771 | "Compare the time-of-day values of strings a and b." |
| 4762 | (let* ((def (if org-sort-agenda-notime-is-late 2401 -1)) | 4772 | (let* ((def (if org-sort-agenda-notime-is-late 2401 -1)) |
| 4763 | (ta (or (get-text-property 1 'time-of-day a) def)) | 4773 | (ta (or (get-text-property 1 'time-of-day a) def)) |
| 4764 | (tb (or (get-text-property 1 'time-of-day b) def))) | 4774 | (tb (or (get-text-property 1 'time-of-day b) def))) |
| 4765 | (cond ((< ta tb) -1) | 4775 | (cond ((< ta tb) -1) |
| 4766 | ((< tb ta) +1) | 4776 | ((< tb ta) +1) |
| 4767 | (t nil)))) | 4777 | (t nil)))) |
| 4768 | 4778 | ||
| 4769 | (defun org-entries-lessp (a b) | 4779 | (defun org-entries-lessp (a b) |
| 4770 | "Predicate for sorting agenda entries." | 4780 | "Predicate for sorting agenda entries." |
| 4771 | ;; The following variables will be used when the form is evaluated. | 4781 | ;; The following variables will be used when the form is evaluated. |
| 4772 | (let* ((time-up (org-cmp-time a b)) | 4782 | (let* ((time-up (org-cmp-time a b)) |
| 4773 | (time-down (if time-up (- time-up) nil)) | 4783 | (time-down (if time-up (- time-up) nil)) |
| 4774 | (priority-up (org-cmp-priority a b)) | 4784 | (priority-up (org-cmp-priority a b)) |
| 4775 | (priority-down (if priority-up (- priority-up) nil)) | 4785 | (priority-down (if priority-up (- priority-up) nil)) |
| 4776 | (category-up (org-cmp-category a b)) | 4786 | (category-up (org-cmp-category a b)) |
| 4777 | (category-down (if category-up (- category-up) nil)) | 4787 | (category-down (if category-up (- category-up) nil)) |
| 4778 | (category-keep (if category-up +1 nil))) ; FIXME +1 or -1? | 4788 | (category-keep (if category-up +1 nil))) ; FIXME +1 or -1? |
| 4779 | (cdr (assoc | 4789 | (cdr (assoc |
| 4780 | (eval (cons 'or org-agenda-sorting-strategy)) | 4790 | (eval (cons 'or org-agenda-sorting-strategy)) |
| 4781 | '((-1 . t) (1 . nil) (nil . nil)))))) | 4791 | '((-1 . t) (1 . nil) (nil . nil)))))) |
| 4782 | 4792 | ||
| 4783 | (defun org-agenda-show-priority () | 4793 | (defun org-agenda-show-priority () |
| 4784 | "Show the priority of the current item. | 4794 | "Show the priority of the current item. |
| @@ -4792,26 +4802,26 @@ and by additional input from the age of a schedules or deadline entry." | |||
| 4792 | "Go to the Org-mode file which contains the item at point." | 4802 | "Go to the Org-mode file which contains the item at point." |
| 4793 | (interactive) | 4803 | (interactive) |
| 4794 | (let* ((marker (or (get-text-property (point) 'org-marker) | 4804 | (let* ((marker (or (get-text-property (point) 'org-marker) |
| 4795 | (org-agenda-error))) | 4805 | (org-agenda-error))) |
| 4796 | (buffer (marker-buffer marker)) | 4806 | (buffer (marker-buffer marker)) |
| 4797 | (pos (marker-position marker))) | 4807 | (pos (marker-position marker))) |
| 4798 | (switch-to-buffer-other-window buffer) | 4808 | (switch-to-buffer-other-window buffer) |
| 4799 | (widen) | 4809 | (widen) |
| 4800 | (goto-char pos) | 4810 | (goto-char pos) |
| 4801 | (when (eq major-mode 'org-mode) | 4811 | (when (eq major-mode 'org-mode) |
| 4802 | (org-show-hidden-entry) | 4812 | (org-show-hidden-entry) |
| 4803 | (save-excursion | 4813 | (save-excursion |
| 4804 | (and (outline-next-heading) | 4814 | (and (outline-next-heading) |
| 4805 | (org-flag-heading nil)))) ; show the next heading | 4815 | (org-flag-heading nil)))) ; show the next heading |
| 4806 | (and highlight (org-highlight (point-at-bol) (point-at-eol))))) | 4816 | (and highlight (org-highlight (point-at-bol) (point-at-eol))))) |
| 4807 | 4817 | ||
| 4808 | (defun org-agenda-switch-to () | 4818 | (defun org-agenda-switch-to () |
| 4809 | "Go to the Org-mode file which contains the item at point." | 4819 | "Go to the Org-mode file which contains the item at point." |
| 4810 | (interactive) | 4820 | (interactive) |
| 4811 | (let* ((marker (or (get-text-property (point) 'org-marker) | 4821 | (let* ((marker (or (get-text-property (point) 'org-marker) |
| 4812 | (org-agenda-error))) | 4822 | (org-agenda-error))) |
| 4813 | (buffer (marker-buffer marker)) | 4823 | (buffer (marker-buffer marker)) |
| 4814 | (pos (marker-position marker))) | 4824 | (pos (marker-position marker))) |
| 4815 | (switch-to-buffer buffer) | 4825 | (switch-to-buffer buffer) |
| 4816 | (delete-other-windows) | 4826 | (delete-other-windows) |
| 4817 | (widen) | 4827 | (widen) |
| @@ -4819,8 +4829,8 @@ and by additional input from the age of a schedules or deadline entry." | |||
| 4819 | (when (eq major-mode 'org-mode) | 4829 | (when (eq major-mode 'org-mode) |
| 4820 | (org-show-hidden-entry) | 4830 | (org-show-hidden-entry) |
| 4821 | (save-excursion | 4831 | (save-excursion |
| 4822 | (and (outline-next-heading) | 4832 | (and (outline-next-heading) |
| 4823 | (org-flag-heading nil)))))) ; show the next heading | 4833 | (org-flag-heading nil)))))) ; show the next heading |
| 4824 | 4834 | ||
| 4825 | (defun org-agenda-goto-mouse (ev) | 4835 | (defun org-agenda-goto-mouse (ev) |
| 4826 | "Go to the Org-mode file which contains the item at the mouse click." | 4836 | "Go to the Org-mode file which contains the item at the mouse click." |
| @@ -4868,33 +4878,33 @@ the same tree node, and the headline of the tree node in the Org-mode file." | |||
| 4868 | (interactive) | 4878 | (interactive) |
| 4869 | (org-agenda-check-no-diary) | 4879 | (org-agenda-check-no-diary) |
| 4870 | (let* ((col (current-column)) | 4880 | (let* ((col (current-column)) |
| 4871 | (marker (or (get-text-property (point) 'org-marker) | 4881 | (marker (or (get-text-property (point) 'org-marker) |
| 4872 | (org-agenda-error))) | 4882 | (org-agenda-error))) |
| 4873 | (buffer (marker-buffer marker)) | 4883 | (buffer (marker-buffer marker)) |
| 4874 | (pos (marker-position marker)) | 4884 | (pos (marker-position marker)) |
| 4875 | (hdmarker (get-text-property (point) 'org-hd-marker)) | 4885 | (hdmarker (get-text-property (point) 'org-hd-marker)) |
| 4876 | (buffer-read-only nil) | 4886 | (buffer-read-only nil) |
| 4877 | newhead) | 4887 | newhead) |
| 4878 | (with-current-buffer buffer | 4888 | (with-current-buffer buffer |
| 4879 | (widen) | 4889 | (widen) |
| 4880 | (goto-char pos) | 4890 | (goto-char pos) |
| 4881 | (org-show-hidden-entry) | 4891 | (org-show-hidden-entry) |
| 4882 | (save-excursion | 4892 | (save-excursion |
| 4883 | (and (outline-next-heading) | 4893 | (and (outline-next-heading) |
| 4884 | (org-flag-heading nil))) ; show the next heading | 4894 | (org-flag-heading nil))) ; show the next heading |
| 4885 | (org-todo) | 4895 | (org-todo) |
| 4886 | (forward-char 1) | 4896 | (forward-char 1) |
| 4887 | (setq newhead (org-get-heading)) | 4897 | (setq newhead (org-get-heading)) |
| 4888 | (save-excursion | 4898 | (save-excursion |
| 4889 | (org-back-to-heading) | 4899 | (org-back-to-heading) |
| 4890 | (move-marker org-last-heading-marker (point)))) | 4900 | (move-marker org-last-heading-marker (point)))) |
| 4891 | (beginning-of-line 1) | 4901 | (beginning-of-line 1) |
| 4892 | (save-excursion | 4902 | (save-excursion |
| 4893 | (org-agenda-change-all-lines newhead hdmarker 'fixface)) | 4903 | (org-agenda-change-all-lines newhead hdmarker 'fixface)) |
| 4894 | (move-to-column col))) | 4904 | (move-to-column col))) |
| 4895 | 4905 | ||
| 4896 | (defun org-agenda-change-all-lines (newhead hdmarker &optional fixface) | 4906 | (defun org-agenda-change-all-lines (newhead hdmarker &optional fixface) |
| 4897 | "Change all lines in the agenda buffer which match HDMARKER. | 4907 | "Change all lines in the agenda buffer which match hdmarker. |
| 4898 | The new content of the line will be NEWHEAD (as modified by | 4908 | The new content of the line will be NEWHEAD (as modified by |
| 4899 | `org-format-agenda-item'). HDMARKER is checked with | 4909 | `org-format-agenda-item'). HDMARKER is checked with |
| 4900 | `equal' against all `org-hd-marker' text properties in the file. | 4910 | `equal' against all `org-hd-marker' text properties in the file. |
| @@ -4906,30 +4916,30 @@ the new TODO state." | |||
| 4906 | (goto-char (point-max)) | 4916 | (goto-char (point-max)) |
| 4907 | (beginning-of-line 1) | 4917 | (beginning-of-line 1) |
| 4908 | (while (not finish) | 4918 | (while (not finish) |
| 4909 | (setq finish (bobp)) | 4919 | (setq finish (bobp)) |
| 4910 | (when (and (setq m (get-text-property (point) 'org-hd-marker)) | 4920 | (when (and (setq m (get-text-property (point) 'org-hd-marker)) |
| 4911 | (equal m hdmarker)) | 4921 | (equal m hdmarker)) |
| 4912 | (setq props (text-properties-at (point)) | 4922 | (setq props (text-properties-at (point)) |
| 4913 | dotime (get-text-property (point) 'dotime) | 4923 | dotime (get-text-property (point) 'dotime) |
| 4914 | new (org-format-agenda-item "x" newhead "x" dotime 'noprefix) | 4924 | new (org-format-agenda-item "x" newhead "x" dotime 'noprefix) |
| 4915 | pl (get-text-property (point) 'prefix-length) | 4925 | pl (get-text-property (point) 'prefix-length) |
| 4916 | undone-face (get-text-property (point) 'undone-face) | 4926 | undone-face (get-text-property (point) 'undone-face) |
| 4917 | done-face (get-text-property (point) 'done-face)) | 4927 | done-face (get-text-property (point) 'done-face)) |
| 4918 | (move-to-column pl) | 4928 | (move-to-column pl) |
| 4919 | (if (looking-at ".*") | 4929 | (if (looking-at ".*") |
| 4920 | (progn | 4930 | (progn |
| 4921 | (replace-match new t t) | 4931 | (replace-match new t t) |
| 4922 | (beginning-of-line 1) | 4932 | (beginning-of-line 1) |
| 4923 | (add-text-properties (point-at-bol) (point-at-eol) props) | 4933 | (add-text-properties (point-at-bol) (point-at-eol) props) |
| 4924 | (if fixface | 4934 | (if fixface |
| 4925 | (add-text-properties | 4935 | (add-text-properties |
| 4926 | (point-at-bol) (point-at-eol) | 4936 | (point-at-bol) (point-at-eol) |
| 4927 | (list 'face | 4937 | (list 'face |
| 4928 | (if org-last-todo-state-is-todo | 4938 | (if org-last-todo-state-is-todo |
| 4929 | undone-face done-face)))) | 4939 | undone-face done-face)))) |
| 4930 | (beginning-of-line 1)) | 4940 | (beginning-of-line 1)) |
| 4931 | (error "Line update did not work"))) | 4941 | (error "Line update did not work"))) |
| 4932 | (beginning-of-line 0))))) | 4942 | (beginning-of-line 0))))) |
| 4933 | 4943 | ||
| 4934 | (defun org-agenda-priority-up () | 4944 | (defun org-agenda-priority-up () |
| 4935 | "Increase the priority of line at point, also in Org-mode file." | 4945 | "Increase the priority of line at point, also in Org-mode file." |
| @@ -4948,19 +4958,19 @@ the same tree node, and the headline of the tree node in the Org-mode file." | |||
| 4948 | (interactive) | 4958 | (interactive) |
| 4949 | (org-agenda-check-no-diary) | 4959 | (org-agenda-check-no-diary) |
| 4950 | (let* ((marker (or (get-text-property (point) 'org-marker) | 4960 | (let* ((marker (or (get-text-property (point) 'org-marker) |
| 4951 | (org-agenda-error))) | 4961 | (org-agenda-error))) |
| 4952 | (buffer (marker-buffer marker)) | 4962 | (buffer (marker-buffer marker)) |
| 4953 | (pos (marker-position marker)) | 4963 | (pos (marker-position marker)) |
| 4954 | (hdmarker (get-text-property (point) 'org-hd-marker)) | 4964 | (hdmarker (get-text-property (point) 'org-hd-marker)) |
| 4955 | (buffer-read-only nil) | 4965 | (buffer-read-only nil) |
| 4956 | newhead) | 4966 | newhead) |
| 4957 | (with-current-buffer buffer | 4967 | (with-current-buffer buffer |
| 4958 | (widen) | 4968 | (widen) |
| 4959 | (goto-char pos) | 4969 | (goto-char pos) |
| 4960 | (org-show-hidden-entry) | 4970 | (org-show-hidden-entry) |
| 4961 | (save-excursion | 4971 | (save-excursion |
| 4962 | (and (outline-next-heading) | 4972 | (and (outline-next-heading) |
| 4963 | (org-flag-heading nil))) ; show the next heading | 4973 | (org-flag-heading nil))) ; show the next heading |
| 4964 | (funcall 'org-priority force-direction) | 4974 | (funcall 'org-priority force-direction) |
| 4965 | (end-of-line 1) | 4975 | (end-of-line 1) |
| 4966 | (setq newhead (org-get-heading))) | 4976 | (setq newhead (org-get-heading))) |
| @@ -4972,14 +4982,14 @@ the same tree node, and the headline of the tree node in the Org-mode file." | |||
| 4972 | (interactive "p") | 4982 | (interactive "p") |
| 4973 | (org-agenda-check-no-diary) | 4983 | (org-agenda-check-no-diary) |
| 4974 | (let* ((marker (or (get-text-property (point) 'org-marker) | 4984 | (let* ((marker (or (get-text-property (point) 'org-marker) |
| 4975 | (org-agenda-error))) | 4985 | (org-agenda-error))) |
| 4976 | (buffer (marker-buffer marker)) | 4986 | (buffer (marker-buffer marker)) |
| 4977 | (pos (marker-position marker))) | 4987 | (pos (marker-position marker))) |
| 4978 | (with-current-buffer buffer | 4988 | (with-current-buffer buffer |
| 4979 | (widen) | 4989 | (widen) |
| 4980 | (goto-char pos) | 4990 | (goto-char pos) |
| 4981 | (if (not (org-at-timestamp-p)) | 4991 | (if (not (org-at-timestamp-p)) |
| 4982 | (error "Cannot find time stamp")) | 4992 | (error "Cannot find time stamp")) |
| 4983 | (org-timestamp-change arg (or what 'day)) | 4993 | (org-timestamp-change arg (or what 'day)) |
| 4984 | (message "Time stamp changed to %s" org-last-changed-timestamp)))) | 4994 | (message "Time stamp changed to %s" org-last-changed-timestamp)))) |
| 4985 | 4995 | ||
| @@ -4995,14 +5005,14 @@ be used to request time specification in the time stamp." | |||
| 4995 | (interactive "P") | 5005 | (interactive "P") |
| 4996 | (org-agenda-check-no-diary) | 5006 | (org-agenda-check-no-diary) |
| 4997 | (let* ((marker (or (get-text-property (point) 'org-marker) | 5007 | (let* ((marker (or (get-text-property (point) 'org-marker) |
| 4998 | (org-agenda-error))) | 5008 | (org-agenda-error))) |
| 4999 | (buffer (marker-buffer marker)) | 5009 | (buffer (marker-buffer marker)) |
| 5000 | (pos (marker-position marker))) | 5010 | (pos (marker-position marker))) |
| 5001 | (with-current-buffer buffer | 5011 | (with-current-buffer buffer |
| 5002 | (widen) | 5012 | (widen) |
| 5003 | (goto-char pos) | 5013 | (goto-char pos) |
| 5004 | (if (not (org-at-timestamp-p)) | 5014 | (if (not (org-at-timestamp-p)) |
| 5005 | (error "Cannot find time stamp")) | 5015 | (error "Cannot find time stamp")) |
| 5006 | (org-time-stamp arg) | 5016 | (org-time-stamp arg) |
| 5007 | (message "Time stamp changed to %s" org-last-changed-timestamp)))) | 5017 | (message "Time stamp changed to %s" org-last-changed-timestamp)))) |
| 5008 | 5018 | ||
| @@ -5010,49 +5020,49 @@ be used to request time specification in the time stamp." | |||
| 5010 | "Return the heading of the current entry, without the stars." | 5020 | "Return the heading of the current entry, without the stars." |
| 5011 | (save-excursion | 5021 | (save-excursion |
| 5012 | (if (and (re-search-backward "[\r\n]\\*" nil t) | 5022 | (if (and (re-search-backward "[\r\n]\\*" nil t) |
| 5013 | (looking-at "[\r\n]\\*+[ \t]+\\(.*\\)")) | 5023 | (looking-at "[\r\n]\\*+[ \t]+\\(.*\\)")) |
| 5014 | (match-string 1) | 5024 | (match-string 1) |
| 5015 | ""))) | 5025 | ""))) |
| 5016 | 5026 | ||
| 5017 | (defun org-agenda-diary-entry () | 5027 | (defun org-agenda-diary-entry () |
| 5018 | "Make a diary entry, like the `i' command from the calendar. | 5028 | "Make a diary entry, like the `i' command from the calendar. |
| 5019 | All the standard commands work: block, weekly etc." | 5029 | All the standard commands work: block, weekly etc" |
| 5020 | (interactive) | 5030 | (interactive) |
| 5021 | (require 'diary-lib) | 5031 | (require 'diary-lib) |
| 5022 | (let* ((char (progn | 5032 | (let* ((char (progn |
| 5023 | (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic") | 5033 | (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic") |
| 5024 | (read-char-exclusive))) | 5034 | (read-char-exclusive))) |
| 5025 | (cmd (cdr (assoc char | 5035 | (cmd (cdr (assoc char |
| 5026 | '((?d . insert-diary-entry) | 5036 | '((?d . insert-diary-entry) |
| 5027 | (?w . insert-weekly-diary-entry) | 5037 | (?w . insert-weekly-diary-entry) |
| 5028 | (?m . insert-monthly-diary-entry) | 5038 | (?m . insert-monthly-diary-entry) |
| 5029 | (?y . insert-yearly-diary-entry) | 5039 | (?y . insert-yearly-diary-entry) |
| 5030 | (?a . insert-anniversary-diary-entry) | 5040 | (?a . insert-anniversary-diary-entry) |
| 5031 | (?b . insert-block-diary-entry) | 5041 | (?b . insert-block-diary-entry) |
| 5032 | (?c . insert-cyclic-diary-entry))))) | 5042 | (?c . insert-cyclic-diary-entry))))) |
| 5033 | (oldf (symbol-function 'calendar-cursor-to-date)) | 5043 | (oldf (symbol-function 'calendar-cursor-to-date)) |
| 5034 | (point (point)) | 5044 | (point (point)) |
| 5035 | (mark (or (mark t) (point)))) | 5045 | (mark (or (mark t) (point)))) |
| 5036 | (unless cmd | 5046 | (unless cmd |
| 5037 | (error "No command associated with <%c>" char)) | 5047 | (error "No command associated with <%c>" char)) |
| 5038 | (unless (and (get-text-property point 'day) | 5048 | (unless (and (get-text-property point 'day) |
| 5039 | (or (not (equal ?b char)) | 5049 | (or (not (equal ?b char)) |
| 5040 | (get-text-property mark 'day))) | 5050 | (get-text-property mark 'day))) |
| 5041 | (error "Don't know which date to use for diary entry")) | 5051 | (error "Don't know which date to use for diary entry")) |
| 5042 | ;; We implement this by hacking the `calendar-cursor-to-date' function | 5052 | ;; We implement this by hacking the `calendar-cursor-to-date' function |
| 5043 | ;; and the `calendar-mark-ring' variable. Saves a lot of code. | 5053 | ;; and the `calendar-mark-ring' variable. Saves a lot of code. |
| 5044 | (let ((calendar-mark-ring | 5054 | (let ((calendar-mark-ring |
| 5045 | (list (calendar-gregorian-from-absolute | 5055 | (list (calendar-gregorian-from-absolute |
| 5046 | (or (get-text-property mark 'day) | 5056 | (or (get-text-property mark 'day) |
| 5047 | (get-text-property point 'day)))))) | 5057 | (get-text-property point 'day)))))) |
| 5048 | (unwind-protect | 5058 | (unwind-protect |
| 5049 | (progn | 5059 | (progn |
| 5050 | (fset 'calendar-cursor-to-date | 5060 | (fset 'calendar-cursor-to-date |
| 5051 | (lambda (&optional error) | 5061 | (lambda (&optional error) |
| 5052 | (calendar-gregorian-from-absolute | 5062 | (calendar-gregorian-from-absolute |
| 5053 | (get-text-property point 'day)))) | 5063 | (get-text-property point 'day)))) |
| 5054 | (call-interactively cmd)) | 5064 | (call-interactively cmd)) |
| 5055 | (fset 'calendar-cursor-to-date oldf))))) | 5065 | (fset 'calendar-cursor-to-date oldf))))) |
| 5056 | 5066 | ||
| 5057 | 5067 | ||
| 5058 | (defun org-agenda-execute-calendar-command (cmd) | 5068 | (defun org-agenda-execute-calendar-command (cmd) |
| @@ -5062,20 +5072,20 @@ the cursor position." | |||
| 5062 | (unless (get-text-property (point) 'day) | 5072 | (unless (get-text-property (point) 'day) |
| 5063 | (error "Don't know which date to use for calendar command")) | 5073 | (error "Don't know which date to use for calendar command")) |
| 5064 | (let* ((oldf (symbol-function 'calendar-cursor-to-date)) | 5074 | (let* ((oldf (symbol-function 'calendar-cursor-to-date)) |
| 5065 | (point (point)) | 5075 | (point (point)) |
| 5066 | (date (calendar-gregorian-from-absolute | 5076 | (date (calendar-gregorian-from-absolute |
| 5067 | (get-text-property point 'day))) | 5077 | (get-text-property point 'day))) |
| 5068 | (displayed-day (extract-calendar-day date)) | 5078 | (displayed-day (extract-calendar-day date)) |
| 5069 | (displayed-month (extract-calendar-month date)) | 5079 | (displayed-month (extract-calendar-month date)) |
| 5070 | (displayed-year (extract-calendar-year date))) | 5080 | (displayed-year (extract-calendar-year date))) |
| 5071 | (unwind-protect | 5081 | (unwind-protect |
| 5072 | (progn | 5082 | (progn |
| 5073 | (fset 'calendar-cursor-to-date | 5083 | (fset 'calendar-cursor-to-date |
| 5074 | (lambda (&optional error) | 5084 | (lambda (&optional error) |
| 5075 | (calendar-gregorian-from-absolute | 5085 | (calendar-gregorian-from-absolute |
| 5076 | (get-text-property point 'day)))) | 5086 | (get-text-property point 'day)))) |
| 5077 | (call-interactively cmd)) | 5087 | (call-interactively cmd)) |
| 5078 | (fset 'calendar-cursor-to-date oldf)))) | 5088 | (fset 'calendar-cursor-to-date oldf)))) |
| 5079 | 5089 | ||
| 5080 | (defun org-agenda-phases-of-moon () | 5090 | (defun org-agenda-phases-of-moon () |
| 5081 | "Display the phases of the moon for the 3 months around the cursor date." | 5091 | "Display the phases of the moon for the 3 months around the cursor date." |
| @@ -5094,17 +5104,17 @@ Latitude and longitude can be specified with the variables | |||
| 5094 | argument, latitude and longitude will be prompted for." | 5104 | argument, latitude and longitude will be prompted for." |
| 5095 | (interactive "P") | 5105 | (interactive "P") |
| 5096 | (let ((calendar-longitude (if arg nil calendar-longitude)) | 5106 | (let ((calendar-longitude (if arg nil calendar-longitude)) |
| 5097 | (calendar-latitude (if arg nil calendar-latitude)) | 5107 | (calendar-latitude (if arg nil calendar-latitude)) |
| 5098 | (calendar-location-name | 5108 | (calendar-location-name |
| 5099 | (if arg "the given coordinates" calendar-location-name))) | 5109 | (if arg "the given coordinates" calendar-location-name))) |
| 5100 | (org-agenda-execute-calendar-command 'calendar-sunrise-sunset))) | 5110 | (org-agenda-execute-calendar-command 'calendar-sunrise-sunset))) |
| 5101 | 5111 | ||
| 5102 | (defun org-agenda-goto-calendar () | 5112 | (defun org-agenda-goto-calendar () |
| 5103 | "Open the Emacs calendar with the date at the cursor." | 5113 | "Open the Emacs calendar with the date at the cursor." |
| 5104 | (interactive) | 5114 | (interactive) |
| 5105 | (let* ((day (or (get-text-property (point) 'day) | 5115 | (let* ((day (or (get-text-property (point) 'day) |
| 5106 | (error "Don't know which date to open in calendar"))) | 5116 | (error "Don't know which date to open in calendar"))) |
| 5107 | (date (calendar-gregorian-from-absolute day))) | 5117 | (date (calendar-gregorian-from-absolute day))) |
| 5108 | (calendar) | 5118 | (calendar) |
| 5109 | (calendar-goto-date date))) | 5119 | (calendar-goto-date date))) |
| 5110 | 5120 | ||
| @@ -5113,30 +5123,30 @@ argument, latitude and longitude will be prompted for." | |||
| 5113 | This is a command that has to be installed in `calendar-mode-map'." | 5123 | This is a command that has to be installed in `calendar-mode-map'." |
| 5114 | (interactive) | 5124 | (interactive) |
| 5115 | (org-agenda nil (calendar-absolute-from-gregorian | 5125 | (org-agenda nil (calendar-absolute-from-gregorian |
| 5116 | (calendar-cursor-to-date)))) | 5126 | (calendar-cursor-to-date)))) |
| 5117 | 5127 | ||
| 5118 | (defun org-agenda-convert-date () | 5128 | (defun org-agenda-convert-date () |
| 5119 | (interactive) | 5129 | (interactive) |
| 5120 | (let ((day (get-text-property (point) 'day)) | 5130 | (let ((day (get-text-property (point) 'day)) |
| 5121 | date s) | 5131 | date s) |
| 5122 | (unless day | 5132 | (unless day |
| 5123 | (error "Don't know which date to convert")) | 5133 | (error "Don't know which date to convert")) |
| 5124 | (setq date (calendar-gregorian-from-absolute day)) | 5134 | (setq date (calendar-gregorian-from-absolute day)) |
| 5125 | (setq s (concat | 5135 | (setq s (concat |
| 5126 | "Gregorian: " (calendar-date-string date) "\n" | 5136 | "Gregorian: " (calendar-date-string date) "\n" |
| 5127 | "ISO: " (calendar-iso-date-string date) "\n" | 5137 | "ISO: " (calendar-iso-date-string date) "\n" |
| 5128 | "Day of Yr: " (calendar-day-of-year-string date) "\n" | 5138 | "Day of Yr: " (calendar-day-of-year-string date) "\n" |
| 5129 | "Julian: " (calendar-julian-date-string date) "\n" | 5139 | "Julian: " (calendar-julian-date-string date) "\n" |
| 5130 | "Astron. JD: " (calendar-astro-date-string date) | 5140 | "Astron. JD: " (calendar-astro-date-string date) |
| 5131 | " (Julian date number at noon UTC)\n" | 5141 | " (Julian date number at noon UTC)\n" |
| 5132 | "Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n" | 5142 | "Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n" |
| 5133 | "Islamic: " (calendar-islamic-date-string date) " (until sunset)\n" | 5143 | "Islamic: " (calendar-islamic-date-string date) " (until sunset)\n" |
| 5134 | "French: " (calendar-french-date-string date) "\n" | 5144 | "French: " (calendar-french-date-string date) "\n" |
| 5135 | "Mayan: " (calendar-mayan-date-string date) "\n" | 5145 | "Mayan: " (calendar-mayan-date-string date) "\n" |
| 5136 | "Coptic: " (calendar-coptic-date-string date) "\n" | 5146 | "Coptic: " (calendar-coptic-date-string date) "\n" |
| 5137 | "Ethiopic: " (calendar-ethiopic-date-string date) "\n" | 5147 | "Ethiopic: " (calendar-ethiopic-date-string date) "\n" |
| 5138 | "Persian: " (calendar-persian-date-string date) "\n" | 5148 | "Persian: " (calendar-persian-date-string date) "\n" |
| 5139 | "Chinese: " (calendar-chinese-date-string date) "\n")) | 5149 | "Chinese: " (calendar-chinese-date-string date) "\n")) |
| 5140 | (with-output-to-temp-buffer "*Dates*" | 5150 | (with-output-to-temp-buffer "*Dates*" |
| 5141 | (princ s)) | 5151 | (princ s)) |
| 5142 | (fit-window-to-buffer (get-buffer-window "*Dates*")))) | 5152 | (fit-window-to-buffer (get-buffer-window "*Dates*")))) |
| @@ -5164,88 +5174,88 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file." | |||
| 5164 | (interactive "P") | 5174 | (interactive "P") |
| 5165 | (if (org-at-timestamp-p) | 5175 | (if (org-at-timestamp-p) |
| 5166 | (org-agenda nil (time-to-days (org-time-string-to-time | 5176 | (org-agenda nil (time-to-days (org-time-string-to-time |
| 5167 | (substring (match-string 1) 0 10))) | 5177 | (substring (match-string 1) 0 10))) |
| 5168 | 1) | 5178 | 1) |
| 5169 | (let (type path line (pos (point))) | 5179 | (let (type path line (pos (point))) |
| 5170 | (save-excursion | 5180 | (save-excursion |
| 5171 | (skip-chars-backward | 5181 | (skip-chars-backward |
| 5172 | (concat (if org-allow-space-in-links "^" "^ ") | 5182 | (concat (if org-allow-space-in-links "^" "^ ") |
| 5173 | org-non-link-chars)) | 5183 | org-non-link-chars)) |
| 5174 | (if (re-search-forward | 5184 | (if (re-search-forward |
| 5175 | org-link-regexp | 5185 | org-link-regexp |
| 5176 | (save-excursion | 5186 | (save-excursion |
| 5177 | (condition-case nil | 5187 | (condition-case nil |
| 5178 | (progn (outline-end-of-subtree) (max pos (point))) | 5188 | (progn (outline-end-of-subtree) (max pos (point))) |
| 5179 | (error (end-of-line 1) (point)))) | 5189 | (error (end-of-line 1) (point)))) |
| 5180 | t) | 5190 | t) |
| 5181 | (setq type (match-string 1) | 5191 | (setq type (match-string 1) |
| 5182 | path (match-string 2))) | 5192 | path (match-string 2))) |
| 5183 | (unless path | 5193 | (unless path |
| 5184 | (error "No link found")) | 5194 | (error "No link found")) |
| 5185 | ;; Remove any trailing spaces in path | 5195 | ;; Remove any trailing spaces in path |
| 5186 | (if (string-match " +\\'" path) | 5196 | (if (string-match " +\\'" path) |
| 5187 | (setq path (replace-match "" t t path))) | 5197 | (setq path (replace-match "" t t path))) |
| 5188 | 5198 | ||
| 5189 | (cond | 5199 | (cond |
| 5190 | 5200 | ||
| 5191 | ((string= type "file") | 5201 | ((string= type "file") |
| 5192 | (if (string-match ":\\([0-9]+\\)\\'" path) | 5202 | (if (string-match ":\\([0-9]+\\)\\'" path) |
| 5193 | (setq line (string-to-number (match-string 1 path)) | 5203 | (setq line (string-to-number (match-string 1 path)) |
| 5194 | path (substring path 0 (match-beginning 0)))) | 5204 | path (substring path 0 (match-beginning 0)))) |
| 5195 | (org-open-file path in-emacs line)) | 5205 | (org-open-file path in-emacs line)) |
| 5196 | 5206 | ||
| 5197 | ((string= type "news") | 5207 | ((string= type "news") |
| 5198 | (org-follow-gnus-link path)) | 5208 | (org-follow-gnus-link path)) |
| 5199 | 5209 | ||
| 5200 | ((string= type "bbdb") | 5210 | ((string= type "bbdb") |
| 5201 | (org-follow-bbdb-link path)) | 5211 | (org-follow-bbdb-link path)) |
| 5202 | 5212 | ||
| 5203 | ((string= type "gnus") | 5213 | ((string= type "gnus") |
| 5204 | (let (group article) | 5214 | (let (group article) |
| 5205 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | 5215 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) |
| 5206 | (error "Error in Gnus link")) | 5216 | (error "Error in Gnus link")) |
| 5207 | (setq group (match-string 1 path) | 5217 | (setq group (match-string 1 path) |
| 5208 | article (match-string 3 path)) | 5218 | article (match-string 3 path)) |
| 5209 | (org-follow-gnus-link group article))) | 5219 | (org-follow-gnus-link group article))) |
| 5210 | 5220 | ||
| 5211 | ((string= type "vm") | 5221 | ((string= type "vm") |
| 5212 | (let (folder article) | 5222 | (let (folder article) |
| 5213 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | 5223 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) |
| 5214 | (error "Error in VM link")) | 5224 | (error "Error in VM link")) |
| 5215 | (setq folder (match-string 1 path) | 5225 | (setq folder (match-string 1 path) |
| 5216 | article (match-string 3 path)) | 5226 | article (match-string 3 path)) |
| 5217 | ;; in-emacs is the prefix arg, will be interpreted as read-only | 5227 | ;; in-emacs is the prefix arg, will be interpreted as read-only |
| 5218 | (org-follow-vm-link folder article in-emacs))) | 5228 | (org-follow-vm-link folder article in-emacs))) |
| 5219 | 5229 | ||
| 5220 | ((string= type "wl") | 5230 | ((string= type "wl") |
| 5221 | (let (folder article) | 5231 | (let (folder article) |
| 5222 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | 5232 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) |
| 5223 | (error "Error in Wanderlust link")) | 5233 | (error "Error in Wanderlust link")) |
| 5224 | (setq folder (match-string 1 path) | 5234 | (setq folder (match-string 1 path) |
| 5225 | article (match-string 3 path)) | 5235 | article (match-string 3 path)) |
| 5226 | (org-follow-wl-link folder article))) | 5236 | (org-follow-wl-link folder article))) |
| 5227 | 5237 | ||
| 5228 | ((string= type "rmail") | 5238 | ((string= type "rmail") |
| 5229 | (let (folder article) | 5239 | (let (folder article) |
| 5230 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | 5240 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) |
| 5231 | (error "Error in RMAIL link")) | 5241 | (error "Error in RMAIL link")) |
| 5232 | (setq folder (match-string 1 path) | 5242 | (setq folder (match-string 1 path) |
| 5233 | article (match-string 3 path)) | 5243 | article (match-string 3 path)) |
| 5234 | (org-follow-rmail-link folder article))) | 5244 | (org-follow-rmail-link folder article))) |
| 5235 | 5245 | ||
| 5236 | ((string= type "shell") | 5246 | ((string= type "shell") |
| 5237 | (let ((cmd path)) | 5247 | (let ((cmd path)) |
| 5238 | (while (string-match "@{" cmd) | 5248 | (while (string-match "@{" cmd) |
| 5239 | (setq cmd (replace-match "<" t t cmd))) | 5249 | (setq cmd (replace-match "<" t t cmd))) |
| 5240 | (while (string-match "@}" cmd) | 5250 | (while (string-match "@}" cmd) |
| 5241 | (setq cmd (replace-match ">" t t cmd))) | 5251 | (setq cmd (replace-match ">" t t cmd))) |
| 5242 | (if (or (not org-confirm-shell-links) | 5252 | (if (or (not org-confirm-shell-links) |
| 5243 | (yes-or-no-p (format "Execute \"%s\" in the shell? " cmd))) | 5253 | (yes-or-no-p (format "Execute \"%s\" in the shell? " cmd))) |
| 5244 | (shell-command cmd) | 5254 | (shell-command cmd) |
| 5245 | (error "Abort")))) | 5255 | (error "Abort")))) |
| 5246 | 5256 | ||
| 5247 | (t | 5257 | (t |
| 5248 | (browse-url-at-point))))))) | 5258 | (browse-url-at-point))))))) |
| 5249 | 5259 | ||
| 5250 | (defun org-follow-bbdb-link (name) | 5260 | (defun org-follow-bbdb-link (name) |
| 5251 | "Follow a BBDB link to NAME." | 5261 | "Follow a BBDB link to NAME." |
| @@ -5267,8 +5277,8 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file." | |||
| 5267 | ;; General match including network address and notes | 5277 | ;; General match including network address and notes |
| 5268 | (bbdb name nil) | 5278 | (bbdb name nil) |
| 5269 | (when (= 0 (buffer-size (get-buffer "*BBDB*"))) | 5279 | (when (= 0 (buffer-size (get-buffer "*BBDB*"))) |
| 5270 | (delete-window (get-buffer-window "*BBDB*")) | 5280 | (delete-window (get-buffer-window "*BBDB*")) |
| 5271 | (error "No matching BBDB record"))))) | 5281 | (error "No matching BBDB record"))))) |
| 5272 | 5282 | ||
| 5273 | (defun org-follow-gnus-link (&optional group article) | 5283 | (defun org-follow-gnus-link (&optional group article) |
| 5274 | "Follow a Gnus link to GROUP and ARTICLE." | 5284 | "Follow a Gnus link to GROUP and ARTICLE." |
| @@ -5277,11 +5287,11 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file." | |||
| 5277 | (if group (gnus-fetch-group group)) | 5287 | (if group (gnus-fetch-group group)) |
| 5278 | (if article | 5288 | (if article |
| 5279 | (or (gnus-summary-goto-article article nil 'force) | 5289 | (or (gnus-summary-goto-article article nil 'force) |
| 5280 | (if (fboundp 'gnus-summary-insert-cached-articles) | 5290 | (if (fboundp 'gnus-summary-insert-cached-articles) |
| 5281 | (progn | 5291 | (progn |
| 5282 | (gnus-summary-insert-cached-articles) | 5292 | (gnus-summary-insert-cached-articles) |
| 5283 | (gnus-summary-goto-article article nil 'force)) | 5293 | (gnus-summary-goto-article article nil 'force)) |
| 5284 | (message "Message could not be found."))))) | 5294 | (message "Message could not be found."))))) |
| 5285 | 5295 | ||
| 5286 | (defun org-follow-vm-link (&optional folder article readonly) | 5296 | (defun org-follow-vm-link (&optional folder article readonly) |
| 5287 | "Follow a VM link to FOLDER and ARTICLE." | 5297 | "Follow a VM link to FOLDER and ARTICLE." |
| @@ -5289,18 +5299,18 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file." | |||
| 5289 | (if (string-match "^//\\([a-zA-Z]+@\\)?\\([^:]+\\):\\(.*\\)" folder) | 5299 | (if (string-match "^//\\([a-zA-Z]+@\\)?\\([^:]+\\):\\(.*\\)" folder) |
| 5290 | ;; ange-ftp or efs or tramp access | 5300 | ;; ange-ftp or efs or tramp access |
| 5291 | (let ((user (or (match-string 1 folder) (user-login-name))) | 5301 | (let ((user (or (match-string 1 folder) (user-login-name))) |
| 5292 | (host (match-string 2 folder)) | 5302 | (host (match-string 2 folder)) |
| 5293 | (file (match-string 3 folder))) | 5303 | (file (match-string 3 folder))) |
| 5294 | (cond | 5304 | (cond |
| 5295 | ((featurep 'tramp) | 5305 | ((featurep 'tramp) |
| 5296 | ;; use tramp to access the file | 5306 | ;; use tramp to access the file |
| 5297 | (if org-xemacs-p | 5307 | (if org-xemacs-p |
| 5298 | (setq folder (format "[%s@%s]%s" user host file)) | 5308 | (setq folder (format "[%s@%s]%s" user host file)) |
| 5299 | (setq folder (format "/%s@%s:%s" user host file)))) | 5309 | (setq folder (format "/%s@%s:%s" user host file)))) |
| 5300 | (t | 5310 | (t |
| 5301 | ;; use ange-ftp or efs | 5311 | ;; use ange-ftp or efs |
| 5302 | (require (if org-xemacs-p 'efs 'ange-ftp)) | 5312 | (require (if org-xemacs-p 'efs 'ange-ftp)) |
| 5303 | (setq folder (format "/%s@%s:%s" user host file)))))) | 5313 | (setq folder (format "/%s@%s:%s" user host file)))))) |
| 5304 | (when folder | 5314 | (when folder |
| 5305 | (funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly) | 5315 | (funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly) |
| 5306 | (sit-for 0.1) | 5316 | (sit-for 0.1) |
| @@ -5308,14 +5318,14 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file." | |||
| 5308 | (vm-select-folder-buffer) | 5318 | (vm-select-folder-buffer) |
| 5309 | (widen) | 5319 | (widen) |
| 5310 | (let ((case-fold-search t)) | 5320 | (let ((case-fold-search t)) |
| 5311 | (goto-char (point-min)) | 5321 | (goto-char (point-min)) |
| 5312 | (if (not (re-search-forward | 5322 | (if (not (re-search-forward |
| 5313 | (concat "^" "message-id: *" (regexp-quote article)))) | 5323 | (concat "^" "message-id: *" (regexp-quote article)))) |
| 5314 | (error "Could not find the specified message in this folder")) | 5324 | (error "Could not find the specified message in this folder")) |
| 5315 | (vm-isearch-update) | 5325 | (vm-isearch-update) |
| 5316 | (vm-isearch-narrow) | 5326 | (vm-isearch-narrow) |
| 5317 | (vm-beginning-of-message) | 5327 | (vm-beginning-of-message) |
| 5318 | (vm-summarize))))) | 5328 | (vm-summarize))))) |
| 5319 | 5329 | ||
| 5320 | (defun org-follow-wl-link (folder article) | 5330 | (defun org-follow-wl-link (folder article) |
| 5321 | "Follow a Wanderlust link to FOLDER and ARTICLE." | 5331 | "Follow a Wanderlust link to FOLDER and ARTICLE." |
| @@ -5328,21 +5338,21 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file." | |||
| 5328 | (let (message-number) | 5338 | (let (message-number) |
| 5329 | (save-excursion | 5339 | (save-excursion |
| 5330 | (save-window-excursion | 5340 | (save-window-excursion |
| 5331 | (rmail (if (string= folder "RMAIL") rmail-file-name folder)) | 5341 | (rmail (if (string= folder "RMAIL") rmail-file-name folder)) |
| 5332 | (setq message-number | 5342 | (setq message-number |
| 5333 | (save-restriction | 5343 | (save-restriction |
| 5334 | (widen) | 5344 | (widen) |
| 5335 | (goto-char (point-max)) | 5345 | (goto-char (point-max)) |
| 5336 | (if (re-search-backward | 5346 | (if (re-search-backward |
| 5337 | (concat "^Message-ID:\\s-+" (regexp-quote | 5347 | (concat "^Message-ID:\\s-+" (regexp-quote |
| 5338 | (or article ""))) | 5348 | (or article ""))) |
| 5339 | nil t) | 5349 | nil t) |
| 5340 | (rmail-what-message)))))) | 5350 | (rmail-what-message)))))) |
| 5341 | (if message-number | 5351 | (if message-number |
| 5342 | (progn | 5352 | (progn |
| 5343 | (rmail (if (string= folder "RMAIL") rmail-file-name folder)) | 5353 | (rmail (if (string= folder "RMAIL") rmail-file-name folder)) |
| 5344 | (rmail-show-message message-number) | 5354 | (rmail-show-message message-number) |
| 5345 | message-number) | 5355 | message-number) |
| 5346 | (error "Message not found")))) | 5356 | (error "Message not found")))) |
| 5347 | 5357 | ||
| 5348 | (defun org-open-file (path &optional in-emacs line) | 5358 | (defun org-open-file (path &optional in-emacs line) |
| @@ -5354,27 +5364,27 @@ If no application is found, Emacs simply visits the file. | |||
| 5354 | With optional argument IN-EMACS, Emacs will visit the file. | 5364 | With optional argument IN-EMACS, Emacs will visit the file. |
| 5355 | If the file does not exist, an error is thrown." | 5365 | If the file does not exist, an error is thrown." |
| 5356 | (let* ((file (convert-standard-filename (org-expand-file-name path))) | 5366 | (let* ((file (convert-standard-filename (org-expand-file-name path))) |
| 5357 | (dfile (downcase file)) | 5367 | (dfile (downcase file)) |
| 5358 | ext cmd apps) | 5368 | ext cmd apps) |
| 5359 | (if (and (not (file-exists-p file)) | 5369 | (if (and (not (file-exists-p file)) |
| 5360 | (not org-open-non-existing-files)) | 5370 | (not org-open-non-existing-files)) |
| 5361 | (error "No such file: %s" file)) | 5371 | (error "No such file: %s" file)) |
| 5362 | (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\.gz\\)$" dfile) | 5372 | (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\.gz\\)$" dfile) |
| 5363 | (setq ext (match-string 1 dfile)) | 5373 | (setq ext (match-string 1 dfile)) |
| 5364 | (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\)$" dfile) | 5374 | (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\)$" dfile) |
| 5365 | (setq ext (match-string 1 dfile)))) | 5375 | (setq ext (match-string 1 dfile)))) |
| 5366 | (setq apps (append org-file-apps (org-default-apps))) | 5376 | (setq apps (append org-file-apps (org-default-apps))) |
| 5367 | (if in-emacs | 5377 | (if in-emacs |
| 5368 | (setq cmd 'emacs) | 5378 | (setq cmd 'emacs) |
| 5369 | (setq cmd (or (cdr (assoc ext apps)) | 5379 | (setq cmd (or (cdr (assoc ext apps)) |
| 5370 | (cdr (assoc t apps))))) | 5380 | (cdr (assoc t apps))))) |
| 5371 | (cond | 5381 | (cond |
| 5372 | ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) | 5382 | ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) |
| 5373 | (setq cmd (format cmd (concat "\"" file "\""))) | 5383 | (setq cmd (format cmd (concat "\"" file "\""))) |
| 5374 | (save-window-excursion | 5384 | (save-window-excursion |
| 5375 | (shell-command (concat cmd " & &")))) | 5385 | (shell-command (concat cmd " & &")))) |
| 5376 | ((or (stringp cmd) | 5386 | ((or (stringp cmd) |
| 5377 | (eq cmd 'emacs)) | 5387 | (eq cmd 'emacs)) |
| 5378 | (funcall (cdr (assq 'file org-link-frame-setup)) file) | 5388 | (funcall (cdr (assq 'file org-link-frame-setup)) file) |
| 5379 | (if line (goto-line line))) | 5389 | (if line (goto-line line))) |
| 5380 | ((consp cmd) | 5390 | ((consp cmd) |
| @@ -5415,120 +5425,120 @@ For file links, arg negates `org-line-numbers-in-file-links'." | |||
| 5415 | 5425 | ||
| 5416 | ((eq major-mode 'bbdb-mode) | 5426 | ((eq major-mode 'bbdb-mode) |
| 5417 | (setq cpltxt (concat | 5427 | (setq cpltxt (concat |
| 5418 | "bbdb:" | 5428 | "bbdb:" |
| 5419 | (or (bbdb-record-name (bbdb-current-record)) | 5429 | (or (bbdb-record-name (bbdb-current-record)) |
| 5420 | (bbdb-record-company (bbdb-current-record)))) | 5430 | (bbdb-record-company (bbdb-current-record)))) |
| 5421 | link (org-make-link cpltxt))) | 5431 | link (org-make-link cpltxt))) |
| 5422 | 5432 | ||
| 5423 | ((eq major-mode 'calendar-mode) | 5433 | ((eq major-mode 'calendar-mode) |
| 5424 | (let ((cd (calendar-cursor-to-date))) | 5434 | (let ((cd (calendar-cursor-to-date))) |
| 5425 | (setq link | 5435 | (setq link |
| 5426 | (format-time-string | 5436 | (format-time-string |
| 5427 | (car org-time-stamp-formats) | 5437 | (car org-time-stamp-formats) |
| 5428 | (apply 'encode-time | 5438 | (apply 'encode-time |
| 5429 | (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) | 5439 | (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) |
| 5430 | nil nil nil)))))) | 5440 | nil nil nil)))))) |
| 5431 | 5441 | ||
| 5432 | ((or (eq major-mode 'vm-summary-mode) | 5442 | ((or (eq major-mode 'vm-summary-mode) |
| 5433 | (eq major-mode 'vm-presentation-mode)) | 5443 | (eq major-mode 'vm-presentation-mode)) |
| 5434 | (and (eq major-mode 'vm-presentation-mode) (vm-summarize)) | 5444 | (and (eq major-mode 'vm-presentation-mode) (vm-summarize)) |
| 5435 | (vm-follow-summary-cursor) | 5445 | (vm-follow-summary-cursor) |
| 5436 | (save-excursion | 5446 | (save-excursion |
| 5437 | (vm-select-folder-buffer) | 5447 | (vm-select-folder-buffer) |
| 5438 | (let* ((message (car vm-message-pointer)) | 5448 | (let* ((message (car vm-message-pointer)) |
| 5439 | (folder (buffer-file-name)) | 5449 | (folder (buffer-file-name)) |
| 5440 | (subject (vm-su-subject message)) | 5450 | (subject (vm-su-subject message)) |
| 5441 | (author (vm-su-full-name message)) | 5451 | (author (vm-su-full-name message)) |
| 5442 | (message-id (vm-su-message-id message))) | 5452 | (message-id (vm-su-message-id message))) |
| 5443 | (setq folder (abbreviate-file-name folder)) | 5453 | (setq folder (abbreviate-file-name folder)) |
| 5444 | (if (string-match (concat "^" (regexp-quote vm-folder-directory)) | 5454 | (if (string-match (concat "^" (regexp-quote vm-folder-directory)) |
| 5445 | folder) | 5455 | folder) |
| 5446 | (setq folder (replace-match "" t t folder))) | 5456 | (setq folder (replace-match "" t t folder))) |
| 5447 | (setq cpltxt (concat author " on: " subject)) | 5457 | (setq cpltxt (concat author " on: " subject)) |
| 5448 | (setq link (concat cpltxt "\n " | 5458 | (setq link (concat cpltxt "\n " |
| 5449 | (org-make-link | 5459 | (org-make-link |
| 5450 | "vm:" folder "#" message-id)))))) | 5460 | "vm:" folder "#" message-id)))))) |
| 5451 | 5461 | ||
| 5452 | ((eq major-mode 'wl-summary-mode) | 5462 | ((eq major-mode 'wl-summary-mode) |
| 5453 | (let* ((msgnum (wl-summary-message-number)) | 5463 | (let* ((msgnum (wl-summary-message-number)) |
| 5454 | (message-id (elmo-message-field wl-summary-buffer-elmo-folder | 5464 | (message-id (elmo-message-field wl-summary-buffer-elmo-folder |
| 5455 | msgnum 'message-id)) | 5465 | msgnum 'message-id)) |
| 5456 | (wl-message-entity (elmo-msgdb-overview-get-entity | 5466 | (wl-message-entity (elmo-msgdb-overview-get-entity |
| 5457 | msgnum (wl-summary-buffer-msgdb))) | 5467 | msgnum (wl-summary-buffer-msgdb))) |
| 5458 | (author (wl-summary-line-from)) ; FIXME: how to get author name? | 5468 | (author (wl-summary-line-from)) ; FIXME: how to get author name? |
| 5459 | (subject "???")) ; FIXME: How to get subject of email? | 5469 | (subject "???")) ; FIXME: How to get subject of email? |
| 5460 | (setq cpltxt (concat author " on: " subject)) | 5470 | (setq cpltxt (concat author " on: " subject)) |
| 5461 | (setq link (concat cpltxt "\n " | 5471 | (setq link (concat cpltxt "\n " |
| 5462 | (org-make-link | 5472 | (org-make-link |
| 5463 | "wl:" wl-summary-buffer-folder-name | 5473 | "wl:" wl-summary-buffer-folder-name |
| 5464 | "#" message-id))))) | 5474 | "#" message-id))))) |
| 5465 | 5475 | ||
| 5466 | ((eq major-mode 'rmail-mode) | 5476 | ((eq major-mode 'rmail-mode) |
| 5467 | (save-excursion | 5477 | (save-excursion |
| 5468 | (save-restriction | 5478 | (save-restriction |
| 5469 | (rmail-narrow-to-non-pruned-header) | 5479 | (rmail-narrow-to-non-pruned-header) |
| 5470 | (let ((folder (buffer-file-name)) | 5480 | (let ((folder (buffer-file-name)) |
| 5471 | (message-id (mail-fetch-field "message-id")) | 5481 | (message-id (mail-fetch-field "message-id")) |
| 5472 | (author (mail-fetch-field "from")) | 5482 | (author (mail-fetch-field "from")) |
| 5473 | (subject (mail-fetch-field "subject"))) | 5483 | (subject (mail-fetch-field "subject"))) |
| 5474 | (setq cpltxt (concat author " on: " subject)) | 5484 | (setq cpltxt (concat author " on: " subject)) |
| 5475 | (setq link (concat cpltxt "\n " | 5485 | (setq link (concat cpltxt "\n " |
| 5476 | (org-make-link | 5486 | (org-make-link |
| 5477 | "rmail:" folder "#" message-id))))))) | 5487 | "rmail:" folder "#" message-id))))))) |
| 5478 | 5488 | ||
| 5479 | ((eq major-mode 'gnus-group-mode) | 5489 | ((eq major-mode 'gnus-group-mode) |
| 5480 | (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus | 5490 | (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus |
| 5481 | (gnus-group-group-name)) ; version | 5491 | (gnus-group-group-name)) ; version |
| 5482 | ((fboundp 'gnus-group-name) | 5492 | ((fboundp 'gnus-group-name) |
| 5483 | (gnus-group-name)) | 5493 | (gnus-group-name)) |
| 5484 | (t "???")))) | 5494 | (t "???")))) |
| 5485 | (setq cpltxt (concat | 5495 | (setq cpltxt (concat |
| 5486 | (if (org-xor arg org-usenet-links-prefer-google) | 5496 | (if (org-xor arg org-usenet-links-prefer-google) |
| 5487 | "http://groups.google.com/groups?group=" | 5497 | "http://groups.google.com/groups?group=" |
| 5488 | "gnus:") | 5498 | "gnus:") |
| 5489 | group) | 5499 | group) |
| 5490 | link (org-make-link cpltxt)))) | 5500 | link (org-make-link cpltxt)))) |
| 5491 | 5501 | ||
| 5492 | ((memq major-mode '(gnus-summary-mode gnus-article-mode)) | 5502 | ((memq major-mode '(gnus-summary-mode gnus-article-mode)) |
| 5493 | (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary)) | 5503 | (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary)) |
| 5494 | (gnus-summary-beginning-of-article) | 5504 | (gnus-summary-beginning-of-article) |
| 5495 | (let* ((group (car gnus-article-current)) | 5505 | (let* ((group (car gnus-article-current)) |
| 5496 | (article (cdr gnus-article-current)) | 5506 | (article (cdr gnus-article-current)) |
| 5497 | (header (gnus-summary-article-header article)) | 5507 | (header (gnus-summary-article-header article)) |
| 5498 | (author (mail-header-from header)) | 5508 | (author (mail-header-from header)) |
| 5499 | (message-id (mail-header-id header)) | 5509 | (message-id (mail-header-id header)) |
| 5500 | (date (mail-header-date header)) | 5510 | (date (mail-header-date header)) |
| 5501 | (subject (gnus-summary-subject-string))) | 5511 | (subject (gnus-summary-subject-string))) |
| 5502 | (setq cpltxt (concat author " on: " subject)) | 5512 | (setq cpltxt (concat author " on: " subject)) |
| 5503 | (if (org-xor arg org-usenet-links-prefer-google) | 5513 | (if (org-xor arg org-usenet-links-prefer-google) |
| 5504 | (setq link | 5514 | (setq link |
| 5505 | (concat | 5515 | (concat |
| 5506 | cpltxt "\n " | 5516 | cpltxt "\n " |
| 5507 | (format "http://groups.google.com/groups?as_umsgid=%s" | 5517 | (format "http://groups.google.com/groups?as_umsgid=%s" |
| 5508 | (org-fixup-message-id-for-http message-id)))) | 5518 | (org-fixup-message-id-for-http message-id)))) |
| 5509 | (setq link (concat cpltxt "\n" | 5519 | (setq link (concat cpltxt "\n" |
| 5510 | (org-make-link | 5520 | (org-make-link |
| 5511 | "gnus:" group | 5521 | "gnus:" group |
| 5512 | "#" (number-to-string article))))))) | 5522 | "#" (number-to-string article))))))) |
| 5513 | 5523 | ||
| 5514 | ((eq major-mode 'w3-mode) | 5524 | ((eq major-mode 'w3-mode) |
| 5515 | (setq cpltxt (url-view-url t) | 5525 | (setq cpltxt (url-view-url t) |
| 5516 | link (org-make-link cpltxt))) | 5526 | link (org-make-link cpltxt))) |
| 5517 | ((eq major-mode 'w3m-mode) | 5527 | ((eq major-mode 'w3m-mode) |
| 5518 | (setq cpltxt w3m-current-url | 5528 | (setq cpltxt w3m-current-url |
| 5519 | link (org-make-link cpltxt))) | 5529 | link (org-make-link cpltxt))) |
| 5520 | 5530 | ||
| 5521 | ((buffer-file-name) | 5531 | ((buffer-file-name) |
| 5522 | ;; Just link to this file here. | 5532 | ;; Just link to this file here. |
| 5523 | (setq cpltxt (concat "file:" | 5533 | (setq cpltxt (concat "file:" |
| 5524 | (abbreviate-file-name (buffer-file-name)))) | 5534 | (abbreviate-file-name (buffer-file-name)))) |
| 5525 | ;; Add the line number? | 5535 | ;; Add the line number? |
| 5526 | (if (org-xor org-line-numbers-in-file-links arg) | 5536 | (if (org-xor org-line-numbers-in-file-links arg) |
| 5527 | (setq cpltxt | 5537 | (setq cpltxt |
| 5528 | (concat cpltxt | 5538 | (concat cpltxt |
| 5529 | ":" (int-to-string | 5539 | ":" (int-to-string |
| 5530 | (+ (if (bolp) 1 0) (count-lines | 5540 | (+ (if (bolp) 1 0) (count-lines |
| 5531 | (point-min) (point))))))) | 5541 | (point-min) (point))))))) |
| 5532 | (setq link (org-make-link cpltxt))) | 5542 | (setq link (org-make-link cpltxt))) |
| 5533 | 5543 | ||
| 5534 | ((interactive-p) | 5544 | ((interactive-p) |
| @@ -5537,10 +5547,10 @@ For file links, arg negates `org-line-numbers-in-file-links'." | |||
| 5537 | (t (setq link nil))) | 5547 | (t (setq link nil))) |
| 5538 | 5548 | ||
| 5539 | (if (and (interactive-p) link) | 5549 | (if (and (interactive-p) link) |
| 5540 | (progn | 5550 | (progn |
| 5541 | (setq org-stored-links | 5551 | (setq org-stored-links |
| 5542 | (cons (cons (or cpltxt link) link) org-stored-links)) | 5552 | (cons (cons (or cpltxt link) link) org-stored-links)) |
| 5543 | (message "Stored: %s" (or cpltxt link))) | 5553 | (message "Stored: %s" (or cpltxt link))) |
| 5544 | link))) | 5554 | link))) |
| 5545 | 5555 | ||
| 5546 | (defun org-make-link (&rest strings) | 5556 | (defun org-make-link (&rest strings) |
| @@ -5552,24 +5562,24 @@ For file links, arg negates `org-line-numbers-in-file-links'." | |||
| 5552 | (if a (not b) b)) | 5562 | (if a (not b) b)) |
| 5553 | 5563 | ||
| 5554 | (defun org-get-header (header) | 5564 | (defun org-get-header (header) |
| 5555 | "Find a HEADER field in the current buffer." | 5565 | "Find a header field in the current buffer." |
| 5556 | (save-excursion | 5566 | (save-excursion |
| 5557 | (goto-char (point-min)) | 5567 | (goto-char (point-min)) |
| 5558 | (let ((case-fold-search t) s) | 5568 | (let ((case-fold-search t) s) |
| 5559 | (cond | 5569 | (cond |
| 5560 | ((eq header 'from) | 5570 | ((eq header 'from) |
| 5561 | (if (re-search-forward "^From:\\s-+\\(.*\\)" nil t) | 5571 | (if (re-search-forward "^From:\\s-+\\(.*\\)" nil t) |
| 5562 | (setq s (match-string 1))) | 5572 | (setq s (match-string 1))) |
| 5563 | (while (string-match "\"" s) | 5573 | (while (string-match "\"" s) |
| 5564 | (setq s (replace-match "" t t s))) | 5574 | (setq s (replace-match "" t t s))) |
| 5565 | (if (string-match "[<(].*" s) | 5575 | (if (string-match "[<(].*" s) |
| 5566 | (setq s (replace-match "" t t s)))) | 5576 | (setq s (replace-match "" t t s)))) |
| 5567 | ((eq header 'message-id) | 5577 | ((eq header 'message-id) |
| 5568 | (if (re-search-forward "^message-id:\\s-+\\(.*\\)" nil t) | 5578 | (if (re-search-forward "^message-id:\\s-+\\(.*\\)" nil t) |
| 5569 | (setq s (match-string 1)))) | 5579 | (setq s (match-string 1)))) |
| 5570 | ((eq header 'subject) | 5580 | ((eq header 'subject) |
| 5571 | (if (re-search-forward "^subject:\\s-+\\(.*\\)" nil t) | 5581 | (if (re-search-forward "^subject:\\s-+\\(.*\\)" nil t) |
| 5572 | (setq s (match-string 1))))) | 5582 | (setq s (match-string 1))))) |
| 5573 | (if (string-match "\\`[ \t\]+" s) (setq s (replace-match "" t t s))) | 5583 | (if (string-match "\\`[ \t\]+" s) (setq s (replace-match "" t t s))) |
| 5574 | (if (string-match "[ \t\]+\\'" s) (setq s (replace-match "" t t s))) | 5584 | (if (string-match "[ \t\]+\\'" s) (setq s (replace-match "" t t s))) |
| 5575 | s))) | 5585 | s))) |
| @@ -5604,48 +5614,48 @@ With two \\[universal-argument] prefixes, enforce an absolute path even if the f | |||
| 5604 | is in the current directory or below." | 5614 | is in the current directory or below." |
| 5605 | (interactive "P") | 5615 | (interactive "P") |
| 5606 | (let ((link (if complete-file | 5616 | (let ((link (if complete-file |
| 5607 | (read-file-name "File: ") | 5617 | (read-file-name "File: ") |
| 5608 | (completing-read | 5618 | (completing-read |
| 5609 | "Link: " org-stored-links nil nil nil | 5619 | "Link: " org-stored-links nil nil nil |
| 5610 | org-insert-link-history | 5620 | org-insert-link-history |
| 5611 | (or (car (car org-stored-links)))))) | 5621 | (or (car (car org-stored-links)))))) |
| 5612 | linktxt matched) | 5622 | linktxt matched) |
| 5613 | (if (or (not link) (equal link "")) | 5623 | (if (or (not link) (equal link "")) |
| 5614 | (error "No links available")) | 5624 | (error "No links available")) |
| 5615 | (if complete-file | 5625 | (if complete-file |
| 5616 | (let ((pwd (file-name-as-directory (expand-file-name ".")))) | 5626 | (let ((pwd (file-name-as-directory (expand-file-name ".")))) |
| 5617 | (cond | 5627 | (cond |
| 5618 | ((equal complete-file '(16)) | 5628 | ((equal complete-file '(16)) |
| 5619 | (insert | 5629 | (insert |
| 5620 | (org-make-link | 5630 | (org-make-link |
| 5621 | "file:" (abbreviate-file-name (expand-file-name link))))) | 5631 | "file:" (abbreviate-file-name (expand-file-name link))))) |
| 5622 | ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)") | 5632 | ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)") |
| 5623 | (expand-file-name link)) | 5633 | (expand-file-name link)) |
| 5624 | (insert | 5634 | (insert |
| 5625 | (org-make-link | 5635 | (org-make-link |
| 5626 | "file:" (match-string 1 (expand-file-name link))))) | 5636 | "file:" (match-string 1 (expand-file-name link))))) |
| 5627 | (t (insert (org-make-link "file:" link))))) | 5637 | (t (insert (org-make-link "file:" link))))) |
| 5628 | (setq linktxt (cdr (assoc link org-stored-links))) | 5638 | (setq linktxt (cdr (assoc link org-stored-links))) |
| 5629 | (if (not org-keep-stored-link-after-insertion) | 5639 | (if (not org-keep-stored-link-after-insertion) |
| 5630 | (setq org-stored-links (delq (assoc link org-stored-links) | 5640 | (setq org-stored-links (delq (assoc link org-stored-links) |
| 5631 | org-stored-links))) | 5641 | org-stored-links))) |
| 5632 | (if (not linktxt) (setq link (org-make-link link))) | 5642 | (if (not linktxt) (setq link (org-make-link link))) |
| 5633 | (let ((lines (org-split-string (or linktxt link) "\n"))) | 5643 | (let ((lines (org-split-string (or linktxt link) "\n"))) |
| 5634 | (insert (car lines)) | 5644 | (insert (car lines)) |
| 5635 | (setq matched (string-match org-link-regexp (car lines))) | 5645 | (setq matched (string-match org-link-regexp (car lines))) |
| 5636 | (setq lines (cdr lines)) | 5646 | (setq lines (cdr lines)) |
| 5637 | (while lines | 5647 | (while lines |
| 5638 | (insert "\n") | 5648 | (insert "\n") |
| 5639 | (if (save-excursion | 5649 | (if (save-excursion |
| 5640 | (beginning-of-line 0) | 5650 | (beginning-of-line 0) |
| 5641 | (looking-at "[ \t]+\\S-")) | 5651 | (looking-at "[ \t]+\\S-")) |
| 5642 | (indent-relative)) | 5652 | (indent-relative)) |
| 5643 | (setq matched (or matched | 5653 | (setq matched (or matched |
| 5644 | (string-match org-link-regexp (car lines)))) | 5654 | (string-match org-link-regexp (car lines)))) |
| 5645 | (insert (car lines)) | 5655 | (insert (car lines)) |
| 5646 | (setq lines (cdr lines)))) | 5656 | (setq lines (cdr lines)))) |
| 5647 | (unless matched | 5657 | (unless matched |
| 5648 | (error "Add link type: http(s),ftp,mailto,file,news,bbdb,vm,wl,rmail,gnus, or shell"))))) | 5658 | (error "Add link type: http(s),ftp,mailto,file,news,bbdb,vm,wl,rmail,gnus, or shell"))))) |
| 5649 | 5659 | ||
| 5650 | ;;; Hooks for remember.el | 5660 | ;;; Hooks for remember.el |
| 5651 | ;;;###autoload | 5661 | ;;;###autoload |
| @@ -5661,7 +5671,7 @@ conventions in Org-mode. This function returns such a link." | |||
| 5661 | UP/DOWN=headline TAB=cycle visibility [Q]uit RET/<left>/<right>=Store | 5671 | UP/DOWN=headline TAB=cycle visibility [Q]uit RET/<left>/<right>=Store |
| 5662 | RET at beg-of-buf -> Append to file as level 2 headline | 5672 | RET at beg-of-buf -> Append to file as level 2 headline |
| 5663 | RET on headline -> Store as sublevel entry to current headline | 5673 | RET on headline -> Store as sublevel entry to current headline |
| 5664 | <left>/<right> -> Before/after current headline, same headings level") | 5674 | <left>/<right> -> before/after current headline, same headings level") |
| 5665 | 5675 | ||
| 5666 | ;;;###autoload | 5676 | ;;;###autoload |
| 5667 | (defun org-remember-handler () | 5677 | (defun org-remember-handler () |
| @@ -5679,7 +5689,7 @@ Key Cursor position Note gets inserted | |||
| 5679 | RET buffer-start as level 2 heading at end of file | 5689 | RET buffer-start as level 2 heading at end of file |
| 5680 | RET on headline as sublevel of the heading at cursor | 5690 | RET on headline as sublevel of the heading at cursor |
| 5681 | RET no heading at cursor position, level taken from context. | 5691 | RET no heading at cursor position, level taken from context. |
| 5682 | Or use prefix arg to specify level manually. | 5692 | Or use prefix arg to specify level manually. |
| 5683 | <left> on headline as same level, before current heading | 5693 | <left> on headline as same level, before current heading |
| 5684 | <right> on headline as same level, after current heading | 5694 | <right> on headline as same level, after current heading |
| 5685 | 5695 | ||
| @@ -5699,77 +5709,77 @@ also indented so that it starts in the same column as the headline | |||
| 5699 | See also the variable `org-reverse-note-order'." | 5709 | See also the variable `org-reverse-note-order'." |
| 5700 | (catch 'quit | 5710 | (catch 'quit |
| 5701 | (let* ((txt (buffer-substring (point-min) (point-max))) | 5711 | (let* ((txt (buffer-substring (point-min) (point-max))) |
| 5702 | (fastp current-prefix-arg) | 5712 | (fastp current-prefix-arg) |
| 5703 | (file (if fastp org-default-notes-file (org-get-org-file))) | 5713 | (file (if fastp org-default-notes-file (org-get-org-file))) |
| 5704 | (visiting (find-buffer-visiting file)) | 5714 | (visiting (find-buffer-visiting file)) |
| 5705 | (org-startup-with-deadline-check nil) | 5715 | (org-startup-with-deadline-check nil) |
| 5706 | (org-startup-folded nil) | 5716 | (org-startup-folded nil) |
| 5707 | spos level indent reversed) | 5717 | spos level indent reversed) |
| 5708 | ;; Modify text so that it becomes a nice subtree which can be inserted | 5718 | ;; Modify text so that it becomes a nice subtree which can be inserted |
| 5709 | ;; into an org tree. | 5719 | ;; into an org tree. |
| 5710 | (let* ((lines (split-string txt "\n")) | 5720 | (let* ((lines (split-string txt "\n")) |
| 5711 | (first (car lines)) | 5721 | (first (car lines)) |
| 5712 | (lines (cdr lines))) | 5722 | (lines (cdr lines))) |
| 5713 | (if (string-match "^\\*+" first) | 5723 | (if (string-match "^\\*+" first) |
| 5714 | ;; Is already a headline | 5724 | ;; Is already a headline |
| 5715 | (setq indent (make-string (- (match-end 0) (match-beginning 0) | 5725 | (setq indent (make-string (- (match-end 0) (match-beginning 0) |
| 5716 | -1) ?\ )) | 5726 | -1) ?\ )) |
| 5717 | ;; We need to add a headline: Use time and first buffer line | 5727 | ;; We need to add a headline: Use time and first buffer line |
| 5718 | (setq lines (cons first lines) | 5728 | (setq lines (cons first lines) |
| 5719 | first (concat "* " (current-time-string) | 5729 | first (concat "* " (current-time-string) |
| 5720 | " (" (remember-buffer-desc) ")") | 5730 | " (" (remember-buffer-desc) ")") |
| 5721 | indent " ")) | 5731 | indent " ")) |
| 5722 | (if org-adapt-indentation | 5732 | (if org-adapt-indentation |
| 5723 | (setq lines (mapcar (lambda (x) (concat indent x)) lines))) | 5733 | (setq lines (mapcar (lambda (x) (concat indent x)) lines))) |
| 5724 | (setq txt (concat first "\n" | 5734 | (setq txt (concat first "\n" |
| 5725 | (mapconcat 'identity lines "\n")))) | 5735 | (mapconcat 'identity lines "\n")))) |
| 5726 | ;; Find the file | 5736 | ;; Find the file |
| 5727 | (if (not visiting) | 5737 | (if (not visiting) |
| 5728 | (find-file-noselect file)) | 5738 | (find-file-noselect file)) |
| 5729 | (with-current-buffer (get-file-buffer file) | 5739 | (with-current-buffer (get-file-buffer file) |
| 5730 | (setq reversed (org-notes-order-reversed-p)) | 5740 | (setq reversed (org-notes-order-reversed-p)) |
| 5731 | (save-excursion | 5741 | (save-excursion |
| 5732 | (save-restriction | 5742 | (save-restriction |
| 5733 | (widen) | 5743 | (widen) |
| 5734 | ;; Ask the User for a location | 5744 | ;; Ask the User for a location |
| 5735 | (setq spos (if fastp 1 (org-get-location | 5745 | (setq spos (if fastp 1 (org-get-location |
| 5736 | (current-buffer) | 5746 | (current-buffer) |
| 5737 | org-remember-help))) | 5747 | org-remember-help))) |
| 5738 | (if (not spos) (throw 'quit nil)) ; return nil to show we did | 5748 | (if (not spos) (throw 'quit nil)) ; return nil to show we did |
| 5739 | ; not handle this note | 5749 | ; not handle this note |
| 5740 | (goto-char spos) | 5750 | (goto-char spos) |
| 5741 | (cond ((bobp) | 5751 | (cond ((bobp) |
| 5742 | ;; Put it at the start or end, as level 2 | 5752 | ;; Put it at the start or end, as level 2 |
| 5743 | (save-restriction | 5753 | (save-restriction |
| 5744 | (widen) | 5754 | (widen) |
| 5745 | (goto-char (if reversed (point-min) (point-max))) | 5755 | (goto-char (if reversed (point-min) (point-max))) |
| 5746 | (if (not (bolp)) (newline)) | 5756 | (if (not (bolp)) (newline)) |
| 5747 | (org-paste-subtree (or current-prefix-arg 2) txt))) | 5757 | (org-paste-subtree (or current-prefix-arg 2) txt))) |
| 5748 | ((and (org-on-heading-p nil) (not current-prefix-arg)) | 5758 | ((and (org-on-heading-p nil) (not current-prefix-arg)) |
| 5749 | ;; Put it below this entry, at the beg/end of the subtree | 5759 | ;; Put it below this entry, at the beg/end of the subtree |
| 5750 | (org-back-to-heading) | 5760 | (org-back-to-heading) |
| 5751 | (setq level (outline-level)) | 5761 | (setq level (outline-level)) |
| 5752 | (if reversed | 5762 | (if reversed |
| 5753 | (outline-end-of-heading) | 5763 | (outline-end-of-heading) |
| 5754 | (outline-end-of-subtree)) | 5764 | (outline-end-of-subtree)) |
| 5755 | (if (not (bolp)) (newline)) | 5765 | (if (not (bolp)) (newline)) |
| 5756 | (beginning-of-line 1) | 5766 | (beginning-of-line 1) |
| 5757 | (org-paste-subtree (1+ level) txt)) | 5767 | (org-paste-subtree (1+ level) txt)) |
| 5758 | (t | 5768 | (t |
| 5759 | ;; Put it right there, with automatic level determined by | 5769 | ;; Put it right there, with automatic level determined by |
| 5760 | ;; org-paste-subtree or from prefix arg | 5770 | ;; org-paste-subtree or from prefix arg |
| 5761 | (org-paste-subtree current-prefix-arg txt))) | 5771 | (org-paste-subtree current-prefix-arg txt))) |
| 5762 | (when remember-save-after-remembering | 5772 | (when remember-save-after-remembering |
| 5763 | (save-buffer) | 5773 | (save-buffer) |
| 5764 | (if (not visiting) (kill-buffer (current-buffer))))))))) | 5774 | (if (not visiting) (kill-buffer (current-buffer))))))))) |
| 5765 | t) ;; return t to indicate that we took care of this note. | 5775 | t) ;; return t to indicate that we took care of this note. |
| 5766 | 5776 | ||
| 5767 | (defun org-get-org-file () | 5777 | (defun org-get-org-file () |
| 5768 | "Read a filename, with default directory `org-directory'." | 5778 | "Read a filename, with default directory `org-directory'." |
| 5769 | (let ((default (or org-default-notes-file remember-data-file))) | 5779 | (let ((default (or org-default-notes-file remember-data-file))) |
| 5770 | (read-file-name (format "File name [%s]: " default) | 5780 | (read-file-name (format "File name [%s]: " default) |
| 5771 | (file-name-as-directory org-directory) | 5781 | (file-name-as-directory org-directory) |
| 5772 | default))) | 5782 | default))) |
| 5773 | 5783 | ||
| 5774 | (defun org-notes-order-reversed-p () | 5784 | (defun org-notes-order-reversed-p () |
| 5775 | "Check if the current file should receive notes in reversed order." | 5785 | "Check if the current file should receive notes in reversed order." |
| @@ -5778,12 +5788,12 @@ See also the variable `org-reverse-note-order'." | |||
| 5778 | ((eq t org-reverse-note-order) t) | 5788 | ((eq t org-reverse-note-order) t) |
| 5779 | ((not (listp org-reverse-note-order)) nil) | 5789 | ((not (listp org-reverse-note-order)) nil) |
| 5780 | (t (catch 'exit | 5790 | (t (catch 'exit |
| 5781 | (let ((all org-reverse-note-order) | 5791 | (let ((all org-reverse-note-order) |
| 5782 | entry) | 5792 | entry) |
| 5783 | (while (setq entry (pop all)) | 5793 | (while (setq entry (pop all)) |
| 5784 | (if (string-match (car entry) (buffer-file-name)) | 5794 | (if (string-match (car entry) (buffer-file-name)) |
| 5785 | (throw 'exit (cdr entry)))) | 5795 | (throw 'exit (cdr entry)))) |
| 5786 | nil))))) | 5796 | nil))))) |
| 5787 | 5797 | ||
| 5788 | ;;; Tables | 5798 | ;;; Tables |
| 5789 | 5799 | ||
| @@ -5828,10 +5838,10 @@ and table.el tables." | |||
| 5828 | (cond | 5838 | (cond |
| 5829 | ((org-at-table.el-p) | 5839 | ((org-at-table.el-p) |
| 5830 | (if (y-or-n-p "Convert table to Org-mode table? ") | 5840 | (if (y-or-n-p "Convert table to Org-mode table? ") |
| 5831 | (org-table-convert))) | 5841 | (org-table-convert))) |
| 5832 | ((org-at-table-p) | 5842 | ((org-at-table-p) |
| 5833 | (if (y-or-n-p "Convert table to table.el table? ") | 5843 | (if (y-or-n-p "Convert table to table.el table? ") |
| 5834 | (org-table-convert))) | 5844 | (org-table-convert))) |
| 5835 | (t (call-interactively 'table-insert)))) | 5845 | (t (call-interactively 'table-insert)))) |
| 5836 | 5846 | ||
| 5837 | (defun org-table-create (&optional size) | 5847 | (defun org-table-create (&optional size) |
| @@ -5840,30 +5850,30 @@ SIZE is a string Columns x Rows like for example \"3x2\"." | |||
| 5840 | (interactive "P") | 5850 | (interactive "P") |
| 5841 | (unless size | 5851 | (unless size |
| 5842 | (setq size (read-string | 5852 | (setq size (read-string |
| 5843 | (concat "Table size Columns x Rows [e.g. " | 5853 | (concat "Table size Columns x Rows [e.g. " |
| 5844 | org-table-default-size "]: ") | 5854 | org-table-default-size "]: ") |
| 5845 | "" nil org-table-default-size))) | 5855 | "" nil org-table-default-size))) |
| 5846 | 5856 | ||
| 5847 | (let* ((pos (point)) | 5857 | (let* ((pos (point)) |
| 5848 | (indent (make-string (current-column) ?\ )) | 5858 | (indent (make-string (current-column) ?\ )) |
| 5849 | (split (org-split-string size " *x *")) | 5859 | (split (org-split-string size " *x *")) |
| 5850 | (rows (string-to-number (nth 1 split))) | 5860 | (rows (string-to-number (nth 1 split))) |
| 5851 | (columns (string-to-number (car split))) | 5861 | (columns (string-to-number (car split))) |
| 5852 | (line (concat (apply 'concat indent "|" (make-list columns " |")) | 5862 | (line (concat (apply 'concat indent "|" (make-list columns " |")) |
| 5853 | "\n"))) | 5863 | "\n"))) |
| 5854 | (if (string-match "^[ \t]*$" (buffer-substring-no-properties | 5864 | (if (string-match "^[ \t]*$" (buffer-substring-no-properties |
| 5855 | (point-at-bol) (point))) | 5865 | (point-at-bol) (point))) |
| 5856 | (beginning-of-line 1) | 5866 | (beginning-of-line 1) |
| 5857 | (newline)) | 5867 | (newline)) |
| 5858 | ;; (mapcar (lambda (x) (insert line)) (make-list rows t)) | 5868 | ;; (mapcar (lambda (x) (insert line)) (make-list rows t)) |
| 5859 | (dotimes (i rows) (insert line)) | 5869 | (dotimes (i rows) (insert line)) |
| 5860 | (goto-char pos) | 5870 | (goto-char pos) |
| 5861 | (if (> rows 1) | 5871 | (if (> rows 1) |
| 5862 | ;; Insert a hline after the first row. | 5872 | ;; Insert a hline after the first row. |
| 5863 | (progn | 5873 | (progn |
| 5864 | (end-of-line 1) | 5874 | (end-of-line 1) |
| 5865 | (insert "\n|-") | 5875 | (insert "\n|-") |
| 5866 | (goto-char pos))) | 5876 | (goto-char pos))) |
| 5867 | (org-table-align))) | 5877 | (org-table-align))) |
| 5868 | 5878 | ||
| 5869 | (defun org-table-convert-region (beg0 end0 nspace) | 5879 | (defun org-table-convert-region (beg0 end0 nspace) |
| @@ -5871,11 +5881,11 @@ SIZE is a string Columns x Rows like for example \"3x2\"." | |||
| 5871 | The region goes from BEG0 to END0, but these borders will be moved | 5881 | The region goes from BEG0 to END0, but these borders will be moved |
| 5872 | slightly, to make sure a beginning of line in the first line is included. | 5882 | slightly, to make sure a beginning of line in the first line is included. |
| 5873 | When NSPACE is non-nil, it indicates the minimum number of spaces that | 5883 | When NSPACE is non-nil, it indicates the minimum number of spaces that |
| 5874 | separate columns (default: just one space)." | 5884 | separate columns (default: just one space)" |
| 5875 | (let* ((beg (min beg0 end0)) | 5885 | (let* ((beg (min beg0 end0)) |
| 5876 | (end (max beg0 end0)) | 5886 | (end (max beg0 end0)) |
| 5877 | (tabsep t) | 5887 | (tabsep t) |
| 5878 | re) | 5888 | re) |
| 5879 | (goto-char beg) | 5889 | (goto-char beg) |
| 5880 | (beginning-of-line 1) | 5890 | (beginning-of-line 1) |
| 5881 | (setq beg (move-marker (make-marker) (point))) | 5891 | (setq beg (move-marker (make-marker) (point))) |
| @@ -5885,14 +5895,14 @@ separate columns (default: just one space)." | |||
| 5885 | ;; Lets see if this is tab-separated material. If every nonempty line | 5895 | ;; Lets see if this is tab-separated material. If every nonempty line |
| 5886 | ;; contains a tab, we will assume that it is tab-separated material | 5896 | ;; contains a tab, we will assume that it is tab-separated material |
| 5887 | (if nspace | 5897 | (if nspace |
| 5888 | (setq tabsep nil) | 5898 | (setq tabsep nil) |
| 5889 | (goto-char beg) | 5899 | (goto-char beg) |
| 5890 | (and (re-search-forward "^[^\n\t]+$" end t) (setq tabsep nil))) | 5900 | (and (re-search-forward "^[^\n\t]+$" end t) (setq tabsep nil))) |
| 5891 | (if nspace (setq tabsep nil)) | 5901 | (if nspace (setq tabsep nil)) |
| 5892 | (if tabsep | 5902 | (if tabsep |
| 5893 | (setq re "^\\|\t") | 5903 | (setq re "^\\|\t") |
| 5894 | (setq re (format "^ *\\| *\t *\\| \\{%d,\\}" | 5904 | (setq re (format "^ *\\| *\t *\\| \\{%d,\\}" |
| 5895 | (max 1 (prefix-numeric-value nspace))))) | 5905 | (max 1 (prefix-numeric-value nspace))))) |
| 5896 | (goto-char beg) | 5906 | (goto-char beg) |
| 5897 | (while (re-search-forward re end t) | 5907 | (while (re-search-forward re end t) |
| 5898 | (replace-match "|" t t)) | 5908 | (replace-match "|" t t)) |
| @@ -5908,7 +5918,7 @@ are found, lines will be split on whitespace into fields." | |||
| 5908 | (interactive "f\nP") | 5918 | (interactive "f\nP") |
| 5909 | (or (bolp) (newline)) | 5919 | (or (bolp) (newline)) |
| 5910 | (let ((beg (point)) | 5920 | (let ((beg (point)) |
| 5911 | (pm (point-max))) | 5921 | (pm (point-max))) |
| 5912 | (insert-file-contents file) | 5922 | (insert-file-contents file) |
| 5913 | (org-table-convert-region beg (+ (point) (- (point-max) pm)) arg))) | 5923 | (org-table-convert-region beg (+ (point) (- (point-max) pm)) arg))) |
| 5914 | 5924 | ||
| @@ -5917,12 +5927,12 @@ are found, lines will be split on whitespace into fields." | |||
| 5917 | Such a file can be imported into a spreadsheet program like Excel." | 5927 | Such a file can be imported into a spreadsheet program like Excel." |
| 5918 | (interactive) | 5928 | (interactive) |
| 5919 | (let* ((beg (org-table-begin)) | 5929 | (let* ((beg (org-table-begin)) |
| 5920 | (end (org-table-end)) | 5930 | (end (org-table-end)) |
| 5921 | (table (buffer-substring beg end)) | 5931 | (table (buffer-substring beg end)) |
| 5922 | (file (read-file-name "Export table to: ")) | 5932 | (file (read-file-name "Export table to: ")) |
| 5923 | buf) | 5933 | buf) |
| 5924 | (unless (or (not (file-exists-p file)) | 5934 | (unless (or (not (file-exists-p file)) |
| 5925 | (y-or-n-p (format "Overwrite file %s? " file))) | 5935 | (y-or-n-p (format "Overwrite file %s? " file))) |
| 5926 | (error "Abort")) | 5936 | (error "Abort")) |
| 5927 | (with-current-buffer (find-file-noselect file) | 5937 | (with-current-buffer (find-file-noselect file) |
| 5928 | (setq buf (current-buffer)) | 5938 | (setq buf (current-buffer)) |
| @@ -5931,20 +5941,20 @@ Such a file can be imported into a spreadsheet program like Excel." | |||
| 5931 | (insert table) | 5941 | (insert table) |
| 5932 | (goto-char (point-min)) | 5942 | (goto-char (point-min)) |
| 5933 | (while (re-search-forward "^[ \t]*|[ \t]*" nil t) | 5943 | (while (re-search-forward "^[ \t]*|[ \t]*" nil t) |
| 5934 | (replace-match "" t t) | 5944 | (replace-match "" t t) |
| 5935 | (end-of-line 1)) | 5945 | (end-of-line 1)) |
| 5936 | (goto-char (point-min)) | 5946 | (goto-char (point-min)) |
| 5937 | (while (re-search-forward "[ \t]*|[ \t]*$" nil t) | 5947 | (while (re-search-forward "[ \t]*|[ \t]*$" nil t) |
| 5938 | (replace-match "" t t) | 5948 | (replace-match "" t t) |
| 5939 | (goto-char (min (1+ (point)) (point-max)))) | 5949 | (goto-char (min (1+ (point)) (point-max)))) |
| 5940 | (goto-char (point-min)) | 5950 | (goto-char (point-min)) |
| 5941 | (while (re-search-forward "^-[-+]*$" nil t) | 5951 | (while (re-search-forward "^-[-+]*$" nil t) |
| 5942 | (replace-match "") | 5952 | (replace-match "") |
| 5943 | (if (looking-at "\n") | 5953 | (if (looking-at "\n") |
| 5944 | (delete-char 1))) | 5954 | (delete-char 1))) |
| 5945 | (goto-char (point-min)) | 5955 | (goto-char (point-min)) |
| 5946 | (while (re-search-forward "[ \t]*|[ \t]*" nil t) | 5956 | (while (re-search-forward "[ \t]*|[ \t]*" nil t) |
| 5947 | (replace-match "\t" t t)) | 5957 | (replace-match "\t" t t)) |
| 5948 | (save-buffer)) | 5958 | (save-buffer)) |
| 5949 | (kill-buffer buf))) | 5959 | (kill-buffer buf))) |
| 5950 | 5960 | ||
| @@ -5967,52 +5977,53 @@ This is being used to correctly align a single field after TAB or RET.") | |||
| 5967 | (defun org-table-align () | 5977 | (defun org-table-align () |
| 5968 | "Align the table at point by aligning all vertical bars." | 5978 | "Align the table at point by aligning all vertical bars." |
| 5969 | (interactive) | 5979 | (interactive) |
| 5980 | ;; (message "align") (sit-for 2) | ||
| 5970 | (let* ( | 5981 | (let* ( |
| 5971 | ;; Limits of table | 5982 | ;; Limits of table |
| 5972 | (beg (org-table-begin)) | 5983 | (beg (org-table-begin)) |
| 5973 | (end (org-table-end)) | 5984 | (end (org-table-end)) |
| 5974 | ;; Current cursor position | 5985 | ;; Current cursor position |
| 5975 | (linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point)))) | 5986 | (linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point)))) |
| 5976 | (colpos (org-table-current-column)) | 5987 | (colpos (org-table-current-column)) |
| 5977 | (winstart (window-start)) | 5988 | (winstart (window-start)) |
| 5978 | text lines (new "") lengths l typenums ty fields maxfields i | 5989 | text lines (new "") lengths l typenums ty fields maxfields i |
| 5979 | column | 5990 | column |
| 5980 | (indent "") cnt frac | 5991 | (indent "") cnt frac |
| 5981 | rfmt hfmt | 5992 | rfmt hfmt |
| 5982 | (spaces (if (org-in-invisibility-spec-p '(org-table)) | 5993 | (spaces (if (org-in-invisibility-spec-p '(org-table)) |
| 5983 | org-table-spaces-around-invisible-separators | 5994 | org-table-spaces-around-invisible-separators |
| 5984 | org-table-spaces-around-separators)) | 5995 | org-table-spaces-around-separators)) |
| 5985 | (sp1 (car spaces)) | 5996 | (sp1 (car spaces)) |
| 5986 | (sp2 (cdr spaces)) | 5997 | (sp2 (cdr spaces)) |
| 5987 | (rfmt1 (concat | 5998 | (rfmt1 (concat |
| 5988 | (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) | 5999 | (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) |
| 5989 | (hfmt1 (concat | 6000 | (hfmt1 (concat |
| 5990 | (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) | 6001 | (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) |
| 5991 | emptystrings) | 6002 | emptystrings) |
| 5992 | (untabify beg end) | 6003 | (untabify beg end) |
| 5993 | ;; (message "Aligning table...") | 6004 | ;; (message "Aligning table...") |
| 5994 | ;; Get the rows | 6005 | ;; Get the rows |
| 5995 | (setq lines (org-split-string | 6006 | (setq lines (org-split-string |
| 5996 | (buffer-substring-no-properties beg end) "\n")) | 6007 | (buffer-substring-no-properties beg end) "\n")) |
| 5997 | ;; Store the indentation of the first line | 6008 | ;; Store the indentation of the first line |
| 5998 | (if (string-match "^ *" (car lines)) | 6009 | (if (string-match "^ *" (car lines)) |
| 5999 | (setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ ))) | 6010 | (setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ ))) |
| 6000 | ;; Mark the hlines | 6011 | ;; Mark the hlines |
| 6001 | (setq lines (mapcar (lambda (l) | 6012 | (setq lines (mapcar (lambda (l) |
| 6002 | (if (string-match "^ *|-" l) | 6013 | (if (string-match "^ *|-" l) |
| 6003 | nil | 6014 | nil |
| 6004 | (if (string-match "[ \t]+$" l) | 6015 | (if (string-match "[ \t]+$" l) |
| 6005 | (substring l 0 (match-beginning 0)) | 6016 | (substring l 0 (match-beginning 0)) |
| 6006 | l))) | 6017 | l))) |
| 6007 | lines)) | 6018 | lines)) |
| 6008 | ;; Get the data fields | 6019 | ;; Get the data fields |
| 6009 | (setq fields (mapcar | 6020 | (setq fields (mapcar |
| 6010 | (lambda (l) | 6021 | (lambda (l) |
| 6011 | (org-split-string l " *| *")) | 6022 | (org-split-string l " *| *")) |
| 6012 | (delq nil (copy-sequence lines)))) | 6023 | (delq nil (copy-sequence lines)))) |
| 6013 | ;; How many fields in the longest line? | 6024 | ;; How many fields in the longest line? |
| 6014 | (condition-case nil | 6025 | (condition-case nil |
| 6015 | (setq maxfields (apply 'max (mapcar 'length fields))) | 6026 | (setq maxfields (apply 'max (mapcar 'length fields))) |
| 6016 | (error | 6027 | (error |
| 6017 | (kill-region beg end) | 6028 | (kill-region beg end) |
| 6018 | (org-table-create org-table-default-size) | 6029 | (org-table-create org-table-default-size) |
| @@ -6030,25 +6041,25 @@ This is being used to correctly align a single field after TAB or RET.") | |||
| 6030 | (setq cnt 0 frac 0.0) | 6041 | (setq cnt 0 frac 0.0) |
| 6031 | (mapcar | 6042 | (mapcar |
| 6032 | (lambda (x) | 6043 | (lambda (x) |
| 6033 | (if (equal x "") | 6044 | (if (equal x "") |
| 6034 | nil | 6045 | nil |
| 6035 | (setq frac ( / (+ (* frac cnt) | 6046 | (setq frac ( / (+ (* frac cnt) |
| 6036 | (if (string-match org-table-number-regexp x) 1 0)) | 6047 | (if (string-match org-table-number-regexp x) 1 0)) |
| 6037 | (setq cnt (1+ cnt)))))) | 6048 | (setq cnt (1+ cnt)))))) |
| 6038 | column) | 6049 | column) |
| 6039 | (push (>= frac org-table-number-fraction) typenums)) | 6050 | (push (>= frac org-table-number-fraction) typenums)) |
| 6040 | (setq lengths (nreverse lengths) | 6051 | (setq lengths (nreverse lengths) |
| 6041 | typenums (nreverse typenums)) | 6052 | typenums (nreverse typenums)) |
| 6042 | (setq org-table-last-alignment typenums | 6053 | (setq org-table-last-alignment typenums |
| 6043 | org-table-last-column-widths lengths) | 6054 | org-table-last-column-widths lengths) |
| 6044 | ;; Compute the formats needed for output of the table | 6055 | ;; Compute the formats needed for output of the table |
| 6045 | (setq rfmt (concat indent "|") hfmt (concat indent "|")) | 6056 | (setq rfmt (concat indent "|") hfmt (concat indent "|")) |
| 6046 | (while (setq l (pop lengths)) | 6057 | (while (setq l (pop lengths)) |
| 6047 | (setq ty (if (pop typenums) "" "-")) ; number types flushright | 6058 | (setq ty (if (pop typenums) "" "-")) ; number types flushright |
| 6048 | (setq rfmt (concat rfmt (format rfmt1 ty l)) | 6059 | (setq rfmt (concat rfmt (format rfmt1 ty l)) |
| 6049 | hfmt (concat hfmt (format hfmt1 (make-string l ?-))))) | 6060 | hfmt (concat hfmt (format hfmt1 (make-string l ?-))))) |
| 6050 | (setq rfmt (concat rfmt "\n") | 6061 | (setq rfmt (concat rfmt "\n") |
| 6051 | hfmt (concat (substring hfmt 0 -1) "|\n")) | 6062 | hfmt (concat (substring hfmt 0 -1) "|\n")) |
| 6052 | ;; Produce the new table | 6063 | ;; Produce the new table |
| 6053 | ;;(while lines | 6064 | ;;(while lines |
| 6054 | ;; (setq l (pop lines)) | 6065 | ;; (setq l (pop lines)) |
| @@ -6057,11 +6068,11 @@ This is being used to correctly align a single field after TAB or RET.") | |||
| 6057 | ;; (append (pop fields) emptystrings)))) | 6068 | ;; (append (pop fields) emptystrings)))) |
| 6058 | ;; (setq new (concat new hfmt)))) | 6069 | ;; (setq new (concat new hfmt)))) |
| 6059 | (setq new (mapconcat | 6070 | (setq new (mapconcat |
| 6060 | (lambda (l) | 6071 | (lambda (l) |
| 6061 | (if l (apply 'format rfmt | 6072 | (if l (apply 'format rfmt |
| 6062 | (append (pop fields) emptystrings)) | 6073 | (append (pop fields) emptystrings)) |
| 6063 | hfmt)) | 6074 | hfmt)) |
| 6064 | lines "")) | 6075 | lines "")) |
| 6065 | ;; Replace the old one | 6076 | ;; Replace the old one |
| 6066 | (delete-region beg end) | 6077 | (delete-region beg end) |
| 6067 | (move-marker end nil) | 6078 | (move-marker end nil) |
| @@ -6074,7 +6085,7 @@ This is being used to correctly align a single field after TAB or RET.") | |||
| 6074 | (org-table-goto-column colpos) | 6085 | (org-table-goto-column colpos) |
| 6075 | (setq org-table-may-need-update nil) | 6086 | (setq org-table-may-need-update nil) |
| 6076 | (if (org-in-invisibility-spec-p '(org-table)) | 6087 | (if (org-in-invisibility-spec-p '(org-table)) |
| 6077 | (org-table-add-invisible-to-vertical-lines)) | 6088 | (org-table-add-invisible-to-vertical-lines)) |
| 6078 | )) | 6089 | )) |
| 6079 | 6090 | ||
| 6080 | (defun org-table-begin (&optional table-type) | 6091 | (defun org-table-begin (&optional table-type) |
| @@ -6082,10 +6093,10 @@ This is being used to correctly align a single field after TAB or RET.") | |||
| 6082 | With argument TABLE-TYPE, go to the beginning of a table.el-type table." | 6093 | With argument TABLE-TYPE, go to the beginning of a table.el-type table." |
| 6083 | (save-excursion | 6094 | (save-excursion |
| 6084 | (if (not (re-search-backward | 6095 | (if (not (re-search-backward |
| 6085 | (if table-type org-table-any-border-regexp | 6096 | (if table-type org-table-any-border-regexp |
| 6086 | org-table-border-regexp) | 6097 | org-table-border-regexp) |
| 6087 | nil t)) | 6098 | nil t)) |
| 6088 | (error "Can't find beginning of table") | 6099 | (error "Can't find beginning of table") |
| 6089 | (goto-char (match-beginning 0)) | 6100 | (goto-char (match-beginning 0)) |
| 6090 | (beginning-of-line 2) | 6101 | (beginning-of-line 2) |
| 6091 | (point)))) | 6102 | (point)))) |
| @@ -6095,43 +6106,52 @@ With argument TABLE-TYPE, go to the beginning of a table.el-type table." | |||
| 6095 | With argument TABLE-TYPE, go to the end of a table.el-type table." | 6106 | With argument TABLE-TYPE, go to the end of a table.el-type table." |
| 6096 | (save-excursion | 6107 | (save-excursion |
| 6097 | (if (not (re-search-forward | 6108 | (if (not (re-search-forward |
| 6098 | (if table-type org-table-any-border-regexp | 6109 | (if table-type org-table-any-border-regexp |
| 6099 | org-table-border-regexp) | 6110 | org-table-border-regexp) |
| 6100 | nil t)) | 6111 | nil t)) |
| 6101 | (goto-char (point-max)) | 6112 | (goto-char (point-max)) |
| 6102 | (goto-char (match-beginning 0))) | 6113 | (goto-char (match-beginning 0))) |
| 6103 | (point-marker))) | 6114 | (point-marker))) |
| 6104 | 6115 | ||
| 6105 | (defun org-table-justify-field-maybe () | 6116 | (defun org-table-justify-field-maybe (&optional new) |
| 6106 | "Justify the current field, text to left, number to right." | 6117 | "Justify the current field, text to left, number to right. |
| 6118 | Optional argument NEW may specify text to replace the current field content." | ||
| 6107 | (cond | 6119 | (cond |
| 6108 | (org-table-may-need-update) ; Realignment will happen anyway, don't bother | 6120 | ((and (not new) org-table-may-need-update)) ; Realignment will happen anyway |
| 6109 | ((org-at-table-hline-p) | 6121 | ((org-at-table-hline-p) |
| 6110 | ;; This is pretty stupid, but I don't know how to deal with hlines | 6122 | ;; FIXME: I use to enforce realign here, but I think this is not needed. |
| 6111 | (setq org-table-may-need-update t)) | 6123 | ;; (setq org-table-may-need-update t) |
| 6112 | ((or (not (equal (marker-buffer org-table-aligned-begin-marker) | 6124 | ) |
| 6113 | (current-buffer))) | 6125 | ((and (not new) |
| 6114 | (< (point) org-table-aligned-begin-marker) | 6126 | (or (not (equal (marker-buffer org-table-aligned-begin-marker) |
| 6115 | (>= (point) org-table-aligned-end-marker)) | 6127 | (current-buffer))) |
| 6128 | (< (point) org-table-aligned-begin-marker) | ||
| 6129 | (>= (point) org-table-aligned-end-marker))) | ||
| 6116 | ;; This is not the same table, force a full re-align | 6130 | ;; This is not the same table, force a full re-align |
| 6117 | (setq org-table-may-need-update t)) | 6131 | (setq org-table-may-need-update t)) |
| 6118 | (t ;; realign the current field, based on previous full realign | 6132 | (t ;; realign the current field, based on previous full realign |
| 6119 | (let* ((pos (point)) s org-table-may-need-update | 6133 | (let* ((pos (point)) s |
| 6120 | (col (org-table-current-column)) | 6134 | (col (org-table-current-column)) |
| 6121 | (num (nth (1- col) org-table-last-alignment)) | 6135 | (num (nth (1- col) org-table-last-alignment)) |
| 6122 | l f n o) | 6136 | l f n o upd) |
| 6123 | (when (> col 0) | 6137 | (when (> col 0) |
| 6124 | (skip-chars-backward "^|\n") | 6138 | (skip-chars-backward "^|\n") |
| 6125 | (if (looking-at " *\\([^|\n]*?\\) *|") | 6139 | (if (looking-at " *\\([^|\n]*?\\) *|") |
| 6126 | (progn | 6140 | (progn |
| 6127 | (setq s (match-string 1) | 6141 | (setq s (match-string 1) |
| 6128 | o (match-string 0) | 6142 | o (match-string 0) |
| 6129 | l (max 1 (- (match-end 0) (match-beginning 0) 3))) | 6143 | l (max 1 (- (match-end 0) (match-beginning 0) 3))) |
| 6130 | (setq f (format (if num " %%%ds |" " %%-%ds |") l) | 6144 | (setq f (format (if num " %%%ds |" " %%-%ds |") l) |
| 6131 | n (format f s t t)) | 6145 | n (format f s t t)) |
| 6132 | (or (equal n o) (replace-match n))) | 6146 | (if new |
| 6133 | (setq org-table-may-need-update t)) | 6147 | (if (<= (length new) l) |
| 6134 | (goto-char pos)))))) | 6148 | (setq n (format f new t t)) ;; FIXME: why t t????? |
| 6149 | (setq n (concat new "|") org-table-may-need-update t))) | ||
| 6150 | (or (equal n o) | ||
| 6151 | (let (org-table-may-need-update) | ||
| 6152 | (replace-match n)))) | ||
| 6153 | (setq org-table-may-need-update t)) | ||
| 6154 | (goto-char pos)))))) | ||
| 6135 | 6155 | ||
| 6136 | (defun org-table-next-field () | 6156 | (defun org-table-next-field () |
| 6137 | "Go to the next field in the current table. | 6157 | "Go to the next field in the current table. |
| @@ -6140,20 +6160,20 @@ Before doing so, re-align the table if necessary." | |||
| 6140 | (org-table-maybe-eval-formula) | 6160 | (org-table-maybe-eval-formula) |
| 6141 | (org-table-maybe-recalculate-line) | 6161 | (org-table-maybe-recalculate-line) |
| 6142 | (if (and org-table-automatic-realign | 6162 | (if (and org-table-automatic-realign |
| 6143 | org-table-may-need-update) | 6163 | org-table-may-need-update) |
| 6144 | (org-table-align)) | 6164 | (org-table-align)) |
| 6145 | (if (org-at-table-hline-p) | 6165 | (if (org-at-table-hline-p) |
| 6146 | (end-of-line 1)) | 6166 | (end-of-line 1)) |
| 6147 | (condition-case nil | 6167 | (condition-case nil |
| 6148 | (progn | 6168 | (progn |
| 6149 | (re-search-forward "|" (org-table-end)) | 6169 | (re-search-forward "|" (org-table-end)) |
| 6150 | (if (looking-at "[ \t]*$") | 6170 | (if (looking-at "[ \t]*$") |
| 6151 | (re-search-forward "|" (org-table-end))) | 6171 | (re-search-forward "|" (org-table-end))) |
| 6152 | (if (looking-at "-") | 6172 | (if (looking-at "-") |
| 6153 | (progn | 6173 | (progn |
| 6154 | (beginning-of-line 0) | 6174 | (beginning-of-line 0) |
| 6155 | (org-table-insert-row 'below)) | 6175 | (org-table-insert-row 'below)) |
| 6156 | (if (looking-at " ") (forward-char 1)))) | 6176 | (if (looking-at " ") (forward-char 1)))) |
| 6157 | (error | 6177 | (error |
| 6158 | (org-table-insert-row 'below)))) | 6178 | (org-table-insert-row 'below)))) |
| 6159 | 6179 | ||
| @@ -6164,7 +6184,7 @@ Before doing so, re-align the table if necessary." | |||
| 6164 | (org-table-justify-field-maybe) | 6184 | (org-table-justify-field-maybe) |
| 6165 | (org-table-maybe-recalculate-line) | 6185 | (org-table-maybe-recalculate-line) |
| 6166 | (if (and org-table-automatic-realign | 6186 | (if (and org-table-automatic-realign |
| 6167 | org-table-may-need-update) | 6187 | org-table-may-need-update) |
| 6168 | (org-table-align)) | 6188 | (org-table-align)) |
| 6169 | (if (org-at-table-hline-p) | 6189 | (if (org-at-table-hline-p) |
| 6170 | (end-of-line 1)) | 6190 | (end-of-line 1)) |
| @@ -6182,18 +6202,18 @@ Before doing so, re-align the table if necessary." | |||
| 6182 | (org-table-maybe-eval-formula) | 6202 | (org-table-maybe-eval-formula) |
| 6183 | (org-table-maybe-recalculate-line) | 6203 | (org-table-maybe-recalculate-line) |
| 6184 | (if (or (looking-at "[ \t]*$") | 6204 | (if (or (looking-at "[ \t]*$") |
| 6185 | (save-excursion (skip-chars-backward " \t") (bolp))) | 6205 | (save-excursion (skip-chars-backward " \t") (bolp))) |
| 6186 | (newline) | 6206 | (newline) |
| 6187 | (if (and org-table-automatic-realign | 6207 | (if (and org-table-automatic-realign |
| 6188 | org-table-may-need-update) | 6208 | org-table-may-need-update) |
| 6189 | (org-table-align)) | 6209 | (org-table-align)) |
| 6190 | (let ((col (org-table-current-column))) | 6210 | (let ((col (org-table-current-column))) |
| 6191 | (beginning-of-line 2) | 6211 | (beginning-of-line 2) |
| 6192 | (if (or (not (org-at-table-p)) | 6212 | (if (or (not (org-at-table-p)) |
| 6193 | (org-at-table-hline-p)) | 6213 | (org-at-table-hline-p)) |
| 6194 | (progn | 6214 | (progn |
| 6195 | (beginning-of-line 0) | 6215 | (beginning-of-line 0) |
| 6196 | (org-table-insert-row 'below))) | 6216 | (org-table-insert-row 'below))) |
| 6197 | (org-table-goto-column col) | 6217 | (org-table-goto-column col) |
| 6198 | (skip-chars-backward "^|\n\r") | 6218 | (skip-chars-backward "^|\n\r") |
| 6199 | (if (looking-at " ") (forward-char 1))))) | 6219 | (if (looking-at " ") (forward-char 1))))) |
| @@ -6209,44 +6229,44 @@ If the variable `org-table-copy-increment' is non-nil and the field is an | |||
| 6209 | integer, it will be incremented while copying." | 6229 | integer, it will be incremented while copying." |
| 6210 | (interactive "p") | 6230 | (interactive "p") |
| 6211 | (let* ((colpos (org-table-current-column)) | 6231 | (let* ((colpos (org-table-current-column)) |
| 6212 | (field (org-table-get-field)) | 6232 | (field (org-table-get-field)) |
| 6213 | (non-empty (string-match "[^ \t]" field)) | 6233 | (non-empty (string-match "[^ \t]" field)) |
| 6214 | (beg (org-table-begin)) | 6234 | (beg (org-table-begin)) |
| 6215 | txt) | 6235 | txt) |
| 6216 | (org-table-check-inside-data-field) | 6236 | (org-table-check-inside-data-field) |
| 6217 | (if non-empty | 6237 | (if non-empty |
| 6218 | (progn | 6238 | (progn |
| 6219 | (setq txt (org-trim field)) | 6239 | (setq txt (org-trim field)) |
| 6220 | (org-table-next-row) | 6240 | (org-table-next-row) |
| 6221 | (org-table-blank-field)) | 6241 | (org-table-blank-field)) |
| 6222 | (save-excursion | 6242 | (save-excursion |
| 6223 | (setq txt | 6243 | (setq txt |
| 6224 | (catch 'exit | 6244 | (catch 'exit |
| 6225 | (while (progn (beginning-of-line 1) | 6245 | (while (progn (beginning-of-line 1) |
| 6226 | (re-search-backward org-table-dataline-regexp | 6246 | (re-search-backward org-table-dataline-regexp |
| 6227 | beg t)) | 6247 | beg t)) |
| 6228 | (org-table-goto-column colpos t) | 6248 | (org-table-goto-column colpos t) |
| 6229 | (if (and (looking-at | 6249 | (if (and (looking-at |
| 6230 | "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") | 6250 | "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") |
| 6231 | (= (setq n (1- n)) 0)) | 6251 | (= (setq n (1- n)) 0)) |
| 6232 | (throw 'exit (match-string 1)))))))) | 6252 | (throw 'exit (match-string 1)))))))) |
| 6233 | (if txt | 6253 | (if txt |
| 6234 | (progn | 6254 | (progn |
| 6235 | (if (and org-table-copy-increment | 6255 | (if (and org-table-copy-increment |
| 6236 | (string-match "^[0-9]+$" txt)) | 6256 | (string-match "^[0-9]+$" txt)) |
| 6237 | (setq txt (format "%d" (+ (string-to-int txt) 1)))) | 6257 | (setq txt (format "%d" (+ (string-to-int txt) 1)))) |
| 6238 | (insert txt) | 6258 | (insert txt) |
| 6239 | (org-table-maybe-recalculate-line) | 6259 | (org-table-maybe-recalculate-line) |
| 6240 | (org-table-align)) | 6260 | (org-table-align)) |
| 6241 | (error "No non-empty field found")))) | 6261 | (error "No non-empty field found")))) |
| 6242 | 6262 | ||
| 6243 | (defun org-table-check-inside-data-field () | 6263 | (defun org-table-check-inside-data-field () |
| 6244 | "Is point inside a table data field? | 6264 | "Is point inside a table data field? |
| 6245 | I.e. not on a hline or before the first or after the last column?" | 6265 | I.e. not on a hline or before the first or after the last column?" |
| 6246 | (if (or (not (org-at-table-p)) | 6266 | (if (or (not (org-at-table-p)) |
| 6247 | (= (org-table-current-column) 0) | 6267 | (= (org-table-current-column) 0) |
| 6248 | (org-at-table-hline-p) | 6268 | (org-at-table-hline-p) |
| 6249 | (looking-at "[ \t]*$")) | 6269 | (looking-at "[ \t]*$")) |
| 6250 | (error "Not in table data field"))) | 6270 | (error "Not in table data field"))) |
| 6251 | 6271 | ||
| 6252 | (defvar org-table-clip nil | 6272 | (defvar org-table-clip nil |
| @@ -6258,16 +6278,16 @@ I.e. not on a hline or before the first or after the last column?" | |||
| 6258 | (org-table-check-inside-data-field) | 6278 | (org-table-check-inside-data-field) |
| 6259 | (if (and (interactive-p) (org-region-active-p)) | 6279 | (if (and (interactive-p) (org-region-active-p)) |
| 6260 | (let (org-table-clip) | 6280 | (let (org-table-clip) |
| 6261 | (org-table-cut-region (region-beginning) (region-end))) | 6281 | (org-table-cut-region (region-beginning) (region-end))) |
| 6262 | (skip-chars-backward "^|") | 6282 | (skip-chars-backward "^|") |
| 6263 | (backward-char 1) | 6283 | (backward-char 1) |
| 6264 | (if (looking-at "|[^|\n]+") | 6284 | (if (looking-at "|[^|\n]+") |
| 6265 | (let* ((pos (match-beginning 0)) | 6285 | (let* ((pos (match-beginning 0)) |
| 6266 | (match (match-string 0)) | 6286 | (match (match-string 0)) |
| 6267 | (len (length match))) | 6287 | (len (length match))) |
| 6268 | (replace-match (concat "|" (make-string (1- len) ?\ ))) | 6288 | (replace-match (concat "|" (make-string (1- len) ?\ ))) |
| 6269 | (goto-char (+ 2 pos)) | 6289 | (goto-char (+ 2 pos)) |
| 6270 | (substring match 1))))) | 6290 | (substring match 1))))) |
| 6271 | 6291 | ||
| 6272 | (defun org-table-get-field (&optional n replace) | 6292 | (defun org-table-get-field (&optional n replace) |
| 6273 | "Return the value of the field in column N of current row. | 6293 | "Return the value of the field in column N of current row. |
| @@ -6279,11 +6299,11 @@ is always the old value." | |||
| 6279 | (backward-char 1) | 6299 | (backward-char 1) |
| 6280 | (if (looking-at "|[^|\r\n]*") | 6300 | (if (looking-at "|[^|\r\n]*") |
| 6281 | (let* ((pos (match-beginning 0)) | 6301 | (let* ((pos (match-beginning 0)) |
| 6282 | (val (buffer-substring (1+ pos) (match-end 0)))) | 6302 | (val (buffer-substring (1+ pos) (match-end 0)))) |
| 6283 | (if replace | 6303 | (if replace |
| 6284 | (replace-match (concat "|" replace))) | 6304 | (replace-match (concat "|" replace))) |
| 6285 | (goto-char (min (point-at-eol) (+ 2 pos))) | 6305 | (goto-char (min (point-at-eol) (+ 2 pos))) |
| 6286 | val) | 6306 | val) |
| 6287 | (forward-char 1) "")) | 6307 | (forward-char 1) "")) |
| 6288 | 6308 | ||
| 6289 | (defun org-table-current-column () | 6309 | (defun org-table-current-column () |
| @@ -6295,7 +6315,7 @@ When called interactively, column is also displayed in echo area." | |||
| 6295 | (let ((cnt 0) (pos (point))) | 6315 | (let ((cnt 0) (pos (point))) |
| 6296 | (beginning-of-line 1) | 6316 | (beginning-of-line 1) |
| 6297 | (while (search-forward "|" pos t) | 6317 | (while (search-forward "|" pos t) |
| 6298 | (setq cnt (1+ cnt))) | 6318 | (setq cnt (1+ cnt))) |
| 6299 | (if (interactive-p) (message "This is table column %d" cnt)) | 6319 | (if (interactive-p) (message "This is table column %d" cnt)) |
| 6300 | cnt))) | 6320 | cnt))) |
| 6301 | 6321 | ||
| @@ -6309,69 +6329,69 @@ However, when FORCE is non-nil, create new columns if necessary." | |||
| 6309 | (beginning-of-line 1) | 6329 | (beginning-of-line 1) |
| 6310 | (when (> n 0) | 6330 | (when (> n 0) |
| 6311 | (while (and (> (setq n (1- n)) -1) | 6331 | (while (and (> (setq n (1- n)) -1) |
| 6312 | (or (search-forward "|" pos t) | 6332 | (or (search-forward "|" pos t) |
| 6313 | (and force | 6333 | (and force |
| 6314 | (progn (end-of-line 1) | 6334 | (progn (end-of-line 1) |
| 6315 | (skip-chars-backward "^|") | 6335 | (skip-chars-backward "^|") |
| 6316 | (insert " | ")))))) | 6336 | (insert " | ")))))) |
| 6317 | ; (backward-char 2) t))))) | 6337 | ; (backward-char 2) t))))) |
| 6318 | (when (and force (not (looking-at ".*|"))) | 6338 | (when (and force (not (looking-at ".*|"))) |
| 6319 | (save-excursion (end-of-line 1) (insert " | "))) | 6339 | (save-excursion (end-of-line 1) (insert " | "))) |
| 6320 | (if on-delim | 6340 | (if on-delim |
| 6321 | (backward-char 1) | 6341 | (backward-char 1) |
| 6322 | (if (looking-at " ") (forward-char 1)))))) | 6342 | (if (looking-at " ") (forward-char 1)))))) |
| 6323 | 6343 | ||
| 6324 | (defun org-at-table-p (&optional table-type) | 6344 | (defun org-at-table-p (&optional table-type) |
| 6325 | "Return t if the cursor is inside an org-type table. | 6345 | "Return t if the cursor is inside an org-type table. |
| 6326 | If TABLE-TYPE is non-nil, also check for table.el-type tables." | 6346 | If TABLE-TYPE is non-nil, also chack for table.el-type tables." |
| 6327 | (if org-enable-table-editor | 6347 | (if org-enable-table-editor |
| 6328 | (save-excursion | 6348 | (save-excursion |
| 6329 | (beginning-of-line 1) | 6349 | (beginning-of-line 1) |
| 6330 | (looking-at (if table-type org-table-any-line-regexp | 6350 | (looking-at (if table-type org-table-any-line-regexp |
| 6331 | org-table-line-regexp))) | 6351 | org-table-line-regexp))) |
| 6332 | nil)) | 6352 | nil)) |
| 6333 | 6353 | ||
| 6334 | (defun org-table-recognize-table.el () | 6354 | (defun org-table-recognize-table.el () |
| 6335 | "If there is a table.el table nearby, recognize it and move into it." | 6355 | "If there is a table.el table nearby, recognize it and move into it." |
| 6336 | (if org-table-tab-recognizes-table.el | 6356 | (if org-table-tab-recognizes-table.el |
| 6337 | (if (org-at-table.el-p) | 6357 | (if (org-at-table.el-p) |
| 6338 | (progn | 6358 | (progn |
| 6339 | (beginning-of-line 1) | 6359 | (beginning-of-line 1) |
| 6340 | (if (looking-at org-table-dataline-regexp) | 6360 | (if (looking-at org-table-dataline-regexp) |
| 6341 | nil | 6361 | nil |
| 6342 | (if (looking-at org-table1-hline-regexp) | 6362 | (if (looking-at org-table1-hline-regexp) |
| 6343 | (progn | 6363 | (progn |
| 6344 | (beginning-of-line 2) | 6364 | (beginning-of-line 2) |
| 6345 | (if (looking-at org-table-any-border-regexp) | 6365 | (if (looking-at org-table-any-border-regexp) |
| 6346 | (beginning-of-line -1))))) | 6366 | (beginning-of-line -1))))) |
| 6347 | (if (re-search-forward "|" (org-table-end t) t) | 6367 | (if (re-search-forward "|" (org-table-end t) t) |
| 6348 | (progn | 6368 | (progn |
| 6349 | (require 'table) | 6369 | (require 'table) |
| 6350 | (if (table--at-cell-p (point)) | 6370 | (if (table--at-cell-p (point)) |
| 6351 | t | 6371 | t |
| 6352 | (message "recognizing table.el table...") | 6372 | (message "recognizing table.el table...") |
| 6353 | (table-recognize-table) | 6373 | (table-recognize-table) |
| 6354 | (message "recognizing table.el table...done"))) | 6374 | (message "recognizing table.el table...done"))) |
| 6355 | (error "This should not happen...")) | 6375 | (error "This should not happen...")) |
| 6356 | t) | 6376 | t) |
| 6357 | nil) | 6377 | nil) |
| 6358 | nil)) | 6378 | nil)) |
| 6359 | 6379 | ||
| 6360 | (defun org-at-table.el-p () | 6380 | (defun org-at-table.el-p () |
| 6361 | "Return t if the cursor is inside a table.el-type table." | 6381 | "Return t if the cursor is inside a table.el-type table." |
| 6362 | (save-excursion | 6382 | (save-excursion |
| 6363 | (if (org-at-table-p 'any) | 6383 | (if (org-at-table-p 'any) |
| 6364 | (progn | 6384 | (progn |
| 6365 | (goto-char (org-table-begin 'any)) | 6385 | (goto-char (org-table-begin 'any)) |
| 6366 | (looking-at org-table1-hline-regexp)) | 6386 | (looking-at org-table1-hline-regexp)) |
| 6367 | nil))) | 6387 | nil))) |
| 6368 | 6388 | ||
| 6369 | (defun org-at-table-hline-p () | 6389 | (defun org-at-table-hline-p () |
| 6370 | "Return t if the cursor is inside a hline in a table." | 6390 | "Return t if the cursor is inside a hline in a table." |
| 6371 | (if org-enable-table-editor | 6391 | (if org-enable-table-editor |
| 6372 | (save-excursion | 6392 | (save-excursion |
| 6373 | (beginning-of-line 1) | 6393 | (beginning-of-line 1) |
| 6374 | (looking-at org-table-hline-regexp)) | 6394 | (looking-at org-table-hline-regexp)) |
| 6375 | nil)) | 6395 | nil)) |
| 6376 | 6396 | ||
| 6377 | (defun org-table-insert-column () | 6397 | (defun org-table-insert-column () |
| @@ -6381,17 +6401,17 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." | |||
| 6381 | (error "Not at a table")) | 6401 | (error "Not at a table")) |
| 6382 | (org-table-find-dataline) | 6402 | (org-table-find-dataline) |
| 6383 | (let* ((col (max 1 (org-table-current-column))) | 6403 | (let* ((col (max 1 (org-table-current-column))) |
| 6384 | (beg (org-table-begin)) | 6404 | (beg (org-table-begin)) |
| 6385 | (end (org-table-end)) | 6405 | (end (org-table-end)) |
| 6386 | ;; Current cursor position | 6406 | ;; Current cursor position |
| 6387 | (linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point)))) | 6407 | (linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point)))) |
| 6388 | (colpos col)) | 6408 | (colpos col)) |
| 6389 | (goto-char beg) | 6409 | (goto-char beg) |
| 6390 | (while (< (point) end) | 6410 | (while (< (point) end) |
| 6391 | (if (org-at-table-hline-p) | 6411 | (if (org-at-table-hline-p) |
| 6392 | nil | 6412 | nil |
| 6393 | (org-table-goto-column col t) | 6413 | (org-table-goto-column col t) |
| 6394 | (insert "| ")) | 6414 | (insert "| ")) |
| 6395 | (beginning-of-line 2)) | 6415 | (beginning-of-line 2)) |
| 6396 | (move-marker end nil) | 6416 | (move-marker end nil) |
| 6397 | (goto-line linepos) | 6417 | (goto-line linepos) |
| @@ -6402,21 +6422,21 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." | |||
| 6402 | (defun org-table-find-dataline () | 6422 | (defun org-table-find-dataline () |
| 6403 | "Find a dataline in the current table, which is needed for column commands." | 6423 | "Find a dataline in the current table, which is needed for column commands." |
| 6404 | (if (and (org-at-table-p) | 6424 | (if (and (org-at-table-p) |
| 6405 | (not (org-at-table-hline-p))) | 6425 | (not (org-at-table-hline-p))) |
| 6406 | t | 6426 | t |
| 6407 | (let ((col (current-column)) | 6427 | (let ((col (current-column)) |
| 6408 | (end (org-table-end))) | 6428 | (end (org-table-end))) |
| 6409 | (move-to-column col) | 6429 | (move-to-column col) |
| 6410 | (while (and (< (point) end) | 6430 | (while (and (< (point) end) |
| 6411 | (or (not (= (current-column) col)) | 6431 | (or (not (= (current-column) col)) |
| 6412 | (org-at-table-hline-p))) | 6432 | (org-at-table-hline-p))) |
| 6413 | (beginning-of-line 2) | 6433 | (beginning-of-line 2) |
| 6414 | (move-to-column col)) | 6434 | (move-to-column col)) |
| 6415 | (if (and (org-at-table-p) | 6435 | (if (and (org-at-table-p) |
| 6416 | (not (org-at-table-hline-p))) | 6436 | (not (org-at-table-hline-p))) |
| 6417 | t | 6437 | t |
| 6418 | (error | 6438 | (error |
| 6419 | "Please position cursor in a data line for column operations"))))) | 6439 | "Please position cursor in a data line for column operations"))))) |
| 6420 | 6440 | ||
| 6421 | (defun org-table-delete-column () | 6441 | (defun org-table-delete-column () |
| 6422 | "Delete a column into the table." | 6442 | "Delete a column into the table." |
| @@ -6426,18 +6446,18 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." | |||
| 6426 | (org-table-find-dataline) | 6446 | (org-table-find-dataline) |
| 6427 | (org-table-check-inside-data-field) | 6447 | (org-table-check-inside-data-field) |
| 6428 | (let* ((col (org-table-current-column)) | 6448 | (let* ((col (org-table-current-column)) |
| 6429 | (beg (org-table-begin)) | 6449 | (beg (org-table-begin)) |
| 6430 | (end (org-table-end)) | 6450 | (end (org-table-end)) |
| 6431 | ;; Current cursor position | 6451 | ;; Current cursor position |
| 6432 | (linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point)))) | 6452 | (linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point)))) |
| 6433 | (colpos col)) | 6453 | (colpos col)) |
| 6434 | (goto-char beg) | 6454 | (goto-char beg) |
| 6435 | (while (< (point) end) | 6455 | (while (< (point) end) |
| 6436 | (if (org-at-table-hline-p) | 6456 | (if (org-at-table-hline-p) |
| 6437 | nil | 6457 | nil |
| 6438 | (org-table-goto-column col t) | 6458 | (org-table-goto-column col t) |
| 6439 | (and (looking-at "|[^|\n]+|") | 6459 | (and (looking-at "|[^|\n]+|") |
| 6440 | (replace-match "|"))) | 6460 | (replace-match "|"))) |
| 6441 | (beginning-of-line 2)) | 6461 | (beginning-of-line 2)) |
| 6442 | (move-marker end nil) | 6462 | (move-marker end nil) |
| 6443 | (goto-line linepos) | 6463 | (goto-line linepos) |
| @@ -6462,23 +6482,23 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." | |||
| 6462 | (org-table-find-dataline) | 6482 | (org-table-find-dataline) |
| 6463 | (org-table-check-inside-data-field) | 6483 | (org-table-check-inside-data-field) |
| 6464 | (let* ((col (org-table-current-column)) | 6484 | (let* ((col (org-table-current-column)) |
| 6465 | (col1 (if left (1- col) col)) | 6485 | (col1 (if left (1- col) col)) |
| 6466 | (beg (org-table-begin)) | 6486 | (beg (org-table-begin)) |
| 6467 | (end (org-table-end)) | 6487 | (end (org-table-end)) |
| 6468 | ;; Current cursor position | 6488 | ;; Current cursor position |
| 6469 | (linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point)))) | 6489 | (linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point)))) |
| 6470 | (colpos (if left (1- col) (1+ col)))) | 6490 | (colpos (if left (1- col) (1+ col)))) |
| 6471 | (if (and left (= col 1)) | 6491 | (if (and left (= col 1)) |
| 6472 | (error "Cannot move column further left")) | 6492 | (error "Cannot move column further left")) |
| 6473 | (if (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) | 6493 | (if (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) |
| 6474 | (error "Cannot move column further right")) | 6494 | (error "Cannot move column further right")) |
| 6475 | (goto-char beg) | 6495 | (goto-char beg) |
| 6476 | (while (< (point) end) | 6496 | (while (< (point) end) |
| 6477 | (if (org-at-table-hline-p) | 6497 | (if (org-at-table-hline-p) |
| 6478 | nil | 6498 | nil |
| 6479 | (org-table-goto-column col1 t) | 6499 | (org-table-goto-column col1 t) |
| 6480 | (and (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|") | 6500 | (and (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|") |
| 6481 | (replace-match "|\\2|\\1|"))) | 6501 | (replace-match "|\\2|\\1|"))) |
| 6482 | (beginning-of-line 2)) | 6502 | (beginning-of-line 2)) |
| 6483 | (move-marker end nil) | 6503 | (move-marker end nil) |
| 6484 | (goto-line linepos) | 6504 | (goto-line linepos) |
| @@ -6487,11 +6507,11 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." | |||
| 6487 | (org-table-modify-formulas 'swap col (if left (1- col) (1+ col))))) | 6507 | (org-table-modify-formulas 'swap col (if left (1- col) (1+ col))))) |
| 6488 | 6508 | ||
| 6489 | (defun org-table-move-row-down () | 6509 | (defun org-table-move-row-down () |
| 6490 | "Move table row down." | 6510 | "move table row down." |
| 6491 | (interactive) | 6511 | (interactive) |
| 6492 | (org-table-move-row nil)) | 6512 | (org-table-move-row nil)) |
| 6493 | (defun org-table-move-row-up () | 6513 | (defun org-table-move-row-up () |
| 6494 | "Move table row up." | 6514 | "move table row up." |
| 6495 | (interactive) | 6515 | (interactive) |
| 6496 | (org-table-move-row 'up)) | 6516 | (org-table-move-row 'up)) |
| 6497 | 6517 | ||
| @@ -6499,14 +6519,14 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." | |||
| 6499 | "Move the current table line down. With arg UP, move it up." | 6519 | "Move the current table line down. With arg UP, move it up." |
| 6500 | (interactive "P") | 6520 | (interactive "P") |
| 6501 | (let ((col (current-column)) | 6521 | (let ((col (current-column)) |
| 6502 | (pos (point)) | 6522 | (pos (point)) |
| 6503 | (tonew (if up 0 2)) | 6523 | (tonew (if up 0 2)) |
| 6504 | txt) | 6524 | txt) |
| 6505 | (beginning-of-line tonew) | 6525 | (beginning-of-line tonew) |
| 6506 | (if (not (org-at-table-p)) | 6526 | (if (not (org-at-table-p)) |
| 6507 | (progn | 6527 | (progn |
| 6508 | (goto-char pos) | 6528 | (goto-char pos) |
| 6509 | (error "Cannot move row further"))) | 6529 | (error "Cannot move row further"))) |
| 6510 | (goto-char pos) | 6530 | (goto-char pos) |
| 6511 | (beginning-of-line 1) | 6531 | (beginning-of-line 1) |
| 6512 | (setq pos (point)) | 6532 | (setq pos (point)) |
| @@ -6524,14 +6544,14 @@ With prefix ARG, insert below the current line." | |||
| 6524 | (if (not (org-at-table-p)) | 6544 | (if (not (org-at-table-p)) |
| 6525 | (error "Not at a table")) | 6545 | (error "Not at a table")) |
| 6526 | (let* ((line (buffer-substring-no-properties (point-at-bol) (point-at-eol))) | 6546 | (let* ((line (buffer-substring-no-properties (point-at-bol) (point-at-eol))) |
| 6527 | new) | 6547 | new) |
| 6528 | (if (string-match "^[ \t]*|-" line) | 6548 | (if (string-match "^[ \t]*|-" line) |
| 6529 | (setq new (mapcar (lambda (x) (if (member x '(?| ?+)) ?| ?\ )) line)) | 6549 | (setq new (mapcar (lambda (x) (if (member x '(?| ?+)) ?| ?\ )) line)) |
| 6530 | (setq new (mapcar (lambda (x) (if (equal x ?|) ?| ?\ )) line))) | 6550 | (setq new (mapcar (lambda (x) (if (equal x ?|) ?| ?\ )) line))) |
| 6531 | ;; Fix the first field if necessary | 6551 | ;; Fix the first field if necessary |
| 6532 | (setq new (concat new)) | 6552 | (setq new (concat new)) |
| 6533 | (if (string-match "^[ \t]*| *[#$] *|" line) | 6553 | (if (string-match "^[ \t]*| *[#$] *|" line) |
| 6534 | (setq new (replace-match (match-string 0 line) t t new))) | 6554 | (setq new (replace-match (match-string 0 line) t t new))) |
| 6535 | (beginning-of-line (if arg 2 1)) | 6555 | (beginning-of-line (if arg 2 1)) |
| 6536 | (let (org-table-may-need-update) | 6556 | (let (org-table-may-need-update) |
| 6537 | (insert-before-markers new) | 6557 | (insert-before-markers new) |
| @@ -6547,23 +6567,23 @@ With prefix ARG, insert above the current line." | |||
| 6547 | (if (not (org-at-table-p)) | 6567 | (if (not (org-at-table-p)) |
| 6548 | (error "Not at a table")) | 6568 | (error "Not at a table")) |
| 6549 | (let ((line (buffer-substring-no-properties (point-at-bol) (point-at-eol))) | 6569 | (let ((line (buffer-substring-no-properties (point-at-bol) (point-at-eol))) |
| 6550 | (col (current-column)) | 6570 | (col (current-column)) |
| 6551 | start) | 6571 | start) |
| 6552 | (if (string-match "^[ \t]*|-" line) | 6572 | (if (string-match "^[ \t]*|-" line) |
| 6553 | (setq line | 6573 | (setq line |
| 6554 | (mapcar (lambda (x) (if (member x '(?| ?+)) | 6574 | (mapcar (lambda (x) (if (member x '(?| ?+)) |
| 6555 | (prog1 (if start ?+ ?|) (setq start t)) | 6575 | (prog1 (if start ?+ ?|) (setq start t)) |
| 6556 | (if start ?- ?\ ))) | 6576 | (if start ?- ?\ ))) |
| 6557 | line)) | 6577 | line)) |
| 6558 | (setq line | 6578 | (setq line |
| 6559 | (mapcar (lambda (x) (if (equal x ?|) | 6579 | (mapcar (lambda (x) (if (equal x ?|) |
| 6560 | (prog1 (if start ?+ ?|) (setq start t)) | 6580 | (prog1 (if start ?+ ?|) (setq start t)) |
| 6561 | (if start ?- ?\ ))) | 6581 | (if start ?- ?\ ))) |
| 6562 | line))) | 6582 | line))) |
| 6563 | (beginning-of-line (if arg 1 2)) | 6583 | (beginning-of-line (if arg 1 2)) |
| 6564 | (apply 'insert line) | 6584 | (apply 'insert line) |
| 6565 | (if (equal (char-before (point)) ?+) | 6585 | (if (equal (char-before (point)) ?+) |
| 6566 | (progn (backward-delete-char 1) (insert "|"))) | 6586 | (progn (backward-delete-char 1) (insert "|"))) |
| 6567 | (insert "\n") | 6587 | (insert "\n") |
| 6568 | (beginning-of-line 0) | 6588 | (beginning-of-line 0) |
| 6569 | (move-to-column col))) | 6589 | (move-to-column col))) |
| @@ -6587,33 +6607,33 @@ With prefix ARG, insert above the current line." | |||
| 6587 | (defun org-table-copy-region (beg end &optional cut) | 6607 | (defun org-table-copy-region (beg end &optional cut) |
| 6588 | "Copy rectangular region in table to clipboard. | 6608 | "Copy rectangular region in table to clipboard. |
| 6589 | A special clipboard is used which can only be accessed | 6609 | A special clipboard is used which can only be accessed |
| 6590 | with `org-table-paste-rectangle'." | 6610 | with `org-table-paste-rectangle'" |
| 6591 | (interactive "rP") | 6611 | (interactive "rP") |
| 6592 | (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2 | 6612 | (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2 |
| 6593 | region cols | 6613 | region cols |
| 6594 | (rpl (if cut " " nil))) | 6614 | (rpl (if cut " " nil))) |
| 6595 | (goto-char beg) | 6615 | (goto-char beg) |
| 6596 | (org-table-check-inside-data-field) | 6616 | (org-table-check-inside-data-field) |
| 6597 | (setq l01 (count-lines (point-min) (point)) | 6617 | (setq l01 (count-lines (point-min) (point)) |
| 6598 | c01 (org-table-current-column)) | 6618 | c01 (org-table-current-column)) |
| 6599 | (goto-char end) | 6619 | (goto-char end) |
| 6600 | (org-table-check-inside-data-field) | 6620 | (org-table-check-inside-data-field) |
| 6601 | (setq l02 (count-lines (point-min) (point)) | 6621 | (setq l02 (count-lines (point-min) (point)) |
| 6602 | c02 (org-table-current-column)) | 6622 | c02 (org-table-current-column)) |
| 6603 | (setq l1 (min l01 l02) l2 (max l01 l02) | 6623 | (setq l1 (min l01 l02) l2 (max l01 l02) |
| 6604 | c1 (min c01 c02) c2 (max c01 c02)) | 6624 | c1 (min c01 c02) c2 (max c01 c02)) |
| 6605 | (catch 'exit | 6625 | (catch 'exit |
| 6606 | (while t | 6626 | (while t |
| 6607 | (catch 'nextline | 6627 | (catch 'nextline |
| 6608 | (if (> l1 l2) (throw 'exit t)) | 6628 | (if (> l1 l2) (throw 'exit t)) |
| 6609 | (goto-line l1) | 6629 | (goto-line l1) |
| 6610 | (if (org-at-table-hline-p) (throw 'nextline (setq l1 (1+ l1)))) | 6630 | (if (org-at-table-hline-p) (throw 'nextline (setq l1 (1+ l1)))) |
| 6611 | (setq cols nil ic1 c1 ic2 c2) | 6631 | (setq cols nil ic1 c1 ic2 c2) |
| 6612 | (while (< ic1 (1+ ic2)) | 6632 | (while (< ic1 (1+ ic2)) |
| 6613 | (push (org-table-get-field ic1 rpl) cols) | 6633 | (push (org-table-get-field ic1 rpl) cols) |
| 6614 | (setq ic1 (1+ ic1))) | 6634 | (setq ic1 (1+ ic1))) |
| 6615 | (push (nreverse cols) region) | 6635 | (push (nreverse cols) region) |
| 6616 | (setq l1 (1+ l1))))) | 6636 | (setq l1 (1+ l1))))) |
| 6617 | (setq org-table-clip (nreverse region)) | 6637 | (setq org-table-clip (nreverse region)) |
| 6618 | (if cut (org-table-align)) | 6638 | (if cut (org-table-align)) |
| 6619 | org-table-clip)) | 6639 | org-table-clip)) |
| @@ -6629,20 +6649,20 @@ lines." | |||
| 6629 | (error "First cut/copy a region to paste!")) | 6649 | (error "First cut/copy a region to paste!")) |
| 6630 | (org-table-check-inside-data-field) | 6650 | (org-table-check-inside-data-field) |
| 6631 | (let* ((clip org-table-clip) | 6651 | (let* ((clip org-table-clip) |
| 6632 | (line (count-lines (point-min) (point))) | 6652 | (line (count-lines (point-min) (point))) |
| 6633 | (col (org-table-current-column)) | 6653 | (col (org-table-current-column)) |
| 6634 | (org-enable-table-editor t) | 6654 | (org-enable-table-editor t) |
| 6635 | (org-table-automatic-realign nil) | 6655 | (org-table-automatic-realign nil) |
| 6636 | c cols field) | 6656 | c cols field) |
| 6637 | (while (setq cols (pop clip)) | 6657 | (while (setq cols (pop clip)) |
| 6638 | (while (org-at-table-hline-p) (beginning-of-line 2)) | 6658 | (while (org-at-table-hline-p) (beginning-of-line 2)) |
| 6639 | (if (not (org-at-table-p)) | 6659 | (if (not (org-at-table-p)) |
| 6640 | (progn (end-of-line 0) (org-table-next-field))) | 6660 | (progn (end-of-line 0) (org-table-next-field))) |
| 6641 | (setq c col) | 6661 | (setq c col) |
| 6642 | (while (setq field (pop cols)) | 6662 | (while (setq field (pop cols)) |
| 6643 | (org-table-goto-column c nil 'force) | 6663 | (org-table-goto-column c nil 'force) |
| 6644 | (org-table-get-field nil field) | 6664 | (org-table-get-field nil field) |
| 6645 | (setq c (1+ c))) | 6665 | (setq c (1+ c))) |
| 6646 | (beginning-of-line 2)) | 6666 | (beginning-of-line 2)) |
| 6647 | (goto-line line) | 6667 | (goto-line line) |
| 6648 | (org-table-goto-column col) | 6668 | (org-table-goto-column col) |
| @@ -6662,35 +6682,35 @@ blindly applies a recipe that works for simple tables." | |||
| 6662 | (if (org-at-table.el-p) | 6682 | (if (org-at-table.el-p) |
| 6663 | ;; convert to Org-mode table | 6683 | ;; convert to Org-mode table |
| 6664 | (let ((beg (move-marker (make-marker) (org-table-begin t))) | 6684 | (let ((beg (move-marker (make-marker) (org-table-begin t))) |
| 6665 | (end (move-marker (make-marker) (org-table-end t)))) | 6685 | (end (move-marker (make-marker) (org-table-end t)))) |
| 6666 | (table-unrecognize-region beg end) | 6686 | (table-unrecognize-region beg end) |
| 6667 | (goto-char beg) | 6687 | (goto-char beg) |
| 6668 | (while (re-search-forward "^\\([ \t]*\\)\\+-.*\n" end t) | 6688 | (while (re-search-forward "^\\([ \t]*\\)\\+-.*\n" end t) |
| 6669 | (replace-match "")) | 6689 | (replace-match "")) |
| 6670 | (goto-char beg)) | 6690 | (goto-char beg)) |
| 6671 | (if (org-at-table-p) | 6691 | (if (org-at-table-p) |
| 6672 | ;; convert to table.el table | 6692 | ;; convert to table.el table |
| 6673 | (let ((beg (move-marker (make-marker) (org-table-begin))) | 6693 | (let ((beg (move-marker (make-marker) (org-table-begin))) |
| 6674 | (end (move-marker (make-marker) (org-table-end)))) | 6694 | (end (move-marker (make-marker) (org-table-end)))) |
| 6675 | ;; first, get rid of all horizontal lines | 6695 | ;; first, get rid of all horizontal lines |
| 6676 | (goto-char beg) | 6696 | (goto-char beg) |
| 6677 | (while (re-search-forward "^\\([ \t]*\\)|-.*\n" end t) | 6697 | (while (re-search-forward "^\\([ \t]*\\)|-.*\n" end t) |
| 6678 | (replace-match "")) | 6698 | (replace-match "")) |
| 6679 | ;; insert a hline before first | 6699 | ;; insert a hline before first |
| 6680 | (goto-char beg) | 6700 | (goto-char beg) |
| 6681 | (org-table-insert-hline 'above) | 6701 | (org-table-insert-hline 'above) |
| 6682 | ;; insert a hline after each line | 6702 | ;; insert a hline after each line |
| 6683 | (while (progn (beginning-of-line 2) (< (point) end)) | 6703 | (while (progn (beginning-of-line 2) (< (point) end)) |
| 6684 | (org-table-insert-hline)) | 6704 | (org-table-insert-hline)) |
| 6685 | (goto-char beg) | 6705 | (goto-char beg) |
| 6686 | (setq end (move-marker end (org-table-end))) | 6706 | (setq end (move-marker end (org-table-end))) |
| 6687 | ;; replace "+" at beginning and ending of hlines | 6707 | ;; replace "+" at beginning and ending of hlines |
| 6688 | (while (re-search-forward "^\\([ \t]*\\)|-" end t) | 6708 | (while (re-search-forward "^\\([ \t]*\\)|-" end t) |
| 6689 | (replace-match "\\1+-")) | 6709 | (replace-match "\\1+-")) |
| 6690 | (goto-char beg) | 6710 | (goto-char beg) |
| 6691 | (while (re-search-forward "-|[ \t]*$" end t) | 6711 | (while (re-search-forward "-|[ \t]*$" end t) |
| 6692 | (replace-match "-+")) | 6712 | (replace-match "-+")) |
| 6693 | (goto-char beg))))) | 6713 | (goto-char beg))))) |
| 6694 | 6714 | ||
| 6695 | (defun org-table-wrap-region (arg) | 6715 | (defun org-table-wrap-region (arg) |
| 6696 | "Wrap several fields in a column like a paragraph. | 6716 | "Wrap several fields in a column like a paragraph. |
| @@ -6719,40 +6739,40 @@ blank, and the content is appended to the field above." | |||
| 6719 | (if (org-region-active-p) | 6739 | (if (org-region-active-p) |
| 6720 | ;; There is a region: fill as a paragraph | 6740 | ;; There is a region: fill as a paragraph |
| 6721 | (let ((beg (region-beginning)) | 6741 | (let ((beg (region-beginning)) |
| 6722 | nlines) | 6742 | nlines) |
| 6723 | (org-table-cut-region (region-beginning) (region-end)) | 6743 | (org-table-cut-region (region-beginning) (region-end)) |
| 6724 | (if (> (length (car org-table-clip)) 1) | 6744 | (if (> (length (car org-table-clip)) 1) |
| 6725 | (error "Region must be limited to single column")) | 6745 | (error "Region must be limited to single column")) |
| 6726 | (setq nlines (if arg | 6746 | (setq nlines (if arg |
| 6727 | (if (< arg 1) | 6747 | (if (< arg 1) |
| 6728 | (+ (length org-table-clip) arg) | 6748 | (+ (length org-table-clip) arg) |
| 6729 | arg) | 6749 | arg) |
| 6730 | (length org-table-clip))) | 6750 | (length org-table-clip))) |
| 6731 | (setq org-table-clip | 6751 | (setq org-table-clip |
| 6732 | (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ") | 6752 | (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ") |
| 6733 | nil nlines))) | 6753 | nil nlines))) |
| 6734 | (goto-char beg) | 6754 | (goto-char beg) |
| 6735 | (org-table-paste-rectangle)) | 6755 | (org-table-paste-rectangle)) |
| 6736 | ;; No region, split the current field at point | 6756 | ;; No region, split the current field at point |
| 6737 | (if arg | 6757 | (if arg |
| 6738 | ;; combine with field above | 6758 | ;; combine with field above |
| 6739 | (let ((s (org-table-blank-field)) | 6759 | (let ((s (org-table-blank-field)) |
| 6740 | (col (org-table-current-column))) | 6760 | (col (org-table-current-column))) |
| 6741 | (beginning-of-line 0) | 6761 | (beginning-of-line 0) |
| 6742 | (while (org-at-table-hline-p) (beginning-of-line 0)) | 6762 | (while (org-at-table-hline-p) (beginning-of-line 0)) |
| 6743 | (org-table-goto-column col) | 6763 | (org-table-goto-column col) |
| 6744 | (skip-chars-forward "^|") | 6764 | (skip-chars-forward "^|") |
| 6745 | (skip-chars-backward " ") | 6765 | (skip-chars-backward " ") |
| 6746 | (insert " " (org-trim s)) | 6766 | (insert " " (org-trim s)) |
| 6747 | (org-table-align)) | 6767 | (org-table-align)) |
| 6748 | ;; split field | 6768 | ;; split field |
| 6749 | (when (looking-at "\\([^|]+\\)+|") | 6769 | (when (looking-at "\\([^|]+\\)+|") |
| 6750 | (let ((s (match-string 1))) | 6770 | (let ((s (match-string 1))) |
| 6751 | (replace-match " |") | 6771 | (replace-match " |") |
| 6752 | (goto-char (match-beginning 0)) | 6772 | (goto-char (match-beginning 0)) |
| 6753 | (org-table-next-row) | 6773 | (org-table-next-row) |
| 6754 | (insert (org-trim s) " ") | 6774 | (insert (org-trim s) " ") |
| 6755 | (org-table-align)))))) | 6775 | (org-table-align)))))) |
| 6756 | 6776 | ||
| 6757 | (defun org-trim (s) | 6777 | (defun org-trim (s) |
| 6758 | "Remove whitespace at beginning and end of string." | 6778 | "Remove whitespace at beginning and end of string." |
| @@ -6769,21 +6789,21 @@ IF WIDTH is nil and LINES is non-nil, the string is forced into at most that | |||
| 6769 | many lines, whatever width that takes. | 6789 | many lines, whatever width that takes. |
| 6770 | The return value is a list of lines, without newlines at the end." | 6790 | The return value is a list of lines, without newlines at the end." |
| 6771 | (let* ((words (org-split-string string "[ \t\n]+")) | 6791 | (let* ((words (org-split-string string "[ \t\n]+")) |
| 6772 | (maxword (apply 'max (mapcar 'length words))) | 6792 | (maxword (apply 'max (mapcar 'length words))) |
| 6773 | w ll) | 6793 | w ll) |
| 6774 | (cond (width | 6794 | (cond (width |
| 6775 | (org-do-wrap words (max maxword width))) | 6795 | (org-do-wrap words (max maxword width))) |
| 6776 | (lines | 6796 | (lines |
| 6777 | (setq w maxword) | 6797 | (setq w maxword) |
| 6778 | (setq ll (org-do-wrap words maxword)) | 6798 | (setq ll (org-do-wrap words maxword)) |
| 6779 | (if (<= (length ll) lines) | 6799 | (if (<= (length ll) lines) |
| 6780 | ll | 6800 | ll |
| 6781 | (setq ll words) | 6801 | (setq ll words) |
| 6782 | (while (> (length ll) lines) | 6802 | (while (> (length ll) lines) |
| 6783 | (setq w (1+ w)) | 6803 | (setq w (1+ w)) |
| 6784 | (setq ll (org-do-wrap words w))) | 6804 | (setq ll (org-do-wrap words w))) |
| 6785 | ll)) | 6805 | ll)) |
| 6786 | (t (error "Cannot wrap this"))))) | 6806 | (t (error "Cannot wrap this"))))) |
| 6787 | 6807 | ||
| 6788 | 6808 | ||
| 6789 | (defun org-do-wrap (words width) | 6809 | (defun org-do-wrap (words width) |
| @@ -6792,7 +6812,7 @@ The return value is a list of lines, without newlines at the end." | |||
| 6792 | (while words | 6812 | (while words |
| 6793 | (setq line (pop words)) | 6813 | (setq line (pop words)) |
| 6794 | (while (and words (< (+ (length line) (length (car words))) width)) | 6814 | (while (and words (< (+ (length line) (length (car words))) width)) |
| 6795 | (setq line (concat line " " (pop words)))) | 6815 | (setq line (concat line " " (pop words)))) |
| 6796 | (setq lines (push line lines))) | 6816 | (setq lines (push line lines))) |
| 6797 | (nreverse lines))) | 6817 | (nreverse lines))) |
| 6798 | 6818 | ||
| @@ -6829,40 +6849,40 @@ and end of string." | |||
| 6829 | "Add an `invisible' property to vertical lines of current table." | 6849 | "Add an `invisible' property to vertical lines of current table." |
| 6830 | (interactive) | 6850 | (interactive) |
| 6831 | (let* ((beg (org-table-begin)) | 6851 | (let* ((beg (org-table-begin)) |
| 6832 | (end (org-table-end)) | 6852 | (end (org-table-end)) |
| 6833 | (end1)) | 6853 | (end1)) |
| 6834 | (save-excursion | 6854 | (save-excursion |
| 6835 | (goto-char beg) | 6855 | (goto-char beg) |
| 6836 | (while (< (point) end) | 6856 | (while (< (point) end) |
| 6837 | (setq end1 (point-at-eol)) | 6857 | (setq end1 (point-at-eol)) |
| 6838 | (if (looking-at org-table-dataline-regexp) | 6858 | (if (looking-at org-table-dataline-regexp) |
| 6839 | (while (re-search-forward "|" end1 t) | 6859 | (while (re-search-forward "|" end1 t) |
| 6840 | (add-text-properties (1- (point)) (point) | 6860 | (add-text-properties (1- (point)) (point) |
| 6841 | '(invisible org-table))) | 6861 | '(invisible org-table))) |
| 6842 | (while (re-search-forward "[+|]" end1 t) | 6862 | (while (re-search-forward "[+|]" end1 t) |
| 6843 | (add-text-properties (1- (point)) (point) | 6863 | (add-text-properties (1- (point)) (point) |
| 6844 | '(invisible org-table)))) | 6864 | '(invisible org-table)))) |
| 6845 | (beginning-of-line 2))))) | 6865 | (beginning-of-line 2))))) |
| 6846 | 6866 | ||
| 6847 | (defun org-table-toggle-vline-visibility (&optional arg) | 6867 | (defun org-table-toggle-vline-visibility (&optional arg) |
| 6848 | "Toggle the visibility of table vertical lines. | 6868 | "Toggle the visibility of table vertical lines. |
| 6849 | The effect is immediate and on all tables in the file. | 6869 | The effect is immediate and on all tables in the file. |
| 6850 | With prefix ARG, make lines invisible when ARG is positive, make lines | 6870 | With prefix ARG, make lines invisible when ARG is positive, make lines |
| 6851 | visible when ARG is not positive." | 6871 | visible when ARG is not positive" |
| 6852 | (interactive "P") | 6872 | (interactive "P") |
| 6853 | (let ((action (cond | 6873 | (let ((action (cond |
| 6854 | ((and arg (> (prefix-numeric-value arg) 0)) 'on) | 6874 | ((and arg (> (prefix-numeric-value arg) 0)) 'on) |
| 6855 | ((and arg (< (prefix-numeric-value arg) 1)) 'off) | 6875 | ((and arg (< (prefix-numeric-value arg) 1)) 'off) |
| 6856 | (t (if (org-in-invisibility-spec-p '(org-table)) | 6876 | (t (if (org-in-invisibility-spec-p '(org-table)) |
| 6857 | 'off | 6877 | 'off |
| 6858 | 'on))))) | 6878 | 'on))))) |
| 6859 | (if (eq action 'off) | 6879 | (if (eq action 'off) |
| 6860 | (progn | 6880 | (progn |
| 6861 | (org-remove-from-invisibility-spec '(org-table)) | 6881 | (org-remove-from-invisibility-spec '(org-table)) |
| 6862 | (org-table-map-tables 'org-table-align) | 6882 | (org-table-map-tables 'org-table-align) |
| 6863 | (message "Vertical table lines visible") | 6883 | (message "Vertical table lines visible") |
| 6864 | (if (org-at-table-p) | 6884 | (if (org-at-table-p) |
| 6865 | (org-table-align))) | 6885 | (org-table-align))) |
| 6866 | (org-add-to-invisibility-spec '(org-table)) | 6886 | (org-add-to-invisibility-spec '(org-table)) |
| 6867 | (org-table-map-tables 'org-table-align) | 6887 | (org-table-map-tables 'org-table-align) |
| 6868 | (message "Vertical table lines invisible")) | 6888 | (message "Vertical table lines invisible")) |
| @@ -6875,11 +6895,11 @@ visible when ARG is not positive." | |||
| 6875 | (widen) | 6895 | (widen) |
| 6876 | (goto-char (point-min)) | 6896 | (goto-char (point-min)) |
| 6877 | (while (re-search-forward org-table-any-line-regexp nil t) | 6897 | (while (re-search-forward org-table-any-line-regexp nil t) |
| 6878 | (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size))) | 6898 | (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size))) |
| 6879 | (beginning-of-line 1) | 6899 | (beginning-of-line 1) |
| 6880 | (if (looking-at org-table-line-regexp) | 6900 | (if (looking-at org-table-line-regexp) |
| 6881 | (save-excursion (funcall function))) | 6901 | (save-excursion (funcall function))) |
| 6882 | (re-search-forward org-table-any-border-regexp nil 1))))) | 6902 | (re-search-forward org-table-any-border-regexp nil 1))))) |
| 6883 | 6903 | ||
| 6884 | (defun org-table-sum (&optional beg end nlast) | 6904 | (defun org-table-sum (&optional beg end nlast) |
| 6885 | "Sum numbers in region of current table column. | 6905 | "Sum numbers in region of current table column. |
| @@ -6902,61 +6922,61 @@ If NLAST is a number, only the NLAST fields will actually be summed." | |||
| 6902 | (cond | 6922 | (cond |
| 6903 | ((and beg end)) ; beg and end given explicitly | 6923 | ((and beg end)) ; beg and end given explicitly |
| 6904 | ((org-region-active-p) | 6924 | ((org-region-active-p) |
| 6905 | (setq beg (region-beginning) end (region-end))) | 6925 | (setq beg (region-beginning) end (region-end))) |
| 6906 | (t | 6926 | (t |
| 6907 | (setq col (org-table-current-column)) | 6927 | (setq col (org-table-current-column)) |
| 6908 | (goto-char (org-table-begin)) | 6928 | (goto-char (org-table-begin)) |
| 6909 | (unless (re-search-forward "^[ \t]*|[^-]" nil t) | 6929 | (unless (re-search-forward "^[ \t]*|[^-]" nil t) |
| 6910 | (error "No table data")) | 6930 | (error "No table data")) |
| 6911 | (org-table-goto-column col) | 6931 | (org-table-goto-column col) |
| 6912 | ;not needed? (skip-chars-backward "^|") | 6932 | ;not needed? (skip-chars-backward "^|") |
| 6913 | (setq beg (point)) | 6933 | (setq beg (point)) |
| 6914 | (goto-char (org-table-end)) | 6934 | (goto-char (org-table-end)) |
| 6915 | (unless (re-search-backward "^[ \t]*|[^-]" nil t) | 6935 | (unless (re-search-backward "^[ \t]*|[^-]" nil t) |
| 6916 | (error "No table data")) | 6936 | (error "No table data")) |
| 6917 | (org-table-goto-column col) | 6937 | (org-table-goto-column col) |
| 6918 | ;not needed? (skip-chars-forward "^|") | 6938 | ;not needed? (skip-chars-forward "^|") |
| 6919 | (setq end (point)))) | 6939 | (setq end (point)))) |
| 6920 | (let* ((items (apply 'append (org-table-copy-region beg end))) | 6940 | (let* ((items (apply 'append (org-table-copy-region beg end))) |
| 6921 | (items1 (cond ((not nlast) items) | 6941 | (items1 (cond ((not nlast) items) |
| 6922 | ((>= nlast (length items)) items) | 6942 | ((>= nlast (length items)) items) |
| 6923 | (t (setq items (reverse items)) | 6943 | (t (setq items (reverse items)) |
| 6924 | (setcdr (nthcdr (1- nlast) items) nil) | 6944 | (setcdr (nthcdr (1- nlast) items) nil) |
| 6925 | (nreverse items)))) | 6945 | (nreverse items)))) |
| 6926 | (numbers (delq nil (mapcar 'org-table-get-number-for-summing | 6946 | (numbers (delq nil (mapcar 'org-table-get-number-for-summing |
| 6927 | items1))) | 6947 | items1))) |
| 6928 | (res (apply '+ numbers)) | 6948 | (res (apply '+ numbers)) |
| 6929 | (sres (if (= timecnt 0) | 6949 | (sres (if (= timecnt 0) |
| 6930 | (format "%g" res) | 6950 | (format "%g" res) |
| 6931 | (setq diff (* 3600 res) | 6951 | (setq diff (* 3600 res) |
| 6932 | h (floor (/ diff 3600)) diff (mod diff 3600) | 6952 | h (floor (/ diff 3600)) diff (mod diff 3600) |
| 6933 | m (floor (/ diff 60)) diff (mod diff 60) | 6953 | m (floor (/ diff 60)) diff (mod diff 60) |
| 6934 | s diff) | 6954 | s diff) |
| 6935 | (format "%d:%02d:%02d" h m s)))) | 6955 | (format "%d:%02d:%02d" h m s)))) |
| 6936 | (kill-new sres) | 6956 | (kill-new sres) |
| 6937 | (if (interactive-p) | 6957 | (if (interactive-p) |
| 6938 | (message (substitute-command-keys | 6958 | (message (substitute-command-keys |
| 6939 | (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)" | 6959 | (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)" |
| 6940 | (length numbers) sres)))) | 6960 | (length numbers) sres)))) |
| 6941 | sres)))) | 6961 | sres)))) |
| 6942 | 6962 | ||
| 6943 | (defun org-table-get-number-for-summing (s) | 6963 | (defun org-table-get-number-for-summing (s) |
| 6944 | (let (n) | 6964 | (let (n) |
| 6945 | (if (string-match "^ *|? *" s) | 6965 | (if (string-match "^ *|? *" s) |
| 6946 | (setq s (replace-match "" nil nil s))) | 6966 | (setq s (replace-match "" nil nil s))) |
| 6947 | (if (string-match " *|? *$" s) | 6967 | (if (string-match " *|? *$" s) |
| 6948 | (setq s (replace-match "" nil nil s))) | 6968 | (setq s (replace-match "" nil nil s))) |
| 6949 | (setq n (string-to-number s)) | 6969 | (setq n (string-to-number s)) |
| 6950 | (cond | 6970 | (cond |
| 6951 | ((and (string-match "0" s) | 6971 | ((and (string-match "0" s) |
| 6952 | (string-match "\\`[-+ \t0.edED]+\\'" s)) 0) | 6972 | (string-match "\\`[-+ \t0.edED]+\\'" s)) 0) |
| 6953 | ((string-match "\\`[ \t]+\\'" s) nil) | 6973 | ((string-match "\\`[ \t]+\\'" s) nil) |
| 6954 | ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?\\'" s) | 6974 | ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?\\'" s) |
| 6955 | (let ((h (string-to-number (or (match-string 1 s) "0"))) | 6975 | (let ((h (string-to-number (or (match-string 1 s) "0"))) |
| 6956 | (m (string-to-number (or (match-string 2 s) "0"))) | 6976 | (m (string-to-number (or (match-string 2 s) "0"))) |
| 6957 | (s (string-to-number (or (match-string 4 s) "0")))) | 6977 | (s (string-to-number (or (match-string 4 s) "0")))) |
| 6958 | (if (boundp 'timecnt) (setq timecnt (1+ timecnt))) | 6978 | (if (boundp 'timecnt) (setq timecnt (1+ timecnt))) |
| 6959 | (* 1.0 (+ h (/ m 60.0) (/ s 3600.0))))) | 6979 | (* 1.0 (+ h (/ m 60.0) (/ s 3600.0))))) |
| 6960 | ((equal n 0) nil) | 6980 | ((equal n 0) nil) |
| 6961 | (t n)))) | 6981 | (t n)))) |
| 6962 | 6982 | ||
| @@ -6965,25 +6985,26 @@ If NLAST is a number, only the NLAST fields will actually be summed." | |||
| 6965 | (defun org-table-get-formula (&optional equation) | 6985 | (defun org-table-get-formula (&optional equation) |
| 6966 | "Read a formula from the minibuffer, offer stored formula as default." | 6986 | "Read a formula from the minibuffer, offer stored formula as default." |
| 6967 | (let* ((col (org-table-current-column)) | 6987 | (let* ((col (org-table-current-column)) |
| 6968 | (stored-list (org-table-get-stored-formulas)) | 6988 | (org-table-may-need-update nil) |
| 6969 | (stored (cdr (assoc col stored-list))) | 6989 | (stored-list (org-table-get-stored-formulas)) |
| 6970 | (eq (cond | 6990 | (stored (cdr (assoc col stored-list))) |
| 6971 | ((and stored equation (string-match "^ *= *$" equation)) | 6991 | (eq (cond |
| 6972 | stored) | 6992 | ((and stored equation (string-match "^ *= *$" equation)) |
| 6973 | ((stringp equation) | 6993 | stored) |
| 6974 | equation) | 6994 | ((stringp equation) |
| 6975 | (t (read-string | 6995 | equation) |
| 6976 | "Formula: " (or stored "") 'org-table-formula-history | 6996 | (t (read-string |
| 6977 | stored))))) | 6997 | "Formula: " (or stored "") 'org-table-formula-history |
| 6998 | stored))))) | ||
| 6978 | (if (not (string-match "\\S-" eq)) | 6999 | (if (not (string-match "\\S-" eq)) |
| 6979 | (error "Empty formula")) | 7000 | (error "Empty formula")) |
| 6980 | (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq))) | 7001 | (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq))) |
| 6981 | (if (string-match " *$" eq) (setq eq (replace-match "" t t eq))) | 7002 | (if (string-match " *$" eq) (setq eq (replace-match "" t t eq))) |
| 6982 | (if stored | 7003 | (if stored |
| 6983 | (setcdr (assoc col stored-list) eq) | 7004 | (setcdr (assoc col stored-list) eq) |
| 6984 | (setq stored-list (cons (cons col eq) stored-list))) | 7005 | (setq stored-list (cons (cons col eq) stored-list))) |
| 6985 | (if (not (equal stored eq)) | 7006 | (if (not (equal stored eq)) |
| 6986 | (org-table-store-formulas stored-list)) | 7007 | (org-table-store-formulas stored-list)) |
| 6987 | eq)) | 7008 | eq)) |
| 6988 | 7009 | ||
| 6989 | (defun org-table-store-formulas (alist) | 7010 | (defun org-table-store-formulas (alist) |
| @@ -6992,26 +7013,26 @@ If NLAST is a number, only the NLAST fields will actually be summed." | |||
| 6992 | (save-excursion | 7013 | (save-excursion |
| 6993 | (goto-char (org-table-end)) | 7014 | (goto-char (org-table-end)) |
| 6994 | (if (looking-at "\\([ \t]*\n\\)*#\\+TBLFM:.*\n?") | 7015 | (if (looking-at "\\([ \t]*\n\\)*#\\+TBLFM:.*\n?") |
| 6995 | (delete-region (point) (match-end 0))) | 7016 | (delete-region (point) (match-end 0))) |
| 6996 | (insert "#+TBLFM: " | 7017 | (insert "#+TBLFM: " |
| 6997 | (mapconcat (lambda (x) | 7018 | (mapconcat (lambda (x) |
| 6998 | (concat "$" (int-to-string (car x)) "=" (cdr x))) | 7019 | (concat "$" (int-to-string (car x)) "=" (cdr x))) |
| 6999 | alist "::") | 7020 | alist "::") |
| 7000 | "\n"))) | 7021 | "\n"))) |
| 7001 | 7022 | ||
| 7002 | (defun org-table-get-stored-formulas () | 7023 | (defun org-table-get-stored-formulas () |
| 7003 | "Return an alist with the stored formulas directly after current table." | 7024 | "Return an alist withh the t=stored formulas directly after current table." |
| 7004 | (interactive) | 7025 | (interactive) |
| 7005 | (let (col eq eq-alist strings string) | 7026 | (let (col eq eq-alist strings string) |
| 7006 | (save-excursion | 7027 | (save-excursion |
| 7007 | (goto-char (org-table-end)) | 7028 | (goto-char (org-table-end)) |
| 7008 | (when (looking-at "\\([ \t]*\n\\)*#\\+TBLFM: *\\(.*\\)") | 7029 | (when (looking-at "\\([ \t]*\n\\)*#\\+TBLFM: *\\(.*\\)") |
| 7009 | (setq strings (org-split-string (match-string 2) " *:: *")) | 7030 | (setq strings (org-split-string (match-string 2) " *:: *")) |
| 7010 | (while (setq string (pop strings)) | 7031 | (while (setq string (pop strings)) |
| 7011 | (if (string-match "\\$\\([0-9]+\\) *= *\\(.*[^ \t]\\)" string) | 7032 | (if (string-match "\\$\\([0-9]+\\) *= *\\(.*[^ \t]\\)" string) |
| 7012 | (setq col (string-to-number (match-string 1 string)) | 7033 | (setq col (string-to-number (match-string 1 string)) |
| 7013 | eq (match-string 2 string) | 7034 | eq (match-string 2 string) |
| 7014 | eq-alist (cons (cons col eq) eq-alist)))))) | 7035 | eq-alist (cons (cons col eq) eq-alist)))))) |
| 7015 | eq-alist)) | 7036 | eq-alist)) |
| 7016 | 7037 | ||
| 7017 | (defun org-table-modify-formulas (action &rest columns) | 7038 | (defun org-table-modify-formulas (action &rest columns) |
| @@ -7019,9 +7040,9 @@ If NLAST is a number, only the NLAST fields will actually be summed." | |||
| 7019 | ACTION can be `remove', `insert', `swap'. For `swap', two column numbers are | 7040 | ACTION can be `remove', `insert', `swap'. For `swap', two column numbers are |
| 7020 | expected, for the other action only a single column number is needed." | 7041 | expected, for the other action only a single column number is needed." |
| 7021 | (let ((list (org-table-get-stored-formulas)) | 7042 | (let ((list (org-table-get-stored-formulas)) |
| 7022 | (nmax (length (org-split-string (buffer-substring (point-at-bol) (point-at-eol)) | 7043 | (nmax (length (org-split-string (buffer-substring (point-at-bol) (point-at-eol)) |
| 7023 | "|"))) | 7044 | "|"))) |
| 7024 | col col1 col2) | 7045 | col col1 col2) |
| 7025 | (cond | 7046 | (cond |
| 7026 | ((null list)) ; No action needed if there are no stored formulas | 7047 | ((null list)) ; No action needed if there are no stored formulas |
| 7027 | ((eq action 'remove) | 7048 | ((eq action 'remove) |
| @@ -7029,13 +7050,13 @@ expected, for the other action only a single column number is needed." | |||
| 7029 | (org-table-replace-in-formulas list col "INVALID") | 7050 | (org-table-replace-in-formulas list col "INVALID") |
| 7030 | (if (assoc col list) (setq list (delq (assoc col list) list))) | 7051 | (if (assoc col list) (setq list (delq (assoc col list) list))) |
| 7031 | (loop for i from (1+ col) upto nmax by 1 do | 7052 | (loop for i from (1+ col) upto nmax by 1 do |
| 7032 | (org-table-replace-in-formulas list i (1- i)) | 7053 | (org-table-replace-in-formulas list i (1- i)) |
| 7033 | (if (assoc i list) (setcar (assoc i list) (1- i))))) | 7054 | (if (assoc i list) (setcar (assoc i list) (1- i))))) |
| 7034 | ((eq action 'insert) | 7055 | ((eq action 'insert) |
| 7035 | (setq col (car columns)) | 7056 | (setq col (car columns)) |
| 7036 | (loop for i from nmax downto col by 1 do | 7057 | (loop for i from nmax downto col by 1 do |
| 7037 | (org-table-replace-in-formulas list i (1+ i)) | 7058 | (org-table-replace-in-formulas list i (1+ i)) |
| 7038 | (if (assoc i list) (setcar (assoc i list) (1+ i))))) | 7059 | (if (assoc i list) (setcar (assoc i list) (1+ i))))) |
| 7039 | ((eq action 'swap) | 7060 | ((eq action 'swap) |
| 7040 | (setq col1 (car columns) col2 (nth 1 columns)) | 7061 | (setq col1 (car columns) col2 (nth 1 columns)) |
| 7041 | (org-table-replace-in-formulas list col1 "Z") | 7062 | (org-table-replace-in-formulas list col1 "Z") |
| @@ -7050,12 +7071,12 @@ expected, for the other action only a single column number is needed." | |||
| 7050 | (defun org-table-replace-in-formulas (list s1 s2) | 7071 | (defun org-table-replace-in-formulas (list s1 s2) |
| 7051 | (let (elt re s) | 7072 | (let (elt re s) |
| 7052 | (setq s1 (concat "$" (if (integerp s1) (int-to-string s1) s1)) | 7073 | (setq s1 (concat "$" (if (integerp s1) (int-to-string s1) s1)) |
| 7053 | s2 (concat "$" (if (integerp s2) (int-to-string s2) s2)) | 7074 | s2 (concat "$" (if (integerp s2) (int-to-string s2) s2)) |
| 7054 | re (concat (regexp-quote s1) "\\>")) | 7075 | re (concat (regexp-quote s1) "\\>")) |
| 7055 | (while (setq elt (pop list)) | 7076 | (while (setq elt (pop list)) |
| 7056 | (setq s (cdr elt)) | 7077 | (setq s (cdr elt)) |
| 7057 | (while (string-match re s) | 7078 | (while (string-match re s) |
| 7058 | (setq s (replace-match s2 t t s))) | 7079 | (setq s (replace-match s2 t t s))) |
| 7059 | (setcdr elt s)))) | 7080 | (setcdr elt s)))) |
| 7060 | 7081 | ||
| 7061 | (defvar org-table-column-names nil | 7082 | (defvar org-table-column-names nil |
| @@ -7066,36 +7087,49 @@ expected, for the other action only a single column number is needed." | |||
| 7066 | "Alist with parameter names, derived from the `$' line.") | 7087 | "Alist with parameter names, derived from the `$' line.") |
| 7067 | 7088 | ||
| 7068 | (defun org-table-get-specials () | 7089 | (defun org-table-get-specials () |
| 7069 | "Get the column names and local parameters for this table." | 7090 | "Get the column nmaes and local parameters for this table." |
| 7070 | (save-excursion | 7091 | (save-excursion |
| 7071 | (let ((beg (org-table-begin)) (end (org-table-end)) | 7092 | (let ((beg (org-table-begin)) (end (org-table-end)) |
| 7072 | names name fields field cnt) | 7093 | names name fields fields1 field cnt c v) |
| 7073 | (setq org-table-column-names nil | 7094 | (setq org-table-column-names nil |
| 7074 | org-table-local-parameters nil) | 7095 | org-table-local-parameters nil) |
| 7075 | (goto-char beg) | 7096 | (goto-char beg) |
| 7076 | (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t) | 7097 | (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t) |
| 7077 | (setq names (org-split-string (match-string 1) " *| *") | 7098 | (setq names (org-split-string (match-string 1) " *| *") |
| 7078 | cnt 1) | 7099 | cnt 1) |
| 7079 | (while (setq name (pop names)) | 7100 | (while (setq name (pop names)) |
| 7080 | (setq cnt (1+ cnt)) | 7101 | (setq cnt (1+ cnt)) |
| 7081 | (if (string-match "^[a-zA-Z][a-zA-Z0-9]*$" name) | 7102 | (if (string-match "^[a-zA-Z][a-zA-Z0-9]*$" name) |
| 7082 | (push (cons name (int-to-string cnt)) org-table-column-names)))) | 7103 | (push (cons name (int-to-string cnt)) org-table-column-names)))) |
| 7083 | (setq org-table-column-names (nreverse org-table-column-names)) | 7104 | (setq org-table-column-names (nreverse org-table-column-names)) |
| 7084 | (setq org-table-column-name-regexp | 7105 | (setq org-table-column-name-regexp |
| 7085 | (concat "\\$\\(" (mapconcat 'car org-table-column-names "\\|") "\\)\\>")) | 7106 | (concat "\\$\\(" (mapconcat 'car org-table-column-names "\\|") "\\)\\>")) |
| 7086 | (goto-char beg) | 7107 | (goto-char beg) |
| 7087 | (while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t) | 7108 | (while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t) |
| 7088 | (setq fields (org-split-string (match-string 1) " *| *")) | 7109 | (setq fields (org-split-string (match-string 1) " *| *")) |
| 7089 | (while (setq field (pop fields)) | 7110 | (while (setq field (pop fields)) |
| 7090 | (if (string-match "^\\([a-zA-Z][a-zA-Z0-9]*\\) *= *\\(.*\\)" field) | 7111 | (if (string-match "^\\([a-zA-Z][a-zA-Z0-9]*\\|%\\) *= *\\(.*\\)" field) |
| 7091 | (push (cons (match-string 1 field) (match-string 2 field)) | 7112 | (push (cons (match-string 1 field) (match-string 2 field)) |
| 7092 | org-table-local-parameters))))))) | 7113 | org-table-local-parameters)))) |
| 7114 | (goto-char beg) | ||
| 7115 | (while (re-search-forward "^[ \t]*| *\\([_^]\\) *\\(|.*\\)" end t) | ||
| 7116 | (setq c (match-string 1) | ||
| 7117 | fields (org-split-string (match-string 2) " *| *")) | ||
| 7118 | (save-excursion | ||
| 7119 | (beginning-of-line (if (equal c "_") 2 0)) | ||
| 7120 | (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)") | ||
| 7121 | (setq fields1 (org-split-string (match-string 1) " *| *")))) | ||
| 7122 | (while (setq field (pop fields)) | ||
| 7123 | (setq v (pop fields1)) | ||
| 7124 | (if (and (stringp field) (stringp v) | ||
| 7125 | (string-match "^[a-zA-Z][a-zA-Z0-9]*$" field)) | ||
| 7126 | (push (cons field v) org-table-local-parameters))))))) | ||
| 7093 | 7127 | ||
| 7094 | (defun org-this-word () | 7128 | (defun org-this-word () |
| 7095 | ;; Get the current word | 7129 | ;; Get the current word |
| 7096 | (save-excursion | 7130 | (save-excursion |
| 7097 | (let ((beg (progn (skip-chars-backward "^ \t\n") (point))) | 7131 | (let ((beg (progn (skip-chars-backward "^ \t\n") (point))) |
| 7098 | (end (progn (skip-chars-forward "^ \t\n") (point)))) | 7132 | (end (progn (skip-chars-forward "^ \t\n") (point)))) |
| 7099 | (buffer-substring-no-properties beg end)))) | 7133 | (buffer-substring-no-properties beg end)))) |
| 7100 | 7134 | ||
| 7101 | (defun org-table-maybe-eval-formula () | 7135 | (defun org-table-maybe-eval-formula () |
| @@ -7104,35 +7138,35 @@ expected, for the other action only a single column number is needed." | |||
| 7104 | ;; when appropriate. It might return a separator line, but no problem. | 7138 | ;; when appropriate. It might return a separator line, but no problem. |
| 7105 | (when org-table-formula-evaluate-inline | 7139 | (when org-table-formula-evaluate-inline |
| 7106 | (let* ((field (org-trim (or (org-table-get-field) ""))) | 7140 | (let* ((field (org-trim (or (org-table-get-field) ""))) |
| 7107 | (dfield (downcase field)) | 7141 | (dfield (downcase field)) |
| 7108 | col bolpos nlast) | 7142 | col bolpos nlast) |
| 7109 | (when (equal (string-to-char field) ?=) | 7143 | (when (equal (string-to-char field) ?=) |
| 7110 | (if (string-match "^\\(=sum[vh]?\\)\\([0-9]+\\)$" dfield) | 7144 | (if (string-match "^\\(=sum[vh]?\\)\\([0-9]+\\)$" dfield) |
| 7111 | (setq nlast (1+ (string-to-number (match-string 2 dfield))) | 7145 | (setq nlast (1+ (string-to-number (match-string 2 dfield))) |
| 7112 | dfield (match-string 1 dfield))) | 7146 | dfield (match-string 1 dfield))) |
| 7113 | (cond | 7147 | (cond |
| 7114 | ((equal dfield "=sumh") | 7148 | ((equal dfield "=sumh") |
| 7115 | (org-table-get-field | 7149 | (org-table-get-field |
| 7116 | nil (org-table-sum | 7150 | nil (org-table-sum |
| 7117 | (save-excursion (org-table-goto-column 1) (point)) | 7151 | (save-excursion (org-table-goto-column 1) (point)) |
| 7118 | (point) nlast))) | 7152 | (point) nlast))) |
| 7119 | ((member dfield '("=sum" "=sumv")) | 7153 | ((member dfield '("=sum" "=sumv")) |
| 7120 | (setq col (org-table-current-column) | 7154 | (setq col (org-table-current-column) |
| 7121 | bolpos (point-at-bol)) | 7155 | bolpos (point-at-bol)) |
| 7122 | (org-table-get-field | 7156 | (org-table-get-field |
| 7123 | nil (org-table-sum | 7157 | nil (org-table-sum |
| 7124 | (save-excursion | 7158 | (save-excursion |
| 7125 | (goto-char (org-table-begin)) | 7159 | (goto-char (org-table-begin)) |
| 7126 | (if (re-search-forward org-table-dataline-regexp bolpos t) | 7160 | (if (re-search-forward org-table-dataline-regexp bolpos t) |
| 7127 | (progn | 7161 | (progn |
| 7128 | (goto-char (match-beginning 0)) | 7162 | (goto-char (match-beginning 0)) |
| 7129 | (org-table-goto-column col) | 7163 | (org-table-goto-column col) |
| 7130 | (point)) | 7164 | (point)) |
| 7131 | (error "No datalines above current"))) | 7165 | (error "No datalines above current"))) |
| 7132 | (point) nlast))) | 7166 | (point) nlast))) |
| 7133 | ((and (string-match "^ *=" field) | 7167 | ((and (string-match "^ *=" field) |
| 7134 | (fboundp 'calc-eval)) | 7168 | (fboundp 'calc-eval)) |
| 7135 | (org-table-eval-formula nil field))))))) | 7169 | (org-table-eval-formula nil field))))))) |
| 7136 | 7170 | ||
| 7137 | (defvar org-last-recalc-undo-list nil) | 7171 | (defvar org-last-recalc-undo-list nil) |
| 7138 | (defcustom org-table-allow-line-recalculation t | 7172 | (defcustom org-table-allow-line-recalculation t |
| @@ -7141,7 +7175,7 @@ expected, for the other action only a single column number is needed." | |||
| 7141 | :type 'boolean) | 7175 | :type 'boolean) |
| 7142 | 7176 | ||
| 7143 | (defvar org-recalc-commands nil | 7177 | (defvar org-recalc-commands nil |
| 7144 | "List of commands triggering the recalculation of a line. | 7178 | "List of commands triggering the reccalculation of a line. |
| 7145 | Will be filled automatically during use.") | 7179 | Will be filled automatically during use.") |
| 7146 | 7180 | ||
| 7147 | (defvar org-recalc-marks | 7181 | (defvar org-recalc-marks |
| @@ -7149,7 +7183,9 @@ Will be filled automatically during use.") | |||
| 7149 | ("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line") | 7183 | ("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line") |
| 7150 | ("*" . "Recalculate only when entire table is recalculated with `C-u C-c *'") | 7184 | ("*" . "Recalculate only when entire table is recalculated with `C-u C-c *'") |
| 7151 | ("!" . "Column name definition line. Reference in formula as $name.") | 7185 | ("!" . "Column name definition line. Reference in formula as $name.") |
| 7152 | ("$" . "Parameter definition line name=value. Reference in formula as $name."))) | 7186 | ("$" . "Parameter definition line name=value. Reference in formula as $name.") |
| 7187 | ("_" . "Names for values in row below this one.") | ||
| 7188 | ("^" . "Names for values in row above this one."))) | ||
| 7153 | 7189 | ||
| 7154 | (defun org-table-rotate-recalc-marks (&optional newchar) | 7190 | (defun org-table-rotate-recalc-marks (&optional newchar) |
| 7155 | "Rotate the recalculation mark in the first column. | 7191 | "Rotate the recalculation mark in the first column. |
| @@ -7162,28 +7198,28 @@ of the new mark." | |||
| 7162 | (interactive) | 7198 | (interactive) |
| 7163 | (unless (org-at-table-p) (error "Not at a table")) | 7199 | (unless (org-at-table-p) (error "Not at a table")) |
| 7164 | (let* ((marks (append (mapcar 'car org-recalc-marks) '(" "))) | 7200 | (let* ((marks (append (mapcar 'car org-recalc-marks) '(" "))) |
| 7165 | (beg (org-table-begin)) | 7201 | (beg (org-table-begin)) |
| 7166 | (end (org-table-end)) | 7202 | (end (org-table-end)) |
| 7167 | (l (org-current-line)) | 7203 | (l (org-current-line)) |
| 7168 | (l1 (if (org-region-active-p) (org-current-line (region-beginning)))) | 7204 | (l1 (if (org-region-active-p) (org-current-line (region-beginning)))) |
| 7169 | (l2 (if (org-region-active-p) (org-current-line (region-end)))) | 7205 | (l2 (if (org-region-active-p) (org-current-line (region-end)))) |
| 7170 | (have-col | 7206 | (have-col |
| 7171 | (save-excursion | 7207 | (save-excursion |
| 7172 | (goto-char beg) | 7208 | (goto-char beg) |
| 7173 | (not (re-search-forward "^[ \t]*|[^-|][^|]*[^#!$*| \t][^|]*|" end t)))) | 7209 | (not (re-search-forward "^[ \t]*|[^-|][^|]*[^#!$*_^| \t][^|]*|" end t)))) |
| 7174 | (col (org-table-current-column)) | 7210 | (col (org-table-current-column)) |
| 7175 | (forcenew (car (assoc newchar org-recalc-marks))) | 7211 | (forcenew (car (assoc newchar org-recalc-marks))) |
| 7176 | epos new) | 7212 | epos new) |
| 7177 | (if l1 (setq newchar (char-to-string (read-char-exclusive "Change region to what mark? Type # * ! $ or SPC: ")) | 7213 | (if l1 (setq newchar (char-to-string (read-char-exclusive "Change region to what mark? Type # * ! $ or SPC: ")) |
| 7178 | forcenew (car (assoc newchar org-recalc-marks)))) | 7214 | forcenew (car (assoc newchar org-recalc-marks)))) |
| 7179 | (if (and newchar (not forcenew)) | 7215 | (if (and newchar (not forcenew)) |
| 7180 | (error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'" | 7216 | (error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'" |
| 7181 | newchar)) | 7217 | newchar)) |
| 7182 | (if l1 (goto-line l1)) | 7218 | (if l1 (goto-line l1)) |
| 7183 | (save-excursion | 7219 | (save-excursion |
| 7184 | (beginning-of-line 1) | 7220 | (beginning-of-line 1) |
| 7185 | (unless (looking-at org-table-dataline-regexp) | 7221 | (unless (looking-at org-table-dataline-regexp) |
| 7186 | (error "Not at a table data line"))) | 7222 | (error "Not at a table data line"))) |
| 7187 | (unless have-col | 7223 | (unless have-col |
| 7188 | (org-table-goto-column 1) | 7224 | (org-table-goto-column 1) |
| 7189 | (org-table-insert-column) | 7225 | (org-table-insert-column) |
| @@ -7192,19 +7228,19 @@ of the new mark." | |||
| 7192 | (save-excursion | 7228 | (save-excursion |
| 7193 | (beginning-of-line 1) | 7229 | (beginning-of-line 1) |
| 7194 | (org-table-get-field | 7230 | (org-table-get-field |
| 7195 | 1 (if (looking-at "^[ \t]*| *\\([#!$* ]\\) *|") | 7231 | 1 (if (looking-at "^[ \t]*| *\\([#!$*^_ ]\\) *|") |
| 7196 | (concat " " | 7232 | (concat " " |
| 7197 | (setq new (or forcenew | 7233 | (setq new (or forcenew |
| 7198 | (cadr (member (match-string 1) marks)))) | 7234 | (cadr (member (match-string 1) marks)))) |
| 7199 | " ") | 7235 | " ") |
| 7200 | " # "))) | 7236 | " # "))) |
| 7201 | (if (and l1 l2) | 7237 | (if (and l1 l2) |
| 7202 | (progn | 7238 | (progn |
| 7203 | (goto-line l1) | 7239 | (goto-line l1) |
| 7204 | (while (progn (beginning-of-line 2) (not (= (org-current-line) l2))) | 7240 | (while (progn (beginning-of-line 2) (not (= (org-current-line) l2))) |
| 7205 | (and (looking-at org-table-dataline-regexp) | 7241 | (and (looking-at org-table-dataline-regexp) |
| 7206 | (org-table-get-field 1 (concat " " new " ")))) | 7242 | (org-table-get-field 1 (concat " " new " ")))) |
| 7207 | (goto-line l1))) | 7243 | (goto-line l1))) |
| 7208 | (if (not (= epos (point-at-eol))) (org-table-align)) | 7244 | (if (not (= epos (point-at-eol))) (org-table-align)) |
| 7209 | (goto-line l) | 7245 | (goto-line l) |
| 7210 | (and (interactive-p) (message (cdr (assoc new org-recalc-marks)))))) | 7246 | (and (interactive-p) (message (cdr (assoc new org-recalc-marks)))))) |
| @@ -7214,9 +7250,9 @@ of the new mark." | |||
| 7214 | (interactive) | 7250 | (interactive) |
| 7215 | (and org-table-allow-line-recalculation | 7251 | (and org-table-allow-line-recalculation |
| 7216 | (not (and (memq last-command org-recalc-commands) | 7252 | (not (and (memq last-command org-recalc-commands) |
| 7217 | (equal org-last-recalc-line (org-current-line)))) | 7253 | (equal org-last-recalc-line (org-current-line)))) |
| 7218 | (save-excursion (beginning-of-line 1) | 7254 | (save-excursion (beginning-of-line 1) |
| 7219 | (looking-at org-table-auto-recalculate-regexp)) | 7255 | (looking-at org-table-auto-recalculate-regexp)) |
| 7220 | (fboundp 'calc-eval) | 7256 | (fboundp 'calc-eval) |
| 7221 | (org-table-recalculate) t)) | 7257 | (org-table-recalculate) t)) |
| 7222 | 7258 | ||
| @@ -7225,12 +7261,21 @@ of the new mark." | |||
| 7225 | When nil, simply write \"#ERROR\" in corrupted fields.") | 7261 | When nil, simply write \"#ERROR\" in corrupted fields.") |
| 7226 | 7262 | ||
| 7227 | (defvar modes) | 7263 | (defvar modes) |
| 7228 | (defsubst org-set-calc-mode (var value) | 7264 | (defsubst org-set-calc-mode (var &optional value) |
| 7229 | (setcar (or (cdr (memq var modes)) (cons nil nil)) value)) | 7265 | (if (stringp var) |
| 7266 | (setq var (assoc var '(("D" calc-angle-mode deg) | ||
| 7267 | ("R" calc-angle-mode rad) | ||
| 7268 | ("F" calc-prefer-frac t) | ||
| 7269 | ("S" calc-symbolic-mode t))) | ||
| 7270 | value (nth 2 var) var (nth 1 var))) | ||
| 7271 | (if (memq var modes) | ||
| 7272 | (setcar (cdr (memq var modes)) value) | ||
| 7273 | (cons var (cons value modes))) | ||
| 7274 | modes) | ||
| 7230 | 7275 | ||
| 7231 | (defun org-table-eval-formula (&optional ndown equation | 7276 | (defun org-table-eval-formula (&optional ndown equation |
| 7232 | suppress-align suppress-const | 7277 | suppress-align suppress-const |
| 7233 | suppress-store) | 7278 | suppress-store) |
| 7234 | "Replace the table field value at the cursor by the result of a calculation. | 7279 | "Replace the table field value at the cursor by the result of a calculation. |
| 7235 | 7280 | ||
| 7236 | This function makes use of Dave Gillespie's calc package, in my view the | 7281 | This function makes use of Dave Gillespie's calc package, in my view the |
| @@ -7263,7 +7308,7 @@ A few examples for formulas: | |||
| 7263 | $1+$2;%.2f Same, and format result to two digits after dec.point | 7308 | $1+$2;%.2f Same, and format result to two digits after dec.point |
| 7264 | exp($2)+exp($1) Math functions can be used | 7309 | exp($2)+exp($1) Math functions can be used |
| 7265 | $;%.1f Reformat current cell to 1 digit after dec.point | 7310 | $;%.1f Reformat current cell to 1 digit after dec.point |
| 7266 | ($3-32)*5/9 Degrees F -> C conversion | 7311 | ($3-32)*5/9 degrees F -> C conversion |
| 7267 | 7312 | ||
| 7268 | When called with a raw \\[universal-argument] prefix, the formula is applied to the current | 7313 | When called with a raw \\[universal-argument] prefix, the formula is applied to the current |
| 7269 | field, and to the same same column in all following rows, until reaching a | 7314 | field, and to the same same column in all following rows, until reaching a |
| @@ -7285,94 +7330,91 @@ it is a modified equation that should not overwrite the stored one." | |||
| 7285 | (org-table-check-inside-data-field) | 7330 | (org-table-check-inside-data-field) |
| 7286 | (org-table-get-specials) | 7331 | (org-table-get-specials) |
| 7287 | (let* (fields | 7332 | (let* (fields |
| 7288 | (org-table-automatic-realign nil) | 7333 | (org-table-automatic-realign nil) |
| 7289 | (case-fold-search nil) | 7334 | (case-fold-search nil) |
| 7290 | (down (> ndown 1)) | 7335 | (down (> ndown 1)) |
| 7291 | (formula (if (and equation suppress-store) | 7336 | (formula (if (and equation suppress-store) |
| 7292 | equation | 7337 | equation |
| 7293 | (org-table-get-formula equation))) | 7338 | (org-table-get-formula equation))) |
| 7294 | (n0 (org-table-current-column)) | 7339 | (n0 (org-table-current-column)) |
| 7295 | (modes (copy-sequence org-calc-default-modes)) | 7340 | (modes (copy-sequence org-calc-default-modes)) |
| 7296 | n form fmt x ev orig c) | 7341 | n form fmt x ev orig c) |
| 7297 | ;; Parse the format | 7342 | ;; Parse the format string. Since we have a lot of modes, this is |
| 7343 | ;; a lot of work. | ||
| 7298 | (if (string-match ";" formula) | 7344 | (if (string-match ";" formula) |
| 7299 | (let ((tmp (org-split-string formula ";"))) | 7345 | (let ((tmp (org-split-string formula ";"))) |
| 7300 | (setq formula (car tmp) fmt (or (nth 1 tmp) "")) | 7346 | (setq formula (car tmp) |
| 7301 | (while (string-match "[pnfse]\\(-?[0-9]+\\)" fmt) | 7347 | fmt (concat (cdr (assoc "%" org-table-local-parameters)) |
| 7302 | (setq c (string-to-char (match-string 1 fmt)) | 7348 | (nth 1 tmp))) |
| 7303 | n (string-to-number (or (match-string 1 fmt) ""))) | 7349 | (while (string-match "[pnfse]\\(-?[0-9]+\\)" fmt) |
| 7304 | (if (= c ?p) (org-set-calc-mode 'calc-internal-prec n) | 7350 | (setq c (string-to-char (match-string 1 fmt)) |
| 7305 | (org-set-calc-mode 'calc-float-format | 7351 | n (string-to-number (or (match-string 1 fmt) ""))) |
| 7306 | (list (cdr (assoc c '((?n. float) (?f. fix) | 7352 | (if (= c ?p) (setq modes (org-set-calc-mode 'calc-internal-prec n)) |
| 7307 | (?s. sci) (?e. eng)))) | 7353 | (setq modes (org-set-calc-mode |
| 7308 | n))) | 7354 | 'calc-float-format |
| 7309 | (setq fmt (replace-match "" t t fmt))) | 7355 | (list (cdr (assoc c '((?n. float) (?f. fix) |
| 7310 | (when (string-match "[DR]" fmt) | 7356 | (?s. sci) (?e. eng)))) |
| 7311 | (org-set-calc-mode 'calc-angle-mode | 7357 | n)))) |
| 7312 | (if (equal (match-string 0 fmt) "D") | 7358 | (setq fmt (replace-match "" t t fmt))) |
| 7313 | 'deg 'rad)) | 7359 | (while (string-match "[DRFS]" fmt) |
| 7314 | (setq fmt (replace-match "" t t fmt))) | 7360 | (setq modes (org-set-calc-mode (match-string 0 fmt))) |
| 7315 | (when (string-match "F" fmt) | 7361 | (setq fmt (replace-match "" t t fmt))) |
| 7316 | (org-set-calc-mode 'calc-prefer-frac t) | 7362 | (unless (string-match "\\S-" fmt) |
| 7317 | (setq fmt (replace-match "" t t fmt))) | 7363 | (setq fmt nil)))) |
| 7318 | (when (string-match "S" fmt) | ||
| 7319 | (org-set-calc-mode 'calc-symbolic-mode t) | ||
| 7320 | (setq fmt (replace-match "" t t fmt))) | ||
| 7321 | (unless (string-match "\\S-" fmt) | ||
| 7322 | (setq fmt nil)))) | ||
| 7323 | (if (and (not suppress-const) org-table-formula-use-constants) | 7364 | (if (and (not suppress-const) org-table-formula-use-constants) |
| 7324 | (setq formula (org-table-formula-substitute-names formula))) | 7365 | (setq formula (org-table-formula-substitute-names formula))) |
| 7325 | (setq orig (or (get-text-property 1 :orig-formula formula) "?")) | 7366 | (setq orig (or (get-text-property 1 :orig-formula formula) "?")) |
| 7326 | (while (> ndown 0) | 7367 | (while (> ndown 0) |
| 7327 | (setq fields (org-split-string | 7368 | (setq fields (org-split-string |
| 7328 | (buffer-substring | 7369 | (buffer-substring |
| 7329 | (point-at-bol) (point-at-eol)) " *| *")) | 7370 | (point-at-bol) (point-at-eol)) " *| *")) |
| 7330 | (if org-table-formula-numbers-only | 7371 | (if org-table-formula-numbers-only |
| 7331 | (setq fields (mapcar | 7372 | (setq fields (mapcar |
| 7332 | (lambda (x) (number-to-string (string-to-number x))) | 7373 | (lambda (x) (number-to-string (string-to-number x))) |
| 7333 | fields))) | 7374 | fields))) |
| 7334 | (setq ndown (1- ndown)) | 7375 | (setq ndown (1- ndown)) |
| 7335 | (setq form (copy-sequence formula)) | 7376 | (setq form (copy-sequence formula)) |
| 7336 | (while (string-match "\\$\\([0-9]+\\)?" form) | 7377 | (while (string-match "\\$\\([0-9]+\\)?" form) |
| 7337 | (setq n (if (match-beginning 1) | 7378 | (setq n (if (match-beginning 1) |
| 7338 | (string-to-int (match-string 1 form)) | 7379 | (string-to-int (match-string 1 form)) |
| 7339 | n0) | 7380 | n0) |
| 7340 | x (nth (1- n) fields)) | 7381 | x (nth (1- n) fields)) |
| 7341 | (unless x (error "Invalid field specifier \"%s\"" | 7382 | (unless x (error "Invalid field specifier \"%s\"" |
| 7342 | (match-string 0 form))) | 7383 | (match-string 0 form))) |
| 7343 | (if (equal x "") (setq x "0")) | 7384 | (if (equal x "") (setq x "0")) |
| 7344 | (setq form (replace-match (concat "(" x ")") t t form))) | 7385 | (setq form (replace-match (concat "(" x ")") t t form))) |
| 7345 | (setq ev (calc-eval (cons form modes) | 7386 | (setq ev (calc-eval (cons form modes) |
| 7346 | (if org-table-formula-numbers-only 'num))) | 7387 | (if org-table-formula-numbers-only 'num))) |
| 7347 | 7388 | ||
| 7348 | (when org-table-formula-debug | 7389 | (when org-table-formula-debug |
| 7349 | (with-output-to-temp-buffer "*Help*" | 7390 | (with-output-to-temp-buffer "*Help*" |
| 7350 | (princ (format "Substitution history of formula | 7391 | (princ (format "Substitution history of formula |
| 7351 | Orig: %s | 7392 | Orig: %s |
| 7352 | $xyz-> %s | 7393 | $xyz-> %s |
| 7353 | $1-> %s\n" orig formula form)) | 7394 | $1-> %s\n" orig formula form)) |
| 7354 | (if (listp ev) | 7395 | (if (listp ev) |
| 7355 | (princ (format " %s^\nError: %s" | 7396 | (princ (format " %s^\nError: %s" |
| 7356 | (make-string (car ev) ?\-) (nth 1 ev))) | 7397 | (make-string (car ev) ?\-) (nth 1 ev))) |
| 7357 | (princ (format "Result: %s" ev)))) | 7398 | (princ (format "Result: %s\nFormat: %s\nFinal: %s" |
| 7358 | (shrink-window-if-larger-than-buffer (get-buffer-window "*Help*")) | 7399 | ev (or fmt "NONE") |
| 7359 | (unless (and (interactive-p) (not ndown)) | 7400 | (if fmt (format fmt (string-to-number ev)) ev))))) |
| 7360 | (unless (let (inhibit-redisplay) | 7401 | (shrink-window-if-larger-than-buffer (get-buffer-window "*Help*")) |
| 7361 | (y-or-n-p "Debugging Formula. Continue to next? ")) | 7402 | (unless (and (interactive-p) (not ndown)) |
| 7362 | (org-table-align) | 7403 | (unless (let (inhibit-redisplay) |
| 7363 | (error "Abort")) | 7404 | (y-or-n-p "Debugging Formula. Continue to next? ")) |
| 7364 | (delete-window (get-buffer-window "*Help*")) | 7405 | (org-table-align) |
| 7365 | (message ""))) | 7406 | (error "Abort")) |
| 7366 | (if (listp ev) | 7407 | (delete-window (get-buffer-window "*Help*")) |
| 7367 | (setq fmt nil ev "#ERROR")) | 7408 | (message ""))) |
| 7368 | (org-table-blank-field) | 7409 | (if (listp ev) (setq fmt nil ev "#ERROR")) |
| 7369 | (if fmt | 7410 | (org-table-justify-field-maybe |
| 7370 | (insert (format fmt (string-to-number ev))) | 7411 | (if fmt (format fmt (string-to-number ev)) ev)) |
| 7371 | (insert ev)) | ||
| 7372 | (if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]")) | 7412 | (if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]")) |
| 7373 | (call-interactively 'org-return) | 7413 | (call-interactively 'org-return) |
| 7374 | (setq ndown 0))) | 7414 | (setq ndown 0))) |
| 7375 | (or suppress-align (org-table-align)))) | 7415 | (and down (org-table-maybe-recalculate-line)) |
| 7416 | (or suppress-align (and org-table-may-need-update | ||
| 7417 | (org-table-align))))) | ||
| 7376 | 7418 | ||
| 7377 | (defun org-table-recalculate (&optional all noalign) | 7419 | (defun org-table-recalculate (&optional all noalign) |
| 7378 | "Recalculate the current table line by applying all stored formulas." | 7420 | "Recalculate the current table line by applying all stored formulas." |
| @@ -7382,51 +7424,51 @@ $1-> %s\n" orig formula form)) | |||
| 7382 | (unless (org-at-table-p) (error "Not at a table")) | 7424 | (unless (org-at-table-p) (error "Not at a table")) |
| 7383 | (org-table-get-specials) | 7425 | (org-table-get-specials) |
| 7384 | (let* ((eqlist (sort (org-table-get-stored-formulas) | 7426 | (let* ((eqlist (sort (org-table-get-stored-formulas) |
| 7385 | (lambda (a b) (< (car a) (car b))))) | 7427 | (lambda (a b) (< (car a) (car b))))) |
| 7386 | (inhibit-redisplay t) | 7428 | (inhibit-redisplay t) |
| 7387 | (line-re org-table-dataline-regexp) | 7429 | (line-re org-table-dataline-regexp) |
| 7388 | (thisline (+ (if (bolp) 1 0) (count-lines (point-min) (point)))) | 7430 | (thisline (+ (if (bolp) 1 0) (count-lines (point-min) (point)))) |
| 7389 | (thiscol (org-table-current-column)) | 7431 | (thiscol (org-table-current-column)) |
| 7390 | beg end entry eql (cnt 0)) | 7432 | beg end entry eql (cnt 0)) |
| 7391 | ;; Insert constants in all formulas | 7433 | ;; Insert constants in all formulas |
| 7392 | (setq eqlist | 7434 | (setq eqlist |
| 7393 | (mapcar (lambda (x) | 7435 | (mapcar (lambda (x) |
| 7394 | (setcdr x (org-table-formula-substitute-names (cdr x))) | 7436 | (setcdr x (org-table-formula-substitute-names (cdr x))) |
| 7395 | x) | 7437 | x) |
| 7396 | eqlist)) | 7438 | eqlist)) |
| 7397 | (if all | 7439 | (if all |
| 7398 | (progn | 7440 | (progn |
| 7399 | (setq end (move-marker (make-marker) (1+ (org-table-end)))) | 7441 | (setq end (move-marker (make-marker) (1+ (org-table-end)))) |
| 7400 | (goto-char (setq beg (org-table-begin))) | 7442 | (goto-char (setq beg (org-table-begin))) |
| 7401 | (if (re-search-forward org-table-recalculate-regexp end t) | 7443 | (if (re-search-forward org-table-recalculate-regexp end t) |
| 7402 | (setq line-re org-table-recalculate-regexp) | 7444 | (setq line-re org-table-recalculate-regexp) |
| 7403 | (if (and (re-search-forward org-table-dataline-regexp end t) | 7445 | (if (and (re-search-forward org-table-dataline-regexp end t) |
| 7404 | (re-search-forward org-table-hline-regexp end t) | 7446 | (re-search-forward org-table-hline-regexp end t) |
| 7405 | (re-search-forward org-table-dataline-regexp end t)) | 7447 | (re-search-forward org-table-dataline-regexp end t)) |
| 7406 | (setq beg (match-beginning 0)) | 7448 | (setq beg (match-beginning 0)) |
| 7407 | nil))) ;; just leave beg where it is | 7449 | nil))) ;; just leave beg where it is |
| 7408 | (setq beg (point-at-bol) | 7450 | (setq beg (point-at-bol) |
| 7409 | end (move-marker (make-marker) (1+ (point-at-eol))))) | 7451 | end (move-marker (make-marker) (1+ (point-at-eol))))) |
| 7410 | (goto-char beg) | 7452 | (goto-char beg) |
| 7411 | (and all (message "Re-applying formulas to full table...")) | 7453 | (and all (message "Re-applying formulas to full table...")) |
| 7412 | (while (re-search-forward line-re end t) | 7454 | (while (re-search-forward line-re end t) |
| 7413 | (unless (string-match "^ *[!$] *$" (org-table-get-field 1)) | 7455 | (unless (string-match "^ *[!$] *$" (org-table-get-field 1)) |
| 7414 | ;; Unprotected line, recalculate | 7456 | ;; Unprotected line, recalculate |
| 7415 | (and all (message "Re-applying formulas to full table...(line %d)" | 7457 | (and all (message "Re-applying formulas to full table...(line %d)" |
| 7416 | (setq cnt (1+ cnt)))) | 7458 | (setq cnt (1+ cnt)))) |
| 7417 | (setq org-last-recalc-line (org-current-line)) | 7459 | (setq org-last-recalc-line (org-current-line)) |
| 7418 | (setq eql eqlist) | 7460 | (setq eql eqlist) |
| 7419 | (while (setq entry (pop eql)) | 7461 | (while (setq entry (pop eql)) |
| 7420 | (goto-line org-last-recalc-line) | 7462 | (goto-line org-last-recalc-line) |
| 7421 | (org-table-goto-column (car entry) nil 'force) | 7463 | (org-table-goto-column (car entry) nil 'force) |
| 7422 | (org-table-eval-formula nil (cdr entry) 'noalign 'nocst 'nostore)))) | 7464 | (org-table-eval-formula nil (cdr entry) 'noalign 'nocst 'nostore)))) |
| 7423 | (goto-line thisline) | 7465 | (goto-line thisline) |
| 7424 | (org-table-goto-column thiscol) | 7466 | (org-table-goto-column thiscol) |
| 7425 | (or noalign (org-table-align) | 7467 | (or noalign (and org-table-may-need-update (org-table-align)) |
| 7426 | (and all (message "Re-applying formulas to %d lines...done" cnt))))) | 7468 | (and all (message "Re-applying formulas to %d lines...done" cnt))))) |
| 7427 | 7469 | ||
| 7428 | (defun org-table-formula-substitute-names (f) | 7470 | (defun org-table-formula-substitute-names (f) |
| 7429 | "Replace $const with values in string F." | 7471 | "Replace $const with values in stirng F." |
| 7430 | (let ((start 0) a n1 n2 nn1 nn2 s (f1 f)) | 7472 | (let ((start 0) a n1 n2 nn1 nn2 s (f1 f)) |
| 7431 | ;; First, check for column names | 7473 | ;; First, check for column names |
| 7432 | (while (setq start (string-match org-table-column-name-regexp f start)) | 7474 | (while (setq start (string-match org-table-column-name-regexp f start)) |
| @@ -7436,11 +7478,11 @@ $1-> %s\n" orig formula form)) | |||
| 7436 | ;; Expand ranges to vectors | 7478 | ;; Expand ranges to vectors |
| 7437 | (while (string-match "\\$\\([0-9]+\\)\\.\\.\\.?\\$\\([0-9]+\\)" f) | 7479 | (while (string-match "\\$\\([0-9]+\\)\\.\\.\\.?\\$\\([0-9]+\\)" f) |
| 7438 | (setq n1 (string-to-number (match-string 1 f)) | 7480 | (setq n1 (string-to-number (match-string 1 f)) |
| 7439 | n2 (string-to-number (match-string 2 f)) | 7481 | n2 (string-to-number (match-string 2 f)) |
| 7440 | nn1 (1+ (min n1 n2)) nn2 (max n1 n2) | 7482 | nn1 (1+ (min n1 n2)) nn2 (max n1 n2) |
| 7441 | s (concat "[($" (number-to-string (1- nn1)) ")")) | 7483 | s (concat "[($" (number-to-string (1- nn1)) ")")) |
| 7442 | (loop for i from nn1 upto nn2 do | 7484 | (loop for i from nn1 upto nn2 do |
| 7443 | (setq s (concat s ",($" (int-to-string i) ")"))) | 7485 | (setq s (concat s ",($" (int-to-string i) ")"))) |
| 7444 | (setq s (concat s "]")) | 7486 | (setq s (concat s "]")) |
| 7445 | (if (< n2 n1) (setq s (concat "rev(" s ")"))) | 7487 | (if (< n2 n1) (setq s (concat "rev(" s ")"))) |
| 7446 | (setq f (replace-match s t t f))) | 7488 | (setq f (replace-match s t t f))) |
| @@ -7449,10 +7491,10 @@ $1-> %s\n" orig formula form)) | |||
| 7449 | (while (setq start (string-match "\\$\\([a-zA-Z][a-zA-Z0-9]*\\)" f start)) | 7491 | (while (setq start (string-match "\\$\\([a-zA-Z][a-zA-Z0-9]*\\)" f start)) |
| 7450 | (setq start (1+ start)) | 7492 | (setq start (1+ start)) |
| 7451 | (if (setq a (save-match-data | 7493 | (if (setq a (save-match-data |
| 7452 | (org-table-get-constant (match-string 1 f)))) | 7494 | (org-table-get-constant (match-string 1 f)))) |
| 7453 | (setq f (replace-match (concat "(" a ")") t t f)))) | 7495 | (setq f (replace-match (concat "(" a ")") t t f)))) |
| 7454 | (if org-table-formula-debug | 7496 | (if org-table-formula-debug |
| 7455 | (put-text-property 0 (length f) :orig-formula f1 f)) | 7497 | (put-text-property 0 (length f) :orig-formula f1 f)) |
| 7456 | f)) | 7498 | f)) |
| 7457 | 7499 | ||
| 7458 | (defun org-table-get-constant (const) | 7500 | (defun org-table-get-constant (const) |
| @@ -7527,26 +7569,26 @@ table editor in arbitrary modes.") | |||
| 7527 | ;; by accident in org-mode. | 7569 | ;; by accident in org-mode. |
| 7528 | (message "Orgtbl-mode is not useful in org-mode, command ignored") | 7570 | (message "Orgtbl-mode is not useful in org-mode, command ignored") |
| 7529 | (setq orgtbl-mode | 7571 | (setq orgtbl-mode |
| 7530 | (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode))) | 7572 | (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode))) |
| 7531 | (if orgtbl-mode | 7573 | (if orgtbl-mode |
| 7532 | (progn | 7574 | (progn |
| 7533 | (and (orgtbl-setup) (defun orgtbl-setup () nil)) | 7575 | (and (orgtbl-setup) (defun orgtbl-setup () nil)) |
| 7534 | ;; Make sure we are first in minor-mode-map-alist | 7576 | ;; Make sure we are first in minor-mode-map-alist |
| 7535 | (let ((c (assq 'orgtbl-mode minor-mode-map-alist))) | 7577 | (let ((c (assq 'orgtbl-mode minor-mode-map-alist))) |
| 7536 | (and c (setq minor-mode-map-alist | 7578 | (and c (setq minor-mode-map-alist |
| 7537 | (cons c (delq c minor-mode-map-alist))))) | 7579 | (cons c (delq c minor-mode-map-alist))))) |
| 7538 | (set (make-local-variable (quote org-table-may-need-update)) t) | 7580 | (set (make-local-variable (quote org-table-may-need-update)) t) |
| 7539 | (make-local-hook (quote before-change-functions)) | 7581 | (make-local-hook (quote before-change-functions)) |
| 7540 | (add-hook 'before-change-functions 'org-before-change-function | 7582 | (add-hook 'before-change-functions 'org-before-change-function |
| 7541 | nil 'local) | 7583 | nil 'local) |
| 7542 | (set (make-local-variable 'org-old-auto-fill-inhibit-regexp) | 7584 | (set (make-local-variable 'org-old-auto-fill-inhibit-regexp) |
| 7543 | auto-fill-inhibit-regexp) | 7585 | auto-fill-inhibit-regexp) |
| 7544 | (set (make-local-variable 'auto-fill-inhibit-regexp) | 7586 | (set (make-local-variable 'auto-fill-inhibit-regexp) |
| 7545 | (if auto-fill-inhibit-regexp | 7587 | (if auto-fill-inhibit-regexp |
| 7546 | (concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp) | 7588 | (concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp) |
| 7547 | "[ \t]*|")) | 7589 | "[ \t]*|")) |
| 7548 | (easy-menu-add orgtbl-mode-menu) | 7590 | (easy-menu-add orgtbl-mode-menu) |
| 7549 | (run-hooks 'orgtbl-mode-hook)) | 7591 | (run-hooks 'orgtbl-mode-hook)) |
| 7550 | (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) | 7592 | (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) |
| 7551 | (remove-hook 'before-change-functions 'org-before-change-function t) | 7593 | (remove-hook 'before-change-functions 'org-before-change-function t) |
| 7552 | (easy-menu-remove orgtbl-mode-menu) | 7594 | (easy-menu-remove orgtbl-mode-menu) |
| @@ -7559,70 +7601,70 @@ table editor in arbitrary modes.") | |||
| 7559 | 7601 | ||
| 7560 | (defun orgtbl-make-binding (fun n &rest keys) | 7602 | (defun orgtbl-make-binding (fun n &rest keys) |
| 7561 | "Create a function for binding in the table minor mode. | 7603 | "Create a function for binding in the table minor mode. |
| 7562 | FUN is the command to call inside a table. N is used to create a unique | 7604 | FUN is the command to call inside a table. N is used to create a unique |
| 7563 | command name. KEYS are keys that should be checked in for a command | 7605 | command name. KEYS are keys that should be checked in for a command |
| 7564 | to execute outside of tables." | 7606 | to execute outside of tables." |
| 7565 | (eval | 7607 | (eval |
| 7566 | (list 'defun | 7608 | (list 'defun |
| 7567 | (intern (concat "orgtbl-hijacker-command-" (int-to-string n))) | 7609 | (intern (concat "orgtbl-hijacker-command-" (int-to-string n))) |
| 7568 | '(arg) | 7610 | '(arg) |
| 7569 | (concat "In tables, run `" (symbol-name fun) "'.\n" | 7611 | (concat "In tables, run `" (symbol-name fun) "'.\n" |
| 7570 | "Outside of tables, run the binding of `" | 7612 | "Outside of tables, run the binding of `" |
| 7571 | (mapconcat (lambda (x) (format "%s" x)) keys "' or `") | 7613 | (mapconcat (lambda (x) (format "%s" x)) keys "' or `") |
| 7572 | "'.") | 7614 | "'.") |
| 7573 | '(interactive "p") | 7615 | '(interactive "p") |
| 7574 | (list 'if | 7616 | (list 'if |
| 7575 | '(org-at-table-p) | 7617 | '(org-at-table-p) |
| 7576 | (list 'call-interactively (list 'quote fun)) | 7618 | (list 'call-interactively (list 'quote fun)) |
| 7577 | (list 'let '(orgtbl-mode) | 7619 | (list 'let '(orgtbl-mode) |
| 7578 | (list 'call-interactively | 7620 | (list 'call-interactively |
| 7579 | (append '(or) | 7621 | (append '(or) |
| 7580 | (mapcar (lambda (k) | 7622 | (mapcar (lambda (k) |
| 7581 | (list 'key-binding k)) | 7623 | (list 'key-binding k)) |
| 7582 | keys) | 7624 | keys) |
| 7583 | '('orgtbl-error)))))))) | 7625 | '('orgtbl-error)))))))) |
| 7584 | 7626 | ||
| 7585 | (defun orgtbl-error () | 7627 | (defun orgtbl-error () |
| 7586 | "Error when there is no default binding for a table key." | 7628 | "Error when there is no default binding for a table key." |
| 7587 | (interactive) | 7629 | (interactive) |
| 7588 | (error "This key has no function outside tables")) | 7630 | (error "This key is has no function outside tables")) |
| 7589 | 7631 | ||
| 7590 | (defun orgtbl-setup () | 7632 | (defun orgtbl-setup () |
| 7591 | "Setup orgtbl keymaps." | 7633 | "Setup orgtbl keymaps." |
| 7592 | (let ((nfunc 0) | 7634 | (let ((nfunc 0) |
| 7593 | (bindings | 7635 | (bindings |
| 7594 | (list | 7636 | (list |
| 7595 | '([(meta shift left)] org-table-delete-column) | 7637 | '([(meta shift left)] org-table-delete-column) |
| 7596 | '([(meta left)] org-table-move-column-left) | 7638 | '([(meta left)] org-table-move-column-left) |
| 7597 | '([(meta right)] org-table-move-column-right) | 7639 | '([(meta right)] org-table-move-column-right) |
| 7598 | '([(meta shift right)] org-table-insert-column) | 7640 | '([(meta shift right)] org-table-insert-column) |
| 7599 | '([(meta shift up)] org-table-kill-row) | 7641 | '([(meta shift up)] org-table-kill-row) |
| 7600 | '([(meta shift down)] org-table-insert-row) | 7642 | '([(meta shift down)] org-table-insert-row) |
| 7601 | '([(meta up)] org-table-move-row-up) | 7643 | '([(meta up)] org-table-move-row-up) |
| 7602 | '([(meta down)] org-table-move-row-down) | 7644 | '([(meta down)] org-table-move-row-down) |
| 7603 | '("\C-c\C-w" org-table-cut-region) | 7645 | '("\C-c\C-w" org-table-cut-region) |
| 7604 | '("\C-c\M-w" org-table-copy-region) | 7646 | '("\C-c\M-w" org-table-copy-region) |
| 7605 | '("\C-c\C-y" org-table-paste-rectangle) | 7647 | '("\C-c\C-y" org-table-paste-rectangle) |
| 7606 | '("\C-c-" org-table-insert-hline) | 7648 | '("\C-c-" org-table-insert-hline) |
| 7607 | '([(shift tab)] org-table-previous-field) | 7649 | '([(shift tab)] org-table-previous-field) |
| 7608 | '("\C-c\C-c" org-ctrl-c-ctrl-c) | 7650 | '("\C-c\C-c" org-ctrl-c-ctrl-c) |
| 7609 | '("\C-m" org-table-next-row) | 7651 | '("\C-m" org-table-next-row) |
| 7610 | (list (org-key 'S-return) 'org-table-copy-down) | 7652 | (list (org-key 'S-return) 'org-table-copy-down) |
| 7611 | '([(meta return)] org-table-wrap-region) | 7653 | '([(meta return)] org-table-wrap-region) |
| 7612 | '("\C-c\C-q" org-table-wrap-region) | 7654 | '("\C-c\C-q" org-table-wrap-region) |
| 7613 | '("\C-c?" org-table-current-column) | 7655 | '("\C-c?" org-table-current-column) |
| 7614 | '("\C-c " org-table-blank-field) | 7656 | '("\C-c " org-table-blank-field) |
| 7615 | '("\C-c+" org-table-sum) | 7657 | '("\C-c+" org-table-sum) |
| 7616 | '("\C-c|" org-table-toggle-vline-visibility) | 7658 | '("\C-c|" org-table-toggle-vline-visibility) |
| 7617 | '("\C-c=" org-table-eval-formula) | 7659 | '("\C-c=" org-table-eval-formula) |
| 7618 | '("\C-c*" org-table-recalculate) | 7660 | '("\C-c*" org-table-recalculate) |
| 7619 | '([(control ?#)] org-table-rotate-recalc-marks))) | 7661 | '([(control ?#)] org-table-rotate-recalc-marks))) |
| 7620 | elt key fun cmd) | 7662 | elt key fun cmd) |
| 7621 | (while (setq elt (pop bindings)) | 7663 | (while (setq elt (pop bindings)) |
| 7622 | (setq nfunc (1+ nfunc)) | 7664 | (setq nfunc (1+ nfunc)) |
| 7623 | (setq key (car elt) | 7665 | (setq key (car elt) |
| 7624 | fun (nth 1 elt) | 7666 | fun (nth 1 elt) |
| 7625 | cmd (orgtbl-make-binding fun nfunc key)) | 7667 | cmd (orgtbl-make-binding fun nfunc key)) |
| 7626 | (define-key orgtbl-mode-map key cmd)) | 7668 | (define-key orgtbl-mode-map key cmd)) |
| 7627 | ;; Special treatment needed for TAB and RET | 7669 | ;; Special treatment needed for TAB and RET |
| 7628 | (define-key orgtbl-mode-map [(return)] | 7670 | (define-key orgtbl-mode-map [(return)] |
| @@ -7637,53 +7679,53 @@ to execute outside of tables." | |||
| 7637 | ;; If the user wants maximum table support, we need to hijack | 7679 | ;; If the user wants maximum table support, we need to hijack |
| 7638 | ;; some standard editing functions | 7680 | ;; some standard editing functions |
| 7639 | (substitute-key-definition 'self-insert-command 'orgtbl-self-insert-command | 7681 | (substitute-key-definition 'self-insert-command 'orgtbl-self-insert-command |
| 7640 | orgtbl-mode-map global-map) | 7682 | orgtbl-mode-map global-map) |
| 7641 | (substitute-key-definition 'delete-char 'orgtbl-delete-char | 7683 | (substitute-key-definition 'delete-char 'orgtbl-delete-char |
| 7642 | orgtbl-mode-map global-map) | 7684 | orgtbl-mode-map global-map) |
| 7643 | (substitute-key-definition 'delete-backward-char 'orgtbl-delete-backward-char | 7685 | (substitute-key-definition 'delete-backward-char 'orgtbl-delete-backward-char |
| 7644 | orgtbl-mode-map global-map) | 7686 | orgtbl-mode-map global-map) |
| 7645 | (define-key org-mode-map "|" 'self-insert-command)) | 7687 | (define-key org-mode-map "|" 'self-insert-command)) |
| 7646 | (easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu" | 7688 | (easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu" |
| 7647 | '("OrgTbl" | 7689 | '("OrgTbl" |
| 7648 | ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"] | 7690 | ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"] |
| 7649 | ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"] | 7691 | ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"] |
| 7650 | ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"] | 7692 | ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"] |
| 7651 | ["Next Row" org-return :active (org-at-table-p) :keys "RET"] | 7693 | ["Next Row" org-return :active (org-at-table-p) :keys "RET"] |
| 7652 | "--" | 7694 | "--" |
| 7653 | ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"] | 7695 | ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"] |
| 7654 | ["Copy Field from Above" | 7696 | ["Copy Field from Above" |
| 7655 | org-table-copy-down :active (org-at-table-p) :keys "S-RET"] | 7697 | org-table-copy-down :active (org-at-table-p) :keys "S-RET"] |
| 7656 | "--" | 7698 | "--" |
| 7657 | ("Column" | 7699 | ("Column" |
| 7658 | ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-<left>"] | 7700 | ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-<left>"] |
| 7659 | ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-<right>"] | 7701 | ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-<right>"] |
| 7660 | ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"] | 7702 | ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"] |
| 7661 | ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-<right>"]) | 7703 | ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-<right>"]) |
| 7662 | ("Row" | 7704 | ("Row" |
| 7663 | ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-<up>"] | 7705 | ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-<up>"] |
| 7664 | ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-<down>"] | 7706 | ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-<down>"] |
| 7665 | ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-<up>"] | 7707 | ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-<up>"] |
| 7666 | ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-<down>"] | 7708 | ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-<down>"] |
| 7667 | "--" | 7709 | "--" |
| 7668 | ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"]) | 7710 | ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"]) |
| 7669 | ("Rectangle" | 7711 | ("Rectangle" |
| 7670 | ["Copy Rectangle" org-copy-special :active (org-at-table-p) :keys "C-c M-w"] | 7712 | ["Copy Rectangle" org-copy-special :active (org-at-table-p) :keys "C-c M-w"] |
| 7671 | ["Cut Rectangle" org-cut-special :active (org-at-table-p) :keys "C-c C-w"] | 7713 | ["Cut Rectangle" org-cut-special :active (org-at-table-p) :keys "C-c C-w"] |
| 7672 | ["Paste Rectangle" org-paste-special :active (org-at-table-p) :keys "C-c C-y"] | 7714 | ["Paste Rectangle" org-paste-special :active (org-at-table-p) :keys "C-c C-y"] |
| 7673 | ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p) :keys "C-c C-q"]) | 7715 | ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p) :keys "C-c C-q"]) |
| 7674 | "--" | 7716 | "--" |
| 7675 | ["Eval Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="] | 7717 | ["Eval Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="] |
| 7676 | ["Eval Formula Down " (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] | 7718 | ["Eval Formula Down " (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] |
| 7677 | ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"] | 7719 | ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"] |
| 7678 | ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"] | 7720 | ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"] |
| 7679 | ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"] | 7721 | ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"] |
| 7680 | ["Sum Column/Rectangle" org-table-sum | 7722 | ["Sum Column/Rectangle" org-table-sum |
| 7681 | :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"] | 7723 | :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"] |
| 7682 | ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"] | 7724 | ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"] |
| 7683 | ["Debug Formulas" | 7725 | ["Debug Formulas" |
| 7684 | (setq org-table-formula-debug (not org-table-formula-debug)) | 7726 | (setq org-table-formula-debug (not org-table-formula-debug)) |
| 7685 | :style toggle :selected org-table-formula-debug] | 7727 | :style toggle :selected org-table-formula-debug] |
| 7686 | )) | 7728 | )) |
| 7687 | t) | 7729 | t) |
| 7688 | 7730 | ||
| 7689 | (defun orgtbl-tab () | 7731 | (defun orgtbl-tab () |
| @@ -7704,13 +7746,13 @@ If the cursor is in a table looking at whitespace, the whitespace is | |||
| 7704 | overwritten, and the table is not marked as requiring realignment." | 7746 | overwritten, and the table is not marked as requiring realignment." |
| 7705 | (interactive "p") | 7747 | (interactive "p") |
| 7706 | (if (and (org-at-table-p) | 7748 | (if (and (org-at-table-p) |
| 7707 | (eq N 1) | 7749 | (eq N 1) |
| 7708 | (looking-at "[^|\n]* +|")) | 7750 | (looking-at "[^|\n]* +|")) |
| 7709 | (let (org-table-may-need-update) | 7751 | (let (org-table-may-need-update) |
| 7710 | (goto-char (1- (match-end 0))) | 7752 | (goto-char (1- (match-end 0))) |
| 7711 | (delete-backward-char 1) | 7753 | (delete-backward-char 1) |
| 7712 | (goto-char (match-beginning 0)) | 7754 | (goto-char (match-beginning 0)) |
| 7713 | (self-insert-command N)) | 7755 | (self-insert-command N)) |
| 7714 | (setq org-table-may-need-update t) | 7756 | (setq org-table-may-need-update t) |
| 7715 | (let (orgtbl-mode) | 7757 | (let (orgtbl-mode) |
| 7716 | (call-interactively (key-binding (vector last-input-event)))))) | 7758 | (call-interactively (key-binding (vector last-input-event)))))) |
| @@ -7723,14 +7765,14 @@ still be marked for re-alignment, because a narrow field may lead to a | |||
| 7723 | reduced column width." | 7765 | reduced column width." |
| 7724 | (interactive "p") | 7766 | (interactive "p") |
| 7725 | (if (and (org-at-table-p) | 7767 | (if (and (org-at-table-p) |
| 7726 | (eq N 1) | 7768 | (eq N 1) |
| 7727 | (string-match "|" (buffer-substring (point-at-bol) (point))) | 7769 | (string-match "|" (buffer-substring (point-at-bol) (point))) |
| 7728 | (looking-at ".*?|")) | 7770 | (looking-at ".*?|")) |
| 7729 | (let ((pos (point))) | 7771 | (let ((pos (point))) |
| 7730 | (backward-delete-char N) | 7772 | (backward-delete-char N) |
| 7731 | (skip-chars-forward "^|") | 7773 | (skip-chars-forward "^|") |
| 7732 | (insert " ") | 7774 | (insert " ") |
| 7733 | (goto-char (1- pos))) | 7775 | (goto-char (1- pos))) |
| 7734 | (delete-backward-char N))) | 7776 | (delete-backward-char N))) |
| 7735 | 7777 | ||
| 7736 | (defun orgtbl-delete-char (N) | 7778 | (defun orgtbl-delete-char (N) |
| @@ -7741,15 +7783,15 @@ will still be marked for re-alignment, because a narrow field may lead to | |||
| 7741 | a reduced column width." | 7783 | a reduced column width." |
| 7742 | (interactive "p") | 7784 | (interactive "p") |
| 7743 | (if (and (org-at-table-p) | 7785 | (if (and (org-at-table-p) |
| 7744 | (not (bolp)) | 7786 | (not (bolp)) |
| 7745 | (not (= (char-after) ?|)) | 7787 | (not (= (char-after) ?|)) |
| 7746 | (eq N 1)) | 7788 | (eq N 1)) |
| 7747 | (if (looking-at ".*?|") | 7789 | (if (looking-at ".*?|") |
| 7748 | (let ((pos (point))) | 7790 | (let ((pos (point))) |
| 7749 | (replace-match (concat | 7791 | (replace-match (concat |
| 7750 | (substring (match-string 0) 1 -1) | 7792 | (substring (match-string 0) 1 -1) |
| 7751 | " |")) | 7793 | " |")) |
| 7752 | (goto-char pos))) | 7794 | (goto-char pos))) |
| 7753 | (delete-char N))) | 7795 | (delete-char N))) |
| 7754 | 7796 | ||
| 7755 | ;;; Exporting | 7797 | ;;; Exporting |
| @@ -7759,29 +7801,29 @@ a reduced column width." | |||
| 7759 | (defun org-export-find-first-heading-line (list) | 7801 | (defun org-export-find-first-heading-line (list) |
| 7760 | "Remove all lines from LIST which are before the first headline." | 7802 | "Remove all lines from LIST which are before the first headline." |
| 7761 | (let ((orig-list list) | 7803 | (let ((orig-list list) |
| 7762 | (re (concat "^" outline-regexp))) | 7804 | (re (concat "^" outline-regexp))) |
| 7763 | (while (and list | 7805 | (while (and list |
| 7764 | (not (string-match re (car list)))) | 7806 | (not (string-match re (car list)))) |
| 7765 | (pop list)) | 7807 | (pop list)) |
| 7766 | (or list orig-list))) | 7808 | (or list orig-list))) |
| 7767 | 7809 | ||
| 7768 | (defun org-skip-comments (lines) | 7810 | (defun org-skip-comments (lines) |
| 7769 | "Skip lines starting with \"#\" and subtrees starting with COMMENT." | 7811 | "Skip lines starting with \"#\" and subtrees starting with COMMENT." |
| 7770 | (let ((re1 (concat "^\\(\\*+\\)[ \t]+" org-comment-string)) | 7812 | (let ((re1 (concat "^\\(\\*+\\)[ \t]+" org-comment-string)) |
| 7771 | (re2 "^\\(\\*+\\)[ \t\n\r]") | 7813 | (re2 "^\\(\\*+\\)[ \t\n\r]") |
| 7772 | rtn line level) | 7814 | rtn line level) |
| 7773 | (while (setq line (pop lines)) | 7815 | (while (setq line (pop lines)) |
| 7774 | (cond | 7816 | (cond |
| 7775 | ((and (string-match re1 line) | 7817 | ((and (string-match re1 line) |
| 7776 | (setq level (- (match-end 1) (match-beginning 1)))) | 7818 | (setq level (- (match-end 1) (match-beginning 1)))) |
| 7777 | ;; Beginning of a COMMENT subtree. Skip it. | 7819 | ;; Beginning of a COMMENT subtree. Skip it. |
| 7778 | (while (and (setq line (pop lines)) | 7820 | (while (and (setq line (pop lines)) |
| 7779 | (or (not (string-match re2 line)) | 7821 | (or (not (string-match re2 line)) |
| 7780 | (> (- (match-end 1) (match-beginning 1)) level)))) | 7822 | (> (- (match-end 1) (match-beginning 1)) level)))) |
| 7781 | (setq lines (cons line lines))) | 7823 | (setq lines (cons line lines))) |
| 7782 | ((string-match "^#" line) | 7824 | ((string-match "^#" line) |
| 7783 | ;; an ordinary comment line | 7825 | ;; an ordinary comment line |
| 7784 | ) | 7826 | ) |
| 7785 | (t (setq rtn (cons line rtn))))) | 7827 | (t (setq rtn (cons line rtn))))) |
| 7786 | (nreverse rtn))) | 7828 | (nreverse rtn))) |
| 7787 | 7829 | ||
| @@ -8098,29 +8140,29 @@ underlined headlines. The default is 3." | |||
| 8098 | (interactive "P") | 8140 | (interactive "P") |
| 8099 | (setq-default org-todo-line-regexp org-todo-line-regexp) | 8141 | (setq-default org-todo-line-regexp org-todo-line-regexp) |
| 8100 | (let* ((region | 8142 | (let* ((region |
| 8101 | (buffer-substring | 8143 | (buffer-substring |
| 8102 | (if (org-region-active-p) (region-beginning) (point-min)) | 8144 | (if (org-region-active-p) (region-beginning) (point-min)) |
| 8103 | (if (org-region-active-p) (region-end) (point-max)))) | 8145 | (if (org-region-active-p) (region-end) (point-max)))) |
| 8104 | (lines (org-export-find-first-heading-line | 8146 | (lines (org-export-find-first-heading-line |
| 8105 | (org-skip-comments (org-split-string region "[\r\n]")))) | 8147 | (org-skip-comments (org-split-string region "[\r\n]")))) |
| 8106 | (org-startup-with-deadline-check nil) | 8148 | (org-startup-with-deadline-check nil) |
| 8107 | (level 0) line txt | 8149 | (level 0) line txt |
| 8108 | (umax nil) | 8150 | (umax nil) |
| 8109 | (case-fold-search nil) | 8151 | (case-fold-search nil) |
| 8110 | (filename (concat (file-name-sans-extension (buffer-file-name)) | 8152 | (filename (concat (file-name-sans-extension (buffer-file-name)) |
| 8111 | ".txt")) | 8153 | ".txt")) |
| 8112 | (buffer (find-file-noselect filename)) | 8154 | (buffer (find-file-noselect filename)) |
| 8113 | (levels-open (make-vector org-level-max nil)) | 8155 | (levels-open (make-vector org-level-max nil)) |
| 8114 | (date (format-time-string "%Y/%m/%d" (current-time))) | 8156 | (date (format-time-string "%Y/%m/%d" (current-time))) |
| 8115 | (time (format-time-string "%X" (current-time))) | 8157 | (time (format-time-string "%X" (current-time))) |
| 8116 | (author user-full-name) | 8158 | (author user-full-name) |
| 8117 | (title (buffer-name)) | 8159 | (title (buffer-name)) |
| 8118 | (options nil) | 8160 | (options nil) |
| 8119 | (email user-mail-address) | 8161 | (email user-mail-address) |
| 8120 | (language org-export-default-language) | 8162 | (language org-export-default-language) |
| 8121 | (text nil) | 8163 | (text nil) |
| 8122 | (todo nil) | 8164 | (todo nil) |
| 8123 | (lang-words nil)) | 8165 | (lang-words nil)) |
| 8124 | 8166 | ||
| 8125 | (setq org-last-level 1) | 8167 | (setq org-last-level 1) |
| 8126 | (org-init-section-numbers) | 8168 | (org-init-section-numbers) |
| @@ -8131,7 +8173,7 @@ underlined headlines. The default is 3." | |||
| 8131 | (org-parse-key-lines) | 8173 | (org-parse-key-lines) |
| 8132 | 8174 | ||
| 8133 | (setq lang-words (or (assoc language org-export-language-setup) | 8175 | (setq lang-words (or (assoc language org-export-language-setup) |
| 8134 | (assoc "en" org-export-language-setup))) | 8176 | (assoc "en" org-export-language-setup))) |
| 8135 | (if org-export-ascii-show-new-buffer | 8177 | (if org-export-ascii-show-new-buffer |
| 8136 | (switch-to-buffer-other-window buffer) | 8178 | (switch-to-buffer-other-window buffer) |
| 8137 | (set-buffer buffer)) | 8179 | (set-buffer buffer)) |
| @@ -8139,49 +8181,49 @@ underlined headlines. The default is 3." | |||
| 8139 | (fundamental-mode) | 8181 | (fundamental-mode) |
| 8140 | (if options (org-parse-export-options options)) | 8182 | (if options (org-parse-export-options options)) |
| 8141 | (setq umax (if arg (prefix-numeric-value arg) | 8183 | (setq umax (if arg (prefix-numeric-value arg) |
| 8142 | org-export-headline-levels)) | 8184 | org-export-headline-levels)) |
| 8143 | 8185 | ||
| 8144 | ;; File header | 8186 | ;; File header |
| 8145 | (if title (org-insert-centered title ?=)) | 8187 | (if title (org-insert-centered title ?=)) |
| 8146 | (insert "\n") | 8188 | (insert "\n") |
| 8147 | (if (or author email) | 8189 | (if (or author email) |
| 8148 | (insert (concat (nth 1 lang-words) ": " (or author "") | 8190 | (insert (concat (nth 1 lang-words) ": " (or author "") |
| 8149 | (if email (concat " <" email ">") "") | 8191 | (if email (concat " <" email ">") "") |
| 8150 | "\n"))) | 8192 | "\n"))) |
| 8151 | (if (and date time) | 8193 | (if (and date time) |
| 8152 | (insert (concat (nth 2 lang-words) ": " date " " time "\n"))) | 8194 | (insert (concat (nth 2 lang-words) ": " date " " time "\n"))) |
| 8153 | (if text (insert (concat (org-html-expand-for-ascii text) "\n\n"))) | 8195 | (if text (insert (concat (org-html-expand-for-ascii text) "\n\n"))) |
| 8154 | 8196 | ||
| 8155 | (insert "\n\n") | 8197 | (insert "\n\n") |
| 8156 | 8198 | ||
| 8157 | (if org-export-with-toc | 8199 | (if org-export-with-toc |
| 8158 | (progn | 8200 | (progn |
| 8159 | (insert (nth 3 lang-words) "\n" | 8201 | (insert (nth 3 lang-words) "\n" |
| 8160 | (make-string (length (nth 3 lang-words)) ?=) "\n") | 8202 | (make-string (length (nth 3 lang-words)) ?=) "\n") |
| 8161 | (mapcar '(lambda (line) | 8203 | (mapcar '(lambda (line) |
| 8162 | (if (string-match org-todo-line-regexp | 8204 | (if (string-match org-todo-line-regexp |
| 8163 | line) | 8205 | line) |
| 8164 | ;; This is a headline | 8206 | ;; This is a headline |
| 8165 | (progn | 8207 | (progn |
| 8166 | (setq level (- (match-end 1) (match-beginning 1)) | 8208 | (setq level (- (match-end 1) (match-beginning 1)) |
| 8167 | txt (match-string 3 line) | 8209 | txt (match-string 3 line) |
| 8168 | todo | 8210 | todo |
| 8169 | (or (and (match-beginning 2) | 8211 | (or (and (match-beginning 2) |
| 8170 | (not (equal (match-string 2 line) | 8212 | (not (equal (match-string 2 line) |
| 8171 | org-done-string))) | 8213 | org-done-string))) |
| 8172 | ; TODO, not DONE | 8214 | ; TODO, not DONE |
| 8173 | (and (= level umax) | 8215 | (and (= level umax) |
| 8174 | (org-search-todo-below | 8216 | (org-search-todo-below |
| 8175 | line lines level)))) | 8217 | line lines level)))) |
| 8176 | (setq txt (org-html-expand-for-ascii txt)) | 8218 | (setq txt (org-html-expand-for-ascii txt)) |
| 8177 | 8219 | ||
| 8178 | (if org-export-with-section-numbers | 8220 | (if org-export-with-section-numbers |
| 8179 | (setq txt (concat (org-section-number level) | 8221 | (setq txt (concat (org-section-number level) |
| 8180 | " " txt))) | 8222 | " " txt))) |
| 8181 | (if (<= level umax) | 8223 | (if (<= level umax) |
| 8182 | (progn | 8224 | (progn |
| 8183 | (insert | 8225 | (insert |
| 8184 | (make-string (* (1- level) 4) ?\ ) | 8226 | (make-string (* (1- level) 4) ?\ ) |
| 8185 | (format (if todo "%s (*)\n" "%s\n") txt)) | 8227 | (format (if todo "%s (*)\n" "%s\n") txt)) |
| 8186 | (setq org-last-level level)) | 8228 | (setq org-last-level level)) |
| 8187 | )))) | 8229 | )))) |
| @@ -8193,10 +8235,10 @@ underlined headlines. The default is 3." | |||
| 8193 | (setq line (org-html-expand-for-ascii line)) | 8235 | (setq line (org-html-expand-for-ascii line)) |
| 8194 | (cond | 8236 | (cond |
| 8195 | ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) | 8237 | ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) |
| 8196 | ;; a Headline | 8238 | ;; a Headline |
| 8197 | (setq level (- (match-end 1) (match-beginning 1)) | 8239 | (setq level (- (match-end 1) (match-beginning 1)) |
| 8198 | txt (match-string 2 line)) | 8240 | txt (match-string 2 line)) |
| 8199 | (org-ascii-level-start level txt umax)) | 8241 | (org-ascii-level-start level txt umax)) |
| 8200 | (t (insert line "\n")))) | 8242 | (t (insert line "\n")))) |
| 8201 | (normal-mode) | 8243 | (normal-mode) |
| 8202 | (save-buffer) | 8244 | (save-buffer) |
| @@ -8205,19 +8247,19 @@ underlined headlines. The default is 3." | |||
| 8205 | (defun org-search-todo-below (line lines level) | 8247 | (defun org-search-todo-below (line lines level) |
| 8206 | "Search the subtree below LINE for any TODO entries." | 8248 | "Search the subtree below LINE for any TODO entries." |
| 8207 | (let ((rest (cdr (memq line lines))) | 8249 | (let ((rest (cdr (memq line lines))) |
| 8208 | (re org-todo-line-regexp) | 8250 | (re org-todo-line-regexp) |
| 8209 | line lv todo) | 8251 | line lv todo) |
| 8210 | (catch 'exit | 8252 | (catch 'exit |
| 8211 | (while (setq line (pop rest)) | 8253 | (while (setq line (pop rest)) |
| 8212 | (if (string-match re line) | 8254 | (if (string-match re line) |
| 8213 | (progn | 8255 | (progn |
| 8214 | (setq lv (- (match-end 1) (match-beginning 1)) | 8256 | (setq lv (- (match-end 1) (match-beginning 1)) |
| 8215 | todo (and (match-beginning 2) | 8257 | todo (and (match-beginning 2) |
| 8216 | (not (equal (match-string 2 line) | 8258 | (not (equal (match-string 2 line) |
| 8217 | org-done-string)))) | 8259 | org-done-string)))) |
| 8218 | ; TODO, not DONE | 8260 | ; TODO, not DONE |
| 8219 | (if (<= lv level) (throw 'exit nil)) | 8261 | (if (<= lv level) (throw 'exit nil)) |
| 8220 | (if todo (throw 'exit t)))))))) | 8262 | (if todo (throw 'exit t)))))))) |
| 8221 | 8263 | ||
| 8222 | ;; FIXME: Try to handle <b> and <i> as faces via text properties. | 8264 | ;; FIXME: Try to handle <b> and <i> as faces via text properties. |
| 8223 | ;; FIXME: Can I implement *bold*,/italic/ and _underline_ for ASCII export? | 8265 | ;; FIXME: Can I implement *bold*,/italic/ and _underline_ for ASCII export? |
| @@ -8225,8 +8267,8 @@ underlined headlines. The default is 3." | |||
| 8225 | "Handle quoted HTML for ASCII export." | 8267 | "Handle quoted HTML for ASCII export." |
| 8226 | (if org-export-html-expand | 8268 | (if org-export-html-expand |
| 8227 | (while (string-match "@<[^<>\n]*>" line) | 8269 | (while (string-match "@<[^<>\n]*>" line) |
| 8228 | ;; We just remove the tags for now. | 8270 | ;; We just remove the tags for now. |
| 8229 | (setq line (replace-match "" nil nil line)))) | 8271 | (setq line (replace-match "" nil nil line)))) |
| 8230 | line) | 8272 | line) |
| 8231 | 8273 | ||
| 8232 | (defun org-insert-centered (s &optional underline) | 8274 | (defun org-insert-centered (s &optional underline) |
| @@ -8234,21 +8276,21 @@ underlined headlines. The default is 3." | |||
| 8234 | (let ((ind (max (/ (- 80 (length s)) 2) 0))) | 8276 | (let ((ind (max (/ (- 80 (length s)) 2) 0))) |
| 8235 | (insert (make-string ind ?\ ) s "\n") | 8277 | (insert (make-string ind ?\ ) s "\n") |
| 8236 | (if underline | 8278 | (if underline |
| 8237 | (insert (make-string ind ?\ ) | 8279 | (insert (make-string ind ?\ ) |
| 8238 | (make-string (length s) underline) | 8280 | (make-string (length s) underline) |
| 8239 | "\n")))) | 8281 | "\n")))) |
| 8240 | 8282 | ||
| 8241 | (defun org-ascii-level-start (level title umax) | 8283 | (defun org-ascii-level-start (level title umax) |
| 8242 | "Insert a new level in ASCII export." | 8284 | "Insert a new level in ASCII export." |
| 8243 | (let (char) | 8285 | (let (char) |
| 8244 | (if (> level umax) | 8286 | (if (> level umax) |
| 8245 | (insert (make-string (* 2 (- level umax 1)) ?\ ) "* " title "\n") | 8287 | (insert (make-string (* 2 (- level umax 1)) ?\ ) "* " title "\n") |
| 8246 | (if (or (not (equal (char-before) ?\n)) | 8288 | (if (or (not (equal (char-before) ?\n)) |
| 8247 | (not (equal (char-before (1- (point))) ?\n))) | 8289 | (not (equal (char-before (1- (point))) ?\n))) |
| 8248 | (insert "\n")) | 8290 | (insert "\n")) |
| 8249 | (setq char (nth (- umax level) (reverse org-ascii-underline))) | 8291 | (setq char (nth (- umax level) (reverse org-ascii-underline))) |
| 8250 | (if org-export-with-section-numbers | 8292 | (if org-export-with-section-numbers |
| 8251 | (setq title (concat (org-section-number level) " " title))) | 8293 | (setq title (concat (org-section-number level) " " title))) |
| 8252 | (insert title "\n" (make-string (string-width title) char) "\n")))) | 8294 | (insert title "\n" (make-string (string-width title) char) "\n")))) |
| 8253 | 8295 | ||
| 8254 | (defun org-export-copy-visible () | 8296 | (defun org-export-copy-visible () |
| @@ -8257,29 +8299,29 @@ Also removes the first line of the buffer if it specifies a mode, | |||
| 8257 | and all options lines." | 8299 | and all options lines." |
| 8258 | (interactive) | 8300 | (interactive) |
| 8259 | (let* ((filename (concat (file-name-sans-extension (buffer-file-name)) | 8301 | (let* ((filename (concat (file-name-sans-extension (buffer-file-name)) |
| 8260 | ".txt")) | 8302 | ".txt")) |
| 8261 | (buffer (find-file-noselect filename)) | 8303 | (buffer (find-file-noselect filename)) |
| 8262 | (ore (concat | 8304 | (ore (concat |
| 8263 | (org-make-options-regexp | 8305 | (org-make-options-regexp |
| 8264 | '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" | 8306 | '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" |
| 8265 | "STARTUP" "ARCHIVE" | 8307 | "STARTUP" "ARCHIVE" |
| 8266 | "TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE")) | 8308 | "TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE")) |
| 8267 | (if org-noutline-p "\\(\n\\|$\\)" ""))) | 8309 | (if org-noutline-p "\\(\n\\|$\\)" ""))) |
| 8268 | s e) | 8310 | s e) |
| 8269 | (with-current-buffer buffer | 8311 | (with-current-buffer buffer |
| 8270 | (erase-buffer) | 8312 | (erase-buffer) |
| 8271 | (text-mode)) | 8313 | (text-mode)) |
| 8272 | (save-excursion | 8314 | (save-excursion |
| 8273 | (setq s (goto-char (point-min))) | 8315 | (setq s (goto-char (point-min))) |
| 8274 | (while (not (= (point) (point-max))) | 8316 | (while (not (= (point) (point-max))) |
| 8275 | (goto-char (org-find-invisible)) | 8317 | (goto-char (org-find-invisible)) |
| 8276 | (append-to-buffer buffer s (point)) | 8318 | (append-to-buffer buffer s (point)) |
| 8277 | (setq s (goto-char (org-find-visible))))) | 8319 | (setq s (goto-char (org-find-visible))))) |
| 8278 | (switch-to-buffer-other-window buffer) | 8320 | (switch-to-buffer-other-window buffer) |
| 8279 | (newline) | 8321 | (newline) |
| 8280 | (goto-char (point-min)) | 8322 | (goto-char (point-min)) |
| 8281 | (if (looking-at ".*-\\*- mode:.*\n") | 8323 | (if (looking-at ".*-\\*- mode:.*\n") |
| 8282 | (replace-match "")) | 8324 | (replace-match "")) |
| 8283 | (while (re-search-forward ore nil t) | 8325 | (while (re-search-forward ore nil t) |
| 8284 | (replace-match "")) | 8326 | (replace-match "")) |
| 8285 | (goto-char (point-min)))) | 8327 | (goto-char (point-min)))) |
| @@ -8287,17 +8329,17 @@ and all options lines." | |||
| 8287 | (defun org-find-visible () | 8329 | (defun org-find-visible () |
| 8288 | (if (featurep 'noutline) | 8330 | (if (featurep 'noutline) |
| 8289 | (let ((s (point))) | 8331 | (let ((s (point))) |
| 8290 | (while (and (not (= (point-max) (setq s (next-overlay-change s)))) | 8332 | (while (and (not (= (point-max) (setq s (next-overlay-change s)))) |
| 8291 | (get-char-property s 'invisible))) | 8333 | (get-char-property s 'invisible))) |
| 8292 | s) | 8334 | s) |
| 8293 | (skip-chars-forward "^\n") | 8335 | (skip-chars-forward "^\n") |
| 8294 | (point))) | 8336 | (point))) |
| 8295 | (defun org-find-invisible () | 8337 | (defun org-find-invisible () |
| 8296 | (if (featurep 'noutline) | 8338 | (if (featurep 'noutline) |
| 8297 | (let ((s (point))) | 8339 | (let ((s (point))) |
| 8298 | (while (and (not (= (point-max) (setq s (next-overlay-change s)))) | 8340 | (while (and (not (= (point-max) (setq s (next-overlay-change s)))) |
| 8299 | (not (get-char-property s 'invisible)))) | 8341 | (not (get-char-property s 'invisible)))) |
| 8300 | s) | 8342 | s) |
| 8301 | (skip-chars-forward "^\r") | 8343 | (skip-chars-forward "^\r") |
| 8302 | (point))) | 8344 | (point))) |
| 8303 | 8345 | ||
| @@ -8338,7 +8380,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff." | |||
| 8338 | (mapconcat 'identity org-todo-keywords " ") | 8380 | (mapconcat 'identity org-todo-keywords " ") |
| 8339 | "Me Jason Marie DONE") | 8381 | "Me Jason Marie DONE") |
| 8340 | (cdr (assoc org-startup-folded | 8382 | (cdr (assoc org-startup-folded |
| 8341 | '((nil . "nofold")(t . "fold")(content . "content")))) | 8383 | '((nil . "nofold")(t . "fold")(content . "content")))) |
| 8342 | (if org-startup-with-deadline-check "dlcheck" "nodlcheck") | 8384 | (if org-startup-with-deadline-check "dlcheck" "nodlcheck") |
| 8343 | org-archive-location | 8385 | org-archive-location |
| 8344 | )) | 8386 | )) |
| @@ -8349,7 +8391,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff." | |||
| 8349 | (if (not (bolp)) (newline)) | 8391 | (if (not (bolp)) (newline)) |
| 8350 | (let ((s (org-get-current-options))) | 8392 | (let ((s (org-get-current-options))) |
| 8351 | (and (string-match "#\\+CATEGORY" s) | 8393 | (and (string-match "#\\+CATEGORY" s) |
| 8352 | (setq s (substring s 0 (match-beginning 0)))) | 8394 | (setq s (substring s 0 (match-beginning 0)))) |
| 8353 | (insert s))) | 8395 | (insert s))) |
| 8354 | 8396 | ||
| 8355 | (defun org-toggle-fixed-width-section (arg) | 8397 | (defun org-toggle-fixed-width-section (arg) |
| @@ -8363,29 +8405,29 @@ bar to all lines, in the column given by the beginning of the region. | |||
| 8363 | If there is a numerical prefix ARG, create ARG new lines starting with \"|\"." | 8405 | If there is a numerical prefix ARG, create ARG new lines starting with \"|\"." |
| 8364 | (interactive "P") | 8406 | (interactive "P") |
| 8365 | (let* ((cc 0) | 8407 | (let* ((cc 0) |
| 8366 | (regionp (org-region-active-p)) | 8408 | (regionp (org-region-active-p)) |
| 8367 | (beg (if regionp (region-beginning) (point))) | 8409 | (beg (if regionp (region-beginning) (point))) |
| 8368 | (end (if regionp (region-end))) | 8410 | (end (if regionp (region-end))) |
| 8369 | (nlines (or arg (if (and beg end) (count-lines beg end) 1))) | 8411 | (nlines (or arg (if (and beg end) (count-lines beg end) 1))) |
| 8370 | (re "[ \t]*\\(:\\)") | 8412 | (re "[ \t]*\\(:\\)") |
| 8371 | off) | 8413 | off) |
| 8372 | (save-excursion | 8414 | (save-excursion |
| 8373 | (goto-char beg) | 8415 | (goto-char beg) |
| 8374 | (setq cc (current-column)) | 8416 | (setq cc (current-column)) |
| 8375 | (beginning-of-line 1) | 8417 | (beginning-of-line 1) |
| 8376 | (setq off (looking-at re)) | 8418 | (setq off (looking-at re)) |
| 8377 | (while (> nlines 0) | 8419 | (while (> nlines 0) |
| 8378 | (setq nlines (1- nlines)) | 8420 | (setq nlines (1- nlines)) |
| 8379 | (beginning-of-line 1) | 8421 | (beginning-of-line 1) |
| 8380 | (cond | 8422 | (cond |
| 8381 | (arg | 8423 | (arg |
| 8382 | (move-to-column cc t) | 8424 | (move-to-column cc t) |
| 8383 | (insert ":\n") | 8425 | (insert ":\n") |
| 8384 | (forward-line -1)) | 8426 | (forward-line -1)) |
| 8385 | ((and off (looking-at re)) | 8427 | ((and off (looking-at re)) |
| 8386 | (replace-match "" t t nil 1)) | 8428 | (replace-match "" t t nil 1)) |
| 8387 | ((not off) (move-to-column cc t) (insert ":"))) | 8429 | ((not off) (move-to-column cc t) (insert ":"))) |
| 8388 | (forward-line 1))))) | 8430 | (forward-line 1))))) |
| 8389 | 8431 | ||
| 8390 | (defun org-export-as-html-and-open (arg) | 8432 | (defun org-export-as-html-and-open (arg) |
| 8391 | "Export the outline as HTML and immediately open it with a browser. | 8433 | "Export the outline as HTML and immediately open it with a browser. |
| @@ -8414,32 +8456,32 @@ headlines. The default is 3. Lower levels will become bulleted lists." | |||
| 8414 | (setq-default org-deadline-line-regexp org-deadline-line-regexp) | 8456 | (setq-default org-deadline-line-regexp org-deadline-line-regexp) |
| 8415 | (setq-default org-done-string org-done-string) | 8457 | (setq-default org-done-string org-done-string) |
| 8416 | (let* ((region-p (org-region-active-p)) | 8458 | (let* ((region-p (org-region-active-p)) |
| 8417 | (region | 8459 | (region |
| 8418 | (buffer-substring | 8460 | (buffer-substring |
| 8419 | (if region-p (region-beginning) (point-min)) | 8461 | (if region-p (region-beginning) (point-min)) |
| 8420 | (if region-p (region-end) (point-max)))) | 8462 | (if region-p (region-end) (point-max)))) |
| 8421 | (all_lines | 8463 | (all_lines |
| 8422 | (org-skip-comments (org-split-string region "[\r\n]"))) | 8464 | (org-skip-comments (org-split-string region "[\r\n]"))) |
| 8423 | (lines (org-export-find-first-heading-line all_lines)) | 8465 | (lines (org-export-find-first-heading-line all_lines)) |
| 8424 | (level 0) (line "") (origline "") txt todo | 8466 | (level 0) (line "") (origline "") txt todo |
| 8425 | (umax nil) | 8467 | (umax nil) |
| 8426 | (filename (concat (file-name-sans-extension (buffer-file-name)) | 8468 | (filename (concat (file-name-sans-extension (buffer-file-name)) |
| 8427 | ".html")) | 8469 | ".html")) |
| 8428 | (buffer (find-file-noselect filename)) | 8470 | (buffer (find-file-noselect filename)) |
| 8429 | (levels-open (make-vector org-level-max nil)) | 8471 | (levels-open (make-vector org-level-max nil)) |
| 8430 | (date (format-time-string "%Y/%m/%d" (current-time))) | 8472 | (date (format-time-string "%Y/%m/%d" (current-time))) |
| 8431 | (time (format-time-string "%X" (current-time))) | 8473 | (time (format-time-string "%X" (current-time))) |
| 8432 | (author user-full-name) | 8474 | (author user-full-name) |
| 8433 | (title (buffer-name)) | 8475 | (title (buffer-name)) |
| 8434 | (options nil) | 8476 | (options nil) |
| 8435 | (email user-mail-address) | 8477 | (email user-mail-address) |
| 8436 | (language org-export-default-language) | 8478 | (language org-export-default-language) |
| 8437 | (text nil) | 8479 | (text nil) |
| 8438 | (lang-words nil) | 8480 | (lang-words nil) |
| 8439 | (head-count 0) cnt | 8481 | (head-count 0) cnt |
| 8440 | (start 0) | 8482 | (start 0) |
| 8441 | table-open type | 8483 | table-open type |
| 8442 | table-buffer table-orig-buffer | 8484 | table-buffer table-orig-buffer |
| 8443 | ) | 8485 | ) |
| 8444 | (message "Exporting...") | 8486 | (message "Exporting...") |
| 8445 | 8487 | ||
| @@ -8449,22 +8491,22 @@ headlines. The default is 3. Lower levels will become bulleted lists." | |||
| 8449 | ;; Search for the export key lines | 8491 | ;; Search for the export key lines |
| 8450 | (org-parse-key-lines) | 8492 | (org-parse-key-lines) |
| 8451 | (setq lang-words (or (assoc language org-export-language-setup) | 8493 | (setq lang-words (or (assoc language org-export-language-setup) |
| 8452 | (assoc "en" org-export-language-setup))) | 8494 | (assoc "en" org-export-language-setup))) |
| 8453 | 8495 | ||
| 8454 | ;; Switch to the output buffer | 8496 | ;; Switch to the output buffer |
| 8455 | (if (or hidden (not org-export-html-show-new-buffer)) | 8497 | (if (or hidden (not org-export-html-show-new-buffer)) |
| 8456 | (set-buffer buffer) | 8498 | (set-buffer buffer) |
| 8457 | (switch-to-buffer-other-window buffer)) | 8499 | (switch-to-buffer-other-window buffer)) |
| 8458 | (erase-buffer) | 8500 | (erase-buffer) |
| 8459 | (fundamental-mode) | 8501 | (fundamental-mode) |
| 8460 | (let ((case-fold-search nil)) | 8502 | (let ((case-fold-search nil)) |
| 8461 | (if options (org-parse-export-options options)) | 8503 | (if options (org-parse-export-options options)) |
| 8462 | (setq umax (if arg (prefix-numeric-value arg) | 8504 | (setq umax (if arg (prefix-numeric-value arg) |
| 8463 | org-export-headline-levels)) | 8505 | org-export-headline-levels)) |
| 8464 | 8506 | ||
| 8465 | ;; File header | 8507 | ;; File header |
| 8466 | (insert (format | 8508 | (insert (format |
| 8467 | "<html lang=\"%s\"><head> | 8509 | "<html lang=\"%s\"><head> |
| 8468 | <title>%s</title> | 8510 | <title>%s</title> |
| 8469 | <meta http-equiv=\"Content-Type\" content=\"text/html\"> | 8511 | <meta http-equiv=\"Content-Type\" content=\"text/html\"> |
| 8470 | <meta name=generator content=\"Org-mode\"> | 8512 | <meta name=generator content=\"Org-mode\"> |
| @@ -8472,182 +8514,182 @@ headlines. The default is 3. Lower levels will become bulleted lists." | |||
| 8472 | <meta name=author content=\"%s\"> | 8514 | <meta name=author content=\"%s\"> |
| 8473 | </head><body> | 8515 | </head><body> |
| 8474 | " | 8516 | " |
| 8475 | language (org-html-expand title) date time author)) | 8517 | language (org-html-expand title) date time author)) |
| 8476 | (if title (insert (concat "<H1 align=\"center\">" | 8518 | (if title (insert (concat "<H1 align=\"center\">" |
| 8477 | (org-html-expand title) "</H1>\n"))) | 8519 | (org-html-expand title) "</H1>\n"))) |
| 8478 | (if author (insert (concat (nth 1 lang-words) ": " author "\n"))) | 8520 | (if author (insert (concat (nth 1 lang-words) ": " author "\n"))) |
| 8479 | (if email (insert (concat "<a href=\"mailto:" email "\"><" | 8521 | (if email (insert (concat "<a href=\"mailto:" email "\"><" |
| 8480 | email "></a>\n"))) | 8522 | email "></a>\n"))) |
| 8481 | (if (or author email) (insert "<br>\n")) | 8523 | (if (or author email) (insert "<br>\n")) |
| 8482 | (if (and date time) (insert (concat (nth 2 lang-words) ": " | 8524 | (if (and date time) (insert (concat (nth 2 lang-words) ": " |
| 8483 | date " " time "<br>\n"))) | 8525 | date " " time "<br>\n"))) |
| 8484 | (if text (insert (concat "<p>\n" (org-html-expand text)))) | 8526 | (if text (insert (concat "<p>\n" (org-html-expand text)))) |
| 8485 | (if org-export-with-toc | 8527 | (if org-export-with-toc |
| 8486 | (progn | 8528 | (progn |
| 8487 | (insert (format "<H2>%s</H2>\n" (nth 3 lang-words))) | 8529 | (insert (format "<H2>%s</H2>\n" (nth 3 lang-words))) |
| 8488 | (insert "<ul>\n") | 8530 | (insert "<ul>\n") |
| 8489 | (mapcar '(lambda (line) | 8531 | (mapcar '(lambda (line) |
| 8490 | (if (string-match org-todo-line-regexp line) | 8532 | (if (string-match org-todo-line-regexp line) |
| 8491 | ;; This is a headline | 8533 | ;; This is a headline |
| 8492 | (progn | 8534 | (progn |
| 8493 | (setq level (- (match-end 1) (match-beginning 1)) | 8535 | (setq level (- (match-end 1) (match-beginning 1)) |
| 8494 | txt (save-match-data | 8536 | txt (save-match-data |
| 8495 | (org-html-expand | 8537 | (org-html-expand |
| 8496 | (match-string 3 line))) | 8538 | (match-string 3 line))) |
| 8497 | todo | 8539 | todo |
| 8498 | (or (and (match-beginning 2) | 8540 | (or (and (match-beginning 2) |
| 8499 | (not (equal (match-string 2 line) | 8541 | (not (equal (match-string 2 line) |
| 8500 | org-done-string))) | 8542 | org-done-string))) |
| 8501 | ; TODO, not DONE | 8543 | ; TODO, not DONE |
| 8502 | (and (= level umax) | 8544 | (and (= level umax) |
| 8503 | (org-search-todo-below | 8545 | (org-search-todo-below |
| 8504 | line lines level)))) | 8546 | line lines level)))) |
| 8505 | (if org-export-with-section-numbers | 8547 | (if org-export-with-section-numbers |
| 8506 | (setq txt (concat (org-section-number level) | 8548 | (setq txt (concat (org-section-number level) |
| 8507 | " " txt))) | 8549 | " " txt))) |
| 8508 | (if (<= level umax) | 8550 | (if (<= level umax) |
| 8509 | (progn | 8551 | (progn |
| 8510 | (setq head-count (+ head-count 1)) | 8552 | (setq head-count (+ head-count 1)) |
| 8511 | (if (> level org-last-level) | 8553 | (if (> level org-last-level) |
| 8512 | (progn | 8554 | (progn |
| 8513 | (setq cnt (- level org-last-level)) | 8555 | (setq cnt (- level org-last-level)) |
| 8514 | (while (>= (setq cnt (1- cnt)) 0) | 8556 | (while (>= (setq cnt (1- cnt)) 0) |
| 8515 | (insert "<ul>")) | 8557 | (insert "<ul>")) |
| 8516 | (insert "\n"))) | 8558 | (insert "\n"))) |
| 8517 | (if (< level org-last-level) | 8559 | (if (< level org-last-level) |
| 8518 | (progn | 8560 | (progn |
| 8519 | (setq cnt (- org-last-level level)) | 8561 | (setq cnt (- org-last-level level)) |
| 8520 | (while (>= (setq cnt (1- cnt)) 0) | 8562 | (while (>= (setq cnt (1- cnt)) 0) |
| 8521 | (insert "</ul>")) | 8563 | (insert "</ul>")) |
| 8522 | (insert "\n"))) | 8564 | (insert "\n"))) |
| 8523 | (insert | 8565 | (insert |
| 8524 | (format | 8566 | (format |
| 8525 | (if todo | 8567 | (if todo |
| 8526 | "<li><a href=\"#sec-%d\"><span style='color:red'>%s</span></a></li>\n" | 8568 | "<li><a href=\"#sec-%d\"><span style='color:red'>%s</span></a></li>\n" |
| 8527 | "<li><a href=\"#sec-%d\">%s</a></li>\n") | 8569 | "<li><a href=\"#sec-%d\">%s</a></li>\n") |
| 8528 | head-count txt)) | 8570 | head-count txt)) |
| 8529 | (setq org-last-level level)) | 8571 | (setq org-last-level level)) |
| 8530 | )))) | 8572 | )))) |
| 8531 | lines) | 8573 | lines) |
| 8532 | (while (> org-last-level 0) | 8574 | (while (> org-last-level 0) |
| 8533 | (setq org-last-level (1- org-last-level)) | 8575 | (setq org-last-level (1- org-last-level)) |
| 8534 | (insert "</ul>\n")) | 8576 | (insert "</ul>\n")) |
| 8535 | )) | 8577 | )) |
| 8536 | (setq head-count 0) | 8578 | (setq head-count 0) |
| 8537 | (org-init-section-numbers) | 8579 | (org-init-section-numbers) |
| 8538 | (while (setq line (pop lines) origline line) | 8580 | (while (setq line (pop lines) origline line) |
| 8539 | ;; Protect the links | 8581 | ;; Protect the links |
| 8540 | (setq start 0) | 8582 | (setq start 0) |
| 8541 | (while (string-match org-link-maybe-angles-regexp line start) | 8583 | (while (string-match org-link-maybe-angles-regexp line start) |
| 8542 | (setq start (match-end 0)) | 8584 | (setq start (match-end 0)) |
| 8543 | (setq line (replace-match | 8585 | (setq line (replace-match |
| 8544 | (concat "\000" (match-string 1 line) "\000") | 8586 | (concat "\000" (match-string 1 line) "\000") |
| 8545 | t t line))) | 8587 | t t line))) |
| 8546 | 8588 | ||
| 8547 | ;; replace "<" and ">" by "<" and ">" | 8589 | ;; replace "<" and ">" by "<" and ">" |
| 8548 | ;; handle @<..> HTML tags (replace "@>..<" by "<..>") | 8590 | ;; handle @<..> HTML tags (replace "@>..<" by "<..>") |
| 8549 | (setq line (org-html-expand line)) | 8591 | (setq line (org-html-expand line)) |
| 8550 | 8592 | ||
| 8551 | ;; Verbatim lines | 8593 | ;; Verbatim lines |
| 8552 | (if (and org-export-with-fixed-width | 8594 | (if (and org-export-with-fixed-width |
| 8553 | (string-match "^[ \t]*:\\(.*\\)" line)) | 8595 | (string-match "^[ \t]*:\\(.*\\)" line)) |
| 8554 | (progn | 8596 | (progn |
| 8555 | (let ((l (match-string 1 line))) | 8597 | (let ((l (match-string 1 line))) |
| 8556 | (while (string-match " " l) | 8598 | (while (string-match " " l) |
| 8557 | (setq l (replace-match " " t t l))) | 8599 | (setq l (replace-match " " t t l))) |
| 8558 | (insert "\n<span style='font-family:Courier'>" | 8600 | (insert "\n<span style='font-family:Courier'>" |
| 8559 | l "</span>" | 8601 | l "</span>" |
| 8560 | (if (and lines | 8602 | (if (and lines |
| 8561 | (not (string-match "^[ \t]+\\(:.*\\)" | 8603 | (not (string-match "^[ \t]+\\(:.*\\)" |
| 8562 | (car lines)))) | 8604 | (car lines)))) |
| 8563 | "<br>\n" "\n")))) | 8605 | "<br>\n" "\n")))) |
| 8564 | (setq start 0) | 8606 | (setq start 0) |
| 8565 | (while (string-match org-protected-link-regexp line start) | 8607 | (while (string-match org-protected-link-regexp line start) |
| 8566 | (setq start (- (match-end 0) 2)) | 8608 | (setq start (- (match-end 0) 2)) |
| 8567 | (setq type (match-string 1 line)) | 8609 | (setq type (match-string 1 line)) |
| 8568 | (cond | 8610 | (cond |
| 8569 | ((member type '("http" "https" "ftp" "mailto" "news")) | 8611 | ((member type '("http" "https" "ftp" "mailto" "news")) |
| 8570 | ;; standard URL | 8612 | ;; standard URL |
| 8571 | (setq line (replace-match | 8613 | (setq line (replace-match |
| 8572 | ; "<a href=\"\\1:\\2\"><\\1:\\2></a>" | 8614 | ; "<a href=\"\\1:\\2\"><\\1:\\2></a>" |
| 8573 | "<a href=\"\\1:\\2\">\\1:\\2</a>" | 8615 | "<a href=\"\\1:\\2\">\\1:\\2</a>" |
| 8574 | nil nil line))) | 8616 | nil nil line))) |
| 8575 | ((string= type "file") | 8617 | ((string= type "file") |
| 8576 | ;; FILE link | 8618 | ;; FILE link |
| 8577 | (let* ((filename (match-string 2 line)) | 8619 | (let* ((filename (match-string 2 line)) |
| 8578 | (abs-p (file-name-absolute-p filename)) | 8620 | (abs-p (file-name-absolute-p filename)) |
| 8579 | (thefile (if abs-p (expand-file-name filename) filename)) | 8621 | (thefile (if abs-p (expand-file-name filename) filename)) |
| 8580 | (thefile (save-match-data | 8622 | (thefile (save-match-data |
| 8581 | (if (string-match ":[0-9]+$" thefile) | 8623 | (if (string-match ":[0-9]+$" thefile) |
| 8582 | (replace-match "" t t thefile) | 8624 | (replace-match "" t t thefile) |
| 8583 | thefile))) | 8625 | thefile))) |
| 8584 | (file-is-image-p | 8626 | (file-is-image-p |
| 8585 | (save-match-data | 8627 | (save-match-data |
| 8586 | (string-match (org-image-file-name-regexp) thefile)))) | 8628 | (string-match (org-image-file-name-regexp) thefile)))) |
| 8587 | (setq line (replace-match | 8629 | (setq line (replace-match |
| 8588 | (if (and org-export-html-inline-images | 8630 | (if (and org-export-html-inline-images |
| 8589 | file-is-image-p) | 8631 | file-is-image-p) |
| 8590 | (concat "<img src=\"" thefile "\"/>") | 8632 | (concat "<img src=\"" thefile "\"/>") |
| 8591 | (concat "<a href=\"" thefile "\">\\1:\\2</a>")) | 8633 | (concat "<a href=\"" thefile "\">\\1:\\2</a>")) |
| 8592 | nil nil line)))) | 8634 | nil nil line)))) |
| 8593 | 8635 | ||
| 8594 | ((member type '("bbdb" "vm" "wl" "rmail" "gnus" "shell")) | 8636 | ((member type '("bbdb" "vm" "wl" "rmail" "gnus" "shell")) |
| 8595 | (setq line (replace-match | 8637 | (setq line (replace-match |
| 8596 | "<i><\\1:\\2></i>" nil nil line))))) | 8638 | "<i><\\1:\\2></i>" nil nil line))))) |
| 8597 | 8639 | ||
| 8598 | ;; TODO items | 8640 | ;; TODO items |
| 8599 | (if (and (string-match org-todo-line-regexp line) | 8641 | (if (and (string-match org-todo-line-regexp line) |
| 8600 | (match-beginning 2)) | 8642 | (match-beginning 2)) |
| 8601 | (if (equal (match-string 2 line) org-done-string) | 8643 | (if (equal (match-string 2 line) org-done-string) |
| 8602 | (setq line (replace-match | 8644 | (setq line (replace-match |
| 8603 | "<span style='color:green'>\\2</span>" | 8645 | "<span style='color:green'>\\2</span>" |
| 8604 | nil nil line 2)) | 8646 | nil nil line 2)) |
| 8605 | (setq line (replace-match "<span style='color:red'>\\2</span>" | 8647 | (setq line (replace-match "<span style='color:red'>\\2</span>" |
| 8606 | nil nil line 2)))) | 8648 | nil nil line 2)))) |
| 8607 | 8649 | ||
| 8608 | ;; DEADLINES | 8650 | ;; DEADLINES |
| 8609 | (if (string-match org-deadline-line-regexp line) | 8651 | (if (string-match org-deadline-line-regexp line) |
| 8610 | (progn | 8652 | (progn |
| 8611 | (if (save-match-data | 8653 | (if (save-match-data |
| 8612 | (string-match "<a href" | 8654 | (string-match "<a href" |
| 8613 | (substring line 0 (match-beginning 0)))) | 8655 | (substring line 0 (match-beginning 0)))) |
| 8614 | nil ; Don't do the replacement - it is inside a link | 8656 | nil ; Don't do the replacement - it is inside a link |
| 8615 | (setq line (replace-match "<span style='color:red'>\\&</span>" | 8657 | (setq line (replace-match "<span style='color:red'>\\&</span>" |
| 8616 | nil nil line 1))))) | 8658 | nil nil line 1))))) |
| 8617 | 8659 | ||
| 8618 | (cond | 8660 | (cond |
| 8619 | ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) | 8661 | ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) |
| 8620 | ;; This is a headline | 8662 | ;; This is a headline |
| 8621 | (setq level (- (match-end 1) (match-beginning 1)) | 8663 | (setq level (- (match-end 1) (match-beginning 1)) |
| 8622 | txt (match-string 2 line)) | 8664 | txt (match-string 2 line)) |
| 8623 | (if (<= level umax) (setq head-count (+ head-count 1))) | 8665 | (if (<= level umax) (setq head-count (+ head-count 1))) |
| 8624 | (org-html-level-start level txt umax | 8666 | (org-html-level-start level txt umax |
| 8625 | (and org-export-with-toc (<= level umax)) | 8667 | (and org-export-with-toc (<= level umax)) |
| 8626 | head-count)) | 8668 | head-count)) |
| 8627 | 8669 | ||
| 8628 | ((and org-export-with-tables | 8670 | ((and org-export-with-tables |
| 8629 | (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) | 8671 | (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) |
| 8630 | (if (not table-open) | 8672 | (if (not table-open) |
| 8631 | ;; New table starts | 8673 | ;; New table starts |
| 8632 | (setq table-open t table-buffer nil table-orig-buffer nil)) | 8674 | (setq table-open t table-buffer nil table-orig-buffer nil)) |
| 8633 | ;; Accumulate lines | 8675 | ;; Accumulate lines |
| 8634 | (setq table-buffer (cons line table-buffer) | 8676 | (setq table-buffer (cons line table-buffer) |
| 8635 | table-orig-buffer (cons origline table-orig-buffer)) | 8677 | table-orig-buffer (cons origline table-orig-buffer)) |
| 8636 | (when (or (not lines) | 8678 | (when (or (not lines) |
| 8637 | (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" | 8679 | (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" |
| 8638 | (car lines)))) | 8680 | (car lines)))) |
| 8639 | (setq table-open nil | 8681 | (setq table-open nil |
| 8640 | table-buffer (nreverse table-buffer) | 8682 | table-buffer (nreverse table-buffer) |
| 8641 | table-orig-buffer (nreverse table-orig-buffer)) | 8683 | table-orig-buffer (nreverse table-orig-buffer)) |
| 8642 | (insert (org-format-table-html table-buffer table-orig-buffer)))) | 8684 | (insert (org-format-table-html table-buffer table-orig-buffer)))) |
| 8643 | (t | 8685 | (t |
| 8644 | ;; Normal lines | 8686 | ;; Normal lines |
| 8645 | ;; Lines starting with "-", and empty lines make new paragraph. | 8687 | ;; Lines starting with "-", and empty lines make new paragraph. |
| 8646 | (if (string-match "^ *-\\|^[ \t]*$" line) (insert "<p>")) | 8688 | (if (string-match "^ *-\\|^[ \t]*$" line) (insert "<p>")) |
| 8647 | (insert line (if org-export-preserve-breaks "<br>\n" "\n")))) | 8689 | (insert line (if org-export-preserve-breaks "<br>\n" "\n")))) |
| 8648 | )) | 8690 | )) |
| 8649 | (if org-export-html-with-timestamp | 8691 | (if org-export-html-with-timestamp |
| 8650 | (insert org-export-html-html-helper-timestamp)) | 8692 | (insert org-export-html-html-helper-timestamp)) |
| 8651 | (insert "</body>\n</html>\n") | 8693 | (insert "</body>\n</html>\n") |
| 8652 | (normal-mode) | 8694 | (normal-mode) |
| 8653 | (save-buffer) | 8695 | (save-buffer) |
| @@ -8660,53 +8702,53 @@ headlines. The default is 3. Lower levels will become bulleted lists." | |||
| 8660 | (org-format-org-table-html lines) | 8702 | (org-format-org-table-html lines) |
| 8661 | ;; Table made by table.el - test for spanning | 8703 | ;; Table made by table.el - test for spanning |
| 8662 | (let* ((hlines (delq nil (mapcar | 8704 | (let* ((hlines (delq nil (mapcar |
| 8663 | (lambda (x) | 8705 | (lambda (x) |
| 8664 | (if (string-match "^[ \t]*\\+-" x) x | 8706 | (if (string-match "^[ \t]*\\+-" x) x |
| 8665 | nil)) | 8707 | nil)) |
| 8666 | lines))) | 8708 | lines))) |
| 8667 | (first (car hlines)) | 8709 | (first (car hlines)) |
| 8668 | (ll (and (string-match "\\S-+" first) | 8710 | (ll (and (string-match "\\S-+" first) |
| 8669 | (match-string 0 first))) | 8711 | (match-string 0 first))) |
| 8670 | (re (concat "^[ \t]*" (regexp-quote ll))) | 8712 | (re (concat "^[ \t]*" (regexp-quote ll))) |
| 8671 | (spanning (delq nil (mapcar (lambda (x) (not (string-match re x))) | 8713 | (spanning (delq nil (mapcar (lambda (x) (not (string-match re x))) |
| 8672 | hlines)))) | 8714 | hlines)))) |
| 8673 | (if (and (not spanning) | 8715 | (if (and (not spanning) |
| 8674 | (not org-export-prefer-native-exporter-for-tables)) | 8716 | (not org-export-prefer-native-exporter-for-tables)) |
| 8675 | ;; We can use my own converter with HTML conversions | 8717 | ;; We can use my own converter with HTML conversions |
| 8676 | (org-format-table-table-html lines) | 8718 | (org-format-table-table-html lines) |
| 8677 | ;; Need to use the code generator in table.el, with the original text. | 8719 | ;; Need to use the code generator in table.el, with the original text. |
| 8678 | (org-format-table-table-html-using-table-generate-source olines))))) | 8720 | (org-format-table-table-html-using-table-generate-source olines))))) |
| 8679 | 8721 | ||
| 8680 | (defun org-format-org-table-html (lines) | 8722 | (defun org-format-org-table-html (lines) |
| 8681 | "Format a table into HTML." | 8723 | "Format a table into html." |
| 8682 | (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) | 8724 | (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) |
| 8683 | (setq lines (nreverse lines)) | 8725 | (setq lines (nreverse lines)) |
| 8684 | (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) | 8726 | (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) |
| 8685 | (setq lines (nreverse lines)) | 8727 | (setq lines (nreverse lines)) |
| 8686 | (let ((head (and org-export-highlight-first-table-line | 8728 | (let ((head (and org-export-highlight-first-table-line |
| 8687 | (delq nil (mapcar | 8729 | (delq nil (mapcar |
| 8688 | (lambda (x) (string-match "^[ \t]*|-" x)) | 8730 | (lambda (x) (string-match "^[ \t]*|-" x)) |
| 8689 | (cdr lines))))) | 8731 | (cdr lines))))) |
| 8690 | line fields html) | 8732 | line fields html) |
| 8691 | (setq html (concat org-export-html-table-tag "\n")) | 8733 | (setq html (concat org-export-html-table-tag "\n")) |
| 8692 | (while (setq line (pop lines)) | 8734 | (while (setq line (pop lines)) |
| 8693 | (catch 'next-line | 8735 | (catch 'next-line |
| 8694 | (if (string-match "^[ \t]*|-" line) | 8736 | (if (string-match "^[ \t]*|-" line) |
| 8695 | (progn | 8737 | (progn |
| 8696 | (setq head nil) ;; head ends here, first time around | 8738 | (setq head nil) ;; head ends here, first time around |
| 8697 | ;; ignore this line | 8739 | ;; ignore this line |
| 8698 | (throw 'next-line t))) | 8740 | (throw 'next-line t))) |
| 8699 | ;; Break the line into fields | 8741 | ;; Break the line into fields |
| 8700 | (setq fields (org-split-string line "[ \t]*|[ \t]*")) | 8742 | (setq fields (org-split-string line "[ \t]*|[ \t]*")) |
| 8701 | (setq html (concat | 8743 | (setq html (concat |
| 8702 | html | 8744 | html |
| 8703 | "<tr>" | 8745 | "<tr>" |
| 8704 | (mapconcat (lambda (x) | 8746 | (mapconcat (lambda (x) |
| 8705 | (if head | 8747 | (if head |
| 8706 | (concat "<th>" x "</th>") | 8748 | (concat "<th>" x "</th>") |
| 8707 | (concat "<td valign=\"top\">" x "</td>"))) | 8749 | (concat "<td valign=\"top\">" x "</td>"))) |
| 8708 | fields "") | 8750 | fields "") |
| 8709 | "</tr>\n")))) | 8751 | "</tr>\n")))) |
| 8710 | (setq html (concat html "</table>\n")) | 8752 | (setq html (concat html "</table>\n")) |
| 8711 | html)) | 8753 | html)) |
| 8712 | 8754 | ||
| @@ -8721,51 +8763,51 @@ headlines. The default is 3. Lower levels will become bulleted lists." | |||
| 8721 | newstr)) | 8763 | newstr)) |
| 8722 | 8764 | ||
| 8723 | (defun org-format-table-table-html (lines) | 8765 | (defun org-format-table-table-html (lines) |
| 8724 | "Format a table generated by table.el into HTML. | 8766 | "Format a table generated by table.el into html. |
| 8725 | This conversion does *not* use `table-generate-source' from table.el. | 8767 | This conversion does *not* use `table-generate-source' from table.el. |
| 8726 | This has the advantage that Org-mode's HTML conversions can be used. | 8768 | This has the advantage that Org-mode's HTML conversions can be used. |
| 8727 | But it has the disadvantage, that no cell- or row-spanning is allowed." | 8769 | But it has the disadvantage, that no cell- or row-spanning is allowed." |
| 8728 | (let (line field-buffer | 8770 | (let (line field-buffer |
| 8729 | (head org-export-highlight-first-table-line) | 8771 | (head org-export-highlight-first-table-line) |
| 8730 | fields html empty) | 8772 | fields html empty) |
| 8731 | (setq html (concat org-export-html-table-tag "\n")) | 8773 | (setq html (concat org-export-html-table-tag "\n")) |
| 8732 | (while (setq line (pop lines)) | 8774 | (while (setq line (pop lines)) |
| 8733 | (setq empty " ") | 8775 | (setq empty " ") |
| 8734 | (catch 'next-line | 8776 | (catch 'next-line |
| 8735 | (if (string-match "^[ \t]*\\+-" line) | 8777 | (if (string-match "^[ \t]*\\+-" line) |
| 8736 | (progn | 8778 | (progn |
| 8737 | (if field-buffer | 8779 | (if field-buffer |
| 8738 | (progn | 8780 | (progn |
| 8739 | (setq html (concat | 8781 | (setq html (concat |
| 8740 | html | 8782 | html |
| 8741 | "<tr>" | 8783 | "<tr>" |
| 8742 | (mapconcat | 8784 | (mapconcat |
| 8743 | (lambda (x) | 8785 | (lambda (x) |
| 8744 | (if (equal x "") (setq x empty)) | 8786 | (if (equal x "") (setq x empty)) |
| 8745 | (if head | 8787 | (if head |
| 8746 | (concat "<th valign=\"top\">" x | 8788 | (concat "<th valign=\"top\">" x |
| 8747 | "</th>\n") | 8789 | "</th>\n") |
| 8748 | (concat "<td valign=\"top\">" x | 8790 | (concat "<td valign=\"top\">" x |
| 8749 | "</td>\n"))) | 8791 | "</td>\n"))) |
| 8750 | field-buffer "\n") | 8792 | field-buffer "\n") |
| 8751 | "</tr>\n")) | 8793 | "</tr>\n")) |
| 8752 | (setq head nil) | 8794 | (setq head nil) |
| 8753 | (setq field-buffer nil))) | 8795 | (setq field-buffer nil))) |
| 8754 | ;; Ignore this line | 8796 | ;; Ignore this line |
| 8755 | (throw 'next-line t))) | 8797 | (throw 'next-line t))) |
| 8756 | ;; Break the line into fields and store the fields | 8798 | ;; Break the line into fields and store the fields |
| 8757 | (setq fields (org-split-string line "[ \t]*|[ \t]*")) | 8799 | (setq fields (org-split-string line "[ \t]*|[ \t]*")) |
| 8758 | (if field-buffer | 8800 | (if field-buffer |
| 8759 | (setq field-buffer (mapcar | 8801 | (setq field-buffer (mapcar |
| 8760 | (lambda (x) | 8802 | (lambda (x) |
| 8761 | (concat x "<br>" (pop fields))) | 8803 | (concat x "<br>" (pop fields))) |
| 8762 | field-buffer)) | 8804 | field-buffer)) |
| 8763 | (setq field-buffer fields)))) | 8805 | (setq field-buffer fields)))) |
| 8764 | (setq html (concat html "</table>\n")) | 8806 | (setq html (concat html "</table>\n")) |
| 8765 | html)) | 8807 | html)) |
| 8766 | 8808 | ||
| 8767 | (defun org-format-table-table-html-using-table-generate-source (lines) | 8809 | (defun org-format-table-table-html-using-table-generate-source (lines) |
| 8768 | "Format a table into HTML, using `table-generate-source' from table.el. | 8810 | "Format a table into html, using `table-generate-source' from table.el. |
| 8769 | This has the advantage that cell- or row-spanning is allowed. | 8811 | This has the advantage that cell- or row-spanning is allowed. |
| 8770 | But it has the disadvantage, that Org-mode's HTML conversions cannot be used." | 8812 | But it has the disadvantage, that Org-mode's HTML conversions cannot be used." |
| 8771 | (require 'table) | 8813 | (require 'table) |
| @@ -8774,7 +8816,7 @@ But it has the disadvantage, that Org-mode's HTML conversions cannot be used." | |||
| 8774 | (insert (mapconcat 'identity lines "\n")) | 8816 | (insert (mapconcat 'identity lines "\n")) |
| 8775 | (goto-char (point-min)) | 8817 | (goto-char (point-min)) |
| 8776 | (if (not (re-search-forward "|[^+]" nil t)) | 8818 | (if (not (re-search-forward "|[^+]" nil t)) |
| 8777 | (error "Error processing table")) | 8819 | (error "Error processing table")) |
| 8778 | (table-recognize-table) | 8820 | (table-recognize-table) |
| 8779 | (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer)) | 8821 | (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer)) |
| 8780 | (table-generate-source 'html " org-tmp2 ") | 8822 | (table-generate-source 'html " org-tmp2 ") |
| @@ -8786,29 +8828,29 @@ But it has the disadvantage, that Org-mode's HTML conversions cannot be used." | |||
| 8786 | ;; First check if there is a link in the line - if yes, apply conversions | 8828 | ;; First check if there is a link in the line - if yes, apply conversions |
| 8787 | ;; only before the start of the link. | 8829 | ;; only before the start of the link. |
| 8788 | (let* ((m (string-match org-link-regexp string)) | 8830 | (let* ((m (string-match org-link-regexp string)) |
| 8789 | (s (if m (substring string 0 m) string)) | 8831 | (s (if m (substring string 0 m) string)) |
| 8790 | (r (if m (substring string m) ""))) | 8832 | (r (if m (substring string m) ""))) |
| 8791 | ;; convert < to < and > to > | 8833 | ;; convert < to < and > to > |
| 8792 | (while (string-match "<" s) | 8834 | (while (string-match "<" s) |
| 8793 | (setq s (replace-match "<" t t s))) | 8835 | (setq s (replace-match "<" t t s))) |
| 8794 | (while (string-match ">" s) | 8836 | (while (string-match ">" s) |
| 8795 | (setq s (replace-match ">" t t s))) | 8837 | (setq s (replace-match ">" t t s))) |
| 8796 | (if org-export-html-expand | 8838 | (if org-export-html-expand |
| 8797 | (while (string-match "@<\\([^&]*\\)>" s) | 8839 | (while (string-match "@<\\([^&]*\\)>" s) |
| 8798 | (setq s (replace-match "<\\1>" nil nil s)))) | 8840 | (setq s (replace-match "<\\1>" nil nil s)))) |
| 8799 | (if org-export-with-emphasize | 8841 | (if org-export-with-emphasize |
| 8800 | (setq s (org-export-html-convert-emphasize s))) | 8842 | (setq s (org-export-html-convert-emphasize s))) |
| 8801 | (if org-export-with-sub-superscripts | 8843 | (if org-export-with-sub-superscripts |
| 8802 | (setq s (org-export-html-convert-sub-super s))) | 8844 | (setq s (org-export-html-convert-sub-super s))) |
| 8803 | (if org-export-with-TeX-macros | 8845 | (if org-export-with-TeX-macros |
| 8804 | (let ((start 0) wd ass) | 8846 | (let ((start 0) wd ass) |
| 8805 | (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)" s start)) | 8847 | (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)" s start)) |
| 8806 | (setq wd (match-string 1 s)) | 8848 | (setq wd (match-string 1 s)) |
| 8807 | (if (setq ass (assoc wd org-html-entities)) | 8849 | (if (setq ass (assoc wd org-html-entities)) |
| 8808 | (setq s (replace-match (or (cdr ass) | 8850 | (setq s (replace-match (or (cdr ass) |
| 8809 | (concat "&" (car ass) ";")) | 8851 | (concat "&" (car ass) ";")) |
| 8810 | t t s)) | 8852 | t t s)) |
| 8811 | (setq start (+ start (length wd))))))) | 8853 | (setq start (+ start (length wd))))))) |
| 8812 | (concat s r))) | 8854 | (concat s r))) |
| 8813 | 8855 | ||
| 8814 | (defun org-create-multibrace-regexp (left right n) | 8856 | (defun org-create-multibrace-regexp (left right n) |
| @@ -8820,13 +8862,13 @@ delimiters. It will also define a single group which contains the | |||
| 8820 | match except for the outermost delimiters. The maximum depth of | 8862 | match except for the outermost delimiters. The maximum depth of |
| 8821 | stacked delimiters is N. Escaping delimiters is not possible." | 8863 | stacked delimiters is N. Escaping delimiters is not possible." |
| 8822 | (let* ((nothing (concat "[^" "\\" left "\\" right "]*?")) | 8864 | (let* ((nothing (concat "[^" "\\" left "\\" right "]*?")) |
| 8823 | (or "\\|") | 8865 | (or "\\|") |
| 8824 | (re nothing) | 8866 | (re nothing) |
| 8825 | (next (concat "\\(?:" nothing left nothing right "\\)+" nothing))) | 8867 | (next (concat "\\(?:" nothing left nothing right "\\)+" nothing))) |
| 8826 | (while (> n 1) | 8868 | (while (> n 1) |
| 8827 | (setq n (1- n) | 8869 | (setq n (1- n) |
| 8828 | re (concat re or next) | 8870 | re (concat re or next) |
| 8829 | next (concat "\\(?:" nothing left next right "\\)+" nothing))) | 8871 | next (concat "\\(?:" nothing left next right "\\)+" nothing))) |
| 8830 | (concat left "\\(" re "\\)" right))) | 8872 | (concat left "\\(" re "\\)" right))) |
| 8831 | 8873 | ||
| 8832 | (defvar org-match-substring-regexp | 8874 | (defvar org-match-substring-regexp |
| @@ -8845,35 +8887,35 @@ stacked delimiters is N. Escaping delimiters is not possible." | |||
| 8845 | (while (string-match org-match-substring-regexp string) | 8887 | (while (string-match org-match-substring-regexp string) |
| 8846 | (setq key (if (string= (match-string 2 string) "_") "sub" "sup")) | 8888 | (setq key (if (string= (match-string 2 string) "_") "sub" "sup")) |
| 8847 | (setq c (or (match-string 8 string) | 8889 | (setq c (or (match-string 8 string) |
| 8848 | (match-string 6 string) | 8890 | (match-string 6 string) |
| 8849 | (match-string 5 string))) | 8891 | (match-string 5 string))) |
| 8850 | (setq string (replace-match | 8892 | (setq string (replace-match |
| 8851 | (concat (match-string 1 string) | 8893 | (concat (match-string 1 string) |
| 8852 | "<" key ">" c "</" key ">") | 8894 | "<" key ">" c "</" key ">") |
| 8853 | t t string))) | 8895 | t t string))) |
| 8854 | (while (string-match "\\\\\\([_^]\\)" string) | 8896 | (while (string-match "\\\\\\([_^]\\)" string) |
| 8855 | (setq string (replace-match (match-string 1 string) t t string)))) | 8897 | (setq string (replace-match (match-string 1 string) t t string)))) |
| 8856 | string) | 8898 | string) |
| 8857 | 8899 | ||
| 8858 | (defun org-export-html-convert-emphasize (string) | 8900 | (defun org-export-html-convert-emphasize (string) |
| 8859 | (while (string-match | 8901 | (while (string-match |
| 8860 | "\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)" | 8902 | "\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)" |
| 8861 | string) | 8903 | string) |
| 8862 | (setq string (replace-match | 8904 | (setq string (replace-match |
| 8863 | (concat "<b>" (match-string 3 string) "</b>") | 8905 | (concat "<b>" (match-string 3 string) "</b>") |
| 8864 | t t string 2))) | 8906 | t t string 2))) |
| 8865 | (while (string-match | 8907 | (while (string-match |
| 8866 | "\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)" | 8908 | "\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)" |
| 8867 | string) | 8909 | string) |
| 8868 | (setq string (replace-match | 8910 | (setq string (replace-match |
| 8869 | (concat "<i>" (match-string 3 string) "</i>") | 8911 | (concat "<i>" (match-string 3 string) "</i>") |
| 8870 | t t string 2))) | 8912 | t t string 2))) |
| 8871 | (while (string-match | 8913 | (while (string-match |
| 8872 | "\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)" | 8914 | "\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)" |
| 8873 | string) | 8915 | string) |
| 8874 | (setq string (replace-match | 8916 | (setq string (replace-match |
| 8875 | (concat "<u>" (match-string 3 string) "</u>") | 8917 | (concat "<u>" (match-string 3 string) "</u>") |
| 8876 | t t string 2))) | 8918 | t t string 2))) |
| 8877 | string) | 8919 | string) |
| 8878 | 8920 | ||
| 8879 | (defun org-parse-key-lines () | 8921 | (defun org-parse-key-lines () |
| @@ -8881,59 +8923,59 @@ stacked delimiters is N. Escaping delimiters is not possible." | |||
| 8881 | (save-excursion | 8923 | (save-excursion |
| 8882 | (goto-char 0) | 8924 | (goto-char 0) |
| 8883 | (let ((re (org-make-options-regexp | 8925 | (let ((re (org-make-options-regexp |
| 8884 | '("TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))) | 8926 | '("TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))) |
| 8885 | key) | 8927 | key) |
| 8886 | (while (re-search-forward re nil t) | 8928 | (while (re-search-forward re nil t) |
| 8887 | (setq key (match-string 1)) | 8929 | (setq key (match-string 1)) |
| 8888 | (cond ((string-equal key "TITLE") | 8930 | (cond ((string-equal key "TITLE") |
| 8889 | (setq title (match-string 2))) | 8931 | (setq title (match-string 2))) |
| 8890 | ((string-equal key "AUTHOR") | 8932 | ((string-equal key "AUTHOR") |
| 8891 | (setq author (match-string 2))) | 8933 | (setq author (match-string 2))) |
| 8892 | ((string-equal key "EMAIL") | 8934 | ((string-equal key "EMAIL") |
| 8893 | (setq email (match-string 2))) | 8935 | (setq email (match-string 2))) |
| 8894 | ((string-equal key "LANGUAGE") | 8936 | ((string-equal key "LANGUAGE") |
| 8895 | (setq language (match-string 2))) | 8937 | (setq language (match-string 2))) |
| 8896 | ((string-equal key "TEXT") | 8938 | ((string-equal key "TEXT") |
| 8897 | (setq text (concat text "\n" (match-string 2)))) | 8939 | (setq text (concat text "\n" (match-string 2)))) |
| 8898 | ((string-equal key "OPTIONS") | 8940 | ((string-equal key "OPTIONS") |
| 8899 | (setq options (match-string 2)))))))) | 8941 | (setq options (match-string 2)))))))) |
| 8900 | 8942 | ||
| 8901 | (defun org-parse-export-options (s) | 8943 | (defun org-parse-export-options (s) |
| 8902 | "Parse the export options line." | 8944 | "Parse the export options line." |
| 8903 | (let ((op '(("H" . org-export-headline-levels) | 8945 | (let ((op '(("H" . org-export-headline-levels) |
| 8904 | ("num" . org-export-with-section-numbers) | 8946 | ("num" . org-export-with-section-numbers) |
| 8905 | ("toc" . org-export-with-toc) | 8947 | ("toc" . org-export-with-toc) |
| 8906 | ("\\n" . org-export-preserve-breaks) | 8948 | ("\\n" . org-export-preserve-breaks) |
| 8907 | ("@" . org-export-html-expand) | 8949 | ("@" . org-export-html-expand) |
| 8908 | (":" . org-export-with-fixed-width) | 8950 | (":" . org-export-with-fixed-width) |
| 8909 | ("|" . org-export-with-tables) | 8951 | ("|" . org-export-with-tables) |
| 8910 | ("^" . org-export-with-sub-superscripts) | 8952 | ("^" . org-export-with-sub-superscripts) |
| 8911 | ("*" . org-export-with-emphasize) | 8953 | ("*" . org-export-with-emphasize) |
| 8912 | ("TeX" . org-export-with-TeX-macros))) | 8954 | ("TeX" . org-export-with-TeX-macros))) |
| 8913 | o) | 8955 | o) |
| 8914 | (while (setq o (pop op)) | 8956 | (while (setq o (pop op)) |
| 8915 | (if (string-match (concat (regexp-quote (car o)) ":\\([^ \t\n\r;,.]*\\)") | 8957 | (if (string-match (concat (regexp-quote (car o)) ":\\([^ \t\n\r;,.]*\\)") |
| 8916 | s) | 8958 | s) |
| 8917 | (set (make-local-variable (cdr o)) | 8959 | (set (make-local-variable (cdr o)) |
| 8918 | (car (read-from-string (match-string 1 s)))))))) | 8960 | (car (read-from-string (match-string 1 s)))))))) |
| 8919 | 8961 | ||
| 8920 | (defun org-html-level-start (level title umax with-toc head-count) | 8962 | (defun org-html-level-start (level title umax with-toc head-count) |
| 8921 | "Insert a new level in HTML export." | 8963 | "Insert a new level in HTML export." |
| 8922 | (let ((l (1+ (max level umax)))) | 8964 | (let ((l (1+ (max level umax)))) |
| 8923 | (while (<= l org-level-max) | 8965 | (while (<= l org-level-max) |
| 8924 | (if (aref levels-open (1- l)) | 8966 | (if (aref levels-open (1- l)) |
| 8925 | (progn | 8967 | (progn |
| 8926 | (org-html-level-close l) | 8968 | (org-html-level-close l) |
| 8927 | (aset levels-open (1- l) nil))) | 8969 | (aset levels-open (1- l) nil))) |
| 8928 | (setq l (1+ l))) | 8970 | (setq l (1+ l))) |
| 8929 | (if (> level umax) | 8971 | (if (> level umax) |
| 8930 | (progn | 8972 | (progn |
| 8931 | (if (aref levels-open (1- level)) | 8973 | (if (aref levels-open (1- level)) |
| 8932 | (insert "<li>" title "<p>\n") | 8974 | (insert "<li>" title "<p>\n") |
| 8933 | (aset levels-open (1- level) t) | 8975 | (aset levels-open (1- level) t) |
| 8934 | (insert "<ul><li>" title "<p>\n"))) | 8976 | (insert "<ul><li>" title "<p>\n"))) |
| 8935 | (if org-export-with-section-numbers | 8977 | (if org-export-with-section-numbers |
| 8936 | (setq title (concat (org-section-number level) " " title))) | 8978 | (setq title (concat (org-section-number level) " " title))) |
| 8937 | (setq level (+ level 1)) | 8979 | (setq level (+ level 1)) |
| 8938 | (if with-toc | 8980 | (if with-toc |
| 8939 | (insert (format "\n<H%d><a name=\"sec-%d\">%s</a></H%d>\n" | 8981 | (insert (format "\n<H%d><a name=\"sec-%d\">%s</a></H%d>\n" |
| @@ -8951,18 +8993,18 @@ stacked delimiters is N. Escaping delimiters is not possible." | |||
| 8951 | (defun org-init-section-numbers () | 8993 | (defun org-init-section-numbers () |
| 8952 | "Initialize the vector for the section numbers." | 8994 | "Initialize the vector for the section numbers." |
| 8953 | (let* ((level -1) | 8995 | (let* ((level -1) |
| 8954 | (numbers (nreverse (org-split-string "" "\\."))) | 8996 | (numbers (nreverse (org-split-string "" "\\."))) |
| 8955 | (depth (1- (length org-section-numbers))) | 8997 | (depth (1- (length org-section-numbers))) |
| 8956 | (i depth) number-string) | 8998 | (i depth) number-string) |
| 8957 | (while (>= i 0) | 8999 | (while (>= i 0) |
| 8958 | (if (> i level) | 9000 | (if (> i level) |
| 8959 | (aset org-section-numbers i 0) | 9001 | (aset org-section-numbers i 0) |
| 8960 | (setq number-string (or (car numbers) "0")) | 9002 | (setq number-string (or (car numbers) "0")) |
| 8961 | (if (string-match "\\`[A-Z]\\'" number-string) | 9003 | (if (string-match "\\`[A-Z]\\'" number-string) |
| 8962 | (aset org-section-numbers i | 9004 | (aset org-section-numbers i |
| 8963 | (- (string-to-char number-string) ?A -1)) | 9005 | (- (string-to-char number-string) ?A -1)) |
| 8964 | (aset org-section-numbers i (string-to-int number-string))) | 9006 | (aset org-section-numbers i (string-to-int number-string))) |
| 8965 | (pop numbers)) | 9007 | (pop numbers)) |
| 8966 | (setq i (1- i))))) | 9008 | (setq i (1- i))))) |
| 8967 | 9009 | ||
| 8968 | (defun org-section-number (&optional level) | 9010 | (defun org-section-number (&optional level) |
| @@ -8971,24 +9013,24 @@ When LEVEL is non-nil, increase section numbers on that level." | |||
| 8971 | (let* ((depth (1- (length org-section-numbers))) idx n (string "")) | 9013 | (let* ((depth (1- (length org-section-numbers))) idx n (string "")) |
| 8972 | (when level | 9014 | (when level |
| 8973 | (when (> level -1) | 9015 | (when (> level -1) |
| 8974 | (aset org-section-numbers | 9016 | (aset org-section-numbers |
| 8975 | level (1+ (aref org-section-numbers level)))) | 9017 | level (1+ (aref org-section-numbers level)))) |
| 8976 | (setq idx (1+ level)) | 9018 | (setq idx (1+ level)) |
| 8977 | (while (<= idx depth) | 9019 | (while (<= idx depth) |
| 8978 | (if (not (= idx 1)) | 9020 | (if (not (= idx 1)) |
| 8979 | (aset org-section-numbers idx 0)) | 9021 | (aset org-section-numbers idx 0)) |
| 8980 | (setq idx (1+ idx)))) | 9022 | (setq idx (1+ idx)))) |
| 8981 | (setq idx 0) | 9023 | (setq idx 0) |
| 8982 | (while (<= idx depth) | 9024 | (while (<= idx depth) |
| 8983 | (setq n (aref org-section-numbers idx)) | 9025 | (setq n (aref org-section-numbers idx)) |
| 8984 | (setq string (concat string (if (not (string= string "")) "." "") | 9026 | (setq string (concat string (if (not (string= string "")) "." "") |
| 8985 | (int-to-string n))) | 9027 | (int-to-string n))) |
| 8986 | (setq idx (1+ idx))) | 9028 | (setq idx (1+ idx))) |
| 8987 | (save-match-data | 9029 | (save-match-data |
| 8988 | (if (string-match "\\`\\([@0]\\.\\)+" string) | 9030 | (if (string-match "\\`\\([@0]\\.\\)+" string) |
| 8989 | (setq string (replace-match "" nil nil string))) | 9031 | (setq string (replace-match "" nil nil string))) |
| 8990 | (if (string-match "\\(\\.0\\)+\\'" string) | 9032 | (if (string-match "\\(\\.0\\)+\\'" string) |
| 8991 | (setq string (replace-match "" nil nil string)))) | 9033 | (setq string (replace-match "" nil nil string)))) |
| 8992 | string)) | 9034 | string)) |
| 8993 | 9035 | ||
| 8994 | 9036 | ||
| @@ -9082,13 +9124,13 @@ If the cursor is in a table looking at whitespace, the whitespace is | |||
| 9082 | overwritten, and the table is not marked as requiring realignment." | 9124 | overwritten, and the table is not marked as requiring realignment." |
| 9083 | (interactive "p") | 9125 | (interactive "p") |
| 9084 | (if (and (org-table-p) | 9126 | (if (and (org-table-p) |
| 9085 | (eq N 1) | 9127 | (eq N 1) |
| 9086 | (looking-at "[^|\n]* +|")) | 9128 | (looking-at "[^|\n]* +|")) |
| 9087 | (let (org-table-may-need-update) | 9129 | (let (org-table-may-need-update) |
| 9088 | (goto-char (1- (match-end 0))) | 9130 | (goto-char (1- (match-end 0))) |
| 9089 | (delete-backward-char 1) | 9131 | (delete-backward-char 1) |
| 9090 | (goto-char (match-beginning 0)) | 9132 | (goto-char (match-beginning 0)) |
| 9091 | (self-insert-command N)) | 9133 | (self-insert-command N)) |
| 9092 | (setq org-table-may-need-update t) | 9134 | (setq org-table-may-need-update t) |
| 9093 | (self-insert-command N))) | 9135 | (self-insert-command N))) |
| 9094 | 9136 | ||
| @@ -9104,14 +9146,14 @@ still be marked for re-alignment, because a narrow field may lead to a | |||
| 9104 | reduced column width." | 9146 | reduced column width." |
| 9105 | (interactive "p") | 9147 | (interactive "p") |
| 9106 | (if (and (org-table-p) | 9148 | (if (and (org-table-p) |
| 9107 | (eq N 1) | 9149 | (eq N 1) |
| 9108 | (string-match "|" (buffer-substring (point-at-bol) (point))) | 9150 | (string-match "|" (buffer-substring (point-at-bol) (point))) |
| 9109 | (looking-at ".*?|")) | 9151 | (looking-at ".*?|")) |
| 9110 | (let ((pos (point))) | 9152 | (let ((pos (point))) |
| 9111 | (backward-delete-char N) | 9153 | (backward-delete-char N) |
| 9112 | (skip-chars-forward "^|") | 9154 | (skip-chars-forward "^|") |
| 9113 | (insert " ") | 9155 | (insert " ") |
| 9114 | (goto-char (1- pos))) | 9156 | (goto-char (1- pos))) |
| 9115 | (backward-delete-char N))) | 9157 | (backward-delete-char N))) |
| 9116 | 9158 | ||
| 9117 | (defun org-delete-char (N) | 9159 | (defun org-delete-char (N) |
| @@ -9122,15 +9164,15 @@ will still be marked for re-alignment, because a narrow field may lead to | |||
| 9122 | a reduced column width." | 9164 | a reduced column width." |
| 9123 | (interactive "p") | 9165 | (interactive "p") |
| 9124 | (if (and (org-table-p) | 9166 | (if (and (org-table-p) |
| 9125 | (not (bolp)) | 9167 | (not (bolp)) |
| 9126 | (not (= (char-after) ?|)) | 9168 | (not (= (char-after) ?|)) |
| 9127 | (eq N 1)) | 9169 | (eq N 1)) |
| 9128 | (if (looking-at ".*?|") | 9170 | (if (looking-at ".*?|") |
| 9129 | (let ((pos (point))) | 9171 | (let ((pos (point))) |
| 9130 | (replace-match (concat | 9172 | (replace-match (concat |
| 9131 | (substring (match-string 0) 1 -1) | 9173 | (substring (match-string 0) 1 -1) |
| 9132 | " |")) | 9174 | " |")) |
| 9133 | (goto-char pos))) | 9175 | (goto-char pos))) |
| 9134 | (delete-char N))) | 9176 | (delete-char N))) |
| 9135 | 9177 | ||
| 9136 | ;; How to do this: Measure non-white length of current string | 9178 | ;; How to do this: Measure non-white length of current string |
| @@ -9140,11 +9182,11 @@ a reduced column width." | |||
| 9140 | ;; If the user wants maximum table support, we need to hijack | 9182 | ;; If the user wants maximum table support, we need to hijack |
| 9141 | ;; some standard editing functions | 9183 | ;; some standard editing functions |
| 9142 | (substitute-key-definition 'self-insert-command 'org-self-insert-command | 9184 | (substitute-key-definition 'self-insert-command 'org-self-insert-command |
| 9143 | org-mode-map global-map) | 9185 | org-mode-map global-map) |
| 9144 | (substitute-key-definition 'delete-char 'org-delete-char | 9186 | (substitute-key-definition 'delete-char 'org-delete-char |
| 9145 | org-mode-map global-map) | 9187 | org-mode-map global-map) |
| 9146 | (substitute-key-definition 'delete-backward-char 'org-delete-backward-char | 9188 | (substitute-key-definition 'delete-backward-char 'org-delete-backward-char |
| 9147 | org-mode-map global-map) | 9189 | org-mode-map global-map) |
| 9148 | (define-key org-mode-map "|" 'self-insert-command)) | 9190 | (define-key org-mode-map "|" 'self-insert-command)) |
| 9149 | 9191 | ||
| 9150 | (defun org-shiftcursor-error () | 9192 | (defun org-shiftcursor-error () |
| @@ -9273,25 +9315,25 @@ scanning the buffer for these lines and updating the information." | |||
| 9273 | ((org-at-table-p) | 9315 | ((org-at-table-p) |
| 9274 | (org-table-maybe-eval-formula) | 9316 | (org-table-maybe-eval-formula) |
| 9275 | (if arg | 9317 | (if arg |
| 9276 | (org-table-recalculate t) | 9318 | (org-table-recalculate t) |
| 9277 | (org-table-maybe-recalculate-line)) | 9319 | (org-table-maybe-recalculate-line)) |
| 9278 | (org-table-align)) | 9320 | (org-table-align)) |
| 9279 | ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)")) | 9321 | ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)")) |
| 9280 | (cond | 9322 | (cond |
| 9281 | ((equal (match-string 1) "TBLFM") | 9323 | ((equal (match-string 1) "TBLFM") |
| 9282 | ;; Recalculate the table before this line | 9324 | ;; Recalculate the table before this line |
| 9283 | (save-excursion | 9325 | (save-excursion |
| 9284 | (beginning-of-line 1) | 9326 | (beginning-of-line 1) |
| 9285 | (skip-chars-backward " \r\n\t") | 9327 | (skip-chars-backward " \r\n\t") |
| 9286 | (if (org-at-table-p) (org-table-recalculate t)))) | 9328 | (if (org-at-table-p) (org-table-recalculate t)))) |
| 9287 | (t | 9329 | (t |
| 9288 | (let ((org-inhibit-startup t)) (org-mode))))) | 9330 | (let ((org-inhibit-startup t)) (org-mode))))) |
| 9289 | ((org-region-active-p) | 9331 | ((org-region-active-p) |
| 9290 | (org-table-convert-region (region-beginning) (region-end) arg)) | 9332 | (org-table-convert-region (region-beginning) (region-end) arg)) |
| 9291 | ((and (region-beginning) (region-end)) | 9333 | ((and (region-beginning) (region-end)) |
| 9292 | (if (y-or-n-p "Convert inactive region to table? ") | 9334 | (if (y-or-n-p "Convert inactive region to table? ") |
| 9293 | (org-table-convert-region (region-beginning) (region-end) arg) | 9335 | (org-table-convert-region (region-beginning) (region-end) arg) |
| 9294 | (error "Abort"))) | 9336 | (error "Abort"))) |
| 9295 | (t (error "No table at point, and no region to make one"))))) | 9337 | (t (error "No table at point, and no region to make one"))))) |
| 9296 | 9338 | ||
| 9297 | (defun org-return () | 9339 | (defun org-return () |
| @@ -9359,7 +9401,7 @@ scanning the buffer for these lines and updating the information." | |||
| 9359 | :style toggle :selected (org-in-invisibility-spec-p '(org-table))] | 9401 | :style toggle :selected (org-in-invisibility-spec-p '(org-table))] |
| 9360 | "--" | 9402 | "--" |
| 9361 | ["Create" org-table-create (and (not (org-at-table-p)) | 9403 | ["Create" org-table-create (and (not (org-at-table-p)) |
| 9362 | org-enable-table-editor)] | 9404 | org-enable-table-editor)] |
| 9363 | ["Convert Region" org-ctrl-c-ctrl-c (not (org-at-table-p 'any))] | 9405 | ["Convert Region" org-ctrl-c-ctrl-c (not (org-at-table-p 'any))] |
| 9364 | ["Import from File" org-table-import (not (org-at-table-p))] | 9406 | ["Import from File" org-table-import (not (org-at-table-p))] |
| 9365 | ["Export to File" org-table-export (org-at-table-p)] | 9407 | ["Export to File" org-table-export (org-at-table-p)] |
| @@ -9471,7 +9513,7 @@ With optional NODE, go directly to that node." | |||
| 9471 | ;;; Documentation | 9513 | ;;; Documentation |
| 9472 | 9514 | ||
| 9473 | (defun org-customize () | 9515 | (defun org-customize () |
| 9474 | "Call the customize function with `org' as argument." | 9516 | "Call the customize function with org as argument." |
| 9475 | (interactive) | 9517 | (interactive) |
| 9476 | (customize-browse 'org)) | 9518 | (customize-browse 'org)) |
| 9477 | 9519 | ||
| @@ -9529,7 +9571,7 @@ Works on both Emacs and XEmacs." | |||
| 9529 | (if org-ignore-region | 9571 | (if org-ignore-region |
| 9530 | nil | 9572 | nil |
| 9531 | (if org-xemacs-p | 9573 | (if org-xemacs-p |
| 9532 | (and zmacs-regions (region-active-p)) | 9574 | (and zmacs-regions (region-active-p)) |
| 9533 | (and transient-mark-mode mark-active)))) | 9575 | (and transient-mark-mode mark-active)))) |
| 9534 | 9576 | ||
| 9535 | (defun org-add-to-invisibility-spec (arg) | 9577 | (defun org-add-to-invisibility-spec (arg) |
| @@ -9550,8 +9592,8 @@ that can be added." | |||
| 9550 | (if (fboundp 'remove-from-invisibility-spec) | 9592 | (if (fboundp 'remove-from-invisibility-spec) |
| 9551 | (remove-from-invisibility-spec arg) | 9593 | (remove-from-invisibility-spec arg) |
| 9552 | (if (consp buffer-invisibility-spec) | 9594 | (if (consp buffer-invisibility-spec) |
| 9553 | (setq buffer-invisibility-spec | 9595 | (setq buffer-invisibility-spec |
| 9554 | (delete arg buffer-invisibility-spec))))) | 9596 | (delete arg buffer-invisibility-spec))))) |
| 9555 | 9597 | ||
| 9556 | (defun org-in-invisibility-spec-p (arg) | 9598 | (defun org-in-invisibility-spec-p (arg) |
| 9557 | "Is ARG a member of `buffer-invisibility-spec'?." | 9599 | "Is ARG a member of `buffer-invisibility-spec'?." |
| @@ -9564,14 +9606,14 @@ that can be added." | |||
| 9564 | (if (fboundp 'image-file-name-regexp) | 9606 | (if (fboundp 'image-file-name-regexp) |
| 9565 | (image-file-name-regexp) | 9607 | (image-file-name-regexp) |
| 9566 | (let ((image-file-name-extensions | 9608 | (let ((image-file-name-extensions |
| 9567 | '("png" "jpeg" "jpg" "gif" "tiff" "tif" | 9609 | '("png" "jpeg" "jpg" "gif" "tiff" "tif" |
| 9568 | "xbm" "xpm" "pbm" "pgm" "ppm"))) | 9610 | "xbm" "xpm" "pbm" "pgm" "ppm"))) |
| 9569 | (concat "\\." | 9611 | (concat "\\." |
| 9570 | (regexp-opt (nconc (mapcar 'upcase | 9612 | (regexp-opt (nconc (mapcar 'upcase |
| 9571 | image-file-name-extensions) | 9613 | image-file-name-extensions) |
| 9572 | image-file-name-extensions) | 9614 | image-file-name-extensions) |
| 9573 | t) | 9615 | t) |
| 9574 | "\\'")))) | 9616 | "\\'")))) |
| 9575 | 9617 | ||
| 9576 | ;; Functions needed for compatibility with old outline.el | 9618 | ;; Functions needed for compatibility with old outline.el |
| 9577 | 9619 | ||
| @@ -9591,9 +9633,9 @@ to a visible line beginning. This makes the function of C-a more intuitive." | |||
| 9591 | nil | 9633 | nil |
| 9592 | (backward-char 1) | 9634 | (backward-char 1) |
| 9593 | (if (org-invisible-p) | 9635 | (if (org-invisible-p) |
| 9594 | (while (and (not (bobp)) (org-invisible-p)) | 9636 | (while (and (not (bobp)) (org-invisible-p)) |
| 9595 | (backward-char 1) | 9637 | (backward-char 1) |
| 9596 | (beginning-of-line 1)) | 9638 | (beginning-of-line 1)) |
| 9597 | (forward-char 1)))) | 9639 | (forward-char 1)))) |
| 9598 | (when org-noutline-p | 9640 | (when org-noutline-p |
| 9599 | (define-key org-mode-map "\C-a" 'org-beginning-of-line)) | 9641 | (define-key org-mode-map "\C-a" 'org-beginning-of-line)) |
| @@ -9603,26 +9645,26 @@ to a visible line beginning. This makes the function of C-a more intuitive." | |||
| 9603 | (if org-noutline-p | 9645 | (if org-noutline-p |
| 9604 | ;; Early versions of noutline don't have `outline-invisible-p'. | 9646 | ;; Early versions of noutline don't have `outline-invisible-p'. |
| 9605 | (if (fboundp 'outline-invisible-p) | 9647 | (if (fboundp 'outline-invisible-p) |
| 9606 | (outline-invisible-p) | 9648 | (outline-invisible-p) |
| 9607 | (get-char-property (point) 'invisible)) | 9649 | (get-char-property (point) 'invisible)) |
| 9608 | (save-excursion | 9650 | (save-excursion |
| 9609 | (skip-chars-backward "^\r\n") | 9651 | (skip-chars-backward "^\r\n") |
| 9610 | (equal (char-before) ?\r)))) | 9652 | (equal (char-before) ?\r)))) |
| 9611 | 9653 | ||
| 9612 | (defun org-back-to-heading (&optional invisible-ok) | 9654 | (defun org-back-to-heading (&optional invisible-ok) |
| 9613 | "Move to previous heading line, or beginning of this line if it's a heading. | 9655 | "Move to previous heading line, or beg of this line if it's a heading. |
| 9614 | Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." | 9656 | Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." |
| 9615 | (if org-noutline-p | 9657 | (if org-noutline-p |
| 9616 | (outline-back-to-heading invisible-ok) | 9658 | (outline-back-to-heading invisible-ok) |
| 9617 | (if (looking-at outline-regexp) | 9659 | (if (looking-at outline-regexp) |
| 9618 | t | 9660 | t |
| 9619 | (if (re-search-backward (concat (if invisible-ok "\\([\r\n]\\|^\\)" "^") | 9661 | (if (re-search-backward (concat (if invisible-ok "\\([\r\n]\\|^\\)" "^") |
| 9620 | outline-regexp) | 9662 | outline-regexp) |
| 9621 | nil t) | 9663 | nil t) |
| 9622 | (if invisible-ok | 9664 | (if invisible-ok |
| 9623 | (progn (goto-char (match-end 1)) | 9665 | (progn (goto-char (match-end 1)) |
| 9624 | (looking-at outline-regexp))) | 9666 | (looking-at outline-regexp))) |
| 9625 | (error "Before first heading"))))) | 9667 | (error "Before first heading"))))) |
| 9626 | 9668 | ||
| 9627 | (defun org-on-heading-p (&optional invisible-ok) | 9669 | (defun org-on-heading-p (&optional invisible-ok) |
| 9628 | "Return t if point is on a (visible) heading line. | 9670 | "Return t if point is on a (visible) heading line. |
| @@ -9632,9 +9674,9 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok too." | |||
| 9632 | (save-excursion | 9674 | (save-excursion |
| 9633 | (skip-chars-backward "^\n\r") | 9675 | (skip-chars-backward "^\n\r") |
| 9634 | (and (looking-at outline-regexp) | 9676 | (and (looking-at outline-regexp) |
| 9635 | (or invisible-ok | 9677 | (or invisible-ok |
| 9636 | (bobp) | 9678 | (bobp) |
| 9637 | (equal (char-before) ?\n)))))) | 9679 | (equal (char-before) ?\n)))))) |
| 9638 | 9680 | ||
| 9639 | (defun org-up-heading-all (arg) | 9681 | (defun org-up-heading-all (arg) |
| 9640 | "Move to the heading line of which the present line is a subheading. | 9682 | "Move to the heading line of which the present line is a subheading. |
| @@ -9642,26 +9684,26 @@ This function considers both visible and invisible heading lines. | |||
| 9642 | With argument, move up ARG levels." | 9684 | With argument, move up ARG levels." |
| 9643 | (if org-noutline-p | 9685 | (if org-noutline-p |
| 9644 | (if (fboundp 'outline-up-heading-all) | 9686 | (if (fboundp 'outline-up-heading-all) |
| 9645 | (outline-up-heading-all arg) ; emacs 21 version of outline.el | 9687 | (outline-up-heading-all arg) ; emacs 21 version of outline.el |
| 9646 | (outline-up-heading arg t)) ; emacs 22 version of outline.el | 9688 | (outline-up-heading arg t)) ; emacs 22 version of outline.el |
| 9647 | (org-back-to-heading t) | 9689 | (org-back-to-heading t) |
| 9648 | (looking-at outline-regexp) | 9690 | (looking-at outline-regexp) |
| 9649 | (if (<= (- (match-end 0) (match-beginning 0)) arg) | 9691 | (if (<= (- (match-end 0) (match-beginning 0)) arg) |
| 9650 | (error "Cannot move up %d levels" arg) | 9692 | (error "Cannot move up %d levels" arg) |
| 9651 | (re-search-backward | 9693 | (re-search-backward |
| 9652 | (concat "[\n\r]" (regexp-quote | 9694 | (concat "[\n\r]" (regexp-quote |
| 9653 | (make-string (- (match-end 0) (match-beginning 0) arg) | 9695 | (make-string (- (match-end 0) (match-beginning 0) arg) |
| 9654 | ?*)) | 9696 | ?*)) |
| 9655 | "[^*]")) | 9697 | "[^*]")) |
| 9656 | (forward-char 1)))) | 9698 | (forward-char 1)))) |
| 9657 | 9699 | ||
| 9658 | (defun org-show-hidden-entry () | 9700 | (defun org-show-hidden-entry () |
| 9659 | "Show an entry where even the heading is hidden." | 9701 | "Show an entry where even the heading is hidden." |
| 9660 | (save-excursion | 9702 | (save-excursion |
| 9661 | (if (not org-noutline-p) | 9703 | (if (not org-noutline-p) |
| 9662 | (progn | 9704 | (progn |
| 9663 | (org-back-to-heading t) | 9705 | (org-back-to-heading t) |
| 9664 | (org-flag-heading nil))) | 9706 | (org-flag-heading nil))) |
| 9665 | (org-show-entry))) | 9707 | (org-show-entry))) |
| 9666 | 9708 | ||
| 9667 | (defun org-check-occur-regexp (regexp) | 9709 | (defun org-check-occur-regexp (regexp) |
| @@ -9670,7 +9712,7 @@ Of course, only for the old outline mode." | |||
| 9670 | (if org-noutline-p | 9712 | (if org-noutline-p |
| 9671 | regexp | 9713 | regexp |
| 9672 | (if (string-match "^\\^" regexp) | 9714 | (if (string-match "^\\^" regexp) |
| 9673 | (concat "[\n\r]" (substring regexp 1)) | 9715 | (concat "[\n\r]" (substring regexp 1)) |
| 9674 | regexp))) | 9716 | regexp))) |
| 9675 | 9717 | ||
| 9676 | (defun org-flag-heading (flag &optional entry) | 9718 | (defun org-flag-heading (flag &optional entry) |
| @@ -9679,21 +9721,21 @@ When ENTRY is non-nil, show the entire entry." | |||
| 9679 | (save-excursion | 9721 | (save-excursion |
| 9680 | (org-back-to-heading t) | 9722 | (org-back-to-heading t) |
| 9681 | (if (not org-noutline-p) | 9723 | (if (not org-noutline-p) |
| 9682 | ;; Make the current headline visible | 9724 | ;; Make the current headline visible |
| 9683 | (outline-flag-region (max 1 (1- (point))) (point) (if flag ?\r ?\n))) | 9725 | (outline-flag-region (max 1 (1- (point))) (point) (if flag ?\r ?\n))) |
| 9684 | ;; Check if we should show the entire entry | 9726 | ;; Check if we should show the entire entry |
| 9685 | (if entry | 9727 | (if entry |
| 9686 | (progn | 9728 | (progn |
| 9687 | (org-show-entry) | 9729 | (org-show-entry) |
| 9688 | (save-excursion ;; FIXME: Is this the fix for points in the -| | 9730 | (save-excursion ;; FIXME: Is this the fix for points in the -| |
| 9689 | ;; middle of text? | | 9731 | ;; middle of text? | |
| 9690 | (and (outline-next-heading) ;; | | 9732 | (and (outline-next-heading) ;; | |
| 9691 | (org-flag-heading nil)))) ; show the next heading _| | 9733 | (org-flag-heading nil)))) ; show the next heading _| |
| 9692 | (outline-flag-region (max 1 (1- (point))) | 9734 | (outline-flag-region (max 1 (1- (point))) |
| 9693 | (save-excursion (outline-end-of-heading) (point)) | 9735 | (save-excursion (outline-end-of-heading) (point)) |
| 9694 | (if org-noutline-p | 9736 | (if org-noutline-p |
| 9695 | flag | 9737 | flag |
| 9696 | (if flag ?\r ?\n)))))) | 9738 | (if flag ?\r ?\n)))))) |
| 9697 | 9739 | ||
| 9698 | (defun org-show-subtree () | 9740 | (defun org-show-subtree () |
| 9699 | "Show everything after this heading at deeper levels." | 9741 | "Show everything after this heading at deeper levels." |
| @@ -9732,8 +9774,8 @@ Show the heading too, if it is currently invisible." | |||
| 9732 | '(defadvice bookmark-jump (after org-make-visible activate) | 9774 | '(defadvice bookmark-jump (after org-make-visible activate) |
| 9733 | "Make the position visible." | 9775 | "Make the position visible." |
| 9734 | (and (eq major-mode 'org-mode) | 9776 | (and (eq major-mode 'org-mode) |
| 9735 | (org-invisible-p) | 9777 | (org-invisible-p) |
| 9736 | (org-show-hierarchy-above)))) | 9778 | (org-show-hierarchy-above)))) |
| 9737 | 9779 | ||
| 9738 | ;;; Finish up | 9780 | ;;; Finish up |
| 9739 | 9781 | ||