aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorCarsten Dominik2007-07-10 07:24:08 +0000
committerCarsten Dominik2007-07-10 07:24:08 +0000
commit7d58338ef2bdcaaf3ff94f7472d01a49c65a232d (patch)
treef59609996d67c4128e62a71f11349571168672e3
parentf3850a5f263bb4c661683951d435f3fadba7643e (diff)
downloademacs-7d58338ef2bdcaaf3ff94f7472d01a49c65a232d.tar.gz
emacs-7d58338ef2bdcaaf3ff94f7472d01a49c65a232d.zip
* org.el (org-agenda-day-view, org-agenda-week-view): Remember
span as default. (org-columns-edit-value): Renamed from `org-column-edit'. (org-columns-display-here-title): Renamed from `org-overlay-columns-title'. (org-columns-remove-overlays): ` Renamed from org-remove-column-overlays'. (org-columns-get-autowidth-alist): ` Renamed from org-get-columns-autowidth-alist'. (org-columns-display-here): Renamed from `org-overlay-columns'. (org-columns-new-overlay): Renamed from `org-new-column-overlay'. (org-columns-quit): Renamed from `org-column-quit'. (org-columns-show-value): Renamed from `org-column-show-value'. (org-columns-content, org-columns-widen) (org-columns-next-allowed-value) (org-columns-edit-allowed, org-columns-store-format) (org-columns-uncompile-format, org-columns-redo) (org-columns-edit-attributes, org-delete-property) (org-set-property, org-columns-update) (org-columns-compute, org-columns-eval) (org-columns-not-in-agenda, org-columns-compute-all) (org-property-next-allowed-value) (org-columns-compile-format) (org-fill-paragraph-experimental) (org-string-to-number, org-property-action) (org-columns-move-left, org-columns-new ) (org-column-number-to-string) (org-property-previous-allowed-value) (org-at-property-p, org-columns-delete) (org-columns-previous-allowed-value) (org-columns-move-right, org-columns-narrow) (org-property-get-allowed-values) (org-verify-version, org-column-string-to-number) (org-delete-property-globally): New functions. (org-columns-current-fmt): Renamed from `org-current-columns-fmt'. (org-columns-overlays): Renamed from `org-column-overlays'. (org-columns-map): Renamed from `org-column-map'. (org-columns-current-maxwidths): Renamed from `org-current-columns-maxwidths'. (org-columns-begin-marker, org-columns-current-fmt-compiled) (org-previous-header-line-format) (org-columns-inhibit-recalculation) (org-columns-top-level-marker): New variables. (org-columns-default-format): Renamed from `org-default-columns-format'. (org-property-re): New constant.
-rw-r--r--lisp/textmodes/org.el1117
-rw-r--r--man/ChangeLog4
2 files changed, 870 insertions, 251 deletions
diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el
index 244f9bb0bce..0a7bfc7db0c 100644
--- a/lisp/textmodes/org.el
+++ b/lisp/textmodes/org.el
@@ -5,7 +5,7 @@
5;; Author: Carsten Dominik <dominik at science dot uva dot nl> 5;; Author: Carsten Dominik <dominik at science dot uva dot nl>
6;; Keywords: outlines, hypermedia, calendar, wp 6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ 7;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
8;; Version: 5.01 8;; Version: 5.02
9;; 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11;; 11;;
@@ -83,7 +83,7 @@
83 83
84;;; Version 84;;; Version
85 85
86(defconst org-version "5.01" 86(defconst org-version "5.02"
87 "The version number of the file org.el.") 87 "The version number of the file org.el.")
88(defun org-version () 88(defun org-version ()
89 (interactive) 89 (interactive)
@@ -1763,7 +1763,7 @@ lined-up with respect to each other."
1763 :group 'org-properties 1763 :group 'org-properties
1764 :type 'string) 1764 :type 'string)
1765 1765
1766(defcustom org-default-columns-format "%25ITEM %TODO %3PRIORITY %TAGS" 1766(defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS"
1767 "The default column format, if no other format has been defined. 1767 "The default column format, if no other format has been defined.
1768This variable can be set on the per-file basis by inserting a line 1768This variable can be set on the per-file basis by inserting a line
1769 1769
@@ -3244,6 +3244,12 @@ color of the frame."
3244 "Face for column display of entry properties." 3244 "Face for column display of entry properties."
3245 :group 'org-faces) 3245 :group 'org-faces)
3246 3246
3247(when (fboundp 'set-face-attribute)
3248 ;; Make sure that a fixed-width face is used when we have a column table.
3249 (set-face-attribute 'org-column nil
3250 :height (face-attribute 'default :height)
3251 :family (face-attribute 'default :family)))
3252
3247(defface org-warning ;; font-lock-warning-face 3253(defface org-warning ;; font-lock-warning-face
3248 (org-compatible-face 3254 (org-compatible-face
3249 '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) 3255 '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t))
@@ -3573,7 +3579,7 @@ means to push this value onto the list in the variable.")
3573 ((equal key "TAGS") 3579 ((equal key "TAGS")
3574 (setq tags (append tags (org-split-string value splitre)))) 3580 (setq tags (append tags (org-split-string value splitre))))
3575 ((equal key "COLUMNS") 3581 ((equal key "COLUMNS")
3576 (org-set-local 'org-default-columns-format value)) 3582 (org-set-local 'org-columns-default-format value))
3577 ((equal key "LINK") 3583 ((equal key "LINK")
3578 (when (string-match "^\\(\\S-+\\)[ \t]+\\(.+\\)" value) 3584 (when (string-match "^\\(\\S-+\\)[ \t]+\\(.+\\)" value)
3579 (push (cons (match-string 1 value) 3585 (push (cons (match-string 1 value)
@@ -3678,15 +3684,15 @@ means to push this value onto the list in the variable.")
3678 (mapconcat 'regexp-quote org-not-done-keywords "\\|") 3684 (mapconcat 'regexp-quote org-not-done-keywords "\\|")
3679 "\\)\\>") 3685 "\\)\\>")
3680 org-todo-line-regexp 3686 org-todo-line-regexp
3681 (concat "^\\(\\*+\\)[ \t]*\\(?:\\(" 3687 (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
3682 (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") 3688 (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
3683 "\\)\\>\\)? *\\(.*\\)") 3689 "\\)\\>\\)? *\\(.*\\)")
3684 org-nl-done-regexp 3690 org-nl-done-regexp
3685 (concat "[\r\n]\\*+[ \t]+" 3691 (concat "\n\\*+[ \t]+"
3686 "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|") 3692 "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|")
3687 "\\)" "\\>") 3693 "\\)" "\\>")
3688 org-todo-line-tags-regexp 3694 org-todo-line-tags-regexp
3689 (concat "^\\(\\*+\\)[ \t]*\\(?:\\(" 3695 (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
3690 (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") 3696 (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
3691 (org-re 3697 (org-re
3692 "\\)\\>\\)? *\\(.*?\\([ \t]:[[:alnum:]:_@]+:[ \t]*\\)?$\\)")) 3698 "\\)\\>\\)? *\\(.*?\\([ \t]:[[:alnum:]:_@]+:[ \t]*\\)?$\\)"))
@@ -3982,7 +3988,7 @@ The following commands are available:
3982 (org-add-to-invisibility-spec '(org-cwidth)) 3988 (org-add-to-invisibility-spec '(org-cwidth))
3983 (when (featurep 'xemacs) 3989 (when (featurep 'xemacs)
3984 (org-set-local 'line-move-ignore-invisible t)) 3990 (org-set-local 'line-move-ignore-invisible t))
3985 (setq outline-regexp "\\*+") 3991 (setq outline-regexp "\\*+ ")
3986 (setq outline-level 'org-outline-level) 3992 (setq outline-level 'org-outline-level)
3987 (when (and org-ellipsis (stringp org-ellipsis) 3993 (when (and org-ellipsis (stringp org-ellipsis)
3988 (fboundp 'set-display-table-slot) (boundp 'buffer-display-table)) 3994 (fboundp 'set-display-table-slot) (boundp 'buffer-display-table))
@@ -4412,17 +4418,20 @@ between words."
4412 (looking-at outline-regexp) 4418 (looking-at outline-regexp)
4413 (if (match-beginning 1) 4419 (if (match-beginning 1)
4414 (+ (org-get-string-indentation (match-string 1)) 1000) 4420 (+ (org-get-string-indentation (match-string 1)) 1000)
4415 (- (match-end 0) (match-beginning 0))))) 4421 (1- (- (match-end 0) (match-beginning 0))))))
4416 4422
4417(defvar org-font-lock-keywords nil) 4423(defvar org-font-lock-keywords nil)
4418 4424
4425(defconst org-property-re "^[ \t]*\\(:\\([a-zA-Z_0-9]+\\):\\)[ \t]*\\(\\S-.*\\)"
4426 "Regular expression matching a property line.")
4427
4419(defun org-set-font-lock-defaults () 4428(defun org-set-font-lock-defaults ()
4420 (let* ((em org-fontify-emphasized-text) 4429 (let* ((em org-fontify-emphasized-text)
4421 (lk org-activate-links) 4430 (lk org-activate-links)
4422 (org-font-lock-extra-keywords 4431 (org-font-lock-extra-keywords
4423 ;; Headlines 4432 ;; Headlines
4424 (list 4433 (list
4425 '("^\\(\\**\\)\\(\\*\\)\\(.*\\)" (1 (org-get-level-face 1)) 4434 '("^\\(\\**\\)\\(\\* \\)\\(.*\\)" (1 (org-get-level-face 1))
4426 (2 (org-get-level-face 2)) (3 (org-get-level-face 3))) 4435 (2 (org-get-level-face 2)) (3 (org-get-level-face 3)))
4427 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" 4436 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
4428 (1 'org-table)) 4437 (1 'org-table))
@@ -4436,7 +4445,7 @@ between words."
4436 '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t)) 4445 '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
4437 '(org-hide-wide-columns (0 nil append)) 4446 '(org-hide-wide-columns (0 nil append))
4438 ;; TODO lines 4447 ;; TODO lines
4439 (list (concat "^\\*+[ \t]*" org-not-done-regexp) 4448 (list (concat "^\\*+[ \t]+" org-not-done-regexp)
4440 '(1 'org-todo t)) 4449 '(1 'org-todo t))
4441 ;; Priorities 4450 ;; Priorities
4442 (list (concat "\\[#[A-Z0-9]\\]") '(0 'org-special-keyword t)) 4451 (list (concat "\\[#[A-Z0-9]\\]") '(0 'org-special-keyword t))
@@ -4458,7 +4467,7 @@ between words."
4458 '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" 4467 '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
4459 (0 (org-get-checkbox-statistics-face) t))) 4468 (0 (org-get-checkbox-statistics-face) t)))
4460 ;; COMMENT 4469 ;; COMMENT
4461 (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string 4470 (list (concat "^\\*+[ \t]+\\<\\(" org-comment-string
4462 "\\|" org-quote-string "\\)\\>") 4471 "\\|" org-quote-string "\\)\\>")
4463 '(1 'org-special-keyword t)) 4472 '(1 'org-special-keyword t))
4464 '("^#.*" (0 'font-lock-comment-face t)) 4473 '("^#.*" (0 'font-lock-comment-face t))
@@ -4475,14 +4484,18 @@ between words."
4475 ;; Table stuff 4484 ;; Table stuff
4476 '("^[ \t]*\\(:.*\\)" (1 'org-table t)) 4485 '("^[ \t]*\\(:.*\\)" (1 'org-table t))
4477 '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t)) 4486 '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t))
4478 '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t)) 4487; '("^[ \t]*| *\\([#!$*_^/]\\) *|" (1 'org-formula t))
4488 '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t))
4489 '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t))
4479 ;; Drawers 4490 ;; Drawers
4480 (list org-drawer-regexp '(0 'org-drawer t)) 4491; (list org-drawer-regexp '(0 'org-drawer t))
4481 (list "^[ \t]*:END:" '(0 'org-drawer t)) 4492; (list "^[ \t]*:END:" '(0 'org-drawer t))
4493 (list org-drawer-regexp '(0 'org-special-keyword t))
4494 (list "^[ \t]*:END:" '(0 'org-special-keyword t))
4482 ;; Properties 4495 ;; Properties
4483 '("^[ \t]*\\(:[a-zA-Z0-9]+:\\)[ \t]*\\(\\S-.*\\)" 4496 (list org-property-re
4484 (1 'org-special-keyword t) (2 'org-property-value t)) 4497 '(1 'org-special-keyword t)
4485;FIXME (1 'org-tag t) (2 'org-property-value t)) 4498 '(3 'org-property-value t))
4486 (if org-format-transports-properties-p 4499 (if org-format-transports-properties-p
4487 '("| *\\(<[0-9]+>\\) *" (1 'org-formula t))) 4500 '("| *\\(<[0-9]+>\\) *" (1 'org-formula t)))
4488 '("^\\*+ \\(.*:ARCHIVE:.*\\)" (1 'org-archived prepend)) 4501 '("^\\*+ \\(.*:ARCHIVE:.*\\)" (1 'org-archived prepend))
@@ -4499,7 +4512,7 @@ between words."
4499(defvar org-f nil) 4512(defvar org-f nil)
4500(defun org-get-level-face (n) 4513(defun org-get-level-face (n)
4501 "Get the right face for match N in font-lock matching of healdines." 4514 "Get the right face for match N in font-lock matching of healdines."
4502 (setq org-l (- (match-end 2) (match-beginning 1))) 4515 (setq org-l (- (match-end 2) (match-beginning 1) 1))
4503 (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) 4516 (if org-odd-levels-only (setq org-l (1+ (/ org-l 2))))
4504 (setq org-f (nth (% (1- org-l) org-n-levels) org-level-faces)) 4517 (setq org-f (nth (% (1- org-l) org-n-levels) org-level-faces))
4505 (cond 4518 (cond
@@ -4559,7 +4572,7 @@ between words."
4559 (interactive "P") 4572 (interactive "P")
4560 (let* ((outline-regexp 4573 (let* ((outline-regexp
4561 (if (and (org-mode-p) org-cycle-include-plain-lists) 4574 (if (and (org-mode-p) org-cycle-include-plain-lists)
4562 "\\(?:\\*+\\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) \\)" 4575 "\\(?:\\*+ \\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) \\)"
4563 outline-regexp)) 4576 outline-regexp))
4564 (bob-special (and org-cycle-global-at-bob (bobp) 4577 (bob-special (and org-cycle-global-at-bob (bobp)
4565 (not (looking-at outline-regexp)))) 4578 (not (looking-at outline-regexp))))
@@ -5175,8 +5188,8 @@ If the region is active in `transient-mark-mode', promote all headings
5175in the region." 5188in the region."
5176 (org-back-to-heading t) 5189 (org-back-to-heading t)
5177 (let* ((level (save-match-data (funcall outline-level))) 5190 (let* ((level (save-match-data (funcall outline-level)))
5178 (up-head (make-string (org-get-legal-level level -1) ?*)) 5191 (up-head (concat (make-string (org-get-legal-level level -1) ?*) " "))
5179 (diff (abs (- level (length up-head))))) 5192 (diff (abs (- level (length up-head) -1))))
5180 (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary")) 5193 (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary"))
5181 (replace-match up-head nil t) 5194 (replace-match up-head nil t)
5182 ;; Fixup tag positioning 5195 ;; Fixup tag positioning
@@ -5189,8 +5202,8 @@ If the region is active in `transient-mark-mode', demote all headings
5189in the region." 5202in the region."
5190 (org-back-to-heading t) 5203 (org-back-to-heading t)
5191 (let* ((level (save-match-data (funcall outline-level))) 5204 (let* ((level (save-match-data (funcall outline-level)))
5192 (down-head (make-string (org-get-legal-level level 1) ?*)) 5205 (down-head (concat (make-string (org-get-legal-level level 1) ?*) " "))
5193 (diff (abs (- level (length down-head))))) 5206 (diff (abs (- level (length down-head) -1))))
5194 (replace-match down-head nil t) 5207 (replace-match down-head nil t)
5195 ;; Fixup tag positioning 5208 ;; Fixup tag positioning
5196 (and org-auto-align-tags (org-set-tags nil t)) 5209 (and org-auto-align-tags (org-set-tags nil t))
@@ -5251,8 +5264,8 @@ level 5 etc."
5251 (let ((org-odd-levels-only nil) n) 5264 (let ((org-odd-levels-only nil) n)
5252 (save-excursion 5265 (save-excursion
5253 (goto-char (point-min)) 5266 (goto-char (point-min))
5254 (while (re-search-forward "^\\*\\*+" nil t) 5267 (while (re-search-forward "^\\*\\*+ " nil t)
5255 (setq n (1- (length (match-string 0)))) 5268 (setq n (- (length (match-string 0)) 2))
5256 (while (>= (setq n (1- n)) 0) 5269 (while (>= (setq n (1- n)) 0)
5257 (org-demote)) 5270 (org-demote))
5258 (end-of-line 1)))))) 5271 (end-of-line 1))))))
@@ -5266,15 +5279,15 @@ is signaled in this case."
5266 (interactive) 5279 (interactive)
5267 (goto-char (point-min)) 5280 (goto-char (point-min))
5268 ;; First check if there are no even levels 5281 ;; First check if there are no even levels
5269 (when (re-search-forward "^\\(\\*\\*\\)+[^*]" nil t) 5282 (when (re-search-forward "^\\(\\*\\*\\)+ " nil t)
5270 (org-show-context t) 5283 (org-show-context t)
5271 (error "Not all levels are odd in this file. Conversion not possible.")) 5284 (error "Not all levels are odd in this file. Conversion not possible."))
5272 (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ") 5285 (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ")
5273 (let ((org-odd-levels-only nil) n) 5286 (let ((org-odd-levels-only nil) n)
5274 (save-excursion 5287 (save-excursion
5275 (goto-char (point-min)) 5288 (goto-char (point-min))
5276 (while (re-search-forward "^\\*\\*+" nil t) 5289 (while (re-search-forward "^\\*\\*+ " nil t)
5277 (setq n (/ (length (match-string 0)) 2)) 5290 (setq n (/ (length (1- (match-string 0))) 2))
5278 (while (>= (setq n (1- n)) 0) 5291 (while (>= (setq n (1- n)) 0)
5279 (org-promote)) 5292 (org-promote))
5280 (end-of-line 1)))))) 5293 (end-of-line 1))))))
@@ -6285,6 +6298,8 @@ C-c C-c Set tags / toggle checkbox"
6285 '([(meta shift down)] org-shiftmetadown) 6298 '([(meta shift down)] org-shiftmetadown)
6286 '([(meta shift left)] org-shiftmetaleft) 6299 '([(meta shift left)] org-shiftmetaleft)
6287 '([(meta shift right)] org-shiftmetaright) 6300 '([(meta shift right)] org-shiftmetaright)
6301 '([(shift up)] org-shiftup)
6302 '([(shift down)] org-shiftdown)
6288 '("\M-q" fill-paragraph) 6303 '("\M-q" fill-paragraph)
6289 '("\C-c^" org-sort) 6304 '("\C-c^" org-sort)
6290 '("\C-c-" org-cycle-list-bullet))) 6305 '("\C-c-" org-cycle-list-bullet)))
@@ -6466,8 +6481,7 @@ this heading."
6466 (if heading 6481 (if heading
6467 (progn 6482 (progn
6468 (if (re-search-forward 6483 (if (re-search-forward
6469 (concat "\\(^\\|\r\\)" 6484 (concat "^" (regexp-quote heading)
6470 (regexp-quote heading)
6471 (org-re "[ \t]*\\(:[[:alnum:]_@:]+:\\)?[ \t]*\\($\\|\r\\)")) 6485 (org-re "[ \t]*\\(:[[:alnum:]_@:]+:\\)?[ \t]*\\($\\|\r\\)"))
6472 nil t) 6486 nil t)
6473 (goto-char (match-end 0)) 6487 (goto-char (match-end 0))
@@ -7723,7 +7737,7 @@ should be done in reverse order."
7723 (setq beg (point-at-bol 1))) 7737 (setq beg (point-at-bol 1)))
7724 (goto-char pos) 7738 (goto-char pos)
7725 (if (re-search-forward org-table-hline-regexp tend t) 7739 (if (re-search-forward org-table-hline-regexp tend t)
7726 (setq end (point-at-bol 0)) 7740 (setq end (point-at-bol 1))
7727 (goto-char tend) 7741 (goto-char tend)
7728 (setq end (point-at-bol)))) 7742 (setq end (point-at-bol))))
7729 (setq beg (move-marker (make-marker) beg) 7743 (setq beg (move-marker (make-marker) beg)
@@ -11015,12 +11029,14 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
11015 (switch-to-buffer-other-window 11029 (switch-to-buffer-other-window
11016 (org-get-buffer-for-internal-link (current-buffer))) 11030 (org-get-buffer-for-internal-link (current-buffer)))
11017 (org-mark-ring-push)) 11031 (org-mark-ring-push))
11018 (org-link-search 11032 (let ((cmd `(org-link-search
11019 path 11033 ,path
11020 (cond ((equal in-emacs '(4)) 'occur) 11034 ,(cond ((equal in-emacs '(4)) 'occur)
11021 ((equal in-emacs '(16)) 'org-occur) 11035 ((equal in-emacs '(16)) 'org-occur)
11022 (t nil)) 11036 (t nil))
11023 pos)) 11037 ,pos)))
11038 (condition-case nil (eval cmd)
11039 (error (progn (widen) (eval cmd))))))
11024 11040
11025 ((string= type "tree-match") 11041 ((string= type "tree-match")
11026 (org-occur (concat "\\[" (regexp-quote path) "\\]"))) 11042 (org-occur (concat "\\[" (regexp-quote path) "\\]")))
@@ -11170,7 +11186,7 @@ in all files. If AVOID-POS is given, ignore matches near that position."
11170 (let ((case-fold-search t) 11186 (let ((case-fold-search t)
11171 (s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " ")) 11187 (s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " "))
11172 (markers (concat "\\(?:" (mapconcat (lambda (x) (regexp-quote (car x))) 11188 (markers (concat "\\(?:" (mapconcat (lambda (x) (regexp-quote (car x)))
11173 (append '((" ") ("\t") ("\n")) 11189 (append '(("") (" ") ("\t") ("\n"))
11174 org-emphasis-alist) 11190 org-emphasis-alist)
11175 "\\|") "\\)")) 11191 "\\|") "\\)"))
11176 (pos (point)) 11192 (pos (point))
@@ -11197,10 +11213,10 @@ in all files. If AVOID-POS is given, ignore matches near that position."
11197 ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *"))) 11213 ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *")))
11198 (t (org-do-occur (match-string 1 s))))) 11214 (t (org-do-occur (match-string 1 s)))))
11199 (t 11215 (t
11200 ;; A normal search string 11216 ;; A normal search strings
11201 (when (equal (string-to-char s) ?*) 11217 (when (equal (string-to-char s) ?*)
11202 ;; Anchor on headlines, post may include tags. 11218 ;; Anchor on headlines, post may include tags.
11203 (setq pre "^\\*+[ \t]*\\(?:\\sw+\\)?[ \t]*" 11219 (setq pre "^\\*+[ \t]+\\(?:\\sw+\\)?[ \t]*"
11204 post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@:+]:[ \t]*\\)?$") 11220 post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@:+]:[ \t]*\\)?$")
11205 s (substring s 1))) 11221 s (substring s 1)))
11206 (remove-text-properties 11222 (remove-text-properties
@@ -11707,6 +11723,7 @@ If the file does not exist, an error is thrown."
11707 ((or (stringp cmd) 11723 ((or (stringp cmd)
11708 (eq cmd 'emacs)) 11724 (eq cmd 'emacs))
11709 (funcall (cdr (assq 'file org-link-frame-setup)) file) 11725 (funcall (cdr (assq 'file org-link-frame-setup)) file)
11726 (widen)
11710 (if line (goto-line line) 11727 (if line (goto-line line)
11711 (if search (org-link-search search)))) 11728 (if search (org-link-search search))))
11712 ((consp cmd) 11729 ((consp cmd)
@@ -11842,14 +11859,18 @@ to be run from that hook to fucntion properly."
11842 (let* ((org-last-tags-completion-table 11859 (let* ((org-last-tags-completion-table
11843 (org-global-tags-completion-table 11860 (org-global-tags-completion-table
11844 (if (equal char "G") (org-agenda-files) (and file (list file))))) 11861 (if (equal char "G") (org-agenda-files) (and file (list file)))))
11862 (org-add-colon-after-tag-completion t)
11845 (ins (completing-read 11863 (ins (completing-read
11846 (if prompt (concat prompt ": ") "Tags: ") 11864 (if prompt (concat prompt ": ") "Tags: ")
11847 'org-tags-completion-function nil nil nil 11865 'org-tags-completion-function nil nil nil
11848 'org-tags-history))) 11866 'org-tags-history)))
11849 (insert (concat ":" (mapconcat 'identity 11867 (setq ins (mapconcat 'identity
11850 (org-split-string ins (org-re "[^[:alnum:]]+")) 11868 (org-split-string ins (org-re "[^[:alnum:]]+"))
11851 ":") 11869 ":"))
11852 ":")))) 11870 (when (string-match "\\S-" ins)
11871 (or (equal (char-before) ?:) (insert ":"))
11872 (insert ins)
11873 (or (equal (char-after) ?:) (insert ":")))))
11853 (char 11874 (char
11854 (setq org-time-was-given (equal (upcase char) char)) 11875 (setq org-time-was-given (equal (upcase char) char))
11855 (setq time (org-read-date (equal (upcase char) "U") t nil 11876 (setq time (org-read-date (equal (upcase char) "U") t nil
@@ -11939,7 +11960,7 @@ See also the variable `org-reverse-note-order'."
11939 (let* ((lines (split-string txt "\n")) 11960 (let* ((lines (split-string txt "\n"))
11940 first) 11961 first)
11941 (setq first (car lines) lines (cdr lines)) 11962 (setq first (car lines) lines (cdr lines))
11942 (if (string-match "^\\*+" first) 11963 (if (string-match "^\\*+ " first)
11943 ;; Is already a headline 11964 ;; Is already a headline
11944 (setq indent nil) 11965 (setq indent nil)
11945 ;; We need to add a headline: Use time and first buffer line 11966 ;; We need to add a headline: Use time and first buffer line
@@ -11990,7 +12011,7 @@ See also the variable `org-reverse-note-order'."
11990 (save-restriction 12011 (save-restriction
11991 (widen) 12012 (widen)
11992 (goto-char (point-min)) 12013 (goto-char (point-min))
11993 (re-search-forward "^\\*" nil t) 12014 (re-search-forward "^\\*+ " nil t)
11994 (beginning-of-line 1) 12015 (beginning-of-line 1)
11995 (org-paste-subtree 1 txt))) 12016 (org-paste-subtree 1 txt)))
11996 ((and (org-on-heading-p t) (not current-prefix-arg)) 12017 ((and (org-on-heading-p t) (not current-prefix-arg))
@@ -12197,7 +12218,7 @@ At all other locations, this simply calls `ispell-complete-word'."
12197 (texp 12218 (texp
12198 (setq type :tex) 12219 (setq type :tex)
12199 org-html-entities) 12220 org-html-entities)
12200 ((string-match "\\`\\*+[ \t]*\\'" 12221 ((string-match "\\`\\*+[ \t]+\\'"
12201 (buffer-substring (point-at-bol) beg)) 12222 (buffer-substring (point-at-bol) beg))
12202 (setq type :todo) 12223 (setq type :todo)
12203 (mapcar 'list org-todo-keywords-1)) 12224 (mapcar 'list org-todo-keywords-1))
@@ -12258,12 +12279,12 @@ At all other locations, this simply calls `ispell-complete-word'."
12258 (save-excursion 12279 (save-excursion
12259 (org-back-to-heading) 12280 (org-back-to-heading)
12260 (if (looking-at (concat outline-regexp 12281 (if (looking-at (concat outline-regexp
12261 "\\( +\\<" org-comment-string "\\>\\)")) 12282 "\\( *\\<" org-comment-string "\\>\\)"))
12262 (replace-match "" t t nil 1) 12283 (replace-match "" t t nil 1)
12263 (if (looking-at outline-regexp) 12284 (if (looking-at outline-regexp)
12264 (progn 12285 (progn
12265 (goto-char (match-end 0)) 12286 (goto-char (match-end 0))
12266 (insert " " org-comment-string)))))) 12287 (insert org-comment-string " "))))))
12267 12288
12268(defvar org-last-todo-state-is-todo nil 12289(defvar org-last-todo-state-is-todo nil
12269 "This is non-nil when the last TODO state change led to a TODO state. 12290 "This is non-nil when the last TODO state change led to a TODO state.
@@ -12297,7 +12318,7 @@ For calling through lisp, arg is also interpreted in the following way:
12297 (interactive "P") 12318 (interactive "P")
12298 (save-excursion 12319 (save-excursion
12299 (org-back-to-heading) 12320 (org-back-to-heading)
12300 (if (looking-at outline-regexp) (goto-char (match-end 0))) 12321 (if (looking-at outline-regexp) (goto-char (1- (match-end 0))))
12301 (or (looking-at (concat " +" org-todo-regexp " *")) 12322 (or (looking-at (concat " +" org-todo-regexp " *"))
12302 (looking-at " *")) 12323 (looking-at " *"))
12303 (let* ((this (match-string 1)) 12324 (let* ((this (match-string 1))
@@ -12490,7 +12511,7 @@ of `org-todo-keywords-1'."
12490 org-todo-keywords-1))) 12511 org-todo-keywords-1)))
12491 (t (error "Invalid prefix argument: %s" arg))))) 12512 (t (error "Invalid prefix argument: %s" arg)))))
12492 (message "%d TODO entries found" 12513 (message "%d TODO entries found"
12493 (org-occur (concat "^" outline-regexp " +" kwd-re ))))) 12514 (org-occur (concat "^" outline-regexp " *" kwd-re )))))
12494 12515
12495(defun org-deadline () 12516(defun org-deadline ()
12496 "Insert the DEADLINE: string to make a deadline. 12517 "Insert the DEADLINE: string to make a deadline.
@@ -13139,11 +13160,12 @@ With prefix ARG, realign all tags in headings in the current buffer."
13139 ;; try completion 13160 ;; try completion
13140 (setq rtn (try-completion s2 ctable confirm)) 13161 (setq rtn (try-completion s2 ctable confirm))
13141 (if (stringp rtn) 13162 (if (stringp rtn)
13142 (concat s1 s2 (substring rtn (length s2)) 13163 (setq rtn
13143 (if (and org-add-colon-after-tag-completion 13164 (concat s1 s2 (substring rtn (length s2))
13144 (assoc rtn ctable)) 13165 (if (and org-add-colon-after-tag-completion
13145 ":" ""))) 13166 (assoc rtn ctable))
13146 ) 13167 ":" ""))))
13168 rtn)
13147 ((eq flag t) 13169 ((eq flag t)
13148 ;; all-completions 13170 ;; all-completions
13149 (all-completions s2 ctable confirm) 13171 (all-completions s2 ctable confirm)
@@ -13202,7 +13224,7 @@ Returns the new tags string, or nil to not change the current settings."
13202 (save-excursion 13224 (save-excursion
13203 (beginning-of-line 1) 13225 (beginning-of-line 1)
13204 (if (looking-at 13226 (if (looking-at
13205 (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*\\(\r\\|$\\)")) 13227 (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))
13206 (setq ov-start (match-beginning 1) 13228 (setq ov-start (match-beginning 1)
13207 ov-end (match-end 1) 13229 ov-end (match-end 1)
13208 ov-prefix "") 13230 ov-prefix "")
@@ -13358,7 +13380,7 @@ Returns the new tags string, or nil to not change the current settings."
13358 (error "Not on a heading")) 13380 (error "Not on a heading"))
13359 (save-excursion 13381 (save-excursion
13360 (beginning-of-line 1) 13382 (beginning-of-line 1)
13361 (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*\\(\r\\|$\\)")) 13383 (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))
13362 (org-match-string-no-properties 1) 13384 (org-match-string-no-properties 1)
13363 ""))) 13385 "")))
13364 13386
@@ -13393,6 +13415,32 @@ but in some other way.")
13393(defconst org-property-end-re "^[ \t]*:END:[ \t]*$" 13415(defconst org-property-end-re "^[ \t]*:END:[ \t]*$"
13394 "Regular expression matching the first line of a property drawer.") 13416 "Regular expression matching the first line of a property drawer.")
13395 13417
13418(defun org-property-action ()
13419 "Do an action on properties."
13420 (interactive)
13421 (let (c prop)
13422 (org-at-property-p)
13423 (setq prop (match-string 2))
13424 (message "Property Action: [s]et [d]elete [D]delete globally")
13425 (setq c (read-char-exclusive))
13426 (cond
13427 ((equal c ?s)
13428 (call-interactively 'org-set-property))
13429 ((equal c ?d)
13430 (call-interactively 'org-delete-property))
13431 ((equal c ?D)
13432 (call-interactively 'org-delete-property-globally))
13433 (t (error "No such property action %c" c)))))
13434
13435(defun org-at-property-p ()
13436 "Is the cursor in a property line?"
13437 ;; FIXME: Does not check if we are actually in the drawer.
13438 ;; FIXME: also returns true on any drawers.....
13439 ;; This is used by C-c C-c for property action.
13440 (save-excursion
13441 (beginning-of-line 1)
13442 (looking-at "^[ \t]*\\(:\\([a-zA-Z_0-9]+\\):\\)[ \t]*\\(.*\\)")))
13443
13396(defmacro org-with-point-at (pom &rest body) 13444(defmacro org-with-point-at (pom &rest body)
13397 "Move to buffer and point of point-or-marker POM for the duration of BODY." 13445 "Move to buffer and point of point-or-marker POM for the duration of BODY."
13398 (declare (indent 1) (debug t)) 13446 (declare (indent 1) (debug t))
@@ -13406,7 +13454,7 @@ but in some other way.")
13406 "Return the (beg . end) range of the body of the property drawer. 13454 "Return the (beg . end) range of the body of the property drawer.
13407BEG and END can be beginning and end of subtree, if not given 13455BEG and END can be beginning and end of subtree, if not given
13408they will be found. 13456they will be found.
13409If the drawer does not exist and FORCE is non-nil, greater the drawer." 13457If the drawer does not exist and FORCE is non-nil, create the drawer."
13410 (catch 'exit 13458 (catch 'exit
13411 (save-excursion 13459 (save-excursion
13412 (let* ((beg (or beg (progn (org-back-to-heading t) (point)))) 13460 (let* ((beg (or beg (progn (org-back-to-heading t) (point))))
@@ -13414,18 +13462,14 @@ If the drawer does not exist and FORCE is non-nil, greater the drawer."
13414 (goto-char beg) 13462 (goto-char beg)
13415 (if (re-search-forward org-property-start-re end t) 13463 (if (re-search-forward org-property-start-re end t)
13416 (setq beg (1+ (match-end 0))) 13464 (setq beg (1+ (match-end 0)))
13417 (or force (throw 'exit nil)) 13465 (if force
13418 (beginning-of-line 2) 13466 (save-excursion
13419 (while (and (looking-at (concat "[ \t]*" org-keyword-time-regexp)) 13467 (org-insert-property-drawer)
13420 (not (equal (match-string 1) org-clock-string))) 13468 (setq end (progn (outline-next-heading) (point))))
13421 (beginning-of-line 2)) 13469 (throw 'exit nil))
13422 (insert ":PROPERTIES:\n:END:\n") 13470 (goto-char beg)
13423 (beginning-of-line -1) 13471 (if (re-search-forward org-property-start-re end t)
13424 (org-indent-line-function) 13472 (setq beg (1+ (match-end 0)))))
13425 (setq beg (1+ (point-at-eol)) end beg)
13426 (beginning-of-line 2)
13427 (org-indent-line-function)
13428 (throw 'exit (cons beg end)))
13429 (if (re-search-forward org-property-end-re end t) 13473 (if (re-search-forward org-property-end-re end t)
13430 (setq end (match-beginning 0)) 13474 (setq end (match-beginning 0))
13431 (or force (throw 'exit nil)) 13475 (or force (throw 'exit nil))
@@ -13448,10 +13492,11 @@ If WHICH is nil or `all', get all properties. If WHICH is
13448 (org-with-point-at pom 13492 (org-with-point-at pom
13449 (let ((clockstr (substring org-clock-string 0 -1)) 13493 (let ((clockstr (substring org-clock-string 0 -1))
13450 (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY")) 13494 (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY"))
13451 beg end range props key value) 13495 beg end range props sum-props key value)
13452 (save-excursion 13496 (save-excursion
13453 (when (condition-case nil (org-back-to-heading t) (error nil)) 13497 (when (condition-case nil (org-back-to-heading t) (error nil))
13454 (setq beg (point)) 13498 (setq beg (point))
13499 (setq sum-props (get-text-property (point) 'org-summaries))
13455 (outline-next-heading) 13500 (outline-next-heading)
13456 (setq end (point)) 13501 (setq end (point))
13457 (when (memq which '(all special)) 13502 (when (memq which '(all special))
@@ -13483,18 +13528,20 @@ If WHICH is nil or `all', get all properties. If WHICH is
13483 (when range 13528 (when range
13484 (goto-char (car range)) 13529 (goto-char (car range))
13485 (while (re-search-forward 13530 (while (re-search-forward
13486 "^[ \t]*:\\([a-zA-Z][a-zA-Z0-9]*\\):[ \t]*\\(\\S-.*\\S-\\)" 13531 "^[ \t]*:\\([a-zA-Z][a-zA-Z_0-9]*\\):[ \t]*\\(\\S-.*\\)?"
13487 (cdr range) t) 13532 (cdr range) t)
13488 (setq key (org-match-string-no-properties 1) 13533 (setq key (org-match-string-no-properties 1)
13489 value (org-match-string-no-properties 2)) 13534 value (org-trim (or (org-match-string-no-properties 2) "")))
13490 (unless (member key excluded) 13535 (unless (member key excluded)
13491 (push (cons key value) props))))) 13536 (push (cons key (or value "")) props)))))
13492 (nreverse props)))))) 13537 (append sum-props (nreverse props)))))))
13493 13538
13494(defun org-entry-get (pom property &optional inherit) 13539(defun org-entry-get (pom property &optional inherit)
13495 "Get value of PROPERTY for entry at point-or-marker POM. 13540 "Get value of PROPERTY for entry at point-or-marker POM.
13496If INHERIT is non-nil and the entry does not have the property, 13541If INHERIT is non-nil and the entry does not have the property,
13497then also check higher levels of the hierarchy." 13542then also check higher levels of the hierarchy.
13543If the property is present but empty, the return value is the empty string.
13544If the property is not present at all, nil is returned."
13498 (org-with-point-at pom 13545 (org-with-point-at pom
13499 (if inherit 13546 (if inherit
13500 (org-entry-get-with-inheritance property) 13547 (org-entry-get-with-inheritance property)
@@ -13505,10 +13552,12 @@ then also check higher levels of the hierarchy."
13505 (if (and range 13552 (if (and range
13506 (goto-char (car range)) 13553 (goto-char (car range))
13507 (re-search-forward 13554 (re-search-forward
13508 (concat "^[ \t]*:" property ":[ \t]*\\(.*\\S-\\)") 13555 (concat "^[ \t]*:" property ":[ \t]*\\(.*\\S-\\)?")
13509 (cdr range) t)) 13556 (cdr range) t))
13510 ;; Found the property, return it. 13557 ;; Found the property, return it.
13511 (org-match-string-no-properties 1))))))) 13558 (if (match-end 1)
13559 (org-match-string-no-properties 1)
13560 "")))))))
13512 13561
13513(defun org-entry-delete (pom property) 13562(defun org-entry-delete (pom property)
13514 "Delete the property PROPERTY from entry at point-or-marker POM." 13563 "Delete the property PROPERTY from entry at point-or-marker POM."
@@ -13521,7 +13570,10 @@ then also check higher levels of the hierarchy."
13521 (re-search-forward 13570 (re-search-forward
13522 (concat "^[ \t]*:" property ":[ \t]*\\(.*\\S-\\)") 13571 (concat "^[ \t]*:" property ":[ \t]*\\(.*\\S-\\)")
13523 (cdr range) t)) 13572 (cdr range) t))
13524 (delete-region (match-beginning 0) (1+ (point-at-eol)))))))) 13573 (progn
13574 (delete-region (match-beginning 0) (1+ (point-at-eol)))
13575 t)
13576 nil)))))
13525 13577
13526(defvar org-entry-property-inherited-from (make-marker)) 13578(defvar org-entry-property-inherited-from (make-marker))
13527 13579
@@ -13575,7 +13627,8 @@ then also check higher levels of the hierarchy."
13575 (backward-char 1) 13627 (backward-char 1)
13576 (org-indent-line-function) 13628 (org-indent-line-function)
13577 (insert ":" property ":")) 13629 (insert ":" property ":"))
13578 (and value (insert " " value))))))) 13630 (and value (insert " " value))
13631 (org-indent-line-function))))))
13579 13632
13580(defun org-buffer-property-keys (&optional include-specials) 13633(defun org-buffer-property-keys (&optional include-specials)
13581 "Get all property keys in the current buffer." 13634 "Get all property keys in the current buffer."
@@ -13594,56 +13647,195 @@ then also check higher levels of the hierarchy."
13594 (setq rtn (append org-special-properties rtn))) 13647 (setq rtn (append org-special-properties rtn)))
13595 (sort rtn (lambda (a b) (string< (upcase a) (upcase b)))))) 13648 (sort rtn (lambda (a b) (string< (upcase a) (upcase b))))))
13596 13649
13597;; FIXME: This should automatically find the right place int he entry.
13598;; And then org-entry-put should use it.
13599(defun org-insert-property-drawer () 13650(defun org-insert-property-drawer ()
13600 "Insert a property drawer at point." 13651 "Insert a property drawer into the current entry."
13601 (interactive) 13652 (interactive)
13602 (beginning-of-line 1) 13653 (org-back-to-heading t)
13603 (insert ":PROPERTIES:\n:END:\n") 13654 (let ((beg (point))
13604 (beginning-of-line -1) 13655 (re (concat "^[ \t]*" org-keyword-time-regexp))
13605 (org-indent-line-function) 13656 end hiddenp)
13606 (beginning-of-line 2) 13657 (outline-next-heading)
13607 (org-indent-line-function) 13658 (setq end (point))
13608 (end-of-line 0)) 13659 (goto-char beg)
13609 13660 (while (re-search-forward re end t))
13610(defvar org-column-overlays nil 13661 (setq hiddenp (org-invisible-p))
13662 (end-of-line 1)
13663 (insert "\n:PROPERTIES:\n:END:")
13664 (beginning-of-line 0)
13665 (org-indent-line-function)
13666 (beginning-of-line 2)
13667 (org-indent-line-function)
13668 (beginning-of-line 0)
13669 (if hiddenp
13670 (save-excursion
13671 (org-back-to-heading t)
13672 (hide-entry))
13673 (org-flag-drawer t))))
13674
13675(defun org-set-property (property value)
13676 "In the current entry, set PROPERTY to VALUE."
13677 (interactive
13678 (let* ((prop (completing-read "Property: "
13679 (mapcar 'list (org-buffer-property-keys))))
13680 (cur (org-entry-get nil prop))
13681 (allowed (org-property-get-allowed-values nil prop 'table))
13682 (val (if allowed
13683 (completing-read "Value: " allowed nil 'req-match)
13684 (read-string
13685 (concat "Value" (if (and cur (string-match "\\S-" cur))
13686 (concat "[" cur "]") "")
13687 ": ")
13688 "" cur))))
13689 (list prop (if (equal val "") cur val))))
13690 (unless (equal (org-entry-get nil property) value)
13691 (org-entry-put nil property value)))
13692
13693(defun org-delete-property (property)
13694 "In the current entry, delete PROPERTY."
13695 (interactive
13696 (let* ((prop (completing-read
13697 "Property: " (org-entry-properties nil 'standard))))
13698 (list prop)))
13699 (message (concat "Property " property
13700 (if (org-entry-delete nil property)
13701 " deleted"
13702 " was not present in the entry"))))
13703
13704(defun org-delete-property-globally (property)
13705 "Remove PROPERTY globally, from all entries."
13706 (interactive
13707 (let* ((prop (completing-read
13708 "Globally remove property: "
13709 (mapcar 'list (org-buffer-property-keys)))))
13710 (list prop)))
13711 (save-excursion
13712 (save-restriction
13713 (widen)
13714 (goto-char (point-min))
13715 (let ((cnt 0))
13716 (while (re-search-forward
13717 (concat "^[ \t]*:" (regexp-quote property) ":.*\n?")
13718 nil t)
13719 (setq cnt (1+ cnt))
13720 (replace-match ""))
13721 (message "Property \"%s\" removed from %d entries" property cnt)))))
13722
13723(defun org-property-get-allowed-values (pom property &optional table)
13724 "Get allowed values for the property PROPERTY.
13725When TABLE is non-nil, return an alist that can directly be used for
13726completion."
13727 (let (vals)
13728 (cond
13729 ((equal property "TODO")
13730 (setq vals (org-with-point-at pom
13731 (append org-todo-keywords-1 '("")))))
13732 ((equal property "PRIORITY")
13733 (let ((n org-lowest-priority))
13734 (while (>= n org-highest-priority)
13735 (push (char-to-string n) vals)
13736 (setq n (1- n)))))
13737 ((member property org-special-properties))
13738 (t
13739 (setq vals (org-entry-get pom (concat property "_ALL") 'inherit))
13740 (when (and vals (string-match "\\S-" vals))
13741 (setq vals (car (read-from-string (concat "(" vals ")"))))
13742 (setq vals (mapcar (lambda (x)
13743 (cond ((stringp x) x)
13744 ((numberp x) (number-to-string x))
13745 ((symbolp x) (symbol-name x))
13746 (t "???")))
13747 vals)))))
13748 (if table (mapcar 'list vals) vals)))
13749
13750;;; Column View
13751
13752(defvar org-columns-overlays nil
13611 "Holds the list of current column overlays.") 13753 "Holds the list of current column overlays.")
13612 13754
13613(defvar org-current-columns-fmt nil 13755(defvar org-columns-current-fmt nil
13614 "Loval variable, holds the currently active column format.") 13756 "Local variable, holds the currently active column format.")
13615(defvar org-current-columns-maxwidths nil 13757(defvar org-columns-current-fmt-compiled nil
13758 "Local variable, holds the currently active column format.
13759This is the compiled version of the format.")
13760(defvar org-columns-current-maxwidths nil
13616 "Loval variable, holds the currently active maximum column widths.") 13761 "Loval variable, holds the currently active maximum column widths.")
13762(defvar org-columns-begin-marker (make-marker)
13763 "Points to the position where last a column creation command was called.")
13764(defvar org-columns-top-level-marker (make-marker)
13765 "Points to the position where current columns region starts.")
13617 13766
13618(defvar org-column-map (make-sparse-keymap) 13767(defvar org-columns-map (make-sparse-keymap)
13619 "The keymap valid in column display.") 13768 "The keymap valid in column display.")
13620 13769
13621(define-key org-column-map "e" 'org-column-edit) 13770(defun org-columns-content ()
13622(define-key org-column-map "v" 'org-column-show-value) 13771 "Switch to contents view while in columns view."
13623(define-key org-column-map "q" 'org-column-quit) 13772 (interactive)
13624(define-key org-column-map [left] 'backward-char) 13773 (org-overview)
13625(define-key org-column-map [right] 'forward-char) 13774 (org-content))
13626 13775
13627(easy-menu-define org-column-menu org-column-map "Org Column Menu" 13776(org-defkey org-columns-map "c" 'org-columns-content)
13777(org-defkey org-columns-map "o" 'org-overview)
13778(org-defkey org-columns-map "e" 'org-columns-edit-value)
13779(org-defkey org-columns-map "v" 'org-columns-show-value)
13780(org-defkey org-columns-map "q" 'org-columns-quit)
13781(org-defkey org-columns-map "r" 'org-columns-redo)
13782(org-defkey org-columns-map [left] 'backward-char)
13783(org-defkey org-columns-map "a" 'org-columns-edit-allowed)
13784(org-defkey org-columns-map "s" 'org-columns-edit-attributes)
13785(org-defkey org-columns-map [right] 'forward-char)
13786(org-defkey org-columns-map [(shift right)] 'org-columns-next-allowed-value)
13787(org-defkey org-columns-map "\C-c\C-c" 'org-columns-next-allowed-value)
13788(org-defkey org-columns-map "n" 'org-columns-next-allowed-value)
13789(org-defkey org-columns-map [(shift left)] 'org-columns-previous-allowed-value)
13790(org-defkey org-columns-map "p" 'org-columns-previous-allowed-value)
13791(org-defkey org-columns-map "<" 'org-columns-narrow)
13792(org-defkey org-columns-map ">" 'org-columns-widen)
13793(org-defkey org-columns-map [(meta right)] 'org-columns-move-right)
13794(org-defkey org-columns-map [(meta left)] 'org-columns-move-left)
13795(org-defkey org-columns-map [(shift meta right)] 'org-columns-new)
13796(org-defkey org-columns-map [(shift meta left)] 'org-columns-delete)
13797
13798(easy-menu-define org-columns-menu org-columns-map "Org Column Menu"
13628 '("Column" 13799 '("Column"
13629 ["Edit property" org-column-edit t] 13800 ["Edit property" org-columns-edit-value t]
13630 ["Show full value" org-column-show-value t] 13801 ["Next allowed value" org-columns-next-allowed-value t]
13631 ["Quit" org-column-quit t])) 13802 ["Previous allowed value" org-columns-previous-allowed-value t]
13803 ["Show full value" org-columns-show-value t]
13804 ["Edit allowed" org-columns-edit-allowed t]
13805 "--"
13806 ["Edit column attributes" org-columns-edit-attributes t]
13807 ["Increase column width" org-columns-widen t]
13808 ["Decrease column width" org-columns-narrow t]
13809 "--"
13810 ["Move column right" org-columns-move-right t]
13811 ["Move column left" org-columns-move-left t]
13812 ["Add column" org-columns-new t]
13813 ["Delete column" org-columns-delete t]
13814 "--"
13815 ["CONTENTS" org-columns-content t]
13816 ["OVERVIEW" org-overview t]
13817 ["Refresh columns display" org-columns-redo t]
13818 "--"
13819 ["Quit" org-columns-quit t]))
13632 13820
13633(defun org-new-column-overlay (beg end &optional string face) 13821(defun org-columns-new-overlay (beg end &optional string face)
13634 "Create a new column overlay an add it to the list." 13822 "Create a new column overlay and add it to the list."
13635 (let ((ov (org-make-overlay beg end))) 13823 (let ((ov (org-make-overlay beg end)))
13636 (org-overlay-put ov 'face (or face 'secondary-selection)) 13824 (org-overlay-put ov 'face (or face 'secondary-selection))
13637 (org-overlay-display ov string face) 13825 (org-overlay-display ov string face)
13638 (push ov org-column-overlays) 13826 (push ov org-columns-overlays)
13639 ov)) 13827 ov))
13640 13828
13641(defun org-overlay-columns (&optional props) 13829(defun org-columns-display-here (&optional props)
13642 "Overlay the current line with column display." 13830 "Overlay the current line with column display."
13643 (interactive) 13831 (interactive)
13644 (let ((fmt (copy-sequence org-current-columns-fmt)) 13832 (let* ((fmt org-columns-current-fmt-compiled)
13645 (beg (point-at-bol)) 13833 (beg (point-at-bol))
13646 (start 0) props pom property ass width f string ov) 13834 (color (list :foreground
13835 (face-attribute
13836 (or (get-text-property beg 'face) 'default)
13837 :foreground)))
13838 props pom property ass width f string ov column)
13647 ;; Check if the entry is in another buffer. 13839 ;; Check if the entry is in another buffer.
13648 (unless props 13840 (unless props
13649 (if (eq major-mode 'org-agenda-mode) 13841 (if (eq major-mode 'org-agenda-mode)
@@ -13651,11 +13843,9 @@ then also check higher levels of the hierarchy."
13651 (get-text-property (point) 'org-marker)) 13843 (get-text-property (point) 'org-marker))
13652 props (if pom (org-entry-properties pom) nil)) 13844 props (if pom (org-entry-properties pom) nil))
13653 (setq props (org-entry-properties nil)))) 13845 (setq props (org-entry-properties nil))))
13654 ;; Parse the format 13846 ;; Walk the format
13655 (while (string-match "%\\([0-9]+\\)?\\([a-zA-Z0-9]+\\)\\-*" 13847 (while (setq column (pop fmt))
13656 fmt start) 13848 (setq property (car column)
13657 (setq start (match-end 0)
13658 property (match-string 2 fmt)
13659 ass (if (equal property "ITEM") 13849 ass (if (equal property "ITEM")
13660 (cons "ITEM" 13850 (cons "ITEM"
13661 (save-match-data 13851 (save-match-data
@@ -13664,17 +13854,21 @@ then also check higher levels of the hierarchy."
13664 (buffer-substring-no-properties 13854 (buffer-substring-no-properties
13665 (point-at-bol) (point-at-eol)))))) 13855 (point-at-bol) (point-at-eol))))))
13666 (assoc property props)) 13856 (assoc property props))
13667 width (or (cdr (assoc property org-current-columns-maxwidths)) 13857 width (or (cdr (assoc property org-columns-current-maxwidths))
13668 (string-to-number (or (match-string 1 fmt) "10"))) 13858 (nth 2 column))
13669 f (format "%%-%d.%ds | " width width) 13859 f (format "%%-%d.%ds | " width width)
13670 string (format f (or (cdr ass) ""))) 13860 string (format f (or (cdr ass) "")))
13671 ;; Create the overlay 13861 ;; Create the overlay
13672 (org-unmodified 13862 (org-unmodified
13673 (setq ov (org-new-column-overlay 13863 (setq ov (org-columns-new-overlay
13674 beg (setq beg (1+ beg)) string 'org-column)) 13864 beg (setq beg (1+ beg)) string
13675 (org-overlay-put ov 'keymap org-column-map) 13865 (list color 'org-column)))
13676 (org-overlay-put ov 'org-column-key property) 13866;;; (list (get-text-property (point-at-bol) 'face) 'org-column)))
13677 (org-overlay-put ov 'org-column-value (cdr ass))) 13867 (org-overlay-put ov 'keymap org-columns-map)
13868 (org-overlay-put ov 'org-columns-key property)
13869 (org-overlay-put ov 'org-columns-value (cdr ass))
13870 (org-overlay-put ov 'org-columns-pom pom)
13871 (org-overlay-put ov 'org-columns-format f))
13678 (if (or (not (char-after beg)) 13872 (if (or (not (char-after beg))
13679 (equal (char-after beg) ?\n)) 13873 (equal (char-after beg) ?\n))
13680 (let ((inhibit-read-only t)) 13874 (let ((inhibit-read-only t))
@@ -13682,64 +13876,72 @@ then also check higher levels of the hierarchy."
13682 (goto-char beg) 13876 (goto-char beg)
13683 (insert " "))))) 13877 (insert " ")))))
13684 ;; Make the rest of the line disappear. 13878 ;; Make the rest of the line disappear.
13685 ;; FIXME: put the keymap also at the end of the line!
13686 (org-unmodified 13879 (org-unmodified
13687 (setq ov (org-new-column-overlay beg (point-at-eol))) 13880 (setq ov (org-columns-new-overlay beg (point-at-eol)))
13688 (org-overlay-put ov 'invisible t) 13881 (org-overlay-put ov 'invisible t)
13689 (org-overlay-put ov 'keymap 'org-column-map) 13882 (org-overlay-put ov 'keymap org-columns-map)
13690 (push ov org-column-overlays) 13883 (push ov org-columns-overlays)
13691 (setq ov (org-make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) 13884 (setq ov (org-make-overlay (1- (point-at-eol)) (1+ (point-at-eol))))
13692 (org-overlay-put ov 'keymap 'org-column-map) 13885 (org-overlay-put ov 'keymap org-columns-map)
13693 (push ov org-column-overlays) 13886 (push ov org-columns-overlays)
13694 (let ((inhibit-read-only t)) 13887 (let ((inhibit-read-only t))
13695 (put-text-property (1- (point-at-bol)) 13888 (put-text-property (1- (point-at-bol))
13696 (min (point-max) (1+ (point-at-eol))) 13889 (min (point-max) (1+ (point-at-eol)))
13697 'read-only "Type `e' to edit property"))))) 13890 'read-only "Type `e' to edit property")))))
13698 13891
13699(defun org-overlay-columns-title () 13892(defvar org-previous-header-line-format nil
13893 "The header line format before column view was turned on.")
13894(defvar org-columns-inhibit-recalculation nil
13895 "Inhibit recomputing of columns on column view startup.")
13896
13897(defvar header-line-format)
13898(defun org-columns-display-here-title ()
13700 "Overlay the newline before the current line with the table title." 13899 "Overlay the newline before the current line with the table title."
13701 (interactive) 13900 (interactive)
13702 (let ((fmt (copy-sequence org-current-columns-fmt)) 13901 (let ((fmt org-columns-current-fmt-compiled)
13703 (start 0)
13704 string (title "") 13902 string (title "")
13705 property width f ov) 13903 property width f column str)
13706 (while (string-match "%\\([0-9]+\\)?\\([a-zA-Z0-9]+\\)\\-*" 13904 (while (setq column (pop fmt))
13707 fmt start) 13905 (setq property (car column)
13708 (setq start (match-end 0) 13906 str (or (nth 1 column) property)
13709 property (match-string 2 fmt) 13907 width (or (cdr (assoc property org-columns-current-maxwidths))
13710 width (or (cdr (assoc property org-current-columns-maxwidths)) 13908 (nth 2 column))
13711 (string-to-number (or (match-string 1 fmt) "10")))
13712 f (format "%%-%d.%ds | " width width) 13909 f (format "%%-%d.%ds | " width width)
13713 string (format f property) 13910 string (format f str)
13714 title (concat title string))) 13911 title (concat title string)))
13715 (org-unmodified 13912 (setq title (concat
13716 (setq ov (org-new-column-overlay 13913 (org-add-props " " nil 'display '(space :align-to 0))
13717 (1- (point-at-bol)) (point-at-bol) 13914 (org-add-props title nil 'face '(:weight bold :underline t))))
13718 (concat "\n" (make-string (length title) ?-) "\n" 13915 (org-set-local 'org-previous-header-line-format header-line-format)
13719 title "\n" (make-string (length title) ?-) "\n") 13916 (setq header-line-format title)))
13720 'bold)) 13917
13721 (org-overlay-put ov 'keymap org-column-map)))) 13918(defun org-columns-remove-overlays ()
13722
13723(defun org-remove-column-overlays ()
13724 "Remove all currently active column overlays." 13919 "Remove all currently active column overlays."
13725 (interactive) 13920 (interactive)
13726 (org-unmodified 13921 (when (marker-buffer org-columns-begin-marker)
13727 (mapc 'org-delete-overlay org-column-overlays) 13922 (with-current-buffer (marker-buffer org-columns-begin-marker)
13728 (setq org-column-overlays nil) 13923 (when (local-variable-p 'org-previous-header-line-format)
13729 (let ((inhibit-read-only t)) 13924 (setq header-line-format org-previous-header-line-format)
13730 (remove-text-properties (point-min) (point-max) '(read-only t))))) 13925 (kill-local-variable 'org-previous-header-line-format))
13926 (move-marker org-columns-begin-marker nil)
13927 (move-marker org-columns-top-level-marker nil)
13928 (org-unmodified
13929 (mapc 'org-delete-overlay org-columns-overlays)
13930 (setq org-columns-overlays nil)
13931 (let ((inhibit-read-only t))
13932 (remove-text-properties (point-min) (point-max) '(read-only t)))))))
13731 13933
13732(defun org-column-show-value () 13934(defun org-columns-show-value ()
13733 "Show the full value of the property." 13935 "Show the full value of the property."
13734 (interactive) 13936 (interactive)
13735 (let ((value (get-char-property (point) 'org-column-value))) 13937 (let ((value (get-char-property (point) 'org-columns-value)))
13736 (message "Value is: %s" (or value "")))) 13938 (message "Value is: %s" (or value ""))))
13737 13939
13738(defun org-column-quit () 13940(defun org-columns-quit ()
13739 "Remove the column overlays and in this way exit column editing." 13941 "Remove the column overlays and in this way exit column editing."
13740 (interactive) 13942 (interactive)
13741 (org-unmodified 13943 (org-unmodified
13742 (org-remove-column-overlays) 13944 (org-columns-remove-overlays)
13743 (let ((inhibit-read-only t)) 13945 (let ((inhibit-read-only t))
13744 ;; FIXME: is this safe??? 13946 ;; FIXME: is this safe???
13745 ;; or are there other reasons why there may be a read-only property???? 13947 ;; or are there other reasons why there may be a read-only property????
@@ -13747,13 +13949,13 @@ then also check higher levels of the hierarchy."
13747 (when (eq major-mode 'org-agenda-mode) 13949 (when (eq major-mode 'org-agenda-mode)
13748 (message "Modification not yet reflected in Agenda buffer, use `r' to refresh"))) 13950 (message "Modification not yet reflected in Agenda buffer, use `r' to refresh")))
13749 13951
13750(defun org-column-edit () 13952(defun org-columns-edit-value ()
13751 "Edit the value of the property at point in column view. 13953 "Edit the value of the property at point in column view.
13752Where possible, use the standard interface for changing this line." 13954Where possible, use the standard interface for changing this line."
13753 (interactive) 13955 (interactive)
13754 (let* ((col (current-column)) 13956 (let* ((col (current-column))
13755 (key (get-char-property (point) 'org-column-key)) 13957 (key (get-char-property (point) 'org-columns-key))
13756 (value (get-char-property (point) 'org-column-value)) 13958 (value (get-char-property (point) 'org-columns-value))
13757 (bol (point-at-bol)) (eol (point-at-eol)) 13959 (bol (point-at-bol)) (eol (point-at-eol))
13758 (pom (or (get-text-property bol 'org-hd-marker) 13960 (pom (or (get-text-property bol 'org-hd-marker)
13759 (point))) ; keep despite of compiler waring 13961 (point))) ; keep despite of compiler waring
@@ -13763,8 +13965,8 @@ Where possible, use the standard interface for changing this line."
13763 (>= (overlay-start x) bol) 13965 (>= (overlay-start x) bol)
13764 (<= (overlay-start x) eol) 13966 (<= (overlay-start x) eol)
13765 x)) 13967 x))
13766 org-column-overlays))) 13968 org-columns-overlays)))
13767 nval eval) 13969 nval eval allowed)
13768 (when (equal key "ITEM") 13970 (when (equal key "ITEM")
13769 (error "Cannot edit item headline from here")) 13971 (error "Cannot edit item headline from here"))
13770 13972
@@ -13788,7 +13990,10 @@ Where possible, use the standard interface for changing this line."
13788 (setq eval '(org-with-point-at pom 13990 (setq eval '(org-with-point-at pom
13789 (call-interactively 'org-deadline)))) 13991 (call-interactively 'org-deadline))))
13790 (t 13992 (t
13791 (setq nval (read-string "Edit: " value)) 13993 (setq allowed (org-property-get-allowed-values pom key 'table))
13994 (if allowed
13995 (setq nval (completing-read "Value: " allowed nil t))
13996 (setq nval (read-string "Edit: " value)))
13792 (setq nval (org-trim nval)) 13997 (setq nval (org-trim nval))
13793 (when (not (equal nval value)) 13998 (when (not (equal nval value))
13794 (setq eval '(org-entry-put pom key nval))))) 13999 (setq eval '(org-entry-put pom key nval)))))
@@ -13797,67 +14002,272 @@ Where possible, use the standard interface for changing this line."
13797 (remove-text-properties (1- bol) eol '(read-only t)) 14002 (remove-text-properties (1- bol) eol '(read-only t))
13798 (unwind-protect 14003 (unwind-protect
13799 (progn 14004 (progn
13800 (setq org-column-overlays 14005 (setq org-columns-overlays
13801 (org-delete-all line-overlays org-column-overlays)) 14006 (org-delete-all line-overlays org-columns-overlays))
13802 (mapc 'org-delete-overlay line-overlays) 14007 (mapc 'org-delete-overlay line-overlays)
13803 (eval eval)) 14008 (org-columns-eval eval))
13804 (org-overlay-columns)))) 14009 (org-columns-display-here))))
13805 (move-to-column col))) 14010 (move-to-column col)
14011 (if (nth 3 (assoc key org-columns-current-fmt-compiled))
14012 (org-columns-update key))))
14013
14014(defun org-columns-edit-allowed ()
14015 "Edit the list of allowed values for the current property."
14016 (interactive)
14017 (let* ((col (current-column))
14018 (key (get-char-property (point) 'org-columns-key))
14019 (key1 (concat key "_ALL"))
14020 (value (get-char-property (point) 'org-columns-value))
14021 (allowed (org-entry-get (point) key1 t))
14022 nval)
14023 (setq nval (read-string "Allowed: " allowed))
14024 (org-entry-put
14025 (cond ((marker-position org-entry-property-inherited-from)
14026 org-entry-property-inherited-from)
14027 ((marker-position org-columns-top-level-marker)
14028 org-columns-top-level-marker))
14029 key1 nval)))
14030
14031(defun org-columns-eval (form)
14032 (let (hidep)
14033 (save-excursion
14034 (beginning-of-line 1)
14035 (next-line 1)
14036 (setq hidep (org-on-heading-p 1)))
14037 (eval form)
14038 (and hidep (hide-entry))))
14039
14040(defun org-columns-previous-allowed-value ()
14041 "Switch to the previous allowed value for this column."
14042 (interactive)
14043 (org-columns-next-allowed-value t))
14044
14045(defun org-columns-next-allowed-value (&optional previous)
14046 "Switch to the next allowed value for this column."
14047 (interactive)
14048 (let* ((col (current-column))
14049 (key (get-char-property (point) 'org-columns-key))
14050 (value (get-char-property (point) 'org-columns-value))
14051 (bol (point-at-bol)) (eol (point-at-eol))
14052 (pom (or (get-text-property bol 'org-hd-marker)
14053 (point))) ; keep despite of compiler waring
14054 (line-overlays
14055 (delq nil (mapcar (lambda (x)
14056 (and (eq (overlay-buffer x) (current-buffer))
14057 (>= (overlay-start x) bol)
14058 (<= (overlay-start x) eol)
14059 x))
14060 org-columns-overlays)))
14061 (allowed (or (org-property-get-allowed-values pom key)
14062 (and (equal
14063 (nth 4 (assoc key org-columns-current-fmt-compiled))
14064 'checkbox) '("[ ]" "[X]"))))
14065 nval)
14066 (when (equal key "ITEM")
14067 (error "Cannot edit item headline from here"))
14068 (unless allowed
14069 (error "Allowed values for this property have not been defined"))
14070 (if previous (setq allowed (reverse allowed)))
14071 (if (member value allowed)
14072 (setq nval (car (cdr (member value allowed)))))
14073 (setq nval (or nval (car allowed)))
14074 (if (equal nval value)
14075 (error "Only one allowed value for this property"))
14076 (let ((inhibit-read-only t))
14077 (remove-text-properties (1- bol) eol '(read-only t))
14078 (unwind-protect
14079 (progn
14080 (setq org-columns-overlays
14081 (org-delete-all line-overlays org-columns-overlays))
14082 (mapc 'org-delete-overlay line-overlays)
14083 (org-columns-eval '(org-entry-put pom key nval)))
14084 (org-columns-display-here)))
14085 (move-to-column col)
14086 (if (nth 3 (assoc key org-columns-current-fmt-compiled))
14087 (org-columns-update key))))
14088
14089(defun org-verify-version (task)
14090 (cond
14091 ((eq task 'columns)
14092 (if (or (featurep 'xemacs)
14093 (< emacs-major-version 22))
14094 (error "Emacs 22 is required for the columns feature")))))
13806 14095
13807(defun org-columns () 14096(defun org-columns ()
13808 "Turn on column view on an org-mode file." 14097 "Turn on column view on an org-mode file."
13809 (interactive) 14098 (interactive)
13810 (org-remove-column-overlays) 14099 (org-verify-version 'columns)
14100 (org-columns-remove-overlays)
14101 (move-marker org-columns-begin-marker (point))
13811 (let (beg end fmt cache maxwidths) 14102 (let (beg end fmt cache maxwidths)
13812 (move-marker org-entry-property-inherited-from nil) 14103 (when (condition-case nil (org-back-to-heading) (error nil))
13813 (setq fmt (org-entry-get nil "COLUMNS" t)) 14104 (move-marker org-entry-property-inherited-from nil)
13814 (unless fmt 14105 (setq fmt (org-entry-get nil "COLUMNS" t)))
13815 (message "No local columns format defined, using default")) 14106 (setq fmt (or fmt org-columns-default-format))
13816 (org-set-local 'org-current-columns-fmt (or fmt org-default-columns-format)) 14107 (org-set-local 'org-columns-current-fmt fmt)
13817 (org-back-to-heading) 14108 (org-columns-compile-format fmt)
13818 (save-excursion 14109 (save-excursion
13819 (if (marker-position org-entry-property-inherited-from) 14110 (if (marker-position org-entry-property-inherited-from)
13820 (goto-char org-entry-property-inherited-from)) 14111 (goto-char org-entry-property-inherited-from))
13821 (setq beg (point) 14112 (setq beg (point))
13822 end (org-end-of-subtree t t)) 14113 (move-marker org-columns-top-level-marker (point))
14114 (unless org-columns-inhibit-recalculation
14115 (org-columns-compute-all))
14116 (setq end (or (condition-case nil (org-end-of-subtree t t) (error nil))
14117 (point-max)))
13823 (goto-char beg) 14118 (goto-char beg)
13824 ;; Get and cache the properties 14119 ;; Get and cache the properties
13825 (while (re-search-forward (concat "^" outline-regexp) end t) 14120 (while (re-search-forward (concat "^" outline-regexp) end t)
13826 (push (cons (org-current-line) (org-entry-properties)) cache)) 14121 (push (cons (org-current-line) (org-entry-properties)) cache))
13827 (when cache 14122 (when cache
13828 (setq maxwidths (org-get-columns-autowidth-alist fmt cache)) 14123 (setq maxwidths (org-columns-get-autowidth-alist fmt cache))
13829 (org-set-local 'org-current-columns-maxwidths maxwidths) 14124 (org-set-local 'org-columns-current-maxwidths maxwidths)
13830 (goto-line (car (org-last cache))) 14125 (goto-line (car (org-last cache)))
13831 (org-overlay-columns-title) 14126 (org-columns-display-here-title)
13832 (mapc (lambda (x) 14127 (mapc (lambda (x)
13833 (goto-line (car x)) 14128 (goto-line (car x))
13834 (org-overlay-columns (cdr x))) 14129 (org-columns-display-here (cdr x)))
13835 cache))))) 14130 cache)))))
13836 14131
14132(defun org-columns-new (&optional prop title width op fmt)
14133 "Insert a new column, to the leeft o the current column."
14134 (interactive)
14135 (let ((editp (and prop (assoc prop org-columns-current-fmt-compiled)))
14136 cell)
14137 (setq prop (completing-read
14138 "Property: " (mapcar 'list (org-buffer-property-keys t))
14139 nil nil prop))
14140 (setq title (read-string (concat "Column title [" prop "]: ") (or title prop)))
14141 (setq width (read-string "Column width: " (if width (number-to-string width))))
14142 (if (string-match "\\S-" width)
14143 (setq width (string-to-number width))
14144 (setq width nil))
14145 (setq fmt (completing-read "Summary [none]: "
14146 '(("none") ("add_numbers") ("add_times") ("checkbox"))
14147 nil t))
14148 (if (string-match "\\S-" fmt)
14149 (setq fmt (intern fmt))
14150 (setq fmt nil))
14151 (if (eq fmt 'none) (setq fmt nil))
14152 (if editp
14153 (progn
14154 (setcar editp prop)
14155 (setcdr editp (list title width nil fmt)))
14156 (setq cell (nthcdr (1- (current-column))
14157 org-columns-current-fmt-compiled))
14158 (setcdr cell (cons (list prop title width nil fmt)
14159 (cdr cell))))
14160 (org-columns-store-format)
14161 (org-columns-redo)))
14162
14163(defun org-columns-delete ()
14164 "Delete the column at point from columns view."
14165 (interactive)
14166 (let* ((n (current-column))
14167 (title (nth 1 (nth n org-columns-current-fmt-compiled))))
14168 (when (y-or-n-p
14169 (format "Are you sure you want to remove column \"%s\"? " title))
14170 (setq org-columns-current-fmt-compiled
14171 (delq (nth n org-columns-current-fmt-compiled)
14172 org-columns-current-fmt-compiled))
14173 (org-columns-store-format)
14174 (org-columns-redo)
14175 (if (>= (current-column) (length org-columns-current-fmt-compiled))
14176 (backward-char 1)))))
14177
14178(defun org-columns-edit-attributes ()
14179 "Edit the attributes of the current column."
14180 (interactive)
14181 (let* ((n (current-column))
14182 (info (nth n org-columns-current-fmt-compiled)))
14183 (apply 'org-columns-new info)))
14184
14185(defun org-columns-widen (arg)
14186 "Make the column wider by ARG characters."
14187 (interactive "p")
14188 (let* ((n (current-column))
14189 (entry (nth n org-columns-current-fmt-compiled))
14190 (width (or (nth 2 entry)
14191 (cdr (assoc (car entry) org-columns-current-maxwidths)))))
14192 (setq width (max 1 (+ width arg)))
14193 (setcar (nthcdr 2 entry) width)
14194 (org-columns-store-format)
14195 (org-columns-redo)))
14196
14197(defun org-columns-narrow (arg)
14198 "Make the column nrrower by ARG characters."
14199 (interactive "p")
14200 (org-columns-widen (- arg)))
14201
14202(defun org-columns-move-right ()
14203 "Swap this column with the one to the right."
14204 (interactive)
14205 (let* ((n (current-column))
14206 (cell (nthcdr n org-columns-current-fmt-compiled))
14207 e)
14208 (when (>= n (1- (length org-columns-current-fmt-compiled)))
14209 (error "Cannot shift this column further to the right"))
14210 (setq e (car cell))
14211 (setcar cell (car (cdr cell)))
14212 (setcdr cell (cons e (cdr (cdr cell))))
14213 (org-columns-store-format)
14214 (org-columns-redo)
14215 (forward-char 1)))
14216
14217(defun org-columns-move-left ()
14218 "Swap this column with the one to the left."
14219 (interactive)
14220 (let* ((n (current-column)))
14221 (when (= n 0)
14222 (error "Cannot shift this column further to the left"))
14223 (backward-char 1)
14224 (org-columns-move-right)
14225 (backward-char 1)))
14226
14227(defun org-columns-store-format ()
14228 "Store the text version of the current columns format in appropriate place.
14229This is either in the COLUMNS property of the node starting the current column
14230display, or in the #+COLUMNS line of the current buffer."
14231 (let (fmt)
14232 (setq fmt (org-columns-uncompile-format org-columns-current-fmt-compiled))
14233 (if (marker-position org-columns-top-level-marker)
14234 (save-excursion
14235 (goto-char org-columns-top-level-marker)
14236 (if (org-entry-get nil "COLUMNS")
14237 (org-entry-put nil "COLUMNS" fmt)
14238 (goto-char (point-min))
14239 (while (re-search-forward "^#\\+COLUMNS:.*" nil t)
14240 (replace-match (concat "#+COLUMNS: " fmt t t)))))
14241 (setq org-columns-current-fmt fmt))))
14242
13837(defvar org-overriding-columns-format nil 14243(defvar org-overriding-columns-format nil
13838 "FIXME:") 14244 "When set, overrides any other definition.")
13839(defvar org-agenda-view-columns-initially nil 14245(defvar org-agenda-view-columns-initially nil
13840 "FIXME:") 14246 "When set, switch to columns view immediately after creating the agenda.")
13841 14247
13842(defun org-agenda-columns () 14248(defun org-agenda-columns ()
13843 "Turn on column view in the agenda." 14249 "Turn on column view in the agenda."
13844 (interactive) 14250 (interactive)
13845 (let (fmt first-done cache maxwidths m) 14251 (org-verify-version 'columns)
14252 (org-columns-remove-overlays)
14253 (move-marker org-columns-begin-marker (point))
14254 (let (fmt cache maxwidths m)
13846 (cond 14255 (cond
13847 ((and (local-variable-p 'org-overriding-columns-format) 14256 ((and (local-variable-p 'org-overriding-columns-format)
13848 org-overriding-columns-format) 14257 org-overriding-columns-format)
13849 (setq fmt org-overriding-columns-format)) 14258 (setq fmt org-overriding-columns-format))
13850 ((setq m (get-text-property (point-at-bol) 'org-hd-marker)) 14259 ((setq m (get-text-property (point-at-bol) 'org-hd-marker))
13851 (setq fmt (org-entry-get m "COLUMNS" t))) 14260 (setq fmt (org-entry-get m "COLUMNS" t)))
13852 ((and (boundp 'org-current-columns-fmt) 14261 ((and (boundp 'org-columns-current-fmt)
13853 (local-variable-p 'org-current-columns-fmt) 14262 (local-variable-p 'org-columns-current-fmt)
13854 org-current-columns-fmt) 14263 org-columns-current-fmt)
13855 (setq fmt org-current-columns-fmt)) 14264 (setq fmt org-columns-current-fmt))
13856 ((setq m (next-single-property-change (point-min) 'org-hd-marker)) 14265 ((setq m (next-single-property-change (point-min) 'org-hd-marker))
13857 (setq m (get-text-property m 'org-hd-marker)) 14266 (setq m (get-text-property m 'org-hd-marker))
13858 (setq fmt (org-entry-get m "COLUMNS" t)))) 14267 (setq fmt (org-entry-get m "COLUMNS" t))))
13859 (setq fmt (or fmt org-default-columns-format)) 14268 (setq fmt (or fmt org-columns-default-format))
13860 (org-set-local 'org-current-columns-fmt fmt) 14269 (org-set-local 'org-columns-current-fmt fmt)
14270 (org-columns-compile-format fmt)
13861 (save-excursion 14271 (save-excursion
13862 ;; Get and cache the properties 14272 ;; Get and cache the properties
13863 (goto-char (point-min)) 14273 (goto-char (point-min))
@@ -13867,16 +14277,16 @@ Where possible, use the standard interface for changing this line."
13867 (push (cons (org-current-line) (org-entry-properties m)) cache)) 14277 (push (cons (org-current-line) (org-entry-properties m)) cache))
13868 (beginning-of-line 2)) 14278 (beginning-of-line 2))
13869 (when cache 14279 (when cache
13870 (setq maxwidths (org-get-columns-autowidth-alist fmt cache)) 14280 (setq maxwidths (org-columns-get-autowidth-alist fmt cache))
13871 (org-set-local 'org-current-columns-maxwidths maxwidths) 14281 (org-set-local 'org-columns-current-maxwidths maxwidths)
13872 (goto-line (car (org-last cache))) 14282 (goto-line (car (org-last cache)))
13873 (org-overlay-columns-title) 14283 (org-columns-display-here-title)
13874 (mapc (lambda (x) 14284 (mapc (lambda (x)
13875 (goto-line (car x)) 14285 (goto-line (car x))
13876 (org-overlay-columns (cdr x))) 14286 (org-columns-display-here (cdr x)))
13877 cache))))) 14287 cache)))))
13878 14288
13879(defun org-get-columns-autowidth-alist (s cache) 14289(defun org-columns-get-autowidth-alist (s cache)
13880 "Derive the maximum column widths from the format and the cache." 14290 "Derive the maximum column widths from the format and the cache."
13881 (let ((start 0) rtn) 14291 (let ((start 0) rtn)
13882 (while (string-match "%\\([a-zA-Z]\\S-*\\)" s start) 14292 (while (string-match "%\\([a-zA-Z]\\S-*\\)" s start)
@@ -13891,6 +14301,167 @@ Where possible, use the standard interface for changing this line."
13891 rtn) 14301 rtn)
13892 rtn)) 14302 rtn))
13893 14303
14304(defun org-columns-compute-all ()
14305 "Compute all columns that have operators defined."
14306 (remove-text-properties (point-min) (point-max) '(org-summaries t))
14307 (let ((columns org-columns-current-fmt-compiled) col)
14308 (while (setq col (pop columns))
14309 (when (nth 3 col)
14310 (save-excursion
14311 (org-columns-compute (car col)))))))
14312
14313(defun org-columns-update (property)
14314 "Recompute PROPERTY, and update the columns display for it."
14315 (org-columns-compute property)
14316 (let (fmt val pos)
14317 (save-excursion
14318 (mapc (lambda (ov)
14319 (when (equal (org-overlay-get ov 'org-columns-key) property)
14320 (setq pos (org-overlay-start ov))
14321 (goto-char pos)
14322 (when (setq val (cdr (assoc property
14323 (get-text-property (point-at-bol) 'org-summaries))))
14324 (setq fmt (org-overlay-get ov 'org-columns-format))
14325 (org-overlay-put ov 'display (format fmt val)))))
14326 org-columns-overlays))))
14327
14328(defun org-columns-compute (property)
14329 "Sum the values of property PROPERTY hierarchically, for the entire buffer."
14330 (interactive)
14331 (let* ((re (concat "^" outline-regexp))
14332 (lmax 30) ; Does anyone use deeper levels???
14333 (lsum (make-vector lmax 0))
14334 (level 0)
14335 (ass (assoc property org-columns-current-fmt-compiled))
14336 (format (nth 4 ass))
14337 (beg org-columns-top-level-marker)
14338 last-level val end sumpos sum-alist sum str)
14339 (save-excursion
14340 ;; Find the region to compute
14341 (goto-char beg)
14342 (setq end (condition-case nil (org-end-of-subtree t) (error (point-max))))
14343 (goto-char end)
14344 ;; Walk the tree from the back and do the computations
14345 (while (re-search-backward re beg t)
14346 (setq sumpos (match-beginning 0)
14347 last-level level
14348 level (org-outline-level)
14349 val (org-entry-get nil property))
14350 (cond
14351 ((< level last-level)
14352 ;; put the sum of lower levels here as a property
14353 (setq sum (aref lsum last-level)
14354 str (org-column-number-to-string sum format)
14355 sum-alist (get-text-property sumpos 'org-summaries))
14356 (if (assoc property sum-alist)
14357 (setcdr (assoc property sum-alist) str)
14358 (push (cons property str) sum-alist)
14359 (add-text-properties sumpos (1+ sumpos)
14360 (list 'org-summaries sum-alist)))
14361 (when val
14362 (org-entry-put nil property str))
14363 ;; add current to current level accumulator
14364 (aset lsum level (+ (aref lsum level) sum))
14365 ;; clear accumulators for deeper levels
14366 (loop for l from (1+ level) to (1- lmax) do (aset lsum l 0)))
14367 ((>= level last-level)
14368 ;; add what we have here to the accumulator for this level
14369 (aset lsum level (+ (aref lsum level)
14370 (org-column-string-to-number (or val "0") format))))
14371 (t (error "This should not happen")))))))
14372
14373(defun org-columns-redo ()
14374 "Construct the column display again."
14375 (interactive)
14376 (message "Recomputing columns...")
14377 (save-excursion
14378 (if (marker-position org-columns-begin-marker)
14379 (goto-char org-columns-begin-marker))
14380 (org-columns-remove-overlays)
14381 (if (org-mode-p)
14382 (call-interactively 'org-columns)
14383 (call-interactively 'org-agenda-columns)))
14384 (message "Recomputing columns...done"))
14385
14386(defun org-columns-not-in-agenda ()
14387 (if (eq major-mode 'org-agenda-mode)
14388 (error "This command is only allowed in Org-mode buffers")))
14389
14390
14391(defun org-string-to-number (s)
14392 "Convert string to number, and interpret hh:mm:ss."
14393 (if (not (string-match ":" s))
14394 (string-to-number s)
14395 (let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
14396 (while l
14397 (setq sum (+ (string-to-number (pop l)) (/ sum 60))))
14398 sum)))
14399
14400(defun org-column-number-to-string (n fmt)
14401 "Convert a computed column number to a string value, according to FMT."
14402 (cond
14403 ((eq fmt 'add_times)
14404 (let* ((h (floor n)) (m (floor (+ 0.5 (* 60 (- n h))))))
14405 (format "%d:%02d" h m)))
14406 ((eq fmt 'checkbox)
14407 (cond ((= n (floor n)) "[X]")
14408 ((> n 1.) "[-]")
14409 (t "[ ]")))
14410 (t (number-to-string n))))
14411
14412(defun org-column-string-to-number (s fmt)
14413 "Convert a column value to a number that can be used for column computing."
14414 (cond
14415 ((string-match ":" s)
14416 (let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
14417 (while l
14418 (setq sum (+ (string-to-number (pop l)) (/ sum 60))))
14419 sum))
14420 ((eq fmt 'checkbox)
14421 (if (equal s "[X]") 1. 0.000001))
14422 (t (string-to-number s))))
14423
14424(defun org-columns-uncompile-format (cfmt)
14425 "Turn the compiled columns format back into a string representation."
14426 (let ((rtn "") e s prop title op width fmt)
14427 (while (setq e (pop cfmt))
14428 (setq prop (car e)
14429 title (nth 1 e)
14430 width (nth 2 e)
14431 op (nth 3 e)
14432 fmt (nth 4 e))
14433 (cond
14434 ((eq fmt 'add_times) (setq op ":"))
14435 ((eq fmt 'checkbox) (setq op "X"))
14436 ((eq fmt 'add_numbers) (setq op "+")))
14437 (if (equal title prop) (setq title nil))
14438 (setq s (concat "%" (if width (number-to-string width))
14439 prop
14440 (if title (concat "(" title ")"))
14441 (if op (concat "{" op "}"))))
14442 (setq rtn (concat rtn " " s)))
14443 (org-trim rtn)))
14444
14445(defun org-columns-compile-format (fmt)
14446 "FIXME"
14447 (let ((start 0) width prop title op f)
14448 (setq org-columns-current-fmt-compiled nil)
14449 (while (string-match "%\\([0-9]+\\)?\\([a-zA-Z_0-9]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*"
14450 fmt start)
14451 (setq start (match-end 0)
14452 width (match-string 1 fmt)
14453 prop (match-string 2 fmt)
14454 title (or (match-string 3 fmt) prop)
14455 op (match-string 4 fmt)
14456 f nil)
14457 (if width (setq width (string-to-number width)))
14458 (cond
14459 ((equal op "+") (setq f 'add_numbers))
14460 ((equal op ":") (setq f 'add_times))
14461 ((equal op "X") (setq f 'checkbox)))
14462 (push (list prop title width op f) org-columns-current-fmt-compiled))
14463 (setq org-columns-current-fmt-compiled
14464 (nreverse org-columns-current-fmt-compiled))))
13894 14465
13895;;;; Timestamps 14466;;;; Timestamps
13896 14467
@@ -14084,7 +14655,7 @@ used to insert the time stamp into the buffer to include the time."
14084 ;; Help matching am/pm times, because `parse-time-string' does not do that. 14655 ;; Help matching am/pm times, because `parse-time-string' does not do that.
14085 ;; If there is a time with am/pm, and *no* time without it, we convert 14656 ;; If there is a time with am/pm, and *no* time without it, we convert
14086 ;; so that matching will be successful. 14657 ;; so that matching will be successful.
14087 ;; FIXME: make this replace twoce, so that we catch the end time. 14658 ;; FIXME: make this replace twice, so that we catch the end time.
14088 (when (and (not (string-match "[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans)) 14659 (when (and (not (string-match "[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans))
14089 (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans)) 14660 (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans))
14090 (setq hour (string-to-number (match-string 1 ans)) 14661 (setq hour (string-to-number (match-string 1 ans))
@@ -15308,8 +15879,7 @@ The following commands are available:
15308(org-defkey org-agenda-mode-map [(right)] 'org-agenda-later) 15879(org-defkey org-agenda-mode-map [(right)] 'org-agenda-later)
15309(org-defkey org-agenda-mode-map [(left)] 'org-agenda-earlier) 15880(org-defkey org-agenda-mode-map [(left)] 'org-agenda-earlier)
15310(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns) 15881(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns)
15311; FIXME: other key? wtah about the menu???/ 15882
15312;(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-export-icalendar-combine-agenda-files)
15313(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) 15883(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map)
15314 "Local keymap for agenda entries from Org-mode.") 15884 "Local keymap for agenda entries from Org-mode.")
15315 15885
@@ -16555,7 +17125,6 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
16555 (mapcar 'list kwds) nil nil))) 17125 (mapcar 'list kwds) nil nil)))
16556 (and (equal 0 arg) (setq org-select-this-todo-keyword nil)) 17126 (and (equal 0 arg) (setq org-select-this-todo-keyword nil))
16557 (org-set-local 'org-last-arg arg) 17127 (org-set-local 'org-last-arg arg)
16558;FIXME (org-set-local 'org-todo-keywords-for-agenda kwds)
16559 (setq org-agenda-redo-command 17128 (setq org-agenda-redo-command
16560 '(org-todo-list (or current-prefix-arg org-last-arg))) 17129 '(org-todo-list (or current-prefix-arg org-last-arg)))
16561 (setq files (org-agenda-files) 17130 (setq files (org-agenda-files)
@@ -16581,7 +17150,7 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
16581 (mapc (lambda (x) 17150 (mapc (lambda (x)
16582 (setq s (format "(%d)%s" (setq n (1+ n)) x)) 17151 (setq s (format "(%d)%s" (setq n (1+ n)) x))
16583 (if (> (+ (current-column) (string-width s) 1) (frame-width)) 17152 (if (> (+ (current-column) (string-width s) 1) (frame-width))
16584 (insert "\n ")) 17153 (insert "\n "))
16585 (insert " " s)) 17154 (insert " " s))
16586 kwds)) 17155 kwds))
16587 (insert "\n")) 17156 (insert "\n"))
@@ -16705,8 +17274,8 @@ MATCH is being ignored."
16705 "\\)\\>")) 17274 "\\)\\>"))
16706 (tags (nth 2 org-stuck-projects)) 17275 (tags (nth 2 org-stuck-projects))
16707 (tags-re (if (member "*" tags) 17276 (tags-re (if (member "*" tags)
16708 (org-re "^\\*+.*:[[:alnum:]_@]+:[ \t]*$") 17277 (org-re "^\\*+ .*:[[:alnum:]_@]+:[ \t]*$")
16709 (concat "^\\*+.*:\\(" 17278 (concat "^\\*+ .*:\\("
16710 (mapconcat 'identity tags "\\|") 17279 (mapconcat 'identity tags "\\|")
16711 (org-re "\\):[[:alnum:]_@:]*[ \t]*$")))) 17280 (org-re "\\):[[:alnum:]_@:]*[ \t]*$"))))
16712 (gen-re (nth 3 org-stuck-projects)) 17281 (gen-re (nth 3 org-stuck-projects))
@@ -16951,7 +17520,7 @@ the documentation of `org-diary'."
16951(defun org-entry-is-done-p () 17520(defun org-entry-is-done-p ()
16952 "Is the current entry marked DONE?" 17521 "Is the current entry marked DONE?"
16953 (save-excursion 17522 (save-excursion
16954 (and (re-search-backward "[\r\n]\\*" nil t) 17523 (and (re-search-backward "[\r\n]\\* " nil t)
16955 (looking-at org-nl-done-regexp)))) 17524 (looking-at org-nl-done-regexp))))
16956 17525
16957(defun org-at-date-range-p (&optional inactive-ok) 17526(defun org-at-date-range-p (&optional inactive-ok)
@@ -16984,7 +17553,7 @@ the documentation of `org-diary'."
16984 (format "mouse-2 or RET jump to org file %s" 17553 (format "mouse-2 or RET jump to org file %s"
16985 (abbreviate-file-name buffer-file-name)))) 17554 (abbreviate-file-name buffer-file-name))))
16986 ;; FIXME: get rid of the \n at some point but watch out 17555 ;; FIXME: get rid of the \n at some point but watch out
16987 (regexp (concat "[\n\r]\\*+ *\\(" 17556 (regexp (concat "\n\\*+[ \t]+\\("
16988 (if org-select-this-todo-keyword 17557 (if org-select-this-todo-keyword
16989 (if (equal org-select-this-todo-keyword "*") 17558 (if (equal org-select-this-todo-keyword "*")
16990 org-todo-regexp 17559 org-todo-regexp
@@ -17093,12 +17662,12 @@ the documentation of `org-diary'."
17093 ;; substring should only run to end of time stamp 17662 ;; substring should only run to end of time stamp
17094 (setq timestr (substring timestr 0 (match-end 0)))) 17663 (setq timestr (substring timestr 0 (match-end 0))))
17095 (save-excursion 17664 (save-excursion
17096 (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) 17665 (if (re-search-backward "^\\*+ " nil t)
17097 (progn 17666 (progn
17098 (goto-char (match-end 1)) 17667 (goto-char (match-beginning 0))
17099 (setq hdmarker (org-agenda-new-marker) 17668 (setq hdmarker (org-agenda-new-marker)
17100 tags (org-get-tags-at)) 17669 tags (org-get-tags-at))
17101 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") 17670 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
17102 (setq txt (org-format-agenda-item 17671 (setq txt (org-format-agenda-item
17103 (format "%s%s" 17672 (format "%s%s"
17104 (if deadlinep "Deadline: " "") 17673 (if deadlinep "Deadline: " "")
@@ -17202,12 +17771,12 @@ the documentation of `org-diary'."
17202 ;; substring should only run to end of time stamp 17771 ;; substring should only run to end of time stamp
17203 (setq timestr (substring timestr 0 (match-end 0)))) 17772 (setq timestr (substring timestr 0 (match-end 0))))
17204 (save-excursion 17773 (save-excursion
17205 (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) 17774 (if (re-search-backward "^\\*+ " nil t)
17206 (progn 17775 (progn
17207 (goto-char (match-end 1)) 17776 (goto-char (match-beginning 0))
17208 (setq hdmarker (org-agenda-new-marker) 17777 (setq hdmarker (org-agenda-new-marker)
17209 tags (org-get-tags-at)) 17778 tags (org-get-tags-at))
17210 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") 17779 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
17211 (setq txt (org-format-agenda-item 17780 (setq txt (org-format-agenda-item
17212 (if closedp "Closed: " "Clocked: ") 17781 (if closedp "Closed: " "Clocked: ")
17213 (match-string 1) category tags timestr))) 17782 (match-string 1) category tags timestr)))
@@ -17252,10 +17821,10 @@ the documentation of `org-diary'."
17252 (if (and (< diff wdays) todayp (not (= diff 0))) 17821 (if (and (< diff wdays) todayp (not (= diff 0)))
17253 (save-excursion 17822 (save-excursion
17254 (setq category (org-get-category)) 17823 (setq category (org-get-category))
17255 (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) 17824 (if (re-search-backward "^\\*+[ \t]+" nil t)
17256 (progn 17825 (progn
17257 (goto-char (match-end 0)) 17826 (goto-char (match-end 0))
17258 (setq pos1 (match-end 1)) 17827 (setq pos1 (match-beginning 0))
17259 (setq tags (org-get-tags-at pos1)) 17828 (setq tags (org-get-tags-at pos1))
17260 (setq head (buffer-substring-no-properties 17829 (setq head (buffer-substring-no-properties
17261 (point) 17830 (point)
@@ -17311,10 +17880,10 @@ the documentation of `org-diary'."
17311 (if (and (< diff 0) todayp) 17880 (if (and (< diff 0) todayp)
17312 (save-excursion 17881 (save-excursion
17313 (setq category (org-get-category)) 17882 (setq category (org-get-category))
17314 (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) 17883 (if (re-search-backward "^\\*+[ \t]+" nil t)
17315 (progn 17884 (progn
17316 (goto-char (match-end 0)) 17885 (goto-char (match-end 0))
17317 (setq pos1 (match-end 1)) 17886 (setq pos1 (match-beginning 0))
17318 (setq tags (org-get-tags-at)) 17887 (setq tags (org-get-tags-at))
17319 (setq head (buffer-substring-no-properties 17888 (setq head (buffer-substring-no-properties
17320 (point) 17889 (point)
@@ -17364,12 +17933,12 @@ the documentation of `org-diary'."
17364 (save-excursion 17933 (save-excursion
17365 (setq marker (org-agenda-new-marker (point))) 17934 (setq marker (org-agenda-new-marker (point)))
17366 (setq category (org-get-category)) 17935 (setq category (org-get-category))
17367 (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) 17936 (if (re-search-backward "^\\*+ " nil t)
17368 (progn 17937 (progn
17369 (setq hdmarker (org-agenda-new-marker (match-end 1))) 17938 (goto-char (match-beginning 0))
17370 (goto-char (match-end 1)) 17939 (setq hdmarker (org-agenda-new-marker (point)))
17371 (setq tags (org-get-tags-at)) 17940 (setq tags (org-get-tags-at))
17372 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") 17941 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
17373 (setq txt (org-format-agenda-item 17942 (setq txt (org-format-agenda-item
17374 (format (if (= d1 d2) "" "(%d/%d): ") 17943 (format (if (= d1 d2) "" "(%d/%d): ")
17375 (1+ (- d0 d1)) (1+ (- d2 d1))) 17944 (1+ (- d0 d1)) (1+ (- d2 d1)))
@@ -17715,7 +18284,7 @@ If ERROR is non-nil, throw an error, otherwise just return nil."
17715 (if (not (one-window-p)) (delete-window)) 18284 (if (not (one-window-p)) (delete-window))
17716 (kill-buffer buf) 18285 (kill-buffer buf)
17717 (org-agenda-maybe-reset-markers 'force) 18286 (org-agenda-maybe-reset-markers 'force)
17718 (org-remove-column-overlays)) 18287 (org-columns-remove-overlays))
17719 ;; Maybe restore the pre-agenda window configuration. 18288 ;; Maybe restore the pre-agenda window configuration.
17720 (and org-agenda-restore-windows-after-quit 18289 (and org-agenda-restore-windows-after-quit
17721 (not (eq org-agenda-window-setup 'other-frame)) 18290 (not (eq org-agenda-window-setup 'other-frame))
@@ -17814,10 +18383,12 @@ With prefix ARG, go backward that many times the current span."
17814(defun org-agenda-day-view () 18383(defun org-agenda-day-view ()
17815 "Switch to daily view for agenda." 18384 "Switch to daily view for agenda."
17816 (interactive) 18385 (interactive)
18386 (setq org-agenda-ndays 1)
17817 (org-agenda-change-time-span 'day)) 18387 (org-agenda-change-time-span 'day))
17818(defun org-agenda-week-view () 18388(defun org-agenda-week-view ()
17819 "Switch to daily view for agenda." 18389 "Switch to daily view for agenda."
17820 (interactive) 18390 (interactive)
18391 (setq org-agenda-ndays 7)
17821 (org-agenda-change-time-span 'week)) 18392 (org-agenda-change-time-span 'week))
17822(defun org-agenda-month-view () 18393(defun org-agenda-month-view ()
17823 "Switch to daily view for agenda." 18394 "Switch to daily view for agenda."
@@ -17860,8 +18431,9 @@ so that the date SD will be in that range."
17860 ((eq span 'week) 18431 ((eq span 'week)
17861 (let* ((nt (calendar-day-of-week 18432 (let* ((nt (calendar-day-of-week
17862 (calendar-gregorian-from-absolute sd))) 18433 (calendar-gregorian-from-absolute sd)))
17863 (n1 org-agenda-start-on-weekday) 18434 (d (if org-agenda-start-on-weekday
17864 (d (- nt n1))) 18435 (- nt org-agenda-start-on-weekday)
18436 0)))
17865 (setq sd (- sd (+ (if (< d 0) 7 0) d))) 18437 (setq sd (- sd (+ (if (< d 0) 7 0) d)))
17866 (setq nd 7))) 18438 (setq nd 7)))
17867 ((eq span 'month) 18439 ((eq span 'month)
@@ -18329,7 +18901,7 @@ the tags of the current headline come last."
18329 (org-back-to-heading t) 18901 (org-back-to-heading t)
18330 (condition-case nil 18902 (condition-case nil
18331 (while t 18903 (while t
18332 (if (looking-at (org-re "[^\r\n]+?:\\([[:alnum:]_@:]+\\):[ \t]*\\([\n\r]\\|\\'\\)")) 18904 (if (looking-at (org-re "[^\r\n]+?:\\([[:alnum:]_@:]+\\):[ \t]*$"))
18333 (setq tags (append (org-split-string 18905 (setq tags (append (org-split-string
18334 (org-match-string-no-properties 1) ":") 18906 (org-match-string-no-properties 1) ":")
18335 tags))) 18907 tags)))
@@ -19463,7 +20035,8 @@ translations. There is currently no way for users to extend this.")
19463 (re-archive (concat ":" org-archive-tag ":")) 20035 (re-archive (concat ":" org-archive-tag ":"))
19464 (re-quote (concat "^\\*+[ \t]+" org-quote-string "\\>")) 20036 (re-quote (concat "^\\*+[ \t]+" org-quote-string "\\>"))
19465 (htmlp (plist-get parameters :for-html)) 20037 (htmlp (plist-get parameters :for-html))
19466 (outline-regexp "\\*+") 20038 (inhibit-read-only t)
20039 (outline-regexp "\\*+ ")
19467 a b 20040 a b
19468 rtn p) 20041 rtn p)
19469 (save-excursion 20042 (save-excursion
@@ -19739,7 +20312,7 @@ underlined headlines. The default is 3."
19739 :skip-before-1st-heading 20312 :skip-before-1st-heading
19740 (plist-get opt-plist :skip-before-1st-heading) 20313 (plist-get opt-plist :skip-before-1st-heading)
19741 :add-text (plist-get opt-plist :text)) 20314 :add-text (plist-get opt-plist :text))
19742 "[\r\n]"))) 20315 "[\r\n]"))) ;; FIXME: why \r here???/
19743 thetoc have-headings first-heading-pos 20316 thetoc have-headings first-heading-pos
19744 table-open table-buffer) 20317 table-open table-buffer)
19745 20318
@@ -19846,7 +20419,7 @@ underlined headlines. The default is 3."
19846 (when custom-times 20419 (when custom-times
19847 (setq line (org-translate-time line))) 20420 (setq line (org-translate-time line)))
19848 (cond 20421 (cond
19849 ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) 20422 ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
19850 ;; a Headline 20423 ;; a Headline
19851 (setq first-heading-pos (or first-heading-pos (point))) 20424 (setq first-heading-pos (or first-heading-pos (point)))
19852 (setq level (org-tr-level (- (match-end 1) (match-beginning 1))) 20425 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)))
@@ -19953,7 +20526,7 @@ underlined headlines. The default is 3."
19953 ;; find the indentation of the next non-empty line 20526 ;; find the indentation of the next non-empty line
19954 (catch 'stop 20527 (catch 'stop
19955 (while lines 20528 (while lines
19956 (if (string-match "^\\*" (car lines)) (throw 'stop nil)) 20529 (if (string-match "^\\* " (car lines)) (throw 'stop nil))
19957 (if (string-match "^\\([ \t]*\\)\\S-" (car lines)) 20530 (if (string-match "^\\([ \t]*\\)\\S-" (car lines))
19958 (throw 'stop (setq ind (org-get-indentation (car lines))))) 20531 (throw 'stop (setq ind (org-get-indentation (car lines)))))
19959 (pop lines))) 20532 (pop lines)))
@@ -20145,12 +20718,12 @@ this line is also exported in fixed-width font."
20145 (save-excursion 20718 (save-excursion
20146 (org-back-to-heading) 20719 (org-back-to-heading)
20147 (if (looking-at (concat outline-regexp 20720 (if (looking-at (concat outline-regexp
20148 "\\( +\\<" org-quote-string "\\>\\)")) 20721 "\\( *\\<" org-quote-string "\\>\\)"))
20149 (replace-match "" t t nil 1) 20722 (replace-match "" t t nil 1)
20150 (if (looking-at outline-regexp) 20723 (if (looking-at outline-regexp)
20151 (progn 20724 (progn
20152 (goto-char (match-end 0)) 20725 (goto-char (match-end 0))
20153 (insert " " org-quote-string)))))))) 20726 (insert org-quote-string " "))))))))
20154 20727
20155(defun org-export-as-html-and-open (arg) 20728(defun org-export-as-html-and-open (arg)
20156 "Export the outline as HTML and immediately open it with a browser. 20729 "Export the outline as HTML and immediately open it with a browser.
@@ -20303,7 +20876,7 @@ the body tags themselves."
20303 (file-name-nondirectory buffer-file-name))) 20876 (file-name-nondirectory buffer-file-name)))
20304 "UNTITLED")) 20877 "UNTITLED"))
20305 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) 20878 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
20306 (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)")) 20879 (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)"))
20307 (inquote nil) 20880 (inquote nil)
20308 (infixed nil) 20881 (infixed nil)
20309 (in-local-list nil) 20882 (in-local-list nil)
@@ -20495,7 +21068,7 @@ lang=\"%s\" xml:lang=\"%s\">
20495 (catch 'nextline 21068 (catch 'nextline
20496 21069
20497 ;; end of quote section? 21070 ;; end of quote section?
20498 (when (and inquote (string-match "^\\*+" line)) 21071 (when (and inquote (string-match "^\\*+ " line))
20499 (insert "</pre>\n") 21072 (insert "</pre>\n")
20500 (setq inquote nil)) 21073 (setq inquote nil))
20501 ;; inside a quote section? 21074 ;; inside a quote section?
@@ -20672,7 +21245,7 @@ lang=\"%s\" xml:lang=\"%s\">
20672 t t line))))) 21245 t t line)))))
20673 21246
20674 (cond 21247 (cond
20675 ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) 21248 ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
20676 ;; This is a headline 21249 ;; This is a headline
20677 (setq level (org-tr-level (- (match-end 1) (match-beginning 1))) 21250 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)))
20678 txt (match-string 2 line)) 21251 txt (match-string 2 line))
@@ -21595,7 +22168,7 @@ The XOXO buffer is named *xoxo-<source buffer name>*"
21595 (with-current-buffer out (erase-buffer)) 22168 (with-current-buffer out (erase-buffer))
21596 ;; Kick off the output 22169 ;; Kick off the output
21597 (org-export-as-xoxo-insert-into out "<ol class='xoxo'>\n") 22170 (org-export-as-xoxo-insert-into out "<ol class='xoxo'>\n")
21598 (while (re-search-forward "^\\(\\*+\\) \\(.+\\)" (point-max) 't) 22171 (while (re-search-forward "^\\(\\*+\\)[ \t]+\\(.+\\)" (point-max) 't)
21599 (let* ((hd (match-string-no-properties 1)) 22172 (let* ((hd (match-string-no-properties 1))
21600 (level (length hd)) 22173 (level (length hd))
21601 (text (concat 22174 (text (concat
@@ -22052,6 +22625,7 @@ depending on context. See the individual commands for more information."
22052 (cond 22625 (cond
22053 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day)) 22626 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day))
22054 ((org-on-heading-p) (org-call-with-arg 'org-todo 'right)) 22627 ((org-on-heading-p) (org-call-with-arg 'org-todo 'right))
22628 ((org-at-property-p) (call-interactively 'org-property-next-allowed-value))
22055 (t (org-shiftcursor-error)))) 22629 (t (org-shiftcursor-error))))
22056 22630
22057(defun org-shiftleft () 22631(defun org-shiftleft ()
@@ -22060,6 +22634,8 @@ depending on context. See the individual commands for more information."
22060 (cond 22634 (cond
22061 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day)) 22635 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day))
22062 ((org-on-heading-p) (org-call-with-arg 'org-todo 'left)) 22636 ((org-on-heading-p) (org-call-with-arg 'org-todo 'left))
22637 ((org-at-property-p)
22638 (call-interactively 'org-property-previous-allowed-value))
22063 (t (org-shiftcursor-error)))) 22639 (t (org-shiftcursor-error))))
22064 22640
22065(defun org-shiftcontrolright () 22641(defun org-shiftcontrolright ()
@@ -22152,6 +22728,8 @@ This command does many different things, depending on context:
22152 ((and (local-variable-p 'org-finish-function (current-buffer)) 22728 ((and (local-variable-p 'org-finish-function (current-buffer))
22153 (fboundp org-finish-function)) 22729 (fboundp org-finish-function))
22154 (funcall org-finish-function)) 22730 (funcall org-finish-function))
22731 ((org-at-property-p)
22732 (call-interactively 'org-property-action))
22155 ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp)) 22733 ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp))
22156 ((org-on-heading-p) (call-interactively 'org-set-tags)) 22734 ((org-on-heading-p) (call-interactively 'org-set-tags))
22157 ((org-at-table.el-p) 22735 ((org-at-table.el-p)
@@ -22361,17 +22939,7 @@ See the individual commands for more information."
22361 "--" 22939 "--"
22362 ["Set Priority" org-priority t] 22940 ["Set Priority" org-priority t]
22363 ["Priority Up" org-shiftup t] 22941 ["Priority Up" org-shiftup t]
22364 ["Priority Down" org-shiftdown t] 22942 ["Priority Down" org-shiftdown t])
22365 "--"
22366 ;; FIXME: why is this still here????
22367; ["Insert Checkbox" org-insert-todo-heading (org-in-item-p)]
22368; ["Toggle Checkbox" org-ctrl-c-ctrl-c (org-at-item-checkbox-p)]
22369; ["Insert [n/m] cookie" (progn (insert "[/]") (org-update-checkbox-count))
22370; (or (org-on-heading-p) (org-at-item-p))]
22371; ["Insert [%] cookie" (progn (insert "[%]") (org-update-checkbox-count))
22372; (or (org-on-heading-p) (org-at-item-p))]
22373; ["Update Statistics" org-update-checkbox-count t]
22374 )
22375 ("TAGS and Properties" 22943 ("TAGS and Properties"
22376 ["Set Tags" 'org-ctrl-c-ctrl-c (org-at-heading-p)] 22944 ["Set Tags" 'org-ctrl-c-ctrl-c (org-at-heading-p)]
22377 ["Column view of properties" org-columns t]) 22945 ["Column view of properties" org-columns t])
@@ -22811,16 +23379,16 @@ not an indirect buffer"
22811 ;; text in a line directly attached to a headline would otherwise 23379 ;; text in a line directly attached to a headline would otherwise
22812 ;; fill the headline as well. 23380 ;; fill the headline as well.
22813 (org-set-local 'comment-start-skip "^#+[ \t]*") 23381 (org-set-local 'comment-start-skip "^#+[ \t]*")
22814 (org-set-local 'paragraph-separate "\f\\|\\*\\|[ ]*$\\|[ \t]*[:|]") 23382 (org-set-local 'paragraph-separate "\f\\|\\*+ \\|[ ]*$\\|[ \t]*[:|]")
22815;; FIXME!!!!!!! (org-set-local 'paragraph-separate "\f\\|[ ]*$") 23383;; FIXME!!!!!!! (org-set-local 'paragraph-separate "\f\\|[ ]*$")
22816 ;; The paragraph starter includes hand-formatted lists. 23384 ;; The paragraph starter includes hand-formatted lists.
22817 (org-set-local 'paragraph-start 23385 (org-set-local 'paragraph-start
22818 "\f\\|[ ]*$\\|\\([*\f]+\\)\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]") 23386 "\f\\|[ ]*$\\|\\*+ \\|\f\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]")
22819 ;; Inhibit auto-fill for headers, tables and fixed-width lines. 23387 ;; Inhibit auto-fill for headers, tables and fixed-width lines.
22820 ;; But only if the user has not turned off tables or fixed-width regions 23388 ;; But only if the user has not turned off tables or fixed-width regions
22821 (org-set-local 23389 (org-set-local
22822 'auto-fill-inhibit-regexp 23390 'auto-fill-inhibit-regexp
22823 (concat "\\*\\|#\\+" 23391 (concat "\\*+ \\|#\\+"
22824 "\\|[ \t]*" org-keyword-time-regexp 23392 "\\|[ \t]*" org-keyword-time-regexp
22825 (if (or org-enable-table-editor org-enable-fixed-width-editor) 23393 (if (or org-enable-table-editor org-enable-fixed-width-editor)
22826 (concat 23394 (concat
@@ -23099,7 +23667,53 @@ Still experimental, may disappear in the furture."
23099 ;; make tree, check each match with the callback 23667 ;; make tree, check each match with the callback
23100 (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback))) 23668 (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback)))
23101 23669
23670(defun org-fill-paragraph-experimental (&optional justify)
23671 "Re-align a table, pass through to fill-paragraph if no table."
23672 (let ((table-p (org-at-table-p))
23673 (table.el-p (org-at-table.el-p)))
23674 (cond ((equal (char-after (point-at-bol)) ?*) t) ; skip headlines
23675 (table.el-p t) ; skip table.el tables
23676 (table-p (org-table-align) t) ; align org-mode tables
23677 ((save-excursion
23678 (let ((pos (1+ (point-at-eol))))
23679 (backward-paragraph 1)
23680 (re-search-forward "\\\\\\\\[ \t]*$" pos t)))
23681 (save-excursion
23682 (save-restriction
23683 (narrow-to-region (1+ (match-end 0)) (point-max))
23684 (fill-paragraph nil)
23685 t)))
23686 (t nil)))) ; call paragraph-fill
23687
23688(defun org-property-previous-allowed-value (&optional previous)
23689 "Switch to the next allowed value for this property."
23690 (interactive)
23691 (org-property-next-allowed-value t))
23102 23692
23693(defun org-property-next-allowed-value (&optional previous)
23694 "Switch to the next allowed value for this property."
23695 (interactive)
23696 (unless (org-at-property-p)
23697 (error "Not at a property"))
23698 (let* ((key (match-string 2))
23699 (value (match-string 3))
23700 (allowed (or (org-property-get-allowed-values (point) key)
23701 (and (member value '("[ ]" "[-]" "[X]"))
23702 '("[ ]" "[X]"))))
23703 nval)
23704 (unless allowed
23705 (error "Allowed values for this property have not been defined"))
23706 (if previous (setq allowed (reverse allowed)))
23707 (if (member value allowed)
23708 (setq nval (car (cdr (member value allowed)))))
23709 (setq nval (or nval (car allowed)))
23710 (if (equal nval value)
23711 (error "Only one allowed value for this property"))
23712 (org-at-property-p)
23713 (replace-match (concat " :" key ": " nval))
23714 (org-indent-line-function)
23715 (beginning-of-line 1)
23716 (skip-chars-forward " \t")))
23103 23717
23104;;;; Finish up 23718;;;; Finish up
23105 23719
@@ -23109,3 +23723,4 @@ Still experimental, may disappear in the furture."
23109 23723
23110;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd 23724;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
23111;;; org.el ends here 23725;;; org.el ends here
23726
diff --git a/man/ChangeLog b/man/ChangeLog
index 13d4c7b1b29..65173aa2f5d 100644
--- a/man/ChangeLog
+++ b/man/ChangeLog
@@ -1,3 +1,7 @@
12007-07-10 Carsten Dominik <dominik@science.uva.nl>
2
3 * org.texi (Properties and columns): Chapter rewritten.
4
12007-07-08 Michael Albinus <michael.albinus@gmx.de> 52007-07-08 Michael Albinus <michael.albinus@gmx.de>
2 6
3 * tramp.texi: 7 * tramp.texi: