Mercurial > emacs
comparison lisp/textmodes/org.el @ 64080:d5372215b17d
Leading space replaced by TABS.
(org-recalc-marks, org-table-rotate-recalc-marks)
(org-table-get-specials): Treat "^" and "_" marks.
(org-table-justify-field-maybe): Optional argument NEW.
(org-table-eval-formula): Parsing of the format simplified. New
modes C,I. Honor the %= parameter in the current table. Avoid
unnecessary re-align by using the NEW argument to
`org-table-justify-field-maybe'.
(org-calc-default-modes): Default for date-format mimicks
org-mode.
(org-agenda, org-timeline): Quote argument in
`org-agenda-redo-command'.
author | Carsten Dominik <dominik@science.uva.nl> |
---|---|
date | Mon, 04 Jul 2005 15:08:45 +0000 |
parents | ebf5ec3a071e |
children | a8fa7c632ee4 |
comparison
equal
deleted
inserted
replaced
64079:c53a9463c31a | 64080:d5372215b17d |
---|---|
3 ;; Copyright (c) 2004, 2005 Free Software Foundation | 3 ;; Copyright (c) 2004, 2005 Free Software Foundation |
4 ;; | 4 ;; |
5 ;; Author: Carsten Dominik <dominik at science dot uva dot nl> | 5 ;; Author: Carsten Dominik <dominik at science dot uva dot nl> |
6 ;; Keywords: outlines, hypermedia, calendar | 6 ;; Keywords: outlines, hypermedia, calendar |
7 ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ | 7 ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ |
8 ;; Version: 3.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 ;; |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | 12 ;; GNU Emacs is free software; you can redistribute it and/or modify |
13 ;; it under the terms of the GNU General Public License as published by | 13 ;; it under the terms of the GNU General Public License as published by |
78 ;; Org-mode, you can read the same text online as HTML. There is also an | 78 ;; Org-mode, you can read the same text online as HTML. There is also an |
79 ;; excellent reference card made by Philip Rooke. | 79 ;; excellent reference card made by Philip Rooke. |
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. |
86 ;; - table.el keybinding is now `C-c ~'. | 90 ;; - table.el keybinding is now `C-c ~'. |
87 ;; - Numeric argument to org-cycle does `show-subtree' above on level ARG. | 91 ;; - Numeric argument to org-cycle does `show-subtree' above on level ARG. |
176 (require 'time-date) | 180 (require 'time-date) |
177 (require 'easymenu) | 181 (require 'easymenu) |
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) |
185 (message "Org-mode version %s" org-version)) | 189 (message "Org-mode version %s" org-version)) |
186 | 190 |
191 "Are we running xemacs?") | 195 "Are we running xemacs?") |
192 (defconst org-noutline-p (featurep 'noutline) | 196 (defconst org-noutline-p (featurep 'noutline) |
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 |
200 :group 'calendar) | 204 :group 'calendar) |
201 | 205 |
238 | 242 |
239 (defun org-key (key) | 243 (defun org-key (key) |
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. |
247 This can also be configured on a per-file basis by adding one of | 251 This can also be configured on a per-file basis by adding one of |
248 the following lines anywhere in the buffer: | 252 the following lines anywhere in the buffer: |
250 #+STARTUP: fold | 254 #+STARTUP: fold |
251 #+STARTUP: nofold | 255 #+STARTUP: nofold |
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'. |
261 This is useful since some lines containing links can be very long and | 265 This is useful since some lines containing links can be very long and |
262 uninteresting. Also tables look terrible when wrapped." | 266 uninteresting. Also tables look terrible when wrapped." |
309 This variable is only relevant if `org-todo-keywords' contains more than two | 313 This variable is only relevant if `org-todo-keywords' contains more than two |
310 states. There are two ways how these keywords can be used: | 314 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 |
322 \\[org-todo], you turn an empty entry into the state TODO. When you started | 326 \\[org-todo], you turn an empty entry into the state TODO. When you started |
323 working on the item, you use \\[org-todo] again to switch it to \"STARTED\", | 327 working on the item, you use \\[org-todo] again to switch it to \"STARTED\", |
336 type with completion. Of course, you can also type the keyword | 340 type with completion. Of course, you can also type the keyword |
337 directly into the buffer. M-TAB completes TODO keywords at the | 341 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. |
345 This is the priority an item get if no explicit priority is given." | 349 This is the priority an item get if no explicit priority is given." |
346 :group 'org-keywords | 350 :group 'org-keywords |
443 | 447 |
444 (defun org-set-regexps-and-options () | 448 (defun org-set-regexps-and-options () |
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 |
528 "Options concerning time stamps and deadlines in Org-mode." | 532 "Options concerning time stamps and deadlines in Org-mode." |
529 :tag "Org Time" | 533 :tag "Org Time" |
592 | 596 |
593 ;; FIXME: First day of month works only for current month because it would | 597 ;; FIXME: First day of month works only for current month because it would |
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." |
606 :group 'org-agenda | 610 :group 'org-agenda |
607 :type 'number) | 611 :type 'number) |
621 :type 'boolean) | 625 :type 'boolean) |
622 | 626 |
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 |
631 (defcustom org-agenda-sorting-strategy '(time-up category-keep priority-down) | 635 (defcustom org-agenda-sorting-strategy '(time-up category-keep priority-down) |
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. |
644 priority-down Sort numerically by priority, high priority first. | 648 priority-down Sort numerically by priority, high priority first. |
645 | 649 |
655 | 659 |
656 Leaving out `category-keep' would mean that items will be sorted across | 660 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. |
671 This format works similar to a printf format, with the following meaning: | 675 This format works similar to a printf format, with the following meaning: |
672 | 676 |
723 of `org-agenda-prefix-format' or `org-timeline-prefix-format'.") | 727 of `org-agenda-prefix-format' or `org-timeline-prefix-format'.") |
724 | 728 |
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) |
734 | 738 |
735 (defcustom org-agenda-time-grid | 739 (defcustom org-agenda-time-grid |
752 a grid line." | 756 a grid line." |
753 :group 'org-agenda | 757 :group 'org-agenda |
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 |
767 (defcustom org-agenda-remove-times-when-in-prefix t | 771 (defcustom org-agenda-remove-times-when-in-prefix t |
768 "Non-nil means, remove duplicate time specifications in agenda items. | 772 "Non-nil means, remove duplicate time specifications in agenda items. |
775 The option can be t or nil. It may also be the symbol `beg', indicating | 779 The option can be t or nil. It may also be the symbol `beg', indicating |
776 that the time should only be removed what it is located at the beginning of | 780 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. |
786 This is only relevant for sorting. When t, items which have no explicit | 790 This is only relevant for sorting. When t, items which have no explicit |
787 time like 15:30 will be considered as 24:01, i.e. later than any items which | 791 time like 15:30 will be considered as 24:01, i.e. later than any items which |
846 (defcustom org-archive-location "%s_archive::" | 850 (defcustom org-archive-location "%s_archive::" |
847 "The location where subtrees should be archived. | 851 "The location where subtrees should be archived. |
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 |
855 The part after the double colon is a headline. The archived entries will be | 859 The part after the double colon is a headline. The archived entries will be |
856 filed under that headline. When omitted, the subtrees are simply filed away | 860 filed under that headline. When omitted, the subtrees are simply filed away |
857 at the end of the file, as top-level entries. | 861 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 |
877 | 881 |
878 #+ARCHIVE: basement::** Finished Tasks" | 882 #+ARCHIVE: basement::** Finished Tasks" |
903 If you want to make sure that your link is always properly terminated, | 907 If you want to make sure that your link is always properly terminated, |
904 include angle brackets into this format, like \"<%s>\". Some people also | 908 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 |
922 (defcustom org-line-numbers-in-file-links t | 926 (defcustom org-line-numbers-in-file-links t |
923 "Non-nil means, file links from `org-store-link' contain line numbers. | 927 "Non-nil means, file links from `org-store-link' contain line numbers. |
962 For the calendar, use the variable `calendar-setup'. | 966 For the calendar, use the variable `calendar-setup'. |
963 For BBDB, it is currently only possible to display the matches in | 967 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." |
987 :group 'org-link | 991 :group 'org-link |
988 :type 'boolean) | 992 :type 'boolean) |
1021 ("ppt" . "soffice %s") | 1025 ("ppt" . "soffice %s") |
1022 ("pps" . "soffice %s") | 1026 ("pps" . "soffice %s") |
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 |
1030 '((t . "open %s") | 1034 '((t . "open %s") |
1031 ("ps" . "gv %s") | 1035 ("ps" . "gv %s") |
1059 extension. The entries in this list are cons cells with a file extension | 1063 extension. The entries in this list are cons cells with a file extension |
1060 and the corresponding command. Possible values for the command are: | 1064 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 |
1082 "Options concerning interaction with remember.el." | 1086 "Options concerning interaction with remember.el." |
1083 :tag "Org Remember" | 1087 :tag "Org Remember" |
1094 "Default target for storing notes. | 1098 "Default target for storing notes. |
1095 Used by the hooks for remember.el. This can be a string, or nil to mean | 1099 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." |
1114 :tag "Org Table" | 1118 :tag "Org Table" |
1115 :group 'org) | 1119 :group 'org) |
1117 (defcustom org-enable-table-editor 'optimized | 1121 (defcustom org-enable-table-editor 'optimized |
1118 "Non-nil means, lines starting with \"|\" are handled by the table editor. | 1122 "Non-nil means, lines starting with \"|\" are handled by the table editor. |
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 |
1132 very good at guessing when a re-align will be necessary, but you can always | 1136 very good at guessing when a re-align will be necessary, but you can always |
1133 force one with `C-c C-c'. | 1137 force one with `C-c C-c'. |
1137 | 1141 |
1138 This variable can be used to turn on and off the table editor during a session, | 1142 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." |
1148 :group 'org-table | 1152 :group 'org-table |
1149 :type 'string) | 1153 :type 'string) |
1178 12 12.2 2.4e-08 2x10^12 4.034+-0.02 2.7(10) >3.5 | 1182 12 12.2 2.4e-08 2x10^12 4.034+-0.02 2.7(10) >3.5 |
1179 | 1183 |
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. |
1199 In a column all non-white fields are considered. If at least this | 1203 In a column all non-white fields are considered. If at least this |
1200 fraction of fields is matched by `org-table-number-fraction', | 1204 fraction of fields is matched by `org-table-number-fraction', |
1225 (defcustom org-calc-default-modes | 1229 (defcustom org-calc-default-modes |
1226 '(calc-internal-prec 12 | 1230 '(calc-internal-prec 12 |
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 |
1234 relies on the variables to be present in the list." | 1241 relies on the variables to be present in the list." |
1235 :group 'org-table-calculation | 1242 :group 'org-table-calculation |
1264 (setq org-table-formula-constants '((\"c\" . \"299792458.\"))) | 1271 (setq org-table-formula-constants '((\"c\" . \"299792458.\"))) |
1265 | 1272 |
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. |
1274 Then all input fields will be converted to a number, and the result | 1281 Then all input fields will be converted to a number, and the result |
1275 must also be a number. When nil, calc's full potential is available | 1282 must also be a number. When nil, calc's full potential is available |
1320 "Terms used in export text, translated to different languages. | 1327 "Terms used in export text, translated to different languages. |
1321 Use the variable `org-export-default-language' to set the language, | 1328 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 |
1337 (defcustom org-export-headline-levels 3 | 1344 (defcustom org-export-headline-levels 3 |
1338 "The last level which is still exported as a headline. | 1345 "The last level which is still exported as a headline. |
1453 sub- or superscripts. | 1460 sub- or superscripts. |
1454 | 1461 |
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 |
1462 sub/superscript. | 1469 sub/superscript. |
1463 In ASCII export, this option has no effect. | 1470 In ASCII export, this option has no effect. |
1496 Otherwise the buffer will just be saved to a file and stay hidden." | 1503 Otherwise the buffer will just be saved to a file and stay hidden." |
1497 :group 'org-export | 1504 :group 'org-export |
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) |
1505 | 1512 |
1506 (defgroup org-faces nil | 1513 (defgroup org-faces nil |
1662 (defface org-time-grid ;; font-lock-variable-name-face | 1669 (defface org-time-grid ;; font-lock-variable-name-face |
1663 '((((type tty) (class color)) (:foreground "yellow" :weight light)) | 1670 '((((type tty) (class color)) (:foreground "yellow" :weight light)) |
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 |
1671 '( | 1678 '( |
1672 org-level-1 | 1679 org-level-1 |
1769 'org-unfontify-region) | 1776 'org-unfontify-region) |
1770 ;; Activate before-change-function | 1777 ;; Activate before-change-function |
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 |
1794 ;; Need to do this here because define-derived-mode sets up | 1804 ;; Need to do this here because define-derived-mode sets up |
1795 ;; the keymap so late. | 1805 ;; the keymap so late. |
1803 (define-key org-mode-map [menu-bar hide] 'undefined) | 1813 (define-key org-mode-map [menu-bar hide] 'undefined) |
1804 (define-key org-mode-map [menu-bar show] 'undefined)) | 1814 (define-key org-mode-map [menu-bar show] 'undefined)) |
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-*\\(|\\|\\+-+\\)"))) |
1821 | 1831 |
1822 (defsubst org-current-line (&optional pos) | 1832 (defsubst org-current-line (&optional pos) |
1848 (concat "\000" org-link-regexp "\000") | 1858 (concat "\000" org-link-regexp "\000") |
1849 "Matches a link and optionally surrounding angle brackets.") | 1859 "Matches a link and optionally surrounding angle brackets.") |
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.") |
1857 (defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\([^0-9>\r\n]*\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" | 1867 (defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\([^0-9>\r\n]*\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" |
1858 "Regular expression matching time strings for analysis.") | 1868 "Regular expression matching time strings for analysis.") |
1859 (defconst org-ts-regexp2 (concat "<" org-ts-regexp1 ">") | 1869 (defconst org-ts-regexp2 (concat "<" org-ts-regexp1 ">") |
1860 "Regular expression matching time stamps, with groups.") | 1870 "Regular expression matching time stamps, with groups.") |
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 |
1887 (org-back-to-heading t) | 1897 (org-back-to-heading t) |
1888 (- (match-end 0) (match-beginning 0)))) | 1898 (- (match-end 0) (match-beginning 0)))) |
1889 | 1899 |
1890 (defvar org-font-lock-keywords nil) | 1900 (defvar org-font-lock-keywords nil) |
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 |
1952 | 1962 |
1953 (defvar org-cycle-global-status nil) | 1963 (defvar org-cycle-global-status nil) |
1954 (defvar org-cycle-subtree-status nil) | 1964 (defvar org-cycle-subtree-status nil) |
1955 (defun org-cycle (&optional arg) | 1965 (defun org-cycle (&optional arg) |
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 |
1973 a `show-subtree' and return to the previous cursor position. If ARG | 1983 a `show-subtree' and return to the previous cursor position. If ARG |
1974 is negative, go up that many levels. | 1984 is negative, go up that many levels. |
1980 - Special case: if point is the the beginning of the buffer and there is | 1990 - Special case: if point is the the beginning of the buffer and there is |
1981 no headline in line 1, this function will act as if called with prefix arg." | 1991 no headline in line 1, this function will act as if called with prefix arg." |
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 |
1989 (cond | 1999 (cond |
1990 | 2000 |
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 |
2000 (cond | 2010 (cond |
2001 ((and (eq last-command this-command) | 2011 ((and (eq last-command this-command) |
2036 ((integerp arg) | 2046 ((integerp arg) |
2037 ;; Show-subtree, ARG levels up from here. | 2047 ;; Show-subtree, ARG levels up from here. |
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)) |
2045 ;; At a heading: rotate between three different views | 2055 ;; At a heading: rotate between three different views |
2046 (org-back-to-heading) | 2056 (org-back-to-heading) |
2053 (while (and (not (eobp)) ;; this is like `next-line' | 2063 (while (and (not (eobp)) ;; this is like `next-line' |
2054 (get-char-property (1- (point)) 'invisible)) | 2064 (get-char-property (1- (point)) 'invisible)) |
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)) |
2088 ((if (and (eq org-cycle-emulate-tab 'white) | 2098 ((if (and (eq org-cycle-emulate-tab 'white) |
2089 (save-excursion (beginning-of-line 1) (looking-at "[ \t]+$"))) | 2099 (save-excursion (beginning-of-line 1) (looking-at "[ \t]+$"))) |
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. |
2106 This function is the default value of the hook `org-cycle-hook'." | 2116 This function is the default value of the hook `org-cycle-hook'." |
2107 (cond | 2117 (cond |
2169 location you want to reach. When pressing RET, the command returns to the | 2179 location you want to reach. When pressing RET, the command returns to the |
2170 original buffer in which the visibility is still unchanged. It then jumps | 2180 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) |
2183 "Let the user select a location in the Org-mode buffer BUF. | 2193 "Let the user select a location in the Org-mode buffer BUF. |
2184 This function uses a recursive edit. It returns the selected position | 2194 This function uses a recursive edit. It returns the selected position |
2185 or nil." | 2195 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)) |
2255 | 2265 |
2256 ;;; Promotion, Demotion, Inserting new headlines | 2266 ;;; Promotion, Demotion, Inserting new headlines |
2284 (save-excursion | 2294 (save-excursion |
2285 (org-back-to-heading) | 2295 (org-back-to-heading) |
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 |
2294 (defun org-promote-subtree () | 2304 (defun org-promote-subtree () |
2295 "Promote the entire subtree. | 2305 "Promote the entire subtree. |
2310 If the region is active in `transient-mark-mode', promote all headings | 2320 If the region is active in `transient-mark-mode', promote all headings |
2311 in the region." | 2321 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 |
2319 (defun org-do-demote () | 2329 (defun org-do-demote () |
2320 "Demote the current heading lower down the tree. | 2330 "Demote the current heading lower down the tree. |
2321 If the region is active in `transient-mark-mode', demote all headings | 2331 If the region is active in `transient-mark-mode', demote all headings |
2322 in the region." | 2332 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 |
2330 (defun org-fix-position-after-promote () | 2340 (defun org-fix-position-after-promote () |
2331 "Make sure that after pro/demotion cursor position is right." | 2341 "Make sure that after pro/demotion cursor position is right." |
2337 "Promote the current heading higher up the tree. | 2347 "Promote the current heading higher up the tree. |
2338 If the region is active in `transient-mark-mode', promote all headings | 2348 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. |
2350 If the region is active in `transient-mark-mode', demote all headings | 2360 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." |
2361 (org-back-to-heading) | 2371 (org-back-to-heading) |
2362 (let ((level (outline-level))) | 2372 (let ((level (outline-level))) |
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." |
2373 (let ((org-ignore-region t)) | 2383 (let ((org-ignore-region t)) |
2374 (save-excursion | 2384 (save-excursion |
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. |
2388 However, if the regexp PROHIBIT matches at all, don't do anything. | 2398 However, if the regexp PROHIBIT matches at all, don't do anything. |
2389 This is being used to change indentation along with the length of the | 2399 This is being used to change indentation along with the length of the |
2390 heading marker. But if there are any lines which are not indented, nothing | 2400 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 |
2402 | 2412 |
2403 (defun org-move-subtree-up (&optional arg) | 2413 (defun org-move-subtree-up (&optional arg) |
2431 (error "Cannot move past superior level or buffer limit"))) | 2441 (error "Cannot move past superior level or buffer limit"))) |
2432 (setq cnt (1- cnt))) | 2442 (setq cnt (1- cnt))) |
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) |
2443 (insert txt) | 2453 (insert txt) |
2444 (goto-char ins-point) | 2454 (goto-char ins-point) |
2468 (let (beg end folded) | 2478 (let (beg end folded) |
2469 (org-back-to-heading) | 2479 (org-back-to-heading) |
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)) |
2477 (goto-char beg) | 2487 (goto-char beg) |
2478 (when (> end beg) | 2488 (when (> end beg) |
2479 (setq org-subtree-clip-folded folded) | 2489 (setq org-subtree-clip-folded folded) |
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. |
2488 The entire subtree is promoted or demoted in order to match a new headline | 2498 The entire subtree is promoted or demoted in order to match a new headline |
2489 level. By default, the new level is derived from the visible headings | 2499 level. By default, the new level is derived from the visible headings |
2504 (unless (org-kill-is-subtree-p tree) | 2514 (unless (org-kill-is-subtree-p tree) |
2505 (error | 2515 (error |
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) |
2557 (setq end (point)) | 2567 (setq end (point)) |
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. |
2577 Returns nil if kill does not start with a headline, or if the first | 2587 Returns nil if kill does not start with a headline, or if the first |
2578 headline level is not the largest headline level in the tree. | 2588 headline level is not the largest headline level in the tree. |
2579 So this will actually accept several entries of equal levels as well, | 2589 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. |
2597 The archive can be a certain top-level heading in the current file, or in | 2607 The archive can be a certain top-level heading in the current file, or in |
2598 a different file. The tree will be moved to that location, the subtree | 2608 a different file. The tree will be moved to that location, the subtree |
2599 heading be marked DONE, and the current time will be added." | 2609 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 |
2693 (defun org-complete (&optional arg) | 2703 (defun org-complete (&optional arg) |
2694 "Perform completion on word at point. | 2704 "Perform completion on word at point. |
2700 setting file options. | 2710 setting file options. |
2701 At all other locations, this simply calls `ispell-complete-word'." | 2711 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 |
2765 (defun org-toggle-comment () | 2775 (defun org-toggle-comment () |
2766 "Change the COMMENT state of an entry." | 2776 "Change the COMMENT state of an entry." |
2767 (interactive) | 2777 (interactive) |
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. |
2780 If the last change removed the TODO tag or switched to DONE, then | 2790 If the last change removed the TODO tag or switched to DONE, then |
2781 this is nil.") | 2791 this is nil.") |
2798 (interactive "P") | 2808 (interactive "P") |
2799 (save-excursion | 2809 (save-excursion |
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. |
2844 The tree will show the lines where the regexp matches, and all higher | 2854 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. |
2854 A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down] | 2864 A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down] |
2855 to modify it to the correct date." | 2865 to modify it to the correct date." |
2856 (interactive) | 2866 (interactive) |
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. |
2866 A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down] | 2876 A timestamp is also inserted - use \\[org-timestamp-up] and \\[org-timestamp-down] |
2867 to modify it to the correct date." | 2877 to modify it to the correct date." |
2868 (interactive) | 2878 (interactive) |
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) |
2878 "Make a compact tree which shows all matches of REGEXP. | 2888 "Make a compact tree which shows all matches of REGEXP. |
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)) |
2886 (let ((cnt 0)) | 2896 (let ((cnt 0)) |
2887 (save-excursion | 2897 (save-excursion |
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 () |
2901 "Make sure point and the headings hierarchy above is visible." | 2911 "Make sure point and the headings hierarchy above is visible." |
2902 (if (org-on-heading-p t) | 2912 (if (org-on-heading-p t) |
2903 (org-flag-heading nil) ; only show the heading | 2913 (org-flag-heading nil) ; only show the heading |
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 |
2916 | 2926 |
2917 (defvar org-priority-regexp ".*?\\(\\[#\\([A-Z]\\)\\] ?\\)" | 2927 (defvar org-priority-regexp ".*?\\(\\[#\\([A-Z]\\)\\] ?\\)" |
2936 (setq action (or action 'set)) | 2946 (setq action (or action 'set)) |
2937 (let (current new news have remove) | 2947 (let (current new news have remove) |
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 |
2977 (defun org-get-priority (s) | 2987 (defun org-get-priority (s) |
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 |
2987 (defvar org-last-changed-timestamp nil) | 2997 (defvar org-last-changed-timestamp nil) |
2988 | 2998 |
2995 So if you press just return without typing anything, the time stamp | 3005 So if you press just return without typing anything, the time stamp |
2996 will represent the current date/time. If there is already a timestamp | 3006 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 |
3026 ;;; FIXME: Make the function take "Fri" as "next friday" | 3036 ;;; FIXME: Make the function take "Fri" as "next friday" |
3027 (defun org-read-date (&optional with-time to-time) | 3037 (defun org-read-date (&optional with-time to-time) |
3053 insert a time. Note that when WITH-TIME is not set, you can still | 3063 insert a time. Note that when WITH-TIME is not set, you can still |
3054 enter a time, and this function will inform the calling routine about | 3064 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 () |
3164 "Return to `org-read-date' with the date currently selected. | 3174 "Return to `org-read-date' with the date currently selected. |
3165 This is used by `org-read-date' in a temporary keymap for the calendar buffer." | 3175 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 |
3173 (defun org-check-deadlines (ndays) | 3183 (defun org-check-deadlines (ndays) |
3174 "Check if there are any deadlines due or past due. | 3184 "Check if there are any deadlines due or past due. |
3176 days from today's date. If the deadline appears in an entry marked DONE, | 3186 days from today's date. If the deadline appears in an entry marked DONE, |
3177 it is not shown. The prefix arg NDAYS can be used to test that many | 3187 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. |
3200 Normally the result is just printed in the echo area, but with prefix arg | 3210 Normally the result is just printed in the echo area, but with prefix arg |
3201 TO-BUFFER, the result is inserted just after the date stamp into the buffer. | 3211 TO-BUFFER, the result is inserted just after the date stamp into the buffer. |
3207 (save-excursion | 3217 (save-excursion |
3208 (unless (org-at-date-range-p) | 3218 (unless (org-at-date-range-p) |
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) |
3274 (apply 'encode-time (org-parse-time-string s))) | 3284 (apply 'encode-time (org-parse-time-string s))) |
3275 | 3285 |
3278 This should be a lot faster than the normal `parse-time-string'. | 3288 This should be a lot faster than the normal `parse-time-string'. |
3279 If time is not given, defaults to 0:00. However, with optional NODEFAULT, | 3289 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) |
3294 "Increase the date item at the cursor by one. | 3304 "Increase the date item at the cursor by one. |
3295 If the cursor is on the year, change the year. If it is on the month or | 3305 If the cursor is on the year, change the year. If it is on the month or |
3322 (and (match-beginning n) | 3332 (and (match-beginning n) |
3323 (<= (match-beginning n) pos) | 3333 (<= (match-beginning n) pos) |
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) |
3350 "Change the date in the time stamp at point. | 3360 "Change the date in the time stamp at point. |
3351 The date will be changed by N times WHAT. WHAT can be `day', `month', | 3361 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) |
3411 "Go to the Emacs calendar at the current date. | 3421 "Go to the Emacs calendar at the current date. |
3412 If there is a time stamp in the current line, go to that date. | 3422 If there is a time stamp in the current line, go to that date. |
3413 A prefix ARG can be used force the current date." | 3423 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)))) |
3427 | 3437 |
3428 (defun org-date-from-calendar () | 3438 (defun org-date-from-calendar () |
3487 (define-key org-agenda-mode-map (org-key 'S-left) 'org-agenda-date-earlier) | 3497 (define-key org-agenda-mode-map (org-key 'S-left) 'org-agenda-date-earlier) |
3488 | 3498 |
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) |
3496 (define-key org-agenda-mode-map "g" 'org-agenda-toggle-time-grid) | 3506 (define-key org-agenda-mode-map "g" 'org-agenda-toggle-time-grid) |
3497 (define-key org-agenda-mode-map "r" 'org-agenda-redo) | 3507 (define-key org-agenda-mode-map "r" 'org-agenda-redo) |
3595 m)) | 3605 m)) |
3596 | 3606 |
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.") |
3608 | 3618 |
3609 (defun org-get-agenda-file-buffer (file) | 3619 (defun org-get-agenda-file-buffer (file) |
3610 "Get a buffer visiting FILE. If the buffer needs to be created, add | 3620 "Get a buffer visiting FILE. If the buffer needs to be created, add |
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)) |
3618 buf))) | 3628 buf))) |
3619 | 3629 |
3623 \(if the user agrees) and then killed." | 3633 \(if the user agrees) and then killed." |
3624 (let (buf file) | 3634 (let (buf file) |
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. |
3634 | 3644 |
3635 (defun org-timeline (&optional include-all) | 3645 (defun org-timeline (&optional include-all) |
3643 (interactive "P") | 3653 (interactive "P") |
3644 (require 'calendar) | 3654 (require 'calendar) |
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) |
3674 (erase-buffer) | 3684 (erase-buffer) |
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)))) |
3708 | 3718 |
3709 ;;;###autoload | 3719 ;;;###autoload |
3719 (interactive "P") | 3729 (interactive "P") |
3720 (org-agenda-maybe-reset-markers 'force) | 3730 (org-agenda-maybe-reset-markers 'force) |
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 ""))) |
3828 | 3838 |
3829 (defun org-check-agenda-file (file) | 3839 (defun org-check-agenda-file (file) |
3830 "Make sure FILE exists. If not, ask user what to do." | 3840 "Make sure FILE exists. If not, ask user what to do." |
3831 ;; FIXME: this does not correctly change the menus | 3841 ;; FIXME: this does not correctly change the menus |
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 () |
3844 "Exit agenda by removing the window or the buffer." | 3854 "Exit agenda by removing the window or the buffer." |
3845 (interactive) | 3855 (interactive) |
3865 (defun org-agenda-goto-today () | 3875 (defun org-agenda-goto-today () |
3866 "Go to today." | 3876 "Go to today." |
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. |
3878 With prefix ARG, go forward that many times `org-agenda-ndays'." | 3888 With prefix ARG, go forward that many times `org-agenda-ndays'." |
3879 (interactive "p") | 3889 (interactive "p") |
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. |
3887 With prefix ARG, go back that many times `org-agenda-ndays'." | 3897 With prefix ARG, go back that many times `org-agenda-ndays'." |
3888 (interactive "p") | 3898 (interactive "p") |
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." |
3896 (interactive) | 3906 (interactive) |
3897 (unless (boundp 'starting-day) | 3907 (unless (boundp 'starting-day) |
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 |
3918 (defun org-agenda-next-date-line (&optional arg) | 3928 (defun org-agenda-next-date-line (&optional arg) |
3919 "Jump to the next line indicating a date in agenda buffer." | 3929 "Jump to the next line indicating a date in agenda buffer." |
3920 (interactive "p") | 3930 (interactive "p") |
3921 (beginning-of-line 1) | 3931 (beginning-of-line 1) |
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) |
3930 "Jump to the next line indicating a date in agenda buffer." | 3940 "Jump to the next line indicating a date in agenda buffer." |
3931 (interactive "p") | 3941 (interactive "p") |
3934 (error "No previous date before this line in this buffer"))) | 3944 (error "No previous date before this line in this buffer"))) |
3935 | 3945 |
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." |
3948 (funcall (if org-xemacs-p 'detach-extent 'delete-overlay) org-hl)) | 3958 (funcall (if org-xemacs-p 'detach-extent 'delete-overlay) org-hl)) |
3949 | 3959 |
3952 "Toggle follow mode in an agenda buffer." | 3962 "Toggle follow mode in an agenda buffer." |
3953 (interactive) | 3963 (interactive) |
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. |
3995 | 4005 |
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)) |
4051 (while (re-search-forward "^ +\n" nil t) | 4061 (while (re-search-forward "^ +\n" nil t) |
4052 (replace-match "")) | 4062 (replace-match "")) |
4059 ;; advice unnecessarily | 4069 ;; advice unnecessarily |
4060 (eval-after-load "diary-lib" | 4070 (eval-after-load "diary-lib" |
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. |
4080 Needed to avoid empty dates which mess up holiday display." | 4090 Needed to avoid empty dates which mess up holiday display." |
4081 ;; Catch the error if dealing with the new add-to-diary-alist | 4091 ;; Catch the error if dealing with the new add-to-diary-alist |
4091 It is possible (but not recommended) to add this function to the | 4101 It is possible (but not recommended) to add this function to the |
4092 `org-mode-hook'." | 4102 `org-mode-hook'." |
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'. |
4118 These are the files which are being checked for agenda entries. | 4128 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) |
4139 (vector file (list 'find-file file) t)) | 4149 (vector file (list 'find-file file) t)) |
4140 | 4150 |
4143 If NO-RANGES is non-nil, include only the start and end dates of a range, | 4153 If NO-RANGES is non-nil, include only the start and end dates of a range, |
4144 not every single day in the range. If FORCE-TODAY is non-nil, make | 4154 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 |
4167 (defun org-diary (&rest args) | 4177 (defun org-diary (&rest args) |
4168 "Return diary information from org-files. | 4178 "Return diary information from org-files. |
4170 It accesses org files and extracts information from those files to be | 4180 It accesses org files and extracts information from those files to be |
4171 listed in the diary. The function accepts arguments specifying what | 4181 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 |
4194 &%%(org-diary) ~/path/to/some/orgfile.org | 4204 &%%(org-diary) ~/path/to/some/orgfile.org |
4195 | 4205 |
4209 function from a program - use `org-agenda-get-day-entries' instead." | 4219 function from a program - use `org-agenda-get-day-entries' instead." |
4210 (org-agenda-maybe-reset-markers) | 4220 (org-agenda-maybe-reset-markers) |
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)) |
4220 (while (setq file (pop files)) | 4230 (while (setq file (pop files)) |
4221 (setq rtn (apply 'org-agenda-get-day-entries file date args)) | 4231 (setq rtn (apply 'org-agenda-get-day-entries file date args)) |
4228 the one returned by `calendar-current-date'. ARGS are symbols indicating | 4238 the one returned by `calendar-current-date'. ARGS are symbols indicating |
4229 which kind of entries should be extracted. For details about these, see | 4239 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?" |
4283 (interactive) | 4293 (interactive) |
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))) |
4557 | 4567 |
4558 | 4568 |
4603 `org-agenda-change-all-lines'." | 4613 `org-agenda-change-all-lines'." |
4604 (save-match-data | 4614 (save-match-data |
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. |
4692 The resulting form is returned and stored in the variable | 4702 The resulting form is returned and stored in the variable |
4693 `org-prefix-format-compiled'." | 4703 `org-prefix-format-compiled'." |
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)) |
4714 (setq org-prefix-format-compiled `(format ,s ,@vars)))) | 4724 (setq org-prefix-format-compiled `(format ,s ,@vars)))) |
4715 | 4725 |
4725 (string-match | 4735 (string-match |
4726 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s) | 4736 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s) |
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) |
4741 "Sort and concatenate the agenda items." | 4751 "Sort and concatenate the agenda items." |
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. |
4785 This priority is composed of the main priority given with the [#A] cookies, | 4795 This priority is composed of the main priority given with the [#A] cookies, |
4786 and by additional input from the age of a schedules or deadline entry." | 4796 and by additional input from the age of a schedules or deadline entry." |
4790 | 4800 |
4791 (defun org-agenda-goto (&optional highlight) | 4801 (defun org-agenda-goto (&optional highlight) |
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) |
4818 (goto-char pos) | 4828 (goto-char pos) |
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." |
4827 (interactive "e") | 4837 (interactive "e") |
4828 (mouse-set-point ev) | 4838 (mouse-set-point ev) |
4866 This changes the line at point, all other lines in the agenda referring to | 4876 This changes the line at point, all other lines in the agenda referring to |
4867 the same tree node, and the headline of the tree node in the Org-mode file." | 4877 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. |
4901 If FIXFACE is non-nil, the face of each item is modified acording to | 4911 If FIXFACE is non-nil, the face of each item is modified acording to |
4902 the new TODO state." | 4912 the new TODO state." |
4904 ; (setq newhead (org-format-agenda-item "x" newhead "x" nil 'noprefix)) | 4914 ; (setq newhead (org-format-agenda-item "x" newhead "x" nil 'noprefix)) |
4905 (save-excursion | 4915 (save-excursion |
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." |
4936 (interactive) | 4946 (interactive) |
4937 (org-agenda-priority 'up)) | 4947 (org-agenda-priority 'up)) |
4946 This changes the line at point, all other lines in the agenda referring to | 4956 This changes the line at point, all other lines in the agenda referring to |
4947 the same tree node, and the headline of the tree node in the Org-mode file." | 4957 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))) |
4967 (org-agenda-change-all-lines newhead hdmarker) | 4977 (org-agenda-change-all-lines newhead hdmarker) |
4968 (beginning-of-line 1))) | 4978 (beginning-of-line 1))) |
4970 (defun org-agenda-date-later (arg &optional what) | 4980 (defun org-agenda-date-later (arg &optional what) |
4971 "Change the date of this item to one day later." | 4981 "Change the date of this item to one day later." |
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 |
4986 (defun org-agenda-date-earlier (arg &optional what) | 4996 (defun org-agenda-date-earlier (arg &optional what) |
4987 "Change the date of this item to one day earlier." | 4997 "Change the date of this item to one day earlier." |
4993 The prefix ARG is passed to the `org-time-stamp' command and can therefore | 5003 The prefix ARG is passed to the `org-time-stamp' command and can therefore |
4994 be used to request time specification in the time stamp." | 5004 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 |
5009 (defun org-get-heading () | 5019 (defun org-get-heading () |
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) |
5059 "Execute a calendar command from the agenda, with the date associated to | 5069 "Execute a calendar command from the agenda, with the date associated to |
5060 the cursor position." | 5070 the cursor position." |
5061 (require 'diary-lib) | 5071 (require 'diary-lib) |
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." |
5082 (interactive) | 5092 (interactive) |
5083 (org-agenda-execute-calendar-command 'calendar-phases-of-moon)) | 5093 (org-agenda-execute-calendar-command 'calendar-phases-of-moon)) |
5092 Latitude and longitude can be specified with the variables | 5102 Latitude and longitude can be specified with the variables |
5093 `calendar-latitude' and `calendar-longitude'. When called with prefix | 5103 `calendar-latitude' and `calendar-longitude'. When called with prefix |
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 |
5111 (defun org-calendar-goto-agenda () | 5121 (defun org-calendar-goto-agenda () |
5112 "Compute the Org-mode agenda for the calendar date displayed at the cursor. | 5122 "Compute the Org-mode agenda for the calendar date displayed at the cursor. |
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*")))) |
5143 | 5153 |
5144 ;;; Link Stuff | 5154 ;;; Link Stuff |
5162 Normally, files will be opened by an appropriate application. If the | 5172 Normally, files will be opened by an appropriate application. If the |
5163 optional argument IN-EMACS is non-nil, Emacs will visit the file." | 5173 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." |
5252 (require 'bbdb) | 5262 (require 'bbdb) |
5253 (let ((inhibit-redisplay t)) | 5263 (let ((inhibit-redisplay t)) |
5265 (bbdb-company name nil) | 5275 (bbdb-company name nil) |
5266 (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) | 5276 (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) |
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." |
5275 (require 'gnus) | 5285 (require 'gnus) |
5276 (funcall (cdr (assq 'gnus org-link-frame-setup))) | 5286 (funcall (cdr (assq 'gnus org-link-frame-setup))) |
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." |
5288 (require 'vm) | 5298 (require 'vm) |
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) |
5307 (when article | 5317 (when article |
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." |
5322 (wl-summary-goto-folder-subr folder 'no-sync t nil t) | 5332 (wl-summary-goto-folder-subr folder 'no-sync t nil t) |
5323 (if article (wl-summary-jump-to-msg-by-message-id article)) | 5333 (if article (wl-summary-jump-to-msg-by-message-id article)) |
5326 (defun org-follow-rmail-link (folder article) | 5336 (defun org-follow-rmail-link (folder article) |
5327 "Follow an RMAIL link to FOLDER and ARTICLE." | 5337 "Follow an RMAIL link to FOLDER and ARTICLE." |
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) |
5349 "Open the file at PATH. | 5359 "Open the file at PATH. |
5350 First, this expands any special file name abbreviations. Then the | 5360 First, this expands any special file name abbreviations. Then the |
5352 entry for this file type, and if yes, the corresponding command is launched. | 5362 entry for this file type, and if yes, the corresponding command is launched. |
5353 If no application is found, Emacs simply visits the file. | 5363 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) |
5381 (eval cmd)) | 5391 (eval cmd)) |
5382 (t (funcall (cdr (assq 'file org-link-frame-setup)) file))))) | 5392 (t (funcall (cdr (assq 'file org-link-frame-setup)) file))))) |
5413 (let (link cpltxt) | 5423 (let (link cpltxt) |
5414 (cond | 5424 (cond |
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) |
5535 (error "Cannot link to a buffer which is not visiting a file")) | 5545 (error "Cannot link to a buffer which is not visiting a file")) |
5536 | 5546 |
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) |
5547 "Concatenate STRINGS, format resulting string with `org-link-format'." | 5557 "Concatenate STRINGS, format resulting string with `org-link-format'." |
5548 (format org-link-format (apply 'concat strings))) | 5558 (format org-link-format (apply 'concat strings))) |
5550 (defun org-xor (a b) | 5560 (defun org-xor (a b) |
5551 "Exclusive or." | 5561 "Exclusive or." |
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))) |
5576 | 5586 |
5577 | 5587 |
5602 | 5612 |
5603 With two \\[universal-argument] prefixes, enforce an absolute path even if the file | 5613 With two \\[universal-argument] prefixes, enforce an absolute path even if the file |
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 |
5652 (defun org-remember-annotation () | 5662 (defun org-remember-annotation () |
5653 "Return a link to the current location as an annotation for remember.el. | 5663 "Return a link to the current location as an annotation for remember.el. |
5659 (defconst org-remember-help | 5669 (defconst org-remember-help |
5660 "Select a destination location for the note. | 5670 "Select a destination location for the note. |
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 () |
5668 "Store stuff from remember.el into an org file. | 5678 "Store stuff from remember.el into an org file. |
5669 First prompts for an org file. If the user just presses return, the value | 5679 First prompts for an org file. If the user just presses return, the value |
5677 Key Cursor position Note gets inserted | 5687 Key Cursor position Note gets inserted |
5678 ----------------------------------------------------------------------------- | 5688 ----------------------------------------------------------------------------- |
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 |
5686 So the fastest way to store the note is to press RET RET to append it to | 5696 So the fastest way to store the note is to press RET RET to append it to |
5687 the default file. This way your current train of thought is not | 5697 the default file. This way your current train of thought is not |
5697 \(i.e. after the stars). | 5707 \(i.e. after the stars). |
5698 | 5708 |
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." |
5776 (cond | 5786 (cond |
5777 ((not org-reverse-note-order) nil) | 5787 ((not org-reverse-note-order) nil) |
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 |
5790 ;; Watch out: Here we are talking about two different kind of tables. | 5800 ;; Watch out: Here we are talking about two different kind of tables. |
5791 ;; Most of the code is for the tables created with the Org-mode table editor. | 5801 ;; Most of the code is for the tables created with the Org-mode table editor. |
5826 (interactive) | 5836 (interactive) |
5827 (require 'table) | 5837 (require 'table) |
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) |
5838 "Query for a size and insert a table skeleton. | 5848 "Query for a size and insert a table skeleton. |
5839 SIZE is a string Columns x Rows like for example \"3x2\"." | 5849 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) |
5870 "Convert region to a table. | 5880 "Convert region to a table. |
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))) |
5882 (goto-char end) | 5892 (goto-char end) |
5883 (if (bolp) (backward-char 1) (end-of-line 1)) | 5893 (if (bolp) (backward-char 1) (end-of-line 1)) |
5884 (setq end (move-marker (make-marker) (point))) | 5894 (setq end (move-marker (make-marker) (point))) |
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)) |
5899 (goto-char beg) | 5909 (goto-char beg) |
5900 (insert " ") | 5910 (insert " ") |
5906 spreadsheet and database applications. If no tabs (at least one per line) | 5916 spreadsheet and database applications. If no tabs (at least one per line) |
5907 are found, lines will be split on whitespace into fields." | 5917 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 |
5915 (defun org-table-export () | 5925 (defun org-table-export () |
5916 "Export table as a tab-separated file. | 5926 "Export table as a tab-separated file. |
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)) |
5929 (erase-buffer) | 5939 (erase-buffer) |
5930 (fundamental-mode) | 5940 (fundamental-mode) |
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 |
5951 (defvar org-table-aligned-begin-marker (make-marker) | 5961 (defvar org-table-aligned-begin-marker (make-marker) |
5952 "Marker at the beginning of the table last aligned. | 5962 "Marker at the beginning of the table last aligned. |
5965 (defvar org-last-recalc-line nil) | 5975 (defvar org-last-recalc-line nil) |
5966 | 5976 |
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) |
6019 (error "Empty table - created default table"))) | 6030 (error "Empty table - created default table"))) |
6020 ;; A list of empty string to fill any short rows on output | 6031 ;; A list of empty string to fill any short rows on output |
6028 (push (apply 'max 1 (mapcar 'length column)) lengths) | 6039 (push (apply 'max 1 (mapcar 'length column)) lengths) |
6029 ;; compute the fraction stepwise, ignoring empty fields | 6040 ;; compute the fraction stepwise, ignoring empty fields |
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)) |
6055 ;; (if l | 6066 ;; (if l |
6056 ;; (setq new (concat new (apply 'format rfmt | 6067 ;; (setq new (concat new (apply 'format rfmt |
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) |
6068 (move-marker org-table-aligned-begin-marker (point)) | 6079 (move-marker org-table-aligned-begin-marker (point)) |
6069 (insert new) | 6080 (insert new) |
6072 (goto-line linepos) | 6083 (goto-line linepos) |
6073 (set-window-start (selected-window) winstart 'noforce) | 6084 (set-window-start (selected-window) winstart 'noforce) |
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) |
6081 "Find the beginning of the table and return its position. | 6092 "Find the beginning of the table and return its position. |
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)))) |
6092 | 6103 |
6093 (defun org-table-end (&optional table-type) | 6104 (defun org-table-end (&optional table-type) |
6094 "Find the end of the table and return its position. | 6105 "Find the end of the table and return its position. |
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. |
6138 Before doing so, re-align the table if necessary." | 6158 Before doing so, re-align the table if necessary." |
6139 (interactive) | 6159 (interactive) |
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 |
6160 (defun org-table-previous-field () | 6180 (defun org-table-previous-field () |
6161 "Go to the previous field in the table. | 6181 "Go to the previous field in the table. |
6162 Before doing so, re-align the table if necessary." | 6182 Before doing so, re-align the table if necessary." |
6163 (interactive) | 6183 (interactive) |
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)) |
6171 (re-search-backward "|" (org-table-begin)) | 6191 (re-search-backward "|" (org-table-begin)) |
6172 (re-search-backward "|" (org-table-begin)) | 6192 (re-search-backward "|" (org-table-begin)) |
6180 Before doing so, re-align the table if necessary." | 6200 Before doing so, re-align the table if necessary." |
6181 (interactive) | 6201 (interactive) |
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))))) |
6200 | 6220 |
6201 (defun org-table-copy-down (n) | 6221 (defun org-table-copy-down (n) |
6207 column to be filled row-by-row. | 6227 column to be filled row-by-row. |
6208 If the variable `org-table-copy-increment' is non-nil and the field is an | 6228 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 |
6253 "Clipboard for table regions.") | 6273 "Clipboard for table regions.") |
6254 | 6274 |
6256 "Blank the current table field or active region." | 6276 "Blank the current table field or active region." |
6257 (interactive) | 6277 (interactive) |
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. |
6274 N defaults to current field. | 6294 N defaults to current field. |
6275 If REPLACE is a string, replace field with this value. The return value | 6295 If REPLACE is a string, replace field with this value. The return value |
6277 (and n (org-table-goto-column n)) | 6297 (and n (org-table-goto-column n)) |
6278 (skip-chars-backward "^|\n") | 6298 (skip-chars-backward "^|\n") |
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 () |
6290 "Find out which column we are in. | 6310 "Find out which column we are in. |
6291 When called interactively, column is also displayed in echo area." | 6311 When called interactively, column is also displayed in echo area." |
6293 (if (interactive-p) (org-table-check-inside-data-field)) | 6313 (if (interactive-p) (org-table-check-inside-data-field)) |
6294 (save-excursion | 6314 (save-excursion |
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 |
6302 (defun org-table-goto-column (n &optional on-delim force) | 6322 (defun org-table-goto-column (n &optional on-delim force) |
6303 "Move the cursor to the Nth column in the current table line. | 6323 "Move the cursor to the Nth column in the current table line. |
6307 However, when FORCE is non-nil, create new columns if necessary." | 6327 However, when FORCE is non-nil, create new columns if necessary." |
6308 (let ((pos (point-at-eol))) | 6328 (let ((pos (point-at-eol))) |
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 () |
6378 "Insert a new column into the table." | 6398 "Insert a new column into the table." |
6379 (interactive) | 6399 (interactive) |
6380 (if (not (org-at-table-p)) | 6400 (if (not (org-at-table-p)) |
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) |
6398 (org-table-goto-column colpos) | 6418 (org-table-goto-column colpos) |
6399 (org-table-align) | 6419 (org-table-align) |
6400 (org-table-modify-formulas 'insert col))) | 6420 (org-table-modify-formulas 'insert col))) |
6401 | 6421 |
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." |
6423 (interactive) | 6443 (interactive) |
6424 (if (not (org-at-table-p)) | 6444 (if (not (org-at-table-p)) |
6425 (error "Not at a table")) | 6445 (error "Not at a table")) |
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) |
6444 (org-table-goto-column colpos) | 6464 (org-table-goto-column colpos) |
6445 (org-table-align) | 6465 (org-table-align) |
6460 (if (not (org-at-table-p)) | 6480 (if (not (org-at-table-p)) |
6461 (error "Not at a table")) | 6481 (error "Not at a table")) |
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) |
6485 (org-table-goto-column colpos) | 6505 (org-table-goto-column colpos) |
6486 (org-table-align) | 6506 (org-table-align) |
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 |
6498 (defun org-table-move-row (&optional up) | 6518 (defun org-table-move-row (&optional up) |
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)) |
6513 (setq txt (buffer-substring (point) (1+ (point-at-eol)))) | 6533 (setq txt (buffer-substring (point) (1+ (point-at-eol)))) |
6514 (delete-region (point) (1+ (point-at-eol))) | 6534 (delete-region (point) (1+ (point-at-eol))) |
6522 With prefix ARG, insert below the current line." | 6542 With prefix ARG, insert below the current line." |
6523 (interactive "P") | 6543 (interactive "P") |
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) |
6538 (insert-before-markers "\n")) | 6558 (insert-before-markers "\n")) |
6539 (beginning-of-line 0) | 6559 (beginning-of-line 0) |
6545 With prefix ARG, insert above the current line." | 6565 With prefix ARG, insert above the current line." |
6546 (interactive "P") | 6566 (interactive "P") |
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))) |
6570 | 6590 |
6571 (defun org-table-kill-row () | 6591 (defun org-table-kill-row () |
6585 (org-table-copy-region beg end 'cut)) | 6605 (org-table-copy-region beg end 'cut)) |
6586 | 6606 |
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)) |
6620 | 6640 |
6621 (defun org-table-paste-rectangle () | 6641 (defun org-table-paste-rectangle () |
6627 (interactive) | 6647 (interactive) |
6628 (unless (and org-table-clip (listp org-table-clip)) | 6648 (unless (and org-table-clip (listp org-table-clip)) |
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) |
6649 (org-table-align))) | 6669 (org-table-align))) |
6650 | 6670 |
6660 (interactive) | 6680 (interactive) |
6661 (require 'table) | 6681 (require 'table) |
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. |
6697 This is useful if you'd like to spread the contents of a field over several | 6717 This is useful if you'd like to spread the contents of a field over several |
6698 lines, in order to keep the table compact. | 6718 lines, in order to keep the table compact. |
6717 (interactive "P") | 6737 (interactive "P") |
6718 (org-table-check-inside-data-field) | 6738 (org-table-check-inside-data-field) |
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." |
6759 (if (string-match "^[ \t]+" s) (setq s (replace-match "" t t s))) | 6779 (if (string-match "^[ \t]+" s) (setq s (replace-match "" t t s))) |
6760 (if (string-match "[ \t]+$" s) (setq s (replace-match "" t t s))) | 6780 (if (string-match "[ \t]+$" s) (setq s (replace-match "" t t s))) |
6767 wrapped to the length of that word. | 6787 wrapped to the length of that word. |
6768 IF WIDTH is nil and LINES is non-nil, the string is forced into at most that | 6788 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) |
6790 "Create lines of maximum width WIDTH (in characters) from word list WORDS." | 6810 "Create lines of maximum width WIDTH (in characters) from word list WORDS." |
6791 (let (lines line) | 6811 (let (lines line) |
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 |
6799 ;; FIXME: I think I can make this more efficient | 6819 ;; FIXME: I think I can make this more efficient |
6800 (defun org-split-string (string &optional separators) | 6820 (defun org-split-string (string &optional separators) |
6827 | 6847 |
6828 (defun org-table-add-invisible-to-vertical-lines () | 6848 (defun org-table-add-invisible-to-vertical-lines () |
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")) |
6869 (redraw-frame (selected-frame)))) | 6889 (redraw-frame (selected-frame)))) |
6870 | 6890 |
6873 (save-excursion | 6893 (save-excursion |
6874 (save-restriction | 6894 (save-restriction |
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. |
6886 The result will be displayed in the echo area, and will be available | 6906 The result will be displayed in the echo area, and will be available |
6887 as kill to be inserted with \\[yank]. | 6907 as kill to be inserted with \\[yank]. |
6900 (save-excursion | 6920 (save-excursion |
6901 (let (col (timecnt 0) diff h m s org-table-clip) | 6921 (let (col (timecnt 0) diff h m s org-table-clip) |
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 |
6963 (defvar org-table-formula-history nil) | 6983 (defvar org-table-formula-history nil) |
6964 | 6984 |
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) |
6990 "Store the list of formulas below the current table." | 7011 "Store the list of formulas below the current table." |
6991 (setq alist (sort alist (lambda (a b) (< (car a) (car b))))) | 7012 (setq alist (sort alist (lambda (a b) (< (car a) (car b))))) |
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) |
7018 "Modify the formulas stored below the current table. | 7039 "Modify the formulas stored below the current table. |
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) |
7028 (setq col (car columns)) | 7049 (setq col (car columns)) |
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") |
7042 (org-table-replace-in-formulas list col2 col1) | 7063 (org-table-replace-in-formulas list col2 col1) |
7043 (org-table-replace-in-formulas list "Z" col2) | 7064 (org-table-replace-in-formulas list "Z" col2) |
7048 (if list (org-table-store-formulas list)))) | 7069 (if list (org-table-store-formulas list)))) |
7049 | 7070 |
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 |
7062 "Alist with column names, derived from the `!' line.") | 7083 "Alist with column names, derived from the `!' line.") |
7063 (defvar org-table-column-name-regexp nil | 7084 (defvar org-table-column-name-regexp nil |
7064 "Regular expression matching the current column names.") | 7085 "Regular expression matching the current column names.") |
7065 (defvar org-table-local-parameters nil | 7086 (defvar org-table-local-parameters nil |
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 () |
7102 "Check if the current field starts with \"=\" and evaluate the formula." | 7136 "Check if the current field starts with \"=\" and evaluate the formula." |
7103 ;; We already know we are in a table. Get field will only return a formula | 7137 ;; We already know we are in a table. Get field will only return a formula |
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 |
7139 "FIXME:" | 7173 "FIXME:" |
7140 :group 'org-table | 7174 :group 'org-table |
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 |
7148 '((" " . "Unmarked: no special line, no automatic recalculation") | 7182 '((" " . "Unmarked: no special line, no automatic recalculation") |
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. |
7156 If in any row, the first field is not consistent with a mark, | 7192 If in any row, the first field is not consistent with a mark, |
7157 insert a new column for the makers. | 7193 insert a new column for the makers. |
7160 After each change, a message will be displayed indication the meaning | 7196 After each change, a message will be displayed indication the meaning |
7161 of the new mark." | 7197 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) |
7190 (org-table-goto-column (1+ col))) | 7226 (org-table-goto-column (1+ col))) |
7191 (setq epos (point-at-eol)) | 7227 (setq epos (point-at-eol)) |
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)))))) |
7211 | 7247 |
7212 (defun org-table-maybe-recalculate-line () | 7248 (defun org-table-maybe-recalculate-line () |
7213 "Recompute the current line if marked for it, and if we haven't just done it." | 7249 "Recompute the current line if marked for it, and if we haven't just done it." |
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 |
7223 (defvar org-table-formula-debug nil | 7259 (defvar org-table-formula-debug nil |
7224 "Non-nil means, debug table formulas. | 7260 "Non-nil means, debug table formulas. |
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 |
7237 most exciting program ever written for GNU Emacs. So you need to have calc | 7282 most exciting program ever written for GNU Emacs. So you need to have calc |
7238 installed in order to use this function. | 7283 installed in order to use this function. |
7261 A few examples for formulas: | 7306 A few examples for formulas: |
7262 $1+$2 Sum of first and second field | 7307 $1+$2 Sum of first and second field |
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 |
7270 horizontal line or the end of the table. When the command is called with a | 7315 horizontal line or the end of the table. When the command is called with a |
7271 numeric prefix argument (like M-3 or C-7 or \\[universal-argument] 24), the formula is applied | 7316 numeric prefix argument (like M-3 or C-7 or \\[universal-argument] 24), the formula is applied |
7283 (setq ndown (if (equal ndown '(4)) 10000 (prefix-numeric-value ndown))) | 7328 (setq ndown (if (equal ndown '(4)) 10000 (prefix-numeric-value ndown))) |
7284 (require 'calc) | 7329 (require 'calc) |
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." |
7379 (interactive "P") | 7421 (interactive "P") |
7380 (or (memq this-command org-recalc-commands) | 7422 (or (memq this-command org-recalc-commands) |
7381 (setq org-recalc-commands (cons this-command org-recalc-commands))) | 7423 (setq org-recalc-commands (cons this-command org-recalc-commands))) |
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)) |
7433 (setq start (1+ start)) | 7475 (setq start (1+ start)) |
7434 (setq a (assoc (match-string 1 f) org-table-column-names)) | 7476 (setq a (assoc (match-string 1 f) org-table-column-names)) |
7435 (setq f (replace-match (concat "$" (cdr a)) t t f))) | 7477 (setq f (replace-match (concat "$" (cdr a)) t t f))) |
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))) |
7447 ;; Parameters and constants | 7489 ;; Parameters and constants |
7448 (setq start 0) | 7490 (setq start 0) |
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) |
7459 "Find the value for a parameter or constant in a formula. | 7501 "Find the value for a parameter or constant in a formula. |
7460 Parameters get priority." | 7502 Parameters get priority." |
7525 (if (eq major-mode 'org-mode) | 7567 (if (eq major-mode 'org-mode) |
7526 ;; Exit without error, in case some hook functions calls this | 7568 ;; Exit without error, in case some hook functions calls this |
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) |
7553 (force-mode-line-update 'all)))) | 7595 (force-mode-line-update 'all)))) |
7554 | 7596 |
7557 (put 'orgtbl-mode :menu-tag "Org Table Mode") | 7599 (put 'orgtbl-mode :menu-tag "Org Table Mode") |
7558 (add-minor-mode 'orgtbl-mode " OrgTbl" orgtbl-mode-map) | 7600 (add-minor-mode 'orgtbl-mode " OrgTbl" orgtbl-mode-map) |
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)] |
7629 (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m")) | 7671 (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m")) |
7630 (define-key orgtbl-mode-map "\C-m" | 7672 (define-key orgtbl-mode-map "\C-m" |
7635 (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)]))) | 7677 (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)]))) |
7636 (when orgtbl-optimized | 7678 (when orgtbl-optimized |
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 () |
7690 "Justification and field motion for `orgtbl-mode'." | 7732 "Justification and field motion for `orgtbl-mode'." |
7691 (interactive) | 7733 (interactive) |
7702 "Like `self-insert-command', use overwrite-mode for whitespace in tables. | 7744 "Like `self-insert-command', use overwrite-mode for whitespace in tables. |
7703 If the cursor is in a table looking at whitespace, the whitespace is | 7745 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)))))) |
7717 | 7759 |
7718 (defun orgtbl-delete-backward-char (N) | 7760 (defun orgtbl-delete-backward-char (N) |
7721 front of the next \"|\" separator, to keep the table aligned. The table will | 7763 front of the next \"|\" separator, to keep the table aligned. The table will |
7722 still be marked for re-alignment, because a narrow field may lead to a | 7764 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) |
7737 "Like `delete-char', but insert whitespace at field end in tables. | 7779 "Like `delete-char', but insert whitespace at field end in tables. |
7738 When deleting characters, in tables this function will insert whitespace in | 7780 When deleting characters, in tables this function will insert whitespace in |
7739 front of the next \"|\" separator, to keep the table aligned. The table | 7781 front of the next \"|\" separator, to keep the table aligned. The table |
7740 will still be marked for re-alignment, because a narrow field may lead to | 7782 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 |
7756 | 7798 |
7757 (defconst org-level-max 20) | 7799 (defconst org-level-max 20) |
7758 | 7800 |
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 |
7788 ;; ASCII | 7830 ;; ASCII |
7789 | 7831 |
8096 The prefix ARG specifies how many levels of the outline should become | 8138 The prefix ARG specifies how many levels of the outline should become |
8097 underlined headlines. The default is 3." | 8139 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) |
8127 | 8169 |
8128 (find-file-noselect filename) | 8170 (find-file-noselect filename) |
8129 | 8171 |
8130 ;; Search for the export key lines | 8172 ;; Search for the export key lines |
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)) |
8138 (erase-buffer) | 8180 (erase-buffer) |
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 )))) |
8188 lines))) | 8230 lines))) |
8189 | 8231 |
8191 (while (setq line (pop lines)) | 8233 (while (setq line (pop lines)) |
8192 ;; Remove the quoted HTML tags. | 8234 ;; Remove the quoted HTML tags. |
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) |
8203 (goto-char (point-min)))) | 8245 (goto-char (point-min)))) |
8204 | 8246 |
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? |
8224 (defun org-html-expand-for-ascii (line) | 8266 (defun org-html-expand-for-ascii (line) |
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) |
8233 "Insert the string S centered and underline it with character UNDERLINE." | 8275 "Insert the string S centered and underline it with character UNDERLINE." |
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 () |
8255 "Copy the visible part of the buffer to another buffer, for printing. | 8297 "Copy the visible part of the buffer to another buffer, for printing. |
8256 Also removes the first line of the buffer if it specifies a mode, | 8298 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)))) |
8286 | 8328 |
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 |
8304 ;; HTML | 8346 ;; HTML |
8305 | 8347 |
8336 "TODO FEEDBACK VERIFY DONE") | 8378 "TODO FEEDBACK VERIFY DONE") |
8337 (if (equal org-todo-interpretation 'type) | 8379 (if (equal org-todo-interpretation 'type) |
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 )) |
8345 | 8387 |
8346 (defun org-insert-export-options-template () | 8388 (defun org-insert-export-options-template () |
8347 "Insert into the buffer a template with information for exporting." | 8389 "Insert into the buffer a template with information for exporting." |
8348 (interactive) | 8390 (interactive) |
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) |
8356 "Toggle the fixed-width indicator at the beginning of lines in the region. | 8398 "Toggle the fixed-width indicator at the beginning of lines in the region. |
8357 If there is no active region, only acts on the current line. | 8399 If there is no active region, only acts on the current line. |
8361 bar to all lines, in the column given by the beginning of the region. | 8403 bar to all lines, in the column given by the beginning of the region. |
8362 | 8404 |
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. |
8392 If there is an active region, export only the region. | 8434 If there is an active region, export only the region. |
8393 The prefix ARG specifies how many levels of the outline should become | 8435 The prefix ARG specifies how many levels of the outline should become |
8412 (interactive "P") | 8454 (interactive "P") |
8413 (setq-default org-todo-line-regexp org-todo-line-regexp) | 8455 (setq-default org-todo-line-regexp org-todo-line-regexp) |
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 |
8446 (setq org-last-level 1) | 8488 (setq org-last-level 1) |
8447 (org-init-section-numbers) | 8489 (org-init-section-numbers) |
8448 | 8490 |
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\"> |
8471 <meta name=generated content=\"%s %s\"> | 8513 <meta name=generated content=\"%s %s\"> |
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) |
8654 (goto-char (point-min))))) | 8696 (goto-char (point-min))))) |
8655 | 8697 |
8658 (if (string-match "^[ \t]*|" (car lines)) | 8700 (if (string-match "^[ \t]*|" (car lines)) |
8659 ;; A normal org table | 8701 ;; A normal org table |
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 |
8713 (defun org-fake-empty-table-line (line) | 8755 (defun org-fake-empty-table-line (line) |
8714 "Replace everything except \"|\" with spaces." | 8756 "Replace everything except \"|\" with spaces." |
8719 (if (not (eq (aref newstr i) ?|)) | 8761 (if (not (eq (aref newstr i) ?|)) |
8720 (aset newstr i ?\ ))) | 8762 (aset newstr i ?\ ))) |
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) |
8772 (with-current-buffer (get-buffer-create " org-tmp1 ") | 8814 (with-current-buffer (get-buffer-create " org-tmp1 ") |
8773 (erase-buffer) | 8815 (erase-buffer) |
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 ") |
8781 (set-buffer " org-tmp2 ") | 8823 (set-buffer " org-tmp2 ") |
8782 (buffer-substring (point-min) (point-max)))) | 8824 (buffer-substring (point-min) (point-max)))) |
8784 (defun org-html-expand (string) | 8826 (defun org-html-expand (string) |
8785 "Prepare STRING for HTML export. Applies all active conversions." | 8827 "Prepare STRING for HTML export. Applies all active conversions." |
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) |
8815 "Create a regular expression which will match a balanced sexp. | 8857 "Create a regular expression which will match a balanced sexp. |
8816 Opening delimiter is LEFT, and closing delimiter is RIGHT, both given | 8858 Opening delimiter is LEFT, and closing delimiter is RIGHT, both given |
8818 The regexp returned will match the entire expression including the | 8860 The regexp returned will match the entire expression including the |
8819 delimiters. It will also define a single group which contains the | 8861 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 |
8833 (concat | 8875 (concat |
8834 "\\([^\\]\\)\\([_^]\\)\\(" | 8876 "\\([^\\]\\)\\([_^]\\)\\(" |
8843 "Convert sub- and superscripts in STRING to HTML." | 8885 "Convert sub- and superscripts in STRING to HTML." |
8844 (let (key c) | 8886 (let (key c) |
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 () |
8880 "Find the special key lines with the information for exporters." | 8922 "Find the special key lines with the information for exporters." |
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" |
8940 level head-count title level)) | 8982 level head-count title level)) |
8941 (insert (format "\n<H%d>%s</H%d>\n" level title level)))))) | 8983 (insert (format "\n<H%d>%s</H%d>\n" level title level)))))) |
8949 (defvar org-section-numbers (make-vector org-level-max 0)) | 8991 (defvar org-section-numbers (make-vector org-level-max 0)) |
8950 | 8992 |
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) |
8969 "Return a string with the current section number. | 9011 "Return a string with the current section number. |
8970 When LEVEL is non-nil, increase section numbers on that level." | 9012 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 |
8995 ;;; Key bindings | 9037 ;;; Key bindings |
8996 | 9038 |
9080 "Like `self-insert-command', use overwrite-mode for whitespace in tables. | 9122 "Like `self-insert-command', use overwrite-mode for whitespace in tables. |
9081 If the cursor is in a table looking at whitespace, the whitespace is | 9123 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 |
9095 ;; FIXME: | 9137 ;; FIXME: |
9096 ;; The following two functions might still be optimized to trigger | 9138 ;; The following two functions might still be optimized to trigger |
9102 front of the next \"|\" separator, to keep the table aligned. The table will | 9144 front of the next \"|\" separator, to keep the table aligned. The table will |
9103 still be marked for re-alignment, because a narrow field may lead to a | 9145 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) |
9118 "Like `delete-char', but insert whitespace at field end in tables. | 9160 "Like `delete-char', but insert whitespace at field end in tables. |
9119 When deleting characters, in tables this function will insert whitespace in | 9161 When deleting characters, in tables this function will insert whitespace in |
9120 front of the next \"|\" separator, to keep the table aligned. The table | 9162 front of the next \"|\" separator, to keep the table aligned. The table |
9121 will still be marked for re-alignment, because a narrow field may lead to | 9163 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 |
9137 ;; If equal to column width, we should realign. | 9179 ;; If equal to column width, we should realign. |
9138 | 9180 |
9139 (when (eq org-enable-table-editor 'optimized) | 9181 (when (eq org-enable-table-editor 'optimized) |
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 () |
9151 "Throw an error because Shift-Cursor command was applied in wrong context." | 9193 "Throw an error because Shift-Cursor command was applied in wrong context." |
9152 (error "This command is only active in tables and on headlines")) | 9194 (error "This command is only active in tables and on headlines")) |
9271 (re-search-forward "|" (save-excursion (end-of-line 2) (point))) | 9313 (re-search-forward "|" (save-excursion (end-of-line 2) (point))) |
9272 (table-recognize-table)) | 9314 (table-recognize-table)) |
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 () |
9298 "Call `org-table-next-row' or `newline'." | 9340 "Call `org-table-next-row' or `newline'." |
9299 (interactive) | 9341 (interactive) |
9357 "--" | 9399 "--" |
9358 ["Invisible Vlines" org-table-toggle-vline-visibility | 9400 ["Invisible Vlines" org-table-toggle-vline-visibility |
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)] |
9366 "--" | 9408 "--" |
9367 ["Create/Convert from/to table.el" org-table-create-with-table.el t])) | 9409 ["Create/Convert from/to table.el" org-table-create-with-table.el t])) |
9469 (mapcar 'org-file-menu-entry org-agenda-files)))) | 9511 (mapcar 'org-file-menu-entry org-agenda-files)))) |
9470 | 9512 |
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 |
9478 (defun org-create-customize-menu () | 9520 (defun org-create-customize-menu () |
9479 "Create a full customization menu for Org-mode, insert it into the menu." | 9521 "Create a full customization menu for Org-mode, insert it into the menu." |
9527 "Is `transient-mark-mode' on and the region active? | 9569 "Is `transient-mark-mode' on and the region active? |
9528 Works on both Emacs and XEmacs." | 9570 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) |
9536 "Add elements to `buffer-invisibility-spec'. | 9578 "Add elements to `buffer-invisibility-spec'. |
9537 See documentation for `buffer-invisibility-spec' for the kind of elements | 9579 See documentation for `buffer-invisibility-spec' for the kind of elements |
9548 (defun org-remove-from-invisibility-spec (arg) | 9590 (defun org-remove-from-invisibility-spec (arg) |
9549 "Remove elements from `buffer-invisibility-spec'." | 9591 "Remove elements from `buffer-invisibility-spec'." |
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'?." |
9558 (if (consp buffer-invisibility-spec) | 9600 (if (consp buffer-invisibility-spec) |
9559 (member arg buffer-invisibility-spec) | 9601 (member arg buffer-invisibility-spec) |
9562 (defun org-image-file-name-regexp () | 9604 (defun org-image-file-name-regexp () |
9563 "Return regexp matching the file names of images." | 9605 "Return regexp matching the file names of images." |
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 |
9578 ;; The following functions capture almost the entire compatibility code | 9620 ;; The following functions capture almost the entire compatibility code |
9579 ;; between the different versions of outline-mode. The only other place | 9621 ;; between the different versions of outline-mode. The only other place |
9589 (beginning-of-line 1) | 9631 (beginning-of-line 1) |
9590 (if (bobp) | 9632 (if (bobp) |
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)) |
9600 | 9642 |
9601 (defun org-invisible-p () | 9643 (defun org-invisible-p () |
9602 "Check if point is at a character currently not visible." | 9644 "Check if point is at a character currently not visible." |
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. |
9629 If INVISIBLE-OK is non-nil, an invisible heading line is ok too." | 9671 If INVISIBLE-OK is non-nil, an invisible heading line is ok too." |
9630 (if org-noutline-p | 9672 (if org-noutline-p |
9631 (outline-on-heading-p 'invisible-ok) | 9673 (outline-on-heading-p 'invisible-ok) |
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. |
9641 This function considers both visible and invisible heading lines. | 9683 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) |
9668 "If REGEXP starts with \"^\", modify it to check for \\r as well. | 9710 "If REGEXP starts with \"^\", modify it to check for \\r as well. |
9669 Of course, only for the old outline mode." | 9711 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) |
9677 "Flag the current heading. FLAG non-nil means make invisible. | 9719 "Flag the current heading. FLAG non-nil means make invisible. |
9678 When ENTRY is non-nil, show the entire entry." | 9720 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." |
9700 (outline-flag-region | 9742 (outline-flag-region |
9701 (point) | 9743 (point) |
9730 ;; Wrapped into eval-after-load to avoid loading advice unnecessarily | 9772 ;; Wrapped into eval-after-load to avoid loading advice unnecessarily |
9731 (eval-after-load "bookmark" | 9773 (eval-after-load "bookmark" |
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 |
9740 (provide 'org) | 9782 (provide 'org) |
9741 | 9783 |