;; Author: Carsten Dominik <dominik at science dot uva dot nl>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
-;; Version: 4.55
+;; Version: 4.56
;;
;; This file is part of GNU Emacs.
;;
;;
;; Recent changes
;; --------------
+;; Version 4.56
+;; - `C-k' in agenda kills current line and corresponding subtree in file.
+;; - XEmacs compatibility issues fixed, in particular tag alignment.
+;; - M-left/right now in/outdents plain list items, no Shift needed.
+;; - Bug fixes.
+;;
;; Version 4.55
;; - Bug fixes.
;;
;; `org-agenda-window-setup', `org-agenda-restore-windows-after-quit'.
;; - Bug fixes.
;;
-;; Version 4.50
-;; - Closing a TODO item can record an additional note.
-;; See variables `org-log-done' and `org-log-note-headings'.
-;; - Inserting headlines and bullets can leave an extra blank line.
-;; See variable `org-blank-before-new-entry'. (Ed Hirgelt patch)
-;; - [[bracket links]] in the agenda are active just as in org-mode buffers.
-;; - C-c C-o on a date range displays the agenda for exactly this range.
-;; - The default for `org-cycle-include-plain-lists' is back to nil.
-;; - Calls to `org-occur' can be stacked by using a prefix argument.
-;; - The options `org-show-hierarchy-above' and `org-show-following-heading'
-;; now always default to `t', but can be customized differently for
-;; different types of sparse trees or jump commands.
-;; - Bug fixes.
-;;
-;; Version 4.49
-;; - Agenda views can be made in batch mode from the command line.
-;; - `org-store-link' does the right thing in dired-mode.
-;; - File links can contain environment variables.
-;; - Full Emacs 21 compatibility has been restored.
-;; - Bug fixes.
-;;
-;; Version 4.47
-;; - Custom commands may produce an agenda which contains several blocks,
-;; each block created by a different agenda command.
-;; - Agenda commands can be restricted to the current file, region, subtree.
-;; - The timeline command must now be called through the agenda
-;; dispatcher (C-c a L). `C-c C-r' no longer works.
-;; - Agenda items can be sorted by tag. The *last* tag is used for this.
-;; - The prefix and the sorting strategy for agenda items can depend
-;; upon the agenda type.
-;; - The handling of `mailto:' links can be customized, see the new
-;; variable `org-link-mailto-program'.
-;; - `mailto' links can specify a subject after a double colon,
-;; like [[mailto:carsten@orgmode.org::Org-mode is buggy]].
-;; - In the #+STARTUP line, M-TAB completes valid keywords.
-;; - In the #+TAGS: line, M-TAB after ":" inserts all currently used tags.
-;; - Again full Emacs 21 support: Checkboxes and publishing are fixed.
-;; - More minor bug fixes.
-;;
-;; Version 4.45
-;; - Checkbox lists can show statistics about checked items.
-;; - C-TAB will cycle the visibility of archived subtrees.
-;;; - Documentation about checkboxes has been moved to chapter 5.
-;; - Bux fixes.
-;;
-;; Version 4.44
-;; - Clock table can be done for a limited time interval.
-;; - Obsolete support for the old outline mode has been removed.
-;; - Bug fixes and code cleaning.
-;;
-;; Version 4.43
-;; - Bug fixes
-;; - `s' key in the agenda saves all org-mode buffers.
-;;
-;; Version 4.41
-;; - Shift-curser keys can modify inactive time stamps (inactive time
-;; stamps are the ones in [...] brackets.
-;; - Toggle all checkboxes in a region/below a headline.
-;; - Bug fixes.
-;;
;;; Code:
(eval-when-compile
;;; Customization variables
-(defvar org-version "4.55"
+(defvar org-version "4.56"
"The version number of the file org.el.")
(defun org-version ()
(interactive)
(const :tag "All" t)
(number :tag "at most")))
+(defcustom org-agenda-confirm-kill 1
+ "When set, remote killing from the agenda buffer needs confirmation.
+When t, a confirmation is always needed. When a number N, confirmation is
+only needed when the text to be killed contains more than N non-white lines."
+ :group 'org-agenda ;; FIXME
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (number :tag "When more than N lines")))
+
+;; FIXME: This variable could be removed
(defcustom org-agenda-include-all-todo nil
"Set means weekly/daily agenda will always contain all TODO entries.
The TODO entries will be listed at the top of the agenda, before
(let* ((level (save-match-data (funcall outline-level)))
(up-head (make-string (org-get-legal-level level -1) ?*))
(diff (abs (- level (length up-head)))))
- (if (= level 1) (error "Cannot promote to level 0. UNDO to recover"))
+ (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary"))
(replace-match up-head nil t)
;; Fixup tag positioning
(and org-auto-align-tags (org-set-tags nil t))
(make-overlay beg end buffer)))
(defun org-delete-overlay (ovl)
(if (featurep 'xemacs) (delete-extent ovl) (delete-overlay ovl)))
-(defun org-detatch-overlay (ovl)
+(defun org-detach-overlay (ovl)
(if (featurep 'xemacs) (detach-extent ovl) (delete-overlay ovl)))
(defun org-move-overlay (ovl beg end &optional buffer)
(if (featurep 'xemacs)
(defvar org-date-ovl (org-make-overlay 1 1))
(org-overlay-put org-date-ovl 'face 'org-warning)
-(org-detatch-overlay org-date-ovl)
+(org-detach-overlay org-date-ovl)
(defun org-read-date (&optional with-time to-time from-string)
"Read a date and make things smooth for the user.
(use-local-map old-map))))))
(t ; Naked prompt only
(setq ans (read-string prompt "" nil timestr))))
- (org-detatch-overlay org-date-ovl)
+ (org-detach-overlay org-date-ovl)
(if (string-match
"^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans)
(define-key org-agenda-mode-map "\C-i" 'org-agenda-goto)
(define-key org-agenda-mode-map [(tab)] 'org-agenda-goto)
(define-key org-agenda-mode-map "\C-m" 'org-agenda-switch-to)
+(define-key org-agenda-mode-map "\C-k" 'org-agenda-kill)
(define-key org-agenda-mode-map " " 'org-agenda-show)
(define-key org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo)
(define-key org-agenda-mode-map "o" 'delete-other-windows)
(org-flag-heading nil)))) ; show the next heading
(and highlight (org-highlight (point-at-bol) (point-at-eol)))))
+(defun org-agenda-kill ()
+ "Kill the entry or subtree belonging to the current agenda entry."
+ (interactive)
+ (let* ((marker (or (get-text-property (point) 'org-marker)
+ (org-agenda-error)))
+ (hdmarker (get-text-property (point) 'org-hd-marker))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker))
+ dbeg dend txt n conf)
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char pos)
+ (if (org-mode-p)
+ (setq dbeg (progn (org-back-to-heading t) (point))
+ dend (org-end-of-subtree t))
+ (setq dbeg (point-at-bol)
+ dend (min (point-max) (1+ (point-at-eol)))))
+ (setq txt (buffer-substring dbeg dend))))
+ (while (string-match "^[ \t]*\n" txt) (setq txt (replace-match "" t t txt)))
+ (setq n (length (split-string txt "\n"))
+ conf (or (eq t org-agenda-confirm-kill)
+ (and (numberp org-agenda-confirm-kill)
+ (> n org-agenda-confirm-kill))))
+ (and conf
+ (not (y-or-n-p
+ (format "Delete entry with %d lines in buffer \"%s\"? "
+ n (buffer-name buffer))))
+ (error "Abort"))
+ ;; FIXME: if we kill an entire subtree, should we not find all
+ ;; lines coming from the subtree?
+ (save-excursion (org-agenda-change-all-lines "" hdmarker))
+ (with-current-buffer buffer (delete-region dbeg dend))
+ (message "Agenda item and source killed")))
+
(defun org-agenda-switch-to (&optional delete-other-windows)
"Go to the Org-mode file which contains the item at point."
(interactive)
`equal' against all `org-hd-marker' text properties in the file.
If FIXFACE is non-nil, the face of each item is modified acording to
the new TODO state."
- (let* (props m pl undone-face done-face finish new dotime cat tags)
+ (let* ((buffer-read-only nil)
+ props m pl undone-face done-face finish new dotime cat tags)
(save-excursion
(goto-char (point-max))
(beginning-of-line 1)
undone-face (get-text-property (point) 'undone-face)
done-face (get-text-property (point) 'done-face))
(move-to-column pl)
- (if (looking-at ".*")
- (progn
- (replace-match new t t)
- (beginning-of-line 1)
- (add-text-properties (point-at-bol) (point-at-eol) props)
- (when fixface
- (add-text-properties
- (point-at-bol) (point-at-eol)
- (list 'face
- (if org-last-todo-state-is-todo
- undone-face done-face))))
- (org-agenda-highlight-todo 'line)
- (beginning-of-line 1))
- (error "Line update did not work")))
+ (cond
+ ((equal new "")
+ (beginning-of-line 1)
+ (and (looking-at ".*\n?") (replace-match "")))
+ ((looking-at ".*")
+ (replace-match new t t)
+ (beginning-of-line 1)
+ (add-text-properties (point-at-bol) (point-at-eol) props)
+ (when fixface
+ (add-text-properties
+ (point-at-bol) (point-at-eol)
+ (list 'face
+ (if org-last-todo-state-is-todo
+ undone-face done-face))))
+ (org-agenda-highlight-todo 'line)
+ (beginning-of-line 1))
+ (t (error "Line update did not work"))))
(beginning-of-line 0)))
(org-finalize-agenda)))
(error nil))))
tags))
+;; FIXME: should fix the tags property of the agenda line.
(defun org-agenda-set-tags ()
"Set tags for the current headline."
(interactive)
(mapconcat 'regexp-quote
(nreverse (cdr (reverse org-todo-keywords)))
"\\|")
- "\\>\\)\\)? *\\(.*?\\)\\(:[A-Za-z_@0-9:]+:\\)?[ \t]*$")) ;;FIXME: was [\n\r] instead of $
+ "\\>\\)\\)? *\\(.*?\\)\\(:[A-Za-z_@0-9:]+:\\)?[ \t]*$"))
(props (list 'face nil
'done-face 'org-done
'undone-face nil
(defvar org-add-colon-after-tag-completion nil) ;; dynamically skoped param
(defvar org-tags-overlay (org-make-overlay 1 1))
-;(org-overlay-put org-tags-overlay 'face 'org-warning)
-(org-detatch-overlay org-tags-overlay)
+(org-detach-overlay org-tags-overlay)
(defun org-set-tags (&optional arg just-align)
"Set the tags for the current headline.
With prefix ARG, realign all tags in headings in the current buffer."
(interactive "P")
(let* ((re (concat "^" outline-regexp))
- (col (current-column))
(current (org-get-tags))
table current-tags inherited-tags ; computed below when needed
- tags empty invis)
+ tags p0 c0 c1 rpl)
(if arg
(save-excursion
(goto-char (point-min))
(let (buffer-invisibility-spec) ; Emacs 21 compatibility
(while (re-search-forward re nil t)
- (org-set-tags nil t)))
+ (org-set-tags nil t)
+ (end-of-line 1)))
(message "All tags realigned to column %d" org-tags-column))
(if just-align
(setq tags current)
+ ;; Get a new set of tags from the user
(setq table (or org-tag-alist (org-get-buffer-tags))
org-last-tags-completion-table table
current-tags (org-split-string current ":")
(delq nil (mapcar 'cdr table))))
(org-fast-tag-selection current-tags inherited-tags table)
(let ((org-add-colon-after-tag-completion t))
- (completing-read "Tags: " 'org-tags-completion-function
- nil nil current 'org-tags-history))))
+ (org-trim
+ (completing-read "Tags: " 'org-tags-completion-function
+ nil nil current 'org-tags-history)))))
(while (string-match "[-+&]+" tags)
+ ;; No boolean logic, just a list
(setq tags (replace-match ":" t t tags))))
- (unless (setq empty (string-match "\\`[\t ]*\\'" tags))
+ (if (string-match "\\`[\t ]*\\'" tags)
+ (setq tags "")
(unless (string-match ":$" tags) (setq tags (concat tags ":")))
(unless (string-match "^:" tags) (setq tags (concat ":" tags))))
- (if (equal current "")
+
+ ;; Insert new tags at the correct column
+ (beginning-of-line 1)
+ (if (re-search-forward
+ (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$")
+ (point-at-eol) t)
(progn
- (end-of-line 1)
- (or empty (insert " ")))
- (beginning-of-line 1)
- (setq invis (org-invisible-p))
- (looking-at (concat ".*?\\([ \t]*" (regexp-quote current) "\\)[ \t]*"))
- (delete-region (match-beginning 1) (match-end 1))
- (goto-char (match-beginning 1))
- (insert (if empty "" " ")))
- (if (equal tags "")
- (save-excursion
- (beginning-of-line 1)
- (skip-chars-forward "*")
- (if (= (char-after) ?\ ) (forward-char 1))
- (and (re-search-forward "[ \t]+$" (point-at-eol) t)
- (replace-match "")))
- (let (buffer-invisibility-spec) ; Emacs 21 compatibility
- (move-to-column (max (current-column)
- (if (> org-tags-column 0)
- org-tags-column
- (- (- org-tags-column) (length tags))))
- t))
- (insert tags)
- (if (and (not invis) (org-invisible-p))
- (outline-flag-region (point) (point-at-bol) nil))) ; show
- (move-to-column col))))
+ (if (equal tags "")
+ (setq rpl "")
+ (goto-char (match-beginning 0))
+ (setq c0 (current-column) p0 (point)
+ c1 (max (1+ c0) (if (> org-tags-column 0)
+ org-tags-column
+ (- (- org-tags-column) (length tags))))
+ rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags)))
+ (replace-match rpl)
+ (and (not (featurep 'xemacs)) c0 (tabify p0 (point)))
+ tags)
+ (error "Tags alignment failed")))))
(defun org-tags-completion-function (string predicate &optional flag)
(let (s1 s2 rtn (ctable org-last-tags-completion-table)
(setq exit-after-next (not exit-after-next))))
((or (= c ?\C-g)
(and (= c ?q) (not (rassoc c ntable))))
- (org-detatch-overlay org-tags-overlay)
+ (org-detach-overlay org-tags-overlay)
(setq quit-flag t))
((= c ?\ )
(setq current nil)
((member tg inherited) i-face)
(t nil)))))
(goto-char (point-min)))))
- (org-detatch-overlay org-tags-overlay)
+ (org-detach-overlay org-tags-overlay)
(if rtn
(mapconcat 'identity current ":")
nil))))
(max 1 (prefix-numeric-value nspace)))))
(goto-char beg)
(while (re-search-forward re end t)
- (replace-match "|" t t))
+ (replace-match "| " t t))
(goto-char beg)
(insert " ")
(org-table-align)))